Delphi World - Приложение для просмотра изображений JPEG и BMP
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Приложение для просмотра изображений 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.

Скачать весь проект

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования