CD Remember

Как-то раз в один прекрасный день решил я у друга взять на денек очередной диск поиграть - и в итоге забыл его в дисководе у другого друга Вот и решил я написать программу-напоминалку: при завершении работы она выскакивает и спрашивает юзера, а не хотел бы он вынуть диск (если диска нет - она даже не пикнет )?
Исходный код модуля:

unit cd;

interface

uses

 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

 Buttons, StdCtrls, MMSystem;

type

 TForm1 = class(TForm)

  Label1: TLabel;

  Button1: TButton;

  Label2: TLabel;

  Label3: TLabel;

  BitBtn1: TBitBtn;

  BitBtn2: TBitBtn;

  Edit1: TEdit;

  GroupBox1: TGroupBox;

  RadioButton1: TRadioButton;

  RadioButton2: TRadioButton;

  Button2: TButton;

  procedure FormCreate(Sender: TObject);

  procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

  procedure BitBtn2Click(Sender: TObject);

  procedure BitBtn1Click(Sender: TObject);

  procedure Button1Click(Sender: TObject);

  procedure Button2Click(Sender: TObject);

 private

  { Private declarations }

 public

  { Public declarations }

 end;

var

 Form1: TForm1;

implementation

{$R *.DFM}

function FindCD:Integer;

var

 i, DType:integer;

 str:string;

 drive:integer;

begin

 Result:=0;

 for i:=65 to 90 do

 begin

 str:=chr(i)+':\';

 DType:=GetDrivetype(PChar(str));

 case DType of

  0: drive:=0;

  1: drive:=1;

  DRIVE_CDROM : drive:=i;

 end;

if not ((DType=0) or (Dtype=1)) then

Result:=drive;

end;

end;

function DiskInDrive(Drive: Char): Boolean;

var

 ErrorMode: word;

begin

 { переводим в верхний регистр }

 if Drive in ['a'..'z'] then Dec(Drive, $20);

 { убеждаемся, что это буква }

 if not (Drive in ['A'..'Z']) then

  raise EConvertError.Create('Not a valid drive ID');

 //отключаем критические ошибки//

 ErrorMode := SetErrorMode(SEM_FailCriticalErrors);

 try

  if DiskSize (Ord(Drive) - $40) = -1 then

  Result := False

  else

  Result := True;

 finally

  { восстанавливаем старый режим ошибок }

  SetErrorMode(ErrorMode);

 end;

end;

procedure ChooseCloseMode;

begin

Form1.Height:=290;

Form1.Repaint;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

Edit1.text:=(chr(Findcd)+':\');

Button1.Enabled:=false;

Label1.Enabled:=false;

end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

if DiskInDrive(chr(findcd))=true then

begin

Canclose:=false;

Form1.Show;

end

else // если нет

CanClose:=true;

end;

procedure TForm1.BitBtn2Click(Sender: TObject);

begin

ChooseCloseMode;

end;

procedure TForm1.BitBtn1Click(Sender: TObject);

begin

mciSendString('Set cdaudio door open wait', nil, 0, handle);

Button1.Enabled:=true;

Label1.Enabled:=true;

BitBtn1.Enabled:=false;

Bitbtn2.Enabled:=false;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

mciSendString('Set cdaudio door closed wait', nil, 0, handle);

ChooseCloseMode;

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

if Radiobutton1.Checked=true then

  ExitWindowsEx(EWX_POWEROFF or EWX_SHUTDOWN,0)

else

if Radiobutton2.Checked=true then

  ExitWindowsEx(EWX_REBOOT,0);

end;

end.

Немного кривоваты комментарии, но кому нужно - разберется.
Код .DPR файла:

program cdrem;

uses

 Forms,

 cd in 'cd.pas' {Form1};

{$R *.RES}

begin

 Application.Initialize;

 Application.ShowMainForm:=false;

 Application.CreateForm(TForm1, Form1);

 Application.Run;

end.

Автор: Blabsadm
Компилятор: Delphi 5

Отправить комментарий

Проверка
Антиспам проверка
Image CAPTCHA
...