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

Советы » GIF, JPEG, MetaFile » Приложение для просмотра изображений JPEG и BMP

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

.

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com