Le portail francophone de la géomatique

Thibast · Sat 14 February 2009 01:06

Bonsoir,
Cela fait une semaine que je copie des bouts de code, un peu partout pour générer un mbx capable d'enregistrer des images centrées sur les différents objets d'une table préalablement sélectionnée dans un menu déroulant.
Les paramétrages pour la génération d'image sont les suivants:
- l'échelle d'image
- sa définition en DPI
- sa taille en hauteur/largeur en mm
- son 1 ER et Dernier ID (Forcement un entier court)
- son chemin d'accès au dossier d'enregistrement cible avec comme format loc_Ma_tableNNNN.jpg
Les fenêtres de saisies semble correc tement fonctionner, mais la boucle permettant la génération des images me pose problème.

Monsieur Maurice Nadal (toujours lui, et qu'il soit ici encore remercié) m'avez transmis son script à l'époque pour réaliser cela dans une fenêtres map (je n'avais pas MapBasic V7.0 à l'époque et il fallait créer autant de bloc de texte qu'il y avait d'images à générer).
Mais là je cale....

En vous remerciant à nouveau pour votre aide

Thibast MI7.8 et MB 7.0

Code:

'****************************************************************
'* Nom de programme:  Gen_image.MB
'*
'* Description:   Générateur d'image de localisation avec nom ID
'* 
'* Créer par:    thibast
'* Date:          30/01/09
'* Date Revised:  30/01/09
'****************************************************************
'
'
'
'-----------------------------------------------------------------------------------------
'Fichiers de définition
'-----------------------------------------------------------------------------------------
Include "MENU.DEF"
Include "MAPBASIC.DEF"
'
'-----------------------------------------------------------------------------------------
'Déclaration des procédures
'-----------------------------------------------------------------------------------------
Declare Sub Main()
Declare Sub Fin_mbx
Declare Sub Apropos_Mbx
Declare Sub GI_InterfaceTablChps
Declare Sub GI_InterfaceParametre
Declare Sub GI_TabChps
Declare Sub GI_TestVal
Declare Sub GI_Bouclimage
'
'-----------------------------------------------------------------------------------------
'Déclaration des procédures et fonctions publiques
'-----------------------------------------------------------------------------------------
Declare Function IsTableOpen(ByVal sTabName As String) As Logical
'
'-----------------------------------------------------------------------------------------
'Déclaration des objets
'-----------------------------------------------------------------------------------------
DEFINE listTab                                     1 
DEFINE ListCol                    2
DEFINE SId_Prime                101
DEFINE SID_Der                  102
DEFINE Sechelle                 103
DEFINE SDPI                     104
DEFINE SHaut                    105
DEFINE Slarg                    106
DEFINE Schem                    107
DEFINE BtnApropos                                200
Define BtnAppliquer             201
Define BtnAnnuler               202

'-----------------------------------------------------------------------------------------
'Déclaration des variables.
'----------------------------------------------
Global gsTable() As String
Global gsColumn()As String
Global gsAddCol As String
Global gnNumRecs, gnCurrRec As Integer
Global s_Tab() as string
Global Echelle as Smallint
Global DPI as Smallint
Global Haut_Image as Smallint
Global Larg_Image As Smallint
Global Chem_acces As String
Global ID_Prime, ID_Dernier as smallint
Global Sel_Table As String 'Selection de Table
Global Sel_Col As String ' Selection Du champs de table

'-----------------------------------------------------------------------------------------
'Sous routine : Main
'-----------------------------------------------------------------------------------------
Sub Main()
  CLS
Create Menu "&Générateur d'images" As
        "Lancer l'Outils"                                        HelpMsg "Générateur d'image de localisation  - Choisir la table." Calling GI_TestVal,
        "(-",
        "&A propos de l'outils"                                 HelpMsg "Description d'Application."                                                          Calling Apropos_Mbx,
        "(-",
    "&Fermer Générateur d'images\tCtrl+M/W^M" HelpMsg "End Application."                                                                              Calling Fin_mbx
Alter Menu Bar Add "Générateur d'images"
End Sub

'
-----------------------------------------------------------------------------------------
'Sous routine : Fin_Mbx
'-----------------------------------------------------------------------------------------
Sub Fin_mbx
    Alter Menu Bar Remove "Générateur d'images"
  Terminate Application "Gen_Image.mbx"
End Sub
'
'-----------------------------------------------------------------------------------------
'Sous routine : Apropos_Mbx
'-----------------------------------------------------------------------------------------
Sub Apropos_Mbx
  Dim sAppName, sVerNum, sFirstDate As String
  Dim iStrLen As SmallInt

  sAppName = "Générateur d'image de localisation"
  sVerNum = "1.00"
  sFirstDate = "30/01/2009"

  If Len(sAppName) < 30 Then
    iStrLen = 156
  Else
    iStrLen = Len(sAppName) * 5
  End If

  Dialog Title "A Propos"
    Control GroupBox    Position 8,8    Width iStrLen Height 16
    Control StaticText  Position 12,14  Title sAppName + " Version " + sVerNum
    Control StaticText  Position 8,36   Title "Cet utilitaire permet la génération d'images de localisation"
    Control StaticText  Position 8,48   Title "Le nom de l'image est indicé par rapport à son identifiant"
    Control StaticText  Position 8,82   Title "Créé par Thibast le , " + sFirstDate + "."
    Control OKButton
End Sub
'
-----------------------------------------------------------------------------------------
'Sous routine : GI_TestVal
'-----------------------------------------------------------------------------------------
Sub GI_TestVal
    Dim i, i_NbTab as integer 'en plus
                     '==========================================
                    'Vérifie qu'au moins une table soit ouverte.
    If NumTables() <1 then
                    Note "Ouvrez au minimum une table graphique avant de continuer"
                    Else
                 '==================================
                    'Compte le nombre de tables valides.
                    Redim s_Tab(NumTables())
                    For i = 1 to NumTables()
                    If TableInfo(i,TAB_INFO_MAPPABLE) = TRUE then
                    If TableInfo(i,TAB_INFO_TYPE) = TAB_TYPE_BASE or TableInfo(i,TAB_INFO_TYPE) = TAB_TYPE_RESULT then
                        i_NbTab = i_NbTab + 1            
                    End if
                    End if
    Next

                '==================================================================================================
                 'Vérifie qu'il s'agisse de tables cartographiables de type normales, seamless ou issues de requêtes.
                 Redim s_Tab(i_NbTab)
                 i_NbTab = 0
             For i = 1 to NumTables()
                If TableInfo(i,TAB_INFO_MAPPABLE) = TRUE then
                    If TableInfo(i,TAB_INFO_TYPE) = TAB_TYPE_BASE or TableInfo(i,TAB_INFO_TYPE) = TAB_TYPE_RESULT then
                        i_NbTab = i_NbTab + 1
                        s_Tab(i_NbTab) = TableInfo(i,Tab_Info_Name)                        
                    End if
                End if
            Next

                 '============================================================
                 'Appelle l'interface d'étude au moins une table est concernée.
            If i_NbTab > 0 then            
                Call GI_InterfaceTablChps            
            Else            
                Dim strMessage as string
                i = i - 1
                If i = 1 then
                    strMessage = "Le fichier ouvert n'est pas une table graphique"
                Else
                    strMessage ="Aucun des " & i & " fichiers ouvertes est valide"
                End if
                Note strMessage & chr$(13) & "Ouvrez au minimum une table graphique n'appartenant pas aux types suivants :" & chr$(13) & "    1. Fichier image" & chr$(13) & "    2. Analyse thématique"
            End if

        End if 
End Sub
'
-----------------------------------------------------------------------------------------
'Sous routine : GI_InterfaceTablChps
'-----------------------------------------------------------------------------------------
Sub GI_InterfaceTablChps
 Dim i, iTable, iColumn As SmallInt
 Echelle = 200
 DPI = 200
 Larg_image = 170
 Haut_Image = 90
 ID_Prime = 1
 ID_Dernier = 100 

  ReDim gsTable(NumTables())  'MàJ de la     variable GSTABle en fct du nbre de tables dispo
  For i = 1 to NumTables()
    gsTable(i) = TableInfo(i, TAB_INFO_NAME)
  Next

    Dialog Title "Fenêtre de paramétrages" 
  width 260 Height 162                                                             'taille de fen^tre
  
  Control GroupBox
      position 5,5
         width 120 Height 70                                                          ' taille longeur/hauteur
        Title "&Table :"
        Control ListBox                                                                    ' Liste unique
      position 10, 15
         width 110 Height 55
         ID ListTab
        Title from Variable gsTable
         Value ListTab Into iTable 
         Calling GI_TabChps
    
    Control GroupBox
      position 135,5
         width 120 Height 70
        Title "&Champs :"
       Control ListBox
       position 140, 15
        width 110 Height 55
        ID ListCol
        Title from Variable gsTable
        Value ListCol Into icolumn 
        
    Control Button
         ID btnApropos
       Title "A propos"
       Position 63, 142    
       Width 52 Height 15
    Calling Apropos_Mbx
        
   Control OKButton
       ID btnAppliquer
    Title "OK"
       Position 130, 142
       Width 52 Height 15
       Calling GI_InterfaceParametre
       Enable
       
   Control CancelButton
       ID btnAnnuler
    Title "Annuler"
    Position 192, 142
    Width 52 Height 15
    Calling Fin_Mbx
    
End Sub

   
'-----------------------------------------------------------------------------------------
' Sous routine : GI_InterfaceParametre
'-----------------------------------------------------------------------------------------
Sub GI_InterfaceParametre 
    'Retourne les informations relatives à la table sélectionnée.
    Dim i_sel_Table as integer
    i_Sel_table = ReadControlValue (listTab)
    Sel_Table = TableInfo(s_Tab(i_Sel_table),TAB_INFO_NAME)            
 
    'Retourne la colonne de la table choisie
    Dim I_Sel_Col As integer '(num de colonne)
    i_Sel_Col = ReadControlValue (listCol)
    Sel_Col = ColumnInfo (Sel_Table,"Col" + Str$(i_Sel_Col),col_info_Name) 'nom de table num de colonne renvoi nom de colonne
  Print Sel_Table
  Print Sel_Col
    'Vérifie que la colonne est un chiffre
        If ColumnInfo (Sel_Table,"Col" + Str$(i_Sel_Col),col_type_integer) = true then
            Note "La colonne selectionnée doit être de type nombre pour être incrémenter. Prière de relancer l'outils de selection"
        call fin_Mbx 
        Else
        End if  
        Select * From Sel_table Where Obj Into TempSel NoSelect   
    Dialog Title "Fenêtre de paramétrages" 
  width 260 Height 162         
  
    Control StaticText
         position 5,81
      Title "Id 1ere Image à générer"
        Control EditText
        position 100,80
        width 25 height 12
        ID SId_Prime Into ID_Prime Value ID_Prime
    
    Control StaticText
         position 135,81
      Title "Id derniere image à générer"
        Control EditText
        position 228,80
        width 25 height 12
        ID SId_Der Into ID_Dernier Value TableInfo(Sel_table, TAB_INFO_NROWS)    
    
    Control StaticText
         position 5,96
         Title "&Echelle : 1/"
         Control EditText
        position 45,94
        width 25 height 12
        ID Sechelle Into Echelle Value Echelle
    
     Control StaticText
      position 100,95
      Title "&Definition de l'image (en DPI)"
        Control EditText
        position 228,94
        width 25 height 12
        ID SDPI Into DPI Value DPI    
    
    Control StaticText
         position 5,110
      Title "&Hauteur Image (en mm)"
        Control EditText
        position 100,109
        width 25 height 12
        ID SHaut Into Haut_Image Value Haut_Image
    
     Control StaticText
      position 135,110
      Title "&Largeur Image (en mm)"
         Control EditText
        position 228,109
        width 25 height 12
        ID Slarg Into Larg_image Value Larg_Image
    
    Control StaticText
         position 5,125
      Title "&Dossier d'enregistrement"
         Control EditText
         position 100,124
         width 155 height 12
         ID SChem Into Chem_acces Value ApplicationDirectory$()
        
    Control Button
         ID btnApropos
       Title "A propos"
       Position 63, 142    
       Width 52 Height 15
    Calling Apropos_Mbx
        
   Control OKButton
       ID btnAppliquer
    Title "OK"
       Position 130, 142
       Width 52 Height 15
       Calling GI_Bouclimage
       Enable
       
   Control CancelButton
       ID btnAnnuler
    Title "Annuler"
    Position 192, 142
    Width 52 Height 15
    Calling Fin_Mbx
    
End Sub

'-----------------------------------------------------------------------------------------
'Sous routine : GI_Bouclimage
'-----------------------------------------------------------------------------------------
sub GI_Bouclimage
dim Num_image as smallint
'dim image_encours as  smallint
dim cmd as string
dim Image_Sauv  as  string
Num_image=ID_Prime
if Num_image > ID_Dernier then run command fin_Mbx 
else
'Select * from TempSEl where col_info(sel_col,col_info_name)=num_image into image_encours  'changer ID par SEl_Col
'set map redraw off
'Add Map Layer Numero_encours
'Set Map  Scale 1 Units "cm" For Echelle Units "cm" 'Echelle d'impression'
'Set Map Layer 1 Label Position Above Right Font ("Arial",257,8,16711680,16777215) With sel_col Auto On
'Set map zoom entire layer image_encours
'set map redraw on
Image_Sauv=chr$(34)+Chem_acces+"\Loc_"+num_image+".jpg"+chr$(34)'Chem_acces de sauvegarde des localisation
cmd="save window frontwindow() as "+Image_Sauv+" type "+chr$(34)+"JPEG"+chr$(34)+" resolution 200" ' Définition de l'image'
run command cmd 
End if
' je ne sais pas ;;;;Fetch next from TempSEl
End sub
'
'-----------------------------------------------------------------------------------------
'Sous routine : GI_TabChps 'Recherche des champs en fonction de la table selectionnée
'-----------------------------------------------------------------------------------------
Sub GI_TabChps
Dim i, iCols As SmallInt
Sel_Table = gsTable(ReadControlValue(1))
iCols = NumCols(Sel_Table)
ReDim gsColumn(iCols)
For i = 1 to iCols
 gsColumn(i) = ColumnInfo(Sel_Table, "Col" + Str$(i), COL_INFO_NAME)
    Next
  Alter Control 2 Title From Variable gsColumn Value 1
End Sub
'
'--------------------------------------------------------------------------
'Test Si Des tables sont ouvertes
'--------------------------------------------------------------------------
Function IsTableOpen(ByVal sTabName as String) as Logical
  Dim n As Integer
  IsTableOpen = True
  OnError Goto ERROR_SPOT
  n = TableInfo(sTabName, TAB_INFO_NROWS)
  Exit Function
ERROR_SPOT:
  IsTableOpen = False
  Exit Function
End Function

Thibast · Sun 15 February 2009 22:57

Bonsoir,

Je reviens vers vous pour préciser mes questions
1- (Question sans-doute très bête); Je ne parviens pas a renvoyer les valeurs saisies dans les boites de dialogue dans les variables définies :

Code:

Control StaticText
         position 5,125
              Title "&Dossier"
         Control EditText
         position 45,124
         width 155 height 12
         ID SChem Into Chem_acces Value ApplicationDirectory$()

Schem correspond au dossier en cours mais Chem_acces est égal à rien !

2- Cette Sous Routine m'a "turlupinée" (Et je reste Poli !!) tout le WE, sans que je puisse obtenir le résultat recherché:

Code:

'-----------------------------------------------------------------------------------------
'Sous routine : GI_Bouclimage
'-----------------------------------------------------------------------------------------
sub GI_Bouclimage
dim Num_EnCours as Integer
dim cmd as string
dim Prefixe as String
dim Extension as string 
dim nom as string
dim numChps as smallint

Num_EnCours =ID_prime
Nom="Loc_"
Extension=".jpg"  
numchps=ColumnInfo(Sel_Table,Sel_Col,COL_INFO_Num) 'test
Print numchps   'retest ok le numéro est bon ...

SET COORDSYS TABLE TempSel 'pour renvoyer le systeme de coordonnées de la table en cours ??

if Num_EnCours > ID_Dernier then run command fin_Mbx 
else

'Num_EnCours=Sel_Table.Sel_Col                     'Commande Inconnue ????Sel_Table.COL(numchps) marche pas non plus
select * from sel_table where ID =Num_EnCours into Tempnum 'je ne sais pas renvoyer le nom de champs (dans le cas présent ID) par la variable Sel_Col ou le numero de olonne NumChps ...
Add Map Layer Tempnum
Set Map  Scale 1 Units "cm" For Echelle Units "cm" 
Set Map Layer 1 Label Position Above Right Font ("Arial",257,8,16711680,16777215) With sel_col Auto On
Set map zoom entire layer image_encours
set map redraw on
cmd="Save Window frontwindow() As "+chr$(34)+Chem_acces+chr$(34)+prefixe+chr$(34)+Num_EnCours+chr$(34)+Extension+chr$(34)+"Width"+chr$(34)+larg_image+chr$(34)+"Units "+chr$(34)+"mm"+chr$(34)+" Height"+chr$(34)+Haut_image+chr$(34)+"Units "+chr$(34)+"mm"+chr$(34)+" Resolution"+chr$(34)+dpi+chr$(34)
run command cmd 
fetch next from Sel_Table
End if
End sub

Non seulement cela ne fonctionne pas mais en plus il me renvoi le message "Type de Base de données non Valide. Attention : Pas de Quôte en fin de chaîne" même si je réduit cmd

Au secours je craque !!!!

Maurice · Mon 16 February 2009 23:22

Bonjour
Je ne fais qu'un court passage et je ne peux résoudre tout ce qui vous "turlupine"...
Deux pistes:
- pour bien comprendre comment fonctionnent dialogues et contrôles, en particulier comment ils renvoient des valeurs soit en cours de route par un "handler" soit à la clôture par le OK, lire ce document...
- pour la seconde question: quand on veut un JPG... il faut dire à MI: Extension=".JPEG" !!

Thibast · Tue 17 February 2009 21:21

Bonsoir,
Merci pour ces réponses;

La première, correspond plus à une véritable bible qu'a une simple piste. Je vais tacher de m'en inspirer dans l'avenir, je trouverais sans doute la (des) solution(s) à ma(mes) tracasserie(s) actuelle(s) et à venir.
Par contre, dans le seconde réponse, je pense avoir bien reporté le . de Jpg, puisqu'il est intégré au nom de la variable extension. ...

Je cherche encore ....

A bientôt.

Maurice · Tue 17 February 2009 23:41

Thibast a écrit:

Par contre, dans le seconde réponse, je pense avoir bien reporté le . de Jpg, puisqu'il est intégré au nom de la variable extension. ...

Ne cherche plus et regarde attentivement: MI veut qu'on dise JPEG, en 4 lettres, avec le "E", quand on désire du JPG (en 3 lettres) !!
ps: j'ai fait sauter le code (pour la lisibilité, tu l'avais déjà donné)

