Roden37101
Junior Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Код: const Archives = '{app}\q.arc'; type PAnsiChar=PChar; TMyMsg = record hwnd: HWND; message: UINT; wParam: Longint; lParam: Longint; time: DWORD; pt: TPoint; end; TFreeArcCallback = function (what: PAnsiChar; int1, int2: Integer; str: PAnsiChar): Integer; TArc = record Path: string; Size: Extended; end; function PeekMessage(var lpMsg: TMyMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external 'PeekMessageA@user32.dll stdcall'; function TranslateMessage(const lpMsg: TMyMsg): BOOL; external 'TranslateMessage@user32.dll stdcall'; function DispatchMessage(const lpMsg: TMyMsg): Longint; external 'DispatchMessageA@user32.dll stdcall'; const PM_REMOVE = 1; procedure AppProcessMessage; var Msg: TMyMsg; begin while PeekMessage(Msg, WizardForm.Handle, 0, 0, PM_REMOVE) do begin TranslateMessage(Msg); DispatchMessage(Msg); end; end; function WrapFreeArcCallback (callback: TFreeArcCallback; paramcount: integer):longword; external 'wrapcallback@files:innocallback.dll stdcall'; function FreeArcExtract (callback: longword; cmd1,cmd2,cmd3,cmd4,cmd5,cmd6,cmd7,cmd8,cmd9,cmd10: PAnsiChar): integer; external 'FreeArcExtract@files:unarc.dll cdecl'; var ProgressBar: TNewProgressBar; ExtractFile: TNewStaticText; Button1: TButton; Cancel: Integer; n: Integer; Arcs: array of TArc; m: Extended; function cm(Message: String): String; Begin Result:= ExpandConstant('{cm:'+ Message +'}') End; Function NumToStr(Float: Extended): String; Begin Result:= Format('%.3n', [Float]); StringChange(Result, ',', '.'); while (Pos('.', Result) > 0) and ((Result[Length(Result)] = '0') or (Result[Length(Result)] = '.')) do SetLength(Result, Length(Result)-1); 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; procedure Button1OnClick(Sender: TObject); begin Cancel := -127; end; function FindArcs(dir: string): Extended; var FSR: TFindRec; Begin if FindFirst(ExpandConstant(dir), FSR) then try repeat if FSR.Attributes and FILE_ATTRIBUTE_DIRECTORY > 0 then CONTINUE n:= GetArrayLength(Arcs) SetArrayLength(Arcs, n +1) Arcs[n].Path:= ExtractFilePath(ExpandConstant(Archives)) + FSR.Name Arcs[n].Size:= Size64(FSR.SizeHigh, FSR.SizeLow) Result:= Result + Arcs[n].Size; until not FindNext(FSR); finally FindClose(FSR); end; End; function FreeArcCallback (what: PAnsiChar; Mb, sizeArc: Integer; str: PAnsiChar): Integer; var percents: Integer; begin if string(what)='filename' then else if (string(what)='progress') and (sizeArc>0) then begin percents:= (Mb*1000) div sizeArc; ProgressBar.Position:= percents; ExtractFile.Caption:= FmtMessage(cm('ArcInfo'), [IntToStr(Mb), IntToStr(sizeArc), Format('%.1n', [Abs(percents/10)]), IntToStr(n+1), IntToStr(GetArrayLength(Arcs)) ]); WizardForm.ProgressGauge.Position:= WizardForm.ProgressGauge.Tag + round(ProgressBar.Position * m) percents:= (WizardForm.ProgressGauge.Position-WizardForm.ProgressGauge.Min)/((WizardForm.ProgressGauge.Max - WizardForm.ProgressGauge.Min)/1000) WizardForm.FileNameLabel.Caption:= FmtMessage(cm('AllProgress'), [Format('%.1n', [Abs(percents/10)])]); end; AppProcessMessage; Result := Cancel; end; function ExtractFreeArcArchive(arcname, destpath: String): Integer; var callback: longword; begin Cancel:= 0; AppProcessMessage; callback:= WrapFreeArcCallback(@FreeArcCallback,4); try Result:= FreeArcExtract (callback, 'x', '-o+', '-dp'+destpath, '--', arcname, '', '', '', '', ''); if Result = 0 then Result:= Cancel; except Result:= -63; end; end; function UnPack(Archives: string): Integer; var allSize: Extended; FreeMB, TotalMB: Cardinal; mes: string; begin Button1.Show WizardForm.ProgressGauge.Position:= 0; WizardForm.ProgressGauge.Max:= 1000 allSize:= FindArcs(Archives) for n:= 0 to GetArrayLength(Arcs) -1 do begin m:= Arcs[n].Size/allSize WizardForm.ProgressGauge.Tag:= WizardForm.ProgressGauge.Position Result:= ExtractFreeArcArchive(Arcs[n].Path, ExpandConstant('{app}')); if Result <> 0 then begin mes:= FmtMessage(cm('ArcError'), [IntToStr(Result)]); GetSpaceOnDisk(ExtractFileDrive(ExpandConstant('{app}')), True, FreeMB, TotalMB); case Result of -1: if FreeMB < 32 then mes:= SetupMessage(msgDiskSpaceWarningTitle) else mes:= mes + #13#10 + FmtMessage(cm('ArcBroken'), [ExtractFileName(Arcs[n].Path)]); -127: mes:= cm('ArcBreak'); -63: mes:= cm('ArcFail'); end; MsgBox(mes, mbInformation, MB_OK); Log(mes); Break; end; end; Button1.visible:= false; end; procedure CurStepChanged(CurStep: TSetupStep); begin if CurStep = ssPostInstall then UnPack(Archives); end; procedure InitializeWizard(); begin ProgressBar := TNewProgressBar.Create(WizardForm); ExtractFile := TNewStaticText.Create(WizardForm); with WizardForm.ProgressGauge do begin ProgressBar.SetBounds(Left, Top + ScaleX(55), Width, Height) ProgressBar.Parent := WizardForm.InstallingPage; ProgressBar.max := 1000; ProgressBar.Position := 0; ExtractFile.parent:=WizardForm.InstallingPage; ExtractFile.autosize:=false; ExtractFile.Width := Width; ExtractFile.top:=Top + ScaleX(35); ExtractFile.caption:=cm('ArcTitle'); end; Button1:=TButton.create(WizardForm); Button1.parent:=WizardForm; Button1.SetBounds(260, WizardForm.cancelbutton.top, 135, WizardForm.cancelbutton.Height); Button1.caption:=cm('ArcCancel'); Button1.OnClick:=@Button1OnClick; Button1.Hide; end; type HSTREAM=DWORD; TTimerProc=procedure(uTimerID,uMessage:UINT;dwUser,dw1,dw2:DWORD); const BackGround=6; Timer=16; Indent=25; var MP3List:TStringList; CurrentMP3:integer; hMP3:HWND; TimerID:LongWord; function GetWindowLong(hWnd: HWND; nIndex: Integer): Longint; external 'GetWindowLongA@user32.dll stdcall delayload'; function SetWindowLong(hWnd: HWND; nIndex: Integer; dwNewLong: Longint): Longint; external 'SetWindowLongA@user32.dll stdcall'; function isxbb_AddImage(Image: PChar; Flags: Cardinal): integer; external 'isxbb_AddImage@files:isxbb.dll stdcall delayload'; function isxbb_Init(hWnd: Integer): integer; external 'isxbb_Init@files:isxbb.dll stdcall delayload'; function isxbb_StartTimer(Seconds: Integer; Flags: Cardinal): integer; external 'isxbb_StartTimer@files:isxbb.dll stdcall'; function isxbb_KillTimer(Flags: Cardinal): integer; external 'isxbb_KillTimer@files:isxbb.dll stdcall'; procedure ShowSplashScreen(p1:HWND;p2:string;p3,p4,p5,p6,p7:integer;p8:boolean;p9:Cardinal;p10:integer); external 'ShowSplashScreen@files:isgsg.dll stdcall delayload'; function GetSystemMetrics(nIndex:Integer):integer; external 'GetSystemMetrics@user32.dll stdcall delayload'; function SetTimer(hWnd:HWND;nIDEvent,uElapse:UINT;lpTimerFunc:LongWord{TFNTimerProc}):UINT; external 'SetTimer@user32.dll stdcall delayload'; function KillTimer(hWnd:HWND;uIDEvent:UINT):BOOL; external 'KillTimer@user32.dll stdcall delayload'; function BASS_ChannelIsActive(Handle:HWND):DWORD; external 'BASS_ChannelIsActive@files:bass.dll stdcall'; function BASS_SetConfig(Option,Value:DWORD):DWORD; external 'BASS_SetConfig@files:bass.dll stdcall'; function BASS_Init(Device:integer;Freq,Flags:DWORD;Win:HWND;CLSID:integer):boolean; external 'BASS_Init@files:bass.dll stdcall delayload'; function BASS_StreamCreateFile(Mem:BOOL;f:PChar;Offset:DWORD;Length:DWORD;Flags:DWORD):HSTREAM; external 'BASS_StreamCreateFile@files:bass.dll stdcall'; function BASS_StreamFree(Handle:HWND):boolean; external 'BASS_StreamFree@files:bass.dll stdcall'; function BASS_ChannelPlay(Handle:HWND;Restart:boolean):boolean; external 'BASS_ChannelPlay@files:bass.dll stdcall'; function BASS_Start: Boolean; external 'BASS_Start@files:bass.dll stdcall'; function BASS_Stop: Boolean; external 'BASS_Stop@files:bass.dll stdcall'; function BASS_Free: Boolean; external 'BASS_Free@files:bass.dll stdcall delayload'; function WrapTimerProc(CallBack:TTimerProc;ParamCount:integer):LongWord; external 'wrapcallback@files:innocallback.dll stdcall'; procedure TimerTick(uTimerID,uMessage:UINT;dwUser,dw1,dw2:DWORD); begin if BASS_ChannelIsActive(hMP3)=0 then begin BASS_Stop; BASS_StreamFree(hMP3); hMP3:=BASS_StreamCreateFile(False,PChar(MP3List.Strings[CurrentMP3]),0,0,0); BASS_Start; if hMP3<>0 then if BASS_ChannelPlay(hMP3,True) then begin CurrentMP3:=CurrentMP3+1; if CurrentMP3>MP3List.Count-1 then CurrentMP3:=0; end; end; end; function InitializeSetup:boolean; begin ExtractTemporaryFile('01. Rise Of The Argonauts.mp3'); ExtractTemporaryFile('02. Broken Union.mp3'); ExtractTemporaryFile('03. The Purge.mp3'); MP3List:=TStringList.Create; MP3List.Add(ExpandConstant('{tmp}')+'\01. Rise Of The Argonauts.mp3'); MP3List.Add(ExpandConstant('{tmp}')+'\02. Broken Union.mp3'); MP3List.Add(ExpandConstant('{tmp}')+'\03. The Purge.mp3'); CurrentMP3:=0; Result:=True; end; procedure InitializeWizard; begin SetWindowLong(MainForm.Handle,-16,GetWindowLong(MainForm.Handle,-16) and not $C40000); MainForm.Width:=GetSystemMetrics(0); MainForm.Height:=GetSystemMetrics(1)+1; MainForm.Top:=-1; MainForm.Left:=0; ExtractTemporaryFile('4.jpg'); ShowSplashScreen(WizardForm.Handle,ExpandConstant('{tmp}')+'\4.jpg',1000,3000,1000,0,255,False,$FFFFFF,10); TimerID:=SetTimer(0,0,500,WrapTimerProc(@TimerTick,5)); BASS_Init(-1,44100,0,0,0); BASS_SetConfig(5,100); BASS_SetConfig(6,100); end; procedure CurStepChanged(CurStep: TSetupStep); begin if CurStep=ssInstall then begin ExtractTemporaryFile('01.jpg'); isxbb_AddImage(ExpandConstant('{tmp}')+'\01.jpg',BackGround or Timer); ExtractTemporaryFile('02.jpg'); isxbb_AddImage(ExpandConstant('{tmp}')+'\02.jpg',BackGround or Timer); ExtractTemporaryFile('03.jpg'); isxbb_AddImage(ExpandConstant('{tmp}')+'\03.jpg',BackGround or Timer); ExtractTemporaryFile('04.jpg'); isxbb_AddImage(ExpandConstant('{tmp}')+'\04.jpg',BackGround or Timer); ExtractTemporaryFile('06.jpg'); isxbb_AddImage(ExpandConstant('{tmp}')+'\06.jpg',BackGround or Timer); isxbb_Init(StrToInt(ExpandConstant('{hwnd}'))); isxbb_StartTimer(10,BackGround) MainForm.Visible:=True; end; if CurStep=ssPostInstall then begin MainForm.Visible:=False; isxbb_KillTimer(BackGround); end; end; procedure CurPageChanged(CurPageID: Integer); begin if CurPageID=wpInstalling then begin WizardForm.MainPanel.Visible:=False; WizardForm.Bevel1.Visible:=False; WizardForm.Width:=ScaleX(395); WizardForm.Height:=ScaleY(142); WizardForm.Left:=ScaleX(MainForm.Width-WizardForm.Width-Indent); WizardForm.Top:=ScaleY(MainForm.Height-WizardForm.Height-Indent); WizardForm.InnerNotebook.Left:=ScaleX(10); WizardForm.InnerNotebook.Top:=ScaleY(10); WizardForm.InnerNotebook.Width:=ScaleX(370); WizardForm.StatusLabel.Left:=ScaleX(0); WizardForm.StatusLabel.Top:=ScaleY(0); WizardForm.StatusLabel.Width:=WizardForm.InnerNotebook.Width; WizardForm.FileNameLabel.Left:=ScaleX(0); WizardForm.FileNameLabel.Top:=ScaleY(20); WizardForm.FileNameLabel.Width:=WizardForm.InnerNotebook.Width; WizardForm.ProgressGauge.Top:=ScaleY(40); WizardForm.ProgressGauge.Width:=WizardForm.InnerNotebook.Width; WizardForm.CancelButton.Left:=ScaleX(154); WizardForm.CancelButton.Top:=ScaleY(80); end; if CurPageID=wpFinished then begin WizardForm.Visible:=False; WizardForm.Width:=502; WizardForm.Height:=392; WizardForm.Left:=(MainForm.Width-WizardForm.Width) div 2; WizardForm.Top:=(MainForm.Height-WizardForm.Height) div 2; WizardForm.Visible:=True; end; end; procedure DeinitializeSetup; begin KillTimer(0,TimerID); BASS_Stop; BASS_Free; MP3List.Free; end; var PageNameLabel, PageDescriptionLabel: TLabel; DesktopIcon: TCheckBox; LogoImage:TBitmapImage; LogoPanel: TPanel; LogoLabel: TLabel; procedure LogoLabelOnClick(Sender: TObject); var ErrorCode: Integer; begin ShellExec('open', 'http://www.vgtorrent.ru/forum/index.php', '', '', SW_SHOWNORMAL, ewNoWait, ErrorCode) end; type TProc=procedure(HandleW, msg, idEvent, TimeSys: LongWord); var TimerID: LongWord; pfunc: LongWord; Label1:tlabel; procedure InitializeWizard(); begin LogoPanel := TPanel.Create(WizardForm); with LogoPanel do begin Parent := WizardForm; Left := ScaleX(2); Top := ScaleY(313); Width := ScaleX(276); Height := ScaleY(100); BevelOuter := bvNone; end; LogoImage := TBitmapImage.Create(WizardForm); with LogoImage do begin Parent := LogoPanel; Left := ScaleX(0); Top := ScaleY(0); AutoSize:=true; ReplaceColor:=clFuchsia; ReplaceWithColor:=clBtnFace; ExtractTemporaryFile('logo.bmp'); Bitmap.LoadFromFile(ExpandConstant('{tmp}\logo.bmp')); end; LogoLabel := TLabel.Create(WizardForm); with LogoLabel do begin Parent := LogoPanel; Width := LogoPanel.Width; Height := LogoPanel.Height; Transparent:=True; Cursor := crHand; OnClick:=@LogoLabelOnClick; end; end; |
| Всего записей: 194 | Зарегистр. 20-06-2009 | Отправлено: 21:07 23-06-2009 | Исправлено: Roden37101, 21:30 23-06-2009 |
|