Delphi图像缩放,剪切,拼接,读取EXCEL内容,批量添加内容

Delphi图形界面编程

下载此实例

开发语言：Pascal
实例大小：0.01M
下载次数：25
浏览次数：545
发布时间：2019-03-20
实例类别：Delphi图形界面编程
发布人：crazycode
文件格式：.rar
所需积分：2

实例介绍

[下载地址]

【实例简介】

【实例截图】

from clipboard

拼接后如下：

from clipboard

【核心代码】

unit u_main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, FileCtrl, StdCtrls, ExtCtrls, Buttons,nexcel, Grids,jpeg;

type
  TForm1 = class(TForm)
    pnl1: TPanel;
    pnl2: TPanel;
    img1: TImage;
    btn1: TBitBtn;
    btn2: TBitBtn;
    dlgOpen: TOpenDialog;
    mmo1: TMemo;
    btn3: TBitBtn;
    lbl1: TLabel;
    btn4: TButton;
    procedure btn1Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure btn4Click(Sender: TObject);
  private
    function BmpToJpg(FilePath: string): string;
    function JpgToBmp(FilePath: string): string;
    procedure imgscale(Src, Dst: string;NewH,NewW:integer);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btn1Click(Sender: TObject);
var
  i1,i2:Integer;
  fs1:string;
begin

  for i1:=0 to 9 do
      with img1.Picture do
    begin

        fs1:=ExtractFilePath(Application.ExeName) 'pic\' inttostr(i1 1) '.jpg';
        LoadFromFile(JpgToBmp(fs1));
        i2:=img1.Picture.Height;
        Bitmap.Canvas.Brush.Style:= bsClear;
        Bitmap.Canvas.Font.Size:=20;
        Bitmap.Canvas.Font.Name:='黑体';
        Bitmap.Canvas.Font.Color:=clGray;

        Bitmap.Canvas.Brush.Color:=clWhite;
        bitmap.canvas.Rectangle(1,i2-50,img1.Picture.Width,img1.Picture.Height);
        bitmap.Canvas.FloodFill(2,i2-49,clwhite,fsBorder);
      {  Bitmap.Canvas.Font.Color:=clblack;
        Bitmap.Canvas.TextOut(12,i2-35,mmo1.Lines[i1]); }
        Bitmap.Canvas.Font.Color:=clred;
        Bitmap.Canvas.TextOut(10,i2-37,mmo1.Lines[i1]);
       { Bitmap.Canvas.Font.Color:=clWhite;
        Bitmap.Canvas.TextOut(8,766,mmo1.Lines[i1]);  }
        SaveToFile(copy(fs1, 1, Length(fs1) - 3)   'bmp');
        BmpToJpg(copy(fs1, 1, Length(fs1) - 3)   'bmp');
        DeleteFile(Copy(fs1, 1, Length(fs1) - 3)   'bmp');
    end;

   ShowMessage('添加文字完成!');
end;

procedure TForm1.btn2Click(Sender: TObject);
var
  i: integer;
  book:IXLSWorkBook;
  ws:IXLSWorksheet;
begin
  book:=TXLSWorkbook.Create;
 if not dlgopen.Execute then Exit;
 try
  book.Open(dlgopen.FileName);
  ws:=book.WorkSheets[1];
  begin
    {    strngrd1.Cells[0,0]:='名次';
        strngrd1.Cells[1,0]:='棚号';
        strngrd1.Cells[2,0]:='姓名';
        strngrd1.Cells[3,0]:='足环号';
        strngrd1.Cells[4,0]:='性别';
        strngrd1.Cells[5,0]:='羽色';
        strngrd1.Cells[6,0]:='眼砂'; }
     mmo1.Lines.Clear;
    for i := 1 to 10 do      //
    begin
        mmo1.Lines.Append('第' inttostr(ws.UsedRange.Item[i 1,1].value) '名: ' ws.UsedRange.Item[i 1,3].value 
        ' 足环号:' ws.UsedRange.Item[i 1,4].value ' 特征:' ws.UsedRange.Item[i 1,5].value ' ' ws.UsedRange.Item[i 1,6].value 
        ' ' ws.UsedRange.Item[i 1,7].value);
       // mmo1.Lines.Add('第' ws.UsedRange.Item[i,1].value '名   姓名:' ws.UsedRange.Item[i,3].value);

    end; //for i
  end; //if
   except
 raise;
 end;  //try
