Sources PureBasicConsultez toutes les sources

Nombre d'auteurs : 41, nombre de sources : 88, dernière mise à jour : 13 août 2011 

 
OuvrirSommaireApplications

Pour tester un fichier langue, vous pouvez créer un fichier texte que vous nommerez'german.prefs'. Ce fichier contiendra les lignes suivantes:

[MenuTitle]
File = Datei
Edit = Bearbeiten

[MenuItem]
New = Neu
Open = Öffnen
Save = Speichern


Pour un programme dans le mode unicode, le fichier doit être enregistré en UTF8 avec le BOM (byte order mark) valant UTF8 (voir WriteStringFormat()) , afin que la bibliothèque Preference charge correctement les chaînes en unicode.

 
Sélectionnez

;Vous pouvez consulter les fichiers langues de l'EDI dans le répertoire catalogs de PureBasic
              
; -----------------------------------------------------------------
;  Exemple d'une gestion simple des langues pour une application
; -----------------------------------------------------------------
;
; Avantage de cette solution :
;  - Les chaînes de caractères sont identifiées par un groupe et un nom clé, ce qui permet  
;    de mieux les organiser avec leurs propres descriptions et de développer plus facilement.
;
;  - Les chaînes de caractères sont indexées et triées lors de leur chargement,
;    ce qui permet un accès rapide malgré qu'elles soient appelées par leur nom.
;
;  - Une langue par défaut est définie dans le code (DataSection), aussi même 
;     si un fichier externe de langue est manquant ou périmé, il y a toujours la langue
;     par défaut présente.
;
;  - La liste de mots est facile à élargir. Il suffit d'ajouter une nouvelle entrée
;     dans la DataSection ainsi que le fichier de langue et d'utiliser le nouveau groupe et nom clé.
;
;  - Les fichiers de langues additionnels sont dans le format "PB preference" qui
;    permet de les maintenir facilement.
;
; Utilisation:
;  - définissez le langage par défaut dans la DataSection comme montré plus bas
;  - Utilisez LoadLanguage() au départ pour charger le langage par défaut ou le fichier externe.
;  - Utilisez Language(Group$, Name$) pour accéder aux mots des langages.
;
; -----------------------------------------------------------------
 
; Divers
;
Global NbLanguageGroups, NbLanguageStrings
 
Structure LanguageGroup
  Name$
  GroupStart.l
  GroupEnd.l
  IndexTable.l[256]
EndStructure
 
; Cette procédure charge la langue depuis un fichier, ou le langage par défaut.
; Elle doit être appelée au moins une fois avant d'utiliser n'importe quel mot.
;
; Cette procédure permet de :
; - charger et trier le langage par défaut fourni
; - charger n'importe quel langage depuis un fichier
;
; Cette méthode vous permet d'obtenir un mot d'une langue, même si le fichier n'est pas 
; trouvé, ou qu'un mot référencé par un index est introuvable dans le fichier.
; Vous récupererez la langue par défaut en utilisant la commande Language().
;
; Cette fonction peut être appelée plusieurs fois pour changer la langue utilisée durant l'exécution.
;
Procedure LoadLanguage(FileName$ = "")
 
  ; Fait d'abord un rapide compte de la DataSection
  ;
  NbLanguageGroups = 0
  NbLanguageStrings = 0
 
  Restore Language
  Repeat
 
    Read Name$
    Read String$
 
    Name$ = UCase(Name$)
 
    If Name$ = "_GROUP_"
      NbLanguageGroups + 1
    ElseIf Name$ = "_END_"
      Break
    Else
      NbLanguageStrings + 1
    EndIf
    
  ForEver
    
  Global Dim LanguageGroups.LanguageGroup(NbLanguageGroups)  ; ils sont tous 
  Global Dim LanguageStrings.s(NbLanguageStrings)
  Global Dim LanguageNames.s(NbLanguageStrings)
 
  ; On charge la langue standard (par défaut)
  ;  
  Group = 0
  StringIndex = 0  
 
  Restore Language
  Repeat
 
    Read Name$
    Read String$
 
    Name$ = UCase(Name$)
 
    If Name$ = "_GROUP_"
      LanguageGroups(Group)\GroupEnd   = StringIndex ; Mémorise le dernier index de chaînes associées à ce groupe
      Group + 1  
 
      LanguageGroups(Group)\Name$      = UCase(String$)  ; Mémorise le nom du groupe
      LanguageGroups(Group)\GroupStart = StringIndex + 1 ; Mémorise le premier index de chaînes associées à ce groupe
      For i = 0 To 255
        LanguageGroups(Group)\IndexTable[i] = 0
      Next i
      
    ElseIf Name$ = "_END_"
      Break
 
    Else
      StringIndex + 1 ; Incrémente l'index sur les chaînes
      LanguageNames(StringIndex)   = Name$ + Chr(1) + String$  ; Garde le nom de l'index et la valeur ensemble pour trier plus facilement
 
    EndIf
    
  ForEver
 
  LanguageGroups(Group)\GroupEnd   = StringIndex ; Configure le dernier index pour le dernier groupe !
  
  ; On effectue le tri et l'indexation pour chaque groupe
  ;
  For Group = 1 To NbLanguageGroups
    If LanguageGroups(Group)\GroupStart <= LanguageGroups(Group)\GroupEnd  
      
      SortArray(LanguageNames(), 0, LanguageGroups(Group)\GroupStart, LanguageGroups(Group)\GroupEnd)
  
      char = 0
      For StringIndex = LanguageGroups(Group)\GroupStart To LanguageGroups(Group)\GroupEnd
        LanguageStrings(StringIndex) = StringField(LanguageNames(StringIndex), 2, Chr(1)) ; Sépare la valeur de l'index
        LanguageNames(StringIndex)   = StringField(LanguageNames(StringIndex), 1, Chr(1))
 
        If Asc(Left(LanguageNames(StringIndex), 1)) <> char
          char = Asc(Left(LanguageNames(StringIndex), 1))
          LanguageGroups(Group)\IndexTable[char] = StringIndex
        EndIf
      Next StringIndex
      
    EndIf
  Next Group
 
  ; On essaye de chargé un fichier de langue externe.
  ;        
  If FileName$ <> ""
      
    If OpenPreferences(FileName$)
      For Group = 1 To NbLanguageGroups
        If LanguageGroups(Group)\GroupStart <= LanguageGroups(Group)\GroupEnd  
          PreferenceGroup(LanguageGroups(Group)\Name$)
          
          For StringIndex = LanguageGroups(Group)\GroupStart To LanguageGroups(Group)\GroupEnd
            LanguageStrings(StringIndex) = ReadPreferenceString(LanguageNames(StringIndex), LanguageStrings(StringIndex))
          Next StringIndex
        EndIf
      Next Group
      ClosePreferences()    
      
      ProcedureReturn #True
    EndIf    
 
  EndIf
  
  ProcedureReturn #True
EndProcedure
 
 
; Cette fonction retourne un mot pour la langue en cours d'utilisation.
; Chaque mot est identifié par un groupe et un nom (les deux sont insensibles à la casse)
;
; Si le mot n'est pas trouvé (ou non inclus dans la langue par défaut) le
; retour sera "##### String not found! #####". Cela aide à trouver les erreurs dans le code de la langue facilement
;
Procedure.s Language(Group$, Name$)
  Static Group.l  ; Pour un accès plus rapide quand on utilise le meme nom de groupe plusieurs fois
  Protected String$, StringIndex, Result
 
  Group$  = UCase(Group$)
  Name$   = UCase(Name$)
  String$ = "##### String not found! #####"  ; Pour aider à trouver les erreurs
 
  If LanguageGroups(Group)\Name$ <> Group$  ; Contrôle si c'est le même groupe à chaque fois
    For Group = 1 To NbLanguageGroups
      If Group$ = LanguageGroups(Group)\Name$
        Break
      EndIf
    Next Group
 
    If Group > NbLanguageGroups  ; Le groupe demandé n'est pas trouvé
      Group = 0
    EndIf
  EndIf
  
  If Group <> 0
    StringIndex = LanguageGroups(Group)\IndexTable[ Asc(Left(Name$, 1)) ]
    If StringIndex <> 0
 
      Repeat
        Result = CompareMemoryString(@Name$, @LanguageNames(StringIndex))
 
        If Result = #PB_String_Equal
          String$ = LanguageStrings(StringIndex)
          Break
 
        ElseIf Result = -1 ; Mot non trouvé
          Break
 
        EndIf
 
        StringIndex + 1
      Until StringIndex > LanguageGroups(Group)\GroupEnd
 
    EndIf
 
  EndIf
 
  ProcedureReturn String$
