Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  

Показать сообщение отдельно

Аватара для Johny777

Ветеран


Сообщения: 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,
Цитата saurn:
Небольшой вопрос по вашему примеру для отображения процентов http://forum.oszone.net/post-2123218-47.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;
//    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 Sanchezhttp://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;


Последний раз редактировалось Johny777, 04-04-2013 в 02:39.

Это сообщение посчитали полезным следующие участники:

Отправлено: 02:42, 03-04-2013 | #69