home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / windows / c / mobjm260 / odmenu.pa_ / odmenu.pa
Encoding:
Text File  |  1994-09-06  |  11.6 KB  |  345 lines
  1. (*******************************************************************)
  2. (*                                                                 *)
  3. (*          Microworks ObjectMate 2.6                                                      *)
  4. (*                                                                 *)
  5. (*     Windows Interface Develpment Kit the Borland Languages.     *)
  6. (*                                                                 *)
  7. (*         ODMENU.PAS : Ownerdraw menu unit                                 *)
  8. (*                                                                                                                           *)
  9. (*     Copyright 1992-94 Microworks Sydney, Australia.               *)
  10. (*                                                                 *)
  11. (*******************************************************************)
  12.  
  13. (* This unit contains the functions necessary to draw ownerdraw menus. The main
  14.  * functions are 'DrawMenuItem' and 'MeasureMenuItem' and should be called from
  15.  * your WM_DRAWITEM and WM_MEASUREITEM methods respecitively. You can specify the
  16.  * menu text font,    highlight color and highlight text color as arguments in a call
  17.  * to DrawMenuItem. Zero values specify a fine system font and the standard
  18.  * Windows' highlight and highlight-text colors. The font handle passed as an
  19.  * argument to DrawMenuItem should also be passed to MeasureMenuItem so that each
  20.  * item is measured and drawn using the same font.
  21.  *
  22.  * The other functions 'StripStrLen', 'GetMenuItemPos', 'ProcessSystemChar' and
  23.  * 'Set3DSystemMenu' are accessory functions. GetMenuItemPos returns the zero based
  24.  * position of a menu item. It's used to determine if the next or previous menu
  25.  * item is a separator and if it is, draw its the adjacent part along with the current
  26.  * item. Set3DSystemMenu sets up an ownerdraw system menu and ProcessSystemChar
  27.  * processes its mnemonics. You should call Set3DSystemMenu from somewhere like
  28.  * SetupWindow. It takes a window handle and application name as arguments.
  29.  * ProcessSystemChar must be called from EvMenuChar if the active menu is the system
  30.  * menu. StripStrLen calculates the length of the menu text minus any 'single' or
  31.  * 'first of a pair' ampersands.
  32.  *
  33.  * Since the system menu rarely gets modified the Set3DSystemMenu and
  34.  * ProcessSystemChar functions are provided for convenience.
  35.  
  36.  * You can enhance your ownerdraw menu's by adding a bitmap or icon glyph to each
  37.  * item. If you do, you will need to pass a pointer to a record that specifies
  38.  * the menu item text and bitmap or icon handle as its members. This pointer is
  39.  * passed as the itemData member of the DRAWITEMSTRUCT and MEASUREITEMSTRUCT
  40.  * structures. You will need to retrieve the text string and bitmap or icon handle
  41.  * in MeasureMenuItem to calculate the itemWidth and itemHeight, and in DrawMenuItem
  42.  * to draw each item.
  43.  *)
  44.  
  45. unit ODMenu;
  46.  
  47. interface
  48.  
  49. uses WinTypes, WinProcs, Win31, Strings, SFX200;
  50.  
  51.     procedure DrawMenuItem (DIS: PDrawItemStruct; Font: HFont; Color, TextColor: TColorRef);
  52.  
  53.     function  GetMenuItemPos(Menu: HMenu; ItemID: LongInt): Word;
  54.  
  55.     function  GetMenuTextExtent (DC: HDC; Str: PChar; Count: Integer; var Size: TSize): BOOL;
  56.  
  57.     procedure MeasureMenuItem (Wnd: HWnd; MIS: PMeasureItemStruct; Font: HFont);
  58.  
  59.     function  ProcessSystemChar (Key: Word): LongInt;
  60.  
  61.     procedure Set3DSystemMenu (Wnd: HWnd; Name: PChar);
  62.  
  63. implementation
  64.  
  65. const
  66.  
  67.     LTGRAY = $00C0C0C0;
  68.     BLACK  = $00000000;
  69.  
  70. {    StripStrLen - returns the length of string "str" minus any 'underline' or
  71.                                 'first of a pair' ampersands. }
  72.  
  73. function StripStrLen (Str: PChar): Integer;
  74. var
  75.     i : Integer;
  76.     P : PChar;
  77. begin
  78.     i := lstrlen(Str);
  79.     P := StrScan(Str, '&');
  80.     while P <> nil do
  81.     begin
  82.         Dec(i);
  83.         P := StrScan(@P[2], '&');
  84.     end;
  85.     StripStrLen := i;
  86. end;
  87.  
  88. { DrawMenuItem - draws the ownerdraw menu items. Font, Color and TextColor can be zero. }
  89.  
  90. procedure DrawMenuItem (DIS: PDrawItemStruct; Font: HFont; Color, TextColor: TColorRef);
  91. var
  92.     IsNext, IsPrev  : Boolean;
  93.     GrayBrush       : HBrush;
  94.     WhiteBrush      : HBrush;
  95.     Brush, OldBrush : HBrush;
  96.     OldFont         : HFont;
  97.     OldPen, Pen     : HPen;
  98.     a, b, c         : Integer;
  99.     Count, Pos      : Word;
  100.     MenuText        : array[0..144] of Char;
  101. begin
  102.     with DIS^ do
  103.         case CtlType of
  104.             ODT_MENU:
  105.             begin
  106.                 IsNext := FALSE;
  107.                 IsPrev := FALSE;
  108.                 if GetSystemMetrics(SM_CYSIZE) = 26 then
  109.                 begin
  110.                     a := 5; b := 5;
  111.                 end
  112.                 else
  113.                 begin
  114.                     if GetSystemMetrics(SM_CXSCREEN) = 640 then
  115.                         a := 3
  116.                     else
  117.                         a := 4;
  118.                     b := 3;
  119.                 end;
  120.                 WhiteBrush := GetStockObject(WHITE_BRUSH);
  121.                 GrayBrush := GetStockObject(GRAY_BRUSH);
  122.                 if itemState and ODS_SELECTED <> 0 then
  123.                 begin
  124.                     if Color = 0 then
  125.                         Color := GetSysColor(COLOR_HIGHLIGHT);
  126.                     if TextColor = 0 then
  127.                         TextColor := GetSysColor(COLOR_HIGHLIGHTTEXT);
  128.                 end
  129.                 else
  130.                 begin
  131.                     Color := LTGRAY;
  132.                     TextColor := BLACK;
  133.                 end;
  134.                 Brush := CreateSolidBrush(Color);
  135.                 SetBkColor(hDC, Color);
  136.                 SetBkMode(hDC, TRANSPARENT);
  137.                 if (itemState and ODS_DISABLED <> 0) or (itemState and ODS_GRAYED <> 0) then
  138.                 begin
  139.                     if (itemState and ODS_SELECTED <> 0) then
  140.                     begin
  141.                         if (Color = LTGRAY) then
  142.                             SetTextColor(hDC, RGB(221, 221, 221))
  143.                         else
  144.                             SetTextColor(hDC, LTGRAY);
  145.                     end
  146.                     else
  147.                         SetTextColor(hDC, GetSysColor(COLOR_GRAYTEXT));
  148.                 end
  149.                 else
  150.                     SetTextColor(hDC, TextColor);
  151.                 Count := GetMenuItemCount(hwndItem) - 1;
  152.                 Pos := GetMenuItemPos(hwndItem, itemId);
  153.                 if (Pos <= Count) and (GetMenuItemID(hwndItem, Pos + 1) = 0) then
  154.                 begin
  155.                     Inc(rcItem.bottom, a);
  156.                     IsNext := TRUE;
  157.                 end;
  158.                 if (Pos > 0) and (GetMenuItemID(hwndItem, Pos - 1) = 0) then
  159.                 begin
  160.                     Dec(rcItem.top, b);
  161.                     IsPrev := TRUE;
  162.                 end;
  163.                 OldBrush := SelectObject(hDC, WhiteBrush);
  164.                 PatBlt(hDC, rcItem.left, rcItem.top, 2, rcItem.bottom- rcItem.top, PatCopy);
  165.                 SelectObject(hDC, GrayBrush);
  166.                 PatBlt(hDC, rcItem.right-2, rcItem.top, 2, rcItem.bottom- rcItem.top, PatCopy);
  167.                 if (Pos = 0) or IsPrev then
  168.                 begin
  169.                     SelectObject(hDC, WhiteBrush);
  170.                     PatBlt(hDC, rcItem.left+2, rcItem.top, rcItem.right- rcItem.left-2, 1, PatCopy);
  171.                     PatBlt(hDC, rcItem.left+2, rcItem.top+1, rcItem.right- rcItem.left-3, 1, PatCopy);
  172.                     Inc(rcItem.top, 2);
  173.                 end;
  174.                 if (Pos = Count) or IsNext then
  175.                 begin
  176.                     SelectObject(hDC, GrayBrush);
  177.                     PatBlt(hDC, rcItem.left+1, rcItem.bottom-1, rcItem.right- rcItem.left-2, 1, PatCopy);
  178.                     PatBlt(hDC, rcItem.left+2, rcItem.bottom-2, rcItem.right- rcItem.left-4, 1, PatCopy);
  179.                     Dec(rcItem.bottom, 2);
  180.                 end;
  181.                 InflateRect(rcItem, -2, 0);
  182.                 if itemState and ODS_SELECTED <> 0 then
  183.                 begin
  184.                     if IsNext then
  185.                     begin
  186.                         Dec(rcItem.bottom, a);
  187.                         if itemState and ODS_SELECTED <> 0 then
  188.                         begin
  189.                             SelectObject(hDC, GetStockObject(LtGray_Brush));
  190.                             PatBlt(hDC, rcItem.left, rcItem.bottom, rcItem.right- rcItem.left, a, PatCopy);
  191.                         end;
  192.                     end;
  193.                     if IsPrev then
  194.                     begin
  195.                         Inc(rcItem.top, b);
  196.                         if itemState and ODS_SELECTED <> 0 then
  197.                         begin
  198.                             SelectObject(hDC, GetStockObject(LtGray_Brush));
  199.                             PatBlt(hDC, rcItem.left, rcItem.top -3, rcItem.right- rcItem.left, b, PatCopy);
  200.                         end;
  201.                     end;
  202.                 end;
  203.                 FillRect(hDC, rcItem, Brush);
  204.                 SelectObject(hDC, OldBrush);
  205.                 if itemState and ODS_CHECKED <> 0 then
  206.                 begin
  207.                     Pen := CreatePen(PS_SOLID, 1, TextColor);
  208.                     OldPen := SelectObject(hDC, Pen);
  209.                     c := rcItem.top + (((rcItem.bottom - rcItem.top) - 10) div 2);
  210.                     MoveTo(hDC, rcItem.Left + 3, c + 5);
  211.                     LineTo(hDC, rcItem.Left + 3, c + 10);
  212.                     MoveTo(hDC, rcItem.Left + 4, c + 4);
  213.                     LineTo(hDC, rcItem.Left + 4, c + 10);
  214.                     MoveTo(hDC, rcItem.Left + 5, c + 7);
  215.                     LineTo(hDC, rcItem.Left + 12, c + 0);
  216.                     MoveTo(hDC, rcItem.Left + 5, c + 8);
  217.                     LineTo(hDC, rcItem.Left + 13, c + 0);
  218.                     SelectObject(hDC, OldPen);
  219.                     DeleteObject(Pen);
  220.                 end;
  221.                 lstrcpy(MenuText, PChar(itemData));
  222.                 if Font <> 0 then
  223.                     OldFont := SelectObject(hDC, Font)
  224.                 else
  225.                     OldFont := SelectObject(hDC, GetSFXObject(SYSTEM_FINE_FONT));
  226.                 rcItem.left := 7 + 12;
  227.                 if (itemState and ODS_SELECTED = 0) then
  228.                 begin
  229.                     if IsNext then
  230.                         Dec(rcItem.bottom, a)
  231.                     else
  232.                     if IsPrev then
  233.                         Inc(rcItem.top, b);
  234.                 end;
  235.                 DrawText(hDC, MenuText, -1, rcItem, DT_SINGLELINE + DT_VCENTER + DT_EXPANDTABS);
  236.                 if (itemState and ODS_SELECTED <> 0) and not (Color = LTGRAY) then
  237.                 begin
  238.                     OffsetRect(rcItem, 1, 0);
  239.                     DrawText(hDC, MenuText, -1, rcItem, DT_SINGLELINE + DT_VCENTER + DT_EXPANDTABS);
  240.                 end;
  241.                 SelectObject(hDC, OldFont);
  242.                 DeleteObject(Brush);
  243.             end;
  244.         end;
  245. end;
  246.  
  247. { GetMenuItemPos -> returns the zero based position of a menu item }
  248.  
  249. function GetMenuItemPos(Menu: HMenu; ItemID: LongInt): Word;
  250. var
  251.     Count   : Integer;
  252.     Item    : LongInt;
  253. begin
  254.     (* To properly sort through a menu items, if a menu has more than one sub menu
  255.      * each sub menu must have different menu handle.
  256.      *)
  257.     Count := GetMenuItemCount(Menu);
  258.     if Count > -1 then
  259.     begin
  260.         if IsMenu(ItemID) then
  261.         repeat
  262.             Dec(Count);
  263.             Item := LongInt(GetSubMenu(Menu, Count));
  264.         until (Item = ItemID) or (Count = 0)
  265.         else
  266.         repeat
  267.             Dec(Count);
  268.             Item := GetMenuItemID(Menu, Count);
  269.         until (Item = ItemID) or (Count = 0);
  270.     end;
  271.     GetMenuItemPos := Count;
  272. end;
  273.  
  274. { GetMenuTextExtent -> imports the WIN31 GetTextExtentPoint function correctly }
  275.  
  276. function GetMenuTextExtent; external 'GDI' index 471;
  277.  
  278. { MeasureMenuItem -> sets the width and height of the ownerdraw menu items. Font can be zero }
  279.  
  280. procedure MeasureMenuItem (Wnd: HWnd; MIS: PMeasureItemStruct; Font: HFont);
  281. var
  282.     DC       : HDC;
  283.     MenuFont : HFont;
  284.     OldFont  : HFont;
  285.     Size     : TSize;
  286.     MenuText : array[0..144] of Char;
  287. begin
  288.     with    MIS^ do
  289.         case CtlType of
  290.             ODT_MENU:
  291.             begin
  292.                 DC := GetDC(Wnd);
  293.                 if Font = 0 then
  294.                     MenuFont := GetSFXObject(SYSTEM_FINE_FONT)
  295.                 else
  296.                     MenuFont := Font;
  297.                 OldFont := SelectObject(DC, MenuFont);
  298.                 lstrcpy(MenuText, PChar(itemData));
  299.                 GetMenuTextExtent(DC, MenuText, StripStrLen(MenuText), Size);
  300.                 ItemWidth := Size.cX + 20;
  301.                 ItemHeight := Size.cY + ((Size.cY div 5) * 2);
  302.                 SelectObject(DC, OldFont);
  303.                 ReleaseDC(Wnd, DC);
  304.             end;
  305.         end;
  306. end;
  307.  
  308. { ProcessSystemChar -> call from WM_MENUCHAR to process the system menu mnemonics }
  309.  
  310. function ProcessSystemChar (Key: Word): LongInt;
  311. begin
  312.     case Key of
  313.         82, 114 : ProcessSystemChar := MakeLong(0, 2);
  314.         77, 109 : ProcessSystemChar := MakeLong(1, 2);
  315.         83, 115 : ProcessSystemChar := MakeLong(2, 2);
  316.         78, 110 : ProcessSystemChar := MakeLong(3, 2);
  317.         88, 120 : ProcessSystemChar := MakeLong(4, 2);
  318.         67, 99  : ProcessSystemChar := MakeLong(6, 2);
  319.     else
  320.         ProcessSystemChar := 0;
  321.     end;
  322. end;
  323.  
  324. { Set3DSystemMenu-> sets up a basic 3D system menu, minus the 'Switch To' item. }
  325.  
  326. procedure Set3DSystemMenu (Wnd: HWnd; Name: PChar);
  327. const
  328.     TextStr : array[0..50] of Char = '';
  329. var
  330.     SysMenu : HMenu;
  331. begin
  332.     SysMenu := GetSystemMenu(Wnd, False);
  333.     RemoveMenu(SysMenu, 7, mf_ByPosition);
  334.     RemoveMenu(SysMenu, 7, mf_ByPosition);
  335.     ModifyMenu(SysMenu, 0, mf_ByPosition or mf_OwnerDraw, sc_Restore, '&Restore');
  336.     ModifyMenu(SysMenu, 1, mf_ByPosition or mf_OwnerDraw, sc_Move, '&Move');
  337.     ModifyMenu(SysMenu, 2, mf_ByPosition or mf_OwnerDraw, sc_Size, '&Size');
  338.     ModifyMenu(SysMenu, 3, mf_ByPosition or mf_OwnerDraw, sc_Minimize, 'Mi&nimize');
  339.     ModifyMenu(SysMenu, 4, mf_ByPosition or mf_OwnerDraw, sc_Maximize, 'Ma&ximize');
  340.     wvsprintf(TextStr, '&Close  %s      Alt+F4', Name);
  341.     ModifyMenu(SysMenu, 6, mf_ByPosition or mf_OwnerDraw, sc_Close, TextStr);
  342. end;
  343.  
  344. begin
  345. end.