[Back to WIN-OS2 SWAG index]  [Back to Main SWAG index]  [Original]


{************************************************}
{                                                }
{   Turbo Pascal for Windows                     }
{   Tips & Techniques Demo Program               }
{   Copyright (c) 1991 by Borland International  }
{                                                }
{************************************************}

program DblClick;

uses WinTypes, WinProcs, WObjects;

type
  TApp = object(TApplication)
    procedure InitMainWindow; virtual;
  end;

  PMyWindow = ^TMyWindow;
  TMyWindow = Object(TWindow)
    constructor Init(AParent: PWindowsObject; ATitle: PChar);
    procedure Paint(PaintDC: HDC; var PaintInfo :TPaintStruct); virtual;
    function  GetClassName: PChar; virtual;
    procedure GetWindowClass(var AWndClass: TWndClass); virtual;
    procedure DblClk(var Message: TMessage);
      virtual wm_lButtonDblClk;
  end;

procedure TApp.InitMainWindow;
begin
  MainWindow := New(PMyWindow, Init(Nil, 'Double Click'));
end;

constructor TMyWindow.Init(AParent: PWindowsObject; ATitle: PChar);
begin
  TWindow.Init(AParent, ATitle);
end;
procedure TMyWindow.Paint(PaintDC: HDC; var PaintInfo :TPaintStruct);
begin
  TWindow.Paint(PaintDC, PaintInfo);
  TextOut(PaintDC, 30, 30, 'Please Double Click in the Client Region'#0,
    40);
end;

function TMyWindow.GetClassName: PChar;
begin
  GetClassName := 'DoubleClickDemoWindow';
end;

procedure TMyWindow.GetWindowClass(var AWndClass: TWndClass);
begin
  TWindow.GetWindowClass(AWndClass);
  AWndClass.Style := AWndClass.Style or cs_DblClks;
end;

procedure TMyWindow.DblClk(var Message: TMessage);
begin
  MessageBox(HWindow, 'Double Click', 'Message', mb_Ok);
end;

var
  App: TApp;

begin
  App.Init('DblClick');
  App.Run;
  App.Done;
end.

[Back to WIN-OS2 SWAG index]  [Back to Main SWAG index]  [Original]