Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Multimedia (https://www.delphipraxis.net/16-multimedia/)
-   -   Delphi TStringList als Property (https://www.delphipraxis.net/131724-tstringlist-als-property.html)

IIIMADDINIII 29. Mär 2009 20:08


TStringList als Property
 
hallo erst mal

Ich arbeite an einer neuen komponente. Ich wollte eine TStringList zu den Propertys hinzufügen. Aber immer wenn ich auf dieses property zugreifen will Sagt er mir das er ein Read error hat. Ich habe keine ahnung woran es liegt. ich habe diesen fehler jetzt schon drei tage und er will sich nicht auflösen.

Bernhard Geyer 29. Mär 2009 20:19

Re: TStringList als Property
 
Glaskugel auspack: Du solltest die Stringliste in deiner Komponente auch anlegen

Delphi-Quellcode:
type
  TMyType = class(TPersistent)
  private
    FMyStringList: TStrings;
  public
    constructor Create(Owner: TObject);
    MyStringList: TStrings read FMyStringList write SetMyStringList;
  end;

constructor TMyType.Create(Owner: TObject);
begin
  inherited

  FMyStringList := TStringList.Create;
end;

procedure SetMyStringList(Value: TStrings);
begin
  FMyStringList.Assign(Value);
end;

Muetze1 29. Mär 2009 20:33

Re: TStringList als Property
 
@Bernhard Geyer: Willst du nicht lieber das "property" Schlüsselwort verwenden? Und vielleicht den Member auch wieder freigeben?

IIIMADDINIII 29. Mär 2009 20:42

Re: TStringList als Property
 
ich habe die stringliste declariert ind auch gecreatet funct aber trotzdem nicht

mkinzler 29. Mär 2009 20:44

Re: TStringList als Property
 
Wie versuchst du darauf zuzugreifen?

Bernhard Geyer 29. Mär 2009 20:51

Re: TStringList als Property
 
Zitat:

Zitat von Muetze1
@Bernhard Geyer: Willst du nicht lieber das "property" Schlüsselwort verwenden? Und vielleicht den Member auch wieder freigeben?

Wer will den gleich so kleinlich sein :mrgreen:
Wenn man Abends sich nebenbei mit Word und Einladungskarten herumärgern muss :twisted:

Zitat:

Zitat von IIIMADDINIII
ich habe die stringliste declariert ind auch gecreatet funct aber trotzdem nicht

Dann lass doch mal etwas Code rüberwachsen. Du sieht ja das So abend die Glaskugen nicht so richtig funktionieren. Muss an der Zeitumstellung liegen ...

p80286 30. Mär 2009 09:08

Re: TStringList als Property
 
Meine Glaskugel sagt
count=0

Gruß
K-H

khh 30. Mär 2009 09:20

Re: TStringList als Property
 
Zitat:

Zitat von Bernhard Geyer
Wenn man Abends sich nebenbei mit Word und Einladungskarten herumärgern muss

OT: dann nimm doch OpenOffice ;-)


Gruss Kh

DeddyH 30. Mär 2009 09:25

Re: TStringList als Property
 
Ohne das jetzt ausprobiert zu haben: genügt nicht eine ReadOnly-Property, da man die Instanz ja nicht verändern möchte, sondern nur ihre Methoden aufrufen?
Delphi-Quellcode:
type
  TMyType = class(TPersistent)
  private
    FMyStringList: TStrings;
  public
    constructor Create(Owner: TComponent);override;
    destructor Destroy;override;
    property MyStringList: TStrings read FMyStringList;
  end;

constructor TMyType.Create(Owner: TComponent);
begin
  inherited;
  FMyStringList := TStringList.Create;
end;

destructor TMyType.Destroy;
begin
  FMyStringList.Free;
  inherited;
end;
Nur dahergetippt, daher ohne Gewähr.

Muetze1 30. Mär 2009 09:32

Re: TStringList als Property
 
Zitat:

Zitat von DeddyH
Ohne das jetzt ausprobiert zu haben: genügt nicht eine ReadOnly-Property, da man die Instanz ja nicht verändern möchte, sondern nur ihre Methoden aufrufen?

- Wenn die Property in den Published Bereich verschoben werden soll, dann würde sie im Inspektor nicht auftauschen, wenn sie r/o ist.
/EDIT: nicht ohne weiteres. Es gibt die Möglichkeit mit Rechtsklick auf dem OI alle r/o Properties mit anzuzeigen.
- Er hat extra einen Setter geschrieben, damit er intern Assign() aufruft, was der vollkommen korrekte Weg wäre und diese Property auch Komponententauglich/Objektinspektor-tauglich zu machen.
- Grundsätzlich hast du Recht, es würde reichen, aber mit einem Setter und Assign() würde auch sowas möglich werden:

Delphi-Quellcode:
  MyType.MyStringList := ListBox1.Items;
Bei deiner Lösung ohne Setter müsste man immer

Delphi-Quellcode:
  MyType.MyStringList.Assign(ListBox1.Items);
nutzen. Im Endeffekt der gleiche Code, nur beim zweiten muss das auch der x. Anwender von TMyType dieses Wissen haben. Ersteres klappt nach Plug'n'Pray Methoden und verhält sich gleich zur VCL.

DeddyH 30. Mär 2009 09:39

Re: TStringList als Property
 
Ahja, Danke für die ausführliche Erklärung :thumb:.

IIIMADDINIII 30. Mär 2009 16:56

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.

himitsu 30. Mär 2009 17:01

Re: TStringList als Property
 
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:

Muetze1 30. Mär 2009 17:31

Re: TStringList als Property
 
Zitat:

Zitat von himitsu
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:

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:

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.

DeddyH 30. Mär 2009 17:33

Re: TStringList als Property
 
[OT]
Zitat:

Zitat von Muetze1
Ignoriert mich bitte.

Hat da jemand gerade was gepostet? :mrgreen: [/OT]

IIIMADDINIII 30. Mär 2009 17:48

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 11:32 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