Suche kompo: seti@home progress bar

[Meflin]

^^ push ^^ ich gebe nicht auf

[Meflin]

[Meflin]

^^ push ^^

[Meflin]

pushen macht spass, eine antwort wär mir lieber

[supermuckl]

wie wärs mit canvas und selber zeichnen ?

schau mal genau hin wie sich das verhält und zerleg dir das in 2D shapes im gehirn

dann mach dir funktionen die die teilbilder zeichnen

und dann verschiebst du nur immer die bereiche usw.. das geht sicherlich einfacher als da jetzt die meisten vermuten

[SirThornberry]

Ich würd für sowas auch selbst die Komponente selbst zeichnen, ist ja kein Akt paar Linien auf eine Canvas zu zeichnen und mit ner Farbe zu füllen.

[sCrAPt]

Ich hab mal so eine ähnliche Progressbar gesehen wo am Ende noch die Prozentzahl herausstand 8) Sowas zu proggen wird dann schon lustiger *fg*

http://www.og4all.de/s.jpg, sCrAPt

[SirThornberry]

Und die Komponente wurde gefunden (im Anhang)...

in der Unit aus der Zipdatei ist kein "Registercomponents", du musst also die Komponente zur Laufzeit erstellen oder das selbst noch tippen.

Prozentzahl musst du auch extra setzen, ist also nur der pure balken

[Meflin]

ok, das ist fast genau das was ich wollte (fehlt noch das von hinten nach vorne sich die einzelnen striche aufbauen und die jeweils von oben nach unten) aber ich denke das sollte mir genügen. folgenden code kann man als vcl komponente installieren:

Delphi-Quellcode:

unit uStatus3DBalken;

interface

uses
  windows, graphics, classes, controls;

type
  TStatus3DBalken = class(TCustomControl)
  private
    fMaxPos: Integer;
    fPos: Integer;
    fLineColor: TColor;
    fBalkenColor1: TColor;
    fBalkenColor2: TColor;
    fBalkenColor3: TColor;
    fTmpPic: TBitmap;
    procedure FDrawBalken;
    procedure FSetColors(AIndex: Integer; AValue: TColor);
    procedure FSetMax(AValue: Integer);
    procedure FSetPos(AValue: Integer);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
  published
    property BalkenColor1: TColor Index 0 read fBalkenColor1 write FSetColors;
    property BalkenColor2: TColor Index 1 read fBalkenColor2 write FSetColors;
    property BalkenColor3: TColor Index 2 read fBalkenColor3 write FSetColors;
    property LineColor: TColor Index 3 read fLineColor write FSetColors;
    property Color;
    property Doublebuffered;
    property Max: Integer read fMaxPos write FSetMax;
    property Position: Integer read fPos write FSetPos;
    property ParentColor;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Beispiele', [TStatus3DBalken]);
end;

constructor TStatus3DBalken.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fMaxPos := 100;
  fPos    := 25;
  Color   := clBlack;
  fLineColor := clSilver;
  fBalkenColor1 := RGB(220, 0, 0);
  fBalkenColor2 := RGB(200, 0, 0);
  fBalkenColor3 := RGB(110, 0, 0);
  fTmpPic := TBitmap.Create;
  SetBounds(Left, Top, 300, 28);
end;

destructor TStatus3DBalken.Destroy;
begin
  fTmpPic.Free;
  inherited Destroy;
end;

procedure TStatus3DBalken.FDrawBalken;
var LCanvas: TCanvas;
    LGesHeight, LGesWidth, LBWidth, LBHeight, LAbstand, LBalkenWidth, LX, LY: Integer;
    LMax, LPos: Integer;
