CD Remember

Материал из DRKB

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.


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


ID: 01405