Скрипты Inno Setup. Помощь и советы [часть 8]

[AlekseyPopovv]

Dodakaedr, Может не правильно выразился, мне надо поменять цвет окна во всех MsgBox...

[Dodakaedr]

Может не правильно выразился, мне надо поменять цвет окна во всех MsgBox... »
так задайте его, если по тому примеру то так FinishedForm.Color := clLime;

[AlekseyPopovv]

Dodakaedr, А как в стандартных MsgBox поменять цвет?

[solopavel]

Прошу помощи. В этой проге я дуб дубом, а в smart install maker у меня не получается это сделать. Накидайте пожалуйста образец скрипта для такой схемы:

При установке, нужно удалить из "программы" две папки с файлами полностью "aircraft_1" и "aircraft1_2", а также два файла "traffic_1.bgl" и "traffic_2.bgl". Создать папку с файлами "aircraft_3" и файл "traffic_3.bgl"

Я это вот, как дилетант, так себе это представляю:

[InstallDelete]
Type: files; Name: "traffic_1.bgl"{app}\"
Type: files; Name: "traffic_2.bgl"{app}\"
Type: files; Name: "aircraft_1l"{app}\"
Type: files; Name: "aircraft_2l"{app}\"
[Files]
Source: “traffic_3.bgl”; DestDir: “{app}”
Source: “aircraft_3”; DestDir: “{app}”

Заранее благодарен за ответ.

[El Sanchez]

А как в стандартных MsgBox поменять цвет? »
AlekseyPopovv, например, так:

[Setup]
AppName=test
AppVerName=test
DefaultDirName={tmp}\test
CreateAppDir=no
Uninstallable=no
CreateUninstallRegKey=no

[Languages]
Name: ru; MessagesFile: compiler:Languages\russian.isl

[Code]
#define A = (Defined UNICODE) ? "W" : "A"
const
WH_CBT = 5;
HCBT_CREATEWND = 3;
WC_DIALOG = '#32770';
WM_INITDIALOG = $0110;
WM_ERASEBKGND = $0014;
WM_PAINT = $000F;
WM_CTLCOLORSTATIC = $0138;
WM_CTLCOLORBTN = $0135;
WM_DESTROY = $0002;
TRANSPARENT = 1;

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

function GetCurrentThreadId: DWORD; external 'GetCurrentThreadId@kernel32.dll stdcall';
function CallNextHookEx(hhk: THandle; nCode: Integer; wParam, lParam: Longint): Longint; external 'CallNextHookEx@user32.dll stdcall';
function SetWindowsHookEx(idHook: Integer; lpfn, hMod: Longint; dwThreadId: DWORD): THandle; external 'SetWindowsHookEx{#A}@user32.dll stdcall';
function UnhookWindowsHookEx(hhk: THandle): BOOL; external 'UnhookWindowsHookEx@user32.dll stdcall';
function SetWindowSubclass(hWnd: HWND; pfnSubclass: Longint; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): BOOL; external 'SetWindowSubclass@comctl32.dll stdcall';
function RemoveWindowSubclass(hWnd: HWND; pfnSubclass: Longint; uIdSubclass: UINT_PTR): BOOL; external 'RemoveWindowSubclass@comctl32.dll stdcall';
function DefSubclassProc(hWnd: HWND; uMsg: UINT; wParam, lParam: Longint): Longint; external 'DefSubclassProc@comctl32.dll stdcall';
function GetClassName(hWnd: HWND; lpClassName: string; nMaxCount: Integer): Integer; external 'GetClassName{#A}@user32.dll stdcall';
function GetSysColorBrush(nIndex: Integer): THandle; external 'GetSysColorBrush@user32.dll stdcall';
function SetBkMode(hdc: THandle; iBkMode: Integer): Integer; external 'SetBkMode@gdi32.dll stdcall';
function BeginPaint(hWnd: HWND; var lpPaint: PAINTSTRUCT): Longint; external 'BeginPaint@user32.dll stdcall';
function EndPaint(hWnd: HWND; const lpPaint: PAINTSTRUCT): Boolean; external 'EndPaint@user32.dll stdcall';
function FillRect(hDC: THandle; const lprc: TRect; hbr: THandle): Integer; external 'FillRect@user32.dll stdcall';
function GetUpdateRect(hWnd: HWND; var lpRect: TRect; bErase: BOOL): BOOL; external 'GetUpdateRect@user32.dll stdcall';

var
GCBTProc, GDlgProc: Longint;
GDlgHook, GBgndBrush: THandle;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function DlgProc(hWnd: HWND; uMsg: UINT; wParam, lParam: Longint; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): Longint;
var
ps: PAINTSTRUCT;
rc: TRect;
begin
case uMsg of
WM_INITDIALOG:
begin
if GBgndBrush = 0 then
GBgndBrush := GetSysColorBrush(13{COLOR_HIGHLIGHT для примера});
Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
end;
WM_ERASEBKGND:
begin
GetUpdateRect(hWnd, rc, False);
FillRect(wParam, rc, GBgndBrush);
Result := 1;
end;
WM_PAINT:
begin
BeginPaint(hWnd, ps);
FillRect(ps.hdc, ps.rcPaint, GBgndBrush);
EndPaint(hWnd, ps);
end;
WM_CTLCOLORBTN, WM_CTLCOLORSTATIC:
begin
SetBkMode(wParam, TRANSPARENT);
Result := GBgndBrush;
end;
WM_DESTROY:
begin
RemoveWindowSubclass(hWnd, GDlgProc, 0);
Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
end;
else
Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
end;
end;

///////////////////////////////////////////////////////////////////
function CBTProc(nCode: Integer; wParam, lParam: Longint): Longint;
var
ClassName: string;
begin
case nCode of
HCBT_CREATEWND:
begin
ClassName := StringOfChar(#0, 64);
GetClassName(wParam, ClassName, Length(ClassName));
ClassName := TrimRight(ClassName);
case ClassName of
WC_DIALOG:
begin
if GDlgProc = 0 then
GDlgProc := CallbackAddr('DlgProc');
SetWindowSubclass(wParam, GDlgProc, 0, 0);
end;
end;
Result := 0;
end;
else
Result := CallNextHookEx(GDlgHook, nCode, wParam, lParam);
end;
end;

//////////////////
procedure HookDlg;
begin
if GCBTProc = 0 then
GCBTProc := CallbackAddr('CBTProc');
GDlgHook := SetWindowsHookEx(WH_CBT, GCBTProc, 0, GetCurrentThreadId);
end;

////////////////////
procedure UnHookDlg;
begin
UnhookWindowsHookEx(GDlgHook);
end;

///////////////////////////
procedure InitializeWizard;
begin
HookDlg;
end;

////////////////////////////
procedure DeinitializeSetup;
begin
if ExpandConstant('{wizardhwnd}') = '0' then Exit;
UnHookDlg;
end;

//////////////////////////////////////
function InitializeUninstall: Boolean;
begin
Result := True;
HookDlg;
end;

////////////////////////////////
procedure DeinitializeUninstall;
begin
UnHookDlg;
end;

[ZVSRus]

При установке, нужно удалить из "программы" две папки с файлами полностью "aircraft_1" и "aircraft1_2"
Как-то так.

[Files]
Source: "{app}\traffic_3.bgl"; DestDir: "{app}";
Source: "{app}\aircraft_3\*"; DestDir: "{app}\aircraft_3";

[InstallDelete]
Type: files; Name: "{app}\traffic_1.bgl";
Type: files; Name: "{app}\traffic_2.bgl";
Type: filesandordirs; Name: "{app}\aircraft_1l";
Type: filesandordirs; Name: "{app}\aircraft_2l";

[Dodakaedr]

например, так: »
есть где-то список номером цветов? Или как указать требуемый цвет? Как вы узнали чему равна цифра 13?

[El Sanchez]

есть где-то список номером цветов? Или как указать требуемый цвет? Как вы узнали чему равна цифра 13? »
Dodakaedr, дык, это ж параметр функции GetSysColorBrush (https://msdn.microsoft.com/en-us/library/dd144927%28v=vs.85%29.aspx), там в описании параметра к ней ссылка на GetSysColor (https://msdn.microsoft.com/en-us/library/ms724371%28v=vs.85%29.aspx), где представлены константы системных цветов. Я не стал в примере константу писать, влепил комментарий, чтобы обратили внимание на этот кусок кода. Вместо кисти с системным цветом здесь можно создать и использовать свою сплошную кисть с любым цветом при помощи CreateSolidBrush (https://msdn.microsoft.com/en-us/library/dd183518%28v=vs.85%29.aspx) или узорчатую при помощи CreatePatternBrush (https://msdn.microsoft.com/en-us/library/dd183508%28v=vs.85%29.aspx). Разумеется, при использовании пользовательских кистей обработка сообщений WM_* будет немного другой.

[Dodakaedr]

Вместо кисти с системным цветом здесь можно создать и использовать свою сплошную кисть с любым цветом при помощи CreateSolidBrush »
Если есть время набросайте, пожалуйста, пример.

[solopavel]

ZVSRus, спасибо за оперативный ответ.
Сейчас попробую.

[AlekseyPopovv]

Dodakaedr, Мне долго экспериментировать не пришлось, цифра 15 подошла.

[El Sanchez]

Если есть время набросайте, пожалуйста, пример. »

function CreateSolidBrush(crColor: DWORD): THandle; external 'CreateSolidBrush@gdi32.dll stdcall';
function DeleteObject(hObject: Longint): BOOL; external 'DeleteObject@gdi32.dll stdcall';

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function DlgProc(hWnd: HWND; uMsg: UINT; wParam, lParam: Longint; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): Longint;
var
ps: PAINTSTRUCT;
rc: TRect;
begin
case uMsg of
WM_INITDIALOG:
begin
GBgndBrush := CreateSolidBrush(clFuchsia{или в формате $BBGGRR});
Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
end;
WM_ERASEBKGND:
begin
GetUpdateRect(hWnd, rc, False);
FillRect(wParam, rc, GBgndBrush);
Result := 1;
end;
WM_PAINT:
begin
BeginPaint(hWnd, ps);
FillRect(ps.hdc, ps.rcPaint, GBgndBrush);
EndPaint(hWnd, ps);
end;
WM_CTLCOLORBTN, WM_CTLCOLORSTATIC:
begin
SetBkMode(wParam, TRANSPARENT);
Result := GBgndBrush;
end;
WM_DESTROY:
begin
DeleteObject(GBgndBrush);
RemoveWindowSubclass(hWnd, GDlgProc, 0);
Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
end;
else
Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
end;
end;



function CreatePatternBrush(hbmp: HBITMAP): THandle; external 'CreatePatternBrush@gdi32.dll stdcall';
function DeleteObject(hObject: Longint): BOOL; external 'DeleteObject@gdi32.dll stdcall';
function WindowFromDC(hDC: THandle): HWND; external 'WindowFromDC@user32.dll stdcall';
function MapWindowPoints(hWndFrom, hWndTo: HWND; var lpPoints: TPoint; cPoints: UINT): Integer; external 'MapWindowPoints@user32.dll stdcall';
function SetBrushOrgEx(hdc: Longint; nXOrg, nYOrg: Integer; var lppt: TPoint): BOOL; external 'SetBrushOrgEx@gdi32.dll stdcall';

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function DlgProc(hWnd: HWND; uMsg: UINT; wParam, lParam: Longint; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): Longint;
var
ps: PAINTSTRUCT;
rc: TRect;
pt: TPoint;
H: HWND;
begin
case uMsg of
WM_INITDIALOG:
begin
GBgndBrush := CreatePatternBrush(WizardForm.WizardSmallBitmapImage.Bitmap.Handle);
Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
end;
WM_ERASEBKGND:
begin
H := WindowFromDC(wParam);
if H <> 0 then
begin
MapWindowPoints(H, hWnd, pt, 1);
SetBrushOrgEx(wParam, -pt.x, -pt.y, pt);
end;
GetUpdateRect(hWnd, rc, False);
FillRect(wParam, rc, GBgndBrush);
Result := 1;
end;
WM_PAINT:
begin
BeginPaint(hWnd, ps);
FillRect(ps.hdc, ps.rcPaint, GBgndBrush);
EndPaint(hWnd, ps);
end;
WM_CTLCOLORBTN, WM_CTLCOLORSTATIC:
begin
H := WindowFromDC(wParam);
if H <> 0 then
begin
MapWindowPoints(H, hWnd, pt, 1);
SetBrushOrgEx(wParam, -pt.x, -pt.y, pt);
end;
SetBkMode(wParam, TRANSPARENT);
Result := GBgndBrush;
end;
WM_DESTROY:
begin
DeleteObject(GBgndBrush);
RemoveWindowSubclass(hWnd, GDlgProc, 0);
Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
end;
else
Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
end;
end;

[vovann01]

Я не хочу от вас "готовый код", мне бы просто сам способ узнать, пример какой-нить а дальше я как-нить будь сам) »
Когда-то давал пример, пробуйте Ссылка на пример »

То что вы мне скинули, это не то.

Мне нужно, что бы установщик СНАЧАЛА сохранял в архив файлы, которые уже лежат на компе, а только потом производилась установка. В случае, если установка произошла не удачно, то можно было бы эти все файлы во становить из архива. Я сам так и не смог найти нормальный пример этого

[ZVSRus]

Мне нужно, что бы установщик СНАЧАЛА сохранял в архив файлы, которые уже лежат на компе, а только потом производилась установка
Другими словами, перед установкой нужно сделать Backup файлов которые лежат на компе.
В справке как сделать Backup (Создать резервную копию оригинальных файлов) я насчитал около 10 примеров.
Где искать смотри на картинке.

[Naomi]

Помогите пожалуйста реализовать прилипание мастер формы к краям экрана отрисованной через ботву. Установлена расширенная юникод версия инно 5.5.1. Заранее благодарна :)

[El Sanchez]

реализовать прилипание мастер формы к краям экрана »
Naomi, пример:

[Setup]
AppName=test
AppVerName=test
DefaultDirName={tmp}
CreateAppDir=no
Uninstallable=no
CreateUninstallRegKey=no

[Languages]
Name: ru; MessagesFile: compiler:Languages\russian.isl

[Code]
#define A = (Defined UNICODE) ? "W" : "A"
const
SPI_GETWORKAREA = $0030;
WM_WINDOWPOSCHANGING = $0046;

type
TWindowPos = record
hwnd: HWND;
hwndInsertAfter: HWND;
x: Integer;
y: Integer;
cx: Integer;
cy: Integer;
flags: UINT;
end;

function SetWindowSubclass(hWnd: HWND; pfnSubclass: Longint; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): BOOL; external 'SetWindowSubclass@comctl32.dll stdcall';
function RemoveWindowSubclass(hWnd: HWND; pfnSubclass: Longint; uIdSubclass: UINT_PTR): BOOL; external 'RemoveWindowSubclass@comctl32.dll stdcall';
function DefSubclassProc(hWnd: HWND; uMsg: UINT; wParam, lParam: Longint): Longint; external 'DefSubclassProc@comctl32.dll stdcall';
function SystemParametersInfo(uiAction, uiParam: UINT; var pvParam: TRect; fWinIni: UINT): BOOL; external 'SystemParametersInfo{#A}@user32.dll stdcall';
function ReadProcessMemory(hProcess: THandle; lpBaseAddress: Longint; out lpBuffer: TWindowPos; nSize: DWORD; out lpNumberOfBytesRead: DWORD): BOOL; external 'ReadProcessMemory@kernel32.dll stdcall';
function WriteProcessMemory(hProcess: THandle; lpBaseAddress: Longint; var lpBuffer: TWindowPos; nSize: DWORD; out lpNumberOfBytesWritten: DWORD): BOOL; external 'WriteProcessMemory@kernel32.dll stdcall';
function GetCurrentProcess: THandle; external 'GetCurrentProcess@kernel32.dll stdcall';

var
GWndProc: Longint;
GSnapBuffer: Integer;

///////////////////////////////////////////////////////////////////////////
procedure HandleEdge(var Edge: Integer; SnapToEdge, SnapDistance: Integer);
begin
if (Abs(Edge + SnapDistance - SnapToEdge) < GSnapBuffer) then
Edge := SnapToEdge - SnapDistance;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function WndProc(hWnd: HWND; uMsg: UINT; wParam, lParam: Longint; uIdSubclass: UINT_PTR; dwRefData: DWORD_PTR): Longint;
var
LRect: TRect;
WindowPos: TWindowPos;
NumberOfBytesRead, NumberOfBytesWritten: DWORD;
begin
case uMsg of
WM_WINDOWPOSCHANGING:
begin
SystemParametersInfo(SPI_GETWORKAREA, 0, LRect, 0);
ReadProcessMemory(GetCurrentProcess, lParam, WindowPos, SizeOf(WindowPos), NumberOfBytesRead);
HandleEdge(WindowPos.x, LRect.Left, 0);
HandleEdge(WindowPos.y, LRect.Top, 0);
HandleEdge(WindowPos.x, LRect.Right, WizardForm.Width);
HandleEdge(WindowPos.y, LRect.Bottom, WizardForm.Height);
WriteProcessMemory(GetCurrentProcess, lParam, WindowPos, SizeOf(WindowPos), NumberOfBytesWritten);
Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
end;
else
Result := DefSubclassProc(hWnd, uMsg, wParam, lParam);
end;
end;

