Как рисовать пером, шириной тоньше, чем один пиксель?

[Matew]

Вот описание из АПИ-гайда:
Declare Function CreatePen Lib "gdi32.dll" (ByVal fnPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Параметры :
nWidth-Ширина пера. Если равна 0, перо - всегда точно один пиксел.
Сабж.?

[Vitaly1]

Тоньше одного пикселя нельзя зделать толшину пера! Т.к. на мониторе минимально возможным изображением является пиксель!

[Matew]

А как можно распечатать изображение, нарисованное полигоном, тоненькой линией?

[tyomitch]

Matew, тебе нужен GDI+, где можно рисовать любой толщиной пера.
Моя обёртка для него лежит на http://mix.web.ur.ru/JPEG.zip ; пример прямо сейчас не напишу, если будет нужен - может, вечером.

[Matew]

Скачал пример, прописал библиотеку, но пример не работает(( Рисует на форме символы. Пользоваться библиотекой в моих целях у меня не получается, т.ч. пример бы очень пригодился.

[tyomitch]

Скачал пример, прописал библиотеку, но пример не работает(( Рисует на форме символы. Пользоваться библиотекой в моих целях у меня не получается, т.ч. пример бы очень пригодился.

Вот, типа, пример - "графический редактор"

[Matew]

Редактор просто супер! Я бы такой же не написал))) Я из него пару фишек прикольных выковырял)) Но там нельзя рисовать пером тоньше одного пикселя(( Мне это в общем - то нужно, что бы мелкие полигоны рисовать не БОЛЬШИМИ квадратами.
В книжке Эпплмана написано:

Код: Выделить всё

Option Explicit

' This function shows how you can use the API to obtain
'   a printer device context for printing.
'   Note how this function also switches to print in
'   landscape mode without changing the default printer
'   configuration.
'
Private Sub CmdPrint_Click()
    Dim DeviceName$
    Dim dm As DEVMODE, dmout As DEVMODE
    Dim bufsize&
    Dim dmInBuf() As Byte
    Dim dmOutBuf() As Byte
    Dim prhdc&
    Dim dinfo As DOCINFO
    Dim docname$
    Dim oldcursor&
    Dim hPrinter&
    Dim res&, di&
   
    hPrinter = OpenDefaultPrinter(DeviceName$)
       
    ' Get a copy of the DEVMODE structure for this printer
    ' First find out how big the DEVMODE structure is
    bufsize& = DocumentProperties(hwnd, hPrinter, DeviceName$, 0, 0, 0)
   
    ' Allocate buffers of that size
    ReDim dmInBuf(bufsize&)
    ReDim dmOutBuf(bufsize&)
   
    ' Get the output DEVMODE structure
    res = DocumentProperties(hwnd, hPrinter, DeviceName$, agGetAddressForObject(dmOutBuf(0)), agGetAddressForObject(dmInBuf(0)), DM_OUT_BUFFER)

    ' Copy the data buffer into the DEVMODE structure
     agCopyData dmOutBuf(0), dmout, Len(dmout)
   
    ' Set the orientation, and set the dmField flag so that
    ' the function will know that it is valid.
   
    dmout.dmOrientation = DMORIENT_LANDSCAPE
    dmout.dmFields = dm.dmFields Or DM_ORIENTATION
   
    ' Now copy the data back to the buffer
    agCopyData dmout, dmOutBuf(0), Len(dmout)
   
   
    ' We now have need DC to the default printer
    ' This DC is also initialized to landscape mode
    prhdc = CreateDCBynum("WINSPOOL", DeviceName$, vbNullString, agGetAddressForObject&(dmOutBuf(0)))
    If prhdc = 0 Then GoTo cleanup2

    ' The DOCINFO structure is the information that the
    ' print manager will show. This also gives you the
    ' opportunity of dumping output to a file.
    docname$ = "Sample Document"
    dinfo.cbSize = Len(dinfo)
    dinfo.lpszDocName = docname$
    dinfo.lpszOutput = vbNullString
   
   
   
    Enabled = False ' Disable the main form
   
    ' The usual print sequence here
    di = StartDoc(prhdc, dinfo)
    di = StartPage(prhdc)
    PrintBitmap prhdc
   
    ' The system will spend a long time in the EndPage
    ' function, but it will periodically call the Abort
    ' procedure which in turn triggers the Callback1
    ' AbortProc event.
    di = EndPage(prhdc)
    If di >= 0 Then di = EndDocAPI(prhdc)
    Unload AbortForm
    Enabled = True
   
cleanup2:
    If prhdc <> 0 Then di = DeleteDC(prhdc)
    If hPrinter <> 0 Then Call ClosePrinter(hPrinter)

End Sub

'   This function retrieves the definition of the default
'   printer on this system
'
Private Function GetDefPrinter$()
    Dim def$
    Dim di&

    def$ = String$(128, 0)
    di = GetProfileString("WINDOWS", "DEVICE", "", def$, 127)
    def$ = agGetStringFromLPSTR$(def$)
    GetDefPrinter$ = def$

End Function

'   This function returns the driver module name
'
Private Function GetDeviceDriver$(dev$)
    Dim firstpos%, nextpos%
    firstpos% = InStr(dev$, ",")
    nextpos% = InStr(firstpos% + 1, dev$, ",")
    GetDeviceDriver$ = Mid$(dev$, firstpos% + 1, nextpos% - firstpos% - 1)
End Function

'   Retrieves the name portion of a device string
'
Private Function GetDeviceName$(dev$)
    Dim npos%
    npos% = InStr(dev$, ",")
    GetDeviceName$ = Left$(dev$, npos% - 1)
End Function

'   Returns the output destination for the specified device
'
Private Function GetDeviceOutput$(dev$)
    Dim firstpos%, nextpos%
    firstpos% = InStr(dev$, ",")
    nextpos% = InStr(firstpos% + 1, dev$, ",")
    GetDeviceOutput$ = Mid$(dev$, nextpos% + 1)
End Function


'   Prints the bitmap in the picture1 control to the
'   printer context specified.
'
Private Sub PrintBitmap(hdc&)
    Dim bi As BITMAPINFO
    Dim dctemp&, dctemp2&
    Dim msg$
    Dim bufsize&
    Dim bm As BITMAP
    Dim ghnd&
    Dim gptr&
    Dim xpix&, ypix&
    Dim doscale&
    Dim uy&, ux&
    Dim di&

    ' Create a temporary memory DC and select into it
    ' the background picture of the picture1 control.
    dctemp& = CreateCompatibleDC(Picture1.hdc)
   
    ' Get the size of the picture bitmap
    di = GetObjectAPI(Picture1.Picture, Len(bm), bm)

    ' Can this printer handle the DIB?
    If (GetDeviceCaps(hdc, RASTERCAPS)) And RC_DIBTODEV = 0 Then
        msg$ = "This device does not support DIB's" + vbCrLf + "See source code for further info"
        MsgBox msg$, 0, "No DIB support"
    End If

    ' Fill the BITMAPINFO for the desired DIB
    bi.bmiHeader.biSize = Len(bi.bmiHeader)
    bi.bmiHeader.biWidth = bm.bmWidth
    bi.bmiHeader.biHeight = bm.bmHeight
    bi.bmiHeader.biPlanes = 1
    ' Set to 24 here to create a 24 bit DIB
    ' Set to 8 here to create an 8 bit DIB
    bi.bmiHeader.biBitCount = 4
    bi.bmiHeader.biCompression = BI_RGB
    ' Now calculate the data buffer size needed
    bufsize& = bi.bmiHeader.biWidth

    ' Figure out the number of bytes based on the
    ' number of pixels in each byte. In this case we
    ' really don't need all this code because this example
    ' always uses a 16 color DIB, but the code is shown
    ' here for your future reference
    Select Case bi.bmiHeader.biBitCount
        Case 1
            bufsize& = Int((bufsize& + 7) / 8)
        Case 4
            bufsize& = Int((bufsize& + 1) / 2)
        Case 24
            bufsize& = bufsize& * 3
    End Select
    ' And make sure it aligns on a long boundary
    bufsize& = (Int((bufsize& + 3) / 4)) * 4
    ' And multiply by the # of scan lines
    bufsize& = bufsize& * bi.bmiHeader.biHeight

    ' Now allocate a buffer to hold the data
    ' We use the global memory pool because this buffer
    ' could easily be above 64k bytes.
    ghnd = GlobalAlloc(GMEM_MOVEABLE, bufsize&)
    gptr& = GlobalLock&(ghnd)

    di = GetDIBits(dctemp, Picture1.Picture, 0, bm.bmHeight, ByVal gptr&, bi, DIB_RGB_COLORS)
    di = SetDIBitsToDevice(hdc, 0, 0, bm.bmWidth, bm.bmHeight, 0, 0, 0, bm.bmHeight, ByVal gptr&, bi, DIB_RGB_COLORS)

    ' Now see if we can also print a scaled version
    xpix = GetDeviceCaps(hdc, HORZRES)
    ' We subtract off the size of the bitmap already
    ' printed, plus some extra space
    ypix = GetDeviceCaps(hdc, VERTRES) - (bm.bmHeight + 50)

    ' Find out the largest multiplier we can use and still
    ' fit on the page
    doscale = xpix / bm.bmWidth
    If (ypix / bm.bmHeight < doscale) Then doscale = ypix / bm.bmHeight
    If doscale > 1 Then
        doscale = doscale
        ux = bm.bmWidth * doscale
        uy = bm.bmHeight * doscale
        ' Now how this is offset a bit so that we don't
        ' print over the 1:1 scaled bitmap
        di = StretchDIBits(hdc, 0, bm.bmHeight + 50, ux, uy, 0, 0, bm.bmWidth, bm.bmHeight, ByVal gptr&, bi, DIB_RGB_COLORS, SRCCOPY)
    End If
    ' Dump the global memory block
    di = GlobalUnlock(ghnd)
    di = GlobalFree(ghnd)
    di = DeleteDC(dctemp)

End Sub

' Shows information about the current device mode
'
Private Sub ShowDevMode(dm As DEVMODE)
    Dim crlf$
    Dim a$

    crlf$ = Chr$(13) + Chr$(10)
    a$ = "Device name = " + agGetStringFromLPSTR$(dm.dmDeviceName) + crlf$
    a$ = a$ + "Devmode Version: " + Hex$(dm.dmSpecVersion) + ", Driver version: " + Hex$(dm.dmDriverVersion) + crlf$
    a$ = a$ + "Orientation: "
    If dm.dmOrientation = DMORIENT_PORTRAIT Then a$ = a$ + "Portrait" Else a$ = a$ + "Landscape"
    a$ = a$ + crlf$
    a$ = a$ + "Field mask = " + Hex$(dm.dmFields) + crlf$
    a$ = a$ + "Copies = " + Str$(dm.dmCopies) + crlf$
    If dm.dmFields And DM_YRESOLUTION <> 0 Then
        a$ = a$ + "X,Y resolution = " + Str$(dm.dmPrintQuality) + "," + Str$(dm.dmYResolution) + crlf$
    End If
    MsgBox a$, 0, "Devmode structure"
End Sub



Public Function OpenDefaultPrinter(Optional DeviceName) As Long
    Dim dev$, devname$, devoutput$
    Dim hPrinter&, res&
    Dim pdefs As PRINTER_DEFAULTS
   
    pdefs.pDatatype = vbNullString
    pdefs.pDevMode = 0
    pdefs.DesiredAccess = PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE

   
    dev$ = GetDefPrinter$() ' Get default printer info
   
    If dev$ = "" Then Exit Function
    devname$ = GetDeviceName$(dev$)
    devoutput$ = GetDeviceOutput$(dev$)
   
    If Not IsMissing(DeviceName) Then
        DeviceName = devname$
    End If
   
    ' You can use OpenPrinterBynum to pass a zero as the
    ' third parameter, but you won't have full access to
    ' edit the printer properties
    res& = OpenPrinter(devname$, hPrinter, pdefs)
    If res <> 0 Then OpenDefaultPrinter = hPrinter
End Function


функция di = StretchDIBits(hdc, 0, bm.bmHeight + 50, ux, uy, 0, 0, bm.bmWidth, bm.bmHeight, ByVal gptr&, bi, DIB_RGB_COLORS, SRCCOPY) рисует все мелко, но она печатает тока БМП (т.ч. я сохраняю мой пикчербокс в БМП, а потом его ЛоадПикчер ) и она все сильно уменьшает , поэтому весь рисунок так крупно на пикчербокс не поместиться Помогите советом, а?

[GSerg]

Не буду даже пытаться разобраться в коде

Скажи мне, а как должна отображаться на экране линия толщиной меньше одного пикселя, если минимальная единица отображения конечна и равна одному пикселю?

[alibek]

Он имеет ввиду совсем не это
Толковые графические редакторы применяют антиальясинг в процессе отображения масштабированного (уменьшенного) изображения. И очень тонкие линии получаются как бы пунктирными.
А он хочет нарисовать такую линию, которая бы выглядела тоньше, чем однопиксельная линия. И добиться этого можно только:
1) посчитав угол наклона линии и "плотность" пунктиров, рисовать вручную пунктиры.
2) возложить п.1 на API.

