ReSQL.ru
     
powered by simpleCommunicator - 2.0.51     © 2025 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / WinForms, .Net Framework [игнор отключен] [закрыт для гостей] / А можно как-то подменить hdc принтера на hdc связанное с bitmap с целью сохранить в файл?
3 сообщений из 3, страница 1 из 1
А можно как-то подменить hdc принтера на hdc связанное с bitmap с целью сохранить в файл?
    #39688459
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дмитрий77
Участник
В службе факсов/Fax and Scan есть нехилый такой функционал, связанный с Cover Pages (Титульные страницы).
Озадачился нестандартной задачей: сохранить распечатанную Cover Page в TIFF-файл (дабы использовать ее в другом приложении - не MSFax).

Стандартный алгоритм описан здесь:
Printing a Fax to a Device Context
1.Call the FaxStartPrintJob function to retrieve the handle to a fax printer DC. The function returns the handle in a FAX_CONTEXT_INFO structure.
2.Call the FaxPrintCoverPage function, if a cover page is required, passing a pointer to the FAX_CONTEXT_INFO structure returned by the FaxStartPrintJob function.
3.Print the fax document to the printer DC in the normal manner, passing the handle to the DC returned by the FaxStartPrintJob function. The procedure can include calls to the StartPage and EndPage Win32 GDI functions.
4.Call the EndDoc function or the AbortDoc function, passing the handle to the DC returned by FaxStartPrintJob. This closes the document and ends the fax print job.
5.Call the DeleteDC function to deallocate the handle to the DC.
Т.е. FaxStartPrintJob возвращает hdc в структуре FAX_CONTEXT_INFO (и видимо инициализирует StartDoc), а FaxPrintCoverPage лепит CoverPage в это hdc. EndDoc завершает подготовку факса и факс улетает в Fax and Scan на отправку.
Ну, штатно все работает:
 
Код: vbnet
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.
  Public Function SendCoverPage(ByRef err_text As String) As Boolean

    SendCoverPage = True

    ' dwFaxId is the fax job id
    Dim dwFaxId As Integer

    ' FaxPrintInfo is the fax print info
    Dim FaxPrintInfo As New FAX_PRINT_INFO
    FaxPrintInfo.SizeOfStruct = Marshal.SizeOf(FaxPrintInfo)
    FaxPrintInfo.RecipientNumber = "500" 'номер не может быть пустой

    ' FaxContextInfo is the fax context
    Dim FaxContextInfo As New FAX_CONTEXT_INFO
    FaxContextInfo.SizeOfStruct = Marshal.SizeOf(FaxContextInfo)

    'FaxContextInfo.hDC - здесь возвращается hdc
    If FaxStartPrintJob(vbNullString, FaxPrintInfo, dwFaxId, FaxContextInfo) = False Then
      SendCoverPage = False
      err_text = "FaxStartPrintJob Error " & RaiseAPIError()
      GoTo ToExit
    End If

    ' CoverPageInfo is the cover page info
    Dim CoverPageInfo As New FAX_COVERPAGE_INFO
    With CoverPageInfo
      .SizeOfStruct = Marshal.SizeOf(CoverPageInfo)
      .UseServerCoverPage = True
      .CoverPageName = "confident" ' "C:\ProgramData\Microsoft\Windows NT\MSFax\Common Coverpages\ru-RU\confident.cov"
      .Subject = "confident"
      '...
    End With

    'печать титульной страницы - FaxContextInfo.hDC определяет куда ее выводить
    If FaxPrintCoverPage(FaxContextInfo, CoverPageInfo) = False Then
      SendCoverPage = False
      err_text = "FaxPrintCoverPage Error " & RaiseAPIError()
      GoTo ToExit
    End If

    ' Сюда можно вставить  StartPage ... EndPage и нарисовать остальные страницы

    If EndDoc(FaxContextInfo.hDC) = 0 Then
      SendCoverPage = False
      err_text = "EndDoc Error " & RaiseAPIError()
      GoTo ToExit
    End If