end;

function tform1.JpgToBmp(FilePath: string): string;
var 
  MyJPEG: TJPEGImage;
  MyBMP: TBitmap;
  s: string; 
begin
  Result := '';
  s := copy(FilePath, 1, Length(FilePath) - 3)   'bmp';
  MyJPEG := TJPEGImage.Create;
  with MyJPEG do
    begin  LoadFromFile(FilePath);
    MyBMP := TBitmap.Create;
    with MyBMP do
      begin  
        Width := MyJPEG.Width;
        Height := MyJPEG.Height;
        Canvas.Draw(0, 0, MyJPEG);
        SaveToFile(s);
        Result := s;
        Free;
      end;
    Free;
  end;
end;



function tform1.BmpToJpg(FilePath: string): string;
var  
  Jpg: TJpegImage;
  BMP: TBitMap;
  s:string;
begin  
   s := copy(FilePath, 1, Length(FilePath) - 3)   'jpg';
  Jpg := TJpegImage.Create;
  BMP := TBitmap.Create;
  BMP.LoadFromFile(FilePath);
  Jpg.Assign(BMP);
  Jpg.SaveToFile(s);
  BMP.Free;
  Jpg.Free;
end;

procedure TForm1.btn3Click(Sender: TObject);
 var
 jp1, jp2, jp: TJPEGImage;
 bmp_t, bmp: TBitmap;
begin

 jp1 := TJPEGImage.Create;
 jp2 := TJPEGImage.Create;
 jp := TJPEGImage.Create;
  try
   jp1.LoadFromFile('1.jpg');
   jp2.LoadFromFile('2.jpg');
   bmp := TBitmap.Create;
   bmp_t := TBitmap.Create;
    try
    bmp.Width := 800;
    bmp.Height := 800;

    bmp_t.Assign(jp1);
    bmp.Canvas.Draw(0, 0, bmp_t);
    bmp_t.Assign(jp2);
    bmp.Canvas.Draw(0, jp1.Height, jp2);

    jp.Assign(bmp);
    jp.SaveToFile('0.jpg');
    finally
    bmp.Free;
    bmp_t.Free;
    end;
  finally
  jp1.Free;
  jp2.Free;
  jp.Free;
  end;
end;

procedure TForm1.btn4Click(Sender: TObject);
var
  p1:TBitmap;
  picOriginal: TPicture;
  bili:Single;
  rectSrc, rectDst: TRect;
  i1:integer;
  jpg: TJPEGImage;
