合併兩個德爾福臺成一個單

-1

我有一個項目TMainForm的TImage組件創建瓦爾特泡沫。下面是代碼：合併兩個德爾福臺成一個單

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.

我的要求是編譯項目單單元。這是「WaterEffect」單位應該從我的項目中刪除，「WaterEffect」的代碼將添加「KoushikHalder01」單位。最後，我所定義的以下代碼：

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.

在編譯的我收到時間

「[DCC錯誤] KoushikHalder01.pas（133）：E2008不兼容的類型的」在

constructor TMainForm.Create; 
begin 
    inherited;

現在我已將「構造器」和「析構器」都重命名爲

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

在我試圖編譯我的計劃，我得到

「[DCC錯誤] KoushikHalder01.pas（53）：E2137法 'BubbleDestroy'沒有在基類中找到」在

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

請注意情況。

來源

2013-07-11 user2325284

似乎是一個很酷的想法。你能提供一個樣本JPG結果嗎？ – Jlouro

@Jlouro，['由yourself'嘗試]（http://stackoverflow.com/q/10234727/960757）;-)取['此code']（http://stackoverflow.com/a/11419925/ 960757），因爲從接受的答案轉換消耗很多CPU（C++原版沒有，所以它可能翻譯不好）。 – TLama

你不應該在你的名字下「合併」GPL的代碼。 – OnTheFly

主窗體構造函數和析構函數必須是這樣的：

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

您需要使用TComponent推出的虛擬構造函數的重寫，因爲否則的形式流框架不會找到你的構造。它調用TComponent中介紹的虛擬構造函數，這就是爲什麼你必須重寫那個。

而且你應該擁有的唯一的析構函數是在TObject中引入的名爲Destroy的覆蓋。否則調用Free不會讓你的析構函數運行。

話雖如此，我認爲你做錯了這個方法。你的要求是合併這兩個單位。根本不需要合併這兩個類。現在你把所有東西混合在一起，這使得代碼難以理解。

您應該保留類以前一樣，只是聲明它們在同一個單位。

來源

2013-07-11 11:17:58

合併兩個德爾福臺成一個單

回答

相關問題