不显示Delphi创建的图像

时间:2014-12-30 15:46:56

标签: delphi firemonkey timage

我正在尝试动态创建带有图像的自定义组件并将其显示在网格中,但图像不会显示。下面是省略了部分声明的代码,有人可以帮助我并告诉我我做错了什么吗?

自定义组件类

unit Tile;

interface

uses FMX.Controls, FMX.StdCtrls, System.Classes, FMX.Types, System.StrUtils ,
System.SysUtils, System.Types, System.UITypes,
  System.Variants,
  FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Ani,
  FMX.Objects, FMX.Layouts;

type
  TTileType = (Slider, Memory, Tile3D);

  TTile = class
  private
    FOnChangedText: TNotifyEvent;
    FType: TTileType;
    FControl: TComponent;
    FText: String;
    FName: String;
    FBitmap : TBitmap;
    FAlign : TAlignLayout;
    procedure TextChangedDefault(Sender: TObject);
  protected
    procedure SetText(aText: String);
    procedure TextChanged; virtual;
    procedure SetControlOnClick(AProc: TNotifyEvent);
    function GetControlOnClick: TNotifyEvent;
    procedure SetControlName(aName: String);
    procedure  SetBitmap(bitmap:TBitmap);
    procedure  SetAlign(align :TAlignLayout);
  public
    constructor Create(AParent: TFmxObject; AType: TTileType);
    destructor Destroy; override;
  published
    property Text: String read FText write SetText;
    property Name: String read FName write SetControlName;
    property Bitmap:TBitmap read FBitmap write SetBitmap;
    property Align:TAlignLayout read FAlign write SetAlign;
    property OnChangedText: TNotifyEvent read FOnChangedText
      write FOnChangedText;
    property OnClick: TNotifyEvent read GetControlOnClick
      write SetControlOnClick;
  end;

implementation


constructor TTile.Create(AParent: TFmxObject; AType: TTileType);
begin
  FType := AType;
  case FType of
    Slider:
      begin
        FControl := TButton.Create(AParent as TComponent);
        FOnChangedText := TextChangedDefault;
        (FControl as TFmxObject).Parent := AParent;
      end;
    Memory:
    begin
      FControl := TImage.Create(AParent as TComponent);
        FOnChangedText := TextChangedDefault;
        (FControl as TFmxObject).Parent := AParent;


    end;
    Tile3D:
      FControl := nil;
  else
    FControl := nil;
  end;
  FName := FControl.Name;
end;

destructor TTile.Destroy;
begin
  FControl.DisposeOf;
  inherited;
end;

function TTile.GetControlOnClick: TNotifyEvent;
begin
  case FType of
    Slider:
      begin
        Result := (FControl as TButton).OnClick;
      end;
    Memory:
      begin
        Result := (FControl as TImage).OnClick;
      end;
    Tile3D:
      begin
        // TODO
      end;
  else
    Result := nil;
  end;

end;

procedure TTile.SetControlName(aName: String);
begin
  FName := aName;
  FControl.Name := aName;
end;

procedure TTile.SetBitmap(bitmap :TBitmap);
begin
  FBitmap:=bitmap;

end;

procedure TTile.SetAlign(align :TAlignLayout);
begin
  FAlign:=align;

end;





procedure TTile.SetControlOnClick(AProc: TNotifyEvent);
begin
  case FType of
    Slider:
      begin
        (FControl as TButton).OnClick := AProc;
      end;
    Memory:
      begin
        (FControl as TImage).OnClick := AProc;
      end;
    Tile3D:
      begin
        // TODO
      end;
  end;
end;

procedure TTile.SetText(aText: String);
begin
  FText := aText;
  TextChanged;
end;

procedure TTile.TextChanged;
begin
  if Assigned(FOnChangedText) then
    FOnChangedText(Self);
end;

procedure TTile.TextChangedDefault(Sender: TObject);
begin
  (FControl as TButton).Text := FText;
end;

end.

记忆游戏类:

   unit MemoryGame;

interface

uses Tile, Consts, FMX.Controls, FMX.StdCtrls, FMX.Layouts, System.Classes,
  FMX.Types, System.Types, FMX.Graphics, System.SysUtils, FMX.Dialogs,Helper,FMX.ExtCtrls  ,

     System.UITypes,
  System.Variants,
   FMX.Forms,
   FMX.TabControl, SliderPuzzle, System.Actions,
  FMX.ActnList, FMX.StdActns, FMX.MultiView, FMX.Controls.Presentation, FMX.Edit,
  DateUtils ,FMX.Objects  ;


type
  TMemoryGame = class(TGridLayout)
  private
    FTiles: TArray<TTile>;

    procedure FillGrid(aTileNo: Integer);
  protected

  public
    constructor Create(AParent: TFmxObject; aTileNo: Integer); reintroduce;

  end;

  var
  moveCounter : Integer = 0 ;

implementation

{ MemoryGame }

constructor TMemoryGame.Create(AParent: TFmxObject; aTileNo: Integer);
begin
  inherited Create(nil);
  Parent := AParent;
  FillGrid(aTileNo);
end;


procedure TMemoryGame.FillGrid(aTileNo: Integer);
var
  I: Integer;
  LTile: TTile;


begin
  SetLength(FTiles, aTileNo);
  for I := 0 to aTileNo - 1 do
  begin
   LTile := TTile.Create(Self, TTileType.Memory);


   FTiles[I] := LTile;

    if I = 0 then
    begin
    LTile.Bitmap:= TBitmap.CreateFromFile('../../img/img1.bmp');
     LTile.Align := TAlignLayout.Client;
     LTile.Align := TAlignLayout.Center;








    end
    else
    begin

      LTile.Bitmap:= TBitmap.CreateFromFile('../../img/img1.bmp');
        LTile.Align := TAlignLayout.Client;
  LTile.Align := TAlignLayout.Center;
   end;
 end;
end;
end.

主要表格:

unit MainForm;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  System.Variants, Consts,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls, FMX.ExtCtrls,
  FMX.Layouts, FMX.TabControl, SliderPuzzle, System.Actions,
  FMX.ActnList, FMX.StdActns, FMX.MultiView, FMX.Controls.Presentation, FMX.Edit,
  DateUtils,MemoryGame, FMX.Objects;

type
  TFormMain = class(TForm)
    tcMain: TTabControl;
    ti1Slider: TTabItem;
    ti2Runtime: TTabItem;
    ti4Game3D: TTabItem;
    ti3Memory: TTabItem;
    GridLayout: TGridLayout;
    bTile1: TButton;
    bTile2: TButton;
    bTile3: TButton;
    bTile4: TButton;
    bTile5: TButton;
    bTile6: TButton;
    bTile7: TButton;
    bTile8: TButton;
    bTile9: TButton;
    bTile10: TButton;
    bTile11: TButton;
    bTile12: TButton;
    bTile13: TButton;
    bTile14: TButton;
    bTile15: TButton;
    bTileEmpty: TButton;
    bNew: TButton;
    MultiView: TMultiView;
    bExitApp: TButton;
    ActionList: TActionList;
    FileExitActn: TFileExit;
    NewGameActn: TAction;
    StyleBook: TStyleBook;
    hitCountLabel: TLabel;
    movesCounter: TLabel;
    TimeCountLabel: TLabel;
    timer: TLabel;
    Timer1: TTimer;
    procedure bTileClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure NewGameActnExecute(Sender: TObject);
    procedure GridLayoutResize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);





  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;
  Slider: TSliderPuzzle;
  Memory : TMemoryGame;
  firstMove : Boolean = true;
   stop, elapsed : TDateTime  ;
   start  : TDateTime = 0  ;



implementation

{$R *.fmx}


