RSS订阅 | 匿名投稿
您的位置:网站首页 > 图像 > 正文

DELPHI写的截图小工具源码(部分)

作者:admin 来源: 日期:2018/3/3 11:34:38 人气: 标签:

unit ImageJT;

 

 

interface

 

 

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, Menus, ExtCtrls, StdCtrls, DB, ADODB,ShellAPI,Clipbrd, pngimage;

 

 

type

  TForm1 = class(TForm)

    Image1: TImage;

    PaintBox1: TPaintBox;

    MainMenu1: TMainMenu;

    N1: TMenuItem;

    ScrollBox1: TScrollBox;

    OpenDialog1: TOpenDialog;

    Button1: TButton;

    SaveDialog1: TSaveDialog;

    Edit1: TEdit;

    Edit2: TEdit;

    ADOC1: TADOConnection;

    Q1: TADOQuery;

    N2: TMenuItem;

    N3: TMenuItem;

    N4: TMenuItem;

    N5: TMenuItem;

    Image2: TImage;

    procedure N1Click(Sender: TObject);

    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;

      Shift: TShiftState; X, Y: Integer);

    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,

      Y: Integer);

    procedure PaintBox1Paint(Sender: TObject);

    procedure Button1Click(Sender: TObject);

    procedure SaveTxt(logname,logpath,Ftxt :string);

    procedure N2Click(Sender: TObject);

    procedure FormResize(Sender: TObject);

    procedure FormCreate(Sender: TObject);

    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

    procedure N3Click(Sender: TObject);

    procedure N4Click(Sender: TObject);

    procedure N5Click(Sender: TObject);

  private

      //截屏的坐标,路径

  procedure SnapScreen(a, b, c, d: Integer; Apath: string);

    { Private declarations }

  public

    { Public declarations }

  end;

 

 

var

  Form1: TForm1;

  Re,Arect:TRect;

  point:TPoint;

  BeginX,BeginY,Endx,EndY:integer;

  jtks:Boolean=False;   //截图开始

  cztx:Boolean=False;  //重置图像

  ifsd:Boolean=False;  //锁定起点

implementation

 uses GIFImg,jpeg,ckImage,Unit2,AddBl;

{$R *.dfm}

//保存记录到文本

procedure TForm1.SaveTxt(logname,logpath,Ftxt :string);

var

  f:TextFile;

  hile: Thandle;

begin

  //判断是否有文本

   if not FileExists(logpath+'\log.txt') then

   begin

      //创建文本

      hile :=FileCreate(logpath+'\log.txt');

      CloseHandle(hile);

   end;

     //Ftxt:=inputbox('输入','请输入名字','');

     assignfile(f,logpath+'\log.txt');

     Append(f);

     Writeln(f,datetimetostr(now)+'插入描述:'+Ftxt+'截图:'+logname+'.jpg'+'原图:'+logname+'yt.jpg');

     closeFile(f);

end;

 //任意区域截图,参数为截图坐标

procedure TForm1.SnapScreen(a, b, c, d: Integer; Apath: string);

var

    bmpscreen,b1:Tbitmap;

   // jgpscreen:TJPEGImage;  \

 

 

    FullscreenCanvas:TCanvas;

    dc:HDC;

    sourceRect, destRect: TRect;

begin

    //dc:=getdc(0);  获取屏幕的句柄

    fullscreencanvas:=Tcanvas.Create;

    //获取图片的句柄

    fullscreencanvas.Handle:=Image1.Canvas.Handle;

    bmpscreen:=Tbitmap.create;

    b1:=Tbitmap.Create;

    bmpscreen.Width:=abs(c-a);

    bmpscreen.Height:=abs(d-b);

    sourcerect:=Rect(0,0,c-a,d-b);//创建一个与截图同样大小的图

    destrect:= Rect(a,b,c,d);//实际截图的位置

    bmpscreen.Canvas.CopyRect(sourcerect,fullscreenCanvas,destrect);

    //bmp转换为jpg --b1改为JPG 后就可以直接用,现在改为BMP格式的还是使用的转换代码

    b1.Assign(bmpscreen);

    //图片保存到本地

    b1.SaveToFile(Apath);

    FullscreenCanvas.Free;

    bmpscreen.Free;

    b1.Free;

    //ReleaseDC(0, DC);