ToExit:
    DeleteDC(FaxContextInfo.hDC)
  End Function



Но мне надо "угнать" CoverPage картинку в свой файл.
Создаю свою кухню, пытаюсь подсунуть в FaxPrintCoverPage свое hdc, не вызывая предварительно FaxStartPrintJob
Код: vbnet
1.
2.
3.
4.
    ' FaxContextInfo is the fax context
    Dim FaxContextInfo As New FAX_CONTEXT_INFO
    FaxContextInfo.SizeOfStruct = Marshal.SizeOf(FaxContextInfo)
    FaxContextInfo.hDC = hdcDst 'пытаемся подсунуть свой hdc в FaxPrintCoverPage


 
Код: vbnet
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.
  Public Function SaveCoverPage1(ByRef err_text As String) As Boolean

    SaveCoverPage1 = True

    Dim bmiDst As BITMAPINFO2
    Dim pBits As IntPtr
    Dim hbmDst As IntPtr
    Dim hdcDst As IntPtr
    Dim hbmOldDst As IntPtr
    Dim nBitmap As Bitmap

    With bmiDst.bmiHeader
      .biSize = Marshal.SizeOf(bmiDst.bmiHeader)
      .biWidth = 1728
      .biHeight = 2339
      .biPlanes = 1
      .biBitCount = 1
      .biCompression = BI_RGB
    End With
    With bmiDst.bmiColors1
      .rgbBlue = 255
      .rgbGreen = 255
      .rgbRed = 255
    End With
    hbmDst = CreateDIBSection(IntPtr.Zero, bmiDst, DIB_RGB_COLORS, pBits, IntPtr.Zero, 0)

    hdcDst = CreateCompatibleDC(IntPtr.Zero)
    hbmOldDst = SelectObject(hdcDst, hbmDst)

    PatBlt(hdcDst, 0, 0, bmiDst.bmiHeader.biWidth, bmiDst.bmiHeader.biHeight, WHITENESS) 'красим белым т.к. он гад черный
    'Using gr As Graphics = Graphics.FromHdc(hdcDst)
    '  gr.Clear(Color.White)
    'End Using

    '=====
    ' FaxContextInfo is the fax context
    Dim FaxContextInfo As New FAX_CONTEXT_INFO
    FaxContextInfo.SizeOfStruct = Marshal.SizeOf(FaxContextInfo)
    FaxContextInfo.hDC = hdcDst 'пытаемся подсунуть свой hdc в FaxPrintCoverPage


    ' CoverPageInfo is the cover page info
    Dim CoverPageInfo As New FAX_COVERPAGE_INFO
    With CoverPageInfo
      .SizeOfStruct = Marshal.SizeOf(CoverPageInfo)
      .UseServerCoverPage = True
      .CoverPageName = "confident" ' "C:\ProgramData\Microsoft\Windows NT\MSFax\Common Coverpages\ru-RU\confident.cov"
      .Subject = "confident"
      '...
    End With

    If FaxPrintCoverPage(FaxContextInfo, CoverPageInfo) = False Then
      SaveCoverPage1 = False
      err_text = "FaxPrintCoverPage Error " & RaiseAPIError()
    End If
    '=====

    SelectObject(hdcDst, hbmOldDst) : hbmOldDst = IntPtr.Zero
    DeleteDC(hdcDst) : hdcDst = IntPtr.Zero

    If SaveCoverPage1 = True Then
      Try
        nBitmap = Bitmap.FromHbitmap(hbmDst)
        nBitmap.SetResolution(204, 196)

        'http://stackoverflow.com/questions/21169217/tiff-file-compression-with-c-sharp
        ' Get an ImageCodecInfo object that represents the TIFF codec.
        Dim myImageCodecInfo As ImageCodecInfo = GetEncoderInfo("image/tiff")
        ' Create an Encoder object based on the GUID for the Compression parameter category.
        Dim myEncoder As Encoder = Encoder.Compression
        ' Create an EncoderParameters object. An EncoderParameters object has an array of EncoderParameter 
        ' objects. In this case, there is only one EncoderParameter object in the array.
        Dim myEncoderParameters As EncoderParameters = New EncoderParameters(1)
        ' Save the bitmap as a TIFF file with eTifCompression compression.
        Dim myEncoderParameter As EncoderParameter = New EncoderParameter(myEncoder, Fix(EncoderValue.CompressionCCITT4))
        myEncoderParameters.Param(0) = myEncoderParameter
        nBitmap.Save("cover_page.tif", myImageCodecInfo, myEncoderParameters)
        nBitmap.Dispose() : nBitmap = Nothing
      Catch
      End Try
    End If

    DeleteObject(hbmDst) : hbmDst = IntPtr.Zero : pBits = IntPtr.Zero
  End Function


