XProfan

'############################################
'Bilder con OLE invitar y Mostrar
'############################################
'Andreas Miethe * Juli 2002
'############################################
'de Profano 7.X
'############################################
'getestet con Win98, WinME y WinXP
'sino que debe auch ya con Win95
'trabajo.
'############################################
'unterstützte Formate :
'BMP,RLE,DIB,JPG,JPE,JPEG,GIF,EMF,WMF,CUR,ICO
'no 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 Seleccionar objeto(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 Variables
DECLARE OLE32&,OLEPRO32&
DECLARE IID_IPicture#
DECLARE PData#
DECLARE HMEM&
'Prozeduren

Proc Ole_Init'Ole-Schnittstelle inicializar y Variables fuellen

    OLE32& = UseDll("OLE32")
    OLEPRO32& = UseDll("OLEPRO32")
    OleInitialize(0)
    Dim IID_IPicture#,16
    Largo 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 liberación

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

ENDPROC

Proc Ole_LoadImage'Bild con OLE invitar

    Declarar MemPointer&,PStream&,PictureObject&,PSize&
    Parámetros Picture$
    '------------------------
    Filemode 0
    PSIZE& = Filesize(Picture$)
    Dim PData#,PSIZE&
    Asignar #1,Picture$
    OpenRW #1
    BlockRead(#1,PData#,0,PSIZE&)'Daten en Bereichsvariable einlesen
    CloseRW #1
    '------------------------
    GlobalFree(Hmem&)
    HMem& = GlobalAlloc($022,PSize&)'Speicher reservieren
    Mempointer& = GlobalLock(Hmem&)'Pointer en Speicher
    CopyMemory(MemPointer&,PData#,PSize&)'Bereichsvariable en Speicher schieben
    DISPOSE PData#'Bereichsvariable liberación
    GlobalUnlock(HMem&)'Speicher para Gebrauch liberación
    CreateStreamOnHGlobal(Hmem&,1,addr(PStream&))'Stream-Pointer redactar
    OleLoadPicture(PStream&,PSIZE&,0,IID_IPicture#,ADDR(PictureObject&))'Pointer fuer Pictureobject
    '------------------------
    Case PictureObject& > 0 : Volver PictureObject&
    Case PictureObject& = 0 : Volver 0

ENDPROC

Proc Ole_LoadResImage'Bild de Modul con OLE invitar

    Declarar MemPointer&,PStream&,PictureObject&,PSize&
    Declarar Reshandle&,GlobalMem&
    Parámetros Modul&,Resname$,Restype$
    GlobalFree(Hmem&)
    '------------------------
    'Resource invitar
    Reshandle& = FindResource(Modul&,addr(Resname$),addr(Restype$))
    Globalmem& = LoadResource(Modul&,ResHandle&)
    PSize& = SizeOfResource(Modul&,Reshandle&)
    '------------------------
    HMem& = GlobalAlloc($022,PSize&)'Speicher reservieren
    Mempointer& = GlobalLock(Hmem&)'Pointer en Speicher
    CopyMemory(MemPointer&,Globalmem&,PSize&)'Bereichsvariable en Speicher schieben
    GlobalUnlock(HMem&)'Speicher para Gebrauch liberación
    CreateStreamOnHGlobal(Hmem&,1,addr(PStream&))'Stream-Pointer redactar
    OleLoadPicture(PStream&,PSIZE&,0,IID_IPicture#,ADDR(PictureObject&))'Pointer fuer Pictureobject
    '------------------------
    Case PictureObject& > 0 : Volver PictureObject&
    Case PictureObject& = 0 : Volver 0

ENDPROC

Proc Ole_RenderImage'Bild en DC rendern

    Parámetros DC&,wnd&,PictureObject&,xx&,yy&,ww&,hh&,Center&
    Declarar Command&,Aspect!,xpixels&,ypixels&,ImageWidth&,ImageHeight&,w&,h&,ImageX&,ImageY&
    Command& = Largo(PictureObject&,0)
    'RENDERN preparar
    'Breite y Hoehe auslesen
    Call(@Largo(Command&,&Picture_Get_Width),PictureObject&,addr(w&))
    Call(@Largo(Command&,&Picture_Get_Height),PictureObject&,addr(h&))
    'Imagebreite y Hoehe berechnen
    xpixels& = GetDeviceCaps(DC&, 88)
    ypixels& = GetDeviceCaps(DC&, 90)
    ImageWidth&  = (w&*xpixels&)/2540
    ImageHeight& = (h&*ypixels&)/2540
    'Imagebreite y Hoehe a Ventana adaptar si a gross
    Aspect! = Imagewidth&/ImageHeight&

    If O(Imagewidth& > ww&,Imageheight& > hh&)

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

        If ImageWidth& > ww&

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

        EndIf

    Endif

    'y Einfuegepunkte (Zentrierung) berechnen

    If Center& = 1

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

    Más

        ImageX& = xx&
        ImageY& = yy&

    Endif

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

ENDPROC

Proc Ole_GetType'Bildtyp ermitteln

    Parámetros PictureObject&
    Declarar Command&,PicFormat&
    Command& = Largo(PictureObject&,0)
    Call(@Largo(Command&,&Picture_GetType),PictureObject&,addr(PicFormat&))
    Volver PicFormat&

ENDPROC

Proc Ole_GetHandle'BildHandle ermitteln

    Parámetros PictureObject&
    Declarar Command&,PicHandle&
    Command& = Largo(PictureObject&,0)
    Call(@Largo(Command&,&Picture_GetHandle),PictureObject&,addr(PicHandle&))
    Volver PicHandle&

ENDPROC

Proc Ole_FreeImage'Bild liberación

    Parámetros PictureObject&
    Declarar Command&
    Command& = Largo(PictureObject&,0)
    Call(@Largo(Command&,&Picture_Release),PictureObject&)

ENDPROC

'############################################
'Bilder con OLE invitar y Mostrar
'############################################
'Andreas Miethe * Juli 2002
'############################################
'de Profano 7.X
'############################################
'getestet con Win98, WinME y WinXP
'Laut Microsoft con WindowNT de Versión 4.0
'y Windows95 lauffaehig
'############################################
'unterstützte Formate :
'BMP,RLE,DIB,JPG,JPE,JPEG,GIF,EMF,WMF,CUR,ICO
'no animierten Gif's
'############################################
'
'Anwendungsbeispiel
'
'############################################
'
'Prozeduren el Incluir
'1. Ole_Init -> initialisiert el Ole_Schnittstelle
'------------------------------------------------------------------------------------
'2. Ole_LoadImage -> Laedt el Bild y son una Zeiger el Bildobject zurueck
'   Parámetro Filename$
'------------------------------------------------------------------------------------
'3. Ole_RenderImage -> Rendert el Bild en una DC
'   Parámetro   : DC&
'               : FensterHandle des DC
'               : Zeiger en Bildobject
'               : Einfuegepunkt X
'               : Einfuegepunkt Y
'               : Breite
'               : Hoehe
'               : Flag fuer Zentrierung
'                       1 = Zentrieren X,Y,W y H koenne Null ser
'                       0 = kein Zentrieren X,Y,W y H mussen angegeben voluntad
'------------------------------------------------------------------------------------
'4. Ole_GetType -> ermittelt el Bildtypen
'   Parámetro Zeiger en Bildobject
'   Rueckgabe   : 1 fuer BITAP
'               : 2 fuer WMF
'               : 3 fuer ICON Oder CURSOR
'               : 2 fuer EMF
'------------------------------------------------------------------------------------
'5. Ole_FreeImage -> son el Bildobject frei
'   Parámetro Zeiger en Bildobject
'------------------------------------------------------------------------------------
'6. Ole_Free -> son el Ole_Schnittstelle y Speicherbereich frei
'------------------------------------------------------------------------------------
'7. Ole_LoadResImage -> Laedt el Bild de una Modul y
'                       son una Zeiger el Bildobject zurueck
'   Parámetro   : 1 = ModulHandle
'               : 2 = Resource-Name
'               : 3 = Resource-Typ
'------------------------------------------------------------------------------------
 $I profalt.inc'erspart etliche Reparaturen - fürs schnelle Testen...
 $I Ole_LoadImage.inc
DECLARE PictureObject&,Picture$,Type&
window 0,0-%maxx,%Maxy
cls rgb(192,192,192)
Ole_Init()

If Picture$ = ""

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

endif

If Picture$ <> ""

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

    If PictureObject& > 0

        Ole_RenderImage(%hdc2,%hwnd,PictureObject&,0,0,width(%hwnd),height(%hwnd),1)
        Repaint'Actualización
        Type& = Ole_GetType(PictureObject&)
        Case Type& = 1: Settext %hwnd,"Mapa de bits"
        Case Type& = 2: Settext %hwnd,"WMF"
        Case Type& = 3: Settext %hwnd,"Icon / Cursor"
        Case Type& = 4: Settext %hwnd,"EMF"
        UseCursor 0
        Ole_FreeImage(PictureObject&)

    más

        MessageBox("Falsches Grafikformat ! Oder Expediente beschädigt","Meldung",0)

    Endif

endif

waitinput
Ole_Free()
End