end;

 

 

procedure TForm1.Button1Click(Sender: TObject);

var

   filename,logname:string;

   filejpg,reImage: TImage;

   Stream:TMemoryStream;

   blms,blmc:string;

begin

    if jtks then

    begin

     logname:=formatdatetime('yymmddhhmmss',now);

     filename:=ExtractFilePath(Application.ExeName)+'image\'+formatdatetime('yyyymmdd',now)+'\';

     if not DirectoryExists(filename) then

     begin

       ForceDirectories(filename);

     //  CreateDir(filename);

     end;

     SnapScreen(Arect.Left,Arect.Top,Arect.Right,Arect.Bottom,FileName+logname+'.bmp' );

    { SaveDialog1.FileName:=FileName+logname+'.jpg' ;

    //图片保存到本地

    if not SaveDialog1.Execute then

     begin

        DeleteFile(ExtractFilePath(Application.ExeName)+'\Cut.jpg');

        Exit;

     end;     }

{      if FileExists(FileName+logname+'.jpg') then

      begin

      CopyFile(PChar(FileName+logname+'.jpg'),PChar(SaveDialog1.FileName),False);

      end ;            }

      //取本地图片加载后存储到数据库

      filejpg:=TImage.Create(self);

      if  FileExists(FileName+logname+'.bmp') then

      begin

      filejpg.Picture.LoadFromFile(FileName+logname+'.bmp');

      end else

      begin

         MessageBox(Handle,'错误信息','图片截取失败请判断图片是否截取!',MB_ICONEXCLAMATION);

         //DeleteFile(ExtractFilePath(Application.ExeName)+'\Cut.jpg');

         exit;

      end;

 

 

      Form2:=TForm2.Create(nil);

      if Form2.ShowModal=mrCancel then

      begin

         form2.Free;

         //DeleteFile(ExtractFilePath(Application.ExeName)+'\Cut.jpg');

         //ShowMessage('123');

         Exit;

      end;

      blms:=Form2.memo1.Text;

      blmc:=Form2.Edit2.Text;

      q1.Close;

      q1.SQL.Clear;

      q1.SQL.Text:='select * from t2_image where 1=0';

      q1.open;

      q1.Append;

      q1.FieldByName('sj').Value:=FormatDateTime('yyyy-mm-dd hh:nn:ss',now);

      Q1.FieldByName('image').Assign(filejpg.Picture.Graphic);

      Q1.FieldByName('blms').value:=blms;

      Q1.FieldByName('blmc').value:=blmc;

      Q1.FieldByName('x1').value:=Arect.Left;

      Q1.FieldByName('y1').value:=Arect.Top;

      Q1.FieldByName('x2').value:=Arect.Right;

      Q1.FieldByName('y2').value:=Arect.top;

      Q1.FieldByName('x3').value:=Arect.Left;

      Q1.FieldByName('y3').value:=Arect.Bottom;

      Q1.FieldByName('x4').value:=Arect.Right;

      Q1.FieldByName('y4').value:=Arect.Bottom;

      Q1.FieldByName('YTNamePath').value:=FileName+logname+'yt.bmp';

      Q1.FieldByName('YTfilepath').value:=FileName+logname+'ytzb.bmp';

      Q1.FieldByName('filepath').value:=FileName+logname+'.bmp';

      q1.Post;

      if  Q1.RecordCount>0 then

      begin

        SaveTxt(logname,FileName,blms);

        //button1.Visible:=False;

        Image2.Visible:=False;

        MessageBox(Handle,'保存成功!','提示',0);

      end else

      begin

        MessageBox(Handle,'保存失败!','提示',0);

      end;

     // CopyFile(PChar(ExtractFilePath(Application.ExeName)+'\Cut.jpg'),PChar(SaveDialog1.FileName),False);

     // DeleteFile(ExtractFilePath(Application.ExeName)+'\Cut.jpg');

           //保存带矩形的原图

      reImage:=TImage.Create(nil);

      reImage.Picture.Bitmap.Assign(Image1.Picture.Graphic);

      reImage.Canvas.Brush.Style:=bsClear;

      reImage.Canvas.Pen.Color:=clRed;

      reImage.Canvas.Rectangle(Arect);

      reImage.Canvas.Font.Size:=12;

      reImage.Canvas.TextOut(0,0,'截图矩形坐标值:('+inttostr(Arect.Left)+','+inttostr(Arect.Top)+')'

      +'('+inttostr(Arect.Right)+','+inttostr(Arect.top)+')'

      +'('+inttostr(Arect.Left)+','+inttostr(Arect.Bottom)+')'

      +'('+inttostr(Arect.Right)+','+inttostr(Arect.Bottom)+')');

      reImage.Picture.SaveToFile(FileName+logname+'ytzb.bmp'); //保存原图

      Image1.Picture.SaveToFile(FileName+logname+'yt.bmp');

 

 

      jtks:=False;

      cztx:=True;

      ifsd:=False;

      Form2.Free;

      filejpg.Free;

    end else

    begin

      MessageBox(Handle,'请先选择图片','错误',MB_ICONEXCLAMATION) ;

    end;

