[Delphi] Tstatusbar knippert

[jvdmeer]

Tijdens een lang proces, wil ik de voortgang doorgeven aan de gebruiker op de manier die bijv. Photoshop doet. een voortschreidend blauw balkje op de statusbar.

Dit lukt, maar de statusbar knippert verschrikkelijk. Ik heb het tot nu toe op twee manieren geprobeerd:

Delphi:

TStatuspanel[0].style:=psOwnerdraw

en dan rechtstreeks tekenen op het canvas:

Delphi:

procedure TForm1.StatusbarDrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
    Statusbar.Canvas.[hoop acties]
end;

en daarna heb ik nog geprobeerd via een buffer:

Delphi:

procedure TForm1.StatusbarDrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
var
  w,h:Integer;
  TmpBitmap: TBitmap;
begin
  W := Rect.Right - Rect.Left + 1;
  H := Rect.Bottom-Rect.top+1;
  Try
    TmpBitmap:=TBitmap.Create;
    TmpBitmap.Width:=W;
    Tmpbitmap.Height:=H;

    with TmpBitmap.Canvas do
    begin
       [hoop acties]
    end;

    Statusbar.Canvas.CopyMode:=cmSrcCopy;
    Statusbar.Canvas.CopyRect(Rect,TmpBitmap.Canvas,Classes.Rect(0,0,W,H));

   finally
    TmpBitmap.Free;
  end;
end;

Allebei de mogelijkheden knipperen verschrikkelijk, en dat komt omdat delphi eerst zelf de TStatusbar tekent, en daarna pas de OnDraw aanroept van de afzonderlijke panels.
Weet iemand hier een oplossing voor?

[ Voor 1% gewijzigd door jvdmeer op 02-09-2003 21:43 . Reden: lege regels verwijderd ]

[Creepy]

Heb je al een Form1.doublebuffered:=true geprobeerd??

Anders kan je altijd nog een TStatusbar overerven en OnPaint van deTstatusbar afvangen.

[jvdmeer]

Creepy schreef op 02 September 2003 @ 21:52:
Heb je al een Form1.doublebuffered:=true geprobeerd??

Ja, hielp niet.

Creepy schreef op 02 September 2003 @ 21:52:
Anders kan je altijd nog een TStatusbar overerven en OnPaint van de Tstatusbar afvangen.

Het netste zou zijn, om alleen de Tstatuspanel te overerven, en daar een nieuwe OnPaint voor schrijven. Dan worden de andere panels en de rest van de bar op de normale wijze getekend.
Anders zou ik als ik jouw suggestie volg, de complete statusbar zewlf moeten tekenen, terwijl het mij alleen om 1 Tstatuspanel gaat. De OnPaint van TStatusbar, tekent nu namelijk eerst de hele balk, en vult daarna een voor een de panels. Deze panels controleren of OnDrawEvent is toegewezen, zo niet, wordt het panel blank gemaakt. Maar op dat moment is het voor mij alweer fout gegaan omdat het panel al blanko is gemaakt door TStatusbar.OnPaint. En ik hoop dat ik 't kan oplossen op een andere manier, zonder 25% van de VCL (ComCtrls) te herschrijven.

[OZ-Gump]

Wellicht is het een idee om de acties die je uitvoert tijdens de voortschrijding van je statusbalk in een thread te gooien? Op die manier geef je namelijk volgens mij de statusbalk de mogelijkheid om 'normaal' getekend te worden, terwijl wel al je acties worden uitgevoerd.... Of zit ik er nou helemaal langs

Trouwens, een tijdje geleden ben ik een component tegen gekomen die het inbouwen van componenten in een statusbalk erg goed in elkaar had zitten. Voortgangsbalkjes enzo zaten er allemaal in, en volgens mij zonder knipperen. Ik zal eens kijken of ik die nog kan vinden...

[ Voor 32% gewijzigd door OZ-Gump op 03-09-2003 00:15 ]

[Tomatoman]

Uit eigen werk. Het staat je vrij om de code te gebruiken.

Delphi:

unit StatusBarPanels;

{-------------------------------------------------------------------------------

        Status bar panels

        Copyright (c) 2003 Robin Gerrets. All rights reserved.

  The standard TStatusBar item cannot contain a progress bar.
  TProgressStatusPanel adds this functionality.

-------------------------------------------------------------------------------}

interface

uses
  Windows, Classes, ComCtrls, Graphics;

