首页  编辑  

图片黑白字符化

Tags: /超级猛料/Picture.图形图像编程/其他/   Date Created:

图片黑白字符化

procedure TForm1.FormCreate(Sender: TObject);

var strlines:string;

   i,j:integer;

begin

 // 分辨率 800*600 及以上

 form1.WindowState:= wsMaximized;

 image1.autosize:=true;

 with memo1 do begin

   lines.clear;

   align:=alclient;

   font.Name:=' 宋体 ';

   font.size:=5;

   scrollbars:=ssboth;

 end;

 {with Image1.Canvas do  begin

   with Font do begin

     Name:=' 华文彩云 ';

     Style:=[fsBold];

     Size:=18;

   end;

   TextOut(0,10,' 颜鑫 ');

 end;}

 // 请先在 image1 中加入 bmp 图片

 for i:=0 to image1.height do

 BEGIN

   strLines:='';

   for j:=1 to image1.width do

     // 好像只支持 bmp

     case GetRValue(Image1.Canvas.Pixels[j,i])+GetGValue(Image1.Canvas.Pixels[j,i])+GetBValue(Image1.Canvas.Pixels[j,i])of

       // 十级图像灰度

       // 希望能得到更理想的字符来表示图像的灰度

       000..075: strLines:=strLines+'M';

       076..150: strLines:=strLines+'B';

       151..225: strLines:=strLines+'A';

       226..300: strLines:=strLines+'@';

       301..375: strLines:=strLines+'9';

       376..450: strLines:=strLines+'3';

       451..525: strLines:=strLines+'+';

       526..600: strLines:=strLines+':';

       601..675: strLines:=strLines+',';

       676..765: strLines:=strLines+'.';

     end;

     // 另一种方法,不知为何效果更差?希望你能解释解释。

     {case Image1.Canvas.Pixels[j,i] of

       $000000..$191919: strLines:=strLines+'M';  //000..025

       $1a1a1a..$323232: strLines:=strLines+'B';  //026..050

       $333333..$4b4b4b: strLines:=strLines+'A';  //051..075

       $4c4c4c..$646464: strLines:=strLines+'@';  //076..100

       $656565..$707070: strLines:=strLines+'9';  //101..125

       $717171..$969696: strLines:=strLines+'3';  //126..150

       $979797..$afafaf: strLines:=strLines+'+';  //151..175

       $b0b0b0..$c8c8c8: strLines:=strLines+':';  //176..200

       $c9c9c9..$e1e1e1: strLines:=strLines+',';  //201..225

       $e2e2e2..$ffffff: strLines:=strLines+'.';  //226..255

     end;}

   memo1.Lines.Add(strLines);

 end;

end;