我寫了一個程式,是類似液位的改變..
目的:
程式如下
先加入模組,在模組中寫入
Declare Function FloodFill Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Declare Function GetTickCount Lib "kernel32" () As Long
然後表單的程式如下
Public x1, x2, x3 As Single
Public y1, y2, y3 As Single
Public x_1 As Single
Private Sub Command1_Click()
End
End Sub
Private Sub Form_activate()
ScaleMode = 3
ForeColor = RGB(0, 0, 0)
'三角形的三個點
  x1 = 100
  x2 = 200
  x3 = 300
  y1 = 200
  y2 = 50
  y3 = 200
  Line (x1, y1)-(x2, y2)
  Line -(x3, y3)
  Line -(x1, y1)
  FillStyle = 0
  FillColor = RGB(255, 255, 255)
  r = FloodFill(hdc, 200, 51, ForeColor)
  
For x_1 = 100 To 300 Step 20
Call coeff(x, y, a1, a2, b1, b2)

'延遲
  t = GetTickCount()
  Do
  DoEvents
  Loop Until GetTickCount - t >= 500 '數字愈多,延遲愈久

Next
End Sub
Public Function coeff(x, y, a1, a2, b1, b2)
'計算由三角形三個點構成的直線係數
  'y=a*x+b
  a1 = (y1 - y2) / (x1 - x2)
  b1 = y1 - a1 * x1
  a2 = (y2 - y3) / (x2 - x3)
  b2 = y2 - a2 * x2
  '給定任何一個x值,計算高度
If x_1 <= 200 Then
y = a1 * x_1 + b1
  x = (y - b2) / a2
Else
y = a2 * x_1 + b2
  x = (y - b1) / a1
End If
'在三角形中畫高度線
  Line (x_1, y)-(x, y)

'填滿高度
  FillColor = RGB(128, 128, 255)
  If y + 1 >= y3 Then y = y3 - 1
  g = FloodFill(hdc, 200, y + 1, ForeColor)
  
End Function
但是這樣子的寫法有問題想請大家幫幫忙..
Q1:高度線會有好幾條畫在表單的三角形上..我希望一次就是一條..
Q2:填滿顏色的部分一開始有達到我想看到的..不斷升高..但是卻
下不來..我希望填滿顏色的部分隨著我的高度線改變..
arrow
arrow
    全站熱搜

    vbqa 發表在 痞客邦 留言(4) 人氣()