http://www.purebasic.com
https://www.purebasic.fr/english/
Code: Select all
Procedure FrameGadgetColorProc(hWnd,uMsg,wParam,lParam)
Structure FrameColor
lpPrevFunc.i
clrText.l
bThemeXP.b
EndStructure
*frmex.FrameColor=GetWindowLongPtr_(hWnd,#GWL_USERDATA)
Select uMsg
Case #WM_NCDESTROY
FreeMemory(*frmex)
ProcedureReturn 0
Case #WM_PAINT
activewin=GetActiveWindow()
If activewin<>-1
hdc=BeginPaint_(hWnd,ps.PAINTSTRUCT)
SelectObject_(hdc,SendMessage_(hWnd,#WM_GETFONT,0,0))
text$=GetGadgetText(GetDlgCtrlID_(hWnd))
GetTextExtentPoint32_(hdc,text$,Len(text$),fts.SIZE)
GetClientRect_(hWnd,wrc.RECT)
SetRect_(wrc,wrc\left,(wrc\top+fts\cy)/2,wrc\right,wrc\bottom)
If OSVersion()=>#PB_OS_Windows_XP And IsThemeActive_() And IsAppThemed_() And *frmex\bThemeXP
lpBuffer=AllocateMemory(14)
If lpBuffer
PokeS(lpBuffer,"Button",-1,#PB_Unicode)
hThemeButton=OpenThemeData_(WindowID(activewin),lpBuffer)
If hThemeButton
DrawThemeBackground_(hThemeButton,hdc,4,1,wrc,0)
CloseThemeData_(hThemeButton)
EndIf
FreeMemory(lpBuffer)
EndIf
Else
DrawEdge_(hdc,wrc,#EDGE_ETCHED,#BF_RECT)
EndIf
c=GetSysColor_(#COLOR_3DFACE)
parent=GetParent_(hWnd)
grandparent=GetParent_(parent)
If grandparent
gad=GetDlgCtrlID_(grandparent)
If GadgetType(gad)=#PB_GadgetType_Panel
If StartDrawing(WindowOutput(activewin))
c=Point(GadgetX(gad)+3,GadgetY(gad)+3)
StopDrawing()
EndIf
EndIf
EndIf
SetBkColor_(hdc,c)
SetTextColor_(hdc,*frmex\clrText)
TextOut_(hdc,9,0,text$,Len(text$))
EndPaint_(hWnd,ps)
EndIf
ProcedureReturn 0
EndSelect
ProcedureReturn CallWindowProc_(*frmex\lpPrevFunc,hWnd,uMsg,wParam,lParam)
EndProcedure
Procedure FrameGadgetColor(gad,x,y,w,h,text$,col)
dvi.DLLVERSIONINFO\cbsize=SizeOf(DLLVERSIONINFO)
FrameGadget(gad,x,y,w,h,text$)
*frmex.FrameColor=AllocateMemory(SizeOf(FrameColor))
*frmex\lpPrevFunc=SetWindowLongPtr_(GadgetID(gad),#GWL_WNDPROC,@FrameGadgetColorProc())
*frmex\clrText=col
hInstance=OpenLibrary(#PB_Any,"comctl32.dll")
If hInstance
CallFunction(hInstance,"DllGetVersion",@dvi)
If dvi\dwMajorVersion=6 : *frmex\bThemeXP=#True : EndIf
CloseLibrary(hInstance)
EndIf
SetWindowLongPtr_(GadgetID(gad),#GWL_USERDATA,*frmex)
ProcedureReturn GadgetID(gad)
EndProcedure
OpenWindow(0,200,200,420,150,"Window",#PB_Window_SystemMenu)
PanelGadget(0,10,10,210,130)
AddGadgetItem(0,-1,"Panel")
FrameGadgetColor(1,10,10,180,85,"Blue",#Blue)
CloseGadgetList()
FrameGadgetColor(2,230,23,180,118,"Red",RGB(220,0,0))
Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow
Code: Select all
OpenWindow(0,200,200,420,150,"Window",#PB_Window_SystemMenu)
PanelGadget(0,10,10,210,130)
AddGadgetItem(0,-1,"Panel")
FrameGadget(1,10,10,180,85," Blue ")
txt = TextGadget(#PB_Any,10+8,10,30,20," Blue ")
SetGadgetColor(txt,#PB_Gadget_FrontColor,#Blue)
CloseGadgetList()
FrameGadget(2,230,23,180,118," Red ")
txt = TextGadget(#PB_Any,230+8,23,30,20," Red ")
SetGadgetColor(txt,#PB_Gadget_FrontColor,#Red)
Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow
RASHAD wrote:Too much code for simple task
Hold it -- not so fast this time, Rashad!RASHAD wrote:Too much code for simple task
Thanks Rashad, I'll work on it.RASHAD wrote:Dude just increase the width of the TextGadget ex.from 30 to 50
Code: Select all
OpenWindow(0,200,200,420,150,"Window", #PB_Window_SystemMenu)
If LoadFont(0,"Broadway",12)
SetGadgetFont(#PB_Default, FontID(0))
EndIf
PanelGadget(0,10,10,210,130)
AddGadgetItem(0,-1,"Panel")
FrameGadget(1,10,10,180,85," Blue ")
dummy = TextGadget(#PB_Any,0,0,0,0," Blue ")
w = GadgetWidth(dummy,#PB_Gadget_RequiredSize)
h = GadgetHeight(dummy,#PB_Gadget_RequiredSize)
txt = TextGadget(#PB_Any,10+8,10,w,h," Blue ")
SetGadgetColor(txt,#PB_Gadget_FrontColor,$FF0000)
FreeGadget(dummy)
CloseGadgetList()
FrameGadget(2,230,23,180,118," Red ")
dummy = TextGadget(#PB_Any,0,0,0,0," Red ")
w = GadgetWidth(dummy,#PB_Gadget_RequiredSize)
h = GadgetHeight(dummy,#PB_Gadget_RequiredSize)
txt = TextGadget(#PB_Any,230+8,23,w,h," Red ")
SetGadgetColor(txt,#PB_Gadget_FrontColor,$0000FF)
FreeGadget(dummy)
Repeat : Until WaitWindowEvent()=#PB_Event_CloseWindow