unit mainUnit;
interface
uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 ExtDlgs, StdCtrls, ComCtrls, ExtCtrls, Buttons, ToolWin, ImgList;
type
 TForm1 = class(TForm)
  SavePictureDialog1: TSavePictureDialog;
  OpenPictureDialog1: TOpenPictureDialog;
  ScrollBox1: TScrollBox;
  Image1: TImage;
  ToolBar1: TToolBar;
  OpenBtn: TToolButton;
  SaveBtn: TToolButton;
  Panel2: TPanel;
  ProgressBar1: TProgressBar;
  ImageList1: TImageList;
  procedure SavePictureDialog1TypeChange(Sender: TObject);
  procedure Image1Progress(Sender: TObject; Stage: TProgressStage;
  PercentDone: Byte; RedrawNow: Boolean; const R: TRect;
  const Msg: string);
  procedure SavePictureDialog1Close(Sender: TObject);
  procedure FormCreate(Sender: TObject);
  procedure OpenBitBtnClick(Sender: TObject);
  procedure SaveBitBtnClick(Sender: TObject);
  procedure ToolBar1Resize(Sender: TObject);
 private
  { Private declarations }
 public
  { Public declarations }
 end;
var
 Form1: TForm1;
implementation
{$R *.DFM}
uses jpeg;
const DeltaH: Integer = 80;
var Quality: TJpegQualityRange;
 ProgressiveEnc: Boolean;
procedure TForm1.FormCreate(Sender: TObject);
var s: string;
begin
 s := GraphicFilter(TBitmap) + '|' + GraphicFilter(TJpegImage);
 OpenPictureDialog1.Filter := s;
 SavePictureDialog1.Filter := s;
end;
procedure TForm1.OpenBitBtnClick(Sender: TObject);
begin
 if OpenPictureDialog1.Execute
  then
 begin
  Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
  SaveBtn.Enabled := True;
 end;
end;
procedure TForm1.SaveBitBtnClick(Sender: TObject);
var ji: TJpegImage;
begin
 with SavePictureDialog1 do
 begin
  FilterIndex := 1;
  FileName := '';
  if not Execute then Exit;
  if Pos('.', FileName) = 0 then
  if (FilterIndex = 1) then
  FileName := FileName + '.bmp'
  else
  FileName := FileName + '.jpg';
  if (FilterIndex = 1) then
  Image1.Picture.Bitmap.SaveToFile(FileName)
  else
  begin
  ji := TJpegImage.Create;
  ji.CompressionQuality := Quality;
  ji.ProgressiveEncoding := ProgressiveEnc;
  ji.OnProgress := Image1Progress;
  ji.Assign(Image1.Picture.Bitmap);
  ji.SaveToFile(FileName);
  ji.Free;
  end;
 end;
end;
procedure TForm1.SavePictureDialog1TypeChange(Sender: TObject);
var ParentHandle: THandle; wRect: TRect;
 PicPanel, PaintPanel: TPanel; QEdit: TEdit;
begin
 with Sender as TSavePictureDialog do
 begin
//родительская панель
  PicPanel := (FindComponent('PicturePanel') as TPanel);
  if not Assigned(PicPanel) then Exit;
  ParentHandle := GetParent(Handle);
//панель-сосед сверху
  PaintPanel := (FindComponent('PaintPanel') as TPanel);
  PaintPanel.Align := alNone;
  if FilterIndex > 1 then
  begin
  GetWindowRect(ParentHandle, WRect);
  SetWindowPos(ParentHandle, 0, 0, 0, WRect.Right - WRect.Left,
  WRect.Bottom - WRect. + DeltaH, SWP_NOMOVE + SWP_NOZORDER);
  GetWindowRect(Handle, WRect);
  SetWindowPos(handle, 0, 0, 0, WRect.Right - WRect.Left,
  WRect.Bottom - WRect. + DeltaH, SWP_NOMOVE + SWP_NOZORDER);
  PicPanel.Height := PicPanel.Height + DeltaH;
  if FindComponent('JLabel') = nil then
  with TLabel.Create(Sender as TSavePictureDialog) do
  begin
  Parent := PicPanel;
  Name := 'JLabel';
  Caption := 'Quality';
  Left := 5; //Width := PicPanel.Width - 10;
  Height := 25;
   := PaintPanel. + PaintPanel.Height + 5;
  end;
  if FindComponent('JEdit') = nil then
  begin
  QEdit := TEdit.Create(Sender as TSavePictureDialog);
  with QEdit do
  begin
  Parent := PicPanel;
  Name := 'JEdit';
  Text := '75';
  Left := 50; Width := 50;
  Height := 25;
   := PaintPanel. + PaintPanel.Height + 5;
  end;
  end;
  if FindComponent('JUpDown') = nil then
  with TUpDown.Create(Sender as TSavePictureDialog) do
  begin
  Parent := PicPanel;
  Name := 'JUpDown';
  Associate := QEdit;
  Increment := 5;
  Min := 1; Max := 100;
  Position := 75;
  end;
  if FindComponent('JCheck') = nil then
  with TCheckBox.Create(Sender as TSavePictureDialog) do
  begin
  Name := 'JCheck';
  Caption := 'Progressive Encoding';
  Parent := PicPanel;
  Left := 5; Width := PicPanel.Width - 10;
  Height := 25;
   := PaintPanel. + PaintPanel.Height + 35;
  end;
  end
  else
  SavePictureDialog1Close(Sender);
 end;
end;
procedure TForm1.Image1Progress(Sender: TObject; Stage: TProgressStage;
 PercentDone: Byte; RedrawNow: Boolean; const R: TRect;
 const Msg: string);
begin
 case Stage of
  psStarting: begin
  Progressbar1.Position := 0;
  Progressbar1.Max := 100;
  end;
  psEnding: begin
  Progressbar1.Position := 0;
  end;
  psRunning: begin
  Progressbar1.Position := PercentDone;
  end;
 end;
end;
procedure TForm1.SavePictureDialog1Close(Sender: TObject);
var PicPanel: TPanel; ParentHandle: THandle; WRect: TRect;
begin
 with Sender as TSavePictureDialog do
 begin
  PicPanel := (FindComponent('PicturePanel') as TPanel);
  if not Assigned(PicPanel) then Exit;
  ParentHandle := GetParent(Handle);
  if ParentHandle = 0 then Exit;
  if FindComponent('JLabel') <> nil then
  try
  FindComponent('JLabel').Free;
  FindComponent('JEdit').Free;
  ProgressiveEnc := (FindComponent('JCheck') as TCheckBox).Checked;
  FindComponent('JCheck').Free;
  Quality := (FindComponent('JUpDown') as TUpDown).Position;
  FindComponent('JUpDown').Free;
  PicPanel.Height := PicPanel.Height - DeltaH;
  GetWindowRect(Handle, WRect);
  SetWindowPos(Handle, 0, 0, 0, WRect.Right - WRect.Left,
  WRect.Bottom - WRect. - DeltaH, SWP_NOMOVE + SWP_NOZORDER);
  GetWindowRect(ParentHandle, WRect);
  SetWindowPos(ParentHandle, 0, 0, 0, WRect.Right - WRect.Left,
  WRect.Bottom - WRect. - DeltaH, SWP_NOMOVE + SWP_NOZORDER);
  FilterIndex := 1;
  except
  ShowMessage('Dialog resizing error');
  end;
 end;
end;
procedure TForm1.ToolBar1Resize(Sender: TObject);
begin
 Panel2.Width := ToolBar1.Width - Panel2.Left;
end;
end.