unit1.pas

本程序完成字模提取与将提取的字模数据通过串口下载到单片机

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, SPComm, ComCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Image1: TImage;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    grp1: TGroupBox;
    btn1: TBitBtn;
    btn2: TBitBtn;
    btn3: TBitBtn;
    comm1: TComm;
    grp2: TGroupBox;
    Combobox1: TComboBox;
    Combobox2: TComboBox;
    lbl1: TLabel;
    lbl2: TLabel;
    Timer1: TTimer;
    grp3: TGroupBox;
    mmo1: TMemo;
    Memo1: TMemo;
    ProgressBar1: TProgressBar;
    Label3: TLabel;
    procedure btn2Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Combobox2Change(Sender: TObject);
    procedure Combobox2KeyPress(Sender: TObject; var Key: Char);
    procedure Combobox1Change(Sender: TObject);
    procedure btn1Click(Sender: TObject);
//    procedure comm1ReceiveData(Sender: TObject; Buffer: Pointer;BufferLength: Word);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    procedure GetQWCode(HZ: string; var Q, W: Word);
    procedure MakeChar(HZ: String; n: integer);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  f: File;

implementation

{$R *.dfm}
 type TDigits = array[0..31] of byte;
 var
 AllByte:array[0..3] of TDigits;      //存储4个字的字模数据
 CharCount:Integer;                   //汉字个数计数器，表示当前到了第几个汉字
 Flag_Of_Generated_Lattice:Boolean;
  Flag_Of_Comm_Success:Boolean;    //表示通信是否成功
  length_of_hanzi:Integer;         //汉字长度
  count_row:Integer ;              //记录发送了几个字的字模数据
  count_colum:Integer ;            //记录发送了字模的第几个数据
function inttoBin(int1:integer):string;       //将整形数据转化为16位二进制数
var s2:string;
    m,j:Integer;
begin
  m:=int1;
   while m<>0 do
  begin
   if m=(m div 2)*2 then
    s2:='0' +s2
    else
   s2:='1'+s2;
   m:=m div 2;
  end;
  for j:=0 to 16-length(s2)-1 do
       s2:='0'+s2;
 Result:=s2;
  end;


procedure TForm1.GetQWCode(HZ: string; var Q, W: Word);
begin
  Q := Byte(HZ[1]) - $A0;
  W := Byte(HZ[2]) - $A0;
end;

function HengToZong(zimo:TDigits):TDigits;      //横向字模转向纵向字模
var
i,j,tmpint1,tmpint2: Integer;
   tmpintarray1:array[0..15] of Integer;
   tmpintarray2:TDigits;
    str1,s:string;
begin
      for j:=0 to 16-1 do
     begin
         tmpintarray1[j]:=zimo[2*j]*256+ zimo[2*j+1] ;
         str1:=str1+inttobin(tmpintarray1[j]);   //转换成二进制代码
       end;
      s:=str1;
      for i:=1 to 16 do
       begin
         tmpint1:=(Ord(s[i])-ord('0'))*128+(Ord(s[i+16])-ord('0'))*64+(Ord(s[i+32])-ord('0'))*32+(Ord(s[i+48])-ord('0'))*16+(Ord(s[i+64])-ord('0'))*8+(Ord(s[i+80])-ord('0'))*4+(Ord(s[i+96])-ord('0'))*2+(Ord(s[i+112])-ord('0'))*1;
          tmpintarray2[2*i-2]:= tmpint1 ;
         tmpint2:=(Ord(s[i+128])-ord('0'))*128+(Ord(s[i+144])-ord('0'))*64+(Ord(s[i+160])-ord('0'))*32+(Ord(s[i+176])-ord('0'))*16+(Ord(s[i+192])-ord('0'))*8+(Ord(s[i+208])-ord('0'))*4+(Ord(s[i+224])-ord('0'))*2+(Ord(s[i+240])-ord('0'))*1;
          tmpintarray2[2*i-1]:= tmpint2 ;
         end;
       Result:=tmpintarray2;
  end;

procedure TForm1.MakeChar(HZ: String; n: integer);  //字模显示
var
  OffSet: integer;
  GetStr,GetStr1: TDigits;
  temp,dis:byte;
  x, y, i, j: integer;
  Q, W: word;
  tmpstr,tmpstr1:string;