type
  TProgressStatusPanelClass = class of TProgressStatusPanel;

  TProgressStatusPanel = class(TStatusPanel)
  private
    FAnimatedIncrease: Boolean;
    FAnimatedDecrease: Boolean;
    FProgressBar: TProgressBar;
    FProgressWidth: Integer;
    FStatusPanels: TStatusPanels;
    function GetMax: Integer;
    function GetMin: Integer;
    function GetPosition: Integer;
    function GetSmooth: Boolean;
    function GetStep: Integer;
    function GetWidth: Integer;
    procedure SetMax(const Value: Integer);
    procedure SetMin(const Value: Integer);
    procedure SetPosition(const Value: Integer);
    procedure SetProgressWidth(const Value: Integer);
    procedure SetSmooth(const Value: Boolean);
    procedure SetStep(const Value: Integer);
    procedure SetWidth(const Value: Integer);
  public
    procedure Assign(Source: TPersistent); override;
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Paint(StatusBar: TStatusBar; const Rect: TRect); virtual;
    function TextWidth: Integer;
  published
    property AnimatedDecrease: Boolean read FAnimatedDecrease
      write FAnimatedDecrease default False;
    property AnimatedIncrease: Boolean read FAnimatedIncrease
      write FAnimatedIncrease default True;
    property Max: Integer read GetMax write SetMax default 100;
    property Min: Integer read GetMin write SetMin default 0;
    property Position: Integer read GetPosition write SetPosition;
    property ProgressWidth: Integer read FProgressWidth write SetProgressWidth;
    property Smooth: Boolean read GetSmooth write SetSmooth;
    property Step: Integer read GetStep write SetStep default 10;
    property Width: Integer read GetWidth write SetWidth;
  end;

implementation

type
  TExposedStatusPanels = class(TStatusPanels);

function ExposeStatusPanels(Panels: TStatusPanels): TExposedStatusPanels;
begin
  Result := TExposedStatusPanels(Panels);
end;

function TProgressStatusPanel.GetMax: Integer;
begin
  Result := FProgressBar.Max;
end;

function TProgressStatusPanel.GetMin: Integer;
begin
  Result := FProgressBar.Min;
end;

function TProgressStatusPanel.GetPosition: Integer;
begin
  Result := FProgressBar.Position;
end;

function TProgressStatusPanel.GetSmooth: Boolean;
begin
  Result := FProgressBar.Smooth;
end;

function TProgressStatusPanel.GetStep: Integer;
begin
  Result := FProgressBar.Step;
end;

function TProgressStatusPanel.GetWidth: Integer;
begin
  Result := inherited Width;
end;

procedure TProgressStatusPanel.SetMax(const Value: Integer);
begin
  FProgressBar.Max := Value;
end;

procedure TProgressStatusPanel.SetMin(const Value: Integer);
begin
  FProgressBar.Min := Value;
end;

procedure TProgressStatusPanel.SetPosition(const Value: Integer);

  function Min2(A, B: Integer): Integer;
  begin
    if A < B then
      Result := A
    else
      Result := B;
  end;

  function Max2(A, B: Integer): Integer;
  begin
    if A > B then
      Result := A
    else
      Result := B;
  end;

  procedure Animate(AFrom, ATo, Increment: Integer);
  begin
    FProgressBar.Position := AFrom;
    if Increment > 0 then
      while FProgressBar.Position < ATo do
        FProgressBar.Position := Min2(FProgressBar.Position + Increment, ATo)
    else
      while FProgressBar.Position > ATo do
        FProgressBar.Position := Max2(FProgressBar.Position + Increment, ATo);
  end;

begin
  with FProgressBar do
  begin
    if Position = Value then
      Exit;
    if (Value > Position) and AnimatedIncrease then
      Animate(Max2(Position, Min), Min2(Value, Max), 1)
    else if (Value < Position) and AnimatedDecrease then
      Animate(Min2(Position, Max), Max2(Value, Min), -1)
    else
      Position := Value;
  end;
end;

procedure TProgressStatusPanel.SetProgressWidth(const Value: Integer);
begin
  if FProgressWidth <> Value then
  begin
    FProgressWidth := Value;
    FProgressBar.Width := Value;
    FProgressBar.Visible := (Value > 0) and (ProgressWidth > 0);
    if Assigned(FStatusPanels) then
      ExposeStatusPanels(FStatusPanels).Update(Self);
  end;
end;

procedure TProgressStatusPanel.SetSmooth(const Value: Boolean);
begin
  FProgressBar.Smooth := Value;
end;

procedure TProgressStatusPanel.SetStep(const Value: Integer);
begin
  FProgressBar.Step := Value;
end;

procedure TProgressStatusPanel.SetWidth(const Value: Integer);
begin
  FProgressBar.Visible := (Value > 0) and (ProgressWidth > 0);
  inherited Width := Value;
