XProfan

'Multipage Tif's Mostrar:
'Andreas Miethe * Februar 2004
'##############################
 $H windows.ph
 $H Functions_GDIPLUS.ph
 $H GDIP_Imageging.ph
 $I GDIP_Helper.inc
Declarar gdiplusToken&,ImageObject&,GraphicObject&,Count&,X&,XX&,YY&,SIO&
Declarar ImageWidth&,ImageHeight&,Expediente$
Declarar GUID#
Ventana 800,600
CLS ~GetSysColor(~COLOR_3DFACE)
gdiplusToken& = InitGDIPlus()'GDIPlus starten
PopUp "Datei"
AppendMenu 109,"Bild öffnen"
AppendMenu 110,"Neues Bild de Bild 1+2"

Proc ImageObject

    Parámetros x&
    declarar a$
    MCLS 800, 600 , ~GetSysColor(~COLOR_3DFACE)
    MCopyBmp 0,0 - 800,600 > 0,30; 0
    ImageObject& = gdipLoadImage(Expediente$)'Bild invitar
    ~GdipCreateFromHWND(%hwnd,ADDR(GraphicObject&))
    Dim GUID#,32
    ~GdipImageGetFrameDimensionsList(ImageObject&,GUID#,1)
    ~GdipImageGetFrameCount(ImageObject&,GUID#,Addr(Count&))
    Settext %hwnd,"Bilder en el Multiframe : "+str$(Count&)
    ~GdipImageSelectActiveFrame(ImageObject&,GUID#,X&)
    SaveAsPNG(ImageObject&,"Bild "+str$(x&)+".png")
    ~GdipDrawImageI(GraphicObject&,ImageObject&,30,30)
    Disponer GUID#
    ~GdipDisposeImage(ImageObject&)
    ~GdipDeleteGraphics(GraphicObject&)

ENDPROC

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Proc NeuMultiImage

    Parámetros file$
    Declarar ImageID1&, ImageID2&
    'BEISPIEL *******************************************************
    ' // Get the CLSID of the TIFF encoder.
    '  EncoderClsid = GUID$(GdiPlusGetEncoderClsid("image/tiff"))
    ' // Crear three image objects.
    '   strFileName = UCODE$("Shapes.bmp")
    '   hStatus = GdipLoadImageFromFile(STRPTR(strFileName), pMulti)
    '   strFileName = UCODE$("Iron.jpg")
    '   hStatus = GdipLoadImageFromFile(STRPTR(strFileName), pPage2)
    ' // Save the first page (frame).
    '   parameterValue = %EncoderValueMultiFrame
    '   strFileName = UCODE$("Multiframe.tif")
    '   hStatus = GdipSaveImageToFile(pMulti, STRPTR(strFileName), EncoderClsid, eps)
    '   IF hStatus = %StatusOk THEN PRINT "Page 1 saved successfully"
    ' // Save the second page (frame).
    '   parameterValue = %EncoderValueFrameDimensionPage
    '   hStatus = GdipSaveAddImage(pMulti, pPage2, eps)
    '   IF hStatus = %StatusOk THEN PRINT "Page 2 saved successfully"
    ' // Cerrar the multiframe file.
    '   parameterValue = %EncoderValueFlush
    '   hStatus = GdipSaveAdd(pMulti, eps)
    '   IF hStatus = %StatusOk THEN PRINT "File closed successfully"
    '****************************************************************
    ImageID1& = gdipLoadImage("Bild 0.png")
    ImageID1& = gdipLoadImage("Bild 1.png")
    ~GdipDisposeImage(ImageID1&)
    ~GdipDisposeImage(ImageID2&)

ENDPROC

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Datei$="MultiFrame.tif"
ImageObject 0
var x%=0
var butz%=CreateButton(%hwnd,"<",30,5,20,20)
var butv%=CreateButton(%hwnd,">",60,5,20,20)

mientras que 0=0

    Waitinput

    if GetFocus(butz%) AND (x%>0)

        dec x%
        ImageObject x%
        SetFocus(%hwnd)

    Elseif GetFocus(butv%) AND (x%<Count&-1)

        inc x%
        ImageObject x%
        SetFocus(%hwnd)

    Elseif MenuItem(109)

        datei$ = @LoadFile$("ÖFFNE","Bild|*.Tif")

        If len(trim$(datei$))>0

            ImageObject 0
            x%=0

        EndIf

    EndIf

    caso MenuItem(110): NeuMultiImage "ZweiMulti.tif"

wend

DeleteObject bmp&
ExitGDIPlus(gdiplusToken&)
End