OOP a Windows [5. Tvorba komponentov]

5. Tvorba komponentov

Na prednáške:

hierarchia komponentov v Delphi;
vytváranie vlastných komponentov.

Komponenty v Delphi

Všetky objektové triedy (typ class) sú odvodené od základnej triedy TObject:

TPersistant:
- metódy Assign, AssignTo ... dovoľujú priradiť hodnoty atribútov jedného objektu druhému objektu;
- metóda DefineProperties ... používa sa pri definovaní špeciálnych vlastností pri práci so streamami;
TComponent je potomkom TPersistant:
- objekty tejto triedy môžeme ukladať do formulára;
- predchodca nevizuálnych komponentov (TTimer);
- vlastnosti Components, ComponentCount ... sprístupňujú zoznam vlastnených komponentov;
TControl je potomkom TComponent:
- predchodca vizuálnych komponentov;
- vlastnosti BoundsRect, ClientRect, Visble ... poloha, rozmery, viditeľnosť;
- vlastnosť Parent ... rodič - miesto, na ktorom komponent leží.

Od TControl sú odvodené dve dôležité triedy:

TWinControl:
- trieda určená na tvorbu "windowsovksých" komponentov (TForm, TButton a pod.) ;
- objekty z tejto triedy zaberajú zdroje (tzv. resources) Windows;

TGraphicControl:
- komponenty, ktoré sú nemusia byť typu TWinControl (TLabel, TImage, TShape a ďalšie);
- do takýchto komponentov však nemôžeme ukladať iné komponenty.

Rozdiel medzi týmito triedami lepšie vysvetlíme na niektorej ďalšej prednáške. Zatiaľ budeme používať triedu TGraphicControl.

Vlastný komponent

Tieňovaný obdĺžnik:

unit ShadeBox;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls;

type
TShadeBoxKind=(sbkLeftRight, sbkRightLeft, sbkTopBottom, sbkBottomTop);
TShadeBox=class(TGraphicControl)
private
    FKind: TShadeBoxKind;
    procedure SetKind(Kind: TShadeBoxKind);
protected
    procedure Paint; override;
public
    constructor Create(Owner: TComponent); override;
published
    property Kind: TShadeBoxKind read FKind write SetKind;
    property Align;
    property Anchors;
    property Visible;
end;

procedure Register;

implementation

constructor TShadeBox.Create(Owner: TComponent);
begin
inherited;
FKind:=sbkTopBottom;
end;

type
TRGB=record
    case Boolean of
      False: (Value: Longint);
      True: (R, G, B, N: Byte);
end;

function RGB(A, B, X: Integer; ARGB, BRGB: TRGB): TRGB;
begin
if A=B then begin
    Result.R:=(ARGB.R+BRGB.R) div 2;
    Result.G:=(ARGB.G+BRGB.G) div 2;
    Result.B:=(ARGB.B+BRGB.B) div 2;
end else begin
    Result.R:=ARGB.R+MulDiv(BRGB.R-ARGB.R, X-A, B-A);
    Result.G:=ARGB.G+MulDiv(BRGB.G-ARGB.G, X-A, B-A);
    Result.B:=ARGB.B+MulDiv(BRGB.B-ARGB.B, X-A, B-A);
end;
Result.N:=0;
end;

procedure TShadeBox.Paint;
var
ARGB, BRGB: TRGB;
X, Y: Integer;
begin
if (Width<=0) or (Height<=0) then Exit;
ARGB.Value:=ColorToRGB(Color);
BRGB.R:=ARGB.R*3 div 4;
BRGB.G:=ARGB.G*3 div 4;
BRGB.B:=ARGB.B*3 div 4;
case Kind of
    sbkLeftRight:
      for X:=0 to Width-1 do begin
        Canvas.Brush.Color:=RGB(0, Width-1, X, ARGB, BRGB).Value;
        Canvas.FillRect(Bounds(X, 0, 1, Height));
      end;
    sbkRightLeft:
      for X:=0 to Width-1 do begin
        Canvas.Brush.Color:=RGB(0, Width-1, X, ARGB, BRGB).Value;
        Canvas.FillRect(Bounds(X, 0, 1, Height));
      end;
    sbkTopBottom:
      for Y:=0 to Height-1 do begin
        Canvas.Brush.Color:=RGB(0, Height-1, Y, ARGB, BRGB).Value;
        Canvas.FillRect(Bounds(0, Y, Width, 1));
      end;
    sbkBottomTop:
      for Y:=0 to Height-1 do begin
        Canvas.Brush.Color:=RGB(0, Height-1, Y, ARGB, BRGB).Value;
        Canvas.FillRect(Bounds(0, Y, Width, 1));
      end;
