Xojo Conferences

Platforms to show: All Mac Windows Linux Cross-Platform

/Images/GIF/Gif Write Animated
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
This example is the version from Mon, 22th Nov 2015.
Project "Gif Write Animated.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 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 FileMaker tutorial videos