-
Jan 2nd, 2011, 01:31 AM
#41
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!
-
Jan 2nd, 2011, 02:07 AM
#42
Thread Starter
Hyperactive Member
Re: [RESOLVED] About PCX
You're welcome. I call it a day now.
-
Nov 11th, 2017, 04:46 AM
#43
New Member
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
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|