[Lazarus] Scroll Wheel

Howard Page-Clark hdpc at talktalk.net
Fri Apr 11 21:21:59 CEST 2014


On 11/04/2014 19:33, Timothy Groves wrote:
> No; I am unsure as to how to do that. Would I need to create a
> descendant class, or does Lazarus support overriding without doing so?

The following should give you an idea how to develop the hint Mattias gave:

===code===
unit testIntWheelEdit;

{$mode objfpc}{$H+}

interface

uses
   SysUtils, Forms, StdCtrls, LMessages, Spin, Classes;

type

   { TIntWheelEdit }

   TIntWheelEdit=class(TCustomEdit)
   private
     function GetAsInteger: integer;
   protected
     procedure WMMouseWheel(var Message: TLMMouseEvent); message 
LM_MOUSEWHEEL;
     procedure KeyPress(var Key: char); override;
   public
     property AsInteger: integer read GetAsInteger;
   end;

   { TForm1 }

   TForm1 = class(TForm)
     procedure FormCreate(Sender: TObject);
   private
     intEdit: TIntWheelEdit;
     spinEdit: TSpinEdit;
     procedure IntEditChange(Sender: TObject);
   end;

var
   Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
   intEdit:=TIntWheelEdit.Create(Self);
   intEdit.Left:=10;
   intEdit.Top:=10;
   intEdit.OnChange:=@IntEditChange;
   intEdit.TabOrder:=0;
   intEdit.Parent:=Self;

   spinEdit:=TSpinEdit.Create(Self);
   spinEdit.Top:=10;
   spinEdit.Left:=100;
   spinEdit.MinValue:=-1000;
   spinEdit.MaxValue:=1000;
   spinEdit.ReadOnly:=True;
   spinEdit.Parent:=Self;
end;

procedure TForm1.IntEditChange(Sender: TObject);
begin
   if Sender is TIntWheelEdit then
     spinEdit.Value:=TIntWheelEdit(Sender).AsInteger;
end;

{ TIntWheelEdit }

function TIntWheelEdit.GetAsInteger: integer;
begin
   Result:=StrToIntDef(Text, 0);
end;

procedure TIntWheelEdit.WMMouseWheel(var Message: TLMMouseEvent);
var
   i: integer;
begin
   i:=StrToIntDef(Text, 0);
   if Message.WheelDelta >=0 then
     Inc(i)
   else Dec(i);
   Text:=IntToStr(i);
   Message.Result:=1;
end;

procedure TIntWheelEdit.KeyPress(var Key: char);
begin
   case Length(Text)=0 of
     False: if Key in [#8,'0'..'9'] then
              inherited KeyPress(Key)
            else Key:=#0;
     True:  if Key in [#8,'-','0'..'9'] then
              inherited KeyPress(Key)
            else Key := #0;
   end;
end;

end.
===code end===





More information about the Lazarus mailing list