⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 可以缩放JPG文件
💻 PAS
字号:
{
 本程序演示了如何将大JPG图像转换为指定高度和宽度小JPG图像,所用于的代码大部分来自
 于网络,特向前人表示感谢.
                                               余涛
                                            2005年10月19日
}
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,jpeg, ComCtrls, ToolWin, ExtCtrls, ExtDlgs,
  XsImageEffect, ImgList;

type
  TForm1 = class(TForm)
    Image1: TImage;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    XsImageEffect1: TXsImageEffect;
    OpenPictureDialog1: TOpenPictureDialog;
    ToolButton4: TToolButton;
    Label1: TLabel;
    Edit1: TEdit;
    ToolButton5: TToolButton;
    Label2: TLabel;
    Edit2: TEdit;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ImageList1: TImageList;
    procedure ToolButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    jpgstream:TMemoryStream;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ToolButton1Click(Sender: TObject);
var
  jpg,jpgsmall :TJpegImage;
  bmp,tmpbmp :TBitmap;
  jpgstream:TMemoryStream;
begin
  if not self.OpenPictureDialog1.Execute then
   exit;
 
  jpgstream:=TMemoryStream.Create;
  jpg :=TJpegImage.Create;
  jpgsmall:=Tjpegimage.Create;
//打开原始文件  
  jpg.LoadFromFile(self.OpenPictureDialog1.FileName);
  bmp :=TBitmap.Create;
  bmp.Assign(jpg);
  tmpbmp :=TBitmap.Create;

  tmpbmp.Height :=strtoint(self.Edit1.Text);   //转换后的高度
  tmpbmp.Width :=strtoint(self.Edit2.text);   //转换后的宽度

  tmpbmp.pixelformat:=pf32bit; //设置Bmp图像的颜色深度
  jpg.PixelFormat:=jf24bit;    //设置JPG图像的颜色深度
  tmpbmp.Canvas.StretchDraw(tmpbmp.Canvas.ClipRect,jpg);//先转换为BMP
  
  jpg.Assign(tmpbmp); //再转换为JPG
  jpg.SaveToStream(jpgstream);
  self.Image1.Picture.LoadFromFile(self.OpenPictureDialog1.FileName);
  jpgsmall.LoadFromStream(jpgstream);

  jpgstream.Position:=0;
  jpgsmall.LoadFromStream(jpgstream);
  self.XsImageEffect1.Picture.Bitmap.Assign(jpgsmall);
  jpg.Free;
  bmp.Free;
  tmpbmp.Free;
 end;
end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -