English Deutsch Français Italiano Español Português 繁體中文 Bahasa Indonesia Tiếng Việt ภาษาไทย
所有分類

小弟想要知道 滑鼠點擊到 Line1物件時候產生事件
但是 Line1 與 Shape1 都沒有 MouseDown 功能所有想要問有沒有人懂可以幫幫我

2006-12-02 13:35:24 · 2 個解答 · 發問者 leecach 2 in 電腦與網際網路 程式設計

W.J.S. 大大的解答太高階了 @@ 看不懂
執行後 Public pX&(), pY&(), P% 出現錯誤自己也無法修改
!!~~560~~!! 的解答比較簡單
(Line1.X1 - Line1.X2) 打錯了被我發現,但是還看的懂
假如有繪出 Line2條線,有沒有辦法知道說移動到哪一條上面,請幫忙解答 謝謝

2006-12-03 06:20:14 · update #1

我詳細的看的一下 W.J.S. 的範例 終於知道了如何使用了
忘記放在模組中使用_還在研究中 90% 看不懂 . . . 看來要走的路還很遠

2006-12-03 10:18:39 · update #2

2 個解答

基本上...Line1要點到也有點難吧...如果果使用預設的線條的話
但是點Line1跟點Shape1其實都會呼叫到Form_MouseUp,因為它們只是Form的裝飾品,既然知道對應的事件,就容易著手了。
計算有沒有在線上,如果有就當作觸發Line1的Click事件,沒有就算了
我的方法是,計算滑鼠點的位置跟線段兩頂點距離與直線的距離作判斷,若點到的位置剛好在線上,則以下的式子成立:
Dim Len1 As Single,Len2 As Single,Len3 As Single
Len1=((Line1.X1 - X) ^ 2 + (Line1.Y1 - Y) ^ 2) ^ 0.5
Len2=((Line1.X2 - X) ^ 2 + (Line1.Y2 - Y) ^ 2) ^ 0.5
Len3=((Line1.X1 - Lin1.X2) ^ 2 + (Line1.Y1 - Line1.Y2) ^ 2) ^ 0.5
Len1+Len2-Len3=0←就是這個式子
相信對於電腦的精確度大家早有耳聞,我用了以下的程式碼測試
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Len1 As Single,Len2 As Single,Len3 As Single
Len1=((Line1.X1 - X) ^ 2 + (Line1.Y1 - Y) ^ 2) ^ 0.5
Len2=((Line1.X2 - X) ^ 2 + (Line1.Y2 - Y) ^ 2) ^ 0.5
Len3=((Line1.X1 - Lin1.X2) ^ 2 + (Line1.Y1 - Line1.Y2) ^ 2) ^ 0.5
If Len1+Len2-Len3=0 Then Form1.Caption="有交點到"
End Sub
經過測試,反覆移來移去,程式都沒有反應...顯然由於電腦太精準和Single的不準確
所以把判斷小小的修改一下
If Len1 + Len2 - Len3 < 10 Then
 Form1.Caption = "OnLine"
Else
 Form1.Caption = "NotOnLine"
End If
似乎有反應了!!至於要如何的得知<10也只是我自己慢慢測試覺得最好用的數值,沒有什麼特殊的依據,作者也可以依據自己的喜好更改
再來是Shape
判斷方法主要分為1.方形(矩形、方形)2.橢圓形(橢圓形、圓形)
1的判斷如下:
又分為按下矩形的任意點(含內部)或按下矩形的線條
按下矩形的線條的判別方法可以視為四條Line來看,方法同上面
另一個可以利用四個角來判斷用(x1,y1)代替是因為字數會超出
左上角的點為(Shape1.Left-Shape1.Width/2,Shape1.Top-Shape1.Height/2)當做(x1,y1)
右下角的點為(Shape1.Left+Shape1.Width/2,Shape1.Top+Shape1.Height/2)當做(x2,y2)
判斷為If X>=X1 And X==Y1 And Y= 2.圓形
圓形的方法就簡單多了
只要計算R跟點到圓心的距離即可
If Shape1.Left/2>((x-Shape1.Left)^2-(y-Shape1.Top)^2)^0.5>0 Then
若是點到圓的線才算則把>0改成<10即可
橢圓就比較麻煩了
橢圓的公式為(x-h)/a+(y-k)/b=1
但是其基本觀念為假設有兩個點A(Xa,Ya)、B(Xb,Yb)與動點P(X,Y)
PA的距離+PB的距離=某數
所以只要判斷PA的距離+PB的距離-某數=0、<0及可
睏...明天再補充A點B點的算法

2006-12-02 23:40:33 補充:
想不到我在我打的同時WJS大也剛好再打同一題,還是用WJS大的方法比較簡單。

2006-12-04 22:32:06 補充:
橢圓的定義:在平面上任一動點P(x,y)至兩焦點A,B之距離和等於長軸長度PA+PB=2a(2a=長軸距離,若是扁的橢圓則為寬,若是長的橢圓則為高)從這裡就很容易算出來了一開始先判斷是長的還是寬的橢圓,若是寬的則(以下為Shape1的屬性)Width>Heightf=((Width/2)^2-(Height/2)^2)^0.5Xa=Left-fXb=Left+fYa=Yb=Top+Height/2

2006-12-04 22:32:37 補充:
若為長的則Height>Widthf=((Height/2)^2-(Width/2)^2)^0.5Xa=xB=Left+Width/2Ya=Top-fyB=Top+fPA+PB="某數"剛剛觀念就有說了噢

2006-12-04 22:49:41 補充:
不給我打字了...真討厭...看意見吧!!

