unit1.~pas

字模管理程序,为单片机程序汉字显示打印而制.无密码

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Edit2: TEdit;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    BitBtn1: TBitBtn;
    Memo1: TMemo;
    Button4: TButton;
    Button2: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    DrawGrid1: TDrawGrid;
    StringGrid1: TStringGrid;
    Button1: TButton;
    StaticText1: TStaticText;
    Memo2: TMemo;
    Edit1: TEdit;
    Edit3: TEdit;
    Button3: TButton;
    Label3: TLabel;
    Edit4: TEdit;
    procedure BitBtn1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure SearchFile(Fname:string);
    procedure Button8Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Hznum,Gcol,Grow:integer;
 PathName:string;
const
    pbf:array [0..3] of byte =($31,$32,$33,$34); //pass '1234'
    hzkfilename:string = 'hzk16';
    cfile: pchar  = '.c';
    asmfile: pchar = '.asm';

implementation
{$R *.dfm}
uses LzpPasLib,UnitComm;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
  i:integer;
begin
    OpenDialog1.Filter := 'Program files (*.c)|*.c|Text files (*.asm)|*.asm|All files (*.*)|*.*';//'Text files (*.txt)|*.TXT';
    if OpenDialog1.Execute then if fileexists(OpenDialog1.FileName) then begin
        for i:=memo1.Lines.Count downto 0 do begin
                if  memo1.Lines[i-1] = OpenDialog1.FileName then begin
                        exit;
                end
        end ;
        Memo1.Lines.Add(OpenDialog1.FileName) ;
    end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
        Memo1.Lines.Clear;
end;
procedure  addone(Grid: TStringGrid;s2 :string );
var
    k,row,col:integer;
    find:boolean;
begin
                                find:=false;
                                k:=0;
                                if (Hznum>=512) then exit;
                                while (k<Hznum) do begin
                                    row:=k div 10;
                                    col:=k mod 10;
                                    if  (Grid.Cells[col,row]=s2) then find:=true;
                                    k:=k+1;
                                end ;
                                if not find then begin
                                    row:=Hznum div 10;
                                    col:=Hznum mod 10;
                                    Grid.Cells[col,row]:=s2;
                                    Hznum:=Hznum+1;
                                end;
end  ;
procedure  addstr(Grid: TStringGrid;s1 :string );
var
    l,j:integer;
    s2:string;
begin
    l:=Length(s1);
    j:=1;
    while (j<l) do begin
        if  (s1[j]>chr($7f)) and  (s1[j+1]>chr($7f)) then begin
            s2:='';
            s2:=s2+s1[j];
            s2:=s2+s1[j+1];
            addone(Grid,s2);
            j:=j+1;
        end;
        j:=j+1;
    end;
end;
procedure TForm1.SearchFile(Fname:string);
var
  i,j,k,zs,typ,l,row,col:integer;
  F1: TextFile;
  s1,s2:string;
  find:boolean;
begin
            typ:=0;
            if fileexists(Fname) then begin
                s2:=  Fname    ;
                l:= pos(cfile,s2) ;
                if (not (l=0)) then begin
                    typ:=1;
                end  else if  not(pos(asmfile,Fname)=0) then begin
                                typ:=2;
                            end ;
                AssignFile(F1, Fname);
                Reset(F1);
                while not eof(f1) do begin
                    readln(F1,s1);
                    l:=Length(s1);
                    j:=1;
                    zs:=0;       //注释
                    while (j<l) do begin
                        if zs=0 then begin
                            if s1[j]='/' then begin
                                if typ=1 then begin
                                    if s1[j+1]='*' then begin
                                        zs:=1;
                                    end else if s1[j+1]='/' then begin
                                                zs:=2;
                                            end
                                end
                            end else if s1[j]=';' then begin
                                if typ=2 then begin
                                    zs:=2;
                                end
                            end ;
                            if ((s1[j]>chr($7f)) and (s1[j+1]>chr($7f))) then begin
                                s2:='';
                                s2:=s2+s1[j];
                                s2:=s2+s1[j+1];
                                find:=false;
                                addone(StringGrid1,s2);
                                j:=j+1;
                            end
                        end;
                        if zs=2 then begin
                            if s1[j]=chr($0d) then begin
                                j:=j+1;
                                zs:=0;
                            end
                        end else
                        if zs=1 then begin
                            if ((s1[j]='*') and (s1[j+1]='/')) then begin
                                zs:=0;
                                j:=j+1;
                            end
                        end ;
                        j:=j+1;
                    end;
                end;
                closefile(f1);
            end;
        StaticText1.Caption:=inttostr(Hznum);

end;
procedure TForm1.Button4Click(Sender: TObject);
var
  i,j,k,zs,typ,l,row,col:integer;
  F1: TextFile;
  s1,s2:string;
  find:boolean;
begin
        //搜索汉字//
        if (Hznum>=512) then begin
            MessageDlg('汉字够512个了！',mtConfirmation, [mbOK], 0);
            exit;
        end;
        for i:=memo1.Lines.Count downto 0 do begin
            SearchFile(memo1.Lines[i-1]);
        end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
        PathName:=extractfilepath(application.ExeName);
        Hznum:=0;
        Gcol:=120;
        Grow:=120;
end;
//区位码表 从a1a1开始a1=第1区,每去94个字即a1--fe
//    第二区:b1a1开始
//
procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
var
    f:TfileStream;
    b:array [0..50] of byte ;
    b1:byte;
    i,j,hzq,hzw:integer;//汉字区/位
    hzoff:int64;
    hzks:string;
begin