Ну и ни фига не работает, FaxPrintCoverPage отрабатывает без ошибки, но на выходе белый лист бумаги. Почему? По идее должен был туда чего-нибудь накалякать.

Но результат таки получил.
Делаем все как в первом случае, т.е. с вызовом FaxStartPrintJob, и с подсовыванием в FaxPrintCoverPage честного hdc (FaxContextInfo.hDC, которое вернула первая ф-ция).
Но далее делаем.
Код: vbnet
1.
2.
3.
4.
5.
    '!!! в этом месте тупо копируем FaxContextInfo.hDC -> hdcDst
    BitBlt(hdcDst, 0, 0, 1728, 2339, FaxContextInfo.hDC, 0, 0, SRCCOPY)

    '!!!отменяем реальную отправку через MSFax (во первых не отправляется, во вторых не сохраняется в очереди печати)
    AbortDoc(FaxContextInfo.hDC)


Т.е. я вылавливаю-таки желаемую картинку, а затем отменяю "печать" (AbortDoc).
Прокатывает, получаем картинку сохраненную в файле.
 
Код: vbnet
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.
 Public Function SaveCoverPage(ByRef err_text As String) As Boolean

    SaveCoverPage = True

    Dim bmiDst As BITMAPINFO2
    Dim pBits As IntPtr
    Dim hbmDst As IntPtr
    Dim hdcDst As IntPtr
    Dim hbmOldDst As IntPtr
    Dim nBitmap As Bitmap

    With bmiDst.bmiHeader
      .biSize = Marshal.SizeOf(bmiDst.bmiHeader)
      .biWidth = 1728
      .biHeight = 2339
      .biPlanes = 1
      .biBitCount = 1
      .biCompression = BI_RGB
    End With
    With bmiDst.bmiColors1
      .rgbBlue = 255
      .rgbGreen = 255
      .rgbRed = 255
    End With
    hbmDst = CreateDIBSection(IntPtr.Zero, bmiDst, DIB_RGB_COLORS, pBits, IntPtr.Zero, 0)

    hdcDst = CreateCompatibleDC(IntPtr.Zero)
    hbmOldDst = SelectObject(hdcDst, hbmDst)

    PatBlt(hdcDst, 0, 0, bmiDst.bmiHeader.biWidth, bmiDst.bmiHeader.biHeight, WHITENESS) 'красим белым т.к. он гад черный
    'Using gr As Graphics = Graphics.FromHdc(hdcDst)
    '  gr.Clear(Color.White)
    'End Using

    '=====

    ' dwFaxId is the fax job id
    Dim dwFaxId As Integer

    ' FaxPrintInfo is the fax print info
    Dim FaxPrintInfo As New FAX_PRINT_INFO
    FaxPrintInfo.SizeOfStruct = Marshal.SizeOf(FaxPrintInfo)
    FaxPrintInfo.RecipientNumber = "500" 'номер не может быть пустой

    ' FaxContextInfo is the fax context
    Dim FaxContextInfo As New FAX_CONTEXT_INFO
    FaxContextInfo.SizeOfStruct = Marshal.SizeOf(FaxContextInfo)

    'FaxContextInfo.hDC - здесь возвращается hdc
    If FaxStartPrintJob(vbNullString, FaxPrintInfo, dwFaxId, FaxContextInfo) = False Then
      SaveCoverPage = False
      err_text = "FaxStartPrintJob Error " & RaiseAPIError()
      GoTo ToExit
    End If

    ' CoverPageInfo is the cover page info
    Dim CoverPageInfo As New FAX_COVERPAGE_INFO
    With CoverPageInfo
      .SizeOfStruct = Marshal.SizeOf(CoverPageInfo)
      .UseServerCoverPage = True
      .CoverPageName = "confident" ' "C:\ProgramData\Microsoft\Windows NT\MSFax\Common Coverpages\ru-RU\confident.cov"
      .Subject = "confident"
      '...
    End With

    'печать титульной страницы - FaxContextInfo.hDC определяет куда ее выводить
    If FaxPrintCoverPage(FaxContextInfo, CoverPageInfo) = False Then
      SaveCoverPage = False
      err_text = "FaxPrintCoverPage Error " & RaiseAPIError()
      GoTo ToExit
    End If

    '!!! в этом месте тупо копируем FaxContextInfo.hDC -> hdcDst
    BitBlt(hdcDst, 0, 0, 1728, 2339, FaxContextInfo.hDC, 0, 0, SRCCOPY)

    '!!!отменяем реальную отправку через MSFax (во первых не отправляется, во вторых не сохраняется в очереди печати)
    AbortDoc(FaxContextInfo.hDC)

ToExit:
    DeleteDC(FaxContextInfo.hDC)
    '=====

    SelectObject(hdcDst, hbmOldDst) : hbmOldDst = IntPtr.Zero
    DeleteDC(hdcDst) : hdcDst = IntPtr.Zero

    If SaveCoverPage = True Then
      'сохранение в TIFF титульной страницы
      Try
        nBitmap = Bitmap.FromHbitmap(hbmDst)
        nBitmap.SetResolution(204, 196)

        'http://stackoverflow.com/questions/21169217/tiff-file-compression-with-c-sharp
        ' Get an ImageCodecInfo object that represents the TIFF codec.
        Dim myImageCodecInfo As ImageCodecInfo = GetEncoderInfo("image/tiff")
        ' Create an Encoder object based on the GUID for the Compression parameter category.
        Dim myEncoder As Encoder = Encoder.Compression
        ' Create an EncoderParameters object. An EncoderParameters object has an array of EncoderParameter 
        ' objects. In this case, there is only one EncoderParameter object in the array.
        Dim myEncoderParameters As EncoderParameters = New EncoderParameters(1)
        ' Save the bitmap as a TIFF file with eTifCompression compression.
        Dim myEncoderParameter As EncoderParameter = New EncoderParameter(myEncoder, Fix(EncoderValue.CompressionCCITT4))
        myEncoderParameters.Param(0) = myEncoderParameter
        nBitmap.Save("cover_page.tif", myImageCodecInfo, myEncoderParameters)
        nBitmap.Dispose() : nBitmap = Nothing
      Catch
      End Try
    End If

    DeleteObject(hbmDst) : hbmDst = IntPtr.Zero : pBits = IntPtr.Zero
  End Function



(Ну, код субъективен, принтер Fax надо выставлять программно в 200x200,A4,Портрет - на момент выполнения кода (соответствует разрешению 204x198 и размеру картинки 1728x2339. Но это я умею, также без проблем возвращаю к "текущим установкам").

Мне вот не понятно почему не рисует второй код и что тут можно придумать. Третий код как бы рабочий, но он использует ресурсы принтера, хоть я и не довожу штатную процедуру до конца. Т.е. я делаю копию картинки на полпути, а мне бы изначально эту картинку бухнуть в свое hdc и в файл, не обращаясь к принтеру.

P.S hdc и связанный bitmap я готовлю правильно, могу туда без проблем нарисовать какую-нибудь линию через .Net-овскую Grafics и тому подобное, но вот FaxPrintCoverPage туда напрямую рисовать отказывается, хотя BitBlt туда копирует. Понятно что пытаюсь сделать нечто недокументированное, но тем не менее. Должен быть способ его обмануть.
...
Рейтинг: 0 / 0
16.08.2018, 05:58
| Ответить | Цитировать | Написать  
А можно как-то подменить hdc принтера на hdc связанное с bitmap с целью сохранить в файл?
    #39689184
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дмитрий77
Участник
Дмитрий77Но мне надо "угнать" CoverPage картинку в свой файл.
Создаю свою кухню, пытаюсь подсунуть в FaxPrintCoverPage свое hdc, не вызывая предварительно FaxStartPrintJob
Код: vbnet
1.
2.
3.
4.
    ' FaxContextInfo is the fax context
    Dim FaxContextInfo As New FAX_CONTEXT_INFO
    FaxContextInfo.SizeOfStruct = Marshal.SizeOf(FaxContextInfo)
    FaxContextInfo.hDC = hdcDst 'пытаемся подсунуть свой hdc в FaxPrintCoverPage


 
Код: vbnet
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.
  Public Function SaveCoverPage1(ByRef err_text As String) As Boolean

    SaveCoverPage1 = True

    Dim bmiDst As BITMAPINFO2
    Dim pBits As IntPtr
    Dim hbmDst As IntPtr
    Dim hdcDst As IntPtr
    Dim hbmOldDst As IntPtr
    Dim nBitmap As Bitmap

    With bmiDst.bmiHeader
      .biSize = Marshal.SizeOf(bmiDst.bmiHeader)
      .biWidth = 1728
      .biHeight = 2339
      .biPlanes = 1
      .biBitCount = 1
      .biCompression = BI_RGB
    End With
    With bmiDst.bmiColors1
      .rgbBlue = 255
      .rgbGreen = 255
      .rgbRed = 255
    End With
    hbmDst = CreateDIBSection(IntPtr.Zero, bmiDst, DIB_RGB_COLORS, pBits, IntPtr.Zero, 0)

    hdcDst = CreateCompatibleDC(IntPtr.Zero)
    hbmOldDst = SelectObject(hdcDst, hbmDst)

    PatBlt(hdcDst, 0, 0, bmiDst.bmiHeader.biWidth, bmiDst.bmiHeader.biHeight, WHITENESS) 'красим белым т.к. он гад черный
    'Using gr As Graphics = Graphics.FromHdc(hdcDst)
    '  gr.Clear(Color.White)
    'End Using

    '=====
    ' FaxContextInfo is the fax context
    Dim FaxContextInfo As New FAX_CONTEXT_INFO
    FaxContextInfo.SizeOfStruct = Marshal.SizeOf(FaxContextInfo)
    FaxContextInfo.hDC = hdcDst 'пытаемся подсунуть свой hdc в FaxPrintCoverPage


    ' CoverPageInfo is the cover page info
    Dim CoverPageInfo As New FAX_COVERPAGE_INFO
    With CoverPageInfo
      .SizeOfStruct = Marshal.SizeOf(CoverPageInfo)
      .UseServerCoverPage = True
      .CoverPageName = "confident" ' "C:\ProgramData\Microsoft\Windows NT\MSFax\Common Coverpages\ru-RU\confident.cov"
      .Subject = "confident"
      '...
    End With

    If FaxPrintCoverPage(FaxContextInfo, CoverPageInfo) = False Then
      SaveCoverPage1 = False
      err_text = "FaxPrintCoverPage Error " & RaiseAPIError()
    End If
    '=====

    SelectObject(hdcDst, hbmOldDst) : hbmOldDst = IntPtr.Zero
    DeleteDC(hdcDst) : hdcDst = IntPtr.Zero

    If SaveCoverPage1 = True Then
      Try
        nBitmap = Bitmap.FromHbitmap(hbmDst)
        nBitmap.SetResolution(204, 196)

        'http://stackoverflow.com/questions/21169217/tiff-file-compression-with-c-sharp
        ' Get an ImageCodecInfo object that represents the TIFF codec.
        Dim myImageCodecInfo As ImageCodecInfo = GetEncoderInfo("image/tiff")
        ' Create an Encoder object based on the GUID for the Compression parameter category.
        Dim myEncoder As Encoder = Encoder.Compression
        ' Create an EncoderParameters object. An EncoderParameters object has an array of EncoderParameter 
        ' objects. In this case, there is only one EncoderParameter object in the array.
        Dim myEncoderParameters As EncoderParameters = New EncoderParameters(1)
        ' Save the bitmap as a TIFF file with eTifCompression compression.
        Dim myEncoderParameter As EncoderParameter = New EncoderParameter(myEncoder, Fix(EncoderValue.CompressionCCITT4))
        myEncoderParameters.Param(0) = myEncoderParameter
        nBitmap.Save("cover_page.tif", myImageCodecInfo, myEncoderParameters)
        nBitmap.Dispose() : nBitmap = Nothing
      Catch
      End Try
    End If

    DeleteObject(hbmDst) : hbmDst = IntPtr.Zero : pBits = IntPtr.Zero
  End Function


Ну и ни фига не работает, FaxPrintCoverPage отрабатывает без ошибки, но на выходе белый лист бумаги. Почему? По идее должен был туда чего-нибудь накалякать…
.но вот FaxPrintCoverPage туда напрямую рисовать отказывается, хотя BitBlt туда копирует. Понятно что пытаюсь сделать нечто недокументированное, но тем не менее. Должен быть способ его обмануть.
А если заменить
Код: vbnet
1.
hdcDst = CreateCompatibleDC(IntPtr.Zero)

На вот это
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
    'FaxContextInfo.hDC - здесь возвращается hdc
    If FaxStartPrintJob(vbNullString, FaxPrintInfo, dwFaxId, FaxContextInfo) = False Then
      SaveCoverPageTest = False
      err_text = "FaxStartPrintJob Error " & RaiseAPIError()
    End If


    hdcDst = CreateCompatibleDC(FaxContextInfo.hDC)
    hbmOldDst = SelectObject(hdcDst, hbmDst)
 
    AbortDoc(FaxContextInfo.hDC)
    DeleteDC(FaxContextInfo.hDC)


    FaxContextInfo.hDC = hdcDst 'пытаемся подсунуть свой hdc в FaxPrintCoverPage

...
    If FaxPrintCoverPage(FaxContextInfo, CoverPageInfo) = False Then
      SaveCoverPageTest = False
      err_text = "FaxPrintCoverPage Error " & RaiseAPIError()
    End If


то все однако срабатывает и FaxPrintCoverPage выводит графику уже напрямую в мое DC (hdcDst).

Осталось сообразить как создать самому правильное hdcDst, чтоб можно было выкинуть FaxStartPrintJob, которое генерирует вспомогательное FaxContextInfo.hDC.

М.б. CreateDCW function ?
Вопрос только что в нее пихать...
Ключевой судя по всему является структура DEVMODE structure , которую придется "сочинять".
...
Рейтинг: 0 / 0
17.08.2018, 02:26
| Ответить | Цитировать | Написать  
А можно как-то подменить hdc принтера на hdc связанное с bitmap с целью сохранить в файл?
    #39689197
Дмитрий77
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Дмитрий77
Участник
Ну вот чтоб совсем на абстрактное hdc вывести, что-то не получается.
Можно
1) Получить текущую DEVMODE принтера
2) Подправить эту DEVMODE с учетом желаемого разрешения (а заодно чтоб точно было A4+Портрет), не нарушая при этом текущих системных установок принтера
3) Создать DC принтера через CreateDC (передается имя принтера и кастомизированная DEVMODE)
4) Из нее создать еще одну hdc через CreateCompatibleDC, в нее уже можно рисовать FaxPrintCoverPage и сохранять картинку.
Поприличней конечно, но по сути не отличается от того что в предыдущем посте. Еще иконка принтера в трей выводится как при печати, хоть мусора в очереди печати и не остается. Также используется имя принтера "Fax", а его вообще говоря можно переименовать в "Fax1".


