-1

TMainForm の TImage コンポーネントに Watter Bubble を作成するプロジェクトが 1 つあります。コードは次のとおりです。

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;

ケースをご覧ください。

4

1 に答える 1

5

メイン フォームのコンストラクタとデストラクタは次のようにする必要があります。

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

で導入された仮想コンストラクターのオーバーライドを使用する必要がありますTComponent。そうしないと、フォーム ストリーミング フレームワークがコンストラクターを見つけられないためです。で導入された仮想コンストラクターを呼び出すTComponentため、それをオーバーライドする必要があります。

そして、あなたが持つべき唯一のデストラクタは、Destroyで導入された名前のオーバーライドですTObject。そうしないと、 を呼び出してFreeもデストラクタは実行されません。

そうは言っても、あなたはこれを間違った方法で行ったと思います。あなたの要件は、2 つのユニットをマージすることでした。2 つのクラスをマージする必要はまったくありません。すべてを混ぜ合わせて、コードを理解しにくくしています。

クラスは以前のままにしておく必要がありますが、同じユニットで宣言するだけです。

于 2013-07-11T11:17:58.060 に答える