Ir para conteúdo
Fórum Script Brasil
  • 0

Panel um pouco transparente


robinhocne

Pergunta

3 respostass a esta questão

Posts Recomendados

  • 0

parece que voce não entendeu as sugstões anteriores

quem essa, voce entende:

unit  TranPanel;
interface
uses
  Windows,  Messages,  SysUtils,  Classes,  Graphics,  Controls,  Forms,  Dialogs,
  ExtCtrls;
type
  TGlassStyle  =  (
  gsBlackness,  gsDstInvert,  gsMergeCopy,  gsMergePaint,  gsNotSrcCopy,
  gsNotSrcErase,  gsPatCopy,  gsPatInvert,  gsPatPaint,  gsSrcAnd,
  gsSrcCopy,  gsSrcErase,  gsSrcInvert,  gsSrcPaint,  gsWhiteness);
  TGlass  =  class(TCustomControl)
private
  FColor:  TColor;
  FStyle:  TGlassStyle;
  FOnPaint:  TNotifyEvent;
  procedure  SetColor(Value:  TColor);
  procedure  SetStyle(Value:  TGlassStyle);
  procedure  CMCtl3DChanged(var  Message:  TMessage);  message  CM_CTL3DCHANGED;
  procedure  WMEraseBkgnd(var  Message:  TMessage);  message  WM_ERASEBKGND;
  procedure  WMWindowPosChanging(var  Message:  TWMWindowPosChanging);  message  WM_WINDOWPOSCHANGING;
  protected
    Buffer:  TBitmap;
  procedure  CreateParams(var  Params:  TCreateParams);  override;
  procedure  Paint;  override;
  procedure  Resize;  override;
public
  constructor  Create(AOwner:  TComponent);  override;
  destructor  Destroy;  override;
  property  Canvas;
published
  property  Align;
  property  Anchors;
  property  AutoSize;
  property  BiDiMode;
  property  BorderWidth;
  property  Color:  TColor  read  FColor  write  SetColor;
  property  Ctl3D;
  property  Enabled;
  property  Style:  TGlassStyle  read  FStyle  write  SetStyle  default  gsSrcAnd;
  property  Visible;
  property  OnClick;
  property  OnDblClick;
  property  OnEnter;
  property  OnExit;
  property  OnMouseDown;
  property  OnMouseMove;
  property  OnMouseUp;
  property  OnResize;
  property  OnPaint:  TNotifyEvent  read  FOnPaint  write  FOnPaint;
end;
procedure  Register;

implementation

procedure  Register;
begin
  RegisterComponents('Croco',  [TGlass]);
end;

function  GlassStyleToInt(gs:  TGlassStyle):  LongInt;
begin
  case  gs  of
    gsBlackness  :  Result  :=  cmBlackness;
    gsDstInvert  :  Result  :=  cmDstInvert;
    gsMergeCopy  :  Result  :=  cmMergeCopy;
    gsMergePaint  :  Result  :=  cmMergePaint;
    gsNotSrcCopy  :  Result  :=  cmNotSrcCopy;
    gsNotSrcErase:  Result  :=  cmNotSrcErase;
    gsPatCopy  :  Result  :=  cmPatCopy;
    gsPatInvert  :  Result  :=  cmPatInvert;
    gsPatPaint  :  Result  :=  cmPatPaint;
    gsSrcAnd  :  Result  :=  cmSrcAnd;
    gsSrcCopy  :  Result  :=  cmSrcCopy;
    gsSrcErase  :  Result  :=  cmSrcErase;
    gsSrcInvert  :  Result  :=  cmSrcInvert;
    gsSrcPaint  :  Result  :=  cmSrcPaint;
    gsWhiteness  :  Result  :=  cmWhiteness;
  else  Assert(True,  'Error  parameter  in  function  GlassStyleToInt');
  end;
end;

constructor  TGlass.Create(AOwner:  TComponent);
begin
   inherited  Create(AOwner);
   Buffer  :=  TBitmap.Create;
   ControlStyle  :=  [csAcceptsControls,  csCaptureMouse,  csClickEvents,
   csDoubleClicks,  csReplicatable];
   Width  :=  100;
   Height  :=  100;
   FStyle  :=  gsSrcAnd;
   ParentCtl3d  :=  False;
   Ctl3D  :=  False;
   ParentColor  :=  False;
   FColor  :=  clWhite;
end;

destructor  TGlass.Destroy;
begin
   Buffer.Free;
   inherited  Destroy;
end;

procedure  TGlass.Paint;
var
   R:  TRect;
   rop:  LongInt;
begin
   R  :=  Rect(0,  0,  Width,  Height);
   Buffer.Width  :=  Width;
   Buffer.Height  :=  Height;
   Buffer.Canvas.Brush.Style  :=  bsSolid;
   Buffer.Canvas.Brush.Color  :=  FColor;
   Buffer.Canvas.FillRect(Rect(0,  0,  Width,  Height));
   rop  :=  GlassStyleToInt(FStyle);
   StretchBlt(Buffer.Canvas.Handle,  0,  0,  Width,  Height,
   Canvas.Handle,  0,  0,  Width,  Height,  rop);
   if  Ctl3D  then  DrawEdge(Buffer.Canvas.Handle,  R,  BDR_RAISEDINNER,  BF_RECT);
   Buffer.Canvas.Pen.Mode  :=  pmCopy;
   Buffer.Canvas.Pen.Style  :=  psSolid;
   Canvas.Draw(0,  0,  Buffer);
   if  Assigned(FOnPaint)  then  FOnPaint(Self);
end;

procedure  TGlass.SetColor(Value:  TColor);
begin
   if  Value  <>  FColor  then
      begin
         FColor  :=  Value;
         RecreateWnd;
      end;
end;

procedure  TGlass.CreateParams(var  Params:  TCreateParams);
begin
   inherited  CreateParams(Params);
   Params.ExStyle  :=  Params.ExStyle  +  WS_EX_TRANSPARENT;
end;

procedure  TGlass.WMWindowPosChanging(var  Message:  TWMWindowPosChanging);
begin
   Invalidate;
   inherited;
end;

procedure  TGlass.WMEraseBkgnd(var  Message:  TMessage);
begin
   Message.Result  :=  0;
end;

procedure  TGlass.Resize;
begin
   Invalidate;
   inherited;
end;

procedure  TGlass.CMCtl3DChanged(var  Message:  TMessage);
begin
   inherited;
   RecreateWnd;
end;

procedure  TGlass.SetStyle(Value:  TGlassStyle);
begin
   if  Value  <>  FStyle  then
      begin
        FStyle  :=  Value;
        RecreateWnd;
      end;
end;

end.

abraço

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,1k
    • Posts
      651,8k
×
×
  • Criar Novo...