Le portail francophone de la géomatique

add Column nomtable (ColumnID  Integer)  'Créer un champ temporaire dans la table nomtable
update nomtable set ColumnID = rowid

'on crée un champ temporaire dans la table nomtable
    
    Cmd = "ALTER TABLE nomtable ADD ID Integer"
    Run command cmd
    Update nomtable Set ID = RowId
    
'on fait la boucle sur les enregistrements de la table choisie
    Fetch First from nomtable
    Do while not EOT(nomtable)

    idPolygone = nomtable.ID

'on crée une table temporaire à partir du polygone sélectionné
     SELECT * FROM nomtable WHERE ID = idPolygone into monPolygone

DIM idPolygone as Integer

add column nomtable (dede integer) from nomtable set to rowid

'on fait la boucle sur les enregistrements de la table choisie
    Fetch First from nomtable
    Do while not EOT(nomtable)

    idPolygone = nomtable.dede

'on crée une table temporaire à partir du polygone sélectionné
     SELECT * FROM nomtable WHERE dede = idPolygone into monPolygone

'on crée une copie de la table d'où le polygone est sélectionné
    DIM maTable AS string
    maTable = selectioninfo(SEL_INFO_TABLENAME)

'on rajoute une couche avec le polygone sélectionné et on zoome sur celle-ci
    Add Map window WindowID(IdMap) Layer monPolygone
    SET Map Window WindowID(IdMap) Zoom Entire Layer monPolygone

'on défini le polygone en pochoir
    Fetch First from monPolygone
    SET Map Clipping Object monPolygone.obj

'on dessine dans le Layout un cadre permettant l'affichage de la carte
    create frame into window WindowID(IdLayout) (0.63, 3.48) (41.37, 29.1) Pen(1,1,0) brush(1, 16777215, 16777215) FROM WINDOW WindowID(IdMap) fillframe on

'on supprime la couche avec le polygone sélectionné
    Remove Map Window WindowID(IdMap) Layer monPolygone
'on ferme la table monPolygone
    Close table monPolygone

    include "mapbasic.def"

'---------------------------------------------------------------------------
'--- déclaration des procédures et variables globales
'---------------------------------------------------------------------------
    DECLARE SUB main
    DECLARE SUB MEPA
    DECLARE FUNCTION MakeOpenTabsList$(ByVal OnlyMappable As Logical) as STRING

    DIM j, k, l, m, z, cpt, nomcarte, totale, selection, idPolygone as INTEGER
    DIM NbrFenetre,IdMap,Idlayout,Idlegend, nbchamp as SMALLINT 
    DIM tbl_list, field_list, nomtable, nomchamp as STRING

'---------------------------------------------------------------------------
'---------------------------SUB PRINCIPALE----------------------------------
'---------------------------------------------------------------------------
SUB main
    create buttonpad "Facil'Atlas" as
        pushbutton calling MEPA icon 78 helpmsg "Facil'Atlas\nFacil'Atlas"
    fixed
END SUB
    
'---------------------------------------------------------------------------
'---------------------------SUB FACIL'ATLAS---------------------------------
'---------------------------------------------------------------------------
SUB MEPA

'***********************************Ouvre une fenetre MEP dans MI***********************************
    Layout width 12.6808 Height 7.5869 position (0, 0)
    Set coordsys Layout units "cm" set window WindowID(IdLayout) printer orientation Landscape Copies 1 Papersize 8

'************************cherche les ID de la fenetre MAP, layout et legende************************
    NbrFenetre = NumWindows()
    For cpt=1 to NbrFenetre Step 1

        if WindowInfo(cpt,WIN_INFO_TYPE) = WIN_MAPPER then
            IdMap=cpt
            print "Carte : "+str$(IdMap)
        end if

        if WindowInfo(cpt,WIN_INFO_TYPE) = WIN_LAYOUT then
            Idlayout=cpt
            print "Mise en page : "+str$(Idlayout)
        end if

        if WindowInfo(cpt,WIN_INFO_TYPE) = WIN_CART_LEGEND then
            Idlegend =cpt
            print "Légende : "+str$(Idlegend )
        end if
    Next

