dragresize.pas

Delphi sample 界面设计

unit DragResize;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Math, Grids, ComCtrls, Menus,IniFiles;

type
  TC = class(TControl);
  TFrm_Design = class(TForm)
    StringGrid1: TStringGrid;
    MainMenu1: TMainMenu;
    MonthCalendar1: TMonthCalendar;
    Panel1: TPanel;
    Memo1: TMemo;
    Image1: TImage;
    Button1: TButton;
    N1: TMenuItem;
    Design: TMenuItem;
    Runtime: TMenuItem;
    RadioButton1: TRadioButton;
    CheckBox1: TCheckBox;
    Label2: TLabel;
    ComboBox1: TComboBox;
    CheckBox2: TCheckBox;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Label1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
    procedure ConMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure DSMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure ConMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure DSMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure MyMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure RuntimeClick(Sender: TObject);
    procedure DesignClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
  private
    zX,zY : Integer;
    Con : TControl;
    aMethods : Array [1..4] of Array of TMethod;
    procedure CreateDragSpot(Loc: String ; Cur :  TCursor);
    procedure RenewDragSpots;
    procedure RenewDragSpot(aLeft, aTop: integer; Loc: String);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Frm_Design: TFrm_Design;
  i:integer;
  Ini:TIniFile;
implementation

{$R *.dfm}

procedure TFrm_Design.Button1Click(Sender: TObject);
begin
  ShowMessage('onClick functioning');
end;

procedure TFrm_Design.Label1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  Label1.Caption := Format('%d,%d',[X,Y]);
end;

procedure TFrm_Design.DSMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  setcapturecontrol(TControl(Sender));
end;

procedure TFrm_Design.ConMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Con := TControl(Sender);
  setcapturecontrol(TControl(Sender));
  zX := X;
  zY := Y;
  RenewDragSpots;
end;

procedure TFrm_Design.ConMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
ds : tcontrol;
begin
  ds := getcapturecontrol;
  if ds = nil then exit;
  ds.Left := ds.Left + X - zX;
  ds.Top := ds.Top + Y - zY;
  RenewDragSpots;
end;

procedure TFrm_Design.DSMouseMove(Sender: TObject; Shift: TShiftState; X,  Y: Integer);
var ds : tcontrol;
begin
  ds := getcapturecontrol;
  if ds = nil then exit;
  if ds.Name[9] = 'T' then
  begin
    con.Height := Max(0,Con.Height + Con.Top - (y + ds.Top));
    con.Top := y + ds.Top;
  end
  else if ds.Name[9] = 'B' then
    con.Height := Max(0,y + ds.Top - Con.Top);
  if ds.Name[10] = 'L' then
  begin
    con.Width := Max(0,Con.Width + Con.Left - (x + ds.Left));
    con.Left := x + ds.Left;
  end
  else if ds.Name[10] = 'R' then
    con.Width := Max(0,x + ds.Left - Con.Left);
  RenewDragSpots;
end;

procedure TFrm_Design.MyMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  releasecapture;
end;

procedure TFrm_Design.CreateDragSpot(Loc : String ; Cur :  TCursor);
begin
  with TPanel.Create(self) do
    begin
      Parent:=Self;
      Width:=4;
      Height:=4;
      Color:=clBlack;
      BevelOuter := bvNone;
      Cursor := Cur;
      onMouseDown := DSMouseDown;
      onMouseMove := DSMouseMove;
      onMouseUp := MyMouseUp;
      Name := 'DragSpot' + Loc;
    end;
end;

procedure TFrm_Design.RenewDragSpot(aLeft,aTop : integer; Loc : String);
var Pn : TPanel;
begin
  Pn := TPanel(self.FindComponent('DragSpot' + Loc));
  if Pn = nil then exit;
  with Pn do
    begin
      Left := aLeft;
      Top := aTop;
      Parent := Con.Parent;
    end;
end;

procedure TFrm_Design.RenewDragSpots;
begin
  RenewDragSpot(Con.Left-2,Con.Top-2,'TL');
  RenewDragSpot(Con.Left-2,Con.Top+Round(Con.Height / 2 ),'CL');
  RenewDragSpot(Con.Left-2,Con.Top+Con.Height - 2,'BL');
  RenewDragSpot(Con.Left+Round(Con.Width / 2 ),Con.Top-2,'TC');
  RenewDragSpot(Con.Left+Round(Con.Width / 2 ),Con.Top+Con.Height-2,'BC');
  RenewDragSpot(Con.Left+Con.Width-2,Con.Top-2,'TR');
  RenewDragSpot(Con.Left+Con.Width-2,Con.Top+Round(Con.Height / 2),'CR');
  RenewDragSpot(Con.Left+Con.Width-2,Con.Top+Con.Height-2,'BR');
end;

procedure TFrm_Design.RuntimeClick(Sender: TObject);
var
  i : integer;
begin
  for i := ComponentCount -1 downto 0 do
    if (Components[i] is TPanel) and (Copy(Components[i].Name,1,8) = 'DragSpot') then
      Components[i].Free;
  for i := 0 to ComponentCount - 1 do
    if Components[i] is TControl then
      begin
        TC(Components[i]).OnClick := TNotifyEvent(aMethods[1,i]);
        TC(Components[i]).OnMouseDown := TMouseEvent(aMethods[2,i]);
        TC(Components[i]).OnMouseMove := TMouseMoveEvent(aMethods[3,i]);
        TC(Components[i]).OnMouseUp := TMouseEvent(aMethods[4,i]);
      end;
  Design.Enabled := true;
  Runtime.Enabled := false;

end;

procedure TFrm_Design.DesignClick(Sender: TObject);
var
  i : integer;
begin
  for i := 1 to 4 do
    SetLength(aMethods[i],ComponentCount);
  for i := 0 to ComponentCount - 1 do
    if Components[i] is TControl then
      begin
        aMethods[1,i] := TMethod(TC(Components[i]).onClick);
        aMethods[2,i] := TMethod(TC(Components[i]).onMouseDown);
        aMethods[3,i] := TMethod(TC(Components[i]).onMouseMove);
        aMethods[4,i] := TMethod(TC(Components[i]).onMouseUp);
        TC(Components[i]).OnClick := nil;
        TC(Components[i]).OnMouseDown := conMouseDown;
        TC(Components[i]).OnMouseMove := conMouseMove;
        TC(Components[i]).OnMouseUp := myMouseUp;
      end;
  CreateDragSpot('TL',crSizeNWSE);
  CreateDragSpot('CL',crSizeWE);
  CreateDragSpot('BL',crSizeNESW);
  CreateDragSpot('TC',crSizeNS);
  CreateDragSpot('BC',crSizeNS);
  CreateDragSpot('TR',crSizeNESW);
  CreateDragSpot('CR',crSizeWE);
  CreateDragSpot('BR',crSizeNWSE);
  Con := ActiveControl;
  RenewDragSpots;
  Design.Enabled := false;
  Runtime.Enabled := true;
end;

procedure TFrm_Design.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Ini.Free;
  Action:=CaFree;
end;

procedure TFrm_Design.FormDestroy(Sender: TObject);
begin
  frm_Design:=nil;
end;

end.