⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 eeprom_form.~pas

📁 AVR开发板电路图/PCB/示范程序
💻 ~PAS
📖 第 1 页 / 共 2 页
字号:
{-----------------------------------------------------------------------------
 Unit Name:  Unit1
 Author :    A1.Aleyn.wu
 E-mail :    Aleyn@e-midas.cn
 QQ/Group:   2282902/7617215
 Purpose:
 History:    v1.0
-----------------------------------------------------------------------------}

unit EEPROM_form;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DB, DBGrids, StdCtrls, DBClient, ExtCtrls, ToolWin,
  ComCtrls, CPort, ActnList, CPortCtl, HMRegistry,Midas;

type
  TForm1 = class(TForm)
    DataSource1: TDataSource;
    cdsAVR: TClientDataSet;
    cdsAVRF1: TStringField;
    cdsAVRF2: TStringField;
    cdsAVRF3: TStringField;
    cdsAVRF4: TStringField;
    cdsAVRF5: TStringField;
    cdsAVRF6: TStringField;
    cdsAVRF7: TStringField;
    cdsAVRF8: TStringField;
    cdsAVRF9: TStringField;
    cdsAVRFA: TStringField;
    cdsAVRFB: TStringField;
    cdsAVRFC: TStringField;
    cdsAVRFD: TStringField;
    cdsAVRFE: TStringField;
    cdsAVRFF: TStringField;
    cdsAVRFS: TStringField;
    ToolBar1: TToolBar;
    ActionList1: TActionList;
    actHelp: TAction;
    actRead: TAction;
    actWrite: TAction;
    actExit: TAction;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    actStart: TAction;
    actStop: TAction;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    cdsAVRF0: TStringField;
    cdsAVRFI: TStringField;
    prs: TProgressBar;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    actOpen: TAction;
    actSave: TAction;
    ToolButton13: TToolButton;
    cdsImport: TClientDataSet;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Panel1: TPanel;
    DBGrid1: TDBGrid;
    Splitter1: TSplitter;
    Memo1: TMemo;
    Panel2: TPanel;
    Splitter2: TSplitter;
    GroupBox1: TGroupBox;
    opnAddr1: TRadioButton;
    opnAddr2: TRadioButton;
    GroupBox2: TGroupBox;
    ra2: TCheckBox;
    ra1: TCheckBox;
    ra0: TCheckBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    wa2: TCheckBox;
    wa1: TCheckBox;
    wa0: TCheckBox;
    Label5: TLabel;
    ComPort1: TComPort;
    GroupBox3: TGroupBox;
    ComLed1: TComLed;
    ComLed3: TComLed;
    ComLed4: TComLed;
    ComLed5: TComLed;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    cmbPort: TComComboBox;
    cmbRate: TComComboBox;
    cmbData: TComComboBox;
    cmbFlow: TComComboBox;
    cmbParity: TComComboBox;
    cmbStop: TComComboBox;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    btnUpdate: TButton;
    Reg: THMRegistry;
    procedure actHelpExecute(Sender: TObject);
    procedure actStartExecute(Sender: TObject);
    procedure actStopExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure actReadExecute(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure actExitExecute(Sender: TObject);
    procedure actWriteExecute(Sender: TObject);
    procedure actOpenExecute(Sender: TObject);
    procedure actSaveExecute(Sender: TObject);
    procedure cdsAVRBeforePost(DataSet: TDataSet);
    procedure ComPort1RxChar(Sender: TObject; Count: Integer);
    procedure btnUpdateClick(Sender: TObject);
  private
    FBuffer: PChar;
    FBufIdx: integer;
    SBuffer: PChar;
  public
    procedure OpenPort;
    procedure ClosePort;
    procedure WritePort(Buffer: Pointer; Count: Integer);
    procedure PressBuffer(Buffer: Pointer; BufferLength: Integer);
  end;

type
  TWriteCommThread = class(TThread)
  private
    FAddrType: integer;
    procedure SetAddrType(const Value: integer);
  protected
    procedure Execute; override;
  public
    property AddrType: integer read FAddrType write SetAddrType;
  end;

const
  CMDBEGIN = #27;
  CMDEND = #28;
  CMDHELP = #72;
  CMDREAD = #82;
  CMDWRITE = #87;

var
  Form1: TForm1;
  VaildWrite: PChar;
  WriteResult: Boolean;

implementation

{$R *.dfm}

const
  Convert: array[0..15] of Char = '0123456789ABCDEF';

procedure TForm1.FormCreate(Sender: TObject);
begin
  Reg.OpenKey;
  if Reg.ValueExists('Port') then cmbPort.Text := Reg.SValue['Port'];
  if Reg.ValueExists('Rate') then cmbRate.Text := Reg.SValue['Rate'];
  if Reg.ValueExists('Data') then cmbData.Text := Reg.SValue['Data'];
  if Reg.ValueExists('Flow') then cmbFlow.Text := Reg.SValue['Flow'];
  if Reg.ValueExists('Parity') then cmbParity.Text := Reg.SValue['Parity'];
  if Reg.ValueExists('Stop') then cmbStop.Text := Reg.SValue['Stop'];
  Reg.CloseKey;
  btnUpdateClick(Sender);
  GetMem(FBuffer, 4096);
  GetMem(SBuffer, 4096);
  GetMem(VaildWrite, 3);
  cdsAVR.LoadFromFile('HexTable.cds');
  cdsAVR.Open;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Reg.OpenKey;
  Reg.SValue['Port'] := cmbPort.Text;
  Reg.SValue['Rate'] := cmbRate.Text;
  Reg.SValue['Data'] := cmbData.Text;
  Reg.SValue['Flow'] := cmbFlow.Text;
  Reg.SValue['Parity'] := cmbParity.Text;
  Reg.SValue['Stop'] := cmbStop.Text;

  FreeMem(FBuffer);
  FreeMem(SBuffer);
  FreeMem(VaildWrite);
  FBufIdx := 0;
end;

procedure TForm1.actHelpExecute(Sender: TObject);
var
  Buffer: PChar;
begin
  GetMem(Buffer, 32); //命令缓冲区
  try
    Buffer[0] := CMDBEGIN; //命令开始符
    Buffer[1] := CMDHELP; //标志这条命令是要求AVR发送HELP给PC
    Buffer[2] := CMDEND; //命令结束符
    //ComPort1.Write(Buffer, 4);
    WritePort(Buffer, 4); //从串口发出命令
    Sleep(100); //等待 100ms,此间AVR会发回信息
  finally
    FreeMem(Buffer);
  end;
end;

procedure TForm1.actStartExecute(Sender: TObject);
begin
  OpenPort;
  actStart.Enabled := False;
  actStop.Enabled := True;
end;

procedure TForm1.actStopExecute(Sender: TObject);
begin
  ClosePort;
  actStart.Enabled := True;
  actStop.Enabled := False;
end;

procedure TForm1.actReadExecute(Sender: TObject);
var
  Buffer: PChar;
  Buf2: array[1..2] of Byte;
begin
  GetMem(Buffer, 32);
  try
    Buffer[0] := CMDBEGIN;
    Buffer[1] := CMDREAD;

    if opnAddr1.Checked then
      Buf2[1] := 1
    else
      Buf2[1] := 2;
    Buf2[2] := 0;

    if ra0.Checked then Buf2[2] := Buf2[2] + 2;
    if ra1.Checked then Buf2[2] := Buf2[2] + 4;
    if ra2.Checked then Buf2[2] := Buf2[2] + 8;
    BinToHex(@Buf2[1], @Buffer[2], 2); //Memory Address Type and Chip Address

    Buf2[1] := $00;
    Buf2[2] := $00;
    BinToHex(@Buf2[1], @Buffer[6], 2); //Memory Address

    Buf2[1] := $01;
    Buf2[2] := $FF;
    BinToHex(@Buf2[1], @Buffer[10], 2); //Read Count

    Buffer[14] := CMDEND;
    //Comm1.WriteCommData(Buffer, 15);
    WritePort(Buffer, 15);
  finally
    FreeMem(Buffer);
  end;

end;

procedure TForm1.PressBuffer(Buffer: Pointer; BufferLength: Integer);
var
  Buf2: pchar;
  i: integer;
  pos, pos2: integer;
  s: string;
begin

  if BufferLength > 0 then
    begin
      if (PChar(Buffer)[0] = CMDBEGIN) then FBufIdx := 0;
      if (BufferLength + FBufIdx >= 4096) then BufferLength := 4096 - FBufIdx - 1;
      CopyMemory(@FBuffer[FBufIdx], Buffer, BufferLength);
      Inc(FBufIdx, BufferLength);
      //Memo2.Text:=StrPas(FBuffer);

      if (PChar(Buffer)[BufferLength - 1]) <> CMDEND then exit;
    end;

  if (FBufIdx <= 3) then exit;
  if (FBuffer[1] = CMDHELP) then
    begin
      GetMem(Buf2, FBufIdx - 2);
      try
        CopyMemory(Buf2, @FBuffer[2], FBufIdx - 3);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -