继续 cmets 中的讨论，这里有一个示例说明您可以如何执行此操作 - 创建一个新组件并将其添加到您的项目中。这里我称之为TextureCube（右键单击包 -> 安装。要更改，请右键单击 -> 卸载，进行更改，然后右键单击 -> 再次安装）：
unit TextureCube;
interface
uses
System.SysUtils, System.Classes, FMX.Types, FMX.Types3D, FMX.Objects3D,
Generics.Collections;
type
TCubeTexture = (ctGrass, ctDirt, ctSnow, ctStone);
TTextureSource = Class(TComponent)
private
FSelectedTexture : TCubeTexture;
FTextures : TDictionary<TCubeTexture, TBitmap>;
function GetTexture : TBitmap;
procedure SetTexture(setTex : TBitmap);
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
property Textures : TDictionary<TCubeTexture, TBitmap> read FTextures;
published
property SelectedTexture : TCubeTexture read FSelectedTexture write FSelectedTexture;
property Texture : TBitmap read GetTexture write SetTexture;
End;
TTextureCube = class(TCube)
private
FType : TCubeTexture;
FTextureSource : TTextureSource;
procedure SetCubeTexture(cubeTex : TCubeTexture);
procedure SetTextureSource(texSource : TTextureSource);
published
property CubeType : TCubeTexture read FType write SetCubeTexture;
property TextureSource : TTextureSource read FTextureSource write SetTextureSource;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TTextureCube]);
RegisterComponents('Samples', [TTextureSource]);
end;
constructor TTextureSource.Create(AOwner : TComponent);
begin
inherited;
FTextures := TDictionary<TCubeTexture, TBitmap>.Create();
end;
destructor TTextureSource.Destroy;
begin
FTextures.Free;
inherited;
end;
function TTextureSource.GetTexture : TBitmap;
var tex : TBitmap;
begin
if FTextures.TryGetValue(FSelectedTexture, tex) then
result := tex
else begin
tex := TBitmap.Create(1,1);
FTextures.AddOrSetValue(FSelectedTexture, tex);
result := tex;
end;
end;
procedure TTextureSource.SetTexture(setTex : TBitmap);
begin
FTextures.AddOrSetValue(FSelectedTexture, setTex);
end;
procedure TTextureCube.SetCubeTexture(cubeTex: TCubeTexture);
var tex : TBitmap;
begin
FType := cubeTex;
if Assigned(FTextureSource) and
(FTextureSource.Textures.TryGetValue(cubeTex, tex)) then
self.Material.Texture := tex
else
self.Material.Texture.Clear(0);
end;
procedure TTextureCube.SetTextureSource(texSource: TTextureSource);
begin
FTextureSource := texSource;
SetCubeTexture(FType);
end;
end.
这提供了一个新的立方体类TTextureCube，它继承自TCube - 立方体添加了一个枚举类型，并且可以链接到为每种类型提供纹理的TTextureSource。在这里，我已将这些添加到组件工具栏中的Samples 部分，您可以将它们放在任何您想要的地方。将一个 TTextureSource 和一个 TTexture 立方体放到您的表单上，然后离开。这显然可以通过在表单上让TTextureCubes 与TTextureSources 自动关联来改善 - 现在只需关联多维数据集和源：
我没有费心在这里制作自定义编辑器/查看器 - 在TTextureSource 中，您可以选择任何类型并为该类型设置纹理。 TTextureSource 将保存与每种立方体类型相关的纹理库：
然后对于每个TTextureCube，您只需要更改立方体类型，它就会从TTextureSource 中获取相关的纹理：
作为一个完整的警告 - 我出于周日的无聊而很快写了这篇文章，作为一个如何开始的例子，也许如何融入一个稍微优雅的设计。显然，我可能遗漏了很多东西，可能没有正确清理等等。如果没有良好的一次性处理、一些添加的异常处理、错误检查和整洁，我不会在生产代码中使用它。