[vb6] Class to make Image Controls Support PNG, TIF, GIF Animation

hi i hv 3 question

1: how can use of this class for load pictures on layered window(for example transparent form,please send a example projecte used this class, i used alpha image control but i dont want load all of classes and control and ... i want just use a simple class like ur class )

2: how can load apng format with this class(when this calss can suppore png or tiff multipage why can not support apng?
i want load animation png on form(transparent form like as desktop)


3: how can load psd format (for example psd old format with adobe 8 cs for better processing) and i want load each layers on layred window or i want find counts of layers and ....?
or if psd format is hard so no matter i can use tiff format but i need load each layers on separated layered window

(for example i hv a a.psd or a.tiff with 10 layers and i named each layer to open close hover disable or like this and i want load like object and when mouse entered on object hover layer can show or ....) i see like this on some softwares and i want create like that with vb.

PSD and APNG are not supported by this class. If you can extract an image in bmp, jpg or tiff format from PSD (common in PSDs I believe), then you can send the bytes to this class.

Edited: I have no PSD parsing routines and am not interested in supporting PSD. That does not stop anyone from using whatever they want to parse the PSD themselves to extract the image format. Looks like the format is described here

If APNG is a requirement, suggest not using this class. Though, maybe over the next few days, I'll play with the idea. Initial thoughts are parsing the APNG and saving it to multi-page TIFF format and then treating the TIFF much like how this class handles GIF. Just a thought & no promises.

As far as your first question, let me create a simple example and post a bit later (tonite or tomorrow). You'll need a short routine to convert any image to 32bpp pre-multiplied so that you can use layered window APIs. Kinda busy with something else at the moment.

ok i am waiting to question 1 samples and i hv some sources to work with psd format in vb (special photoshop 8 or 6 format - is different with current PSDfiles created by photoshop versions) i can send a sample using psd by vb but i want u check it and maybe can convert to a class for use in a sample project and used by your class too. i think it is easy for your because psd sample worked with vb is very simple but my problem is in work with graphic in vb6 and i think it is easy for get counts of layers and ....

Here is a simple example using layered windows. I assume you already know how to apply the attributes and create the bitmap required for layered window APIs. If so, the part of this code you will be interested in is Form_Load

1. Add a new form to the test project included the one from the 1st post in this thread. Make form borderless
2. Set your project startup to begin with the new form
3. Copy and paste this into the new form

Code:

---

Option Explicit

Private Declare Function UpdateLayeredWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal hdcDst As Long, ByRef pptDst As Any, ByRef pSize As Any, ByVal hdcSrc As Long, ByRef pptSrc As Any, ByVal crKey As Long, ByRef pblend As Long, ByVal dwFlags As Long) As Long
Private Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32.dll" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function ReleaseCapture Lib "user32.dll" () As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Sub FillMemory Lib "kernel32.dll" Alias "RtlFillMemory" (ByRef Destination As Any, ByVal Length As Long, ByVal Fill As Byte)
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hDC As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32.dll" (ByVal hDC As Long, ByRef pBitmapInfo As Any, ByVal un As Long, ByRef lplpVoid As Long, ByVal Handle As Long, ByVal dw As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hDC As Long) As Long
Private Const WS_EX_LAYERED As Long = &H80000
Private Const GWL_EXSTYLE As Long = -20
Private Const ULW_ALPHA As Long = &H2
Private Const ULW_COLORKEY As Long = &H1
Private Const WM_NCLBUTTONDOWN As Long = &HA1
Private Const HTCAPTION As Long = 2
Private Const AC_SRC_ALPHA As Long = &H1
Private Const AC_SRC_OVER As Long = &H0
Private Const GWL_STYLE As Long = -16
Private Const WS_BORDER As Long = &H800000
Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type Size
    Cx As Long
    Cy As Long
End Type
Private Type BITMAPINFOHEADER        ' GDI structure
    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 m_hDC As Long, m_hBmp As Long, m_DIBptr As Long
Private m_Opacity As Long
Private m_MousePoints As POINTAPI
Private m_Size As Size

Private Sub Form_DblClick()
    Unload Me
End Sub

