unit ScanImage;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, jpeg, AxCtrls, Menus, ActnList, ComCtrls, ToolWin,
ExtDlgs, ImgList, Clipbrd, Spin, Buttons, Math, ScanLibCtl_TLB,
AdminLibCtl_TLB, ImgeditLibCtl_TLB, OleCtrls, DbOleCtl;
type
TPointsType = array [0..3] of TPoint;
type
TfrmScanImage = class(TForm)
ActionList1: TActionList;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
E1: TMenuItem;
itemScan: TAction;
itemCalog: TAction;
ItemExit: TAction;
itemAbout: TAction;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
itemShowScan: TAction;
N9: TMenuItem;
N10: TMenuItem;
itemUndo: TAction;
itemRedo: TAction;
StatusBar1: TStatusBar;
itemSave: TAction;
N19: TMenuItem;
N20: TMenuItem;
SvDlgScan: TSaveDialog;
OpenPictureDialog1: TOpenPictureDialog;
ToolBar1: TToolBar;
tlbtnScan: TToolButton;
tlbtnSave: TToolButton;
tlbtnTransfer: TToolButton;
ToolButton1: TToolButton;
ImageList1: TImageList;
ToolButton2: TToolButton;
ToolButton8: TToolButton;
ScrollBox1: TScrollBox;
ImgEdit: TImgEdit;
Panel1: TPanel;
Label1: TLabel;
lblLight: TLabel;
Label3: TLabel;
scrlbrLight: TScrollBar;
lblContrast: TLabel;
scrlbrContrast: TScrollBar;
Label5: TLabel;
lblRotate: TLabel;
scrlbrRotate: TScrollBar;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
spnedtX: TSpinEdit;
spnedtY: TSpinEdit;
Label10: TLabel;
lblColorR: TLabel;
N7: TMenuItem;
spdbtnLight: TSpeedButton;
spdbtnContrast: TSpeedButton;
spdbtnRotate: TSpeedButton;
spdbtnColor: TSpeedButton;
Label2: TLabel;
scrlbrColorR: TScrollBar;
Label4: TLabel;
scrlbrColorG: TScrollBar;
Label6: TLabel;
scrlbrColorB: TScrollBar;
lblColorG: TLabel;
lblColorB: TLabel;
Label11: TLabel;
scrlbrSharp: TScrollBar;
lblSharp: TLabel;
spnbtnSharp: TSpeedButton;
N8: TMenuItem;
PopupMenu1: TPopupMenu;
S1: TMenuItem;
Panel2: TPanel;
ScrollBox3: TScrollBox;
ImgShow: TImage;
ImgAdmin1: TImgAdmin;
ImgScan1: TImgScan;
pnlShow: TPanel;
ScrollBox2: TScrollBox;
Image1: TImage;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
Label12: TLabel;
lblBlur: TLabel;
ScrollBar1: TScrollBar;
ToolButton5: TToolButton;
tlbtnBox: TToolButton;
procedure ItemExitExecute(Sender: TObject);
procedure itemShowScanExecute(Sender: TObject);
procedure itemScanExecute(Sender: TObject);
procedure itemSaveExecute(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure itemCalogExecute(Sender: TObject);
procedure scrlbrLightChange(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure spdbtnLightClick(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure ImgShowMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure S1Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure Image1DblClick(Sender: TObject);
procedure scrlbrSharpScroll(Sender: TObject; ScrollCode: TScrollCode;
var ScrollPos: Integer);
procedure ImgShowMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ImgShowMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
FFileName : string;
FBitmap : TBitmap;
//FDown : Boolean;
FPoints : TPointsType;
FChange, FMouseDown : Boolean;
K, FSelPoint : Integer;
FDownPoint, FUpPoint : TPoint;
procedure Lightness(var clip: Tbitmap; Amount: Integer);
procedure SmoothRotate(var Src, Dst: TBitmap; cx, cy: Integer;
Angle: Extended);
procedure SaveBitmap;
procedure Contrast(var clip: tbitmap; Amount: Integer);
procedure ColorWeight(var clip: tbitmap; indexR,indexG,indexB : integer);
procedure Sharp2(var clip: tbitmap; Amount: integer);
procedure Sharp3(var clip: tbitmap; Amount: integer);
procedure Sharp4(Bmp: TBitmap; Amount: Integer);
procedure Sharp5(var clip: tbitmap; Amount: integer);
procedure Twist(SrBMP, DstBMP: TBitmap; Points: TPointsType);
procedure ClearLine;
procedure BoxMouseDown(X, Y : Integer);
procedure BoxMouseMove(X, Y : Integer);
procedure BoxMouseUp(X, Y : Integer);
procedure ShowLanguage;
public
{ Public declarations }
property FileName : string read FFileName;
end;
var
frmScanImage: TfrmScanImage;
implementation
uses TiHua, AULanguage;
{$R *.DFM}
procedure ActOnTemplete(Arr : Pointer;ArrCount : Integer;ABmp : TBitmap);
var i,j,k : Integer;
OrgLine,Line : PByteArray;
ALine,BLine : PByteArray;
Param : array of Integer;
BBmp : TBitmap;
Total : Integer;
begin
ABmp.PixelFormat := pf24bit;
BBmp := TBitmap.Create;
BBmp.Assign(ABmp);
SetLength(Param,ArrCount);
CopyMemory(Param,Arr,ArrCount * SizeOf(Integer));
Total := 0;
for i := Low(Param) to High(Param) do
Total := Total + Param
;
if Total = 0 then Total := 1;
for i := 1 to ABmp.Height - 2 do
begin
Line := ABmp.ScanLine;
OrgLine := BBmp.ScanLine;
ALine := BBmp.ScanLine[i - 1];
BLine := BBmp.ScanLine[i + 1];
for j := 1 to ABmp.Width - 2 do
begin
k := (OrgLine[j * 3] * Param[4] + OrgLine[(j - 1) * 3] * Param[3] +
OrgLine[(j + 1) * 3] * Param[5] + ALine[j * 3] * Param[1] +
ALine[(j - 1) * 3] * Param[0] + ALine[(j + 1) * 3] * Param[2] +
BLine[j * 3] * Param[7] + BLine[(j - 1) * 3] * Param[6] +
BLine[(j + 1) * 3] * Param[8]) div Total;
if k > 255 then Line[j * 3] := 255
else if k < 0 then Line[j * 3] := 0
else Line[j * 3] := k;
k := (OrgLine[j * 3 + 1] * Param[4] + OrgLine[(j - 1) * 3 + 1] * Param[3]
+ OrgLine[(j + 1) * 3 + 1] * Param[5] + ALine[j * 3 + 1] * Param[1] +
ALine[(j - 1) * 3 + 1] * Param[0] + ALine[(j + 1) * 3 + 1] * Param[2] +
BLine[j * 3 + 1] * Param[7] + BLine[(j - 1) * 3 + 1] * Param[6] +
BLine[(j + 1) * 3 + 1] * Param[8]) div Total;
if k > 255 then Line[j * 3 + 1] := 255
else if k < 0 then Line[j * 3 + 1] := 0
else Line[j * 3 + 1] := k;
k := (OrgLine[j * 3 + 2] * Param[4] + OrgLine[(j - 1) * 3 + 2] * Param[3]
+ OrgLine[(j + 1) * 3 + 2] * Param[5] + ALine[j * 3 + 2] * Param[1] +
ALine[(j - 1) * 3 + 2] * Param[0] + ALine[(j + 1) * 3 + 2] * Param[2] +
BLine[j * 3 + 2] * Param[7] + BLine[(j - 1) * 3 + 2] * Param[6] +
BLine[(j + 1) * 3 + 2] * Param[8]) div Total;
if k > 255 then Line[j * 3 + 2] := 255
else if k < 0 then Line[j * 3 + 2] := 0
else Line[j * 3 + 2] := k;
end;
end;
BBmp.Free;
end;
function IntToByte(i:Integer):Byte;
begin
if i>255 then Result:=255
else if i<0 then Result:=0
else Result:=i;
end;
function myGetTempPath: String;
var
nBufferLength : DWORD;
lpBuffer : PChar;
begin
nBufferLength := 255;
GetMem(lpBuffer, nBufferLength);
try
if GetTempPath(nBufferLength, lpBuffer) <> 0 then
Result := StrPas(lpBuffer)
else
Result := '';
finally
FreeMem(lpBuffer);
end;
end;
function TrimInt(i, Min, Max: Integer): Integer;
begin
if i>Max then Result:=Max
else if i<Min then Result:=Min
else Result:=i;
end;
procedure TfrmScanImage.ItemExitExecute(Sender: TObject);
begin
Close;
end;
//选择系统中已安装的扫描仪
procedure TfrmScanImage.itemShowScanExecute(Sender: TObject);
begin
ImgScan1.ShowSelectScanner;
end;
procedure TfrmScanImage.itemScanExecute(Sender: TObject);
begin
ImgEdit.Zoom:=100; //设置图象的放缩因子
ImgShow.Left := 0;
ImgShow.Top := 0;
if not ImgScan1.ScannerAvailable then
begin
ShowMessage(FindLanguageString('[9,1]'));
exit;
end;
with ImgScan1 do
begin
if ScannerAvailable then //如果选择的扫描仪不可用
begin
OpenScanner; //打开扫描仪
StartScan; //开始扫描图象
CloseScanner; //关闭扫描仪
if FileExists(ExtractFilePath(Application.ExeName)+'cccc.tif') then
begin
ImgEdit.Display;
ImgEdit.ClipboardCopy(0,0,ImgEdit.ImageWidth,ImgEdit.ImageHeight);
ImgShow.Width := ImgEdit.ImageWidth;
ImgShow.Height := ImgEdit.ImageHeight;
spnedtX.Value := ImgShow.Width div 2;
spnedtY.Value := ImgShow.Height div 2;
ImgShow.Picture.Bitmap.Assign(Clipboard);
Clipboard.Clear;
SaveBitmap;
ImgShow.Picture := nil;
ImgShow.Picture.Bitmap.Assign(FBitmap);
end;
end;
end;
end;
procedure TfrmScanImage.itemSaveExecute(Sender: TObject);
begin
if not FChange then
ClearLine;
SvDlgScan.InitialDir := ExtractFilePath(ParamStr(0));
if ImgShow.Picture.Bitmap.Empty then Exit;
if SvDlgScan.Execute then
begin
ImgShow.Picture.Bitmap.SaveToFile(SvDlgScan.FileName);
//ImgEdit.SaveAs(SvDlgScan.FileName);
//if FileExists(FTempPath + '$$$~~.TIFF') then
// DeleteFile(FTempPath + '$$$~~.TIFF');
end;
end;
procedure TfrmScanImage.FormCreate(Sender: TObject);
var
s : string;
begin
//FTempPath := myGetTempPath;
// ShowLanguage;
K := 0;
FMouseDown := false;
FChange := true;
lblLight.Caption := IntToStr(scrlbrLight.Position);
lblColorR.Caption := IntToStr(scrlbrColorR.Position);
lblColorG.Caption := IntToStr(scrlbrColorG.Position);
lblColorB.Caption := IntToStr(scrlbrColorB.Position);
lblContrast.Caption := IntToStr(scrlbrContrast.Position);
lblRotate.Caption := IntToStr(scrlbrRotate.Position);
lblSharp.Caption := IntToStr(scrlbrSharp.Position);
ImgShow.Left := 0;
ImgShow.Top := 0;
ImgShow.Canvas.Pen.Color := clRed;
ImgShow.Canvas.Pen.Mode := pmNotXor;
FBitmap := TBitmap.Create;
s := ExtractFilePath(Application.ExeName);
s := s + 'cccc.TIF';
{ if not FileExists(s) then
begin
Stream := TFileStream.Create(s, fmCreate);
try
finally
Stream.Free;
end;
//ShowMessage('程序运行目录中不存在 cccc.TIF 文件');
//CreateFile(PChar(cccc.TiF),
//exit;
end;}
ImgScan1.Image := s;
ImgEdit.Image := s;
//ImgScan1.Image := FTempPath + '$$$~~.TIFF';
//ImgEdit.Image := FTempPath + '$$$~~.TIFF';
end;
procedure TfrmScanImage.itemCalogExecute(Sender: TObject);
begin
// Application.HelpContext(1130);
end;
procedure TfrmScanImage.Lightness(var clip: tbitmap; Amount: Integer);
var
p0 : pbytearray;
r,g,b,x,y : Integer;
begin
for y:=0 to clip.Height-1 do begin
p0:=clip.scanline[y];
for x:=0 to clip.Width-1 do
begin
r:=p0[x*3];
g:=p0[x*3+1];
b:=p0[x*3+2];
p0[x*3]:=IntToByte(r+((255-r)*Amount)div 255);
p0[x*3+1]:=IntToByte(g+((255-g)*Amount)div 255);
p0[x*3+2]:=IntToByte(b+((255-b)*Amount)div 255);
end;
end;
end;
procedure TfrmScanImage.Contrast(var clip: tbitmap; Amount: Integer);
var
p0
bytearray;
rg,gg,bg,r,g,b,x,y: Integer;
begin
for y:=0 to clip.Height-1 do
begin
p0:=clip.scanline[y];
for x:=0 to clip.Width-1 do
begin
r:=p0[x*3];
g:=p0[x*3+1];
b:=p0[x*3+2];
rg:=(Abs(127-r)*Amount)div 255;
gg:=(Abs(127-g)*Amount)div 255;
bg:=(Abs(127-b)*Amount)div 255;
if r>127 then r:=r+rg else r:=r-rg;
if g>127 then g:=g+gg else g:=g-gg;
if b>127 then b:=b+bg else b:=b-bg;
p0[x*3]:=IntToByte(r);
p0[x*3+1]:=IntToByte(g);
p0[x*3+2]:=IntToByte(b);
end;
end;
end;
procedure TfrmScanImage.SmoothRotate(var Src, Dst: TBitmap; cx, cy: Integer;
Angle: Extended);
type
TFColor = record b,g,r:Byte end;
var
Top,
Bottom,
Left,
Right,
eww,nsw,
fx,fy,
wx,wy: Extended;
cAngle,
sAngle: Double;
xDiff,
yDiff,
ifx,ify,
px,py,
ix,iy,
x,y: Integer;
nw,ne,
sw,se: TFColor;
P1,P2,P3bytearray;
begin
Angle:=angle;
Angle:=-Angle*Pi/180;
sAngle:=Sin(Angle);
cAngle:=Cos(Angle);
xDiff:=(Dst.Width-Src.Width)div 2;
yDiff:=(Dst.Height-Src.Height)div 2;
for y:=0 to Dst.Height-1 do
begin
P3:=Dst.scanline[y];
py:=2*(y-cy)+1;
for x:=0 to Dst.Width-1 do
begin
px:=2*(x-cx)+1;
fx:=(((px*cAngle-py*sAngle)-1)/ 2+cx)-xDiff;
fy:=(((px*sAngle+py*cAngle)-1)/ 2+cy)-yDiff;
ifx:=Round(fx);
ify:=Round(fy);
if(ifx>-1)and(ifx<Src.Width)and(ify>-1)and(ify<Src.Height)then
begin
eww:=fx-ifx;
nsw:=fy-ify;
iy:=TrimInt(ify+1,0,Src.Height-1);
ix:=TrimInt(ifx+1,0,Src.Width-1);
P1:=Src.scanline[ify];
P2:=Src.scanline[iy];
nw.r:=P1[ifx*3];
nw.g:=P1[ifx*3+1];
nw.b:=P1[ifx*3+2];
ne.r:=P1[ix*3];
ne.g:=P1[ix*3+1];
ne.b:=P1[ix*3+2];
sw.r:=P2[ifx*3];
sw.g:=P2[ifx*3+1];
sw.b:=P2[ifx*3+2];
se.r:=P2[ix*3];
se.g:=P2[ix*3+1];
se.b:=P2[ix*3+2];
Top:=nw.b+eww*(ne.b-nw.b);
Bottom:=sw.b+eww*(se.b-sw.b);
P3[x*3+2]:=IntToByte(Round(Top+nsw*(Bottom-Top)));
Top:=nw.g+eww*(ne.g-nw.g);
Bottom:=sw.g+eww*(se.g-sw.g);
P3[x*3+1]:=IntToByte(Round(Top+nsw*(Bottom-Top)));
Top:=nw.r+eww*(ne.r-nw.r);
Bottom:=sw.r+eww*(se.r-sw.r);
P3[x*3]:=IntToByte(Round(Top+nsw*(Bottom-Top)));
end;
end;
end;
end;
procedure TfrmScanImage.scrlbrLightChange(Sender: TObject);
var
TempValue: integer;
TempBmp : TBitmap;
Temp : array of Integer;
begin
if ImgShow.Picture.Bitmap.Empty then
exit;
FChange := true;
TempBmp := TBitmap.Create;
TempBmp.Width := FBitmap.Width;
TempBmp.Height := FBitmap.Height;
BitBlt(TempBmp.Canvas.Handle,0,0,TempBmp.Width,TempBmp.Height,
FBitmap.Canvas.Handle,0,0,SRCCOPY);
TempBmp.PixelFormat := pf24bit;
TempValue := (Sender as TScrollBar).Position;
case (Sender as TScrollBar).Tag of
1 :
begin
Lightness(TempBmp,TempValue);
lblLight.Caption := IntToStr((Sender as TScrollBar).Position);
end;
2 :
begin
Contrast(TempBmp,TempValue);
lblContrast.Caption := IntToStr((Sender as TScrollBar).Position);
end;
3 :
begin
TempBmp.Canvas.Brush.Color := clWhite;
TempBmp.Canvas.FillRect(TempBmp.Canvas.ClipRect);
SmoothRotate(FBitmap,TempBmp,spnedtX.Value,spnedtY.Value,TempValue);
lblRotate.Caption := IntToStr((Sender as TScrollBar).Position);
end;
4, 5, 6 :
begin
ColorWeight(TempBmp,scrlbrColorR.Position,scrlbrColorG.Position,
scrlbrColorB.Position);
lblColorR.Caption := IntToStr(scrlbrColorR.Position);
lblColorG.Caption := IntToStr(scrlbrColorG.Position);
lblColorB.Caption := IntToStr(scrlbrColorB.Position);
end;
7 :
begin
lblSharp.Caption := IntToStr((Sender as TScrollBar).Position);
if scrlbrSharp.Position = 0 then
begin
ImgShow.Picture.Bitmap.Assign(FBitmap);
ImgShow.Refresh;
exit;
end;
//Sharp5(TempBmp,TempValue);
SetLength(Temp,9);
Temp[0] := -1;
Temp[1] := -1;
Temp[2] := -1;
Temp[3] := -1;
Temp[4] := 9;
Temp[5] := -1;
Temp[6] := -1;
Temp[7] := -1;
Temp[8] := -1;
ActOnTemplete(Temp,Length(Temp),TempBmp);
//ActOnTemplete(@Laplace,Length(Temp),Bmp);
//Image1.Picture.Assign(Bmp);
//Bmp.Free;
end;
8 :
begin
lblBlur.Caption := IntToStr((Sender as TScrollBar).Position);
if ScrollBar1.Position = 0 then
begin
ImgShow.Picture.Bitmap.Assign(FBitmap);
ImgShow.Refresh;
exit;
end;
SetLength(Temp,9);
Temp[0] := 1;
Temp[1] := 2;
Temp[2] := 1;
Temp[3] := 2;
Temp[4] := 4;
Temp[5] := 2;
Temp[6] := 1;
Temp[7] := 2;
Temp[8] := 1;
ActOnTemplete(Temp,Length(Temp),TempBmp);
end;
end;
//ImgShow.Picture := nil;
ImgShow.Picture.Bitmap.Assign(TempBmp);
ImgShow.Update;
FreeAndNil(TempBmp);
//ImgShow.Update;
end;
procedure TfrmScanImage.Sharp2(var clip: Tbitmap; Amount : integer);
var
p0,p1,p2bytearray;
cx,x,y: Integer;
Buf: array[0..8,0..2]of Byte;
r,g,b : integer;
begin
for y:=0 to clip.Height-1 do
begin
p0 := clip.ScanLine[TrimInt(y-Amount,0,clip.Height-1)];
p1:=clip.scanline[y];
p2 := clip.ScanLine[TrimInt(y+Amount,0,clip.Height-1)];
for x:=0 to (clip.Width-1) * 3 do
begin
cx:=TrimInt(x-Amount,0,clip.Width-1);
Buf[0,0] := p0[cx * 3];
Buf[0,1] := p0[cx * 3 + 1];
Buf[0,2] := p0[cx * 3 + 2];
Buf[1,0] := p1[cx * 3];
Buf[1,1] := p1[cx * 3 + 1];
Buf[1,2] := p1[cx * 3 + 2];
Buf[2,0] := p2[cx * 3];
Buf[2,1] := P2[cx * 3 + 1];
Buf[2,2] := P2[cx * 3 + 2];
Buf[3,0] := p0[x * 3];
Buf[3,1] := p0[x * 3 + 1];
Buf[3,2] := p0[x * 3 + 2];
Buf[4,0] := p1[x * 3];
Buf[4,1] := p1[x * 3 + 1];
Buf[4,2] := p1[x * 3 + 2];
Buf[5,0] := p2[x * 3];
Buf[5,1] := P2[x * 3 + 1];
Buf[5,2] := P2[x * 3 + 2];
cx:=TrimInt(x+Amount,0,clip.Width-1);
Buf[6,0] := p0[cx * 3];
Buf[6,1] := p0[cx * 3 + 1];
Buf[6,2] := p0[cx * 3 + 2];
Buf[7,0] := p1[cx * 3];
Buf[7,1] := p1[cx * 3 + 1];
Buf[7,2] := p1[cx * 3 + 2];
Buf[8,0] := p2[cx * 3];
Buf[8,1] := P2[cx * 3 + 1];
Buf[8,2] := P2[cx * 3 + 2];
{ r := ((-Buf[0,0]-Buf[1,0]-Buf[2,0]-Buf[3,0]+Buf[4,0] * 9
-Buf[5,0]-Buf[6,0]-Buf[7,0]-Buf[8,0]));
g := ((-Buf[0,1]-Buf[1,1]-Buf[2,1]-Buf[3,1]+Buf[4,1] * 9
-Buf[5,1]-Buf[6,1]-Buf[7,1]-Buf[8,1]));
b := ((-Buf[0,2]-Buf[1,2]-Buf[2,2]-Buf[3,2]+Buf[4,2] * 9
-Buf[5,2]-Buf[6,2]-Buf[7,2]-Buf[8,2]));
if r < 0 then
r := abs(r);
if r > 255 then
r := 255;
if g < 0 then
g := abs(g);
if g > 255 then
g := 255;
if b < 0 then
b := abs(b);
if b > 255 then
b := 255;
p1[x*3] := Byte(r);
p1[x*3+1] := Byte(g);
p1[x*3+2] := Byte(b); }
r := (256 * Buf[4,0]-(Buf[0,0]+Buf[1,0]+Buf[2,0]+Buf[3,0]
+Buf[5,0]+Buf[6,0]+Buf[7,0]+Buf[8,0])*16) div 128;
g := (256 * Buf[4,1]-(Buf[0,1]+Buf[1,1]+Buf[2,1]+Buf[3,1]
+Buf[5,1]+Buf[6,1]+Buf[7,1]+Buf[8,1])*16) div 128;
b := (256 * Buf[4,2]-(Buf[0,2]+Buf[1,2]+Buf[2,2]+Buf[3,2]
+Buf[5,2]+Buf[6,2]+Buf[7,2]+Buf[8,2])*16) div 128;
p1[cx*3] := IntToByte(r);
p1[cx*3+1] := IntToByte(g);
p1[cx*3+2] := IntToByte(b);
end;
end;
end;
procedure TfrmScanImage.Sharp5(var clip: TBitmap; Amount: integer);
var
p0,p1,p2bytearray;
cx,x,y: Integer;
Buf: array[0..4,0..2]of byte;
begin
if Amount=0 then Exit;
for y:=0 to clip.Height-1 do
begin
p0:=clip.scanline[y];
if y-Amount<0 then p1:=clip.scanline[y]
else {y-Amount>0} p1:=clip.ScanLine[y-Amount];
if y+Amount<clip.Height then p2:=clip.ScanLine[y+Amount]
else {y+Amount>=Height} p2:=clip.ScanLine[clip.Height-y];
for x:=0 to clip.Width-1 do
begin
Buf[4,0] := p0[x*3];
Buf[4,1] := p0[x*3 + 1];
Buf[4,2] := p0[x*3 + 2];
if x-Amount<0 then cx:=x
else {x-Amount>0} cx:=x-Amount;
Buf[0,0]:=p1[cx*3];
Buf[0,1]:=p1[cx*3+1];
Buf[0,2]:=p1[cx*3+2];
Buf[1,0]:=p2[cx*3];
Buf[1,1]:=p2[cx*3+1];
Buf[1,2]:=p2[cx*3+2];
if x+Amount<clip.Width then cx:=x+Amount
else {x+Amount>=Width} cx:=clip.Width-x;
Buf[2,0]:=p1[cx*3];
Buf[2,1]:=p1[cx*3+1];
Buf[2,2]:=p1[cx*3+2];
Buf[3,0]:=p2[cx*3];
Buf[3,1]:=p2[cx*3+1];
Buf[3,2]:=p2[cx*3+2];
p0[x*3]:=IntToByte(Buf[4,0]*5-(Buf[0,0]+Buf[1,0]+Buf[2,0]+Buf[3,0]));
p0[x*3+1]:=IntToByte(Buf[4,1]*5-(Buf[0,1]+Buf[1,1]+Buf[2,1]+Buf[3,1]));
p0[x*3+2]:=IntToByte(Buf[4,2]*5-(Buf[0,2]+Buf[1,2]+Buf[2,2]+Buf[3,2]));
end;
end;
end;
procedure TfrmScanImage.Sharp3(var clip: tbitmap; Amount: integer);
var
p0,p1,p2bytearray;
cx,x,y: Integer;
Buf: array[0..3,0..2]of byte;
begin
if Amount=0 then Exit;
for y:=0 to clip.Height-1 do
begin
p0:=clip.scanline[y];
if y-Amount<0 then p1:=clip.scanline[y]
else {y-Amount>0} p1:=clip.ScanLine[y-Amount];
if y+Amount<clip.Height then p2:=clip.ScanLine[y+Amount]
else {y+Amount>=Height} p2:=clip.ScanLine[clip.Height-y];
for x:=0 to clip.Width-1 do
begin
if x-Amount<0 then cx:=x
else {x-Amount>0} cx:=x-Amount;
Buf[0,0]:=p1[cx*3];
Buf[0,1]:=p1[cx*3+1];
Buf[0,2]:=p1[cx*3+2];
Buf[1,0]:=p2[cx*3];
Buf[1,1]:=p2[cx*3+1];
Buf[1,2]:=p2[cx*3+2];
if x+Amount<clip.Width then cx:=x+Amount
else {x+Amount>=Width} cx:=clip.Width-x;
Buf[2,0]:=p1[cx*3];
Buf[2,1]:=p1[cx*3+1];
Buf[2,2]:=p1[cx*3+2];
Buf[3,0]:=p2[cx*3];
Buf[3,1]:=p2[cx*3+1];
Buf[3,2]:=p2[cx*3+2];
p0[x*3]:=(Buf[0,0]+Buf[1,0]+Buf[2,0]+Buf[3,0])shr 2;
p0[x*3+1]:=(Buf[0,1]+Buf[1,1]+Buf[2,1]+Buf[3,1])shr 2;
p0[x*3+2]:=(Buf[0,2]+Buf[1,2]+Buf[2,2]+Buf[3,2])shr 2;
end;
end;
end;
procedure TfrmScanImage.Sharp4(Bmp:TBitmap;Amount:Integer);
{var
Lin0,
Lin1,
Lin2: PByteArray;
// pc: PFColor;
cx,x,y: Integer;
Buf: array[0..8]of integer; }
begin
{ for y:=0 to Bmp.Height-1 do
begin
Lin0:=Bmp.ScanLine[TrimInt(y-Amount,0,Bmp.Height-1)];
Lin1:=Bmp.ScanLine[y];
Lin2:=Bmp.ScanLine[TrimInt(y+Amount,0,Bmp.Height-1)];
for x:=0 to Bmp.Width-1 do
begin
cx:=TrimInt(x-Amount,0,Bmp.Width-1);
Buf[0]:=Lin0[cx];
Buf[1]:=Lin1[cx];
Buf[2]:=Lin2[cx];
Buf[3]:=Lin0[x];
Buf[4]:=Lin1[x];
Buf[5]:=Lin2[x];
cx:=TrimInt(x+Amount,0,Bmp.Width-1);
Buf[6]:=Lin0[cx];
Buf[7]:=Lin1[cx];
Buf[8]:=Lin2[cx];
pc.b:=IntToByte(
(256*Buf[4].b-(Buf[0].b+Buf[1].b+Buf[2].b+Buf[3].b+
Buf[5].b+Buf[6].b+Buf[7].b+Buf[8].b)*16)div 128);
pc.g:=IntToByte(
(256*Buf[4].g-(Buf[0].g+Buf[1].g+Buf[2].g+Buf[3].g+
Buf[5].g+Buf[6].g+Buf[7].g+Buf[8].g)*16)div 128);
pc.r:=IntToByte(
(256*Buf[4].r-(Buf[0].r+Buf[1].r+Buf[2].r+Buf[3].r+
Buf[5].r+Buf[6].r+Buf[7].r+Buf[8].r)*16)div 128);
Inc(pc);
end;
pc:=Pointer(Integer(pc)+Bmp.Gap);
end; }
end;
procedure TfrmScanImage.SaveBitmap;
begin
if Assigned(FBitmap) then
FreeAndNil(FBitmap);
FBitmap := TBitmap.Create;
FBitmap.Width := ImgShow.Width;
FBitmap.Height := ImgShow.Height;
BitBlt(FBitmap.Canvas.Handle,0,0,FBitmap.Width,FBitmap.Height,
ImgShow.Picture.Bitmap.Canvas.Handle,0,0,SRCCOPY);
FBitmap.PixelFormat := pf24bit;
end;
procedure TfrmScanImage.FormDestroy(Sender: TObject);
var
S : string;
begin
s := ExtractFilePath(Application.ExeName);
s := s + 'cccc.TIF';
if FileExists(s) then DeleteFile(s);
if Assigned(FBitmap) then
FreeAndNil(FBitmap);
end;
procedure TfrmScanImage.ColorWeight(var clip: tbitmap; indexR, indexG,
indexB: integer);
var
p0 : pbytearray;
r,g,b,x,y : Integer;
begin
for y:=0 to clip.Height-1 do begin
p0:=clip.scanline[y];
for x:=0 to clip.Width-1 do
begin
b:=p0[x*3];
g:=p0[x*3+1];
r:=p0[x*3+2];
r := r + indexR;
if r > 255 then
r := 255;
g := g + indexG;
if g > 255 then
g := 255;
b := b + indexB;
if b > 255 then
b := 255;
p0[x*3]:=IntToByte(b);
p0[x*3+1]:=IntToByte(g);
p0[x*3+2]:=IntToByte(r);
end;
end;
end;
procedure TfrmScanImage.ClearLine;
var
i : integer;
begin
With ImgShow.Canvas do
begin
for i := 0 to 2 do
begin
MoveTo(FPoints.x,FPoints.y);
LineTo(FPoints[i + 1].x,FPoints[i + 1].y);
end;
MoveTo(FPoints[0].x,FPoints[0].y);
LineTo(FPoints[3].x,FPoints[3].y);
end;
end;
procedure TfrmScanImage.spdbtnLightClick(Sender: TObject);
begin
if ImgShow.Picture.Bitmap.Empty then
exit;
if not FChange then
ClearLine;
SaveBitmap;
scrlbrColorR.Position := 0;
scrlbrColorG.Position := 0;
scrlbrColorB.Position := 0;
scrlbrContrast.Position := 0;
scrlbrLight.Position := 0;
scrlbrRotate.Position := 0;
scrlbrSharp.Position := 0;
spnedtX.Value := ImgShow.Width div 2;
spnedtY.Value := ImgShow.Height div 2;
end;
procedure TfrmScanImage.N10Click(Sender: TObject);
begin
FChange := true;
ImgShow.Picture.Bitmap.Assign(FBitmap);
ImgShow.Update;
StretchBlt(ImgShow.Canvas.Handle,ImgShow.Width - 1,0, - ImgShow.Width,ImgShow.Height,
ImgShow.Canvas.Handle,0,0,ImgShow.Width,ImgShow.Height,SRCCOPY);
ImgShow.Refresh;
SaveBitmap;
end;
procedure TfrmScanImage.N7Click(Sender: TObject);
begin
FChange := true;
ImgShow.Picture.Bitmap.Assign(FBitmap);
ImgShow.Update;
StretchBlt(ImgShow.Canvas.Handle,0,ImgShow.Height - 1,ImgShow.Width, - ImgShow.Height,
ImgShow.Canvas.Handle,0,0,ImgShow.Width,ImgShow.Height,SRCCOPY);
ImgShow.Refresh;
SaveBitmap;
end;
procedure TfrmScanImage.ImgShowMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
//const
// k : integer = 0;
procedure ChangeArrayOrder;
var
I, J : Integer;
TempPoint : TPoint;
TempPoints : TPointsType;
begin
for I := 0 to 2 do
begin
for J := I to 3 do
begin
if FPoints.x> FPoints[J].x then
begin
TempPoint := FPoints;
FPoints := FPoints[J];
FPoints[J] := TempPoint;
end;
end;
end;
if FPoints[0].y > FPoints[1].y then
begin
TempPoints[0] := FPoints[1];
TempPoints[3] := FPoints[0];
end
else
begin
TempPoints[0] := FPoints[0];
TempPoints[3] := FPoints[1];
end;
if FPoints[2].y > FPoints[3].y then
begin
TempPoints[1] := FPoints[3];
TempPoints[2] := FPoints[2];
end
else
begin
TempPoints[1] := FPoints[2];
TempPoints[2] := FPoints[3];
end;
for I := 0 to 3 do
begin
FPoints := TempPoints;
end;
end;
function JudgePointInBitmap : boolean;
var
I : Integer;
begin
Result := true;
for I := 0 to 3 do
begin
if (FPoints.x < 0) and (FPoints.X > FBitmap.Width - 1)
and (FPoints.Y < 0) and (FPoints.Y > FBitmap.Height - 1) then
begin
Result := false;
break;
end;
end;
end;
var
I : Integer;
begin
if tlbtnBox.Down then
begin
BoxMouseDown(X, Y);
FMouseDown := true;
Exit;
end;
if (Button = mbLeft) then
begin
if tlbtnTransfer.Down then
begin
FChange := false;
if K = 0 then
begin
ImgShow.Picture.Assign(FBitmap);
ImgShow.Update;
end;
if K < 4 then
begin
FPoints[k] := Point(X,Y);
with ImgShow.Canvas do
begin
Pen.Mode := pmNotXor;
if (K > 0) and (K < 4) then
begin
MoveTo(FPoints[k - 1].x,FPoints[K - 1].y);
LineTo(FPoints[K].x,FPoints[K].y);
end;
if K = 3 then
begin
MoveTo(FPoints[0].x,FPoints[0].y);
LineTo(FPoints[3].x,FPoints[3].y);
end;
Inc(K);
Exit;
end;
end else
begin
for I := 0 to 3 do
begin
if (abs(X - FPoints.x) < 3)and (abs(Y - FPoints.Y) < 3) then
begin
FMouseDown := true;
FSelPoint := I;
break;
end;
end;
end;
end;
end
else
begin
if K > 3 then
begin
if not JudgePointInBitmap then
ShowMessage(FindLanguageString('[9,2]'))
else
begin
ChangeArrayOrder;
Twist(FBitmap,image1.Picture.Bitmap,FPoints);
tlbtnTransfer.Down := false;
K := 0;
pnlShow.Visible := true;
pnlShow.Left := 100;
pnlShow.Top := 100;
pnlShow.ManualDock(nil,nil,alNone);
end;
end;
end;
end;
Procedure TfrmScanImage.Twist(SrBMP,DstBMP:TBitmap;Points:TPointsType);
var
i,j:Integer;
Alpha,Beta,xx,yy,k,A,B,C,u,w,v,t,k1,k2ouble;
TempPointA,TempPointB:Array[0..3] of TPoint;
TempLeft,TempTop,TempRight,TempBottom:Integer;
P1, P2 : PByteArray;
TempBmp : TBitmap;
begin
//TempLeft,TempTop,TempRight,TempBottom分别为最终矩形的左,上,右,下边界
TempLeft := Min(Min(Points[0].x, Points[1].x), Min(Points[2].x, Points[3].x));
TempTop := Min(Min(Points[0].y, Points[1].y), Min(Points[2].y, Points[3].y));
TempRight := Max(Max(Points[0].x, Points[1].x), Max(Points[2].x, Points[3].x));
TempBottom := Max(Max(Points[0].y, Points[1].y), Max(Points[2].y, Points[3].y));
//TempPointB为扭曲的四边形各顶点
TempPointB[0]:= Points[0];
TempPointB[1]:= Points[1];
TempPointB[2]:= Points[2];
TempPointB[3]:= Points[3];
//TempPointB为最终矩形各顶点
TempPointA[0]:= Point(0,0);
TempPointA[1]:= Point(TempRight - TempLeft,0);
TempPointA[2]:= Point(TempRight - TempLeft,TempBottom - TempTop);
TempPointA[3]:= Point(0,TempBottom - TempTop);
//设置传出的位图的大小
TempBmp := TBitmap.Create;
TempBMP.Width := TempRight - TempLeft;
TempBMP.Height := TempBottom - TempTop;
SrBmp.PixelFormat := pf24Bit;
TempBmp.PixelFormat := pf24Bit;
for j := 1 to TempBottom - TempTop - 1 do
begin
P1 := TempBmp.ScanLine[J];
for i :=1 to TempRight - TempLeft -1 do
begin
//逐点计算映射后点的坐标,并且赋上颜色值
A := (TempPointA[2].y * i - TempPointA[2].x * j) + (TempPointA[3].x * j - TempPointA[3].y * i)
- (TempPointA[3].x * TempPointA[2].y + TempPointA[2].x * TempPointA[3].y);
B := (TempPointA[1].y * i - TempPointA[1].x * j) + (TempPointA[2].y * i - TempPointA[2].x * j)
+ (TempPointA[0].x * j - TempPointA[0].y * i) + (TempPointA[3].x * j - TempPointA[3].y * i)
- (TempPointA[0].x * TempPointA[2].y + TempPointA[0].y * TempPointA[2].x) - (TempPointA[3].x * TempPointA[1].y + TempPointA[3].y * TempPointA[1].x);
C := TempPointA[1].y * i - TempPointA[1].x * j + TempPointA[0].x * j - TempPointA[0].y * i
-TempPointA[0].x * TempPointA[1].y + TempPointA[1].x * TempPointA[0].y;
//注意:此处k只能取K2,换成k1出错
//计算由A,B,C组成的一元二次方程的根(用求根公式)
//k1 := (-B + sqrt( (B * B - 4 * A * C))) / (2 * A) ;
k2 := (-B - sqrt( (B * B - 4 * A * C))) / (2 * A) ;
k := k2;
u := ( (i * TempPointA[1].y - TempPointA[1].x * j) + k * (i * TempPointA[2].y - j * TempPointA[2].x))
/(TempPointA[0].x * TempPointA[1].y - TempPointA[1].x * TempPointA[0].y + k * (TempPointA[0].x * TempPointA[2].y - TempPointA[2].x * TempPointA[0].y)
+ k * (TempPointA[3].x * TempPointA[1].y - TempPointA[1].x * TempPointA[3].y) + k * k * (TempPointA[3].x * TempPointA[2].y - TempPointA[2].x * TempPointA[3].y));
w :=( (j * TempPointA[0].x - TempPointA[0].y * i )+ k * (j * TempPointA[3].x - i * TempPointA[3].y))
/(TempPointA[0].x * TempPointA[1].y - TempPointA[1].x * TempPointA[0].y + k * (TempPointA[0].x * TempPointA[2].y - TempPointA[2].x * TempPointA[0].y)
+ k * (TempPointA[3].x * TempPointA[1].y - TempPointA[1].x * TempPointA[3].y) + k * k * (TempPointA[3].x * TempPointA[2].y - TempPointA[2].x * TempPointA[3].y));
v := u * k;
t := w * k;
alpha :=v + t;
Beta := w + t;
xx :=(1 - beta) * (1 - alpha) * TempPointB[0].x + (1 - beta) * alpha * TempPointB[3].x + ( 1 - alpha) * beta * TempPointB[1].x + alpha * beta * TempPointB[2].x;
yy :=(1 - beta) * (1 - alpha) * TempPointB[0].y + (1 - beta) * alpha * TempPointB[3].y + ( 1 - alpha) * beta * TempPointB[1].y + alpha * beta * TempPointB[2].y;
P2 := SrBmp.ScanLine[Round(yy)];
//Dstbmp.Canvas.pixels[i,j] := Srbmp.Canvas.Pixels[round(xx),round(yy)];
P1[3 * I] := P2[3 * Round(XX)];
P1[3 * I + 1] := P2[3 * Round(XX) + 1];
P1[3 * I + 2] := P2[3 * Round(XX) + 2];
end;
end;
DstBmp.Width := TempBmp.Width - 1;
DstBmp.Height := TempBmp.Height - 1;
//DstBmp.Canvas.CopyRect()
BitBlt(DstBmp.Canvas.Handle, 0, 0, TempBmp.Width - 1, TempBmp.Height - 1,
TempBmp.Canvas.Handle, 1, 1, SRCCOPY);
FreeAndNil(TempBmp);
end;
procedure TfrmScanImage.S1Click(Sender: TObject);
begin
SvDlgScan.InitialDir := ExtractFilePath(ParamStr(0));
if SvDlgScan.Execute then
begin
Image1.Picture.SaveToFile(SvDlgScan.FileName);
end;
end;
procedure TfrmScanImage.N8Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
begin
ImgShow.Picture.LoadFromFile(OpenPictureDialog1.FileName);
FBitmap.Assign(ImgShow.Picture.Graphic);
FBitmap.PixelFormat := pf24Bit;
FBitmap.Dormant; // Free up GDI resources
FBitmap.FreeImage; // Free up Memory.
ImgShow.Picture.Assign(FBItmap);
end;
end;
procedure TfrmScanImage.Image1DblClick(Sender: TObject);
begin
FFileName := myGetTempDirectory +'~~'+ IntToStr(Handle) + '.Bmp';
(Sender as TImage).Picture.Bitmap.SaveToFile(FFileName);
frmTiHuaMain.itemOpenExecute(nil);
Close;
end;
procedure TfrmScanImage.scrlbrSharpScroll(Sender: TObject;
ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
scrlbrLightChange(Sender);
end;
procedure TfrmScanImage.ImgShowMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
if FMouseDown then
begin
if tlbtnBox.Down then
BoxMouseMove(X, Y)
else
begin
ImgShow.Canvas.Brush.Style := bsClear;
ImgShow.Canvas.Polygon(FPoints);
FPoints[FSelPoint] := Point(X, Y);
ImgShow.Canvas.Polygon(FPoints);
end;
end;
end;
procedure TfrmScanImage.ImgShowMouseUp(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if Button = mbRight then
K := 0;
FMouseDown := false;
if tlbtnBox.Down then
BoxMouseUp(X, Y);
end;
procedure TfrmScanImage.BoxMouseDown(X, Y : Integer);
begin
FDownPoint := Point(X, Y);
FUpPoint := Point(X, Y);
end;
procedure TfrmScanImage.BoxMouseMove(X, Y : Integer);
var
TempRect : TRect;
TempPoint : TPoint;
begin
TempPoint := FUpPoint;
ImgShow.Canvas.Pen.Color := clRed;
ImgShow.Canvas.pen.Mode := pmNotXor;
TempRect.TopLeft := FDownPoint;
TempRect.BottomRight := TempPoint;
// DrawFocusRect(Image1.Canvas.Handle, TempRect);
ImgShow.Canvas.Rectangle(TempRect);
FUpPoint := Point(X, Y);
TempRect.BottomRight := FUpPoint;
ImgShow.Canvas.Rectangle(TempRect);
// TempRect.TopLeft := FPoints[0];
// TempRect.BottomRight := FPoints[2];
// DrawFocusRect(Image1.Canvas.Handle, TempRect);
end;
procedure TfrmScanImage.BoxMouseUp(X, Y : Integer);
begin
FPoints[0] := FDownPoint;
FPoints[2].X := FUpPoint.X - 1;
FPoints[2].y := FUpPoint.y - 1;
FPoints[1].x := FPoints[2].x;
FPoints[1].y := FPoints[0].y;
FPoints[3].x := FPoints[0].x;
FPoints[3].y := Fpoints[2].y;
K := 4;
tlbtnBox.Down := false;
tlbtnTransfer.Down := True;
end;
procedure TfrmScanImage.ShowLanguage;
begin
N1.Caption := FindLanguageString('[1,1]');
itemShowScan.Caption := FindLanguageString('[9,4]');
itemScan.Caption := FindLanguageString('[9,5]');
itemScan.Hint := FindLanguageString('[9,5]');
N8.Caption := FindLanguageString('[1,3]');
ToolButton2.Hint := FindLanguageString('[1,3]');
itemSave.Caption := FindLanguageString('[1,4]');
itemSave.Hint := FindLanguageString('[1,4]');
ItemExit.Caption := FindLanguageString('[1,10]');
ItemExit.Hint := FindLanguageString('[1,10]');
E1.Caption := FindLanguageString('[1,11]');
N10.Caption := FindLanguageString('[9,12]');
N7.Caption := FindLanguageString('[9,13]');
N2.Caption := FindLanguageString('[1,92]');
N6.Caption := FindLanguageString('[1,93]');
Label1.Caption := FindLanguageString('[9,16]');
Label3.Caption := FindLanguageString('[9,17]');
Label5.Caption := FindLanguageString('[9,18]');
Label7.Caption := FindLanguageString('[9,19]');
Label8.Caption := FindLanguageString('[9,20]');
Label9.Caption := FindLanguageString('[9,21]');
Label10.Caption := FindLanguageString('[9,22]');
Label2.Caption := FindLanguageString('[9,23]');
Label4.Caption := FindLanguageString('[9,24]');
Label6.Caption := FindLanguageString('[9,25]');
Label12.Caption := FindLanguageString('[9,26]');
Label11.Caption := FindLanguageString('[9,27]');
tlbtnTransfer.Hint := FindLanguageString('[9,28]');
tlbtnBox.Hint := FindLanguageString('[9,29]');
S1.Caption := FindLanguageString('[1,4]');
Self.Caption := FindLanguageString('[9,30]');
end;
end.
当然这是我的程序中的一部分，你是要改一下就可以运行，其中还有一点关于图像处理算法的东西相送，不过用我这代码中得法的人最好给我加点分
好吗？我相信大家，现在一直用VC，好久没来了，所以想要点分。
