Post by Hans-Peter DiettrichPost by PeterWenn Du ein Bißchen Geduld hast kann ich am Wochenende ein Beispiel
produzieren.
Das wäre nett :-)
OK, hier ist es. Pack's in eine Designtime-Package und wirf ein
TDemoPanel auf ein Form. Ich habe das mit XE2 entwickelt, aber die Unit
sollte auch mit älteren Delphi-Versionen funktionieren.
unit demoPanelU;
interface
uses
Windows, SysUtils, Classes, Controls, ExtCtrls;
type
TMyRect = class(TPersistent)
private
FOnChange: TNotifyEvent;
FRect: TRect;
protected
procedure Change; virtual;
function GetHeight: Integer;
function GetWidth: Integer;
procedure SetAsTRect(const Value: TRect);
procedure SetHeight(const Value: Integer);
procedure SetLeft(const Value: Integer);
procedure SetTop(const Value: Integer);
procedure SetWidth(const Value: Integer);
public
constructor Create; virtual;
procedure Assign(Source: TPersistent); override;
property AsTRect: TRect read FRect write SetAsTRect;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
published
property Left: Integer read FRect.Left write SetLeft;
property Height: Integer read GetHeight write SetHeight;
property Top: Integer read FRect.Top write SetTop;
property Width: Integer read GetWidth write SetWidth;
end;
TDemoPanel = class(TPanel)
private
FRect: TMyRect;
procedure SetRect(const Value: TMyRect);
protected
procedure RectChanged(Sender: TObject);
procedure Paint; override;
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
published
property Rect: TMyRect read FRect write SetRect;
end;
procedure Register;
implementation
uses
Graphics;
procedure Register;
begin
RegisterComponents('Samples', [TDemoPanel]);
end;
constructor TDemoPanel.Create(aOwner: TComponent);
begin
inherited Create(aOwner);
FRect := TMyRect.Create;
FRect.OnChange := RectChanged;
end;
destructor TDemoPanel.Destroy;
begin
FRect.Free;
inherited Destroy;
end;
procedure TDemoPanel.Paint;
begin
inherited;
Canvas.Brush.Color := clYellow;
Canvas.FillRect(Rect.AsTRect);
end;
procedure TDemoPanel.RectChanged(Sender: TObject);
begin
Invalidate;
end;
procedure TDemoPanel.SetRect(const Value: TMyRect);
begin
FRect.Assign(Value);
end;
// Initialize FRect to some sensible default
constructor TMyRect.Create;
begin
inherited;
FRect := Rect(5, 5, 25, 25);
end;
procedure TMyRect.Assign(Source: TPersistent);
begin
if Source is TMyRect then begin
FRect := TMyRect(Source).FRect;
Change;
end
else
inherited;
end;
procedure TMyRect.Change;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
function TMyRect.GetHeight: Integer;
begin
Result := FRect.Bottom - FRect.Top
end;
function TMyRect.GetWidth: Integer;
begin
Result := FRect.Right - FRect.Left;
end;
procedure TMyRect.SetAsTRect(const Value: TRect);
begin
FRect := Value; // should validate left < Top etc.
Change;
end;
procedure TMyRect.SetHeight(const Value: Integer);
begin
if Value < 0 then
FRect.Top := FRect.Bottom + Value
else
FRect.Bottom := FRect.Top + Value;
Change;
end;
procedure TMyRect.SetLeft(const Value: Integer);
begin
OffsetRect(FRect, Value - Frect.Left, 0);
Change;
end;
procedure TMyRect.SetTop(const Value: Integer);
begin
OffsetRect(FRect, 0, Value - FRect.Top);
Change;
end;
procedure TMyRect.SetWidth(const Value: Integer);
begin
if Value < 0 then
FRect.Left := FRect.Right + Value
else
FRect.Right := FRect.Left + Value;
Change;
end;
end.
--
Peter Below