Recent

Author Topic: Scroll in Label  (Read 2463 times)

Zittergie

  • Full Member
  • ***
  • Posts: 103
    • XiX Music Player
Scroll in Label
« on: July 16, 2014, 10:52:05 pm »
Hi,

is it possible to scroll up and down in a label.  The label has a fixed height and wordwrap is TRUE.
See the picture.  I would like to add a possibility to scroll the lyrics up and down (or a scrollbar) when the lyrics are bigger than the label.

Greetz,
Bart

(Lazarus version 1.3 - FPC 2.6.2 - SVN 45889)
Be the difference that makes a difference

Blaazen

  • Hero Member
  • *****
  • Posts: 2782
  • POKE 54296,15
    • Eye-Candy Controls
Re: Scroll in Label
« Reply #1 on: July 16, 2014, 11:00:44 pm »
Hi,

you can take a look at Lazarus -> Help -> About Lazarus, tab Contributors, and search the sources.
Lazarus 2.1.0 r59757M FPC 3.3.1 r40507 x86_64-linux-qt Chakra, Qt 4.8.7/5.11.2, Plasma 5.14.2
Lazarus 1.8.2 r57369 FPC 3.0.4 i386-win32-win32/win64 Wine 3.21

Try Eye-Candy Controls: https://sourceforge.net/projects/eccontrols/files/

taazz

  • Hero Member
  • *****
  • Posts: 5363
Re: Scroll in Label
« Reply #2 on: July 16, 2014, 11:23:55 pm »
erm make the label autosize and put it inside a scroll box
Good judgement is the result of experience … Experience is the result of bad judgement.

OS : Windows 7 64 bit
Laz: Lazarus 1.4.4 FPC 2.6.4 i386-win32-win32/win64

typo

  • Hero Member
  • *****
  • Posts: 3051
Re: Scroll in Label
« Reply #3 on: July 17, 2014, 12:07:12 am »
Or, if you don't want the user can scroll it, you could put it into a TPanel and scroll it programatically.

Zittergie

  • Full Member
  • ***
  • Posts: 103
    • XiX Music Player
Re: Scroll in Label
« Reply #4 on: July 17, 2014, 10:22:36 am »
Forgot to mention, the lyric should have to stay transparent.
Scrollbox works, but I don't find a way to make the box transparent. Setting the color to 'none' makes the box White.
Be the difference that makes a difference

RAW

  • Hero Member
  • *****
  • Posts: 781
Re: Scroll in Label
« Reply #5 on: July 30, 2019, 08:30:24 pm »
I know this thread is old, but maybe someone else needs this in the future too ...  :)
The text isn't transparent, but the background is ...

This scrolls very nice:
// BrushStyle:= bsClear (Transparent Background)
Code: Pascal  [Select]
  1. UNIT uWpLabelBasic;
  2. {$MODE OBJFPC}{$H+}
  3.  
  4. INTERFACE
  5.  
  6. USES
  7.   Classes,
  8.   Controls,
  9.   Graphics;
  10.  
  11. TYPE
  12.   TScrollBasic = Class(TGraphicControl)
  13.    PRIVATE
  14.     slItems    : TStrings;
  15.     iTopLine   : Integer;
  16.     iItemHeight: Integer;
  17.     iAddHeight : Integer; // additional space between text and top/bottom (sum)
  18.     iTextPos   : Integer;
  19.     bsBrush    : TBrushStyle;
  20.     Function  GetCaption   : String;
  21.     Procedure SetCaption   (Const str: String);
  22.     Function  GetFont      : TFont;
  23.     Procedure SetFont      (Const Ft: TFont);
  24.     Procedure SetItems     (Const sl: TStrings);
  25.     Procedure SetBrush     (Const bs: TBrushStyle);
  26.     Procedure SetAddHeight (Const i: Integer);
  27.     Procedure SetTextPos   (Const i: Integer);
  28.    PUBLIC
  29.     Constructor Create           (AOwner: TComponent); Override;
  30.     Destructor  Destroy;         Override;
  31.     Procedure   Paint;           Override;
  32.     Function    ItemsPerPage     : Integer;
  33.     Procedure   ScrollBy         (i: Integer);
  34.     Procedure   ScrollTo         (i: Integer);
  35.     Procedure   MouseWheelScroll (iLeft, iMaxLine, iScroll: Integer;
  36.                                   Shift: TShiftState; WheelDelta: Integer);
  37.     Procedure  KeyboardVkRight (iMaxLine, iScroll: Integer; Shift: TShiftState);
  38.     Procedure  KeyboardVkLeft  (iLeft, iScroll: Integer; Shift: TShiftState);
  39.    PUBLISHED
  40.     Property Color;
  41.     Property TopLine: Integer Read iTopLine;
  42.     Property AddHeight: Integer Read iAddHeight Write SetAddHeight Default 0;
  43.     Property TextPos: Integer Read iTextPos Write SetTextPos Default 0;
  44.     Property Items: TStrings Read slItems Write SetItems;
  45.     Property Font: TFont Read GetFont Write SetFont;
  46.     Property Caption: String Read GetCaption Write SetCaption;
  47.     Property BrushStyle: TBrushStyle Read bsBrush Write SetBrush;
  48.     Property OnMouseMove;
  49.     Property OnMouseDown;
  50.   End;
  51.  
  52. IMPLEMENTATION
  53.  
  54. Constructor TScrollBasic.Create(AOwner: TComponent);
  55. Begin
  56.   Inherited;
  57.   slItems:= TStringList.Create;
  58. End;
  59.  
  60. Destructor TScrollBasic.Destroy;
  61. Begin
  62.   slItems.Free;
  63.   Inherited;
  64. End;
  65.  
  66. Function TScrollBasic.GetCaption: String;
  67. Begin
  68.   Result:= slItems.Text;
  69. End;
  70.  
  71. Procedure TScrollBasic.SetCaption(Const str: String);
  72. Begin
  73.   slItems.Text:= str;
  74.   iTopLine:= 0;
  75.   Invalidate;
  76. End;
  77.  
  78. Function TScrollBasic.GetFont: TFont;
  79. Begin
  80.   Result:= Inherited Font;
  81. End;
  82.  
  83. Procedure TScrollBasic.SetFont(Const Ft: TFont);
  84. Begin
  85.   Inherited Font:= Ft;
  86.   Canvas.Font:= Ft;
  87.   iItemHeight:= Canvas.TextHeight('Û')+iAddHeight;
  88. End;
  89.  
  90. Procedure TScrollBasic.SetItems(Const sl: TStrings);
  91. Begin
  92.   slItems.Assign(sl);
  93.   iTopLine:= 0;
  94.   Invalidate;
  95. End;
  96.  
  97. Function TScrollBasic.ItemsPerPage: Integer;
  98. Begin
  99.   Result:= Height Div iItemHeight;
  100. End;
  101.  
  102. Procedure TScrollBasic.SetAddHeight(Const i: Integer);
  103. Begin
  104.   iAddHeight:= i;
  105.   Invalidate;
  106. End;
  107.  
  108. Procedure TScrollBasic.SetTextPos(Const i: Integer);
  109. Begin
  110.   iTextPos:= i;
  111. End;
  112.  
  113. Procedure TScrollBasic.SetBrush(Const bs: TBrushStyle);
  114. Begin
  115.   bsBrush:= bs;
  116.   Invalidate;
  117. End;
  118.  
  119. Procedure TScrollBasic.Paint;
  120. Var
  121.  i, iy: Integer;
  122. Begin
  123.   Canvas.Font.Assign(Font);
  124.    If iItemHeight = 0
  125.    Then iItemHeight:= Canvas.TextHeight('Û')+iAddHeight;
  126.   Canvas.Brush.Style:= bsBrush;
  127.    If (Canvas.Brush.Style <> bsClear)
  128.    Then
  129.     Begin
  130.       Canvas.Brush.Color:= Color;
  131.       Canvas.FillRect(Rect(0, 0, Width, Height));
  132.     End;
  133.  
  134.    i:= iTopLine;
  135.    iy:= 0;
  136.  
  137.   While (iy < Height) And (i < slItems.Count)
  138.   Do
  139.    Begin
  140.     Canvas.TextOut(iTextPos, iy+(iAddHeight SHR 1), slItems[i]);
  141.     Inc(iy, iItemHeight);
  142.     Inc(i);
  143.    End;
  144. End;
  145.  
  146. Procedure TScrollBasic.ScrollTo(i: Integer);
  147. Begin
  148.   If slItems.Count <= ItemsPerPage Then Exit;
  149.   If i < 0 Then i:= 0
  150.   Else
  151.    Begin
  152.     If i+ItemsPerPage >= slItems.Count
  153.     Then i:= slItems.Count-ItemsPerPage;
  154.    End;
  155.   iTopLine:= i;
  156.   Invalidate;
  157. End;
  158.  
  159. Procedure TScrollBasic.ScrollBy(i: Integer);
  160. Begin
  161.   ScrollTo(iTopLine+i);
  162. End;
  163.  
  164. Procedure TScrollBasic.KeyboardVkLeft
  165. (iLeft, iScroll: Integer; Shift: TShiftState);
  166. Begin
  167.   If Shift = [ssSHIFT]
  168.   Then
  169.    Begin
  170.      iTextPos:= iLeft;
  171.      Invalidate;
  172.    End
  173.   Else If Shift = []
  174.   Then
  175.    Begin
  176.      iTextPos:= iTextPos+iScroll;
  177.      If iTextPos > iLeft Then iTextPos:= iLeft;
  178.      Invalidate;
  179.    End;
  180. End;
  181.  
  182. Procedure TScrollBasic.KeyboardVkRight
  183. (iMaxLine, iScroll: Integer; Shift: TShiftState);
  184. Begin
  185.   If Shift = [ssSHIFT]
  186.   Then
  187.    Begin
  188.      If iMaxLine > Width
  189.      Then
  190.       Begin
  191.         iTextPos:= Width-iMaxLine-10;
  192.         Invalidate;
  193.       End;
  194.    End
  195.   Else If Shift = []
  196.   Then
  197.    Begin
  198.      If iMaxLine > Width
  199.      Then
  200.       Begin
  201.         iTextPos:= iTextPos-iScroll;
  202.         If iTextPos < Width-iMaxLine
  203.         Then iTextPos:= Width-iMaxLine-10;
  204.         Invalidate;
  205.       End;
  206.    End;
  207. End;
  208.  
  209. Procedure TScrollBasic.MouseWheelScroll
  210. (iLeft, iMaxLine, iScroll: Integer; Shift: TShiftState; WheelDelta: Integer);
  211. Begin
  212.   If Shift = []
  213.   Then
  214.    Begin
  215.      If WheelDelta > 0
  216.      Then ScrollBy(-1)
  217.      Else ScrollBy(+1);
  218.    End
  219.   Else If Shift = [ssCTRL]
  220.   Then
  221.    Begin
  222.      If WheelDelta > 0
  223.      Then ScrolLBy(-ItemsPerPage)
  224.      Else ScrolLBy(+ItemsPerPage);
  225.    End
  226.   Else If Shift = [ssSHIFT]
  227.   Then
  228.    Begin
  229.     If WheelDelta > 0
  230.     Then
  231.      Begin
  232.       If iMaxLine > Width
  233.       Then
  234.        Begin
  235.          iTextPos:= iTextPos+iScroll;
  236.          If iTextPos > iLeft Then iTextPos:= iLeft;
  237.          Invalidate;
  238.        End;
  239.      End
  240.     Else
  241.      Begin
  242.       If iMaxLine > Width
  243.       Then
  244.        Begin
  245.          iTextPos:= iTextPos-iScroll;
  246.          If iTextPos < Width-iMaxLine
  247.          Then iTextPos:= Width-iMaxLine-10;
  248.          Invalidate;
  249.        End;
  250.      End;
  251.    End;
  252. End;
  253.  
  254. {
  255. Procedure TWndMain.FormKeyDown
  256. (Sender: TObject; Var Key: Word; Shift: TShiftState);
  257. Begin
  258.   Case Key Of
  259.    VK_UP   : wpLabel.ScrollBy(-1);
  260.    VK_DOWN : wpLabel.ScrollBy(+1);
  261.    VK_PRIOR: wpLabel.ScrolLBy(-wpLabel.ItemsPerPage);
  262.    VK_NEXT : wpLabel.ScrollBy(+wpLabel.ItemsPerPage);
  263.    VK_HOME : wpLabel.ScrollTo(0);
  264.    VK_END  : wpLabel.ScrollTo(wpLabel.Items.Count);
  265.    VK_LEFT : wpLabel.KeyboardVkLeft(0, 30, Shift);
  266.    VK_RIGHT: wpLabel.KeyboardVkRight(iLongLine, 30, Shift);
  267.   End;
  268. End;
  269.  
  270. Procedure TwndMain.FormMouseWheel
  271. (Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint;
  272.  Var Handled: Boolean);
  273. Begin
  274.   wpLabel.MouseWheelScroll(0, iLongLine, 30, Shift, WheelDelta);
  275. End;
  276.  
  277. Procedure TwndMain.FormResize(Sender: TObject);
  278. Begin
  279.   wpLabel.TextPos:= 0;
  280.   wpLabel.SetBounds(0, 0, ClientWidth, ClientHeight);
  281. End;
  282. }
  283. END.
« Last Edit: August 15, 2019, 11:53:03 pm by RAW »
Windows 7 Pro (x64 Sp1) And Windows XP Pro (x86 Sp3) - LAZARUS 2.0.4 FPC 3.0.4 - TRUNK 2.1.0 FPC 3.3.1