![]() |
Re: Linien-Komponente gesucht
Wie wäre es mit einem Bevel?
|
Re: Linien-Komponente gesucht
In diesem Fall wäre die [bi.onPaint[/i]-Property nicht so ideal, besser .Paint überschreiben.
|
Re: Linien-Komponente gesucht
Zitat:
Zitat:
|
Re: Linien-Komponente gesucht
Hier mal was ganz einfaches um zu verstehen, wie man sich selbst sowas macht... hehe
Delphi-Quellcode:
unit FormLine;
interface uses SysUtils, Classes, Controls, Windows, Graphics; type TFormLine = class(TCustomControl) private FStartPosX : Integer; FStartPosY : Integer; FEndPosX : Integer; FEndPosY : Integer; FPenColor : TColor; procedure SetStartPosX(const Value: Integer); procedure SetStartPosY(const Value: Integer); procedure SetEndPosX(const Value: Integer); procedure SetEndPosY(const Value: Integer); procedure SetPenColor(const Value: TColor); procedure Paint; override; protected { Protected-Deklarationen } public { Public-Deklarationen } published property StartPosX: Integer read FStartPosX write SetStartPosX; property StartPosY: Integer read FStartPosY write SetStartPosY; property EndPosX : Integer read FEndPosX write SetEndPosX; property EndPosY : Integer read FEndPosY write SetEndPosY; property Color; property PenColor : TColor read FPenColor write SetPenColor; { Published-Deklarationen } end; procedure Register; implementation procedure Register; begin RegisterComponents('Beispiele', [TFormLine]); end; procedure TFormLine.SetStartPosX(const Value: Integer); begin IF (Value <> FStartPosX) THEN BEGIN FStartPosX := Value; Invalidate; END; end; procedure TFormLine.SetStartPosY(const Value: Integer); begin IF (Value <> FStartPosY) THEN BEGIN FStartPosY := Value; Invalidate; END; end; procedure TFormLine.SetEndPosX(const Value: Integer); begin IF (Value <> FEndPosX) THEN BEGIN FEndPosX := Value; Invalidate; END; end; procedure TFormLine.SetEndPosY(const Value: Integer); begin IF (Value <> FEndPosY) THEN BEGIN FEndPosY := Value; Invalidate; END; end; procedure TFormLine.SetPenColor(const Value: TColor); begin IF Value <> FPenColor THEN BEGIn FPenColor := Value; invalidate; END; end; procedure TFormLine.Paint; begin Canvas.Brush.Color := Color; Canvas.FillRect(Canvas.ClipRect); Canvas.Pen.Color := FPenColor; Canvas.MoveTo(FStartPosX, FStartPosY); Canvas.LineTo(FEndPosX, FEndPosY); end; end. |
Re: Linien-Komponente gesucht
Veröffentliche doch einfach Pen und Brush ...
Delphi-Quellcode:
unit FormLine;
interface uses SysUtils, Classes, Controls, Windows, Graphics; type TFormLine = class(TGraphicControl) private FStartPosX : Integer; FStartPosY : Integer; FEndPosX : Integer; FEndPosY : Integer; procedure SetStartPosX(const Value: Integer); procedure SetStartPosY(const Value: Integer); procedure SetEndPosX(const Value: Integer); procedure SetEndPosY(const Value: Integer); procedure SetPen(const Value: TPen); procedure GetPen: TPen; procedure SetBrush(const Value: TBrush); procedure GetBrush: TBrush; protected { Protected-Deklarationen } public { Public-Deklarationen } procedure Paint; override; published property StartPosX: Integer read FStartPosX write SetStartPosX; property StartPosY: Integer read FStartPosY write SetStartPosY; property EndPosX : Integer read FEndPosX write SetEndPosX; property EndPosY : Integer read FEndPosY write SetEndPosY; property Pen: TPen read GetPen write SetPen; property Brush: TBrush read GetBrush write SetBrush; { Published-Deklarationen } end; procedure Register; implementation procedure Register; begin RegisterComponents('Beispiele', [TFormLine]); end; procedure TFormLine.SetStartPosX(const Value: Integer); begin IF (Value <> FStartPosX) THEN BEGIN FStartPosX := Value; Invalidate; END; end; procedure TFormLine.SetStartPosY(const Value: Integer); begin IF (Value <> FStartPosY) THEN BEGIN FStartPosY := Value; Invalidate; END; end; procedure TFormLine.SetEndPosX(const Value: Integer); begin IF (Value <> FEndPosX) THEN BEGIN FEndPosX := Value; Invalidate; END; end; procedure TFormLine.SetEndPosY(const Value: Integer); begin IF (Value <> FEndPosY) THEN BEGIN FEndPosY := Value; Invalidate; END; end; procedure SetPen(const Value: TPen); Begin Canvas.Pen.Assign(Value); End; procedure GetPen: TPen; Begin Result := Canvas.Pen; End; procedure SetBrush(const Value: TBrush); Begin Canvas.Brush.Assign(Value); End; procedure GetBrush: TBrush; Begin Result := Canvas.Brush; End; procedure TFormLine.Paint; begin Canvas.FillRect(Canvas.ClipRect); Canvas.MoveTo(FStartPosX, FStartPosY); Canvas.LineTo(FEndPosX, FEndPosY); end; end. |
Re: Linien-Komponente gesucht
@muetze da sind noch einige fehler drin
- was mir nicht gefällt, ist dass ein rechteck entsteht, welches dann die linie beinhaltet. schön wären einfach nur ein start und endpunkt und dazwischen die linie und das direkt auf dem canvas des parent! |
Re: Linien-Komponente gesucht
Delphi-Quellcode:
So, nun sollten die Fehler raus sein.
unit FormLine;
interface uses SysUtils, Classes, Controls, Windows, Graphics; type TFormLine = class(TGraphicControl) private FStartPosX : Integer; FStartPosY : Integer; FEndPosX : Integer; FEndPosY : Integer; procedure SetStartPosX(const Value: Integer); procedure SetStartPosY(const Value: Integer); procedure SetEndPosX(const Value: Integer); procedure SetEndPosY(const Value: Integer); procedure SetPen(const Value: TPen); function GetPen: TPen; procedure SetBrush(const Value: TBrush); Function GetBrush: TBrush; protected { Protected-Deklarationen } public { Public-Deklarationen } procedure Paint; override; published property StartPosX: Integer read FStartPosX write SetStartPosX; property StartPosY: Integer read FStartPosY write SetStartPosY; property EndPosX : Integer read FEndPosX write SetEndPosX; property EndPosY : Integer read FEndPosY write SetEndPosY; property Pen: TPen read GetPen write SetPen; property Brush: TBrush read GetBrush write SetBrush; { Published-Deklarationen } end; procedure Register; implementation procedure Register; begin RegisterComponents('Beispiele', [TFormLine]); end; procedure TFormLine.SetStartPosX(const Value: Integer); begin IF (Value <> FStartPosX) THEN BEGIN FStartPosX := Value; Invalidate; END; end; procedure TFormLine.SetStartPosY(const Value: Integer); begin IF (Value <> FStartPosY) THEN BEGIN FStartPosY := Value; Invalidate; END; end; procedure TFormLine.SetEndPosX(const Value: Integer); begin IF (Value <> FEndPosX) THEN BEGIN FEndPosX := Value; Invalidate; END; end; procedure TFormLine.SetEndPosY(const Value: Integer); begin IF (Value <> FEndPosY) THEN BEGIN FEndPosY := Value; Invalidate; END; end; procedure TFormLine.SetPen(const Value: TPen); Begin Canvas.Pen.Assign(Value); End; Function TFormLine.GetPen: TPen; Begin Result := Canvas.Pen; End; procedure TFormLine.SetBrush(const Value: TBrush); Begin Canvas.Brush.Assign(Value); End; Function TFormLine.GetBrush: TBrush; Begin Result := Canvas.Brush; End; procedure TFormLine.Paint; begin Canvas.FillRect(Canvas.ClipRect); Canvas.MoveTo(FStartPosX, FStartPosY); Canvas.LineTo(FEndPosX, FEndPosY); end; end. Wenn er kein Rechteck füllen sollen, dann kannst du zum einen den Brush Style auf bsClear setzen oder du entfernst das FillRect in Paint. Erstere Methode lässt dir aber noch mehr andere Möglichkeiten offen. Mein Code ist von TGraphicControl abgeleitet und dieses benutzt den Canvas des Parent und keinen eigenen |
Re: Linien-Komponente gesucht
nein sind sie immer noch nicht :wink:
Zitat:
|
Re: Linien-Komponente gesucht
Zitat:
Zu dem Zitat:
Ich weiss nicht was du mir damit willst, schliesslich leite ich von TGraphicControl ab und habe somit Zugriff auf die protected-Member. |
Re: Linien-Komponente gesucht
Zitat:
|
Alle Zeitangaben in WEZ +1. Es ist jetzt 01:42 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