在執行時讓使用者調較元件大小──程式碼全解說

發表時間：2003-06-02 08:23:28

IP:218.16.xxx.xxx 未訂閱

範例下載請到 : http://delphi.ktop.com.tw/topic.php?TOPIC_ID=31513 這個範例就是示範如何在程式執行時可以進入設計模式讓使用者自由的拉動元件的位置和大小，其特點就是基本上絕大部份可視元件都可以支援 (即使沒有 onMouseXXX 事件的如 TMonthCalendar 都支援但 MainMenu 那些沒法)，而且完全不需要設定甚麼，放上 Form / Containaer 便可以了。

基本原理

在進入設計模式時 1. 將所有元件的 onClick 及 onMouseXXX 事件先存起來 2. 將 onMouseXXX 事件換成重設元件位置和大小的事件 (對於沒這些事件的元件要 TypeCast 成自訂 TControl 子代來設定) 3. 動態的建立 8 個拖放點 (DragSpot)，並設好 Cursor 及對應的邊線 4. 以現時的 ActiveControl 作為首個對像 使用者按某元件時 : 設定該元件為對像並記下開始位置 使用者拉那個元件時 : 對應開始位置移動元件的位置 使用者拉某個拖放點時 : 以該拖放點的對應邊線作計算，即時更改元件的大小和位置 當離開設計模式進入一般模式時 1. 釋放所有拖放點 2. 將各元件的 onClick 及 onMouseXXX 事件還原

非即時重繪方法

這個範例是使用即時重繪的方式的，即是說一邊拉一邊顯示最新的大小位置，這樣做的好處是即時可看到結果但懷處時會較閃及有時有暫時殘影。 Delphi IDE 使用的是非即時重繪的方式，就是拉是只顯示元件的外框，到放手時才更新元件的大小位置，好處是不會閃及耗用CPU較少。若你想使用這種方式，可動態建立一個長方形 TShape，在 onMouseMove 時以 TShape 來代元件的改變，到 onMouseUp 時才將 TShape 的大小位置設給元件。

程式碼解說

unit dragresize;    interface    uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Math, Grids, ComCtrls, Menus;    type
  TC = class(TControl); // 這個是用來 TypeCast 以便存取一些 hide 了的 property / event
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    MainMenu1: TMainMenu;
    miDesign: TMenuItem;
    miNormal: TMenuItem;
    MonthCalendar1: TMonthCalendar;
    Panel1: TPanel;
    Memo1: TMemo;
    Image1: TImage;
    Label1: TLabel;
    Button1: TButton;
    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 miDesignClick(Sender: TObject);
    procedure miNormalClick(Sender: TObject);
  private
    zX,zY : Integer;
    Con : TControl;
    aMethods : Array [1..4] of Array of TMethod; // 這個是用來記住所有 Control 的 onClick / onMouseXXX 的
    procedure CreateDragSpot(Loc: String ; Cur :  TCursor);
    procedure RenewDragSpots;
    procedure RenewDragSpot(aLeft, aTop: integer; Loc: String);
  end;    var
  Form1: TForm1;    implementation    {$R *.dfm}    procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage('onClick functioning');
end;    procedure TForm1.Label1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  Label1.Caption := Format('%d,%d',[X,Y]);
end;    procedure TForm1.ConMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin // 使用者按 Control 時觸發 (Design Mode Only)
  Con := TControl(Sender); // 設定好現在在處理的 Control
  setcapturecontrol(TControl(Sender)); // 設定誰取得 Mouse 的事件
  zX := X; // 記著開始時的 X Y 座標，作之後移動元件用
  zY := Y;
  RenewDragSpots; // 重新以這個 Control 排好 DragSpots
end;    procedure TForm1.DSMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin // 使用者按 DragSpot 時觸發
  setcapturecontrol(TControl(Sender)); // 設定誰取得 Mouse 的事件
end;    procedure TForm1.ConMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
ds : tcontrol;
begin  // 當 Control 收到 Mouse 在 Move 時執行
  ds := getcapturecontrol; // 先取得之前 SetCaptureControl 正在處理的 Control
  if ds = nil then exit; // 若沒人即正常 MouseMove (沒 Drug) 所以便離開不作處理
  ds.Left := ds.Left   X - zX; // 對比最初存起的 X Y 座標來移動 Control
  ds.Top := ds.Top   Y - zY;
  RenewDragSpots; // 由於 Control 的位置可能變了所以要重排 DragSpot