begin
  rectSrc:=Rect(4,4,492,796);
  rectDst:=Rect(496,4,796,394);
  picOriginal := TPicture.Create;
  p1:=TBitmap.Create;
  for i1 := 1 to 10 do
     begin
  picOriginal.LoadFromFile(ExtractFilePath(ParamStr(0))   'spic\' inttostr(i1) '-1.jpg'); //fileName为jpg文件路径
  bili:=picOriginal.Width/picoriginal.Height;

  p1.Width := Round(796*bili);  //355
  p1.Height := 796;
  p1.Canvas.StretchDraw(Rect(-50,0,p1.Width, p1.Height), picOriginal.Graphic);
  img1.Canvas.CopyRect(rectSrc,p1.Canvas,rectSrc);


  picOriginal.LoadFromFile(ExtractFilePath(ParamStr(0))   'spic\' inttostr(i1) '-2.jpg'); //fileName为jpg文件路径
  p1.Width := Round(396*bili);  //355
  p1.Height := 396;
  p1.Canvas.StretchDraw(Rect(-30,0,p1.Width, p1.Height), picOriginal.Graphic);
   img1.Canvas.CopyRect(rectdst,p1.Canvas,rect(4,4,296,394));

  picOriginal.LoadFromFile(ExtractFilePath(ParamStr(0))   'spic\' inttostr(i1) '-3.jpg'); //fileName为jpg文件路径
  p1.Width := Round(394*bili);  //355
  p1.Height := 394;
  p1.Canvas.StretchDraw(Rect(0,0,p1.Width, p1.Height), picOriginal.Graphic);
  img1.Canvas.CopyRect(Rect(496,398,796,796),p1.Canvas,rect(4,4,296,394));

        img1.Picture.Bitmap.Canvas.Brush.Style:= bsClear;
        img1.Picture.Bitmap.Canvas.Font.Size:=20;
        img1.Picture.Bitmap.Canvas.Font.Name:='黑体';
        img1.Picture.Bitmap.Canvas.Font.Color:=clGray;

        img1.Picture.Bitmap.Canvas.Brush.Color:=clWhite;
        img1.Picture.bitmap.canvas.Rectangle(4,750,img1.Picture.Width-4,img1.Picture.Height);
        img1.Picture.bitmap.Canvas.FloodFill(2,751,clwhite,fsBorder);

        img1.Picture.Bitmap.Canvas.Font.Color:=clred;
        img1.Picture.Bitmap.Canvas.TextOut(10,800-37,mmo1.Lines[i1-1]);

    img1.Picture.Graphic.Width:=800;
    img1.Picture.Graphic.Height:=800;
   jpg:=tjpegimage.Create;
   jpg.Assign(img1.Picture.Graphic);
   jpg.CompressionQuality:=50;
   jpg.Compress;
   jpg.SaveToFile(extractfilepath(paramstr(0)) 'pic\' inttostr(i1) '.jpg');
   jpg.Free;
   //  img1.Picture.SaveToFile(extractfilepath(paramstr(0)) 'pic\' inttostr(i1) '.jpg');
     end;
  p1.Free;
  picOriginal.Free;

end;

procedure TForm1.imgscale(Src, Dst: string;NewH,NewW:integer);
var
  SrcBM,DstBM:TBitMap;
  Rect:TRect;
  PicW,PicH:Integer;
  HDivW:Double;
begin
  SrcBM:=TBitMap.Create;
  SrcBM.LoadFromFile(Src);
  PicW:=SrcBM.Width;
  PicH:=SrcBM.Height;
  NewH:=768;
  NewW:=1024;
  DstBM:=TBitMap.Create;
  with DstBM do
  begin
    Width:=NewW;
    Height:=NewH;
    Rect.TopLeft:=Point(0,0);
    Rect.BottomRight:=Point(NewW,NewH);
    Canvas.Rectangle(0,0,Width,Height);
    Canvas.StretchDraw(Rect,TGraphic(SrcBM));
    SaveToFile(Dst);
    FreeImage;
    Free;
  end;
end;




end.

标签： 拼接图像剪贴缩放

实例下载地址

Delphi图像缩放,剪切,拼接,读取EXCEL内容,批量添加内容

点此下载实例

不能下载？内容有错？点击这里报错 + 投诉 + 提问

好例子网口号：伸出你的我的手 — 分享！

网友评论

我要评论

小贴士

感谢您为本站写下的评论，您的评论对其它用户来说具有重要的参考价值，所以请认真填写。

类似“顶”、“沙发”之类没有营养的文字，对勤劳贡献的楼主来说是令人沮丧的反馈信息。
相信您也不想看到一排文字/表情墙，所以请不要反馈意义不大的重复字符，也请尽量不要纯表情的回复。
提问之前请再仔细看一遍楼主的说明，或许是您遗漏了。
请勿到处挖坑绊人、招贴广告。既占空间让人厌烦，又没人会搭理，于人于己都无利。

关于好例子网

本站旨在为广大IT学习爱好者提供一个非营利性互相学习交流分享平台。本站所有资源都可以被免费获取学习研究。本站资源来自网友分享，对搜索内容的合法性不具有预见性、识别性、控制性，仅供学习研究，请务必在下载后24小时内给予删除，不得用于其他任何用途，否则后果自负。基于互联网的特殊性，平台无法对用户传输的作品、信息、内容的权属或合法性、安全性、合规性、真实性、科学性、完整权、有效性等进行实质审查；无论平台是否已进行审查，用户均应自行承担因其传输的作品、信息、内容而可能或已经产生的侵权或权属纠纷等法律责任。本站所有资源不代表本站的观点或立场，基于网友分享，根据中国法律《信息网络传播权保护条例》第二十二与二十三条之规定，若资源存在侵权或相关问题请联系本站客服人员，点此联系我们。关于更多版权及免责申明参见版权及免责申明

Delphi图像缩放,剪切,拼接,读取EXCEL内容,批量添加内容

同类人气实例

实例介绍

实例下载地址

Delphi图像缩放,剪切,拼接,读取EXCEL内容,批量添加内容

相关软件

相关文章

网友评论

小贴士

关于好例子网

下载周排行

下载总排行