在运行时使形状显示在表单上[关闭]

Question

我有一个按钮，点击后，我希望 TMachine（又名 TShape）出现在表单上。目前我没有收到任何错误，但它从未出现在表单上。

按钮点击代码

procedure TfDeptLayout.bAddMachineClick(Sender: TObject);
var
  machine: TMachine;
  shapeAsset,
  shapeShape,
  shapeNumber,
  shapeName: string;
begin
  if not OkToAdd() then
  begin
    ShowMessage('Please fill out form correctly!');
    Exit;
  end;

  ShapeAsset := Edit2.text;
  ShapeShape := Combobox1.Text;
  ShapeNumber := Edit3.Text;
  ShapeName := Edit1.Text;

  if sub = false then
    begin
      machine := TMachine.Create(self);
      machine.Parent := Self;
      machine.PlaceShape(0, FDB.GetWW(ShapeShape), FDB.GethW(ShapeShape), 
        '20', '20', ShapeName, ShapeNumber, ShapeAsset)
      //show save button
      //lockout add machine button
      //let user place machine top / left.
      //save all locations
      //save top and left for each tmachine to database
      //lockout save button
      //show add machine button
    end;

  if sub then
    ShowMessage('auto save form');

  ShowMessage('congrats you added a machine');        
end;

如果需要，我可以展示 TMachine 单元吗？..

type    
  TMachine = class(TShape)
  private
    FOnMouseEnter: TNotifyEvent;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  protected
    procedure DoMouseEnter; virtual;
  published
    property OnMouseEnter: TNotifyEvent Read FOnMouseEnter write FOnMouseEnter;
  public
    mnName: string;
    mnAsset: string;
    mnNumber: string;
    mnIsPanel: string;
    mnBasicName: string;
    mnLShape: string;
    procedure PlaceShape(AM, sizeW, sizeH: Integer; ptop, pleft, name, order, 
      asset: string);
  end;

implementation

uses
  deptlayout;

procedure TMachine.CMMouseEnter(var Message: TMessage);
begin
  DoMouseEnter;
  inherited;
end;

procedure TMachine.DoMouseEnter;
begin
  if Assigned(FOnMouseEnter) then
    FOnMouseEnter(Self);
end;

procedure TMachine.PlaceShape(AM, sizeW, sizeH: Integer; ptop, pleft, name, 
  order, asset: string);
var
  myLabel: TLabel;
begin
  if ptop = '0' then
    Top := 136
  else
    Top := StrToInt(ptop);

  Width := sizeW;
  Height := sizeH;

  if pleft = '0' then
    Left := MyDataModule.fDB.LastX + 2  //set left
  else
    Left := StrToInt(pleft);

  MyDataModule.fDB.lastx := Left + sizeW;

  if AM = 1 then  //if in edit mode..
  begin
    //create label put inside the shape.
    myLabel := TLabel.Create(FDeptLayout);
    mylabel.Parent := FDeptLayout;
    mylabel.Left := Left;
    mylabel.Top := Top + 8;
    mylabel.Caption := '#' + mnNumber;
  end;
end;

end.

Answer 1

当然不行！

添加机器的代码在if not OkToAdd() then里面，所以只有not OkToAdd才会运行。但！即使是这种情况，您在运行代码之前Exit！因此，代码永远不会运行！

可能你的意思是这样的：

if not OkToAdd then
begin
  ShowMessage('Please fill out form correctly!');
  Exit;
end; //END!!!!!!

Answer 2

总结一下我上面的cmets：

将 fDeptLayout 的引用更改为 Self，就像您在编辑中所做的那样：

procedure TfDeptLayout.bAddMachineClick(Sender: TObject);
var
  machine : TMachine;
  shapeAsset,
  shapeShape,
  shapeNumber,
  shapeName : string;
begin
if not OkToAdd() then
begin
  showmessage('Please fill out form correctly!');
  Exit;
End;

  shapeAsset := edit2.text;
  ShapeShape := Combobox1.Text;
  ShapeNumber := Edit3.Text;
  ShapeName := Edit1.Text;

  if sub = false then
    begin
      machine := TMachine.Create(self);
      machine.Parent := Self;
      machine.PlaceShape(0,FDB.GetWW(ShapeShape),FDB.GethW(ShapeShape),'20','20',ShapeName,ShapeNumber,ShapeAsset)
      //show save button
      //lockout add machine button
      //let user place machine top / left.
      //save all locations
      //save top and left for each tmachine to database
      //lockout save button
      //show add machine button
    end;

  if sub then
      showmessage('auto save form');

showmessage('congrats you added a machine');


end;

为避免将来出现混淆，请删除 Delphi IDE 为除主表单和任何其他自动创建的表单之外的所有表单创建的全局表单变量 - 如果需要，它们很少会“污染命名空间”

Answer 3

不知道为什么这解决了它，但是在尝试通过 put 找到 Machine 的父级之后

showmessage('Machine Parent: '+Machine.parent.name);

它给出了访问错误。

已删除

Machine.parent := self;

编译，构建。然后读了

Machine.parent := self;

一切正常。