Xojo Conferences

Platforms to show: All Mac Windows Linux Cross-Platform

/Images/GIF/Gif Write Animated with endless loop
Required plugins for this example: MBS Images Plugin, MBS Main Plugin, MBS Picture Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Images/GIF/Gif Write Animated with endless loop
This example is the version from Mon, 22th Nov 2015.
Project "Gif Write Animated with endless loop.rbp"
MenuBar Menu
MenuItem UntitledMenu3 = ""
MenuItem UntitledMenu2 = "File"
MenuItem FileQuit = "Quit"
MenuItem UntitledMenu0 = "Edit"
MenuItem EditUndo = "Undo"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "Cut"
MenuItem EditCopy = "Copy"
MenuItem EditPaste = "Paste"
MenuItem EditClear = "Clear"
End MenuBar
Class App Inherits Application
EventHandler Sub Open() MakeImages MainWindow.Show Convert8bit Write End EventHandler
Protected Sub Convert8bit() dim i,c as integer c=UBound(images) for i=0 to c Convert8bit images(i) next End Sub
Protected Sub Convert8bit(pic as picture) dim p as new PaletteCalculatorMBS call p.CreatePicturePalette(pic) dim pal as new GifPaletteMBS pal.Count=256 for i as integer=0 to 255 dim co as color=p.col(i) pal.Red(i)=co.red pal.green(i)=co.green pal.blue(i)=co.blue next Palettes.Append pal data.Append p.TransformBetterDithering(pic) End Sub
Sub MakeImages() dim i as integer dim logo as Picture=LogoMBS(300) for i=30 downto 0 dim p as Picture = New Picture(300,300,32) dim x,y,w,h as integer w=300-i*10 h=300-i*10 // from bottom x=(300-w)/2 y=(300-h)/2+i*2 p.Graphics.ForeColor=&cFFFFFF p.Graphics.FillRect 0,0,p.Width,p.Height p.Graphics.DrawPicture logo,x,y,w,h,0,0,logo.Width,logo.Height images.Append p next End Sub
Protected Sub Write() dim i,c as integer dim g as new GIFMBS dim f as FolderItem // create the memory block for a looping gif dim m as new MemoryBlock(3) m.LittleEndian = true m.Int8Value(0) = 1 // block ID must be 1 m.Int16Value(1) = 0 // number of times to loop, 0 = endless dim d1 as new GifDataMBS d1.DataString = "NETSCAPE2.0" // Netscape made the extensions for repeat dim d2 as new GifDataMBS d2.dataMemory = m dim e as new GifExtensionMBS e.Add d1 e.Add d2 e.Marker=&hFF dim b as new GifBlockMBS b.Intro=&h21 // picture block b.Extension=e g.add b // now add frames c=UBound(images) for i=0 to c Write g,i next // global size and palette dim s as new GifScreenMBS s.Height=300 s.Width=300 s.Palette=Palettes(0) s.PaletteDepth=8 s.HasPalette = true g.Screen=s f=SpecialFolder.Desktop.Child("Gif Write Animated.gif") if f.SaveAsGIFMBS(g) then f.Launch else MsgBox "fail" end if End Sub
Protected Sub Write(g as gifmbs, i as integer) dim d as new GifDataMBS dim m as MemoryBlock // extension to control graphic m=New MemoryBlock(4) m.LittleEndian=true m.Byte(0)=0 // flags, needs to be set to correct value for using transparent color! m.UShort(1)=10 // delay in 100th seconds m.Byte(3)=0 // transparent color index d.DataMemory=m dim e as new GifExtensionMBS e.Marker=&hF9 e.add d dim p as new GifPictureMBS p.Data=data(i) p.Width=300 p.Height=300 p.Palette=Palettes(i) p.Top=0 p.Left=0 p.Interlace=true p.HasPalette = true p.PaletteDepth=8 dim b as new GifBlockMBS b.Intro=&h21 // picture block b.Extension=e g.add b b = new GifBlockMBS b.Intro=&h2C // picture block b.Picture=p g.Add b End Sub
Property Protected data() As memoryBlock
Property images() As picture
Property Protected palettes() As gifpaletteMBS
End Class
Class MainWindow Inherits Window
EventHandler Sub Paint(g As Graphics, areas() As REALbasic.Rect) dim n as integer for y as integer=0 to 3 for x as integer=0 to 7 if UBound(app.images)>=n then g.DrawPicture app.images(n), x*151,y*151,150,150,0,0,300,300 end if n=n+1 next next End EventHandler
End Class
End Project

See also:

Feedback, Comments & Corrections

The items on this page are in the following plugins: MBS Images Plugin.

MBS Xojo Plugins