Форум: "WinAPI";
Текущий архив: 2004.07.11;
Скачать: [xml.tar.bz2];

Вниз

ProgresBar при копировании   Найти похожие ветки 

← →
eRoR_rrr   (2004-06-02 15:22) [0]

Как при копировании файла показать прогресбар, то есть сколько процентов скопировалось

---

← →
Anatoly Podgoretsky ©   (2004-06-02 15:33) [1]

TProgressVar.Create

---

← →
Anatoly Podgoretsky ©   (2004-06-02 15:35) [2]

Снимаю ответ, не посмотрел какая конференция.

---

← →
NAlexey ©   (2004-06-02 16:12) [3]

В каком то вопросе уже отвечал не помню. Вот полный код:

procedure FastFileCopy(const hProgress: HWND; InFileName, OutFileName: string);
const
 BufSize = 3*4*4096; { 48Kbytes gives me the best results }
type
 PBuffer = ^TBuffer;
 TBuffer = array[1..BufSize] of Byte;
var
 Size: DWORD;
 Buffer: PBuffer;
 infile, outfile: file;
 SizeDone, SizeFile: LongInt;
begin
 if (InFileName <> OutFileName) then
 begin
   buffer := nil;
   Assign(infile, InFileName);
   Reset(infile, 1);
   try
     SizeFile := FileSize(infile);
     Assign(outfile, OutFileName);
     Rewrite(outfile, 1);
     SendMessage(hProgress, PBM_SETRANGE, 0, MAKELPARAM(0, SizeFile div BufSize));
     SendMessage(hProgress, PBM_SETSTEP, 1, 0);
     try
       SizeDone := 0;
       New(Buffer);
       repeat
         BlockRead(infile, Buffer^, BufSize, Size);
         Inc(SizeDone{, BufSize});
         SendMessage(hProgress, PBM_SETPOS, SizeDone, 0);
         BlockWrite(outfile, Buffer^, Size)
       until Size < BufSize;
       FileSetDate(TFileRec(outfile).Handle,
       FileGetDate(TFileRec(infile).Handle));
     finally
       if Buffer <> nil then
         Dispose(Buffer);
       CloseFile(outfile)
     end;
   finally
     CloseFile(infile);
   end;
 end;
end;

function WindProc(hWindow: HWnd; Message, wParam, lParam: Integer): Integer; stdcall;
begin
 Result := 0;
 case Message of
   WM_DESTROY:
   begin
     PostQuitMessage(0);
     Exit;
   end;
 else
   Result := DefWindowProc(hWindow, Message, wParam, lParam);
 end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 hWindow: THandle;
 PB: THandle;
 Inst: HINST;

 function GetSplashWindow: THandle;
 var
   WinClass: WNDCLASS;
   Left, Top, W, H: Integer;
 begin
   WinClass.style := 0;
   WinClass.cbClsExtra := 0;
   WinClass.cbWndExtra := 0;
   WinClass.hInstance := hInstance;
   WinClass.hIcon := 0;
   WinClass.hCursor := LoadCursor(0, IDC_ARROW);;
   WinClass.hbrBackground := color_btnface + 1;
   WinClass.lpszMenuName := nil;
   WinClass.lpszClassName := "ProgressWindow";
   WinClass.lpfnWndProc := @WindProc;
   Windows.RegisterClass(WinClass);
   W := 300;
   H := 50;
   Left := (Screen.Width - W) div 2;
   Top :=  (Screen.Height - H) div 2;
   Result := CreateWindowEx(WS_EX_TOOLWINDOW or
     WS_EX_DLGMODALFRAME or WS_EX_TOPMOST,
     WinClass.lpszClassName, "????", WS_CAPTION{WS_POPUP}, Left,
     Top, W, H, HWND_DESKTOP, 0, HInstance, nil);
 end;

begin
 Inst := HInstance;
 hWindow := GetSplashWindow;
 PB := CreateWindow("msctls_progress32", "progressbar", WS_VISIBLE or WS_CHILD {or WS_BORDER},
   5, 5, 280, 15, hWindow, 0, Inst, nil);
 SendMessage(PB, PBM_SETPOS, 0, 0);
 ShowWindow(hWindow, SW_NORMAL);
 FastFileCopy(PB, "C:\Data.rar", "C:\Data1.rar")
end;


---

Страницы: 1 вся ветка

Форум: "WinAPI";
Текущий архив: 2004.07.11;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.041 c