How to Render multiple images into one AlphaImage control
Greetings, dear experts!
I create a big project for intuitive learning piano. I am professional musician and musical methodist rather than programmer, but my program is already very complex, and I still understand it.
It's very important to decide now, how to move a group of controls being transparent?
Of the controls, there are almost exclusively pictures.
Therefore, one of the solutions (not the best) is to render all pictures into one AlphaImage and move only it.
Then the question is:
HOW TO INSERT SEVERAL PICTURES - WITH EXACT COORDINATES - INTO ONE ALPHAIMAGE?
But if it is possible to group controls and move them around the form in one fell swoop, leaving transparency between them, it would be generally magical! However, control "Frame" is not transparent to other form controls (even with WinAPI), and the smooth movement of the group controls by For...Next looks like a big jittery. I found a working solution (move all transparent form over another form), but it is clumsy.
Re: How to Render multiple images into one AlphaImage control
Much thanks!
But I tried it all.
I have some AlphaImage controls.
I must move them gradually, all at the same time, and saving transparence.
THIS IS THE WHOLE PROBLEM.
If I move them by For...Next, they move step by step, slowly and ugly.
If I put them on a frame or PictureBox and move this container, they lose transparence
(and WinAPI doesn't help: container become transparent as a hole in a form, we see desktop behind form but not controls behind container).
Then I put pictures on another form, made this form transparent and move a whole new form with pictures over the old form with background pictures.
It works, but it has very clumsy and unreliable code.
I think the best solution is to render several pictures into one AlphaImageControl.
This control has command "Render", but I didn't find how to render multiple images with certain coordinates. Maybe someone made it?
Xiaoyao, I just tested Your Transparent control. It is really nice!
But in this case, the background trembles while moving...
I once did something similar with the transparency of the frame, it turned out about the same, and I left this idea.
Re: How to Render multiple images into one AlphaImage control
Hooray!
Still, I found something that is almost perfect: https://www.vbforums.com/showthread....aImage-control
And now I have adapted this code for my task. Everything worked out!
But I was looking for such solution during days , but I found it only now ...
Anyway, many thanks to everyone!
Re: How to Render multiple images into one AlphaImage control
This will still flicker on movement while using WS_EX_LAYERED will allow the GPU to alpha-blend which should remove flicker.
Another option is to alpha-blend *everything* into a canvas and draw the canvas in one step. This is how games are implemented, not with separate controls for characters or piano keys in your case.
There are a lot of people that do games here (with Direct2D or plain GDI) that might chime in and share ideas.
Re: How to Render multiple images into one AlphaImage control
In fact, it is very simple. The form is set to WS_EX_LAYERED, and then transparent PNG images are loaded on multiple controls, and they can be moved at will without any flicker. You can also set multiple controls into a combination, move one control, and it will move with it.
Finally, you can take a screenshot of the picture, or create a transparent PNG object according to their coordinates, and draw them in.
Re: How to Render multiple images into one AlphaImage control
You can also use a way to directly draw multiple images on the form, and place 5 LABEL controls on 5 images and set them to be transparent. Or set 5 groups of movable peripheral points, which can be a single moving image or multiple moving images. It's like designing a visual form and moving multiple controls.
Re: How to Render multiple images into one AlphaImage control
If you just move the entire group of pictures, it's the easiest, just use GDIPLUS or other methods to synthesize multiple pictures into a transparent picture first, and then move them as one picture.
You can also use the web control Webbrowser to operate, you can add a web page background, and then set a few transparent PNG images as a group to drag, write a small amount of JS or set an ID for each image, and bind it to the support event object DOM in VB6 , Synchronous movement
Last edited by xiaoyao; Jul 30th, 2021 at 12:54 PM.
the function LoadPng() ,only 50 lines code,The only disadvantage is that the system requires WIN8 and above. WIN10 works perfectly
So that several pictures can be moved at the same time
Code:
Dim xx, yy
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
DoMouseDown Button, X, Y
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
DoMove Button, X, Y
End Sub
Private Sub Command2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
DoMouseDown Button, X, Y
End Sub
Private Sub Command2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
DoMove Button, X, Y
End Sub
Sub DoMouseDown(Button As Integer, X As Single, Y As Single)
If Button = 1 Then
xx = X
yy = Y
End If
End Sub
Sub DoMove(Button As Integer, X As Single, Y As Single)
If Button = 1 Then
Picture1.Left = Picture1.Left + X - xx
Picture1.Top = Picture1.Top + Y - yy
Command2.Left = Command2.Left + X - xx
Command2.Top = Command2.Top + Y - yy
End If
End Sub
Last edited by xiaoyao; Jul 30th, 2021 at 07:38 PM.
Re: How to Render multiple images into one AlphaImage control
Originally Posted by xiaoyao
If you just move the entire group of pictures, it's the easiest, just use GDIPLUS or other methods to synthesize multiple pictures into a transparent picture first, and then move them as one picture.
I am doing this exactly! I merge many GDI+ pictures in one GDI+ control AlphaImage by LaVolpe. I like this control very much, I can load GIF animations in it, I can set % of transparency and then move them all, merged into one control, without flicking! And WS_EX_LAYERED is not needed in this case!
My PREVIOS way was two forms, one of which was transparent, as in your "Project3: Transparent Control By Multiple transparent windows form". But megring pictures is much easier and powerfully! I can make OCX control with it and not need to make several processes with API's, that depend on system version. By the way, I have Win7 on my mashine and I hate Win8 at all. It requires powerful computer, otherwise it works slowly. My program will be for children who want to be classical musicians and for adults who want to spend much time for music, not for earnings, and they most likely have a weak computer with Windows XP or 7. Among my friends, it is.
I learned your projects - they are very interesting! I remember "Project2:VB6 UserControl-Transparency Container" - I found something very similar before, maybe it was your project. But on such a transparent OCX, the AlphaImage can only be square - the edges of a transparent GIF are still gray. And I need to animate transparent GIFs - it complicates the task.
I made a project to test your Transparency UserControl deeper, but unfortunately can't attach it on the forum - it writes an unexpected error.
But merging all GIFs into one is really the best desicion! I will post here the code.
Re: How to Render multiple images into one AlphaImage control
Transparency_Usercontrol TEST.zip
This is test. Press "MOVING", watch a movement of Transparent control, then press "Bottom picture" and watch movement of picture without UserControl. This picture can consist of many pictures.
I think no much difference.
I put several images in Transparent UserControl, they move same.
That's why it would be simple to use your desicion.
But!!!
Transparent OCX doesn't allow the GIF to be transparent too!
Top image is on a gray background!
And in case of AlphaImgCtl it is the same!
Is there decision to make top image transparent on TransparentOCX, except of Win8 desicion and a second transparent window, and without complicate APIs?
Last edited by Svetlana; Jul 31st, 2021 at 07:08 AM.
Re: How to Render multiple images into one AlphaImage control
The gif animation is not really transparent. For example, he uses black or yellow as the background color, and then the picture also uses the same color as the background color, forming a virtual transparency.
True transparency is to have 0-255, multiple transparency, such as semi-transparent, fully transparent and other forms. Only by doing this can the animation scroll and move on any picture.
For example, the rotating earth, you need to convert the 360-degree rotating earth into 12 or 24 png images with true transparency per second.
Re: How to Render multiple images into one AlphaImage control
Image1.Left = Image1.Left + 60
There will always be some flicker in this method, and direct GDIPLUS drawing or other methods to draw can be truly flicker-free.
Use WS_EX_LAYERED to create multiple transparent forms, or create multiple transparent PNG image controls on one form. This method of movement is perfect, but it needs the support of WIN8 and above. In fact, WIN8 is almost the same as WIN7, and basically seldom takes up memory and CPU. There is basically no use of XP now. But if you want to use it for different users, you can only find a way to solve the compatibility problem of WIN7 and WIN8.
If you learn how to draw with gdiplus or GDI32, you can also achieve perfect transparency.
Re: How to Render multiple images into one AlphaImage control
Much thanks, Xiaoyao! I start understanding!
Originally Posted by xiaoyao
Image1.Left = Image1.Left + 60
There will always be some flicker in this method, and direct GDIPLUS drawing or other methods to draw can be truly flicker-free.
But if we make a transparent form, we must move a transparent frame in it, and it will be such as:
Frame1.left= Frame1.Left + 60
And it will still flick.
OR NOT?
Is there in GDI+ the way of DIRECT MOVING without timer and consistent adding to Left?
Re: How to Render multiple images into one AlphaImage control
If you have 10 transparent PNG images and need to synthesize a large transparent PNG image, the coordinate position and size of each image are clear.
You can use GDIPLUS to create a PNG image with the size of the composite image. Then just draw each PNG image into it.
Then save it as a PNG image and load it with the AlphaImg control.
You can also put 10 PNG images in a resource file, load the memory into a large PNG image, and display it with AlphaImg without writing to the hard disk.
I downloaded this project. It represents transparent PNG on another form that is transparent. It is EXACTLY what I made before. And it works on my Win7 (not only Win8) perfectly.
YOU ARE RIGHT.
I tested my old version with blending of 2 transparent forms.
It doesn't flicker at all.
And it looks amazing.
The code is some clumsy (I make UserControl with this functionality), but result is the best. I will continue this desicion.
Xiaoyao, You saved me from a false path, in which I wanted to fit many images into one, and this one would still flicker - much less than subsequent moving, but yet flicker! I didn't know that overlaying of two transparent forms provides smooth motion so much better than all variants inside a form.
Re: How to Render multiple images into one AlphaImage control
WS_EX_LAYERED_Control Group，use only one form?
loadpng("1.png",picture1.hwnd)
loadpng("2.png",picture2.hwnd)
WS_EX_LAYERED for control support win7 ?it's win7 sp2?
WS_EX_LAYERED forms (form1,form2),may be support xp?i don't khnow
In terms of VB's transparent controls, forms and other technologies, my technology is relatively leading on the entire earth, and it took a lot of time.
In fact, multiple transparent WS_EX_LAYERED forms to load PNG images are also a method. The bottom form loads a background image, the transparent form above loads other images (layers), and then you can also load a transparent form (the control is not transparent), and then Control simultaneous movement, prohibit minimization, or move only a window, HOOK mouse window activates the event to prevent switching windows from changing the Z order.
Re: How to Render multiple images into one AlphaImage control
WS_EX_LAYERED_Control Group TEST.zip
This is test version on the base of Your project of two windows.
What an amazing moving!
You can adjust the speed by ScrollBar, and it still does not flickers.
Re: How to Render multiple images into one AlphaImage control
10 transparent PNG images and need to synthesize a large transparent PNG image,
ADD MORE png to one png file
Code:
Private m_GDIplus As NewPngClass
Private Sub Command1_Click()
Dim hImage As Long, hGraphics As Long, tData() As Byte
Call m_GDIplus.NewPng(350, 350, hImage, hGraphics)
Dim Img2 As Long, Width2 As Long, Height2 As Long
Img2 = m_GDIplus.LoadImg(App.Path & "\001PNG_ICQ.png", Width2, Height2)
Call m_GDIplus.DrawImage(hGraphics, Img2, 0, 0, Width2, Height2)
m_GDIplus.DisposeImage Img2
Img2 = m_GDIplus.LoadImg(App.Path & "\002.png", Width2, Height2)
Call m_GDIplus.DrawImage(hGraphics, Img2, 0, 0, Width2, Height2)
m_GDIplus.DisposeImage Img2
m_GDIplus.DisposeGraphics hGraphics
m_GDIplus.ImageToPngByte hImage, tData()
Open App.Path & "\newpng.png" For Binary As #1
Put #1, 1, tData()
Close #1
m_GDIplus.DisposeImage hImage
End Sub
NewPngClass.cls
Code:
Option Explicit
'from:https://www.vbforums.com/showthread.php?853467-Psd-read-layers-save-as-png-show-like-as-layerd-window&highlight=StdPictureEx
Private Declare Function GdipDrawImageRect Lib "gdiplus" (ByVal graphics As Long, ByVal Image As Long, ByVal x As Single, ByVal y As Single, ByVal Width As Single, ByVal Height As Single) As Long
Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32.dll" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal length As Long)
Private Declare Function lstrlenW Lib "kernel32.dll" (ByVal psString As Any) As Long
Private Declare Function GetSysColor Lib "user32.dll" (ByVal nIndex As Long) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)
Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As Any, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdipLoadImageFromFile Lib "GdiPlus.dll" (ByVal mFilename As Long, ByRef mImage As Long) As Long
Private Declare Function GdipDisposeImage Lib "GdiPlus.dll" (ByVal mImage As Long) As Long
Private Declare Function GdipBitmapLockBits Lib "gdiplus" (ByVal gdipBitmap As Long, gdipRect As RECTL, ByVal gdipFlags As Long, ByVal iPixelFormat As Long, lockedBitmapData As BitmapData) As Long
Private Declare Function GdipBitmapUnlockBits Lib "gdiplus" (ByVal gdipBitmap As Long, lockedBitmapData As BitmapData) As Long
Private Declare Function GdipCreateBitmapFromScan0 Lib "GdiPlus.dll" (ByVal Width As Long, ByVal Height As Long, ByVal stride As Long, ByVal PixelFormat As Long, scan0 As Any, BITMAP As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "GdiPlus.dll" (ByVal mGraphics As Long) As Long
Private Declare Function GdipCreateFromHDC Lib "GdiPlus.dll" (ByVal hDC As Long, hGraphics As Long) As Long
Private Declare Function GdipGetImageGraphicsContext Lib "GdiPlus.dll" (ByVal pImage As Long, ByRef graphics As Long) As Long
Private Declare Function GdipGetImageEncodersSize Lib "GdiPlus.dll" (numEncoders As Long, Size As Long) As Long
Private Declare Function GdipGetImageEncoders Lib "GdiPlus.dll" (ByVal numEncoders As Long, ByVal Size As Long, Encoders As Any) As Long
Private Declare Function GdipSaveImageToStream Lib "GdiPlus.dll" (ByVal Image As Long, ByVal Stream As IUnknown, clsidEncoder As Any, encoderParams As Any) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function CreateStreamOnHGlobal Lib "ole32.dll" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long
Private Declare Function GetHGlobalFromStream Lib "ole32.dll" (ByVal ppstm As Long, hGlobal As Long) As Long
Private Declare Function GlobalSize Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Type RECTF ' GDI+ rectangle w/Single vartypes
nLeft As Single
nTop As Single
nWidth As Single
nHeight As Single
End Type
Private Type RECTL ' GDI+ rectangle w/Long vartypes
nLeft As Long
nTop As Long
nWidth As Long
nHeight As Long
End Type
Private Enum LockModeConstants
ImageLockModeRead = &H1
ImageLockModeWrite = &H2
ImageLockModeUserInputBuf = &H4
End Enum
Private Type BitmapData ' GDI+ lock/unlock bits structure
Width As Long
Height As Long
stride As Long
PixelFormat As Long
Scan0Ptr As Long
ReservedPtr As Long
End Type
Private Type EncoderParameter ' GDI+ image format encoding structure
GUID(0 To 3) As Long
NumberOfValues As Long
Type As Long
Value As Long
End Type
'-- Encoder Parameters structure
Private Type EncoderParameters
Count As Long
Parameter(0 To 5) As EncoderParameter
End Type
Private Type ImageCodecInfo ' GDI+ codec structure
ClassID(0 To 3) As Long
FormatID(0 To 3) As Long
CodecName As Long
DllName As Long
FormatDescription As Long
FilenameExtension As Long
MimeType As Long
Flags As Long
Version As Long
SigCount As Long
SigSize As Long
SigPattern As Long
SigMask As Long
End Type
Public Enum GDIpColorConstants
Color1bpp = &H30101 'Specifies that the format is 1 bit per pixel, indexed.
Color4bpp = &H30402 'Specifies that the format is 4 bits per pixel, indexed.
Color8bpp = &H30803 'Specifies that the format is 8 bits per pixel, indexed.
Color16bppGrayscale = &H101004 'Specifies that the format is 16 bits per pixel, grayscale.
Color16bpp555 = &H21005 'Specifies that the format is 16 bits per pixel; 5 bits each are used for the red, green, and blue components. The remaining bit is not used.
Color16bpp565 = &H21006 'Specifies that the format is 16 bits per pixel; 5 bits are used for the red component, 6 bits are used for the green component, and 5 bits are used for the blue component.
Color16bpp555Alpha = &H61007 'Specifies that the format is 16 bits per pixel; 1 bit is used for the alpha component, and 5 bits each are used for the red, green, and blue components.
Color24bpp = &H21808 'Specifies that the format is 24 bits per pixel; 8 bits each are used for the red, green, and blue components.
Color32bpp = &H22009 'Specifies that the format is 32 bits per pixel; 8 bits each are used for the red, green, and blue components. The remaining 8 bits are not used.
Color32bppAlpha = &H26200A 'Specifies that the format is 32 bits per pixel; 8 bits each are used for the alpha, red, green, and blue components.
Color32bppAlphaMultiplied = &HE200B 'Specifies that the format is 32 bits per pixel; 8 bits each are used for the alpha, red, green, and blue components. The red, green, and blue components are premultiplied according to the alpha component.
Color48bpp = &H10300C 'Specifies that the format is 48 bits per pixel; 16 bits each are used for the red, green, and blue components.
Color64bppAlpha = &H34400D 'Specifies that the format is 64 bits per pixel; 16 bits each are used for the alpha, red, green, and blue components.
Color64bppAlphaMultiplied = &H1C400E 'Specifies that the format is 64 bits per pixel; 16 bits each are used for the alpha, red, green, and blue components. The red, green, and blue components are premultiplied according to the alpha component.
End Enum
Private Declare Function GdipGetImageWidth Lib "gdiplus" (ByVal Image As Long, Width As Long) As Long
Private Declare Function GdipGetImageHeight Lib "gdiplus" (ByVal Image As Long, Height As Long) As Long
Private m_Token As Long
Private m_Version As Single
Sub GetImgSize(Image As Long, Width As Long, Height As Long)
GdipGetImageWidth Image, Width
GdipGetImageHeight Image, Height
End Sub
Function LoadImg(File1 As String, Optional Width As Long, Optional Height As Long) As Long 'add by xiaoyao
Call GdipLoadImageFromFile(StrPtr(File1), LoadImg)
GetImgSize LoadImg, Width, Height
End Function
Sub NewPng(Width As Long, Height As Long, hImage As Long, hGraphics As Long)
Const UnitPixels As Long = 2
hImage = CreateImageFromScan0(0, 0, Width, Height, Color32bppAlpha)
hGraphics = CreateGraphicsFromHIMAGE(hImage)
End Sub
Private Sub Class_Initialize()
Dim GSI As GdiplusStartupInput
Dim pa As Long, hMod As Long
On Error Resume Next
GSI.GdiplusVersion = 1&
Call GdiplusStartup(m_Token, GSI)
If m_Token Then ' is v1.1 GDI+?
hMod = LoadLibrary("gdiplus.dll") ' test it
If hMod Then
pa = GetProcAddress(hMod, "GdipDrawImageFX") ' if it has this function, then at least GDI+ v1.1
If pa Then m_Version = 1.1!
FreeLibrary hMod
End If
If m_Version = 0! Then m_Version = 1!
Else
m_Token = -1& ' prevent calling this time & time again if failure
End If
End Sub
Private Sub Class_Terminate()
If Not (m_Token = 0 Or m_Token = -1) Then GdiplusShutdown m_Token
m_Token = 0&
End Sub
Private Function pvStreamFromArray(ArrayPtr As Long, ArraySize As Long) As IUnknown
On Error GoTo HandleError
Dim o_hMem As Long
Dim o_lpMem As Long
If ArrayPtr = 0& Then
CreateStreamOnHGlobal 0&, 1&, pvStreamFromArray
ElseIf ArraySize <> 0& Then
o_hMem = GlobalAlloc(&H2&, ArraySize)
If o_hMem <> 0 Then
o_lpMem = GlobalLock(o_hMem)
If o_lpMem <> 0 Then
CopyMemory ByVal o_lpMem, ByVal ArrayPtr, ArraySize
Call GlobalUnlock(o_hMem)
Call CreateStreamOnHGlobal(o_hMem, 1&, pvStreamFromArray)
End If
End If
End If
HandleError:
End Function
Private Function pvStreamToArray(hStream As IUnknown, arrayBytes() As Byte) As Boolean
' Return array of bytes contained in an IUnknown interface (stream)
Dim o_hMem As Long, o_lpMem As Long
Dim o_lngByteCount As Long
If Not hStream Is Nothing Then
If GetHGlobalFromStream(ByVal ObjPtr(hStream), o_hMem) = 0 Then
o_lngByteCount = GlobalSize(o_hMem)
If o_lngByteCount > 0 Then
o_lpMem = GlobalLock(o_hMem)
If o_lpMem <> 0 Then
ReDim arrayBytes(0 To o_lngByteCount - 1)
CopyMemory arrayBytes(0), ByVal o_lpMem, o_lngByteCount
GlobalUnlock o_hMem
pvStreamToArray = True
End If
End If
End If
End If
End Function
Private Function pvGetEncoderClsID(strMimeType As String, ClassID() As Long) As Long
' Routine is a helper function for the various SaveAsxxxx routines
Dim lCount As Long
Dim lSize As Long
Dim lIdx As Long
Dim ICI() As ImageCodecInfo
Dim buffer() As Byte, sMime As String
'-- Get the encoder array size
Call GdipGetImageEncodersSize(lCount, lSize)
If (lSize = 0& Or lCount = 0&) Then Exit Function ' Failed!
'-- Allocate room for the arrays dynamically
ReDim ICI(1 To lCount) As ImageCodecInfo
ReDim buffer(1 To lSize) As Byte
'-- Get the array and string data
Call GdipGetImageEncoders(lCount, lSize, buffer(1))
'-- Copy the class headers
Call CopyMemory(ICI(1), buffer(1), (Len(ICI(1)) * lCount))
lSize = Len(strMimeType)
sMime = String$(lSize, vbNullChar)
'-- Loop through all the codecs
For lIdx = lCount To 1& Step -1&
'-- Must convert the pointer into a usable string
With ICI(lIdx)
If lSize = lstrlenW(ByVal .MimeType) Then
Call CopyMemory(ByVal StrPtr(sMime), ByVal .MimeType, lSize * 2&)
If StrComp(sMime, strMimeType, vbTextCompare) = 0 Then
CopyMemory ClassID(0), .ClassID(0), 16&
Exit For
End If
End If
End With
Next lIdx
pvGetEncoderClsID = lIdx
End Function
Public Function Color_RGBtoARGB(ByVal RGBColor As Long, ByVal Opacity As Long) As Long
' GDI+ color conversion routines. Most GDI+ functions require ARGB format vs standard RGB format
' This routine will return the passed RGBcolor to RGBA format
If (RGBColor And &H80000000) Then RGBColor = GetSysColor(RGBColor And &HFF&)
Color_RGBtoARGB = (RGBColor And &HFF00&) Or (RGBColor And &HFF0000) \ &H10000 Or (RGBColor And &HFF) * &H10000
If Opacity < 128 Then
If Opacity < 0& Then Opacity = 0&
Color_RGBtoARGB = Color_RGBtoARGB Or Opacity * &H1000000
Else
If Opacity > 255& Then Opacity = 255&
Color_RGBtoARGB = Color_RGBtoARGB Or (Opacity - 128&) * &H1000000 Or &H80000000
End If
End Function
Public Function Color_ARGBtoRGB(ByVal ARGBcolor As Long, Optional ByRef Opacity As Long) As Long
' This routine is the opposite of Color_RGBtoARGB
' Returned color is always RGB format, Opacity parameter will contain RGBAcolor opacity (0-255)
If (ARGBcolor And &H80000000) Then
Opacity = (ARGBcolor And Not &H80000000) \ &H1000000 Or &H80
Else
Opacity = (ARGBcolor \ &H1000000)
End If
Color_ARGBtoRGB = (ARGBcolor And &HFF00&) Or (ARGBcolor And &HFF0000) \ &H10000 Or (ARGBcolor And &HFF) * &H10000
End Function
Public Sub DisposeImage(hGDIpImage As Long)
GdipDisposeImage hGDIpImage
End Sub
Public Sub DisposeGraphics(hGDIpGraphics As Long)
GdipDeleteGraphics hGDIpGraphics
End Sub
Public Function CreateGraphicsFromHIMAGE(hGDIpImage As Long) As Long
GdipGetImageGraphicsContext hGDIpImage, CreateGraphicsFromHIMAGE
End Function
Public Function CreateGraphicsFromHDC(hDC As Long) As Long
GdipCreateFromHDC hDC, CreateGraphicsFromHDC
End Function
Public Function CreateImageFromScan0(BitsPointer As Long, BitsScanWidth As Long, _
Width As Long, Height As Long, _
ColorType As GDIpColorConstants) As Long
' returns GDI+ hImage form an array, dib pointer, etc
' only supports 16, 24 & 32 bpp as written here. don't pass anything else
Dim dstBoundsI As RECTL
Dim tBMPsrc As BitmapData
Dim hImage As Long
With tBMPsrc
.Height = Height
.Width = Width
.Scan0Ptr = BitsPointer
.stride = BitsScanWidth
.PixelFormat = ColorType
End With
dstBoundsI.nHeight = Height: dstBoundsI.nWidth = Width
GdipCreateBitmapFromScan0 dstBoundsI.nWidth, dstBoundsI.nHeight, 0&, tBMPsrc.PixelFormat, ByVal 0&, hImage
If hImage = 0& Then Exit Function
If BitsPointer Then
If GdipBitmapLockBits(hImage, dstBoundsI, ImageLockModeWrite Or ImageLockModeUserInputBuf, tBMPsrc.PixelFormat, tBMPsrc) Then
GdipDisposeImage hImage: hImage = 0
Else
GdipBitmapUnlockBits hImage, tBMPsrc
End If
End If
CreateImageFromScan0 = hImage
End Function
Public Function ImageToPngByte(hGDIpImage As Long, arrBytes() As Byte) As Boolean
Dim uEncCLSID(0 To 3) As Long
Dim IIStream As IUnknown
Const MimeType As String = "image/png"
If pvGetEncoderClsID(MimeType, uEncCLSID) <> -1& Then
Set IIStream = pvStreamFromArray(0&, 0&)
If Not IIStream Is Nothing Then
If GdipSaveImageToStream(hGDIpImage, IIStream, uEncCLSID(0), ByVal 0&) = 0& Then
ImageToPngByte = pvStreamToArray(IIStream, arrBytes)
End If
Set IIStream = Nothing
End If
End If
End Function
Public Property Get Version() As Single
Version = m_Version
End Property
Public Property Get Token() As Long
Token = m_Token
End Property
Function DrawImage(ByVal graphics As Long, ByVal Image As Long, ByVal x As Single, ByVal y As Single, ByVal Width As Single, ByVal Height As Single) As Long
DrawImage = GdipDrawImageRect(graphics, Image, x, y, Width, Height)
End Function
Re: How to Render multiple images into one AlphaImage control
Originally Posted by xiaoyao
WS_EX_LAYERED_Control Group，use only one form?
loadpng("1.png",picture1.hwnd)
loadpng("2.png",picture2.hwnd)
WS_EX_LAYERED for control support win7 ?
No! I start your application, and it shows only three BLANK white squares instead of pictures. And only the button "WS_EX_LAYERED form" works.
Such, Win7 is NOT supported for layered CONTROLS, and I can't even see how it works.
That's why I think I will layer FORMS that works on more simple systems.
XP is really rare, but Win7 is very popular yet.
Re: How to Render multiple images into one AlphaImage control
Originally Posted by xiaoyao
10 transparent PNG images and need to synthesize a large transparent PNG image,
ADD MORE png to one png file
[/CODE]
Ooooo! It is really your great work! But in my case with PNG have I to make animation manually? Have I to make several PNGs from one GIF and switch them by Timer?
But I have GIFs, and I think I will not make a shadow or semi-transparense or other effects with them. Can I use GIF animation, or it will flicker more?
I use GIF animations in AlphaImg in transparent form over background form, and it flickers NOT.
PNG is more high-quality, but more complex, especially in case of animation. Isn't it?
Re: How to Render multiple images into one AlphaImage control
Code:
Sub LoadPng(Png1 As String, hWnd As Long)
Bytes = OpenBinFile(Png1)
m_GDIplus.ImageToPngByte hImage, Bytes()
png byte array to show
you can make new function like :
Sub LoadPngFromByteArr(Bytes() as byte, hWnd As Long)
it's the new version ,fix some bug:
AlphaControlBas.bas
Code:
Option Explicit
'version 2021-7-31
Public Type POINTAPI
x As Long
y As Long
End Type
Public Type RectWh
Left As Long
Top As Long
Right As Long
Bottom As Long
Width As Long
Height As Long
End Type
'获取窗口（Form/控件）客户区的坐标系。客户区坐标指定客户区的左上角和右下角，即(0,0)-(ScaleWidth,ScaleHeight)。
Public Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As Rect) As Long
'将客户区坐标系中的点转换为屏幕坐标
Public Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Public Const LWA_COLORKEY = &H1
Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const GWL_EXSTYLE = -20
Private Const WS_EX_LAYERED = &H80000
Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Public Declare Sub InitCommonControls Lib "comctl32.dll" ()
Public Type Rect
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Declare Function GetWindowRect Lib "user32.dll" _
(ByVal hWnd As Long, lpRect As Rect) As Long
Declare Function ReleaseCapture Lib "user32" () As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2
Private Const WIN32_NULL As Long = 0
Private Const WIN32_FALSE As Long = 0
Private Const WIN32_TRUE As Long = Not WIN32_FALSE
Private Declare Function CreateBitmap Lib "gdi32" ( _
ByVal Width As Long, _
ByVal Height As Long, _
ByVal Planes As Long, _
ByVal BitsPerPixel As Long, _
ByRef Bits As Any) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Const LR_DEFAULTCOLOR As Long = 0
Private Declare Function CreateIconFromResourceEx Lib "user32" ( _
ByRef IconBits As Byte, _
ByVal cbIconBits As Long, _
ByVal fIcon As Long, _
ByVal dwVersion As Long, _
ByVal cxDesired As Long, _
ByVal cyDesired As Long, _
ByVal uFlags 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 DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Private Enum DI_FLAGS
DI_MASK = &H1&
DI_IMAGE = &H2&
DI_NORMAL = &H3&
DI_COMPAT = &H4&
DI_DEFAULTSIZE = &H8&
DI_NOMIRROR = &H10&
End Enum
Private Declare Function DrawIconEx Lib "user32" ( _
ByVal hDC As Long, _
ByVal xLeft As Long, _
ByVal yTop As Long, _
ByVal hIcon As Long, _
ByVal cxWidth As Long, _
ByVal cyWidth As Long, _
ByVal istepIfAniCur As Long, _
ByVal hbrFlickerFreeDraw As Long, _
ByVal diFlags As DI_FLAGS) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Type ICONINFO
fIcon As Long 'API TRUE for icon, API FALSE for cursor.
xHotspot As Long 'The hotspot X-coordinate for cursor.
yHotspot As Long 'The hotspot Y-coordinate for cursor.
hbmMask As Long 'HBITMAP handle to monochrome AND mask bitmap.
hbmColor As Long 'HBITMAP handle to device dependent XOR mask bitmap.
End Type
Private Declare Function GetIconInfo Lib "user32" ( _
ByVal hIcon As Long, _
ByRef ICONINFO As ICONINFO) As Long
Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectW" ( _
ByVal hObject As Long, _
ByVal nCount As Long, _
ByRef Obj As Any) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongW" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function ReleaseDC Lib "user32" ( _
ByVal hWnd As Long, _
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 SetWindowLong Lib "user32" Alias "SetWindowLongW" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Type POINT
x As Long
y As Long
End Type
Private Type SIZE
cx As Long
cy As Long
End Type
Private Const AC_SRC_OVER As Byte = 0
Private Const AC_SRC_ALPHA As Byte = 1
Private Type BLENDFUNCTION
BlendOp As Byte 'Always AC_SRC_OVER.
BlendFlags As Byte 'Always 0.
SourceConstantAlpha As Byte 'We'll set this value upon use.
AlphaFormat As Byte 'Always AC_SRC_ALPHA.
End Type
Private Enum ULW_FLAGS
ULW_COLORKEY = &H1&
ULW_ALPHA = &H2&
ULW_OPAQUE = &H4&
ULW_EX_NORESIZE = &H8&
End Enum
Private Declare Function UpdateLayeredWindow Lib "user32" ( _
ByVal hWnd As Long, _
ByVal hdcDst As Long, _
ByRef ptDst As Any, _
ByRef sizeNew As Any, _
ByVal hdcSrc As Long, _
ByRef ptSrc As Any, _
ByVal crKey As Long, _
ByRef blend As BLENDFUNCTION, _
ByVal dwFlags As ULW_FLAGS) As Long
'For dragging:
Private GrabX As Single
Private GrabY As Single
Private Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Function GetClientArea(Hwnd1 As Long) As RectWh
'获取客户区矩形
Dim RectWh As RectWh, ClientWH As Rect, ClientXY As POINTAPI
'客户区宽高Rect(Right,Bottom)，ClientXY=客户区左右角坐标
GetClientRect Hwnd1, ClientWH
ClientToScreen Hwnd1, ClientXY
'转换数据
GetClientArea.Left = ClientXY.x
GetClientArea.Top = ClientXY.y
GetClientArea.Right = ClientXY.x + ClientWH.Right
GetClientArea.Bottom = ClientXY.y + ClientWH.Bottom
GetClientArea.Width = ClientWH.Right
GetClientArea.Height = ClientWH.Bottom
End Function
Sub LoadPng(Png1 As String, hWnd As Long)
Dim Bytes() As Byte
Dim hIcon As Long
Dim ICONINFO As ICONINFO
Dim BITMAP As BITMAP
Dim sizeNew As SIZE
Dim ptDst As POINT
Dim ptSrc As POINT '0, 0
Dim BLENDFUNCTION As BLENDFUNCTION
Dim hdcScreen As Long
Dim hdcMem As Long
Dim hbm As Long
Bytes = OpenBinFile(Png1)
hIcon = CreateIconFromResourceEx(Bytes(0), UBound(Bytes) + 1, WIN32_TRUE, &H30000, 0, 0, LR_DEFAULTCOLOR)
Erase Bytes
GetIconInfo hIcon, ICONINFO
GetObject ICONINFO.hbmColor, LenB(BITMAP), BITMAP
With BITMAP
sizeNew.cx = .bmWidth
sizeNew.cy = .bmHeight
End With
Dim ParentHwnd As Long
ParentHwnd = GetParent(hWnd)
Dim Rect1 As RectWh
Rect1 = GetClientArea(ParentHwnd)
Dim Rect2 As Rect
GetWindowRect hWnd, Rect2
MoveWindow hWnd, Rect2.Left - Rect1.Left, Rect2.Top - Rect1.Top, sizeNew.cx, sizeNew.cy, 0
hdcScreen = GetDC(WIN32_NULL)
hdcMem = CreateCompatibleDC(hdcScreen)
With sizeNew
hbm = CreateBitmap(.cx, .cy, 1, 32, ByVal WIN32_NULL)
SelectObject hdcMem, hbm
DrawIconEx hdcMem, 0, 0, hIcon, .cx, .cy, 0, WIN32_NULL, DI_NORMAL
End With
DestroyIcon hIcon
SetWindowLong hWnd, GWL_EXSTYLE, GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED
With ptDst 'HERE NEED CHANGE CODE !!!!!!
.x = Rect2.Left - Rect1.Left
.y = Rect2.Top - Rect1.Top
End With
With BLENDFUNCTION
.BlendOp = AC_SRC_OVER
.SourceConstantAlpha = 255
.AlphaFormat = AC_SRC_ALPHA
End With
UpdateLayeredWindow hWnd, hdcScreen, ptDst, sizeNew, hdcMem, ptSrc, 0, BLENDFUNCTION, ULW_ALPHA
ReleaseDC WIN32_NULL, hdcScreen
DeleteDC hdcMem 'Releases hbm.
DeleteObject hbm
End Sub
Function OpenBinFile(filename As String, Optional ErrInfo As String) As Byte()
'[mycode_id:1903],edittime:2011/7/11 13:27:34
On Error Resume Next
Dim hFile As Integer
hFile = FreeFile
Open filename For Binary As #hFile
ReDim OpenBinFile(LOF(hFile) - 1)
Get #hFile, , OpenBinFile
Close #hFile
End Function
Function SetAlphaColor(hWnd As Long, Optional AlphaColor As Long = vbBlue) As Long
Dim rtn As Long
rtn = GetWindowLong(hWnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hWnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hWnd, AlphaColor, 0, LWA_COLORKEY
SetLayeredWindowAttributes hWnd, AlphaColor, 100, LWA_COLORKEY
SetAlphaColor = rtn
End Function
Re: How to Render multiple images into one AlphaImage control
Originally Posted by Svetlana
Ooooo! It is really your great work! But in my case with PNG have I to make animation manually? Have I to make several PNGs from one GIF and switch them by Timer?
But I have GIFs, and I think I will not make a shadow or semi-transparense or other effects with them. Can I use GIF animation, or it will flicker more?
I use GIF animations in AlphaImg in transparent form over background form, and it flickers NOT.
PNG is more high-quality, but more complex, especially in case of animation. Isn't it?
if AlphaImg can show gif,and you did'nt need back image,AlphaImg maybe best
Re: How to Render multiple images into one AlphaImage control
why you use Frame control?
like my sample,you can move more AlphaImage by vb6 code,like a group
or you can make a transparent frame border picture by photoshop,
it you make a easy game for full screen,WS_EX_LAYERED forms with png file,it's nice for win7
Create a full-screen background form, and then display multiple forms with other PNG images in a layered manner. The position can also be dragged at will. The main thing is to deal with the form and do not let it become the focus after clicking.
You can also synthesize multiple pictures into a single transparent picture in real time. If each picture needs to be moved or clicked, you need to identify which picture you clicked on, a certain coordinate, and if the upper layer is completely transparent, find the opaque layer in turn.
Last edited by xiaoyao; Jul 31st, 2021 at 10:30 AM.
form is transparent. I used green, you can use any other background color of your images that will become transparent. And then I can load regular .gif, .bmp with the appropriate background using:
Code:
frmSplash.Picture = LoadPicture ("File Name")
the desired images in the desired order.
frmSplash can be moved around the entire monitor screen with:
Re: How to Render multiple images into one AlphaImage control
This is a good way to change a color in the form to a transparent color. Then add multiple BMP pictures to the form, as long as its background color is the same color, it will be transparent.
Re: How to Render multiple images into one AlphaImage control
If you want to move 10 controls, you can write a simple code, such as using all the control names, the control array.
Picture1 (0-10)
Picture2 (0-10)
As long as Picture1(0) is moved, the corresponding other controls Picture1(1-10) also move as a whole. As long as Picture2(0) is moved, the corresponding other controls Picture2(1-10) also move as a whole.
It’s too simple. Didn’t I write an example?
No need to use Frame control at all
Code:
Dim xx, yy
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
DoMouseDown Button, X, Y
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
DoMove Button, X, Y
End Sub
Private Sub Command2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
DoMouseDown Button, X, Y
End Sub
Private Sub Command2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
DoMove Button, X, Y
End Sub
Sub DoMouseDown(Button As Integer, X As Single, Y As Single)
If Button = 1 Then
xx = X
yy = Y
End If
End Sub
Sub DoMove(Button As Integer, X As Single, Y As Single)
If Button = 1 Then
Picture1.Left = Picture1.Left + X - xx
Picture1.Top = Picture1.Top + Y - yy
Command2.Left = Command2.Left + X - xx
Command2.Top = Command2.Top + Y - yy
End If
End Sub
Dim xx2, yy2
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
DoMouseDown2 Button, X, Y
End Sub
Private Sub Picture2b_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
DoMove2 Button, X, Y
End Sub
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
DoMouseDown2 Button, X, Y
End Sub
Private Sub Picture2b_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
DoMove Button2, X, Y
End Sub
Sub DoMouseDown2(Button As Integer, X As Single, Y As Single)
If Button = 1 Then
xx2 = X
yy2 = Y
End If
End Sub
Sub DoMove(Button As Integer, X As Single, Y As Single)
If Button = 1 Then
Picture2.Left = Picture1.Left + X - xx2
Picture2.Top = Picture1.Top + Y - yy2
Picture2b.Left = Command2.Left + X - xx2
Picture2b.Top = Command2.Top + Y - yy2
End If
End Sub
Last edited by xiaoyao; Aug 2nd, 2021 at 03:52 AM.
Re: How to Render multiple images into one AlphaImage control
Originally Posted by xiaoyao
Then add multiple BMP pictures to the form, as long as its background color is the same color, it will be transparent.
Yes. It's good for writing simple cartoons. If you use:
Project -> Reference -> Microsoft Speech Object Library
then at the time of the function call:
Code:
Voice.Speak "Hello! My name is Merlin.", SVSFlagsAsync
frmSplash loses transparency and the background turns black. After the text message is cleared, the frmSplash background becomes transparent again. If you use a function:
Code:
Public Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" _
(ByVal lpszName As String, ByVal hModule As Long, _
ByVal dwFlags As Long) As Long
.....
PlaySound "0016.wav", 0 &, (SND_ASYNC Or SND_PURGE)
Re: How to Render multiple images into one AlphaImage control
Xiaoyao, in your project "Move array controls together" there is code:
Code:
For Each Pic In ControlArr
Pic.Left = Pic.Left + X - xx
Pic.Top = Pic.Top + Y - yy
Next
So, if we have 20 small pictures that are visible and about 100 out of screen, this Sub() makes 120 operations and 20 real picture movings.
But placing all these images on a Frame colored green (which is transparent as well as the form) allows this Sub() to have 1 operation to move them all.
If moving is gradual (through Sleep), I think that 1 operation per moving cycle is better then 20 or 120.
In your example "Move control array together" I would place each group into individual frame and write such:
Code:
Private Sub Picture1_MouseMove(...)
DoMove Picture1, Button, X, Y
End Sub
Private Sub Picture2_MouseMove(...)
DoMove Picture2, Button, X, Y
End Sub
.................
Sub DoMove (Group as Object, Button, X, Y):
With Group.Parent 'that is their Frame
.Move .Left + X - xx, .Top + Y - yy
End With
End Sub
And if we have not 3 empty images but 30 colorful ones, I think my variant will be more smooth.
And if the Form is not full-screen but have dimensions, Frame will show the fragment of images, unlike moving whole transparent Form.
Last edited by Svetlana; Aug 3rd, 2021 at 04:13 PM.
Reply With Quote
Originally Posted by Svetlana
