--- TBX.pas 2004-05-29 19:48:58.000000000 +-0400 +++ TBX.pas 2005-08-14 23:15:12.000000000 +-0400 @@ -8,12 +8,16 @@ interface {$I TB2Ver.inc} {$I TBX.inc} +{x$DEFINE TBX_NO_ANIMATION} + { Enabling the above define disables all menu animation. For debugging + purpose only. } {vb+} + uses Windows, Messages, Classes, SysUtils, Controls, Graphics, ImgList, Forms, TB2Item, TB2Dock, TB2Toolbar, TB2ToolWindow, TB2Anim, TBXUtils, TBXThemes; const TBXVersion = 2.1; @@ -68,13 +72,13 @@ property Underline: TTriState read FUnderline write SetUnderline default tsDefault; property StrikeOut: TTriState read FStrikeOut write SetStrikeOut default tsDefault; property Size: TFontSize read FSize write SetSize default 100; // percent property Color: TColor read FColor write SetColor default clNone; property Name: TFontName read FName write SetName; // default '' end; - + TTBXPopupPositionInfo = record Item: TTBCustomItem; // this is a tentative type, it will be changed ParentView: TTBView; // or removed in future versions ParentViewer: TTBItemViewer; PositionAsSubmenu: Boolean; APopupPoint: TPoint; @@ -160,12 +164,13 @@ property InheritOptions; property Layout; property MaskOptions; property MinHeight; property MinWidth; property Options; + property RadioItem; property ShortCut; property Stretch; property Visible; property OnAdjustFont; property OnDrawImage; property OnClick; @@ -224,12 +229,13 @@ property Layout; property LinkSubitems; property MaskOptions; property MinHeight; property MinWidth; property Options; + property RadioItem; property ShortCut; property Stretch; property SubMenuImages; property ToolBoxPopup; property Visible; property OnAdjustFont; @@ -302,12 +308,13 @@ TTBXPopupWindow = class(TTBPopupWindow) private FControlRect: TRect; FShadows: TShadows; procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW; + procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED; {vb+} procedure TBMGetViewType(var Message: TMessage); message TBM_GETVIEWTYPE; procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE; procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT; procedure WMPrint(var Message: TMessage); message WM_PRINT; procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED; @@ -316,12 +323,13 @@ procedure CreateParams(var Params: TCreateParams); override; procedure CreateShadow; virtual; procedure DestroyShadow; virtual; function GetNCSize: TPoint; override; function GetShowShadow: Boolean; virtual; function GetViewClass: TTBViewClass; override; + procedure PaintScrollArrows; override; {vb+} public destructor Destroy; override; function GetFillColor: TColor; end; TTBXPopupView = class(TTBPopupView); @@ -354,12 +362,13 @@ protected procedure DrawNCArea(const DrawToDC: Boolean; const ADC: HDC; const Clip: HRGN); override; function GetChevronItemClass: TTBChevronItemClass; override; function GetFloatingWindowParentClass: TTBFloatingWindowParentClass; override; procedure GetToolbarInfo(out ToolbarInfo: TTBXToolbarInfo); virtual; function GetViewClass: TTBToolbarViewClass; override; + procedure Loaded; override; {vb+} procedure SetParent(AParent: TWinControl); override; procedure UpdateEffectiveColor; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function Embedded: Boolean; @@ -461,26 +470,29 @@ protected function CreatePopupEx(SelectFirstItem: Boolean; const AControlRect: TRect; Alignment: TTBPopupAlignment): TTBPopupWindow; virtual; function GetPopupWindowClass: TTBPopupWindowClass; override; procedure GetPopupPosition(ParentView: TTBView; PopupWindow: TTBPopupWindow; var PopupPositionRec: TTBPopupPositionRec); override; - procedure OpenPopupEx(const SelectFirstItem, TrackRightButton: Boolean; - const ControlRect: TRect; const Alignment: TTBPopupAlignment); - procedure PopupEx(const ControlRect: TRect; TrackRightButton: Boolean; - Alignment: TTBPopupAlignment = tbpaLeft); + function OpenPopupEx(const SelectFirstItem, TrackRightButton: Boolean; + const ControlRect: TRect; const Alignment: TTBPopupAlignment; + const ReturnClickedItemOnly: Boolean): TTBCustomItem; + function PopupEx(const ControlRect: TRect; TrackRightButton: Boolean; + Alignment: TTBPopupAlignment = tbpaLeft; + ReturnClickedItemOnly: Boolean = False): TTBCustomItem; end; TTBXPopupMenu = class(TTBPopupMenu) private FToolBoxPopup: Boolean; procedure TBMGetViewType(var Message: TMessage); message TBM_GETVIEWTYPE; protected function GetRootItemClass: TTBRootItemClass; override; public - procedure PopupEx(const ControlRect: TRect); + function PopupEx(const ControlRect: TRect; + ReturnClickedItemOnly: Boolean = False): TTBCustomItem; property ToolBoxPopup: Boolean read FToolBoxPopup write FToolBoxPopup default False; end; TTBXFloatingWindowParent = class(TTBFloatingWindowParent) private FCloseButtonHover: Boolean; @@ -551,14 +563,35 @@ destructor Destroy; override; published property Color default clNone; property UseParentBackground: Boolean read FUseParentBackground write SetUseParentBackground default False; end; + { TTBXMenuAnimation } {vb+} + + TMenuAnimation = (maNone, maUnfold, maSlide, maFade); + TAnimationMode = (amNone, amSysDefault, amRandom, amUnfold, amSlide, amFade); + TAnimationModes = set of TAnimationMode; + + TTBXMenuAnimation = class + private + FAnimationMode: TAnimationMode; + function SysParamEnabled(Param: Cardinal): Boolean; + function GetAvailableModes: TAnimationModes; + function GetMenuAnimation: TMenuAnimation; + procedure SetAnimationMode(Value: TAnimationMode); + property MenuAnimation: TMenuAnimation read GetMenuAnimation; + public + constructor Create(AAnimationMode: TAnimationMode = amSysDefault); + property AnimationMode: TAnimationMode read FAnimationMode write SetAnimationMode; + property AvailableModes: TAnimationModes read GetAvailableModes; + end; + var CurrentTheme: TTBXTheme; + TBXMenuAnimation: TTBXMenuAnimation; { vb+ } {$IFNDEF JR_D6} var clMoneyGreen: TColor = TColor($C0DCC0); clSkyBlue: TColor = TColor($F0CAA6); clCream: TColor = TColor($F0FBFF); @@ -588,25 +621,27 @@ implementation {$R tbx_glyphs.res} uses TBXExtItems, TBXLists, TB2Common, TBXUxThemes, MultiMon, TBXDefaultTheme, - ComCtrls, Menus; + {ComCtrls, Menus;} {vb-} + ComCtrls, Menus, MMSystem; {vb+} type TTBItemAccess = class(TTBCustomItem); TTBViewAccess = class(TTBView); TTBItemViewerAccess = class(TTBItemViewer); TTBFloatingWindowParentAccess = class(TTBFloatingWindowParent); TTBCustomDockableWindowAccess = class(TTBCustomDockableWindow); TTBXToolbarAccess = class(TTBXToolbar); TTBBackgroundAccess = class(TTBBackground); TControlAccess = class(TControl); TTBXThemeAccess = class(TTBXTheme); TDockAccess = class(TTBDock); + TTBPopupWindowAccess = class(TTBPopupWindow); {vb+} { TTBNexus } TTBXNexus = class private FNotifies: TList; procedure TBXSysCommand(var Message: TMessage); message TBX_SYSCOMMAND; @@ -670,14 +705,14 @@ Shift.X := 0; Shift.Y := 0; Shift := Parent.ScreenToClient(Control.ClientToScreen(Shift)); SaveDC(DC); try SetWindowOrgEx(DC, Shift.X, Shift.Y, nil); Msg.Msg := WM_ERASEBKGND; - Msg.WParam := DC; - Msg.LParam := DC; + Msg.WParam := Integer(DC); {vb+} + Msg.LParam := Integer(DC); {vb+} Msg.Result := 0; Parent.Dispatch(Msg); finally RestoreDC(DC, -1); end; @@ -1316,13 +1351,13 @@ end else begin Inc(AHeight, ImgSize.CY); if AWidth < ImgSize.CX + 7 then AWidth := ImgSize.CX + 7; end; - end; + end; if tbisSubmenu in TTBItemAccess(Item).ItemStyle then with CurrentTheme do begin if tbisCombo in TTBItemAccess(Item).ItemStyle then Inc(AWidth, SplitBtnArrowWidth) else if tboDropdownArrow in Item.EffectiveOptions then begin @@ -1521,13 +1556,13 @@ Result := not (tbisSubmenu in TTBItemAccess(Item).ItemStyle); if (tbisCombo in TTBItemAccess(Item).ItemStyle) then begin if IsToolbarStyle then W := CurrentTheme.SplitBtnArrowWidth else W := GetSystemMetrics(SM_CXMENUCHECK); Result := X < (BoundsRect.Right - BoundsRect.Left) - W; - end; + end; end; function TTBXItemViewer.IsToolbarSize: Boolean; begin Result := inherited IsToolbarSize; Result := Result or ((GetViewType(View) and PVT_TOOLBOX) = PVT_TOOLBOX); @@ -1564,13 +1599,13 @@ CAppActive: array [Boolean] of Integer = (0, IO_APPACTIVE); var Item: TTBXCustomItem; View: TTBViewAccess; ItemInfo: TTBXItemInfo; - M: Integer; + {M: Integer;} {vb-} R: TRect; ComboRect: TRect; CaptionRect: TRect; ImageRect: TRect; C: TColor; @@ -1888,15 +1923,22 @@ Left := Left + ((Right - Left) - CX) div 2; ImageRect.Top := Top + ((Bottom - Top) - CY) div 2; Right := Left + CX; Bottom := Top + CY; DrawItemImage(Canvas, ImageRect, ItemInfo); end - else if not ToolbarStyle and Item.Checked then - CurrentTheme.PaintCheckMark(Canvas, ImageRect, ItemInfo); - end; + {else if not ToolbarStyle and Item.Checked then + CurrentTheme.PaintCheckMark(Canvas, ImageRect, ItemInfo);} {vb-} + else {vb+} + if not ToolbarStyle and Item.Checked then + begin + if Item.RadioItem then + with ItemInfo do ItemOptions := ItemOptions or IO_RADIO; + CurrentTheme.PaintCheckMark(Canvas, ImageRect, ItemInfo); + end; + end; end; //============================================================================// { TTBXSubmenuItem } @@ -2090,12 +2132,59 @@ HintStr := View.Selected.GetHintText; View.Selected.Dispatch(Message); end; end; end; +procedure TTBXPopupWindow.CMShowingChanged(var Message: TMessage); {vb+} +const + ShowFlags: array[Boolean] of UINT = ( + SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_HIDEWINDOW, + SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or SWP_SHOWWINDOW); +var + MenuAni: TMenuAnimation; + AniDir: TTBAnimationDirection; +begin + { Must override TCustomForm/TForm's CM_SHOWINGCHANGED handler so that the + form doesn't get activated when Visible is set to True. } + + { Handle animation. NOTE: I do not recommend trying to enable animation on + Windows 95 and NT 4.0 because there's a difference in the way the + SetWindowPos works on those versions. See the comment in the + TBStartAnimation function of TB2Anim.pas. } + {$IFNDEF TBX_NO_ANIMATION} + if ((View.ParentView = nil) or not(vsNoAnimation in View.ParentView.State)) and + Showing and (View.Selected = nil) and not IsWindowVisible(WindowHandle) and + (TBXMenuAnimation.AnimationMode <> amNone) then + begin + { Start animation only if WM_TB2K_POPUPSHOWING returns zero (or not handled) } + if SendMessage(WindowHandle, WM_TB2K_POPUPSHOWING, TPS_ANIMSTART, 0) = 0 then + begin + MenuAni := TBXMenuAnimation.MenuAnimation; + AniDir := TTBPopupWindowAccess(Self).AnimationDirection; + if MenuAni = maUnfold then + if [tbadDown, tbadUp] * AniDir <> [] + then Include(AniDir, tbadRight) + else Include(AniDir, tbadDown); + TBStartAnimation(WindowHandle, MenuAni = maFade, AniDir); + Exit; + end; + end; + {$ENDIF} + + { No animation... } + if not Showing then begin + { Call TBEndAnimation to ensure WS_EX_LAYERED style is removed before + hiding, otherwise windows under the popup window aren't repainted + properly. } + 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 TTBXPopupWindow.CreateParams(var Params: TCreateParams); const CS_DROPSHADOW = $00020000; begin inherited CreateParams(Params); with Params do @@ -2180,12 +2269,61 @@ function TTBXPopupWindow.GetViewClass: TTBViewClass; begin Result := TTBXPopupView; end; +procedure TTBXPopupWindow.PaintScrollArrows; {vb+} + + function _GetPopupMargin: Integer; + begin + if View.ParentView <> nil then + Result := GetPopupMargin(TTBViewAccess(View.ParentView).OpenViewer) + else if View.ViewerCount > 0 then + Result := GetPopupMargin(View.Viewers[0]) + else Result := -1; + end; + + procedure DrawArrows; + var + ItemInfo: TTBXItemInfo; + Index: Integer; + begin + FillChar(ItemInfo, SizeOf(ItemInfo), 0); + ItemInfo.ViewType := PVT_POPUPMENU; + ItemInfo.Enabled := True; + ItemInfo.PopupMargin := _GetPopupMargin; + if ItemInfo.PopupMargin > 0 then + begin + if TTBViewAccess(View).ShowUpArrow then + for Index := 0 to View.ViewerCount- 1 do + if View.Viewers[Index].Show then + begin + CurrentTheme.PaintMenuItemFrame(Canvas, Rect(0, 0, ClientWidth, + View.Viewers[Index].BoundsRect.Top), ItemInfo); + Break; + end; + if TTBViewAccess(View).ShowDownArrow then + for Index := View.ViewerCount- 1 downto 0 do + if View.Viewers[Index].Show then + begin + CurrentTheme.PaintMenuItemFrame(Canvas, Rect(0, + View.Viewers[Index].BoundsRect.Bottom, ClientWidth, + ClientHeight), ItemInfo); + Break; + end; + end; + end; + +begin + with TTBViewAccess(View) do + if ShowUpArrow or ShowDownArrow then + DrawArrows; + inherited; +end; + procedure TTBXPopupWindow.TBMGetViewType(var Message: TMessage); var PI: TTBCustomItem; begin Message.Result := PVT_POPUPMENU; if View <> nil then @@ -2462,13 +2600,13 @@ R2 := CurrentDock.ClientRect; OffsetRect(R2, -Left, -Top); TDockAccess(CurrentDock).DrawBackground(DC, R2); if (Color = clNone) and CurrentDock.BackgroundOnToolbars then ACanvas.Brush.Style := bsClear; end - else + else begin ACanvas.Brush.Color := GetEffectiveColor(CurrentDock); ACanvas.FillRect(R); ACanvas.Brush.Color := EffectiveColor; ACanvas.Brush.Style := bsSolid; end; @@ -2533,12 +2671,18 @@ procedure TTBXToolbar.SetItemTransparency(const Value: TTBXItemTransparency); begin FItemTransparency := Value; Invalidate; end; +procedure TTBXToolbar.Loaded; {vb+} +begin + inherited; + UpdateEffectiveColor; +end; + procedure TTBXToolbar.SetParent(AParent: TWinControl); begin inherited; if AParent is TTBXFloatingWindowParent then TTBXFloatingWindowParent(AParent).SnapDistance := SnapDistance; end; @@ -2806,14 +2950,15 @@ function TTBXRootItem.GetPopupWindowClass: TTBPopupWindowClass; begin Result := TTBXPopupWindow; end; -procedure TTBXRootItem.OpenPopupEx(const SelectFirstItem, TrackRightButton: Boolean; - const ControlRect: TRect; const Alignment: TTBPopupAlignment); +function TTBXRootItem.OpenPopupEx(const SelectFirstItem, TrackRightButton: Boolean; + const ControlRect: TRect; const Alignment: TTBPopupAlignment; + const ReturnClickedItemOnly: Boolean): TTBCustomItem; var ModalHandler: TTBModalHandler; Popup: TTBPopupWindow; DoneActionData: TTBDoneActionData; State: TTBViewState; begin @@ -2834,37 +2979,45 @@ TTBViewAccess(Popup.View).SetState(State); Popup.Free; end; finally ModalHandler.Free; end; - ProcessDoneAction(DoneActionData); + Result := ProcessDoneAction(DoneActionData, ReturnClickedItemOnly); end; -procedure TTBXRootItem.PopupEx(const ControlRect: TRect; - TrackRightButton: Boolean; Alignment: TTBPopupAlignment); +function TTBXRootItem.PopupEx(const ControlRect: TRect; + TrackRightButton: Boolean; Alignment: TTBPopupAlignment = tbpaLeft; + ReturnClickedItemOnly: Boolean = False): TTBCustomItem; begin - OpenPopupEx(False, TrackRightButton, ControlRect, Alignment); + Result := OpenPopupEx(False, TrackRightButton, ControlRect, + Alignment, ReturnClickedItemOnly); end; //============================================================================// { TTBXPopupMenu } function TTBXPopupMenu.GetRootItemClass: TTBRootItemClass; begin Result := TTBXRootItem; end; -procedure TTBXPopupMenu.PopupEx(const ControlRect: TRect); +function TTBXPopupMenu.PopupEx(const ControlRect: TRect; + ReturnClickedItemOnly: Boolean = False): TTBCustomItem; begin {$IFDEF JR_D5} + {$IFDEF JR_D9} + SetPopupPoint(Point(ControlRect.Left, ControlRect.Bottom)); + {$ELSE} PPoint(@PopupPoint)^ := Point(ControlRect.Left, ControlRect.Bottom); {$ENDIF} - TTBXRootItem(Items).PopupEx(ControlRect, TrackButton = tbRightButton, TTBPopupAlignment(Alignment)) + {$ENDIF} + Result := TTBXRootItem(Items).PopupEx(ControlRect, TrackButton = tbRightButton, + TTBPopupAlignment(Alignment), ReturnClickedItemOnly); end; procedure TTBXPopupMenu.TBMGetViewType(var Message: TMessage); begin Message.Result := PVT_POPUPMENU; end; @@ -3403,13 +3556,15 @@ if Message.Msg = TBX_SYSCOMMAND then Broadcast(TBM_THEMECHANGE, Message.WParam, 0); end; procedure InitAdditionalSysColors; begin +{$IFNDEF JR_D7} {vb+} AddTBXColor(clHotLight, 'clHotLight'); +{$ENDIF} {vb+} {$IFNDEF JR_D6} AddTBXColor(clMoneyGreen, 'clMoneyGreen'); AddTBXColor(clSkyBlue, 'clSkyBlue'); AddTBXColor(clCream, 'clCream'); AddTBXColor(clMedGray, 'clMedGray'); {$ENDIF} @@ -3572,17 +3727,111 @@ begin FResizing := True; inherited; FResizing := False; end; +{ TTBXMenuAnimation } {vb+} + +constructor TTBXMenuAnimation.Create(AAnimationMode: TAnimationMode = amSysDefault); +begin + AnimationMode := AAnimationMode; +end; + +function TTBXMenuAnimation.GetAvailableModes: TAnimationModes; +var IsWindows2K: Boolean; +begin + Result := [amNone]; + IsWindows2K := (Win32Platform = VER_PLATFORM_WIN32_NT) and + CheckWin32Version(5); + if IsWindows2K or ((Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and + CheckWin32Version(4, 10){Win98}) then + Result := Result+ [amSysDefault, amRandom, amUnfold, amSlide]; + if IsWindows2K then + Include(Result, amFade); +end; + +function TTBXMenuAnimation.GetMenuAnimation: TMenuAnimation; + + function GetSysDefault: TMenuAnimation; + const + SPI_GETMENUFADE = $1012; + SysDefAni: array[Boolean] of TMenuAnimation = (maSlide, maFade); + begin + if SysParamEnabled(SPI_GETMENUANIMATION) + then Result := SysDefAni[SysParamEnabled(SPI_GETMENUFADE)] + else Result := maNone; + end; + + function GetRandom: TMenuAnimation; + var Max: Integer; + begin + Max := Ord(High(TMenuAnimation)); + if not (amFade in AvailableModes) then + Dec(Max); + Result := Succ(TMenuAnimation(Random(Max))); + end; + +begin + case AnimationMode of + amSysDefault: Result := GetSysDefault; + amRandom: Result := GetRandom; + amUnfold: Result := maUnfold; + amSlide: Result := maSlide; + amFade: Result := maFade; + else + Result := maNone; + end; +end; + +procedure TTBXMenuAnimation.SetAnimationMode(Value: TAnimationMode); +var AvailModes: TAnimationModes; +begin + AvailModes := AvailableModes; + while not (Value in AvailModes) do + Value := Pred(Value); + FAnimationMode := Value; +end; + +function TTBXMenuAnimation.SysParamEnabled(Param: Cardinal): Boolean; +var B: BOOL; +begin + Result := SystemParametersInfo(Param, 0, @B, 0) and B; +end; + +{ Work around delayed menu showing in Windows 2000+ } {vb+} +var + FixPlaySoundThreadHandle: Cardinal; + +function FixPlaySoundThreadFunc(Param: Pointer): Integer; stdcall; +begin + Sleep(250); + PlaySound(nil, 0, 0); + CloseHandle(FixPlaySoundThreadHandle); { Harakiri :~| } + Result := $4E494150; { :) } +end; + +procedure FixPlaySoundDelay; +var ThreadId: Cardinal; +begin + if (Win32Platform = VER_PLATFORM_WIN32_NT) and CheckWin32Version(5) and + (FixPlaySoundThreadHandle = 0) then + FixPlaySoundThreadHandle := CreateThread(nil, $1000, + @FixPlaySoundThreadFunc, nil, 0, ThreadId); +end; + initialization - CurrentTheme := nil; + FixPlaySoundDelay; {vb+} + {CurrentTheme := nil;} {vb-} RegisterTBXTheme('Default', TTBXDefaultTheme); TBXNexus := TTBXNexus.Create('Default'); + TBXMenuAnimation := TTBXMenuAnimation.Create; {vb+} + {$IFNDEF JR_D7} {vb+} InitAdditionalSysColors; + {$ENDIF} {vb+} finalization TBXNexus.Free; + FreeAndNil(TBXMenuAnimation); {vb+} ColorRegistry := nil; end. --- TBXAluminumTheme.pas 2004-05-25 22:02:56.000000000 +-0400 +++ TBXAluminumTheme.pas 2005-08-03 02:29:24.000000000 +-0400 @@ -441,12 +441,13 @@ end; function TTBXAluminumTheme.GetIntegerMetrics(Index: Integer): Integer; begin case Index of TMI_SPLITBTN_ARROWWIDTH: Result := 12; + TMI_MENU_LCAPTIONMARGIN: Result := 3; TMI_MENU_MDI_DW: Result := 1; TMI_MENU_MDI_DH: Result := 2; TMI_EDIT_FRAMEWIDTH: Result := 2; TMI_EDIT_TEXTMARGINHORZ: Result := 2; TMI_EDIT_TEXTMARGINVERT: Result := 1; TMI_EDIT_BTNWIDTH: Result := 14; @@ -573,18 +574,27 @@ end; procedure TTBXAluminumTheme.PaintCheckMark(Canvas: TCanvas; ARect: TRect; const ItemInfo: TTBXItemInfo); var DC: HDC; X, Y: Integer; + C: TColor; begin DC := Canvas.Handle; - X := (ARect.Left + ARect.Right) div 2 - 2; + X := (ARect.Left + ARect.Right) div 2 - 1; Y := (ARect.Top + ARect.Bottom) div 2 + 1; - PolyLineEx(DC, [Point(X-2, Y-2), Point(X, Y), Point(X+4, Y-4), - Point(X+4, Y-3), Point(X, Y+1), Point(X-2, Y-1), Point(X-2, Y-2)], GetBtnColor(ItemInfo, ipText)); + C := GetBtnColor(ItemInfo, ipText); + if ItemInfo.ItemOptions and IO_RADIO > 0 then + begin + RoundRectEx(DC, X-2, Y-4, X+4, Y+2, 2, 2, + MixColors(C, ToolbarColor, 200), clNone); + RoundRectEx(DC, X-2, Y-4, X+4, Y+2, 6, 6, C, C); + end + else + PolylineEx(DC, [Point(X-2, Y-2), Point(X, Y), Point(X+4, Y-4), + Point(X+4, Y-3), Point(X, Y+1), Point(X-2, Y-1), Point(X-2, Y-2)], C); end; procedure TTBXAluminumTheme.PaintDropDownArrow(Canvas: TCanvas; const ARect: TRect; const ItemInfo: TTBXItemInfo); var X, Y: Integer; --- TBXDefaultTheme.pas 2004-05-25 22:02:56.000000000 +-0400 +++ TBXDefaultTheme.pas 2005-08-03 01:58:42.000000000 +-0400 @@ -388,25 +388,36 @@ Brush.Style := bsSolid; end; end; procedure TTBXDefaultTheme.PaintCheckMark(Canvas: TCanvas; ARect: TRect; const ItemInfo: TTBXItemInfo); var + DC: HDC; X, Y: Integer; + C: TColor; begin + DC := Canvas.Handle; X := (ARect.Left + ARect.Right) div 2 - 1; - Y := (ARect.Top + ARect.Bottom) div 2 + 2; - if ItemInfo.Enabled then Canvas.Pen.Color := clBtnText - else Canvas.Pen.Color := clGrayText; - Canvas.Polyline([Point(X-2, Y-2), Point(X, Y), Point(X+4, Y-4), - Point(X+4, Y-3), Point(X, Y+1), Point(X-2, Y-1), Point(X-2, Y-2)]); - if ItemInfo.Enabled then - begin - Canvas.Pen.Color := clBtnHighlight; - Canvas.Polyline([Point(X-3, Y-2), Point(X-3, Y-1), Point(X, Y+2), - Point(X+5, Y-3), Point(X+5, Y-5)]); + Y := (ARect.Top + ARect.Bottom) div 2 + 1; + if ItemInfo.Enabled + then C := clBtnText + else C := clGrayText; + if ItemInfo.ItemOptions and IO_RADIO > 0 then + begin + RoundRectEx(DC, X-2, Y-4, X+4, Y+2, 2, 2, + MixColors(C, clBtnHighlight, 128), clNone); + RoundRectEx(DC, X-2, Y-4, X+4, Y+2, 6, 6, C, C); + if ItemInfo.Enabled then + RoundRectEx(DC, X-3, Y-5, X+5, Y+3, 6, 6, clBtnHighlight, clNone); + end + else begin + PolyLineEx(DC, [Point(X-2, Y-2), Point(X, Y), Point(X+4, Y-4), + Point(X+4, Y-3), Point(X, Y+1), Point(X-2, Y-1), Point(X-2, Y-2)], C); + if ItemInfo.Enabled then + PolyLineEx(DC, [Point(X-3, Y-2), Point(X-3, Y-1), Point(X, Y+2), + Point(X+5, Y-3), Point(X+5, Y-5)], clBtnHighlight); end; end; procedure TTBXDefaultTheme.PaintChevron(Canvas: TCanvas; ARect: TRect; const ItemInfo: TTBXItemInfo); const --- TBXDkPanels.pas 2004-05-29 18:16:02.000000000 +-0400 +++ TBXDkPanels.pas 2005-08-12 12:24:26.000000000 +-0400 @@ -18,13 +18,13 @@ const { New hit test constants for page scrollers } HTSCROLLPREV = 30; HTSCROLLNEXT = 31; type - { TTBXDockablePanel } + { TTBXControlMargins } TTBXControlMargins = class(TPersistent) private FLeft, FTop, FRight, FBottom: Integer; FOnChange: TNotifyEvent; procedure SetBottom(Value: Integer); @@ -47,47 +47,52 @@ TTBXMultiDock = class(TTBDock) protected LastValidRowSize: Integer; function Accepts(ADockableWindow: TTBCustomDockableWindow): Boolean; override; procedure ValidateInsert(AComponent: TComponent); override; public + procedure ArrangeToolbars; override; procedure Paint; override; procedure ResizeVisiblePanels(NewSize: Integer); - procedure ArrangeToolbars; override; end; - { TTBXDockablePanel } + { TTBXCustomDockablePanel } TDPCaptionRotation = (dpcrAuto, dpcrAlwaysHorz, dpcrAlwaysVert); TTBXResizingStage = (rsBeginResizing, rsResizing, rsEndResizing); TTBXDockedResizing = procedure(Sender: TObject; Vertical: Boolean; var NewSize: Integer; Stage: TTBXResizingStage; var AllowResize: Boolean) of object; TDockKinds = set of (dkStandardDock, dkMultiDock); - TTBXDockablePanel = class(TTBCustomDockableWindow) + {TTBXDockablePanel = class(TTBCustomDockableWindow)} {vb-} + TTBXCustomDockablePanel = class(TTBCustomDockableWindow) {vb+} private FBorderSize: Integer; FCaptionRotation: TDPCaptionRotation; FDockedWidth: Integer; FDockedHeight: Integer; FEffectiveColor: TColor; FFloatingWidth: Integer; FFloatingHeight: Integer; + FHorzResizeCursor: TCursor; {vb+} + FHorzSplitCursor : TCursor; {vb+} FIsResizing: Boolean; FIsSplitting: Boolean; FMinClientWidth: Integer; FMinClientHeight: Integer; FMaxClientWidth: Integer; FMaxClientHeight: Integer; FSmoothDockedResize: Boolean; FSnapDistance: Integer; FShowCaptionWhenDocked: Boolean; FSplitHeight: Integer; FSplitWidth: Integer; FSupportedDocks: TDockKinds; + FVertResizeCursor: TCursor; {vb+} + FVertSplitCursor : TCursor; {vb+} FOnDockedResizing: TTBXDockedResizing; function CalcSize(ADock: TTBDock): TPoint; procedure SetBorderSize(Value: Integer); procedure SetCaptionRotation(Value: TDPCaptionRotation); procedure SetDockedHeight(Value: Integer); procedure SetDockedWidth(Value: Integer); @@ -146,60 +151,96 @@ function GetFloatingBorderSize: TPoint; override; procedure ReadPositionData(const Data: TTBReadPositionData); override; procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override; procedure UpdateChildColors; procedure WritePositionData(const Data: TTBWritePositionData); override; property EffectiveColor: TColor read FEffectiveColor; - published + property CaptionRotation: TDPCaptionRotation read FCaptionRotation write SetCaptionRotation default dpcrAuto; + property Color default clNone; + property CloseButtonWhenDocked default True; + property DblClickUndock default False; { client size constraints should be restored before other size related properties } property MaxClientHeight: Integer read FMaxClientHeight write FMaxClientHeight default 0; property MaxClientWidth: Integer read FMaxClientWidth write FMaxClientWidth default 0; property MinClientHeight: Integer read FMinClientHeight write SetMinClientHeight default 32; property MinClientWidth: Integer read FMinClientWidth write SetMinClientWidth default 32; + property BorderSize: Integer read FBorderSize write SetBorderSize default 0; + property DockedWidth: Integer read FDockedWidth write SetDockedWidth default 128; + property DockedHeight: Integer read FDockedHeight write SetDockedHeight default 128; + property FloatingWidth: Integer read FFloatingWidth write SetFloatingWidth default 0; + property FloatingHeight: Integer read FFloatingHeight write SetFloatingHeight default 0; + property Height stored False; + property HorzResizeCursor: TCursor read FHorzResizeCursor write FHorzResizeCursor default crSizeWE; {vb+} + property HorzSplitCursor: TCursor read FHorzSplitCursor write FHorzSplitCursor default crHSplit; {vb+} + property ShowCaptionWhenDocked: Boolean read FShowCaptionWhenDocked write SetShowCaptionWhenDocked default True; + property SplitHeight: Integer read FSplitHeight write SetSplitHeight default 0; + property SplitWidth: Integer read FSplitWidth write SetSplitWidth default 0; + property SupportedDocks: TDockKinds read FSupportedDocks write FSupportedDocks; + property SmoothDockedResize: Boolean read FSmoothDockedResize write FSmoothDockedResize default True; + property SnapDistance: Integer read FSnapDistance write SetSnapDistance default 0; + property VertResizeCursor: TCursor read FVertResizeCursor write FVertResizeCursor default crSizeNS; {vb+} + property VertSplitCursor: TCursor read FVertSplitCursor write FVertSplitCursor default crVSplit; {vb+} + property Width stored False; + property OnDockedResizing: TTBXDockedResizing read FOnDockedResizing write FOnDockedResizing; + end; {vb+} + { TTBXDockablePanel } + + TTBXDockablePanel = class(TTBXCustomDockablePanel) {vb+} + published + { client size constraints should be restored before other size related properties } + property MaxClientHeight; + property MaxClientWidth; + property MinClientHeight; + property MinClientWidth; + property ActivateParent; property Align; property Anchors; - property BorderSize: Integer read FBorderSize write SetBorderSize default 0; + property BorderSize; property BorderStyle; property Caption; - property CaptionRotation: TDPCaptionRotation read FCaptionRotation write SetCaptionRotation default dpcrAuto; - property Color default clNone; + property CaptionRotation; + property Color; property CloseButton; - property CloseButtonWhenDocked default True; + property CloseButtonWhenDocked; property CurrentDock; - property DblClickUndock default False; + property DblClickUndock; property DefaultDock; property DockableTo; - property DockedWidth: Integer read FDockedWidth write SetDockedWidth default 128; - property DockedHeight: Integer read FDockedHeight write SetDockedHeight default 128; + property DockedWidth; + property DockedHeight; property DockMode; property DockPos; property DockRow; - property FloatingWidth: Integer read FFloatingWidth write SetFloatingWidth default 0; - property FloatingHeight: Integer read FFloatingHeight write SetFloatingHeight default 0; + property FloatingWidth; + property FloatingHeight; property FloatingMode; property Font; - property Height stored False; + property Height; property HideWhenInactive; + property HorzResizeCursor; {vb+} + property HorzSplitCursor; {vb+} property LastDock; property ParentFont; property ParentShowHint; property PopupMenu; property Resizable; property ShowCaption; - property ShowCaptionWhenDocked: Boolean read FShowCaptionWhenDocked write SetShowCaptionWhenDocked default True; + property ShowCaptionWhenDocked; property ShowHint; - property SplitHeight: Integer read FSplitHeight write SetSplitHeight default 0; - property SplitWidth: Integer read FSplitWidth write SetSplitWidth default 0; - property SupportedDocks: TDockKinds read FSupportedDocks write FSupportedDocks; + property SplitHeight; + property SplitWidth; + property SupportedDocks; property SmoothDrag; - property SmoothDockedResize: Boolean read FSmoothDockedResize write FSmoothDockedResize default True; - property SnapDistance: Integer read FSnapDistance write SetSnapDistance default 0; + property SmoothDockedResize; + property SnapDistance; property TabOrder; property UseLastDock; + property VertResizeCursor; {vb+} + property VertSplitCursor; {vb+} property Visible; property Width stored False; property OnClose; property OnCloseQuery; {$IFDEF JR_D5} @@ -207,13 +248,13 @@ {$ENDIF} property OnDragDrop; property OnDragOver; property OnDockChanged; property OnDockChanging; property OnDockChangingHidden; - property OnDockedResizing: TTBXDockedResizing read FOnDockedResizing write FOnDockedResizing; + property OnDockedResizing; property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnMove; property OnRecreated; property OnRecreating; @@ -390,12 +431,13 @@ end; { TTBXLabel } TTBXLabel = class(TTBXCustomLabel) published + property Action; {vb+} property Align; property Alignment; property Anchors; property AutoSize; property BiDiMode; property Caption; @@ -473,12 +515,13 @@ end; { TTBXLink } TTBXLink = class(TTBXCustomLink) published + property Action; {vb+} property Align; property Alignment; property Anchors; property AutoSize; property BiDiMode; property Caption; @@ -617,12 +660,13 @@ function GetControlsAlignment: TAlignment; override; end; { TTBXButton } TTBXButton = class(TTBXCustomButton) published + property Action; {vb+} property Align; property Alignment; property GroupIndex; property AllowAllUnchecked; property Anchors; property AutoSize; @@ -715,12 +759,13 @@ public constructor Create(AOwner: TComponent); override; end; TTBXCheckBox = class(TTBXCustomCheckBox) published + property Action; {vb+} property Align; property Alignment; property AllowGrayed; property Anchors; property AutoSize; property BiDiMode; @@ -800,12 +845,13 @@ public constructor Create(AOwner: TComponent); override; end; TTBXRadioButton = class(TTBXCustomRadioButton) published + property Action; {vb+} property Align; property Alignment; property Anchors; property AutoSize; property BiDiMode; property Caption; @@ -1205,22 +1251,35 @@ var NewDockList: TList; PosData: array of TPosRec; LeftRight: Boolean; I, J, K, L, DragIndex, ResizeIndex, ForcedWidth: Integer; EmptySize, ClientW, ClientH, DockSize, TotalSize, TotalMinimumSize, TotalMaximumSize: Integer; - DragIndexPos: Integer; + {DragIndexPos: Integer;} {vb-} T: TTBXDockablePanel; S: TPoint; CurRowPixel, CurRowSize: Integer; StretchPanelCount: Integer; Stretching: Boolean; AccDelta, Acc: Extended; Delta, IntAcc: Integer; MinWidth, MaxWidth, EffectiveMinWidth, EffectiveMaxWidth: Integer; R: TRect; + + function IndexOfDraggingToolbar(const List: TList): Integer; {vb+} + { Returns index of toolbar in List that's currently being dragged, or -1 } + var + I: Integer; + begin + for I := 0 to List.Count-1 do + if TTBCustomDockableWindow(List[I]).DragMode then begin + Result := I; + Exit; + end; + Result := -1; + end; procedure GetSizes(Panel: TTBXDockablePanel; out Size, MinSize, MaxSize: Integer); var Sz: TPoint; MinWidth, MinHeight, MaxWidth, MaxHeight: Integer; begin @@ -1305,16 +1364,20 @@ { Copy DockList to NewDockList, and ensure it is in correct ordering according to DockRow/DockPos } NewDockList := TList.Create; NewDockList.Count := DockList.Count; for I := 0 to NewDockList.Count - 1 do NewDockList[I] := DockList[I]; - I := NewDockList.IndexOf(DragToolbar); + {I := NewDockList.IndexOf(DragToolbar); {vb-} + I := IndexOfDraggingToolbar(NewDockList); {vb+} ListSortEx(NewDockList, CompareDockPos, nil); - DragIndex := NewDockList.IndexOf(DragToolbar); - if (I <> -1) and DragSplitting then + {DragIndex := NewDockList.IndexOf(DragToolbar); {vb-} + DragIndex := IndexOfDraggingToolbar(NewDockList); {vb+} + {if (I <> -1) and DragSplitting then {vb-} + if (I <> -1) and + TTBCustomDockableWindow(NewDockList[DragIndex]).DragSplitting then {vb+} begin { When splitting, don't allow the toolbar being dragged to change positions in the dock list } NewDockList.Move(DragIndex, I); DragIndex := I; end; @@ -1345,18 +1408,18 @@ begin DragIndex := I; Break; end; { Count total sizes and set initial positions } - DragIndexPos := 0; + {DragIndexPos := 0;} {vb-} TotalSize := 0; TotalMinimumSize := 0; TotalMaximumSize := 0; for I := 0 to Length(PosData) - 1 do with PosData[I] do begin - if I = DragIndex then DragIndexPos := Panel.DockPos; + {if I = DragIndex then DragIndexPos := Panel.DockPos;} {vb-} Pos := TotalSize; Inc(TotalSize, Size); Inc(TotalMinimumSize, MinSize); Inc(TotalMaximumSize, MaxSize); end; @@ -1815,19 +1878,19 @@ end; //----------------------------------------------------------------------------// { TTBXDockablePanel } -procedure TTBXDockablePanel.AdjustClientRect(var Rect: TRect); +procedure TTBXCustomDockablePanel.AdjustClientRect(var Rect: TRect); begin inherited AdjustClientRect(Rect); if BorderSize <> 0 then InflateRect(Rect, -BorderSize, -BorderSize); end; -procedure TTBXDockablePanel.BeginDockedSizing(HitTest: Integer); +procedure TTBXCustomDockablePanel.BeginDockedSizing(HitTest: Integer); var OrigPos, OldPos: TPoint; Msg: TMsg; DockRect, DragRect, OrigDragRect, OldDragRect: TRect; NCSizes: TPoint; EdgeRect, OldEdgeRect: TRect; @@ -1973,19 +2036,20 @@ finally if GetCapture = Handle then ReleaseCapture; CommitResizing := DoEndDockedResizing(HitTest in [HTTOP, HTBOTTOM]); if EraseEdgeRect then begin DrawDraggingOutline(ScreenDC, Rect(0, 0, 0, 0), OldEdgeRect); - if CommitResizing then with OldDragRect do - begin - BlockSizeUpdate := True; - if LeftRight then DockedWidth := Right - Left - NCSizes.X - else DockedHeight := Bottom - Top - NCSizes.Y; - BlockSizeUpdate := False; - end; + if CommitResizing and not IsRectEmpty(OldDragRect) then + with OldDragRect do + begin + BlockSizeUpdate := True; + if LeftRight then DockedWidth := Right - Left - NCSizes.X + else DockedHeight := Bottom - Top - NCSizes.Y; + BlockSizeUpdate := False; + end; end else if not CommitResizing then begin BlockSizeUpdate := True; BoundsRect := RectToClient(OrigDragRect); BlockSizeUpdate := False; @@ -1997,13 +2061,13 @@ Form := GetParentForm(Self); if (Form <> nil) and (Form.Designer <> nil) then Form.Designer.Modified; end; end; end; -procedure TTBXDockablePanel.BeginSplitResizing(HitTest: Integer); +procedure TTBXCustomDockablePanel.BeginSplitResizing(HitTest: Integer); type TPosRec = record Panel: TTBXDockablePanel; OrigPos, OrigSize, OrigWidth, Pos, Size, MinSize, MaxSize: Integer; end; var @@ -2012,13 +2076,14 @@ I: Integer; LeftRight, Smooth, CommitResizing: Boolean; DockSize, TotalSize, TotalMinSize, TotalMaxSize: Integer; OrigCursorPos, OldCursorPos: TPoint; Msg: TMsg; EffectiveIndex: Integer; - EffectivePanel: TTBXDockablePanel; + {EffectivePanel: TTBXDockablePanel;} {vb-} + EffectivePanel: TTBXCustomDockablePanel; {vb+} PanelRect, DockRect, EdgeRect, OrigEdgeRect, OldEdgeRect: TRect; EdgePosition: TTBDockPosition; ScreenDC: HDC; EraseEdgeRect: Boolean; Form: TCustomForm; Delta: Integer; @@ -2339,13 +2404,13 @@ Form := GetParentForm(Self); if (Form <> nil) and (Form.Designer <> nil) then Form.Designer.Modified; end; end; end; -function TTBXDockablePanel.CalcNCSizes: TPoint; +function TTBXCustomDockablePanel.CalcNCSizes: TPoint; begin if not Docked then begin Result.X := 0; Result.Y := 0; end @@ -2356,13 +2421,13 @@ if ShowCaptionWhenDocked then if IsVertCaption then Inc(Result.X, GetSystemMetrics(SM_CYSMCAPTION)) else Inc(Result.Y, GetSystemMetrics(SM_CYSMCAPTION)); end; end; -function TTBXDockablePanel.CalcSize(ADock: TTBDock): TPoint; +function TTBXCustomDockablePanel.CalcSize(ADock: TTBDock): TPoint; begin if Assigned(ADock) then begin if ADock.Position in [dpLeft, dpRight] then begin Result.X := FDockedWidth; @@ -2395,18 +2460,18 @@ Result.X := FFloatingWidth; Result.Y := FFloatingHeight; end; end; -function TTBXDockablePanel.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; +function TTBXCustomDockablePanel.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; begin Result := True; end; -function TTBXDockablePanel.CanDockTo(ADock: TTBDock): Boolean; +function TTBXCustomDockablePanel.CanDockTo(ADock: TTBDock): Boolean; begin Result := inherited CanDockTo(ADock); if Result then begin if ADock is TTBXMultiDock then begin @@ -2416,13 +2481,13 @@ begin Result := dkStandardDock in SupportedDocks;; end; end; end; -function TTBXDockablePanel.CanSplitResize(EdgePosition: TTBDockPosition): Boolean; +function TTBXCustomDockablePanel.CanSplitResize(EdgePosition: TTBDockPosition): Boolean; var Dock: TDockAccess; begin Result := Docked and (CurrentDock is TTBXMultiDock) and HandleAllocated; if not Result then Exit; Dock := TDockAccess(CurrentDock); @@ -2444,60 +2509,64 @@ else Result := False; end; end; end; -procedure TTBXDockablePanel.CMColorChanged(var Message: TMessage); +procedure TTBXCustomDockablePanel.CMColorChanged(var Message: TMessage); begin UpdateEffectiveColor; Brush.Color := Color; if Docked and HandleAllocated then begin RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE or RDW_ERASE or RDW_UPDATENOW or RDW_ALLCHILDREN); end; Invalidate; UpdateChildColors; end; -procedure TTBXDockablePanel.CMControlChange(var Message: TCMControlChange); +procedure TTBXCustomDockablePanel.CMControlChange(var Message: TCMControlChange); begin inherited; if Message.Inserting and (Color = clNone) then Message.Control.Perform(CM_PARENTCOLORCHANGED, 1, EffectiveColor); end; -procedure TTBXDockablePanel.CMTextChanged(var Message: TMessage); +procedure TTBXCustomDockablePanel.CMTextChanged(var Message: TMessage); begin inherited; if HandleAllocated then begin if Docked then RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE) else RedrawWindow(TTBXFloatingWindowParent(Parent).Handle, nil, 0, RDW_FRAME or RDW_INVALIDATE); end; end; -procedure TTBXDockablePanel.ConstrainedResize(var MinWidth, MinHeight, MaxWidth, MaxHeight: Integer); +procedure TTBXCustomDockablePanel.ConstrainedResize(var MinWidth, MinHeight, MaxWidth, MaxHeight: Integer); var Sz: TPoint; begin Sz := CalcNCSizes; if MinClientWidth > 0 then MinWidth := MinClientWidth + Sz.X; if MinClientHeight > 0 then MinHeight := MinClientHeight + Sz.Y; if MaxClientWidth > 0 then MaxWidth := MaxClientWidth + Sz.X; if MaxClientHeight > 0 then MaxHeight := MaxClientHeight + Sz.Y; end; -constructor TTBXDockablePanel.Create(AOwner: TComponent); +constructor TTBXCustomDockablePanel.Create(AOwner: TComponent); begin inherited; FMinClientWidth := 32; FMinClientHeight := 32; FDockedWidth := 128; FDockedHeight := 128; + FHorzResizeCursor := crSizeWE; {vb+} + FHorzSplitCursor := crHSplit; {vb+} + FVertResizeCursor := crSizeNS; {vb+} + FVertSplitCursor := crVSplit; {vb+} CloseButtonWhenDocked := True; DblClickUndock := False; FShowCaptionWhenDocked := True; FSmoothDockedResize := True; BlockSizeUpdate := True; SetBounds(Left, Top, 128, 128); @@ -2505,36 +2574,36 @@ FullSize := True; Color := clNone; AddThemeNotification(Self); SupportedDocks := [dkStandardDock, dkMultiDock]; end; -destructor TTBXDockablePanel.Destroy; +destructor TTBXCustomDockablePanel.Destroy; begin RemoveThemeNotification(Self); inherited; end; -function TTBXDockablePanel.DoArrange(CanMoveControls: Boolean; +function TTBXCustomDockablePanel.DoArrange(CanMoveControls: Boolean; PreviousDockType: TTBDockType; NewFloating: Boolean; NewDock: TTBDock): TPoint; begin Result := CalcSize(NewDock); end; -function TTBXDockablePanel.DoBeginDockedResizing(Vertical: Boolean): Boolean; +function TTBXCustomDockablePanel.DoBeginDockedResizing(Vertical: Boolean): Boolean; var Sz: Integer; begin Result := True; if Vertical then Sz := Height else Sz := Width; if Assigned(FOnDockedResizing) then FOnDockedResizing(Self, Vertical, Sz, rsBeginResizing, Result); if Result then if Vertical then Height := Sz else Width := Sz; end; -function TTBXDockablePanel.DoDockedResizing(Vertical: Boolean; var NewSize: Integer): Boolean; +function TTBXCustomDockablePanel.DoDockedResizing(Vertical: Boolean; var NewSize: Integer): Boolean; const MIN_PARENT_CLIENT_SIZE = 32; var NCSizes: TPoint; CW, CH: Integer; DockParent: TWinControl; @@ -2564,25 +2633,25 @@ NewSize := CH + NCSizes.Y; end; Result := True; if Assigned(FOnDockedResizing) then FOnDockedResizing(Self, Vertical, NewSize, rsResizing, Result); end; -function TTBXDockablePanel.DoEndDockedResizing(Vertical: Boolean): Boolean; +function TTBXCustomDockablePanel.DoEndDockedResizing(Vertical: Boolean): Boolean; var Sz: Integer; begin Result := True; if Vertical then Sz := Height else Sz := Width; if Assigned(FOnDockedResizing) then FOnDockedResizing(Self, Vertical, Sz, rsEndResizing, Result); if Result then if Vertical then Height := Sz else Width := Sz; end; -procedure TTBXDockablePanel.DrawNCArea(const DrawToDC: Boolean; +procedure TTBXCustomDockablePanel.DrawNCArea(const DrawToDC: Boolean; const ADC: HDC; const Clip: HRGN); var DC: HDC; R, CR: TRect; ACanvas: TCanvas; Sz: Integer; @@ -2628,18 +2697,18 @@ end; finally if not DrawToDC then ReleaseDC(Handle, DC); end; end; -procedure TTBXDockablePanel.GetBaseSize(var ASize: TPoint); +procedure TTBXCustomDockablePanel.GetBaseSize(var ASize: TPoint); begin ASize := CalcSize(CurrentDock); end; -function TTBXDockablePanel.GetDockedCloseButtonRect(LeftRight: Boolean): TRect; +function TTBXCustomDockablePanel.GetDockedCloseButtonRect(LeftRight: Boolean): TRect; var X, Y, Z: Integer; begin Z := GetSystemMetrics(SM_CYSMCAPTION) - 1; if LeftRight or not IsVertCaption then begin @@ -2651,13 +2720,13 @@ X := DockedBorderSize; Y := ClientHeight + DockedBorderSize - Z; end; Result := Bounds(X, Y, Z, Z); end; -procedure TTBXDockablePanel.GetDockPanelInfo(out DockPanelInfo: TTBXDockPanelInfo); +procedure TTBXCustomDockablePanel.GetDockPanelInfo(out DockPanelInfo: TTBXDockPanelInfo); begin FillChar(DockPanelInfo, SizeOf(DockPanelInfo), 0); DockPanelInfo.WindowHandle := WindowHandle; DockPanelInfo.ViewType := GetViewType; if CurrentDock <> nil then DockPanelInfo.IsVertical := not IsVertCaption; DockPanelInfo.AllowDrag := CurrentDock.AllowDrag; @@ -2672,105 +2741,105 @@ DockPanelInfo.CloseButtonState := CDBS_VISIBLE; if CloseButtonDown then DockPanelInfo.CloseButtonState := DockPanelInfo.CloseButtonState or CDBS_PRESSED; if CloseButtonHover then DockPanelInfo.CloseButtonState := DockPanelInfo.CloseButtonState or CDBS_HOT; end; end; -function TTBXDockablePanel.GetFloatingBorderSize: TPoint; +function TTBXCustomDockablePanel.GetFloatingBorderSize: TPoint; begin CurrentTheme.GetViewBorder(GetViewType or DPVT_FLOATING, Result); end; -function TTBXDockablePanel.GetFloatingWindowParentClass: TTBFloatingWindowParentClass; +function TTBXCustomDockablePanel.GetFloatingWindowParentClass: TTBFloatingWindowParentClass; begin Result := TTBXFloatingWindowParent; end; -procedure TTBXDockablePanel.GetMinMaxSize(var AMinClientWidth, AMinClientHeight, +procedure TTBXCustomDockablePanel.GetMinMaxSize(var AMinClientWidth, AMinClientHeight, AMaxClientWidth, AMaxClientHeight: Integer); begin AMinClientWidth := FMinClientWidth; AMinClientHeight := FMinClientHeight; AMaxClientWidth := FMaxClientWidth; AMaxClientHeight := FMaxClientHeight; end; -function TTBXDockablePanel.GetViewType: Integer; +function TTBXCustomDockablePanel.GetViewType: Integer; begin Result := DPVT_NORMAL; if Floating then Result := Result or DPVT_FLOATING; if Resizable then Result := Result or DPVT_RESIZABLE; end; -function TTBXDockablePanel.IsVertCaption: Boolean; +function TTBXCustomDockablePanel.IsVertCaption: Boolean; begin case CaptionRotation of dpcrAlwaysHorz: Result := False; dpcrAlwaysVert: Result := Docked; else // dpcrAuto: Result := Docked and (CurrentDock.Position in [dpTop, dpBottom]); end; end; -procedure TTBXDockablePanel.Loaded; +procedure TTBXCustomDockablePanel.Loaded; begin inherited; UpdateChildColors; end; -procedure TTBXDockablePanel.Paint; +procedure TTBXCustomDockablePanel.Paint; begin if csDesigning in ComponentState then with Canvas do begin Pen.Style := psDot; Pen.Color := clBtnShadow; Brush.Style := bsClear; with ClientRect do Rectangle(Left, Top, Right, Bottom); Pen.Style := psSolid; end; end; -procedure TTBXDockablePanel.ReadPositionData(const Data: TTBReadPositionData); +procedure TTBXCustomDockablePanel.ReadPositionData(const Data: TTBReadPositionData); begin with Data do begin FDockedWidth := ReadIntProc(Name, rvDockedWidth, FDockedWidth, ExtraData); FDockedHeight := ReadIntProc(Name, rvDockedHeight, FDockedHeight, ExtraData); FFloatingWidth := ReadIntProc(Name, rvFloatingWidth, FFloatingWidth, ExtraData); FFloatingHeight := ReadIntProc(Name, rvFloatingHeight, FFloatingHeight, ExtraData); FSplitWidth := ReadIntProc(Name, rvSplitWidth, FSplitWidth, ExtraData); FSplitHeight := ReadIntProc(Name, rvSplitHeight, FSplitHeight, ExtraData); end; end; -procedure TTBXDockablePanel.SetBorderSize(Value: Integer); +procedure TTBXCustomDockablePanel.SetBorderSize(Value: Integer); begin if FBorderSize <> Value then begin FBorderSize := Value; Realign; end; end; -procedure TTBXDockablePanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); +procedure TTBXCustomDockablePanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer); begin inherited SetBounds(ALeft, ATop, AWidth, AHeight); end; -procedure TTBXDockablePanel.SetCaptionRotation(Value: TDPCaptionRotation); +procedure TTBXCustomDockablePanel.SetCaptionRotation(Value: TDPCaptionRotation); begin if FCaptionRotation <> Value then begin FCaptionRotation := Value; if Docked and HandleAllocated then SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER); end; end; -procedure TTBXDockablePanel.SetDockedHeight(Value: Integer); +procedure TTBXCustomDockablePanel.SetDockedHeight(Value: Integer); begin if Value < MinClientHeight then Value := MinClientHeight; if Value <> FDockedHeight then begin FDockedHeight := Value; if Docked and (CurrentDock.Position in [dpTop, dpBottom]) then @@ -2779,13 +2848,13 @@ Height := Value + CalcNCSizes.Y; BlockSizeUpdate := False; end; end; end; -procedure TTBXDockablePanel.SetDockedWidth(Value: Integer); +procedure TTBXCustomDockablePanel.SetDockedWidth(Value: Integer); begin if Value < MinClientWidth then Value := MinClientWidth; if Value <> FDockedWidth then begin FDockedWidth := Value; if Docked and (CurrentDock.Position in [dpLeft, dpRight]) then @@ -2794,13 +2863,13 @@ Width := Value + CalcNCSizes.X; BlockSizeUpdate := False; end; end; end; -procedure TTBXDockablePanel.SetFloatingHeight(Value: Integer); +procedure TTBXCustomDockablePanel.SetFloatingHeight(Value: Integer); begin { FloatingHeight (and floating width) can be set to 0 while panel is docked. This will force to restore floating dimensions from docked size } if Value < 0 then Value := 0; if not Docked and (Value < MinClientHeight) then Value := MinClientHeight; if Value <> FFloatingHeight then @@ -2812,13 +2881,13 @@ Height := Value + CalcNCSizes.Y; BlockSizeUpdate := False; end; end; end; -procedure TTBXDockablePanel.SetFloatingWidth(Value: Integer); +procedure TTBXCustomDockablePanel.SetFloatingWidth(Value: Integer); begin { See comment for TTBXDockablePanel.SetFloatingHeight } if Value < 0 then Value := 0; if not Docked and (Value < MinClientWidth) then Value := MinClientWidth; if Value <> FFloatingWidth then begin @@ -2829,32 +2898,32 @@ Width := Value + CalcNCSizes.X; BlockSizeUpdate := False; end; end; end; -procedure TTBXDockablePanel.SetMinClientHeight(Value: Integer); +procedure TTBXCustomDockablePanel.SetMinClientHeight(Value: Integer); begin if Value < 8 then Value := 8; FMinClientHeight := Value; end; -procedure TTBXDockablePanel.SetMinClientWidth(Value: Integer); +procedure TTBXCustomDockablePanel.SetMinClientWidth(Value: Integer); begin if Value < 8 then Value := 8; FMinClientWidth := Value; end; -procedure TTBXDockablePanel.SetParent(AParent: TWinControl); +procedure TTBXCustomDockablePanel.SetParent(AParent: TWinControl); begin inherited; if AParent is TTBXFloatingWindowParent then TTBXFloatingWindowParent(AParent).SnapDistance := SnapDistance; end; -procedure TTBXDockablePanel.SetShowCaptionWhenDocked(Value: Boolean); +procedure TTBXCustomDockablePanel.SetShowCaptionWhenDocked(Value: Boolean); begin if FShowCaptionWhenDocked <> Value then begin FShowCaptionWhenDocked := Value; if Docked then begin @@ -2862,43 +2931,43 @@ SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER); end; end; end; -procedure TTBXDockablePanel.SetSnapDistance(Value: Integer); +procedure TTBXCustomDockablePanel.SetSnapDistance(Value: Integer); begin if Value < 0 then Value := 0; FSnapDistance := Value; if (Parent <> nil) and (Parent is TTBXFloatingWindowParent) then TTBXFloatingWindowParent(Parent).SnapDistance := Value; end; -procedure TTBXDockablePanel.SetSplitHeight(Value: Integer); +procedure TTBXCustomDockablePanel.SetSplitHeight(Value: Integer); begin if Value < 0 then Value := 0; if FSplitHeight <> Value then begin FSplitHeight := Value; if Docked and (CurrentDock.Position in [dpLeft, dpRight]) and (CurrentDock is TTBXMultiDock) then CurrentDock.ArrangeToolbars; end; end; -procedure TTBXDockablePanel.SetSplitWidth(Value: Integer); +procedure TTBXCustomDockablePanel.SetSplitWidth(Value: Integer); begin if Value < 0 then Value := 0; if FSplitWidth <> Value then begin FSplitWidth := Value; if Docked and (CurrentDock.Position in [dpTop, dpBottom]) and (CurrentDock is TTBXMultiDock) then CurrentDock.ArrangeToolbars; end; end; -procedure TTBXDockablePanel.SizeChanging(const AWidth, AHeight: Integer); +procedure TTBXCustomDockablePanel.SizeChanging(const AWidth, AHeight: Integer); begin if not BlockSizeUpdate then begin if Docked and (CurrentDock.Position in [dpLeft, dpRight]) then FDockedWidth := AWidth - CalcNCSizes.X else if Floating then @@ -2908,24 +2977,24 @@ FDockedHeight := AHeight - CalcNCSizes.Y else if Floating then FFloatingHeight := AHeight - CalcNCSizes.Y; end; end; -procedure TTBXDockablePanel.TBMGetEffectiveColor(var Message: TMessage); +procedure TTBXCustomDockablePanel.TBMGetEffectiveColor(var Message: TMessage); begin Message.WParam := EffectiveColor; Message.Result := 1; end; -procedure TTBXDockablePanel.TBMGetViewType(var Message: TMessage); +procedure TTBXCustomDockablePanel.TBMGetViewType(var Message: TMessage); begin Message.Result := GetViewType; end; -procedure TTBXDockablePanel.TBMThemeChange(var Message: TMessage); +procedure TTBXCustomDockablePanel.TBMThemeChange(var Message: TMessage); var M: TMessage; begin case Message.WParam of TSC_BEFOREVIEWCHANGE: BeginUpdate; TSC_AFTERVIEWCHANGE: @@ -2947,53 +3016,53 @@ M.Result := 0; Broadcast(M); end; end; end; -procedure TTBXDockablePanel.UpdateChildColors; +procedure TTBXCustomDockablePanel.UpdateChildColors; var M: TMessage; begin M.Msg := CM_PARENTCOLORCHANGED; M.WParam := 1; M.LParam := EffectiveColor; M.Result := 0; Broadcast(M); end; -procedure TTBXDockablePanel.UpdateEffectiveColor; +procedure TTBXCustomDockablePanel.UpdateEffectiveColor; begin if Color = clNone then FEffectiveColor := CurrentTheme.GetViewColor(GetViewType) else FEffectiveColor := Color; end; -procedure TTBXDockablePanel.WMEraseBkgnd(var Message: TWMEraseBkgnd); +procedure TTBXCustomDockablePanel.WMEraseBkgnd(var Message: TWMEraseBkgnd); var BRUSH: HBRUSH; begin BRUSH := CreateSolidBrush(ColorToRGB(EffectiveColor)); FillRect(Message.DC, Clientrect, BRUSH); DeleteObject(BRUSH); Message.Result := 1; end; -procedure TTBXDockablePanel.WMNCCalcSize(var Message: TWMNCCalcSize); +procedure TTBXCustomDockablePanel.WMNCCalcSize(var Message: TWMNCCalcSize); begin Message.Result := 0; if Docked then with Message.CalcSize_Params^ do begin InflateRect(rgrc[0], -DockedBorderSize, -DockedBorderSize); if ShowCaptionWhenDocked then if IsVertCaption then Inc(rgrc[0].Left, GetSystemMetrics(SM_CYSMCAPTION)) else Inc(rgrc[0].Top, GetSystemMetrics(SM_CYSMCAPTION)) end; end; -procedure TTBXDockablePanel.WMNCHitTest(var Message: TWMNCHitTest); +procedure TTBXCustomDockablePanel.WMNCHitTest(var Message: TWMNCHitTest); const CResizeMargin = 2; var P: TPoint; R: TRect; Sz: Integer; @@ -3072,13 +3141,13 @@ end; end; end else inherited; end; -procedure TTBXDockablePanel.WMNCLButtonDown(var Message: TWMNCLButtonDown); +procedure TTBXCustomDockablePanel.WMNCLButtonDown(var Message: TWMNCLButtonDown); var OldCursor: HCURSOR; begin if Message.HitTest in [HTLEFT..HTBOTTOM] then BeginDockedSizing(Message.HitTest) else if Message.HitTest in [HT_TBX_SPLITRESIZELEFT..HT_TBX_SPLITRESIZEBOTTOM] then BeginSplitResizing(Message.HitTest) else @@ -3093,42 +3162,66 @@ end; end else inherited; end; end; -procedure TTBXDockablePanel.WMSetCursor(var Message: TWMSetCursor); +procedure TTBXCustomDockablePanel.WMSetCursor(var Message: TWMSetCursor); +var Cur: TCursor; {vb+} begin - if Docked and CurrentDock.AllowDrag and - (Message.CursorWnd = WindowHandle) and - (Smallint(Message.HitTest) = HT_TB2k_Border) and - ShowCaptionWhenDocked then - begin - SetCursor(LoadCursor(0, IDC_ARROW)); - Message.Result := 1; - Exit; - end - else if Docked and CurrentDock.AllowDrag and (Message.CursorWnd = WindowHandle) then - begin - if (Message.HitTest = HT_TBX_SPLITRESIZELEFT) or (Message.HitTest = HT_TBX_SPLITRESIZERIGHT) then - begin - SetCursor(LoadCursor(0, IDC_SIZEWE)); - Message.Result := 1; - Exit; - end - else if (Message.HitTest = HT_TBX_SPLITRESIZETOP) or (Message.HitTest = HT_TBX_SPLITRESIZEBOTTOM) then + {if Docked and CurrentDock.AllowDrag and + (Message.CursorWnd = WindowHandle) and + (Smallint(Message.HitTest) = HT_TB2k_Border) and + ShowCaptionWhenDocked then + begin + SetCursor(LoadCursor(0, IDC_ARROW)); + Message.Result := 1; + Exit; + end + else if Docked and CurrentDock.AllowDrag and (Message.CursorWnd = WindowHandle) then + begin + if (Message.HitTest = HT_TBX_SPLITRESIZELEFT) or (Message.HitTest = HT_TBX_SPLITRESIZERIGHT) then + begin + SetCursor(LoadCursor(0, IDC_SIZEWE)); + Message.Result := 1; + Exit; + end + else if (Message.HitTest = HT_TBX_SPLITRESIZETOP) or (Message.HitTest = HT_TBX_SPLITRESIZEBOTTOM) then + begin + SetCursor(LoadCursor(0, IDC_SIZENS)); + Message.Result := 1; + Exit; + end; + end; } {vb-} + if Docked and CurrentDock.AllowDrag and + (Message.CursorWnd = WindowHandle) then + begin + Cur := crNone; + case Message.HitTest of + HTLEFT, HTRIGHT: + Cur := HorzResizeCursor; + HTTOP, HTBOTTOM: + Cur := VertResizeCursor; + HT_TBX_SPLITRESIZELEFT, HT_TBX_SPLITRESIZERIGHT: + Cur := HorzSplitCursor; + HT_TBX_SPLITRESIZETOP, HT_TBX_SPLITRESIZEBOTTOM: + Cur := VertSplitCursor; + HT_TB2k_Border: + if ShowCaptionWhenDocked then Cur := crArrow; + end; + if Cur <> crNone then begin - SetCursor(LoadCursor(0, IDC_SIZENS)); + SetCursor(Screen.Cursors[Cur]); Message.Result := 1; Exit; end; end; inherited; end; -procedure TTBXDockablePanel.WMWindowPosChanged(var Message: TWMWindowPosChanged); +procedure TTBXCustomDockablePanel.WMWindowPosChanged(var Message: TWMWindowPosChanged); begin inherited; if (Message.WindowPos^.flags and SWP_NOSIZE) = 0 then begin Realign; Update; @@ -3137,13 +3230,13 @@ begin UpdateEffectiveColor; UpdateChildColors; end; end; -procedure TTBXDockablePanel.WritePositionData(const Data: TTBWritePositionData); +procedure TTBXCustomDockablePanel.WritePositionData(const Data: TTBWritePositionData); begin with Data do begin WriteIntProc(Name, rvDockedWidth, FDockedWidth, ExtraData); WriteIntProc(Name, rvDockedHeight, FDockedHeight, ExtraData); WriteIntProc(Name, rvFloatingWidth, FFloatingWidth, ExtraData); @@ -3214,13 +3307,13 @@ AdjustHeight; end; constructor TTBXTextObject.Create(AOwner: TComponent); begin inherited; - ControlStyle := ControlStyle + [csSetCaption] - [csDoubleClicks]; + ControlStyle := ControlStyle + [csSetCaption, csDoubleClicks]; FMargins := TTBXControlMargins.Create; FMargins.OnChange := MarginsChangeHandler; FShowAccelChar := True; PaintOptions := [cpoDoubleBuffered]; AutoSize := True; Width := 100; --- TBXExtItems.pas 2004-05-25 22:02:56.000000000 +-0400 +++ TBXExtItems.pas 2005-08-11 13:41:06.000000000 +-0400 @@ -645,13 +645,14 @@ begin Edit.Text := S2; Edit.SelStart := Length(S); Edit.SelLength := Length(S2) - Length(S); S := S2; end; - if S <> FLastEditChange then + {if S <> FLastEditChange then} {vb-} + if AnsiCompareText(S, FLastEditChange) <> 0 then {vb+} begin DoChange(S); // note, Edit.Text may be different from Self.Text FLastEditChange := S; end; finally FIsChanging := False; @@ -1121,13 +1122,16 @@ function TTBXDropDownItemViewer.HandleEditMessage(var Message: TMessage): Boolean; begin if Message.Msg = WM_KEYDOWN then begin if TWMKeyDown(Message).CharCode = VK_F4 then begin - TTBViewAccess(View).OpenChildPopup(True); + {TTBViewAccess(View).OpenChildPopup(True);} {vb-} + if (View.OpenViewer = Self) // WasAlreadyOpen {vb+} + then View.CloseChildPopups + else View.OpenChildPopup(True); Result := True; Exit; end; end; Result := inherited HandleEditMessage(Message); @@ -1399,21 +1403,23 @@ begin if (Message.Msg = WM_KEYDOWN) then with TTBXComboBoxItem(Item) do begin case Message.wParam of VK_UP: begin - ItemIndex := ItemIndex - 1; + if ItemIndex > 0 then {vb+} + ItemIndex := ItemIndex- 1; EditControl.Text := Text; EditControl.SelectAll; Result := True; end; VK_DOWN: begin - ItemIndex := ItemIndex + 1; + if ItemIndex < Strings.Count- 1 then {vb+} + ItemIndex := ItemIndex+ 1; EditControl.Text := Text; EditControl.SelectAll; Result := True; end; else Result := inherited HandleEditMessage(Message); --- TBXLists.pas 2004-02-21 02:07:54.000000000 +-0400 +++ TBXLists.pas 2005-08-07 00:27:10.000000000 +-0400 @@ -188,12 +188,14 @@ procedure MouseMove(X, Y: Integer); override; procedure MouseUp(X, Y: Integer; MouseWasDownOnMenu: Boolean); override; procedure MouseWheel(WheelDelta: Integer; X, Y: Integer); override; procedure Paint(const Canvas: TCanvas; const ClientAreaRect: TRect; IsHoverItem, IsPushed, UseDisabledShadow: Boolean); override; procedure UpdateItems; property HoverIndex: Integer read FHoverIndex write FHoverIndex; + property Offset: Integer read FOffset; {vb+} + property VisibleItems: Integer read FVisibleItems; {vb+} public constructor Create(AView: TTBView; AItem: TTBCustomItem; AGroupLevel: Integer); override; destructor Destroy; override; end; { TTBXStringList } --- TBXOfficeXPTheme.pas 2004-05-25 22:02:56.000000000 +-0400 +++ TBXOfficeXPTheme.pas 2005-08-05 17:41:38.000000000 +-0400 @@ -11,12 +11,14 @@ {$I TB2Ver.inc} {$I TBX.inc} uses Windows, Messages, Graphics, TBXThemes, TBXDefaultTheme, ImgList; +{$DEFINE ALTERNATIVE_DISABLED_STYLE} // remove the asterisk to change appearance of disabled images + type TItemPart = (ipBody, ipText, ipFrame); TBtnItemState = (bisNormal, bisDisabled, bisSelected, bisPressed, bisHot, bisDisabledHot, bisSelectedHot, bisPopupParent); TMenuItemState = (misNormal, misDisabled, misHot, misDisabledHot); TWinFramePart = (wfpBorder, wfpCaption, wfpCaptionText); @@ -361,19 +363,29 @@ Brush.Style := bsSolid; end; end; procedure TTBXOfficeXPTheme.PaintCheckMark(Canvas: TCanvas; ARect: TRect; const ItemInfo: TTBXItemInfo); var + DC: HDC; X, Y: Integer; + C: TColor; begin - X := (ARect.Left + ARect.Right) div 2 - 2; + DC := Canvas.Handle; + X := (ARect.Left + ARect.Right) div 2 - 1; Y := (ARect.Top + ARect.Bottom) div 2 + 1; - Canvas.Pen.Color := GetBtnColor(ItemInfo, ipText); - Canvas.Polyline([Point(X-2, Y-2), Point(X, Y), Point(X+4, Y-4), - Point(X+4, Y-3), Point(X, Y+1), Point(X-2, Y-1), Point(X-2, Y-2)]); + C := GetBtnColor(ItemInfo, ipText); + if ItemInfo.ItemOptions and IO_RADIO > 0 then + begin + RoundRectEx(DC, X-2, Y-4, X+4, Y+2, 2, 2, + MixColors(C, ToolbarColor, 200), clNone); + RoundRectEx(DC, X-2, Y-4, X+4, Y+2, 6, 6, C, C); + end + else + PolylineEx(DC, [Point(X-2, Y-2), Point(X, Y), Point(X+4, Y-4), + Point(X+4, Y-3), Point(X, Y+1), Point(X-2, Y-1), Point(X-2, Y-2)], C); end; procedure TTBXOfficeXPTheme.PaintChevron(Canvas: TCanvas; ARect: TRect; const ItemInfo: TTBXItemInfo); const Pattern: array[Boolean, 0..15] of Byte = ( ($CC, 0, $66, 0, $33, 0, $66, 0, $CC, 0, 0, 0, 0, 0, 0, 0), --- TBXReg.pas 2004-05-25 22:02:56.000000000 +-0400 +++ TBXReg.pas 2004-12-16 20:22:26.000000000 +-0400 @@ -432,12 +432,13 @@ {$ENDIF} RegisterComponentEditor(TTBXToolbar, TTBXItemsEditor); RegisterComponentEditor(TTBXPopupMenu, TTBXItemsEditor); RegisterPropertyEditor(TypeInfo(string), TTBXCustomItem, 'Caption', TMLStringProperty); + RegisterPropertyEditor(TypeInfo(string), TTBXCustomItem, 'Hint', TMLStringProperty); RegisterPropertyEditor(TypeInfo(string), TTBXLabelItem, 'Caption', TCaptionProperty); RegisterPropertyEditor(TypeInfo(string), TTBToolbar, 'ChevronHint', TMLStringProperty); RegisterPropertyEditor(TypeInfo(string), TTBXToolbar, 'ChevronHint', TMLStringProperty); RegisterPropertyEditor(TypeInfo(string), TTBXSwitcher, 'Theme', TThemeProperty); {$IFDEF JR_D5} RegisterPropertyEditor(TypeInfo(TImageIndex), TTBXCustomLink, 'ImageIndex', TTBXLinkImageIndexPropertyEditor); --- TBXStrEdit.pas 2004-02-21 02:07:54.000000000 +-0400 +++ TBXStrEdit.pas 2005-08-12 10:11:16.000000000 +-0400 @@ -29,15 +29,15 @@ procedure TStrEditDlg.ArrangeControls; var R, B: TRect; W, H: Integer; begin R := ClientRect; - InflateRect(R, -16, -16); + InflateRect(R, -6, -6); B := R; - W := 60; H := 23; + W := 70; H := 23; B.Left := B.Right - W; B.Top := B.Bottom - H; Cancel.BoundsRect := B; B.Right := B.Left - 4; B.Left := B.Right - W; OK.BoundsRect := B; @@ -46,33 +46,38 @@ end; constructor TStrEditDlg.Create(AOwner: TComponent); begin inherited CreateNew(AOwner); AutoScroll := False; + Constraints.MinHeight := 200; + Constraints.MinWidth := 300; Scaled := False; Position := poScreenCenter; Memo := TMemo.Create(Self); with Memo do begin ScrollBars := ssBoth; OnKeyDown := MemoKeyDown; + Parent := Self; end; OK := TButton.Create(Self); with OK do begin Caption := 'OK'; Default := True; ModalResult := mrOk; + Parent := Self; end; Cancel := TButton.Create(Self); with Cancel do begin Cancel := True; Caption := 'Cancel'; ModalResult := mrCancel; + Parent := Self; end; end; procedure TStrEditDlg.MemoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_ESCAPE then Cancel.Click; --- TBXThemes.pas 2004-05-25 22:02:56.000000000 +-0400 +++ TBXThemes.pas 2004-12-17 08:47:16.000000000 +-0400 @@ -100,12 +100,13 @@ const IO_TOOLBARSTYLE = $01; IO_SUBMENUITEM = $04; IO_COMBO = $08; IO_DESIGNING = $10; IO_APPACTIVE = $20; // True when Application.Active = True + IO_RADIO = $40; { Drag handle styles } const DHS_DOUBLE = 0; DHS_NONE = 1; DHS_SINGLE = 2; --- TBXUtils.pas 2004-04-01 03:22:58.000000000 +-0400 +++ TBXUtils.pas 2005-08-14 04:51:58.000000000 +-0400 @@ -21,12 +21,15 @@ function EscapeAmpersandsW(const S: WideString): WideString; function FindAccelCharW(const S: WideString): WideChar; function StripAccelCharsW(const S: WideString): WideString; function StripTrailingPunctuationW(const S: WideString): WideString; {$ENDIF} +{$IFNDEF JR_D6} +function CheckWin32Version(AMajor, AMinor: Integer = 0): Boolean; {vb+} +{$ENDIF} procedure GetRGB(C: TColor; out R, G, B: Integer); function MixColors(C1, C2: TColor; W1: Integer): TColor; function SameColors(C1, C2: TColor): Boolean; function Lighten(C: TColor; Amount: Integer): TColor; function NearestLighten(C: TColor; Amount: Integer): TColor; function NearestMixedColor(C1, C2: TColor; W1: Integer): TColor; @@ -47,12 +50,14 @@ function CreateDitheredBrush(C1, C2: TColor): HBrush; function FillRectEx(DC: HDC; const Rect: TRect; Color: TColor): Boolean; {$IFDEF COMPATIBLE_GFX}overload;{$ENDIF} function FrameRectEx(DC: HDC; var Rect: TRect; Color: TColor; Adjust: Boolean): Boolean; {$IFDEF COMPATIBLE_GFX}overload;{$ENDIF} procedure DrawLineEx(DC: HDC; X1, Y1, X2, Y2: Integer; Color: TColor); {$IFDEF COMPATIBLE_GFX}overload;{$ENDIF} function PolyLineEx(DC: HDC; const Points: array of TPoint; Color: TColor): Boolean; procedure PolygonEx(DC: HDC; const Points: array of TPoint; OutlineColor, FillColor: TColor); +procedure RoundRectEx(DC: HDC; Left, Top, Right, Bottom: Integer; EllipseWidth, EllipseHeight, OutlineColor, FillColor: TColor); overload; {vb+} +procedure RoundRectEx(DC: HDC; const R: TRect; EllipseWidth, EllipseHeight, OutlineColor, FillColor: TColor); overload; {vb+} procedure DitherRect(DC: HDC; const R: TRect; C1, C2: TColor); {$IFDEF COMPATIBLE_GFX}overload;{$ENDIF} procedure Frame3D(DC: HDC; var Rect: TRect; TopColor, BottomColor: TColor; Adjust: Boolean); {$IFDEF COMPATIBLE_GFX}overload;{$ENDIF} procedure DrawDraggingOutline(DC: HDC; const NewRect, OldRect: TRect); { Gradients } type @@ -393,13 +398,19 @@ else if (L > 3) and (Result[L - 2] = '.') and (Result[L - 1] = '.') and (Result[L] = '.') then SetLength(Result, L - 3); end; {$ENDIF} - +{$IFNDEF JR_D6} +function CheckWin32Version(AMajor, AMinor: Integer = 0): Boolean; {vb+} +begin + Result := (Win32MajorVersion > AMajor) or + ((Win32MajorVersion = AMajor) and (Win32MinorVersion >= AMinor)); +end; +{$ENDIF} type PPoints = ^TPoints; TPoints = array [0..0] of TPoint; const @@ -541,13 +552,13 @@ begin i1 := ColorDistance(AColor, $000000); i2 := ColorDistance(ABkgndColor, $000000); Threshold := GetAdjustedThreshold(i2, Threshold); if i1 > i2 then DoInvert := i2 < 442 - Threshold - else DoInvert := i2 < Threshold; + else DoInvert := i2 < Threshold; x := (ABkgndColor and $FF) * WeightR; y := (ABkgndColor shr 8 and $FF) * WeightG; z := (ABkgndColor shr 16) * WeightB; r := (AColor and $FF) * WeightR; @@ -728,27 +739,31 @@ begin if Color = clNone then begin LB.lbStyle := BS_HOLLOW; Result := CreateBrushIndirect(LB); end - else if Color < 0 then Result := GetSysColorBrush(Color and $000000FF) - else Result := CreateSolidBrush(Color); + {else if Color < 0 then Result := GetSysColorBrush(Color and $000000FF)} {vb-} + else begin {vb+} + if Color < 0 then Color := GetSysColor(Color and $000000FF); + Result := CreateSolidBrush(Color); + end; end; function FillRectEx(DC: HDC; const Rect: TRect; Color: TColor): Boolean; var Brush: HBRUSH; begin Result := Color <> clNone; if Result then begin if Color < 0 then Brush := GetSysColorBrush(Color and $000000FF) else Brush := CreateSolidBrush(Color); Windows.FillRect(DC, Rect, Brush); - DeleteObject(Brush); + {DeleteObject(Brush);} {vb-} + if Color >= 0 then DeleteObject(Brush); {vb+} end; end; function FrameRectEx(DC: HDC; var Rect: TRect; Color: TColor; Adjust: Boolean): Boolean; var Brush: HBRUSH; @@ -756,13 +771,14 @@ Result := Color <> clNone; if Result then begin if Color < 0 then Brush := GetSysColorBrush(Color and $000000FF) else Brush := CreateSolidBrush(Color); Windows.FrameRect(DC, Rect, Brush); - DeleteObject(Brush); + {DeleteObject(Brush);} {vb-} + if Color >= 0 then DeleteObject(Brush); {vb+} end; if Adjust then with Rect do begin Inc(Left); Dec(Right); Inc(Top); Dec(Bottom); end; @@ -810,12 +826,38 @@ SelectObject(DC, OldBrush); SelectObject(DC, OldPen); DeleteObject(Brush); DeleteObject(Pen); end; +procedure RoundRectEx(DC: HDC; Left, Top, Right, Bottom: Integer; + EllipseWidth, EllipseHeight, OutlineColor, FillColor: TColor); {vb+} +var + OldBrush, Brush: HBrush; + OldPen, Pen: HPen; +begin + if (OutlineColor = clNone) and (FillColor = clNone) then Exit; + Pen := CreatePenEx(OutlineColor); + Brush := CreateBrushEx(FillColor); + OldPen := SelectObject(DC, Pen); + OldBrush := SelectObject(DC, Brush); + Windows.RoundRect(DC, Left, Top, Right, Bottom, EllipseWidth, EllipseHeight); + SelectObject(DC, OldBrush); + SelectObject(DC, OldPen); + DeleteObject(Brush); + DeleteObject(Pen); +end; + +procedure RoundRectEx(DC: HDC; const R: TRect; EllipseWidth, EllipseHeight, + OutlineColor, FillColor: TColor); {vb+} +begin + with R do + RoundRectEx(DC, Left, Top, Right, Bottom, EllipseWidth, + EllipseHeight, OutlineColor, FillColor); +end; + function CreateDitheredBrush(C1, C2: TColor): HBrush; var B: TBitmap; begin B := AllocPatternBitmap(C1, C2); B.HandleType := bmDDB; @@ -949,26 +991,25 @@ POP EDI POP ESI end; procedure DrawTBXIcon(Canvas: TCanvas; const R: TRect; ImageList: TCustomImageList; ImageIndex: Integer; HiContrast: Boolean); -const - CWeirdColor = $00203241; +{const + CWeirdColor = $00203241;} {vb -} var ImageWidth, ImageHeight: Integer; I, J: Integer; Src, Dst: PColor; S, C: TColor; begin if not HiContrast then begin ImageList.Draw(Canvas, R.Left, R.Top, ImageIndex); Exit; end; - ImageWidth := R.Right - R.Left; ImageHeight := R.Bottom - R.Top; with ImageList do begin if Width < ImageWidth then ImageWidth := Width; if Height < ImageHeight then ImageHeight := Height; @@ -978,27 +1019,33 @@ StockBitmap1.Height := ImageHeight; StockBitmap2.Width := ImageWidth; StockBitmap2.Height := ImageHeight; BitBlt(StockBitmap1.Canvas.Handle, 0, 0, ImageWidth, ImageHeight, Canvas.Handle, R.Left, R.Top, SRCCOPY); - for J := 0 to ImageHeight - 1 do - FillLongWord(StockBitmap2.ScanLine[J]^, ImageWidth, CWeirdColor); + {for J := 0 to ImageHeight - 1 do + FillLongWord(StockBitmap2.ScanLine[J]^, ImageWidth, CWeirdColor);} {vb -} + BitBlt(StockBitmap2.Canvas.Handle, 0, 0, ImageWidth, ImageHeight, + Canvas.Handle, R.Left, R.Top, SRCCOPY); {vb +} ImageList.Draw(StockBitmap2.Canvas, 0, 0, ImageIndex); for J := 0 to ImageHeight - 1 do begin Src := StockBitmap2.ScanLine[J]; Dst := StockBitmap1.ScanLine[J]; for I := 0 to ImageWidth - 1 do begin - S := Src^ and $00FFFFFF; - if S <> CWeirdColor then + {S := Src^ and $00FFFFFF;} {vb -} + S := Src^; {vb +} + {if S <> CWeirdColor then} {vb -} + if S <> Dst^ then {vb +} begin - C := (S and $FF0000) shr 16 * 76 + (S and $00FF00) shr 8 * 150 + - (S and $0000FF) * 29; + {C := (S and $FF0000) shr 16 * 76 + (S and $00FF00) shr 8 * 150 + + (S and $0000FF) * 29;} {vb -} + C := (S and $00FF0000) shr 16 * 76 + (S and $0000FF00) shr 8 * 150 + + (S and $000000FF) * 29; {vb +} if C > $FD00 then S := $000000 else if C < $6400 then S := $FFFFFF; Dst^ := Lighten(S, 32); end; Inc(Src); Inc(Dst); @@ -1007,14 +1054,14 @@ BitBlt(Canvas.Handle, R.Left, R.Top, ImageWidth, ImageHeight, StockBitmap1.Canvas.Handle, 0, 0, SRCCOPY); end; procedure BlendTBXIcon(Canvas: TCanvas; const R: TRect; ImageList: TCustomImageList; ImageIndex: Integer; Opacity: Byte); -const - CWeirdColor = $00203241; +{const + CWeirdColor = $00203241;} {vb -} var ImageWidth, ImageHeight: Integer; I, J: Integer; Src, Dst: ^Cardinal; S, C, CBRB, CBG: Cardinal; Wt1, Wt2: Cardinal; @@ -1033,14 +1080,16 @@ StockBitmap1.Height := ImageHeight; StockBitmap2.Width := ImageWidth; StockBitmap2.Height := ImageHeight; BitBlt(StockBitmap1.Canvas.Handle, 0, 0, ImageWidth, ImageHeight, Canvas.Handle, R.Left, R.Top, SRCCOPY); + {BitBlt(StockBitmap2.Canvas.Handle, 0, 0, ImageWidth, ImageHeight, + StockBitmap1.Canvas.Handle, 0, 0, SRCCOPY);} {vb -} BitBlt(StockBitmap2.Canvas.Handle, 0, 0, ImageWidth, ImageHeight, - StockBitmap1.Canvas.Handle, 0, 0, SRCCOPY); + Canvas.Handle, R.Left, R.Top, SRCCOPY); {vb +} ImageList.Draw(StockBitmap2.Canvas, 0, 0, ImageIndex, True); for J := 0 to ImageHeight - 1 do begin Src := StockBitmap2.ScanLine[J]; Dst := StockBitmap1.ScanLine[J]; @@ -1048,31 +1097,35 @@ begin S := Src^; if S <> Dst^ then begin CBRB := (Dst^ and $00FF00FF) * Wt1; CBG := (Dst^ and $0000FF00) * Wt1; - C := ((S and $FF00FF) * Wt2 + CBRB) and $FF00FF00 + ((S and $00FF00) * Wt2 + CBG) and $00FF0000; + {C := ((S and $FF00FF) * Wt2 + CBRB) and $FF00FF00 + + ((S and $00FF00) * Wt2 + CBG) and $00FF0000;} {vb -} + C := ((S and $00FF00FF) * Wt2 + CBRB) and $FF00FF00 + + ((S and $0000FF00) * Wt2 + CBG) and $00FF0000; {vb +} Dst^ := C shr 8; end; Inc(Src); Inc(Dst); end; end; BitBlt(Canvas.Handle, R.Left, R.Top, ImageWidth, ImageHeight, StockBitmap1.Canvas.Handle, 0, 0, SRCCOPY); end; procedure HighlightTBXIcon(Canvas: TCanvas; const R: TRect; ImageList: TCustomImageList; ImageIndex: Integer; HighlightColor: TColor; Amount: Byte); -const - CWeirdColor = $00203241; +{const + CWeirdColor = $00203241;} {vb -} var ImageWidth, ImageHeight: Integer; I, J: Integer; - Src, Dst: PColor; + {Src, Dst: PColor;} {vb -} + Src, Dst: ^Cardinal; {vb +} S, C: Cardinal; CBRB, CBG: Cardinal; W1, W2: Cardinal; begin ImageWidth := R.Right - R.Left; ImageHeight := R.Bottom - R.Top; @@ -1086,14 +1139,16 @@ StockBitmap1.Height := ImageHeight; StockBitmap2.Width := ImageWidth; StockBitmap2.Height := ImageHeight; BitBlt(StockBitmap1.Canvas.Handle, 0, 0, ImageWidth, ImageHeight, Canvas.Handle, R.Left, R.Top, SRCCOPY); - for J := 0 to ImageHeight - 1 do - FillLongWord(StockBitmap2.ScanLine[J]^, ImageWidth, CWeirdColor); + {for J := 0 to ImageHeight - 1 do + FillLongWord(StockBitmap2.ScanLine[J]^, ImageWidth, CWeirdColor);} {vb -} + BitBlt(StockBitmap2.Canvas.Handle, 0, 0, ImageWidth, ImageHeight, + Canvas.Handle, R.Left, R.Top, SRCCOPY); {vb +} ImageList.Draw(StockBitmap2.Canvas, 0, 0, ImageIndex); W2 := Amount; W1 := 255 - W2; HighlightColor := GetBGR(ColorToRGB(HighlightColor)); CBRB := (Cardinal(HighlightColor) and $00FF00FF) * W1; @@ -1102,16 +1157,21 @@ for J := 0 to ImageHeight - 1 do begin Src := StockBitmap2.ScanLine[J]; Dst := StockBitmap1.ScanLine[J]; for I := 0 to ImageWidth - 1 do begin - S := Src^ and $00FFFFFF; - if S <> CWeirdColor then + {S := Src^ and $00FFFFFF;} {vb -} + S := Src^; {vb +} + {if S <> CWeirdColor then} {vb -} + if S <> Dst^ then {vb +} begin - C := ((S and $FF00FF) * W2 + CBRB) and $FF00FF00 + ((S and $00FF00) * W2 + CBG) and $00FF0000; + {C := ((S and $FF00FF) * W2 + CBRB) and $FF00FF00 + + ((S and $00FF00) * W2 + CBG) and $00FF0000;} {vb -} + C := ((S and $00FF00FF) * W2 + CBRB) and $FF00FF00 + + ((S and $0000FF00) * W2 + CBG) and $00FF0000; {vb +} Dst^ := C shr 8; end; Inc(Src); Inc(Dst); end; end; @@ -1144,14 +1204,16 @@ StockBitmap1.Height := ImageHeight; StockBitmap2.Width := ImageWidth; StockBitmap2.Height := ImageHeight; BitBlt(StockBitmap1.Canvas.Handle, 0, 0, ImageWidth, ImageHeight, Canvas.Handle, R.Left, R.Top, SRCCOPY); + {BitBlt(StockBitmap2.Canvas.Handle, 0, 0, ImageWidth, ImageHeight, + StockBitmap1.Canvas.Handle, 0, 0, SRCCOPY);} {vb -} BitBlt(StockBitmap2.Canvas.Handle, 0, 0, ImageWidth, ImageHeight, - StockBitmap1.Canvas.Handle, 0, 0, SRCCOPY); + Canvas.Handle, R.Left, R.Top, SRCCOPY); {vb +} ImageList.Draw(StockBitmap2.Canvas, 0, 0, ImageIndex, True); for J := 0 to ImageHeight - 1 do begin Src := StockBitmap2.ScanLine[J]; Dst := StockBitmap1.ScanLine[J]; @@ -1159,14 +1221,16 @@ begin S := Src^; if S <> Dst^ then begin CBRB := Dst^ and $00FF00FF; CBG := Dst^ and $0000FF00; - C := ((S and $FF0000) shr 16 * 29 + (S and $00FF00) shr 8 * 150 + - (S and $0000FF) * 76) shr 8; + {C := ((S and $FF0000) shr 16 * 29 + (S and $00FF00) shr 8 * 150 + + (S and $0000FF) * 76) shr 8;} {vb -} + C := ((S and $00FF0000) shr 16 * 29 + (S and $0000FF00) shr 8 * 150 + + (S and $000000FF) * 76) shr 8; {vb +} C := C div D_DIV[Density] + D_ADD[Density]; Dst^ := ((CBRB * C and $FF00FF00) or (CBG * C and $00FF0000)) shr 8; end; Inc(Src); Inc(Dst); end; @@ -1938,13 +2002,13 @@ Size, I, Start, Finish: Integer; GradIndex: Integer; R, CR: TRect; Brush: HBRUSH; begin if not RectVisible(DC, ARect) then Exit; - + ClrTopLeft := ColorToRGB(ClrTopLeft); ClrBottomRight := ColorToRGB(ClrBottomRight); if @GradientFill <> nil then begin { Use msimg32.dll } with V[0] do @@ -2085,18 +2149,24 @@ NextCacheEntry: Integer = 0; procedure ClearCacheItem(var CacheItem: TThreadCacheItem); var I: Integer; begin - for I := NUM_TEMPLATES - 1 downto 0 do - begin - CacheItem.BaseColor := $FFFFFFFF; - CacheItem.Roughness := -1; - if CacheItem.Bitmaps[I] <> 0 then DeleteObject(CacheItem.Bitmaps[I]); - CacheItem.Bitmaps[I] := 0; + with CacheItem do + begin + BaseColor := $FFFFFFFF; + Roughness := -1; + for I := NUM_TEMPLATES - 1 downto 0 do + begin + if Bitmaps[I] <> 0 then + begin + DeleteObject(Bitmaps[I]); + Bitmaps[I] := 0; + end; + end; end; end; procedure ResetBrushedFillCache; var I: Integer; @@ -2235,29 +2305,25 @@ DeleteDC(CacheDC); RestoreDC(DC, -1); end; var - hUser, hMSImg: HModule; + hMSImg: HModule; initialization - -hUser := LoadLibrary('user32.dll'); -hMSImg := LoadLibrary('msimg32.dll'); -@UpdateLayeredWindow := GetProcAddress(hUser, 'UpdateLayeredWindow'); -@AlphaBlend := GetProcAddress(hMSImg, 'AlphaBlend'); -@GradientFill := GetProcAddress(hMSImg, 'GradientFill'); - -InitializeStock; -InitializeBrushedFill; -ResetBrushedFillCache; - + @UpdateLayeredWindow := GetProcAddress( + GetModuleHandle('user32.dll'), 'UpdateLayeredWindow'); + hMSImg := LoadLibrary('msimg32.dll'); + if hMSImg <> 0 then + begin + @AlphaBlend := GetProcAddress(hMSImg, 'AlphaBlend'); + @GradientFill := GetProcAddress(hMSImg, 'GradientFill'); + end; + InitializeStock; + InitializeBrushedFill; + ResetBrushedFillCache; finalization - -FinalizeBrushedFill; -FinalizeStock; - -FreeLibrary(hMSImg); -FreeLibrary(hUser); - + FinalizeBrushedFill; + FinalizeStock; + if hMSImg <> 0 then FreeLibrary(hMSImg); end. --- TBXOffice2003Theme.pas 2005-02-14 12:06:12.000000000 +-0400 +++ TBXOffice2003Theme.pas 2005-08-12 12:33:40.000000000 +-0400 @@ -19,13 +19,13 @@ // I advise you to get it from http://pngdelphi.sourceforge.net // after downloading, install it and TPNGImageList component from PNGImgList.pas // uncomment next string if you have TPNGImage and TPNGImageList installed //{$DEFINE PNGIMAGELIST} // uncomment next string if you want to see highlighted icons -//{$DEFINE HIGHLIGHTTOOLBARICONS} +{$DEFINE HIGHLIGHTTOOLBARICONS} uses Windows, Messages, Graphics, TBXThemes, ImgList, TBXUxThemes {$IFDEF PNGIMAGELIST}, PNGImgList{$ENDIF}; type @@ -414,13 +414,13 @@ Result := BtnBodyColors[B, False] else Result := BtnItemColors[B, ItemPart]; if Embedded and (Result = clNone) then begin if ItemPart = ipBody then Result := EmbeddedColor; - if ItemPart = ipFrame then Result := EmbeddedFrameColor;; + if ItemPart = ipFrame then Result := EmbeddedFrameColor; end; end; end; end; function TTBXOffice2003Theme.GetItemColor(const ItemInfo: TTBXItemInfo): TColor; @@ -550,19 +550,29 @@ Brush.Style := bsSolid; end; end; procedure TTBXOffice2003Theme.PaintCheckMark(Canvas: TCanvas; ARect: TRect; const ItemInfo: TTBXItemInfo); var + DC: HDC; X, Y: Integer; + C: TColor; begin - X := (ARect.Left + ARect.Right) div 2 - 2; + DC := Canvas.Handle; + X := (ARect.Left + ARect.Right) div 2 - 1; Y := (ARect.Top + ARect.Bottom) div 2 + 1; - Canvas.Pen.Color := GetBtnColor(ItemInfo, ipText); - Canvas.Polyline([Point(X - 2, Y - 2), Point(X, Y), Point(X + 4, Y - 4), - Point(X + 4, Y - 3), Point(X, Y + 1), Point(X - 2, Y - 1), Point(X - 2, Y - 2)]); + C := GetBtnColor(ItemInfo, ipText); + if ItemInfo.ItemOptions and IO_RADIO > 0 then + begin + RoundRectEx(DC, X-2, Y-4, X+4, Y+2, 2, 2, + MixColors(C, ToolbarColor1, 200), clNone); + RoundRectEx(DC, X-2, Y-4, X+4, Y+2, 6, 6, C, C); + end + else + PolylineEx(DC, [Point(X-2, Y-2), Point(X, Y), Point(X+4, Y-4), + Point(X+4, Y-3), Point(X, Y+1), Point(X-2, Y-1), Point(X-2, Y-2)], C); end; procedure TTBXOffice2003Theme.PaintChevron(Canvas: TCanvas; ARect: TRect; const ItemInfo: TTBXItemInfo); const Pattern: array[Boolean, 0..15] of Byte = ( ($CC, 0, $66, 0, $33, 0, $66, 0, $CC, 0, 0, 0, 0, 0, 0, 0),