[es] - Program za crtanje, kako da konstruise pravougaonik?

Vto 4Idi0tzZ
skola, ucenik
Gradiska

Član broj: 203890
Poruke: 2
*.gradiska.com.

Profil

Program za crtanje, kako da konstruise pravougaonik?

^{05.12.2008. u 23:18 - pre 187 meseci}

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

Odgovor na temu