'******************récupère la table choisie parmit les tables ouvertes dans MI************************
'on sélectionne la table sur laquelle sera effectué les manipulations    
    tbl_list = ""

    tbl_list = MakeOpenTabsList$(TRUE)
    If tbl_list = "" Then
        Note "Pas de tables ouvertes"
            Exit Sub
    End If

    Dialog title "Tables"
        Control StaticText Title "Choisissez la table :" Position 10, 10
         Control ListBox value j into j
           Position 10, 20 Width 120 Height 140
           Title tbl_list 
        Control OKbutton 
           Title "Confirmez le choix" 

    nomtable = TableInfo (j, TAB_INFO_NAME)

'on récupère les champs de la table choisie
    nbchamp = NumCols(j)

    For k=1 to nbchamp
    field_list= field_list + ColumnInfo (nomtable, "COL"+k, COL_INFO_NAME) + ";"
    Next

    Dialog title "Champs"
           Control StaticText Title "Choisissez le champ :" Position 10, 10
           Control ListBox value l into l
           Position 10, 20 Width 120 Height 140
           Title field_list
           Control OKbutton
           Title "Confirmez le choix"
  
'    nomchamp = ColumnInfo(l, COL_INFO_NAME)

'*******************************************Crée un cadre carte*******************************************
DIM idPolygone as Integer

'on crée un champ ID dans la table nomtable
    add column nomtable (dede integer) from nomtable set to rowid

'on fait la boucle sur les enregistrements de la table choisie
    Fetch rec z from nomtable
    z = 1
'    Do while not EOT(nomtable)

'    idPolygone = nomtable.dede

'on crée une table temporaire à partir du polygone sélectionné
     SELECT * FROM nomtable into monPolygone

'on crée une copie de la table d'où le polygone est sélectionné
    DIM maTable AS string
    maTable = selectioninfo(SEL_INFO_TABLENAME)

'on rajoute une couche avec le polygone sélectionné et on zoome sur celle-ci
    Add Map window WindowID(IdMap) Layer monPolygone
    SET Map Window WindowID(IdMap) Zoom Entire Layer monPolygone

'on défini le polygone en pochoir
    Fetch rec z from monPolygone
    SET Map Clipping Object monPolygone.obj

'on dessine dans le Layout un cadre permettant l'affichage de la carte
    create frame into window WindowID(IdLayout) (0.63, 3.48) (41.37, 29.1) Pen(1,1,0) brush(1, 16777215, 16777215) FROM WINDOW WindowID(IdMap) fillframe on

'on supprime la couche avec le polygone sélectionné
    Remove Map Window WindowID(IdMap) Layer monPolygone
'on ferme la table monPolygone
    Close table monPolygone

'************************paramètre la taille de la fenetre carte pour calculer l'echelle************************
    DIM echelle as STRING  
  
      Set Distance Units "cm" 
      Set Paper Units "cm"
   
    echelle= (MAPPERINFO(WindowID(IdMap), MAPPER_INFO_SCALE))/100

    create text into Window WindowID(IdLayout) "Echelle : 1cm = "& echelle &"m" (28.5, 28) (33.5, 28) Font("Arial", 0, 12, BLACK)

'*************************************dessine dans le Layout une flèche Nord*************************************
    create point into Window WindowID(IdLayout) (40.3, 4.5) symbol(42, 0, 40, "MapInfo Arrows", 0, 0)

'*********************************affiche les sources des données dans le layout*********************************
    create text into Window WindowID(IdLayout) "Sources : IGN - Données : ONEMA, DDT" (41.37, 29.1) (41.37, 29.1) Font("Arial", 1, 7, BLACK) Angle 90

'*******************************crée un cadre permettant l'insertion d'une légende*******************************
    create Frame into Window WindowID(IdLayout) (33.18, 16.5) (41.37, 29.1) Pen(1,1,0) brush(1, 16777215, 16777215)FROM WINDOW WindowID(Idlegend) fillframe on

'****************************************Dessine les bordures sur la MEP****************************************
    DIM valeur as STRING

