Source/ Codesnippets | | | | | KompilierenMarqueSéparationSource 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
|
| | | | |
| | 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 QuelltextOptions du sujet | 5.359 Views |
Themeninformationencet Thema hat 2 participant: |
|