home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / tpw / docdemos / tdodemo.pas < prev    next >
Pascal/Delphi Source File  |  1991-05-20  |  13KB  |  339 lines

  1. {***********************************************************************
  2.  *  Copyright (c) 1991 - Borland International.
  3.  *
  4.  *  File: TDODEMO.PAS
  5.  *
  6.  *  Turbo Pascal demonstration program to show how to use TDW
  7.  *  to debug an Object Windows application.
  8.  *
  9.  *  The Color Scribble program lets the user draw on the screen in
  10.  *  any of four colors: red, green, blue, and black.
  11.  ***********************************************************************}
  12.  
  13. program CScribble;
  14.  
  15. {$R TDODEMO.RES} {Include resource file having menu definition. }
  16.  
  17. uses  WinTypes, WinProcs, WObjects;
  18.  
  19. const
  20.   PenWidth   = 1;          { Width of Scribble line.      }
  21.   MenuID     = 100;        { ID of menu in resource file. }
  22.   IconID     = 100;        { ID of Icon in resource file. }
  23.   RedMenu    = 101;        { Value of Pen|Red menu.       }
  24.   GreenMenu  = 102;        { Value of Pen|Green menu.     }
  25.   BlueMenu   = 103;        { Value of Pen|Blue menu.      }
  26.   BlackMenu  = 204;        { Value of Pen|Black menu.     }
  27.  
  28. type
  29. { --------------------------------------------------------
  30.   CScribbleApplication type.
  31.   -------------------------------------------------------- }
  32.  CScribbleApplication = object(TApplication)
  33.    procedure InitMainWindow; virtual; { Creates main window }
  34.  end;
  35.  
  36.  
  37. type
  38. { --------------------------------------------------------
  39.   ScribbleWindow type.
  40.   -------------------------------------------------------- }
  41.  
  42.   PScribbleWindow = ^ScribbleWindow;
  43.   ScribbleWindow = object(TWindow)
  44.     HandleDC: HDC;        { Display context for drawing.            }
  45.               { Preserves value while dragging mouse.   }
  46.     ButtonDown: Boolean;  { left-button-down flag }
  47.  
  48.     constructor Init(aParent: PWindowsObject; aTitle: PChar);
  49.  
  50.       { Virtual method that gets called when the left mouse     }
  51.       { button is clicked in the window.  This method sets up   }
  52.       { the window for scribbling by creating a display context.}
  53.     procedure WMLButtonDown(var Msg: TMessage); virtual WM_LBUTTONDOWN;
  54.  
  55.       { Virtual method that gets called when the left mouse     }
  56.       { button is released in the window.  This method releases }
  57.       { the display context that is used for drawing.           }
  58.     procedure WMLButtonUp(var Msg: TMessage); virtual WM_LBUTTONUP;
  59.  
  60.       { Virtual method that gets called when the mouse is   }
  61.       { moved anywhere in the window.  If the left mouse    }
  62.       { button is pressed, the window will be scribbled in. }
  63.     procedure WMMouseMove(var Msg: TMessage); virtual WM_MOUSEMOVE;
  64.  
  65.       { Virtual method that gets called when the right mouse button }
  66.       { is clicked in the window.  It clears the window by invali-  }
  67.       { dating the window, causing a WM_PAINT message to be sent.   }
  68.     procedure WMRButtonDown(var Msg: TMessage); virtual WM_RBUTTONDOWN;
  69.  
  70.   end;
  71.  
  72.  
  73. { --------------------------------------------------------
  74.   CScribbleWindow type.
  75.   -------------------------------------------------------- }
  76.   PCScribbleWindow = ^CScribbleWindow;
  77.   CScribbleWindow  = object(ScribbleWindow)
  78.     thePen: HPen;  { Pen that is used for drawing in color }
  79.  
  80.       { Adds a menu to the window and }
  81.       { initializes the pen to black. }
  82.     constructor Init(aParent: PWindowsObject; ATitle: PChar);
  83.  
  84.     destructor Done; virtual;   { Disposes of the pen. }
  85.  
  86.       { Virtual method that gets called when user      }
  87.       { selects Pen.Red from the menu bar. Disposes    }
  88.       { of the current pen and creates a red pen.      }
  89.     procedure SelectRedPen(var Msg: TMessage);
  90.       virtual cm_First + RedMenu;
  91.  
  92.       { Virtual method that gets called when user      }
  93.       { selects Pen.Green from the menu bar. Disposes  }
  94.       { of the current pen and creates a green pen.    }
  95.     procedure SelectGreenPen(var Msg: TMessage);
  96.       virtual cm_First + GreenMenu;
  97.  
  98.       { Virtual method that gets called when user      }
  99.       { selects Pen.Blue from the menu bar. Disposes   }
  100.       { of the current pen and creates a blue pen.     }
  101.     procedure SelectBluePen(var Msg: TMessage);
  102.       virtual cm_First + BlueMenu;
  103.  
  104.       { Virtual method that gets called when user       }
  105.       { selects Pen.Black from the menu bar. Disposes   }
  106.       { of the current pen and creates a black pen.     }
  107.     procedure SelectBlackPen(var Msg: TMessage);
  108.       virtual cm_First + BlackMenu;
  109.  
  110.       { Method that gets called when the user presses the         }
  111.       { left mouse button.  Selects pen into the display context. }
  112.     procedure WMLButtonDown(var Msg: TMessage);
  113.       virtual WM_LBUTTONDOWN;
  114.  
  115.       { Method to change the window class of the Scribble Window. }
  116.       {    Allows program to have an Icon associated with the        }
  117.       {    main window                                               }
  118.     procedure GetWindowClass(var AWndClass: TWndClass);virtual;
  119.  
  120.       { Returns a unique name for this class of window.  Needed }
  121.       {    because this class has a unique icon associated through }
  122.       {    GetWindowClass method                                   }
  123.     function GetClassName: PChar;virtual;
  124.   end;
  125.  
  126. {*****************************************************************
  127.  * ScribbleWindow constructor.
  128.  *****************************************************************}
  129. constructor ScribbleWindow.Init(aParent: PWindowsObject; aTitle: PChar);
  130. begin
  131.   TWindow.Init(aParent, aTitle);
  132.   ButtonDown := False;
  133. end;
  134.  
  135. {*****************************************************************
  136.  * procedure ScribbleWindow.WMLButtonDown
  137.  *
  138.  * Process WM_LBUTTONDOWN messages by creating a display context and
  139.  * marking mouse as being pressed.  Also tell Windows to send
  140.  * all mouse messages to window.
  141.  *****************************************************************}
  142. procedure ScribbleWindow.WMLButtonDown(var Msg: TMessage);
  143. begin
  144.   if not ButtonDown then
  145.   begin
  146.     ButtonDown := True;  { Mark mouse button as being     }
  147.              { pressed so when mouse movement }
  148.              { occurs, a line will be drawn.  }
  149.  
  150.     SetCapture(hWindow); { Tell Windows to send all mouse   }
  151.              { messages to window. WMLButtonUp  }
  152.              { method will release the capture. }
  153.  
  154.     HandleDC := GetDC(hWindow);    { Create display context for drawing. }
  155.  
  156.     MoveTo(HandleDC, Msg.LParamLo, { Move drawing point to location }
  157.        Msg.LParamHi);          { where mouse was pressed.       }
  158.  
  159.   end;
  160. end;
  161.  
  162. {*****************************************************************
  163.  * procedure ScribbleWindow.WM_Mousemove
  164.  *
  165.  * Process WM_MOUSEMOVE messages by drawing a line if the
  166.  * mouse button is marked as being pressed.
  167.  *****************************************************************}
  168. procedure ScribbleWindow.WMMouseMove(var Msg: TMessage);
  169. begin
  170.   if ButtonDown then  { If the mouse button is currently down }
  171.     LineTo(HandleDC, Msg.LParamLo, Msg.LParamHi);
  172.               { Draw a line to where the mouse is presently }
  173. end;
  174.  
  175. {*****************************************************************
  176.  * procedure ScribbleWindow.WM_LBUTTONUP
  177.  *
  178.  * Process WM_LBUTTONUP messages by allowing other applications
  179.  * to receive mouse messages, releasing the display context, and
  180.  * marking the mouse button as not being pressed.
  181.  *****************************************************************}
  182. procedure ScribbleWindow.WMLButtonUp(var Msg: TMessage);
  183. begin
  184.   if ButtonDown then
  185.   begin
  186.     ReleaseCapture; { Tell Windows to stop sending all mouse  }
  187.                     { messages to this window.  Allow other   }
  188.                     { applications to receive mouse messages. }
  189.     ReleaseDC(hWindow,handleDC);
  190.              { Release display context created   }
  191.                          { by WMLButtonDown method.          }
  192.     ButtonDown := False; { Mark mouse button as not pressed. }
  193.   end;
  194. end;
  195.  
  196. {*****************************************************************
  197.  * procedure ScribbleWindow.WMRButtonDown
  198.  *
  199.  * Process WM_RBUTTONDOWN messages by erasing the window.
  200.  * Invalidate entire window by passing nil rectangle to
  201.  * InvalidateRect.  Window is erased because third parameter
  202.  * of InvalidateRect is true. Since a Paint method wasn't
  203.  * defined, WM_PAINT messages call only BeginPaint and EndPaint.
  204.  ***************************************************************** }
  205. procedure ScribbleWindow.WMRButtonDown(var Msg: TMessage);
  206. begin
  207.   InvalidateRect(HWindow, nil, True);
  208.   UpdateWindow(HWindow);
  209. end;
  210.  
  211. {*****************************************************************
  212.  * CScribbleWindow constructor.
  213.  *****************************************************************}
  214. constructor CScribbleWindow.Init(aParent: PWindowsObject; ATitle: PChar);
  215. begin
  216.   ScribbleWindow.Init(aParent, ATitle); { Call standard OWL constructor }
  217.                                         { for a window.                 }
  218.   Attr.Menu := LoadMenu(HInstance,          { Attach menu from resource }
  219.           MakeIntResource(MenuID)); { file to window.           }
  220.  
  221.   thePen := CreatePen(PS_SOLID,PenWidth,    {Initialize pen to black.   }
  222.                       RGB(0, 0, 0));
  223. end;
  224.  
  225. {*****************************************************************
  226.  * CScribbleWindow destructor.
  227.  *****************************************************************}
  228. destructor CScribbleWindow.Done;
  229. begin
  230.   TWindow.Done;           { Call standard OWL destructor for a window. }
  231.   DeleteObject(thePen);   { Dispose of pen. }
  232. end;
  233.  
  234. {*****************************************************************
  235.  * procedure CScribbleWindow.SelectRedPen
  236.  *
  237.  * Create a red pen in response to a "Red" selection from
  238.  * Pen menu.
  239.  *****************************************************************}
  240. procedure CScribbleWindow.SelectRedPen(var Msg: TMessage);
  241. begin
  242.   DeleteObject(thePen);                { Dispose of the current pen }
  243.   thePen := CreatePen(PS_SOLID,PenWidth, RGB(255, 0, 0));
  244. end;
  245.  
  246. {*****************************************************************
  247.  * procedure CScribbleWindow.SelectGreenPen
  248.  *
  249.  * Create a green pen in response to a "Green" selection from
  250.  * Pen menu.
  251.  *****************************************************************}
  252. procedure CScribbleWindow.SelectGreenPen(var Msg: TMessage);
  253. begin
  254.   DeleteObject(thePen);                 { Dispose of the current pen }
  255.   thePen := CreatePen(PS_SOLID,PenWidth, RGB(0, 255, 0));
  256. end;
  257.  
  258. {*****************************************************************
  259.  * procedure CScribbleWindow.SelectBluePen
  260.  *
  261.  * Create a blue pen in response to a "Blue" selection from
  262.  * Pen menu.
  263.  *****************************************************************}
  264. procedure CScribbleWindow.SelectBluePen(var Msg: TMessage);
  265. begin
  266.   DeleteObject(thePen);                 { Dispose of the current pen }
  267.   thePen := CreatePen(PS_SOLID,PenWidth, RGB(0, 0, 255));
  268. end;
  269.  
  270. {*****************************************************************
  271.  * procedure CScribbleWindow.SelectBlackPen
  272.  *
  273.  * Create a black pen in response to a "Black" selection from
  274.  * Pen menu.
  275.  *****************************************************************}
  276. procedure CScribbleWindow.SelectBlackPen(var Msg: TMessage);
  277. begin
  278.   DeleteObject(thePen); { Dispose of the current pen }
  279.   thePen := CreatePen(PS_SOLID,PenWidth, RGB(0, 0, 0));
  280. end;
  281.  
  282. {*****************************************************************
  283.  * procedure CScribbleWindow.WM_LButtonDown
  284.  *
  285.  * Select a colored pen into the display context.
  286.  *****************************************************************}
  287. procedure CScribbleWindow.WMLButtonDown(var Msg: TMessage);
  288. begin
  289.   ScribbleWindow.WMLButtonDown(Msg); { Call ScribbleWindow   }
  290.                      { WMLButtonDown method. }
  291.   SelectObject(handleDC, thePen);    { Select pen into display context. }
  292. end;
  293.  
  294. {*****************************************************************
  295.  * procedure CScribbleWindow.GetWindowClass
  296.  *
  297.  * Changes the window icon to a custom icon
  298.  *****************************************************************}
  299. procedure CScribbleWindow.GetWindowClass(var AWndClass: TWndClass);
  300. begin
  301.   ScribbleWindow.GetWindowClass(AWndClass); { Get the ScribbleWindow }
  302.                         { class                  }
  303.   AWndClass.hIcon := LoadIcon(HInstance,MakeIntResource(IconID));
  304.                         { Attach a resource to }
  305.                         {  the window          }
  306. end;
  307.  
  308. {*****************************************************************
  309.  * function CScribbleWindow.GetClassName: PChar;
  310.  *
  311.  * Returns a unique class name for the Color Scribble window class.
  312.  *****************************************************************}
  313. function CScribbleWindow.GetClassName: PChar;
  314. begin
  315.   GetClassName := 'ColorScribble';
  316. end;
  317.  
  318. {*****************************************************************
  319.  * procedure CScribbleApplication.InitMainWindow
  320.  *
  321.  * Initialize a Color Scribble window for the main window.
  322.  *****************************************************************}
  323. procedure CScribbleApplication.InitMainWindow;
  324. begin
  325.   MainWindow := New(PCScribbleWindow,Init(nil, 'Scribble With Color!'));
  326. end;
  327.  
  328.  
  329. {*** Program begins here. ***}
  330.  
  331. var
  332.   CSApp: CScribbleApplication;
  333.  
  334. begin
  335.   CSApp.Init('CScribble');
  336.   CSApp.Run;
  337.   CSApp.Done;
  338. end.
  339.