XProfan

'############################################
'Bilder avec OLE magasin et Montrer
'############################################
'Andreas Miethe * juillet 2002
'############################################
'ab Profan 7.X
'############################################
'getestet avec Win98, WinME et WinXP
'mais devrait aussi déjà avec Win95
'marcher.
'############################################
'unterstützte Formate :
'BMP,RLE,DIB,JPG,JPE,JPEG,GIF,EMF,WMF,CUR,ICO
'aucun animierten Gif's
'############################################
'Definitionen
DEF CreateStreamOnHGlobal(3) ! "OLE32","CreateStreamOnHGlobal"
DEF OleLoadPicture(5) ! "OLEPRO32","OleLoadPicture"
DEF OleInitialize(1) ! "OLE32","OleInitialize"
DEF OleUnInitialize(0) ! "OLE32","OleUninitialize"
DEF GlobalAlloc(2)  ! "KERNEL32","GlobalAlloc"
DEF GlobalLock(1)  ! "KERNEL32","GlobalLock"
DEF GlobalUnlock(1)  ! "KERNEL32","GlobalUnlock"
DEF GlobalFree(1)  ! "KERNEL32","GlobalFree"
DEF CopyMemory(3)  ! "KERNEL32","RtlMoveMemory"
DEF SelectObject(2) ! "gdi32","SelectObject"
DEF GetDeviceCaps(2) ! "gdi32","GetDeviceCaps"
DEF GetDC(1) ! "User32","GetDC"
DEF ReleaseDC(2) ! "User32","ReleaseDC"
DEF FindResource(3) ! "KERNEL32","FindResourceA"
DEF LoadResource(2) ! "KERNEL32","LoadResource"
DEF SizeOfResource(2) ! "KERNEL32","SizeofResource"
'Konstanten
DEF &Picture_Release     8
DEF &Picture_GetHandle  12
DEF &Picture_GetType    20
DEF &Picture_Get_Width  24
DEF &Picture_Get_Height 28
DEF &Picture_Render     32
DEF &Picture_Select     44
'Globale Variablen
DECLARE OLE32&,OLEPRO32&
DECLARE IID_IPicture#
DECLARE PData#
DECLARE HMEM&
'Prozeduren

Proc Ole_Init'Ole-Schnittstelle initialisieren et Variablen fuellen

    OLE32& = UseDll("OLE32")
    OLEPRO32& = UseDll("OLEPRO32")
    OleInitialize(0)
    Faible IID_IPicture#,16
    Long IID_IPicture#,0 = $7BF80980
    Word IID_IPicture#,4 = $BF32
    Word IID_IPicture#,6 = $101A
    Byte IID_IPicture#,8 = $8B
    Byte IID_IPicture#,9 = $BB
    Byte IID_IPicture#,10 = $00
    Byte IID_IPicture#,11 = $AA
    Byte IID_IPicture#,12 = $00
    Byte IID_IPicture#,13 = $30
    Byte IID_IPicture#,14 = $0C
    Byte IID_IPicture#,15 = $AB

ENDPROC

Proc Ole_Free'Ole-Schnittstelle Speicherbereiche freigeben

    GlobalFree(Hmem&)
    OleUnInitialize()
    FreeDll OLE32&
    FreeDll OLEPRO32&
    DISPOSE IID_IPicture#

ENDPROC

Proc Ole_LoadImage'Bild avec OLE magasin

    Déclarer MemPointer&,PStream&,PictureObject&,PSize&
    Paramètres Picture$
    '------------------------
    Filemode 0
    PSIZE& = Filesize(Picture$)
    Faible PData#,PSIZE&
    Assign #1,Picture$
    OpenRW #1
    BlockRead(#1,PData#,0,PSIZE&)'données dans Bereichsvariable einlesen
    CloseRW #1
    '------------------------
    GlobalFree(Hmem&)
    HMem& = GlobalAlloc($022,PSize&)'grenier reservieren
    Mempointer& = GlobalLock(Hmem&)'Pointer sur grenier
    CopyMemory(MemPointer&,PData#,PSize&)'Bereichsvariable dans grenier schieben
    DISPOSE PData#'Bereichsvariable freigeben
    GlobalUnlock(HMem&)'grenier zum Gebrauch freigeben
    CreateStreamOnHGlobal(Hmem&,1,addr(PStream&))'Stream-Pointer erstellen
    OleLoadPicture(PStream&,PSIZE&,0,IID_IPicture#,ADDR(PictureObject&))'Pointer pour Pictureobject
    '------------------------
    Cas PictureObject& > 0 : Retour PictureObject&
    Cas PictureObject& = 0 : Retour 0

ENDPROC

Proc Ole_LoadResImage'Bild aus Modul avec OLE magasin

    Déclarer MemPointer&,PStream&,PictureObject&,PSize&
    Déclarer Reshandle&,GlobalMem&
    Paramètres Modul&,Resname$,Restype$
    GlobalFree(Hmem&)
    '------------------------
    'Resource magasin
    Reshandle& = FindResource(Modul&,addr(Resname$),addr(Restype$))
    Globalmem& = LoadResource(Modul&,ResHandle&)
    PSize& = SizeOfResource(Modul&,Reshandle&)
    '------------------------
    HMem& = GlobalAlloc($022,PSize&)'grenier reservieren
    Mempointer& = GlobalLock(Hmem&)'Pointer sur grenier
    CopyMemory(MemPointer&,Globalmem&,PSize&)'Bereichsvariable dans grenier schieben
    GlobalUnlock(HMem&)'grenier zum Gebrauch freigeben
    CreateStreamOnHGlobal(Hmem&,1,addr(PStream&))'Stream-Pointer erstellen
    OleLoadPicture(PStream&,PSIZE&,0,IID_IPicture#,ADDR(PictureObject&))'Pointer pour Pictureobject
    '------------------------
    Cas PictureObject& > 0 : Retour PictureObject&
    Cas PictureObject& = 0 : Retour 0

ENDPROC

Proc Ole_RenderImage'Bild sur DC rendern

    Paramètres DC&,wnd&,PictureObject&,xx&,yy&,ww&,hh&,Center&
    Déclarer Command&,Aspect!,xpixels&,ypixels&,ImageWidth&,ImageHeight&,w&,h&,ImageX&,ImageY&
    Command& = Long(PictureObject&,0)
    'RENDERN vorbereiten
    'Breite et Hoehe auslesen
    Call(@Long(Command&,&Picture_Get_Width),PictureObject&,addr(w&))
    Call(@Long(Command&,&Picture_Get_Height),PictureObject&,addr(h&))
    'Imagebreite et Hoehe berechnen
    xpixels& = GetDeviceCaps(DC&, 88)
    ypixels& = GetDeviceCaps(DC&, 90)
    ImageWidth&  = (w&*xpixels&)/2540
    ImageHeight& = (h&*ypixels&)/2540
    'Imagebreite et Hoehe à la fenêtre anpassen si trop gross
    Aspect! = Imagewidth&/ImageHeight&

    Si OU(Imagewidth& > ww&,Imageheight& > hh&)

        ImageHeight& = hh&
        ImageWidth& =  ImageHeight&*aspect!

        Si ImageWidth& > ww&

            ImageWidth& = ww&
            ImageHeight& = ImageWidth&/aspect!

        EndIf

    Endif

    'et Einfuegepunkte (Zentrierung) berechnen

    Si Center& = 1

        ImageX& = width(%hwnd)/2 - Imagewidth&/2
        ImageY& = height(%hwnd)/2 - Imageheight&/2

    D'autre

        ImageX& = xx&
        ImageY& = yy&

    Endif

    'sur DC Rendern
    Call(@Long(Command&,&Picture_Render),PictureObject&,DC&,Imagex&,Imagey&,Imagewidth&,ImageHeight&,0,h&,w&,(h&*-1),0)

ENDPROC

Proc Ole_GetType'Bildtyp ermitteln

    Paramètres PictureObject&
    Déclarer Command&,PicFormat&
    Command& = Long(PictureObject&,0)
    Call(@Long(Command&,&Picture_GetType),PictureObject&,addr(PicFormat&))
    Retour PicFormat&

ENDPROC

Proc Ole_GetHandle'BildHandle ermitteln

    Paramètres PictureObject&
    Déclarer Command&,PicHandle&
    Command& = Long(PictureObject&,0)
    Call(@Long(Command&,&Picture_GetHandle),PictureObject&,addr(PicHandle&))
    Retour PicHandle&

ENDPROC

Proc Ole_FreeImage'Bild freigeben

    Paramètres PictureObject&
    Déclarer Command&
    Command& = Long(PictureObject&,0)
    Call(@Long(Command&,&Picture_Release),PictureObject&)

ENDPROC

'############################################
'Bilder avec OLE magasin et Montrer
'############################################
'Andreas Miethe * juillet 2002
'############################################
'ab Profan 7.X
'############################################
'getestet avec Win98, WinME et WinXP
'le son Microsoft avec WindowNT ab Version 4.0
'et Windows95 lauffaehig
'############################################
'unterstützte Formate :
'BMP,RLE,DIB,JPG,JPE,JPEG,GIF,EMF,WMF,CUR,ICO
'aucun animierten Gif's
'############################################
'
'Anwendungsbeispiel
'
'############################################
'
'Prozeduren qui Include
'1. Ole_Init -> initialisiert qui Ole_Schnittstelle
'------------------------------------------------------------------------------------
'2. Ole_LoadImage -> Laedt cela Bild et gibt une aiguille sur cela Bildobject zurueck
'   paramètre Filename$
'------------------------------------------------------------------------------------
'3. Ole_RenderImage -> Rendert cela Bild sur un DC
'   paramètre   : DC&
'               : FensterHandle des DC
'               : aiguille sur Bildobject
'               : Einfuegepunkt X
'               : Einfuegepunkt Y
'               : Breite
'               : Hoehe
'               : Flag pour Zentrierung
'                       1 = Zentrieren X,Y,W et H koenne zéro son
'                       0 = ne...aucune Zentrieren X,Y,W et H mussen angegeben volonté
'------------------------------------------------------------------------------------
'4. Ole_GetType -> ermittelt den Bildtypen
'   paramètre aiguille sur Bildobject
'   Rueckgabe   : 1 pour BITAP
'               : 2 pour WMF
'               : 3 pour ICON ou bien CURSOR
'               : 2 pour EMF
'------------------------------------------------------------------------------------
'5. Ole_FreeImage -> gibt cela Bildobject libre
'   paramètre aiguille sur Bildobject
'------------------------------------------------------------------------------------
'6. Ole_Free -> gibt qui Ole_Schnittstelle et Speicherbereich libre
'------------------------------------------------------------------------------------
'7. Ole_LoadResImage -> Laedt cela Bild aus einem Modul et
'                       gibt une aiguille sur cela Bildobject zurueck
'   paramètre   : 1 = ModulHandle
'               : 2 = Resource-nom
'               : 3 = Resource-Typ
'------------------------------------------------------------------------------------
 $I profalt.inc'erspart certains Reparaturen - pour schnelle Testen...
 $I Ole_LoadImage.inc
DECLARE PictureObject&,Picture$,Type&
window 0,0-%maxx,%Maxy
cls rgb(192,192,192)
Ole_Init()

Si Picture$ = »

    Picture$ = LoadFile$("ÖFFNE","alle unterstützten Formate|*.dib;*.bmp;*.rle;*.jpe;*.jpeg;*.jpg;*.gif;*.ico;*.cur;*.emf;*.wmf|\
    Bitmap (bmp,rle,dib)|*.bmp;*.rle;*.dib|Jpeg (jpg,jpe,jpeg)|*.jpg;*.jpe;*.jpeg|Gif (gif)|*.gif|\
    Enhanced Metafile (emf)|*.emf|Metafile (wmf)|*.wmf|Icônes (Ico)|*.ico|Cursor (cur)|*.cur")

endif

Si Picture$ <> »

    UseCursor 2
    'Ole_LoadResImage 0,"#100","JPEG"
    PictureObject& = Ole_LoadImage(Picture$)

    Si PictureObject& > 0

        Ole_RenderImage(%hdc2,%hwnd,PictureObject&,0,0,width(%hwnd),height(%hwnd),1)
        Repaint'Update
        Type& = Ole_GetType(PictureObject&)
        Cas Type& = 1: Settext %hwnd,"Bitmap"
        Cas Type& = 2: Settext %hwnd,"WMF"
        Cas Type& = 3: Settext %hwnd,"Icon / Cursor"
        Cas Type& = 4: Settext %hwnd,"EMF"
        UseCursor 0
        Ole_FreeImage(PictureObject&)

    d'autre

        MessageBox("Falsches Grafikformat ! ou bien Dossier beschädigt","Meldung",0)

    Endif

endif

waitinput
Ole_Free()
Fin