end;

procedure TProgressStatusPanel.Assign(Source: TPersistent);
begin
  if Source is TStatusPanel then
  begin
    AnimatedDecrease := TProgressStatusPanel(Source).AnimatedDecrease;
    AnimatedIncrease := TProgressStatusPanel(Source).AnimatedIncrease;
    Max := TProgressStatusPanel(Source).Max;
    Min := TProgressStatusPanel(Source).Min;
    Position := TProgressStatusPanel(Source).Position;
    ProgressWidth := TProgressStatusPanel(Source).ProgressWidth;
    Smooth := TProgressStatusPanel(Source).Smooth;
    Step := TProgressStatusPanel(Source).Step;
  end
  else if Source is TProgressBar then
  begin
    Max := TProgressBar(Source).Max;
    Min := TProgressBar(Source).Min;
    Position := TProgressBar(Source).Position;
    ProgressWidth := TProgressBar(Source).Width;
    Smooth := TProgressBar(Source).Smooth;
    Step := TProgressBar(Source).Step;
  end
  else
    inherited Assign(Source);
end;

constructor TProgressStatusPanel.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  if Collection is TStatusPanels then
    FStatusPanels := TStatusPanels(Collection);
  FProgressBar := TProgressBar.Create(nil);
  Bevel := pbNone;
  Style := psOwnerDraw;
  FAnimatedIncrease := True;
  ProgressWidth := 100;
  inherited Width := 200;
end;

destructor TProgressStatusPanel.Destroy;
begin
  FProgressBar.Free;
  inherited;
end;

procedure TProgressStatusPanel.Paint(StatusBar: TStatusBar; const Rect: TRect);
var
  ProgRect, TextRect: TRect;
  BorderDecrease, TextVertOffset, TextWidth, TextLeft: Integer;
begin
  if Assigned(StatusBar) then
  begin
    { paint progress bar }
    FProgressBar.ParentWindow := StatusBar.Handle;
    BorderDecrease := Width - (Rect.Right - Rect.Left);
    ProgRect := Rect;
    ProgRect.Right := ProgRect.Left + ProgressWidth - BorderDecrease;
    FProgressBar.BoundsRect := ProgRect;
    if FProgressBar.Visible and (ProgRect.Left < ProgRect.Right) then
      FProgressBar.PaintTo(StatusBar.Canvas.Handle, ProgRect.Left, ProgRect.Top);

    { paint text }
    if Text <> '' then
    begin
      TextRect := Rect;
      TextRect.Left := ProgRect.Right + 4;
      if TextRect.Left < TextRect.Right then
        with TextRect do
        begin
          TextVertOffset := (Bottom - Top -
            StatusBar.Canvas.TextHeight('Pp')) div 2;
          TextWidth := StatusBar.Canvas.TextWidth(Text);
          case Alignment of
            taLeftJustify: TextLeft := Left;
            taCenter: TextLeft := Left + (Right - Left - TextWidth) div 2;
          else // taRightJustify:
            TextLeft := Right - TextWidth;
          end;
          StatusBar.Canvas.Brush.Style := bsClear;
          StatusBar.Canvas.TextRect(TextRect, TextLeft, Top + TextVertOffset,
            Text);
        end;
    end;
  end;
end;

function TProgressStatusPanel.TextWidth: Integer;
begin
  Result := Width - ProgressWidth;
end;

end.

Je gebruikt de code als volgt:

Delphi:

type
  TForm1 = class(TForm)
    StatusBar: TStatusBar;
    procedure FormCreate(Sender: TObject);
    procedure StatusBarDrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const Rect: TRect);
    procedure StatusBarCreatePanelClass(Sender: TCustomStatusBar;
      var PanelClass: TStatusPanelClass);
  private
    FProgressPanel: TProgressStatusPanel;
  end;

...

procedure TForm1.FormCreate(Sender: TObject);
begin
  try
    StatusBar.Panels.BeginUpdate;
    FProgressPanel := StatusBar.Panels.AddItem(nil, 0) as TProgressStatusPanel;
    StatusBar.OnCreatePanelClass := nil;

    // En nu een beetje met de belangrijkste properties spelen.
    FProgressPanel.Position := 50;
    FProgressPanel.Width := 400;
    FProgressPanel.ProgressWidth := 200;
    FProgressPanel.Text := 'Some status text';
  finally
    StatusBar.Panels.EndUpdate;
  end;
end;

procedure TForm1.StatusBarDrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
  if Panel = FProgressPanel then
    FProgressPanel.Paint(StatusBar, Rect);
end;

