Программ CD Eject
14.10.2007

Программа для открытия или закрытия CD/DVD диска.

Нужны специальные модуль
Uses DriveTools;

 

Function GetAllDrive: TStringList; /// Определения CD/DVD дисков.
Var C : Char;
begin
For C := 'A' to 'Z' do
Begin
case GetDriveType(PChar(C+':\')) of
0 : ;//ShowMessage('The drive type cannot be determined');
1 : ;//ShowMessage('The root directory does not exist');
DRIVE_REMOVABLE : ;//ShowMessage('The disk can be removed');
DRIVE_FIXED : ;//ShowMessage('The disk cannot be removed');
DRIVE_REMOTE : ;//ShowMessage('The drive is remote (network) drive');
DRIVE_CDROM : AllDrive.Add(C+':\'); //ShowMessage('The drive is a CD-ROM drive');
DRIVE_RAMDISK : ;//ShowMessage('The drive is a RAM disk');
end;
end;
Result := AllDrive
end;

function CreateRgnFromBitmap(rgnBitmap: TBitmap): HRGN; /// Удаляет winxp графику
///окна
var
TransColor: TColor;
i, j: Integer;
i_width, i_height: Integer;
i_left, i_right: Integer;
rectRgn: HRGN;
begin
Result := 0;
i_width := rgnBitmap.Width;
i_height := rgnBitmap.Height;
transColor := rgnBitmap.Canvas.Pixels[0, 0];
for i := 0 to i_height - 1 do
begin
i_left := -1;
for j := 0 to i_width - 1 do
begin
if i_left < 0 then
begin
if rgnBitmap.Canvas.Pixels[j, i] <> transColor then
i_left := j;
end
else
if rgnBitmap.Canvas.Pixels[j, i] = transColor then
begin
i_right := j;
rectRgn := CreateRectRgn(i_left, i, i_right, i + 1);
if Result = 0 then
Result := rectRgn
else
begin
CombineRgn(Result, Result, rectRgn, RGN_OR);
DeleteObject(rectRgn);
end;
i_left := -1;
end;
end;
if i_left >= 0 then
begin
rectRgn := CreateRectRgn(i_left, i, i_width, i + 1);
if Result = 0 then
Result := rectRgn
else
begin
CombineRgn(Result, Result, rectRgn, RGN_OR);
DeleteObject(rectRgn);
end;
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
WindowRgn: HRGN;
tray: TNotifyIconData;
Ic: TIcon;
begin
Ic := TIcon.Create;
Ic.LoadFromFile('iconka.ico');
with tray do begin
cbSize := SizeOf(TNotifyIconData);
Wnd := Form1.Handle;
uID := 1;
uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
uCallBackMessage := WM_NOTIFYTRAYICON;
hIcon := Ic.Handle;
szTip := ('Canada clock');
end;
Shell_NotifyIcon(NIM_ADD, Addr(tray));
Ic.Destroy;

AllDrive := TStringList.Create;
ComboBox1.Items := GetAllDrive;
ComboBox1.ItemIndex := 0;
Label2.Caption := IntToStr(ComboBox1.Items.Count)+' CD/DVD - ROM';
AllDrive.Destroy
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
If ComboBox1.Text[1] <> '' then OpenCD(ComboBox1.Text[1])
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
If ComboBox1.Text[1] <> '' then CloseCD(ComboBox1.Text[1])
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
tray: TNotifyIconData;
begin
with tray do begin
cbSize := SizeOf(TNotifyIconData);
Wnd := Form1.Handle;
uID := 1;
end;
Shell_NotifyIcon(NIM_DELETE, Addr(tray));
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
halt
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
if form1.Visible then form1.Visible:=false
else form1.Visible:=true;
end;

procedure TForm1.WMTRAYICONNOTIFY(var Msg: TMessage);
begin
case Msg.LParam of
WM_RBUTTONDOWN: PopupMenu1.popup(Mouse.CursorPos.X,Mouse.CursorPos.Y);
WM_LBUTTONDBLCLK: N1Click(Form1);
end;
end;

procedure TForm1.Halt1Click(Sender: TObject);
begin
halt
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
halt
end;


procedure TForm1.Button4Click(Sender: TObject);
begin
if form1.Visible then form1.Visible:=false
else form1.Visible:=true;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if button=mbLeft then
begin
Dragging := True;
OldLeft := X;
OldTop := Y;
end;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Dragging then
begin
Left := Left+X-OldLeft;
Top := Top+Y-OldTop;
end;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Dragging := False;
end;

procedure TForm1.N1Click(Sender: TObject);
begin
if form1.Visible then form1.Visible:=false else form1.Visible:=true;
end;

procedure TForm1.about1Click(Sender: TObject);
begin
form2.ShowModal;
end;

end.

 

Скачать исходник


Просмотров: 1352

Ваш коментарий будет первым

Только зарегистрированные пользователи могут оставлять коментарии.
Пожалуйста зарегистрируйтесь или войдите в ваш аккаунт.
 
< Пред.   След. >
Назад
Журнал о компьютерах, новости интернета © 2009