透明的panel,为什么显示不出它原有的Caption....会的进来看看源码要改哪里 ( 积分: 50 )

  • 主题发起人 主题发起人 xuegaoyili
  • 开始时间 开始时间
X

xuegaoyili

Unregistered / Unconfirmed
GUEST, unregistred user!
下面的代码是一个叫Croco 的论坛网友写得.我看到后想加入一个Caption实现透明背景的同时显示panel的Caption.不能实现.知道的请指点

代码: 
unit Glass;

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 Caption;
    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.
 
下面的代码是一个叫Croco 的论坛网友写得.我看到后想加入一个Caption实现透明背景的同时显示panel的Caption.不能实现.知道的请指点

代码: 
unit Glass;

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 Caption;
    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.
 
帮顶,我也有过这样的问题,就是想把进度条上面放个label,然后调成透明的,也没有实现:(
 
Canvas.Draw(0, 0, Buffer);
{ 加上下面几句： }
Canvas.Brush.Style := bsClear;
DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_CENTER or DT_VCENTER);
Canvas.Brush.Style := bsSolid;
 
问题解决了.谢了楼上的
 
您必须登录或注册才可回复。

Similar threads

I
用delphi编程实现XP界面效果
回复
0
查看
645
import
I
I
图像旋转控件
回复
0
查看
641
import
I
I
关于类似UltraEdit的文件改变监视
回复
0
查看
614
import
I
I
窗体透明的讨论
回复
0
查看
629
import
I
冰
定时显示已用时间和剩余时间：WaitableTimer和线程封装的问题(200)
回复
1
查看
758
渡鸦
渡
后退
顶部