lazarus/examples/mousebuttons/uform.pas

unit uform;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, Types;

type

  { TFormMain }

  TFormMain = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    ShapeButtonExtra2: TShape;
    ShapeButtonLeft: TShape;
    ShapeButtonExtra1: TShape;
    ShapeButtonRight: TShape;
    ShapeWheel: TShape;
    ShapeWheelUp: TShape;
    ShapeWheelDown: TShape;
    ShapeWheelRight: TShape;
    ShapeWheelLeft: TShape;
    procedure FormCreate(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseWheelLeft(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseWheelRight(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
    procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: Boolean);
  private

  public

  end;

var
  FormMain: TFormMain;

implementation

{$R *.lfm}

const
  color_On = clGreen;
  color_Off = clWhite;
  cDelay = 100;

procedure DoBlink(C: TShape);
begin
  C.Brush.Color:= color_On;
  Application.ProcessMessages;
  Sleep(cDelay);
  C.Brush.Color:= color_Off;
end;

{ TFormMain }

procedure TFormMain.FormCreate(Sender: TObject);
var
  i: integer;
begin
  for i:= 0 to ControlCount-1 do
    if Controls[i] is TShape then
    begin
      (Controls[i] as TShape).OnMouseDown:= Self.OnMouseDown;
      (Controls[i] as TShape).OnMouseUp:= Self.OnMouseUp;
      (Controls[i] as TShape).OnMouseWheelUp:= Self.OnMouseWheelUp;
      (Controls[i] as TShape).OnMouseWheelDown:= Self.OnMouseWheelDown;
      (Controls[i] as TShape).OnMouseWheelLeft:= Self.OnMouseWheelLeft;
      (Controls[i] as TShape).OnMouseWheelRight:= Self.OnMouseWheelRight;
    end;
end;

procedure TFormMain.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  case Button of
    mbLeft:
      ShapeButtonLeft.Brush.Color:= color_On;
    mbRight:
      ShapeButtonRight.Brush.Color:= color_On;
    mbMiddle:
      ShapeWheel.Brush.Color:= color_On;
    mbExtra1:
      ShapeButtonExtra1.Brush.Color:= color_On;
    mbExtra2:
      ShapeButtonExtra2.Brush.Color:= color_On;
  end;
end;

procedure TFormMain.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  case Button of
    mbLeft:
      ShapeButtonLeft.Brush.Color:= color_Off;
    mbRight:
      ShapeButtonRight.Brush.Color:= color_Off;
    mbMiddle:
      ShapeWheel.Brush.Color:= color_Off;
    mbExtra1:
      ShapeButtonExtra1.Brush.Color:= color_Off;
    mbExtra2:
      ShapeButtonExtra2.Brush.Color:= color_Off;
  end;
end;

procedure TFormMain.FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  DoBlink(ShapeWheelDown);
end;

procedure TFormMain.FormMouseWheelLeft(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  DoBlink(ShapeWheelLeft);
end;

procedure TFormMain.FormMouseWheelRight(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  DoBlink(ShapeWheelRight);
end;

procedure TFormMain.FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: Boolean);
begin
  DoBlink(ShapeWheelUp);
end;

end.