Отправляет email-рассылки с помощью сервиса Sendsay

Программирование в Delphi

  Все выпуски  

Делаем программу, копирующую файлы на дискету


Выпуск No 5

Делаем программу, копирующую файлы на дискету

Доброго времени суток!

 

Уважаемые подписчики, пожалуйста высылайте ваши идеи, предложения, пожелания на glyclabs@mail.ru !

Содержание рассылки во многом зависит от вас!

 

А теперь ближе к теме выпуска. Хочу предложить вам программу, которая копирует файлы на дискету. А работать это будет так: вы «бросаете» на окно программы файл, нажимаете кнопку копировать, и файл копируется на дискету.

Я хочу сделать нестандартное окно программы. У этого окна не будет заголовка, и его можно будет таскать за любую часть.

 

У становите свойство BorderStyle формы в bsNone. В свойстве Color выставите какой-нибудь цвет, например clYellow, Такой же цвет поставьте в свойстве TransparentColorValue. В свойстве TransparentColor поставьте true, тем самым разрешив использование прозрачности.

Если не ошибаюсь, то данное свойство работает начиная с ОС Windows 2000.

Если вы сейчас запустите программу, то вы увидите, … ничего вы не увидите.

 Сейчас мы это исправим. Поместите на форму компонент Shape, в свойстве align поставьте alClient. Эта фигура будет играть роль главного окна приложения. Раскрасьте фигуру как вам понравится, в свойстве shape выберите фигуре свойство stRoundRect – прямоугольник со скруглёнными краями. Теперь разместите на компоненте shape1 лейбл с именем NameLabel (этот лэйбл будет показывать пользователю имя файла). Ниже разместите кнопки Button1 (Копировать на дискету) и Button2 (Отформатировать дискету). В правом верхнем углу  разместите маленькую кнопку с заголовком ‘X’. Это будет кнопка выхода из приложения. С интерфейсом вроде бы разобрались, приступим к коду.

 

В модуле uses подключите юнит ShellAPI.

В секции private напишите следующее:

procedure WMNCHitTest(var Message: TWMNCHitTest);  message WM_NCHITTEST;

Объявите глобальную переменную filepath типа string. Зададим действия, выполняющиеся по событию FormCreate.

procedure TForm1.FormCreate(Sender: TObject);

begin

//Говорим Windows, что прога поддерживает Drag-Drop

DragAcceptFiles(Handle, True);

//Эта длинная строчка убирает форму из TaskBar

SetWindowLong(Application.Handle, GWL_EXSTYLE, GetWindowLong(application.Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW) ;

//Задаём расположение окна проги в правом верхнем правом углу экрана

Form1.Left:=Screen.width-form1.Width-5;

Form1.Top:=5;

end;

 

procedure TForm1.FormDestroy(Sender: TObject);

begin

DragAcceptFiles(Handle, False);

end;

 

Поцедура WMDropFiles обрабатывает событие Drag-Drom формы и запоминает в переменной filepath полный путь к файлу. Данная процедура работает только с одним файлом (если вы кинете на неё несколько файлов она «запомнит» только последний)

procedure TForm1.WMDropFiles(var Msg: TMessage);

var

   Filename: array[0 .. 256] of Char;

   acFileName: PChar;

   cnMaxFileNameLen: integer;

begin

  DragQueryFile( THandle(Msg.WParam), 0, Filename,SizeOf(Filename) ) ;

  filepath := LowerCase(StrPas(FileName));

  DragFinish(THandle(Msg.WParam));

NameLabel.caption:=ExtractFileName(filepath);

end;

 

С помощью процедуры windowscopyfile мы будем копировать полученый файл на дискету.

function WindowsCopyFile(FromFile, ToDir : string) : boolean;

var F : TShFileOpStruct;

begin

  F.Wnd := 0; F.wFunc := FO_COPY;

  FromFile:=FromFile+#0; F.pFrom:=pchar(FromFile);

  ToDir:=ToDir+#0; F.pTo:=pchar(ToDir);

  F.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION;

  result:=ShFileOperation(F) = 0;

end;

 

//Функция SHFormatDrive находится в виндовсовской библиотеке Shell32.dll. Оттуда-то мы её и вызываем.

function SHFormatDrive(hWnd : HWND; Drive : Word; fmtID : Word;

Options : Word) : Longint stdcall; external 'Shell32.dll' name 'SHFormatDrive';

 

//Копируем файл на дискету

procedure TForm1.Button1Click(Sender: TObject);

begin

if not WindowsCopyFile(filepath, 'A:\'+ExtractFileName(filepath)) then Application.MessageBox('Не удаётся скопировать файл', 'Ошибка')

end;

 

procedure TForm1.Button2Click(Sender: TObject);

const ERROR = -1;

const CANCEL = -2;

const NOFORMAT = -3;

var FmtRes : integer;

 begin

   try

{Функция SHFormatDrive возвращает в переменную FmtRes число, показывающее выполнилось форматирование или нет}

     FmtRes:= ShFormatDrive(Handle, 0, $FFFF, 0);

     case FmtRes  of

      ERROR :

      ShowMessage('Ошибка форматирования');

      CANCEL :

      ShowMessage(‘Форматирование диска отменено пользователем’);

      NOFORMAT : ShowMessage(‘Нет форматирования’)

     else

      ShowMessage(‘Диск отформатирован!’);

     end;

   except

   end;

end;

 

//Эта процедура позволяет таскать форму за любую её часть

procedure TForm1.WMNCHitTest(var Message: TWMNCHitTest);

begin

Message.Result := HTCAPTION;

end;

 

//Без  комментариев :))

procedure TForm1.Button3Click(Sender: TObject);

begin

close;

end;

 

end.

 

Исходники здесь, здесь exe

На сегодня всё. Встретимся через неделю.

 

Все отзывы, пожелания, предложения присылайте на glyclabs@mail.ru

От вашего мнения зависит содержание рассылки, пишите!

C уважением, Valar


В избранное