繼承TCustomPanel,重繪元件後其他窗體停駐其上遮擋部份會消失 |
缺席
|
erinus
一般會員 發表:1 回覆:1 積分:0 註冊:2004-07-09 發送簡訊給我 |
各位前輩
我的專案是CB2010,打包如下 我的WBEntity繼承自TCustomPanel,我在Paint裡重繪,可正常顯示,但奇怪的事是在我另外開個視窗去遮擋那元件繪出的部份區域後再將視窗移開,會發現元件被另個視窗擋道的部份會重繪的很奇怪,有時消失有時破碎,是不是要在WMEraseBkgnd作一些處理,我有按著查到的Delphi Code去改,可是沒用,程式碼及編譯完成的執行檔如附件,希望前輩們給我點意見,感謝各位前輩。 |
erinus
一般會員 發表:1 回覆:1 積分:0 註冊:2004-07-09 發送簡訊給我 |
感謝各位前輩幫忙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] |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |