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;
    end;
  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;
    end;
  finally
    FreeAndNil(bmp);
    FreeAndNil(jpg);
  end;
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;
// 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;
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;
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.
delphi 加载图像并压缩，旋转图像角度

相关推荐

评论