end;
end;

procedure TShadeBox.SetKind(Kind: TShadeBoxKind);
begin
if FKind=Kind then Exit;
FKind:=Kind;
Invalidate;
end;

procedure Register;
begin
RegisterComponents('Test', [TShadeBox]);
end;

end.

Komponent nainštalujeme do prostredia Delphi príkazom z hlavnej ponuky Component | Install Component... :

Inštalovanie komponentu

Ukážky komponentov pri návrhu okna.

Oprava komponentu

Po zmene zdrojového kódu dclusr.dpk (v podadresári Lib adresára, v ktorom sú Delphi inštalované):

Komponent sa inštaloval do balíčka (tzv. package) dclusr.dpk. Balíček môže obsahovať rôzne komponenty, knižnice a pod.

Ak chceme mať v Palete komponentov vlastnú ikonku:

Teba nakreslit bitmapu s rozmermi 24x24 bodov (uložíme ju do súboru ShadeBox.bmp);
Teba vytvoriť súbor ShadeBox.rc s nasledujúcim obsahom:
TSHADEBOX BITMAP "ShadeBox.bmp"

Tento súbor treba skompilovať pomocou resource kompilátora:
"D:\Delphi6\Bin\brcc32.exe" ShadeBox.rc
Vznikol súbor ShadeBox.res, ktorý pripojíme k unitu ShadeBox.pas:
unit ShadeBox;
...
implementation

{$R *.res}
...
end.
Prekompilujeme balíček s komponentom.

Animovaný komponent

unit Ball;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
ExtCtrls;

type
TBall=class(TGraphicControl)
private
    FX, FY, FdX, FdY: Real;
    FTimer: TTimer;
    FOnBounce: TNotifyEvent;
    procedure TimerTimer(Sender: TObject);
protected
    procedure Paint; override;
    procedure Loaded; override;
public
    constructor Create(Owner: TComponent); override;
published
    property Color;
    property OnBounce: TNotifyEvent read FOnBounce write FOnBounce;
end;

procedure Register;

implementation

constructor TBall.Create(Owner: TComponent);
begin
inherited;
FTimer:=TTimer.Create(Self);
FTimer.Enabled:=False;
FTimer.Interval:=20;
FTimer.OnTimer:=TimerTimer;
FdX:=-1;
end;

procedure TBall.TimerTimer(Sender: TObject);
var
IsEvent: Boolean;
begin
IsEvent:=False;
FX:=FX+FdX;
FY:=FY+FdY;
FdY:=FdY+0.5;
if FX<0 then begin
    FdX:=-FdX;
    FX:=0;
    IsEvent:=True;
end;
if FX+Width>Parent.ClientWidth then begin
    FdX:=-FdX;
    FX:=Parent.ClientWidth-Width;
    IsEvent:=True;
end;
if FY+Height>Parent.ClientHeight then begin
    FdY:=-FdY+1;
    FY:=Parent.ClientHeight-Height;
    IsEvent:=True;
end;
SetBounds(Round(FX), Round(FY), Width, Height);
if IsEvent and Assigned(OnBounce) then OnBounce(Self);
end;

procedure TBall.Paint;
begin
Canvas.Brush.Color:=clRed;
Canvas.Ellipse(0, 0, Width, Height);
end;

procedure TBall.Loaded;
begin
inherited;
FX:=Left;
FY:=Top;
if not (csDesigning in ComponentState) then FTimer.Enabled:=True;
end;

procedure Register;
begin
RegisterComponents('Test', [TBall]);
end;

end.

NDÚ: Každý komponent TBall využíva časovať, čo pri viacerých komponentoch nemusí byť efektívne. Porozmýšľajte, ako by ste upravili tento unit a triedu TBall tak, aby všetky komponenty TBall využívali maximálne jeden (spoločný) časovač.