Tag Archives: VB

在VB中用PictureBox实现图片的缩略图浏览

Posted by on December 9, 2006 No comments

要写一个程序，涉及到缩略图的问题，原先准备用StretchBlt来实现的，后来找了下发现PictureBox的PaintPicture方法 也可以把图像按规定大小进行缩放，试了一下感觉PaintPicture的速度比StretchBlt快一些。

PaintPicture的 函数定义为：

Sub PaintPicture(Picture As IPictureDisp, X1 As Single, Y1 As Single, [Width1], [Height1], [X2], [Y2], [Width2], [Height2], [Opcode])

X1 和Y1是目标位置，Width1和Height1是目标大小，默认是PictureBox的大小，X2和Y2是源位置，Width2和Height2是源 大小，Opcode是操作方式，默认应该是vbSrcCopy，如果Width1、Height1和Width2、Height2的大小不一样则进行缩 放。

新建一个工程，设置Form1的ScaleMode为“3 - Pixel”，往窗体上放1个FileListBox控件名称为 File1，1个ImageList控件名称为ImageList1，2个PictureBox控件，一个名称为Picture1，AutoResize 为True，Visible为False，另外一个名称为Picture2，AutoRedraw为True，Visible为False，Width和 Height为128，1个ListView控件名称为ListView1，将图像列表中普通设置为ImageList1。

在窗体里添加如 下代码：

‘ 窗体载入时载入图像列表
Private Sub Form_Load()
Dim i As Long
For i = 0 To File1.ListCount – 1
‘ 载入图像
Picture1.Picture = LoadPicture(File1.Path & “\” & File1.List(i))
‘ 生成缩略图
Picture2.PaintPicture Picture1.Picture, 0, 0
‘ 添加缩略图到ImageList
ImageList1.ListImages.Add , , Picture2.Image
‘ 添加缩略图到ListView
ListView1.ListItems.Add , , File1.List(i), i + 1
DoEvents
Next
End Sub
‘ 窗体改变大小时改变ListView的大小
Private Sub Form_Resize()
With ListView1
.Top = 0
.Left = 0
.Width = Me.ScaleWidth
.Height = Me.ScaleHeight
End With
End Sub
这样就差不多可以实现图片的缩略图浏览了。

用VB写一个你自己的Flash播放器

Posted by on July 10, 2006 No comments

前天在PConline下了一个孙鑫的《Java从入门到精通》的视频教程，Flash格式，在看的时候感觉很不爽，每一课开始的时候有一大段广 告，而且前面的一部分颇为啰嗦，讲了乱七八糟的东西，不知道是不是因为“入门”的关系，然后就把以前做的一个Flash播放器找出来，直接跳到自己要看的 地方～

要想用VB做一个自己的Flash播放器还是比较方便的，因为Macromedia已经提供了Shockwave Flash控件， 可以方便来的播放Flash影片。要想使用这个控件，首先要在工程里添加这个控件，选中菜单“工程->部件”，找到 Shockwave Flash，打上勾，确定就可以了。另外，因为要加载Flash影片，所以我们还需要加入对话框控件 Microsoft Common Dialog Control。

做这个Flash播放器之前，先用对象浏览器来看一下 Shockwave Flash控件有哪些我们需要的事件、方法和属性。

因为我们做的Flash播放器比较简单，所以没有可以利用的控件事 件。

方法：

Sub Back()

跳 到前一帧，相当于Flash右键菜单中的快退

Function CurrentFrame() As Long

获 取当前播放的为第几帧

Sub Forward()

跳到后一帧，相当于Flash 右键菜单中的快进

Sub GotoFrame(FrameNum As Long)

跳 到指定帧，这是一个相当有用的方法，也是要做这个Flash播放器的理由之一了

Sub Play()

播 放，相当于Flash中的播放

Sub Stop()

停止，需要注意的是这个是停 止，而不是暂停，停止后再开始播放将从第1帧开始

Sub StopPlay()

暂 停，暂停后再播放是继续暂停之前的状态

属性：

Property Movie As String

影 片路径，用来加载要播放的Flash影片

Property Playing As Boolean

是 否正在播放

TotalFrames

Flash影片的总帧数

好了， 有了这些资料就可以开始写自己的Flash播放了～

