Loading PCX files?

[Joe[x86]]

Yeah. I don't say this often, so savor the moment, this is totally over my head.

Can anyone provide me with a easy-to-follow tutorial on loading a PCX file into an object (I asume, a picturebox)? Anyone who helps will be both credited, and exaulted. <3.

Thanks in advance.

PS: Any documentation on SMK is also apreciated.

[SNiFFeR]

Don't really know what you want to use it for. So I did a google search, this came up. Quickly glanced at it. Not sure if thats what you need. Refer to this.

[K]

Google came up with this for me.

If you follow the format, it should be easy enough to load a file.

[UserLoser.]

I gave you more than enough information just the other night.

[Joe[x86]]

Yeah, I started forgetting what I opened windows for while trying to figure it out, and after almost passing out, went to bed. Like I said, over my head.

[Ringo]

Yeah. I don't say this often, so savor the moment, this is totally over my head.

Can anyone provide me with a easy-to-follow tutorial on loading a PCX file into an object (I asume, a picturebox)? Anyone who helps will be both credited, and exaulted. <3.

Thanks in advance.

PS: Any documentation on SMK is also apreciated.

I dragged this out of my bot, and made it as simple as i could.
It doesnt need to be classed, so you can dump it in a module.
Iv also commented things as simple as i can, so not to over confuse things, and made it simply load it to a picture box.
(the code is abit ewwwy, i know)

When you decide to make a class for it, this should help you understand the steps.
(anything you dont understand, feel free to ask)

Code Select Expand



Private Sub Command1_Click()
    DrawPCX Picture1, App.Path & "\ad000b0b.pcx"
End Sub





Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC 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 CreateDIBitmap_8 Lib "gdi32" Alias "CreateDIBitmap" (ByVal hdc As Long, lpInfoHeader As BITMAPINFOHEADER, ByVal dwUsage As Long, lpInitBits As Any, lpInitInfo As BITMAPINFO_8, ByVal wUsage As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal numbytes As Long)

Private Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type
Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type
Private Type BITMAPINFO_8
    bmiHeader As BITMAPINFOHEADER
    bmiColors(255) As RGBQUAD
End Type

Private Type RGBTriple
    Red As Byte
    Green As Byte
    Blue As Byte
End Type
Private Type PCXHeader
    Manufacturer As Byte
    Version As Byte
    Encoding As Byte
    Bpp As Byte
    XMIN As Integer
    YMIN As Integer
    XMAX As Integer
    YMAX As Integer
    HDpi As Integer
    VDpi As Integer
    ColourPalette(0 To 15) As RGBTriple
    Reserved1 As Byte
    Planes As Byte
    BytesPerLine As Integer
    PaletteInfo As Integer
    HScreenSize As Integer
    VScreenSize As Integer
    Reserved2(0 To 53)  As Byte
End Type

Private bm8 As BITMAPINFO_8 'bitmap infomation header
Private hBmp As Long 'bitmap handle
Private LineSize As Long
Private BitmapData() As Byte
Private nWidth As Long
Private nHeight As Long
Private Header As PCXHeader

Public Sub DrawPCX(PicBox As PictureBox, ByVal PCXPath As String)
    'Check we can see the file
    If Dir$(PCXPath) = vbNullString Then
        MsgBox "Unable to load " & PCXPath & vbCrLf & "File not found.", vbCritical
        Exit Sub
    End If
    'load file
    LoadBannerPCX PCXPath
    'draw to 'PicBox'
    DrawBitmap nWidth, nHeight, PicBox, False
    'clear up
    Erase BitmapData()
End Sub

