GFAlphaBlend/Testfrm.frm
VERSION 5.00
Begin VB.Form Testfrm
Caption = "GFAlphaBlend"
ClientHeight = 6135
ClientLeft = 45
ClientTop = 405
ClientWidth = 6975
LinkTopic = "Form2"
ScaleHeight = 6135
ScaleWidth = 6975
StartUpPosition = 3 'Windows‑Standard
Begin VB.CommandButton Command8
Caption = "Colorize"
Height = 735
Left = 6384
TabIndex = 9
Top = 4984
Width = 495
End
Begin VB.CommandButton Command7
Caption = "Border Fade"
Height = 735
Left = 6384
TabIndex = 8
Top = 4200
Width = 495
End
Begin VB.PictureBox Picture2
AutoRedraw = ‑1 'True
Height = 1935
Left = 180
ScaleHeight = 1875
ScaleWidth = 5955
TabIndex = 7
Top = 120
Width = 6015
End
Begin VB.CommandButton Command6
Caption = "Command6"
Height = 735
Left = 6384
TabIndex = 6
Top = 3420
Width = 495
End
Begin VB.CommandButton Command5
Caption = "Command5"
Height = 735
Left = 6384
TabIndex = 5
Top = 2640
Width = 495
End
Begin VB.PictureBox Picture1
Height = 3435
Left = 180
Picture = "Testfrm.frx":0000
ScaleHeight = 3375
ScaleWidth = 5955
TabIndex = 4
Top = 2640
Width = 6015
End
Begin VB.CommandButton Command4
Caption = "Command4"
Height = 315
Left = 5220
TabIndex = 3
Top = 2220
Width = 1635
End
Begin VB.CommandButton Command3
Caption = "Command3"
Height = 315
Left = 180
TabIndex = 2
Top = 2220
Width = 1635
End
Begin VB.CommandButton Command2
Caption = "Command2"
Height = 315
Left = 1860
TabIndex = 1
Top = 2220
Width = 1635
End
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 315
Left = 3540
TabIndex = 0
Top = 2220
Width = 1635
End
End
Attribute VB_Name = "Testfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'(c)2001‑2003 by Louis.
'DEBUG
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Form_Load()
'on error resume next
Dim WindowDC As Long
Dim BlendFactor As Single
'preset
Exit Sub 'DEBUG
'begin
With GFAlphaBlendfrm
Call .GFAlphaBlend_FetchBlendPicture1(.GFAlphaBlend_GetDesktopDC, Me.Left / Screen.TwipsPerPixelX, Me.Top / Screen.TwipsPerPixelY, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY)
Me.Show
Me.Refresh
WindowDC = GFAlphaBlendfrm.GFAlphaBlend_GetWindowDC(Me.hwnd)
Call .GFAlphaBlend_FetchBlendPicture2(WindowDC, 0, 0, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY)
Call .GFAlphaBlend_Blend(.GFAlphaBlend_GetWindowDC(Me.hwnd), 0, 0, 0)
Do
BlendFactor = BlendFactor + 0.1!
Call .GFAlphaBlend_Blend(WindowDC, 0, 0, BlendFactor)
DoEvents
Call Sleep(5)
If Not (BlendFactor < 1!) Then Exit Do
Loop
End With
Debug.Print "FINISHED"
End Sub
Private Sub Command1_Click()
'on error resume next
Dim BlendFactor As Single
'preset
With GFAlphaBlendfrm
Call .GFAlphaBlend_LoadBlendPicture1("c:\system\�gypten.bmp")
Call .GFAlphaBlend_LoadBlendPicture2("c:\system\dreiecke.bmp")
Me.AutoRedraw = True
Do
BlendFactor = BlendFactor + 0.01!
Call .GFAlphaBlend_Blend(Me.hDC, 0, 0, BlendFactor)
Me.Refresh 'important
DoEvents
Call Sleep(25)
If Not (BlendFactor < 1!) Then Exit Do
Loop
End With
End Sub
Private Sub Command2_Click()
'on error resume next
Dim BlendFactor As Single
'preset
With GFAlphaBlendfrm
Call .GFAlphaBlend_LoadBlendPicture1("c:\system\wolken.bmp")
Call .GFAlphaBlend_CreateBlendPicture2(0, 0) 'RGB(255, 255, 255))
Me.AutoRedraw = True
Do
BlendFactor = BlendFactor + 0.25!
Call .GFAlphaBlend_Blend(Me.hDC, 0, 0, 1! ‑ BlendFactor)
Me.Refresh 'important
DoEvents
Call Sleep(5)
If Not (BlendFactor < 1!) Then Exit Do
Loop
End With
End Sub
Private Sub Command3_Click()
'on error resume next
With GFAlphaBlendfrm
Call .GFAlphaBlend_FetchBlendPicture1(.GFAlphaBlend_GetWindowDC(Me.hwnd), 0, 0, Me.Width / Screen.TwipsPerPixelX, Me.Height / Screen.TwipsPerPixelY)
Call .GFAlphaBlend_LoadBlendPicture2("C:\SYSTEM\wolken.bmp")
Call .GFAlphaBlend_Fade(.GFAlphaBlend_GetWindowDC(Me.hwnd), Me, 0, 0, 15, 2000)
End With
End Sub
Private Sub Command4_Click()
'on error resume next
Picture1.ScaleMode = vbPixels
Call GFAlphaBlendfrm.GFAlphaBlend_AdjustBrightness(Picture1.hDC, Picture1.ScaleWidth, Picture1.ScaleHeight, 0.95!)
End Sub
Private Sub Command5_Click()
'on error resume next
Picture1.ScaleMode = vbPixels
Call GFAlphaBlendfrm.GFAlphaBlend_AdjustColor(Picture1.hDC, Picture1.ScaleWidth, Picture1.ScaleHeight, 0.8!, 0.8!, 1.2!)
Debug.Print Time$
End Sub
Private Sub Command6_Click()
'on error resume next
Dim X As Long
Dim Y As Long
Dim XD As Long
Dim YD As Long
'
'NOTE: the code of this sub should create an effect like a sphere
'rolling over the image of Picture1, but the code is too slow and buggy
'so that the target project should not use it.
'
'preset
Picture1.AutoRedraw = True
XD = 5
YD = 5
'begin
With GFAlphaBlendfrm
'preset
.GFABPicture1.ScaleMode = vbPixels
'begin
Call GFAlphaBlendfrm.GFAlphaBlend_FetchBlendPicture1(Picture1.hDC, 0, 0, Picture1.ScaleWidth / Screen.TwipsPerPixelX, Picture1.ScaleHeight / Screen.TwipsPerPixelY)
'NOTE: the whole image of Picture1 is now in GFABPicture1.
Call GFAlphaBlendfrm.GFAlphaBlend_Sphere_Dissolve(.GFABPicture1.hDC, .GFABPicture1.ScaleWidth, .GFABPicture1.ScaleHeight, 50)
'NOTE: X and Y of TranslationStructArray(X, Y) go from 1 to SphereRadius * 2.
Do
X = X + XD
Y = Y + YD
If X > 120 Then XD = ‑5
If X < 0 Then XD = 5
If Y > 100 Then YD = ‑5
If Y < 0 Then YD = 5
Call GFAlphaBlendfrm.GFAlphaBlend_Sphere_Create(Picture1.hDC, X, Y)
Picture1.Refresh 'important
Loop
End With
End Sub
Private Sub Command7_Click()
'on error resume next
'preset
Picture1.ScaleMode = vbPixels
'begin
Call GFAlphaBlendfrm.GFAlphaBlend_BorderFade(Picture1.hDC, Picture1.ScaleWidth, Picture1.ScaleHeight, 50, 50, RGB(255, 255, 0))
End Sub
Private Sub Command8_Click()
'on error resume next
Picture1.ScaleMode = vbPixels
Call GFAlphaBlendfrm.GFAlphaBlend_Colorize(Picture1.hDC, Picture1.ScaleWidth, Picture1.ScaleHeight, RGB(0, 255, 0))
End Sub
[END OF FILE]