2006-12-04 22:50:12 補充:
如果兩條線重疊或者靠太進...
那兩條線都會被辦別Click成立所以可以先把我打的方法做成函數,例如
Function CheckLine1() As Boolen
Function CheckLine2() As Boolen
在Line1的副程式裡若Line1結果成立則CheckLine1=True
在Line2的副程式裡若Line1結果成立則CheckLine2=True
若要按到交點並觸發2個Click事件則可以用以下的寫法
Form_MouseUp
IF CheckLine1=True Then 程式
IF CheckLine2=True Then 程式

2006-12-04 22:50:29 補充:
若要只處發一個事件就會有先後的順序
若是要Line1>Line2則
If CheckLine1=True Then
程式
ElseIF CheckLine2=True Then
程式
EndIF
若是Line2>Line1則
If CheckLine2=True Then
程式
ElseIF CheckLine1=True Then
程式
EndIF

2006-12-04 23:02:51 補充:
在我們平常上數學課時,常常看到老師揮汗如雨般的証明著一條又一條的公式,只是希望我們理解公式的由來,如果忘記了可以再從基本觀念著手,但是當我們真正考試時,由於計算的題目已經很多了,所以也會不自覺得使用公式,其實是跳躍好幾個步驟了,所以結論是...還是選實用的WJS的答案吧!!就把我的方法當成上課一樣看就好了,再寫的時候還是要用WJS大的方法噢!!他的方法是建立在Windows巨人所提供的方法,就像牛頓說的"如果我比笛卡兒等人看得遠些,那是因為我站在巨人的肩上而已。"

2006-12-04 23:06:31 補充:
不好意思噢...晚了一點才來回覆,不過接下來剛好又碰到停機,停機完也要開始努力讀書了,沒辦法像現在這樣常常上知識+...如果還有問題...問WJS大吧...我已經打太多字不能回答了呦!!

2006-12-02 18:38:43 · answer #1 · answered by 五百六 3 · 0 0

'版本:VB6.0'以下在模組Declare Sub LineDDA Lib "gdi32" (ByVal n1&, ByVal n2&, ByVal n3&, ByVal n4&, ByVal l&, ByVal P&)Declare Function CreateEllipticRgn& Lib "gdi32" (ByVal X&, ByVal Y&, ByVal W&, ByVal H&)Declare Function CreateRoundRectRgn& Lib "gdi32" (ByVal X&, ByVal Y&, ByVal W&, ByVal H&, ByVal I&, ByVal J&)Declare Function CreateRectRgn& Lib "gdi32" (ByVal X&, ByVal Y&, ByVal W&, ByVal H&)Declare Function PtInRegion& Lib "gdi32" (ByVal H&, ByVal X&, ByVal Y&)Declare Sub DeleteObject Lib "gdi32" (ByVal H&)Public pX&(), pY&(), P%Sub LineDDAProc(ByVal X&, ByVal Y&, ByVal l&)    ReDim Preserve pX(P), pY(P)    pX(P) = X: pY(P) = Y    P = P + 1End Sub'以下在表單Dim S&Private Sub Form_Load()    ScaleMode = 3    With Shape1         If .Shape Mod 2 Then            If .Width > .Height Then               .Width = .Height            Else               .Height = .Width            End If         End If         '依Shape之形狀來建立區域         Select Case .Shape                Case 0 To 1 '建立矩形/正方形區域                     S = CreateRectRgn(.Left, .Top, .Left + .Width, .Top + .Height)                Case 2 To 3 '建立圓形/橢圓形區域                     S = CreateEllipticRgn(.Left, .Top, .Left + .Width, .Top + .Height)                Case Else '建立圓角矩形/圓角正方形區域                     S = CreateRoundRectRgn(.Left, .Top, .Left + .Width, .Top + .Height, .Width \ 5, .Height \ 5)        End Select    End WithEnd SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)    Dim I%, B As Boolean        '偵測是否點到Line1    Erase pX, pY    P = 0: Cls    With Line1         LineDDA .X1, .Y1, .X2, .Y2, AddressOf LineDDAProc, 0    End With    For I = 0 To P - 1        If ((pX(I) - X) ^ 2 + (pY(I) - Y) ^ 2) ^ 0.5 < 3 Then Print "點到Line1": B = True: Exit For    Next    '偵測是否點到Shape1    If PtInRegion(S, X, Y) Then Print "點到Shape1": B = True    If Not B Then Print "沒點到任何物件"End SubPrivate Sub Form_Unload(Cancel As Integer)    DeleteObject SEnd Sub

2006-12-03 22:31:26 補充:
我提供的是外掛(函數),而560大大教的是觀念,函數背起來就會,但觀念不懂背再多函數也沒用,建議此題最佳解頒給560大大.

2006-12-05 00:47:29 補充:
"理解公式的由來" 這就是我一直強調的重點.追根究底才是王道.

2006-12-12 14:20:43 補充:
S = CreateRoundRectRgn(.Left, .Top, .Left .Width, .Top .Height, .Width 5, .Height 5)
改成
S = CreateRoundRectRgn(.Left, .Top, .Left .Width, .Top .Height, .Width \ 5, .Height\ 5)
新版知識 會吃掉倒斜線,只好用全形代替

2006-12-12 14:23:10 補充:
S = CreateRoundRectRgn(.Left, .Top, .Left + .Width, .Top+ .Height, .Width 5, .Height 5)
改成
S = CreateRoundRectRgn(.Left, .Top, .Left +.Width, .Top +.Height, .Width \ 5, .Height\ 5)
連+號也吞了XD

2006-12-02 18:35:44 · answer #2 · answered by W.J.S. 7 · 0 0

fedest.com, questions and answers