// C:\FWH..\SAMPLES\CORMEMO.PRG
***************************************************
* Multi SAY/GET testing in 32 bit Xbase++ mode....*
* Jon Berg 10-8-99 *
***************************************************
#include "FiveWin.ch"
#Define CLR_GOLD1 nRGB( 255, 215, 000 ) //-> Gold1 - Ouro 1
#Define CLR_GOLD2 nRGB( 238, 201, 000 ) //-> Gold2 - Ouro 2
#Define CLR_GOLD3 nRGB( 205, 173, 000 ) //-> Gold3 - Ouro 3
#Define CLR_GOLD4 nRGB( 139, 117, 000 ) //-> Gold4 - Ouro 4
#Define CLR_AQUAMARINE nRGB( 127, 255, 212 ) //-> Aquamarine - Agua Marinha
#Define CLR_ORANGE nRGB( 255, 165, 000 ) //-> Orange - Laranja
#Define CLR_VERDEAGUA nRGB( 0, 128, 128 )
#Define CLR_CREME nRGB( 255, 255, 235 ) //-> Cream color
#Define CLR_AZULADITO nRGB( 255-016-008, 255-016-008, 255-016 )
#Define CLR_CHOCOLATE nRGB( 238, 118, 33 )
#Define CLR_LGREEN nRGB( 190, 215, 190 )
#Define CLR_VERMELHO nRGB( 255, 000, 000 ) //-> Vermelho Para a Letra
#Define CLR_AMARELO nRgb( 255, 255, 000 ) //-> Amarelo Para o Fundo
#Define CLR_BOMBOM nRGB( 165, 42, 42 ) //-> Marrom BomBom
#Define CLR_MARROM nRGB( 135, 206, 250 ) //-> LightSkyBlue
#Define CLR_MENTA nRGB( 221, 255, 238 ) //-> Cor de Menta
#Define CLR_HMENTA nRGB( 000, 128, 000 ) //-> Cor de Menta Light uiiii
#Define CLR_SOFTYELLOW nRGB( 255, 251, 225 ) //-> Amerelo Soft.
#Define CLR_PINK nRGB( 255, 128, 128 ) //-> Rosa. uiiii. kkkkkk
#Define CLR_NBLUE nRGB( 128, 128, 192 )
#Define CLR_MSPURPLE nRGB( 0, 120, 215 ) //-> Purpura.
#Define CLR_MSRED nRGB( 232, 17, 35 )
#Define CLR_MSGRAY nRGB( 229, 229, 229 )
#Define CLR_LGRAY nRGB( 230, 230, 230 )
#Define CLR_MAGENTA2 nRGB( 239, 222, 222 )
static oWnd, lCambiaColor := .T.
FUNCTION Main()
DEFINE WINDOW oWnd FROM 1, 1 TO 30, 70 ;
TITLE "Testing Says/Gets and Get Pictures and Foreground/Background Colors" ;
MENU BuildMenu()
SET MESSAGE OF oWnd TO "FiveWin++"
ACTIVATE WINDOW oWnd MAXIMIZED
RETURN NIL
FUNCTION BuildMenu()
local oMenu
MENU oMenu
MENUITEM "&Say/Get Testing"
MENU
MENUITEM "&Build Multi GET Dialog1 with PICTs " ACTION (BldDlg1())
MENUITEM "Item &2" ACTION MsgInfo("Test Menu Item2")
MENUITEM "Item &3" ACTION MsgInfo("Test Menu Item3")
SEPARATOR
MENUITEM "Exit" ACTION oWnd:End()
ENDMENU
ENDMENU
RETURN( oMenu )
FUNCTION BldDlg1()
LOCAL oBrushRed, oBrushGreen
LOCAL oDlg, oArial, oFont, oMemo
LOCAL cName1 := "ONE "
LOCAL cName2 := "two "
LOCAL cName3 := "3 "
LOCAL cName4 := "4 "
LOCAL cName5 := "5 "
LOCAL cName6 := "54321 "
LOCAL cName7 := "567890 "
LOCAL lRESERVE := .F.
LOCAL cPROV_TYPE:= SPACE(20)
LOCAL cPHONE := SPACE(18)
LOCAL dCERT_DATE:= CTOD(' / / ')
LOCAL nPROC_DAYS:= 9876
LOCAL cTEXT := "Use Tab or Shift Tab to move to next get."+SPACE(256)
LOCAL aGet := ARRAY(5)
SET EPOCH TO 1920
SET CENTURY ON
tGet():lDisColors := .F. // WHEN( .F. )
tGet():nClrTextDis := CLR_BLACK
tGet():nClrPaneDis := CLR_SOFTYELLOW
DEFINE BRUSH oBrushRed COLOR CLR_HRED
DEFINE BRUSH oBrushGreen COLOR CLR_HGREEN
DEFINE FONT oFont NAME "FIXEDSYS" SIZE 10, -10 && Use a Nonproportional font
DEFINE DIALOG oDlg FROM 1, 1 TO 600, 800 TITLE "Hello Gets!" ;
STYLE nOr(WS_POPUP, ;
WS_VISIBLE, ;
WS_CAPTION, ;
WS_THICKFRAME, ;
WS_SYSMENU, ;
WS_MINIMIZEBOX, ;
WS_MAXIMIZEBOX) ;
PIXEL OF oWnd BRUSH oBrushGreen // Defined by Pixels
@ 00, 03 SAY "Showing how to do SAY/GETs from source code. No DLLs or RC files. " OF oDlg ;
COLORS CLR_BLACK,CLR_YELLOW BORDER SIZE 300,10 UPDATE
@ 01, 03 SAY "Navigation Keys to traverse gets are Ret, Arrows, Tab and Shift Tab....ESC to close this Dialog" OF oDlg ;
COLORS CLR_WHITE,CLR_BLUE BORDER SIZE 380,10 UPDATE
@ 02, 03 SAY "Testing Say with different colors and a border. " OF oDlg ;
COLORS CLR_HRED ,CLR_WHITE BORDER SIZE 200,10 UPDATE
@ 03, 03 SAY "Testing Say with different colors and no border." OF oDlg ;
COLORS CLR_HBLUE ,CLR_WHITE SIZE 200,10 UPDATE
@ 05, 19 SAY "Field length" OF oDlg SIZE 65,10 UPDATE && Use normal colors
@ 06, 19 SAY " | " OF oDlg SIZE 65,10 UPDATE
@ 07, 03 SAY "1 Chr No PICT 13" OF oDlg ;
COLORS CLR_BLACK ,CLR_HCYAN BORDER SIZE 195,10 UPDATE
@ 08, 03 SAY "2 Chr No PICT 11" OF oDlg ;
COLORS CLR_BLUE ,CLR_HCYAN BORDER SIZE 195,10 UPDATE
@ 09, 03 SAY "3 Chr No PICT 9" OF oDlg ;
COLORS CLR_RED ,CLR_HCYAN BORDER SIZE 195,10 UPDATE
@ 10, 03 SAY "4 Chr PICT 'NNNNNNNN' 8" OF oDlg ;
COLORS CLR_HRED ,CLR_HCYAN BORDER SIZE 195,10 UPDATE
@ 11, 03 SAY "5 Chr PICT 'AAAAAAAAA' 9" OF oDlg ;
COLORS CLR_HGREEN,CLR_HCYAN BORDER SIZE 195,10 UPDATE
@ 12, 03 SAY "6 Chr PICT '9999999999' 13" OF oDlg ;
COLORS CLR_BLACK ,CLR_HCYAN BORDER SIZE 195,10 UPDATE
@ 13, 03 SAY "7 Chr PICT '@K@!@S10' 24" OF oDlg ;
COLORS CLR_BLACK ,CLR_HCYAN BORDER SIZE 195,10 UPDATE
@ 14, 03 SAY " Logic 'T/F or Y/N' 1" OF oDlg ;
COLORS CLR_BLACK ,CLR_HCYAN BORDER SIZE 195,10 UPDATE
@ 15, 03 SAY " Chr PICT '@S5'and !EMPTY() 20" OF oDlg ;
COLORS CLR_BLACK ,CLR_HCYAN BORDER SIZE 195,10 UPDATE
@ 16, 03 SAY " Chr PICT '(999)A99-9!99-9999' 18" OF oDlg ;
COLORS CLR_BLACK ,CLR_HCYAN BORDER SIZE 195,10 UPDATE
@ 17, 03 SAY " Date !> comp date or empty 8" OF oDlg ;
COLORS CLR_BLACK ,CLR_HCYAN BORDER SIZE 195,10 UPDATE
@ 16.8, 35 SAY "Set Century is on." OF oDlg ;
SIZE 195,10 UPDATE
@ 17.3, 35 SAY "Set Epoch is set to 1919." OF oDlg ;
SIZE 195,10 UPDATE
@ 18, 03 SAY " Num PICT '99' !>10 10" OF oDlg ;
COLORS CLR_BLACK ,CLR_HCYAN BORDER SIZE 195,10 UPDATE
@ 19, 03 SAY " Memo No PICT 256" OF oDlg ;
COLORS CLR_BLACK ,CLR_HCYAN BORDER SIZE 195,10 UPDATE
@ 07, 28 GET cName1 OF oDlg COLORS "B/BG" SIZE 20,10 UPDATE CENTER
@ 08, 28 GET cName2 OF oDlg COLORS CLR_BLACK, CLR_HCYAN UPDATE CENTER
@ 09, 28 GET cName3 OF oDlg COLORS CLR_BLACK, CLR_YELLOW UPDATE CENTER
@ 10, 28 GET cName4 OF oDlg PICTURE "NNNNNNNN" ;
COLORS nRGB(111, 30, 81), nRGB(245, 235, 147) UPDATE CENTER
@ 11, 28 GET cName5 OF oDlg PICTURE "AAAAAAAAA" ;
COLORS nRGB(43, 43, 43), nRGB(248, 239, 186) UPDATE CENTER
@ 12, 28 GET cName6 OF oDlg PICTURE "9999999999" ;
COLORS nRGB(43, 43, 43), nRGB(248, 239, 186) UPDATE CENTER
@ 13, 28 GET cName7 OF oDlg PICTURE "@K@!@S10" ;
COLORS CLR_ORANGE, CLR_WHITE WHEN( .F. ) UPDATE CENTER
@ 14, 28 GET lRESERVE OF oDlg PICTURE "Y" CENTER ;
MESSAGE "Please type in a Y or N " COLORS CLR_PINK, CLR_WHITE UPDATE
@ 15, 28 GET cPROV_TYPE OF oDlg PICTURE "@S5" ;
COLORS CLR_NBLUE, CLR_WHITE UPDATE CENTER ;
VALID IF(EMPTY(cPROV_TYPE),(MSGINFO("You have to enter at least 1 Character"),.F.),.T.)
@ 16, 28 GET cPHONE OF oDlg PICTURE "(999)A99-9!99-9999" ;
COLORS CLR_MSPURPLE, CLR_WHITE UPDATE CENTER
@ 17, 28 GET dCERT_DATE OF oDlg SIZE 50,10 ;
COLORS CLR_MSRED, CLR_WHITE UPDATE CENTER ;
VALID (IF(dCERT_DATE>DATE(),(MSGINFO("Certification Date must not be greater than Computer Date or blank!"),.F.),.T.)) MESSAGE "Please type in the Certification Date"
@ 18, 28 GET nPROC_DAYS OF oDlg PICTURE "99" ;
COLORS CLR_BLACK, CLR_WHITE UPDATE CENTER ;
VALID (IF(nPROC_DAYS>10,(MSGINFO("Processing Days Must be less that 11 or Empty"),.F.),.T.)) MESSAGE "Please type in the Number of days it took to process"
//@ 19, 28 GET cText MEMO OF oDlg SIZE 140,46
@ 19, 28 GET aGet[1] VAR cText MEMO OF oDlg SIZE 140,46 UPDATE ;
ON CHANGE( SET_COLOR( aGet ) )
aGet[1]:bGotFocus := {|| aGet[1]:SetColor(RGB(0,0,0),RGB(197,205,255)),aGet[1]:Refresh()}
aGet[1]:bLostFocus := {|| aGet[1]:SetColor(RGB(0,0,0),RGB(255,255,255)),aGet[1]:Refresh()}
SET FONT OF oDlg TO oFont && so characters line up in Says
ACTIVATE DIALOG oDlg CENTERED /* ;
ON LEFT CLICK nMsgBox( "Incredible!" ) */
lCambiaColor := .T.
oBrushRed:End()
oBrushGreen:End()
RETURN NIL
FUNCTION SET_COLOR( aGet ) // mas o menos esto, cambia a tu gosto.
LOCAL nCor
IF lCambiaColor // cambia color solo una viez
aGet[1]:SetColor( aGet[1]:nClrText, nCor := ChooseColor( aGet[1]:nClrPane ) )
aGet[1]:Refresh()
aGet[1]:SetFocus()
ENDIF
lCambiaColor := .F.
RETURN NIL
// FIN / END