سلام
يه دوستي به برنامه نسبتا ساده ميخواد كه يه دايره باشه كه به قطاع هاي مساوي تقسيم شده باشه و رنگها به طور متناوب توش عوض بشن ...
با دلفي
فكر نكنم خيلي وقت بگيره ولي من دلفي كار نكردم .
اگر كسي تونست تو همين يكي دو روزه فوري رو سايت بزاره . اون دوستم دعاش ميكنه :wink:
چاكريم
سلام
من خودم برنامش رو با ويژوال بيسيك نوشتم روي سايت هم به اين آدرس گذاشتم:
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