'on dessine dans le Layout les bordures
    create Line into Window WindowID(IdLayout) (0.63, 0.6) (41.37, 0.6) Pen(2,2,0) 'en haut
    create Line into Window WindowID(IdLayout) (0.63, 0.6) (0.63, 29.1) Pen(2,2,0) 'a gauche
    create Line into window WindowID(IdLayout) (0.63, 29.1) (41.37, 29.1) Pen(2,2,0) 'en bas
    create Line into window WindowID(IdLayout) (41.37, 29.1) (41.37, 0.60) Pen(2,2,0) 'a droite
    create Line into window WindowID(IdLayout) (0.63, 3.48) (41.37, 3.48) Pen(2,2,0) 'le titre

'on insère dans le Layout un titre et sous titre
    create text into window WindowID(IdLayout) " sTitre " (1, 1.2) (41, 1.2) Font("Arial", 1, 12, BLACK)
    create text into window WindowID(IdLayout) " sSousTitre " (1, 1.8) (41, 1.8) Font("Arial", 1, 10, BLACK)
    
'on inclue la valeur du champs dans le commentaire
    valeur = l.nomtable
    create text into window WindowID(IdLayout) " Cartographie de la commune : "& valeur &" " (1, 2.7) (41, 2.7) Font("Arial", 0, 10, BLACK)

'on compte le nombre d'enregistrement présent dans le champ sélectionné
    selection = TableInfo(z,TAB_INFO_NROWS)
    totale = TableInfo(nomtable,TAB_INFO_NROWS)
    create text into window WindowID(IdLayout) " Carte n° "& selection &" / "& totale &" " (1, 2) (41, 2) Font("Arial", 0, 10, BLACK)

'***************************mise en place du logo*******************************************
    DIM DDT_logo as INTEGER
    DIM bool1 as LOGICAL
    DIM c as INTEGER

'on ouvre la table du logo
    open table "C:\Documents and Settings\cyril.chat.DDE-79\Bureau\Stage\Doc_WOR\Bloc_Marque_DDT.TAB"

'on insertion du logo en configurant sa fenetre
    bool1 = FALSE
    For c=1 to numWindows()
        If WindowInfo(c, WIN_INFO_NAME) = "logo" THEN 
        bool1= TRUE 
        End if
    Next
    If bool1 = FALSE Then
    map from Bloc_Marque_DDT width 2.5 units "cm" height 2.5 units "cm" min 
    End if
'on profite que cette fenêtre soit au premier plan pour la renommer
    Set Window FrontWindow() Title "logo"
'on récupère l'ID de la fenetre logo
    ddt_logo = WindowID(FrontWindow())

'on crée le cadre logo dans la mise en page en le placant
    Create Frame into Window WindowID(IdLayout) (1, 28.7) (4, 25.7) Pen(1,1,0) brush(1, 16777215, 16777215) from Title "logo" FillFrame On

'***************************utilisation de l'impression MI pour imprimer directement en PDF*******************************************
'on paramètre l'imprimante pour une impression en PDF
    Set Window FrontWindow() Printer 
        Name "PDFCreator" Orientation Landscape Copies 1 Papersize 8
    Printwin window WindowID(IdLayout) interactive

    Fetch next from nomtable
    Loop

END SUB

'---------------------------------------------------------------------------
'------------FUNCTION permettant de connaitre les tables ouvertes-----------
'---------------------------------------------------------------------------
FUNCTION MakeOpenTabsList$(ByVal OnlyMappable As Logical) As String
      Dim i, iNumOpen as smallint
      Dim sTabList as string
        
    iNumOpen = NumTables()
        For i = 1 to iNumOpen
            If OnlyMappable Then

                  If TableInfo(i,TAB_INFO_MAPPABLE) and TableInfo(i,TAB_INFO_TYPE) <> TAB_TYPE_IMAGE Then 
                sTabList = sTabList + tableinfo(i,TAB_INFO_NAME) + ";"
                  End If
            Else
              sTabList = sTabList + tableinfo(i,TAB_INFO_NAME) + ";"
            End If
        Next
    MakeOpenTabsList$ = sTabList
END FUNCTION