برنامه يه دايره رنگي چرخان !

[NabiKAZ]

سلام
يه دوستي به برنامه نسبتا ساده ميخواد كه يه دايره باشه كه به قطاع هاي مساوي تقسيم شده باشه و رنگها به طور متناوب توش عوض بشن ...
با دلفي
فكر نكنم خيلي وقت بگيره ولي من دلفي كار نكردم .
اگر كسي تونست تو همين يكي دو روزه فوري رو سايت بزاره . اون دوستم دعاش ميكنه :wink:

چاكريم

[NabiKAZ]

سلام
من خودم برنامش رو با ويژوال بيسيك نوشتم روي سايت هم به اين آدرس گذاشتم:
http://www.iranvig.com/3063.html
اصل سورس هم پايين اوردم فقط اگر كسي بتونه اون بخشهاي عمدش رو به دلفي تبديل كنه ممنون ميشم .
راستي تابعي كه عمل Fill (ريختن رنگ) رو انجام بده پيدا نكردم و از تابع اي پي اي ExtFloodFill استفاده كردم راه ديگه نبود؟

تشكر
نبي

اينم اصل سورس:

کد:

'Programmer: Nabi K.A.Z.
'Email: NabiKAZ2001_se@yahoo.com
'Website: http://www.AhwazServer.com
'===================================

Const pi = 3.14159
Dim color(1 To 1000) As Long
Dim n As Integer
Dim x As Integer, y As Integer
Dim Flag_Color As String

' To fill an area
Private Declare Sub _
  ExtFloodFill Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, _
                            ByVal y As Long, ByVal crColor As Long, _
                            ByVal wFillType As Long)
                            

Private Sub Command1_Click()
Timer1.Interval = Text2.Text

If Val(Text1.Text) <= 0 Then MsgBox "Out of range", vbCritical, "Error": Text1.Text = n: Exit Sub
n = Text1.Text
For i = 1 To n
    Select Case Flag_Color
        Case "blue": color(i) = RGB(0, 0, i * (255 / n))
        Case "red": color(i) = RGB(i * (255 / n), 0, 0)
        Case "green": color(i) = RGB(0, i * (255 / n), 0)
    End Select
Next i
End Sub



Private Sub Command3_Click()
Flag_Color = "blue"
Call Command1_Click

End Sub

Private Sub Command4_Click()
Flag_Color = "red"
Call Command1_Click

End Sub

Private Sub Command5_Click()
Flag_Color = "green"
Call Command1_Click

End Sub

Private Sub Form_Load()
picPaint.DrawMode = vbCopyPen
picPaint.FillStyle = 0
picPaint.AutoRedraw = True
Timer1.Interval = 1
Flag_Color = "blue"

Call Command1_Click
Call Refresh_Form

End Sub


Private Sub Form_Resize()
picPaint.Width = frmCircle.ScaleWidth - 2 * picPaint.Left
frmCircle.Height = frmCircle.Width + 15 * picPaint.Top
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Command1_Click
If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then
    KeyAscii = 0
End If
End Sub



Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Command1_Click
If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then
    KeyAscii = 0
End If
End Sub

Private Sub Timer1_Timer()
temp = color(1)
For i = 1 To n - 1
color(i) = color(i + 1)
Next i
color(n) = temp
Call Refresh_Form

End Sub

Sub Refresh_Form()
picPaint.Height = picPaint.Width
x = picPaint.ScaleWidth / 2
y = picPaint.ScaleHeight / 2
r = picPaint.ScaleWidth / 2
picPaint.ForeColor = RGB(255, 255, 255)
picPaint.Cls

picPaint.Circle (x, y), r
d = 360 / n
For i = 1 To n
    picPaint.Line (x, y)-(x + Cos((i * d) * pi / 180) * (r + 2), y - Sin((i * d) * pi / 180) * (r + 2))
    X1 = x + Cos(((i * d) - (d / 2)) * pi / 180) * (r / 2)
    Y1 = y - Sin(((i * d) - (d / 2)) * pi / 180) * (r / 2)
    picPaint.FillColor = color(i)
    ExtFloodFill picPaint.hDC, X1, Y1, picPaint.Point(X1, Y1), 1
Next i
End Sub