main.pas

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

    with GWrite do
    begin
      WriteString('PortW','Port'+IntToStr(i),Cells[1,i]);
      WriteString('Values','Val'+IntToStr(i),Cells[2,i]);
    end;
    with GRead do
    begin
      WriteString('PortR','Port'+IntToStr(i),Cells[1,i]);
    end;
  end;
 end;
 MyIniFile.Free;
 Close;
end;

function HexToInt(s:String):dWord;
const hexch:array[0..15] of Char='0123456789ABCDEF';
var i,j : Byte;
    r,n,k:dWord;
    ch : Char;
begin
  k:=1; r:=0;
  for i:=Length(s) downto 1 do
  begin
    ch:=s[i]; n:=0;
    for j:=0 to 15 do if UpperCase(ch)=hexch[j] then n:=j;
    r:=r+n*k; if i>1 then k:=k*16;
  end;
  Result:=r;
end;

procedure TMainForm.GReadSelectCell(Sender: TObject; Col, Row: Longint;
  var CanSelect: Boolean);
begin
  with GRead do
  begin
    PortRSel:=HexToInt(Cells[1,Row]); NomRSel:=Row;
  end;
end;

procedure TMainForm.B_WriteClick(Sender: TObject);
begin
 with GWrite,HwCtrl do
 begin
   PortWSel:=HexToInt(Cells[1,Row]);    Cells[1,Row]:=IntToHex(PortWSel,4);
   ValWSel:=HexToInt(Cells[2,Row]);     Cells[2,Row]:=IntToHex(ValWSel,2);
   NomWSel:=Row;
   if (PortWSel=0) then begin MessageBeep(0); Exit; end;
   Port[PortWSel]    :=ValWSel;
 end;
end;

procedure TMainForm.B_WriteAllClick(Sender: TObject);
var i,v       : Byte;
    P,N       : Word;
begin
 with GWrite,HwCtrl do
 begin
   N:=0;
   for i:=1 to MaxPorts do
   begin
     P:=HexToInt(Cells[1,i]); Cells[1,i]:=IntToHex(P,4);
     if p>0 then
     begin
       V:=HexToInt(Cells[2,i]); Cells[2,i]:=IntToHex(v,2);
       Inc(N);
       PortRec[N].PortData:=V;
       PortRec[N].PortAddr:=P;
       PortRec[N].fWrite:=TRUE;
       Port[P]:=v;
     end;
   end;
//   if N>0 then PortControl(@PortRec,N);
 end;
end;

procedure TMainForm.B_ReadClick(Sender: TObject);
var b : Byte;
begin
 with GRead,HwCtrl do
 begin
   PortRSel:=HexToInt(Cells[1,Row]); Cells[1,Row]:=IntToHex(PortRSel,4);
   NomRSel:=Row;
   if (PortRSel=0) then begin MessageBeep(0); Exit; end;
   b:=Port[PortRSel];
   Cells[2,Row]:=IntToHex(b,2);
 end;
end;

procedure TMainForm.B_ReadAllClick(Sender: TObject);
var i       : Byte;
    P,N     : Word;
    cl      : array[1..MaxPorts] of Byte;
begin
 with GRead,HwCtrl do
 begin
   N:=0;
   for i:=1 to MaxPorts do
   begin
     P:=HexToInt(Cells[1,i]); Cells[1,i]:=IntToHex(P,4);
     if p>0 then
     begin
       Inc(N); cl[N]:=i;
       PortRec[N].PortAddr:=P;
       PortRec[N].fWrite:=FALSE;
       PortRec[N].PortData:=Port[P];
     end;
   end;
//   if N>0 then PortControl(@PortRec,N);
   for i:=1 to N do
     Cells[2,cl[i]]:=IntToHex(PortRec[i].PortData,2);
 end;
end;

procedure TMainForm.B_SetMemoryClick(Sender: TObject);
begin
  PhysAddr:=HexToInt(E_Addr.text); E_Addr.Text:=IntToHex(PhysAddr,8);
  with HwCtrl do  PointPhys:=TPointPhys(MapPhysToLinear(PhysAddr,256));
  B_SetMemory.Enabled:=FALSE;
  ShowButtons;
end;

procedure TMainForm.B_ReadMemoryClick(Sender: TObject);
var CurrAddr,i,j : dWord;
    s            : String;
    b            : Byte;
    ch           : Char;
begin
  if PointPhys<>NIL then
  begin
    CurrAddr:=PhysAddr;
    for i:=1 to 16 do
    begin
      s:=IntToHex(CurrAddr,8); MemoHex.Cells[0,i]:=s; s:='';
      for j:=1 to 16 do s:=s+IntToHex(PointPhys^[i][j],2);
      MemoHex.Cells[1,i]:=s; s:='';
      for j:=1 to 16 do
      begin
        b:=PointPhys^[i][j];
        if b>=$20 then ch:=Char(b) else ch:='.';  s:=s+ch;
      end;
      MemoHex.Cells[2,i]:=s;
      CurrAddr:=CurrAddr+16;
    end;

  end;

end;

procedure TMainForm.E_AddrChange(Sender: TObject);
begin
  B_SetMemory.Enabled:=HwCtrl.ActiveHW;;
end;

procedure TMainForm.Timer1Timer(Sender: TObject);
var nPin : Byte;
    i : Word;
    s : String;
begin
  with HWCtrl,TextMemo do
  begin
    if ActiveHW then L_Gen.Caption:=IntToStr(IRQCounter);
