Access编程交流网
  • 设为首页|收藏本站|繁体中文|手机版
  •     
  • Access培训-Access开发平台-Access行业开发

  • 首页
  • 资讯
  • 技巧
  • 源码
  • 行业
  • 资源
  • 活动
  • 关于

技巧

ACCESS数据库

启动/设置/选项/背景

修复/压缩

安全/加密/解密

快捷键

版本升级/其它等

数据表

命名方式/设计规范

表设计

查询

Sql语言基础

选择查询

更新查询

删除查询

追加查询

生成表查询

交叉表查询

SQL特定查询

查询参数

查询综合应用

界面/窗体/控件

标签

文本框

命令按钮

组合框/列表框

选项组/复选框/选项按钮

选项卡

子窗体

窗体本身/综合应用

其它

报表打印

报表设计

高级报表

模块/函数/VBA/API/系统

VBA基础

内置函数

调试/跟踪/Debug

模块/类模块

API/COM/系统相关

字符数字日期

网络通信游戏

加密解密安全

文件处理

经典算法

宏/菜单/工具栏/功能区

宏/脚本

菜单/工具栏

功能区/Ribbon

图表/图形/图像/多媒体

图表

图形/图像

音频

视频/动画

DAO/链接表/ADO/ADP

DAO/链接表/ODBC

ADO/RDO

ADP

ActiveX/第三方控件/插件

Treeview树控件

ListView列表控件

Toolbar工具栏控件

微软其它控件

Dbi-Tech

CodeJock

Grid++Report

FastReport

ComponentOne

加载项/插件/Addin

OFFICE集成/导入导出/交互

Excel导入导出/交互

Word导入导出/交互

PPT交互

Outlook控制/邮件

Text文本文件/INI/CSV

PDF/SWF/XML格式

CAD格式

Sharepoint/其它Office

SqlServer/其它数据库

表

视图

存储过程/触发器

函数

用户/权限/安全

调试/维护

SqlServer其它/综合

发布/打包/文档/帮助

开发版/运行时

打包/发布/部署

开发文档/帮助制作

Access完整行业系统

采购管理系统

销售管理系统

仓库管理系统

人力资源管理HRM

CRM管理系统

MRP/ERP管理系统

BRP/流程优化

其它管理系统

心得/经验/绝招
其它/杂项
Excel技巧

Excel应用与操作

Excel开发编程

Word技巧

Word应用与操作

Word开发编程

Outlook技巧

Outlook应用与操作

Outlook开发编程

热门文章

  • 剖析 Declare 语句
  • API函数详细解释
  • 隐藏Access主窗口之一
  • VBA保存剪贴板为Bmp(..
  • 一种比GetTickCou..
  • Access VBA 判断..

最新文章

  • Access API函数分..
  • Access VBA 注册..
  • Access Excel ..
  • 毫秒级和纳秒级计时的API..
  • 一种比GetTickCou..
  • VB用PrevInstan..

联系方式

Access交流网(免费Access交流)

QQ:18449932 

网  址:www.access-cn.com

当前位置:首页 > 技巧 > 模块/函数/VBA/API/系统 > API/COM/系统相关
API/COM/系统相关

VB创建多线程应用程序(二)

 

源代码如下:

窗体中的代码:

Option Explicit

 

'开始

Private Sub Command1_Click()

  

   On Error Resume Next

  

   With myThreadleft

        .Initialize AddressOf Fillleft            '传递过程地址给线程

        .ThreadEnabled = True

   End With

   With myThreadright

        .Initialize AddressOf Fillright

        .ThreadEnabled = True

   End With

   With myThreadbottom

        .Initialize AddressOf Fillbottom

        .ThreadEnabled = True

   End With

  

   MsgBox "多线程正在运行...,看看图片框控件的变色效果!", 64, "信息"

  

   '终止线程运行

   Set myThreadleft = Nothing

   Set myThreadright = Nothing

   Set myThreadbottom = Nothing

  

End Sub

 

'结束

Private Sub Command2_Click()

   Unload Me

End Sub

模块中的代码:

Option Explicit

 

'时间计数API

Private Declare Function GetTickCount Lib "kernel32" () As Long

 

'声明cls_thread类的对象变量

Public myThreadleft As New cls_thread, myThreadright As New cls_thread, myThreadbottom As New cls_thread

  

Sub Main()

   Load Form1

   Form1.Show

End Sub

 

Public Sub Fillleft()

       Static Bkgcolor As Long

       Dim LongTick As Long, Longcounter As Long

       On Error Resume Next

       For Longcounter = 0 To 3000

           DoEvents

           Bkgcolor = Longcounter Mod 256

           Form1.Picture1.BackColor = RGB(Bkgcolor, 0, 0)

           LongTick = GetTickCount

           While GetTickCount - LongTick < 10             '延时10毫秒,下同

           Wend

       Next

       Set myThreadleft = Nothing  '如果循环结束则终止当前线程运行,下同

End Sub

 

Public Sub Fillright()

       Static Bkgcolor As Long

       Dim LongTickValue As Long, Longcounter As Long

       On Error Resume Next

       For Longcounter = 0 To 3000

           DoEvents

           Bkgcolor = Longcounter Mod 256

           Form1.Picture2.BackColor = RGB(0, Bkgcolor, 0)

           LongTickValue = GetTickCount

           While GetTickCount - LongTickValue < 10

           Wend

       Next

Set myThreadright = Nothing

End Sub

 

Public Sub Fillbottom()

       Static Bkgcolor As Long

       Dim LongTick As Long, Longcounter As Long

       On Error Resume Next

       For Longcounter = 0 To 3000

           DoEvents

           Bkgcolor = Longcounter Mod 256

           Form1.Picture3.BackColor = RGB(0, 0, Bkgcolor)

           LongTick = GetTickCount

           While GetTickCount - LongTick < 10

           Wend

       Next

       Set myThreadright = Nothing

End Sub

类模块中的代码:

 

'功能:创建多线程类,用于初始化线程。   类名:cls_Thread 

'参数:LongPointFunction 用于接收主调过程传递过来的函数地址值

'调用方法:1.声明线程类对象变量 Dim mythread as cls_Thread

'          2.调用形式:With mythread

'                         .Initialize AddressOf 自定义过程或函数名 '(初始化线程) .

'                         .ThreadEnabled = True                  '(设置线程是否激活)

'                      End With                                       

'          3.终止调用: Set mythread = Nothing                                                                           

'   Crate By : 陈宇 On 2004.5.10     Copyright(C).Ldt By CY-soft 2001--2004                       

'   Email:4y4ycoco@163.com                                                              

'   Test On: VB6.0+Win98  AND  VB6.0+WinXP     It's Pass !                                   

 

Option Explicit

'创建线程API

'此API经过改造,lpThreadAttributes改为Any型,lpStartAddress改为传值引用:

'因为函数的入口地址由形参变量传递,如果用传址那将传递形参变量的地址而不是函数的入口地址

Private Declare Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, LpthreadId As Long) As Long

'终止线程API

Private Declare Function TerminateThread Lib "kernel32" (ByVal hThread As Long, ByVal dwExitCode As Long) As Long

'激活线程API

Private Declare Function ResumeThread Lib "kernel32" (ByVal hThread As Long) As Long

'挂起线程API

Private Declare Function SuspendThread Lib "kernel32" (ByVal hThread As Long) As Long

 

Private Const CREATE_SUSPENDED = &H4    '线程挂起常量

 

'自定义线程结构类型

Private Type udtThread

        Handle As Long

        Enabled As Boolean

End Type

 

Private meTheard As udtThread

'初始化线程

Public Sub Initialize(ByVal LongPointFunction As Long)

       Dim LongStackSize As Long, LongCreationFlags As Long, LpthreadId As Long, LongNull As Long

       On Error Resume Next

       LongNull = 0

       LongStackSize = 0

       LongCreationFlags = CREATE_SUSPENDED         '创建线程后先挂起,由程序激活线程

      

       '创建线程并返线程句柄

       meTheard.Handle = CreateThread(LongNull, LongStackSize, ByVal LongPointFunction, LongNull, LongCreationFlags, LpthreadId)

      

       If meTheard.Handle = LongNull Then

          MsgBox "线程创建失败!", 48, "错误"

       End If

End Sub

 

'获取线程是否激活属性

Public Property Get ThreadEnabled() As Boolean

       On Error Resume Next

       Enabled = meTheard.Enabled

End Property

 

'设置线程是否激活属性

Public Property Let ThreadEnabled(ByVal Newvalue As Boolean)

       On Error Resume Next

       '若激活线程(Newvalue为真)设为TRUE且此线程原来没有激活时激活此线程

       If Newvalue And (Not meTheard.Enabled) Then

          ResumeThread meTheard.Handle

          meTheard.Enabled = True

       Else          '若激活线程(Newvalue为真)且此线程原来已激活则挂起此线程

          If meTheard.Enabled Then

             SuspendThread meTheard.Handle

             meTheard.Enabled = False

          End If

       End If

End Property

 

'终止线程事件

Private Sub Class_Terminate()

        On Error Resume Next

        Call TerminateThread(meTheard.Handle, 0)

End Sub

总结:

本程序的缺点是程序运行时CPU占用率高。

至此全部源代码结束,在实例的基础上可以根据个人需要做出不同的多线程应用程序,可以用此类模块创建ActiveX DLL,然后引用这个DLL来进行调用。希望对大家有用,若大家找到一种更好的实现方法且CPU占用率低的程序请通知我,程序中有什么Bug请Email,谢谢。


作者Blog:http://blog.csdn.net/chenyu5188/
发布人:chenyu51…-chenyu5188 的 Blog  
分享到:
点击次数:  更新时间:2005-02-06 12:29:02  【打印此页】  【关闭】
上一条:如何提取分组取前N条的记录  下一条:VB创建多线程应用程序(一)



相关文章

  • • Access API函数分享
  • • Access VBA 注册表操作源码
  • • Access Excel VBA程序同时兼容32位和64位的解决办法
  • • 毫秒级和纳秒级计时的API--timeGetTime、GetTickCount、QueryPerformanceCounter
  • • 一种比GetTickCount 和Timer更精确的计时器
  • • VB用PrevInstance和DDE实现禁止多个实例同时打开并传递命令
  • • 获取版本号及判断是否运行版本
  • • API获取网卡地址

热门文章

  • [2008-11-25] 如何解决用fso删除文件时不作任何提示直接删除了,也不放入回收access数据库
  • [2017-01-20] Access或VB为任何控件添加鼠标滚轮事件(适用VB及VBA)access数据库
  • [2009-04-17] 不关闭当前数据库COPY当前数据库access数据库
  • [2005-02-05] 如何禁止Access主窗体右上角的退出按钮access数据库
  • [2006-11-23] 快速读取 TextBox 第 N 行的资料access数据库
  • [2004-11-23] 在ACCESS中如何将某一程序设置成为当WINDOWS启动自动执行的程序access数据库

热门产品

公司动态|在线留言|在线反馈|友情链接|会员中心|站内搜索|网站地图

中山市天鸣科技发展有限公司 版权所有 1999-2023 粤ICP备10043721号

QQ:18449932

Access应用 Access培训 Access开发 Access平台

access|数据库|access下载|access教程|access视频|access软件

Powered by MetInfo 5.3.12 ©2008-2025  www.metinfo.cn