home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Pascal / BPASCAL.700 / D11 / WDOCDEMO.ZIP / STEP04A.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-01  |  4.6 KB  |  175 lines
  1. {************************************************}
  2. {                                                }
  3. {   ObjectWindows Demo                           }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program Step04a;
  9.  
  10. uses Strings, WinTypes, WinProcs, OWindows, OStdDlgs;
  11.  
  12. {$R STEPS.RES}
  13.  
  14. {$I STEPS.INC}
  15.  
  16. type
  17.   PStepWindow = ^TStepWindow;
  18.   TStepWindow = object(TWindow)
  19.     DragDC: HDC;
  20.     ButtonDown, HasChanged: Boolean;
  21.     ThePen: HPen;
  22.     PenSize: Integer;
  23.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  24.     destructor Done; virtual;
  25.     function CanClose: Boolean; virtual;
  26.     procedure CMFileNew(var Msg: TMessage);
  27.       virtual cm_First + cm_FileNew;
  28.     procedure CMFileOpen(var Msg: TMessage);
  29.       virtual cm_First + cm_FileOpen;
  30.     procedure CMFileSave(var Msg: TMessage);
  31.       virtual cm_First + cm_FileSave;
  32.     procedure CMFileSaveAs(var Msg: TMessage);
  33.       virtual cm_First + cm_FileSaveAs;
  34.     procedure CMFilePrint(var Msg: TMessage);
  35.       virtual cm_First + cm_FilePrint;
  36.     procedure CMFileSetup(var Msg: TMessage);
  37.       virtual cm_First + cm_FileSetup;
  38.     procedure SetPenSize(NewSize: Integer);
  39.     procedure WMLButtonDown(var Msg: TMessage);
  40.       virtual wm_First + wm_LButtonDown;
  41.     procedure WMLButtonUp(var Msg: TMessage);
  42.       virtual wm_First + wm_LButtonUp;
  43.     procedure WMMouseMove(var Msg: TMessage);
  44.       virtual wm_First + wm_MouseMove;
  45.     procedure WMRButtonDown(var Msg: TMessage);
  46.       virtual wm_First + wm_RButtonDown;
  47.   end;
  48.   TMyApplication = object(TApplication)
  49.     procedure InitMainWindow; virtual;
  50.   end;
  51.  
  52. constructor TStepWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  53. begin
  54.   inherited Init(AParent, ATitle);
  55.   Attr.Menu := LoadMenu(HInstance, MakeIntResource(100));
  56.   HasChanged := False;
  57.   ButtonDown := False;
  58.   PenSize := 1;
  59.   ThePen := CreatePen(ps_Solid, PenSize, 0);
  60. end;
  61.  
  62. destructor TStepWindow.Done;
  63. begin
  64.   DeleteObject(ThePen);
  65.   inherited Done;
  66. end;
  67.  
  68. function TStepWindow.CanClose: Boolean;
  69. var
  70.   Reply: Integer;
  71. begin
  72.   CanClose := True;
  73.   if HasChanged then
  74.   begin
  75.     Reply := MessageBox(HWindow, 'Do you want to save?',
  76.       'Drawing has changed', mb_YesNo or mb_IconQuestion);
  77.     if Reply = id_Yes then CanClose := False;
  78.   end;
  79. end;
  80.  
  81. procedure TStepWindow.CMFileNew(var Msg: TMessage);
  82. begin
  83.   InvalidateRect(HWindow, nil, True);
  84. end;
  85.  
  86. procedure TStepWindow.CMFileOpen(var Msg: TMessage);
  87. begin
  88.   MessageBox(HWindow, 'Feature not implemented.', 'File Open', mb_OK);
  89. end;
  90.  
  91. procedure TStepWindow.CMFileSave(var Msg: TMessage);
  92. begin
  93.   MessageBox(HWindow, 'Feature not implemented.', 'File Save', mb_OK);
  94. end;
  95.  
  96. procedure TStepWindow.CMFileSaveAs(var Msg: TMessage);
  97. begin
  98.   MessageBox(HWindow, 'Feature not implemented.', 'File Save As', mb_OK);
  99. end;
  100.  
  101. procedure TStepWindow.CMFilePrint(var Msg: TMessage);
  102. begin
  103.   MessageBox(HWindow, 'Feature not implemented.', 'File Print', mb_OK);
  104. end;
  105.  
  106. procedure TStepWindow.CMFileSetup(var Msg: TMessage);
  107. begin
  108.   MessageBox(HWindow, 'Feature not implemented.', 'Printer Setup', mb_OK);
  109. end;
  110.  
  111. procedure TStepWindow.SetPenSize(NewSize: Integer);
  112. begin
  113.   DeleteObject(ThePen);
  114.   ThePen := CreatePen(ps_Solid, NewSize, 0);
  115.   PenSize := NewSize;
  116. end;
  117.  
  118. procedure TStepWindow.WMLButtonDown(var Msg: TMessage);
  119. begin
  120.   if not ButtonDown then
  121.   begin
  122.     ButtonDown := True;
  123.     SetCapture(HWindow);
  124.     DragDC := GetDC(HWindow);
  125.     SelectObject(DragDC, ThePen);
  126.     MoveTo(DragDC, Msg.LParamLo, Msg.LParamHi);
  127.   end;
  128. end;
  129.  
  130. procedure TStepWindow.WMLButtonUp(var Msg: TMessage);
  131. begin
  132.   if ButtonDown then
  133.   begin
  134.     ButtonDown := False;
  135.     ReleaseCapture;
  136.     ReleaseDC(HWindow, DragDC);
  137.   end;
  138. end;
  139.  
  140. procedure TStepWindow.WMMouseMove(var Msg: TMessage);
  141. begin
  142.   if ButtonDown then LineTo(DragDC, Msg.LParamLo, Msg.LParamHi);
  143. end;
  144.  
  145. procedure TStepWindow.WMRButtonDown(var Msg: TMessage);
  146. var
  147.   InputText: array[0..5] of Char;
  148.   NewSize, ErrorPos: Integer;
  149. begin
  150.   if not ButtonDown then
  151.   begin
  152.     Str(PenSize, InputText);
  153.     if Application^.ExecDialog(New(PInputDialog,
  154.       Init(@Self, 'Line Width', 'Type a new line width:',
  155.       InputText, SizeOf(InputText)))) = id_OK then
  156.     begin
  157.       Val(InputText, NewSize, ErrorPos);
  158.       if ErrorPos = 0 then SetPenSize(NewSize);
  159.     end;
  160.   end;
  161. end;
  162.  
  163. procedure TMyApplication.InitMainWindow;
  164. begin
  165.   MainWindow := New(PStepWindow, Init(nil, 'Steps'));
  166. end;
  167.  
  168. var
  169.   MyApp: TMyApplication;
  170.  
  171. begin
  172.   MyApp.Init('Steps');
  173.   MyApp.Run;
  174.   MyApp.Done;
  175. end.