|
div.main {margin-left: 20pt; margin-right: 20pt} Программа CD-Rememberer
Автор: Blabsadm
Компилятор: Delphi 5
Как-то раз в один прекрасный день решил я у друга взять на денек
очередной диск поиграть - и в итоге забыл его в дисководе у другого друга
:( Вот и решил я написать программу-напоминалку: при завершении работы она
выскакивает и спрашивает юзера, а не хотел бы он вынуть диск (если диска
нет - она даже не пикнет :))?
Исходный код модуля: 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.
Скачать исходник
готового проекта - 13 Кб
|
