Как сделать калькулятор в Delphi?
Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.
Как Delphi реализует многоплатформенную разработку?
Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. Delphi достигает многоплатформенности с помощью...
Копируем файл с индикатором процесса
{ 1. }
{
You need a TProgressBar on your form for this tip.
Fьr diesen Tip wird eine TProgressBar benцtigt.
}
procedure TForm1.CopyFileWithProgressBar1(Source, Destination: string
);
var
FromF, ToF: file
of
byte;
Buffer: array
[0..4096] of
char;
NumRead: integer;
FileLength: longint;
begin
AssignFile(FromF, Source);
reset(FromF);
AssignFile(ToF, Destination);
rewrite(ToF);
FileLength := FileSize(FromF);
with
Progressbar1 do
begin
Min := 0;
Max := FileLength;
while
FileLength > 0 do
begin
BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);
FileLength := FileLength - NumRead;
BlockWrite(ToF, Buffer[0], NumRead);
Position := Position + NumRead;
end
;
CloseFile(FromF);
CloseFile(ToF);
end
;
end
;
procedure
TForm1.Button1Click(Sender: TObject);
begin
CopyFileWithProgressBar1('c:WindowsWelcome.exe', 'c: empWelcome.exe');
end
;
{ 2. }
{***************************************}
// To show the estimated time to copy a file:
procedure TForm1.CopyFileWithProgressBar1(Source, Destination: string
);
var
FromF, ToF: file
of
byte;
Buffer: array
[0..4096] of
char;
NumRead: integer;
FileLength: longint;
t1, t2: DWORD;
maxi: integer;
begin
AssignFile(FromF, Source);
reset(FromF);
AssignFile(ToF, Destination);
rewrite(ToF);
FileLength := FileSize(FromF);
with
Progressbar1 do
begin
Min := 0;
Max := FileLength;
t1 := TimeGetTime;
maxi := Max div
4096;
while
FileLength > 0 do
begin
BlockRead(FromF, Buffer[0], SizeOf(Buffer), NumRead);
FileLength := FileLength - NumRead;
BlockWrite(ToF, Buffer[0], NumRead);
t2 := TimeGetTime;
Min := Min + 1;
// Show the time in Label1
label1.Caption := FormatFloat('0.00', ((t2 - t1) / min * maxi - t2 + t1) / 100);
Application.ProcessMessages;
Position := Position + NumRead;
end;
CloseFile(FromF);
CloseFile(ToF);
end
;
end
;
{ 3. }
{***************************************}
// To show the estimated time to copy a file, using a callback function:
type
TCallBack = procedure
(Position, Size: Longint);
{ export; }
procedure FastFileCopy(const
InFileName, OutFileName: string
;
CallBack: TCallBack);
implementation
procedure
FastFileCopyCallBack(Position, Size: Longint);
begin
Form1.ProgressBar1.Max := Size;
Form1.ProgressBar1.Position := Position;
end
;
procedure
FastFileCopy(const
InFileName, OutFileName: string
;
CallBack: TCallBack);
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);
try
SizeDone := 0;
New(Buffer);
repeat
BlockRead(infile, Buffer^, BufSize, Size);
Inc(SizeDone, Size);
CallBack(SizeDone, SizeFile);
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
else
raise
EInOutError.Create('File cannot be copied onto itself')
end
;
{FastFileCopy}
procedure TForm1.Button1Click(Sender: TObject);
begin
FastFileCopy('c:daten.txt', 'c: estdaten2.txt', @FastFileCopyCallBack);
end
;
{ 4. }
{***************************************}
function CopyFileWithProgressBar2(TotalFileSize,
TotalBytesTransferred,
StreamSize,
StreamBytesTransferred: LARGE_INTEGER;
dwStreamNumber,
dwCallbackReason: DWORD;
hSourceFile,
hDestinationFile: THandle;
lpData: Pointer): DWORD; stdcall
;
begin
// just set size at the beginning
if dwCallbackReason = CALLBACK_STREAM_SWITCH then
TProgressBar(lpData).Max := TotalFileSize.QuadPart;
TProgressBar(lpData).Position := TotalBytesTransferred.QuadPart;
Application.ProcessMessages;
Result := PROGRESS_CONTINUE;
end
;
function
TForm1.CopyWithProgress(sSource, sDest: string
): Boolean;
begin
// set this FCancelled to true, if you want to cancel the copy operation
FCancelled := False;
Result := CopyFileEx(PChar(sSource), PChar(sDest), @CopyFileWithProgressBar2,
ProgressBar1, @FCancelled, 0);
end
;
end
;