Control bandeja

[Casimiro Noteví]

Empezado por REHome

La bandeja abre y cierra. Muestra los mensajes Abierto y Cerrado, pero no aparecen los mensajes Abriendo... y Cerrando... Solo eso.

Claro, pero no es que no aparezca el mensaje, es que no te da tiempo a verlo, por eso lo de poner un "retraso" para que dé tiempo a leerlo.

Código Delphi [-]
Label_Mensaje.Caption := 'Abriendo...';
OpenCd(TRUE);
Sleep(1000);  // 1 segundo de espera
Label_Mensaje.Caption := 'Abierto.';

[[ElDioni]]

Código Delphi [-]
Label_Mensaje.Caption := 'Abriendo...';
Application.ProcessMessages;
OpenCd(TRUE); 
Sleep(1000);  // 1 segundo de espera 
Label_Mensaje.Caption := 'Abierto.';

[REHome]

Buenas:

@Casimiro Notevi No hace falta poner ningún Sleep para que me de tiempo, no aparece ese mensaje. El tiempo te lo da lo que dure en abrir la bandeja.

Por cierto, ya funciona con Application.ProcessMessages; que puso nuestro compañero @ElDioni.

Dejo el código Delphi completo por si alguien lo pueda necesitar.

unit Lector_bandeja;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls, MMSystem;

  // No olvidar añadir en uses MMSystem arriba.

type
  TForm1 = class(TForm)
    RadioGroup_Bandeja: TRadioGroup;
    Button_Abrir: TButton;
    Button_Cerrar: TButton;
    Label_Mensaje: TLabel;
    procedure Button_AbrirClick(Sender: TObject);
    procedure Button_CerrarClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure OpenCd(AOpen:Boolean);
const
    DoPlay : array[Boolean] of string = ('Set cdaudio door closed wait',
         'Set cdaudio door open wait');
var
   MyError       : LongInt;
   MyErrorString : array[0..MAXERRORLENGTH - 1] of char;
begin
   MyError := mciSendString(pChar(DoPlay[AOpen]), nil, 0, 0);
   if MyError <> 0 then
   begin
     MciGetErrorString(MyError,MyErrorString,MAXERRORLENGTH - 1);
     Showmessage(MyErrorString);
     Exit;
   end;
end;
procedure TForm1.Button_AbrirClick(Sender: TObject);
begin
    Label_Mensaje.Caption := 'Abriendo...';
    Application.ProcessMessages;
    OpenCd(TRUE);
    Label_Mensaje.Caption := 'Abierto.';
end;

procedure TForm1.Button_CerrarClick(Sender: TObject);
begin
    Label_Mensaje.Caption := 'Cerrando...';
    Application.ProcessMessages;
    OpenCd(FALSE);
    Label_Mensaje.Caption := 'Cerrado.';
end;

end.

Muchas gracias a tod@s.

[Casimiro Noteví]

Me alegro

[REHome]

Hola:

La forma formulario Windows ya funciona al 100 %, ahora toca hacerlo en modo consola con Delphi. Un ejemplo que pongo en C# en modo consola es este. También tengo de VB .net y C++ CLR que hace lo mismo, si lo necesitan porque lo entienden mejor avisen.



Código C#:

using System;
using System.Runtime.InteropServices;
using System.Text;

namespace Lector_teclado_consola_cs
{
    class Program
    {
        [DllImport("winmm.dll")]
        public static extern Int32 mciSendString(string lpstrCommand, StringBuilder lpstrReturnString,
        int uReturnLength, IntPtr hwndCallback);

        public static StringBuilder rt = new StringBuilder(127);

        public static void DoEventsAbriendo()
        {
            Console.SetCursorPosition(0, 6);
            Console.Write("Abriendo...");
        }

        public static void DoEventsCerrando()
        {
            Console.SetCursorPosition(0, 6);
            Console.Write("Cerrando...");
        }

        static void Main(string[] args)
        {
            // Título de la ventana.
            Console.Title = "Control lector de bandeja. C#";

            // Tamaño ventana consola.
            Console.WindowWidth = 29; // X. Ancho.
            Console.WindowHeight = 8; // Y. Alto. 

            // Cursor invisible.
            Console.CursorVisible = false; 

            // Posición del mansaje en la ventana.
            Console.SetCursorPosition(0, 0);
            Console.Write(@"Control bandeja del lector:

A - Abrir bandeja.
C - Cerrar bandeja.
===========================");



            ConsoleKey key;
            //Console.CursorVisible = false;
            do
            {
                key = Console.ReadKey(true).Key;

                string mensaje = string.Empty;

                //Asignamos la tecla presionada por el usuario
                switch (key)
                {
                    case ConsoleKey.A:
                        // mensaje = "Abriendo...";
                        Console.SetCursorPosition(0, 6);
                        DoEventsAbriendo();
                        mciSendString("set CDAudio door open", rt, 127, IntPtr.Zero);
                        mensaje = "Abierto.";
                        break;

                    case ConsoleKey.C:
                        // mensaje = "Cerrando...";
                        Console.SetCursorPosition(0, 6);
                        DoEventsCerrando();
                        mciSendString("set CDAudio door closed", rt, 127, IntPtr.Zero);
                        mensaje = "Cerrado.";
                        break;
                }

                Console.SetCursorPosition(0, 6);
                Console.Write("           ");
                Console.SetCursorPosition(0, 6);
                Console.Write(mensaje);

            }
            while (key != ConsoleKey.Escape);
        }
    }
}

Saludos.

[REHome]

Buenas:

Les dejo el código más simple y directo que el original. (De paso, por si alguien lo necesita).

unit Bandeja_Delphi;

interface

// Añadir MMSystem en el uses.
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, MMSystem;

type
  TForm1 = class(TForm)
    GroupBox_Bandeja: TGroupBox;
    Button_Abrir: TButton;
    Button_Cerrar: TButton;
    Label_Mensaje: TLabel;
    procedure Button_AbrirClick(Sender: TObject);
    procedure Button_CerrarClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button_AbrirClick(Sender: TObject);
begin
    Label_Mensaje.Caption := 'Abriendo...';
    Application.ProcessMessages;
    mciSendString('Set cdaudio door open wait', nil, 0, 0);
    Label_Mensaje.Caption := 'Abierto.';
end;

procedure TForm1.Button_CerrarClick(Sender: TObject);
begin
    Label_Mensaje.Caption := 'Cerrando...';
    Application.ProcessMessages;
    mciSendString('Set cdaudio door closed wait', nil, 0, 0);
    Label_Mensaje.Caption := 'Cerrado.';
end;

end.

Saludos.