Private Sub LoadBannerPCX(ByRef FileName As String)
On Error GoTo hdlError
    Dim FF As Integer, PalByte As Byte, i As Integer, hdc As Long
    Dim Pal(0 To 255) As RGBTriple 'palette
    FF = FreeFile()
    'open file and extract the header
    Open FileName For Binary Lock Write As #FF
        Get #FF, , Header
        'check its a PCX file
        If IsPCX(Header) = False Then
            MsgBox "ITS NOT A PCX"
            GoTo FileClose
        End If
        With Header
            'extract width and height from the header
            nWidth = .XMAX - .XMIN + 1
            nHeight = .YMAX - .YMIN + 1
            LineSize = .Planes * .BytesPerLine
            'check its a 8bit PCX
            Select Case .Bpp
                Case 1
                    If .Planes = 1 Then
                        MsgBox "PCX is 1bit"
                    ElseIf .Planes = 4 Then
                        MsgBox "PCX is 4bit"
                    End If
                    GoTo FileClose
                Case 4
                    If .Planes = 1 Then
                        MsgBox "PCX is 4bit"
                    End If
                    GoTo FileClose
                Case 8
                    If .Planes = 1 Then
                        'Bnet pcx banner files are
                        'always 8 bit i tihnk*
                        GoTo PCXLoad
                    ElseIf .Planes = 3 Then
                        MsgBox "PCX is 24bit"
                        GoTo FileClose
                    Else
                        GoTo FileClose
                    End If
                Case Else
                    MsgBox "Unknown PCX"
                    GoTo FileClose
            End Select
        End With
FileClose:
    Close #FF
hdlError:
    Exit Sub
PCXLoad: 'resume load
        'preserve the amount of bytes needed to hold in are byte array
        ReDim BitmapData(LOF(FF) - Len(Header))
        Get #FF, , BitmapData()
        'Get palette indication byte
        Seek #FF, LOF(FF) - 768
        Get #FF, , PalByte
        'Check for palette
        If PalByte = 12 Then
            'Get it
            Seek #FF, LOF(FF) - 767
            Get #FF, , Pal()
        Else
            'create one
            For i = 0 To 255
                Pal(i).Blue = i
                Pal(i).Green = i
                Pal(i).Red = i
            Next i
        End If
    Close #FF
    'Trasfer Palette
    For i = 0 To 255
        With bm8.bmiColors(i)
            .rgbBlue = Pal(i).Blue
            .rgbGreen = Pal(i).Green
            .rgbRed = Pal(i).Red
            .rgbReserved = 0
        End With
    Next i
    If Header.Encoding = 1 Then
        'decompress the image data
        DecompressPCX BitmapData
    End If
    'Convert into a bitmap format
    MakeBitmap BitmapData, nHeight, LineSize
    'create a 8bit bitmap from are image data byte array
    With bm8.bmiHeader
        .biSize = Len(bm8.bmiHeader)
        .biWidth = nWidth
        .biHeight = nHeight
        .biPlanes = 1
        .biBitCount = 8
    End With
    'Get the DC
    hdc = GetDC(0)
    'Create 8 bit bitmap and get the handle
    hBmp = CreateDIBitmap_8(hdc, bm8.bmiHeader, &H4, BitmapData(0), bm8, &H0)
End Sub

Private Sub DecompressPCX(imgData() As Byte)
    Dim tmpBM() As Byte, i As Long, i2 As Long, A As Long, B As Long, Expan As Long, C As Byte
    'copy compressed bitmap to tmpBitmap
    ReDim tmpBM(UBound(imgData))
    CopyMemory tmpBM(0), imgData(0), UBound(imgData) + 1
    ReDim imgData(0)
    For i = 0 To UBound(tmpBM) - 1
        A = tmpBM(i)
        If A > 191 Then
            B = A - 192
            C = tmpBM(i + 1)
            i = i + 1
        Else
            B = 1
            C = A
        End If
        For i2 = 1 To B
            'refill bitmapdata with decompressed data
            ReDim Preserve imgData(Expan)
            imgData(Expan) = C
            Expan = Expan + 1
        Next i2
    Next i
    Erase tmpBM()
End Sub

