[Krekerpro]

У меня вопрос:возможно ли соединить это

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

Код:

[_Code] 
var 
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 
end;

это

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

Код:

[_сode]
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;

procedure InitializeWizard();
begin
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;

и вот это

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

Код:

[сode]
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;

procedure InitializeWizard();
begin
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;