XProfan

Compile Mark Separation

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

both gespeicherten Icons not ladbar.

03/18/07 ▲

Jörg
Sellmeyer

Dito by me.

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

Sebastian
Sprenger

Hello Dieter,
by me just as. I fürchte but, that windows the so thoroughly correctly. power.
In of/ one ICO-File can namely several Icons stored sein; presumably, so itself windows one heraussuchen can, the best to currently tuned Color Depth and Symbolgröße fit. with the first SaveIcon becomes only the Icon self stored and the second SaveIcon The list this different Icons, which same at the beginning of/ one ICO-File befindet.
my first idea would, SaveIcon even number of times aufzurufen and the Resources to a File zusammenzuflicken.
on this place there certainly yet some To mind, but moreover would I time rather first come, if it again bright outside is...

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

Hello Dieter...

somehow have you got there whom Header forget:
Compile Mark Separation

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

[...]

i think time, whom remainder get You too there.

well Yes, so vaguely...
Compile Mark Separation

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 Thanks for Help, I faith i'm the Solution now plenty hither, one must The routine really 2 x Call, once with RT_Icon, because there stand The data the or the Icons and a second time with RT_Group_Icon, because in this is the Icondirectory. there this but not exakt the Header corresponds to, think I I since the required data there read must and from it a new Header form
like Sebastian it written has.
@Andreas your Lösungsansatz is almost correctly., but one must first The data read around the suitable Header for different Icons, amount, colour, Size etc To write. I have me time of Worsit.org The Description the Icondateien pulled, i think I it hinbekommen will be, becomes but a while last, I to Time still in Germany be middle april but again to asia weg will be. If I the code ready have I will it here available to put, becomes but a while last.

Greeting

Dieter

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

have you got you already time my last View source respected - there standing still The Solution... (or goes the with you not?) in the resource standing since the ID one Icons as last Member the Strucktur - in the ICON Files one LongInt, the on the beginning the data verweist.

Uwe
''Pascal''
Niemeier

Hello people!

*räusper*
here lying still somewhere my middle-aged API-Workshops rum...
in the 4. part goes it circa Resourcen; thereby are too Examples, circa Icons complete To export. The are of course yet for Profan 6.6, but since must only the then übliche addr(String$)+1 korrigiert go, then works it.
HTH
Pascal

whom fourth part have I yet never used, thanks

@Uwe: The are here: [...]

the Layout is only momentum verkorkst...

Dieter
Zornow

I have me the angeschaut, in the Iconbeschreibung of worsit.org. with one
Einfachicon is the RT_Group_Icon structure 20 bytes big and Word 18 is the ID to find, everybody can String #ID on FindResource transfer can. with one MehrfachIcon repeatedly itself the part of Iconbreite To ID according to Number of Icons, the structure is the properly larger.
one can MehrfachIcons then particular or again as MehrfachIcon abspeichern
with the suitable Header.
The process is me now clear, I must the only still in code umsetzten if I The Time moreover find.
over again many Thanks for Help.

Greeting

Dieter

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