![]() |
Eigene Komponente, Paint in FireMonkey überschreiben
Hallo,
möchte gerne eine eigene Komponente aus Delphi 2007 nach FireMonkey übernehmen. Beispiel ist weiter unten : Hier kommen aber jede Menge Fehler. z.B. Polygon, clblack usw. Wenn ich das alles konvertiere in z.B. Fillpolygon und clablack kommen keine Fehlermedungen mehr, aber er zeichnet auch nicht. Ich denke das liegt am Paint überschreiben ! Auch Invalidate geht nicht mehr. Kann mir da jemand einen oder mehrere Tipps geben ?
Delphi-Quellcode:
unit Pfeil; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; type TRichtung =(Links,Rechts,Unten,Oben); type TPfeil = class(TGraphicControl) private { Private-Deklarationen } GetRichtung : TRichtung; GetVisible : Boolean; GetColor : TColor; procedure SetRichtung(value:TRichtung); procedure SetVisible(value:Boolean); procedure SetColor(value:TColor); public { Public-Deklarationen } constructor Create(AOwner: TComponent); override; protected { Protected-Deklarationen } procedure Paint; override; published { Published-Deklarationen } property Richtung: TRichtung read getRichtung write setRichtung; property Visible: Boolean read GetVisible write SetVisible; property Color: TColor read GetColor write SetColor; property AutoSize; end; procedure Register; implementation {$R Pfeil.res} procedure Register; begin RegisterComponents('AfwBackup', [TPfeil]); end; procedure TPfeil.SetColor(value:TColor); begin if Value <> GetColor then begin GetColor := Value; invalidate; end; end; procedure TPfeil.SetRichtung(value:TRichtung); begin if Value <> GetRichtung then begin GetRichtung := Value; invalidate; end; end; procedure TPfeil.SetVisible(value:Boolean); begin if Value <> GetVisible then begin GetVisible := Value; invalidate; end; end; constructor TPfeil.Create(AOwner: TComponent); begin inherited Create(AOwner); Height:=25; Width:=25; GetVisible:=true; GetColor:=clblack; GetRichtung:=Links; end; procedure TPfeil.Paint; begin if Visible then with Canvas do begin pen.color:=Color; brush.color:=Color; { Pfeil zeichnen } case GetRichtung of Oben : Polygon([Point(0,height),Point(width div 2,0),Point(width,height)]); Unten : Polygon([Point(0,0),Point(width div 2,height),Point(width,0)]); Rechts : Polygon([Point(0,0),Point(width,height div 2),Point(0,height)]); Links : Polygon([Point(width,0),Point(0,height div 2),Point(width,height)]); end; end; end; end. |
AW: Eigene Komponente, Paint in FireMonkey überschreiben
Hi,
herzlich willkommen in der DP. Inhaltlich kann ich dir nicht direkt weiterhelfen, aber eine Bitte hätte ich: Der Thread wird gleich viel leserlicher, wenn der Code entsprechend formatiert ist - dazu gibt es hier in der DP die sog. Delphi-Tags. Diese kannst du entweder von Hand hinzufügen, dann einfach [delphi] vor den Quellcode und [/delphi] hinter den Quellcode schreiben oder du nutzt im Beitragseditor die Schaltfläche mit dem Delphi-Helm, dann wird das für dich übernommen (wenn du den Quelltext markierst, wird dieser umschlossen). LG, Frederic |
AW: Eigene Komponente, Paint in FireMonkey überschreiben
![]() |
AW: Eigene Komponente, Paint in FireMonkey überschreiben
Schon ziemlich alt, vielleicht interessierts noch:
Delphi-Quellcode:
unit Pfeil;
interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, FMX.Types, FMX.Controls; type TRichtung = (Links, Rechts, Unten, Oben); type TPfeil = class(TControl) private { Private-Deklarationen } FRichtung: TRichtung; FVisible: Boolean; FColor: TAlphaColor; procedure SetRichtung(value: TRichtung); procedure SetColor(value: TAlphaColor); public { Public-Deklarationen } constructor Create(AOwner: TComponent); override; protected { Protected-Deklarationen } procedure Paint; override; published { Published-Deklarationen } property Richtung: TRichtung read FRichtung write SetRichtung; property Color: TAlphaColor read FColor write SetColor; end; procedure Register; implementation procedure Register; begin RegisterComponents('AfwBackup', [TPfeil]); end; procedure TPfeil.SetColor(value: TAlphaColor); begin if value <> FColor then begin FColor:= value; InvalidateRect(Self.BoundsRect); end; end; procedure TPfeil.SetRichtung(value: TRichtung); begin if value <> FRichtung then begin FRichtung:= value; InvalidateRect(Self.BoundsRect); end; end; constructor TPfeil.Create(AOwner: TComponent); begin inherited Create(AOwner); Self.Height:= 25; Self.Width:= 25; Self.FVisible:= true; Self.FColor:= claBlack; Self.FRichtung:= Links; end; procedure TPfeil.Paint; var pol: TPolygon; begin if Visible then with Self.Canvas do begin Stroke.Color:= FColor; Fill.Color:= FColor; Stroke.Kind:= TBrushKind.bkSolid; Fill.Kind:= TBrushKind.bkSolid; { Pfeil zeichnen } SetLength(pol, 3); case FRichtung of Links: begin pol[0]:= PointF(Self.Width, 0); pol[1]:= PointF(0, Self.Height / 2); pol[2]:= PointF(Self.Width, Self.Height); end; Rechts: begin pol[0]:= PointF(0, 0); pol[1]:= PointF(Self.Width / 2, Self.Height); pol[2]:= PointF(0, Self.Height); end; Unten: begin pol[0]:= PointF(0, 0); pol[1]:= PointF(Self.Width / 2, Self.Height); pol[2]:= PointF(Self.Width, 0); end; Oben: begin pol[0]:= PointF(0, Self.Height); pol[1]:= PointF(Self.Width / 2, 0); pol[2]:= PointF(Self.Width, Self.Height); end; end; DrawPolygon(pol, 1); SetLength(pol, 0); end; end; end. |
Alle Zeitangaben in WEZ +1. Es ist jetzt 10:43 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz