[AlekseyPopovv]

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

[El Sanchez]

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

CreateSolidBrush

Код:

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;

CreatePatternBrush

Код:

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 (в зависимости от того, что было выбрано ранее) автоматически меняют свое состояние, т.е. становятся не активными. Всегда должно быть активно не более одной кнопки.