vb.net的windows窗体实现dos命令

最新推荐文章于 2023-04-02 17:19:22 发布

Chendy

最新推荐文章于 2023-04-02 17:19:22 发布

阅读量2.2k

点赞数

分类专栏： VisualStudio 2005 文章标签： vb.net windows integer datagrid excel exception

VisualStudio 2005 专栏收录该内容

30 篇文章 0 订阅

订阅专栏

Imports System.Threading
Imports System.Runtime.CompilerServices
Public Class frmCmdExcute
Inherits System.Windows.Forms.Form

#Region " Windows 窗体设计器生成的代码 "
Public Sub New()

MyBase.New()

'该调用是 Windows 窗体设计器所必需的。
InitializeComponent()

'在 InitializeComponent() 调用之后添加任何初始化

End Sub

'窗体重写 dispose 以清理组件列表。

Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub

'Windows 窗体设计器所必需的
Private components As System.ComponentModel.IContainer

'注意: 以下过程是 Windows 窗体设计器所必需的
'可以使用 Windows 窗体设计器修改此过程。
'不要使用代码编辑器修改它。

Friend WithEvents tbResult As System.Windows.Forms.TextBox
Friend WithEvents Panel1 As System.Windows.Forms.Panel
Friend WithEvents btnExcute As System.Windows.Forms.Button
Friend WithEvents Label1 As System.Windows.Forms.Label
Friend WithEvents btClear As System.Windows.Forms.Button
Friend WithEvents tbComText As System.Windows.Forms.ComboBox
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
Me.tbResult = New System.Windows.Forms.TextBox
Me.Panel1 = New System.Windows.Forms.Panel
Me.tbComText = New System.Windows.Forms.ComboBox
Me.btClear = New System.Windows.Forms.Button
Me.Label1 = New System.Windows.Forms.Label
Me.btnExcute = New System.Windows.Forms.Button
Me.Panel1.SuspendLayout()
Me.SuspendLayout()
'
'tbResult
'
Me.tbResult.Anchor = CType((((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Bottom) _
Or System.Windows.Forms.AnchorStyles.Left) _
Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles)
Me.tbResult.BackColor = System.Drawing.SystemColors.Info
Me.tbResult.BorderStyle = System.Windows.Forms.BorderStyle.FixedSingle
Me.tbResult.Location = New System.Drawing.Point(8, 8)
Me.tbResult.Multiline = True
Me.tbResult.Name = "tbResult"
Me.tbResult.ScrollBars = System.Windows.Forms.ScrollBars.Both
Me.tbResult.Size = New System.Drawing.Size(584, 304)
Me.tbResult.TabIndex = 0
Me.tbResult.Text = ""
'
'Panel1
'
Me.Panel1.Anchor = CType((System.Windows.Forms.AnchorStyles.Bottom Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles)
Me.Panel1.Controls.Add(Me.tbComText)
Me.Panel1.Controls.Add(Me.btClear)
Me.Panel1.Controls.Add(Me.Label1)
Me.Panel1.Controls.Add(Me.btnExcute)
Me.Panel1.Location = New System.Drawing.Point(8, 320)
Me.Panel1.Name = "Panel1"
Me.Panel1.Size = New System.Drawing.Size(584, 40)
Me.Panel1.TabIndex = 1
'
'tbComText
'
Me.tbComText.Location = New System.Drawing.Point(224, 8)
Me.tbComText.Name = "tbComText"
Me.tbComText.Size = New System.Drawing.Size(224, 20)
Me.tbComText.TabIndex = 5
Me.tbComText.Text = "Dir"
'
'btClear
'
Me.btClear.FlatStyle = System.Windows.Forms.FlatStyle.Flat
Me.btClear.Location = New System.Drawing.Point(40, 8)
Me.btClear.Name = "btClear"
Me.btClear.Size = New System.Drawing.Size(80, 24)
Me.btClear.TabIndex = 3
Me.btClear.Text = "清空(&C)"
'
'Label1
'
Me.Label1.Location = New System.Drawing.Point(160, 8)
Me.Label1.Name = "Label1"
Me.Label1.Size = New System.Drawing.Size(48, 16)
Me.Label1.TabIndex = 2
Me.Label1.Text = "命令："
'
'btnExcute
'
Me.btnExcute.FlatStyle = System.Windows.Forms.FlatStyle.Flat
Me.btnExcute.Location = New System.Drawing.Point(472, 8)
Me.btnExcute.Name = "btnExcute"
Me.btnExcute.Size = New System.Drawing.Size(80, 24)
Me.btnExcute.TabIndex = 1
Me.btnExcute.Text = "执行(&E)"
'
'frmCmdExcute
'
Me.AcceptButton = Me.btnExcute
Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)
Me.ClientSize = New System.Drawing.Size(600, 365)
Me.Controls.Add(Me.Panel1)
Me.Controls.Add(Me.tbResult)
Me.Name = "frmCmdExcute"
Me.Text = "Command Excute Result"
Me.Panel1.ResumeLayout(False)
Me.ResumeLayout(False)

End Sub

#End Region

Public Shared Sub Main()
If System.Environment.OSVersion.ToString.IndexOf("NT") = -1 Then
MsgBox("暂时不支持非NT系统,程序退出！")
Application.Exit()
Else
Application.Run(New frmCmdExcute)
End If
End Sub

Private Delegate Sub TextAddHandler(ByVal strPara As String)

#Region "private viable"
Dim sw As IO.StreamWriter
Dim sr As New MyStreamReader
Dim err As New MyStreamReader
Dim p As System.Diagnostics.Process = New System.Diagnostics.Process
Dim psI As New System.Diagnostics.ProcessStartInfo(System.Environment.GetEnvironmentVariable("ComSpec"))
#End Region

Private Sub frmCmdExcute_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
p = New System.Diagnostics.Process
'"cmd.exe"为nt的命令行程序
psI = New System.Diagnostics.ProcessStartInfo("cmd.exe")
psI.UseShellExecute = False
psI.RedirectStandardInput = True
psI.RedirectStandardOutput = True
psI.RedirectStandardError = True
psI.CreateNoWindow = True
p.StartInfo = psI

p.Start()
sw = p.StandardInput
sr.stream = p.StandardOutput
err.stream = p.StandardError
sw.AutoFlush = True
sr.stream.BaseStream.BeginRead(sr.bytes, 0, 1024, New AsyncCallback(AddressOf CBstream), sr)
err.stream.BaseStream.BeginRead(err.bytes, 0, 1024, New AsyncCallback(AddressOf CBstream), err)
End Sub

Private Sub frmCmdExcute_Closed(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Closed
p.Close()
If Not sw Is Nothing Then
sw.Close()
End If
If Not sr Is Nothing Then
sr.stream.Close()
End If
If Not err Is Nothing Then
err.stream.Close()
End If

End Sub

Private Sub btClear_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btClear.Click
Me.tbResult.Text = String.Empty
End Sub

Private Sub btnExcute_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnExcute.Click
Me.CmdExcute()
End Sub

Private Sub CmdExcute()
Try
Me.Cursor = System.Windows.Forms.Cursors.WaitCursor
If Me.tbComText.Text <> "" Then
sw.WriteLine(Me.tbComText.Text)
Else
sw.WriteLine("Dir")
End If
Me.Cursor = System.Windows.Forms.Cursors.Default

'向combobox中添加元素
Me.tbComText.Items.Add(Me.tbComText.Text)
Me.tbComText.SelectionStart = 0
Me.tbComText.SelectionLength = Me.tbComText.Text.Length
Me.tbComText.Focus()
Catch ex As Exception
MsgBox("CmdExcute--" & ex.ToString)
End Try
End Sub

Private Sub AppText(ByVal strAdd As String)
Me.tbResult.Text &= strAdd
End Sub

'回调函数
'为了保证执行invoke方法的线程顺序，使用了MethodImpl
<MethodImpl(MethodImplOptions.Synchronized)> _
Sub CBstream(ByVal s As IAsyncResult)
Try
Dim t As MyStreamReader = CType(s.AsyncState, MyStreamReader)
If t.stream.BaseStream Is Nothing Then
Exit Sub
End If
Dim i As Integer = t.stream.BaseStream.EndRead(s)
Dim strReceive As String = System.Text.Encoding.Default.GetString(t.bytes, 0, i)
Me.Invoke(New TextAddHandler(AddressOf AppText), New Object() {strReceive})
t.stream.BaseStream.BeginRead(t.bytes, 0, 1024, New AsyncCallback(AddressOf CBstream), t)
Catch ex As Exception
MsgBox("CBstream--" & ex.ToString)
End Try
End Sub

Friend Class MyStreamReader
Public stream As IO.StreamReader
Public bytes(1024) As Byte
Public Sub New()
End Sub
End Class
End Class

用VB.NET和Excel排生产计划
作者：佚名来源：本站整理发布时间：2005-6-14 8:51:40
版权声明：可以任意转载，转载时请务必以超链接形式标明文章原始出处和作者信息及本声明
http://www.Tuenhai.com/

　　开发工具：Microsoft Visual Studio .NET 2003
　　操作系统：Windows XP

　　　　　　　　　　　　　　　　　企业信息化失败原因探讨

　　中国企业上线ERP的成功率是不高的。这是为什么呢？
　　实用的ERP系统有两个特征:
　　　１. 要求具有高度的定制性
　　　 2. 要能根据企业实际随时修改ERP系统

　　而现在企业的ERP系统开发基本采用外包模式，开发人员虽然也可以深入公司各个部门，掌握各个方面信息，然后进行定制开发。但是开发人员毕竟不是企业实际从业人员，掌握信息的广度、深度毕竟是有限的，因此，通常情况下，所开发的ERP系统难以保证第一个特征：要求具有高度的定制性。
　　
　　另一方面，企业的实际情况随时都可能发生变化，ERP系统也要随时修改，才可能随时满足企业的需求。如果说一开始，ERP系统是满足企业需求的，那么一年以后呢？当然开发人员也可以跟踪企业需求，随时修改ERP系统，但总归是不太方便。

　　
　　　　　　　　　　　　　　　　　理想的企业信息化模式

　　个人认为，理想的企业信息化模式是这样的：
　　　１.企业信息化系统的开发应由企业内部人员进行，而不是外包
　　　只有这样，实用的ERP系统所要求的两个特征:要求具有高度的定制性; 要能根据企业实际随时修改ERP系统就很可能两者都具备了。
　　　２.企业信息化要从实际工作需要出发，逐步推进
　　公司实际从业人员（兼开发人员）从实际工作需要出发，开发出相应的信息化模块、功能，再逐步完善。
　　现实中，许多企业开发的信息化系统功能很多，但又有多少人会用呢，最终是花架子而已。
　　就象笔者所在单位，说大不大，说小不小，但要一开始推行信息化管理，是不可能的。企业各部门人员素质不一，是不可能被普遍接受的。

　　要实现笔者所述理想的企业信息化模式，最大的困难是什么？
　　最大的困难是是人才难得，特定管理人员要同时具备两种能力：管理能力和开发能力。这种人才并不是每个企业都能得到的。
　　笔者虽然谈不上什么人才，但近几年从事的却是企业管理工作，并对信息化管理系统的开发亦略知一二。笔者就有可能亲身实践“理想的企业信息化模式”，并把有关经验与大家分享。

　　　　　　　　　　　　　　　　　　公司实际情况分析

　　从2004年起，tuenhai主管公司的计划工作，包括制定并下发产品生产计划，自制件生产计划，外协件采购计划等。原来公司内一直用手写的方式，由于公司产品的型号较多，如果tuenhai也是用手工填写，计划一多，整天忙于机械式的写写算算，做不了什么事情。所以tuenhai考虑用电脑代替部分机械性的工作，tuenhai就可以腾出精力抓其他方面事情了。电脑可以辅助、代替tuenhai做哪些机械性的工作呢？
　　比如，每一成品由零件组装而成，零件分自制件和外协件。每一产品由哪些零件组成是固定的。每个月的生产计划，都要分解成自制件生产计划和外协件采购计划，这个分解工作tuenhai决定交给电脑来完成。

　　　　　　　　　　　　　　　　　　程序开发模式分析　　　
　　　　　　　　　　　　　　　　　
　　用什么开发工具，用什么开发模式来实现所要求的功能呢？公司内暂时只有tuenhai自己运用，要实现的功能也不多，在一开始并没有必要用复杂的大型数据库系统。为方便信息共享，tuenhai决定用VB.NET调用Excel来实现功能模块。
　　为什么用VB.NET而不用C#，因为Excel中有个VBA，其语法和VB.NET是近似的。而且，VB.NET和C#的区别主要是语法，而非功能。
　　tuenhai现在只要求实现用程序自动安排《自制件生产计划》,这个功能不用VB.NET，单用VBA也能轻易实现。但是，考虑到以后可能的功能扩充、升级，还是用VB.NET。VB.NET是面向一代的开发工具，功能强大，而且调用EXCEL也很方便。
　　不推荐用VB6,VB.NET的入门及初级应用并不难，为何还要去用早期版本，而不用最新版本,掌握最新技术呢！　　
　　

　　　　　　　　　　　　　　　用VB.NET和Excel排生产计划

　　软件构思是这样的：
　　先在EXCEL里定制好《自制件生产计划》的样表（模板），保存为自制件生产计划.xls，其中只有一个sheet:样表。在样表中设置好各种格式，填写好固定项。再新建一空白workbook,保存为2004年自制件生产计划.xls。
　　新建一VB.NET应用程序，命名为生产计划报表。在窗体上放很少几个控件，如：几个文本框，用来输入产品数量;checkbox用来先选择是正式生产计划还是增补生产计划;另外用二个文本框用来输入计划时间和计划编号。
　　点击button，程序打开自制件生产计划.xls和2004年自制件生产计划.xls，把样表copy到2004年自制件生产计划.xls,并自动在目标sheet中填写各自制件需要生产的数量。
　　
　下面是实现代码及详细注释。注意，要先添加com引用Microsoft Excel Object Library，tuenhai的是office 2003，引用Microsoft Excel 11.0 Object Library。

Private Sub producePlan()
　　Call killEXCEL() '调用杀死EXCEL进程过程
　　'以下代码判断用户填写信息是否完整,如不完整则提示信息并退出.
　　If chkFormal.Checked = False And chkSubjoin.Checked = False Then
　　　　MsgBox("是正式计划还是增补计划??", MsgBoxStyle.Critical, "请先选择计划性质")
　　　　Exit Sub
　　End If
　　If txtDay.Text = "2004年月" Then
　　　　MsgBox("什么月份的生产计划???", MsgBoxStyle.Critical, "请填写计划时间")
　　　　Exit Sub
　　End If
　　If txt703.Text = Nothing Or txt909.Text = Nothing Or txt931.Text = Nothing Or txt932.Text = Nothing 　Then
　　　　MsgBox("请填写计划台数!", MsgBoxStyle.Critical, "计划台数填写不全")
　　　　Exit Sub
　　End If
　　If chkFormal.Checked = True And chkSubjoin.Checked = True Then
　　　　MsgBox("正式和增补两者只能选一!", MsgBoxStyle.Critical, "请重新选择计划性质")
　　　　Exit Sub
　　End If

　　'以下代码即是计算各自制件的数量,用中文来命名是免去代码注释
　　Dim 涂氟龙面板703 As Integer = CType(txt703.Text, Integer)
　　Dim 钛金面板909 As Integer = CType(txt909.Text, Integer)
　　Dim 油磨不锈钢面板931 As Integer = CType(txt931.Text, Integer)
　　Dim 油磨不锈钢面板932 As Integer = CType(txt932.Text, Integer)
　　Dim 底盘24 As Integer = 涂氟龙面板703
　　Dim 底盘22 As Integer = 钛金面板909
　　Dim 底盘41A As Integer = 油磨不锈钢面板931
　　Dim 底盘41B As Integer = 油磨不锈钢面板931
　　Dim 水盘25 As Integer = 涂氟龙面板703
　　Dim 水盘24 As Integer = 涂氟龙面板703
　　Dim 水盘22 As Integer = 钛金面板909 * 2
　　Dim 中心支架2 As Integer = 涂氟龙面板703 + 钛金面板909
　　Dim 长支架931 As Integer = (油磨不锈钢面板931 + 油磨不锈钢面板932) * 2
　　Dim 支架931U As Integer = 油磨不锈钢面板931 * 2
　　Dim 支架932U As Integer = 油磨不锈钢面板932 * 2
　　Dim 磁头抱攀 As Integer = (钛金面板909 + 油磨不锈钢面板931 + 油磨不锈钢面板932) * 2
　　Dim 电池抱攀 As Integer = (涂氟龙面板703 + 钛金面板909 + 油磨不锈钢面板931 + 油磨不锈钢面板932) * 2
　　Dim 三通抱攀 As Integer = 电池抱攀 / 2
　　Dim 炉头垫片 As Integer = 电池抱攀 * 3

　　'定义一个数组,方便在EXCEL中循环写入数字，也可以放在EXCEL的VBA中实现
　　Dim allNum() As Integer = _
　　{涂氟龙面板703, 钛金面板909, 油磨不锈钢面板931, 油磨不锈钢面板932, _
　　底盘24, 底盘22, 底盘41A, 底盘41B, _
　　水盘25, 水盘24, 水盘22, _
　　中心支架2, 长支架931, 支架931U, 支架932U, _
　　磁头抱攀, 电池抱攀, 三通抱攀, 炉头垫片}

　　Dim excelApp As New Excel.Application
　　Dim excelBook As Excel.Workbook 　　　　'自制件生产计划.xls
　　Dim excelbook2004 As Excel.Workbook　　 '2004自制件生产计划.xls
　　Dim excelWorksheet As Excel.Worksheet
　　Dim planProperty As String 　　　　　　　'计划性质,是正式计划还是增补计划

　　Try '建议用try方式捕捉错误,处理错误

　　　　excelBook = excelApp.Workbooks.Open(Application.StartupPath & "/自制件生产计划.xls")

　　　　excelbook2004 = excelApp.Workbooks.Open(Application.StartupPath & "/2004年自制件生产计划.xls")
　　　　excelWorksheet = CType(excelBook.Worksheets("样表"), Excel.Worksheet)
　　　　excelWorksheet.Copy(After:=excelbook2004.Sheets("sheet1"))
　　　　'把样表copy到<2004年自制件生产计划>workbook中sheet1的后面

　　　　excelApp.Visible = True '设置工作薄为可视

　　　　If chkFormal.Checked = True Then
　　　　　　planProperty = "正式"
　　　　ElseIf chkSubjoin.Checked = True Then
　　　　　　planProperty = "增补"
　　　　End If

　　With excelbook2004.ActiveSheet '用with 简化代码
　　　　.Range("D1").Value = txtDay.Text '计划时间
　　　　.Range("C2").Value = "laoban公司" & txtDay.Text & planProperty & "采购计划" '计划依据
　　　　.Range("C25").Value = Now.Date.Today.ToShortDateString '这就是制表日期
　　　　.Range("F2").Value = txtNO.Text '计划编号

　　End With
　　For i As Integer = 0 To 18 '共19种自制件
　　　　excelbook2004.ActiveSheet.cells(4 + i, 4) = allNum(i)　　　'4+i是行号,第二个４是列号
　　Next '循环把各自制件数填入<2004年自制件生产计划>中的活动工作表相应位置

　　Catch ex As Exception '捕捉错误,并回收资源,显示错误
　　　　excelBook = Nothing
　　　　excelbook2004 = Nothing
　　　　excelWorksheet = Nothing
　　　　excelApp = Nothing
　　　　GC.Collect(0)
　　　　MsgBox(ex.ToString) '显示错误信息,以查找定位
　　Exit Sub '出错就退出
　　Finally '这里的代码一定会被执行到
　　　　excelBook = Nothing
　　　　excelbook2004 = Nothing
　　　　excelWorksheet = Nothing　　
　　　　excelApp = Nothing
　　GC.Collect(0)
　　End Try
　　MsgBox("已排好自制件生产计划,请查看")

　　excelBook = Nothing
　　excelbook2004 = Nothing
　　excelWorksheet = Nothing
　　excelApp = Nothing
　　GC.Collect(0)

End Sub

　
　　下面是杀死EXCEL进程的过程：

Private Sub killEXCEL() '为进程避免冲突,在调用EXCEL前先杀死现有EXCEL进程.
　　Dim pProcess() As Process
　　pProcess = Process.GetProcesses()
　　Dim i As Integer
　　For i = 0 To pProcess.Length() - 1
　　　　If (pProcess(i).ProcessName = "EXCEL") Then
　　　　pProcess(i).Kill() '关闭进程
　　　　End If
　　Next
End Sub

　　更多内容在http://www.Tuenhai.com/。

　　以上代码非常简单，功能也很有限，但是很实用，以前都是用手工填写并计算的，现在全部自动实现。本来要半小时的工作，现在可以在５分钟内搞定。如果产品有变化，tuenhai可以随时修改程序，使程序始终满足企业需求。企业信息化就应该是这样，从很小的功能开始。
　　也许老总一点不知道何为企业信息化，你可以展示给老总，看，以前要用半小时排计划，现在５分钟就解决，这也是属于企业信息化。
　　昨天用了一个晚上时间写了以上代码，一个晚上只是一个晚上而已，以后可以省下多少时间？老总是经济第一的，要他掏腰包聘专业开发人员，或外委软件公司开发，总是要让老总割血，也是不太可能的事。tuenhai是管理人员，本身也懂一点编程，信息化从自身工作开始，不用老总多花一分钱，反而可以提高工作效率。而且，原来公司里只有极少懂产品的人有排计划的能力，现在用程序来实现，人人都会。
　　中国的企业信息化,要么华而不实，更多企业是根本不知并不用。tuenhai在公司内进行企业信息化探索受诸多因素限制。无论如何，tuenhai会将tuenhai的经验与大家分享，大家共同来探索有中国特色的企业信息化之路。

在VB。NET里怎么实现类似C#中continue的功能
作者：佚名来源：本站整理发布时间：2005-6-14 8:54:10

如下C#代码:
int sum=0;
for(int i=1;i<101;i++)
{
if(i％2!=0)
{
continue;
}
sum+=i;
}
可以考虑用以下VB.NET代码实现:
Dim sum As Integer, i As Integer
For i = 1 To 100
   If (i Mod 2 = 0) Then
     sum = sum + i
   End If
Next

Dim sum As Integer, i As Integer
For i = 1 To 100
If (i Mod 2 <> 0) Then
GoTo continue
End If
sum = sum + i
continue:
Next

另外在VB.NET 2005,已经实现了continue语法
For i As Integer = 0 To 100
     ’ If i = 50 skip Console.Writeline statement
     If i = 50 Then Continue For
     Console.WriteLine(i.ToString)
Next

’ Do While using Continue statement.
Dim ii As Integer = 1
Do While ii < 100
     ii += 1
     ’ If i = 50 skip Console.Writeline statement
     If ii = 50 Then Continue Do
     Console.WriteLine(ii.ToString)
Loop

’ While using Continue statement.
Dim iii As Integer = 1
While iii < 100
     iii += 1
     ’ If i = 50 skip Console.Writeline statement
     If iii = 50 Then Continue While
     Console.WriteLine(iii.ToString)
End While

一个驱动webcam的类，利用通用的摄像头驱动程序avicap32.dll [vb.net]
作者：佚名来源：本站整理发布时间：2005-6-14 8:58:40

'-------------------------------------------------

'--------Code By Ken Tucker-------------

'-------------------------------------------------

Imports System.Runtime.InteropServices

Public Class Form1
Inherits System.Windows.Forms.Form

#Region " Windows Form Designer generated code "

Public Sub New()
MyBase.New()

'This call is required by the Windows Form Designer.
InitializeComponent()

'Add any initialization after the InitializeComponent() call

End Sub

    'Form overrides dispose to clean up the component list.
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing Then
            If Not (components Is Nothing) Then
                components.Dispose()
            End If
        End If
        MyBase.Dispose(disposing)
    End Sub

'Required by the Windows Form Designer
Private components As System.ComponentModel.IContainer

    'NOTE: The following procedure is required by the Windows Form Designer
    'It can be modified using the Windows Form Designer.
    'Do not modify it using the code editor.
    Friend WithEvents picCapture As System.Windows.Forms.PictureBox
    Friend WithEvents lstDevices As System.Windows.Forms.ListBox
    Friend WithEvents lblDevice As System.Windows.Forms.Label
    Friend WithEvents btnStart As System.Windows.Forms.Button
    Friend WithEvents btnSave As System.Windows.Forms.Button
    Friend WithEvents btnStop As System.Windows.Forms.Button
    Friend WithEvents sfdImage As System.Windows.Forms.SaveFileDialog
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
        Me.picCapture = New System.Windows.Forms.PictureBox()
        Me.lstDevices = New System.Windows.Forms.ListBox()
        Me.lblDevice = New System.Windows.Forms.Label()
        Me.btnStart = New System.Windows.Forms.Button()
        Me.btnSave = New System.Windows.Forms.Button()
        Me.btnStop = New System.Windows.Forms.Button()
        Me.sfdImage = New System.Windows.Forms.SaveFileDialog()
        Me.SuspendLayout()
        '
        'picCapture
        '
        Me.picCapture.BorderStyle = System.Windows.Forms.BorderStyle.Fixed3D
        Me.picCapture.Location = New System.Drawing.Point(208, 24)
        Me.picCapture.Name = "picCapture"
        Me.picCapture.Size = New System.Drawing.Size(256, 272)
        Me.picCapture.TabIndex = 0
        Me.picCapture.TabStop = False
        '
        'lstDevices
        '
        Me.lstDevices.Location = New System.Drawing.Point(8, 55)
        Me.lstDevices.Name = "lstDevices"
        Me.lstDevices.Size = New System.Drawing.Size(184, 238)
        Me.lstDevices.TabIndex = 1
        '
        'lblDevice
        '
        Me.lblDevice.Location = New System.Drawing.Point(8, 32)
        Me.lblDevice.Name = "lblDevice"
        Me.lblDevice.Size = New System.Drawing.Size(184, 16)
        Me.lblDevice.TabIndex = 2
        Me.lblDevice.Text = "Available Devices"
        Me.lblDevice.TextAlign = System.Drawing.ContentAlignment.TopCenter
        '
        'btnStart
        '
        Me.btnStart.Location = New System.Drawing.Point(20, 320)
        Me.btnStart.Name = "btnStart"
        Me.btnStart.Size = New System.Drawing.Size(112, 32)
        Me.btnStart.TabIndex = 3
        Me.btnStart.Text = "Start Preview"
        '
        'btnSave
        '
        Me.btnSave.Anchor = (System.Windows.Forms.AnchorStyles.Bottom Or System.Windows.Forms.AnchorStyles.Right)
        Me.btnSave.Location = New System.Drawing.Point(348, 320)
        Me.btnSave.Name = "btnSave"
        Me.btnSave.Size = New System.Drawing.Size(112, 32)
        Me.btnSave.TabIndex = 4
        Me.btnSave.Text = "Save Image"
        '
        'btnStop
        '
        Me.btnStop.Location = New System.Drawing.Point(184, 320)
        Me.btnStop.Name = "btnStop"
        Me.btnStop.Size = New System.Drawing.Size(112, 32)
        Me.btnStop.TabIndex = 5
        Me.btnStop.Text = "Stop Preview"
        '
        'sfdImage
        '
        Me.sfdImage.FileName = "Webcam1"
        Me.sfdImage.Filter = "Bitmap|*.bmp"
        '
        'Form1
        '
        Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
        Me.ClientSize = New System.Drawing.Size(480, 382)
        Me.Controls.AddRange(New System.Windows.Forms.Control() {Me.btnStop, Me.btnSave, Me.btnStart, Me.lblDevice, Me.lstDevices, Me.picCapture})
        Me.Name = "Form1"
        Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen
        Me.Text = "Video Capture"
        Me.ResumeLayout(False)

End Sub

#End Region

Const WM_CAP As Short = &H400S

    Const WM_CAP_DRIVER_CONNECT As Integer = WM_CAP + 10
    Const WM_CAP_DRIVER_DISCONNECT As Integer = WM_CAP + 11
    Const WM_CAP_EDIT_COPY As Integer = WM_CAP + 30

    Const WM_CAP_SET_PREVIEW As Integer = WM_CAP + 50
    Const WM_CAP_SET_PREVIEWRATE As Integer = WM_CAP + 52
    Const WM_CAP_SET_SCALE As Integer = WM_CAP + 53
    Const WS_CHILD As Integer = &H40000000
    Const WS_VISIBLE As Integer = &H10000000
    Const SWP_NOMOVE As Short = &H2S
    Const SWP_NOSIZE As Short = 1
    Const SWP_NOZORDER As Short = &H4S
    Const HWND_BOTTOM As Short = 1

Dim iDevice As Integer = 0 ' Current device ID
Dim hHwnd As Integer ' Handle to preview window

    Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, _
        <MarshalAs(UnmanagedType.AsAny)> ByVal lParam As Object) As Integer

    Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" (ByVal hwnd As Integer, _
        ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, _
        ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer

Declare Function DestroyWindow Lib "user32" (ByVal hndw As Integer) As Boolean

    Declare Function capCreateCaptureWindowA Lib "avicap32.dll" _
        (ByVal lpszWindowName As String, ByVal dwStyle As Integer, _
        ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, _
        ByVal nHeight As Short, ByVal hWndParent As Integer, _
        ByVal nID As Integer) As Integer

    Declare Function capGetDriverDescriptionA Lib "avicap32.dll" (ByVal wDriver As Short, _
        ByVal lpszName As String, ByVal cbName As Integer, ByVal lpszVer As String, _
        ByVal cbVer As Integer) As Boolean

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        LoadDeviceList()
        If lstDevices.Items.Count > 0 Then
            btnStart.Enabled = True
            lstDevices.SelectedIndex = 0
            btnStart.Enabled = True
        Else
            lstDevices.Items.Add("No Capture Device")
            btnStart.Enabled = False
        End If

        btnStop.Enabled = False
        btnSave.Enabled = False
        picCapture.SizeMode = PictureBoxSizeMode.StretchImage
    End Sub

    Private Sub LoadDeviceList()
        Dim strName As String = Space(100)
        Dim strVer As String = Space(100)
        Dim bReturn As Boolean
        Dim x As Integer = 0

        '
        ' Load name of all avialable devices into the lstDevices
        '

        Do
            '
            '   Get Driver name and version
            '
            bReturn = capGetDriverDescriptionA(x, strName, 100, strVer, 100)

            '
            ' If there was a device add device name to the list
            '
            If bReturn Then lstDevices.Items.Add(strName.Trim)
            x += 1
        Loop Until bReturn = False
    End Sub

    Private Sub OpenPreviewWindow()
        Dim iHeight As Integer = picCapture.Height
        Dim iWidth As Integer = picCapture.Width

        '
        ' Open Preview window in picturebox
        '
        hHwnd = capCreateCaptureWindowA(iDevice, WS_VISIBLE Or WS_CHILD, 0, 0, 640, _
            480, picCapture.Handle.ToInt32, 0)

        '
        ' Connect to device
        '
        If SendMessage(hHwnd, WM_CAP_DRIVER_CONNECT, iDevice, 0) Then
            '
            'Set the preview scale
            '
            SendMessage(hHwnd, WM_CAP_SET_SCALE, True, 0)

            '
            'Set the preview rate in milliseconds
            '
            SendMessage(hHwnd, WM_CAP_SET_PREVIEWRATE, 66, 0)

            '
            'Start previewing the image from the camera
            '
            SendMessage(hHwnd, WM_CAP_SET_PREVIEW, True, 0)

            '
            ' Resize window to fit in picturebox
            '
            SetWindowPos(hHwnd, HWND_BOTTOM, 0, 0, picCapture.Width, picCapture.Height, _
                    SWP_NOMOVE Or SWP_NOZORDER)

            btnSave.Enabled = True
            btnStop.Enabled = True
            btnStart.Enabled = False
        Else
            '
            ' Error connecting to device close window
            '
            DestroyWindow(hHwnd)

            btnSave.Enabled = False
        End If
    End Sub

    Private Sub btnStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStart.Click
        iDevice = lstDevices.SelectedIndex
        OpenPreviewWindow()
    End Sub

    Private Sub ClosePreviewWindow()
        '
        ' Disconnect from device
        '
        SendMessage(hHwnd, WM_CAP_DRIVER_DISCONNECT, iDevice, 0)

        '
        ' close window
        '

DestroyWindow(hHwnd)
End Sub

    Private Sub btnStop_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStop.Click
        ClosePreviewWindow()
        btnSave.Enabled = False
        btnStart.Enabled = True
        btnStop.Enabled = False
    End Sub

    Private Sub btnSave_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSave.Click
        Dim data As IDataObject
        Dim bmap As Image

        '
        ' Copy image to clipboard
        '
        SendMessage(hHwnd, WM_CAP_EDIT_COPY, 0, 0)

        '
        ' Get image from clipboard and convert it to a bitmap
        '
        data = Clipboard.GetDataObject()
        If data.GetDataPresent(GetType(System.Drawing.Bitmap)) Then
            bmap = CType(data.GetData(GetType(System.Drawing.Bitmap)), Image)
            picCapture.Image = bmap
            ClosePreviewWindow()
            btnSave.Enabled = False
            btnStop.Enabled = False
            btnStart.Enabled = True

            If sfdImage.ShowDialog = DialogResult.OK Then
                bmap.Save(sfdImage.FileName, Imaging.ImageFormat.Bmp)
            End If

End If
End Sub

    Private Sub Form1_Closing(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
        If btnStop.Enabled Then
            ClosePreviewWindow()
        End If
    End Sub
End Class

VB.NET中实现IEnumerator接口
作者：佚名来源：本站整理发布时间：2005-6-14 8:59:30

VB.NET中实现IEnumerator接口
在面向对象的设计中，经常会用到有类似父子关系的这个对象，比如在我现在的一个项目中，有订单对象，在一个订单下又包含多个产品，这时我就想用Iterator模式来封装订单下的产品，在dot Net中的IEnumerator接口就是用来实现迭代的，来支持dot Net中的for each的操作。

要实现IEnumerator接口，需在实现以下几个函数来支持IEnumerator接口的操作

Overridable ReadOnly Property Current() As Object

Current用于在迭代过程中得到当前的对象

Public Overridable Function MoveNext() As Boolean

MoveNext用于在迭代过程中将迭代指针指向下一个对象，初始是迭代指针指向集合的开始（在第一个节点之前的位置），一旦越过集合的结尾，在调用 Reset 之前，对 MoveNext 的后续调用返回 false。

Overridable Sub Reset()
将枚举数设置为其初始位置，该位置位于集合中第一个元素之前。

只要集合保持不变，枚举数就将保持有效。如果对集合进行了更改（例如添加、修改或删除元素），则该枚举数将失效且不可恢复，并且下一次对 MoveNext 或 Reset 的调用将引发 InvalidOperationException。

下需是一个具体的实现IEnumerator接口的对像

'------------------------实现IEnumerator接口的类----------------------------------

Imports System.Collections

'在此实际实现的是System.Collections.IEnumerable接口，IteratorProduct 用此接口来向使用者提供对IEnumerator接口的操作。

Public Class IteratorProduct : Implements System.Collections.IEnumerable
Private Products As Collection '用Collection在存订单中的所有产品
Private item As Integer = -1

    Public Sub New()
        Products = New Collection
        Products.Add("xh")                   '这只是为了测试方便，将加入产品的内容直接写在这了
        Products.Add("lj")
        Products.Add("qd")
    End Sub

    Overridable ReadOnly Property Current() As Object
        Get
            Return Products(item)
        End Get
    End Property

    Public Overridable Function MoveNext() As Boolean
        item += 1
    End Function

    Overridable Sub Reset()
        item = -1
    End Sub

' 返回迭代对像给使用者

Overridable Function GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
Return Me.Products.GetEnumerator
End Function

End Class

'------------------------使用类----------------------------------

Private Sub Page_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        Dim Products As IteratorProduct
        Products = New IteratorProduct
        Dim ProductName As String
        For Each ProductName In Products
            Response.Write(ProductName)
            Response.Write("<br>")
        Next
    End Sub

输出为:

xh
lj
qd
说明实现成功

vb.net 读写xml方法(1)
作者：佚名来源：本站整理发布时间：2005-6-14 8:54:50
Dim domXmlDocument As System.Xml.XmlDocument
Dim tmpPath As String = AppTempFilePath
Dim xmlFile As String = tmpPath + "/testXml.xml"

’窗体加载事件
    Private Sub TestXml_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        ’读xml过程测试通过
        Dim domXmlDocument As System.Xml.XmlDocument
        Dim tmpPath As String = AppTempFilePath
        Dim xmlFile As String = tmpPath + "/testXml.xml"
        Dim reader As System.Xml.XmlReader = Nothing
        Try
            reader = New Xml.XmlTextReader(xmlFile)
            ’reader.
            While reader.Read
                Me.lboxXml.Items.Add(reader.Name + reader.Value)
            End While
        Catch ex As Exception
            MsgBox(ex.Message)
        Finally
            If Not (reader Is Nothing) Then
                reader.Close()
            End If
        End Try
    End Sub
    ’载入xml事件
    Private Sub btnXmlLoad_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnXmlLoad.Click
        ’Me.lboxXml.Items.Clear()
        ’’读xml过程测试通过
        ’Dim reader As System.Xml.XmlReader = Nothing
        ’Try
        ’    reader = New Xml.XmlTextReader(xmlFile)
        ’    While reader.Read
        ’        Me.lboxXml.Items.Add(reader.Name + ":" + reader.Value)
        ’    End While
        ’Catch ex As Exception
        ’    MsgBox(ex.Message)
        ’Finally
        ’    If Not (reader Is Nothing) Then
        ’        reader.Close()
        ’    End If
        ’End Try
        Dim ds As New DataSet
        Try
            ’如果直接使用ds做datasource则不会展开datagrid，用dv则可以直接显示正确。
            ds.ReadXml(xmlFile)
            Dim tb As DataTable
            Dim dv As DataView
            tb = ds.Tables(0)
            dv = New DataView(tb)
            DataGrid1.DataSource = dv
            ’DataGrid1.DataMember = "testXmlMember"
            ’DataGrid1.DataMember = "employeefname"
            ’Dim dxd As New XmlDataDocument
        Catch ex As Exception
            MsgBox(ex.Message.ToString)
        End Try
    End Sub
    ’保存新建xml内容事件
    Private Sub btnSaveNew_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSaveNew.Click
        Dim myTW As New XmlTextWriter(tmpPath + "/testXmlWrite.xml", Nothing)
        myTW.WriteStartDocument()
        myTW.Formatting = Formatting.Indented
        myTW.WriteStartElement("Team")
        myTW.WriteStartElement("player")
        myTW.WriteAttributeString("Name", "George Zip")
        myTW.WriteAttributeString("Position", "QB")
        myTW.WriteElementString("Nickname", "Zippy")
        myTW.WriteElementString("JerseyNumber", XmlConvert.ToString(7))
        myTW.WriteEndElement()
        myTW.WriteEndElement()
        myTW.WriteEndDocument()
        myTW.Close()
    End Sub

对于修改datagrid中指定内容并保存到xml中还不会,弄明白了,在vb.net与xml读写的2中写出来!

vb.net读写xml(2)--实现datagrid与xml的沟通
作者：佚名来源：本站整理发布时间：2005-6-14 8:54:40

注:我主要参考网上一篇文章名为:《VB和VB.NET中的XML操作》文章url：http://www.wrclub.net/study/listarticle.aspx?id=1459

在里面里介绍了大体过程，但是，在我的实际应用过程中

在文章代码中：

Dim mySDD As System.Xml.XmlDataDocument
myXDD = New System.Xml.XmlDataDocument(Me.dsMaster1)
myXDD.Load ("dataOnly.xml")
SetBindings(Me.dsMaster1)

SetBindings这一方法始终不知道是什么东西，在msdn里也找不到，所以最后还是没有按照他的文章方法实现。参照了一下msdn，不过此文章对我的帮助还是比较大，虽然也导致我走了一些弯路。

在这里主要帖出两个事件，即将xml载入到datagrid中的办法：

            '如果直接使用ds做datasource则不会展开datagrid，用dv则可以直接显示正确。
            Dim ds As DataSet = New DataSet
            ds.ReadXml(xmlFile)
            Dim tb As DataTable
            Dim dv As DataView
            tb = ds.Tables(0)
            dv = New DataView(tb)
            'DataGrid1.DataSource = dv
            'DataGrid1.DataMember = "testXmlMember"
            'DataGrid1.DataMember = "employeefname"
            'Dim dxd As New XmlDataDocument
            DataGrid1.SetDataBinding(dv, "")
            xmlDD = New XmlDataDocument(ds)

注意ds和xmlDD这两个引用变量的位置。查找msdn可以找到对应的帮助。具体就是避免重复绑定的错误。

另外一个事件在保存事件中，只要直接调用：

xmlDD.Save(xmlFile)

即可

这样就可以实现xml显示在grid中，然后通过保存，把grid中的内容保存到xml文件中。

万事开头难，开个头，接下来的就不那么难了！

如果用.net来操作xml，我想主要用到的类也就是XMLDocument、XMLReader、XMLWriter.以及他们的衍生类，在MSDN里可以找到！

接下来的任务就是：获取某一节点，然后只需要更新某一节点，以及通过xml关系表映射关系到正确对象等问题了！

Chendy

关注

0
点赞
踩
1

收藏

觉得还不错? 一键收藏
0
评论
vb.net的windows窗体实现dos命令

Imports System.ThreadingImports System.Runtime.CompilerServicesPublic Class frmCmdExcuteInherits System.Windows.Forms.Form#Region " Windows 窗体设计器生成的代码 "Public Sub New()MyBase.New()该调用是 Windows
复制链接

扫一扫

专栏目录