• Vui lòng đọc nội qui diễn đàn để tránh bị xóa bài viết
  • Tìm kiếm trước khi đặt câu hỏi

Căn bản vẽ VB6

Các bài viết hướng dẫn, giúp các bạn hiểu và tiếp cận với Visual Basic nhanh hơn
User avatar
truongphu
VIP
VIP
Posts: 4765
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 519 times

Căn bản vẽ VB6

Postby truongphu » Tue 21/12/2010 3:46 pm

Tên bài viết: Căn bản vẽ VB6
Tác giả: truongphu
Cấp độ bài viết: căn bản và nâng cao
Tóm tắt: Đề mục nầy dừng ở cấp căn bản và hơn một chút . Các cách dùng thông thường sẽ không được nhắc đến, chỉ viết về các điều ít được đề cập, qua đó vừa nâng cao các cách vẽ mới, vừa ôn lại cấu trúc vẽ cũ.




1- Lệnh Line với cấu trúc:
Object.Line Step (xStart, yStart)-[Step] (xEnd, yEnd), PenColour, BF


chú ý đối số BF cuối: B là tạo hình khung từ 2 điểm, F là phủ đầy màu. dùng F phải kèm B

*** Ứng dụng: Vẽ một điểm:
Vẽ một điểm là lệnh Line 1 pixel. Với 1 Pixel ta khó nhìn thấy, vậy thêm thành 4 pixel:

Code: Select all

    Line (200, 200)-(204, 204), vbRed

vẫn không thấy! ta bao viền (ô 4x4) và đổ đầy màu đỏ:

Code: Select all

    Line (200, 200)-(204, 204), vbRed, BF

lần nầy đã thấy, tiếc rằng quá nhỏ. Chơi luôn 20 pixel (ô 20x20):

Code: Select all

    Line (500, 500)-(520, 520), vbBlue, BF


*** Vài lệnh vẽ đoạn thẳng quen dùng:

Vẽ đường ngang giữa Form

Code: Select all

    Me.Line (0, Me.ScaleHeight / 2)-(Me.ScaleWidth, Me.ScaleHeight / 2)

Vẽ đường dọc giữa Form

Code: Select all

    Me.Line (Me.ScaleWidth / 2, 0)-(Me.ScaleWidth / 2, Me.ScaleHeight)

Vẽ đường chéo trên-xuống

Code: Select all

    Me.Line (0, 0)-(Me.ScaleWidth, Me.ScaleHeight)

Vẽ đường chéo dưới lên

Code: Select all

    Me.Line (0, Me.ScaleHeight)-(Me.ScaleWidth, 0)

Vẽ hình vuông màu đỏ (ô 400x400)

Code: Select all

    Me.Line (100, 100)-(500, 500), RGB(255, 0, 0), BF


2- Lệnh PSet với cấu trúc:
Object.PSet Step (x, y), Colour


Nếu dùng lệnh nầy đơn độc, cơ bãn ta không thấy được điểm 1 pixel như đã nói trên ở lệnh Line

*** Kết hợp lệnh Line để vẽ bằng chuột:
-> dùng Pset để tạo tọa độ ban đầu (Form_MouseDown)
-> dùng Line để vẽ đường liền (Form_MouseMove): tọa độ ban đầu bỏ (ngầm hiểu dùng tọa độ cũ)

[vb]Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
PSet (X, Y)
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then Me.Line -(X, Y)
End Sub[/vb]

*** Kết hợp vòng lặp để vẽ vòng tròn bằng các dấu chấm:
[vb] Dim I, X, Y, BanKinh As Integer
'Set toa dô tâm
X = 1200
Y = 1200
BanKinh = 800
For I = 1 To 360
Picture1.PSet (X + Cos(I) * BanKinh, Y + Sin(I) * BanKinh)
Next[/vb]

(còn tiếp: Lệnh Circle)


o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

User avatar
truongphu
VIP
VIP
Posts: 4765
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 519 times

Re: Căn bản vẽ VB6

Postby truongphu » Wed 22/12/2010 8:57 am

3- Lệnh Circle với cấu trúc:
Object.Circle Step (x, y), Radius, Colour, Start, End, Aspect


Ta chú ý các yếu tố Start, End và Aspect
- Start = Điểm khởi đầu, default là 0
- End = Điểm cuối, default là 2PiRad; 2 điểm nầy dùng cho vẽ cung
- Aspect = tỉ lệ giữa cao và rộng của tứ giác ngoại tiếp, default là 1 = vòng tròn, <1 là dẹp, >1 là thon

*** Dùng thử yếu tố Aspect như code sau:

Code: Select all

    Circle (Me.ScaleWidth / 2, Me.ScaleHeight / 2), 1000, , , , 0.5


*** Vẽ cung bất kỳ:

Code: Select all

    Circle (Me.ScaleWidth / 2, Me.ScaleHeight / 2 + 500), 1000, , 0.7, 2.9


*** Function chuyển từ độ sang radian phục vụ hàm Circle

Code: Select all

Private Function Rads(ByVal Degree As Single) As Single
  Const PI = 22 / 7
  Rads = Degree / 180 * PI
End Function


*** Vẽ một biểu đồ hình tròn:
  1. Private Sub Command1_Click()
  2.     FillStyle = 0
  3.   FillColor = &HFFFF9C
  4.   Circle (2500, 2000), 1500, , -Rads(180), -Rads(10.8)
  5.   CurrentX = 2800: CurrentY = 4000
  6.   Print "53%"
  7.   Line (2800, 2700)-(2800, 3900)
  8.  
  9.     FillColor = &H639AFF
  10.   Circle (2500, 2000), 1500, , -Rads(10.8), -Rads(46.8)
  11.   CurrentX = 4700: CurrentY = 1000
  12.   Print "10%"
  13.   Line (3500, 1200)-(4500, 1200)
  14.  
  15.     FillColor = &H9C30FF
  16.   Circle (2500, 2000), 1500, , -Rads(46.8), -Rads(118.8)
  17.   CurrentX = 2700: CurrentY = 100
  18.   Print "20%"
  19.   Line (2800, 350)-(2800, 1000)
  20.  
  21.     FillColor = &HFFCFCE
  22.   Circle (2500, 2000), 1500, , -Rads(118.8), -Rads(172.8)
  23.   CurrentX = 200: CurrentY = 1100
  24.   Print "15%"
  25.   Line (600, 1400)-(1500, 1400)
  26.  
  27.     FillColor = 52992
  28.   Circle (2500, 2000), 1500, , -Rads(172.8), -Rads(180)
  29.   CurrentX = 200: CurrentY = 2000
  30.   Print "2%"
  31.   Line (550, 2000)-(1300, 1900)
  32.  
  33. End Sub
  34.  
  35. Private Function Rads(ByVal Degree As Single) As Single
  36.   Const PI = 22 / 7
  37.   Rads = Degree / 180 * PI
  38. End Function


4- Circle qua 3 điểm:
Vẽ 2 trung trực để xác định tâm và bán kính vòng tròn ngoại tiếp tam giác ABC
Có 3 điểm A(Ax, Ay), B(Bx, By) và C(Cx, Cy)
Trung điểm AB là M((Ax+Bx)/2, (Ay+By)/2)
Trung điểm AC là N((Ax+Cx)/2, (Ay+Cy)/2)
Line1 (trung trực) qua M (rất khó!)
Line2 (trung trực) qua N
Giao điểm Line1 và Line2 là O. OA là R

còn tiếp: tính tọa độ giao điểm O và tính R (rất khó!)
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

User avatar
truongphu
VIP
VIP
Posts: 4765
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 519 times

Re: Căn bản vẽ VB6

Postby truongphu » Wed 22/12/2010 8:57 pm

4a- Khảo sát Line giao nhau: Tính tọa độ giao điểm
bài nầy khó

Module đã thu gọn:
  1. Public Sub FindLineIntersection(Line1 As Line, Line2 As Line, _
  2.     inter_x!, inter_y!, inter_x1!, inter_y1!, inter_x2!, inter_y2!)
  3. Dim dx1!, dy1!, dx2!, dy2!, t1!, t2!, denominator!
  4.     dx1 = Line1.X2 - Line1.X1
  5.     dy1 = Line1.Y2 - Line1.Y1
  6.     dx2 = Line2.X2 - Line2.X1
  7.     dy2 = Line2.Y2 - Line2.Y1
  8.     On Error Resume Next
  9.     denominator = (dy1 * dx2 - dx1 * dy2)
  10.     t1 = ((Line1.X1 - Line2.X1) * dy2 + (Line2.Y1 - Line1.Y1) * dx2) / denominator
  11.     If Err.Number <> 0 Then
  12.         inter_x = 1E+38:          inter_y = 1E+38
  13.         inter_x1 = 1E+38:         inter_y1 = 1E+38
  14.         inter_x2 = 1E+38:         inter_y2 = 1E+38
  15.         Exit Sub
  16.     End If
  17.     On Error GoTo 0
  18.     t2 = ((Line2.X1 - Line1.X1) * dy1 + (Line1.Y1 - Line2.Y1) * dx1) / -denominator
  19.     inter_x = Line1.X1 + dx1 * t1
  20.     inter_y = Line1.Y1 + dy1 * t1
  21.     If t1 < 0 Then t1 = 0 Else If t1 > 1 Then t1 = 1
  22.     If t2 < 0 Then t2 = 0 Else If t2 > 1 Then t2 = 1
  23.     inter_x1 = Line1.X1 + dx1 * t1
  24.     inter_y1 = Line1.Y1 + dy1 * t1
  25.     inter_x2 = Line2.X1 + dx2 * t2
  26.     inter_y2 = Line2.Y1 + dy2 * t2
  27. End Sub
  28.  


Form vẽ 2 line: Line1 và Line2
Command1 có caption là: "Kiêu 4: Song song"
[vb]Private Sub Command1_Click()
Select Case Command1.Caption
Case "Kiêu 1 =Giao nhau": Command1.Caption = "Kiêu 2: Giao 1"
Line1.X1 = 2640: Line1.X2 = 480: Line1.Y1 = 360: Line1.Y2 = 1800
Line2.X1 = 2780: Line2.X2 = 3720: Line2.Y1 = 960: Line2.Y2 = 2400

Case "Kiêu 2: Giao 1": Command1.Caption = "Kiêu 3: Giao ngoài"
Line1.X1 = 2640: Line1.X2 = 480: Line1.Y1 = 360: Line1.Y2 = 1800
Line2.X1 = 3000: Line2.X2 = 3240: Line2.Y1 = 480: Line2.Y2 = 1920

Case "Kiêu 3: Giao ngoài": Command1.Caption = "Kiêu 4: Song song"
Line1.X1 = 2640: Line1.X2 = 480: Line1.Y1 = 360: Line1.Y2 = 1800
Line2.X1 = 3120: Line2.X2 = 600: Line2.Y1 = 360: Line2.Y2 = 2040

Case "Kiêu 4: Song song": Command1.Caption = "Kiêu 1 =Giao nhau"
Line1.X1 = 2640: Line1.X2 = 480: Line1.Y1 = 360: Line1.Y2 = 1800
Line2.X1 = 1680: Line2.X2 = 3240: Line2.Y1 = 360: Line2.Y2 = 1920
End Select
Me.Cls
Giao
End Sub

Private Sub Giao()
Dim X!, Y!, X1!, Y1!, X2!, Y2!
FindLineIntersection Line1, Line2, X, Y, X1, Y1, X2, Y2
If X < 1E+38 Then
If X1 <> X2 Or Y1 <> Y2 Then
DrawStyle = vbDot
Line (X, Y)-(X1, Y1), vbBlack
Line (X, Y)-(X2, Y2), vbBlack
DrawStyle = vbSolid
End If
Circle (X, Y), 20, vbGreen
End If
End Sub
[/vb]

(còn tiếp)
Attachments
các kiêu 2 line giao nhau.rar
(2.05 KiB) Downloaded 529 times
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

User avatar
truongphu
VIP
VIP
Posts: 4765
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 519 times

Re: Căn bản vẽ VB6

Postby truongphu » Thu 23/12/2010 12:52 pm

Mục 4a chúng ta đã khảo sát 2 line giao nhau, giờ chúng ta dựng đường thẳng góc (trung trực) và tính bán kính, vậy là ta vẽ được vòng tròn qua 3 điểm cho trước!

4b- Tính bán kính, dựng đường trung trực, vẽ đường tròn qua 3 điểm với hàm Cỉcle
* Module : như mục 4a
* Form: vẽ (mảng) Picture1 với index là 0, 1 và 2 (thực ra không cần mảng cũng được)
  1. Private Type Ðiêm
  2.     Xx As Long
  3.     Yy As Long
  4. End Type
  5. Dim Tâm As Ðiêm
  6.  
  7. Private Sub Command1_Click()
  8.    Dim M As Ðiêm, N As Ðiêm, A!, B!, R!
  9.    ' xác Ðinh trung Ðiêm 2 canh
  10.   M.Xx = (Picture1(0).Left + Picture1(1).Left) \ 2
  11.    M.Yy = (Picture1(0).Top + Picture1(1).Top) \ 2
  12.    N.Xx = (Picture1(0).Left + Picture1(2).Left) \ 2
  13.    N.Yy = (Picture1(0).Top + Picture1(2).Top) \ 2
  14.    ' Ve~ 2 duong trung truc
  15.   Dim dx!, dy!, length!
  16.     dx = Picture1(0).Left - Picture1(1).Left
  17.     dy = Picture1(0).Top - Picture1(1).Top
  18.     length = Sqr(dx * dx + dy * dy)
  19.     dx = dx / length * 150
  20.     dy = dy / length * 150
  21.    Line1.X1 = M.Xx: Line1.Y1 = M.Yy
  22.    Line1.X2 = M.Xx - dy: Line1.Y2 = M.Yy + dx
  23.    
  24.     dx = Picture1(2).Left - Picture1(0).Left
  25.     dy = Picture1(2).Top - Picture1(0).Top
  26.     length = Sqr(dx * dx + dy * dy)
  27.     dx = dx / length * 150
  28.     dy = dy / length * 150
  29.    Line2.X1 = N.Xx: Line2.Y1 = N.Yy
  30.    Line2.X2 = N.Xx - dy: Line2.Y2 = N.Yy + dx
  31.    
  32.    ' Tính tâm Ðiêm
  33.   Line1.BorderColor = &H8000000F: Line2.BorderColor = &H8000000F
  34.    Giao
  35.    
  36.    ' Tính bán kính R
  37.     A = Tâm.Xx - Picture1(1).Left
  38.      B = Tâm.Yy - Picture1(1).Top
  39.      R = Sqr(A * A + B * B)
  40.      Circle (Tâm.Xx, Tâm.Yy), 1
  41.      Circle (Tâm.Xx, Tâm.Yy), R
  42.      'Line (Tâm.Xx, Tâm.Yy)-(Picture1(1).Left, Picture1(1).Top), vbBlue
  43. End Sub
  44.  
  45. Private Sub Giao()
  46. Dim X!, Y!, X1!, Y1!, X2!, Y2!
  47.     FindLineIntersection Line1, Line2, X, Y, X1, Y1, X2, Y2
  48.     If X < 1E+38 Then Tâm.Xx = X: Tâm.Yy = Y
  49. End Sub
  50.  
Attachments
Vòng tròn qua 3 Ðiêm.rar
(2.27 KiB) Downloaded 530 times
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

User avatar
truongphu
VIP
VIP
Posts: 4765
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 519 times

Re: Căn bản vẽ VB6

Postby truongphu » Thu 23/12/2010 12:57 pm

5- Tham khảo vài bài nước ngoài về Line và Circle:
  1. Option Explicit
  2. Dim px(1 To 2) As Single, py(1 To 2) As Single
  3. Dim s As Long
  4. Dim ta As Single
  5. Dim pi As Single
  6. Dim Deg2Rad As Single
  7.  
  8. Private Sub Form_Load()
  9. pi = Atn(1) * 4
  10. Deg2Rad = pi / 180
  11. ScaleMode = vbPixels
  12. AutoRedraw = True
  13. ta = Tan(40 * Deg2Rad) 'ratio of two sides for 30 degrees (change angle here)
  14. px(1) = 100: py(1) = 100
  15. px(2) = 200: py(2) = 100
  16. Update
  17. End Sub
  18.  
  19. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  20. Dim d1 As Single, d2 As Single
  21. d1 = ((X - px(1)) * (X - px(1))) + ((Y - py(1)) * (Y - py(1))) 'how far from circle 1
  22. d2 = ((X - px(2)) * (X - px(2))) + ((Y - py(2)) * (Y - py(2))) 'how far from circle 2
  23. If Abs(d1 < 15 * 15) Then s = 1 'if inside circle 1 select circle 1
  24. If Abs(d2 < 15 * 15) Then s = 2 'if inside circle 2 select circle 2
  25. End Sub
  26.  
  27. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  28. If Button = vbLeftButton Then
  29. If s > 0 Then
  30. px(s) = X: py(s) = Y
  31. Update
  32. End If
  33. End If
  34. End Sub
  35.  
  36. Private Sub Update()
  37. Dim mx As Single, my As Single
  38. Dim dy As Single, dx As Single
  39. Dim cx As Single, cy As Single
  40. Dim ch As Single
  41. 'Thanks to DaftasBrush (although I had to subtract when calculating cy not add)
  42. 'http://www.xtremevbtalk.com/showthread.php?p=1134693#post1134693
  43. mx = (px(1) + px(2)) / 2 'x midpoint of line
  44. my = (py(1) + py(2)) / 2 'y midpoint of line
  45. dy = my - py(1) 'one side of right triangle
  46. dx = mx - px(1) 'other side of right triangle
  47. cx = mx + ta * dy 'apply the ratio to our sides in reverse (for 90 degree rotation)
  48. cy = my - ta * dx
  49.  
  50. Cls
  51. Circle (px(1), py(1)), 15
  52. Circle (px(2), py(2)), 15
  53. Line (px(1), py(1))-(px(2), py(2))
  54. Line -(cx, cy)
  55. Line -(px(1), py(1))
  56. DrawWidth = 5: PSet (cx, cy): DrawWidth = 1
  57. End Sub
  58.  
Attachments
Ve~ line circle di chuyen.rar
(1.67 KiB) Downloaded 537 times
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

User avatar
truongphu
VIP
VIP
Posts: 4765
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 519 times

Re: Căn bản vẽ VB6

Postby truongphu » Thu 23/12/2010 6:44 pm

