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.Top + DeltaH, SWP_NOMOVE + SWP_NOZORDER);
GetWindowRect(Handle, WRect);
SetWindowPos(handle, 0, 0, 0, WRect.Right - WRect.Left,
WRect.Bottom - WRect.Top + 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;
Top := PaintPanel.Top + 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;
Top := PaintPanel.Top + 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;
Top := PaintPanel.Top + 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.Top - DeltaH, SWP_NOMOVE + SWP_NOZORDER);
GetWindowRect(ParentHandle, WRect);
SetWindowPos(ParentHandle, 0, 0, 0, WRect.Right - WRect.Left,
WRect.Bottom - WRect.Top - 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.