Platforms to show: All Mac Windows Linux Cross-Platform
/Images/GIF/Gif Write Animated
Required plugins for this example: MBS Main Plugin, MBS Picture Plugin, MBS Images 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.xojo_binary_project"
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:
The items on this page are in the following plugins: MBS Images Plugin.