Thibast · Wed 18 February 2009 20:38

Oui Effectivement !
"Mille fois tourne ta langue dans ta bouche avant de répondre"
Je teste cela dans la foulée. Je ne dois plus être trop maintenant de l'objectif que je me suis fixé ...
Merci encore

Communauté	Ressources	L'emploi	Le marché	L'association	Fils RSS
Forum Blogs Wiki Planet Sites amis	Agenda Biblio Fiches AMO-CNIG Paris PCGIS Téléchargements	Offres d'emploi Banque de CV Formations Démarche Métiers	Geo-Entreprises Geo-Communiqué Appels d'offres	L'association Qui sommes-nous ? Nous aider Bienfaiteurs Partenaires Historique Statuts	Tout le site Job Géomatique Services GeoBlogs ...	Faire un don Mentions légales

Le portail francophone de la géomatique

Annonce

#1 Sat 14 February 2009 01:06

Probleme de code pour la génération d'images et leur enregistrement

Code:

#2 Sun 15 February 2009 22:57

Re: Probleme de code pour la génération d'images et leur enregistrement

Code:

Code:

#3 Mon 16 February 2009 23:22

Re: Probleme de code pour la génération d'images et leur enregistrement

#4 Tue 17 February 2009 21:21

Re: Probleme de code pour la génération d'images et leur enregistrement

#5 Tue 17 February 2009 23:41

Re: Probleme de code pour la génération d'images et leur enregistrement

#6 Wed 18 February 2009 20:38

Re: Probleme de code pour la génération d'images et leur enregistrement

Pied de page des forums