How do we scale up a facility in a business mouse?



  • That's how it's done in the peint, photoshop, etc. We'll separate the object, put it on its top corner by a mouse, and there are arrows to scale/replace, etc. I'd like to see Shape. I'd like to try, even though I'm gonna make a space planner, a view on the top.



  • Distance over right, lower edge or right-hand corner:

    unit Unit1;
    

    interface

    uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, ExtCtrls;

    type
    TForm1 = class(TForm)
    Shape1: TShape;
    procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure Shape1MouseUp(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
    procedure Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
    Y: Integer);
    private
    { Private declarations }
    public
    { Public declarations }
    end;

    var
    Form1: TForm1;
    dx,dy: integer;

    implementation

    {$R *.dfm}

    procedure TForm1.FormCreate(Sender: TObject);
    begin
    dx := -1;
    dy := -1;
    end;

    procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
    begin
    // При нажатии кнопки мыши на краю фигуры запоминаем расстояние от курсора до границы фигуры
    if X>Shape1.Width-8 then dx := Shape1.Width - X;
    if Y>Shape1.Height-8 then dy := Shape1.Height - Y;
    end;

    procedure TForm1.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
    Y: Integer);
    var n:integer;
    begin
    // Изменение вида курсора на границе фигуры
    n := 0;
    if X>Shape1.Width-8 then n := n + 1;
    if Y>Shape1.Height-8 then n := n + 2;
    case n of
    0: Shape1.Cursor := crDefault;
    1: Shape1.Cursor := crSizeWE;
    2: Shape1.Cursor := crSizeNS;
    3: Shape1.Cursor := crSizeNWSE;
    end;

    // Изменение размера фигуры
    if dx >= 0 then Shape1.Width := X + dx;
    if dy >= 0 then Shape1.Height := Y + dy;
    end;

    procedure TForm1.Shape1MouseUp(Sender: TObject; Button: TMouseButton;
    Shift: TShiftState; X, Y: Integer);
    begin
    // При отпускании кнопки мыши "отпускаем" край фигуры
    dx := -1;
    dy := -1;
    end;

    end.


Log in to reply
 


Suggested Topics

  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2
  • 2