China DOS Union

How to convert a BMP to a 32-color animated GIF using VBS?

hmm, going to read and write binary files~~ I wonder if there are ready-made COMs that can be called?

I googled online and it's said that LZW algorithm is needed, but I haven't tried it.

However, there are quite a lot of articles about image format conversion, and they are all relatively complicated

[ Last edited by electronixtar on 2006-8-18 at 17:56 ]

here is somebody's reply on news://microsoft.public.scripting.wsh

DO NOT ask me to explain everything in the quote, I myself do not fully understand the content yet.

I believe there is. It's called WIA Automation Layer (i.e. Windows Image
Acquisition Automation Layer 2.0). It's basically a DLL that needs
registering, and then you get all sorts of objects and methods available
from WSH. It's free from Microsoft, but I believe it needs a minimum of
Windows XP SP1 and also dotNET v1.1.


N.B. Don't get WIA (Windows Imaging Architecture) confused with WIA (Windows
Image Acquisition) nor is it to be confused with WIA Scripting Model. These
three things are related (I think) but all very different topics.


N.B. WIA Automation Layer supersedes the older WIA Scripting Model.


Anyway, here's an overview of WIA Automation Layer
http://windowssdk.msdn.microsoft.com/en-us/library/ms630827.aspx


Download here:
http://www.microsoft.com/downloads/details.aspx?FamilyID=a332a77a-01b...
i.e. "Windows® Image Acquisition Automation Library v2.0 Tool: Image
acquisition and manipulation component for VB and scripting"


Unzip the file, read the docs, and then start to play.


