Re: [Lazarus] Scroll Wheel

[Howard Page-Clark]

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===


--
_______________________________________________
Lazarus mailing list
Lazarus@lists.lazarus.freepascal.org
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus