為什麼這個取圖片只能從左上到右下取圖片是正常~~!!

students1

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

要怎樣傳值才正確勒~~我是使用VB6~~!!
我將有問題的源碼上傳~~到這裡
http://www.filethief.com/download/123/why.rar.html

又靜

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

您的問題出現在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

這是我修改過的~~~因為傳值問題導致截圖都錯誤所以我改成你說的程式碼~~~!!
現在我的拖曳大小後已經可以正常截圖了

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~~但是未改變拖曳大小而直接移動截圖框或動態修改截圖框的大小卻無法截圖我該怎麼做??

又靜

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

想說又靜大大可以幫我看看嗎???

又靜

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

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

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

又靜

您好，
在 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

又靜大大謝謝~~感謝妳的大力幫忙~!! ^^

又靜

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

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