begin
  fTmpPic.Width := Width;
  fTmpPic.Height := Height;
  LCanvas := fTmpPic.Canvas;
  //Hintergrund malen
  LCanvas.Brush.Color := Color;
  LCanvas.FillRect(Rect(0, 0, Width, Height));
  if (Width > 2) and (Height > 2) then
  begin
    LX := 0;
    LY := 0;
    LGesHeight := Height - 1;
    LGesWidth := Width;
    LAbstand := LGesHeight div 3;
    LBHeight := LAbstand * 2;
    LBWidth := LGesWidth - LAbstand - 1;
    LMax := fMaxPos;
    LPos := fPos;
    LBalkenWidth := Round(LPos * (LGesWidth - LAbstand) / LMax);


    //BackgroundLines zeichnen
    LCanvas.Pen.Color := fLineColor;
    LCanvas.MoveTo(LX + LAbstand, 0 + LY);
    LCanvas.LineTo(LX + LAbstand + LBWidth, 0 + LY);
    LCanvas.LineTo(LX + LAbstand + LBWidth, 0 + LBHeight + LY);
    LCanvas.LineTo(LX + LAbstand, 0 + LBHeight + LY);
    LCanvas.LineTo(LX + LAbstand, 0 + LY);

    LCanvas.MoveTo(LX + LAbstand, LBHeight + LY);
    LCanvas.LineTo(LX + LAbstand - (LBHeight div 2), LBHeight + (LBHeight div 2) + LY);
    LCanvas.LineTo(LX + LAbstand + LBWidth - (LBHeight div 2), LBHeight + (LBHeight div 2) + LY);
    LCanvas.LineTo(LX + LAbstand + LBWidth, LBHeight + LY);

    LCanvas.MoveTo(LX + LAbstand, 0 + LY);
    LCanvas.LineTo(LX + LAbstand - (LBHeight div 2), (LBHeight div 2) + LY);
    LCanvas.LineTo(LX + LAbstand - (LBHeight div 2), LBHeight + (LBHeight div 2) + LY);

    if LBalkenWidth > 1 then
    begin
      //Balken zeichnen
      LCanvas.Pen.Color := fBalkenColor1;
      LCanvas.Brush.Color := LCanvas.Pen.Color;
      LCanvas.FillRect(Rect(LX + 1, LAbstand + LY, LX + LBalkenWidth, LAbstand + LBHeight + LY));

      LCanvas.Pen.Color := fBalkenColor2;
      LCanvas.Brush.Color := LCanvas.Pen.Color;
      LCanvas.MoveTo(LX + LBalkenWidth, LAbstand - 1 + LY);
      LCanvas.LineTo(LX + LBalkenWidth + LAbstand - 2, 1 + LY);
      LCanvas.LineTo(LX + LBalkenWidth + LAbstand - 2, LBHeight + LY);
      LCanvas.LineTo(LX + LBalkenWidth, LBHeight + LAbstand - 2 + LY);
      LCanvas.LineTo(LX + LBalkenWidth, LAbstand - 1 + LY);
      LCanvas.FloodFill(LX + LBalkenWidth + 1, LAbstand + LY, LCanvas.Pen.Color, fsBorder);


      LCanvas.Pen.Color := fBalkenColor3;
      LCanvas.Brush.Color := LCanvas.Pen.Color;
      LCanvas.MoveTo(LX + LAbstand + 1, 1 + LY);
      LCanvas.LineTo(LX + LAbstand + LBalkenWidth - 3, 1 + LY);
      LCanvas.LineTo(LX + LBalkenWidth - 1, LAbstand - 1 + LY);
      LCanvas.LineTo(LX + 2, LAbstand - 1 + LY);
      LCanvas.LineTo(LX + LAbstand + 1, 0 + LY);
      if LBalkenwidth > 7 then LCanvas.FloodFill(LX + LAbstand + 1, 2 + LY, LCanvas.Pen.Color, fsBorder);
    end;
  end;
  BitBlt(Canvas.Handle, 0, 0, width, height, LCanvas.Handle, 0, 0, SRCCOPY);
end;

procedure TStatus3DBalken.FSetColors(AIndex: Integer; AValue: TColor);
begin
  if (AIndex = 0) and (AValue <> fBalkenColor1) then
  begin
    fBalkenColor1 := AValue;
    FDrawBalken;
  end else if (AIndex = 1) and (AValue <> fBalkenColor2) then
  begin
    fBalkenColor2 := AValue;
    FDrawBalken;
  end else if (AIndex = 2) and (AValue <> fBalkenColor3) then
  begin
    fBalkenColor3 := AValue;
    FDrawBalken;
  end else if (AIndex = 3) and (AValue <> fLineColor) then
  begin
    fLineColor := AValue;
    FDrawBalken;
  end;
end;

procedure TStatus3DBalken.Paint;
begin
  FDrawBalken;
end;

procedure TStatus3DBalken.FSetMax(AValue: Integer);
begin
  if AValue < 0 then AValue := 0;
  if AValue <> fMaxPos then
  begin
    fMaxPos := AValue;
    if not(fPos < fMaxPos) then Position := fMaxPos;
    FDrawBalken;
  end;
end;

procedure TStatus3DBalken.FSetPos(AValue: Integer);
begin
  if AValue < 0 then AValue := 0 else
  if AValue > fMaxPos then AValue := fMaxPos;
  if (AValue <= fMaxPos) and (AValue <> fPos) then
  begin
    fPos := AValue;
    FDrawBalken;
  end;
end;


end.

ich lasse hier extra offen, sollte noch jemand die exakte kompo finden...