Private Sub MakeBitmap(imgArray() As Byte, Lines As Long, BytesLine As Long)
    Dim tmpBM() As Byte, G As Long, GBMP As Long, i As Long, i2 As Long, tmpBMX As Long
    If (BytesLine Mod 4) = 0 Then
        tmpBMX = BytesLine - 1
    Else
        tmpBMX = (BytesLine \ 4) * 4 + 3
    End If
    G = Lines * BytesLine
    GBMP = Lines * (tmpBMX + 1) - 1
    'copy bitmapdata to tmpBM
    ReDim tmpBM(UBound(imgArray))
    CopyMemory tmpBM(0), imgArray(0), UBound(imgArray) + 1
    ReDim imgArray(GBMP)
    'convert and recopy the new bitmapdata back
    For i = 0 To BytesLine * Lines - BytesLine Step BytesLine
        CopyMemory imgArray(i2), tmpBM(G - i - BytesLine), BytesLine
        i2 = i2 + tmpBMX + 1
    Next i
    'clear are temp bitmap
    Erase tmpBM()
End Sub

Private Sub DrawBitmap(PicWidth As Long, PicHeight As Long, Pic As PictureBox, Autoscale As Boolean)
    Dim cDC As Long, sScale As Long, pScale As Long, realheight As Long, realwidth As Long
    'eeew! i know!
    With Pic
        .AutoRedraw = True
        .Cls
        pScale = .Parent.ScaleMode
        .Parent.ScaleMode = 1
        sScale = .ScaleMode
        .ScaleMode = 1
        If Autoscale = True Then
            .Height = PicHeight * Screen.TwipsPerPixelY
            .Width = PicWidth * Screen.TwipsPerPixelX
        End If
        If Not .Height = .ScaleHeight Then  'with Boarders
            realheight = .Height / Screen.TwipsPerPixelY
            realwidth = .Width / Screen.TwipsPerPixelX
        Else
            .ScaleMode = 3
            realheight = .ScaleHeight
            realwidth = .ScaleWidth
        End If
        If hBmp Then 'we have the bitmap handle
            Const SCRCOPY As Long = &HCC0020
            cDC = CreateCompatibleDC(.hdc)
            SelectObject cDC, hBmp
            Call StretchBlt(.hdc, 0, 0, realwidth, realheight, cDC, 0, 0, PicWidth, PicHeight, SCRCOPY)
            DeleteDC cDC
        End If
        .Parent.ScaleMode = pScale
        .ScaleMode = sScale
        .Picture = .Image
        .AutoRedraw = False
    End With
End Sub

Private Function IsPCX(H As PCXHeader) As Boolean
    'test's the header to make sure its a PCX file
    IsPCX = True
    With H
        If Not .Manufacturer = &HA Then IsPCX = False
        If Not .Encoding < &H2 Then IsPCX = False
        Select Case .Version
            Case &H0, &H2, &H3, &H5
            Case Else: IsPCX = False
        End Select
    End With
End Function



And the only infomaiton i know of about SMK, is here


hope this helps

[Joe[x86]]

OMG! /ehug!

MY HERO!

/exault
/thank

Thanks.

/addabout Ringo

[Ringo]

I just want the phone credit, i need to make a long distance phone call!

[Newby]

OMG! /ehug!

MY HERO!

/exault
/thank

Thanks.

/addabout Ringo

Did you just copy and paste the code?

[rabbit]

OMG! /ehug!

MY HERO!

/exault
/thank

Thanks.

/addabout Ringo

Did you just copy and paste the code?

He's Joe.

[Warrior]

OMG! /ehug!

MY HERO!

/exault
/thank

Thanks.

/addabout Ringo

Did you just copy and paste the code?

*shrug* He just said thanks
But yea, he's Joe

[Joe[x86]]

* Joe agrees with Warrior. I = Joe.

[rabbit]

Too bad he was agreeing with me, jackass.

[FrOzeN]

Why are you implementing Ad Banner support into a bot?

[Topaz]

Stfu Frozen you suck at life