procedure TForm1.StatusBarCreatePanelClass(Sender: TCustomStatusBar;
  var PanelClass: TStatusPanelClass);
begin
  PanelClass := TProgressStatusPanel;
end;

[ Voor 5% gewijzigd door Tomatoman op 03-09-2003 00:56 ]

[Creepy]

jvdmeer schreef op 02 September 2003 @ 22:45:
[...]

Ja, hielp niet.

Zeg dat dan, scheelt mij weer domme vragen stellen

Het netste zou zijn, om alleen de Tstatuspanel te overerven, en daar een nieuwe OnPaint voor schrijven. Dan worden de andere panels en de rest van de bar op de normale wijze getekend.
Anders zou ik als ik jouw suggestie volg, de complete statusbar zewlf moeten tekenen, terwijl het mij alleen om 1 Tstatuspanel gaat. De OnPaint van TStatusbar, tekent nu namelijk eerst de hele balk, en vult daarna een voor een de panels. Deze panels controleren of OnDrawEvent is toegewezen, zo niet, wordt het panel blank gemaakt. Maar op dat moment is het voor mij alweer fout gegaan omdat het panel al blanko is gemaakt door TStatusbar.OnPaint. En ik hoop dat ik 't kan oplossen op een andere manier, zonder 25% van de VCL (ComCtrls) te herschrijven.

Right, you got me there!

[alienfruit]

Je had ook gewoon DevExpress' status bar of die van Brad Stowers kunnen gebruiken

[Verwijderd]

jvdmeer schreef op 02 September 2003 @ 22:45:
En ik hoop dat ik 't kan oplossen op een andere manier, zonder 25% van de VCL (ComCtrls) te herschrijven.

Zal wel meevallen...
Tomatoman's code ziet er erg bruikbaar uit (tip aan tomatoman: maak er een component van, met een Register procedure, design time properties, etc. en je kunt een hoop minder ervaren Delphi-ers heel blij maken).

Maar eigenlijk is bij jou het enige wat je hoeft te doen: een TStatusBar afgeleide maken die de WM_PAINT message afvangt.
VCL source mag ik niet posten, maar wat de WMPaint procedure van TStatusBar doet is het updaten van ieder panel op die statusbar. Jij weet op welk panel je progressbar moet komen, dus kun je dat in WMPaint afvangen en niet door de standaard UpdatePanel() laten afhandelen.

[jvdmeer]

tomatoman schreef op 03 september 2003 @ 00:37:
Uit eigen werk. Het staat je vrij om de code te gebruiken.

[mega cut]

procedure TForm1.StatusBarDrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
begin
if Panel = FProgressPanel then
FProgressPanel.Paint(StatusBar, Rect);
end;

Deze ga ik vanavond proberen. Maar zo ver ik door de code kijk, lijk ik op hetzelfde probleem te lopen. Allereerst wordt de complete statusbar getekend, en daarna worden de TStatuspanel.OnDrawEvent aangeroepen met daarin bovenstaande functie.
Dus volgens mij blijft'ie knipperen.

alienfruit schreef op 03 September 2003 @ 10:59:
Je had ook gewoon DevExpress' status bar of die van Brad Stowers kunnen gebruiken

Ga ik naar op zoek.

Verwijderd schreef op 03 september 2003 @ 13:17:Maar eigenlijk is bij jou het enige wat je hoeft te doen: een TStatusBar afgeleide maken die de WM_PAINT message afvangt.
VCL source mag ik niet posten, maar wat de WMPaint procedure van TStatusBar doet is het updaten van ieder panel op die statusbar. Jij weet op welk panel je progressbar moet komen, dus kun je dat in WMPaint afvangen en niet door de standaard UpdatePanel() laten afhandelen.

