XProfan

Español

KHR

¡Hola miteinander,

.

momentan tener Yo como algunos Programas en el Mache, el bitmaps oder Icons de ner DLL uso. Das klappt dank Eurer Ayuda sí bastante bien.

Jetzt komme Yo aber langsam en el Zona, wo Yo el Inhalte dieser DLL no sólo una Ressourcen-Tool pero auch de una XProfan-Programa de ändern oder gar invertir puede debería.

Hab Yo como nen einfachen Weg übersehen?

Oder meint Ihr: Laß el Finger weg - is a komplex?

Wer kann me Tips geben?

Gruß
Karl-Heinz
WIN XP home/Pro / XPROFAN 11 / P2CPP
ATMEL + BASCOM Fan

23.02.2009 ▲

Vollständiges Zitat

Absatzweise Cita Zeilenweise Cita

Andreas
Miethe

DOKTOR XPROFAN EHRENHALBER

Yo sería sagen weitermachen ! Ist no así schwer.
Kompilieren Marca Separación

#############################################
Bitmaps als Resource in eine Dll einbinden
#############################################
nur für NT-basierende Windows-Versionen
#############################################
XPROFAN 11.1
#############################################
 $H Windows.ph
cls ~GetsysColor(~COLOR_BTNFACE)
Print Ich bin ein Test
Bitmap zu Testzwecken anlegen
Var Testname$ = Test.bmp
Var Testpic& = Create(hPic,0,&SCRBMP)
SavePic Testname$,Testpic&
Var hUpdate& = ~BeginUpdateResource(Leer32.dll,0)
Parameter 1 = Pfad zur Dll ( anpassen )
Parameter 2 = BOOL fuer alle Resourcen loeschen (1 oder Null)
Declare FileData#,Size&
Dim FileData#,FileSize(Testname$)
Assign #1,Testname$
OpenRW #1
Size& = @BlockRead(#1,FileData#,0,FileSize(Testname$))
CloseRW #1
~UpdateResource(hUpdate&,~RT_BITMAP,11,~GetSystemDefaultLangID(),FileData#,Size&)
UpdateResource für alle Resourcen ausführen die eingefügt werden sollen
sind die beiden letzten Parameter = NULL wirddie Resource gelöscht
Dispose FileData#
~EndUpdateResource(hUpdate&,0)
EndUpdateResource fügt alle Resourcen in die Dll ein und schliesst die Operation de

Gruss
Andreas
________ ________ ________ ________ _
Profan 3.3 - XProfanX2
Win 95,98,ME,2000,XP,Vista - Win 7 32 / 64 Bit
ASUS X93S - Intel Core I7-NVIDIA GForce 540M 8GB Arbeitsspeicher
Homepage : [...]

23.02.2009 ▲

Vollständiges Zitat

Absatzweise Cita Zeilenweise Cita

So simplemente(?)

23.02.2009 ▲

Vollständiges Zitat

Absatzweise Cita Zeilenweise Cita

Andreas
Miethe

DOKTOR XPROFAN EHRENHALBER

So simplemente(?)

Sí klar, aber sólo si uno blanco como va

23.02.2009 ▲

Vollständiges Zitat

Absatzweise Cita Zeilenweise Cita

Gehör Yo ahora con a!

23.02.2009 ▲

Vollständiges Zitat

Absatzweise Cita Zeilenweise Cita

Uwe
''Pascal''
Niemeier

Hi Andreas!

Würde el auch con Interpreter / Runtime (ungelinkt) klappen (encima %HInstance oder anstelle el dll geladen)? Z.B. a Größe el enthaltenen Icons a ändern o. selbige a sustituir?

SeeYou
Pascal

23.02.2009 ▲

Vollständiges Zitat

Absatzweise Cita Zeilenweise Cita

KHR

¡Hola Andreas,

.

sicher kann Yo ahora no sagen, Yo dazugehöre
Yo kanns zwar anwenden, aber Yo como entonces mache weiß Yo no así bastante.

Zum otro geh lo en me simplemente todavía no. Muß todavía una bißchen probieren. Wenn lo entonces no klappt komm Yo otra vez para rumheulen her.

.

Den code con el auslesen el Mapa de bits-Namen tener Yo en efecto largo no kapiert. Und el umstricken ha sólo geklappt, porque Yo después de cada Code-Änderung ausprobiert habe obs todavía se ejecuta. Wenn sí - una Schritt más, si no - 1 Schritt zurück. Und jede Zwischenversion abgespeichert.

Gruß
Karl-Heinz
WIN XP home/Pro / XPROFAN 11 / P2CPP
ATMEL + BASCOM Fan

23.02.2009 ▲

Vollständiges Zitat

Absatzweise Cita Zeilenweise Cita

Andreas
Miethe

DOKTOR XPROFAN EHRENHALBER

Uwe Pascal Niemeier

Hi Andreas!

Würde el auch con Interpreter / Runtime (ungelinkt) klappen (encima %HInstance oder anstelle el dll geladen)? Z.B. a Größe el enthaltenen Icons a ändern o. selbige a sustituir?

SeeYou
Pascal

Usted musst dazu Schreibrechte haben. Das heisst el Expediente darf a el Zeitpunkt no ausgeführt voluntad. Lo se auch kein Handle pero una Filename$ como Parámetro esperado.
Direkt a Laufzeit es also no.
Ein Programa a escribir, dass el Resourcen antes el Linken ändert es posible, danach kann el Linker sí por Hand aufgerufen voluntad.
En Icons se lo allerding ya schwieriger ( stichwort MultiIcons ).

Yo habe hier todavía una alten Code rumliegen. Tiempo sehen si Yo schaffe el después de XProfan a portieren.

23.02.2009 ▲

Vollständiges Zitat

Absatzweise Cita Zeilenweise Cita

Andreas
Miethe

DOKTOR XPROFAN EHRENHALBER

Yo habe el alten Code umgefummelt.
Ist tal vez una gute Concepto el simplemente como Incluir einzubinden.
Hoffe lo haben se no Fehler eingeschlichen.
Kompilieren Marca Separación

 $H Windows.ph
###########

Proc ClearAll

    Parameters Filename$
    Declare hUpdate&
    hUpdate& = ~BeginUpdateResource(ADDR(FileName$),1)alle Resourcen loeschen
    ~EndUpdateResource(hUpdate&,0)

EndProc

###########

Proc AddBmp

    Parameters FileName$,ResFile$
    Declare FileData#,Size&,IsBMP$
    ResFile$ = Upper$(Resfile$)
    Dim FileData#,FileSize(ResFile$)
    Assign #1,ResFile$
    OpenRW #1
    Size& = @BlockRead(#1,FileData#,0,FileSize(ResFile$))
    IsBMP$ = Chr$(Byte(Filedata#,0))+ Chr$(Byte(Filedata#,1))

    If IsBMP$ = BM

        ~UpdateResource(hUpdate&,~RT_BITMAP,ADDR(ResFile$),~GetSystemDefaultLangID(),ADDR(FileData#)+14,SizeOf(FileData#)-14)
        CloseRW #1
        Dispose FileData#

    Endif

EndProc

###########

Proc DelBmp

    Parameters FileName$,ResFile$
    Declare Mod&
    ResFile$ = Upper$(Resfile$)
    Mod& = UseDll(Filename$)

    If ~FindResource(Mod&,Addr(Resfile$),~RT_BITMAP)

        FreeDll Mod&
        ~UpdateResource(hUpdate&,~RT_BITMAP,ADDR(ResFile$),~GetSystemDefaultLangID(),0,0)

    Endif

EndProc

###########

Proc AddUSER

    Parameters FileName$,ResFile$,My$
    Declare FileData#,Size&
    ResFile$ = Upper$(Resfile$)
    Dim FileData#,FileSize(ResFile$)
    Assign #1,ResFile$
    OpenRW #1
    Size& = @BlockRead(#1,FileData#,0,FileSize(ResFile$))
    ~UpdateResource(hUpdate&,Addr(My$),ADDR(ResFile$),~GetSystemDefaultLangID(),ADDR(FileData#),SizeOf(FileData#))
    CloseRW #1
    Dispose FileData#

Endproc

###########

Proc DelUSER

    Parameters FileName$,ResFile$,My$
    Declare Mod&
    ResFile$ = Upper$(Resfile$)
    Mod& = UseDll(Filename$)

    If ~FindResource(Mod&,Addr(Resfile$),Addr(My$))

        FreeDll Mod&
        ~UpdateResource(hUpdate&,Addr(My$),ADDR(ResFile$),~GetSystemDefaultLangID(),0,0)

    EndProc

    ###########

    Proc AddCursor

        Parameters Filename$,Resfile$
        Declare FileData#,size&
        ResFile$ = Upper$(Resfile$)
        Dim FileData#,FileSize(ResFile$)
        Assign #1,ResFile$
        OpenRW #1
        Size& = @BlockRead(#1,FileData#,0,FileSize(ResFile$))
        CloseRW #1
        ~UpdateResource(hUpdate&,~RT_CURSOR,ADDR(ResFile$),~GetSystemDefaultLangID(),ADDR(FileData#)+18,Size&-18)
        Dispose FileData#

    EndProc

    ###########

    Proc DelCursor

        Parameters FileName$,ResFile$
        Declare Mod&
        ResFile$ = Upper$(Resfile$)
        Mod& = UseDll(Filename$)

        If ~FindResource(Mod&,Addr(Resfile$),~RT_CURSOR)

            FreeDll Mod&
            ~UpdateResource(hUpdate&,~RT_CURSOR,ADDR(ResFile$),~GetSystemDefaultLangID(),0,0)

        Endif

    EndProc

    ###########

    Proc AddIcon

        Parameters Filename$,Resfile$
        MultiIcons

        Proc GetLastIconNum

            Parameters hModul&
            set(FastMode,1)
            ~EnumResourceNames(hModul&,3,ProcAddr(ResNames,4),0)

            Proc ResNames

                Parameters hModul&,lpszType&,lpszName&,lParam&

                If lpszName& & $FFFF0000

                    AddString(l&,String$(lpszName&,0))

                else

                    AddString(l&,Str$(lpszName&))

                Endif

                Return 1

            EndProc

            set(FastMode,0)

        EndProc

        Proc GetIconZahl

            Declare Ret&,Size#
            Parameters file$
            Dim Size#,2
            FileMode 0
            Assign #1,file$
            OpenRW #1
            Seek #1,4
            wieviele Icons sind im File ?
            BlockRead(#1,Size#,0,2)
            Ret& = @Word(Size#,0)
            close #1
            Dispose size#
            Return Ret&

        EndProc

        Proc GetIconDimensions

            Declare Icons&,x%,Size#
            Parameters file$
            Dim Size#,16
            FileMode 0
            Let x% = 0
            Assign #1,file$
            OpenRW #1

            whilenot x% = anzahl%

                zum Einstiegspunkt der einzelnen Icons
                Seek #1,6+(x%*16)
                BlockRead(#1,Size#,0,16)
                Breite%[x%]   = @Byte(size#,0)
                hoehe%[x%]    = @Byte(size#,1)
                farben%[x%]    = @Byte(size#,2)
                reserved%[x%] = @Byte(size#,3)
                colplanes%[x%] = @word(size#,4)
                bitspixel%[x%] =  @word(size#,6)
                bytesinres%[x%] =  @long(size#,8)
                offset%[x%] =  @word(size#,12)
                Inc x%

            EndWhile

            CloseRW #1
            FileMode 2
            Dispose Size#

        EndProc

        Proc DrawSingleIcon

            Parameters Ico$,x%
            Declare FileHeader#,Dummy#
            Dim Fileheader#,22
            Fileheader fuer Icon anlegen
            word fileheader#,0 = 0
            word fileheader#,2 = 1Icon
            word fileheader#,4 = 1How many Images
            byte fileheader#,6 = Breite%[x%]width
            byte fileheader#,7 = Hoehe%[x%]height
            byte fileheader#,8 = farben%[x%]colorcount
            byte fileheader#,9 = reserved%[x%]reserved
            word fileheader#,10 = colplanes%[x%]colorplanes
            word fileheader#,12 = bitspixel%[x%]bitcount
            long fileheader#,14 = bytesinres%[x%]BytesInRes
            long fileheader#,18 = 22ImageOffset
            Daten EinzelIcon auslesen
            Dim Dummy#,bytesinres%[x%]
            assign #1,ico$
            OpenRW #1
            Seek #1,offset%[x%]
            BlockRead(#1,dummy#,0,bytesinres%[x%])
            close #1
            ~UpdateResource(hUpdate&,~RT_ICON,x%+LastIcon&+1,~GetSystemDefaultLangID(),dummy#,bytesinres%[x%])
            Dispose FileHeader#

        endproc

        Proc DrawMultiIcon

            Parameters Ico$,anzahl%
            Declare FileHeader#,xxxx%,x%
            Dim Fileheader#,(20*anzahl%)
            xxxx% = 0
            word fileheader#,0 = 0
            word fileheader#,2 = 1Icon
            word fileheader#,4 = anzahl%How many Images

            Whilenot x% = anzahl%

                byte fileheader#,6+xxxx% = Breite%[x%]width
                byte fileheader#,7+xxxx% = Hoehe%[x%]height
                byte fileheader#,8+xxxx% = farben%[x%]colorcount
                byte fileheader#,9+xxxx% = reserved%[x%]reserved
                word fileheader#,10+xxxx% = colplanes%[x%]colorplanes
                word fileheader#,12+xxxx% = bitspixel%[x%]bitcount
                long fileheader#,14+xxxx% = bytesinres%[x%]BytesInRes
                word fileheader#,18+xxxx% = x%+Lasticon&+1ID
                xxxx% = xxxx% + 14
                Inc x%

            endwhile

            ~UpdateResource(hUpdate&,~RT_GROUP_ICON,Addr(ico$),~GetSystemDefaultLangID(),FileHeader#,sizeOf(Fileheader#))
            Dispose FileHeader#

        EndProc

        ResFile$ = Upper$(Resfile$)
        Declare d&,l&
        d& = UseDll(Filename$)
        l& = Create(SortedListBox,%hwnd,,0,0,0,0)
        GetLastIconNum(d&)
        Var LastIcon& = val(GetString$(l&,GetCount(l&)-1))
        Freedll d&
        Destroywindow(l&)
        Declare anzahl%
        anzahl% = GetIconZahl(ResFile$)  Anzahl der enthaltenen Icons holen
        Arrays deklarieren
        Declare breite%[anzahl%]
        Declare hoehe%[anzahl%]
        Declare farben%[anzahl%]
        Declare colplanes%[anzahl%]
        Declare reserved%[anzahl%]
        Declare bitspixel%[anzahl%]
        Declare bytesinres%[anzahl%]
        Declare offset%[anzahl%]
        Declare Ico&[anzahl%]
        Werte der einezelnen Icons in die Arrays bringen
        GetIconDimensions(ResFile$)
        Declare xxx%

        Whilenot xxx% = anzahl%

            DrawSingleIcon(resfile$,xxx%)
            inc xxx%

        wend

        DrawMultiIcon(resfile$,anzahl%)

    EndProc

    ############

    Proc DelICON

        Parameters FileName$,ResFile$
        Declare Mod&
        Declare hFind&,hGlobal&,hLock&,Icons&,X%,xxxx%,Index$
        ResFile$ = Upper$(Resfile$)
        Mod& = UseDll(Filename$)
        hFind& = ~FindResource(Mod&,Addr(Resfile$),~RT_GROUP_ICON)

        If hFind&

            hGlobal& = ~LoadResource(Mod&,hFind&)
            hLock& = ~LockResource(hGlobal&)
            Icons& = word(hLock&,4)
            Declare IconIndex&[icons&]

            Whilenot x% = Icons&

                IconIndex&[x%] = Word(hLock&,18+xxxx%)
                xxxx% = xxxx% + 14
                Inc x%

            endwhile

            X% = 0

            Whilenot x% = Icons&

                ~UpdateResource(hUpdate&,~RT_ICON,IconIndex&[x%],~GetSystemDefaultLangID(),0,0)
                Inc x%

            Endwhile

            ~UpdateResource(hUpdate&,~RT_GROUP_ICON,ADDR(ResFile$),~GetSystemDefaultLangID(),0,0)

        Endif

        FreeDll Mod&

    EndProc

    BEISPIEL
    cls
    ClearAll(Leer32.dll)
    Var hUpdate& = ~BeginUpdateResource(Leer32.dll,0)
    AddIcon(Leer32.dll,Ram.ico)Icons
    AddBmp(Leer32.dll,Test.bmp)Bitmaps
    AddCursor(Leer32.dll,3dgmove.cur)Cursor
    AddUser(Leer32.dll,Test.bmp,Mein Bild)Userresource, Name frei wählbar
    ~EndUpdateResource(hUpdate&,0)