Delphi learning_ Implementation of control designer_ Custom parent class

Posted by FFEMTcJ on Fri, 31 Dec 2021 12:16:59 +0100

Custom parent class

The parent class is the main manifestation of each dynamically created control. This design is implemented by inheriting the TGraphicControl class. In addition to expanding the conventional properties such as position and size, it also imitates the TShape class, declares Canvas inside the class to realize the display of text, and defines virtual functions to facilitate the text output of different controls.

Partial object action interpretation

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

In order to complete the construction of objects, some objects in the class need to be constructed when calling the constructor of the parent class. The FBrush object is created to make the background color of the object transparent and will not be modified in subsequent actions; FPen object implements prompt feedback when a control is selected; The FFont object is used to edit the text display effect;

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;
  1. destructor TDefObject.Destroy;

Directly call the parent class destructor to destruct

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

  1. procedure TDefObject.Paint;

Follow tshape Paint completes the box drawing and text display, and reduces the actual coordinates and actual size in proportion to the actual screen size.

procedure TDefObject.Paint;
var
  mv,mh:Integer;
begin
  AlignManager; //Alignment management
  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;
  1. procedure TDefObject.MyMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

When the mouse button is pressed, the action is triggered, and three tasks need to be completed
1> Judge whether the current object is a selected object. If not, select the target, and then enter
2> If the target is selected and the left button is pressed, record the position coordinates of the mouse relative to the control (FDeltX, FDeltY), the mouse press flag, and mark the possible size drag change through the relative position and the mouse pointer state (explained in detail in the next paragraph).
If you right-click, the selection menu pops up and changes the menu content.

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

begin
  if Pen.Style = psDot then
  begin
    //1 clear previously selected
    if ObjectList <> nil then UncheckObject;
    //2. Create the selected target
    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; //Middle drag mark
    if (Cursor = crSizeNS) and (FDeltY < (height shr 1)) then
    begin //Upper edge
      FlagChange := 1;
    end
    else if (Cursor = crSizeNS) and (FDeltY > (height shr 1)) then
    begin //Lower edge
      FlagChange := 2;
    end
    else if (Cursor = crSizeWE) and (FDeltX < (width shr 1)) then
    begin //Left edge
      FlagChange := 3;
    end
    else if (Cursor = crSizeWE) and (FDeltX > (width shr 1)) then
    begin //Right edge
      FlagChange := 4;
    end;
  end;
  //Right click menu bar
  if Button = mbRight then
  begin
    MainForm.N1.Caption := 'delete';
    MainForm.N2.Enabled := True;
    MainForm.N3.Enabled := False;
    MainForm.A1.Enabled := True;
    MainForm.PopupMenu1.Popup(mouse.CursorPos.X,mouse.CursorPos.Y);
  end;

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

When the mouse button pops up, the action is triggered to set the mouse button status and update the content in the ValueListEditor at the same time.

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

When the mouse moves in the corresponding control, the action is triggered, and two tasks need to be completed here
1> The value of the flagchange flag changes the size, location and properties of the control
2> Change the mouse style according to the state of the control. If the current control is not selected, the mouse becomes a finger, and if it is at the edge of the control, the mouse becomes an arrow.

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//Switch position
        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;

  1. procedure TDefObject.MyMouseEnter(var msg:TMessage);
  2. procedure TDefObject.MyMouseLeave(var msg:TMessage);

7 and 8 register the mouse in and mouse out functions to achieve a better interactive effect when selecting objects, so that the unselected control objects will be prompted with dotted lines after the mouse points.

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;

summary

This is the first time to use object-oriented thinking to design pure software. The class design is still in its infancy. There are still some doubts about the private, protected and public modifiers in attributes, but the design of this project is started based on the learning process of theory guiding practice and practice testing theory.

Topics: Delphi