SOGO論壇

標題: 為什麼這個取圖片只能從左上到右下取圖片是正常~~!! [列印本頁]
作者: students1    時間: 2012-3-19 10:02:31     標題: 為什麼這個取圖片只能從左上到右下取圖片是正常~~!!


剪裁時左上又下ok 其他都不行不知道該怎樣設定剪裁的寬度和期使點~~~那我該怎麼半~~!!!
可以幫我看一下~~教我嗎~~!! 謝謝~!!

要怎樣傳值才正確勒~~我是使用VB6~~!!
我將有問題的源碼上傳~~到這裡
http://www.filethief.com/download/123/why.rar.html
作者: 又靜    時間: 2012-3-20 02:01:06

本帖最後由 又靜 於 2012-3-20 02:23 編輯

您好，為了不占版面，小妹只列出您有問題的程式碼說明

您的問題出現在Mouse Button Up的 左下右上 沒有讓選取的圖示，顯示在Picture3上面

以下是您的原始程式
  1. '停止在圖片面板上移動
  2. Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  3.   Dim CurrentDc       As Long
  4.   Dim lHight, lWidth  As Long
  5.          
  6.          
  7.           If Button = 1 And Down = True Then
  8.                     If X >= dx And Y >= DY Then
  9.                       '左上右下
  10.                        selEndPos.X = X
  11.                        selEndPos.Y = Y
  12.                        lWidth = Abs((selStartPos.X - selEndPos.X))
  13.                        lHight = Abs((selStartPos.Y - selEndPos.Y))
  14.                        Picture2.Cls '清除圖片內的圖形
  15.                         '將滑鼠按下到起來的框選範圍內圖示顯示在Picture3上面
  16.                        BitBlt Picture2.hDC, 10, 10, lWidth, lHight, Picture1.hDC, selStartPos.X, selStartPos.Y, SRCCOPY
  17.                            
  18.                     Else
  19.                             If X < dx And Y < DY Then
  20.                                                '右下左上
  21.                                     
  22.                                     
  23.                             Else
  24.                                     If X < dx And Y >= DY Then
  25.                                                '右上左下
  26.                                     ElseIf X >= dx And Y < DY Then
  27.                                                '左下右上
  28.                                     End If
  29.                             End If
  30.                     End If
  31.                     
  32.             End If
  33.          
  34.          
  35.           Call MoveDownUp
  36.           Down = False
  37.             
  38. End Sub
複製代碼
作者: students1    時間: 2012-3-20 08:39:58

本帖最後由 students1 於 2012-3-20 08:52 編輯

這是我修改過的~~~因為傳值問題導致截圖都錯誤所以我改成你說的程式碼~~~!!
現在我的拖曳大小後已經可以正常截圖了
  1.   Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  2.   Dim CurrentDc       As Long
  3.   Dim lHight, lWidth  As Long
  4.          
  5.          
  6.           If Button = 1 And Down = True Then
  7.                     If X >= dx And Y >= DY Then
  8.                       '左上右下拖曳
  9.                        selEndPos.X = X
  10.                        selEndPos.Y = Y
  11.                        lWidth = Abs((selStartPos.X - selEndPos.X))
  12.                        lHight = Abs((selStartPos.Y - selEndPos.Y))
  13.                        Picture2.Cls '清除圖片內的圖形
  14.                         '將滑鼠按下到起來的框選範圍內圖示顯示在Picture3上面
  15.                        BitBlt Picture2.hDC, 10, 10, lWidth, lHight, Picture1.hDC, selStartPos.X, selStartPos.Y, SRCCOPY
  16.                            
  17.                     Else
  18.                        If X < dx And Y < DY Then
  19.                        '右下左上拖曳
  20.                                     
  21.                        selEndPos.X = X
  22.                        selEndPos.Y = Y
  23.                        lWidth = Abs((selStartPos.X - selEndPos.X))
  24.                        lHight = Abs((selStartPos.Y - selEndPos.Y))
  25.                        Picture2.Cls '清除圖片內的圖形
  26.                         '將滑鼠按下到起來的框選範圍內圖示顯示在Picture3上面
  27.                        BitBlt Picture2.hDC, 10, 10, lWidth, lHight, Picture1.hDC, selEndPos.X, selEndPos.Y, SRCCOPY
  28.                      
  29.                             Else
  30.                                     If X < dx And Y >= DY Then
  31.                                                '右上左下拖曳
  32.                                                selEndPos.X = X
  33.                                                selEndPos.Y = Y
  34.                                                lWidth = Abs((selStartPos.X - selEndPos.X))
  35.                                                lHight = Abs((selStartPos.Y - selEndPos.Y))
  36.                                                Picture2.Cls '清除圖片內的圖形
  37.                                                '將滑鼠按下到起來的框選範圍內圖示顯示在Picture3上面
  38.                                                BitBlt Picture2.hDC, 10, 10, lWidth, lHight, Picture1.hDC, selEndPos.X, selStartPos.Y, SRCCOPY
  39.                                                
  40.                                     ElseIf X >= dx And Y < DY Then
  41.                                                '左下右上拖曳
  42.                                                selEndPos.X = X
  43.                                                selEndPos.Y = Y
  44.                                                lWidth = Abs((selStartPos.X - selEndPos.X))
  45.                                                lHight = Abs((selStartPos.Y - selEndPos.Y))
  46.                                                Picture2.Cls '清除圖片內的圖形
  47.                                                '將滑鼠按下到起來的框選範圍內圖示顯示在Picture3上面
  48.                                                BitBlt Picture2.hDC, 10, 10, lWidth, lHight, Picture1.hDC, selStartPos.X, selEndPos.Y, SRCCOPY
  49.                                     End If
  50.                             End If
  51.                     End If
  52.                     
  53.             End If
  54.          
  55.          
  56.           Call MoveDownUp
  57.           Down = False
  58.             
  59. End Sub
