home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Borland / Borland Pascal with Objects 7.0 / HELPEX.ZIP / HELPEX.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-27  |  9.0 KB  |  345 lines
  1. {************************************************}
  2. {                                                }
  3. {   Demo program                                 }
  4. {   Copyright (c) 1991 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program HelpEx;
  9.  
  10. {$X+}
  11.  
  12. {$R HELPEX.RES}
  13.  
  14. uses WinTypes, WinProcs, Strings;
  15.  
  16. const
  17.  
  18.   { File Menu Items }
  19.  
  20.   IdmNew    = 100;
  21.   IdmOpen   = 101;
  22.   IdmSave   = 102;
  23.   IdmSaveAs = 103;
  24.   IdmPrint  = 104;
  25.   IdmExit   = 105;
  26.  
  27.   { Edit Menu Items }
  28.  
  29.   IdmUndo  = 200;
  30.   IdmCut   = 201;
  31.   IdmCopy  = 202;
  32.   IdmPaste = 203;
  33.   IdmClear = 204;
  34.  
  35.   { Help Items }
  36.  
  37.   IdmAbout        = 300;
  38.   IdmHelpIndex    = 301;
  39.   IdmHelpKeyboard = 302;
  40.   IdmHelpHelp     = 303;
  41.  
  42.   ExeNameMaxSize = 128;
  43.  
  44.   HelpIdEditClear = 100;
  45.   HelpIdEditCopy  = 101;
  46.   HelpIdEditCut   = 102;
  47.   HelpIdEditPaste = 103;
  48.   HelpIdEditUndo  = 104;
  49.  
  50.   HelpIdFileExit   = 200;
  51.   HelpIdFileNew    = 201;
  52.   HelpIdFileOpen   = 202;
  53.   HelpIdFilePrint  = 203;
  54.   HelpIdFileSave   = 204;
  55.   HelpIdFileSaveAs = 205;
  56.  
  57.   HelpIdEditWindow   = 300;
  58.   HelpIdMaximizeIcon = 301;
  59.   HelpIdMinimizeIcon = 302;
  60.   HelpIdSystemMenu   = 303;
  61.   HelpIdTitleBar     = 306;
  62.   HelpIdSizingBorder = 307;
  63.  
  64. type
  65.   THelpName = array[0..ExeNameMaxSize+1] of Char;
  66.  
  67. var
  68.   Wnd: Hwnd;
  69.   Inst: tHandle;
  70.   Help: Boolean;
  71.   HelpCursor: HCursor;
  72.   HelpFileName: THelpName;
  73.   AccTable: THandle;
  74.  
  75. procedure MakeHelpPathName(var FileName: THelpName);
  76. var
  77.   FileNameLen: integer;
  78.   I: integer;
  79. begin
  80.   FileNameLen:= GetModuleFileName(Inst, FileName, ExeNameMaxSize);
  81.  
  82.   I := FileNameLen - 1;
  83.   while (I <> 0) and ((Filename[I] <> '\') and (Filename[I] <> ':')) do
  84.     Dec(I);
  85.   Inc(I);
  86.   if I + 13 <= ExeNameMaxSize then
  87.     StrCopy(@FileName[I], 'helpex.hlp')
  88.   else
  89.     StrCopy(@FileName[I], '?');
  90. end;
  91.  
  92. function About(Dlg: Hwnd; Message, WParam: Word; LParam: Longint): Boolean;
  93.   far;
  94. begin
  95.   About := False;
  96.   case Message of
  97.     WM_INITDIALOG:
  98.       About := True;
  99.     WM_COMMAND:
  100.       if WParam = idOk then
  101.       begin
  102.         EndDialog(Dlg, 1);
  103.         About := True;
  104.       end;
  105.   end;
  106. end;
  107.  
  108. function MainWndProc(Wnd: Hwnd; Message, WParam: Word;
  109.   LParam: LongInt): LongInt; export;
  110. var
  111.   ProcAbout: TFarProc;
  112.   HelpContextId: Longint;
  113.   Rect: TRect;
  114.   Pt: TPoint;
  115.   DoubleWord: LongInt;
  116.   WFormat: Word;
  117.   Arrow: HCursor;
  118. begin
  119.   MainWndProc := 0;
  120.   case message of
  121.  
  122.     WM_COMMAND:
  123.       { Was F1 just pressed in a menu, or are we in help mode
  124.         Shift+F1?  }
  125.       if Help then
  126.       begin
  127.         case WParam of
  128.           IdmNew: HelpContextId := HelpIdFileNew;
  129.           IdmOpen: HelpContextId := HelpIdFileOpen;
  130.           IdmSave: HelpContextId := HelpIdFileSave;
  131.           IdmSaveAs: HelpContextId := HelpIdFileSaveAs;
  132.           IdmPrint: HelpContextId := HelpIdFilePrint;
  133.           IdmExit: HelpContextId := HelpIdFileExit;
  134.           IdmUndo: HelpContextId := HelpIdEditUndo;
  135.           IdmCut: HelpContextId := HelpIdEditCut;
  136.           IdmClear: HelpContextId := HelpIdEditClear;
  137.           IdmCopy: HelpContextId := HelpIdEditCopy;
  138.           IdmPaste: HelpContextId := HelpIdEditPaste;
  139.         else
  140.           HelpContextId := 0;
  141.         end;
  142.  
  143.         if HelpContextId = 0 then
  144.         begin
  145.           MessageBox(Wnd, 'Help not available for Help Menu Item',
  146.             'Help Example', Mb_Ok);
  147.           MainWndProc := DefWindowProc(Wnd, Message, WParam, LParam);
  148.         end
  149.         else
  150.         begin
  151.           Help := False;
  152.           WinHelp(Wnd, HelpFileName, Help_Context, HelpContextId);
  153.         end
  154.       end
  155.       else
  156.         case WParam of
  157.           IdmNew,
  158.           IdmOpen,
  159.           IdmSave,
  160.           IdmSaveAs,
  161.           IdmPrint,
  162.           IdmUndo,
  163.           IdmCut,
  164.           IdmClear,
  165.           IdmCopy,
  166.           IdmPaste:
  167.             Messagebox(Wnd, 'Command not Implemented', 'Help Example', mb_Ok);
  168.           IdmExit:
  169.             DestroyWindow(Wnd);
  170.           IdmHelpIndex:
  171.             WinHelp(Wnd, HelpFileName, Help_Index, 0);
  172.           IdmHelpKeyBoard:
  173.             WinHelp(Wnd, HelpFileName, Help_Key, LongInt(PChar('keys')));
  174.           IdmHelpHelp:
  175.             WinHelp(Wnd, 'WINHELP.HLP', Help_Index, 0);
  176.           IdmAbout:
  177.             begin
  178.               ProcAbout:= MakeProcInstance(@About, Inst);
  179.               DialogBox(Inst, 'AboutBox', Wnd, ProcAbout);
  180.               FreeProcInstance(ProcAbout);
  181.             end;
  182.         else
  183.           MainWndProc := DefWindowProc(Wnd, Message, WParam, LParam);
  184.         end;
  185.  
  186.     WM_LBUTTONDOWN:
  187.       if Help then
  188.       begin
  189.         Help := False;
  190.         WinHelp(Wnd, HelpFileName, Help_Context, HelpIDEditWindow);
  191.       end
  192.       else
  193.         MainWndProc := DefWindowProc(Wnd, Message, WParam, LParam);
  194.  
  195.     WM_NCLBUTTONDOWN:
  196.  
  197.       { If we are in help mode (Shift+F1) then display
  198.         context sensitive help for non-client area.  }
  199.  
  200.       if Help then
  201.       begin
  202.         case WParam of
  203.           HtCaption: HelpContextId := HelpIdTitleBar;
  204.           HtReduce: HelpContextId := HelpIdMinimizeIcon;
  205.           HtZoom: HelpContextId := HelpIdMaximizeIcon;
  206.           HtSysMenu: HelpContextId := HelpIdSystemMenu;
  207.           HtBottom: HelpContextId := HelpIdSizingBorder;
  208.           HtBottomLeft: HelpContextId := HelpIdSizingBorder;
  209.           HtBottomRight: HelpContextId := HelpIdSizingBorder;
  210.           HtTop: HelpContextId := HelpIdSizingBorder;
  211.           HtLeft: HelpContextId := HelpIdSizingBorder;
  212.           HtRight: HelpContextId := HelpIdSizingBorder;
  213.           HtTopLeft: HelpContextId := HelpIdSizingBorder;
  214.           HtTopRight: HelpContextId := HelpIdSizingBorder;
  215.         else
  216.           HelpContextId := 0;
  217.         end;
  218.         if HelpContextId = 0 then
  219.           MainWndProc := DefWindowProc(Wnd, Message, WParam, LParam)
  220.         else
  221.         begin
  222.           Help := False;
  223.           WinHelp(Wnd, HelpFileName, Help_Context, HelpContextId);
  224.         end
  225.       end
  226.       else
  227.         MainWndProc := DefWindowProc(Wnd, Message, WParam, LParam);
  228.  
  229.     WM_KEYDOWN:
  230.       if WParam = vk_F1 then
  231.  
  232.         { If Shift-F1, turn help mode on and set help cursor }
  233.  
  234.         if GetKeyState(VK_Shift) < 0 then
  235.         begin
  236.           Help := True;
  237.           SetCursor(HelpCursor);
  238.           MainWndProc := DefWindowProc(Wnd, Message, WParam, LParam);
  239.         end
  240.  
  241.         { If F1 without shift, call up help main index topic }
  242.  
  243.         else
  244.           WinHelp(Wnd, HelpFileName, Help_Index, 0)
  245.  
  246.         { Escape during help mode: turn help mode off }
  247.  
  248.       else if (WParam = vk_Escape) and Help then
  249.       begin
  250.         Help := False;
  251.         SetCursor(hCursor(GetClassWord(Wnd, GCW_HCursor)));
  252.       end;
  253.  
  254.     WM_SETCURSOR:
  255.  
  256.       { In help mode it is necessary to reset the cursor
  257.         in response to every WM_SETCURSOR message.  Otherwise,
  258.         by default, Windows will reset the cursor to that
  259.         of the window class.  }
  260.  
  261.       if Help then
  262.         SetCursor(HelpCursor)
  263.       else
  264.         MainWndProc := DefWindowProc(Wnd, Message, WParam, LParam);
  265.  
  266.     WM_INITMENU:
  267.       if Help then
  268.         SetCursor(HelpCursor)
  269.       else
  270.         MainWndProc := 1;
  271.  
  272.     WM_ENTERIDLE:
  273.       if ((WParam = msgf_Menu) and ((GetKeyState(VK_F1) and $8000) <> 0)) then
  274.       begin
  275.         Help := True;
  276.         PostMessage(Wnd, WM_KEYDOWN, VK_RETURN, 0);
  277.       end;
  278.  
  279.     WM_DESTROY:
  280.       begin
  281.         WinHelp(Wnd, HelpFileName, HELP_QUIT, 0);
  282.         PostQuitMessage(0);
  283.       end
  284.   else
  285.     MainWndProc := DefWindowProc(Wnd, Message, WParam, LParam);
  286.   end;
  287. end;
  288.  
  289. function InitInstance(Instance: THandle; CmdShow: Integer): Boolean;
  290. begin
  291.   Inst := Instance;
  292.   AccTable := LoadAccelerators(Inst,'HELPEXACC');
  293.   Wnd := CreateWindow('Helpex', 'Help Example', WS_OVERLAPPEDWINDOW,
  294.     CW_USEDEFAULT, 0, CW_USEDEFAULT, 0, GetFocus, 0, Instance, nil);
  295.   if Wnd = 0 then
  296.   begin
  297.     InitInstance := False;
  298.     Exit;
  299.   end;
  300.   ShowWindow(Wnd, CmdShow);
  301.   UpdateWindow(Wnd);
  302.   EnableMenuItem(GetSubMenu(GetMenu(Wnd), 1), IdmClear, Mf_Enabled);
  303.  
  304.   MakeHelpPathName(HelpFileName);
  305.   HelpCursor := LoadCursor(Inst,'HELPCURSOR');
  306.   InitInstance := True;
  307. end;
  308.  
  309. function InitApplication(Instance: THandle): Boolean;
  310. var
  311.   WC: TWndClass;
  312. begin
  313.   with WC do
  314.   begin
  315.     style := CS_HRedraw or CS_VRedraw;
  316.     lpfnWndProc := @MainWndProc;
  317.     cbClsExtra := 0;
  318.     cbWndEXtra := 0;
  319.     hInstance := Instance;
  320.     hIcon := LoadIcon(0, IDI_Application);
  321.     hCursor := LoadCursor(0, IDC_Arrow);
  322.     hbrBackground := GetStockObject( White_Brush);
  323.     lpszMenuName := 'HELPEXMENU';
  324.     lpszClassName := 'Helpex';
  325.   end;
  326.   InitApplication := RegisterClass(WC);
  327. end;
  328.  
  329.  
  330. var
  331.   Message: TMsg;
  332.  
  333. begin { main }
  334.   if hPrevInst = 0 then
  335.     if not InitApplication(hInstance) then Halt;
  336.   if not InitInstance(hInstance, CmdShow) then Halt;
  337.   while GetMessage(Message, 0, 0, 0) do
  338.     if TranslateAccelerator(Wnd, AccTable, Message) = 0 then
  339.     begin
  340.       TranslateMessage(Message);
  341.       DispatchMessage(Message);
  342.     end;
  343. end.
  344.  
  345.