1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
Option Explicit
' Variables pour suivre si la sélection est en cours
Public SelectionEnCours As Boolean
Public X1 As Single
Public Y1 As Single
Public X2 As Single
Public Y2 As Single
Dim ActionOCR As String ' Variable pour stocker le type d'action OCR
Private Sub FermerBT_Click()
Unload Me
End Sub
Private Sub TitleBt_Click()
' Configuration de base
ActionOCR = "Titre"
' Sélection de zone
' Passer le formulaire en mode non modal
Me.Show vbModeless
' Activer la sélection
SelectionEnCours = True
' Afficher un message demandant à l'utilisateur de sélectionner une zone
MsgBox "Veuillez sélectionner une zone en cliquant et en faisant glisser la souris pour " & ActionOCR, vbInformation
' Attendez que l'utilisateur fasse une sélection
Do While SelectionEnCours
DoEvents ' Permet à l'application de gérer les événements
Loop
' Copie et sauvegarde de la zone sélectionnée en tant qu'image JPEG
Dim FicCible As String
FicCible = RepExport & "\" & ActionOCR & ".jpg"
CopierEtSauvegarderSelection FicCible
' Repasser le formulaire en mode modal
Me.Show vbModal
Call Programme.UtiliserTesseractOCR
Dim cheminImage As String
Dim cheminTexte As String
Dim strCommand As String
' Charger le résultat de l'OCR dans FamilleTxt et FamillecorrigeTxt
Dim FichierTxt As String
FichierTxt = cheminTexte
If Len(Dir(FichierTxt)) > 0 Then
' Utilisez la fonction FileToStr pour lire le contenu avec l'encodage UTF-8
Dim contenuFichier As String
contenuFichier = FileToStr(FichierTxt, "UTF-8")
' Affecter le contenu au contrôle de zone de texte
CreerFamilleForm.FamilleTxt.Text = contenuFichier
CreerFamilleForm.FamillecorrigeTxt.Text = contenuFichier
End If
contenuFichier = Replace(contenuFichier, vbCrLf, " ")
' Afficher le formulaire CreerFamilleForm
CreerFamilleForm.Show vbModal ' vbModal pour afficher le formulaire en mode modal
End Sub
Private Sub ChargePage_Click()
Dim cheminImageSource As String
' Utilisez la boîte de dialogue de sélection de fichier pour choisir un fichier dans RepExport
With Application.fileDialog(msoFileDialogFilePicker)
.Title = "Sélectionnez une image"
.InitialFileName = RepExport
.Filters.Add "Images", "*.jpg;*.jpeg;*.png;*.bmp;*.gif;*.tiff"
If .Show = -1 Then ' L'utilisateur a sélectionné un fichier
cheminImageSource = .SelectedItems(1)
' Appeler la procédure AfficherScan avec le chemin de l'image source en tant qu'argument
Call Programme.AfficherScan(cheminImageSource)
End If
End With
End Sub
Private Sub Scanner_Click()
Call Programme.initialisation
Call Programme.ScannerPage
Dim cheminImage As String
cheminImage = RepExport & "\frequence.jpg"
' Appeler la procédure AfficherScan avec le chemin de l'image source en tant qu'argument
Call Programme.AfficherScan(cheminImage)
End Sub
Function FileToStr(ByVal filePath As String, ByVal encoding As String) As String
Dim fileNumber As Integer
Dim fileContents As String
fileNumber = FreeFile
Open filePath For Input As fileNumber
If encoding = "ANSI" Then
fileContents = Input$(LOF(fileNumber), fileNumber)
ElseIf encoding = "UTF-8" Then
' Lire le contenu du fichier avec l'encodage UTF-8
Dim stream As Object
Set stream = CreateObject("ADODB.Stream")
stream.Open
stream.Type = 2 ' adTypeText
stream.Charset = "utf-8"
stream.LoadFromFile filePath
fileContents = stream.ReadText
stream.Close
End If
Close fileNumber
FileToStr = fileContents
End Function
Public Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
' Si la sélection est en cours, changez la forme du pointeur en une croix de sélection
If SelectionEnCours Then
ImageControl.MousePointer = 9 ' Constante pour la forme de la croix
Else
ImageControl.MousePointer = 0 ' Constante pour la forme par défaut
End If
End Sub
Public Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
' Lorsque l'utilisateur clique pour la première fois, enregistrez les coordonnées de début
X1 = X
Y1 = Y
' Indiquez que la sélection est en cours
SelectionEnCours = True
End Sub
Public Sub Image1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
' Lorsque l'utilisateur relâche le clic, enregistrez les coordonnées de fin
X2 = X
Y2 = Y
' Indiquez que la sélection est terminée
SelectionEnCours = False
' Maintenant, vous pouvez utiliser X1, Y1, X2 et Y2 pour définir la zone de sélection
' et effectuer la copie et la sauvegarde de la zone en tant qu'image JPEG
End Sub
' Fonction pour copier et sauvegarder la zone sélectionnée en tant qu'image JPEG
Public Sub CopierEtSauvegarderSelection(FicCible As String)
' Vérifiez si les coordonnées de début et de fin de la sélection sont valides
If X1 = 0 Or Y1 = 0 Or X2 = 0 Or Y2 = 0 Then
MsgBox "Please select an area to copy first.", vbExclamation
Exit Sub
End If
' Créez un objet GdPicture
Dim gdPicture As Object
Set gdPicture = CreateObject("GdPicture.GdPicture.10")
' Chargez l'image source
Dim imagePath As String
imagePath = ImageControl.Picture
If gdPicture.LoadFromFile(imagePath) = 0 Then
MsgBox "Unable to load the image.", vbExclamation
Exit Sub
End If
' Calculez les coordonnées de la zone sélectionnée
Dim width As Long
Dim height As Long
width = X2 - X1
height = Y2 - Y1
' Copiez la zone sélectionnée
gdPicture.Crop X1, Y1, width, height
' Enregistrez la zone sélectionnée en tant qu'image JPEG
If gdPicture.SaveAsJPEG(FicCible, 75) = 0 Then
MsgBox "Error while saving the image.", vbExclamation
Else
MsgBox "The selection has been copied and saved as a JPEG image.", vbInformation
End If
' Libérez les ressources de GdPicture
gdPicture.CloseImage
Set gdPicture = Nothing
End Sub |
