unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Source1: TImage;
    Source2: TImage;
    Button1: TButton;
    Button2: TButton;
    EffectImg: TImage;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Image1Open: TOpenPictureDialog;
    EffectOpen: TOpenPictureDialog;
    Image2Open: TOpenPictureDialog;
    ProgressBar: TProgressBar;
    Label1: TLabel;
    SourceSize: TEdit;
    RemainingTimeLbl: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure CopyF(sc,dc:TCanvas);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

type
 TByteArray=array of byte;
 PByteArray=^TByteArray;

implementation

uses Unit2;

{$R *.dfm}

type TRGBValues=record
 //reserved1, blue, green, red: byte;
 red, green, blue, reserved:byte;
end;

function GetRedValue(c:TColor):byte;
begin
 Result := GetRValue(c);     
end;

function MediumVal(const v1, v2, factor:byte):byte;
begin
 Result := ((v1*Factor)+(v2*(not factor)))div 255;
end;

function SmoothColors(c1, c2:TColor; Factor:byte):TColor;
var v1, v2, r:TRgbValues;
begin
 v1 := TRgbValues(ColorToRgb(c1));
 v2 := TRgbValues(ColorToRgb(c2));
 r.red := MediumVal(v1.red, v2.red, Factor);
 r.green := MediumVal(v1.green, v2.green, Factor);
 r.blue := MediumVal(v1.blue, v2.blue, Factor);
 Result := rgb(r.red, r.green, r.blue);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
 if (Image1Open.Execute) then Source1.Picture.LoadFromFile(Image1Open.FileName);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 if (Image2Open.Execute) then Source2.Picture.LoadFromFile(Image2Open.FileName);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 if EffectOpen.Execute then EffectImg.Picture.LoadFromFile(EffectOpen.FileName);
end;

procedure TForm1.Button4Click(Sender: TObject);
var s1, s2:TBitmap; i,j:word; srect, drect:TRect; s1c, s2c, pc:TColor;
 ds:integer; tstart, tcurr, freq:int64; ls1, ls2, ld, le:^byte; rnum,ep:integer;
begin
 Form2.Show;
 s1 := TBitmap.Create;
 s2 := TBitmap.Create;
 ds := StrToInt(SourceSize.Text)*4;
 s1.Height := ds; s1.Width := ds;
 s2.Height := ds; s2.Width := ds;
 CopyF(Source1.Picture.Bitmap.Canvas, s1.Canvas);
 CopyF(Source2.Picture.Bitmap.Canvas, s2.Canvas);
 Form2.DestImg.Width := ds;
 Form2.DestImg.Height := ds;
 Form2.DestImg.Picture.Bitmap.Height := ds;
 Form2.DestImg.Picture.Bitmap.Width := ds;
 EffectImg.Picture.Bitmap.PixelFormat := pf8bit;
 s1.PixelFormat := pf24bit;
 s2.PixelFormat := pf24bit;
 Form2.DestImg.Picture.Bitmap.PixelFormat := pf24bit;
 ProgressBar.Max := ds;
 QueryPerformanceCounter(tstart);
 QueryPerformanceFrequency(freq);
 for i := 0 to ds-1 do begin
{  for j := 0 to ds-1 do begin
   s1c := s1.Canvas.Pixels[j,i];
   s2c := s2.Canvas.Pixels[j,i];
   pc := EffectImg.Picture.Bitmap.Canvas.Pixels[j,i];
   Form2.DestImg.Picture.Bitmap.Canvas.Pixels[j, i] :=
    SmoothColors(s1c, s2c, GetRedValue(pc));
  end;      }
  ls1 := s1.ScanLine[i];
  ls2 := s2.ScanLine[i];
  ld := Form2.DestImg.Picture.Bitmap.ScanLine[i];
  le := EffectImg.Picture.Bitmap.ScanLine[i];
  rnum := ds*3;
  ep := 0;
  for j := 0 to rnum-1 do begin
   ld^ := ((ls1^)*(le^)+(ls2^)*(not le^)) shr 8;
   if ((j+1) mod 3)=0 then inc(le);
   inc(ls1);
   inc(ls2);
   inc(ld);
  end;

  if (i mod 8)=0 then begin
   ProgressBar.Position := i;
   QueryPerformanceCounter(tcurr);
   RemainingTimeLbl.Caption :=
    FloatToStrF(((tcurr-tstart)/((i+1)*freq))*(ds-i), ffFixed, 6,1);
   Form2.DestImg.Repaint;
   Application.ProcessMessages;
  end;
 end;
 s1.Free;
 s2.Free;
end;

procedure TForm1.CopyF(sc,dc:TCanvas);
var i,j:byte; srect,drect:TRect; s:integer;
begin
 s := StrToInt(SourceSize.Text);
 srect := Rect(0,0,s,s);
 for i := 0 to 3 do begin
  for j := 0 to 3 do begin
   drect := Rect(j*s, i*s, (j*s)+s, (i*s)+s);
   dc.CopyRect(drect, sc, srect);
  end;
 end;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
 Form2.Show;
end;

end.
