[ Vto 4Idi0tzZ @ 05.12.2008. 23:18 ] @
E ovako, imam problem, treba da prepravim zadatak za crtanje... inace nudi opcije za crtanje duzi, slobodnog oblika i kruga... a meni je zadato da umjesto kruga pravi pravougaonik... pokusao sam sa umetanjem formule dijagonale i nije upalilo, i sami znate zasto... evo koda, pa ako neko moze pomoci bio bih mu zahvalan... bas puno :D Code: Option Explicit 'Deklarise varijable za sve podprograme i objekte Dim CentreX As Integer, CentreY As Integer Dim StartX As Integer, StartY As Integer Dim Started As Boolean Private Sub Command1_Click() End End Sub Private Sub hsbBoje_Change(Index As Integer) lblUzorak.BackColor = RGB(CInt(lblBoje(0).Caption), CInt(lblBoje(1).Caption), CInt(lblBoje(2).Caption)) lblBoje(Index).Caption = hsbBoje(Index).Value picSlika.ForeColor = lblUzorak.BackColor End Sub Private Sub hsbBoje_Scroll(Index As Integer) lblUzorak.BackColor = RGB(CInt(lblBoje(0).Caption), CInt(lblBoje(1).Caption), CInt(lblBoje(2).Caption)) lblBoje(Index).Caption = hsbBoje(Index).Value picSlika.ForeColor = lblUzorak.BackColor End Sub Private Sub hsbDebljina_Change() lblDebljina.Caption = hsbDebljina.Value picSlika.DrawWidth = hsbDebljina.Value End Sub Private Sub picSlika_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim DrawingStyle As Integer DrawingStyle = GetStil() If Button = vbLeftButton Then Select Case DrawingStyle Case 0 'slobodna linija picSlika.PSet (X, Y) Case 1 'Linija StartX = X StartY = Y Case 2 'Krug 'Odredjuje centar kruga CentreX = X CentreY = Y End Select Else picSlika.Cls End If End Sub Private Sub picSlika_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Static OldX As Integer, OldY As Integer Dim Radius As Double Dim DrawingStyle As Integer DrawingStyle = GetStil() 'Crta ako je ljevo dugme misa pritisnuto If Button = vbLeftButton Then Select Case DrawingStyle Case 0 'Slobodna linija picSlika.Line -(X, Y) Case 1 'Linija 'Mijenja mod crtanja picSlika.DrawMode = vbInvert 'Ako crtate novu linijju morate izbriasti staru If Started = True Then picSlika.Line (StartX, StartY)-(OldX, OldY) End If picSlika.Line (StartX, StartY)-(X, Y) Started = True 'Upamti tekuce koordinate misa OldX = X OldY = Y Case 2 'Krug 'Mijenja mod crtanja picSlika.DrawMode = vbInvert 'Ako crtate novu liniju morate izbrisati staru If Started = True Then 'Racuna radijus kruga preko pitagorine teoreme Radius = Sqr((OldX - CentreX) ^ 2 + (OldY - CentreX) ^ 2) picSlika.Circle (CentreX, CentreY), Radius End If 'Crta novi krug Radius = Sqr((X - CentreX) ^ 2 + (Y - CentreX) ^ 2) picSlika.Circle (CentreX, CentreY), Radius Started = True 'Upamti tekuce koorddinate misa OldX = X OldY = Y End Select End If End Sub Private Sub picSlika_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim Radius As Double Dim DrawingStyle As Integer DrawingStyle = GetStil() If Button = vbLeftButton Then Select Case DrawingStyle Case 1 'Linija 'Mijenja mod crtanja picSlika.DrawMode = vbCopyPen picSlika.Line (StartX, StartY)-(X, Y) Case 2 'Krug 'Mijenja mod crtanja picSlika.DrawMode = vbCopyPen 'Koristi pitagorinu teremu za radijus Radius = Sqr((X - CentreX) ^ 2 + (Y - CentreX) ^ 2) picSlika.Circle (CentreX, CentreY), Radius End Select End If Started = False End Sub Private Function GetStil() As Integer Dim Counter As Integer For Counter = 0 To 2 If optStil(Counter).Value = True Then GetStil = Counter End If Next Counter End Function |