Программирование на Visual Basic

06. Используя небольшое количество графических функций отчета можно нарисовать линии, окружности и т.п.

'  Нарисовать объект (линию, прямоугольник) из таблицы
Private Sub newObject(rpt As Report, sTable As String)
Dim dbs As Database, rst As Recordset, i As Integer
Const PI = 3.14
    With rpt
        .ScaleMode = 6 'Рисуем в миллиметрах
        .FontName = "Arial" 'Выбираем шрифт
        .FontSize = 8 'Размер шрифта
        .ForeColor = 0 'Цвет объектов
    End With
    Set dbs = CurrentDb 'Текущая база данных
    Set rst = dbs.OpenRecordset(sTable) 'Открываем таблицу
    If rst.RecordCount  0 Then
        rst.MoveLast  'Заполняем запрос
        rst.MoveFirst 'Устанавливаем позицию
        For i = 0 To rst.RecordCount - 1 'Просматриваем запрос
          If rst!B = True Then 'Это прямоугольник
            rpt.Line (rst!x1, rst!y1)-(rst!x2, rst!y2), 0, B
          Else 'Это линия
            rpt.Line (rst!x1, rst!y1)-(rst!x2, rst!y2)
          End If
          rst.MoveNext 'Следующий элемент
        Next
    End If
    rst.Close
    'Рисуем окружность, элипс и дугу в радианах
    rpt.ForeColor = RGB(255, 0, 0) 'Красный цвет
    rpt.Circle (40, 20), 7 'Окружность
    rpt.ForeColor = RGB(0, 255, 0) 'Зеленый цвет
    rpt.Circle (40, 50), 20, , , , 0.5 'Элипс
    rpt.ForeColor = RGB(0, 0, 255) 'Синий цвет
    rpt.Circle (40, 50), 10, , PI / 2 + 0.5, PI, 0.5 'Дуга
End Sub