Embossed3D




'Declare these constants in a .BAS module


' Label and Shape Styles

Global Const GFM_STANDARD = 0
Global Const GFM_RAISED = 1
Global Const GFM_SUNKEN = 2

' Control Shadow Styles

Global Const GFM_BACKSHADOW = 1
Global Const GFM_DROPSHADOW = 2

' Color constants

Global Const BOX_WHITE& = &HFFFFFF
Global Const BOX_LIGHTGRAY& = &HC0C0C0
Global Const BOX_DARKGRAY& = &H808080
Global Const BOX_BLACK& = &H0&

'Here is the Embossed routine:


Static Sub FormLabelCaptionEmbossed (L1 As Label, L2 As Label, L3 As Label,
label_text As String, label_effect As Integer, label_forecolor As Long,
label_depth As Integer)

'Create an embossed effect using ordinary label controls

'on a form. Create 3 labels and place them on the form.

'The first label will be the "real" label.

'The second and third labels provide the embossed effect.

'Set all labels "BackStyle" property set to 0


'It's easiest to create a control array,

'and use Label1(0) as the real label,

'and Label1(1) and Label1(2) as the shadow labels.


' Parameters Type Comment

' L1 Label the "real" label

' L2 Label a shadow label

' L3 Label a shadow label

' label_text string if = "", the caption from L1 will be used

' label_effect integer GFM_RAISED or GFM_SUNKEN

' label_forecolor long color of top label

' label_depth integer offset depth for effect '1 is usually good

'


' *** For the best effect the forms backcolor should be set

' to Light Grey. ***


Dim lt As String
Dim savesm As Integer
Dim f As Form
Set f = L1.Parent

L1.Visible = False
L2.Visible = False
L3.Visible = False

savesm = f.ScaleMode
f.ScaleMode = 3 'pixels

If label_text = "" Then
lt = L1
Else
lt = label_text
End If

L1 = lt
L2 = lt
L3 = lt

L1.BackStyle = 0 'transparent
L1.ForeColor = label_forecolor

L2.Width = L1.Width
L2.Height = L1.Height
L2.BackStyle = L1.BackStyle
'Replaced this constant

L2.ForeColor = BOX_DARKGRAY&

L3.Width = L1.Width
L3.Height = L1.Height
L3.BackStyle = L1.BackStyle
'Replaced this constant

L3.ForeColor = BOX_WHITE&

Select Case label_effect
Case GFM_SUNKEN
L2.Left = L1.Left - label_depth
L2.Top = L1.Top - label_depth
L3.Left = L1.Left + label_depth
L3.Top = L1.Top + label_depth
Case GFM_RAISED
L2.Left = L1.Left + label_depth
L2.Top = L1.Top + label_depth
L3.Left = L1.Left - label_depth
L3.Top = L1.Top - label_depth

End Select
f.ScaleMode = savesm

L1.Visible = True
L2.Visible = True
L3.Visible = True
L1.ZOrder

End Sub

' Examples:


'Use existing text in label1(0)

FormLabelCaptionEmbossed label1(0), label1(1), label1(2), "", GFM_RAISED,
QBColor(7), 1

'Set label text in this function

FormLabelCaptionEmbossed label1(0), label1(1), label1(2), "My Label",
GFM_SUNKEN, QBColor(7), 1











( embossed3d.html )- by Paolo Puglisi - Modifica del 17/12/2023