home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / tpwinst / docdemos.pak / STEP04.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-21  |  3KB  |  109 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   Demo program                                 }
  5. {   Copyright (c) 1991 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. program MyProgram;
  10.  
  11. uses Strings, WinTypes, WinProcs, WObjects;
  12.  
  13. type
  14.   TMyApplication = object(TApplication)
  15.     procedure InitMainWindow; virtual;
  16.   end;
  17.  
  18. type
  19.   PMyWindow = ^TMyWindow;
  20.   TMyWindow = object(TWindow)
  21.     DragDC: HDC;
  22.     ButtonDown: Boolean;
  23.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  24.     function CanClose: Boolean; virtual;
  25.     procedure WMLButtonDown(var Msg: TMessage);
  26.       virtual wm_First + wm_LButtonDown;
  27.     procedure WMLButtonUp(var Msg: TMessage);
  28.       virtual wm_First + wm_LButtonUp;
  29.     procedure WMMouseMove(var Msg: TMessage);
  30.       virtual wm_First + wm_MouseMove;
  31.     procedure WMRButtonDown(var Msg: TMessage);
  32.       virtual wm_First + wm_RButtonDown;
  33.   end;
  34.  
  35. {--------------------------------------------------}
  36. { TMyWindow's method implementations:              }
  37. {--------------------------------------------------}
  38.  
  39. constructor TMyWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  40. begin
  41.   TWindow.Init(AParent, ATitle);
  42.   ButtonDown := False;
  43. end;
  44.  
  45. function TMyWindow.CanClose: Boolean;
  46. var
  47.   Reply: Integer;
  48. begin
  49.   CanClose := True;
  50.   Reply := MessageBox(HWindow, 'Do you want to save?',
  51.     'Drawing has changed', mb_YesNo or mb_IconQuestion);
  52.   if Reply = id_Yes then CanClose := False;
  53. end;
  54.  
  55. procedure TMyWindow.WMLButtonDown(var Msg: TMessage);
  56. begin
  57.   InvalidateRect(HWindow, nil, True);
  58.   if not ButtonDown then
  59.   begin
  60.     ButtonDown := True;
  61.     SetCapture(HWindow);
  62.     DragDC := GetDC(HWindow);
  63.     MoveTo(DragDC, Msg.LParamLo, Msg.LParamHi);
  64.   end;
  65. end;
  66.  
  67. procedure TMyWindow.WMMouseMove(var Msg: TMessage);
  68. begin
  69.   if ButtonDown then
  70.     LineTo(DragDC, Integer(Msg.LParamLo), Integer(Msg.LParamHi));
  71. end;
  72.  
  73. procedure TMyWindow.WMLButtonUp(var Msg: TMessage);
  74. begin
  75.   if ButtonDown then
  76.   begin
  77.     ButtonDown := False;
  78.     ReleaseCapture;
  79.     ReleaseDC(HWindow, DragDC);
  80.   end;
  81. end;
  82.  
  83. procedure TMyWindow.WMRButtonDown(var Msg: TMessage);
  84. begin
  85.   InvalidateRect(HWindow, nil, True);
  86. end;
  87.  
  88. {--------------------------------------------------}
  89. { TMyApplication's method implementations:         }
  90. {--------------------------------------------------}
  91.  
  92. procedure TMyApplication.InitMainWindow;
  93. begin
  94.   MainWindow := New(PMyWindow, Init(nil, 'Sample ObjectWindows Program'));
  95. end;
  96.  
  97. {--------------------------------------------------}
  98. { Main program:                                    }
  99. {--------------------------------------------------}
  100.  
  101. var
  102.   MyApp: TMyApplication;
  103.  
  104. begin
  105.   MyApp.Init('MyProgram');
  106.   MyApp.Run;
  107.   MyApp.Done;
  108. end.
  109.