begin
  GetQWCode(HZ,Q, W);
  OffSet := (94*(Q-1)+(W-1))*32;
    Seek(f, OffSet);
    tmpstr:='';
    BlockRead(f, GetStr, SizeOf(GetStr));
   GetStr1:=HengToZong(GetStr);  //可以由横向取模至纵向取模
   Allbyte[CharCount]:=GetStr1;
   Inc(CharCount);  //每次加1;
   if CharCount=4 then
      begin
         CharCount:=0;   //恢复原来大小，以免溢出
        end;
    mmo1.Lines.Add('汉字'+'"'+HZ+'"'+'的字模数据为：');
    for i:=0 to  SizeOf(GetStr1)-1 do
     begin
       tmpstr1:=IntToHex(Getstr1[i],2) ;
       tmpstr:=tmpstr+'0x'+tmpstr1+',' ;
     end;
    mmo1.Lines.Add(tmpstr+#13+#10);
//GetStr
  x:=0;
  y:=0;
  i:=0;
  j:=0;
  while(i<=31) do
  begin
    temp:=getstr[i];
    for j:=0 to 7 do begin
      dis:=temp and 128;
      dis:=dis shr 7;
      if dis=1 then
         form1.Image1.Canvas.Rectangle(n*32+(x+1)*2-1,(y+1)*2-1,n*32+(x+1)*2-1+3,(y+1)*2-1+3);
      inc(x);
      if x>15 then begin
        x:=0;
        inc(y);
      end;
      temp:=temp shl 1;
    end;
    inc(i);
  end;
end;

procedure TForm1.btn2Click(Sender: TObject);
begin
  Application.Terminate;
  comm1.StopComm;

end;

procedure TForm1.btn3Click(Sender: TObject);
var
  strChinese, strChar: String;
  i, n: integer;
begin
  mmo1.Clear;
  form1.Image1.Canvas.Brush.Color := clBlack;
  form1.Image1.Canvas.FillRect(rect(0,0,324,36));
  form1.Image1.Canvas.Brush.Color := clRed;
  form1.Image1.Canvas.Pen.Color := clBlack;
  strChinese := Edit1.Text;
 // CharCount:=0;//初始化所接收的汉字个数
  if strChinese='' then
    begin
      ShowMessage('请输入字符！');
      Exit;
      end
  else
  begin
          length_of_hanzi:= Length(strChinese) div 2;
           if length_of_hanzi>4 then
           begin
             ShowMessage('所输入的汉字个数必须小于4个');
             Exit;
             end;
          for i:=1 to length_of_hanzi do
            begin
                  if   ByteType(strChinese,i)=mbsingleByte   then
                   begin
                    ShowMessage('所输入的字符必需为汉字！');
                    Exit;
                    Break;
                   end;
              end;
          if Length(strChinese) > 0 then begin
            AssignFile(f, 'Hzk16.bin');
            reset(f, 1);
             n := Length(strChinese) div 2;
             for i := 0 to n - 1 do begin
                strChar := Copy(strChinese, i*2+1, 2);
                MakeChar(strChar, i);
             end;
            CloseFile(f);
          end;
          Flag_Of_Generated_Lattice:=True;
          btn1.Enabled:=Flag_Of_Generated_Lattice;//生成了数据则可以下载了。
        end;
  end;

procedure TForm1.FormCreate(Sender: TObject);
begin
//  EnumComPorts(ComboBox1.Items);    //得到串口列表
   ProgressBar1.Visible:=False;
   Label3.Visible:=False;
  count_row:=0;//             //记录发送了几个字的字模数据
  count_colum:=0;//         //记录发送了字模的第几个数据
  mmo1.Clear;            //将mmo1中的数据清除掉
  Flag_Of_Generated_Lattice:=False;
  Timer1.Enabled:=False;   //关掉定时器1
 // Timer2.Enabled:=False;   //关掉定时器2
  ComboBox1.ItemIndex := 0;
  Comm1.CommName := ComboBox1.Text;
  ComboBox2.ItemIndex := 6;
  Comm1.BaudRate := StrToInt(ComboBox2.Text);
 // SetLength(Allbyte,4,32);     //存4个字的字模数据
  CharCount:=0;
   btn1.Enabled:=Flag_Of_Generated_Lattice;//在数据生成前disenble掉此按钮
   Comm1.StopComm;
      try
       begin
            Comm1.StartComm;
       end
     except
       begin
           Application.MessageBox('串行口COM1未能成功打开,请检查串口是否插后或其他原因！','警告',MB_OK);
           Application.Terminate;
       end;
     end;
end;

procedure TForm1.Combobox2Change(Sender: TObject);

var  BaudRate : Integer;
begin
  if ComboBox2.Text = 'Custom' then
    begin
      ComboBox2.Style := csDropDown;
      ComboBox2.SetFocus;
    end
  else begin
    if  ComboBox2.ItemIndex >0 then
      ComboBox2.Style := csDropDownList;
    if TryStrToInt(ComboBox2.Text,BaudRate) then
           Comm1.BaudRate := BaudRate;
  end;
end;

procedure TForm1.Combobox2KeyPress(Sender: TObject; var Key: Char);
begin
 if not (Key in ['0'..'9',#8]) then Key := #0;
end;

procedure TForm1.Combobox1Change(Sender: TObject);
begin
  Comm1.CommName:=ComboBox1.Text;
end;

procedure TForm1.btn1Click(Sender: TObject);
var
   //p:PChar;
   str:string;
begin
   CharCount:=0;
   str:=chr(length_of_hanzi*32);     //字模数据长度
 //  p:=PChar(str);
 if  comm1.WriteCommData(PChar(str),1) then
   begin     //表示开始发送数据
       form1.Comm1.ParityCheck:=false;    //发送一个字符后加上一个地址帧"0 即RB8=0
       form1.Comm1.Parity:=Space;
       form1.Comm1.ParityCheck:=true;
       timer1.Enabled:=True; //启动定时器
    //   Flag_Of_Comm_Success:=False;//通信暂不成功。
       Combobox1.Enabled:=False;//其他控件不可用
           Combobox2.Enabled:=False;
           btn3.Enabled:=False;
           btn1.Enabled:=False;
           btn2.Enabled:=False;
           ProgressBar1.Visible:=True;
           Label3.Visible:=True;
           ProgressBar1.Min:=0;
           ProgressBar1.Max:=length_of_hanzi*32; //进度条设置
   end
 else
   begin
       ShowMessage('"数据写"命令发送失败！');
       exit;
     end;

end;

{procedure TForm1.comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
  var
    p:pchar;
    comdata,
     tmpsign:string;
begin
     p:=Buffer;
     comdata:=PChar(p);
     Memo1.Lines.Add(PChar(buffer));
     tmpsign:=copy(comdata,1,1); //判断是否通信成功
     if tmpsign='f' then    // 若收到下位机响应
        begin
        Timer1.Enabled:=true;   //启动定时器，2秒后判断上位机与下位机通信是否成功
        Flag_Of_Comm_Success:=True;  //通信成功
        end
       else
        Flag_Of_Comm_Success:=false;  //通信不成功

end;   }

procedure TForm1.Timer1Timer(Sender: TObject);
var
 p:PChar;
 i,j:Integer;
 str:string;
begin
 i:=count_row;
 j:=count_colum;
 ProgressBar1.StepBy(1);
 str:=chr(AllByte[i][j]) ;
 p:=PChar(str);
 comm1.WriteCommData(p,1);     //表示开始发送数据
 form1.Comm1.ParityCheck:=false;    //发送一个字符后加上一个地址帧"0
 form1.Comm1.Parity:=Mark;
 form1.Comm1.ParityCheck:=true;             {   }
 Inc(count_colum);
 if count_colum mod 32=0 then
   begin
      count_colum:=0;
      Inc(count_row);
     end;
 if count_row=length_of_hanzi then
     begin
        count_colum:=0;
        count_row:=0;
        Timer1.Enabled:=False; //全部数据发送完毕

           Combobox1.Enabled:=true;//其他控件可用
           Combobox2.Enabled:=true;
           btn3.Enabled:=true;
           btn1.Enabled:=true;
           btn2.Enabled:=true;
           comm1.StopComm;
           Label3.Visible:=False;
           ProgressBar1.Visible:=False;
           ShowMessage('字模数据下载完毕！');
       end;
end;

procedure TForm1.Timer2Timer(Sender: TObject);

var
 p:PChar;
 i,j:Integer;
 str:string;
begin
 i:=count_row;
 j:=count_colum;
 ProgressBar1.StepBy(1);
 str:=chr(AllByte[i][j]) ;
 p:=PChar(str);
 comm1.WriteCommData(p,1);     //表示开始发送数据
 form1.Comm1.ParityCheck:=false;    //发送一个字符后加上一个地址帧"0
 form1.Comm1.Parity:=Mark;
 form1.Comm1.ParityCheck:=true;             {   }
 Inc(count_colum);
 if count_colum mod 32=0 then
   begin
      count_colum:=0;
      Inc(count_row);
     end;
 if count_row=length_of_hanzi then
     begin
        count_colum:=0;
        count_row:=0;
     //   Timer2.Enabled:=False; //全部数据发送完毕

           Combobox1.Enabled:=true;//其他控件可用
           Combobox2.Enabled:=true;
           btn3.Enabled:=true;
           btn1.Enabled:=true;
           btn2.Enabled:=true;
           comm1.StopComm;
           Label3.Visible:=False;
           ProgressBar1.Visible:=False;
           ShowMessage('字模数据下载完毕！');
       end;

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 comm1.StopComm;
end;

end.