我用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.

答案就在這一行
procedure Paint; override;
要實作它