XProfan

Français

KHR

allô miteinander,

.

momentan hab je là quelques Programme dans qui fais, qui bitmaps ou bien Icônes aus ner DLL verwenden. cela klappt dank Eurer Aider oui pas mal.

maintenant viens je mais lente dans den Bereich, wohin je qui Inhalte cette DLL pas seulement avec einem Ressourcen-Tool mais aussi de einem XProfan-Programme aus changement ou bien gar anlegen peut sollte.

Hab je là nen einfachen Weg übersehen?

ou bien meint son: Laß qui Finger weg - is trop komplex?

qui peux mir Tips donner?

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

23.02.2009 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Andreas
Miethe

DOKTOR XPROFAN EHRENHALBER

je serait dire weitermachen ! Ist pas so schwer.
Kompilieren Marque Séparation

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

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 citation

Absatzweise Citation Zeilenweise Citation

So simple(?)

23.02.2009 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Andreas
Miethe

DOKTOR XPROFAN EHRENHALBER

So simple(?)

oui bien sûr, mais seulement si on weiss comme allez

23.02.2009 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Gehör je maintenant avec trop!

23.02.2009 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Uwe
''Pascal''
Niemeier

Hi Andreas!

Würde cela aussi avec Interpreter / Runtime (ungelinkt) marcher (sur %HInstance ou bien anstelle qui dll geladen)? Z.B. à Taille qui enthaltenen Icônes trop changement bzw. selbige trop ersetzen?

SeeYou
Pascal

23.02.2009 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

KHR

allô Andreas,

.

sûrement peux je maintenant pas dire, qui je dazugehöre
je kanns zwar anwenden, mais quoi je là ensuite fais sais je pas so droite.

Zum anderen va es chez mir simple encore pas. Doit encore légèrement essayer. si es ensuite pas klappt komm je wieder zum rumheulen her.

.

Den code avec dem auslesen qui Bitmap-Namen hab je oui aussi longtemps pas kapiert. et cela umstricken hat seulement geklappt, weil je pour chacun Code-Changement ausprobiert habe obs encore fonctionne. si oui - un Schritt plus, si pas - 1 Schritt zurück. et chacun Zwischenversion abgespeichert.

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

23.02.2009 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Andreas
Miethe

DOKTOR XPROFAN EHRENHALBER

Uwe Pascal Niemeier

Hi Andreas!

Du musst en supplément Schreibrechte avons. cela heisst qui Dossier darf trop dem la date pas fonctionnement volonté. Es wird aussi ne...aucune Handle mais un Filename$ comme paramètre erwartet.
direct zur Laufzeit ca va alors pas.
un Programme trop écrivons, dass qui Resourcen avant dem Linken ändert ist possible, après peux qui Linker oui per main aufgerufen volonté.
chez Icônes wird es allerding déjà schwieriger ( stichwort MultiIcons ).

j'ai ici encore une alten Code rumliegen. la fois voyons si je es schaffe den pour XProfan trop portieren.

23.02.2009 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Andreas
Miethe

DOKTOR XPROFAN EHRENHALBER

j'ai den alten Code umgefummelt.
Ist peut-être une gute concept den simple comme Include einzubinden.
Hoffe es avons sich aucun faute eingeschlichen.
Kompilieren Marque Séparation

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