Inno Setup (создание инсталяционных пакетов)

sergey3695 · 3 Мар 2014

А понял почему не работало у меня

Код:

SetFileAttributesW

Ну в любом случае через [Files] короче и тоже самое.

ilzok17 · 6 Мар 2014

Хорошего всем настроения.Вопросик такого плана:уже давно внедряю в свои скрипты TransparentStatic и всё хорошо работает кроме одного,не удаётся сделать прозрачным TasksList в SelectTasksPage и ReadyPage,но раньше обходился без этого,а сейчас решил добить этот нюанс до конца.Помогите пожалуйста.

Вот обе части TransparentStatic,что и в какой части там надо дописать?Спасибо.

Код:

#include "TransparentStatic.iss"
[Setup]
WizardImageFile=2.bmp
SourceDir=.
OutputDir=.
AppName=Тест
AppVerName=Тест
AppVersion=Тест
DefaultDirName={pf}\Тест
DefaultGroupName=Тест
AllowNoIcons=yes
OutputBaseFilename=setup
SetupIconFile=D:\2.general games  ISDone 0.6final\0.ico
WindowVisible=no
WindowShowCaption=no
WindowResizable=no
Compression=lzma/ultra
SolidCompression=yes

[Files]
Source: CallbackCtrl.dll; Flags: dontcopy

CODE
procedure InitializeWizard();
var i:Integer;
begin
  StaticSetTransparent;
  WizardForm.WizardBitmapImage.Width := WizardForm.ClientWidth;
  WizardForm.WizardBitmapImage.Height := WizardForm.ClientHeight;
  WizardForm.WizardBitmapImage2.Width := WizardForm.ClientWidth;
  WizardForm.WizardBitmapImage2.Height := WizardForm.ClientHeight;
  for i:=0 to 14 do
    begin
      with TBitmapImage.Create(WizardForm) do
        begin
          Stretch:=True;
          SetBounds(-WizardForm.InnerNotebook.Left,-WizardForm.InnerNotebook.Top,WizardForm.ClientWidth,WizardForm.ClientHeight);
            Case i of
              0:
                begin
                  Parent:=WizardForm;
                  SetBounds(0,0,WizardForm.ClientWidth,WizardForm.ClientHeight);
                end;
              1:
                begin
                  Parent:=WizardForm.InnerPage;
                  SetBounds(0,0,WizardForm.ClientWidth,WizardForm.ClientHeight);
                end;
              2: Parent:=WizardForm.LicensePage;
              3: Parent:=WizardForm.PasswordPage;
              4: Parent:=WizardForm.InfoBeforePage;
              5: Parent:=WizardForm.UserInfoPage;
              6: Parent:=WizardForm.SelectDirPage;
              7: Parent:=WizardForm.SelectComponentsPage;
              8: Parent:=WizardForm.SelectProgramGroupPage;
              9: Parent:=WizardForm.SelectTasksPage;
              10: Parent:=WizardForm.ReadyPage;
              11: Parent:=WizardForm.PreparingPage;
              12: Parent:=WizardForm.InstallingPage;
              13: Parent:=WizardForm.InfoAfterPage;
            end;
          Bitmap:= WizardForm.WizardBitmapImage.Bitmap;
        end;
    end;
end;

procedure DeinitializeSetup;
begin
  StaticSetDefault;
end;

Код:

CODE
type
  TStaticTextProc = function(h:hWnd;Msg,wParam,lParam:Longint):Longint;

  TPaintStruct = record
    hdc: LongWord;
    fErase: BOOL;
    rcPaint: TRect;
    fRestore: BOOL;
    fIncUpdate: BOOL;
    rgbReserved: array[0..31] of Byte;
  end;

  TANewStatic = record
    Static  : TNewStaticText;
    OldProc : Longint;
  end;

  TANewEdit = record
    Static1  : TEdit;
    OldProc1 : Longint;
  end;

var
  ANewStatic : array of TANewStatic;
  ANewEdit : array of TANewEdit;

function WrapStaticTextProc(Callback: TStaticTextProc; ParamCount: Integer): Longword; external 'wrapcallbackaddr@files:CallbackCtrl.dll stdcall';
function GetWindowLong(hWnd: HWND; nIndex: Integer): Longint;  external 'GetWindowLongA@user32.dll stdcall';
function InvalidateRect(hWnd: HWND; lpRect: Longint; bErase: BOOL): BOOL; external 'InvalidateRect@user32.dll stdcall';
function GetAncestor(hwnd: HWND; gaFlags: UINT): HWND; external 'GetAncestor@user32.dll stdcall';
function GetClienTRect(hWnd: HWND; var lpRect: TRect): BOOL; external 'GetClientRect@user32.dll stdcall';
function GetDC(hWnd: HWND): LongWord; external 'GetDC@user32.dll stdcall'; 
function CreateCompatibleDC(DC: LongWord): LongWord; external 'CreateCompatibleDC@gdi32.dll stdcall';
function CreateCompatibleBitmap(DC: LongWord; Width, Height: Integer): HBITMAP; external 'CreateCompatibleBitmap@gdi32.dll stdcall';
function ReleaseDC(hWnd: HWND; hDC: LongWord): Integer; external 'ReleaseDC@user32.dll stdcall';
function SelectObject(DC: LongWord; p2: LongWord): LongWord; external 'SelectObject@gdi32.dll stdcall';
function GetWindowRect(hWnd: HWND; var lpRect: TRect): BOOL; external 'GetWindowRect@user32.dll stdcall';
function ScreenToClient(hWnd: HWND; var lpPoint: TPoint): BOOL; external 'ScreenToClient@user32.dll stdcall';
function CallWindowProc(lpPrevWndFunc: Longint; hWnd: HWND; Msg: UINT; wParam: Longint; lParam: Longint): Longint; external 'CallWindowProcA@user32.dll stdcall';
function BitBlt(DestDC: LongWord; X, Y, Width, Height: Integer; SrcDC: LongWord; XSrc, YSrc: Integer; Rop: DWORD): BOOL; external 'BitBlt@gdi32.dll stdcall';
function DeleteObject(p1: LongWord): BOOL; external 'DeleteObject@gdi32.dll stdcall';
function BeginPaint(hWnd: HWND; var lpPaint: TPaintStruct): LongWord; external 'BeginPaint@user32.dll stdcall';
function EndPaint(hWnd: HWND; const lpPaint: TPaintStruct): BOOL; external 'EndPaint@user32.dll stdcall';
function SetBkMode(DC: LongWord; BkMode: Integer): Integer; external 'SetBkMode@gdi32.dll stdcall'; 
function SetTextColor(DC: LongWord; Color: DWORD): DWORD; external 'SetTextColor@gdi32.dll stdcall'; 
function GetSysColor(nIndex: Integer): DWORD;  external 'GetSysColor@user32.dll stdcall';
function DrawText(hDC: LongWord; lpString: PAnsiChar; nCount: Integer; var lpRect: TRect; uFormat: UINT): Integer; external 'DrawTextA@user32.dll stdcall';
function SetWindowLong(hWnd: HWND; nIndex: Integer; dwNewLong: Longint): Longint; external 'SetWindowLongA@user32.dll stdcall';

function TEditProc(h:HWND;Msg,wParam,lParam:Longint):Longint;
var
  MemDC,DC:LongWord;
  hParent:HWND;
  r,rs:TRect;
  hBMP,hBMP2:HBITMAP;
  ps:TPaintStruct;
  ind:integer;
  TextFormat:Cardinal;
  p:TPoint;
  Color:Longint;
begin
  ind:=GetWindowLong(h,-21);
  if (Msg=$5) or (Msg=$3) then InvalidateRect(h,0,False);
  case Msg of
    $14: Result:=1;
    $F: begin
      Result:=0;
      hParent:=GetAncestor(h,1);
      GetClienTRect(hParent,r);
      DC:=GetDC(hParent);
      MemDC:=CreateCompatibleDC(DC);
      hBmp:=CreateCompatibleBitmap(DC,r.Right,r.Bottom);
      ReleaseDC(hParent,DC);
      SelectObject(MemDC,hBmp);
      DC:=BeginPaint(h,ps);
      SendMessage(hParent,$14,Longint(MemDC),0);
      CallWindowProc(GetWindowLong(hParent,-4),hParent,$F,Longint(MemDC),0);
//      if Length(ANewEdit[ind].Static1.Text)>0 then begin
        GetWindowRect(h,rs);
        p.X:=rs.Left;
        p.Y:=rs.Top;
        ScreenToClient(hParent,p);
        rs.Left:=p.X;
        rs.Top:=p.Y;
        p.X:=rs.Right;
        p.Y:=rs.Bottom;
        ScreenToClient(hParent,p);
        rs.Right:=p.X;
        rs.Bottom:=p.Y;
        SelectObject(MemDC,ANewEdit[ind].Static1.Font.Handle);
        SetBkMode(MemDC,1);
        if ANewEdit[ind].Static1.Font.Color<0 then Color:=GetSysColor(ANewEdit[ind].Static1.Font.Color and $000000FF)
          else Color:=ANewEdit[ind].Static1.Font.Color;
        SetTextColor(MemDC,Color);
        TextFormat:=0;
        DrawText(MemDC,PAnsiChar(ANewEdit[ind].Static1.Text),Length(ANewEdit[ind].Static1.Text),rs,TextFormat);
//      end;
      BitBlt(DC,ps.rcPaint.Left,ps.rcPaint.Top,ps.rcPaint.Right,ps.rcPaint.Bottom,MemDC,r.Left+rs.Left+ps.rcPaint.Left,r.Top+rs.Top+ps.rcPaint.Top,$00CC0020);
      EndPaint(h,ps);
      DeleteObject(hBmp2);
      DeleteObject(hBmp);
      DeleteObject(MemDC);
    end;
    else Result:=CallWindowProc(ANewEdit[ind].OldProc1,h,Msg,wParam,lParam);
  end;
end;

function StaticTextProc(h:HWND;Msg,wParam,lParam:Longint):Longint;
var
  MemDC,DC:LongWord;
  hParent:HWND;
  r,rs:TRect;
  hBMP,hBMP2:HBITMAP;
  ps:TPaintStruct;
  ind:integer;
  TextFormat:Cardinal;
  p:TPoint;
  Color:Longint;
begin
  ind:=GetWindowLong(h,-21);
  if (Msg=$5) or (Msg=$3) then InvalidateRect(h,0,False);
  case Msg of
    $14: Result:=1;
    $F: begin
      Result:=0;
      hParent:=GetAncestor(h,1);
      GetClienTRect(hParent,r);
      DC:=GetDC(hParent);
      MemDC:=CreateCompatibleDC(DC);
      hBmp:=CreateCompatibleBitmap(DC,r.Right,r.Bottom);
      ReleaseDC(hParent,DC);
      SelectObject(MemDC,hBmp);
      DC:=BeginPaint(h,ps);
      SendMessage(hParent,$14,Longint(MemDC),0);
      CallWindowProc(GetWindowLong(hParent,-4),hParent,$F,Longint(MemDC),0);
      if Length(ANewStatic[ind].Static.Caption)>0 then begin
        GetWindowRect(h,rs);
        p.X:=rs.Left;
        p.Y:=rs.Top;
        ScreenToClient(hParent,p);
        rs.Left:=p.X;
        rs.Top:=p.Y;
        p.X:=rs.Right;
        p.Y:=rs.Bottom;
        ScreenToClient(hParent,p);
        rs.Right:=p.X;
        rs.Bottom:=p.Y;
        SelectObject(MemDC,ANewStatic[ind].Static.Font.Handle); 
        SetBkMode(MemDC,1);
        if ANewStatic[ind].Static.Font.Color<0 then Color:=GetSysColor(ANewStatic[ind].Static.Font.Color and $000000FF) 
          else Color:=ANewStatic[ind].Static.Font.Color;
        SetTextColor(MemDC,Color);
        TextFormat:=0;
        if ANewStatic[ind].Static.WordWrap then TextFormat:=TextFormat or $10;
        DrawText(MemDC,PAnsiChar(ANewStatic[ind].Static.Caption),Length(ANewStatic[ind].Static.Caption),rs,TextFormat);
      end;
      BitBlt(DC,ps.rcPaint.Left,ps.rcPaint.Top,ps.rcPaint.Right,ps.rcPaint.Bottom,MemDC,r.Left+rs.Left+ps.rcPaint.Left,r.Top+rs.Top+ps.rcPaint.Top,$00CC0020);
      EndPaint(h,ps);
      DeleteObject(hBmp2);
      DeleteObject(hBmp);
      DeleteObject(MemDC);
    end;
    else Result:=CallWindowProc(ANewStatic[ind].OldProc,h,Msg,wParam,lParam);
  end;
end;

procedure AddStaticToArray(st:TNewStaticText);
var
  i:integer;
begin
  i:=GetArrayLength(ANewStatic);
  SetArrayLength(ANewStatic,i+1);
  ANewStatic[i].Static:=st;
  ANewStatic[i].OldProc:=GetWindowLong(st.Handle,-4);
  SetWindowLong(st.Handle,-21,i);
  SetWindowLong(st.Handle,-4,WrapStaticTextProc(@StaticTextProc,4));
end;

procedure StaticChange(c:TWinControl);
var
  i:integer;
begin
  for i:=0 to c.ControlCount-1 do
    if c.Controls[i] is TWinControl then begin
      if c.Controls[i] is TNewStaticText then AddStaticToArray(TNewStaticText(c.Controls[i]));
      if TWinControl(c.Controls[i]).ControlCount>0 then StaticChange(TWinControl(c.Controls[i]));
    end;
end;

procedure AddEditToArray(st:TEdit);
var
  i:integer;
begin
  i:=GetArrayLength(ANewEdit);
  SetArrayLength(ANewEdit,i+1);
  ANewEdit[i].Static1:=st;
  ANewEdit[i].OldProc1:=GetWindowLong(st.Handle,-4);
  SetWindowLong(st.Handle,-21,i);
  SetWindowLong(st.Handle,-4,WrapStaticTextProc(@TEditProc,4));
end;

procedure EditChange(c:TWinControl);
var
  i:integer;
begin
  for i:=0 to c.ControlCount-1 do
    if c.Controls[i] is TWinControl then begin
      if c.Controls[i] is TNewStaticText then AddStaticToArray(TNewStaticText(c.Controls[i]));
      if TWinControl(c.Controls[i]).ControlCount>0 then StaticChange(TWinControl(c.Controls[i]));
    end;
end;
procedure StaticSetTransparent;
begin
  //делаем "прозрачность" у статиков лежащих на WizardForm и его дочерних окнах
  StaticChange(WizardForm);
//  EditChange(WizardForm);
end;

procedure StaticSetDefault;
var
  i,i1:integer;
begin
  //возвращаем статикам оконные процедуры в зад
  for i:=0 to GetArrayLength(ANewStatic)-1 do
    SetWindowLong(ANewStatic[i].Static.Handle,-4,ANewStatic[i].OldProc);
  SetArrayLength(ANewStatic,0);
  for i1:=0 to GetArrayLength(ANewEdit)-1 do
    SetWindowLong(ANewEdit[i1].Static1.Handle,-4,ANewEdit[i1].OldProc1);
  SetArrayLength(ANewEdit,0);
end;

sergey3695 · 6 Мар 2014

ilzok17, никак через этот модуль. Вот ты написал,что давно внедряешь...то есть понимаешь как там работает...
Возможно:
1) Использовать изображение .bmp на задний фон.
2) Использовать IsPicture.dll или тот способ который там используется там, хотя тебе проще через библу.
3) Не исключено дописывание модуля...

малоли...чудеса случаются.

ilzok17 · 6 Мар 2014

sergey3695.Спасибо за советы,с ".bmp на задний фон" пробовал по всякому,но увы - не получилось,а IsPicture - помогло но отчасти:попробовал и IsPicture [0.01e],и IsPicture2,вроде всё нормально но столкнулся с такой проблемой: в WelcomeLable1(Вас приветствует......и т.д.)не поменять стиль шрифта,причём именно в заголовках,а остальные тексты(Lable2 и т.д.)меняются нормально в редакторе форм.
Ниже скрипт,подскажи пожалуйста как там изменить стиль текста в заголовках,всю ночь сидел,но так ничего и не вышло - уже крыша поехала.%)

Setup
SourceDir=.
OutputDir=.
AppName=My Application
AppVersion=1.5
DefaultDirName={pf}\My Application

[Files]
Source : IsPicture2.dll; Flags : dontcopy;
;Source: fon.avi; Flags: dontcopy
Source: fon.bmp; Flags: dontcopy

CODE
//----------------------------------------------------------------------------------\\
const // жирность шрифта
FW_DONTCARE = 0;
FW_THIN = 100;
FW_ULTRALIGHT = 200;
FW_LIGHT = 300;
FW_NORMAL = 400;
FW_MEDIUM = 500;
FW_DEMIBOLD = 600;
FW_BOLD = 700;
FW_ULTRABOLD = 800;
FW_BLACK = 900;

procedure IsPicInit(Handle : HWND);
external 'IsPicInit@files:IsPicture2.dll stdcall delayload';
// начало работы

procedure IsPicAddImg(fName : AnsiString);
external 'IsPicAddImg@files:IsPicture2.dll stdcall delayload';
// изображение на заднем фоне

procedure IsPicAddVideo(fName : AnsiString; l, t, w, h : Integer; test : Boolean);
external 'IsPicAddVideo@files:IsPicture2.dll stdcall delayload';
// видео на заднем фоне
// fName - имя файла
// l, t, w, h - положение и размер видео
// test показ сообщений об ошибках: True - с сообщениями, false - без сообщений
function IsPicReFont(OldFont: HWND; Size, Weight : Integer; Italic : Boolean; Name : AnsiString) : HWND;
external 'IsPicReFont@files:IsPicture2.dll stdcall delayload';
// подмена шрифта для борьбы с артефактами сглаживания
// Size - размер шрифта
// Weight - жирность
// Italic - наклонность
// Name -имя шрифта
procedure IsPicStopVideo;
external 'IsPicStopVideo@files:IsPicture2.dll stdcall delayload';
// остановка воспроизведения видео - после этой команды
// видео будет полностью выгружено

function IsPicChecVideo : Boolean;
external 'IsPicChecVideo@files:IsPicture2.dll stdcall delayload';
// проверка успешности загрузки видео

function IsPicChecSound : Boolean;
external 'IsPicChecSound@files:IsPicture2.dll stdcall delayload';
// проверка успешности загрузки звука

procedure IsPicPauseVideo(play : Boolean);
external 'IsPicPauseVideo@files:IsPicture2.dll stdcall delayload';
// пауза видео
// play -
// если значение True, то продолжаем воспроизводить
// если значение False, то ставим на паузу

procedure IsPicSetVolume(volume : Integer);
external 'IsPicSetVolume@files:IsPicture2.dll stdcall delayload';
// громкость видео от -10000 до 0.
// -10000 - минимальное значение
// 0 - максимальное значение

procedure IsPicDeInit;
external 'IsPicDeInit@files:IsPicture2.dll stdcall delayload';
// не забываем вызвать в DeinitializeSetup
//----------------------------------------------------------------------------------\\

procedure RunStop(Sender: TObject);
begin
IsPicPauseVideo(TNewCheckBox(Sender).Checked);
end;

procedure SetVolume(Sender: TObject);
begin
IsPicSetVolume(TTrackBar(Sender).Position);
end;

procedure InitializeWizard();
var
fName : AnsiString; // переменная для своего шрифта
begin
ExtractTemporaryFile('fon.bmp');
// ExtractTemporaryFile('fon.avi');

with WizardForm do
begin
WizardBitmapImage.Free;
WizardBitmapImage2.Free;
//----------------------------------------------------------------------------------\\
// подменяем шрифты
fName := 'Trebuchet MS'; // задаем желаемый шрифт
Font.Handle := IsPicReFont(Font.Handle, Font.Size, FW_DEMIBOLD, False, fName);
WelcomeLabel1.Font.Handle := IsPicReFont(WelcomeLabel1.Font.Handle, WelcomeLabel1.Font.Size, FW_BOLD, False, fName);
PageNameLabel.Font.Handle := IsPicReFont(PageNameLabel.Font.Handle, PageNameLabel.Font.Size, FW_BOLD, False, fName);
FinishedHeadingLabel.Font.Handle := IsPicReFont(FinishedHeadingLabel.Font.Handle, FinishedHeadingLabel.Font.Size, FW_BOLD, False, fName);
//----------------------------------------------------------------------------------\\
//----------------------------------------------------------------------------------\\
// цвет прозрачности - $000008. Указываем его для элементов,которые должны быть прозрачными
Color := $000008;
WelcomePage.Color := $000008;
InnerPage.Color := $000008;
FinishedPage.Color := $000008;
MainPanel.Color := $000008;
DirEdit.Color := $000008;
ReadyMemo.Color := $000008;
//----------------------------------------------------------------------------------\\
Font.Color := clYellow;
// запускам
IsPicInit(Handle);
end;
//----------------------------------------------------------------------------------\\
// добавляем изображение на задний фон
IsPicAddImg(ExpandConstant('{tmp}\fon.bmp'));
// добавляем видео на задний фон
IsPicAddVideo('fon.avi', 137, 113, 360, 200, True); // При окончательной компиляции меняем True на False
//----------------------------------------------------------------------------------\\

//----------------------------------------------------------------------------------\\
// проверяем успешность загрузки видео
if IsPicChecVideo then
begin
// чекбокс - Пуск - Пауза
with TNewCheckBox.Create(WizardForm) do
begin
Parent := WizardForm;
SetBounds(ScaleX(24), ScaleY(330), ScaleX(90), ScaleY(14));
Caption := 'Пуск - Пауза';
Checked := true;
OnClick := @RunStop;
end;
// трекбар - Громкость
if IsPicChecSound then
with TTrackBar.Create(WizardForm) do
begin
Parent := WizardForm;
SetBounds(ScaleX(138), ScaleY(326), ScaleX(100), ScaleY(23));
Min := -5000;
Max := 0;
Position := -3000;
TickMarks := tmBoth;
TickStyle := tsNone;
OnChange := @SetVolume;
end;
IsPicSetVolume(-3000);
end;
//----------------------------------------------------------------------------------\\
end;

procedure DeinitializeSetup();
begin
// завершаем работу
IsPicDeInit;
end;

ilzok17 · 6 Мар 2014

Всё!Победил эту проблему,ещё раз огромное спасибо sergey3695,без тебя не справился бы.

ilzok17 · 7 Мар 2014

Добрый день.Кто нибудь сталкивался с такой проблемой:я для проверки сис.требований использовал get_hw_caps v1.0.0.3 и всё было нормально,а клгда поставил себе видяху R9 290X ,то стало показывать только 1024mb,попробовал HWREQ v.1.0 и IsUtils 1.0,там ещё хуже - по 100-300mb и естественно везде видео выделено красным и сообщение о не соответствие конфигурации.Может есть ещё какие нибудь модули для проверки системных требований с поддержкой новых видеокарт,или в этих можноли что то подправить?Спасибо.

Shift85 · 7 Мар 2014

ilzok17, Попробуй:

type
PDisplay_Device = record
cb: DWord;
DeviceName: array [0..31] of char;
DeviceString: array [0..127] of char;
StateFlags: DWord;
DeviceID, DeviceKey: array [0..127] of char;
end;

TMixerCaps = record
vPid, vDriverVersion: DWord;
sName: array [0..31] of char;
Support, cDestinations: DWord;
end;

// Проверка версии Windows
#if Pos("4.", GetFileVersion(AddBackslash(GetEnv("windir")) + "Explorer.exe")) == 1
{Win9x}
TMemoryStatusEx = record
dwLength, dwMemoryLoad: DWord;
LoTotalPhys, LoAvailPhys, LoTotalPageFile, LoAvailPageFile,
LoTotalVirtual, LoAvailVirtual, LoAvailExtendedVirtual, HiTotalPhys,
HiAvailPhys, HiTotalPageFile, HiAvailPageFile, HiTotalVirtual, HiAvailVirtual,
HiAvailExtendedVirtual: Integer;
end;
function GlobalMemoryStatusEx(var lpBuffer: TMemoryStatusEx): Boolean;
external 'GlobalMemoryStatus@kernel32.dll stdcall';
#else
{WinNT}
TMemoryStatusEx = record
dwLength, dwMemoryLoad: DWord;
LoTotalPhys, HiTotalPhys, LoAvailPhys, HiAvailPhys,
LoTotalPageFile, HiTotalPageFile, LoAvailPageFile, HiAvailPageFile,
LoTotalVirtual, HiTotalVirtual, LoAvailVirtual, HiAvailVirtual, LoAvailExtendedVirtual,
HiAvailExtendedVirtual: Integer;
end;
function GlobalMemoryStatusEx(var lpBuffer: TMemoryStatusEx): Boolean;
external 'GlobalMemoryStatusEx@kernel32.dll stdcall';
#endif

const
DISPLAY_DEVICE_PRIMARY_DEVICE = 4;
oneMB = 1024*1024;
NeedMHz = 1800;
NeedVideoRAM = 128;
NeedSoundCard = 'Creative X-Fi';
NeedMB = 512;
NeedPageFile = 1024;

var
InfoPage: TWizardPage;
TopText, BottomText: TNewStaticText;
ChangeText: Boolean;
SystemPanel, ProcessorPanel, VideoPanel,
AudioPanel, RAMPanel, PageFilePanel: TMemo;
SystemVersionPanel, ProcessorMHzPanel, VideoRAMPanel,
AudioNamePanel, RAMTotalPanel, PageFileTotalPanel: TMemo;
lpCaps: TMixerCaps;
Version: TWindowsVersion;
MemoryEx: TMemoryStatusEx;
n, errCode: Integer;
Keys: TArrayOfString;
DeviceValue: Cardinal;
lpDisplayDevice: PDisplay_Device;

function GetSystemMetrics(nIndex: Integer): Integer;
external 'GetSystemMetrics@user32.dll stdcall';

function GetDeviceCaps(hDC, nIndex: Integer): Integer;
external 'GetDeviceCaps@GDI32 stdcall';

function CreateDC(lpDriverName, lpDeviceName, lpOutput: String; lpInitData: Integer): Integer;
external 'CreateDCA@GDI32 stdcall';

function EnumDisplayDevices(lpDevice, iDevNum: DWord; var lpDisplayDevice: PDisplay_Device; dwFlags: DWord): Boolean;
external 'EnumDisplayDevicesA@user32.dll stdcall';

function mixerGetDevCaps(uDeviceID: LongInt; var lpCaps: TMixerCaps; uSize: LongInt): LongInt;
external 'mixerGetDevCapsA@winmm.dll stdcall';

function mixerGetNumDevs: Integer;
external 'mixerGetNumDevs@winmm.dll stdcall';

// Дополнить число до кратного Multiple
function ToMultiple(Bytes, Multiple: Integer): Integer;
begin
if Abs(Bytes/Multiple) > Bytes/Multiple then
Result := (Bytes/Multiple + 1)*Multiple
else
Result := Bytes
end;

// Перевод числа в значение Бт/Кб/Мб/Гб/Тб (до 3х знаков после запятой)
function ByteOrTB(Bytes: Extended; noMB: Boolean): String;
begin
if not noMB then
Result := FloatToStr(Int(Bytes)) + ' Мб'
else
if Bytes < 1024 then
Result := FloatToStr(Int(Bytes)) + ' Бт'
else
if Bytes/1024 < 1024 then
Result := FloatToStr(round((Bytes/1024)*10)/10) + ' Кб'
else
if Bytes/oneMB < 1024 then
Result := FloatToStr(round(Bytes/oneMB*100)/100) + ' Мб'
else
if Bytes/oneMB/1000 < 1024 then
Result := FloatToStr(round(Bytes/oneMB/1024*1000)/1000) + ' Гб'
else
Result := FloatToStr(round(Bytes/oneMB/oneMB*1000)/1000) + ' Тб'
StringChange(Result, ',', '.')
end;

// Удаление начальных, конечных и повторных пробелов
function DelSp(String: String): String;
begin
while (Pos(' ', String) > 0) do Delete(String, Pos(' ', String), 1)
Result := Trim(String)
end;

function Size64(Hi, Lo: Integer): Extended;
begin
Result := Lo
if Lo < 0 then
Result := Result + $7FFFFFFF + $7FFFFFFF + 2
for Hi := Hi-1 downto 0 do Result := Result + $7FFFFFFF + $7FFFFFFF + 2
end;

function CheckCPU(NeedMHz: Integer): Boolean;
var
String: String;
begin
String := 'Hardware\Description\System\CentralProcessor'; RegGetSubkeyNames(HKLM, String, Keys) // Количество ядер
for n := 0 to GetArrayLength(Keys)-1 do
RegQueryStringValue(HKLM, String + '\' + Keys[n], 'ProcessorNameString', Keys[n])
if not RegQueryDWordValue(HKLM, String + '\0', '~MHz', DeviceValue) or (DeviceValue < NeedMHz) then
Exit
else
Result := True
end;

function CheckMemorySize(NeedRAM: Integer): Boolean;
begin
MemoryEx.dwLength := SizeOf(MemoryEx)
if not GlobalMemoryStatusEx(MemoryEx) then
MsgBox('Ошибка функции:' + #13 + 'GlobalMemoryStatusEx', mbError, mb_Ok)
else
if (ToMultiple(trunc(Size64(MemoryEx.HiTotalPhys, MemoryEx.LoTotalPhys)/oneMB), 16) < NeedRAM) then
Exit
else
Result := True
end;

procedure CreateCheckForm();
begin

TopText := TNewStaticText.Create(InfoPage)
with TopText do
begin
Parent := InfoPage.Surface
Left := 0
AutoSize := True
end

BottomText := TNewStaticText.Create(InfoPage)
with BottomText do
begin
Parent := InfoPage.Surface
Caption := 'Когда Вы будете готовы продолжить установку, нажмите «Далее».'
Font.Color := clBlack
Left := 0
Top := 200
AutoSize := True
end

SystemPanel := TMemo.Create(InfoPage)
with SystemPanel do
begin
Text := 'Система'
Alignment := taCenter
Parent := InfoPage.Surface
Left := ScaleX(0)
Top := ScaleY(33)
Width := ScaleX(100)
Height := ScaleY(22)
ReadOnly := True
Color := $EEEEEE
end

SystemVersionPanel := TMemo.Create(InfoPage)
with SystemVersionPanel do
begin
Alignment := taLeftJustify
Parent := InfoPage.Surface
Left := ScaleX(104)
Top := SystemPanel.Top
Width := ScaleX(310)
Height := ScaleY(22)
ReadOnly := True
end

ProcessorPanel := TMemo.Create(InfoPage)
with ProcessorPanel do
begin
Text := 'Процессор'
Alignment := taCenter
Parent := InfoPage.Surface
Left := ScaleX(0)
Top := SystemPanel.Top + 27
Width := ScaleX(100)
Height := ScaleY(22)
ReadOnly := True
Color := $EEEEEE
end

ProcessorMHzPanel := TMemo.Create(InfoPage)
with ProcessorMHzPanel do
begin
Alignment := taLeftJustify
Parent := InfoPage.Surface
Left := ScaleX(104)
Top := ProcessorPanel.Top
Width := ScaleX(310)
Height := ScaleY(22)
ReadOnly := True
end

VideoPanel := TMemo.Create(InfoPage)
with VideoPanel do
begin
Text := 'Видеоадаптер'
Alignment := taCenter
Parent := InfoPage.Surface
Left := ScaleX(0)
Top := ProcessorPanel.Top + 27
Width := ScaleX(100)
Height := ScaleY(22)
ReadOnly := True
Color := $EEEEEE
end

VideoRAMPanel := TMemo.Create(InfoPage)
with VideoRAMPanel do
begin
Alignment := taLeftJustify
Parent := InfoPage.Surface
Left := ScaleX(104)
Top := VideoPanel.Top
Width := ScaleX(310)
Height := ScaleY(22)
ReadOnly := True
end

AudioPanel := TMemo.Create(InfoPage)
with AudioPanel do
begin
Text := 'Звуковая карта'
Alignment := taCenter
Parent := InfoPage.Surface
Left := ScaleX(0)
Top := VideoPanel.Top + 27
Width := ScaleX(100)
Height := ScaleY(22)
ReadOnly := True
Color := $EEEEEE
end

AudioNamePanel := TMemo.Create(InfoPage)
with AudioNamePanel do
begin
Alignment := taLeftJustify
Parent := InfoPage.Surface
Left := ScaleX(104)
Top := AudioPanel.Top
Width := ScaleX(310)
Height := ScaleY(22)
ReadOnly := True
end

RAMPanel := TMemo.Create(InfoPage)
with RAMPanel do
begin
Text := 'Объём памяти'
Alignment := taCenter
Parent := InfoPage.Surface
Left := ScaleX(0)
Top := AudioPanel.Top + 27
Width := ScaleX(100)
Height := ScaleY(22)
ReadOnly := True
Color := $EEEEEE
end

RAMTotalPanel := TMemo.Create(InfoPage)
with RAMTotalPanel do
begin
Alignment := taLeftJustify
Parent := InfoPage.Surface
Left := ScaleX(104)
Top := RAMPanel.Top
Width := ScaleX(310)
Height := ScaleY(22)
ReadOnly := True
end

PageFilePanel := TMemo.Create(InfoPage)
with PageFilePanel do
begin
Text := 'Файл подкачки'
Alignment := taCenter
Parent := InfoPage.Surface
Left := ScaleX(0)
Top := RAMPanel.Top + 27
Width := ScaleX(100)
Height := ScaleY(22)
ReadOnly := True
Color := $EEEEEE
end;

PageFileTotalPanel := TMemo.Create(InfoPage)
with PageFileTotalPanel do
begin
Alignment := taLeftJustify
Parent := InfoPage.Surface
Left := ScaleX(104)
Top := PageFilePanel.Top
Width := ScaleX(310)
Height := ScaleY(22)
ReadOnly := True
end

end;

procedure UpdateInfo();
var
DeviceName, DeviceKey: String;
begin
ChangeText := False

GetWindowsVersionEx(Version)

// Операционная система:
SystemVersionPanel.Color := $CCFFCC

DeviceKey := 'Software\Microsoft\Windows NT\CurrentVersion'
if not UsingWinNT then StringChange(DeviceKey, 'Windows NT', 'Windows')
RegQueryStringValue(HKLM, DeviceKey, 'ProductName', DeviceName)
if RegQueryStringValue(HKLM, DeviceKey, 'CSDVersion', DeviceKey) then
DeviceName := DeviceName + ' ' + DeviceKey
StringChange(DeviceName, 'Microsoft ', '')
SystemVersionPanel.Text := ' ' + DeviceName + ' сборка ' + IntToStr(Version.Major) + '.' + IntToStr(Version.Minor) +
'.' + IntToStr(Version.Build)

if (Pos('2000 Service Pack 4', SystemVersionPanel.Text) = 0) and // Windows 2000 SP4
(Pos('XP Service Pack 2', SystemVersionPanel.Text) = 0) and // Windows XP SP2
(Pos('Vista', SystemVersionPanel.Text) = 0) and // Windows Vista (c любым SP или без него)
(Pos('Windows 7', SystemVersionPanel.Text) = 0) then
begin
SystemVersionPanel.Color := $CCCCFF
ChangeText := True
end

// Процессор:
ProcessorMHzPanel.Color := $CCFFCC

if not CheckCPU(NeedMHz) then
begin
ProcessorMHzPanel.Color := $CCCCFF
ChangeText := True
end

ProcessorMHzPanel.Text := ' ' + DelSp(Keys[0]) + ' @' + IntToStr(DeviceValue) + ' MHz'
if GetArrayLength(Keys) > 1 then
ProcessorPanel.Text := 'Процессоры' // + ' (' + IntToStr(GetArrayLength(Keys)) + ')'

// Видеокарта:
VideoRAMPanel.Color := $CCFFCC

lpDisplayDevice.cb := SizeOf(lpDisplayDevice)
DeviceKey := ''
n := 0
while not (EnumDisplayDevices(0, n, lpDisplayDevice, 0) and
(lpDisplayDevice.StateFlags and DISPLAY_DEVICE_PRIMARY_DEVICE > 0)) and (n < 127) do n := n + 1
for n := 0 to 127 do DeviceKey := DeviceKey + lpDisplayDevice.DeviceKey[n]
Delete(DeviceKey, Pos(Chr(0), DeviceKey), 127) // Ключ драйвера получаем из API
StringChange(DeviceKey, '\Registry\Machine\', '')
errCode := 1
DeviceValue := 0
if RegQueryBinaryValue(HKLM, DeviceKey, 'HardwareInformation.MemorySize', DeviceName) then
for n := 1 to Length(DeviceName) do
begin
DeviceValue := DeviceValue + Ord(DeviceName[n])*errCode
errCode := errCode*$100
end
else
if RegQueryDWordValue(HKLM, DeviceKey, 'HardwareInformation.MemorySize', DeviceValue) then
else
RegQueryDWordValue(HKLM, DeviceKey + '\Info', 'VideoMemory', DeviceValue)
DeviceName := ''
for n := 0 to 127 do DeviceName := DeviceName + lpDisplayDevice.DeviceString[n]
Delete(DeviceName, Pos(Chr(0), DeviceName), 127)

if DeviceName <> '' then
if DeviceValue > 0 then
VideoRAMPanel.Text := ' ' + DelSp(DeviceName) + ', '+ ByteOrTB(DeviceValue/oneMB, False)
else
VideoRAMPanel.Text := ' ' + DelSp(DeviceName) + ' (Standard), '+ ByteOrTB(DeviceValue/oneMB, False)
else
begin
VideoRAMPanel.Text := ' Драйвер устройства не обнаружен'
VideoRAMPanel.Color := $CCCCFF
ChangeText := True
end
if (DeviceValue/oneMB < NeedVideoRAM) then
begin
VideoRAMPanel.Color := $CCCCFF
ChangeText := True
end
VideoRAMPanel.Text := VideoRAMPanel.Text + ', ' + IntToStr(GetSystemMetrics(0)) + 'x' +
IntToStr(GetSystemMetrics(1)) + ' (' + IntToStr(GetDeviceCaps(CreateDC('DISPLAY','','',0),14) *
GetDeviceCaps(CreateDC('DISPLAY','','',0),12)) + ' bit)'

// Звуковая карта:
AudioNamePanel.Color := $CCFFCC

// for errCode := 0 to 1 do // Вывод основного звукового устройства
for errCode := 0 to mixerGetNumDevs do
begin
mixerGetDevCaps(errCode-1, lpCaps, SizeOf(lpCaps))
DeviceName := ' '
for n := 0 to 31 do DeviceName := DeviceName + lpCaps.sName[n]
Delete(DeviceName, Pos(Chr(0), DeviceName), 31)
Delete(DeviceName, Pos(' [', DeviceName), 31)
StringChange(DeviceName, 'SB ', 'Creative ')
Delete(DeviceName, Pos(' Audio', DeviceName), 31)
SetArrayLength(Keys, errCode)
if errCode > 0 then Keys[errCode-1] := DeviceName
end

if GetArrayLength(Keys) > 1 then
begin
AudioPanel.Text := 'Звуковые карты'
// AudioPanel.Text := 'Звуковые карты (' + IntToStr(GetArrayLength(Keys)) +')'
AudioNamePanel.Text := ''
for n := 1 to GetArrayLength(Keys) do
AudioNamePanel.Text := AudioNamePanel.Text + Keys[n-1] // + '(' + IntToStr(n) + ')'
end
else
if GetArrayLength(Keys) = 0 then
begin
AudioNamePanel.Text := ' Драйвер устройства не обнаружен'
AudioNamePanel.Color := $CCCCFF
ChangeText := True
end
else
AudioNamePanel.Text := Keys[0]
if Pos(NeedSoundCard, AudioNamePanel.Text) = 0 then
AudioNamePanel.Text := AudioNamePanel.Text + ' (рекомендуется ' + NeedSoundCard + ')'

// Объём памяти:
RAMTotalPanel.Color := $CCFFCC
if not CheckMemorySize(NeedMB) then
begin
RAMTotalPanel.Color := $CCCCFF
ChangeText := True
end
RAMTotalPanel.Text := ' ' + ByteOrTB(ToMultiple(trunc(Size64(MemoryEx.HiTotalPhys, MemoryEx.LoTotalPhys)/oneMB), 16), False) + ' всего, ' +
ByteOrTB(ToMultiple(trunc(Size64(MemoryEx.HiTotalPhys, MemoryEx.LoTotalPhys)/oneMB), 16) -
Size64(MemoryEx.HiAvailPhys, MemoryEx.LoAvailPhys)/oneMB, False) + ' используется, ' +
ByteOrTB(Size64(MemoryEx.HiAvailPhys, MemoryEx.LoAvailPhys)/oneMB, False) + ' свободно'

// Виртуальная память:
PageFileTotalPanel.Color := $CCFFCC
PageFileTotalPanel.Text := ' ' + ByteOrTB(Size64(MemoryEx.HiTotalPageFile, MemoryEx.LoTotalPageFile)/oneMB, False) + ' всего, ' +
ByteOrTB((Size64(MemoryEx.HiTotalPageFile, MemoryEx.LoTotalPageFile) -
Size64(MemoryEx.HiAvailPageFile, MemoryEx.LoAvailPageFile))/oneMB, False) + ' занято системным кэшем'
if Size64(MemoryEx.HiTotalPageFile, MemoryEx.LoTotalPageFile)/oneMB < NeedPageFile then
begin
PageFileTotalPanel.Color := $CCCCFF
ChangeText := True
end

if ChangeText = True then
begin
TopText.Top := 0
TopText.Caption := 'Не все компоненты удовлетворяют минимальным требованиям игры.' #13
'Пожалуйста, проверьте позиции, выделенные красным цветом.'
TopText.Font.Color := clRed
// WizardForm.NextButton.Enabled := False
end
else
begin
TopText.Caption := 'Все компоненты соответствуют минимальным требованиям игры.'
TopText.Font.Color := clGreen
TopText.Top := 8
// WizardForm.NextButton.Enabled := True
end
end;

procedure InitializeWizard();
begin
InfoPage := CreateCustomPage(wpLicense, 'Аппаратное и программное обеспечение',
'Программа установки обнаружила следующие наобходимые компоненты.')
CreateCheckForm() // Создание объектов TMemo, в которых будет выводится информация о системе
UpdateInfo() // Обновление информации о системе
end;

procedure CurPageChanged(CurPageID: Integer);
begin
if CurPageID = InfoPage.ID then UpdateInfo() // Обновление информации о системе
end;

ilzok17 · 7 Мар 2014

Shift85 написал(а):
ilzok17, Попробуй:

type
PDisplay_Device = record
cb: DWord;
DeviceName: array [0..31] of char;
DeviceString: array [0..127] of char;
StateFlags: DWord;
DeviceID, DeviceKey: array [0..127] of char;
end;

TMixerCaps = record
vPid, vDriverVersion: DWord;
sName: array [0..31] of char;
Support, cDestinations: DWord;
end;

// Проверка версии Windows
#if Pos("4.", GetFileVersion(AddBackslash(GetEnv("windir")) + "Explorer.exe")) == 1
{Win9x}
TMemoryStatusEx = record
dwLength, dwMemoryLoad: DWord;
LoTotalPhys, LoAvailPhys, LoTotalPageFile, LoAvailPageFile,
LoTotalVirtual, LoAvailVirtual, LoAvailExtendedVirtual, HiTotalPhys,
HiAvailPhys, HiTotalPageFile, HiAvailPageFile, HiTotalVirtual, HiAvailVirtual,
HiAvailExtendedVirtual: Integer;
end;
function GlobalMemoryStatusEx(var lpBuffer: TMemoryStatusEx): Boolean;
external 'GlobalMemoryStatus@kernel32.dll stdcall';
#else
{WinNT}
TMemoryStatusEx = record
dwLength, dwMemoryLoad: DWord;
LoTotalPhys, HiTotalPhys, LoAvailPhys, HiAvailPhys,
LoTotalPageFile, HiTotalPageFile, LoAvailPageFile, HiAvailPageFile,
LoTotalVirtual, HiTotalVirtual, LoAvailVirtual, HiAvailVirtual, LoAvailExtendedVirtual,
HiAvailExtendedVirtual: Integer;
end;
function GlobalMemoryStatusEx(var lpBuffer: TMemoryStatusEx): Boolean;
external 'GlobalMemoryStatusEx@kernel32.dll stdcall';
#endif

const
DISPLAY_DEVICE_PRIMARY_DEVICE = 4;
oneMB = 1024*1024;
NeedMHz = 1800;
NeedVideoRAM = 128;
NeedSoundCard = 'Creative X-Fi';
NeedMB = 512;
NeedPageFile = 1024;

var
InfoPage: TWizardPage;
TopText, BottomText: TNewStaticText;
ChangeText: Boolean;
SystemPanel, ProcessorPanel, VideoPanel,
AudioPanel, RAMPanel, PageFilePanel: TMemo;
SystemVersionPanel, ProcessorMHzPanel, VideoRAMPanel,
AudioNamePanel, RAMTotalPanel, PageFileTotalPanel: TMemo;
lpCaps: TMixerCaps;
Version: TWindowsVersion;
MemoryEx: TMemoryStatusEx;
n, errCode: Integer;
Keys: TArrayOfString;
DeviceValue: Cardinal;
lpDisplayDevice: PDisplay_Device;

function GetSystemMetrics(nIndex: Integer): Integer;
external 'GetSystemMetrics@user32.dll stdcall';

function GetDeviceCaps(hDC, nIndex: Integer): Integer;
external 'GetDeviceCaps@GDI32 stdcall';

function CreateDC(lpDriverName, lpDeviceName, lpOutput: String; lpInitData: Integer): Integer;
external 'CreateDCA@GDI32 stdcall';

function EnumDisplayDevices(lpDevice, iDevNum: DWord; var lpDisplayDevice: PDisplay_Device; dwFlags: DWord): Boolean;
external 'EnumDisplayDevicesA@user32.dll stdcall';

function mixerGetDevCaps(uDeviceID: LongInt; var lpCaps: TMixerCaps; uSize: LongInt): LongInt;
external 'mixerGetDevCapsA@winmm.dll stdcall';

function mixerGetNumDevs: Integer;
external 'mixerGetNumDevs@winmm.dll stdcall';

// Дополнить число до кратного Multiple
function ToMultiple(Bytes, Multiple: Integer): Integer;
begin
if Abs(Bytes/Multiple) > Bytes/Multiple then
Result := (Bytes/Multiple + 1)*Multiple
else
Result := Bytes
end;

// Перевод числа в значение Бт/Кб/Мб/Гб/Тб (до 3х знаков после запятой)
function ByteOrTB(Bytes: Extended; noMB: Boolean): String;
begin
if not noMB then
Result := FloatToStr(Int(Bytes)) + ' Мб'
else
if Bytes < 1024 then
Result := FloatToStr(Int(Bytes)) + ' Бт'
else
if Bytes/1024 < 1024 then
Result := FloatToStr(round((Bytes/1024)*10)/10) + ' Кб'
else
if Bytes/oneMB < 1024 then
Result := FloatToStr(round(Bytes/oneMB*100)/100) + ' Мб'
else
if Bytes/oneMB/1000 < 1024 then
Result := FloatToStr(round(Bytes/oneMB/1024*1000)/1000) + ' Гб'
else
Result := FloatToStr(round(Bytes/oneMB/oneMB*1000)/1000) + ' Тб'
StringChange(Result, ',', '.')
end;

// Удаление начальных, конечных и повторных пробелов
function DelSp(String: String): String;
begin
while (Pos(' ', String) > 0) do Delete(String, Pos(' ', String), 1)
Result := Trim(String)
end;

function Size64(Hi, Lo: Integer): Extended;
begin
Result := Lo
if Lo < 0 then
Result := Result + $7FFFFFFF + $7FFFFFFF + 2
for Hi := Hi-1 downto 0 do Result := Result + $7FFFFFFF + $7FFFFFFF + 2
end;

function CheckCPU(NeedMHz: Integer): Boolean;
var
String: String;
begin
String := 'Hardware\Description\System\CentralProcessor'; RegGetSubkeyNames(HKLM, String, Keys) // Количество ядер
for n := 0 to GetArrayLength(Keys)-1 do
RegQueryStringValue(HKLM, String + '\' + Keys[n], 'ProcessorNameString', Keys[n])
if not RegQueryDWordValue(HKLM, String + '\0', '~MHz', DeviceValue) or (DeviceValue < NeedMHz) then
Exit
else
Result := True
end;

function CheckMemorySize(NeedRAM: Integer): Boolean;
begin
MemoryEx.dwLength := SizeOf(MemoryEx)
if not GlobalMemoryStatusEx(MemoryEx) then
MsgBox('Ошибка функции:' + #13 + 'GlobalMemoryStatusEx', mbError, mb_Ok)
else
if (ToMultiple(trunc(Size64(MemoryEx.HiTotalPhys, MemoryEx.LoTotalPhys)/oneMB), 16) < NeedRAM) then
Exit
else
Result := True
end;

procedure CreateCheckForm();
begin

TopText := TNewStaticText.Create(InfoPage)
with TopText do
begin
Parent := InfoPage.Surface
Left := 0
AutoSize := True
end

BottomText := TNewStaticText.Create(InfoPage)
with BottomText do
begin
Parent := InfoPage.Surface
Caption := 'Когда Вы будете готовы продолжить установку, нажмите «Далее».'
Font.Color := clBlack
Left := 0
Top := 200
AutoSize := True
end

SystemPanel := TMemo.Create(InfoPage)
with SystemPanel do
begin
Text := 'Система'
Alignment := taCenter
Parent := InfoPage.Surface
Left := ScaleX(0)
Top := ScaleY(33)
Width := ScaleX(100)
Height := ScaleY(22)
ReadOnly := True
Color := $EEEEEE
end

SystemVersionPanel := TMemo.Create(InfoPage)
with SystemVersionPanel do
begin
Alignment := taLeftJustify
Parent := InfoPage.Surface
Left := ScaleX(104)
Top := SystemPanel.Top
Width := ScaleX(310)
Height := ScaleY(22)
ReadOnly := True
end

ProcessorPanel := TMemo.Create(InfoPage)
with ProcessorPanel do
begin
Text := 'Процессор'
Alignment := taCenter
Parent := InfoPage.Surface
Left := ScaleX(0)
Top := SystemPanel.Top + 27
Width := ScaleX(100)
Height := ScaleY(22)
ReadOnly := True
Color := $EEEEEE
end

ProcessorMHzPanel := TMemo.Create(InfoPage)
with ProcessorMHzPanel do
begin
Alignment := taLeftJustify
Parent := InfoPage.Surface
Left := ScaleX(104)
Top := ProcessorPanel.Top
Width := ScaleX(310)
Height := ScaleY(22)
ReadOnly := True
end

VideoPanel := TMemo.Create(InfoPage)
with VideoPanel do
begin
Text := 'Видеоадаптер'
Alignment := taCenter
Parent := InfoPage.Surface
Left := ScaleX(0)
Top := ProcessorPanel.Top + 27
Width := ScaleX(100)
Height := ScaleY(22)
ReadOnly := True
Color := $EEEEEE
end

VideoRAMPanel := TMemo.Create(InfoPage)
with VideoRAMPanel do
begin
Alignment := taLeftJustify
Parent := InfoPage.Surface
Left := ScaleX(104)
Top := VideoPanel.Top
Width := ScaleX(310)
Height := ScaleY(22)
ReadOnly := True
end

AudioPanel := TMemo.Create(InfoPage)
with AudioPanel do
begin
Text := 'Звуковая карта'
Alignment := taCenter
Parent := InfoPage.Surface
Left := ScaleX(0)
Top := VideoPanel.Top + 27
Width := ScaleX(100)
Height := ScaleY(22)
ReadOnly := True
Color := $EEEEEE
end

AudioNamePanel := TMemo.Create(InfoPage)
with AudioNamePanel do
begin
Alignment := taLeftJustify
Parent := InfoPage.Surface
Left := ScaleX(104)
Top := AudioPanel.Top
Width := ScaleX(310)
Height := ScaleY(22)
ReadOnly := True
end

RAMPanel := TMemo.Create(InfoPage)
with RAMPanel do
begin
Text := 'Объём памяти'
Alignment := taCenter
Parent := InfoPage.Surface
Left := ScaleX(0)
Top := AudioPanel.Top + 27
Width := ScaleX(100)
Height := ScaleY(22)
ReadOnly := True
Color := $EEEEEE
end

RAMTotalPanel := TMemo.Create(InfoPage)
with RAMTotalPanel do
begin
Alignment := taLeftJustify
Parent := InfoPage.Surface
Left := ScaleX(104)
Top := RAMPanel.Top
Width := ScaleX(310)
Height := ScaleY(22)
ReadOnly := True
end

PageFilePanel := TMemo.Create(InfoPage)
with PageFilePanel do
begin
Text := 'Файл подкачки'
Alignment := taCenter
Parent := InfoPage.Surface
Left := ScaleX(0)
Top := RAMPanel.Top + 27
Width := ScaleX(100)
Height := ScaleY(22)
ReadOnly := True
Color := $EEEEEE
end;

PageFileTotalPanel := TMemo.Create(InfoPage)
with PageFileTotalPanel do
begin
Alignment := taLeftJustify
Parent := InfoPage.Surface
Left := ScaleX(104)
Top := PageFilePanel.Top
Width := ScaleX(310)
Height := ScaleY(22)
ReadOnly := True
end

end;

procedure UpdateInfo();
var
DeviceName, DeviceKey: String;
begin
ChangeText := False

GetWindowsVersionEx(Version)

// Операционная система:
SystemVersionPanel.Color := $CCFFCC

DeviceKey := 'Software\Microsoft\Windows NT\CurrentVersion'
if not UsingWinNT then StringChange(DeviceKey, 'Windows NT', 'Windows')
RegQueryStringValue(HKLM, DeviceKey, 'ProductName', DeviceName)
if RegQueryStringValue(HKLM, DeviceKey, 'CSDVersion', DeviceKey) then
DeviceName := DeviceName + ' ' + DeviceKey
StringChange(DeviceName, 'Microsoft ', '')
SystemVersionPanel.Text := ' ' + DeviceName + ' сборка ' + IntToStr(Version.Major) + '.' + IntToStr(Version.Minor) +
'.' + IntToStr(Version.Build)

if (Pos('2000 Service Pack 4', SystemVersionPanel.Text) = 0) and // Windows 2000 SP4
(Pos('XP Service Pack 2', SystemVersionPanel.Text) = 0) and // Windows XP SP2
(Pos('Vista', SystemVersionPanel.Text) = 0) and // Windows Vista (c любым SP или без него)
(Pos('Windows 7', SystemVersionPanel.Text) = 0) then
begin
SystemVersionPanel.Color := $CCCCFF
ChangeText := True
end

// Процессор:
ProcessorMHzPanel.Color := $CCFFCC

if not CheckCPU(NeedMHz) then
begin
ProcessorMHzPanel.Color := $CCCCFF
ChangeText := True
end

ProcessorMHzPanel.Text := ' ' + DelSp(Keys[0]) + ' @' + IntToStr(DeviceValue) + ' MHz'
if GetArrayLength(Keys) > 1 then
ProcessorPanel.Text := 'Процессоры' // + ' (' + IntToStr(GetArrayLength(Keys)) + ')'

// Видеокарта:
VideoRAMPanel.Color := $CCFFCC

lpDisplayDevice.cb := SizeOf(lpDisplayDevice)
DeviceKey := ''
n := 0
while not (EnumDisplayDevices(0, n, lpDisplayDevice, 0) and
(lpDisplayDevice.StateFlags and DISPLAY_DEVICE_PRIMARY_DEVICE > 0)) and (n < 127) do n := n + 1
for n := 0 to 127 do DeviceKey := DeviceKey + lpDisplayDevice.DeviceKey[n]
Delete(DeviceKey, Pos(Chr(0), DeviceKey), 127) // Ключ драйвера получаем из API
StringChange(DeviceKey, '\Registry\Machine\', '')
errCode := 1
DeviceValue := 0
if RegQueryBinaryValue(HKLM, DeviceKey, 'HardwareInformation.MemorySize', DeviceName) then
for n := 1 to Length(DeviceName) do
begin
DeviceValue := DeviceValue + Ord(DeviceName[n])*errCode
errCode := errCode*$100
end
else
if RegQueryDWordValue(HKLM, DeviceKey, 'HardwareInformation.MemorySize', DeviceValue) then
else
RegQueryDWordValue(HKLM, DeviceKey + '\Info', 'VideoMemory', DeviceValue)
DeviceName := ''
for n := 0 to 127 do DeviceName := DeviceName + lpDisplayDevice.DeviceString[n]
Delete(DeviceName, Pos(Chr(0), DeviceName), 127)

if DeviceName <> '' then
if DeviceValue > 0 then
VideoRAMPanel.Text := ' ' + DelSp(DeviceName) + ', '+ ByteOrTB(DeviceValue/oneMB, False)
else
VideoRAMPanel.Text := ' ' + DelSp(DeviceName) + ' (Standard), '+ ByteOrTB(DeviceValue/oneMB, False)
else
begin
VideoRAMPanel.Text := ' Драйвер устройства не обнаружен'
VideoRAMPanel.Color := $CCCCFF
ChangeText := True
end
if (DeviceValue/oneMB < NeedVideoRAM) then
begin
VideoRAMPanel.Color := $CCCCFF
ChangeText := True
end
VideoRAMPanel.Text := VideoRAMPanel.Text + ', ' + IntToStr(GetSystemMetrics(0)) + 'x' +
IntToStr(GetSystemMetrics(1)) + ' (' + IntToStr(GetDeviceCaps(CreateDC('DISPLAY','','',0),14) *
GetDeviceCaps(CreateDC('DISPLAY','','',0),12)) + ' bit)'

// Звуковая карта:
AudioNamePanel.Color := $CCFFCC

// for errCode := 0 to 1 do // Вывод основного звукового устройства
for errCode := 0 to mixerGetNumDevs do
begin
mixerGetDevCaps(errCode-1, lpCaps, SizeOf(lpCaps))
DeviceName := ' '
for n := 0 to 31 do DeviceName := DeviceName + lpCaps.sName[n]
Delete(DeviceName, Pos(Chr(0), DeviceName), 31)
Delete(DeviceName, Pos(' [', DeviceName), 31)
StringChange(DeviceName, 'SB ', 'Creative ')
Delete(DeviceName, Pos(' Audio', DeviceName), 31)
SetArrayLength(Keys, errCode)
if errCode > 0 then Keys[errCode-1] := DeviceName
end

if GetArrayLength(Keys) > 1 then
begin
AudioPanel.Text := 'Звуковые карты'
// AudioPanel.Text := 'Звуковые карты (' + IntToStr(GetArrayLength(Keys)) +')'
AudioNamePanel.Text := ''
for n := 1 to GetArrayLength(Keys) do
AudioNamePanel.Text := AudioNamePanel.Text + Keys[n-1] // + '(' + IntToStr(n) + ')'
end
else
if GetArrayLength(Keys) = 0 then
begin
AudioNamePanel.Text := ' Драйвер устройства не обнаружен'
AudioNamePanel.Color := $CCCCFF
ChangeText := True
end
else
AudioNamePanel.Text := Keys[0]
if Pos(NeedSoundCard, AudioNamePanel.Text) = 0 then
AudioNamePanel.Text := AudioNamePanel.Text + ' (рекомендуется ' + NeedSoundCard + ')'

// Объём памяти:
RAMTotalPanel.Color := $CCFFCC
if not CheckMemorySize(NeedMB) then
begin
RAMTotalPanel.Color := $CCCCFF
ChangeText := True
end
RAMTotalPanel.Text := ' ' + ByteOrTB(ToMultiple(trunc(Size64(MemoryEx.HiTotalPhys, MemoryEx.LoTotalPhys)/oneMB), 16), False) + ' всего, ' +
ByteOrTB(ToMultiple(trunc(Size64(MemoryEx.HiTotalPhys, MemoryEx.LoTotalPhys)/oneMB), 16) -
Size64(MemoryEx.HiAvailPhys, MemoryEx.LoAvailPhys)/oneMB, False) + ' используется, ' +
ByteOrTB(Size64(MemoryEx.HiAvailPhys, MemoryEx.LoAvailPhys)/oneMB, False) + ' свободно'

// Виртуальная память:
PageFileTotalPanel.Color := $CCFFCC
PageFileTotalPanel.Text := ' ' + ByteOrTB(Size64(MemoryEx.HiTotalPageFile, MemoryEx.LoTotalPageFile)/oneMB, False) + ' всего, ' +
ByteOrTB((Size64(MemoryEx.HiTotalPageFile, MemoryEx.LoTotalPageFile) -
Size64(MemoryEx.HiAvailPageFile, MemoryEx.LoAvailPageFile))/oneMB, False) + ' занято системным кэшем'
if Size64(MemoryEx.HiTotalPageFile, MemoryEx.LoTotalPageFile)/oneMB < NeedPageFile then
begin
PageFileTotalPanel.Color := $CCCCFF
ChangeText := True
end

if ChangeText = True then
begin
TopText.Top := 0
TopText.Caption := 'Не все компоненты удовлетворяют минимальным требованиям игры.' #13
'Пожалуйста, проверьте позиции, выделенные красным цветом.'
TopText.Font.Color := clRed
// WizardForm.NextButton.Enabled := False
end
else
begin
TopText.Caption := 'Все компоненты соответствуют минимальным требованиям игры.'
TopText.Font.Color := clGreen
TopText.Top := 8
// WizardForm.NextButton.Enabled := True
end
end;

procedure InitializeWizard();
begin
InfoPage := CreateCustomPage(wpLicense, 'Аппаратное и программное обеспечение',
'Программа установки обнаружила следующие наобходимые компоненты.')
CreateCheckForm() // Создание объектов TMemo, в которых будет выводится информация о системе
UpdateInfo() // Обновление информации о системе
end;

procedure CurPageChanged(CurPageID: Integer);
begin
if CurPageID = InfoPage.ID then UpdateInfo() // Обновление информации о системе
end;

Спасибо,попробовал.Но к сожалению выдаёт такую ошибку:

Shift85 · 7 Мар 2014

ilzok17, Просто тег CODE лепит пробелы куда не попадя вот лови: http://rghost.ru/52885958

ilzok17 · 7 Мар 2014

Shift85 написал(а):
ilzok17, Просто тег CODE лепит пробелы куда не попадя вот лови: http://rghost.ru/52885958

Спасибо,но опять ошибка в том же месте,но чюток другая строка обозначена:

Shift85 · 7 Мар 2014

ilzok17, Странно у меня все окей.
Какая версия Inno Setup у тебя у меня (5.5.1.ee2 (a) build 121002)...

ilzok17 · 7 Мар 2014

Shift85 написал(а):
ilzok17, Странно у меня все окей.
Какая версия Inno Setup у тебя у меня (5.5.1.ee2 (a) build 121002)...

Расширенная 5.5.1.ee2 (u)Unicode.А туда .dll никаких не надо?

ilzok17 · 7 Мар 2014

Shift85 сейчас в виртуалку поставлю ASCII и попробую,может в этом причина.

Shift85 · 7 Мар 2014

ilzok17 написал(а):
Расширенная 5.5.1.ee2 (u)Unicode.А туда .dll никаких не надо?

Ставь расширенную анси на юникоде не робит. Нет тут dll никаких не надо.

ilzok17 · 7 Мар 2014

Shift85 написал(а):
Ставь расширенную анси на юникоде не робит. Нет тут dll никаких не надо.

Спасибо.Да,с ASCII получилось,я думаю может совсем перейти на ASCII,а то с Unicode много подобных проблем возникает.

Что касается модуля,то всё равно выдаёт ошибку - у меня оказывается видяха всего 1mb,а я то думал что хорошую,4гиговую купил :cry:

Edison007 · 7 Мар 2014

ilzok17 написал(а):
Спасибо,но опять ошибка в том же месте,но чюток другая строка обозначена:

Написано ведь что в конце строки не хватает символа ;
:stop:

ATTACUE · 8 Мар 2014

Приветствую или доброго Вам времени суток)

Столкнулся со следующей проблемой:

Около пары месяцев назад я натолкнулся на замечательный модуль: ISMD5Check от Shegorat'а и nik1967.
Вроде бы работает так, как я и хотел, но есть одна проблема - если нажать на иконку инсталлятора в панели задач (таскбар) в процессе проверки хеш суммы, то сама форма (MD5Form) сворачивается, но обратно - не разворачивается.
Причем после именно такого теста на сворачиваемость, то WizardForm, которая инициализируется после успешной проверки - так же страдает этой "болезнью", точнее не сворачивается по щелчку на иконку в таскбаре, пока не нажмешь системную кнопку "свернуть".
Если не щелкать по иконке на таскбаре вообще, то такая проблема не возникает.
ОС: Windows 7 x64 SP1 Максимальная, не самопал.
Если сам модуль инициализировать не через function InitializeSetup(): Boolean; как это сделано здесь, то данная проблема вроде отсутствует, но нужно именно через function InitializeSetup(): Boolean;.

Немного подредактированный пример во вложении обьяснит то, чего я бы хотел получить на выходе.
Заранее благодарен)

Wanterlude · 8 Мар 2014

Всем привет, запаковал все вот так:
-mprecomp+srep64+delta+lzma64:a1:mfbt4:d158m:fb273:mc1000:lc8
И не пойму как прописать распоковку, мучаюсь уже 2 дня, заранее спасибо!

Tixo · 8 Мар 2014

в окне выбора компонентов, вместо прозрачности молочный фон, мб ли это быть из-за кривой формы псд?
и как это исправить?
http://rghost.ru/52907445

Shift85 · 8 Мар 2014

Tixo, Замени в скрипте: http://rghost.ru/52907883

Tixo написал(а):
из-за кривой формы

Точно...

Inno Setup (создание инсталяционных пакетов)

Ветеран

Новичок

Ветеран

Новичок

Новичок

Новичок

Старожил

Новичок

Старожил

Новичок

Старожил

Новичок

Новичок

Старожил

Новичок

Ветеран

Новичок

Вложения

Мимокрокодил

Новичок

Старожил