******************************************************************************* * Program : BRTEST.PRG * Launch BRTEST.EXE * Goal : Demonstrate how to mix different programming styles using * NtkTBrowse OO Classe and both NTKCore+NTKRad * Make : Just type MKRAD BRTEST * Date : 11/10/04 * Author(s) : Jn DECHEREUX * Copyright : (c) 2004 - Jn DECHEREUX. Tous droits r‚serv‚s/All Rights Reserved. ******************************************************************************** #include "ntkacc.ch" #include "ntkgdi.ch" #include "ntkmsg.ch" #include "ntkmenus.ch" #include "windows.ch" #include "ntkcctrl.ch" #include "ntkcmdlg.ch" #include "ntkdlg.ch" #include "ntkedget.ch" #include "ntkcmd.ch" #include "wNtk.ch" #include "wNtkKeys.ch" // -- Manifest Windows XP //#define ISOLATION_AWARE_ENABLED 1 // remove remarks if you want fancy XP Theme buttons. #define CR chr(13)+chr(10) #define C_RED NTK_RGB(255,0,0) #define C_DARKRED NTK_RGB(128, 0, 0) #define C_PINK NTK_RGB(255, 0, 128) #define C_BLUE NTK_RGB(0,0,255) #define C_DARKBLUE NTK_RGB(0, 0, 128) #define C_GREEN NTK_RGB(0,255,0) #define C_DARKGREEN NTK_RGB(0,128,0) #define C_MAGENTA NTK_RGB(255,0,255) #define C_DARKMAGENTA NTK_RGB(128,0,128) #define C_BLACK NTK_RGB(0,0,0) #define C_WHITE NTK_RGB(255,255,255) #define C_GREY NTK_RGB(192, 192, 192) #define C_DARKGREY NTK_RGB(128, 128, 128) #define C_GREYDARK NTK_RGB(100, 100, 100) #define C_YELLOW NTK_RGB(255, 255, 0) #define C_LIGHTYELLOW NTK_RGB(255, 255, 185) #define C_OCKER NTK_RGB(128, 128, 0) #define C_CYAN NTK_RGB(0, 128, 128) #define C_LIGHTCYAN NTK_RGB(0, 255, 255) #define C_PURPLE NTK_RGB(128, 0, 128) #define ID_GETEDIT1 7001 // unique id (used for the get control) FUNCTION MAIN() LOCAL cMsg LOCAL NTK_aMSG := { 0,0,0,0,0,0,0 } // 7 elements, see NTKMSG.CH LOCAL hInst := NTK_GetInstance() //LOCAL hIcon := NTK_LoadIcon( Nil , IDI_HAND ) // IDI_APPLICATION) LOCAL hIcon := NTK_LoadIcon( NTK_GetInstance() , "rICO01" ) // IDI_APPLICATION) LOCAL hCurs := NTK_LoadCursor( Nil , IDC_ARROW) LOCAL hBrush := NTK_GetStockObject(GRAY_BRUSH) // DKGRAY_BRUSH, LTGRAY_BRUSH, WHITE_BRUSH ... LOCAL cWinTitle := "DataGrid/Browse object: How to mix NTKCore+NtkTBrowse OO Class+NTKRad programming styles!" LOCAL hWndDemo LOCAL aMenu, aPopupMenu, aPopupSubMenu PRIVATE hTBParent // Handle to the current active browse (if any) parent window/container. PRIVATE aDemoFont1 PRIVATE hDemoFont1 PRIVATE cMenuHlpMsg := "" //SET CENTURY ON SET EPOCH TO 1980 IF !NTK_RegisterClassEx( CS_HREDRAW + CS_VREDRAW,; // CS_OWNDC + CS_VREDRAW + CS_HREDRAW + CS_DBLCLKS,; hInst,; hIcon,; hCurs,; hBrush,; "MAINCLASS",; { |hWnd, message, nwParam, nlParam|; MAINWNDPROC(hWnd, message, nwParam, nlParam) } ) NTK_MsgBox( , "Can't register MAINCLASS class..." ) RETURN Nil ENDIF IF !NTK_RegisterClassEx( CS_HREDRAW + CS_VREDRAW,; // CS_OWNDC + CS_VREDRAW + CS_HREDRAW + CS_DBLCLKS,; hInst,; hIcon,; hCurs,; NTK_GetStockObject(WHITE_BRUSH) ,; "MYBROWSE",; { |hWnd, message, nwParam, nlParam|; MYWNDPROC(hWnd, message, nwParam, nlParam) } ) NTK_MsgBox( , "Can't register MYBROWSE class..." ) RETURN Nil ENDIF // ----- Ensure that the common control dynamic-link library (DLL) is loaded. // ----- Don't forget to use this command if you plan to use controls such as DatePicker, tooltips... NTK_InitCommonControlsEx( ICC_DATE_CLASSES + ICC_BAR_CLASSES + ICC_LISTVIEW_CLASSES ); hWndDemo = NTK_CreateWindowEx( WS_EX_WINDOWEDGE, "MAINCLASS", cWinTitle, ; F_MIN+F_MAX+WS_SIZEBOX+WS_SYSMENU, ; 0, 0, 640, 480 ) IF hWndDemo == 0 NTK_MsgBox( , "Can not create Window..." ) RETURN Nil ENDIF aDemoFont1 := { -48,12,0,0,700, .F., .F., .F., 1, 0, 0, 0, 0, "ARIAL" } hDemoFont1 := NTK_CreateFont( aDemoFont1 ) IF hDemoFont1 == 0 NTK_MsgBox( , "Cannot create DemoFont1..." ) RETURN Nil ENDIF aMenu := NtkCreateMenu() aPopupMenu := NtkCreatePopupMenu() NtkAppendMenu(aPopupMenu, "GRID", MF_ENABLED + MF_STRING, "&Browse", {|| DoBrowse(hWndDemo) }, "Browse creation..." ) NtkAppendMenu(aPopupMenu, "", MF_SEPARATOR) NtkAppendMenu(aPopupMenu, "QUIT", MF_ENABLED + MF_STRING, "E&xit", {|| DoQUIT() } , "Quit this program." ) NtkAppendMenu( aMenu, "DMO", MF_ENABLED + MF_POPUP, "&Demos", aPopupMenu, "Demonstration of blend NTK's programming styles..." ) aPopupMenu := NtkCreatePopupMenu() NtkAppendMenu( aPopupMenu, "ABOUT", MF_ENABLED + MF_STRING, "&About", {|| DOABOUT() },"Help or information about this program..." ) NtkAppendMenu( aMenu, "INFO", MF_ENABLED + MF_POPUP, "&?", aPopupMenu, "About this program..." ) lRet := NtkSetMenu(hWndDemo, aMenu) NTK_ShowWindow( hWndDemo, SW_MAXIMIZE ) NTK_UpdateWindow( hWndDemo ) // ---------------------------------- NTK's Main Events (Windows Msg) Loop DO WHILE NTK_GetMessage( NTK_aMSG, 0 ) // hWndDemo, 0,0 ) NTK_TranslateMessage( NTK_aMSG ) NTK_DispatchMessage( NTK_aMSG ) ENDDO NTK_DeleteObject( hDemoFont1 ) NTK_SelectWindow( hWndDemo ) NTK_DestroyWindow( hWndDemo ) NTK_UnregisterClass( "MYBROWSE", hInst ) NTK_UnregisterClass( "MAINCLASS", hInst ) RETURN ****** ****** ****** FUNCTION DOABOUT(hwnd, cDispMsg) NTK_MsgBox( hWnd,; "¸ 2002-2004 Jn Dechereux.",; "About...",; MB_OK+MB_ICONASTERISK ) RETURN(Nil) ****** ****** ****** FUNCTION DOQUIT(hwnd) IF NTK_MsgBox( hWnd,; "Do you really want to quit ?",; "That's all Folks !",; MB_OKCANCEL+MB_ICONQUESTION ) == IDOK NTK_PostQuitMessage(0) RETURN .T. ENDIF RETURN .F. ****** ****** ****** FUNCTION MAINWNDPROC( hWnd, message, nwParam, nlParam) LOCAL aPS := { 0,.T.,0,0,0,0,.T.,.T.,nil } // 9 elements, see NTKGDI.CH LOCAL hDC := 0 LOCAL nRed := NTK_RGB(255,0,0) LOCAL nDkGray := NTK_RGB(164,164,164) LOCAL hMyIcon := NTK_LoadIcon( , IDI_ASTERISK ) // EXCLAMATION LOCAL aCliRect := NTK_GetClientRect(hWnd) LOCAL nXpos, nYpos LOCAL nMenuItem, bMenu DO CASE CASE message == WM_CREATE * NTK_MsgBox( , "aCliRect[4]= "+str(aCliRect[4]), MB_OK+MB_ICONHAND ) CASE message == WM_CHAR IF nwParam==27 // K_ESC DoQuit(hWnd) ENDIF CASE message == WM_RBUTTONDOWN DoQuit(hWnd) CASE message == WM_SYSCOMMAND IF nwParam == SC_CLOSE // system menu double click, or Alt-F4 IF DoQuit(hWnd) **tone(130,1) **tone(130,1) ENDIF ENDIF **RETURN 0 CASE message == WM_MENUSELECT nMenuItem := NTK_LoWord(nwParam) cMenuHlpMsg := NtkGetMenuHlpMsg( NtkGetMenu(hWnd), nMenuItem, nlParam ) NTK_InvalidateRect( hWnd,; {0, aCliRect[4]-40, aCliRect[3], aCliRect[4]},; .T. ) CASE message == WM_COMMAND nMenuItem := NTK_LoWord(nwParam) bMenu := NtkGetMenuBlock( NtkGetMenu(hWnd), nMenuItem ) IF !EMPTY(bMenu) // IF bMenu != Nil EVAL(bMenu) // Evaluer le Code Block du Menu RETURN 0 ENDIF CASE message == WM_PAINT hDC := NTK_BEGINPAINT( hWnd, aPS ) //NTK_DrawIcon( hDC,160, 320, hMyIcon ) //NTK_TextOut( hDC, 190, 350, "Press Esc or hit right mouse button to quit..." ) nXpos := (aCliRect[3]-(35*08)) / 2 nYpos := aCliRect[4]-100 NTK_DrawIcon( hDC, nXpos-30, nYpos-30, hMyIcon ) NTK_TextOut( hDC, nXpos, nYpos, "Press Esc or hit right mouse button to quit..." ) NTK_SetTextColor( hDC, nDkGray ) NTK_SetBkMode( hDC, TRANSPARENT ) NTK_DrawText( hDC, cMenuHlpMsg,; { 0, aCliRect[4]-40, aCliRect[3], aCliRect[4] },; DT_CENTER+DT_VCENTER ) NTK_ENDPAINT( hWnd, aPS ) CASE message == WM_CLOSE // WM_DESTROY NTK_PostQuitMessage(0) RETURN(0) ENDCASE RETURN( NTK_DEFWNDPROC(hWnd, message, nwParam, nlParam) ) //RETURN -1 // OR NTK_DEFWNDPROC( ... ) is the same ! ****** ****** ****** ****** ****************************************************************************************** ****** *********************** INTERNAL VARS & SUBROUTINES **************************** ****** ****************************************************************************************** FUNCTION JNDCLSINFO(void) // UNDOC'ed - TOP SECRET ;-) LOCAL cJndClsInfo := " CLASSE - bWNDPROC"+CHR(13) FOR nI := 1 TO LEN(__NTK_aCLASSES) cJndClsInfo := cJndClsInfo + "["+ __NTK_aCLASSES[nI,1] +"] - "+; "["+ VALTYPE(__NTK_aCLASSES[nI,2]) +"]" + CHR(13) NEXT NTK_MsgBox( , cJndClsInfo ) RETURN( Nil ) ****** ****** ****** FUNCTION JNDWNDINFO(void) // UNDOC'ed - TOP SECRET ;-) LOCAL cJndWndInfo := " HWND - CLASSE"+CHR(13) FOR nI := 1 TO LEN(__NTK_aWND) cJndWndInfo := cJndWndInfo + "["+STR(__NTK_aWND[nI,1],15)+"] - "+; "["+ __NTK_aWND[nI,2] +"]" + CHR(13) IF !NTK_ISWINDOW( __NTK_aWND[nI,1]) // if hWnd is no more existing... // Some code ... ENDIF NEXT NTK_MsgBox( , cJndWndInfo ) RETURN( Nil ) ****** ****** ****** ****** ******************************************************************************************* ****** *********************** WINDOWS CREATION **************************** ****** ******************************************************************************************* FUNCTION DoBrowse( hWndMain ) LOCAL hInst := NTK_GetInstance() LOCAL NTK_aMSG := { 0,0,0,0,0,0,0 } // 7 elements, see NTKMSG.CH LOCAL aParentRect := {} LOCAL oCol1, oCol2, oCol3, oCol4, oCol5 IF !EMPTY(hTBParent) NTK_MsgBox( hWndMain, "Only one browse session per database is allowed!", "Your attention Please!", MB_OK+MB_ICONEXCLAMATION ) IF NTK_IsIconic(hTBParent) NTK_ShowWindow(hTBParent, SW_RESTORE) ENDIF RETURN( Nil ) ENDIF PRIVATE oB // Expected to be known by child procedures... PRIVATE aGetList := {} // Must be here! PRIVATE aBtnList := {} // Must be here! hTBParent := NTK_CreateWindowEx( WS_EX_WINDOWEDGE, "MYBROWSE",; "Browse control demo...", ; WS_CHILD + WS_OVERLAPPEDWINDOW + WS_CLIPCHILDREN,; 10, 50, 780, 560, hWndMain, nil, hInst ) //WS_HSCROLL + WS_VSCROLL + WS_SYSMENU, ; //WS_SYSMENU,; IF hTBParent == 0 NTK_MsgBox( , "Can not create browse parent's Window ..." ) RETURN( Nil ) ENDIF aParentRect := NTK_GetClientRect(hTBParent) USE PRODUCT SHARE ALIAS product //USE PRODUCT EXCLUSIVE ALIAS product SKIP 3 // 10 // Move to the thrird occurence of current database in use. // --------- Column's objets : Quick initialization //oCol1:=NtkColumn():Init( "Part number"+chr(13)+"or BarCode" , { || PRODUCT->CODEART } , nil, NTK_RGB(255,255,228), NTK_RGB(55,240,23), DT_LEFT , 100 ) oCol1:=NtkColumn():Init( {"","Part number","or","BarCode"}, { || PRODUCT->CODEART } , nil, NTK_RGB(255,255,228), NTK_RGB(55,240,23), DT_RIGHT, 100 ) oCol2:=NtkColumn():Init( "Description" , { || PRODUCT->DESIGNART+CR+PRODUCT->DESCRIP01 } , nil, nil, nil, DT_LEFT , 300 ) oCol3:=NtkColumn():Init( "Purchase price" , { || STR(PRODUCT->PUAHT,10,2) } , nil, nil, nil, DT_RIGHT, 150 ) oCol4:=NtkColumn():Init( "Sale price" , { || STR(PRODUCT->PUVHT,10,2) } , nil, NTK_RGB(12,15,46), NTK_RGB(200,200,255), DT_RIGHT, 150 ) // --------- #1 Column : Optional Customization... oCol1:HeadColor := NTK_RGB(0,128,0) // Title will appear in Dark Green oCol1:HeadFont := NTK_GetStockObject(DEFAULT_GUI_FONT) oCol1:HeadBmpIndex := OBM_SIZE // COMBO // OLD_CLOSE //COMBO //CLOSE oCol1:HeadBmpAlign := DT_RIGHT oCol1:HeadBmpVAlign := DT_BOTTOM // --------- #2 Column : Optional Customization... //oCol2:Bitmap := OBM_COMBO // DNARROW //COMBO //CLOSE //oCol2:Bitmap := { || IIF( PRODUCT->PUAHT>1, OBM_UPARROW, 0) } //OBM_DNARROW) } // DNARROW //COMBO //CLOSE oCol2:Bitmap := { || IIF( PRODUCT->PUAHT>1, 0, 1502 ) } oCol2:BitAlign := DT_RIGHT+DT_VCENTER //DT_BOTTOM oCol2:HeadAlign := DT_RIGHT+DT_BOTTOM oCol2:HeadBmpIndex := 1501 //OBM_BTNCORNERS // DNARROW //COMBO //CLOSE oCol2:HeadBmpAlign := DT_CENTER oCol2:HeadBmpVAlign := DT_TOP // --------- #3 Column : Optional Customization... oCol3:HeadBmpIndex := OBM_CHECK //COMBO //CLOSE oCol3:HeadBmpAlign := DT_RIGHT //oCol3:HeadBmpVAlign := DT_VCENTER oCol3:fgColor := {|| IIF(PRODUCT->PUAHT<1,NTK_RGB(255,0,0), Nil) } // --------- #4 Column : Optional Customization... // none oB := NtkTBrowse():Init( hTBParent,; 0, 0, aParentRect[RECT_Width], aParentRect[RECT_Height],; "",; WS_CHILD + WS_VISIBLE + WS_OVERLAPPED + WS_THICKFRAME + WS_VSCROLL ) //WS_CHILD+WS_TABSTOP+WS_VISIBLE+WS_DLGFRAME+WS_VSCROLL ) oB:addColumn( oCol1 ) oB:addColumn( oCol2 ) oB:addColumn( oCol3 ) oB:addColumn( oCol4 ) oB:AutoLite := .F. // .F. Hilight focused cell only / .T. Hilight all cells of the row oB:showFocus := .T. // Mimic Windows focus rectangle oB:boxcursor := .F. // Mimics SpreadSheet Cursor focus. (Black thin borders) oB:make3D := .F. // 3D look : Each cell appears to be raised oB:mimicButton:= .T. // Vertical & heading Nubs will work like buttons oB:ColGrids := .T. // We Want LT_GRAY lines (Grid) between each row/col oB:RowGrids := .T. // We Want LT_GRAY lines (Grid) between each row/col oB:userMove := .F. // Allows Col swapping oB:userSize := .T. // Allows Col Resize oB:escape := .F. // User can/can't exit the browse pressing Esc Key. Defaut is .T. oB:HeadHeight := 60 **oB:Headfont := NTK_GetStockObject(DEFAULT_GUI_FONT) //ANSI_VAR_FONT ANSI_FIXED_FONT oB:HeadColor := NTK_RGB( 0,0,255 ) oB:tbfont := NTK_GetStockObject(DEFAULT_GUI_FONT) // ANSI_FIXED_FONT) oB:LineHeight := 32 // 20 // Set the height of the browse rows in pixel. oB:ColorSpec := { NTK_RGB( 0, 0, 255) , NTK_RGB(255, 255, 176) ,; // UnSel Cells/Items fg/bgk NTK_RGB(255, 255, 255) , NTK_RGB(156, 131, 247) ,; // Sel Cells/Items fg/bgk NTK_RGB(184, 184, 184) ; // WndBrowse fg/bkg (unused cells) } // NTK_RGB(255, 255, 255) ; // WndBrowse fg/bkg (unused cells): White // NTK_RGB(184, 184, 184) ; // WndBrowse fg/bkg (unused cells): Lt Gray // --------- Here we're defining Nub's customization oB:showNumbers := .T. // We want to see logical record number on nubs oB:nubWidth := 120 oB:nubHheadBlock := Nil // A codeblock to be evaluated when the user clicks on the "nub" Heading oB:nubHBitmap := 1500 //OBM_CHECK // Bitmap to be drawn into the nub's heading oB:nubHBitAlign := DT_CENTER // Alignment is used for both nub heading's Bitmap/Text... oB:nubHeading := { "File:", "'Products'"} // A character constant/expression/array to be displayed on the "nub" column heading oB:nubHeadColor := NTK_RGB(255,0,0) // RGB() which is used to set the textcolor for the "nub" heading oB:nubHeadBlock := Nil // A codeblock to be evaluated when the user clicks on each "nub" column header oB:nubBlock := {|| PRODUCT->CODEART} // A codeblock. Evaluated for each record read. eg. oB:nubBlock := {||IIF( CONTACT->SEX == 'M', "Male", "Female" ) }) **oB:nubBlock := {|| IIF( PRODUCT->PUAHT<=1, OBM_BTNCORNERS, OBM_COMBO ) } // A codeblock. Evaluated for each record read. eg. oB:nubBlock := {||IIF( CONTACT->SEX == 'M', "Male", "Female" ) }) **oB:nubColor := NTK_RGB(255,128,255) // RGB() which is used to set the textcolor for the "nubs". oB:nubColor := NTK_RGB(0,0,255) // RGB() which is used to set the textcolor for the "nubs". //oB:nubHheadBlock := {|| NTK_MsgBox( oB:hWnd, "You've clicked the nub's heading..."), NTK_SetFocus(oB:hWnd)} oB:nubHheadBlock := {|| DelCol(oB), NTK_SetFocus(oB:hWnd)} oB:nubClickBlock := {|| WhereAmI(oB)} //oB:nubHeadBlock := {|| NTK_MsgBox( oB:hWnd, "You've clicked the nub's Column heading #"+STR(oB:nubHeadClickPos)+"..."), NTK_SetFocus(oB:hWnd)} oB:nubHeadBlock := {|| InsNewCol(oB), NTK_SetFocus(oB:hWnd)} oB:doubleClick := { |oB,nMsg,nWparam,nLparam| EditCell(oB) } // Do edit routine oB:singleClick := { |oB,nMsg,nWparam,nLparam| ExitCell(oB) } // Exit from the active get session (if any), when user singleclick... oB:Configure() NTK_SetFocus(oB:hWnd) NTK_ShowWindow( hTBParent, SW_MAXIMIZE ) // SW_SHOW ) NTK_UpdateWindow( hTBParent ) // ---------------------------------- NTK's Main Events (Windows Msg) Loop DO WHILE NTK_GetMessage( NTK_aMSG, hTBParent) // hTBParent, 0,0 ) NTK_TranslateMessage( NTK_aMSG ) NTK_DispatchMessage( NTK_aMSG ) ENDDO NTK_SelectWindow( hTBParent ) NTK_DestroyWindow( hTBParent ) hTBParent := Nil // indicate there is no more active browse CLOSE DATABASES RETURN(Nil) ****** ****** ****** FUNCTION MYWNDPROC( hWnd, message, nwParam, nlParam) LOCAL aPS := { 0,.T.,0,0,0,0,.T.,.T.,nil } // 9 elements, see NTKGDI.CH LOCAL hDC := 0 LOCAL nRetCD DO CASE CASE message == WM_CREATE *$ CASE message == WM_NOTIFY // Browse Custom drawing management... *$ nRetCD := NtkTBCustomDraw(oB, nlParam) // Requested here *$ IF nRetCD != CDRF_DODEFAULT *$ RETURN( nRetCD ) *$ ENDIF CASE message == WM_CHAR IF nwParam==27 // K_ESC NTK_PostQuitMessage(0) ENDIF CASE message == WM_RBUTTONDOWN NTK_PostQuitMessage(0) CASE message == WM_SYSCOMMAND IF nwParam == SC_CLOSE // system menu double click, or Alt-F4 NTK_PostQuitMessage(0) ENDIF **RETURN 0 CASE message == WM_COMMAND NTK_GetCtrl( aGetList, nwParam, nlParam ) // Must be here! CASE message == WM_CTLCOLOREDIT //RETURN( NTK_GetColor( aGetList, nwParam, nlParam, hGetBrush ) ) RETURN( NTK_GetColor( aGetList, nwParam, nlParam ) ) // default return is WHITE_BRUSH CASE message == WM_PAINT hDC := NTK_BEGINPAINT( hWnd, aPS ) NTK_ENDPAINT( hWnd, aPS ) CASE message == WM_CLOSE // WM_DESTROY NTK_PostQuitMessage(0) RETURN(0) ENDCASE RETURN( NTK_DEFWNDPROC(hWnd, message, nwParam, nlParam) ) ****** ****** ****** ****** ****** ****** FUNCTION EditCell( oB ) LOCAL nPrevGetPos, hOldGet LOCAL lpBuffer, nI LOCAL nCellY, nCellX LOCAL nCellheight, nCellWidth LOCAL lOldReadState, lOldGetMode LOCAL lGetUpdated:= .F. LOCAL cCellName := "" LOCAL aCellValue := Nil LOCAL xCellValue := Nil LOCAL aCellRect := {0,0,0,0} * LOCAL nCol := oB:ColPos LOCAL oCol := oB:getColumn( nCol ) PRIVATE aGetList := {} // Must be here! PRIVATE aBtnList := {} // Must be here! PRIVATE hGetBkClrBrush IF oCol == Nil NTK_MsgBox( oB:hWnd, "Invalid Col #"+STR(nCol), "Error" ) NTK_SetFocus(oB:hWnd) RETURN(nil) ENDIF lpBuffer := oCol:Heading IF VALTYPE( lpBuffer ) == "A" FOR nI := 1 TO LEN(lpBuffer) cCellName += lpBuffer[nI]+CR NEXT cCellName := AllTrim(cCellName) ELSE cCellName := oCol:Heading ENDIF // --- In case of multi-thread apps... An other thread could change the database field //xCellValue := EVAL(oCol:Block) // In case of multi-thread apps... // ------------------------------ more classic apps aCellData := oB:getCellData() // getCellData(nRow,nCol) -> {xData , Picture} xCellValue := aCellData[1] aCellRect := oB:getCellRect() // getCellRect(nRow,nCol) -> {Left,Top,Width,Height} nCellY := aCellRect[RECT_Top] +1 nCellX := aCellRect[RECT_Left] +1 nCellWidth := aCellRect[RECT_Right] -1 nCellheight := aCellRect[RECT_Bottom] -2 **Create a new brush from a RGB CREATE SOLID BRUSH NTK_RGB( 239,243,210) TO hGetBkClrBrush **Set Default Bkg Brush for all gets SET DEFAULT BACKGROUND GETS COLOR BRUSH TO hGetBkClrBrush NTK_SetFocus(oB:hWnd) NTK_SelectWindow(oB:hwnd) IF oB:ColPos == 1 @ nCellY, nCellX GET xCellValue ID ID_GETEDIT1 ; SIZE nCellHeight , nCellWidth ; PICTURE "@!" ; FONT oB:TbFont ; // NTK_GetStockObject(ANSI_FIXED_FONT),; // Get font TEXTCOLOR NTK_RGB(000,000,128) ; // Get ForeGround Color (RGB value) BACKCOLOR NTK_RGB(255,255,128) ; // Get BackGround Color (RGB value) STYLE GS_BORDER ; // Get extra Style (e.g. GS_BORDER, GS_3DRAISED, GS_3DTHICKSUNKEN,...) MESSAGE "Now, you can change the data cell's content..." ELSEIF oB:ColPos == 2 @ nCellY, nCellX GET xCellValue ID ID_GETEDIT1 ; SIZE nCellHeight , nCellWidth ; TYPE GT_MEMO ; FONT oB:TbFont ; // NTK_GetStockObject(ANSI_FIXED_FONT),; // Get font TEXTCOLOR NTK_RGB(255,000,000) ; // Get ForeGround Color (RGB value) BACKCOLOR NTK_RGB(255,255,255) ; // Get BackGround Color (RGB value) STYLE GS_BORDER ; // Get extra Style (e.g. GS_BORDER, GS_3DRAISED, GS_3DTHICKSUNKEN,...) MESSAGE "Now, you can change the data cell's content..." ELSE xCellValue := VAL(xCellValue) @ nCellY, nCellX GET xCellValue ID ID_GETEDIT1 ; SIZE nCellHeight , nCellWidth ; PICTURE "99999.99" ; FONT NTK_GetStockObject(SYSTEM_FONT); // Get font TEXTCOLOR NTK_RGB(000,000,128) ; // Get ForeGround Color (RGB value) BACKCOLOR NTK_RGB(255,255,128) ; // Get BackGround Color (RGB value) STYLE GS_3DSUNKEN ; // Get extra Style (e.g. GS_BORDER, GS_3DRAISED, GS_3DTHICKSUNKEN,...) MESSAGE "Now, you can change the data cell's content..." //FONT oB:TbFont ; // NTK_GetStockObject(ANSI_FIXED_FONT),; // Get font ENDIF **NTK_EnableWindow( oB:hWnd, .F. ) // Browse Desactivation **NTK_EnableWindow( oB:hNubWnd, .F. ) // Browse nub's Desactivation //lOldGetMode := NTK_ReadInsert( .F. ) // Force to switch to overwrite mode lOldReadState := NTK_ReadExit( .T. ) oB:StandByMode(.T.) // Freeze the Browse : can't move anymore, nor allow other action during the Get edtion. ** A basic loop using NTK_GetMessage(), NTK_TranslateMessage(), NTK_DispatchMessage() functions ** is no more needed ! Now, we are using NTK_ReadModal() - 'All-in-one'... // ------------ Get Reader and Windows wait-4-all-events... //just to see lGetUpdated := NTK_ReadModal( oB:hWndMain, aGetList ) // Minimum declaration ** lGetUpdated := NTK_ReadModal( oB:hWndMain, aGetList ) // Minimum declaration or just use READ command ** //NTK_ReadModal( oB:hWndMain, aGetList, 2 ,, 10, Nil, Nil, NTK_RGB(255,0,0) ) READ INTO oB:hWnd TOOLTIP lGetUpdated := NTK_Updated() oB:StandByMode(.F.) // free the Browse and let it works again... NTK_ReadExit( lOldReadState ) //NTK_ReadInsert( lOldGetMode ) IF lGetUpdated IF PRODUCT->(DBRLOCK()) If nCol == 1 REPLACE PRODUCT->CODEART WITH xCellValue ElseIf nCol == 2 REPLACE PRODUCT->DESIGNART WITH LEFT(xCellValue, AT(xCellValue,CR) ) REPLACE PRODUCT->DESCRIP01 WITH SUBSTR(xCellValue, AT(xCellValue,CR)+1 ) ElseIf nCol == 3 REPLACE PRODUCT->PUAHT WITH xcellValue **NTK_MsgBox( , STR(aGetList[1, GET_VAR]), "New value is:" ) ElseIf nCol == 4 REPLACE PRODUCT->PUVHT WITH xCellValue EndIf PRODUCT->(DBUNLOCK()) ENDIF ENDIF // ------------------------ Destroy all Editget(s) and clear aGetList[], thus NTK_ClearGets(aGetList) // NTK_GetCtrl() is no longer activated while aGetList is empty... ***NTK_MsgBox( , STR( LEN(aGetList) ), "Lengh of aGetList is now :" ) DELETE BRUSH hGetBkClrBrush NTK_EnableWindow( oB:hNubWnd, .T. ) // Browse nub's Activation NTK_EnableWindow( oB:hWnd, .T. ) // Browse Activation oB:RefreshCurrent() NTK_SetFocus(oB:hWnd) // ------------------------ Keyb emulation: Mimic spreadsheets way to exit from edit-mode IF NTK_Lastkey()==K_UP NTK_PostMessage( oB:hWnd, WM_KEYDOWN, VK_UP, 0 ) ELSEIF NTK_LastKey==K_PGUP NTK_PostMessage( oB:hWnd, WM_KEYDOWN, VK_PAGEUP, 0 ) ELSEIF NTK_Lastkey()==K_DOWN NTK_PostMessage( oB:hWnd, WM_KEYDOWN, VK_DOWN, 0 ) ELSEIF NTK_LastKey==K_PGDN NTK_PostMessage( oB:hWnd, WM_KEYDOWN, VK_PAGEDN, 0 ) ENDIF RETURN(nil) ****** ****** ****** FUNCTION ExitCell( oB ) LOCAL nPrevGetPos, hOldGet // --------------------------------------------------------------------------------------------- // DID THE USER SINGLECLICKED ON ANOTHER CELL AS HE WAS ALREADY CURRENTLY EDITING A CELL ? // In such a case, the ergonomic rule traditionally applied is to exit from the active get // session (if there's one) and hilite to the new pointed cell. // Making this, the value entered into the previous cell has to be saved/kept. // --------------------------------------------------------------------------------------------- // BEFORE BEGIN A NEW GET SESSION, // We have to TEST and STOP any previous session of EditCell() / GET edition. // Keep in mind that user can double click many times elsewhere into an // other cell of the browse! Furthermore, NTK's GetSystem cannot accept more // the one NTK_ReadModal() session per hWnd // To prevent this user comportment, we just have to scan all lines of the // current aGetList array and search for any hint of oB:hWnd into the col#2 of // the array (See NTKEDGET.CH) and then, force the system to get out of the // NTK_ReadModeal() previous session... nPrevGetPos := ASCAN( aGetList, { |aVal| NTK_GetParent(aVal[GET_HWND])==oB:hWnd } ) IF nPrevGetPos >0 hOldGet := aGetList[nPrevGetPos,GET_HWND] // Found the Edit-GET handle IF aGetList[nPrevGetPos,GET_TYPE]==GT_MEMO * --- Ability of a Memo Get: Quit without saving only. May be later it will be possible to enhance this feature... NTK_PostMessage( hOldGet, WM_KEYDOWN, VK_ESC, 0 ) // Keyb emulation: Force to Exit from the Get without saving. Else * --- Ability of a Normal/standard Get. You can choose your favorite way of doing things... // NTK_PostMessage( hOldGet, WM_KEYDOWN, VK_ESC, 0 ) // Keyb emulation: Force to Exit from the Get without saving. NTK_PostMessage( hOldGet, WM_KEYDOWN, VK_ENTER, 0 ) // Keyb emulation: Force to Exit from the Get saving data. Endif RETURN // Return from previous session of EditCell() before start another... ENDIF // --------------------------------------------------------------------------------- RETURN(nil) ****** ****** ****** FUNCTION WhereAmI( oB ) NTK_MsgBox( oB:hWnd, "Code="+ (oB:Alias)->CODEART,; "RecNo()="+STR( (oB:Alias)->(RecNo()) ) ) NTK_SetFocus( oB:hWnd ) RETURN(nil) ****** ****** ****** FUNCTION InsNewCol( oB ) LOCAL cMsg LOCAL oNewCol LOCAL nSelCol := oB:nubHeadClickPos LOCAL nPrevCol := nSelCol -1 IF nSelCol >= oB:ColCount cMsg := "After this Col" ELSEIF nSelCol < 3 NTK_MsgBox( oB:hWnd, "Insertion before col #2 is not allowed...", "Forbidden", MB_OK ) NTK_SetFocus(oB:hWnd) RETURN(nil) ELSE cMsg := "Between Col #" +ALLTRIM(Str(nPrevCol))+ " and Col #" + ALLTRIM(Str(nSelCol)) ENDIF IF NTK_MsgBox( oB:hWnd, cMsg, "Do you want to insert a new colunm ?",; MB_OKCANCEL+MB_ICONQUESTION ) == IDOK // Add new column ... oNewCol := NtkColumn():Init( "Stock" ,; { || STR(PRODUCT->STOCACTUEL,10,3) },; nil,; NTK_RGB(12,15,46),; NTK_RGB(255,255,255),; DT_RIGHT,; 50 ) oNewCol:HeadColor := C_PURPLE // NTK_RGB(255,255,128) // Title foreground will appear in purple color oB:insColumn( nSelCol, oNewCol ) oB:configure() oB:refreshAll() ENDIF NTK_SetFocus(oB:hWnd) RETURN(nil) ****** ****** ****** FUNCTION DelCol( oB ) LOCAL nSelCol := oB:ColPos LOCAL cMsg := "Do you really want to remove colunm #"+LTRIM(STR(nSelCol))+" ?" IF NTK_MsgBox( oB:hWnd, cMsg, "ATTENTION!!!",; MB_OKCANCEL+MB_ICONQUESTION ) == IDOK // Delete column # ... oB:DelColumn( nSelCol ) oB:configure() oB:refreshAll() ENDIF RETURN(nil) ****** ****** ******