AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
• Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia Delphi TStringList als Property
Thema durchsuchen
Ansicht
Themen-Optionen

TStringList als Property

Ein Thema von IIIMADDINIII · begonnen am 29. Mär 2009 · letzter Beitrag vom 30. Mär 2009
Antwort Antwort
Seite 2 von 2     12   
Benutzerbild von DeddyH
DeddyH

Registriert seit: 17. Sep 2006
Ort: Barchfeld
27.625 Beiträge
 
Delphi 12 Athens
 
#11

Re: TStringList als Property

  Alt 30. Mär 2009, 10:39
Ahja, Danke für die ausführliche Erklärung .
Detlef
"Ich habe Angst vor dem Tag, an dem die Technologie unsere menschlichen Interaktionen übertrumpft. Die Welt wird eine Generation von Idioten bekommen." (Albert Einstein)
Dieser Tag ist längst gekommen
  Mit Zitat antworten Zitat
IIIMADDINIII
(Gast)

n/a Beiträge
 
#12

Re: TStringList als Property

  Alt 30. Mär 2009, 17:56
ich habe alles mit property mit read und write gemacht
ich ver astehe es nicht ich habe keine ahnung warum es nicht funct .
zusammenfalten · markieren
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.
  Mit Zitat antworten Zitat
Benutzerbild von himitsu
himitsu

Registriert seit: 11. Okt 2003
Ort: Elbflorenz
44.184 Beiträge
 
Delphi 12 Athens
 
#13

Re: TStringList als Property

  Alt 30. Mär 2009, 18:01
markieren
Delphi-Quellcode:
selflist: TStringList;
...
property List: TStringList read selflist;
die Liste im Constructor erstellen und im Destructor löschen ... von Außen wird sowas normaler Weise nicht gesetzt.

es muß ja nur deren Inhalt von Außen änderbar sein
$2B or not $2B
  Mit Zitat antworten Zitat
Muetze1
(Gast)

n/a Beiträge
 
#14

Re: TStringList als Property

  Alt 30. Mär 2009, 18:31
Zitat von himitsu:
markieren
Delphi-Quellcode:
selflist: TStringList;
...
property List: TStringList read selflist;
die Liste im Constructor erstellen und im Destructor löschen ... von Außen wird sowas normaler Weise nicht gesetzt.

es muß ja nur deren Inhalt von Außen änderbar sein :angel2:
Ignoriert mich bitte. Ich verweise nochmal auf meinen Beitrag #10. Es ist eine published Property, also mit Setter und Assign().

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:

zusammenfalten · markieren
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: 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: 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:

Nachtrag II: Eine Color Eigenschaft genaus. Also auch gleich diese mal genutzt:

zusammenfalten · markieren
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.
  Mit Zitat antworten Zitat
Benutzerbild von DeddyH
DeddyH

Registriert seit: 17. Sep 2006
Ort: Barchfeld
27.625 Beiträge
 
Delphi 12 Athens
 
#15

Re: TStringList als Property

  Alt 30. Mär 2009, 18:33
[OT]
Zitat von Muetze1:
Ignoriert mich bitte.
Hat da jemand gerade was gepostet? [/OT]
Detlef
"Ich habe Angst vor dem Tag, an dem die Technologie unsere menschlichen Interaktionen übertrumpft. Die Welt wird eine Generation von Idioten bekommen." (Albert Einstein)
Dieser Tag ist längst gekommen
  Mit Zitat antworten Zitat
IIIMADDINIII
(Gast)

n/a Beiträge
 
#16

Re: TStringList als Property

  Alt 30. Mär 2009, 18:48
danke für eure hilfe
hab es noch nicht ausprobiert wird aber varscheinlich functionieren
nochmals vielen dank
schau

euer MADDIN
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 2 von 2     12   

« Vorheriges Thema | Nächstes Thema »

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus
Gehe zu:

• Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 02:03 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz