VB5 Alpha Shadow Creator (96K)
VB6 Alpha Shadow Creator (89K)
16 Apr 2004
First Posted
Subclassing Without The Crashes
Softening, Blurring, Sharpening and Embossing images
vbAccelerator - Contents of code file: frmAlphaShadow.frm
VERSION 5.00
Begin VB.Form frmAlphaShadow
Caption = "vbAccelerator - Programmatic Shadow Creator"
ClientHeight = 6840
ClientLeft = 3045
ClientTop = 2550
ClientWidth = 8685
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmAlphaShadow.frx":0000
LinkTopic = "Form1"
ScaleHeight = 6840
ScaleWidth = 8685
Begin VB.PictureBox picTools
Align = 4 'Align Right
BorderStyle = 0 'None
Height = 6840
Left = 5430
ScaleHeight = 6840
ScaleWidth = 3255
TabIndex = 2
Top = 0
Width = 3255
Begin VB.CommandButton cmdLoad
Caption = "&Open..."
Height = 435
Left = 1140
TabIndex = 15
Top = 1200
Width = 1215
End
Begin VB.CheckBox chkAuto
Caption = "&Auto"
Height = 195
Left = 1200
TabIndex = 14
Top = 780
Value = 1 'Checked
Width = 675
End
Begin VB.HScrollBar hscScale
Height = 255
LargeChange = 2
Left = 1200
Max = 6
TabIndex = 13
Top = 360
Value = 2
Width = 1995
End
Begin VB.PictureBox picTransparent
BackColor = &H00FFFFFF&
Height = 315
Left = 1920
ScaleHeight = 255
ScaleWidth = 855
TabIndex = 12
Top = 720
Width = 915
End
Begin VB.CommandButton cmdBackColour
Caption = "..."
Enabled = 0 'False
Height = 315
Left = 2880
TabIndex = 11
Top = 720
Width = 315
End
Begin VB.CommandButton cmdPickSaveBackColor
Caption = "..."
Height = 315
Left = 2880
TabIndex = 10
Top = 3960
Width = 315
End
Begin VB.PictureBox picSaveBackColor
BackColor = &H00808080&
Height = 315
Left = 1200
ScaleHeight = 255
ScaleWidth = 1575
TabIndex = 9
Top = 3960
Width = 1635
End
Begin VB.CommandButton cmdCreate
Caption = "&Create"
Height = 435
Left = 1140
TabIndex = 8
Top = 4440
Width = 1215
End
Begin VB.CheckBox chkSizeResult
Caption = "&Size Result to Hold Shadow"
Height = 255
Left = 0
TabIndex = 7
Top = 2340
Value = 1 'Checked
Width = 3075
End
Begin VB.HScrollBar hscOffsetX
Height = 255
LargeChange = 2
Left = 1200
Max = 32
TabIndex = 6
Top = 2700
Value = 20
Width = 1995
End
Begin VB.HScrollBar hscOffsetY
Height = 255
LargeChange = 2
Left = 1200
Max = 32
TabIndex = 5
Top = 3000
Value = 20
Width = 1995
End
Begin VB.HScrollBar hscBlur
Height = 255
LargeChange = 2
Left = 1200
Max = 5
Min = 1
TabIndex = 4
Top = 3300
Value = 2
Width = 1995
End
Begin VB.HScrollBar hscOpacity
Height = 255
LargeChange = 32
Left = 1200
Max = 255
SmallChange = 8
TabIndex = 3
Top = 3600
Value = 128
Width = 1995
End
Begin VB.Label lblResult
BackColor = &H80000010&
Caption = " Result:"
ForeColor = &H80000016&
Height = 255
Left = 0
TabIndex = 24
Top = 1980
Width = 3195
End
Begin VB.Label lblSource
BackColor = &H80000010&
Caption = " Source:"
ForeColor = &H80000016&
Height = 255
Left = 0
TabIndex = 23
Top = 60
Width = 3195
End
Begin VB.Label lblScale
Caption = "&Scale:"
Height = 255
Left = 0
TabIndex = 22
Top = 360
Width = 1035
End
Begin VB.Label lblBackColour
Caption = "&Transparent Colour"
Height = 375
Left = 0
TabIndex = 21
Top = 720
Width = 1035
End
Begin VB.Label lblShadowColour
Caption = "&Shadow Colour:"
Height = 255
Left = 0
TabIndex = 20
Top = 4020
Width = 1155
End
Begin VB.Label lblOffsetX
Caption = "&Offset X:"
Height = 195
Left = 0
TabIndex = 19
Top = 2700
Width = 1035
End
Begin VB.Label lblOffsetY
Caption = "&Offset Y:"
Height = 195
Left = 0
TabIndex = 18
Top = 3000
Width = 1035
End
Begin VB.Label lblMatrixSize
Caption = "&Blur:"
Height = 195
Left = 0
TabIndex = 17
Top = 3300
Width = 1035
End
Begin VB.Label lblOpacity
Caption = "&Opacity:"
Height = 195
Left = 0
TabIndex = 16
Top = 3600
Width = 1035
End
End
Begin AlphaShadow.dibViewPort dibViewResult
Height = 3555
Left = 60
TabIndex = 1
Top = 2940
Width = 3435
_ExtentX = 6059
_ExtentY = 6271
BackgroundStyle = 1
PictureAlign = 1
End
Begin AlphaShadow.dibViewPort dibViewSource
Height = 2775
Left = 60
TabIndex = 0
Top = 60
Width = 3435
_ExtentX = 6059
_ExtentY = 4895
BackgroundStyle = 1
PictureAlign = 1
End
End
Attribute VB_Name = "frmAlphaShadow"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_cShadowCreator As cDIBShadowCreator
Private Sub chkAuto_Click()
cmdBackColour.Enabled = (chkAuto.value = vbUnchecked)
End Sub
Private Sub chkSizeResult_Click()
m_cShadowCreator.ResizeToHoldShadow = (chkSizeResult.value = vbChecked)
End Sub
Private Sub cmdBackColour_Click()
Dim cD As New cCommonDialog
Dim lColor As Long
lColor = picTransparent.BackColor
If (cD.VBChooseColor(lColor, FullOpen:=True, Owner:=Me.hwnd)) Then
m_cShadowCreator.TransparentColor = lColor
picTransparent.BackColor = lColor
Set dibViewSource.DibSection = m_cShadowCreator.ScaledSourceDib
End If
End Sub
Private Sub cmdCreate_Click()
m_cShadowCreator.CreateShadow
Set dibViewResult.DibSection = m_cShadowCreator.DibResult
End Sub
Private Sub cmdLoad_Click()
Dim cD As New cCommonDialog
Dim sFile As String
If (cD.VBGetOpenFileName(sFile, _
Filter:="Graphics Files (*.BMP;*.GIF;*.JPG)|*.BMP;*.GIF;*.JPG|Bitmap
Files (*.BMP)|*.BMP|GIF Files (*.GIF)|GIF|JPEG Files (*.JPG)|*.JPG|All
Files (*.*)|*.*", _
DefaultExt:="BMP", _
Owner:=Me.hwnd)) Then
Dim sPic As StdPicture
Set sPic = LoadPicture(sFile)
Dim cSource As New cAlphaDibSection
cSource.CreateFromPicture sPic
m_cShadowCreator.DibSource = cSource
Set dibViewSource.DibSection = m_cShadowCreator.ScaledSourceDib
picTransparent.BackColor = m_cShadowCreator.TransparentColor
End If
End Sub
Private Sub cmdPickSaveBackColor_Click()
Dim cD As New cCommonDialog
Dim lColor As Long
lColor = picSaveBackColor.BackColor
If (cD.VBChooseColor(lColor, FullOpen:=True, Owner:=Me.hwnd)) Then
m_cShadowCreator.ShadowColor = lColor
picSaveBackColor.BackColor = m_cShadowCreator.ShadowColor
End If
End Sub
Private Sub Form_Load()
Set m_cShadowCreator = New cDIBShadowCreator
hscScale_Change
hscOffsetX_Change
hscOffsetY_Change
hscOpacity_Change
hscBlur_Change
End Sub
Private Sub Form_Resize()
On Error Resume Next
Dim lWidth As Long
Dim lHeight As Long
lWidth = Me.ScaleWidth - dibViewSource.left * 2 - picTools.Width
lHeight = (Me.ScaleHeight - dibViewSource.top * 3) \ 2
dibViewSource.Move dibViewSource.left, dibViewSource.top, lWidth, lHeight
dibViewResult.Move dibViewSource.left, dibViewSource.top * 2 + lHeight,
lWidth, lHeight
End Sub
Private Sub hscBlur_Change()
Dim lV As Long
lV = (hscBlur.value + 1) * 2
lblMatrixSize.Caption = "&Blur " & lV
m_cShadowCreator.MatrixSize = hscBlur.value
End Sub
Private Sub hscOffsetX_Change()
Dim lV As Long
lV = hscOffsetX.value - 16
lblOffsetX.Caption = "Offset &X " & lV
m_cShadowCreator.OffsetX = lV
End Sub
Private Sub hscOffsetX_Scroll()
hscOffsetX_Change
End Sub
Private Sub hscOffsetY_Change()
Dim lV As Long
lV = hscOffsetY.value - 16
lblOffsetY.Caption = "Offset &Y " & lV
m_cShadowCreator.OffsetY = lV
End Sub
Private Sub hscOffsetY_Scroll()
hscOffsetY_Change
End Sub
Private Sub hscOpacity_Change()
lblOpacity.Caption = "&Opacity " & hscOpacity.value
m_cShadowCreator.Opacity = hscOpacity.value
End Sub
Private Sub hscOpacity_Scroll()
hscOpacity_Change
End Sub
Private Sub hscScale_Change()
'
lblScale.Caption = "&Scale (" & 100 \ 2 ^ hscScale & "%)"
m_cShadowCreator.SourceScale = 2 ^ hscScale
Set dibViewSource.DibSection = m_cShadowCreator.ScaledSourceDib
End Sub
Private Sub hscScale_Scroll()
lblScale.Caption = "&Scale (" & 100 \ 2 ^ hscScale & "%)"
End Sub
