GFSkinEngine/Testfrm.frm
VERSION 5.00
Begin VB.Form Testfrm
BorderStyle = 0 'Kein
Caption = "GFSkinEngine test form"
ClientHeight = 6705
ClientLeft = 105
ClientTop = 105
ClientWidth = 7155
Icon = "Testfrm.frx":0000
LinkTopic = "Form1"
ScaleHeight = 6705
ScaleWidth = 7155
StartUpPosition = 3 'Windows‑Standard
Begin VB.Timer Timer1
Interval = 2000
Left = 5580
Top = 2340
End
Begin VB.CommandButton Command3
Caption = "En‑/Disable Frm"
Height = 315
Left = 5580
TabIndex = 18
Top = 2340
Width = 1455
End
Begin VB.Frame CloseSECommand
Height = 255
Left = 6720
TabIndex = 16
Top = 60
Width = 255
End
Begin VB.Frame MinimizeSECommand
Height = 255
Left = 6300
TabIndex = 15
Top = 60
Width = 255
End
Begin VB.Frame SECommand1
Height = 495
Left = 5580
TabIndex = 14
Top = 6120
Width = 1455
End
Begin VB.Frame SECommand2
Height = 495
Left = 3780
TabIndex = 13
Top = 6120
Width = 1455
End
Begin VB.CommandButton Command2
Caption = "En‑/Disable Cmd"
Height = 315
Left = 5580
TabIndex = 12
Top = 1920
Width = 1455
End
Begin VB.CommandButton Command1
Caption = "Open TestToolsfrm"
Height = 315
Left = 3780
TabIndex = 11
Top = 2340
Width = 1755
End
Begin VB.PictureBox GFTreeViewPicture
Height = 1035
Left = 3780
ScaleHeight = 975
ScaleWidth = 3195
TabIndex = 10
Top = 4980
Width = 3255
End
Begin VB.PictureBox GFListViewPicture
Height = 1035
Left = 60
ScaleHeight = 975
ScaleWidth = 3495
TabIndex = 9
Top = 4980
Width = 3555
End
Begin VB.PictureBox Picture1
Height = 1875
Left = 60
ScaleHeight = 1815
ScaleWidth = 3435
TabIndex = 8
Top = 2880
Width = 3495
End
Begin VB.ListBox List1
Height = 1815
ItemData = "Testfrm.frx":1272
Left = 3780
List = "Testfrm.frx":127F
TabIndex = 7
Top = 2880
Width = 3255
End
Begin VB.TextBox Text1
Height = 285
Left = 3780
TabIndex = 5
Text = "Text1"
Top = 1440
Width = 3255
End
Begin VB.ComboBox Combo1
Height = 315
ItemData = "Testfrm.frx":12D8
Left = 3780
List = "Testfrm.frx":12E8
TabIndex = 4
Text = "Combo1"
Top = 720
Width = 3255
End
Begin VB.CheckBox Check1
Caption = "Check1"
Height = 195
Left = 60
TabIndex = 1
Top = 300
Width = 3555
End
Begin VB.Frame Frame1
Caption = "Frame1"
Height = 2175
Left = 60
TabIndex = 0
Top = 600
Width = 3495
Begin VB.OptionButton Option2
Caption = "Option2"
Height = 195
Left = 180
TabIndex = 3
Top = 660
Width = 3135
End
Begin VB.OptionButton Option1
Caption = "Option1"
Height = 195
Left = 180
TabIndex = 2
Top = 300
Width = 3135
End
End
Begin VB.Label Label2
Caption = "This is Label2"
Height = 195
Left = 3840
TabIndex = 17
Top = 300
Width = 1695
End
Begin VB.Line Line1
X1 = 60
X2 = 7020
Y1 = 4860
Y2 = 4860
End
Begin VB.Label Label1
Caption = "This is Label1"
Height = 195
Left = 3780
TabIndex = 6
Top = 1980
Width = 1695
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, 2002 by Louis. Test form, sample how to use GFSkinEngine.
'ProgramGetMousePos[X, Y]
Private Declare Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long
'ProgramOpenPopUpMenu
Private Declare Function GetMenu Lib "user32.dll" (ByVal hwnd As Long) As Long 'source: VB sample 'CallDlls'
Private Declare Function GetSubMenu Lib "user32.dll" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function TrackPopupMenu Lib "user32.dll" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal nReserved As Long, ByVal hwnd As Long, lpReserved As Any) As Long
'ProgramGetMousePos[X, Y]
Private Type POINTAPI
X As Long
Y As Long
End Type
'ProgramOpenPopUpMenu
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'other
Dim GFListView1 As New GFReportViewcls
Dim GFTreeView1 As New GFTreeViewcls
Private Sub Form_Load()
'on error resume next
Dim FontStructVar As FontStruct
'preset
'
FontStructVar.Name = "Terminal"
FontStructVar.Size = 9
FontStructVar.Underline = False
'
Call GFListView1.Create("", GFListViewPicture.hwnd, 0, 0, GFListViewPicture.ScaleWidth, GFListViewPicture.ScaleHeight, 0, Testfrm, "TEST")
Call GFListView1.SetStyle(LVS_EDITLABELS, True)
Call GFListView1.AddColumn("Column 1", 1000)
Call GFListView1.AddItem("TestItem", 1, 1)
Call GFTreeView1.Create("", GFTreeViewPicture.hwnd, 0, 0, GFTreeViewPicture.ScaleWidth, GFTreeViewPicture.ScaleHeight, TVS_EDITLABELS, Testfrm, "TEST")
Call GFTreeView1.AddItem("TestItem", "TestItem", "")
'begin
Call SE_Initialize(RGB(255, 255, 255), 0, FontStructVar, "", True, "", HKEY_LOCAL_MACHINE, "Software\GFSkinEngine\TestApp\")
Call SEFormSystem_Initialize(False, False, False, False, False, True)
Call SECB_AddCallBackForm(Testfrm)
'
Call SE_RegisterControl("Testfrm_0", Testfrm, SECONTROLTYPE_FORM)
Call SE_RegisterControl("Testfrm_1", Testfrm, SECONTROLTYPE_FORM)
Call SE_RegisterControl("Testfrm_2", Testfrm, SECONTROLTYPE_FORM)
Call SE_RegisterControl("SECommand1", SECommand1, SECONTROLTYPE_SECOMMAND)
Call SE_RegisterControl("SECommand2", SECommand2, SECONTROLTYPE_SECOMMAND)
Call SE_RegisterControl("MinimizeSECommandFixed", MinimizeSECommand, SECONTROLTYPE_SECOMMAND)
Call SE_RegisterControl("CloseSECommandFixed", CloseSECommand, SECONTROLTYPE_SECOMMAND)
Call SE_RegisterControl("MinimizeSECommandMovable", MinimizeSECommand, SECONTROLTYPE_SECOMMAND)
Call SE_RegisterControl("CloseSECommandMovable", CloseSECommand, SECONTROLTYPE_SECOMMAND)
Call SE_RegisterControl("Label1", Label1, SECONTROLTYPE_LABEL)
Call SE_RegisterControl("Label2", Label2, SECONTROLTYPE_LABEL)
Call SE_RegisterControl("Text1", Text1, SECONTROLTYPE_TEXTBOX)
Call SE_RegisterControl("Combo1", Combo1, SECONTROLTYPE_COMBOBOX)
Call SE_RegisterControl("Picture1", Picture1, SECONTROLTYPE_PICTUREBOX)
Call SE_RegisterControl("Check1", Check1, SECONTROLTYPE_CHECKBOX)
Call SE_RegisterControl("Option1", Option1, SECONTROLTYPE_OPTIONBUTTON)
Call SE_RegisterControl("Option2", Option2, SECONTROLTYPE_OPTIONBUTTON)
Call SE_RegisterControl("GFListView1", GFListView1, SECONTROLTYPE_GFLISTVIEW)
Call SE_RegisterControl("GFTreeView1", GFTreeView1, SECONTROLTYPE_GFTREEVIEW)
Call SE_RegisterControl("GFListViewPicture", GFListViewPicture, SECONTROLTYPE_PICTUREBOX)
Call SE_RegisterControl("GFTreeViewPicture", GFTreeViewPicture, SECONTROLTYPE_PICTUREBOX)
Call SE_RegisterControl("Line1", Line1, SECONTROLTYPE_LINE)
Call SE_RegisterControl("List1", List1, SECONTROLTYPE_LISTBOX)
Call SE_RegisterControl("Frame1", Frame1, SECONTROLTYPE_FRAME)
Call SE_RegisterControl("PolyRgn1", Testfrm, SECONTROLTYPE_SEPOLYRGN)
Call SE_RegisterControl("PolyRgn12", Testfrm, SECONTROLTYPE_SEPOLYRGN)
Call SE_RegisterControl("PolyRgn2", Testfrm, SECONTROLTYPE_SEPOLYRGN)
Call SE_RegisterControl("TestToolsfrm", TestToolsfrm, SECONTROLTYPE_FORM)
Call SE_RegisterControl("TestToolsfrm.Label1", TestToolsfrm.Label1, SECONTROLTYPE_LABEL)
'
Call SE_DefineHotKeys
Call Skin_Preload
Call SE_DisplayPalette(‑1, ‑1, True, True) 'display changes
'
End Sub
Private Sub Form_DblClick()
'on error resume next
Call SE_DisplayPalette(1, 2, True, False)
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'on error resume next
If Button = vbRightButton Then
'NOTE: several names may be associated with the object 'Form1'.
Call SE_OpenFormMenu(GetSEControlNameFromControlObject(Testfrm), Testfrm) 'read annotations of the pool system
End If
End Sub
Private Sub Timer1_Timer()
'on error resume next 'no one can press the command anymore
Timer1.Enabled = False
Call Command3_Click
End Sub
Private Sub Command1_Click()
'on error resume next
Call TestToolsfrm.ShowTools
End Sub
Private Sub Command2_Click()
'on error resume next
SECommand2.Enabled = Not SECommand2.Enabled
End Sub
Private Sub Command3_Click()
'on error resume next
Testfrm.Enabled = Not Testfrm.Enabled
If Testfrm.Enabled = False Then
Timer1.Enabled = True
End If
End Sub
Private Sub SECommand1_Click()
'on error resume next
Call SE_DisplayPalette(SE_GetCurrentPaletteNumber, 1, False, False)
End Sub
Private Sub SECommand2_Click()
'on error resume next
Call SE_DisplayPalette(SE_GetCurrentPaletteNumber, 2, False, False)
End Sub
Private Sub MinimizeSECommand_Click()
'on error resume next
Testfrm.WindowState = vbMinimized
End Sub
Private Sub CloseSECommand_Click()
'on error resume next
Unload Me
End Sub
Public Sub SE_ReceiveCallBackMessage(ByVal Msg As Integer, ByVal wParam As String, ByVal lParam As String, ByRef ReturnValueUsedFlag As Boolean, ByRef ReturnValue As Long)
'on error resume next 'callback sub of the GFSkinEngine
Select Case Msg
Case SECBMSG_FORMTITLEBAR_LBUTTONDBLCLK
Select Case SEFormSystem_GetFormState(wParam)
Case vbNormal
Call SEFormSystem_Maximize(wParam)
Case vbMaximized
Call SEFormSystem_Restore(wParam, True, True)
End Select
End Select
End Sub
'***********************************GENERAL FUNCTIONS***********************************
Public Sub ProgramOpenPopUpMenu(ByVal XPos As Long, ByVal YPos As Long, ByVal PopUpMenuIndex As Integer)
On Error Resume Next 'v1.1; always copy general functions out of latest project
Dim MenuHandle As Long
Dim SubMenuHandle As Long
Dim RECTVar As RECT
Dim Temp As Long
'begin
RECTVar.Left = 0
RECTVar.Top = 0
RECTVar.Right = Screen.Width / Screen.TwipsPerPixelX
RECTVar.Bottom = Screen.Height / Screen.TwipsPerPixelY
MenuHandle = GetMenu(Testfrm.hwnd)
SubMenuHandle = GetSubMenu(MenuHandle, (PopUpMenuIndex ‑ 1)) '1 to 0 based
Temp = TrackPopupMenu(SubMenuHandle, 2, XPos, YPos, 0, Testfrm.hwnd, RECTVar)
End Sub
Public Function ProgramGetMousePosX() As Long
On Error Resume Next 'the format is: pixels
Dim ProgramGetMousePosXTemp As Long
Dim CurrentMousePos As POINTAPI
ProgramGetMousePosXTemp = GetCursorPos(CurrentMousePos)
ProgramGetMousePosX = CurrentMousePos.X
End Function
Public Function ProgramGetMousePosY() As Long
On Error Resume Next 'the format is: pixels
Dim ProgramGetMousePosYTemp As Long
Dim CurrentMousePos As POINTAPI
ProgramGetMousePosYTemp = GetCursorPos(CurrentMousePos)
ProgramGetMousePosY = CurrentMousePos.Y
End Function
'***END OF GENERAL FUNCTIONS***
'***OTHER***
Public Sub CC_Click(ByVal CCMCSourceDescription As String, _
ByVal Button As Integer, ByVal X As Single, ByVal Y As Single)
End Sub
Public Sub CC_DblClick(ByVal CCMCSourceDescription As String, _
ByVal Button As Integer, ByVal X As Single, ByVal Y As Single)
End Sub
Public Sub CC_HeaderClick(ByVal CCMCSourceDescription As String, _
ByVal ListViewHeaderIndex As Integer)
End Sub
Public Sub CC_MouseUp(ByVal CCMCSourceDescription As String, _
ByVal Button As Integer, ByVal X As Single, ByVal Y As Single)
End Sub
Public Sub CC_BeginLabelEdit(ByVal CCMCSourceDescription As String, _
ByVal TreeViewItemHandle As Long, ByVal TreeViewItemTextNew As String, ByRef Cancel As Integer)
End Sub
Public Sub CC_EndLabelEdit(ByVal CCMCSourceDescription As String, _
ByVal TreeViewItemHandle As Long, ByVal TreeViewItemTextNew As String, ByRef Cancel As Integer)
End Sub
Public Sub CC_Other(ByVal SourceDescription As String, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef ReturnValue As Long, ByRef ReturnValueUsedFlag As Boolean)
'on error resume next 'receives all messages that have not been processed
'Debug.Print SourceDescription, Msg, wParam, lParam
End Sub
'***END OF OTHER***
Private Sub Form_Unload(Cancel As Integer)
'on error resume next
Call GFSubClass_Terminate
Call SE_Terminate
Call GFSM_Terminate
Call GFKeyHook_Terminate
Call GFListView1.Unload
Call GFTreeView1.Unload
End Sub
[END OF FILE]