Последние записи
- Изменить цвет шрифта TextBox на форме
- Ресайз PNG без потери прозрачности
- Вывод на печать графического файла
- Взаимодействие через командную строку
- Перенести программу из Delphi в Lazarus
- Определить текущую ОС
- Автоматическая смена языка (раскладки клавиатуры)
- Сравнение языков на массивах. Часть 2
- wprintf как напечатать кириллицу
- Взаимодействие через командную строку
Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk
Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw
9th
Авг
Как сделать копирование как в TotaleComander?
Posted by Chas under Исходники, Пост-обзор
Исходник прилагаю.
Т.к. пример достаточно простой,нужно указывать откуда копировать файла + имя коп. файла и куда копировать + имя коп. файла- так что нужные функции дальше сами добавите.
Почитайте книжку А.Чиртик … “Delphi Трюки&Эффекты”.
Красивое копирование файла.zip
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
pbCopyProgress: TProgressBar;
cmbCopy: TButton;
txtFrom: TEdit;
txtTo: TEdit;
Label2: TLabel;
procedure cmbCopyClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
var
progress: TProgressBar;
bCancelCopy: BOOL;
{$R *.dfm}
//Функция обратного вызова для отображения хода копирования
function CopyProgressFunc( TotalFileSize: Int64;
TotalBytesTransferred: Int64;
StreamSize: Int64;
StreamBytesTransferred: Int64;
dwStreamNumber: DWORD;
dwCallbackReason: DWORD;
hSourceFile: THandle;
hDestinationFile: THandle;
lpData: Pointer ): DWORD; stdcall;
begin
progress.Position := 100 * TotalBytesTransferred div TotalFileSize;
Application.ProcessMessages; //Чтобы не “зависал” интерфейс приложения
CopyProgressFunc := PROGRESS_CONTINUE;
end;
procedure TForm1.cmbCopyClick(Sender: TObject);
begin
if cmbCopy.Caption = ‘Копировать’ then
begin
//Запускаем копирование
progress := pbCopyProgress; //Настроен от 0 до 100%
bCancelCopy := FALSE;
cmbCopy.Caption := ‘Отмена’;
if CopyFileEx(PAnsiChar(txtFrom.Text), PAnsiChar(txtTo.Text),
Addr(CopyProgressFunc), nil, Addr(bCancelCopy),
COPY_FILE_FAIL_IF_EXISTS) = FALSE
then
MessageBox(Handle, ‘Не удается скопировать файл’, ‘Копирование’,
MB_ICONEXCLAMATION);
end
else
begin
//Останавливаем процесс копирования
bCancelCopy := TRUE;
cmbCopy.Caption := ‘Копировать’;
end;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
//Останавливаем процесс копирования
bCancelCopy := TRUE;
end;
end.
Похожие статьи
Купить рекламу на сайте за 1000 руб
пишите сюда - alarforum@yandex.ru
Да и по любым другим вопросам пишите на почту
пеллетные котлы
Пеллетный котел Emtas
Наши форумы по программированию:
- Форум Web программирование (веб)
- Delphi форумы
- Форумы C (Си)
- Форум .NET Frameworks (точка нет фреймворки)
- Форум Java (джава)
- Форум низкоуровневое программирование
- Форум VBA (вба)
- Форум OpenGL
- Форум DirectX
- Форум CAD проектирование
- Форум по операционным системам
- Форум Software (Софт)
- Форум Hardware (Компьютерное железо)