home *** CD-ROM | disk | FTP | other *** search
- unit UnitFrmDummyUnicodePopup;
- {
- Purpose:
- Wrap all the logic needed to to create a low level API popup
- menu that has Unicode text and gather the data needed
- to show a Unicode Tooltip hint (see FrmDummyUnicodeTooltip
-
- Updates:
-
- Code completely re-written and simplified - FrmMainPopup's popup
- menu it traversed and duplicated instead of creating is from scratch
-
- -------------
-
- Show tooltip for "All Items..." hover
- ------------------------
- "All Items..." support
- ------------------------
-
- "Number of characters to show for each item" required a restart to
- work with the unicode popup
-
- ----------------------
- Let Permanent Items grow as large as they want
- "Beep" on accelerator key
-
- }
-
- interface
-
- uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, ExtCtrls, StrUtils, INIFIles, Math, Menus,
-
- UnitClipQueue, UnitFrmMainPopup, UnitTWideChar, UnitMisc,
- UnitOtherQueue, UnitKeyboardQuery, UnitFrmDummyUnicodeTooltip, Contnrs,
- StdCtrls;
-
- type
- TFrmDummyUnicodePopup = class(TForm)
- tim: TTimer;
- Label1: TLabel;
- procedure timTimer(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- private
- { Private declarations }
- LastCursorPos : TPoint;
- LastHint : string;
- LastClipItem : TClipItem;
- CurrentClipboard : TClipItem;
- KeyToItemID : THashedStringList;
- VisibleCharCount : integer;
- Tooltip : TTooltipWindow;
- TimeFiring : boolean;
-
- SubMenuItemList : THashedStringList;
- SubObjectList : TObjectList;
- mi : TMenuITem;
-
- function ItemIDToMenuItem(itemID : integer) : TMenuItem;
- public
- { Public declarations }
-
- procedure PopulatePopupUnicode(var M : TMenuItem; parent : HMENU);
- procedure ShowPopup(x,y : integer; inpopup : TPopupMenu);
-
- procedure WMDrawItem(var Msg: TWMDrawItem); message WM_DRAWITEM;
- procedure WMMeasureItem(var Msg: TWMMeasureItem); message WM_MEASUREITEM;
- procedure WMCommand(var Msg : TWMCommand); message WM_COMMAND;
- procedure WMMenuChar(var Msg : TWMMenuChar); message WM_MENUCHAR;
- procedure WMMenuSelect(var Msg : TWMMenuSelect); message WM_MENUSELECT;
- procedure WMEnterIdle(var Msg : TWMEnterIdle); message WM_ENTERIDLE;
- end;
-
- var
- FrmDummyUnicodePopup: TFrmDummyUnicodePopup;
- {////////////////////}
- {//}implementation{//}
- {////////////////////}
- {$R *.dfm}
-
-
- uses UnitFrmPermanentNew, UnitFrmConfig, UnitFrmSysTrayMenu, UnitPaste;
- const PU_LAST_TEXT = 'Las&t: ';
- PU_CURRENT_TEXT = 'Cu&rrent: ';
-
-
- procedure TFrmDummyUnicodePopup.FormCreate(Sender: TObject);
- begin
- KeyToItemID := THashedStringList.Create;
- CurrentClipboard := TClipItem.Create;
- LastClipItem := TClipItem.Create;
- //Popup := TPopupMenu.Create(self);
- Tooltip := TTooltipWindow.Create;
-
-
- self.SubMenuItemList := THashedStringList.Create;
- SubObjectList := TObjectList.Create;
- SubObjectList.OwnsObjects := false;
-
- mi := TMenuItem.Create(self);
- end;
-
- procedure TFrmDummyUnicodePopup.FormDestroy(Sender: TObject);
- begin
-
- SubMenuItemList.Free;
- SubObjectList.Free;
-
- mi.Free;
- end;
-
-
- procedure TFrmDummyUnicodePopup.ShowPopup(x, y: integer; inpopup: TPopupMenu);
- var p : HMENU;
- m : TMenuItem;
- begin
- Windows.SetLastError(ERROR_SUCCESS);
- self.VisibleCharCount := FrmConfig.udCharacters.Position;
-
-
- // add new items
- p := Windows.CreatePopupMenu;
- m := inpopup.items;
- self.PopulatePopupUnicode(m, p);
- self.CurrentClipboard.GetClipboardItem(0);
-
- // show it
- Windows.TrackPopupMenu(p,
- TPM_LEFTBUTTON or TPM_RIGHTBUTTON or TPM_LEFTALIGN,
- x, y, 0,
- self.Handle, nil);
-
- Windows.DrawMenuBar(p);
- // clean up
- while Windows.GetMenuItemCount(p) > 0 do begin
- Windows.DeleteMenu(p,0, MF_BYPOSITION);
- end;
-
- end;
-
- // Call Order
- //--------------
- // Populate -> Measure Item -> Draw Item
- // Some user event trigers
- // (MenuSelect, EnterIdle, Command)
-
- procedure TFrmDummyUnicodePopup.PopulatePopupUnicode(var M : TMenuItem; parent : HMENU);
- procedure TraverseMenuItems(var m : TMenuItem; parent : HMENU; level : integer = 0) ;
- var i : integer;
- menu : HMENU;
- m2 : TMenuItem;
- s : string;
- begin
- if (m.count = 0) then begin
- if (m.IsLine) then begin
- Windows.AppendMenu(parent, MF_SEPARATOR, 0, nil);
- end else begin
- i := SubObjectList.Add(m);
- if (m.Checked) then begin
- case m.Tag of
- Integer(PASTE_CTRL_V): s := '&1 CTRL+V';
- Integer(PASTE_SHIFT_INS): s := '&2 SHIFT+INS';
- Integer(PASTE_MIMIC): s := '&3 Mimic Typing';
- Integer(PASTE_CLIPBOARD): s := '&4 Clipboard Only';
- Integer(PASTE_DEFAULT): s := '&5 Default';
- end;
-
- Windows.AppendMenu(parent,
- MF_ENABLED or MF_BYCOMMAND or MF_CHECKED,
- i, PChar(s));
- end else begin
- Windows.AppendMenu(parent, MF_OWNERDRAW, i, nil);
- end;
- end;
- end else begin
- if (level <> 0) then begin
- menu := Windows.CreatePopupMenu;
- end;
- for i := 0 to (m.Count - 1) do begin
- m2 := m.Items[i];
- if (level <> 0) then begin
- TraverseMenuItems(m2, menu, level + 1);
- end else begin
- TraverseMenuItems(m2, parent, level + 1);
- end;
- end;
- if (level <> 0) then begin
- i := SubObjectList.Add(m);
- SubMenuItemList.Values[IntToStr(menu)] := IntToStr(i);
- Windows.AppendMenu(parent, MF_OWNERDRAW or MF_POPUP, menu, nil);
- end;
- end;
- end;
- begin
- SubObjectList.Clear;
- SubMenuItemList.clear;
- TraverseMenuItems(m, parent, 0);
- end;
-
-
- {
- //
- // These 2 messages are just do draw the damn popu
- //
- }
-
- procedure TFrmDummyUnicodePopup.WMMeasureItem(var Msg: TWMMeasureItem);
- var id : Cardinal;
- s : string;
- sz : TSize;
- procedure GetTextSizeOf( s : string );
- begin
- Windows.GetTextExtentPoint32(self.Canvas.Handle, PChar(s),
- min(length(s), VisibleCharCount),
- sz);
- msg.MeasureItemStruct^.itemWidth := max(sz.cx + loword(GetMenuCheckMarkDimensions),20);
- msg.MeasureItemStruct^.itemHeight := max(sz.cy+2, 6);
- end;
- procedure GetTextSizeOfNoLimit( s : string );
- begin
- Windows.GetTextExtentPoint32(self.Canvas.Handle, PChar(s),
- length(s),
- sz);
- msg.MeasureItemStruct^.itemWidth := max(sz.cx + loword(GetMenuCheckMarkDimensions),20);
- msg.MeasureItemStruct^.itemHeight := max(sz.cy+2, 6);
- end;
-
- var
- mi2 : TMenuItem;
- begin
- Windows.SetLastError(ERROR_SUCCESS);
- id := msg.MeasureItemStruct^.itemID;
-
- //
- // Basically, use the longest text item to gauge the width of the popup
- // At a minimum the height is the 2 pixels above the size of an icon
- //
- mi2 := self.ItemIDToMenuItem(id);
- if mi2 <> nil then begin
- s := mi2.Caption;
- end;
-
- if (s <> '') then begin
- GetTextSizeOf(s);
- end else begin
- s := self.CurrentClipboard.GetAsText;
- if length(s) < length(FrmMainPopup.GetLastStringSelected) then begin
- GetTextSizeOf(PU_LAST_TEXT + FrmMainPopup.GetTrimmedItem(FrmMainPopup.GetLastStringSelected));
- end else begin
- GetTextSizeOf(PU_LAST_TEXT + FrmMainPopup.GetTrimmedItem(s));
- end;
- end;
-
- //TODO: Unsure how to handle this, swapping Perm Items back and
- // forth will be way to costly
-
- msg.MeasureItemStruct^.itemWidth := max(msg.MeasureItemStruct^.itemWidth + 8, 100);
- end;
-
- procedure TFrmDummyUnicodePopup.WMDrawItem(var Msg: TWMDrawItem);
- var
- i : cardinal;
- ci : TClipItem;
- tc, bc : cardinal;
- dc : integer;
- CONST ICON_SPACER = 20;
- //
- // Since it's owner drawns, I have to know what &x character related
- // to what ItemID
- //
- procedure UpdateAccessKeys(s : string);
- var amp : integer;
- begin
- amp := pos('&', s);
- if (amp <> 0) then begin
- inc(amp);
- KeyToItemID.Values[lowercase(s[amp])] := IntToStr(msg.DrawItemStruct^.itemID);
- end;
- end;
- procedure DrawTextAndBitmap(bm : TBitmap; s : string);
- var ico : TIcon;
- il : TImageList;
- r : TRect;
- begin
- with msg.DrawItemStruct^ do begin
- UpdateAccessKeys(s);
-
- r.Top := rcItem.Top;
- r.Bottom := rcItem.Bottom;
- r.Left := rcItem.Left + ICON_SPACER;
- r.Right := rcItem.Right;
-
- DrawText(hdc, PChar(s), length(s),
- r, DT_VCENTER);
-
- if (bm <> nil) and ((bm.Width and bm.Height) <> 0) then begin
- ico := TIcon.Create;
- il := TImageList.CreateSize(bm.Width, bm.Height);
- il.AddMasked(bm, bm.TransparentColor);
- il.GetIcon(0, ico);
- il.Free;
- if (ico.Handle <> 0) then begin
- DrawIconEx(hdc,
- rcItem.left,
- rcItem.top,
- ico.Handle,
- 16,16, 0, 0, DI_NORMAL);
- end;
- ico.Free;
- end;
- end;
- end;
- procedure DrawTextAndImage(ti : TImage; s : string);
- begin
- if ti = nil then begin
- DrawTextAndBitmap(nil, s);
- end else begin
- DrawTextAndBitmap(ti.Picture.Bitmap, s);
- end;
- end;
-
- procedure DrawUnicodeAndIcon(h : HICON; ci : TClipItem; prefix : string);
- var wc : TWideChar;
- r : TRect;
- sz : TSize;
- begin
- UpdateAccessKeys(prefix);
-
- wc := TWideChar.Create;
- wc.Append(prefix);
- wc.Append(ci.GetHandle, ci.GetDataSize);
- wc.Replace(WideChar($9), WideChar($3)); // replace these whitespace
- wc.Replace(WideChar(#13),WideChar($3)); // characters with "squares"
- wc.Replace(WideChar(#10),WideChar($3)); //
-
- if (ci.GetDataSize / 2) > VisibleCharCount then begin
- wc.LeftStr(self.VisibleCharCount);
- wc.Append('...');
- end;
-
- Windows.GetTextExtentPoint32W(self.Canvas.Handle, wc.Memory,
- wc.StrLength,sz);
-
-
- with msg.DrawItemStruct^ do begin
- r.Top := rcItem.Top;
- r.Bottom := r.top + sz.cy;
- r.Left := rcItem.Left + ICON_SPACER;
- r.Right := rcItem.Right;
- // trim the rectangle so the next line of text won't be
- // partially visible
-
- DrawTextW(hdc, PWideChar(wc.Memory), wc.strlength - 1,
- r, DT_VCENTER );
- MyFree(wc);
-
- if (h <> 0) then begin
- DrawIconEx(hdc,
- rcItem.left, rcItem.top,
- h,
- 16,16, 0, 0, DI_NORMAL);
- end;
- end;
- end;
-
- procedure DrawTextAndIcon(h : HICON; s : string); overload;
- var r : TRect;
- begin
- UpdateAccessKeys(s);
-
- with msg.DrawItemStruct^ do begin
- r.Top := rcItem.Top;
- r.Bottom := rcItem.Bottom;
- r.Left := rcItem.Left + ICON_SPACER;
- r.Right := rcItem.Right;
-
- DrawText(hdc, PChar(s), length(s),
- r, DT_VCENTER);
-
- if (h <> 0) then begin
- DrawIconEx(hdc,
- rcItem.left, rcItem.top,
- h, 16,16,
- 0, 0, DI_NORMAL);
- end;
- end;
- end;
-
- procedure DrawTextAndIcon(ci : TClipItem); overload;
- begin
- if (ci.GetFormat = CF_UNICODETEXT) then begin
- DrawUnicodeAndIcon(ci.CData.GetHICON, ci, '');
- end else begin
- DrawTextAndIcon(ci.CData.GetHICON, FrmMainPopup.GetTrimmedItem(ci.getastext));
- end;
- end;
-
-
- var HB : HBRUSH;
- prefix : string;
- mi : TMenuItem;
- ni, ni2 : TNotifyEvent;
- h : HGDIOBJ;
- oldf, f : HFONT;
- name : string;
- begin
- Windows.SetLastError(ERROR_SUCCESS);
- with msg.DrawItemStruct^ do begin
- dc := Windows.SaveDC(hDC);
- if (dc = 0) then begin
- UnitMisc.AppendLog('WMDrawItem: SaveDC failed - ', true);
- EXIT;
- end;
- //
- // Fill the entire background with a hilight or no higlight
- //
-
-
-
- name := self.Font.Name;
-
-
- f :=Createfont(
- self.Font.Height,0,0,0,0,0,0,0,Ansi_Charset,Out_Default_Precis,
- clip_Default_Precis,Draft_Quality,variable_Pitch OR ff_swiss,
- pchar(name)
- );
-
- oldf := Windows.SelectObject(hdc, f);
-
-
- if (itemState and ODS_SELECTED) = 0 then begin
- tc := Windows.SetTextColor(hDC, ColorToRGB(clMenuText));
- bc := Windows.SetBkColor(hDC, ColorToRGB(clMenu));
- hb := Windows.CreateSolidBrush(ColorToRGB(clMenu));
- end else begin
- tc := Windows.SetTextColor(hdc, ColorToRGB(clHighLightText));
- bc := Windows.SetBkColor(hdc, ColorToRGB(clHighLight));
- hb := Windows.CreateSolidBrush(ColorToRGB(clHighLight));
- end;
- if (hb <> 0) then begin
- Windows.FillRect(hdc, rcItem, hb);
- Windows.DeleteObject(hb);
- end;
-
- try
- mi := self.ItemIDToMenuItem(itemID);
- if (mi <> nil) then begin
- ni := mi.OnClick;
- ni2 := FrmMainPopup.MenuItemClickEvent;;
- if (@ni = @ni2) then begin
- i := ClipQueue.IndexOf(mi.hint);
- ci := ClipQueue.GetClipItem(i);
-
- if (FrmConfig.cbUseKeyboard.Checked) then begin
- prefix := '&' + FrmMainPopup.GetAccelerator(i) + ': ';
- end;
- if (FrmConfig.cbShowTypes.Checked) then begin
- prefix := prefix + UnitMisc.GetCliptypeSymbol(ci.GetFormat) + ' ';
- end;
- if (ci.GetFormat = Windows.CF_UNICODETEXT) then begin
- DrawUnicodeAndIcon(ci.CData.GetHICON, ci, Prefix)
- end else begin
- DrawTextAndIcon(ci.CData.GetHICON,prefix +
- FrmMainPopup.GetTrimmedItem(ci.GetAsText));
- end;
- end else begin
- ni2 := FrmMainPopup.CurrentMenuItemClickEvent;
- if (@ni = @ni2) then begin
- if (self.CurrentClipboard.GetFormat = CF_UNICODETEXT) then begin
- DrawUnicodeAndIcon(0, self.CurrentClipboard, PU_CURRENT_TEXT);
- end else begin
- DrawTextAndImage(nil, PU_CURRENT_TEXT + LeftStr(self.CurrentClipboard.GetAsText, VisibleCharCount));
- end;
- end else begin
- DrawTextAndBitmap(mi.Bitmap, mi.caption);
- end;
-
- end;
-
- end;
- finally
- h := SelectObject(hdc, oldf);
- DeleteObject(h);
-
- Windows.SetTextColor(hdc, tc);
- Windows.SetBkColor(hdc, bc);
- Windows.RestoreDC(hdc, dc);
-
-
- end;
- end;
- end;
-
-
-
- //
- // And Item was selected by keystroke, or by click
- //
- procedure TFrmDummyUnicodePopup.WMMenuChar(var Msg: TWMMenuChar);
- var m : TWMCommand;
- s : string;
-
- begin
- if (msg.MenuFlag and MF_POPUP) <> 0 then begin
- //
- // Wait until user releases keystrok
- // Translate key to ItemID
- // pass information WMCommand - as if it was clicked by a mouse
- //
- while KeyboardQuery.IsPressed(VkKeyScan(msg.user)) do begin
- Application.ProcessMessages;
- end;
- msg.Result := MakeLong(0, MNC_CLOSE);
-
- s := KeyToItemID.Values[lowercase(msg.User)];
-
- if (s <> '') then begin
- //
- // trigger the correct WMCommand event
- //
- Application.ProcessMessages;
- m.NotifyCode := 0;
- m.ItemID := StrToInt(s);
- m.Ctl := 0;
- self.WMCommand(m);
- end;
- end else begin
- inherited;
- end;
- end;
-
- procedure TFrmDummyUnicodePopup.WMCommand(var Msg: TWMCommand);
- var
- itemID : integer;
- mi2 : TMenuItem;
- ni, ni2, ni3, ni4, ni5, ni6, ni7 : TNotifyEvent;
- begin
- // Given an ItemID - carry out the selected action
-
- if (msg.NotifyCode = 0) then begin
- itemID := msg.ItemID;
- mi2 := self.ItemIDToMenuItem(itemID);
- if (mi2 <> nil) then begin
-
- // Some items expect the menu item passed back
- // Other items need this form's handle to set focus correctly
-
- ni := mi2.OnClick;
- ni2 := FrmMainPopup.MenuItemClickEvent;
- ni3 := FrmMainPopup.OtherItemClickEvent;
- ni4 := FrmMainPopup.PermanentMenuItemClickEvent;
- ni5 := FrmMainPopup.PermanentGroupItemClickEvent;
- ni6 := frmSysTrayMenu.SwitchPermFolder;
- ni7 := frmSysTrayMenu.MethodMenuItemClickEvent;
- if (@ni = @ni2) or (@ni = @ni3) or
- (@ni = @ni4) or (@ni = @ni5) or
- (@ni = @ni6) or (@ni = @ni7) then begin
- Mi2.OnClick(mi2);
- end else begin
- Mi2.OnClick(self);
- end;
- end;
- end else begin
- {dunno if this is needed}
- inherited;
- end;
- end;
-
-
-
-
- {
- //
- // These 3 messages control the menu popup
- // Item is selected, Idle state occurs, then the time will fire the
- // showtooltip event
- }
-
- procedure TFrmDummyUnicodePopup.WMEnterIdle(var Msg: TWMEnterIdle);
- begin
- // use this position to show the tooltip
- tim.Interval := Application.HintPause;
- tim.Enabled := true;
- Windows.GetCursorPos(LastCursorPos);
- end;
-
- procedure TFrmDummyUnicodePopup.timTimer(Sender: TObject);
- var ci : TClipItem;
- begin
- self.TimeFiring := true;
-
- tim.Enabled := false;
-
- if (self.LastClipItem = nil) and (self.LastHint = '') then begin
- EXIT;
- end;
-
- inc(self.LastCursorPos.X, 20);
- inc(self.LastCursorPos.Y, 10);
-
- UnitMisc.AppendLog('Showing Tooltip hint');
- if (self.LastClipItem <> nil) then begin
- Tooltip.ShowTooltip(self.LastClipITem, self.LastCursorPos);
- //FrmDummyUnicodeTooltip.ShowTooltip(self.LastClipITem, self.LastCursorPos);
- end else begin
- if (FrmPermanent.IsComplexItem(self.LastHint)) then begin
- ci := FrmPermanent.GetComplexItem(self.LastHint);
- if (ci.GetFormat = Windows.CF_UNICODETEXT) then begin
- Tooltip.ShowTooltip(ci, self.LastCursorPos);
- end else begin
- Tooltip.ShowTooltip('[Clip format: ' + ci.GetFormatName + ']',
- self.LastCursorPos);
- end;
- MyFree(ci);
- end else begin
- Tooltip.ShowTooltip(self.LastHint, self.LastCursorPos);
- end;
-
- end;
-
- self.LastHint := '';
- self.TimeFiring := false;
- end;
-
-
- procedure TFrmDummyUnicodePopup.WMMenuSelect(var Msg: TWMMenuSelect);
- var id : word;
- i : integer;
- ni, ni2 : TNotifyEvent;
- mi : TMenuItem;
- begin
- tim.Enabled := false;
- ToolTip.CloseTooltip;
-
-
- //
- // Here, we assign either set "Hint" to display as a tooltip as plain
- // text, or we use the complex item (unicode) if available
- //
-
- self.LastHint := '';
- self.LastClipITem := nil;
- id := TWMMENUSELECT(msg).IDItem;
-
-
- //
- // ignore Menu items with submenus - they don't have popups
- //
- if ((TWMMENUSELECT(msg).MenuFlag and MF_POPUP) <> 0) then begin
- EXIT;
- end;
-
- mi := self.ItemIDToMenuItem(id);
- if (mi <> nil) then begin
-
- // use the click event address to determin the type of menu item
- // that's hilighted
-
- ni := mi.OnClick;
- ni2 := FrmMainPopup.MenuItemClickEvent;
- if (@ni = @ni2) then begin
- i := ClipQueue.IndexOf(mi.hint);
- self.LastClipItem := ClipQueue.GetClipItem(i)
- end;
-
- ni2 := FrmMainPopup.LastMenuItemClickEvent;
- if (@ni = @ni2) then begin
- self.LastHint := FrmMainPopup.GetLastStringSelected;
- end;
-
- ni2 := FrmMainPopup.CurrentMenuItemClickEvent;
- if (@ni = @ni2) then begin
- self.LastHint := self.CurrentClipboard.GetAsText;
- end;
-
- ni2 := FrmMainPopup.PermanentMenuItemClickEvent;
- if (@ni = @ni2) then begin
- // Caption contains name
- // hint contains plain text value
- // tag containg the group ID or -1 for current group
-
- self.LastHint := mi.Hint;
- if (mi.Tag <> - 1) then begin
- FrmPermanent.PermFolderPush;
- FrmPermanent.SetPermanentPath(FrmPermanent.PermFoldersGetItem(mi.tag));
- self.LastHint := FrmPermanent.GetTextFrom(mi.caption);
-
- FrmPermanent.PermFolderPop;
- end;
- end;
- end;
- end;
-
-
- function TFrmDummyUnicodePopup.ItemIDToMenuItem(
- itemID: integer): TMenuItem;
- var s : string;
- i : integer;
- begin
- result := nil;
-
- // either ItemID is a WM_COMMAND (an index to an object)
- // or it's an address of a menu item
- // - find the correct one and return it or NIL
-
- if itemID < SubObjectList.Count then begin
- result := TMenuItem(SubObjectList.Items[itemID]);
- end;
-
- if result = nil then begin
- s := SubMenuItemList.values[IntToStr(itemID)];
- if (s <> '') then begin
- i := StrToInt(s);
- if i < SubObjectList.Count then begin
- result := TMenuItem( SubObjectList.items[i] );
- end;
- end;
- end;
- end;
-
- end.
-