1. Уважаемые гости и пользователи форума.
    Администрация настоятельно рекомендует не регистрировать несколько аккаунтов для одного пользователя. При выявлении наличия мультиаккаунтов будут заблокированы все учетные записи данного пользователя.
    Аккаунты, зарегистрированные на временную почту будут также заблокированы.

FAQ FAQ по Inno Setup

Тема в разделе "Inno Setup", создана пользователем Shegorat, 16 июн 2011.

Метки:
  1. Борода Модератор

    Регистрация:
    15 июн 2011
    Сообщения:
    718
    Симпатии:
    532
    Пол:
    Мужской
    В: Есть-ли альтернативные способы показа главного окна инсталлятора и деинсталлятора?
    О: Да, поскольку оно является родительским окном для рабочего окна (это так-же ответ на вопрос - можно-ли использовать IsPicture для деинсталлятора).
    Код (Text):
    [Setup]
    AppName=My Application
    AppVersion=1.5
    DefaultDirName={pf}\My Application

    [code]
    function GetWindow(H : HWND; U : UINT) : HWND;
      external 'GetWindow@user32.dll stdcall';
    function ShowWindow(H : HWND; SHOW : Integer) : HWND;
      external 'ShowWindow@user32.dll stdcall';

    procedure InitializeWizard();
    begin
      ShowWindow(GetWindow(WizardForm.Handle, 4), SW_SHOWMAXIMIZED);
    end;

    procedure InitializeUninstallProgressForm();
    begin
      ShowWindow(GetWindow(UninstallProgressForm.Handle, 4), SW_SHOWMAXIMIZED);
    end;
     
    Craj и Shift85 нравится это.
  2. Тех. админ Администратор

    Регистрация:
    26 дек 2011
    Сообщения:
    511
    Симпатии:
    601
    Пол:
    Мужской
    В: Как сделать собственную форму сообщения при нажатии на кнопку "Отмена"?
    О: Так
    Код (Text):
    [Setup]
    AppName=Custom Cancel Form
    AppVersion=1.0
    DefaultDirName={pf}\Custom Cancel Form
    AppPublisher=YURSHAT
    AppPublisherURL=http://krinkels.org

    [Languages]
    Name: "RU"; MessagesFile: "compiler:Languages\Russian.isl"

    [Code]
    const
      SND_ALIAS  = $10000;
      SND_ASYNC  = 1;
      SND_NOWAIT = $2000;

    var
      CancelForm: TSetupForm;
      YesButton: TNewButton;
      NoButton: TNewButton;
      FormClose: Boolean;

    function PlaySound(pszSound: PAnsiChar; hmod: Cardinal; fdwSound: DWORD): BOOL;
      external 'PlaySoundA@winmm stdcall';

    function PlaySystemSound(const Sound: String): BOOL;
    begin
      Result := PlaySound(PAnsiChar(Sound), 0, SND_ALIAS or SND_ASYNC or SND_NOWAIT);
    end;

    procedure CancelFormButtonClick(Sender: TObject);
    begin
      case TNewButton(Sender) of
        YesButton: FormClose := True;
        NoButton:  FormClose := False;
      end;
      CancelForm.Close;
    end;

    function ShowCancelMessage(): Boolean;
    begin
      CancelForm := CreateCustomForm();
      try
        PlaySystemSound('SystemQuestion');

        with CancelForm do
        begin
          ClientWidth := ScaleX(473);
          ClientHeight := ScaleY(129);
          BorderIcons := [];
          Caption := SetupMessage(msgExitSetupTitle);
          CenterInsideControl(WizardForm, False);
        end;

        with TLabel.Create(CancelForm) do
        begin
          Parent := CancelForm;
          SetBounds(ScaleX(60), ScaleY(10), ScaleX(400), ScaleY(80));
          AutoSize := False;
          Caption := SetupMessage(msgExitSetupMessage);
        end;

        YesButton := TNewButton.Create(CancelForm);
        with YesButton do
        begin
          Parent := CancelForm;
          SetBounds(ScaleX(157), ScaleY(95), ScaleX(75), ScaleY(23));
          OnClick := @CancelFormButtonClick;
          Caption := SetupMessage(msgButtonYes);
        end;

        NoButton := TNewButton.Create(CancelForm);
        with NoButton do
        begin
          Parent := CancelForm;
          SetBounds(ScaleX(241), ScaleY(95), ScaleX(75), ScaleY(23));
          OnClick := @CancelFormButtonClick;
          Caption := SetupMessage(msgButtonNo);
        end;

        CancelForm.ShowModal;
        Result := FormClose;
      finally
        CancelForm.Free;
      end;
    end;

    procedure CancelButtonClick(CurPageID: Integer; var Cancel, Confirm: Boolean);
    begin
      Confirm := False;
      Cancel := ShowCancelMessage;
    end;
     
    SBalykov нравится это.
  3. Старожил

    Регистрация:
    21 май 2013
    Сообщения:
    14
    Симпатии:
    6
    В: Как использовать системный MsgBox вместо встроенного MsgBox?
    О: Вот так:
    Код (Text):

    #ifdef UNICODE
      #define AW "W"
    #else
      #define AW "A"
    #endif

    [Setup]
    AppName=MyApp
    AppVersion=1.0
    DefaultDirName={pf}\MyApp
    OutputDir=.

    [Languages]
    Name: "RU"; MessagesFile: "compiler:Languages\Russian.isl"

    [Code]
    const
      MB_ICONNONE = $0;
      MB_ICONERROR = $10;
      MB_ICONQUESTION = $20;
      MB_ICONWARNING = $30;
      MB_ICONINFORMATION = $40;

    function MessageBox(hWnd : HWND; lpText, lpCaption : string; uType : UINT): Integer;
    external 'MessageBox{#AW}@user32.dll stdcall';

    function InitializeSetup(): Boolean;
    begin
      MessageBox(HWND, 'Hello, world!', 'Inno Setup', MB_OK or MB_ICONINFORMATION);
    end;
     
     
    Последнее редактирование: 21 апр 2016
    Kotyarko_O нравится это.
  4. Тех. админ Администратор

    Регистрация:
    26 дек 2011
    Сообщения:
    511
    Симпатии:
    601
    Пол:
    Мужской
    В: Как добавить описание компонентов при наведении курсора на компонент + превью в виде изображений?
    О: Можно так (реализация средствами Inno)
    Код (Text):
    [Setup]
    AppName=Моя программа
    AppVersion=1.5
    AppPublisher=YURSHAT
    AppPublisherURL=http://krinkels.org/
    DefaultDirName={pf}\Моя программа

    [Languages]
    Name: "RU"; MessagesFile: "compiler:Languages\Russian.isl"

    [CustomMessages]
    RU.CompName1=Компонент 1
    RU.CompName2=Компонент 2
    RU.ComponentsInfo=Наведите курсор мыши на компонент, чтобы прочитать его описание.
    RU.ComponentsImgInfo=Наведите курсор мыши на компонент, чтобы посмотреть его превью.
    RU.CompDesc1=Описание первого компонента
    RU.CompDesc2=Описание второго компонента

    [Files]
    Source: "compiler:WizModernImage.bmp"; DestName: "CompDescImg1.bmp"; Flags: dontcopy
    Source: "compiler:WizModernImage-IS.bmp"; DestName: "CompDescImg2.bmp"; Flags: dontcopy

    [Types]
    Name: full; Description: Full installation; Flags: iscustom

    [Components]
    Name: comp1; Description: "{cm:CompName1}"; Types: full
    Name: comp2; Description: "{cm:CompName2}"; Types: full

    [Code]
    type
      TComponentDesc = record
        Description: String;
        ImageName: String;
        Index: Integer;
      end;

    var
      CompDescs: array of TComponentDesc;
      CompDescPanel, CompDescImgPanel: TPanel;
      CompDescText: array[1..2] of TLabel;
      CompIndex, LastIndex: Integer;
      CompDescImg: TBitmapImage;

    procedure ShowCompDescription(Sender: TObject; X, Y, Index: Integer; Area: TItemArea);
    var
      i: Integer;
    begin
      if Index = LastIndex then Exit;
      CompIndex := -1;
      for i := 0 to GetArrayLength(CompDescs) -1 do
      begin
        if (CompDescs[i].Index = Index) then
        begin
          CompIndex := i;
          Break;
        end;
      end;
      if (CompIndex >= 0) and (Area = iaItem) then
      begin
        if not FileExists(ExpandConstant('{tmp}\') + CompDescs[CompIndex].ImageName) then
          ExtractTemporaryFile(CompDescs[CompIndex].ImageName);
        CompDescImg.Bitmap.LoadFromFile(ExpandConstant('{tmp}\') + CompDescs[CompIndex].ImageName);
        CompDescImg.Show;

        CompDescText[2].Caption := CompDescs[CompIndex].Description;
        CompDescText[2].Enabled := True;
      end else
      begin
        CompDescText[2].Caption := CustomMessage('ComponentsInfo');
        CompDescText[2].Enabled := False;
        CompDescImg.Hide;
      end;
      LastIndex := Index;
    end;

    procedure CompListMouseLeave(Sender: TObject);
    begin
      CompDescImg.Hide;
      CompDescText[2].Caption := CustomMessage('ComponentsInfo');
      CompDescText[2].Enabled := False;
      LastIndex := -1;
    end;

    procedure AddCompDescription(AIndex: Integer; ADescription: String; AImageName: String);
    var
      i: Integer;
    begin
      i := GetArrayLength(CompDescs);
      SetArrayLength(CompDescs, i + 1);
      CompDescs[i].Description := ADescription;
      CompDescs[i].ImageName := AImageName;
      CompDescs[i].Index := AIndex - 1
    end;

    procedure InitializeWizard();
    begin
      WizardForm.SelectComponentsLabel.Hide;
      WizardForm.TypesCombo.Hide;
      WizardForm.ComponentsList.SetBounds(ScaleX(0), ScaleY(0), ScaleX(184), ScaleY(205));
      WizardForm.ComponentsList.OnItemMouseMove:= @ShowCompDescription;
      WizardForm.ComponentsList.OnMouseLeave := @CompListMouseLeave;

      CompDescImgPanel := TPanel.Create(WizardForm);
      with CompDescImgPanel do
      begin
        Parent := WizardForm.SelectComponentsPage;
        SetBounds(ScaleX(192), ScaleY(0), ScaleX(225), ScaleY(120));
        BevelInner := bvLowered;
      end;

      CompDescText[1] := TLabel.Create(WizardForm);
      with CompDescText[1] do
      begin
        Parent := CompDescImgPanel;
        SetBounds(ScaleX(5), ScaleY(5), CompDescImgPanel.Width - ScaleX(10), CompDescImgPanel.Height - ScaleY(10));
        AutoSize := False;
        WordWrap := True;
        Enabled := False;
        Caption := CustomMessage('ComponentsImgInfo');
      end;

      CompDescImg := TBitmapImage.Create(WizardForm);
      with CompDescImg do
      begin
        Parent := CompDescImgPanel;
        SetBounds(ScaleX(5), ScaleY(5), CompDescImgPanel.Width - ScaleX(10), CompDescImgPanel.Height - ScaleY(10));
        Stretch := True;
        Hide;
      end;

      CompDescPanel := TPanel.Create(WizardForm);
      with CompDescPanel do
      begin
        Parent := WizardForm.SelectComponentsPage;
        SetBounds(ScaleX(192), ScaleY(125), ScaleX(225), ScaleY(80));
        BevelInner := bvLowered;
      end;

      CompDescText[2] := TLabel.Create(WizardForm);
      with CompDescText[2] do
      begin
        Parent := CompDescPanel;
        SetBounds(ScaleX(5), ScaleY(5), CompDescPanel.Width - ScaleX(10), CompDescPanel.Height - ScaleY(10));
        AutoSize := False;
        WordWrap := True;
        Enabled := False;
        Caption := CustomMessage('ComponentsInfo');
      end;

      AddCompDescription(1, CustomMessage('CompDesc1'), 'CompDescImg1.bmp');
      AddCompDescription(2, CustomMessage('CompDesc2'), 'CompDescImg2.bmp');
    end;
     
    infereni, Dossbot, AtotIK и 5 другим нравится это.
  5. Ветеран Модератор

    Регистрация:
    26 июн 2011
    Сообщения:
    970
    Симпатии:
    664
    В: Как определить разрешение экрана?
    О: Так
    Способ 1-3:
    Код (Text):
    [Setup]
    AppName=My Application
    AppVersion=1.5
    DefaultDirName={pf}\My Application

    [code]
    function GetDC(HWND: DWord): DWord; external 'GetDC@user32.dll stdcall';
    function GetDeviceCaps(DC: DWord; Index: Integer): Integer; external 'GetDeviceCaps@gdi32.dll stdcall';
    function ReleaseDC(HWND: DWord;DC: DWord): Integer; external 'ReleaseDC@user32.dll stdcall';

    function GetMonitorInfo(MetricType:Byte;Descriptor:THandle)  : Word;
    var
      dc: DWord;
    begin
      Result:= 0;
      case MetricType of
        1:  /// разрешение по ширине
        begin
          dc:= GetDC(Descriptor);
          Result:= GetDeviceCaps(dc,8);
        end;
        2: /// разрешение по высоте
        begin
          dc:= GetDC(Descriptor);
          Result:= GetDeviceCaps(dc,10);
        end;
       end;
      ReleaseDC(Descriptor,dc);
    end;

    // GetSystemMetrics - для второго способа онли.
    function GetSystemMetrics(nIndex: Integer): Integer; external 'GetSystemMetrics@user32.dll stdcall';

    procedure InitializeWizard();
    begin
      MsgBox('Разрешение монитора: ' + IntToStr(GetMonitorInfo(1,MainForm.Handle)) + ' x ' + IntToStr(GetMonitorInfo(2,MainForm.Handle)), mbConfirmation, MB_OK);
      MsgBox('Разрешение монитора 2: ' + IntToStr(GetSystemMetrics(0)) + ' x ' + IntToStr(GetSystemMetrics(1)), mbConfirmation, MB_OK);
      MsgBox('Разрешение монитора 3: ' + IntToStr(Screen.Width) + ' x ' + IntToStr(Screen.Height), mbConfirmation, MB_OK);
    end;
     
    Adil нравится это.
  6. Ветеран Модератор

    Регистрация:
    26 июн 2011
    Сообщения:
    970
    Симпатии:
    664
    В: Как воспроизвести видео, чтобы кнопки (и т.п.) были поверх него? (видео без звука!)
    О: Так (это не вариант конечно так грузить систему. ну а почему бы и нет?)
     

    Вложения:

    • Example.rar
      Размер файла:
      14,2 МБ
      Просмотров:
      74
    Adil и Хамик нравится это.
  7. Ветеран Модератор

    Регистрация:
    26 июн 2011
    Сообщения:
    970
    Симпатии:
    664
    В: Как скрыть сообщения деинсталлятора?
    О: Так
    Код (Text):
    function FindWindowEx(Parent, Child: HWND; ClassName, WindowName: PansiChar): HWND; external 'FindWindowExA@user32.dll stdcall';

    const
      BM_CLICK    = $00F5;
    var
      Timer: TTimer;
      msg: string;
      Wnd, WndEx: HWND;

    procedure OnTimer(Sender: TObject);
    begin
      Wnd:= FindWindowByWindowName(msg);
      if Wnd > 0 then
        begin
          WndEx:= FindWindowEx(Wnd, 0,'Button', '');
        if WndEx > 0 then
        begin
          PostMessage(WndEx, BM_CLICK, 0, 0);
          Timer.Enabled:= False;
        end;
      end;
    end;

    function InitializeUninstall:boolean;
    //var
    //  S: String;
    begin
    //if ActiveLanguage='rus' then
    //  S:= 'Вы действительно хотите удалить {#GameName}'+#10+'и все компоненты программы?'
    //else
    //  S:= 'Are you sure you want to completely remove {#GameName}'+#10+'and all of its components?';
    //if ShowMessageEx(S, '', MB_YESNO, mQuestion) = IDYES then
      Result := True;
      msg:= SetupMessage(msgUninstallAppFullTitle);
      StringChange(msg, '%1', '{#SetupSetting('AppName')}');
      OnTimer(nil);
      Timer:= TTimer.Create(nil);
      with Timer do
      begin
      OnTimer:= @OnTimer;
      Interval:= 1;
      Enabled:= True;
      end;
    end;

    procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
    begin
    if CurUninstallStep=usPostUninstall then
    begin
      OnTimer(nil);
      Timer:= TTimer.Create(nil);
      with Timer do
      begin
      OnTimer:= @OnTimer;
      Interval:= 1;
      Enabled:= True;
      end;
    end;
    end;
     
     
    Хамик и Adil нравится это.
  8. Ветеран Модератор

    Регистрация:
    26 июн 2011
    Сообщения:
    970
    Симпатии:
    664
    В: Как скрыть курсор?
    О: Так
    Код (Text):
    function ShowCursor(bShow: BOOL): BOOL; external 'ShowCursor@user32.dll stdcall';
    //...
        ShowCursor(false);
     
     
    Adil нравится это.
  9. Ветеран Модератор

    Регистрация:
    26 июн 2011
    Сообщения:
    970
    Симпатии:
    664
    В: Как скрыть таскбар?
    О: Так
    Код (Text):
    [Setup]
    AppName=1
    AppVersion=1
    DefaultDirName={pf}\1
    DefaultGroupName=1
    OutputDir=.

    [Code]
    var
      NewButton1: TNewButton;

    procedure NewButton1Click(Sender: TObject); forward;

    procedure RedesignWizardForm;
    begin
      { NewButton1 }
      NewButton1 := TNewButton.Create(WizardForm);
      with NewButton1 do
      begin
        Parent := WizardForm;
        Left := ScaleX(25);
        Top := WizardForm.NextButton.Top;
        Width := ScaleX(75);
        Height := ScaleY(25);
        Caption := 'TaskBar';
        OnClick := @NewButton1Click;
      end;
    end;

    function FindWindow(lpClassName, lpWindowName: PAnsiChar): HWND; external 'FindWindowA@user32.dll stdcall';
    function ShowWindow(hWnd: Integer; uType: Integer): Integer; external 'ShowWindow@user32.dll stdcall';

    VAR
      HTASKBAR : THANDLE;
      H: Boolean;

    procedure NewButton1Click(Sender: TObject);
    begin
      HTASKBAR := FindWindow('SHELL_TRAYWND', '');
    if not H then
    begin
      H:= true;
      SHOWWINDOW(HTASKBAR, SW_HIDE);
    end else begin
      H:= false;
      SHOWWINDOW(HTASKBAR, SW_SHOW);
    end;
    end;

    procedure InitializeWizard();
    begin
      RedesignWizardForm;
    end;
     
     
    Nemko и Adil нравится это.
  10. Ветеран Модератор

    Регистрация:
    26 июн 2011
    Сообщения:
    970
    Симпатии:
    664
    В: Добавление программы в автозапуск.
    О: Так
    Код (Text):
    Root: HKLM; Subkey: "Software\Microsoft\Windows\CurrentVersion\Run\"; ValueType: string; ValueName: "Название проги";  ValueData: "путь к проге (например: {app}\program.exe"; Flags: uninsdeletevalue;
    в [code_] аналогично с помощью RegWriteStringValue.
     
    Kotyarko_O нравится это.
  11. Ветеран Модератор

    Регистрация:
    26 июн 2011
    Сообщения:
    970
    Симпатии:
    664
    В: Как определить свободный объем памяти?
    О: Так
    Код (Text):
    [Setup]
    AppName=1
    AppVersion=1
    DefaultDirName={pf}\1
    DefaultGroupName=1
    OutputDir=.

    [Code]
    type
    #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

    var
      MemoryEx: TMemoryStatusEx;

    function ToMultiple(Bytes, Multiple: Integer): Integer;
    begin
      if Abs(Bytes/Multiple) > Bytes/Multiple then
         Result := (Bytes/Multiple + 1)*Multiple
      else
         Result := Bytes;
    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 NumToStr(Float: Extended): string;
    begin
      Result:= Format('%.2n', [Float]); StringChange(Result, ',', '.');
    while ((Result[Length(Result)] = '0') or (Result[Length(Result)] = '.')) and (Pos('.', Result) > 0) do
      SetLength(Result, Length(Result)-1);
    end;

    function MbOrTb(Byte: Extended): string;
    begin
    if Byte < 1024 then Result:= NumToStr(Byte) + ' MB' else
    if Byte/1024 < 1024 then Result:= NumToStr((Byte/1024*100)/100) + ' GB' else
      Result:= NumToStr(((Byte/(1024*1024))*100)/100) + ' TB';
    end;

    var
      Label1: TLabel;

    procedure RedesignWizardForm;
    begin
      { Label1 }
      Label1 := TLabel.Create(WizardForm);
      with Label1 do
      begin
        Parent := WizardForm;
        Caption := 'Label1';
        Left := ScaleX(32);
        Top:= WizardForm.NextButton.Top;
        Width := ScaleX(197);
        Height := ScaleY(16);
      end;

        MemoryEx.dwLength := SizeOf(MemoryEx)
      if not GlobalMemoryStatusEx(MemoryEx) then
        MsgBox('Ошибка функции:' + #13 + 'GlobalMemoryStatusEx', mbError, mb_Ok)
      else
        Label1.Caption:= MbOrTb(ToMultiple(trunc(Size64(MemoryEx.HiTotalPhys, MemoryEx.LoTotalPhys)/1048576), 16));
    end;

    procedure InitializeWizard();
    begin
      RedesignWizardForm;
    end;
     
    Tb на глубокое будущее. для кадлы ~86
     
    Последнее редактирование: 20 окт 2015
    Adil нравится это.
  12. Ветеран Модератор

    Регистрация:
    26 июн 2011
    Сообщения:
    970
    Симпатии:
    664
    В: Как запретить запуск установщика дважды с выводом сообщения на своей форме?
    О: Так
    Код (Text):

    //===== [AppId] =====\\:
    #define AppId "{1B32B3E4-A50C-473D-A36A-51E051F496A8}"
    //===== [Languages] =====\\:
    #define Languages

    [Setup]
    AppId={{#AppId}
    AppName=1
    AppVersion=1
    DefaultDirName={pf}\1
    DefaultGroupName=1
    OutputDir=.

    [Languages]
    #ifdef Languages
    Name: "eng"; MessagesFile: "compiler:Default.isl"
    #endif
    Name: "rus"; MessagesFile: "compiler:Languages\Russian.isl"

    [Code]
    #ifdef UNICODE
      #define A "W"
    #else
      #define A "A"
    #endif

    #include "ShowMessageEx.iss"
    #include "ExecAndWait.iss"

    const
      SYNCHRONIZE = $00100000;
      STANDARD_RIGHTS_REQUIRED = $000F0000;
      SEMAPHORE_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or $3);
      SEMAPHORE_UNIQUE_NAME = '{#AppId}';

    function CreateSemaphore(lpSemaphoreAttributes, lInitialCount, lMaximumCount: Longint; lpName: String): THandle; external 'CreateSemaphore{#A}@kernel32.dll stdcall';
    function OpenSemaphore(dwDesiredAccess: DWORD; bInheritHandle: BOOL; lpName: String): THandle; external 'OpenSemaphore{#A}@kernel32.dll stdcall';
    function ReleaseSemaphore(hSemaphore: THandle; lReleaseCount: Longint; lpPreviousCount: Longint): BOOL; external 'ReleaseSemaphore@kernel32.dll stdcall';

    var
      hSemaphore: THandle;
      Lang: boolean;

    function InitializeSetup(): Boolean;
    var
      msg: string;
    begin
    if ActiveLanguage = 'rus' then
      Lang:= True;
      Result := OpenSemaphore(SEMAPHORE_ALL_ACCESS, False, SEMAPHORE_UNIQUE_NAME) = 0;
      msg:= SetupMessage(msgSetupAppRunningError);
      StringChange(msg, '%1', '{#SetupSetting('AppName')}');
    if Lang then
      StringChange(msg, 'затем ', 'затем'+#13);
    if not Result then
    if ShowMessageEx(msg, SetupMessage(msgSetupAppTitle), MB_OKCANCEL, mError) = IDOK then
    #ifdef Languages
    if Lang then
      ExecAndWait(ExpandConstant('{srcexe}'), '/LANG=rus', SW_SHOW, false, 0)
    else
      ExecAndWait(ExpandConstant('{srcexe}'), '/LANG=eng', SW_SHOW, false, 0);
    #else
      ExecAndWait(ExpandConstant('{srcexe}'), '', SW_SHOW, false, 0);
    #endif
      hSemaphore := CreateSemaphore(0, 1, 1, SEMAPHORE_UNIQUE_NAME);
    end;

    procedure DeinitializeSetup();
    begin
      ReleaseSemaphore(hSemaphore, 1, 0);
      CloseHandle(hSemaphore);
    end;
     
     

    Вложения:

    Последнее редактирование: 6 дек 2014
    Natrix, Косой, SBalykov и ещё 1-му нравится это.
  13. Ветеран Модератор

    Регистрация:
    26 июн 2011
    Сообщения:
    970
    Симпатии:
    664
    В: Как отрисовать миниатюру (без использования скина)?
    О: Так
    Код (Text):
    [Setup]
    AppName=1
    AppVersion=1
    DefaultDirName={pf}\1
    DefaultGroupName=1
    OutputDir=.

    [Code]
    var
      Form: TForm;
      Timer: TTimer;

    function GetDC(hWnd: HWND): LongWord; external 'GetDC@user32 stdcall';
    function BitBlt(DestDC: LongWord; X, Y, Width, Height: Integer; SrcDC: LongWord; XSrc, YSrc: Integer; Rop: DWORD): BOOL; external 'BitBlt@gdi32 stdcall';
    function ReleaseDC(hWnd: HWND; hDC: LongWord): Integer; external 'ReleaseDC@user32.dll stdcall';
    function DwmIsCompositionEnabled(var pfEnabled: BOOL): Longint; external 'DwmIsCompositionEnabled@dwmapi.dll stdcall delayload';

    function isWin6: boolean;var ver: TWindowsVersion;
    begin
      GetWindowsVersionEx(ver);
    if (ver.Major >= 6) then result:=true
    else result:=false;
    end;

    function CompositionEnabled: boolean;var r: bool;
    begin
    if isWin6 then
    if DwmIsCompositionEnabled(r) = 0 then
      result:=r else result:=false;
    end;

    procedure FormT(Sender: TObject);
    var
      FormDC, DC: LongWord;
    begin
      DC:= GetDC(Form.Handle);
      FormDC := GetDC(WizardForm.Handle);
      BitBlt(DC, 0, 0, WizardForm.ClientWidth, WizardForm.ClientHeight, FormDC, 0, 0, $00CC0020);
      ReleaseDC(Form.Handle, DC);
      ReleaseDC(WizardForm.Handle, FormDC);
    end;

    procedure FormM(Sender: TObject);
    begin
    if CompositionEnabled then
      Timer.Enabled:= false;
    end;

    procedure FormR(Sender: TObject);
    begin
    if CompositionEnabled then
      Timer.Enabled:= True;
    end;

    procedure  InitializeWizard;
    begin
    if CompositionEnabled then begin
      Form:= TForm.Create(MainForm);
    with Form do
    begin
      ClientWidth:= WizardForm.ClientWidth;
      ClientHeight:= WizardForm.ClientHeight;
      Left:= -10000;
      Show;
    end;
      Timer := TTimer.Create(MainForm);
    with Timer do
    begin
      Interval:= 1;
      OnTimer:=  @FormT;
    end;
    end;
      Application.OnMinimize:= @FormM;
      Application.OnRestore:= @FormR;
    end;
     
     
    Последнее редактирование: 7 дек 2014
    Shift85 и Adil нравится это.
  14. Ветеран Модератор

    Регистрация:
    26 июн 2011
    Сообщения:
    970
    Симпатии:
    664
    В: Как отрисовать миниатюру используя библиотеку VCL Styles?
    О: Так
    Код (Text):
    #define AW = (Defined UNICODE) ? "W" : "A"

    [Setup]
    AppName=VCL Styles
    AppVersion=1.5
    DefaultDirName={pf}\VCL Styles
    Compression=none
    OutputDir=.

    [Languages]
    Name: "RU"; MessagesFile: "compiler:Languages\Russian.isl"

    [Files]
    Source: "VclStylesinno.dll"; Flags: dontcopy
    Source: "Amakrits.vsf"; Flags: dontcopy

    [Code]
    var
      TestForm: TSetupForm;
      Timer: TTimer;
      OldProc: Longint;

    procedure LoadVCLStyle(VClStyleFile: String); external 'LoadVCLStyle{#AW}@files:VclStylesinno.dll stdcall';
    procedure UnLoadVCLStyles; external 'UnLoadVCLStyles@files:VclStylesinno.dll stdcall';

    function GetDC(hWnd: HWND): LongWord; external 'GetDC@user32 stdcall';
    function BitBlt(DestDC: LongWord; X, Y, Width, Height: Integer; SrcDC: LongWord; XSrc, YSrc: Integer; Rop: DWORD): BOOL; external 'BitBlt@gdi32 stdcall';
    function ReleaseDC(hWnd: HWND; hDC: LongWord): Integer; external 'ReleaseDC@user32.dll stdcall';
    function DwmIsCompositionEnabled(var pfEnabled: BOOL): Longint; external 'DwmIsCompositionEnabled@dwmapi.dll stdcall delayload';

    function isWin6: boolean;var ver: TWindowsVersion;
    begin
      GetWindowsVersionEx(ver);
    if (ver.Major >= 6) then result:=true
    else result:=false;
    end;

    function CompositionEnabled: boolean;var r: bool;
    begin
    if isWin6 then
    if DwmIsCompositionEnabled(r) = 0 then
      result:=r else result:=false;
    end;

    procedure FormT(Sender: TObject);
    var
      FormDC, DC: LongWord;
    begin
      DC:= GetDC(TestForm.Handle);
      FormDC := GetDC(WizardForm.Handle);
      BitBlt(DC, 0, 0, WizardForm.ClientWidth, WizardForm.ClientHeight, FormDC, 0, 0, $00CC0020);
      ReleaseDC(TestForm.Handle, DC);
      ReleaseDC(WizardForm.Handle, FormDC);
    end;

    procedure FormM(Sender: TObject);
    begin
    if CompositionEnabled then
      Timer.Enabled:= false;
    end;

    procedure FormR(Sender: TObject);
    begin
    if CompositionEnabled then
      Timer.Enabled:= True;
    end;

    const
      GWL_STYLE = -16;
      WS_MAXIMIZEBOX = $10000;
      GWL_WNDPROC = -4;
      WM_MOVE = $3;

    function SetWindowLong(Wnd: HWnd; Index: Integer; NewLong: Longint): Longint; external 'SetWindowLongA@user32.dll stdcall';
    function GetWindowLong(Wnd: HWnd; Index: Integer): Longint; external 'GetWindowLongA@user32.dll stdcall';
    function CallWindowProc(lpPrevWndFunc: Longint; hWnd: HWND; Msg: UINT; wParam, lParam: Longint): Longint; external 'CallWindowProcA@user32.dll stdcall';

    procedure OnCloseQuery(Sender: TObject; var CanClose: Boolean);
    begin
      Timer.Free;
      SetWindowlong(TestForm.Handle, GWL_WNDPROC, OldProc);
      TestForm.Free;
      CanClose:= True;
    end;

    function InitializeSetup(): Boolean;
    begin
      ExtractTemporaryFile('Amakrits.vsf');
      LoadVCLStyle(ExpandConstant('{tmp}\Amakrits.vsf'));

    if CompositionEnabled then begin
      TestForm := CreateCustomForm;
      with TestForm do
      begin
        BorderStyle:= bsSingle;
        SetWindowLong(handle, GWL_STYLE, GetWindowLong(handle, GWL_STYLE)and(not WS_MAXIMIZEBOX));
        Left:= -1000;
        ClientWidth:= ScaleX(497);
        ClientHeight:= ScaleY(363);
        Caption := 'Test Form';
        OnCloseQuery:= @OnCloseQuery;
        Show;
      end;
    end;
      Result := True;
    end;

    function MyProc(h: HWND; Msg, wParam, lParam: longint): Longint;
    begin
    if Msg=WM_MOVE then
    begin
      TestForm.Left:= WizardForm.Left;
      TestForm.Top:= WizardForm.Top;
    end;
      Result:= CallWindowProc(OldProc, h, Msg, wParam, lParam);
    end;

    procedure InitializeWizard();
    begin
    with WizardForm do
    begin
      ClientWidth:= ScaleX(497);
      ClientHeight:= ScaleY(363);
    end;
    if CompositionEnabled then begin
      TestForm.Caption:= WizardForm.Caption;
      TestForm.Left:= WizardForm.Left;
      TestForm.Top:= WizardForm.Top;
      OldProc:= SetWindowLong(WizardForm.Handle, GWL_WNDPROC, CallbackAddr('MyProc'));
      Timer := TTimer.Create(MainForm);
    with Timer do
    begin
      Interval:= 1;
      OnTimer:=  @FormT;
    end;
      Application.OnMinimize:= @FormM;
      Application.OnRestore:= @FormR;
    end;
    end;

    procedure DeinitializeSetup();
    begin
      UnLoadVCLStyles;
    end;
     
     
    SBalykov, Shift85 и Adil нравится это.
  15. Ветеран Модератор

    Регистрация:
    26 июн 2011
    Сообщения:
    970
    Симпатии:
    664
    В: Как узнать размер увеличения (уменьшения) текста на рабочем столе?
    О: Так
    Код (Text):
    function GetDeviceCaps(hDC, nIndex: Integer): Integer; external 'GetDeviceCaps@GDI32 stdcall';
    function GetDC(HWND: DWord): DWord; external 'GetDC@user32.dll stdcall';

    Const LOGPIXELSX = 88;

    procedure InitializeWizard();
    var
      DC: DWord;
    begin
      DC:=GetDC(0);
    // 96 - 100%
    // 120 - 125%
    // 144 - 150%
    if (GetDeviceCaps(DC, LOGPIXELSX) = 120) then
     
     
    Adil и Kotyarko_O нравится это.
  16. Ветеран Модератор

    Регистрация:
    26 июн 2011
    Сообщения:
    970
    Симпатии:
    664
    В: Как обновить рабочий стол?
    О: Так
    Код (Text):

    const
        SHCNE_ASSOCCHANGED = $08000000;
        SHCNF_IDLIST = $0000;

    procedure SHChangeNotify(wEventId: Integer; uFlags: UINT; dwItem1, dwItem2: Longint); external 'SHChangeNotify@shell32.dll stdcall';

    procedure InitializeWizard();
    begin
        SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0);
    end;
     
    Спасибо Silentman.
     
    SBalykov, Хамик, ExPlayer и 2 другим нравится это.
  17. Ветеран Модератор

    Регистрация:
    26 июн 2011
    Сообщения:
    970
    Симпатии:
    664
    В: Как сделать прозрачный Edit?
    О: Так
    Скрипт лучше делать без ScaleX,Y.
    Спасибо за помощь Shegorat'у :happy:
     

    Вложения:

    • Example.rar
      Размер файла:
      310,9 КБ
      Просмотров:
      123
    Хамик, HandyMan, David.D.Rocco и 4 другим нравится это.
  18. Ветеран

    Регистрация:
    16 сен 2012
    Сообщения:
    311
    Симпатии:
    64
    Пол:
    Мужской
    В: Как наложить прогресс бар через bmp текстуру?
    О: Так

    Используется картинка размером 1x19. Хотя картинка может быть любого размера, но будет выглядеть отвратно при растягивании.
    Высота может чуть-чуть отличаться, т.е. если она будет высотой 17-22, то это не очень принципиально.
     

    Вложения:

    • Progress.7z
      Размер файла:
      30,2 КБ
      Просмотров:
      70
    Последнее редактирование: 12 фев 2015
    Adil нравится это.
  19. Ветеран

    Регистрация:
    16 сен 2012
    Сообщения:
    311
    Симпатии:
    64
    Пол:
    Мужской
    В: Как показать Splash заставку?
    О: Так
     

    Вложения:

    • Splash.7z
      Размер файла:
      508,7 КБ
      Просмотров:
      115
    Timick и Adil нравится это.
  20. Ветеран

    Регистрация:
    16 сен 2012
    Сообщения:
    311
    Симпатии:
    64
    Пол:
    Мужской
    В: Как реализовать показ слайд-шоу через ботву?
    О: Примерно так

    Спасибо огромное nik1967 :drinks:
     

    Вложения:

    Последнее редактирование: 14 фев 2015
    Nemko и Adil нравится это.

Поделиться этой страницей