Working with color schemes in vfp menus
The COLOR clause
The trick is to use the COLOR clause in the DEFINE PAD, DEFINE POPUP or DEFINE BAR commands. (DEFINE PAD creates the top-level menu title, DEFINE POPUP creates the menu itself, and DEFINE BAR creates an individual menu item.) According to the VFP Help, the COLOR clause includes something called a ColorPairList. Unfortunately, the Help fails to tell you what a ColorPairList looks like or how to code it.
In fact, it's quite easy. A ColorPairList is a comma-separated list of up to ten values. Each value corresponds to a different element of the menu, as indicated in Table 1. Of these ten items, the ones that are most commonly customised are the first, second, and sixth. These determine the colours of disabled items, normal (enabled) items and selected items respectively.
Item in list Meaning
1 Disabled item
2 Enabled item
3 Border
4 Title
5 Message
6 Selected item
7 Hotkey indicator
8 Shadow
9 Enabled control
10 Disabled control
Table 1: The ten items in a ColorPairList
Within the list, you can choose between two methods of coding the various colours. The first method relies on combinations of letters, separated by a forward slash. The letters represent the foreground and background colours respectively. For example, W/G is white on green, while N/RB is black on magenta. Table 2 lists the available colours. The plus sign (as in GR+) indicates a "bright" version of the colour; this is available for the foreground colour only. To produce a bright version of a background colour, add an asterisk.
Colour Code
Black N
Blue B
Brown GR
Cyan BG
Green G
Magenta RB
Red R
White W
Yellow GR+
Table 2: Alphabetic colour codes
Here then is a command to create a menu in which disabled items appear as green on white, normal items as blue on white, and the selected item as "bright" white on brown (if the plus sign was omitted from the last element, the "white" would show up as a medium grey).
DEFINE POPUP Shortcut COLOR G/W*, B/W*,,,,W+/GR && Note the use of commas as place-holders for missing items.
from:http://fox.wikis.com/wc.dll?Wiki~ColorPairConcordance
Click on code to select [then copy] -click outside to deselect
*1* created on tuesday 17 of january 2017.
*color schemes with contextuel menus
Publi yform
yform=Newobject("yColorSchemes")
yform.Show
Read Events
Retu
*
Define Class yColorSchemes As Form
BorderStyle = 0
Height = 250
Width = 783
ShowWindow = 2
AutoCenter = .T.
Caption = "Working with menu color schemes with a live example."
MaxButton = .F.
BackColor = Rgb(212,210,208)
showTips=.t.
x1 = .F.
x2 = .F.
x3 = .F.
x4 = .F.
x5 = .F.
Add Object command1 As CommandButton With ;
Top = 120, ;
Left = 521, ;
Height = 84, ;
Width = 156, ;
FontSize = 14, ;
WordWrap = .T., ;
Caption = "Click/rightClick for Contextuel Menu", ;
MousePointer = 15, ;
ForeColor = Rgb(128,0,64), ;
Name = "Command1"
Add Object combo1 As ComboBox With ;
Height = 37, ;
Left = 24, ;
Top = 24, ;
Width = 169, ;
Name = "Combo1"
Add Object combo2 As ComboBox With ;
Height = 37, ;
Left = 217, ;
Top = 24, ;
Width = 169, ;
Name = "Combo2"
Add Object combo3 As ComboBox With ;
Height = 37, ;
Left = 410, ;
Top = 24, ;
Width = 169, ;
Name = "Combo3"
Add Object text1 As TextBox With ;
FontBold = .T., ;
FontSize = 12, ;
Height = 36, ;
Left = 16, ;
ReadOnly = .T., ;
Top = 144, ;
Width = 493, ;
ForeColor = Rgb(0,0,255), ;
DisabledForeColor = Rgb(0,0,255), ;
tooltiptext="Rightclick to copy to clipboard",;
Name = "Text1"
Add Object combo4 As ComboBox With ;
Height = 37, ;
Left = 598, ;
Top = 24, ;
Width = 169, ;
Name = "Combo4"
Add Object label1 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 10, ;
BackStyle = 0, ;
Caption = "Disabled Item", ;
Height = 18, ;
Left = 56, ;
Top = 0, ;
Width = 89, ;
ForeColor = Rgb(255,0,0), ;
Name = "Label1"
Add Object label2 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 10, ;
BackStyle = 0, ;
Caption = "Enabled Item", ;
Height = 18, ;
Left = 232, ;
Top = 0, ;
Width = 86, ;
ForeColor = Rgb(255,0,0), ;
Name = "Label2"
Add Object label3 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 10, ;
BackStyle = 0, ;
Caption = "Selected Item", ;
Height = 18, ;
Left = 423, ;
Top = 0, ;
Width = 90, ;
ForeColor = Rgb(255,0,0), ;
Name = "Label3"
Add Object label4 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 10, ;
BackStyle = 0, ;
Caption = "Backcolor Selected Item", ;
Height = 18, ;
Left = 607, ;
Top = 0, ;
Width = 157, ;
ForeColor = Rgb(255,0,0), ;
Name = "Label4"
Add Object label5 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 32, ;
BackStyle = 0, ;
Caption = "?", ;
Height = 54, ;
Left = 732, ;
MousePointer = 15, ;
Top = 108, ;
Width = 28, ;
ForeColor = Rgb(0,255,0), ;
Name = "Label5"
Add Object combo5 As ComboBox With ;
Height = 37, ;
Left = 217, ;
Top = 20+50+10, ;
Width = 169, ;
Name = "Combo5"
Add Object label6 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 10, ;
BackStyle = 0, ;
Caption = "Background color", ;
Height = 18, ;
Left = 230, ;
Top = 0+50+10, ;
Width = 114, ;
ForeColor = Rgb(255,0,0), ;
Name = "Label6"
Procedure combo5.Init
With This
.RowSource="ycurs.xcolor"
.RowSourceType=6
.ListIndex=1
.Style=2
Locate
Endwith
Endproc
Procedure Load
_Screen.WindowState=1
Create Cursor ycurs (xcolor c(15),xvalue c(4))
Insert Into ycurs Values("White" ," W+")
Insert Into ycurs Values("Black " , "N")
Insert Into ycurs Values("Dark Gray","N+")
Insert Into ycurs Values("Gray" ,"W")
Insert Into ycurs Values("Red" ,"R+")
Insert Into ycurs Values("Dark Red" ,"R" )
Insert Into ycurs Values("Yellow" ,"GR+")
Insert Into ycurs Values("Dark Yellow" ,"GR" )
Insert Into ycurs Values("Green" ,"G+")
Insert Into ycurs Values("Dark Green" ,"G" )
Insert Into ycurs Values("Cyan" , "BG+")
Insert Into ycurs Values("Dark Cyan" ,"BG" )
Insert Into ycurs Values("Blue" , "B+")
Insert Into ycurs Values("Dark Blue","B" )
Insert Into ycurs Values("Magenta" ,"RB+" )
Insert Into ycurs Values("Dark Magenta" ,"RB" )
Insert Into ycurs Values("Blank" ,"X" )
*brow
Endproc
Procedure Destroy
Clea Events
Endproc
Procedure command1.Click
With Thisform
Sele ycurs
Locate For xcolor=Thisform.combo1.Value
.x1=xvalue
Locate For xcolor=Thisform.combo2.Value
.x2=xvalue
Locate For xcolor=Thisform.combo3.Value
.x3=xvalue
Locate For xcolor=Thisform.combo4.Value
.x4=xvalue
Locate For xcolor=Thisform.combo5.Value
.x5=xvalue
Y=Allt(.x1)+"/w*,"+Allt(.x2)+"/"+Allt(.x5)+"*"+",,,,"+Allt(.x3)+"/"+Allt(.x4)
Endwith
Thisform.text1.Value="SET COLOR OF SCHEME 1 TO "+m.y
Set Color Of Scheme 1 To (m.y)
Define Popup raccourci SHORTCUT Relative From Mrow(),Mcol() Color Scheme 1
Define Bar 1 Of raccourci Prompt "Hide menu" ;
FONT "Courier New", 8 Style "BI" ;
PICTURE Home(1)+"graphics\icons\industry\sinewave.ico"
Define Bar 2 Of raccourci Prompt "Run vfp9" ;
FONT "Courier New", 8 Style "BI"
Define Bar 3 Of raccourci Prompt "Run explorer" ;
FONT "Courier New", 8 Style "BI" ;
PICTURE Home(1)+"graphics\icons\misc\camera.ico"
Define Bar 4 Of raccourci Prompt "Run Mspaint" ;
FONT "Courier New", 8 Style "BI" ;
PICTURE Home(1)+"graphics\icons\misc\misc15.ico"
Define Bar 5 Of raccourci Prompt "Run Calculator" ;
FONT "Courier New", 8 Style "BI" ;
PICTURE Home(1)+"graphics\icons\misc\volume01.ico"
Define Bar _Med_find Of raccourci Prompt "Rec\<hercher..." ;
KEY CTRL+F, "Ctrl+F" ;
PICTRES _Med_find ;
MESSAGE "Recherche le texte spécifié"
Define Bar _Med_redo Of raccourci Prompt "\<Rétablir" ;
KEY CTRL+R, "Ctrl+R" ;
PICTRES _Med_redo ;
MESSAGE "Rétablit la dernière opération annulée"
Define Bar _Med_undo Of raccourci Prompt "\<Annuler" ;
KEY CTRL+Z, "Ctrl+Z" ;
PICTRES _Med_undo ;
MESSAGE "Annule la dernière modification"
Define Bar _Med_paste Of raccourci Prompt "C\<oller" ;
KEY CTRL+V, "Ctrl+V" ;
PICTRES _Med_paste ;
MESSAGE "Place le contenu du Presse-papiers au point d'insertion"
Define Bar _Med_copy Of raccourci Prompt "\ Co\<pier" ;
KEY CTRL+c, "Ctrl+C" ;
PICTRES _Med_copy ;
MESSAGE "Copie la sélection et la place dans le Presse-papiers"
Define Bar _Med_cut Of raccourci Prompt "\<Couper" ;
KEY CTRL+X, "Ctrl+X" ;
PICTRES _Med_cut ;
MESSAGE "Enlève la sélection et la place dans le Presse-papiers"
Define Bar _Med_slcta Of raccourci Prompt "\Sélec\<tionner tout" ;
KEY CTRL+A, "Ctrl+A" ;
PICTRES _Med_slcta ;
MESSAGE "Sélectionne tout le texte ou tous les éléments de la fenêtre active"
*2 bars are disabled by "\" operator
Activate Popup raccourci
Endproc
Procedure command1.RightClick
This.Click
Endproc
Procedure combo1.Init
With This
.RowSource="ycurs.xcolor"
.RowSourceType=6
.ListIndex=3
.Style=2
Locate
Endwith
Endproc
Procedure combo2.Init
With This
.RowSource="ycurs.xcolor"
.RowSourceType=6
.ListIndex=5
.Style=2
Locate
Endwith
Endproc
Procedure combo3.Init
With This
.RowSource="ycurs.xcolor"
.RowSourceType=6
.ListIndex=1
.Style=2
Locate
Endwith
Endproc
Procedure combo4.Init
With This
.RowSource="ycurs.xcolor"
.RowSourceType=6
.ListIndex=6
.Style=2
Locate
Endwith
Endproc
Procedure text1.RightClick
_Cliptext=This.Value && capture the command to add to the menu procedure
Endproc
Procedure label5.Click
Local m.myvar
TEXT to m.myvar pretext 7 noshow
The COLOR clause
The trick is to use the COLOR clause in the DEFINE PAD, DEFINE POPUP or DEFINE BAR commands. (DEFINE PAD creates the top-level menu title, DEFINE POPUP creates the menu itself, and DEFINE BAR creates an individual menu item.) According to the VFP Help, the COLOR clause includes something called a ColorPairList. Unfortunately, the Help fails to tell you what a ColorPairList looks like or how to code it.
In fact, it's quite easy. A ColorPairList is a comma-separated list of up to ten values. Each value corresponds to a different element of the menu, as indicated in Table 1. Of these ten items, the ones that are most commonly customised are the first, second, and sixth. These determine the colours of disabled items, normal (enabled) items and selected items respectively.
Item in list Meaning
1 Disabled item
2 Enabled item
3 Border
4 Title
5 Message
6 Selected item
7 Hotkey indicator
8 Shadow
9 Enabled control
10 Disabled control
Table 1: The ten items in a ColorPairList
Within the list, you can choose between two methods of coding the various colours. The first method relies on combinations of letters, separated by a forward slash. The letters represent the foreground and background colours respectively. For example, W/G is white on green, while N/RB is black on magenta. Table 2 lists the available colours. The plus sign (as in GR+) indicates a "bright" version of the colour; this is available for the foreground colour only. To produce a bright version of a background colour, add an asterisk.
Colour Code
Black N
Blue B
Brown GR
Cyan BG
Green G
Magenta RB
Red R
White W
Yellow GR+
Table 2: Alphabetic colour codes
Here then is a command to create a menu in which disabled items appear as green on white, normal items as blue on white, and the selected item as "bright" white on brown (if the plus sign was omitted from the last element, the "white" would show up as a medium grey).
DEFINE POPUP Shortcut COLOR G/W*, B/W*,,,,W+/GR && Note the use of commas as place-holders for missing items.
from:http://fox.wikis.com/wc.dll?Wiki~ColorPairConcordance
ENDTEXT
*messagebox(m.myvar,0+32+4096,"Summary help")
#define MB_ICONINFORMATION 0x00000040
#define MB_OK 0x00000000
#define MB_APPLMODAL 0x00000000
#define MB_DEFBUTTON1 0x00000000
DECLARE INTEGER MessageBox IN user32 As MessageBoxA;
INTEGER hwnd,;
STRING lpText,;
STRING lpCaption,;
INTEGER wType
*buttons
#define MB_ABORTRETRYIGNORE 0x00000002
#define MB_CANCELTRYCONTINUE 0x00000006
#define MB_HELP 0x00004000
#define MB_OKCANCEL 0x00000001
#define MB_RETRYCANCEL 0x00000005
#define MB_YESNO 0x00000004
#define MB_YESNOCANCEL 0x00000003
*Icons
#define MB_ICONEXCLAMATION 0x00000030
#define MB_ICONWARNING 0x00000030
#define MB_ICONASTERISK 0x00000040
#define MB_ICONQUESTION 0x00000020
#define MB_ICONSTOP 0x00000010
#define MB_ICONERROR 0x00000010
#define MB_ICONHAND 0x00000010
*To indicate the default button, specify one of the following values.
#define MB_DEFBUTTON2 0x00000100
#define MB_DEFBUTTON3 0x00000200
#define MB_DEFBUTTON4 0x00000300
*To indicate the modality of the dialog box, specify one of the following values.
#define MB_SYSTEMMODAL 0x00001000
#define MB_TASKMODAL 0x00002000
*To specify other options, use one or more of the following values.
#define MB_DEFAULT_DESKTOP_ONLY 0x00020000
#define MB_RIGHT 0x00080000
#define MB_RTLREADING 0x00100000
#define MB_SETFOREGROUND 0x00010000
#define MB_TOPMOST 0x00040000
#define MB_SERVICE_NOTIFICATION 0x00200000
*Return code
#define IDABORT 3
#define IDCANCEL 2
#define IDCONTINUE 11
#define IDIGNORE 5
#define IDNO 7
#define IDOK 1
#define IDRETRY 4
#define IDTRYAGAIN 10
#define IDYES 6
MessageBoxA(_vfp.hwnd,m.myvar,"Summary help",MB_APPLMODAL+MB_OK +MB_ICONINFORMATION +MB_DEFBUTTON1 )
Endproc
Enddefine
*
*-- EndDefine: ycolorSchemes
can colorize any vfp menu with color scheme command in menu definition as explained in code.
Click on code to select [then copy] -click outside to deselect
*2*
*return RGBSchemes and litteral schemes from 10 vfp color pair.
*Returns an RGB color pair or an RGB color pair list from a specified color pair.
*RGBSCHEME(nColorSchemeNumber [, nColorPairPosition])
*Schemes:Returns a color pair list or a single color pair from a specified color scheme.
*SCHEME(nSchemeNumber [, nColorPairNumber])
Local m.u,m.v,cr
m.cr=Chr(13)+Chr(10)
m.u="RGBSchemes 1-10"+cr
m.v="Schemes 1-10 "+cr
For i=1 To 10
m.u=m.u+Trans(Rgbscheme(i))+cr
m.v=m.v+ Scheme(i)+cr
Endfor
Local m.lcdest
m.lcdest=Addbs(Sys(2023))+"ytemp.txt"
Strtofile(m.u+Chr(13)+Chr(10)+m.v,m.lcdest)
Run/N notepad &lcdest
Click on code to select [then copy] -click outside to deselect
![]()
*3* this code apply custom color schemes to a top level form (sdi). *the color schemes can be applied if the bar is not a vfp system one want to say its with the clause *BAR AT LINE 1 &&or up (with BAR statement ony, the menu is vfp system one and cannot altered with custom schemes. *with the code *1* can apply any scheme style (see the form.combo1. *the method ybuild_menu builds the menu with custom schemes. Publi oform oform=Newobject("ysdi_schemes") oform.Show Read Events Retu * Define Class ysdi_schemes As Form DataSession = 2 Height = 415 Width = 740 ShowWindow = 2 ShowTips = .T. AutoCenter = .T. Caption = "Add a custom VFP Menu to SDI Form" MaxButton = .F. AlwaysOnTop = .T. BackColor = Rgb(212,210,208) yscheme1 = .F. yscheme2 = .F. Name = "SDIFORM" Add Object combo1 As ComboBox With ; Anchor = 768, ; Height = 37, ; Left = 588, ; Top = 36, ; Width = 145, ; Name = "Combo1" Procedure ybuild_menu Lparameters oFormRef, getMenuName, lUniquePopups, parm4, parm5, parm6, parm7, parm8, parm9 Local cMenuName, nTotPops, a_menupops, cTypeParm2, cSaveFormName If Type("m.oFormRef") # "O" Or ; LOWER(m.oFormRef.BaseClass) # 'form' Or ; m.oFormRef.ShowWindow # 2 Messagebox([This menu can only be called from a Top-Level form. Ensure that your form's ShowWindow property is set to 2. Read the header section of the menu's MPR file for more details.]) Return Endif m.cTypeParm2 = Type("m.getMenuName") m.cMenuName = Sys(2015) m.cSaveFormName = m.oFormRef.Name If m.cTypeParm2 = "C" Or (m.cTypeParm2 = "L" And m.getMenuName) m.oFormRef.Name = m.cMenuName Endif If m.cTypeParm2 = "C" And !Empty(m.getMenuName) m.cMenuName = m.getMenuName Endif Dimension a_menupops[4] If Type("m.lUniquePopups")="L" And m.lUniquePopups For nTotPops = 1 To Alen(a_menupops) a_menupops[m.nTotPops]= Sys(2015) Endfor Else a_menupops[1]="foods" a_menupops[2]="buffalowin" a_menupops[3]="animals" a_menupops[4]="sports" Endif * Menu Definition Set Color Of Scheme 1 To (Thisform.yscheme1) Set Color Of Scheme 2 To (Thisform.yscheme2) Define Menu (m.cMenuName) In (m.oFormRef.Name) Bar At Line 1 Font 'Arial',12 Style "BI" Color Scheme 1 *" at LINE 1" makes the menu as custom (not vfp system menu) and can be altered with custom schemes *if omitted the menu is a vfp system menu and cannot be altered with custom color schemes Define Pad _08i0obyaa Of (m.cMenuName) Prompt "\<Foods" Color Scheme 1 ; KEY Alt+F, "" Define Pad _08i0obyb4 Of (m.cMenuName) Prompt "\<Animals" Color Scheme 1 ; KEY Alt+A, "" Define Pad _08i0obyb5 Of (m.cMenuName) Prompt "\<Sports" Color Scheme 1 ; KEY Alt+S, "" On Pad _08i0obyaa Of (m.cMenuName) Activate Popup (a_menupops[1]) On Pad _08i0obyb4 Of (m.cMenuName) Activate Popup (a_menupops[3]) On Pad _08i0obyb5 Of (m.cMenuName) Activate Popup (a_menupops[4]) Define Popup (a_menupops[1]) Margin Relative Shadow Color Scheme 1 Define Bar 1 Of (a_menupops[1]) Prompt "Bananas" Define Bar 2 Of (a_menupops[1]) Prompt "Salsa" Define Bar 3 Of (a_menupops[1]) Prompt "Buffalo WIngs" Define Bar 4 Of (a_menupops[1]) Prompt "\-" Define Bar 5 Of (a_menupops[1]) Prompt "Pizza" Define Bar 6 Of (a_menupops[1]) Prompt "Espresso" On Bar 3 Of (a_menupops[1]) Activate Popup (a_menupops[2]) Define Popup (a_menupops[2]) Margin Relative Shadow Color Scheme 2 Define Bar 1 Of (a_menupops[2]) Prompt "Hot" Define Bar 2 Of (a_menupops[2]) Prompt "Medium" Define Bar 3 Of (a_menupops[2]) Prompt "Mild" Define Bar 4 Of (a_menupops[2]) Prompt "Garlic" Define Popup (a_menupops[3]) Margin Relative Shadow Color Scheme 2 Define Bar 1 Of (a_menupops[3]) Prompt "Dogs" Define Bar 2 Of (a_menupops[3]) Prompt "Cats" Define Bar 3 Of (a_menupops[3]) Prompt "Elephants" Define Bar 4 Of (a_menupops[3]) Prompt "Pigs" Define Popup (a_menupops[4]) Margin Relative Shadow Color Scheme 2 Define Bar 1 Of (a_menupops[4]) Prompt "Football" Define Bar 2 Of (a_menupops[4]) Prompt "Rugby" Define Bar 3 Of (a_menupops[4]) Prompt "Bowling" Activate Menu (m.cMenuName) Nowait If m.cTypeParm2 = "C" m.getMenuName = m.cMenuName m.oFormRef.Name = m.cSaveFormName Endif Endproc Procedure Init If Fontmetric(1, 'MS Sans Serif', 8, '') # 13 Or ; fontmetric(4, 'MS Sans Serif', 8, '') # 2 Or ; fontmetric(6, 'MS Sans Serif', 8, '') # 5 Or ; fontmetric(7, 'MS Sans Serif', 8, '') # 11 This.SetAll('fontname', 'Tahoma') Else This.SetAll('fontname','MS Sans Serif') Endif This.SetAll('fontsize',8) With Thisform .yscheme1=" N+/w*,R+/GR+*,,,,W+/R" .yscheme2=" N+/B*,R+/G+*,,,,W+/R" Endwith Thisform.ybuild_menu(Thisform,.T.) *can be if there is external mpr defined menu ( for top level fom only) *do sdiform2.mpr with thisform,.t. Endproc Procedure Destroy Release Menu (This.Name) Extended Set Sysmenu To Defa &&restore the vfp system menu clea events Endproc Procedure combo1.Click Do Case Case This.Value=1 Thisform.yscheme1=" N+/w*,R+/GR+*,,,,W+/R" Case This.Value=2 Thisform.yscheme1=" N+/w*,R+/BG*,,,,W+/R" Thisform.yscheme2=" N+/w*,R+/G+*,,,,W+/R" Case This.Value=3 Thisform.yscheme1=" N+/w*,R+/B+*,,,,W+/R" Thisform.yscheme2=" N+/w*,R+/BG*,,,,W+/R" Case This.Value=4 Thisform.yscheme1=" N+/w*,R+/N*,,,,W+/R" Thisform.yscheme2=" N+/w*,R+/BG*,,,,W+/R" Endcase Thisform.ybuild_menu(Thisform,.T.) Endproc Procedure combo1.Init With This .AddItem ("custom scheme1") .AddItem("Custom scheme 2") .AddItem("custom scheme 3") .AddItem("custom scheme 4") .ListIndex=1 .Value=1 .Style=2 Endwith Endproc Enddefine * *-- EndDefine: ysdi_schemes
Important:All Codes above are tested on VFP9SP2 & windows 10 pro .