还想问个问题，如何实现半透明菜单呢（不好意思拉）

将一个FORM变成透明的实质性手段就是拦截CMEraseBkgnd消息。unit Utransform; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TForm1 = class(TForm)private { Private declarations }public { Public declarations }PROCEDURE CMEraseBkgnd(var Message:TWMEraseBkgnd);Message WM_ERASEBKGND;end;var Form1: TForm1;implementation{$R *.DFM}PROCEDURE Tform1.CMEraseBkgnd(var Message:TWMEraseBkgnd);BEGINbrush.style:=bsClear;Inherited;END;end.//////////////////////////////////////
procedure TForm1.FormCreate(Sender: TObject);
begin
  Form1.Brush.Style := bsClear;
  Form1.BorderStyle := bsNone
end;procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  Application.Terminate;
end;
/////////////////////////////////////////////
用透明的控件呗. 一般继承自TGraphicControl的
(就是那些没有handle属性, 不能有focus的控件, 如image)
都有Transparent属性. 对TWinControl类的控件, 要实现透明只要完成以下
四步基本上就成了.
1.在Create中设定ControlStyle :=
ControlStyle - [csOpaque];)
2. override 它的CreateParams方法, exstyle 里加上WS_EX_TRANSPARENT.
3. 修改它的parent的window style, 去掉WS_CLIPCHILDREN.  inherited CreateParams(Params);
  with Params do
  begin
  { 完全重画 }
    Style := Style and not WS_CLIPCHILDREN;
    Style := Style and not WS_CLIPSIBLINGS;
  { 增加透明 }
    ExStyle := ExStyle or WS_EX_TRANSPARENT;
  end;
