fm_pcspkr1.pas

在Windows NT使用I/O端口,包括装载,开始,卸载驱动程序的函数.

unit fm_PCSpkr1;
{ PortTest program  PC Speaker test form

Revisions
---------
98-06-01 GW Original

Copyright info: see main form unit
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  Tfm_PCSpkr = class(TForm)
    GroupBox4: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    bt_NoteOn: TButton;
    tx_Freq: TEdit;
    bt_NoteOff: TButton;
    bt_Enable_Ports: TButton;
    bt_Disable_Ports: TButton;
    Label3: TLabel;
    lb_Result: TLabel;
    procedure bt_NoteOnClick(Sender: TObject);
    procedure bt_NoteOffClick(Sender: TObject);
    procedure bt_Enable_PortsClick(Sender: TObject);
    procedure bt_Disable_PortsClick(Sender: TObject);
    procedure bt_Test_EnableClick(Sender: TObject);
    procedure bt_Test_DisableClick(Sender: TObject);
  private
    { Private declarations }
    function ResultOK(DriverResult: DWORD): Boolean;
  public
    { Public declarations }
  end;

var
  fm_PCSpkr: Tfm_PCSpkr;

//---------------------------------
implementation
//---------------------------------
uses gwportio, gwiopm, gwutil_1;

{$R *.DFM}

//=================================================
// Test I/O to Speaker
//=================================================

{-------------------------------------------
Speaker freq is set by setting divider in Intel
8253/8254 timer chip at port addresses $40 through $43
-------------------------------------------}
procedure setfreq(freq: integer);
Const Clk8253 = 1193180;
Var
  divider: integer;
Begin
  divider :=  Clk8253 div freq;
  PortOut($43, $b6);	         					// timer 2, square wave
  PortOut($42, IntAsBytes(divider).b0);
  PortOut($42, IntAsBytes(divider).b1);
end;

{------------------------------------------
The speaker control is at port $61.
Setting the lowest two bits enables timer 2 of the 8253/8254 timer
and turns on the speaker.
------------------------------------------}
//---------------------------------
procedure SoundOn(freq: integer);
//---------------------------------
Begin
  PortOut($61,PortIn($61) or $03);  // enable speaker
  setfreq(freq);
end;

//---------------------------------
procedure SoundOff;
//---------------------------------
Begin
  PortOut($61,PortIn($61) and ($FF - $03));  // disable speaker
end;

//---------------------------------
procedure Tfm_PCSpkr.bt_NoteOnClick(Sender: TObject);
//---------------------------------
Var
  S: string;
  Freq: integer;
begin
  S := tx_Freq.Text;
  Freq := StrToInt(S);
  SoundOn(Freq);
end;

//---------------------------------
procedure Tfm_PCSpkr.bt_NoteOffClick(Sender: TObject);
//---------------------------------
begin
  SoundOff;
end;

//---------------------------------
function Tfm_PCSpkr.ResultOK(DriverResult: DWORD): Boolean;
//---------------------------------
Begin
  If DriverResult <> ERROR_SUCCESS then
  Begin
    lb_Result.Caption := GWIOPM_Driver.ErrorLookup(DriverResult);
  end;
  result := (DriverResult = ERROR_SUCCESS);
end;

//---------------------------------
procedure Tfm_PCSpkr.bt_Enable_PortsClick(Sender: TObject);
//---------------------------------
Var
  DriverResult: DWORD;
Label the_end;
begin
  lb_Result.Caption := '---';
  lb_Result.Refresh;
  If not ResultOK(GWIOPM_Driver.LIOPM_Set_Ports($42, $43, true)) then goto the_end;
  If not ResultOK(GWIOPM_Driver.LIOPM_Set_Ports($61, $61, true)) then goto the_end;
  If not ResultOK(GWIOPM_Driver.IOCTL_IOPMD_ACTIVATE_KIOPM) then goto the_end;
the_end:
end;

//---------------------------------
procedure Tfm_PCSpkr.bt_Disable_PortsClick(Sender: TObject);
//---------------------------------
Var
  DriverResult: DWORD;
Label the_end;
begin
  lb_Result.Caption := '---';
  lb_Result.Refresh;
  If not ResultOK(GWIOPM_Driver.LIOPM_Set_Ports($42, $43, false)) then goto the_end;
  If not ResultOK(GWIOPM_Driver.LIOPM_Set_Ports($61, $61, false)) then goto the_end;
  If not ResultOK(GWIOPM_Driver.IOCTL_IOPMD_ACTIVATE_KIOPM) then goto the_end;
the_end:
end;

procedure Tfm_PCSpkr.bt_Test_EnableClick(Sender: TObject);
Var
  DriverResult: DWORD;
Label the_end;
begin
  lb_Result.Caption := '---';
  lb_Result.Refresh;
  If not ResultOK(GWIOPM_Driver.LIOPM_Set_Ports($46, $4A, true)) then goto the_end;
  If not ResultOK(GWIOPM_Driver.LIOPM_Set_Ports($4C, $53, true)) then goto the_end;
  If not ResultOK(GWIOPM_Driver.IOCTL_IOPMD_ACTIVATE_KIOPM) then goto the_end;
the_end:
end;

procedure Tfm_PCSpkr.bt_Test_DisableClick(Sender: TObject);
Var
  DriverResult: DWORD;
Label the_end;
begin
  lb_Result.Caption := '---';
  lb_Result.Refresh;
  If not ResultOK(GWIOPM_Driver.LIOPM_Set_Ports($46, $4A, false)) then goto the_end;
  If not ResultOK(GWIOPM_Driver.LIOPM_Set_Ports($4C, $53, false)) then goto the_end;
  If not ResultOK(GWIOPM_Driver.IOCTL_IOPMD_ACTIVATE_KIOPM) then goto the_end;
the_end:
end;

end.