Merging Two Delphi units into one uni

Question

I having one Project to create Watter Bubble in TImage Component of TMainForm. Here is the code:

unit KoushikHalder01;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Math, Vcl.ExtCtrls, Vcl.Imaging.pngimage, WaterEffect;

type
  TMainform = class(TForm)
    Image01: TImage;
    Timer01: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer01Timer(Sender: TObject);
    procedure Image01MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
    Water: TWaterEffect;
    Bmp: TBitmap;
  public
    { Public declarations }
  end;

var
  Mainform: TMainform;

implementation

{$R *.dfm}

procedure TMainform.FormCreate(Sender: TObject);
begin
  Bmp := TBitmap.Create;
  Bmp.Assign(Image01.Picture.Graphic);
  Image01.Picture.Graphic := nil;
  Image01.Picture.Bitmap.Height := Bmp.Height;
  Image01.Picture.Bitmap.Width := Bmp.Width;
  Water := TWaterEffect.Create;
  Water.SetSize(Bmp.Width,Bmp.Height);
end;

procedure TMainform.FormDestroy(Sender: TObject);
begin
  Bmp.Free;
  Water.Free;
end;

procedure TMainform.Image01MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Water.Blob(x,y,1,100);
end;

procedure TMainform.Timer01Timer(Sender: TObject);
begin
  if Random(8) = 1 then
    Water.Blob(-1, -1, Random(1) + 1, Random(500) + 50);
  Water.Render(Bmp, Image01.Picture.Bitmap);
  Image01.Repaint;
end;

end.

In my project I am having another unit named as "WaterEffect" and the code for the same is:

unit WaterEffect;

interface

uses
  Windows, SysUtils, Graphics, Math;

const
  csDefDamping = 20;

type
  PIntArray = ^TIntArray;
  TIntArray = array[0..65535] of Integer;
  PPIntArray = ^TPIntArray;
  TPIntArray = array[0..65535] of PIntArray;
  PRGBArray = ^TRGBArray;
  TRGBArray = array[0..65535] of TRGBTriple;
  PPRGBArray = ^TPRGBArray;
  TPRGBArray = array[0..65535] of PRGBArray;
  TWaterDamping = 1..99;
  TWaterEffect = class(TObject)
  private
    { Private declarations }
    FLightModifier: Integer;
    FWidth: Integer;
    FHeight: Integer;
    FBuff1: Pointer;
    FBuff2: Pointer;
    FScanLine1: PPIntArray;
    FScanLine2: PPIntArray;
    FScanLineSrc: PPRGBArray;
    FDamping: TWaterDamping;
    procedure SetDamping(Value: TWaterDamping);
  protected
    { Protected declarations }
    procedure CalcWater;
    procedure DrawWater(ALightModifier: Integer; Src, Dst: TBitmap);
  public
    { Public declarations }
    constructor Create;
    destructor Destroy; override;
    procedure ClearWater;
    procedure SetSize(AWidth, AHeight: Integer);
    procedure Render(Src, Dst: TBitmap);
    procedure Blob(x, y: Integer; ARadius, AHeight: Integer);
    property Damping: TWaterDamping read FDamping write SetDamping;
  end;

implementation

{ WaterEffect }

const
  RAND_MAX = $7FFF;

procedure TWaterEffect.Blob(x, y: Integer; ARadius, AHeight: Integer);
var
  Rquad: Integer;
  cx, cy, cyq: Integer;
  Left, Top, Right, Bottom: Integer;
