home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / tpwinst / docdemos.pak / STEP05.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-21  |  4KB  |  144 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, StdDlgs;
  12.  
  13. {$R COOKBOOK.RES}
  14.  
  15. type
  16.   TMyApplication = object(TApplication)
  17.     procedure InitMainWindow; virtual;
  18.   end;
  19.  
  20. type
  21.   PMyWindow = ^TMyWindow;
  22.   TMyWindow = object(TWindow)
  23.     DragDC: HDC;
  24.     ButtonDown: Boolean;
  25.     ThePen: HPen;
  26.     PenSize: Integer;
  27.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  28.     destructor Done; virtual;
  29.     function CanClose: Boolean; virtual;
  30.     procedure WMLButtonDown(var Msg: TMessage);
  31.       virtual wm_First + wm_LButtonDown;
  32.     procedure WMLButtonUp(var Msg: TMessage);
  33.       virtual wm_First + wm_LButtonUp;
  34.     procedure WMMouseMove(var Msg: TMessage);
  35.       virtual wm_First + wm_MouseMove;
  36.     procedure WMRButtonDown(var Msg: TMessage);
  37.       virtual wm_First + wm_RButtonDown;
  38.     procedure SetPenSize(NewSize: Integer);
  39.   end;
  40.  
  41. {--------------------------------------------------}
  42. { TMyWindow's method implementations:               }
  43. {--------------------------------------------------}
  44.  
  45. constructor TMyWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  46. begin
  47.   TWindow.Init(AParent, ATitle);
  48.   ButtonDown := False;
  49.   PenSize := 1;
  50.   ThePen := CreatePen(ps_Solid, PenSize, 0);
  51. end;
  52.  
  53. destructor TMyWindow.Done;
  54. begin
  55.   DeleteObject(ThePen);
  56.   TWindow.Done;
  57. end;
  58.  
  59. function TMyWindow.CanClose: Boolean;
  60. var
  61.   Reply: Integer;
  62. begin
  63.   CanClose := True;
  64.   Reply := MessageBox(HWindow, 'Do you want to save?',
  65.     'Drawing has changed', mb_YesNo or mb_IconQuestion);
  66.   if Reply = id_Yes then CanClose := False;
  67. end;
  68.  
  69. procedure TMyWindow.WMLButtonDown(var Msg: TMessage);
  70. begin
  71.   InvalidateRect(HWindow, nil, True);
  72.   if not ButtonDown then
  73.   begin
  74.     ButtonDown := True;
  75.     SetCapture(HWindow);
  76.     DragDC := GetDC(HWindow);
  77.     SelectObject(DragDC, ThePen);
  78.     MoveTo(DragDC, Msg.LParamLo, Msg.LParamHi);
  79.   end;
  80. end;
  81.  
  82. procedure TMyWindow.WMMouseMove(var Msg: TMessage);
  83. begin
  84.   if ButtonDown then
  85.     LineTo(DragDC, Integer(Msg.LParamLo), Integer(Msg.LParamHi));
  86. end;
  87.  
  88. procedure TMyWindow.WMLButtonUp(var Msg: TMessage);
  89. begin
  90.   if ButtonDown then
  91.   begin
  92.     ButtonDown := False;
  93.     ReleaseCapture;
  94.     ReleaseDC(HWindow, DragDC);
  95.   end;
  96. end;
  97.  
  98. procedure TMyWindow.WMRButtonDown(var Msg: TMessage);
  99. var
  100.   InputText: array[0..5] of Char;
  101.   NewSize, ErrorPos: Integer;
  102. begin
  103.   if not ButtonDown then
  104.   begin
  105.     Str(PenSize, InputText);
  106.     if Application^.ExecDialog(New(PInputDialog,
  107.       Init(@Self, 'Line Thickness', 'Input a new thickness:',
  108.         InputText, SizeOf(InputText)))) = id_Ok then
  109.     begin
  110.       Val(InputText, NewSize, ErrorPos);
  111.       if ErrorPos = 0 then SetPenSize(NewSize);
  112.     end;
  113.   end;
  114. end;
  115.  
  116. procedure TMyWindow.SetPenSize(NewSize: Integer);
  117. begin
  118.   DeleteObject(ThePen);
  119.   ThePen := CreatePen(ps_Solid, NewSize, 0);
  120.   PenSize := NewSize;
  121. end;
  122.  
  123. {--------------------------------------------------}
  124. { TMyApplication's method implementations:         }
  125. {--------------------------------------------------}
  126.  
  127. procedure TMyApplication.InitMainWindow;
  128. begin
  129.   MainWindow := New(PMyWindow, Init(nil, 'Sample ObjectWindows Program'));
  130. end;
  131.  
  132. {--------------------------------------------------}
  133. { Main program:                                    }
  134. {--------------------------------------------------}
  135.  
  136. var
  137.   MyApp : TMyApplication;
  138.  
  139. begin
  140.   MyApp.Init('MyProgram');
  141.   MyApp.Run;
  142.   MyApp.Done;
  143. end.
  144.