求透明的TPanel 马上接贴 解决方案 » 免费领取超大流量手机卡，每月29元包185G流量+100分钟通话, 中国电信官方发货 转贴unit TranPanel;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,ExtCtrls;typeTGlassStyle = (gsBlackness, gsDstInvert, gsMergeCopy, gsMergePaint, gsNotSrcCopy,gsNotSrcErase, gsPatCopy, gsPatInvert, gsPatPaint, gsSrcAnd,gsSrcCopy, gsSrcErase, gsSrcInvert, gsSrcPaint, gsWhiteness);TGlass = class(TCustomControl)privateFColor: 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;protectedBuffer: TBitmap;procedure CreateParams(var Params: TCreateParams); override;procedure Paint; override;procedure Resize; override;publicconstructor Create(AOwner: TComponent); override;destructor Destroy; override;property Canvas;publishedproperty 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;implementationprocedure Register;beginRegisterComponents('Croco', [TGlass]);end;function GlassStyleToInt(gs: TGlassStyle): LongInt;begincase gs ofgsBlackness : 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);begininherited 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;beginBuffer.Free;inherited Destroy;end;procedure TGlass.Paint;varR: TRect;rop: LongInt;beginR := 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);beginif Value <> FColor thenbeginFColor := Value;RecreateWnd;end;end;procedure TGlass.CreateParams(var Params: TCreateParams);begininherited CreateParams(Params);Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT;end;procedure TGlass.WMWindowPosChanging(var Message: TWMWindowPosChanging);beginInvalidate;inherited;end;procedure TGlass.WMEraseBkgnd(var Message: TMessage);beginMessage.Result := 0;end;procedure TGlass.Resize;beginInvalidate;inherited;end;procedure TGlass.CMCtl3DChanged(var Message: TMessage);begininherited;RecreateWnd;end;procedure TGlass.SetStyle(Value: TGlassStyle);beginif Value <> FStyle thenbeginFStyle := Value;RecreateWnd;end;end;end. 好象Raise这个第三方控件有~~~~~~~~~~ delphi 7 调用c#写的webservice的时候,返回了其他未调用方法的结果 有谁用过这个控件：DImageEn，是控制扫描仪的 如何进行两个文件大小的比较？ delphi的日期问题 急！急!急! 关于控件安装！！！ 给100分 delphi7的报表组件在哪？ 按钮事件中加入一行文本改变执行语句怎么加 ！！！！巨好消息！！！！Delphi 6有了中文版了！！！！！！ 部分成员不能在此发言 请问sq语句中select的top怎么用的，能否写个例子 一个关于TDBGridEh的简单问题 如何动态设置Access表的字段属性
unit TranPanel;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,ExtCtrls;typeTGlassStyle = (gsBlackness, gsDstInvert, gsMergeCopy, gsMergePaint, gsNotSrcCopy,gsNotSrcErase, gsPatCopy, gsPatInvert, gsPatPaint, gsSrcAnd,gsSrcCopy, gsSrcErase, gsSrcInvert, gsSrcPaint, gsWhiteness);TGlass = class(TCustomControl)privateFColor: 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;protectedBuffer: TBitmap;procedure CreateParams(var Params: TCreateParams); override;procedure Paint; override;procedure Resize; override;publicconstructor Create(AOwner: TComponent); override;destructor Destroy; override;property Canvas;publishedproperty 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;implementationprocedure Register;beginRegisterComponents('Croco', [TGlass]);end;function GlassStyleToInt(gs: TGlassStyle): LongInt;begincase gs ofgsBlackness : 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);begininherited 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;beginBuffer.Free;inherited Destroy;end;procedure TGlass.Paint;varR: TRect;rop: LongInt;beginR := 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);beginif Value <> FColor thenbeginFColor := Value;RecreateWnd;end;end;procedure TGlass.CreateParams(var Params: TCreateParams);begininherited CreateParams(Params);Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT;end;procedure TGlass.WMWindowPosChanging(var Message: TWMWindowPosChanging);beginInvalidate;inherited;end;procedure TGlass.WMEraseBkgnd(var Message: TMessage);beginMessage.Result := 0;end;procedure TGlass.Resize;beginInvalidate;inherited;end;procedure TGlass.CMCtl3DChanged(var Message: TMessage);begininherited;RecreateWnd;end;procedure TGlass.SetStyle(Value: TGlassStyle);beginif Value <> FStyle thenbeginFStyle := Value;RecreateWnd;end;end;end.