PureBoard

Code: Alles auswählen

;PureBasic-QuellCode "IconSave" mit allen ModulBody´s
;erstellt durch Programm "PB_Mod2Body", Vers. 7A13a am 25.04.2008, 10:25

;Modul      IconSave Version 1.05 vom 17.09.2007
;
;Funktion:  speichert ein Icon aufgrund IconHandle in einer .BMP-Datei
;           Es wird keine PB-Icon-/Image-Nummer benötigt: interessant,
;           wenn Icon via API aufgebaut / geladen wurde (z.B. via
;           ExtractIconEx_(DLL_File$....)) und nur ´n Handle bekannt
;           ist...
;
;Aufruf:    IconSave(IconHdl.l, FileName$)
;           IconHdl = Icon-Handle, z.B. Ergbniss von CreateImage() oder
;                     LoadImage()...
;           FileName$ = DateiName der anzulegenden .BMP-Datei
;
;#jaPBeExt exit
;==========  Begin Modul "C:\ALSTERSOFT\PUREBASIC\MODULE\ERRTXT.PBI"  ==========
Procedure.s ErrTxt() ;- liefert Text zum letzten Fehler
  Protected ErrText$
  ErrText$ = Space(1024)
  FormatMessage_(#FORMAT_MESSAGE_FROM_SYSTEM, 0, GetLastError_(), 0, ErrText$, Len(ErrText$), 0)
  For i=1 To 31 : ErrText$=ReplaceString(ErrText$,Chr(i),"") : Next
  ProcedureReturn ErrText$
EndProcedure
;==========  Ende Modul "C:\ALSTERSOFT\PUREBASIC\MODULE\ERRTXT.PBI"  ==========
;XIncludeFile "C:\AlsterSoft\PureBasic\Module\FreeWinNr.PBI"
;XIncludeFile "C:\AlsterSoft\PureBasic\Module\FreeBildNr.PBI"

Procedure IconSave(IS_IconID, IS_FileName$) ;- Icon in .BMP-Datei speichern
  Protected WinID, WinNr, WinHDC
  Protected IconBr, IconHo, IconInfo.ICONINFO
  Protected ImgNr, ImgId, ImgHDC
  
  If GetExtensionPart(IS_FileName$) = "" : IS_FileName$ + ".BMP" : EndIf
  
  If GetIconInfo_(IS_IconID, @IconInfo) ;check Icon & get IconSize:
    IconBr = IconInfo\xHotspot * 2
    IconHo = IconInfo\yHotspot * 2
    
    WinNr = 1 ;FreeWinNr()                 ;create Window:
    WinID = OpenWindow(WinNr, 0, 0, IconBr, IconHo, "", #PB_Window_ScreenCentered)
    CreateGadgetList(WinID)
    
    WinHDC = GetDC_(WinID)              ;DrawIcon in vorliegender Größe im Fenster
    #DI_NORMAL = 3
    DrawIconEx_(WinHDC, 0, 0, IS_IconID, IconBr, IconHo, 0, 0, #DI_NORMAL)
    
    ImgNr = 1 ;FreeBildNr(0)              ;create Image als Kopier-Ziel des Icon´s im Fenster
    ImgId = CreateImage(ImgNr, IconBr, IconHo)
    ImgHDC = StartDrawing(ImageOutput(ImgNr))
    If BitBlt_(ImgHDC, 0, 0, IconBr, IconHo, WinHDC, 0, 0, #SRCCOPY) ;copy Screen-->Image
      SaveImage(ImgNr, IS_FileName$)
    Else : MessageRequester("Fehler aufgetreten !", "Das Icon " + Str(IS_IconID) + " konnte nicht in der Datei" + Chr(10) + IS_FileName$ + Chr(34) + "" + Chr(34) + "" + Chr(10) + "gespeichert werden, weil" + Chr(10) + ErrTxt(), #MB_OK|#MB_ICONWARNING)
    EndIf
    StopDrawing()
    
    While WindowEvent() : Delay(10) : Wend ;MsgQueue abarbeiten
    ;FreeBildNr(ImgNr)
    CloseWindow(WinNr)
  EndIf
EndProcedure


OutFile$ = "Test.BMP"
IconID.l ;Icon_Handle

ExtractIconEx_("Shell32.dll", 21, 0, @IconID, 1) ;get Icon

IconSave(IconID, OutFile$) ;Icon --> .BMP-File

RunProgram("mspaint", OutFile$, "", 0) ;BMP-File anzeigen

End
 
; jaPBe Version=3.7.10.668
; Build=0
; Language=0x0000 Language Neutral
; FirstLine=0
; CursorPosition=0
; ExecutableFormat=Windows
; DontSaveDeclare
; EOF