unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, StdCtrls, GDIPOBJ, GDIPAPI,  GDIPUTIL, ExtDlgs,
  ActiveX;

type
  TMyPanel = class(TCustomPanel)
  private
    FImageFilePath : String;
    FJPEGQuality   : Cardinal;
    procedure SetImageFilePath(const Value: String);
    procedure SetJPEGQuality(const Value: Cardinal);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    property ImageFilePath : String   read FImageFilePath write SetImageFilePath;
    property JPEGQuality   : Cardinal read FJPEGQuality   write SetJPEGQuality;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    TrackBar1: TTrackBar;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
  private
    { Private 宣言 }
    MyPanel : TMyPanel;
  protected

  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  JPEG,
  GifImg,
  pngimage;

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.Caption := 'GDI+  JPEG 画像の品質設定';

  //TMyPanelを生成して配置
  MyPanel := TMyPanel.Create(Self);
  with MyPanel do begin
    Parent  := Self;
    Left    := 5;
    Top     := 35;
    Width   := Self.ClientWidth  - 10;
    Height  := Self.ClientHeight - Top - 5;
    Anchors := [akLeft, akTop, akRight, akBottom];
    Color   := clWhite;

    BevelOuter       := bvNone;
    ParentBackground := False;
    DoubleBuffered   := True;
  end;

  //品質の設定用
  with TrackBar1 do begin
    ShowSelRange := False;
    TickStyle    := tsNone;
    Height   := 26;
    Min      := 0;
    Max      := 100;
    Position := 100;
  end;
end;

//=============================================================================
//  [画像ファイル]ボタン
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  if not Assigned(MyPanel) then exit;

  if OpenPictureDialog1.InitialDir = '' then begin
    OpenPictureDialog1.InitialDir := ExtractFileDir(ParamStr(0));
  end;

  OpenPictureDialog1.Filter := '画像ファイル|*.png;*.jpg;*.jpeg;*.bmp;*.gif';
  if OpenPictureDialog1.Execute then begin
    OpenPictureDialog1.InitialDir := ExtractFileDir(MyPanel.ImageFilePath);
    MyPanel.ImageFilePath         := OpenPictureDialog1.FileName;
  end;
end;

//=============================================================================
//  TrackBar1のOnChangeイベント処理
//=============================================================================
procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  if not Assigned(MyPanel) then exit;
  MyPanel.JPEGQuality := TrackBar1.Position;
  Label1.Caption := IntToStr(TrackBar1.Position);
end;

{ TMyPanel }

//-----------------------------------------------------------------------------
//  コンストラクタ
//-----------------------------------------------------------------------------
constructor TMyPanel.Create(AOwner: TComponent);
begin
  inherited;
  FImageFilePath := '';
  FJPEGQuality   := 100;
end;

//-----------------------------------------------------------------------------
//  ImageFilePathプロパティの設定メソッド
//  表示する画像ファイルを指定する
//-----------------------------------------------------------------------------
procedure TMyPanel.SetImageFilePath(const Value: String);
begin
  if not FileExists(Value) then exit;

  FImageFilePath := Value;
  Invalidate;
end;

//-----------------------------------------------------------------------------
//  JPEGQualityプロパティの設定メソッド
//-----------------------------------------------------------------------------
procedure TMyPanel.SetJPEGQuality(const Value: Cardinal);
begin
  if FImageFilePath = '' then exit;
  if FJPEGQuality <> Value then begin
    FJPEGQuality := Value;
    Invalidate;
  end;
end;

//-----------------------------------------------------------------------------
//  TMyPanelクラスのPaintメソッド
//  実際の描画コード
//-----------------------------------------------------------------------------
procedure TMyPanel.Paint;
var
  LObjWidth      : Integer;
  LObjHeight     : Integer;
  LGPImage       : TGPImage;
  LGPGraphic     : TGPGraphics;
  LEncoderParams : TEncoderParameters;
  LMemoryStream  : TMemoryStream;
  LIStrema       : IStream;
  LImageGUID     : TGUID;
begin
  inherited;
  if FImageFilePath = '' then exit;

  //画像ファイルからTGPImageのインスタンスを生成．幅と高さを取得
  LGPImage   := TGPImage.Create(FImageFilePath);
  LObjWidth   := LGPImage.GetWidth;
  LObjHeight  := LGPImage.GetHeight;

  //画像をTMyPanelのCanvasに描画
  LGPGraphic := TGPGraphics.Create(Canvas.Handle);
  LGPGraphic.DrawImage(LGPImage, 0, 0, LObjWidth, LObjHeight);

  //JPEGの品質関係の値をTEncoderParametersレコード型の各メンバーにセット
  LEncoderParams.Count := 1;
  LEncoderParams.Parameter[0].Guid           := EncoderQuality;
  LEncoderParams.Parameter[0].Type_          := EncoderParameterValueTypeLong;
  LEncoderParams.Parameter[0].NumberOfValues := 1;
  LEncoderParams.Parameter[0].Value := @FJPEGQuality;

  LMemoryStream := TMemoryStream.Create;
  try
    //メモリストリームを生成して，そこに保存
    GetEncoderClsid('image/jpeg', LImageGUID);
    LGPImage.Save(TStreamAdapter.Create(LMemoryStream), LImageGUID, @LEncoderParams);

    LGPImage.Free;
    //保存したJPEG画像を読み出して描画
    LIStrema := TStreamAdapter.Create(LMemoryStream);
    LGPImage := TGPBitmap.Create(LIStrema);
    LGPGraphic.DrawImage(LGPImage, LObjWidth + 10, 0, LObjWidth, LObjHeight);
  finally
    LMemoryStream.Free;
  end;

  LGPImage.Free;
  LGPGraphic.Free;
end;

end.