Recent

Author Topic: [SOLVED] TPanel slider position  (Read 2112 times)

Handoko

  • Hero Member
  • *****
  • Posts: 5106
  • My goal: build my own game engine using Lazarus
Re: TPanel slider position
« Reply #15 on: December 03, 2023, 04:57:55 pm »
My code has:
procedure GotoPosition(Pos: Integer);


Have you tried it?
Add a TTimer, set its Interval to 100 and add this TTimer.OnTimer event:

Code: Pascal  [Select][+][-]
  1. procedure TForm1.Timer1Timer(Sender: TObject);
  2. const
  3.   Progress: Integer = 0;
  4. begin
  5.   Inc(Progress);
  6.   if Progress > FResultMax then Progress := FResultMin;
  7.   GotoPosition(Progress);
  8. end;

Pe3s

  • Hero Member
  • *****
  • Posts: 533
Re: TPanel slider position
« Reply #16 on: December 03, 2023, 05:22:16 pm »
Unfortunately it does not work. I keep searching

From procedure procedure GotoPosition(Pos: Integer); the bar does not move

Handoko

  • Hero Member
  • *****
  • Posts: 5106
  • My goal: build my own game engine using Lazarus
Re: TPanel slider position
« Reply #17 on: December 03, 2023, 05:29:11 pm »
I don't why it didn't work on your system. It works correctly on my Linux computer.

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     Image1: TImage;
  16.     Image2: TImage;
  17.     Label1: TLabel;
  18.     lbeGoto: TLabeledEdit;
  19.     lbeResultMax: TLabeledEdit;
  20.     lbeResultMin: TLabeledEdit;
  21.     Timer1: TTimer;
  22.     procedure FormCreate(Sender: TObject);
  23.     procedure Image1Click(Sender: TObject);
  24.     procedure Image2MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
  25.       );
  26.     procedure lbeGotoEditingDone(Sender: TObject);
  27.     procedure lbeResultMaxEditingDone(Sender: TObject);
  28.     procedure lbeResultMinEditingDone(Sender: TObject);
  29.     procedure Timer1Timer(Sender: TObject);
  30.   private
  31.     FResultMin: Integer;
  32.     FResultMax: Integer;
  33.     procedure CalculatePosition;
  34.     procedure GotoPosition(Pos: Integer);
  35.   end;
  36.  
  37. var
  38.   Form1: TForm1;
  39.  
  40. implementation
  41.  
  42. {$R *.lfm}
  43.  
  44. { TForm1 }
  45.  
  46. procedure TForm1.lbeResultMaxEditingDone(Sender: TObject);
  47. var
  48.   NewValue: Integer;
  49. begin
  50.   if not(TryStrToInt(lbeResultMax.Text, NewValue)) then
  51.   begin
  52.     lbeResultMax.Text := IntToStr(FResultMax);
  53.     Exit;
  54.   end;
  55.   if NewValue <= FResultMin then
  56.   begin
  57.     lbeResultMax.Text := IntToStr(FResultMax);
  58.     Exit;
  59.   end;
  60.   FResultMax := NewValue;
  61.   CalculatePosition;
  62. end;
  63.  
  64. procedure TForm1.lbeResultMinEditingDone(Sender: TObject);
  65. var
  66.   NewValue: Integer;
  67. begin
  68.   if not(TryStrToInt(lbeResultMin.Text, NewValue)) then
  69.   begin
  70.     lbeResultMin.Text := IntToStr(FResultMin);
  71.     Exit;
  72.   end;
  73.   if NewValue >= FResultMax then
  74.   begin
  75.     lbeResultMin.Text := IntToStr(FResultMin);
  76.     Exit;
  77.   end;
  78.   FResultMin := NewValue;
  79.   CalculatePosition;
  80. end;
  81.  
  82. procedure TForm1.Timer1Timer(Sender: TObject);
  83. const
  84.   Progress: Integer = 0;
  85. begin
  86.   Inc(Progress);
  87.   if Progress > FResultMax then Progress := FResultMin;
  88.   GotoPosition(Progress);
  89. end;
  90.  
  91. procedure TForm1.lbeGotoEditingDone(Sender: TObject);
  92. var
  93.   NewValue: Integer;
  94. begin
  95.   if not(TryStrToInt(lbeGoto.Text, NewValue)) then Exit;
  96.   if (NewValue < FResultMin) or (NewValue > FResultMax) then Exit;
  97.   lbeGoto.Text := '';
  98.   GotoPosition(NewValue);
  99. end;
  100.  
  101. procedure TForm1.Image1Click(Sender: TObject);
  102. var
  103.   NewPos:TPoint;
  104. begin
  105.   NewPos      := ScreenToClient(Mouse.CursorPos);
  106.   Image2.Left := NewPos.X - (Image2.Width div 2);
  107.   CalculatePosition;
  108. end;
  109.  
  110. procedure TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  111. var
  112.   AllowedMin,
  113.   AllowedMax : Integer;
  114. begin
  115.  
  116.   if not(ssLeft in Shift) then Exit;
  117.  
  118.   AllowedMin := Image1.Left;
  119.   AllowedMax := Image1.Left + Image1.Width - Image2.Width;
  120.  
  121.   Image2.Left := Image2.Left + X - (Image2.Width div 2);
  122.   if Image2.Left < AllowedMin then Image2.Left := AllowedMin;
  123.   if Image2.Left > AllowedMax then Image2.Left := AllowedMax;
  124.  
  125.   CalculatePosition;
  126.  
  127. end;
  128.  
  129. procedure TForm1.FormCreate(Sender: TObject);
  130. begin
  131.   FResultMin := StrToInt(lbeResultMin.Text);
  132.   FResultMax := StrToInt(lbeResultMax.Text);
  133. end;
  134.  
  135. procedure TForm1.CalculatePosition;
  136. var
  137.   Result: Integer;
  138. begin
  139.   Result := ((FResultMax-FResultMin) *
  140.             (Image2.Left-Image1.Left) div
  141.             (Image1.Width-Image2.Width)) + FResultMin;
  142.   Label1.Caption := Result.ToString;
  143. end;
  144.  
  145. procedure TForm1.GotoPosition(Pos: Integer);
  146. begin
  147.   Image2.Left := Round((Pos-FResultMin) * (Image1.Width-Image2.Width) /
  148.                  (FResultMax-FResultMin) + Image1.Left);
  149.   Label1.Caption := Pos.ToString;
  150. end;
  151.  
  152. end.

Pe3s

  • Hero Member
  • *****
  • Posts: 533
Re: TPanel slider position
« Reply #18 on: December 03, 2023, 05:46:45 pm »
I reinstalled Lazarus, it works. Thank you again and sorry for the inconvenience


 

TinyPortal © 2005-2018