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
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