Opening and Closing a CD Tray better (Views: 27)
Problem/Question/Abstract: Opening and Closing a CD Tray? Answer: uses MMSystem; // Open CD Tray {Simple Way:} mciSendstring('SET CDAUDIO DOOR OPEN WAIT', nil, 0, Self.Handle); {More complex way:} function OpenCD(Drive: Char): Boolean; var Res: MciError; OpenParm: TMCI_Open_Parms; Flags: DWORD; S: string; DeviceID: Word; begin Result := False; S := Drive + ':'; Flags := MCI_OPEN_TYPE or MCI_OPEN_ELEMENT; with OpenParm do begin dwCallback := 0; lpstrDeviceType := 'CDAudio'; lpstrElementName := PChar(S); end; Res := mciSendCommand(0, MCI_OPEN, Flags, Longint(@OpenParm)); if Res <> 0 then Exit; DeviceID := OpenParm.wDeviceID; try Res := mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0); if Res = 0 then Exit; Result := True; finally mciSendCommand(DeviceID, MCI_CLOSE, Flags, Longint(@OpenParm)); end; end; //Close CD Tray {Simple Way:} mciSendstring('SET CDAUDIO DOOR CLOSED WAIT', nil, 0, Self.Handle); {More complex way:} function CloseCD(Drive: Char): Boolean; var Res: MciError; OpenParm: TMCI_Open_Parms; Flags: DWORD; S: string; DeviceID: Word; begin Result := False; S := Drive + ':'; Flags := MCI_OPEN_TYPE or MCI_OPEN_ELEMENT; with OpenParm do begin dwCallback := 0; lpstrDeviceType := 'CDAudio'; lpstrElementName := PChar(S); end; Res := mciSendCommand(0, MCI_OPEN, Flags, Longint(@OpenParm)); if Res <> then Exit; DeviceID := OpenParm.wDeviceID; try Res := mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0); if Res = 0 then Exit; Result := True; finally mciSendCommand(DeviceID, MCI_CLOSE, Flags, Longint(@OpenParm)); end; end; |