Ветеран
Сообщения: 649
Благодарности: 444
|
Профиль
|
Отправить PM
| Цитировать
Gnom_aka_Lexander,
Цитата Gnom_aka_Lexander:
|
наоборот. несколько мелких функций гораздо оптимальнее одного здоровенного уродливого монстра. единственное, для дополнительной оптимизации есь смысл передавать TStrings со списком ресурсов , дабы не создавать для каждого ресурса отдельный объект TResourceStream. Создали и в цикле по списку выгружаем на диск, с очисткой после выгрузки. Это точно будет быстрее, чем столько-же раз создать и разрушить объект. »
|
В натуре. Цикл действительно ускорил скорость запуска, что видно на глаз по появлению кнопки в панели задач - теперь без тормозка.
в цикле создаём массив of TResourceStream, и сразу же извлекаем файл и разрушаем TResourceStream-ы и входной стринглист
Короче зацени function ExtractResource(var ResourceList: TStringList): Boolean; чуть ниже под спойлером! 
habib2302, vint56, saurn, вот обновлённый пример, он совместим с файлами из архива в моём предыдущем посте:
читать дальше »
Код:  #include "botva2.iss"
[Setup]
AppName=DrawImageExample by South.Tver
AppVerName=DrawImageExample by South.Tver
DefaultDirName={pf}\ImageExample
OutputBaseFilename=setup
RawDataResource=Botva:botva2.dll|bPic:bPic.png|LiPic:LiPic.png|aPic:aPic.png
[Code]
const
AXEL_YELLOW = $48c1ca;
RT_RCDATA = 10;
function ExtractResource(var ResourceList: TStringList): Boolean;
var
ResStreams: array of TResourceStream;
ResName, ResFile: String;
i: Integer;
begin
if ResourceList = nil then Exit;
Result := ResourceList.Count > 0;
SetArrayLength(ResStreams, ResourceList.Count);
try
for i := 0 to ResourceList.Count-1 do
try
ResName := Trim( Copy(ResourceList.Strings[i], 1, Pos(',', ResourceList.Strings[i])-1) );
ResFile := Trim( Copy(ResourceList.Strings[i], Pos(',', ResourceList.Strings[i])+1, Length(ResourceList.Strings[i])-Pos(',', ResourceList.Strings[i])) );
ResStreams[i] := TResourceStream.Create(HInstance, ResName, RT_RCDATA);
ResStreams[i].SaveToFile(ExpandConstant('{tmp}\') + ResFile);
Result := Result and FileExists(ExpandConstant('{tmp}\') + ResFile);
finally
ResStreams[i].Free;
end;
finally
ResourceList.Free;
end;
end;
procedure InitializeWizard;
var
PicHandle: THandle;
ResList: TStringList;
begin
ResList := TStringList.Create;
ResList.Add('_IS_BOTVA, botva2.dll'); // 'Имя ресурса, имя файла'
ResList.Add('_IS_BPIC, bPic.png');
ResList.Add('_IS_LIPIC, LiPic.png');
ResList.Add('_IS_APIC, aPic.png');
with WizardForm do
begin
WelcomePage.Color := AXEL_YELLOW;
MainPanel.Color := AXEL_YELLOW;
if ExtractResource(ResList) then
begin
PicHandle := ImgLoad(WelcomePage.Handle, ExpandConstant('{tmp}\aPic.png'), WizardBitmapImage.Left, WizardBitmapImage.Top, WizardBitmapImage.Width, WizardBitmapImage.Height, True, True);
WizardBitmapImage.Hide;
ImgSetVisibility(PicHandle, True);
ImgApplyChanges(WelcomePage.Handle);
PicHandle := ImgLoad(FinishedPage.Handle, ExpandConstant('{tmp}\bPic.png'), WizardBitmapImage2.Left, WizardBitmapImage2.Top, WizardBitmapImage2.Width, WizardBitmapImage2.Height, True, True);
WizardBitmapImage2.Hide;
ImgSetVisibility(PicHandle, True);
ImgApplyChanges(FinishedPage.Handle);
PicHandle := ImgLoad(MainPanel.Handle, ExpandConstant('{tmp}\LiPic.png'), WizardSmallBitmapImage.Left, WizardSmallBitmapImage.Top, WizardSmallBitmapImage.Width, WizardSmallBitmapImage.Height, True, True);
WizardSmallBitmapImage.Hide;
ImgSetVisibility(PicHandle, True);
ImgApplyChanges(MainPanel.Handle);
end;
end;
end;
procedure DeinitializeSetup;
begin
if FileExists(ExpandConstant('{tmp}\') + 'botva2.dll') then gdipShutDown;
end;
/////////////////////////////////////////////////////////////////////
procedure InitializeUninstallProgressForm();
var
PicHandle: THandle;
ResList: TStringList;
begin
with UninstallProgressForm do
begin
MainPanel.Color := AXEL_YELLOW;
ResList := TStringList.Create;
ResList.Add('_IS_BOTVA, botva2.dll');
ResList.Add('_IS_LIPIC, LIPic.png');
if ExtractResource(ResList) then
begin
PicHandle := ImgLoad(MainPanel.Handle, ExpandConstant('{tmp}\LiPic.png'), WizardSmallBitmapImage.Left, WizardSmallBitmapImage.Top, WizardSmallBitmapImage.Width, WizardSmallBitmapImage.Height, True, True);
WizardSmallBitmapImage.Hide;
ImgSetVisibility(PicHandle, True);
ImgApplyChanges(MainPanel.Handle);
end;
end;
end;
procedure DeinitializeUninstall();
begin
if FileExists(ExpandConstant('{tmp}\') + 'botva2.dll') then gdipShutDown;
end;
=======================================================================
insombia,
Цитата insombia:
|
Johny777 а как в твоем примере растянуть картинку на весь инсталл? как фоновой так и маленькой »
|
хочешь удивлю?
перед тем как сделать тот пример открыл пример ботвы ...\Inno Setup 5\Modules\South\botva2_example\image.iss и посмотрел как создать картинку. До этого ботву не использовал и не знал
потом открыл модуль где автор любезно под каждым прототипом функции по русски описал все входные аргументы и сделал пример!
цитирую описание к функции ImgLoad(...):
читать дальше »
Код: function ImgLoad(Wnd :HWND; FileName :PAnsiChar; Left, Top, Width, Height :integer; Stretch, IsBkg :boolean) :Longint; external 'ImgLoad@{tmp}\botva2.dll stdcall delayload';
//загружает изображение в память, сохраняет переданные параметры
//Wnd - хэндл окна, в котором будет выведено изображение
//FileName - файл изображения
//Left,Top - координаты верхнего левого угла вывода изображения (в координатах клиентской области Wnd)
//Width,Height - ширина, высота изображения
// если Stretch=True, то изображение будет растянуто/сжато в прямоугольной области
// Rect.Left:=Left;
// Rect.Top:=Top;
// Rect.Right:=Left+Width;
// Rect.Bottom:=Top+Height;
// если Stretch=False, то параметры Width,Height игнорируются и вычисляются самой ImgLoad, т.е. можно передать 0
//Stretch - масштабировать изображение или нет
//IsBkg - если IsBkg=True, изображение будет выведено на фоне формы,
// поверх него будут отрисованы графические объекты (TLabel, TBitmapImage и т.д.),
// затем поверх всего будут выведены изображения с флагом IsBkg=False
//возвращаемое значение - указатель на структуру, хранящей изображение и его парметры, приведенный к типу Longint
//изображения будут выведены в той последовательности, в которой вызывается ImgLoad
Напрашивается вопрос: Ты хоть сам пробовал немного разобраться прежде чем спрашивать?
короче настраивай последние в вышеупомянутой функции
...Width, Height :integer; Stretch, IsBkg :boolean) :Longint;
...ширина, высота - целочисленные значения (пиши при необходимости через ScaleY,X() ), растянуть, на фоне - булев значения): Longint;
===========================================================================
UPD:
saurn,
вот так:
читать дальше »
Код: [Setup]
AppName=MyApp
AppVerName=MyApp
DefaultDirname={pf}\MyApp
[Files]
Source: {fonts}\*; DestDir: {app}; Flags: external
[code ]
#ifdef UNICODE
#define A "W"
#else
#define A "A"
#endif
const
WM_USER = $0400;
// CCM_FIRST = $2000;
// CCM_SETBKCOLOR = CCM_FIRST + 1;
//
// PBS_SMOOTH = 01;
// PBS_VERTICAL = 04;
// PBM_SETRANGE = WM_USER+1;
PBM_SETPOS = WM_USER+2;
// PBM_DELTAPOS = WM_USER+3;
// PBM_SETSTEP = WM_USER+4;
// PBM_STEPIT = WM_USER+5;
// PBM_SETRANGE32 = WM_USER+6; // lParam = high, wParam = low
PBM_GETRANGE = WM_USER+7; // lParam = PPBRange or Nil
// // wParam = False: Result = high
// // wParam = True: Result = low
PBM_GETPOS = WM_USER+8;
// PBM_SETBARCOLOR = WM_USER+9; // lParam = bar color
// PBM_SETBKCOLOR = CCM_SETBKCOLOR; // lParam = bkColor
//
// { For Windows >= XP }
// PBS_MARQUEE = $08;
// PBM_SETMARQUEE = WM_USER+10;
//
// { For Windows >= Vista }
// PBS_SMOOTHREVERSE = $10;
//
// { For Windows >= Vista }
// PBM_GETSTEP = WM_USER+13;
// PBM_GETBKCOLOR = WM_USER+14;
// PBM_GETBARCOLOR = WM_USER+15;
// PBM_SETSTATE = WM_USER+16; { wParam = PBST_[State] (NORMAL, ERROR, PAUSED) }
// PBM_GETSTATE = WM_USER+17;
//
// { For Windows >= Vista }
// PBST_NORMAL = $0001;
// PBST_ERROR = $0002;
// PBST_PAUSED = $0003;
GWL_WNDPROC = -4;
type
LPARAM = Integer;
WPARAM = Integer;
LRESULT = Integer;
TFNWndProc = Integer;
function SetWindowLong(hWnd: HWND; nIndex: Integer; dwNewLong: Longint): Longint; external 'SetWindowLong{#A}@user32.dll stdcall';
function CallWindowProc(lpPrevWndFunc: TFNWndProc; hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; external 'CallWindowProc{#A}@user32.dll stdcall';
function SetWindowText(hWnd: HWND; lpString: String): BOOL; external 'SetWindowText{#A}@user32.dll stdcall';
var
OldProgressBarProc, hInstallStatusLabel, hInstallProgressBar: Longint;
function ProgressBarProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
var
UndefPosition, UndefMax: Longint;
begin
if Msg = PBM_SETPOS then
begin
UndefPosition := SendMessage(hInstallProgressBar, PBM_GETPOS, 0, 0);
UndefMax := SendMessage(hInstallProgressBar, PBM_GETRANGE, 0, 0);
SetWindowText( hInstallStatusLabel, Format('%s'#32'%s', [SetupMessage(msgStatusExtractFiles), FormatFloat('0.#0 %', (UndefPosition*100)/UndefMax)]) );
end;
Result := CallWindowProc(OldProgressBarProc, hWnd, Msg, wParam, lParam);
end;
procedure InitializeWizard();
begin
hInstallProgressBar := WizardForm.ProgressGauge.Handle;
OldProgressBarProc := SetWindowLong(WizardForm.ProgressGauge.Handle, GWL_WNDPROC, CallbackAddr('ProgressBarProc'));
hInstallStatusLabel := WizardForm.StatusLabel.Handle;
end;
procedure DeinitializeSetup();
begin
SetWindowlong(WizardForm.ProgressGauge.Handle, GWL_WNDPROC, OldProgressBarProc);
end;
//////////////////////////////////////////////////////////////////////
var
hUnistallProgress, hUninstallStatusLabel: Longint;
function UninstallProgressBarProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
var
UndefPosition, UndefMax: Longint;
begin
if Msg = PBM_SETPOS then
begin
UndefPosition := SendMessage(hUnistallProgress, PBM_GETPOS, 0, 0);
UndefMax := SendMessage(hUnistallProgress, PBM_GETRANGE, 0, 0);
SetWindowText( hUninstallStatusLabel, Format('%s'#32'%s', [FmtMessage(SetupMessage(msgStatusUninstalling), ['{#SetupSetting("AppName")}']), FormatFloat('0.#0 %', (UndefPosition*100)/UndefMax)]) );
end;
Result := CallWindowProc(OldProgressBarProc, hWnd, Msg, wParam, lParam);
end;
procedure UninstallFormOnHide(Sender: TObject);
begin
SetWindowlong(TUninstallProgressForm(Sender).ProgressBar.Handle, GWL_WNDPROC, OldProgressBarProc);
end;
procedure InitializeUninstallProgressForm();
begin
hUnistallProgress := UninstallProgressForm.ProgressBar.Handle;
hUninstallStatusLabel := UninstallProgressForm.StatusLabel.Handle;
OldProgressBarProc := SetWindowLong(hUnistallProgress, GWL_WNDPROC, CallbackAddr('UninstallProgressBarProc'));
UninstallProgressForm.OnHide := @UninstallFormOnHide;
end;
+ улучшил код:
1. Проценты отображаются в лучшем месте, чем в заголовке формы
2. Теперь никакого прямого обращения к контролам через оконную процедуру - всё обращение теперь на чистом WinApi (это гарантированно избавит от возможных ошибок) через адреса
PS: И обращайся на Ты, а то мне как-то не по себе!
UPD: Обновлённый пример благодаря правке El Sanchez-а http://forum.oszone.net/post-2125286-79.html
читать дальше »
Код: [Setup]
AppName=MyApp
AppVerName=MyApp
DefaultDirname={pf}\MyApp
[Files]
Source: {fonts}\*; DestDir: {app}; Flags: external
[code ]
#ifdef UNICODE
#define A "W"
#else
#define A "A"
#endif
const
WM_USER = $0400;
PBM_SETPOS = WM_USER+2;
GWL_WNDPROC = -4;
type
LPARAM = Integer;
WPARAM = Integer;
LRESULT = Integer;
TFNWndProc = Integer;
function SetWindowLong(hWnd: HWND; nIndex: Integer; dwNewLong: Longint): Longint; external 'SetWindowLong{#A}@user32.dll stdcall';
function CallWindowProc(lpPrevWndFunc: TFNWndProc; hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; external 'CallWindowProc{#A}@user32.dll stdcall';
function SetWindowText(hWnd: HWND; lpString: String): BOOL; external 'SetWindowText{#A}@user32.dll stdcall';
var
OldProgressBarProc: Longint;
function ProgressBarProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
if Msg = PBM_SETPOS then with WizardForm do SetWindowText( StatusLabel.Handle, Format('%s'#32'%s', [SetupMessage(msgStatusExtractFiles), FormatFloat('0.#0 %', (ProgressGauge.Position*100)/ProgressGauge.Max)]) );
Result := CallWindowProc(OldProgressBarProc, hWnd, Msg, wParam, lParam);
end;
procedure InitializeWizard();
begin
OldProgressBarProc := SetWindowLong(WizardForm.ProgressGauge.Handle, GWL_WNDPROC, CallbackAddr('ProgressBarProc'));
end;
procedure DeinitializeSetup();
begin
SetWindowlong(WizardForm.ProgressGauge.Handle, GWL_WNDPROC, OldProgressBarProc);
end;
/////////////////////////////// Uninstall //////////////////////////////////
function UninstallProgressBarProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
begin
if Msg = PBM_SETPOS then with UninstallProgressForm do SetWindowText( StatusLabel.Handle, Format('%s'#32'%s', [FmtMessage(SetupMessage(msgStatusUninstalling), ['{#SetupSetting("AppName")}']), FormatFloat('0.#0 %', (ProgressBar.Position*100)/ProgressBar.Max)]) );
Result := CallWindowProc(OldProgressBarProc, hWnd, Msg, wParam, lParam);
end;
procedure UninstallFormOnHide(Sender: TObject);
begin
SetWindowlong(TUninstallProgressForm(Sender).ProgressBar.Handle, GWL_WNDPROC, OldProgressBarProc);
end;
procedure InitializeUninstallProgressForm();
begin
OldProgressBarProc := SetWindowLong(UninstallProgressForm.ProgressBar.Handle, GWL_WNDPROC, CallbackAddr('UninstallProgressBarProc'));
UninstallProgressForm.OnHide := @UninstallFormOnHide;
end;
|