4. 截获WM_ERASEBKGND, 什么都不做直接返回1.(不搽除背景）
一般有上面3步能成. 有些控件比如TPanel, 在它的paint中用了fillrect, 所以要实现透明的话还要override 它的paint方法，自己画.
按钮透明需要进一步处理.
createparams里加上style := style or BS_OWNERDRAW;
然后在WM_DRAWITEM中自己画吧unit TransButton;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;type
TTransButton = class(TButton)
private
  FTransparent : Boolean;

  procedure SetTransparent(Value: Boolean);
  procedure WMEraseBkgnd(var Msg: TMessage); message WM_ERASEBKGND;
protected
  procedure CreateParams(var Params: TCreateParams); override;
  procedure SetParent(AParent: TWinControl); override;
published
  property Transparent: Boolean read FTransparent write SetTransparent;
end;procedure Register;implementationprocedure Register;
begin
  RegisterComponents('CX Lib', [TTransButton]);
end;procedure TTransButton.SetTransparent(Value: Boolean);
begin
  if ftransparent <> value then
  begin
    ftransparent := value;
    if value then
      controlstyle := controlstyle - [csOpaque]
    else
      controlstyle := controlstyle + [csOpaque];
    invalidate;
  end;
end;procedure TTransButton.WMEraseBkgnd(var Msg: TMessage);
var
  br: HBRUSH;
begin
  if ftransparent then
    msg.result := 1
  else
    inherited;
end;procedure TTransButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  params.exstyle := params.exstyle or WS_EX_TRANSPARENT;
end;procedure TTransButton.SetParent(AParent: TWinControl);
begin
  inherited SetParent(AParent);
  if (aparent <> nil) and aparent.HandleAllocated
    and (GetWindowLong(aparent.Handle, GWL_STYLE) or WS_CLIPCHILDREN <> 0) then
    SetWindowLong(aparent.handle, GWL_STYLE, GetWindowLong(aparent.Handle, GWL_STYLE)
                                            and not WS_CLIPCHILDREN);
end;end.
//////////////////////////////////////////////////////////////
透明的TPanel
type
  TPanelBorder = set of (pbInnerRaised, pbInnerSunk, pbOuterRaised, pbOuterSunk);
  TTrPanel = class(TCustomPanel)
  private
    FTransparentRate : Integer;     // 透明度

    FBkGnd : TBitmap;               // 背景buffer

    procedure SetTransparentRate(value: Integer);

    procedure WMEraseBkgnd(var Msg: TMessage); message WM_ERASEBKGND;

  protected
    procedure BuildBkgnd; virtual;         // 生成半透明的背景
    procedure SetParent(AParent : TWinControl); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Paint; override;
  public
    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
    property TransparentRate: Integer read FTransparentRate write SetTransparentRate;
    property ......
     ........          // 可以抄TPanel里面的
  end;procedure Register;implimentation
procedure Register;
begin
  RegisterComponent('Samples', [TTrPanel]);
end;procedure TTrPanel.SetTransparentRate(value: Integer);
begin
  if (value <0) or (value > 100) then exit;
  if value <> FTransparentRate then
  begin
    FTransparentRate := value;
    Invalidate;
  end;
end;procedure TTrPanel.WMEraseBkgnd(var Msg: TMessage);
begin
  Msg.Result := 1;
end;procedure TTrPanel.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 TTrPanel.CreateParams(.....);
begin
  inherited CreateParams(Params);
  params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT;
end;procedure TTrPanel.Paint;
begin
  if not assigned(FBkgnd) then
    BuildBkgnd;
  bitblt(Canvas.handle, 0, 0, width, height, FBkgnd.Canvas.Handle, 0, 0, SRCCOPY);
    ........
    ........    // 画边框, 画caption等, 就不写了.
end;
type
  T24Color = record
    b, g, r: Byte;
  end;
  P24Color := ^T24Color;procedure TTrPanel.BuildBkgnd;
var
  p, p1: P24Color;
  C : LongInt;
  i, j: Integer;
begin
  FBkgnd := TBitmap.Create;
  FBkgnd.PixelFormat := pf24Bit;
  FBkgnd.Width := Width;
  FBkgnd.Height := Height;
  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(fFBkgnd.canvas.handle, c);
    deleteobject(c);
  end;
  controlstyle := controlstyle + [csOpaque];   // 背景没有变化时的重画不会出现闪烁
end;
Constructor TTrPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fbkgnd := nil;
  fTransparentRate := 0;
end;Destructor TTrPanel.Destroy;
begin
  if assigned(fbkgnd) then
    fbkgnd.free;
  inherited;
end;procedure TTrPanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  if ftransparentrate > 0 then    // 移动时能获得正确的背景
    invalidate;
  inherited;
end;procedure TTrPanel.Invalidate;    // 刷新时重新计算背景
begin
  if assigned(fbkgnd) then
  begin
    fbkgnd.free;
    fbkgnd := nil;
    controlstyle := constrolstyle - [csOpaque];
  end;
  inherited;
end;procedure TTrPanel.InvalidateA;  // 刷新时不重新计算背景(可以加快显示速度)
begin
  inherited Invalidate;
end;end.
//////////////////////////////////////////////
unit homepage_coolform;interfaceuses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Buttons;type TForm1 = class(TForm)
  procedure FormPaint(Sender: TObject);
  procedure FormShow(Sender: TObject);
  procedure FormDestroy(Sender: TObject);
private   { Private declarations }
public  { Public declarations }
  hbmp:integer;
end;var Form1: TForm1;implementation
{$R *.DFM}
function CopyScreenToBitmap(Rect:TREct):integer;
var
  hScrDC, hMemDC, hBitmap, hOldBitmap:integer;
  nX, nY, nX2, nY2: integer;
  nWidth, nHeight:integer;
  xScrn, yScrn:integer;
begin
if (IsRectEmpty(Rect)) then
begin
  result:= 0;
  exit;
end; // 获得屏幕缓冲区的句柄.
// a memory DC compatible to screen DC
hScrDC:= CreateDC('DISPLAY', pchar(0), pchar(0), PDeviceModeA(0));
hMemDC:= CreateCompatibleDC(hScrDC);
// get points of rectangle to grab
nX := rect.left;
nY := rect.top;
nX2 := rect.right;
nY2 := rect.bottom;
// get screen resolution
xScrn:= GetDeviceCaps(hScrDC, HORZRES);
yScrn := GetDeviceCaps(hScrDC, VERTRES);
//make sure bitmap rectangle is visible
if (nX <0) then
            nX :="0;"
      if (nY < 0) then
            nY :="0;"
      if (nX2> xScrn) then
  nX2 := xScrn;
if (nY2 > yScrn) then
  nY2 := yScrn;
nWidth := nX2 - nX;
nHeight := nY2 - nY;
// create a bitmap compatible with the screen DC
hBitmap := CreateCompatibleBitmap(hScrDC, nWidth, nHeight);
// select new bitmap into memory DC
hOldBitmap := SelectObject(hMemDC, hBitmap);
// bitblt screen DC to memory DC
BitBlt(hMemDC, 0, 0, nWidth, nHeight, hScrDC, nX, nY, SRCCOPY);
// select old bitmap back into memory DC and get handle to
// bitmap of the screen
hBitmap := SelectObject(hMemDC, hOldBitmap);
// clean up
DeleteDC(hScrDC);
DeleteDC(hMemDC);
result:= hBitmap;
end;procedure TForm1.FormShow(Sender: TObject);
Var
rect:TRect;
p:TPoint;
begin
rect:=ClientRect;
p:=ClientOrigin;
rect.left:=p.x;
rect.top:=p.y;
rect.bottom:=rect.bottom+p.y;
rect.right:=rect.right+p.x;
hbmp:=copyScreenToBitmap(rect);
inherited;
end;procedure TForm1.FormPaint(Sender: TObject);
var
bitmap:TBitmap;
rect:TRect;
begin
bitmap:=TBitmap.create;
bitmap.handle:=hbmp;
rect:=ClientRect;
canvas.draw(rect.left,rect.top,bitmap);
bitmap.handle:=0;
bitmap.free;
end;procedure TForm1.FormDestroy(Sender: TObject);
begin
DeleteObject(hbmp);
end;end.
////////////////////////////////////////////type
  TBackgroundStyle = (bsOpaque, bsTransparent);  TCustomButtonPanel = class(TScrollBox)
    private
      FCanvas: TCanvas;  { Need a Canvas }
    protected
      procedure WMSize(var Message: TWMSize); message WM_SIZE;
      procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
      procedure WMMove(var Message: TWMMove); message WM_MOVE;
      procedure CreateParams(var Params: TCreateParams); override;
      procedure PaintWindow(DC: HDC); override;
      procedure Paint; virtual;
      procedure InvalidateFrame;
      property BackgroundStyle:  TBackgroundStyle
            read FBackgroundStyle
            write SetBackgroundStyle
            default bsOpaque;
      ... other stuff snipped ...
    public
      constructor Create(AOwner: TComponent); override;
      property Canvas: TCanvas read FCanvas;
      ... other stuff snipped ...
  end;... other code and stuff snipped ...implementationconstructor TCustomButtonPanel.Create(AOwner: TComponent);
begin
  FBackgroundStyle := bsOpaque;
  inherited Create(AOwner);
  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
                   csSetCaption, csOpaque, csDoubleClicks];
  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;