Probleem blijft, ook in dit geval dat de TStatusbar eerst zichzelf tekent en daarna pas de panels.Dus als ik de WM_Paint afvang, zal ik volgens mij (correct me if i'm wrong) zelf de complete statusbalk moeten tekenen.

[Verwijderd]

TStatusBar bestaat alleen maar uit TStatusPanels, en hoeft zichzelf dus niet te tekenen (doet 'ie ook niet).
Wat 'ie doet is "UpdatePanels({UpdateRect=}False, {UpdateText=}True);".
En UpdatePanels roept vervolgens UpdatePanel() aan voor ieder panel in de statusbar. Daar kun je vrij simpel dat ene panel met een progressbar buitenhouden, dunkt me...

Edit:
Mocht de inherited WMPaint voor het knipperen zorgen (lijkt me stug, TStatusBar inherit direct van TWinControl), dan kan LockWindowUpdate je nog wel helpen.

Delphi:

TMyStatusBar.WMPaint(var Message: TWMPaint);
LockWindowUpdate(Handle);
try
  // de WMPaint override
finally
  LockWindowUpdate(0);
end;

[ Voor 35% gewijzigd door Verwijderd op 03-09-2003 14:06 ]

[alienfruit]

Je zou ook de Progress bar als custom draw kunnen implementeren ipv. van TProgressBar gebruik te maken, zal waarschijnlijk ook wel het probleem oplossen

Gewoon effe TStatusbar overriden in je unit, dat doe ik zelf ook als ik de werking van een TForm even snel wil aanpassen.

[jvdmeer]

Verwijderd schreef op 03 September 2003 @ 13:55:
TStatusBar bestaat alleen maar uit TStatusPanels, en hoeft zichzelf dus niet te tekenen (doet 'ie ook niet).
Wat 'ie doet is "UpdatePanels({UpdateRect=}False, {UpdateText=}True);".
En UpdatePanels roept vervolgens UpdatePanel() aan voor ieder panel in de statusbar. Daar kun je vrij simpel dat ene panel met een progressbar buitenhouden, dunkt me...

Volgens worden de randen van de panels eerst getekend, zie r.5820 en 5821 van comctrls.pas (D7) en roept hij daarna pas UpdatePanel aan. En het lijkt er op dat die randen ook het centrum blank maken.

[Verwijderd]

r.5820 komt bij mij (D6) in TCustomStatusBar.CMColorChanged uit. Lijkt me niet dat je dat bedoelt.

Maar wanneer je UpdatePanels bedoelt, die SB_SETPARTS en SB_SETTEXT messages worden alleen verstuurd als UpdateRect True is, en in 't WMPaint event is dat niet het geval.

[alienfruit]

http://www.torry.net/statusbars.htm

[Tomatoman]

Het probleem is dat al het paintwerk door TCustomStatusBar wordt gedaan en niet door de status panels. Het is wel mogelijk om de CM_COLORCHANGED message in de status bar af te vangen door de WindowProc te subclassen, maar welk object moet die subclassing dan doen?

Het is onlogisch om dat door een zelfgemaakt status panel (zeg TMijnStatusPanel) te laten doen, want dan zou de originele WindowProc net zo vaak worden 'gesubclasst' als er TMijnStatusPanel objecten zijn. Dat gaat fout tijdens het restoren van de originele WindowProc.

De meest voor de hand liggende oplossing is een centraal proxy object maken dat de window subclassing regelt. Zodra het proxy object constateert dat er een CM_COLORCHANGED voorbijkomt in een status bar, moet het in de message genoemde TMijnStatusPanel een Paint opdracht krijgen. Dit principe werkt wel, maar is niet eenvoudig.

[ Voor 5% gewijzigd door Tomatoman op 03-09-2003 18:14 ]

[Delpix]

Het is toch mogelijk om een Progressbar in een Statusbar te plaatsen? Niet in de designtime dan, alleen tijdens runtime. Iets van:

Progressbar.parentwindow := Statusbar.handle;

(ik heb hier geen Delphi bij de hand, dus teste kan ik niet. Ik weet wel dat het op zo?n manier mogelijk is)

edit: ow.. zoiets stond ook al ergens in de code van tomatoman

[ Voor 13% gewijzigd door Delpix op 03-09-2003 20:32 ]

[jvdmeer]

alienfruit schreef op 03 September 2003 @ 14:44:
http://www.torry.net/statusbars.htm

Mijn keuze is gevallen op MxStatusbar, omdat die gratis is, source meelevert en D7 ondersteund. En die lijkt goed te werken. Is makkelijker dan een zelf de componenten te schrijven.

[alienfruit]

Oki doki, volgens mij zat bij dfsStatusbar toch ook source, en onderstunt ie ook Delphi 7

[jvdmeer]

alienfruit schreef op 04 September 2003 @ 09:47:
Oki doki, volgens mij zat bij dfsStatusbar toch ook source, en onderstunt ie ook Delphi 7

TdfsStatusBar v.1.24 FWS 49 Kb 29.06.01
By Brad Stowers. A status bar that provides many common specialized panels. The main features are key lock indicators (caps, num, scroll), gauges, images, ellipsis text, and date/time. Also, the status bar can own other components (i.e. you can drop something on it in the IDE).

Fully functional
Source: Included
Download: CB3 CB4 CB5 D3 D4 D5 D6

D7 staat niet in de lijst...

[ Voor 3% gewijzigd door jvdmeer op 04-09-2003 13:12 ]