procedure TFormMain.NewGameActnExecute(Sender: TObject);
begin
  if ti1Slider.IsSelected then
    repeat
    begin
     firstMove:=true;
        Slider.ShuffleTiles(GridLayout);
        Slider.resetMoveCounter;
         Timer1.Enabled := true;
         Timer1.Interval :=1000;
    Slider.resetTimer(start);

    movesCounter.Text := IntToStr(Slider.GetMoveCount);
   timer.Text := '--/--/--';

    end;

    until not Slider.IsGameOver(GridLayout)
  else if ti2Runtime.IsSelected then
    repeat
      Slider.ShuffleTiles
    until not Slider.IsGameOver;
end;



procedure TFormMain.Timer1Timer(Sender: TObject);
var myVar:Integer;
begin
if start<>0 then
begin

  myVar :=  SecondsBetween(start,Now);

timer.Text :=Format('%.2d:%.2d', [myVar div 60, myVar mod 60]); ;


end;


end;

procedure TFormMain.bTileClick(Sender: TObject);
begin
  if firstMove then
  begin
  Slider.startCount(start);
  firstMove:=false;

  end;



  Slider.incrementCounter;
  movesCounter.Text := IntToStr(Slider.GetMoveCount);

  Slider.SwapTiles(GridLayout, Sender as TButton, bTileEmpty);
  if Slider.IsGameOver(GridLayout) then
  begin
    Slider.resetMoveCounter;
   Slider.resetTimer(start);
   // movesCounter.Text := IntToStr(Slider.GetMoveCount);
//    timer.Text := '--/--/--';
   Timer1.Enabled := false;
        ShowMessage('GAME OVER');
        firstMove:=true;
     ti3Memory.Enabled := true;
     ti3Memory.TabControl.SetActiveTabWithTransition(ti3Memory,TTabTransition.Slide);

  end;
end;

procedure TFormMain.GridLayoutResize(Sender: TObject);
begin
  GridLayout.ItemHeight := GridLayout.Height / COLS-25;
  GridLayout.ItemWidth := GridLayout.Width / ROWS;
end;



procedure TFormMain.FormShow(Sender: TObject);
begin
  ReportMemoryLeaksOnShutdown := true;
  Slider := TSliderPuzzle.Create(Self.ti2Runtime, TILES);
  Slider.Height := GridLayout.Height;
  Slider.Width := GridLayout.Width;
  Slider.Align := TAlignLayout.Client;

  //PuzzleGame

   ReportMemoryLeaksOnShutdown := true;
  Memory := TMemoryGame.Create(Self.ti3Memory, TILES);
 Memory.Height := GridLayout.Height;
  Memory.Width := GridLayout.Width;
  Memory.Align := TAlignLayout.Client;


end;



end.

3 个答案:

答案 0 :(得分:0)

在你设置过程中调用FBitmap变量的assign()方法:

procedure TTile.SetBitmap(bitmap :TBitmap);
begin
  FBitmap.Assign(bitmap);

end;

答案 1 :(得分:0)

将以下代码添加到Tile类,修复了问题。

type 
  private 

  FOnChangedBitmap : TNotifyEvent;

protected 
  procedure BitmapChanged;virtual;


procedure TTile.BitmapChanged;
begin
  if Assigned(FOnChangedBitmap) then
    FOnChangedBitmap(Self);
end;

procedure TTile.BitmapChangedDefault(Sender: TObject);
begin
  (FControl as TImage).Bitmap := FBitmap;
end;

procedure TTile.SetBitmap(bitmap :TBitmap);
begin
  FBitmap:=bitmap;
  BitmapChanged;

end;

答案 2 :(得分:0)

这看起来非常复杂,也许是。 但是我通过简单地设置图像的父级来解决了类似的问题:

  Fheart := TImage.Create(self);
  Fheart.Parent := self;
  Fheart.SetSubComponent(true);

当在构造函数中将其作为所有者传递时,似乎不需要设置父级-但这确实解决了我的问题