Valhalla Legends Forums Archive | Visual Basic Programming | Loading PCX files?

AuthorMessageTime
JoeTheOdd
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.
December 2, 2005, 3:14 AM
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.
December 2, 2005, 4:09 AM
K
Google came up with this for me.

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

December 2, 2005, 4:10 AM
UserLoser.
I gave you more than enough information just the other night.
December 2, 2005, 4:22 AM
JoeTheOdd
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.
December 2, 2005, 4:35 AM
Ringo
[quote author=Joe link=topic=13400.msg136035#msg136035 date=1133493267]
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.
[/quote]

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]

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
[/code]


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


hope this helps :)
December 2, 2005, 9:50 PM
JoeTheOdd
OMG! /ehug!

MY HERO!

/exault
/thank

Thanks.

/addabout Ringo
December 2, 2005, 10:52 PM
Ringo
I just want the phone credit, i need to make a long distance phone call! :)
December 2, 2005, 11:43 PM
Newby
[quote author=Joe link=topic=13400.msg136099#msg136099 date=1133563933]
OMG! /ehug!

MY HERO!

/exault
/thank

Thanks.

/addabout Ringo
[/quote]

Did you just copy and paste the code?
December 3, 2005, 6:32 PM
rabbit
[quote author=Newby link=topic=13400.msg136219#msg136219 date=1133634740]
[quote author=Joe link=topic=13400.msg136099#msg136099 date=1133563933]
OMG! /ehug!

MY HERO!

/exault
/thank

Thanks.

/addabout Ringo
[/quote]

Did you just copy and paste the code?
[/quote]He's Joe.
December 3, 2005, 7:38 PM
Quarantine
[quote author=Newby link=topic=13400.msg136219#msg136219 date=1133634740]
[quote author=Joe link=topic=13400.msg136099#msg136099 date=1133563933]
OMG! /ehug!

MY HERO!

/exault
/thank

Thanks.

/addabout Ringo
[/quote]

Did you just copy and paste the code?
[/quote]

*shrug* He just said thanks :P
But yea, he's Joe
December 3, 2005, 9:39 PM
JoeTheOdd
[me=Joe]agrees with Warrior. I = Joe.[/me]
December 4, 2005, 5:13 AM
rabbit
Too bad he was agreeing with me, jackass.
December 5, 2005, 1:51 AM
FrOzeN
Why are you implementing Ad Banner support into a bot? :-\
December 5, 2005, 2:03 AM
Topaz
Stfu Frozen you suck at life
December 5, 2005, 2:18 AM
JoeTheOdd
Hey Topaz, I'd apreciate it if you didn't answer questions directed at me, especially with a flame.

[quote author=FrOzeN link=topic=13400.msg136404#msg136404 date=1133748225]
Why are you implementing Ad Banner support into a bot? :-\
[/quote]For the experience of doing so. JBBE isn't being released anymore, so its not hurting anyone, and if I don't want to see them, theres a configuration value (General->DisplayAdvertisments or something like that) that can be set to false to hide them.
December 5, 2005, 2:43 AM
FrOzeN
[quote author=Joe link=topic=13400.msg136409#msg136409 date=1133750585]
Hey Topaz, I'd apreciate it if you didn't answer questions directed at me, especially with a flame.

[quote author=FrOzeN link=topic=13400.msg136404#msg136404 date=1133748225]
Why are you implementing Ad Banner support into a bot? :-\
[/quote]For the experience of doing so. JBBE isn't being released anymore, so its not hurting anyone, and if I don't want to see them, theres a configuration value (General->DisplayAdvertisments or something like that) that can be set to false to hide them.
[/quote]
Oh ok. :)
December 5, 2005, 2:46 AM
QwertyMonster
[quote author=Topaz link=topic=13400.msg136407#msg136407 date=1133749125]
Stfu Frozen you suck at life
[/quote]

I beg your pardon? What was that for?
December 5, 2005, 4:15 PM
JoeTheOdd
[quote author=QwertyMonster link=topic=13400.msg136463#msg136463 date=1133799336]
[quote author=Topaz link=topic=13400.msg136407#msg136407 date=1133749125]
Stfu Frozen you suck at life
[/quote]

I beg your pardon? What was that for?
[/quote]

Hm.. while we're flaming, DON'T FEED THE TROLL.

Kidding Qwerty, we all love you.
December 5, 2005, 11:33 PM
FrOzeN
I still don't get it. I don't even know who Topaz is, apart from a few posts I've seen.
December 5, 2005, 11:47 PM
MesiaH
He is your father.  :o
December 22, 2005, 9:45 AM

Search