****************************************************************************************** * Program : Fancyget.PRG * * Launch FANCYGET.EXE * * ..........: --- This program show you how to: -----------------------------------------* * ..........: Howto Create RAD GET and Window with solid/brush bitmap * * ..........: Howto Create windows menu * * ..........: HowTo Create dBase/xBase file * * ..........: HowTo Manage dBase/xBase file * * ..........: HowTo Use Manifest file ( Windows XP style widgets ) * * ..........: HowTo Set Res file for ico and bitmap * * ..........: HowTo set and use Box (drawing) * *...........: HowTo set Clipper's like picture (Mask Edit widget) in gets * *...........: HowTo use the Crystal Reports into NTK * *........................................................................................* *...........: Don't forget, NTK use Windows constant for styles etc... * *...........: You can check Microsoft's MSDN Website and also the NTK include Windows.CH * * ..........: ---------------------------------------------------------------------------* * Make : Juste type MAKE * * Date : 03/16/06 * * Author(s) : Sylvain Pasquet * * Copyright : (c) 2006 - SPA pour SiS-Logiciels * ****************************************************************************************** **Classic windows constant include #include "windows.ch" **Include the GDI #include "ntkgdi.ch" **Include for Edit Get #include "ntkedget.ch" **Include button state like enable/disable.. #include "ntkbtn.ch" **Include the Ntk_messagebox very usefull for informations box or simply debugging #include "ntkmsg.ch" **Include all that you need to set your acceleration key #include "ntkacc.ch" **Include all that you need to create windows menu #include "ntkmenus.ch" **Include define for the listbox #include "ntkdlg.ch" **Common NTK include file #include "wNtk.ch" #include "ntkcmd.ch" #include "ntkcmdex.ch" **Include constant for define key #include "wNtkKeys.ch" ********** ********** ********** **We can define custom things like carriage return #define CR CHR(13) ********** ********** ********** **Define the GETs IDs (This will define gets's direction navigation) #define GET_ONE 7001 #define GET_TWO 7002 #define GET_THREE 7003 #define GET_FOUR 7004 #define GET_FIVE 7005 #define GET_SIX 7006 #define GET_SEVEN 7007 #define GET_EIGHT 7008 #define GET_NINE 7009 ********** ********** ********** **Define button IDs #define ID_BTN0 8000 // unique id (Quit Button) #define ID_BTN1 8001 // unique id ( Button) #define ID_BTN2 8002 // unique id ( Button) #define ID_BTN3 8003 // unique id ( Button) #define ID_BTN4 8004 // unique id ( Button) #define ID_BTN5 8005 // unique id ( Button) #define ID_BTN6 8006 // unique id ( Button) #define ID_BTN7 8007 // unique id ( Button) #define ID_BTN8 8008 // unique id ( Button) ********** ********** ********** **Define radio button #define ID_GETRB1 8015 // unique id (used for the get control) #define ID_GETRB2 8016 // unique id (used for the get control) #define ID_GETRB3 8017 // unique id (used for the get control) ********** ********** ********** **Our program must have a MAIN function, it's our program's start. FUNCTION MAIN() **Will contain window's handle LOCAL hWndMain **It will be usefull to set windows size into vars and give them to a local function **"center window" for center window program into Windows's desktop. LOCAL cxSize:=625 LOCAL cySize:=500 **This function return an array with centered window coordinate. (Local function, see bottom) LOCAL aArray:=CenterWindow(cxSize,cySize) LOCAL cWinTitle := "Fancy Get and dBase/xBase::Rad-Method::Exemple" **For brush we can also use stock object brush LOCAL hBrush := NTK_GetStockObject(WHITE_BRUSH) // LTGRAY_BRUSH, WHITE_BRUSH... **We can use icon in the res file or use system icons (like:IDI_APPLICATION) LOCAL hIcon := NTK_LoadIcon( NTK_GetInstance() , "rICO01" ) // **This local var will be use for a custom brush LOCAL cBmpFile2 **Local vars for menu LOCAL lRet,aPopupMenu,aPopupMenu2 **Local var used by the read system LOCAL lOldReadState **If we set delete ON, the database (cXBaseFile) will not keep deleted records **If we set delete OFF,the deleted records will be flaged and will not be deleted until a PACK or ZAP command SET DELETE ON **Load BMP from RC file PRIVATE hMyBmpHeader := NTK_LoadBitmap( NTK_GetInstance(), "head" ) PRIVATE hMyBmpLinux := NTK_LoadBitmap( NTK_GetInstance(), "linux" ) **We can also directly load a BMP, JPEG, GIF image from a disk file PRIVATE hMyBox := NTK_ReadPictureToBmp( "./bmp/box01.bmp" ) *PRIVATE hMyBmpShield := NTK_ReadPictureToBmp( ".\bmp\Shield.bmp" ) **Xharbour allow you to create database with longname. But, be careful, many old tools don't manage them ! PRIVATE cXBaseFile:="./files/mybasewithalongname.DBF" //PRIVATE cXBaseFile:="./files/test.DBF" // If we're expected to keep on rolling with the old good 8.3 dBase format... **If we use some customs fonts we need to declare them **PRIVATE aObjFONT1 := { -48,18,0,0,700, .F., .F., .F., 1, 0, 0, 0, 0, "VERDANA" } PRIVATE aObjFONT1 := { -12,7,0,0,700, .F., .F., .F., 1, 0, 0, 0, 0, "VERDANA" } PRIVATE hObjFONT1 := NTK_CreateFont( aObjFONT1 ) **We can test if the font was successfully opened. IF hObjFONT1 == 0 NTK_MsgBox( , "Can not create Georgia Font..." ) RETURN Nil ENDIF **If we use some customs fonts we need to declare them PRIVATE aObjFONT2 := { -10,6,0,0,700, .F., .F., .F., 1, 0, 0, 0, 0, "VERDANA" } PRIVATE hObjFONT2 := NTK_CreateFont( aObjFONT2 ) **We can test if the font was successfully opened. IF hObjFONT2 == 0 NTK_MsgBox( , "Can not create Verdana Font..." ) RETURN Nil ENDIF **This array will contain Button list and Get list PRIVATE aBtnList := {} // Must be Here. We certainly need Buttons... PRIVATE aGetList := {} // Must be Here. We certainly need Gets... **We need to initialize our get's variables PRIVATE sString1,sString2,sString3,sString4,sString5 **Memo get PRIVATE sMemo1 **Dropdown list get PRIVATE sMySelection := "Male" PRIVATE aCbChoices := { "Male", "Female", "Alien"} **Default State Radio button box PRIVATE lCheckBox1,lCheckBox2,lCheckBox3 **CheckBox default state PRIVATE lCheckBox **Multi-choice ListBox: Default selected and list box choices PRIVATE aLbSel := { "Banana", "Peach" } PRIVATE aLbChoices := { "Plum", "Banana", "Apple", "Peach", "Apricot" } **Set the entry mode to no PRIVATE EntryMode := "N" **Set present record to no PRIVATE Present := "N" ***************************************************************************************** ** Create a dBase/xBase if not exist * ***************************************************************************************** ** First Part: We must declare our Base skeleton * ***************************************************************************************** ** First argument is the field's Name. * ** Second argument is the field's Type : * ** -N type means NUMERIC * ** -D type means DATE * ** -C type means Character * ** -M type means Memo (Ignore field's length argument, it always allocate 64Ko) * ** Third argument is the field's Length. * ** Fourth and last argument is the number of decimals. (Char and numeric fields only). * ***************************************************************************************** PRIVATE T_DBF := {} AADD( T_DBF, { "FNAME" , "C", 20, 0 } ) AADD( T_DBF, { "LNAME" , "C", 20, 0 } ) AADD( T_DBF, { "ADDR1" , "C", 30, 0 } ) AADD( T_DBF, { "ADDR2" , "C", 30, 0 } ) AADD( T_DBF, { "PHONE" , "C", 15, 0 } ) AADD( T_DBF, { "GENDER" , "N", 1, 0 } ) AADD( T_DBF, { "NOTES" , "M", 10, 0 } ) AADD( T_DBF, { "COOLG" , "L", 1, 0 } ) AADD( T_DBF, { "FRUIT" , "C", 20, 0 } ) // Ensure a max number of LbChoices to 20 elements/fruits AADD( T_DBF, { "OS" , "N", 1, 0 } ) **If file doesn't exist create it ! IF !FILE( cXBaseFile ) DBCREATE( cXBaseFile, T_DBF) ENDIF **We define a select number and open our cXBaseFile database SELECT 1 USE (cXBaseFile) ** Settings of "EntryMode" and "Present" vars, depending if our database has got (at least) a record or not... IF EOF() DO INIT_FCGet Present := "N" EntryMode:="C" ELSE DO VARI_FCGet Present := "Y" ENDIF **We can create a brush from a bmp file ****Create a bitmap brush from a bitmap file. ****cBmpFile1 := ".\BMP\mbg03.bmp" ****CREATE BITMAP BRUSH FROM cBmpFile1 TO hBkClrBrush **Or create a brush from a RGB CREATE SOLID BRUSH NTK_RGB( 239,243,254) TO hBkClrBrush **We now create our window with custom brush CREATE WINDOW hWndMain ; TITLE cWinTitle ; ICON hIcon ; AT aArray[1],aArray[2] SIZE cxSize,cySize ; BRUSH hBkClrBrush ; STYLE WS_SYSMENU ; ON PAINT DoRePaint() ; ON EXIT DoQuit() **Fancy Brush just from Bitmap file on hdd. cBmpFile2 := ".\BMP\bg02.bmp" *This is the way for creating a bitmap brush named hGetBkClrBrush CREATE BITMAP BRUSH FROM cBmpFile2 TO hGetBkClrBrush **Default Bkg Brush for all gets SET DEFAULT BACKGROUND GETS COLOR BRUSH TO hGetBkClrBrush **Fancy Brush just from Bitmap file on hdd. cBmpFile2 := ".\BMP\BG01.bmp" CREATE BITMAP BRUSH FROM cBmpFile2 TO hGetFocusClrBrush **Bkg brush used when current Get has focus SET DEFAULT SELECTED GET COLOR BRUSH TO hGetFocusClrBrush **Create a windows menu aMenu := NtkCreateMenu() aPopupMenu := NtkCreatePopupMenu() NtkAppendMenu(aPopupMenu, "PRINT", MF_ENABLED + MF_STRING, "&Print", {|| IMPR_FCGET(hWndMain) }, "Output the document directly to printer." ) NtkAppendMenu(aPopupMenu, "", MF_SEPARATOR) NtkAppendMenu(aPopupMenu, "QUIT", MF_ENABLED + MF_STRING, "E&xit", {|| DOQUIT( hWndMain ) } , "Quit this program." ) aPopupMenu2 := NtkCreatePopupMenu() NtkAppendMenu(aPopupMenu2, "ABOUT", MF_ENABLED + MF_STRING, "&About", {|| DOABOUT(hWndMain,"WELCOME TO NTK !!") }, "Show the about dialog." ) NtkAppendMenu( aMenu, "FILE", MF_ENABLED + MF_POPUP, "&Files", aPopupMenu, "Files operations..." ) NtkAppendMenu( aMenu, "About", MF_ENABLED + MF_POPUP, "&About", aPopupMenu2, "Show the wonderfull about dialog" ) lRet := NtkSetMenu(hWndMain, aMenu) **In clipper "@!" picture transform in uppercase @ 98,125 GET sString1 ID GET_ONE ; PICTURE "@!" ; SIZE 22,250 ; VALID TESTGET1(hWndMain) ; STYLE GS_3DSUNKEN ; TEXTCOLOR NTK_RGB(0,0,128) ; BACKCOLOR TRANSPARENT ; PICK DoAbout() ; MESSAGE "Enter the first name." @ 123,125 GET sString2 ID GET_TWO ; SIZE 22,250 ; VALID TESTGET2(hWndMain) ; STYLE GS_3DSUNKEN ; TEXTCOLOR NTK_RGB(0,0,128) ; BACKCOLOR TRANSPARENT ; MESSAGE "Enter the last name." @ 148,125 GET sString3 ID GET_THREE ; SIZE 22,250 ; STYLE GS_3DSUNKEN ; TEXTCOLOR NTK_RGB(0,0,128) ; BACKCOLOR TRANSPARENT ; MESSAGE "Enter the address." @ 173,125 GET sString4 ID GET_FOUR ; SIZE 22,250 ; STYLE GS_3DSUNKEN ; TEXTCOLOR NTK_RGB(0,0,128) ; BACKCOLOR TRANSPARENT ; MESSAGE "Enter the address ( second line )." @ 198,125 GET sString5 ID GET_FIVE ; SIZE 22,250 ; PICTURE "99-99-99-99-99" ; STYLE GS_3DSUNKEN ; TEXTCOLOR NTK_RGB(0,0,128) ; BACKCOLOR TRANSPARENT ; MESSAGE "Enter the phone number." @ 223, 125 GET sMySelection ID GET_SIX ; SIZE 100,150 ; CAPTION aCbChoices ; TYPE GXT_COMBOBOX ; FONT NTK_GetStockObject(ANSI_VAR_FONT) ; TEXTCOLOR NTK_RGB(000,000,128) ; BACKCOLOR NTK_RGB(255,255,128) ; STYLE CBS_DROPDOWNLIST ; MESSAGE "Select your gender ..." @ 248, 125 GET sMemo1 ID GET_SEVEN ; SIZE 50,250 ; PICTURE "@!@K" ; TYPE GT_MEMO ; STYLE GS_BORDER ; MESSAGE "Enter a Memo string here - Use CTRL-UP/CTRL-DN arrow to move to Prev/Next get..." ***CheckBox @ 305, 125 GET lCheckBox ID GET_EIGHT ; CAPTION "Cool guy" ; FONT hObjFont2 ; TEXTCOLOR NTK_RGB(255,128,128) ; BACKCOLOR NTK_RGB(255,0,0) ; STYLE BS_FLAT ; BACKBRUSH NTK_GetStockObject( WHITE_BRUSH) ; MESSAGE "Press Space Bar to Enable or Disable ..." @ 330, 125 GET aLbSel ID GET_NINE ; SIZE 60,150 ; CAPTION aLbChoices ; TYPE GXT_LISTBOX ; FONT hObjFont2 ; TEXTCOLOR NTK_RGB(000,000,128) ; BACKCOLOR NTK_RGB(255,255,128) ; STYLE GS_3DRAISED + WS_VSCROLL + LBS_NOTIFY + ; LBS_MULTIPLESEL ; MESSAGE "Select one or more fruits ..." // -------- From here, we START making the RADIO BUTTON GROUP named GRP_FAVORITE_OS @ 110, 430 GET lCheckBox1 ID ID_GETRB1 ; SIZE 20,100 ; CAPTION "Gnu/Linux" ; TYPE GXT_RADIOBUTTON + "GRP_FAVORITE_OS" ; FONT NTK_GetStockObject(ANSI_VAR_FONT) ; TEXTCOLOR NTK_RGB(000,255,000) ; BACKCOLOR NTK_RGB(255,255,065) ; BACKBRUSH NTK_GetStockObject( WHITE_BRUSH) ; STYLE WS_GROUP + BS_FLAT ; // BS_PUSHLIKE MESSAGE "Click here or press space bar for GNU/Linux..." @ 140, 430 GET lCheckBox2 ID ID_GETRB2 ; SIZE 20,100 ; CAPTION "MS Windows" ; TYPE GXT_RADIOBUTTON + "GRP_FAVORITE_OS" ; FONT NTK_GetStockObject(ANSI_VAR_FONT) ; TEXTCOLOR NTK_RGB(000,128,000) ; BACKCOLOR NTK_RGB(255,255,065) ; BACKBRUSH NTK_GetStockObject( WHITE_BRUSH) ; STYLE BS_FLAT ;// BS_PUSHLIKE MESSAGE "Click here or press space bar for MSWindows..." @ 170, 430 GET lCheckBox3 ID ID_GETRB3 ; SIZE 20,100 ; CAPTION "Mac OS" ; TYPE GXT_RADIOBUTTON + "GRP_FAVORITE_OS" ; FONT NTK_GetStockObject(ANSI_VAR_FONT) ; TEXTCOLOR NTK_RGB(000,096,000) ; BACKCOLOR TRANSPARENT ; BACKBRUSH NTK_GetStockObject( WHITE_BRUSH ) ; STYLE BS_FLAT ;// BS_PUSHLIKE MESSAGE "Click here or press space bar for MacOs..." ** ** ** **We now declare our buttons @ 330, 430 BUTTON "EXIT (Esc)" SIZE 30,160 ; ID ID_BTN0 ; STYLE BS_DEFPUSHBUTTON ; FONT hObjFONT2 ; SUPER ACCEL KEY K_ESC ; ACTION NTK_ReadEscape(hWndMain) ; // Use NTK_ReadEscape|Validate() when your window wait state pump is based upon READ/NTK_ReadModal() STATE NTK_BT_ENABLE ; OF hWndMain // ACTION NTK_SendCloseEvent() ; // Tells NTK RAD system to call the ON EXIT proc. @ 360, 430 BUTTON "SAVE DATA (F10)" SIZE 30,160 ; ID ID_BTN1 ; STYLE BS_PUSHLIKE ; FONT hObjFONT2 ; SUPER ACCEL KEY K_F10 ; ACTION REPL_FCGet(hWndMain) ; STATE NTK_BT_ENABLE ; OF hWndMain @ 230, 430 BUTTON "Previous (-)" SIZE 30,80 ; ID ID_BTN2 ; STYLE BS_PUSHLIKE ; FONT hObjFONT2 ; SUPER ACCEL KEY K_GMINUS ; ACTION PREV_FCGet() ; STATE NTK_BT_ENABLE ; OF hWndMain @ 230, 510 BUTTON "Next (+)" SIZE 30,80 ; ID ID_BTN3 ; STYLE BS_PUSHLIKE ; FONT hObjFONT2 ; SUPER ACCEL KEY K_GPLUS ; ACTION NEXT_FCGet() ; STATE NTK_BT_ENABLE ; OF hWndMain @ 260, 510 BUTTON "Go to Last" SIZE 30,80 ; ID ID_BTN4 ; STYLE BS_PUSHLIKE ; FONT hObjFONT2 ; SUPER ACCEL KEY K_END ; ACTION LAST_FCGet() ; STATE NTK_BT_ENABLE ; OF hWndMain @ 260, 430 BUTTON "Go to First" SIZE 30,80 ; ID ID_BTN5 ; STYLE BS_PUSHLIKE ; FONT hObjFONT2 ; SUPER ACCEL KEY K_HOME ; ACTION FIRST_FCGet() ; STATE NTK_BT_ENABLE ; OF hWndMain @ 300, 430 BUTTON "Add (F2)" SIZE 30,80 ; ID ID_BTN6 ; STYLE BS_PUSHLIKE ; FONT hObjFONT2 ; SUPER ACCEL KEY K_F2 ; ACTION ADD_FCGet() ; STATE NTK_BT_ENABLE ; OF hWndMain @ 300, 510 BUTTON "Remove (F3)" SIZE 30,80 ; ID ID_BTN7 ; STYLE BS_PUSHLIKE ; FONT hObjFONT2 ; SUPER ACCEL KEY K_F3 ; ACTION DEL_FCGet(hWndMain) ; STATE NTK_BT_ENABLE ; OF hWndMain IF Present=="N" DO INIT_FCGet ELSE DO VARI_FCGet ENDIF DO DISP_FCGet ACTIVATE WINDOW hWndMain NORMAL // Display the current window and its child controls **AUTO MANAGE EVENTS OF WINDOW hWndMain // Start processing background events (animate the current window) // Not useful here because READ Clause does it the same + Get management // -- Allow or not Up/Dn/Enter Key to exit after last get lOldReadState := NTK_ReadExit( .F. ) // .F. means not allowed. So, we will loop to first get... DO WHILE NTK_IsWindow(hWndMain) // ------------ Invoke Get Reader System and auto process window's events ** READ // Strict Minimum declaration (just READ) READ INTO hWndMain ; // Complete declaration : START FROM 1 ; BUTTON LIST aBtnList ; MSG FONT hObjfont2 ; MSG AT 430, 1,630 ; //Place the help message X,Y,Width MSG COLOR NTK_RGB(000,000,000) // Help Text foreground will be black ** MSG FONT hHLPFont //If you want to use another font than the default font ** FOCUS COLOR NTK_RGB(239,215,169) ; // Current Focused (selected) Gget color will be LT Brown IF NTK_LastKey()==K_ESC .OR. NTK_LastKey()==K_ALT_F4 .OR. NTK_LASTBTN()==-1 IF DoQuit(hWndmain) EXIT ENDIF ENDIF ENDDO // Back to previous state NTK_ReadExit( lOldReadState ) **If you want some debug tips, you can show vars value when exiting main window **NTK_MsgBox( , sString1, "sString1=" ) **cStr := "" **FOR nI := 1 TO Len( aLbSel ) ** cStr := cStr + aLbSel[nI] + CHR(13) **NEXT **NTK_MsgBox( , cStr, "aLbSel selected items are :" ) // ---------------------------- Destroy all Gets (and clear aGetList[]) belonging to this window. CLEAR GETS OF hWndMain // Note: This command kills all gets of hWndMain and remove their trace // from current aGetlist. Thus, NTK RAD's Internal WndProc doesn't // call anymore NTK_GetCtrl() each time a WM_COMMAND occurs. // So, READ has no effect... CLEAR BUTTONS OF hWndMain // Same remark as above. **We need to delete our custom content, if not some memory will not be released NTK_DeleteObject(hMyBox) **NTK_DeleteObject(hMyBoxMask) NTK_DeleteObject(hMyBmpHeader) NTK_DeleteObject(hMyBmpLinux) *NTK_DeleteObject(hMyBmpShield) DELETE FONT hObjFONT1 DELETE FONT hObjFONT2 DELETE BRUSH hGetBkClrBrush DELETE BRUSH hBkClrBrush CLOSE DATABASES CLOSE WINDOW hWndMain RETURN ********** ********** ********** FUNCTION DoQuit(hWnd,Msg,wParam,lParam) IF NTK_MsgBox( hWnd,; "Are you sure to quit ?",; "Warning !",; MB_OKCANCEL+MB_ICONQUESTION ) == IDOK NTK_ReadEscape() RETURN( NTK_SendQuitEvent() ) ENDIF RETURN(.F.) // Do not quit, keep on current task ********** ********** ********** FUNCTION DOREPAINT(hWnd, message, nwParam, nlParam, hDC) **We can create box with clipper's style declaration, we can use new windows style too ( 3D_sunken for example) **We can use one of this style for our box **NTK_BXS_NORMAL **NTK_BXS_SIMPLE **NTK_BXS_DOUBLE **NTK_BXS_ROUNDED **NTK_BXS_3DRAISED **NTK_BXS_3DSUNKEN NTK_DrawBmp( hDC, hMyBmpHeader, 0, 0, SRCCOPY ) **We can use SET RGB to define box's border color and background color SET RGB COLOR TEXT NTK_RGB(115,147,225) ; // Define your own blend on fly... BACKGND NTK_RGB(255,255,255) **Now place the box with this style and the drawing context @ 90, 05, 400, 400 BOX NTK_BXS_SIMPLE INTO CONTEXT hDC **First Box header SET RGB COLOR TEXT NTK_RGB(115,147,225) BACKGND NTK_RGB(214,223,247) @ 75, 05, 92, 400 BOX NTK_BXS_SIMPLE INTO CONTEXT hDC **Second box with this header SET RGB COLOR TEXT NTK_RGB(115,147,225) BACKGND NTK_RGB(255,255,255) @ 90, 420, 200, 600 BOX NTK_BXS_SIMPLE INTO CONTEXT hDC **Header SET RGB COLOR TEXT NTK_RGB(115,147,225) BACKGND NTK_RGB(214,223,247) @ 75, 420, 92, 600 BOX NTK_BXS_SIMPLE INTO CONTEXT hDC **Third box with this header SET RGB COLOR TEXT NTK_RGB(115,147,225) BACKGND NTK_RGB(255,255,255) @ 210, 420, 400, 600 BOX NTK_BXS_SIMPLE INTO CONTEXT hDC **Header SET RGB COLOR TEXT NTK_RGB(115,147,225) BACKGND NTK_RGB(214,223,247) @ 210, 420, 227, 600 BOX NTK_BXS_SIMPLE INTO CONTEXT hDC **Help Box SET RGB COLOR TEXT NTK_RGB(115,147,225) BACKGND NTK_RGB(255,255,255) @ 420, 2, 450, 616 BOX NTK_BXS_ROUNDED INTO CONTEXT hDC **If you don't want to use RGB color you can use old school Clippers color **@ 90, 450, 350, 600 BOX NTK_BXS_3DSUNKEN INTO CONTEXT hDC COLOR "N/W" DrawBmpTransparent( hDC, hMyBmpLinux, 2, 375, NTK_RGB(255,255,255), 1 ) // Here we cant set max transparency. Fun, isn't it @ 50,400 SAY "My First NTK RAD APPLICATION"; INTO CONTEXT hDC ; TEXTCOLOR NTK_RGB(255,255,255) ; FONT hObjFONT1 ; BACKCOLOR TRANSPARENT ; STYLE DT_CENTER @ 77,10 SAY ".::Customer Information::." ; INTO CONTEXT hDC ; TEXTCOLOR NTK_RGB(0,0,0) ; BACKCOLOR TRANSPARENT ; FONT hObjFONT2 ; STYLE DT_CENTER @ 100,10 SAY "First Name :" ; INTO CONTEXT hDC ; TEXTCOLOR NTK_RGB(0,0,0) ; BACKCOLOR TRANSPARENT ; STYLE DT_CENTER @ 100,105 SAY "*" TEXTCOLOR NTK_RGB(255,0,0) // Symbolises this gets absolutly need to be filled... @ 125,10 SAY "Last Name :" ; INTO CONTEXT hDC ; TEXTCOLOR NTK_RGB(0,0,0) ; BACKCOLOR TRANSPARENT ; STYLE DT_CENTER @ 150,10 SAY "Address 1 :" ; INTO CONTEXT hDC ; TEXTCOLOR NTK_RGB(0,0,0) ; BACKCOLOR TRANSPARENT ; STYLE DT_CENTER @ 175,10 SAY "Address 2 :" ; INTO CONTEXT hDC ; TEXTCOLOR NTK_RGB(0,0,0) ; BACKCOLOR TRANSPARENT ; STYLE DT_CENTER @ 200,10 SAY "Phone Number :" ; INTO CONTEXT hDC ; TEXTCOLOR NTK_RGB(0,0,0) ; BACKCOLOR TRANSPARENT ; STYLE DT_CENTER @ 225,10 SAY "Gender :" ; INTO CONTEXT hDC ; TEXTCOLOR NTK_RGB(0,0,0) ; BACKCOLOR TRANSPARENT ; STYLE DT_CENTER @ 250,10 SAY "Notes :" ; INTO CONTEXT hDC ; TEXTCOLOR NTK_RGB(0,0,0) ; BACKCOLOR TRANSPARENT ; STYLE DT_CENTER @ 305,10 SAY "Special :" ; INTO CONTEXT hDC ; TEXTCOLOR NTK_RGB(0,0,0) ; BACKCOLOR TRANSPARENT ; STYLE DT_CENTER @ 330,10 SAY "Buy Fruit(s) :" ; INTO CONTEXT hDC ; TEXTCOLOR NTK_RGB(0,0,0) ; BACKCOLOR TRANSPARENT ; STYLE DT_CENTER @ 77,430 SAY ".::Favorite OS::." ; INTO CONTEXT hDC ; TEXTCOLOR NTK_RGB(0,0,0) ; BACKCOLOR TRANSPARENT ; FONT hObjFONT2 ; STYLE DT_CENTER @ 212,430 SAY ".::Manage records::." ; INTO CONTEXT hDC ; TEXTCOLOR NTK_RGB(0,0,0) ; BACKCOLOR TRANSPARENT ; FONT hObjFONT2 ; STYLE DT_CENTER RETURN( Nil ) ********** ********** ********** RETURN Nil ********** ********** ********** **Show the about box FUNCTION DOABOUT(hwnd, cDispMsg) IF PCOUNT() < 2 cDispMsg :="" hWnd := NTK_SelectWindow() ELSEIF PCOUNT() < 1 hWnd := NTK_SelectWindow() ENDIF NTK_MsgBox( hWnd,; "Current Active Get is ID #"+ALLTRIM(STR( NTK_GiveGetActive(aGetList) ))+CR+CR+; "FaNcY get"+CR+; ALLTRIM(cDispMsg)+CR+; "Developped with NTKcore for X/HARBOUR."+CR+; "¸ 2004-2006 Jn Dechereux.",; "About...",; MB_OK+MB_ICONASTERISK ) RETURN(Nil) ********** ********** ********** PROCEDURE INIT_FCGet **We need to initialize the content's get sString1:= SPACE(20) sString2:= SPACE(20) sString3:= SPACE(30) sString4:= SPACE(30) sString5:= SPACE(15) **Memo get sMemo1 := "" **Dropdown list get sMySelection := "Male" aCbChoices := { "Male", "Female", "Alien"} **Default State Radio button box lCheckBox1 := .T. lCheckBox2 := .F. lCheckBox3 := .F. **CheckBox default state lCheckBox := .T. **ListBox Default selected and list box choices aLbSel := { "Banana", "Peach" } aLbChoices := { "Plum", "Banana", "Apple", "Peach", "Apricot" } // or only "Orange" DO DISP_FCGet RETURN ********** ********** ********** PROCEDURE DISP_FCGet REDEFINE GETS // same as REFRESH GETS RETURN ********** ********** ********** PROCEDURE VARI_FCGet SELECT 1 **We need to Load gets content from the dbf record sString1:= 1->FNAME sString2:= 1->LNAME sString3:= 1->ADDR1 sString4:= 1->ADDR2 sString5:= 1->PHONE **Memo get sMemo1 := 1->NOTES **NTK_messagebox(,STR(sMemo1)) **Dropdown list get aCbChoices := { "Male", "Female", "Alien"} IF 1->GENDER==1 sMySelection := "Male" ELSEIF 1->GENDER==2 sMySelection := "Female" ELSE sMySelection := "Alien" ENDIF **Default State Radio button box IF 1->OS <= 1 .OR. 1->OS > 3 lCheckBox1 := .T. lCheckBox2 := .F. lCheckBox3 := .F. ELSEIF 1->OS == 2 lCheckBox1 := .F. lCheckBox2 := .T. lCheckBox3 := .F. ELSE // Third choice is implicit lCheckBox1 := .F. lCheckBox2 := .F. lCheckBox3 := .T. ENDIF **CheckBox default state lCheckBox := 1->COOLG **ListBox Default selected and list box choices aLbSel := {} // { "Banana", "Peach" } ***aLbChoices := { "Plum", "Banana", "Apple", "Peach", "Apricot" } // or only "Orange" // Keep in mind that: // a) The maximum number of possible choices is LEN(aLbChoices). 5 in this example. // b) Each selected choice by the user has been previously stored in the FRUIT field following this rule : // - Choice possible values is : 1=Checked / Space or 0=Not Checked // - So, in our example, if the user multiple selection is "Banana, Apple and Apricot", // the char FRUIT field looks like something like this : "01101" // Now we want to built our aLbSel array from from values stored in FRUIT field. FOR nF := 1 TO LEN(aLbChoices) IF SUBSTR( 1->FRUIT, nF, 1 ) == "1" AADD( aLbSel, aLbChoices[nF] ) ENDIF NEXT REDEFINE GETS RETURN ********** ********** ********** **Previous function, will move database pointer to the previous record. (Skip-1) PROCEDURE PREV_FCGet SELECT 1 SKIP -1 IF BOF() TONE(1300,5) GO TOP ENDIF PRESENT="Y" DO VARI_FCGet DO DISP_FCGet RETURN ********** ********** ********** **Next function, will move database pointer to the next record. (Skip) PROCEDURE NEXT_FCGet SELECT 1 SKIP IF EOF() TONE(80,5) GO BOTTOM ENDIF PRESENT="Y" DO VARI_FCGet DO DISP_FCGet RETURN ********** ********** ********** **FIRST function, will move database pointer to the first record. (GOTO TOP) PROCEDURE FIRST_FCGet SET CURSOR OFF GOTO TOP TONE(1300,5) DO VARI_FCGet DO DISP_FCGet SET CURSOR ON RETURN ********** ********** ********** **LAST function, will move database pointer to the last record. (GOTO BOTTOM) PROCEDURE LAST_FCGet SET CURSOR OFF GOTO BOTTOM IF EOF() SKIP -1 ENDIF TONE(80,5) DO VARI_FCGet DO DISP_FCGet SET CURSOR ON RETURN ********** ********** ********** PROCEDURE ADD_FCGet **We set EntryMode to C (Create) and when we replace data it will append blank into our database EntryMode:="C" **Prepare Widgets to receive the new data by reinitializing them from fields DO INIT_FCGet ** Force focus to fisrt get NTK_SelectGetFocus( aGetList, GET_ONE ) RETURN ********** ********** ********** PROCEDURE REPL_FCGet(hWnd) LOCAL nCh, cLbBitMask **We need to set again the select on the good database **Don't forget you are in windowed environnement and if you are multiple windows, **you must be sure by force the select each time we need to use it. SELECT 1 IF NTK_MsgBox( hWnd,; "Really want to save data ?",; "Warning !",; MB_OKCANCEL+MB_ICONQUESTION ) != IDOK RETURN ENDIF **If we are in creation mode, we add a new entry to our database IF EntryMode == "C" APPEND BLANK EntryMode := "M" // Don't forget to replace it to "M", otherwise there's a serious risk of empty recording... ENDIF **We need to replace gets contents into database REPLACE 1->FNAME WITH sString1 REPLACE 1->LNAME WITH sString2 REPLACE 1->ADDR1 WITH sString3 REPLACE 1->ADDR2 WITH sString4 REPLACE 1->PHONE WITH sString5 **Dropdown list IF sMySelection=="Male" REPLACE 1->GENDER WITH 1 ELSEIF sMySelection=="Female" REPLACE 1->GENDER WITH 2 ELSE REPLACE 1->GENDER WITH 3 ENDIF **Memo get REPLACE 1->NOTES WITH sMemo1 **CheckBox default state REPLACE 1->COOLG WITH lCheckBox **Detect radio box selection // NTK_MsgBox(, "RB Linux="+IIF(lCheckBox1, ".T.", ".F.")+CR+; // "RB Win32="+IIF(lCheckBox2, ".T.", ".F.")+CR+; // "RB MacOS="+IIF(lCheckBox3, ".T.", ".F."),; // "State of each RB Group element" ) IF lCheckBox1 == .T. REPLACE 1->OS WITH 1 ENDIF IF lCheckBox2 == .T. REPLACE 1->OS WITH 2 ENDIF IF lCheckBox3 == .T. REPLACE 1->OS WITH 3 ENDIF **Multi-choices ListBox replacement of selected items ** aLbSel := {} // { "Banana", "Peach" } ** aLbChoices := { "Plum", "Banana", "Apple", "Peach", "Apricot" } // or only "Orange" ** We're going to built a bitmask string representing of aLbSel array selected items into aLBChoices. ** Selected Items will be set to "1", others to "0". cLbBitMask := "" FOR nCh := 1 TO LEN(aLbChoices) nPos := ASCAN( aLbSel, { |aVal| aVal==aLbChoices[nCh] } ) cLbBitMask += IIF( nPos > 0, "1", "0" ) NEXT ***NTK_MsgBox(, cLbBitMask, "User's bitMask fruit selection is" ) REPLACE 1->FRUIT WITH cLbBitMask **Commit data into database COMMIT RETURN ********** ********** ********** **DELETE function, will remove record from a database (DELETE) FUNCTION DEL_FCGet(hWndMain) * IF LASTREC() == 0 RETURN ENDIF * **If no record IF Present == "N" **DO RECH_2 **IF Present == "N" RETURN **ENDIF ENDIF IF NTK_MsgBox( hWndMain,; "Really delete record ?",; "Warning !",; MB_OKCANCEL+MB_ICONQUESTION ) != IDOK RETURN ENDIF * *Delete the record DELETE tone(1300,2) * SKIP IF EOF() SKIP -1 ENDIF * IF LASTREC() == 0 DO INIT_FCGet Present := "N" ELSE DO VARI_FCGet Present := "Y" ENDIF DO DISP_FCGet * RETURN ********** ********** ********** FUNCTION TESTGET1(hWndMain) IF EMPTY(sString1) NTK_MsgBox( hWndMain, "This area must be filled!", "Firstname area", MB_ICONEXCLAMATION+MB_OK) sString1 := "You need a first name" **sString2 := "Tata yoyo..." **sString3 := "Far away from here..." **lCheckBox := .F. **NTK_RefreshGet(-1, hWndMain) // Means only all Gets from parent hWnd, will be refresh REFRESH ALL GETS OF hWndMain **NTK_RefreshGet(-1) // Means all Gets will be refresh *REFRESH ALL GETS **NTK_RefreshGet(GET_ONE) // Means only the specified Get will be refresh *REFRESH GET ID GET_ONE *RETURN .F. ENDIF RETURN .T. ********** ********** ********** FUNCTION TESTGET2(hWndMain) IF EMPTY(sString2) NTK_MsgBox( hWndMain, "This area must be filled!", "Lastname area", MB_ICONEXCLAMATION+MB_OK) sString2 := "You need a last name" REFRESH ALL GETS OF hWndMain ENDIF RETURN .T. ********** ********** ********** FUNCTION IMPR_FCGET(hWndMain) LOCAL cFilToPrint := "./files/fancyget.RPT" LOCAL TMPFIFCG := "./files/TMPFCGET.DBF" LOCAL aDbCli := NTKexSaveDBenv() IF !FILE(cFilToPrint) PRIVATE B := {} AADD( B, { " [Ech]=ABANDONNER ", K_ESC } ) NTK_MessageBox( hWndMain, "RPT Error : "+ALLTRIM(cFilToPrint)+Chr(13)+" file is corrupted or doesn't exist...", "Lastname area", MB_ICONEXCLAMATION+MB_OK) RETURN ENDIF **Change mouse cursor and set hourglass mode NTK_HOURGLASS(1) IF FILE(TMPFIFCG) ERASE(TMPFIFCG) ERASE( StrTran(TMPFIFCG,".DBF", ".DBT") ) ENDIF **Copy actual database into a temporary file SELECT 1 COPY TO (TMPFIFCG) **Disable hourglass mode NTK_HOURGLASS(0) **Call the Ntk function to print reports from crystal NTKPRT_CRWRPT( cFilToPrint, "Customers file report..." ,1,1 ) NTKexRestDBenv(aDbCli) RETURN ********** ********** ********** **Local function for drawing bitmap with a transparent mask STATIC FUNCTION DrawBmpTransparent( hDC, hBmp, nX, nY, nTransparentClr, nTransparencyLevel ) LOCAL hBmpMask nTransparencyLevel := IIF( VALTYPE(nTransparencyLevel) !="N", 0, nTransparencyLevel ) // 0=Normal, 1=High nX := IIF( VALTYPE(nX) !="N", 0, nX ) nY := IIF( VALTYPE(nY) !="N", 0, nY ) hBmpMask := NTK_CreateBmpMask( hBmp, nTransparentClr ) IF nTransparencyLevel > 0 NTK_DrawBmp( hDC, NTK_NOT(hBmpMask) , nX, nY, SRCPAINT ) ELSE NTK_DrawBmp( hDC, NTK_OR(hBmpMask), nX, nY, SRCPAINT ) ENDIF NTK_DrawBmp( hDC, hBmp , nX, nY, SRCAND ) NTK_DeleteObject( hBmpMask ) RETURN( Nil ) ********** ********** ********** **Local function FUNCTION CenterWindow(cxSize,cySize) **__Center a window into the current screen, receive height and width of child, return the approximate center position__** ** LOCAL _CXSCREEN := NTK_GetDeviceCaps( NTK_GetDC(), HORZRES ) LOCAL _CYSCREEN := NTK_GetDeviceCaps( NTK_GetDC(), VERTRES ) LOCAL cx,cy cx:=(_CXSCREEN-cxSize)/2 cy:=(_CYSCREEN-cySize)/2 RETURN({cx,cy}) ********** ********** **********