I can't supply an example of accessing a WebCam, although I'm sure it is
possible - anyway, attached below is my example of using WIA Automation
Layer v2.0. Search the code for:
CreateObject( "WIA.
...and you'll also need to search the Web for other examples.


In my example code I use WIA Automation Layer to convert JPG to BMP and to
re-size the image. Watch out for word/line wrap if you cut and paste.


Good luck.


Regards,
Dave.


Option Explicit
Const cs_fac = "%rotate-wallpaper, "
Const cs_script_version = "v0.02"
Const ci_temporary_folder = 2
Const cb_debug = True


Const cl_image_wait = 3


Dim go_fso, go_wsh, go_app, go_wmi
Dim gs_script_spec, gs_script_path, gs_script_name, gs_script_title,
gs_script_engine, gs_script_fac, gd_script_start, gd_script_end
Dim gs_temp_path, gs_temp_file, gs_temp_spec
Dim gb_echo, gb_popup


Dim gs_pics, gl_screen_height, gl_screen_width
Dim gl_tot_folders, gl_tot_files, gl_tot_images, gl_tot_used


Set go_fso = CreateObject( "Scripting.FileSystemObject" )
Set go_wsh = CreateObject( "WScript.Shell" )
Set go_app = CreateObject( "Shell.Application" )
Set go_wmi = GetObject( "WinMgmts://./root/cimv2" )


Call s_setup()


gs_pics = go_app.NameSpace( 39 ).Self.Path


If cb_debug Then Call s_log( cs_fac & "My Pictures: " & gs_pics )


Call s_scan_tree( gs_pics )


If cb_debug Then
Call s_log( "" )
Call s_log( cs_fac & "Folders: " & gl_tot_folders )
Call s_log( cs_fac & "Files: " & gl_tot_files )
Call s_log( cs_fac & "Images: " & gl_tot_images )
Call s_log( cs_fac & "Used: " & gl_tot_used )
End If


WScript.Quit


Sub s_setup()
Const cs_fac = "%s_setup, "
Dim lo_displays, lo_display


Set lo_displays = go_wmi.ExecQuery( "Select * from
Win32_DisplayConfiguration", , 48 )


For Each lo_display In lo_displays
gl_screen_width = lo_display.PelsWidth
gl_screen_height = lo_display.PelsHeight
Next


If cb_debug Then
Call s_log( "" )
Call s_log( cs_fac & "Screen height: " & gl_screen_height )
Call s_log( cs_fac & "Screen width: " & gl_screen_width )
End If


Call s_set_wallpaper_style( "centered" )


gs_script_spec = Wscript.ScriptFullName
gs_script_path = go_fso.GetParentFolderName( gs_script_spec )
gs_script_name = go_fso.GetBaseName( gs_script_spec )
gs_script_title = gs_script_name & " (" & cs_script_version & ")"
gs_script_fac = "%" & gs_script_name & ", "
gs_script_engine = LCase( go_fso.GetBaseName( Wscript.FullName ) )


Select Case gs_script_engine
Case "cscript"
gb_echo = True
gb_popup = False
Case "wscript"
gb_echo = False
gb_popup = True
End Select


gs_temp_path = go_fso.GetSpecialFolder( ci_temporary_folder )
gs_temp_file = go_fso.GetTempName
gs_temp_spec = gs_temp_path & "\" & gs_script_name & ".bmp"
End Sub


Sub s_scan_tree( ps_folder )
Const cs_fac = "%s_scan_tree, "
Dim lo_folder, lb_exists


Call s_log( "" )
Call s_log( cs_fac & "Scanning folder tree `" & ps_folder & "`..." )


On Error Resume Next
Set lo_folder = go_fso.GetFolder( ps_folder )
Select Case Err.Number
Case 0
lb_exists = True
Case 76
lb_exists = False
Case Else
Call s_error( cs_fac & "Failed to attach to folder object `" & ps_folder
& "`..." )
End Select
On Error Goto 0


If lb_exists Then
Call s_scan_folder( lo_folder )
Else
Call s_log( cs_fac & "Folder `" & ps_folder & "` does not exist..." )
End If


Set lo_folder = Nothing
End Sub


Sub s_scan_folder( po_folder )
Const cs_fac = "%s_scan_folder, "
Dim lo_subfolders, lo_subfolder
Dim lo_files, lo_file


Set lo_subfolders = po_folder.SubFolders
Set lo_files = po_folder.Files


gl_tot_folders = gl_tot_folders + 1


For Each lo_file In lo_files
Call s_scan_file( lo_file )
Next


For Each lo_subfolder In lo_subfolders
Call s_scan_folder( lo_subfolder )
Next


Set lo_subfolder = Nothing
Set lo_subfolders = Nothing
Set lo_file = Nothing
Set lo_files = Nothing
End Sub


Sub s_scan_file( po_file )
Const cs_fac = "%s_scan_file, "
Dim ls_file_base, ls_file_extn, lb_valid, lo_cim
Dim ls_dimensions, ls_sizes, ll_height, ll_width, lb_wanted


gl_tot_files = gl_tot_files + 1


ls_file_base = LCase( go_fso.GetBaseName( po_file.Path ) )
ls_file_extn = LCase( go_fso.GetExtensionName( po_file.Path ) )


Select Case ls_file_extn
Case "jpg", "bmp"
Case Else
Exit Sub
End Select


gl_tot_images = gl_tot_images + 1


ls_dimensions = fs_property( po_file.Path, "dimensions" )


ls_sizes = Split( ls_dimensions, " ", 3 )
ll_height = CLng( ls_sizes( 0 ) )
ll_width = CLng( ls_sizes( 2 ) )


lb_wanted = True


If lb_wanted Then If ll_height < ( gl_screen_height * 0.50 ) Then
lb_wanted = False
If lb_wanted Then If ll_width < ( gl_screen_height * 0.50 ) Then
lb_wanted = False


If lb_wanted Then If Instr( 1, LCase( po_file.Path ), "wedding" ) > 0 Then
lb_wanted = False


If Not lb_wanted Then
If cb_debug Then Call s_log( cs_fac & "Ignoring file `" & po_file.Path &
"`..." )
Exit Sub
End If


If cb_debug Then
Call s_log( cs_fac & "File: " & po_file.Path )
Call s_log( cs_fac & " Size: " & po_file.Size )
Call s_log( cs_fac & " Dimensions: " & fs_property( po_file.Path,
"dimensions" ) )
End If


gl_tot_used = gl_tot_used + 1


Dim lo_image_file, lo_image_process


Set lo_image_file = CreateObject( "WIA.ImageFile" )
Set lo_image_process = CreateObject( "WIA.ImageProcess" )


Const wiaFormatBMP = "{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}"
Const wiaFormatPNG = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
Const wiaFormatGIF = "{B96B3CB0-0728-11D3-9D7B-0000F81EF32E}"
Const wiaFormatJPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
Const wiaFormatTIFF = "{B96B3CB1-0728-11D3-9D7B-0000F81EF32E}"


lo_image_file.LoadFile po_file.Path


lo_image_process.Filters.Add lo_image_process.FilterInfos(
"Scale" ).FilterID
lo_image_process.Filters(1).Properties( "MaximumHeight" ) =
gl_screen_height
lo_image_process.Filters(1).Properties( "MaximumWidth" ) =
gl_screen_width
lo_image_process.Filters(1).Properties( "PreserveAspectRatio" ) = True


lo_image_process.Filters.Add lo_image_process.FilterInfos(
"Convert" ).FilterID
lo_image_process.Filters(2).Properties( "FormatID" ).Value = wiaFormatBMP


Set lo_image_file = lo_image_process.Apply( lo_image_file )


If go_fso.FileExists( gs_temp_spec ) Then go_fso.DeleteFile gs_temp_spec
lo_image_file.SaveFile gs_temp_spec


Call s_set_wallpaper_image( gs_temp_spec )


WScript.Sleep cl_image_wait * 1000
End Sub


Sub s_show_info( ps_file )
Const cs_fac = "%s_show_info, "
Const cl_max = 47
Dim lo_fso, lo_app
Dim lo_fso_file, ls_fso_parent, ls_fso_name
Dim lo_app_parent, lo_app_name
Dim ll_property, ls_property_name, ls_property_value


Set lo_fso = CreateObject( "Scripting.FileSystemObject" )
Set lo_app = CreateObject( "Shell.Application" )


Set lo_fso_file = lo_fso.GetFile( ps_file )


ls_fso_parent = lo_fso_file.ParentFolder
ls_fso_name = lo_fso_file.Name


Set lo_app_parent = lo_app.NameSpace( ls_fso_parent )
Set lo_app_name = lo_app_parent.ParseName( ls_fso_name )


For ll_property = 0 To cl_max
ls_property_name = lo_app_parent.GetDetailsOf( lo_app_parent,
ll_property )
ls_property_value = lo_app_parent.GetDetailsOf( lo_app_name,
ll_property )
Call s_log( ll_property & vbTab & Left( ls_property_name & Space(20),
20 ) & " " & ls_property_value )
Next
End Sub


Function fs_property( ps_file, ps_property_name )
Const cs_fac = "%fs_property, "
Const cl_max = 47
Dim lo_fso, lo_app
Dim lo_fso_file, ls_fso_parent, ls_fso_name
Dim lo_app_parent, lo_app_name
Dim ll_property, ls_property_name, ls_property_value


Set lo_fso = CreateObject( "Scripting.FileSystemObject" )
Set lo_app = CreateObject( "Shell.Application" )


Set lo_fso_file = lo_fso.GetFile( ps_file )


ls_fso_parent = lo_fso_file.ParentFolder
ls_fso_name = lo_fso_file.Name


Set lo_app_parent = lo_app.NameSpace( ls_fso_parent )
Set lo_app_name = lo_app_parent.ParseName( ls_fso_name )


For ll_property = 0 To cl_max
ls_property_name = lo_app_parent.GetDetailsOf( lo_app_parent,
ll_property )
ls_property_value = lo_app_parent.GetDetailsOf( lo_app_name,
ll_property )
If ( LCase( ps_property_name ) = LCase( ls_property_name ) ) Or (
ps_property_name = CStr( ll_property ) ) Then
fs_property = ls_property_value
Exit Function
End If
Next


fs_property = ""
End Function


Sub s_set_wallpaper_style( ps_style )
Const cs_fac = "%s_set_wallpaper_style, "
Select Case LCase( ps_style )
Case "stretched"
go_wsh.RegWrite "HKCU\Control Panel\Desktop\WallpaperStyle", "2"
go_wsh.RegWrite "HKCU\Control Panel\Desktop\TileWallpaper", "0"
Case "centered"

There's no need to use VBS for conversion; third-party software can be used instead. For example: GIFTOOLS 2.0 from Xianzhi Software Studio is okay.

Finally, I've got a research result, hoho～～

http://www.cn-dos.net/forum/viewthread.php?tid=24514

You can also download an ImageMagick package, which contains many powerful command-line tools for image processing.