XProfan

English

KHR

Hello together,

.

momentarily Have I there some programs in the make, The bitmaps or Icons from Ner DLL use. the works dank Eurer Help Yes integrally well.

now come I but slow into area, where I The contents this DLLs not only with a Ressourcen-Tool separate too of a XProfan-Program from Change or quite lay out can ought to.

Have I there NEN einfachen lane overlooking?

or means your: red The fingers lane - is To komplex?

who can me hints give?

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

02/23/09 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Andreas
Miethe

DOKTOR XPROFAN EHRENHALBER

i'd say go on ! isn't so heavy.
Compile Mark Separation

#############################################
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 ex

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 : [...]

02/23/09 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

so simply(?)

02/23/09 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Andreas
Miethe

DOKTOR XPROFAN EHRENHALBER

so simply(?)

Yes clear, but only if one knows as goes

02/23/09 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

hearing I now with To!

02/23/09 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Uwe
''Pascal''
Niemeier

Hi Andreas!

would be the too with Interpreter / Runtime (ungelinkt) klappen (over %HInstance or in lieu of the dll loaded)? Z.B. around the Size the encompassed Icons To Change or. selbige To supplant?

SeeYou
Pascal

02/23/09 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

KHR

Hello Andreas,

.

sure can I now not say, that I dazugehöre
I kanns of course utilize, but I there then make white I do not so right.

to that others go it by me simply not yet. mandatory another slightly try. If it then not works komm I again to that rumheulen since.

.

whom code with the read the Bitmap-names Have I indeed long not understands. and the umstricken has only worked, because I to eachone code-Änderung ausprobiert have obs yet runs. if so - one step moreover, unless - 1 step back. and each Zwischenversion abgespeichert.

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

02/23/09 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Andreas
Miethe

DOKTOR XPROFAN EHRENHALBER

Uwe Pascal Niemeier

Hi Andreas!

You must moreover Schreibrechte having. the means The File must to the Time not carryed out go. it'll too no lever separate one Filename$ as Parameter expects.
directly to Laufzeit goes it means not.
One Program To write, that The Resources to the left changes is possible, thereafter can the Linker Yes by hand called go.
with Icons becomes it allerding already tougher ( cue MultiIcons ).

I have here yet a middle-aged code present. time see whether I it create whom to XProfan to portieren.

02/23/09 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Andreas
Miethe

DOKTOR XPROFAN EHRENHALBER

I have whom middle-aged code umgefummelt.
is Perhaps a good idea whom simply as Include einzubinden.
hope it having itself no Error eingeschlichen.
Compile Mark Separation

 $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 spare wählbar
    ~EndUpdateResource(hUpdate&,0)