1
0
mirror of synced 2024-12-22 17:23:07 +01:00

Added: OS.ComCtlVersion and OS.XPManifest properties

This commit is contained in:
Mark van Renswoude 2004-08-31 09:12:50 +00:00
parent cdf35a6cdb
commit 6ea14fac77
6 changed files with 132 additions and 38 deletions

View File

@ -1,10 +1,10 @@
object frmMain: TfrmMain object frmMain: TfrmMain
Left = 199 Left = 339
Top = 107 Top = 239
BorderIcons = [biSystemMenu] BorderIcons = [biSystemMenu]
BorderStyle = bsDialog BorderStyle = bsDialog
Caption = 'X'#178'Utils Test' Caption = 'X'#178'Utils Test'
ClientHeight = 206 ClientHeight = 245
ClientWidth = 455 ClientWidth = 455
Color = clBtnFace Color = clBtnFace
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
@ -65,29 +65,44 @@ object frmMain: TfrmMain
end end
object lblInstances: TLabel object lblInstances: TLabel
Left = 8 Left = 8
Top = 84 Top = 128
Width = 49 Width = 49
Height = 13 Height = 13
Caption = 'Instances:' Caption = 'Instances:'
end end
object lblFormatSize: TLabel object lblFormatSize: TLabel
Left = 8 Left = 8
Top = 160 Top = 204
Width = 56 Width = 56
Height = 13 Height = 13
Caption = 'Format size:' Caption = 'Format size:'
end end
object lblFormatSizeValue: TLabel object lblFormatSizeValue: TLabel
Left = 244 Left = 244
Top = 160 Top = 204
Width = 205 Width = 205
Height = 13 Height = 13
AutoSize = False AutoSize = False
Caption = '<unknown>' Caption = '<unknown>'
end end
object lstInstances: TListBox object lblComCtlVersionValue: TLabel
Left = 112 Left = 112
Top = 84 Top = 84
Width = 333
Height = 13
AutoSize = False
Caption = '<unknown>'
end
object lblComCtlVersion: TLabel
Left = 8
Top = 84
Width = 73
Height = 13
Caption = 'ComCtl version:'
end
object lstInstances: TListBox
Left = 112
Top = 128
Width = 337 Width = 337
Height = 65 Height = 65
ItemHeight = 13 ItemHeight = 13
@ -95,7 +110,7 @@ object frmMain: TfrmMain
end end
object txtSize: TEdit object txtSize: TEdit
Left = 112 Left = 112
Top = 156 Top = 200
Width = 121 Width = 121
Height = 21 Height = 21
TabOrder = 1 TabOrder = 1
@ -103,11 +118,21 @@ object frmMain: TfrmMain
end end
object chkBytes: TCheckBox object chkBytes: TCheckBox
Left = 112 Left = 112
Top = 180 Top = 224
Width = 97 Width = 97
Height = 17 Height = 17
Caption = '&Keep bytes' Caption = '&Keep bytes'
TabOrder = 2 TabOrder = 2
OnClick = txtSizeChange OnClick = txtSizeChange
end end
object chkXPManifest: TCheckBox
Left = 112
Top = 104
Width = 337
Height = 17
Caption = 'XP Manifest'
Checked = True
State = cbChecked
TabOrder = 3
end
end end

View File

@ -12,10 +12,13 @@ uses
type type
TfrmMain = class(TForm, IX2InstanceNotifier) TfrmMain = class(TForm, IX2InstanceNotifier)
chkBytes: TCheckBox; chkBytes: TCheckBox;
chkXPManifest: TCheckBox;
lblAppPath: TLabel; lblAppPath: TLabel;
lblAppPathValue: TLabel; lblAppPathValue: TLabel;
lblAppVersion: TLabel; lblAppVersion: TLabel;
lblAppVersionValue: TLabel; lblAppVersionValue: TLabel;
lblComCtlVersion: TLabel;
lblComCtlVersionValue: TLabel;
lblFormatSize: TLabel; lblFormatSize: TLabel;
lblFormatSizeValue: TLabel; lblFormatSizeValue: TLabel;
lblInstances: TLabel; lblInstances: TLabel;
@ -40,17 +43,27 @@ uses
{$R *.dfm} {$R *.dfm}
// If you have a WinXP.RES which holds the XP manifest, you will
// notice that the Common Controls version changes to 6 instead of 5.
{.$R WinXP.RES}
{=============================== TfrmMain {=============================== TfrmMain
Initialization Initialization
========================================} ========================================}
procedure TfrmMain.FormCreate; procedure TfrmMain.FormCreate;
begin begin
Randomize(); Randomize();
lblAppPathValue.Caption := App.Path; lblAppPathValue.Caption := App.Path;
lblAppVersionValue.Caption := App.FormatVersion(); lblAppVersionValue.Caption := App.FormatVersion();
lblOSVersionValue.Caption := OS.FormatVersion(); lblOSVersionValue.Caption := OS.FormatVersion();
txtSize.Text := IntToStr(Random(MaxInt));
with OS.ComCtlVersion do
lblComCtlVersionValue.Caption := Format('%d.%d build %d', [Major, Minor,
Build]);
chkXPManifest.Checked := OS.XPManifest;
txtSize.Text := IntToStr(Random(MaxInt));
RegisterInstance(Self); RegisterInstance(Self);
end; end;

View File

@ -32,6 +32,5 @@
-M -M
-$M16384,1048576 -$M16384,1048576
-K$00400000 -K$00400000
-LE"c:\program files\borland\delphi6\Projects\Bpl" -LE"c:\delphi6\Projects\Bpl"
-LN"c:\program files\borland\delphi6\Projects\Bpl" -LN"c:\delphi6\Projects\Bpl"
-DmadExcept

View File

@ -47,7 +47,7 @@ PackageDLLOutputDir=
PackageDCPOutputDir= PackageDCPOutputDir=
SearchPath= SearchPath=
Packages=vcl;rtl;vclx;Indy60;madBasic_;madDisAsm_;dsnap;dbrtl;xmlrtl;inet;soaprtl Packages=vcl;rtl;vclx;Indy60;madBasic_;madDisAsm_;dsnap;dbrtl;xmlrtl;inet;soaprtl
Conditionals=madExcept Conditionals=
DebugSourceDirs= DebugSourceDirs=
UsePackages=0 UsePackages=0
[Parameters] [Parameters]
@ -56,6 +56,10 @@ HostApplication=
Launcher= Launcher=
UseLauncher=0 UseLauncher=0
DebugCWD= DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=
[Version Info] [Version Info]
IncludeVerInfo=1 IncludeVerInfo=1
AutoIncBuild=1 AutoIncBuild=1
@ -148,19 +152,3 @@ Item0=madExcept
[HistoryLists\hlUnitAliases] [HistoryLists\hlUnitAliases]
Count=1 Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Included Packages]
C:\Program Files\Borland\Delphi6\Bin\dclstd60.bpl=Borland Standard Components
c:\program files\borland\delphi6\Bin\dclsmpedit60.bpl=Borland Editor Script Enhancements
F:\Delphi\Components\madCollection\madBasic\Delphi 6\madBasic_.bpl=madBasic 1.1f · www.madshi.net
F:\Delphi\Components\madCollection\madDisAsm\Delphi 6\madDisAsm_.bpl=madDisAsm 2.0a · www.madshi.net
F:\Delphi\Components\madCollection\madExcept\Delphi 6\madExcept_.bpl=madExcept 2.6a · www.madshi.net
F:\Delphi\Components\madCollection\madExcept\Delphi 6\madExceptIde_.bpl=madExceptIde 1.0b · www.madshi.net
F:\Delphi\Components\madCollection\madExcept\Delphi 6\madExceptWizard_.bpl=madExceptWizard 2.6 · www.madshi.net
C:\Program Files\Borland\Delphi6\Bin\dcldb60.bpl=Borland Database Components
c:\program files\borland\delphi6\Bin\dclnet60.bpl=Borland Internet Components
c:\program files\borland\delphi6\Bin\dclsoap60.bpl=Borland SOAP Components
c:\program files\borland\delphi6\Projects\Bpl\ColorPickerButtonD6.bpl=ColorPickerButton
C:\Program Files\Borland\Delphi6\Bin\dclact60.bpl=Borland ActionBar Components
c:\program files\borland\delphi6\Projects\Bpl\SysILS.bpl=(untitled)
c:\program files\borland\delphi6\Projects\Bpl\videocap5.bpl=(untitled)
c:\program files\borland\delphi6\Projects\Bpl\DragDropD6.bpl=Drag and Drop Component Suite

View File

@ -1,8 +1,6 @@
program X2UtilsTest; program X2UtilsTest;
uses uses
madExcept,
madLinkDisAsm,
Forms, Forms,
X2UtOS in '..\X2UtOS.pas', X2UtOS in '..\X2UtOS.pas',
X2UtApp in '..\X2UtApp.pas', X2UtApp in '..\X2UtApp.pas',

View File

@ -18,6 +18,13 @@ type
TX2OSVersion = (osWin95, osWin98, osWinME, osWinNT3, osWinNT4, TX2OSVersion = (osWin95, osWin98, osWinME, osWinNT3, osWinNT4,
osWin2K, osWinXP, osWin2003, osUnknown); osWin2K, osWinXP, osWin2003, osUnknown);
//:$ Record to hold the Common Controls version
TX2CCVersion = record
Major: Cardinal;
Minor: Cardinal;
Build: Cardinal;
end;
{ {
:$ Contains extended version information for the Operating System :$ Contains extended version information for the Operating System
} }
@ -46,10 +53,14 @@ type
} }
TX2OS = class(TObject) TX2OS = class(TObject)
private private
FCCVersion: TX2CCVersion;
FVersion: TX2OSVersion; FVersion: TX2OSVersion;
FVersionEx: TX2OSVersionEx; FVersionEx: TX2OSVersionEx;
function GetXPManifest(): Boolean;
protected protected
procedure GetVersion(); virtual; procedure GetVersion(); virtual;
procedure GetCCVersion(); virtual;
public public
constructor Create(); constructor Create();
destructor Destroy(); override; destructor Destroy(); override;
@ -59,6 +70,13 @@ type
//:: OS' Build number. //:: OS' Build number.
function FormatVersion(Build: Boolean = True): String; function FormatVersion(Build: Boolean = True): String;
//:$ Contains the Common Controls version
property ComCtlVersion: TX2CCVersion read FCCVersion;
//:$ Checks if the application uses an XP manifest
//:: If present, Common Controls version 6 or higher is available.
property XPManifest: Boolean read GetXPManifest;
//:$ Contains the detected OS version //:$ Contains the detected OS version
property Version: TX2OSVersion read FVersion; property Version: TX2OSVersion read FVersion;
@ -71,7 +89,22 @@ type
implementation implementation
uses uses
SysUtils; SysUtils;
const
ComCtl32 = 'comctl32.dll';
type
PDllVersionInfo = ^TDllVersionInfo;
TDllVersionInfo = record
cbSize: DWORD;
dwMajorVersion: DWORD;
dwMinorVersion: DWORD;
dwBuildNumber: DWORD;
dwPlatformID: DWORD;
end;
TDllGetVersion = function(pdvi: PDllVersionInfo): HRESULT; stdcall;
var var
GOS: TX2OS; GOS: TX2OS;
@ -97,6 +130,7 @@ begin
FVersionEx := TX2OSVersionEx.Create(); FVersionEx := TX2OSVersionEx.Create();
GetVersion(); GetVersion();
GetCCVersion();
end; end;
destructor TX2OS.Destroy; destructor TX2OS.Destroy;
@ -180,6 +214,43 @@ begin
end; end;
end; end;
procedure TX2OS.GetCCVersion;
var
DllGetVersion: TDllGetVersion;
hLib: THandle;
viVersion: TDllVersionInfo;
begin
FillChar(FCCVersion, SizeOf(FCCVersion), #0);
hLib := LoadLibrary(ComCtl32);
if hLib <> 0 then
begin
@DllGetVersion := GetProcAddress(hLib, 'DllGetVersion');
if Assigned(DllGetVersion) then
begin
FillChar(viVersion, SizeOf(viVersion), #0);
viVersion.cbSize := SizeOf(viVersion);
DllGetVersion(@viVersion);
with FCCVersion do
begin
Major := viVersion.dwMajorVersion;
Minor := viVersion.dwMinorVersion;
Build := viVersion.dwBuildNumber;
end;
end;
FreeLibrary(hLib);
end;
end;
function TX2OS.GetXPManifest;
begin
Result := (FCCVersion.Major >= 6);
end;
function TX2OS.FormatVersion; function TX2OS.FormatVersion;
var var
@ -199,5 +270,5 @@ end;
initialization initialization
finalization finalization
FreeAndNil(GOS); FreeAndNil(GOS);
end. end.