end;

 

 

procedure TForm1.FormCreate(Sender: TObject);

var

   dataSource:string;

begin

 DoubleBuffered:=True;

   dataSource:=ExtractFilePath(Application.ExeName)+'\tpdb.mdb';

   try

     ADOC1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='''+dataSource+''';Persist Security Info=False' ;

     ADOC1.Connected:=True;

   except

      ShowMessage('数据库连接失败!');

   end;

end;

 

 

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;

  Shift: TShiftState);

begin

   if Key=13 then

     Button1.Click;

   if Key=27 then

   begin

      ifsd:=False;

   end;

 

 

end;

 

 

procedure TForm1.FormResize(Sender: TObject);

begin

     ScrollBox1.Width:=form1.ClientWidth;

     ScrollBox1.Height:=form1.ClientHeight;

end;

 

 

procedure TForm1.N1Click(Sender: TObject);

var

  filename,ext:string;

  png:TPngImage;

  jpg:TJpegImage;

begin

      OpenDialog1.Filter:='图片文件|*.jpg;*.bmp;*.png;*.jpeg' ;

      if OpenDialog1.Execute then

      begin

          //获取文件路径

          filename:=OpenDialog1.FileName;

          ext:=ExtractFileExt(filename);

          //InputBox('','',filename);

          //判断后缀是什么

          if ext='.bmp' then

          begin

            Image1.Picture.LoadFromFile(filename);

          end else

          if ext='.png' then

          begin

            png:=TPngImage.Create;

            png.LoadFromFile(filename);

            Image1.Picture.Bitmap.Assign(png);

            png.Free

          end else

          if (ext='.jpg') or (ext='jpeg') then

          begin

            jpg:=TJPEGImage.Create;

            jpg.LoadFromFile(filename);

            Image1.Picture.Bitmap.Assign(jpg);

            jpg.Free;

          end;

          PaintBox1.Width:=Image1.Width;

          PaintBox1.Height:=Image1.Height;

      end;

end;

 

 

procedure TForm1.N2Click(Sender: TObject);

begin

  ckima:=Tckima.Create(self);

  ckima.ShowModal;

  ckima.Free;

end;

 

 

procedure TForm1.N3Click(Sender: TObject);

begin

    ShellAbout( Self.Handle,PChar('截图工具'),

       PChar('Delphi截图V1.0  QQ:283365011'+#13+'帮助:ENTER为保存,查看图片点击右键删除'),

       HICON(nil)

       ) ;

end;

 

 

procedure TForm1.N4Click(Sender: TObject);

begin

  AddBlzd:=TAddBlzd.Create(nil);

  AddBlzd.ShowModal;

  AddBlzd.Free;

end;

 

 

procedure TForm1.N5Click(Sender: TObject);

var

   bit: TBitmap;

begin

   if not Clipboard.HasFormat(CF_BITMAP) then Exit;

   bit := TBitmap.Create;

   bit.Assign(Clipboard);

   Image1.Picture.Bitmap.Assign(bit);

   PaintBox1.Width:=Image1.Width;

   PaintBox1.Height:=Image1.Height;

end;

 

 

procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;

  Shift: TShiftState; X, Y: Integer);

