Delphi学习_控件设计器的实现_自定义父类

自定义父类

父类为每个动态创建控件的主要表现形式，本次设计通过继承TGraphicControl类实现。在拓展出常规的位置、大小等属性外同时仿照TShape类，在类内部声明Canvas用来实现文字的显示，同时定义虚函数方便实现不同控件的文本输出。

部分对象动作解释

1. constructor TDefObject.Create(AOwner: TComponent);

为完成对象的构造在调用父类的构造函数还需要对类中部分对象进行构造。FBrush对象的创建是为了使对象底色透明，在后续的各种动作中不进行修改；FPen对象实现了在选中控件时做提示反馈；FFont对象是对文字显示效果进行编辑；

constructor TDefObject.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  FPen := TPen.Create;
  FPen.OnChange := StyleChanged;
  FBrush := TBrush.Create;
  FBrush.OnChange := StyleChanged;
  FFont := TFont.Create;
  FFont.OnChange := StyleChanged;

  Font.Size := 30;
  Brush.Style := bsClear;
  Pen.Style := psClear;
  Pen.Width := 1;
  FAlign := 'alNone';
  NumAlign:=0;
  OnMouseUp := MyMouseUp;
  OnMouseDown := MyMouseDown;
  OnMouseMove := MyMouseMove;
end;

2. destructor TDefObject.Destroy;

直接调用父类析构函数进行析构

destructor TDefObject.Destroy;
begin
  FPen.Free;
  inherited Destroy;
end;

3. procedure TDefObject.Paint;

仿照TShape.Paint完成方框的绘制和文字的显示，同时根据实际屏幕大小对实际坐标、实际大小进行成比例缩小。

procedure TDefObject.Paint;
var
  mv,mh:Integer;
begin
  AlignManager; //对齐管理
  with Canvas do
  begin
    Pen := FPen;
    Brush := FBrush;
    Font := FFont;
    Rectangle(1, 1, Width-1, Height-1);
    TextOut(1,1,caption);
  end;
  if Pen.Style = psSolid then
  begin
    mv := height shr 1;
    mh := width shr 1;
    canvas.Rectangle(mh-2,0,mh+2,4);
    canvas.Rectangle(mh-2,height-4,mh+2,height);
    canvas.Rectangle(0,mv-2,4,mv+2);
    canvas.Rectangle(width-4,mv-2,width,mv+2);
  end;
end;

4. procedure TDefObject.MyMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

当鼠标按键按下时触发动作，需要完成3个任务
1>判断当前对象是否为已选中对象，如果不是则选中目标，然后进入
2>如果是已选中目标以及是左键按下，记录鼠标相对控件的位置坐标(FDeltX、FDeltY)、鼠标按下标志并通过相对位置和鼠标指针状态（在下小段详细解释）对即将可能发生的大小拖动变化进行标记。
如果是右键按下，弹出选择菜单，并对菜单内容进行更改。

procedure TDefObject.MyMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i:integer;

begin
  if Pen.Style = psDot then
  begin
    //1清除之前选中
    if ObjectList <> nil then UncheckObject;
    //2建立选中目标
    Pen.Style := psSolid;
    self.BringToFront;
    UpdateValueListEditor(self);
    checkObject := MainForm.ListBox1.ItemIndex;

  end;
  if (Pen.Style = psSolid)and(Button = mbLeft) then
  begin
    self.FDeltX := X;
    self.FDeltY := Y;
    flagMouse := 1;
    FlagChange := 0; //中间拖动 标记
    if (Cursor = crSizeNS) and (FDeltY < (height shr 1)) then
    begin //上边沿
      FlagChange := 1;
    end
    else if (Cursor = crSizeNS) and (FDeltY > (height shr 1)) then
    begin //下边沿
      FlagChange := 2;
    end
    else if (Cursor = crSizeWE) and (FDeltX < (width shr 1)) then
    begin //左边沿
      FlagChange := 3;
    end
    else if (Cursor = crSizeWE) and (FDeltX > (width shr 1)) then
    begin //右边沿
      FlagChange := 4;
    end;
  end;
  //右键菜单栏
  if Button = mbRight then
  begin
    MainForm.N1.Caption := '删除';
    MainForm.N2.Enabled := True;
    MainForm.N3.Enabled := False;
    MainForm.A1.Enabled := True;
    MainForm.PopupMenu1.Popup(mouse.CursorPos.X,mouse.CursorPos.Y);
  end;

end;

5. procedure TDefObject.MyMouseUp(Sender: TObject; Button:
   TMouseButton; Shift: TShiftState; X, Y: Integer);

当鼠标按键弹起时触发动作，对鼠标按键状态进行置位，同时更新ValueListEditor中的内容。

procedure TDefObject.MyMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  flagMouse := 0;
  UpdateValueListEditor(self);
end;

6. procedure TDefObject.MyMouseMove(Sender: TObject; Shift:
   TShiftState; X,Y: Integer);

当鼠标在对应控件移动时触发动作，在此需要完成两个任务
1>FlagChange标志的值对控件的大小、位置属性进行改变
2>根据控件的状态变换鼠标样式，如果当前控件未被选中鼠标变成手指，如果处于控件边缘鼠标变成箭头。

procedure TDefObject.MyMouseMove(Sender: TObject; Shift: TShiftState;
      X,Y: Integer);
var
  i:Integer;
begin
  if (flagMouse = 1) and (Pen.Style = psSolid) then
  begin
    if (FlagChange = 0)then
    begin
      ChangeRectSize(Left-FDeltX+X,Top-FDeltY+Y,Width,Height);
      if (Align = 'alLeft')and((LimitAlign+x)<(LimitAlign shr 1))then//切换位置
        ExchangeNumAlign(Self,'alLeft')
      else if(Align = 'alRight')and((x - Width)>(LimitAlign shr 1))then
        ExchangeNumAlign(Self,'alRight')
      else if(Align = 'alTop')and((LimitAlign+y)<(LimitAlign shr 1))then
        ExchangeNumAlign(Self,'alTop')
      else if(Align = 'alBottom')and((y - Height)>(LimitAlign shr 1))then
        ExchangeNumAlign(Self,'alBottom')

    end
    else if (FlagChange = 1)and(Align <> 'alTop') then
    begin
      ChangeRectSize(Left,Top-FDeltY+Y,width,Height+FDeltY-Y)
    end
    else if (FlagChange = 2)and(Align <> 'alBottom') then
    begin
      ChangeRectSize(Left,Top,width,Y)
    end
    else if (FlagChange = 3)and(Align <> 'alLeft') then
    begin
      ChangeRectSize(Left-FDeltX+X,Top,Width+FDeltX-X,Height)
    end
    else if (FlagChange = 4)and(Align <> 'alRight') then
    begin
      ChangeRectSize(Left,Top,X,height)
    end;
  end;

  if self.Pen.Style = psDot then
  begin
    Cursor := crHandpoint;
  end
  else if self.Pen.Style = psSolid then
  begin
    if (X in [0..8])or(width-X in [0..8]) then Cursor := crSizeWE
    else if (Y in [0..8])or(height-Y in [0..8]) then Cursor := crSizeNS
    else  Cursor := crDefault;
  end;
end;

7. procedure TDefObject.MyMouseEnter(var msg:TMessage);
8. procedure TDefObject.MyMouseLeave(var msg:TMessage);

7和8通过注册鼠标进入和鼠标离开函数，实现一个较好的选择对象时的交互效果，使未选中的控件对象在鼠标指向后有虚线描边的提示。

procedure TDefObject.MyMouseEnter(var msg:TMessage);
begin
  if Pen.Style <> psSolid then Pen.Style := psDot;
end;

procedure TDefObject.MyMouseLeave(var msg:TMessage);
begin
  if Pen.Style <> psSolid then Pen.Style := psClear;
end;

总结

这是第一次利用通过面向对象的思维进行纯软件的设计，在类的设计上还只是起步阶段，对于属性中的private、protected、public修饰词还有些许的疑惑，但本着理论指导实践、实践检验理论的学习流程进行开始了本项目的设计。