[RESOLVED] About PCX - Page 2-VBForums
Page 2 of 2 FirstFirst 12
Results 41 to 43 of 43

Thread: [RESOLVED] About PCX

  1. #41
    VB-aholic & Lovin' It LaVolpe's Avatar
    Join Date
    Oct 2007
    Location
    Beside Waldo
    Posts
    16,737

    Re: [RESOLVED] About PCX

    Yes, its a GIF. That HasTransparency routine is a pre-filter when SavePictureGDI+ is called and I see now I have to handle GIFs differently. GDI+ can return alpha pixel format for GIFs that don't use alpha. An easy enough mod to that routine.

    If you did want to modify that cFunctionsPCX SaveToStream routine, you'd just have to rem out or remove that one line afterall
    Code:
    bAlpha = HasTransparency(Handle, ImageType, tBMP.PixelFormat, False)
    BTW: With above temp mod, that gif compressed to 689 kb

    Thanx for leading me to that issue.
    Oh and great image; looks soooo rich & just 256 colors, wow!
    Insomnia is just a byproduct of, "It can't be done"

    Classics Enthusiast? Here's my 1969 Mustang Mach I Fastback. Her sister '67 Coupe has been adopted

    Newbie? Novice? Bored? Spend a few minutes browsing the FAQ section of the forum.
    Read the HitchHiker's Guide to Getting Help on the Forums.
    Here is the list of TAGs you can use to format your posts
    Here are VB6 Help Files online


    {Alpha Image Control} {Memory Leak FAQ} {Unicode Open/Save Dialog} {Resource Image Viewer/Extractor}
    {VB and DPI Tutorial} {Manifest Creator} {UserControl Button Template} {stdPicture Render Usage}

  2. #42

    Thread Starter
    Hyperactive Member
    Join Date
    Jul 2010
    Posts
    273

    Re: [RESOLVED] About PCX

    You're welcome. I call it a day now.

  3. #43
    New Member
    Join Date
    Nov 2017
    Posts
    1

    Re: [RESOLVED] About PCX

    Petersen

    Came across this thread and am trying to get it to work with VB.Net using framework 4.5

    The file being created is not in the correct format. I had made a few changes in the declarations to make the code run. Still missing something. Can you take a look?

    Starting with the image in a picturebox:
    Code:
            Dim sPCXFile As String = System.IO.Path.GetTempFileName
            Dim oGraphics As Graphics = myPictureBox.CreateGraphics
            Dim oHDC As IntPtr = oGraphics.GetHdc()
            SavePCX(sPCXFile, oHDC, 500, 500)
    Your code with amendments:
    Code:
    Imports System.Runtime.InteropServices
    
        Private Const vbSRCCOPY = &HCC0020
        Private Structure RGBTriple
            Public Red As Byte
            Public Green As Byte
            Public Blue As Byte
        End Structure
    
        Private Structure PCXHeader                     ' 128 bytes
            Public Manufacturer As Byte
            Public Version As Byte
            Public Encoding As Byte                          ' 1 = RLE
            Public BitsPP As Byte                              ' 1, 2, 4, 8
            Public xMin As Integer
            Public yMin As Integer
            Public w As Integer
            Public h As Integer
            Public hDPI As Integer
            Public vDPI As Integer
            <VBFixedArray(16)> Public Minutiae() As RGBTriple
            Public Reserved As Byte
            Public Planes As Byte
            Public BytesPerLine As Integer
            Public PaletteType As Integer
            Public HScreenSize As Integer
            Public VScreenSize As Integer
            <VBFixedArray(54)> Private Reserved2() As Byte
        End Structure
    
        Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Object, pSrc As Object, _
           ByVal ByteLen As Long)
    
        Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, _
           ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, _
           ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
    
        Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
        Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
        Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
        Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
    
        Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Int32, ByVal hBitmap As Int32, _
           ByVal nStartScan As Int32, ByVal nNumScans As Int32, ByRef lpBits As Int32, ByRef lpBI As BITMAPINFO, _
           ByVal wUsage As Int32) As Long
    
        Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hDC As Int32, _
            ByRef pBitmapInfo As BITMAPINFO, ByVal un As UInt32, _
            ByRef ppvBits As Int32, ByVal hSection As Int32, _
            ByVal dwOffset As UInt32) As Int32
    
        Private Const DIB_RGB_COLORS = 0
        Private Const BI_RGB = 0
    
        'Private Structure BITMAPINFOHEADER
        'Public biSize As Long
        'Public biWidth As Long
        'Public biHeight As Long
        'Public biPlanes As Integer
        'Public biBitCount As Integer
        'Public biCompression As Long
        'Public biSizeImage As Long
        'Public biXPelsPerMeter As Long
        'Public biYPelsPerMeter As Long
        'Public biClrUsed As Long
        'Public biClrImportant As Long
        'End Structure
        <StructLayout(LayoutKind.Sequential)> _
        Private Structure BITMAPINFOHEADER
            Public biSize As Int32
            Public biWidth As Int32
            Public biHeight As Int32
            Public biPlanes As Int16
            Public biBitCount As Int16
            Public biCompression As Int32
            Public biSizeImage As Int32
            Public biXPelsPerMeter As Int32
            Public biYPelsPerMeter As Int32
            Public biClrUsed As Int32
            Public biClrImportant As Int32
        End Structure
    
        'Private Structure RGBQUAD
        'Public B As Byte
        'Public G As Byte
        'Public R As Byte
        'Public a As Byte
        'End Structure
        <StructLayout(LayoutKind.Sequential)> _
        Private Structure RGBQUAD
            Public rgbBlue As Byte
            Public rgbGreen As Byte
            Public rgbRed As Byte
            Public rgbReserved As Byte
        End Structure
    
        'Private Structure BITMAPINFO
        'Public bmiHeader As BITMAPINFOHEADER
        'Public bmiColors As RGBQUAD
        'End Structure
        <StructLayout(LayoutKind.Sequential)> _
        Private Structure BITMAPINFO
            Dim bmiheader As BITMAPINFOHEADER
            Dim bmiColors As RGBQUAD
        End Structure
    
        Private Structure BGRcolorspace
            Public b As Byte
            Public g As Byte
            Public r As Byte
        End Structure
    
    
        Public Function SavePCX(inFileSpec As String, inHDC As Long, inW As Long, inH As Long) As Boolean
            Dim tmpPCX As New PCXHeader
            Dim mHandle As Integer
            Dim arrByte() As Byte
            Dim BI As BITMAPINFO
            Dim tmpBitmap As Long
            Dim tmpDC As Long
            Dim arrPCXbyte() As Byte
            Dim DIBw As Long
            Dim PCXw As Long
            Dim tmpByte() As Byte
            Dim i As Long
    
            If inW * 3 Mod 4 = 0 Then
                DIBw = inW * 3
            Else
                DIBw = (inW * 3 \ 4 + 1) * 4
            End If
    
            If inW Mod 2 = 0 Then
                PCXw = inW
            Else
                PCXw = inW + 1
            End If
    
            ReDim arrPCXbyte((DIBw) * inH - 1)
    
            With BI.bmiheader
                .biSize = Len(BI.bmiheader)
                .biWidth = inW
                .biHeight = inH
                .biBitCount = 24
                .biCompression = BI_RGB
                .biPlanes = 1
            End With
    
            tmpDC = CreateCompatibleDC(inHDC)
            Dim lVoid As Long = 0, lHandle As Long = 0, lDW As Long = 0
            tmpBitmap = CreateDIBSection(tmpDC, BI, DIB_RGB_COLORS, lVoid, lHandle, lDW)
            SelectObject(tmpDC, tmpBitmap)
            BitBlt(tmpDC, 0, 0, BI.bmiheader.biWidth, BI.bmiheader.biHeight, inHDC, 0, 0, vbSRCCOPY)
    
            'Adj for bottom up
            BI.bmiheader.biHeight = (0 - inH)
            GetDIBits(tmpDC, tmpBitmap, 0, inH, arrPCXbyte(0), BI, DIB_RGB_COLORS)
    
            ReDim tmpByte(PCXw * inH * 3 - 1)
    
            'Put to PCX sequence
            Dim MyGC As GCHandle = GCHandle.Alloc(tmpByte, GCHandleType.Pinned)
            Dim ptrGC As IntPtr = MyGC.AddrOfPinnedObject()
    
            If inW * 3 <> DIBw Then
                For i = 0 To inH - 1
                    'CopyMemory(  tmpByte(i * PCXw * 3), arrPCXbyte(i * DIBw), PCXw * 3)
                    Marshal.Copy(tmpByte, (i * PCXw * 3), arrPCXbyte(i * DIBw), PCXw * 3)
                Next i
            Else
                'CopyMemory(tmpByte(0), arrPCXbyte(0), UBound(arrPCXbyte) + 1)
                Marshal.Copy(arrPCXbyte, 0, ptrGC, UBound(arrPCXbyte) + 1)
            End If
    
            DeleteDC(tmpDC)
            DeleteObject(tmpBitmap)
    
            With tmpPCX
                .Manufacturer = 10
                .Version = 5
                .Encoding = 0
                .BitsPP = 8
                .Planes = 3
                .xMin = 1
                .yMin = 1
                .w = inW
                .h = inH
                .hDPI = 96
                .vDPI = 96
                .Reserved = 0
                .PaletteType = 0
                .BytesPerLine = PCXw
            End With
    
            FormPCX24BPPbytes(tmpByte, arrByte, PCXw, inH)
    
            'If compression is wanted, unblock
            'CompressPCX arrByte, inScanW
    
            mHandle = FreeFile()
            'Open inFileSpec For Binary Access Read Write As mHandle
            Dim fsFile As IO.FileStream
            fsFile = IO.File.Open(inFileSpec, IO.FileMode.OpenOrCreate, IO.FileAccess.ReadWrite)
            'Put #mHandle, , tmpPCX
            'Put #mHandle, , arrByte
            'Close #mHandle
    
            Dim Ptr As IntPtr = Marshal.AllocHGlobal(Marshal.SizeOf(tmpPCX))
            Dim ByteArray(Marshal.SizeOf(tmpPCX) - 1) As Byte
            'now copy structure to Ptr pointer 
            Marshal.StructureToPtr(tmpPCX, Ptr, False)
            'copy to byte array
            Marshal.Copy(Ptr, ByteArray, 0, Marshal.SizeOf(tmpPCX))
            Marshal.FreeHGlobal(Ptr)
    
            fsFile.Write(ByteArray, 0, UBound(ByteArray) + 1)
            fsFile.Write(arrByte, 0, UBound(arrByte) + 1)
            fsFile.Close()
    
            Erase arrPCXbyte
            Erase tmpByte
    
            SavePCX = True
        End Function
    
    
        Private Sub FormPCX24BPPbytes(inArrSrc() As Byte, ByRef inArrDest() As Byte, inScanW As Long, inH As Long)
            Dim x As Long, y As Long
            Dim nStartPos As Long
            Dim h As Long
            Dim arrBGR() As BGRcolorspace
    
            ReDim arrBGR(inScanW * inH)
            Dim MyGC As GCHandle = GCHandle.Alloc(arrBGR, GCHandleType.Pinned)
            Dim ptrGC As IntPtr = MyGC.AddrOfPinnedObject()
    
            'CopyMemory(arrBGR(0), inArrSrc(0), (inScanW * inH * 3))
            Marshal.Copy(inArrSrc, 0, ptrGC, inScanW * inH * 3)
            ReDim inArrDest(inScanW * inH * 3 - 1)
            For y = 0 To inH - 1
                For x = 0 To inScanW - 1
                    h = inH - y - 1
                    nStartPos = h * inScanW * 3 + x
                    With arrBGR((x + (inH - 1 - y) * inScanW))
                        inArrDest(nStartPos) = .r
                        inArrDest(nStartPos + inScanW) = .g
                        inArrDest(nStartPos + inScanW * 2) = .b
                    End With
                Next x
            Next y
        End Sub

Page 2 of 2 FirstFirst 12

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Featured


Click Here to Expand Forum to Full Width

Survey posted by VBForums.