timgedit控件上放透明panel

{******************************************************************************}
{ @unitname     : utranspanel,pas                                              }
{ @author       : budded                                                       }
{ @description  : 透明 panel                                                   }
{ @fileversion  : 1.0.0.0                                                      }
{ @createdate   : 2005-08-24                                                   }
{ @lastupdate   : budded, 2005-08-24                                           }
{ @history      : created by budded, 2005-08-24 10:20                          }
{******************************************************************************}
unit utranspanel;

interface

uses
  windows, messages, sysutils, graphics, classes, controls, extctrls, buttons;

type
  ttransmode = （tmnone, tmsrccopy, tmsrcpaint, tmsrcand, tmsrcinvert, tmsrcerase,
    tmnotsrccopy, tmnotsrcerase, tmmergecopy, tmmergepaint,
    tmpatcopy, tmpatpaint, tmpatinvert, tmdstinvert, tmblackness, tmwhiteness);

  ttranspanel = class（tpanel)
  private
    { private declarations }
    ftransmode: ttransmode;

    procedure cmctl3dchanged（var message: tmessage); message cm_ctl3dchanged;
    procedure wmerasebkgnd（var message: tmessage); message wm_erasebkgnd;
    procedure wmwindowposchanging（var message: twmwindowposchanging); message wm_windowposchanging;
    function gettransmodeex: integer;
  protected
    { protected declarations }
    buffer: tbitmap;
    procedure createparams（var params: tcreateparams); override;
    procedure paint; override;
    procedure resize; override;
  public
    { public declarations }
    constructor create（aowner: tcomponent); override;
    destructor destroy（); override;
    property transmodeex: integer read gettransmodeex;
  published
    { published declarations }
    property transmode: ttransmode read ftransmode write ftransmode default tmsrccopy;
  end;

procedure register;

implementation

procedure register;
begin
  registercomponents（'budded', [ttranspanel]);
end;

{ ttranspanel }

procedure ttranspanel.cmctl3dchanged（var message: tmessage);
begin
  inherited;
  recreatewnd;
end;

constructor ttranspanel.create（aowner: tcomponent);
begin
  inherited;
  buffer := tbitmap.create;
  ftransmode := tmsrccopy;
end;

procedure ttranspanel.createparams（var params: tcreateparams);
begin
  inherited;
  params.exstyle := params.exstyle + ws_ex_transparent;
end;

destructor ttranspanel.destroy;
begin
  if assigned（buffer) then
    buffer.free;
  inherited;
end;

function ttranspanel.gettransmodeex: integer;
begin
  result := 0;
  case transmode of  //case
    tmnone: result := 0;
    tmsrccopy: result := srccopy;
    tmsrcpaint: result := srcpaint;
    tmsrcand: result := srcand;
    tmsrcinvert: result := srcinvert;
    tmsrcerase: result := srcerase;
    tmnotsrccopy: result := notsrccopy;
    tmnotsrcerase: result := notsrcerase;
    tmmergecopy: result := mergecopy;
    tmmergepaint: result := mergepaint;
    tmpatcopy: result := patcopy;
    tmpatpaint: result := patpaint;
    tmpatinvert: result := patinvert;
    tmdstinvert: result := dstinvert;
    tmblackness: result := blackness;
    tmwhiteness: result := whiteness;
  end;  // end case
end;

procedure ttranspanel.paint;
var
  rect: 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
//  inherited;

  rect := clientrect;//rect（0, 0, width, height);
  buffer.width := width;
  buffer.height := height;
  buffer.canvas.brush.style := bssolid;
  buffer.canvas.brush.color := color;
  buffer.canvas.fillrect（rect);
  stretchblt（buffer.canvas.handle, 0, 0, width, height,
    canvas.handle, 0, 0, width, height, transmodeex);

  if ctl3d then drawedge（buffer.canvas.handle, rect, bdr_raisedinner, bf_rect);

  if bevelouter <> bvnone then
  begin
    adjustcolors（bevelouter);
    frame3d（buffer.canvas, rect, topcolor, bottomcolor, bevelwidth);
  end;
  if bevelinner <> bvnone then
  begin
    adjustcolors（bevelinner);
    frame3d（buffer.canvas, rect, topcolor, bottomcolor, bevelwidth);
  end;

  buffer.canvas.pen.mode := pmcopy;
  buffer.canvas.pen.style := pssolid;

  canvas.draw（0, 0, buffer);
end;

procedure ttranspanel.resize;
begin
  inherited;
end;

procedure ttranspanel.wmerasebkgnd（var message: tmessage);
begin
  message.result := 0;
end;

procedure ttranspanel.wmwindowposchanging（var message: twmwindowposchanging);
begin
  invalidate;
  inherited;
end;

end.