begin

   if (ssShift in Shift) and (ifsd=False) then

   begin

      ifsd:=True;

      //re:=Rect(X,Y,X,Y);

      Arect:=Rect(X,Y,X,Y);

      jtks:=True;

      BeginX:=X;

      BeginY:=Y;

      cztx:=False;

      //Button1.Visible:=True;

      Image2.Visible:=True;

   end;

end;

 

 

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

begin

   if  (ssLeft in Shift) and (jtks=true) then

   begin

     if x>image1.Width then

     begin

        endx:=image1.Width

     end else

     if x<0 then

     begin

       endx:=1;

     end else

     begin

        endx:=x;

     end;

     if y>image1.Height then

     begin

        endy:=image1.Height;

     end else

     if y<0 then

     begin

       endy:=1

     end else

     begin

        endy:=y;

     end;

     //Re.Right:=endx;

     //Re.Bottom:=endy;

     //Arect.Left:=BeginX;   //取消锁定起点

     //Arect.Top:=BeginY;    //取消锁定起点

     Arect.Right:=endx;

     Arect.Bottom:=endy;

    //Edit1.Text:=IntToStr(PaintBox1.Width);

    //Edit2.Text:=IntToStr(PaintBox1.Height);

    //Re.Right:=endy;

    //Re.Bottom:=endy;

     PaintBox1.Canvas.Brush.Style:=bsClear;

     PaintBox1.Canvas.Rectangle(Arect);

     //InvalidateRect(form1.Handle,Re ,TRUE);

     //窗体创建DoubleBuffered:=True; 防止闪图

     PaintBox1.Invalidate;

   end else

   begin

      if cztx then

      PaintBox1.Invalidate;

   end;

end;

 

 

procedure TForm1.PaintBox1Paint(Sender: TObject);

var

   tsX,tsY:Integer;

begin

   PaintBox1.Width:=Image1.Width;

   PaintBox1.Height:=Image1.Height;

   tsX:=endx+5;

   tsY:=endY+5;

   if jtks then

   begin

     PaintBox1.Canvas.Brush.Style:=bsClear;

     PaintBox1.Canvas.Pen.Color:=clRed;

     PaintBox1.Canvas.Rectangle(Arect);

     if (endx+200)>Image1.Width then

     begin

       tsx:=tsX-200;

     end;

     if (tsY+50)>Image1.Height then

     begin

       tsY:=tsY-50;

     end;

     PaintBox1.Canvas.TextOut(tsX,tsY,'保存请按ENTER!');

     PaintBox1.Canvas.TextOut(tsX,tsY+15,'('+inttostr(Arect.Left)+','+inttostr(Arect.Top)+')'

      +'('+inttostr(Arect.Right)+','+inttostr(Arect.top)+')'

      +'('+inttostr(Arect.Left)+','+inttostr(Arect.Bottom)+')'

      +'('+inttostr(Arect.Right)+','+inttostr(Arect.Bottom)+')'

      );

      Image2.Top:=Arect.Bottom;

      Image2.Left:=Arect.Right;

      form1.Caption:='截图工具(按住SHIFT+鼠标左键选择起点;ESC取消起点锁定)'+'                    '

      +'('+inttostr(Arect.Left)+','+inttostr(Arect.Top)+')'

      +'('+inttostr(Arect.Right)+','+inttostr(Arect.top)+')'

      +'('+inttostr(Arect.Left)+','+inttostr(Arect.Bottom)+')'

      +'('+inttostr(Arect.Right)+','+inttostr(Arect.Bottom)+')'

   end;

 

 

end;

 

 

end.

//第一次完整的写Delphi小工,纪念一下,代码写的很烂请不要见怪。

读完这篇文章后,您心情如何?
0
0
0
0
0
0
0
0
本文网址:
下一篇:没有资料