des modules ^^

Dr. Dri · Message par **Dr. Dri** » sam. 22/oct./2005 20:21

comme je m'ennuyai un peu hier j'ai décidé de créer des modules

en gros jme fais des fichiers avec des fonctions que je peux réutiliser à loisir
le tout groupé par thème...
Au cas où je devais les perdre je les mets sur le forum et vous pouvez les consulter (une pierre deux coups

)

Dri

Dr. Dri · Message par **Dr. Dri** » sam. 22/oct./2005 20:22

Code : Tout sélectionner

;> --------------------------------------------------------------------------- <
;  Fichier      : Misc.pbi
;
;  Module       : Miscellaneous
;
;  Auteur       : Dr. Dri
;
;  Description  : Divers
;
;  Historique   : 21/10/2005 - Création du module
;> --------------------------------------------------------------------------- <

;> ----------------- <
;- Misc : Structures
;> ----------------- <

Structure Bytes
  b.b[0]
EndStructure

Structure Words
  w.w[0]
EndStructure

Structure Longs
  l.l[0]
EndStructure

Structure Strings
  s.s[0]
EndStructure

Structure Floats
  f.f[0]
EndStructure

Dri

Dr. Dri · Message par **Dr. Dri** » sam. 22/oct./2005 20:24

Code : Tout sélectionner

;> --------------------------------------------------------------------------- <
;  Fichier      : Lang.pbi
;
;  Module       : Lang Manager
;
;  Auteur       : Dr. Dri
;
;  Description  : Gestion des langues ASCII
;
;  Fonctions    : GetLangName     @4
;                 GetLangCode     @4
;                 GetLangLocale   @4
;                 IsLangSupported @4
;                 LangRequester   @16
;
;  Commentaires : Pas de gestion des sous-langues
;
;  Historique   : 21/10/2005 - Création du module
;> --------------------------------------------------------------------------- <

;> ---------------------- <
;- Lang Manager : Modules
;> ---------------------- <

XIncludeFile "Misc.pbi"

;> ------------------------- <
;- Lang Manager : Constantes
;> ------------------------- <

Enumeration
  #LANG_NEUTRAL
  #LANG_ARABIC
  #LANG_BULGARIAN
  #LANG_CATALAN
  #LANG_CHINESE
  #LANG_CZECH
  #LANG_DANISH
  #LANG_GERMAN
  #LANG_GREEK
  #LANG_ENGLISH
  #LANG_SPANISH
  #LANG_FINNISH
  #LANG_FRENCH
  #LANG_HEBREW
  #LANG_HUNGARIAN
  #LANG_ICELANDIC
  #LANG_ITALIAN
  #LANG_JAPANESE
  #LANG_KOREAN
  #LANG_DUTCH
  #LANG_NORWEGIAN
  #LANG_POLISH
  #LANG_PORTUGUESE
  #LANG_ROMANIAN   = 24
  #LANG_RUSSIAN
  #LANG_CROATIAN
  #LANG_SERBIAN    = 26
  #LANG_SLOVAK
  #LANG_ALBANIAN
  #LANG_SWEDISH
  #LANG_THAI
  #LANG_TURKISH
  #LANG_URDU
  #LANG_INDONESIAN
  #LANG_UKRAINIAN
  #LANG_BELARUSIAN
  #LANG_SLOVENIAN
  #LANG_ESTONIAN
  #LANG_LATVIAN
  #LANG_LITHUANIAN
  #LANG_FARSI      = 41
  #LANG_VIETNAMESE
  #LANG_ARMENIAN
  #LANG_AZERI
  #LANG_BASQUE
  #LANG_MACEDONIAN = 47
  #LANG_AFRIKAANS  = 54
  #LANG_GEORGIAN
  #LANG_FAEROESE
  #LANG_HINDI
  #LANG_MALAY      = 62
  #LANG_KAZAK
  #LANG_SWAHILI    = 65
  #LANG_UZBEK      = 67
  #LANG_TATAR
  #LANG_BENGALI
  #LANG_PUNJABI
  #LANG_GUJARATI
  #LANG_ORIYA
  #LANG_TAMIL
  #LANG_TELUGU
  #LANG_KANNADA
  #LANG_MALAYALAM
  #LANG_ASSAMESE
  #LANG_MARATHI
  #LANG_SANSKRIT
  #LANG_KONKANI    = 87
  #LANG_MANIPURI
  #LANG_SINDHI
  #LANG_KASHMIRI
  #LANG_NEPALI
