Sunday, December 28, 2014

How to Display Menu Item Hints in Delphi Applications (Revisited)

Last week I decided I wanted the main menu hints and popup menu hints to display in a tooltip window just like the hints for all the other controls. I figured it shouldn't be that difficult, right. Microsoft does it all over the place so why shouldn't my applications.

Wow did I under estimate what it takes to pull this one off.

It turns out that menuitem hints by design are intended to display in the status bar. Who's bright idea was that? I don't know about you but when I mouseover stuff my eyes look where the mouse cursor is. I hardly ever look down at the status bar.

So, I turned to google and began my search for code. I figured that someone has already done this and I can just implement their solution. Almost but not quite.

Here are my requirements:
  1. Display all main menu hints in a tooltip
  2. Display all popup menu hints in a tooltip
  3. Display multi-line menu hints as multi-lines
I'd like to thank Zarko Gajic and mghie (from stackoverflow) for doing all the hard work and providing the code base that I tweaked in my final implementation.

How to Display Menu Item Hints in Delphi Applications - Zarko Gajic
Display a ToolTip hint on a disabled menu item of a popup menu - mghie

I have heavily commented the code below for a very specific reason. I wanted it to standout from all the other code in my application. Here is what the folded code looks like in my IDE

Yes those are real box drawing characters. I like the way the structured comments keeps all the code needed for the menuhints implementation in a nice, visual group.

Semper Fi,
Gunny Mike

Add to Uses
  Vcl.Menus
  Vcl.ExtCtrls

