home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l040 / 11.ddi / WDOCDEMO.ZIP / STEP03B.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-27  |  3.3 KB  |  131 lines
  1. {************************************************}
  2. {                                                }
  3. {   ObjectWindows Demo                           }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. {$R-} { Turn off range check because Windows message parameters
  9.         don't distinguish between Integer and Word. }
  10.  
  11. program Step03b;
  12.  
  13. uses Strings, WinTypes, WinProcs, OWindows, OStdDlgs;
  14.  
  15. type
  16.   PStepWindow = ^TStepWindow;
  17.   TStepWindow = object(TWindow)
  18.     DragDC: HDC;
  19.     ButtonDown, HasChanged: Boolean;
  20.     ThePen: HPen;
  21.     PenSize: Integer;
  22.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  23.     destructor Done; virtual;
  24.     function CanClose: Boolean; virtual;
  25.     procedure SetPenSize(NewSize: Integer);
  26.     procedure WMLButtonDown(var Msg: TMessage);
  27.       virtual wm_First + wm_LButtonDown;
  28.     procedure WMLButtonUp(var Msg: TMessage);
  29.       virtual wm_First + wm_LButtonUp;
  30.     procedure WMMouseMove(var Msg: TMessage);
  31.       virtual wm_First + wm_MouseMove;
  32.     procedure WMRButtonDown(var Msg: TMessage);
  33.       virtual wm_First + wm_RButtonDown;
  34.   end;
  35.   TMyApplication = object(TApplication)
  36.     procedure InitMainWindow; virtual;
  37.   end;
  38.  
  39. constructor TStepWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  40. begin
  41.   inherited Init(AParent, ATitle);
  42.   HasChanged := False;
  43.   ButtonDown := False;
  44.   PenSize := 1;
  45.   ThePen := CreatePen(ps_Solid, PenSize, 0);
  46. end;
  47.  
  48. destructor TStepWindow.Done;
  49. begin
  50.   DeleteObject(ThePen);
  51.   inherited Done;
  52. end;
  53.  
  54. function TStepWindow.CanClose: Boolean;
  55. var
  56.   Reply: Integer;
  57. begin
  58.   CanClose := True;
  59.   if HasChanged then
  60.   begin
  61.     Reply := MessageBox(HWindow, 'Do you want to save?',
  62.       'Drawing has changed', mb_YesNo or mb_IconQuestion);
  63.     if Reply = id_Yes then CanClose := False;
  64.   end;
  65. end;
  66.  
  67. procedure TStepWindow.SetPenSize(NewSize: Integer);
  68. begin
  69.   DeleteObject(ThePen);
  70.   ThePen := CreatePen(ps_Solid, NewSize, 0);
  71.   PenSize := NewSize;
  72. end;
  73.  
  74. procedure TStepWindow.WMLButtonDown(var Msg: TMessage);
  75. begin
  76.   if not ButtonDown then
  77.   begin
  78.     ButtonDown := True;
  79.     SetCapture(HWindow);
  80.     DragDC := GetDC(HWindow);
  81.     SelectObject(DragDC, ThePen);
  82.     MoveTo(DragDC, Msg.LParamLo, Msg.LParamHi);
  83.   end;
  84. end;
  85.  
  86. procedure TStepWindow.WMLButtonUp(var Msg: TMessage);
  87. begin
  88.   if ButtonDown then
  89.   begin
  90.     ButtonDown := False;
  91.     ReleaseCapture;
  92.     ReleaseDC(HWindow, DragDC);
  93.   end;
  94. end;
  95.  
  96. procedure TStepWindow.WMMouseMove(var Msg: TMessage);
  97. begin
  98.   if ButtonDown then LineTo(DragDC, Msg.LParamLo, Msg.LParamHi);
  99. end;
  100.  
  101. procedure TStepWindow.WMRButtonDown(var Msg: TMessage);
  102. var
  103.   InputText: array[0..5] of Char;
  104.   NewSize, ErrorPos: Integer;
  105. begin
  106.   if not ButtonDown then
  107.   begin
  108.     Str(PenSize, InputText);
  109.     if Application^.ExecDialog(New(PInputDialog,
  110.       Init(@Self, 'Line Width', 'Type a new line width:',
  111.       InputText, SizeOf(InputText)))) = id_OK then
  112.     begin
  113.       Val(InputText, NewSize, ErrorPos);
  114.       if ErrorPos = 0 then SetPenSize(NewSize);
  115.     end;
  116.   end;
  117. end;
  118.  
  119. procedure TMyApplication.InitMainWindow;
  120. begin
  121.   MainWindow := New(PStepWindow, Init(nil, 'Steps'));
  122. end;
  123.  
  124. var
  125.   MyApp: TMyApplication;
  126.  
  127. begin
  128.   MyApp.Init('Steps');
  129.   MyApp.Run;
  130.   MyApp.Done;
  131. end.