BmpConvet.pas
unit BmpConvert;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, ExtDlgs, ComCtrls, ArrayFeature, ZoomRect;type
TBmpConvertForm = class(TForm)
OpenPictureDialog1: TOpenPictureDialog;
Image1: TImage;
Image2: TImage;
BitBtn1: TBitBtn;
TrackBar1: TTrackBar;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Button1: TButton;
Button2: TButton;
Label4: TLabel;
procedure Image1Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
function Get_Most_LRTB(StretchImage: TImage): TRect;
procedure setmap(eight: TDoubleEightArray);
procedure showeight(eightmap: TDoubleEightArray);
procedure FormCreate(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
function BmpToSmallBmp(Fname: string; ZoomQty: Integer): Tbitmap; private
{ Private declarations }
public
{ Public declarations }
end;var
BmpConvertForm: TBmpConvertForm;
ArrayFeature: TArrayFeature;
eight: array of array of TLabel; //array[1..8, 1..8] of TLabel;
EightCode: TDoubleEightArray;
CurFName: string;implementation{$R *.dfm}procedure TBmpConvertForm.Image1Click(Sender: TObject);
beginend;//清除上下左右多余空白function TBmpConvertForm.Get_Most_LRTB(StretchImage: TImage): TRect;
var //得到图片上的最左、最右、最上、最下的点
i, j: integer;
label FindMostRight, FindMostTop, FindMostBottom, FindInMiddle;
begin
//FindMostLeft： 获得最左边的点
for i := 1 to StretchImage.Width - 1 do
for j := 1 to StretchImage.Height - 1 do
if StretchImage.Canvas.Pixels[i, j] <> clWhite then
begin
Result.Left := i;
goto FindMostRight;
end;
FindMostRight: //获得最右边的点
for i := StretchImage.Width - 1 downto 1 do
for j := 1 to StretchImage.Height - 1 do
if StretchImage.Canvas.Pixels[i, j] <> clWhite then
begin
Result.Right := i; goto FindMostTop;
end;
FindMostTop: // 获得最上面的点
for j := 1 to StretchImage.Height - 1 do
for i := 1 to StretchImage.Width - 1 do
if StretchImage.Canvas.Pixels[i, j] <> clWhite then
begin
Result.Top := j; goto FindMostBottom;
end;
FindMostBottom: //获得最下面的点
for j := StretchImage.Height - 1 downto 1 do
for i := 1 to StretchImage.Width - 1 do
if StretchImage.Canvas.Pixels[i, j] <> clWhite then
begin
Result.Bottom := j; goto FindInMiddle;
end;
FindInMiddle:
i := Result.Right - Result.Left; //得到区域宽度
j := Result.Bottom - Result.Top; //得到区域高度
i := i mod 8; i := i div 2;
if i > 0 then //将边缘对称于矩形的左右部分
begin
Dec(Result.Left, i); Inc(Result.Right, i);
end;
j := j mod 8; j := j div 2;
if j > 0 then //将边缘对称于矩形的上下部分
begin
Dec(Result.Top, i); Inc(Result.Bottom, j);
end;
//对左右部分过小的图片进行加宽处理
i := Result.Right - Result.Left;
if i < 80 then //细长的黑色的字最小宽为80
begin
i := (80 - i) div 2;
Dec(Result.Left, i); Inc(Result.Right, i);
end;
end;procedure TBmpConvertForm.showeight(eightmap: TDoubleEightArray);
var
i, j: integer;
begin
for i := 1 to ConstNum - 1 do
for j := 1 to ConstNum - 1 do
if eightmap[i][j] = 1 then
eight[i][j].Color := clRed
else
eight[i][j].Color := clwhite;
end;procedure TBmpConvertForm.setmap(eight: TDoubleEightArray);
begin
EightCode := eight;
end;procedure TBmpConvertForm.BitBtn1Click(Sender: TObject);
var
rect_s, rect_d: TRect;
SaveImage: Tbitmap;
Eight: TDoubleEightArray;
x, i: integer;
begin
SetLength(eight, ConstNum, ConstNum);
SaveImage := Tbitmap.Create;
// 取得数字图片的位置 rest_d;
Rect_s := Get_Most_LRTB(Image1);
Rect_d.Top := 0;
Rect_d.Left := 0;
Rect_d.Right := rect_s.Right - rect_s.Left;
Rect_d.Bottom := rect_s.Bottom - rect_s.Top; SaveImage.Width := rect_d.Right;
SaveImage.Height := rect_d.Bottom;
SaveImage.Canvas.CopyRect(rect_d, Image1.Canvas, rect_s);
SaveImage.SaveToFile('TempImage.bmp'); // 得到8*8特征值
if ArrayFeature = nil then
ArrayFeature := TArrayFeature.Create;
// 这里对左边的显示窗口进行操作
ArrayFeature.SetPicFile('TempImage.bmp');
eight := ArrayFeature.GetDoubleEightArray; //取得8*8数据
showeight(eight);
setmap(eight); //显示8*8图像 Image2.Picture.LoadFromFile('TempImage.bmp');
SaveImage.Free;
end;//初始化procedure TBmpConvertForm.FormCreate(Sender: TObject);
var
i, j: Integer;
begin
DoubleBuffered := true;
ConstNum := 8 + 1;
SetLength(eight, ConstNum, ConstNum);
SetLength(EightCode, ConstNum, ConstNum); //显示8*8特征块图像
{ for i := 1 to ConstNum-1 do
for j := 1 to ConstNum-1 do
begin
eight[i][j] := TLabel.Create(self);
eight[i][j].Parent := self;
eight[i][j].Width := 20;
eight[i][j].Height := 20;
eight[i][j].Left := (i - 1) * 20 + 200;
eight[i][j].Top := j * 20 + 220;
eight[i][j].Color := clRed;
end; }
end;procedure TBmpConvertForm.TrackBar1Change(Sender: TObject);
begin
ConstNum := TrackBar1.Position; //远近参数等于该值
Label4.Caption := IntToStr(ConstNum);
SetLength(eight, ConstNum, ConstNum);
SetLength(EightCode, ConstNum, ConstNum);
end;procedure TBmpConvertForm.Button1Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
begin
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
CurFName := OpenPictureDialog1.FileName;
end;end;//计算一个图片区域内的黑色点数,判断是否超过20%function BlackCount(Pic1: TBitmap; Rect1: Trect): TColor;
var
x, y, PointCount, BlackCount: integer;
begin
Result := clWhite;
BlackCount := 0;
PointCount := 0; for x := Rect1.Left to Rect1.Right do
begin
for y := Rect1.Top to Rect1.Bottom do
begin
inc(PointCount); //统计总数 //if pic1.Canvas.Pixels[x, y] <> 16777215 then if pic1.Canvas.Pixels[x, y] <> clWhite then
Inc(BlackCount); //统计点色所占数
end;
end; //黑色像素数是否超过区域总数20%,如果超过则为黑,否则为白
if BlackCount = 0 then Exit;
if PointCount = 0 then exit; //ShowMessage('Black:'+IntToStr(BlackCount));
//ShowMessage('White:'+IntToStr(PointCount));
if Round(BlackCount / PointCount) > 0.2 then
Result := clBlack
else
Result := clWhite;
end;//图片缩放,保留雏形function TBmpConvertForm.BmpToSmallBmp(Fname: string; ZoomQty: Integer): Tbitmap;
var
bmp1, bmp2: TBitmap;
w, h: integer;
i, j: integer;
BlackMax, x, y: integer;
Rect: Trect;
SPoint: array of array of integer; //用数组保存座标
begin
//读入文件到内存
if not FileExists(Fname) then Exit;
bmp1 := TBitmap.Create;
bmp1.PixelFormat := pf24bit;
bmp1.LoadFromFile(Fname); //将图片划分成等份&ZoomQty为缩放倍数
//宽
w := bmp1.Width mod ZoomQty;
bmp1.Width := bmp1.Width + ZoomQty - w;
w := bmp1.Width div ZoomQty;
//高
h := bmp1.Height mod ZoomQty;
bmp1.Height := bmp1.Height + ZoomQty - h;
h := bmp1.Height div ZoomQty; //设置数组长度
SetLength(SPoint, w, h); BlackMax := 0; //初始化黑色像素点计数
//建立第二个图像
bmp2 := TBitmap.Create;
bmp2.PixelFormat := pf24bit;
bmp2.Width := w;
bmp2.Height := h; ShowMessage(IntToStr(bmp1.Width) + ',' + IntToStr(bmp1.Height));
ShowMessage(IntToStr(bmp2.Width) + ',' + IntToStr(bmp2.Height));
for x := 1 to w do
begin
for y := 1 to h do
begin
rect.Left := ZoomQty * (x - 1);
rect.Top := ZoomQty * (y - 1);
rect.Right := rect.Left + ZoomQty - 1;
rect.Bottom := rect.Top + ZoomQty - 1;
bmp2.Canvas.Pixels[x - 1, y - 1] := BlackCount(bmp1, Rect); //绘制该点
end;
end; //加载转化后的图
Image2.Picture.Bitmap.Assign(bmp2);
Image2.Picture.SaveToFile('C:\outbmp2.bmp');
bmp2.Free;
end;
procedure TBmpConvertForm.Button2Click(Sender: TObject);
begin
//
if CurFName = '' then exit;
BmpToSmallBmp(CurFName, ConstNum);
end;end.
unit BmpConvert;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, ExtDlgs, ComCtrls, ArrayFeature, ZoomRect;type
TBmpConvertForm = class(TForm)
OpenPictureDialog1: TOpenPictureDialog;
Image1: TImage;
Image2: TImage;
BitBtn1: TBitBtn;
TrackBar1: TTrackBar;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Button1: TButton;
Button2: TButton;
Label4: TLabel;
procedure Image1Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
function Get_Most_LRTB(StretchImage: TImage): TRect;
procedure setmap(eight: TDoubleEightArray);
procedure showeight(eightmap: TDoubleEightArray);
procedure FormCreate(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
function BmpToSmallBmp(Fname: string; ZoomQty: Integer): Tbitmap; private
{ Private declarations }
public
{ Public declarations }
end;var
BmpConvertForm: TBmpConvertForm;
ArrayFeature: TArrayFeature;
eight: array of array of TLabel; //array[1..8, 1..8] of TLabel;
EightCode: TDoubleEightArray;
CurFName: string;implementation{$R *.dfm}procedure TBmpConvertForm.Image1Click(Sender: TObject);
beginend;//清除上下左右多余空白function TBmpConvertForm.Get_Most_LRTB(StretchImage: TImage): TRect;
var //得到图片上的最左、最右、最上、最下的点
i, j: integer;
label FindMostRight, FindMostTop, FindMostBottom, FindInMiddle;
begin
//FindMostLeft： 获得最左边的点
for i := 1 to StretchImage.Width - 1 do
for j := 1 to StretchImage.Height - 1 do
if StretchImage.Canvas.Pixels[i, j] <> clWhite then
begin
Result.Left := i;
goto FindMostRight;
end;
FindMostRight: //获得最右边的点
for i := StretchImage.Width - 1 downto 1 do
for j := 1 to StretchImage.Height - 1 do
if StretchImage.Canvas.Pixels[i, j] <> clWhite then
begin
Result.Right := i; goto FindMostTop;
end;
FindMostTop: // 获得最上面的点
for j := 1 to StretchImage.Height - 1 do
for i := 1 to StretchImage.Width - 1 do
if StretchImage.Canvas.Pixels[i, j] <> clWhite then
begin
Result.Top := j; goto FindMostBottom;
end;
FindMostBottom: //获得最下面的点
for j := StretchImage.Height - 1 downto 1 do
for i := 1 to StretchImage.Width - 1 do
if StretchImage.Canvas.Pixels[i, j] <> clWhite then
begin
Result.Bottom := j; goto FindInMiddle;
end;
FindInMiddle:
i := Result.Right - Result.Left; //得到区域宽度
j := Result.Bottom - Result.Top; //得到区域高度
i := i mod 8; i := i div 2;
if i > 0 then //将边缘对称于矩形的左右部分
begin
Dec(Result.Left, i); Inc(Result.Right, i);
end;
j := j mod 8; j := j div 2;
if j > 0 then //将边缘对称于矩形的上下部分
begin
Dec(Result.Top, i); Inc(Result.Bottom, j);
end;
//对左右部分过小的图片进行加宽处理
i := Result.Right - Result.Left;
if i < 80 then //细长的黑色的字最小宽为80
begin
i := (80 - i) div 2;
Dec(Result.Left, i); Inc(Result.Right, i);
end;
end;procedure TBmpConvertForm.showeight(eightmap: TDoubleEightArray);
var
i, j: integer;
begin
for i := 1 to ConstNum - 1 do
for j := 1 to ConstNum - 1 do
if eightmap[i][j] = 1 then
eight[i][j].Color := clRed
else
eight[i][j].Color := clwhite;
end;procedure TBmpConvertForm.setmap(eight: TDoubleEightArray);
begin
EightCode := eight;
end;procedure TBmpConvertForm.BitBtn1Click(Sender: TObject);
var
rect_s, rect_d: TRect;
SaveImage: Tbitmap;
Eight: TDoubleEightArray;
x, i: integer;
begin
SetLength(eight, ConstNum, ConstNum);
SaveImage := Tbitmap.Create;
// 取得数字图片的位置 rest_d;
Rect_s := Get_Most_LRTB(Image1);
Rect_d.Top := 0;
Rect_d.Left := 0;
Rect_d.Right := rect_s.Right - rect_s.Left;
Rect_d.Bottom := rect_s.Bottom - rect_s.Top; SaveImage.Width := rect_d.Right;
SaveImage.Height := rect_d.Bottom;
SaveImage.Canvas.CopyRect(rect_d, Image1.Canvas, rect_s);
SaveImage.SaveToFile('TempImage.bmp'); // 得到8*8特征值
if ArrayFeature = nil then
ArrayFeature := TArrayFeature.Create;
// 这里对左边的显示窗口进行操作
ArrayFeature.SetPicFile('TempImage.bmp');
eight := ArrayFeature.GetDoubleEightArray; //取得8*8数据
showeight(eight);
setmap(eight); //显示8*8图像 Image2.Picture.LoadFromFile('TempImage.bmp');
SaveImage.Free;
end;//初始化procedure TBmpConvertForm.FormCreate(Sender: TObject);
var
i, j: Integer;
begin
DoubleBuffered := true;
ConstNum := 8 + 1;
SetLength(eight, ConstNum, ConstNum);
SetLength(EightCode, ConstNum, ConstNum); //显示8*8特征块图像
{ for i := 1 to ConstNum-1 do
for j := 1 to ConstNum-1 do
begin
eight[i][j] := TLabel.Create(self);
eight[i][j].Parent := self;
eight[i][j].Width := 20;
eight[i][j].Height := 20;
eight[i][j].Left := (i - 1) * 20 + 200;
eight[i][j].Top := j * 20 + 220;
eight[i][j].Color := clRed;
end; }
end;procedure TBmpConvertForm.TrackBar1Change(Sender: TObject);
begin
ConstNum := TrackBar1.Position; //远近参数等于该值
Label4.Caption := IntToStr(ConstNum);
SetLength(eight, ConstNum, ConstNum);
SetLength(EightCode, ConstNum, ConstNum);
end;procedure TBmpConvertForm.Button1Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
begin
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
CurFName := OpenPictureDialog1.FileName;
end;end;//计算一个图片区域内的黑色点数,判断是否超过20%function BlackCount(Pic1: TBitmap; Rect1: Trect): TColor;
var
x, y, PointCount, BlackCount: integer;
begin
Result := clWhite;
BlackCount := 0;
PointCount := 0; for x := Rect1.Left to Rect1.Right do
begin
for y := Rect1.Top to Rect1.Bottom do
begin
inc(PointCount); //统计总数 //if pic1.Canvas.Pixels[x, y] <> 16777215 then if pic1.Canvas.Pixels[x, y] <> clWhite then
Inc(BlackCount); //统计点色所占数
end;
end; //黑色像素数是否超过区域总数20%,如果超过则为黑,否则为白
if BlackCount = 0 then Exit;
if PointCount = 0 then exit; //ShowMessage('Black:'+IntToStr(BlackCount));
//ShowMessage('White:'+IntToStr(PointCount));
if Round(BlackCount / PointCount) > 0.2 then
Result := clBlack
else
Result := clWhite;
end;//图片缩放,保留雏形function TBmpConvertForm.BmpToSmallBmp(Fname: string; ZoomQty: Integer): Tbitmap;
var
bmp1, bmp2: TBitmap;
w, h: integer;
i, j: integer;
BlackMax, x, y: integer;
Rect: Trect;
SPoint: array of array of integer; //用数组保存座标
begin
//读入文件到内存
if not FileExists(Fname) then Exit;
bmp1 := TBitmap.Create;
bmp1.PixelFormat := pf24bit;
bmp1.LoadFromFile(Fname); //将图片划分成等份&ZoomQty为缩放倍数
//宽
w := bmp1.Width mod ZoomQty;
bmp1.Width := bmp1.Width + ZoomQty - w;
w := bmp1.Width div ZoomQty;
//高
h := bmp1.Height mod ZoomQty;
bmp1.Height := bmp1.Height + ZoomQty - h;
h := bmp1.Height div ZoomQty; //设置数组长度
SetLength(SPoint, w, h); BlackMax := 0; //初始化黑色像素点计数
//建立第二个图像
bmp2 := TBitmap.Create;
bmp2.PixelFormat := pf24bit;
bmp2.Width := w;
bmp2.Height := h; ShowMessage(IntToStr(bmp1.Width) + ',' + IntToStr(bmp1.Height));
ShowMessage(IntToStr(bmp2.Width) + ',' + IntToStr(bmp2.Height));
for x := 1 to w do
begin
for y := 1 to h do
begin
rect.Left := ZoomQty * (x - 1);
rect.Top := ZoomQty * (y - 1);
rect.Right := rect.Left + ZoomQty - 1;
rect.Bottom := rect.Top + ZoomQty - 1;
bmp2.Canvas.Pixels[x - 1, y - 1] := BlackCount(bmp1, Rect); //绘制该点
end;
end; //加载转化后的图
Image2.Picture.Bitmap.Assign(bmp2);
Image2.Picture.SaveToFile('C:\outbmp2.bmp');
bmp2.Free;
end;
procedure TBmpConvertForm.Button2Click(Sender: TObject);
begin
//
if CurFName = '' then exit;
BmpToSmallBmp(CurFName, ConstNum);
end;end.
不清楚你说的出问题是什么问题
在找原因...
那样有啥意义？让客户难受？
在找原因...
比例不同，只是影响转换出的图像的大小