Recent

Author Topic: [SOLVED] TPanel bar MouseWheel step  (Read 677 times)

Pe3s

  • Hero Member
  • *****
  • Posts: 596
[SOLVED] TPanel bar MouseWheel step
« on: November 23, 2023, 05:40:06 pm »
Hello, how can I program the OnMouseWheel event with increments of 5?
Regards

Code: Pascal  [Select][+][-]
  1. uses
  2.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, LCLIntf, Types, Math;
  3.  
  4. type
  5.  
  6.   { TForm1 }
  7.  
  8.   TForm1 = class(TForm)
  9.     Panel1: TPanel;
  10.     Panel2: TPanel;
  11.     procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
  12.       );
  13.     procedure Panel1Paint(Sender: TObject);
  14.   private
  15.  
  16.   public
  17.  
  18.   end;
  19.  
  20. var
  21.   Form1: TForm1;
  22.   BarPos: Integer = 100;
  23.  
  24.  
  25. implementation
  26.  
  27. {$R *.lfm}
  28.  
  29. { TForm1 }
  30.  
  31. procedure TForm1.Panel1Paint(Sender: TObject);
  32. var
  33.   R: TRect;
  34. begin
  35.   with Panel1, Canvas do
  36. begin
  37.   R := Rect(0, 0, Panel1.Width * BarPos div 100, Panel1.Height);
  38.   Brush.Color := RGB(250, 208, 44);
  39.   FillRect(R);
  40. end;
  41. end;
  42.  
  43. procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  44. begin
  45.   if (ssLeft in Shift) then
  46.    begin
  47.      BarPos := EnsureRange(X * 100 div Panel1.Width, 0, 100);
  48.      if(BarPos mod 5) = 0 then
  49.       begin
  50.         Panel1.Invalidate;
  51.         Panel2.Caption := IntToStr(BarPos);
  52.       end;
  53.    end;
  54. end;
  55.  
  56. end.
  57.  
« Last Edit: November 23, 2023, 07:00:06 pm by Pe3s »

Handoko

  • Hero Member
  • *****
  • Posts: 5436
  • My goal: build my own game engine using Lazarus
Re: TPanel bar MouseWheel step
« Reply #1 on: November 23, 2023, 06:23:49 pm »
Done.

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, ExtCtrls, LCLIntf;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     Panel1: TPanel;
  16.     Panel2: TPanel;
  17.     procedure Panel1MouseWheel(Sender: TObject; Shift: TShiftState;
  18.       WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  19.     procedure Panel1Paint(Sender: TObject);
  20.   end;
  21.  
  22. var
  23.   Form1: TForm1;
  24.   BarPos: Integer = 100;
  25.  
  26.  
  27. implementation
  28.  
  29. {$R *.lfm}
  30.  
  31. { TForm1 }
  32.  
  33. procedure TForm1.Panel1Paint(Sender: TObject);
  34. var
  35.   R: TRect;
  36. begin
  37.   with Panel1, Canvas do
  38.   begin
  39.     R := Rect(0, 0, Panel1.Width * BarPos div 100, Panel1.Height);
  40.     Brush.Color := RGB(250, 208, 44);
  41.     FillRect(R);
  42.   end;
  43. end;
  44.  
  45. procedure TForm1.Panel1MouseWheel(Sender: TObject; Shift: TShiftState;
  46.   WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
  47. const
  48.   Step = 5;
  49. begin
  50.   case WheelDelta < 0 of
  51.     True:  BarPos := BarPos - Step;
  52.     False: BarPos := BarPos + Step;
  53.   end;
  54.   if BarPos < 0   then BarPos := 0;
  55.   if BarPos > 100 then BarPos := 100;
  56.   Panel1.Invalidate;
  57.   Panel2.Caption := IntToStr(BarPos);
  58. end;
  59.  
  60. end.

Tested on Ubuntu Mate only, but I think it should work too on Windows.

Pe3s

  • Hero Member
  • *****
  • Posts: 596
Re: TPanel bar MouseWheel step
« Reply #2 on: November 23, 2023, 06:34:08 pm »
@Handoko, I noticed that if we move the mouse bar and then use the mouse wheel, the values ​​do not match. It is possible to make the values ​​the same every 5. Why does this happen?
Regards


Handoko

  • Hero Member
  • *****
  • Posts: 5436
  • My goal: build my own game engine using Lazarus
Re: TPanel bar MouseWheel step
« Reply #3 on: November 23, 2023, 06:42:08 pm »
Add this MouseMove event:

Code: Pascal  [Select][+][-]
  1. procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  2.   Y: Integer);
  3. begin
  4.   if not(ssLeft in Shift) then Exit;
  5.   BarPos := EnsureRange(X * 100 div Panel1.Width, 0, 100);
  6.   BarPos := BarPos - (BarPos mod 5);
  7.   Panel1.Invalidate;
  8.   Panel2.Caption := IntToStr(BarPos);
  9. end;

Pe3s

  • Hero Member
  • *****
  • Posts: 596
Re: TPanel bar MouseWheel step
« Reply #4 on: November 23, 2023, 06:59:50 pm »
@Handoko, Thank you for your help :)
Regards

 

TinyPortal © 2005-2018