[Serega]

возможно ли соединить это »

читать дальше »

Код:

[code]
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';

const
  MB_ICONQUESTION = $20;

var
  SecondProgressBar: TNewProgressBar;
  MouseLabel,SiteLabel: TLabel;

procedure SiteLabelOnClick(Sender: TObject);
var
  ErrorCode: Integer;
begin
  ShellExec('open', 'http://*******', '', '', SW_SHOWNORMAL, ewNoWait, ErrorCode)
end;

procedure SiteLabelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  SiteLabel.Font.Color:=clRed
end;

procedure SiteLabelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  SiteLabel.Font.Color:=clBlue
end;

procedure SiteLabelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  SiteLabel.Font.Color:=clGreen
end;

procedure SiteLabelMouseMove2(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  SiteLabel.Font.Color:=clRed
end;

procedure InitializeWizard();
begin
  MouseLabel:=TLabel.Create(WizardForm)
  MouseLabel.Width:=WizardForm.Width
  MouseLabel.Height:=WizardForm.Height
  MouseLabel.Autosize:=False
  MouseLabel.Transparent:=True
  MouseLabel.OnMouseMove:=@SiteLabelMouseMove2
  MouseLabel.Parent:=WizardForm

  SiteLabel:=TLabel.Create(WizardForm)
  SiteLabel.Left:=10
  SiteLabel.Top:=330
  SiteLabel.Cursor:=crHand
  SiteLabel.Font.Color:=clRed
  SiteLabel.Caption:='Pirat.ca'
  SiteLabel.OnClick:=@SiteLabelOnClick
  SiteLabel.OnMouseDown:=@SiteLabelMouseDown
  SiteLabel.OnMouseUp:=@SiteLabelMouseUp
  SiteLabel.OnMouseMove:=@SiteLabelMouseMove
  SiteLabel.Parent:=WizardForm

  SecondProgressBar := TNewProgressBar.Create(WizardForm);
  with SecondProgressBar do begin
    Parent := wizardform.InstallingPage;
    Left := ScaleX(wizardform.progressgauge.left);
    Top := ScaleY(wizardform.progressgauge.top);
    Width := ScaleX(wizardform.progressgauge.Width);
    Height := ScaleY(wizardform.progressgauge.Height);
  end;
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: ResumeExtract;
    end
  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) //Последнее значение задается в зависимости от кол-ва архивов + 100. То есть - если их 3, то пишем 400, если 1, то 200.
    StartArcExtract(ExpandConstant('{tmp}\Arc.exe'), 'x '+AddQuotes(AddBackslash(ExpandConstant('{src}'))+'data-a.bin')+' -y -dp'+AddQuotes(ExpandConstant('{app}')), ReturnCode)
    UpdateWizGauge;
  end;
end;