EndProcedure
 
 
DataSection
 
  ; C'es ici que la langue par défaut est définie.C'est une liste de Groupe, 
  ; Name avec quelques mot clefs spéciaux pour un groupe
  ;
  ; "_GROUP_" indique un nouveau gorupe dans la DataSection, la seconde valeur est le nom du groupe
  ; "_END_" indique la fin de la liste de la langue (comme il n'y a pas de nombre de mots prédéfinis)
  ;
  ; Note: Les index de mot sont insensibles à la casse pour se faciliter la vie.
  
  Language:
 
    ; ===================================================
    Data$ "_GROUP_",            "MenuTitle"
    ; ===================================================
 
      Data$ "File",             "File"
      Data$ "Edit",             "Edit"
                        
    ; ===================================================
    Data$ "_GROUP_",            "MenuItem"
    ; ===================================================
 
      Data$ "New",              "New"
      Data$ "Open",             "Open..."
      Data$ "Save",             "Save"
          
    ; ===================================================
    Data$ "_END_",              ""
    ; ===================================================
 
EndDataSection

; -----------------------------------------------------------------
; Exemple:
; -----------------------------------------------------------------
 
LoadLanguage()                ; charge la langue par défaut
;LoadLanguage("german.prefs") ; décommentez pour charger le fichier de langue allemand
 
; Récupère quelques mot de la langue
;
Debug Language("MenuTitle", "Edit")
Debug Language("MenuItem", "Save")
 
; -----------------------------------------------------------------
Créé le 22 juin 2008  par Freak

Voila un code qui affiche une boite de dialogue que j'ai personnalisée pour afficher un aperçu de l'image du fichier sélectionné.
Avec les fonctions PB des images, c'est assez limité mais personnellement j'utilise la dll Freeimage (wrapper de Progi1984) et c'est tellement mieux...
Le code est extrait de mon projet qui fait environ 10000 lignes, donc une procédure est écrite avec un peu d'assembleur pour correspondre à mes besoins.

Après réduction de l'image png, la transparence n'est pas conservé avec PB (mais avec Freeimage et un peu d'imagination on y arrive). Chez moi les tiff ne s'affichent pas (mais c'est parfait avec Freeimage qui est capable d'ouvrir de très grandes images).

Image non disponible

Exemple avec un fichier librairie d'icônes icl

Image non disponible

Exemple avec un fichier png réduit avec conservation de la transparence pour l'affichage

Image non disponible
 
Sélectionnez

EnableExplicit
EnableASM

;- Declarations
Declare Free_ScrollArea_From_Images()

;-Constantes Fenêtres
Enumeration
     #MainWindow
EndEnumeration

;-Constantes Gadgets
Enumeration 0
     #Texte_ScrollAreaGadget_Icone
     #HmainCombo
     #ScrollAreaGadget_Icone   ; scrollarea fenêtre principale
     #ScrollAreaGadget_OpenFileRequesterIcone   ; scrollarea fenêtre d'ouverture fichier ico etc
     #ContainerGadget_OpenFileRequesterIcone   ; ListViewGadget d'ouverture fichier png, jpg etc
     #TextGadget_ScrollAreaGadget_OpenFileRequesterIcone
EndEnumeration

Enumeration 0;
     ; Read-Write
     #FileFormat_Unknown
     #ICO
     #CUR
     #ANI
     #ICL
     #DLL
     #BMP
     #PNG
     #JPG
     #TIF
     ; Read-Only
     #EXE
     #OCX
     #CPL
     #SRC
EndEnumeration

#Option_Fenetre = #PB_Window_Invisible | #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget
#CRLF = Chr(13) + Chr(10)
#CRLF_2 = #CRLF + #CRLF
#Format_16 = 16
#Format_32 = 32
#Format_48 = 48
#Format_96 = 96
#Format_128 = 128
#Offset_X_Icone_Apercu = 3
#Offset_Y_Icone_Apercu = 3
#Intervale_X_Icone_Apercu = 3
#Intervale_Y_Icone_Apercu = 3
#Taille_Icone_Apercu = #Format_48
#largeurScrollAreaOpenfile = ((#Taille_Icone_Apercu + #Intervale_X_Icone_Apercu)*5) + (#Offset_X_Icone_Apercu*2) + 25

; valeur retournée en cas d'erreur
#Return_Error = 0

; couleur fond scrollarea de Getopenfilename
#CoulerFondScrollarea_Getopenfilename = #White

; constante des messages de la boîte de dialogue
; #CDN_FIRST = -601
#CDN_FOLDERCHANGE = (#CDN_FIRST-2)
#CDN_HELP = #CDN_FIRST-4
#CDN_INITDONE = #CDN_FIRST
#CDN_FILEOK = #CDN_FIRST-5

#CDN_SELCHANGE = #CDN_FIRST-1
#CDN_SHAREVIOLATION = #CDN_FIRST-3
#CDN_TYPECHANGE = #CDN_FIRST-6
#OFN_FORCESHOWHIDDEN = $10000000
#OFN_ENABLESIZING = $800000

#Maxi_File_Buffer_31_Ko = 31*1024  ; taille du buffer de texte de la boîte de dialogue

; les deux constantes suivantes pour l'extension des fichiers lnk
#Link_extensionFile = ".lnk"
#Link_extensionFile_Length = 4

#HeapCompatibilityInformation = 0


Structure AfficheMiniature
     Reduction.l   ; True l'image est réduite sinon false
     X_Position.l  ; position X sur le gadget d'affichage
     Y_Position.l  ; position Y sur le gadget d'affichage
     Width.l       ; Largeur d'origine de l'image
     Height.l      ; hauteur d'origine de l'image
EndStructure

Structure AfficheImg
     ; mémorise l'id statique de l'image gadget pour l'icone
     StaticImageGadgetId.l
     ; mémorise l'id statique de l'image créée
     StaticImageId.l
EndStructure

CompilerIf Defined(Chaine, #PB_Structure) = #False
     Structure Chaine
          pt.c[260]
     EndStructure
CompilerEndIf

CompilerIf Defined(EnumChidlDatas, #PB_Structure) = #False
     Structure EnumChidlDatas
          rc.RECT
          Dialog.l
     EndStructure
CompilerEndIf

CompilerIf Defined(AffichageMiniature, #PB_Structure) = #False
     Structure AffichageMiniature
          Reduction.l ; rue l'image est réduite sinon false
          X_Position.l ; position X sur le gadget d'affichage
          Y_Position.l ; position Y sur le gadget d'affichage
          Width.l ; Largeur d'origine de l'image
          Height.l ; hauteur d'origine de l'image
     EndStructure
CompilerEndIf

CompilerIf Defined(OFNOTIFY, #PB_Structure) = #False
     Structure OFNOTIFY
          hdr.NMHDR
          *lpOFN.OPENFILENAME
          pszFile.l
     EndStructure
CompilerEndIf

CompilerIf Defined(OPENFILENAMEXP, #PB_Structure) = #False
     Structure OPENFILENAMEXP Extends OPENFILENAME
     pvReserved.l
     dwReserved.l
     FlagsEx.l
EndStructure
CompilerEndIf


Global hMainWindow    ; Handle de la fenêtre principale
Global Largeur_Ecran  ; mémorise la largeur de l'écran
Global Hauteur_Ecran  ; mémorise la hauteur de l'écran
Global Ecran.RECT     ; pour retrouver la taille de l'écran
Global Old_Dialogue_Proc   ; mémorise la procédure d'origine de la fenetre parent du dialog
Global hListIcon_Apercu.l   ; mémorise le handle de la listicon des aperçus
Global Font_Textegadget_Nb_Format_Icones
Global BrushBkgWindow   ; mémorise la solidbrush couleur fond fenêtre
Global Old_ScrollGadget_Proc.l  ; mémorise l'adresse de la callback Windows du scrollAreaGadget
Global _WIN32_WINNT.w  ; version de window par l'API
Global _WIN32_IE.w     ; version d'Internet explorer
Global Nb_Button_ToolBarGetOpenFileName.b; mémorise le nombre de boutons de la Toolbar Getopenfilerequester
Global Quitter_Application.b   ; = #true on ferme l'application
Global FileNumber.l   ; retourne le nombre de fichiers sélectionés après la fermeture d dialogue
Global HeapFragValue.l
Global NewList Infos.AfficheImg() ; utilisé pour mémoriser les images

; Macro
Macro FreeGadgetEx(StaticGadget3)
     If IsGadget(StaticGadget3)
          FreeGadget(StaticGadget3)
     EndIf
EndMacro

Macro FreeFontEX(StaticFont)
     If IsFont(StaticFont)
          FreeFont(StaticFont)
     EndIf
EndMacro

Macro SetGadgetColorEX(StaticGadget12, type, color)
     If IsGadget(StaticGadget12)
          SetGadgetColor(StaticGadget12, type, color)
     EndIf
EndMacro

Macro ShowScrollBarEx(StaticGadget88, Mode, affichage)
     If IsGadget(StaticGadget88)
          ShowScrollBar_(GadgetID(StaticGadget88), Mode, affichage)
     EndIf
EndMacro

Macro SetGadgetFontEx(StaticGadget11, StaticFontId)
     If IsFont(StaticFontId) And IsGadget(StaticGadget11)
          SetGadgetFont(StaticGadget11, FontID(StaticFontId))
     EndIf
EndMacro

Macro ResizeGadgetEx(Gadget, x, y, Largeur, Hauteur)
     If IsGadget(Gadget)
          ResizeGadget(Gadget, x, y, Largeur, Hauteur)
     EndIf
EndMacro

Macro SetGadgetTextEx(StaticGadget4, ch)
     If IsGadget(StaticGadget4)
          SetGadgetText(StaticGadget4, ch)
     EndIf
EndMacro

Macro FreeImageEx(StaticImage3)
     If IsImage(StaticImage3)
          FreeImage(StaticImage3)
     EndIf
EndMacro

Macro InvalidateRectEX(Staticgadget, lpRect, bErase)
     If IsGadget(Staticgadget)
          InvalidateRect_(GadgetID(Staticgadget), lpRect, bErase)
          UpdateWindow_(GadgetID(Staticgadget))
     EndIf
EndMacro


; - Procedures
Procedure _UPeekB(valeur.l)
     ; identique à PeekB() sauf que la valeur retournée est un long non signé (pas d'extension de signe)
     MOV edx, valeur
     MOVZX eax, byte[edx]
     ProcedureReturn
EndProcedure

Procedure.s IE_Version()
     ; retourne une chaine donnant la version de IE au format défini ici http://support.microsoft.com/kb/164539
     Protected Hkey.l, Version$ = ""
     Protected lpType.l, lpcbData.l, resultat.l
     
     If RegOpenKeyEx_(#HKEY_LOCAL_MACHINE, "Software\Microsoft\Internet Explorer\", 0, #KEY_QUERY_VALUE, @Hkey)<>#ERROR_SUCCESS
          ProcedureReturn ""
     EndIf
     
     ;1er appel pour déterminer la taille du buffer
     resultat = RegQueryValueEx_(Hkey, "Version", 0, @lpType, @Version$, @lpcbData)
     If resultat<>#ERROR_MORE_DATA
          RegCloseKey_(Hkey)
          ProcedureReturn ""
     EndIf
     
     Version$ = Space(lpcbData + 2) ; alloue 2 caractères 0 de fin de chaine
     ; lpcbData contient la taille du buffer à allouer pour la fonction
     ; 2ème appel de la fonction
     
     resultat = RegQueryValueEx_(Hkey, "Version", 0, @lpType, @Version$, @lpcbData)
     RegCloseKey_(Hkey)
     If resultat<>#ERROR_SUCCESS
          ProcedureReturn ""
     EndIf
     
     ProcedureReturn Version$
EndProcedure


Procedure Init_Main()
     Protected lib.l, *HeapSetInformation
     
     SystemParametersInfo_(#SPI_GETWORKAREA, 0, @Ecran.RECT, 0)
     Largeur_Ecran = Ecran\right-Ecran\Left
     Hauteur_Ecran = Ecran\bottom-Ecran\top-20
     
     ; WinVersion
     If OSVersion()<#PB_OS_Windows_2000
          MessageRequester("Error/Erreur", "Windows version is to old (Windows 2000 minimum)" + Chr(13) + Chr(13) + "La version de Windows est trop ancienne (Windows 2000 minimum)", #MB_ICONERROR)
          End
     EndIf
     
     Select OSVersion()
               
          Case #PB_OS_Windows_Vista, #PB_OS_Windows_Server_2008, #PB_OS_Windows_Future
               _WIN32_WINNT = $0600
               
          Case #PB_OS_Windows_Server_2003
               _WIN32_WINNT = $0502
               
          Case #PB_OS_Windows_XP
               _WIN32_WINNT = $0501
               
          Case #PB_OS_Windows_2000
               _WIN32_WINNT = $0500
               
     EndSelect
     
     If _WIN32_WINNT< = $0400
          MessageRequester("Error/Erreur", "Windows version is to old" + Chr(13) + Chr(13) + "La version de Windows est trop ancienne", 16)
          End
     EndIf
     
     _WIN32_IE = Val(StringField(IE_Version(), 1, "."))
     
     BrushBkgWindow = CreateSolidBrush_(GetSysColor_(#COLOR_BTNFACE))
     
     ; tente d'utiliser la défragmentation de la mémoire (Low-fragmentation Heap)
     
     lib = OpenLibrary(#PB_Any, "Kernel32.dll")
     
     If lib
          *HeapSetInformation = GetFunction(lib, "HeapSetInformation")
          HeapFragValue = 2
         
          If CallFunctionFast(*HeapSetInformation, GetProcessHeap_(), #HeapCompatibilityInformation, @HeapFragValue, SizeOf(HeapFragValue))
               Debug("Success!\n")
               
          Else
               Debug "Failure " + Str(GetLastError_())
          EndIf
          CloseLibrary(lib)
     EndIf
EndProcedure

Procedure UnInit_Main()
     ; destruction de la brush
     If BrushBkgWindow
          DeleteObject_(BrushBkgWindow)
     EndIf
EndProcedure

Procedure ScrollAreaGadget_CallBack(Window, Message, wParam, lParam)
     Protected Resultat.l = CallWindowProc_(Old_ScrollGadget_Proc, Window, Message, wParam, lParam)
     
     Select Message
          Case #WM_PARENTNOTIFY
               Select wParam & $FFFF
                    Case #WM_LBUTTONDOWN, #WM_RBUTTONDOWN, #WM_MBUTTONDOWN
                         SetFocus_(Window)
                         Resultat = 0
               EndSelect
               
          Case #WM_LBUTTONDOWN, #WM_RBUTTONDOWN, #WM_MBUTTONDOWN
               SetFocus_(Window)
               Resultat = 0
     EndSelect
     ProcedureReturn Resultat
EndProcedure

Procedure DialogueCallBack(Window, Message, wParam, lParam)
     Protected ReturnValue = CallWindowProc_(Old_Dialogue_Proc, Window, Message, wParam, lParam)
     
     Select Message
          Case #WM_DESTROY
               FreegadgetEX(#ScrollAreaGadget_OpenFileRequesterIcone)
               FreegadgetEX(#ContainerGadget_OpenFileRequesterIcone)
               FreegadgetEX(#TextGadget_ScrollAreaGadget_OpenFileRequesterIcone)
               FreeFontEX(Font_Textegadget_Nb_Format_Icones)
               Font_Textegadget_Nb_Format_Icones = 0
               Free_ScrollArea_From_Images()
               ReturnValue = 0
               
          Case #WM_CTLCOLORSTATIC
               If IsGadget(#TextGadget_ScrollAreaGadget_OpenFileRequesterIcone) And lParam = GadgetID(#TextGadget_ScrollAreaGadget_OpenFileRequesterIcone)
                    ; on colorise le texte en blue
                    If BrushBkgWindow
                         SetBkMode_(wParam, #TRANSPARENT)
                         SetTextColor_(wParam, #Blue)
                         ReturnValue = BrushBkgWindow
                    EndIf
               EndIf
               
     EndSelect
     
     ProcedureReturn ReturnValue
EndProcedure

Procedure.l enumChildren(hwnd.l, *Var.EnumChidlDatas)
     Protected parentText.Chaine
     Protected childText.Chaine
     Protected classText.Chaine
     Protected rc1.RECT
     
     If hwnd = 0
          ProcedureReturn #Return_Error
     EndIf
     
     If GetDlgCtrlID_(hwnd) = 0
          ProcedureReturn #Return_Error
     EndIf
     
     If GetClassName_(hwnd, @classText, 256) = 0
          ProcedureReturn #Return_Error
     EndIf
     
     SendMessage_(hwnd, #WM_GETTEXT, 256, @childText)
     
     If PeekS(classText) = "SysListView32"
          hListIcon_Apercu = hwnd
     EndIf
     
     If PeekS(classText) = "ToolbarWindow32"
          If GetWindowRect_(hwnd, @rc1) = 0
               ProcedureReturn #Return_Error
          EndIf
         
          If ScreenToClient_(GetParent_(hwnd), @rc1) = 0
               ProcedureReturn #Return_Error
          EndIf
         
          If ScreenToClient_(GetParent_(hwnd), @rc1 + 8) = 0
               ProcedureReturn #Return_Error
          EndIf
          ; on compare avec les tailles de contenue par *rc.rect, si supérieur *rc.rect prend les valeurs
          ; on ne compare que la position en x car la Toolbar voulue est la plus proche du bord gauche
          If rc1\left<*Var\rc\left
               CopyMemory(@rc1, *Var\rc, SizeOf(RECT))
               *Var\Dialog = hwnd ; handle de la toolbar
          EndIf
         
     EndIf
     ProcedureReturn #True
EndProcedure

Procedure LoadImageEx(chaine$, *rc.AffichageMiniature)
     ; mémorise l'identifiant statique de l'image crée
     Protected Img
     ; Mémorise la largeur du ScrollAreaGadget
     Protected WidthGadgetMax.l
     ; Mémorise la hauteur du ScrollAreaGadget
     Protected HeightGadgetMax.l
     ; mémorise le ratio image origine
     Protected ratio_origine.f
     ; mémorise le ratio du gadget d(affichage
     Protected ratio_gadget.f
     ; mémorise le ratio de l'image affichée
     Protected ratio_dest.f
     ; mémorise un ratio temporaire
     Protected ratio_Temp.f
     ; mémorise la largeur de l'image redimensionnée
     Protected NewWidth
     ; mémorise la largeur de l'image redimensionnée
     Protected Newheight
     
     UseJPEGImageDecoder()
     UseJPEG2000ImageDecoder()
     UsePNGImageDecoder()
     UseTIFFImageDecoder()
     
     Img = LoadImage(#PB_Any, chaine$)
     If Img
          WidthGadgetMax = #largeurScrollAreaOpenfile-25-(#Offset_X_Icone_Apercu*2)
          HeightGadgetMax = GadgetHeight(#ScrollAreaGadget_OpenFileRequesterIcone)-(#Offset_Y_Icone_Apercu*2)-25
         
          ; récupération des tailles de l'image d'origine
          *Rc\Width = ImageWidth(Img)
          *Rc\Height = ImageHeight(Img)
         
          ; calcul du ratio image d'origine largeur/hauteur
          ratio_origine = *Rc\Width/*Rc\Height
         
          ; calcul du ratio gadget d'affichage largeur/hauteur
          ratio_gadget = WidthGadgetMax/HeightGadgetMax
         
          ; on redimensionne si un des côtés au moins est > au côté correspondant du gadget
          If (HeightGadgetMax> = *Rc\Height) And (WidthGadgetMax> = *Rc\Width)
               ; on ne redimensionne pas
               NewWidth = *Rc\Width
               Newheight = *Rc\Height
               *Rc\Reduction = #False
          Else ; (HeightGadgetMax < *Rc\Height) And (WidthGadgetMax < *Rc\Width)
               
               ratio_Temp = WidthGadgetMax/*Rc\Width
               ratio_dest = HeightGadgetMax/*Rc\Height
               
               ; on utilise le ratio le plus petit pour réduire l'image d'origine
               If ratio_Temp<ratio_dest
                    ratio_dest = ratio_Temp
               EndIf
               
               *Rc\Reduction = #True
               ; on redimensionne
               NewWidth = Round((*Rc\Width*ratio_dest), 0)
               Newheight = Round((*Rc\Height*ratio_dest), 0)
               ResizeImage(img, NewWidth, Newheight)
          EndIf
         
          ; fixe la valeur des éléments *Rc\X_Position et *Rc\Y_Position
          *Rc\X_Position = (#largeurScrollAreaOpenfile-NewWidth)/2
          If (#largeurScrollAreaOpenfile-NewWidth) & 1 ; impaire
               *Rc\X_Position-1
          EndIf
         
          *Rc\Y_Position = (HeightGadgetMax + 25 + (#Offset_Y_Icone_Apercu*2)-Newheight)/2
          If (HeightGadgetMax + 25 + (#Offset_Y_Icone_Apercu*2)-Newheight) & 1 ; impaire
               *Rc\Y_Position-1
          EndIf
         
          ProcedureReturn img
     Else
          ProcedureReturn #Return_Error
     EndIf
     
EndProcedure

Procedure Free_ScrollArea_From_Images()
     ; la procedure retire tous les gadgets du scrollarea du Dialogue GetOpenFileName_()
     If ListSize(Infos())
          ; on efface les éléments correspondants
          ForEach Infos()
               FreeImageEx(Infos()\StaticImageId) ; image
               If IsGadget(Infos()\StaticImageGadgetId)
                    SetGadgetState(Infos()\StaticImageGadgetId, 0)
                    FreeGadget(Infos()\StaticImageGadgetId) ; gadget utilisé pour afficher l'image
               EndIf
          Next
          ClearList(Infos())
     EndIf
     InvalidateRectEX(#ScrollAreaGadget_OpenFileRequesterIcone, #Null, #True)
EndProcedure

Procedure Affiche_Image(chaine$)
     ; mémorise le texte d'énumération de l'icône
     Protected Texte$
     ; mémorise le type de fichier
     Protected FileType.l
     ; mémorise l'identifiant des images bmp etc
     Protected Img.l
     ; mémorise la position de l'image réduite qui sera affichée (format BMP, PNG etc)
     Protected Rc.AffichageMiniature
     
     Free_ScrollArea_From_Images()
     If FileSize(chaine$)>0 And IsGadget(#ScrollAreaGadget_OpenFileRequesterIcone) And IsGadget(#ContainerGadget_OpenFileRequesterIcone)
          Free_ScrollArea_From_Images()
         
          Select LCase(Right(chaine$, 4))
                   
               Case ".bmp"
                    FileType = #BMP
                    Img = LoadImageEx(chaine$, @rc)
                   
               Case ".jpg"
                    FileType = #JPG
                    Img = LoadImageEx(chaine$, @rc)
                   
               Case ".png"
                    FileType = #PNG
                    Img = LoadImageEx(chaine$, @rc)
                   
               Case ".tif"
                    FileType = #TIF
                    Img = LoadImageEx(chaine$, @rc)
                   
          EndSelect
         
          Select FileType
                    ;-#BMP, #JPG
               Case #BMP, #JPG, #PNG
                    ; on masque le scrollaragadget
                    HideGadget(#ScrollAreaGadget_OpenFileRequesterIcone, 1)
                    ; on affiche la listviewgadget
                    HideGadget(#ContainerGadget_OpenFileRequesterIcone, 0)
                    If Img<>#Return_Error
                         If AddElement(Infos())
                              Infos()\StaticImageId = Img
                              Infos()\StaticImageGadgetId = ImageGadget(#PB_Any, Rc\X_Position, Rc\Y_Position, 0, 0, ImageID(Img))
                             
                              If Infos()\StaticImageGadgetId
                                   If Rc\reduction
                                        Texte$ = "Image réduite - "
                                   Else
                                        Texte$ = "Image non réduite - "
                                   EndIf
                                   Texte$ + Str(rc\Width) + " x " + Str(rc\height) + " pixels"
                                   SetGadgetTextEx(#TextGadget_ScrollAreaGadget_OpenFileRequesterIcone, Texte$)
                              EndIf
                         EndIf
                    EndIf
                   
                   
          EndSelect
         
     EndIf
EndProcedure


Procedure.l OFHookProc(hdlg, Message, wParam, *lParam.OFNOTIFY)
     ; ; mémorise l'identifiant système du dialogue
     Protected hDialog.l
     ; résultat de la fonction
     Protected Resultat = #False
     ; retrouve les coordonnées du bureau et de la boite de dialogue
     Protected wr.RECT, wr1.RECT, rcc.RECT
     ; mémorise le handle du parent de la boite de dialogue
     Protected Parent_hdlg.l
     ; mémorise l'adresse du buffer mémoire de 31 Ko
     Protected *FileBuffer.long
     ; mémorise le chemin du fichier
     Protected Path$
     ; mémorise la longuer du chemin
     Protected Path_Lenght.l
     ; mémorise les coordonnées de la Toolbar de gauche qui ne s'affiche pas bien avec les thèmes XP
     Protected rc.RECT
     ; mémorise les coordonnées de la zone client de la boite de dialogue
     Protected clientRect.rect
     ; mémorise les coordonnées de la boite de dialogue
     Protected windowrect.rect
     ; mémorise les coordonnées de de la boite de dialogue lors de l'énumération et son handle
     Protected ToolBarGauche.EnumChidlDatas
     ; mémorise les coordonnées du bouton Annuler
     Protected Cancel.RECT
     ; mémorise la hauteur calculée de la toobar pour redimensionnement eventuel
     Protected HauteurToolBar.l
     ; mémorise les écarts entre la zone client de la boite dialogue et ses coordonnée entières de la fenêtre
     ; est utilisé pour déterminer s'il faut ou non redimensionner, cette variable est aussi utilisée pour
     ; calculer l'offset à appliquer aux bouton Annuler et Ok
     Protected ecartWindow.l
     ; mémorise le texte de plusieurs fichiers sélectionnés
     Protected Texte$
     ; mémorise l'identifiant de la zone propre du scrollareagadget
     Protected hWnd_ScrollArea
     ; mémorise si la fenêtre Getopenfilename a déjà été modifiée
     Protected GetOpenfilename_modifer
     
     Select Message
          Case #WM_INITDIALOG
               Parent_hdlg.l = GetParent_(hdlg)
               If Parent_hdlg = 0
                    Resultat = #True
               Else
                    Old_Dialogue_Proc = SetWindowLong_(Parent_hdlg, #GWL_WNDPROC, @DialogueCallBack())
               EndIf
               If GetWindowRect_(Parent_hdlg, wr.RECT) And GetWindowRect_(GetDesktopWindow_(), wr1.RECT)
                    If ((wr1\right/2)-((wr\right + #largeurScrollAreaOpenfile + 10)/2)>20) And (((wr1\bottom/2)-((wr\bottom)/2))>20)
                         MoveWindow_(Parent_hdlg, (wr1\right/2)-((wr\right + #largeurScrollAreaOpenfile + 10)/2), ((wr1\bottom/2)-((wr\bottom)/2)), wr\right + #largeurScrollAreaOpenfile + 30, wr\bottom-wr\top, #True)
                    EndIf
               EndIf
               If UseGadgetList(Parent_hdlg)
                    hDialog = GetDlgItem_(Parent_hdlg, #lst1)
                    If hDialog
                         If GetWindowRect_(hDialog, wr.RECT) And ScreenToClient_(hdlg, wr.RECT) And ScreenToClient_(hdlg, @wr\right)
                              wr1\left = -10
                              GetWindowRect_(GetDlgItem_(Parent_hdlg, #IDCANCEL), wr1.RECT)
                              ScreenToClient_(hdlg, wr1.RECT)
                              ScreenToClient_(hdlg, @wr1\right)
                              ; création du scrollAreaGadget perso
                              If ScrollAreaGadget(#ScrollAreaGadget_OpenFileRequesterIcone, wr\right + 20, wr\top + 22, #largeurScrollAreaOpenfile, wr1\bottom-wr\top-20, #largeurScrollAreaOpenfile-25, wr1\bottom-wr\top-40, 55, #PB_ScrollArea_Flat)
                                   hWnd_ScrollArea = FindWindowEx_(GadgetID(#ScrollAreaGadget_OpenFileRequesterIcone), 0, "PureScrollAreaChild", 0)
                                   If hWnd_ScrollArea
                                        Old_ScrollGadget_Proc = SetWindowLong_(hWnd_ScrollArea, #GWL_WNDPROC, @ScrollAreaGadget_CallBack())
                                   EndIf
                                   SetGadgetColorEX(#ScrollAreaGadget_OpenFileRequesterIcone, #PB_Gadget_BackColor, #CoulerFondScrollarea_Getopenfilename)
                                   SetGadgetAttribute(#ScrollAreaGadget_OpenFileRequesterIcone, #PB_ScrollArea_InnerWidth, #largeurScrollAreaOpenfile-25)
                                   ShowScrollBarEx(#ScrollAreaGadget_OpenFileRequesterIcone, #SB_VERT, #True)
                                   CloseGadgetList()
                                   TextGadget(#TextGadget_ScrollAreaGadget_OpenFileRequesterIcone, wr\right + 40, GadgetY(#ScrollAreaGadget_OpenFileRequesterIcone)-25, #largeurScrollAreaOpenfile-20, 20, "", #PB_Text_Center)
                                   SetgadgetfontEX(#TextGadget_ScrollAreaGadget_OpenFileRequesterIcone, Font_Textegadget_Nb_Format_Icones)
                              EndIf
                              ; création de la ListGadget perso
                              If ContainerGadget(#ContainerGadget_OpenFileRequesterIcone, wr\right + 20, wr\top + 22, #largeurScrollAreaOpenfile, wr1\bottom-wr\top-20, #PB_Container_Flat)
                                   SetGadgetColor(#ContainerGadget_OpenFileRequesterIcone, #PB_Gadget_BackColor, #White)
                                   HideGadget(#ContainerGadget_OpenFileRequesterIcone, 1)
                                   If IsGadget(#TextGadget_ScrollAreaGadget_OpenFileRequesterIcone) = 0
                                        TextGadget(#TextGadget_ScrollAreaGadget_OpenFileRequesterIcone, wr\right + 40, GadgetY(#ContainerGadget_OpenFileRequesterIcone)-25, #largeurScrollAreaOpenfile-20, 20, "", #PB_Text_Center)
                                        SetgadgetfontEX(#TextGadget_ScrollAreaGadget_OpenFileRequesterIcone, Font_Textegadget_Nb_Format_Icones)
                                   EndIf
                              EndIf
                         EndIf
                    EndIf
               EndIf
               Resultat = #True
               
          Case #WM_NOTIFY
               *FileBuffer = *lParam\lpOFN\lCustData
               If (_WIN32_WINNT> = $0501) And (GetOpenfilename_modifer = #False)
                    ; on retrouve les coordonnées de la toolbar et de son handle
                    ; on force ToolBarGauche\rc\left à une grande valeur pour que le teste dans EnumChildWindows_ soit Ok
                    ToolBarGauche\rc\left = 65534
                    EnumChildWindows_(*lParam\hdr\hwndFrom, @enumChildren(), @ToolBarGauche)
                    If Nb_Button_ToolBarGetOpenFileName< = 0
                         Nb_Button_ToolBarGetOpenFileName = SendMessage_(ToolBarGauche\dialog, #TB_BUTTONCOUNT, 0, 0)
                         If Nb_Button_ToolBarGetOpenFileName
                              ; on réinitialise la fenêtre et le contrôle si besoin
                              ; on retrouve la taille des boutons
                              ; retrouve les coordonnées du dernier bouton
                              If SendMessage_(ToolBarGauche\dialog, #TB_GETITEMRECT, Nb_Button_ToolBarGetOpenFileName-1, @rc)
                                   ; calcul de la hauteur ToolBar
                                   If GetWindowRect_(*lParam\hdr\hwndFrom, windowrect.RECT) And GetClientRect_(*lParam\hdr\hwndFrom, @clientRect)
                                        HauteurToolBar = rc\bottom + (Nb_Button_ToolBarGetOpenFileName*((SendMessage_(ToolBarGauche\dialog, #TB_GETPADDING, 0, 0)>>16) & $FFFF))
                                        ; calcul de la différence entre la zone client de la fenêtre et la fenêtre
                                        ecartWindow.l = (windowrect\bottom-windowrect\top)-(clientRect\bottom-clientRect\top)
                                        ; on vérifie avant de modifier si le point bas de la toolbar \bottom est inférieur au point bas du boutton annuler
                                        ; si c'est le cas on modifie, sinon on laisse
                                        If GetWindowRect_(GetDlgItem_(*lParam\hdr\hwndFrom, #IDCANCEL), Cancel.RECT); And (_WIN32_WINNT >= $0600)
                                             If ScreenToClient_(*lParam\hdr\hwndFrom, @Cancel\right)
                                                  ; on teste si la hauteur de la toolbar des boutons à gauche dépasse le point bas du bouton "Quitter"
                                                  If HauteurToolBar>Cancel\bottom
                                                       ; cette valeur sera ajoutée à la valeur de la hauteur de la toolbar pour dimensionner la boite de dialogue correctement
                                                       ; on augmente la taille de la fenêtre du dialogue
                                                       MoveWindow_(*lParam\hdr\hwndFrom, windowrect\left, windowrect\top, windowrect\right-windowrect\left, HauteurToolBar + ToolBarGauche\rc\top + ecartWindow, #True)
                                                       ; on rectifie la taille de la toolbar des boutons à gauche pour qu'elle ne soit pas trop grande par rapport aux nombre de boutons
                                                       HauteurToolBar-((Nb_Button_ToolBarGetOpenFileName)*((SendMessage_(ToolBarGauche\dialog, #TB_GETPADDING, 0, 0)>>16) & $FFFF)) + 2
                                                       
                                                       MoveWindow_(ToolBarGauche\dialog, ToolBarGauche\rc\left, ToolBarGauche\rc\top, ToolBarGauche\rc\right-ToolBarGauche\rc\left, HauteurToolBar, #True)
                                                       ; on décale les 2 boutons OK et Cancel et les 2 texte gadget qui vont avec
                                                       ; on descend le bouton cancel, on retrouve les coordonnées de la fenêtre déplacée
                                                       If GetWindowRect_(GetDlgItem_(*lParam\hdr\hwndFrom, #IDCANCEL), wr1.RECT) And GetWindowRect_(*lParam\hdr\hwndFrom, windowrect.RECT)
                                                            ecartWindow = (windowrect\bottom-wr1\bottom)/2
                                                            If ScreenToClient_(*lParam\hdr\hwndFrom, @wr1) And ScreenToClient_(*lParam\hdr\hwndFrom, @wr1 + 8)
                                                                 ; calcul de l'écart entre la partie basse du bouton et celle de la fenêtre, le tout divisé par 2
                                                                 MoveWindow_(GetDlgItem_(*lParam\hdr\hwndFrom, #IDCANCEL), wr1\left, wr1\top + ecartWindow, wr1\right-wr1\left, wr1\bottom-wr1\top, #True)
                                                            EndIf
                                                       EndIf
                                                       ; on repositionne le scrollarea juste après le déplacement du bouton cancel car on a ses coordonnées avec wr1
                                                       ResizeGadgetEx(#ScrollAreaGadget_OpenFileRequesterIcone, #PB_Ignore, #PB_Ignore, #PB_Ignore, GadgetHeight(#ScrollAreaGadget_OpenFileRequesterIcone) + (ecartWindow))
                                                       ResizeGadgetEx(#ContainerGadget_OpenFileRequesterIcone, #PB_Ignore, #PB_Ignore, #PB_Ignore, GadgetHeight(#ContainerGadget_OpenFileRequesterIcone) + (ecartWindow-2))
                                                       
                                                       If GetWindowRect_(GetDlgItem_(*lParam\hdr\hwndFrom, #cmb1), wr1.RECT)
                                                            If ScreenToClient_(*lParam\hdr\hwndFrom, @wr1) And ScreenToClient_(*lParam\hdr\hwndFrom, @wr1 + 8)
                                                                 MoveWindow_(GetDlgItem_(*lParam\hdr\hwndFrom, #cmb1), wr1\left, wr1\top + ecartWindow, wr1\right-wr1\left, wr1\bottom-wr1\top, #True)
                                                            EndIf
                                                       EndIf
                                                       If GetWindowRect_(GetDlgItem_(*lParam\hdr\hwndFrom, #stc2), wr1.RECT)
                                                            If ScreenToClient_(*lParam\hdr\hwndFrom, @wr1) And ScreenToClient_(*lParam\hdr\hwndFrom, @wr1 + 8)
                                                                 MoveWindow_(GetDlgItem_(*lParam\hdr\hwndFrom, #stc2), wr1\left, wr1\top + ecartWindow, wr1\right-wr1\left, wr1\bottom-wr1\top, #True)
                                                            EndIf
                                                       EndIf
                                                       
                                                       ecartWindow*2/3
                                                       If GetWindowRect_(GetDlgItem_(*lParam\hdr\hwndFrom, #IDOK), wr1.RECT)
                                                            If ScreenToClient_(*lParam\hdr\hwndFrom, @wr1) And ScreenToClient_(*lParam\hdr\hwndFrom, @wr1 + 8)
                                                                 MoveWindow_(GetDlgItem_(*lParam\hdr\hwndFrom, #IDOK), wr1\left, wr1\top + ecartWindow, wr1\right-wr1\left, wr1\bottom-wr1\top, #True)
                                                            EndIf
                                                       EndIf
                                                       If GetWindowRect_(GetDlgItem_(*lParam\hdr\hwndFrom, #cmb13), wr1.RECT)
                                                            If ScreenToClient_(*lParam\hdr\hwndFrom, @wr1) And ScreenToClient_(*lParam\hdr\hwndFrom, @wr1 + 8)
                                                                 MoveWindow_(GetDlgItem_(*lParam\hdr\hwndFrom, #cmb13), wr1\left, wr1\top + ecartWindow, wr1\right-wr1\left, wr1\bottom-wr1\top, #True)
                                                            EndIf
                                                       EndIf
                                                       ; texte "Nom du fichier"
                                                       If GetWindowRect_(GetDlgItem_(*lParam\hdr\hwndFrom, #stc3), wr1.RECT)
                                                            If ScreenToClient_(*lParam\hdr\hwndFrom, @wr1) And ScreenToClient_(*lParam\hdr\hwndFrom, @wr1 + 8)
                                                                 MoveWindow_(GetDlgItem_(*lParam\hdr\hwndFrom, #stc3), wr1\left, wr1\top + ecartWindow, wr1\right-wr1\left, wr1\bottom-wr1\top, #True)
                                                            EndIf
                                                       EndIf
                                                  Else
                                                       ; on ne modifie pas car pas besoin et la boite a été centré en WM_InitDialog
                                                  EndIf
                                             EndIf
                                        EndIf
                                   EndIf
                              EndIf
                         EndIf
                    EndIf
               EndIf
               
               Select *lParam\hdr\code
                    Case #CDN_INITDONE
                         GetOpenfilename_modifer = #True
                         
                         
                         ;- #CDN_FOLDERCHANGE, #CDN_TYPECHANGE
                    Case #CDN_FOLDERCHANGE, #CDN_TYPECHANGE
                         ShowScrollBarEx(#ScrollAreaGadget_OpenFileRequesterIcone, #SB_HORZ, #False)
                         SetgadgetfontEX(#TextGadget_ScrollAreaGadget_OpenFileRequesterIcone, Font_Textegadget_Nb_Format_Icones)
                         SendMessage_(*lParam\hdr\hwndFrom, #CDM_SETCONTROLTEXT, #edt1, @"")
                         If IsGadget(#ScrollAreaGadget_OpenFileRequesterIcone)
                              SetGadgetTextEx(#TextGadget_ScrollAreaGadget_OpenFileRequesterIcone, "")
                              Free_ScrollArea_From_Images()
                         EndIf
                         
                         ;- #CDN_SELCHANGE
                    Case #CDN_SELCHANGE
                         If *lParam\hdr\code = #CDN_SELCHANGE
                              ShowScrollBarEx(#ScrollAreaGadget_OpenFileRequesterIcone, #SB_HORZ, #False)
                              If IsGadget(#ScrollAreaGadget_OpenFileRequesterIcone)
                                   Free_ScrollArea_From_Images()
                                   
                                   ; on vide la liste de ses éléments
                                   PokeL(*FileBuffer, 0) ; on remet la chaine à 0
                                   ; avant d'afficher, on vérifie que le fichier est bien dans la zone d'écriture des noms de fichiers
                                   SendMessage_(*lParam\hdr\hwndFrom, #CDM_GETSPEC, #Maxi_File_Buffer_31_Ko, *FileBuffer)
                                   ; on compte les " contenu dans la chaine
                                   If _UPeekB(*FileBuffer) = '"'
                                        ; remet les scrollbar à 0
                                        SetGadgetAttribute(#ScrollAreaGadget_OpenFileRequesterIcone, #PB_ScrollArea_InnerHeight, GadgetHeight(#ScrollAreaGadget_OpenFileRequesterIcone)-20)
                                        SetGadgetAttribute(#ScrollAreaGadget_OpenFileRequesterIcone, #PB_ScrollArea_InnerWidth, #largeurScrollAreaOpenfile-25)
                                        Texte$ = "Plusieurs éléments sont sélectionnés"
                                   ElseIf _UPeekB(*FileBuffer)
                                        ; on teste que c'est un fichier et pas un dossier
                                        Path_Lenght = 1
                                        Path$ = Space(Path_Lenght)
                                        Path_Lenght = SendMessage_(*lParam\hdr\hwndFrom, #CDM_GETFILEPATH, Path_Lenght, @Path$)
                                        If Path_Lenght>0
                                             Path$ = Space(Path_Lenght-1)
                                             If Len(Path$) = Path_Lenght-1
                                                  ; Path_Lenght = SendMessage_(*lParam\hdr\hwndFrom, #CDM_GETFOLDERPATH, Path_Lenght, @Path$)
                                                  Path_Lenght = SendMessage_(*lParam\hdr\hwndFrom, #CDM_GETFILEPATH, Path_Lenght, @Path$)
                                                  ; on teste si c'est un lien, fichier lnk
                                                  ; si oui, on ne fait rien, sinon, c'est un fichier à afficher
                                                  If LCase(Right(PeekS(*FileBuffer), #Link_extensionFile_Length))<>#Link_extensionFile
                                                       Path$ = GetPathPart(Path$)
                                                       If Len(Path$)
                                                            If Right(Path$, 1)<>"\"
                                                                 Path$ + "\"
                                                            EndIf
                                                            If FileSize(Path$ + PeekS(*FileBuffer))> = 0
                                                                 
                                                                 ; *********************************************
                                                                 ; c'est ici que l'on affiche l'image sélectionnée
                                                                 
                                                                 Affiche_Image(Path$ + PeekS(*FileBuffer))
                                                                 
                                                                 ; *********************************************
                                                                 
                                                            EndIf
                                                       EndIf
                                                  EndIf
                                             EndIf
                                        EndIf
                                   EndIf
                              EndIf
                         EndIf
               EndSelect
               Resultat = #True
     EndSelect
     
     ProcedureReturn Resultat
EndProcedure

Procedure.l Open_FileRequester(InitialDir$, Pattern.l, PatternPosition.l, buffer.l)
Protected Resultat.l
Protected lpofn.OPENFILENAMEXP

lpofn\lStructSize = SizeOf(OPENFILENAMEXP)
lpofn\hwndOwner = hMainWindow
lpofn\hInstance = #Null
lpofn\lpstrFilter = pattern
lpofn\lpstrCustomFilter = #Null
lpofn\nMaxCustFilter = #Null
lpofn\nFilterIndex = PatternPosition
lpofn\lpstrFile = buffer
lpofn\nMaxFile = #Maxi_File_Buffer_31_Ko
lpofn\lpstrFileTitle = #Null
lpofn\nMaxFileTitle = #Null
lpofn\lpstrInitialDir = @InitialDir$ ; Windows 2000/XP et > sinon voir la définition
lpofn\lpstrTitle = @"Ouvrir les fichiers"
lpofn\flags = #OFN_HIDEREADONLY | #OFN_EXPLORER | #OFN_ENABLEHOOK | #OFN_ALLOWMULTISELECT | #OFN_FILEMUSTEXIST | #OFN_FORCESHOWHIDDEN | #OFN_SHAREAWARE | #OFN_PATHMUSTEXIST
lpofn\nFileOffset = 0
lpofn\nFileExtension = 0
lpofn\lpstrDefExt = 0
lpofn\lCustData = buffer
lpofn\lpfnHook = @OFHookProc()
lpofn\lpTemplateName = 0
lpofn\pvReserved = 0
lpofn\FlagsEx = 0

Font_Textegadget_Nb_Format_Icones = LoadFont(#PB_Any, "TAHOMA", 9, #PB_Font_Italic | #PB_Font_HighQuality)

EnableWindow_(WindowID(#MainWindow), #False)

Nb_Button_ToolBarGetOpenFileName = #False
If GetOpenFileName_(@lpofn)
     Resultat = #True
Else
     Resultat = -CommDlgExtendedError_()
EndIf
EnableWindow_(WindowID(#MainWindow), #True)

ProcedureReturn Resultat
EndProcedure

Procedure.s Open_FileRequesterEx(InitialDir$, Pattern, PatternPosition, *ReturnedFilesNumber)
Protected *FileBuffer
Protected nb_files
Protected getFile$ = ""
Protected No_Error

*FileBuffer = AllocateMemory(#Maxi_File_Buffer_31_Ko) ; 31 Ko alloué pour la chaîne
If *FileBuffer = 0
     ProcedureReturn getFile$
EndIf

No_Error = Open_FileRequester(InitialDir$, Pattern, PatternPosition, *FileBuffer)
If Len(PeekS(*FileBuffer))
     If No_Error = #True
          If FileSize(GetFilePart(PeekS(*FileBuffer)))<0
               ; on met une virgule à la place des 0 pour séparer les fichiers et le chemin également
               ; si il y a un double 0, c'est la fin de chaine, on termine sans mettre de virgule
               ; le nombre de fichiers est le nobre de virgule
               ! xor ecx, ecx ; ecx mémorise le nombre de virgules
               ! mov eax, [p.p_FileBuffer] ; eax = adresse zone mémoire
               ! boucle :
               ! inc eax ; eax pointe le 1er élément
               ! cmp word [eax], 0 ; teste si c'est un double 0, si oui on quite
               ! je quit
               ! cmp byte [eax], 0 ; il n'y a pas de double 0, on teste le 0 simple
               ! je virgule ; si = 0 on met une virgule
               ! jmp boucle
               ! virgule :
               ! mov byte [eax], ","
               ! inc ecx
               ! jmp boucle
               ! quit :
               ! mov eax, [p.p_ReturnedFilesNumber] ; i vaut le nombre de fichier contenu dans la chaine
               ! mov [eax], ecx ; i vaut le nombre de fichiers contenu dans la chaine
          Else
               ; un seul fichier de sélectionné
               ! mov ecx, 1
          EndIf
          ! mov eax, [p.p_ReturnedFilesNumber] ; i vaut le nombre de fichier contenu dans la chaine
          ! mov [eax], ecx
          getFile$ = PeekS(*FileBuffer)
     Else
          ; GetOpenFileName_ retourne nonzero si c'est OK
          ; sinon retourne 0 et il faut tester CommDlgExtendedError_()
          ; ici GetOpenFileName a retourné 0
          ;
          ; GetOpenFileName_() retourne 0
          ; si CommDlgExtendedError_() = 0 --> le bouton cancel a été activé, on ne fait rien
          ;
          ; on met le compteur de fichier à 0
          ! mov eax, [p.p_ReturnedFilesNumber] ; i vaut le nombre de fichier contenu dans la chaine
          ! sub ecx, ecx ; ecx vaut le nombre de fichiers contenu dans la chaine soit 0 ici
          ! mov [eax], ecx
         
          ; on traite les erreurs
          ; si CommDlgExtendedError_() = 0 --> le bouton cancel a été activé, on ne fait rien
          If No_Error
               MessageRequester("Error/Erreur", "An error system has occur, no file names returned" + Chr(13) + Chr(13) + "Une erreur système est arrivéee, aucun nom de fichier renvoyé")
          EndIf
     EndIf
EndIf
FreeMemory(*FileBuffer)
ProcedureReturn getFile$
EndProcedure



;- Code principal
hMainWindow = OpenWindow(#MainWindow, Ecran\left, Ecran\top, Largeur_Ecran, Hauteur_Ecran, "Openfilerequester et miniatures", #Option_Fenetre)
If hMainWindow = 0
     MessageRequester("Erreur système", "La création de la fenêtre principale a échouée." + #CRLF + "L'application va se terminer.", 16)
     End
EndIf
Init_Main()

;ShowWindow_(hMainWindow, #SW_SHOWMAXIMIZED)

Open_FileRequesterEx("C:\" + "\JPG", ?Patern_Ico, 1, @FileNumber)


; ShowWindow_(hMainWindow, #SW_SHOWMAXIMIZED)

; ;- Boucle
; Repeat
     ; Select WaitWindowEvent()
               ;
          ; Case #PB_Event_CloseWindow
               ; Quitter_Application = #True
               ;
     ; EndSelect
; Until Quitter_Application

; restauration de la mémoire etc
UnInit_Main()
DisableASM
End

DataSection
     Patern_Ico : ; filtre pour les fichiers au format ico, dll, exe, icl etc
     Data.s "Tous formats"
     Data.s "*.ani;*.cur;*.icl;*.ico;*.dll;*.exe;*.bmp;*.jpg;*.png;*.tif;*.tiff"
     Data.s "icones (*.icl;*.ico;*.dll;*.exe)"
     Data.s "*.icl;*.ico;*.dll;*.exe"
     Data.s "Bibliothèques d'icône (*.icl)"
     Data.s "*.icl"
     Data.s "Curseurs (*.ani, *.cur)"
     Data.s "*.ani;*.cur"
     Data.s "Images (*.bmp, *.jpg, *.png, *.tif, *.tiff)"
     Data.s "*.bmp;*.jpg;*.png;*.tif;*.tiff"
     ; Data.s "Curseurs animés(*.ani)"
     ; Data.s "*.ani"
     ; Data.s "Curseurs simples(*.cur)"
     ; Data.s "*.cur"
     Data.w 0 ; double 0 de fin de chaine signalant la fin des filtres de la boîte
EndDataSection
Créé le 27 novembre 2008  par Denis

Cet utilitaire permet d'intégrer une image dans le code source. Les données de l'image sont compressées pour réduire la taille dans le programme.
Lancez ce code, une fenêtre apparait avec une cible, faites glisser une image sur cette cible (drag and drop) et suivez les instructions.
Un fichier sera généré, vous n'avez plus qu'à l'intégrer dans votre programme.

 
Sélectionnez


;**************************************************************
; Program:           PicPak
; Author:            netmaestro
; Date:              April 15, 2006
; Target OS:         Microsoft Windows All
; Target Compiler:   PureBasic 4.xx
; License:           Free, unrestricted, credit appreciated
;                    but not required
;**************************************************************

Declare CreateDataSection(picin.s)

Procedure.s GetDroppedFile()
  buf.s=Space(DragQueryFile_(EventwParam(),0,0,0))
  DragQueryFile_(EventwParam(), 0, buf, Len(buf)+1)
  DragFinish_(EventwParam())
  ProcedureReturn buf
EndProcedure

line$=Chr(10)
line$+ "          Written in PureBasic by netmaestro, April 2006"+Chr(10)+Chr(10)
line$+ "          100% free to use, distribute, reverse-engineer,"+Chr(10)
line$+ "          repackage and say you wrote it, anything you want"+Chr(10)
line$+ "          to do with it is A-OK with me"+Chr(10)

use$=""+Chr(10)
use$ + Space(3) + "1. Drop an image file on the window"+Chr(13)+Chr(10)+Chr(10)
use$ + Space(3) + "2. Select a label name"+Chr(13)+Chr(10)+Chr(10)
use$ + Space(3) + "3. Look for Temp.pbi in this folder"+Chr(13)+Chr(10)+Chr(10)
use$ + Space(3) + "4. The #image img0 will be ready to use!"+Chr(13)+Chr(10)+Chr(10)

CreateImage(0, 512,512,32)
StartDrawing(ImageOutput(0))
  Box(0,0,512,512,GetSysColor_(#COLOR_BTNFACE))
  Circle(256,256,256,#Red)
  Circle(256,256,200,#White)
  Circle(256,256,145,#Red)
  Circle(256,256,80,#White)
  Circle(256,256,40,#Red)
StopDrawing()
ResizeImage(0,120,120)

OpenWindow(0,0,0,150,170,"PicPak",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
CreateGadgetList(WindowID(0))
ImageGadget(0,15,15,0,0,ImageID(0))
DisableGadget(0,1)
DragAcceptFiles_ (WindowID(0), #True)
StickyWindow(0,#True)

If CreateMenu(0, WindowID(0))
   MenuTitle("Menu")
   MenuItem( 1, "Usage")
   MenuItem( 2, "About...")
EndIf

source.s = ProgramParameter()
If source
  CreateDataSection(source)
EndIf

Repeat
  ev=WaitWindowEvent()
  Select ev
    Case #WM_DROPFILES
      Source.s = GetDroppedFile()
      ext.s = GetExtensionPart(source)
      If FindString("BMP JPG JPEG TIF PNG", UCase(ext),1)
        CreateDataSection(source)
      Else
        StickyWindow(0,#False)
        MessageRequester("Problem","File must be:  BMP, JPG, PNG or TIF",#MB_ICONERROR)
        StickyWindow(0,#True)
      EndIf
    Case #PB_Event_Menu
      Select EventMenu()
        Case 1
          StickyWindow(0,#False)
          MessageRequester("How to use PicPak",use$,$C0)
          StickyWindow(0,#True)
        Case 2
          StickyWindow(0,#False)
          MessageRequester("About PicPak",line$, $C0)
          StickyWindow(0,#True)
      EndSelect
  EndSelect
Until ev=#WM_CLOSE

Procedure CreateDataSection(picin.s)
  Pattern$ = "BMP (*.bmp)|*.bmp|JPEG (*.jpg)|*.jpg|PNG (*.png)|*.png|TIFF (*.tif)|*.tif"
  If picin = " "
    picin.s = OpenFileRequester("Choose an image file", "", pattern$, 0)
  EndIf
  ext.s = GetExtensionPart(picin)
  If ReadFile(0,picin)
    FileLength = Lof(0)
    *Source = AllocateMemory(FileLength)
    *Target = AllocateMemory(FileLength+8)
    If FileLength And *Source And *Target
      ReadData(0, *Source, FileLength)
      CompressedLength = PackMemory(*Source, *Target, FileLength, 9)
      If CompressedLength
        DecompressedLength = UnpackMemory(*Target, *Source)
        If DecompressedLength = FileLength
          StickyWindow(0,#False)
          MessageRequester("Info", "Compression succeeded:"+Chr(10)+Chr(10)+"Old size: "+Str(FileLength)+Chr(10)+"New size: "+Str(CompressedLength), #MB_ICONINFORMATION)
          StickyWindow(0,#True)
          FreeMemory(*source)
          *Source = AllocateMemory(compressedLength)
          CopyMemory(*target,*source,compressedlength)         
        EndIf   
      Else 
        compressedlength=filelength
        StickyWindow(0,#False)
        MessageRequester("Info", "Compression not needed", #MB_ICONINFORMATION)
        StickyWindow(0,#True)
      EndIf
      StickyWindow(0,#False)
      label.s = InputRequester("Label Input","Enter a label For the DataSection: ","PicPak:")
      If Trim(label)=""
        label="picpak"
      EndIf
      label="  "+label
      StickyWindow(0,#True)
      label=RemoveString(label,":")
      endlabel.s = label+"end:"
      label+":"
      If CreateFile(1,GetHomeDirectory()+"temp.pbi")
        WriteStringN(1,""):clip$=Chr(10)
        Select ext
          Case "jpg"
            WriteStringN(1,"UseJPEGImageDecoder()"):clip$+"UseJPEGImageDecoder()"+Chr(10)
          Case "png"
            WriteStringN(1,"UsePNGImageDecoder()"):clip$+"UsePNGImageDecoder()"+Chr(10)
          Case "tif"
            WriteStringN(1,"UseTIFFImageDecoder()"):clip$+"UseTIFFImageDecoder()"+Chr(10)
        EndSelect
        If compressedlength<>filelength
          WriteStringN(1,"*unpacked = AllocateMemory("+Str(Filelength)+")")
          WriteStringN(1,"UnpackMemory(?"+Trim(RemoveString(label,":"))+", *unpacked)")
          WriteStringN(1,"img0 = CatchImage(#PB_Any, *unpacked, "+Str(Filelength)+")")
          clip$+"*unpacked = AllocateMemory("+Str(Filelength)+")"+Chr(10)
          clip$+"UnpackMemory(?"+Trim(RemoveString(label,":"))+", *unpacked)"+Chr(10)
          clip$+"img0 = CatchImage(#PB_Any, *unpacked, "+Str(Filelength)+")"+Chr(10)
        Else
          WriteStringN(1,"img0 = CatchImage(#PB_Any, ?" + Trim(RemoveString(label,":")) + ", "+Str(Filelength)+")")
          clip$+"img0 = CatchImage(#PB_Any, ?" + Trim(RemoveString(label,":")) + ", "+Str(Filelength)+")"+Chr(10)
        EndIf
        clip$+Chr(10)
        SetClipboardText(clip$)
        WriteStringN(1,"")
        WriteStringN(1,"Datasection")
        WriteStringN(1,label)
        WriteString(1,"  Data.b ")
        c=0
        For i = 0 To compressedlength-1
          If i=compressedlength-1
            lastbyte=#True
          Else
            lastbyte=#False
          EndIf
          c+1
          If c >= 20 Or lastbyte
            c = 0
            WriteStringN(1, "$"+RSet(Hex(PeekC(*source+i)),2,"0"))
            If Not lastbyte
              WriteString(1,"  Data.b ")
            EndIf
          Else
            WriteString(1, "$"+RSet(Hex(PeekC(*source+i)),2,"0")+",")
          EndIf
        Next
        WriteStringN(1,endlabel)
        WriteStringN(1,"EndDatasection")
        CloseFile(1)
        FreeMemory(*Source)
        FreeMemory(*Target)
        CloseFile(0)
        MessageRequester("Success!","Temp.pbi successfully created: "+GetHomeDirectory()+"temp.pbi")
      Else
        MessageRequester("Problem","Could not open the output file")
      EndIf
    Else
      MessageRequester("Problem","Could not allocate the memory... file too large?")
    EndIf
  Else
    MessageRequester("Problem","Could not open input file")
  EndIf
EndProcedure

Exemple de fichier généré :

 
Sélectionnez

*unpacked = AllocateMemory(1142)
UnpackMemory(?Poubelle, *unpacked)
img0 = CatchImage(#PB_Any, *unpacked, 1142)

DataSection
  Poubelle:
  Data.b $4A,$43,$76,$04,$00,$00,$77,$4D,$F0,$08,$14,$6A,$E2,$20,$15,$36,$3C,$EA,$03,$45
  Data.b $26,$1A,$12,$45,$9A,$14,$80,$27,$04,$A4,$81,$08,$33,$46,$8F,$60,$CC,$80,$96,$A0
  Data.b $11,$38,$98,$34,$0D,$7A,$F0,$71,$6C,$0E,$0A,$86,$E5,$BF,$50,$D1,$00,$04,$BF,$28
  Data.b $55,$A6,$EC,$D7,$04,$F0,$1F,$F8,$60,$89,$FD,$AF,$17,$6E,$C6,$13,$DA,$43,$8F,$3E
  Data.b $BF,$71,$2A,$F0,$AE,$D9,$36,$25,$BC,$6D,$5F,$BE,$AF,$FD,$74,$C4,$FD,$97,$D7,$9D
  Data.b $57,$32,$6D,$02,$E0,$CC,$37,$EF,$BC,$79,$D9,$23,$9F,$A0,$C9,$5D,$BA,$CF,$F8,$04
  Data.b $75,$49,$EB,$0B,$66,$08,$FE,$4F,$9D,$34,$99,$53,$B8,$BB,$C5,$89,$29,$F1,$23,$99
  Data.b $23,$92,$81,$30,$43,$6A,$BF,$2E,$5F,$F2,$F3,$BC,$FF,$EB,$3D,$25,$FB,$F4,$AB,$A9
  Data.b $1F,$5D,$C4,$01,$33,$F7,$21,$FC,$18,$EF,$E7,$1D,$F9,$DA,$DD,$56,$3F,$79,$B3,$BF
  Data.b $BC,$A7,$F6,$EB,$BD,$CD,$02,$20,$8D,$0F,$FB,$FA,$FB,$E9,$F4,$96,$08,$FE,$F9,$D7
  Data.b $BF,$FF,$E1,$42,$FB,$29,$CF,$10,$25,$72,$F3,$65,$C4,$93,$FC,$BF,$8E,$3A,$69,$FD
  Data.b $47,$CF,$3D,$F5,$DA,$E1,$CD,$F7,$BE,$0F,$BF,$FB,$F0,$BF,$33,$96,$B6,$5F,$6B,$EE
  Data.b $3E,$BC,$F4,$E7,$A7,$B1,$F4,$27,$15,$09,$35,$FF,$75,$D2,$2C,$22,$09,$FB,$48,$EF
  Data.b $AF,$02,$10,$28,$7D,$6A,$52,$4C,$40,$0C,$A4,$1A,$94,$68,$A5,$56,$EE,$A0,$26,$61
  Data.b $C5,$C1,$0E,$6D,$CD,$10,$ED,$85,$A1,$9F,$D4,$5E,$DC,$A5,$F8,$72,$C9,$CA,$2A,$25
  Data.b $28,$7A,$2F,$7C,$96,$47,$3F,$49,$5C,$FB,$7B,$77,$C2,$1E,$27,$28,$41,$EC,$F5,$2E
  Data.b $56,$BE,$A7,$FA,$2B,$2F,$B6,$26,$3C,$C8,$34,$0F,$EE,$D3,$C6,$F9,$F3,$8D,$38,$EF
  Data.b $7C,$98,$E1,$FF,$E5,$6C,$64,$6B,$E6,$90,$D3,$64,$5D,$D4,$5E,$82,$82,$85,$26,$DF
  Data.b $D8,$73,$D8,$2C,$03,$9E,$79,$55,$B2,$EC,$30,$8F,$24,$45,$F2,$51,$3F,$8D,$98,$6F
  Data.b $56,$AC,$AE,$3C,$7E,$A9,$84,$FA,$B1,$57,$6D,$DA,$A1,$E6,$99,$B9,$9F,$D4,$9D,$AB
  Data.b $D0,$BA,$C1,$A3,$17,$5D,$37,$63,$A3,$B4,$43,$96,$28,$3B,$61,$C1,$59,$5F,$DD,$AD
  Data.b $B5,$28,$88,$39,$AF,$4E,$F9,$5E,$BB,$DC,$C7,$C9,$B3,$0D,$59,$CF,$42,$31,$D5,$2B
  Data.b $70,$E0,$AC,$9A,$A9,$62,$F0,$5C,$B6,$9A,$18,$8C,$59,$73,$6F,$BF,$FF,$C7,$FC,$2C
  Data.b $F4,$FD,$05,$BE,$84,$F3,$BF,$AB,$74,$F8,$BE,$C2,$39,$9F,$4E,$67,$8E,$E9,$02,$37
  Data.b $BB,$40,$8A,$BE,$1D,$97,$DF,$BC,$47,$ED,$64,$BF,$54,$37,$97,$88,$9F,$3E,$3C,$BC
  Data.b $2D,$41,$25,$29,$C7,$07,$1F,$E8,$D9,$8E,$65,$62,$4D,$6A,$DA,$1F,$C5,$BB,$8B,$77
  Data.b $F2,$C4,$FE,$ED,$EB,$F1,$CC,$BD,$03,$D9,$A7,$7E,$B1,$7E,$6D,$F9,$43,$8F,$EB,$AF
  Data.b $CB,$73,$2E,$32,$61,$DB,$69,$23,$13,$57,$E1,$7D,$66,$2A,$1D,$71,$69,$97,$69,$8F
  Data.b $87,$F8,$CF,$93,$96,$B6,$BA,$9A,$6E,$6A,$CA,$D9,$B7,$ED,$39,$F4,$D6,$CD,$A3,$BB
  Data.b $FF,$69,$FB,$F5,$27,$35,$E9,$1C,$6C,$43,$6B,$95,$E0,$3D,$FE,$59,$93,$53,$D4,$69
  Data.b $D1,$A4,$C1,$0A,$75,$4D,$00,$00,$00,$82
  Poubelleend:
EndDataSection

Vous pouvez désormais utiliser l'image 'img0' dans votre code.
Pensez à utiliser le décodeur correspondant au format de l'image initiale. Par exemple UsePngImageDecoder() si l'image initiale était dans le format PNG.

Créé le 27 novembre 2008  par netmaestro

Jusqu'à présent, je ne faisais que de la 2D ou de la 3D avec PureBasic.
Avec l'arrivée de Sqlite dans PureBasic, j'avais envie de tester cette bibliothèque et de créer une petite application pour me faire la main.

J'ai choisi un sujet classique, la gestion de mes livres. Pour commencer en douceur, il y a seulement 3 fiches :

  • Les livres
  • Les auteurs
  • Les éditeurs

Sur la fiche 'Livres' figure la liste des livres, mais aussi la liste des auteurs et la liste des éditeurs du livre sélectionné (cliquez sur un livre pour le sélectionner).

Sur la fiche 'Auteurs' figure la liste des auteurs, mais aussi la liste des livres de l'auteur sélectionné (cliquez sur un auteur pour le sélectionner).

Sur la fiche 'Editeurs' figure la liste des éditeurs, mais aussi la liste des livres de l'éditeur sélectionné (cliquez sur un éditeur pour le sélectionner).

L'application utilise le 'glisser et déposer' (drag and drop).

Sur chaque fiche, il y a une poubelle dans laquelle il est possible de glisser (et donc supprimer) les éléments de la fiche.

Vous pouvez aussi utiliser le glisser et déposer pour affecter un livre à un auteur ou un éditeur, ou glisser un auteur ou un éditeur dans la fiche livre.

Pour modifier un enregistrement double cliquez sur l'élément à modifier.

L'archive contient un exécutable pour tester sans PureBasic, ainsi qu'une base de données de tests 'MaBibliotheque.sqlite'. Les sources se trouvent également dans l'archive.

Je ne connaissais pas Sqlite avant ce projet, aussi soyez indulgents, et surtout n'hésitez pas à me contacter pour me corriger ou proposer une meilleure utilisation de Sqlite.

Une version pour Linux est disponible ici.

Image non disponible
Créé le 29 novembre 2008  par Comtois

Téléchargez le zip

Débutant en PB je me suis dis que le plus simple (!!) serait peut être d'adapter un petit programme de ceux que j'ai déjà en PHP.
Voici donc ma toute première réalisation qui sert uniquement à vérifier les comptes bancaires entrés dans les formulaires divers.

 
Sélectionnez

Enumeration
#WindowMain

#GAD_TEXT_code_banque
#GAD_TEXT_code_guichet
#GAD_TEXT_compte
#GAD_TEXT_rib
#GAD_TEXT_message

#GAD_STR_code_banque
#GAD_STR_code_guichet
#GAD_STR_compte
#GAD_STR_rib

#GAD_BOUT_validation
#GAD_BOUT_abandon

EndEnumeration

Declare controlerib()



OpenWindow(#WindowMain, 0, 0, 550, 160, "Contrôle des comptes bancaires", #PB_Window_ScreenCentered )
CreateGadgetList(WindowID(#WindowMain))

ButtonGadget(#GAD_BOUT_validation, 20,20, 150, 20, "controle du compte")
ButtonGadget(#GAD_BOUT_abandon, 20, 110, 150, 20, "Abandon")

TextGadget(#GAD_TEXT_code_banque, 200, 20, 120, 20, "Code banque")
TextGadget(#GAD_TEXT_code_guichet, 200, 50, 120, 20, "Code guichet")
TextGadget(#GAD_TEXT_compte, 200, 80, 120, 20, "Numéro de compte")
TextGadget(#GAD_TEXT_rib, 200, 110, 120, 20, "Clé RIB")

TextGadget(#GAD_TEXT_message, 200, 140, 330, 15, "", #PB_Text_Center)
SetGadgetColor(#GAD_TEXT_message, #PB_Gadget_BackColor, $BAFEFC )
SetGadgetColor(#GAD_TEXT_message, #PB_Gadget_FrontColor, $0000FD )
HideGadget(#GAD_TEXT_message, 1)

StringGadget(#GAD_STR_code_banque, 350, 20, 50, 20, "",#PB_String_Numeric)
StringGadget(#GAD_STR_code_guichet, 350, 50, 50, 20, "",#PB_String_Numeric)
StringGadget(#GAD_STR_compte, 350, 80, 180, 20, "", #PB_String_UpperCase)
StringGadget(#GAD_STR_rib, 350, 110, 50, 20, "",#PB_String_Numeric)

Repeat
   event = WaitWindowEvent()
      If event = #PB_Event_Gadget
         Select EventGadget()
            Case #GAD_BOUT_validation
               ;déclenche le controle du compte bancaire
               controlerib()
         EndSelect      
      EndIf
Until EventGadget() = #GAD_BOUT_abandon



Procedure controlerib()
   ;Réinitialise l'affichage préalablement au contrôle
   SetGadgetColor(#GAD_STR_code_banque, #PB_Gadget_BackColor, $FFFFFF )
   SetGadgetColor(#GAD_STR_code_banque, #PB_Gadget_FrontColor, $000000 )
   SetGadgetColor(#GAD_STR_code_guichet, #PB_Gadget_BackColor, $FFFFFF )
   SetGadgetColor(#GAD_STR_code_guichet, #PB_Gadget_FrontColor, $000000 )
   SetGadgetColor(#GAD_STR_compte, #PB_Gadget_BackColor, $FFFFFF )
   SetGadgetColor(#GAD_STR_compte, #PB_Gadget_FrontColor, $000000 )
   SetGadgetColor(#GAD_STR_rib, #PB_Gadget_BackColor, $FFFFFF )
   SetGadgetColor(#GAD_STR_rib, #PB_Gadget_FrontColor, $000000 )
    HideGadget(#GAD_TEXT_message, 1)

   ;Certain comptes comme ceux de la Poste comporte des lettres dans le numéro de compte
   ;Il est nécéssaire de remplacer ces lettres par un caractère numérique selon l'algorithme suivant
     compte.s = ""
     For compteur = 1 To 11 ;Les 11 caractères du compte sont lus les un après les autres
        caractere.s = Mid(GetGadgetText(#GAD_STR_compte), compteur, 1) ; on extrait le caractère
        ascode.b = Asc(caractere) ; et on lit son code ASCII
       
        If ascode > 82 ;soit [S-Z]                           ;
            compte + Str((Asc(caractere) -81)%10)         ;
        ElseIf ascode >73 ; soit [J-R]                     ;
            compte + Str((Asc(caractere)-73)%10)         ; si le code ASCII représente une lettre il est transformé selon son rang
        ElseIf ascode >57 ; soit [A-I]                     ; et ajouté en fin de chaine "compte"
            compte + Str((Asc(caractere)-64)%10)         ;
        Else
            compte + caractere                              ; si c'est un chiffre il est conservé tel quel et ajouté à la chaine
        EndIf       
     Next
     
     ;par exemple, le compte 00915078A24 sera remplacé par 00915078124
     ;code ASCII de A = 65 soit 65-64=1     1%10=1
     ;ou encore le compte Z0915078A24 sera remplacé par 90915078124
     ;code ASCII de Z = 90 soit 90-81=9   9%10=9
     
    ; ensuite le calcul de la clé est le suivant que je vous laisse découvrir. Un petit conseil, surlignez bien les parenthèses pour suivre les calculs     
     cle.s = Str(Val(GetGadgetText(#GAD_STR_code_banque))%97)
     cle = Str((Val(cle) * 100000 + (Val(GetGadgetText(#GAD_STR_code_guichet))))%97)
     cle = Str((Val(cle) * 1000000 + (Val(Left(compte , 6))))%97)
     cle = Str((Val(cle) * 100000 + (Val(Right(compte , 5))))%97)
     cle = Str(((97 - Val(cle)) * 100)%97)
     If Len(cle) < 2 : cle = "0" + cle : EndIf
 
     ;et une simple comparaison permet de modifier l'affichage pour attirer l'attention en cas d'erreur     
     If cle <> GetGadgetText(#GAD_STR_rib)
            SetGadgetColor(#GAD_STR_code_banque, #PB_Gadget_BackColor, $BAFEFC )
            SetGadgetColor(#GAD_STR_code_banque, #PB_Gadget_FrontColor, $0000FD )
            SetGadgetColor(#GAD_STR_code_guichet, #PB_Gadget_BackColor, $BAFEFC )
            SetGadgetColor(#GAD_STR_code_guichet, #PB_Gadget_FrontColor, $0000FD )
            SetGadgetColor(#GAD_STR_compte, #PB_Gadget_BackColor, $BAFEFC )
            SetGadgetColor(#GAD_STR_compte, #PB_Gadget_FrontColor, $0000FD )
            SetGadgetColor(#GAD_STR_rib, #PB_Gadget_BackColor, $BAFEFC )
            SetGadgetColor(#GAD_STR_rib, #PB_Gadget_FrontColor, $0000FD )
            SetGadgetText(#GAD_TEXT_message, "Pour ce compte la clé RIB devrait être: " + cle + ". A vous de voir  !!!")
            HideGadget(#GAD_TEXT_message, 0)
     EndIf

EndProcedure
Créé le 3 décembre 2008  par Claude-OI

Ce code calcule et affiche un engrenage pour lequel vous pouvez définir différents paramètres comme :

  • Module
  • Nombre de dents
  • Angle de pression
  • Déport (*module)
  • H tête (*module)
  • H pied (*module)
  • R chanfrein (*module)
 
Sélectionnez

; Auteur : Le Soldat Inconnu
; Version de PB : 4.40
;
; Explication du programme :
; Dessiner un engrenage


; Le filtre permet d'émuler de l'antialiasing sur le dessin de l'engrenage, ne pas mettre au dessus de 8
Global FiltreAA = 4, Dessin_Angle.d, Dessin_Zoom.d, Dessin.i


Enumeration
  ; Paramètres
  #G_Module
  #G_Z
  #G_Angle_Pression
  #G_D_primitif
  #G_D_pied
  #G_D_tete
  #G_H_dent
  #G_Pas
  #G_Deport
  ; Norme
  #G_H_pied
  #G_H_tete
  #G_R_chanfrein
  
  ; Autres
  #G_Onglet
  #G_Zoom
  #G_Dessin
  #G_Angle
  
EndEnumeration

#Engrenage_ResolutionDent = 314
#Equation_Degree = 1
#Cremaillere_NbEquation = 7
#Engrenage_Couleur = $FF00FFFF
#Engrenage_Diametre = $200000FF
#Engrenage2_Couleur = $FF0000FF
#Cremaillere_Couleur = $40FFFFFF
#Cremaillere_Hauteur = $400000FF
Structure Structure_Cercle
  x.d
  y.d
  R.d
  Interieur.b
  Exterieur.b
EndStructure
Structure Structure_Equation
  x1.d
  x2.d
  v.d[#Equation_Degree + 1]
  c.Structure_Cercle
EndStructure
Structure Structure_Rayon
  R.d
  Angle.d
  Zone.b
EndStructure
Structure Structure_Engrenage
  Module.d
  Z.d
  D_primitif.d
  D_tete.d
  D_pied.d
  H_dent.d
  Angle_pression.d
  Pas.d
  Deport.d
  H_tete.d
  H_pied.d
  R_chanfrein.d
  Contour.Structure_Rayon[#Engrenage_ResolutionDent]
  Cremaillere.Structure_Equation[#Cremaillere_NbEquation]
  Outil.Structure_Equation[#Cremaillere_NbEquation]
EndStructure

Global Engrenage.Structure_Engrenage

Procedure.s AfficheValeur(Valeur.d)
  ProcedureReturn RTrim(RTrim(RTrim(StrD(Valeur), "0"), "."), ",")
EndProcedure

Procedure Engrenage_Calcul(*Calcul.Structure_Engrenage)
  With *Calcul
    ;- Paramètres de l'engrenage
    \D_primitif = \Z * \Module
    \D_tete = \D_primitif + 2 * \H_tete * \Module
    \D_pied = \D_primitif - 2 * \H_pied * \Module
    \Pas = #PI * \Module
    \H_dent = (\H_tete + \H_pied) * \Module
    ;- Equation de la crémaillère
    Largeur_zone_tete.d = \Pas / 2 - 2 * \H_tete * \Module * Sin(\Angle_pression * #PI / 180)
    Largeur_zone_cercle.d = \R_chanfrein * \Module * Cos(\Angle_pression * #PI / 180)
    Hauteur_zone_cercle.d = \R_chanfrein * \Module * (1-Sin(\Angle_pression * #PI / 180))
    Largeur_zone_inclinee.d = (\H_dent - Hauteur_zone_cercle) * Sin(\Angle_pression * #PI / 180)
    Largeur_zone_pied.d = \Pas - Largeur_zone_tete - 2 * Largeur_zone_cercle - 2 * Largeur_zone_inclinee
    ; Zone 1
    \Cremaillere[0]\x1 = 0
    \Cremaillere[0]\x2 = Largeur_zone_tete / 2
    \Cremaillere[0]\v[0] = \H_dent
    ; zone 2
    \Cremaillere[1]\x1 = \Cremaillere[0]\x2
    \Cremaillere[1]\x2 = \Cremaillere[1]\x1 + Largeur_zone_inclinee
    \Cremaillere[1]\v[1] = -1/Sin(\Angle_pression * #PI / 180)
    \Cremaillere[1]\v[0] = \H_dent - \Cremaillere[1]\v[1] * \Cremaillere[1]\x1
    ; zone 3
    \Cremaillere[2]\x1 = \Cremaillere[1]\x2
    \Cremaillere[2]\x2 = \Cremaillere[2]\x1 + Largeur_zone_cercle
    ; \Cremaillere[2]\v[0] = Hauteur_zone_cercle
    \Cremaillere[2]\c\x = \Cremaillere[2]\x2
    \Cremaillere[2]\c\y = \R_chanfrein * \Module
    \Cremaillere[2]\c\R = \R_chanfrein * \Module
    \Cremaillere[2]\c\Interieur = 1
    ; zone 4
    \Cremaillere[3]\x1 = \Cremaillere[2]\x2
    \Cremaillere[3]\x2 = \Cremaillere[3]\x1 + Largeur_zone_pied
    \Cremaillere[3]\v[0] = 0
    ; zone 5
    \Cremaillere[4]\x1 = \Cremaillere[3]\x2
    \Cremaillere[4]\x2 = \Cremaillere[4]\x1 + Largeur_zone_cercle
    \Cremaillere[4]\c\x = \Cremaillere[4]\x1
    \Cremaillere[4]\c\y = \R_chanfrein * \Module
    \Cremaillere[4]\c\R = \R_chanfrein * \Module
    \Cremaillere[4]\c\Interieur = 1
    ; Zone 6
    \Cremaillere[5]\x1 = \Cremaillere[4]\x2
    \Cremaillere[5]\x2 = \Cremaillere[5]\x1 + Largeur_zone_inclinee
    \Cremaillere[5]\v[1] = 1/Sin(\Angle_pression * #PI / 180)
    \Cremaillere[5]\v[0] = Hauteur_zone_cercle - \Cremaillere[5]\v[1] * \Cremaillere[5]\x1
    ; Zone 7
    \Cremaillere[6]\x1 = \Cremaillere[5]\x2
    \Cremaillere[6]\x2 = \Pas
    \Cremaillere[6]\v[0] = \H_dent
    
    
    ;- Equation de l'outil
    Largeur_zone_pied.d = \Pas / 2 - 2 * \H_tete * \Module * Sin(\Angle_pression * #PI / 180)
    Largeur_zone_cercle.d = \R_chanfrein * \Module * Cos(\Angle_pression * #PI / 180)
    Hauteur_zone_cercle.d = \R_chanfrein * \Module * (1-Sin(\Angle_pression * #PI / 180))
    Largeur_zone_inclinee.d = (\H_dent - Hauteur_zone_cercle) * Sin(\Angle_pression * #PI / 180)
    Largeur_zone_tete.d = \Pas - Largeur_zone_pied - 2 * Largeur_zone_cercle - 2 * Largeur_zone_inclinee
    ; Zone 1
    \Outil[0]\x1 = 0
    \Outil[0]\x2 = Largeur_zone_tete / 2
    \Outil[0]\v[0] = \H_dent + (\H_pied - \H_tete) * \Module
    ; Zone 2
    \Outil[1]\x1 = \Outil[0]\x2
    \Outil[1]\x2 = \Outil[1]\x1 + Largeur_zone_cercle
    \Outil[1]\c\x = \Outil[1]\x1
    \Outil[1]\c\y = \H_dent + (\H_pied - \H_tete) * \Module - \R_chanfrein * \Module
    \Outil[1]\c\R = \R_chanfrein * \Module
    \Outil[1]\c\Exterieur = 1
    ; zone 3
    \Outil[2]\x1 = \Outil[1]\x2
    \Outil[2]\x2 = \Outil[2]\x1 + Largeur_zone_inclinee
    \Outil[2]\v[1] = -1/Sin(\Angle_pression * #PI / 180)
    \Outil[2]\v[0] = \H_dent + (\H_pied - \H_tete) * \Module - Hauteur_zone_cercle - \Outil[2]\v[1] * \Outil[2]\x1
    ; zone 4
    \Outil[3]\x1 = \Outil[2]\x2
    \Outil[3]\x2 = \Outil[3]\x1 + Largeur_zone_pied
    \Outil[3]\v[0] = (\H_pied - \H_tete) * \Module
    ; Zone 5
    \Outil[4]\x1 = \Outil[3]\x2
    \Outil[4]\x2 = \Outil[4]\x1 + Largeur_zone_inclinee
    \Outil[4]\v[1] = 1/Sin(\Angle_pression * #PI / 180)
    \Outil[4]\v[0] = (\H_pied - \H_tete) * \Module - \Outil[4]\v[1] * \Outil[4]\x1
    ; Zone 6
    \Outil[5]\x1 = \Outil[4]\x2
    \Outil[5]\x2 = \Outil[5]\x1 + Largeur_zone_cercle
    \Outil[5]\c\x = \Outil[5]\x2
    \Outil[5]\c\y = \H_dent + (\H_pied - \H_tete) * \Module - \R_chanfrein * \Module
    \Outil[5]\c\R = \R_chanfrein * \Module
    \Outil[5]\c\Exterieur = 1
    ; Zone 7
    \Outil[6]\x1 = \Outil[5]\x2
    \Outil[6]\x2 = \Pas
    \Outil[6]\v[0] = \H_dent + (\H_pied - \H_tete) * \Module
    
    ; CopyMemory(@\Cremaillere, @\Outil, SizeOf(Structure_Equation) * #Cremaillere_NbEquation)
    
    ; Reset de la taille de l'engrenage
    For x = 0 To #Engrenage_ResolutionDent - 1
      \Contour[x]\R = \D_tete / 2
      \Contour[x]\Angle = x * 2 * #PI / #Engrenage_ResolutionDent / \Z
    Next
    
  EndWith
EndProcedure

Procedure Engrenage_Diametre(*Calcul.Structure_Engrenage)
  With *Calcul
    If \Module > 0 And \Z > 0 And \Angle_pression > 0 And \D_pied > 0
      
      ;- Calcul des rayons avec l'angle par défaut
      For x = 0 To #Engrenage_ResolutionDent - 1
        \Contour[x]\Angle.d = x * 2 * #PI / #Engrenage_ResolutionDent / \Z
        x_reel.d = \D_primitif * \Contour[x]\Angle / 2
        
        While x_reel >= \Pas And \Pas > 0
          x_reel - \Pas
        Wend
        If x_reel < 0
          x_reel = 0
        EndIf
        For n = 0 To #Cremaillere_NbEquation - 1
          If x_reel >= \Outil[n]\x1 And x_reel < \Outil[n]\x2
            If \Outil[n]\c\R ; Cercle
              y_reel.d = \Outil[n]\c\y + \Outil[n]\c\R * (\Outil[n]\c\Exterieur - \Outil[n]\c\Interieur) * Sin(ACos((x_reel - \Outil[n]\c\x) / (\R_chanfrein *\Module)))
            Else ; Courbe
              CompilerIf #Equation_Degree = 1
                y_reel.d = \Outil[n]\v[0] + \Outil[n]\v[1] * x_reel
              CompilerElse
                y_reel.d = \Outil[n]\v[0]
                For nn = 1 To #Equation_Degree
                  y_reel.d + \Outil[n]\v[nn] * Pow(x_reel, nn)
                Next
              CompilerEndIf
            EndIf
            Break
          EndIf
        Next
        
        \Contour[x]\R =(\D_primitif / 2 + \H_pied * \Module) + \Deport * \Module - y_reel
        If \Contour[x]\R > \D_tete / 2 + \Deport * \Module
          \Contour[x]\R = \D_tete / 2 + \Deport * \Module
        EndIf
        If \Contour[x]\R < \D_pied / 2 + \Deport * \Module
          \Contour[x]\R = \D_pied / 2 + \Deport * \Module
        EndIf
        
        If \Contour[x]\Angle < #PI / \Z
          \Contour[x]\Zone = 1
        Else
          \Contour[x]\Zone = 2
        EndIf
        
      Next
      
      ;- Correction de l'angle
      
      ; Centre de l'engrenage
      x_reel.d = 0
      y_reel.d =(\D_primitif / 2 + \H_pied * \Module) + \Deport * \Module
      
      Correction.d = 1 / #Engrenage_ResolutionDent / \Z
      
      Rotation.d = #Engrenage_ResolutionDent * \Z / 4
      If Rotation < #Engrenage_ResolutionDent * 2
        Rotation = #Engrenage_ResolutionDent * 2
      EndIf
      
      For Z = -Rotation To Rotation
        
        Angle.d = Z * 2 * #PI / #Engrenage_ResolutionDent / \Z
        Avance.d = \D_primitif * Angle / 2
        
        For x = 0 To #Engrenage_ResolutionDent - 1
          If \Contour[x]\R
            
            Repeat
              
              Angle_reel.d = \Contour[x]\Angle + Angle
              x1_reel.d = x_reel + \Contour[x]\R * Sin(Angle_reel) - Avance
              y1_reel.d = y_reel - \Contour[x]\R * Cos(Angle_reel)
              
              While x1_reel < 0 And \Pas > 0
                x1_reel + \Pas
              Wend
              While x1_reel >= \Pas And \Pas > 0
                x1_reel - \Pas
              Wend
              For n = 0 To #Cremaillere_NbEquation - 1
                If x1_reel >= \Outil[n]\x1 And x1_reel < \Outil[n]\x2
                  If \Outil[n]\c\R ; Cercle
                    y2_reel.d = \Outil[n]\c\y + \Outil[n]\c\R * (\Outil[n]\c\Exterieur - \Outil[n]\c\Interieur) * Sin(ACos((x1_reel - \Outil[n]\c\x) / (\R_chanfrein *\Module)))
                  Else ; Courbe
                    CompilerIf #Equation_Degree = 1
                      y2_reel.d = \Outil[n]\v[0] + \Outil[n]\v[1] * x1_reel
                    CompilerElse
                      y2_reel.d = \Outil[n]\v[0]
                      For nn = 1 To #Equation_Degree
                        y2_reel.d + \Outil[n]\v[nn] * Pow(x1_reel, nn)
                      Next
                    CompilerEndIf
                  EndIf
                  Break
                EndIf
              Next
              
              If y1_reel < y2_reel
                
                If \Contour[x]\Zone = 1
                  \Contour[x]\Angle + Correction
                  If \Contour[x]\Angle > #PI / \Z
                    \Contour[x]\R = 0
                  EndIf
                Else
                  \Contour[x]\Angle - Correction
                  If \Contour[x]\Angle < #PI / \Z
                    \Contour[x]\R = 0
                  EndIf
                EndIf
                
              EndIf
              
            Until y1_reel >= y2_reel
            
          EndIf
        Next
      Next
    EndIf
  EndWith
EndProcedure

Procedure Engrenage_Dessin(Gadget, Image, *Calcul.Structure_Engrenage, Angle.d, Zoom.d = 0)
  
  LoadFont(1, "Tahoma", 9 * FiltreAA, #PB_Font_HighQuality)
  
  With *Calcul
    Largeur = GadgetWidth(Gadget) * FiltreAA
    Hauteur = GadgetHeight(Gadget) * FiltreAA
    Echelle.d =(2 * \Pas *(1 - Zoom) + \D_tete * Zoom) /(Largeur - 32 * FiltreAA)
    x0 = Largeur / 2
    y0 = Hauteur / 3 - \H_pied * \Module / Echelle
    
    ; De combien la crémaillère se déplace pour l'angle donné
    Avance.d = \D_primitif * Angle / 2
    
    CreateImage(Image, Largeur, Hauteur, 24)
    StartDrawing(ImageOutput(Image))
      DrawingMode(#PB_2DDrawing_AlphaBlend | #PB_2DDrawing_Transparent)
      Box(0, 0, Largeur, Hauteur, $FF000000)
      
      If \Module > 0 And \Z > 0 And \Angle_pression > 0 And \D_pied > 0
        
        If Dessin = 0 Or FiltreAA = 1
          ; Centre de l'engrenage
          x_reel.d = 0
          y_reel.d =(\D_primitif / 2 + \H_pied * \Module) + \Deport * \Module
          ; Dessin de l'engrenage
          Angle_reel.d = \Contour[0]\Angle + Angle
          x1_reel.d = x_reel + \Contour[0]\R * Sin(Angle_reel)
          y1_reel.d = y_reel - \Contour[0]\R * Cos(Angle_reel)
          For nn = 0 To \Z - 1
            For n = 1 To #Engrenage_ResolutionDent - 1
              If \Contour[n]\R
                Angle_reel.d = \Contour[n]\Angle + 2 * #PI * nn / \Z + Angle
                x2_reel.d = x_reel + \Contour[n]\R * Sin(Angle_reel)
                y2_reel.d = y_reel - \Contour[n]\R * Cos(Angle_reel)
                ; Debug StrD(x2_reel, 4) + " / " + StrD(y2_reel, 4)
                LineXY(x0 + x1_reel / Echelle, y0 + y1_reel / Echelle, x0 + x2_reel / Echelle, y0 + y2_reel / Echelle, #Engrenage_Couleur)
                x1_reel = x2_reel
                y1_reel = y2_reel
              EndIf
            Next
          Next
          Angle_reel.d = \Contour[0]\Angle + Angle
          x2_reel.d = x_reel + \Contour[0]\R * Sin(Angle_reel)
          y2_reel.d = y_reel - \Contour[0]\R * Cos(Angle_reel)
          LineXY(x0 + x1_reel / Echelle, y0 + y1_reel / Echelle, x0 + x2_reel / Echelle, y0 + y2_reel / Echelle, #Engrenage_Couleur)
        EndIf
        
        If Dessin = 0 Or FiltreAA = 1
          ; Remplissage de l'engrenage
          If y0 + y_reel / Echelle > Hauteur
            y = Hauteur - 1
          Else
            y = y0 + y_reel / Echelle
          EndIf
          FillArea(x0, y, #Engrenage_Couleur, #Engrenage_Couleur)
        EndIf
        
        If Dessin = 0 Or FiltreAA = 1
          ; Dessin de la crémaillère et de l'outil
          For x = 0 To Largeur - 1
            x_reel.d =(x - x0) * Echelle - Avance
            While x_reel < 0 And \Pas > 0
              x_reel + \Pas
            Wend
            While x_reel >= \Pas And \Pas > 0
              x_reel - \Pas
            Wend
            
            ; Dessin de la crémaillère
            For n = 0 To #Cremaillere_NbEquation - 1
              If x_reel >= \Cremaillere[n]\x1 And x_reel < \Cremaillere[n]\x2
                If \Cremaillere[n]\c\R ; Cercle
                  y_reel = \Cremaillere[n]\c\y + \Cremaillere[n]\c\R * (\Cremaillere[n]\c\Exterieur - \Cremaillere[n]\c\Interieur) * Sin(ACos((x_reel - \Cremaillere[n]\c\x) / (\R_chanfrein *\Module)))
                Else ; Courbe
                  CompilerIf #Equation_Degree = 1
                    y_reel.d = \Cremaillere[n]\v[0] + \Cremaillere[n]\v[1] * x_reel
                  CompilerElse
                    y_reel.d = \Cremaillere[n]\v[0]
                    For nn = 1 To #Equation_Degree
                      y_reel.d + \Cremaillere[n]\v[nn] * Pow(x_reel, nn)
                    Next
                  CompilerEndIf
                EndIf
                Break
              EndIf
            Next
            y = y_reel / Echelle + y0
            LineXY(x, y, x, 0, #Cremaillere_Couleur)
            
            ; Dessin de l'outil d'usinage
            For n = 0 To #Cremaillere_NbEquation - 1
              If x_reel >= \Outil[n]\x1 And x_reel < \Outil[n]\x2
                If \Outil[n]\c\R ; Cercle
                  y_reel = \Outil[n]\c\y + \Outil[n]\c\R * (\Outil[n]\c\Exterieur - \Outil[n]\c\Interieur) * Sin(ACos((x_reel - \Outil[n]\c\x) / (\R_chanfrein *\Module)))
                Else ; Courbe
                  CompilerIf #Equation_Degree = 1
                    y_reel.d = \Outil[n]\v[0] + \Outil[n]\v[1] * x_reel
                  CompilerElse
                    y_reel.d = \Outil[n]\v[0]
                    For nn = 1 To #Equation_Degree
                      y_reel.d + \Outil[n]\v[nn] * Pow(x_reel, nn)
                    Next
                  CompilerEndIf
                EndIf
                Break
              EndIf
            Next
            y = y_reel / Echelle + y0
            LineXY(x, y, x, 0, #Cremaillere_Couleur)
            
          Next
        EndIf
        
        If Dessin = 0 Or FiltreAA = 1
          ; Centre de l'engrenage
          x_reel.d = 0
          y_reel.d =(\D_primitif / 2 + \H_pied * \Module) + \Deport * \Module
          ; Dessin du diametre de pied
          Circle(x0, y0 + y_reel / Echelle,(\D_pied / 2 + \Deport * \Module) / Echelle, #Engrenage_Diametre)
          ; Box(0, y0 +(2.5 * \Module) / Echelle - FiltreAA / 2, Largeur, FiltreAA, #Cremaillere_Hauteur)
          ; Dessin du diametre primitif
          Circle(x0, y0 + y_reel / Echelle,(\D_primitif / 2) / Echelle, #Engrenage_Diametre)
          Box(0, y0 +(\H_pied * \Module) / Echelle - FiltreAA / 2, Largeur, FiltreAA, #Cremaillere_Hauteur)
          Box(0, y0 +(\H_pied * \Module + \Deport * \Module) / Echelle - FiltreAA / 2, Largeur, FiltreAA, #Cremaillere_Hauteur)
          ; Dessin du diametre de tête
          Circle(x0, y0 + y_reel / Echelle,(\D_tete / 2 + \Deport * \Module) / Echelle, #Engrenage_Diametre)
          ; Box(0, y0 +(0.25 * \Module) / Echelle - FiltreAA / 2, Largeur, FiltreAA, #Cremaillere_Hauteur)
          ; pied de la crémaillère
          ; Box(0, y0 - FiltreAA / 2, Largeur, FiltreAA, #Cremaillere_Hauteur)
          ; Tête de la crémaillère
          ; Box(0, y0 +(2.25 * \Module) / Echelle - FiltreAA / 2, Largeur, FiltreAA, #Cremaillere_Hauteur)
          ; centre
          Box(x0 - FiltreAA / 2, 0, FiltreAA, Hauteur, #Cremaillere_Hauteur)
        EndIf
        
        If Dessin = 0 Or FiltreAA = 1
          ; Centre de l'engrenage
          x_reel.d = 0
          y_reel.d =(\H_pied * \Module - \D_primitif / 2) - \Deport * \Module
          ; Dessin de l'engrenage
          Angle_reel.d = -\Contour[0]\Angle + Angle + #PI / \Z
          x1_reel.d = x_reel + \Contour[0]\R * Sin(Angle_reel)
          y1_reel.d = y_reel + \Contour[0]\R * Cos(Angle_reel)
          For nn = 0 To \Z - 1
            For n = 1 To #Engrenage_ResolutionDent - 1
              Angle_reel.d = \Contour[n]\Angle + 2 * #PI * nn / \Z + Angle + #PI / \Z
              If \Contour[n]\R
                x2_reel.d = x_reel + \Contour[n]\R * Sin(Angle_reel)
                y2_reel.d = y_reel + \Contour[n]\R * Cos(Angle_reel)
                ; Debug StrD(x2_reel, 4) + " / " + StrD(y2_reel, 4)
                LineXY(x0 + x1_reel / Echelle, y0 + y1_reel / Echelle, x0 + x2_reel / Echelle, y0 + y2_reel / Echelle, #Engrenage2_Couleur)
                x1_reel = x2_reel
                y1_reel = y2_reel
              EndIf
            Next
          Next
          Angle_reel.d = -\Contour[0]\Angle + Angle + #PI / \Z
          x2_reel.d = x_reel + \Contour[0]\R * Sin(Angle_reel)
          y2_reel.d = y_reel + \Contour[0]\R * Cos(Angle_reel)
          LineXY(x0 + x1_reel / Echelle, y0 + y1_reel / Echelle, x0 + x2_reel / Echelle, y0 + y2_reel / Echelle, #Engrenage2_Couleur)
        EndIf
        
        If Dessin = 0 Or FiltreAA = 1
          ; Dessin de l'échelle
          DrawingFont(FontID(1))
          Longueur.d = 1 / Echelle
          Texte.s = "1 mm"
          If TextWidth(Texte + "  ") > Longueur
            Longueur.d = 5 / Echelle
            Texte.s = "5 mm"
          EndIf
          If TextWidth(Texte + "  ") > Longueur
            Longueur.d = 10 / Echelle
            Texte.s = "1 cm"
          EndIf
          If TextWidth(Texte + "  ") > Longueur
            Longueur.d = 50 / Echelle
            Texte.s = "5 cm"
          EndIf
          If TextWidth(Texte + "  ") > Longueur
            Longueur.d = 100 / Echelle
            Texte.s = "1 dm"
          EndIf
          If TextWidth(Texte + "  ") > Longueur
            Longueur.d = 500 / Echelle
            Texte.s = "5 dm"
          EndIf
          If TextWidth(Texte + "  ") > Longueur
            Longueur.d = 1000 / Echelle
            Texte.s = "1 m"
          EndIf
          DrawText(x0 +(Longueur - TextWidth(Texte)) / 2, Hauteur - 16 * FiltreAA - TextHeight(Texte), Texte, $FFFFFFFF)
          Box(x0, Hauteur - 16 * FiltreAA, Longueur, FiltreAA, $FFFFFFFF)
          Box(x0, Hauteur - 16 * FiltreAA - Longueur, FiltreAA, Longueur, $FFFFFFFF)
        EndIf
        
      EndIf
    StopDrawing()
    If Dessin = 0 Or FiltreAA = 1
      If FiltreAA > 1
        ResizeImage(Image, Largeur / FiltreAA, Hauteur / FiltreAA, #PB_Image_Smooth)
      EndIf
      SetGadgetState(#G_Dessin, ImageID(0))
    EndIf
    
    FreeFont(1)
    
  EndWith
EndProcedure

Procedure Affichage(Parametre.i)
  
  Repeat
    
    While Dessin = 0 And Compteur < 50
      Delay(20)
      If FiltreAA = 1
        Compteur + 1
      EndIf
    Wend
    
    If Dessin > 0
      Dessin = 0
      FiltreAA = 1
      Affichage = 1
    EndIf
    If Compteur >= 50
      FiltreAA = 4
      Compteur = 0
      Affichage = 1
    EndIf
    
    If Affichage
      Affichage = 0
      
      Engrenage_Dessin(#G_Dessin, 0, @Engrenage, Dessin_Angle, Dessin_Zoom)
      
    EndIf
    
  Until Dessin < 0
  MessageRequester("oups", "fin")
EndProcedure



; Création de la fenêtre et de la GadgetList
If OpenWindow(0, 0, 0, 800, 600, "Taillage d'engrenage", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget) = 0
  End
EndIf

LoadFont(0, "Tahoma", 9, #PB_Font_HighQuality)
SetGadgetFont(#PB_Default, FontID(0))

Engrenage\Module = 1
Engrenage\Z = 15
Engrenage\Angle_pression = 20
Engrenage\H_tete = 1
Engrenage\H_pied = 1.25
Engrenage\R_chanfrein = 0.38
Engrenage_Calcul(@Engrenage)

x = 4
y = 4
Largeur = 200 - 8
PanelGadget(#G_Onglet, 4, 4, Largeur, 600 - 8 - 96 - 8)
AddGadgetItem(#G_Onglet, -1, "Paramètres")
Largeur2 = GetGadgetAttribute(#G_Onglet, #PB_Panel_ItemWidth) - 8
x2 = 4
y2 = 4
TextGadget(#PB_Any, x2, y2, Largeur2, 16, "Module")
y2 + 16
StringGadget(#G_Module, x2, y2, Largeur2, 24, AfficheValeur(Engrenage\Module))
y2 + 24
y2 + 8
TextGadget(#PB_Any, x2, y2, Largeur2, 16, "Z (Nombre de dents)")
y2 + 16
StringGadget(#G_Z, x2, y2, Largeur2, 24, AfficheValeur(Engrenage\Z))
y2 + 24
y2 + 8
TextGadget(#PB_Any, x2, y2, Largeur2, 16, "Angle de pression (en °)")
y2 + 16
StringGadget(#G_Angle_Pression, x2, y2, Largeur2, 24, AfficheValeur(Engrenage\Angle_pression))
y2 + 24
y2 + 8
TextGadget(#PB_Any, x2, y2, Largeur2, 16, "Déport (* module)")
y2 + 16
StringGadget(#G_Deport, x2, y2, Largeur2, 24, AfficheValeur(Engrenage\Deport))
y2 + 24
y2 + 8
TextGadget(#PB_Any, x2, y2, Largeur2, 16, "Diamètre primitif")
y2 + 16
StringGadget(#G_D_primitif, x2, y2, Largeur2, 24, AfficheValeur(Engrenage\D_primitif), #PB_String_ReadOnly)
y2 + 24
y2 + 8
TextGadget(#PB_Any, x2, y2, Largeur2, 16, "Diamètre de tête")
y2 + 16
StringGadget(#G_D_tete, x2, y2, Largeur2, 24, AfficheValeur(Engrenage\D_tete + 2 * Engrenage\Deport * Engrenage\Module), #PB_String_ReadOnly)
y2 + 24
y2 + 8
TextGadget(#PB_Any, x2, y2, Largeur2, 16, "Diamètre de pied")
y2 + 16
StringGadget(#G_D_pied, x2, y2, Largeur2, 24, AfficheValeur(Engrenage\D_pied + 2 * Engrenage\Deport * Engrenage\Module), #PB_String_ReadOnly)
y2 + 24
y2 + 8
TextGadget(#PB_Any, x2, y2, Largeur2, 16, "Hauteur de dent")
y2 + 16
StringGadget(#G_H_dent, x2, y2, Largeur2, 24, AfficheValeur(Engrenage\H_dent), #PB_String_ReadOnly)
y2 + 24
y2 + 8
TextGadget(#PB_Any, x2, y2, Largeur2, 16, "Pas")
y2 + 16
StringGadget(#G_Pas, x2, y2, Largeur2, 24, AfficheValeur(Engrenage\Pas), #PB_String_ReadOnly)
y2 + 24
y2 + 8


AddGadgetItem(#G_Onglet, -1, "Norme")
x2 = 4
y2 = 4
TextGadget(#PB_Any, x2, y2, Largeur2, 32, "Les paramètres suivants sont définis par la norme.")
y2 + 32
y2 + 8
TextGadget(#PB_Any, x2, y2, Largeur2, 16, "H tête (* Module)")
y2 + 16
StringGadget(#G_H_tete, x2, y2, Largeur2, 24, AfficheValeur(Engrenage\H_tete))
y2 + 24
y2 + 8
TextGadget(#PB_Any, x2, y2, Largeur2, 16, "H pied (* Module)")
y2 + 16
StringGadget(#G_H_pied, x2, y2, Largeur2, 24, AfficheValeur(Engrenage\H_pied))
y2 + 24
y2 + 8
TextGadget(#PB_Any, x2, y2, Largeur2, 16, "R chanfrein (* Module)")
y2 + 16
StringGadget(#G_R_chanfrein, x2, y2, Largeur2, 24, AfficheValeur(Engrenage\R_chanfrein))
y2 + 24
y2 + 8

CloseGadgetList()
y + GadgetHeight(#G_Onglet)
y + 8

TextGadget(#PB_Any, x, y, Largeur, 16, "Zoom d'affichage")
y + 16
TrackBarGadget(#G_Zoom, x, y, Largeur, 32, 0, 10, #PB_TrackBar_Ticks)
Dessin_Zoom.d = 0
y + 32
TextGadget(#PB_Any, x, y, Largeur, 16, "Rotation de l'engrenage")
y + 16
TrackBarGadget(#G_Angle, x, y, Largeur, 32, 0, 72)
Dessin_Angle.d = 0
y + 32

CreateImage(0, 600 - 8, 600 - 8, 24)
ImageGadget(#G_Dessin, 204, 4, ImageWidth(0), ImageHeight(0), ImageID(0))

Engrenage_Diametre(@Engrenage)
Engrenage_Dessin(#G_Dessin, 0, @Engrenage, 0)

Dessin = 1
Thread = CreateThread(@Affichage(), 0)

Repeat
  Event = WaitWindowEvent()
  
  Select Event
    Case #PB_Event_Gadget
      Select EventGadget() ; Gadgets
        Case #G_Module, #G_Z, #G_Angle_Pression, #G_Deport, #G_H_tete, #G_H_pied, #G_R_chanfrein
          If EventType() = #PB_EventType_Change
            ; ^paramètres
            Engrenage\Module = ValD(GetGadgetText(#G_Module))
            Engrenage\Z = ValD(GetGadgetText(#G_Z))
            Engrenage\Angle_pression = ValD(GetGadgetText(#G_Angle_Pression))
            Engrenage\Deport = ValD(GetGadgetText(#G_Deport))
            ; Norme
            Engrenage\H_tete = ValD(GetGadgetText(#G_H_tete))
            Engrenage\H_pied = ValD(GetGadgetText(#G_H_pied))
            Engrenage\R_chanfrein = ValD(GetGadgetText(#G_R_chanfrein))
            
            Engrenage_Calcul(@Engrenage)
            Engrenage_Diametre(@Engrenage)
            Dessin + 1
            ; Affichage des résultats
            SetGadgetText(#G_D_primitif, AfficheValeur(Engrenage\D_primitif))
            SetGadgetText(#G_D_tete, AfficheValeur(Engrenage\D_tete + 2 * Engrenage\Deport * Engrenage\Module))
            SetGadgetText(#G_D_pied, AfficheValeur(Engrenage\D_pied + 2 * Engrenage\Deport * Engrenage\Module))
            SetGadgetText(#G_H_dent, AfficheValeur(Engrenage\H_dent))
            SetGadgetText(#G_Pas, AfficheValeur(Engrenage\Pas))
          EndIf
        Case #G_Zoom
          Dessin_Zoom = GetGadgetState(#G_Zoom) / 10
          Dessin + 1
        Case #G_Angle
          Dessin_Angle.d = GetGadgetState(#G_Angle) * 2 * #PI /(36 * Engrenage\Z)
          Dessin + 1
      EndSelect
  EndSelect
  
Until Event = #PB_Event_CloseWindow
Mis à jour le 7 novembre 2010  par Le Soldat Inconnu

Un aperçu du résultat, le programme permet de faire varier la forme de la jauge, la position de l'aiguille, etc.

Image non disponible
 
Sélectionnez

Procedure.d MaxD(A.d, B.d)
  If A > B
    ProcedureReturn A
  EndIf
  ProcedureReturn B
EndProcedure

Procedure MinI(A, B)
  If A < B
    ProcedureReturn A
  EndIf
  ProcedureReturn B
EndProcedure

Procedure DrawTextCentered(x, y, T.s, FrontColor, BackColor)
  x = x - TextWidth(T)/2
  y = y - TextHeight("Wg")/2
  DrawText(x, y, T, FrontColor, BackColor)
EndProcedure

Macro GaugeValueType
  i
EndMacro

Prototype SGauge_PaintProto(*Gauge, Image)

Structure SGauge
  X.i
  Y.i
  W.i
  H.i
  Min.GaugeValueType
  Max.GaugeValueType
  BigStep.GaugeValueType    ; A text is drawn for every BigStep
  SmallStep.GaugeValueType  ; A nub is drawn for every SmallStep
  Value.i
  Text.s
  SubText.s
  Gadget.i
  ; Style:
  SectorDegrees.i
  InnerCircleRadius.i
  BgColor.i
  WheelColor.i
  WheelBgColor.i
  TextColor.i
  SubTextColor.i
  HandColor.i
  WheelFont.i
  TextFont.i
  SubTextFont.i
  ; Style override:
  PaintBackground.SGauge_PaintProto
  PaintWheel.SGauge_PaintProto
  PaintDescription.SGauge_PaintProto
  PaintHand.SGauge_PaintProto
  ; Repaint cache (set to 1 after changing style override)
  ; (The hand is always repainted)
  BgNeedRepaint.i
  WheelNeedRepaint.i
  DescriptionNeedRepaint.i
  ; Image cache (don't touch)
  BgImg.i
  WheelImg.i
  DescriptionImg.i
  ComposedImg.i
EndStructure

; Default paint functions
Procedure SGauge_PaintBackground(*G.SGauge, Image)
  DrawingMode(#PB_2DDrawing_AllChannels)
  Box(0, 0, *G\w, *g\H, *G\BgColor)
  DrawingMode(#PB_2DDrawing_AllChannels | #PB_2DDrawing_Outlined)
  Box(0, 0, *G\w, *g\H, RGBA(0, 0, 0, 32))
EndProcedure

Procedure SGauge_PaintWheel(*G.SGauge, Image)
  With *G
    StartDegree.i = 0 + ((360-\SectorDegrees)/2)
    wpx = \W / 33
    wpx2 = wpx/4.*3-1
    centerX = \w/2
    centerY = \H/2
    r = MinI(centerX, centerY) - TextWidth("12345")
    SmallStepDegrees.d  = \SmallStep / \Max * \SectorDegrees
    BigStepDegrees.d    = \BigStep / \Max * \SectorDegrees
    DrawingMode(#PB_2DDrawing_AllChannels)
    For I = 0 To \SectorDegrees
      x = centerX + Sin(Radian(StartDegree+I))*r
      y = centerY + Cos(Radian(StartDegree+I))*r
      Circle(x, y, wpx, \WheelColor)
    Next
    DrawingMode(#PB_2DDrawing_AllChannels)
    For I = 0 To \SectorDegrees
      x = centerX + Sin(Radian(StartDegree+I))*r
      y = centerY + Cos(Radian(StartDegree+I))*r
      Circle(x, y, wpx2, \WheelBgColor)
    Next
    dI.d = 0
    While dI <= \SectorDegrees
      x1 = centerX + Sin(Radian(StartDegree+dI))*(r-wpx2)
      y1 = centerY + Cos(Radian(StartDegree+dI))*(r-wpx2)
      x2 = centerX + Sin(Radian(StartDegree+dI))*(r-wpx2/2)
      y2 = centerY + Cos(Radian(StartDegree+dI))*(r-wpx2/2)
      LineXY(x1, y1, x2, y2, \WheelColor)
      dI + SmallStepDegrees
    Wend
    dI = 0
    While dI <= \SectorDegrees + 1 ;?!
      x1 = centerX + Sin(Radian(StartDegree+dI))*(r-wpx)
      y1 = centerY + Cos(Radian(StartDegree+dI))*(r-wpx)
      x2 = centerX + Sin(Radian(StartDegree+dI))*(r+wpx)
      y2 = centerY + Cos(Radian(StartDegree+dI))*(r+wpx)
      LineXY(x1, y1, x2, y2, \WheelColor)
      dI + BigStepDegrees
    Wend
    DrawingMode(#PB_2DDrawing_AlphaBlend | #PB_2DDrawing_Transparent)
    DrawingFont(FontID(\WheelFont))
    dI = 0
    I = 0
    While dI <= \SectorDegrees+1 ; not sure why that is needed
      T.s = Str(\Max-I)
      x = centerX + Sin(Radian(StartDegree+dI))*(r+wpx*3)
      y = centerY + Cos(Radian(StartDegree+dI))*(r+wpx*3)
      DrawTextCentered(x, y, T, RGBA(0, 0, 0, 255), RGBA(0, 0, 0, 0))
      dI + BigStepDegrees
      I + \BigStep
    Wend
  EndWith
EndProcedure

Procedure SGauge_PaintDescription(*G.SGauge, Image)
  With *G
    DrawingMode(#PB_2DDrawing_AlphaBlend | #PB_2DDrawing_Transparent)
    DrawingFont(FontID(\TextFont))
    x = 0.5 * \w
    y = 0.8 * \h
    DrawTextCentered(x, y, \Text, \TextColor, 0)
    y + TextHeight("Wg")
    DrawingFont(FontID(\SubTextFont))
    DrawTextCentered(x, y, \SubText, \SubTextColor, 0)
  EndWith
EndProcedure

Procedure SGauge_PaintHand(*G.SGauge, Image)
  With *G
    StartDegree.i = 0 + ((360-\SectorDegrees)/2)
   
    DrawVal = \Max - \Value
    DirDegrees.d = StartDegree + DrawVal / \Max * \SectorDegrees
    centerX = \W / 2
    centerY = \H / 2
    DrawingFont(\WheelFont)
    r = MinI(centerX, centerY) - TextWidth("12345")
    tipX = centerX + Sin(Radian(DirDegrees)) * r
    tipY = centerY + Cos(Radian(DirDegrees)) * r
    innerx = centerX + Sin(Radian(DirDegrees)) * \InnerCircleRadius
    innery = centerY + Cos(Radian(DirDegrees)) * \InnerCircleRadius
    LineXY(innerx, innery, tipx, tipy, RGBA(255, 0, 0, 255))
    Circle(innerx, innery, 2, RGBA(255, 0, 0, 255))
  EndWith
EndProcedure

Procedure SoftFreeImage(Image)
  If Image
    FreeImage(Image)
  EndIf
EndProcedure

Procedure SoftFreeFont(Font)
  If Font
    FreeFont(Font)
  EndIf
EndProcedure

; Set sane default settings for a gauge
; (except x and y which must be set manually unless already done)
; Better call this first, or your gauge won't show up
Procedure Gauge_InitDefaults(*G.SGauge, X = #PB_Ignore, Y = #PB_Ignore, W = #PB_Ignore, H = #PB_Ignore)
  With *G
    If X <> #PB_Ignore
      \X = X
    EndIf
    If Y <> #PB_Ignore
      \Y = Y
    EndIf
    If W <> #PB_Ignore
      \W = W
    EndIf
    If H <> #PB_Ignore
      \H = H
    EndIf
    \Min = 0
    \Max = 100
    \BigStep = 10
    \SmallStep = 5
    \Value = 0
    \Text = "Value"
    \SubText = "in percent"
    \Gadget = -1
    \SectorDegrees = 270
    \InnerCircleRadius = 0
    \BgColor = RGBA(0, 0, 0, 0)
    \WheelColor = RGBA(62, 62, 128, 192)
    \WheelBgColor = RGBA(64, 64, 0, 32)
    \TextColor = RGBA(0, 0, 0, 255)
    \SubTextColor = RGBA(92, 92, 92, 255)
    \HandColor = RGBA(255, 255, 192, 255)
    SoftFreeFont(\WheelFont)
    SoftFreeFont(\TextFont)
    SoftFreeFont(\SubTextFont)
    \WheelFont.i = LoadFont(#PB_Any, "Tahoma", MaxD(7, 0.04*\W))
    \TextFont.i  = LoadFont(#PB_Any, "Tahoma", MaxD(8, 0.056*\W), #PB_Font_Bold)
    \SubTextFont.i  = LoadFont(#PB_Any, "Tahoma", MaxD(7, 0.04*\W))
   
    \PaintBackground  = @SGauge_PaintBackground()
    \PaintWheel       = @SGauge_PaintWheel()
    \PaintDescription = @SGauge_PaintDescription()
    \PaintHand        = @SGauge_PaintHand()
   
    \BgNeedRepaint.i = 1
    \WheelNeedRepaint.i = 1
    \DescriptionNeedRepaint.i = 1
 
    \BgImg = SoftFreeImage(\BgImg)
    \WheelImg = SoftFreeImage(\WheelImg)
    \DescriptionImg = SoftFreeImage(\DescriptionImg)
    \ComposedImg = SoftFreeImage(\ComposedImg)
  EndWith
EndProcedure

; Called to redraw gauge
Procedure Gauge_UpdateDisplay(*G.SGauge)
  With *G
    If \BgNeedRepaint
      SoftFreeImage(\BgImg)
      \BgImg = CreateImage(#PB_Any, \w, \H, 32 | #PB_Image_Transparent)
      StartDrawing(ImageOutput(\BgImg))
        \PaintBackground(*G, \BgImg)
      StopDrawing()
    EndIf
    If \WheelNeedRepaint
      SoftFreeImage(\WheelImg)
      \WheelImg= CreateImage(#PB_Any, \w, \h, 32 | #PB_Image_Transparent)
      StartDrawing(ImageOutput(\WheelImg))
        \PaintWheel(*G, \WheelImg)
      StopDrawing()
    EndIf
    If \DescriptionNeedRepaint
      SoftFreeImage(\DescriptionImg)
      \DescriptionImg= CreateImage(#PB_Any, \w, \h, 32 | #PB_Image_Transparent)
      StartDrawing(ImageOutput(\DescriptionImg))
        \PaintDescription(*G, \DescriptionImg)
      StopDrawing()
    EndIf
    SoftFreeImage(\ComposedImg)
    \ComposedImg = CreateImage(#PB_Any, \w, \h, 32 | #PB_Image_Transparent)
    StartDrawing(ImageOutput(\ComposedImg))
      DrawingMode(#PB_2DDrawing_AlphaBlend)
      DrawImage(ImageID(\BgImg), 0, 0)
      DrawImage(ImageID(\WheelImg), 0, 0)
      DrawImage(ImageID(\DescriptionImg), 0, 0)
      \PaintHand(*G, \ComposedImg)
    StopDrawing()
    If \Gadget = -1
      \Gadget = ImageGadget(#PB_Any, \x, \y, \w, \h, ImageID(\ComposedImg))
    Else
      ResizeGadget(\Gadget, \x, \y, #PB_Ignore, #PB_Ignore)
      SetGadgetState(\Gadget, ImageID(\ComposedImg))
    EndIf
  EndWith
EndProcedure

; If changing some other setting than value, call this
; before Gauge_UpdateDisplay() or it won't be redrawn properly
Procedure Gauge_SettingsChanged(*G.SGauge)
  With *G
    \BgNeedRepaint.i = 1
    \WheelNeedRepaint.i = 1
    \DescriptionNeedRepaint.i = 1
  EndWith
EndProcedure

;- Example
#W = 640
#H = 384

OpenWindow(0, 0, 0, #W, #H, "", #PB_Window_ScreenCentered | #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
; SpinGadget(0, 300, 10, 100, 22, 0, 100, #PB_Spin_Numeric)
TrackBarGadget(0, 220, 10, 200, 22, 0, 100)
SetGadgetState(0, 0)
; SpinGadget(1, 300, 40, 100, 22, 1, 360, #PB_Spin_Numeric)
TrackBarGadget(1, 220, 40, 360, 22, 1, 360)
SetGadgetState(1, 270)
;SpinGadget(2, 300, 70, 100, 22, 0, 80, #PB_Spin_Numeric)
TrackBarGadget(2, 220, 70, 200, 22, 0, 40)
SetGadgetState(2, 0)

g.SGauge

Gauge_InitDefaults(@G, 10, 10, 200, 200)
Gauge_UpdateDisplay(@G)

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 0: ; Change value
          g\Value = GetGadgetState(0)
          Gauge_UpdateDisplay(@g)
        Case 1: ; Change size in degrees
          g\SectorDegrees = GetGadgetState(1)
          Gauge_SettingsChanged(@G)
          Gauge_UpdateDisplay(@g)
        Case 2: ; Change hand origin radius
          g\InnerCircleRadius = GetGadgetState(2)
          Gauge_SettingsChanged(@G)
          Gauge_UpdateDisplay(@g)
      EndSelect
    Case #PB_Event_CloseWindow
      Break
  EndSelect
ForEver
Créé le 18 février 2011  par Trond

Tiny Visual Designer (TVD) Version 0.94 est un mini designer visuel pour PureBasic.
Image non disponible

L'image n'est pas très représentative de ce qu'il est possible de faire, dans la version 0.94 vous pouvez ajouter 10 types de gadgets :

  • ButtonGadget
  • CheckBoxGadget
  • ComboBoxGadget
  • EditorGadget
  • Frame3DGadget
  • ListIconGadget
  • ListViewGadget
  • OptionGadget
  • StringGadget
  • TextGadget

Cette version fonctionne aussi sous Linux (testé sur Ubuntu 10) mais donne des résultats différents de la version Windows.

- Les gadgets sont accessibles depuis le menu contextuel (popup)
- Chaque gadget est repositionnable et redimensionnable avec la souris ou bien en utilisant les raccourcis suivant.
Ctrl + Flèches pour repositionner les gadgets.
Alt + Flèches pour redimensionner les gadgets.

Créé le 3 avril 2011  par falsam

Téléchargez le zip

  

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2008 Developpez Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.