Code source de TXT2JPG

Avant de commencer

A propos...

Visual Basic 6TXT2JPG est un logiciel permettant de lire du texte sur n'importe quel baladeur affichant des images. Vous trouverez plus d'informations au sujet de ce logiciel sur le site du projet.
Cette page sert uniquement à l'affichage et au téléchargement du code. Si vous n'êtes pas programmeur (ou simplement curieux), vous pouvez passer votre chemin !

Le logiciel a été programmé à l'aide de l'ancien éditeur de BASIC de Microsoft, Visual Basic 6.0 (dernière version apparue avant l'avénement de l'architecture .NET).
En conséquent, le code utilise le BASIC, mais aussi les APIs mises à disposition par Windows, et les possibilités de création de contrôles.

Licence

Ce code est fourni sous la licence Creative Commons BY

Cela signifie grossièrement :

Ceci n'est qu'un résumé de la licence, l'ensemble du texte juridique peut être trouvé en suivant le lien ci-dessus.

Téléchargement

L'ensemble du code, des images et des fichiers associés peut être téléchargé ici : Zip du projet.
Cette archive contient aussi les anciennes versions des fichiers EXE de TXT2JPG, ainsi que les modules (Degrade, Convert PowerPoint)
Attention, l'ensemble pèse plus de 6Mo.

Visionnage du code source

L'arborescence du projetSi vous souhaitez juste visionner le code pour satisfaire votre curiosité, cette section devrait vous plaire !
Attention, le projet représente tout de même près de 3 000 lignes de code !

L'ensemble du code est très fortement commenté (près de 40%), et vous devriez pouvoir le comprendre sans difficulté.
En revanche, les contrôles ne sont pas du tout commentés...mais ils respectent la même structure que n'importe quel contrôle VB, et vous ne devriez donc pas avoir de problèmes pour leur compréhension si vous êtes familier des notions abordées.

La feuille principale

La feuille de travail

Seul le code de la feuille est présenté ici, le placement des contrôles ne présentant pas d'intêret. (vous le trouverez dans le zip)

Code source : Feuille.frm
  • Langage : vb
  • ΔT : 3.824s
  • Taille :117839 caractères

'--------------------------------------------------------------------------------
'    Component  : Principale
'    Project    : TXT2JPG
'
'    Description: LA feuille principale de TXT2JPG, contient tout les controles
'Your life is yours alone. Rise up and live it !
'Nothing is ever easy
'
'    Modified   :
'--------------------------------------------------------------------------------

Option Explicit

'Graphismes
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Private Declare Function TransparentBlt Lib "msimg32.dll" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nWidthSrc As Long, ByVal nHeightSrc As Long, ByVal crTranparent As Long) As Long

Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long

Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long

'Apis de telechargement
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long

Private Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hOpen As Long, ByVal sUrl As String, ByVal sHeaders As String, ByVal lLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long

Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer

Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer

'Toujours au premier plan/Déplacement de controles
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

'Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
'Convertir en JPG
Private Declare Function BMP2JPGpourVBFrance Lib "BMP2JPG.dll" (ByVal A As String, ByVal B As String, ByVal c As Integer) As Integer

'Temps
Private Declare Function GetTickCount Lib "kernel32" () As Long

'Souris
'Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
'Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
'Priorités
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long

Private Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long

'Lancer une utilitaire externe
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

'Masque le curseur du RTB
Private Declare Function HideCaret Lib "user32" (ByVal hwnd As Long) As Long

'API pour mettre en mémoire les RGB
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)

'APIs pour simuler les mouse out
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long

'Type pointApi
Private Type POINTAPI

    X As Long
    Y As Long

End Type

Private Type vRGB

    R As Byte
    G As Byte
    B As Byte

End Type

Private NotUse As Boolean, DoNotChange As Boolean, BG_red As Long, BG_green As Long, BG_blue As Long, sens_dessin As Long

Private poubelle As Long, tempo As Long, NonForcé As Boolean

Private SelectedPlug As Control, IsSlidingWorking As Boolean, NoSelEvents As Boolean, SVGofRTF As String    'Variables génerales pour le programme

Private Splitter As String, Splitter_Cur As Long, Split_Count As Long   'Les paramètres pour le Split des chapter

Private MyChoiceIs As Long  'Empeche de redemander à chaque fois les paramètres pour les images lorsque l'on utilise splitchapter

Private BackPicture As IPictureDisp 'L'image de fond, si il ne s'agit pas d'un dégradé

Private debut As Single 'Pour tout les timers...

Private NoInternet As Boolean   'Si pas de connexion vaut true

Private Reponse As String, Couleur_Selectionnee As Long 'Contient la réponse du Comdlg

Private TailleTexte As Long

Private CleverColor As Boolean 'détrermine si les forecolor doivent s'adapter à l'arrière plan.

'Messages Windows
Const WM_PASTE = &H302

Const WM_VSCROLL = &H115

'Messages Windows Priorité
'Const NORMAL_PRIORITY_CLASS As Long = &H20 ' normal
Const ABOVE_NORMAL_PRIORITY_CLASS As Long = &H8000 ' normal +

Const HIGH_PRIORITY_CLASS As Long = &H80 ' haute

Const REALTIME_PRIORITY_CLASS As Long = &H100 ' maximum

'Messages RTFBox/ComboBox
Const SB_PAGEDOWN = 3

Const EM_CHARFROMPOS = &HD7

Const CB_SHOWDROPDOWN = &H14F

Const CB_SETDROPPEDWIDTH = &H160

Const Barre As String = "{\pict\wmetafile8\picw1764\pich882\picwgoal9070\pichgoal29 " & vbCrLf & "010009000003bb00000006001c00000000000400000003010800050000000b0200000000050000" & vbCrLf & "000c023300ca0e040000002e0118001c000000fb021000070000000000bc020000000001020222" & vbCrLf & "53797374656d0000ca0e00002c3e0000a489120026e2823900d61a000c020000040000002d0100" & vbCrLf & "0004000000020101001c000000fb029cff0000000000009001000000000440001254696d657320" & vbCrLf & "4e657720526f6d616e0000000000000000000000000000000000040000002d0101000500000009" & vbCrLf & "02000000020d000000320a5a0000000100040000000000c50e320020932d00030000001e000700" & vbCrLf & "0000fc020000dbdee8000000040000002d01020008000000fa02050000000000ffffff00040000" & vbCrLf & "002d0103000e00000024030500ffffffffffff3200c40e3200c40effffffffffff08000000fa02" & vbCrLf & "00000000000000000000040000002d01040007000000fc020000ffffff000000040000002d0105" & vbCrLf & "00040000002701ffff040000002d010000030000000000" & vbCrLf & "}"

Private Sub Do_Abort()
    On Error Resume Next
    Abandon.Visible = True
    Abandon.Top = 126
    tempo = Timer

    Do
        DoEvents
        DoEvents
        Abandon.Top = 126 - (Timer - tempo) * 31.5
    Loop While Timer - tempo < 3

    Abandon.Visible = False
End Sub

Public Sub Form_TailleChange()
    'Sub triggered chaque fois qu'il y a un évenement size
    On Error Resume Next

    'Autorise le redimensionnement de la feuille. Replace les controles au bons endroits
    Dim Current_Height As Long, Current_Width As Long

    Current_Height = Me.ScaleHeight
    Current_Width = Me.ScaleWidth
    'If Current_Height < 310 Then Me.ScaleHeight = 310: Exit Sub
    'If Current_Width < 600 Then Me.ScaleHeight = 600: Exit Sub
    'Redimensionner sur la hauteur
    'Replacer les controles
    Apercu.Height = IIf(Rechercher.Visible, Me.ScaleHeight - Rechercher.Height - Apercu.Top, Me.ScaleHeight - Apercu.Top - 12)
    Separateur(0).Y2 = Me.ScaleHeight
    Rechercher.Top = Current_Height - 30
    MainContainer.Top = Current_Height \ 2 - MainContainer.Height \ 2
    SelectedPlug.Top = Current_Height \ 2 - SelectedPlug.Height \ 2
    'Replacer la fenêtre au milieu :
    'Me.Top = Screen.Height \ 2 - (Me.Height \ 2)
    'Redimensionner sur la largeur
    'Replacer les controles
    Apercu.Width = Current_Width - 362
    MainContainer.Left = Apercu.Left + Apercu.Width + 2
    Separateur(0).X1 = MainContainer.Left + MainContainer.Width + 4
    Separateur(0).X2 = MainContainer.Left + MainContainer.Width + 4
    SelectedPlug.Left = MainContainer.Left + MainContainer.Width + 7
    BallonTip.Visible = False

    Form_Redraw
End Sub

Private Sub Glass(X1 As Long, Y1 As Long, X2 As Long, Y2 As Long, Optional Me_DC As Long = 0)
    On Error Resume Next
    'Une petite sub bien pratique qui permet d'afficher un glassage par dessus un controle, pour le mettre en valeur ou simplement pour faire joli !
    Dim X    As Long, Y As Long, V As Long, T As Long, pre_compute As Long, pre_compute2 As Long, pre_compute3 As Long, pre_compute4 As Long, pre_compute5 As Long, LenType As Long

    Dim iRGB As vRGB

    iRGB.B = 0: iRGB.R = 0: iRGB.G = 0
    LenType = LenB(iRGB)

    If Me_DC = 0 Then Me_DC = myHDC
    pre_compute = X1 + X2

    For Y = 0 To 10
        pre_compute2 = Y1 + Y
        pre_compute3 = (15 - Y) * (10 - Y \ 2)

        For X = X1 To pre_compute
            'Haut
            V = GetPixel(Me_DC, X, pre_compute2)
            CopyMemory iRGB, V, LenType
            SetPixelV Me_DC, X, pre_compute2, RGB(Min(iRGB.R + pre_compute3, 255), Min(iRGB.G + pre_compute3, 255), Min(iRGB.B + pre_compute3, 255))
        Next
    Next

    'La partie la plus longue : le milieu
    pre_compute4 = Y2 - 5 - Y1

    For Y = 11 To pre_compute4
        pre_compute2 = Y1 + Y
        pre_compute3 = (15 - Y) * (10 - Y \ 2)

        For X = X1 To pre_compute
            V = GetPixel(Me_DC, X, pre_compute2)
            CopyMemory iRGB, V, LenType
            SetPixelV Me_DC, X, pre_compute2, RGB(Min(iRGB.R + 20, 255), Min(iRGB.G + 20, 255), Min(iRGB.B + 20, 255))
        Next
    Next

    T = 2
    pre_compute3 = Y2 - Y1

    For Y = pre_compute4 To pre_compute3
        T = T + 2
        pre_compute2 = Y1 + Y
        pre_compute5 = (T + 2) * (T \ 2)

        For X = X1 To pre_compute
            V = GetPixel(Me_DC, X, pre_compute2)
            CopyMemory iRGB, V, LenType
            SetPixelV Me_DC, X, pre_compute2, RGB(Min(iRGB.R + pre_compute5, 255), Min(iRGB.G + pre_compute5, 255), Min(iRGB.B + pre_compute5, 255))
        Next
    Next

    If Me_DC = myHDC Then Me.Line (X1, Y1)-(X1 + X2, Y2), RGB(192, 192, 192), B
End Sub

