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
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.
-- _______________________________________________ Lazarus mailing list Lazarus@lists.lazarus.freepascal.org http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus