Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / наПечать *.TIF файл / 11 сообщений из 11, страница 1 из 1
23.09.2009, 12:40
    #36212340
Mazai-XZ
Mazai-XZ
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
наПечать *.TIF файл
Всем доброго дня! Подскажите, как при помощи VB60 Распечатать файл tif - формата. Выводить на экран сам файл не обязательно, просто нужно по нажатию кнопки распечатывать его. Благодарю за внимание! )
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
23.09.2009, 15:51
    #36212907
Бенедикт
Бенедикт
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
наПечать *.TIF файл
Mazai-XZ,
при наличии в системе GDI+:
Первый модуль:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
Option Explicit

Private Enum PICTYPE
   PICTYPE_UNINITIALIZED = - 1 
   PICTYPE_NONE =  0 
   PICTYPE_BITMAP =  1 
   PICTYPE_METAFILE =  2 
   PICTYPE_ICON =  3 
   PICTYPE_ENHMETAFILE =  4 
End Enum

Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4( 0  To  7 ) As Byte
End Type

Private Type PicBmp
   Size As Long
   Type As PICTYPE
   hBmp As Long
   hPal As Long
   Reserved As Long
End Type

Private Declare Function OleCreatePictureIndirect Lib "olepro32" ( _
   PicDesc As PicBmp, RefIID As GUID, _
   ByVal fPictureOwnsHandle As Long, IPic As IPictureDisp) As Long

Public Function CreateIPictureDispFromHBITMAP( _
   ByVal hBitmap As Long) As IPictureDisp
 Dim IID_IDispatch As GUID
 Dim Pic As PicBmp

 With Pic
    .Size = Len(Pic)
    .Type = PICTYPE_BITMAP
    .hBmp = hBitmap
    .hPal =  0 
 End With
 With IID_IDispatch
    .Data1 = &H20400
    .Data4( 0 ) = &HC0
    .Data4( 7 ) = &H46
 End With
 OleCreatePictureIndirect Pic, IID_IDispatch,  1 , CreateIPictureDispFromHBITMAP
End Function
Второй модуль:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
Option Explicit

Private Type GdiplusStartupInput
   GdiplusVersion As Long
   DebugEventCallback As Long
   SuppressBackgroundThread As Long
   SuppressExternalCodecs As Long
End Type

Private Declare Function GdiplusStartup Lib "gdiplus" ( _
   rToken As Long, rInput As GdiplusStartupInput, pvOutput As Any) As Long

Private Declare Sub GdiplusShutdown Lib "gdiplus" ( _
   ByVal token As Long)

Private Declare Function GdipCreateBitmapFromFile Lib "gdiplus" ( _
   ByVal FileNamePtr As Long, nBitmap As Long) As Long

Private Declare Function GdipDisposeImage Lib "gdiplus" ( _
   ByVal nImage As Long) As Long

Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" ( _
   ByVal nBitmap As Long, hbmReturn As Long, _
   ByVal ARGBBackground As Long) As Long

Public Function LoadBitmapPicture(ByVal FileName As String) As IPictureDisp
 Dim GdipSession As Long
 Dim gpsi As GdiplusStartupInput
 Dim nBitmap As Long
 Dim hBitmap As Long
 Dim Pic As IPictureDisp
 
 With gpsi
    .GdiplusVersion =  1 
    .DebugEventCallback =  0 
    .SuppressBackgroundThread =  0 
    .SuppressExternalCodecs =  1 
 End With
 
 If GdiplusStartup(GdipSession, gpsi, ByVal  0 &) Then
    MsgBox "GDI+ Initialization Failed", vbCritical, "LoadBitmapPicture()"
    Exit Function
 End If
 
 GdipCreateBitmapFromFile StrPtr(FileName), nBitmap
 GdipCreateHBITMAPFromBitmap nBitmap, hBitmap,  0 
 Set LoadBitmapPicture = CreateIPictureDispFromHBITMAP(hBitmap)
 GdipDisposeImage nBitmap
 
 GdiplusShutdown GdipSession
End Function
Простейшая печать:
Код: plaintext
1.
2.
3.
4.
Private Sub Command1_Click()
 Printer.ScaleMode = vbMillimeters
 Printer.PaintPicture LoadBitmapPicture("C:\File.tif"),  15 ,  15 
 Printer.EndDoc
End Sub
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
24.09.2009, 10:27
    #36214193
Mazai-XZ
Mazai-XZ
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
наПечать *.TIF файл
Бенедикт, Спасибо огромное за содействие, но к сожалению ошибка вылетает ((( ругается на LoadBitmapPicture (sub or Function not Defined) =( мож в референсах добавить надобно чего?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
24.09.2009, 10:51
    #36214275
Игорь Горбонос
Игорь Горбонос
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
наПечать *.TIF файл
> Автор: Mazai-XZ
> Бенедикт, Спасибо огромное за содействие, но к сожалению ошибка вылетает ((( ругается на LoadBitmapPicture (sub
> or Function not Defined) =( мож в референсах добавить надобно чего?

ты точно сделал 2 модуля, в которые поместил соответствующий код?


Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
24.09.2009, 11:20
    #36214398
Бенедикт
Бенедикт
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
наПечать *.TIF файл
Mazai-XZ,
В References должна быть ссылка на библиотеку типов OLE Automation.
А так - просто создайте два модуля (или объедините в один) и сделайте Copy-Paste.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
24.09.2009, 14:34
    #36215075
Mazai-XZ
Mazai-XZ
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
наПечать *.TIF файл
Бенедикт, Игорь Горбонос , Огромное спасибо! Проблема была м моём раздолбайстве. Сделал 2 модуля и всё заработало на ура. теперь небольшая проблемка: можно-ли как-то настроить размер изображения? Суть в том, что этот тиф файл - набор сканов документов, где 1 скан = 1 страница, при проверочной печати получил результат: четверть скана на 1 страницу, можно как-то установить в свойствах принтера пропорции? При печати документа через Microsoft Office Document Imaging печать проходит корректно. Спасибо!
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
24.09.2009, 15:04
    #36215191
Mazai-XZ
Mazai-XZ
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
наПечать *.TIF файл
А! Всё, разобрался! ))) Нужно было добавить ещё и размеры скана ))) Правда теперь другая проблемка всплыла: так как документ это набор сканов, в нём содержатся 24 страницы, как вывести их ВСЕ на печать?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
24.09.2009, 18:39
    #36215853
Бенедикт
Бенедикт
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
наПечать *.TIF файл
Mazai-XZ,
Хорошо, что в данном случае переделка много времени не занимает, но о таких деталях неплохо бы говорить заранее.
Второй модуль заменим на модуль класса CMultiFrameImage:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
Option Explicit


Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4( 0  To  7 ) As Byte
End Type


Private Enum GpStatus
   OK =  0 
   GenericError =  1 
   InvalidParameter =  2 
   OutOfMemory =  3 
   ObjectBusy =  4 
   InsufficientBuffer =  5 
   NotImplemented =  6 
   Win32Error =  7 
   WrongState =  8 
   Aborted =  9 
   FileNotFound =  10 
   ValueOverflow =  11 
   AccessDenied =  12 
   UnknownImageFormat =  13 
   FontFamilyNotFound =  14 
   FontStyleNotFound =  15 
   NotTrueTypeFont =  16 
   UnsupportedGdiplusVersion =  17 
   GdiplusNotInitialized =  18 
   PropertyNotFound =  19 
   PropertyNotSupported =  20 
   ProfileNotFound =  21 
End Enum

Private Type GdiplusStartupInput
   GdiplusVersion As Long
   DebugEventCallback As Long
   SuppressBackgroundThread As Long
   SuppressExternalCodecs As Long
End Type

Private Declare Function GdiplusStartup Lib "gdiplus" ( _
   rToken As Long, rInput As GdiplusStartupInput, pvOutput As Any) As GpStatus

Private Declare Sub GdiplusShutdown Lib "gdiplus" ( _
   ByVal token As Long)

Private Declare Function GdipCreateBitmapFromFile Lib "gdiplus" ( _
   ByVal FileNamePtr As Long, nBitmap As Long) As GpStatus

Private Declare Function GdipDisposeImage Lib "gdiplus" ( _
   ByVal nImage As Long) As GpStatus

Private Declare Function GdipCreateHBITMAPFromBitmap Lib "gdiplus" ( _
   ByVal nBitmap As Long, hbmReturn As Long, _
   ByVal ARGBBackground As Long) As GpStatus

Private Declare Function GdipImageGetFrameDimensionsCount Lib "gdiplus" ( _
   ByVal nImage As Long, nCount As Long) As GpStatus
Private Declare Function GdipImageGetFrameDimensionsList Lib "gdiplus" ( _
   ByVal nImage As Long, DimensionIDs As GUID, ByVal nCount As Long) As GpStatus
Private Declare Function GdipImageGetFrameCount Lib "gdiplus" ( _
   ByVal nImage As Long, DimensionID As GUID, nCount As Long) As GpStatus
Private Declare Function GdipImageSelectActiveFrame Lib "gdiplus" ( _
   ByVal nImage As Long, DimensionID As GUID, _
   ByVal nFrameIndex As Long) As GpStatus


Private m_GdipSession As Long
Private m_nBitmap As Long
Private m_nFrameCount As Long
Private m_DimensionIDs() As GUID


Public Function LoadFromFile(ByVal FileName As String) As IPictureDisp
 Dim gpsi As GdiplusStartupInput
 Dim nBitmap As Long
 Dim hBitmap As Long
 Dim Pic As IPictureDisp
 
 If m_GdipSession =  0  Then
    With gpsi
       .GdiplusVersion =  1 
       .DebugEventCallback =  0 
       .SuppressBackgroundThread =  0 
       .SuppressExternalCodecs =  1 
    End With
    
    If GdiplusStartup(m_GdipSession, gpsi, ByVal  0 &) <> OK Then
       MsgBox "GDI+ Initialization Failed", vbCritical, "LoadFromFile()"
       Exit Function
    End If
 End If
 
 If m_nBitmap Then
    GdipDisposeImage m_nBitmap
    m_nBitmap =  0 
 End If
 m_nFrameCount =  0 
 If GdipCreateBitmapFromFile(StrPtr(FileName), m_nBitmap) = OK Then
    If GdipCreateHBITMAPFromBitmap(m_nBitmap, hBitmap,  0 ) = OK Then
       Set LoadFromFile = CreateIPictureDispFromHBITMAP(hBitmap)
    End If
 End If
End Function

Public Property Get FrameCount() As Long
 Dim nDimsCount As Long
 If m_nFrameCount =  0  Then
    If m_nBitmap Then
       If GdipImageGetFrameDimensionsCount(m_nBitmap, nDimsCount) = OK Then
          If nDimsCount >  0  Then
             ReDim m_DimensionIDs( 0  To nDimsCount -  1 ) As GUID
             GdipImageGetFrameDimensionsList m_nBitmap, m_DimensionIDs( 0 ), _
                                             nDimsCount
             GdipImageGetFrameCount m_nBitmap, m_DimensionIDs( 0 ), m_nFrameCount
          End If
       End If
    End If
 End If
 FrameCount = m_nFrameCount
End Property

Public Property Get Frame(ByVal nFrame As Long) As IPictureDisp
 Dim hBitmap As Long
 If (nFrame >  0 ) And (nFrame <= FrameCount) Then
    If GdipImageSelectActiveFrame(m_nBitmap, m_DimensionIDs( 0 ), _
                                  nFrame -  1 ) = OK Then
       If GdipCreateHBITMAPFromBitmap(m_nBitmap, hBitmap,  0 ) = OK Then
          Set Frame = CreateIPictureDispFromHBITMAP(hBitmap)
       End If
    End If
 End If
End Property

Private Sub Class_Terminate()
 If m_nBitmap Then GdipDisposeImage m_nBitmap
 If m_GdipSession Then GdiplusShutdown m_GdipSession
End Sub
Печать с масштабированием и центровкой на листе:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
Private Sub PrintPicFrame(ByVal Pic As IPictureDisp)
 Dim FrameLeft As Double
 Dim FrameTop As Double
 Dim FrameWidth As Double
 Dim FrameHeight As Double
 FrameLeft =  20  'поля слева и справа
 FrameTop =  20   'поля сверху и снизу
 FrameWidth = Printer.ScaleWidth - FrameLeft *  2 
 FrameHeight = Printer.ScaleHeight - FrameTop *  2 
 
 Dim DstLeft As Double
 Dim DstTop As Double
 Dim DstWidth As Double
 Dim DstHeight As Double
 Dim r0 As Double
 r0 = Pic.Width / Pic.Height
 If r0 < FrameWidth / FrameHeight Then
    DstHeight = FrameHeight
    DstWidth = FrameHeight * r0
    'If DstWidth <= 0 Then DstWidth = 0.001
    DstLeft = (FrameWidth - DstWidth) /  2 
 Else
    DstWidth = FrameWidth
    DstHeight = FrameWidth / r0
    'If DstHeight <= 0 Then DstHeight = 0.001
    DstTop = (FrameHeight - DstHeight) /  2 
 End If
 
 Printer.PaintPicture Pic, FrameLeft + DstLeft, FrameTop + DstTop, _
                      DstWidth, DstHeight
End Sub

Private Sub Command1_Click()
 Dim mpi As CMultiFrameImage
 Dim nFrameCount As Long, nFrame As Long
 
 Set mpi = New CMultiFrameImage
 mpi.LoadFromFile "C:\File.tif"
 
 nFrameCount = mpi.FrameCount
 If nFrameCount Then
    Printer.ScaleMode = vbMillimeters
    For nFrame =  1  To nFrameCount -  1 
       PrintPicFrame mpi.Frame(nFrame)
       Printer.NewPage
       'DoEvents
    Next nFrame
    PrintPicFrame mpi.Frame(nFrameCount)
    Printer.EndDoc
 End If
End Sub
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
29.09.2009, 17:30
    #36223413
Mazai-XZ
Mazai-XZ
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
наПечать *.TIF файл
Бенедикт, Извиняюсь за свою безграмотность, но как именно создать этот модуль класса CMultiFrameImage? У меня VB6.0 Enterprise Edition
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
29.09.2009, 18:37
    #36223590
Бенедикт
Бенедикт
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
наПечать *.TIF файл
Mazai-XZ,

Меню:Project\Add Class Module - кнопка Open - F4 - в свойство (Name) написать CMultiFrameImage - F7. Скопировать и вставить текст модуля класса.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Период между сообщениями больше года.
13.11.2010, 16:16
    #36954210
Dick Johnson
Dick Johnson
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
наПечать *.TIF файл
Искал варианты печати многостраничныъ tif. Попробовал указанный выше способ - долго печатает и не всегда верно.
нашел другой вариант

Код: plaintext
1.
2.
3.
4.
5.
 Dim inFileName As String 
    Dim FileToPrint As New MODI.Document
    FileToPrint.Create (inFileName)
    FileToPrint.PrintOut
печатает быстро и правильно.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / наПечать *.TIF файл / 11 сообщений из 11, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]