繼承TCustomPanel，重繪元件後其他窗體停駐其上遮擋部份會消失

發表時間：2010-04-06 10:25:09

IP:122.116.xxx.xxx 訂閱

感謝各位前輩幫忙view這個問題，雖然沒有解決辦法，不過我用Delphi改寫這個元件後，問題已經解決了，這邊貼上原始碼給以後有遇到相同問題的人了

[code delphi]
unit WBEntity;
interface
uses
SysUtils, Classes, Controls, ExtCtrls, ComCtrls, Forms, Graphics, Windows, Messages;
type
EntityBorderStyle = (ebsSolid, ebdDash);
EntityCornerStyle = (ecsNormal, ecsRoundSmall, ecsRoundMedium, ecsRoundLarge, ecsRoundExtraLarge);
TWBEntity = class(TCustomControl)
private
{ Private declarations }
FBorderColor: TColor;
FBorderStyle: EntityBorderStyle;
FCornerStyle: EntityCornerStyle;
FEntityColor: TColor;
FEntityName: UnicodeString;
FEntityNote: UnicodeString;
FSelected: Boolean;
procedure SetBorderColor(Value: TColor);
procedure SetBorderStyle(Value: EntityBorderStyle);
procedure SetCornerStyle(Value: EntityCornerStyle);
procedure SetEntityColor(Value: TColor);
procedure SetEntityName(Value: UnicodeString);
procedure SetEntityNote(Value: UnicodeString);
protected
{ Protected declarations }
procedure CreateParams(var Params: TCreateParams); override;
procedure Paint; override;
procedure Click; override;
procedure DblClick; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer); override;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Published declarations }
property BorderColor: TColor read FBorderColor write SetBorderColor;
property BorderStyle: EntityBorderStyle read FBorderStyle write SetBorderStyle;
property CornerStyle: EntityCornerStyle read FCornerStyle write SetCornerStyle;
property EntityColor: TColor read FEntityColor write SetEntityColor;
property EntityName: UnicodeString read FEntityName write SetEntityName;
property EntityNote: UnicodeString read FEntityNote write SetEntityNote;
property OnClick;
property OnDblClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;
implementation
constructor TWBEntity.Create(AOwner: TComponent);
begin
inherited;
FBorderColor := $00000000;
FEntityColor := $00FFFFFF;
FCornerStyle := ecsRoundMedium;
end;
destructor TWBEntity.Destroy;
begin
inherited;
end;
procedure TWBEntity.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
end;
procedure TWBEntity.Paint;
var
HwndRect: HWND;
CtrlRect: TRect;
NameRect: TRect;
CrnrSpan: Integer;
begin
CtrlRect := Self.Canvas.ClipRect;
Self.Canvas.Pen.Mode := pmCopy;
Self.Canvas.Pen.Color := FBorderColor;
Self.Canvas.Brush.Color := FEntityColor;
case FCornerStyle of
ecsNormal:
begin
CrnrSpan := 0;
end;
ecsRoundSmall:
begin
CrnrSpan := 4;
end;
ecsRoundMedium:
begin
CrnrSpan := 6;
end;
ecsRoundLarge:
begin
CrnrSpan := 10;
end;
ecsRoundExtraLarge:
begin
CrnrSpan := 18;
end;
end;
HwndRect := CreateRoundRectRgn(0, 0, CtrlRect.Right - CtrlRect.Left, CtrlRect.Bottom - CtrlRect.Top, CrnrSpan - 2, CrnrSpan - 2);
SetWindowRgn(Self.Handle, HwndRect, True);
DeleteObject(HwndRect);
Self.Canvas.RoundRect(0, 0, CtrlRect.Right - CtrlRect.Left - 1, CtrlRect.Bottom - CtrlRect.Top - 1, CrnrSpan, CrnrSpan);
Inc(CtrlRect.Top);
Inc(CtrlRect.Left);
Dec(CtrlRect.Right);
Dec(CtrlRect.Bottom);
NameRect := CtrlRect;
NameRect.Top := NameRect.Top 4;
NameRect.Left := NameRect.Left 4;
NameRect.Right := NameRect.Right - 4;
NameRect.Bottom := NameRect.Top Self.Canvas.TextHeight(FEntityName) 4;
Self.Canvas.Brush.Style := bsClear;
Self.Canvas.TextRect(NameRect, FEntityName, [tfCenter, tfEndEllipsis]);
Self.Canvas.MoveTo(NameRect.Left, NameRect.Bottom);
Self.Canvas.LineTo(NameRect.Right, NameRect.Bottom);
end;
procedure TWBEntity.Click;
begin
inherited;
end;
procedure TWBEntity.DblClick;
begin
inherited;
end;
procedure TWBEntity.MouseDown;
begin
inherited;
end;
procedure TWBEntity.MouseMove;
begin
inherited;
end;
procedure TWBEntity.MouseUp;
begin
inherited;
end;
procedure TWBEntity.CMMouseEnter(var Message: TMessage);
begin
inherited;
end;
procedure TWBEntity.CMMouseLeave(var Message: TMessage);
begin
inherited;
end;
procedure TWBEntity.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
inherited;
end;
procedure TWBEntity.SetBorderColor(Value: TColor);
begin
if FBorderColor <> Value then
begin
FBorderColor := Value;
Invalidate;
end;
end;
procedure TWBEntity.SetBorderStyle(Value: EntityBorderStyle);
begin
if FBorderStyle <> Value then
begin
FBorderStyle := Value;
Invalidate;
end;
end;
procedure TWBEntity.SetCornerStyle(Value: EntityCornerStyle);
begin
if FCornerStyle <> Value then
begin
FCornerStyle := Value;
Invalidate;
end;
end;
procedure TWBEntity.SetEntityColor(Value: TColor);
begin
if FEntityColor <> Value then
begin
FEntityColor := Value;
Invalidate;
end;
end;
procedure TWBEntity.SetEntityName(Value: UnicodeString);
begin
if FEntityName <> Value then
begin
FEntityName := Value;
Invalidate;
end;
end;
procedure TWBEntity.SetEntityNote(Value: UnicodeString);
begin
if FEntityNote <> Value then
begin
FEntityNote := Value;
Invalidate;
end;
end;
end.
[/code]