Приложение для просмотра изображений JPEG и BMP

Previous  Top  Next

    
 

 

Code:

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.

 

©Drkb::03798