mirrors/doublecmd
2
0
Fork 0
mirror of https://github.com/doublecmd/doublecmd.git synced 2026-06-21 09:58:13 +00:00
Code Issues Projects Releases Packages Wiki Activity

FIX: Progress Bar for unpacking operation

Browse source
This commit is contained in:
Alexander Koblov 2007-06-24 21:08:13 +00:00
commit fca9ab92e9
4 changed files with 36 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

3
doc/uwcxmodule.txt
View file

@ -3,4 +3,5 @@
которые выводят только файлы (без подкаталогов).
23.05.2007 Сделал упаковку/распаковку в потоке
Добавил прогресс бар на упаковку/распаковку
22.06.2007 Добавил функции упаковки/распаковки без потока
22.06.2007 Добавил функции упаковки/распаковки без потока
25.06.2007 Теперь корректно работает ProgressBar при распаковке

2
uWCXhead.pas
View file

@ -69,7 +69,7 @@ type
TChangeVolProc=function(ArcName:pchar;Mode:longint):longint; stdcall;
{Notify that data is processed - used for progress dialog}
PProcessDataProc=^TProcessDataProc;
TProcessDataProc=function(FileName:pchar;Size:longint):longint; stdcall;
TProcessDataProc=function(FileName: PChar; Size: Integer): Integer; stdcall;
type
THeaderData=packed record

53
uwcxmodule.pas
View file

@ -65,7 +65,6 @@ Type
function WCXCopyOut : Boolean;{Extract files from archive}
function WCXCopyIn : Boolean;{Pack files in archive}
function ProcessDataProc(FileName:pchar;Size:longint):longint;stdcall;
procedure CopySelectedWithSubFolders(var flist:TFileList);
protected
// module's functions
@ -121,11 +120,15 @@ Type
implementation
uses Forms, SysUtils, uFileOp, uOSUtils, LCLProc, uFileProcs, uDCUtils;
var
WCXModule : TWCXModule;
constructor TWCXModule.Create;
begin
FFilesSize:= 0;
FPercent := 0;
FEmulate := True; // temporally
FEmulate := False;
WCXModule := Self;
end;
destructor TWCXModule.Destroy;
@ -188,6 +191,29 @@ begin
@PackSetDefaultParams:= nil;
end;
function ProcessDataProc(FileName: PChar; Size: Integer): Integer; stdcall;
begin
DebugLN('Working ' + FileName + ' Size = ' + IntToStr(Size));
Result := 1;
with WCXModule do
begin
FPercent := FPercent + ((Size * 100) / FFilesSize);
DebugLN('Percent = ' + IntToStr(Round(FPercent)));
FFileOpDlg.iProgress1Pos := 100;
FFileOpDlg.iProgress2Pos := Round(FPercent);
if Assigned(AT) then
AT.Synchronize(FFileOpDlg.UpdateDlg)
else
begin
FFileOpDlg.UpdateDlg;
Application.ProcessMessages;
end;
end; //with
end;
function TWCXModule.VFSInit: Boolean;
begin
@ -252,7 +278,7 @@ begin
end;
if not FEmulate then
SetProcessDataProc(ArcHandle, Pointer(ProcessDataProc));
SetProcessDataProc(ArcHandle, ProcessDataProc);
DebugLN('Get File List');
(*Get File List*)
@ -371,7 +397,7 @@ begin
Exit;
end;
if not FEmulate then
SetProcessDataProc(ArcHandle, Pointer(ProcessDataProc));
SetProcessDataProc(ArcHandle, ProcessDataProc);
FillChar(ArcHeader, SizeOf(ArcHeader), #0);
while (ReadHeader(ArcHandle, ArcHeader) = 0) do
@ -500,21 +526,6 @@ begin
end;
end;
function TWCXModule.ProcessDataProc(FileName: pchar; Size: longint): longint;stdcall;
begin
DebugLN('Working ' + FileName + ' Size = ' + IntToStr(Size));
Result := 1;
FPercent := FPercent + ((Size * 100) / FFilesSize);
DebugLN('Percent = ' + IntToStr(Round(FPercent)));
FFileOpDlg.iProgress1Pos := 100;
FFileOpDlg.iProgress2Pos := Round(FPercent);
AT.Synchronize(FFileOpDlg.UpdateDlg);
end;
procedure TWCXModule.CopySelectedWithSubFolders(var flist:TFileList);
procedure SelectFilesInSubfolders(var fl : TFileList; sDir : String);
@ -555,7 +566,7 @@ procedure TWCXModule.CopySelectedWithSubFolders(var flist:TFileList);
end
else
begin
inc(FFilesSize, PackSize);
inc(FFilesSize, UnpSize);
end;
end; //with
fl.AddItem(fr);
@ -588,7 +599,7 @@ begin
SelectFilesInSubfolders(Newfl, fri.sName)
else
begin
inc(FFilesSize);
inc(FFilesSize, fri.iSize);
end;
end;

2
uwcxprototypes.pas
View file

@ -18,7 +18,7 @@ type
TGetPackerCaps = function () : integer;{$IFNDEF WIN32}cdecl{$ELSE}stdcall{$ENDIF};
TConfigurePacker = procedure (Parent: THandle; DllInstance: THandle);{$IFNDEF WIN32}cdecl{$ELSE}stdcall{$ENDIF};
TSetChangeVolProc = procedure (hArcData: THandle; pChangeVolProc1: tChangeVolProc);{$IFNDEF WIN32}cdecl{$ELSE}stdcall{$ENDIF};
TSetProcessDataProc = procedure (hArcData: THandle; pProcessDataProc: pointer);{$IFNDEF WIN32}cdecl{$ELSE}stdcall{$ENDIF};
TSetProcessDataProc = procedure (hArcData: THandle; pProcessDataProc: TProcessDataProc);{$IFNDEF WIN32}cdecl{$ELSE}stdcall{$ENDIF};
TStartMemPack = function (Options: integer; FileName: pchar): integer;{$IFNDEF WIN32}cdecl{$ELSE}stdcall{$ENDIF};
TPackToMem = function (hMemPack: integer; BufIn: pchar; InLen: integer; Taken: pinteger; BufOut: pchar; OutLen: integer; Written: pinteger; SeekBy: integer): integer;{$IFNDEF WIN32}cdecl{$ELSE}stdcall{$ENDIF};
TDoneMemPack = function (hMemPack: integer): integer;stdcall;