unit1.pas

24*32图片转点阵程序

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, FileCtrl, RzFilSys, RzShellDialogs, ExtCtrls, Buttons,strutils,inifiles;

type
  TForm1 = class(TForm)
    Button1: TButton;
    src: TRzFileListBox;
    sf: TRzSelectFolderDialog;
    path: TEdit;
    Button2: TButton;
    dst: TRzFileListBox;
    dstpath: TEdit;
    Button3: TButton;
    BitBtn1: TBitBtn;
    GroupBox1: TGroupBox;
    srcimage: TImage;
    BitBtn2: TBitBtn;
    Button5: TButton;
    bin: TGroupBox;
    Memo1: TMemo;
    s: TEdit;
    e: TEdit;
    Button4: TButton;
    Button6: TButton;
    filesv: TRzSaveDialog;
    Button7: TButton;
    inisave: TRzSaveDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    function stringtochar(instring:string):string;
    procedure BitBtn2Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
    lab:array[0..31,0..31] of tlabel;
    mybyte:array[0..127] of byte;


implementation

{$R *.dfm}
function tform1.stringtochar(instring:string):string;
var
temp:string;
itmp:integer;
len:integer;
i,j,k:integer;
begin
temp:='';
itmp:=0; i:=0;j:=0;
k:=0;
for  i:=0 to 127 do
begin
itmp:=0;
  if (instring[i*8+1])='1' then itmp:=128;
  if (instring[i*8+2])='1' then itmp:=itmp+64;
  if (instring[i*8+3])='1' then itmp:=itmp+32;
   if (instring[i*8+4])='1' then itmp:=itmp+16;
   if (instring[i*8+5])='1' then itmp:=itmp+8;
   if (instring[i*8+6])='1' then itmp:=itmp+4;
    if (instring[i*8+7])='1' then itmp:=itmp+2;
     if (instring[i*8+8])='1' then itmp:=itmp+1;
   //  showmessage(inttostr(itmp));
 // mybyte[k]:=itmp;
  temp:=temp+char(itmp);
end;
 result:=temp;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
     tfile:textfile;
     filename:string;
     binstr:string;
     i,j:integer;
     charstr:string;
     filehandle:integer;
     dd:string;
     inifile:string;
  begin
  filesv.Execute;
  filename:=filesv.FileName;
  assignfile(tfile,filename);
  rewrite(tfile);
    // memo1.text:='' ;
      for i:=0 to 31 do
      begin
      dd:='';
        for j:=0 to 31 do
        begin
        binstr:=binstr+lab[i,j].Caption;
       // dd:=dd+lab[i,j].Caption;
        memo1.text:=memo1.text+lab[i,j].Caption;
        end;
       // showmessage(dd);
       //  memo1.Text:=memo1.text+#10+#13;
         end;
        charstr:=stringtochar(binstr);
        write(tfile,charstr);
          closefile(tfile);

      //  sfile.Write(pchar(mybyte),sizeof(mybyte));
       // sfile.Free;
        //assignfile(tfile,filename);
       // rewrite(tfile);
      //  write(tfile,charstr);

    // sfile.Write(mybyte, sizeof(mybyte));

    {
        sfile:=tfilestream.Create(filename,fmCreate);
        sfile.WriteBuffer(charstr,1);
        sfile.Free;
      //edit1.Text:=inttostr(strtoint(edit1.text)+1);
      src.Update;  }
    //  dst.Update;
  end;

procedure TForm1.Button2Click(Sender: TObject);
begin
sf.Execute;
path.Text:=sf.SelectedPathName;
src.FileName:=path.Text;


end;



procedure TForm1.BitBtn1Click(Sender: TObject);
var
filenum:integer;
begin
 filenum:=src.ItemIndex;
 if filenum<>-1 then
 srcimage.Picture.LoadFromFile(src.FileName)
 else
 showmessage('No Picture!');
 
end;

procedure TForm1.FormShow(Sender: TObject);
begin
//binlist.Click;
//bin.Update;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
i,j:integer;
vlab:tlabel;
lstr:string;
begin
i:=0;j:=0;
if srcimage.Picture<>nil then
begin
 for j:=0 to 31 do
 begin
   for i:=0 to 23 do
   begin
       //showmessage('i:'+inttostr(i)+'   j:'+inttostr(j)+'  ima:'+inttoHEX(srcimage.Canvas.Pixels[i,j],4));
        if (srcimage.Canvas.Pixels[i,j]=0) or (srcimage.Canvas.Pixels[i,j]=$343434)
        then
           lab[j,i].Caption:='1'
        else
        lab[j,i].Caption:='0';

     
   end;
 end;
 {for j:=0 to 31 do
   begin
     if lab[1,j].Caption='1' then lab[0,j].Caption:='1';
    end;
    for j:=0 to 31 do
     if lab[j,1].Caption='1' then lab[j,0].Caption :='1';  }
end;
//bin.Update;
//memo1.Text:='';
{for i:=0 to 31 do
  begin
    lstr:='';
    for j:=0 to 31 do lstr:=lstr+lab[i,j].Caption;
  //  memo1.Text:=memo1.Text+lstr+#13+#10;
  end;
 }
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
sf.Execute;
dstpath.Text:=sf.SelectedPathName;
dst.FileName:=dstpath.Text;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
i,j:integer;

begin
   for i:=0 to 31 do
   begin
     for j:=0 to 31 do
     begin
     lab[i,j]:=tlabel.Create(nil);
     lab[i,j].Parent:=bin;
         lab[i,j].ParentFont:=true;
     lab[i,j].Caption :='0';
     lab[i,j].Top:=15+i*11;
     lab[i,j].Left:=10+j*11;
     lab[i,j].Width:=9;
     lab[i,j].Height:=12;

     lab[i,j].Name :='l'+inttostr(i)+'_'+inttostr(j);
     lab[i,j].Hint:='l'+inttostr(i)+'_'+inttostr(j);
     lab[i,j].ShowHint:=true;
     end;
   end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
s.text:=inttostr(src.ItemIndex);
e.text:=inttostr(src.ItemIndex);
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
e.text:=inttostr(src.ItemIndex);
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
var
     tfile:textfile;
     filename:string;
     binstr:string;
     i,j:integer;
     charstr:string;
     filehandle:integer;
     k,l,m:integer;
     serialno:integer;
     inifile:tinifile;
  begin
  binstr:='';
  filesv.Execute;
  inisave.Execute;
  inifile:=tinifile.Create(inisave.FileName);
  filename:=filesv.FileName;
  assignfile(tfile,filename);
  rewrite(tfile);
  k:=strtoint(s.text);l:=strtoint(e.text);
  src.ItemIndex:=k;
  serialno:=0;
  for m:=k to l do
  begin
  src.ItemIndex:=m;
    bitbtn1.Click;
    button5.Click;
    serialno:=serialno+1;
   // memo1.text:=memo1.text+src.FileName+'='+inttostr(serialno-1)+#13+#10;
    inifile.WriteString('gaoyu',src.FileName,inttostr(serialno-1));
    binstr:='';
       for i:=0 to 31 do
       for j:=0 to 31 do
        binstr:=binstr+lab[i,j].Caption;
        charstr:=stringtochar(binstr);
        write(tfile,charstr);
  end;
          closefile(tfile);



end;

procedure TForm1.Button7Click(Sender: TObject);
var
tfile:textfile;
filename:string;
begin
filesv.Execute;
filename:=filesv.FileName;
  assignfile(tfile,filename);
  rewrite(tfile);
  write(tfile,memo1.text);
  closefile(tfile);
end;

end.