{ Class UCXPStyle: Based on XPMenu 3.1 for Delphi XPMenu for Delphi Author: Khaled Shagrouni URL: http://www.shagrouni.com/english/software/xpmenu.html e-mail: khaled@shagrouni.com Version 3.1 - 22.02.2004 XPMenu is a Delphi component to mimic Office XP menu and toolbar style. Copyright (C) 2001, 2003 Khaled Shagrouni. This component is FREEWARE with source code. I still hold the copyright, but you can use it for whatever you like: freeware, shareware or commercial software. If you have any ideas for improvement or bug reports, don't hesitate to e-mail me (Please state the XPMenu version and OS information). -------------------------------------------------------------------------------- changes by QmD 30/11/2003 - qmd@usercontrol.com.br * Add BitBtnColor / BitBtnSelectColor by QmD 30/11/2003 - qmd@usercontrol.com.br * BitBtn Button multi-line corrected * 29/03/2004 - XPmenu 2.21 incorporated in User Control Package. Class renamed to UCXPMenu to prevent conflicts (http://usercontrol.sourceforge.net) changes by fduenas 29/12/2004 - fduenas@outm.net, fduenas@flashmail.com * XPMenu.pas 3.1 Ported to UCXPStyle.pas by Francisco Dueñas fduenas@outm.net. * File UCXPMenu.pas renamed to UCXPStyle.pas * Class UCXPSet renamed to UCXPSettings * File UCXPSet.pas renamed to UCXPSettings.pas } {$IFDEF VER130} {$DEFINE VER5U} {$ENDIF} {$IFDEF VER140} {$DEFINE VER5U} {$DEFINE VER6U} {$ENDIF} {$IFDEF VER150} {$DEFINE VER5U} {$DEFINE VER6U} {$DEFINE VER7U} {$ENDIF} unit UCXPStyle; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, ComCtrls, Forms, Menus, Commctrl, ExtCtrls, StdCtrls, Buttons, UCXPSettings, UCBase, UCSettings; type { moved to UCXPSettings.pas and renamed TXP* to TUCXP* TXPContainer = (xccForm, xccFrame, xccToolbar, xccCoolbar, xccControlbar, xccPanel, xccScrollBox, xccGroupBox, xccTabSheet, xccPageScroller); TXPContainers = set of TXPContainer; TXPControl = (xcMainMenu, xcPopupMenu, xcToolbar, xcControlbar, xcCombo, xcListBox, xcEdit, xcMaskEdit, xcMemo, xcRichEdit, xcMiscEdit, xcCheckBox, xcRadioButton, xcButton, xcBitBtn, xcSpeedButton, xcUpDown, xcPanel, xcGroupBox, xcTreeView, xcListView, xcProgressBar, xcHotKey); {xcStringGrid, xcDrawGrid, xcDBGrid); } TUCAboutXpStyleVar=String[10]; TUCXPStyle = class; TControlSubClass = class(TComponent) //: "Fabian Jakubowski" private Control: TControl; FBuilding: boolean; FMouseInControl: boolean; FLButtonBressed: boolean; FBressed: boolean; FIsKeyDown: boolean; FIsFocused: boolean; orgWindowProc: TWndMethod; FXPStyle: TUCXPStyle; FCtl3D: boolean; FBorderStyle: TBorderStyle; {FOnDrawCell: TDrawCellEvent;} FDefaultDrawing: boolean; FSelCol, FSelRow: integer; FMsg: Cardinal; procedure ControlSubClass(var Message: TMessage); procedure PaintControlXP; procedure PaintCombo; procedure PaintDBLookupCombo; procedure PaintEdit; procedure PaintRichEdit; procedure PaintCheckBox; procedure PaintRadio; procedure PaintButton; procedure PaintBitButn; procedure PaintUpDownButton; procedure PaintSpeedButton; procedure PaintPanel; procedure PaintGroupBox; procedure PaintNCWinControl; procedure PaintProgressBar; procedure PaintHotKey; end; TUCXPStyle = class(TComponent) private FActive: boolean; {Changes MMK FForm to TScrollingWinControl} FForm: TScrollingWinControl; {moved to UCXPsettings FFont: TFont; FColor: TColor; FIconBackColor: TColor; FMenuBarColor: TColor; FCheckedColor: TColor; FSeparatorColor: TColor; FSelectBorderColor: TColor; FSelectColor: TColor; FDisabledColor: TColor; FSelectFontColor: TColor; FIconWidth: integer; FDrawSelect: boolean; FUseSystemColors: boolean; FColorsChanged: boolean; // +jt } FFColor, FFIconBackColor, FFSelectColor, FFSelectBorderColor, FFSelectFontColor, FCheckedAreaColor, FCheckedAreaSelectColor, FFCheckedColor, FFMenuBarColor, FFDisabledColor, FFSeparatorColor, FMenuBorderColor, FMenuShadowColor: TColor; Is16Bit: boolean; { moved to UCXPSettings.pas FOverrideOwnerDraw: boolean; FGradient: boolean; FFlatMenu: boolean; FAutoDetect: boolean; FUCXPContainers: TUCXPContainers; FUCXPControls: TUCXPControls; FGrayLevel: byte; FDimLevel: byte; FDrawMenuBar: boolean; FUseDimColor: boolean; } FDimParentColor, FDimParentColorSelect: integer; FAutoDetect: boolean; // FUseParentClor: boolean; FSettingWindowRng: boolean; FIsW2k: boolean; FIsWXP: boolean; FIsWNT: boolean; // FTransparentColor: TColor; // Do not allow the component to be used for subclassing FDisableSubclassing: boolean; FUCSettings: TUCSettings; FUCXPSettings: TUCXPSettings; FUCAboutXpStyleVar: TUCAboutXpStyleVar; {+qmd} procedure SetDisableSubclassing(const Value: boolean); procedure SetActive(const Value: boolean); procedure SetForm(const Value: TScrollingWinControl); { moved to UCXPSettings procedure SetFont(const Value: TFont); procedure SetColor(const Value: TColor); procedure SetIconBackColor(const Value: TColor); procedure SetMenuBarColor(const Value: TColor); procedure SetCheckedColor(const Value: TColor); procedure SetDisabledColor(const Value: TColor); procedure SetSelectColor(const Value: TColor); procedure SetSelectBorderColor(const Value: TColor); procedure SetSeparatorColor(const Value: TColor); procedure SetSelectFontColor(const Value: TColor); procedure SetIconWidth(const Value: integer); procedure SetDrawSelect(const Value: boolean); procedure SetUseSystemColors(const Value: boolean); procedure SetOverrideOwnerDraw(const Value: boolean); procedure SetGradient(const Value: boolean); procedure SetFlatMenu(const Value: boolean); procedure SetUCXPContainers(const Value: TUCXPContainers); procedure SetUCXPControls(const Value: TUCXPControls); procedure SetDrawMenuBar(const Value: boolean); procedure SetUseDimColor(const Value: boolean); } procedure SetUCSettings(const Value: TUCSettings); {+qmd} protected procedure Loaded; override; //add by Cunha, liyang. procedure InitItems(wForm: TWinControl; Enable, Update: boolean); procedure InitItem(Comp: TComponent; Enable, Update: boolean); // Tom: "Thomas Knoblauch" 27.08 procedure DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean); procedure MenueDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean); {$IFDEF VER5U} procedure ToolBarDrawButton(Sender: TToolBar; Button: TToolButton; State: TCustomDrawState; var DefaultDraw: Boolean); {$ENDIF} procedure ControlBarPaint(Sender: TObject; Control: TControl; Canvas: TCanvas; var ARect: TRect; var Options: TBandPaintOptions); procedure SetGlobalColor(ACanvas: TCanvas); procedure DrawTopMenuItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; BckColor:Tcolor; IsRightToLeft: boolean); procedure DrawCheckedItem(FMenuItem: TMenuItem; Selected, Enabled, HasImgLstBitmap: boolean; ACanvas: TCanvas; CheckedRect: TRect); procedure DrawTheText(Sender: TObject; txt, ShortCuttext: string; ACanvas: TCanvas; TextRect: TRect; Selected, Enabled, Default, TopMenu, IsRightToLeft: boolean; var TxtFont: TFont; TextFormat: integer); procedure DrawIcon(Sender: TObject; ACanvas: TCanvas; B: TBitmap; IconRect: Trect; Hot, Selected, Enabled, Checked, FTopMenu, IsRightToLeft: boolean); procedure MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer); //function GetImageExtent(MenuItem: TMenuItem): TPoint; function GetImageExtent(MenuItem: TMenuItem; FTopMenu: TMenu): TPoint; // +jt function TopMenuFontColor(ACanvas: TCanvas; Color: TColor): TColor; procedure DrawGradient(ACanvas: TCanvas; ARect: TRect; IsRightToLeft: boolean); procedure DrawWindowBorder(hWnd: HWND; IsRightToLeft: boolean); procedure Notification(AComponent: TComponent; AOperation: TOperation); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure InitComponent(Comp: TComponent); // Tom: Added for usage by the main program ."Thomas Knoblauch" 27.08 procedure ActivateMenuItem(MenuItem: TMenuItem; SubMenus: boolean); // +jt property Form: TScrollingWinControl read FForm write SetForm;// +jt property IsWXP: boolean read FIsWXP; property IsW2k: boolean read FIsW2k; property IsWNT: boolean read FIsWNT; { property TransparentColor: TColor read FTransparentColor write FTransparentColor;} published {moved to UCXPSettings property DimLevel: Byte read FDimLevel write FDimLevel; property GrayLevel: Byte read FGrayLevel write FGrayLevel; property Font: TFont read FFont write SetFont; property Color: TColor read FColor write SetColor; property DrawMenuBar: boolean read FDrawMenuBar write SetDrawMenuBar; property IconBackColor: TColor read FIconBackColor write SetIconBackColor; property MenuBarColor: TColor read FMenuBarColor write SetMenuBarColor; property SelectColor: TColor read FSelectColor write SetSelectColor; property SelectBorderColor: TColor read FSelectBorderColor write SetSelectBorderColor; property SelectFontColor: TColor read FSelectFontColor write SetSelectFontColor; property DisabledColor: TColor read FDisabledColor write SetDisabledColor; property SeparatorColor: TColor read FSeparatorColor write SetSeparatorColor; property CheckedColor: TColor read FCheckedColor write SetCheckedColor; property IconWidth: integer read FIconWidth write SetIconWidth; property DrawSelect: boolean read FDrawSelect write SetDrawSelect; property UseSystemColors: boolean read FUseSystemColors write SetUseSystemColors; property UseDimColor: boolean read FUseDimColor write SetUseDimColor; property OverrideOwnerDraw: boolean read FOverrideOwnerDraw write SetOverrideOwnerDraw; property Gradient: boolean read FGradient write SetGradient; property FlatMenu: boolean read FFlatMenu write SetFlatMenu; property AutoDetect: boolean read FAutoDetect write SetAutoDetect; property XPContainers: TUCXPContainers read FUCXPContainers write SetUCXPContainers default [xccForm, xccFrame, xccToolbar, xccCoolbar, xccControlbar, xccPanel, xccScrollBox, xccGroupBox, xccTabSheet, xccPageScroller]; property XPControls :TUCXPControls read FUCXPControls write SetUCXPControls default [xcMainMenu, xcPopupMenu, xcToolbar, xcControlbar, xcCombo, xcListBox, xcEdit, xcMaskEdit, xcMemo, xcRichEdit, xcMiscEdit, xcCheckBox, xcRadioButton, xcButton, xcBitBtn, xcSpeedButton, xcUpDown, xcPanel, xcGroupBox, xcTreeView, xcListView, xcProgressBar, xcHotKey]; {xcStringGrid, xcDrawGrid, xcDBGrid]; } property About: TUCAboutXpStyleVar read FUCAboutXpStyleVar write FUCAboutXpStyleVar; property Active: boolean read FActive write SetActive; property DisableSubclassing: boolean read FDisableSubclassing write SetDisablesubclassing default false; property XPSettings : TUCXPSettings read FUCXPSettings write FUCXPSettings; property UCSettings : TUCSettings read FUCSettings write SetUCSettings; end; TUCXPStyleManager = class(TPersistent) private FXPStyleList: TList; FPendingFormsList: TList; FFormList: TList; FActiveXPStyle: TUCXPStyle; FDisableSubclassing: boolean; function MainWindowHook(var Message: TMessage): boolean; procedure CollectForms; procedure RemoveChildSubclassing(AForm: TCustomForm); procedure SetDisableSubclassing(AValue: boolean); function FindSubclassingXPStyle(Exclude: TUCXPStyle): TUCXPStyle; protected procedure Notification(AComponent: TComponent; AOperation: TOperation); public constructor Create; destructor Destroy; override; procedure Add(AXPStyle: TUCXPStyle); procedure Delete(AXPStyle: TUCXPStyle); procedure UpdateActiveXPStyle(AXPStyle: TUCXPStyle); procedure AddForm(AForm: TCustomForm); procedure RemoveForm(AForm: TCustomForm); function IsFormSubclassed(AForm: TCustomForm): boolean; function IsComponentSubclassed(AComponent: TComponent): boolean; property ActiveXPStyle: TUCXPStyle read FActiveXPStyle; property DisableSubclassing: boolean read FDisableSubclassing write SetDisableSubclassing default false; end; function GetShadeColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor; function MergColor(Colors: Array of TColor): TColor; function NewColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor; procedure DimBitmap(ABitmap: TBitmap; Value: integer); procedure DrawArrow(ACanvas: TCanvas; X, Y: integer); overload; procedure DrawArrow(ACanvas: TCanvas; X, Y, Orientation: integer); overload; function GrayColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor; function GetInverseColor(AColor: TColor): TColor; procedure GrayBitmap(ABitmap: TBitmap; Value: integer); procedure DrawBitmapShadow(B: TBitmap; ACanvas: TCanvas; X, Y: integer; ShadowColor: TColor); procedure DrawCheckMark(ACanvas: TCanvas; X, Y: integer); procedure GetSystemMenuFont(Font: TFont); //procedure Register; const WM_DRAWMENUBORDER = CN_NOTIFY + 101; // +jt WM_DRAWMENUBORDER2 = CN_NOTIFY + 102; // +jt // Gloabal access to the UCXPStyleManager var UCXPStyleManager: TUCXPStyleManager; implementation { moved to UCReg.pas procedure Register; begin RegisterComponents('XP', [TUCXPStyle]); end; } // Set up the global variable that represents the UCXPStyleManager procedure InitControls; begin //added by fduenas if (csDesigning in Application.ComponentState) then exit; if (Not assigned(UCXPStyleManager)) or (UCXPStyleManager = nil) then UCXPStyleManager := TUCXPStyleManager.Create; end; // Delete the global variable that represents the UCXPStyleManager procedure DoneControls; begin FreeAndNil(UCXPStyleManager); { if (UCXPStyleManager <> nil) then begin UCXPStyleManager.Free; UCXPStyleManager := nil; end; } end; // Test if mouse cursor is in the given rect of the application's main form function IsMouseInRect(TheForm: TScrollingWinControl; DestRect: TRect): boolean; var p: TPoint; begin if Assigned(TheForm) then begin p := Mouse.CursorPos; p.x := p.x - TheForm.Left; p.y := p.y - TheForm.Top; Dec(DestRect.Right); Dec(DestRect.Bottom, 2); Result := (p.x >= DestRect.Left) and (p.x <= DestRect.Right) and (p.y >= DestRect.Top) and (p.y <= DestRect.Bottom); end else Result := false; end; { TUCXPStyle } constructor TUCXPStyle.Create(AOwner: TComponent); var OSVersionInfo: TOSVersionInfo; // +jt begin inherited Create(AOwner); {moved to UCXPSettings FFont := TFont.Create; } FDisableSubclassing := false; // enable XPStyle to be used for global subclassing {moved to UCXPSettings {$IFDEF VER5U FFont.Assign(Screen.MenuFont); {$ELSE GetSystemMenuFont(FFont); {$ENDIF } FForm := (Owner as TScrollingWinControl); FUCXPSettings := TUCXPSettings.create(self); //added by fduenas {moved to UCXPSettings FUseSystemColors := true; FColor := clBtnFace; FIconBackColor := clBtnFace; FSelectColor := clHighlight; FSelectBorderColor := clHighlight; FMenuBarColor := clBtnFace; FDisabledColor := clInactiveCaption; FSeparatorColor := clBtnFace; FCheckedColor := clHighlight; FSelectFontColor := FFont.Color; FGrayLevel := 10; FDimLevel := 30; FIconWidth := 24; FDrawSelect := true; UCXPContainers := [xccForm, xccFrame, xccToolbar, xccCoolbar, xccControlbar, xccPanel, xccScrollBox, xccGroupBox, xccTabSheet, xccPageScroller]; UCXPControls := [xcMainMenu, xcPopupMenu, xcToolbar, xcControlbar, xcCombo, xcListBox, xcEdit, xcMaskEdit, xcMemo, xcRichEdit, xcMiscEdit, xcCheckBox, xcRadioButton, xcButton, xcBitBtn, xcSpeedButton, xcUpDown, xcPanel, xcGroupBox, xcTreeView, xcListView, xcProgressBar, xcHotKey]; {xcStringGrid, xcDrawGrid, xcDBGrid]; } if Assigned(FForm) then SetGlobalColor(TForm(FForm).Canvas); // +jt // FTransparentColor := clFuchsia; FUCXPSettings.ColorsChanged := false; OSVersionInfo.dwOSVersionInfoSize := sizeof(OSVersionInfo); GetVersionEx(OSVersionInfo); FIsWXP:=false; FIsW2k:=false; FIsWNT:=false; if OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then begin FIsWNT:=true; if (OSVersionInfo.dwMajorVersion = 5) and (OSVersionInfo.dwMinorVersion = 0) then FIsW2k:=true; if (OSVersionInfo.dwMajorVersion = 5) and (OSVersionInfo.dwMinorVersion = 1) then FIsWXP:=true; end; // +jt {moved to initialization section if not(csDesigning in ComponentState) then InitControls else exit; } if FActive then Self.Active := FActive; //if FForm.Handle <> 0 then // Windows.DrawMenuBar(FForm.Handle); end; destructor TUCXPStyle.Destroy; begin if Assigned(FForm) then //oleg oleg@vdv-s.ru Mon Oct 7 InitItems(FForm, false, false); // Remove XPStyle from UCXPStyleManager if Assigned(UCXPStyleManager) and not(csDesigning in ComponentState) then begin UCXPStyleManager.Delete(Self); FForm.Update; {moved to finalization section if UCXPStyleManager.FXPStyleList.Count = 0 then DoneControls; } end; //FFont.Free; moved to TCXPSettings FreeAndNil(FUCXPSettings); {added by fduenas} inherited Destroy; end; //add by: //liyang ,2002-07-19 //Pedro Miguel Cunha - 02 Apr 2002 procedure TUCXPStyle.Loaded; begin inherited Loaded; // Add the XPStyle to the UCXPStyleManager if Assigned(UCXPStyleManager) and not(csDesigning in ComponentState) then UCXPStyleManager.Add(Self); end; {to check for new sub items} procedure TUCXPStyle.ActivateMenuItem(MenuItem: TMenuItem; SubMenus: boolean); // +jt procedure Activate(MenuItem: TMenuItem); begin if (MenuItem.Tag <> 999) then if addr(MenuItem.OnDrawItem) <> addr(TUCXPStyle.DrawItem) then begin if (not assigned(MenuItem.OnDrawItem)) or (FUCXPSettings.OverrideOwnerDraw) then MenuItem.OnDrawItem := DrawItem; if (not assigned(MenuItem.OnMeasureItem)) or (FUCXPSettings.OverrideOwnerDraw) then MenuItem.OnMeasureItem := MeasureItem; end end; var i{, j}: integer; begin Activate(MenuItem); if (SubMenus=true) then // +jt begin for i := 0 to MenuItem.Count -1 do begin ActivateMenuItem(MenuItem.Items[i],true); end; end; end; procedure TUCXPStyle.InitItems(wForm: TWinControl; Enable, Update: boolean ); var i: integer; Comp: TComponent; begin for i := 0 to wForm.ComponentCount - 1 do begin Comp := wForm.Components[i]; InitItem(Comp, Enable, Update); // Tom: "Thomas Knoblauch" 27.08 end; end; procedure TUCXPStyle.InitComponent(Comp: TComponent); // Tom: for external (by the main program) use without parameters. "Thomas Knoblauch" 27.08 begin if FActive then InitItem(Comp, true, true); end; // Tom: "Thomas Knoblauch" 27.08 procedure TUCXPStyle.InitItem(Comp: TComponent; Enable, Update: boolean ); procedure Activate(MenuItem: TMenuItem); begin if Enable then begin if (MenuItem.Tag <> 999) then begin if (not assigned(MenuItem.OnDrawItem)) or (FUCXPSettings.OverrideOwnerDraw) then MenuItem.OnDrawItem := DrawItem; if (not assigned(MenuItem.OnMeasureItem)) or (FUCXPSettings.OverrideOwnerDraw) then MenuItem.OnMeasureItem := MeasureItem; end; end else begin if addr(MenuItem.OnDrawItem) = addr(TUCXPStyle.DrawItem) then MenuItem.OnDrawItem := nil; if addr(MenuItem.OnMeasureItem) = addr(TUCXPStyle.MeasureItem) then MenuItem.OnMeasureItem := nil; end; end; procedure ItrateMenu(MenuItem: TMenuItem); var i: integer; begin Activate(MenuItem); for i := 0 to MenuItem.Count - 1 do begin ItrateMenu(MenuItem.Items[i]); end; end; var x: integer; s: string; begin if (Comp is TMainMenu) and (xcMainMenu in FUCXPSettings.XPControls) and (TMainMenu(Comp).Tag <> 999)then begin for x := 0 to TMainMenu(Comp).Items.Count - 1 do begin TMainMenu(Comp).OwnerDraw := Enable; //Activate(TMainMenu(Comp).Items[x]); ItrateMenu(TMainMenu(Comp).Items[x]); end; // Selly way to force top menu in other forms to repaint S := TMainMenu(Comp).Items[0].Caption; TMainMenu(Comp).Items[0].Caption := ''; TMainMenu(Comp).Items[0].Caption := S; end; if (Comp is TPopupMenu) and (xcPopupMenu in FUCXPSettings.XPControls) then begin for x := 0 to TPopupMenu(Comp).Items.Count - 1 do begin TPopupMenu(Comp).OwnerDraw := Enable; ItrateMenu(TPopupMenu(Comp).Items[x]); end; end; {$IFDEF VER5U} if (Comp is TToolBar) and (xcToolBar in FUCXPSettings.XPControls) then if not (csDesigning in ComponentState) then begin if not TToolBar(Comp).Flat then TToolBar(Comp).Flat := true; if Enable then begin for x := 0 to TToolBar(Comp).ButtonCount - 1 do if (not assigned(TToolBar(Comp).OnCustomDrawButton)) or (FUCXPSettings.OverrideOwnerDraw) then begin TToolBar(Comp).OnCustomDrawButton := ToolBarDrawButton; end; end else begin if addr(TToolBar(Comp).OnCustomDrawButton) = addr(TUCXPStyle.ToolBarDrawButton) then TToolBar(Comp).OnCustomDrawButton := nil; end; if Update then TToolBar(Comp).Invalidate; end; {$ENDIF} if (Comp is TControlBar) and (xcControlBar in FUCXPSettings.XPControls) then if not (csDesigning in ComponentState) then begin if Enable then begin if (not assigned(TControlBar(Comp).OnBandPaint)) or (FUCXPSettings.OverrideOwnerDraw) then begin TControlBar(Comp).OnBandPaint := ControlBarPaint; end; end else begin if addr(TControlBar(Comp).OnBandPaint) = addr(TUCXPStyle.ControlBarPaint) then TControlBar(Comp).OnBandPaint := nil; end; if Update then TControlBar(Comp).Invalidate; end; if not (csDesigning in ComponentState) then if {$IFDEF VER6U} ((Comp is TCustomCombo) and (xcCombo in FUCXPSettings.XPControls)) or ((Comp is TCustomLabeledEdit) and (xcEdit in FUCXPSettings.XPControls)) or {$ELSE} ((Comp is TCustomComboBox) and (xcCombo in FUCXPSettings.XPControls)) or {$ENDIF} ((Comp is TEdit) and (xcEdit in FUCXPSettings.XPControls)) or ((Comp.ClassName = 'TMaskEdit') and (xcMaskEdit in FUCXPSettings.XPControls)) or ((Comp.ClassName = 'TDBEdit') and (xcMaskEdit in FUCXPSettings.XPControls)) or ((Comp is TCustomMemo) and (xcMemo in FUCXPSettings.XPControls)) or ((Comp is TCustomRichEdit) and (xcRichEdit in FUCXPSettings.XPControls)) or ((Comp is TCustomCheckBox) and (xcCheckBox in FUCXPSettings.XPControls)) or ((Comp is TRadioButton) and (xcRadioButton in FUCXPSettings.XPControls)) or ((Comp.ClassName = 'TBitBtn') and (xcBitBtn in FUCXPSettings.XPControls)) or ((Comp.ClassName = 'TButton') and (xcButton in FUCXPSettings.XPControls)) or ((Comp.ClassName = 'TUpDown') and (xcUpDown in FUCXPSettings.XPControls)) or ((Comp is TSpeedButton) and (xcSpeedButton in FUCXPSettings.XPControls)) or ((Comp is TCustomPanel) and (xcPanel in FUCXPSettings.XPControls)) or ((Comp.ClassName = 'TDBNavigator') and (xcButton in FUCXPSettings.XPControls)) or ((Comp.ClassName = 'TDBLookupComboBox') and (xcButton in FUCXPSettings.XPControls)) or ((Comp is TCustomGroupBox) and (xcGroupBox in FUCXPSettings.XPControls)) or ((Comp is TCustomListBox) and (xcListBox in FUCXPSettings.XPControls)) or ((Comp is TCustomTreeView) and (xcTreeView in FUCXPSettings.XPControls)) or ((Comp is TCustomListView) and (xcListView in FUCXPSettings.XPControls)) or ((Comp is TProgressBar) and (xcProgressBar in FUCXPSettings.XPControls)) or ((Comp is TCustomHotKey) and (xcHotKey in FUCXPSettings.XPControls)) then if ((TControl(Comp).Parent is TToolbar) and (xccToolBar in FUCXPSettings.XPContainers))or ((TControl(Comp).Parent is TCoolbar) and (xccCoolbar in FUCXPSettings.XPContainers)) or ((TControl(Comp).Parent is TCustomPanel) and (xccPanel in FUCXPSettings.XPContainers)) or ((TControl(Comp).Parent is TControlbar) and (xccControlbar in FUCXPSettings.XPContainers)) or ((TControl(Comp).Parent is TScrollBox) and (xccScrollBox in FUCXPSettings.XPContainers)) or ((TControl(Comp).Parent is TCustomGroupBox) and (xccGroupBox in FUCXPSettings.XPContainers)) or ((TControl(Comp).Parent is TTabSheet) and (xccTabSheet in FUCXPSettings.XPContainers)) or ((TControl(Comp).Parent is TTabControl) and (xccTabSheet in FUCXPSettings.XPContainers)) or ((TControl(Comp).Parent.ClassName = 'TdxTabSheet') and (xccTabSheet in FUCXPSettings.XPContainers)) or //DeveloperExpress ((TControl(Comp).Parent is TPageScroller) and (xccPageScroller in FUCXPSettings.XPContainers)) or {$IFDEF VER5U} ((TControl(Comp).Parent is TCustomFrame) and (xccFrame in FUCXPSettings.XPContainers)) or {$ENDIF} ((TControl(Comp).Parent.ClassName = 'TDBCtrlPanel') and (xccFrame in FUCXPSettings.XPContainers)) or ((TControl(Comp).Parent is TCustomForm) and (xccForm in FUCXPSettings.XPContainers)) then begin if (Enable) and (Comp.Tag <> 999) and (TControl(Comp).Parent.Tag <> 999) then {skip if Control/Control.parent.tag = 999} with TControlSubClass.Create(Self) do begin Control := TControl(Comp); if Addr(Control.WindowProc) <> Addr(TControlSubClass.ControlSubClass) then begin orgWindowProc := Control.WindowProc; Control.WindowProc := ControlSubClass; end; FXPStyle := self; if (Control is TCustomEdit) then begin FCtl3D := TEdit(Control).Ctl3D; FBorderStyle := TRichEdit(Control).BorderStyle; end; if Control.ClassName = 'TDBLookupComboBox' then begin FCtl3D := TComboBox(Control).Ctl3D; end; if (Control is TCustomListBox) then begin FCtl3D := TListBox(Control).Ctl3D; FBorderStyle := TListBox(Control).BorderStyle; end; if (Control is TCustomListView) then begin FCtl3D := TListView(Control).Ctl3D; FBorderStyle := TListView(Control).BorderStyle; end; if (Control is TCustomTreeView) then begin FCtl3D := TTreeView(Control).Ctl3D; FBorderStyle := TTreeView(Control).BorderStyle; end; end; if Update then begin TControl(Comp).invalidate //in TControlSubClass.ControlSubClass end; end; // Recursive call for possible containers. // Do recursive call for RadioGroups if (((Comp is TCustomRadioGroup)) and (xccGroupBox in FUCXPSettings.XPContainers)) then self.InitItems(Comp as TWinControl, Enable, Update); if {$IFDEF VER5U}((Comp is TCustomFrame) and (xccFrame in FUCXPSettings.XPContainers)) or {$ENDIF}(Comp.ClassName = 'TDBNavigator') or (Comp is TCustomForm) then //By Geir Wikran self.InitItems(Comp as TWinControl, Enable, Update); end; procedure TUCXPStyle.DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean); begin try //"Steve Rice" if FActive then MenueDrawItem(Sender, ACanvas, ARect, Selected); except end; end; function TUCXPStyle.GetImageExtent(MenuItem: TMenuItem; FTopMenu: TMenu): TPoint; var HasImgLstBitmap: boolean; B: TBitmap; begin B := TBitmap.Create; try B.Width := 0; B.Height := 0; Result.x := 0; Result.Y := 0; HasImgLstBitmap := false; // +jt if Assigned(FTopMenu) then begin if FTopMenu.Images <> nil then if MenuItem.ImageIndex <> -1 then HasImgLstBitmap := true; end; if (MenuItem.Parent.GetParentMenu.Images <> nil) {$IFDEF VER5U} or (MenuItem.Parent.SubMenuImages <> nil) {$ENDIF} then begin if MenuItem.ImageIndex <> -1 then HasImgLstBitmap := true else HasImgLstBitmap := false; end; if HasImgLstBitmap then begin {$IFDEF VER5U} if MenuItem.Parent.SubMenuImages <> nil then MenuItem.Parent.SubMenuImages.GetBitmap(MenuItem.ImageIndex, B) else {$ENDIF} MenuItem.Parent.GetParentMenu.Images.GetBitmap(MenuItem.ImageIndex, B) end else if MenuItem.Bitmap.Width > 0 then B.Assign(TBitmap(MenuItem.Bitmap)); Result.x := B.Width; Result.Y := B.Height; if not Assigned(FTopMenu) then // +jt if Result.x < FUCXPSettings.IconWidth then Result.x := FUCXPSettings.IconWidth; finally B.Free; end; end; procedure TUCXPStyle.MeasureItem(Sender: TObject; ACanvas: TCanvas; var Width, Height: Integer); var s: string; W, H: integer; P: TPoint; IsLine: boolean; FTopMenu: boolean; // +jt FMenu: TMenu; // +jt i: integer; // +jt begin FTopMenu:=false; //+jt if FActive then begin S := TMenuItem(Sender).Caption; if S = '-' then IsLine := true else IsLine := false; if IsLine then S := ''; if Trim(ShortCutToText(TMenuItem(Sender).ShortCut)) <> '' then S := S + ShortCutToText(TMenuItem(Sender).ShortCut) + 'WWW'; ACanvas.Font.Assign(FUCXPSettings.Font); W := ACanvas.TextWidth(s); Inc(W, 5); if pos('&', s) > 0 then W := W - ACanvas.TextWidth('&'); // +jt FMenu := TMenuItem(Sender).Parent.GetParentMenu; if FMenu is TMainMenu then begin for i := 0 to TMenuItem(Sender).GetParentMenu.Items.Count - 1 do if TMenuItem(Sender).GetParentMenu.Items[i] = TMenuItem(Sender) then begin FTopMenu := True; break; end end; if not FTopMenu then FMenu := nil; if(not FTopMenu) and (TMenuItem(Sender).Count>0) then Inc(W,6); // +jt // +jt P := GetImageExtent(TMenuItem(Sender), FMenu); // +jt W := W + P.x ; if Width < W then Width := W; if IsLine then Height := 4 else begin H := ACanvas.TextHeight(s) + Round(ACanvas.TextHeight(s) * 0.75); if P.y + 6 > H then H := P.y + 6; if Height < H then Height := H; end; end; end; procedure TUCXPStyle.MenueDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean); var txt: string; B: TBitmap; IconRect, TextRect, CheckedRect: TRect; FillRect: TRect; // +jt i, X1, X2: integer; TextFormat: integer; HasImgLstBitmap: boolean; HasBitmap: boolean; FMenuItem: TMenuItem; FMenu: TMenu; FTopMenu: boolean; IsLine: boolean; ImgListHandle: HImageList; {Commctrl.pas} ImgIndex: integer; hWndM: HWND; hDcM: HDC; DrawTopMenuBorder: boolean; msg: TMSG; // +jt buff: TBitmap; // +jt OrigRect: TRect; // +jt OrigCanvas: TCanvas; // +jt FFontSettings: TFont; begin OrigCanvas:= nil; FTopMenu := false; FMenuItem := TMenuItem(Sender); // +jt B := TBitmap.Create; buff := TBitmap.Create; try origrect:= ARect; Dec(origrect.Left,4); origcanvas:=ACanvas; ARect.Right:=(ARect.Right-ARect.Left)+4; ARect.Bottom:=ARect.Bottom-ARect.Top; ARect.Left:=4; ARect.Top:=0; buff.Width := ARect.Right; buff.Height := ARect.Bottom; ACanvas:=buff.Canvas; // +jt //SetGlobalColor(ACanvas); if FMenuItem.Caption = '-' then IsLine := true else IsLine := false; FMenu := FMenuItem.Parent.GetParentMenu; if FMenu is TMainMenu then for i := 0 to FMenuItem.GetParentMenu.Items.Count - 1 do if FMenuItem.GetParentMenu.Items[i] = FMenuItem then begin FTopMenu := True; // +jt ARect.Left:=0; Inc(origrect.Left,4); Dec(ARect.Right,4); buff.Width:=ARect.Right; Dec(ARect.Bottom,1); // +jt break; end; if(FUCXPSettings.ColorsChanged) then SetGlobalColor(ACanvas); // +jt ACanvas.Font.Assign(FUCXPSettings.Font); Inc(ARect.Bottom, 1); TextRect := ARect; txt := ' ' + FMenuItem.Caption; // B := TBitmap.Create; //Leslie Cutting lesnes@absamail.co.za Jul 8 2003 HasBitmap := false; HasImgLstBitmap := false; if (FMenuItem.Parent.GetParentMenu.Images <> nil) {$IFDEF VER5U} or (FMenuItem.Parent.SubMenuImages <> nil) {$ENDIF} then begin if FMenuItem.ImageIndex <> -1 then HasImgLstBitmap := true else HasImgLstBitmap := false; end; if FMenuItem.Bitmap.Width > 0 then HasBitmap := true; //------- if HasBitmap then begin B.Width := FMenuItem.Bitmap.Width; B.Height := FMenuItem.Bitmap.Height; // +jt //B.Canvas.Brush.Color := FTransparentColor; // ACanvas.Brush.Color; B.Canvas.Brush.Color := B.Canvas.Pixels[0, B.Height - 1];//"Todd Asher" B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height)); FMenuItem.Bitmap.Transparent := true; FMenuItem.Bitmap.TransparentMode := tmAuto; B.Canvas.Draw(0,0,FMenuItem.Bitmap); // +jt end; if HasImgLstBitmap then begin {$IFDEF VER5U} if FMenuItem.Parent.SubMenuImages <> nil then begin ImgListHandle := FMenuItem.Parent.SubMenuImages.Handle; ImgIndex := FMenuItem.ImageIndex; B.Width := FMenuItem.Parent.SubMenuImages.Width; B.Height := FMenuItem.Parent.SubMenuImages.Height; // B.Canvas.Brush.Color := FTransparentColor; // ACanvas.Brush.Color; // +jt B.Canvas.Brush.Color := B.Canvas.Pixels[0, B.Height - 1];//"Todd Asher" B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height)); ImageList_DrawEx(ImgListHandle, ImgIndex, B.Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_Transparent); end else {$ENDIF} if FMenuItem.Parent.GetParentMenu.Images <> nil then begin ImgListHandle := FMenuItem.Parent.GetParentMenu.Images.Handle; ImgIndex := FMenuItem.ImageIndex; B.Width := FMenuItem.Parent.GetParentMenu.Images.Width; B.Height := FMenuItem.Parent.GetParentMenu.Images.Height; //B.Canvas.Brush.Color := FTransparentColor; //ACanvas.Pixels[2,2]; // +jt B.Canvas.Brush.Color := B.Canvas.Pixels[0, B.Height - 1];//"Todd Asher" B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height)); ImageList_DrawEx(ImgListHandle, ImgIndex, B.Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_Transparent); end; end; //----- if FMenu.IsRightToLeft then begin X1 := ARect.Right - FUCXPSettings.IconWidth; X2 := ARect.Right; end else begin X1 := ARect.Left; X2 := ARect.Left + FUCXPSettings.IconWidth; end; IconRect := Rect(X1, ARect.Top, X2, ARect.Bottom); if HasImgLstBitmap or HasBitmap then begin CheckedRect := IconRect; Inc(CheckedRect.Left, 1); Inc(CheckedRect.Top, 2); Dec(CheckedRect.Right, 3); Dec(CheckedRect.Bottom, 2); end else begin CheckedRect.Left := IconRect.Left + (IConRect.Right - IconRect.Left - 10) div 2; CheckedRect.Top := IconRect.Top + (IConRect.Bottom - IconRect.Top - 10) div 2; CheckedRect.Right := CheckedRect.Left + 10; CheckedRect.Bottom := CheckedRect.Top + 10; end; if B.Width > FUCXPSettings.IconWidth then if FMenu.IsRightToLeft then CheckedRect.Left := CheckedRect.Right - B.Width else CheckedRect.Right := CheckedRect.Left + B.Width; if FTopMenu then Dec(CheckedRect.Top, 1); if FMenu.IsRightToLeft then begin X1 := ARect.Left; if not FTopMenu then Dec(X2, FUCXPSettings.IconWidth) else Dec(X2, 4); if (ARect.Right - B.Width) < X2 then X2 := ARect.Right - B.Width - 8; end else begin X1 := ARect.Left ; if not FTopMenu then Inc(X1, FUCXPSettings.IconWidth) else Inc(X1, 4); if (ARect.Left + B.Width) > X1 then X1 := ARect.Left + B.Width + 4; X2 := ARect.Right; end; TextRect := Rect(X1, ARect.Top, X2, ARect.Bottom); // +jt FillRect := ARect; Dec(FillRect.Left,4); // +jt if FTopMenu then begin if not (HasImgLstBitmap or HasBitmap) then begin TextRect := ARect; end else begin if FMenu.IsRightToLeft then TextRect.Right := TextRect.Right + 5 else TextRect.Left := TextRect.Left - 5; end end; if FTopMenu then begin if FUCXPSettings.DrawMenuBar then FFMenuBarColor := FUCXPSettings.MenuBarColor; ACanvas.brush.color := FFMenuBarColor; ACanvas.Pen.Color := FFMenuBarColor; // Inc(ARect.Bottom, 2); ACanvas.FillRect(ARect); //-- if FUCXPSettings.DrawMenuBar then begin if FMenuItem.GetParentMenu.Items[FMenuItem.GetParentMenu.Items.Count-1] = FMenuItem then begin if FMenu.IsRightToLeft then ACanvas.Rectangle(3, ARect.Top, ARect.Right, ARect.Bottom) else ACanvas.Rectangle(ARect.Left, ARect.Top, TScrollingWinControl(FMenu.Owner).ClientWidth+5{FForm.ClientWidth+5}, ARect.Bottom); end else if FMenu.IsRightToLeft then ACanvas.Rectangle(ARect.Left, ARect.Top, ARect.Right+7, ARect.Bottom); end; //-- end else begin if (Is16Bit and FUCXPSettings.Gradient) then begin inc(ARect.Right,2); //needed for RightToLeft DrawGradient(ACanvas, ARect, FMenu.IsRightToLeft); Dec(ARect.Right,2); end else begin ACanvas.brush.color := FFColor; ACanvas.FillRect(FillRect); // +jt ACanvas.brush.color := FFIconBackColor; ACanvas.FillRect(IconRect); end; //------------ end; if FMenuItem.Enabled then ACanvas.Font.Color := FUCXPSettings.Font.Color else ACanvas.Font.Color := FUCXPSettings.DisabledColor; DrawTopMenuBorder := false; if Selected and FUCXPSettings.DrawSelect then begin ACanvas.brush.Style := bsSolid; if FTopMenu then begin DrawTopMenuItem(FMenuItem, ACanvas, ARect, FUCXPSettings.MenuBarColor, FMenu.IsRightToLeft); end else if FMenuItem.Enabled then begin Inc(ARect.Top, 1); Dec(ARect.Bottom, 1); if FUCXPSettings.FlatMenu then Dec(ARect.Right, 1); ACanvas.brush.color := FFSelectColor; ACanvas.FillRect(ARect); ACanvas.Pen.color := FFSelectBorderColor; ACanvas.Brush.Style := bsClear; ACanvas.RoundRect(Arect.Left, Arect.top, Arect.Right, Arect.Bottom, 0, 0); Dec(ARect.Top, 1); Inc(ARect.Bottom, 1); if FUCXPSettings.FlatMenu then Inc(ARect.Right, 1); end; DrawTopMenuBorder := true; end // Draw the menubar in XP Style when hovering over an main menu item else begin //if FMenuItem.Enabled and FTopMenu and IsMouseInRect( TScrollingWinControl(FMenu.Owner), ARect) then if FMenuItem.Enabled and FTopMenu and IsWNT and IsMouseInRect( TScrollingWinControl(FMenu.Owner), origrect) then // +jt begin ACanvas.brush.Style := bsSolid; ACanvas.brush.color := FFSelectColor; DrawTopMenuBorder := true; ACanvas.Pen.color := FFSelectBorderColor; ACanvas.Rectangle(ARect.Left, ARect.Top, ARect.Right - 7, ARect.Bottom); end; end; if (FMenuItem.Checked) or (FMenuItem.RadioItem ) then //x DrawCheckedItem(FMenuItem, Selected, FMenuItem.Enabled, HasImgLstBitmap or HasBitmap, ACanvas, CheckedRect); if (B <> nil) and (B.Width > 0) then // X DrawIcon(FMenuItem, ACanvas, B, IconRect, Selected or DrawTopMenuBorder, False, FMenuItem.Enabled, FMenuItem.Checked, FTopMenu, FMenu.IsRightToLeft); if not IsLine then begin if FMenu.IsRightToLeft then begin TextFormat := DT_RIGHT + DT_RTLREADING; Dec(TextRect.Right, 3); end else begin TextFormat := 0; Inc(TextRect.Left, 3); end; TextRect.Top := TextRect.Top + ((TextRect.Bottom - TextRect.Top) - ACanvas.TextHeight('W')) div 2; FFontSettings := FUCXPSettings.Font; DrawTheText(FMenuItem, txt, ShortCutToText(FMenuItem.ShortCut), ACanvas, TextRect, Selected, FMenuItem.Enabled, FMenuItem.Default, FTopMenu, FMenu.IsRightToLeft, FFontSettings, TextFormat); FUCXPSettings.Font := FFontSettings; end else begin if FMenu.IsRightToLeft then begin X1 := TextRect.Left; X2 := TextRect.Right - 7; end else begin X1 := TextRect.Left + 7; X2 := TextRect.Right; end; ACanvas.Pen.Color := FFSeparatorColor; ACanvas.MoveTo(X1, TextRect.Top + Round((TextRect.Bottom - TextRect.Top) / 2)); ACanvas.LineTo(X2, TextRect.Top + Round((TextRect.Bottom - TextRect.Top) / 2)) end; // +jt BitBlt(origcanvas.Handle,origrect.Left,origrect.Top,buff.Width,buff.Height,ACanvas.Handle,0,0,SRCCOPY); finally B.free; buff.free; ACanvas := OrigCanvas; ARect:=origrect; end; // +jt if not (csDesigning in ComponentState) then begin if (FUCXPSettings.FlatMenu) and (not FTopMenu) then begin hDcM := ACanvas.Handle; hWndM := WindowFromDC(hDcM); // +jt if (hWndM=0) and (Application.Handle<>0) then begin if not PeekMessage(msg,Application.Handle,WM_DRAWMENUBORDER,WM_DRAWMENUBORDER2,PM_NOREMOVE) then PostMessage(Application.Handle,WM_DRAWMENUBORDER,0,Integer(FMenuItem)); end else if hWndM <> FForm.Handle then begin if not PeekMessage(msg,Application.Handle,WM_DRAWMENUBORDER,WM_DRAWMENUBORDER2,PM_NOREMOVE) then PostMessage(Application.Handle,WM_DRAWMENUBORDER2,integer(FMenu.IsRightToLeft),Integer(hWndM)); end; end; end; //----- end; {$IFDEF VER5U} procedure TUCXPStyle.ToolBarDrawButton(Sender: TToolBar; Button: TToolButton; State: TCustomDrawState; var DefaultDraw: Boolean); var ACanvas: TCanvas; ARect, HoldRect: TRect; B: TBitmap; HasBitmap: boolean; {Sylvain ...} HasHotBitMap : Boolean; HasDisBitMap : Boolean; ImglstHand : THandle; CanDraw : Boolean; {... Sylvain} BitmapWidth: integer; TextFormat: integer; XButton: TToolButton; HasBorder: boolean; HasBkg: boolean; IsTransparent: boolean; FBSelectColor: TColor; FFontSettings: TFont; {fduenas} procedure DrawBorder; var BRect, WRect: TRect; procedure DrawRect; begin ACanvas.Pen.color := FFSelectBorderColor; ACanvas.MoveTo(WRect.Left, WRect.Top); ACanvas.LineTo(WRect.Right, WRect.Top); ACanvas.LineTo(WRect.Right, WRect.Bottom); ACanvas.LineTo(WRect.Left, WRect.Bottom); ACanvas.LineTo(WRect.Left, WRect.Top); end; begin BRect := HoldRect; Dec(BRect.Bottom, 1); Inc(BRect.Top, 1); Dec(BRect.Right, 1); WRect := BRect; if Button.Style = tbsDropDown then begin Dec(WRect.Right, 13); DrawRect; WRect := BRect; Inc(WRect.Left, WRect.Right - WRect.Left - 13); DrawRect; end else begin DrawRect; end; end; begin B := nil; {Added By Sylvain ...} HasHotBitmap := (Sender.HotImages <> nil) and (Button.ImageIndex <> -1) and (Button.ImageIndex <= Sender.HotImages.Count - 1); HasDisBitmap := (Sender.DisabledImages <> nil) and (Button.ImageIndex <> -1) and (Button.ImageIndex <= Sender.DisabledImages.Count - 1); {...Sylvain} HasBitmap := (Sender.Images <> nil) and (Button.ImageIndex <> -1) and (Button.ImageIndex <= Sender.Images.Count - 1); IsTransparent := Sender.Transparent; ACanvas := Sender.Canvas; //SetGlobalColor(ACanvas); if (FUCXPSettings.ColorsChanged) then SetGlobalColor(ACanvas); // +jt if (Is16Bit) and (not FUCXPSettings.UseSystemColors) then FBSelectColor := NewColor(ACanvas, FUCXPSettings.SelectColor, 68) else FBSelectColor := FFSelectColor; HoldRect := Button.BoundsRect; ARect := HoldRect; if Is16Bit then ACanvas.brush.color := NewColor(ACanvas, Sender.Color, 16) else ACanvas.brush.color := Sender.Color; if not IsTransparent then ACanvas.FillRect(ARect); HasBorder := false; HasBkg := false; if (cdsHot in State) then begin if (cdsChecked in State) or (Button.Down) or (cdsSelected in State) then ACanvas.Brush.Color := FCheckedAreaSelectColor else ACanvas.brush.color := FBSelectColor; HasBorder := true; HasBkg := true; end; if ((cdsChecked in State) and not (cdsHot in State)) then begin ACanvas.Brush.Color := FCheckedAreaColor; HasBorder := true; HasBkg := true; end; if (cdsIndeterminate in State) and not (cdsHot in State) then begin ACanvas.Brush.Color := FBSelectColor; HasBkg := true; end; if (Button.MenuItem <> nil) and (State = []) then begin ACanvas.brush.color := Sender.Color; if not IsTransparent then HasBkg := true; end; Inc(ARect.Top, 1); if HasBkg then ACanvas.FillRect(ARect); if HasBorder then DrawBorder; if ((Button.MenuItem <> nil) or (Button.DropdownMenu <> nil)) and (cdsSelected in State) then begin DrawTopMenuItem(Button, ACanvas, ARect, Sender.Color ,false); DefaultDraw := false; end; ARect := HoldRect; DefaultDraw := false; if Button.Style = tbsDropDown then begin ACanvas.Pen.Color := clBlack; DrawArrow(ACanvas, (ARect.Right - 14) + ((14 - 5) div 2), ARect.Top + ((ARect.Bottom - ARect.Top - 3) div 2) + 1); end; BitmapWidth := 0; { Rem by Sylvain ... if HasBitmap then begin ... Sylvain} try B := TBitmap.Create; CanDraw := False; ImglstHand:=0; if (cdsHot in State) AND HasHotBitmap then begin B.Width := Sender.HotImages.Width; B.Height := Sender.HotImages.Height; ImglstHand := Sender.HotImages.Handle; CanDraw := True; end else if (cdsDisabled in State) and HasDisBitmap then begin B.Width := Sender.DisabledImages.Width; B.Height := Sender.DisabledImages.Height; ImglstHand := Sender.DisabledImages.Handle; CanDraw := True; end else if HasBitMap then begin B.Width := Sender.Images.Width; B.Height := Sender.Images.Height; ImglstHand := Sender.Images.Handle; CanDraw := True; end; if CanDraw then begin {CanDraw} // B.Canvas.Brush.Color := TransparentColor; // ACanvas.Brush.Color; // +jt B.Canvas.Brush.Color := B.Canvas.Pixels[0, B.Height - 1];//"Todd Asher" B.Canvas.FillRect(Rect(0, 0, B.Width, B.Height)); ImageList_DrawEx(ImglstHand, Button.ImageIndex, B.Canvas.Handle, 0, 0, 0, 0, clNone, clNone, ILD_Transparent); BitmapWidth := b.Width; if Button.Style = tbsDropDown then Dec(ARect.Right, 12); if TToolBar(Button.Parent).List then begin if Button.BiDiMode = bdRightToLeft then begin Dec(ARect.Right, 3); ARect.Left := ARect.Right - BitmapWidth; end else begin Inc(ARect.Left, 3); ARect.Right := ARect.Left + BitmapWidth end end else ARect.Left := Round(ARect.Left + (ARect.Right - ARect.Left - B.Width)/2); inc(ARect.Top, 2); ARect.Bottom := ARect.Top + B.Height + 6; DrawIcon(Button, ACanvas, B, ARect, (cdsHot in State), (cdsSelected in State), Button.Enabled, (cdsChecked in State), false, false); end; {CanDraw} finally B.Free; end; ARect := HoldRect; DefaultDraw := false; {rem by sylvain ... end; ...Sylvain} //----------- if Sender.ShowCaptions then begin if Button.Style = tbsDropDown then Dec(ARect.Right, 12); if not TToolBar(Button.Parent).List then begin TextFormat := DT_Center; ARect.Top := ARect.Bottom - ACanvas.TextHeight(Button.Caption) - 6; end else begin TextFormat := DT_VCENTER; if Button.BiDiMode = bdRightToLeft then begin TextFormat := TextFormat + DT_Right; Dec(ARect.Right, BitmapWidth + 7); end else begin if BitmapWidth > 0 then //"Dan Downs" if Sender.List then //Michaël Moreno Inc(ARect.Left, BitmapWidth + 6) else Inc(ARect.Left, BitmapWidth); end end; if (Button.MenuItem <> nil) then begin TextFormat := DT_Center; //Inc(ARect.Left, 1); end; if Button.BiDiMode = bdRightToLeft then TextFormat := TextFormat + DT_RTLREADING; if Button.Down and not Button.Enabled then //"felix" 23/5 InflateRect(ARect, -1, -1); {alexs alexs75@hotbox.ru} ARect.Top := ARect.Top + ((ARect.Bottom - ARect.Top) - ACanvas.TextHeight('W')) div 2; FFontSettings := FUCXPSettings.Font; DrawTheText(Button, Button.Caption, '', ACanvas, ARect, (cdsSelected in State), Button.Enabled, false, (Button.MenuItem <> nil), (Button.BidiMode = bdRightToLeft), FFontSettings, TextFormat); FUCXPSettings.Font := FFontSettings; ARect := HoldRect; DefaultDraw := false; end; if Button.Index > 0 then begin XButton := {TToolBar(Button.Parent)}Sender.Buttons[Button.Index - 1]; if (XButton.Style = tbsDivider) or (XButton.Style = tbsSeparator) then begin ARect := XButton.BoundsRect; if Is16Bit then ACanvas.brush.color := NewColor(ACanvas, Sender.Color, 16) else ACanvas.brush.color := Sender.Color; if not IsTransparent then ACanvas.FillRect(ARect); // if (XButton.Style = tbsDivider) then // Can't get it. if XButton.Tag > 0 then begin Inc(ARect.Top, 2); Dec(ARect.Bottom, 1); ACanvas.Pen.color := GetShadeColor(ACanvas,Sender.Color,30); ARect.Left := ARect.Left + (ARect.Right - ARect.Left) div 2; ACanvas.MoveTo(ARect.Left, ARect.Top); ACanvas.LineTo(ARect.Left, ARect.Bottom); end; ARect := Button.BoundsRect; DefaultDraw := false; end; end; {if Button.MenuItem <> nil then if (xcMainMenu in UCXPControls) then ActivateMenuItem(Button.MenuItem);} end; {$ENDIF} // Controlbar Paint. Added by Michiel van Oudheusden (27 sep 2001) // Paints the bands of a controlbar like the office XP style procedure TUCXPStyle.ControlBarPaint(Sender: TObject; Control: TControl; Canvas: TCanvas; var ARect: TRect; var Options: TBandPaintOptions); var i: Integer; intInc: integer; begin if(FUCXPSettings.ColorsChanged) then SetGlobalColor(Canvas); // +jt // No frame and grabber drawing. We do it ourselfes Options := []; // First background if Is16Bit then Canvas.brush.color := NewColor(Canvas, TControlBar(Sender).Color , 6) else Canvas.brush.color := TControlBar(Sender).Color; Canvas.FillRect(ARect); intInc := 30; for i := (ARect.Top + 5) to (ARect.Bottom - 5)do begin Canvas.Pen.Color := GetShadeColor(Canvas, TControlBar(Sender).Color, intInc); if i mod 2 = 0 then begin Canvas.MoveTo(ARect.Left + 3, i); Canvas.LineTo(ARect.Left + 6, i); Inc(intInc, 7); end; end; end; procedure TUCXPStyle.SetGlobalColor(ACanvas: TCanvas); begin //----- FUCXPSettings.ColorsChanged:=false; // +jt if GetDeviceCaps(ACanvas.Handle, BITSPIXEL) < 16 then Is16Bit := false else Is16Bit := true; FDimParentColor := 16; FDimParentColorSelect := 40; FFColor := FUCXPSettings.Color; FFIconBackColor := FUCXPSettings.IconBackColor; if Is16Bit then begin if FUCXPSettings.UseDimColor then begin FFSelectColor := NewColor(ACanvas, FUCXPSettings.SelectColor, 68); FCheckedAreaColor := NewColor(ACanvas, FUCXPSettings.SelectColor, 80); FCheckedAreaSelectColor := NewColor(ACanvas, FUCXPSettings.SelectColor, 50); end else begin FFSelectColor := FUCXPSettings.SelectColor; FCheckedAreaColor := FUCXPSettings.SelectColor; FCheckedAreaSelectColor := FUCXPSettings.SelectColor; end; FMenuBorderColor := GetShadeColor(ACanvas, clBtnFace, 90); FMenuShadowColor := GetShadeColor(ACanvas, clBtnFace, 76); end else begin FFSelectColor := FUCXPSettings.SelectColor; FCheckedAreaColor := clWhite; FCheckedAreaSelectColor := clSilver; FMenuBorderColor := clBtnShadow; FMenuShadowColor := clBtnShadow; end; FFSelectBorderColor := FUCXPSettings.SelectBorderColor; FFSelectFontColor := FUCXPSettings.SelectFontColor; FFMenuBarColor := FUCXPSettings.MenuBarColor; FFDisabledColor := FUCXPSettings.DisabledColor; FFCheckedColor := FUCXPSettings.CheckedColor; FFSeparatorColor := FUCXPSettings.SeparatorColor; if FUCXPSettings.UseSystemColors then begin // GetSystemMenuFont(FUCXPSettings.Font); FFSelectFontColor := FUCXPSettings.Font.Color; if not Is16Bit then begin FFColor := clWhite; FFIconBackColor := clBtnFace; FFSelectColor := clWhite; FFSelectBorderColor := clHighlight; FFMenuBarColor := FFIconBackColor; FFDisabledColor := clBtnShadow; FFCheckedColor := clHighlight; FFSeparatorColor := clBtnShadow; FCheckedAreaColor := clWhite; FCheckedAreaSelectColor := clWhite; end else begin FFColor := NewColor(ACanvas, clBtnFace, 86); FFIconBackColor := NewColor(ACanvas, clBtnFace, 16); FFSelectColor := NewColor(ACanvas, clHighlight, 68); FFSelectBorderColor := clHighlight; FFMenuBarColor := clBtnFace; FFDisabledColor := NewColor(ACanvas, clBtnShadow, 10); FFSeparatorColor := NewColor(ACanvas, clBtnShadow, 25); FFCheckedColor := clHighlight; FCheckedAreaColor := NewColor(ACanvas, clHighlight, 80); FCheckedAreaSelectColor := NewColor(ACanvas, clHighlight, 50); end; end; end; procedure TUCXPStyle.DrawTopMenuItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; BckColor:Tcolor; IsRightToLeft: boolean); var X1, X2: integer; DefColor, HoldColor: TColor; begin X1 := ARect.Left; X2 := ARect.Right; ACanvas.brush.Style := bsSolid; ACanvas.brush.color := FFSelectColor; ACanvas.FillRect(ARect); ACanvas.Pen.Color := FFSelectBorderColor; if (not IsRightToLeft) and (Is16Bit) and (Sender is TMenuItem) then begin ACanvas.MoveTo(X1, ARect.Bottom - 1); ACanvas.LineTo(X1, ARect.Top); ACanvas.LineTo(X2 - 8, ARect.Top); ACanvas.LineTo(X2 - 8, ARect.Bottom); // ACanvas.LineTo(X1, ARect.Bottom); DefColor := FFMenuBarColor; HoldColor := GetShadeColor(ACanvas, DefColor, 10); ACanvas.Brush.Style := bsSolid; ACanvas.Brush.Color := HoldColor; ACanvas.Pen.Color := HoldColor; ACanvas.FillRect(Rect(X2 - 7, ARect.Top, X2, ARect.Bottom)); HoldColor := GetShadeColor(ACanvas, DefColor, 30); ACanvas.Brush.Color := HoldColor; ACanvas.Pen.Color := HoldColor; ACanvas.FillRect(Rect(X2 - 7, ARect.Top + 3, X2 - 2, ARect.Bottom)); HoldColor := GetShadeColor(ACanvas, DefColor, 40 + 20); ACanvas.Brush.Color := HoldColor; ACanvas.Pen.Color := HoldColor; ACanvas.FillRect(Rect(X2 - 7, ARect.Top + 5, X2 - 3, ARect.Bottom)); HoldColor := GetShadeColor(ACanvas, DefColor, 60 + 40); ACanvas.Brush.Color := HoldColor; ACanvas.Pen.Color := HoldColor; ACanvas.FillRect(Rect(X2 - 7, ARect.Top + 6, X2 - 5, ARect.Bottom)); //--- ACanvas.Pen.Color := DefColor; ACanvas.MoveTo(X2 - 5, ARect.Top + 1); ACanvas.LineTo(X2 - 1, ARect.Top + 1); ACanvas.LineTo(X2 - 1, ARect.Top + 6); ACanvas.MoveTo(X2 - 3, ARect.Top + 2); ACanvas.LineTo(X2 - 2, ARect.Top + 2); ACanvas.LineTo(X2 - 2, ARect.Top + 3); ACanvas.LineTo(X2 - 3, ARect.Top + 3); ACanvas.Pen.Color := GetShadeColor(ACanvas, DefColor, 10); ACanvas.MoveTo(X2 - 6, ARect.Top + 3); ACanvas.LineTo(X2 - 3, ARect.Top + 3); ACanvas.LineTo(X2 - 3, ARect.Top + 6); ACanvas.LineTo(X2 - 4, ARect.Top + 6); ACanvas.LineTo(X2 - 4, ARect.Top + 3); ACanvas.Pen.Color := GetShadeColor(ACanvas, DefColor, 30); ACanvas.MoveTo(X2 - 5, ARect.Top + 5); ACanvas.LineTo(X2 - 4, ARect.Top + 5); ACanvas.LineTo(X2 - 4, ARect.Top + 9); ACanvas.Pen.Color := GetShadeColor(ACanvas, DefColor, 40); ACanvas.MoveTo(X2 - 6, ARect.Top + 5); ACanvas.LineTo(X2 - 6, ARect.Top + 7); end else begin ACanvas.Pen.Color := FFSelectBorderColor; ACanvas.Brush.Color := GetShadeColor(ACanvas, BckColor, 70); ACanvas.MoveTo(X1, ARect.Bottom - 1); ACanvas.LineTo(X1, ARect.Top); ACanvas.LineTo(X2 - 3, ARect.Top); ACanvas.LineTo(X2 - 3, ARect.Bottom); ACanvas.Pen.Color := ACanvas.Brush.Color; ACanvas.FillRect(Rect(X2 - 2, ARect.Top + 2, X2, ARect.Bottom)); ACanvas.Brush.Color := BckColor; ACanvas.FillRect(Rect(X2 - 2, ARect.Top , X2, ARect.Top + 2)); end; end; procedure TUCXPStyle.DrawCheckedItem(FMenuItem: TMenuItem; Selected, Enabled, HasImgLstBitmap: boolean; ACanvas: TCanvas; CheckedRect: TRect); var X1, X2: integer; begin if FMenuItem.RadioItem then begin if FMenuItem.Checked then begin if Enabled then begin ACanvas.Pen.color := FFSelectBorderColor; if selected then ACanvas.Brush.Color := FCheckedAreaSelectColor else ACanvas.Brush.Color := FCheckedAreaColor; end else ACanvas.Pen.color := FFDisabledColor; ACanvas.Brush.Style := bsSolid; if HasImgLstBitmap then begin ACanvas.RoundRect(CheckedRect.Left, CheckedRect.Top, CheckedRect.Right, CheckedRect.Bottom, 6, 6); end else begin ACanvas.Ellipse(CheckedRect.Left, CheckedRect.Top, CheckedRect.Right, CheckedRect.Bottom); // +jt InflateRect(CheckedRect, -2, -2); ACanvas.Brush.color := ACanvas.Pen.Color; ACanvas.Ellipse(CheckedRect.Left, CheckedRect.Top, CheckedRect.Right, CheckedRect.Bottom); // +jt end; end; end else begin if (FMenuItem.Checked) then if (not HasImgLstBitmap) then begin if Enabled then begin ACanvas.Pen.color := FFCheckedColor; if selected then ACanvas.Brush.Color := FCheckedAreaSelectColor else ACanvas.Brush.Color := FCheckedAreaColor; ; end else ACanvas.Pen.color := FFDisabledColor; ACanvas.Brush.Style := bsSolid; ACanvas.Rectangle(CheckedRect.Left, CheckedRect.Top, CheckedRect.Right, CheckedRect.Bottom); if Enabled then ACanvas.Pen.color := clBlack else ACanvas.Pen.color := FFDisabledColor; x1 := CheckedRect.Left + 1; x2 := CheckedRect.Top + 5; ACanvas.MoveTo(x1, x2); x1 := CheckedRect.Left + 4; x2 := CheckedRect.Bottom - 2; ACanvas.LineTo(x1, x2); //-- x1 := CheckedRect.Left + 2; x2 := CheckedRect.Top + 5; ACanvas.MoveTo(x1, x2); x1 := CheckedRect.Left + 4; x2 := CheckedRect.Bottom - 3; ACanvas.LineTo(x1, x2); //-- x1 := CheckedRect.Left + 2; x2 := CheckedRect.Top + 4; ACanvas.MoveTo(x1, x2); x1 := CheckedRect.Left + 5; x2 := CheckedRect.Bottom - 3; ACanvas.LineTo(x1, x2); //----------------- x1 := CheckedRect.Left + 4; x2 := CheckedRect.Bottom - 3; ACanvas.MoveTo(x1, x2); x1 := CheckedRect.Right + 2; x2 := CheckedRect.Top - 1; ACanvas.LineTo(x1, x2); //-- x1 := CheckedRect.Left + 4; x2 := CheckedRect.Bottom - 2; ACanvas.MoveTo(x1, x2); x1 := CheckedRect.Right - 2; x2 := CheckedRect.Top + 3; ACanvas.LineTo(x1, x2); end else begin if Enabled then begin ACanvas.Pen.color := FFSelectBorderColor; if selected then ACanvas.Brush.Color := FCheckedAreaSelectColor else ACanvas.Brush.Color := FCheckedAreaColor; ; end else ACanvas.Pen.color := FFDisabledColor; ACanvas.Brush.Style := bsSolid; ACanvas.Rectangle(CheckedRect.Left, CheckedRect.Top, CheckedRect.Right, CheckedRect.Bottom); end; end; end; procedure TUCXPStyle.DrawTheText(Sender: TObject; txt, ShortCuttext: string; ACanvas: TCanvas; TextRect: TRect; Selected, Enabled, Default, TopMenu, IsRightToLeft: boolean; var TxtFont: TFont; TextFormat: integer); var DefColor: TColor; B: TBitmap; BRect: TRect; begin TextFormat := TextFormat + DT_EXPANDTABS; DefColor := TxtFont.Color; ACanvas.Font.Assign (TxtFont); if Selected then DefColor := FFSelectFontColor; If not Enabled then begin DefColor := FFDisabledColor; if (Sender is TToolButton) then begin TextRect.Top := TextRect.Top + ((TextRect.Bottom - TextRect.Top) - ACanvas.TextHeight('W')) div 2; B := TBitmap.Create; try B.Width := TextRect.Right - TextRect.Left; B.Height := TextRect.Bottom - TextRect.Top; BRect := Rect(0,0,B.Width, B.Height); B.Canvas.Brush.Color := ACanvas.Brush.Color; B.Canvas.FillRect (BRect); // B.Canvas.Font := FUCXPSettings.Font; //felix added for resolving font problems in Win98 //27.08 B.Canvas.Font.color := DefColor; DrawtextEx(B.Canvas.Handle, PChar(txt), Length(txt), BRect, TextFormat + DT_VCENTER, nil); ACanvas.CopyRect(TextRect, B.Canvas, BRect); finally B.Free; end; exit; end; end; if (TopMenu and Selected) then if FUCXPSettings.UseSystemColors then DefColor := TopMenuFontColor(ACanvas, FFIconBackColor); ACanvas.Font.color := DefColor; // will not affect Buttons SetBkMode(ACanvas.Handle, TRANSPARENT); if Default and Enabled then begin Inc(TextRect.Left, 1); ACanvas.Font.color := GetShadeColor(ACanvas, ACanvas.Pixels[TextRect.Left, TextRect.Top], 30); DrawtextEx(ACanvas.Handle, PChar(txt), Length(txt), TextRect, TextFormat, nil); Dec(TextRect.Left, 1); Inc(TextRect.Top, 2); Inc(TextRect.Left, 1); Inc(TextRect.Right, 1); ACanvas.Font.color := GetShadeColor(ACanvas, ACanvas.Pixels[TextRect.Left, TextRect.Top], 30); DrawtextEx(ACanvas.Handle, PChar(txt), Length(txt), TextRect, TextFormat, nil); Dec(TextRect.Top, 1); Dec(TextRect.Left, 1); Dec(TextRect.Right, 1); ACanvas.Font.color := GetShadeColor(ACanvas, ACanvas.Pixels[TextRect.Left, TextRect.Top], 40); DrawtextEx(ACanvas.Handle, PChar(txt), Length(txt), TextRect, TextFormat, nil); Inc(TextRect.Left, 1); Inc(TextRect.Right, 1); ACanvas.Font.color := GetShadeColor(ACanvas, ACanvas.Pixels[TextRect.Left, TextRect.Top], 60); DrawtextEx(ACanvas.Handle, PChar(txt), Length(txt), TextRect, TextFormat, nil); Dec(TextRect.Left, 1); Dec(TextRect.Right, 1); Dec(TextRect.Top, 1); ACanvas.Font.color := DefColor; end; DrawtextEx(ACanvas.Handle, PChar(txt), Length(txt), TextRect, TextFormat, nil); txt := ShortCutText + ' '; { if not Is16Bit then ACanvas.Font.color := DefColor else ACanvas.Font.color := GetShadeColor(ACanvas, DefColor, -40); } if IsRightToLeft then begin Inc(TextRect.Left, 10); TextFormat := DT_LEFT end else begin Dec(TextRect.Right, 10); TextFormat := DT_RIGHT; end; DrawtextEx(ACanvas.Handle, PChar(txt), Length(txt), TextRect, TextFormat, nil); end; procedure TUCXPStyle.DrawIcon(Sender: TObject; ACanvas: TCanvas; B: TBitmap; IconRect: Trect; Hot, Selected, Enabled, Checked, FTopMenu, IsRightToLeft: boolean); var DefColor: TColor; X, Y: integer; begin if (B <> nil) and (B.Width > 0) then begin X := IconRect.Left; Y := IconRect.Top + 1; if (Sender is TMenuItem) then begin inc(Y, 2); if FUCXPSettings.IconWidth > B.Width then X := X + ((FUCXPSettings.IconWidth - B.Width) div 2) - 1 else begin if IsRightToLeft then X := IconRect.Right - b.Width - 2 else X := IconRect.Left + 2; end; end; if FTopMenu then begin if IsRightToLeft then X := IconRect.Right - b.Width - 5 else X := IconRect.Left + 1; end; if (Hot) and (FTopMenu) and (Enabled) then if not Selected then begin dec(X, 1); dec(Y, 2); end; if (Hot) and (not FTopMenu) and (Enabled) and (not Checked) then if not Selected then begin dec(X, 1); dec(Y, 1); end; if (not Hot) and (Enabled) and (not Checked) then if Is16Bit then DimBitmap(B, FUCXPSettings.DimLevel{30}); if not Enabled then begin GrayBitmap(B, FUCXPSettings.GrayLevel ); DimBitmap(B, 40); end; if (Hot) and (Enabled) and (not Checked) then begin if (Is16Bit) and (not FUCXPSettings.UseSystemColors) and (Sender is TToolButton) then DefColor := NewColor(ACanvas, FUCXPSettings.SelectColor, 68) else DefColor := FFSelectColor; DefColor := GetShadeColor(ACanvas, DefColor, 50); DrawBitmapShadow(B, ACanvas, X + 2, Y + 2, DefColor); end; B.Transparent := true; ACanvas.Draw(X, Y, B); end; end; function TUCXPStyle.TopMenuFontColor(ACanvas: TCanvas; Color: TColor): TColor; var r, g, b, avg: integer; begin Color := ColorToRGB(Color); r := Color and $000000FF; g := (Color and $0000FF00) shr 8; b := (Color and $00FF0000) shr 16; Avg := (r + b) div 2; if (Avg > 150) or (g > 200) then Result := FUCXPSettings.Font.Color else Result := NewColor(ACanvas, Color, 90); end; procedure TUCXPStyle.SetDisableSubclassing(const Value: boolean); begin if Value = FDisableSubclassing then Exit; FDisableSubClassing := Value; if UCXPStyleManager.ActiveXPStyle = Self then UCXPStyleManager.UpdateActiveXPStyle(Self) else if (UCXPStyleManager.ActiveXPStyle = nil) and not(FDisableSubclassing) then UCXPStyleManager.UpdateActiveXPStyle(nil); end; procedure TUCXPStyle.SetActive(const Value: boolean); begin //if Value = FActive then exit; FActive := Value; if FActive then InitItems(FForm, true, true) else InitItems(FForm, false, true); if FForm.Handle <> 0 then Windows.DrawMenuBar(FForm.Handle); end; procedure TUCXPStyle.SetForm(const Value: TScrollingWinControl); var Hold: boolean; begin if Value <> FForm then begin Hold := Active; Active := false; FForm := Value; if Hold then Active := True; end; end; {moved to UCXPSettings procedure TUCXPStyle.SetFont(const Value: TFont); begin FFont.Assign(Value); Windows.DrawMenuBar(FForm.Handle); end; procedure TUCXPStyle.SetColor(const Value: TColor); begin FColor := Value; FColorsChanged := true; // +jt end; procedure TUCXPStyle.SetIconBackColor(const Value: TColor); begin FIconBackColor := Value; FColorsChanged := true; // +jt end; procedure TUCXPStyle.SetMenuBarColor(const Value: TColor); begin FMenuBarColor := Value; FColorsChanged := true; // +jt Windows.DrawMenuBar(FForm.Handle); end; procedure TUCXPStyle.SetCheckedColor(const Value: TColor); begin FCheckedColor := Value; FColorsChanged := true; // +jt end; procedure TUCXPStyle.SetSeparatorColor(const Value: TColor); begin FSeparatorColor := Value; FColorsChanged := true; // +jt end; procedure TUCXPStyle.SetSelectBorderColor(const Value: TColor); begin FSelectBorderColor := Value; FColorsChanged := true; // +jt end; procedure TUCXPStyle.SetSelectColor(const Value: TColor); begin FSelectColor := Value; FColorsChanged := true; // +jt end; procedure TUCXPStyle.SetDisabledColor(const Value: TColor); begin FDisabledColor := Value; FColorsChanged := true; // +jt end; procedure TUCXPStyle.SetSelectFontColor(const Value: TColor); begin FSelectFontColor := Value; FColorsChanged := true; // +jt end; procedure TUCXPStyle.SetIconWidth(const Value: integer); begin FIconWidth := Value; end; procedure TUCXPStyle.SetDrawSelect(const Value: boolean); begin FDrawSelect := Value; end; procedure TUCXPStyle.SetOverrideOwnerDraw(const Value: boolean); begin FOverrideOwnerDraw := Value; if FActive then Active := True; end; procedure TUCXPStyle.SetUseSystemColors(const Value: boolean); begin FUseSystemColors := Value; Windows.DrawMenuBar(FForm.Handle); end; procedure TUCXPStyle.SetGradient(const Value: boolean); begin FGradient := Value; end; procedure TUCXPStyle.SetFlatMenu(const Value: boolean); begin FFlatMenu := Value; end; procedure TUCXPStyle.SetUCXPContainers(const Value: TUCXPContainers); begin if Value <> FXPContainers then begin if FActive then begin FActive := false; InitItems(FForm, false, true); FActive := true; FXPContainers := Value; InitItems(FForm, true, true); end; end; FXPContainers := Value; end; procedure TUCXPStyle.SetUCXPControls(const Value: TUCXPControls); begin if Value <> FXPControls then begin if FActive then begin FActive := false; InitItems(FForm, false, true); FActive := true; FXPControls := Value; InitItems(FForm, true, true); end; end; FXPControls := Value; end; procedure TUCXPStyle.SetDrawMenuBar(const Value: boolean); begin FDrawMenuBar := Value; end; procedure TUCXPStyle.SetUseDimColor(const Value: boolean); begin FUseDimColor := Value; end; }{END moved to UCXPSettings} procedure GetSystemMenuFont(Font: TFont); var FNonCLientMetrics: TNonCLientMetrics; begin FNonCLientMetrics.cbSize := Sizeof(TNonCLientMetrics); if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @FNonCLientMetrics,0) then begin Font.Handle := CreateFontIndirect(FNonCLientMetrics.lfMenuFont); Font.Color := clMenuText; end; end; procedure TUCXPStyle.SetUCSettings(const Value: TUCSettings); begin FUCSettings := Value; if Value <> nil then Value.FreeNotification(self); //changed by fduenas end; procedure TUCXPStyle.DrawGradient(ACanvas: TCanvas; ARect: TRect; IsRightToLeft: boolean); var i: integer; v: integer; FRect: TRect; begin fRect := ARect; V := 0; if IsRightToLeft then begin fRect.Left := fRect.Right - 1; for i := ARect.Right Downto ARect.Left do begin if (fRect.Left < ARect.Right) and (fRect.Left > ARect.Right - FUCXPSettings.IconWidth + 5) then inc(v, 3) else inc(v, 1); if v > 96 then v := 96; ACanvas.Brush.Color := NewColor(ACanvas, FFIconBackColor, v); ACanvas.FillRect(fRect); fRect.Left := fRect.Left - 1; fRect.Right := fRect.Left - 1; end; end else begin fRect.Right := fRect.Left + 1; for i := ARect.Left to ARect.Right do begin if (fRect.Left > ARect.Left) and (fRect.Left < ARect.Left + FUCXPSettings.IconWidth + 5) then inc(v, 3) else inc(v, 1); if v > 96 then v := 96; ACanvas.Brush.Color := NewColor(ACanvas, FFIconBackColor, v); ACanvas.FillRect(fRect); fRect.Left := fRect.Left + 1; fRect.Right := fRect.Left + 1; end; end; end; function MenuWindowProc(hwnd: HWND; uMsg: integer; WParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; var oldproc: integer; r: TRect; pt: TPoint; begin if(uMsg=WM_ERASEBKGND) then begin Result:=1; exit; end; if((uMsg=WM_SHOWWINDOW) and (not Boolean(WParam))) or (uMsg=WM_CLOSE) or (uMsg=WM_DESTROY) then begin SetWindowRgn(hwnd, 0,false); oldproc:=GetWindowLong(hWnd,GWL_USERDATA); SetWindowLong(hWnd,GWL_WNDPROC,oldproc); SetWindowLong(hWnd,GWL_USERDATA,0); Result:=CallWindowProc(Pointer(oldproc), hwnd, uMsg, wParam, lParam); GetWindowRect(hWnd, r); pt.x:=r.Right+2; pt.y:=r.Top+2; hWnd :=WindowFromPoint(pt); if GetWindowLong(hWnd,GWL_WNDPROC)<>integer(@MenuWindowProc) then begin pt.x:=r.Right+2; pt.y:=r.Bottom-2; hWnd :=WindowFromPoint(pt); if GetWindowLong(hWnd,GWL_WNDPROC)<>integer(@MenuWindowProc) then exit; end; InvalidateRect(hwnd,nil,false); end else Result:=CallWindowProc(Pointer(GetWindowLong(hWnd,GWL_USERDATA)), hwnd, uMsg, wParam, lParam); end; procedure TUCXPStyle.DrawWindowBorder(hWnd: HWND; IsRightToLeft: boolean); var WRect: TRect; dCanvas: TCanvas; wDC: HDC; // +jt regiontype: integer; // +jt r1,r2,wr,region: HRGN; // +jt rgnr: TRect; // +jt begin if (hWnd <= 0) or (FSettingWindowRng) then begin exit; end; // +jt wDC := GetWindowDC(hWnd); //GetDesktopWindow if wDC=0 then exit; // +jt FSettingWindowRng :=true; // +jt dCanvas := TCanvas.Create; try dCanvas.Handle := wDC; // +jt GetWindowRect(hWnd, WRect); // +jt WRect.Right := WRect.Right-WRect.Left; WRect.Bottom := WRect.Bottom-WRect.Top; WRect.Top:=0; WRect.Left:=0; if GetWindowLong(hWnd,GWL_WNDPROC)<>integer(@MenuWindowProc) then begin SetWindowLong(hWnd,GWL_USERDATA,GetWindowLong(hWnd,GWL_WNDPROC)); SetWindowLong(hWnd,GWL_WNDPROC,integer(@MenuWindowProc)); end; if not IsWXP then begin wr:= CreateRectRgn(0,0,0,0); regiontype := GetWindowRgn(hWnd, wr); GetRgnBox(wr,rgnr); DeleteObject(wr); if (regionType = ERROR) or (abs(rgnr.Right-WRect.Right)>5) or (abs(rgnr.Bottom-WRect.Bottom)>5) then begin region:= CreateRectRgn(0,0,0,0); r1:=CreateRectRgn(WRect.Left,WRect.Top,WRect.Right-2,WRect.Bottom-2); r2:=CreateRectRgn(WRect.Left+2,WRect.Top+2,WRect.Right,WRect.Bottom); CombineRgn(region,r1,r2,RGN_OR); DeleteObject(r1); DeleteObject(r2); SetWindowRgn(hWnd,region,true); end; // +jt Dec(WRect.Right, 2); Dec(WRect.Bottom, 2); end; // +jt dCanvas.Brush.Style := bsClear; dCanvas.Pen.Color := FMenuBorderColor; dCanvas.Rectangle(WRect.Left, WRect.Top, WRect.Right, WRect.Bottom); if IsRightToLeft then begin dCanvas.Pen.Color := FFIconBackColor; dCanvas.MoveTo(WRect.Right - 3, WRect.Top + 2); dCanvas.LineTo(WRect.Right - 2, WRect.Bottom - 1); end else begin dCanvas.Pen.Color := FFIconBackColor; dCanvas.Rectangle(WRect.Left + 1, WRect.Top + 2, WRect.Left + 3, WRect.Bottom - 1); end; // +jt StretchBlt(dCanvas.Handle,WRect.Left + 1,WRect.Top + 1,WRect.Right - WRect.Left-1,2, dCanvas.Handle,WRect.Left + 1,WRect.Top + 3,WRect.Right - WRect.Left-1,1,SRCCOPY); if IsWXP then begin StretchBlt(dCanvas.Handle,WRect.Left + 1,WRect.Bottom - 3,WRect.Right - WRect.Left-1,2, dCanvas.Handle,WRect.Left + 1,WRect.Top + 3,WRect.Right - WRect.Left-1,1, SRCCOPY); dCanvas.Pen.Color := FFColor; dCanvas.Rectangle(WRect.Right - 3, WRect.Top+1, WRect.Right - 1, WRect.Bottom-1); end; // +jt Inc(WRect.Right, 2); Inc(WRect.Bottom, 2); if not IsWXP then // +jt begin // +jt dCanvas.Pen.Color := FMenuShadowColor; dCanvas.Rectangle(WRect.Left + 2, WRect.Bottom, WRect.Right, WRect.Bottom - 2); dCanvas.Rectangle(WRect.Right - 2, WRect.Bottom, WRect.Right, WRect.Top + 2); end; // +jt finally ReleaseDC(hWnd, wDC); // +jt dCanvas.Free; FSettingWindowRng :=false; end; end; procedure TUCXPStyle.Notification(AComponent: TComponent; AOperation: TOperation); begin //added by fduenas inherited Notification(AComponent, AOperation); //changed by fduenas if AOperation = opRemove then If AComponent = FUCSettings then FUCSettings := nil; if not Assigned(UCXPStyleManager) then Exit; // Pass the notification information to the UCXPStyleManager if not(csDesigning in ComponentState) then UCXPStyleManager.Notification(AComponent, AOperation); if not FActive then exit; if not FAutoDetect then exit; if (AOperation = opInsert) and ((AComponent is TMenuItem) or (AComponent is TToolButton) or (AComponent is TControlBar)) then begin if not (csDesigning in ComponentState) then InitItem(AComponent, true, true); // Tom: This will process this new component end; end; function GetShadeColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor; var r, g, b: integer; begin clr := ColorToRGB(clr); r := Clr and $000000FF; g := (Clr and $0000FF00) shr 8; b := (Clr and $00FF0000) shr 16; r := (r - value); if r < 0 then r := 0; if r > 255 then r := 255; g := (g - value) + 2; if g < 0 then g := 0; if g > 255 then g := 255; b := (b - value); if b < 0 then b := 0; if b > 255 then b := 255; //Result := Windows.GetNearestColor(ACanvas.Handle, RGB(r, g, b)); Result := RGB(r, g, b); end; function MergColor(Colors: Array of TColor): TColor; var r, g, b, i: integer; clr: TColor; begin r := 0; g:= 0; b:= 0; for i := 0 to High(Colors) do begin clr := ColorToRGB(Colors[i]); r := r + (Clr and $000000FF) div High(Colors); g := g + ((Clr and $0000FF00) shr 8) div High(Colors); b := b + ((Clr and $00FF0000) shr 16) div High(Colors); end; Result := RGB(r, g, b); end; function NewColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor; var r, g, b: integer; begin if Value > 100 then Value := 100; clr := ColorToRGB(clr); r := Clr and $000000FF; g := (Clr and $0000FF00) shr 8; b := (Clr and $00FF0000) shr 16; r := r + Round((255 - r) * (value / 100)); g := g + Round((255 - g) * (value / 100)); b := b + Round((255 - b) * (value / 100)); //Result := Windows.GetNearestColor(ACanvas.Handle, RGB(r, g, b)); Result := RGB(r, g, b); end; function GetInverseColor(AColor: TColor): TColor; begin Result := ColorToRGB(AColor) xor $FFFFFF; end; function GrayColor(ACanvas: TCanvas; Clr: TColor; Value: integer): TColor; var r, g, b, avg: integer; begin clr := ColorToRGB(clr); r := Clr and $000000FF; g := (Clr and $0000FF00) shr 8; b := (Clr and $00FF0000) shr 16; Avg := (r + g + b) div 3; Avg := Avg + Value; if Avg > 240 then Avg := 240; //if ACanvas <> nil then // Result := Windows.GetNearestColor (ACanvas.Handle,RGB(Avg, avg, avg)); Result := RGB(Avg, avg, avg); end; procedure GrayBitmap(ABitmap: TBitmap; Value: integer); var x, y: integer; LastColor1, LastColor2, Color: TColor; begin LastColor1 := 0; LastColor2 := 0; for y := 0 to ABitmap.Height do for x := 0 to ABitmap.Width do begin Color := ABitmap.Canvas.Pixels[x, y]; if Color = LastColor1 then ABitmap.Canvas.Pixels[x, y] := LastColor2 else begin LastColor2 := GrayColor(ABitmap.Canvas , Color, Value); ABitmap.Canvas.Pixels[x, y] := LastColor2; LastColor1 := Color; end; end; end; {Modified by felix@unidreamtech.com} { procedure GrayBitmap(ABitmap: TBitmap; Value: integer); var Pixel: PRGBTriple; w, h: Integer; x, y: Integer; avg: integer; begin ABitmap.PixelFormat := pf24Bit; w := ABitmap.Width; h := ABitmap.Height; for y := 0 to h - 1 do begin Pixel := ABitmap.ScanLine[y]; for x := 0 to w - 1 do begin avg := ((Pixel^.rgbtRed + Pixel^.rgbtGreen + Pixel^.rgbtBlue) div 3) + Value; if avg > 240 then avg := 240; Pixel^.rgbtRed := avg; Pixel^.rgbtGreen := avg; Pixel^.rgbtBlue := avg; Inc(Pixel); end; end; end; } procedure DimBitmap(ABitmap: TBitmap; Value: integer); var x, y: integer; LastColor1, LastColor2, Color: TColor; begin if Value > 100 then Value := 100; LastColor1 := -1; LastColor2 := -1; for y := 0 to ABitmap.Height - 1 do for x := 0 to ABitmap.Width - 1 do begin Color := ABitmap.Canvas.Pixels[x, y]; if Color = LastColor1 then ABitmap.Canvas.Pixels[x, y] := LastColor2 else begin LastColor2 := NewColor(ABitmap.Canvas, Color, Value); ABitmap.Canvas.Pixels[x, y] := LastColor2; LastColor1 := Color; end; end; end; // LIne 2647 {Modified by felix@unidreamtech.com} {works fine for 24 bit color procedure DimBitmap(ABitmap: TBitmap; Value: integer); var Pixel: PRGBTriple; w, h: Integer; x, y, c1, c2: Integer; begin ABitmap.PixelFormat := pf24Bit; w := ABitmap.Width; h := ABitmap.Height; c1 := Value * 255; c2 := 100 - Value; for y := 0 to h - 1 do begin Pixel := ABitmap.ScanLine[y]; for x := 0 to w - 1 do begin Pixel^.rgbtRed := ((c2 * Pixel^.rgbtRed) + c1) div 100; Pixel^.rgbtGreen := ((c2 * Pixel^.rgbtGreen) + c1) div 100; Pixel^.rgbtBlue := ((c2 * Pixel^.rgbtBlue) + c1) div 100; Inc(Pixel); end; end; end; } procedure DrawArrow(ACanvas: TCanvas; X, Y: integer); begin ACanvas.MoveTo(X, Y); ACanvas.LineTo(X + 5, Y); ACanvas.MoveTo(X + 1, Y + 1); ACanvas.LineTo(X + 4, Y); ACanvas.MoveTo(X + 2, Y + 2); ACanvas.LineTo(X + 3, Y); end; procedure DrawArrow(ACanvas: TCanvas; X, Y, Orientation: integer); begin case Orientation of 0: begin ACanvas.MoveTo(X, Y); ACanvas.LineTo(X, Y-1); ACanvas.MoveTo(X + 1, Y + 1); ACanvas.LineTo(X + 4, Y + 4); ACanvas.MoveTo(X, Y + 1); ACanvas.LineTo(X + 3, Y + 4); ACanvas.MoveTo(X, Y + 2); ACanvas.LineTo(X + 2, Y + 4); ACanvas.MoveTo(X - 1, Y + 1); ACanvas.LineTo(X - 4, Y + 4); ACanvas.MoveTo(X, Y + 2); ACanvas.LineTo(X - 3, Y + 4); ACanvas.MoveTo(X, Y + 1); ACanvas.LineTo(X - 2, Y + 4); end; 1: begin ACanvas.MoveTo(X, Y+3); ACanvas.LineTo(X, Y+4); ACanvas.MoveTo(X + 1, Y + 2); ACanvas.LineTo(X + 4, Y - 1); ACanvas.MoveTo(X, Y + 2); ACanvas.LineTo(X + 3, Y - 1); ACanvas.MoveTo(X, Y + 1); ACanvas.LineTo(X + 2, Y + 0); ACanvas.MoveTo(X - 1, Y + 2); ACanvas.LineTo(X - 4, Y - 1); ACanvas.MoveTo(X, Y + 2); ACanvas.LineTo(X - 3, Y - 1); ACanvas.MoveTo(X, Y + 1); ACanvas.LineTo(X - 2, Y + 0); end; end; end; procedure DrawBitmapShadow(B: TBitmap; ACanvas: TCanvas; X, Y: integer; ShadowColor: TColor); var BX, BY: integer; TransparentColor: TColor; begin TransparentColor := B.Canvas.Pixels[0, B.Height - 1]; for BY := 0 to B.Height - 1 do for BX := 0 to B.Width - 1 do begin if B.Canvas.Pixels[BX, BY] <> TransparentColor then ACanvas.Pixels[X + BX, Y + BY] := ShadowColor; end; end; procedure DrawCheckMark(ACanvas: TCanvas; X, Y: integer); begin Inc(X, 2); Dec(Y, 3); ACanvas.MoveTo(X , Y - 2); ACanvas.LineTo(X + 2, Y ); ACanvas.LineTo(X + 7, Y - 5); ACanvas.MoveTo(X , Y - 3); ACanvas.LineTo(X + 2, Y - 1); ACanvas.LineTo(X + 7, Y - 6); ACanvas.MoveTo(X , Y - 4); ACanvas.LineTo(X + 2, Y - 2); ACanvas.LineTo(X + 7, Y - 7); end; { TCustomComboSubClass } //By Heath Provost (Nov 20, 2001) // ComboBox Subclass WndProc. // Message processing to allow control to repond to // messages needed to paint using Office XP style. procedure TControlSubClass.ControlSubClass(var Message: TMessage); begin //Call original WindowProc FIRST. We are trying to emulate inheritance, so //original WindowProc must handle all messages before we do. if ((Message.Msg = WM_PAINT) and ((Control is TGraphicControl))) or ((Control.ClassName = 'TDBLookupComboBox') and (Message.Msg = WM_NCPAINT)) then Message.Result := 1 else //: "Marcus Paulo Tavares" orgWindowProc(Message); if (FXPStyle <> nil) and (not FXPStyle.FActive) then begin try Message.Result := 1; if Control <> nil then begin Control.WindowProc := orgWindowProc; if Control is TCustomEdit then TEdit(Control).Ctl3D := FCtl3D; if Control is TCustomRichEdit then TRichEdit(Control).BorderStyle := FBorderStyle; if Control.ClassName = 'TDBLookupComboBox' then TComboBox(Control).Ctl3D := FCtl3D; if Control is TCustomListBox then TListBox(Control).BorderStyle := FBorderStyle; if Control is TCustomListView then TListView(Control).BorderStyle := FBorderStyle; if Control is TCustomTreeView then TTreeView(Control).BorderStyle := FBorderStyle; Control := nil; Free; end; exit; except exit; end; end; FMsg := Message.Msg; case Message.Msg of EM_GETMODIFY, // For edit CM_INVALIDATE: begin FBuilding := true end; CM_PARENTCOLORCHANGED: begin PaintControlXP; end; WM_DESTROY: begin if not FBuilding then begin try if Control <> nil then begin Control.WindowProc := orgWindowProc; FBuilding := false; Free; end; except end; //FBuilding := false; end; Exit; end; WM_PAINT: begin FBuilding := false; PaintControlXP; end; CM_MOUSEENTER: if TControl(Control).Enabled then begin // if FmouseInControl then exit; FmouseInControl := true; if Control is TGraphicControl then begin Control.Repaint; exit; end; PaintControlXP; {if Control is TGraphicControl then begin if not FMouseInControl and Control.Enabled and (GetCapture = 0) then begin FMouseInControl := True; Control.Repaint; end; end else begin FmouseInControl := true; PaintControlXP; end;} end; CM_MOUSELEAVE: if TControl(Control).Enabled then begin FmouseInControl := false; if Control is TGraphicControl then begin Control.Invalidate; exit; end; PaintControlXP; {if Control is TGraphicControl then begin if FMouseInControl and Control.Enabled then begin FMouseInControl := False; Control.Invalidate; end; end else begin FmouseInControl := false; PaintControlXP; end;} end; WM_MOUSEMOVE: begin if TControl(Control).Enabled and (Control.ClassName = 'TUpDown') then PaintControlXP; end; WM_LBUTTONDOWN: begin FLButtonBressed := true; PaintControlXP; end; WM_LBUTTONUP: begin FLButtonBressed := false; if Control is TGraphicControl then begin Control.Repaint; exit; end; PaintControlXP; end; WM_KEYDOWN: if Message.WParam = VK_SPACE then begin FBressed := true; if not FIsKeyDown then PaintControlXP; FIsKeyDown := true; end; WM_KEYUP: if Message.WParam = VK_SPACE then begin FBressed := false; FIsKeyDown := false; PaintControlXP; end; WM_SETFOCUS: begin FmouseInControl := true; PaintControlXP; end; WM_KILLFOCUS: begin FmouseInControl := false; PaintControlXP; end; CM_FOCUSCHANGED: //?? PaintControlXP; CM_EXIT: begin FmouseInControl := false; PaintControlXP; end; BM_SETCHECK: begin FmouseInControl := false; PaintControlXP; end; BM_GETCHECK: begin FmouseInControl := false; PaintControlXP; end; CM_ENABLEDCHANGED: begin if (Message.WParam = 0) then FmouseInControl := false;//Dirk Bottcher PaintControlXP; end; CM_TEXTCHANGED: begin PaintControlXP; end; CM_CTL3DCHANGED, CM_PARENTCTL3DCHANGED: begin FBuilding := true; end; WM_LBUTTONDBLCLK: //for button, check begin if (Control is TButton) or (Control is TSpeedButton) or (Control is TCheckBox) then Control.Perform(WM_LBUTTONDOWN, Message.WParam , Longint(Message.LParam)); end; {CN_DRAWITEM,} BM_SETSTATE: begin PaintControlXP; // button end; WM_WINDOWPOSCHANGED, CN_PARENTNOTIFY: // Moving From parent to other begin FBuilding := true end; WM_NCPAINT: begin if (Control is TCustomListBox) or (Control is TCustomTreeView) or (Control is TCustomListBox) then PaintNCWinControl; end; end; end; // changes added by Heath Provost (Nov 20, 2001) { TCustomComboSubClass } // paints an overlay over the control to make it mimic // Office XP style. procedure TControlSubClass.PaintControlXP; begin If Control is TWinControl then FIsFocused := TWinControl(Control).Focused else FIsFocused := false; {$IFDEF VER6U} if (Control is TCustomCombo) then PaintCombo; {$ELSE} if (Control is TCustomComboBox) then PaintCombo; {$ENDIF} if Control.ClassName = 'TDBLookupComboBox' then PaintDBLookupCombo; if Control is TCustomRichEdit then PaintRichEdit else if Control is TCustomEdit then PaintEdit; if Control is TCustomCheckBox then PaintCheckBox; if Control is TRadioButton then PaintRadio; if Control is TBitBtn then PaintBitButn else if Control is TButton then PaintButton; if Control is TUpDown then PaintUpDownButton; if Control is TSpeedButton then if Control.Visible then PaintSpeedButton; if Control is TCustomPanel then PaintPanel; if Control is TCustomGroupBox then PaintGroupBox; if (Control is TCustomListBox) or (Control is TCustomTreeView) or (Control is TCustomListView) then PaintNCWinControl; if Control is TProgressBar then PaintProgressBar; if Control is TCustomHotKey then PaintHotKey; { if Control is TDrawGrid then PaintGrid; } end; procedure TControlSubClass.PaintCombo; var C: TControlCanvas; R: TRect; SelectColor, BorderColor, ArrowColor: TColor; X: integer; begin C := TControlCanvas.Create; try C.Control := Control; // FXPStyle.SetGlobalColor(C); if Control.Enabled then ArrowColor := clBlack else ArrowColor := clWhite; if (FmouseinControl) then begin borderColor := FXPStyle.FFSelectBorderColor; SelectColor := FXPStyle.FFSelectColor; end else begin borderColor := TComboBox(Control).Color; if Control.Tag = 1000 then SelectColor := NewColor(C, TControl(Control).Parent.Brush.Color, FXPStyle.FDimParentColor) else selectColor := clBtnFace; end; if (not FmouseinControl) and (FIsFocused) then begin borderColor := NewColor(C, FXPStyle.FFSelectBorderColor,60); SelectColor := FXPStyle.FCheckedAreaColor; end; R := Control.ClientRect; C.Brush.Color := Control.Parent.Brush.Color; C.FrameRect(R); InflateRect(R, -1, -1); C.Pen.Color := C.Brush.Color; C.MoveTo(R.Left, R.Top); C.LineTo(R.Right, R.Top); InflateRect(R, 0, -1); if ( FmouseinControl or FIsFocused) then InflateRect(R, 1, 1); C.Brush.Color := TComboBox(Control).Color;; C.FrameRect(R); Inc(R.Bottom,1); C.Brush.Color := BorderColor; C.FrameRect(R); {$IFDEF VER6U} if TCustomCombo(Control).DroppedDown then {$ELSE} if TCustomComboBox(Control).DroppedDown then {$ENDIF} begin BorderColor := FXPStyle.FFSelectBorderColor; ArrowColor := clWhite; SelectColor := FXPStyle.FCheckedAreaSelectColor ; end; if TComboBox(Control).style <> csSimple then begin InflateRect(R, -1, -1); if Control.BiDiMode = bdRightToLeft then R.Right := R.Left + GetSystemMetrics(SM_CXHTHUMB) + 1 else R.Left := R.Right - GetSystemMetrics(SM_CXHTHUMB) - 1; if ( FmouseinControl or FIsFocused) then begin if Control.BiDiMode = bdRightToLeft then Inc(R.Right, 2) else Dec(R.Left, 1); end; C.Brush.Color := SelectColor; C.FillRect(R); if Control.BiDiMode = bdRightToLeft then R.Left := R.Right - 5 else R.Right := R.Left + 5; C.Brush.Color := TComboBox(Control).Color; C.FillRect(R); C.Pen.Color := BorderColor; if Control.BiDiMode = bdRightToLeft then begin C.Moveto(R.Left, R.Top); C.LineTo(R.Left, R.Bottom); end else begin C.Moveto(R.Right, R.Top); C.LineTo(R.Right, R.Bottom); end; C.Pen.Color := arrowColor; R := Control.ClientRect; if Control.BiDiMode = bdRightToLeft then X := R.Left + 5 else X := R.Right - 10; C.Moveto(X + 0, R.Top + 10); C.LineTo(X + 5, R.Top + 10); C.Moveto(X + 1, R.Top + 11); C.LineTo(X + 4, R.Top + 11); C.Moveto(X + 2, R.Top + 12); C.LineTo(X + 3, R.Top + 12); end; finally C.Free; end; end; procedure TControlSubClass.PaintDBLookupCombo; var C: TControlCanvas; R: TRect; FrameColor, SelectColor, BorderColor, ArrowColor: TColor; X: integer; DC: HDC; begin C := TControlCanvas.Create; DC := GetWindowDC(TWinControl(Control).Handle); try C.Control := Control; C.Handle := DC; if TComboBox(Control).Ctl3D then begin FBuilding := true; TComboBox(Control).Ctl3D := false; end; //FXPStyle.SetGlobalColor(C); if Control.Enabled then ArrowColor := clBlack else ArrowColor := clWhite; if (FmouseinControl) then begin FrameColor := FXPStyle.FFSelectBorderColor; borderColor := FXPStyle.FFSelectBorderColor; SelectColor := FXPStyle.FFSelectColor; end else begin FrameColor := GetShadeColor(C, Control.Parent.Brush.Color, 60); borderColor := NewColor(C, FXPStyle.FFSelectBorderColor,60); selectColor := clBtnFace; end; if (not FmouseinControl) and (FIsFocused) then begin FrameColor := GetShadeColor(C, Control.Parent.Brush.Color, 60); borderColor := NewColor(C, FXPStyle.FFSelectBorderColor,60); SelectColor := FXPStyle.FCheckedAreaColor; end; R := Rect(0, 0, Control.Width, Control.Height); C.Brush.Color := TComboBox(Control).Color; C.Brush.Color := FrameColor; C.FrameRect(R); R := Control.ClientRect; // Move the thumb one pixel to the right and one pixel down OffsetRect(R, 1, 1); C.Brush.Color := TComboBox(Control).Color; C.FrameRect(R); {$IFDEF VER6U} if TCustomCombo(Control).DroppedDown then {$ELSE} if TCustomComboBox(Control).DroppedDown then {$ENDIF} begin BorderColor := FXPStyle.FFSelectBorderColor; ArrowColor := clWhite; SelectColor := FXPStyle.FCheckedAreaSelectColor ; end; if TComboBox(Control).style <> csSimple then begin InflateRect(R, -1, -1); if Control.BiDiMode = bdRightToLeft then R.Right := R.Left + GetSystemMetrics(SM_CXHTHUMB) + 1 else R.Left := R.Right - GetSystemMetrics(SM_CXHTHUMB) - 1; if ( FmouseinControl or FIsFocused) then begin if Control.BiDiMode = bdRightToLeft then Inc(R.Right, 1) else Dec(R.Left, 1); end; C.Brush.Color := SelectColor; C.FillRect(R); C.Brush.Color := BorderColor; C.FrameRect(R); if Control.BiDiMode = bdRightToLeft then R.Left := R.Right - 5 else R.Right := R.Left + 5; C.Brush.Color := TComboBox(Control).Color; C.FillRect(R); C.Pen.Color := BorderColor; if Control.BiDiMode = bdRightToLeft then begin C.Moveto(R.Left, R.Top); C.LineTo(R.Left, R.Bottom); end else begin C.Moveto(R.Right, R.Top); C.LineTo(R.Right, R.Bottom); end; C.Pen.Color := arrowColor; R := Control.ClientRect; if Control.BiDiMode = bdRightToLeft then X := R.Left + 5 else X := R.Right - 9; // Changed by Uwe Runkel, uwe@runkel.info // Changed value from 10 to 9 because the thumb has // moved one pixel to the right C.Moveto(X + 0, R.Top + 8); C.LineTo(X + 5, R.Top + 8); C.Moveto(X + 1, R.Top + 9); C.LineTo(X + 4, R.Top + 9); C.Moveto(X + 2, R.Top + 10); C.LineTo(X + 3, R.Top + 10); end; finally C.Free; ReleaseDC(TWinControl(Control).Handle, DC); end; end; procedure TControlSubClass.PaintEdit; var C: TControlCanvas; R: TRect; BorderColor: TColor; begin C := TControlCanvas.Create; try C.Control := Control; //FXPStyle.SetGlobalColor(C); if TEdit(Control).Ctl3D <> false then begin FBuilding := true; TEdit(Control).Ctl3D := false; end; if (FmouseinControl) or (FIsFocused) then borderColor := NewColor(C, FXPStyle.FFSelectBorderColor, 60) else borderColor := GetShadeColor(C, Control.Parent.Brush.Color, 60); if FBorderStyle = bsNone then begin if (FmouseinControl) and (not FIsFocused) then //borderColor := NewColor(C, Control.Parent.Brush.Color, 60) borderColor := NewColor(C, MergColor([TEdit(Control).Color,Control.Parent.Brush.Color]), 40) else borderColor := TEdit(Control).Color; end; R := Control.ClientRect; C.Pen.Color := BorderColor; C.Brush.Style := bsClear; C.Rectangle(R.Left, R.Top, R.Right, R.Bottom); finally C.Free; end; end; procedure TControlSubClass.PaintRichEdit; var C: TControlCanvas; R: TRect; BorderColor: TColor; begin C := TControlCanvas.Create; try C.Control := Control.Parent; R := Control.BoundsRect; InflateRect(R, 1, 1); if FBorderStyle = bsSingle then begin FBuilding := true; TRichEdit(Control).BorderStyle := bsNone; if TRichEdit(Control).BorderWidth < 2 then TRichEdit(Control).BorderWidth := 2; end; if (FmouseinControl) or (FIsFocused) then borderColor := NewColor(C, FXPStyle.FFSelectBorderColor,60) else begin if FBorderStyle = bsSingle then borderColor := GetShadeColor(C, Control.Parent.Brush.Color, 60) else borderColor := Control.Parent.Brush.Color; end; Frame3D(C, R, borderColor, borderColor, 1); finally C.Free; end; end; procedure TControlSubClass.PaintCheckBox; var C: TControlCanvas; R: TRect; SelectColor, BorderColor: TColor; begin C := TControlCanvas.Create; try C.Control := Control; if FMouseInControl then begin SelectColor := FXPStyle.FFSelectColor; BorderColor := FXPStyle.FFSelectBorderColor; end else begin SelectColor := clWindow; BorderColor := clBtnShadow; end; if (FIsFocused) then begin SelectColor := FXPStyle.FFSelectColor; BorderColor := FXPStyle.FFSelectBorderColor; end; if (FBressed) or (FLButtonBressed ) then SelectColor := FXPStyle.FCheckedAreaSelectColor ; if TCheckBox(Control).State = cbGrayed then SelectColor := clSilver ; R := Control.ClientRect; InflateRect(R, 0, -3); R.Top := R.Top + ((R.Bottom - R.Top - GetSystemMetrics(SM_CXHTHUMB)) div 2); R.Bottom := R.Top + GetSystemMetrics(SM_CXHTHUMB); if ((Control.BiDiMode = bdRightToLeft) and (TCheckBox(Control).Alignment = taRightJustify)) or ((Control.BiDiMode = bdLeftToRight) and (TCheckBox(Control).Alignment = taLeftJustify)) then R.Left := R.Right - GetSystemMetrics(SM_CXHTHUMB) + 1 else if ((Control.BiDiMode = bdLeftToRight) and (TCheckBox(Control).Alignment = taRightJustify)) or ((Control.BiDiMode = bdRightToLeft) and (TCheckBox(Control).Alignment = taLeftJustify)) then R.Right := R.Left + GetSystemMetrics(SM_CXHTHUMB) - 1; C.Brush.Color := TCheckBox(Control).Color; C.FillRect(R); InflateRect(R, -2, -2); C.Brush.Color := SelectColor; C.Pen.Color := BorderColor; C.Rectangle(R.Left, R.Top, R.Right, R.Bottom); if (TCheckBox(Control).Checked) or (TCheckBox(Control).State = cbGrayed) then begin if Control.Enabled then begin if (FBressed) or (FLButtonBressed ) then C.Pen.color := clWindow else begin if TCheckBox(Control).State = cbGrayed then C.Pen.color := clGray else C.Pen.color := clHighlight; end; end else C.Pen.color := FXPStyle.FFDisabledColor; DrawCheckMark(C, R.Left, R.Bottom ) end; finally C.Free; end; end; procedure TControlSubClass.PaintRadio; var C: TControlCanvas; R: TRect; SelectColor, BorderColor: TColor; begin C := TControlCanvas.Create; try C.Control := Control; if FMouseInControl then begin SelectColor := FXPStyle.FFSelectColor; BorderColor := FXPStyle.FFSelectBorderColor;; end else begin SelectColor := clWindow; BorderColor := clBtnShadow; end; if (FIsFocused) then SelectColor := FXPStyle.FFSelectColor; R := Control.ClientRect; InflateRect(R, 0, -4); R.Top := R.Top + ((R.Bottom - R.Top - GetSystemMetrics(SM_CXHTHUMB)) div 2); R.Bottom := R.Top + GetSystemMetrics(SM_CXHTHUMB)-1; if ((Control.BiDiMode = bdRightToLeft) and (TCheckBox(Control).Alignment = taRightJustify)) or ((Control.BiDiMode = bdLeftToRight) and (TCheckBox(Control).Alignment = taLeftJustify)) then R.Left := R.Right - GetSystemMetrics(SM_CXHTHUMB) + 1 else if ((Control.BiDiMode = bdLeftToRight) and (TCheckBox(Control).Alignment = taRightJustify)) or ((Control.BiDiMode = bdRightToLeft) and (TCheckBox(Control).Alignment = taLeftJustify)) then R.Right := R.Left + GetSystemMetrics(SM_CXHTHUMB) - 1; C.Brush.Color := TCheckBox(Control).Color; C.FillRect(R); InflateRect(R, -2, -2); C.Brush.Color := SelectColor; C.Pen.Color := BorderColor; C.Ellipse(R.Left, R.Top, R.Right, R.Bottom); if TRadioButton(Control).Checked then begin InflateRect(R, -2, -2); if Control.Enabled then C.Brush.Color := clHighlight else C.Brush.color := FXPStyle.FFDisabledColor; C.Pen.Color := C.Brush.Color; C.Ellipse(R.Left, R.Top, R.Right, R.Bottom); end; finally C.Free; end; end; procedure TControlSubClass.PaintButton; var C: TControlCanvas; R: TRect; SelectColor, BorderColor: TColor; Txt: string; TextRect: TRect; TxtFont: TFont; CWidth, CHeight, TWidth, THeight: integer; TextFormat: integer; begin C := TControlCanvas.Create; try C.Control := Control; if (FMouseInControl) then begin if Control.Tag = 1000 then // UseParentColor SelectColor := NewColor(C, TControl(Control).Parent.Brush.Color, FXPStyle.FDimParentColorSelect) else SelectColor := NewColor(C, clBtnFace, FXPStyle.FDimParentColorSelect); BorderColor := NewColor(C, FXPStyle.FFSelectBorderColor,60); end else begin if Control.Tag = 1000 then SelectColor := NewColor(C, TControl(Control).Parent.Brush.Color, FXPStyle.FDimParentColor) else SelectColor := FXPStyle.FFIconBackColor; BorderColor := clBtnShadow; end; if (not FmouseinControl) and (FIsFocused) then begin BorderColor := NewColor(C, FXPStyle.FFSelectBorderColor,60); end; TextFormat := DT_CENTER + DT_VCENTER; R := Control.ClientRect; CWidth := (R.Right - R.Left); CHeight := (R.Bottom - R.Top); C.Brush.Color := Control.Parent.Brush.Color; C.FillRect(R); C.Brush.Color := SelectColor; C.Pen.Color := NewColor(C, BorderColor, 30); C.RoundRect(R.Left, R.Top, R.Right, R.Bottom, 4, 4); if TControl(Control).Enabled then if FBressed or (FLButtonBressed and FmouseinControl) {or FBressed} then begin C.Pen.Color := GetShadeColor(C, BorderColor, 50); C.MoveTo(R.Left , R.Bottom - 2); C.LineTo(R.Left , R.Top + 1); C.LineTo(R.Left + 1, R.Top ); C.LineTo(R.Right - 1 , R.Top ); end else begin C.Pen.Color := GetShadeColor(C, BorderColor, 50); C.MoveTo(R.Right - 1, R.Top + 1); C.LineTo(R.Right - 1, R.Bottom - 2); C.LineTo(R.Right - 2, R.Bottom - 1); C.LineTo(R.Left , R.Bottom - 1); end; Txt := TButton(Control).Caption; TextRect := R; TxtFont := TButton(Control).Font; C.Font.Assign (TxtFont); if TButton(Control).IsRightToLeft then TextFormat := TextFormat + DT_RTLREADING; //--- //"Holger Lembke" if (Txt <> '') then begin FillChar(TextRect, SizeOf(TextRect),0); DrawText(C.Handle, PChar(Txt), Length(Txt), TextRect, DT_CALCRECT + control.DrawTextBiDiModeFlags(0)); TWidth := TextRect.Right; THeight := TextRect.Bottom; end else begin TWidth := 0; THeight := 0; end; //--- TextRect.Left := (CWidth - (TWidth)) div 2; TextRect.Right := TextRect.Left + TWidth; TextRect.Top := (CHeight - (THeight)) div 2; TextRect.Bottom := TextRect.Top + THeight; FXPStyle.DrawTheText(Control, Txt, '', C, TextRect, false, TControl(Control).Enabled, TButton(Control).Default, false, TControl(Control).IsRightToLeft, TxtFont, TextFormat); finally C.Free; end; end; procedure TControlSubClass.PaintSpeedButton; var C: TControlCanvas; R: TRect; SelectColor, BorderColor: TColor; Txt: string; TextRect, IconRect: TRect; TxtFont: TFont; B, BF: TBitmap; CWidth, CHeight, BWidth, BHeight, TWidth, THeight, Space, NumGlyphs, Offset: integer; TextFormat: integer; FDown, FFlat, FTransparent: boolean; FLayout: TButtonLayout; P: TPoint; begin C := TControlCanvas.Create; try C.Control := Control; FDown := TSpeedButton(Control).Down; FFlat := TSpeedButton(Control).Flat; FTransparent := TSpeedButton(Control).Transparent; NumGlyphs := TSpeedButton(Control).NumGlyphs; //---------- if FFlat then if FMouseInControl then begin p := Mouse.CursorPos; P := Control.ScreenToClient(P); R := Control.ClientRect; FMouseInControl := (p.x >= R.Left) and (p.x <= R.Right) and (p.y >= R.Top) and (p.y <= R.Bottom); end; //---------- if (FMouseInControl) then begin if Control.Tag = 1000 then // UseParentColor begin SelectColor := NewColor(C, TControl(Control).Parent.Brush.Color, FXPStyle.FDimParentColorSelect); if FFlat then SelectColor := FXPStyle.FFSelectColor ; end else begin SelectColor := NewColor(C, clBtnFace, FXPStyle.FDimParentColorSelect); if FFlat then SelectColor := FXPStyle.FFSelectColor ; end; BorderColor := NewColor(C, FXPStyle.FFSelectBorderColor,60); end else begin if Control.Tag = 1000 then SelectColor := NewColor(C, TControl(Control).Parent.Brush.Color, FXPStyle.FDimParentColor) else SelectColor := FXPStyle.FFIconBackColor; if FFlat then SelectColor := TControl(Control).Parent.Brush.Color; if (Control.ClassName = 'TNavButton') and FFlat then begin SelectColor := TControl(Control).Parent.Brush.Color; end; BorderColor := clBtnShadow; end; if FDown then begin SelectColor := FXPStyle.FCheckedAreaColor; BorderColor := FXPStyle.FFSelectBorderColor; end; if FDown and FMouseInControl then begin SelectColor := FXPStyle.FCheckedAreaSelectColor; BorderColor := FXPStyle.FFSelectBorderColor; end; if not TControl(Control).Enabled then BorderColor := clBtnShadow; TextFormat := + DT_CENTER + DT_VCENTER;; R := Control.ClientRect; CWidth := (R.Right - R.Left); CHeight := (R.Bottom - R.Top); if (FDown or FMouseInControl) and FTransparent then begin BF := TBitmap.Create; try BF.Width := R.Right - R.Left; BF.Height := R.Bottom - R.Top; if FFlat then begin if GetDeviceCaps(C.Handle, BITSPIXEL) > 16 then BF.Canvas.Brush.Color := NewColor(C, FXPStyle.FFSelectColor, 20) else BF.Canvas.Brush.Color := SelectColor; end else begin if GetDeviceCaps(C.Handle, BITSPIXEL) > 16 then BF.Canvas.Brush.Color := NewColor(C, SelectColor, 5) else BF.Canvas.Brush.Color := SelectColor; end; BF.Canvas.FillRect (R); BitBlt(C.handle, R.Left, R.Top, R.Right - R.left, R.Bottom - R.top, BF.Canvas.Handle, 0, 0, SRCAND); finally BF.Free; end; end; C.Brush.Color := SelectColor; if not FTransparent then c.FillRect (R); if Control.ClassName = 'TNavButton' then begin c.FillRect (R); end; C.Pen.Color := NewColor(C, BorderColor, 30); if (FFlat) and (not FTransparent) and (not FDown) and (not FMouseInControl) then C.Pen.Color := C.Brush.Color; if FTransparent then C.Brush.Style := bsClear; if ((FTransparent) and (FMouseInControl)) or ((FTransparent) and (FDown)) or ((not FTransparent )) or ((not FFlat)) then begin C.Rectangle(R.Left, R.Top, R.Right, R.Bottom); end; if TControl(Control).Enabled then begin if (FFlat) then begin if (FLButtonBressed ) or (FDown) then begin C.Pen.Color := BorderColor; C.Rectangle(R.Left, R.Top, R.Right, R.Bottom); C.Pen.Color := GetShadeColor(C, BorderColor, 50); C.MoveTo(R.Left , R.Bottom - 1); C.LineTo(R.Left , R.Top ); C.LineTo(R.Right , R.Top ); end else if (FMouseInControl) then begin C.Pen.Color := FXPStyle.FFSelectBorderColor; C.Rectangle(R.Left, R.Top, R.Right, R.Bottom); end; end; if (not FFlat) then if (FLButtonBressed ) or (FDown) then begin C.Pen.Color := GetShadeColor(C, BorderColor, 50); C.MoveTo(R.Left , R.Bottom - 1); C.LineTo(R.Left , R.Top ); C.LineTo(R.Right , R.Top ); end else begin C.Pen.Color := GetShadeColor(C, BorderColor, 50); C.MoveTo(R.Right - 1, R.Top ); C.LineTo(R.Right - 1, R.Bottom - 1); C.LineTo(R.Left , R.Bottom - 1); end; end; Txt := TSpeedButton(Control).Caption; TextRect := R; TxtFont := TSpeedButton(Control).Font; C.Font.Assign (TxtFont); TWidth := C.TextWidth(Txt); //THeight := C.TextHeight(Txt); TextRect.Left := (CWidth - TWidth) div 2; if TControl(Control).IsRightToLeft then TextFormat := TextFormat + DT_RTLREADING; //--- //"Holger Lembke" if (Txt <> '') then begin FillChar(TextRect, sizeof(TextRect),0); DrawText(C.Handle, PChar(Txt), Length(Txt), TextRect, DT_CALCRECT + control.DrawTextBiDiModeFlags(0)); TWidth := TextRect.Right; THeight := TextRect.Bottom; end else begin TWidth := 0; THeight := 0; end; //--- if (TSpeedButton(Control).Glyph <> nil) then begin B := TBitmap.Create; BWidth := TSpeedButton(Control).Glyph.Width div TSpeedButton(Control).NumGlyphs; BHeight := TSpeedButton(Control).Glyph.Height; B.Width := BWidth; B.Height := BHeight; if Length(TSpeedButton(Control).Caption) > 0 then Space := TSpeedButton(Control).Spacing else Space := 0; IconRect := Rect(R.Left , R.Top, R.Left+BWidth, R.Top + BHeight); // Suggested by : "Holger Lembke" Offset := 1; if (not Control.Enabled) and (NumGlyphs > 1) then Offset := 2; if (FLButtonBressed) and (NumGlyphs > 2) then Offset := 3; if (FDown) and (NumGlyphs > 3) then Offset := 4; B.Canvas.CopyRect (Rect(0, 0, BWidth, BHeight), TSpeedButton(Control).Glyph.Canvas, Rect((BWidth * Offset) - BWidth, 0, BWidth * Offset, BHeight)); FLayout := TSpeedButton(Control).Layout; if Control.IsRightToLeft then begin if FLayout = blGlyphLeft then FLayout := blGlyphRight else if FLayout = blGlyphRight then FLayout := blGlyphLeft; end; case FLayout of blGlyphLeft: begin IconRect.Left := (CWidth - (BWidth + Space + TWidth)) div 2; IconRect.Right := IconRect.Left + BWidth; IconRect.Top := ((CHeight - (BHeight)) div 2) - 1; IconRect.Bottom := IconRect.Top + BHeight; TextRect.Left := IconRect.Right + Space; TextRect.Right := TextRect.Left + TWidth; TextRect.Top := (CHeight - (THeight)) div 2; TextRect.Bottom := TextRect.Top + THeight; end; blGlyphRight: begin IconRect.Right := (CWidth + (BWidth + Space + TWidth)) div 2; IconRect.Left := IconRect.Right - BWidth; IconRect.Top := (CHeight - (BHeight)) div 2; IconRect.Bottom := IconRect.Top + BHeight; TextRect.Right := IconRect.Left - Space; TextRect.Left := TextRect.Right - TWidth; TextRect.Top := (CHeight - (THeight)) div 2; TextRect.Bottom := TextRect.Top + THeight; end; blGlyphTop: begin IconRect.Left := (CWidth - BWidth) div 2; IconRect.Right := IconRect.Left + BWidth; IconRect.Top := (CHeight - (BHeight + Space + THeight)) div 2; IconRect.Bottom := IconRect.Top + BHeight; TextRect.Left := (CWidth - (TWidth)) div 2; TextRect.Right := TextRect.Left + TWidth; TextRect.Top := IconRect.Bottom + Space; TextRect.Bottom := TextRect.Top + THeight; end; blGlyphBottom: begin IconRect.Left := (CWidth - BWidth) div 2; IconRect.Right := IconRect.Left + BWidth; IconRect.Bottom := (CHeight + (BHeight + Space + THeight)) div 2; IconRect.Top := IconRect.Bottom - BHeight; TextRect.Left := (CWidth - (TWidth)) div 2; TextRect.Right := TextRect.Left + TWidth; TextRect.Bottom := IconRect.Top - Space; TextRect.Top := TextRect.Bottom - THeight; end; end; FXPStyle.DrawIcon(Control, C , B, IconRect, FMouseinControl, FIsFocused, TControl(Control).Enabled, FDown or FLButtonBressed, false, TControl(Control).IsRightToLeft); B.Free; end; FXPStyle.DrawTheText(Control, Txt, '', C, TextRect, false, TControl(Control).Enabled, false, false, TControl(Control).IsRightToLeft, TxtFont, TextFormat); finally C.Free; end; end; procedure TControlSubClass.PaintBitButn; var C: TControlCanvas; R: TRect; SelectColor, BorderColor: TColor; Txt: string; TextRect, IconRect: TRect; TxtFont: TFont; B: TBitmap; CWidth, CHeight, BWidth, BHeight, TWidth, THeight, Space: integer; TextFormat: integer; begin C := TControlCanvas.Create; try C.Control := Control; if (FMouseInControl or FBressed) then begin if (Control.Tag and 1000) = 1000 then SelectColor := NewColor(C, TControl(Control).Parent.Brush.Color, FXPStyle.FDimParentColorSelect) else SelectColor := NewColor(C, clBtnFace, FXPStyle.FDimParentColorSelect); BorderColor := NewColor(C, FXPStyle.FFSelectBorderColor,60); end else begin if (Control.Tag and 1000) = 1000 then SelectColor := NewColor(C, TControl(Control).Parent.Brush.Color, FXPStyle.FDimParentColor) else SelectColor := FXPStyle.FFIconBackColor; BorderColor := clBtnShadow; end; if (not FmouseinControl) and (FIsFocused) then begin BorderColor := NewColor(C, FXPStyle.FFSelectBorderColor,60); end; if (Control.Tag and 1001) = 1001 then begin BorderColor := SelectColor; end; TextFormat := + DT_CENTER + DT_VCENTER; R := Control.ClientRect; CWidth := (R.Right - R.Left); CHeight := (R.Bottom - R.Top); C.Brush.Color := Control.Parent.Brush.Color; C.FillRect(R); C.Brush.Color := SelectColor; C.Pen.Color := NewColor(C, BorderColor, 30); c.RoundRect(R.Left, R.Top, R.Right, R.Bottom, 4, 4); if (Control.Tag and 1001) <> 1001 then begin if TControl(Control).Enabled then if (FLButtonBressed and FmouseinControl) or (FBressed) then begin C.Pen.Color := GetShadeColor(C, BorderColor, 50); C.MoveTo(R.Left , R.Bottom - 2); C.LineTo(R.Left , R.Top + 1); C.LineTo(R.Left + 1, R.Top ); C.LineTo(R.Right - 1 , R.Top ); end else begin C.Pen.Color := GetShadeColor(C, BorderColor, 50); C.MoveTo(R.Right - 1, R.Top + 1); C.LineTo(R.Right - 1, R.Bottom - 2); C.LineTo(R.Right - 2, R.Bottom - 1); C.LineTo(R.Left , R.Bottom - 1); end; end; Txt := TBitBtn(Control).Caption; TextRect := R; TxtFont := TBitBtn(Control).Font; C.Font.Assign (TxtFont); TWidth := C.TextWidth(Txt); TextRect.Left := (CWidth - TWidth) div 2; //--- //"Holger Lembke" if (Txt <> '') then begin FillChar(TextRect, sizeof(TextRect),0); DrawText(C.Handle, PChar(Txt), Length(Txt), TextRect, DT_CALCRECT + control.DrawTextBiDiModeFlags(0)); TWidth := TextRect.Right; THeight := TextRect.Bottom; end else begin TWidth := 0; THeight := 0; end; //--- if TBitBtn(Control).IsRightToLeft then TextFormat := TextFormat + DT_RTLREADING; if (TBitBtn(Control).Glyph <> nil) then begin B := TBitmap.Create; BWidth := TBitBtn(Control).Glyph.Width div TBitBtn(Control).NumGlyphs; BHeight := TBitBtn(Control).Glyph.Height; B.Width := BWidth; B.Height := BHeight; Space := TBitBtn(Control).Spacing; if (Trim(TBitBtn(Control).Caption) = '') then Space := 0; //"Holger Lembke" IconRect := Rect(R.Left , R.Top, R.Left+BWidth, R.Top + BHeight); B.Canvas.CopyRect (Rect(0, 0, BWidth, BHeight), TBitBtn(Control).Glyph.Canvas, Rect(0, 0, BWidth, BHeight)); case TBitBtn(Control).Layout of blGlyphLeft: begin IconRect.Left := (CWidth - (BWidth + Space + TWidth)) div 2; IconRect.Right := IconRect.Left + BWidth; IconRect.Top := (CHeight - (BHeight)) div 2; IconRect.Bottom := IconRect.Top + BHeight; TextRect.Left := IconRect.Right + Space; TextRect.Right := TextRect.Left + TWidth; TextRect.Top := (CHeight - (THeight)) div 2; TextRect.Bottom := TextRect.Top + THeight; end; blGlyphRight: begin IconRect.Right := (CWidth + (BWidth + Space + TWidth)) div 2; IconRect.Left := IconRect.Right - BWidth; IconRect.Top := (CHeight - (BHeight)) div 2; IconRect.Bottom := IconRect.Top + BHeight; TextRect.Right := IconRect.Left - Space; TextRect.Left := TextRect.Right - TWidth; TextRect.Top := (CHeight - (THeight)) div 2; TextRect.Bottom := TextRect.Top + THeight; end; blGlyphTop: begin IconRect.Left := (CWidth - BWidth) div 2; IconRect.Right := IconRect.Left + BWidth; IconRect.Top := (CHeight - (BHeight + Space + THeight)) div 2; IconRect.Bottom := IconRect.Top + BHeight; TextRect.Left := (CWidth - (TWidth)) div 2; TextRect.Right := TextRect.Left + TWidth; TextRect.Top := IconRect.Bottom + Space; TextRect.Bottom := TextRect.Top + THeight; end; blGlyphBottom: begin IconRect.Left := (CWidth - BWidth) div 2; IconRect.Right := IconRect.Left + BWidth; IconRect.Bottom := (CHeight + (BHeight + Space + THeight)) div 2; IconRect.Top := IconRect.Bottom - BHeight; TextRect.Left := (CWidth - (TWidth)) div 2; TextRect.Right := TextRect.Left + TWidth; TextRect.Bottom := IconRect.Top - Space; TextRect.Top := TextRect.Bottom - THeight; end; end; FXPStyle.DrawIcon(Control, C , B, IconRect, FMouseinControl, FIsFocused, TControl(Control).Enabled, false, false, TControl(Control).IsRightToLeft); B.Free; end; if (Control.Tag and 1002) = 1002 then begin if TBitBtn(Control).IsRightToLeft then TextFormat := + DT_RIGHT + DT_VCENTER else TextFormat := + DT_LEFT + DT_VCENTER; TextRect := R; InflateRect(TextRect, -4,-2); end; FXPStyle.DrawTheText(Control, Txt, '', C, TextRect, false, TControl(Control).Enabled, TBitBtn(Control).Default, false, TControl(Control).IsRightToLeft, TxtFont, TextFormat); finally C.Free; end; end; procedure TControlSubClass.PaintUpDownButton; var C: TControlCanvas; R: TRect; SelectColor, BorderColor, ArrowColor: TColor; P: TPoint; H: integer; procedure DrawUpDownButton(ARect: TRect; Arrow: integer; Active: boolean); begin if Control.Enabled then ArrowColor := clBlack else ArrowColor := clWhite; if Active then begin if FLButtonBressed then begin BorderColor := FXPStyle.FFSelectBorderColor; SelectColor := FXPStyle.FCheckedAreaSelectColor ; ArrowColor := clWhite; end else begin BorderColor := FXPStyle.FFSelectBorderColor; SelectColor := NewColor(C, FXPStyle.FFSelectColor, 60);//FXPStyle.FFSelectColor; end; end else begin if Control.Tag = 1000 then SelectColor := NewColor(C, TControl(Control).Parent.Brush.Color, FXPStyle.FDimParentColor) else SelectColor := NewColor(C, FXPStyle.FFSelectColor, FXPStyle.FDimParentColor);//clBtnFace; BorderColor := NewColor(C, TControl(Control).Parent.Brush.Color, 80);//SelectColor; end; C.Pen.Color := BorderColor; C.Brush.Color := SelectColor; C.Font.Color := ArrowColor; if C.Pixels[ARect.Left, ARect.Top] <> ColorToRGB(BorderColor) then begin C.Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom); C.Pen.Color := ArrowColor; DrawArrow(C, ARect.Left + ((ARect.Right - ARect.Left) div 2), ARect.Top + ((ARect.Bottom - ARect.Top) div 2) -2, Arrow); end; end; begin C := TControlCanvas.Create; try C.Control := Control; R := Control.ClientRect; H := (R.Bottom - R.Top) div 2; P := Control.ScreenToClient(Mouse.CursorPos); DrawUpDownButton(Rect(R.Left, R.Top, R.Right, R.Top + H), 0, TControl(Control).Enabled and FMouseInControl and (P.Y < H)); DrawUpDownButton(Rect(R.Left, R.Bottom - H, R.Right, R.Bottom), 1, TControl(Control).Enabled and FMouseInControl and not(P.Y < H)); finally C.Free; end; end; procedure TControlSubClass.PaintGroupBox; var C: TControlCanvas; R, RText: TRect; ShadowColor, LightColor: TColor; TextHeight, TextWidth: integer; Text: string; begin if FMsg <> WM_PAINT then exit; C := TControlCanvas.Create; try C.Control := Control; R := Control.ClientRect; C.Font.Assign (TGroupBox(Control).Font); C.Font.Height := TGroupBox(Control).Font.Height; Text := TGroupBox(Control).Caption; TextHeight := C.TextHeight(Text); TextWidth := C.TextWidth(Text); if Length(Text) = 0 then TextHeight := C.TextHeight(' '); ShadowColor := GetShadeColor(C, TGroupBox(Control).color, 60); LightColor := NewColor(C, TGroupBox(Control).color, 60); InflateRect(R,-1, -1); Inc(R.Top, (TextHeight)-1); C.Brush.Style := bsClear; C.Pen.Color := TGroupBox(Control).Color; // Control Color; C.Rectangle (R.Left, R.Top, R.Right, R.Bottom); //----Draw the outer Frame R := Control.ClientRect; Inc(R.Top, (TextHeight div 2)-1); C.Pen.Color := TGroupBox(Control).Color; C.MoveTo(R.Left + 1, R.Top); // Repeat C.LineTo(R.Left + 1, R.Bottom); if TGroupBox(Control).Ctl3D then Frame3D(C, R, LightColor, ShadowColor, 1) else Frame3D(C, R, ShadowColor, ShadowColor, 1); // Fill Upper part (outside frame) R := Control.ClientRect; R.Bottom := R.Top + (TextHeight div 2) + 1; C.Brush.Style := bsSolid; C.Brush.Color := Control.Parent.Brush.Color; // Parent Color; C.Pen.Color := C.Brush.Color; C.FillRect(R); if Control.IsRightToLeft then begin C.TextFlags := ETO_RTLREADING; RText.Right := R.Right - 9; RText.Left := RText.Right - TextWidth; end else begin RText.Left := R.Left + 9; RText.Right := RText.Left + TextWidth; end; RText.Top := R.Top ; RText.Bottom := R.Top + TextHeight; //(inside frame) InflateRect(R, -1, 0); R.Top := R.Bottom; R.Bottom := R.Top + (TextHeight div 2) + 1; C.Brush.Style := bsSolid; R.Left := RText.Left; R.Right := RText.Right; C.Brush.Color := TGroupBox(Control).Color; // Control Color; C.Pen.Color := C.Brush.Color; C.FillRect(R); R.Right := Control.ClientRect.Right; C.MoveTo(R.Right-2, R.Top); C.LineTo(R.Right-2, RText.Bottom); C.Brush.Style := bsClear; if Control.IsRightToLeft then C.TextFlags := ETO_RTLREADING; C.TextRect (RText, RText.Left, RText.Top, Text); // Draw Upper Line R := Control.ClientRect; Inc(R.Top, (TextHeight div 2) + 1); if TGroupBox(Control).Ctl3D then C.Pen.Color := LightColor else C.Pen.Color := ShadowColor; C.MoveTo(R.Left, R.Top); C.LineTo(RText.Left, R.Top); C.MoveTo(RText.Right, R.Top); C.LineTo(R.Right -1, R.Top); finally C.Free; end; end; procedure TControlSubClass.PaintPanel; var C: TControlCanvas; R: TRect; ShadowColor, LightColor: TColor; begin if FMsg <> WM_PAINT then exit; C := TControlCanvas.Create; try C.Control := Control; R := Control.ClientRect; ShadowColor := GetShadeColor(C, TPanel(Control).color, 60); LightColor := NewColor(C, TPanel(Control).color, 60); if TPanel(Control).BevelOuter <> bvNone then begin if TPanel(Control).BevelOuter = bvLowered then Frame3D(C, R, ShadowColor, LightColor, TPanel(Control).BevelWidth) else Frame3D(C, R, LightColor, ShadowColor, TPanel(Control).BevelWidth); end; if TPanel(Control).BevelInner <> bvNone then begin InflateRect(R, -TPanel(Control).BorderWidth, -TPanel(Control).BorderWidth); if TPanel(Control).BevelInner = bvLowered then Frame3D(C, R, ShadowColor, LightColor, TPanel(Control).BevelWidth) else Frame3D(C, R, LightColor, ShadowColor, TPanel(Control).BevelWidth); end; finally C.Free; end; end; type TCastWinControl = class(TWinControl); procedure TControlSubClass.PaintNCWinControl; var DC: HDC; C: TControlCanvas; R: TRect; BorderColor: TColor; begin C := TControlCanvas.Create; DC := GetWindowDC(TWinControl(Control).Handle); try C.Control := Control; C.Handle := DC; FXPStyle.SetGlobalColor(C); if (FMouseInControl) or (FIsFocused) then begin if FBorderStyle = bsSingle then BorderColor := NewColor(C, FXPStyle.FFSelectBorderColor, 60) else BorderColor := NewColor(C, FXPStyle.FFSelectBorderColor, 80); end else begin if FBorderStyle = bsSingle then borderColor := GetShadeColor(C, Control.Parent.Brush.Color, 60) else borderColor := Control.Parent.Brush.Color; end; if TCastWinControl(Control).Ctl3D <> false then begin FBuilding := true; TCastWinControl(Control).Ctl3D := false; end; C.Pen.Color := BorderColor; C.Brush.Style := bsClear; R := Rect(0, 0, Control.Width, Control.Height); C.Rectangle(R.Left, R.Top, R.Right, R.Bottom); finally C.Free; ReleaseDC(TWinControl(Control).Handle, DC); end; end; procedure TControlSubClass.PaintProgressBar; var DC: HDC; C: TControlCanvas; R: TRect; BorderColor: TColor; begin C := TControlCanvas.Create; DC := GetWindowDC(TWinControl(Control).Handle); try C.Control := Control; C.Handle := DC; if (FMouseInControl) then BorderColor := FXPStyle.FFSelectBorderColor else BorderColor := GetShadeColor(C, Control.Parent.Brush.Color, 60); C.Pen.Color := BorderColor; C.Brush.Style := bsClear; R := Rect(0, 0, Control.Width, Control.Height); C.Rectangle(R.Left, R.Top, R.Right, R.Bottom); finally C.Free; ReleaseDC(TWinControl(Control).Handle, DC); end; end; procedure TControlSubClass.PaintHotKey; var DC: HDC; C: TControlCanvas; R: TRect; BorderColor: TColor; begin C := TControlCanvas.Create; DC := GetWindowDC(TWinControl(Control).Handle); try C.Control := Control; C.Handle := DC; FXPStyle.SetGlobalColor(C); if (FMouseInControl) or (FIsFocused) then BorderColor := NewColor(C, FXPStyle.FFSelectBorderColor, 60) else BorderColor := GetShadeColor(C, Control.Parent.Brush.Color, 60); C.Pen.Color := BorderColor; C.Brush.Style := bsClear; R := Rect(0, 0, Control.Width, Control.Height); C.Rectangle(R.Left, R.Top, R.Right, R.Bottom); InflateRect(R, -1, -1); C.Pen.Color := clWindow; C.Rectangle(R.Left, R.Top, R.Right, R.Bottom); finally C.Free; ReleaseDC(TWinControl(Control).Handle, DC); end; end; // UCXPStyleManager // // Uwe Runkel, uwe@runkel.info // // Enable FXPStyle to be used globally (all windows in the application use XPStyle). // Hence you don't need more than one instance in an application. However it is also // possible to have more than one instance. But only one instance is used for subclassing. // If this instance is destroyed the manager looks if there is another instance which is // allowed to subclass. constructor TUCXPStyleManager.Create; begin inherited Create; FXPStyleList := TList.Create; // list of XPStyle components in the application FFormList := TList.Create; // list of subclassed forms FPendingFormsList := TList.Create; // list of forms inserted but not subclassed yet FDisableSubclassing := false; // This disables the UCXPStyleManager FActiveXPStyle := nil; // Currently for subclassing used XPStyle // if this is nil no subclassing is done. {the If condition was added because sometimes it freezes delphi when more than two windows with the UCXPStyle component are opened and the closed} if not (csDesigning in Application.ComponentState) then Application.HookMainWindow(MainWindowHook); end; destructor TUCXPStyleManager.Destroy; begin {Bret Goldsmith bretg@yahoo.com} {alexs } {the If condition was added because sometimes it freezes delphi when more than two windows with the UCXPStyle component are opened and the closed} if not (csDesigning in Application.ComponentState) then Application.UnhookMainWindow(MainWindowHook); FPendingFormsList.Free; FXPStyleList.Free; FFormList.Free; inherited; end; // A component has been inserted or removed, if it is a form and subclassing is // allowed then subclass it, so this form doesn't need a XPStyle component as well procedure TUCXPStyleManager.Notification(AComponent: TComponent; AOperation: TOperation); begin if (FActiveXPStyle = nil) or FDisableSubclassing then Exit; case AOperation of opInsert: // At this place we cannot subclass the control because it did not yet get its // initial window procedure. // So we add it to an intermediate list and subclass it at a later moment. if (AComponent is TCustomForm) and (FPendingFormsList.IndexOf(AComponent) < 0) then FPendingFormsList.Add(AComponent); opRemove: if (AComponent is TWinControl) then begin if AComponent is TCustomForm then begin // Remove the destroyed form from any form list if it is still there. FPendingFormsList.Remove(AComponent); FFormList.Remove(AComponent); end; end; end; end; // Add some XPStyle to the manager procedure TUCXPStyleManager.Add(AXPStyle: TUCXPStyle); begin FXPStyleList.Add(AXPStyle); FFormList.Add(AXPStyle.Form); if (FActiveXPStyle = nil) and AXPStyle.Active and not(AXPStyle.DisableSubclassing) and not(FDisableSubclassing) then begin FActiveXPStyle := AXPStyle; CollectForms; end; end; // Remove some XPStyle from the manager procedure TUCXPStyleManager.Delete(AXPStyle: TUCXPStyle); begin if AXPStyle = FActiveXPStyle then UpdateActiveXPStyle(AXPStyle); FXPStyleList.Remove(AXPStyle); end; // Select a new ActiveXPStyle (except the one given in the parameter) procedure TUCXPStyleManager.UpdateActiveXPStyle(AXPStyle: TUCXPStyle); var Cnt : integer; XPM : TUCXPStyle; Item: TControlSubClass; Comp: TControlSubClass; begin XPM := FindSubclassingXPStyle(AXPStyle); if XPM = nil then begin FPendingFormsList.Clear; if not Assigned(Application.MainForm) then Exit; for Cnt := 0 to FFormList.Count - 1 do if (AXPStyle = nil) or (FFormList[Cnt] <> AXPStyle.Form) then RemoveChildSubclassing(TCustomForm(FFormList[Cnt])); FFormList.Clear; FActiveXPStyle := XPM; end else begin if FActiveXPStyle = nil then begin FActiveXPStyle := XPM; CollectForms; end else begin for Cnt := 0 to FActiveXPStyle.ComponentCount - 1 do if (FActiveXPStyle.Components[Cnt] is TControlSubClass) then begin Comp := FActiveXPStyle.Components[Cnt] as TControlSubClass; if (AXPStyle <> nil) and not(AXPStyle.Form.ContainsControl(Comp.Control)) then begin Item := TControlSubClass.Create(XPM); Item.Control := Comp.Control; Item.orgWindowProc := Comp.orgWindowProc; Item.Control.WindowProc := Item.ControlSubClass; Item.FXPStyle := XPM; Item.FCtl3D := Comp.FCtl3D; Item.FBorderStyle := Comp.FBorderStyle; {Item.FOnDrawCell := Comp.FOnDrawCell;} Item.FDefaultDrawing := Comp.FDefaultDrawing; Item.FSelCol := Comp.FSelCol; Item.FSelRow := Comp.FSelRow; end; end; FActiveXPStyle := XPM; end; end; end; // Find an XPStyle which can be used for subclassing function TUCXPStyleManager.FindSubclassingXPStyle(Exclude: TUCXPStyle): TUCXPStyle; var XPM: TUCXPStyle; Cnt: integer; begin Result := nil; if (FXPStyleList.Count = 0) or FDisableSubclassing then Exit; Cnt := 0; repeat XPM := TUCXPStyle(FXPStyleList[Cnt]); if XPM.Active and not(XPM.DisableSubclassing) and (XPM <> Exclude) then Result := XPM; inc(Cnt); until (Result <> nil) or (Cnt = FXPStyleList.Count); end; // Listens to messages sent to the application and looks if a window is inserted. function TUCXPStyleManager.MainWindowHook(var Message: TMessage): boolean; var i: integer; NewForm: TCustomForm; FMenuItem: TMenuItem; // +jt FMenu: TMenu; // +jt r: TRECT; // +jt pt: TPOINT; // +jt hWndM: HWND; // +j begin Result := false; // +ahuser// ahuser: "Andreas Hausladen" if UCXPStyleManager = nil then // prevent AVs on termination Exit; // +ahuser if Message.Msg = WM_DRAWMENUBORDER then begin FMenuItem:=TMenuItem(Message.LParam); if Assigned(FMenuItem) then begin GetMenuItemRect(0,FMenuItem.Parent.Handle,FMenuItem.MenuIndex,r); FMenu := FMenuItem.Parent.GetParentMenu; pt.x:=r.Left+(r.Right-r.Left) div 2; pt.y:=r.Top+(r.Bottom-r.Top) div 2; hWndM :=WindowFromPoint(pt); if (hWndM <> 0) and Assigned(FActiveXPStyle) then //Rappido 2003 09 13 FActiveXPStyle.DrawWindowBorder(hWndM, FMenu.IsRightToLeft); end; end; if Message.Msg = WM_DRAWMENUBORDER2 then begin hWndM := HWND(Message.LParam); if (hWndM <> 0) and Assigned(FActiveXPStyle) then //Rappido 2003 09 13 FActiveXPStyle.DrawWindowBorder(hWndM, boolean(Message.WParam)); end; if (Assigned(FPendingFormsList)) and (FPendingFormsList <> nil) then try if (FPendingFormsList.Count > 0) then begin for i := 0 to FPendingFormsList.Count - 1 do begin NewForm := TCustomForm(FPendingFormsList[i]); if FFormList.IndexOf(NewForm) < 0 then begin FFormList.Add(NewForm); if not(FDisableSubclassing) then FActiveXPStyle.InitItems(NewForm, true, true); end; end; FPendingFormsList.Clear; end; except end; end; // Collect all forms of the application and subclass them procedure TUCXPStyleManager.CollectForms; var FCnt, CCnt: integer; HasXPStyle : boolean; begin if not FDisableSubclassing then for FCnt := 0 to Screen.FormCount - 1 do if (FFormList.IndexOf(Screen.Forms[FCnt]) < 0) and (Screen.Forms[FCnt].Tag <> 999) then begin HasXPStyle := false; for CCnt := 0 to Screen.Forms[FCnt].ComponentCount - 1 do HasXPStyle := HasXPStyle or (Screen.Forms[FCnt].Components[CCnt] is TUCXPStyle); if not(HasXPStyle) then FPendingFormsList.Add(Screen.Forms[FCnt]); end; end; // Remove subclassing from the original components procedure TUCXPStyleManager.RemoveChildSubclassing(AForm: TCustomForm); var Cnt : integer; Comp : TComponent; Control: TControl; begin //exit; for Cnt := FActiveXPStyle.ComponentCount - 1 downto 0 do begin Comp := FActiveXPStyle.Components[Cnt]; if (Comp is TControlSubClass) then begin Control := TControlSubClass(Comp).Control; if AForm.ContainsControl(Control) then begin try Control.WindowProc := TControlSubClass(Comp).orgWindowProc; if Control is TCustomEdit then begin TEdit(Control).Ctl3D := TControlSubClass(Comp).FCtl3D; TEdit(Control).BorderStyle := TControlSubClass(Comp).FBorderStyle; end; if Control.ClassName = 'TDBLookupComboBox' then TComboBox(Control).Ctl3D := TControlSubClass(Comp).FCtl3D; if Control is TCustomListBox then begin TListBox(Control).Ctl3D := TControlSubClass(Comp).FCtl3D; TListBox(Control).BorderStyle := TControlSubClass(Comp).FBorderStyle; end; if Control is TCustomListView then begin TListView(Control).Ctl3D := TControlSubClass(Comp).FCtl3D; TListView(Control).BorderStyle := TControlSubClass(Comp).FBorderStyle; end; if Control is TCustomTreeView then begin TTreeView(Control).Ctl3D := TControlSubClass(Comp).FCtl3D; TTreeView(Control).BorderStyle := TControlSubClass(Comp).FBorderStyle; end; except end; end; end; end; end; // Add a form manually to the current XPStyle procedure TUCXPStyleManager.AddForm(AForm: TCustomForm); begin if FPendingFormsList.IndexOf(AForm) < 0 then FPendingFormsList.Add(AForm); end; // Remove a form manually from the current XPStyle procedure TUCXPStyleManager.RemoveForm(AForm: TCustomForm); begin if FPendingFormsList.IndexOf(AForm) >= 0 then FPendingFormsList.Remove(AForm); if FFormList.IndexOf(AForm) >= 0 then FFormList.Remove(AForm); end; // Disable/Enable subclassing by the manager procedure TUCXPStyleManager.SetDisableSubclassing(AValue: boolean); begin if FDisableSubclassing = AValue then Exit; FDisableSubclassing := AValue; UpdateActiveXPStyle(nil); end; // Check if a Form is subclassed function TUCXPStyleManager.IsFormSubclassed(AForm: TCustomForm): boolean; begin Result := ((FFormList <> nil) and (FFormList.IndexOf(AForm) >= 0)) or ((FPendingFormsList <> nil) and (FPendingFormsList.IndexOf(AForm) >= 0)); end; // Check if a Component is subclassed function TUCXPStyleManager.IsComponentSubclassed(AComponent: TComponent): boolean; var Cnt: integer; begin Result := false; with FActiveXPStyle do for Cnt := 0 to ComponentCount - 1 do if Components[Cnt] is TControlSubClass then if TControlSubClass(Components[Cnt]).Control = TControl(AComponent) then begin Result := True; Break; // ahuser end; end; initialization InitControls; //else // exit; finalization DoneControls; end.