[Lazarus] Smooth scrolling label (marquee)

[Graeme Geldenhuys]

On 2015-11-10 21:16, Luca Olivetti wrote:
> Here is the component I adapted from the forum posting.

I quickly created my own scrolling label test widget for fpGUI. Attached
is the unit. I set the scrolling step to 2 pixels and scrolling speed at
20 milliseconds. It uses a fpGUI Timer (no threads). I didn't even use
AggPas, just the standard Canvas.DrawText().

The result is a smooth horizontal scroll at a readable speed. CPU load
was a constant 0.5% which is considered pretty much idle. Moving the
mouse or the window makes no difference to the scrolling speed.

Feel free to port that to LCL and see how it fares.

Regards,
  - Graeme -

-- 
fpGUI Toolkit - a cross-platform GUI toolkit using Free Pascal
http://fpgui.sourceforge.net/

My public PGP key:  http://tinyurl.com/graeme-pgp
-------------- next part --------------
unit scrollinglabel;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, fpg_base, fpg_main, fpg_widget, fpg_label;

type
  TScrollingLabel = class(TfpgLabel)
  private
    FScrolling: boolean;
    FNeedsCalc: Boolean;
    FTimer: TfpgTimer;
    FOffset: integer;
    FTextWidth: integer;
    procedure SetScrolling(AValue: boolean);
    procedure TimerFired(Sender: TObject);
  protected
    procedure HandlePaint; override;
  public
    constructor Create(AOwner: TComponent); override;
    property Scrolling: boolean read FScrolling write SetScrolling;
  end;

implementation

{ TScrollingLabel }

procedure TScrollingLabel.TimerFired(Sender: TObject);
begin
  Inc(FOffset, 2);  // step
  Invalidate;
end;

procedure TScrollingLabel.SetScrolling(AValue: boolean);
begin
  if FScrolling = AValue then Exit;
  FScrolling := AValue;
  FTimer.Enabled := FScrolling;
end;

procedure TScrollingLabel.HandlePaint;
var
  lTxtFlags: TfpgTextFlags;
begin
  if FNeedsCalc then
  begin
    FTextWidth := Font.TextWidth(Text);
    FNeedsCalc := False;
  end;
  Canvas.Clear(clWindowBackground);
  Canvas.SetFont(Font);
  if Enabled then
    Canvas.SetTextColor(FTextColor)
  else
    Canvas.SetTextColor(clShadow1);

  lTxtFlags:= [];
  if not Enabled then
    Include(lTxtFlags, txtDisabled);

  Include(lTxtFlags, txtLeft);
  Include(lTxtFlags, txtVCenter);

  FTextHeight := Canvas.DrawText(Width-FOffset, 0, Width, Height, FText, lTxtFlags);
  if FOffset > (Width + FTextWidth) then
    FOffset := 0; // wrap the scrolling
end;

constructor TScrollingLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FScrolling := False;
  FNeedsCalc := True;
  FOffset := 0;

  FTimer := TfpgTimer.Create(20); // scroll speed
  FTimer.OnTimer := @TimerFired;
end;

end.