freepascal.ru

Код: Выделить всё

unit Unit1; 

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  ExtCtrls,Messages,LMessages;
  //Добавлены вот эти модули  Messages,LMessages;
type

  { TForm1 }

  TForm1 = class(TForm)
    Panel1: TPanel;
    Timer1: TTimer;
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer
      );
    procedure Timer1Timer(Sender: TObject);
  private
    { private declarations }
  public
      procedure LBUTTONDOWN (var message: TMessage); message LM_LBUTTONDOWN;
      procedure LBUTTONUP (var message: TMessage); message LM_LBUTTONUP;
    { public declarations }
  end; 

var
  Form1: TForm1; 
  MLeft:Boolean;
implementation

{$R *.lfm}


{ TForm1 }

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if MLeft then
  Form1.Caption:='Нажали'
    else
    Form1.Caption:='Ждемс'

end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  //Вообще то событие возникает когда перемещаем мышь на панели но мы
  //тут будем использовать  Shift чтоб узнать зажата ли кнопка
  //При этом нужно помнить что нажав кнопку на понели и переместив за границу панели
  //надпись не измениться так как сама процедура генериться только в панели
  If (ssLeft in Shift) then
   Panel1.Caption:='Удерживаем левую кнопку'
   else
   Panel1.Caption:='Просто так елозим на панели'
end;

procedure TForm1.LBUTTONDOWN(var message: TMessage);
begin
  MLeft:=true;   //Перехват события нажатия кнопки в данном случае левой
end;

procedure TForm1.LBUTTONUP(var message: TMessage);
begin
  MLeft:=False; //Отпустили кнопку записываем в переменную багу
end;


end.