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
- 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;
- destructor TDefObject.Destroy;
Directly call the parent class destructor to destruct
destructor TDefObject.Destroy; begin FPen.Free; inherited Destroy; end;
- 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;
- 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;
- 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;
- 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;
- procedure TDefObject.MyMouseEnter(var msg:TMessage);
- 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.