XProfan

Français

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Editzeile und Static farbig gestalten
Lauffähig ab Profan-Version 5.0
PRFellow-Vorlage
Autor: Thomas Hölzer
Ein Control färben, bisher bedingt geeignet für CreateText (Static),
noch bedingter für einzeiliges Edit(Flackern bei der 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
Declare crect#,ctxt#
Declare cname#

Proc PaintControl

    Parameters h&,bc&,tc&
    Declare dc&,brush&,t$
    Dim cname#,16
    GetClassName(h&,cname#,16)

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

        Let bc&=GetSysColor(5)

    EndIf

    Dispose cname#
    Dim crect#,16
    Long crect#,0=0
    Long crect#,4=0
    Long crect#,8=Width(h&)
    Long crect#,12=Height(h&)
    Let t$=GetText$(h&)
    Dim ctxt#,Add(Len(t$),1)
    String ctxt#,0=t$
    Let dc&=GetDC(h&)
    SelectObject(dc&,SendMessage(h&,$31,0,0))
    Let 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
Declare hText&,htext2&
SetTrueColor 1
Cls GetSyscolor(4)
UseFont Arial,15,0,0,0,0
SetDialogFont 1
Let htext&=CreateEdit(%hwnd,Borussia Dortmund,10,10,200,20)
Let htext2&=CreateText(%hwnd,Das ist ein Static,10,50,200,20)
Hauptprogrammschleife

While 1

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