XProfan

Source wurde al 15.07.2007 de el MMJ-Quellcodesammlung (Dietmar Horn) en el Babyklappe en XProfan.Com abgelegt:
Editar: Ein Editar färben
PRFellow-Presentación
Autor: Thomas Hölzer
Ein Control färben, bisher bedingt geeignet para CreateText (Static),
todavía bedingter para einzeiliges Editar(Flackern en el 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 Seleccionar objeto(2) !GDI32,Seleccionar objeto
Def UpdateColors(1) !GDI32,UpdateColors
Declarar crect#,ctxt#
Declarar cname#

Proc PaintControl

    Parámetros h&,bc&,tc&
    Declarar dc&,brush&,t$
    Dim cname#,16
    GetClassName(h&,cname#,16)

    If Equ$(Trim$(String$(cname#,0)),Editar)

        Let bc&=GetSysColor(5)

    EndIf

    Disponer cname#
    Dim crect#,16
    Largo crect#,0=0
    Largo crect#,4=0
    Largo crect#,8=Width(h&)
    Largo crect#,12=Height(h&)
    Let t$=GetText $(h&)
    Dim ctxt#,Add(Len(t$),1)
    String ctxt#,0=t$
    Let dc&=GetDC(h&)
    Seleccionar objeto(dc&,SendMessage(h&,$31,0,0))
    Let brush&=CreateSolidBrush(bc&)
    Seleccionar objeto(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)
    Disponer crect#
    Disponer ctxt#
    w32_DeleteObject(brush&)
    ReleaseDC(h&,dc&)

ENDPROC

Ejemplo
Declarar hText&,htext2&
SetTrueColor 1
Cls GetSyscolor(4)
UseFont ,15,0,0,0,0
SetDialogFont 1
Let htext&=CreateEdit(%hwnd,Borussia Dortmund,10,10,200,20)
Let htext2&=CreateText(%hwnd,Das es una Static,10,50,200,20)
Hauptprogrammschleife

Mientras que 1

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

Wend

'Source wurde al 15.07.2007 de el MMJ-Quellcodesammlung (Dietmar Horn) en el Babyklappe en XProfan.Com abgelegt:
'Editar: Ein Editar färben
'PRFellow-Presentación
'Autor: Thomas Hölzer
'Ein Control färben, bisher bedingt geeignet para CreateText (Static),
'todavía bedingter para einzeiliges Editar(Flackern en 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 Seleccionar objeto(2) "GDI32","SelectObject"
Def UpdateColors(1) "GDI32","UpdateColors"
Declarar crect#,ctxt#
Declarar cname#

Proc PaintControl

    Parámetros h&,bc&,tc&
    Declarar dc&,brush&,t$
    Dim cname#,16
    GetClassName(h&,cname#,16)

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

        Let bc&=GetSysColor(5)

    EndIf

    Disponer cname#
    Dim crect#,16
    Largo crect#,0=0
    Largo crect#,4=0
    Largo crect#,8=Width(h&)
    Largo crect#,12=Height(h&)
    Let t$=GetText $(h&)
    Dim ctxt#,Add(Len(t$),1)
    String ctxt#,0=t$
    Let dc&=GetDC(h&)
    Seleccionar objeto(dc&,SendMessage(h&,$31,0,0))
    Let brush&=CreateSolidBrush(bc&)
    Seleccionar objeto(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)
    Disponer crect#
    Disponer ctxt#
    w32_DeleteObject(brush&)
    ReleaseDC(h&,dc&)

ENDPROC

'Ejemplo
Declarar hText&,htext2&
SetTrueColor 1
Cls GetSyscolor(4)
UseFont "Western",15,0,0,0,0
SetDialogFont 1
Let htext&=CreateEdit(%hwnd,"Borussia Dortmund",10,10,200,20)
Let htext2&=CreateText(%hwnd,"Das es una Static",10,50,200,20)
'Hauptprogrammschleife

Mientras que 1

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

Wend