[tyomitch]

Не буду даже пытаться разобраться в коде

А мой-то хоть поглядел?

Скажи мне, а как должна отображаться на экране линия толщиной меньше одного пикселя, если минимальная единица отображения конечна и равна одному пикселю?

Имхо у неё альфа должна относиться к 255 так же, как толщина к единице.
А на самом деле, не знаю

[tyomitch]

Он имеет ввиду совсем не это
Толковые графические редакторы применяют антиальясинг в процессе отображения масштабированного (уменьшенного) изображения. И очень тонкие линии получаются как бы пунктирными.
А он хочет нарисовать такую линию, которая бы выглядела тоньше, чем однопиксельная линия. И добиться этого можно только:
1) посчитав угол наклона линии и "плотность" пунктиров, рисовать вручную пунктиры.
2) возложить п.1 на API.

Не понимаю, как соотносятся антиалиасинг и пунктирность? Антиалиасинг - это введение "подпикселов", поддерживается только GDI+ и применяется в моём примере. Пунктирность - это стиль линии; его прекрасно поддерживают и GDI, и GDI+

[Sebas]

РезУме:
(Знание фирмы Novalogic обязательно!)

-Что такое воксель?
-Это кубический пиксел!

[alibek]

tyomitch, слово "пунктир" подразумевалось в кавычках. Я лучше проиллюстрирую.

