VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "VisRectangle"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'Klasa VisRectangle
Implements Drawing
Dim x As Integer, y As Integer, w As Integer, h As Integer
Private rect As Rectangle
Private selected As Boolean
Private filled As Boolean
Private fillColor As ColorConstants
'-----
Public Sub init(xp As Integer, yp As Integer)
  x = xp                          'Przechowaj współrzędne
  y = yp
  w = 40                          'Domyślne wymiary
  h = 30
  fillColor = vbRed
  saveAsRect
End Sub
'-----
'Metody właściwości uzywane do przechowania i odtwarzania stanu
Property Get rects() As Rectangle
  Set rects = rect
End Property
'-----
Property Set rects(rc As Rectangle)
  x = rc.x
  y = rc.y
  w = rc.w
  h = rc.h
  saveAsRect
End Property

Private Function Drawing_contains(xp As Integer, yp As Integer) As Boolean
  Drawing_contains = rect.contains(xp, yp)
End Function

Private Sub Drawing_draw(Pic As PictureBox)
  If filled Then
    Pic.Line (x, y)-(x + w, y + h), fillColor, BF
  End If
  Pic.Line (x, y)-(x + w, y + h), , B
  If selected Then   'Narysuj uchwyty
    Pic.Line (x + w / 2, y - 2)- _
              (x + w / 2 + 4, y + 2), , BF
    Pic.Line (x - 2, y + h / 2)- _
              (x + 2, y + h / 2 + 4), , BF
    Pic.Line (x + (w / 2), y + h - 2)- _
              (x + (w / 2) + 4, y + h + 2), , BF
    Pic.Line (x + (w - 2), y + (h / 2))- _
              (x + (w + 2), y + (h / 2) + 4), , BF
  End If
End Sub

Private Sub Drawing_move(xpt As Integer, ypt As Integer)
  x = xpt
  y = ypt
  saveAsRect
End Sub

Private Sub saveAsRect()
  Set rect = New Rectangle
  rect.init x, y, w, h
End Sub

Private Property Set Drawing_rects(rc As Rectangle)
  x = rc.x
  y = rc.y
  w = rc.w
  h = rc.h
  saveAsRect
End Property

Private Property Get Drawing_rects() As Rectangle
  Set Drawing_rects = rect
End Property

Private Sub Drawing_setFill(b As Boolean)
  filled = b
End Sub

Private Sub Drawing_setSelected(b As Boolean)
  selected = b
End Sub
