XProfan

Source wurde am 15.07.2007 aus qui MMJ-Quellcodesammlung (Dietmar Horn) dans qui Babyklappe sur XProfan.Com abgelegt:
Éditer: un Éditer färben
PRFellow-Présentation
Autor: Thomas Bois
un Contrôle färben, bisher bedingt approprié pour CreateText (Static),
encore bedingter pour einzeiliges Éditer(Flackern chez qui Texteingabe)
Def GetDC(1) !USER32,GetDC
Def ReleaseDC(2) !USER32,ReleaseDC
Def FillRect(3) !USER32,FillRect
Def GetSysColor(1) !USER32,GetSysColor
Def CreateSolidBrush(1) !GDI32,CreateSolidBrush
Def w32_DeleteObject(1) !GDI32,DeleteObject
Def w32_DrawText(5) !USER32,DrawTextA
Def SetTextColor(2) !GDI32,SetTextColor
Def SetBkColor(2) !GDI32,SetBkColor
Def SetBkMode(2) !GDI32,SetBkMode
Def GetClassName(3) !USER32,GetClassNameA
Def SelectObject(2) !GDI32,SelectObject
Def UpdateColors(1) !GDI32,UpdateColors
Déclarer crect#,ctxt#
Déclarer cname#

Proc PaintControl

    Paramètres h&,bc&,tc&
    Déclarer dc&,brush&,t$
    Faible cname#,16
    GetClassName(h&,cname#,16)

    Si Equ$(Trim$(String$(cname#,0)),Éditer)

        Laisser bc&=GetSysColor(5)

    EndIf

    Dispose cname#
    Faible crect#,16
    Long crect#,0=0
    Long crect#,4=0
    Long crect#,8=Width(h&)
    Long crect#,12=Height(h&)
    Laisser t$=GetText $(h&)
    Faible ctxt#,Ajouter(Len(t $),1)
    String ctxt#,0=t$
    Laisser dc&=GetDC(h&)
    SelectObject(dc&,SendMessage(h&,$31,0,0))
    Laisser brush&=CreateSolidBrush(bc&)
    SelectObject(dc&,brush&)
    SetBKColor(dc&,bc&)
    SetBKMode(dc&,1)
    SetTextColor(dc&,tc&)
    UpdateColors(dc&)
    FillRect(dc&,crect#,brush&)
    w32_DrawText(dc&,ctxt#,Len(t $),crect#,0)
    Dispose crect#
    Dispose ctxt#
    w32_DeleteObject(brush&)
    ReleaseDC(h&,dc&)

ENDPROC

Beispiel
Déclarer hText&,htext2&
SetTrueColor 1
Cls GetSyscolor(4)
UseFont ,15,0,0,0,0
SetDialogFont 1
Laisser htext&=CreateEdit(%hwnd,Borussia Dortmund,10,10,200,20)
Laisser htext2&=CreateText(%hwnd,cela ist un Static,10,50,200,20)
Hauptprogrammschleife

Tandis que 1

    PaintControl htext&,$00FFFF,0
    PaintControl htext2&,RGB(255,0,0),RGB(0,0,255)
    WaitInput

Wend

'Source wurde am 15.07.2007 aus qui MMJ-Quellcodesammlung (Dietmar Horn) dans qui Babyklappe sur XProfan.Com abgelegt:
'Éditer: un Éditer färben
'PRFellow-Présentation
'Autor: Thomas Bois
'un Contrôle färben, bisher bedingt approprié pour CreateText (Static),
'encore bedingter pour einzeiliges Éditer(Flackern chez qui Texteingabe)
 $I profalt.inc
Def GetDC(1) "User32","GetDC"
Def ReleaseDC(2) "User32","ReleaseDC"
Def FillRect(3) "User32","FillRect"
Def GetSysColor(1) "User32","GetSysColor"
Def CreateSolidBrush(1) "GDI32","CreateSolidBrush"
Def w32_DeleteObject(1) "GDI32",«DeleteObject»
Def w32_DrawText(5) "User32","DrawTextA"
Def SetTextColor(2) "GDI32","SetTextColor"
Def SetBkColor(2) "GDI32","SetBkColor"
Def SetBkMode(2) "GDI32","SetBkMode"
Def GetClassName(3) "User32","GetClassNameA"
Def SelectObject(2) "GDI32","SelectObject"
Def UpdateColors(1) "GDI32","UpdateColors"
Déclarer crect#,ctxt#
Déclarer cname#

Proc PaintControl

    Paramètres h&,bc&,tc&
    Déclarer dc&,brush&,t$
    Faible cname#,16
    GetClassName(h&,cname#,16)

    Si Equ$(Trim$(String$(cname#,0)),"Edit")

        Laisser bc&=GetSysColor(5)

    EndIf

    Dispose cname#
    Faible crect#,16
    Long crect#,0=0
    Long crect#,4=0
    Long crect#,8=Width(h&)
    Long crect#,12=Height(h&)
    Laisser t$=GetText $(h&)
    Faible ctxt#,Ajouter(Len(t $),1)
    String ctxt#,0=t$
    Laisser dc&=GetDC(h&)
    SelectObject(dc&,SendMessage(h&,$31,0,0))
    Laisser brush&=CreateSolidBrush(bc&)
    SelectObject(dc&,brush&)
    SetBKColor(dc&,bc&)
    SetBKMode(dc&,1)
    SetTextColor(dc&,tc&)
    UpdateColors(dc&)
    FillRect(dc&,crect#,brush&)
    w32_DrawText(dc&,ctxt#,Len(t $),crect#,0)
    Dispose crect#
    Dispose ctxt#
    w32_DeleteObject(brush&)
    ReleaseDC(h&,dc&)

ENDPROC

'Beispiel
Déclarer hText&,htext2&
SetTrueColor 1
Cls GetSyscolor(4)
UseFont "Western",15,0,0,0,0
SetDialogFont 1
Laisser htext&=CreateEdit(%hwnd,"Borussia Dortmund",10,10,200,20)
Laisser htext2&=CreateText(%hwnd,"Das est un Static",10,50,200,20)
'Hauptprogrammschleife

Tandis que 1

    PaintControl htext&,$00FFFF,0
    PaintControl htext2&,RGB(255,0,0),RGB(0,0,255)
    WaitInput

Wend