Просмотр графических файлов (JPEG,bmp)

---

Проект состоит из двух форм. Главная форма - FormMain содержит компоненты для настройки свойств картинки и кнопку - чтобы открыть файл с картинкой. Цель - показать основные возможности Делфи при работе с картинками JPEG. (В последне время появились файлы с расширением .jpe - после переименования в .jpg их тоже можно смотреть). Файлы .bmp тоже просматриваются, но настройки для них не работают.

Для картинок JPEG сделаны настройки:

• переключение: цветное / серое
• переключение: наилучшее качество / наилучшая скорость (при чтении)
• сглаживание структуры элементов-квадратиков: вкл/выкл
• количество цветов: 256 или 2^24
• масштаб: 100% 50% 25% 12,5%. Фактически масштаб меньше, если картинка не помещается на форме (т е можно плавно уменьшать масштаб (но не увеличивать))

Причем масштаб и цветное/серое изменяются сразу при щелчке, не требуя перезагрузки картинки.

Другая форма - FKart содержит компонент Image1 и служит для показа картинки. Форма прячется при щелчке по картинке.
Текст обоих модулей и проекта:

 { ************** ShowJpeg.dpr *****************}
program ShowJpeg;

uses
  Forms,
  ServerMain in 'ServerMain.pas' {FormMain},
  UKarta in 'UKarta.pas' {FKarta};

{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TFormMain, FormMain);
  Application.CreateForm(TFKarta, FKarta);
  Application.Run;
end.

 { ************** ServerMain.pas *****************}
unit ServerMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPServer, StdCtrls, ComCtrls,
  ExtCtrls, ExtDlgs;

