Okay, jetzt habe ich in meinem Archive noch was gefunden und angepasst.....
Als Start ganz gut geeignet ....
Code: Alles auswählen
; Written by Axolotl
;
EnableExplicit
Procedure WndFly_PerformCallbackProc(hWnd, uMsg, wParam, lParam)
Select uMsg
Case #WM_NCDESTROY
Debug "WM_NCDESTROY "
RemoveProp_(hWnd, "Gadget")
Case #WM_ACTIVATE
; user clicked outside the window / listbox
;
If wParam = #WA_INACTIVE : Debug "WM_ACTIVATE, WA_INACTIVE, hide the fly window now "
ShowWindow_(hWnd, #SW_HIDE) ; use handle instead
;; HideWindow(#WND_FlyOver, 1)
EndIf
Case #WM_CHAR : Debug "WM_CHAR '" + wParam + "'"
Case #WM_KEYDOWN ; : Debug "WM_KEYDOWN "
Select wParam
Case #VK_ESCAPE : Debug "WM_KEYDOWN ESCAPE "
Case #VK_RETURN : Debug "WM_KEYDOWN RETUEN "
EndSelect
Case #WM_COMMAND
Select ((wParam >> 16) & $FFFF)
Case #EN_CHANGE
; ?? editor changed
Case #LBN_SELCANCEL : Debug "WM_COMMAND, LBN_SELCANCEL, "
; ?? listbox selection ??
Debug " State == " + GetGadgetState(GetProp_(hwnd, "Gadget"))
SendMessage_(hwnd, #WM_CLOSE, 0, 0)
EndSelect
; If ((wParam >> 16) & $FFFF) = #LBN_SELCANCEL
; Debug "WM_COMMAND, LBN_SELCANCEL, ?? "
; EndIf
; Default
;Debug "Default -> uMsg = " + uMsg
EndSelect
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
; ---
Procedure WndFly_Create(Window, Width=200, Height=200)
Protected oldGadgetList
Protected ii, wnd, gdt
wnd = OpenWindow(Window, 0, 0, Width, Height, "", #PB_Window_Invisible | #PB_Window_BorderLess)
If wnd
If Window = #PB_Any
Window = wnd ; now Window is a correct number
wnd = WindowID(Window) ; and wnd is the handle
EndIf
StickyWindow(Window, 1) ; because main window is also sticky
oldGadgetList = UseGadgetList(wnd) ; Create GadgetList and store old GadgetList
gdt = ListIconGadget(#PB_Any, 0, 0, Width, Height, "", Width-24, #PB_ListIcon_CheckBoxes|#LVS_NOCOLUMNHEADER)
If gdt ; valid gadget number
For ii = 1 To 4
AddGadgetItem(gdt, -1, "Item "+Str(ii))
Next ii
SetProp_(wnd, "Gadget", gdt)
SetWindowCallback(@WndFly_PerformCallbackProc(), Window)
UseGadgetList(oldGadgetList) ; return to previous GadgetList
ProcedureReturn #True
Else
; strange error .....
CloseWindow(Window)
EndIf
EndIf
ProcedureReturn #False
EndProcedure
; ---
Procedure WndFly_ShowForGadget(Window, TargetGadget)
Protected gdt, x, y, w
If IsWindow(Window)
gdt = GetProp_(WindowID(Window), "Gadget")
; get pos and width of TargetGadget to place the window below .....
x = GadgetX(TargetGadget, #PB_Gadget_ScreenCoordinate)
y = GadgetY(TargetGadget, #PB_Gadget_ScreenCoordinate) + GadgetHeight(TargetGadget)
w = GadgetWidth(TargetGadget)
; adjust the window size ???
ResizeWindow(Window, x, y, w, #PB_Ignore) ; pos and width of the window
ResizeGadget(gdt, #PB_Ignore, #PB_Ignore, w, #PB_Ignore) ; adjust the gadget width to the window width
SetGadgetItemAttribute(gdt, #PB_Ignore, #PB_ListIcon_ColumnWidth, w-24, 0) ; adjust the gadget width to the window width
HideWindow(Window, 0) ; show now
SetActiveGadget(gdt)
ProcedureReturn #True
EndIf
ProcedureReturn #False
EndProcedure
; ---
If OpenWindow(0, 0, 0, 300, 80, "Test ", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ButtonGadget(0, 0, 20, 200, 20, "Click")
TextGadget(1, 0, 0, 200, 20, "Click here on the Button below .... ")
WndFly_Create(1, 400, 200)
; WndFly_Fill(0, Items$())
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Break
Case #PB_Event_Gadget
Select EventGadget()
Case 0
WndFly_ShowForGadget(1, 0)
EndSelect
EndSelect
ForEver
EndIf
