XProfan

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

Proc ImageObject

    Parameters x&
    declare a$
    MCls 800, 600 , ~GetSysColor(~COLOR_3DFACE)
    MCopyBmp 0,0 - 800,600 > 0,30; 0
    ImageObject& = gdipLoadImage(Datei$)'Bild laden
    ~GdipCreateFromHWND(%hwnd,ADDR(GraphicObject&))
    Dim GUID#,32
    ~GdipImageGetFrameDimensionsList(ImageObject&,GUID#,1)
    ~GdipImageGetFrameCount(ImageObject&,GUID#,Addr(Count&))
    Settext %hwnd,"Bilder im Multiframe : "+str$(Count&)
    ~GdipImageSelectActiveFrame(ImageObject&,GUID#,X&)
    SaveAsPNG(ImageObject&,"Bild "+str$(x&)+".png")
    ~GdipDrawImageI(GraphicObject&,ImageObject&,30,30)
    Dispose GUID#
    ~GdipDisposeImage(ImageObject&)
    ~GdipDeleteGraphics(GraphicObject&)

Endproc

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

Proc NeuMultiImage

    Parameters file$
    Declare ImageID1&, ImageID2&
    'BEISPIEL *******************************************************
    ' // Get the CLSID of the TIFF encoder.
    '  EncoderClsid = GUID$(GdiPlusGetEncoderClsid("image/tiff"))
    ' // Create 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"
    ' // Close 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)

while 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

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

wend

DeleteObject bmp&
ExitGDIPlus(gdiplusToken&)
End