begin
  if (x < 0) or (x > FWidth - 1) then x := 1 + ARadius + Random(RAND_MAX) mod (FWidth - 2 * ARadius - 1);
  if (y < 0) or (y > FHeight - 1) then y := 1 + ARadius + Random(RAND_MAX) mod (FHeight - 2 * ARadius - 1);
  Left := -Min(x, ARadius);
  Right := Min(FWidth - 1 - x, ARadius);
  Top := -Min(y, ARadius);
  Bottom := Min(FHeight - 1 - y, ARadius);
  Rquad := ARadius * ARadius;
  for cy := Top to Bottom do
  begin
    cyq := cy * cy;
    for cx := Left to Right do
    begin
      if (cx * cx + cyq <= Rquad) then
      begin
        Inc(FScanLine1[cy + y][cx + x], AHeight);
      end;
    end;
  end;
end;

procedure TWaterEffect.CalcWater;
var
  x, y, xl, xr: Integer;
  NewH: Integer;
  P, P1, P2, P3: PIntArray;
  PT: Pointer;
  Rate: Integer;
begin
  Rate := (100 - FDamping) * 256 div 100;
  for y := 0 to FHeight - 1 do
  begin
    P := FScanLine2[y];
    P1 := FScanLine1[Max(y - 1, 0)];
    P2 := FScanLine1[y];
    P3 := FScanLine1[Min(y + 1, FHeight - 1)];
    for x := 0 to FWidth - 1 do
    begin
      xl := Max(x - 1, 0);
      xr := Min(x + 1, FWidth - 1);
      NewH := (P1[xl] + P1[x] + P1[xr] + P2[xl] + P2[xr] + P3[xl] + P3[x] + P3[xr]) div 4 - P[x];
      P[x] := NewH * Rate div 256;
    end;
  end;
  PT := FBuff1;
  FBuff1 := FBuff2;
  FBuff2 := PT;
  PT := FScanLine1;
  FScanLine1 := FScanLine2;
  FScanLine2 := PT;
end;

procedure TWaterEffect.ClearWater;
begin
 if FBuff1 <> nil then ZeroMemory(FBuff1, (FWidth * FHeight) * SizeOf(Integer));
 if FBuff2 <> nil then ZeroMemory(FBuff2, (FWidth * FHeight) * SizeOf(Integer));
end;

constructor TWaterEffect.Create;
begin
  inherited;
  FLightModifier := 10;
  FDamping := csDefDamping;
end;

destructor TWaterEffect.Destroy;
begin
  if FBuff1 <> nil then FreeMem(FBuff1);
  if FBuff2 <> nil then FreeMem(FBuff2);
  if FScanLine1 <> nil then FreeMem(FScanLine1);
  if FScanLine2 <> nil then FreeMem(FScanLine2);
  if FScanLineSrc <> nil then FreeMem(FScanLineSrc);
  inherited;
end;

procedure TWaterEffect.DrawWater(ALightModifier: Integer; Src, Dst: TBitmap);
var
  dx, dy: Integer;
  i, c, x, y: Integer;
  P1, P2, P3: PIntArray;
  PSrc, PDst: PRGBArray;
  PSrcDot, PDstDot: PRGBTriple;
  BytesPerLine1, BytesPerLine2: Integer;
