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