📄 fm_ioport1.pas
字号:
unit fm_IOPort1;
{ PortTest program IO Port form
Revisions
---------
98-06-01 GW Original
Copyright info: see main form unit
}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Grids, ExtCtrls, StdCtrls, Menus;
type
Tfm_IOPort = class(TForm)
Panel1: TPanel;
sg_Heads: TStringGrid;
sg_IOPort: TStringGrid;
lb_Scratch: TLabel;
bt_Change: TButton;
Label1: TLabel;
Label2: TLabel;
procedure FormCreate(Sender: TObject);
procedure sg_IOPortSelectCell(Sender: TObject; Col, Row: Integer;
var CanSelect: Boolean);
procedure sg_IOPortMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure bt_ChangeClick(Sender: TObject);
procedure sg_IOPortEnter(Sender: TObject);
procedure sg_IOPortExit(Sender: TObject);
private
{ Private declarations }
AddrBase: integer;
AddrCount: integer;
sg_IOPort_EditCol : integer;
sg_IOPort_EditRow : integer;
procedure sg_IOPort_Init;
procedure UpdateBinFromHex(RowNum: integer; RW: char);
procedure UpdateHexFromBin(RowNum: integer; RW: char);
procedure sg_IOPort_EditClear;
procedure sg_IOPort_Editing(NewCol, NewRow: integer);
procedure sg_IOPort_EditCommitCheck(NewCol, NewRow: integer; Leaving: Boolean);
procedure sg_IOPort_EditCommit; // OldCol, OldRow
procedure WriteValueChangeCheck(RowNum: integer);
public
{ Public declarations }
end;
var
fm_IOPort: Tfm_IOPort;
//==========================================================
implementation
//==========================================================
uses fm_BaseCount1, gwutil_1, gwportio;
{$R *.DFM}
Type
Tgcf1 = (gcf_Addr, gcf_Read, gcf_Write, gcf_Old);
TColInfo = record
Width: integer;
Caption: string;
Func: Tgcf1;
Base: shortint; //0-7, 10=decimal, 16=hex, -1 = none
end;
Const
{ grid col constants }
gc_Begin = 0;
gc_AddHex = 0; gc_AddDec = 1;
gc_RR = 2; gc_RHex = 3;
gc_R7 = 4; gc_R6 = 5; gc_R5 = 6; gc_R4 = 7;
gc_R3 = 8; gc_R2 = 9; gc_R1 = 10; gc_R0 = 11;
gc_WArrow = 12; gc_WW = 13; gc_WHex = 14;
gc_W7 = 15; gc_W6 = 16; gc_W5 = 17; gc_W4 = 18;
gc_W3 = 19; gc_W2 = 20; gc_W1 = 21; gc_W0 = 22;
gc_WOld = 23;
gc_End = 23;
gc_Count = gc_End-gc_Begin+1;
gcb_Doit = -1;
gcb_Arrow = -2;
gcb_Dec = -10;
gcb_Hex = -16;
MainColInfo : array[gc_Begin..gc_End] of TColInfo = (
(Width: 40; Caption: 'Hex' ; Func: gcf_Addr ; Base: gcb_Hex ),
(Width: 40; Caption: 'Dec' ; Func: gcf_Addr ; Base: gcb_Dec ),
(Width: 16; Caption: 'R' ; Func: gcf_Read ; Base: gcb_Doit ),
(Width: 40; Caption: 'Hex' ; Func: gcf_Read ; Base: gcb_Hex ),
(Width: 16; Caption: '7' ; Func: gcf_Read ; Base: 7 ),
(Width: 16; Caption: '6' ; Func: gcf_Read ; Base: 6 ),
(Width: 16; Caption: '5' ; Func: gcf_Read ; Base: 5 ),
(Width: 16; Caption: '4' ; Func: gcf_Read ; Base: 4 ),
(Width: 16; Caption: '3' ; Func: gcf_Read ; Base: 3 ),
(Width: 16; Caption: '2' ; Func: gcf_Read ; Base: 2 ),
(Width: 16; Caption: '1' ; Func: gcf_Read ; Base: 1 ),
(Width: 16; Caption: '0' ; Func: gcf_Read ; Base: 0 ),
(Width: 16; Caption: '->' ; Func: gcf_Write; Base: gcb_Arrow),
(Width: 16; Caption: 'W' ; Func: gcf_Write; Base: gcb_Doit ),
(Width: 40; Caption: 'Hex' ; Func: gcf_Write; Base: gcb_Hex ),
(Width: 16; Caption: '7' ; Func: gcf_Write; Base: 7 ),
(Width: 16; Caption: '6' ; Func: gcf_Write; Base: 6 ),
(Width: 16; Caption: '5' ; Func: gcf_Write; Base: 5 ),
(Width: 16; Caption: '4' ; Func: gcf_Write; Base: 4 ),
(Width: 16; Caption: '3' ; Func: gcf_Write; Base: 3 ),
(Width: 16; Caption: '2' ; Func: gcf_Write; Base: 2 ),
(Width: 16; Caption: '1' ; Func: gcf_Write; Base: 1 ),
(Width: 16; Caption: '0' ; Func: gcf_Write; Base: 0 ),
(Width: 0; Caption: 'Old' ; Func: gcf_Old ; Base: gcb_Hex )
);
gch_Begin = 0;
gch_Add = 0;
gch_Read = 1;
gch_Write = 2;
gch_Dummy = 3;
gch_End = 3;
gch_Count = gch_End-gch_Begin+1;
HeadColInfo : array[gch_Begin..gch_End] of TColInfo = (
(Width: 80+1; Caption: 'Port Address' ),
(Width: 40+ 9*17; Caption: ' Read' ),
(Width: 40+10*17; Caption: ' Write' ),
(Width: 0; Caption: '' )
);
//----------------------------------------------
procedure Tfm_IOPort.sg_IOPort_Init;
//----------------------------------------------
Var
AddrIx, RowNum: integer;
rect: TGridRect;
Begin
sg_IOPort.RowCount := 1; { to clear existing data }
sg_IOPort.RowCount := 1 + AddrCount;
If sg_IOPort.RowCount < 2 then
Begin { fixup due to losing fixed row if rowcount < 2 }
sg_IOPort.RowCount := 2;
end;
sg_IOPort.FixedRows := 1;
For AddrIx := 0 to AddrCount-1 do
Begin
RowNum := AddrIx + 1;
sg_IOPort.Cells[gc_AddHex , RowNum] := IntToHex(AddrBase+AddrIx,4);
sg_IOPort.Cells[gc_AddDec , RowNum] := IntToStr(AddrBase+AddrIx);
sg_IOPort.Cells[gc_RR , RowNum] := 'R';
sg_IOPort.Cells[gc_RHex , RowNum] := '??'; // IntToHex(ByteFake,2);
sg_IOPort.Cells[gc_WArrow , RowNum] := '->';
sg_IOPort.Cells[gc_WW , RowNum] := '-';
sg_IOPort.Cells[gc_WOld , RowNum] := '--';
UpdateBinFromHex(RowNum,'R');
end;
rect.Left := gc_WHex;
rect.Right := gc_WHex;
rect.Top := 1;
rect.Bottom := 1;
sg_IOPort.Selection := rect;
end;
//----------------------------------------------
procedure Tfm_IOPort.UpdateBinFromHex(RowNum: integer; RW: char);
//----------------------------------------------
Var
HexCol, HexVal, B, N: integer;
BitChar: char;
Label the_end;
Begin
HexCol := 0;
Case RW of
'R': HexCol := gc_RHex;
'W': HexCol := gc_WHex;
end;
If HexCol = 0 then goto the_end;
If sg_IOPort.Cells[HexCol,RowNum] = '??' then
For N := 0 to 7 do
Begin
BitChar := ' ';
sg_IOPort.Cells[HexCol+8-N,RowNum] := BitChar;
goto the_end;
end;
HexVal := HexToIntDef(sg_IOPort.Cells[HexCol,RowNum], -1);
For N := 0 to 7 do
Begin
BitChar := '1';
B := 1 shl N;
If (B and HexVal) = 0 then BitChar := '0';
sg_IOPort.Cells[HexCol+8-N,RowNum] := BitChar;
end;
the_end:
end;
//----------------------------------------------
procedure Tfm_IOPort.UpdateHexFromBin(RowNum: integer; RW: char);
//----------------------------------------------
Var
HexCol, HexVal, B, N: integer;
BitChar: char;
Label the_end;
Begin
HexCol := 0;
Case RW of
'R': HexCol := gc_RHex;
'W': HexCol := gc_WHex;
end;
If HexCol = 0 then goto the_end;
HexVal := 0;
For N := 0 to 7 do
Begin
BitChar := (sg_IOPort.Cells[HexCol+8-N,RowNum] + '0')[1];
If BitChar = '1' then
Begin
B := 1 shl N;
HexVal := HexVal or B;
end;
end;
sg_IOPort.Cells[HexCol,RowNum] := IntToHex(HexVal, 2);
the_end:
end;
//----------------------------------------------
procedure Tfm_IOPort.FormCreate(Sender: TObject);
//----------------------------------------------
Var
ColNum: integer;
begin
// Set up string grids
sg_IOPort.ColCount := gc_Count;
For ColNum := gc_Begin to gc_End do
Begin
sg_IOPort.ColWidths[ColNum] := MainColInfo[ColNum].Width;
sg_IOPort.Cells[ColNum,0] := MainColInfo[ColNum].Caption;
end;
sg_Heads.ColCount := gch_Count;
For ColNum := gch_Begin to gch_End do
Begin
sg_Heads.ColWidths[ColNum] := HeadColInfo[ColNum].Width;
sg_Heads.Cells[ColNum,0] := HeadColInfo[ColNum].Caption;
end;
AddrBase := 0;
AddrCount := $10;
sg_IOPort_Init;
sg_IOPort_EditClear;
end;
//--------------------------------------------------
procedure Tfm_IOPort.sg_IOPortSelectCell(Sender: TObject; Col, Row: Integer;
var CanSelect: Boolean);
//--------------------------------------------------
Var
CellRect: TRect;
OldRow, OldCol: integer;
begin
CanSelect := (
(MainColInfo[Col].Func = gcf_Write) and
((MainColInfo[Col].Base >= 0) or (MainColInfo[Col].Base = gcb_Hex))
);
sg_IOPort_EditCommitCheck(Col, Row, CanSelect);
if CanSelect then
Begin
sg_IOPort_Editing(Col, Row);
end;
end;
//--------------------------------------------------
procedure Tfm_IOPort.sg_IOPortMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
//--------------------------------------------------
Var
ColNum, RowNum: integer;
S, OutB, AddHex: string;
Addr: integer;
TempByte: byte;
begin
sg_IOPort.MouseToCell(X, Y, ColNum, RowNum);
// sg_IOPort_EditCommitCheck(ColNum, RowNum, false); redundant
// lb_Scratch.Caption := 'Col ' + IntToStr(ColNum) + ',Row ' + IntToStr(RowNum);
Case ColNum of
gc_RR: Begin
AddHex := sg_IOPort.Cells[gc_AddHex, RowNum];
Addr := HexToIntDef(AddHex,0);
TempByte := PortIn(Addr);
sg_IOPort.Cells[gc_RHex , RowNum] := IntToHex(TempByte,2);
UpdateBinFromHex(RowNum,'R');
end;
gc_WArrow: Begin
S := sg_IOPort.Cells[gc_RHex , RowNum];
If S = '??' then S := '00';
sg_IOPort.Cells[gc_WHex , RowNum] := S;
UpdateBinFromHex(RowNum,'W');
WriteValueChangeCheck(RowNum);
end;
gc_WW: Begin
OutB := Copy(sg_IOPort.Cells[gc_WHex , RowNum]+'00',1,2);
TempByte := HexToIntDef(OutB,0);
AddHex := sg_IOPort.Cells[gc_AddHex, RowNum];
Addr := HexToIntDef(AddHex,0);
S := 'Writing '+ OutB +' to port '+AddHex;
Application.MessageBox(PChar(S), '',MB_OK );
PortOut(Addr, TempByte);
sg_IOPort.Cells[gc_WW , RowNum] := '-';
sg_IOPort.Cells[gc_WOld, RowNum] := OutB;
end;
end; { case }
end;
//--------------------------------------------------
procedure Tfm_IOPort.bt_ChangeClick(Sender: TObject);
//--------------------------------------------------
Var
Status: integer;
begin
fm_BaseCount.Top := Top+50;
fm_BaseCount.Left := Left+50;
status := fm_BaseCount.ShowModal;
if status = mrOK then
Begin
AddrBase := fm_BaseCount.LastBase;
AddrCount := fm_BaseCount.LastCount;
sg_IOPort_Init;
end;
end;
//------------------------------------------------
procedure Tfm_IOPort.sg_IOPortEnter(Sender: TObject);
//------------------------------------------------
begin // Don't insert code in this proc
sg_IOPort_Editing(sg_IOPort.Selection.Left, sg_IOPort.Selection.Top);
end;
//------------------------------------------------
procedure Tfm_IOPort.sg_IOPortExit(Sender: TObject);
//------------------------------------------------
begin // Don't insert code in this proc
sg_IOPort_EditCommitCheck(-1,-1, true);
end;
//------------------------------------------------
procedure Tfm_IOPort.sg_IOPort_EditCommitCheck(NewCol, NewRow: integer; Leaving: Boolean);
//------------------------------------------------
Label the_end;
Begin // Don't insert code in this proc
If (sg_IOPort_EditCol <> -1) and (sg_IOPort_EditRow <> -1 ) then
sg_IOPort_EditCommit;
if Leaving then sg_IOPort_EditClear;
the_end:
end;
//------------------------------------------------
procedure Tfm_IOPort.sg_IOPort_EditClear;
//------------------------------------------------
Begin // Don't insert code in this proc
sg_IOPort_EditCol := -1;
sg_IOPort_EditRow := -1;
end;
//------------------------------------------------
procedure Tfm_IOPort.sg_IOPort_Editing(NewCol, NewRow: integer);
//------------------------------------------------
Begin
sg_IOPort_EditCol := NewCol;
sg_IOPort_EditRow := NewRow;
end;
//------------------------------------------------
procedure Tfm_IOPort.sg_IOPort_EditCommit;
//------------------------------------------------
// Get here ONLY from EditCommitCheck !!!
Var
S: string;
Begin
S := sg_IOPort.Cells[sg_IOPort_EditCol, sg_IOPort_EditRow];
Case sg_IOPort_EditCol of
gc_WHex: Begin
S := IntToHex(HexToIntDef(S,0),2);
sg_IOPort.Cells[sg_IOPort_EditCol, sg_IOPort_EditRow] := S;
UpdateBinFromHex(sg_IOPort_EditRow, 'W');
WriteValueChangeCheck(sg_IOPort_EditRow);
end;
gc_W7..gc_W0: Begin
If Length(S) > 0 then
Begin
if S[1] = '1' then S := '1' else
if S[1] = '0' then S := '0' else S := '0';
end else S := '0';
sg_IOPort.Cells[sg_IOPort_EditCol, sg_IOPort_EditRow] := S;
UpdateHexFromBin(sg_IOPort_EditRow, 'W');
WriteValueChangeCheck(sg_IOPort_EditRow);
end;
end; {case}
end;
//------------------------------------------------------------
procedure Tfm_IOPort.WriteValueChangeCheck(RowNum: integer);
//------------------------------------------------------------
Var
S: string;
C: char;
Begin
S := sg_IOPort.Cells[gc_WOld, RowNum];
C := '-';
If S <> sg_IOPort.Cells[gc_WHex, RowNum] then C := 'W';
sg_IOPort.Cells[gc_WW, RowNum] := C;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -