Français
Source/ Codesnippets

un Färben Static Text

 

KompilierenMarqueSéparation
Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Text: Ein Static mit Text färben
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 ,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)
    WaitInp
Wend
 
15.07.2007  
 




Jörg
Sellmeyer
Kommentarzeichen et Anführungszeichen eingefügt et profalt.inc pour neuere Versionen eingebunden...
KompilierenMarqueSéparation
'Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
'Text: Ein Static mit Text färben
'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)
 $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"
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 "Western",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&,$0000FF,0
    PaintControl htext2&,RGB(255,0,0),RGB(0,0,255)
    WaitIn
> Wend
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
15.09.2014  
 



Zum Quelltext


Topictitle, max. 100 marque.
 

Systemprofile:

ne...aucune Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

s'il te plaît s'inscrire um une Beitrag trop verfassen.
 

Options du sujet

5.359 Views

Untitledvor 0 min.
H.Brill09.05.2023
Normann Strübli08.02.2023
p.specht20.11.2021
Uwe Lang20.11.2021
plus...

Themeninformationen

cet Thema hat 2 participant:

Jörg Sellmeyer (1x)
unbekannt (1x)


Admins  |  AGB  |  Applications  |  Auteurs  |  Chat  |  protection des données  |  Télécharger  |  Entrance  |  Aider  |  Merchantportal  |  Empreinte  |  Mart  |  Interfaces  |  SDK  |  Services  |  Jeux  |  cherche  |  Support

un projet aller XProfaner, qui il y a!


Mon XProfan
Privé Nouvelles
Eigenes Ablageforum
Sujets-La liste de voeux
Eigene Posts
Eigene Sujets
Zwischenablage
Annuler
 Deutsch English Français Español Italia
Traductions

protection des données


Wir verwenden Cookies seulement comme Session-Cookies à cause de qui technischen Notwendigkeit et chez uns gibt es aucun Cookies de Drittanbietern.

si du ici sur unsere Webseite klickst ou bien navigierst, stimmst du unserer Erfassung de Informationen dans unseren Cookies sur XProfan.Net trop.

Weitere Informationen trop unseren Cookies et en supplément, comment du qui Kontrolle par-dessus behältst, findest du dans unserer nachfolgenden Datenschutzerklärung.


d'accordDatenschutzerklärung
je voudrais keinen Cookie