///////////////////////////
procedure InitializeWizard;
begin
GSnapBuffer := 50;
if GWndProc = 0 then
GWndProc := CallbackAddr('WndProc');
SetWindowSubclass(WizardForm.Handle, GWndProc, 0, 0);
end;

////////////////////////////
procedure DeinitializeSetup;
begin
if ExpandConstant('{wizardhwnd}') = '0' then Exit;
RemoveWindowSubclass(WizardForm.Handle, GWndProc, 0);
end;

[vovann01]

Другими словами, перед установкой нужно сделать Backup файлов которые лежат на компе.
В справке как сделать Backup (Создать резервную копию оригинальных файлов) я насчитал около 10 примеров.
Где искать смотри на картинке. »

именно так). Буду благодарен хотя бы за ссылки на 5 примеров) и у меня нет такой инструкции в программе.

[ZVSRus]

Буду благодарен хотя бы за ссылки на 5 примеров

[Setup]
AppName=MyProg
AppVerName=MyProg
DefaultDirName={pf}\MyProg
DefaultGroupName=MyProg
OutputDir=.

[Code]
var
MyTask: TCheckBox;

function MoveFile(const srcFile, destFile: PChar): Integer; external 'MoveFileA@kernel32.dll stdcall';

procedure CurStepChanged(CurStep: TSetupStep);
var
FindFiles: TFindRec;
i: integer;
MyFiles: array of string;
MyDir, BackDir: string;
begin
if CurStep=ssInstall then begin
if MyTask.Checked then begin
MyFiles:=['TS3.exe','gameplay.package','*.precomp','*.jpg']; // указать файлы или маски нужные для бакупа через запятую. при указании маски '*' бакупятся все файлы с вложенными папками
MyDir:=ExpandConstant('{app}'+'\Game\Bin\'); //папка откуда бакупить
BackDir:=ExpandConstant('{app}'+'\Backup\'); // папка куда бакупить
for i:=0 to GetArrayLength(MyFiles)-1 do
begin
if FindFirst(MyDir+MyFiles[i], FindFiles) then begin
repeat
if not DirExists(BackDir) then begin
CreateDir(BackDir);
end;
MoveFile(MyDir+FindFiles.Name, BackDir+FindFiles.Name);
until not FindNext(FindFiles);
FindClose(FindFiles);
end;
end;
end;
end;
end;

procedure InitializeWizard();
begin
MyTask:=TCheckBox.Create(WizardForm);
with MyTask do
begin
Parent:=WizardForm.SelectDirPage;
Caption:='Сделать Бэкап';
Left:=ScaleX(0);
Top:=ScaleY(100);
Width:=ScaleX(400);
Height:=ScaleY(15);
TabOrder:=0;
Checked:=True;
end;
end;

procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
var
FindFiles: TFindRec;
MyDir, BackDir: string;
begin
if CurUninstallStep = usPostUninstall then begin
MyDir:=ExpandConstant('{app}'+'\Game\Bin\'); //папка куда возвращать файлы
BackDir:=ExpandConstant('{app}'+'\Backup\'); // папка откуда брать файлы
if DirExists(BackDir) then begin
if MsgBox('Восстановить данные из бэкапа?', mbConfirmation, MB_YESNO) = IDYES then begin
if FindFirst(BackDir+'*', FindFiles) then begin
repeat
MoveFile(BackDir+FindFiles.Name, MyDir+FindFiles.Name);
until not FindNext(FindFiles);
FindClose(FindFiles);
RemoveDir(BackDir);
end;
end;
end;
end;
end;




;Как создать резервную копию во время установки, и кнопку перед установкой "Создать резервную копию оригинальных файлов" с галочкой?

[Setup]
AppName=My Program
AppVerName=My Program version 1.5
DefaultDirName={pf}\My Program
Compression=lzma
SolidCompression=yes
Uninstallable=no

[Tasks]
Name: arc; Description: "Create backup"

[Files]
Source: Files\*.*; DestDir: {app}; BeforeInstall: CreateBackup

[Code]
var
Page: TInputDirWizardPage;
ArcDir: String;

procedure CreateBackup();
var
SrcFile, DestFile: string;
begin
if IsTaskSelected('arc') then
begin
// if Not DirExists(ArcDir) then CreateDir(ArcDir);
ForceDirectories(ArcDir); // исправлено
SrcFile:= AddBackslash(ExpandConstant('{app}')) + ExtractFileName(CurrentFileName);
DestFile:= AddBackslash(ArcDir) + ExtractFileName(CurrentFileName);
FileCopy(SrcFile, DestFile, False);
end;
end;

function NextButtonClick(CurPageID: Integer): Boolean;
begin
If (CurPageID = Page.ID) then
ArcDir := Page.Values[0];
Result:= True;
end;

function ShouldSkipPage(PageID: Integer): Boolean;
begin
If (PageID = Page.ID) and
(Not IsTaskSelected('arc')) then
Result:= True
else Result:= False;
end;

procedure InitializeWizard();
begin
Page:= CreateInputDirPage(wpSelectTasks, 'Select Backup Location',
'Where should backup files be stored?',
'To continue, click Next.' + #10#13#10#13 +
'If you would like to select a different folder, click Browse.',
False, 'Backup');
Page.Add('');
//Page.Values[0] := ExpandConstant('{sd}\Backup');
Page.Values[0] := AddBackslash(ExpandConstant('{sd}\Backup')) +
GetDateTimeString('yyyy/mm/dd hh:nn', '_', '.' ); // исправлено
end;




Пример скрипта, автоматически создающего бэкапы в папки с именем по дате/времени. Кол-во бэкапов задается в скрипте. При превышении кол-ва, самые старые будут удалены.
#define MaxBackup 3

[Setup]
AppName=My Program
AppVerName=My Program version 1.5
DefaultDirName={pf}\My Program
Compression=lzma
SolidCompression=yes
Uninstallable=no

[Files]
Source: Files\*.*; DestDir: {app}; BeforeInstall: CreateBackup

[Code]
var
ArcDir: String;
DirNames: TStringList;

procedure CreateBackup();
var
SrcFile, DestFile: string;
begin
ArcDir:= AddBackslash(ExpandConstant('{app}\Backup')) +
GetDateTimeString('yyyy/mm/dd hh:nn', '_', '.' );
ForceDirectories(ArcDir);
SrcFile:= AddBackslash(ExpandConstant('{app}')) + ExtractFileName(CurrentFileName);
DestFile:= AddBackslash(ArcDir) + ExtractFileName(CurrentFileName);
FileCopy(SrcFile, DestFile, False);
end;

procedure GetBackupCount();
var
FindRec: TFindRec;
begin
if FindFirst(ExpandConstant('{app}\Backup\*'), FindRec) then begin
try
DirNames:= TStringList.Create();
DirNames.Sorted:= True;
repeat
if (FindRec.Attributes = FILE_ATTRIBUTE_DIRECTORY) and
(FindRec.Name <> '.') and (FindRec.Name <> '..') then
begin
DirNames.Append(FindRec.Name);
end;
until not FindNext(FindRec);
finally
FindClose(FindRec);
end;
end;
end;

procedure CurStepChanged(CurStep: TSetupStep);
var
i: integer;
begin
if CurStep = ssInstall then
begin
GetBackupCount();
if DirNames.Count >= StrToInt(ExpandConstant('{#MaxBackup}')) then
begin
for i:= DirNames.Count - StrToInt(ExpandConstant('{#MaxBackup}')) downto 0 do
begin
DelTree(ExpandConstant('{app}\Backup\') + DirNames[i], True, True, True);
end;
end;
end;
end;

[Nightwishh]

Вопрос по поводу модуля get_hw_caps.dll. Можно ли увеличить объём определяемой видео памяти (в модуле) таким образомVidRam:=GetVidMemLocal/1000000;
if (VidRam<63) or (VidRam>1100) then vr:=VidRam
else if VidRam<100 then vr:=64
else if VidRam<200 then vr:=128
else if VidRam<300 then vr:=256
else if VidRam<400 then vr:=384
else if VidRam<600 then vr:=512
else if VidRam<800 then vr:=792
else if VidRam>800 then vr:=1024

else if VidRam<1500 then vr:=1280
else if VidRam<2100 then vr:=2048
else if VidRam<2600 then vr:=2550
else if VidRam<3100 then vr:=3072;И нужно ли ли что то ещё дописывать?

[AlexanderSergeev]

Помогите решить проблему. Как сделать взаимоисключающий выбор для кнопок из 8 состояний (аналог CheckBox из botva) Если пользователь активирует мышкой кнопку-3, то кнопки-1 или 2 (в зависимости от того, что было выбрано ранее) автоматически меняют свое состояние, т.е. становятся не активными. Всегда должно быть активно не более одной кнопки.