Interface Section
{┌────────────────────────────────────────────────────────────┐}
{│ MenuHints Type Declaration                                 │}
{├────────────────────────────────────────────────────────────┤}
{│ How to Display Menu Item Hints in Delphi Applications      │}
{│ http://delphi.about.com/od/vclusing/a/menuitemhints.htm    │}
{│ Zarko Gajic                                                │}
{├────────────────────────────────────────────────────────────┘}
{│} type
{│}   TMenuItemHint = class(THintWindow)
{│}     private
{│}       activeMenuItem : TMenuItem;
{│}       showTimer : TTimer;
{│}       hideTimer : TTimer;
{│}       procedure HideTime(Sender : TObject) ;
{│}       procedure ShowTime(Sender : TObject) ;
{│}     public
{│}       constructor Create(AOwner : TComponent) ; override;
{│}       destructor Destroy; override;
{│}       procedure DoActivateHint(menuItem : TMenuItem) ;
{│}    end;
{│} {  End TMenuItemHint }
{└─────────────────────────────────────────────────────────────}


TForm Private Declarations
    { Private declarations }
    {┌────────────────────────────────────────────────────────────┐}
    {│ MenuHints Form Private Declartions                         │}
    {├────────────────────────────────────────────────────────────┤}
    {│ Adapted from Zarko Gajic's article called                  │}
    {│ How to Display Menu Item Hints in Delphi Applications      │}
    {│ http://delphi.about.com/od/vclusing/a/menuitemhints.htm    │}
    {│                                                            │}
    {│ Further adapted by mghie's stackoverflow answer to         │}
    {│ Display a ToolTip hint on a disabled menu item of a        │}
    {│ popup menu                                                 │}
    {│ http://stackoverflow.com/questions/470696/#471065          │}
    {│                                                            │}
    {│ Important:                                                 │}
    {│ Add call to MenuHintOnCreate in the form OnCreate method   │}
    {│ Add call to MenuHintOnDestroy in the form OnDestroy method │}
    {├────────────────────────────────────────────────────────────┘}
    {│} miHint : TMenuItemHint;
    {│} fOldWndProc: TFarProc;
    {└─────────────────────────────────────────────────────────────}
    {┌────────────────────────────────────────────────────────────┐}
    {│ MenuHints Form Private Declartions Contiinued              │}
    {├────────────────────────────────────────────────────────────┘}
    {│} Procedure MenuHintOnCreate;
    {│} Procedure MenuHintOnDestroy;
    {│} procedure WMMenuSelect(var Msg: TWMMenuSelect); message WM_MENUSELECT;
    {│} procedure PopupListWndProc(var AMsg: TMessage);  public
    {└─────────────────────────────────────────────────────────────}


Form OnCreate / OnDestroy
procedure TfrmMain.FormCreate(Sender: TObject);
begin
  {┌────────────────────────────────────────────────────────────┐}
  {│ MenuHints:                                                 │}
  {├────────────────────────────────────────────────────────────┘}
  {│} MenuHintOnCreate;
  {└─────────────────────────────────────────────────────────────}
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  {┌────────────────────────────────────────────────────────────┐}
  {│ MenuHints:                                                 │}
  {├────────────────────────────────────────────────────────────┘}
  {│} MenuHintOnDestroy;
  {└─────────────────────────────────────────────────────────────}
end;


Implementation Section
{┌────────────────────────────────────────────────────────────┐}
{│ MenuHints Implementation                                   │}
{├────────────────────────────────────────────────────────────┤}
{│ Adapted from Zarko Gajic's article called                  │}
{│ How to Display Menu Item Hints in Delphi Applications      │}
{│ http://delphi.about.com/od/vclusing/a/menuitemhints.htm    │}
{│                                                            │}
{│ Further adapted by mghie's stackoverflow answer to         │}
{│ Display a ToolTip hint on a disabled menu item of a        │}
{│ popup menu                                                 │}
{│ http://stackoverflow.com/questions/470696/#471065          │}
{│                                                            │}
{│ Modified to accomodate multi line hints                    │}
{├────────────────────────────────────────────────────────────┤}
{│ Generic Section                                            │}
{├────────────────────────────────────────────────────────────┘}
{│} procedure TMenuItemHint.HideTime(Sender: TObject);
{│} begin
{│}    //hide (destroy) hint window
{│}    self.ReleaseHandle;
{│}    hideTimer.OnTimer := nil;
{│} end;
{├────────────────────────────────────────────────────────────┐}
{│ procedure: TMenuItemHint.ShowTime                          │}
{│ Modified:  12/27/2014                                      │}
{│ By:        Michael Riley                                   │}
{│ Reason:    Accomodate multi line hints                     │}
{│            Changed the position and size of the TRect      │}
{├────────────────────────────────────────────────────────────┘}
{│} procedure TMenuItemHint.ShowTime(Sender: TObject);
{│}
{│}   procedure Split(Delim: Char; Str: string; Lst: TStrings) ;
{│}   begin
{│}      Lst.Clear;
{│}      Lst.StrictDelimiter := True;
{│}      Lst.Delimiter     := Delim;
{│}      Lst.DelimitedText := Str;
{│}   end;
{│}
{│} var
{│}   r : TRect;
{│}   wdth : integer;
{│}   list : TStringList;
{│}   s,str  : string;
{│}   j,h,w : integer;
{│}
{│} begin
{│}   if activeMenuItem <> nil then
{│}   begin
{│}      str := activeMenuItem.Hint;
{│}      str := StringReplace(str,#13#10,'|',[rfReplaceAll]);
{│}      str := StringReplace(str,#13,'|',[rfReplaceAll]);
{│}      str := StringReplace(str,#10,'|',[rfReplaceAll]);
{│}      while AnsiPos('||',str) > 0 do
{│}      begin
{│}        str := StringReplace(str,'||','|',[]);
{│}      end;
{│}
{│}      list := TStringList.Create;
{│}      split('|',str,list);
{│}      s := '';
{│}      h := Canvas.TextHeight(str) * (list.Count);
{│}      w := 0;
{│}      for j := 0 to list.Count -1 do
{│}      begin
{│}        if j > 0 then s := s + #13#10;
{│}        s := s + list[j];
{│}        wdth := Canvas.TextWidth(list[j]);
{│}        if wdth > w then w := wdth;
{│}      end;
{│}      list.Free;
{│}
{│}     //position and resize
{│}     r.Left := Mouse.CursorPos.X;
{│}     r.Top := Mouse.CursorPos.Y + 20;
{│}     r.Right := r.Left + w + 8;
{│}     r.Bottom := r.Top + h + 2;//6;
{│}     ActivateHint(r,s);
{│}   end;
{│}
{│}   showTimer.OnTimer := nil;
{│} end; (*ShowTime*)
{├─────────────────────────────────────────────────────────────}
{│} constructor TMenuItemHint.Create(AOwner: TComponent);
{│} begin
{│}   inherited;
{│}   showTimer := TTimer.Create(self) ;
{│}   showTimer.Interval := Application.HintPause;
{│}
{│}   hideTimer := TTimer.Create(self) ;
{│}   hideTimer.Interval := Application.HintHidePause;
{│} end;
{├─────────────────────────────────────────────────────────────}
{│} destructor TMenuItemHint.Destroy;
{│} begin
{│}   hideTimer.OnTimer := nil;
{│}   showTimer.OnTimer := nil;
{│}   self.ReleaseHandle;
{│}   inherited;
{│} end;
{├─────────────────────────────────────────────────────────────}
{│} procedure TMenuItemHint.DoActivateHint(menuItem: TMenuItem);
{│} begin
{│}   //force remove of the "old" hint window
{│}   hideTime(self) ;
{│}
{│}   if (menuItem = nil) or (menuItem.Hint = '') then
{│}   begin
{│}     activeMenuItem := nil;
{│}     Exit;
{│}   end;
{│}
{│}   activeMenuItem := menuItem;
{│}
{│}   showTimer.OnTimer := ShowTime;
{│}   hideTimer.OnTimer := HideTime;
{│} end;
{├────────────────────────────────────────────────────────────┐}
{│ Form Specific Section                                      │}
{├────────────────────────────────────────────────────────────┘}
{│} procedure TfrmMain.MenuHintOnCreate;
{│} var
{│}   NewWndProc: TFarProc;
{│} begin
{│}   miHint := TMenuItemHint.Create(self);
{│}   NewWndProc := MakeObjectInstance(PopupListWndProc);
{│}   fOldWndProc := TFarProc(SetWindowLong(VCL.Menus.PopupList.Window, GWL_WNDPROC, integer(NewWndProc)));
{│} end;
{├─────────────────────────────────────────────────────────────}
{│} procedure TfrmMain.MenuHintOnDestroy;
{│} var
{│}   NewWndProc: TFarProc;
{│} begin
{│}   NewWndProc := TFarProc(SetWindowLong(VCL.Menus.PopupList.Window, GWL_WNDPROC, integer(fOldWndProc)));
{│}   FreeObjectInstance(NewWndProc);
{│} end;
{├─────────────────────────────────────────────────────────────}
{│} procedure TfrmMain.WMMenuSelect(var Msg: TWMMenuSelect);
{│} var
{│}   menuItem : TMenuItem;
{│}   hSubMenu : HMENU;
{│} begin
{│}   inherited; // from TCustomForm
{│}
{│}   menuItem := nil;
{│}   if (Msg.MenuFlag <> $FFFF) or (Msg.IDItem <> 0) then
{│}   begin
{│}     if Msg.MenuFlag and MF_POPUP = MF_POPUP then
{│}     begin
{│}       hSubMenu := GetSubMenu(Msg.Menu, Msg.IDItem);
{│}       menuItem := Self.Menu.FindItem(hSubMenu, fkHandle);
{│}     end
{│}     else
{│}     begin
{│}       menuItem := Self.Menu.FindItem(Msg.IDItem, fkCommand);
{│}     end;
{│}   end;
{│}
{│}   miHint.DoActivateHint(menuItem);
{│} end; (*WMMenuSelect*)
{├─────────────────────────────────────────────────────────────}
{│} procedure TfrmMain.PopupListWndProc(var AMsg: TMessage);
{│}
{│}   function FindItemForCommand(APopupMenu: TPopupMenu; const AMenuMsg: TWMMenuSelect): TMenuItem;
{│}   var
{│}     SubMenu: HMENU;
{│}   begin
{│}     Assert(APopupMenu <> nil);
{│}     // menuitem
{│}     Result := APopupMenu.FindItem(AMenuMsg.IDItem, fkCommand);
{│}     if Result = nil then begin
{│}       // submenu
{│}       SubMenu := GetSubMenu(AMenuMsg.Menu, AMenuMsg.IDItem);
{│}       if SubMenu <> 0 then
{│}         Result := APopupMenu.FindItem(SubMenu, fkHandle);
{│}     end;
{│}   end;
{│}
{│} var
{│}   Msg: TWMMenuSelect;
{│}   menuItem: TMenuItem;
{│}   MenuIndex: integer;
{│}
{│} begin
{│}   AMsg.Result := CallWindowProc(fOldWndProc, VCL.Menus.PopupList.Window, AMsg.Msg, AMsg.WParam, AMsg.LParam);
{│}   if AMsg.Msg = WM_MENUSELECT then begin
{│}     menuItem := nil;
{│}     Msg := TWMMenuSelect(AMsg);
{│}     if (Msg.MenuFlag <> $FFFF) or (Msg.IDItem <> 0) then begin
{│}       for MenuIndex := 0 to PopupList.Count - 1 do begin
{│}         menuItem := FindItemForCommand(PopupList.Items[MenuIndex], Msg);
{│}         if menuItem <> nil then
{│}           break;
{│}       end;
{│}     end;
{│}     miHint.DoActivateHint(menuItem);
{│}   end;
{│} end;
{└─────────────────────────────────────────────────────────────}
end.

Sunday, December 14, 2014

Software Built With Delphi Celebrates 20 Years

I am pleased to announce the release of Credit Card Math 2014, a program written with Delphi XE4.

When I started this project I had just upgraded to Delphi 2010. If you go back and read my first blog post I mentioned one of the reasons for upgrading to Delphi 2010 was "I need to bring my products up to date (no more 640 X 480 windows) etc." 

It's hard to believe that it's been five years since I first mentioned I needed to upgrade my software. Over the past five years I've learned a lot. I've made a shit-load of mistakes. I've developed new coding habits. I've discovered new components. And most importantly I made a bunch of new friends in the Delphi community.

I still have two other software products that need to be updated. I do not believe it will take me five years to upgrade each of them.

I would like to thank the following people, who's software components helped me with my project:

Ray Konopka, Raize Components
Tim Young, ElevateDB 
Boian Mitov, Basic Video 
Nard Mosely, ReportBuilder
Jordan Russell, Inno Setup

Here are some screen shots of Credit Card Math from 1994 - 2014

Credit Card Math 2014: Delphi XE4
Credit Card Math 2004: Delphi 5
Credit Card Math 1998: Delphi 3
Credit Card Math 1994: Turbo Pascal 5.5
Credit Card Math 1994: Turbo Pascal 5.5

Semper Fi,
Gunny Mike



end.