begin
  Src.PixelFormat := pf24bit;
  Dst.PixelFormat := pf24bit;
  FScanLineSrc[0] := Src.ScanLine[0];
  BytesPerLine1 := Integer(Src.ScanLine[1]) - Integer(FScanLineSrc[0]);
  for i := 1 to FHeight - 1 do FScanLineSrc[i] := PRGBArray(Integer(FScanLineSrc[i - 1]) + BytesPerLine1);
  PDst := Dst.ScanLine[0];
  BytesPerLine2 := Integer(Dst.ScanLine[1]) - Integer(PDst);
  for y := 0 to FHeight - 1 do
  begin
    PSrc := FScanLineSrc[y];
    P1 := FScanLine1[Max(y - 1, 0)];
    P2 := FScanLine1[y];
    P3 := FScanLine1[Min(y + 1, FHeight - 1)];
    for x := 0 to FWidth - 1 do
    begin
      dx := P2[Max(x - 1, 0)] - P2[Min(x + 1, FWidth - 1)];
      dy := P1[x] - P3[x];
      if (x + dx >= 0) and (x + dx < FWidth) and (y + dy >= 0) and (y + dy < FHeight) then
      begin
        PSrcDot := @FScanLineSrc[y + dy][x + dx];
        PDstDot := @PDst[x];
        c := PSrcDot.rgbtBlue - dx;
        if c < 0 then PDstDot.rgbtBlue := 0 else if c > 255 then PDstDot.rgbtBlue := 255 else PDstDot.rgbtBlue := c;
        c := PSrcDot.rgbtGreen - dx;
        if c < 0 then PDstDot.rgbtGreen := 0 else if c > 255 then PDstDot.rgbtGreen := 255 else PDstDot.rgbtGreen := c;
        c := PSrcDot.rgbtRed - dx;
        if c < 0 then PDstDot.rgbtRed := 0 else if c > 255 then PDstDot.rgbtRed := 255 else PDstDot.rgbtRed := c;
      end
      else
      begin
        PDst[x] := PSrc[x];
      end;
    end;
    PDst := PRGBArray(Integer(PDst) + BytesPerLine2);
  end;
end;

procedure TWaterEffect.Render(Src, Dst: TBitmap);
begin
  CalcWater;
  DrawWater(FLightModifier, Src, Dst);
end;

procedure TWaterEffect.SetDamping(Value: TWaterDamping);
begin
  if (Value >= Low(TWaterDamping)) and (Value <= High(TWaterDamping)) then FDamping := Value;
end;

procedure TWaterEffect.SetSize(AWidth, AHeight: Integer);
var
  i: Integer;
begin
  if (AWidth <= 0) or (AHeight <= 0) then
  begin
    AWidth := 0;
    AHeight := 0;
  end;
  FWidth := AWidth;
  FHeight := AHeight;
  ReallocMem(FBuff1, FWidth * FHeight * SizeOf(Integer));
  ReallocMem(FBuff2, FWidth * FHeight * SizeOf(Integer));
  ReallocMem(FScanLine1, FHeight * SizeOf(PIntArray));
  ReallocMem(FScanLine2, FHeight * SizeOf(PIntArray));
  ReallocMem(FScanLineSrc, FHeight * SizeOf(PRGBArray));
  ClearWater;
  if FHeight > 0 then
  begin
    FScanLine1[0] := FBuff1;
    FScanLine2[0] := FBuff2;
    for i := 1 to FHeight - 1 do
    begin
      FScanLine1[i] := @FScanLine1[i - 1][FWidth];
      FScanLine2[i] := @FScanLine2[i - 1][FWidth];
    end;
  end;
end;

end.

My requirement is to compile the Project with single unit. That is "WaterEffect" unit should be removed from my project and the code of "WaterEffect" to be added "KoushikHalder01" unit. Ultimately I defined the following codes :

unit KoushikHalder01;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Math, Vcl.ExtCtrls, Vcl.Imaging.pngimage;

type
  PIntArray = ^TIntArray;
  TIntArray = array[0..65535] of Integer;
  PPIntArray = ^TPIntArray;
  TPIntArray = array[0..65535] of PIntArray;
  PRGBArray = ^TRGBArray;
  TRGBArray = array[0..65535] of TRGBTriple;
  PPRGBArray = ^TPRGBArray;
  TPRGBArray = array[0..65535] of PRGBArray;
  TWaterDamping = 1..99;

