zoukankan      html  css  js  c++  java
  • delphi透明panel组件或者制作方法

    //透明Panel控件
    
    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.
    我也遇到同样的问题,能解决的话,另外我也开贴给分.
    目前网上有不少代码.目前我使用的方法是
    1.重写TPanel的Create方法,增加
    ControlStyle := ControlStyle - [csOpaque];
      Brush.Style := bsClear;
    2.CreateParams方法,增加
    with Params  do
      begin
        ExStyle := ExStyle or WS_EX_TRANSPARENT;
      end;
    3.重写Paint方法,直接将置空(我现在用的Panel只是做为一个容器用)
    4.获取WM_ERASEBKGND消息,Result为1
    
    但是现在出现两个问题
    1.放置Panel的窗口发生变化时,Panel不显示
    2.Panel刷新后,背景没有刷新.(我在Panel上放了两个控件:控件1,控件2,这两个控件是交替显示的,发生交替的时候发现前面一个隐藏掉的控件还是画在了Panel上面,导致背景看起来很乱).
    
    由于这个Panel是放在Form上使用的,我在Form上又放置了TImage控件,我希望Panel透明以后不要影响其他控件的显示效果,而现在网上的基本是靠获取Panel的父控件的背景来重画Panel背景实现,这种方式会影响其他控件的使用.
    我结合网上搜到的资料,做了一个,基本能够达到我的应用了,但是还存在一个问题"放置Panel的窗口发生变化时,Panel不显示",
    先把代码贴出来,大家帮忙看看哪边有问题.
    //透明Panel
      TTransparentPanel=class(TPanel)
      protected
        procedure Paint; override;
        procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;
        procedure WMMove(var Message: TWMMove); Message WM_Move;
        procedure AlignControls(AControl: TControl; var Rect: TRect); override;
      public
        constructor Create(AOwner: TComponent); override;
        destructor Destroy; override;
        procedure CreateParams(var Params: TCreateParams); override;
        procedure Invalidate;override;
      end;
    
    { TTransparentPanel }
    
    procedure TTransparentPanel.AlignControls(AControl: TControl; var Rect: TRect);
    begin
      inherited;
      Invalidate;
    end;
    
    constructor TTransparentPanel.Create(AOwner: TComponent);
    begin
      inherited;
      ControlStyle := ControlStyle - [csSetCaption];
      ControlStyle := ControlStyle - [csOpaque];
    end;
    
    procedure TTransparentPanel.CreateParams(var Params: TCreateParams);
    begin
      inherited;
      with Params  do
      begin
        ExStyle := ExStyle or WS_EX_TRANSPARENT;
      end;
    end;
    
    destructor TTransparentPanel.Destroy;
    begin
    
      inherited Destroy;
    end;
    
    procedure TTransparentPanel.Invalidate;
    var
      Rect: TRect;
      iLoop: Integer;
    begin
      if (Parent<>nil) and(Parent.HandleAllocated) then
      begin
        Rect := BoundsRect;
        InvalidateRect(Parent.Handle,@Rect,False);
        for iLoop := 0 to ControlCount- 1 do
           Controls[iLoop].Invalidate;
      end;
    end;
    
    procedure TTransparentPanel.Paint;
    var
      ARect: TRect;
      TopColor, BottomColor: TColor;
    
      procedure AdjustColors(Bevel: TPanelBevel);
      begin
        TopColor := clBtnHighlight;
        if Bevel = bvLowered then TopColor := clBtnShadow;
        BottomColor := clBtnShadow;
        if Bevel = bvLowered then BottomColor := clBtnHighlight;
      end;
    begin
      ARect := GetClientRect;
      if BevelOuter <> bvNone then
      begin
        AdjustColors(BevelOuter);
        Frame3D(Canvas, ARect, TopColor, BottomColor, BevelWidth);
      end;
      Frame3D(Canvas, ARect, Color, Color, BorderWidth);
      if BevelInner <> bvNone then
      begin
        AdjustColors(BevelInner);
        Frame3D(Canvas, ARect, TopColor, BottomColor, BevelWidth);
      end;
      Update;
    end;
    
    procedure TTransparentPanel.WMEraseBkgnd(var Message: TMessage);
    begin
      Message.Result := 1;
    end;
    
    
    procedure TTransparentPanel.WMMove(var Message: TWMMove);
    begin
      inherited;
      Invalidate;
    end;
  • 相关阅读:
    springboot---web 应用开发-文件上传
    springboot --> web 应用开发-CORS 支持
    Springboot
    spring boot ---web应用开发-错误处理
    Spring Boot基础教程》 第1节工具的安装和使用
    jQuery第四课 点击 _选项卡效果一
    jQuery第三课 点击按钮 弹出层div效果
    jQuery第二课 点击弹出一个提示框
    jQuery第一课 加载页面弹出一个对话框
    NPIO 导出Execl
  • 原文地址:https://www.cnblogs.com/blogpro/p/11345960.html
Copyright © 2011-2022 走看看