打开窗体编辑器，先在窗体添加5个按钮，名称和Caption分别 为：cmdOpen(“打开”)，cmdPlay(“播放”)，cmdStop(“停止”)，cmdPrev(“前一帧”)，cmdNext(“后一 帧”)。为了能快整跳转，再添加一个水平滚动条，名称为hslFrame。当然，最重要的，Shockwave Flash不能少了，也要添加，名称为 swf。再者要打开文件，所以添加一个Microsoft Common Dialog Control，名称为dlg。

完成窗体的设计，开始编写代码。

‘ 先给打开按钮添加过程 Private Sub cmdOpen_Click() dlg.Filter = ”Flash(*.swf)|*.swf”  ’ 设 置文件名过滤器，只显示Flash文件 dlg.ShowOpen If dlg.FileName = ”" Then Exit Sub ’ 如 果用户点了取消则退出处理 swf.Movie = dlg.FileName           ’ 加载影片 hslFrame.Max = swf.TotalFrames     ’ 获 取总帧数，并赋值给滚动条的最大值 End Sub ‘ 接着是播放按钮 Private Sub cmdPlay_Click() If swf.Playing = True Then   ’ 如 果正在播放则暂停 swf.StopPlay cmdPlay.Caption = ”播 放” ’ 按钮文本设置为“播放” Else swf.Play                 ’ 否 则就继续播放 cmdPlay.Caption = ”暂停” ’ 按钮文本设置为“暂停” End If End Sub ‘ 停 止按钮 Private Sub cmdStop_Click() swf.Stop  ’ 停止 End Sub ‘ 前 一帧按钮 Private Sub cmdPrev_Click() swf.Back End Sub ‘ 后 一帧按钮 Private Sub cmdNext_Click() swf.Forward End Sub ‘ 为 了可以拖动滚动条来进行播放，下面处理hslFrame的OnChange事件 Private Sub hslFrame_Change() swf.GotoFrame hslFrame.Value  ’ 跳 到滚动条值所在的帧 End Sub

好了，一个简单的Flahs播放器就做好了，当然你也可以在这个此基础上加上更多的功能。

[VB] 短信统计

Posted by on June 7, 2006 No comments

无聊时做的一个东东，用来统计短信发送的情况，每个号码发了几条，占的百分比，还有图示。数据文件用从移动网站得到的短信详单，从第一条复制到最后一条保 存成文本文件就可以了～～再想想，似乎真的很无聊的一东西……

下载：SMSStat

[VB] Win+R

Posted by on June 4, 2006 No comments

以前做的一个小软件，用来管理注册表里AppPath里的项，可以从运行对话框里快速启动程序。我一般是取程序名的两个字母，基本上都是左手边的，比如 Foxmail就用fx，FlashGet用fg，Visual C++用vc，这样就可以只用左手来启动程序了。我是感觉是方便点，具体用不用和怎么用 看个人高兴了。说明文件是照着EMU8086的说明文件用英文写的，纯粹为了好玩，英语没学好，有语法错误是难免的，所以不看也罢^_^。PS.早上起来 发现又下雨了。

下载：WinR

update @ 2009.06.18 把 COMCTL32.ocx 一起放进压缩包，避免有些机器上会出现找不到 COMCTL32.ocx 的错 误。

[VB] 一个操作多线程的类

Posted by on May 10, 2006 No comments

根据点睛工作室的多线程类改写的，不过没有经过严格测试，好像工作不是很稳定，如果使用不当会出错的说。

Option Explicit
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Declare Function CreateThread Lib “kernel32″ (lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Private Declare Function CreateThreadL Lib “kernel32″ Alias “CreateThread” (ByVal lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Private Declare Function TerminateThread Lib “kernel32″ (ByVal hThread As Long, ByVal dwExitCode As Long) As Long
Private Declare Function SetThreadPriority Lib “kernel32″ (ByVal hThread As Long, ByVal nPriority As Long) As Long
Private Declare Function GetThreadPriority Lib “kernel32″ (ByVal hThread As Long) As Long
Private Declare Function ResumeThread Lib “kernel32″ (ByVal hThread As Long) As Long
Private Declare Function SuspendThread Lib “kernel32″ (ByVal hThread As Long) As Long
Private Declare Function GetCurrentThread Lib “kernel32″ () As Long
Private Declare Function GetCurrentThreadId Lib “kernel32″ () As Long
Private Declare Sub ExitThread Lib “kernel32″ (Optional ByVal dwExitCode As Long = 0)
Private Declare Function GetLastError Lib “kernel32″ () As Long
‘ 常数常量
Private Const MAXLONG = &H7FFFFFFF
‘ 线程优先级常量
Private Const THREAD_BASE_PRIORITY_IDLE = -15
Private Const THREAD_BASE_PRIORITY_LOWRT = 15
Private Const THREAD_BASE_PRIORITY_MAX = 2
Private Const THREAD_BASE_PRIORITY_MIN = -2
Private Const THREAD_PRIORITY_HIGHEST = THREAD_BASE_PRIORITY_MAX
Private Const THREAD_PRIORITY_IDLE = THREAD_BASE_PRIORITY_IDLE
Private Const THREAD_PRIORITY_LOWEST = THREAD_BASE_PRIORITY_MIN
Private Const THREAD_PRIORITY_NORMAL = 0
Private Const THREAD_PRIORITY_TIME_CRITICAL = THREAD_BASE_PRIORITY_LOWRT
Private Const THREAD_PRIORITY_ABOVE_NORMAL = (THREAD_PRIORITY_HIGHEST – 1)
Private Const THREAD_PRIORITY_BELOW_NORMAL = (THREAD_PRIORITY_LOWEST + 1)
Private Const THREAD_PRIORITY_ERROR_RETURN = (MAXLONG)
‘ 线程创建标志
Private Const CREATE_ALWAYS = 2
Private Const CREATE_NEW = 1
Private Const CREATE_NEW_CONSOLE = &H10
Private Const CREATE_NEW_PROCESS_GROUP = &H200
Private Const CREATE_NO_WINDOW = &H8000000
Private Const CREATE_PROCESS_DEBUG_EVENT = 3
Private Const CREATE_SUSPENDED = &H4
Private Const CREATE_THREAD_DEBUG_EVENT = 2
‘ 线程优先级结构
Public Enum ThreadPriority
Lowest = THREAD_PRIORITY_LOWEST
BelowNormal = THREAD_PRIORITY_BELOW_NORMAL
Normal = THREAD_PRIORITY_NORMAL
AboveNormal = THREAD_PRIORITY_ABOVE_NORMAL
Highest = THREAD_PRIORITY_HIGHEST
End Enum
Private mAttrib As SECURITY_ATTRIBUTES
Private mEnabled As Boolean
Private mThreadHandle As Long
Private mThreadID As Long
Private mTerminate As Boolean
Public Property Get ThreadID() As Long
ThreadID = mThreadID
End Property
Public Property Get ThreadHandle() As Long
ThreadHandle = mThreadHandle
End Property
Public Function Create(ByVal cFunction As Long, Optional ByVal cPriority As ThreadPriority, Optional ByVal cEnabled As Boolean = True) As Long
Dim CreateFlag As Long
If mThreadHandle <> 0 Then TerminateMe
mEnabled = cEnabled
If mEnabled Then
CreateFlag = CREATE_NEW
Else
CreateFlag = CREATE_SUSPENDED
End If
mAttrib.nLength = Len(mAttrib)
mThreadHandle = CreateThreadL(0, 0, cFunction, 0&, CreateFlag, mThreadID)
If mThreadHandle = 0 Then
MsgBox “Create thread failed!Error code:” & GetLastError, vbOKOnly Or vbCritical, “Error”
End If
End Function
Public Sub SuspendMe()
If mThreadHandle = 0 Or mEnabled = False Then Exit Sub
If SuspendThread(mThreadHandle) <> -1 Then
mEnabled = False
Else
MsgBox “Suspend thread failed!Error code:” & GetLastError, vbOKOnly Or vbCritical, “Error”
End If
End Sub
Public Sub ResumeMe()
If mThreadHandle = 0 Or mEnabled = True Then Exit Sub
If ResumeThread(mThreadHandle) <> -1 Then
mEnabled = True
Else
MsgBox “Resume thread failed!Error code:” & GetLastError, vbOKOnly Or vbCritical, “Error”
End If
End Sub
Public Sub TerminateMe()
If mThreadHandle = 0 Then Exit Sub
TerminateThread mThreadHandle, 0
mThreadHandle = 0
‘mTerminate = True
‘Do
‘    DoEvents
‘Loop Until mTerminate
End Sub
Private Sub Class_Terminate()
‘TerminateThread mThreadHandle, 0
End Sub
.