Erstellen einer
VCL-Komponente nach einem vorgefertigten Muster.
Ich hatte zugegebenermaßen große Probleme das Konzept der Klassen und Komponenten zu verstehen. Ganz simpel ausgedrückt ist es eigentlich am einfachsten das Konzept zu verstehen, wenn man ausprobiert und einfach mal Testet, welche Möglichkeiten man für sich selbst nutzen kann. Ich habe hier einfach mal ein Standard-Pattern für eine
VCL-Komponente zusammengeschrieben, mit dem ich seit geraumer Zeit relativ gut arbeiten kann.
Kleines Lippenbekenntnis vorab. Auch ich habe mir die meisten Ideen im Netz zusammengekramt. Unter anderem haben mir Leute aus diesem Forum mit Tipps geholfen. Denjenigen ein Dankeschön. Ich habe sie so aufbereitet, dass ich jederzeit loslegen kann. Leider habe ich keine Quellen parat, da dies über die Zeit hin gewachsen ist. Aber, dies ist keine Doktorarbeit und so ...
Jetzt aber los. Die Typendeklaration TShape gibt uns die Möglichkeit, einfache, nicht rechteckige Formen für unsere
VCL-Komponente zu bestimmen.
Type TShape =(bsRect, bsRounded, bsEllipse);
1. Die Typendeklaration der Komponente selbst. Ich gehe einfach einmal auf die wichtigsten Elemente ein. TVCL_Component (nennt es einfach wie ihr wollt) wird von der Klasse TGraphicControl, ein Bestandteil von Delphi abgeleitet.
2. Im „Private“-Teil benenne ich die Variable, die ich verwende sowie einige Procedures, die ich nach außen hin schütze, indem ich sie in diesen Bereich schreibe.
3. „Public“ – In den Public-Teil kommen die wichtigen „3“. Create, Destroy und Paint. Ich will jetzt nicht erklären, warum man einen Constructor oder einen Destructor benötigt. Die Paint-Prozedur aber sollte in zumindest einem Satz erklärt werden. „Man braucht sie, um etwas von der Komponente sichtbar zu machen.“ Eigenlich logisch, sonst ist es nämlich keine
VCL-Komponente. Ich muss aber noch etwas mehr dazu sagen. Man muss ein „Zauberwort“ sagen, damit man die Wirkung der Komponente bereits im Design-Modus beobachten kann „if (csDesigning in ComponentState) then …“. Ansonsten sieht man einfach nur ein Rechteck und dabei wissen wir doch, dass es bei anderen Komponenten auch funktioniert.
4. In den „Published“-Teil packen wir nun endlich alle Prozeduren und Properties, die wir nach außen hin sichtbar darstellen. Wir kennen sie bereits von anderen Komponenten aus dem Objektinspektor. Manche Prozeduren wie MouseDown werden mit den Events gesteuert. Auf diese können wir dann letztlich reagieren wie wir wollen. Nachdem es
VCL, also sichtbare Komponenten sind, wollen wir sicherlich mit der Maus arbeiten. Also sind diese Funktionen wichtig. Was noch? Klar, die Properties. Davon gehen wir einfach zwei Tyen. Die, die wir zuweisen können z.B. die Font und Farben, wo andererseits die Ereignisfunktionen sind, die dann, wenn wir sie einsetzen auf Ereignisse reagieren.
type TVCL_COMPONENT = class(TGraphicControl)
private
FColor : TColor; // Variable Hintergrundfarbe
FFlat : Boolean;
FRadius : Integer; // Variable Radius der Form (rounded)
FShape : TBtnShape; // Variable Form der Komponente
FMouseOver : boolean; // Variable Maus wird über die Kompo bewegt
FPushDown : boolean; // Variable Maus wird über der Kompo gedrückt
Points : array [0..MaxPoints] of TPoint; // Variable Point-Array für Polygonale Form
procedure SetColor(const Value: TColor); // Setzt die Farbe des Hintergrundes
procedure SetRadius(const Value: Integer); // Setzt den Radius der Ecken
procedure SetShape(const Value: TBtnShape); // Setzt die Form der Komponente
procedure SetFlat(const Value: boolean); // Zeigt die Komponente flach oder erhaben
protected
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Paint; Override; // MUSS bei
VCL-Komponenten
published
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override;
procedure CMMouseLeave(var Message: TMessage); message CM_MouseLeave;
procedure CMMouseEnter(var Message: TMessage); message CM_MouseEnter;
property Radius : Integer read FRadius write SetRadius;
property Color : TColor read FColor write SetColor;
property Shape : TBtnShape read FShape write SetShape;
property Flat : boolean read FFlat write SetFlat;
Property Caption;
property Font; // Setzt den Font
property Hint; // Zeigt einen Hint
property ShowHint; // Enabling des Hint
property Visible; // Sichtbar oder nicht
// Reaktion auf die Standardevents der
VCL-Komponenten
property OnClick;
property OnDblClick;
property OnMouseActivate;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents (‘Komponententitel’, [TVCL_COMPONENT]);
End;
//================================================== ============================
//== Class-Definition TVCL_COMPONENT
//================================================== ============================
constructor TVCL_COMPONENT.Create(AOwner: TComponent);
begin
inherited;
Width := 300;
Height:= 400;
end;
//__________________________________________________ ___________________________
destructor TVCL_COMPONENT.Destroy;
begin
inherited;
end;
//__________________________________________________ ___________________________
Procedure TVCL_COMPONENT.Paint;
var xw, yh : integer;
rgn : Hrgn;
R, RCap : Trect;
hiColor, loColor : Tcolor;
procedure drawcaption;
begin
Rcap := Rect(0, 0, width-0, height-0);
canvas.font.Assign(Font);
canvas.brush.style := bsClear;
if Fmouseover then
Begin
canvas.font.color := clBlack;
End;
if FPushDown then
Begin
Rcap := Rect(1, 1, width+1, height+1);
canvas.font.color := clBlack;
End;
DrawText (canvas.handle, @Caption[1], -1, Rcap,
DT_SINGLELINE or DT_VCENTER or
DT_CENTER or DT_END_ELLIPSIS);
end;
procedure drawframe;
begin
if Fmouseover or FPushDown then
with canvas do
begin
canvas.font.color := clBlack;
brush.color:= FColor;
brush.style:= bssolid;
case Fshape of
bsRect : Rectangle(0,0,xw,yh);
bsRounded : RoundRect(0,0,xw,yh,FRadius,FRadius);
bsEllipse : Ellipse(0,0,xw,yh);
end;
end;
if ((Not Fmouseover) And (Not FPushDown)) then
with canvas do
begin
brush.color:=FColor;
brush.style:=bssolid;
pen.color:=loColor;
canvas.font.color := Canvas.Font.Color;
case Fshape of
bsRect : Rectangle(0,0,xw,yh);
bsRounded : RoundRect(0,0,xw,yh,FRadius,FRadius);
bsEllipse : Ellipse(0,0,xw,yh);
end;
end;
SelectClipRgn(Canvas.handle,rgn);
//________________________________
// Hier Code einfügen
//________________________________
drawcaption;
end;
begin
R := Rect(0, 0, width, height);
if FPushDown then
begin
RCap.left := Rcap.left + 1;
RCap.top := RCap.top + 1;
RCap.Right := RCap.right + 1;
RCap.Bottom := Rcap.Bottom + 1;
end;
xw := width-1;
yh := height-1;
// Gezeichnet wird während des Design, wichtig für den Entwickler
if (csDesigning in ComponentState) then
begin
hiColor :=HiCol;
locolor :=LoCol;
canvas.pen.style :=pssolid;
drawframe;
end else
// Gezeichnet wird, wenn die Komponente "flach" dargestellt wird
begin
hiColor :=HiCol;
locolor :=LoCol;
canvas.pen.style:=psclear;
drawframe;
end;
SelectClipRgn(Canvas.handle,0);
DeleteObject(rgn);
End;
//__________________________________________________ ____________________________
procedure TVCL_COMPONENT.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
FPushDown:=true;
invalidate;
inherited;
end;
//__________________________________________________ ____________________________
procedure TVCL_COMPONENT.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
FPushDown:=false;
invalidate;
inherited;
end;
//__________________________________________________ ____________________________
procedure TVCL_COMPONENT.CMMouseLeave(var Message: TMessage);
begin
FMouseOver := false;
invalidate;
end;
//__________________________________________________ ____________________________
procedure TVCL_COMPONENT.CMMouseEnter(var Message: TMessage);
begin
FMouseOver := true;
invalidate;
end;
//__________________________________________________ ____________________________
procedure TVCL_COMPONENT.SetColor(const Value: TColor);
begin
if value <> FColor then
begin
FColor := Value;
invalidate;
end;
end;
//__________________________________________________ ____________________________
procedure TVCL_COMPONENT.SetRadius(const Value: Integer);
begin
FRadius := Value;
invalidate;
end;
//__________________________________________________ ____________________________
procedure TVCL_COMPONENT.SetShape(const Value: TBtnShape);
begin
FShape := Value;
invalidate;
end;
//__________________________________________________ ____________________________
procedure TVCL_COMPONENT.SetFlat(const Value: boolean);
begin
FFlat := Value;
end;
Nicht vergessen, “procedure Register;” wie jede andere Prozedur einer
Unit in den Bereich von Implementation einbinden.
So, und jetzt stellen wir uns die große Gretchenfrage: “Wie krieg ich das denn nun endlich in eine Komponente, die ich dann auch anwenden kann.
1. Delphi öffnen
2. Ein neues
Package anlegen.
3. Eine neue
Unit anlegen (wir wollen doch einigermaßen sauber arbeiten.
4. Den Code von hier in die neue
Unit kopieren.
5. Den Teil mit der Registrierung nicht vergessen.
6. Kompilieren
7. Im Menü „Komponente“ – „Packages installieren“ [hinzufügen] … suchen und bestätigen
8. Ein Programm schreiben, in das ihr eure neue Komponente einfügen könnt.
9. Erweitern, erweitern und schließlich erweitern.
Dies ist, um es nochmal zu erklären, einfach nur ein Pattern, ein Muster, das ich hier für all jene bereitstellen möchte, die wie ich eigentlich keine Vorstellung hatten, wie das aussehen könnte und kein Tutorial, in dem ich zum n-ten mal erklären möchte andere schon ganz gut getan haben.
Macht ein paar Versuche und das Verständnis kommt beim ausprobieren, so wie der Hunger beim Essen.