XProfan

Kompilieren Marque Séparation

Def FindResource(3) !Kernel32,FindResourceA
Def LoadResource(2) !Kernel32,LoadResource
Def SizeofResource(2) !Kernel32,SizeofResource
Def LockResource(1) ! Kernel32,LockResource
clearclip

Proc SaveIcon

    Parameters IconPfad$,hdl&,nr$,typ&
    declare Icon#,Size&,IconH&,IconAD&,IconADL&
    IconH& = FindResource(hdl&,addr(nr$),typ&)
    _print IconH&
    Size& = SizeofResource(hdl&,IconH&)
    _print size&
    dim Icon#,Size&
    IconAD& = LoadResource(hdl&,IconH&)
    _print IconAD&
    IconADL& = LockResource(IconAD&)
    _print IconADL&
    Icon# = IconADL&
    assign #1,IconPfad$
    openrw #1
    blockwrite #1,Icon#,0,Size&
    close #1
    dispose Icon#

EndProc

cls
SaveIcon(c:TempIcon.ico,%hinstance,#22,3)
waitinput
cls
SaveIcon(c:TempIcon2.ico,%hinstance,A,14)
waitinput
end

proc _print

    parameters l&
    putclip str$(l&)+
    print l&

endproc

Beide gespeicherten Icônes pas ladbar.

18.03.2007 ▲

Jörg
Sellmeyer

Dito chez mir.

Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

Sebastian
Sprenger

allô Dieter,
chez mir genauso. je fürchte mais, dass Windows cela so durchaus richtig pouvoir.
dans einer ICO-Dossier peut nämlich plusieurs Icônes gespeichert sein; probablement, avec cela sich Windows une heraussuchen peux, cela am besten zur aktuell eingestellten Farbtiefe et Symbolgröße passt. avec dem ersten SaveIcon wird seulement cela Icon selbst gespeichert et dem zweiten SaveIcon qui liste cette verschiedenen Icônes, qui sich juste am Anfang einer ICO-Dossier est.
mon erste concept wäre, SaveIcon plan plusieurs fois aufzurufen et qui Resourcen trop einer Dossier zusammenzuflicken.
à cette Stelle gibt es bestimmt encore einiges trop tenir compte de, mais en supplément serait je la fois lieber seulement venons, si es wieder hell dehors ist...

Salut, Sebastian

Profan² 7.0e, XProfan 9, 11.2a, FreeProfan32

Windows Vista Home Premium 32-Bit, 2.8 Ghz, 4 GB RAM

Windows Me, 1.8 Ghz, 256 MB RAM

allô Dieter...

Irgendwie la hâte du là den En-tête oublier qc:
Kompilieren Marque Séparation

Def @GetCurrentProcessId(0) !KERNEL32,GetCurrentProcessId
Def @Toolhelp32ReadProcessMemory(5) !KERNEL32,Toolhelp32ReadProcessMemory
Def FindResource(3) !Kernel32,FindResourceA
Def LoadResource(2) !Kernel32,LoadResource
Def FreeResource(1) !Kernel32,FreeResource
Def SizeofResource(2) !Kernel32,SizeofResource
Def LockResource(1) ! Kernel32,LockResource
Def @GetLastError(0) !KERNEL32,GetLastError
Def @SetLastError(1) !KERNEL32,SetLastError
Declare Header#

Proc SaveIcon

    Parameters IconPfad$,hdl&,nr$,typ%
    declare Icon#,Size&,IconH&,IconAD&,IconADL&,READ&
    Dim Header#,22
    Clear Header#
    @SetLastError(0)
    IconH& = FindResource(hdl&,@addr(nr$),Typ%)
    Print Error:+@str$(GetLastError())
    Print IconH&
    Size& = SizeofResource(hdl&,IconH&)
    print size&
    dim Icon#,Size&+1
    IconAD& = LoadResource(hdl&,IconH&)
    Print IconAD&
    IconADL& = LockResource(IconAD&)
    print IconADL&
    @Toolhelp32ReadProcessMemory(@GetCurrentProcessId(),IconADL&,Icon#,Size&,@ADDR(READ&))
    Icon# = IconADL&
    assign #1,IconPfad$
    erase #1
    openrw #1
    Word HEADER#,0=0 reserviert
    Word HEADER#,2=1 Typ = Icon
    Word HEADER#,4=1 Anzahl der Icons in der Datei
    Byte HEADER#,6=32 Breite
    Byte HEADER#,7=32 Höhe
    Byte HEADER#,8=16 Anzahl der Farben
    Byte HEADER#,9=0  reserviert
    Word HEADER#,10=1 Color Planes
    Word HEADER#,12=4 Bits per Pixel
    Long HEADER#,14=Size& Amzahl an Bytes der Daten-Bytes
    Long HEADER#,18=22 Anfang der Daten
    Seek #1,0
    blockwrite #1,HEADER#,0,22
    blockwrite #1,Icon#,0,Size&
    closerw #1
    dispose Icon#
    dispose HEADER#
    FreeResource(IconAD&)

EndProc

cls
SaveIcon(c:TempIcon.ico,0,#3,$3)
waitinput

[...]

je denke la fois, den reste bekommst du aussi hin.

eh bien, so dans etwa...
Kompilieren Marque Séparation

Def FindResource(3) !Kernel32,FindResourceA
Def LoadResource(2) !Kernel32,LoadResource
Def SizeofResource(2) !Kernel32,SizeofResource
Def LockResource(1) ! Kernel32,LockResource
Declare Seek&

Proc SaveIcon

    Parameters IconPfad$,hdl&,nr$,typ&,Offset&
    declare Icon#,Size&,IconH&,IconAD&,IconADL&
    IconH& = FindResource(hdl&,addr(nr$),typ&)
    Print IconH&
    Size& = SizeofResource(hdl&,IconH&)
    print size&
    dim Icon#,Size&
    IconAD& = LoadResource(hdl&,IconH&)
    Print IconAD&
    IconADL& = LockResource(IconAD&)
    print IconADL&
    Icon# = IconADL&
    assign #1,IconPfad$
    CASE OFFSET&=0 : ERASE #1
    openrw #1
    Seek #1,Offset&
    blockwrite #1,Icon#,0,Size&
    close #1
    dispose Icon#

EndProc

Declare Size#
cls
SaveIcon(c:TempIcon.ico,%hinstance,DOS,14,0)
DIM Size#,4
Long Size#,0=22
assign #1,c:TempIcon.ico
openrw #1
Seek #1,18
blockwrite #1,Size#,0,4
closerw #1
Dispose Size#
LET Seek&=@FileSize(c:TempIcon.ico)
Print Seek&
SaveIcon(c:TempIcon.ico,%hinstance,#3,3,Seek&)
waitinput

Dieter
Zornow

Vielen Dank pour qui Aider, je crois je suis qui Solution maintenant viel näher, on muss qui Routine wirklich 2 x appel, einmal avec RT_Icon, car là stehen qui données des ou bien qui Icônes et un zweites la fois avec RT_Group_Icon, car dans diesem ist cela Icondirectory. là cet mais pas exakt dem En-tête entspricht, denke je dass je là qui nécessaire données là auslesen muss et daraus une neuen En-tête bilden
ähnlich comment Sebastian es geschrieben hat.
@Andreas dein Lösungsansatz ist presque richtig, mais on muss d'abord qui données auslesen um den passenden En-tête pour différent Icônes, Anzahl, la couleur, Taille usw trop écrivons. j'ai mir la fois de Worsit.org qui Beschreibung qui Icondateien gezogen, je denke dass je es hinbekommen werde, wird mais une Weile dauern, là je zur Zeit encore dans l'allemagne suis Mitte avril mais wieder pour Asien aller werde. si Je l' Code fertig habe werde je ihn ici zur Disposition se mettre, wird mais une Weile dauern.

Salut

Dieter

Er ist ein Mann wie ein Baum. Sie nennen ihn Bonsai., Win 7 32 bit und Win 7 64 bit, mit XProfan X2

la hâte du dir déjà la fois meinen letzten Voir le texte source angesehen - là steht doch qui Solution... (ou bien allez qui chez dir pas?) dans qui resource steht là qui ID eines Icônes comme dernier Member qui Strucktur - dans qui ICON Datein un LongInt, qui sur den Anfang qui données verweist.

Uwe
''Pascal''
Niemeier

allô gens!

*räusper*
ici liegen doch encore irgendwo mon alten API-Workshops rum...
Im 4. partie ca va um Resourcen; dabei sommes aussi Beispiele, um Icônes komplett trop exportieren. qui sommes zwar encore pour Profan 6.6, mais là muss seulement cela autrefois übliche addr(String$)+1 korrigiert volonté, ensuite klappt es.
HTH
Pascal

den vierten partie habe je encore nie gebraucht, merci

@Uwe: qui sommes ici: [...]

cela Layout ist seulement im Moment verkorkst...

Dieter
Zornow

j'ai mir cela angeschaut, dans qui Iconbeschreibung de worsit.org. chez einem
Einfachicon ist qui RT_Group_Icon Struktur 20 bytes grand et dans Word 18 ist qui ID pour trouver, qui on String #ID à FindResource transfert peux. chez einem MehrfachIcon wiederholt sich qui partie de Iconbreite jusqu'à ID je pour Nombre de Icônes, qui Struktur ist dem entsprechend größer.
il peut MehrfachIcons ensuite einzeln ou bien wieder comme MehrfachIcon abspeichern
avec dem passenden En-tête.
qui Vorgang c'est moi eh bien bien sûr, je muss cela seulement encore dans Code umsetzten si je qui Zeit en supplément finde.
Nochmals vielen Dank pour qui Aider.

Salut

Dieter

Er ist ein Mann wie ein Baum. Sie nennen ihn Bonsai., Win 7 32 bit und Win 7 64 bit, mit XProfan X2