Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
XTGUI.bi
| Uploader: |  ThePuppetMaster |
| Datum/Zeit: | 05.03.2023 12:00:20 |
Dim Shared XTGUI_IMGBG as Any Ptr
Dim Shared XTGUI_IMGBP1 as Any Ptr
Dim Shared XTGUI_IMGBP2 as Any Ptr
Dim Shared XTGUI_IMGBU1 as Any Ptr
Dim Shared XTGUI_IMGBU2 as Any Ptr
Dim Shared XTGUI_W as UInteger
Dim Shared XTGUI_H as UInteger
Dim Shared XTGUI_ColorBackground as UInteger = &H007070CC
Dim Shared XTGUI_ColorText as UInteger = &H00FFFFFF
Dim Shared XTGUI_ColorBorder as UInteger = &H000000FF
Dim Shared XTGUI_ColorSelected as UInteger = &H0070CC70
Dim Shared XTGUI_CallbackScroll as Sub (ByVal V_Callback as Any Ptr, ByVal V_Direction as Integer)
Dim Shared XTGUI_TX as Integer
Dim Shared XTGUI_TY as Integer
Dim Shared XTGUI_TZ as Integer
Dim Shared XTGUI_TB as Integer
Dim Shared XTGUI_TTR as Integer
Dim Shared XTGUI_TTX as Integer
Dim Shared XTGUI_TTY as Integer
Dim Shared XTGUI_TTZ as Integer
Dim Shared XTGUI_TTB as Integer
'------------------------------------------------------------------------------------------------------------------------
Sub XTGUI_Init(V_Width as UInteger, V_Height as UInteger)
If XTGUI_IMGBG <> 0 Then Exit Sub
XTGUI_W = V_Width
XTGUI_H = V_Height
XTGUI_IMGBG = ImageCreate(XTGUI_W, XTGUI_H, 0, 32)
XTGUI_IMGBP1 = ImageCreate(XTGUI_W, XTGUI_H, 0, 32)
XTGUI_IMGBP2 = ImageCreate(XTGUI_W, XTGUI_H, 0, 32)
XTGUI_IMGBU1 = ImageCreate(XTGUI_W, XTGUI_H, 0, 32)
XTGUI_IMGBU2 = ImageCreate(XTGUI_W, XTGUI_H, 0, 32)
Line XTGUI_IMGBG, (0, 0)-(XTGUI_W - 1, XTGUI_H - 1), &HFF000000, BF
Line XTGUI_IMGBP1, (0, 0)-(XTGUI_W - 1, XTGUI_H - 1), &H00000000, BF
Line XTGUI_IMGBP2, (0, 0)-(XTGUI_W - 1, XTGUI_H - 1), &H00000000, BF
Line XTGUI_IMGBU1, (0, 0)-(XTGUI_W - 1, XTGUI_H - 1), &H00000000, BF
Line XTGUI_IMGBU2, (0, 0)-(XTGUI_W - 1, XTGUI_H - 1), &H00000000, BF
End Sub
'------------------------------------------------------------------------------------------------------------------------
Sub XTGUI_Term()
If XTGUI_IMGBG <> 0 Then ImageDestroy(XTGUI_IMGBG): XTGUI_IMGBG = 0
If XTGUI_IMGBP1 <> 0 Then ImageDestroy(XTGUI_IMGBP1): XTGUI_IMGBP1 = 0
If XTGUI_IMGBP2 <> 0 Then ImageDestroy(XTGUI_IMGBP2): XTGUI_IMGBP2 = 0
If XTGUI_IMGBU1 <> 0 Then ImageDestroy(XTGUI_IMGBU1): XTGUI_IMGBU1 = 0
If XTGUI_IMGBU2 <> 0 Then ImageDestroy(XTGUI_IMGBU2): XTGUI_IMGBU2 = 0
End Sub
'------------------------------------------------------------------------------------------------------------------------
Sub XTGUI_Cls(V_Color as UInteger = &HFF000000)
Line XTGUI_IMGBG, (0, 0)-(XTGUI_W - 1, XTGUI_H - 1), V_Color, BF
Line XTGUI_IMGBP1, (0, 0)-(XTGUI_W - 1, XTGUI_H - 1), &H00000000, BF
Line XTGUI_IMGBP2, (0, 0)-(XTGUI_W - 1, XTGUI_H - 1), &H00000000, BF
Line XTGUI_IMGBU1, (0, 0)-(XTGUI_W - 1, XTGUI_H - 1), &H00000000, BF
Line XTGUI_IMGBU2, (0, 0)-(XTGUI_W - 1, XTGUI_H - 1), &H00000000, BF
End Sub
'------------------------------------------------------------------------------------------------------------------------
Function XTGUI_GetDrawBuffer() as Any Ptr
Return XTGUI_IMGBG
End Function
'------------------------------------------------------------------------------------------------------------------------
Sub XTGUI_AddLabel(V_Left as Integer, V_Top as Integer, V_Text as String, V_TextColor as UInteger = XTGUI_ColorText)
Draw String XTGUI_IMGBG, (V_Left + 5, V_Top + 5), V_Text, V_TextColor
End Sub
'------------------------------------------------------------------------------------------------------------------------
Sub XTGUI_AddTextSingleLine(V_Left as Integer, V_Top as Integer, V_Width as UInteger, V_Height as UInteger, V_Text as String, V_CursorPos as Integer, V_Callback as Any Ptr, V_BackColor as UInteger = XTGUI_ColorBackground, V_TextColor as UInteger = XTGUI_ColorText, V_BorderColor as UInteger = XTGUI_ColorBorder, V_SelectColor as UInteger = XTGUI_ColorSelected)
Dim TH as Integer = 12
Line XTGUI_IMGBG, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), V_BackColor, BF
Line XTGUI_IMGBP1, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), ((Cast(UInteger, V_Callback) SHR 0) AND &HFFFFFFFF), BF
Line XTGUI_IMGBP2, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), ((Cast(UInteger, V_Callback) SHR 32) AND &HFFFFFFFF), BF
Draw String XTGUI_IMGBG, (V_Left + 5, V_Top + 5), Left(V_Text, Fix((V_Width - 6) / 8)), V_TextColor
Dim TX as Integer = V_CursorPos * 8
Line XTGUI_IMGBG, (V_Left + 5 + TX - 1, V_Top + 3)-(V_Left + 5 + TX, V_Top + 3 + TH), V_TextColor, BF
Line XTGUI_IMGBG, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), V_BorderColor, B
End Sub
'------------------------------------------------------------------------------------------------------------------------
Sub XTGUI_AddButton(V_Left as Integer, V_Top as Integer, V_Width as UInteger, V_Height as UInteger, V_Text as String, V_Callback as Any Ptr, V_BackColor as UInteger = XTGUI_ColorBackground, V_TextColor as UInteger = XTGUI_ColorText, V_BorderColor as UInteger = XTGUI_ColorBorder)
Line XTGUI_IMGBG, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), V_BackColor, BF
Draw String XTGUI_IMGBG, (V_Left + 5, V_Top + 5), V_Text, V_TextColor
Line XTGUI_IMGBG, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), V_BorderColor, B
Dim TADR1 as ULong = CULng(Cast(UInteger, V_Callback) AND &HFFFFFFFF)
Dim TADR2 as ULong = CULng((Cast(UInteger, V_Callback) SHR 32) AND &HFFFFFFFF)
'Print #1, "ADD: " & TADR1 & " - " & TADR2
Line XTGUI_IMGBP1, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), TADR1, BF
Line XTGUI_IMGBP2, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), TADR2, BF
End Sub
'------------------------------------------------------------------------------------------------------------------------
Sub XTGUI_AddList(V_Left as Integer, V_Top as Integer, V_Width as UInteger, V_Height as UInteger, V_ListText() as String, V_ListC as UInteger, V_ListStart as Integer, V_ListSel as Integer, V_Callback as Any Ptr, V_BackColor as UInteger = XTGUI_ColorBackground, V_TextColor as UInteger = XTGUI_ColorText, V_BorderColor as UInteger = XTGUI_ColorBorder, V_SelectColor as UInteger = XTGUI_ColorSelected)
Dim TH as Integer = 12
Line XTGUI_IMGBG, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), V_BackColor, BF
Line XTGUI_IMGBP1, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), ((Cast(UInteger, V_Callback) SHR 0) AND &HFFFFFFFF), BF
Line XTGUI_IMGBP2, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), ((Cast(UInteger, V_Callback) SHR 32) AND &HFFFFFFFF), BF
If V_ListC > 0 Then
Dim TPosY as UInteger
For X as Integer = 1 to V_ListC
If X < V_ListStart Then Continue For
If X = V_ListSel Then Line XTGUI_IMGBG, (V_Left + 2, V_Top + 2 + TPosY)-(V_Left + V_Width - 2, V_Top + 2 + TPosY + TH), V_SelectColor, BF
Draw String XTGUI_IMGBG, (V_Left + 5, V_Top + 5 + TPosY), Left(V_ListText(X), Fix((V_Width - 6) / 8)), V_TextColor
Line XTGUI_IMGBU1, (V_Left + 1, V_Top + 1 + TPosY)-(V_Left + V_Width - 1, V_Top + 2 + TPosY + TH), ((Cast(UInteger, X) SHR 0) AND &HFFFFFFFF), BF
Line XTGUI_IMGBU2, (V_Left + 1, V_Top + 1 + TPosY)-(V_Left + V_Width - 1, V_Top + 2 + TPosY + TH), ((Cast(UInteger, X) SHR 32) AND &HFFFFFFFF), BF
TPosY += TH
If (TPosY + TH) >= V_Height Then Exit For
Next
End If
Line XTGUI_IMGBG, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), V_BorderColor, B
End Sub
'------------------------------------------------------------------------------------------------------------------------
Sub XTGUI_AddGrid(V_Left as Integer, V_Top as Integer, V_Width as UInteger, V_Height as UInteger, V_WidthName as UInteger, V_ListName() as String, V_ListValue() as String, V_ListC as UInteger, V_ListStart as Integer, V_ListSel as Integer, V_Callback as Any Ptr, V_BackColor as UInteger = XTGUI_ColorBackground, V_TextColor as UInteger = XTGUI_ColorText, V_BorderColor as UInteger = XTGUI_ColorBorder, V_SelectColor as UInteger = XTGUI_ColorSelected)
Dim TH as Integer = 12
Line XTGUI_IMGBG, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), V_BackColor, BF
Line XTGUI_IMGBP1, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), ((Cast(UInteger, V_Callback) SHR 0) AND &HFFFFFFFF), BF
Line XTGUI_IMGBP2, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), ((Cast(UInteger, V_Callback) SHR 32) AND &HFFFFFFFF), BF
If V_ListC > 0 Then
Dim TPosY as UInteger
For X as Integer = 1 to V_ListC
If X < V_ListStart Then Continue For
Draw String XTGUI_IMGBG, (V_Left + 5, V_Top + 5 + TPosY), Left(V_ListName(X), Fix(((V_Width - V_WidthName) - 6) / 8)), V_TextColor
If X = V_ListSel Then Line XTGUI_IMGBG, (V_Left + 2 + V_WidthName, V_Top + 2 + TPosY)-(V_Left + V_Width - 2, V_Top + 2 + TPosY + TH), V_SelectColor, BF
Draw String XTGUI_IMGBG, (V_Left + 5 + V_WidthName, V_Top + 5 + TPosY), Left(V_ListValue(X), Fix((V_Width - 6) / 8)), V_TextColor
Line XTGUI_IMGBU1, (V_Left + 1, V_Top + 1 + TPosY)-(V_Left + V_Width - 1, V_Top + 2 + TPosY + TH), ((Cast(UInteger, X) SHR 0) AND &HFFFFFFFF), BF
Line XTGUI_IMGBU2, (V_Left + 1, V_Top + 1 + TPosY)-(V_Left + V_Width - 1, V_Top + 2 + TPosY + TH), ((Cast(UInteger, X) SHR 32) AND &HFFFFFFFF), BF
TPosY += TH
If (TPosY + TH) >= V_Height Then Exit For
Next
End If
Line XTGUI_IMGBG, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), V_BorderColor, B
End Sub
'------------------------------------------------------------------------------------------------------------------------
Sub XTGUI_AddProgressH(V_Left as Integer, V_Top as Integer, V_Width as UInteger, V_Height as UInteger, V_Max as Integer, V_Value as Integer, V_Text as String, V_Callback as Any Ptr, V_BackColor as UInteger = XTGUI_ColorBorder, V_ValueColor as UInteger = XTGUI_ColorBackground, V_TextColor as UInteger = XTGUI_ColorText, V_BorderColor as UInteger = XTGUI_ColorBorder)
Line XTGUI_IMGBG, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), V_BackColor, BF
Line XTGUI_IMGBG, (V_Left, V_Top)-(V_Left + (V_Width / V_Max * V_Value), V_Top + V_Height), V_ValueColor, BF
Draw String XTGUI_IMGBG, (V_Left + 5, V_Top + 5), V_Text, V_TextColor
Line XTGUI_IMGBG, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), V_BorderColor, B
Line XTGUI_IMGBP1, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), ((Cast(UInteger, V_Callback) SHR 0) AND &HFFFFFFFF), BF
Line XTGUI_IMGBP2, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), ((Cast(UInteger, V_Callback) SHR 32) AND &HFFFFFFFF), BF
Dim TVal as Integer
For X as Integer = 0 to V_Width
TVal = V_Max / V_Width * X
Line XTGUI_IMGBU1, (V_Left + X, V_Top)-(V_Left + X, V_Top + V_Height), ((Cast(UInteger, TVal) SHR 0) AND &HFFFFFFFF), BF
Line XTGUI_IMGBU2, (V_Left + X, V_Top)-(V_Left + X, V_Top + V_Height), ((Cast(UInteger, TVal) SHR 32) AND &HFFFFFFFF), BF
Next
End Sub
'------------------------------------------------------------------------------------------------------------------------
Sub XTGUI_AddProgressV(V_Left as Integer, V_Top as Integer, V_Width as UInteger, V_Height as UInteger, V_Max as Integer, V_Value as Integer, V_Text as String, V_Callback as Any Ptr, V_BackColor as UInteger = XTGUI_ColorBorder, V_ValueColor as UInteger = XTGUI_ColorBackground, V_TextColor as UInteger = XTGUI_ColorText, V_BorderColor as UInteger = XTGUI_ColorBorder)
Line XTGUI_IMGBG, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), V_BackColor, BF
If V_Max > 0 Then
If V_Value > 0 Then
If V_Value <= V_Max Then
Line XTGUI_IMGBG, (V_Left, V_Top)-(V_Left + V_Width, V_Top + (V_Height / V_Max * V_Value)), V_ValueColor, BF
Else: Line XTGUI_IMGBG, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), V_ValueColor, BF
End If
End If
Else: Line XTGUI_IMGBG, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), V_ValueColor, BF
End If
Draw String XTGUI_IMGBG, (V_Left + 5, V_Top + 5), V_Text, V_TextColor
Line XTGUI_IMGBG, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), V_BorderColor, B
Line XTGUI_IMGBP1, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), ((Cast(UInteger, V_Callback) SHR 0) AND &HFFFFFFFF), BF
Line XTGUI_IMGBP2, (V_Left, V_Top)-(V_Left + V_Width, V_Top + V_Height), ((Cast(UInteger, V_Callback) SHR 32) AND &HFFFFFFFF), BF
Dim TVal as Integer
For Y as Integer = 0 to V_Height
TVal = (V_Max / V_Height * Y) + 1
Line XTGUI_IMGBU1, (V_Left, V_Top + Y)-(V_Left + V_Width, V_Top + Y), ((Cast(UInteger, TVal) SHR 0) AND &HFFFFFFFF), BF
Line XTGUI_IMGBU2, (V_Left, V_Top + Y)-(V_Left + V_Width, V_Top + Y), ((Cast(UInteger, TVal) SHR 32) AND &HFFFFFFFF), BF
Next
End Sub
'------------------------------------------------------------------------------------------------------------------------
Sub XTGUI_Draw(V_OffsetX as Integer, V_OffsetY as Integer)
Put (V_OffsetX, V_OffsetY), XTGUI_IMGBG, PSET
End Sub
'------------------------------------------------------------------------------------------------------------------------
Function XTGUI_CheckIO(V_OffsetX as Integer, V_OffsetY as Integer) as Integer
Dim RV as Integer = -1
XTGUI_TX = XTGUI_TTX
XTGUI_TY = XTGUI_TTY
XTGUI_TZ = XTGUI_TTZ
XTGUI_TB = XTGUI_TTB
XTGUI_TTR = GetMouse(XTGUI_TTX, XTGUI_TTY, XTGUI_TTZ, XTGUI_TTB)
If XTGUI_TTR <> 0 Then Return RV
If ((XTGUI_TTX - V_OffsetX) < 0) or ((XTGUI_TTX - V_OffsetX) >= XTGUI_W) Then Return RV
If ((XTGUI_TTY - V_OffsetY) < 0) or ((XTGUI_TTY - V_OffsetY) >= XTGUI_H) Then Return RV
RV = 0
Dim TPitch1 as Long
Dim TPitch2 as Long
Dim TPixData1 as Any Ptr
Dim TPixData2 as Any Ptr
ImageInfo(XTGUI_IMGBP1, , , , TPitch1, TPixData1)
ImageInfo(XTGUI_IMGBP2, , , , TPitch2, TPixData2)
Dim TADR1 as UInteger = CUInt(Cast(ULong Ptr, TPixData1 + (XTGUI_TTY - V_OffsetY) * TPitch1)[(XTGUI_TTX - V_OffsetX)])
Dim TADR2 as UInteger = CUInt(Cast(ULong Ptr, TPixData2 + (XTGUI_TTY - V_OffsetY) * TPitch2)[(XTGUI_TTX - V_OffsetX)]) SHL 32
Dim TXPtr as Any Ptr = Cast(Any Ptr, TADR1 OR TADR2)
Dim TSub as Sub (ByRef R_Return as Integer = 0, ByVal V_Value as Integer) = TXPtr
ImageInfo(XTGUI_IMGBU1, , , , TPitch1, TPixData1)
ImageInfo(XTGUI_IMGBU2, , , , TPitch2, TPixData2)
TADR1 = CUInt(Cast(ULong Ptr, TPixData1 + (XTGUI_TTY - V_OffsetY) * TPitch1)[(XTGUI_TTX - V_OffsetX)])
TADR2 = CUInt(Cast(ULong Ptr, TPixData2 + (XTGUI_TTY - V_OffsetY) * TPitch2)[(XTGUI_TTX - V_OffsetX)]) SHL 32
Dim TVal as Integer = TADR1 OR TADR2
If XTGUI_TB <> XTGUI_TTB Then
If XTGUI_TTB <> 1 Then Return RV
If TSub <> 0 Then TSub(RV, TVal)
ElseIf XTGUI_TTB = 0 Then
If XTGUI_CallbackScroll = 0 Then Return RV
If XTGUI_TZ < XTGUI_TTZ Then
XTGUI_CallbackScroll(TXPtr, -1)
ElseIf XTGUI_TZ > XTGUI_TTZ Then
XTGUI_CallbackScroll(TXPtr, +1)
End If
End If
Return RV
End Function