panelgadget mit einem panel über ganze gadgetbreite
Verfasst: 04.11.2009 13:17
vieleicht kanns ja mal wer brauchen oder zumindest ein bischen was raus holen:
Code: Alles auswählen
EnableExplicit
Procedure Form_Size()
Define TabWidth.l
If IsGadget(0) = #False
ProcedureReturn
EndIf
;Gadget der Fenstergröße anpassen
ResizeGadget(0, 10, 10, WindowWidth(0) - 20, WindowHeight(0) - 20)
;Tabbreite über ganze Gadgetbreite
TabWidth = GadgetWidth(0) - 4
If IsThemeActive_()
TabWidth = GadgetWidth(0) - 6
EndIf
SetWindowLongPtr_(GadgetID(0), #GWL_STYLE, GetWindowLongPtr_(GadgetID(0), #GWL_STYLE)|#TCS_FIXEDWIDTH)
SendMessage_(GadgetID(0), #TCM_SETITEMSIZE, 0, TabWidth)
EndProcedure
Procedure Form_DrawItem (wParam.l, lParam.l)
Define *ItemInfo.DRAWITEMSTRUCT
Define rcClip.RECT
Define hTheme.l
Define ItemText.s
;Wenn kein Theme aktiv, nix tun
If IsThemeActive_() = #False
ProcedureReturn
EndIf
;Konstanten für DrawTheme
#TABP_TABITEMLEFTEDGE = 2
#TABP_PANE = 9 ;TABP = TabParts
#TIS_SELECTED = 3 ;TIS = TabItemState
;Für DrawTheme vorbereiten
*ItemInfo = lParam
hTheme = OpenThemeData_(WindowID(0), @"Tab")
;Itemtext wieder herstellen
ItemText = GetGadgetItemText(*ItemInfo\CtlID, 0, 0)
SetBkMode_(*ItemInfo\hdc, #TRANSPARENT)
DrawText_(*ItemInfo\hdc, ItemText, Len(ItemText), *ItemInfo\rcItem, #DT_CENTER | #DT_SINGLELINE | #DT_VCENTER | #DT_NOCLIP)
;Ein Pixel am linken Rand korrigieren
rcClip\left = *ItemInfo\rcItem\left
rcClip\top = *ItemInfo\rcItem\bottom - 1
rcClip\right = *ItemInfo\rcItem\left + 1
rcClip\bottom = *ItemInfo\rcItem\bottom
DrawThemeBackground_(hTheme, *ItemInfo\hDC, #TABP_TABITEMLEFTEDGE, #TIS_SELECTED, *ItemInfo\rcItem, @rcClip)
;Rect wegen rechten Schatten vergrößern
*ItemInfo\rcItem\right + 2
;Rect wegen unterem Schattenauslauf vergrößern
*ItemInfo\rcItem\bottom + 4
;Rechten Rand korrigieren und Schatten von Grundkörper übernehmen
rcClip\left = *ItemInfo\rcItem\right - 3
rcClip\top = *ItemInfo\rcItem\top + 3
rcClip\right = *ItemInfo\rcItem\right
rcClip\bottom = *ItemInfo\rcItem\bottom - 4
DrawThemeBackground_(hTheme, *ItemInfo\hDC, #TABP_PANE, 0, *ItemInfo\rcItem, @rcClip)
;Themedata schließen
CloseThemeData_(hTheme)
EndProcedure
Procedure Callback_Windows(hWnd.l, msg.l, wParam.l, lParam.l)
Select msg
Case #WM_SIZE : Form_Size()
Case #WM_DRAWITEM : Form_DrawItem(wParam, lParam)
EndSelect
ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure
OpenWindow(0, 0, 0, 200, 300, "PanelGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget)
PanelGadget (0, #PB_Ignore, #PB_Ignore, #PB_Ignore, #PB_Ignore)
AddGadgetItem (0, -1, "Test")
CloseGadgetList()
;Tab soll durch Benutzer gezeichnet werden
SetWindowLong_(GadgetID(0), #GWL_STYLE, GetWindowLong_(GadgetID(0), #GWL_STYLE) | #TCS_OWNERDRAWFIXED)
;Windows Callbackfunktion benutzen
SetWindowCallback(@Callback_Windows())
;Gadgets zeichnen
Form_Size()
Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow