Changing the color of HyperText ( Windows )

[RASHAD]

Based on the request of luis

1- For Windows Vista And Windows 7 only
The changes will be active untill Next change

Code: Select all

Global GetHandle.l ,hKey.l ,lType.l ,lpcbData.l ,lpData.s ,lReturnCode.l ,lhRemoteRegistry.l ,lpDataDWORD.l
   
Procedure.l SetValue(topKey.l, sKeyName.s, sValueName.s, vValue.s, lType.l, ComputerName.s)
  If ComputerName = "" 
    GetHandle = RegOpenKeyEx_(topKey, sKeyName, 0, #KEY_ALL_ACCESS, @hKey) 
  Else 
    lReturnCode = RegConnectRegistry_(ComputerName, topKey, @lhRemoteRegistry) 
    GetHandle = RegOpenKeyEx_(lhRemoteRegistry, sKeyName, 0, #KEY_ALL_ACCESS, @hKey) 
  EndIf 

  If GetHandle = #ERROR_SUCCESS 
    lpcbData = 255 
    lpData = Space(255) 
        GetHandle = RegSetValueEx_(hkey, sValueName, 0, #REG_SZ, @vValue, Len(vValue) + 1)
    RegCloseKey_(hkey) 
    Error = 1 
    ProcedureReturn Error 
  Else 
    MessageRequester("Error", "An Error occured, Return value = " + Str(lRetVal), 0) 
    RegCloseKey_(hKey) 
    Error  = 0 
    ProcedureReturn Error 
  EndIf 
EndProcedure

SetValue(#HKEY_CURRENT_USER , "Control Panel\Colors", "HotTrackingColor","255 255 0", #REG_SZ, "")    ;"255 255 0"  "R G B" values for new color
Result = MessageRequester("Information","Going to LogOff LogOn Proceed?", #PB_MessageRequester_YesNo)
If Result = #PB_MessageRequester_Yes
RunProgram("Shutdown.exe"," -l","",#PB_Program_Hide|#PB_Program_Wait)
EndIf
End

Because the color of the hypertext is hardcoded in Windows XP
Here it is a workaround And it is For ALL OS (XP,Vista,7) And may be more
A challege For ( Sparkie ) To make it automated For all gadgets

Code: Select all

Global HDC,EG,FS.RECT

  #CFM_LINK = $00000020
  #CFE_LINK = $0020
  #CFE_SUBSCRIPT = $00010000
  #CFE_SUPERSCRIPT = $00020000
  #CFM_SUBSCRIPT = #CFE_SUBSCRIPT | #CFE_SUPERSCRIPT
  #CFM_SUPERSCRIPT=#CFM_SUBSCRIPT
  #CFM_BACKCOLOR =$4000000

; original idea from
; http://www.purebasic.fr/english/viewtopic.php?p=28616&sid=05ddd4bf0b054bf1429b544cc39afc73#28616

Procedure Htcolor(tx,ty,Fcolor,Bcolor,Text$)
     UseFont = CreateFont_(15,0,0,0,0,0,#True,0,0,0,0,0,0,"Arial")
      Tnm = Len(Text$)
      HDC=GetDC_(EG)
;       UseFont.LOGFONT 
;       UseName.s = "Arial"+Chr(0)      
;       UseFont\lfFaceName=@FontName.s
;       UseFont\lfUnderline = #True
;       UseFont\lfHeight = 15    
      SetBkMode_(HDC,#OPAQUE)
      SetTextColor_(HDC,Fcolor)
      SetBkColor_(HDC,Bcolor)
;       hFont = CreateFontIndirect_(UseFont) 
      SelectObject_(HDC,UseFont)
      DrawText_(HDC,Text$,Tnm,FS,#DT_NOCLIP|#DT_SINGLELINE)
EndProcedure

Procedure EditorGadgetEx_Cut (hWnd)
SendMessage_(hWnd, #WM_CUT,0,0)   
EndProcedure

Procedure EditorGadgetEx_Copy (hWnd)
SendMessage_(hWnd, #WM_COPY,0,0)   
EndProcedure

Procedure EditorGadgetEx_Insert (hWnd, sNewText.s)
ProcedureReturn SendMessage_(hWnd, #EM_REPLACESEL, 0, @sNewText)
EndProcedure

Procedure EditorGadgetEx_Select (hWnd, iLineStart, iLineEnd, iCharStart, iCharEnd)
; iLineStart range from 0 to CountGadgetItems(#Gadget) - 1
; iLineEnd   set -1 to indicate the last line
; iCharStart range from 1 to the length of a line
; iCharEnd   set to -1 to indicate the end of a line
;
; Selecting from 0, 1 to -1,-1 selects all

Protected tRange.CHARRANGE
 
tRange\cpMin = SendMessage_(hWnd, #EM_LINEINDEX, iLineStart, 0) + iCharStart - 1

If iLineEnd = -1
    iLineEnd = SendMessage_(hWnd, #EM_GETLINECOUNT, 0, 0) - 1
EndIf
 
tRange\cpMax = SendMessage_(hWnd, #EM_LINEINDEX, iLineEnd, 0)

If iCharEnd = -1
    tRange\cpMax + SendMessage_(hWnd, #EM_LINELENGTH, tRange\cpMax, 0)
Else
    tRange\cpMax + iCharEnd - 1
EndIf

SendMessage_(hWnd, #EM_EXSETSEL, 0, @tRange)
EndProcedure

Procedure EditorGadgetEx_BackColor (hWnd, iColor)
Protected tFormat.CHARFORMAT2
tFormat\cbSize = SizeOf(CHARFORMAT2)
tFormat\dwMask = $4000000  ; = #CFM_BACKCOLOR
tFormat\crBackColor = iColor
SendMessage_(hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @tFormat)
EndProcedure

Procedure EditorGadgetEx_ForeColor (hWnd, iColor)
; Set the text color for the selection in RGB format 
Protected tFormat.CHARFORMAT
 
tFormat\cbSize = SizeOf(CHARFORMAT)
tFormat\dwMask = #CFM_COLOR
tFormat\crTextColor = iColor
 
SendMessage_(hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @tFormat)
EndProcedure

Procedure EditorGadgetEx_Font (hWnd, sFontName.s)
; Set font for the Selection
; You must specify a font name, the font doesn't need to be loaded
Protected tFormat.CHARFORMAT

tFormat\cbSize = SizeOf(CHARFORMAT)
tFormat\dwMask = #CFM_FACE

PokeS(@tFormat\szFaceName, sFontName)

SendMessage_(hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @tFormat)
EndProcedure

Procedure EditorGadgetEx_FontSize (hWnd, iFontsize)
; Set font size for the selection in point
Protected tFormat.CHARFORMAT
 
tFormat\cbSize = SizeOf(CHARFORMAT)
tFormat\dwMask = #CFM_SIZE
tFormat\yHeight = iFontSize*20
 
SendMessage_(hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @tFormat)
EndProcedure

Procedure EditorGadgetEx_FontStyle (hWnd, iFlags, flgXOR = 0)
; Set font style of the selection.
; This can be a combination of the following values:

; #CFE_BOLD
; #CFE_ITALIC
; #CFE_UNDERLINE
; #CFE_STRIKEOUT
; #CFE_LINK
; #CFE_SUBSCRIPT
; #CFE_SUPERSCRIPT

Protected tFormat.CHARFORMAT2

tFormat\cbSize = SizeOf(CHARFORMAT2)

If flgXOR
    SendMessage_(hWnd, #EM_GETCHARFORMAT, 1, @tFormat)
    iFlags = tFormat\dwEffects ! iFlags
EndIf

tFormat\dwMask = #CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE|#CFM_LINK|#CFM_SUBSCRIPT|#CFM_SUPERSCRIPT
tFormat\dwEffects = iFlags
 
SendMessage_(hWnd, #EM_SETCHARFORMAT, #SCF_SELECTION, @tFormat)
 
EndProcedure

Procedure EditorGadgetEx_HideSelection (hWnd, flgHide)
SendMessage_(hWnd,#EM_HIDESELECTION,flgHide,0)
EndProcedure


; EXAMPLE

FS.RECT 
FS\left   =89 
FS\top    =13

If OpenWindow(0, 0, 0, 500, 500, "EditorGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

EG = EditorGadget(1, 10, 10, 480, 480) 
    SetGadgetColor(1,   #PB_Gadget_BackColor, #Black)
    SetGadgetColor(1,   #PB_Gadget_FrontColor, #White)
   
    AddGadgetItem(1, 0, "This is a some normal text.")     
    AddGadgetItem(1, 1, "This will contain a LINK. See ? It's blue !")
       
    hEdit = GadgetID(1)
   
    EditorGadgetEx_HideSelection (hEdit, 1)
     
    EditorGadgetEx_Select(hEdit, 1, 1, 21, 25)  ; select "LINK" on line 2       
    EditorGadgetEx_FontStyle(hEdit, #CFE_LINK)  ; this makes the text BLUE
   
    EditorGadgetEx_Select(hEdit, 0, 0, 0, 0)   ; select nothing again
    EditorGadgetEx_HideSelection (hEdit, 0)
   
    Repeat
    Htcolor(FS\left,FS\top,$0AFDFA,$000000,"LINK")   ;Back_Color =  Gadget BackColor   FrontColor = Your choice
    Until WaitWindowEvent() = #PB_Event_CloseWindow

EndIf

have fun

[luis]

Hi RASHAD, thank you for your time !

Please note in your second example you have to define FS.RECT as global or the program crash in htcolor because FC is null (EnableExplicit rulez ! )

So you confirm is really hardcorded in XP eh ? That's what I ended to believe too.

The idea to change some settings in the registry for a need so humble really piss me off, so I will not consider it.

I like more the second approach, I'll try to see if I can encapsulate it and make all the calc of the positions involved automatic. Good idea !

It's really incredible there is no way to set it programmatically with a simple message. What were they thinking ?

Thank you again for your help and suggestions.

[RASHAD]

Hi luis
FS.RECT it was in the globals I deleted by mistake before posting, sorry
Now You will have a hard time to make the snippet applicable
I think one of the big brothers of API staff like Sparkie ,netmaestro ,srod ,Fluid Byte can help just like that

have fun my friend