unit kompres_window;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  Spin, EditBtn, StdCtrls, FractalImageCompression, IntfGraphics;

type

  KKRecord = record
    RaSize:Word;
    XT:Word;
    YT:Word;
    Transf:Byte;
    ST:Single;
    OT:Single;
  end;
  DKKMatrix   = array of KKRecord;

  { TForm2 }

  TForm2 = class(TForm)
    Button_Komprimuj: TButton;
    FileNameEdit1: TFileNameEdit;
    FileNameEdit2: TFileNameEdit;
    FloatSpinEdit1: TFloatSpinEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    SpinEdit3: TSpinEdit;
    SpinEdit4: TSpinEdit;
    procedure Button_KomprimujClick(Sender: TObject);

  private
    { private declarations }
  public
    { public declarations }
  end; 

var
  Form2: TForm2; 

  KompresOutputFile: File of KKRecord;      //Datovy vystup
  InputImage: TLazIntfImage;   // Obrazky

  OD: Double;
  LS,UseLibrary,UseMinDepth,UseMaxDepth: Integer;
  PathSave, PathLog, PathOpenPicture: String;

  procedure NewLog;
  procedure EndLog;
  procedure SaveOutput;
  procedure LoadPicture;

implementation

{ TForm2 }

{******************************************************************************}
{                              PROCEDURY                                       }//PROCEDURY
{******************************************************************************}

{************************************************************************NEWLOG}
procedure NewLog;
begin
  AssignFile(TextOutput, PathLog);
  try
    Rewrite(TextOutput);
    WriteLn(TextOutput, 'Fractal Image Compression');
    WriteLn(TextOutput, '=========================');
    WriteLn(TextOutput, 'input: ' + PathOpenPicture);
    WriteLn(TextOutput, 'output: ' + PathSave);

    WriteLn(TextOutput, 'ε: ' + FloatToStrF(OD,ffNumber,3,2));
    WriteLn(TextOutput, 'Min.I: ' + IntToStr(UseMinDepth));
    WriteLn(TextOutput, 'Max.I: ' + IntToStr(UseMaxDepth));
    WriteLn(TextOutput, 'D' + IntToStr(UseLibrary) + '; l=' + IntToStr(LS));
    WriteLn(TextOutput, '  ');
    Write(TextOutput, 'Start: ');
    Write(TextOutput, DateToStr(Date));Write(TextOutput, '  ');
    Write(TextOutput, TimeToStr(Time));
    WriteLn(TextOutput, '  '); WriteLn(TextOutput, '  ');
  finally
    CloseFile(TextOutput);
  end;
end;
{************************************************************************ENDLOG}
procedure EndLog;
begin
  AssignFile(TextOutput, PathLog);
  try
    Append(TextOutput);
    WriteLn(TextOutput, '  ');
    Write(TextOutput, 'Finish: ');
    Write(TextOutput, DateToStr(Date));Write(TextOutput, '  ');
    Write(TextOutput, TimeToStr(Time));
    WriteLn(TextOutput, '  '); WriteLn(TextOutput, '  ');
  finally
    CloseFile(TextOutput);
  end;
end;
{********************************************************************SAVEOUTPUT}
procedure SaveOutput;
var i: Integer; MSave:KKRecord;
begin
  AssignFile(KompresOutputFile, PathSave);
  ReWrite(KompresOutputFile);
  for i:=0 to High(KompresMatrix_R) do
  begin
    MSave.RaSize:=KompresMatrix_R[i].RaSize;
    MSave.XT:=KompresMatrix_R[i].XT;
    MSave.YT:=KompresMatrix_R[i].YT;
    MSave.Transf:=KompresMatrix_R[i].Transf;
    MSave.ST:=KompresMatrix_R[i].ST;
    MSave.OT:=KompresMatrix_R[i].OT;
    Write(KompresOutputFile, MSave);
  end;
  if BW=False then
  begin
    for i:=0 to High(KompresMatrix_G) do
    begin
      MSave.RaSize:=KompresMatrix_G[i].RaSize;
      MSave.XT:=KompresMatrix_G[i].XT;
      MSave.YT:=KompresMatrix_G[i].YT;
      MSave.Transf:=KompresMatrix_G[i].Transf;
      MSave.ST:=KompresMatrix_G[i].ST;
      MSave.OT:=KompresMatrix_G[i].OT;
      Write(KompresOutputFile, MSave);
    end;
    for i:=0 to High(KompresMatrix_B) do
    begin
      MSave.RaSize:=KompresMatrix_B[i].RaSize;
      MSave.XT:=KompresMatrix_B[i].XT;
      MSave.YT:=KompresMatrix_B[i].YT;
      MSave.Transf:=KompresMatrix_B[i].Transf;
      MSave.ST:=KompresMatrix_B[i].ST;
      MSave.OT:=KompresMatrix_B[i].OT;
      Write(KompresOutputFile, MSave);
    end;
  end;
  CloseFile(KompresOutputFile);
end;
{*******************************************************************LOADPICTURE}
procedure LoadPicture;
var
  i,j:Integer;
  MemTBip:TBitmap;
begin
    MemTBip:=TBitmap.Create;
    InputImage:=TLazIntfImage.Create(0,0);

    MemTBip.LoadFromFile(PathOpenPicture);
    InputImage.LoadFromBitmap(MemTBip.Handle,MemTBip.MaskHandle);

    BW:=True;
    //Nastaveni velikosti matic
    SetLength(InputImageMatrix_R, InputImage.Width);
    SetLength(InputImageMatrix_G, InputImage.Width);
    SetLength(InputImageMatrix_B, InputImage.Width);
    for i:= 0 to InputImage.Width-1 do
    begin
      SetLength(InputImageMatrix_R[i], InputImage.Width);
      SetLength(InputImageMatrix_G[i], InputImage.Width);
      SetLength(InputImageMatrix_B[i], InputImage.Width);
    end;
    //Nacteni hodnot do matice
    for i:= 0 to InputImage.Width-1 do
    begin
      for j:= 0 to InputImage.Width-1 do
      begin
        InputImageMatrix_R[i,j]:=Red(FPColorToTColor(InputImage.Colors[i,j]));
        InputImageMatrix_G[i,j]:=Green(FPColorToTColor(InputImage.Colors[i,j]));
        InputImageMatrix_B[i,j]:=Blue(FPColorToTColor(InputImage.Colors[i,j]));
        If (InputImageMatrix_R[i,j]<>InputImageMatrix_G[i,j]) and
          (InputImageMatrix_G[i,j]<>InputImageMatrix_B[i,j]) then BW:=False;
      end;
    end;

end;

procedure TForm2.Button_KomprimujClick(Sender: TObject);
var i,k, l: Integer;
    j: Boolean;
begin
  OD:= FloatSpinEdit1.Value;
  UseMinDepth:= SpinEdit1.Value;
  UseMaxDepth:= SpinEdit2.Value;
  UseLibrary:= SpinEdit3.Value;
  LS:= SpinEdit4.Value;
  PathOpenPicture:=FileNameEdit1.FileName;
  PathSave:=FileNameEdit2.FileName;
  PathLog:=FileNameEdit2.FileName + '.log';

  LoadPicture;
  k:=1;
  j:= false;
  for i:= 0 to 30 do
  begin
    k:=k*2;
    if k = (High(InputImageMatrix_B)+1) then begin j:= True; l:= i; end;
  end;
  If j= False then
  begin
    ShowMessage('Rozlišení obrazu pro kompresi musí být 2^n*2^n px');
    exit;
  end;
  if UseMinDepth> UseMaxDepth then
  begin
    ShowMessage('Min.I. nemůže být větší než Max.I.');
    exit;
  end;
  if UseMaxDepth> (l) then
  begin
    ShowMessage('Max.I. nemůže být větší než '+ IntToStr(l));
    exit;
  end;
  NewLog;
  SetLength(KompresMatrix_R, 1);
  with KompresMatrix_R[0] do
  begin
    RaSize:=0;
    XR:=0;
    YR:=0;
    XT:=(High(InputImageMatrix_R)+1);
    YT:=(High(InputImageMatrix_R)+1);
    Transf:=0;
    if BW=True then ST:=1 else ST:=0;
    OT:=0;
  end;
  Progres:=0; PProgres:=0;
  ReKomp(InputImageMatrix_R,KompresMatrix_R, 1, UseMinDepth, UseMaxDepth,0,0,
    UseLibrary,1);

  if BW=False then
  begin
    SetLength(KompresMatrix_G, 1);
    with KompresMatrix_G[0] do
    begin
      RaSize:=0;
      XR:=0;
      YR:=0;
      XT:=(High(InputImageMatrix_G)+1);
      YT:=(High(InputImageMatrix_G)+1);
      Transf:=0;
      ST:=0;
      OT:=0;
    end;
    SetLength(KompresMatrix_B, 1);
    with KompresMatrix_B[0] do
    begin
      RaSize:=0;
      XR:=0;
      YR:=0;
      XT:=(High(InputImageMatrix_B)+1);
      YT:=(High(InputImageMatrix_B)+1);
      Transf:=0;
      ST:=0;
      OT:=0;
    end;
    Progres:=0; PProgres:=0;
    ReKomp(InputImageMatrix_G,KompresMatrix_G, 1, UseMinDepth, UseMaxDepth,0,0,
      UseLibrary,2);
    Progres:=0; PProgres:=0;
    ReKomp(InputImageMatrix_B,KompresMatrix_B, 1, UseMinDepth, UseMaxDepth,0,0,
      UseLibrary,3);
  end;
  EndLog;
  SaveOutput;
  ShowMessage('Komprese proběhla úspěšně!');
end;


initialization
  {$I kompres_window.lrs}

end.

