Index: TB2Common.pas =================================================================== RCS file: /data/cvs/tb2k/Source/TB2Common.pas,v retrieving revision 1.28 diff -u -r1.28 TB2Common.pas --- TB2Common.pas 26 Feb 2004 07:05:57 -0000 1.28 +++ TB2Common.pas 29 May 2004 22:19:14 -0000 @@ -868,40 +868,82 @@ procedure DrawRotatedText(const DC: HDC; AText: String; const ARect: TRect; const AFormat: Cardinal); { Like DrawText, but draws the text at a 270 degree angle. - The only format flag this function respects is DT_HIDEPREFIX. Text is always - drawn centered. } + The format flag this function respects are + DT_NOPREFIX, DT_HIDEPREFIX, DT_CENTER, DT_END_ELLIPSIS, DT_NOCLIP } var RotatedFont, SaveFont: HFONT; TextMetrics: TTextMetric; - X, Y, P, I, SU, FU: Integer; + X, Y, P, I, SU, FU, W: Integer; SaveAlign: UINT; SavePen, Pen: HPEN; + Clip: Boolean; + + function GetSize(DC: HDC; const S: string): Integer; + var + Size: TSize; + begin + GetTextExtentPoint32(DC, PChar(S), Length(S), Size); + Result := Size.cx; + end; + begin + if Length(AText) = 0 then Exit; + RotatedFont := CreateRotatedFont(DC); SaveFont := SelectObject(DC, RotatedFont); GetTextMetrics(DC, TextMetrics); X := ARect.Left + ((ARect.Right - ARect.Left) - TextMetrics.tmHeight) div 2; - Y := ARect.Top + ((ARect.Bottom - ARect.Top) - GetTextWidth(DC, AText, True)) div 2; + + Clip := (AFormat and DT_NOCLIP) <> DT_NOCLIP; { Find the index of the character that should be underlined. Delete '&' characters from the string. Like DrawText, only the last prefixed character will be underlined. } P := 0; I := 1; - while I <= Length(AText) do begin - if AText[I] in LeadBytes then - Inc(I) - else if AText[I] = '&' then begin - Delete(AText, I, 1); - { Note: PChar cast is so that if Delete deleted the last character in - the string, we don't step past the end of the string (which would cause - an AV if AText is now empty), but rather look at the null character - and treat it as an accelerator key like DrawText. } - if PChar(AText)[I-1] <> '&' then - P := I; + if (AFormat and DT_NOPREFIX) <> DT_NOPREFIX then + while I <= Length(AText) do begin + if AText[I] in LeadBytes then + Inc(I) + else if AText[I] = '&' then begin + Delete(AText, I, 1); + { Note: PChar cast is so that if Delete deleted the last character in + the string, we don't step past the end of the string (which would cause + an AV if AText is now empty), but rather look at the null character + and treat it as an accelerator key like DrawText. } + if PChar(AText)[I-1] <> '&' then + P := I; + end; + Inc(I); + end; + + if (AFormat and DT_END_ELLIPSIS) = DT_END_ELLIPSIS then + begin + if (Length(AText) > 1) and (GetSize(DC, AText) > ARect.Bottom - ARect.Top) then + begin + W := ARect.Bottom - ARect.Top; + if W > 2 then + begin + Delete(AText, Length(AText), 1); + while (Length(AText) > 1) and (GetSize(DC, AText + '...') > W) do + Delete(AText, Length(AText), 1); + end + else AText := AText[1]; + if P > Length(AText) then P := 0; + AText := AText + '...'; end; - Inc(I); + end; + + if (AFormat and DT_CENTER) = DT_CENTER then + Y := ARect.Top + ((ARect.Bottom - ARect.Top) - GetSize(DC, AText)) div 2 + else + Y := ARect.Top; + + if Clip then + begin + SaveDC(DC); + with ARect do IntersectClipRect(DC, Left, Top, Right, Bottom); end; SaveAlign := SetTextAlign(DC, TA_BOTTOM); @@ -920,6 +962,8 @@ DeleteObject(Pen); end; + if Clip then RestoreDC(DC, -1); + SelectObject(DC, SaveFont); DeleteObject(RotatedFont); end; Index: TB2Dock.pas =================================================================== RCS file: /data/cvs/tb2k/Source/TB2Dock.pas,v retrieving revision 1.88 diff -u -r1.88 TB2Dock.pas --- TB2Dock.pas 26 Feb 2004 07:05:57 -0000 1.88 +++ TB2Dock.pas 29 May 2004 22:19:14 -0000 @@ -82,9 +82,6 @@ FDisableArrangeToolbars: Integer; { Increment to disable ArrangeToolbars } FArrangeToolbarsNeeded: Boolean; FNonClientWidth, FNonClientHeight: Integer; - DockList: TList; { List of the toolbars docked, and those floating and have LastDock - pointing to the dock. Items are casted in TTBCustomDockableWindow's. } - DockVisibleList: TList; { Similar to DockList, but lists only docked and visible toolbars } { Property access methods } //function GetVersion: TToolbar97Version; @@ -102,14 +99,11 @@ { Internal } procedure BackgroundChanged(Sender: TObject); procedure ChangeDockList(const Insert: Boolean; const Bar: TTBCustomDockableWindow); - procedure ChangeWidthHeight(const NewWidth, NewHeight: Integer); procedure CommitPositions; procedure DrawNCArea(const DrawToDC: Boolean; const ADC: HDC; const Clip: HRGN); function GetDesignModeRowOf(const XY: Integer): Integer; - function HasVisibleToolbars: Boolean; procedure RelayMsgToFloatingBars(var Message: TMessage); - function ToolbarVisibleOnDock(const AToolbar: TTBCustomDockableWindow): Boolean; procedure ToolbarVisibilityChanged(const Bar: TTBCustomDockableWindow; const ForceRemove: Boolean); @@ -128,21 +122,30 @@ procedure WMPrintClient(var Message: TMessage); message WM_PRINTCLIENT; procedure WMSysCommand(var Message: TWMSysCommand); message WM_SYSCOMMAND; protected + DockList: TList; { List of the toolbars docked, and those floating and have LastDock + pointing to the dock. Items are casted in TTBCustomDockableWindow's. } + DockVisibleList: TList; { Similar to DockList, but lists only docked and visible toolbars } + function Accepts(ADockableWindow: TTBCustomDockableWindow): Boolean; virtual; procedure AlignControls(AControl: TControl; var Rect: TRect); override; + procedure ChangeWidthHeight(const NewWidth, NewHeight: Integer); procedure DrawBackground(DC: HDC; const DrawRect: TRect); virtual; function GetPalette: HPALETTE; override; + function HasVisibleToolbars: Boolean; procedure InvalidateBackgrounds; procedure Loaded; override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure SetParent(AParent: TWinControl); override; + function ToolbarVisibleOnDock(const AToolbar: TTBCustomDockableWindow): Boolean; procedure Paint; override; function UsingBackground: Boolean; virtual; + property ArrangeToolbarsNeeded: Boolean read FArrangeToolbarsNeeded write FArrangeToolbarsNeeded; + property DisableArrangeToolbars: Integer read FDisableArrangeToolbars write FDisableArrangeToolbars; public constructor Create(AOwner: TComponent); override; procedure CreateParams(var Params: TCreateParams); override; destructor Destroy; override; - procedure ArrangeToolbars; + procedure ArrangeToolbars; virtual; procedure BeginUpdate; procedure EndUpdate; function GetCurrentRowSize(const Row: Integer; var AFullSize: Boolean): Integer; @@ -266,6 +269,7 @@ private { Property variables } FAutoResize: Boolean; + FDblClickUndock: Boolean; FDockPos, FDockRow, FEffectiveDockPos, FEffectiveDockRow: Integer; FDocked: Boolean; FCurrentDock, FDefaultDock, FLastDock: TTBDock; @@ -427,6 +431,7 @@ { Methods accessible to descendants } procedure Arrange; function CalcNCSizes: TPoint; virtual; + function CanDockTo(ADock: TTBDock): Boolean; virtual; procedure ChangeSize(AWidth, AHeight: Integer); function ChildControlTransparent(Ctl: TControl): Boolean; dynamic; procedure Close; @@ -451,7 +456,10 @@ procedure ResizeTrack(var Rect: TRect; const OrigRect: TRect); dynamic; procedure ResizeTrackAccept; dynamic; procedure SizeChanging(const AWidth, AHeight: Integer); virtual; + property EffectiveDockPosAccess: Integer read FEffectiveDockPos write FEffectiveDockPos; + property EffectiveDockRowAccess: Integer read FEffectiveDockRow write FEffectiveDockRow; public + property DblClickUndock: Boolean read FDblClickUndock write FDblClickUndock default True; property Docked: Boolean read FDocked; property CurrentDock: TTBDock read FCurrentDock write SetCurrentDock stored False; property CurrentSize: Integer read FCurrentSize write FCurrentSize; @@ -1000,6 +1008,11 @@ end; end; +function TTBDock.Accepts(ADockableWindow: TTBCustomDockableWindow): Boolean; +begin + Result := AllowDrag; +end; + procedure TTBDock.AlignControls(AControl: TControl; var Rect: TRect); begin ArrangeToolbars; @@ -2494,6 +2507,7 @@ FActivateParent := True; FBorderStyle := bsSingle; FCloseButton := True; + FDblClickUndock := True; FDockableTo := [dpTop, dpBottom, dpLeft, dpRight]; FDockableWindowStyles := [tbdsResizeEightCorner, tbdsResizeClipCursor]; FDockPos := -1; @@ -2911,6 +2925,11 @@ RemoveFromList(FDockForms, Form); end; +function TTBCustomDockableWindow.CanDockTo(ADock: TTBDock): Boolean; +begin + Result := ADock.Position in DockableTo; +end; + function TTBCustomDockableWindow.IsAutoResized: Boolean; begin Result := AutoResize or Assigned(CurrentDock) or Floating; @@ -3879,11 +3898,6 @@ procedure BuildDockList; - function AcceptableDock(const D: TTBDock): Boolean; - begin - Result := D.FAllowDrag and (D.Position in DockableTo); - end; - procedure Recurse(const ParentCtl: TWinControl); var D: TTBDockPosition; @@ -3900,7 +3914,7 @@ if (Controls[I] is TWinControl) and not(Controls[I] is TTBDock) then Recurse(TWinControl(Controls[I])); end; - if (ParentCtl is TTBDock) and AcceptableDock(TTBDock(ParentCtl)) and + if (ParentCtl is TTBDock) and TTBDock(ParentCtl).Accepts(Self) and CanDockTo(TTBDock(ParentCtl)) and (DockList.IndexOf(ParentCtl) = -1) then DockList.Add(ParentCtl); end; @@ -3912,7 +3926,7 @@ begin { Manually add CurrentDock to the DockList first so that it gets priority over other docks } - if Assigned(CurrentDock) and AcceptableDock(CurrentDock) then + if Assigned(CurrentDock) and CurrentDock.Accepts(Self) and CanDockTo(CurrentDock) then DockList.Add(CurrentDock); ParentForm := TBGetToolWindowParentForm(Self); DockFormsList := TList.Create; @@ -4201,19 +4215,20 @@ procedure TTBCustomDockableWindow.DoubleClick; begin if Docked then begin - if DockMode = dmCanFloat then begin + if DblClickUndock and (DockMode = dmCanFloat) then begin Floating := True; MoveOnScreen(True); end; end - else - if Assigned(LastDock) then - Parent := LastDock - else - if Assigned(DefaultDock) then begin - FDockRow := ForceDockAtTopRow; - FDockPos := ForceDockAtLeftPos; - Parent := DefaultDock; + else if Floating then begin + if Assigned(LastDock) then + Parent := LastDock + else + if Assigned(DefaultDock) then begin + FDockRow := ForceDockAtTopRow; + FDockPos := ForceDockAtLeftPos; + Parent := DefaultDock; + end; end; end; Index: TB2DsgnItemEditor.pas =================================================================== RCS file: /data/cvs/tb2k/Source/TB2DsgnItemEditor.pas,v retrieving revision 1.52 diff -u -r1.52 TB2DsgnItemEditor.pas --- TB2DsgnItemEditor.pas 26 Feb 2004 07:05:57 -0000 1.52 +++ TB2DsgnItemEditor.pas 29 May 2004 22:19:14 -0000 @@ -152,6 +152,12 @@ procedure TBRegisterItemClass(AClass: TTBCustomItemClass; const ACaption: String; ResInstance: HINST); +type + TTBDsgnEditorHook = procedure(Sender: TTBItemEditForm) of object; + +procedure TBRegisterDsgnEditorHook(Hook: TTBDsgnEditorHook); +procedure TBUnregisterDsgnEditorHook(Hook: TTBDsgnEditorHook); + implementation {$R *.DFM} @@ -179,6 +185,7 @@ var ItemClasses: TList; ItemImageList: TImageList; + EditFormHooks: TList; {$IFNDEF JR_D6} function CreateSelectionList: TDesignerSelectionList; @@ -240,7 +247,18 @@ const ACaption: String; ResInstance: HINST); var Info: PItemClassInfo; + I: Integer; begin + if ItemClasses <> nil then + for I := ItemClasses.Count - 1 downto 0 do + begin + Info := ItemClasses[I]; + if Info.ItemClass = AClass then + begin + Dispose(Info); + ItemClasses.Delete(I); + end; + end; New(Info); Info.ItemClass := AClass; Info.Caption := ACaption; @@ -357,6 +375,11 @@ Item.OnClick := MoreItemClick; MoreMenu.Add(Item); end; + { Run the hooks } + + if EditFormHooks <> nil then + for I := 0 to EditFormHooks.Count - 1 do + TTBDsgnEditorHook(EditFormHooks[I]^)(Self); end; destructor TTBItemEditForm.Destroy; @@ -1332,14 +1355,44 @@ Result := '(TB2000 Items)'; end; + +procedure TBRegisterDsgnEditorHook(Hook: TTBDsgnEditorHook); +var + H: ^TTBDsgnEditorHook; +begin + New(H); + H^ := Hook; + EditFormHooks.Add(H); +end; + +procedure TBUnregisterDsgnEditorHook(Hook: TTBDsgnEditorHook); +var + H: ^TTBDsgnEditorHook; + I: Integer; +begin + for I := EditFormHooks.Count - 1 downto 0 do + begin + H := EditFormHooks[I]; + if (TMethod(H^).Code = TMethod(Hook).Code) and + (TMethod(H^).Data = TMethod(Hook).Data) then + begin + Dispose(H); + EditFormHooks.Delete(I); +// Break; + end; + end; +end; + initialization ItemImageList := TImageList.Create(nil); ItemImageList.Handle := ImageList_LoadImage(HInstance, 'TB2_DSGNEDITORIMAGES', 16, 0, clFuchsia, IMAGE_BITMAP, 0); ItemClasses := TList.Create; + EditFormHooks := TList.Create; AddModuleUnloadProc(UnregisterModuleItemClasses); finalization RemoveModuleUnloadProc(UnregisterModuleItemClasses); FreeItemClasses; FreeAndNil(ItemImageList); + FreeAndNil(EditFormHooks); end. Index: TB2ExtItems.pas =================================================================== RCS file: /data/cvs/tb2k/Source/TB2ExtItems.pas,v retrieving revision 1.56 diff -u -r1.56 TB2ExtItems.pas --- TB2ExtItems.pas 26 Feb 2004 07:05:57 -0000 1.56 +++ TB2ExtItems.pas 29 May 2004 22:19:14 -0000 @@ -43,6 +43,11 @@ EditItemDefaultEditOptions = []; EditItemDefaultEditWidth = 64; +{ Change reasons for TTBEditItem.Text property } + tcrSetProperty = 0; // direct assignment to TTBEditItem.Text property + tcrActionLink = 1; // change comes from an action link + tcrEditControl = 2; // change is caused by typing in edit area + type TTBEditItem = class; TTBEditItemViewer = class; @@ -96,6 +101,7 @@ FEditCaption: String; FEditOptions: TTBEditItemOptions; FEditWidth: Integer; + FExtendedAccept: Boolean; FMaxLength: Integer; FOnAcceptText: TTBAcceptTextEvent; FOnBeginEdit: TTBBeginEditEvent; @@ -112,10 +118,15 @@ procedure SetText(Value: String); protected procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override; + function DoAcceptText(var NewText: string): Boolean; virtual; procedure DoBeginEdit(Viewer: TTBEditItemViewer); virtual; + procedure DoTextChanging(const OldText: String; var NewText: String; Reason: Integer); virtual; + procedure DoTextChanged(Reason: Integer); virtual; function GetActionLinkClass: TTBCustomItemActionLinkClass; override; function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; override; function NeedToRecreateViewer(AViewer: TTBItemViewer): Boolean; override; + property ExtendedAccept: Boolean read FExtendedAccept write FExtendedAccept default False; + procedure SetTextEx(Value: String; Reason: Integer); public constructor Create(AOwner: TComponent); override; procedure Clear; @@ -146,6 +157,8 @@ property OnSelect; end; + TEditClass = class of TEdit; + TTBEditItemViewer = class(TTBItemViewer) private FEditControl: TEdit; @@ -162,6 +175,7 @@ function GetAccValue(var Value: WideString): Boolean; override; function GetCaptionText: String; override; procedure GetCursor(const Pt: TPoint; var ACursor: HCURSOR); override; + function GetEditControlClass: TEditClass; virtual; procedure GetEditRect(var R: TRect); virtual; procedure MouseDown(Shift: TShiftState; X, Y: Integer; var MouseDownOnMenu: Boolean); override; @@ -365,7 +379,7 @@ procedure TTBEditItemActionLink.SetText(const Value: String); begin - if IsTextLinked then TTBEditItem(FClient).Text := Value; + if IsTextLinked then TTBEditItem(FClient).SetTextEx(Value , tcrActionLink); end; @@ -389,7 +403,7 @@ if not CheckDefaults or (Self.EditOptions = []) then Self.EditOptions := EditOptions; if not CheckDefaults or (Self.Text = '') then - Self.Text := Text; + Self.SetTextEx(Text, tcrActionLink); if not CheckDefaults or not Assigned(Self.OnAcceptText) then Self.OnAcceptText := OnAcceptText; end; @@ -496,15 +510,41 @@ end; end; -procedure TTBEditItem.SetText(Value: String); +function TTBEditItem.DoAcceptText(var NewText: string): Boolean; +begin + Result := True; + if Assigned(FOnAcceptText) then FOnAcceptText(Self, NewText, Result); +end; + +procedure TTBEditItem.DoTextChanging(const OldText: String; var NewText: String; Reason: Integer); begin case FCharCase of - ecUpperCase: Value := AnsiUpperCase(Value); - ecLowerCase: Value := AnsiLowerCase(Value); + ecUpperCase: NewText := AnsiUpperCase(NewText); + ecLowerCase: NewText := AnsiLowerCase(NewText); + end; +end; + +procedure TTBEditItem.DoTextChanged(Reason: Integer); +begin +end; + +procedure TTBEditItem.SetText(Value: String); +begin + DoTextChanging(FText, Value, tcrSetProperty); + if FText <> Value then begin + FText := Value; + Change(False); + DoTextChanged(tcrSetProperty); end; +end; + +procedure TTBEditItem.SetTextEx(Value: String; Reason: Integer); +begin + DoTextChanging(FText, Value, Reason); if FText <> Value then begin FText := Value; Change(False); + DoTextChanged(Reason); end; end; @@ -518,14 +558,9 @@ procedure AcceptText; var S: String; - Accept: Boolean; begin S := FEditControl.Text; - Accept := True; - if Assigned(Item.FOnAcceptText) then - Item.FOnAcceptText(Self, S, Accept); - if Accept then - Item.Text := S; + if Item.DoAcceptText(S) then Item.SetTextEx(S, tcrEditControl); end; begin @@ -552,6 +587,11 @@ TEditAccess(FEditControl).WndProc(Message); end; +function TTBEditItemViewer.GetEditControlClass: TEditClass; +begin + Result := TEdit; +end; + procedure TTBEditItemViewer.GetEditRect(var R: TRect); var Item: TTBEditItem; @@ -771,6 +811,7 @@ Item: TTBEditItem; R: TRect; ActiveWnd, FocusWnd: HWND; + S: string; begin Item := TTBEditItem(Self.Item); GetEditRect(R); @@ -784,8 +825,8 @@ { Create the edit control } InflateRect(R, -3, -3); - //View.FreeNotification(Self); - FEditControl := TEdit.Create(nil); + //View.FreeNotification (Self); + FEditControl := GetEditControlClass.Create(nil); try FEditControl.Name := Format('%s_edit_control_%p', [ClassName, Pointer(FEditControl)]); @@ -812,9 +853,14 @@ FEditControlStatus := [ecsContinueLoop]; ControlMessageLoop; finally + S := FEditControl.Text; FreeAndNil(FEditControl); end; + with TTBEditItem(Item) do + if (FEditControlStatus = [ecsContinueLoop]) and ExtendedAccept then + if DoAcceptText(S) then SetTextEx(S, tcrEditControl); + { ensure the area underneath the edit control is repainted immediately } View.Window.Update; { If app is still active, set focus to previous control and restore capture Index: TB2Item.pas =================================================================== RCS file: /data/cvs/tb2k/Source/TB2Item.pas,v retrieving revision 1.258 diff -u -r1.258 TB2Item.pas --- TB2Item.pas 26 Feb 2004 07:05:57 -0000 1.258 +++ TB2Item.pas 29 May 2004 22:19:15 -0000 @@ -1,5 +1,5 @@ unit TB2Item; - + { Toolbar2000 Copyright (C) 1998-2004 by Jordan Russell @@ -23,7 +23,7 @@ GPL. If you do not delete the provisions above, a recipient may use your version of this file under either the "Toolbar2000 License" or the GPL. - $jrsoftware: tb2k/Source/TB2Item.pas,v 1.258 2004/02/26 07:05:57 jr Exp $ + $jrsoftware: tb2k/Source/TB2Item.pas,v 1.259 2004/05/05 08:43:18 jr Exp $ } interface @@ -41,6 +41,14 @@ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, CommCtrl, Menus, ActnList, ImgList, TB2Anim; +const + WM_TB2K_POPUPSHOWING = WM_USER + 554; + + { Parameter in LParam of WM_TB2K_POPUPSHOWING } + TPS_ANIMSTART = 1; // animation query: if Result <> 0, do not animate! + TPS_ANIMFINISHED = 2; // only fired when animation thread is done + TPS_NOANIM = 3; // fired when animation is done, or if showing with no animation + type TTBCustomItem = class; TTBCustomItemClass = class of TTBCustomItem; @@ -82,7 +90,7 @@ TTBItemStyle = set of (tbisSubmenu, tbisSelectable, tbisSeparator, tbisEmbeddedGroup, tbisClicksTransparent, tbisCombo, tbisNoAutoOpen, tbisSubitemsEditable, tbisNoLineBreak, tbisRightAlign, tbisDontSelectFirst, - tbisRedrawOnSelChange, tbisRedrawOnMouseOverChange); + tbisRedrawOnSelChange, tbisRedrawOnMouseOverChange, tbisStretch); TTBPopupAlignment = (tbpaLeft, tbpaRight, tbpaCenter); TTBPopupEvent = procedure(Sender: TTBCustomItem; FromLink: Boolean) of object; TTBSelectEvent = procedure(Sender: TTBCustomItem; Viewer: TTBItemViewer; @@ -97,6 +105,18 @@ {$IFNDEF JR_D5} TImageIndex = type Integer; {$ENDIF} + TTBPopupPositionRec = record + PositionAsSubmenu: Boolean; + Alignment: TTBPopupAlignment; + Opposite: Boolean; + MonitorRect: TRect; + ParentItemRect: TRect; + NCSizeX: Integer; + NCSizeY: Integer; + X, Y, W, H: Integer; + AnimDir: TTBAnimationDirection; + PlaySound: Boolean; + end; TTBCustomItem = class(TComponent) private @@ -186,6 +206,8 @@ function GetChevronParentView: TTBView; virtual; procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override; function GetItemViewerClass(AView: TTBView): TTBItemViewerClass; virtual; + procedure GetPopupPosition(ParentView: TTBView; + PopupWindow: TTBPopupWindow; var PopupPositionRec: TTBPopupPositionRec); virtual; function GetPopupWindowClass: TTBPopupWindowClass; virtual; procedure IndexError; procedure Loaded; override; @@ -315,7 +337,7 @@ function DoExecute: Boolean; virtual; procedure DrawItemCaption(const Canvas: TCanvas; ARect: TRect; const ACaption: String; ADrawDisabledShadow: Boolean; AFormat: UINT); virtual; - procedure Entering; virtual; + procedure Entering(OldSelected: TTBItemViewer); virtual; function GetAccRole: Integer; virtual; function GetAccValue(var Value: WideString): Boolean; virtual; function GetCaptionText: String; virtual; @@ -323,7 +345,7 @@ function GetImageList: TCustomImageList; function ImageShown: Boolean; function IsRotated: Boolean; - function IsToolbarSize: Boolean; + function IsToolbarSize: Boolean; virtual; function IsPtInButtonPart(X, Y: Integer): Boolean; virtual; procedure KeyDown(var Key: Word; Shift: TShiftState); virtual; procedure Leaving; virtual; @@ -352,7 +374,7 @@ function GetAccObject: IDispatch; function GetHintText: String; function IsAccessible: Boolean; - function IsToolbarStyle: Boolean; + function IsToolbarStyle: Boolean; virtual; function ScreenToClient(const P: TPoint): TPoint; end; PTBItemViewerArray = ^TTBItemViewerArray; @@ -450,6 +472,8 @@ procedure KeyDown(var Key: Word; Shift: TShiftState); virtual; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure SetAccelsVisibility(AShowAccels: Boolean); + procedure SetState(AState: TTBViewState); + property DoneActionData: TTBDoneActionData read FDoneActionData write FDoneActionData; public constructor CreateView(AOwner: TComponent; AParentView: TTBView; AParentItem: TTBCustomItem; AWindow: TWinControl; @@ -653,10 +677,12 @@ procedure WMPrint(var Message: TMessage); message WM_PRINT; procedure WMPrintClient(var Message: TMessage); message WM_PRINTCLIENT; procedure WMTB2kStepAnimation(var Message: TMessage); message WM_TB2K_STEPANIMATION; + procedure WMTB2kAnimationEnded (var Message: TMessage); message WM_TB2K_ANIMATIONENDED; protected procedure CreateParams(var Params: TCreateParams); override; procedure CreateWnd; override; procedure DestroyWindowHandle; override; + function GetNCSize: TPoint; dynamic; function GetViewClass: TTBViewClass; dynamic; procedure Paint; override; procedure PaintScrollArrows; virtual; @@ -800,6 +826,21 @@ var ToolbarFont: TFont; +type + TTBModalHandler = class + private + FCreatedWnd: Boolean; + FInited: Boolean; + FWnd: HWND; + public + constructor Create(AExistingWnd: HWND); + destructor Destroy; override; + procedure Loop(const RootView: TTBView; const AMouseDown, AExecuteSelected, + AFromMSAA, TrackRightButton: Boolean); + property Wnd: HWND read FWnd; + end; + +procedure ProcessDoneAction(const DoneActionData: TTBDoneActionData); implementation @@ -815,19 +856,6 @@ ClickList: TList; type - TTBModalHandler = class - private - FCreatedWnd: Boolean; - FInited: Boolean; - FWnd: HWND; - public - constructor Create(AExistingWnd: HWND); - destructor Destroy; override; - procedure Loop(const RootView: TTBView; const AMouseDown, AExecuteSelected, - AFromMSAA, TrackRightButton: Boolean); - property Wnd: HWND read FWnd; - end; - PItemChangedNotificationData = ^TItemChangedNotificationData; TItemChangedNotificationData = record Proc: TTBItemChangedProc; @@ -1645,10 +1673,11 @@ var PlayedSound: Boolean = False; -function TTBCustomItem.CreatePopup(const ParentView: TTBView; - const ParentViewer: TTBItemViewer; const PositionAsSubmenu, SelectFirstItem, - Customizing: Boolean; const APopupPoint: TPoint; - const Alignment: TTBPopupAlignment): TTBPopupWindow; +procedure TTBCustomItem.GetPopupPosition(ParentView: TTBView; + PopupWindow: TTBPopupWindow; var PopupPositionRec: TTBPopupPositionRec); +var + X2, Y2: Integer; + RepeatCalcX: Boolean; function CountObscured(X, Y, W, H: Integer): Integer; var @@ -1672,114 +1701,9 @@ end; end; -var - EventItem, ParentItem: TTBCustomItem; - Opposite: Boolean; - ChevronParentView: TTBView; - X, X2, Y, Y2, W, H: Integer; - P: TPoint; - RepeatCalcX: Boolean; - ParentItemRect: TRect; - MonitorRect: TRect; - AnimDir: TTBAnimationDirection; begin - EventItem := ItemContainingItems(Self); - if EventItem <> Self then - EventItem.DoPopup(Self, True); - DoPopup(Self, False); - - ChevronParentView := GetChevronParentView; - if ChevronParentView = nil then - ParentItem := Self - else - ParentItem := ChevronParentView.FParentItem; - - Opposite := Assigned(ParentView) and (vsOppositePopup in ParentView.FState); - Result := GetPopupWindowClass.CreatePopupWindow(nil, ParentView, ParentItem, - Customizing); - try - if Assigned(ChevronParentView) then begin - ChevronParentView.FreeNotification(Result.View); - Result.View.FChevronParentView := ChevronParentView; - Result.View.FIsToolbar := True; - Result.View.Style := Result.View.Style + - (ChevronParentView.Style * [vsAlwaysShowHints]); - Result.Color := clBtnFace; - end; - - { Calculate ParentItemRect, and MonitorRect (the rectangle of the monitor - that the popup window will be confined to) } - if Assigned(ParentView) then begin - ParentView.ValidatePositions; - ParentItemRect := ParentViewer.BoundsRect; - P := ParentView.FWindow.ClientToScreen(Point(0, 0)); - OffsetRect(ParentItemRect, P.X, P.Y); - if not IsRectEmpty(ParentView.FMonitorRect) then - MonitorRect := ParentView.FMonitorRect - else - MonitorRect := GetRectOfMonitorContainingRect(ParentItemRect, False); - end - else begin - ParentItemRect.TopLeft := APopupPoint; - ParentItemRect.BottomRight := APopupPoint; - MonitorRect := GetRectOfMonitorContainingPoint(APopupPoint, False); - end; - Result.View.FMonitorRect := MonitorRect; - - { Initialize item positions and size of the popup window } - if ChevronParentView = nil then - Result.View.FMaxHeight := (MonitorRect.Bottom - MonitorRect.Top) - - (PopupMenuWindowNCSize * 2) - else - Result.View.WrapOffset := (MonitorRect.Right - MonitorRect.Left) - - (PopupMenuWindowNCSize * 2); - if SelectFirstItem then - Result.View.Selected := Result.View.FirstSelectable; - Result.View.UpdatePositions; - W := Result.Width; - H := Result.Height; - - { Calculate initial X,Y position of the popup window } - if Assigned(ParentView) then begin - if not PositionAsSubmenu then begin - if ChevronParentView = nil then begin - if (ParentView = nil) or (ParentView.FOrientation <> tbvoVertical) then begin - if GetSystemMetrics(SM_MENUDROPALIGNMENT) = 0 then - X := ParentItemRect.Left - else - X := ParentItemRect.Right - W; - Y := ParentItemRect.Bottom; - end - else begin - X := ParentItemRect.Left - W; - Y := ParentItemRect.Top; - end; - end - else begin - if ChevronParentView.FOrientation <> tbvoVertical then begin - X := ParentItemRect.Right - W; - Y := ParentItemRect.Bottom; - end - else begin - X := ParentItemRect.Left - W; - Y := ParentItemRect.Top; - end; - end; - end - else begin - X := ParentItemRect.Right - PopupMenuWindowNCSize; - Y := ParentItemRect.Top - PopupMenuWindowNCSize; - end; - end - else begin - X := APopupPoint.X; - Y := APopupPoint.Y; - case Alignment of - tbpaRight: Dec(X, W); - tbpaCenter: Dec(X, W div 2); - end; - end; - + with PopupPositionRec do + begin { Adjust the Y position of the popup window } { If the window is going off the bottom of the monitor, try placing it above the parent item } @@ -1788,7 +1712,7 @@ if not PositionAsSubmenu then Y2 := ParentItemRect.Top else - Y2 := ParentItemRect.Bottom + PopupMenuWindowNCSize; + Y2 := ParentItemRect.Bottom + NCSizeY; Dec(Y2, H); { Only place it above the parent item if it isn't going to go off the top of the monitor } @@ -1864,17 +1788,17 @@ X2 := X; if Opposite or (X2 + W > MonitorRect.Right) then begin if Assigned(ParentView) then - X2 := ParentItemRect.Left + PopupMenuWindowNCSize; + X2 := ParentItemRect.Left + NCSizeX; Dec(X2, W); if not Opposite then - Include(Result.View.FState, vsOppositePopup) + Include(PopupWindow.View.FState, vsOppositePopup) else begin if X2 < MonitorRect.Left then begin Opposite := False; RepeatCalcX := True; end else - Include(Result.View.FState, vsOppositePopup); + Include(PopupWindow.View.FState, vsOppositePopup); end; end; until not RepeatCalcX; @@ -1901,8 +1825,141 @@ else Include(AnimDir, tbadLeft); end; - Result.FAnimationDirection := AnimDir; + end; +end; + +function TTBCustomItem.CreatePopup(const ParentView: TTBView; + const ParentViewer: TTBItemViewer; const PositionAsSubmenu, SelectFirstItem, + Customizing: Boolean; const APopupPoint: TPoint; + const Alignment: TTBPopupAlignment): TTBPopupWindow; +var + EventItem, ParentItem: TTBCustomItem; + Opposite: Boolean; + ChevronParentView: TTBView; + X, Y, W, H: Integer; + P: TPoint; + ParentItemRect: TRect; + MonitorRect: TRect; + PopupRec: TTBPopupPositionRec; + NCSize: TPoint; +begin + EventItem := ItemContainingItems(Self); + if EventItem <> Self then + EventItem.DoPopup(Self, True); + DoPopup(Self, False); + + ChevronParentView := GetChevronParentView; + if ChevronParentView = nil then + ParentItem := Self + else + ParentItem := ChevronParentView.FParentItem; + Opposite := Assigned(ParentView) and (vsOppositePopup in ParentView.FState); + Result := GetPopupWindowClass.CreatePopupWindow(nil, ParentView, ParentItem, + Customizing); + try + if Assigned(ChevronParentView) then begin + ChevronParentView.FreeNotification(Result.View); + Result.View.FChevronParentView := ChevronParentView; + Result.View.FIsToolbar := True; + Result.View.Style := Result.View.Style + + (ChevronParentView.Style * [vsAlwaysShowHints]); + Result.Color := clBtnFace; + end; + + { Calculate ParentItemRect, and MonitorRect (the rectangle of the monitor + that the popup window will be confined to) } + if Assigned(ParentView) then begin + ParentView.ValidatePositions; + ParentItemRect := ParentViewer.BoundsRect; + P := ParentView.FWindow.ClientToScreen(Point(0, 0)); + OffsetRect(ParentItemRect, P.X, P.Y); + if not IsRectEmpty(ParentView.FMonitorRect) then + MonitorRect := ParentView.FMonitorRect + else + MonitorRect := GetRectOfMonitorContainingRect(ParentItemRect, False); + end + else begin + ParentItemRect.TopLeft := APopupPoint; + ParentItemRect.BottomRight := APopupPoint; + MonitorRect := GetRectOfMonitorContainingPoint(APopupPoint, False); + end; + Result.View.FMonitorRect := MonitorRect; + + { Initialize item positions and size of the popup window } + NCSize := Result.GetNCSize; + if ChevronParentView = nil then + Result.View.FMaxHeight := (MonitorRect.Bottom - MonitorRect.Top) - + (NCSize.Y * 2) + else + Result.View.WrapOffset := (MonitorRect.Right - MonitorRect.Left) - + (NCSize.X * 2); + if SelectFirstItem then + Result.View.Selected := Result.View.FirstSelectable; + Result.View.UpdatePositions; + W := Result.Width; + H := Result.Height; + + { Calculate initial X,Y position of the popup window } + if Assigned(ParentView) then begin + if not PositionAsSubmenu then begin + if ChevronParentView = nil then begin + if (ParentView = nil) or (ParentView.FOrientation <> tbvoVertical) then begin + if GetSystemMetrics(SM_MENUDROPALIGNMENT) = 0 then + X := ParentItemRect.Left + else + X := ParentItemRect.Right - W; + Y := ParentItemRect.Bottom; + end + else begin + X := ParentItemRect.Left - W; + Y := ParentItemRect.Top; + end; + end + else begin + if ChevronParentView.FOrientation <> tbvoVertical then begin + X := ParentItemRect.Right - W; + Y := ParentItemRect.Bottom; + end + else begin + X := ParentItemRect.Left - W; + Y := ParentItemRect.Top; + end; + end; + end + else begin + X := ParentItemRect.Right - NCSize.X; + Y := ParentItemRect.Top - NCSize.Y; + end; + end + else begin + X := APopupPoint.X; + Y := APopupPoint.Y; + case Alignment of + tbpaRight: Dec(X, W); + tbpaCenter: Dec(X, W div 2); + end; + end; + + PopupRec.PositionAsSubmenu := PositionAsSubmenu; + PopupRec.Alignment := Alignment; + PopupRec.Opposite := Opposite; + PopupRec.MonitorRect := MonitorRect; + PopupRec.ParentItemRect := ParentItemRect; + PopupRec.NCSizeX := NCSize.X; + PopupRec.NCSizeY := NCSize.Y; + PopupRec.X := X; + PopupRec.Y := Y; + PopupRec.W := W; + PopupRec.H := H; + PopupRec.AnimDir := []; + PopupRec.PlaySound := True; + GetPopupPosition(ParentView, Result, PopupRec); + X := PopupRec.X; + Y := PopupRec.Y; + W := PopupRec.W; + H := PopupRec.H; + Result.FAnimationDirection := PopupRec.AnimDir; Result.SetBounds(X, Y, W, H); if Assigned(ParentView) then begin Result.FreeNotification(ParentView); @@ -1916,7 +1973,7 @@ end; end; Include(Result.View.FState, vsDrawInOrder); - if not NeedToPlaySound('MenuPopup') then begin + if not PopupRec.PlaySound or not NeedToPlaySound('MenuPopup') then begin { Don't call PlaySound if we don't have to } Result.Visible := True; end @@ -3224,7 +3281,7 @@ View.Invalidate(Self); end; -procedure TTBItemViewer.Entering; +procedure TTBItemViewer.Entering(OldSelected: TTBItemViewer); begin if Assigned(Item.FOnSelect) then Item.FOnSelect(Item, Self, True); @@ -4015,7 +4072,7 @@ if Assigned(Value) then begin if tbisRedrawOnSelChange in Value.Item.ItemStyle then Invalidate(Value); - Value.Entering; + Value.Entering(OldSelected); end; NotifyFocusEvent; @@ -4308,7 +4365,7 @@ HighestHeightOnLine := TotalSize.Y; end; { Make separators on toolbars as tall/wide as the tallest/widest item } - if tbisSeparator in Item.ItemStyle then begin + if [tbisSeparator, tbisStretch] * Item.ItemStyle <> [] then begin if AOrientation <> tbvoVertical then Pos.BoundsRect.Bottom := Pos.BoundsRect.Top + HighestHeightOnLine else @@ -5576,12 +5633,30 @@ Result := GetRootView.FCaptureWnd; end; +procedure TTBView.SetState(AState: TTBViewState); +begin + FState := AState; +end; + { TTBModalHandler } +const + LSFW_LOCK = 1; + LSFW_UNLOCK = 2; + +var + LockSetForegroundWindowInited: BOOL; + LockSetForegroundWindow: function(uLockCode: UINT): BOOL; stdcall; + constructor TTBModalHandler.Create(AExistingWnd: HWND); begin inherited Create; + if not LockSetForegroundWindowInited then begin + LockSetForegroundWindow := GetProcAddress(GetModuleHandle(user32), + 'LockSetForegroundWindow'); + LockSetForegroundWindowInited := True; + end; LastPos := SmallPointToPoint(TSmallPoint(GetMessagePos())); if AExistingWnd <> 0 then FWnd := AExistingWnd @@ -5589,6 +5664,13 @@ FWnd := {$IFDEF JR_D6}Classes.{$ENDIF} AllocateHWnd(nil); FCreatedWnd := True; end; + if Assigned(LockSetForegroundWindow) then begin + { Like standard menus, don't allow other apps to steal the focus during + our modal loop. This also prevents us from losing activation when + "active window tracking" is enabled and the user moves the mouse over + another application's window. } + LockSetForegroundWindow(LSFW_LOCK); + end; SetCapture(FWnd); SetCursor(LoadCursor(0, IDC_ARROW)); CallNotifyWinEvent(EVENT_SYSTEM_MENUSTART, FWnd, OBJID_CLIENT, CHILDID_SELF); @@ -5597,6 +5679,8 @@ destructor TTBModalHandler.Destroy; begin + if Assigned(LockSetForegroundWindow) then + LockSetForegroundWindow(LSFW_UNLOCK); if FWnd <> 0 then begin if GetCapture = FWnd then ReleaseCapture; @@ -6021,9 +6105,10 @@ procedure TTBPopupView.AutoSize(AWidth, AHeight: Integer); begin - with FWindow do - SetBounds(Left, Top, AWidth + (PopupMenuWindowNCSize * 2), - AHeight + (PopupMenuWindowNCSize * 2)); + with TTBPopupWindow(FWindow) do + with GetNCSize do + SetBounds(Left, Top, AWidth + (X * 2), + AHeight + (Y * 2)); end; function TTBPopupView.GetFont: TFont; @@ -6100,6 +6185,12 @@ inherited; end; +function TTBPopupWindow.GetNCSize: TPoint; +begin + Result.X := PopupMenuWindowNCSize; + Result.Y := PopupMenuWindowNCSize; +end; + function TTBPopupWindow.GetViewClass: TTBViewClass; begin Result := TTBPopupView; @@ -6183,8 +6274,12 @@ SystemParametersInfo(SPI_GETMENUANIMATION, 0, @Animate, 0) and Animate then begin Blend := SystemParametersInfo(SPI_GETMENUFADE, 0, @Animate, 0) and Animate; if Blend or (FAnimationDirection <> []) then begin - TBStartAnimation(WindowHandle, 150, Blend, FAnimationDirection); - Exit; + if SendMessage(WindowHandle, WM_TB2K_POPUPSHOWING, TPS_ANIMSTART, 0) = 0 then + begin + { Start animation only if WM_TB2K_POPUPSHOWING returns zero (or not handled) } + TBStartAnimation(WindowHandle, 150, Blend, FAnimationDirection); + Exit; + end; end; end; {$ENDIF} @@ -6197,6 +6292,12 @@ TBEndAnimation(WindowHandle); end; SetWindowPos(WindowHandle, 0, 0, 0, 0, 0, ShowFlags[Showing]); + if Showing then SendNotifyMessage(WindowHandle, WM_TB2K_POPUPSHOWING, TPS_NOANIM, 0); +end; + +procedure TTBPopupWindow.WMTB2kAnimationEnded(var Message: TMessage); +begin + SendNotifyMessage(WindowHandle, WM_TB2K_POPUPSHOWING, TPS_ANIMFINISHED, 0); end; procedure TTBPopupWindow.WMTB2kStepAnimation(var Message: TMessage); @@ -6266,8 +6367,8 @@ procedure TTBPopupWindow.WMNCCalcSize(var Message: TWMNCCalcSize); begin - InflateRect(Message.CalcSize_Params^.rgrc[0], - -PopupMenuWindowNCSize, -PopupMenuWindowNCSize); + with GetNCSize do + InflateRect(Message.CalcSize_Params^.rgrc[0], -X, -Y); inherited; end; Index: TB2MRU.pas =================================================================== RCS file: /data/cvs/tb2k/Source/TB2MRU.pas,v retrieving revision 1.22 diff -u -r1.22 TB2MRU.pas --- TB2MRU.pas 26 Feb 2004 07:05:58 -0000 1.22 +++ TB2MRU.pas 29 May 2004 22:19:15 -0000 @@ -53,6 +53,7 @@ procedure SetMaxItems(Value: Integer); protected property Container: TTBCustomItem read FContainer; + function GetFirstKey: Integer; virtual; function GetItemClass: TTBCustomItemClass; virtual; procedure SetItemCaptions; virtual; public @@ -107,7 +108,7 @@ procedure Delete(Index: Integer); override; function Get(Index: Integer): String; override; function GetCount: Integer; override; - function IndexOf(const S: String): Integer; override; + function IndexOf(const S: String): Integer; override; procedure Insert(Index: Integer; const S: String); override; procedure Move(CurIndex, NewIndex: Integer); override; procedure Put(Index: Integer; const S: String); override; @@ -296,20 +297,21 @@ procedure TTBMRUList.SetItemCaptions; var - I, J: Integer; + I, J, N: Integer; Key: Char; S: String; Buf: array[0..MAX_PATH-1] of Char; begin while FList.Count > FMaxItems do FList.Delete(FList.Count-1); + N := GetFirstKey; for I := 0 to FContainer.Count-1 do begin Key := #0; - if I < 9 then - Key := Chr(Ord('1') + I) + if N < 9 then + Key := Chr(Ord('1') + N) else begin { No more numbers; try letters } - J := I - 9; + J := N - 9; if J < 26 then Key := Chr(Ord('A') + J); end; @@ -321,6 +323,7 @@ FContainer[I].Caption := Format('&%s %s', [Key, S]) else FContainer[I].Caption := S; + Inc(N); end; end; @@ -361,6 +364,11 @@ Result := TTBCustomItem; end; +function TTBMRUList.GetFirstKey: Integer; +begin + Result := 0; +end; + { TTBMRUListItem } Index: TB2Reg.pas =================================================================== RCS file: /data/cvs/tb2k/Source/TB2Reg.pas,v retrieving revision 1.27 diff -u -r1.27 TB2Reg.pas --- TB2Reg.pas 26 Feb 2004 07:05:58 -0000 1.27 +++ TB2Reg.pas 29 May 2004 22:19:15 -0000 @@ -36,13 +36,6 @@ TB2Toolbar, TB2ToolWindow, TB2Dock, TB2Item, TB2ExtItems, TB2MRU, TB2MDI, TB2DsgnItemEditor; -procedure Register; - -implementation - -uses - ImgEdit; - {$IFDEF JR_D5} { TTBImageIndexPropertyEditor } @@ -67,6 +60,25 @@ const ARect: TRect; ASelected: Boolean); {$IFNDEF JR_D6} override; {$ENDIF} end; +{ TTBItemImageIndexPropertyEditor } + +type + TTBItemImageIndexPropertyEditor = class(TTBImageIndexPropertyEditor) + public + function GetImageListAt (Index: Integer): TCustomImageList; override; + end; + +{$ENDIF} + +procedure Register; + +implementation + +uses + ImgEdit; + +{$IFDEF JR_D5} + function TTBImageIndexPropertyEditor.GetAttributes: TPropertyAttributes; begin Result := [paMultiSelect, paValueList, paRevertable]; @@ -128,12 +140,6 @@ { TTBItemImageIndexPropertyEditor } -type - TTBItemImageIndexPropertyEditor = class(TTBImageIndexPropertyEditor) - protected - function GetImageListAt(Index: Integer): TCustomImageList; override; - end; - function TTBItemImageIndexPropertyEditor.GetImageListAt(Index: Integer): TCustomImageList; var C: TPersistent; Index: TB2ToolWindow.pas =================================================================== RCS file: /data/cvs/tb2k/Source/TB2ToolWindow.pas,v retrieving revision 1.17 diff -u -r1.17 TB2ToolWindow.pas --- TB2ToolWindow.pas 26 Feb 2004 07:05:58 -0000 1.17 +++ TB2ToolWindow.pas 29 May 2004 22:19:15 -0000 @@ -195,14 +195,24 @@ begin Result.X := FBarWidth; Result.Y := FBarHeight; - if Assigned(ADock) and (FullSize or Stretch) then begin - { If docked and stretching, return the minimum size so that the toolbar - can shrink below FBarWidth/FBarHeight } - if not(ADock.Position in [dpLeft, dpRight]) then - Result.X := FMinClientWidth - else - Result.Y := FMinClientHeight; - end; + if Assigned(ADock) then + if FullSize then + begin + { If docked and full size, return the size corresponding to docked size } + if not(ADock.Position in [dpLeft, dpRight]) then + Result.X := ADock.ClientWidth - (Width - ClientWidth) + else + Result.Y := ADock.ClientHeight - (Height - ClientHeight); + end + else if Stretch then + begin + { If docked and stretching, return the minimum size so that the toolbar + can shrink below FBarWidth/FBarHeight } + if not(ADock.Position in [dpLeft, dpRight]) then + Result.X := FMinClientWidth + else + Result.Y := FMinClientHeight; + end; end; procedure TTBToolWindow.GetBaseSize(var ASize: TPoint); Index: TB2Toolbar.pas =================================================================== RCS file: /data/cvs/tb2k/Source/TB2Toolbar.pas,v retrieving revision 1.99 diff -u -r1.99 TB2Toolbar.pas --- TB2Toolbar.pas 26 Feb 2004 07:05:58 -0000 1.99 +++ TB2Toolbar.pas 29 May 2004 22:19:15 -0000 @@ -23,7 +23,7 @@ GPL. If you do not delete the provisions above, a recipient may use your version of this file under either the "Toolbar2000 License" or the GPL. - $jrsoftware: tb2k/Source/TB2Toolbar.pas,v 1.99 2004/02/26 07:05:58 jr Exp $ + $jrsoftware: tb2k/Source/TB2Toolbar.pas,v 1.100 2004/04/30 21:06:18 jr Exp $ } interface @@ -327,7 +327,9 @@ SetWindowsHookExW, Msg.wParam may either be an ANSI character or a Unicode character, due to an apparent bug on these platforms. It is an ANSI character when the message passes through a separate - SetWindowsHookExA-installed WH_GETMESSAGE hook first. + SetWindowsHookExA-installed WH_GETMESSAGE hook first, and that hook + calls us via CallNextHookEx. Windows apparently "forgets" to convert + the character from ANSI back to Unicode in this case. We can't convert the character code because there seems to be no way to detect whether it is ANSI or Unicode. So we can't really do much with Msg.wParam, apart from comparing it against character codes that @@ -340,9 +342,12 @@ { Redirect the message to the main form. Note: Unfortunately, due to a bug in Windows NT 4.0 (and not 2000/XP/9x/Me), modifications to the message don't take effect if - another WH_GETMESSAGE hook has been installed above this one. I - don't know of any clean workaround, other than to ensure other - WH_GETMESSAGE hooks are installed *before* Toolbar2000's. } + another WH_GETMESSAGE hook has been installed above this one. + (The bug is that CallNextHookEx copies lParam^ to a local buffer, but + does not propogate the changes made by the hook back to lParam^ when + it returns.) I don't know of any clean workaround, other than to + ensure other WH_GETMESSAGE hooks are installed *before* + Toolbar2000's. } Msg.hwnd := MainForm.Handle; end; end; @@ -891,6 +896,11 @@ Hint := Item.Hint else Hint := ''; + + with TTBItemViewerAccess(FView.Find(Item)) do + begin + MouseMove(X - BoundsRect.Left, Y - BoundsRect.Top); + end; end else Hint := '';