home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / tpw / docdemos / helpex / owlhelp.pas < prev    next >
Pascal/Delphi Source File  |  1991-05-20  |  10KB  |  373 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   Demo program                                 }
  5. {   Copyright (c) 1991 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. program HelpEx;
  10.  
  11. { ObjectWindows version of the HelpEx example program }
  12.  
  13. {$R OWLHELP.RES}
  14.  
  15. uses WinTypes, WinProcs, Strings, WObjects;
  16.  
  17. const
  18.   cm_Print  = 104;
  19.  
  20.   { Help Items }
  21.   cm_About        = 300;
  22.   cm_HelpIndex    = 301;
  23.   cm_HelpKeyboard = 302;
  24.   cm_HelpHelp     = 303;
  25.  
  26.   ExeNameMaxSize = 128;
  27.  
  28.   { Help contexts }
  29.   hc_EditClear = 100;
  30.   hc_EditCopy  = 101;
  31.   hc_EditCut   = 102;
  32.   hc_EditPaste = 103;
  33.   hc_EditUndo  = 104;
  34.   hc_FileExit   = 200;
  35.   hc_FileNew    = 201;
  36.   hc_FileOpen   = 202;
  37.   hc_FilePrint  = 203;
  38.   hc_FileSave   = 204;
  39.   hc_FileSaveAs = 205;
  40.   hc_EditWindow   = 300;
  41.   hc_MaximizeIcon = 301;
  42.   hc_MinimizeIcon = 302;
  43.   hc_SystemMenu   = 303;
  44.   hc_TitleBar     = 306;
  45.   hc_SizingBorder = 307;
  46.  
  47. type
  48.   THelpExApp = object(TApplication)
  49.     procedure InitMainWindow; virtual;
  50.     procedure InitInstance; virtual;
  51.   end;
  52.  
  53.   PHelpExWindow = ^THelpExWindow;
  54.   THelpExWindow = object(TWindow)
  55.     Help: Boolean;
  56.     HelpCursor: HCursor;
  57.     HelpFileName: PChar;
  58.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  59.     destructor Done; virtual;
  60.     procedure NotImplemented;
  61.     procedure WMCommand(var Message: TMessage);
  62.       virtual wm_First + wm_Command;
  63.     procedure WMLButtonDown(var Message: TMessage);
  64.       virtual wm_First + wm_LButtonDown;
  65.     procedure WMKeyDown(var Message: TMessage);
  66.       virtual wm_First + wm_KeyDown;
  67.     procedure WMSetCursor(var Message: TMessage);
  68.       virtual wm_First + wm_SetCursor;
  69.     procedure WMInitMenu(var Message: TMessage);
  70.       virtual wm_First + wm_InitMenu;
  71.     procedure WMEnterIdle(var Message: TMessage);
  72.       virtual wm_First + wm_EnterIdle;
  73.     procedure WMDestroy(var Message: TMessage);
  74.       virtual wm_First + wm_Destroy;
  75.     procedure WMNCLButtonDown(var Message: TMessage);
  76.       virtual wm_First + wm_NCLButtonDown;
  77.     procedure CMFileNew(var Message: TMessage);
  78.       virtual cm_First + cm_FileNew;
  79.     procedure CMFileOpen(var Message: TMessage);
  80.       virtual cm_First + cm_FileOpen;
  81.     procedure CMFileSave(var Message: TMessage);
  82.       virtual cm_First + cm_FileSave;
  83.     procedure CMFileSaveAs(var Message: TMessage);
  84.       virtual cm_First + cm_FileSaveAs;
  85.     procedure CMPrint(var Message: TMessage);
  86.       virtual cm_First + cm_Print;
  87.     procedure CMEditUndo(var Message: TMessage);
  88.       virtual cm_First + cm_EditUndo;
  89.     procedure CMEditCut(var Message: TMessage);
  90.       virtual cm_First + cm_EditCut;
  91.     procedure CMEditClear(var Message: TMessage);
  92.       virtual cm_First + cm_EditClear;
  93.     procedure CMEditCopy(var Message: TMessage);
  94.       virtual cm_First + cm_EditCopy;
  95.     procedure CMEditPaste(var Message: TMessage);
  96.       virtual cm_First + cm_EditPaste;
  97.     procedure CMHelpIndex(var Message: TMessage);
  98.       virtual cm_First + cm_HelpIndex;
  99.     procedure CMHelpKeyBoard(var Message: TMessage);
  100.       virtual cm_First + cm_HelpKeyBoard;
  101.     procedure CMHelpHelp(var Message: TMessage);
  102.       virtual cm_First + cm_HelpHelp;
  103.     procedure CMAbout(var Message: TMessage);
  104.      virtual cm_First + cm_About;
  105.   end;
  106.  
  107. { THelpExApp }
  108. procedure THelpExApp.InitMainWindow;
  109. begin
  110.   MainWindow := New(pHelpExWindow, Init(nil, 'HelpEx'));
  111. end;
  112.  
  113. procedure THelpExApp.InitInstance;
  114. begin
  115.   TApplication.InitInstance;
  116.   if Status = 0 then
  117.     HAccTable := LoadAccelerators(HInstance, 'HELPEXACC');
  118. end;
  119.  
  120. { THelpExWindow }
  121. constructor THelpExWindow.Init;
  122. var
  123.   FileNameLen: Integer;
  124.   FileName: array[0..ExeNameMaxSize + 1] of Char;
  125.   I: Integer;
  126. begin
  127.   { Get Menu from the Resource File }
  128.   TWindow.Init(AParent, ATitle);
  129.   Attr.Menu := LoadMenu(HInstance, 'HELPEXMENU');
  130.  
  131.   { Construct HelpFileName from Module Name }
  132.   FileNameLen := GetModuleFileName(HInstance, FileName, ExeNameMaxSize);
  133.   I := FileNameLen - 1;
  134.   while (I <> 0) and ((FileName[I] <> '\') and (FileName[I] <> ':')) do
  135.     Dec(I);
  136.   Inc(I);
  137.   if I + 13 <= ExeNameMaxSize then
  138.     StrCopy(@FileName[I], 'helpex.hlp')
  139.   else
  140.     StrCopy(@FileName[I], '?');
  141.   HelpFileName := StrNew(FileName);
  142.  
  143.   {Load the Cursor from from the Resource }
  144.   HelpCursor := LoadCursor(HInstance, 'HELPCURSOR');
  145.   Help := False;
  146. end;
  147.  
  148. destructor THelpExWindow.Done;
  149. begin
  150.   TWindow.Done;
  151.   StrDispose(HelpFileName);
  152. end;
  153.  
  154. procedure THelpExWindow.NotImplemented;
  155. begin
  156.   Messagebox(HWindow, 'Command not Implemented', 'Help Example', mb_Ok);
  157. end;
  158.  
  159. procedure THelpExWindow.WMCommand;
  160. var
  161.   HelpContextId: LongInt;
  162. begin
  163.   if Help then
  164.   begin
  165.  
  166.     { Determine the Appropriate Help Context }
  167.     case Message.wParam of
  168.       cm_FileNew: HelpContextId := hc_FileNew;
  169.       cm_FileOpen: HelpContextId := hc_FileOpen;
  170.       cm_FileSave: HelpContextId := hc_FileSave;
  171.       cm_FileSaveAs: HelpContextId := hc_FileSaveAs;
  172.       cm_Print: HelpContextId := hc_FilePrint;
  173.       cm_Exit: HelpContextId := hc_FileExit;
  174.       cm_EditUndo: HelpContextId := hc_EditUndo;
  175.       cm_EditCut: HelpContextId := hc_EditCut;
  176.       cm_EditClear: HelpContextId := hc_EditClear;
  177.       cm_EditCopy: HelpContextId := hc_EditCopy;
  178.       cm_EditPaste: HelpContextId := hc_EditPaste;
  179.     else
  180.       HelpContextId := 0;
  181.     end;
  182.  
  183.     { Warn of No Context Help Available }
  184.     { or Let the Help System take over. }
  185.     if HelpContextId = 0 then
  186.     begin
  187.       MessageBox(HWindow, 'Help not available for Help Menu Item',
  188.         'Help Example', Mb_Ok);
  189.       DefWndProc(Message);
  190.     end
  191.     else
  192.     begin
  193.       Help := False;
  194.       WinHelp(HWindow, HelpFileName, Help_Context, HelpContextId);
  195.     end;
  196.   end
  197.   else TWindow.WMCommand(Message);
  198. end;
  199.  
  200. { Handles the Press of the Left Button of the Mouse }
  201. procedure THelpExWindow.WMLButtonDown;
  202. begin
  203.   if Help then
  204.   begin
  205.     Help := False;
  206.     WinHelp(HWindow,HelpFileName, Help_Context, hc_EditWindow);
  207.   end
  208.   else DefWndProc(Message);
  209. end;
  210.  
  211. { Responds to normal keypresses }
  212. procedure THelpExWindow.WMKeyDown;
  213. begin
  214.   if Message.wParam = vk_F1 then
  215.     if GetKeyState(vk_Shift) < 0 then
  216.     begin
  217.       Help := True;
  218.       SetCursor(HelpCursor);
  219.       DefWndProc(Message);
  220.     end
  221.     else WinHelp(HWindow, HelpFileName, Help_Index, 0)
  222.   else if (Message.wParam = vk_Escape) and Help then
  223.   begin
  224.     Help := False;
  225.     SetCursor(HCursor(GetClassWord(HWindow, gcw_HCursor)));
  226.   end;
  227. end;
  228.  
  229. { Sets the Help Cursor if appropriate }
  230. procedure THelpExWindow.WMSetCursor;
  231. begin
  232.   if Help then
  233.     SetCursor(HelpCursor)
  234.   else DefWndProc(Message);
  235. end;
  236.  
  237. { Sets the Help Cursor if appropriate }
  238. procedure THelpExWindow.WMInitMenu;
  239. begin
  240.   if Help then
  241.     SetCursor(HelpCursor);
  242. end;
  243.  
  244. { Select Help during Idle }
  245. procedure THelpExWindow.WMEnterIdle;
  246. begin
  247.   if ((Message.wParam = msgf_Menu) and ((GetKeyState(vk_F1)
  248.     and $8000) <> 0)) then
  249.   begin
  250.     Help := True;
  251.     PostMessage(HWindow, wm_KeyDown, vk_Return, 0);
  252.   end;
  253. end;
  254.  
  255. { Shut Down the Help System and post Quit }
  256. procedure THelpExWindow.WMDestroy;
  257. begin
  258.   WinHelp(HWindow, HelpFileName, help_Quit, 0);
  259.   PostQuitMessage(0);
  260. end;
  261.  
  262. { Handle Help outside Client Window }
  263. procedure THelpExWindow.WMNCLButtonDown;
  264. var
  265.   HelpContextId: LongInt;
  266. begin
  267.   if Help then
  268.   begin
  269.     case Message.wParam of
  270.       htCaption: HelpContextId := hc_TitleBar;
  271.       htReduce: HelpContextId := hc_MinimizeIcon;
  272.       htZoom: HelpContextId := hc_MaximizeIcon;
  273.       htSysMenu: HelpContextId := hc_SystemMenu;
  274.       htBottom: HelpContextId := hc_SizingBorder;
  275.       htBottomLeft: HelpContextId := hc_SizingBorder;
  276.       htBottomRight: HelpContextId := hc_SizingBorder;
  277.       htTop: HelpContextId := hc_SizingBorder;
  278.       htLeft: HelpContextId := hc_SizingBorder;
  279.       htRight: HelpContextId := hc_SizingBorder;
  280.       htTopLeft: HelpContextId := hc_SizingBorder;
  281.       htTopRight: HelpContextId := hc_SizingBorder;
  282.     else
  283.       HelpContextId := 0;
  284.     end;
  285.     if HelpContextId <> 0 then
  286.     begin
  287.       Help := False;
  288.       WinHelp(HWindow, HelpFileName, Help_Context, HelpContextId);
  289.     end
  290.     else DefWndProc(Message);
  291.   end
  292.   else DefWndProc(Message);
  293. end;
  294.  
  295. procedure THelpExWindow.CMFileNew(var Message: TMessage);
  296. begin
  297.   NotImplemented;
  298. end;
  299.  
  300. procedure THelpExWindow.CMFileOpen(var Message: TMessage);
  301. begin
  302.   NotImplemented;
  303. end;
  304.  
  305. procedure THelpExWindow.CMFileSave(var Message: TMessage);
  306. begin
  307.   NotImplemented
  308. end;
  309.  
  310. procedure THelpExWindow.CMFileSaveAs(var Message: TMessage);
  311. begin
  312.   NotImplemented;
  313. end;
  314.  
  315. procedure THelpExWindow.CMPrint(var Message: TMessage);
  316. begin
  317.   NotImplemented;
  318. end;
  319.  
  320. procedure THelpExWindow.CMEditUndo(var Message: TMessage);
  321. begin
  322.   NotImplemented;
  323. end;
  324.  
  325. procedure THelpExWindow.CMEditCut(var Message: TMessage);
  326. begin
  327.   NotImplemented;
  328. end;
  329.  
  330. procedure THelpExWindow.CMEditClear(var Message: TMessage);
  331. begin
  332.   NotImplemented;
  333. end;
  334.  
  335. procedure THelpExWindow.CMEditCopy(var Message: TMessage);
  336. begin
  337.   NotImplemented;
  338. end;
  339.  
  340. procedure THelpExWindow.CMEditPaste(var Message: TMessage);
  341. begin
  342.   NotImplemented;
  343. end;
  344.  
  345. procedure THelpExWindow.CMHelpIndex(var Message: TMessage);
  346. begin
  347.   WinHelp(HWindow, HelpFileName, Help_Index, 0);
  348. end;
  349.  
  350. procedure THelpExWindow.CMHelpKeyBoard(var Message: TMessage);
  351. begin
  352.   WinHelp(HWindow, HelpFileName, Help_Key, LongInt(PChar('keys')));
  353. end;
  354.  
  355. procedure THelpExWindow.CMHelpHelp(var Message: TMessage);
  356. begin
  357.   WinHelp(HWindow, 'WINHELP.HLP', Help_Index, 0);
  358. end;
  359.  
  360. procedure THelpExWindow.CMAbout(var Message: TMessage);
  361. begin
  362.   Application^.ExecDialog(New(PDialog, Init(@Self, 'ABOUTBOX')));
  363. end;
  364.  
  365. var
  366.   HelpExApp:THelpExApp;
  367.  
  368. begin
  369.   HelpExApp.Init('HelpEx');
  370.   HelpExApp.Run;
  371.   HelpExApp.Done;
  372. end.
  373.