type
  TFormMain = class(TForm)
    OPD1: TOpenPictureDialog;
    btnSelect: TButton;
    gray: TCheckBox;
    gbPerformance: TGroupBox;
    rbBestSpeed: TRadioButton;
    rbBestQuality: TRadioButton;
    gbPixelFormat: TGroupBox;
    rb24Bit: TRadioButton;
    rb8Bit: TRadioButton;
    gbScale: TGroupBox;
    rbFullSize: TRadioButton;
    rbHalf: TRadioButton;
    rbQuarter: TRadioButton;
    rbEighth: TRadioButton;
    cbSmooth: TCheckBox;
    procedure SetJPEGOptions2(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnSelectClick(Sender: TObject);
    procedure btnRepeatClick(Sender: TObject);
    procedure grayClick(Sender: TObject);
    procedure rbFullSizeClick(Sender: TObject);
    procedure rbHalfClick(Sender: TObject);
    procedure rbQuarterClick(Sender: TObject);
    procedure rbEighthClick(Sender: TObject);
    procedure rb8BitClick(Sender: TObject);
    procedure rb24BitClick(Sender: TObject);
  private
    { Private declarations  TJPegImage   }
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation uses JPeg, UKarta;

{$R *.dfm}

Var aJpeg:TJpegImage=nil;  MStream: TMemoryStream=nil;

procedure TFormMain.FormCreate(Sender: TObject);
begin
   Top := 10; Left := 10;
end;

procedure TFormMain.btnSelectClick(Sender: TObject);
var 
  FName: string;
begin
  if OPD1.Execute then FName := OPD1.FileName else exit;
    try
      FKarta.Image1.Picture.LoadFromFile(FName);
    except
      on EInvalidGraphic do
        FKarta.Image1.Picture.Graphic := nil;
    end;
    SetJPEGOptions2(self);
    FKarta.ClientHeight:= FKarta.Image1.Height;
    FKarta.ClientWidth:= FKarta.Image1.Width;
    FKarta.Show;
end;

procedure TFormMain.SetJPEGOptions2(Sender: TObject);
var
  Temp: Boolean;
begin
  Temp := FKarta.Image1.Picture.Graphic is TJPEGImage;
  if Temp then
    with TJPEGImage(FKarta.Image1.Picture.Graphic) do
    begin
      if Gray.Checked then Grayscale:= true
        else Grayscale:= false;
      if rbBestSpeed.Checked then Performance:= jpBestSpeed else
      if rbBestQuality.Checked then Performance:= jpBestQuality;
      if rb24Bit.Checked then PixelFormat:= jf24Bit else
      if rb8Bit.Checked then PixelFormat:= jf8Bit;
      if rbFullSize.Checked then Scale:= jsFullSize else
      if rbHalf.Checked then Scale:= jsHalf else
      if rbQuarter.Checked then Scale:= jsQuarter else
      if rbEighth.Checked then Scale:= jsEighth;
      ProgressiveDisplay := true;
      if cbSmooth.Checked then Smoothing:= true else
        Smoothing:= false;
    end;
  FKarta.Image1.IncrementalDisplay := true;
end;

procedure TFormMain.btnRepeatClick(Sender: TObject);
begin // Эта кнопка уже не нужна, а процедура осталась (нужна)!
 if not (FKarta.Image1.Picture.Graphic is TJPEGImage) then
   exit; // т е если картинка не загружена или типа TBitMap, TIcon
  SetJPEGOptions2(Sender);
    FKarta.ClientHeight:= FKarta.Image1.Height;
    FKarta.ClientWidth:= FKarta.Image1.Width;
    FKarta.Show;
end;

{ ****** СПРАВКА: TJPEGImage.Properties: *******
property Grayscale: Boolean; // серая картинка
property Performance: TJPEGPerformance;
type TJPEGPerformance = (jpBestQuality, jpBestSpeed); 
// наилучшее: качество или скорость 
property PixelFormat: TJPEGPixelFormat;
type TJPEGPixelFormat = (jf24Bit, jf8Bit);
property Scale: TJPEGScale; // Масштаб: 100%, 50%, 25%, 12,5%
// (Масштаб мож быть меньше, если уменьшить окно, НО НЕ БОЛЬШЕ !! 
type TJPEGScale = (jsFullSize, jsHalf, jsQuarter, jsEighth);
property Smoothing: Boolean;
}

procedure TFormMain.grayClick(Sender: TObject);
begin
  btnRepeatClick(Sender);
end;

procedure TFormMain.rbFullSizeClick(Sender: TObject);
begin
  btnRepeatClick(Sender);
end;

procedure TFormMain.rbHalfClick(Sender: TObject);
begin
  btnRepeatClick(Sender);
end;

procedure TFormMain.rbQuarterClick(Sender: TObject);
begin
  btnRepeatClick(Sender);
end;

procedure TFormMain.rbEighthClick(Sender: TObject);
begin
  btnRepeatClick(Sender);
end;

procedure TFormMain.rb8BitClick(Sender: TObject);
begin
  btnRepeatClick(Sender);
end;

procedure TFormMain.rb24BitClick(Sender: TObject);
begin
  btnRepeatClick(Sender);
end;

end.

 { ************** UKarta.pas *****************}
unit UKarta;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TFKarta = class(TForm)
    Image1: TImage;
    procedure Image1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FKarta: TFKarta;

implementation

{$R *.dfm}

procedure TFKarta.Image1Click(Sender: TObject);
begin
  Hide;
end;

end.

(Имя ServerMain.pas - это след переделки из сетевого приложения, которое, возможно, будет представлено)

Из настроек нужно отметить (т к в тексте они не видны, а только в инспекторе объектов):

• FormMain.Font.CharSET = RUSSIAN_CHARSET
• FormMain.Font.Size = 10
• FormMain.BorderStyle = bsSingle // т е размеры формы постоянны
• FormMain.Position = poScreenCenter
• FKarta.Image1.Align = alClient (т е Image1 занимает всю форму)
• FKarta.Image1.AutoSize = false (потому что включено Proportional)
• FKarta.Image1.Proportional = true (это для слежения за размером формы - только уменьшает! масштаб)

Вообще настройки видны при просмотре файлов *.dfm (они тоже текстовые. В старых Делфи (Д3) их можно преобразовывать в текстовые)

Скачать RAR-архив исходников (120 Кб)
Скачать RAR-архив исходников + .exe(350 Кб)