PureBasic

Forums PureBasic - Français
http://forums.purebasic.com/french/

Sources de WinDestroyer

http://forums.purebasic.com/french/viewtopic.php?t=4764

Page 1 sur 1

Sources de WinDestroyer

Publié : jeu. 30/mars/2006 9:17
par Dr. Dri
Voila toutes les sources de WinDestroyer (j'édite au fur et à mesure) qui ne concernent pas la destruction de fichier.

Window.pbi

Code : Tout sélectionner

Procedure DisableTitleBarButton(Window.l, Button.l, State.l)
  Protected MenuID.l
  
  If State
    State = #MF_DISABLED | #MF_GRAYED
  EndIf
  
  MenuID = GetSystemMenu_(WindowID(Window), #False)
  
  If MenuID
    EnableMenuItem_(MenuID, Button, State)
  EndIf
EndProcedure

Macro DisableMinimizeBox(Window, State)
  DisableTitleBarButton(Window, #SC_MINIMIZE, State)
EndMacro

Macro DisableMaximizeBox(Window, State)
  DisableTitleBarButton(Window, #SC_MAXIMIZE, State)
EndMacro

Macro DisableCloseBox(Window, State)
  DisableTitleBarButton(Window, #SC_CLOSE, State)
EndMacro
ToolBar.pbi

Code : Tout sélectionner

Macro ToolBarButton(ToolBar, ButtonID, ImageID, ToolTip, Mode = #PB_ToolBar_Normal)
  ToolBarImageButton(ButtonID, ImageID, Mode)
  ToolBarToolTip(ToolBar, ButtonID, ToolTip)
EndMacro

Macro ToolBarButtonIndex(ToolBar, ButtonID)
  SendMessage_(ToolBarID(ToolBar), #TB_COMMANDTOINDEX, ButtonID, #Null)
EndMacro

Procedure.l ToolBarWidth(ToolBar.l)
  Protected sz.Size, ToolBarID.l
  
  #TB_GETSIZE = #WM_USER + $53
  
  ToolBarID = ToolBarID(ToolBar)
  SendMessage_(ToolBarID, #TB_GETSIZE, #Null, sz)
  
  ProcedureReturn sz\cx
EndProcedure

Procedure.l ToolBarButtonX(ToolBar.l, ButtonID.l)
  Protected rc.rect, Index.l
  
  Index = ToolBarButtonIndex(ToolBar, ButtonID)
  SendMessage_(ToolBarID(ToolBar), #TB_GETITEMRECT, Index, rc)
  
  ProcedureReturn rc\left
EndProcedure

Procedure.l ToolBarButtonY(ToolBar.l, ButtonID.l)
  Protected rc.rect, Index.l
  
  Index = ToolBarButtonIndex(ToolBar, ButtonID)
  SendMessage_(ToolBarID(ToolBar), #TB_GETITEMRECT, Index, rc)
  
  ProcedureReturn rc\top
EndProcedure

Procedure.l ToolBarButtonWidth(ToolBar.l, ButtonID.l)
  Protected rc.rect, Index.l
  
  Index = ToolBarButtonIndex(ToolBar, ButtonID)
  SendMessage_(ToolBarID(ToolBar), #TB_GETITEMRECT, Index, rc)
  
  ProcedureReturn rc\right - rc\left
EndProcedure

Procedure.l ToolBarButtonHeight(ToolBar.l, ButtonID.l)
  Protected rc.rect, Index.l
  
  Index = ToolBarButtonIndex(ToolBar, ButtonID)
  SendMessage_(ToolBarID(ToolBar), #TB_GETITEMRECT, Index, rc)
  
  ProcedureReturn rc\bottom - rc\top
EndProcedure
StatusBar.pbi

Code : Tout sélectionner

Structure StatusBarField
  Width.l
  Text.s
  Style.l
  ImageID.l
EndStructure

Procedure UpdateStatusBar(StatusBar.l, Fields.StatusBarField(1), nFields.l)
  Protected i.l
  
  If IsStatusBar(StatusBar)
    Dim Widths.l(nFields + 1)
    
    While i < nFields
      Widths(i+1) = Widths(i) + Fields(i)\Width
      i + 1
    Wend
    
    If Fields(nFields)\Width = #PB_Default
      Widths(nFields+1) = Fields(nFields)\Width 
    Else
      Widths(nFields+1) = Widths(nFields) + Fields(nFields)\Width
    EndIf
    
    If SendMessage_(StatusBarID(StatusBar), #SB_SETPARTS, nFields+1, @Widths(1))
      i = 0
      
      While i < nFields
        StatusBarText(StatusBar, i, Fields(i)\Text, Fields(i)\Style)
        
        If Fields(i)\ImageID
          StatusBarIcon(StatusBar, i, Fields(i)\ImageID)
        EndIf
        
        i + 1
      Wend
      
    EndIf
  EndIf
EndProcedure
Resources.pbi

Code : Tout sélectionner

Enumeration 1
  #RT_CURSOR
  #RT_BITMAP
  #RT_ICON
  #RT_MENU
  #RT_DIALOG
  #RT_STRING
  #RT_FONTDIR
  #RT_FONT
  #RT_ACCELERATOR
  #RT_RCDATA
  #RT_MESSAGETABLE
  #RT_GROUP_CURSOR
  #RT_GROUP_ICON   = 14
  #RT_VERSION      = 16
  #RT_DLGINCLUDE
  #RT_PLUGPLAY     = 19
  #RT_VXD
  #RT_ANICURSOR
  #RT_ANIICON
  #RT_HTML
EndEnumeration

Procedure.l GetLibraryID(Library.l = #PB_Default)
  Protected LibraryID.l
  Static    ModuleID.l
  
  If ModuleID = #Null
    ModuleID = GetModuleHandle_(#Null)
  EndIf
  
  If Library = #PB_Default
    LibraryID = ModuleID
  Else
    If IsLibrary(Library)
      LibraryID = LibraryID(Library)
    EndIf
  EndIf
  
  ProcedureReturn LibraryID
EndProcedure

Procedure.l LoadBitmap(Resource.l, Image.l, Library.l = #PB_Default)
  Protected Load.l, LibraryID.l, Index.l
  Protected *ImageID.Long, BitmapID.l, bm.Bitmap
  
  LibraryID = GetLibraryID(Library)
  
  If LibraryID
    BitmapID = LoadBitmap_(LibraryID, Resource)
  EndIf
  
  If BitmapID And GetObject_(BitmapID, SizeOf(Bitmap), bm)
    Index = CreateImage(Image, bm\bmWidth, bm\bmHeight, bm\bmBitsPixel)
    If Image <> #PB_Any : Index = Image : EndIf
    *ImageID = IsImage(Index)
  EndIf
  
  If *ImageID
    DeleteObject_(*ImageID\l)
    *ImageID\l = BitmapID
    If Image = #PB_Any
      BitmapID = Index
    EndIf
  Else
    DeleteObject_(BitmapID)
    BitmapID = #Null
  EndIf
  
  ProcedureReturn BitmapID
EndProcedure

Procedure.l LoadIcon(Resource.l, Image.l, Library.l = #PB_Default)
  Protected Load.l, LibraryID.l, Index.l
  Protected *ImageID.Long, IconID.l
  
  LibraryID = GetLibraryID(Library)
  
  If LibraryID
    IconID = LoadIcon_(LibraryID, Resource)
  EndIf
  
  If IconID
    Index = CreateImage(Image, GetSystemMetrics_(#SM_CXICON), GetSystemMetrics_(#SM_CYICON))
    If Image <> #PB_Any : Index = Image : EndIf
    *ImageID = IsImage(Index)
  EndIf
  
  If *ImageID
    DeleteObject_(*ImageID\l)
    *ImageID\l = IconID
    If Image = #PB_Any
      IconID = Index
    EndIf
  Else
    DestroyIcon_(IconID)
    IconID = #Null
  EndIf
  
  ProcedureReturn IconID
EndProcedure

Procedure.l LoadIconEx(Resource.l, Image.l, Width.l, Heigth.l, Library.l = #PB_Default)
  Protected Load.l, LibraryID.l, IconData.l, IconSize.l
  Protected *ImageID.Long, IconID.l, ResourceID.l, Index.l
  
  LibraryID = GetLibraryID(Library)
  
  If LibraryID
    ResourceID = FindResource_(LibraryID, Resource, #RT_GROUP_ICON)
    IconData   = LoadResource_(LibraryID, ResourceID)
    Resource   = LookupIconIdFromDirectoryEx_(IconData, #True, Width, Heigth, #LR_DEFAULTCOLOR)
    ResourceID = FindResource_(LibraryID, Resource, #RT_ICON)
    IconData   = LoadResource_(LibraryID, ResourceID)
    IconSize   = SizeofResource_(LibraryID, ResourceID)
    IconID     = CreateIconFromResourceEx_(IconData, IconSize, #True, $00030000, Width, Heigth, #LR_DEFAULTCOLOR)
  EndIf
  
  If IconID
    Index = CreateImage(Image, Width, Heigth)
    If Image <> #PB_Any : Index = Image : EndIf
    *ImageID = IsImage(Index)
  EndIf
  
  If *ImageID
    DeleteObject_(*ImageID\l)
    *ImageID\l = IconID
    If Image = #PB_Any
      IconID = Index
    EndIf
  Else
    DestroyIcon_(IconID)
    IconID = #Null
  EndIf
  
  ProcedureReturn IconID
EndProcedure

Procedure.l LoadMenu(Resource.l, Menu.l, WindowID.l, Library.l = #PB_Default)
  Protected Load.l, LibraryID.l, Index.l
  Protected *MenuID.Long, MenuID.l
  
  LibraryID = GetLibraryID(Library)
  
  If LibraryID
    MenuID = LoadMenu_(LibraryID, Resource)
  EndIf
  
  If MenuID
    Index = CreateMenu(Menu, WindowID)
    If Menu <> #PB_Any : Index = Menu : EndIf
    *MenuID = IsMenu(Menu)
  EndIf
  
  If *MenuID
    SetMenu_(WindowID, MenuID)
    DestroyMenu_(*MenuID\l)
    *MenuID\l = MenuID
    If Menu = #PB_Any
      MenuID = Index
    EndIf
  Else
    DestroyMenu_(MenuID)
    MenuID = #Null
  EndIf
  
  ProcedureReturn MenuID
EndProcedure

Procedure.l LoadPopupMenu(Resource.l, Menu.l, Library.l = #PB_Default)
  Protected Load.l, LibraryID.l, Index.l
  Protected *MenuID.Long, MenuID.l
  
  LibraryID = GetLibraryID(Library)
  
  If LibraryID
    MenuID = LoadMenu_(LibraryID, Resource)
  EndIf
  
  If MenuID
    MenuID = GetSubMenu_(MenuID, 0)
  EndIf
  
  If MenuID
    Index = CreatePopupMenu(Menu)
    If Menu <> #PB_Any : Index = Menu : EndIf
    *MenuID = IsMenu(Menu)
  EndIf
  
  If *MenuID
    DestroyMenu_(*MenuID\l)
    *MenuID\l = MenuID
    If Menu = #PB_Any
      MenuID = Index
    EndIf
  Else
    DestroyMenu_(MenuID)
    MenuID = #Null
  EndIf
  
  ProcedureReturn MenuID
EndProcedure

Procedure.s LoadString(Resource.l, Library.l = #PB_Default)
  Protected String.s, Length, LibraryID.l
  
  LibraryID = GetLibraryID(Library)
  
  If LibraryID
    Repeat
      Length + $400
      String = Space(Length)
    Until LoadString_(LibraryID, Resource, String, Length) < (Length - 1)
  EndIf
  
  ProcedureReturn String
EndProcedure

Procedure.l LoadKeyboardShortcuts(Resource.l, Window.l, Library.l = #PB_Default)
  Protected nShortcuts.l, LibraryID.l
  Protected ShortcutsID.l, Shortcut.l, i.l
  
  If IsWindow(Window)
    LibraryID = GetLibraryID(Library)
  EndIf
  
  If LibraryID
    ShortcutsID = LoadAccelerators_(LibraryID, Resource)
  EndIf
  
  If ShortcutsID
    nShortcuts = CopyAcceleratorTable_(ShortcutsID, #Null, #Null)
  EndIf
  
  If nShortcuts
    Dim Shortcuts.Accel(nShortcuts)
    CopyAcceleratorTable_(ShortcutsID, Shortcuts(), nShortcuts)
    
    While i < nShortcuts
      Shortcut = Shortcuts(i)\key
      
      If Shortcuts(i)\fVirt & #FSHIFT   : Shortcut | #PB_Shortcut_Shift   : EndIf
      If Shortcuts(i)\fVirt & #FCONTROL : Shortcut | #PB_Shortcut_Control : EndIf
      If Shortcuts(i)\fVirt & #FALT     : Shortcut | #PB_Shortcut_Alt     : EndIf
      
      AddKeyboardShortcut(Window, Shortcut, Shortcuts(i)\cmd)
      
      i + 1
    Wend
  EndIf
  
  ProcedureReturn nShortcuts
EndProcedure
Dri ;)

PS. j'essairai de poster des exemples
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru