中国DOS联盟论坛

中国DOS联盟

-- 联合DOS 推动DOS 发展DOS --

联盟域名:www.cn-dos.net  论坛域名:www.cn-dos.net/forum
DOS,代表着自由开放与发展,我们努力起来,学习FreeDOS和Linux的自由开放与GNU精神,共同创造和发展美好的自由与GNU GPL世界吧!

游客:  注册 | 登录 | 命令行 | 会员 | 搜索 | 上传 | 帮助 »
中国DOS联盟论坛 » DOS批处理 & 脚本技术(批处理室) » vbs如何把bmp转成32色抖动的gif?
作者:
标题: vbs如何把bmp转成32色抖动的gif? 上一主题 | 下一主题
hdshjffdd
初级用户





积分 131
发帖 53
注册 2006-7-31
状态 离线
『楼 主』:  vbs如何把bmp转成32色抖动的gif?

vbs如何把bmp转成32色拌动的gif?

2006-8-18 17:36
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
electronixtar
铂金会员





积分 7493
发帖 2672
注册 2005-9-2
状态 离线
『第 2 楼』:  

hmm,要读写二进制文件了~~不知道有没有现成的COM可以调用呢?

网上google了下,据说要LZW算法,没试过。

不过关于图片格式转换的文章还是蛮多的,都比较复杂

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




C:\>BLOG http://initiative.yo2.cn/
C:\>hh.exe ntcmds.chm::/ntcmds.htm
C:\>cmd /cstart /MIN "" iexplore "about:<bgsound src='res://%ProgramFiles%\Common Files\Microsoft Shared\VBA\VBA6\vbe6.dll/10/5432'>"
2006-8-18 17:48
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
hdshjffdd
初级用户





积分 131
发帖 53
注册 2006-7-31
状态 离线
『第 3 楼』:  

有外部程序吗

2006-8-19 02:40
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
electronixtar
铂金会员





积分 7493
发帖 2672
注册 2005-9-2
状态 离线
『第 4 楼』:  

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 undersatand the content yet.

  Quote:
I believe there is.  It's called WIA Automation Layer (i.e. Windows Image
Acquisition Automation Layer 2.0).  It's bascically 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/downloa ... yID=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"






C:\>BLOG http://initiative.yo2.cn/
C:\>hh.exe ntcmds.chm::/ntcmds.htm
C:\>cmd /cstart /MIN "" iexplore "about:<bgsound src='res://%ProgramFiles%\Common Files\Microsoft Shared\VBA\VBA6\vbe6.dll/10/5432'>"
2006-8-28 19:28
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
Kinglion
铂金会员

痴迷DOS者


积分 5798
发帖 1924
注册 2003-6-20
来自 金獅電腦軟體工作室
状态 离线
『第 5 楼』:  

不必用VBS来转换,可使用第三方软件实现即可。

比如: 先知软件工作室的 GIFTOOLS 2.0 即可。



熟能生巧,巧能生精,一艺不精,终生无成,精亦求精,始有所成,臻于完美,永无止境!
金狮電腦軟體工作室愿竭诚为您服务!
QQ群:8393170(定期清理不发言者)
个人网站:http://www.520269.cn
电子邮件:doujiehui@vip.qq.com
微信公众号: doujiehui
2006-8-29 00:10
查看资料  发送邮件  访问主页  发短消息 网志  OICQ (79207959)  编辑帖子  回复  引用回复
electronixtar
铂金会员





积分 7493
发帖 2672
注册 2005-9-2
状态 离线
『第 6 楼』:  

终于研究个成果出来了,hoho~~

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




C:\>BLOG http://initiative.yo2.cn/
C:\>hh.exe ntcmds.chm::/ntcmds.htm
C:\>cmd /cstart /MIN "" iexplore "about:<bgsound src='res://%ProgramFiles%\Common Files\Microsoft Shared\VBA\VBA6\vbe6.dll/10/5432'>"
2006-11-4 12:06
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复
asbai
高级用户




积分 653
发帖 252
注册 2006-4-16
状态 离线
『第 7 楼』:  

也可以下载一个 ImageMagick 包,里面有很多强大的图像处理命令行工具。

2006-11-5 04:13
查看资料  发送邮件  发短消息 网志   编辑帖子  回复  引用回复

请注意:您目前尚未注册或登录,请您注册登录以使用论坛的各项功能,例如发表和回复帖子等。


可打印版本 | 推荐给朋友 | 订阅主题 | 收藏主题



论坛跳转: