unit1.~pas

VC实现等值线编成的COM组件的源程序代码

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Image1: TImage;
    RichEdit1: TRichEdit;
    OpenPictureDialog1: TOpenPictureDialog;
    Button2: TButton;
    Button3: TButton;
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure xishu(m,n:integer;var s:array of integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  table0:array [0..928]of string;
  table3:array [0..928]of string;
  table6:array [0..928]of string;
  dataarray:array of array of integer;
  store1,bardata:array of integer;
  Form1: TForm1;
  barwidth,barheight:int64; //条码宽,高的象素数
  pointarray,effectarray:array of array of shortint; //存放每个象素的数组,1表示点,0表示空.
  dataoffset:longword;//数据偏移量;
  bitsperpixel,bpp:smallint;//显示每个点需要的象素数和字节数;
  str,filestring:string;//打开文件名字符串;
  compactarray:array of array of array of smallint;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

begin
 if OpenPictureDialog1.Execute then
  filestring:=OpenPictureDialog1.FileName;
  image1.Picture.LoadFromFile(filestring);
  richedit1.Text:='';
  statusbar1.Panels[1].Text:=filestring;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
close;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  fv:file;
  Hbyte,Lbyte,Cnum2,i1,i2,i3,i4,i5,flag1,flag2:integer;
  bartemp:byte;
  temp1,barx1,barx2,bary1,bary2:integer;
  Cstore:array of integer;
  Cp1:array[0..4,0..5] of integer;
  num1:array[0..5] of integer;
label label1,label2,label3;
begin
if filestring<>'' then
begin
richedit1.Text :='';
assignfile(fv,filestring);
reset(fv,2);
seek(fv,14);
blockread(fv,bitsperpixel,1);
seek(fv,5);
blockread(fv,dataoffset,1);
seek(fv,9);
blockread(fv,barwidth,1);
seek(fv,11);
blockread(fv,barheight,1);
//showmessage(format('dataoffset:%d',[dataoffset]));
//showmessage(format('bitsperpixel:%d',[bitsperpixel]));
//showmessage(format('barwidth:%d,barheight:%d',[barwidth,barheight]));
bpp:=bitsperpixel div 8;
closefile(fv);
setlength(pointarray,barheight,barwidth);
//下面把条码每个点读入二维数组
assignfile(fv,filestring);
reset(fv,1);
for i1:=barheight-1 downto 0 do
 for i2:=0 to barwidth-1 do
 begin
   seek(fv,54+i1*barwidth*bpp+i2*bpp);
   blockread(fv,bartemp,1);
   if bartemp=0 then
    pointarray[barheight-1-i1,i2]:=1
    else pointarray[barheight-1-i1,i2]:=0;
 end;
closefile(fv);

//....以下测试条码数组是否正确................
{ for i1:=0 to barwidth-1 do
  richedit1.Text :=richedit1.Text+inttostr(pointarray[57,i1]);
}
//.........................................
barx1:=0; barx2:=0; bary1:=0; bary2:=0;
for  i1:=0 to barheight-1 do
 for i2:=0 to barwidth-1 do
      if pointarray[i1,i2]<>0 then
          begin
          barx1:=i2;
          bary1:=i1;
          goto label1;
          end;

label1:
//showmessage(format('barx1:%d,bary1:%d',[barx1,bary1]));
for i1:=barheight-1 downto 0 do
 for i2:=barwidth-1 downto 0 do
   if pointarray[i1,i2]<>0 then
      begin
      barx2:=i2;
      bary2:=i1;
      goto label2;
      end;
label2:
//showmessage(format('barx2:%d,bary2:%d',[barx2,bary2]));
barx1:=barx1+17;
barx2:=barx2-18;
i1:=bary2-bary1+1;  //i1,i2为有效数组即有效条码的高度和宽度
i2:=barx2-barx1+1;
setlength(effectarray,i1,i2);
for i3:=0 to i1-1 do
 for i4:=0 to i2-1 do
   effectarray[i3,i4]:=pointarray[bary1+i3,barx1+i4];
//..........以下测试有效数组是否正确...........
//for i3:=0 to i2-1 do
// richedit1.text:=richedit1.text+inttostr(effectarray[15,i3]);

 //......................................................
i3:=0;
while i3<=(i1-1) do
begin
 flag1:=1;
 for i4:=i3+1 to i1-1 do
  begin
  flag2:=1;
  for i5:=0 to i2-1 do
    if effectarray[i3,i5]<>effectarray[i4,i5] then
      begin
     // flag2:=0;  //是否有用?
      goto label3;
      end;
  if flag2=1 then flag1:=flag1+1;
  end;
label3:
i4:=i3+flag1;
  while i4<=(i1-1)  do //for i4:=i3+flag1 to i1-1 do
   begin
    for i5:=0 to i2-1 do
      effectarray[i4-flag1+1,i5]:=effectarray[i4,i5];
    i4:=i4+1;
   end;
 i1:=i1-flag1+1;
i3:=i3+1;
end;
 //...........以下测试压缩数组...........
//showmessage(format('i1:%d',[i1]));
//for i3:=0 to i2-1 do
//richedit1.text:=richedit1.text+inttostr(effectarray[0,i3]);
//...................................................
temp1:=i2 div 17;
setlength(compactarray,i1,temp1,8);
for i3:=0 to i1-1 do
  for i4:=0 to temp1-1 do
    for i5:=0 to 7 do  compactarray[i3,i4,i5]:=0;
for i3:=0 to i1-1 do
    for i4:=0 to temp1-1 do
   begin
   i5:=0;
   while i5<=16 do
     if effectarray[i3,i4*17+i5]=1 then
        begin
        compactarray[i3,i4,0]:=compactarray[i3,i4,0]+1;
        i5:=i5+1;
        end else break;
   while i5<=16 do
     if effectarray[i3,i4*17+i5]=0 then
       begin
        compactarray[i3,i4,1]:=compactarray[i3,i4,1]+1;
        i5:=i5+1;
       end else break;
   while i5<=16 do
      if effectarray[i3,i4*17+i5]=1 then
        begin
         compactarray[i3,i4,2]:=compactarray[i3,i4,2]+1;
         i5:=i5+1;
        end else break;
   while i5<=16 do
      if effectarray[i3,i4*17+i5]=0 then
        begin
         compactarray[i3,i4,3]:=compactarray[i3,i4,3]+1;
         i5:=i5+1;
        end else break;
   while i5<=16 do
      if effectarray[i3,i4*17+i5]=1 then
        begin
         compactarray[i3,i4,4]:=compactarray[i3,i4,4]+1;
         i5:=i5+1;
        end else break;
   while i5<=16 do
      if effectarray[i3,i4*17+i5]=0 then
        begin
         compactarray[i3,i4,5]:=compactarray[i3,i4,5]+1;
         i5:=i5+1;
        end else break;
   while i5<=16 do
      if effectarray[i3,i4*17+i5]=1 then
        begin
         compactarray[i3,i4,6]:=compactarray[i3,i4,6]+1;
         i5:=i5+1;
        end else break;
   while i5<=16 do
      if effectarray[i3,i4*17+i5]=0 then
        begin
         compactarray[i3,i4,7]:=compactarray[i3,i4,7]+1;
         i5:=i5+1;
        end else break;
   end;
//...........以下测试变换压缩数组...............
//for i3:=0 to 7 do
//richedit1.Text:=richedit1.Text+inttostr(compactarray[0,0,i3]);
//....................................
setlength(dataarray,i1,temp1);
for i3:=0 to i1-1 do
 begin
  if (i3 mod 3)=0 then
    for i4:=0 to temp1-1 do
       for flag1:=0 to 928 do
          begin
          i5:=0;
          for flag2:=1 to 8 do
             if table0[flag1,flag2]<>inttostr(compactarray[i3,i4,flag2-1]) then
                i5:=1;

          if i5=0 then  dataarray[i3,i4]:=flag1;
          end;
  if (i3 mod 3)=1 then
    for i4:=0 to temp1-1 do
       for flag1:=0 to 928 do
          begin
          i5:=0;
          for flag2:=1 to 8 do
             if table3[flag1,flag2]<>inttostr(compactarray[i3,i4,flag2-1]) then
                i5:=1;

          if i5=0 then  dataarray[i3,i4]:=flag1;
          end;
  if (i3 mod 3)=2 then
    for i4:=0 to temp1-1 do
       for flag1:=0 to 928 do
          begin
          i5:=0;
          for flag2:=1 to 8 do
             if table6[flag1,flag2]<>inttostr(compactarray[i3,i4,flag2-1]) then
                i5:=1;

          if i5=0 then  dataarray[i3,i4]:=flag1;
          end;
 end;
//..........以下测试数据区数据.................
//richedit1.Text:=richedit1.Text+inttostr(dataarray[0,0]);
i5:=i1*(temp1-2);
setlength(bardata,i5);
for i3:=0 to i1-1 do
  for i4:=1 to temp1-2 do
   bardata[i3*(temp1-2)+(i4-1)]:=dataarray[i3,i4];
//...........以下为继承接口程序....................//
//showmessage(format('num:%d',[bardata[0]]));
Cnum2:=bardata[0];
for i3:=bardata[0]-1 downto 0 do
 if bardata[i3]=900 then    //....去掉填充码字..
    Cnum2:=i3  else break;
//.................................
bardata[0]:=Cnum2;    
setlength(store1,Cnum2);
for i3:=0 to Cnum2-1 do
  store1[i3]:=bardata[i3];

   i1:=(Cnum2-2) div 5;
    i5:=i1;
    i2:=(Cnum2-2) mod 5;
    setlength(Cstore,i1*6+i2);
    for i1:=0 to i1-1 do
      begin
      xishu(store1[i1*5+2],4,Cp1[4]);
      xishu(store1[i1*5+3],3,Cp1[3]);
      xishu(store1[i1*5+4],2,Cp1[2]);
      xishu(store1[i1*5+5],1,Cp1[1]);
      xishu(store1[i1*5+6],0,Cp1[0]);
      for i3:=0 to 5 do num1[i3]:=0;
      for i3:=0 to 5 do
       for i4:=0 to 4 do
        num1[i3]:=num1[i3]+Cp1[i4,i3];
      for i3:=0 to 5 do
       if num1[i3]>256 then
          begin
            num1[i3+1]:=num1[i3+1]+num1[i3] div 256;
            num1[i3]:=num1[i3] mod 256;
          end;
      for i3:=0 to 5 do
        begin
        Cstore[i1*6+i3]:=num1[5-i3];
      //  showmessage(format('Cstore[%d]:%d',[i1*6+i3,Cstore[i1*6+i3]]));
        end;
      end;
      for i3:=0 to i2-1 do
         begin
         Cstore[i5*6+i3]:=store1[store1[0]-i2+i3];
      //   showmessage(format('Cstore[%d]:%d',[i5*6+i3,Cstore[i5*6+i3]]));
         end;


 i1:=low(Cstore);
 while(i1<=high(Cstore))do
 begin
   If Cstore[i1]>= 128 Then
   begin
    Hbyte :=Cstore[i1];
    Lbyte :=Cstore[i1+1];
    str:=chr(Hbyte)+chr(Lbyte);
    i1:=i1+2;
   end
  Else
   begin
    str:= chr(Cstore[i1]);
    i1:=i1+1;
   end;
 richedit1.text:=richedit1.text+str;
 end;

end
else showmessage('请首先打开条码图象文件!');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
filestring:='';
end;

procedure Tform1.xishu(m,n:integer;var s:array of integer);
var
 i,j,k,t:integer;
begin
    for i:=0 to 5 do s[i]:=0;
     s[0]:=m;
     s[1]:=s[1]+s[0] div 256;
     s[0]:=s[0] mod 256;
      j:=n;
      while j>0 do
      begin
       for k:=0 to 5 do s[k]:=s[k]*900;
	      for t:=0 to 5 do
		    if s[t]>256 then
         begin
		      s[t+1]:=s[t+1]+s[t] div 256;
		       s[t]:=s[t] mod 256;
         end;
	      j:=j-1;
      end;
end;


initialization
table0[0]:='31111136';
table0[1]:='41111144';
table0[2]:='51111152';
table0[3]:='31111235';
table0[4]:='41111243';
table0[5]:='51111251';
table0[6]:='21111326';
table0[7]:='31111334';
table0[8]:='21111425';
table0[9]:='11111516';
table0[10]:='21111524';
table0[11]:='11111615';
table0[12]:='21112136';
table0[13]:='31112144';
table0[14]:='41112152';
table0[15]:='21112235';
table0[16]:='31112243';
table0[17]:='41112251';
table0[18]:='11112326';
table0[19]:='21112334';
table0[20]:='11112425';
table0[21]:='11113136';
table0[22]:='21113144';
table0[23]:='31113152';
table0[24]:='11113235';
table0[25]:='21113243';
table0[26]:='31113251';
table0[27]:='11113334';
table0[28]:='21113342';
table0[29]:='11114144';
table0[30]:='21114152';
table0[31]:='11114243';
table0[32]:='21114251';
table0[33]:='11115152';
table0[34]:='51116111';
table0[35]:='31121135';
table0[36]:='41121143';
table0[37]:='51121151';
table0[38]:='21121226';
table0[39]:='31121234';
table0[40]:='41121242';
table0[41]:='21121325';
table0[42]:='31121333';
table0[43]:='11121416';
table0[44]:='21121424';
table0[45]:='31121432';
table0[46]:='11121515';
table0[47]:='21121523';
table0[48]:='11121614';
table0[49]:='21122135';
table0[50]:='31122143';
table0[51]:='41122151';
table0[52]:='11122226';
table0[53]:='21122234';
table0[54]:='31122242';
table0[55]:='11122325';
table0[56]:='21122333';
table0[57]:='31122341';
table0[58]:='11122424';
table0[59]:='21122432';
table0[60]:='11123135';
table0[61]:='21123143';
table0[62]:='31123151';
table0[63]:='11123234';
table0[64]:='21123242';
table0[65]:='11123333';
table0[66]:='21123341';
table0[67]:='11124143';
table0[68]:='21124151';
table0[69]:='11124242';
table0[70]:='11124341';
table0[71]:='21131126';
table0[72]:='31131134';
table0[73]:='41131142';
table0[74]:='21131225';
table0[75]:='31131233';
table0[76]:='41131241';
table0[77]:='11131316';
table0[78]:='21131324';
table0[79]:='31131332';
table0[80]:='11131415';
table0[81]:='21131423';
table0[82]:='11131514';
table0[83]:='11131613';
table0[84]:='11132126';
table0[85]:='21132134';
table0[86]:='31132142';
table0[87]:='11132225';
table0[88]:='21132233';
table0[89]:='31132241';
table0[90]:='11132324';
table0[91]:='21132332';
table0[92]:='11132423';
table0[93]:='11132522';
table0[94]:='11133134';
table0[95]:='21133142';
table0[96]:='11133233';
table0[97]:='21133241';
table0[98]:='11133332';
table0[99]:='11134142';
table0[100]:='21141125';
table0[101]:='31141133';
table0[102]:='41141141';
table0[103]:='11141216';
table0[104]:='21141224';
table0[105]:='31141232';
table0[106]:='11141315';
table0[107]:='21141323';
table0[108]:='31141331';
table0[109]:='11141414';
table0[110]:='21141422';
table0[111]:='11141513';
table0[112]:='21141521';
table0[113]:='11142125';
table0[114]:='21142133';
table0[115]:='31142141';
table0[116]:='11142224';
table0[117]:='21142232';
table0[118]:='11142323';
table0[119]:='21142331';
table0[120]:='11142422';
table0[121]:='11142521';
table0[122]:='21143141';