******************************************************************************** * Program : BRWCITY.PRG * Goal : Gestion des communes * Make : MKRAD BRWCITY * Date : 21/06/2007 * Author(s) : Jn ELMANSSOURI * Copyright : Public domain, Courtesy of JNE. Just provided as tutorial. ******************************************************************************** //Manifest Windows XP #define ISOLATION_AWARE_ENABLED 1 **Ntk Include #include "windows.ch" #include "ntkcctrl.ch" #include "ntkgdi.ch" #include "ntkmsg.ch" #include "ntkacc.ch" #include "ntkdlg.ch" #include "ntkmenus.ch" #include "ntkbtn.ch" #include "ntkedget.ch" #include "ntkcmd.ch" #include "ntkshell.ch" #include "wNtk.ch" #include "wNtkKeys.ch" #include "ntknetw.ch" #INCLUDE "FILEIO.ch" // xHarbour **#include "APPFILES.CH" #Include "AppSets.ch" #define TAB CHR(9) #define CR CHR(13) #define CRLF CHR(13)+CHR(10) #define ID_BTN_NEW 8100 #define ID_BTN_MODIF 8101 #define ID_BTN_SEARCH 8102 #define ID_BTN_INS 8103 #define ID_BTN_DEL 8104 #define ID_BTN_FIRST 8105 #define ID_BTN_PREV 8106 #define ID_BTN_NEXT 8107 #define ID_BTN_LAST 8108 #define ID_BTN_QUIT 8109 #define ID_BTN_RET 8110 #define ID_BTN_IMP 8111 #define ID_BTN_PRE 8112 #define ID_BTN_ABANDON 8127 #define ID_GET_CODE 7101 #define ID_GET_VILL 7102 STATIC hFont1, oBCom FUNCTION MAIN_COM11(hWndP) LOCAL hWndCom LOCAL cWinTitle := "Les 'Communes' ..." LOCAL aOldBtn := ACLONE(aBtnList) SELECT 44 // Communes IF !NtkNetOpenDbf( P__FILES+DBFFRVIL, NTK_NETUSE_SHARED, 5 ) && open database CLOSE DATABASES RETURN ENDIF SET INDEX TO ( P__FILES+NTXCPCHL ), ( P__FILES+NTXVILNO ) SET ORDER TO 0 GOTO TOP CREATE WINDOW hWndCom ; TITLE cWinTitle ; // Minimum declaration AT 0,0 SIZE 640,550 ; // CW_USEDEFAULT, CW_USEDEFAULT; STYLE WS_SYSMENU ; INTO PARENT hWndP ; ON PAINT PAIN_COM11() ; ON EXIT EXIT_COM11() IF hWndCom == 0 NTK_MsgBox( hWndP, "Impossible de créer la fenêtre des communes...", "Alerte!", MB_OK+MB_ICONHAND ) CLOSE DATABASES RETURN Nil ENDIF EnableBtnMen10(hWndP, .F.) /*CREATE FONT hFont1 FACENAME "Bitstream Vera Sans" SIZE -26 WIDTH 13 WEIGHT 700*/ CREATE FONT hFont1 FACENAME "Junicode-Regular" SIZE -16 WIDTH 8 WEIGHT 800 @ 03,60 BUTTON "Fermer (Ech)" ; ID ID_BTN_ABANDON ; STATE NTK_BT_ENABLE ; SUPER ACCEL KEY K_ESC ; SIZE 02.5,18 ; TYPE NTK_BT_OWNERDRAWN ; FONT APP_hICOFONT ; BITMAP UP "32_quitdn" ; BITMAP OVER "32_QUITOVR" ; BITMAP GRAYED "32_quitoff" ; SHIFT TO 4,4 ; ACTION NTK_SendCloseEvent() ; OF hWndCom ; MESSAGE "Revenir au menu principal." @ 06,60 BUTTON "Imprimer (F6)" ; ID ID_BTN_IMP ; STATE NTK_BT_ENABLE ; SUPER ACCEL KEY K_F6 ; SIZE 02.5,18 ; TYPE NTK_BT_OWNERDRAWN ; FONT APP_hICOFONT ; BITMAP UP "32_PRINTUp" ; BITMAP GRAYED "32_PRINToff" ; SHIFT TO 4,4 ; ACTION IMPR_COM11(hWndCom) ; OF hWndCom ; MESSAGE "Imprimer la présente liste des communes." @ 09,60 BUTTON "Insérer (Inser)" ; ID ID_BTN_INS ; STATE NTK_BT_ENABLE ; SUPER ACCEL KEY K_INS ; SIZE 02.5,18 ; TYPE NTK_BT_OWNERDRAWN ; FONT APP_hICOFONT ; BITMAP UP "32_NEWUp" ; BITMAP GRAYED "32_NEWoff" ; SHIFT TO 4,4 ; ACTION INS_COM11(hWndCom) ; OF hWndCom ; MESSAGE "Ajouter une nouvelle commune juste après la séléction." @ 12,60 BUTTON "Supprimer (Suppr)" ; ID ID_BTN_DEL ; STATE NTK_BT_ENABLE ; SUPER ACCEL KEY K_DEL ; SIZE 02.5,18 ; TYPE NTK_BT_OWNERDRAWN ; FONT APP_hICOFONT ; BITMAP UP "32_Cancelon" ; BITMAP GRAYED "32_Canceloff" ; SHIFT TO 4,4 ; ACTION DEL_COM11(hWndCom) ; OF hWndCom ; MESSAGE "Détruire et retirer la commune en cours de sélection."+CR+; "(à condition qu'elle ne soit pas encore utilisée...)" SELECT 44 // communes @ 03,01 TO 25,57 CREATE BROWSE oBCom ; WITH DBAREA 44 ; TITLES "CP", "Nom de la commune" ; FIELDS CODEPOSTAL, VILLE ; SIZE 08,40 ; ON INIT InitBrw_COM11(oBCom) ; INTO hWndCom //NTK_CenterWindow( hWndCom, hWndP ) ACTIVATE WINDOW hWndCom MODE CENTER // Show main container window and all its children NTK_Setfocus(oBCom:hWnd) AUTO MANAGE EVENTS OF WINDOW hWndCom USING BUTTON LIST aBtnList // Event Manager for main container window DELETE FONT hFont1 CLOSE WINDOW hWndCom SELECT 44 SET ORDER TO 0 GO TOP NtkNETALLDEL( 'EMPTY(44->CODEPOSTAL)', NTK_NETUSE_SHARED, 5 ) CLOSE DATABASES EnableBtnMen10(hWndP, .T.) aBtnList := ACLONE(aOldBtn) RETURN ****** ****** ****** FUNCTION EXIT_COM11(hWnd,Msg,wParam,lParam) RETURN(.T.) ****** ****** ****** FUNCTION PAIN_COM11(hWnd, message, nwParam, nlParam, hDC) LOCAL cSouTitre := "Définition des 'communes' ..." **SET COLOR TO N/T // T=TRANSPARENT COLOR (background only) **SET COLOR TO R+/W+ SET RGB COLOR TEXT NTK_RGB(000,000,000) ; // Definir son propre mélange BACKGND NTK_RGB(252,243,228) // à la volée... CLEAR CONTEXT hDC SET RGB COLOR TEXT NTK_RGB(159,192,098) ; // Definir son propre mélange BACKGND NTK_RGB(252,243,228) // à la volée... @ 0.5,01 SAY cSouTitre FONT hFont1 INTO CONTEXT hDC @ 2,01 , 2.1,77 BOX NTK_BXS_SIMPLE INTO CONTEXT hDC // COLOR "N+/T" // "DBK/DBK" SET RGB COLOR TEXT NTK_RGB(159,192,098) ; // Definir son propre mlange BACKGND NTK_RGB(159,192,098) // la vole @ 2.5, 59.5, 20, 80 BOX NTK_BXS_LTROUNDED INTO CONTEXT hDC COLOR "XFG/XBG" // cadre 4 RETURN Nil ****** ****** ****** FUNCTION INITBrw_COM11(MyoBCom) *** NTK_MessageBox(, "Browse #2 Intialization procedure..." ) MyoBCom:ShowFocus := .T. // If set to .T. NtkTBrowse() will draw a focus rectangle around the currently selected cell. Defaults to .F. //MyoBCom:RowGridColor := NTK_RGB(167,207,250) //MyoBCom:ColGridColor := NTK_RGB(255,153,204) MyoBCom:sbHorz := .F. MyoBCom:ShowNumbers := .T. MyoBCom:nubWidth := 20 // pixels MyoBCom:nubAlign := DT_CENTER MyoBCom:nubBlock := {|| IIF( EMPTY( (MyoBCom:Alias)->(FIELDGET(01)) ), 1600, 0 ) } MyoBCom:headHeight := 25 // pixels MyoBCom:headColor := NTK_RGB(0,0,255) // Super nubHeadings Foreground Color //MyoBCom:autoSize := .F. // Don't let NtkTBrowse calculate automatically the width of each Col, regarding to its type and the OEM_FIXED FONT size. MyoBCom:LineHeight := 20 // pixels // The following is not very fancy, but at least, it shows how to do things... //MyoBCom:HeadFont := NTK_GetStockObject( ANSI_FIXED_FONT ) // nubHeading font //MyoBCom:tbFont := NTK_GetStockObject( OEM_FIXED_FONT) // SYSTEM_FONT ) //ANSI_VAR_FONT ) //MyoBCom:ColorSpec := { NTK_RGB(000,000,000) , NTK_RGB(255,255,255),; // UnSel Cells fg / bkg // NTK_RGB(255,255,255) , NTK_RGB(000,000,128) ,; // Sel Cells fg / bkg // NTK_RGB(172,220,247) } // Unused cells MyoBCom:doubleClick := { |oB,nMsg,nWparam,nLparam| EDIT_COM11(oB) } // Do edit routine MyoBCom:singleClick := { |oB,nMsg,nWparam,nLparam| NtkTBAutoExitCell(oB) } // Exit from the active get session (if any), when user singleclick... RETURN(Nil) ****** ****** ****** PROCEDURE IMPR_COM11 LOCAL aDbCur := NtkExSaveDbEnv() SELECT 44 // communes GOTO TOP DO PLACOM20 NtkExRestDbEnv(aDbCur) oBCom:ShowAll() NTK_SelectWindow( oBCom:hWnd ) NTK_SetFocus( oBCom:hWnd ) RETURN // ( nil ) ****** ****** ****** PROCEDURE INS_COM11 SET DELETED OFF NtkFINSERT() SET DELETED ON oBCom:RefreshAll() RETURN( nil ) ****** ****** ****** PROCEDURE DEL_COM11 LOCAL aDbCur LOCAL Touche, Posrec LOCAL zCode := ALLTRIM( FIELDGET(1) ) SKIP -1 Posrec := 44->( RECNO() ) SKIP * PRIVATE B := {} AADD( B, { " Abandonner (Esc) ", K_ESC } ) AADD( B, { " Supprimer (Entrée) ", K_ENTER } ) * Touche := NtkWARNBOX( Nil, Nil, 05, 57, "Voulez-vous réellement supprimer cette commune ?", B, C_WE, "rDlgBkg01_W", IDI_QUESTION,APP_hSAYFONT ) IF Touche == K_ESC RETURN ENDIF IF !NtkNETDEL( NTK_NETUSE_SHARED, 5 ) && Marquer un enregistrement pour l'effacement PRIVATE C := {} AADD( C, { " Continuer (Entrée) ", K_ENTER } ) Touche := NtkWARNBOX( Nil, Nil, 05, 55, "Impossible de supprimer la fiche en cours ?", C, C_WE, "rDlgBkg01_W", IDI_EXCLAMATION,APP_hSAYFONT ) ENDIF * SELECT 44 // communes GO Posrec * oBCom:RefreshAll() * RETURN && Fin de la proc‚dure suppression d'un champ d'un Browse ****** ****** ****** FUNCTION EDIT_COM11( oB ) LOCAL nI LOCAL nCellY, nCellX LOCAL nCellheight, nCellWidth LOCAL lOldReadState, lOldGetMode LOCAL lGetUpdated:= .F. LOCAL aCellValue := Nil LOCAL aCellRect := {0,0,0,0} * LOCAL nCol := oB:ColPos LOCAL oCol := oB:getColumn( nCol ) * **LOCAL hGetFont := NTK_GetStockObject(ANSI_VAR_FONT) // DEFAULT_GUI_FONT) LOCAL hGetFont := NTK_GetStockObject(DEFAULT_GUI_FONT) PRIVATE xCellValue := Nil // Remember: All GET's Var MUST be declared as PRIVATE! IF oCol == Nil NTK_MsgBox( oB:hWnd, "La Colonne Nø"+STR(nCol)+" est invalide.", "Erreur!" ) NTK_SetFocus(oB:hWnd) RETURN(nil) ENDIF PRIVATE B := {} AADD( B, { " CONTINUER (Entrée)", K_ENTER } ) IF LASTREC() == 0 NtkWarnBox( nil, nil, 05, 55, "Vous devez d'abord INSERER, avant de pouvoir Modifier", B, C_WE, "rDlgBkg01_W", IDI_EXCLAMATION,APP_hSAYFONT ) RETURN(nil) ENDIF IF oB:ColPos == 1 .AND. !EMPTY( 44->(FIELDGET(1)) ) NtkWarnBox( nil, nil, 05, 55, "Vous ne pouvez pas modifier un identifiant unique, supprimez puis recréez...", B, C_WE, "rDlgBkg01_W", IDI_EXCLAMATION,APP_hSAYFONT ) RETURN(nil) ENDIF IF oB:ColPos == 2 .AND. EMPTY( 44->(FIELDGET(1)) ) NtkWarnBox( nil, nil, 05, 50, "Veuillez d'abord renseigner le CODE POSTAL de la commune...", B, C_WE, "rDlgBkg01_W", IDI_EXCLAMATION,APP_hSAYFONT ) oB:ColPos := 1 oB:ShowAll() NTK_SendVkey( VK_ENTER, oB:hWnd ) RETURN(nil) ENDIF //-- Disable Action PushButtons NTK_EnableBtnID(ID_BTN_ABANDON, .F. ) NTK_EnableBtnID(ID_BTN_IMP, .F. ) NTK_EnableBtnID(ID_BTN_INS, .F. ) NTK_EnableBtnID(ID_BTN_DEL, .F. ) // --- 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] // --- REMEMBER: getCellRect() ALWAYS returns coordinates in pixel units! aCellRect := oB:getCellRect(oB:RowPos, oB:ColPos) // getCellRect(nRow,nCol) -> {Left,Top,Width,Height} // --- SO, as we chose Row/Col mode in MAIN module, we have to convert pixel coordinates into row/col values... nCellY := ( aCellRect[RECT_Top] +1 ) / __NtkSetRowRatio() nCellX := ( aCellRect[RECT_Left] +1 ) / __NtkSetColRatio() nCellWidth := ( aCellRect[RECT_Right] -1 ) / __NtkSetColRatio() nCellheight := ( aCellRect[RECT_Bottom] -2 ) / __NtkSetRowRatio() NTK_SelectWindow(oB:hwnd) NTK_SetFocus(oB:hWnd) DO CASE CASE oB:ColPos == 1 @ nCellY, nCellX GET xCellValue ID ID_GET_CODE ; SIZE nCellHeight , nCellWidth ; PICTURE "@!" ; FONT hGetFont ; TEXTCOLOR APP_fgGETSELCOLOR ; BACKCOLOR APP_bgGETSELCOLOR ; BACKBRUSH APP_hGETSELBRUSH ; STYLE GS_3DSUNKEN ; MESSAGE "Entrer le code postal pour cette nouvelle commune..."+CR+; "(puis presser [Entrée] pour Valider ou [Echap] pour Abandonner)" CASE oB:ColPos == 2 @ nCellY, nCellX GET xCellValue ID ID_GET_VILL ; SIZE nCellHeight , nCellWidth ; PICTURE "@!" ; FONT hGetFont ; TEXTCOLOR APP_fgGETSELCOLOR ; BACKCOLOR APP_bgGETSELCOLOR ; BACKBRUSH APP_hGETSELBRUSH ; STYLE GS_3DSUNKEN ; MESSAGE "Entrer le nom de la commune..."+CR+; "(puis presser [Entrée] pour Valider ou [Echap] pour Abandonner)" ENDCASE oB:StandByMode(.T.) // Freeze the Browse : can't move anymore, nor allow other action during the Get edtion. //lOldGetMode := NTK_ReadInsert( .F. ) // Force to switch to overwrite mode // -- Allow or not Up/Dn/Enter Key to exit after last get lOldReadState := NTK_ReadExit( .T. ) // .F. means we allow exit only by GVK (def. F10). So after last get, we will loop to first get... READ INTO oB:hWnd TOOLTIP // Active la saisie dans le GET NTK_ReadExit( lOldReadState ) //NTK_ReadInsert( lOldGetMode ) IF NTK_Lastkey() != K_ESC // ----------------- Replace the Get value into Database SELECT ( (oB:Alias) ) If NTK_Updated() if !NtkNetRLock( "Impossible de sauvegarder les modifications, Voulez-vous réessayer ?", 5 ) // Autre message si n‚cessaire... else Do Case Case oB:ColPos==1 REPLACE 44->CODEPOSTAL WITH xCellValue Case oB:ColPos==2 REPLACE 44->VILLE WITH xCellValue EndCase UNLOCK && d‚verrouiller l'enregistrement endif Endif ENDIF oB:StandByMode(.F.) // Free the Browse and let it works again... // ------------------------ Destroy all Editget(s) and clear aGetList[], thus CLEAR GETS OF oB:hWnd // NTK_GetCtrl() is no longer activated while aGetList is empty... oB:RefreshCurrent() // Repaint all fields of the current row //-- Enable Action PushButtons NTK_EnableBtnID(ID_BTN_ABANDON, .T. ) NTK_EnableBtnID(ID_BTN_IMP, .T. ) NTK_EnableBtnID(ID_BTN_INS, .T. ) NTK_EnableBtnID(ID_BTN_DEL, .T. ) NTK_EnableWindow( oB:hNubWnd, .T. ) // Browse nub's Activation NTK_EnableWindow( oB:hWnd, .T. ) // Browse Activation NTK_SetFocus(oB:hWnd) // Put focus on browse Control // ------------------------ Keyb emulation: Mimic spreadsheets way to exit from edit-mode IF NTK_Lastkey()==K_UP NTK_SendVKey( VK_UP, oB:hWnd ) ELSEIF NTK_LastKey==K_PGUP NTK_SendVKey( VK_PAGEUP, oB:hWnd ) ELSEIF NTK_Lastkey()==K_DOWN NTK_SendVKey( VK_DOWN, oB:hWnd ) ELSEIF NTK_LastKey==K_PGDN NTK_SendVKey( VK_PAGEDN, oB:hWnd ) ENDIF RETURN(nil) ****** ****** ******