XProfan

'Multipage Tif's Montrer:
'Andreas Miethe * février 2004
'##############################
 $H windows.ph
 $H Functions_GDIPLUS.ph
 $H GDIP_Imageging.ph
 $I GDIP_Helper.inc
Déclarer gdiplusToken&,ImageObject&,GraphicObject&,Count&,X&,XX&,YY&,SIO&
Déclarer ImageWidth&,ImageHeight&,Dossier$
Déclarer GUID#
Fenêtre 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

    Paramètres x&
    declare a$
    MCLS 800, 600 , ~GetSysColor(~COLOR_3DFACE)
    MCopyBmp 0,0 - 800,600 > 0,30; 0
    ImageObject& = gdipLoadImage(Dossier$)'Bild magasin
    ~GdipCreateFromHWND(%hwnd,ADDR(GraphicObject&))
    Faible 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

    Paramètres file$
    Déclarer ImageID1&, ImageID2&
    'BEISPIEL *******************************************************
    ' // Get le CLSID of le TIFF encoder.
    '  EncoderClsid = GUID$(GdiPlusGetEncoderClsid("image/tiff"))
    ' // Créer three image objects.
    '   strFileName = UCODE$("Shapes.bmp")
    '   hStatus = GdipLoadImageFromFile(STRPTR(strFileName), pMulti)
    '   strFileName = UCODE$("Iron.jpg")
    '   hStatus = GdipLoadImageFromFile(STRPTR(strFileName), pPage2)
    ' // Save le first le chasseur (frame).
    '   parameterValue = %EncoderValueMultiFrame
    '   strFileName = UCODE$("Multiframe.tif")
    '   hStatus = GdipSaveImageToFile(pMulti, STRPTR(strFileName), EncoderClsid, eps)
    '   IF hStatus = %StatusOk THEN PRINT "Page 1 saved successfully"
    ' // Save le second le chasseur (frame).
    '   parameterValue = %EncoderValueFrameDimensionPage
    '   hStatus = GdipSaveAddImage(pMulti, pPage2, eps)
    '   IF hStatus = %StatusOk THEN PRINT "Page 2 saved successfully"
    ' // Fermer le 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)

tandis que 0=0

    Waitinput

    si 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)

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

        Si len($ Trim(fichier$))>0

            ImageObject 0
            x%=0

        EndIf

    EndIf

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

Wend

DeleteObject bmp&
ExitGDIPlus(gdiplusToken&)
Fin