end;procedure TCustomButtonPanel.SetBackgroundStyle(Value:TBackgroundStyle);
begin
  { BackgroundStyle Set Property Handler }
  if Value <> FBackgroundStyle then begin
    FBackgroundStyle := Value;
    RecreateWnd;
  end;
end;procedure TCustomButtonPanel.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do begin
    if FBackgroundStyle = bsOpaque then
      ExStyle := ExStyle and not Ws_Ex_Transparent
    else
      ExStyle := ExStyle or Ws_Ex_Transparent;
  end;
end;procedure TCustomButtonPanel.PaintWindow(DC: HDC);
begin
  { Setup the canvas and call the Paint routine }
  FCanvas.Handle := DC;
  try
    Paint;
  finally
    FCanvas.Handle := 0;
  end;
end;procedure TCustomButtonPanel.Paint;
var
  theRect: TRect;
begin
  with canvas do
    brush.Color := Self.Color;
    theRect := GetClientRect;
    if FBackgroundStyle = bsOpaque then
      FillRect(theRect);
  ... other code and stuff snipped ...
  end;
end;procedure TCustomButtonPanel.InvalidateFrame;
var
  R: TRect;
begin
  { Handle invalidation after move in designer }
  R := BoundsRect;
  InflateRect(R, 1, 1);
  InvalidateRect(Parent.Handle, @R, True);
end;procedure TCustomButtonPanel.WMMove(var Message: TWMMove);
begin
  if (csDesigning in ComponentState) then
    InvalidateFrame;
  inherited;
end;///////////////////////////////////////////////////
1. 使RichEdit的窗口透明. SetWindowLong(RichEdit.Handle, GWL_EXSTYLE, GetWindowLong(RichEdit.Handle,GWL_EXSTYLE) or WS_EX_TRANSPARENT);2. 截获RichEdit的Wndproc, 处理以下消息:
    CN_CTLCOLORMSGBOX..CN_CTLCOLORSTATIC: 返回一个NullBrush的handle
(防止编辑状态时清除背景).
    WM_ERASEBKGND: 什么都不做就返回1(防止窗口在刷新时清除背景)               －－－－刚好在HUBDOG整理的葵花宝典中看到此文章。
               －－－－借贴。
               －－－－供参考，为尊重作者，原文未做任何改动。
               －－－－别给我分！！！！！！！

调试易

还想问个问题，如何实现半透明菜单呢（不好意思拉）

解决方案 »