end;    procedure TForm1.DSMouseMove(Sender: TObject; Shift: TShiftState; X,  Y: Integer);
var ds : tcontrol;
begin // 當 DragSpot 收到 Mouse 在 Move 時執行
  ds := getcapturecontrol; // 先取得之前 SetCaptureControl 正在處理的 DragSpot
  if ds = nil then exit; // 若沒人即正常 MouseMove (沒 Drug) 所以便離開不作處理
  if ds.Name[9] = 'T' then // DragSpot 是位於上邊界
  begin
    con.Height := Max(0,Con.Height   Con.Top - (y   ds.Top)); // 按新的 Y 座標計算新高度但不能小於 0
    con.Top := y   ds.Top; // 由於是上邊界所以要重新設定 Control Top 的位置
  end
  else if ds.Name[9] = 'B' then // DragSpot 是位於下邊界
    con.Height := Max(0,y   ds.Top - Con.Top); 
  if ds.Name[10] = 'L' then // DragSpot 是位於左邊界
  begin
    con.Width := Max(0,Con.Width   Con.Left - (x   ds.Left)); // 按新的 X 座標計算新闊度但不能小於 0
    con.Left := x   ds.Left; // 由於是左邊界所以要重新設定 Control Left 的位置
  end
  else if ds.Name[10] = 'R' then // DragSpot 是位於右邊界
    con.Width := Max(0,x   ds.Left - Con.Left);
  RenewDragSpots; // 由於 Control 的位置大小可能變了所以要重排 DragSpot
end;    procedure TForm1.MyMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin // 使用者在 Control / DragSpot 放開按鈕時執行
  releasecapture; // 取消取得 Mouse 的事件
end;    procedure TForm1.miDesignClick(Sender: TObject);
var i : integer;
begin // 進入設計模式
  for i := 1 to 4 do
    SetLength(aMethods[i],ComponentCount); // 設好存放 Control 事件的陣列
  for i := 0 to ComponentCount - 1 do
    if Components[i] is TControl then // 只處理 TControl 因為 TComponent 沒 Mouse 事件
    begin
      aMethods[1,i] := TMethod(TC(Components[i]).onClick); // 儲存 onClick 及 Mouse 事件
      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; // 使 onClick 沒動作
      TC(Components[i]).OnMouseDown := conMouseDown; // 設定 設計模式的 Mouse 事件
      TC(Components[i]).OnMouseMove := conMouseMove; // 由為有些元件沒 Mouse 事件所以以 TC 來 TypeCast
      TC(Components[i]).OnMouseUp := myMouseUp;
    end;
  CreateDragSpot('TL',crSizeNWSE); // 建立 DragSpot, 給與位置代號及 Cursor 形狀
  CreateDragSpot('CL',crSizeWE);
  CreateDragSpot('BL',crSizeNESW);
  CreateDragSpot('TC',crSizeNS);
  CreateDragSpot('BC',crSizeNS);
  CreateDragSpot('TR',crSizeNESW);
  CreateDragSpot('CR',crSizeWE);
  CreateDragSpot('BR',crSizeNWSE);
  Con := ActiveControl; // 先設定 ActiveContorl 做首個對象
  RenewDragSpots; // 排好 DragSpots 的位置
  miDesign.Enabled := false; // 設好 Menu Item
  miNormal.Enabled := true;
end;    procedure TForm1.miNormalClick(Sender: TObject);
var i : integer;
begin // 從設計模式返回正常模式
  for i := ComponentCount -1 downto 0 do // 釋放 HotSpots
    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;
  miDesign.Enabled := true; // 設好 Menu Item
  miNormal.Enabled := false;
end;    procedure TForm1.CreateDragSpot(Loc : String ; Cur :  TCursor);
begin // 建立 DragSpot 程序
  with TPanel.Create(self) do
  begin
    Parent:=Self;
    Width:=4;
    Height:=4;
    Color:=clBlack;
    BevelOuter := bvNone;
    Cursor := Cur; //設定 Cursor 形狀
    onMouseDown := DSMouseDown; // 設定 onMouse 事件
    onMouseMove := DSMouseMove;
    onMouseUp := MyMouseUp;
    Name := 'DragSpot'   Loc; // 以位置代號為部份的名字，方便拉動時判段應甚改變 Control
  end;
end;    procedure TForm1.RenewDragSpot(aLeft,aTop : integer; Loc : String);
var Pn : TPanel; 
begin // 跟據計算好的資料設好 DragSpot 的位置
  Pn := TPanel(self.FindComponent('DragSpot'   Loc)); // 以位置代號找相對 DragSpot
  if Pn = nil then exit;
  with Pn do
  begin
    Left := aLeft;
    Top := aTop;
    Parent := Con.Parent; // 設定 DragSpot 的 Parent 為現處理 Control 的 Parent
  end;
end;    procedure TForm1.RenewDragSpots;
begin // 以元件的位置大小來計算 DragSpots 的位置, 以 DragSpots 的位置代號作識認
  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;    end.

若仍有不明白的地方歡迎發問。