type
  TMainform = class(TForm)
    Image01: TImage;
    Timer01: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer01Timer(Sender: TObject);
    procedure Image01MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
    Bmp: TBitmap;
    FLightModifier: Integer;
    FWidth: Integer;
    FHeight: Integer;
    FBuff1: Pointer;
    FBuff2: Pointer;
    FScanLine1: PPIntArray;
    FScanLine2: PPIntArray;
    FScanLineSrc: PPRGBArray;
    FDamping: TWaterDamping;
    procedure SetDamping(Value: TWaterDamping);
  protected
    { Protected declarations }
    procedure CalcWater;
    procedure DrawWater(ALightModifier: Integer; Src, Dst: TBitmap);
  public
    { Public declarations }
    constructor Create;
    destructor Destroy; override;
    procedure ClearWater;
    procedure SetSize(AWidth, AHeight: Integer);
    procedure Render(Src, Dst: TBitmap);
    procedure Blob(x, y: Integer; ARadius, AHeight: Integer);
    property Damping: TWaterDamping read FDamping write SetDamping;
  end;

var
  Mainform: TMainform;

const
  csDefDamping = 20;
  RAND_MAX = $7FFF;

implementation

{$R *.dfm}

procedure TMainForm.Blob(x, y: Integer; ARadius, AHeight: Integer);
var
  Rquad: Integer;
  cx, cy, cyq: Integer;
  Left, Top, Right, Bottom: Integer;
begin
  if (x < 0) or (x > FWidth - 1) then x := 1 + ARadius + Random(RAND_MAX) mod (FWidth - 2 * ARadius - 1);
  if (y < 0) or (y > FHeight - 1) then y := 1 + ARadius + Random(RAND_MAX) mod (FHeight - 2 * ARadius - 1);
  Left := -Min(x, ARadius);
  Right := Min(FWidth - 1 - x, ARadius);
  Top := -Min(y, ARadius);
  Bottom := Min(FHeight - 1 - y, ARadius);
  Rquad := ARadius * ARadius;
  for cy := Top to Bottom do
  begin
    cyq := cy * cy;
    for cx := Left to Right do
    begin
      if (cx * cx + cyq <= Rquad) then
      begin
        Inc(FScanLine1[cy + y][cx + x], AHeight);
      end;
    end;
  end;
end;

procedure TMainForm.CalcWater;
var
  x, y, xl, xr: Integer;
  NewH: Integer;
  P, P1, P2, P3: PIntArray;
  PT: Pointer;
  Rate: Integer;
begin
  Rate := (100 - FDamping) * 256 div 100;
  for y := 0 to FHeight - 1 do
  begin
    P := FScanLine2[y];
    P1 := FScanLine1[Max(y - 1, 0)];
    P2 := FScanLine1[y];
    P3 := FScanLine1[Min(y + 1, FHeight - 1)];
    for x := 0 to FWidth - 1 do
    begin
      xl := Max(x - 1, 0);
      xr := Min(x + 1, FWidth - 1);
      NewH := (P1[xl] + P1[x] + P1[xr] + P2[xl] + P2[xr] + P3[xl] + P3[x] + P3[xr]) div 4 - P[x];
      P[x] := NewH * Rate div 256;
    end;
  end;
  PT := FBuff1;
  FBuff1 := FBuff2;
  FBuff2 := PT;
  PT := FScanLine1;
  FScanLine1 := FScanLine2;
  FScanLine2 := PT;
end;

procedure TMainForm.ClearWater;
begin
 if FBuff1 <> nil then ZeroMemory(FBuff1, (FWidth * FHeight) * SizeOf(Integer));
 if FBuff2 <> nil then ZeroMemory(FBuff2, (FWidth * FHeight) * SizeOf(Integer));
end;

constructor TMainForm.Create;
begin
  inherited;
  FLightModifier := 10;
  FDamping := csDefDamping;
end;

destructor TMainForm.Destroy;
begin
  if FBuff1 <> nil then FreeMem(FBuff1);
  if FBuff2 <> nil then FreeMem(FBuff2);
  if FScanLine1 <> nil then FreeMem(FScanLine1);
  if FScanLine2 <> nil then FreeMem(FScanLine2);
  if FScanLineSrc <> nil then FreeMem(FScanLineSrc);
  inherited;
end;

procedure TMainForm.DrawWater(ALightModifier: Integer; Src, Dst: TBitmap);
var
  dx, dy: Integer;
  i, c, x, y: Integer;
  P1, P2, P3: PIntArray;
  PSrc, PDst: PRGBArray;
  PSrcDot, PDstDot: PRGBTriple;
  BytesPerLine1, BytesPerLine2: Integer;
begin
  Src.PixelFormat := pf24bit;
  Dst.PixelFormat := pf24bit;
  FScanLineSrc[0] := Src.ScanLine[0];
  BytesPerLine1 := Integer(Src.ScanLine[1]) - Integer(FScanLineSrc[0]);
  for i := 1 to FHeight - 1 do FScanLineSrc[i] := PRGBArray(Integer(FScanLineSrc[i - 1]) + BytesPerLine1);
  PDst := Dst.ScanLine[0];
  BytesPerLine2 := Integer(Dst.ScanLine[1]) - Integer(PDst);
  for y := 0 to FHeight - 1 do
  begin
    PSrc := FScanLineSrc[y];
    P1 := FScanLine1[Max(y - 1, 0)];
    P2 := FScanLine1[y];
    P3 := FScanLine1[Min(y + 1, FHeight - 1)];
    for x := 0 to FWidth - 1 do
    begin
      dx := P2[Max(x - 1, 0)] - P2[Min(x + 1, FWidth - 1)];
      dy := P1[x] - P3[x];
      if (x + dx >= 0) and (x + dx < FWidth) and (y + dy >= 0) and (y + dy < FHeight) then
      begin
        PSrcDot := @FScanLineSrc[y + dy][x + dx];
        PDstDot := @PDst[x];
        c := PSrcDot.rgbtBlue - dx;
        if c < 0 then PDstDot.rgbtBlue := 0 else if c > 255 then PDstDot.rgbtBlue := 255 else PDstDot.rgbtBlue := c;
        c := PSrcDot.rgbtGreen - dx;
        if c < 0 then PDstDot.rgbtGreen := 0 else if c > 255 then PDstDot.rgbtGreen := 255 else PDstDot.rgbtGreen := c;
        c := PSrcDot.rgbtRed - dx;
        if c < 0 then PDstDot.rgbtRed := 0 else if c > 255 then PDstDot.rgbtRed := 255 else PDstDot.rgbtRed := c;
      end
      else
      begin
        PDst[x] := PSrc[x];
      end;
    end;
    PDst := PRGBArray(Integer(PDst) + BytesPerLine2);
  end;
end;

procedure TMainForm.Render(Src, Dst: TBitmap);
begin
  CalcWater;
  DrawWater(FLightModifier, Src, Dst);
end;

procedure TMainForm.SetDamping(Value: TWaterDamping);
begin
  if (Value >= Low(TWaterDamping)) and (Value <= High(TWaterDamping)) then FDamping := Value;
end;

procedure TMainForm.SetSize(AWidth, AHeight: Integer);
var
  i: Integer;
begin
  if (AWidth <= 0) or (AHeight <= 0) then
  begin
    AWidth := 0;
    AHeight := 0;
  end;
  FWidth := AWidth;
  FHeight := AHeight;
  ReallocMem(FBuff1, FWidth * FHeight * SizeOf(Integer));
  ReallocMem(FBuff2, FWidth * FHeight * SizeOf(Integer));
  ReallocMem(FScanLine1, FHeight * SizeOf(PIntArray));
  ReallocMem(FScanLine2, FHeight * SizeOf(PIntArray));
  ReallocMem(FScanLineSrc, FHeight * SizeOf(PRGBArray));
  ClearWater;
  if FHeight > 0 then
  begin
    FScanLine1[0] := FBuff1;
    FScanLine2[0] := FBuff2;
    for i := 1 to FHeight - 1 do
    begin
      FScanLine1[i] := @FScanLine1[i - 1][FWidth];
      FScanLine2[i] := @FScanLine2[i - 1][FWidth];
    end;
  end;
