TPanel in Thread als Progressbar

[DevilsCamp]

Ich habe eine Form mit zwei Buttons, einer Listbox und einem Panel.

Ich habe folgenden Code:

Delphi-Quellcode:

implementation

uses
  anithread;
const
  maxp = 50000;

procedure TForm1.Button1Click(Sender: TObject);
var
  ani : TAnimationThread;
  r   : TRect;
  i   : Integer;
begin
  r := panel1.ClientRect;
  InflateRect(r, - panel1.bevelwidth, - panel1.bevelwidth);

  posi  := 0;
  ani := TAnimationThread.Create(panel1, r, panel1.Color, [clBlack, clBlue], 10, maxp);
  Button1.Enabled := False;
  ListBox1.Items.Clear;

  doit  := true;
  i     := 0;

  while (doit)and(i<=maxp) do
  begin
    ListBox1.Items.Add(Format('%.6d', [i]));
    inc(i);
    posi  := i;

    if (i mod 100)=0 then
      Application.ProcessMessages;
  end;

  Button1.Enabled := True;

  try
    ani.Terminate;
  finally
    ani := nil;
  end;
end;

Der Thread sieht so aus:

Delphi-Quellcode:

unit anithread;

interface

uses
  Classes, Windows, Controls, Graphics, SysUtils;

type
  TAnimationThread = class(TThread)
  private
    { Private declarations }
    FWnd: HWND;
    FPaintRect: TRect;
    FbkColor, FfgColor: TColor;
    FInterval: Integer;
    FMaxPos : Integer;
    FUseColors  : Array of TColor;
    image: TBitmap;
    imrect: TRect;
    procedure DrawGradient(ACanvas: TCanvas; Rect: TRect; Horicontal: Boolean;
      Colors: array of TColor);
    procedure PaintText(ACanvas: TCanvas; PaintRect: TRect; fProzent: Integer);
    procedure ShowCaption;
  protected
    procedure Execute; override;
  public
    constructor Create(paintsurface: TWinControl; {Control to paint on }
      paintrect: TRect;          {area for animation bar }
      bkColor, barcolor: TColor; {colors to use }
      interval: Integer;       {wait in msecs between paints}
      maxpos: Integer); overload;

    constructor Create(paintsurface: TWinControl; {Control to paint on }
      paintrect: TRect;          {area for animation bar }
      bkColor: TColor; bColors: array of TColor; {colors to use }
      interval: Integer;       {wait in msecs between paints}
      maxpos: Integer); overload;

  end;

implementation

uses animprog_main;

constructor TAnimationThread.Create(paintsurface: TWinControl;
  paintrect: TRect; bkColor, barcolor: TColor; interval: Integer; maxpos: Integer);
begin
  inherited Create(True);
  FWnd       := paintsurface.Handle;
  FPaintRect := paintrect;
  FbkColor   := bkColor;
  FfgColor   := barColor;
  FInterval  := interval;
  FreeOnterminate := True;
  FMaxPos   := maxpos;
  SetLength(FUseColors, 1);
  FUseColors[0]  := FfgColor;
  Image := TBitmap.Create;
  Resume;
end; { TAnimationThread.Create }

procedure TAnimationThread.Execute;
var
  Left, Right: Integer;
  increment: Integer;
  state: (incRight, decRight);
  po    : Integer;
  proz  : Integer;
begin
  try
    with Image do
    begin
      Width     := FPaintRect.Right - FPaintRect.Left;
      Height    := FPaintRect.Bottom - FPaintRect.Top;
      imrect := Rect(0, 0, Width, Height);
    end; { with }
    Left      := 0;
    Right     := 0;
    increment := imrect.Right div 50;
    state     := Low(State);
    while not Terminated do
    begin
      with Image.Canvas do
      begin
        Brush.Color := FbkColor;

        FillRect(imrect); // original!
        Brush.Color := FfgColor;

        po  := Form1.posi;

        if (po>FMaxPos) then
          po  := FMaxPos;

        proz  := Round(100.0/FMaxPos*po);

        Right := Round((imrect.Right-imrect.Left+1)*1.0/FMaxPos*po);

        DrawGradient(Image.Canvas, Rect(Left, imrect.Top, Right, imrect.Bottom),
          True, FUseColors);

        PaintText(Image.Canvas, imrect, proz);
      end; { with }

      Synchronize(ShowCaption);
      Sleep(FInterval);
    end; { While }
  finally
    Image.Free;
  end;
  InvalidateRect(FWnd, nil, True);
end; { TAnimationThread.Execute }

procedure TAnimationThread.DrawGradient(ACanvas: TCanvas; Rect: TRect;
  Horicontal: Boolean; Colors: array of TColor);
type
  RGBArray = array[0..2] of Byte;
var
  x, y, z, stelle, mx, bis, faColorsh, mass: Integer;
  Faktor: Double;
  A: RGBArray;
  B: array of RGBArray;
  merkw: Integer;
  merks: TPenStyle;
  merkp: TColor;
begin
  mx := High(Colors);
  if mx > 0 then
  begin
    if Horicontal then
      mass := Rect.Right - Rect.Left
    else
      mass := Rect.Bottom - Rect.Top;
    SetLength(b, mx + 1);
    for x := 0 to mx do
    begin
      Colors[x] := ColorToRGB(Colors[x]);
      b[x][0]   := GetRValue(Colors[x]);
      b[x][1]   := GetGValue(Colors[x]);
      b[x][2]   := GetBValue(Colors[x]);
    end;
    merkw     := ACanvas.Pen.Width;
    merks     := ACanvas.Pen.Style;
    merkp     := ACanvas.Pen.Color;
    ACanvas.Pen.Width := 1;
    ACanvas.Pen.Style := psSolid;
    faColorsh := Round(mass / mx);
    for y := 0 to mx - 1 do
    begin
      if y = mx - 1 then
        bis := mass - y * faColorsh - 1
      else
        bis := faColorsh;
      for x := 0 to bis do
      begin
        Stelle := x + y * faColorsh;
        faktor := x / bis;
        for z := 0 to 2 do
          a[z] := Trunc(b[y][z] + ((b[y + 1][z] - b[y][z]) * Faktor));
        ACanvas.Pen.Color := RGB(a[0], a[1], a[2]);
        if Horicontal then
        begin
          ACanvas.MoveTo(Rect.Left + Stelle, Rect.Top);
          ACanvas.LineTo(Rect.Left + Stelle, Rect.Bottom);
        end
        else
        begin
          ACanvas.MoveTo(Rect.Left, Rect.Top + Stelle);
          ACanvas.LineTo(Rect.Right, Rect.Top + Stelle);
        end;
      end;
    end;
    b := nil;
    ACanvas.Pen.Width := merkw;
    ACanvas.Pen.Style := merks;
    ACanvas.Pen.Color := merkp;
  end
  else
  begin
    merkp := ACanvas.Brush.Color;
    ACanvas.Brush.Color := Colors[0];
    ACanvas.FillRect(Rect);
    ACanvas.Brush.Color := merkp;
  end;
end;


constructor TAnimationThread.Create(paintsurface: TWinControl;
  paintrect: TRect; bkColor: TColor; bColors: array of TColor; interval,
  maxpos: Integer);
var
  i : Integer;
begin
  inherited Create(true);

  FWnd       := paintsurface.Handle;
  FPaintRect := paintrect;
  FbkColor   := bkColor;

  if (Length(bColors)=0) then
  begin
    SetLength(FUseColors, 1);

    FUseColors[0] := RGB(255-GetRValue(ColorToRGB(bkColor)),255-GetGValue(ColorToRGB(bkColor)),255-GetBValue(ColorToRGB(bkColor)));
  end
  else
  begin
    SetLength(FUseColors, Length(bColors));

    for i := 0 to High(bColors) do
      FUseColors[i] := bColors[i];
  end;

  FfgColor   := FUseColors[0];
  FInterval  := interval;
  FreeOnterminate := True;
  FMaxPos   := maxpos;
  Image := TBitmap.Create;
  Resume;
