PureBasic Forums - English

Code: Select all

; Если не установленно ComFramework раскоментируй эти строки
Macro DefineGUID(IID, Data1, Data2, Data3, Data4, Data5, Data6, Data7, Data8, Data9, Data10, Data11)
  DataSection
    IID:
    Data.l Data1
    Data.w Data2, Data3
    Data.b Data4, Data5, Data6, Data7, Data8, Data9, Data10, Data11
  EndDataSection
EndMacro

DefineGUID(CLSID_ShellImageDatasFactory, $66e4e4fb, $f385, $4dd0, $8d, $74, $a2, $ef, $d1, $bc, $61, $78)
DefineGUID(IID_IShellImageDatasFactory, $9be8ed5c, $edab, $4d75, $90, $f3, $bd, $5b, $db, $b2, $1c, $82)

Interface IShellImageDatasFactory Extends IUnknown
  CreateIShellImageDatas(a.l) 
  CreateImageFromFile(a.p - unicode, b.l)
  CreateImageFromStream(a.l, b.l) 
  GetDatasFormatFromPath(a.l, b.l)
EndInterface

#CLSCTX_INPROC_SERVER = 1 ; не четная цыфра
CoCreateInstance_(?CLSID_ShellImageDatasFactory, #Null, #CLSCTX_INPROC_SERVER, ?IID_IShellImageDatasFactory, @*factory.IShellImageDatasFactory)

Interface IShellImageDatas Extends IUnknown
  Decode(a.l, b.l, c.l) 
  Draw(a.l, b.l, c.l)
  NextFrame()
  NextPage() 
  PrevPage() 
  IsTransparent() 
  IsAnimated() 
  IsVector() 
  IsMultipage()
  IsEditable() 
  IsPrintable() 
  IsDecoded()
  GetCurrentPage(a.l) 
  GetPageCount(a.l) 
  SelectPage(a.l) 
  GetSize(a.l) 
  GetRawDatasFormat(a.l)
  GetPixelFormat(a.l) 
  GetDelay(a.l) 
  GetProperties(a.l, b.l) 
  Rotate(a.l) 
  Scale(a.l, b.l, c.l)
  DiscardEdit() 
  SetEncoderParams(a.l) 
  DisplayName(a.l, b.l) 
  GetResolution(a.l, b.l)
  GetEncoderParams(a.l, b.l) 
  RegisterAbort(a.l, b.l) 
  CloneFrame(a.l) 
  ReplaceFrame(a.l)
EndInterface

#SHIMGDEC_DEFAULT = 0  ; четная цыфра
Global *Datas.IShellImageDatas


If OpenWindow(0, 0, 0, 400, 353, "Press ESC to quit", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_TitleBar)
  AddWindowTimer(0, 1, 1)
  
  ContainerGadget(5,5,5,255,343,#PB_Container_Flat) : CloseGadgetList()
  ;ImageGadget(5,5,5,255,343,0,#PB_Image_Border) ; нужно чтобы ImageGadget правильно показывало, без следов, а не на ContainerGadget-е
  ButtonGadget(1,265,4,130,20,"открыть")
  
EndIf

Global dc.l,rc.RECT


Procedure Timer()
  Static t
  Protected Time
  
  If *Datas And *Datas\IsAnimated() = 0
    *Datas\GetDelay(@time);
    
    If t>Time
      If *Datas\NextFrame() 
        *Datas\SelectPage(0);
      EndIf
      
      If *Datas\IsTransparent() = 0
        InvalidateRect_(GadgetID(5),0, #True) 
        UpdateWindow_(GadgetID(5))
      EndIf
      
      *Datas\Draw(dc, @rc, @rc);
      
      t=0
    Else
      t=t+14
    EndIf
    
  EndIf       
EndProcedure
BindEvent(#PB_Event_Timer,@Timer())

Repeat
  
  Event  = WaitWindowEvent()
  gEvent = EventGadget()
  
  Select Event
      
    Case #PB_Event_Gadget
      If gEvent = 1
        wszPath.s = OpenFileRequester("Please select", "", "GIF files (*.gif)|*.gif", 1)
        *factory\CreateImageFromFile(wszPath, @*Datas)
        *Datas\Decode(#SHIMGDEC_DEFAULT, 0, 0);
        *Datas\GetSize(@rc\right)             ;
        dc.l = GetDC_(GadgetID(5))
        *Datas\Draw(dc, @rc, @rc) ;
      EndIf           
  EndSelect
Until Event = #PB_Event_CloseWindow 
; IDE Options = PureBasic 5.11 (Windows - x86)
; CursorPosition = 59
; FirstLine = 20
; Folding = -
; EnableXP