www.pudn.com > TMS.Component.Pack.v5.0.rar > advappstyler.pas, change:2009-01-24,size:16193b
{*************************************************************************}
{ TMS TAdvFormStyler & TAdvAppStyler component }
{ for Delphi & C++Builder }
{ }
{ written by TMS Software }
{ copyright © 2006 - 2007 }
{ Email : info@tmssoftware.com }
{ Web : http://www.tmssoftware.com }
{ }
{ The source code is given as is. The author is not responsible }
{ for any possible damage done due to the use of this code. }
{ The component can be freely used in any application. The complete }
{ source code remains property of the author and may not be distributed, }
{ published, given or sold in any form as such. No parts of the source }
{ code can be included in any other component or application without }
{ written authorization of the author. }
{*************************************************************************}
unit AdvAppStyler;
interface
uses
Classes, AdvStyleIF, Forms, Windows, SysUtils, Controls, Messages, Dialogs;
const
MAJ_VER = 1; // Major version nr.
MIN_VER = 2; // Minor version nr.
REL_VER = 0; // Release nr.
BLD_VER = 1; // Build nr.
// version history
// 1.0.1.0 : added OnChange event
// 1.1.0.0 : Added AutoThemeAdapt capability
// 1.1.1.0 : Added capability to handle frames in TAdvFormStyler
// 1.1.2.0 : Added OnChange event for TAdvAppStyler
// 1.1.3.0 : Added capability to adapt theme programmatically at runtime by setting AutoThemeAdapt
// 1.1.4.0 : Added support to handle frames in frames
// 1.1.4.1 : Fixed issue with AutoThemeAdapt
// 1.2.0.0 : New : Added event OnApplyStyle in TAdvFormStyler to allow excluding components from being styled
// 1.2.0.1 : Fixed : issue with form inheritance
type
TAdvFormStyler = class;
TThemeNotifierWindow = class(TWinControl)
private
FOnThemeChange: TNotifyEvent;
protected
procedure WndProc(var Msg: TMessage); override;
published
property OnThemeChange: TNotifyEvent read FOnThemeChange write FOnThemeChange;
end;
TAdvAppStyler = class(TComponent)
public
FForms: TList;
FStyle: TTMSStyle;
FAutoThemeAdapt: boolean;
FNotifier: TThemeNotifierWindow;
FOnChange: TNotifyEvent;
private
procedure SetStyle(const Value: TTMSStyle);
function GetVersion: string;
procedure SetVersion(const Value: string);
procedure ThemeChanged(Sender: TObject);
procedure SetAutoThemeAdapt(const Value: boolean);
protected
procedure Loaded; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure RegisterFormStyler(AFormStyler: TAdvFormStyler);
procedure UnRegisterFormStyler(AFormStyler: TAdvFormStyler);
function GetVersionNr: integer;
published
property AutoThemeAdapt: boolean read FAutoThemeAdapt write SetAutoThemeAdapt;
property Style: TTMSStyle read FStyle write SetStyle default tsCustom;
property Version: string read GetVersion write SetVersion stored false;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
end;
TApplyStyleEvent = procedure(Sender: TObject; AComponent: TComponent; var Allow:boolean) of object;
TAdvFormStyler = class(TComponent)
private
FStyle: TTMSStyle;
FAppStyle: TAdvAppStyler;
FOnChange: TNotifyEvent;
FAutoThemeAdapt: boolean;
FNotifier: TThemeNotifierWindow;
FOnApplyStyle: TApplyStyleEvent;
procedure SetStyle(const Value: TTMSStyle);
procedure SetAppStyle(const Value: TAdvAppStyler);
function GetVersion: string;
procedure SetVersion(const Value: string);
procedure ThemeChanged(Sender: TObject);
procedure SetAutoThemeAdapt(const Value: boolean);
protected
procedure Notification(AComponent: TComponent; AOperation: TOperation); override;
public
procedure Loaded; override;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
procedure ApplyStyle;
procedure ApplyStyleToForm(Form: TCustomForm; AStyle:TTMSStyle);
procedure ApplyStyleToFrame(Frame: TCustomFrame; AStyle:TTMSStyle);
function GetVersionNr: integer;
published
property AutoThemeAdapt: boolean read FAutoThemeAdapt write SetAutoThemeAdapt;
property Style: TTMSStyle read FStyle write SetStyle default tsCustom;
property AppStyle: TAdvAppStyler read FAppStyle write SetAppStyle;
property OnApplyStyle: TApplyStyleEvent read FOnApplyStyle write FOnApplyStyle;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property Version: string read GetVersion write SetVersion stored false;
end;
procedure Register;
implementation
const
// theme changed notifier
WM_THEMECHANGED = $031A;
type
XPColorScheme = (xpNone, xpBlue, xpGreen, xpGray);
{$IFNDEF TMSDOTNET}
var
GetCurrentThemeName: function(pszThemeFileName: PWideChar;
cchMaxNameChars: Integer;
pszColorBuff: PWideChar;
cchMaxColorChars: Integer;
pszSizeBuff: PWideChar;
cchMaxSizeChars: Integer): THandle cdecl stdcall;
IsThemeActive: function: BOOL cdecl stdcall;
{$ENDIF}
function IsWinXP: Boolean;
var
VerInfo: TOSVersioninfo;
begin
{$IFNDEF TMSDOTNET}
VerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
{$ENDIF}
{$IFDEF TMSDOTNET}
VerInfo.dwOSVersionInfoSize := Marshal.SizeOf(TypeOf(OSVersionInfo));
{$ENDIF}
GetVersionEx(verinfo);
Result := (verinfo.dwMajorVersion > 5) OR
((verinfo.dwMajorVersion = 5) AND (verinfo.dwMinorVersion >= 1));
end;
{$IFDEF TMSDOTNET}
function CurrentXPTheme: XPColorScheme;
var
FileName, ColorScheme, SizeName: StringBuilder;
begin
Result := xpNone;
if IsWinXP then
begin
if IsThemeActive then
begin
FileName := StringBuilder.Create(255);
SizeName := StringBuilder.Create(255);
ColorScheme := StringBuilder.Create(255);
GetCurrentThemeName(FileName, 255, ColorScheme, 255, SizeName, 255);
if(ColorScheme.ToString = 'NormalColor') then
Result := xpBlue
else if (ColorScheme.ToString = 'HomeStead') then
Result := xpGreen
else if (ColorScheme.ToString = 'Metallic') then
Result := xpGray
end;
end;
end;
{$ENDIF}
{$IFNDEF TMSDOTNET}
function CurrentXPTheme: XPColorScheme;
var
FileName, ColorScheme, SizeName: WideString;
hThemeLib: THandle;
begin
hThemeLib := 0;
Result := xpNone;
if not IsWinXP then
Exit;
try
hThemeLib := LoadLibrary('uxtheme.dll');
if hThemeLib > 0 then
begin
IsThemeActive := GetProcAddress(hThemeLib,'IsThemeActive');
if Assigned(IsThemeActive) then
if IsThemeActive then
begin
GetCurrentThemeName := GetProcAddress(hThemeLib,'GetCurrentThemeName');
if Assigned(GetCurrentThemeName) then
begin
SetLength(FileName, 255);
SetLength(ColorScheme, 255);
SetLength(SizeName, 255);
GetCurrentThemeName(PWideChar(FileName), 255,
PWideChar(ColorScheme), 255, PWideChar(SizeName), 255);
if (PWideChar(ColorScheme) = 'NormalColor') then
Result := xpBlue
else if (PWideChar(ColorScheme) = 'HomeStead') then
Result := xpGreen
else if (PWideChar(ColorScheme) = 'Metallic') then
Result := xpGray
else
Result := xpNone;
end;
end;
end;
finally
if hThemeLib <> 0 then
FreeLibrary(hThemeLib);
end;
end;
{$ENDIF}
//------------------------------------------------------------------------------
{ TNotifierWindow }
procedure TThemeNotifierWindow.WndProc(var Msg: TMessage);
begin
if Msg.Msg = WM_THEMECHANGED then
begin
if Assigned(FOnThemeChange) then
begin
FOnThemeChange(Self);
end;
end;
inherited;
end;
{ TAdvFormStyler }
procedure TAdvFormStyler.ApplyStyleToForm(Form: TCustomForm; AStyle: TTMSStyle);
var
i: integer;
tmsif: ITMSStyle;
allow: boolean;
begin
for i := 0 to Form.ComponentCount - 1 do
begin
if Form.Components[i].GetInterface(ITMSStyle, tmsif) then
begin
allow := true;
if Assigned(FOnApplyStyle) then
FOnApplyStyle(Self, Form.Components[i],allow);
if allow then
tmsif.SetComponentStyle(AStyle);
end;
end;
end;
procedure TAdvFormStyler.ApplyStyleToFrame(Frame: TCustomFrame; AStyle: TTMSStyle);
var
i: integer;
tmsif: ITMSStyle;
allow: boolean;
begin
for i := 0 to Frame.ComponentCount - 1 do
begin
if Frame.Components[i].GetInterface(ITMSStyle, tmsif) then
begin
allow := true;
if Assigned(FOnApplyStyle) then
FOnApplyStyle(Self, Frame.Components[i],allow);
if allow then
tmsif.SetComponentStyle(AStyle);
end;
if Frame.Components[i] is TCustomFrame then
begin
ApplyStyleToFrame(TCustomFrame(Frame.Components[i]), AStyle);
end;
end;
end;
procedure TAdvFormStyler.Assign(Source: TPersistent);
begin
if (Source is TAdvFormStyler) then
begin
AutoThemeAdapt := (Source as TAdvFormStyler).AutoThemeAdapt;
Style := (Source as TAdvFormStyler).Style;
end;
end;
constructor TAdvFormStyler.Create(AOwner: TComponent);
var
ctrl: TComponent;
begin
inherited;
if not (csDesigning in ComponentState) then
begin
FNotifier := TThemeNotifierWindow.Create(self);
// find first owning TWinControl owner
ctrl := AOwner;
while Assigned(ctrl) and not (ctrl is TWinControl) do
begin
ctrl := ctrl.Owner;
end;
if Assigned(ctrl) then
if (ctrl is TWinControl) then
FNotifier.Parent := TWinControl(ctrl);
FNotifier.OnThemeChange := ThemeChanged;
end;
end;
destructor TAdvFormStyler.Destroy;
begin
if Assigned(FAppStyle) and not (csDesigning in ComponentState) then
FAppStyle.UnRegisterFormStyler(Self);
inherited;
end;
function TAdvFormStyler.GetVersion: string;
var
vn: Integer;
begin
vn := GetVersionNr;
Result := IntToStr(Hi(Hiword(vn)))+'.'+IntToStr(Lo(Hiword(vn)))+'.'+IntToStr(Hi(Loword(vn)))+'.'+IntToStr(Lo(Loword(vn)));
end;
function TAdvFormStyler.GetVersionNr: integer;
begin
Result := MakeLong(MakeWord(BLD_VER,REL_VER),MakeWord(MIN_VER,MAJ_VER));
end;
procedure TAdvFormStyler.Loaded;
var
AStyle: TTMSStyle;
begin
inherited;
if Assigned(FAppStyle) then
begin
Style := FAppStyle.Style;
end
else
begin
AStyle := Style;
Style := tsCustom;
Style := AStyle;
end;
if not (csDesigning in ComponentState) then
ThemeChanged(Self);
end;
procedure TAdvFormStyler.Notification(AComponent: TComponent;
AOperation: TOperation);
begin
inherited;
if (AOperation = opRemove) and (FAppStyle = AComponent) then
begin
FAppStyle := nil;
end;
if (AOperation = opInsert) then
begin
end;
end;
procedure TAdvFormStyler.SetAppStyle(const Value: TAdvAppStyler);
begin
FAppStyle := Value;
if not (csLoading in ComponentState) then
begin
if Assigned(FAppStyle) then
Style := FAppStyle.Style;
end;
if Assigned(FAppStyle) and not (csDesigning in ComponentState) then
begin
FAppStyle.RegisterFormStyler(self);
end;
end;
procedure TAdvFormStyler.SetAutoThemeAdapt(const Value: boolean);
begin
FAutoThemeAdapt := value;
ThemeChanged(self);
end;
procedure TAdvFormStyler.ApplyStyle;
var
AForm: TCustomForm;
AFrame: TCustomFrame;
begin
// apply style to form
if Owner is TCustomForm then
begin
AForm := Owner as TCustomForm;
ApplyStyleToForm(AForm, FStyle);
end;
if Owner is TCustomFrame then
begin
AFrame := Owner as TCustomFrame;
ApplyStyleToFrame(AFrame, FStyle);
end;
end;
procedure TAdvFormStyler.SetStyle(const Value: TTMSStyle);
begin
if (FStyle <> Value) then
begin
FStyle := Value;
if (Value <> tsCustom) then
begin
ApplyStyle;
end;
if Assigned(OnChange) then
OnChange(Self);
end;
end;
procedure TAdvFormStyler.SetVersion(const Value: string);
begin
end;
procedure TAdvFormStyler.ThemeChanged(Sender: TObject);
var
eTheme: XPColorScheme;
begin
if not AutoThemeAdapt then
Exit;
eTheme := CurrentXPTheme();
case eTheme of
xpBlue: Style := tsOffice2003Blue;
xpGreen: Style := tsOffice2003Olive;
xpGray: Style := tsOffice2003Silver;
else
Style := tsOffice2003Classic;
end;
end;
procedure Register;
begin
RegisterComponents('TMS Menus',[TAdvFormStyler, TAdvAppStyler]);
end;
{ TAdvAppStyler }
procedure TAdvAppStyler.Assign(Source: TPersistent);
begin
if (Source is TAdvAppStyler) then
begin
Style := (Source as TAdvAppStyler).Style;
AutoThemeAdapt := (Source as TAdvAppStyler).AutoThemeAdapt;
end;
end;
constructor TAdvAppStyler.Create(AOwner: TComponent);
begin
inherited;
FForms := TList.Create;
if not (csDesigning in ComponentState) then
begin
FNotifier := TThemeNotifierWindow.Create(self);
FNotifier.Parent := Application.MainForm;
FNotifier.OnThemeChange := ThemeChanged;
end;
end;
destructor TAdvAppStyler.Destroy;
var
i: integer;
begin
for i := 0 to FForms.Count - 1 do
begin
if Assigned(FForms[i]) then
begin
TAdvFormStyler(FForms[i]).AppStyle := nil; //Unregister from the form to avoid AV
end;
end;
FForms.Free;
inherited;
end;
function TAdvAppStyler.GetVersion: string;
var
vn: Integer;
begin
vn := GetVersionNr;
Result := IntToStr(Hi(Hiword(vn)))+'.'+IntToStr(Lo(Hiword(vn)))+'.'+IntToStr(Hi(Loword(vn)))+'.'+IntToStr(Lo(Loword(vn)));
end;
function TAdvAppStyler.GetVersionNr: integer;
begin
Result := MakeLong(MakeWord(BLD_VER,REL_VER),MakeWord(MIN_VER,MAJ_VER));
end;
procedure TAdvAppStyler.Loaded;
begin
inherited;
if FAutoThemeAdapt then
begin
ThemeChanged(Self);
end;
end;
procedure TAdvAppStyler.RegisterFormStyler(AFormStyler: TAdvFormStyler);
begin
if FForms.IndexOf(Pointer(AFormStyler)) = -1 then
FForms.Add(Pointer(AFormStyler));
end;
procedure TAdvAppStyler.SetAutoThemeAdapt(const Value: boolean);
begin
FAutoThemeAdapt := Value;
ThemeChanged(Self);
end;
procedure TAdvAppStyler.SetStyle(const Value: TTMSStyle);
var
i: integer;
begin
if (FStyle <> Value) then
begin
FStyle := Value;
if not (csLoading in ComponentState) and not (csDesigning in ComponentState) then
begin
for i := 0 to FForms.Count - 1 do
begin
TAdvFormStyler(FForms[i]).Style := Value;
end;
end;
if Assigned(FOnChange) then
FOnChange(Self);
end;
end;
procedure TAdvAppStyler.SetVersion(const Value: string);
begin
end;
procedure TAdvAppStyler.ThemeChanged(Sender: TObject);
var
eTheme: XPColorScheme;
begin
if not AutoThemeAdapt then
Exit;
eTheme := CurrentXPTheme();
case eTheme of
xpBlue: Style := tsOffice2003Blue;
xpGreen: Style := tsOffice2003Olive;
xpGray: Style := tsOffice2003Silver;
else
Style := tsOffice2003Classic;
end;
end;
procedure TAdvAppStyler.UnRegisterFormStyler(AFormStyler: TAdvFormStyler);
var
idx: integer;
begin
idx := FForms.IndexOf(Pointer(AFormStyler));
if idx <> -1 then
FForms.Delete(idx);
end;
end.