[Serega]

Помогите соединить »

Подробнее

Код:

[code]
const
  MB_ICONQUESTION = $20;

  HALIGN_CENTER = 0;
  HALIGN_LEFT = 1;
  HALIGN_RIGHT = 2;

  VALIGN_CENTER = 0;
  VALIGN_TOP = 1;
  VALIGN_BOTTOM = 2;

  FIT_NONE = 0;
  FIT_WIDTH = 1;
  FIT_HEIGHT = 2;
  FIT_BOTH = 3;

  CLR_INVALID = $FFFFFFFF;

function InitGifCtrl(): Boolean; external 'initgifctrl@files:gifctrl.dll stdcall';
function UninitGifCtrl(): Boolean; external 'uninitgifctrl@files:gifctrl.dll stdcall';
function NewGifbWnd(hWndParent: HWND; X, Y, nWidth, nHeight: Integer): HWND; external 'newgifwnd@files:gifctrl.dll stdcall';
function FreeGifWnd(hWndGif: HWND): Boolean; external 'freegifwnd@files:gifctrl.dll stdcall';
function GifWndSetParent(hWndGif: HWND; hWndParent: HWND): Boolean; external 'gifwndsetparent@files:gifctrl.dll stdcall';
function GifWndSetBounds(hWndGif: HWND; X, Y, nWidth, nHeight: Integer): Boolean;
  external 'gifwndsetbounds@files:gifctrl.dll stdcall';
function GifWndLoadFromFile(hWndGif: HWND; HAlign, VAlign: Integer; BGColor: DWord; Fit: integer; GifFileName: PChar): Boolean;
  external 'gifwndloadfromfile@files:gifctrl.dll stdcall';

procedure InitPBarz(wizpbhwnd,pbhwnd:THandle; pbLengt:integer); external 'InitPBarz@files:arc.dll stdcall';
procedure StartArcExtract(freearc,params:pchar; var ReturnCode:integer);
 external 'StartArcExtract@files:arc.dll stdcall';
procedure CancelExtract; external 'CancelExtract@files:arc.dll stdcall';
procedure RepeatExtract; external 'RepeatExtract@files:arc.dll stdcall';
procedure SuspendExtract; external 'SuspendExtract@files:arc.dll stdcall';
procedure ResumeExtract; external 'ResumeExtract@files:arc.dll stdcall';
procedure UpdateWizGauge; external 'UpdateWizGauge@files:arc.dll stdcall';
procedure SkipError; external 'SkipError@files:arc.dll stdcall';
function MessageBox(hWnd: Integer; lpText, lpCaption: String; uType: Cardinal): Integer;
  external 'MessageBoxA@user32.dll stdcall';

var
  Image1: TBitmapImage;
  NeedSize:Integer;
  FreeMB, TotalMB: Cardinal;
  NeedSpaceLabel,FreeSpaceLabel,WLabel1,WLabel2: TLabel;
  GIFHWND: HWND;
  SecondProgressBar: TNewProgressBar;


procedure GetFreeSpaceCaption(Sender: TObject); /////Вычисление свободного места на диске
var
  Path: String;
begin
  Path := ExtractFileDrive(WizardForm.DirEdit.Text);
  GetSpaceOnDisk(Path, True, FreeMB, TotalMB);
  if FreeMB > 1024 then
  FreeSpaceLabel.Caption := 'Доступно места на диске: '+ FloatToStr(round(FreeMB/1024*100)/100) + ' GB' else
  FreeSpaceLabel.Caption := 'Доступно места на диске: '+ IntToStr(FreeMB)+ ' MB';
  if FreeMB < NeedSize then
  WizardForm.NextButton.Enabled := False else
  WizardForm.NextButton.Enabled := True;
end;

procedure GetNeedSpaceCaption; /////Вычисление требуемого места для установки
begin
  if NeedSize > 1024 then
  NeedSpaceLabel.Caption := 'Требуется места на диске: '+ FloatToStr(round(NeedSize/1024*100)/100) + ' GB' else
  NeedSpaceLabel.Caption := 'Требуется места на диске: '+ IntToStr(NeedSize)+ ' MB';
end;

function InitializeSetup(): Boolean;
begin
  InitGifCtrl();
  GIFHWND := 0;
  Result := True;
end;

procedure CancelButtonClick(CurPage: Integer; var Cancel, Confirm: Boolean);
begin
  if curpage=wpInstalling then begin
    Cancel:=False;
    Confirm:=False;
    SuspendExtract;
  case MessageBox(StrToInt(ExpandConstant('{wizardhwnd}')), setupmessage(msgExitSetupMessage),
       setupmessage(msgExitSetupTitle), MB_YESNO or MB_defbutton2 or MB_ICONQUESTION) of
  idyes:
      begin
        CancelExtract Cancel:=true;
      end;
  idno:
      begin
        ResumeExtract;
      end;
    end;
  end;
end;

procedure LblOnClick(Sender: TObject);
var
  ErrorCode: Integer;
begin
  ShellExec('open', 'http://forum.ru-board.com', '', '', SW_SHOWNORMAL, ewNoWait, ErrorCode);
end;

procedure CurPageChanged(CurPageID: Integer);
begin
  if CurPageID=wpSelectDir then begin //если Свободное место на диске < требуемого, то кнопка "Установить" на PageSelectDir неактивна
    GetNeedSpaceCaption;
    if FreeMB < NeedSize then
    WizardForm.NextButton.Enabled:=False
    WizardForm.NextButton.Caption:='Установить'; //Rename кнопки "Далее" на SelectDir
  end;
end;

procedure CurStepChanged(CurStep: TSetupStep);
var
  returnCode:integer;
begin
  if CurStep = ssInstall then begin
    WizardForm.StatusLabel.Caption:=SetupMessage(msgStatusExtractFiles);
    ExtractTemporaryFile('arc.exe');
    InitPBarz(wizardform.progressgauge.handle,secondprogressbar.Handle,200)
    StartArcExtract(ExpandConstant('{tmp}\Arc.exe'), 'x '+AddQuotes(AddBackslash(ExpandConstant('{src}'))+'data-a.bin')+' -y -dp'+AddQuotes(ExpandConstant('{app}')), ReturnCode)
    UpdateWizGauge;
  end;
end;

procedure InitializeWizard();
var
  GifFileName: String;
  Lbl: TNewStaticText;
begin
  NeedSize := 6610; //Здесь указывается место для приложения
  WizardForm.DiskSpaceLabel.Hide;
  ExtractTemporaryFile('welcome.bmp')
  WizardForm.PageNameLabel.Hide;
  WizardForm.PageDescriptionLabel.Hide;
  WizardForm.WizardSmallBitmapImage.Left:= ScaleX(0);
  WizardForm.WizardSmallBitmapImage.Width:=WizardForm.ClientWidth;
  WizardForm.WelcomeLabel1.Hide;
  WizardForm.WelcomeLabel2.Hide;

  Image1:=TBitmapImage.Create(WizardForm)
  with Image1 do begin
    Left:=0
    Top:=0
    Width:=497
    Height:=313
    Parent:=WizardForm.WelcomePage
    Bitmap.LoadFromFile(ExpandConstant('{tmp}')+'\welcome.bmp')
  end;

  NeedSpaceLabel := TLabel.Create(WizardForm);
  with NeedSpaceLabel do begin
    Parent := WizardForm.SelectDirPage;
    Left := ScaleX(0);
    Top := ScaleY(202);
    Width := ScaleX(209);
    Height := ScaleY(13);
  end;

  FreeSpaceLabel := TLabel.Create(WizardForm);
  with FreeSpaceLabel do begin
    Parent := WizardForm.SelectDirPage;
    Left := ScaleX(0);
    Top := ScaleY(220);
    Width := ScaleX(209);
    Height := ScaleY(13);
  end;

  WizardForm.DirEdit.OnChange := @GetFreeSpaceCaption;
  WizardForm.DirEdit.Text := WizardForm.DirEdit.Text + #0;

  WLabel1 := TLabel.Create(WizardForm);
  WLabel1.Left := ScaleX(170);
  WLabel1.Top := ScaleY(16);
  WLabel1.Width := ScaleX(320);
  WLabel1.Height := ScaleY(100);
  WLabel1.AutoSize := False;
  WLabel1.WordWrap := True;
  WLabel1.Font.Size := 12;
  WLabel1.Font.Style := [fsBold];
  WLabel1.Font.Color:= clWhite;
  WLabel1.Font.Name:= 'Tahoma';
  WLabel1.ShowAccelChar := False;
  WLabel1.Caption := WizardForm.WelcomeLabel1.Caption;
  WLabel1.Transparent := True;
  WLabel1.Parent := WizardForm.WelcomePage;

  WLabel2 :=TLabel.Create(WizardForm);
  WLabel2.Top := ScaleY(76);
  WLabel2.Left := ScaleX(170);
  WLabel2.Width := ScaleX(300);
  WLabel2.Height := ScaleY(234);
  WLabel2.AutoSize := False;
  WLabel2.WordWrap := True;
  WLabel2.Font.Color:= clWhite;
  WLabel2.ShowAccelChar := False;
  WLabel2.Caption := WizardForm.WelcomeLabel2.Caption;
  WLabel2.Transparent := True;
  WLabel2.Parent := WizardForm.WelcomePage;

  ExtractTemporaryFile('www_oszone_net.gif');

  GIFHWND := NewGifbWnd(WizardForm.Handle, ScaleX(30), WizardForm.Bevel.Top + ScaleY(8), 126, 31);
  GifWndLoadFromFile(GIFHWND, HALIGN_CENTER, VALIGN_CENTER, CLR_INVALID, FIT_NONE, ExpandConstant('{tmp}\www_oszone_net.gif'));
  Lbl := TNewStaticText.Create(WizardForm);
  Lbl.Parent := WizardForm;
  Lbl.AutoSize := False;
  Lbl.SetBounds(ScaleX(30), WizardForm.Bevel.Top + ScaleY(8), 126, 31);
  Lbl.OnClick := @LblOnClick;
  Lbl.Cursor := crHand;
  SecondProgressBar := TNewProgressBar.Create(WizardForm);
  with SecondProgressBar do begin
    Parent := wizardform.installingpage;
    Top := 100
    Width := 150;
    Height := wizardform.progressgauge.height;
  end;

  WizardForm.ProgressGauge.Top:=ScaleY(100);
  WizardForm.ProgressGauge.Width:=262;
  WizardForm.ProgressGauge.Left:=155;
  WizardForm.StatusLabel.Top:=ScaleY(80);
end;

procedure DeinitializeSetup();
begin
  UninitGifCtrl();
end;

размещения картинки на последней странице установки »

Пример, пост №454.