在執行時讓使用者調較元件大小──程式碼全解說 |
|
Justmade
版主 發表:94 回覆:1934 積分:2030 註冊:2003-03-12 發送簡訊給我 |
範例下載請到 :
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.若仍有不明白的地方歡迎發問。 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |