Update: Gadgets funktionieren auch im Unicode und/oder Threadsafe Mode!
Code: Alles auswählen
; Include zum Erstellen von Gadgets in reinem Basic!
; Autoren: Hallodri und TS-Soft
; Version 1.1 vom 30.04.2006
; Getestet mit PureBasic 4.0 Beta 11
Prototype.l PB_Object_GetOrAllocateID(Objects.l,ID.l)
Prototype.l PB_Gadget_RegisterGadget(ID.l,*Gadget.l,hwnd.l,*GadgetVT.l)
Enumeration
#PB_GadgetType_Unknown
#PB_GadgetType_Button
#PB_GadgetType_String
#PB_GadgetType_Text
#PB_GadgetType_CheckBox
#PB_GadgetType_Option
#PB_GadgetType_ListView
#PB_GadgetType_Frame3D
#PB_GadgetType_ComboBox
#PB_GadgetType_Image
#PB_GadgetType_HyperLink
#PB_GadgetType_Container
#PB_GadgetType_ListIcon
#PB_GadgetType_IPAddress
#PB_GadgetType_ProgressBar
#PB_GadgetType_ScrollBar
#PB_GadgetType_ScrollArea
#PB_GadgetType_TrackBar
#PB_GadgetType_Web
#PB_GadgetType_ButtonImage
#PB_GadgetType_Calendar
#PB_GadgetType_Date
#PB_GadgetType_Editor
#PB_GadgetType_ExplorerList
#PB_GadgetType_ExplorerTree
#PB_GadgetType_ExplorerCombo
#PB_GadgetType_Spin
#PB_GadgetType_Tree
#PB_GadgetType_Panel
#PB_GadgetType_Splitter
#PB_GadgetType_MDI
#PB_GadgetType_Scintilla
#PB_GadgetType_LastEnum
EndEnumeration
CompilerIf Defined(PB_GadgetVT, #PB_Structure) = #False
Structure PB_GadgetVT
GadgetType.l
SizeOf.l
GadgetCallback.l
FreeGadget.l
GetGadgetState.l
SetGadgetState.l
GetGadgetText.l
SetGadgetText.l
AddGadgetItem2.l
AddGadgetItem3.l
RemoveGadgetItem.l
ClearGadgetItemList.l
ResizeGadget.l
CountGadgetItems.l
GetGadgetItemState.l
SetGadgetItemState.l
GetGadgetItemText.l
SetGadgetItemText.l
OpenGadgetList2.l
GadgetX.l
GadgetY.l
GadgetWidth.l
GadgetHeight.l
HideGadget.l
AddGadgetColumn.l
RemoveGadgetColumn.l
GetGadgetAttribute.l
SetGadgetAttribute.l
GetGadgetItemAttribute2.l
SetGadgetItemAttribute2.l
SetGadgetColor.l
GetGadgetColor.l
SetGadgetItemColor2.l
GetGadgetItemColor2.l
SetGadgetItemData.l
GetGadgetItemData.l
EndStructure
CompilerEndIf
CompilerIf Defined(PB_Gadget, #PB_Structure) = #False
Structure PB_Gadget
Gadget.l
*VT.PB_GadgetVT
UserData.l
OldCallback.l
Daten.l[4]
EndStructure
CompilerEndIf
;GetGadgetParent
;
; Rueckgabe : Parent Handle
;
Procedure GetGadgetParent()
!EXTRN _PB_Object_GetThreadMemory@4
!EXTRN _PB_Gadget_Globals
!MOV Eax,[_PB_Gadget_Globals]
!push eax
!call _PB_Object_GetThreadMemory@4
!MOV Eax,[Eax]
ProcedureReturn
CreateGadgetList(0)
EndProcedure
Structure Gadget_Info
OldCallback.l
DestroyProc.l
PBID.l
EndStructure
Procedure RegGadget_Callback(hwnd, msg, wparam, lparam)
Protected *Gadget_Info.Gadget_Info = GetProp_(hwnd, "GadgetInfo")
Protected OldProc = *Gadget_Info\OldCallback
If msg = #WM_NCDESTROY
If *Gadget_Info
If *Gadget_Info\DestroyProc
CallFunctionFast(*Gadget_Info\DestroyProc, *Gadget_Info\pbid)
EndIf
EndIf
RemoveProp_(hwnd, "GadgetInfo")
FreeMemory(*Gadget_Info)
EndIf
ProcedureReturn CallWindowProc_(OldProc, hwnd, msg, wparam, lparam)
EndProcedure
;RegisterGadget
; hwnd.l ; Handle des Controls
; ID.l ; PB_ID
; DestroyProc.l=0 ; OPTIONAL Proc zum aufraeumen
; *vt.PB_GadgetVT = 0 ; OPTIONAL Gadget VT
;
; Rueckgabe : wenn ID = -1 / PB_Any = PB_ID
; snst Handle des Controls
Procedure RegisterGadget(hwnd.l, ID.l, DestroyProc.l = 0, *vttemp.PB_GadgetVT = 0)
Protected PB_Object_GetOrAllocateID.PB_Object_GetOrAllocateID
Protected PB_Gadget_RegisterGadget.PB_Gadget_RegisterGadget
Protected PB_Gadget_Objects.l
Protected *Gadget.PB_Gadget, *Gadget_Info.Gadget_Info
Protected OldCallback.l
Protected *vt.PB_GadgetVT
If ((hwnd = 0) Or (id < #PB_Any))
ProcedureReturn 0
EndIf
*vt = AllocateMemory(SizeOf(PB_GadgetVT))
If *vttemp <> 0
CopyMemory(*vttemp,*vt,SizeOf(PB_GadgetVT))
EndIf
CompilerIf #PB_Compiler_Unicode
!EXTRN _PB_Gadget_RegisterGadget_UNICODE@16
!MOV [p.v_PB_Gadget_RegisterGadget] ,dword _PB_Gadget_RegisterGadget_UNICODE@16
CompilerElse
!EXTRN _PB_Gadget_RegisterGadget@16
!MOV [p.v_PB_Gadget_RegisterGadget] ,dword _PB_Gadget_RegisterGadget@16
CompilerEndIf
!EXTRN _PB_Object_GetOrAllocateID@8
!EXTRN _PB_Gadget_Objects
!MOV [p.v_PB_Object_GetOrAllocateID],dword _PB_Object_GetOrAllocateID@8
!MOV eax,[_PB_Gadget_Objects]
!MOV [p.v_PB_Gadget_Objects],eax
*Gadget = PB_Object_GetOrAllocateID(PB_Gadget_Objects, ID)
hwnd = PB_Gadget_RegisterGadget(ID, *Gadget,hwnd,*vt)
If DestroyProc
*Gadget_Info = AllocateMemory(SizeOf(Gadget_Info))
*Gadget_Info\DestroyProc = DestroyProc
*Gadget_Info\OldCallback = SetWindowLong_(*Gadget\Gadget, #GWL_WNDPROC, @RegGadget_Callback())
If id = #PB_Any
*Gadget_Info\PBID = hwnd
Else
*Gadget_Info\PBID = ID
EndIf
SetProp_(*Gadget\Gadget, "GadgetInfo", *Gadget_Info)
EndIf
ProcedureReturn hwnd
EndProcedure
; CreateGadget
; Id.l ; Gadget, kann auch #PB_Any sein!
; ClassName.s ; Windows-Klassenname (muss Windows bekannt sein)
; Text.s ; ggf. Text/Überschrift
; Style.l ; Stil
; X.l, Y.l ; linke, obere Ecke des Gadgets auf dem Fenster
; DX.l, DY.l ; Größe des Gadgets
; Optional:
; ExStyle.l ; erweiterter Stil
; DestroyProc.l ; Procedure-Adresse, einer Procedure zum Aufräumen
; *vt.PB_GadgetVT ; Pointer zu einer gefüllten Structurevariable mit GadgetFunktionen!
;
; Rückgabe: hWnd oder ID (bei #PB_Any)
Procedure CreateGadget(Id.l, ClassName.s, Text.s, Style.l, X.l, Y.l, DX.l, DY.l, ExStyle.l = 0, DestroyProc.l = 0, *vt.PB_GadgetVT = 0)
Protected hwnd.l
Protected Parent.l = GetGadgetParent()
Protected hInstance.l = GetModuleHandle_(0)
hwnd = CreateWindowEx_(ExStyle, ClassName, Text, Style, X, Y, DX, DY, Parent, 0, hInstance, 0)
SendMessage_(hWnd, #WM_SETFONT, GetGadgetFont(#PB_Default), 1);
If hwnd = #False : ProcedureReturn #False : EndIf
ProcedureReturn RegisterGadget(hwnd, ID, DestroyProc, *vt)
EndProcedure
Code: Alles auswählen
; Testprogramm für CreateGadget ;)
XIncludeFile "CreateGadget.pbi"
If LoadLibrary_("Scintilla.dll") = #False : MessageRequester("", "Scintilla.dll nicht gefunden") : End : EndIf
Procedure MySciEdit(Gadget, x, y, width, height)
ProcedureReturn CreateGadget(Gadget, "Scintilla", "", #WS_CHILD | #WS_VISIBLE, x, y, width, height, #WS_EX_CLIENTEDGE)
EndProcedure
Procedure MyStatic(Gadget, x, y, width, height, Text.s)
ProcedureReturn CreateGadget(Gadget, "Static", Text, #WS_CHILD|#WS_VISIBLE|#SS_CENTER|#SS_SUNKEN, x, y, width, height)
EndProcedure
Procedure MyButton(Gadget, x, y, width, height, Text.s)
ProcedureReturn CreateGadget(Gadget, "Button", Text, #WS_CHILD | #WS_VISIBLE, x, y, width, height)
EndProcedure
If OpenWindow(0, #PB_Ignore, 0, 250, 480, "Test")
CreateGadgetList(WindowID(0))
MySciEdit(0, 0, 0, 250, 400)
MyButton(1, 10, 440, 50, 25, "Button 1")
GadgetToolTip(1, "Button 1")
MyButton(2, 70, 440, 50, 25, "Button 2")
GadgetToolTip(2, "Button 2")
btn3 = MyButton(#PB_Any, 130, 440, 50, 25, "Button 3")
GadgetToolTip(btn3, "Button 3")
MyButton(4, 190, 440, 50, 25, "")
GadgetToolTip(4, "Button 4")
MyStatic(5, 10, 410, 50, 20, "Label 1")
MyStatic(6, 70, 410, 50, 20, "Label 2")
MyStatic(7, 130, 410, 50, 20, "Label 3")
MyStatic(8, 190, 410, 50, 20, "Label 4")
SetGadgetText(0, "Feel the ..Pure.. Power")
SetGadgetText(4, "Button 4")
EndIf
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Break
Case #PB_Event_Gadget
Select EventGadget()
Case 1
Debug "Button 1"
If GetGadgetText(1) = "Button 1"
SetGadgetText(1, "PushMe")
Else
SetGadgetText(1, "Button 1")
EndIf
Case 2
Debug "Button 2"
Debug GetGadgetText(0)
Case btn3
Debug "Button 3"
Case 4
Debug "Button 4"
EndSelect
EndSelect
ForEver
Download
Vorschau:
