标签存档: VB

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

要写一个程序,涉及到缩略图的问题,原先准备用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播放器

前天在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] 短信统计

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

下载:SMSStat

[VB] Win+R

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

下载:WinR

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

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

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

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