XProfan

Kompilieren Marca Separación

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 Icons no ladbar.

18.03.2007 ▲

Jörg
Sellmeyer

Dito en me.

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

Sebastian
Sprenger

¡Hola Dieter,
en me genauso. Yo fürchte aber, dass Windows el así durchaus correcto macht.
In uno ICO-Expediente puede nämlich mehrere Icons gespeichert sein; vermutlich, así se Windows eins heraussuchen kann, el al besten a aktuell eingestellten Farbtiefe y Symbolgröße passt. Mit el ersten SaveIcon se sólo el Icon incluso gespeichert y el zweiten SaveIcon el Liste dieser verschiedenen Icons, que igual al Anfang uno ICO-Expediente befindet.
Mi erste Concepto wäre, SaveIcon eben mehrmals aufzurufen y el Resourcen a uno Expediente zusammenzuflicken.
An dieser Punto hay determinado todavía einiges a beachten, aber dazu sería Yo veces más bien sólo kommen, si otra vez hell draußen es...

Saludo, 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

¡Hola Dieter...

Irgendwie hast du como el Encabezamiento vergessen:
Kompilieren Marca Separación

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

[...]

Yo denke veces, el Rest bekommst du auch hin.

Na sí, así en etwa...
Kompilieren Marca Separación

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 para el Ayuda, Yo glaube Yo bin el Solución ahora viel näher, Man muss el Rutina wirklich 2 x aufrufen, una vez con RT_Icon, porque como posición el Daten des oder el Icons y una zweites veces con RT_Group_Icon, porque en diesem es el Icondirectory. Como dieses pero no exakt el Encabezamiento entspricht, denke Yo dass Yo como el benötigten Daten hay auslesen muss y lo una neuen Encabezamiento forma
ähnlich como Sebastian lo geschrieben ha.
@Andreas dein Lösungsansatz es fast correcto, aber uno muss zuerst el Daten auslesen en el passenden Encabezamiento para diferente Icons, Anzahl, Farbe, Größe usw a escribir. Yo habe veces de mí Worsit.org el Descripción el Icondateien elaborado, Yo denke dass Yo hinbekommen voluntad, se aber una Weile dauern, como Yo a Tiempo aún en Deutschland bin Mitte April aber otra vez después de Asien ir voluntad. Wenn Yo, el Code fertig habe voluntad Yo ihn hier disponible stellen, se aber una Weile dauern.

Saludo

Dieter

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

Hast du dir ya veces media letzten Ver código fuente angesehen - como es doch el Solución... (Oder va el en dir no?) In el resource es como el ID uno Icons como letzter Member el Strucktur - en el ICON Datein una LongInt, el en el Anfang el Daten verweist.

Uwe
''Pascal''
Niemeier

¡Hola Personas!

*räusper*
Hier mentira todavía irgendwo mi alten API-Workshops rum...
Im 4. Teil es en Resourcen; esta son auch Beispiele, en Icons komplett a exportieren. El son zwar todavía para Profano 6.6, aber como muss sólo el damals übliche addr(String$)+1 korrigiert voluntad, entonces klappt lo.
HTH
Pascal

el vierten Teil Todavía nie gebraucht, danke

@Uwe: El son hier: [...]

Das Layout es sólo en el Moment verkorkst...

Dieter
Zornow

Yo habe me angeschaut, en el Iconbeschreibung de worsit.org. En una
Einfachicon Es el RT_Group_Icon Struktur 20 bytes groß y Word 18 Es el ID para encontrar, el uno String #ID a FindResource transferencia kann. En una MehrfachIcon wiederholt se el Teil de Iconbreite a ID je después de Anzahl el Icons, el Struktur es el entsprechend größer.
Se puede MehrfachIcons entonces einzeln oder otra vez como MehrfachIcon abspeichern
con el passenden Encabezamiento.
Der Vorgang me está nun klar, Yo muss el sólo aún en Code umsetzten si yo el Tiempo dazu finde.
Nochmals vielen Dank para el Ayuda.

Saludo

Dieter

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