Code:
#DEFINE NAME="CheckResDynamic"
[Setup]
AppName={#NAME}
AppVersion=1.0
CreateAppDir=false
OutputDir=.
OutputBaseFilename={#NAME}
[Code]
#ifdef UNICODE
#define AW "W"
#else
#define AW "A"
#endif
const
CCHFORMNAME = 32;
CCHDEVICENAME = 32;
SM_CXSCREEN = 0;
SM_CYSCREEN = 1;
MB_ICONWARNING = 2;
type
TDeviceMode = record
dmDeviceName: array[0..CCHDEVICENAME - 1] of Char;
dmSpecVersion: Word;
dmDriverVersion: Word;
dmSize: Word;
dmDriverExtra: Word;
dmFields: DWORD;
dmOrientation: Smallint;
dmPaperSize: Smallint;
dmPaperLength: Smallint;
dmPaperWidth: Smallint;
dmScale: Smallint;
dmCopies: Smallint;
dmDefaultSource: Smallint;
dmPrintQuality: Smallint;
dmColor: Smallint;
dmDuplex: Smallint;
dmYResolution: Smallint;
dmTTOption: Smallint;
dmCollate: Smallint;
dmFormName: array[0..CCHFORMNAME - 1] of Char;
dmLogPixels: Word;
dmBitsPerPel: DWORD;
dmPelsWidth: DWORD;
dmPelsHeight: DWORD;
dmDisplayFlags: DWORD;
dmDisplayFrequency: DWORD;
dmICMMethod: DWORD;
dmICMIntent: DWORD;
dmMediaType: DWORD;
dmDitherType: DWORD;
dmICCManufacturer: DWORD;
dmICCModel: DWORD;
dmPanningWidth: DWORD;
dmPanningHeight: DWORD;
end;
TDeviceFilter = record
Width: DWORD;
Height: DWORD;
end;
var
ModeIndex: DWORD;
ModeExists: Boolean;
FilterIndex: Integer;
DisplayPage: TWizardPage;
DisplayCombo: TNewComboBox;
DisplayModes: array of TDeviceFilter;
DisplaySettings: TDeviceMode;
function EnumDisplaySettings(lpszDeviceName: string; iModeNum: DWORD; var lpDevMode: TDeviceMode): BOOL;
external 'EnumDisplaySettings{#AW}@user32.dll stdcall';
function GetSystemMetrics (nIndex: Integer): Integer;
external '[email protected] stdcall setuponly';
function _MessageBoxW_(hWnd: Integer; lpText, lpCaption: String; uType: Cardinal): Integer;
external '[email protected] stdcall';
function SysMsgBox(const Caption, Message: String; const Flags: Integer): Integer;
begin
Result := _MessageBoxW_(StrToInt(ExpandConstant('{wizardhwnd}')), Message, Caption, Flags);
end;
procedure CancelButtonClick(CurPageID: Integer; var Cancel, Confirm: Boolean);
begin
Confirm:=False;
Cancel:=True;
end;
function LoadValueFromXML(const AFileName, APath: string): string;
var
XMLNode: Variant;
XMLDoc: Variant;
begin
Log('Get Xml text node: ' + AFileName);
Result := '';
XMLDoc := CreateOleObject('Msxml2.DOMDocument.6.0');
try
XMLDoc.async := False;
XMLDoc.load(AFileName);
if (XMLDoc.parseError.errorCode <> 0) then
SysMsgBox('{#NAME}', 'Le fichier est introuvable.', MB_ICONWARNING) else begin
XMLDoc.setProperty('SelectionLanguage', 'XPath');
XMLNode := XMLDoc.selectSingleNode(APath);
Result := XMLNode.text;
end;
except
SysMsgBox('{#NAME}', 'Une erreur est survenue!' + #13#10 + GetExceptionMessage, MB_ICONWARNING);
end;
end;
function GetAttrValueFromXML(const AFileName, APath: string): string;
var
XMLNode: Variant;
XMLDoc: Variant;
begin
Result := '';
XMLDoc := CreateOleObject('Msxml2.DOMDocument.6.0');
try
XMLDoc.async := False;
XMLDoc.load(AFileName);
if (XMLDoc.parseError.errorCode <> 0) then
SysMsgBox('{#NAME}', 'Le fichier "settings.xml" est introuvable.', MB_ICONWARNING) else begin
XMLDoc.setProperty('SelectionLanguage', 'XPath');
XMLNode := XMLDoc.selectSingleNode(APath);
Result := XMLNode.NodeValue;
end;
except
SysMsgBox('{#NAME}', 'Une erreur est survenue!' + #13#10 + GetExceptionMessage, MB_ICONWARNING);
end;
end;
procedure SaveValueToXML(const AFileName, APath, AValue: string);
var
XMLNode: Variant;
XMLDoc: Variant;
begin
Log('Save Xml text node: ' + AFileName);
XMLDoc := CreateOleObject('Msxml2.DOMDocument.6.0');
try
XMLDoc.async := False;
XMLDoc.load(AFileName);
if (XMLDoc.parseError.errorCode <> 0) then
SysMsgBox('{#NAME}', 'Le fichier "settings.xml" est introuvable.', MB_ICONWARNING) else begin
XMLDoc.setProperty('SelectionLanguage', 'XPath');
XMLNode := XMLDoc.selectSingleNode(APath);
XMLNode.text := AValue;
XMLDoc.save(AFileName);
end;
except
SysMsgBox('{#NAME}', 'Une erreur est survenue!' + #13#10 + GetExceptionMessage, MB_ICONWARNING);
end;
end;
procedure SaveAttributeValueToXML(const AFileName, APath, AAttribute, AValue: string);
var
XMLNode: Variant;
XMLDoc: Variant;
begin
Log('Save Xml attr: ' + AFileName);
XMLDoc := CreateOleObject('Msxml2.DOMDocument.6.0');
try
XMLDoc.async := False;
XMLDoc.load(AFileName);
if (XMLDoc.parseError.errorCode <> 0) then
SysMsgBox('{#NAME}', 'Le fichier "settings.xml" est introuvable.', MB_ICONWARNING) else begin
XMLDoc.setProperty('SelectionLanguage', 'XPath');
XMLNode := XMLDoc.selectSingleNode(APath);
XMLNode.setAttribute(AAttribute, AValue);
XMLDoc.save(AFileName);
end;
except
SysMsgBox('{#NAME}', 'Une erreur est survenue!' + #13#10 + GetExceptionMessage, MB_ICONWARNING);
end;
end;
procedure DisplayComboOnChange(Sender: TObject);
var
ModeIndex: DWORD;
ModeExists: Boolean;
FilterIndex,ProgressBarPos,ProgressBarMax: Integer;
DisplayModes: array of TDeviceFilter;
DisplaySettings: TDeviceMode;
XMLFile: string;
begin
XMLFile := ExpandConstant('{src}\settings.xml');
ModeIndex := 0;
while EnumDisplaySettings('', ModeIndex, DisplaySettings) do
begin
with DisplaySettings do
begin
Inc(ModeIndex);
ModeExists := False;
for FilterIndex := 0 to GetArrayLength(DisplayModes) - 1 do
begin
if (DisplayModes[FilterIndex].Width = dmPelsWidth) and (DisplayModes[FilterIndex].Height = dmPelsHeight) then begin
ModeExists := True;
Break;
end;
end;
if not ModeExists then begin
SetArrayLength(DisplayModes, GetArrayLength(DisplayModes) + 1);
with DisplayModes[GetArrayLength(DisplayModes) - 1] do begin
Width := dmPelsWidth;
Height := dmPelsHeight;
if DisplayCombo.Text = Format('%dx%d', [Width,Height]) then begin
SaveAttributeValueToXML(XMLFile, '//Settings/video/ScreenWidth','value',IntToStr(Width));
SaveAttributeValueToXML(XMLFile, '//Settings/video/ScreenHeight','value',IntToStr(Height));
end;
end;
end;
end;
end;
end;
procedure InitializeWizard;
var
xres,yres: integer;
XMLFile,ResW,ResH: string;
XMLDoc,NewNode,XMLNode,RootNode: Variant;
AutoRunFormNotebook: TNewNotebook;
AutoRunForm: TNewNotebookPage;
begin
xres := GetSystemMetrics(SM_CXSCREEN);
yres := GetSystemMetrics(SM_CYSCREEN);
XMLFile := ExpandConstant('{src}\settings.xml');
XMLDoc := CreateOleObject('MSXML2.DOMDocument');
XMLDoc.async := False;
XMLDoc.resolveExternals := False;
XMLDoc.load(XMLFile);
XMLNode := XMLDoc.selectSingleNode('//Settings/FirstLaunch');
{if ((XMLNode as IDispatch) = nil) then begin
NewNode := XMLDoc.createElement('FirstLaunch');
RootNode := XMLDoc.documentElement;
RootNode.appendChild(NewNode);
RootNode.lastChild.text := '0';
XMLDoc.Save(XMLFile);
SaveAttributeValueToXML(XMLFile, '//Settings/video/ScreenWidth','value',IntToStr(xres));
SaveAttributeValueToXML(XMLFile, '//Settings/video/ScreenHeight','value',IntToStr(yres));
end;}
with WizardForm do
begin
BorderStyle := bsDialog;
Position := poScreenCenter;
AutoScroll := False;
ClientWidth := ScaleX(220);
ClientHeight := ScaleY(50);
Caption:='{#NAME}';
end;
AutoRunFormNotebook := TNewNotebook.Create(WizardForm);
with AutoRunFormNotebook do
begin
Parent := WizardForm;
Left := ScaleX(0);
Top := ScaleY(0);
Width := ScaleX(220);
Height := ScaleY(50);
Align := alClient;
end;
AutoRunForm := TNewNotebookPage.Create(WizardForm);
with AutoRunForm do
begin
Notebook := AutoRunFormNotebook;
end;
ResW:=GetAttrValueFromXML(XMLFile,'//Settings/video/ScreenWidth/@value');
ResH:=GetAttrValueFromXML(XMLFile,'//Settings/video/ScreenHeight/@value');
DisplayCombo := TNewComboBox.Create(WizardForm);
with DisplayCombo do
begin
Parent := AutoRunFormNotebook;
Left:=10;
Top:=15;
Width := 200;
Text := ResW+'x'+ResH;
OnChange:=@DisplayComboOnChange;
Style:=csOwnerDrawVariable;
end;
ModeIndex := 0;
while EnumDisplaySettings('', ModeIndex, DisplaySettings) do
begin
with DisplaySettings do
begin
Inc(ModeIndex);
ModeExists := False;
for FilterIndex := 0 to GetArrayLength(DisplayModes) - 1 do
begin
if (DisplayModes[FilterIndex].Width = dmPelsWidth) and
(DisplayModes[FilterIndex].Height = dmPelsHeight)then
begin
ModeExists := True;
Break;
end;
end;
if not ModeExists then
begin
SetArrayLength(DisplayModes, GetArrayLength(DisplayModes) + 1);
with DisplayModes[GetArrayLength(DisplayModes) - 1] do
begin
Width := dmPelsWidth;
Height := dmPelsHeight;
DisplayCombo.Items.Add(Format('%dx%d', [Width,Height]));
if (Width = xres) and (Height = yres) then DisplayCombo.ItemIndex:=DisplayCombo.Items.Count-1;
end;
end;
end;
end;
end;