6- Đo một góc:
  1. Private Type MY_POINTS
  2.     X As Long
  3.     Y As Long
  4. End Type
  5. Private ArcPoints(1 To 3) As MY_POINTS
  6. Private NextPoint As Integer
  7. Dim a(1 To 3) As Single, intL As Integer
  8. Const PI = 3.14159265358979
  9. Private Sub ClearPoints()
  10.     DrawMode = vbCopyPen
  11.     For intL = 1 To 3
  12.         lblValue(intL - 1) = ""
  13.         a(intL) = 0
  14.     Next
  15.     Cls
  16. End Sub
  17. Private Sub cmdExit_Click()
  18.     End
  19. End Sub
  20. Private Sub Form_Load()
  21.     ScaleMode = vbPixels
  22.     AutoRedraw = True
  23.     NextPoint = 1
  24. End Sub
  25. Public Function MyTan(ByVal d1 As Single, ByVal d2 As Single) As Single
  26. Select Case d2
  27.     Case Is < 0
  28.         MyTan = (PI / 2) + Atn(d1 / d2)
  29.     Case Is > 0
  30.         MyTan = (PI * 1.5) + Atn(d1 / d2)
  31.     Case Is = 0
  32.         MyTan = IIf(d1 < 0, PI, PI * 2)
  33. End Select
  34. End Function
  35. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  36. Select Case NextPoint
  37.     Case 1
  38.         ClearPoints
  39.         Circle (X, Y), 3, vbRed
  40.         NextPoint = NextPoint + 1
  41.     Case 2
  42.         Line (ArcPoints(1).X, ArcPoints(1).Y)-(ArcPoints(2).X, ArcPoints(2).Y)
  43.         NextPoint = NextPoint + 1
  44.     Case 3
  45.         NextPoint = 1
  46. End Select
  47. With ArcPoints(NextPoint)
  48.     .X = X
  49.     .Y = Y
  50. End With
  51. DrawMode = vbInvert
  52. End Sub
  53. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  54. Select Case NextPoint
  55.     Case 1
  56.         ArcPoints(1).X = X
  57.         ArcPoints(1).Y = Y
  58.     Case 2
  59.         Line (ArcPoints(1).X, ArcPoints(1).Y)-(ArcPoints(2).X, ArcPoints(2).Y)
  60.                     ArcPoints(2).X = X
  61.                     ArcPoints(2).Y = Y
  62.             a(1) = Sqr((Abs(ArcPoints(2).X - ArcPoints(1).X) ^ 2) + (Abs(ArcPoints(2).Y - ArcPoints(1).Y) ^ 2))
  63.                 lblValue(0) = "Radius = " & Format$(a(1), "0.00")
  64.             a(2) = MyTan(ArcPoints(2).X - ArcPoints(1).X, ArcPoints(2).Y - ArcPoints(1).Y)
  65.                 lblValue(1) = "Start Angle = " & Format$(a(2) * (180 / PI), "0")
  66.         Line (ArcPoints(1).X, ArcPoints(1).Y)-(ArcPoints(2).X, ArcPoints(2).Y)
  67.     Case 3
  68.         Line (ArcPoints(1).X, ArcPoints(1).Y)-(ArcPoints(3).X, ArcPoints(3).Y)
  69.         If a(3) <> 0 Then Circle (ArcPoints(1).X, ArcPoints(1).Y), a(1), vbBlack, a(2), a(3)
  70.             a(3) = MyTan(X - ArcPoints(1).X, Y - ArcPoints(1).Y)
  71.                 lblValue(2) = "End Angle = " & Format$(a(3) * (180 / PI), "0")
  72.                     ArcPoints(3).X = ArcPoints(1).X + (a(1) * (Sin(a(3) + (PI / 2))))
  73.                     ArcPoints(3).Y = ArcPoints(1).Y + (a(1) * (Cos(a(3) + (PI / 2))))
  74.         Line (ArcPoints(1).X, ArcPoints(1).Y)-(ArcPoints(3).X, ArcPoints(3).Y)
  75.         Circle (ArcPoints(1).X, ArcPoints(1).Y), a(1), vbBlack, a(2), a(3)
  76. End Select
  77. End Sub
  78.  
Attachments
howto_draw_arcs.rar
(1.96 KiB) Downloaded 496 times
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

User avatar
truongphu
VIP
VIP
Posts: 4765
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 519 times

Re: Căn bản vẽ VB6

Postby truongphu » Thu 23/12/2010 6:47 pm

7- Vẽ vòng tròn qua 3 điểm code gọn:
  1. Option Explicit
  2.  
  3. Private m_PointNum As Integer
  4. Private m_x(0 To 2)
  5. Private m_y(0 To 2)
  6.  
  7. Private Sub FindCircle(ByVal ax As Single, ByVal ay As Single, ByVal bx As Single, ByVal by As Single, ByVal cx As Single, ByVal cy As Single, ByRef ox As Single, ByRef oy As Single, ByRef radius As Single)
  8. Dim x1 As Single
  9. Dim y1 As Single
  10. Dim dx1 As Single
  11. Dim dy1 As Single
  12. Dim x2 As Single
  13. Dim y2 As Single
  14. Dim dx2 As Single
  15. Dim dy2 As Single
  16. Dim dx As Single
  17. Dim dy As Single
  18.  
  19.     ' Get the perpendicular bisector of (x1, y1) and (x2, y2).
  20.    x1 = (bx + ax) / 2
  21.     y1 = (by + ay) / 2
  22.     dy1 = bx - ax
  23.     dx1 = -(by - ay)
  24.  
  25.     ' Get the perpendicular bisector of (x2, y2) and (x3, y3).
  26.    x2 = (cx + bx) / 2
  27.     y2 = (cy + by) / 2
  28.     dy2 = cx - bx
  29.     dx2 = -(cy - by)
  30.  
  31.     ' See where the lines intersect.
  32.    ox = (y1 * dx1 * dx2 + x2 * dx1 * dy2 - x1 * dy1 * dx2 - y2 * dx1 * dx2) _
  33.         / (dx1 * dy2 - dy1 * dx2)
  34.     oy = (ox - x1) * dy1 / dx1 + y1
  35.  
  36.     dx = ox - ax
  37.     dy = oy - ay
  38.     radius = Sqr(dx * dx + dy * dy)
  39. End Sub
  40. Private Sub Form_Load()
  41.     AutoRedraw = True
  42. End Sub
  43.  
  44. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  45. Const GAP = 10
  46.  
  47. Dim cx As Single
  48. Dim cy As Single
  49. Dim radius As Single
  50.  
  51.     m_x(m_PointNum) = X
  52.     m_y(m_PointNum) = Y
  53.  
  54.     If m_PointNum = 0 Then
  55.         ' Erase the form.
  56.        Line (0, 0)-Step(ScaleWidth, ScaleHeight), BackColor, BF
  57.     End If
  58.  
  59.     ' Draw the point.
  60.    Line (X - GAP, Y - GAP)-(X + GAP, Y + GAP), vbBlack, BF
  61.  
  62.     If m_PointNum = 2 Then
  63.         m_PointNum = 0
  64.  
  65.         ' Draw the circle.
  66.        On Error Resume Next
  67.         FindCircle m_x(0), m_y(0), _
  68.             m_x(1), m_y(1), m_x(2), m_y(2), _
  69.             cx, cy, radius
  70.         If Err.Number <> 0 Then
  71.             MsgBox "No circle"
  72.         Else
  73.             Circle (cx, cy), radius
  74.         End If
  75.     Else
  76.         m_PointNum = m_PointNum + 1
  77.     End If
  78. End Sub
  79.  
Attachments
howto_circle 3 points.rar
(4.77 KiB) Downloaded 485 times
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

User avatar
truongphu
VIP
VIP
Posts: 4765
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 519 times

Re: Căn bản vẽ VB6

Postby truongphu » Thu 23/12/2010 6:51 pm

8- Thước đo độ:
  1. Private Sub Form_Load()
  2. Scale (-1, 1)-(1, -1)
  3. End Sub
  4.  
  5. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  6. On Error Resume Next
  7. Cls
  8. Line (0, 1)-(0, -1), vbBlue
  9. Line (-1, 0)-(1, 0), vbBlue
  10. Line (0, 0)-(X, Y), vbRed
  11. If Y > 0 Then
  12.     Ðô = Abs(Atn(Y / X) * 180 / 3.14159)
  13.     If X < 0 Then Ðô = 180 - Ðô
  14.     Circle (0, 0), 0.15, vbGreen, 0, Rads(Ðô)
  15. Else
  16.     Ðô = -Abs(Atn(Y / X) * 180 / 3.14159)
  17.     If X < 0 Then Ðô = -180 - Ðô
  18.     Circle (0, 0), 0.15, vbGreen, Rads(360 + Ðô), 0
  19. End If
  20.  
  21. Me.Caption = Format(Ðô, "##0")
  22. End Sub
  23.  
  24. Private Function Rads(ByVal Degree As Single) As Single
  25.   Const PI = 3.1416
  26.   Rads = (Degree / 180) * PI
  27. End Function
  28.  
Attachments
Ðo Ðô 2.rar
(1.26 KiB) Downloaded 496 times
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

thangluong23
Posts: 1
Joined: Tue 18/01/2011 2:16 pm

Re: Căn bản vẽ VB6

Postby thangluong23 » Tue 18/01/2011 2:57 pm

anh ơi cho em hỏi cách vẽ hình vuông trong đồ họa vb.nhưng phải căn chuẩn ra giữa màn hình phai làm như thế nào.em mới học vb nên dang còn kém lắm.

User avatar
truongphu
VIP
VIP
Posts: 4765
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 519 times

Re: Căn bản vẽ VB6

Postby truongphu » Wed 19/01/2011 2:26 pm

thangluong23 wrote:em mới học vb nên dang còn kém lắm.

dù bạn nói kém, nhưng đã hướng dẫn nhiều ví dụ trên rồi mà...
Đọc code phải suy nghĩ và làm thử chứ

thangluong23 wrote:phải căn chuẩn ra giữa màn hình

Form chưa nói đến tràn màn hình mà đã yêu cầu giữa màn hình? hay là giữa form?
* giữa form: u = Me.ScaleWidth \ 2 và v = Me.ScaleHeight \ 2
* Màn hình: Screen.Width và Screen.Height

Dùng lệnh Line có yếu tố B

Code: Select all

Line (u - 1000, v - 1000)-(u + 1000, v + 1000), , B


chi tiết, xem ở trên.
[mod=]Các câu hỏi, đề nghị gởi ở Box Thăc mắc[/mod]
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

thienhoang562
Thành viên chính thức
Thành viên chính thức
Posts: 15
Joined: Wed 16/03/2011 9:10 am

Re: Căn bản vẽ VB6

Postby thienhoang562 » Sun 05/06/2011 11:14 am

bài viết rất hay cảm ơn bạn....

spklion
Posts: 3
Joined: Wed 08/06/2011 6:50 pm

Re: Căn bản vẽ VB6

Postby spklion » Fri 17/06/2011 6:56 pm

ai giúp mình vẽ đồ thị bài này với được ko,vẽ hàm Ae^-kxsinwx,với k là số chu kì,w là tần số góc,vẽ nhiều chu kì sao cho biên độ lúc kết thúc bằng 1/10 biên độ A ban đầu

doduc812
Thành viên năng nổ
Thành viên năng nổ
Posts: 56
Joined: Fri 04/11/2011 8:08 pm
Has thanked: 12 times

Re: Căn bản vẽ VB6

Postby doduc812 » Wed 29/02/2012 2:24 pm

Line (500, 500)-(520, 520), vbBlue, BF
Bác TruongPhu ơi cho cháu hỏi lệnh trên là đổ đầy màu đường thẳng, vậy đường tròn hay cung tròn có được không bác?
Lệnh đó cấu trúc ntn hả bác

User avatar
truongphu
VIP
VIP
Posts: 4765
Joined: Sun 04/11/2007 10:57 am
Location: Cam Đức, Khánh hòa
Has thanked: 14 times
Been thanked: 519 times

Re: Căn bản vẽ VB6

Postby truongphu » Thu 01/03/2012 10:48 am

doduc812 wrote:đổ đầy màu đường thẳng, vậy đường tròn hay cung tròn


Mấy code nầy đã ghi ở trên, hoặc tìm trong forum có nhiều
Phải tập search chứ!

  1. Private Sub Command1_Click()
  2.     FillStyle = 0
  3.     FillColor = &H9C30FF
  4.   Circle (2500, 2000), 1500, , -Rads(46.8), -Rads(118.8)
  5. End Sub
  6.  
  7.  
  8.  
  9.  
  10. Private Function Rads(ByVal Degree As Single) As Single
  11.   Const PI = 22 / 7
  12.   Rads = Degree / 180 * PI
  13. End Function
o0o--truongphu--o0o

.........
Ghé thăm:
Chuyện Linh Tinh

doduc812
Thành viên năng nổ
Thành viên năng nổ
Posts: 56
Joined: Fri 04/11/2011 8:08 pm
Has thanked: 12 times

Re: Căn bản vẽ VB6

Postby doduc812 » Thu 01/03/2012 3:42 pm

Hic, cảm ơn bác ah! lần sau cháu sẽ cố gắng tim thật kĩ ah!

hoangtiengiaovien
Posts: 1
Joined: Mon 27/07/2015 2:35 pm

Re: Căn bản vẽ VB6

Postby hoangtiengiaovien » Mon 27/07/2015 2:45 pm

chào anh chị em lập trình một bài toán chuyển động của vật dùng lệnh vẽ Line (xy)- (x'y') và Pest(xy) để vẽ..nhưng em vẫn không biết lệnh xóa đường mà chúng vẽ ra.. tức em muốn mình có thể thay đổi độ lớn vận tốc hay chiều của vật rồi cho nó vẽ lại nhưng hình vẽ của câu lẹnh trước chưa xóa nên rất khó coi..em may mò đủ cách nhưng không biết câu lệnh thế nào..a chị cho em hỏi mình dùng câu lệnh gì để xóa nó ak


Return to “[VB] Bài viết hướng dẫn”

Who is online

Users browsing this forum: No registered users and 1 guest