home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / l / l040 / 11.ddi / WDOCDEMO.ZIP / STEP06B.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-27  |  4.8 KB  |  176 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 Step06b;
  12.  
  13. uses WinDos, Strings, WinTypes, WinProcs, OWindows, ODialogs, OStdDlgs, Pen;
  14.  
  15. {$R STEPS.RES}
  16.  
  17. {$I STEPS.INC}
  18.  
  19. type
  20.   PStepWindow = ^TStepWindow;
  21.   TStepWindow = object(TWindow)
  22.     DragDC: HDC;
  23.     ButtonDown, HasChanged: Boolean;
  24.     CurrentPen: PPen;
  25.     FileName: array[0..fsPathName] of Char;
  26.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  27.     destructor Done; virtual;
  28.     function CanClose: Boolean; virtual;
  29.     procedure CMAbout(var Msg: TMessage);
  30.       virtual cm_First + cm_About;
  31.     procedure CMFileNew(var Msg: TMessage);
  32.       virtual cm_First + cm_FileNew;
  33.     procedure CMFileOpen(var Msg: TMessage);
  34.       virtual cm_First + cm_FileOpen;
  35.     procedure CMFileSave(var Msg: TMessage);
  36.       virtual cm_First + cm_FileSave;
  37.     procedure CMFileSaveAs(var Msg: TMessage);
  38.       virtual cm_First + cm_FileSaveAs;
  39.     procedure CMFilePrint(var Msg: TMessage);
  40.       virtual cm_First + cm_FilePrint;
  41.     procedure CMFileSetup(var Msg: TMessage);
  42.       virtual cm_First + cm_FileSetup;
  43.     procedure CMPen(var Msg: TMessage);
  44.       virtual cm_First + cm_Pen;
  45.     procedure WMLButtonDown(var Msg: TMessage);
  46.       virtual wm_First + wm_LButtonDown;
  47.     procedure WMLButtonUp(var Msg: TMessage);
  48.       virtual wm_First + wm_LButtonUp;
  49.     procedure WMMouseMove(var Msg: TMessage);
  50.       virtual wm_First + wm_MouseMove;
  51.     procedure WMRButtonDown(var Msg: TMessage);
  52.       virtual wm_First + wm_RButtonDown;
  53.   end;
  54.   TMyApplication = object(TApplication)
  55.     procedure InitMainWindow; virtual;
  56.   end;
  57.  
  58. constructor TStepWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  59. begin
  60.   inherited Init(AParent, ATitle);
  61.   Attr.Menu := LoadMenu(HInstance, MakeIntResource(100));
  62.   HasChanged := False;
  63.   ButtonDown := False;
  64.   StrCopy(FileName, '*.PTS');
  65.   CurrentPen := New(PPen, Init(ps_Solid, 1, 0));
  66. end;
  67.  
  68. destructor TStepWindow.Done;
  69. begin
  70.   Dispose(CurrentPen, Done);
  71.   inherited Done;
  72. end;
  73.  
  74. function TStepWindow.CanClose: Boolean;
  75. var
  76.   Reply: Integer;
  77. begin
  78.   CanClose := True;
  79.   if HasChanged then
  80.   begin
  81.     Reply := MessageBox(HWindow, 'Do you want to save?',
  82.       'Drawing has changed', mb_YesNo or mb_IconQuestion);
  83.     if Reply = id_Yes then CanClose := False;
  84.   end;
  85. end;
  86.  
  87. procedure TStepWindow.CMAbout(var Msg: TMessage);
  88. begin
  89.   Application^.ExecDialog(New(PDialog, Init(@Self, 'ABOUTBOX')));
  90. end;
  91.  
  92. procedure TStepWindow.CMFileNew(var Msg: TMessage);
  93. begin
  94.   InvalidateRect(HWindow, nil, True);
  95. end;
  96.  
  97. procedure TStepWindow.CMFileOpen(var Msg: TMessage);
  98. begin
  99.   if Application^.ExecDialog(New(PFileDialog,
  100.     Init(@Self, PChar(sd_FileOpen), FileName))) = id_OK then
  101.     MessageBox(HWindow, FIleName, 'Open the file:', mb_OK);
  102. end;
  103.  
  104. procedure TStepWindow.CMFileSave(var Msg: TMessage);
  105. begin
  106.   MessageBox(HWindow, 'Feature not implemented.', 'File Save', mb_OK);
  107. end;
  108.  
  109. procedure TStepWindow.CMFileSaveAs(var Msg: TMessage);
  110. begin
  111.   if Application^.ExecDialog(New(PFileDialog,
  112.     Init(@Self, PChar(sd_FileSave), FileName))) = id_OK then
  113.     MessageBox(HWindow, FileName, 'Save the file:', mb_OK);
  114. end;
  115.  
  116. procedure TStepWindow.CMFilePrint(var Msg: TMessage);
  117. begin
  118.   MessageBox(HWindow, 'Feature not implemented.', 'File Print', mb_OK);
  119. end;
  120.  
  121. procedure TStepWindow.CMFileSetup(var Msg: TMessage);
  122. begin
  123.   MessageBox(HWindow, 'Feature not implemented.', 'Printer Setup', mb_OK);
  124. end;
  125.  
  126. procedure TStepWindow.CMPen(var Msg: TMessage);
  127. begin
  128.   CurrentPen^.ChangePen;
  129. end;
  130.  
  131. procedure TStepWindow.WMLButtonDown(var Msg: TMessage);
  132. begin
  133.   if not ButtonDown then
  134.   begin
  135.     ButtonDown := True;
  136.     SetCapture(HWindow);
  137.     DragDC := GetDC(HWindow);
  138.     CurrentPen^.Select(DragDC);
  139.     MoveTo(DragDC, Msg.LParamLo, Msg.LParamHi);
  140.   end;
  141. end;
  142.  
  143. procedure TStepWindow.WMLButtonUp(var Msg: TMessage);
  144. begin
  145.   if ButtonDown then
  146.   begin
  147.     ButtonDown := False;
  148.     ReleaseCapture;
  149.     CurrentPen^.Delete;
  150.     ReleaseDC(HWindow, DragDC);
  151.   end;
  152. end;
  153.  
  154. procedure TStepWindow.WMMouseMove(var Msg: TMessage);
  155. begin
  156.   if ButtonDown then LineTo(DragDC, Msg.LParamLo, Msg.LParamHi);
  157. end;
  158.  
  159. procedure TStepWindow.WMRButtonDown(var Msg: TMessage);
  160. begin
  161.   if not ButtonDown then CurrentPen^.ChangePen;
  162. end;
  163.  
  164. procedure TMyApplication.InitMainWindow;
  165. begin
  166.   MainWindow := New(PStepWindow, Init(nil, 'Steps'));
  167. end;
  168.  
  169. var
  170.   MyApp: TMyApplication;
  171.  
  172. begin
  173.   MyApp.Init('Steps');
  174.   MyApp.Run;
  175.   MyApp.Done;
  176. end.