Private Sub Form_Load()

    Dim tPic As StdPicture
 
    m_MousePoints.x = -1&
    m_Opacity = 255
   
    Set tPic = StdPictureEx.LoadPicture(LoadResData("PNG", "CUSTOM"), , , , , , vbPicTypeBitmap)
    'Set tPic = StdPictureEx.LoadPicture(LoadResData("ICON", "CUSTOM"), lpsCustom, , 256, 256)
   
    m_Size.Cx = ScaleX(tPic.Width, vbHimetric, vbPixels)
    m_Size.Cy = ScaleY(tPic.Height, vbHimetric, vbPixels)
    If pvCreateLWdc = False Then
        Stop
        ' error couldn't create a basic DC & bitmap
    End If
    Me.Move Me.Left, Me.Top, m_Size.Cx * Screen.TwipsPerPixelX, m_Size.Cy * Screen.TwipsPerPixelY
    tPic.Render (m_hDC), 0!, 0!, (m_Size.Cx), (m_Size.Cy), 0!, tPic.Height, tPic.Width, -tPic.Height, ByVal 0&
   
    SetWindowLong Me.hWnd, GWL_EXSTYLE, GetWindowLong(Me.hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED
    Call pvUpdateWindow
    Show
   
End Sub

Private Sub pvUpdateWindow()
    Dim srcPt As POINTAPI
    Dim lBlendFunc As Long
    lBlendFunc = AC_SRC_OVER Or (m_Opacity * &H10000) Or (AC_SRC_ALPHA * &H1000000)
    UpdateLayeredWindow Me.hWnd, 0&, ByVal 0&, m_Size, m_hDC, srcPt, 0&, lBlendFunc, ULW_ALPHA
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton And m_MousePoints.x > -1& Then
        If m_MousePoints.x <> x And m_MousePoints.y <> y Then
            ReleaseCapture
            m_MousePoints.x = -1
            SendMessage Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&
        End If
    End If
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton Then
        m_MousePoints.x = x
        m_MousePoints.y = y
    End If
End Sub

Private Function pvCreateLWdc() As Boolean
    Dim BHI As BITMAPINFOHEADER
    Dim tDC As Long
    With BHI
        .biBitCount = 32
        .biHeight = -m_Size.Cy
        .biWidth = m_Size.Cx
        .biPlanes = 1
        .biSize = Len(BHI)
    End With
    tDC = GetDC(0)
    m_hDC = CreateCompatibleDC(tDC)
    ReleaseDC 0, tDC
    m_hBmp = CreateDIBSection(m_hDC, BHI, 0&, m_DIBptr, 0&, 0&)
    If m_hBmp <> 0 Then
        m_hBmp = SelectObject(m_hDC, m_hBmp)
        pvCreateLWdc = True
    Else
        DeleteDC m_hDC: m_hDC = 0&
    End If
End Function

Private Sub Form_Unload(Cancel As Integer)
    If m_hBmp <> 0 Then
        DeleteObject SelectObject(m_hDC, m_hBmp)
        DeleteDC m_hDC
    End If
End Sub

---

An example of using an icon is also in the Form_Load, but commented out. The form uses a PNG in this example. GIFs are not working so avoid those for layered window images.

Avoid hitting STOP while using the class. The sample form can be closed by double clicking on it. It can be dragged around the desktop.

If your goal is to animate GIFs onto layered windows, let me know. I'll see if I can tweak the class to support GIFs to 32bpp premultiplied so you can use it correctly. In any case, animation would require rendering each GIF frame to the layered window bitmap and calling UpdateLayeredWindow. The test project (Form1) included with this class shows how animation is performed and how to navigate the GIF frames.

Icons less than 32bpp don't work either in this case. I'll have to look at the routine that is supposed to return/convert to 32bpp bitmap. I think I coded it to convert to 32bpp bitmap only if necessary vs. always if user wants it that way. Makes sense to me because why subclass the image if not needed. In this case, it may be needed to render 32bpp premultiplied correctly. The icon in the example works because there are 32bpp icons in the resource file icon.

FYI: This is nearly the exact same example I used when describing how to do this with the AlphaImage Control

hi i used ur codes but now i hv a problem for use form controls too, i want use this class and form controls too in same time,in this code just used dc.how can merge layered window with form and this class too.for example i want use text boxes or commands or .... on form and images used by this class too(can u send a sampe code or project)

and how can make animation (not gif) just png pictures on layered window or forms or merged both by this class ?

and any ways to can use sprite sheets png ? u hv any class or control for it? i can use apng in alpha image control but i want know any way for import animations like sprite sheets in these classes? and make animation on forms or layared window merged with form like games?

This thread isn't the place to ask about using controls on layered windows. I'd recommend posting those questions in the VB Forums section.

For animation and this class:

1. The class does not animate. It is the responsibility of the user (you) to begin and stop animation with whatever method you want. In the demo provided with this class, you can see one way to animate using a simple timer. The class can pass you the information you need for animation: frame count, duration times, etc.

2. Animating PNGs is not yet supported because this class does not parse APNG files. I mentioned that I will consider adding that capability, but that will take a few days. And even if I provide the capability, it will not be as efficient as the Alpha Image Control. I purposely did not intend this project to be a mini-AlphaImage control. This class was only intended to extend VB's Image control and stdPicture object.

i hv a sample for read a special file format (PSD) - i dont want use png or tif or .... .
read pixels strcure is like this :

Code:

---

        For y = 0 To FHeight - 1
                For x = 0 To FWidth - 1
                        r = ScanR(y * FWidth + x)
                        g = ScanG(y * FWidth + x)
                        b = ScanB(y * FWidth + x)
                        a = ScanA2(y * FWidth + x)
                        If a > layers(i).Opacity Then a = layers(i).Opacity
                        SetPixelA theHdc, x + FLeft, y + FTop, r, g, b, a
                Next x
                If y Mod 32 = 0 Then FObject.Refresh: DoEvents
        Next y

---

theHdc is same target hdc like form.hdc or picturebox.hdc ( not worked on image box)

1.how can show this data on image box too ?

2.how i can load this array in to ur class?(send a sample project pls)

and my other question :
i can show this array on picture box or form.picture but i want show on layerd window.
when i used like ur sent code (pvCreateLWdc and pvUpdateWindow and hdc was been set picturebox.hdc or form hdc) not worked good
3.how can show this array on layered window and can click or move dc?
Attachment 151835

The first step is to understand how to create a bitmap from raw bytes.

Suggestion: Post a thread in the classic VB Forums section asking how to transfer PSD bytes to a bitmap. When I and others see that thread, we will reply. Regardless whether you use this class or not, you will want to be able to transfer the bytes to a bitmap. After you understand how to do that, then the following will apply...

If you create the bitmap in premulitplied format, you don't even need this class. You could use AlphaBlend to draw the bitmap directly to m_hDC (pvCreateLWdc ) or any other DC.

And if you still want to use this class, do not premulitiply the pixels. Then you could pass the bitmap handle to the class' pvHandleToStdPicture function (make it public so you can call it), then pass the returned stdPicture to the class' LoadPicture function.

You have choices, but first thing is first. You need to understand how to transfer raw bytes to a bitmap in the proper format. And that applies whether you use this class or not.

hi created this thread : http://www.vbforums.com/showthread.p...35#post5216435

i completed my project but i need optimize it and so i asked questions in that thread.
i am waiting to ur answers and thanks.

The image control can be transparent and moved, and together with the LABEL control, it supports up and down switching. But if you put this control on the PICTURE, can't display PNG images transparently.

Code:

---

Private Sub Command2_Click()
    Set Image1.Picture = StdPictureEx1.LoadPicture(App.Path & "\02AlphaPNG.png")
    Set Image2.Picture = StdPictureEx1.LoadPicture(App.Path & "\02AlphaPNG.png")
Timer1.Enabled = True
End Sub
Private Sub Timer1_Timer()
Image2.Left = Image2.Left + 10
End Sub

---

Btw, it says that this project is no longer maintained and the original author LaVolpe said good bye to these forums a couple of months ago.

If Image1 and Image2 in the snippet above are VB.Image controls then there is no way to make these controls paint alpha transparent StdPictures unless hooking the StdPicture.Render method as has been show before in other threads here.

I know that I will probably regret it but. . . here is a link to a single-file windowless image control that can load and paint 32-bit PNG images with alpha transparency: https://github.com/wqweto/AlphaBlendImage

cheers,
</wqw>

how to loadpicture from png only by gdi32.dll?or gdiplus.dll?
not with thunk,need your help,thank you

Quote:

---

Originally Posted by wqweto

Btw, it says that this project is no longer maintained and the original author LaVolpe said good bye to these forums a couple of months ago.

If Image1 and Image2 in the snippet above are VB.Image controls then there is no way to make these controls paint alpha transparent StdPictures unless hooking the StdPicture.Render method as has been show before in other threads here.

I know that I will probably regret it but. . . here is a link to a single-file windowless image control that can load and paint 32-bit PNG images with alpha transparency: https://github.com/wqweto/AlphaBlendImage

cheers,
</wqw>

---

Set Image1.Picture = StdPictureEx1.LoadPicture(App.Path & "\02AlphaPNG.png")
Set me.Picture = StdPictureEx1.LoadPicture(App.Path & "\02AlphaPNG.png")

it's with Transparent channel，it's very nice

Try Set AlphaBlendImage1.Picture = AlphaBlendImage1.GdipLoadPicture(App.Path & "\02AlphaPNG.png") instead.

There are several helper functions too: GdipLoadPicture, GdipLoadPictureArray, WicLoadPicture and WicLoadPictureArray for loading a transparent StdPicture using GDI+ and WIC respectively and several miscellaneous functions like GdipSetClipboardDib, GdipSetClipboardDibV5 and GdipUpdateLayeredWindow which are self-explanatory what they do.

You have to realize that the first step is to *load* a transparent PNG into a StdPicture (this is not easy) and the second step is to *paint* a transparent StdPicture. You've been looking for transparent paint left and right but the point is you don't even know how to load a 32-bit alpha PNG into an StdPicture.

cheers,
</wqw>

Quote:

---

Originally Posted by wqweto

Try Set AlphaBlendImage1.Picture = AlphaBlendImage1.GdipLoadPicture(App.Path & "\02AlphaPNG.png") instead.

There are several helper functions too: GdipLoadPicture, GdipLoadPictureArray, WicLoadPicture and WicLoadPictureArray for loading a transparent StdPicture using GDI+ and WIC respectively and several miscellaneous functions like GdipSetClipboardDib, GdipSetClipboardDibV5 and GdipUpdateLayeredWindow which are self-explanatory what they do.

You have to realize that the first step is to *load* a transparent PNG into a StdPicture (this is not easy) and the second step is to *paint* a transparent StdPicture. You've been looking for transparent paint left and right but the point is you don't even know how to load a 32-bit alpha PNG into an StdPicture.

cheers,
</wqw>

---

Call GdipCreateFromHDC(Me.hDC, pGraphics)
Call GdipLoadImageFromFile(StrConv(c_pngPath, vbUnicode), pImg)
Call GdipGetImageWidth(pImg, w)
Call GdipGetImageHeight(pImg, h)
Call GdipDrawImageRect(pGraphics, pImg, 0, 0, w, h)

i only khnow how to GdipDrawImageRect,but don't khnow set alpha png to StdPicture

Set Image1.Picture = AlphaBlendImage1.GdipLoadPicture(App.Path & "\bbb.png"),THIS code ,The background image is not transparent, it is black

VB.Image cannot display transparent StdPictures so you have to use AlphaBlendImage control. This is the second part of the problem when *painting* transparent StdPictures is not working.

image.picture=*
He used this component to make the picture transparent, but how to zoom in?
If you use the control itself to zoom out, it will be jagged and deformed.

StdPictureEx.LoadPicture，HOW TO SET BACKCOLOR TO WHITE?
LOAD png img file,backcolor is black,how to do?

Hi.
I want to use the StdPictureEx.cls mainly for GIF files.
Though I have found it very useful, I have the problem that I cannot load a GIF file during run-time and get the animation work.

I have used many ways:

The GifFile is as 12-frame gif.

Set Image1.Picture = StdPictureEx.LoadPicture(GifFile)

or

Image1.Picture = LoadPicture(GifFile)

or

Set imgItem = ImageList1.ListImages.Add( , , LoadPicture(GifFile))
Set Image1.Picture = imgItem.Picture


The StdPictureEx.SubImageCount(Image1.Picture) always return zero frames, so there can be no animation.

Some help, please.

Thanks.