www.pudn.com > Delphi_VC_JPEG2000.rar > Wavelet_Form.pas
(* Wavelet Kompressor 2.0 (c) 2002 by Daniel Vollmer (maven@maven.de)
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));
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, 3);
end;
SourceImage.Free();
end;
end;
if (node <> Nil) then
TreeViewChannels.Selected := node; // and display
TrackBarSizeBPPChange(TrackBarSizeBPP);
ProgRec.Bar := ProgressBar1;
ProgRec.MaxChannel := NumChannels - old_num_channels;
if (PageControlSettings.ActivePage = TabSheetQuality) then
max_bits := 0
else
max_bits := (Int64(NumChannels) * Int64(ImageWidth) * Int64(ImageHeight) * Int64(TrackBarSizeBPP.Position)) div Int64(1000);
for i := old_num_channels to NumChannels - 1 do with Channels[i] do begin // initialise the new channels
ProgRec.CurChannel := i - old_num_channels;
Channel := wv_init_channel(ImageWidth, ImageHeight, Data, max_bits, 0, NumBlocks, ReorderTable, @wv_progress, @ProgRec);
if (Channel = Nil) then
break; // abort loop if we quit
end;
EnableUI();
end;
procedure TFormWavelet.CheckBoxGreyScaleClick(Sender: TObject);
begin
CheckBoxYCbCr.Enabled := not CheckBoxGreyScale.Checked;
end;
procedure TFormWavelet.TreeViewChannelsChange(Sender: TObject; Node: TTreeNode);
var
idx, subidx: Integer;
row: PByteArray;
x, y: Integer;
r, g, b: pawv_pel;
SourceImage: TBitmap;
did_cstats: Boolean;
mse: Single;
begin
if (Node = Nil) then
Exit;
did_cstats := False;
idx := Integer(Node.Data) shr 16;
subidx := Integer(Node.Data) and $ffff;
if (idx + subidx < NumChannels) then begin
SourceImage := TBitmap.Create();
SourceImage.PixelFormat := pf24bit;
SourceImage.Width := ImageWidth;
SourceImage.Height := ImageHeight;
if ((Node.Parent = Nil) and not (Channels[idx].IsGreyScale)) then begin // got a group (rgb or yuv)
if (Channels[idx].DidYCbCr) then begin
GetMem(r, NWidth * NHeight * SizeOf(wv_pel));
GetMem(g, NWidth * NHeight * SizeOf(wv_pel));
GetMem(b, NWidth * NHeight * SizeOf(wv_pel));
wv_ycbcr_to_rgb(NWidth * NHeight, Channels[idx].Data, Channels[idx + 1].Data,
Channels[idx + 2].Data, r, g, b);
end else begin
r := Channels[idx + 0].Data;
g := Channels[idx + 1].Data;
b := Channels[idx + 2].Data;
end;
end else begin // grey
if (Channels[idx + subidx].max_mse = 0.0) then
TrackBarPSNR.Position := TrackBarPSNR.Min
else
TrackBarPSNR.Position := TrackBarPSNR.Max - Round(TrackBarPSNR.PageSize * mse_to_psnr(Channels[idx + subidx].max_mse));
TrackBarDeltaMSE.Position := TrackBarDeltaMSE.Max div 2 + Round(Channels[idx + subidx].delta_mse * 1000.0);
if (Channels[idx + subidx].CData <> Nil) then begin
did_cstats := True;
EditOutRMSE.Text := Format('%7.3f', [Sqrt(Channels[idx + subidx].out_mse)]);
EditOutMSE.Text := Format('%7.3f', [Channels[idx + subidx].out_mse]);
if (Channels[idx + subidx].out_mse = 0.0) then
EditOutPSNR.Text := 'lossless'
else
EditOutPSNR.Text := Format('%7.3f', [mse_to_psnr(Channels[idx + subidx].out_mse)]);
end;
r := Channels[idx + subidx].Data;
g := Channels[idx + subidx].Data;
b := Channels[idx + subidx].Data;
end;
for y := 0 to ImageHeight - 1 do begin
row := SourceImage.ScanLine[y];
for x := 0 to ImageWidth - 1 do begin
row[x * 3 + ofs_R] := Min(255, Max(0, r[y * NWidth + x]));
row[x * 3 + ofs_G] := Min(255, Max(0, g[y * NWidth + x]));
row[x * 3 + ofs_B] := Min(255, Max(0, b[y * NWidth + x]));
end;
end;
if (not did_cstats) then begin
mse := 0.0;
x := 0;
for y := 0 to NumChannels - 1 do if (Channels[y].CData <> Nil) then begin
mse := mse + Channels[y].out_mse;
Inc(x);
end;
if (x > 0) then begin
mse := mse / x;
EditOutRMSE.Text := Format('%7.3f', [Sqrt(mse)]);
EditOutMSE.Text := Format('%7.3f', [mse]);
if (mse = 0.0) then
EditOutPSNR.Text := 'lossless'
else
EditOutPSNR.Text := Format('%7.3f', [mse_to_psnr(mse)]);
end else begin
EditOutRMSE.Text := '';
EditOutMSE.Text := '';
EditOutPSNR.Text := '';
end;
end;
FormImage.Constraints.MaxWidth := ImageWidth + ScrollBarX;
FormImage.Constraints.MaxHeight := ImageHeight + ScrollBarY;
FormImage.Image.Width := ImageWidth;
FormImage.Image.Height := ImageHeight;
FormImage.Image.Picture.Bitmap := SourceImage;
FormImage.Visible := True;
if (Channels[idx].CData <> Nil) then begin // now for compressed image
if ((Node.Parent = Nil) and not (Channels[idx].IsGreyScale)) then begin // got a group (rgb or yuv)
if (Channels[idx].DidYCbCr) then begin
wv_ycbcr_to_rgb(NWidth * NHeight, Channels[idx].CData, Channels[idx + 1].CData,
Channels[idx + 2].CData, r, g, b);
end else begin
r := Channels[idx + 0].CData;
g := Channels[idx + 1].CData;
b := Channels[idx + 2].CData;
end;
end else begin
r := Channels[idx + subidx].CData;
g := Channels[idx + subidx].CData;
b := Channels[idx + subidx].CData;
end;
for y := 0 to ImageHeight - 1 do begin
row := SourceImage.ScanLine[y];
for x := 0 to ImageWidth - 1 do begin
row[x * 3 + ofs_R] := Min(255, Max(0, r[y * NWidth + x]));
row[x * 3 + ofs_G] := Min(255, Max(0, g[y * NWidth + x]));
row[x * 3 + ofs_B] := Min(255, Max(0, b[y * NWidth + x]));
end;
end;
FormCImage.Constraints.MaxWidth := ImageWidth + ScrollBarX;
FormCImage.Constraints.MaxHeight := ImageHeight + ScrollBarY;
FormCImage.Image.Width := ImageWidth;
FormCImage.Image.Height := ImageHeight;
FormCImage.Image.Picture.Bitmap := SourceImage;
FormCImage.Visible := True;
end;
if ((Node.Parent = Nil) and Channels[idx].DidYCbCr) then begin
FreeMem(r);
FreeMem(g);
FreeMem(b);
end;
SourceImage.Free();
end;
end;
procedure TFormWavelet.CheckBoxStayOnTopClick(Sender: TObject);
begin
if (CheckBoxStayOnTop.Checked) then
FormStyle := fsStayOnTop
else
FormStyle := fsNormal;
end;
procedure TFormWavelet.ButtonClearClick(Sender: TObject);
var
i: Integer;
begin
for i := 0 to NumChannels - 1 do with Channels[i] do begin
if (Data <> Nil) then
FreeMem(Data);
if (CData <> Nil) then
FreeMem(CData);
wv_done_channel(Channel, Integer(i = 0));
Data := Nil;
CData := Nil;
Channel := Nil;
end;
NumChannels := 0;
NWidth := 0;
NHeight := 0;
ImageWidth := 0;
ImageHeight := 0;
ReorderTable := Nil;
NumBlocks := 0;
TrackBarSizeBPPChange(TrackBarSizeBPP);
TreeViewChannels.Items.Clear();
FormImage.Visible := False;
FormImage.Image.Picture := Nil;
FormCImage.Visible := False;
FormCImage.Image.Picture := Nil;
ButtonKompress.Enabled := False;
GroupBoxChannels.Caption := 'Channels:';
EditBits.Clear();
EditKiloBytes.Clear();
EditBPP.Clear();
EditOutPSNR.Clear();
EditOutMSE.Clear();
EditOutRMSE.Clear();
end;
procedure TFormWavelet.TrackBarPSNRChange(Sender: TObject);
var
idx, subidx: Integer;
begin
if (Sender is TTrackBar) then begin
if ((Sender as TTrackBar).Position = (Sender as TTrackBar).Min) then begin
EditPSNR.Text := 'lossless';
EditMSE.Text := Format('%7.3f', [0.0]);
end else begin
EditPSNR.Text := Format('%7.3f', [((Sender as TTrackBar).Max - (Sender as TTrackBar).Position) / (Sender as TTrackBar).PageSize]);
EditMSE.Text := Format('%7.3f', [Sqrt(psnr_to_mse(((Sender as TTrackBar).Max - (Sender as TTrackBar).Position) / (Sender as TTrackBar).PageSize))]);
end;
if (TreeViewChannels.Selected <> Nil) then begin
idx := Integer(TreeViewChannels.Selected.Data) shr 16;
subidx := Integer(TreeViewChannels.Selected.Data) and $ffff;
if ((TreeViewChannels.Selected.Parent = Nil) and not (Channels[idx].IsGreyScale)) then begin // got a group (rgb or yuv)
ApplySettings([SMaxMSE], Channels[idx + 0]);
ApplySettings([SMaxMSE], Channels[idx + 1]);
ApplySettings([SMaxMSE], Channels[idx + 2]);
end else begin
ApplySettings([SMaxMSE], Channels[idx + subidx]);
end;
end;
end;
end;
procedure TFormWavelet.ButtonKompressClick(Sender: TObject);
var
ChPar: array[0..wv_MAX_CHANNELS - 1] of t_wv_mchannel_params;
Sets: array[0..wv_MAX_CHANNELS - 1] of tp_wv_csettings;
i, bits: Integer;
bf: tp_bit_file;
mem: PByteArray;
dc: tp_wv_dchannels;
MaxBits: Integer;
fname: String;
save_as_bmp: Boolean;
begin
for i := 0 to wv_MAX_CHANNELS - 1 do
Sets[i] := Nil;
EditBits.Text := '';
EditKiloBytes.Text := '';
EditBPP.Text := '';
EditOutPSNR.Text := '';
EditOutMSE.Text := '';
EditOutRMSE.Text := '';
if (NumChannels > 0) then begin
if (PageControlSettings.ActivePage = TabSheetQuality) then begin
for i := 0 to NumChannels - 1 do begin
ChPar[i].cc := Channels[i].Channel;
ChPar[i].max_mse := Channels[i].max_mse;
end;
bits := wv_init_multi_channels(0, 1.0, NumChannels, @ChPar, @Sets);
end else begin
for i := 0 to NumChannels - 1 do begin
ChPar[i].cc := Channels[i].Channel;
ChPar[i].max_mse := Sqr(Sqr(Channels[i].delta_mse));
if (Channels[i].delta_mse > 0.0) then
ChPar[i].max_mse := -ChPar[i].max_mse; // reverse sign
end;
MaxBits := (Int64(NumChannels) * Int64(ImageWidth) * Int64(ImageHeight) * Int64(TrackBarSizeBPP.Position)) div Int64(1000);
bits := wv_init_multi_channels(MaxBits, 0.0, NumChannels, @ChPar, @Sets);
end;
if (bits > 0) then begin
bf := Nil;
fname := '';
save_as_bmp := False;
if (CheckBoxSave.Checked and SaveDialog1.Execute()) then begin
fname := SaveDialog1.FileName;
save_as_bmp := AnsiCompareFileName(ExtractFileExt(fname), '.BMP') = 0;
end;
if ((fname <> '') and (not save_as_bmp)) then begin
bf := bit_open(PChar(fname), 'wb', 0);
if (bf = Nil) then
fname := '';
end;
if (bf = Nil) then
bf := bit_open(Nil, 'wm', wv_MAX_HEADER_SIZE + bits);
if (bf <> Nil) then begin
bit_write(Integer(Channels[0].DidYCbCr), 1, bf);
wv_encode_channels(NumChannels, @Sets, bf);
mem := Nil;
bits := bit_close(bf, @mem);
if (mem <> Nil) then
bf := bit_open(Pointer(mem), 'rm', bits) // open from mem
else
bf := bit_open(PChar(fname), 'rb', bits);
bit_read(1, bf); // skip YCbCr flag
dc := wv_init_decode_channels(bf);
if (dc <> Nil) then begin
for i := 0 to NumChannels - 1 do with Channels[i] do begin
if (CData <> Nil) then
FreeMem(CData);
GetMem(CData, dc^.width * dc^.height * SizeOf(wv_pel));
Move(dc^.channels^[i]^, CData^, dc^.width * dc^.height * SizeOf(wv_pel));
wv_calc_psnr(Data, CData, ImageWidth, ImageHeight, NWidth, out_mse);
end;
wv_done_decode_channels(dc);
EditBits.Text := IntToStr(bits);
EditKiloBytes.Text := Format('%7.3f', [bits / 8192.0]);
EditBPP.Text := Format('%7.3f', [bits / (NumChannels * ImageWidth * ImageHeight)]);
TreeViewChannelsChange(Self, TreeViewChannels.Selected);
if ((fname <> '') and save_as_bmp) then
FormCImage.Image.Picture.SaveToFile(fname);
end;
bit_close(bf, Pointer(mem)); // frees the pointer
end;
end;
for i := 0 to NumChannels - 1 do
if (Sets[i] <> Nil) then
wv_done_channel_settings(Sets[i]);
end;
end;
procedure TFormWavelet.TrackBarSizeBPPChange(Sender: TObject);
begin
if (Sender is TTrackBar) then begin
EditSizeBPP.Text := Format('%.3f', [(Sender as TTrackBar).Position / 1000.0]);
EditSizeSize.Text := Format('%.3f', [(Int64(NumChannels) * Int64(ImageWidth) * Int64(ImageHeight) * Int64((Sender as TTrackBar).Position)) / (1024.0 * 1000.0 * 8.0)]);
end;
end;
procedure TFormWavelet.UpDownSizeChangingEx(Sender: TObject;
var AllowChange: Boolean; NewValue: Smallint;
Direction: TUpDownDirection);
begin
if ((NewValue < TrackBarSizeBPP.Min) or (NewValue > TrackBarSizeBPP.Max)) then
AllowChange := False
else
TrackBarSizeBPP.Max := MaxSizeTrack shr NewValue;
end;
procedure TFormWavelet.TrackBarDeltaMSEChange(Sender: TObject);
var
idx, subidx: Integer;
d: Single;
begin
if (Sender is TTrackBar) then begin
d := ((Sender as TTrackBar).Position - (Sender as TTrackBar).Max div 2) / 1000.0;
if (d < 0) then
d := -Sqr(d)
else
d := Sqr(d);
EditDeltaMSE.Text := Format('%6.3f', [d]);
if (TreeViewChannels.Selected <> Nil) then begin
idx := Integer(TreeViewChannels.Selected.Data) shr 16;
subidx := Integer(TreeViewChannels.Selected.Data) and $ffff;
if ((TreeViewChannels.Selected.Parent = Nil) and not (Channels[idx].IsGreyScale)) then begin // got a group (rgb or yuv)
ApplySettings([SDeltaMSE], Channels[idx + 0]);
ApplySettings([SDeltaMSE], Channels[idx + 1]);
ApplySettings([SDeltaMSE], Channels[idx + 2]);
end else begin
ApplySettings([SDeltaMSE], Channels[idx + subidx]);
end;
end;
end;
end;
end.