Droopy's Lib

Gillou · Message par **Gillou** » ven. 04/nov./2005 15:45

Tiens Droopy pour te remercier pour ta super lib:

Vous pouvez faire ce que vous voulez de ce code , comme d'habitude

Bon, il est pas en couleur mais ça ne saurait tarder, une petite erreur sur mon pc

Il y a encore plein d'améliorations à apporter sur toutes ces fonctions, je vous laisse le faire

Code : Tout sélectionner

; Gillou
; PureBasic 3.94
; Dernière mise à jour : 31/10/05

;- DESKTOP

; DIMENSION ECRAN LARGEUR, HAUTEUR, PROFONDEUR
 ; #ENUM_CURRENT_SETTINGS = -1
 ; #ENUM_REGISTRY_SETTINGS = -2
 ; DefType.DEVMODE dm
 ; EnumDisplaySettings_ (#Null, #ENUM_CURRENT_SETTINGS, @dm)
 ; xs = dm\dmPelsWidth
 ; ys = dm\dmPelsHeight
 ; ps = dm\dmBitsPerPel

DeclareDLL.s GetExePath()

ProcedureDLL GetDesktopHeight() ; Retourne la hauteur du bureau
SystemParametersInfo_(#SPI_GETWORKAREA, 0, @desktop.RECT, 0) 
ProcedureReturn desktop\bottom-desktop\top
EndProcedure

ProcedureDLL GetDesktopWidth() ; Retourne la largeur du bureau
SystemParametersInfo_(#SPI_GETWORKAREA, 0, @desktop.RECT, 0) 
ProcedureReturn desktop\right-desktop\left
EndProcedure

ProcedureDLL GetDesktopX() ; Retourne la position du bureau suivant l'horizontal
SystemParametersInfo_(#SPI_GETWORKAREA, 0, @desktop.RECT, 0) 
ProcedureReturn desktop\left
EndProcedure

ProcedureDLL GetDesktopY() ; Retourne la position du bureau suivant la vertical
SystemParametersInfo_(#SPI_GETWORKAREA, 0, @desktop.RECT, 0) 
ProcedureReturn desktop\Top
EndProcedure

Procedure.l UpdateWindowsProc(hWnd.l, *desktop.RECT) 
  If IsZoomed_(hWnd) 
    MoveWindow_(hWnd, *desktop\left, *desktop\top, *desktop\right-*desktop\left, *desktop\bottom-*desktop\top, #True) 
  EndIf 
  ProcedureReturn #True 
EndProcedure

ProcedureDLL SetDesktopArea(x, y, width, height) ; Modifie les dimensions et la position du bureau
desktop.RECT
desktop\left=x
desktop\Top=y
desktop\Right=x+width
desktop\bottom=y+height
v=SystemParametersInfo_(#SPI_SETWORKAREA, 0, @desktop, #SPIF_SENDWININICHANGE)
EnumWindows_(@UpdateWindowsProc(), @desktop)
ProcedureReturn v
EndProcedure

;- FILE

ProcedureDLL.s GetFilePartWithoutExtension(File.s) ; Retourne le nom du fichier sans l'extension
    File.s = GetFilePart(File.s)
    If Len(GetExtensionPart(File.s)) <> 0
        ProcedureReturn Left(File.s, Len(File.s) - Len(GetExtensionPart(File.s)) - 1)
    EndIf
    ProcedureReturn File.s
EndProcedure

ProcedureDLL.s ReadStringN(Number,Separator.s) ; Lit N ligne du fichier actuellement ouvert et place entre chaque ligne lue un separateur
For a=0 To number-1
If a=0
txt$=ReadString()
Else
txt$=txt$+separator+ReadString()
EndIf
Next
ProcedureReturn txt$
EndProcedure

ProcedureDLL.s GetShortPathName(path$) ; Retourne l'adresse courte de path$
ShortPath$ = Space(#MAX_PATH) 
GetShortPathName_(Path$,@ShortPath$,#MAX_PATH)
ProcedureReturn shortpath$ 
EndProcedure

ProcedureDLL.s GetLongPathName(path$) ; Retourne l'adresse longue de path$
Global *POINTER_GetLongPathName
lib=OpenLibrary(#PB_Any,"kernel32.dll")
*POINTER_GetLongPathName=IsFunction(lib,"GetLongPathNameA")
temp=AllocateMemory(#MAX_PATH)
If CallFunctionFast(*POINTER_GetLongPathName,path$,temp,#MAX_PATH)
ProcedureReturn PeekS(temp)
EndIf
EndProcedure 

ProcedureDLL ExistFile(File$) ; Retourne 1 si le fichier existe
If GetPathPart(file$)=""
file$=GetExePath()+file$
EndIf
If ExamineDirectory(0,GetPathPart(file$),"")
Repeat
fi=NextDirectoryEntry()
If fi=1
If GetFilePart(file$)=DirectoryEntryName()
ProcedureReturn 1
EndIf
EndIf
Until fi=0
EndIf
ProcedureReturn 0
EndProcedure

;- FILESYSTEM

Procedure LASDE(Directory.l, DirectoryName.s)
Global filel , filed , dirtemp , dirt$ , lista , listb , listc
If dirtemp=0
dirtemp=1
If Right(DirectoryName,1)<>"\" : DirectoryName=DirectoryName+"\" : EndIf
dirt$=DirectoryName
If  filel=0 : NewList FileList.s() : filel=1 : Else : ClearList(FileList()) : EndIf
If  filed=0 : NewList DirList.s() : filed=1 : Else : ClearList(DirList()) : EndIf
EndIf
   Typ=ExamineDirectory(Directory, DirectoryName, "")
   Typ = NextDirectoryEntry()
   Repeat 
         Name$ = DirectoryEntryName() 
         If Typ = 1                                   
         AddElement(FileList()) : filelist()=DirectoryName+name$
         ElseIf Typ = 2 And Left(Name$,1) <> "." 
         AddElement(dirList()) : dirlist()=DirectoryName+name$+"\"
         LASDE(Directory+1,DirectoryName  + Name$ + "\")
         UseDirectory(Directory)
      EndIf 
      Typ = NextDirectoryEntry()
   Until Typ = 0
If dirt$=DirectoryName
lista=0
listb=0
ProcedureReturn CountList(filelist())+CountList(DirList())
EndIf
EndProcedure 

ProcedureDLL ListAllSubDirectoryEntry(DirectoryName.s) ; Retourne le nombre d'objets contenus (Met en mémoire la liste des sous-objets)
Global Dir
Dir=0
If Right(DirectoryName,1)<>"\" : DirectoryName=DirectoryName+"\" : EndIf
ProcedureReturn LASDE(Dir,DirectoryName.s)
EndProcedure

ProcedureDLL.s NextSubDirectory() ; Retourne le nom du prochain sous-dossier
If dirtemp=1
If CountList(DirList())-1>=ListA
SelectElement(DirList(),ListA)
ListA=ListA+1
ProcedureReturn DirList()
Else
ListA=0
ProcedureReturn ""
EndIf
EndIf
EndProcedure

ProcedureDLL.s NextSubFile(Pattern.s) ; Retourne le nom du prochain sous-fichier
If dirtemp=1
If pattern="" Or pattern="*.*" 
If CountList(FileList())-1>=ListB
SelectElement(FileList(),ListB)
ListB=ListB+1
ProcedureReturn FileList()
Else
ProcedureReturn ""
EndIf
Else
ext$=UCase(GetExtensionPart(pattern))
For a=0 To CountList(FileList())-1
SelectElement(FileList(),a)
If UCase(GetExtensionPart(FileList()))=ext$
c=c+1
If c=ListC
ListC=ListC+1
ProcedureReturn FileList()
EndIf
EndIf
Next
ProcedureReturn ""
EndIf
EndIf
EndProcedure

ProcedureDLL.f DirectorySize(Directory.l,DirectoryName.s, Scale.l) ; Retourne la taille du dossier en octet, si scale=0, en ko, si scale=1,... 
    If Right(DirectoryName, 1)<>"\" : DirectoryName=DirectoryName+"\" : EndIf
    If ExamineDirectory(Directory, DirectoryName, "*.*")
        Repeat
            Entry.l = NextDirectoryEntry()
            If Entry = 1
                Size.f =size.f+ (DirectoryEntrySize() / Pow(1024,scale))
            ElseIf Entry = 2
                Name.s = DirectoryEntryName()
                If Name <> ".." And Name <> "."
                    Size.f=size.f + DirectorySize(Directory+1,DirectoryName + Name + "\",scale)
                    UseDirectory(Directory)
                EndIf
            EndIf
        Until Entry = 0
    EndIf
    ProcedureReturn Size.f
EndProcedure

ProcedureDLL GetDiskFreeSpace(Drive.s) ; Retourne l'espace disque restant en Mo
    ; this prevents the 'please insert drive' requester.
    ; GetDiskFreeSpaceEx_() will just return 0 if the drive is not available,
    ; without a prompt to the user:
    SetErrorMode_(#SEM_FAILCRITICALERRORS)
    
    
    If GetDiskFreeSpaceEx_( @drive.s, BytesFreeToCaller.int64, TotalBytes.int64, TotalFreeBytes.int64) = 0
        MessageRequester("", "Drive not ready!")
        End
    EndIf
    
    ; reset the error behaviour
    SetErrorMode_(0)
    
    ; calculate sizes in mb.
    
    FreeMB = ((TotalFreeBytes\Long1 >> 20) & $FFF) | (TotalFreeBytes\Long2 << 12)
    ProcedureReturn FreeMB
EndProcedure

ProcedureDLL GetDiskTotalSpace(Drive.s) ; Retourne l'espace disque total en Mo
    ; this prevents the 'please insert drive' requester.
    ; GetDiskFreeSpaceEx_() will just return 0 if the drive is not available,
    ; without a prompt to the user:
    SetErrorMode_(#SEM_FAILCRITICALERRORS)
    
    
    If GetDiskFreeSpaceEx_( @drive.s, BytesFreeToCaller.int64, TotalBytes.int64, TotalFreeBytes.int64) = 0
        MessageRequester("", "Drive not ready!")
        End
    EndIf
    
    ; reset the error behaviour
    SetErrorMode_(0)
    
    ; calculate sizes in mb.
    
    TotalMB = ((TotalBytes\Long1 >> 20) & $FFF) | (TotalBytes\Long2 << 12)
    ProcedureReturn TotalMB
EndProcedure

ProcedureDLL GetDrives() ; Retourne le nombre de lecteur présent sur l'ordinateur
Global listdriv
;#DRIVE_UNKNOWN
;#DRIVE_NO_ROOT_DIR
;#DRIVE_REMOVABLE
;#DRIVE_FIXED
;#DRIVE_REMOTE
;#DRIVE_CDROM
;#DRIVE_RAMDISK
If listdriv=0 : listdriv=1 : NewList Drive.s() : AddElement(drive()) : Else : ClearList(drive()) : EndIf
bitmask.l = GetLogicalDrives_()       ; not a PB Function, its Windows API (becourse of the '_' )
                                      ; each bit represents one drive.
one.l = 1

For i = 0 To 31                       ; go from bit 0 to 31.
  If bitmask  & one<<i                ; the 'one<<i' thingy is a bit tricky, what it does is something like 2^i
       AddElement(drive())                               ; '&' is bitwise AND operator, so if the bit i is one, the whole thing returns true.
       typ=GetDriveType_(Chr(65+i)+":\")
       drive()=Chr(65+i)+"|"+Str(typ)       ; add the driveletter to the string.
  EndIf
Next i
ProcedureReturn CountList(drive())-1
EndProcedure

ProcedureDLL.s SelectDrive(Number) ; Retourne la lettre du nième lecteur (le premier lecteur est le numéro 1) (la fonction GetDrives doit être initialisé au paravant)
Global ndriv
If listdriv And number<=CountList(drive())
ndriv=number
SelectElement(drive(),number)
ProcedureReturn StringField(drive(),1,"|")
EndIf
EndProcedure

ProcedureDLL DriveType() ; Retourne le type du lecteur choisi avec la fonction SelectDrive
If listdriv=1 And ndriv>0
ProcedureReturn Val(StringField(drive(),2,"|"))
EndIf
EndProcedure

;- GADGET

ProcedureDLL SetGadgetReadOnly(GadgetID.l, State.l) ; Active ou désactive le mode lecture seule du gadget choisi
    ProcedureReturn SendMessage_(GadgetID, #EM_SETREADONLY, State, 0)
EndProcedure

ProcedureDLL SpinEvent(idgadget, Min,Max,texte) ; Gere automatiquement les actions faites sur le spingadget choisi (si texte=1 les textes sont autorisés)
  Global boucler , DimMax
  NID=Abs(idgadget)
  If DimMax=0 : Dim mem(#MAXLONG) : DimMax=1 : EndIf
  If GetAsyncKeyState_(48) & 1 Or GetAsyncKeyState_(49) & 1 Or GetAsyncKeyState_(50) & 1 Or GetAsyncKeyState_(51) & 1 Or GetAsyncKeyState_(52) & 1 Or GetAsyncKeyState_(53) & 1 Or GetAsyncKeyState_(54) & 1 Or GetAsyncKeyState_(55) & 1 Or GetAsyncKeyState_(56) & 1 Or GetAsyncKeyState_(57) & 1
    BOUCLER = 1
    If texte=0
    If Val(GetGadgetText(idgadget))>Max : SetGadgetState(idgadget, max) : SetGadgetText(idgadget, Str(max)) : EndIf
    EndIf
  Else
    If BOUCLER = 0
      If Str(Val(GetGadgetText(idgadget))) = GetGadgetText(idgadget)
        If Val(GetGadgetText(idgadget)) = mem(Nid)
          SetGadgetText(idgadget, Str(GetGadgetState(idgadget)))
          mem(Nid) = GetGadgetState(idgadget)
        Else
          mem(Nid) = Val(GetGadgetText(idgadget))
          SetGadgetState(idgadget, mem(Nid))
        EndIf
      EndIf
      If texte = 0
        SetGadgetText(idgadget, Str(GetGadgetState(idgadget)))
      EndIf
    Else
      BOUCLER = 0
    EndIf
  EndIf
  ProcedureReturn IsGadget(idgadget)
EndProcedure

ProcedureDLL GetGadgetTextSize(Gadget.l,Type.l,String.s) ; Retourne la dimension du texte (Type = #TEXTLENGTH ou Type=#TEXTHEIGHT)
  #TEXTLENGTH = 0 
  #TEXTHEIGHT = 1 
  hGadget = GadgetID(GadgetNr) 
  If hGadget 
    hFont   = SendMessage_(hGadget,#WM_GETFONT,0,0) 
    hDC     = GetDC_(hGadget) 
    If hFont 
      SelectObject_(hDC,hFont) 
    EndIf 
    If GetTextExtentPoint32_(hDC,String,Len(String),@TextSize.SIZE) 
      If     Type = #TEXTLENGTH ; Text-Length 
        RetVal = TextSize\cx 
      ElseIf Type = #TEXTHEIGHT ; Text-Height 
        RetVal = TextSize\cy 
      EndIf 
    EndIf 
    ReleaseDC_(hGadget,hDC) 
  EndIf 
  ProcedureReturn RetVal 
EndProcedure

ProcedureDLL EditorGadget_CursorX(Gadget) ; Renvoie la position du curseur sur la ligne en cours
  ; returns X-Pos of Cursor 
  REG = GadgetID(Gadget) 
  SendMessage_(REG,#EM_EXGETSEL,0,Range.CHARRANGE) 
  ProcedureReturn (Range\cpMax-(SendMessage_(REG,#EM_LINEINDEX,SendMessage_(REG,#EM_EXLINEFROMCHAR,0,Range\cpMin),0))+1) 
EndProcedure 

ProcedureDLL EditorGadget_CursorY(Gadget) ; Renvoie le numéro de la ligne en cours d'ecriture
  ; returns Y-Pos of Cursor 
  REG = GadgetID(Gadget) 
  SendMessage_(REG,#EM_EXGETSEL,0,Range.CHARRANGE) 
  ProcedureReturn SendMessage_(REG,#EM_EXLINEFROMCHAR,0,Range\cpMin)+1 
EndProcedure 

ProcedureDLL EditorGadget_CursorPos(Gadget) ; Renvoie la position du curseur
  ; returns relative Position of Cursor 
  SendMessage_(GadgetID(Gadget),#EM_EXGETSEL,0,Range.CHARRANGE) 
  ProcedureReturn Range\cpMax 
EndProcedure 

ProcedureDLL EditorGadget_Locate(Gadget,colonne,ligne) ; Positionne le curseur à la position choisie
  ; Set cursor position 
  REG = GadgetID(Gadget) 
  CharIdx = SendMessage_(REG,#EM_LINEINDEX,y-1,0) 
  LLength = SendMessage_(REG,#EM_LINELENGTH,CharIdx,0) 
  If LLength >= x-1 
    CharIdx + x-1 
  EndIf 
  Range.CHARRANGE 
  Range\cpMin = CharIdx 
  Range\cpMax = CharIdx 
  SendMessage_(REG,#EM_EXSETSEL,0,Range) 
EndProcedure 

ProcedureDLL EditorGadget_SelectedTextStart(Editor) ; Renvoie la position de début du texte sélectionné
SendMessage_(GadgetID(Editor),#EM_GETSEL,@CSP, @CEP)
ProcedureReturn CSP
EndProcedure

ProcedureDLL EditorGadget_SelectedTextStop(Editor) ; Renvoie la position de fin du texte sélectionné
SendMessage_(GadgetID(Editor),#EM_GETSEL,@CSP, @CEP)
ProcedureReturn CEP
EndProcedure

ProcedureDLL EditorGadget_Select(Editor, SelectStart, SelectEnd) ; Sélectionne le texte positionné entre SelectStart et SelectEnd
ProcedureReturn SendMessage_(GadgetID(Editor), #EM_SETSEL, Selectstart,Selectend)
EndProcedure
   
ProcedureDLL EditorGadget_Select_2(Gadget, LineStart.l, CharStart.l, LineEnd.l, CharEnd.l) ; Sélectionne le texte positionné entre LineStart, CharStart et LineEnd, CharEnd
  sel.CHARRANGE 
  sel\cpMin = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineStart, 0) + CharStart - 1 
  
  If LineEnd = -1 
    LineEnd = SendMessage_(GadgetID(Gadget), #EM_GETLINECOUNT, 0, 0)-1 
  EndIf 
  sel\cpMax = SendMessage_(GadgetID(Gadget), #EM_LINEINDEX, LineEnd, 0) 
  
  If CharEnd = -1 
    sel\cpMax + SendMessage_(GadgetID(Gadget), #EM_LINELENGTH, sel\cpMax, 0) 
  Else 
    sel\cpMax + CharEnd - 1 
  EndIf 
  SendMessage_(GadgetID(Gadget), #EM_EXSETSEL, 0, @sel) 
EndProcedure 
         
ProcedureDLL.s EditorGadget_SelectedText(Editor) ; Renvoie le texte sélectionné
ProcedureReturn Mid(GetGadgetText(Editor),EditorGadget_SelectedTextStart(Editor)+1,EditorGadget_SelectedTextStop(Editor)-EditorGadget_SelectedTextStart(Editor))
EndProcedure

ProcedureDLL.l EditorGadget_ReplaceText(Editor, KeyStart$, KeyStop$,Text$) ; Permet d'encadrer le texte sélectionné par KeyStart$ et KeyStop$ (si Text$ est précisé le texte sélectionné sera remplacé par Text$)
TextSelect$=EditorGadget_SelectedText(Editor)
Editor$=GetGadgetText(Editor)
If TextSelect$
TextAvant$=Left(Editor$, EditorGadget_SelectedTextStart(Editor))
TextApres$=Right(Editor$, Len(Editor$)-EditorGadget_SelectedTextStop(Editor))
If text$<>""
TextSelect$=text$
EndIf
Else
ns=CountString(Editor$,Chr(13))*2
TextAvant$=Left(Editor$, Editor_CursorPos(Editor)+ns)
TextApres$=Right(Editor$,Len(Editor$)-EditorGadget_CursorPos(Editor)-ns)
TextSelect$=text$
EndIf
ProcedureReturn SetGadgetText(Editor, Textavant$+keyStart$+TextSelect$+keyStop$+TextApres$)
EndProcedure

ProcedureDLL EditorGadget_InsertText(Editor,Text$) ; Insére le texte à la position
ProcedureReturn SendMessage_(GadgetID(gadget),#EM_REPLACESEL,0,Text$) 
EndProcedure

ProcedureDLL EditorGadget_BackgroundColor(Gadget, Color.l) ; Change la couleur de fond de l'éditeur
  format.CHARFORMAT2
  format\cbSize = SizeOf(CHARFORMAT2) 
  format\dwMask = $4000000  ; = #CFM_BACKCOLOR 
  format\crBackColor = Color 
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format) 
EndProcedure

ProcedureDLL EditorGadget_Color(Gadget, Color.l) ; Change la couleur du texte sélectionné
  format.CHARFORMAT 
  format\cbSize = SizeOf(CHARFORMAT) 
  format\dwMask = #CFM_COLOR 
  format\crTextColor = Color 
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format) 
EndProcedure 

ProcedureDLL EditorGadget_FontSize(Gadget, Fontsize.l) ; Change la taille de la police du texte sélectionné
  format.CHARFORMAT 
  format\cbSize = SizeOf(CHARFORMAT) 
  format\dwMask = #CFM_SIZE 
  format\yHeight = FontSize*20 
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format) 
EndProcedure

ProcedureDLL EditorGadget_Font(Gadget, FontName.s) ; Change la police du texte sélectionné
  format.CHARFORMAT 
  format\cbSize = SizeOf(CHARFORMAT) 
  format\dwMask = #CFM_FACE 
  PokeS(@format\szFaceName, FontName) 
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format) 
EndProcedure 

ProcedureDLL EditorGadget_Format(Gadget, Flags.l) ; Change le format du texte sélectionné (#CFM_BOLD, #CFM_ITALIC, #CFM_UNDERLINE, #CFM_STRIKEOUT) 
  format.CHARFORMAT 
  format\cbSize = SizeOf(CHARFORMAT) 
  format\dwMask = #CFM_ITALIC|#CFM_BOLD|#CFM_STRIKEOUT|#CFM_UNDERLINE 
  format\dwEffects = Flags 
  SendMessage_(GadgetID(Gadget), #EM_SETCHARFORMAT, #SCF_SELECTION, @format) 
EndProcedure

;- IMAGE

ProcedureDLL ImageToTable(Image, Table) ; Retourne 1 si l'image a été chargée dans le tableau ImageID=#Image : Table=@Tableau(), ex : Dim Tableau(ImageWidth(),ImageHeight()) -> @Tableau()
If Image>=0 And Table
UseImage(Image)
ImageID=ImageID()
  Hdc = CreateCompatibleDC_(GetDC_(ImageID))
  If HDC 
    bmi.BITMAPINFO
    bm.BITMAP
    GetObject_(ImageID, SizeOf(BITMAP), @bm.BITMAP)
    bmi\bmiHeader\biSize   = SizeOf(BITMAPINFOHEADER) 
    bmi\bmiheader\biWidth  = bm\bmWidth
    bmi\bmiheader\biHeight = bm\bmHeight
    bmi\bmiheader\biPlanes = 1 
    bmi\bmiheader\biBitCount = 32 
    bmi\bmiheader\biCompression = #BI_RGB
    HList = AllocateMemory(bm\bmWidth*bm\bmHeight*4)
    GetDIBits_(hDC,ImageID,0,bm\bmHeight,HList,bmi,#DIB_RGB_COLORS) 
    
    For nn = 0 To bm\bmWidth - 1
      For n = 0 To bm\bmHeight - 1
        s = HList + nn * 4 + (bm\bmHeight - 1 - n) * bm\bmWidth * 4
        d = Table + n * 4 + nn * bm\bmHeight * 4
        CopyMemory(s + 2, d, 1)
        CopyMemory(s + 1, d + 1, 1)
        CopyMemory(s, d + 2, 1)
      Next n
      Table+4
    Next nn
  Else
    ProcedureReturn 0
  EndIf
  ProcedureReturn 1
Else
  ProcedureReturn 0
EndIf
EndProcedure


ProcedureDLL TableToImage(Image, Table) ; Crée une image à partir du tableau Image=#Image, Table=@Tableau(), ex : Dim Tableau(ImageWidth(),ImageHeight()) -> @Tableau()
If Image>=0 And Table
UseImage(Image)
ImageID=ImageID()
bm.BITMAP
GetObject_(ImageID, SizeOf(BITMAP), @bm.BITMAP)
bmi.BITMAPINFO
bmi\bmiHeader\biSize   = SizeOf(BITMAPINFOHEADER) 
bmi\bmiheader\biWidth  = bm\bmWidth
bmi\bmiheader\biHeight = bm\bmHeight
bmi\bmiheader\biPlanes = 1 
bmi\bmiheader\biBitCount = 32 
bmi\bmiheader\biCompression = #BI_RGB
pixel=AllocateMemory(bm\bmHeight*bm\bmWidth*4)
    For nn = 0 To bm\bmwidth - 1
      For n = 0 To bm\bmheight - 1
        s = Table + n * 4 + nn * bm\bmHeight * 4
        d = pixel + nn * 4 + (bm\bmHeight - 1 - n) * bm\bmWidth * 4
        CopyMemory(s, d + 2, 1)
        CopyMemory(s + 1, d + 1, 1)
        CopyMemory(s + 2, d, 1)
      Next
      table + 4
    Next
HDC=StartDrawing(ImageOutput())
SetDIBits_(HDC,ImageID,0,ImageHeight(), pixel, bmi, #DIB_RGB_COLORS)
StopDrawing()
FreeMemory(pixel)
ProcedureReturn 1
Else
ProcedureReturn 0
EndIf
EndProcedure

ProcedureDLL.s OpenImageRequester(Title.s, DefaultPath.s) ; Retourne le fichier sélectionné
UseJPEGImageDecoder()
UsePNGImageDecoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()
UseEC_OLEImageDecoder()
ProcedureReturn OpenFileRequester(Title.s,DefaultPath.S,"Images (JPG, BMP, PNG, TGA, TIFF, ICO, CUR, WMF, EMF)|*.jpg;*.jpeg;*.bmp;*.tga;*.tiff*.png;*.ico;*.cur;*.wmf;*.emf",0)
EndProcedure

ProcedureDLL.s OpenImageRequester2(Title.s, DefaultPath.s, Flags) ; Retourne le fichier sélectionné
UseJPEGImageDecoder()
UsePNGImageDecoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()
UseEC_OLEImageDecoder()
ProcedureReturn OpenFileRequester(Title.s,DefaultPath.S,"Images (JPG, BMP, PNG, TGA, TIFF, ICO, CUR, WMF, EMF)|*.jpg;*.jpeg;*.bmp;*.tga;*.tiff*.png;*.ico;*.cur;*.wmf;*.emf",0,Flags)
EndProcedure

;- MATH

ProcedureDLL IsInteger(Number.f) ; Retourne 1 si le nombre est entier
    If Round(number, 1) = number And Round(number, 0) = number
        ProcedureReturn 1
    EndIf
EndProcedure

ProcedureDLL IsOddNumber(Number.l) ; Retourne 1 si le nombre est impair
    ProcedureReturn Number & 1
EndProcedure

ProcedureDLL IsPrimeNumber(Number.l) ; Retourne 1 si le nombre est premier
    ; algorithme de Knuth
    Global list
    If list = 0 : NewList listNP() : list = 1 : Else : ClearList(listNP()) : EndIf
    AddElement(listNP()) : listNP() = 2
    If IsOddNumber(number)
        If number > 2
            For a = 3 To Int(Round(Sqr(number), 1)) Step 2
                v = 0
                nbl = CountList(listNP())
                For b = 0 To nbl - 1
                    SelectElement(listNP(), b)
                    If IsInteger(a / listNP()) = 0
                        v = v + 1
                    EndIf
                Next
                If v = nbl
                    AddElement(listNP())
                    listNP() = a
                EndIf
            Next
        ElseIf number<2
        ProcedureReturn 0
        EndIf
        v = 0
        For a = 0 To CountList(listNP()) - 1
            SelectElement(listNP(), a)
            If IsInteger(number / listNP())
                v = 1
            EndIf
        Next
        If v = 0
            ProcedureReturn 1
        EndIf
    Else
        If number = 2
            ProcedureReturn 1
        EndIf
    EndIf
EndProcedure

ProcedureDLL PrimeNumberList(Number.l) ; Retourne le nième nombre premier
    ;num = 2147483647
    ; algorithme de Knuth
    ;Global list2
    ;If list2 = 0 : NewList listNP2() : list2 = 1 : Else : ClearList(listNP2()) : EndIf
    ;AddElement(listNP2()) : listNP2() = 2
    ;If Number = < 0
    ;    ProcedureReturn 0
    ;ElseIf Number = 1
    ;    ProcedureReturn 2
    ;Else
    ;    For a = 3 To num Step 2
    ;        v = 0
    ;        nbl = CountList(listNP2())
    ;        For b = 0 To nbl - 1
    ;            SelectElement(listNP2(), b)
    ;            If Integer(a / listNP2()) = 0
    ;                v = v + 1
    ;            EndIf
    ;        Next
    ;        If v = nbl
    ;            AddElement(listNP2())
    ;            listNP2() = a
    ;            If CountList(listNP2()) = Number
    ;                SelectElement(listNP2(), Number - 1)
    ;                ProcedureReturn listNP2()
    ;            EndIf
    ;        EndIf
    ;    Next
    ;EndIf
    If number = 1
    ProcedureReturn 2
    ElseIf number > 1
For a=3 To 2147483647 Step 2
If IsPrimeNumber(a)
b=b+1
If b=number
ProcedureReturn a
EndIf
EndIf
Next
EndIf
EndProcedure

Procedure.s nb2txt(Number)
num.s=Str(number)
Dim nb.s(100)
nb(1)="un"
nb(2)="deux"
nb(3)="trois"
nb(4)="quatre"
nb(5)="cinq"
nb(6)="six"
nb(7)="sept"
nb(8)="huit"
nb(9)="neuf"
nb(10)="dix"
nb(11)="onze"
nb(12)="douze"
nb(13)="treize"
nb(14)="quatorze"
nb(15)="quinze"
nb(16)="seize"
nb(17)="dix-sept"
nb(18)="dix-huit"
nb(19)="dix-neuf"
nb(20)="vingt"
nb(30)="trente"
nb(40)="quarante"
nb(50)="cinquante"
nb(60)="soixante"
nb(70)="soixante-dix"
nb(80)="quatre-vingt"
nb(90)="quatre-vingt-dix"
nb(28)="cent"
nb(29)="cents"
nb(31)="mille"
nb(32)="million"
nb(33)="millions"
nb(34)="milliard"
nb(35)="milliards"
If Len(num)=3
    If Val(Left(num,1))>1 And Val(Right(num,2))=0
        numb.s=nb(Val(Left(num,1)))+" "+nb(29)
    ElseIf Val(Left(num,1))>1 And Val(Right(num,2))<>0
        numb.s=nb(Val(Left(num,1)))+" "+nb(28)
    Else
        numb=nb(28)
    EndIf
    If Val(Right(num,2))>10 And Val(Right(num,2))<20
        numb=numb+" "+nb(Val(Right(num,2)))
    ElseIf Val(Right(num,2))>70 And Val(Right(num,2))<80
        If Val(Right(num,2))=71
            numb=numb+" "+nb(60)+"-et-"+nb(10+Val(Right(num,1)))
        Else
            numb=numb+" "+nb(60)+"-"+nb(10+Val(Right(num,1)))
        EndIf
    ElseIf Val(Right(num,2))>90 And Val(Right(num,2))<100
        numb=numb+" "+nb(80)+"-"+nb(10+Val(Right(num,1)))
    ElseIf Val(Right(num,2))=21 Or Val(Right(num,2))=31 Or Val(Right(num,2))=41 Or Val(Right(num,2))=51 Or Val(Right(num,2))=61
        numb=numb+" "+nb(10*Val(Mid(num,2,1)))+"-et-"+nb(Val(Right(num,1)))
    Else
        If Val(Mid(num,2,1))<>0
            numb=numb+" "+nb(Val(Mid(num,2,1))*10)
            b=1
        EndIf
        If Val(Right(num,1))<>0
            If b=1 : int.s="-" : Else : int.s=" " : EndIf
            numb=numb+int+nb(Val(Right(num,1)))
        EndIf
    EndIf
ElseIf Len(num)=2
    If Val(num)>10 And Val(num)<20
        numb=nb(Val(num))
    ElseIf Val(num)>70 And Val(num)<80
        If Val(num)=71
            numb=nb(60)+"-et-"+nb(10+Val(Right(num,1)))
        Else
            numb=nb(60)+"-"+nb(10+Val(Right(num,1)))
        EndIf
    ElseIf Val(num)>90 And Val(num)<100
        numb=nb(80)+"-"+nb(10+Val(Right(num,1)))
    ElseIf Val(num)=21 Or Val(num)=31 Or Val(num)=41 Or Val(num)=51 Or Val(num)=61
        numb=nb(10*Val(Left(num,1)))+"-et-"+nb(Val(Right(num,1)))
    Else
        If Val(Left(num,1))<>0
            numb=nb(Val(Left(num,1))*10)
            b=1
        EndIf
        If Val(Right(num,1))<>0
        If b=1 : int.s="-" : Else : int.s=" " : EndIf
            numb=numb+int+nb(Val(Right(num,1)))
        EndIf
    EndIf
Else
    If Val(Right(num,1))<>0
        numb=nb(Val(Right(num,1)))
    EndIf
EndIf
ProcedureReturn numb
EndProcedure

ProcedureDLL.s NbToTxt(Number.l) ; Retourne sous forme texte le nombre choisie entre -2147483648 et +2147483647
If number<0
num.s="moins "
number=Abs(number)
Else
num.s=""
EndIf
lon=Len(Str(number))
If number=0
    ProcedureReturn "zéro"
EndIf
If lon<4
    num.s=num+nb2txt(number)
ElseIf lon>3 And lon<7
    If Val(Right(Str(number),3))=0
        num.s=num+nb2txt(Val(Left(Str(number),lon-3)))+" "+nb(31)
    Else
        num.s=num+nb2txt(Val(Left(Str(number),lon-3)))+" "+nb(31)+" "+nb2txt(Val(Right(Str(number),3)))
    EndIf
ElseIf lon>6 And lon<10
    If Val(Left(Str(number),lon-6))>1
        num.s=num+nb2txt(Val(Left(Str(number),lon-6)))+" "+nb(33)
    Else
        num.s=num+nb2txt(Val(Left(Str(number),lon-6)))+" "+nb(32)
    EndIf
    If Val(Right(Str(number),6))>0
        num.s=num.s+" "+NbToTxt(Val(Right(Str(number),6)))
    EndIf
ElseIf lon>9 And lon<13
    If Val(Left(Str(number),lon-9))>1
        num.s=num+nb2txt(Val(Left(Str(number),lon-9)))+" "+nb(35)
    Else
        num.s=num+nb2txt(Val(Left(Str(number),lon-9)))+" "+nb(34)
    EndIf
    If Val(Right(Str(number),9))>0
        num.s=num.s+" "+NbToTxt(Val(Right(Str(number),9)))
    EndIf
EndIf
ProcedureReturn num
EndProcedure

ProcedureDLL.f Cosd( Angle.f ) ; Retourne le cos d'un angle en degré
ProcedureReturn Cos( Angle * 0.0174533 )
EndProcedure

ProcedureDLL.f Sind( Angle.f ) ; Retourne le sin d'un angle en degré
ProcedureReturn Sin( Angle * 0.0174533 )
EndProcedure

;- MOUSE

ProcedureDLL ScreenMouseX() ; Retourne la position en x de la souris 
GetCursorPos_(CursorPos.POINT)
     ProcedureReturn CursorPos\x
EndProcedure

ProcedureDLL ScreenMouseY() ; Retourne la position en y de la souris
GetCursorPos_(CursorPos.POINT)
      ProcedureReturn  CursorPos\y
EndProcedure

ProcedureDLL SetMousePos(x,y) ; Modifie la position de la souris
ProcedureReturn SetCursorPos_(x,y)
EndProcedure

ProcedureDLL MouseClick(Parameter) ; Simule une action sur les boutons de la souris (EX : MouseClick(#MOUSEEVENTF_RIGHTDOWN) : mouseclick(#MOUSEEVENTF_RIGHTUP))
  Mem.l=GlobalAlloc_(0,8) 
  GetCursorPos_(Mem) 
  re=mouse_event_(Parameter|#MOUSEEVENTF_ABSOLUTE,PeekL(Mem)*($FFFF/GetSystemMetrics_(0)),PeekL(Mem+4)*($FFFF/GetSystemMetrics_(1)),0,GetMessageExtraInfo_()) 
  GlobalFree_(Mem) 
  ProcedureReturn re
EndProcedure 

ProcedureDLL IsMouseOver(GadgetID) ; Retourne 1 si la souris est au dessus du gadget
    GetWindowRect_(GadgetID,re.RECT) 
    re\Left = re\left 
    re\top  = re\top 
    re\right  = re\right 
    re\bottom  = re\bottom 
    GetCursorPos_(pt.POINT) 
    Result = PtInRect_(re,pt\x,pt\y) 
    ProcedureReturn Result 
EndProcedure 

;- PUREBASIC

ProcedureDLL.s GetPureBasicPath() ; Retourne le dossier d'installation de PureBasic
    path.s = "Applications\PureBasic.exe\shell\open\command"
    If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, path, 0, #KEY_ALL_ACCESS, @Key) = #ERROR_SUCCESS
        indir.s = Space(500)
        insize = 500
        If RegQueryValueEx_(Key, "", 0, 0, @indir.s, @insize) = #ERROR_SUCCESS
            RegCloseKey_(Key)
            indir = RemoveString(indir, "%1", 1)
            indir = RemoveString(indir, Chr(34), 1)
            indir = RTrim(indir)
            path = GetPathPart(indir)
        Else
            RegCloseKey_(Key)
            ProcedureReturn ""
        EndIf
    EndIf
    If Path
        ProcedureReturn Path
    EndIf
EndProcedure

ProcedureDLL.s GetPureBasicVersion() ; Retourne la version de PureBasic
    ; environ 330 ms
    path.s = "Applications\PureBasic.exe\shell\open\command"
    If RegOpenKeyEx_(#HKEY_CLASSES_ROOT, path, 0, #KEY_ALL_ACCESS, @Key) = #ERROR_SUCCESS
        indir.s = Space(500)
        insize = 500
        If RegQueryValueEx_(Key, "", 0, 0, @indir.s, @insize) = #ERROR_SUCCESS
            RegCloseKey_(Key)
            indir = RemoveString(indir, "%1", 1)
            indir = RemoveString(indir, Chr(34), 1)
            indir = RTrim(indir)
            path = GetPathPart(indir)
        Else
            MessageRequester("Erreur!", "Hum... Je ne trouve pas Purebasic" + Chr(13) + filename.s, #MB_ICONERROR)
            RegCloseKey_(Key)
            path = PathRequester("Indiquer le repertoire du compilateur de PureBasic", "C:\program files\PureBasic\compilers\")
            If path
                file = ReadFile(#PB_Any, path + "pbcompiler.exe")
                If file
                    path = Left(path, Len(path) - 1)
                    CloseFile(file)
                Else
                    MessageRequester("Information", "Impossible de trouver le compilateur de PureBasic", #MB_ICONERROR)
                    End
                EndIf
            Else
                MessageRequester("Information", "Vous n'avez pas spécifié de repertoire", #MB_ICONERROR)
                End
            EndIf
        EndIf
    EndIf
    file = ReadFile(#PB_Any, path + "\compilers\PBcompiler.exe")
    If file
        Repeat
            ligne$ = ReadString()
            pos = FindString(ligne$, "PureBasic v", 0)
            If pos <> 0
                po = pos
                CIPureBasic$ = ligne$
            EndIf
        Until Eof(file) Or pos <> 0
        CloseFile(file)
        CIPureBasic$ = StringField(Right(CIPureBasic$, Len(CIPureBasic$) - (po + 10)), 1, "*")
    EndIf
    ProcedureReturn CIPureBasic$
EndProcedure

;- REQUESTER

ProcedureDLL MSGP(Titre.s, Msg.s, Type.l, Icone.l) ; Affiche une boîte de dialogue avancée
    ; Type  | Boutons qui apparaissent avec résultat
    ; 0       OK = 1
    ; 1       OK = 1, Annuler = 2
    ; 2       Abandon = 3, Reessayer = 4, Ignorer = 5
    ; 3       Oui = 6, Non = 7, Annuler = 2
    ; 4       Oui = 6, Non = 7
    ; 5       Reessayer = 4, Annuler = 2
    
    ; Icone | Description de l'icône
    ; 0       Rien          : pas d'icône
    ; 1       Interdit      : rond rouge avec une croix blanche
    ; 2       Aide          : bulle avec un ?
    ; 3       Danger        : triangle jaune avec un !
    ; 4       Information   : bulle avec un I
    
    If Type >= 0 And Type <= 5 And Icone >= 0 And Icone <= 4
        ProcedureReturn MessageRequester(Titre, Msg, Type + 16 * Icone)
    Else
        ProcedureReturn 0
    EndIf
EndProcedure

ProcedureDLL MSG(Text.s) ; Affiche une boîte de dialogue
    MessageRequester("Information", text.s)
EndProcedure

;- SPECIAL DIRECTORY

ProcedureDLL.s GetUserDirectory(Flag.l) ; Retourne l'adresse d'un répertoire système
    ; Certaines des options ci-dessous ne fonctionnent que sous Windows XP
    hKey.l = 0
    keyvalue.s = Space(255)
    datasize.l = 255
    If Flag < 24 Or Flag = 36
        OpenKey.l = #HKEY_CURRENT_USER
    Else
        OpenKey.l = #HKEY_LOCAL_MACHINE
    EndIf
    SubKey.s = "Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders"
    Select Flag
        Case 1 ; Dossier où se trouve les outils d'administration
            ValueName.s = "Administrative Tools"
        Case 2 ; Application Data
            ValueName.s = "AppData"
        Case 3 ; Repertoire temporaire pour les fichiers internet
            ValueName.s = "Cache"
        Case 4 ; Repertoire temporaire pour les fichiers à graver
            ValueName.s = "CD Burning"
        Case 5 ; Dossier des cookies
            ValueName.s = "Cookies"
        Case 6 ; Bureau de l'utilisateur
            ValueName.s = "Desktop"
        Case 7 ; Dossier des favoris
            ValueName.s = "Favorites"
        Case 8 ; Dossier contenant les polices de Windows
            ValueName.s = "Fonts"
        Case 9 ; Historique de Windows
            ValueName.s = "History"
        Case 10 ; Application Data dans paramètres locaux
            ValueName.s = "Local AppData"
        Case 11 ; Paramètres locaux
            ValueName.s = "Local Settings"
        Case 12 ; Dossier contenant vos musiques dans Mes Documents
            ValueName.s = "My Music"
        Case 13 ; Dossier contenant vos images dans Mes Documents
            ValueName.s = "My Pictures"
        Case 14 ; Dossier contenant vos vidéos dans Mes Documents
            ValueName.s = "My Video"
        Case 15 ; Voisinage réseau
            ValueName.s = "NetHood"
        Case 16 ; Mes Documents
            ValueName.s = "Personal"
        Case 17 ; Voisinage d'impression
            ValueName.s = "PrintHood"
        Case 18 ; Menu Démarrer\Progammes
            ValueName.s = "Programs"
        Case 19 ; Fichiers récemments ouverts (contient des raccourcis)
            ValueName.s = "Recent"
        Case 20 ; Dossier envoyer vers
            ValueName.s = "SendTo"
        Case 21 ; Menu Démarrer
            ValueName.s = "Start Menu"
        Case 22 ; Menu Démarrer\Progammes\Démarrage
            ValueName.s = "Startup"
        Case 23 ; Modèles
            ValueName.s = "Templates"
        Case 36 ; Microsoft\Internet Explorer\Quick Launch
            ValueName.s = "AppData"
            ; Même chose mais pour 'Tous les utlisateurs'
            
        Case 24
            ValueName.s = "Common Administrative Tools"
        Case 25
            ValueName.s = "Common AppData"
        Case 26
            ValueName.s = "Common Desktop"
        Case 27 ; Documents de tous les utilisateurs , il est aussi le dossier nommé 'Documents partagés'
            ValueName.s = "Common Documents"
        Case 28
            ValueName.s = "Common Favorites"
        Case 29
            ValueName.s = "Common Programs"
        Case 30
            ValueName.s = "Common Start Menu"
        Case 31
            ValueName.s = "Common Startup"
        Case 32
            ValueName.s = "Common Templates"
        Case 33
            ValueName.s = "CommonMusic"
        Case 34
            ValueName.s = "CommonPictures"
        Case 35
            ValueName.s = "CommonVideo"
    EndSelect
    
    If RegOpenKeyEx_(OpenKey, SubKey, 0, #KEY_READ, @hKey)
        MessageBeep_(#MB_ICONEXCLAMATION) ; alerte la clé n'éxiste pas !!!
        keyvalue = "PAS DE CLE"
    Else
        If RegQueryValueEx_(hKey, ValueName, 0, 0, @keyvalue, @datasize)
            keyvalue = "" ; si la sous-clé n'éxiste pas renvoi un texte vide
        Else
            keyvalue = Left(keyvalue, datasize - 1) ; si la sous clé existe renvoi l'adresse du repertorie demandé
        EndIf
        RegCloseKey_(hKey)
    EndIf
    If Flag = 36
        keyvalue = keyvalue + "\Microsoft\Internet Explorer\Quick Launch"
    EndIf
    If Right(keyvalue,1)<>"\" : keyvalue=keyvalue+"\" : EndIf
    ProcedureReturn keyvalue
EndProcedure

ProcedureDLL.s GetApplicationDirectory() ; Retourne l'adresse du programme
    appdir$ = Space(255)
    If Right(appdir$, 1) = "\"
    Else
        appdir$ = appdir$ + "\"
    EndIf
    GetCurrentDirectory_(255, @appdir$)
    If Right(appdir$, 1) <> "\" ; si l'adresse ne finit pas par "\"
        appdir$ = appdir$ + "\" ; on rajoute le "\"
    EndIf
    ProcedureReturn appdir$
EndProcedure

ProcedureDLL.s GetUserProfileDirectory() ; Retourne l'adresse du répertoire utilisateur
    OpenProcessToken_(GetCurrentProcess_(), $08, @token)
    
    Length.l = 512
    directory$ = Space(Length)
    
    GetUserProfileDirectory_(token, directory$, @Length)
    ProcedureReturn Left(directory$, Length) + "\"
EndProcedure

ProcedureDLL.s GetWindowsDirectory() ; Retourne l'adresse de Windows
    windir$ = Space(255) : GetWindowsDirectory_( @windir$, 255) : If Right(windir$, 1) <> "\" : windir$ + "\" : EndIf
    ProcedureReturn windir$
EndProcedure

ProcedureDLL.s GetSystemDirectory() ; Retourne l'adresse du répertoire système
    sysdir$ = Space(255) : GetSystemDirectory_( @sysdir$, 255) : If Right(sysdir$, 1) <> "\" : sysdir$ + "\" : EndIf
    ProcedureReturn sysdir$
EndProcedure

ProcedureDLL.s GetTempDirectory() ; Retourne l'adresse du répertoire temporaire
  Protected WinTemp.s
  WinTemp  = Space(255) 
  GetTempPath_(255, WinTemp)
  If Right(WinTemp, 1) <> "\" : WinTemp = WinTemp + "\" : EndIf
  ProcedureReturn WinTemp
EndProcedure

;- SPECIAL COMMAND

ProcedureDLL AutoDeleteProg() ; Supprime le programme
    ExeName.s = Space(255) : GetModuleFileName_(0, @ExeName, 255) ; Recherche l'adresse du programme
    cmd$ = Space(255) : GetEnvironmentVariable_("comspec", @cmd$, 255) ; Recherche le programme de commande (command.exe ou cmd.exe)
    RunProgram(cmd$, "/c del.exe /F " + Chr(34) + ExeName + Chr(34), GetPathPart(ExeName), 2) : End ; Lance la suppression en mode forcé et caché
EndProcedure

ProcedureDLL.s GetCommandPath() ; Retourne l'adresse du programme 'ligne de commandes' (command.exe ou cmd.exe)
    cmd$ = Space(255) : GetEnvironmentVariable_("comspec", @cmd$, 255)
    ProcedureReturn cmd$
EndProcedure

ProcedureDLL CreateShortcut(Target$, Shortcut$, Arguments$, Comments$, WorkDirectory$, WindowSize.l, IconShortcut$, IconNumber.l ) ; Crée un raccourci 
    CoInitialize_(0)
    If WindowSize = 1
        TFen.l = #SW_SHOWNORMAL
    ElseIf WindowSize = 2
        TFen.l = #SW_SHOWMAXIMIZED
    ElseIf WindowSize = 3
        TFen.l = #SW_SHOWMINIMIZED
    EndIf
    
    If CoCreateInstance_(?CLSID_ShellLink, 0, 1, ?IID_IShellLink, @psl.IShellLinkA) = 0
        
        Set_ShellLink_preferences :
        psl\SetPath( @Target$)
        psl\SetArguments( @Arguments$)
        psl\SetWorkingDirectory( @WorkDirectory$)
        psl\SetDescription( @Comments$)
        psl\SetShowCmd(TFen)
        psl\SetHotkey(0) ; Touche raccourci
        psl\SetIconLocation( @IconShortcut$, IconNumber.l)
        
        ShellLink_SAVE :
        If psl\QueryInterface(?IID_IPersistFile, @ppf.IPersistFile) = 0
            mem.s = Space(1000)
            MultiByteToWideChar_(#CP_ACP, 0, Shortcut$, -1, mem, 1000)
            hres = ppf\Save( @mem, #True)
            result = 1
            ppf\Release()
        EndIf
        psl\Release()
    EndIf
    CoUninitialize_()
    ProcedureReturn result
    
    DataSection
        CLSID_ShellLink :
            Data.l $00021401
            Data.w $0000, $0000
            Data.b $C0, $00, $00, $00, $00, $00, $00, $46
        IID_IShellLink :
            Data.l $000214EE
            Data.w $0000, $0000
            Data.b $C0, $00, $00, $00, $00, $00, $00, $46
        IID_IPersistFile :
            Data.l $0000010B
            Data.w $0000, $0000
            Data.b $C0, $00, $00, $00, $00, $00, $00, $46
    EndDataSection
    
EndProcedure

ProcedureDLL ComputerShutDown(Flags.l) ; 1 : fermer la session, 2 : éteindre, 3 : redémarrer, 4 : mettre en veille prolongée, 5 : mettre en veille
    ; POUR LA MISE EN VEILLE PROLONGEE : LE PROGRAMME NE VERIFIE PAS SI LA FONCTION EST ACTIVE SUR VOTRE ORDINATEUR (si elle ne l'est pas veille prologée sera équivalente à une veille normale)
    ; Param = paramètre d'instinction de l'ordinateur
    ; 1 : quitter session
    ; 2 : arrêter
    ; 3 : redémarrer
    ; 4 : veille prolongée
    ; 5 : veille
    #TOKEN_ADJUST_PRIVILEGES = 32
    #TOKEN_QUERY = 8
    #SE_PRIVILEGE_ENABLED = 2
    #EWX_LOGOFF = 0
    #EWX_SHUTDOWN = 1
    #EWX_REBOOT = 2
    #EWX_FORCE = 4
    #EWX_POWEROFF = 8
    
    Structure MyLUID
        LowPart.l
        HighPart.l
        Attributes.l
    EndStructure
    
    Structure MyTOKEN
        PrivilegeCount.l
        LowPart.l
        HighPart.l
        Attributes.l
    EndStructure
    
    Protected hdlTokenHandle.l, tmpLuid.MyLUID, tkp.MyTOKEN, tkpNewButIgnored.MyTOKEN, lBufferNeeded.l
    
    OpenProcessToken_(GetCurrentProcess_(), #TOKEN_ADJUST_PRIVILEGES | #TOKEN_QUERY, @hdlTokenHandle) ; On demande à Windows l'autorisation de le quitter (c'est n'importe quoi, demander à son ordi si il veut bien aller dormir, on va où là?)
    SysName.s = "" + Chr(0)
    Name.s = "SeShutdownPrivilege" + Chr(0)
    LookupPrivilegeValue_(SysName, Name, @tmpLuid)
    tmpLuid\Attributes = #SE_PRIVILEGE_ENABLED
    tkp\PrivilegeCount = 1
    tkp\LowPart = tmpLuid\LowPart
    tkp\HighPart = tmpLuid\HighPart
    tkp\Attributes = tmpLuid\Attributes
    AdjustTokenPrivileges_(hdlTokenHandle, 0, @tkp, SizeOf(MyTOKEN), @tkpNewButIgnored, @lBufferNeeded)
    
    Select Flags
        Case 1 : ExitWindowsEx_(#EWX_LOGOFF | #EWX_FORCE, 0) ; On quitte la session en cours en forçant l'arrêt des programmes
        Case 2 : ExitWindowsEx_(#EWX_SHUTDOWN | #EWX_FORCE, 0) ; On éteint l'ordinateur en forçant l'arrêt des programmes
        Case 3 : ExitWindowsEx_(#EWX_REBOOT | #EWX_FORCE, 0) ; On redémarre l'ordinateur en forçant l'arrêt des programmes
        Case 4 : SetSystemPowerState_(#False, #False) ; On passe en mode hibernation sans forcer l'arrêt des programmes
        Case 5 : SetSystemPowerState_(#True, #False) ; On passe en mode veille sans forcer l'arrêt des programmes
    EndSelect
    
EndProcedure

ProcedureDLL.s GetExeName() ; Retourne le nom du programme
    ExeName.s = Space(255) : GetModuleFileName_(0, @ExeName, 255)
    ProcedureReturn GetFilePart(ExeName)
EndProcedure

ProcedureDLL.s GetExePath() ; Retourne l'adresse du programme
    ExeName.s = Space(255) : GetModuleFileName_(0, @ExeName, 255)
    ProcedureReturn GetPathPart(ExeName)
EndProcedure

ProcedureDLL GetBatteryACLineStatus() ; Retourne 3 si l'ordinateur est branché mais sans batterie ; 4 si branché et batterie présente ; sinon retourne une valeur différente
    powerstatus = GetSystemPowerStatus_( @LPSYSTEM_POWER_STATUS.STATUS)
    If powerstatus
        If LPSYSTEM_POWER_STATUS\ACLineStatus = 1 And LPSYSTEM_POWER_STATUS\BatteryFlag = 128
            ProcedureReturn 3
        ElseIf LPSYSTEM_POWER_STATUS\ACLineStatus = 1 And LPSYSTEM_POWER_STATUS\BatteryFlag >= 8 And LPSYSTEM_POWER_STATUS\BatteryFlag = < 9
            ProcedureReturn 4
        Else
            ProcedureReturn LPSYSTEM_POWER_STATUS\ACLineStatus
        EndIf
    EndIf
EndProcedure

ProcedureDLL GetBatteryLifePercent() ; Retourne en pourcentage la capacité restante de la batterie
    powerstatus = GetSystemPowerStatus_( @LPSYSTEM_POWER_STATUS.STATUS)
    If powerstatus
        ProcedureReturn LPSYSTEM_POWER_STATUS\BatteryLifePercent
    EndIf
EndProcedure

ProcedureDLL DownloadFile(URL.s, FileToSave.s, GadgetText.l, SetGadgetTextFileFind.s, SetGadgetTextFileNotFind.s, GadgetProgress.l) ; Permet de télécharger un fichier
; SetGadgetTextFileFind.s="Avancement du téléchargement : |BytesDownloaded|/|SizeFile| ko : |Progress|
    isLoop.b = 1
    Bytes.l = 0
    fBytes.l = 0
    Buffer.l = 4096
    res.s = ""
    tmp.s = ""
    
    OpenType.b = 1
    INTERNET_FLAG_RELOAD.l = $80000000
    INTERNET_DEFAULT_HTTP_PORT.l = 80
    INTERNET_SERVICE_HTTP.l = 3
    HTTP_QUERY_STATUS_CODE.l = 19
    HTTP_QUERY_STATUS_TEXT.l = 20
    HTTP_QUERY_RAW_HEADERS.l = 21
    HTTP_QUERY_RAW_HEADERS_CRLF.l = 22
    
    MemoryID = AllocateMemory(Buffer)
    
    Result = CreateFile(1, FileToSave)
    If Result
        
        hInet = InternetOpen_("", OpenType, #Null, #Null, 0)
        hURL = InternetOpenUrl_(hInet, URL, #Null, 0, INTERNET_FLAG_RELOAD, 0)
        If hInet <> 0 And hURL <> 0
            domain.s = ReplaceString(Left(URL, (FindString(URL, "/", 8) - 1)), "http://", "")
            hInetCon = InternetConnect_(hInet, domain, INTERNET_DEFAULT_HTTP_PORT, #Null, #Null, INTERNET_SERVICE_HTTP, 0, 0)
            If hInetCon > 0
                hHttpOpenRequest = HttpOpenRequest_(hInetCon, "HEAD", ReplaceString(URL, "http://" + domain + "/", ""), "http/1.1", #Null, 0, INTERNET_FLAG_RELOAD, 0)
                If hHttpOpenRequest > 0
                    iretval = HttpSendRequest_(hHttpOpenRequest, #Null, 0, 0, 0)
                    If iretval > 0
                        lBufferLength.l = 0
                        lBufferLength = 1024
                        sBuffer.s = Space(lBufferLength)
                        HttpQueryInfo_(hHttpOpenRequest, HTTP_QUERY_STATUS_CODE, sBuffer, @lBufferLength, 0)
                        tmp = Left(sBuffer, lBufferLength)
                        If Trim(tmp) = "200"
                            lBufferLength.l = 0
                            lBufferLength = 1024
                            sBuffer.s = Space(lBufferLength)
                            HttpQueryInfo_(hHttpOpenRequest, HTTP_QUERY_RAW_HEADERS_CRLF, sBuffer, @lBufferLength, 0)
                            tmp = Left(sBuffer, lBufferLength)
                            If FindString(tmp, "Content-Length:", 1) > 0
                                ii.l = FindString(tmp, "Content-Length:", 1) + Len("Content-Length:")
                                tmp = Mid(tmp, ii, Len(tmp) - ii)
                                myMax = Val(Trim(tmp))
                            EndIf
            Repeat
                InternetReadFile_(hURL, MemoryID, Buffer, @Bytes)
                If Bytes = 0
                    isLoop = 0
                Else
                    fBytes = fBytes + Bytes
                    If mymax > 0
                    If GadgetText > 0
                        SetGadgetText(GadgetText, ReplaceString(ReplaceString(ReplaceString(SetGadgetTextFileFind,"|BytesDownloaded|",Str(fbytes / 1024)),"|SizeFile|",Str(mymax / 1024)),"|Progress|",Str(fbytes * 100 / myMax)))
                    EndIf
                    If GadgetProgress > 0
                        SetGadgetState(GadgetProgress, fbytes * 100 / myMax)
                    EndIf
                    Else
                    If GadgetText > 0
                        SetGadgetText(GadgetText, ReplaceString(ReplaceString(ReplaceString(SetGadgetTextFileNotFind,"|BytesDownloaded|",Str(fbytes / 1024)),"|SizeFile|",Str(mymax / 1024)),"|Progress|",Str(fbytes * 100 / myMax)))
                    EndIf
                    EndIf
                    UseFile(1)
                    WriteData(MemoryID, Bytes)
                EndIf
            Until isLoop = 0
            InternetCloseHandle_(hURL)
            InternetCloseHandle_(hInet)
            CloseFile(1)
            FreeMemory(MemoryID)
            EndIf
                    EndIf
                EndIf
            EndIf
            If down = 1
                ProcedureReturn 0
            EndIf
        Else
            CloseFile(1)
            DeleteFile(FileToSave)
            If down = 0
                ProcedureReturn 0
            EndIf
        EndIf
    Else
        If ReadFile(2, FileToSave) <> 0
            CloseFile(2)
            ProcedureReturn 1
        Else
            ProcedureReturn 0
        EndIf
    EndIf
EndProcedure

ProcedureDLL OpenMailProgram(MailAddress.s, Subject.s, Message.s) ; Ouvre le programme par défaut pour envoyer un email (si MailAddressInCopy="", il ne sera pas pris en compte) (pour passer une ligne utiliser #CRLF$)
ProcedureReturn RunProgram("mailto:"+mailaddress+"?Subject="+Subject+m$+"&Body="+ReplaceString(message,#CRLF$," Body="))
EndProcedure



ProcedureDLL OpenMailProgram2(MailAddress.s, Subject.s, Message.s, MailAddressInCopy.s) ; Ouvre le programme par défaut pour envoyer un email (si MailAddressInCopy="", il ne sera pas pris en compte) (pour passer une ligne utiliser #CRLF$)
If MailAddressInCopy<>""
m$="&cc="+MailAddressInCopy
EndIf
ProcedureReturn RunProgram("mailto:"+mailaddress+"?Subject="+Subject+m$+"&Body="+ReplaceString(message,#CRLF$," Body="))
EndProcedure

Gillou · Message par **Gillou** » ven. 04/nov./2005 15:55

Code : Tout sélectionner

ProcedureDLL SendKeys(handle,window$,keys$) ; Ecrit du pour vous (si handle est précisé, la fonction écrit dans la fenêtre choisie) (si window$ est précisé, la fonction écrit dans la fenêtre portant le nom défini)
  If window$<>"" : handle=FindWindow_(0,window$) : EndIf ; Use window$ instead of handle.
  If IsWindow_(handle)=0 ; Does the target window actually exist?
    ProcedureReturn 0 ; Nope, so report 0 for failure to type.
  Else
    ; This block gives the target window the focus before typing.
    thread1=GetWindowThreadProcessId_(GetForegroundWindow_(),0)
    thread2=GetWindowThreadProcessId_(handle,0)
    If thread1<>thread2 : AttachThreadInput_(thread1,thread2,#True) : EndIf
    ;SetForegroundWindow_(handle) ; Target window now has the focus for typing.
    Sleep_(125) ; 1/8 second pause before typing to prevent fast CPU problems.
    ; Now the actual typing starts.
    keybd_event_(#VK_MENU,0,#KEYEVENTF_KEYUP,0) ; Release ALT key before typing.
    keybd_event_(#VK_CONTROL,0,#KEYEVENTF_KEYUP,0) ; Release CONTROL key before typing.
    keybd_event_(#VK_SHIFT,0,#KEYEVENTF_KEYUP,0) ; Release SHIFT key before typing.
    keybd_event_(#VK_LWIN,0,#KEYEVENTF_KEYUP,0) ; Release WINDOWS key before typing.
    For r=1 To Len(keys$)
      vk$=Mid(keys$,r,1)
      If vk$="{" ; Special key found.
        s=FindString(keys$,"}",r+1)-(r+1) ; Get length of special key.
        s$=Mid(keys$,r+1,s) ; Get special key name.
        Select s$ ; Get virtual key code of special key.
          Case "ALTDOWN" : keybd_event_(#VK_MENU,0,0,0) ; Hold ALT down.
          Case "ALTUP" : keybd_event_(#VK_MENU,0,#KEYEVENTF_KEYUP,0) ; Release ALT.
          Case "BACKSPACE" : vk=#VK_BACK
          Case "CONTROLDOWN" : keybd_event_(#VK_CONTROL,0,0,0) ; Hold CONTROL down.
          Case "CONTROLUP" : keybd_event_(#VK_CONTROL,0,#KEYEVENTF_KEYUP,0) ; Release CONTROL.
          Case "DELAY" : vk=0 : Sleep_(1000) ; Delay typing for one second.
          Case "DELETE" : vk=#VK_DELETE
          Case "DOWN" : vk=#VK_DOWN
          Case "END" : vk=#VK_END
          Case "ENTER" : vk=#VK_RETURN
          Case "ESCAPE" : vk=#VK_ESCAPE
          Case "F1" : vk=#VK_F1
          Case "F2" : vk=#VK_F2
          Case "F3" : vk=#VK_F3
          Case "F4" : vk=#VK_F4
          Case "F5" : vk=#VK_F5
          Case "F6" : vk=#VK_F6
          Case "F7" : vk=#VK_F7
          Case "F8" : vk=#VK_F8
          Case "F9" : vk=#VK_F9
          Case "F10" : vk=#VK_F10
          Case "F11" : vk=#VK_F11
          Case "F12" : vk=#VK_F12
          Case "HOME" : vk=#VK_HOME
          Case "INSERT" : vk=#VK_INSERT
          Case "LEFT" : vk=#VK_LEFT
          Case "PAGEDOWN" : vk=#VK_NEXT
          Case "PAGEUP" : vk=#VK_PRIOR
          Case "PRINTSCREEN" : vk=#VK_SNAPSHOT
          Case "RETURN" : vk=#VK_RETURN
          Case "RIGHT" : vk=#VK_RIGHT
          Case "SPACE" : vk=#VK_SPACE
          Case "SHIFTDOWN" : shifted=1 : keybd_event_(#VK_SHIFT,0,0,0) ; Hold SHIFT down.
          Case "SHIFTUP" : shifted=0 : keybd_event_(#VK_SHIFT,0,#KEYEVENTF_KEYUP,0) ; Release SHIFT.
          Case "TAB" : vk=#VK_TAB
          Case "UP" : vk=#VK_UP
          Case "WINDOWS" : vk=#VK_LWIN
        EndSelect
        If Left(s$,3)<>"ALT" And Left(s$,7)<>"CONTROL" And Left(s$,5)<>"SHIFT"
          keybd_event_(vk,0,0,0) : keybd_event_(vk,0,#KEYEVENTF_KEYUP,0) ; Press the special key.
        EndIf
        r+s+1 ; Continue getting the keystrokes that follow the special key.
      Else
        vk=VkKeyScanEx_(Asc(vk$),GetKeyboardLayout_(0)) ; Normal key found.
        If vk>303 And shifted=0 : keybd_event_(#VK_SHIFT,0,0,0) : EndIf ; Due to shifted character.
        keybd_event_(vk,0,0,0) : keybd_event_(vk,0,#KEYEVENTF_KEYUP,0) ; Press the normal key.
        If vk>303 And shifted=0 : keybd_event_(#VK_SHIFT,0,#KEYEVENTF_KEYUP,0) : EndIf ; Due to shifted character.
      EndIf
    Next
    If thread1<>thread2 : AttachThreadInput_(thread1,thread2,#False) : EndIf ; Finished typing to target window!
    keybd_event_(#VK_MENU,0,#KEYEVENTF_KEYUP,0) ; Release ALT key in case user forgot.
    keybd_event_(#VK_CONTROL,0,#KEYEVENTF_KEYUP,0) ; Release CONTROL key in case user forgot.
    keybd_event_(#VK_SHIFT,0,#KEYEVENTF_KEYUP,0) ; Release SHIFT key in case user forgot.
    keybd_event_(#VK_LWIN,0,#KEYEVENTF_KEYUP,0) ; Release WINDOWS key in case user forgot.
    ProcedureReturn 1 ; Report successful typing!  :)   
  EndIf
EndProcedure 

ProcedureDLL MonitorPower(Value) ; si value=-1 : (active le moniteur)(turn on the monitor), si value=1 : (met en veille le moniteur)(standby monitor), si value=2 : (éteind le moniteur)(turn off the monitor)
hwnd = OpenWindow(#PB_Any,0,0,200,200,#PB_Window_Invisible,"")
v=SendMessage_(WindowID(hwnd), #WM_SYSCOMMAND, #SC_MONITORPOWER, value)
CloseWindow(hwnd)
ProcedureReturn v
EndProcedure

ProcedureDLL.s GetUserLanguage() ; Retourne la langue de l'utilisateur : Return user language
LangInf= GetUserDefaultLCID_()
langId_main=langInf&$FF
langId_sub=(langinf&$ff>>8)&$ff

lan$="":sub$=""

Select langid_main
  Case $00: lan$="Neutral"
    Select langid_sub
      Case $01: sub$="Default"
      Case $02: sub$="System Default"
    EndSelect
  Case $01: lan$="Arabic"
    Select langid_sub
      Case $01: sub$="Arabia"
      Case $02: sub$="Iraq"
      Case $03: sub$="Egypt" 
      Case $04: sub$="Libya" 
      Case $05: sub$="Algeria" 
      Case $06: sub$="Morocco" 
      Case $07: sub$="Tunisia" 
      Case $08: sub$="Oman" 
      Case $09: sub$="Yemen" 
      Case $10: sub$="Syria" 
      Case $11: sub$="Jordan" 
      Case $12: sub$="Lebanon" 
      Case $13: sub$="Kuwait" 
      Case $14: sub$="U.A.E." 
      Case $15: sub$="Bahrain"
      Case $16: sub$="Qatar"
    EndSelect
  Case $02: lan$="Bulgarian"
  Case $03: lan$="Catalan"  
  Case $04: lan$="Chinese"
    Select langid_sub
      Case $01: sub$="Traditional"
      Case $02: sub$="Simplified"
      Case $03: sub$="Hong Kong SAR, PRC"
      Case $04: sub$="Singapore"
      Case $05: sub$="Macau"
    EndSelect
  Case $05: lan$="Czech"
  Case $06: lan$="Danish" 
  Case $07: lan$="German" 
    Select langid_sub
      Case $01: sub$=""
      Case $02: sub$="Swiss"
      Case $03: sub$="Austrian"
      Case $04: sub$="Luxembourg"
      Case $05: sub$="Liechtenstein"
    EndSelect
  Case $08: lan$="Greek" 
  Case $09: lan$="English"
    Select langid_sub
      Case $01: sub$="US"
      Case $02: sub$="UK"
      Case $03: sub$="Australian"
      Case $04: sub$="Canadian"
      Case $05: sub$="New Zealand"
      Case $06: sub$="Ireland"
      Case $07: sub$="South Africa"
      Case $08: sub$="Jamaica"
      Case $09: sub$="Caribbean"
      Case $0a: sub$="Belize"
      Case $0b: sub$="Trinidad" 
      Case $0c: sub$="Zimbabwe"
      Case $0d: sub$="Philippines"
    EndSelect
  Case $0a: lan$="Spanish"
    Select langid_sub
      Case $01: sub$="Castilian" 
      Case $02: sub$="Mexican" 
      Case $03: sub$="Modern"
      Case $04: sub$="Guatemala"
      Case $05: sub$="Costa Rica"
      Case $06: sub$="Panama"
      Case $07: sub$="Dominican Republic"
      Case $08: sub$="Venezuela"
      Case $09: sub$="Colombia"
      Case $0a: sub$="Peru"
      Case $0b: sub$="Argentina"
      Case $0c: sub$="Ecuador"
      Case $0d: sub$="Chile"
      Case $0e: sub$="Uruguay"
      Case $0f: sub$="Paraguay" 
      Case $10: sub$="Bolivia"
      Case $11: sub$="El Salvador"
      Case $12: sub$="Honduras"
      Case $13: sub$="Nicaragua"
      Case $14: sub$="Puerto Rico"
    EndSelect
  Case $0b: lan$="Finnish" 
  Case $0c: lan$="French" 
    Select langid_sub
      Case $01: sub$="" 
      Case $02: sub$="Belgian"
      Case $03: sub$="Canadian"
      Case $04: sub$="Swiss"
      Case $05: sub$="Luxembourg"
      Case $06: sub$="Monaco"
    EndSelect
  Case $0d: lan$="Hebrew" 
  Case $0e: lan$="Hungarian" 
  Case $0f: lan$="Icelandic" 
  Case $10: lan$="Italian"
    If langid_sub=$02: sub$="Swiss" :EndIf
  Case $11: lan$="Japanese" 
  Case $12: lan$="Korean" 
  Case $13: lan$="Dutch"
    If langid_sub=$02: sub$="Belgian" :EndIf
  Case $14: lan$="Norwegian"
    Select langid_sub
      Case $01: sub$="Norwegian"
      Case $02: sub$="Nynorsk"
    EndSelect
  Case $15: lan$="Polish" 
  Case $16: lan$="Portuguese"
    If langid_sub=$02: sub$="Brazilian" :EndIf
  Case $18: lan$="Romanian" 
  Case $19: lan$="Russian" 
  Case $1a: lan$="Croatian" 
  Case $1a: lan$="Serbian"
    Select langid_sub
      Case $02: sub$="Latin"
      Case $03: sub$="Cyrillic"
    EndSelect
  Case $1b: lan$="Slovak" 
  Case $1c: lan$="Albanian" 
  Case $1d: lan$="Swedish"
    If langid_sub=$02: sub$="Finland" :EndIf  
  Case $1e: lan$="Thai" 
  Case $1f: lan$="Turkish"  
  Case $20: lan$="Urdu"
    Select langid_sub
      Case $01: sub$="Pakistan"
      Case $02: sub$="India"
    EndSelect
  Case $21: lan$="Indonesian" 
  Case $22: lan$="Ukrainian" 
  Case $23: lan$="Belarusian" 
  Case $24: lan$="Slovenian" 
  Case $25: lan$="Estonian" 
  Case $26: lan$="Latvian" 
  Case $27: lan$="Lithuanian"
    If langid_sub: sub$="Classic" :EndIf
  Case $29: lan$="Farsi" 
  Case $2a: lan$="Vietnamese" 
  Case $2b: lan$="Armenian" 
  Case $2c: lan$="Azeri"
    Select langid_sub
      Case $01: sub$="Latin"
      Case $02: sub$="Cyrillic"
    EndSelect
  Case $2d: lan$="Basque" 
  Case $2f: lan$="Macedonian" 
  Case $36: lan$="Afrikaans" 
  Case $37: lan$="Georgian" 
  Case $38: lan$="Faeroese" 
  Case $39: lan$="Hindi" 
  Case $3e: lan$="Malay"
    Select langid_sub
      Case $01: sub$="Malaysia"
      Case $02: sub$="Brunei Darassalam"
    EndSelect
  Case $3f: lan$="Kazak" 
  Case $41: lan$="Swahili" 
  Case $43: lan$="Uzbek"
    Select langid_sub
      Case $01: sub$="Latin"
      Case $02: sub$="Cyrillic"
    EndSelect 
  Case $44: lan$="Tatar" 
  Case $45: lan$="Bengali" 
  Case $46: lan$="Punjabi" 
  Case $47: lan$="Gujarati" 
  Case $48: lan$="Oriya" 
  Case $49: lan$="Tamil" 
  Case $4a: lan$="Telugu" 
  Case $4b: lan$="Kannada" 
  Case $4c: lan$="Malayalam" 
  Case $4d: lan$="Assamese" 
  Case $4e: lan$="Marathi" 
  Case $4f: lan$="Sanskrit" 
  Case $57: lan$="Konkani" 
  Case $58: lan$="Manipuri" 
  Case $59: lan$="Sindhi" 
  Case $60: lan$="Kashmiri"
    If langid_sub=$02 : sub$="India" : EndIf
  Case $61: lan$="Nepali"
    If langid_sub=$02 : sub$="India" : EndIf
EndSelect
ProcedureReturn lan$+" "+sub$
EndProcedure

ProcedureDLL.s Color2HTM(couleur.l) ; Retourne une couleur sous forme html ex: Color2HTM($00FFFF) = "#FFFF0"
    ProcedureReturn "#" + Hex(Red(couleur)) + Hex(Green(couleur)) + Hex(Blue(couleur))
EndProcedure

ProcedureDLL.l HexToDec(Valeur.s) ; Retourne la valeur Long d'une chaîne Hexadécimale
 Valeur =UCase(Valeur)
  For r=1 To Len(Valeur)
    d<<4 : a$=Mid(Valeur,r,1)
    If Asc(a$)>60
      d+Asc(a$)-55
    Else
      d+Asc(a$)-48
    EndIf
  Next
  ProcedureReturn d
EndProcedure

ProcedureDLL GetLedState(key) ; etat=1 ->Led allumée    etat=0 ->Led éteinte ; Si vous préférez : #VK_scroll=145 : #VK_CAPITAL=20 : #VK_numlock=144
ProcedureReturn GetKeyState_(key)
EndProcedure

ProcedureDLL SetLedState(key.l,etat.l) ; etat=1 ->Led allumée    etat=0 ->Led éteinte ; Si vous préférez : #VK_scroll=145 : #VK_CAPITAL=20 : #VK_numlock=144
If key=#VK_SCROLL
If s<>etat : ok=1 : s=etat : Else : ok=0 : EndIf
ElseIf key=#VK_CAPITAL
If c<>etat : ok=1 : c=etat : Else : ok=0 : EndIf
ElseIf key=#VK_NUMLOCK
If n<>etat : ok=1 : n=etat : Else : ok=0 : EndIf
EndIf
If ok=1
keybd_event_(key,0,#KEYEVENTF_EXTENDEDKEY | 0,0) 
keybd_event_(key,0,#KEYEVENTF_EXTENDEDKEY | #KEYEVENTF_KEYUP,0) 
EndIf
EndProcedure

Procedure SetKey(fold,Key$,Subkey$,Type,Adr,len) 
  If RegCreateKeyEx_(fold, Key$, 0, 0, #REG_OPTION_NON_VOLATILE, #KEY_ALL_ACCESS, 0, @NewKey, @KeyInfo) = #ERROR_SUCCESS 
    RegSetValueEx_(NewKey, Subkey$, 0, Type,  Adr, len) 
    RegCloseKey_(NewKey) 
  EndIf 
EndProcedure 

DeclareDLL AssociateExtensionExe2(ext$,ext_description$,programm$,Icon$,prgkey$,cmd_description$,cmd_key$) 

ProcedureDLL AssociateExtensionExe(ext$,ext_description$,programm$,Icon$) ; Associe une extension à un programme
  AssociateExtensionExe2(ext$,ext_description$,programm$,Icon$,GetFilePart(programm$),"open","open")  
EndProcedure

ProcedureDLL AssociateExtensionExe2(ext$,ext_description$,programm$,Icon$,prgkey$,cmd_description$,cmd_key$) 
  cmd$=Chr(34)+programm$+Chr(34)+" "+Chr(34)+"%1"+Chr(34) 
  If GetVersion_() & $ff0000  ; Windows NT/XP 
    SetKey(#HKEY_CLASSES_ROOT, "Applications\"+prgkey$+"\shell\"+cmd_description$+"\command","",#REG_SZ    ,@cmd$,Len(cmd$)+1) 
    If ext_description$ 
      Key$=ext$+"_auto_file" 
      SetKey(#HKEY_CLASSES_ROOT  ,"."+ext$           ,"",#REG_SZ,@Key$,Len(Key$)+1) 
      SetKey(#HKEY_CLASSES_ROOT  ,Key$               ,"",#REG_SZ,@ext_description$,Len(ext_description$)+1) 
      If Icon$ 
        SetKey(#HKEY_CLASSES_ROOT,Key$+"\DefaultIcon","",#REG_SZ,@Icon$,Len(Icon$)+1) 
      EndIf 
    EndIf 
    SetKey(#HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\FileExts\."+ext$,"Application",#REG_SZ,@prgkey$         ,Len(prgkey$)+1) 
  Else ;Windows 9x 
    SetKey(#HKEY_LOCAL_MACHINE,"Software\Classes\."+ext$                        ,"",#REG_SZ,@prgkey$         ,Len(prgkey$)+1) 
    If ext_description$ 
      SetKey(#HKEY_LOCAL_MACHINE,"Software\Classes\"+prgkey$                   ,"",#REG_SZ,@ext_description$,Len(ext_description$)+1) 
    EndIf 
    If Icon$ 
      SetKey(#HKEY_LOCAL_MACHINE,"Software\Classes\"+prgkey$+"\DefaultIcon"    ,"",#REG_SZ,@Icon$           ,Len(Icon$)+1) 
    EndIf 
    If cmd_description$<>cmd_key$ 
      SetKey(#HKEY_LOCAL_MACHINE,"Software\Classes\"+prgkey$+"\shell\"+cmd_key$,"",#REG_SZ,@cmd_description$,Len(cmd_description$)+1) 
    EndIf 
    SetKey(#HKEY_LOCAL_MACHINE,"Software\Classes\"+prgkey$+"\shell\"+cmd_key$+"\command","",#REG_SZ,@cmd$   ,Len(cmd$)+1) 
  EndIf 
EndProcedure 

;- STRING

ProcedureDLL.s ReplaceStringN(String$, StringToFind$, StringToReplace$, Index) ; Remplace le texte spécifié à la nième répétition
    If CountString(String$, StringToFind$) >= Index
        For a = 1 To Index
            pos = pos + 1
            pos = FindString(String$, StringToFind$, pos)
        Next
        ProcedureReturn Left(String$, pos - 1) + StringToReplace$ + Right(String$, Len(String$) - (pos - 1) - Len(StringToFind$))
    EndIf
EndProcedure

ProcedureDLL FindStringN(String$, StringToFind$, StartPosition, Index) ; Retourne la position du texte spécifié à la nième répétition
    String2$ = Right(String$, Len(String$) - StartPosition)
    If CountString(String2$, StringToFind$) >= Index
        For a = 1 To Index
            pos = pos + 1
            pos = FindString(String2$, StringToFind$, pos)
        Next
        ProcedureReturn pos + StartPosition
    EndIf
    ProcedureReturn 0
EndProcedure

ProcedureDLL.s RightField(String$, Separator$) ; Retourne la partie droite du texte jusqu'au caractère séparateur
ProcedureReturn Right(string$,Len(string$)-FindStringN(string$,Separator$,0,CountString(string$,separator$)))
EndProcedure

ProcedureDLL.s LeftField(String$, Separator$) ; Retourne la partie gauche du texte jusqu'au caractère séparateur
ProcedureReturn Left(string$,FindStringN(string$,Separator$,0,1)-1)
EndProcedure

ProcedureDLL.s MidField(String$, Index, Separator$) ; Retourne le texte contenu entre le nième et le nième caractère séparateur +1
If FindStringN(string$,Separator$,0,Index)=0
l=Len(String$)-FindStringN(string$,Separator$,0,Index-1)
Else
l=FindStringN(string$,Separator$,0,Index)-FindStringN(string$,Separator$,0,Index-1)-1
EndIf
ProcedureReturn Mid(string$,FindStringN(string$,Separator$,0,Index-1)+1,l)
EndProcedure

;- SYSTEM

ProcedureDLL IsAdmin() ; Retourne 1 si la session est en mode administrateur 0 sinon et -1 si une erreur s'est produite 
    ; Pour savoir si l'utilisateur actuel est administrateur de l'ordinateur
    ; Renvoi 1 si admin, 0 sinon et -1 si erreur d'ouverture de la librairie
    If OpenLibrary(0, "advpack.dll")
        Resultat = CallFunction(0, "IsNTAdmin", 0, 0)
        CloseLibrary(0)
    Else
        Resultat = -1
    EndIf
    ProcedureReturn Resultat
EndProcedure

ProcedureDLL IsSafeMode() ; Retourne 1 si mode sans échec, 2 si mode sans échec avec gestion réseau et 0 si mode normal
    ; 0="Mode Normal"
    ; 1="Mode sans échec"
    ; 2="Mode sans échec avec gestion réseau"
    ProcedureReturn GetSystemMetrics_(#SM_CLEANBOOT)
EndProcedure

ProcedureDLL.s GetComputerName() ; Retourne le nom de l'ordinateur
    nompc.s = Space(1024) ; buffer for string
    ; Get And display the name of the computer.
    bufsize.l = 1024
    GetComputerName_( @nompc, @bufsize)
    ProcedureReturn nompc
EndProcedure


ProcedureDLL.s GetUserName() ; Retourne le nom d'utilisateur de la session en cours
    buffer.s = Space(1024)
    ; Get And display the user name.
    bufsize.l = 1024
    GetUserName_( @buffer, @bufsize)
    ProcedureReturn buffer
EndProcedure

ProcedureDLL SetWallpaper(FileName.s, ImageID, mode.l, BackgroundColor.l) ; mode=1 Etirer, 2 Centrer, 3 Centrer et agrandi, 4 Mosaïque (si FileName="" , ImageID sera pris en compte et inversement) 
    ; mode=1 Etirer
    ; mode=2 Centrer
    ; mode=3 Centrer et agrandir proportionnellement
    ; mode=4 Mosaïque
    If FileName
    idi = LoadImage(#PB_Any, FileName)
    Else
    idi=ImageID
    EndIf
    If idi
        id = ImageID()
        largimag = ImageWidth()
        hautimag = ImageHeight()
        dx=GetSystemMetrics_(#SM_CXSCREEN)
        dy=GetSystemMetrics_(#SM_CYSCREEN)
        lon = Len(GetExtensionPart(FileName))
        If IsAdmin()=1
        If OSVersion()=#PB_OS_Windows_XP Or OSVersion()=#PB_OS_Windows_2000
        photo.s = GetWindowsDirectory() + "Web\Wallpaper\Fond d'écran.bmp"
        Else
        photo.s = GetWindowsDirectory()+"Fond d'écran.bmp"
        EndIf
        Else
        photo.s=GetUserProfileDirectory()+"Fond d'écran.bmp"
        EndIf
        If mode = 1
            ResizeImage(idi, dx, dy)
            SaveImage(idi, photo)
        ElseIf mode = 2
            idi2 = CreateImage(#PB_Any, dx, dy)
            StartDrawing(ImageOutput())
                Box(0, 0, dx, dy, BackgroundColor)
                DrawImage(Id, (dx - largimag) / 2, (dy - hautimag) / 2)
            StopDrawing()
            SaveImage(idi2, photo)
        ElseIf mode = 3
            idi2 = CreateImage(#PB_Any, dx, dy)
            StartDrawing(ImageOutput())
                Box(0, 0, dx, dy, BackgroundColor)
                clarg.f = dx / largimag
                chaut.f = dy / hautimag
                If clarg > chaut
                    DrawImage(Id, (dx - Round(chaut * largimag, 0)) / 2, 0, Round(chaut * largimag, 0), dy)
                ElseIf clarg < chaut
                    DrawImage(Id, 0, (dy - Round(clarg * hautimag, 0)) / 2, dx, Round(clarg * hautimag, 0))
                Else
                    DrawImage(id, 0, 0, dx, dy)
                EndIf
            StopDrawing()
            SaveImage(idi2, photo)
            FreeImage(idi2)
        ElseIf mode = 4
            idi2 = CreateImage(#PB_Any, dx, dy)
            StartDrawing(ImageOutput())
                Box(0, 0, dx, dy, BackgroundColor)
                nc = Round(dx / largimag, 1)
                nl = Round(dy / hautimag, 1)
                For a = 0 To nc - 1
                    For b = 0 To nl - 1
                        DrawImage(id, a * largimag, b * hautimag)
                    Next
                Next
            StopDrawing()
            SaveImage(idi2, photo)
            FreeImage(idi2)
        EndIf
        FreeImage(idi)
        ProcedureReturn SystemParametersInfo_(#SPI_SETDESKWALLPAPER, 0, photo, #SPIF_UPDATEINIFILE | #SPIF_SENDWININICHANGE)
    EndIf
EndProcedure

ProcedureDLL GetMemoryFree(Scale) ; Retourne la mémoire vive libre, si scale=0, en octet, si scale=1, en ko, si 2, en Mo...)
    GlobalMemoryStatus_( @Info.MEMORYSTATUS)
    FreeM.f = Info\dwAvailPhys
    ProcedureReturn (FreeM) / Pow(1024, Scale)
EndProcedure

ProcedureDLL GetMemoryTotal(Scale) ; Retourne la mémoire vive totale, si scale=0, en octet, si scale=1, en ko, si 2, en Mo...)
    GlobalMemoryStatus_( @Info.MEMORYSTATUS)
    TotalM.f = Info\dwTotalPhys
    ProcedureReturn (TotalM) / Pow(1024, Scale)
EndProcedure

ProcedureDLL GetMemoryPercentUse() ; Retourne en pourcentage la mémoire vive utilisée
    GlobalMemoryStatus_( @Info.MEMORYSTATUS)
    ProcedureReturn Info\dwMemoryLoad
EndProcedure

Procedure ListWin(window, parameter)
 Global nwin, listacwin , listacwin1
If listacwin=0 : NewList window.s() : listacwin=1 : ElseIf listacwin=2 : listacwin=1 : nwin=0 : ClearList(window()) : EndIf
memoryid=ReAllocateMemory (0, 255)
    GetClassName_ (window, memoryid, 255) 
    class$ = PeekS (MemoryID) 
memoryid=ReAllocateMemory (0, 255)
    GetWindowText_ (window, memoryid, 255) 
    title$ = PeekS (MemoryID) 

    FreeMemory (0) 
    If title$<>"" And nwin=1
    For a=0 To CountList(window())-1
    SelectElement(window(),a)
    If StringField(window(),1,"|")=title$
    c=1
    EndIf
    Next
    If c=0
    AddElement(window()) : window()=title$+"|"+class$
    EndIf
    c=1
    ElseIf title$<>""
    nwin=1
    AddElement(window()) : window()=title$+"|"+class$
    EndIf
    ProcedureReturn #True 
EndProcedure 

ProcedureDLL ListProgramWindows() ; Retourne le nombre de programmes fenêtrés si la fonction à réussi
enum=EnumWindows_ (@ListWin(), 0) 
listacwin=2
SortList(window(),2)
ProcedureReturn CountList(window())
EndProcedure

ProcedureDLL.s ListProgramWindowsNext() ; Liste le nom des fenêtres des programmes actuellement actifs (La fonction ListProgramWindows doit être exécutée au paravant)
If nwin>0
SelectElement(window(),listacwin1)
listacwin1=listacwin1+1
If listacwin1<=CountList(window())
ProcedureReturn StringField(window(),1,"|")
Else
ProcedureReturn ""
EndIf
EndIf
EndProcedure

ProcedureDLL.s ListProgramWindowsClass() ; Retourne la classe de la fenêtres choi (La fonction ListProgramWindowsNext doit être exécutée au paravant)
If nwin>0
If listacwin1<=CountList(window())
ProcedureReturn StringField(window(),2,"|")
EndIf
EndIf
EndProcedure

ProcedureDLL ListWindows() ; Retourne le nombre de fenêtres actuellement active
Global listwins
If listwins=0 : NewList wind.s() : listwins=1 : Else : ClearList(wind()) : EndIf
hWnd.l = FindWindow_( 0, 0 )
  While hWnd <> 0
    If GetWindowLong_(Hwnd, #GWL_STYLE) & #WS_VISIBLE = #WS_VISIBLE ; pour lister que les fenêtres visibles
      If GetWindowLong_(Hwnd, #GWL_EXSTYLE) & #WS_EX_TOOLWINDOW <> #WS_EX_TOOLWINDOW ; pour lister que les fenêtres qui ne sont pas des ToolWindow ou barre d'outils
        txt.s = Space(256)
        GetWindowText_(hwnd, txt, 256)
        If txt <> ""
          AddElement(wind()) : wind()=txt
        EndIf
      EndIf
    EndIf
    hWnd = GetWindow_(hWnd, #GW_HWNDNEXT)
  Wend
  ProcedureReturn CountList(wind())
EndProcedure

ProcedureDLL.s SelectWindows(Number) ; Retourne le titre de la fenêtre sélectionnée (Number doit être compris entre 0 et ListWindows()-1)
If listwins=1
If CountList(wind())>0
If number=<CountList(wind())-1
SelectElement(wind(),number)
ProcedureReturn wind()
EndIf
EndIf
EndIf
EndProcedure

ProcedureDLL.l GetProcessorFrequency() ; Retourne la fréquence du processeur : Return the processor frequency
  Protected Resultat, Lib
  Structure PROCESSOR_POWER_INFORMATION
    Number.l ; Numéro du processeur
    MaxMhz.l ; Fréquence max en mhz de la configuration actuelle
    CurrentMhz.l ; Fréquence actuelle
    MhzLimit.l ; Fréquence max en mhz supportée par le processeur
    MaxIdleState.l
    CurrentIdleState.l
  EndStructure
  Lib = OpenLibrary(#PB_Any, "PowrProf.dll")
  If Lib
    If CallFunction(Lib, "CallNtPowerInformation", 11, 0, 0, lpOutputBuffer.PROCESSOR_POWER_INFORMATION, SizeOf(PROCESSOR_POWER_INFORMATION)) = 0
      Resultat = lpOutputBuffer\MaxMhz
    EndIf
    CloseLibrary(Lib)
  EndIf
  ProcedureReturn Resultat
EndProcedure

;- WINDOW

ProcedureDLL DisableWindow(WindowID, State) ; Active ou désactive la fenêtre choisie (state=#True pour désactivé la fenetre)
If state=#False : state=#True : Else : state=#False : EndIf
    EnableWindow_(WindowID, State)
EndProcedure

ProcedureDLL SetWindowTransparency (WindowID, Transparency_Level.l) ; Applique un effet de transparence (de 0 (invisible) à 255 (opaque))
    ; 0 à 255
    SetWindowLong_(WindowID, #GWL_EXSTYLE, $00080000) ; #WS_EX_LAYERED = $00080000
    ProcedureReturn SetLayeredWindowAttributes_(WindowID, 0, Transparency_Level, 2) ;
EndProcedure

ProcedureDLL SetWindowState(WindowID, State) ; Change l'état de la fenêtre : 1 Minimiser, 2 Maximiser, 3 Restorer, 4 Normaliser
    Select State
        Case 1 ; Minimiser la fenêtre
            r = ShowWindow_(WindowID, #SW_MINIMIZE)
        Case 2 ; Maximiser la fenêtre
            r = ShowWindow_(WindowID, #SW_MAXIMIZE)
        Case 3 ; Restorer la fenêtre
            r = ShowWindow_(WindowID, #SW_RESTORE)
        Case 4 ; Normaliser la fenêtre
            r = ShowWindow_(WindowID, #SW_NORMAL)
    EndSelect
    ProcedureReturn r
EndProcedure

ProcedureDLL OpenToolWindow(Window, x, y, Width, Height, Flags, Title.s, ParentID, ResizeWidow) ; Ouvre une fenêtre outil (si ParentID = 0, ParentID ne sera pas pris en compte) (ResizeWindow=1 sauf si vous supprimer le bord de la fenêtre)
    ;If flags = #PB_Window_SystemMenu
    ;    wflag = #PB_Window_SystemMenu
    ;ElseIf flags = #PB_Window_ScreenCentered
    ;    wflag = #PB_Window_ScreenCentered
    ;ElseIf flags = #PB_Window_SizeGadget
    ;    wflag = #PB_Window_SizeGadget
    ;ElseIf flags = #PB_Window_SystemMenu|#PB_Window_SizeGadget
    ;    wflag = #PB_Window_SystemMenu|#PB_Window_SizeGadget
    ;ElseIf flags = #PB_Window_ScreenCentered|#PB_Window_SizeGadget
    ;    wflag = #PB_Window_ScreenCentered|#PB_Window_SizeGadget
    ;ElseIf flags = #PB_Window_SystemMenu | #PB_Window_ScreenCentered
    ;    wflag = #PB_Window_SystemMenu | #PB_Window_ScreenCentered
    ;ElseIf flags = #PB_Window_ScreenCentered|#PB_Window_SizeGadget|#PB_Window_SystemMenu
    ;    wflag = #PB_Window_ScreenCentered|#PB_Window_SizeGadget|#PB_Window_SystemMenu
    ;EndIf
    If resizewindow=1
    n=8
    EndIf
    If parentid<>0
    windo=OpenWindow(Window, x, y, width, height - n, #PB_Window_Invisible | flags, title, ParentID)
    If windo
        SetWindowLong_(WindowID(), #GWL_EXSTYLE, GetWindowLong_(WindowID(), #GWL_EXSTYLE) | #WS_EX_TOOLWINDOW)
        ShowWindow_(WindowID(), #SW_SHOW)
        ProcedureReturn Windo
    EndIf
    Else
    windo=OpenWindow(Window, x, y, width, height - n, #PB_Window_Invisible | flags, title)
    If windo
        SetWindowLong_(WindowID(), #GWL_EXSTYLE, GetWindowLong_(WindowID(), #GWL_EXSTYLE) | #WS_EX_TOOLWINDOW)
        ShowWindow_(WindowID(), #SW_SHOW)
        ProcedureReturn Windo
    EndIf
    EndIf
EndProcedure

ProcedureDLL HideFromTaskbar(Window, State) ; Cache la fenêtre de la barre des tâches
    Shared proc_HideFromTaskbar_Object
    If STATE = 0
        CallCOM(#HideFromTaskbar_AddTab, proc_HideFromTaskbar_Object, WINDOW) ; Montrer la fenêtre
    Else
        CallCOM(#HideFromTaskbar_DeleteTab, proc_HideFromTaskbar_Object, WINDOW) ; Cacher la fenêtre
    EndIf
EndProcedure

ProcedureDLL InitHideFromTaskbar() ; Initialise le mode cacher de la barre des tâches
    Shared proc_HideFromTaskbar_Object
    CoInitialize_(0)
    CoCreateInstance_(?CLSID_TaskbarList, 0, 1, ?IID_ITaskbarList, @proc_HideFromTaskbar_Object)
    CallCOM(#HideFromTaskbar_HrInit, proc_HideFromTaskbar_Object) ; Initialiser l'objet
    DataSection
        CLSID_TaskbarList :
            Data.l $56FDF344
            Data.w $FD6D, $11D0
            Data.b $95, $8A, $00, $60, $97, $C9, $A0, $90
        IID_ITaskbarList :
            Data.l $56FDF342
            Data.w $FD6D, $11D0
            Data.b $95, $8A, $00, $60, $97, $C9, $A0, $90
    EndDataSection
EndProcedure

ProcedureDLL EndHideFromTaskbar() ; Coupe le mode cacher de la barre des tâches
    Shared proc_HideFromTaskbar_Object
    CallCOM(#HideFromTaskbar_Release, proc_HideFromTaskbar_Object)
    CoUninitialize_()
EndProcedure

Procedure CatchBorderScreenThread(WindowID)
    Repeat
        ;UseWindow(window)
        SetActiveWindow_(WindowID)
        ; Dimension de la fenêtre avec prise en comptes des bords
        GetWindowRect_(WindowID, @Taille_Fenetre.rect)
        Largeur_Fenetre = Taille_Fenetre\Right - Taille_Fenetre\Left
        Hauteur_Fenetre = Taille_Fenetre\Bottom - Taille_Fenetre\top
        
        ; Dimension de l'écran
        SystemParametersInfo_(#SPI_GETWORKAREA, 0, @Taille_Ecran.RECT, 0)
        ; Position de la fenêtre
        PosWinX = WindowX()
        PosWinY = WindowY()
        
        ; Ajustement sur les X
        If Abs(PosWinX - Taille_Ecran\Left) <= 12 ; Si fenêtre placé contre le bord droit de l'écran
            
            MoveWindow(Taille_Ecran\Left, PosWinY) ; On aligne sur le bord droit de l'écran
            PosWinX = WindowX() ; Nouvelle position de la fenêtre
        ElseIf Abs(PosWinX + Largeur_Fenetre - Taille_Ecran\Right) <= 12 ; Si fenêtre placé contre le bord gauche de l'écran
            MoveWindow(Taille_Ecran\Right - Largeur_Fenetre, PosWinY) ; On aligne sur le bord gauche de l'écran
            PosWinX = WindowX() ; Nouvelle position de la fenêtre
        EndIf
        
        ; Ajustement sur les Y
        If Abs(PosWinY - Taille_Ecran\top) <= 12 ; Si fenêtre placé contre le haut de l'écran
            MoveWindow(PosWinX, Taille_Ecran\top) ; On aligne sur le haut de l'écran
        ElseIf Abs(PosWinY + Hauteur_Fenetre - Taille_Ecran\Bottom) <= 12
            MoveWindow(PosWinX, Taille_Ecran\Bottom - Hauteur_Fenetre)
        EndIf
        Delay(10)
    ForEver
EndProcedure

ProcedureDLL InitCatchBorderScreen(WindowID) ; Accroche la fenêtre aux bords de l'écran 
    Global threadIDCBS
   CreateThread_(Secur.SECURITY_ATTRIBUTES,0, @CatchBorderScreenThread(), WindowID,0,@threadIDCBS)
    :threadIDCBS=CreateThread(@CatchBorderScreenThread(), Window)
    ProcedureReturn threadIDCBS
EndProcedure

ProcedureDLL EndCatchBorderScreen() ; Supprime l'accroche de la fenêtre aux bords de l'écran
    GetExitCodeThread_(threadIDCBS, @exit)
    ProcedureReturn TerminateThread_(threadIDCBS, exit)
    ;KillThread(threadIDCBS)
EndProcedure

ProcedureDLL SetWindowPos(WindowID, State) ; Permet de mettre la fenêtre en arrière, au premier plan,... (ex : toujours au premier plan : State = #HWND_TOPMOST)
    ; #HWND_BOTTOM	
    ; #HWND_TOPMOST
    ; #HWND_NOTOPMOST
    ; HWND_TOP	
    SetWindowPos_(WindowID, state, 0, 0, 0, 0, #SWP_NOSIZE | #SWP_NOMOVE) ; la fenêtre est toujours au premier plan
EndProcedure

ProcedureDLL SetCursor(WindowID, Cursor) ; Change le curseur de la fenêtre choisie (ex : Cursor sablier = #IDC_WAIT )
    ; Change Curseur
    ; Quelques curseurs :
    ; IDC_APPSTARTING   : curseur standard + sablier
    ; IDC_ARROW               : curseur standard
    ; IDC_CROSS                : croix
    ; IDC_IBEAM                 : texte
    ; IDC_ICON                   : Seulement Windows NT : Icône vide
    ; IDC_NO                       : Cercle barré (sens interdit)
    ; IDC_SIZE                     : Seulement Windows NT: 4 flèches : nord sud est ouest
    ; IDC_SIZEALL              : Même chose que IDC_SIZE
    ; IDC_SIZENESW          : 2 flèches : nordest et sudouest
    ; IDC_SIZENS                : 2 flèches : nord et sud
    ; IDC_SIZENWSE          : 2 flèches : nordouest et sudest
    ; IDC_SIZEWE               : 2 flèches : ouest et sud
    ; IDC_UPARROW          : 1 flèche : nord
    ; IDC_WAIT                    : Sablier
    C = LoadCursor_(0, Cursor)
    ProcedureReturn SetClassLong_(WindowID, #GCL_HCURSOR, C)
EndProcedure

ProcedureDLL InitDragAndDrop(WindowID) ; Initialise le mode glisser déposer
    Global listdrag
    If listdrag=0 : listdrag=1 : NewList fichierdr.s() : Else : ClearList(fichierdr()) : EndIf
    ProcedureReturn DragAcceptFiles_(WindowID, #True)
EndProcedure

ProcedureDLL GetDropFile() ; Retourne le nombre d'éléments déposés
    ClearList(fichierdr())
    Protected dropped.l, num.l, index.l, size.l, FileName.s
    dropped.l = EventwParam()
    num.l = DragQueryFile_(dropped, -1, "", 0)
    For index = 0 To num - 1
        size.l = DragQueryFile_(dropped, index, 0, 0)
        FileName.s = Space(size)
        DragQueryFile_(dropped, index, FileName, size + 1)
        AddElement(fichierdr())
        fichierdr() = FileName
    Next
    DragFinish_(dropped)
    SelectElement(fichierdr(), 0)
    ProcedureReturn CountList(fichierdr())
EndProcedure

ProcedureDLL.s DropFileSelect(Number) ; Retourne le nom du fichier selectionné (la liste des fichier va de 0 à getdropfile())
    SelectElement(fichierdr(), Number)
    ProcedureReturn fichierdr()
EndProcedure

ProcedureDLL StopDragAndDrop(WindowID) ; Stop le mode glisser déposer
ProcedureReturn DragAcceptFiles_(WindowID, #False)
EndProcedure

ProcedureDLL MoveBorderlessWindow(WindowID,Button) ; Permet de déplacer une fenêtre sans bord (seuls les boutons gauche et droit de la souris sont pris en charge) (Button=#WM_RBUTTONDOWN or #WM_LBUTTONDOWN)
If button=#WM_RBUTTONDOWN
wx=WindowMouseX()
wy=WindowMouseY()
Repeat
Debug "ok"
MoveWindow(ScreenMouseX()-Wx,ScreenMouseY()-wy)
Delay(1)
Until WindowEvent()=#WM_RBUTTONUP
ElseIf button=#WM_LBUTTONDOWN
ProcedureReturn SendMessage_(WindowID,#WM_NCLBUTTONDOWN, #HTCAPTION, 0)
EndIf
EndProcedure

ProcedureDLL ChangeWindowIcon(WindowID, ImageID) ; Permet de changer l'icône de la fenêtre en cours
If imageid
ProcedureReturn SendMessage_(Windowid,#WM_SETICON,#False,imageid)
EndIf
EndProcedure

ProcedureDLL AnimateWindow(WindowID, Time, Action) ; Permet d'animer une fenêtre (glissement, transparence, cacher,...) (#ANIW_...)
;#ANIW_HOR_POSITIVE = $1 ;Animer la fenêtre de gauche à droite. Cet effet peut être utilisé avec ANIW_SLIDE.
;#ANIW_HOR_NEGATIVE = $2 ;Animer la fenêtre de droite à gauche. Cet effet peut être utilisé avec ANIW_SLIDE.
;#ANIW_VER_POSITIVE = $4 ;Animer la fenêtre de haut en bas. Cet effet peut être utilisé avec ANIW_SLIDE.
;#ANIW_VER_NEGATIVE = $8 ;Animer la fenêtre de bas en haut. Cet effet peut être utilisé avec ANIW_SLIDE.
;#ANIW_CENTER = $10      ;La fenêtre apparaît avec un effet par éffondrement vers l'intérieur si ANIW_HIDE est utilisé et vers l'extérieur sans ANIW_HIDE.
;#ANIW_HIDE = $10000     ;Cacher la fenêtre.
;#ANIW_ACTIVATE = $20000 ;Activer la fenêtre.
;#ANIW_SLIDE = $40000    ;Effet de glissement.
;#ANIW_BLEND = $80000    ;Effet de transparence. Vous pouvez utilisez cet effet ssi la fenêtre est au premier plan.
ProcedureReturn AnimateWindow_(WindowID, Time, Action)
EndProcedure

ProcedureDLL.l GetWindowDimBorder(WindowID, Bord) ; Retourne la dimension du bord choisi (si bord=1 gauche, si bord=2 droit, si bord=3 haut, si bord=4 bas)
  Protected WR.RECT
  Protected PA.Point
  If IsWindow_( windowid) = 0
    ProcedureReturn 0
  EndIf
  GetWindowRect_(windowid, WR )
  ClientToScreen_(windowid, PA )
  WR\Left = PA\X - WR\Left
  WR\Top = PA\Y - WR\Top
  If bord = 1 Or bord = 2 Or bord = 4
    ProcedureReturn WR\Left
  ElseIf bord = 3
    ProcedureReturn WR\Top
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

ProcedureDLL GetWindowBackgroundColor(WindowID) ; Retourne la couleur d'arrière plan de la fenêtre
  A$=Space(40)
  GetObject_(GetClassLong_(hWNd,#GCL_HBRBACKGROUND),40,@A$)
  ProcedureReturn PeekL(@A$+4)
EndProcedure

ProcedureDLL SetWindowBackgroundColor(WindowID, Color) ; Colorise la fenêtre choisie
hBrush=CreateSolidBrush_(Color)
SetClassLong_(WindowID,#GCL_HBRBACKGROUND,hBrush)
ProcedureReturn InvalidateRect_(WindowID,#Null,#True)
EndProcedure

Les Résidents:

Code : Tout sélectionner

Structure int64 
  Long1.l 
  Long2.l 
EndStructure 

Structure STATUS
  ACLineStatus.b ; si 1 = branché, 0 = débranché, 255 = inconnu
  BatteryFlag.b ; Niveau de chargement de la batterie 1 = haut ; 2 = bas ; 4 = critique ; 8 = en charge ; 128 = pas de batterie ; 255 = inconnu
  BatteryLifePercent.b ; pourcentage de charge
  Reserved1.b ; réservé au system 0
  BatteryLifeTime.w ; Temps restant en seconde ; si inconnu = -1
  BatteryFullLifeTime.w ; Temps total en seconde ; si inconnu = -1
EndStructure

Structure IOCTL_DISK_PERFORMANCE
        BytesRead.l
        BytesWritten.l 
        ReadTime.l
        WriteTime.l 
        ReadCount.w
        WriteCount.w 
        QueueDepth.w
EndStructure

   Structure DISK_GEOMETRY
   Cylinders.l 
   MediaType.s
   TracksPerCylinder.w 
   SectorsPerTrack.w 
   BytesPerSector.w
   EndStructure

Structure RGB 
  v.l 
EndStructure 

Structure CHARFORMAT2
  cbSize.l 
  dwMask.l  
  dwEffects.l  
  yHeight.l  
  yOffset.l  
  crTextColor.l  
  bCharSet.b  
  bPitchAndFamily.b  
  szFaceName.b[32]  
  _wPad2.w  
  wWeight.w  
  sSpacing.w  
  crBackColor.l  
  lcid.l  
  dwReserved.l  
  sStyle.w  
  wKerning.w  
  bUnderlineType.b  
  bAnimation.b  
  bRevAuthor.b  
  bReserved1.b 
EndStructure 

#HideFromTaskbar_QueryInterface =  0
#HideFromTaskbar_AddRef         =  4
#HideFromTaskbar_Release = 8
#HideFromTaskbar_HrInit = 12
#HideFromTaskbar_AddTab = 16
#HideFromTaskbar_DeleteTab = 20
#HideFromTaskbar_ActivateTab    = 24
#HideFromTaskbar_SetActiveAlt   = 28

#SC_MONITORPOWER = $F170

#PI=3.14159265

#ANIW_HOR_POSITIVE = $1 ;Animer la fenêtre de gauche à droite. Cet effet peut être utilisé avec #ANIW_SLIDE.
#ANIW_HOR_NEGATIVE = $2 ;Animer la fenêtre de droite à gauche. Cet effet peut être utilisé avec #ANIW_SLIDE.
#ANIW_VER_POSITIVE = $4 ;Animer la fenêtre de haut en bas. Cet effet peut être utilisé avec #ANIW_SLIDE.
#ANIW_VER_NEGATIVE = $8 ;Animer la fenêtre de bas en haut. Cet effet peut être utilisé avec #ANIW_SLIDE.
#ANIW_CENTER = $10      ;La fenêtre apparaît avec un effet par éffondrement vers l'intérieur si #ANIW_HIDE est utilisé et vers l'extérieur sans #ANIW_HIDE.
#ANIW_HIDE = $10000     ;Cacher la fenêtre.
#ANIW_ACTIVATE = $20000 ;Activer la fenêtre.
#ANIW_SLIDE = $40000    ;Effet de glissement.
#ANIW_BLEND = $80000    ;Effet de transparence. Vous pouvez utilisez cet effet ssi la fenêtre est au premier plan.

Droopy · Message par **Droopy** » ven. 04/nov./2005 21:19

Merci, dès que j'ai le temps j'intègre ça à la lib ( J'ai un exam prochainement ce qui m'empêche de bosser sur la lib actuellement )

A+

Pour info tu peux me tutoyer

Gillou · Message par **Gillou** » ven. 04/nov./2005 23:09

ok y a pas de pbs, et bonne chance pour ton exam (au fait on dit pas merci

)

@+

Droopy · Message par **Droopy** » sam. 05/nov./2005 9:59

Si si, le premier mot de mon Post était " MERCI ", au fait j'avais déjà commencé à pomper sur ton code que tu avais posté sur 2Dev

, j'ai plus qu'a compléter avec le différentiel.

Qui a créé ces codes, afin que je rende a Cesar ...

Gillou · Message par **Gillou** » lun. 07/nov./2005 11:30

le merci c'était par rapport à la chance pour ton exam, c'est pas que je sois supersititieux, c'était pour le fun

Bon pour la fonction TableToImage et ImageToTable

il faut un tableau comme ça :
Table(imageheight(), imagewidth())
et pas l'inverse, je vais corrigé ça

J'ai corrigé les fonctions editor gadget qui déconné (mais bon il y a la lib de Progi1984 qui tourne nickel alors?)

si j'ai d'autre, fonction je te les envoies

à+ et de rien

wolfjeremy · Message par **wolfjeremy** » sam. 25/mars/2006 21:23

Salut,

L'aide de la lib refuse de s'ouvrir chez moi.
L'exe ne marche pas, l'invite de commande s'ouvre et le curseur se deplace dedans mais rien ne se passe...

Pouvez vous m'aider ?
merci d'avance.

Droopy · Message par **Droopy** » sam. 25/mars/2006 23:24

Si l'installeur ne fonctionne pas chez toi, utilise la version sans installeur :

http://www.penguinbyte.com/apps/pbwebst ... taller.zip

wolfjeremy · Message par **wolfjeremy** » dim. 26/mars/2006 15:53

merci

Gillou · Message par **Gillou** » mar. 04/avr./2006 15:17

Droopy, ma bibliothèque avec la plupart des codes corrigés pour la v4

File:1->PureFonctions_-_PB4.zip

A+

wolfjeremy · Message par **wolfjeremy** » mar. 04/avr./2006 18:49

Heu sinon, Droopy l'aide de ta lib refuse de s'ouvrir chez moi, tu saurai pas m'aider ? merci lol

impossible d'ouvrir le fichier : mk:@MSITStore:C:\Documents and Settings\jeremy\bureau\droopy.chm.

Droopy · Message par **Droopy** » mar. 04/avr./2006 21:43

Alors là Gillou je reste bouche bée

Je finis un projet que j'ai en cours et regarde ça avec attention

Droopy · Message par **Droopy** » mar. 04/avr./2006 21:44

Si tu décompresse ce ZIP : http://www.penguinbyte.com/apps/pbwebst ... taller.zip

ça le fait pas ?

wolfjeremy · Message par **wolfjeremy** » mar. 04/avr./2006 21:47

Ha non... excuse moi

Droopy · Message par **Droopy** » mer. 05/avr./2006 6:56

Bizarre le fichier droopy.chm s'ouvre très bien sur plusieurs de mes PC.

Droopy's Lib

La seconde partie