Thema: Delphi TStringList als Property

Einzelnen Beitrag anzeigen

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 .
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