Процедура печати из DBGrid
Private Sub cmdPrint_Click() '*********************************************************** '* Процедура печати данных из DBgrid * '*********************************************************** Dim c As Integer 'Номер строки Dim Dob ' Добавочная поправка к ширине столбца для привязки 'к ширине страницы Dim FlagStrWrap(15) As Integer ' Флаг переноса строки Dim i As Integer ' Номер записи в таблице Dim NumDob As Integer Dim OStrWidth Dim sss(15) Dim Str As String Dim StrWidth(15) ' Ширина столбца Dim StrWrap As String Dim StrWrapOst As String Dim StWidth(15) Dim title As String ' Заголовок таблицы Dim w As Integer ' Позиция пробела Dim x As Integer 'Координата позиции печати X Dim xRom As Integer ' Хранит приращение координаты X при 'переносе строки Dim xx As Integer 'Приращение координаты X Dim Y As Integer 'Координата позиции печати Y Dim z As Integer ' Номер столбца (в 1-м цикле) Dim zz As Integer ' Номер столбца (во 2-м вложенном цикле) Dim zzz As Integer ' Номер столбца (в 3-м вложенном цикле) MousePointer = 11 'Задание пользовательской системы координат x = Printer.ScaleWidth * 0.01 Y = Printer.ScaleHeight * 0.02 'Установка свойств объекта Printer Printer.FontName = "Arial Cyr" Printer.FontSize = 10 Printer.FontBold = False '*************************************** 'Предварительный расчет ширины столбцов '*************************************** 'Считывание названий полей из DBGrid For z = 0 To Grid.Columns.Count - 1 Step 1 StrWidth(z) = Grid.Columns(z).DataField Next z 'Измерение максимальной ширины текстовых данных в 'столбцах DBGrid DataReport.Recordset.MoveFirst For i = 0 To DataReport.Recordset.RecordCount - 1 For z = 0 To Grid.Columns.Count - 1 Step 1 Str = DataReport.Recordset.Fields(Grid.Columns(z).DataField).Value If Len(Str) > Len(StrWidth(z)) Then 'Проверка на превышение допустимой длины строки If Printer.TextWidth(Str) > 25 * x Then StrWrap = Left(Str, InStr(w + 1, Str, " ", vbTextCompare) - 1) VarWidth: If Printer.TextWidth(StrWrap) <25 * x Then w="InStr(w" + 1, Str, " ") ' следующая позиция пробела StrWrap = Left(Str, InStr(w + 1, Str, " ", vbTextCompare) - 1) If Not InStr(w + 1, Str, " ", vbTextCompare) - 1 = 0 Then GoTo VarWidth End If StrWidth(z) = StrWrap GoTo 610 End If StrWidth(z) = Grid.Columns(z).Text 610 End If Next z DataReport.Recordset.MoveNext Next i DataReport.Recordset.MoveFirst Str = 0 c = 1 xx = 12 For z = 0 To Grid.Columns.Count - 1 Step 1 StWidth(z) = Printer.TextWidth(StrWidth(z)) OStrWidth = OStrWidth + StWidth(z) Next z 'Учет незадействованной ширины листа и равномерное 'распределение ее по столцам Dob = (Printer.ScaleWidth - OStrWidth - 1847) / _ (Grid.Columns.Count - 1) If Dob <1 Then GoTo 10 NumDob="(Printer.ScaleWidth" OStrWidth 1847) / Dob For z="0" To NumDob Step 1 StWidth(z)="StWidth(z)" + Dob Next z '********************* 'Формирование таблицы '********************* 'Печать заголовка таблицы Grid 10 xx = 8 title = Grid.Caption c = c + 1 Printer.FontSize = 8 Printer.CurrentX = (Printer.ScaleWidth - Printer.TextWidth(title)) / 2 Printer.CurrentY = Y * c Printer.Print title c = c + 1 'Печать вертикальной линии шапки таблицы Printer.DrawWidth = 2 Printer.Line (x * 8, Y * c)-(x * 94, Y * c) Printer.DrawWidth = 1 'Печать названий столбцов For z = 0 To Grid.Columns.Count - 1 Step 1 sss(z) = Grid.Columns(z).DataField Printer.CurrentX = x * (xx + 0.4) Printer.CurrentY = Y * (c + 0.2) Printer.Print sss(z) xx = xx + (StWidth(z) / (Printer.ScaleWidth / 100)) Next z xx = 8 'Печать вертикальных разделительных линий For z = 0 To Grid.Columns.Count - 1 Step 1 If z = 0 Then Printer.DrawWidth = 2 Else Printer.DrawWidth = 1 End If Printer.Line (x * xx, Y * c)-(x * xx, Y * (c + 1)) xx = xx + (StWidth(z) / (Printer.ScaleWidth / 100)) Next z Printer.DrawWidth = 2 Printer.Line (x * 94, Y * c)-(x * 94, Y * (c + 1)) Printer.DrawWidth = 1 c = c + 1 xx = 8 '************** 'Печать данных '************** DataReport.Recordset.MoveFirst For i = 0 To DataReport.Recordset.RecordCount - 1 For z = 0 To Grid.Columns.Count - 1 Step 1 '****************************************************** 'Проверка, не превысило ли количество строк назначенное 'для страницы значение If c > 38 Then 'Завершение текущей страницы Printer.CurrentX = x * 84 Printer.CurrentY = Y * (39.1) Printer.Print "Стр. "; Printer.page Printer.DrawWidth = 2 Printer.Line (x * 8, Y * c)-(x * 94, Y * c) Printer.DrawWidth = 1 '********************** 'Начало новой страницы '********************** Printer.NewPage c = 1 'Печать верхней линии шапки таблицы Printer.DrawWidth = 2 Printer.Line (x * 8, Y * c)-(x * 94, Y * c) Printer.DrawWidth = 1 'Печать названия столбцов For zz = 0 To Grid.Columns.Count - 1 Step 1 sss(zz) = Grid.Columns(zz).DataField Printer.CurrentX = x * (xx + 0.4) Printer.CurrentY = Y * (c + 0.2) Printer.Print sss(zz) xx = xx + (StWidth(zz) / (Printer.ScaleWidth / 100)) Next zz xx = 8 'Печать вертикальных разделительных линий For zz = 0 To Grid.Columns.Count - 1 Step 1 If zz = 0 Then Printer.DrawWidth = 2 Else Printer.DrawWidth = 1 End If Printer.Line (x * xx, Y * c)-(x * xx, Y * (c + 1)) xx = xx + (StWidth(zz) / (Printer.ScaleWidth / 100)) Next zz 'Печать крайней правой вертикальной линии Printer.DrawWidth = 2 Printer.Line (x * 94, Y * c)-(x * 94, Y * (c + 1)) Printer.DrawWidth = 1 c = c + 1 xx = 8 End If 'Окончание цикла, предназначенного для перехода на новую 'страницу '************************************************************ 'печать данных Printer.CurrentX = x * (xx + 0.4) Printer.CurrentY = Y * (c + 0.2) Str = DataReport.Recordset.Fields(Grid.Columns(z) _ .DataField).Value 'проверка, не превышает ли длина данных в строке 'величину в 25 позиций печати для последующей 'организации переноса оставшейся части строки If Printer.TextWidth(Str) > 25 * x Then Transportation: StrWrap = Left(Str, InStr(w + 1, Str, " ") - 1) If Printer.TextWidth(StrWrap) <25 * x Then w="InStr(w" + 1, Str, " ") GoTo Transportation End If Str="StrWrap" 'Установка флага переноса строки FlagStrWrap(z) = 1 xRom = xx StrWrapOst = Mid(DataReport.Recordset.Fields(Grid.Columns(z) _ .DataField).Value, Len(Str) + 1) Else FlagStrWrap(z) = 0 End If Printer.Print Str xx = xx + (StWidth(z) / (Printer.ScaleWidth / 100)) Next z 'Печать вертикальных разделительных линий xx = 8 For z = 0 To Grid.Columns.Count - 1 Step 1 If z = 0 Then Printer.DrawWidth = 2 Else Printer.DrawWidth = 1 End If Printer.Line (x * xx, Y * c)-(x * xx, Y * (c + 1)) xx = xx + (StWidth(z) / (Printer.ScaleWidth / 100)) Next z Printer.DrawWidth = 2 Printer.Line (x * 94, Y * c)-(x * 94, Y * (c + 1)) Printer.DrawWidth = 1 Printer.Line (x * 8, Y * c)-(x * 94, Y * c) c = c + 1 DataReport.Recordset.MoveNext '***************************************** 'Печать остатка строки '***************************************** For zz = 0 To Grid.Columns.Count - 1 Step 1 If FlagStrWrap(zz) = 1 Then xx = xRom Printer.CurrentX = x * (xx + 0.4) Printer.CurrentY = Y * (c + 0.2) Printer.Print StrWrapOst xx = 8 For zzz = 0 To Grid.Columns.Count - 1 Step 1 If zzz = 0 Then Printer.DrawWidth = 2 Else Printer.DrawWidth = 1 End If Printer.Line (x * xx, Y * c)-(x * xx, Y * (c + 1)) Printer.DrawWidth = 2 Printer.Line (x * 94, Y * c)-(x * 94, Y * (c + 1)) Printer.DrawWidth = 1 xx = xx + (StWidth(zzz) / (Printer.ScaleWidth / 100)) Next zzz c = c + 1 End If Next zz xx = 8 Next i DataReport.Recordset.MoveFirst Printer.DrawWidth = 1 Printer.Line (x * 8, Y * c)-(x * 94, Y * c) 'Печать суммирующей строки из DBGrid Grid2 For z = 0 To Grid.Columns.Count - 1 Step 1 If z = Grid.Columns.Count - 3 Then Printer.CurrentX = x * (xx + 0.4) Printer.CurrentY = Y * (c + 0.2) 'Печать названия итоговой величины из DBGrid Grid2 Printer.Print Grid2.Columns(0).DataField End If If z = Grid.Columns.Count - 1 Then Printer.CurrentX = x * (xx + 0.4) Printer.CurrentY = Y * (c + 0.2) 'Печать итоговой суммы из DBGrid Grid2 Printer.Print Grid2.Columns(0).Text End If xx = xx + (StWidth(z) / (Printer.ScaleWidth / 100)) Next z Printer.DrawWidth = 2 Printer.Line (x * 8, Y * c)-(x * 8, Y * (c + 1)) Printer.Line (x * 94, Y * c)-(x * 94, Y * (c + 1)) c = c + 1 Printer.Line (x * 8, Y * c)-(x * 94, Y * c) Printer.DrawWidth = 1 Printer.CurrentX = x * 84 Printer.CurrentY = Y * 39.1 Printer.Print "Стр. "; Printer.page 'Завершение построения отчета и физическая печать MousePointer = 0 Printer.EndDoc PrintError: MousePointer = 0 End Sub