//    L_Debug.caption:='DebugCode='+IntToStr(DebugCode);
    L_ScanCode.caption:=': '+IntToHex(Scan_Code,2)+'h';
    L_LPT_Data.caption:=': '+IntToHex(Data_Reg,2)+'h';
    L_LPT_STATUS.caption:=': '+IntToHex(Status_Reg,2)+'h';
    L_Timers.Caption:=IntToStr(Flag_tim div 1000);
    L_Flag.Caption:=IntToStr(Flag_Intr);
    if ActiveHW and (not IRQMasked) then
    begin
      CurrTicker:=GetTickCount;
      Flag_Tim:=Sum_Ticks+CurrTicker-OldTicker;
    end else  OldTicker:=GetTickCount;
    for nPin:=1 to 17 do
      CPinRead[nPin].Checked:=Pin[nPin];

    C_ACKWL.Checked := LPTAckwl;
    C_Busy.Checked  := LPTBusy;
    C_ERROR.Checked := LPTError;
    C_PE.Checked    := LPTPaperEnd;
    C_SLCT.Checked  := LPTSlct;

    if FlagPrint then
    begin
      Timer1.Enabled:=FALSE;
      for i:=1 to 100 do
      begin
        Application.ProcessMessages;
        s:=Lines[NumLine]+#$0D#$0A;
        if NumSymbol>Length(s) then
        begin
          if NumLine=Lines.Count then begin
                                        Timer1.Enabled:=TRUE;
                                        FlagPrint:=FALSE; Exit;
                                      end;
          Inc(NumLine);
          s:=Lines[NumLine]+#$0D#$0A;
          NumSymbol:=1;
        end;
        if LPTPrintChar(s[NumSymbol]) then Inc(NumSymbol);
      end;
      Timer1.Enabled:=TRUE;
    end;

    B_Stop.Enabled:=FlagPrint;
    B_Print.Enabled:=not FlagPrint;

  end;
end;

procedure TMainForm.B_MaskClick(Sender: TObject);
begin
  with HWCtrl do
  begin
    if not B_Mask.Checked then
    begin
      Sum_Ticks:=Flag_Tim;
      IRQMasked := TRUE;
      Port[LPTBasePort+2]:=$00;
      C_LPT_IRQ.Checked:=FALSE;
    end
    else
    begin
      IRQ := SpinIRQ.Value;
      IRQNumber  := IRQ;
      Flag_Intr := 0;
      Sum_Ticks := 0;
      Flag_Tim  := 0;
      Scan_Code := 0;
      IRQMasked := FALSE;
    end;
    ShowButtons;
  end;
end;

procedure TMainForm.SpinIRQChange(Sender: TObject);
begin
  IRQ:=SpinIRQ.Value;
  HWCtrl.IRQNumber:=IRQ;
  ShowButtons;
end;

procedure TMainForm.B_FillMemoryClick(Sender: TObject);
var i,j : byte;
begin
  if PointPhys<>NIL then
  begin
    for i:=1 to 16 do
    begin
      for j:=1 to 16 do PointPhys^[i][j]:=16*(i-1)+j-1;
    end;
  end;
end;

procedure TMainForm.C_HardClick(Sender: TObject);
begin
  HwCtrl.HardAccess:=C_Hard.Checked;
end;

procedure TMainForm.C_LPT_IRQClick(Sender: TObject);
begin
  with HwCtrl do
  begin
    if C_LPT_IRQ.Checked then Port[LPTBasePort+2]:=$10
                         else Port[LPTBasePort+2]:=$00;
  end;
end;

procedure TMainForm.WPin1Click(Sender: TObject);
var nPin : Byte;
begin
  for nPin:=1 to 17 do
     HwCtrl.Pin[nPin]:=BOOL(CPinWrite[nPin].Checked);
end;

procedure TMainForm.C_InitClick(Sender: TObject);
begin
  HwCtrl.LPTInit;
end;

procedure TMainForm.B_ClearClick(Sender: TObject);
begin
  TextMemo.Clear;
end;

procedure TMainForm.B_PrintClick(Sender: TObject);
begin
  with TextMemo,HwCtrl do
  begin
    if FlagPrint then Exit;
    NumLine:=0;
    NumSymbol:=1;
    FlagPrint:=TRUE;
  end;
end;

procedure TMainForm.B_StopClick(Sender: TObject);
begin
  FlagPrint:=FALSE;
end;

procedure TMainForm.B_CloseDriverClick(Sender: TObject);
begin
  Timer1.Enabled:=FALSE;
  HwCtrl.Port[HwCtrl.LPTBasePort+2]:=$00;
  C_LPT_IRQ.Checked:=FALSE;
  HwCtrl.CloseDriver;
  B_Mask.Checked:=FALSE;
  PointPhys:=NIL;
  B_SetMemory.Enabled:=FALSE;
  Flag_Intr:=0;
  ShowButtons;
end;

procedure TMainForm.SpinLPTChange(Sender: TObject);
begin
  with HwCtrl do
  begin
    LPTNumber:=SpinLPT.Value;
  end;
  ShowButtons;
end;

procedure TMainForm.HwCtrlHwInterrupt(Sender: TObject; HwCounter: Longint;
  LPT_DataReg, LPT_StatusReg, Keyb_ScanCode: Byte);
begin
  Data_Reg   := LPT_DataReg;
  Status_Reg := LPT_StatusReg;
  Scan_Code  := Keyb_ScanCode;
  IRQCounter := HwCounter;
  Inc(Flag_Intr);
end;

initialization
  NomWSel:=0; NomRSel:=0; PointPhys:=NIL; Flag_Intr:=0; Flag_tim:=0;
  Sum_Ticks:=0;CurrTicker:=0; OldTicker:=0;   Scan_Code := 0;
  FlagPrint:=FALSE; IRQCounter := 0;
end.