delphi 加载图像并压缩，旋转图像角度

unit Unit1;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,

Vcl.Imaging.jpeg,

Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.ExtDlgs, Vcl.StdCtrls,

Vcl.Buttons;

type

TForm1 = class(TForm)

Image1: TImage;

BitBtn1: TBitBtn;

OpenPictureDialog1: TOpenPictureDialog;

Button1: TButton;

procedure BitBtn1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

uses math;

function CompressJpgImageFile(FileName: string; NewSize: integer; AStream: TMemoryStream) : Boolean; overload;

function GetNewSize(OldWidth, OldHeight: integer; NewSize: integer;

var RetWidth, RetHeight: integer): Boolean;

begin

Result := False;

if OldWidth > OldHeight then

begin

Result := True;

if NewSize < OldWidth then

begin

RetHeight := Round(OldHeight * (NewSize / OldWidth));

RetWidth := NewSize;

end

else

begin

RetHeight := OldHeight;

RetWidth := OldWidth;

end;

end

else

begin

Result := True;

if NewSize < OldHeight then

begin

RetWidth := Round(OldWidth * (NewSize / OldHeight));

RetHeight := NewSize;

end

else

begin

RetHeight := OldHeight;

RetWidth := OldWidth;

end;

var

bmp: TBitmap;

jpg: TJPEGImage;

Width, Height: integer;

begin

Result := False;

try

bmp := TBitmap.Create;

jpg := TJPEGImage.Create;

if pos(UpperCase('.jpg'), UpperCase(FileName)) <> 0 then // jpg其它格式

begin

jpg.LoadFromFile(FileName);

// Application.ProcessMessages;

if GetNewSize(jpg.Width, jpg.Height, NewSize, Width, Height) then

begin

bmp.Height := Height;

bmp.Width := Width;

bmp.Canvas.StretchDraw(bmp.Canvas.ClipRect, jpg);

// Application.ProcessMessages;

jpg.Assign(bmp);

// Application.ProcessMessages;

jpg.CompressionQuality := 80;

jpg.Compress;

// Application.ProcessMessages;

AStream.Clear;

jpg.SaveToStream(AStream);

AStream.Position := 0;

Result := True;

end;

finally

FreeAndNil(bmp);

FreeAndNil(jpg);

end;

/// /旋转90°

// procedure Rotate(Bitmap: TBitmap);

// type

// THelpRGB = packed record

// rgb: TRGBTriple;

// dummy: byte;

// end;

// pRGBArray = ^TRGBArray;

// TRGBArray = array[0..32767] of TRGBTriple;

// var

// aStream: TMemorystream;

// //内存流

// header: TBITMAPINFO;

// dc: hDC;

// P: ^THelpRGB;

// x, y, b, h: Integer;

// RowOut: pRGBArray;

// begin

// //创建内存流

// aStream := TMemoryStream.Create;

// //设置大小，必须是4的倍数

// aStream.SetSize(Bitmap.Height * Bitmap.Width * 4);

// with header.bmiHeader do //操作位图文件

// begin

// biSize := SizeOf(TBITMAPINFOHEADER); //大小

// biWidth := Bitmap.Width; //位图宽

// biHeight := Bitmap.Height; //位图高

// biPlanes := 1;

// biBitCount := 32;

// //无压缩

// biCompression := 0;

// biSizeimage := aStream.Size;

// biXPelsPerMeter := 1; //水平分辨率

// biYPelsPerMeter := 1; //竖直分辨率

// biClrUsed := 0;

// biClrImportant := 0;

// end;

// dc := GetDC(0);

// P := aStream.Memory;

// GetDIBits(dc, Bitmap.Handle, 0, Bitmap.Height, P, header, dib_RGB_Colors);

// ReleaseDC(0, dc);

// b := bitmap.Height; //源图高

// h := bitmap.Width; //源图宽

// //指定要创建的位图的大小尺寸

// bitmap.Width := b;

// bitmap.height := h;

// for y := 0 to (h - 1) do

// begin

// rowOut := Bitmap.ScanLine[y]; //获取新的位图信息

// P := aStream.Memory; //设置文件指针

// inc(p, y); //指针移位

// for x := 0 to (b - 1) do

// begin

// rowout[x] := p^.rgb; //进行数据转移

// inc(p, h);

// end;

// aStream.Free; //释放资源

// end;

procedure TForm1.BitBtn1Click(Sender: TObject);

var

s: string;

begin

if OpenPictureDialog1.Execute then

begin

s := OpenPictureDialog1.FileName;

BitBtn1.Enabled := False;

TThread.CreateAnonymousThread(

procedure

var

FStream: TMemoryStream;

jpg: TJPEGImage;

begin

FStream := TMemoryStream.Create;

jpg := TJPEGImage.Create;

if CompressJpgImageFile(s, 500,FStream) then

begin

jpg.LoadFromStream(FStream);

TThread.Synchronize(nil,

procedure

begin

Image1.Picture.Assign(jpg);

BitBtn1.Enabled := True;

end);

FreeAndNil(jpg);

FreeAndNil(FStream);

end;

end).Start;

end;

procedure Rotate90(Source: TGraphic; Target: TJpegImage);

var

SourceBmp, TargetBmp: TBitmap;

r, c: Integer;

x, y: Integer;

begin

SourceBmp := TBitmap.Create;

SourceBmp.Assign(Source);

TargetBmp := TBitmap.Create;

TargetBmp.Width := SourceBmp.Height;

TargetBmp.Height := SourceBmp.Width;

for r := 0 to SourceBmp.Height - 1 do

begin

for c := 0 to SourceBmp.Width - 1 do

begin

//x := (SourceBmp.Height-1) - r; // -90

//y := c; //-90

x := r; //90

y := (SourceBmp.Width-1) - c; //90

// look into Bitmap.ScanLine for faster pixel access

TargetBmp.Canvas.Pixels[x, y] := SourceBmp.Canvas.Pixels[c, r];

end;

Target.Assign(TargetBmp);

SourceBmp.Free;

TargetBmp.Free;

end;

procedure TForm1.Button1Click(Sender: TObject);

var

Jpeg: TJPEGImage;

begin

Jpeg := TJPEGImage.Create;

Rotate90(Image1.Picture.Graphic, Jpeg);

Image1.Picture.Assign(Jpeg);

Jpeg.Free;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

// FStream := TMemoryStream.Create;

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

// FStream.Free;

end;

end.

推荐分享