Archivado/Componentes.Terceros.TB2k-TBX
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
cd664460a2
Componentes.Terceros.TB2k-TBX/official/2.1.6+2.1.beta1/TBX/_tbx_2.1.beta_patch.diff.txt

2650 lines
89 KiB
Plaintext
Raw Blame History

--- 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),
Reference in New Issue View Git Blame Copy Permalink