end;

procedure TAnimationThread.PaintText(ACanvas: TCanvas; PaintRect: TRect; fProzent: Integer);
var
  Ima2  : TBitmap;
  s     : String;
  X     : Integer;
  Y     : Integer;
  Width : Integer;
  Height  : Integer;
begin
  if true then
  begin
    Width       := PaintRect.Right-PaintRect.Left+1;
    Height      := PaintRect.Bottom-PaintRect.Top+1;
    Ima2        := TBitmap.Create;
    Ima2.Width  := Width;
    Ima2.Height := Height; 
    
    with Ima2.Canvas do
    begin
      CopyMode := cmBlackness;
      CopyRect(Rect(0, 0, Width, Height), Ima2.Canvas, Rect(0, 0, Width, Height));
      CopyMode := cmSrcCopy;
    end;

    with Ima2.Canvas do
    begin
      Brush.Style := bsClear;
      Font.Color  := clWhite;

      s := Format('%d%%', [fProzent]);
      
      with PaintRect do
      begin
        X := (Right - Left + 1 - TextWidth(S)) div 2;
        Y := (Bottom - Top + 1 - TextHeight(S)) div 2;
      end; // with

      TextRect(PaintRect, X, Y, s);
    end; // with Ima2.Canvas

    ACanvas.CopyMode  := cmSrcInvert;
    ACanvas.Draw(0, 0, Ima2);

    FreeAndNil(Ima2);
  end;
end;

procedure TAnimationThread.ShowCaption;
var
  DC: HDC;
begin
  DC := GetDC(FWnd);
  if DC <> 0 then
    try
      BitBlt(DC,
        FPaintRect.Left,
        FPaintRect.Top,
        imrect.Right,
        imrect.Bottom,
        Image.Canvas.Handle,
        0, 0,
        SRCCOPY);
    finally
      ReleaseDC(FWnd, DC);
    end;
end;

end.

Nun habe ich das komische Verhalten, dass die Execute-Methode des Threads erst ausgeführt wird, wenn die For-Schleife, die die ListBox füllt schon einen Teil abgearbeitet hat.
Da ich bisher nur einmal mit Threads gearbeitet habe frage ich mich schon, ob dies ein normales Verhalten ist und wenn ja, wie ich den Thread dazu bewegen könnte nach dem "Resume" in den Konstruktoren direkt die Execute-Methode aufzurufen.

(den Quellcode für den Thread habe ich beim SwissDelphiCenter gefunden)

[Bernhard Geyer]

ich hab jetzt nur den Titel gelesen: Schon mal was davon gehört das man auf VCL-Control nur im Hautpthread zugreifen darf? Alles andere gibt komischte Effekte.

[TeronG]

Luckie hat da n nettes Tut hilft dir bestimmt weiter.
Hier isses ...

[DevilsCamp]

Zitat:

Zitat von Bernhard Geyer

ich hab jetzt nur den Titel gelesen: Schon mal was davon gehört das man auf VCL-Control nur im Hautpthread zugreifen darf? Alles andere gibt komischte Effekte.

Dann solltest du dir vielleicht erst mal den Code anschauen, bevor du die Tastatur unnötig quälst... :warn:

[Bernhard Geyer]

Zitat:

Zitat von DevilsCamp

Dann solltest du dir vielleicht erst mal den Code anschauen, bevor du die Tastatur unnötig quälst... :warn:

Ich habe halt nur den Hauptfehler bei sowas angesprochen. Nicht gleich beleidigt sein.
Und der Code war mir einfach mal zu lang.