複製代碼
這是又靜大大你說的地方我已經修改完畢,這是拖曳大小後截圖OK~~但是未改變拖曳大小而直接移動截圖框或動態修改截圖框的大小卻無法截圖我該怎麼做??
作者: 又靜    時間: 2012-3-20 15:23:33

students1 發表於 2012-3-20 08:39  
這是我修改過的~~~因為傳值問題導致截圖都錯誤所以我改成你說的程式碼~~~!!
現在我的拖曳大小後已經可以正 ...


您好，
問題出現在If ...... Then ...... Else ...... End If 語法上

第 6 行程式If Button = 1 And Down = True Then 這個條件式
應該是判斷拖曳截圖或直接移動截圖框

但在您的四個框選範圍內圖示顯示在Picture3上
都是在第 7 行程式 If X >= dx And Y >= DY Then 的條件式下
才會跳過移動截圖框的方式顯示


PS..我的電腦沒裝VB6，只能約略看一下程式碼回答您的問題
如果有誤，請先進前輩多多指正


作者: students1    時間: 2012-3-24 00:00:52

想說又靜大大可以幫我看看嗎???
作者: 又靜    時間: 2012-3-25 18:12:51

students1 發表於 2012-3-24 00:00  
想說又靜大大可以幫我看看嗎???

您好，
今天下載 VB6精簡版 來執行您的程式
發現有幾個問題點提供您參考

一、您的程式並沒有 移動截圖框或動態修改截圖框 的截圖顯示出來，只針對 拖曳大小後截圖 做處理
   
二、當滑鼠移到截圖框時，會觸發 UserControl 這個控制項，這時所有的動作都是在這個控制項裡執行
    除非滑鼠離開截圖框才會回到父程式裡，因此，您需要以 Event (x,y,w,h,l,t) 通知父程式
    並把新的位置資訊一併送出，在父程式觸發顯示圖片
作者: 又靜    時間: 2012-3-27 13:51:38

本帖最後由 又靜 於 2012-3-27 13:53 編輯

您好，
在 Form1 裡加：
  1. Public Sub Picture2_show(X As Single, Y As Single, lWidth As Single, lHight As Single)
  2.             Picture2.Cls '清除圖片內的圖形
  3.             BitBlt Picture2.hDC, 10, 10, lWidth - 16, lHight - 16, Picture1.hDC, X + 8, Y + 8, SRCCOPY
  4. End Sub
複製代碼
在 UserControl 的 FB_MouseUp 及 UserControl_MouseUp 各加一行
Form1.Picture2_show UserControl.Extender.Left + (X - dx), UserControl.Extender.Top + (Y - DY), UserControl.Extender.Width, UserControl.Extender.Height
  1. Private Sub FB_MouseUp(Index As Integer, Button As Integer, Text As Integer, X As Single, Y As Single)
  2.             Down = False
  3.             '將框選範圍內圖示顯示在Picture2上面
  4.             Form1.Picture2_show UserControl.Extender.Left + (X - dx), UserControl.Extender.Top + (Y - DY), UserControl.Extender.Width, UserControl.Extender.Height
  5. End Sub
複製代碼
  1. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  2.             Down = False
  3.             '將框選範圍內圖示顯示在Picture2上面
  4.             Form1.Picture2_show UserControl.Extender.Left + (X - dx), UserControl.Extender.Top + (Y - DY), UserControl.Extender.Width, UserControl.Extender.Height
  5. End Sub
複製代碼
作者: students1    時間: 2012-3-27 16:16:37

又靜大大謝謝~~感謝妳的大力幫忙~!! ^^
作者: 又靜    時間: 2012-3-27 18:49:38

students1 發表於 2012-3-27 16:16  
又靜大大謝謝~~感謝妳的大力幫忙~!! ^^

您好，
在回覆您的問題中，小妹也學到很多
大家經由提問、回覆的互動中都能學到新的知識



歡迎光臨 SOGO論壇 (https://oursogo.com/) Powered by OURSOGO.COM