Source / code snippets | | | | |
Source watts on the 15.07.2007 from the MMJ-Quellcodesammlung (Dietmar horn) in The Babyklappe on XProfan.Com stored:
Edit: One Edit dye
PRFellow-Presentation
Author: Thomas Hölzer
One Control dye, yet conditioned suitable for CreateText (Static),
yet bedingter for einzeiliges Edit(Flackern with the Text-Input)
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
example
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,the is one Static,10,50,200,20)
Hauptprogrammschleife
While 1
PaintControl htext&,$00FFFF,0
PaintControl htext2&,RGB(255,0,0),RGB(0,0,255)
WaitInput
Wend
|
| | | | |
| | Jörg Sellmeyer | Kommentarzeichen and quotation marks eingefügt and profalt.inc for newer versions eingebunden...
'Source watts on the 15.07.2007 from the MMJ-Quellcodesammlung (Dietmar horn) into Babyklappe on XProfan.com stored:
'Edit: One Edit dye
'PRFellow-Presentation
'Author: Thomas Hölzer
'One Control dye, yet conditioned appropriate to CreateText (Static),
'yet bedingter for einzeiliges Edit(Flackern with the Text-Input)
$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
'example
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 is a Static",10,50,200,20)
'Hauptprogrammschleife
While 1
PaintControl htext&,$00FFFF,0
PaintControl htext2&,RGB(255,0,0),RGB(0,0,255)
WaitInput
Wend
|
| | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 09/15/14 ▲ |
| |
| | RGH | | | | XProfan X2Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD - ATI Radeon HD 4770 512 MB - Windows 7 Home Premium 32Bit - XProfan X4 | 09/15/14 ▲ |
| |
| | Jörg Sellmeyer | | | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 09/15/14 ▲ |
| |
| | | | | | | |
|
Zum QuelltextThemeninformationenthis Topic has 4 subscriber: |