transpanel.pas

皮肤按钮 skinbutton transpanel ... 欢迎改进

unit TransPanel;

interface

uses
  windows,SysUtils, Classes, Controls, graphics,ExtCtrls,
  messages;

type 
  T24Color = record
    b, g, r: Byte;
  end;
  P24Color = ^T24Color;
TPanelBorder =(pbUp,pbDown,pbNormal,pbNone);


  TTransPanel = class(TCustomPanel)
  private
    FTransparentRate: Integer;      // 透明度
    FBkGnd : TBitmap;
    fbmp: tbitmap;
    fpb: tpanelborder;
    fpbpen: tpen;               // 背景buffer

    { Private declarations }
    procedure SetTransparentRate(value: Integer);
    procedure WMEraseBkgnd(var Msg: TMessage); message WM_ERASEBKGND;
    procedure setbmp(const Value: tbitmap);
    procedure setbp(const Value: tpanelborder);
    procedure setpbpen(const Value: tpen);
  protected
    { Protected declarations }
    procedure BuildBkgnd; virtual;         // 生成半透明的背景
    procedure SetParent(AParent : TWinControl); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Paint; override;
  public
    { Public declarations }
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;  // resize or move
    procedure Invalidate; override;
    procedure InvalidateA; virtual;
  published
    { Published declarations }
 Property   TransparentRate: Integer   Read          FTransparentRate
                                       Write       SetTransparentRate;
 property Bitmap:tbitmap read fbmp write setbmp;
 property PanelBordeR:tpanelborder read fpb write setbp;
 property PanelBorderPen:tpen read fpbpen write setpbpen;
    property Align;
    property Alignment;
    property Anchors;
    property AutoSize;
    property BevelInner;
    property BevelOuter;
    property BevelWidth;
    property BiDiMode;
    property BorderWidth;
    property BorderStyle;
    property Caption;
    property Color;
    property Constraints;
    property Ctl3D;
    property UseDockManager default True;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FullRepaint;
    property Font;
    property Locked;
    property ParentBiDiMode;
    property ParentBackground;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnCanResize;
    property OnClick;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDockDrop;
    property OnDockOver;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
 
end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('standard', [TTransPanel]);
end;

{ TTransPanel }

procedure TTransPanel.BuildBkgnd;
var
  p, p1: P24Color;  
  C : LongInt;
  i, j: Integer;
begin
  FBkgnd.PixelFormat := pf24Bit;
  FBkgnd.Width := Width;
  FBkgnd.Height := Height;
  if not fbmp.Empty then canvas.StretchDraw(canvas.ClipRect,fbmp);
  if ftransparentrate > 0 then
  begin
    BitBlt(FBkgnd.Canvas.handle, 0, 0, Width, Height, Canvas.Handle, 0, 0, SRCCOPY);
    if ftransparentrate < 100 then   // 部分透明
    begin
      c := ColorToRGB(Color);
                                        // 注意: ColorToRGB得到的颜色r, b位置与
                                        // scanline中颜色顺序正好相反.
      p1 := @c;
      for i := 0 to FBkgnd.Height - 1 do
      begin
        p := FBkgnd.Scanline[i];
        for j := 0 to FBkgnd.Width - 1 do
        begin
          p^.r := (p^.r * ftransparentrate + p1^.b * (100-ftransparentrate)) div 100;
          p^.g := (p^.g * ftransparentrate + p1^.g * (100-ftransparentrate)) div 100;
          p^.b := (p^.b * ftransparentrate + p1^.r * (100-ftransparentrate)) div 100;
          p := pointer(integer(p)+3);
        end;
      end;
    end;
  end
  else begin     // 不透明
    c := CreateSolidBrush(ColorToRGB(color));
    FillRect(FBkgnd.canvas.handle,fbkgnd.Canvas.ClipRect, c);
    deleteobject(c);    
  end;
  controlstyle := controlstyle + [csOpaque];   // 背景没有变化时的重画不会出现闪烁
end;

constructor TTransPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fbmp:=tbitmap.Create;
  FBkgnd := TBitmap.Create;
  fTransparentRate := 0;
  fpb:=pbnormal;
  fpbpen:=tpen.Create;
end;

procedure TTransPanel.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;

destructor TTransPanel.Destroy;
begin
fpbpen.Free;
fbkgnd.free;
fbmp.Free;
  inherited;
end;

procedure TTransPanel.Invalidate;
begin
  //if assigned(fbkgnd) then
  //begin
    //fbkgnd.free;
    //fbkgnd := nil;
    controlstyle := controlstyle - [csOpaque];
 // end;
  inherited;
end;

procedure TTransPanel.InvalidateA; // 刷新时不重新计算背景(可以加快显示速度)
begin
  inherited Invalidate;
end;
                           
procedure TTransPanel.Paint;
var
r:trect;
begin
  inherited;
  r:=rect(0,0,width,height);
  self.BuildBkgnd;
  bitblt(Canvas.handle, 0, 0, width, height, FBkgnd.Canvas.Handle, 0, 0, SRCCOPY);
  canvas.Brush.Style:=bsclear;
  canvas.Pen:=fpbpen;
  canvas.Pen.Color:=fpbpen.Color;
  canvas.Pen.Style:=fpbpen.Style;
  canvas.Pen.Width:=fpbpen.Width;
  case fpb of
  pbup:frame3d(canvas,r,clwhite,clblack,fpbpen.Width);
  pbdown:frame3d(canvas,r,clblack,clwhite,fpbpen.Width);
  pbnormal:frame3d(canvas,r,fpbpen.Color ,fpbpen.Color,fpbpen.Width);
  end;
end;

procedure TTransPanel.setbmp(const Value: tbitmap);
begin
  fbmp.Assign(value);
  invalidate;
end;

procedure TTransPanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  if ftransparentrate > 0 then    // 移动时能获得正确的背景
    invalidate;
  inherited;
end;

procedure TTransPanel.setbp(const Value: tpanelborder);
begin
  fpb := Value;
  invalidate;
end;

procedure TTransPanel.SetParent(AParent: TWinControl);
begin
  inherited SetParent(AParent);
  if (AParent <> nil) and AParent.HandleAllocated
  and (GetWindowLong(AParent.Handle, GWL_STYLE) and WS_CLIPCHILDREN <> 0)
  then
    SetWindowLong(AParent.Handle, GWL_STYLE,
             GetWindowLong(AParent.Handle, GWL_STYLE) 
             and not WS_CLIPCHILDREN);
end;

procedure TTransPanel.setpbpen(const Value: tpen);
begin
  fpbpen.Assign(value);
  invalidate;
end;

procedure TTransPanel.SetTransparentRate(value: Integer);
begin
  if (value <0) or (value > 100) then exit;
  if value <> FTransparentRate then
  begin
    FTransparentRate := value;
    Invalidate;
  end;
end;

procedure TTransPanel.WMEraseBkgnd(var Msg: TMessage);
begin
Msg.Result := 1;
end;

end.