用TcustomControl繼承設計的圖型元件如何檢知前景有變化! |
答題得分者是:pedro
|
bill534
一般會員 ![]() ![]() 發表:38 回覆:51 積分:17 註冊:2007-02-22 發送簡訊給我 |
我用TCustomControl繼承後寫了一個LED元件,顯示上出現問題就是當有Dialog出現在它上一層時,拖拉都會更新(重繪),但只要是在它前面關掉Dialog就會有殘影的問題!
unit MyLedArray; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls; type TMonitorEvent = procedure(Sender: TObject; nIndex: integer; nCaption: string) of object; // TMyLedArray = class(TCustomControl) private DrawAll: Integer; { Private declarations } FOnColor: TColor; FBorderColor: TColor; FCaption: TStrings; FCaptionForOff: TStrings; FCaptionForOn: TStrings; FCount: Integer; FMonitor: TBits; { Private declarations } FOffColor: TColor; FOnMonitor: TMonitorEvent; FCaptionSpace: Integer; FRowSpace: Integer; function GetCaption: TStrings; function GetCaptionForOff: TStrings; function GetCaptionForOn: TStrings; function GetMonitor(Index: Integer): Boolean; procedure SetCaption(const Value: TStrings); procedure SetCaptionForOn(const Value: TStrings); procedure SetCaptionForOff(const Value: TStrings); procedure SetCount(const Value: Integer); procedure SetfOnColor(Value: TColor); procedure SetFBorderColor(Value: TColor); procedure SetfOffColor(Value: TColor); procedure SetMonitor(Index: Integer; const Value: Boolean); procedure SetCaptionSpace(const Value: Integer); procedure SetRowSpace(const Value: Integer); protected procedure Paint; override; procedure DrawLed; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure WMEraseBkGnd(var Message: TMessage); message WM_EraseBkGnd; public { Public declarations } constructor Create(AOwner: TComponent); override; destructor Destroy; override; property Monitor[Index: Integer]: Boolean read GetMonitor write SetMonitor; published property Align; property Anchors; property Font; property OnColor: TColor read FOnColor write SetfOnColor; property BorderColor: TColor read FBorderColor write SetFBorderColor; property Caption: TStrings read GetCaption write SetCaption; property CaptionForOn: TStrings read GetCaptionForOn write SetCaptionForOn; property CaptionForOff: TStrings read GetCaptionForOff write SetCaptionForOff; property Count: Integer read FCount write SetCount; property OffColor: TColor read FOffColor write SetfOffColor; property OnMonitor: TMonitorEvent read FOnMonitor write FOnMonitor; property CaptionSpace: Integer read FCaptionSpace write SetCaptionSpace; property RowSpace: Integer read FRowSpace write SetRowSpace; end; procedure Register; implementation //{$R *.RES} {--------------------------------------------------------------------------------------------------} constructor TMyLedArray.Create(AOwner: TComponent); begin inherited; Parent := TWinControl(AOwner); // ControlStyle := ControlStyle [csAcceptsControls, csOpaque] - [csAcceptsControls]; FOnColor := clGreen; FOffColor := clYellow; FBorderColor := $00F6ACA5; FCaptionSpace := 3; FRowSpace := 3; FCount := 1; // FMonitor := TBits.Create; FCaption := TStringList.Create; FCaptionForOn := TStringList.Create; FCaptionForOff := TStringList.Create; // DrawAll := -1; end; {constructor} {--------------------------------------------------------------------------------------------------} destructor TMyLedArray.Destroy; begin FMonitor.Free; FCaption.Free; FCaptionForOn.Free; FCaptionForOff.Free; inherited; end; {destructor} {--------------------------------------------------------------------------------------------------} procedure TMyLedArray.SetfOnColor(Value: TColor); begin if (FOnColor <> Value) then begin FOnColor := Value; Invalidate; end; {if} end; {SetfPaperColor} {--------------------------------------------------------------------------------------------------} procedure TMyLedArray.SetFBorderColor(Value: TColor); begin if (FBorderColor <> Value) then begin FBorderColor := Value; Invalidate; end; {if} end; {SetfLineColor} {--------------------------------------------------------------------------------------------------} procedure TMyLedArray.WMEraseBkGnd(var Message: TMessage); begin Drawall := -1; Message.Result := 1; end; {WMEraseBkGnd} {--------------------------------------------------------------------------------------------------} procedure TMyLedArray.DrawLed; const Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER); WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK); var Rect: TRect; s1: string; sh, sw, n1, n2: integer; begin canvas.Lock; try Canvas.Font := Font; with Canvas do begin sh := TextHeight('A') 6; Brush.Color := TWincontrol(Parent).Brush.Color; if Drawall = -1 then FillRect(ClientRect); if Count = 0 then begin DrawAll := -1; exit; end; // draw edge pen.Style := psSolid; Pen.Color := FBorderColor; Pen.Width := 1; n1 := 0; for n2 := 0 to FCount - 1 do begin if (Drawall = -1) or (DrawAll = n2) then begin if FCaption.Count > 0 then begin if FCaption.Strings[n2] <> '' then sw := TextWidth(FCaption.Strings[n2]) 10 else sw := 16; end else sw := 16; Rectangle(0, n1, sw - 1, n1 sh - 1); Rectangle(1, n1 1, sw - 2, n1 sh - 2); // Brush.Color := FOffColor; if FMonitor.Size > 0 then begin if n2 < FMonitor.Size then begin if FMonitor.Bits[n2] then Brush.Color := FOnColor else Brush.Color := FOffColor; end; end; Rect.Left := 2; Rect.Top := n1 2; Rect.Bottom := Rect.Top sh - 5; Rect.right := Rect.Left sw - 5; FillRect(Rect); // draw inside caption if FCaption.Count > 0 then begin if n2 < FCaption.Count then if FCaption.Strings[n2] <> '' then DrawText(Handle, PChar(FCaption.Strings[n2]), -1, Rect, DT_CENTER or DT_VCENTER or DT_SINGLELINE); end; // draw outside caption s1 := 'Undefined'; if FMonitor.Size > 0 then begin if n2 < FMonitor.Size then begin if (FCaptionForOn.Count > 0) and (FCaptionForOff.Count > 0) and (FCaptionForOn.Count = FCaptionForOff.Count) and (n2 < FCaptionForOn.Count) then begin if FMonitor.Bits[n2] then s1 := FCaptionForOn.Strings[n2] else s1 := FCaptionForOff.Strings[n2]; end; end; end; Brush.Style := bsClear; Rect.Left := Rect.right FCaptionSpace; Rect.Top := n1; Rect.Bottom := n1 sh; Rect.right := ClientWidth; DrawText(Handle, PChar(s1), -1, Rect, DT_LEFT or DT_VCENTER or DT_WORDBREAK or DT_SINGLELINE); // strlen(pchar(s1)) end; // next led n1 := n1 sh FRowSpace; end; end; {with} finally canvas.Unlock; DrawAll := -1; end; end; {DrawNotebook} function TMyLedArray.GetCaption: TStrings; begin // TODO -cMM: TMyLedArray.GetCaption default body inserted Result := FCaption; end; function TMyLedArray.GetCaptionForOff: TStrings; begin // TODO -cMM: TMyLedArray.GetCaptionForOff default body inserted Result := FCaptionForOff; end; function TMyLedArray.GetCaptionForOn: TStrings; begin // TODO -cMM: TMyLedArray.GetCaptionForOn default body inserted Result := FCaptionForOn; end; function TMyLedArray.GetMonitor(Index: Integer): Boolean; begin Result := False; if FMonitor.Size > 0 then if Index < FMonitor.Size then Result := FMonitor.Bits[index]; end; procedure TMyLedArray.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(Acomponent, Operation); if Operation = opRemove then begin end; end; {--------------------------------------------------------------------------------------------------} procedure TMyLedArray.Paint; begin Drawled; end; {Paint} procedure TMyLedArray.SetCaption(const Value: TStrings); begin if FCaption <> Value then begin FCaption.Assign(Value); DrawAll := -1; Invalidate; end; end; procedure TMyLedArray.SetCaptionForOn(const Value: TStrings); begin if FCaptionForOn <> Value then begin FCaptionForOn.Assign(Value); if FCaptionForOff.Count = 0 then FCaptionForOff.Assign(Value); DrawAll := -1; Invalidate; end; end; procedure TMyLedArray.SetCaptionForOff(const Value: TStrings); begin if FCaptionForOff <> Value then begin FCaptionForOff.Assign(Value); if FCaptionForOn.Count = 0 then FCaptionForOn.Assign(Value); DrawAll := -1; Invalidate; end; end; procedure TMyLedArray.SetCount(const Value: Integer); var n1: integer; begin if FCount <> Value then begin if Fcaption.Count <> Value then FCaption.Clear; if FCaptionForOn.Count <> Value then FCaptionForOn.Clear; if FCaptionForOff.Count <> Value then FCaptionForOff.Clear; // FMonitor.Size := Value; FCount := Value; DrawAll := -1; Invalidate; end; end; {--------------------------------------------------------------------------------------------------} procedure TMyLedArray.SetfOffColor(Value: TColor); begin if (FOffColor <> Value) then begin FOffColor := Value; DrawAll := -1; Invalidate; end; {if} end; {SetfPaperColor} procedure TMyLedArray.SetMonitor(Index: Integer; const Value: Boolean); var s1: string; begin if Fmonitor.Size > 0 then if Index < Fmonitor.Size then if FMonitor.Bits[index] <> Value then begin FMonitor.Bits[index] := Value; DrawAll := Index; Invalidate; // s1 := ''; if fCaption.Count > 0 then if index < Fcaption.Count then s1 := fCaption.Strings[index]; if Assigned(FOnMonitor) then FOnMonitor(self, Index, s1); end; end; procedure TMyLedArray.SetCaptionSpace(const Value: Integer); begin if FCaptionSpace <> Value then begin FCaptionSpace := Value; DrawAll := -1; Invalidate; end; end; procedure TMyLedArray.SetRowSpace(const Value: Integer); begin if FRowSpace <> Value then begin FRowSpace := Value; DrawAll := -1; Invalidate; end; end; {--------------------------------------------------------------------------------------------------} procedure Register; begin RegisterComponents('myVCL', [TMyLedArray]); end; {Register} {--------------------------------------------------------------------------------------------------} end. |
pedro
尊榮會員 ![]() ![]() ![]() ![]() ![]() ![]() 發表:152 回覆:1187 積分:892 註冊:2002-06-12 發送簡訊給我 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |