View Single Post
  #3  
Old 27-09-2015, 07:49
altef_4's Avatar
altef_4 altef_4 is offline
Registered User
 
Join Date: Mar 2012
Location: Ukraine
Posts: 361
Thanks: 248
Thanked 1,022 Times in 239 Posts
altef_4 is on a distinguished road
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;
Reply With Quote
The Following 2 Users Say Thank You to altef_4 For This Useful Post:
houcine80 (17-11-2015), JRD! (27-09-2015)