home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Pascal / BPASCAL.700 / D11 / WDOCDEMO.ZIP / STEP03B.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-01  |  3.2 KB  |  128 lines

  1. {************************************************}
  2. {                                                }
  3. {   ObjectWindows Demo                           }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program Step03b;
  9.  
  10. uses Strings, WinTypes, WinProcs, OWindows, OStdDlgs;
  11.  
  12. type
  13.   PStepWindow = ^TStepWindow;
  14.   TStepWindow = object(TWindow)
  15.     DragDC: HDC;
  16.     ButtonDown, HasChanged: Boolean;
  17.     ThePen: HPen;
  18.     PenSize: Integer;
  19.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  20.     destructor Done; virtual;
  21.     function CanClose: Boolean; virtual;
  22.     procedure SetPenSize(NewSize: Integer);
  23.     procedure WMLButtonDown(var Msg: TMessage);
  24.       virtual wm_First + wm_LButtonDown;
  25.     procedure WMLButtonUp(var Msg: TMessage);
  26.       virtual wm_First + wm_LButtonUp;
  27.     procedure WMMouseMove(var Msg: TMessage);
  28.       virtual wm_First + wm_MouseMove;
  29.     procedure WMRButtonDown(var Msg: TMessage);
  30.       virtual wm_First + wm_RButtonDown;
  31.   end;
  32.   TMyApplication = object(TApplication)
  33.     procedure InitMainWindow; virtual;
  34.   end;
  35.  
  36. constructor TStepWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  37. begin
  38.   inherited Init(AParent, ATitle);
  39.   HasChanged := False;
  40.   ButtonDown := False;
  41.   PenSize := 1;
  42.   ThePen := CreatePen(ps_Solid, PenSize, 0);
  43. end;
  44.  
  45. destructor TStepWindow.Done;
  46. begin
  47.   DeleteObject(ThePen);
  48.   inherited Done;
  49. end;
  50.  
  51. function TStepWindow.CanClose: Boolean;
  52. var
  53.   Reply: Integer;
  54. begin
  55.   CanClose := True;
  56.   if HasChanged then
  57.   begin
  58.     Reply := MessageBox(HWindow, 'Do you want to save?',
  59.       'Drawing has changed', mb_YesNo or mb_IconQuestion);
  60.     if Reply = id_Yes then CanClose := False;
  61.   end;
  62. end;
  63.  
  64. procedure TStepWindow.SetPenSize(NewSize: Integer);
  65. begin
  66.   DeleteObject(ThePen);
  67.   ThePen := CreatePen(ps_Solid, NewSize, 0);
  68.   PenSize := NewSize;
  69. end;
  70.  
  71. procedure TStepWindow.WMLButtonDown(var Msg: TMessage);
  72. begin
  73.   if not ButtonDown then
  74.   begin
  75.     ButtonDown := True;
  76.     SetCapture(HWindow);
  77.     DragDC := GetDC(HWindow);
  78.     SelectObject(DragDC, ThePen);
  79.     MoveTo(DragDC, Msg.LParamLo, Msg.LParamHi);
  80.   end;
  81. end;
  82.  
  83. procedure TStepWindow.WMLButtonUp(var Msg: TMessage);
  84. begin
  85.   if ButtonDown then
  86.   begin
  87.     ButtonDown := False;
  88.     ReleaseCapture;
  89.     ReleaseDC(HWindow, DragDC);
  90.   end;
  91. end;
  92.  
  93. procedure TStepWindow.WMMouseMove(var Msg: TMessage);
  94. begin
  95.   if ButtonDown then LineTo(DragDC, Msg.LParamLo, Msg.LParamHi);
  96. end;
  97.  
  98. procedure TStepWindow.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 Width', 'Type a new line width:',
  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 TMyApplication.InitMainWindow;
  117. begin
  118.   MainWindow := New(PStepWindow, Init(nil, 'Steps'));
  119. end;
  120.  
  121. var
  122.   MyApp: TMyApplication;
  123.  
  124. begin
  125.   MyApp.Init('Steps');
  126.   MyApp.Run;
  127.   MyApp.Done;
  128. end.