Private Sub Numeriser()

    'LA SUB PRINCIPALE ! EN FIN ? ENFIN !
    'C'est celle qui fait toute la numérisation..
    Dim C_dc  As Long, numero As Long, LastLen As Long, Size As Long, base As String, racine As String, Utilisation_Filigrane As Boolean, Couleur_De_Fond As Long, HHauteur As Long, LLargeur As Long, JPG As Boolean, nom_Fichier As String, c_SelStart As Long, R_DC As Long, Image_A_Blitter_DC As Long, app_path As String, MargeTop As Long, MargeBottom As Long, MarquerPage As Boolean, avancement_DC As Long, Xp As Long, Yp As Long, Retours_Chariot As String, Converter_Hwnd As Long, Retour As Long, pt As POINTAPI, TinySize As Long, EraseUncompleteLine As Boolean, curseur_x As Long, curseur_y As Long, LigneIncomplete As Boolean

    Dim ProgressBar_DC As Long, ProgressBar_FORE_DC As Long

    'Changer la priorité du processus !
    If GetSetting("TXT2JPG", "Data", "Priorite", "Normal") <> "Normal" Then ReglerPriorite GetSetting("TXT2JPG", "Data", "Priorite", "Normal")
    'Ensuite cacher ce sein que je ne saurais voir :
    BUG.Visible = False

    Form_Redraw 'Rafraichir l'ensemble
    app_path = GetSetting("TXT2JPG", "Data", "Default_Path", "NotDefine")

    'Si jamais c'est la toute première fois :-)
    If app_path = "NotDefine" Then

        Do
            app_path = SelectFolder(LoadString(1), Me.hwnd)
        Loop While app_path = vbNullString Or app_path = "NotDefine"

        SaveSetting "TXT2JPG", "Data", "Default_Path", app_path
    End If

    'Sauver les données utiles en variables pour minimiser le temps d'accès
    If UseTopAndBottomMargin.Value = 0 Then
        'Si l'on a dit qu'on ne voulait pas de marges haut bas, on met à 0
        SetMarge(2).Tag = 0
        SetMarge(3).Tag = 0
    End If

    MargeTop = SetMarge(2).Tag
    MargeBottom = SetMarge(3).Tag
    MarquerPage = Pagination.Value
    HHauteur = Hauteur.Text - MargeTop - MargeBottom
    LLargeur = Largeur.Text
    Converter.Width = LLargeur
    Converter.Height = HHauteur

    If Converter.Height > 230 Then
        Me.WindowState = vbNormal
        Me.Height = (50 + Converter.Height + 56) * Screen.TwipsPerPixelY
        MainContainer.Top = 7
    End If

    Resultat.Width = LLargeur
    Resultat.Height = HHauteur + MargeTop + MargeBottom
    nom_Fichier = Dest_Folder.Text
    racine = Root.Text

    'Les erreurs potentielles
    If Dest_Folder.Invalide Or Dest_Folder.Text = vbNullString Then
        'Pas de nom de fichiers, ou erreur
        PlugChoice(0).Value = True
        Dest_Folder.Invalide = True
        Dest_Folder.SetFocus

        Exit Sub

    End If

    If Root.BackColor = 255 Then
        'Mauvais nom de racine
        PlugChoice(2).Value = True
        Root.SetFocus

        Exit Sub

    End If

    If Dir$(Filig.Text) = vbNullString Then
        PlugChoice(1).Value = True
        Filig.SetFocus

        Exit Sub

    End If

    If SplitChapter.Value = True And (KeyWord.Text = vbNullString Or KeyWord.Invalide = True) Then
        PlugChoice(2).Value = True
        KeyWord.SetFocus

        Exit Sub

    End If

    numero = 0

    'Creer le dossier (si pas crée, evidemment)
    If Dir$(app_path & "\" & nom_Fichier, vbDirectory) = vbNullString Then MkDir app_path & "\" & nom_Fichier

    'Redimensionner l'image de fond si besoin est
    If RedimToFit.Value = True Then

        With Image_A_Blitter
            .BackColor = RGB(254, 255, 255)
            .AutoSize = False
            .Width = Largeur.Text
            .Height = Hauteur.Text
            .Picture = LoadPicture(vbNullString)
            .PaintPicture LoadPicture(Filig.Text), 0, 0, Largeur.Text, Hauteur.Text
        End With

    Else
        Image_A_Blitter.Picture = LoadPicture(Filig.Text)
    End If

    If Filig.Text <> vbNullString Then
        'Tous les cas d'utilisations de filigrane
        Utilisation_Filigrane = True

        If Cover.Value = True Then
            Utilisation_Filigrane = False
            BitBlt Resultat.hdc, 0, 0, Largeur.Text, Hauteur.Text, Image_A_Blitter.hdc, 0, 0, vbSrcCopy
            Resultat.Refresh
            SavePicture Resultat.Image, app_path & "\" & nom_Fichier & "\" & racine & "0000.bmp"
            numero = 1
        End If
    End If

    'Mettre au premier plan
    SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 2 Or 1

    Me.Caption = LoadString(2)

    'Masquer les controles
    On Error Resume Next

    SelectedPlug.Visible = False
    MainContainer.Visible = False
    BallonTip.Visible = False
    Separateur(0).Visible = False
    MAJ.Enabled = False
    Apercu.Visible = False
    etiquette(15).Visible = False
    etiquette(0).Visible = True
    Griser_Fermer (Me.hwnd)
    Set etiquette(0).Container = Me
    etiquette(0).Move LLargeur + 55, 56, 253, HHauteur - 5
    Glass LLargeur + 45, 50, 258, 60 + HHauteur - 5
    etiquette(0).Caption = LoadString(3) & vbCrLf & LoadString(4) & vbCrLf
    etiquette(0).ForeColor = RGB(255, 255, 255) - GetPixel(myHDC, LLargeur + 50, 26)
    Converter.Visible = True

    If SplitChapter.Value = True Then      'Splittage des chapitres
        If Splitter = vbNullString Then
            'Premier split
            Splitter = Apercu.TextRTF
            Splitter_Cur = 1
            Split_Count = 0
        End If

        Converter.TextRTF = Splitter

        DoEvents
        etiquette(0).Caption = Replace(LoadString(5), "%u", KeyWord.Text) & vbCrLf & LoadString(6) & Split_Count & vbCrLf

        If Splitter_Cur = Len(Converter.Text) Then
            ShellExecute Me.hwnd, "open", app_path & "\" & Dest_Folder.Text & "\", vbNullString, App.Path, 1
            Unload Me

            Exit Sub

        End If

        Split_Count = Split_Count + 1

        DoEvents
        Converter.SelStart = Splitter_Cur - 1
        Splitter_Cur = InStr(Splitter_Cur + 5, Converter.Text, KeyWord.Text)

        If Splitter_Cur = 0 Then Splitter_Cur = Len(Converter.Text)
        Converter.SelLength = Splitter_Cur - Converter.SelStart - 1
        Converter.TextRTF = Converter.SelRTF
        Apercu.TextRTF = Converter.TextRTF
    End If

    'Et ca commence ! On est sur qu'il n'y a pas de problèmes !
    Me.MousePointer = vbCustom

    DoEvents
    SVGofRTF = Apercu.TextRTF
    Converter.TextRTF = SVGofRTF
    Apercu.TextRTF = vbNullString

    DoEvents
    Couleur_De_Fond = Couleur(1).BackColor
    C_dc = GetDC(Converter.hwnd)
    avancement_DC = Avancement.hdc
    LastLen = Len(Converter.Text)
    Converter.SelStart = LastLen
    Converter.SelLength = 0
    EraseUncompleteLine = Not (Type_Numerisation.Value)
    Retours_Chariot = vbNullString

    For tempo = 1 To 25
        Retours_Chariot = Retours_Chariot & vbCrLf
    Next

    Converter.SelText = Retours_Chariot
    Converter.SelFontSize = 8.25

    DoEvents
    JPG = En_JPG.Value
    'Converter.SelStart =
    Size = Len(Converter.Text) 'Converter.SelStart
    Converter.SelStart = 0
    c_SelStart = 0
    Resultat.BackColor = RGB(255, 255, 255)
    R_DC = Resultat.hdc
    Image_A_Blitter_DC = Image_A_Blitter.hdc

    If InStr(1, SVGofRTF, "\pict") <> 0 Then
        Converter.Enabled = False
        PlugChoice_Click 6

        With Plug(6)
            .Visible = 1
            .Top = (Me.ScaleHeight - .Height) \ 2
            BitBlt .hdc, 0, 0, 176, 289, myHDC, .Left, .Top, vbSrcCopy
            .Left = 745
            .Refresh
        End With

        Set SelectedPlug = Plug(tempo)

        For tempo = 0 To PlugChoice.Count - 1
            Plug(tempo).Visible = False
        Next

        DoEvents
        IsSlidingWorking = True

        Do
            DoEvents
            DoEvents
        Loop While (IsSlidingWorking = True And MyChoiceIs = 25)

        DoEvents
        DoEvents

        If MyChoiceIs <> 25 Then
            Traitement_Img(0).Value = False
            Traitement_Img(1).Value = False
            Traitement_Img(2).Value = False
            Traitement_Img(MyChoiceIs).Value = True
        End If

        tempo = 1

        If Traitement_Img(1).Value = True Or Traitement_Img(2).Value = True Then

            Dim poubelle As String, LLargeurReelle As Long

            LLargeurReelle = LLargeur - SetMarge(0).Tag - SetMarge(1).Tag
            etiquette(0).Caption = etiquette(0).Caption & LoadString(7) & vbCrLf

            Do
                'Redimensionner toutes les images
                'D'abord les Width
                tempo = InStr(tempo, SVGofRTF, "\objw")

                If tempo = 0 Then Exit Do
                tempo = tempo + 5
                poubelle = vbNullString

                Do
                    poubelle = poubelle & Mid$(SVGofRTF, tempo, 1)
                    tempo = tempo + 1
                Loop While (Mid$(SVGofRTF, tempo, 1) Like "[123456789]")

                If Val(poubelle) \ Screen.TwipsPerPixelX > LLargeurReelle Then
                    'Redimensionner (fonction de malade !)
                    Mid$(SVGofRTF, tempo - Len(poubelle), Len(poubelle)) = FORMAT$(LLargeurReelle * Screen.TwipsPerPixelX, Replace(Space$(Len(poubelle)), " ", "0"))
                End If

                If Traitement_Img(2).Value = True Then
                    'Ensuite les height
                    tempo = InStr(tempo - 1, SVGofRTF, "\objh")

                    If tempo = 0 Then Exit Do
                    tempo = tempo + 5
                    poubelle = vbNullString

                    Do
                        poubelle = poubelle & Mid$(SVGofRTF, tempo, 1)
                        tempo = tempo + 1
                    Loop While (Mid$(SVGofRTF, tempo, 1) Like "[0123456789]")

                    If Val(poubelle) \ Screen.TwipsPerPixelY > HHauteur Then
                        'Redimensionner (fonction de malade ! 2 )
                        Mid$(SVGofRTF, tempo - Len(poubelle), Len(poubelle)) = FORMAT$(HHauteur * Screen.TwipsPerPixelY, Replace(Space$(Len(poubelle)), " ", "0"))
                    End If
                End If

            Loop

            tempo = 1

            Do
                'Redimensionner toutes les images incluse d'origine dans le fichier
                'Uniquement les picwgoal
                tempo = InStr(tempo, SVGofRTF, "\picwgoal")

                If tempo = 0 Then Exit Do
                tempo = tempo + 9
                poubelle = vbNullString

                Do
                    poubelle = poubelle & Mid$(SVGofRTF, tempo, 1)
                    tempo = tempo + 1
                Loop While (Mid$(SVGofRTF, tempo, 1) Like "[0123456789]")

                If Val(poubelle) \ Screen.TwipsPerPixelX > LLargeurReelle Then
                    'Redimensionner (fonction de malade !)
                    Mid$(SVGofRTF, tempo - Len(poubelle), Len(poubelle)) = FORMAT$(LLargeurReelle * Screen.TwipsPerPixelX, Replace(Space$(Len(poubelle)), " ", "0"))
                End If

                If Traitement_Img(2).Value = True Then
                    'Ensuite les height
                    tempo = InStr(tempo - 1, SVGofRTF, "\pichgoal")

                    If tempo = 0 Then Exit Do
                    tempo = tempo + 9
                    poubelle = vbNullString

                    Do
                        poubelle = poubelle & Mid$(SVGofRTF, tempo, 1)
                        tempo = tempo + 1
                    Loop While (Mid$(SVGofRTF, tempo, 1) Like "[0123456789]")

                    If Val(poubelle) \ Screen.TwipsPerPixelY > HHauteur Then
                        'Redimensionner (fonction de malade ! 2 )
                        Mid$(SVGofRTF, tempo - Len(poubelle), Len(poubelle)) = FORMAT$(HHauteur * Screen.TwipsPerPixelY, Replace(Space$(Len(poubelle)), " ", "0"))
                    End If
                End If

            Loop

            Converter.TextRTF = SVGofRTF

            'Sauvegarder ces paramètres au cas ou on fait une numérisation multiple
            If Traitement_Img(0).Value = True Then MyChoiceIs = 0
            If Traitement_Img(1).Value = True Then MyChoiceIs = 1
            If Traitement_Img(2).Value = True Then MyChoiceIs = 2
        End If

        Converter.Enabled = True
    End If

    etiquette(0).Caption = etiquette(0).Caption & LoadString(8) & GetSetting("TXT2JPG", "Data", "Priorite", "Normal") & vbCrLf

    If Utilisation_Filigrane = True Then
        etiquette(0).Caption = etiquette(0).Caption & Replace(LoadString(9), "%u", Filig.Text) & vbCrLf
    Else
        etiquette(0).Caption = etiquette(0).Caption & LoadString(10) & vbCrLf
    End If

    etiquette(0).Caption = etiquette(0).Caption & LoadString(11) & Int(LastLen \ ((HHauteur * LLargeur) \ 64) * 2.5 + 1) & vbCrLf
    etiquette(0).Caption = etiquette(0).Caption & LoadString(12) & vbCrLf & vbCrLf & vbCrLf

    'Enfin... c'est maintenant que ca commence vraiment !
    etiquette(0).Caption = etiquette(0).Caption & LoadString(13) & vbCrLf

    Start.Visible = False
    base = app_path & "\" & nom_Fichier & "\" & racine
    Converter_Hwnd = Converter.hwnd

    If SplitChapter.Value = True Then
        base = base & KeyWord.Text & " " & Split_Count & "\"

        If Dir$(base, vbDirectory) = vbNullString Then MkDir base
    End If

    If PutACopyOfFileInFolder.Value = True Then
        Converter.SaveFile base & nom_Fichier & ".rtf"
    End If

    Converter.SetFocus
    pt.X = LLargeur - 2
    pt.Y = HHauteur - 2
    HideCaret Converter_Hwnd    'Masque le caret
    Retour = 0
    TinySize = Max(Size - 2000, 0)
    'Et centrer la feuille :
    Me.Left = (Screen.Width - Me.Width) \ 2
    Me.Top = (Screen.Height - Me.Height) \ 2
    Me.Width = (LLargeur + 50 + 253 + 20) * Screen.TwipsPerPixelY
    Size = Len(Converter.Text)
    'Préparer le progressbar :
    ProgressBar_DC = ProgressBar.hdc
    ProgressBar.Height = 48
    ProgressBar_FORE_DC = ProgressBar_FORE.hdc
    ProgressBar.Visible = True
    BitBlt ProgressBar_DC, 0, 0, 563, 48, myHDC, ProgressBar.Left, 0, vbSrcCopy
    BitBlt ProgressBar_DC, 0, 3, 563, 21, ProgressBar_BACK.hdc, 0, 0, vbSrcCopy
    BitBlt ProgressBar_DC, 0, 27, 563, 21, ProgressBar_BACK.hdc, 0, 0, vbSrcCopy
    Me.Refresh

    For tempo = 0 To 15

        DoEvents
        DoEvents
    Next

'C EST PARTI ICI :
    Do

        If Utilisation_Filigrane Then
            'Si on utilise un filigrane, on fait en deux fois : d'abord on blitte l'image de fond
            BitBlt R_DC, 0, 0, LLargeur, HHauteur + MargeTop + MargeBottom, Image_A_Blitter_DC, 0, 0, vbSrcCopy
            'Et ensuite on transparentblit le texte par dessus
            TransparentBlt R_DC, 0, MargeTop, LLargeur, HHauteur, C_dc, 0, 0, LLargeur, HHauteur, Couleur_De_Fond
        Else
            'Sinon, c'est pas compliqué : on fait un seul blit !
            BitBlt R_DC, 0, MargeTop, LLargeur, HHauteur, C_dc, 0, 0, vbSrcCopy
        End If

        If MarquerPage Then
            'Là, on marque le numéro de page au fer rouge en bas de l'image...
            StretchBlt R_DC, 0, HHauteur + MargeTop, c_SelStart * (LLargeur - 30) \ Size + 30, MargeBottom, avancement_DC, 0, 0, 2, 20, vbSrcCopy
            TextOut R_DC, 0, HHauteur + MargeTop + (MargeBottom - 12) \ 2, FORMAT$(numero, "0000"), 4
        End If
        If EraseUncompleteLine Then
            'Et on efface les lignes incomplètes...
            'On commence par le haut
            curseur_y = HHauteur + MargeTop
            Do
                curseur_y = curseur_y - 1
                LigneIncomplete = False
                If Utilisation_Filigrane Then
                    BitBlt R_DC, 0, curseur_y + 1, LLargeur, 1, Image_A_Blitter_DC, 0, curseur_y + 1, vbSrcCopy
                Else
                    BitBlt R_DC, 0, curseur_y + 1, LLargeur, 1, C_dc, 0, 0, &HFF0062
                End If
                For curseur_x = 0 To LLargeur
                    If GetPixel(R_DC, curseur_x, curseur_y) = vbBlack Then LigneIncomplete = True: Exit For
                Next
            Loop While LigneIncomplete = True
            'Et on finit par le bas
            curseur_y = 0
            Do
                curseur_y = curseur_y + 1
                LigneIncomplete = False
                If Utilisation_Filigrane Then
                    BitBlt R_DC, 0, curseur_y - 1, LLargeur, 1, Image_A_Blitter_DC, 0, curseur_y - 1, vbSrcCopy
                Else
                    BitBlt R_DC, 0, curseur_y - 1, LLargeur, 1, C_dc, 0, 0, &HFF0062
                End If
                For curseur_x = 0 To LLargeur
                    If GetPixel(R_DC, curseur_x, curseur_y) = vbBlack Then LigneIncomplete = True: Exit For
                Next
            Loop While LigneIncomplete = True
        End If
        SavePicture Resultat.Image, base & FORMAT$(numero, "0000") & ".bmp"
        numero = numero + 1
        'Envoyer un message : pagedown et scroll
        SendMessage Converter_Hwnd, WM_VSCROLL, SB_PAGEDOWN, 0

        If Retour < TinySize Then
            Retour = Retour + 1500
        Else
            'Envoyer un message : avoir la position en fonction d'un point(le bord droit du RTB)
            Retour = SendMessage(Converter_Hwnd, EM_CHARFROMPOS, 0&, pt)
            'Puis on remet à jour le progress bar...
            BitBlt ProgressBar_DC, 0, 3, 563, 21, ProgressBar_BACK.hdc, 0, 0, vbSrcCopy
            StretchBlt ProgressBar_DC, 1, 28, (Retour * 561) \ Size, 19, ProgressBar_FORE_DC, 0, 0, 67, 19, vbSrcCopy
            TextOut ProgressBar_DC, 275, 30, FORMAT$((Retour * 100) \ Size, "000") & "%", 4
        End If

        DoEvents
        'Barre d'avancement
        StretchBlt ProgressBar_DC, 1, 4, (Retour * 561) \ Size, 19, ProgressBar_FORE_DC, 0, 0, 67, 19, vbSrcCopy
        ProgressBar.Refresh
    Loop While Retour <> Size

    'If LastLen < TotalLen Then
    '    numero = numero - 1
    '    GoTo demarrage
    'End If
    etiquette(0).Caption = etiquette(0).Caption & LoadString(14) & vbCrLf
    'Détruire les dernière image blanches
    tempo = 0
    Image_A_Blitter.Visible = True
    Converter.Visible = False
    Image_A_Blitter.Left = 5
    Image_A_Blitter.Top = 50

    Do
        tempo = tempo + 1
        Image_A_Blitter.Picture = LoadPicture(base & FORMAT$(numero - tempo, "0000") & ".bmp")
        Size = 0

        'Check les images blanches
        Dim NouLarg As Long, NouHaut As Long

        NouLarg = LLargeur - 5
        NouHaut = HHauteur - 5

        For Xp = 5 To NouLarg
            For Yp = 5 To NouHaut
                Size = Size + (16777215 - GetPixel(Image_A_Blitter.hdc, Xp, Yp))

                If Size > 1 Then Size = 1: Exit For
            Next

            If Size >= 1 Then Exit For
        Next

        If Size = 0 Then Kill base & FORMAT$(numero - tempo, "0000") & ".bmp"
    Loop While Size = 0

    numero = numero - tempo
    BitBlt ProgressBar_DC, 0, 0, 563, 48, myHDC, ProgressBar.Left, 0, vbSrcCopy
    BitBlt ProgressBar_DC, 0, 3, 563, 21, ProgressBar_BACK.hdc, 0, 0, vbSrcCopy

    If JPG Then

        'Conversion en JPG
        etiquette(0).Caption = etiquette(0).Caption & LoadString(15) & vbCrLf
        Me.MousePointer = vbCustom

        For tempo = 0 To numero
            Convert base & FORMAT$(tempo, "0000")

            DoEvents
            StretchBlt ProgressBar_DC, 1, 4, (600 * tempo) \ numero, 19, ProgressBar_FORE_DC, 0, 0, 67, 19, vbSrcCopy
            ProgressBar.Refresh
            Kill base & FORMAT$(tempo, "0000") & ".bmp"
        Next

    End If

    Converter.Visible = False
    Resultat.Visible = False
    Image_A_Blitter.Visible = False

    If SplitChapter.Value Then Numeriser: Exit Sub
    etiquette(0).Caption = etiquette(0).Caption & Replace(LoadString(16), "%u", numero) & vbCrLf & LoadString(18)

    DoEvents
    'Et voilà ! C'est terminé !
    'D'abord, on enregistre l'adresse du fichier
    If PutACopyOfFileInFolder Then
        SaveSetting "TXT2JPG", "Data", "Last_File", base & nom_Fichier & ".rtf"
    End If
    ShellExecute Me.hwnd, "open", app_path & "\" & Dest_Folder.Text & "\", vbNullString, App.Path, 1
    Unload Me
End Sub

Private Sub ReglerPriorite(Niveau As String)

    'Fonction réglant la priorité en cas de besoin, selon le niveau demandé
    On Error Resume Next

    If Niveau = "ABOVE_NORMAL_PRIORITY_CLASS" Then SetPriorityClass GetCurrentProcess(), ABOVE_NORMAL_PRIORITY_CLASS
    If Niveau = "HIGH_PRIORITY_CLASS" Then SetPriorityClass GetCurrentProcess(), HIGH_PRIORITY_CLASS
    If Niveau = "REALTIME_PRIORITY_CLASS" Then SetPriorityClass GetCurrentProcess(), REALTIME_PRIORITY_CLASS
End Sub

Private Sub Convert(Entree As String)
    On Error Resume Next
    'Convertit l'image d'entrée de BMP vers JPG
    BMP2JPGpourVBFrance Entree & ".bmp", Entree & ".jpg", Qualite.Tag  'qualité réglable de 1 à 100
End Sub

Public Sub Download(URL As String, Optional Stockage2 As String = "Nothing")
    On Error Resume Next
    'Telecharge un fichier spécifié
    If NoInternet = True Then Exit Sub
    If Stockage2 = "Nothing" Then Stockage2 = Stockage

    Dim hOpen              As Long, App_Name As String

    Dim hOpenUrl           As Long

    Dim bDoLoop            As Boolean

    Dim sReadBuffer        As String * 2048

    Dim lNumberOfBytesRead As Long

    Dim sBuffer            As String

    App_Name = Me.Caption
    lNumberOfBytesRead = 0
    debut = GetTickCount()
    Me.Caption = "TXT 2 JPG =>" & LoadString(19)
    'Vider les déchets
    Kill Stockage2
    Open Stockage2 For Output As #1
        Print #1, vbNullString
    Close #1
    hOpen = InternetOpen("Zen User", 0, vbNullString, vbNullString, 0)
    hOpenUrl = InternetOpenUrl(hOpen, URL, vbNullString, 0, &H80000000, 0)
    bDoLoop = True

    While bDoLoop

        sReadBuffer = vbNullString
        InternetReadFile hOpenUrl, sReadBuffer, Len(sReadBuffer), lNumberOfBytesRead
        sBuffer = sBuffer & Left$(sReadBuffer, lNumberOfBytesRead)

        If Not CBool(lNumberOfBytesRead) Then bDoLoop = False
        If GetTickCount - debut > 5000 Then
            MsgBox LoadString(20), vbExclamation + vbOKOnly
            NoInternet = True
            GoTo err_handler
        End If

    Wend

err_handler:
    Open Stockage2 For Binary Access Write As #1
    Put #1, , sBuffer
    Close #1
    DoEvents
    If hOpenUrl <> 0 Then InternetCloseHandle (hOpenUrl)
    If hOpen <> 0 Then InternetCloseHandle (hOpen)
    Me.Caption = App_Name
End Sub

'Redessine la feuille et les conteneurs, appelable lors d'un redimensionnement par exemple
Public Sub Form_Redraw(Optional cWidth As Long = 0)
    On Error Resume Next

    If cWidth = 0 Then cWidth = Me.ScaleWidth

    Dim Hauteur_f As Long, PreCompile As Single

    Hauteur_f = Me.ScaleHeight

    If GetSetting("TXT2JPG", "Data", "BackPic", vbNullString) = vbNullString Then

        'Dessiner le BG
        For tempo = 0 To Hauteur_f
            PreCompile = Abs(255 * sens_dessin - ((255 * tempo) \ Hauteur_f))
            SetPixelV myHDC, 0, tempo, RGB(BG_red * PreCompile, BG_green * PreCompile, BG_blue * PreCompile)
        Next

        'Le stretcher
        StretchBlt myHDC, 0, 0, cWidth, Hauteur_f, myHDC, 0, 0, 1, Hauteur_f, vbSrcCopy
    Else
        Me.PaintPicture BackPicture, 0, 0, cWidth, Me.ScaleHeight
    End If

    If CleverColor Then

        For tempo = 0 To etiquette.UBound
            etiquette(tempo).ForeColor = IIf(GetPixel(myHDC, etiquette(tempo).Left, etiquette(tempo).Top) > 8421504, vbBlack, vbWhite)
        Next

    End If

    Me.Refresh
    MAJ.Enabled = True

    'Les conteneurs :
    For tempo = 0 To PlugChoice.Count - 1

        If PlugChoice(tempo).Value = 0 Then
            PlugChoice(tempo).BackColor = GetPixel(myHDC, PlugChoice(tempo).Left + PlugChoice(tempo).Container.Left, PlugChoice(tempo).Top + PlugChoice(tempo).Container.Top)
            PlugChoice(tempo).ForeColor = 16777215 - PlugChoice(tempo).BackColor
        Else
            PlugChoice(tempo).BackColor = &H8000000F
            PlugChoice(tempo).ForeColor = &H80000012
        End If

    Next

    BitBlt SelectedPlug.hdc, 0, 0, 176, 289, myHDC, SelectedPlug.Left, SelectedPlug.Top, vbSrcCopy
    BitBlt MainContainer.hdc, 0, 0, 168, 302, myHDC, MainContainer.Left, MainContainer.Top, vbSrcCopy
    SelectedPlug.Refresh
    MainContainer.Refresh
End Sub

Private Sub Load_Text_File(File_Path As String, Optional ISAnInternetURL As Boolean = False)

    'Objets ole utilisés pour charger les formats exotiques, et les formats standards aussi. Gestion htm, pdf,lrc,doc,txt,rtf.
    'On Error GoTo err_handler

    Dim oWord   As Object

    Dim oDoc    As Object

    Dim oIE     As Object

    Dim donnees As String, auteur As String, Start As Long, total As Long, Titre As String

    Apercu.TextRTF = vbNullString
    Apercu.Text = LoadString(21)
    'Charge un fichier autorisé (3 sources : browse_click + ole apercu et directory)
    Directory.Text = File_Path
    Me.MousePointer = vbCustom

    DoEvents

    If LCase$(Right$(Directory.Text, 3)) = "txt" Or LCase$(Right$(Directory.Text, 3)) = "rtf" Then
        '--------------------------------------------->Fichiers txt et rtf>---------------------------------------------
        Apercu.LoadFile Directory.Text
    Else

        If LCase$(Right$(Directory.Text, 3)) = "doc" Or LCase$(Right$(Directory.Text, 4)) = "docx" Then
            '--------------------------------------------->Fichiers doc>---------------------------------------------
            'Créer l'application Word
            Set oWord = CreateObject("word.application")
            'Ouvrir le document
            Set oDoc = oWord.documents.Add(File_Path)
            Apercu.TextRTF = LoadString(22) & vbCrLf & LoadString(23)
            oWord.Application.Selection.WholeStory
            oWord.Application.Selection.Copy

            DoEvents
            oWord.Quit
            Set oWord = Nothing    ' détruire l'objet Word
            Apercu.TextRTF = LoadString(24)
            CollerWordFile.Enabled = True
        ElseIf ISAnInternetURL Then
            '--------------------------------------------->Fichiers Internet : htm,asp,xhtml,html,php...>---------------------------------------------
            'Créer l'instance d'IE
            Set oIE = CreateObject("internetexplorer.application")
            'Telecharger la page en arrière plan
            oIE.Navigate (File_Path)
            Apercu.TextRTF = LoadString(25) & vbCrLf & LoadString(26)

            DoEvents

            'Attendre la fin du telechargement pour continuer
            Do While (oIE.ReadyState <> 4)
            Loop

            Apercu.TextRTF = LoadString(27) & vbCrLf & LoadString(28) & vbCrLf & LoadString(29)

            DoEvents
            'Copier l'adresse
            oIE.Document.body.createTextRange.execCommand ("Copy")

            DoEvents
            oIE.Quit

            DoEvents
            Set oIE = Nothing
            Apercu.TextRTF = LoadString(30)
            CollerWordFile.Enabled = True
            AfficherTip LoadMSG(1), LoadMSG(2), PlugChoice(0), False
'            Download File_Path
'            Open Stockage For Input As #1
'            donnees = vbNullString
'            Do Until EOF(1) = -1
'                Line Input #1, Titre
'                donnees = donnees & Titre
'            Loop
'            Close #1
'            Apercu.Text = Replace(Replace(Replace(Replace(Replace(Replace(Replace(donnees, vbCrLf, ""), "<br>", vbCrLf), "<br/>", vbCrLf), "<br />", vbCrLf), "<p>", vbCrLf), "</p>", vbCrLf), "</li>", vbCrLf)
        ElseIf LCase$(Right$(Directory.Text, 3)) = "pdf" Then

            '--------------------------------------------->Fichiers PDf>---------------------------------------------
            If vbNo = MsgBox(LoadString(31), "TXT2JPG") Then Exit Sub
            Apercu.TextRTF = LoadString(32)
            ShellExecute Me.hwnd, "open", LoadString(33), vbNullString, App.Path, 1
            Apercu.TextRTF = "Path : " & File_Path
        ElseIf LCase$(Right$(Directory.Text, 3)) = "lrc" Then
            '--------------------------------------------->Fichiers lrc contenant les lyrics d'une chanson>---------------------------------------------
            Apercu.LoadFile Directory.Text

            donnees = Apercu.Text
            Apercu.Text = LoadString(34)
            auteur = MyMid(donnees, "[by:", "]", 1)
            Titre = MyMid(donnees, "[ti:", "]", 1)

            If Titre = vbNullString Then Titre = InputBox(LoadString(35), LoadString(36))

            donnees = Titre & vbCrLf & donnees
            donnees = Replace(donnees, "[by:" & auteur & "]", "Par : " & IIf(auteur <> vbNullString, auteur, "----") & vbCrLf)
            total = Len(donnees)

            For tempo = 1 To total

                If Mid$(donnees, tempo, 1) = "[" Then Start = tempo
                If Mid$(donnees, tempo, 1) = "]" Then

                    donnees = Replace(donnees, Mid$(donnees, Start, tempo - Start + 1), vbNullString)
                    tempo = Start 'Si deux balises à la suite
                    total = Len(donnees)
                End If

            Next

            total = Len(donnees)

            For tempo = 1 To total

                If Mid$(donnees, tempo, 1) = "<" Then Start = tempo
                If Mid$(donnees, tempo, 1) = ">" Then

                    donnees = Replace(donnees, Mid$(donnees, Start, tempo - Start + 1), vbNullString)
                    tempo = Start 'Si deux balises à la suite
                    total = Len(donnees)
                End If

            Next

            NoSelEvents = True

            With Apercu
                .Text = donnees
                .SelStart = 0
                .SelLength = InStr(1, donnees, vbCrLf)
                .SelUnderline = True
                .SelColor = vbRed
                .SelFontSize = 11
                .SelStart = InStr(1, donnees, "Par : " & IIf(auteur <> vbNullString, auteur, "----"))

                If .SelStart <> 0 Then
                    .SelStart = .SelStart - 1
                    .SelLength = Len("Par : " & auteur)
                    .SelItalic = True
                    .SelFontSize = 7
                    .SelColor = RGB(128, 128, 128)
                End If

                .SelStart = 0
                .SelLength = 0
            End With

            NoSelEvents = False
        Else

            '--------------------------------------------->Fichiers non reconnus mais lisibles en mode texte>---------------------------------------------
            If vbNo = MsgBox(LoadString(37), vbYesNo + vbExclamation, "TXT2JPG") Then Exit Sub
            Apercu.LoadFile Directory.Text
        End If
    End If

    If Not (ISAnInternetURL) Then
        Dest_Folder_GotTheFocus
        Dest_Folder.Text = Right$(Directory.Text, Len(Directory.Text) - InStrRev(Directory.Text, "\"))
        Dest_Folder.Text = Left$(Dest_Folder.Text, Len(Dest_Folder.Text) - 4)
    Else
        Dest_Folder_GotTheFocus
        Dest_Folder.Text = Right$(Directory.Text, Len(Directory.Text) - InStrRev(Directory.Text, "/"))
    End If

    Dest_Folder.SetFocus
    Apercu.SelStart = 1
    Me.MousePointer = 0

    Exit Sub

err_handler:
    AfficherTip LoadMSG(3), Err.Description, Dest_Folder, vbExclamation
    Me.MousePointer = vbDefault
End Sub

Private Sub Translate_Text()
    On Error Resume Next
    'Change le texte de la boite d'accueil selon le langage choisi
    'Ne change que si rien n'est déjà chargé
    Dim Texte_Orig As String, ctl As Control, CurIndex As Long, Current_ligne As String

    If InStr(1, Apercu.Text, "TXT2JPG") <> 0 Or Apercu.Text = vbNullString Then
        Apercu.LoadFile GetSetting("TXT2JPG", "Data", "Last_File", App.Path & "\Lang\HOME_" & GetSetting("TXT2JPG", "Data", "Langue", "Francais") & ".rtf")
    End If
    'Puis charger tout les caption, text et autres : (le on error goto est très important !)
    For Each ctl In Me.Controls
        If TypeOf ctl Is Label Or TypeOf ctl Is Bouton Or TypeOf ctl Is OptionButton Or TypeOf ctl Is TextBox Or TypeOf ctl Is ComboBox Or TypeOf ctl Is TextBoxPlus Or TypeOf ctl Is CheckBoxPlus Or TypeOf ctl Is Image Or TypeOf ctl Is CommandButton Then
            'Charger le ToolTipText :
            ctl.ToolTipText = LoadCaption(ctl.Name & "|0|ToolTipText")
            ctl.ToolTipText = LoadCaption(ctl.Name & "|" & ctl.Index & "|ToolTipText")

            'Puis les propriétés spécifiques à chaque controles.
            If TypeOf ctl Is Label Or TypeOf ctl Is Bouton Or TypeOf ctl Is OptionButton Or TypeOf ctl Is CommandButton Then
                ctl.Caption = LoadCaption(ctl.Name & "|0|Caption")
                ctl.Caption = LoadCaption(ctl.Name & "|" & ctl.Index & "|Caption")
            End If

            If TypeOf ctl Is TextBox Or TypeOf ctl Is ComboBox Or TypeOf ctl Is TextBoxPlus Then
                ctl.Text = LoadCaption(ctl.Name & "|0|Text")
                ctl.Text = LoadCaption(ctl.Name & "|" & ctl.Index & "|Text")
            End If
            If TypeOf ctl Is TextBoxPlus Then
                ctl.CueBanner = LoadCaption(ctl.Name & "|0|CueBanner"): Err.Number = 0
                ctl.CueBanner = LoadCaption(ctl.Name & "|" & ctl.Index & "|CueBanner")
            End If
        End If
    Next
    'Puis changee les menus
    For tempo = 0 To Edition.UBound
        Edition(tempo).Caption = LoadCaption("Edition|" & tempo & "|Caption")
    Next
End Sub

Private Sub Abandon_Click()
    On Error Resume Next
    Abandon.Visible = False
    Apercu.TextRTF = SVGofRTF
End Sub

Private Sub Align_Click(Index As Integer)
    On Error Resume Next
    Apercu.SelAlignment = Index
End Sub

Private Sub Alignement_Click()
    On Error Resume Next
    If IsNull(Apercu.SelAlignment) Then
        PopupMenu Edition(18)
    Else
        PopupMenu Edition(18), , , , Align(Apercu.SelAlignment)
    End If

End Sub

Private Sub Apercu_KeyDown(KeyCode As Integer, Shift As Integer)
    On Error Resume Next
    Dim TXT As String, Sel_emplacement As Long

    If TailleTexte < 5000 Then
        TXT = Apercu.TextRTF
        TailleTexte = Len(TXT)

        If InStr(1, TXT, "<hr />") <> 0 Then
            Sel_emplacement = Apercu.SelStart
            Apercu.TextRTF = Replace(TXT, "<hr />", Barre)
            Apercu.SelStart = Sel_emplacement - 5
        End If
    End If

    If Shift = vbCtrlMask And KeyCode = vbKeyF Then Edition_Click (3)
    If Shift = vbCtrlMask And KeyCode = vbKeyH Then Edition_Click (2)

    ' Le KeyCode = 9, correspond à la touche [TAB]
    If (KeyCode = 9) And (Shift = 0) Then
        ' Remet le KeyCode à 0 pour éviter la perte du focus
        KeyCode = 0
        ' Envoie un [Control]+[TAB], pour insérer une tabulation
        SendKeys "^{TAB}"
    End If

End Sub

Private Sub Apercu_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    Dim mouse_pt As POINTAPI
    'Affiche le menu pop up avec les options d'ajustement, utilise aussi le message EM_CHARFROMPOS afin de positionnner correctement le curseur
    If Button = vbRightButton Then
        mouse_pt.X = X \ Screen.TwipsPerPixelX: mouse_pt.Y = Y \ Screen.TwipsPerPixelY

        If Apercu.SelLength = 0 Then Apercu.SelStart = SendMessage(Apercu.hwnd, EM_CHARFROMPOS, 0&, mouse_pt)
        Apercu.Enabled = False
        Apercu.Enabled = True
        PopupMenu Menus(0), , , , Edition(0)
    End If
End Sub

Private Sub Apercu_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    Dim LinkResult As ResultConstant

    LinkResult = IsLink(X, Y, Apercu)
    If Button = 1 Then
        With LinkResult
            If .EstUnLiens = True And .Email = False And .interne = False Then
                If Right(.URL, 1) = " " Then .URL = Left(.URL, Len(.URL) - 1)
                ShellExecute Me.hwnd, vbNullString, .URL, vbNullString, "C:\", 2
            ElseIf .EstUnLiens = True And .Email = True Then
                ShellExecute Me.hwnd, vbNullString, "mailto:" & .URL, vbNullString, "C:\", 2
            End If
        End With
    End If
End Sub

Private Sub Apercu_OLEDragDrop(Data As RichTextLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    'Autorise le glisser déposer de fichier
    SVGofRTF = Apercu.TextRTF

    If Data.GetFormat(vbCFRTF) Then
        Apercu.TextRTF = LoadString(47)
        Apercu.TextRTF = Data.GetData(vbCFRTF)
    ElseIf Data.GetFormat(vbCFText) Then
        Apercu.TextRTF = vbNullString
        Apercu.Text = Data.GetData(vbCFText)
    ElseIf Data.GetFormat(vbCFFiles) Then
        Load_Text_File Data.Files.Item(1)
    ElseIf Data.GetFormat(vbCFBitmap) Then
        SendMessage Apercu.hwnd, WM_PASTE, 0, 0
    Else
        MsgBox LoadString(48), vbCritical + vbOKOnly
    End If

    Do_Abort
End Sub

Private Sub Apercu_SelChange()
    On Error Resume Next
    'Si on travaille sur l'ensemble, on peut accélerer le tout !
    If NoSelEvents Then Exit Sub

    'Règle ce qui peut être reglé (taille et police en fait) en fonction de la sélection

    DoNotChange = True
    Taille.Text = Apercu.SelFontSize
    Polices.Text = Apercu.SelFontName

    If SetMarge(0).Tag <> Apercu.SelIndent Then SetMarge_MouseMove 0, vbLeftButton, 0, Apercu.SelIndent * 1.48, 0

    DoNotChange = True

    If SetMarge(1).Tag <> Apercu.SelRightIndent Then SetMarge_MouseMove 1, vbLeftButton, 0, Apercu.SelRightIndent * 1.48, 0

    DoNotChange = False
End Sub

Private Sub Appliquer_Click()
    On Error Resume Next
    'Appliquer les effets dégradés
    Dim SVGofCaption As String

    If Apercu.SelLength = 0 Then AfficherTip LoadMSG(5), LoadMSG(6), ColorRangeOverView, False: Exit Sub
    SVGofCaption = Appliquer.Caption
    Appliquer.Caption = "...."
    SVGofRTF = Apercu.TextRTF
    Annuler.Enabled = True

    Dim longueur As Long, X As Variant, rouge1 As Long, vert1 As Long, bleu1 As Long, rouge2 As Long, vert2 As Long, bleu2 As Long, Fin As Long

    debut = Apercu.SelStart
    longueur = Apercu.SelLength
    bleu1 = Int(ColorRange(0).BackColor \ 65536)
    vert1 = Int((ColorRange(0).BackColor - (65536 * bleu1)) \ 256)
    rouge1 = ColorRange(0).BackColor - ((bleu1 * 65536) + (vert1 * 256))
    bleu2 = Int(ColorRange(1).BackColor \ 65536)
    vert2 = Int((ColorRange(1).BackColor - (65536 * bleu2)) \ 256)
    rouge2 = ColorRange(1).BackColor - ((bleu2 * 65536) + (vert2 * 256))
    Fin = debut + longueur - 1

    DoEvents

    For tempo = debut To Fin
        Apercu.SelStart = tempo
        Apercu.SelLength = 1
        X = (tempo - debut) / longueur
        Apercu.SelColor = RGB(rouge1 + (rouge2 - rouge1) * X, vert1 + (vert2 - vert1) * X, bleu1 + (bleu2 - bleu1) * X)
    Next

    Apercu.SelStart = debut
    Apercu.SelLength = longueur
    Appliquer.Caption = SVGofCaption
End Sub

Private Sub AppliquImage_Click()
    On Error Resume Next
    For tempo = 0 To 2
        Traitement_Img(tempo).Visible = False
    Next

    For tempo = 35 To 0 Step -1
        etiquette(32).Top = tempo
        etiquette(33).Top = tempo + 42
        etiquette(34).Top = tempo + 119
        etiquette(35).Top = tempo + 168
        AppliquImage.Top = 210

        DoEvents
    Next

    AppliquImage.Visible = False
    IsSlidingWorking = False
End Sub

Private Sub BC_Click(Index As Integer)
    On Error Resume Next
    'Updater le registre
    If DoNotChange Then Exit Sub
    SaveSetting "TXT2JPG", "Data", "BG_red", IIf(BC(0).Value = True, 1, 0)
    SaveSetting "TXT2JPG", "Data", "BG_green", IIf(BC(1).Value = True, 1, 0)
    SaveSetting "TXT2JPG", "Data", "BG_blue", IIf(BC(2).Value = True, 1, 0)
    SaveSetting "TXT2JPG", "Data", "Sens_dessin", IIf(BC(3).Value = True, 1, 0)
    'Updater les variables
    BG_red = GetSetting("TXT2JPG", "Data", "BG_red", "0")
    BG_green = GetSetting("TXT2JPG", "Data", "BG_green", "0")
    BG_blue = GetSetting("TXT2JPG", "Data", "BG_blue", "1")
    sens_dessin = GetSetting("TXT2JPG", "Data", "Sens_dessin", "0")
    SaveSetting "TXT2JPG", "Data", "BackPic", vbNullString

    'Updater la feuille
    Form_Redraw
    Qualite_MouseMove 0, 0, 1, 1
    'Et terminé !
End Sub

'Private Sub BlackAndWhite_Click()
'Mettre l'image en niveau de noir et gris
'Dim X As Long, Y As Long, rouge As Long, vert As Long, bleu As Long, CCouleur As Long, LLargeur As Long, HHauteur As Long, Img_To_Blit_DC As Long
'Me.MousePointer = 11
'   If BlackAndWhite.Value = true Then
'        DoEvents
'        LLargeur = Largeur.Text
'        HHauteur = Hauteur.Text
'        Img_To_Blit_DC = Image_A_Blitter.hDC
'        For X = 1 To LLargeur
'            For Y = 1 To HHauteur
'                CCouleur = GetPixel(Img_To_Blit_DC, X, Y)
'                bleu = Int(CCouleur \ 65536)
'                vert = Int((CCouleur - (65536 * bleu)) \ 256)
'                rouge = CCouleur - ((bleu * 65536) + (vert * 256))
'                CCouleur = (rouge + vert + bleu) \ 3
'                SetpixelV Img_To_Blit_DC, X, Y, RGB(CCouleur, CCouleur, CCouleur)
'            Next
'        Next
'        Image_A_Blitter.Refresh
'        Pochette.Picture = LoadPicture(vbnullstring)
'        DoEvents
'        Pochette.Picture = Image_A_Blitter.Image
'    Else
'        Pochette.Picture = LoadPicture(Filig.Text)
'        Image_A_Blitter.Picture = LoadPicture(Filig.Text)
'        DoEvents
'        If Image_A_Blitter.Width > Largeur.Text Or Image_A_Blitter.Height > Hauteur.Text Then
'            tempo = MsgBox(LoadString(49), vbYesNoCancel + vbInformation, LoadString(50))
'            If tempo = vbCancel Then Exit Sub
'            Image_A_Blitter.BackColor = RGB(254, 255, 255)
'            If tempo = vbYes Then Image_A_Blitter.PaintPicture LoadPicture(Filig.Text), 0, 0, Largeur.Text, Hauteur.Text
'            DoEvents
'        End If
'    End If
'Me.MousePointer = 0
'End Sub
Private Sub Browse_Click()
    On Error Resume Next

    'Charge un fichier texte avec comdlg API
    Reponse = OpenFile(Me.hwnd, LoadString(51), 1, OFN_FILEMUSTEXIST + OFN_PATHMUSTEXIST + OFN_HIDEREADONLY, LoadString(52), vbNullString, GetSetting("TXT2JPG", "Data", "LastPathName", App.Path))

    If Reponse = vbNullString Or Reponse = "0" Then Exit Sub
    SaveSetting "TXT2JPG", "Data", "LastPathName", Reponse
    Load_Text_File Reponse
End Sub

Private Sub Browse_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    ShowHelpFor Browse, LoadMSG(7), LoadMSG(8)
End Sub
Private Sub Browse2_Click()
    On Error Resume Next

    'Charge une image avec comdlg
    Reponse = OpenFile(Me.hwnd, LoadString(53), 1, OFN_FILEMUSTEXIST + OFN_PATHMUSTEXIST + OFN_HIDEREADONLY, LoadString(54), vbNullString, GetSetting("TXT2JPG", "Data", "LastPathName", App.Path))

    If Reponse = vbNullString Then Exit Sub
    SaveSetting "TXT2JPG", "Data", "LastPathName", Reponse
    Filig.Text = Reponse
End Sub

Private Sub Bug_Envoi_Click()
    On Error Resume Next
    Download "http://neamar.free.fr/mailer.php?action=bug&nom=" & GetSetting("TXT2JPG", "Data", "Nom", "Anonyme") & "&message=" & Bug_Texte.Text
    Bug_Texte.BackColor = RGB(255, 140, 140)
    Bug_Texte.Text = vbNullString
    Bug_Texte.CueBanner = LoadString(55)
End Sub

Private Sub BUG_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    Bug_Envoi.ForeColor = vbBlack
End Sub

Private Sub Bug_rapport_Click()
    On Error Resume Next
    BUG.Visible = True
    BUG.Top = -30
    'Bug_Close.Picture = BallonTipCancel(0).Picture
    debut = Timer
    Apercu.Height = Apercu.Height - (30 - Apercu.Top)

    DoEvents
    Do
        tempo = Min(-30 + 60 * (Timer - debut), 0)
        BUG.Top = tempo
        Apercu.Top = tempo + 30

        DoEvents
    Loop While tempo <> 0

End Sub

Private Sub Bug_rapport_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    etiquette(16).Caption = LoadString(56)
    etiquette(16).Tag = "Come into  bug ? Have some ideas to share ? Clic and write !"
End Sub

Private Sub Bug_Texte_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Bug_Envoi.ForeColor = vbBlack
End Sub

Private Sub CharMap_Click()
    On Error Resume Next
    If 0 = Shell("C:\Windows\System32\charmap.exe", vbNormalFocus) Then MsgBox LoadString(57)
End Sub

Private Sub ChoosePic_Click()
    On Error Resume Next

    'Charge une image de fond avec comdlg
    BallonTip.Visible = False
    Reponse = OpenFile(Me.hwnd, LoadString(58), 1, OFN_FILEMUSTEXIST + OFN_PATHMUSTEXIST + OFN_HIDEREADONLY, LoadString(54), vbNullString, GetSetting("TXT2JPG", "Data", "LastPathName", App.Path))

    If Reponse = vbNullString Then Exit Sub
    SaveSetting "TXT2JPG", "Data", "LastPathName", Reponse
    SaveSetting "TXT2JPG", "Data", "BackPic", Reponse
    Set BackPicture = LoadPicture(Reponse)

    Form_Redraw
End Sub

Private Sub ChoosePic_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ShowHelpFor ChoosePic, LoadMSG(9), LoadMSG(10)
End Sub

Private Sub CollerWordFile_Timer()
    On Error Resume Next
    'Colle le RTF d'un fichier word recupéré, car bug du do events à priori...
    CollerWordFile.Enabled = False
    Apercu.TextRTF = vbNullString
    'Edition_Click 11
    SendMessage Apercu.hwnd, WM_PASTE, 0, 0
End Sub

Private Sub ColorRange_Click(Index As Integer)
    On Error Resume Next
    Dim X As Long, Y As Long, rouge1 As Long, vert1 As Long, bleu1 As Long, CCouleur As Long, color_dc As Long, rouge2 As Long, vert2 As Long, bleu2 As Long

    Couleur_Selectionnee = ChoixCouleur(Me.hwnd)

    If Couleur_Selectionnee = -1 Then Exit Sub
    ColorRange(Index).BackColor = Couleur_Selectionnee
    'Rafraichir l'apercu
    color_dc = ColorRangeOverView.hdc
    bleu1 = Int(ColorRange(0).BackColor \ 65536)
    vert1 = Int((ColorRange(0).BackColor - (65536 * bleu1)) \ 256)
    rouge1 = ColorRange(0).BackColor - ((bleu1 * 65536) + (vert1 * 256))
    bleu2 = Int(ColorRange(1).BackColor \ 65536)
    vert2 = Int((ColorRange(1).BackColor - (65536 * bleu2)) \ 256)
    rouge2 = ColorRange(1).BackColor - ((bleu2 * 65536) + (vert2 * 256))

    For X = 0 To 113
        'Règle de trois !
        CCouleur = RGB(rouge1 + (rouge2 - rouge1) * X \ 113, vert1 + (vert2 - vert1) * X \ 113, bleu1 + (bleu2 - bleu1) * X \ 113)

        For Y = 0 To 15
            SetPixelV color_dc, X, Y, CCouleur
        Next
    Next

    ColorRangeOverView.Refresh
End Sub

Private Sub Annuler_Click()
    On Error Resume Next
    'Demande l'annulation du dernier effet appliqué
    'If Annuler.Enabled Then
    '    AfficherTip LoadMSG(11), LoadMSG(12) & vbCrLf & "-Aucune modification effectuée" & vbCrLf & "-Annulation déjà effectuée", "Can't Undo", "This error may come because :" & vbCrLf & "-No change done" & vbCrLf & "-Change still done, can't undo more than once.", Annuler
    '    Exit Sub
    'End If
    Apercu.TextRTF = SVGofRTF
    Annuler.Enabled = False
End Sub

Private Sub ColorRange_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    ShowHelpFor ColorRange(Index), LoadMSG(13), LoadMSG(14)
End Sub

Private Sub Defaut_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ShowHelpFor Defaut, LoadMSG(69), LoadMSG(70)
End Sub

Private Sub Dest_Folder_GotTheFocus()
    AfficherTip LoadMSG(15), LoadMSG(16), Dest_Folder
End Sub


Private Sub Dest_Folder_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ShowHelpFor Dest_Folder, LoadMSG(15), LoadMSG(16)
End Sub

Private Sub DL_From_URL_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ShowHelpFor DL_From_URL, LoadMSG(17), LoadMSG(18)
End Sub

Private Sub Bug_Envoi_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Bug_Envoi.ForeColor = vbBlue
End Sub

Private Sub BallonTip_Fermer()
    BallonTip.Visible = False
End Sub

Private Sub En_JPG_MouseMove(Button As Integer, Shift As Integer)
    ShowHelpFor En_JPG, LoadMSG(41), LoadMSG(42)
End Sub

Private Sub Filig_KeyPress(KeyAscii As Integer)
    'Empêche de marquer manuellement une valeur
    KeyAscii = 0
End Sub

Private Sub KeyWord_Change()
    On Error Resume Next
    If KeyWord.Text = vbNullString Then KeyWord.Invalide = True Else KeyWord.Invalide = False
End Sub



Private Sub Marque_DropDown()
    BallonTip.Visible = False
End Sub

Private Sub Marque_GotFocus()
    'Dérouler le combobox
    SendMessage Marque.hwnd, CB_SHOWDROPDOWN, True, ByVal 0
End Sub
Private Sub Modeles_GotFocus()
    'Dérouler le combobox
    SendMessage Modeles.hwnd, CB_SHOWDROPDOWN, True, ByVal 0
End Sub

Private Sub MouseOutProc_Timer()
Dim pPos As POINTAPI
Call GetCursorPos(pPos)
If WindowFromPoint(pPos.X, pPos.Y) <> MouseOutProc.Tag And WindowFromPoint(pPos.X, pPos.Y) <> BallonTip.hwnd Then
    BallonTip.Visible = False
    BallonTip.Top = 0
    BallonTip.Left = 0
    MouseOutProc.Enabled = False
End If
End Sub

Private Sub Pagination_MouseMove(Button As Integer, Shift As Integer)
    ShowHelpFor Pagination, LoadMSG(57), LoadMSG(58)
End Sub

Private Sub PutACopyOfFileInFolder_MouseMove(Button As Integer, Shift As Integer)
    ShowHelpFor PutACopyOfFileInFolder, LoadMSG(67), LoadMSG(68)
End Sub

Private Sub Qualite_GotFocus()
    AfficherTip LoadMSG(19), LoadMSG(20), Qualite, True
End Sub

Private Sub Rechercher_Texte_KeyDown(KeyCode As Integer, Shift As Integer)
    On Error Resume Next
    If KeyCode = 13 Then Rechercher_Suite_Click
    Rechercher_Texte.SetFocus
End Sub

Private Sub Reseau_Change()
    Reseau.BackColor = vbWhite
End Sub

Private Sub Root_Change()
    On Error Resume Next
    'OLE ! Pour l'apparence visuelle...
    etiquette(4).Caption = LoadString(59) & vbCrLf & Dest_Folder.Text & "\" & Root.Text

    'Nom de root invalide  car contenant caractère interdit
    If Root.Text Like "*[\/:*?""<>]*" Then
        Root.Invalide = True
        AfficherTip LoadMSG(21), LoadMSG(22) & vbCrLf & LoadMSG(4) & "\ / : * ? \"" < >", Root, vbCritical
    Else
        Root.Invalide = False
    End If

    If Root.Text <> vbNullString Then
        If Separateur(5).Y1 = 210 Then
            debut = Timer

            Do
                tempo = Min(210 + 56 * (Timer - debut), 238)
                Separateur(5).Y1 = tempo
                Separateur(5).Y2 = tempo
                etiquette(22).Top = tempo + 7
                etiquette(7).Top = (0.95 * tempo) + 35
                ClearType.Top = tempo + 7

                Type_Numerisation.Top = (0.95 * tempo) + 35

                etiquette(38).Top = (0.97 * tempo) + 45
                SplitChapter.Top = (0.97 * tempo) + 45
            Loop Until tempo = 238

            etiquette(4).Visible = True
        End If
    End If

End Sub

Private Sub Root_GotTheFocus()
    MAJ_Timer
End Sub

Private Sub Root_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
ShowHelpFor Root, LoadMSG(23), LoadMSG(24)
End Sub

Private Sub SetMarge_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    SetMarge_MouseMove Index, Button, Shift, X, Y
End Sub

Private Sub SetMarge_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    'Updater la valeur
    If Button = vbLeftButton And X >= 0 And X <= 144 Then
        SetMarge(Index).Tag = (100 * X) \ 148
    End If

    'Arrière plan
    BitBlt SetMarge(Index).hdc, 0, 0, 148, 15, Plug(2).hdc, SetMarge(Index).Left, SetMarge(Index).Top, vbSrcCopy
    TransparentBlt SetMarge(Index).hdc, 0, 2, 148, 13, QualiteMask.hdc, 0, 0, 148, 13, RGB(255, 255, 255)
    'Bulle
    TransparentBlt SetMarge(Index).hdc, (SetMarge(Index).Tag) * 1.48 - 4, 1, 11, 13, QualiteMask.hdc, 149, 0, 11, 13, RGB(255, 255, 255)
    SetMarge(Index).Refresh

    If DoNotChange Then DoNotChange = False: Exit Sub
    If Button = vbLeftButton Then

        On Error Resume Next

        If Index <= 1 Then

            'Marge à gauche/A droite
            If Apercu.SelText = vbNullString Then
                Apercu.SelStart = 0
                Apercu.SelLength = Len(Apercu.Text)
            End If

            If Index = 0 Then
                Apercu.SelIndent = SetMarge(0).Tag
                etiquette(13).Caption = Left$(etiquette(13).Caption, Len(etiquette(13).Caption) - 5) & FORMAT$(Apercu.SelIndent, "000") & "px"
            Else
                Apercu.SelRightIndent = SetMarge(1).Tag
                etiquette(14).Caption = Left$(etiquette(14).Caption, Len(etiquette(14).Caption) - 5) & FORMAT$(Apercu.SelRightIndent, "000") & "px"
            End If

        Else
            'Marge en haut/en bas
            etiquette(27).Caption = Left$(etiquette(27).Caption, Len(etiquette(27).Caption) - 5) & FORMAT$(SetMarge(2).Tag, "000") & "px"
            etiquette(26).Caption = Left$(etiquette(26).Caption, Len(etiquette(26).Caption) - 5) & FORMAT$(SetMarge(3).Tag, "000") & "px"
            TextBoxMargins Apercu, 5, SetMarge(2).Tag, 5, SetMarge(3).Tag
            TextBoxMargins Converter, 5, SetMarge(2).Tag, 5, SetMarge(3).Tag
        End If

        'If Index > 1 Then AfficherTip LoadMSG(25), LoadMSG(26), SetMarge(3), False
    End If

End Sub

Private Sub SplitChapter_Click()
    On Error Resume Next
    If SplitChapter.Value = True Then
        KeyWord.Visible = True
        KeyWord.Top = SplitChapter.Top - 3
        etiquette(38).Caption = LoadString(60)
        AfficherTip LoadMSG(27), LoadMSG(28), PlugChoice(2), False
        'KeyWord.SetFocus
    Else
        KeyWord.Visible = False
        etiquette(38).Caption = LoadString(61)
    End If

End Sub

Private Sub DL_From_URL_Click()
    On Error Resume Next
    Dim URL_To_Load As String

    URL_To_Load = InputBox(LoadString(62), LoadString(63), LoadString(38))
    If URL_To_Load = vbNullString Then Exit Sub

    Load_Text_File URL_To_Load, True
End Sub

Private Sub Filig_GotFocus()
    'Dérouler le combobox
    SendMessage Filig.hwnd, CB_SHOWDROPDOWN, True, ByVal 0
End Sub

Private Sub Marque_KeyPress(KeyAscii As Integer)
    KeyAscii = 0
End Sub

Private Sub Modeles_KeyPress(KeyAscii As Integer)
    'Locker sans locker
    KeyAscii = 0
End Sub

Private Sub ModulesWhat_Click(Index As Integer)
    On Error Resume Next
    If Index Then
        WhatAbout.Visible = True
        'Affiche l'historique des versions
        Me.MousePointer = vbCustom

        Download "http://neamar.free.fr/Addins/Zen.php?version=1"

        With WhatAbout
            .TextRTF = vbNullString
            .LoadFile Stockage
            .SelStart = 0
            .SelLength = 0
            .SelText = "TXT2JPg - Build n°" & App.Revision & vbCrLf & "Neamar, 2007. " & vbCrLf & "Mail : neamart@yahoo.fr" & vbCrLf & LoadString(64) & GetSetting("TXT2JPG", "Data", "Nom", "Anonyme") & vbCrLf & LoadString(65) & vbCrLf & "------------------------------" & vbCrLf & LoadString(66) & vbCrLf
            .Text = Replace(Replace(.Text, "<br>", vbCrLf), "<br />", vbCrLf)

            DoEvents
            .SelStart = 0
            .SelLength = 20
            .SelColor = vbRed
        End With

        Kill Stockage
        Me.MousePointer = vbDefault
    Else
        WhatAbout.Visible = False
    End If

End Sub

Private Sub Polices_GotFocus()
    On Error Resume Next
    'Dérouler le combobox
    If Polices.ListCount <> 0 Then SendMessage Polices.hwnd, CB_SHOWDROPDOWN, True, ByVal 0
End Sub

Private Sub Polices_KeyPress(KeyAscii As Integer)
    'Locker sans locker
    KeyAscii = 0
End Sub

Private Sub Priorite_GotFocus()
    On Error Resume Next
    'Dérouler le combobox
    SendMessage Priorite.hwnd, CB_SHOWDROPDOWN, True, ByVal 0
    AfficherTip LoadMSG(29), LoadMSG(30), PlugChoice(3), False
End Sub

Private Sub Priorite_KeyPress(KeyAscii As Integer)
    On Error Resume Next
    'Locker sans locker
    KeyAscii = 0
End Sub

Private Sub PutACopyOfFileInFolder_Click()
    On Error Resume Next
    SaveSetting "TXT2JPG", "Data", "PutCopy", PutACopyOfFileInFolder.Value
End Sub

Private Sub Rechercher_Close_Click()
    On Error Resume Next
    Rechercher.Visible = False
    Apercu.Height = Apercu.Height + Rechercher.Height - 10
End Sub

Private Sub Rechercher_Close_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    If Rechercher_Close.Tag <> "Highlight" Then
        Rechercher_Close.Picture = Cross(1).Picture
        Rechercher_Close.Tag = "Highlight"
    End If

End Sub

Private Sub Rechercher_Fond_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    If Rechercher_Close.Tag = "Highlight" Then
        Rechercher_Close.Picture = Cross(0).Picture
        Rechercher_Close.Tag = vbNullString
    End If

End Sub

Private Sub Rechercher_Suite_Click()
    On Error Resume Next
    If Rechercher.Tag = LoadString(67) Then

        'Rechercher
        Apercu.SelStart = InStr(Apercu.SelStart + 2, Apercu.Text, Rechercher_Texte.Text) - 1
        Apercu.SelLength = Len(Rechercher_Texte.Text)

        If Apercu.SelText <> Rechercher_Texte.Text Then
            Apercu.SelLength = 0
            Rechercher_Texte.ForeColor = vbRed
        Else
            Rechercher_Texte.ForeColor = vbBlack
        End If

        Apercu.SetFocus
    End If

    If Rechercher.Tag = LoadString(68) Then

        'Rechercher & remplacer
        Dim compteur As Long, cherche As String, remplace As String, LenCherche As Long

        cherche = Rechercher_Texte.Text
        remplace = Rechercher_Remplacer.Text
        LenCherche = Len(cherche)
        Me.MousePointer = vbCustom
        compteur = 0
        tempo = -LenCherche + 1

        Do
            tempo = InStr(tempo + LenCherche, Apercu.Text, cherche)

            If tempo = 0 Then Exit Do
            Apercu.SelStart = tempo - 1
            Apercu.SelLength = LenCherche
            Apercu.SelText = remplace
            compteur = compteur + 1
        Loop

        AfficherTip LoadMSG(31), compteur & LoadMSG(32), PlugChoice(0), vbInformation
        Me.MousePointer = vbDefault
    End If

End Sub

Private Sub Rechercher_Texte_Change()
    On Error Resume Next
    If Rechercher.Tag = LoadString(67) Then
        'Rechercher
        Apercu.SelStart = InStr(1, Apercu.Text, Rechercher_Texte.Text) - 1
        Apercu.SelLength = Len(Rechercher_Texte.Text)

        If Apercu.SelText <> Rechercher_Texte.Text Then
            Apercu.SelLength = 0
            Rechercher_Texte.ForeColor = vbRed
        Else
            Rechercher_Texte.ForeColor = vbBlack
        End If
    End If

End Sub

Private Sub Reseau_GotFocus()
    AfficherTip LoadMSG(33), LoadMSG(34), Reseau
End Sub

Private Sub Reseau_LostFocus()
    BallonTip.Visible = False
End Sub

Private Sub Save_Folder_GotFocus()
    On Error Resume Next
    AfficherTip LoadMSG(35), LoadMSG(36), Save_Folder
End Sub

Private Sub Save_Folder_LostFocus()
    BallonTip.Visible = False
End Sub

Private Sub Taille_GotFocus()
    'MEssage de déroulement
    SendMessage Taille.hwnd, CB_SHOWDROPDOWN, True, ByVal 0
End Sub

Private Sub TailleDegrade_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    TailleDegrade_MouseMove Index, Button, Shift, X, Y
End Sub

Private Sub TailleDegrade_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    'Updater la valeur

    If Button = vbLeftButton And Y > 5 And Y < 135 Then
        BallonTip.Visible = False

        If Apercu.SelLength = 0 Then AfficherTip LoadMSG(37), LoadMSG(38), TailleDegrade(Index), False: Exit Sub
        TailleDegrade(Index).Tag = Y
    End If

    'Arrière plan
    BitBlt TailleDegrade(Index).hdc, 0, 0, 15, 148, Plug(5).hdc, TailleDegrade(Index).Left, TailleDegrade(Index).Top, vbSrcCopy
    TransparentBlt TailleDegrade(Index).hdc, 0, 2, 13, 148, TailleMask.hdc, 0, 0, 13, 148, RGB(255, 255, 255)
    'Bulle
    TransparentBlt TailleDegrade(Index).hdc, 1, TailleDegrade(Index).Tag, 13, 11, TailleMask.hdc, 0, 149, 13, 11, RGB(255, 255, 255)
    TailleDegrade(Index).Refresh

    If Button = vbLeftButton Then
        SVGofRTF = Apercu.TextRTF
        Annuler.Enabled = True

        Dim longueur As Long, left_value As Long, right_value As Single, SVGofCaption As String, Fin As Long

        SVGofCaption = etiquette(30).Caption
        etiquette(30).Caption = LoadString(69) & vbCrLf & LoadString(70) & Apercu.SelLength

        DoEvents
        left_value = 135 - TailleDegrade(0).Tag

        With Apercu
            longueur = .SelLength
            debut = .SelStart
            right_value = ((135 - TailleDegrade(1).Tag) - left_value) \ longueur 'Right value correspond en fait à la différence...divisée par la longueur. C'est de la précompilation ^^
            Fin = debut + longueur

            For tempo = debut To Fin
                .SelStart = tempo
                .SelLength = 1
                'Une simple règle de trois ;-)
                .SelFontSize = left_value + (tempo - debut) * right_value
            Next

            .SelStart = debut
            .SelLength = longueur
        End With
        etiquette(30).Caption = SVGofCaption
    End If

End Sub

Private Sub Start_Click()
    Numeriser
End Sub

Private Sub Dest_Folder_Change()
    On Error Resume Next
    If Dest_Folder.Text = vbNullString Then Exit Sub
    If Dest_Folder.Text Like "*[\/:*?""<>]*" Then
        'Nom de fichier invalide  car contenant caractère interdit
        Dest_Folder.Invalide = True
        AfficherTip LoadMSG(39), LoadMSG(4) & "\ / : * ? \"" < >", Dest_Folder, vbCritical
    Else
        Dest_Folder.Invalide = False

        If Dest_Folder.HasFocus Then BallonTip.Visible = False

        'Le fichier existe déjà ? On informe !
        If Dir$(GetSetting("TXT2JPG", "Data", "Default_Path", App.Path) & "\" & Dest_Folder.Text, vbDirectory) <> vbNullString Then AfficherTip LoadMSG(65), Replace(LoadMSG(66), "%u", Root.Text), Dest_Folder, vbInformation
    End If

End Sub

Private Sub Traitement_Img_Click(Index As Integer)
    On Error Resume Next
    If NonForcé Then Exit Sub
    NonForcé = True

    For tempo = 0 To 2
        Traitement_Img(tempo).Value = False
    Next

    Traitement_Img(Index).Value = True
    NonForcé = False
End Sub

Private Sub Use_Back_Picture_MouseMove(Button As Integer, Shift As Integer)
    ShowHelpFor Use_Back_Picture, LoadMSG(71), LoadMSG(72)
End Sub

Private Sub UseForeColor_Click()
    On Error Resume Next
    SaveSetting "TXT2JPG", "Data", "CleverColor", Abs(UseForeColor.Value)
    CleverColor = UseForeColor.Value

    Form_Redraw

    If Not (CleverColor) Then

        For tempo = 0 To etiquette.UBound
            etiquette(tempo).ForeColor = -2147483633
        Next

        etiquette(41).ForeColor = vbBlack
        etiquette(40).ForeColor = vbBlack
    End If

End Sub

Private Sub VoirApercu_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    VoirApercu_MouseMove Button, Shift, X, Y
End Sub

Private Sub VoirApercu_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next

    If Button <> 0 And X > 0 And Y > 0 And X < VoirApercu.Width * Screen.TwipsPerPixelX And Y < VoirApercu.Height * Screen.TwipsPerPixelY Then
        OverView.Picture = Image_A_Blitter.Picture
        OverView.Visible = True
    Else
        OverView.Visible = False
    End If

End Sub

Private Sub Filig_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    'Le drag drop Windows pour un path d'image
    If Data.GetFormat(vbCFFiles) Then Filig.Text = Data.Files.Item(1)
End Sub

Private Sub Use_Back_Picture_Click()
    On Error Resume Next
    'Mini animation de déroulement du controle shape
    If Use_Back_Picture.Value = True Then
        debut = Timer

        Do
            tempo = Min(99 * (Timer - debut), 99)
            BitBlt Plug(1).hdc, 0, 0, 176, 289, myHDC, Plug(1).Left, Plug(1).Top, vbSrcCopy
            Glass 9, 180, 170, 170 + tempo, Plug(1).hdc
            Plug(1).Refresh

            If tempo + Use_Back_Picture.Top + 10 > Filig.Top Then Filig.Visible = True: Browse2.Visible = True
            If tempo + Use_Back_Picture.Top + 10 > RedimToFit.Top Then RedimToFit.Visible = True: etiquette(6).Visible = True
            If tempo + Use_Back_Picture.Top + 10 > Cover.Top Then Cover.Visible = True: etiquette(12).Visible = True

            DoEvents
        Loop Until tempo = 99

        Apercu.BackColor = vbWhite
        Converter.BackColor = vbWhite
        Resultat.BackColor = vbWhite
        ClearType.Value = 0
        ClearType.Visible = False
        etiquette(22).Visible = False
    Else
        debut = Timer
        BitBlt Plug(1).hdc, 0, 0, 176, 289, myHDC, 0, Plug(1).Top, vbSrcCopy
        Plug(1).Refresh
        Filig.Visible = False
        Browse2.Visible = False
        RedimToFit.Visible = False
        etiquette(6).Visible = False
        Cover.Visible = False
        etiquette(12).Visible = False
        ClearType.Visible = True
        etiquette(22).Visible = True
        VoirApercu.Visible = False
    End If

End Sub

Private Sub Browse3_Click()
    On Error Resume Next
    Do
        Save_Folder.Text = SelectFolder(LoadString(1), Me.hwnd)
    Loop While Save_Folder.Text = vbNullString Or Save_Folder.Text = "NotDefine"

    Enregistrer_Click (1)
End Sub
'Private Sub Dest_Folder_LostFocus()
''Masquer l'infobulle
'BallonTip.Visible = False
'
'With Dest_Folder
'    If .Text = vbNullString Then
'        .ForeColor = RGB(100, 100, 100)
'        .FontBold = False
'        .Text = LoadString(71)
'    End If
'End With
'End Sub

Private Sub Directory_DblClick()
    'Bouble clic = clic sur le bouton
    Browse_Click
End Sub

Private Sub Directory_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    'Drag'n drop
    Directory.Text = vbNullString
    Load_Text_File Data.Files.Item(1)
End Sub

Private Sub Enregistrer_Click(Index As Integer)
    On Error Resume Next
    If Index = 0 Then
        If Reseau.Text = vbNullString Then Reseau.Text = Environ$("USERNAME")
        SaveSetting "TXT2JPG", "Data", "Nom", Reseau.Text
        Enregistrer(0).Visible = False
        Reseau.BackColor = RGB(0, 196, 0)
    End If

    If Index = 1 Then
        If Dir$(Save_Folder.Text, vbDirectory) = vbNullString Then Save_Folder.BackColor = 255: Exit Sub
        Save_Folder.BackColor = RGB(0, 196, 0)

        If Save_Folder.Text = vbNullString Then Save_Folder.Text = App.Path
        SaveSetting "TXT2JPG", "Data", "Default_Path", Save_Folder.Text
        Enregistrer(1).Visible = False
    End If

End Sub

Private Sub etiquette_Click(Index As Integer)
    On Error Resume Next
    Dim ctl As Control

    'Vérifier si on ne veut pas activer un checkbox
    For Each ctl In Me.Controls

        If TypeOf ctl Is CheckBoxPlus Then
            If ctl.Top = etiquette(Index).Top Then
                If ctl.Left > etiquette(Index).Left - 16 Then
                    If ctl.Left < etiquette(Index).Left Then
                        If ctl.Enabled = True Then
                            ctl.Value = (ctl.Value + 1) Mod 2       'On fait en cascade pour s'éviter un max de temps...
                        End If
                    End If
                End If
            End If
        End If

    Next

End Sub

Private Sub Filig_Click()
    On Error Resume Next
    'Propose plein de trucs marrants !
    If Filig.Text = LoadString(96) Then
        ShellExecute Me.hwnd, "open", "http://www.ict.tuwien.ac.at/pictures/", vbNullString, App.Path, 1

        Exit Sub

    End If

    'Charge une belle image...
    Filig.Text = GetSetting("TXT2JPG", "BackPicture", Filig.Text, Filig.Text)
    MAJ.Tag = Filig.Text
    MAJ.Enabled = True
End Sub

Private Sub Langue_Click()
    On Error Resume Next
    'Change la langue de l'interface (a partir des tag des controles, ou de mon experience)
    Dim ctl As Control, swapper As String
    SaveSetting "TXT2JPG", "Data", "Langue", Langue.Text
    'Truc à faire manuellement (hélas)
    Align(0).Caption = LoadCaption("Align|1|Caption")
    Align(1).Caption = LoadCaption("Align|2|Caption")
    Align(2).Caption = LoadCaption("Align|3|Caption")
    For tempo = 0 To 18
        Edition(tempo).Caption = LoadCaption("Edition|" & tempo & "|Caption")
    Next
    BallonTip.Visible = False
    Translate_Text

'    For Each ctl In Me.Controls
'
'        If TypeOf ctl Is Label Or TypeOf ctl Is CommandButton Or TypeOf ctl Is OptionButton Or TypeOf ctl Is Bouton Then
'            If ctl.Caption <> vbNullString Then
'                swapper = ctl.Caption
'                ctl.Caption = ctl.Tag
'                ctl.Tag = swapper
'            Else
'                swapper = ctl.ToolTipText
'                ctl.ToolTipText = ctl.Tag
'                ctl.Tag = swapper
'            End If
'        End If
'
'        If TypeOf ctl Is Image Or TypeOf ctl Is CheckBox Or TypeOf ctl Is TextBox Then
'            swapper = ctl.ToolTipText
'            ctl.ToolTipText = ctl.Tag
'            ctl.Tag = swapper
'        End If
'
'    Next

'    swapper = Dest_Folder.CueBanner
'    Dest_Folder.CueBanner = Dest_Folder.Tag
'    Dest_Folder.Tag = swapper
'    swapper = KeyWord.CueBanner
'    KeyWord.CueBanner = KeyWord.Tag
'    KeyWord.Tag = swapper
'    swapper = Root.CueBanner
'    Root.CueBanner = Root.Tag
'    Root.Tag = swapper
'    swapper = Bug_Texte.CueBanner
'    Bug_Texte.CueBanner = Bug_Texte.Tag
'    Bug_Texte.Tag = swapper
End Sub

Private Sub Couleur_Click(Index As Integer)
    On Error Resume Next
    'Change la couleur de premier/arrière plan

    If Cover.Value = 0 And Index = 2 And Use_Back_Picture.Value Then
        AfficherTip LoadMSG(43), LoadMSG(44), Couleur(2)
        Exit Sub
    End If

    Couleur_Selectionnee = ChoixCouleur(Me.hwnd)

    If Couleur_Selectionnee = -1 Then Exit Sub

    'If Couleur((Index + 1) Mod 2).BackColor = Couleur_Selectionnee Then
    '    AfficherTip LoadMSG(45), LoadMSG(46), Couleur(Index), False
    '    Exit Sub
    'End If
    If Index = 0 Then
        If Apercu.SelLength = 0 Then
            Apercu.SelStart = 0
            Apercu.SelLength = Len(Apercu.Text)
        End If

        Apercu.SelColor = Couleur_Selectionnee
    ElseIf Index = 1 Then
        'Apercu.BackColor = Couleur_Selectionnee
        'Converter.BackColor = Couleur_Selectionnee
        'Resultat.BackColor = Apercu.BackColor
        SetBackColorSel Apercu.hwnd, Couleur_Selectionnee
    Else
        Apercu.BackColor = Couleur_Selectionnee
        Converter.BackColor = Couleur_Selectionnee
        Resultat.BackColor = Couleur_Selectionnee
    End If

    Apercu.SetFocus
End Sub

Private Sub Defaut_Click()
    On Error Resume Next
    'Enregistrer le baladeur comme baladeur par défaut
    If Modeles.Text = LoadString(74) Or Modeles.Text = vbNullString Then Exit Sub
    If GetSetting("TXT2JPG", "Data", "Modele", vbNullString) <> vbNullString And GetSetting("TXT2JPG", "Data", "Marque", vbNullString) <> vbNullString Then
        'Demander confirmation avant le remplacement
        If vbNo = MsgBox(Replace(Replace(LoadString(78), "%u", GetSetting("TXT2JPG", "Data", "Modele", vbNullString) & "-" & GetSetting("TXT2JPG", "Data", "Marque", vbNullString)), "%n", Modeles.Text & "-" & Marque.Text) & "?", vbYesNo + vbExclamation, LoadString(80)) Then Exit Sub
    End If
    SaveSetting "TXT2JPG", "Data", "Modele", Modeles.Text
    SaveSetting "TXT2JPG", "Data", "Marque", Marque.Text
    Defaut.Visible = False
End Sub

Private Sub Edition_Click(Index As Integer)
    On Error Resume Next
    'toutes les options du clic droit
    Dim donnees As String

    Select Case Index

        Case 0
            'Annuler
            Apercu.SetFocus
            SendKeys "^z"

        Case 2
            'Remplacer
            Rechercher.Visible = True
            Rechercher.Top = Me.ScaleHeight - Rechercher.Height
            Apercu.Height = Me.ScaleHeight - Rechercher.Height - 6
            Rechercher_Remplacer.Enabled = True
            Rechercher_Remplacer.BackColor = vbWhite
            Rechercher_Texte.ForeColor = vbBlack
            Rechercher_Texte.Text = Apercu.SelText
            Rechercher.Tag = LoadString(68)
            Rechercher_Close.Picture = Cross(0).Picture
            Rechercher_Suite.Caption = LoadString(68)

        Case 3
            'Rechercher
            Rechercher.Visible = True
            Rechercher.Top = Me.ScaleHeight - Rechercher.Height
            Apercu.Height = Me.ScaleHeight - Rechercher.Height - 6
            Rechercher_Remplacer.Enabled = False
            Rechercher_Close.Picture = Cross(0).Picture
            Rechercher_Remplacer.BackColor = RGB(128, 128, 128)
            Rechercher_Texte.Text = Apercu.SelText
            Rechercher.Tag = LoadString(67)
            Rechercher_Suite.Caption = LoadString(81)

        Case 5
            'Ajuster
            Me.MousePointer = vbCustom
            SVGofRTF = Apercu.TextRTF

            donnees = Apercu.Text
            donnees = Replace(donnees, " " & vbCrLf, vbCrLf)
            donnees = Replace(donnees, "  ", " ")
            donnees = Replace(donnees, " .", ".")
            donnees = Replace(donnees, " ,", ",")
            donnees = Replace(donnees, "?", "--")
            donnees = Replace(donnees, "?", "..")
            Apercu.TextRTF = vbNullString
            Apercu.Text = donnees
            Me.MousePointer = 0

            Do_Abort

        Case 6

            'Double sauts de ligne
            donnees = Apercu.Text
            donnees = Replace(donnees, vbCrLf & vbCrLf, vbCrLf)
            SVGofRTF = Apercu.TextRTF
            Apercu.TextRTF = vbNullString
            Apercu.TextRTF = donnees

            Do_Abort

        Case 7

            '    'Faire des modifs de police
            '    On Error Resume Next
            '    'Préremplir les champs
            '    With Browser
            '        .fontname = Apercu.SelFontName
            '        .FontSize = Apercu.SelFontSize
            '        .FontBold = Apercu.SelBold
            '        .FontItalic = Apercu.SelItalic
            '        .FontUnderline = Apercu.SelUnderline
            '        .FontStrikethru = Apercu.SelStrikeThru
            '        .flags = 1
            '        .ShowFont
            '    End With
            '    'Si abandon
            '    If Err = 32755 Then Exit Sub
            '    ' Modifier ce qu'il faut
            '    With Browser
            '        Apercu.SelFontName = .fontname
            '        Apercu.SelFontSize = .FontSize
            '        Apercu.SelBold = .FontBold
            '        Apercu.SelItalic = .FontItalic
            '        Apercu.SelUnderline = .FontUnderline
            '        Apercu.SelStrikeThru = .FontStrikethru
            '    End With
        Case 9

            'Couper
            DoEvents
            Apercu.SetFocus
            SendKeys "^x"

        Case 10

            'Copier
            DoEvents
            Apercu.SetFocus
            SendKeys "^c"

        Case 11

            'Coller
            DoEvents
            Apercu.SetFocus
            SendKeys "^v"

        Case 12
            'RTF=>TXT
            SVGofRTF = Apercu.TextRTF
            Apercu.TextRTF = vbNullString
            Apercu.Text = SVGofRTF

        Case 13
            'TXT=>RTF
            Apercu.TextRTF = Apercu.Text

        Case 15
            'Recharge tout en mettant par défaut
            Unload Me
            Me.Show

        Case 17
            Apercu.SelRTF = Barre & Apercu.SelRTF

        Case 19
             MsgBox Replace(LoadString(120), "%u", "CTRL + SHIFT + A")

        Case 20
            MsgBox Replace(LoadString(120), "%u", "CTRL + 2 or CTRL + 1")

        Case 21
            MsgBox Replace(LoadString(120), "%u", "CTRL + SHIFT + =")

        Case 22
            MsgBox Replace(LoadString(120), "%u", "CTRL + =")

    End Select

    'Et on remet le focus
    Apercu.SetFocus
End Sub

Private Sub En_JPG_Click()
    On Error Resume Next
    'Proposer d'encoder les images en JPG
    SaveSetting "TXT2JPG", "Data", "SaveAsJpg", En_JPG.Value
    Me.MousePointer = vbCustom

    If En_JPG.Value = True Then
        If Dir$(GiveMePathOf(&H25) & "\BMP2JPG.dll") = vbNullString Then
            If vbYes = MsgBox(LoadString(82) & vbCrLf & vbCrLf & vbCrLf & "You should download a DLL in order to save in Jpg. Do it now ? (if an error occur, please see you firewall)", vbYesNo + vbCritical, LoadString(83)) Then
                AfficherTip LoadMSG(49), LoadMSG(50), Start, False

                Download "http://neamar.free.fr/Addins/BMP2JPG.dll", GiveMePathOf(&H25) & "\BMP2JPG.dll"
                BallonTip.Visible = False

                DoEvents
                En_JPG_Click
            Else
                En_JPG.Value = 0
            End If

        Else
            etiquette(11).Visible = True
            Qualite.Visible = True
            Qualite_MouseMove 0, 0, 1, 1
        End If

    Else
        etiquette(11).Visible = False
        Qualite.Visible = False
    End If

    Me.MousePointer = 0
End Sub

Private Sub Filig_Change()
    On Error Resume Next
    Dim PATH_FOLDER As String

    'Validité du chemin passé en paramètre
    PATH_FOLDER = Filig.Text

    If LCase$(Right$(PATH_FOLDER, 3)) = "bmp" Or LCase$(Right$(PATH_FOLDER, 3)) = "jpg" Then

        Dim attente As String

        If Dir$(PATH_FOLDER) = vbNullString Then
            AfficherTip LoadMSG(51), LoadMSG(52), Filig, vbExclamation
            Filig.BackColor = 255
            Filig.ForeColor = 0
            VoirApercu.Visible = False

            Exit Sub

        End If

        BallonTip.Visible = False
        'Svg dans le registre
        attente = Right$(PATH_FOLDER, Len(PATH_FOLDER) - InStrRev(PATH_FOLDER, "\"))
        SaveSetting "TXT2JPG", "BackPicture", Left$(attente, Len(attente) - 4), PATH_FOLDER
        'Changer la couleur
        Filig.BackColor = GetPixel(Filig.Container.hdc, Filig.Left, Filig.Top)
        Filig.ForeColor = RGB(255, 255, 255) - Filig.BackColor
        'Afficher un bouton pour apercu
        VoirApercu.Visible = True
        'Et puis le but principal
        Image_A_Blitter.Picture = LoadPicture(PATH_FOLDER)
        'Et remettre pour être sur que ca marche !
        Apercu.BackColor = vbWhite
        Converter.BackColor = vbWhite
        Resultat.BackColor = vbWhite

        DoEvents

        If Image_A_Blitter.Width <> Largeur.Text Or Image_A_Blitter.Height <> Hauteur.Text Then
            RedimToFit.Value = True
            RedimToFit.Visible = True
            etiquette(6).Visible = True
        Else
            RedimToFit.Visible = False
            etiquette(6).Visible = False
        End If

    Else
        AfficherTip LoadMSG(53), LoadMSG(54), Filig
        Image_A_Blitter.Picture = LoadPicture(vbNullString)
        VoirApercu.Visible = False
    End If

End Sub

Private Sub Form_Load()
    On Error Resume Next
    Dim Premiere_Utilisation As Boolean, Last As Long, donnees As String, MySettings As Variant, poubelle2 As Long
    'Lancer le subclassing
    myHDC = Me.hdc

    If App.LogMode <> 0 Then
        SetFormMinMaxSize Me, 900, , 344
        OldWindowProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf NewWindowProc)
    End If

    If App.PrevInstance Then
        MsgBox LoadString(84), vbOKOnly, "PrevInstance"
        Unload Me
        Exit Sub
    End If

    'Définition des variables utilisiées tout au long du programme
    Stockage = GiveMePathOf(&H1C) & "\Stockage.txt":     NotUse = False:     Premiere_Utilisation = False:    NoInternet = False:    MyChoiceIs = 25

    If GetSetting("TXT2JPG", "Data", "Nom", vbNullString) = vbNullString Then
        SaveSetting "TXT2JPG", "Data", "Nom", Environ$("USERNAME")
        Premiere_Utilisation = True
    End If


    'Nettoyer les anciennes traces
    Me.MousePointer = vbCustom

    'Initialiser la feuille : cocher ce qui doit l'être, régler la taille, afficher un BG
    If Dir$(GetSetting("TXT2JPG", "Data", "BackPic", vbNullString)) <> vbNullString Then Set BackPicture = LoadPicture(GetSetting("TXT2JPG", "Data", "BackPic", vbNullString))
    Me.Width = Screen.Width: Me.Height = 5160
    If App.LogMode = 0 Then Me.Width = 13950
    DoNotChange = True
    BG_red = GetSetting("TXT2JPG", "Data", "BG_red", "0"): BC(0).Value = BG_red
    BG_green = GetSetting("TXT2JPG", "Data", "BG_green", 1): BC(1).Value = BG_green
    BG_blue = GetSetting("TXT2JPG", "Data", "BG_blue", "0"): BC(2).Value = BG_blue
    Make_Slide.Value = GetSetting("TXT2JPG", "Data", "Make_Slide", True)
    Reseau.Text = GetSetting("TXT2JPG", "Data", "Nom", Environ$("USERNAME"))
    sens_dessin = GetSetting("TXT2JPG", "Data", "Sens_dessin", "0"): BC(3).Value = sens_dessin
    Save_Folder.Text = GetSetting("TXT2JPG", "Data", "Default_Path", App.Path)
    PutACopyOfFileInFolder.Value = GetSetting("TXT2JPG", "Data", "PutCopy", False)
    UseForeColor.Value = GetSetting("TXT2JPG", "Data", "CleverColor", False): CleverColor = GetSetting("TXT2JPG", "Data", "CleverColor", False)
    Couleur(0).BackColor = 0
    En_JPG.Value = GetSetting("TXT2JPG", "Data", "SaveAsJpg", True)
    'Crée la liste par défaut des bG.
    SaveSetting "TXT2JPG", "BackPicture", LoadString(86), App.Path & "\parchment.jpg"
    SaveSetting "TXT2JPG", "BackPicture", LoadString(87), App.Path & "\aqua.jpg"
    SaveSetting "TXT2JPG", "BackPicture", LoadString(88), App.Path & "\earth.jpg"
    SaveSetting "TXT2JPG", "BackPicture", LoadString(89), App.Path & "\sign.jpg"
    SaveSetting "TXT2JPG", "BackPicture", LoadString(90), App.Path & "\stars.jpg"
    SaveSetting "TXT2JPG", "BackPicture", LoadString(91), App.Path & "\wave.jpg"
    SaveSetting "TXT2JPG", "BackPicture", LoadString(92), App.Path & "\sky.jpg"
    SaveSetting "TXT2JPG", "BackPicture", LoadString(93), App.Path & "\Paix.jpg"
    SaveSetting "TXT2JPG", "BackPicture", LoadString(94), App.Path & "\Ondine.jpg"
    SaveSetting "TXT2JPG", "BackPicture", LoadString(95), App.Path & "\Cristal.jpg"
    SaveSetting "TXT2JPG", "BackPicture", LoadString(96), LoadString(96)
    'Charger les priorités..
    Priorite.AddItem "NORMAL_PRIORITY_CLASS"
    Priorite.AddItem "ABOVE_NORMAL_PRIORITY_CLASS"
    Priorite.AddItem "HIGH_PRIORITY_CLASS"
    Priorite.AddItem "REALTIME_PRIORITY_CLASS"
    Priorite.Text = GetSetting("TXT2JPG", "Data", "Priorite", "NORMAL_PRIORITY_CLASS")
    SendMessage Priorite.hwnd, CB_SETDROPPEDWIDTH, 200, ByVal 0

    ' Extrait les paramètres et remplit la liste des BG
    MySettings = GetAllSettings("TXT2JPG", "BackPicture")
    poubelle = UBound(MySettings, 1): poubelle2 = LBound(MySettings, 1)

    For tempo = poubelle2 To poubelle
        Filig.AddItem MySettings(tempo, 0)
    Next

    'Afficher le "CHARGEMENT..."
    etiquette(2).Top = Hauteur - etiquette(2).Height - 50
    DoNotChange = False

    'Initialisation de l'ensemble linguistique
    donnees = Dir(App.Path & "\Lang\*.LNG") 'lister les langues disponibles
    Do
        Langue.AddItem Left$(donnees, Len(donnees) - 4)
        donnees = Dir
    Loop While donnees <> vbNullString
    Translate_Text
    Langue.Text = "<Chose Your Language>"

    'Et voilà, on montre la feuille !
    Me.Caption = "TXT2JPG, build " & App.Revision
    Apercu.Visible = False

    Me.Show

    DoEvents
    Qualite_MouseMove 0, 0, 0, 0
    Kill Stockage


    NonForcé = False
    TailleDegrade_MouseMove 0, 0, 0, 0, 0: TailleDegrade_MouseMove 1, 0, 0, 0, 0
    ColorRange(0).BackColor = 0: ColorRange(1).BackColor = 0
    Browse2.Picture = Browse.Picture
    Browse3.Picture = Browse.Picture
    Enregistrer(1).Picture = Enregistrer(0).Picture
    Defaut.Picture = Enregistrer(0).Picture
    ChoosePic.Taille = 8
    VoirApercu.Taille = 10
    Appliquer.Taille = 10
    AppliquImage.Taille = 10
    Couleur(1).BackColor = RGB(255, 255, 255)
    Converter.BackColor = RGB(255, 255, 255)
    OverView.ZOrder 0
    PlugChoice_Click (0)

    If Premiere_Utilisation Then AfficherTip LoadMSG(55), LoadMSG(56), PlugChoice(3), vbExclamation
    If Command$() <> vbNullString Then Load_Text_File Mid$(Command$(), 2, Len(Command$()) - 2)

    'De seconde main (dl liste baladeur..)
    DoEvents
    Download "http://neamar.free.fr/Addins/baladeurs.php?requete=MarqueENUM"
    Open Stockage For Input As #1
    Line Input #1, donnees
    Close #1

    donnees = donnees & LoadString(109) & "|"
    'Liste des marques
    tempo = 1
    Last = 1
    'Explode la liste
    poubelle = Len(donnees)

    For tempo = 1 To poubelle

        If Mid$(donnees, tempo, 1) = "|" Then
            Marque.AddItem Mid$(donnees, Last, tempo - Last)
            Last = tempo + 1
            tempo = tempo + 1
        End If

    Next

    If GetSetting("TXT2JPG", "Data", "Modele", vbNullString) <> vbNullString Then
        Marque.Text = GetSetting("TXT2JPG", "Data", "Marque", vbNullString)
        Marque_Click

        DoEvents
        Modeles.Text = GetSetting("TXT2JPG", "Data", "Modele", vbNullString)
        Modeles_Click
    End If

    Apercu.Visible = True
    Me.MousePointer = 0

    If (GetSetting("TXT2JPG", "Data", "ExitCode", 0) <> 0 And App.LogMode <> 0) Then
        'Le logiciel a été mal quitté ! (et est compilé !)
        BUG.Visible = True
        BUG.Top = -30
        'Bug_Close.Picture = BallonTipCancel(0).Picture
        debut = Timer
        Apercu.Height = Apercu.Height - (30 - Apercu.Top)

        DoEvents
        Do
            tempo = Min(-30 + 60 * (Timer - debut), 0)
            BUG.Top = tempo
            Apercu.Top = tempo + 30

            DoEvents
        Loop While tempo <> 0

    End If

    SaveSetting "TXT2JPG", "Data", "ExitCode", 1
End Sub

Private Sub Form_Unload(Cancel As Integer)
    'Quand on quitte, on verifie les updates et puis on sauvegarde qui'l n'y a pas eu de bugs (miracle lol)..
    SaveSetting "TXT2JPG", "Data", "NbUse", GetSetting("TXT2JPG", "Data", "NbUse", "0") + 1

    If App.LogMode <> 0 Then
        If NotUse = False Then

            On Error Resume Next

            Dim base As String

            etiquette(15).Visible = False: etiquette(2).Visible = True
            Apercu.Visible = False

            DoEvents

            'Y a t il une nouvelle version ?
            Download "http://neamar.free.fr/cible2.php?action=ZenUser&version=" & App.Revision & "&utilisateur=" & GetSetting("TXT2JPG", "Data", "Nom", "Anonyme")
            Apercu.Text = vbNullString
            Apercu.LoadFile Stockage

            DoEvents

            If Len(Apercu.Text) > 150 Then
                'Une nouvelle version est disponible !
                base = LoadString(98) & vbCrLf & Replace(Replace(Apercu.Text, "<br>", vbCrLf), "<br />", vbCrLf)

                If vbYes = MsgBox(base, vbYesNo + vbApplicationModal, LoadString(99)) Then
                    'Et il veut la telecharger ! Le bonheur ;-)
                    ShellExecute Me.hwnd, "open", LoadString(38) & "?version=" & App.Revision, vbNullString, App.Path, 1
                End If
            End If

            Kill Stockage
        End If
    End If

    'Proposer un sondage...
    If GetSetting("TXT2JPG", "Data", "NbUse", "0") = "3" Then
        If vbYes = MsgBox(LoadString(100) & vbCrLf & LoadString(101), vbYesNo, "Help TXT2JPG !") Then
            ShellExecute Me.hwnd, "open", "http://neamar.free.fr/" & LoadString(73) & "/sondage.php", vbNullString, App.Path, 1
        End If
    End If

    'Arrêter le subclassing !
    'Il n'y a pas eu de bug !
    SaveSetting "TXT2JPG", "Data", "ExitCode", 0
End Sub

Private Sub Pagination_Click()
    On Error Resume Next
    If Pagination.Value Then
        UseTopAndBottomMargin.Value = True
        UseTopAndBottomMargin.Enabled = False
        SetMarge_MouseMove 3, vbLeftButton, 0, 14 * 1.5, 0
    Else
        BallonTip.Visible = False
        UseTopAndBottomMargin.Enabled = True
    End If

    etiquette(29).BackStyle = 0
End Sub

Private Sub PlugChoice_Click(Index As Integer)

    Dim pos_depart As Long, longueur As Long, Current_time As Long, Pre_compile As Single, pos_depart2 As Long, My_DC As Long, Plug_DC As Long, OLD_Plug_DC As Long, Plug_Left As Long

    On Error Resume Next

    If IsSlidingWorking Then Exit Sub
    BallonTip.Visible = False
    IsSlidingWorking = True

    Dim duree As Long

    duree = 1000 * Abs(Make_Slide.Value) 'durée du slide en ms (0 si désactivé)

    With Plug(Index)
        .Visible = True
        .Top = -.Height
        pos_depart = .Top
        longueur = Abs(pos_depart) + Me.ScaleHeight \ 2 - .Height \ 2
        .Left = MainContainer.Left + MainContainer.Width + 7 '745
        BitBlt .hdc, 0, 0, 176, 289, myHDC, .Left, .Top, vbSrcCopy
    End With

    'Précompiler les valeurs utiles au sliding
    Pre_compile = longueur / duree
    pos_depart2 = SelectedPlug.Top
    debut = GetTickCount()
    My_DC = myHDC
    Plug_DC = Plug(Index).hdc
    Plug_Left = Plug(Index).Left
    OLD_Plug_DC = SelectedPlug.hdc

    'Et le petit sliding !
    Do
        Current_time = GetTickCount()
        Plug(Index).Top = pos_depart + (Current_time - debut) * Pre_compile
        BitBlt Plug_DC, 0, 0, 176, 289, My_DC, Plug_Left, Plug(Index).Top, vbSrcCopy
        Plug(Index).Refresh
        SelectedPlug.Top = pos_depart2 + (Current_time - debut) * Pre_compile
        BitBlt OLD_Plug_DC, 0, 0, 176, 289, My_DC, Plug_Left, SelectedPlug.Top, vbSrcCopy
        SelectedPlug.Refresh

        DoEvents
    Loop While Current_time - debut < duree

    SelectedPlug.Visible = False

    'Au cas ou on a cliqué comme un bourrin un peu partout, pour éviter des bugs anormaux :
    For tempo = 0 To PlugChoice.Count - 1

        If PlugChoice(tempo).Value = True Then

            With Plug(tempo)
                .Visible = 1
                .Top = (Me.ScaleHeight - .Height) \ 2
                BitBlt .hdc, 0, 0, 176, 289, myHDC, 0, .Top, vbSrcCopy
                .Left = MainContainer.Left + MainContainer.Width + 7 '745
            End With

            Set SelectedPlug = Plug(tempo)
        Else
            Plug(tempo).Visible = False
        End If

    Next

    If PlugChoice(1).Value Or PlugChoice(5).Value Then
        If PlugChoice(2).Top = 56 Then

            For tempo = 56 To 84
                PlugChoice(2).Top = tempo
                PlugChoice(4).Top = tempo + 28
                PlugChoice(3).Top = tempo + 56
            Next

        End If

        PlugChoice(5).Visible = True
    Else
        PlugChoice(5).Visible = False

        If PlugChoice(2).Top = 84 Then

            For tempo = 84 To 56 Step -1
                PlugChoice(2).Top = tempo
                PlugChoice(4).Top = tempo + 28
                PlugChoice(3).Top = tempo + 56
            Next

        End If
    End If

    Form_Redraw

    If Index = 5 Then
        NoSelEvents = True
        TailleDegrade_MouseMove 0, 0, 0, 0, 0
        TailleDegrade_MouseMove 1, 0, 0, 0, 0
    ElseIf Index = 2 Then
        SetMarge_MouseMove 0, 0, 0, 0, 0
        SetMarge_MouseMove 1, 0, 0, 0, 0
        SetMarge_MouseMove 2, 0, 0, 0, 0
        SetMarge_MouseMove 3, 0, 0, 0, 0
    ElseIf Index = 0 Then
        Qualite_MouseMove 0, 0, 0, 0
    Else
        NoSelEvents = False
    End If

    If Index = 0 And Modeles.Visible = False Then Glass 10, 121, 158, 152, Plug(0).hdc: Plug(0).Refresh
    If Index = 0 And Modeles.Visible = True Then Glass 10, 121, 158, 222, Plug(0).hdc: Plug(0).Refresh
    If Index = 1 And Use_Back_Picture.Value = True Then Glass 9, 180, 170, 269, Plug(1).hdc: Plug(1).Refresh
    If Index = 4 Then Glass 0, 121, 169, 200, Plug(4).hdc: Plug(4).Refresh
    If Index = 5 Then Glass 0, 170, 169, 285, Plug(5).hdc: Glass 79, 128, 81, 160, Plug(5).hdc: Plug(5).Refresh
    IsSlidingWorking = False
End Sub

Private Sub Polices_DropDown()
    On Error Resume Next
    If Polices.ListCount = 0 Then
        'Les polices mettent un certain temps à se charger, alors on prévient :
        Polices.Text = LoadString(102)

        DoEvents

        Dim nbpolice As Long

        Me.MousePointer = vbCustom
        Polices.MousePointer = vbCustom
        nbpolice = Screen.FontCount - 1

        For tempo = 0 To nbpolice
            Polices.AddItem Screen.Fonts(tempo)
        Next

        Me.MousePointer = vbDefault
        Polices.MousePointer = 0
        Me.Visible = True
        Polices.Text = "MS Sans Serif"
    End If

End Sub

Private Sub Root_LostTheFocus()
    'Masquer l'infobulle
    BallonTip.Visible = False
End Sub

Private Sub MAJ_Timer()
    On Error Resume Next
    MAJ.Enabled = False

    If MAJ.Tag <> vbNullString Then Filig.Text = MAJ.Tag: MAJ.Tag = vbNullString
    Me.Refresh

    If Qualite.Visible Then Qualite_MouseDown 0, 0, 0, 0
End Sub

Private Sub Marque_Click()
    On Error Resume Next
    'Selectionne les modèles convenant à la marque
    Dim Marque_Top As Long

    Dim Last As Long, donnees As String

    Modeles.Clear

    If En_JPG.Top = 161 Then
        Marque_Top = Marque.Top - 6
        debut = Timer

        Do
            tempo = Min(161 + 100 * (Timer - debut), 231)
            En_JPG.Top = tempo
            etiquette(10).Top = tempo
            Qualite.Top = tempo + 28
            etiquette(11).Top = tempo + 14

            If tempo - 20 > Modeles.Top Then Modeles.Visible = True
            If tempo - 15 > etiquette(8).Top Then etiquette(8).Visible = True
            If tempo - 15 > etiquette(9).Top Then etiquette(9).Visible = True
            If tempo - 20 > Hauteur.Top Then Hauteur.Visible = True
            If tempo - 20 > Largeur.Top Then Largeur.Visible = True
            If tempo - 15 > Swap.Top Then Swap.Visible = True: Defaut.Visible = True
            Qualite_MouseMove 0, 0, 0, 0
            BitBlt Plug(0).hdc, 10, Marque_Top, 159, 289 - Marque_Top, myHDC, Plug(0).Left + 10, Plug(0).Top + Marque_Top, vbSrcCopy
            Glass 10, 121, 158, tempo - 9, Plug(0).hdc: Plug(0).Refresh

            DoEvents
        Loop Until tempo = 231

    End If

    Qualite_MouseDown 0, 0, 0, 0
    Me.MousePointer = vbCustom

    Download "http://neamar.free.fr/Addins/baladeurs.php?requete=ModeleENUM&Marque=" & Marque.Text
    Open Stockage For Input As #1
    Line Input #1, donnees
    Close #1

    donnees = donnees & LoadString(104) & "|"
    'Liste des marques
    tempo = 1
    Last = 1
    poubelle = Len(donnees)

    For tempo = 1 To poubelle

        If Mid$(donnees, tempo, 1) = "|" Then
            Modeles.AddItem Mid$(donnees, Last, tempo - Last)
            Last = tempo + 1
            tempo = tempo + 1
        End If

    Next

    Me.MousePointer = 0
End Sub

Private Sub MEf_Click(Index As Integer)
    On Error Resume Next

    If Index = 0 Then Apercu.SelBold = Not (Apercu.SelBold)
    If Index = 1 Then Apercu.SelItalic = Not (Apercu.SelItalic)
    If Index = 2 Then Apercu.SelUnderline = Not (Apercu.SelUnderline)
    If Index = 3 Then Apercu.SelStrikeThru = Not (Apercu.SelStrikeThru)
    If Index = 4 Then Apercu.SelBullet = Not (Apercu.SelBullet)
    Apercu.SetFocus
End Sub

Private Sub Modeles_Click()
    On Error GoTo Err_handler_Modeles

    Dim New_Marque As String, New_Modele As String, texte As String

    texte = vbNullString

    If Modeles.Text <> LoadString(104) Then
        If Dir$(Stockage) <> vbNullString Then Kill Stockage

        Download "http://neamar.free.fr/Addins/baladeurs.php?requete=Screen_Size&Modele=" & Modeles.Text
        Open Stockage For Input As #1
        Input #1, texte
        Close #1
        Hauteur.Text = Val(Left$(texte, 3))
        Largeur.Text = Val(Mid$(texte, 4, 3))
        Defaut.Visible = True
    Else
        Hauteur.Text = InputBox(LoadString(105), LoadString(106), "240")
        Largeur.Text = InputBox(LoadString(107), LoadString(108), "320")

        If Hauteur.Text = vbNullString Or Largeur.Text = vbNullString Then
            AfficherTip LoadMSG(59), LoadMSG(60), Largeur, vbExclamation
            Exit Sub
        End If

        If Marque.Text = LoadString(109) Then New_Marque = InputBox(LoadString(110), LoadString(77), "NoName") Else New_Marque = Marque.Text
        New_Modele = InputBox(LoadString(111), LoadString(76), LoadString(76))
        Modeles.Text = New_Modele
        Marque.Text = New_Marque

        Download "http://neamar.free.fr/mailer.php?action=Submitting&marque=" & New_Marque & "&nom=" & New_Modele & "&hauteur=" & Hauteur.Text & "&largeur=" & Largeur.Text & "&auteur=" & GetSetting("TXT2JPG", "Data", "Nom", "Anonyme") & "&comment=Rien"
        AfficherTip LoadMSG(61), LoadMSG(62), Marque, False
    End If

    DoEvents

    If Filig.Text <> vbNullString Then Filig_Change

    Exit Sub

Err_handler_Modeles:
    AfficherTip LoadMSG(63), LoadMSG(64), Marque, False
End Sub

Private Sub Modules_Click(Index As Integer)
    On Error Resume Next
    Me.MousePointer = vbCustom

    Select Case Index

        Case 0

            'Propose le module ConvertPowerPoint au telechargement, ainsi que ses dépendances
            If Dir$(App.Path & "\ConvertPowerPoint.exe") = vbNullString Then
                If vbNo = MsgBox(LoadString(112), vbYesNo + vbCritical, "TXT2JPG") Then Exit Sub

                Download "http://neamar.free.fr/txt2jpg/Modules/ConvertPowerPoint.exe", App.Path & "\ConvertPowerPoint.exe"
            End If

            If Dir$(GiveMePathOf(&H25) & "\BMP2JPG.dll") = vbNullString Then
                If vbNo = MsgBox(LoadString(113), vbYesNo + vbCritical, LoadString(83)) Then Exit Sub

                Download "http://neamar.free.fr/Addins/BMP2JPG.dll", GiveMePathOf(&H25) & "\BMP2JPG.dll"
            End If

            SaveSetting "TXT2JPG", "Data", "MalLance", False
            ShellExecute Me.hwnd, "open", App.Path & "\ConvertPowerPoint.exe", vbNullString, App.Path, 1
            NotUse = True

            Download "http://neamar.free.fr/cible2.php?action=ConverterPP&utilisateur=" & GetSetting("TXT2JPG", "Data", "Nom", "Anonyme")

        Case 1

            'Propose de telecharger le module degrade
            If Dir$(App.Path & "\Degrade.exe") = vbNullString Then
                If vbNo = MsgBox(LoadString(114), vbYesNo + vbCritical, "TXT2JPG") Then Exit Sub

                Download "http://neamar.free.fr/txt2jpg/Modules/Degrade.exe", App.Path & "\Degrade.exe"
            End If

            If Modeles.Text = LoadString(74) Or Modeles.Text = vbNullString Then
                MsgBox LoadString(115), vbOKOnly + vbInformation

                Exit Sub

            End If

            SaveSetting "TXT2JPG", "Degrade", "Baladeur", Modeles.Text
            SaveSetting "TXT2JPG", "Degrade", LoadString(108), Largeur.Text
            SaveSetting "TXT2JPG", "Degrade", LoadString(106), Hauteur.Text
            ShellExecute Me.hwnd, "open", App.Path & "\Degrade.exe", vbNullString, App.Path, 1

            Download "http://neamar.free.fr/cible2.php?action=Degrade&utilisateur=" & GetSetting("TXT2JPG", "Data", "Nom", "Anonyme")
            NotUse = True

        Case 2

            'Lancer le module GIF2AVI
            If Dir$(App.Path & "\GIF2AVI.exe") = vbNullString Then
                If vbNo = MsgBox(LoadString(116), vbYesNo + vbCritical, "TXT2JPG") Then Exit Sub

                Download "http://neamar.free.fr/txt2jpg/Modules/GIF2AVI.exe", App.Path & "\GIF2AVI.exe"

                If Dir$(GiveMePathOf(&H25) & "\GIF89.DLL") = vbNullString Then Download "http://neamar.free.fr/txt2jpg/Modules/GIF89.DLL", GiveMePathOf(&H25) & "\GIF89.DLL"
                If Dir$(App.Path & "\Hypercube.gif") = vbNullString Then Download "http://neamar.free.fr/txt2jpg/Modules/Hypercube.gif", App.Path & "\Hypercube.gif"
                If Dir$(App.Path & "\CreatAVI.exe") = vbNullString Then Download "http://neamar.free.fr/txt2jpg/Modules/CreatAVI.exe", App.Path & "\CreatAVI.exe"
            End If

            SaveSetting "TXT2JPG", "Data", "MalLance", False
            ShellExecute Me.hwnd, "open", App.Path & "\GIF2AVI.exe", vbNullString, App.Path, 1
            NotUse = True

            Download "http://neamar.free.fr/cible2.php?action=Gif2Avi&utilisateur=" & GetSetting("TXT2JPG", "Data", "Nom", "Anonyme")

        Case 3

            'Ouvre la page d'accueil du projet Gutenberg
            ShellExecute Me.hwnd, "open", LoadString(117), vbNullString, App.Path, 1

        Case 4
            ShellExecute Me.hwnd, "open", "http://neamar.free.fr/Ephem/ephem.php", vbNullString, App.Path, 1
    End Select

    Me.MousePointer = 0
End Sub

Private Sub Modules_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    etiquette(16).Caption = Modules(Index).ToolTipText
    etiquette(16).Tag = Modules(Index).Tag
End Sub

Private Sub OverView_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    OverView.Visible = False
End Sub

Private Sub Polices_Click()
    On Error Resume Next
    If DoNotChange Then Exit Sub

    'Changer la police
    On Error Resume Next

    If Apercu.SelLength = 0 Then
        Apercu.SelStart = 0
        Apercu.SelLength = Len(Apercu.Text)
    End If

    Apercu.SelFontName = Polices.Text
    Apercu.SetFocus
End Sub

Private Sub Priorite_Change()
    On Error Resume Next
    If Priorite.Text = "REALTIME_PRIORITY_CLASS" Then
        'Cette priorité peut être déstabilisante...
        MsgBox LoadString(118), vbExclamation
    End If

    SaveSetting "TXT2JPG", "Data", "Priorite", Priorite.Text
End Sub

Private Sub Priorite_Click()
    Priorite_Change
End Sub

Private Sub Qualite_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Qualite_MouseMove Button, Shift, X, Y
End Sub

Private Sub Qualite_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    On Error Resume Next
    'Updater la valeur
    If Button = vbLeftButton And X >= 0 And X <= 148 Then
        Qualite.Tag = Int((X / 148) * 50 + 50)

        etiquette(11).Caption = Replace(LoadString(119), "%u", Qualite.Tag)
    End If

    'Arrière plan
    BitBlt Qualite.hdc, 0, 0, 148, 15, Plug(0).hdc, Qualite.Left, Qualite.Top, vbSrcCopy
    TransparentBlt Qualite.hdc, 0, 2, 148, 13, QualiteMask.hdc, 0, 0, 148, 13, RGB(255, 255, 255)
    'Bulle
    TransparentBlt Qualite.hdc, (Qualite.Tag - 50) * 2.96 - 4, 1, 11, 13, QualiteMask.hdc, 149, 0, 11, 13, RGB(255, 255, 255)
    Qualite.Refresh
End Sub

Private Sub Reseau_KeyPress(KeyAscii As Integer)
    Enregistrer(0).Visible = True
End Sub

Private Sub Save_Folder_Change()
    Enregistrer(1).Visible = True
End Sub

Private Sub Make_Slide_Click()
    SaveSetting "TXT2JPG", "Data", "Make_Slide", Make_Slide.Value
End Sub

Private Sub Swap_Click()
    On Error Resume Next
    Dim svg As Integer

    svg = Largeur.Text
    Largeur.Text = Hauteur.Text
    Hauteur.Text = svg
    svg = vbNull
End Sub

Private Sub Taille_Change()
    On Error Resume Next
    'Change la taille du texte
    If DoNotChange Then Exit Sub

    On Error Resume Next

    If Apercu.SelLength = 0 Then
        Apercu.SelStart = 0
        Apercu.SelLength = Len(Apercu.Text)
    End If

    Apercu.SelFontSize = Taille.Text
End Sub

Private Sub Taille_Click()
    Taille_Change
End Sub

Private Sub Taille_DropDown()
    On Error Resume Next
    'La première fois, charger
    If Taille.ListCount = 0 Then

        For tempo = 6 To 12
            Taille.AddItem FORMAT$(tempo, "00")
            Taille.AddItem 2 * tempo + 1
            Taille.AddItem 4 * tempo + 1
        Next

    End If

End Sub

Private Sub Taille_KeyPress(KeyAscii As Integer)
    On Error Resume Next
    Dim AllowedKeys As String

    AllowedKeys = "0123456789." & Chr$(8)

    If InStr(AllowedKeys, Chr$(KeyAscii)) = 0 Then KeyAscii = 0
End Sub

Private Sub UseTopAndBottomMargin_Click()
    On Error Resume Next
    'Détermine si l'on peut utiliser des marges haut et bas
    SetMarge(2).Visible = UseTopAndBottomMargin.Value
    SetMarge(3).Visible = UseTopAndBottomMargin.Value
    etiquette(26).Visible = UseTopAndBottomMargin.Value
    etiquette(27).Visible = UseTopAndBottomMargin.Value
End Sub

Private Sub VoirApercu_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    VoirApercu_MouseMove Button, Shift, X, Y
End Sub
 

Les modules :

Fonctions

Le module fonction gère toutes les fonctions annexes qui ne sont pas des événements.

Code source : Fonctions.bas
  • Langage : vb
  • ΔT : 0.587s
  • Taille :20847 caractères
Attribute VB_Name = "Fonctions"
'--------------------------------------------------------------------------------
'    Component  : Fonctions
'    Project    : TXT2JPG
'
'    Description:
'Module utilisé pour le subclassing
'Et pour trouver le chemin des fichiers spéciaux
'Et pour afficher un comdlg, un colorpicker et un select folder
'Et pour des petites fonctions : Min, MyMid
'Et pour SetBackColorSel
'Bref, toutes les petites fonctions qui ne trouvaient leurs places nulle part..
'
'    Modified   :
'--------------------------------------------------------------------------------
'
Option Explicit

'Quasiment l'API principale...pour tout les messages Windows
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

'
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long



'Choix d'un fichier : type des données envoyées
Private Type OPENFILENAME

    lStructSize As Long
    hWndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String

End Type

'Choix d'un dossier : type des données envoyées
Private Type BrowseInfo

    hWndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long

End Type

'Choix de couleur : type des données envoyées
Private Type ChooseColor

    lStructSize As Long
    hWndOwner As Long
    hInstance As Long
    rgbResult As Long
    lpCustColors As String
    flags As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String

End Type

'Pour les dossiers spéciaux :
Private Type SHITEMID

    CB As Long
    abID As Byte

End Type

'
Private Type ITEMIDLIST

    mkid As SHITEMID

End Type

'
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hWndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long

'Grise le bouton de fermeture de la feuille pendant la numérisation :
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long

Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long

Private Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long

Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long

Private Const SC_CLOSE     As Long = &HF060&

Private Const MF_BYCOMMAND As Long = &H0&

Private Const MF_BYPOSITION = &H400&

' Déclaration de fonctions API
'ComDlg
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

'ColorPicker
Private Declare Function ChooseColorAPI Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long

'File picker
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long

'Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long,ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long

'Constantes
'Pour le select folder
Private Const BIF_RETURNONLYFSDIRS = 1

Private Const BIF_DONTGOBELOWDOMAIN = 2

Public Const BIF_USENEWUI = &H40

'Pour le comdlg file :
Public Enum esFlags

    OFN_ALLOWMULTISELECT = &H200
    OFN_CREATEPROMPT = &H2000
    OFN_ENABLEHOOK = &H20
    OFN_ENABLETEMPLATEHANDLE = &H80
    OFN_EXPLORER = &H80000
    OFN_EXTENSIONDIFFERENT = &H400
    OFN_FILEMUSTEXIST = &H1000
    OFN_HIDEREADONLY = &H4
    OFN_LONGNAMES = &H200000
    OFN_NOCHANGEDIR = &H8
    OFN_NODEREFERENCELINKS = &H100000
    OFN_NOLONGNAMES = &H40000
    OFN_NONETWORKBUTTON = &H20000
    OFN_NOREADONLYRETURN = &H8000
    OFN_NOTESTFILECREATE = &H10000
    OFN_NOVALIDATE = &H100
    OFN_OVERWRITEPROMPT = &H2
    OFN_PATHMUSTEXIST = &H800
    OFN_READONLY = &H1
    OFN_SHAREAWARE = &H4000
    OFN_SHOWHELP = &H10

End Enum

'Pour le color picker :
Dim CustomColors() As Byte

Private Const LF_FACESIZE = 32

' Format structure, passé avec SendMessage au contrôle pour changer le backcolor
Private Type FORMAT

    cbSize As Integer
    wPad1 As Integer
    dwMask As Long
    dwEffects As Long
    yHeight As Long
    yOffset As Long
    crTextColor As Long
    bCharSet As Byte
    bPitchAndFamily As Byte
    szFaceName(0 To LF_FACESIZE - 1) As Byte
    wPad2 As Integer
    wWeight As Integer
    sSpacing As Integer
    crBackColor As Long
    lLCID As Long
    dwReserved As Long
    sStyle As Integer
    wKerning As Integer
    bUnderlineType As Byte
    bAnimation As Byte
    bRevAuthor As Byte
    bReserved1 As Byte

End Type

Private Const SCF_SELECTION = &H1&

Private Const WM_USER = &H400

' pour recuperer les messages et text avec richtextbox
Private Const EM_SETCHARFORMAT = (WM_USER + 68)

' pour Font et BackColor
Private Const CFM_BACKCOLOR = &H4000000

Private Const CFE_AUTOBACKCOLOR = CFM_BACKCOLOR

Public Type ResultConstant
    URL As String
    EstUnLiens As Boolean
    Email As Boolean
    interne As Boolean
End Type
Private Type POINTAPI
    X       As Long
    Y       As Long
End Type



Public Stockage As String

'Empeche le rafraichissement d'un controle
Public Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Dim Rectangle As RECT

Private Const EM_GETRECT = &HB2
Private Const EM_SETRECT = &HB3

'Faire un son pour l'infobulle
Private Declare Function MessageBeep Lib "user32" (ByVal wType As Long) As Long

Public Sub ShowHelpFor(controle As Control, MessageTitre As String, MessageTexte As String)
    If Principale.BallonTip.Left <> controle.Width \ 2 + controle.Left - Principale.BallonTip.Width + 18 + controle.Container.Left Or Principale.BallonTip.Top <> controle.Top + controle.Height + controle.Container.Top Then AfficherTip MessageTitre, MessageTexte, controle
End Sub

'Sub pour l'affichage d'une infobulle style XP. Possibilité de définir un son, recoit l'id du message et va chercher dans le fichier ini la traduction
Public Sub AfficherTip(Titre As String, Contenu As String, ctl As Control, Optional SoundToPlay As Long = 0)
    On Error Resume Next
    If Left$(Titre, 1) = "i" Then

        'L'infobulle n'est qu'une simple information qui ne sera affichée qu'une seule fois.
        If GetSetting("TXT2JPG", "ShownTip", Left$(Titre, 4) & Left$(Contenu, 2), 0) > 1 Then Exit Sub
        SaveSetting "TXT2JPG", "ShownTip", Left$(Titre, 4) & Left$(Contenu, 2), GetSetting("TXT2JPG", "ShownTip", Left$(Titre, 4) & Left$(Contenu, 2), 0) + 1
        Titre = Right$(Titre, Len(Titre) - 1)
        Principale.MouseOutProc.Tag = ctl.hwnd
        Principale.MouseOutProc.Enabled = True
    End If

    Principale.BallonTip.Top = ctl.Top + ctl.Height + ctl.Container.Top
    Principale.BallonTip.Left = ctl.Width \ 2 + ctl.Left - Principale.BallonTip.Width + 18 + ctl.Container.Left
    Principale.BallonTip.Titre = Titre
    Principale.BallonTip.Text = Contenu
    Principale.BallonTip.Visible = True

    If SoundToPlay <> False And SoundToPlay <> True Then MessageBeep SoundToPlay
    '    Dim pt As POINTAPIre
    '
    '    pt.x = 0: pt.y = 0
    '    On Error GoTo cantshow
    '    If Not (Me.ActiveControl = ctl) And ExitOnUnFocus Then Exit Sub
    'cantshow:
    '    If Left$(Titre, 1) = "i" Then
    '        'L'infobulle n'est qu'une simple information qui ne sera affichée qu'une seule fois.
    '        If GetSetting("TXT2JPG", "ShownTip", Left$(Titre, 4) & Left$(English_Titre, 4) & Left$(Contenu, 2), 0) > 1 Then Exit Sub
    '        SaveSetting "TXT2JPG", "ShownTip", Left$(Titre, 4) & Left$(English_Titre, 4) & Left$(Contenu, 2), GetSetting("TXT2JPG", "ShownTip", Left$(Titre, 4) & Left$(English_Titre, 4) & Left$(Contenu, 2), 0) + 1
    '        Titre = Right(Titre, Len(Titre) - 1)
    '    End If
    '    'Affiche un message dans une infobulle
    '    'D'abord l'arrière plan : (un simple blit..mais avec des screentoclient^-1)
    '    BallonTip.Visible = False
    '    'Afficher une icone si critique !
    '    BallonTipCaption.Left = IIf(SoundToPlay = vbCritical, 55, 14)
    '    BallonTipCaption.Width = IIf(SoundToPlay = vbCritical, 255, 302)
    '    BallonTipCritique.Visible = IIf(SoundToPlay = vbCritical, True, False)
    '    BallonTip.Top = ctl.Top + ctl.Height + ctl.Container.Top
    '    BallonTip.Left = ctl.Width \ 2 + ctl.Left - BallonTip.Width + 18 + ctl.Container.Left
    '    DoEvents
    '    ClientToScreen BallonTip.hWnd, pt
    '    BitBlt BallonTip.hdc, 0, 0, 327, 113, GetDC(0), pt.x, pt.y, vbSrcCopy
    '
    '    TransparentBlt BallonTip.hdc, 0, 0, 327, 113, BallonTipPic.hdc, 0, 0, 327, 113, RGB(255, 255, 255)
    '    If Selected_Language = "Francais" Then
    '        BallonTipTitre = Titre
    '        BallonTipCaption = Contenu
    '    Else
    '        BallonTipTitre = English_Titre
    '        BallonTipCaption = English_Contenu
    '    End If
    '    If SoundToPlay <> 0 Then MessageBeep SoundToPlay
    '
    '    'Remettre la croix à vide
    '    BallonTipCancel(0).Visible = True
    '    BallonTipCancel(1).Visible = False
    '    BallonTip.Visible = True
End Sub


Public Sub TextBoxMargins(TextBox As RichTextBox, ByVal LeftMargin As Variant, ByVal TopMargin As Variant, ByVal RightMargin As Variant, ByVal BottomMargin As Variant)

  Dim nRect As RECT
 
  TextBoxResetRect TextBox
  With TextBox
    SendMessage .hwnd, EM_GETRECT, 0, nRect
        With nRect
            .Left = LeftMargin
            .Top = TopMargin
            .Right = TextBox.Width - RightMargin
            .Bottom = TextBox.Height - BottomMargin
        End With
        SendMessage .hwnd, EM_SETRECT, 0, nRect
  End With
End Sub
Private Sub TextBoxResetRect(TextBox As RichTextBox)
  Dim nWidth As Single

  With TextBox
    LockWindowUpdate GetParent(.hwnd)
    nWidth = .Width
    .Width = 1
    .Width = nWidth
    LockWindowUpdate 0
  End With
End Sub
Public Function LoadString(ID As Long) As String
    'Lire dans le fichier INi pour les langues
    Dim Retour As String, Variable As String, fichier As String
    fichier = App.Path & "\Lang\" & GetSetting("TXT2JPG", "Data", "Langue", "Francais") & ".lng"
    Variable = "String" & Str(ID)
    Retour = String(512, Chr(0))
    LoadString = Left$(Retour, GetPrivateProfileString("Strings", ByVal Variable, "", Retour, Len(Retour), fichier))
End Function


Public Function LoadCaption(ID As String) As String
    'Lire dans le fichier INi pour les langues
    Dim Retour As String, fichier As String
    fichier = App.Path & "\Lang\" & GetSetting("TXT2JPG", "Data", "Langue", "Francais") & ".lng"
    Retour = String(512, Chr(0))
    LoadCaption = Left$(Retour, GetPrivateProfileString("FormData", ByVal ID, "", Retour, Len(Retour), fichier))
End Function

Public Function LoadMSG(ID As Long) As String
    'Lire dans le fichier lng (ini) pour les langues
    Dim Retour As String, Variable As String, fichier As String
    fichier = App.Path & "\Lang\" & GetSetting("TXT2JPG", "Data", "Langue", "Francais") & ".lng"
    Variable = "MSG" & Str(ID)
    Retour = String(512, Chr(0))
    LoadMSG = Left$(Retour, GetPrivateProfileString("Message", ByVal Variable, "", Retour, Len(Retour), fichier))
End Function


Public Function SetBackColorSel(ByVal RichHwnd As Long, ByVal NouveauFontBackColorSel As Long)

    On Error Resume Next

    Dim iniformat As FORMAT

    ' Set BackColor a masqué
    iniformat.dwMask = CFM_BACKCOLOR

    ' Si le nouveau backcolour est mis à -1 alors nous avons mis le
    ' Backcolour RichTextbox a zero (vbwhite)
    If NouveauFontBackColorSel = -1 Then
        iniformat.dwEffects = CFE_AUTOBACKCOLOR
        iniformat.crBackColor = -1
    Else
        ' donner la nouvelle couleur à BackColour
        iniformat.crBackColor = NouveauFontBackColorSel 'ChangerColor(NouveauFontBackColorSel)
    End If

    ' Nous avons besoin de passer la dimension de la structure comme un
    ' partie de la structure.
    iniformat.cbSize = Len(iniformat)
    ' Envoyez le message et le nouveau format de caractère au RichTextbox
    SetBackColorSel = SendMessage(RichHwnd, EM_SETCHARFORMAT, SCF_SELECTION, iniformat)
End Function

Public Sub Griser_Fermer(hwnd As Long)

    On Error Resume Next

    Dim hSysMenu As Long

    ' Récupère le handle du menu système
    hSysMenu = GetSystemMenu(hwnd, False)
    ' Supprime le menu "Fermer"
    Call DeleteMenu(hSysMenu, SC_CLOSE, MF_BYCOMMAND)
    ' Supprime la barre d'espacement
    Call DeleteMenu(hSysMenu, GetMenuItemCount(hSysMenu) - 1, MF_BYPOSITION)
    ' Redessine la barre de menu
    Call DrawMenuBar(hwnd)
End Sub

Public Function SelectFolder(Titre As String, Handle As Long) As String

    On Error Resume Next

    Dim lpIDList    As Long

    Dim strBuffer   As String

    Dim strTitre    As String

    Dim tBrowseInfo As BrowseInfo

    strTitre = Titre

    With tBrowseInfo
        .hWndOwner = Handle
        .lpszTitle = lstrcat(strTitre, "")
        .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_USENEWUI
    End With

    lpIDList = SHBrowseForFolder(tBrowseInfo)

    If (lpIDList) Then
        strBuffer = String$(260, vbNullChar)
        SHGetPathFromIDList lpIDList, strBuffer
        SelectFolder = Left$(strBuffer, InStr(strBuffer, vbNullChar) - 1)
    End If

End Function

Public Function ChoixCouleur(lg_hwnd As Long) As Long

    On Error Resume Next

    Dim cc      As ChooseColor

    Dim lReturn As Long

    ReDim CustomColors(0 To 16 * 4 - 1) As Byte

    Dim I As Integer, Bas As Long, Haut As Long

    Bas = LBound(CustomColors): Haut = UBound(CustomColors)

    For I = Bas To Haut
        CustomColors(I) = 0
    Next

    cc.lStructSize = Len(cc)
    cc.hWndOwner = lg_hwnd
    cc.hInstance = 0
    cc.lpCustColors = StrConv(CustomColors, vbUnicode)
    cc.flags = 0
    lReturn = ChooseColorAPI(cc)

    If lReturn <> 0 Then
        ChoixCouleur = cc.rgbResult
        CustomColors = StrConv(cc.lpCustColors, vbFromUnicode)
    Else
        ChoixCouleur = -1
    End If

End Function

Public Function OpenFile(lgHwnd As Long, stFiltre As String, FiltreParDefaut As Long, Optional lgFlags As esFlags = OFN_EXPLORER + OFN_LONGNAMES + OFN_PATHMUSTEXIST, Optional stTitre As String = vbNullString, Optional stInitFile As String = vbNullString, Optional stInitDir As String = vbNullString, Optional stDefautExt As String = vbNullString) As String

    On Error Resume Next

    ' Fenêtre "Ouvrir un fichier".
    Dim tyDialog As OPENFILENAME

    tyDialog.lStructSize = Len(tyDialog)
    tyDialog.hWndOwner = lgHwnd ' Handle du propriétraire de la fenêtre.
    tyDialog.hInstance = App.hInstance
    tyDialog.lpstrFilter = Replace(stFiltre, "|", vbNullChar) & vbNullChar & vbNullChar
    tyDialog.lpstrCustomFilter = vbNullString ' Filtre personnalisé (non géré).
    tyDialog.nMaxCustFilter = 0 ' Index de filtre personnalisé (non géré).
    tyDialog.nFilterIndex = FiltreParDefaut  ' Index du filtre à utiliser par défaut.
    tyDialog.lpstrFile = Left$(stInitFile & String$(1024, vbNullChar), 1024) ' Nom de fichier affiché à l'initialisation de la fenêtre.
    tyDialog.nMaxFile = Len(tyDialog.lpstrFile) - 1 ' Longueur du nom de fichier.
    tyDialog.lpstrFileTitle = tyDialog.lpstrFile ' Nom et extension du fichier (sans chemin).
    tyDialog.nMaxFileTitle = tyDialog.nMaxFile ' Taille de la chaîne précédente.
    tyDialog.lpstrInitialDir = stInitDir ' Répertoire initial.
    tyDialog.lpstrTitle = stTitre ' Titre de la fenêtre.
    tyDialog.flags = lgFlags ' Flags pour affichage de la fenêtre.
    'tyDialog.nFileOffset ' Position du nom du fichier dans la chaîne.
    'tyDialog.nFileExtension ' Position de l'extension du fichier dans la chaîne.
    ' Extension par défaut ajoutée automatiquement si l'utilisateur l'oublie.
    tyDialog.lpstrDefExt = stDefautExt
    tyDialog.lCustData = 0
    tyDialog.lpfnHook = 0
    tyDialog.lpTemplateName = 0
    ' Affichage de la boîte de dialogue.
    GetOpenFileName tyDialog
    ' Retourne le nom long du fichier.
    'lgLastIdxFilter = tyDialog.nFilterIndex
    OpenFile = Left$(tyDialog.lpstrFile, InStr(1, tyDialog.lpstrFile, vbNullChar) - 1)
End Function

'Retourne l'adresse d'un dossier : le dossier windows, le dossier mes documents et le dossier Bureau. Utilise SHGetSpecialFolderLocation
Public Function GiveMePathOf(FolderToFind As Long) As String

    On Error Resume Next

    Dim lRet As Long, IDL As ITEMIDLIST, sPath As String

    IDL.mkid.abID = 0: IDL.mkid.CB = 0
    lRet = SHGetSpecialFolderLocation(100&, FolderToFind, IDL)

    If lRet = 0 Then
        sPath = String$(512, Chr$(0))
        lRet = SHGetPathFromIDList(ByVal IDL.mkid.CB, ByVal sPath)
        GiveMePathOf = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
    Else
        GiveMePathOf = "C:\"
    End If

End Function

'Renvoie le minimum entre deux nombres...
Public Function Min(nb1 As Long, nb2 As Long) As Long

    On Error Resume Next

    If nb1 < nb2 Then
        Min = nb1
    Else
        Min = nb2
    End If

End Function

'Renvoie le maximum entre deux nombres...
Public Function Max(nb1 As Long, nb2 As Long) As Long

    On Error Resume Next

    If nb1 > nb2 Then
        Max = nb1
    Else
        Max = nb2
    End If

End Function

'Renvoie une chaine inconnue placée entre deux chaines connues. Principalement utilisée pour les fichiers LRC [by: et [ti:
Public Function MyMid(ByRef Expression As String, sLeft As String, sRight As String, Optional Start As Long = 1) As String

    On Error Resume Next

    Dim lPosL As Long, lPosR As Long

    lPosL = InStr(Start, Expression, sLeft): lPosR = InStr(lPosL + 1, Expression, sRight)

    If lPosL > 0 And lPosR > 0 Then
        MyMid = Mid$(Expression, lPosL + Len(sLeft), lPosR - lPosL - Len(sLeft))
    Else
        MyMid = vbNullString
    End If

End Function

Public Function IsLink(X As Single, Y As Single, RtfBox As RichTextBox) As ResultConstant
On Error Resume Next
    If RtfBox.Text = "" Then Exit Function
    Dim pt As POINTAPI
    Dim PosStart As Long, I As Long, Start As Long, Mot As String, Fin As Long, A As Long
    pt.X = X \ Screen.TwipsPerPixelX
    pt.Y = Y \ Screen.TwipsPerPixelY
    PosStart = SendMessage(RtfBox.hwnd, &HD7, 0&, pt)
    I = PosStart
    A = 0
    Do
        Select Case Mid(" " & RtfBox.Text, I, 1)
            Case " ", Chr(9), Chr(10), Chr(13)
                Start = I: Exit Do
        End Select
        I = I - 1
        A = A + 1
        If A = 100 Then Exit Do
    Loop
    I = PosStart
    A = 0
    Do
        If I = Len(RtfBox.Text) Then Fin = I + 1: Exit Do
        Select Case Mid(" " & RtfBox.Text, I, 1)
            Case " ", Chr(9), Chr(10), Chr(13)
                Fin = I: Exit Do
        End Select
        I = I + 1
        A = A + 1
        If A = 100 Then Exit Do
    Loop
    Mot = Mid(RtfBox.Text, Start, Fin - Start)
    IsLink.URL = vbNullString
    If UCase(Mot) Like "*HTTP://*" Or UCase(Mot) Like "*WWW.*" Then IsLink.EstUnLiens = True: IsLink.URL = Mot: Exit Function
    If UCase(Mot) Like "*MAILTO:*" Then IsLink.EstUnLiens = True: IsLink.Email = True: IsLink.URL = Right(Mot, Len(Mot) - 7): Exit Function
    If UCase(Mot) Like "*@*" Then IsLink.EstUnLiens = True: IsLink.Email = True: IsLink.URL = Mot
End Function

 

Subclassing

Le module Subclassing, comme son nom l'indique, gère tout ce qui concerne le sous classement de l'application (et les graphiques donc).

Code source : Subclassing.bas
  • Langage : vb
  • ΔT : 0.158s
  • Taille :4632 caractères
Attribute VB_Name = "Subclasser"
'--------------------------------------------------------------------------------
'    Component  : Subclasser
'    Project    : TXT2JPG
'
'    Description: Une petite sub qui s'occupe "simplement" de récupérer tout les messages envoyés par Windows à l'application, et en particulier les resize
'
'    Modified   :
'--------------------------------------------------------------------------------
Option Explicit

Public OldWindowProc As Long

Public myHDC As Long

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Declare Function GetProp Lib "user32.dll" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Private Declare Function SetProp Lib "user32.dll" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Public Const GWL_WNDPROC = (-4)

Private Const WM_GETMINMAXINFO As Long = &H24

Const WM_NCDESTROY = &H82

Const WM_SIZE = 5

Private Type POINTAPI

    X As Long
    Y As Long

End Type

Private Type MINMAXINFO

    ptReserved As POINTAPI
    ptMaxSize As POINTAPI
    ptMaxPosition As POINTAPI
    ptMinTrackSize As POINTAPI
    ptMaxTrackSize As POINTAPI

End Type

Public Sub SetFormMinMaxSize(Form As Form, Optional MinWidth As Long = -1, Optional MaxWidth As Long = -1, Optional MinHeight As Long = -1, Optional MaxHeight As Long = -1)

    'Cette sub permet de spécifier à Windows une taille minimale pour l'application, au delà de laquelle est ne peut plus être réduite
    Dim Provided As Long

    On Error Resume Next

    '# On mémorise les dimensions, et on met a jour la liste des dimensions figées
    If MinWidth <> -1 Then
        Provided = Provided Or 1
        '# On prend en compte le Scalemode de la form
        SetProp Form.hwnd, "MINWIDTH", Form.ScaleX(MinWidth, Form.ScaleMode, vbPixels)
    End If

    If MaxWidth <> -1 Then
        Provided = Provided Or 2
        SetProp Form.hwnd, "MAXWIDTH", Form.ScaleX(MaxWidth, Form.ScaleMode, vbPixels)
    End If

    If MinHeight <> -1 Then
        Provided = Provided Or 4
        SetProp Form.hwnd, "MINHEIGHT", Form.ScaleY(MinHeight, Form.ScaleMode, vbPixels)
    End If

    If MaxHeight <> -1 Then
        Provided = Provided Or 8
        SetProp Form.hwnd, "MAXHEIGHT", Form.ScaleY(MaxHeight, Form.ScaleMode, vbPixels)
    End If

    SetProp Form.hwnd, "MINMAX", Provided
End Sub

' Display message names.
Public Function NewWindowProc(ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    On Error Resume Next

    Dim MinMax   As MINMAXINFO

    Dim Provided As Long

    'Debug.Print Hex$(msg)
    Select Case msg

        Case WM_SIZE 'La feuille a été redimensionnée
            Principale.Form_TailleChange
            Principale.Form_Redraw

        Case WM_GETMINMAXINFO
            '# Liste des dimensions figées
            Provided = GetProp(hwnd, "MINMAX")
            '# On recupere les infos deja presentes
            CopyMemory MinMax, ByVal lParam, Len(MinMax)

            '# On met a jour les dimensions
            If (Provided And 1) <> 0 Then
                MinMax.ptMinTrackSize.X = GetProp(hwnd, "MINWIDTH")
            End If

            If (Provided And 2) <> 0 Then
                MinMax.ptMaxTrackSize.X = GetProp(hwnd, "MAXWIDTH")
            End If

            If (Provided And 4) <> 0 Then
                MinMax.ptMinTrackSize.Y = GetProp(hwnd, "MINHEIGHT")
            End If

            If (Provided And 8) <> 0 Then
                MinMax.ptMaxTrackSize.Y = GetProp(hwnd, "MAXHEIGHT")
            End If

            '# On réinsère le tout...
            CopyMemory ByVal lParam, MinMax, Len(MinMax)
            '# On ne repasse pas par la procédure classique...
            NewWindowProc = 0&

            Exit Function

        Case WM_NCDESTROY   'Rétablir la bonne sub de classe :
            SetWindowLong hwnd, GWL_WNDPROC, OldWindowProc
    End Select

    'Transférer le message
    NewWindowProc = CallWindowProc(OldWindowProc, hwnd, msg, wParam, lParam)
End Function
 

Les contrôles :

Bouton

Les boutons "Vista Like".

Code source : AfBtn.ctl
  • Langage : vb
  • ΔT : 0.320s
  • Taille :8247 caractères
VERSION 5.00
Begin VB.UserControl Bouton
   ClientHeight    =   2535
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4365
   MaskColor       =   &H00C0C0C0&
   ScaleHeight     =   2535
   ScaleWidth      =   4365
   ToolboxBitmap   =   "AfBtn.ctx":0000
   Begin VB.Timer Tmr_OO
      Enabled         =   0   'False
      Interval        =   100
      Left            =   2205
      Top             =   735
   End
   Begin VB.Image IMG_mouse
      Height          =   1065
      Left            =   1575
      Picture         =   "AfBtn.ctx":0312
      Stretch         =   -1  'True
      Top             =   1155
      Width           =   2325
   End
   Begin VB.Image IMG_nomouse
      Height          =   1065
      Left            =   105
      Picture         =   "AfBtn.ctx":2484
      Stretch         =   -1  'True
      Top             =   1155
      Width           =   2310
   End
   Begin VB.Label Lbl_Btn
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "Btn XP"
      BeginProperty Font
         Name            =   "Tahoma"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   375
      Left            =   0
      TabIndex        =   0
      Top             =   240
      Width           =   2655
   End
   Begin VB.Image Img_Btn
      Height          =   1170
      Left            =   0
      Stretch         =   -1  'True
      Top             =   0
      Width           =   2640
   End
End
Attribute VB_Name = "Bouton"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'--------------------------------------------------------------------------------
'    Component  : Bouton
'    Project    : TXT2JPG
'
'    Description: Un bouton "a la vista", qui gère mouse over et mouseout
'
'    Modified   :
'--------------------------------------------------------------------------------
Option Explicit

Private Type POINTAPI
    x       As Long
    y       As Long
End Type

'
Private mEnabled As Boolean

Private mTaille  As Long

Dim bDown        As Boolean

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long

Public Event Click()
Attribute Click.VB_MemberFlags = "200"

Public Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

Public Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

Public Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

Public Property Get Caption() As String
Attribute Caption.VB_UserMemId = -518
Attribute Caption.VB_MemberFlags = "200"

    On Error Resume Next

    Caption = Lbl_Btn.Caption
End Property

Public Property Let Caption(ByVal new_mCaption As String)

    On Error Resume Next

    Lbl_Btn.Caption = new_mCaption
    PropertyChanged "Caption"
End Property

Public Property Get Taille() As Long

    On Error Resume Next

    Taille = Lbl_Btn.FontSize
End Property

Public Property Let Taille(ByVal New_Size As Long)

    On Error Resume Next

    Lbl_Btn.FontSize = New_Size
    mTaille = New_Size
    PropertyChanged "Taille"
End Property

Public Property Get hwnd() As Long

    On Error Resume Next

    hwnd = UserControl.hwnd
End Property

Public Property Get hdc() As Long

    On Error Resume Next

    hdc = UserControl.hdc
End Property

Public Property Get Enabled() As Boolean

    On Error Resume Next

    Enabled = mEnabled
End Property

Public Property Let Enabled(ByVal new_mEnabled As Boolean)

    On Error Resume Next

    mEnabled = new_mEnabled

    If mEnabled Then
        Lbl_Btn.ForeColor = vbBlack
    Else
        Lbl_Btn.ForeColor = &HC0C0C0
    End If
    PropertyChanged "Enabled"
End Property

Public Property Let TimerState(ByVal nValue As Boolean)

    On Error Resume Next

    Tmr_OO.Enabled = nValue
    PropertyChanged "TimerState"
End Property

Private Sub UserControl_InitProperties()

    On Error Resume Next

    Caption = Lbl_Btn.Caption
    Taille = Lbl_Btn.FontSize
    mEnabled = True
End Sub

'
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    On Error Resume Next

    Caption = PropBag.ReadProperty("Caption", Lbl_Btn.Caption)
    Enabled = PropBag.ReadProperty("Enabled", True)
    Taille = PropBag.ReadProperty("Taille", Lbl_Btn.FontSize)

    If UserControl.Ambient.UserMode Then Tmr_OO.Enabled = True
End Sub

'
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    On Error Resume Next

    PropBag.WriteProperty "Caption", Lbl_Btn.Caption, "Btn XP"
    PropBag.WriteProperty "Enabled", mEnabled, True
    PropBag.WriteProperty "Taille", mTaille, Lbl_Btn.FontSize
End Sub

'
'
'   *- INIT/RESIZE/TERMINATE -*
Private Sub UserControl_Initialize()

    On Error Resume Next

    Lbl_Btn.BackStyle = 0
    Img_Btn.Picture = IMG_nomouse.Picture
    Lbl_Btn.FontSize = Me.Taille
    Me.TimerState = False
End Sub

'
Private Sub UserControl_Resize()

    On Error Resume Next

    'If UserControl.Width < 300 Then UserControl.Width = 300
    'If UserControl.Height < 200 Then UserControl.Height = 200
    Img_Btn.Width = UserControl.Width
    Img_Btn.Height = UserControl.Height
    Lbl_Btn.Width = UserControl.Width
    Lbl_Btn.Top = (UserControl.Height \ 2) - (Lbl_Btn.Height \ 2) + 30

    If UserControl.Ambient.UserMode Then Me.TimerState = True
End Sub

'
Private Sub UserControl_Terminate()

    On Error Resume Next

    Tmr_OO.Enabled = False
End Sub

'
'
'   *- EVENTS -*
'CLICK :
Private Sub Img_Btn_Click()

    On Error Resume Next

    If mEnabled Then RaiseEvent Click
End Sub

Private Sub Lbl_Btn_Click()

    On Error Resume Next

    If mEnabled Then RaiseEvent Click
End Sub

'MouseDown
Private Sub Img_Btn_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

    On Error Resume Next

    If mEnabled Then bDown = True: RaiseEvent MouseDown(Button, Shift, x, y)
End Sub

Private Sub Lbl_Btn_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

    On Error Resume Next

    If mEnabled Then bDown = True: RaiseEvent MouseDown(Button, Shift, x, y)
End Sub

'Mouse Up
Private Sub Img_Btn_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

    On Error Resume Next

    If mEnabled Then bDown = False: RaiseEvent MouseUp(Button, Shift, x, y)
End Sub

Private Sub Lbl_Btn_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

    On Error Resume Next

    If mEnabled Then bDown = False: RaiseEvent MouseUp(Button, Shift, x, y)
End Sub

'MOUSEMOVE
Private Sub Img_Btn_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

    On Error Resume Next

    Tmr_OO.Enabled = True
    RaiseEvent MouseMove(Button, Shift, x, y)
End Sub

Private Sub Lbl_Btn_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

    On Error Resume Next

    Tmr_OO.Enabled = True
    RaiseEvent MouseMove(Button, Shift, x, y)
End Sub

'Hover
Private Sub Tmr_OO_Timer()

    On Error Resume Next

    If mEnabled Then

        Dim pPos As POINTAPI, lHwnd As Long

        pPos.x = 0: pPos.y = 0
        Call GetCursorPos(pPos)
        lHwnd = WindowFromPoint(pPos.x, pPos.y)

        If lHwnd = UserControl.hwnd Then
            Img_Btn.Picture = IMG_mouse.Picture
            Lbl_Btn.ForeColor = IIf(bDown, vbBlue, vbRed)
        Else
            Img_Btn.Picture = IMG_nomouse.Picture
            Lbl_Btn.ForeColor = vbBlack
            Tmr_OO.Enabled = False
        End If
    End If

End Sub
 

Case à cocher

Les check box relookées.

Code source : CheckBoxPlus.ctl
  • Langage : vb
  • ΔT : 0.162s
  • Taille :6746 caractères
VERSION 5.00
Begin VB.UserControl CheckBoxPlus
   BackColor       =   &H80000008&
   ClientHeight    =   495
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1185
   ForeColor       =   &H8000000B&
   ScaleHeight     =   495
   ScaleWidth      =   1185
   Begin VB.Timer Tmr_OO
      Enabled         =   0   'False
      Interval        =   100
      Left            =   1155
      Top             =   420
   End
   Begin VB.Image CheckData
      Height          =   195
      Index           =   4
      Left            =   945
      Picture         =   "CheckBoxPlus.ctx":0000
      Top             =   0
      Width           =   195
   End
   Begin VB.Image CheckData
      Height          =   195
      Index           =   6
      Left            =   630
      Picture         =   "CheckBoxPlus.ctx":024A
      Top             =   0
      Width           =   195
   End
   Begin VB.Image CheckData
      Height          =   195
      Index           =   3
      Left            =   945
      Picture         =   "CheckBoxPlus.ctx":0494
      Top             =   315
      Width           =   195
   End
   Begin VB.Image CheckData
      Height          =   195
      Index           =   2
      Left            =   630
      Picture         =   "CheckBoxPlus.ctx":06DE
      Top             =   315
      Width           =   195
   End
   Begin VB.Image CheckData
      Height          =   195
      Index           =   1
      Left            =   315
      Picture         =   "CheckBoxPlus.ctx":0928
      Top             =   315
      Width           =   195
   End
   Begin VB.Image CheckData
      Height          =   195
      Index           =   0
      Left            =   0
      Picture         =   "CheckBoxPlus.ctx":0B72
      Top             =   315
      Width           =   195
   End
   Begin VB.Image Check
      Height          =   195
      Left            =   0
      Top             =   0
      Width           =   195
   End
End
Attribute VB_Name = "CheckBoxPlus"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'--------------------------------------------------------------------------------
'    Component  : CheckBoxPlus
'    Project    : TXT2JPG
'
'    Description: Un chackbox avec moins do'ptions que l'original, mais des graphismes différents. Un bon compromis pour économiser du poids au projet.
'
'    Modified   :
'--------------------------------------------------------------------------------
Option Explicit

Private Type POINTAPI

    X       As Long
    Y       As Long

End Type

'
Private mEnabled As Boolean

Private mValue   As Boolean

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long

Public Event Click()

Public Event MouseDown(Button As Integer, Shift As Integer)

Public Event MouseUp(Button As Integer, Shift As Integer)

Public Event MouseMove(Button As Integer, Shift As Integer)

Public Sub Redraw_Me(Optional Hilite As Boolean = False)

    'Si la souris est dessus :
    On Error Resume Next

    Dim pPos As POINTAPI, Hover As Boolean

    pPos.X = 0: pPos.Y = 0
    Hover = False

    If UserControl.Ambient.UserMode Then
        Call GetCursorPos(pPos)

        If WindowFromPoint(pPos.X, pPos.Y) = UserControl.hwnd Or Hilite Then
            Hover = True
        Else
            Tmr_OO.Enabled = False
        End If
    End If

    If Not (mEnabled) Then Hover = False
    Check.Picture = CheckData(4 * (Abs(Not (mEnabled))) + Abs(Hover) + 2 * Abs(mValue)).Picture
End Sub

'Propriétés :
Public Property Get hwnd() As Long

    On Error Resume Next

    hwnd = UserControl.hwnd
End Property

Public Property Get hdc() As Long

    On Error Resume Next

    hdc = UserControl.hdc
End Property

Public Property Let Value(ByVal mValeur As Boolean)

    On Error Resume Next

    mValue = mValeur
    Redraw_Me
    RaiseEvent Click
    PropertyChanged "Value"
End Property

Public Property Get Value() As Boolean

    On Error Resume Next

    Value = Abs(mValue)
End Property

Public Property Get Enabled() As Boolean

    On Error Resume Next

    Enabled = mEnabled
End Property

Public Property Let Enabled(ByVal mActif As Boolean)

    On Error Resume Next

    mEnabled = mActif
    Redraw_Me
End Property

'
'
'   *- PROPBAG -*
Private Sub UserControl_InitProperties()

    On Error Resume Next

    mValue = False
    mEnabled = True
End Sub

'
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    On Error Resume Next

    Value = PropBag.ReadProperty("Value", mValue)
    Enabled = PropBag.ReadProperty("Enabled", mEnabled)
    'If UserControl.Ambient.UserMode Then Tmr_OO.Enabled = True
End Sub

'
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    On Error Resume Next

    PropBag.WriteProperty "Value", mValue, False
    PropBag.WriteProperty "Enabled", mEnabled, True
End Sub

'
'
'   *- INIT/RESIZE/TERMINATE -*
Private Sub UserControl_Initialize()

    On Error Resume Next

    'CheckLabel.BackStyle = 0
    Check.Picture = CheckData(0).Picture
    mValue = False
    mEnabled = True
End Sub

'
Private Sub UserControl_Resize()

    On Error Resume Next

    If UserControl.Width <> 195 Then UserControl.Width = 195
    If UserControl.Height <> 195 Then UserControl.Height = 195
    'If UserControl.Ambient.UserMode Then Tmr_OO.Enabled = True Else Tmr_OO.Enabled = False
End Sub

'
Private Sub UserControl_Terminate()

    On Error Resume Next

    Tmr_OO.Enabled = False
End Sub

'
'
'   *- EVENTS -*
Private Sub Check_Click()

    On Error Resume Next

    If mEnabled Then
        mValue = IIf(mValue = False, True, False)
        Redraw_Me
        RaiseEvent Click
    End If

End Sub

Private Sub Check_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    On Error Resume Next

    RaiseEvent MouseDown(Button, Shift)
End Sub

Private Sub Check_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

    On Error Resume Next

    RaiseEvent MouseUp(Button, Shift)
End Sub

Private Sub Check_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    On Error Resume Next

    Tmr_OO.Enabled = True
    RaiseEvent MouseMove(Button, Shift)
End Sub

'
Private Sub Tmr_OO_Timer()

    On Error Resume Next

    Redraw_Me
End Sub
 

Infobulles

Les infobulles qui affichent l'aide contextuelle.

Code source : Tip.ctl
  • Langage : vb
  • ΔT : 0.175s
  • Taille :7217 caractères
VERSION 5.00
Begin VB.UserControl Tip
   BackColor       =   &H80000011&
   BackStyle       =   0  'Transparent
   ClientHeight    =   1665
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4905
   MaskColor       =   &H8000000E&
   MaskPicture     =   "Tip.ctx":0000
   ScaleHeight     =   111
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   327
   Begin VB.TextBox TitreEdit
      Height          =   285
      Left            =   630
      TabIndex        =   4
      Top             =   420
      Visible         =   0   'False
      Width           =   3900
   End
   Begin VB.TextBox TexteEdit
      Height          =   645
      Left            =   105
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   3
      Top             =   735
      Visible         =   0   'False
      Width           =   4740
   End
   Begin VB.Label Editer
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "Edit..."
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00800000&
      Height          =   225
      Left            =   105
      MousePointer    =   10  'Up Arrow
      TabIndex        =   2
      ToolTipText     =   "Edit this tooltip in good English"
      Top             =   1365
      Width           =   4740
   End
   Begin VB.Image CCancel
      Height          =   240
      Left            =   4515
      Picture         =   "Tip.ctx":1B29A
      Top             =   420
      Width           =   240
   End
   Begin VB.Image CCancelHL
      Height          =   240
      Left            =   4515
      Picture         =   "Tip.ctx":1B5DC
      Top             =   420
      Visible         =   0   'False
      Width           =   240
   End
   Begin VB.Label CTitre
      BackStyle       =   0  'Transparent
      Caption         =   "Titre"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   225
      Left            =   630
      TabIndex        =   1
      Top             =   420
      Width           =   3900
   End
   Begin VB.Label CCaption
      BackStyle       =   0  'Transparent
      Height          =   885
      Left            =   105
      TabIndex        =   0
      Top             =   705
      Width           =   4740
   End
End
Attribute VB_Name = "Tip"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'--------------------------------------------------------------------------------
'    Component  : Tip
'    Project    : TXT2JPG
'
'    Description: Permet d'afficher une infobulle transparente à un emplacement donnée. Entièrement géré par la sub AfficherTip de Principale
'
'    Modified   :
'--------------------------------------------------------------------------------
Option Explicit

Private mText  As String

Private mTitre As String

Public Event Fermer()

Public Property Get hwnd() As Long

    On Error Resume Next

    hwnd = UserControl.hwnd
End Property
Public Property Get Text() As String:    Text = mText: End Property

Public Property Get Titre() As String:    Titre = mTitre: End Property

Public Property Let Edit(ByVal mValeur As Boolean)

    On Error Resume Next
    Editer.Visible = mValeur
End Property
Public Property Let Text(ByVal mValeur As String)

    On Error Resume Next

    mText = mValeur
    CCaption.Caption = mText
    PropertyChanged "Text"
End Property

Public Property Let Titre(ByVal mValeur As String)

    On Error Resume Next

    mTitre = mValeur
    CTitre.Caption = mTitre
    PropertyChanged "Titre"
End Property

Private Sub CCancel_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    On Error Resume Next

    CCancel.Visible = False
    CCancelHL.Visible = True
End Sub

Private Sub CCancelHL_Click()

    On Error Resume Next

    RaiseEvent Fermer
    CCancel.Visible = True
    CCancelHL.Visible = False
End Sub


Private Sub Editer_Click()
    If Editer.Caption = "Edit..." Then
        TitreEdit.Tag = CTitre.Caption
        TitreEdit.Text = CTitre.Caption
        TexteEdit.Text = CCaption.Caption
        TitreEdit.Visible = True: TexteEdit.Visible = True
        Editer.Caption = "Update ToolTip now !"
    Else
        Principale.Download "http://neamar.free.fr/mailer.php?action=EditBallon&OTitre=" & TitreEdit.Tag & "&NTitre=" & TitreEdit.Text & "&NCap=" & TexteEdit.Text & "&auteur=" & GetSetting("TXT2JPG", "Data", "Nom", "Anonyme")
        TitreEdit.Visible = False
        TexteEdit.Visible = False
        CTitre.Caption = "Send."
        Editer.Caption = "Edit..."
        CCaption.Caption = "Thank you for your submission. It will be examined and included in the next version of TXT2JPG."
    End If
End Sub

Private Sub TexteEdit_KeyPress(KeyAscii As Integer)
    If KeyAscii = 38 Then KeyAscii = 0
End Sub

Private Sub TexteEdit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If CCancel.Visible = False Then
        CCancel.Visible = True
        CCancelHL.Visible = False
    End If
End Sub


Private Sub TitreEdit_KeyPress(KeyAscii As Integer)
    If KeyAscii = 38 Then KeyAscii = 0
End Sub
Private Sub TitreEdit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If CCancel.Visible = False Then
        CCancel.Visible = True
        CCancelHL.Visible = False
    End If
End Sub


Private Sub UserControl_Initialize()

    On Error Resume Next

    UserControl.MaskColor = vbWhite
    UserControl.Picture = UserControl.MaskPicture
    mText = "InfoTip Express"
    mTitre = "CTitre"
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    On Error Resume Next

    If CCancel.Visible = False Then
        CCancel.Visible = True
        CCancelHL.Visible = False
    End If

End Sub

Private Sub UserControl_Resize()

    On Error Resume Next

    UserControl.Width = 327 * 15
    UserControl.Height = 111 * 15
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    On Error Resume Next

    Text = PropBag.ReadProperty("Text", mText)
    Titre = PropBag.ReadProperty("Titre", mTitre)
End Sub

'
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    On Error Resume Next

    PropBag.WriteProperty "Text", mText, False
    PropBag.WriteProperty "Titre", mTitre, True
End Sub
 

Fichiers de langues :

Les textes d'accueil des deux langages sont stockés dans le dossier Lang du Zip.

Francais

Un fichier ini standard...

Code source : Francais.lng
  • Langage : ini
  • ΔT : 0.513s
  • Taille :21988 caractères
; Fichier au format .ini, un ; indique un commentaire
; Le fichier se répartit en trois sections : [FormData], [Strings] et [Message]
; [FormData] => L'emplacement ou le programme va chercher les informations des contrôles au démarrage. Il est possible de rajouter des lignes, elles seront prises en compte si le contrôle gère la propriété (exemple : rajouter un tooltiptext est possible pour tout les contrôles, rajouter un CueBanner est impossible pour un label.)
; [Strings] => Tous les strings dont le programme va avoir besoin lors de son exécution. Taille Max : 512 caractères.
; [Message] =>Tout les petits messages qui s'affichent sous forme d'info bulles.
;
;
; Vous pouvez créer une nouvelle langue simplement en ajoutant un fichier <nom de la langue>.ini dans le répertoire Lang de l'application. Il sera automatiquement détecté au démarrage.
; Dans ce cas là, n'hésitez pas à en faire profiter les autres : joignez le-moi par mail à neamart@yahoo.fr, et je l'inclurais dans la prochaine version. Merci !

;{FRANCAIS}, crée par NEAMAR -16/DEC/07

[FormData]
; Cette section contient les informations "en dur" : ce sont les valeurs par défaut des contrôles.

; Les contrôles étiquette sont tout les labels de type générique, ils sons souvent associés à des option buttons.
etiquette|0|Caption=Fichier d'origine / URL :
etiquette|1|Caption=Nom du répertoire :
etiquette|2|Caption=Fermeture de l'application
etiquette|3|Caption=Taille
etiquette|4|Caption=Enregistrer sous :
etiquette|5|Caption=Utiliser une image d'arrière plan
etiquette|6|Caption=Redimensionner l'image...
etiquette|6|Caption=Numériser 'à la volée'
etiquette|7|Caption=Numériser à la volée.
etiquette|7|ToolTipText=Numérisation plus rapide, mais moins jolie.
etiquette|8|Caption=Hauteur :
etiquette|9|Caption=Largeur :
etiquette|10|Caption=Sauver en JPG
etiquette|10|ToolTipText=Encoder en JPG (plus long, mais à utiliser si votre firmware ne convertit pas automatiquement).
etiquette|11|Caption=Qualité : 80%
etiquette|12|Caption=Couverture uniquement
etiquette|12|ToolTipText=N'utiliser cette image que pour la première diapositive : il s'agira d'une couverture, et pas d'une image de fond.
etiquette|13|Caption=Marge Gauche :000px
etiquette|14|Caption=Marge Droite :000px
etiquette|15|Caption=Chargement
etiquette|16|Caption=Passez la souris sur un module...
etiquette|17|Caption=Fond rouge
etiquette|18|Caption=Fond vert
etiquette|19|Caption=Fond bleu
etiquette|20|Caption=Sens.
etiquette|21|Caption=Nom sur le réseau :
etiquette|22|Caption=Utiliser ClearType
etiquette|22|ToolTipText=Cette option ne fonctionne pas si vous définissez une image d'arrière plan
etiquette|23|Caption=Répertoire par défaut :
etiquette|24|Caption=Slide des menus
etiquette|24|ToolTipText=Marque une rapide transition lors du changement entre les menus. Peut être désactivée si votre ordinateur est vieux, ou si vous souhaitez gagner en rapidité d'utilisation.
etiquette|25|Caption=Priorité :
etiquette|25|ToolTipText=Définit la priorité du processus (vitesse d'encodage)
etiquette|26|Caption=Marge du bas :000px
etiquette|27|Caption=Marge du haut :000px
etiquette|28|Caption=Utiliser les marge haut et bas
etiquette|29|Caption=Numéroter page
etiquette|30|Caption=Sélectionnez du texte, puis effectuez des dégradés de taille à partir des barres à gauche. ATTENTION : il est déconseillé de sélectionner plus d'une trentaine de caractères...
etiquette|31|Caption=Sélectionnez la couleur à utiliser pour le premier caractère de la sélection, la couleur du dernier, puis appuyez sur Appliquer...
etiquette|32|Caption=Votre texte contient des images ! Que souhaitez-vous en faire ?
etiquette|33|Caption=Ne rien changer (aucun redimensionnement, les images dont la taille est supérieure à l'écran seront coupées)
etiquette|34|Caption=Redimensionner les images dont la taille est supérieure à la taille de l'écran, sur la largeur uniquement.
etiquette|35|Caption=Redimensionner sur hauteur ET largeur.
etiquette|36|Caption=Adapter les couleurs au BG.
etiquette|36|ToolTipText=Change le contraste de l'affichage pour améliorer la lisibilité. BETA !
etiquette|37|Caption=Langue
etiquette|37|ToolTipText=Choix d'une langue
etiquette|38|Caption=Séparer les chapitres
etiquette|38|ToolTipText=Marquez un mot. A chaque fois que le programme rencontrera ce mot, le dossier de destination changera automatiquement
etiquette|39|Caption=Placer une copie du fichier dans le répertoire de sortie
etiquette|39|ToolTipText=Placer une copie du fichier utilisé lors de la numérisation dans le répertoire où sont stockées les images
etiquette|40|Caption=Rechercher :
etiquette|41|Caption=Remplacer par :

; Les contrôles PlugChoice sont les titres des onglets, qui apparaissent à droite du texte, dans la première colonne, au dessus du bouton démarrer. Le #4 n'apparait que lorsque #1 est activé.
PlugChoice|0|Caption=Options de dossier
PlugChoice|1|Caption=Mise en Forme
PlugChoice|2|Caption=Marges / Options avancées
PlugChoice|3|Caption=Options du programme
PlugChoice|4|Caption=Modules
PlugChoice|5|Caption=Mise en forme (avancé)

; Les options de Mise en forme proposées sont les suivantes :
Couleur|0|ToolTipText=Couleur du texte sélectionné
Couleur|1|ToolTipText=Couleur de surlignement
Couleur|2|ToolTipText=Couleur de fond
MEF|0|ToolTipText=En gras
MEF|1|ToolTipText=En italique
MEF|2|ToolTipText=Souligné
MEF|3|ToolTipText=Barré
MEF|4|ToolTipText=Puces
CharMap|0|ToolTipText=Liste des caractères spéciaux
Alignement|0|ToolTipText=Alignement
Polices|0|Text=MS Sans Serif

;Les modules proposés ou plutôt leurs descriptions:
Modules|0|ToolTipText=Permet de convertir un fichier diaporama PowerPoint en images JPG.
Modules|1|ToolTipText=Crée des dégradés à mettre en fond d'écran de votre baladeur. Vous pouvez aussi vous servir des images comme fond de numérisation pour TXT2JPG
Modules|2|ToolTipText=Convertir un fichier GIF au format AVI.
Modules|3|ToolTipText=Le projet Gutenberg offre plusieurs milliers de livres libres de droit, dont quelques centaines en français. Ils sont téléchargeables au format texte, html ou doc.
Modules|4|ToolTipText=Du même auteur :-) : L'éphéméride est un projet de base de données de blagues. Il contient plus de 1000 blagues, et plus de 500 images drôles.
Modules|5|ToolTipText=En préparation?Ce sera la surprise !
ModulesWhat|0|Caption=Modules
ModulesWhat|1|Caption=A propos
WhatAbout|0|Text=Chargement des données...

; Les menus de clic droit (quand clic que le textbox ou sur alignement)
Edition|0|Caption=Annuler
Edition|1|Caption=-
Edition|2|Caption=Remplacer
Edition|3|Caption=Rechercher
Edition|4|Caption=-
Edition|5|Caption=Ajuster
Edition|6|Caption=Suppr. dbl saut de ligne
Edition|7|Caption=Police
Edition|8|Caption=-
Edition|9|Caption=Couper
Edition|10|Caption=Copier
Edition|11|Caption=Coller
Edition|12|Caption=RTF=>TXT
Edition|13|Caption=TXT=>RTF
Edition|14|Caption=-
Edition|15|Caption=Options par défaut
Edition|16|Caption=-
Edition|17|Caption=Barre horizontale
Edition|18|Caption=Alignement
Edition|19|Caption=Inverser la casse
Edition|20|Caption=Nouveau paragraphe
Edition|21|Caption=En exposant
Edition|22|Caption=En indice
Align|0|Caption=Aligné à gauche
Align|1|Caption=Aligné à droite
Align|2|Caption=Centré

; La barre d'outil rapport de bug : (apparait quand le programme s'est mal fermé, ou quand on clique sur Signaler un bug)
Bug_Texte|0|CueBanner=Un bug s'est produit ?! Pouvez-vous le décrire, afin d'améliorer les prochaines versions ?
Bug_Envoi|0|Caption=Envoyer
Bug_Rapport|0|Caption=Reporter un bug
Bug_Rapport|0|ToolTipText=Cliquez ici si vous avez rencontré un bug, ou si bous souhaitez proposer une amélioration au programme

; La barre d'outil Rechercher Remplacer (CTRL-F, CTRL-H dans le textbox) (voir aussi etiquette|40 et etiquette|41)
Rechercher_Suite|0|Caption=Prochaine occurrence
Rechercher_Close|0|ToolTipText=Fermer la barre de recherche

;A propos du baladeur
Hauteur|0|Text = 240
Largeur|0|Text = 320
Defaut|0|ToolTipText=Enregistrer ce baladeur comme mon baladeur par défaut
Swap|0|ToolTipText=Intervertir largeur et hauteur (affichage dans l'autre sens)
Modeles|0|Text=<Modele>
Marque|0|Text=<Marque du Baladeur>

; Options du programme
ChoosePic|0|Caption=Sélectionner une image de fond
Enregistrer|0|ToolTipText=Enregistrer comme nouveau nom
Enregistrer|1|ToolTipText=Enregistrer comme nouveau répertoire
Browse3|0|ToolTipText=Choix du dossier principal
Langue|0|ToolTipText=Langage :

;Boutons
Abandon|0|Caption=ANNULER ?
Annuler|0|Caption=Annuler
Start|0|Caption=Commencer
Start|0|ToolTipText=Lancer la numérisation !
AppliquImage|0|Caption=Appliquer
Appliquer|0|Caption=Appliquer

;Choix d'un fichier
Dest_Folder|0|CueBanner=Nom du dossier
Directory|0|Text=Directory
Browse|0|ToolTipText=Parcourir

;Divers et varié
VoirApercu|0|Caption=Voir un aperçu
KeyWord|0|CueBanner=Mot Clé
Root|0|CueBanner=Texte préfixe
UseTopAndBottomMargin|0|ToolTipText=Autoriser l'utilisation des marges haut et bas


[Strings]
; La liste des strings utilisés dans le programme.

String 1=Veuillez sélectionner le dossier dans lequel toutes les images seront crées.
String 2=Non, je ne suis pas buggé ! Je travaille !

; Tous les petits commentaires pendant la numérisation
String 3=Initialisation...
String 4=Copie du fichier... (Peut durer quelques minutes, ne pas bouger la souris)
String 5=Hachage du fichier (%u)
String 6=Partie n°
String 7=Redimensionnements des images...
String 8=La priorité est réglée à :
String 9=Une image d'arrière plan est utilisée (%u)
String 10=Aucune image d'arrière plan utilisée.
String 11=Nombre d'images (ESTIMATION) :
String 12=La durée de numérisation va dépendre de la taille du texte et des performances de votre ordinateur
String 13=Transposition texte vers bitmap..
String 14=Destruction des fichiers temporaires...
String 15=Conversion en JPG...
String 16=Finalisation, ouverture du dossier et fermeture de l?application ( %u images)
String 18=Recherche de MAJ.....

; Messages concernant la connexion Internet
String 19=Téléchargement des données en cours...
String 20=Impossible d'ouvrir une connexion Internet. Vous devrez entrer votre baladeur manuellement. Réglez les options de votre pare feu pour corriger le problème.

; Messages concernant l'ouverture d'un document Word/IE via la méthode automation,
String 21=Chargement du fichier en cours...
String 22=Fichier ouvert, récupération des données... environ une minute pour 75 pages...
String 23=ATTENTION : les images ralentissent énormément l'ensemble !
String 24=Fichier récupéré. Si rien ne se passe, faites un clic droit sur ce texte, et sélectionnez copier.
String 25=Automation ouvert...
String 26=Récupération de la page...
String 27=Page récupérée...
String 28=Parsing des données...
String 29=Cliquez sur oui lorsqu'une fenêtre vous demande l'accès au presse papier.
String 30=Automation fermé, conversion terminée ! Si rien ne se passe, appuyez sur ctrl + V.

; Concerne les fichiers PDF
String 31=La lecture de fichiers PDF n'est pas faisable par TXT2JPG. Cependant, vous pouvez utiliser un site internet pour convertir ce fichier en fichier RTF. Effectuer la conversion ?
String 32=La conversion va s'ouvrir sous Internet Explorer....
String 33=http://media-convert.fr

; Concerne les fichiers LRC :
String 34=Passage en Texte ...
String 35=Le fichier LRC ne contient pas le titre de la chanson dans ses balises. Veuillez l'entrez manuellement
String 36=Aucune balise [ti:] détectée
String 37=Fichier invalide. Tenter de l'ouvrir en mode texte ?

; Adresse par défaut lors du choix d'une URL à télécharger, mais aussi URL vers laquelle sera affichée la dernière version.
String 38=http://neamar.free.fr/txt2jpg/txt2jpg.php

String 47=....patience....
String 48=Ce type de fichier n'est pas pris en charge...
String 49=L'image à mettre en filigrane est supérieure à la taille de l'écran du lecteur. La redimensionner ?
String 50=Demande de confirmation !
String 52=Charger un fichier

; Ne pas changer les masques de fichiers...
String 53=Fichiers BMP, JPG(*.bmp,*.jpg)|*.bmp;*.jpg|Fichiers Bitmap Windows(*.bmp)|*.bmp|Fichiers JPEG (*.jpg)|*.jpg|Fichiers GIF (*.gif)|*.gif|
String 51=Fichier Texte, Texte mis en forme et Lyrics (*.txt,*.rtf,*.doc,*.lrc)|*.txt;*.rtf;*.doc;*.lrc;*.docx|Fichiers plain text (*.txt)|*.txt|Fichiers de texte mis en forme (*.rtf,*.doc,*.pdf)|*.rtf;*.doc;*.pdf;*.docx|Fichiers lyrics (*.lrc)|*.lrc|Tout les fichiers (*.*)|*.*
String 58=Fichiers BMP, JPG et GIF (*.bmp,*.jpg, *.gif)|*.bmp;*.jpg;*.gif|Fichiers Bitmap Windows (*.bmp)|*.bmp|Fichiers JPEG (*.jpg)|*.jpg|Fichiers GIF (*.gif)|*.gif|
String 54=Charger une image
String 55=Merci pour votre idée, je tenterai de la traiter dans les plus brefs délais
String 56=Rapporter un bug, faire une suggestion...
String 57=Impossible d'afficher les caractères spéciaux !
String 59=Sauver en tant que :
String 60=Mot :
String 61=Séparer les chapitres
String 62=Entrez l'URL du fichier à télécharger. IE 5.0 min est requis pour le bon fonctionnement. Lorsque l'on vous posera la question, cliquez sur autoriser l'accès de cette page au presse papier.
String 63=Téléchargement d'une page Web
String 64=Nom d'utilisateur :
String 65=Graphismes : Windows XP, pack Vista Inspirat, Noia 2.0 Xtrême, Windows Vista, Windows Media Player, ThunderBird skinné, Neamar, icone de Charmap, Images libres de droit sur Internet.
String 66=Historique des versions :
String 67=Rechercher
String 68=Remplacer
String 69=Application du filtre en cours...
String 70=Taille du texte (caractères) :
String 71=Nom du dossier
String 72=<Marque du Baladeur>

; Path à rajouter à neamar.free.Fr pour arriver sur les pages dans la bonne langue.
String 73=txt2jpg
String 74=<Modèle>
String 76=Quel est le modèle du baladeur ?
String 77=Quelle est la marque ?

; %u : ancien modèle de baladeur, %n : nouveau modèle de baladeur
String 78=Souhaitez vous vraiment remplacer %u par %n
String 80=Confirmer le remplacement

String 81=Suivant
String 82=Vous ne disposez pas de la DLL bmp2jpg.dll. Le programme va la télécharger automatiquement. Si une erreur survient, vérifiez les options de votre pare feu. Continuer ?
String 83=DLL manquante
String 84=Une instance du programme est déjà lancée, cette session va donc s'auto détruire dans cinq secondes...éloignez vous de la bordure du quai s'il vous plait.

; Les images d'arrière plan proposées par défaut.
String 86=Parchemin
String 87=Aquatique
String 88=Terre
String 89=Ésotérique
String 90=Etoiles
String 91=Ondes
String 92=Ciel
String 93=Paix
String 94=Ondine
String 95=Cristal
String 96=Plus...


String 98=Une nouvelle version de TXT2JPG est disponible....
String 99=Nouvelle version !

String 100=Vous utilisez TXT2JPG depuis 3 numérisations.
String 101=Entre temps, peut être vous êtes vous fait une idée un peu avancée de ce logiciel. Pourriez vous répondre à un rapide sondage de quelques questions (une dizaine) afin d'améliorer les prochaines versions ?
String 102=Chargement....
String 104=@Autre...
String 105=Quelle est la hauteur en pixel de l'écran ?
String 106=Hauteur
String 107=Quelle est la largeur en pixel de l'écran ?
String 108=Largeur
String 109=(Autres...)
String 110=Quel est la marque de votre baladeur ? (Si votre baladeur n'a pas de marque, laissez le terme 'No Name')
String 111=Quel est le modèle de baladeur ?
String 112=Vous ne disposez pas du module ConvertPowerPoint.exe. Le télécharger ?
String 113=Vous ne disposez pas de la DLL bmp2jpg.dll. La télécharger?
String 114=Vous ne disposez pas du module Degrade.exe. Le télécharger ?
String 115=Sélectionnez votre baladeur, car le programme Dégradé doit connaitre la taille de l'écran
String 116=Vous ne disposez pas du module GIF2AVI.exe. Le télécharger, ainsi que ses dépendances  ?
String 117=http://www.gutenberg.org/browse/languages/fr
String 118=ATTENTION : AVEC LE NIVEAU REALTIME_PRIORITY_CLASS VOUS JOUEZ AVEC LE FEU. UN SEUL PROCESSUS PEUT AVOIR CETTE PRIORITE EN MEME TEMPS. IL SERA IMPOSSIBLE D'ARRETER LE LOGICIEL TANT QUE LA NUMERISATION NE SERA PAS TERMINEE. VOTRE SOURIS ET VOTRE CLAVIER NE BOUGERONT PLUS. En contrepartie, le programme numérisera les images plusieurs dizaines de fois plus vite.
String 119=Qualité : (%u%)
String 120=Appuyez  sur les touches { %u }.

[Message]
; Les messages qui s'affichent sous forme d'info bulles.
; IMPORTANT : Les titres qui commencent par un i indiquent qu'il s'agit d'une information, l'info bulle ne sera affichée que deux fois, puis sera oubliée. Laissez les i là ou ils sont...
Msg 1=Cette page ne vous plait pas ?
Msg 2=Si vous souhaitez conserver les effets de style de la page (images-tableaux...), ouvrez IE, copiez la page, ouvrez Word, collez le texte, puis copier de nouveau et collez ici...
Msg 3=Erreur !
Msg 4=Les caractères suivants ne sont pas autorisés :
Msg 5=Aucun texte sélectionné !
Msg 6=Sélectionnez du texte dans l'aperçu pour utiliser cette option (max conseillé : 20 caractères)
Msg 7=iOuvrir...
Msg 8=Cliquez pour ouvrir un fichier Texte, Texte mis en forme et Lyrics (*.txt,*.rtf,*.doc,*.lrc)
Msg 9=iFatigué des dégradés ?
Msg 10=Vous pouvez utiliser une image de fond au format JPG/BMP/GIF non animé
Msg 11=Impossible d'annuler
Msg 12=Causes possibles de cette erreur :
Msg 13=iCliquez ici !
Msg 14=Cliquez ici pour créer des dégradés colorés !
Msg 15=iMarquez ici le nom de fichier
Msg 16=Les images crées seront automatiquement sauvegardés dans ce dossier, qui s'ouvrira automatiquement à la fin de la numérisation.
Msg 17=iOuvrir...
Msg 18=Vous devez cliquer içi pour ouvrir un fichier Internet sur le web, ou stocké sur votre disque dur (nécessite IE 5.5 ou supérieur)
Msg 19=iQualité
Msg 20=Réglez la qualité du JPG de sortie. Plus elle est proche de 100, meilleur est le résultat, mais plus il est lourd.
Msg 21=Préfixe invalide !
Msg 22=Ce champ permet de sélectionner un nom de préfixe pour les images.
Msg 23=iChamp préfixe
Msg 24=Ce champ permet de sélectionner un nom de préfixe pour les images. Les images obtenues auront un nom de la forme <dossier>\<préfixe>XXXX.jpg
Msg 25=iLes marges Haut/Bas sont configurées
Msg 26=Chaque image bénéficiera bien de vos modifications (non visibles sur l'aperçu)
Msg 27=iDivision en chapitres
Msg 28=Cette option crée des sous-dossiers à l'intérieur du dossier principal, chacun contenant un chapitre. La division en chapitre s'effectue chaque fois que le programme rencontre le terme marqué à droite, qui ne peut pas contenir du code RTF.
Msg 29=iPriorité
Msg 30=Si vous avez à numériser des textes longs, vous pouvez gagner en rapidité en réglant la priorité. Je conseille ABOVE_NORMAL_PRIORITY_CLASS !
Msg 31=Remplacement terminé
Msg 32= occurrences remplacées (en respectant la casse)
Msg 33=iChamp Nom Réseau
Msg 34=Ce champ vous permet de choisir le nom qui vous identifiera lors de vos connexions avec la base de données de baladeur, lors de rapport de bug....
Msg 35=iChamp Base
Msg 36=Ce champ permet d'indiquer l'arborescence par défaut où sont crées les dossiers de numérisation. Cliquez sur la loupe pour changer.
Msg 37=Aucun texte sélectionné !
Msg 38=Sélectionnez du texte dans l'aperçu pour utiliser cette option (max conseillé : 20 caractères).
Msg 39=Nom de fichier invalide !
Msg 40=Windows n'autorise pas la saisie des caractères suivants dans les noms de dossier :  \ / : * ?   < >
Msg 41=iSauver en JPG
Msg 42=Cliquez içi pour enregistrer ou non vos images au format JPG (le format par défaut est BMP). Je vous conseille d'activer cette option, et de régler la qualité à 75%.
Msg 43=Inutile !
Msg 44=Il est inutile de régler la couleur d'arrière plan, car vous utilisez déjà une image d'arrière plan. Régler la couleur n'aurait aucune utilité...
Msg 45=Opération impossible
Msg 46=La couleur de fond et la couleur de premier plan sont semblables.

Msg 49=Téléchargement en cours...
Msg 50=La DLL est en train d'être téléchargée...Merci de patienter ...
Msg 51=Image introuvable !
Msg 52=Ce fichier n'existe pas ou plus. Vérifiez de ne pas avoir commis d'erreurs.
Msg 53=iImage d'arrière plan
Msg 54=Ce champ permet de sélectionner une image jpg/bmp à utiliser en arrière plan du texte numérisé.
Msg 55=Welcome !
Msg 56=Welcome to TXT2JPG. You are not speaking French ? Click on this tab, and select your language.
Msg 57=iActiver la pagination
Msg 58=Si vous activez cette option, chaque page sera marquée de son numéro et d'une barre de progression. Vous pouvez régler la taille de ces informations à l'aide du curseur de marge du bas.7
Msg 59=Dimensions invalides
Msg 60=Ces dimensions ne sont pas correctes, choisissez un baladeur !
Msg 61=Baladeur Ajouté
Msg 62=Merci pour votre envoi ! Fermez le logiciel puis relancez-le pour prendre en compte !
Msg 63=Une erreur est survenue !
Msg 64=Les paramètres de votre baladeur ont peut être été mal chargés. Si les données affichées ne correspondent pas à votre baladeur, relancez le logiciel.
Msg 65=Demande de confirmation !
Msg 66=Le nom de répertoire existe déjà...Les fichier préexistants portant le même nom (%u/0XXXX.jpg) seront écrasés. Vous devriez changer de nom.
Msg 67=iMettre une copie du fichier dans le...
Msg 68=Si vous effectuez des modifications sur votre texte, cochez cette option. Cela sauvegardera vos changements dans le meme dossier que les images, et rouvrira votre projet au prochain démarrage.
Msg 69=iEnregistrer ce baladeur
Msg 70=Enregistre le baladeur en mémoire, et le sélectionnera par défaut pour chaque numérisation.
Msg 71=iImage d'arrière plan
Msg 72=Par défaut, le fond de chaque image sera de la couleur de fond selectionnée (blanc dans la majorité des cas). Cependant, vous pouvez aussi utiliser une image comme arrière-plan, ou simplement comme couverture.

Anglais

Un autre fichier ini standard...

Code source : English.lng
  • Langage : ini
  • ΔT : 0.314s
  • Taille :18313 caractères
; .ini file, ; is a remark.
; The file contains 3 sections: [FormData], [Strings] and [Message]
; [FormData] => Default value for the controls. You can add some line. You can add properties; they will be taken into account if the control accepts the property.
; [Strings] => Every string the program will need while. Max size: 512 chars.
; [Message] =>Every single tooltip displayed by the software;
;
; You can create new languages files simply by naming them <language name>.ini and pasting the file in the Lang folder. He will be automatically detected at startup.
; In such a case, send me a mail and join it your language file ! neamart@yahoo.fr

;{ENGLISH}, created by NEAMAR - corrected by Y-God - 22/DEC/07

[FormData]
; This part contains all the hard-coded information: they are the default value for controls.

; Etiquette controls are the most commons labels you'll find; they are often associated with option button
etiquette|0|Caption=Source file / URL :
etiquette|1|Caption=Folder's name:
etiquette|2|Caption=Application's closing
etiquette|3|Caption=Size
etiquette|4|Caption=Save As :
etiquette|5|Caption=Use a background picture
etiquette|6|Caption=Modify the pics dimensions
etiquette|6|ToolTipText=Modify the pics dimensions so that if fits the player's screen
etiquette|7|Caption=Convert 'on the fly'
etiquette|7|ToolTipText=Quicker conversion, but less aesthetical
etiquette|8|Caption=Height:
etiquette|9|Caption=Width:
etiquette|10|Caption=Save as *.jpg
etiquette|10|ToolTipText=Encode as JPG (longer, but recommended if your firmware doesn't convert it automatically).
etiquette|11|Caption=Quality: 80%
etiquette|12|Caption=Cover only
etiquette|12|ToolTipText=Use this picture only for the first picture: it'll be considered as a cover, not as a background picture.
etiquette|13|Caption=Left Margin:000px
etiquette|14|Caption=Right Margin:000px
etiquette|15|Caption=Loading...
etiquette|16|Caption=Put the mouse pointer over an image to get a description.
etiquette|17|Caption=Red background
etiquette|18|Caption=Green Background
etiquette|19|Caption=Blue background
etiquette|20|Caption=Orientation
etiquette|21|Caption=Network Name
etiquette|22|Caption=Use Clear Type
etiquette|22|ToolTipText=This option won't work if you're not using a background picture.
etiquette|23|Caption=Default path:
etiquette|24|Caption=Menu's slide
etiquette|24|ToolTipText=Makes a rapid transition when you swap menus. Can be deactivated if your computer is old, or if you want to gain more speed.
etiquette|25|Caption=Priority:
etiquette|25|ToolTipText=Sets process priority (affect converting speed)
etiquette|26|Caption=Bottom Margin:000px
etiquette|27|Caption=Top Margin:000px
etiquette|28|Caption=Use top and bottom margin
etiquette|29|Caption=Write page number
etiquette|30|Caption=Select some text, and make size-range with the left sliders.
etiquette|31|Caption=Select the color for the first char, color of the last char, and click on Apply...
etiquette|32|Caption=Your text's containing pictures! What are you willing to do?
etiquette|33|Caption=Make no changes (no resize, picture larger than your player's screen will be cut)
etiquette|34|Caption=Resize, if need be, but resize nothing but width.
etiquette|35|Caption=Resize, if need be, width AND height.
etiquette|36|Caption=Adapt text colors to the BG.
etiquette|36|ToolTipText=Change the contrast between the background colors, and the text colors. BETA!
etiquette|37|Caption=Language:
etiquette|37|ToolTipText=Choose the language you want TXT2JPG to use
etiquette|38|Caption=Split chapter
etiquette|38|ToolTipText=Write the splitter-word. Each time the software will find this word, a new folder will be created. A common example of word will be 'Chapter'
etiquette|39|Caption=Put a copy of the text in the output folder
etiquette|39|ToolTipText=Create a copy of the text file in the output folder.
etiquette|40|Caption=Search:
etiquette|41|Caption=Replace by:

; Plug choice controls are tabs title; they are displayed in the first row, right after the text, above the start button. The #4 button is displayed only when #1 is active.
PlugChoice|0|Caption=Folder settings
PlugChoice|1|Caption=Text enhancements
PlugChoice|2|Caption=Margin / Advanced settings
PlugChoice|3|Caption=TXT2JPG settings
PlugChoice|4|Caption=Add-ins
PlugChoice|5|Caption=Advanced Text Enhancements

; Text enhancement settings are listed below
Couleur|0|ToolTipText=Text color
Couleur|1|ToolTipText=Highlighted text color
Couleur|2|ToolTipText=Background color.
MEF|0|ToolTipText=Bold
MEF|1|ToolTipText=Italic
MEF|2|ToolTipText=Underline
MEF|3|ToolTipText=Strike
MEF|4|ToolTipText=Lists
CharMap|0|ToolTipText=See the special characters list
Alignement|0|ToolTipText=Alignment
Polices|0|Text=MS Sans Serif

; Add-ins descriptions
Modules|0|ToolTipText=This add-in convert a PowerPoint presentation to JPG pictures, with the right size for your player.
Modules|1|ToolTipText=Create color range to use for your player's background.
Modules|2|ToolTipText=Convert Gif files to AVI. NO ENGLISH SUPPORT!
Modules|3|ToolTipText=The Gutenberg project is a website offering thousand of royalty free books. You can download them for free, as html, txt, rtf and doc.
Modules|4|ToolTipText=Add-in for French speakers: thousands of jokes, hundreds of funny pictures....
Modules|5|ToolTipText=Forthcoming add-in !
ModulesWhat|0|Caption=Add-ins
ModulesWhat|1|Caption=About
WhatAbout|0|Text=Data are loading...

;Right click menus
Edition|0|Caption=Undo
Edition|1|Caption=-
Edition|2|Caption=Replace
Edition|3|Caption=Search
Edition|4|Caption=-
Edition|5|Caption=Fitter tool
Edition|6|Caption=Delete double new-line
Edition|7|Caption=Font
Edition|8|Caption=-
Edition|9|Caption=Cut
Edition|10|Caption=Copy
Edition|11|Caption=Paste
Edition|12|Caption=RTF=>TXT
Edition|13|Caption=TXT=>RTF
Edition|14|Caption=-
Edition|15|Caption=Default settings
Edition|16|Caption=-
Edition|17|Caption=Horizontal line
Edition|18|Caption=Alignment
Edition|19|Caption=Toggle case
Edition|20|Caption=New paragraph
Edition|21|Caption=Superscript
Edition|22|Caption=Subscript
Align|0|Caption=Left alignment
Align|1|Caption=Right alignment
Align|2|Caption=Center

;Bug toolbar, this toolbar is displayed when you launch the soft after a crash, or when you click on "Report a bug"
Bug_Texte|0|CueBanner=A bug happened? Can you say a little more in order to improve future version
Bug_Envoi|0|Caption=Send
Bug_Rapport|0|Caption=Report a bug
Bug_Rapport|0|ToolTipText=Click here if you came across a bug, or if you wish to make a proposition for the software.

; The Search and replace tool bar (CTRL-F, CTRL-H) (see also etiquette|40 and etiquette|41)
Rechercher_Suite|0|Caption=Next
Rechercher_Close|0|ToolTipText=Close this toolbar

; About the player
Hauteur|0|Text = 240
Largeur|0|Text = 320
Defaut|0|ToolTipText=Save this player as my default player
Swap|0|ToolTipText=Swap width and height (reverse display)
Modeles|0|Text=<Player's Name>
Marque|0|Text=<Player's Mark>

; Program settings
ChoosePic|0|Caption=Select back picture
Enregistrer|0|ToolTipText=Save this as my new name
Enregistrer|1|ToolTipText=Save as new root folder
Browse3|0|ToolTipText=Select the root folder:
Langue|0|ToolTipText=Select a language for the soft.

; Button
Abandon|0|Caption=UNDO?
Annuler|0|Caption=Undo
Start|0|Caption=Start
Start|0|ToolTipText=Start converting right now!
AppliquImage|0|Caption=Apply
Appliquer|0|Caption=Apply

; File picking
Dest_Folder|0|CueBanner=Folder name
Directory|0|Text=Directory
Browse|0|ToolTipText=Browse

; Melting pot
VoirApercu|0|Caption=Watch preview
KeyWord|0|CueBanner=Key Word
Root|0|CueBanner=Root text
UseTopAndBottomMargin|0|ToolTipText=Use top and bottom margin


[Strings]
; String list

String 1=Please select the folder where all the pictures will be created.
String 2=No, I?m not bugged ! I am working...

; All the step of conversion
String 3=Beginning...
String 4=Copying file... (May take some minutes, don't click anywhere)
String 5=Splitting file (%u)...
String 6=Part #
String 7=Resizing pictures...
String 8=Priority is set to:
String 9=You are using a background picture (%u)
String 10=You are not using any background picture.
String 11=Picture count will be (ESTIMATION):
String 12=The amount of time required to complete this operation will vary depending on your settings and your computer.
String 13=Converting text to bitmap...
String 14=Unloading temporary files...
String 15=Converting bitmap to jpg...
String 16=Done, now closing application and loading your %u pictures.
String 18=Searching for updates...

; Message about Internet connection
String 19=Downloading data...
String 20=TXT2JPG cannot open an Internet connection. You will have to enter manually your player. Look your firewall options to correct this problem.

; Messages about Word and IE automation
String 21=Opening file...
String 22=File now open, getting back all compatible data...
String 23=Caution: Picture will make this step longer!
String 24=File read. If nothing happen, right click on this text, and select 'Paste'.
String 25=Automation is open...
String 26=Reading the file...
String 27=Page read...
String 28=Parsing for data...
String 29=When you are asked permission for clipboard, click OK.
String 30=Automation closed, end of conversion! If nothing happen, right click on the text and select 'Paste'.

; About PDF Files
String 31=TXT2JPG is unable to open PDF files. However, you can use a website which will do the conversion for you. Do you want to do this conversion now?
String 32=Media convert will be opened in your default browser....
String 33=http://media-convert.us

; About LRC files
String 34=Converting back to text...
String 35=This LRC files contain no title, please write it manually.
String 36=No [ti:] found
String 37=Invalid file. Try opening it as plain text?

; URL for the default URL choice, but also where people will be redirected when a new version is available.
String 38=http://neamar.free.fr/txt2jpg_en/txt2jpg.php

String 47=....please wait....
String 48=This file type is currently not supported...
String 49=The background picture is bigger than your player screen. Resize it?
String 50=Please confirm!
String 52=Load a file

; Do not change files pattern !
String 53=BMP, JPG(*.bmp,*.jpg)|*.bmp;*.jpg|Bitmap Windows(*.bmp)|*.bmp|JPEG (*.jpg)|*.jpg|GIF (*.gif)|*.gif|
String 51=Text, Enhanced Text and Lyrics (*.txt,*.rtf,*.doc,*.lrc)|*.txt;*.rtf;*.doc;*.lrc;*.docx|Plain text (*.txt)|*.txt|Enhanced text (*.rtf,*.doc,*.pdf)|*.rtf;*.doc;*.pdf;*.docx|Lyrics (*.lrc)|*.lrc|All files (*.*)|*.*
String 58=BMP, JPG et GIF (*.bmp,*.jpg, *.gif)|*.bmp;*.jpg;*.gif|Bitmap Windows (*.bmp)|*.bmp|JPEG (*.jpg)|*.jpg|GIF (*.gif)|*.gif|


String 54=Load a picture
String 55=Thank you for your idea, I?ll try to think about it.
String 56=Report a bug, make a suggestion...
String 57=Can?t display special chars.

String 59=Save as:
String 60=Word:
String 61=Split Chapter
String 62=Write here the URL of your file. You'll need at least IE 4.5 for this to work.
String 63=Download a webpage
String 64=User Name:
String 65=Graph : Windows XP, pack Vista Inspirat, Noia 2.0 Xtrême, Windows Vista, Windows Media Player, skinned Thunderbird, Neamar, Char map icon, free picture on the web.
String 66=Features:
String 67=Search
String 68=Replace
String 69=Applying filter...
String 70=Text size (chars):
String 71=Folder name
String 72=<Player's Mark>

; The string to add after the URL to get pages in the good language
String 73=txt2jpg_en

String 74=<Player's Name>
String 76=Player's Model
String 77=Player's Mark

; %u : former player's name, %n : new player's name
String 78=Do you really want to replace %u by %n
String 80=Please confirm!

String 81=Next one
String 82=You don't have the bmp2jpg DLL. The software will download it automatically. If an error happens, look your firewall settings. Continue?
String 83=DLL's missing
String 84=Another instance is already launch! This session will auto destroy herself...click on fire to continue ?

; Default background pictures
String 86=Parchment
String 87=Water
String 88=Earth
String 89=Esoteric
String 90=Stars
String 91=Wave
String 92=Sky
String 93=Peace
String 94=Aqua Wave
String 95=Cristal
String 96=@More...


String 98=A new version of TXT2JPG is available....
String 99=New version!

String 100=You have been using TXT2JPg for three times.
String 101=During this time, you should have grown accustomed to the software. Could you take a rapid survey (10 questions) in order to improve futures versions?
String 102=Loading....
String 104=@Other...
String 105=What is screen's height?
String 106=Height
String 107=What is screen's width?
String 108=Width
String 109=(Other...)
String 110=What is your player mark? If it hasn't a name, write 'No Name'
String 111=Which model do you own?
String 112=You didn't have ConvertPowerPoint.exe. Download it?
String 113=You didn't have the DLL bmp2jpg.dll. Download it?
String 114=You didn't have Degrade.exe. Download it?
String 115=Select your player, for Degrade.exe needs to know your screen size.
String 116=You didn't have GIF2AVI.exe. Download necessary files?
String 117=http://www.gutenberg.org/browse/languages/en
String 118=WARNING: WITH THE REAL TIME PRIORITY? YOU ARE PLAYING WITH WILD FIRE; ONLY ONE PROCESS CAN HAVE THIS PRIORITY. THE SYSTEM MAY CRASH. BUT YOUR CONVERSION WILL BE QUICKER THAN EVER...
String 119=Quality: (%u%)
String 120=Press { %u } keys.

[Message]
; The tool tip messages
; IMPORTANT : Title beginning with an "i" are temporary information tool tip : they will be displayed twice, and not anymore. Don?t change them...
Msg 1=This plain text disappoint you ?
Msg 2=If you want to keep then enhanced text (pictures, table...), open your browser, cut the text, paste it in Word, copy it from Word and eventually paste it here.
Msg 3=Error!
Msg 4=The following chars are not allowed:
Msg 5=No selected text!
Msg 6=Select some text from the left textbox in order to use this tool
Msg 7=iOpen...
Msg 8=Click to open a file on your HDD (*.txt,*.rtf,*.doc,*.lrc)
Msg 9=iWant more than color range?
Msg 10=You can use a background picture for the soft! (JPG/BMP/GIF)
Msg 11=Unable to undo
Msg 12=Possible reasons for this problem:
Msg 13=iClick here!
Msg 14=To make color range, click on both blackbox.
Msg 15=iWrite here the file name
Msg 16=Converted images will be saved in this folder, which will automatically pop-up once the conversion ended.
Msg 17=iOpen...
Msg 18=Clic to open an Internet filer, located either on your HDD or on the web (you will need IE 4.5 or later)
Msg 19=iQuality
Msg 20=Sets the output JPG quality. The bigger the quality is, the best the pictures are, and the biggest their sizes.
Msg 21=Invalid root!
Msg 22=This field let you select a root name for your pictures.
Msg 23=iRoot field
Msg 24=This field let you select a prefix name for your pictures. Converted pictures will be names <folder>\<prefix>XXXX.jpg, where XXXX stands for the number.
Msg 25=iTop and bottom margin configured
Msg 26=Each picture will inherit of your change (invisible in the text overview)
Msg 27=iSplit the chapter
Msg 28=This settings create sub folders in the main folder, each subfolder containing a chapter. This splitting takes place every time the software meets the word written in the right textbox.
Msg 29=iPriority
Msg 30=If you have really long text, you can gain some speed by setting the priority. I advise you to choose ABOVE_NORMAL_PRIORITY_CLASS.
Msg 31=Replace successful
Msg 32= matches found and replaced (case sensitive)
Msg 33=iNetwork name
Msg 34=This field let you choose the name that will be displayed when TXT2JPG download datas, such as the players list.
Msg 35=iRoot field
Msg 36=This field let you select the root for the converted picture. They will all be saved in this folder.
Msg 37=No text selected!
Msg 38=Select some text in the left textbox to use this tool
Msg 39=Invalid file name!
Msg 40=Windows disallow the use of this characters for folder name:  \ / : * ?  < >
Msg 41=iSave in JPG
Msg 42=Click here to save your pictures as a JPG file (default is BMP). I advise you to save in JPG, and to select a quality of 75%.
Msg 43=Useless!
Msg 44=There is no need to set the background color, since you are using a background picture. Setting the background color will be useless...
Msg 45=Unable to do this!
Msg 46=Text color and background color are the same one.

Msg 49=Is downloading...
Msg 50=Your DLL is downloading, please be patient...
Msg 51=Can't find this picture!
Msg 52=This picture does not exist anymore. Try another one
Msg 53=File not allowed !
Msg 54=You can use BMP,JPG ang GIF files.
Msg 55=Welcome !
Msg 56=Welcome to TXT2JPG. You are not speaking French? Click on this tab, and select your language.
Msg 57=iEnable Page number
Msg 58=Each page will wore a number and a progress bar. You can set the size of this information using the bottom margin slider.
Msg 59=Invalid size
Msg 60=This screen size does not exist, try another player.
Msg 61=Player added
Msg 62=Thanks for your contribution! Close the soft and launch it again to see your player in the list.
Msg 63=An error occur!
Msg 64=Your player setting might be misloaded. If the displayed data are not the correct one, launch again the program.
Msg 65=Please confirm!
Msg 66=This folder name is already existing. Existing files with the same pattern (%u/0XXXX.jpg) will be erased. You had better to change the name.
Msg 67=iPut a copy of my file in the folder
Msg 68=If you are editing your text with TXT2JPF, enable this option : a copy of your text file will be put with your images, and will open again the next time you launch TXT2JPG.
Msg 69=iSave this Player
Msg 70=Save the current player in memory, and select it as the default one for each projet.
Msg 71=iBackground Picture
MSg 72=The default background for your picture is the background-color. However, you can select a picture to use as basckground, or as cover.

Fichier d'installation :

Le fichier setup est généré à l'aide du logiciel libre InnoSetup.
Le fichier présenté ici contient des paths incorrects qu'il faudra remplacer par les vôtres si vous souhaitez compiler l'application.

Code source : setupscript.iss
  • Langage : inno
  • ΔT : 0.239s
  • Taille :4610 caractères
; Script generated by the Inno Setup Script Wizard.
; SEE THE DOCUMENTATION FOR DETAILS ON CREATING INNO SETUP SCRIPT FILES!

[Setup]
AppName=TXT2JPG
AppVerName=TXT2JPG 1.3
AppPublisher=Neamar
AppPublisherURL=http://neamar.free.fr/txt2jpg/txt2jpg.php
AppSupportURL=http://neamar.free.fr/txt2jpg/txt2jpg.php
AppUpdatesURL=http://neamar.free.fr/Addins/Zen.php?version=1
DefaultDirName={pf}\TXT2JPG
DefaultGroupName=TXT2JPG
LicenseFile=C:\Documents and Settings\FAMILLE\Bureau\Programmation MATTHIEU\Neamar Games VB\TXT2JPg\Images\licence.rtf
;InfoBeforeFile=C:\Documents and Settings\FAMILLE\Bureau\Programmation MATTHIEU\Neamar Games VB\TXT2JPg\avant.rtf
OutputBaseFilename=setup
Compression=lzma
SolidCompression=yes

[Languages]
Name: "english"; MessagesFile: "compiler:Default.isl"
Name: "french"; MessagesFile: "compiler:Languages\French.isl"

[Tasks]
Name: "desktopicon"; Description: "{cm:CreateDesktopIcon}"; GroupDescription: "{cm:AdditionalIcons}";
Name: "quicklaunchicon"; Description: "{cm:CreateQuickLaunchIcon}"; GroupDescription: "{cm:AdditionalIcons}"; Flags: unchecked

[Files]
Source: "C:\Documents and Settings\FAMILLE\Bureau\Programmation MATTHIEU\Neamar Games VB\TXT2JPg\TXT2JPG.exe"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\Documents and Settings\FAMILLE\Bureau\Programmation MATTHIEU\Neamar Games VB\TXT2JPg\RICHTX32.OCX"; DestDir: "{app}"; Flags: ignoreversion
;Images
Source: "C:\Documents and Settings\FAMILLE\Bureau\Programmation MATTHIEU\Neamar Games VB\TXT2JPg\Images\Cristal.jpg"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\Documents and Settings\FAMILLE\Bureau\Programmation MATTHIEU\Neamar Games VB\TXT2JPg\Images\parchment.jpg"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\Documents and Settings\FAMILLE\Bureau\Programmation MATTHIEU\Neamar Games VB\TXT2JPg\Images\earth.jpg"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\Documents and Settings\FAMILLE\Bureau\Programmation MATTHIEU\Neamar Games VB\TXT2JPg\Images\aqua.jpg"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\Documents and Settings\FAMILLE\Bureau\Programmation MATTHIEU\Neamar Games VB\TXT2JPg\Images\sky.jpg"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\Documents and Settings\FAMILLE\Bureau\Programmation MATTHIEU\Neamar Games VB\TXT2JPg\Images\wave.jpg"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\Documents and Settings\FAMILLE\Bureau\Programmation MATTHIEU\Neamar Games VB\TXT2JPg\Images\stars.jpg"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\Documents and Settings\FAMILLE\Bureau\Programmation MATTHIEU\Neamar Games VB\TXT2JPg\Images\sign.jpg"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\Documents and Settings\FAMILLE\Bureau\Programmation MATTHIEU\Neamar Games VB\TXT2JPg\Images\Paix.jpg"; DestDir: "{app}"; Flags: ignoreversion
Source: "C:\Documents and Settings\FAMILLE\Bureau\Programmation MATTHIEU\Neamar Games VB\TXT2JPg\Images\Ondines.jpg"; DestDir: "{app}"; Flags: ignoreversion

;Fichiers systèmes
Source: "C:\WINDOWS\system32\VB6FR.DLL"; DestDir: "{win}\system32";
Source: "C:\WINDOWS\system32\oleaut32.dll"; DestDir: "{win}\system32";
Source: "C:\WINDOWS\system32\MSVBVM60.DLL"; DestDir: "{win}\system32";
Source: "C:\WINDOWS\system32\olepro32.dll"; DestDir: "{win}\system32";
Source: "C:\WINDOWS\system32\stdole2.tlb"; DestDir: "{win}\system32";
Source: "C:\WINDOWS\system32\asycfilt.dll"; DestDir: "{win}\system32";
Source: "C:\WINDOWS\system32\comcat.dll"; DestDir: "{win}\system32";
Source: "C:\Documents and Settings\FAMILLE\Bureau\Programmation MATTHIEU\Neamar Games VB\TXT2JPg\BMP2JPG.dll"; DestDir: "{win}\system32";
;Y a plus besoin du .ocx !
;Source: "C:\Documents and Settings\FAMILLE\Bureau\Programmation MATTHIEU\Neamar Games VB\TXT2JPg\COMDLG32.OCX"; DestDir: "{win}\system32"; Flags: regserver;
 
[INI]
Filename: "{app}\TXT2JPG.url"; Section: "InternetShortcut"; Key: "URL"; String: "http://neamar.free.fr/txt2jpg/txt2jpg.php"

[Icons]
Name: "{group}\TXT2JPG"; Filename: "{app}\TXT2JPG.exe"; WorkingDir: "{app}"
Name: "{group}\{cm:ProgramOnTheWeb,TXT2JPG}"; Filename: "{app}\TXT2JPG.url"
Name: "{group}\{cm:UninstallProgram,TXT2JPG}"; Filename: "{uninstallexe}"
Name: "{userdesktop}\TXT2JPG"; Filename: "{app}\TXT2JPG.exe"; Tasks: desktopicon
Name: "{userappdata}\Microsoft\Internet Explorer\Quick Launch\TXT2JPG"; Filename: "{app}\TXT2JPG.exe"; Tasks: quicklaunchicon

[Run]
Filename: "{app}\TXT2JPG.exe"; Description: "{cm:LaunchProgram,TXT2JPG}"; Flags: nowait postinstall skipifsilent

[UninstallDelete]
Type: files; Name: "{app}\TXT2JPG.url"

 
Auteur
Neamar
Date
2007
But
Conversion
Menu
Index des ressources

Chargement du sommaire...