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

【例子介绍】

【相关图片】

拼接后如下：

【源码结构】

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.