home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 26 / CD_ASCQ_26_1295.iso / vrac / picdll.zip / WINSTUFF.PAS < prev    next >
Pascal/Delphi Source File  |  1995-06-16  |  7KB  |  270 lines
  1. unit Winstuff;
  2. { Program copyright (c) 1995 by Charles Calvert }
  3. { Project Name: WINSTUFF }
  4.  
  5. {
  6.   This unit shows four types of routines exported from a DLL:
  7.  
  8.     HandleButton: Simple MessageBox routine
  9.  
  10.     About
  11.     ShowAbout: Launch and run a modal dialog
  12.  
  13.     RegisterWinPopup
  14.     CreateWinPopup: Create and show a popup window
  15.  
  16.     RegisterChild
  17.     CreateChild: Register, Create, and Show a child window
  18. }
  19.  
  20. interface
  21.  
  22. uses
  23.   WinTypes, WinProcs, SysUtils,
  24.   Messages;
  25.  
  26. procedure HandleButton(Window: HWnd); export;
  27. function About(Dialog: HWnd; Message, WParam: Word; LParam: Longint): Bool; export;
  28. procedure ShowAbout(Window: Hwnd); export;
  29. function RegisterChild(ParentWindow: HWnd): HWnd; export;
  30. function CreateChild(ParentWindow: HWnd): Hwnd; export;
  31. procedure RegisterWinPopup; export;
  32. procedure CreateWinPopup; export;
  33.  
  34. implementation
  35.  
  36. {$R WINSTUFF.RES}
  37.  
  38. { A trivial routine showing that it is easy to pass
  39.   a window handle into a DLL }
  40. procedure HandleButton(Window: HWnd);
  41. begin
  42.   MessageBox(Window, 'Hello', 'Sam', MB_OK);
  43. end;
  44.  
  45. {--- The About Dialog ---}
  46.  
  47. const
  48.   idm_About = 100;
  49.  
  50. { This is the main routine for the About Dialog. It
  51.   handles all messages sent to the dialog, and is responsible
  52.   for telling it to close itself when the user clicks on the
  53.   Ok or Cancel button. }
  54. function About(Dialog: HWnd; Message, WParam: Word;
  55.   LParam: Longint): Bool;
  56. begin
  57.   About := True;
  58.   case Message of
  59.     wm_InitDialog:
  60.       Exit;
  61.     wm_Command:
  62.       if (WParam = id_Ok) or (WParam = id_Cancel) then begin
  63.         EndDialog(Dialog, 1);
  64.         Exit;
  65.       end;
  66.   end;
  67.   About := False;
  68. end;
  69.  
  70. { Create, show, and destroy a modal dialog }
  71. procedure ShowAbout(Window: Hwnd);
  72. var
  73.   AboutProc: TFarProc;
  74. begin
  75.   AboutProc := MakeProcInstance(@About, HInstance);
  76.   DialogBox(HInstance, 'AboutBox', Window, AboutProc);
  77.   FreeProcInstance(AboutProc);
  78. end;
  79.  
  80. { -- Popup Window -- }
  81.  
  82. const
  83.   PopupName = 'PopStuff';
  84.  
  85. { The WindProc for the Popup Window. }
  86. function PopupWinProc(Window: HWnd; Message, WParam: Word; LParam: Longint): Longint; export;
  87. const
  88.   S:PChar = 'Hello from the DLL';
  89.   S1:PChar = 'Try clicking left button, or right button';
  90. var
  91.   AboutProc: TFarProc;
  92.   PS: TPaintStruct;
  93.   PaintDC: HDC;
  94.  
  95. begin
  96.   PopupWinProc := 0;
  97.   case Message of
  98.     wm_LButtonDown: begin
  99.       HandleButton(Window);
  100.       Exit;
  101.     end;
  102.  
  103.     wm_RButtonDown: begin
  104.       AboutProc := MakeProcInstance(@About, HInstance);
  105.       DialogBox(HInstance, 'AboutBox', Window, AboutProc);
  106.       FreeProcInstance(AboutProc);
  107.       Exit;
  108.     end;
  109.  
  110.     wm_Paint: begin
  111.       PaintDC := BeginPaint(Window, PS);
  112.         TextOut(PaintDC, 10, 10, S, strlen(S));
  113.         TextOut(PaintDC, 10, 50, S1, strlen(S1));
  114.       EndPaint(Window, PS);
  115.     end;
  116.   end;
  117.   PopupWinProc := DefWindowProc(Window, Message, WParam, LParam);
  118. end;
  119.  
  120. { The Create routine for the Popup Window. Basically, its
  121.   just a wrapper around the complex CreateWindow call. The
  122.   call to ShowWindow makes the window visible, with sw_ShowNormal
  123.   specifying that it is shown in a normal state, and not
  124.   minimized or maximized. }
  125.  
  126. procedure CreateWinPopup;
  127. var
  128.   Window: Hwnd;
  129. begin
  130.   Window := CreateWindow(
  131.     PopupName, 'Popup without VCL', ws_OverLappedWindow,
  132.     cw_UseDefault, cw_UseDefault, cw_UseDefault, cw_UseDefault,
  133.     0, 0, HInstance, nil);
  134.  
  135.   CmdShow := Sw_ShowNormal;
  136.  
  137.   ShowWindow(Window, CmdShow);
  138.   UpdateWindow(Window);
  139. end;
  140.  
  141. { The Register routine for the Popup Window. The main chore
  142.   is to fill out the complex TWndClass structure, and pass it
  143.   to RegisterWindow. After the window has been registered,
  144.   the call to the local CreateWinPopup routine actually creates
  145.   it and shows it on screen. Only call RegisterWindow once
  146.   for each window in your application.}
  147.  
  148. procedure RegisterWinPopup;
  149. var
  150.   Window: HWnd;
  151.   WndClass: TWndClass;
  152. begin
  153.   if HPrevInst = 0 then begin
  154.     WndClass.Style := 0;
  155.     WndClass.lpfnWndProc := @PopupWinProc;
  156.     WndClass.cbClsExtra := 0;
  157.     WndClass.cbWndExtra := 0;
  158.     WndClass.hInstance := HInstance;
  159.     WndClass.hIcon := LoadIcon(0, idi_Application);
  160.     WndClass.hCursor := LoadCursor(0, idc_Arrow);
  161.     WndClass.hbrBackground := GetStockObject(white_Brush);
  162.     WndClass.lpszMenuName := PopupName;
  163.     WndClass.lpszClassName := PopupName;
  164.  
  165.     if not RegisterClass(WndClass) then Halt(255);
  166.   end;
  167.  
  168.   CreateWinPopUp;
  169. end;
  170.  
  171. { -- Child Window -- }
  172.  
  173. const
  174.   ChildName = 'ChildWindow';
  175.  
  176. { This is the WindProc for the child Window.
  177.   It paints text to the window, and handles right and
  178.   left button clicks. }
  179. function ChildProc(Window: HWnd; Message, WParam: Word; LParam: Longint): Longint; export;
  180. const
  181.   S:PChar = 'Hello from the DLL';
  182.   S1:PChar = 'Try clicking left button, or right button';
  183. var
  184.   AboutProc: TFarProc;
  185.   PS: TPaintStruct;
  186.   PaintDC: HDC;
  187.  
  188. begin
  189.   ChildProc := 0;
  190.  
  191.   case Message of
  192.     wm_LButtonDown: begin
  193.       HandleButton(Window);
  194.       Exit;
  195.     end;
  196.  
  197.     wm_RButtonDown: begin
  198.       AboutProc := MakeProcInstance(@About, HInstance);
  199.       DialogBox(HInstance, 'AboutBox', Window, AboutProc);
  200.       FreeProcInstance(AboutProc);
  201.       Exit;
  202.     end;
  203.  
  204.     wm_Paint: begin
  205.       PaintDC := BeginPaint(Window, PS);
  206.         TextOut(PaintDC, 10, 10, S, strlen(S));
  207.         TextOut(PaintDC, 10, 50, S1, strlen(S1));
  208.       EndPaint(Window, PS);
  209.       Exit;
  210.     end;
  211.   end;
  212.  
  213.   ChildProc := DefWindowProc(Window, Message, WParam, LParam);
  214. end;
  215.  
  216. { The Create routine for the Child Window. Basically, its
  217.   just a wrapper around the complex CreateWindow call. The
  218.   call to ShowWindow makes the window visible, with sw_ShowNormal
  219.   specifying that it is shown in a normal state, and not
  220.   minimized or maximized. }
  221. function CreateChild(ParentWindow: Hwnd): Hwnd;
  222. var
  223.   ASimpleWindow: HWnd;
  224. begin
  225.   ASimpleWindow := CreateWindow(
  226.     ChildName, 'Child without VCL',
  227.     ws_ChildWindow or ws_Caption or ws_ClipSiblings or
  228.     ws_visible or ws_ThickFrame or ws_SysMenu,
  229.     1, 75, 200, 100, ParentWindow, 0, HInstance, nil);
  230.  
  231.   CmdShow := sw_ShowNormal;
  232.  
  233.   ShowWindow(ASimpleWindow, CmdShow);
  234.  
  235.   Result := ASimpleWindow;
  236. end;
  237.  
  238. { The Register routine for the Child Window. The main chore
  239.   is to fill out the complex TWndClass structure, and pass it
  240.   to RegisterWindow. After the window has been registered,
  241.   the call to the local CreateChild routine actually creates
  242.   it and shows it on screen. Only call RegisterWindow once
  243.   for each window in your application.}
  244. function RegisterChild(ParentWindow: HWnd): HWnd;
  245. var
  246.   Window: HWnd;
  247.   WndClass: TWndClass;
  248. begin
  249.   if HPrevInst = 0 then begin
  250.     WndClass.Style := cs_HRedraw or cs_VRedraw;
  251.     WndClass.lpfnWndProc := @ChildProc;
  252.     WndClass.cbClsExtra := 0;
  253.     WndClass.cbWndExtra := 0;
  254.     WndClass.hInstance := HInstance;
  255.     WndClass.hIcon := LoadIcon(0, idi_Application);
  256.     WndClass.hCursor := LoadCursor(0, idc_Arrow);
  257.     WndClass.hbrBackground := GetStockObject(White_Brush);
  258.     WndClass.lpszMenuName := ChildName;
  259.     WndClass.lpszClassName := ChildName;
  260.  
  261.     if not RegisterClass(WndClass) then Halt(255);
  262.   end;
  263.  
  264.   Result := CreateChild(ParentWindow);
  265. end;
  266.  
  267. end.
  268.  
  269.  
  270.