fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
inc\CreateStaticText.bas

Uploader:	Eternal_Pain
Datum/Zeit:	19.03.2014 04:44:53
Hinweis: Dieser Quelltext ist Bestandteil des Projekts Windows Easy Gui (WEG), zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.
'FontStyles

#Define Regular     &h00

#Define Italic      &h01

#Define Bold        &h02

#Define Underline   &h04

#Define StrikeOut   &h08



Sub Item_StaticText.Destroy()

    ID = "" : Title = ""

    DestroyWindow(whwnd)

    DeleteObject(Font)

    DeleteObject(BckBrush)

    Font   = 0 : BckBrush = 0

    FColor = 0 : BColor   = 0

End SUb



Function CreateStaticText(byref ItemHandle as Item        ,  byval px     as Integer     , byval py        as Integer     , _

                          byval TxT        as String      ,  byval Font   as String  = "", byval FontStyle as UInteger = 0, _

                          byval FontSize   as Integer = 16,  byval FColor as Integer = 0 , byval BColor    as Integer  = TRANSPARENT) as Item



    Dim as UInteger Style   = WS_CHILD OR WS_CLIPSIBLINGS



    If (ItemHandle = 0) orelse (Len(TxT) = 0) Then return NULL



    Dim as RECT    prect

    Dim as HWND    phwnd

    Dim as Integer rx, ry



    If (ItemHandle -> ID = WindowID) Then

        phwnd = ItemHandle -> whwnd

        rx = px : ry = py

    ElseIf (ItemHandle -> ID = GroupBoxID) Then

        phwnd = GetParent(ItemHandle -> whwnd)

        GetClientRect(ItemHandle -> whwnd, @prect)

        MapWindowPoints(ItemHandle -> whwnd, phwnd, Cast(LPPOINT, @prect),2)

        rx = prect.left + px : ry = prect.top + py

    Else

        LOGSTRING(Time & " | ERROR | Parent is not an valid Item.")

        Return NULL

    End If



    Dim as Item_StaticText ptr newStaticText = new Item_StaticText



    newStaticText -> whwnd = CreateWindowEx(NULL, "STATIC", TxT, Style, 0, 0, 0, 0, phwnd, NULL, Globals.hInstance, newStaticText)



    If (newStaticText -> whwnd = 0) Then

        Delete newStaticText

        LOGSTRING(Time & " | ERROR | Failed to create " & StaticTextID)

        MessageBox(NULL,"Failed to create " & StaticTextID, "Error", NULL)

        Return NULL

    End If



    SetWindowLongPtr(newStaticText -> whwnd, GWLP_USERDATA, Cast(LONG_PTR, newStaticText))



    newStaticText -> ID     = StaticTextID

    newStaticText -> Title  = TxT

    newStaticText -> FColor = Convert_RGB_To_BGR(FColor)

    newStaticText -> BColor = TRANSPARENT



    If BColor<>TRANSPARENT Then

        newStaticText -> BColor   = Convert_RGB_To_BGR(BColor)

        newStaticText -> BckBrush = CreateSolidBrush(newStaticText -> BColor)

    End If



    If Font = "" Then Font = WinExtFontName



    Dim as LOGFONT  lf



    With lf

        .lfHeight    = FontSize

        .lfFaceName  = Font

        .lfItalic    = IIF(Bit(FontStyle,0),TRUE,FALSE)

        .lfWeight    = IIF(Bit(FontStyle,1),FW_BOLD,FW_REGULAR)

        .lfUnderline = IIF(Bit(FontStyle,2),TRUE,FALSE)

        .lfStrikeOut = IIF(Bit(FontStyle,3),TRUE,FALSE)

    End With



    newStaticText -> Font = CreateFontIndirect(@lf)



    Dim as HDC      dDC = GetDC(NULL)

    Dim as HDC      fDC = CreateCompatibleDC(dDC)

    Dim as SIZE     fSize



    SelectObject(fDC, newStaticText -> Font)

    GetTextExtentPoint32(fDC, TxT, len(TxT), @fSize)



    ''// extend for overhanging text (italic and bold problems)

    ''// http://www.codeproject.com/Articles/14915/Width-of-text-in-italic-font

    Dim as ABCFLOAT ptr WidthsABC = new ABCFLOAT[256]

    GetCharABCWidthsFloat(fDC, 0, 255, WidthsABC)



    'DeleteObject(newStaticText -> Font)

    DeleteDC(fDC)

    ReleaseDC(NULL,dDC)



    ''// overhang of the last character

    Dim as double dOverhangTrailing = WidthsABC[TxT[Len(TxT)-1]].abcfC



    Delete[] WidthsABC

    If dOverhangTrailing<0 Then fSize.CX -= dOverhangTrailing



    MoveWindow(newStaticText -> whwnd, rx, ry, fSize.CX, fSize.CY, TRUE)

    ShowWindow(newStaticText -> whwnd, SW_SHOW)



    SendMessage(newStaticText -> whwnd, WM_SETFONT, Cast(WPARAM, newStaticText -> Font), Cast(LPARAM, TRUE))



    LOGSTRING(Time & " | INFO  | " & StaticTextID & " " & TxT & " created on " & ItemHandle -> ID & " " & ItemHandle -> Title & ".")



    Globals.ItemList.AddItem(newStaticText)



    return newStaticText

End Function