Как-то раз в один прекрасный день решил я у друга взять на денек очередной диск поиграть - и в итоге забыл его в дисководе у другого друга Вот и решил я написать программу-напоминалку: при завершении работы она выскакивает и спрашивает юзера, а не хотел бы он вынуть диск (если диска нет - она даже не пикнет )?
Исходный код модуля:
| 
 Code:  | 
| 
 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.  | 
- Назад
 - Вперёд >>
 
			
Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.
ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!