wavelet_form.pas

jpeg and mpeg 编解码技术源代码

(* Wavelet Kompressor 2.0 (c) 2002 by Daniel Vollmer ([e-mail])

  This program is free software; you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation; either version 2 of the License, or
  (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with this program; if not, write to the Free Software
  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA *)
unit Wavelet_Form;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtDlgs, ExtCtrls, jpeg, wavelet, ComCtrls, Image_Form, Math;

const
  ofs_R = 2;
  ofs_G = 1;
  ofs_B = 0;
type
  ProgressRecord = record
    Bar: TProgressBar;
    CurChannel, MaxChannel: Integer;
  end;
  PProgressRecord = ^ProgressRecord;
  TSettingsSet = Set of (SMaxMSE, SDeltaMSE);
  TChannel = record
    Data, CData: pawv_pel;
    DidYCbCr, IsGreyScale: Boolean;
    Channel: tp_wv_cchannel;
    // settings
    max_mse, delta_mse: Single;
    out_mse: Single;
  end;
  TFormWavelet = class(TForm)
    OpenDialog1: TOpenDialog;
    GroupBoxInput: TGroupBox;
    ButtonLoad: TButton;
    CheckBoxGreyScale: TCheckBox;
    CheckBoxYCbCr: TCheckBox;
    GroupBoxChannels: TGroupBox;
    TreeViewChannels: TTreeView;
    ButtonClear: TButton;
    PageControlSettings: TPageControl;
    TabSheetQuality: TTabSheet;
    TabSheetSize: TTabSheet;
    CheckBoxStayOnTop: TCheckBox;
    ProgressBar1: TProgressBar;
    GroupBoxCompression: TGroupBox;
    ButtonKompress: TButton;
    GroupBoxQuality: TGroupBox;
    TrackBarPSNR: TTrackBar;
    EditPSNR: TEdit;
    EditBits: TEdit;
    Label1: TLabel;
    EditKiloBytes: TEdit;
    EditBPP: TEdit;
    GroupBox1: TGroupBox;
    EditSizeBPP: TEdit;
    TrackBarSizeBPP: TTrackBar;
    EditSizeSize: TEdit;
    UpDownSize: TUpDown;
    Label4: TLabel;
    Label5: TLabel;
    GroupBox2: TGroupBox;
    Label6: TLabel;
    TrackBarDeltaMSE: TTrackBar;
    EditDeltaMSE: TEdit;
    Label7: TLabel;
    EditMSE: TEdit;
    EditOutPSNR: TEdit;
    EditOutRMSE: TEdit;
    EditOutMSE: TEdit;
    Label10: TLabel;
    CheckBoxSave: TCheckBox;
    SaveDialog1: TSaveDialog;
    procedure ButtonLoadClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure CheckBoxGreyScaleClick(Sender: TObject);
    procedure TreeViewChannelsChange(Sender: TObject; Node: TTreeNode);
    procedure CheckBoxStayOnTopClick(Sender: TObject);
    procedure ButtonClearClick(Sender: TObject);
    procedure TrackBarPSNRChange(Sender: TObject);
    procedure ButtonKompressClick(Sender: TObject);
    procedure TrackBarSizeBPPChange(Sender: TObject);
    procedure UpDownSizeChangingEx(Sender: TObject;
      var AllowChange: Boolean; NewValue: Smallint;
      Direction: TUpDownDirection);
    procedure TrackBarDeltaMSEChange(Sender: TObject);
  private
    { Private-Deklarationen }
    FormImage, FormCImage: TFormImage;
    ImageWidth, ImageHeight, NWidth, NHeight: Integer;
    ScrollBarX, ScrollBarY: Integer;
    NumChannels: Integer;
    Channels: array[0..wv_MAX_CHANNELS - 1] of TChannel;
    ReorderTable: tp_reorder_table;
    NumBlocks: Integer;
    MaxSizeTrack: Integer;
    ProgRec: ProgressRecord;
    function GetBitmapChannel(NWidth, NHeight: Integer; Channel: Integer; SourceImage: TBitmap) : pawv_pel;
    procedure ApplySettings(t: TSettingsSet; var c: TChannel);
    procedure LoadSourceImage(const Name: TFileName; Greyscale, YCbCr: Boolean);
    procedure EnableUI();
    procedure DisableUI();
  public
    { Public-Deklarationen }
  end;

var
  FormWavelet: TFormWavelet;

procedure wv_progress(Current, Maximum: Integer; UserData: Pointer); cdecl;

implementation

procedure wv_progress(Current, Maximum: Integer; UserData: Pointer); cdecl;
var
  pr: PProgressRecord;
  ofs : Integer;
begin
  if (UserData <> Nil) then begin
    pr := PProgressRecord(UserData);
    ofs := (pr^.CurChannel * pr^.Bar.Max) div pr^.MaxChannel;
    pr^.Bar.Position := ofs + (Current * pr^.Bar.Max) div (pr^.MaxChannel * Maximum);
    FormWavelet.Update();
    Application.ProcessMessages();
  end;
end;

{$R *.DFM}

procedure TFormWavelet.ButtonLoadClick(Sender: TObject);
begin
  if (((NumChannels  + 1 <= wv_MAX_CHANNELS) and CheckBoxGreyScale.Checked) or ((NumChannels + 3 <= wv_MAX_CHANNELS) and not CheckBoxGreyScale.Checked)) then begin
    if (OpenDialog1.Execute()) then
      LoadSourceImage(OpenDialog1.FileName, CheckBoxGreyScale.Checked, CheckBoxYCbCr.Checked);
  end else
    MessageDlg('Not enough free channels!', mtError, [mbOK], 0);
end;

procedure TFormWavelet.FormCreate(Sender: TObject);
var
  tf: TFormImage;
  i: Integer;
begin
  for i := 0 to wv_MAX_CHANNELS - 1 do with Channels[i] do begin
    Data := Nil;
    CData := Nil;
    Channel := Nil;
  end;
  ImageWidth := 0;
  ImageHeight := 0;
  NumChannels := 0;
  NumBlocks := 0;
  ReorderTable := Nil;
  FormImage := TFormImage.Create(self);
  FormImage.Caption := 'Original Image';
  FormCImage := TFormImage.Create(self);
  FormCImage.Caption := 'Compressed Image';

  MaxSizeTrack := TrackBarSizeBPP.Max;
  TrackBarSizeBPPChange(TrackBarSizeBPP);
  TrackBarDeltaMSEChange(TrackBarDeltaMSE);
  TrackBarPSNRChange(TrackBarPSNR);

  // get size of scrollbars
  tf := TFormImage.Create(self);
  tf.Image.Width := 100;
  tf.Image.Height := 100;
  tf.FormStyle := fsNormal;
  tf.AutoSize := true;
  tf.Image.Stretch := true;

  tf.ClientWidth := 10;
  tf.ClientHeight := 10;
  ScrollBarX := tf.Width - tf.ClientWidth;
  ScrollBarY := tf.Height - tf.ClientHeight;
  tf.Free();
end;

procedure TFormWavelet.FormDestroy(Sender: TObject);
var
  i: Integer;
begin
  if (FormImage <> Nil) then
    FormImage.Free();
  if (FormCImage <> Nil) then
    FormCImage.Free();
  for i := 0 to NumChannels - 1 do with Channels[i] do begin
    if (Data <> Nil) then
      FreeMem(Data);
    if (CData <> Nil) then
      FreeMem(CData);
    if (Channel <> Nil) then
      wv_done_channel(Channel, Integer(i = 0));
  end;
end;

procedure TFormWavelet.EnableUI();
begin
  ButtonKompress.Enabled := NumChannels > 0;
  ButtonLoad.Enabled := NumChannels < wv_MAX_CHANNELS;
  ButtonClear.Enabled := True;
end;

procedure TFormWavelet.DisableUI();
begin
  ButtonKompress.Enabled := False;
  ButtonLoad.Enabled := False;
  ButtonClear.Enabled := False;
end;

function TFormWavelet.GetBitmapChannel(NWidth, NHeight: Integer; Channel: Integer; SourceImage: TBitmap) : pawv_pel;
var
  x, y: Integer;
  row: PByteArray;
  Data: pawv_pel;
begin
  GetMem(Data, NHeight * NWidth * SizeOf(wv_pel));
  for y := 0 to SourceImage.Height - 1 do begin
    row := SourceImage.ScanLine[y];
    case (Channel) of
     -1: for x := 0 to SourceImage.Width - 1 do Data[y * NWidth + x] := (Integer(row[x * 3 + ofs_R]) * 19595 + Integer(row[x * 3 + ofs_G]) * 38470 + Integer(row[x * 3 + ofs_B]) * 7471 + 32768) shr 16;
      0: for x := 0 to SourceImage.Width - 1 do Data[y * NWidth + x] := row[x * 3 + 2]; // red
      1: for x := 0 to SourceImage.Width - 1 do Data[y * NWidth + x] := row[x * 3 + 1]; // green
      2: for x := 0 to SourceImage.Width - 1 do Data[y * NWidth + x] := row[x * 3 + 0]; // blue
    end;
  end;
  // extend the channel, so that we don't have ugly discontinuities
  for y := 0 to SourceImage.Height - 1 do
    for x := SourceImage.Width to NWidth - 1 do
      Data[y * NWidth + x] := Data[y * NWidth + SourceImage.Width - 1];
  for y := SourceImage.Height to NHeight - 1 do
    Move(Data[(SourceImage.Height - 1) * NWidth], Data[y * NWidth], SizeOf(wv_pel) * NWidth);
  Result := Data;
end;

procedure TFormWavelet.ApplySettings(t: TSettingsSet; var c: TChannel);
begin
  if (SMaxMSE in t) then begin
    if (TrackBarPSNR.Position = TrackBarPSNR.Min) then
      c.max_mse := 0.0
    else
      c.max_mse := psnr_to_mse((TrackBarPSNR.Max - TrackBarPSNR.Position) / TrackBarPSNR.PageSize);
  end;
  if (SDeltaMSE in t) then begin
    c.delta_mse := (TrackBarDeltaMSE.Position - TrackBarDeltaMSE.Max div 2) / 1000.0;
  end;
end;

procedure TFormWavelet.LoadSourceImage(const Name: TFileName; Greyscale, YCbCr: Boolean);
const
  channel_names : array[False..True, 0..wv_MAX_CHANNELS - 1] of String = (('R', 'G', 'B', 'A', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '10', '11'),
    ('Y', 'Cb', 'Cr', 'A', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '10', '11'));
var
  temp: TPicture;
  node: TTreeNode;
  i: Integer;
  y, cb, cr: pawv_pel;
  bf: tp_bit_file;
  is_ycbcr: Boolean;
  dc: tp_wv_dchannels;
  old_num_channels: Integer;
  SourceImage: TBitmap;
  max_bits: Integer;
  pal: array[0..255] of RGBQUAD;
  num_pal: Word;
begin
  SourceImage := Nil;
  DisableUI();
  old_num_channels := NumChannels;
  node := Nil;
  if (AnsiCompareFileName(ExtractFileExt(Name), '.WKO') = 0) then begin
    bf := bit_open(PChar(Name), 'rb', 0);
    if (bf <> Nil) then begin
      is_ycbcr := bit_read(1, bf) <> 0;
      dc := wv_init_decode_channels(bf);
      if (dc <> Nil) then begin
        if ((NumChannels + dc^.num_channels <= wv_MAX_CHANNELS) and
          (((ImageWidth = 0) and (ImageHeight = 0)) or ((ImageWidth = dc^.owidth) and (ImageHeight = dc^.oheight)))) then begin
          ImageWidth := dc^.owidth;
          ImageHeight := dc^.oheight;
          NWidth := 1 shl (log2i(ImageWidth - 1));
          NHeight := 1 shl (log2i(ImageHeight - 1)); // expand to this size
          GroupBoxChannels.Caption := 'Channels: ' + IntToStr(ImageWidth) + 'x' + IntToStr(ImageHeight);
          YCbCr := YCbCr and (dc^.num_channels >= 3);
          node := TreeViewChannels.Items.AddObject(Nil, Name, Pointer(NumChannels shl 16)); // add to TreeView
          for i := NumChannels to NumChannels + dc^.num_channels - 1 do with Channels[i] do begin
            TreeViewChannels.Items.AddChildObject(node, channel_names[YCbCr, i - NumChannels], Pointer((NumChannels shl 16) + (i - NumChannels)));
            DidYCbCr := YCbCr and (i - NumChannels < 3);
            IsGreyScale := (dc^.num_channels < 3) or (i - NumChannels >= 3);
            GetMem(Data, dc^.width * dc^.height * SizeOf(wv_pel));
            Move(dc^.channels^[i - NumChannels]^, Data^, dc^.width * dc^.height * SizeOf(wv_pel));
            ApplySettings([SMaxMSE, SDeltaMSE], Channels[i]);
          end;
          if ((not is_ycbcr) and YCbCr and (dc^.num_channels >= 3)) then begin
            GetMem(Y, NWidth * NHeight * SizeOf(wv_pel));
            GetMem(Cb, NWidth * NHeight * SizeOf(wv_pel));
            GetMem(Cr, NWidth * NHeight * SizeOf(wv_pel));
            wv_rgb_to_ycbcr(NWidth * NHeight, Channels[NumChannels].Data, Channels[NumChannels + 1].Data,
              Channels[NumChannels + 2].Data, Y, Cb, Cr);
            FreeMem(Channels[NumChannels].Data);
            Channels[NumChannels].Data := Y;
            FreeMem(Channels[NumChannels + 1].Data);
            Channels[NumChannels + 1].Data := Cb;
            FreeMem(Channels[NumChannels + 2].Data);
            Channels[NumChannels + 2].Data := Cr;
          end;
          Inc(NumChannels, dc^.num_channels);
        end else
          MessageDlg('Image dimensions do not match!', mtError, [mbOK], 0);
        wv_done_decode_channels(dc);
      end;
      bit_close(bf, Nil);
    end;
  end else begin
    temp := Nil;
    try
      temp := TPicture.Create();
      temp.LoadFromFile(Name);
      if (((ImageWidth = 0) and (ImageHeight = 0)) or ((ImageWidth = temp.Width) and (ImageHeight = temp.Height))) then begin
        SourceImage := TBitmap.Create();
        SourceImage.PixelFormat := pf24bit;
        SourceImage.Width := temp.Width;
        SourceImage.Height := temp.Height;
        if (not Greyscale) then begin
          if (temp.Graphic is TJPEGImage) then
            Greyscale := (temp.Graphic as TJPEGImage).Grayscale;
          if ((temp.Graphic is TBitmap) and ((temp.Graphic as TBitmap).PixelFormat = pf8Bit)) then begin // check whether palette is all-grey
            num_pal := 0;
            GetObject((temp.Graphic as TBitmap).Palette, SizeOf(num_pal), @num_pal);
            GetDIBColorTable((temp.Graphic as TBitmap).Canvas.Handle, 0, num_pal, pal);

            Greyscale := True;
            for i := 0 to num_pal - 1 do
              if ((pal[i].rgbRed <> pal[i].rgbGreen) or (pal[i].rgbGreen <> pal[i].rgbBlue)) then
                Greyscale := False;
          end;
        end;
        SourceImage.Canvas.Draw(0, 0, temp.Graphic);
      end else
        MessageDlg('Image dimensions do not match!', mtError, [mbOK], 0);
      temp.Free();
    except
      on EInvalidGraphic do begin
        temp.Free();
        MessageDlg('Unknown image format!', mtError, [mbOK], 0);
      end;
    end;
    if (SourceImage <> Nil) then begin
      ImageWidth := SourceImage.Width;
      ImageHeight := SourceImage.Height;
      NWidth := 1 shl (log2i(ImageWidth - 1));
      NHeight := 1 shl (log2i(ImageHeight - 1)); // expand to this size
      GroupBoxChannels.Caption := 'Channels: ' + IntToStr(ImageWidth) + 'x' + IntToStr(ImageHeight);
      // now convert it from SourceImage into channels
      if (Greyscale) then begin
        node := TreeViewChannels.Items.AddObject(Nil, Name, Pointer(NumChannels shl 16)); // add to TreeView
        TreeViewChannels.Items.AddChildObject(node, channel_names[True, 0], Pointer(NumChannels shl 16)); // add to TreeView
        Channels[NumChannels].DidYCbCr := False;
        Channels[NumChannels].IsGreyScale := True;
        Channels[NumChannels].Data := GetBitmapChannel(NWidth, NHeight, -1, SourceImage);
        Inc(NumChannels);
      end else begin
        node := TreeViewChannels.Items.AddObject(Nil, Name, Pointer(NumChannels shl 16)); // add to TreeView
        for i := NumChannels to NumChannels + 2 do with Channels[i] do begin
          TreeViewChannels.Items.AddChildObject(node, channel_names[YCbCr, i - NumChannels], Pointer((NumChannels shl 16) + (i - NumChannels)));
          DidYCbCr := YCbCr;
          IsGreyScale := False;
          Data := GetBitmapChannel(NWidth, NHeight, i - NumChannels, SourceImage);
          ApplySettings([SMaxMSE, SDeltaMSE], Channels[i]);
        end;
        if (YCbCr) then begin
          GetMem(Y, NWidth * NHeight * SizeOf(wv_pel));