![]() |
Re: TStringList als Property
Ahja, Danke für die ausführliche Erklärung :thumb:.
|
Re: TStringList als Property
ich habe alles mit property mit read und write gemacht
ich ver astehe es nicht ich habe keine ahnung warum es nicht funct :wall: .
Delphi-Quellcode:
unit roundlist;
interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, math; type Troundlist = class(TCustomControl) private { Private-Deklarationen } selfcolor: TColor; selfshowwidth: Extended; selfY: integer; selfmousepoint: Boolean; selflist: TStringlist; selffont: TFont; protected { Protected-Deklarationen } procedure Paint; override; procedure MouseMove(Shift: TShiftState; X,Y: Integer); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; public { Public-Deklarationen } constructor create (AOwner: TComponent); override; procedure setcolor(Color: TColor); virtual; procedure setshowwidth(Showwidth: Extended); virtual; procedure setlist(list: TStringlist); virtual; procedure setfont(Font: TFont); virtual; function getlist: TStringlist; virtual; published { Published-Deklarationen } property OnClick; Property OnMouseDown; property OnMouseMove; Property OnMouseUp; property OnEnter; Property OnExit; property OnKeyPress; property OnKeyDown; Property OnKeyUp; Property color: Tcolor read selfColor write SetColor; Property Showwidth: extended read selfShowwidth write setshowwidth; property list: TStringlist read getlist write setlist; property font: TFont read selffont write setfont; end; procedure Register; implementation procedure Troundlist.Paint; var Steigung, Xpos, YPos: extended; Uber: integer; begin canvas.Pen.Color := selfcolor; Canvas.Brush.Color := selfColor; steigung := height / (width * selfshowwidth); Uber := round(((height / 2) / sqrt(((height / 2) * (height / 2)) - ((Width * selfshowwidth / 2 - Width) * Steigung * (Width * selfshowwidth / 2 - Width) * Steigung)) * (height / 2)) - (height / 2)); Canvas.Ellipse(round(width - (width * selfshowwidth)),-Uber,width, height + Uber); if (((SelfY) - (height / 2)) / (uber - 6 + (height / 2)) >= -1) and (((SelfY) - (height / 2)) / (uber - 6 + (height / 2)) <= 1) then Xpos := cos(arcsin(((SelfY) - (height / 2)) / (uber - 6 + (height / 2)))) * (width * selfshowwidth / 2 + 6) - ((Width * selfshowwidth / 2) - Width) - 12 else XPos := 0; if Xpos < (width * 0.05) then begin Xpos := Width * 0.05; YPos := sin(arccos((XPos + (width * selfshowwidth / 2 - width)) / (Width * selfshowwidth / 2))) * (uber + height / 2 - 6) + Height / 2; if selfY < Height / 2 then SelfY := round(height - YPos) else SelfY := round(YPos); end; canvas.Pen.Color := rgb(255, 255, 0); Canvas.Rectangle(round(Xpos - 4), selfY - 4, round(Xpos + 4), selfY + 4); canvas.Pen.Color := rgb(255, 243, 0); Canvas.Rectangle(round(Xpos - 3), selfY - 3, round(Xpos + 3), selfY + 3); canvas.Pen.Color := rgb(255, 231, 0); Canvas.Rectangle(round(Xpos - 2), selfY - 2, round(Xpos + 2), selfY + 2); canvas.Pen.Color := rgb(255, 219, 0); Canvas.Rectangle(round(Xpos - 1), selfY - 1, round(Xpos + 1), selfY + 1); if selflist.Count > 0 then canvas.TextOut(0, round(height / 2 - canvas.TextHeight(selflist[0]) / 2), selflist[0]); end; constructor Troundlist.create(AOWner: TComponent); begin inherited create (AOwner); selfcolor := clWhite; selfshowwidth := 2; SelfY := 0; setBounds(0,0,100,200); selflist := TStringlist.Create; selffont := TFont.Create; end; function TRoundlist.getlist: TStringlist; begin result := selflist; end; procedure TRoundlist.setfont(font: TFont); begin selffont := Font; end; procedure TRoundlist.setlist(list: TStringlist); begin selflist := list; end; procedure TRoundlist.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin SelfMousePoint := False; end; procedure TRoundlist.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var XPos: Extended; uber: integer; begin inherited MouseDown(Button, Shift, X, Y); if (((Y) - (height / 2)) / (uber - 6 + (height / 2)) >= -1) and (((Y) - (height / 2)) / (uber - 6 + (height / 2)) <= 1) then Xpos := cos(arcsin(((SelfY) - (height / 2)) / (uber - 6 + (height / 2)))) * (width * selfshowwidth / 2 + 6) - ((Width * selfshowwidth / 2) - Width) - 12 else XPos := 0; if (X >= XPos - 6) and (X <= XPos + 6) then begin SelfMousePoint := true; selfY := Y; end; paint; end; procedure TRoundlist.MouseMove(Shift: TShiftState; X,Y: Integer); begin inherited MouseMove (Shift, X, Y); if selfMousepoint then SelfY := Y; Paint; end; procedure TRoundlist.setshowwidth(showwidth: Extended); begin selfshowwidth := showwidth; rEPAINT; end; procedure TRoundlist.setcolor(color: TColor); begin selfcolor := Color; Repaint; end; procedure Register; begin RegisterComponents('Beispiele', [Troundlist]); end; end. |
Re: TStringList als Property
Delphi-Quellcode:
die Liste im Constructor erstellen und im Destructor löschen ... von Außen wird sowas normaler Weise nicht gesetzt.
selflist: TStringList;
... property List: TStringList read selflist; es muß ja nur deren Inhalt von Außen änderbar sein :angel2: |
Re: TStringList als Property
Zitat:
![]() Und bitte als Propertytyp TStrings definieren! @IIIMADDINIII: 1. Dein SetList fehlt noch der Assignaufruf anstatt der Zuweisung (gleiches gilt für SetFont) 2. Überschreibe bitte den Destruktor und geb die Liste auch wieder frei 3. Gleiches aus Punkt 2. für den Font 4. Willst du vor dem Malen in Paint nicht vielleicht den Font auch dem Canvas übergeben? 5. Um über Änderungen der Liste informiert zu werden um damit ein neuzeichnen auszuösen, solltest du dich im OnChange von TStringList einklinken. Hier mal alles entsprechend angepasst:
Delphi-Quellcode:
Nachtrag: Ich will dir ja nicht den Spass verderben, aber TCustomControl bringt schon eine Font Eigenschaft mit. Hier nochmal die Komponente unter Nutzung der o.g. Property:
unit roundlist;
interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, math; type Troundlist = class(TCustomControl) private { Private-Deklarationen } selfcolor: TColor; selfshowwidth: Extended; selfY: integer; selfmousepoint: Boolean; selflist: TStrings; selffont: TFont; procedure RedrawEvent(Sender: TObject); protected { Protected-Deklarationen } procedure Paint; override; procedure MouseMove(Shift: TShiftState; X,Y: Integer); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; public { Public-Deklarationen } constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure setcolor(Color: TColor); virtual; procedure setshowwidth(Showwidth: Extended); virtual; procedure SetList(list: TStrings); virtual; procedure SetFont(Font: TFont); virtual; published { Published-Deklarationen } property OnClick; Property OnMouseDown; property OnMouseMove; Property OnMouseUp; property OnEnter; Property OnExit; property OnKeyPress; property OnKeyDown; Property OnKeyUp; Property color: Tcolor read selfColor write SetColor; Property Showwidth: extended read selfShowwidth write setshowwidth; property List: TStringlist read SelfList write SetList; property Font: TFont read SelfFont write SetFont; end; procedure Register; implementation procedure Troundlist.Paint; var Steigung, Xpos, YPos: extended; Uber: integer; begin canvas.Pen.Color := selfcolor; Canvas.Brush.Color := selfColor; steigung := height / (width * selfshowwidth); Uber := round(((height / 2) / sqrt(((height / 2) * (height / 2)) - ((Width * selfshowwidth / 2 - Width) * Steigung * (Width * selfshowwidth / 2 - Width) * Steigung)) * (height / 2)) - (height / 2)); Canvas.Ellipse(round(width - (width * selfshowwidth)),-Uber,width, height + Uber); if (((SelfY) - (height / 2)) / (uber - 6 + (height / 2)) >= -1) and (((SelfY) - (height / 2)) / (uber - 6 + (height / 2)) <= 1) then Xpos := cos(arcsin(((SelfY) - (height / 2)) / (uber - 6 + (height / 2)))) * (width * selfshowwidth / 2 + 6) - ((Width * selfshowwidth / 2) - Width) - 12 else XPos := 0; if Xpos < (width * 0.05) then begin Xpos := Width * 0.05; YPos := sin(arccos((XPos + (width * selfshowwidth / 2 - width)) / (Width * selfshowwidth / 2))) * (uber + height / 2 - 6) + Height / 2; if selfY < Height / 2 then SelfY := round(height - YPos) else SelfY := round(YPos); end; canvas.Pen.Color := rgb(255, 255, 0); Canvas.Rectangle(round(Xpos - 4), selfY - 4, round(Xpos + 4), selfY + 4); canvas.Pen.Color := rgb(255, 243, 0); Canvas.Rectangle(round(Xpos - 3), selfY - 3, round(Xpos + 3), selfY + 3); canvas.Pen.Color := rgb(255, 231, 0); Canvas.Rectangle(round(Xpos - 2), selfY - 2, round(Xpos + 2), selfY + 2); canvas.Pen.Color := rgb(255, 219, 0); Canvas.Rectangle(round(Xpos - 1), selfY - 1, round(Xpos + 1), selfY + 1); if selflist.Count > 0 then begin Canvas.Font.Assign(SelfFont); canvas.TextOut(0, round(height / 2 - canvas.TextHeight(selflist[0]) / 2), selflist[0]); end; end; constructor Troundlist.Create(AOWner: TComponent); begin inherited Create(AOwner); selfcolor := clWhite; selfshowwidth := 2; SelfY := 0; setBounds(0,0,100,200); selflist := TStringlist.Create; TStringlist(SelfList).OnChange := RedrawEvent; selffont := TFont.Create; SelfFont.OnChange := RedrawEvent; end; destructor TRoundList.Destroy; begin SelfFont.Free; SelfList.Free; inherited; end; procedure TRoundlist.SetFont(AFont: TFont); begin SelfFont.Assign(AFont); end; procedure TRoundlist.SetList(AList: TStrings); begin SelfList.Assign(AList); end; procedure TRoundlist.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; SelfMousePoint := False; end; procedure TRoundlist.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var XPos: Extended; uber: integer; begin inherited MouseDown(Button, Shift, X, Y); if (((Y) - (height / 2)) / (uber - 6 + (height / 2)) >= -1) and (((Y) - (height / 2)) / (uber - 6 + (height / 2)) <= 1) then Xpos := cos(arcsin(((SelfY) - (height / 2)) / (uber - 6 + (height / 2)))) * (width * selfshowwidth / 2 + 6) - ((Width * selfshowwidth / 2) - Width) - 12 else XPos := 0; if (X >= XPos - 6) and (X <= XPos + 6) then begin SelfMousePoint := true; selfY := Y; end; paint; end; procedure TRoundlist.MouseMove(Shift: TShiftState; X,Y: Integer); begin inherited MouseMove (Shift, X, Y); if selfMousepoint then SelfY := Y; Paint; end; procedure TRoundlist.setshowwidth(showwidth: Extended); begin if not SameValue(selfshowwidth, showwidth, 1000) then begin selfshowwidth := showwidth; if not ( csLoading in ComponentState ) then Invalidate; end; end; procedure TRoundlist.setcolor(color: TColor); begin if AColor <> SelfColor then begin SelfColor := AColor; if not ( csLoading in ComponentState ) then Invalidate; end; end; procedure TRoundList.RedrawEvent(Sender: TObject); begin if not ( csLoading in ComponentState ) then Invalidate; end; procedure Register; begin RegisterComponents('Beispiele', [Troundlist]); end; end. Nachtrag II: Eine Color Eigenschaft genaus. Also auch gleich diese mal genutzt:
Delphi-Quellcode:
unit roundlist;
interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, math; type Troundlist = class(TCustomControl) private { Private-Deklarationen } selfshowwidth: Extended; selfY: integer; selfmousepoint: Boolean; selflist: TStrings; procedure RedrawEvent(Sender: TObject); procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED; procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; protected { Protected-Deklarationen } procedure Paint; override; procedure MouseMove(Shift: TShiftState; X,Y: Integer); override; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; public { Public-Deklarationen } constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure setshowwidth(Showwidth: Extended); virtual; procedure SetList(list: TStrings); virtual; published { Published-Deklarationen } property OnClick; Property OnMouseDown; property OnMouseMove; Property OnMouseUp; property OnEnter; Property OnExit; property OnKeyPress; property OnKeyDown; Property OnKeyUp; Property Color; property ParentColor; Property Showwidth: extended read selfShowwidth write setshowwidth; property List: TStringlist read SelfList write SetList; property Font; property ParentFont; end; procedure Register; implementation procedure Troundlist.Paint; var Steigung, Xpos, YPos: extended; Uber: integer; begin canvas.Pen.Color := Self.Color; Canvas.Brush.Color := self.Color; steigung := height / (width * selfshowwidth); Uber := round(((height / 2) / sqrt(((height / 2) * (height / 2)) - ((Width * selfshowwidth / 2 - Width) * Steigung * (Width * selfshowwidth / 2 - Width) * Steigung)) * (height / 2)) - (height / 2)); Canvas.Ellipse(round(width - (width * selfshowwidth)),-Uber,width, height + Uber); if (((SelfY) - (height / 2)) / (uber - 6 + (height / 2)) >= -1) and (((SelfY) - (height / 2)) / (uber - 6 + (height / 2)) <= 1) then Xpos := cos(arcsin(((SelfY) - (height / 2)) / (uber - 6 + (height / 2)))) * (width * selfshowwidth / 2 + 6) - ((Width * selfshowwidth / 2) - Width) - 12 else XPos := 0; if Xpos < (width * 0.05) then begin Xpos := Width * 0.05; YPos := sin(arccos((XPos + (width * selfshowwidth / 2 - width)) / (Width * selfshowwidth / 2))) * (uber + height / 2 - 6) + Height / 2; if selfY < Height / 2 then SelfY := round(height - YPos) else SelfY := round(YPos); end; canvas.Pen.Color := rgb(255, 255, 0); Canvas.Rectangle(round(Xpos - 4), selfY - 4, round(Xpos + 4), selfY + 4); canvas.Pen.Color := rgb(255, 243, 0); Canvas.Rectangle(round(Xpos - 3), selfY - 3, round(Xpos + 3), selfY + 3); canvas.Pen.Color := rgb(255, 231, 0); Canvas.Rectangle(round(Xpos - 2), selfY - 2, round(Xpos + 2), selfY + 2); canvas.Pen.Color := rgb(255, 219, 0); Canvas.Rectangle(round(Xpos - 1), selfY - 1, round(Xpos + 1), selfY + 1); if selflist.Count > 0 then begin Canvas.Font.Assign(Self.Font); canvas.TextOut(0, round(height / 2 - canvas.TextHeight(selflist[0]) / 2), selflist[0]); end; end; constructor Troundlist.Create(AOWner: TComponent); begin inherited Create(AOwner); Color := clWhite; selfshowwidth := 2; SelfY := 0; setBounds(0,0,100,200); selflist := TStringlist.Create; TStringlist(SelfList).OnChange := RedrawEvent; end; destructor TRoundList.Destroy; begin SelfList.Free; inherited; end; procedure TRoundlist.CMFontChanged(var Message: TMessage); begin inherited; if not ( csLoading in ComponentState ) then Invalidate; end; procedure TRoundList.CMColorChanged(var Message: TMessage); message CM_COLORCHANGED; begin inherited; if not ( csLoading in ComponentState ) then Invalidate; end; procedure TRoundlist.SetList(AList: TStrings); begin SelfList.Assign(AList); end; procedure TRoundlist.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; SelfMousePoint := False; end; procedure TRoundlist.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var XPos: Extended; uber: integer; begin inherited MouseDown(Button, Shift, X, Y); if (((Y) - (height / 2)) / (uber - 6 + (height / 2)) >= -1) and (((Y) - (height / 2)) / (uber - 6 + (height / 2)) <= 1) then Xpos := cos(arcsin(((SelfY) - (height / 2)) / (uber - 6 + (height / 2)))) * (width * selfshowwidth / 2 + 6) - ((Width * selfshowwidth / 2) - Width) - 12 else XPos := 0; if (X >= XPos - 6) and (X <= XPos + 6) then begin SelfMousePoint := true; selfY := Y; end; paint; end; procedure TRoundlist.MouseMove(Shift: TShiftState; X,Y: Integer); begin inherited MouseMove (Shift, X, Y); if selfMousepoint then SelfY := Y; Paint; end; procedure TRoundlist.setshowwidth(showwidth: Extended); begin if not SameValue(selfshowwidth, showwidth, 1000) then begin selfshowwidth := showwidth; if not ( csLoading in ComponentState ) then Invalidate; end; end; procedure TRoundList.RedrawEvent(Sender: TObject); begin if not ( csLoading in ComponentState ) then Invalidate; end; procedure Register; begin RegisterComponents('Beispiele', [Troundlist]); end; end. |
Re: TStringList als Property
[OT]
Zitat:
|
Re: TStringList als Property
danke für eure hilfe
hab es noch nicht ausprobiert wird aber varscheinlich functionieren nochmals vielen dank schau euer MADDIN |
Alle Zeitangaben in WEZ +1. Es ist jetzt 22:49 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-2025 by Thomas Breitkreuz