[tyomitch]

tyomitch, слово "пунктир" подразумевалось в кавычках. Я лучше проиллюстрирую.

Общая ошибка

Выбранное приложение больше не существует

404 File Not Found: The File files/ss_195.zip does not exist.

WTF?

[alibek]

Прикольно...
Ну тогда http://alibek09.narod.ru/ss.gif

[tyomitch]

Ну тогда http://alibek09.narod.ru/ss.gif

Чтобы я понял, о чём всё-таки речь, кинь две картинки: линия толщиной в пиксел и линия толщиной в полпиксела. "Всё познаётся в сравнении" (с)

Потому что я так и не понял, как антиалиасинг связан с полупиксельной шириной.

[tyomitch]

Matew, ещё попробуй сделать всё как в моём примере, только заменив Picture1.hDC на Printer.hDC
Принтер, в отличие от дисплея, должен нормально отрисовывать дробно-пиксельные линии.

[Matew]

VB ругается при попытки задать перо, тоньше 1((

Для тех, кто недопонял меня: мне надо просто распечатать тоненько на принтере.

[tyomitch]

VB ругается при попытки задать перо, тоньше 1((

Потому что нужно писать не 0.5, а 0,5 - попробуй так.

[alibek]

tyomitch, легко сказать
У меня Corel слишком интеллектуальный, он "тонкость" линий цветом задает, т.е. линия в полпиксела рисуется серым цветом, а не черным.
Я имею ввиду, что "плотность" линии в полпиксела в два раза меньше, чем "плотность" линии в пиксел. И добиться такого визуального эффекта можно двумя способами -- осветлить цвет (рисовать серым) или делать линию пунктирной. Попробуй напечатать на принтере линию, которая будет пунктирной (пиксел-пропуск-пиксел-пропуск) -- визуально она будет казаться тоньше, чем просто один пиксел.

[tyomitch]

alibek, у меня матричник, там все точки глазом различимы, и получается именно пунктир, а не полупиксельная линия
С другой стороны, представление полупиксельных линий полупрозрачными я уже предложил. Может, Matew полупрозрачных линий хватит?

[Matew]

Я тут читал книжки умные))), и придумал. Может можно создать свой дескриптор, на нем все нарисовать(сильно увеличенное т.к. у принтера пиксель меньше мониторного) и потом его распечатать. Только я не заю пока как это сделать. Подскажите функции создания дескриптора в памяти и как его распечатать, плиз!!!

[tyomitch]

Matew, найди где-нибудь хелп от книжки Аппельмана, там это всё очень хорошо написано.
Он лежит, например, на http://vbrussian.com/Programs.asp?ID=5 (урезанный), но я подозреваю, что его по всему инету полно.
У меня есть другой - видимо, от более позднего издания, - могу кинуть его

[Matew]

Она у меня есть там написано как создать дескриптор но не написано как его распечатать и перевод в ней фуфло, если честно((

[tyomitch]

Посмотри примеры в 12 главе - она как раз про печать.
Там есть и про вывод на принтер средствами API (пример PicPrint)

[tyomitch]

Вот, типа, пример - "графический редактор"

Подробный разбор моего примера: http://bbs.vbstreets.ru/viewtopic.php?p=76589#76589