Код: vbnet
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.
141.
142.
143.
144.
145.
 Public Function SaveCoverPageTestWithResolution(Optional ResFine As Boolean = True, _
   Optional ByRef err_text As String = vbNullString) As Boolean
    'ResFine=True: 204x196,1728x2339 (A4,PORTRAIT)
    'ResFine=False: 204x98,1728x1169 (A4,PORTRAIT)
    SaveCoverPageTestWithResolution = True
    Dim dm As New DEVMODE 'сюда получаем тек. структуру (главное ее шаблон правильный)
    If GetPrinterDevMode("Fax", dm, err_text) = False Then 'ну значит факс хозяйство не установлено, чего дальше стараться
      SaveCoverPageTestWithResolution = False
      Exit Function
    End If
    'подправим (не меняя дефолтные тек. настройки)
    dm.dmPrintQuality = 200
    dm.dmYResolution = IIf(ResFine, 200, 100)
    dm.dmOrientation = DMORIENT_PORTRAIT
    dm.dmPaperSize = DMPAPER_A4

    'рисуем картинку
    Dim bmiDst As BITMAPINFO2
    Dim pBits As IntPtr
    Dim hbmDst As IntPtr
    Dim hdcDst As IntPtr
    Dim hbmOldDst As IntPtr
    Dim nBitmap As Bitmap

    With bmiDst.bmiHeader
      .biSize = Marshal.SizeOf(bmiDst.bmiHeader)
      .biWidth = 1728
      .biHeight = IIf(ResFine, 2339, 1169)
      .biPlanes = 1
      .biBitCount = 1
      .biCompression = BI_RGB
    End With
    With bmiDst.bmiColors1
      .rgbBlue = 255
      .rgbGreen = 255
      .rgbRed = 255
    End With
    hbmDst = CreateDIBSection(IntPtr.Zero, bmiDst, DIB_RGB_COLORS, pBits, IntPtr.Zero, 0)

    'сначала создаем DC принтера (с заданным A4+Портрет+разрешение)
    Dim hdcDst1 As IntPtr = CreateDC(vbNullString, "fax", vbNullString, dm)
    'из него делаем CompatibleDC, куда перенаправим вывод FaxPrintCoverPage
    hdcDst = CreateCompatibleDC(hdcDst1)
    DeleteDC(hdcDst1) 'это можно сразу грохнуть
    hbmOldDst = SelectObject(hdcDst, hbmDst)

    PatBlt(hdcDst, 0, 0, bmiDst.bmiHeader.biWidth, bmiDst.bmiHeader.biHeight, WHITENESS) 'красим белым т.к. он гад черный

    '======распечатка Cover Page=======
    ' FaxContextInfo is the fax context
    Dim FaxContextInfo As New FAX_CONTEXT_INFO
    FaxContextInfo.SizeOfStruct = Marshal.SizeOf(FaxContextInfo)
    FaxContextInfo.hDC = hdcDst 'подсовываем свой hdc в FaxPrintCoverPage

    ' CoverPageInfo is the cover page info
    Dim CoverPageInfo As New FAX_COVERPAGE_INFO
    With CoverPageInfo
      .SizeOfStruct = Marshal.SizeOf(CoverPageInfo)
      .UseServerCoverPage = True
      .CoverPageName = "confident" ' "C:\ProgramData\Microsoft\Windows NT\MSFax\Common Coverpages\ru-RU\confident.cov"
      .Subject = "confident"
      '...
    End With

    'печать титульной страницы: (FaxContextInfo.hDC = hdcDst)
    Try
      If FaxPrintCoverPage(FaxContextInfo, CoverPageInfo) = False Then
        SaveCoverPageTestWithResolution = False
        err_text = "FaxPrintCoverPage Error " & RaiseAPIError()
      End If
    Catch
      SaveCoverPageTestWithResolution = False
      err_text = Err.Description 'если winfax.dll не найдена
    End Try

    SelectObject(hdcDst, hbmOldDst) : hbmOldDst = IntPtr.Zero
    DeleteDC(hdcDst) : hdcDst = IntPtr.Zero

    If SaveCoverPageResolution() = True Then
      'сохранение в TIFF титульной страницы
      Try
        nBitmap = Bitmap.FromHbitmap(hbmDst)
        nBitmap.SetResolution(204, IIf(ResFine, 196, 98))

        'http://stackoverflow.com/questions/21169217/tiff-file-compression-with-c-sharp
        ' Get an ImageCodecInfo object that represents the TIFF codec.
        Dim myImageCodecInfo As ImageCodecInfo = GetEncoderInfo("image/tiff")
        ' Create an Encoder object based on the GUID for the Compression parameter category.
        Dim myEncoder As Encoder = Encoder.Compression
        ' Create an EncoderParameters object. An EncoderParameters object has an array of EncoderParameter 
        ' objects. In this case, there is only one EncoderParameter object in the array.
        Dim myEncoderParameters As EncoderParameters = New EncoderParameters(1)
        ' Save the bitmap as a TIFF file with eTifCompression compression.
        Dim myEncoderParameter As EncoderParameter = New EncoderParameter(myEncoder, Fix(EncoderValue.CompressionCCITT4))
        myEncoderParameters.Param(0) = myEncoderParameter
        nBitmap.Save("cover_page.tif", myImageCodecInfo, myEncoderParameters)
        nBitmap.Dispose() : nBitmap = Nothing
      Catch
      End Try
    End If

    DeleteObject(hbmDst) : hbmDst = IntPtr.Zero : pBits = IntPtr.Zero
  End Function


  Public Function GetPrinterDevMode(ByVal sPrinterName As String, _
   ByRef dm As DEVMODE, Optional ByRef sErrMsg As String = vbNullString) As Boolean

    Dim hPrinter As IntPtr
    Dim pd As New PRINTER_DEFAULTS

    Dim pBufferDevModeData As IntPtr
    Dim nRet As Integer

    GetPrinterDevMode = False

    pd.DesiredAccess = PRINTER_ACCESS_USE
    If OpenPrinter(sPrinterName & Chr(0), hPrinter, pd) = False Then
      sErrMsg = "OpenPrinter failed: " & RaiseAPIErrorByNumber(Err.LastDllError)
      Exit Function
    End If

    nRet = DocumentProperties(IntPtr.Zero, hPrinter, sPrinterName & Chr(0), IntPtr.Zero, IntPtr.Zero, 0)
    If (nRet < 0) Then
      sErrMsg = "DocumentProperties failed: " & RaiseAPIErrorByNumber(Err.LastDllError)
      GoTo cleanup
    End If

    pBufferDevModeData = Marshal.AllocHGlobal(nRet)
    nRet = DocumentProperties(IntPtr.Zero, hPrinter, sPrinterName & Chr(0), _
     pBufferDevModeData, IntPtr.Zero, DM_OUT_BUFFER)
    If (nRet < 0) Then
      sErrMsg = "DocumentProperties failed: " & RaiseAPIErrorByNumber(Err.LastDllError)
      GoTo cleanup
    End If
    dm = Marshal.PtrToStructure(pBufferDevModeData, GetType(DEVMODE))
    GetPrinterDevMode = True

cleanup:
    If (hPrinter <> IntPtr.Zero) Then Call ClosePrinter(hPrinter)

    If Not pBufferDevModeData.Equals(0) Then
      Marshal.FreeHGlobal(pBufferDevModeData)
    End If
  End Function
...
Рейтинг: 0 / 0
17.08.2018, 06:39
| Ответить | Цитировать | Написать  
3 сообщений из 3, страница 1 из 1
Форумы / WinForms, .Net Framework [игнор отключен] [закрыт для гостей] / А можно как-то подменить hdc принтера на hdc связанное с bitmap с целью сохранить в файл?
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
NoSQL.ru       Новости, Чат       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=20&fpage=28&tid=1399273]:
 0ms
get settings:
 10ms
get forum list:
 14ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 38ms
get topic data:
 11ms
get forum data:
 2ms
get page messages:
 62ms
get tp. blocked users:
 2ms
others: 24ms
total:  169ms
созд. / загр.: 169ms
x
x
Закрыть


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