XProfan

Kompilieren Markieren Separieren

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 nicht ladbar.

18.03.2007 ▲

Jörg
Sellmeyer

Dito bei mir.

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

Sebastian
Sprenger

Hallo Dieter,
bei mir genauso. Ich fürchte aber, dass Windows das so durchaus richtig macht.
In einer ICO-File können nämlich mehrere Icons gespeichert sein; presumibilmente, damit sich Windows eins heraussuchen kann, das am besten zur aktuell eingestellten Farbtiefe und Symbolgröße passt. Mit dem ersten SaveIcon wird nur das Icon selbst gespeichert und mit dem zweiten SaveIcon die Liste dieser verschiedenen Icons, die sich gleich am Anfang einer ICO-File è.
Meine erste Idee wäre, SaveIcon eben mehrmals aufzurufen und die Resourcen zu einer File zusammenzuflicken.
An dieser Stelle gibt es bestimmt noch einiges zu beachten, aber dazu würde ich mal lieber erst kommen, wenn es wieder hell draußen ist...

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

Hallo Dieter...

Irgendwie hast du da den Testata vergessen:
Kompilieren Markieren Separieren

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

[...]

Ich denke mal, den Rest bekommst du auch hin.

Na ja, so in etwa...
Kompilieren Markieren Separieren

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 per die Aiuto, ich glaube ich bin der Lösung jetzt viel näher, Man muss die Routine wirklich 2 x aufrufen, einmal mit RT_Icon, denn da stehen die Daten des oder der Icons und ein zweites mal mit RT_Group_Icon, denn in diesem ist das Icondirectory. Da dieses aber nicht exakt dem Testata entspricht, denke ich dass ich da die benötigten Daten dort auslesen muss und daraus einen neuen Testata bilden
ähnlich wie Sebastian es geschrieben hat.
@Andreas dein Lösungsansatz ist fast richtig, aber man muss zuerst die Daten auslesen um den passenden Testata per unterschiedliche Icons, Anzahl, Farbe, Dimensione usw zu schreiben. Ich habe mir mal von Worsit.org die Beschreibung der Icondateien gezogen, ich denke dass ich es hinbekommen werde, wird aber eine Weile dauern, da ich zur Zeit noch in Germania bin Mitte April aber wieder nach Asien gehen werde. Wenn Io l' Code fertig habe werde ich ihn hier zur Verfügung stellen, wird aber eine Weile dauern.

Saluto

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 schon mal meinen letzten Quelltext angesehen - da steht doch die Lösung... (Oder geht der bei dir nicht?) In der resource steht da die ID eines Icons als letzter Member der Strucktur - in der ICON Datein ein LongInt, der auf den Anfang der Daten verweist.

Uwe
''Pascal''
Niemeier

Hallo Leute!

*räusper*
Hier liegen doch noch irgendwo meine alten API-Workshops rum...
Im 4. Teil geht es um Resourcen; dabei sind auch Beispiele, um Icons komplett zu exportieren. Die sind zwar noch per Profan 6.6, aber da muss nur das damals übliche addr(String$)+1 korrigiert werden, dann klappt es.
HTH
Pascal

den vierten Teil habe ich noch nie gebraucht, danke

@Uwe: Die sind hier: [...]

Das Layout ist nur im Moment verkorkst...

Dieter
Zornow

Ich habe mir das angeschaut, in der Iconbeschreibung von worsit.org. Bei einem
Einfachicon ist die RT_Group_Icon Struktur 20 bytes grande und in Word 18 ist die ID zu finden, die man String #ID an FindResource trasferimento kann. Bei einem MehrfachIcon wiederholt sich der Teil von Iconbreite bis ID je nach Anzahl der Icons, die Struktur ist dem entsprechend größer.
Man kann MehrfachIcons dann einzeln oder wieder als MehrfachIcon abspeichern
mit dem passenden Testata.
Der Vorgang ist mir nun klar, ich muss das nur noch in Code umsetzten wenn ich die Zeit dazu finde.
Nochmals vielen Dank per die Aiuto.

Saluto

Dieter

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