将两个Delphi单元合并为一个uni
我有一个项目在TMainForm的TImage组件中创建Watter Bubble。 代码如下:将两个Delphi单元合并为一个uni,delphi,Delphi,我有一个项目在TMainForm的TImage组件中创建Watter Bubble。 代码如下: 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
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.
在我的项目中,我的另一个单元名为WaterEffect,其代码为:
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.
现在我将构造函数和析构函数都重命名为
public
{ Public declarations }
constructor BubbleCreate;
destructor BubbleDestroy; override;
我试图编译我的程序,我得到了
[DCC错误]KoushikHalder01.pas53:在基类中找不到E2137方法'BubbleDestroy'
public
{ Public declarations }
constructor BubbleCreate;
destructor BubbleDestroy; override;
请使用这种情况。您的主窗体构造函数和析构函数必须如下所示:
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
您需要使用TComponent中引入的虚拟构造函数的重写,否则表单流框架将找不到您的构造函数。它调用TComponent中引入的虚拟构造函数,因此必须重写该构造函数
您应该拥有的唯一析构函数是对TObject中引入的名为Destroy的析构函数的重写。否则,对Free的调用将不会使析构函数运行
话虽如此,我认为你做得不对。你的要求是合并这两个单位。根本不需要合并这两个类。现在您将所有内容混合在一起,这使得代码更难理解
您应该保持类与以前一样,但只需在同一个单元中声明它们。似乎是一个很酷的主意。你能提供结果的样本jpg吗?@Jlouro,;-因为从接受的答案翻译的CPU消耗很多,C++原版没有,所以它可能翻译得很差。你不应该在你的名字下合并GPLAE代码。@ TLama,我不知道C++。所以我无法正确翻译。我刚试过。作为原C++代码非常好。请用德尔菲翻译。我找到了和。请记住将其转换为32位颜色深度,并仅使用一个单元,而不是将WaterEffect作为单独的单元。这将非常有助于我喜欢的用户。该评论是针对这里的第一条评论。。。对不起,我正忙着编写更重要的代码。您所使用的代码没有CPU问题,看起来几乎像是OrtoiseSVN的about框的效果,所以在我看来这很好。但无论如何,正如公认的答案中提到的,将单元与意义完全不同的类合并是一种不好的做法。考虑一下,如果您决定在另一个项目中重用这种效果,您将做什么。你能再拆分一下那个文件吗?
public
{ Public declarations }
constructor BubbleCreate;
destructor BubbleDestroy; override;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;