下面是全部代码：
／／顺便说一下，撤销我在 C:/WINDOWS/Temp/ 下动态建立Accss数据库，在图像操作之前现保存现有图像，操作后若不满意，将保存的图像从数据库中提出显示就行了。
／／由于用途不同，我在粘贴功能上消除了被编辑的图片（这样容易造假），若你实现在图片上粘贴的话，修改粘贴功能代码即可。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Comobj, Dialogs, ExtCtrls, Menus, ComCtrls, ExtDlgs, Clipbrd, StdCtrls, DB,
ADODB, jpeg, frxDesgn, frxClass, frxDock, ShellAPI;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
PopupMenu1: TPopupMenu;
F1: TMenuItem;
N1: TMenuItem;
C1: TMenuItem;
N2: TMenuItem;
O1: TMenuItem;
S1: TMenuItem;
A1: TMenuItem;
N3: TMenuItem;
U1: TMenuItem;
P1: TMenuItem;
N4: TMenuItem;
X1: TMenuItem;
E1: TMenuItem;
U2: TMenuItem;
N5: TMenuItem;
T1: TMenuItem;
C2: TMenuItem;
P2: TMenuItem;
N6: TMenuItem;
A2: TMenuItem;
S2: TMenuItem;
S3: TMenuItem;
N7: TMenuItem;
Z1: TMenuItem;
I1: TMenuItem;
F2: TMenuItem;
S4: TMenuItem;
I2: TMenuItem;
B1: TMenuItem;
T2: TMenuItem;
H1: TMenuItem;
H2: TMenuItem;
N9: TMenuItem;
A3: TMenuItem;
Panel2: TPanel;
StatusBar1: TStatusBar;
ScrollBox1: TScrollBox;
OpenPictureDialog1: TOpenPictureDialog;
Image2: TImage;
N10: TMenuItem;
N11: TMenuItem;
N12: TMenuItem;
O2: TMenuItem;
A4: TMenuItem;
N13: TMenuItem;
U3: TMenuItem;
P3: TMenuItem;
A5: TMenuItem;
N14: TMenuItem;
N15: TMenuItem;
F3: TMenuItem;
S5: TMenuItem;
Button1: TButton;
Panel3: TPanel;
ProgressBar1: TProgressBar;
Button2: TButton;
Panel4: TPanel;
ProgressBar2: TProgressBar;
TrackBar1: TTrackBar;
Label1: TLabel;
Label2: TLabel;
TrackBar2: TTrackBar;
Label3: TLabel;
TrackBar3: TTrackBar;
Image1: TImage;
SaveDialog1: TSaveDialog;
ADOQuery1: TADOQuery;
DataSource1: TDataSource;
PopupMenu2: TPopupMenu;
N8: TMenuItem;
W1: TMenuItem;
N16: TMenuItem;
ADOConnection1: TADOConnection;
N17: TMenuItem;
N18: TMenuItem;
frxDockSite1: TfrxDockSite;
frxReport1: TfrxReport;
Label4: TLabel;
procedure O1Click(Sender: TObject);
procedure X1Click(Sender: TObject);
procedure F2Click(Sender: TObject);
procedure S4Click(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure T1Click(Sender: TObject);
procedure C2Click(Sender: TObject);
procedure S1Click(Sender: TObject);
procedure A1Click(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure P2Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure A2Click(Sender: TObject);
procedure B1Click(Sender: TObject);
procedure I2Click(Sender: TObject);
procedure T2Click(Sender: TObject);
procedure S3Click(Sender: TObject);
procedure Z1Click(Sender: TObject);
procedure A3Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure U2Click(Sender: TObject);
procedure P1Click(Sender: TObject);
procedure W1Click(Sender: TObject);
procedure Label4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Label4MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Label4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ScrollBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure N18Click(Sender: TObject);
procedure frxReport1BeforePrint(Sender: TfrxReportComponent);
procedure H2Click(Sender: TObject);
procedure U1Click(Sender: TObject);
procedure C1Click(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
public
{ Public declarations }
Drawing: Boolean;
StarPoint, MovePt: TPoint;
procedure DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
end;
var
Form1: TForm1;
MouseDownPoint,MouseMovePoint :TPoint;
IsMouseDown :Boolean;
Pmx,Pmy,Pdx,Pdy: Integer;
implementation
uses Unit2, Unit3, Unit4, Unit5, Unit6;
{$R *.dfm}
procedure TForm1.O1Click(Sender: TObject);
var
JPG:TJpegImage;
Extname,Fname,path:string;
CreateAccess:OleVariant;
begin
//打开文件
if OpenPictureDialog1.Execute then
begin
//检测数据库是否存在
if FileExists('C:/WINDOWS/Temp/db.mdb') then
begin
ADOQuery1.close;
ADOQuery1.SQL.clear;
ADOQuery1.SQL.Text:='delete from tb where 1=1';//清空数据库
ADOQuery1.ExecSQL;
end
else
begin
//动态建立数据库。(uses ComObj).
CreateAccess:=CreateOleObject('ADOX.Catalog');
CreateAccess.Create('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:/WINDOWS/Temp/db.mdb');
path := ExtractFilePath('C:/WINDOWS/Temp/'); //程序路径
ADOConnection1.Connected := False;
try
ADOConnection1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' +
path + 'db.mdb' + ';Persist Security Info=False';
ADOConnection1.Connected := true;
adoquery1.close;
adoquery1.sql.clear;
adoquery1.sql.add('create table tb ( ID autoincrement not null,CX OLEOBJECT not null)');
adoquery1.ExecSQL;
except
MessageBox(GetActiveWindow(), '系统错误!', '警告', MB_OK + MB_ICONWARNING);
application.Terminate;
end;// 数据库建立结束。
end;
Extname:=extractfileext(fname);
Fname:=OpenPictureDialog1.FileName;
Extname:=Uppercase(Extractfileext(fname));
if Extname='.BMP' then
Image1.Picture.LoadFromFile(fname);
if (Extname='.JPG') or (Extname='.JPEG') then
begin
jpg:=Tjpegimage.Create;
try
jpg.LoadFromfile(Fname);
Image1.Picture.Bitmap.Assign(jpg);
finally
jpg.Free;
end;
end;
Image1.Top:=0;
Image1.Left:=0;
Image1.Width:=Image1.Picture.Bitmap.Width;
Image1.Height:=Image1.Picture.Bitmap.Height;
S1.Enabled:=True;
A1.Enabled:=True;
A4.Enabled:=True;
U1.Enabled:=True;
P1.Enabled:=True;
A2.Enabled:=True;
A5.Enabled:=True;
Z1.Enabled:=True;
F2.Enabled:=True;
F3.Enabled:=True;
S4.Enabled:=True;
S5.Enabled:=True;
I2.Enabled:=True;
B1.Enabled:=True;
T2.Enabled:=True;
U2.Enabled:=False;
U3.Enabled:=False;
W1.Enabled:=True;
ADOQuery1.close;
ADOQuery1.SQL.clear;
ADOQuery1.SQL.Text:='delete from tb where 1=1';//清空数据库
ADOQuery1.ExecSQL;
end;
end;
procedure TForm1.X1Click(Sender: TObject);
begin
//退出。
if MessageBox(Application.Handle,
PChar('现在真的要退出吗?'),'退出程序',
MB_YesNo+MB_ICONINFORMATION)=IDYes then
begin
ADOConnection1.Connected := False;
U2.Enabled:=False;
U3.Enabled:=False;
DeleteFile(pchar('C:/WINDOWS/Temp/db.mdb'));
Close;
end;
end;
procedure TForm1.F2Click(Sender: TObject);
begin
//翻转与旋转
Form2.Show;
end;
procedure TForm1.S4Click(Sender: TObject);
begin
//拉伸
Form3.Show;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
yjx,yjy:Integer;
ARect: TRect;
fileStream:TMemoryStream;
begin
if Label4.Visible=True then
begin
fileStream:=TMemoryStream.Create;
Image1.Picture.Bitmap.SaveToStream(fileStream);
With ADOQuery1 do
begin
Close;
SQL.Clear;
SQL.Add('insert into tb (cx) values
FieldImage)');//cx是OLE对象字段
Parameters.ParamByName('FieldImage').LoadFromStream(fileStream,ftVarBytes);
ExecSQL;
end;
Image1.Canvas.Brush.style:=bsClear;//使文字透明
Image1.Canvas.Font.Color :=Label4.Font.Color;
Image1.Canvas.Font.Size :=Label4.Font.Size;
Image1.Canvas.Font.Name :=Label4.Font.Name;
Image1.Canvas.Font.Style:=Label4.Font.Style; //加粗
if Label4.Transparent=True then
begin
//输出文字
Image1.canvas.textout(Label4.Left-Image1.Left,Label4.Top-Image1.Top,''+Label4.Caption+'');
Label4.Visible:=False;
end
else
begin
with Image1.Canvas do
begin
CopyMode := cmWhiteness;
//剪切掉所选图形
ARect := Rect(Label4.Left-Image1.Left,Label4.Top-Image1.Top,Label4.Left-Image1.Left + Label4.Width,Label4.Top-Image1.Top + Label4.Height);
CopyRect(ARect, Image1.Canvas, ARect);
end;
Image1.canvas.textout(Label4.Left-Image1.Left,Label4.Top-Image1.Top,''+Label4.Caption+'');
Label4.Visible:=False;
end;
OKBottomDlg.Memo1.Clear;
Label4.Top:=0;
Label4.Left:=0;
U2.Enabled:=True;
end
else
begin
if Image1.Cursor=crCross then
if button=mbLeft then
begin
Image1.canvas.Pen.Mode:= pmNot;
Image1.canvas.Brush.Style:=bsClear;
Image1.canvas.Rectangle(StarPoint.X, StarPoint.Y, MovePt.X, MovePt.Y);
Drawing := True;
//鼠标开始画矩形框
Image1.Canvas.MoveTo(X, Y);
StarPoint := Point(X, Y); //记录起点坐标
MovePt := StarPoint;
StatusBar1.Panels[3].Text := Format('起点坐标: (%d, %d)', [X, Y]);
end;
if Image1.Cursor=crSizeAll then
if button=mbRight then
begin
yjx:=x+Image1.Left+2;
yjy:=y+Image1.Top+48;
PopupMenu1.Popup(yjx, yjy); // 显示的位置右键菜单
end;
end;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (StarPoint.X=MovePt.X) and (StarPoint.Y=MovePt.Y) then
begin
F2.Enabled:=True;
F3.Enabled:=True;
S4.Enabled:=True;
S5.Enabled:=True;
I2.Enabled:=True;
B1.Enabled:=True;
T2.Enabled:=True;
Z1.Enabled:=True;
A2.Enabled:=True;
A5.Enabled:=True;
end
else
begin
F2.Enabled:=False;
F3.Enabled:=False;
S4.Enabled:=False;
S5.Enabled:=False;
I2.Enabled:=False;
B1.Enabled:=False;
T2.Enabled:=False;
Z1.Enabled:=False;
if Drawing then
//画框结束
// DrawShape(StarPoint, Point(X, Y), pmCopy);//选择框不出现在图像中
Drawing := False;
T1.Enabled:=True;
N11.Enabled:=True;
C2.Enabled:=True;
N12.Enabled:=True;
N6.Enabled:=True;
end;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if image1.Picture.bitmap.empty=false then
begin
if (X > StarPoint.X ) and (X < MovePt.X) and (Y > StarPoint.Y )and (Y < MovePt.Y) then
Image1.Cursor:=crSizeAll
else
Image1.Cursor:=crCross;
end
else
Image1.Cursor:=crDefault;
if ssLeft in Shift then
begin
Image1.Canvas.Brush.Style :=bsClear;
if Drawing then
begin
//鼠标移动中
DrawShape(StarPoint, MovePt, pmNotXor);
MovePt := Point(X, Y);
DrawShape(StarPoint, MovePt, pmNotXor);
end;
StatusBar1.Panels[4].Text := Format('目前坐标: (%d, %d)', [X, Y]);
end;
end;
procedure TForm1.DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
begin
Image1.Canvas.Pen.Mode := AMode;
Image1.Canvas.Rectangle(TopLeft.X, TopLeft.Y, BottomRight.X, BottomRight.Y);
end;
procedure TForm1.T1Click(Sender: TObject);
var
ARect: TRect;
fileStream:TMemoryStream;
ax,ay,bx,by:Integer;
Width,Height : Integer;
NewBitmap : TBitmap;
begin
//剪切
U2.Enabled:=True;
U3.Enabled:=True;
P2.Enabled:=True;
P3.Enabled:=True;
ax:=StarPoint.X;
ay:=StarPoint.Y;
bx:=MovePt.X;
by:=MovePt.Y;
Width := abs(bx-ax);
Height := abs(by-ay);
NewBitmap:=Tbitmap.create;
NewBitmap.Width := Width; //设置NewBitmap的长宽
NewBitmap.Height := Height;
Image1.Canvas.Pen.Mode:= pmNot;
Image1.Canvas.Brush.Style:=bsClear;
Image1.Canvas.Rectangle(StarPoint.X, StarPoint.Y, MovePt.X, MovePt.Y);
StarPoint:=Point(0, 0);
MovePt:=Point(0, 0);
//存储图片
fileStream:=TMemoryStream.Create;
Image1.Picture.Bitmap.SaveToStream(fileStream);
With ADOQuery1 do
begin
Close;
SQL.Clear;
SQL.Add('insert into tb (cx) values
FieldImage)');//cx是OLE对象字段
Parameters.ParamByName('FieldImage').LoadFromStream(fileStream,ftVarBytes);
ExecSQL;
end;
NewBitmap.Canvas.CopyRect
(Rect(0,0,Width,Height),Image1.Canvas,
Rect(ax,ay,bx,by));//拷贝Image1中的矩形区域
//剪切掉所选图形
with Image1.Canvas do
begin
CopyMode := cmWhiteness;
ARect := Rect(ax,ay,bx,by);
CopyRect(ARect, Image1.Canvas, ARect);
end;
Image2.Canvas.Rectangle(bx,by,ax,ay);
Image2.Width := Width;
Image2.Height := Height;
Image2.Picture.Bitmap := NewBitmap;//放到的Image2上
//把图片从剪贴板粘贴到Image2
//Image2.Picture.LoadFromClipBoardFormat(cf_BitMap,ClipBoard.GetAsHandle(cf_Bitmap),0);
NewBitmap.Free; //释放Bitmap
Clipboard.Assign(Image2.Picture);//把Image2中的图象复制到剪贴板
T1.Enabled:=False;
N11.Enabled:=False;
N6.Enabled:=False;
A2.Enabled:=False;
A5.Enabled:=False;
C2.Enabled:=False;
N12.Enabled:=False;
end;
procedure TForm1.C2Click(Sender: TObject);
var
fileStream:TMemoryStream;
ax,ay,bx,by:Integer;
Width,Height : Integer;
NewBitmap : TBitmap;
begin
//复制
U2.Enabled:=True;
U3.Enabled:=True;
P2.Enabled:=True;
P3.Enabled:=True;
ax:=StarPoint.X;
ay:=StarPoint.Y;
bx:=MovePt.X;
by:=MovePt.Y;
Width := abs(bx-ax);
Height := abs(by-ay);
NewBitmap:=Tbitmap.create;
NewBitmap.Width := Width; //设置NewBitmap的长宽
NewBitmap.Height := Height;
Image1.Canvas.Pen.Mode:= pmNot;
Image1.Canvas.Brush.Style:=bsClear;
Image1.Canvas.Rectangle(StarPoint.X, StarPoint.Y, MovePt.X, MovePt.Y);
StarPoint:=Point(0, 0);
MovePt:=Point(0, 0);
//存储图片
fileStream:=TMemoryStream.Create;
Image1.Picture.Bitmap.SaveToStream(fileStream);
With ADOQuery1 do
begin
Close;
SQL.Clear;
SQL.Add('insert into tb (cx) values
FieldImage)');//cx是OLE对象字段
Parameters.ParamByName('FieldImage').LoadFromStream(fileStream,ftVarBytes);
ExecSQL;
end;
NewBitmap.Canvas.CopyRect
(Rect(0,0,Width,Height),Image1.Canvas,
Rect(ax,ay,bx,by));//拷贝Image1中的矩形区域
Image2.Canvas.Rectangle(bx,by,ax,ay);
Image2.Width := Width;
Image2.Height := Height;
Image2.Picture.Bitmap := NewBitmap;//放到的Image2上
//把图片从剪贴板粘贴到Image2
//Image2.Picture.LoadFromClipBoardFormat(cf_BitMap,ClipBoard.GetAsHandle(cf_Bitmap),0);
NewBitmap.Free; //释放Bitmap
Clipboard.Assign(Image2.Picture);//把Image2中的图象复制到剪贴板
T1.Enabled:=False;
N11.Enabled:=False;
N6.Enabled:=False;
A2.Enabled:=False;
A5.Enabled:=False;
C2.Enabled:=False;
N12.Enabled:=False;
Clipboard.Assign(Image2.Picture);//把Image2中的图象复制到剪贴板
end;
procedure TForm1.S1Click(Sender: TObject);
var
LSave : Boolean;
Bmp : Tbitmap;
jpg :TJpegImage;
begin
jpg:=TJpegImage.Create;
Bmp:=Tbitmap.Create; //建立临时位图
if OpenPictureDialog1.FileName<>'' then
begin
Bmp:=Tbitmap.Create; //建立临时位图
try
With Bmp do
Begin
Width:=Image1.Width;
Height:=Image1.Height;
End;
Bmp.canvas.StretchDraw(Bmp.canvas.Cliprect,Image1.Picture.Bitmap); //缩放适应
jpg.Assign(bmp);
Jpg.SaveToFile(SaveDialog1.FileName+'.jpg'); //保存
if Savedialog1.FilterIndex=1 then
begin
jpg.Assign(Image1.Picture.Bitmap); //采用相同色彩深度
SaveDialog1.FileName:=ChangeFileExt(SaveDialog1.FileName,'.Jpg');
Jpg.SaveToFile(SaveDialog1.FileName); //保存
end
else
Image1.Picture.Bitmap.SaveToFile(Savedialog1.filename+'.bmp');
ADOQuery1.close;
ADOQuery1.SQL.clear;
ADOQuery1.SQL.Text:='delete from tb where 1=1';//清空数据库
ADOQuery1.ExecSQL;
U2.Enabled:=False;
U3.Enabled:=False;
finally
Bmp.Free;
end;
end
else
begin
if SaveDialog1.Execute then
begin
LSave := True;
if FileExists(SaveDialog1.FileName) and
(MessageDlg(Format('文件 "%s" 已经存在。是否覆盖？',
[SaveDialog1.FileName]), mtConfirmation, [mbYes, mbNo] ,0) <> mrYes) then
LSave := False;
if LSave then
try
Bmp.Assign(Image1.Picture.Bitmap); //采用相同色彩深度
With Bmp do
Begin
Width:=Image1.Width;
Height:=Image1.Height;
End;
Bmp.canvas.StretchDraw(Bmp.canvas.Cliprect,Image1.Picture.Bitmap); //缩放适应
jpg.Assign(bmp);
Jpg.SaveToFile(SaveDialog1.FileName+'.jpg'); //保存
ADOQuery1.close;
ADOQuery1.SQL.clear;
ADOQuery1.SQL.Text:='delete from tb where 1=1';//清空数据库
ADOQuery1.ExecSQL;
U2.Enabled:=False;
U3.Enabled:=False;
finally
Bmp.Free;
end;
end;
end;
end;
procedure TForm1.A1Click(Sender: TObject);
var
LSave : Boolean;
jpg :TJpegImage;
begin
jpg:=TJpegImage.Create;
if SaveDialog1.Execute then
begin
LSave := True;
if (FileExists(SaveDialog1.FileName+'.Jpg') or FileExists(SaveDialog1.FileName+'.Bmp')) and
(MessageDlg(Format('文件 "%s" 已经存在。是否覆盖？',
[SaveDialog1.FileName]), mtConfirmation, [mbYes, mbNo] ,0) <> mrYes) then
LSave := False;
if LSave then
try
if Savedialog1.FilterIndex=1 then
begin
jpg.Assign(Image1.Picture.Bitmap); //采用相同色彩深度
SaveDialog1.FileName:=ChangeFileExt(SaveDialog1.FileName,'.Jpg');
Jpg.SaveToFile(SaveDialog1.FileName); //保存
end
else
Image1.Picture.Bitmap.SaveToFile(Savedialog1.filename+'.bmp');
ADOQuery1.close;
ADOQuery1.SQL.clear;
ADOQuery1.SQL.Text:='delete from tb where 1=1';//清空数据库
ADOQuery1.ExecSQL;
U2.Enabled:=False;
U3.Enabled:=False;
finally
jpg.Free;
end;
end;
end;
procedure TForm1.N10Click(Sender: TObject);
begin
Image1.Picture:=nil;
end;
procedure TForm1.P2Click(Sender: TObject);
var
fileStream:TMemoryStream;
begin
//粘帖
A2.Enabled:=True;
A5.Enabled:=True;
F2.Enabled:=True;
F3.Enabled:=True;
S4.Enabled:=True;
S5.Enabled:=True;
I2.Enabled:=True;
B1.Enabled:=True;
T2.Enabled:=True;
Z1.Enabled:=True;
C2.Enabled:=False;
N12.Enabled:=False;
N6.Enabled:=False;
U2.Enabled:=True;
U3.Enabled:=True;
//存储图片
fileStream:=TMemoryStream.Create;
Image1.Picture.Bitmap.SaveToStream(fileStream);
With ADOQuery1 do
begin
Close;
SQL.Clear;
SQL.Add('insert into tb (cx) values
FieldImage)');//cx是OLE对象字段
Parameters.ParamByName('FieldImage').LoadFromStream(fileStream,ftVarBytes);
ExecSQL;
end;
if T1.Enabled=True then
begin
N11.Enabled:=False;
T1.Enabled:=False;
end;
Image1.Picture.Assign(Clipboard);
end;
procedure TForm1.N6Click(Sender: TObject);
var
ARect: TRect;
fileStream:TMemoryStream;
begin
//清除所选内容
U2.Enabled:=True;
U3.Enabled:=True;
//存储图片
fileStream:=TMemoryStream.Create;
Image1.Picture.Bitmap.SaveToStream(fileStream);
With ADOQuery1 do
begin
Close;
SQL.Clear;
SQL.Add('insert into tb (cx) values
FieldImage)');//cx是OLE对象字段
Parameters.ParamByName('FieldImage').LoadFromStream(fileStream,ftVarBytes);
ExecSQL;
end;
with Image1.Canvas do
begin
CopyMode := cmWhiteness;
ARect := Rect( StarPoint.X, StarPoint.Y, MovePt.X, MovePt.Y );
CopyRect(ARect, Image1.Canvas, ARect);
CopyMode := cmSrcCopy;
end;
end;
procedure TForm1.A2Click(Sender: TObject);
begin
//全选
T1.Enabled:=True;
N11.Enabled:=True;
C2.Enabled:=True;
N12.Enabled:=True;
N6.Enabled:=True;
Drawing := True;
//若有选择框消除
Image1.canvas.Pen.Mode:= pmNot;
Image1.canvas.Brush.Style:=bsClear;
Image1.canvas.Rectangle(StarPoint.X, StarPoint.Y, MovePt.X, MovePt.Y);
Drawing := True;
StarPoint := Point(0, 0); //记录起点坐标
MovePt := StarPoint;
StatusBar1.Panels[3].Text := Format('起点坐标: (%d, %d)', [0, 0]);
MovePt := Point(Image1.Width,Image1.Height);
DrawShape(StarPoint, MovePt, pmNotXor);
//画框结束
//DrawShape(StarPoint, Point(), pmCopy);
Drawing := False;
end;
procedure TForm1.B1Click(Sender: TObject);
var
p: pbyteArray;
x, y: Integer;
Bmp: TBitmap;
Gray: integer;
fileStream:TMemoryStream;
begin
//彩转黑白
U2.Enabled:=True;
U3.Enabled:=True;
//存储图片
fileStream:=TMemoryStream.Create;
Image1.Picture.Bitmap.SaveToStream(fileStream);
With ADOQuery1 do
begin
Close;
SQL.Clear;
SQL.Add('insert into tb (cx) values
FieldImage)');//cx是OLE对象字段
Parameters.ParamByName('FieldImage').LoadFromStream(fileStream,ftVarBytes);
ExecSQL;
end;
Bmp:=TBitmap.Create;
Bmp.Assign(Image1.Picture.Bitmap);
Bmp.PixelFormat:=pf24bit;
//转为真彩色处理
for y := 0 to Bmp.Height - 1 do
begin
//获取每一行象素信息
p:= Bmp.scanline[y];
for x := 0 to Bmp.Width - 1 do
begin
//这里采用方法三即 Y＝0.299R+0587G+0.114B
Gray:=Round(p[3 * x + 2] * 0.3 + p[3 * x + 1] * 0.59
+ p[3 * x] * 0.11);
//由于是24位真彩色，故一个象素点为三个字节
p[3 * x + 2]:=byte(Gray);
p[3 * x + 1]:=byte(Gray);
p[3 * x]:=byte(Gray);
//Gray的值必须在0～255之间
end;
end;
Image1.Picture.Create;
Image1.Picture.Bitmap:=Bmp;
Bmp.Free;
end;
procedure TForm1.I2Click(Sender: TObject);
var
p: PByteArray;
x, y: Integer;
Bmp: TBitmap;
fileStream:TMemoryStream;
begin
//反色
U2.Enabled:=True;
U3.Enabled:=True;
//存储图片
fileStream:=TMemoryStream.Create;
Image1.Picture.Bitmap.SaveToStream(fileStream);
With ADOQuery1 do
begin
Close;
SQL.Clear;
SQL.Add('insert into tb (cx) values
FieldImage)');//cx是OLE对象字段
Parameters.ParamByName('FieldImage').LoadFromStream(fileStream,ftVarBytes);
ExecSQL;
end;
Bmp:=TBitmap.Create;
Bmp.Assign(Image1.Picture.Bitmap);
Bmp.PixelFormat:=pf24Bit;
for y := 0 to Bmp.Height - 1 do
begin
p:= Bmp.scanline[y];
for x := 0 to Bmp.Width - 1 do
begin
p[x * 3]:=not p[x * 3];
p[x * 3 + 1]:=not p[x * 3 + 1];
p[x * 3 + 2]:=not p[x * 3 + 2];
end;
end;
Image1.Picture.Bitmap.Assign(Bmp);
Bmp.Free;
end;
procedure TForm1.T2Click(Sender: TObject);
var
p: PByteArray;
Gray, x, y: Integer;
Bmp: TBitmap;
fileStream:TMemoryStream;
begin
//二值化
U2.Enabled:=True;
U3.Enabled:=True;
//存储图片
fileStream:=TMemoryStream.Create;
Image1.Picture.Bitmap.SaveToStream(fileStream);
With ADOQuery1 do
begin
Close;
SQL.Clear;
SQL.Add('insert into tb (cx) values
FieldImage)');//cx是OLE对象字段
Parameters.ParamByName('FieldImage').LoadFromStream(fileStream,ftVarBytes);
ExecSQL;
end;
Bmp := TBitmap.Create;
Bmp.Assign(Image1.Picture.Bitmap);
//设置为24位真彩色
Bmp.PixelFormat := pf24Bit;
randomize;
for y := 0 to Bmp.Height - 1 do
begin
p := Bmp.scanline[y];
for x := 0 to Bmp.Width - 1 do
begin
//一个象素点三个字节
Gray := Round(p[x * 3 + 2] * 0.3 + p[x * 3 + 1] * 0.59 + p[x
* 3] * 0.11);
if gray > 128 then //全局阀值128
begin
p[x * 3] := 255;
p[x * 3 + 1] := 255;
p[x * 3 + 2] := 255;
end
else
begin
p[x * 3] := 0;
p[x * 3 + 1] := 0;
p[x * 3 + 2] := 0;
end;
end;
end;
Image1.Picture.Bitmap:=Bmp;
Bmp.Free;
end;
procedure TForm1.S3Click(Sender: TObject);
begin
if S3.Checked=True then
begin
S3.Checked:=False;
StatusBar1.Visible:=False;
end
else
begin
S3.Checked:=True;
StatusBar1.Visible:=True;
end;
end;
procedure TForm1.Z1Click(Sender: TObject);
begin
U2.Enabled:=True;
U3.Enabled:=True;
Form4.Show;
end;
procedure TForm1.A3Click(Sender: TObject);
begin
AboutBox.Show;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
//清空数据库
ADOQuery1.close;
ADOQuery1.SQL.clear;
ADOQuery1.SQL.Text:='delete from tb where 1=1';//清空数据库
ADOQuery1.ExecSQL;
S1.Enabled:=False;
A1.Enabled:=False;
A4.Enabled:=False;
U1.Enabled:=False;
P1.Enabled:=False;
A2.Enabled:=False;
A5.Enabled:=False;
Z1.Enabled:=False;
F2.Enabled:=False;
F3.Enabled:=False;
S4.Enabled:=False;
S5.Enabled:=False;
I2.Enabled:=False;
B1.Enabled:=False;
T2.Enabled:=False;
end;
procedure TForm1.U2Click(Sender: TObject);
begin
//撤销
//若有选择框消除
Image1.canvas.Pen.Mode:= pmNot;
Image1.canvas.Brush.Style:=bsClear;
Image1.canvas.Rectangle(StarPoint.X, StarPoint.Y, MovePt.X, MovePt.Y);
StarPoint:=Point(0, 0);
MovePt:=Point(0, 0);
With ADOQuery1 do
begin
Close;
SQL.Clear;
SQL.Add('select * from tb');
Open;
end;
if ADOQuery1.RecordCount>1 then
begin
ADOQuery1.Findlast; //将光标移至最后一条记录
Image1.Picture.Assign(ADOQuery1.FieldByName('cx')); //将记录在Image1内显示
ADOQuery1.Edit; //ADOQuery处于编辑状态
ADOQuery1.delete; //删除最后一条记录
end
else
begin
ADOQuery1.Findlast;
Image1.Picture.Assign(ADOQuery1.FieldByName('cx'));
U2.Enabled:=False;
U3.Enabled:=False;
ADOQuery1.Edit;
ADOQuery1.delete;
end;
end;
procedure TForm1.P1Click(Sender: TObject);
begin
//frxReport1.PrintPreparedReportDlg;
//frxReport1.PrintPreparedReport('',1,True,frAll);
frxReport1.ShowReport;
end;
procedure TForm1.W1Click(Sender: TObject);
begin
OKBottomDlg.Show;
end;
procedure TForm1.Label4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Lx,Ly:Integer;
begin
if button=mbLeft then
begin
IsMouseDown :=True;
MouseDownPoint :=Point(x,y);
Pdx:=0;
Pdy:=0;
end
else
begin
Lx:=x+Label4.Left+2;
Ly:=y+Label4.Top+48;
PopupMenu2.Popup(Lx, Ly); // 显示的位置右键菜单
end;
end;
procedure TForm1.Label4MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if IsMouseDown = True then
begin
MouseMovePoint :=Point(x,y);
Pmx:=MouseDownPoint.x-MouseMovePoint.x;
Pmy:=MouseDownPoint.y-MouseMovePoint.y;
Label4.left := Label4.left +Pdx-Pmx;
Label4.top := Label4.top +Pdy-Pmy;
end;
end;
procedure TForm1.Label4MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
IsMouseDown :=False;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
//退出。
ADOConnection1.Connected := False;
U2.Enabled:=False;
U3.Enabled:=False;
DeleteFile(pchar('C:/WINDOWS/Temp/db.mdb'));
end;
procedure TForm1.ScrollBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Image1.canvas.Pen.Mode:= pmNot;
Image1.canvas.Brush.Style:=bsClear;
Image1.canvas.Rectangle(StarPoint.X, StarPoint.Y, MovePt.X, MovePt.Y);
StarPoint.X:=0;
StarPoint.Y:=0;
MovePt.X:=0;
MovePt.Y:=0;
end;
procedure TForm1.N18Click(Sender: TObject);
begin
OKBottomDlg.Memo1.Lines.Clear;
Label4.Caption:='';
Label4.Visible:=False;
end;
procedure TForm1.frxReport1BeforePrint(Sender: TfrxReportComponent);
var
Bmp : Tbitmap;
k:Real;
begin
//打印
if sender.Name='Picture1' then
begin
if Image1.Picture.Bitmap.Width>695 then
begin
Bmp:=Tbitmap.Create;
//缩小倍率*图像高
k:=(Image1.Picture.Bitmap.Height)*695 div (Image1.Picture.Bitmap.Width);
try
Bmp.Assign(Form1.Image1.Picture.Bitmap);
With Bmp do
Begin
//适合纸张大小
Width:=695;
Height:=Trunc(k); //Trunc取整
End;
Bmp.canvas.StretchDraw(Bmp.canvas.Cliprect,Form1.Image1.Picture.Bitmap);
Image1.Picture.Bitmap := Bmp;
finally
Bmp.Free;
end;
end;
TfrxPictureView(sender).Center:=True;
TfrxPictureView(sender).picture.Assign(Image1.picture);
end;
end;
procedure TForm1.H2Click(Sender: TObject);
begin
//帮助主题
ShellExecute(Handle, nil, PChar('D:/Help/Help.chm'), nil, nil, SW_SHOWNORMAL);
//ShellExecute(Handle, 'open', 'Help.chm',nil,nil, SW_SHOW);
end;
procedure TForm1.U1Click(Sender: TObject);
begin
frxReport1.ShowReport;
end;
procedure TForm1.C1Click(Sender: TObject);
var
CreateAccess:OleVariant;
path:string;
begin
//选定图像
if FileExists('C:/WINDOWS/Temp/db.mdb') then
begin
ADOQuery1.close;
ADOQuery1.SQL.clear;
ADOQuery1.SQL.Text:='delete from tb where 1=1';//清空数据库
ADOQuery1.ExecSQL;
end
else
begin
//若数据库不存在则动态建立数据库。
CreateAccess:=CreateOleObject('ADOX.Catalog');
CreateAccess.Create('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:/WINDOWS/Temp/db.mdb');
path := ExtractFilePath('C:/WINDOWS/Temp/'); //程序路径
ADOConnection1.Connected := False;
try
ADOConnection1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' +
path + 'db.mdb' + ';Persist Security Info=False';
ADOConnection1.Connected := true;
adoquery1.close;
adoquery1.sql.clear;
adoquery1.sql.add('create table tb ( ID autoincrement not null,CX OLEOBJECT not null)');
adoquery1.ExecSQL;
except
MessageBox(GetActiveWindow(), '系统错误!', '警告', MB_OK + MB_ICONWARNING);
application.Terminate;
end;
end;
S1.Enabled:=True;
A1.Enabled:=True;
A4.Enabled:=True;
U1.Enabled:=True;
P1.Enabled:=True;
A2.Enabled:=True;
A5.Enabled:=True;
Z1.Enabled:=True;
F2.Enabled:=True;
F3.Enabled:=True;
S4.Enabled:=True;
S5.Enabled:=True;
I2.Enabled:=True;
B1.Enabled:=True;
T2.Enabled:=True;
end;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (key = Vk_F1) then
ShellExecute(handle, 'open', pchar('help.chm'), nil, nil,
SW_SHOWMAXIMIZED)
end;
end.
