main.pas

《Delphi5企业级解决方案及应用剖析》参考程序 DELPHI 资料集

unit Main;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,IniFiles,
  Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Menus, Spin, Grids,
  ComCtrls, Tabnotbk, HW_32;

type
  TMainForm = class(TForm)
    BitBtn3: TBitBtn;
    B_Open: TButton;
    Timer1: TTimer;
    Panel1: TPanel;
    Label4: TLabel;
    Label6: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label3: TLabel;
    TabbedNotebook1: TTabbedNotebook;
    B_Read: TButton;
    B_ReadAll: TButton;
    B_Write: TButton;
    B_WriteAll: TButton;
    GRead: TStringGrid;
    GWrite: TStringGrid;
    C_Hard: TCheckBox;
    Label12: TLabel;
    E_Addr: TEdit;
    B_SetMemory: TButton;
    B_ReadMemory: TButton;
    MemoHex: TStringGrid;
    B_FillMemory: TButton;
    L_Flag: TLabel;
    L_Gen: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    Label5: TLabel;
    L_Timers: TLabel;
    Label7: TLabel;
    B_Mask: TCheckBox;
    Label10: TLabel;
    L_ScanCode: TLabel;
    Label13: TLabel;
    L_LPT_Data: TLabel;
    Label15: TLabel;
    L_LPT_STATUS: TLabel;
    C_LPT_IRQ: TCheckBox;
    G_Read: TGroupBox;
    Label11: TLabel;
    Label14: TLabel;
    RPin1: TCheckBox;
    RPin2: TCheckBox;
    RPin3: TCheckBox;
    RPin4: TCheckBox;
    RPin5: TCheckBox;
    RPin6: TCheckBox;
    Rpin7: TCheckBox;
    RPin8: TCheckBox;
    RPin9: TCheckBox;
    RPin10: TCheckBox;
    RPin11: TCheckBox;
    RPin12: TCheckBox;
    RPin13: TCheckBox;
    RPin14: TCheckBox;
    RPin15: TCheckBox;
    RPin16: TCheckBox;
    RPin17: TCheckBox;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    CheckBox5: TCheckBox;
    CheckBox6: TCheckBox;
    CheckBox7: TCheckBox;
    CheckBox8: TCheckBox;
    GroupBox1: TGroupBox;
    Label16: TLabel;
    Label17: TLabel;
    WPin1: TCheckBox;
    WPin2: TCheckBox;
    WPin3: TCheckBox;
    WPin4: TCheckBox;
    WPin5: TCheckBox;
    WPin6: TCheckBox;
    WPin7: TCheckBox;
    WPin8: TCheckBox;
    WPin9: TCheckBox;
    WPin14: TCheckBox;
    WPin15: TCheckBox;
    WPin17: TCheckBox;
    WPin10: TCheckBox;
    WPin11: TCheckBox;
    WPin12: TCheckBox;
    WPin13: TCheckBox;
    WPin16: TCheckBox;
    CheckBox9: TCheckBox;
    CheckBox10: TCheckBox;
    CheckBox11: TCheckBox;
    CheckBox12: TCheckBox;
    CheckBox13: TCheckBox;
    CheckBox14: TCheckBox;
    CheckBox15: TCheckBox;
    CheckBox16: TCheckBox;
    GroupBox2: TGroupBox;
    C_BUSY: TCheckBox;
    C_PE: TCheckBox;
    C_ERROR: TCheckBox;
    C_Init: TButton;
    B_Print: TButton;
    B_Clear: TButton;
    B_Stop: TButton;
    C_ACKWL: TCheckBox;
    C_SLCT: TCheckBox;
    TextMemo: TMemo;
    Label18: TLabel;
    SpinIRQ: TSpinEdit;
    B_CloseDriver: TButton;
    GroupBox3: TGroupBox;
    Label19: TLabel;
    L_LPTs: TLabel;
    Label20: TLabel;
    Label21: TLabel;
    SpinLPT: TSpinEdit;
    L_Base: TLabel;
    HwCtrl: TVicHw32;
    procedure B_OpenClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormActivate(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure GReadSelectCell(Sender: TObject; Col, Row: Longint;
      var CanSelect: Boolean);
    procedure B_WriteClick(Sender: TObject);
    procedure B_WriteAllClick(Sender: TObject);
    procedure B_ReadClick(Sender: TObject);
    procedure B_ReadAllClick(Sender: TObject);
    procedure B_SetMemoryClick(Sender: TObject);
    procedure B_ReadMemoryClick(Sender: TObject);
    procedure E_AddrChange(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure B_MaskClick(Sender: TObject);
    procedure SpinIRQChange(Sender: TObject);
    procedure B_FillMemoryClick(Sender: TObject);
    procedure C_HardClick(Sender: TObject);
    procedure C_LPT_IRQClick(Sender: TObject);
    procedure WPin1Click(Sender: TObject);
    procedure C_InitClick(Sender: TObject);
    procedure B_ClearClick(Sender: TObject);
    procedure B_PrintClick(Sender: TObject);
    procedure B_StopClick(Sender: TObject);
    procedure B_CloseDriverClick(Sender: TObject);
    procedure SpinLPTChange(Sender: TObject);
    procedure HwCtrlHwInterrupt(Sender: TObject; HwCounter: Longint;
      LPT_DataReg, LPT_StatusReg, Keyb_ScanCode: Byte);
  end;

const MaxPorts = 8;

var
  MainForm: TMainForm;
  PortWSel,PortRSel:Word;
  ValWSel:Byte;
  NomWSel,NomRSel:Byte;
  PhysAddr : dWord;
  TestString : array[0..255]of Char;
  TestVar : LongInt;
  Scan_Code : Byte;
  Data_Reg  : Byte;
  Status_Reg : Byte;
  IRQCounter : Longint;
var CPinRead,CPinWrite : array[1..25] of TCheckBox;

type SingleData = array[1..16] of Byte;
     SegData    = array[1..16] of SingleData;
     TPointPhys =^SegData;

var  PointPhys  : TPointPhys;
     Flag_Intr  : LongInt;
     Flag_tim   : LongInt;
     Sum_Ticks,CurrTicker, OldTicker : Longint;
     IRQ        : Byte;

  FlagPrint : Boolean;
  NumLine : Word;
  NumSymbol:Word;

implementation

var PortRec : array[1..MaxPorts] of record
                                  PortAddr : Word;
                                  PortData : Byte;
                                  fWrite   : Boolean;
                                end;


{$R *.DFM}

procedure ShowButtons;
var nPin : Byte;
begin
  with MainForm,HwCtrl do
  begin
   B_SetMemory.Enabled := ActiveHW;
   if not ActiveHW then B_Mask.Checked := FALSE;
   SpinLPT.Enabled:=ActiveHW;
   SpinLPT.MaxValue:=LPTNumPorts;
   L_LPTs.caption:=IntToStr(LPTNumPorts);
   L_BASE.caption:=IntToHex(LPTBasePort,3)+'h';
   C_Hard.Checked := HardAccess;
   C_Hard.Enabled := ActiveHW;
   SpinIRQ.Enabled := ActiveHW and (not B_Mask.Checked);
   B_Open.Enabled:=not ActiveHW;
   B_CloseDriver.Enabled := ActiveHW;
   B_Write.Enabled:=ActiveHW;
   B_Read.Enabled:=ActiveHW;
   B_WriteAll.Enabled:=ActiveHW;
   B_ReadAll.Enabled:=ActiveHW;
   C_Init.Enabled:=ActiveHW;
   B_Print.Enabled:=ActiveHW;
   B_Stop.Enabled:=ActiveHW;
   B_ReadMemory.Enabled:=ActiveHW and (PointPhys<>NIL);
   B_FillMemory.Enabled:=ActiveHW and (PointPhys<>NIL);
   B_Mask.Enabled:=ActiveHW and (IRQNumber>0) and (IRQNumber<16);
   C_LPT_IRQ.Enabled:=ActiveHW and (((IRQNumber=7) and (LPTNumber=1))
   or ((IRQNumber=5) and (LPTNumber=2)));
   for nPin:=1 to 17 do
   begin
     if not ActiveHW then CPinRead[nPin].Checked:=FALSE;
     if not ActiveHW then CPinWrite[nPin].Checked:=FALSE;
     CPinWrite[nPin].Enabled:=ActiveHW;
   end;
   CPinWrite[10].Enabled:=FALSE;
   CPinWrite[11].Enabled:=FALSE;
   CPinWrite[12].Enabled:=FALSE;
   CPinWrite[13].Enabled:=FALSE;
   CPinWrite[15].Enabled:=FALSE;
  end;
end;

procedure TMainForm.B_OpenClick(Sender: TObject);
begin
  HwCtrl.OpenDriver;
//  L_Debug.caption:='DebugCode='+IntToStr(HwCtrl.DebugCode);
  if not HwCtrl.ActiveHW then
  begin
    MessageBeep(0);
    Application.MessageBox('The driver "VICHWxx" not found',
                           ' Warning! ',mb_OK or mb_ICONHAND);
  end
  else begin
         IRQ:=SPinIRQ.Value;
         HWCtrl.IRQNumber:=IRQ;
         Timer1.Enabled:=TRUE;
       end;
  B_SetMemory.Enabled:=TRUE;
  ShowButtons;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  HwCtrl.CloseDriver;
  ShowButtons;
end;

procedure TMainForm.FormActivate(Sender: TObject);
var MyIniFile : TIniFile;
    i         : Word;
begin

 MyInifile:=TIniFile.Create('HW_test.ini');
 TabbedNotebook1.PageIndex := 0; 
 with MyIniFile,HWCtrl do
 begin
   CPinRead[ 1]:=RPin1;    CPinWrite[ 1]:=WPin1;
   CPinRead[ 2]:=RPin2;    CPinWrite[ 2]:=WPin2;
   CPinRead[ 3]:=RPin3;    CPinWrite[ 3]:=WPin3;
   CPinRead[ 4]:=RPin4;    CPinWrite[ 4]:=WPin4;
   CPinRead[ 5]:=RPin5;    CPinWrite[ 5]:=WPin5;
   CPinRead[ 6]:=RPin6;    CPinWrite[ 6]:=WPin6;
   CPinRead[ 7]:=RPin7;    CPinWrite[ 7]:=WPin7;
   CPinRead[ 8]:=RPin8;    CPinWrite[ 8]:=WPin8;
   CPinRead[ 9]:=RPin9;    CPinWrite[ 9]:=WPin9;
   CPinRead[10]:=RPin10;   CPinWrite[10]:=WPin10; WPin10.Enabled:=FALSE;
   CPinRead[11]:=RPin11;   CPinWrite[11]:=WPin11; WPin11.Enabled:=FALSE;
   CPinRead[12]:=RPin12;   CPinWrite[12]:=WPin12; WPin12.Enabled:=FALSE;
   CPinRead[13]:=RPin13;   CPinWrite[13]:=WPin13; WPin13.Enabled:=FALSE;
   CPinRead[14]:=RPin14;   CPinWrite[14]:=WPin14;
   CPinRead[15]:=RPin15;   CPinWrite[15]:=WPin15; WPin15.Enabled:=FALSE;
   CPinRead[16]:=RPin16;   CPinWrite[16]:=WPin16;
   CPinRead[17]:=RPin17;   CPinWrite[17]:=WPin17;


  if (GetVersion() and $80000000)<>0 then
     Label3.caption:='Windows 95/98'
  else
     Label3.caption:='Windows NT';
  PhysAddr:=ReadInteger('misc','ADDR',$F8000);
  IRQ:=ReadInteger('misc','IRQ',10);
  SpinIRQ.Value:=IRQ;
  E_Addr.text:=IntToHex(PhysAddr,8);
  for i:=1 to MaxPorts do
  begin
    with GWrite do
    begin
      Cells[0,i]:=IntToStr(i);
      Cells[1,0]:='PORT'; Cells[2,0]:='VAL';
      Cells[1,i]:=ReadString('PortW','Port'+IntToStr(i),'');
      Cells[2,i]:=ReadString('Values','Val'+IntToStr(i),'');
    end;
    with GRead do
    begin
      Cells[0,i]:=IntToStr(i);
      Cells[1,0]:='PORT'; Cells[2,0]:='VAL';
      Cells[1,i]:=ReadString('PortR','Port'+IntToStr(i),'');
    end;
  end;
 end;
 MyIniFile.Free;
 with MemoHex do
 begin
   Cells[0,0]:='  ADDR';
   Cells[1,0]:='             HEX';
   Cells[2,0]:='     ASCII';
 end;
 ShowButtons;
end;

procedure TMainForm.BitBtn3Click(Sender: TObject);
var MyIniFile : TIniFile;
    i         : Word;
begin
 MyInifile:=TIniFile.Create('HW_test.ini');
 with MyIniFile,HWCtrl  do
 begin
  WriteInteger('misc','ADDR',PhysAddr);
  WriteInteger('misc','IRQ',IRQ);
  for i:=1 to MaxPorts do
  begin