end;




procedure TMainform.FormCreate(Sender: TObject);
begin
  Bmp := TBitmap.Create;
  Bmp.Assign(Image01.Picture.Graphic);
  Image01.Picture.Graphic := nil;
  Image01.Picture.Bitmap.Height := Bmp.Height;
  Image01.Picture.Bitmap.Width := Bmp.Width;
  Create;
  SetSize(Bmp.Width,Bmp.Height);
end;

procedure TMainform.FormDestroy(Sender: TObject);
begin
  Bmp.Free;
  Free;
end;

procedure TMainform.Image01MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Blob(x,y,1,100);
end;

procedure TMainform.Timer01Timer(Sender: TObject);
begin
  if Random(8) = 1 then
  Blob(-1, -1, Random(1) + 1, Random(500) + 50);
  Render(Bmp, Image01.Picture.Bitmap);
  Image01.Repaint;
end;

end.

At the time of compilation I am getting

"[DCC Error] KoushikHalder01.pas(133): E2008 Incompatible types" at

constructor TMainForm.Create;
begin
  inherited;

Now I have renamed both the "constractor" and "destructor" as

public
  { Public declarations }
  constructor BubbleCreate;
  destructor BubbleDestroy; override;

the I am trying to compile my program and I am getting

"[DCC Error] KoushikHalder01.pas(53): E2137 Method 'BubbleDestroy' not found in base class" at

public
  { Public declarations }
  constructor BubbleCreate;
  destructor BubbleDestroy; override;

Please se the case.

seems a cool idea. Can you provide an sample jpg of the result? — Jlouro, Jul 11 '13 at 11:54
@Jlouro, [`try it by yourself`](http://stackoverflow.com/q/10234727/960757) ;-) Take [`this code`](http://stackoverflow.com/a/11419925/960757) since the translation from the accepted answer consumes much CPU (the C++ original didn't, so it was probably badly translated). — TLama, Jul 11 '13 at 12:13
@TLama, I don't know C++. So I am unable to translate properly. I have just tried. As the Original C++ code is very good. Please translate it in Delphi. I have found the [.CPP File Link](http://code.google.com/p/tortoisegit/source/browse/src/Utils/MiscUI/WaterEffect.cpp) and [.H File Link](http://code.google.com/p/tortoisegit/source/browse/src/Utils/MiscUI/WaterEffect.h). Please remember to translate it into 32Bit Color depth and to Use ony one Unit not add "WaterEffect" as a seperate unit. It will help very much me like users. — user2325284, Jul 11 '13 at 19:40
That comment was addressed to the first comment here... And sorry, but I'm busy with coding something more important. The code you have used ([`this one`](http://stackoverflow.com/a/11419925/960757)) doesn't have that CPU issue and looks almost like an effect from the TortoiseSVN's about box, so it's fine in my view. But anyway, as was mentioned in the accepted answer, it's a bad practice to merge units with classes with totally different meaning. Think about what you'll do if you decide to reuse that effect in a different project. Will you split that file again ? — TLama, Jul 11 '13 at 19:57

score 5 · Accepted Answer · answered Jul 11 '13 at 11:17

Your main form constructor and destructor must be like this:

constructor Create(AOwner: TComponent); override;
destructor Destroy; override;

You need to use an override of the virtual constructor introduced in TComponent because otherwise the form streaming framework will not find your constructor. It calls the virtual constructor introduced in TComponent so that's why you must override that one.

And the only destructor you should ever have is an override of the one named Destroy that was introduced in TObject. Otherwise calls to Free will not make your destructor run.

Having said that I think you've done this the wrong way. Your requirement was to merge the two units. There's no need at all to merge the two classes. Now you mixed everything in together which makes the code much harder to understand.

You should keep the classes as they were before, but just declare them in the same unit.

Merging Two Delphi units into one uni

1 Answers1