Archivado/Componentes.Terceros.jvcl
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
b40ce04eb4
Componentes.Terceros.jvcl/official/3.32/examples/JvDocking/MSDN2002/Source/XPMenu.pas

4120 lines
120 KiB
ObjectPascal
Raw Normal View History

git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.jvcl@4 7f62d464-2af8-f54e-996c-e91b33f51cbe
2007-07-10 08:04:15 +00:00
{
XPMenu for Delphi
Author: Khaled Shagrouni
URL: http://www.shagrouni.com/english/software/xpmenu.html
e-mail: shagrouni@hotmail.com
Version 2.21, May 18, 2002
XPMenu is a Delphi component to mimic Office XP menu and toolbar style.
Copyright (C) 2001, 2002 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 <shagrouni@hotmail.com> (Please state the XPMenu version and OS information).
Update http://www.tommstudio.com
}
{$IFDEF VER130}
{$DEFINE VER5U}
{$ENDIF}
{$IFDEF VER140}
{$DEFINE VER5U}
{$DEFINE VER6U}
{$ENDIF}
unit XPMenu;
interface
uses
Windows, SysUtils, Classes, Graphics, Controls, ComCtrls, Forms,
Menus, Messages, Commctrl, ExtCtrls, StdCtrls, Buttons,dialogs;
type
TXPContainer = (xccForm, xccFrame, xccToolbar, xccCoolbar, xccControlbar, xccPanel,
xccScrollBox, xccGroupBox, xccTabSheet, xccPageScroller);
TXPContainers = set of TXPContainer;
TXPControl = (xcMainMenu, xcPopupMenu, xcToolbar, xcControlbar, xcCombo,
xcEdit, xcMaskEdit, xcMemo, xcRichEdit, xcCheckBox, xcRadioButton,
xcButton, xcBitBtn, xcSpeedButton, xcPanel, xcGroupBox);
TXPControls = set of TXPControl;
TXPMenu = class;
TControlSubClass = class(TComponent) //: "Fabian Jakubowski" <fj@sambreville.com>
private
Control: TControl;
FBuilding: boolean;
FMouseInControl: boolean;
FLButtonBressed: boolean;
FBressed: boolean;
FIsKeyDown: boolean;
FIsFocused: boolean;
orgWindowProc: TWndMethod;
XPMenu: TXPMenu;
FCtl3D: boolean;
FBorderStyle: TBorderStyle;
FMsg: Cardinal;
procedure ControlSubClass(var Message: TMessage);
procedure PaintControlXP;
procedure PaintCombo;
procedure PaintEdit;
procedure PaintRichEdit;
procedure PaintCheckBox;
procedure PaintRadio;
procedure PaintButton;
procedure PaintBitButn;
procedure PaintUpDownButton;
procedure PaintSpeedButton;
procedure PaintPanel;
procedure PaintGroupBox;
end;
TXPMenu = class(TComponent)
private
FActive: boolean;
{Changes MMK FForm to TScrollingWinControl}
FForm: TScrollingWinControl;
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;
FFColor, FFIconBackColor, FFSelectColor, FFSelectBorderColor,
FFSelectFontColor, FCheckedAreaColor, FCheckedAreaSelectColor,
FFCheckedColor, FFMenuBarColor, FFDisabledColor, FFSeparatorColor,
FMenuBorderColor, FMenuShadowColor: TColor;
{*******************Tommstudio.com update********************}
FControlUseTrueXPStyle:boolean; //<2F>Ƿ<EFBFBD>ʹ<EFBFBD><CAB9><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Xp<58><70>ʽ<EFBFBD><CABD><EFBFBD><EFBFBD>ɫ
FBtnRoundArc:integer; //Բ<><D4B2><EFBFBD>Ĵ<EFBFBD>С
FBtnOutLineBorderColor, //<2F><>ť<EFBFBD><C5A5><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ
FBtnInnerBorderMoveColor, //<2F><><EFBFBD><EFBFBD><EFBFBD>ƶ<EFBFBD><C6B6><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʱ<EFBFBD>ڱ߿<DAB1><DFBF><EFBFBD>ʾ<EFBFBD><CABE><EFBFBD><EFBFBD>ɫ
FBtnInnerBorderFocusColor, //<2F><>ť<EFBFBD>õ<EFBFBD><C3B5><EFBFBD><EFBFBD><EFBFBD>ʱ<EFBFBD>ڱ߿<DAB1><DFBF><EFBFBD><EFBFBD><EFBFBD>ɫ
FBtnSurfaceNormalColor, //<2F><>ť<EFBFBD><C5A5><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ
FBtnSurfaceDownColor, //<2F><><EFBFBD><EFBFBD><EFBFBD>ƶ<EFBFBD><C6B6><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʱ<EFBFBD><CAB1>ť<EFBFBD><C5A5><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ
FBtnSurfaceBottomLineColor, //<2F><><EFBFBD><EFBFBD>û<EFBFBD>а<EFBFBD><D0B0><EFBFBD>ʱ<EFBFBD>±<EFBFBD><C2B1><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ
FRdoChkControlChkColor, //Radioc<6F>ؼ<EFBFBD>checkedʱ<64><CAB1><EFBFBD><EFBFBD>ɫ
FComboBoxChkColor, //combobox<6F>ؼ<EFBFBD>check<63><6B><EFBFBD><EFBFBD>ɫ
FComboboxSurfaceMoveColor, //Combobox<6F>ؼ<EFBFBD><D8BC><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ƶ<EFBFBD><C6B6><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʱ<EFBFBD>ĵ<EFBFBD>ɫ
FComboboxSurfaceDownColor, //Combobox<6F>ؼ<EFBFBD><D8BC><EFBFBD><EFBFBD>갴<EFBFBD>µĵ<C2B5>ɫ
FControlDisabledBorderColor, //<2F><><EFBFBD>пؼ<D0BF><D8BC><EFBFBD><EFBFBD><EFBFBD>Чʱ<D0A7>ı߿<C4B1>ɫ
FBtnSurfaceDownBottomLineColor:TColor; //<2F><><EFBFBD>갴<EFBFBD><EAB0B4>ʱ<EFBFBD>±<EFBFBD><C2B1><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ
{*******************Tommstudio.com update********************}
Is16Bit: boolean;
FOverrideOwnerDraw: boolean;
FGradient: boolean;
FFlatMenu: boolean;
FAutoDetect: boolean;
FXPContainers: TXPContainers;
FXPControls: TXPControls;
FGrayLevel: byte;
FDimLevel: byte;
// FDoubleBuffered :Boolean;
{*******************Tommstudio.com update********************}
procedure SetControlUseTrueXPStyle(const value:Boolean);
{*******************Tommstudio.com update********************}
procedure SetActive(const Value: boolean);
procedure SetAutoDetect(const Value: boolean);
procedure SetForm(const Value: TScrollingWinControl);
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 SetXPContainers(const Value: TXPContainers);
procedure SetXPControls(const Value: TXPControls);
protected
procedure InitItems(wForm: TWinControl; Enable, Update: boolean);
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 ActivateMenuItem(MenuItem: TMenuItem);
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 DrawArrow(ACanvas: TCanvas; X, Y: integer);
procedure MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
function GetImageExtent(MenuItem: TMenuItem): TPoint;
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;
Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Form: TScrollingWinControl read FForm write SetForm;
published
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 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 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: TXPContainers read FXPContainers write SetXPContainers
default [xccForm, xccFrame, xccToolbar, xccCoolbar, xccControlbar, xccPanel,
xccScrollBox, xccGroupBox, xccTabSheet, xccPageScroller];
property XPControls :TXPControls read FXPControls write SetXPControls
default [xcMainMenu, xcPopupMenu, xcToolbar, xcControlbar, xcCombo,
xcEdit, xcMaskEdit, xcMemo, xcRichEdit, xcCheckBox, xcRadioButton,
xcButton, xcBitBtn, xcSpeedButton, xcPanel, xcGroupBox];
property Active: boolean read FActive write SetActive;
{*******************Tommstudio.com update********************}
property ControlUseTrueXPStyle:boolean read FControlUseTrueXPStyle write SetControlUseTrueXPStyle; //<2F>Ƿ<EFBFBD>ʹ<EFBFBD><CAB9><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Xp<58><70>ʽ<EFBFBD><CABD><EFBFBD><EFBFBD>ɫ
property BtnRoundArc:integer read FBtnRoundArc write FBtnRoundArc; //Բ<><D4B2><EFBFBD>Ĵ<EFBFBD>С
property BtnOutLineBorderColor:TColor read FBtnOutLineBorderColor write FBtnOutLineBorderColor;
property BtnInnerBorderMoveColor:TColor read FBtnInnerBorderMoveColor write FBtnInnerBorderMoveColor; //<2F><><EFBFBD><EFBFBD><EFBFBD>ƶ<EFBFBD><C6B6><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʱ<EFBFBD>ڱ߿<DAB1><DFBF><EFBFBD>ʾ<EFBFBD><CABE><EFBFBD><EFBFBD>ɫ
property BtnInnerBorderFocusColor:TColor read FBtnInnerBorderFocusColor write FBtnInnerBorderFocusColor; //<2F><>ť<EFBFBD>õ<EFBFBD><C3B5><EFBFBD><EFBFBD><EFBFBD>ʱ<EFBFBD>ڱ߿<DAB1><DFBF><EFBFBD><EFBFBD><EFBFBD>ɫ
property BtnSurfaceNormalColor:TColor read FBtnSurfaceNormalColor write FBtnSurfaceNormalColor; //<2F><>ť<EFBFBD><C5A5><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ
property BtnSurfaceDownColor:TColor read FBtnSurfaceDownColor write FBtnSurfaceDownColor; //<2F><><EFBFBD><EFBFBD><EFBFBD>ƶ<EFBFBD><C6B6><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʱ<EFBFBD><CAB1>ť<EFBFBD><C5A5><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ
property BtnSurfaceBottomLineColor:TColor read FBtnSurfaceBottomLineColor write FBtnSurfaceBottomLineColor; //<2F><><EFBFBD><EFBFBD>û<EFBFBD>а<EFBFBD><D0B0><EFBFBD>ʱ<EFBFBD>±<EFBFBD><C2B1><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ
property BtnSurfaceDownBottomLineColor:TColor read FBtnSurfaceDownBottomLineColor write FBtnSurfaceDownBottomLineColor; //<2F><><EFBFBD>갴<EFBFBD><EAB0B4>ʱ<EFBFBD>±<EFBFBD><C2B1><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ɫ
property RdoChkControlChkColor:TColor read FRdoChkControlChkColor write FRdoChkControlChkColor;
property ComboBoxChkColor:TColor read FComboBoxChkColor write FComboBoxChkColor;
property ComboboxSurfaceMoveColor:TColor read FComboboxSurfaceMoveColor write FComboboxSurfaceMoveColor;
property ControlDisabledBorderColor:TColor read FControlDisabledBorderColor write FControlDisabledBorderColor;
{*******************Tommstudio.com update********************}
end;
function GetShadeColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor;
function NewColor(ACanvas: TCanvas; clr: TColor; Value: integer): TColor;
procedure DimBitmap(ABitmap: TBitmap; Value: integer);
procedure DrawArrow(ACanvas: TCanvas; X, Y: integer);
function GrayColor(ACanvas: TCanvas; clr: TColor; Value: integer): 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);
{*******************Tommstudio.com update********************}
procedure DrawBtnSurface(ACanvas:TCanvas;Rect:TRect;Color:TColor);
procedure DrawBtnOuterLine(ACanvas:TCanvas;Rect:TRect;Color:TColor;BtnRoundArc:integer);
procedure DrawBtnInnerLine(ACanvas:TCanvas;Rect:TRect;Color:TColor;BtnRoundArc:integer);
procedure DrawBtnBottomLine(ACanvas:TCanvas;Rect:TRect;Color:TColor);
{*******************Tommstudio.com update********************}
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('XP', [TXPMenu]);
end;
{ TXPMenue }
constructor TXPMenu.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
////////////////////////
{*******************Tommstudio.com update********************}
SetControlUseTrueXPStyle(True);
FBtnRoundArc:=5;
{*******************Tommstudio.com update********************}
FFont := TFont.Create;
GetSystemMenuFont(FFont);
FForm := Owner as TScrollingWinControl;
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;
XPContainers := [xccForm, xccFrame, xccToolbar, xccCoolbar, xccControlbar, xccPanel,
xccScrollBox, xccGroupBox, xccTabSheet, xccPageScroller];
XPControls := [xcMainMenu, xcPopupMenu, xcToolbar, xcControlbar, xcCombo,
xcEdit, xcMaskEdit, xcMemo, xcRichEdit, xcCheckBox, xcRadioButton,
xcButton, xcBitBtn, xcSpeedButton, xcPanel, xcGroupBox];
if FActive then
begin
InitItems(FForm, true, false);
end;
end;
destructor TXPMenu.Destroy;
begin
InitItems(FForm, false, false);
FFont.Free;
inherited;
end;
{to check for new sub items}
procedure TXPMenu.ActivateMenuItem(MenuItem: TMenuItem);
procedure Activate(MenuItem: TMenuItem);
begin
if (MenuItem.Tag <> 999) then
if addr(MenuItem.OnDrawItem) <> addr(TXPMenu.DrawItem) then
begin
if (not assigned(MenuItem.OnDrawItem)) or (FOverrideOwnerDraw) then
MenuItem.OnDrawItem := DrawItem;
if (not assigned(MenuItem.OnMeasureItem)) or (FOverrideOwnerDraw) then
MenuItem.OnMeasureItem := MeasureItem;
end
end;
var
i, j: integer;
begin
Activate(MenuItem);
for i := 0 to MenuItem.Parent.Count -1 do
begin
Activate(MenuItem.Parent.Items[i]);
for j := 0 to MenuItem.Parent.Items[i].Count - 1 do
ActivateMenuItem(MenuItem.Parent.Items[i].Items[j]);
end;
end;
procedure TXPMenu.InitItems(wForm: TWinControl; Enable, Update: boolean );
procedure Activate(MenuItem: TMenuItem);
begin
if Enable then
begin
if (MenuItem.Tag <> 999) then
begin
if (not assigned(MenuItem.OnDrawItem)) or (FOverrideOwnerDraw) then
MenuItem.OnDrawItem := DrawItem;
if (not assigned(MenuItem.OnMeasureItem)) or (FOverrideOwnerDraw) then
MenuItem.OnMeasureItem := MeasureItem;
end;
end
else
begin
if addr(MenuItem.OnDrawItem) = addr(TXPMenu.DrawItem) then
MenuItem.OnDrawItem := nil;
if addr(MenuItem.OnMeasureItem) = addr(TXPMenu.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
ItrateMenu(MenuItem.Items[i]);
end;
var
i, x: integer;
Comp: TComponent;
begin
for i := 0 to wForm.ComponentCount - 1 do
begin
Comp := wForm.Components[i];
if (Comp is TMainMenu) and (xcMainMenu in 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;
end;
if (Comp is TPopupMenu) and (xcPopupMenu in XPControls) then
begin
for x := 0 to TPopupMenu(Comp).Items.Count - 1 do
begin
TPopupMenu(Comp).OwnerDraw := Enable;
Activate(TPopupMenu(Comp).Items[x]);
ItrateMenu(TPopupMenu(Comp).Items[x]);
end;
end;
{$IFDEF VER5U}
if (Comp is TToolBar) and (xcToolBar in FXPControls) 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 (FOverrideOwnerDraw) then
begin
TToolBar(Comp).OnCustomDrawButton :=
ToolBarDrawButton;
end;
end
else
begin
if addr(TToolBar(Comp).OnCustomDrawButton) =
addr(TXPMenu.ToolBarDrawButton) then
TToolBar(Comp).OnCustomDrawButton := nil;
end;
if Update then
TToolBar(Comp).Invalidate;
end;
{$ENDIF}
if (Comp is TControlBar) and (xcControlBar in FXPControls) then
if not (csDesigning in ComponentState) then
begin
if Enable then
begin
if (not assigned(TControlBar(Comp).OnBandPaint))
or (FOverrideOwnerDraw) then
begin
TControlBar(Comp).OnBandPaint := ControlBarPaint;
end;
end
else
begin
if addr(TControlBar(Comp).OnBandPaint) =
addr(TXPMenu.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 FXPControls)) or
((Comp is TCustomLabeledEdit) and (xcEdit in FXPControls)) or
{$ELSE}
((Comp is TCustomComboBox) and (xcCombo in FXPControls)) or
{$ENDIF}
((Comp is TEdit) and (xcEdit in FXPControls)) or
((Comp.ClassName = 'TMaskEdit') and (xcMaskEdit in FXPControls)) or
((Comp.ClassName = 'TDBEdit') and (xcMaskEdit in FXPControls)) or
((Comp is TCustomMemo) and (xcMemo in FXPControls)) or
((Comp is TCustomRichEdit) and (xcRichEdit in FXPControls)) or
((Comp is TCustomCheckBox) and (xcCheckBox in FXPControls)) or
((Comp is TRadioButton) and (xcRadioButton in FXPControls)) or
((Comp.ClassName = 'TBitBtn') and (xcBitBtn in FXPControls)) or
((Comp.ClassName = 'TButton') and (xcButton in FXPControls)) or
((Comp.ClassName = 'TUpDown') and (xcButton in FXPControls)) or
((Comp is TSpeedButton) and (xcSpeedButton in FXPControls)) or
((Comp is TCustomPanel) and (xcPanel in FXPControls)) or
((Comp is TCustomGroupBox) and (xcGroupBox in FXPControls))
then
if ((TControl(Comp).Parent is TToolbar) and (xccToolBar in FXPContainers))or
((TControl(Comp).Parent is TCoolbar) and (xccCoolbar in FXPContainers)) or
((TControl(Comp).Parent is TCustomPanel) and (xccPanel in FXPContainers)) or
((TControl(Comp).Parent is TControlbar) and (xccControlbar in FXPContainers)) or
((TControl(Comp).Parent is TScrollBox) and (xccScrollBox in FXPContainers)) or
((TControl(Comp).Parent is TCustomGroupBox) and (xccGroupBox in FXPContainers)) or
((TControl(Comp).Parent is TTabSheet) and (xccTabSheet in FXPContainers)) or
((TControl(Comp).Parent.ClassName = 'TdxTabSheet') and (xccTabSheet in FXPContainers)) or //DeveloperExpress
((TControl(Comp).Parent is TPageScroller) and (xccPageScroller in FXPContainers)) or
{$IFDEF VER5U}
((TControl(Comp).Parent is TCustomFrame) and (xccFrame in FXPContainers)) or
{$ENDIF}
((TControl(Comp).Parent.ClassName = 'TDBCtrlPanel') and (xccFrame in FXPContainers)) or
((TControl(Comp).Parent is TCustomForm) and (xccForm in FXPContainers))
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;
XPMenu := self;
if (Control is TCustomEdit) then
begin
FCtl3D := TEdit(Control).Ctl3D;
FBorderStyle := TRichEdit(Control).BorderStyle;
end;
end;
if Update then
begin
// if Comp is TWinControl then //Cause error with non wincontrol
TControl(Comp).invalidate //in TControlSubClass.ControlSubClass
// else
// TControl(Comp).Update;
end;
end;
// Recursive call for possible containers.
{$IFDEF VER5U}
if ((Comp is TCustomFrame) and (xccFrame in FXPContainers))
or (Comp is TCustomForm) then //By Geir Wikran <gwikran@online.no>
self.InitItems(Comp as TWinControl, Enable, Update);
{$ENDIF}
end;
end;
procedure TXPMenu.DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
Selected: Boolean);
begin
if FActive then
MenueDrawItem(Sender, ACanvas, ARect, Selected);
end;
function TXPMenu.GetImageExtent(MenuItem: TMenuItem): TPoint;
var
HasImgLstBitmap: boolean;
B: TBitmap;
FTopMenu: boolean;
begin
FTopMenu := false;
B := TBitmap.Create;
B.Width := 0;
B.Height := 0;
Result.x := 0;
Result.Y := 0;
HasImgLstBitmap := false;
{Changes MMK TForm and TFrame}
if (FForm is TForm) and ((FForm as TForm).Menu <> nil) then
if MenuItem.GetParentComponent.Name = (FForm as TForm).Menu.Name then
begin
FTopMenu := true;
if (FForm as TForm).Menu.Images <> nil then
if MenuItem.ImageIndex <> -1 then
HasImgLstBitmap := true;
end;
{End Changes}
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 FTopMenu then
if Result.x < FIconWidth then
Result.x := FIconWidth;
B.Free;
end;
procedure TXPMenu.MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
var
s: string;
W, H: integer;
P: TPoint;
IsLine: boolean;
OSVersionInfo: TOSVersionInfo;
begin
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(FFont);
W := ACanvas.TextWidth(s);
Inc(W, 5);
if pos('&', s) > 0 then
W := W - ACanvas.TextWidth('&');
P := GetImageExtent(TMenuItem(Sender));
if P.X > 0 then
W := W + P.x ;
//Add 8 pixels for win2k
if (FForm is TForm) and ((FForm as TForm).Menu <> nil) then
if TMenuItem(Sender).GetParentComponent.Name = (FForm as TForm).Menu.Name then
begin //FTopMenu := true;
GetVersionEx(OSVersionInfo);
if OSVersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then
Inc(W, 8);
end;
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 TXPMenu.MenueDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
Selected: Boolean);
var
txt: string;
B: TBitmap;
IconRect, TextRect, CheckedRect: TRect;
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;
begin
FTopMenu := false;
FMenuItem := TMenuItem(Sender);
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;
break;
end;
ACanvas.Font.Assign(FFont);
Inc(ARect.Bottom, 1);
TextRect := ARect;
txt := ' ' + FMenuItem.Caption;
B := TBitmap.Create;
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;
B.Canvas.CopyRect (Rect(0, 0, B.Width, B.Height), FMenuItem.Bitmap.Canvas,
Rect(0, 0, B.Width, B.Height));
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 := ACanvas.Brush.Color;
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 := ACanvas.Pixels[2,2];
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 - FIconWidth;
X2 := ARect.Right;
end
else
begin
X1 := ARect.Left;
X2 := ARect.Left + FIconWidth;
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 > FIconWidth 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, FIconWidth)
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, FIconWidth)
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);
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
ACanvas.brush.color := FFMenuBarColor;
ACanvas.Pen.Color := FFMenuBarColor;
ACanvas.FillRect(ARect);
end
else
begin
if (Is16Bit and FGradient) 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(ARect);
ACanvas.brush.color := FFIconBackColor;
ACanvas.FillRect(IconRect);
end;
//------------
end;
if FMenuItem.Enabled then
ACanvas.Font.Color := FFont.Color
else
ACanvas.Font.Color := FDisabledColor;
if Selected and FDrawSelect then
begin
ACanvas.brush.Style := bsSolid;
if FTopMenu then
begin
DrawTopMenuItem(FMenuItem, ACanvas, ARect, FMenuBarColor, FMenu.IsRightToLeft);
end
else
if FMenuItem.Enabled then
begin
Inc(ARect.Top, 1);
Dec(ARect.Bottom, 1);
if FFlatMenu 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 FFlatMenu then
Inc(ARect.Right, 1);
end;
end;
DrawCheckedItem(FMenuItem, Selected, FMenuItem.Enabled, HasImgLstBitmap or HasBitmap,
ACanvas, CheckedRect);
DrawIcon(FMenuItem, ACanvas, B, IconRect,
Selected, 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;
DrawTheText(FMenuItem, txt, ShortCutToText(FMenuItem.ShortCut),
ACanvas, TextRect,
Selected, FMenuItem.Enabled, FMenuItem.Default,
FTopMenu, FMenu.IsRightToLeft, FFont, TextFormat);
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;
B.free;
if not (csDesigning in ComponentState) then
begin
if (FFlatMenu) and (not FTopMenu) then
begin
hDcM := ACanvas.Handle;
hWndM := WindowFromDC(hDcM);
if hWndM <> FForm.Handle then
begin
DrawWindowBorder(hWndM, FMenu.IsRightToLeft);
end;
end;
end;
//-----
ActivateMenuItem(FMenuItem); // check for new sub items
end;
{$IFDEF VER5U}
procedure TXPMenu.ToolBarDrawButton(Sender: TToolBar;
Button: TToolButton; State: TCustomDrawState; var DefaultDraw: Boolean);
var
ACanvas: TCanvas;
ARect, HPreviousRect: 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;
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 := HPreviousRect;
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 (Is16Bit) and (not UseSystemColors) then
FBSelectColor := NewColor(ACanvas, FSelectColor, 68)
else
FBSelectColor := FFSelectColor;
HPreviousRect := Button.BoundsRect;
ARect := HPreviousRect;
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 := HPreviousRect;
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 := ACanvas.Brush.Color;
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 := HPreviousRect;
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" <dan@laserformsinc.com>
Inc(ARect.Left, BitmapWidth + 0{6});
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;
DrawTheText(Button, Button.Caption, '',
ACanvas, ARect,
(cdsSelected in State), Button.Enabled, false,
(Button.MenuItem <> nil),
(Button.BidiMode = bdRightToLeft), FFont, TextFormat);
ARect := HPreviousRect;
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 XPControls) 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 TXPMenu.ControlBarPaint(Sender: TObject; Control: TControl;
Canvas: TCanvas; var ARect: TRect; var Options: TBandPaintOptions);
var
i: Integer;
intInc: integer;
begin
SetGlobalColor(Canvas);
// 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 TXPMenu.SetGlobalColor(ACanvas: TCanvas);
begin
//-----
if GetDeviceCaps(ACanvas.Handle, BITSPIXEL) < 16 then
Is16Bit := false
else
Is16Bit := true;
FFColor := FColor;
FFIconBackColor := FIconBackColor;
if Is16Bit then
begin
FFSelectColor := NewColor(ACanvas, FSelectColor, 68);
FCheckedAreaColor := NewColor(ACanvas, FSelectColor, 80);
FCheckedAreaSelectColor := NewColor(ACanvas, FSelectColor, 50);
FMenuBorderColor := GetShadeColor(ACanvas, clBtnFace, 90);
FMenuShadowColor := GetShadeColor(ACanvas, clBtnFace, 76);
end
else
begin
FFSelectColor := FSelectColor;
FCheckedAreaColor := clWhite;
FCheckedAreaSelectColor := clSilver;
FMenuBorderColor := clBtnShadow;
FMenuShadowColor := clBtnShadow;
end;
FFSelectBorderColor := FSelectBorderColor;
FFSelectFontColor := FSelectFontColor;
FFMenuBarColor := FMenuBarColor;
FFDisabledColor := FDisabledColor;
FFCheckedColor := FCheckedColor;
FFSeparatorColor := FSeparatorColor;
if FUseSystemColors then
begin
GetSystemMenuFont(FFont);
FFSelectFontColor := FFont.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 TXPMenu.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);
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 TXPMenu.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);
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 TXPMenu.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
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;
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.color := DefColor;
DrawtextEx(B.Canvas.Handle,
PChar(txt),
Length(txt),
BRect, TextFormat + DT_VCENTER, nil);
ACanvas.CopyRect(TextRect, B.Canvas, BRect);
B.Free;
exit;
end;
end;
if (TopMenu and Selected) then
if FUseSystemColors then
DefColor := TopMenuFontColor(ACanvas, FFIconBackColor);
ACanvas.Font.color := DefColor; // will not affect Buttons
TextRect.Top := TextRect.Top +
((TextRect.Bottom - TextRect.Top) - ACanvas.TextHeight('W')) div 2;
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 TXPMenu.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 FIconWidth > B.Width then
X := X + ((FIconWidth - 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 (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, FDimLevel{30});
if not Enabled then
begin
GrayBitmap(B, FGrayLevel );
DimBitmap(B, 40);
end;
if (Hot) and (Enabled) and (not Checked) then
begin
if (Is16Bit) and (not UseSystemColors) and (Sender is TToolButton) then
DefColor := NewColor(ACanvas, FSelectColor, 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 TXPMenu.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 := FFont.Color
else
Result := NewColor(ACanvas, Color, 90);
end;
procedure TXPMenu.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 <> nil) and (TForm(FForm).Menu <> nil) then
Windows.DrawMenuBar(FForm.Handle);
end;
procedure TXPMenu.SetAutoDetect(const Value: boolean);
begin
FAutoDetect := Value;
end;
procedure TXPMenu.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;
procedure TXPMenu.SetFont(const Value: TFont);
begin
FFont.Assign(Value);
Windows.DrawMenuBar(FForm.Handle);
end;
procedure TXPMenu.SetColor(const Value: TColor);
begin
FColor := Value;
end;
procedure TXPMenu.SetIconBackColor(const Value: TColor);
begin
FIconBackColor := Value;
end;
procedure TXPMenu.SetMenuBarColor(const Value: TColor);
begin
FMenuBarColor := Value;
Windows.DrawMenuBar(FForm.Handle);
end;
procedure TXPMenu.SetCheckedColor(const Value: TColor);
begin
FCheckedColor := Value;
end;
procedure TXPMenu.SetSeparatorColor(const Value: TColor);
begin
FSeparatorColor := Value;
end;
procedure TXPMenu.SetSelectBorderColor(const Value: TColor);
begin
FSelectBorderColor := Value;
end;
procedure TXPMenu.SetSelectColor(const Value: TColor);
begin
FSelectColor := Value;
end;
procedure TXPMenu.SetDisabledColor(const Value: TColor);
begin
FDisabledColor := Value;
end;
procedure TXPMenu.SetSelectFontColor(const Value: TColor);
begin
FSelectFontColor := Value;
end;
procedure TXPMenu.SetIconWidth(const Value: integer);
begin
FIconWidth := Value;
end;
procedure TXPMenu.SetDrawSelect(const Value: boolean);
begin
FDrawSelect := Value;
end;
procedure TXPMenu.SetOverrideOwnerDraw(const Value: boolean);
begin
FOverrideOwnerDraw := Value;
if FActive then
Active := True;
end;
procedure TXPMenu.SetUseSystemColors(const Value: boolean);
begin
FUseSystemColors := Value;
Windows.DrawMenuBar(FForm.Handle);
end;
procedure TXPMenu.SetGradient(const Value: boolean);
begin
FGradient := Value;
end;
procedure TXPMenu.SetFlatMenu(const Value: boolean);
begin
FFlatMenu := Value;
end;
procedure TXPMenu.SetXPContainers(const Value: TXPContainers);
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 TXPMenu.SetXPControls(const Value: TXPControls);
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 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;
//if Font.Name = 'MS Sans Serif' then
//begin
// Font.Name := 'Tahoma';
// Font.Charset := DEFAULT_CHARSET;
//end;
end;
end;
procedure TXPMenu.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 - FIconWidth + 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 + FIconWidth + 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;
procedure TXPMenu.DrawWindowBorder(hWnd: HWND; IsRightToLeft: boolean);
var
WRect: TRect;
dCanvas: TCanvas;
begin
if hWnd <= 0 then
begin
exit;
end;
dCanvas := nil;
try
dCanvas := TCanvas.Create;
dCanvas.Handle := GetWindowDC(GetDesktopWindow);
GetWindowRect(hWnd, WRect);
dCanvas.Brush.Style := bsClear;
Dec(WRect.Right, 2);
Dec(WRect.Bottom, 2);
dCanvas.Pen.Color := FMenuBorderColor;
dCanvas.Rectangle(WRect.Left, WRect.Top, WRect.Right, WRect.Bottom);
if IsRightToLeft then
begin
dCanvas.Pen.Color := FFColor;
dCanvas.Rectangle(WRect.Left + 1, WRect.Top + 1, WRect.Right - 2,
WRect.Top + 3);
dCanvas.MoveTo(WRect.Left + 2, WRect.Top + 2);
dCanvas.LineTo(WRect.Left + 2, WRect.Bottom - 2);
dCanvas.Pen.Color := FFIconBackColor;
dCanvas.MoveTo(WRect.Right - 2, WRect.Top + 2);
dCanvas.LineTo(WRect.Right - 2, WRect.Bottom - 2);
dCanvas.MoveTo(WRect.Right - 2, WRect.Top + 2);
dCanvas.LineTo(WRect.Right - 1 - FIconWidth, WRect.Top + 2);
end
else
begin
if not FGradient then
begin
dCanvas.Pen.Color := FFColor;
dCanvas.Rectangle(WRect.Left + 1, WRect.Top + 1, WRect.Right - 1,
WRect.Top + 3);
dCanvas.Pen.Color := FFIconBackColor;
dCanvas.MoveTo(WRect.Left + 1, WRect.Top + 2);
dCanvas.LineTo(WRect.Left + 3 + FIconWidth, WRect.Top + 2);
end
else
DrawGradient(dCanvas, Rect(WRect.Left + 1, WRect.Top + 1,
WRect.Right - 3, WRect.Top + 3), IsRightToLeft);
dCanvas.Pen.Color := FFIconBackColor;
dCanvas.Rectangle(WRect.Left + 1, WRect.Top + 2,
WRect.Left + 3, WRect.Bottom - 1)
end;
Inc(WRect.Right, 2);
Inc(WRect.Bottom, 2);
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);
dCanvas.Pen.Color := clBtnFace ;
dCanvas.Rectangle(WRect.Left, WRect.Bottom - 2, WRect.Left + 2, WRect.Bottom);
dCanvas.Rectangle(WRect.Right - 2, WRect.Top, WRect.Right, WRect.Top + 2);
finally
ReleaseDC(GetDesktopWindow, dCanvas.Handle);
dCanvas.Free;
end;
end;
procedure TXPMenu.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if not FActive then exit;
if not FAutoDetect then exit;
if (Operation = opInsert) and
((AComponent is TMenuItem) or (AComponent is TToolButton) or
(AComponent is TControlBar)) then
begin
if not (csDesigning in ComponentState) then Active := true;
//else
//if ComponentState = [] then
// Active := true ;
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 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 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;
{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 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)) then
Message.Result := 1
else
//try //: "Marcus Paulo Tavares" <marcuspt@terra.com.br>
orgWindowProc(Message);
//except
//end;
if (not XPMenu.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 is TGraphicControl then
Control.Repaint;
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
Control.WindowProc := orgWindowProc;
Free;
except
end;
FBuilding := false;
end;
Exit;
end;
WM_PAINT:
begin
FBuilding := false;
PaintControlXP;
end;
CM_MOUSEENTER:
if TControl(Control).Enabled then
begin
FmouseInControl := true;
if Control is TGraphicControl then
begin
Control.Repaint;
exit;
end;
PaintControlXP;
end;
CM_MOUSELEAVE:
if TControl(Control).Enabled then
begin
FmouseInControl := false;
if Control is TGraphicControl then
begin
Control.Repaint;
exit;
end;
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,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:
PaintControlXP; // button
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.Tag<0 then exit;
If Control is TWinControl then
FIsFocused := TWinControl(Control).Focused
else
FIsFocused := false;
{$IFDEF VER140}
if (Control is TCustomCombo) then
PaintCombo;
{$ELSE}
if (Control is TCustomComboBox) then
PaintCombo;
{$ENDIF}
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;
end;
procedure TControlSubClass.PaintCombo;
var
C: TControlCanvas;
R: TRect;
SelectColor, BorderColor, ArrowColor: TColor;
X,Y: integer;
TempRect:TRect;
begin
C := nil;
try
C := TControlCanvas.Create;
C.Control := Control;
XPMenu.SetGlobalColor(C);
if Control.Enabled then ArrowColor := clBlack else ArrowColor := clWhite;
if (FmouseinControl) then begin
borderColor := XPMenu.FFSelectBorderColor;
SelectColor := XPMenu.FFSelectColor;
end else begin
borderColor := TComboBox(Control).Color;
selectColor := clBtnFace;
end;
if (not FmouseinControl) and (FIsFocused) then begin
borderColor := NewColor(C, XPMenu.FFSelectBorderColor,60);
SelectColor := XPMenu.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 begin
//***************************Tommstudio.com Update*********************
if (not XpMenu.FControlUseTrueXPStyle) or (Control.Tag=1234567890) then
//***************************Tommstudio.com Update*********************
InflateRect(R, 1, 1);
end;
C.Brush.Color := TComboBox(Control).Color;;
C.FrameRect(R);
Inc(R.Bottom,1);
C.Brush.Color := BorderColor;
//***************************Tommstudio.com Update*********************
if (XpMenu.FControlUseTrueXPStyle) and (Control.Tag<>1234567890) then begin // tag=1234567890<39><30>ʾ<EFBFBD><CABE>ʹ<EFBFBD><CAB9>xp<78><70><EFBFBD><EFBFBD>
if Control.Enabled then
C.Brush.Color:=XpMenu.FBtnOutLineBorderColor//XpMenu.FBtnInnerBorderFocusColor;
else C.Pen.Color:=XpMenu.FControlDisabledBorderColor;
end;
//***************************Tommstudio.com Update*********************
C.FrameRect(R);
{$IFDEF VER6U}
if TCustomCombo(Control).DroppedDown then
{$ELSE}
if TCustomComboBox(Control).DroppedDown then
{$ENDIF}
begin
BorderColor := XPMenu.FFSelectBorderColor;
ArrowColor := clWhite;
SelectColor := XPMenu.FCheckedAreaSelectColor ;
end;
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
//***************************Tommstudio.com Update*********************
if (XpMenu.FControlUseTrueXPStyle) and (Control.Tag<>1234567890) then begin // tag=1234567890<39><30>ʾ<EFBFBD><CABE>ʹ<EFBFBD><CAB9>xp<78><70><EFBFBD><EFBFBD>
//***************************Tommstudio.com Update*********************
end else begin
if Control.BiDiMode = bdRightToLeft then
Inc(R.Right, 2)
else Dec(R.Left, 1);
end;
end;
C.Brush.Color := SelectColor;
//***************************Tommstudio.com Update*********************
if (XpMenu.FControlUseTrueXPStyle) and (Control.Tag<>1234567890) then begin // tag=1234567890<39><30>ʾ<EFBFBD><CABE>ʹ<EFBFBD><CAB9>xp<78><70><EFBFBD><EFBFBD>
C.Brush.Color:=XpMenu.FBtnSurfaceNormalColor;
C.FillRect(R);
if FLButtonBressed then C.Brush.Color:=XpMenu.FBtnSurfaceDownColor else
C.Brush.Color:=XpMenu.FBtnInnerBorderFocusColor;
if FMouseInControl then C.Brush.Color:=XpMenu.FComboboxSurfaceMoveColor;
{$IFDEF VER6U}
if TCustomCombo(Control).DroppedDown then
{$ELSE}
if TCustomComboBox(Control).DroppedDown then
{$ENDIF}
C.Brush.Color:=Xpmenu.FComboboxSurfaceDownColor;
TempRect:=R;
TempRect.Left:=R.Left+1;
TempRect.Top:=R.Top+1;
TempRect.Right:=R.Right-1;
TempRect.Bottom:=R.Bottom-1;
C.FillRect(TempRect);
TempRect:=R;
end else
//***************************Tommstudio.com Update*********************
C.FillRect(R);
//***************************Tommstudio.com Update*********************
if (not XpMenu.FControlUseTrueXPStyle) or (Control.Tag=1234567890) then begin
//***************************Tommstudio.com Update*********************
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;
end;
C.Pen.Color := arrowColor;
R := Control.ClientRect;
if Control.BiDiMode = bdRightToLeft then
X := R.Left + 5
else X := R.Right - 10;
//***************************Tommstudio.com Update*********************
if (XpMenu.FControlUseTrueXPStyle) and (Control.Tag<>1234567890) then begin // tag=1234567890<39><30>ʾ<EFBFBD><CABE>ʹ<EFBFBD><CAB9>xp<78><70><EFBFBD><EFBFBD>
C.Pen.Width:=2;
C.Pen.Color:=XpMenu.FComboBoxChkColor;
X:=TempRect.Left+(TempRect.Right-TempRect.Left-8) div 2;
Y:=TempRect.Top+(TempRect.Bottom-TempRect.Top-4) div 2;
C.MoveTo(x,y);
C.LineTo(x+4,y+4);
C.LineTo(X+8,Y);
end else begin
//***************************Tommstudio.com Update*********************
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.PaintEdit;
var
C: TControlCanvas;
R: TRect;
BorderColor: TColor;
//TempRect: TRect;
begin
C := nil;
try
C := TControlCanvas.Create;
C.Control := Control;
XPMenu.SetGlobalColor(C);
if TEdit(Control).Ctl3D <> false then
begin
FBuilding := true;
TEdit(Control).Ctl3D := false;
end;
if (FmouseinControl) or (FIsFocused) then
begin
if FBorderStyle = bsSingle then
borderColor := NewColor(C, XPMenu.FFSelectBorderColor, 60)
else
borderColor := NewColor(C, XPMenu.FFSelectBorderColor, 80);
end
else
begin
if FBorderStyle = bsSingle then
borderColor := GetShadeColor(C, Control.Parent.Brush.Color, 60)
else
borderColor := Control.Parent.Brush.Color;
end;
R := Control.ClientRect;
//***************************Tommstudio.com Update*********************
if (XpMenu.FControlUseTrueXPStyle) and (Control.Tag<>1234567890) then begin //tag=1234567890ʱ<30><CAB1><EFBFBD><EFBFBD>ʾxpЧ<70><D0A7>
TEdit(Control).Color:=XpMenu.FBtnSurfaceNormalColor;
if Control.Enabled then
C.Pen.Color:=XpMenu.FBtnOutLineBorderColor
else
C.Pen.Color:=XpMenu.FControlDisabledBorderColor;
end;
//***************************Tommstudio.com Update*********************
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
//***************************Tommstudio.com Update*********************
if (XpMenu.FControlUseTrueXPStyle) and (Control.Tag<>1234567890) then begin //tag=1234567890ʱ<30><CAB1><EFBFBD><EFBFBD>ʾxpЧ<70><D0A7>
TRichEdit(Control).Color:=XpMenu.FBtnSurfaceNormalColor;
end;
//***************************Tommstudio.com Update*********************
C := nil;
try
C := TControlCanvas.Create;
C.Control := Control.Parent;
XPMenu.SetGlobalColor(C);
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, XPMenu.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;
TempRect:TRect;
begin
C := nil;
try
C := TControlCanvas.Create;
C.Control := Control;
XPMenu.SetGlobalColor(C);
if FMouseInControl then begin
SelectColor := XPMenu.FFSelectColor;
BorderColor := xpMenu.FFSelectBorderColor;
end else begin
SelectColor := clWindow;
BorderColor := clBtnShadow;
end;
if (FIsFocused) then begin
SelectColor := XPMenu.FFSelectColor;
BorderColor := xpMenu.FFSelectBorderColor;
end;
if (FBressed) or (FLButtonBressed ) then SelectColor := XPMenu.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;
//***************************Tommstudio.com Update*********************
if (XpMenu.FControlUseTrueXPStyle) and (Control.Tag<>1234567890) then begin //tag=1234567890ʱ<30><CAB1><EFBFBD><EFBFBD>ʾxpЧ<70><D0A7>
R.Right:=R.Right+1;
R.Bottom:=R.Bottom;
end;
//***************************Tommstudio.com Update*********************
C.Brush.Color := TCheckBox(Control).Color;
C.FillRect(R);
InflateRect(R, -2, -2);
C.Brush.Color := SelectColor;
C.Pen.Color := BorderColor;
//***************************Tommstudio.com Update*********************
if (XpMenu.FControlUseTrueXPStyle) and (Control.Tag<>1234567890) then begin //tag=1234567890ʱ<30><CAB1><EFBFBD><EFBFBD>ʾxpЧ<70><D0A7>
if not FLButtonBressed then begin
C.Brush.Color:=XpMenu.FBtnSurfaceNormalColor;
if Control.Enabled then
C.Pen.Color:=XpMenu.FBtnOutLineBorderColor
else C.Pen.Color:=XpMenu.FControlDisabledBorderColor;
end else begin
C.Brush.Color:=XpMenu.FBtnSurfaceDownColor;
C.Pen.Color:=XpMenu.FBtnOutLineBorderColor;
end;
end;
//***************************Tommstudio.com Update*********************
C.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
//***************************Tommstudio.com Update*********************
if (XpMenu.FControlUseTrueXPStyle) and (Control.Tag<>1234567890) then begin //tag=1234567890ʱ<30><CAB1><EFBFBD><EFBFBD>ʾxpЧ<70><D0A7>
if FMouseInControl then begin
TempRect.Left:=R.Left+1;
TempRect.Top:=R.Top+1;
TempRect.Right:=R.Right-1;
TempRect.Bottom:=R.Bottom-1;
C.Pen.Color:=XpMenu.FBtnInnerBorderMoveColor;
C.Rectangle(TempRect);
end;
end;
//***************************Tommstudio.com Update*********************
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 := xpMenu.FFDisabledColor;
//***************************Tommstudio.com Update*********************
if (XpMenu.FControlUseTrueXPStyle) and (Control.Tag<>1234567890) then begin //tag=1234567890ʱ<30><CAB1><EFBFBD><EFBFBD>ʾxpЧ<70><D0A7>
C.Pen.Color:=XpMenu.FRdoChkControlChkColor;
R.Left:=R.Left+1;
end;
if (TCheckBox(Control).State = cbGrayed) then begin
TempRect.Left:=R.Left+2;
TempRect.Top:=R.Top+3;
TempRect.Right:=R.Right-3;
TempRect.Bottom:=R.Bottom-3;
C.Brush.Color:=XpMenu.FRdoChkControlChkColor;
C.FillRect(TempRect);
end;
if (TCheckBox(Control).State = cbChecked) then
//***************************Tommstudio.com Update*********************
DrawCheckMark(C, R.Left, R.Bottom )
end;
finally
C.Free;
end;
end;
procedure TControlSubClass.PaintRadio;
var
C: TControlCanvas;
R: TRect;
SelectColor, BorderColor: TColor;
//***************************Tommstudio.com Update*********************
// ParentColor: TColor;
TempRect: TRect;
//***************************Tommstudio.com Update*********************
begin
C := nil;
try
C := TControlCanvas.Create;
C.Control := Control;
XPMenu.SetGlobalColor(C);
if FMouseInControl then begin
SelectColor :=XPMenu.FFSelectColor;
BorderColor :=xpMenu.FFSelectBorderColor;;
end else begin
SelectColor := clWindow;
BorderColor := clBtnShadow;
end;
if (FIsFocused) then SelectColor := XPMenu.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;
//***************************Tommstudio.com Update*********************
if (XpMenu.FControlUseTrueXPStyle) and (Control.Tag<>1234567890) then begin //tag=1234567890ʱ<30><CAB1><EFBFBD><EFBFBD>ʾxpЧ<70><D0A7>
R.Right:=R.Right+2;
R.Bottom:=R.Bottom+2;
end;
//***************************Tommstudio.com Update*********************
C.Brush.Color := TCheckBox(Control).Color;
C.FillRect(R);
InflateRect(R, -2, -2);
//***************************Tommstudio.com Update*********************
C.Brush.Style:=bsSolid;
if (XpMenu.FControlUseTrueXPStyle) and (Control.Tag<>1234567890) then begin //tag=1234567890ʱ<30><CAB1><EFBFBD><EFBFBD>ʾxpЧ<70><D0A7>
if not FLButtonBressed then begin
C.Brush.Color:=XpMenu.FBtnSurfaceNormalColor;
if Control.Enabled then C.Pen.Color:=XpMenu.FBtnOutLineBorderColor
else C.Pen.Color:=Xpmenu.FControlDisabledBorderColor;
end else begin
C.Brush.Color:=XpMenu.FBtnSurfaceDownColor;
C.Pen.Color:=XpMenu.FBtnOutLineBorderColor;
end;
end else begin
//***************************Tommstudio.com Update*********************
C.Brush.Color := SelectColor;
C.Pen.Color := BorderColor;
//begin***************************Tommstudio.com Update*********************
end;
//end***************************Tommstudio.com Update*********************
C.Ellipse(R.Left, R.Top, R.Right, R.Bottom);
//begin***************************Tommstudio.com Update*********************
if (XpMenu.FControlUseTrueXPStyle) and (Control.Tag<>1234567890) and (FMouseInControl) then begin //tag=1234567890ʱ<30><CAB1><EFBFBD><EFBFBD>ʾxpЧ<70><D0A7>
TempRect.Left:=R.Left+1;
TempRect.Top:=R.Top+1;
TempRect.Right:=R.Right-1;
TempRect.Bottom:=R.Bottom-1;
C.Brush.Style:=bsClear;
C.Pen.Color:=XpMenu.FBtnInnerBorderMoveColor;
C.Ellipse(TempRect.Left,TempRect.Top,TempRect.Right,TempRect.Bottom);
end;
//end***************************Tommstudio.com Update*********************
if TRadioButton(Control).Checked then begin
InflateRect(R, -2, -2);
//***************************Tommstudio.com Update*********************
if (XpMenu.FControlUseTrueXPStyle) and (Control.Tag<>1234567890) then begin //tag=1234567890ʱ<30><CAB1><EFBFBD><EFBFBD>ʾxpЧ<70><D0A7>
InflateRect(R,-2,-2);
C.Pen.Color:=XpMenu.FRdoChkControlChkColor;
C.Brush.Color:=C.Pen.Color;
end else begin
//***************************Tommstudio.com Update*********************
if Control.Enabled then C.Brush.Color := clHighlight else C.Brush.color := xpMenu.FFDisabledColor;
C.Pen.Color := C.Brush.Color;
end;
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, TWidth: integer;
TextFormat: integer;
//***************************Tommstudio.com Update*********************
ParentColor:TColor;
TempRect:TRect;
//***************************Tommstudio.com Update*********************
begin
C := nil;
//***************************Tommstudio.com Update*********************
ParentColor:=Control.Parent.Brush.Color;
//***************************Tommstudio.com Update*********************
try
C := TControlCanvas.Create;
C.Control := Control;
XPMenu.SetGlobalColor(C);
if (FMouseInControl or FBressed) then begin
SelectColor := NewColor(C, clBtnFace, 60);
BorderColor := NewColor(C, XPMenu.FFSelectBorderColor,60);
end else begin
SelectColor := XPMenu.FFIconBackColor;
BorderColor := clBtnShadow;
end;
if (not FmouseinControl) and (FIsFocused) then begin
BorderColor := NewColor(C, XPMenu.FFSelectBorderColor,60);
end;
TextFormat := 0;
R := Control.ClientRect;
CWidth := (R.Right - R.Left);
//***************************Tommstudio.com Update*********************
C.Brush.Style:=bsSolid;
//***************************Tommstudio.com Update*********************
C.Brush.Color := Control.Parent.Brush.Color;
C.FillRect(R);
C.Brush.Color := SelectColor;
C.Pen.Color := NewColor(C, BorderColor, 30);
//***************************Tommstudio.com Update*********************
if (XpMenu.FControlUseTrueXPStyle) and (Control.Tag<>1234567890) then begin //tag=1234567890ʱ<30><CAB1><EFBFBD><EFBFBD>ʾxpЧ<70><D0A7>
DrawBtnSurface(C,R,ParentColor);
C.Brush.Style:=bsSolid;
C.Brush.Color:= XpMenu.FBtnSurfaceNormalColor;
DrawBtnOuterLine(C,R,C.Pen.Color,XpMenu.FBtnRoundArc);
C.Brush.Style:=bsClear;
if Control.Enabled then
DrawBtnOuterLine(C,R,XpMenu.FBtnOutLineBorderColor,XpMenu.FBtnRoundArc)
else C.Pen.Color:=XpMenu.FControlDisabledBorderColor;
DrawBtnBottomLine(C,Rect(R.Left+Xpmenu.FBtnRoundArc,R.Bottom-2,R.Right-Xpmenu.FBtnRoundArc,R.Bottom-2),XpMenu.FBtnSurfaceBottomLineColor);
end
//***************************Tommstudio.com Update*********************
else C.RoundRect(R.Left, R.Top, R.Right, R.Bottom, XpMenu.FBtnRoundArc, XpMenu.FBtnRoundArc);
if TControl(Control).Enabled then begin
//***************************Tommstudio.com Update*********************
if (XpMenu.FControlUseTrueXPStyle) and (Control.Tag<>1234567890) then begin //tag=1234567890ʱ<30><CAB1><EFBFBD><EFBFBD>ʾxpЧ<70><D0A7>
if FIsFocused and (not FMouseInControl) and (not FLButtonBressed) and (not FBressed) then begin
TempRect:=R;
TempRect.Left:=R.Left+1;
TempRect.Top:=R.Top+1;
TempRect.Right:=R.Right-1;
TempRect.Bottom:=R.Bottom-1;
DrawBtnInnerLine(C,TempRect,XpMenu.FBtnInnerBorderFocusColor,XpMenu.FBtnRoundArc div 2 );
TempRect.Bottom:=R.Bottom-2;
DrawBtnInnerLine(C,TempRect,XpMenu.FBtnInnerBorderFocusColor+$020202,XpMenu.FBtnRoundArc div 2);
end;
if (FMouseInControl) and (not FLButtonBressed) and (not FBressed) then begin
TempRect:=R;
TempRect.Left:=R.Left+1;
TempRect.Top:=R.Top+1;
TempRect.Right:=R.Right-1;
TempRect.Bottom:=R.Bottom-1;
DrawBtnInnerLine(C,TempRect,XpMenu.FBtnInnerBorderMoveColor,XpMenu.FBtnRoundArc div 2);
TempRect.Bottom:=R.Bottom-2;
DrawBtnInnerLine(C,TempRect,XpMenu.FBtnInnerBorderMoveColor+$020200,XpMenu.FBtnRoundArc div 2);
end;
if FLButtonBressed or FBressed then begin
C.Brush.Style:=bsSolid;
C.Brush.Color:= XpMenu.FBtnSurfaceDownColor;
DrawBtnOuterLine(C,R,XpMenu.FBtnOutLineBorderColor,XpMenu.FBtnRoundArc);
DrawBtnBottomLine(C,Rect(R.Left+XpMenu.FBtnRoundArc,R.Bottom-2,R.Right-XpMenu.FBtnRoundArc,R.Bottom-2),XpMenu.FBtnSurfaceDownBottomLineColor);
end;
end else begin //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Dz<EFBFBD><C7B2><EFBFBD>truexpcolor<6F><72><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
//***************************Tommstudio.com Update*********************
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; //if usetruexp
end;
Txt := TButton(Control).Caption;
TextRect := R;
TxtFont := TButton(Control).Font;
C.Font.Assign (TxtFont);
TWidth := C.TextWidth(Txt);
TextRect.Left := (CWidth - TWidth) div 2;
if TButton(Control).IsRightToLeft then
TextFormat := DT_RTLREADING;
XPMenu.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;
BLayout: TButtonLayout;
TextFormat: integer;
FDown, FFlat, FTransparent: boolean;
FLayout: TButtonLayout;
//***************************Tommstudio.com Update*********************
ParentColor:TColor;
TempRect:TRect;
//***************************Tommstudio.com Update*********************
begin
C := nil;
//***************************Tommstudio.com Update*********************
ParentColor:=Control.Parent.Brush.Color;
//***************************Tommstudio.com Update*********************
try
C := TControlCanvas.Create;
C.Control := Control;
XPMenu.SetGlobalColor(C);
FDown := TSpeedButton(Control).Down;
FFlat := TSpeedButton(Control).Flat;
FTransparent := TSpeedButton(Control).Transparent;
NumGlyphs := TSpeedButton(Control).NumGlyphs;
if (FMouseInControl) then begin
SelectColor := xpMenu.FFSelectColor ;
BorderColor := xpMenu.FFSelectBorderColor;
end else begin
SelectColor := XPMenu.FFIconBackColor;
BorderColor := clBtnShadow;
end;
if FDown then begin
SelectColor := XPMenu.FCheckedAreaColor;
BorderColor := xpMenu.FFSelectBorderColor;
end;
if FDown and FMouseInControl then begin
SelectColor := XPMenu.FCheckedAreaSelectColor;
BorderColor := xpMenu.FFSelectBorderColor;
end;
if not TControl(Control).Enabled then
BorderColor := clBtnShadow;
TextFormat := 0;
R := Control.ClientRect;
//***************************Tommstudio.com Update*********************
C.Brush.Style:=bsSolid;
//***************************Tommstudio.com Update*********************
CWidth := (R.Right - R.Left);
CHeight := (R.Bottom - R.Top);
if (FDown or FMouseInControl) and FTransparent then begin
BF := TBitmap.Create;
BF.Width := R.Right - R.Left;
BF.Height := R.Bottom - R.Top;
if GetDeviceCaps(C.Handle, BITSPIXEL) > 16 then
BF.Canvas.Brush.Color := NewColor(C, xpMenu.FFSelectColor, 20)
else
BF.Canvas.Brush.Color := NewColor(C, xpMenu.FFSelectColor, 40);
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);
BF.Free;
end;
C.Brush.Color := SelectColor;
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
C.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
//***************************Tommstudio.com Update*********************
if (XpMenu.FControlUseTrueXPStyle) and (Control.Tag<>1234567890) then begin //tag=1234567890ʱ<30><CAB1><EFBFBD><EFBFBD>ʾxpЧ<70><D0A7>
DrawBtnSurface(C,R,ParentColor);
C.Brush.Style:=bsSolid;
C.Brush.Color:= XpMenu.FBtnSurfaceNormalColor;
DrawBtnOuterLine(C,R,C.Pen.Color,XpMenu.FBtnRoundArc);
C.Brush.Style:=bsClear;
if Control.Enabled then
DrawBtnOuterLine(C,R,XpMenu.FBtnOutLineBorderColor,XpMenu.FBtnRoundArc)
else C.Pen.Color:=XpMenu.FControlDisabledBorderColor;
DrawBtnBottomLine(C,Rect(R.Left+Xpmenu.FBtnRoundArc,R.Bottom-2,R.Right-Xpmenu.FBtnRoundArc,R.Bottom-2),XpMenu.FBtnSurfaceBottomLineColor);
end;
//***************************Tommstudio.com Update*********************
if TControl(Control).Enabled then
//***************************Tommstudio.com Update*********************
if (XpMenu.FControlUseTrueXPStyle) and (Control.Tag<>1234567890) then begin //tag=1234567890ʱ<30><CAB1><EFBFBD><EFBFBD>ʾxpЧ<70><D0A7>
if (FMouseInControl) and (not FLButtonBressed) and (not FBressed) then begin
TempRect:=R;
TempRect.Left:=R.Left+1;
TempRect.Top:=R.Top+1;
TempRect.Right:=R.Right-1;
TempRect.Bottom:=R.Bottom-1;
DrawBtnInnerLine(C,TempRect,XpMenu.FBtnInnerBorderMoveColor,XpMenu.FBtnRoundArc div 2);
TempRect.Bottom:=R.Bottom-2;
DrawBtnInnerLine(C,TempRect,XpMenu.FBtnInnerBorderMoveColor+$020200,XpMenu.FBtnRoundArc div 2);
end;
if FLButtonBressed or FBressed then begin
C.Brush.Style:=bsSolid;
C.Brush.Color:= XpMenu.FBtnSurfaceDownColor;
DrawBtnOuterLine(C,R,XpMenu.FBtnOutLineBorderColor,XpMenu.FBtnRoundArc);
DrawBtnBottomLine(C,Rect(R.Left+XpMenu.FBtnRoundArc,R.Bottom-2,R.Right-XpMenu.FBtnRoundArc,R.Bottom-2),XpMenu.FBtnSurfaceDownBottomLineColor);
end;
end else begin //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Dz<EFBFBD><C7B2><EFBFBD>truexpcolor<6F><72><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
//***************************Tommstudio.com Update*********************
if (not FFlat) then begin
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;
end; //usetruexpcolor
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 := DT_RTLREADING;
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" <holger@hlembke.de>
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;
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;
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;
xpMenu.DrawIcon(Control, C , B, IconRect,
FMouseinControl,
FIsFocused,
TControl(Control).Enabled,
FDown or FLButtonBressed,
false,
TControl(Control).IsRightToLeft);
B.Free;
//end; //if usetruexpcolor
end; //enabled
XPMenu.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;
BLayout: TButtonLayout;
TextFormat: integer;
//***************************Tommstudio.com Update*********************
ParentColor:TColor;
TempRect:TRect;
//***************************Tommstudio.com Update*********************
begin
C := nil;
//***************************Tommstudio.com Update*********************
ParentColor:=Control.Parent.Brush.Color;
//***************************Tommstudio.com Update*********************
try
C := TControlCanvas.Create;
C.Control := Control;
XPMenu.SetGlobalColor(C);
if (FMouseInControl or FBressed) then begin
SelectColor := NewColor(C, clBtnFace, 60);
BorderColor := NewColor(C, XPMenu.FFSelectBorderColor,60);
end else begin
SelectColor := XPMenu.FFIconBackColor;
BorderColor := clBtnShadow;
end;
if (not FmouseinControl) and (FIsFocused) then begin
BorderColor := NewColor(C, XPMenu.FFSelectBorderColor,60);
end;
TextFormat := 0;
R := Control.ClientRect;
CWidth := (R.Right - R.Left);
CHeight := (R.Bottom - R.Top);
//***************************Tommstudio.com Update*********************
C.Brush.Style:=bsSolid;
//***************************Tommstudio.com Update*********************
C.Brush.Color := Control.Parent.Brush.Color;
C.FillRect(R);
C.Brush.Color := SelectColor;
C.Pen.Color := NewColor(C, BorderColor, 30);
//***************************Tommstudio.com Update*********************
if (XpMenu.FControlUseTrueXPStyle) and (Control.Tag<>1234567890) then begin //tag=1234567890ʱ<30><CAB1><EFBFBD><EFBFBD>ʾxpЧ<70><D0A7>
DrawBtnSurface(C,R,ParentColor);
C.Brush.Style:=bsSolid;
C.Brush.Color:= XpMenu.FBtnSurfaceNormalColor;
DrawBtnOuterLine(C,R,C.Pen.Color,XpMenu.FBtnRoundArc);
C.Brush.Style:=bsClear;
if Control.Enabled then
DrawBtnOuterLine(C,R,XpMenu.FBtnOutLineBorderColor,XpMenu.FBtnRoundArc)
else C.Pen.Color:=XpMenu.FControlDisabledBorderColor;
DrawBtnBottomLine(C,Rect(R.Left+Xpmenu.FBtnRoundArc,R.Bottom-2,R.Right-Xpmenu.FBtnRoundArc,R.Bottom-2),XpMenu.FBtnSurfaceBottomLineColor);
end else
//***************************Tommstudio.com Update*********************
c.RoundRect(R.Left, R.Top, R.Right, R.Bottom, 4, 4);
if TControl(Control).Enabled then begin
//***************************Tommstudio.com Update*********************
if (XpMenu.FControlUseTrueXPStyle) and (Control.Tag<>1234567890) then begin //tag=1234567890ʱ<30><CAB1><EFBFBD><EFBFBD>ʾxpЧ<70><D0A7>
if FIsFocused and (not FMouseInControl) and (not FLButtonBressed) and (not FBressed) then begin
TempRect:=R;
TempRect.Left:=R.Left+1;
TempRect.Top:=R.Top+1;
TempRect.Right:=R.Right-1;
TempRect.Bottom:=R.Bottom-1;
DrawBtnInnerLine(C,TempRect,XpMenu.FBtnInnerBorderFocusColor,XpMenu.FBtnRoundArc div 2 );
TempRect.Bottom:=R.Bottom-2;
DrawBtnInnerLine(C,TempRect,XpMenu.FBtnInnerBorderFocusColor+$020202,XpMenu.FBtnRoundArc div 2);
end;
if (FMouseInControl) and (not FLButtonBressed) and (not FBressed) then begin
TempRect:=R;
TempRect.Left:=R.Left+1;
TempRect.Top:=R.Top+1;
TempRect.Right:=R.Right-1;
TempRect.Bottom:=R.Bottom-1;
DrawBtnInnerLine(C,TempRect,XpMenu.FBtnInnerBorderMoveColor,XpMenu.FBtnRoundArc div 2);
TempRect.Bottom:=R.Bottom-2;
DrawBtnInnerLine(C,TempRect,XpMenu.FBtnInnerBorderMoveColor+$020200,XpMenu.FBtnRoundArc div 2);
end;
if FLButtonBressed or FBressed then begin
C.Brush.Style:=bsSolid;
C.Brush.Color:= XpMenu.FBtnSurfaceDownColor;
DrawBtnOuterLine(C,R,XpMenu.FBtnOutLineBorderColor,XpMenu.FBtnRoundArc);
DrawBtnBottomLine(C,Rect(R.Left+XpMenu.FBtnRoundArc,R.Bottom-2,R.Right-XpMenu.FBtnRoundArc,R.Bottom-2),XpMenu.FBtnSurfaceDownBottomLineColor);
end;
end else begin //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Dz<EFBFBD><C7B2><EFBFBD>truexpcolor<6F><72><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
//***************************Tommstudio.com Update*********************
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;//if usetruexp
end;
Txt := TBitBtn(Control).Caption;
TextRect := R;
TxtFont := TBitBtn(Control).Font;
C.Font.Assign (TxtFont);
TWidth := C.TextWidth(Txt);
THeight := C.TextHeight(Txt);
TextRect.Left := (CWidth - TWidth) div 2;
if TBitBtn(Control).IsRightToLeft then
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" <holger@hlembke.de>
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;
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;
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;
xpMenu.DrawIcon(Control, C , B, IconRect,
FMouseinControl,
FIsFocused,
TControl(Control).Enabled,
false,
false,
TControl(Control).IsRightToLeft);
B.Free;
end;
XPMenu.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;
begin
//
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 := nil;
try
C := TControlCanvas.Create;
C.Control := Control;
XPMenu.SetGlobalColor(C);
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);
// Frame for inner part
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) + 2;
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 := nil;
try
C := TControlCanvas.Create;
C.Control := Control;
XPMenu.SetGlobalColor(C);
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;
procedure DrawBtnSurface(ACanvas:TCanvas;Rect:TRect;Color:TColor);
begin
ACanvas.Brush.Style:=bsSolid;
ACanvas.Brush.Color:=Color;
ACanvas.FillRect(Rect);
end;
procedure DrawBtnOuterLine(ACanvas:TCanvas;Rect:TRect;Color:TColor;BtnRoundArc:integer);
begin
ACanvas.Pen.Color:=Color;
ACanvas.RoundRect(Rect.Left,Rect.Top,Rect.Right,Rect.Bottom,BtnRoundArc,BtnRoundArc);
end;
procedure DrawBtnInnerLine(ACanvas:TCanvas;Rect:TRect;Color:TColor;BtnRoundArc:integer);
begin
ACanvas.Brush.Style:=bsclear;
ACanvas.Pen.Color:=Color;
ACanvas.RoundRect(Rect.Left,Rect.Top,Rect.Right,Rect.Bottom,BtnRoundArc,BtnRoundArc);
end;
procedure DrawBtnBottomLine(ACanvas:TCanvas;Rect:TRect;Color:TColor);
begin
ACanvas.Pen.Color:=Color;
ACanvas.MoveTo(Rect.Left,Rect.Bottom);
ACanvas.LineTo(Rect.Right,Rect.Bottom);
end;
procedure TXPMenu.SetControlUseTrueXPStyle(const value: Boolean);
begin
if FControlUseTrueXPStyle<>Value then FControlUseTrueXPStyle:=Value;
if FControlUseTrueXPStyle then begin
FBtnRoundArc:=5;
FBtnOutLineBorderColor:=$733c00;
FBtnInnerBorderMoveColor:=$31b2ff;
FBtnInnerBorderFocusColor:=$e7ae8c;
FBtnSurfaceDownColor:=$dee7e7;
FBtnSurfaceNormalColor:=$F7FBFF;
FBtnSurfaceBottomLineColor:=$dee7e7;
FBtnSurfaceDownBottomLineColor:=$E7EBEF;
FRdoChkControlChkColor:=$00a200;
FComboBoxChkColor:=$8C694A;
FComboboxSurfaceMoveColor:=$FFE7D6;
FComboboxSurfaceDownColor:=$F7A28C;
FControlDisabledBorderColor:=$B5C7C6;
end;
end;
end.
Reference in New Issue Copy Permalink