EndEnumeration

#LOCALE_SISO639LANGNAME = $59

;> ------------------------- <
;- Lang Manager : Structures
;> ------------------------- <

Structure DLGTEMPLATEEX Extends DLGTEMPLATE
    menu.w
    class.w
    title.l
EndStructure

Structure LangRequesterParams
  Title.s
  Text.s
  IconID.l
  Pattern.s
EndStructure

;> ------------------------ <
;- Lang Manager : Fonctions
;> ------------------------ <

;Nom        : GetLangName()
;Type       : Public
;
;Paramètres : LCID   Locale - L'identifiant de la langue
;Retour     : String        - Le nom de la langue dans sa propre langue
Procedure.s GetLangName(Locale.l)
  Protected LangName.s, Temp.s, Length.l
 
  Length = GetLocaleInfo_(Locale, #LOCALE_SNATIVELANGNAME, #Null, #Null)
 
  If Length > 0
    Temp = Space(Length - 1)
    GetLocaleInfo_(Locale, #LOCALE_SNATIVELANGNAME, Temp, Length)
   
    LangName = UCase( Left (Temp, 1) )
    LangName + LCase( Right(Temp, Length - 2) )
  EndIf
 
  ProcedureReturn LangName
EndProcedure

;Nom        : GetLangCode()
;Type       : Public
;
;Paramètres : LCID   Locale - L'identifiant de la langue
;Retour     : String        - Le code ISO 639 de la langue
Procedure.s GetLangCode(Locale.l)
  Protected LangCode.s, Length.l
 
  Length = GetLocaleInfo_(Locale, #LOCALE_SISO639LANGNAME, #Null, #Null)
 
  If Length > 0
    LangCode = Space(Length - 1)
    GetLocaleInfo_(Locale, #LOCALE_SISO639LANGNAME, LangCode, Length)
  EndIf
 
  ProcedureReturn LangCode
EndProcedure

;Nom        : GetLangLocale()
;Type       : Public
;
;Paramètres : String LangCode - Le code ISO 639 de la langue
;Retour     : LCID            - L'identifiant de la langue
Procedure.l GetLangLocale(LangCode.s)
  Protected Locale.l, Done.l
 
  If Len(LangCode) = 2
    While Locale < #LANG_NEPALI And Done = #False
      Locale + 1
     
      If LangCode = GetLangCode(Locale)
        Done = #True
      EndIf
    Wend
  EndIf
 
  If Done = #False
    Locale = #Null
  EndIf
 
  ProcedureReturn Locale
EndProcedure

;Nom        : IsLangSupported()
;Type       : Public
;
;Paramètres : LCID Locale - L'identifiant de la langue
;Retour     : BOOL        - Retourne vrai si la langue est supportée par le système
Procedure.l IsLangSupported(Locale.l)
  ProcedureReturn (GetLangLocale( GetLangCode(Locale) ) = Locale) Or #False
EndProcedure

;Nom        : LangCallback()
;Type       : Privé
Procedure.l LangCallback(WindowID.l, Message.l, wParam.l, lParam.l)
  Protected *params.LangRequesterParams
  Protected Title.s, Text.s, IconID.l, Pattern.s
  Protected Temp.l, x.l, y.l, cx.l, cy.l, Locale.l, Location.s
  Protected SH.SHFileInfo, rc.RECT
 
  Static Image, Label, ComboLangs, ButtonOK, ButtonCancel, nLangs, *Langs.Longs
 
  Select Message
    Case #WM_INITDIALOG
      *params = lParam
      Title   = *params\Title
      Text    = *params\Text
      IconID  = *params\IconID
      Pattern = *params\Pattern
     
      MoveWindow_(WindowID, 0, 0, 297, 125, #False)
      
      GetClientRect_(WindowID, rc)
      cx = (2 * 297) - (rc\right - rc\left)
      cy = (2 * 125) - (rc\bottom - rc\top)
      
      x = (GetSystemMetrics_(#SM_CXSCREEN) - cx) / 2
      y = (GetSystemMetrics_(#SM_CYSCREEN) - cy) / 2
      
      MoveWindow_(WindowID, x, y, cx, cy, #False)
     
      If Title = #NULL$
        Title = "Language configuration"
      EndIf
     
      If Text = #NULL$
        Text = "Please select a language."
      EndIf
     
      If IconID = #Null
        Location = Space($500)
        GetModuleFileName_(#Null, Location, $500)
       
        SHGetFileInfo_(Location, 0, SH, SizeOf(SHFileInfo), #SHGFI_ICON|#SHGFI_LARGEICON)
        IconID = SH\hIcon
      EndIf
     
      SetWindowText_(WindowID, Title)
     
      CreateGadgetList(WindowID)
      Image        = ImageGadget(#PB_Any, 8, 8, 32, 32, IconID)
      Label        = TextGadget(#PB_Any, 53, 8, 235, 32, Text)
      ComboLangs   = ComboBoxGadget(#PB_Any, 53, 56, 235, 100)
      ButtonOk     = ButtonGadget(#PB_Any, 133, 93, 75, 23, "OK", #PB_Button_Default)
      ButtonCancel = ButtonGadget(#PB_Any, 214, 93, 75, 23, "Cancel")
     
      Temp = CountString(Pattern, "|") + 1
     
      For x = 1 To Temp
        Locale = GetLangLocale( StringField(Pattern, x, "|") )
       
        If Locale
          AddGadgetItem(ComboLangs, #PB_Default, GetLangName(Locale))
          nLangs + 1
        EndIf
      Next x
     
      If nLangs > 0
        *Langs = AllocateMemory(SizeOf(Long) * nLangs)
        nLangs = 0
        
        SetGadgetState(ComboLangs, 0)
        
        For x = 1 To Temp
          Locale   = GetLangLocale( StringField(Pattern, x, "|") )
          
          If Locale
            If Locale = GetUserDefaultLangID_() & $FF
              SetGadgetState(ComboLangs, nLangs)
            EndIf
            *Langs\l[nLangs] = Locale
            nLangs + 1
          EndIf
        Next x
        
        ActivateGadget(ComboLangs)
      Else
        EndDialog_(WindowID, #LANG_NEUTRAL)
      EndIf
      
    Case #WM_COMMAND
      If lParam = #Null Or lParam = GadgetID(ButtonCancel) Or lParam = GadgetID(ButtonOK)
        If lParam = GadgetID(ButtonOK)
          x = GetGadgetState(ComboLangs)
          Locale = *Langs\l[x]
        Else
          Locale = #LANG_NEUTRAL
        EndIf
       
        FreeMemory(*Langs)
        EndDialog_(WindowID, Locale)
      EndIf
     
  EndSelect
 
  ProcedureReturn #Null
EndProcedure

;Nom        : LangRequester()
;Type       : Public
;
;Paramètres : String Title   - Titre de la boîte de dialogue
;                              Remplace le titre par défaut
;             String Message - Texte de la boîte de dialogue
;                              Remplace le texte par défaut
;             HANDLE IconID  - Icône de la bôite de dialogue
;                              Remplace l'icône de l'exécutable
;             String Pattern - Liste des langues sélectionnables
;                              Des codes ISO 639 séparés par des '|' (pipe)
;Retour     : LCID           - L'identifiant de la langue sélectionnée
;                              Retourne #LANG_NEUTRAL en cas d'annulation
Procedure.l LangRequester(Title.s, Message.s, IconID.l, Pattern.s)
  Protected Dlg.DLGTEMPLATEEX, Params.LangRequesterParams
  
  Dlg\style = #WS_SYSMENU|#WS_CAPTION|#DS_CENTER|#DS_MODALFRAME
  
  Params\Title   = Title
  Params\Text    = Message
  Params\IconID  = IconID
  Params\Pattern = Pattern
  
  ProcedureReturn DialogBoxIndirectParam_(#Null, Dlg, WindowID(), @LangCallback(), Params)
EndProcedure

Dri

Dr. Dri · Message par **Dr. Dri** » sam. 22/oct./2005 20:25

Code : Tout sélectionner

;> --------------------------------------------------------------------------- <
;  Fichier      : FileAttributes.pbi
;
;  Module       : File Attributes
;
;  Auteur       : Dr. Dri
;
;  Description  : Manipule les propriétés des fichiers
;
;  Fonctions    : GetFileAttributes @4
;                 SetFileAttributes @8
;                 AddFileAttributes @8
;                 RemFileAttributes @8
;                 HasFileAttributes @8
;
;  Commentaires : Fonctionne aussi avec les dossier
;                 Il est possible de fusionner les attributs avec l'opérateur |
;                 Certains attributs ne doivent pas être fusionnés
;
;  Historique   : 22/10/2005 - Création du module
;> --------------------------------------------------------------------------- <

;> --------------------------- <
;- File Attributes : Fonctions
;> --------------------------- <

;Nom        : GetFileAttributes()
;Type       : Public
;
;Paramètres : String File - Le nom du fichier
;Retour     : Long        - Les attributs
Procedure.l GetFileAttributes(File.s)
  ProcedureReturn GetFileAttributes_(File)
EndProcedure

;Nom        : SetFileAttributes()
;Type       : Public
;
;Paramètres : String File     - Le nom du fichier
;             Long Attributes - Les attributs
;Retour     : BOOL            - Retourne vrai si les attributs sont changés
Procedure.l SetFileAttributes(File.s, Attributes.l)
  ProcedureReturn SetFileAttributes_(File, Attributes)
EndProcedure

;Nom        : AddFileAttributes()
;Type       : Public
;
;Paramètres : String File     - Le nom du fichier
;             Long Attributes - Les attributs
;Retour     : BOOL            - Retourne vrai si les attributs sont ajoutés
Procedure.l AddFileAttributes(File.s, Attributes.l)
  Attributes | GetFileAttributes_(File)
  ProcedureReturn SetFileAttributes_(File, Attributes)
EndProcedure

;Nom        : RemFileAttributes()
;Type       : Public
;
;Paramètres : String File     - Le nom du fichier
;             Long Attributes - Les attributs
;Retour     : BOOL            - Retourne vrai si les attributs sont retirés
Procedure.l RemFileAttributes(File.s, Attributes.l)
  Attributes ! GetFileAttributes_(File)
  ProcedureReturn SetFileAttributes_(File, Attributes)
EndProcedure

;Nom        : HasFileAttributes()
;Type       : Public
;
;Paramètres : String File     - Le nom du fichier
;             Long Attributes - Les attributs
;Retour     : BOOL            - Retourne vrai si les attributs existent
Procedure.l HasFileAttributes(File.s, Attributes.l)
  Attributes & GetFileAttributes_(File)
  ProcedureReturn (Attributes <> 0) Or #False
EndProcedure

Dri

Chris · Message par **Chris** » sam. 22/oct./2005 20:26

Elles existent déjà, celles là, dans le visualiseur de structures

[Edit]
Arfff......
T'en as rajouté!!!!!

Twix · Message par **Twix** » mer. 02/nov./2005 9:59

A propos de modules... je suis en train de programmer un sorte de système de plugin pour Pure... enfin vous verrez ça plus tard, le temps que je débugue ce que j'ai déjà fait et que je finiasse le reste...

LeCyb · Message par **LeCyb** » mer. 02/nov./2005 22:41

@Dri: super, manque p-ê un petit exemple d'utilisation

@Chris: Les structures existent mais en définissant le [0] en plus tu peux aller direct rechercher les valeurs sans faire de Peek (idem pour Poke).
C'est beaucoup plus simple et bien plus rapide à l'exécution.