本身若用是 VS .net 應該可不知道有這驅動,因已是內建
其他語言開發,對這 ODBC .NET 就較有熟悉了
微軟:ODBC .NET 資料提供者
2012年5月31日 星期四
無法使用特殊主體 'sa'
引用來源
--
當程式指定要用 sa 帳號,,但SQL2005把sa歸類為特殊主體,結果要把sa的權限加到資料庫時,出現無法使用特殊主體 'sa'的訊息 ,解決方法有二:
資料庫的相容性層級需要是:90
可用下列的指令調整:
USE [master]
GO
EXEC dbo.sp_dbcmptlevel @dbname=N'資料庫名稱', @new_cmptlevel=90
GO
資料庫應該要具備有效的擁有者。
請使用以下的指令來進行調整:
USE master
GO
ALTER AUTHORIZATION ON DATABASE::資料庫名稱 TO sa
或
USE [資料庫名稱]
GO
EXEC dbo.sp_changedbowner @loginame = N'sa', @map = false
GO
--
當程式指定要用 sa 帳號,,但SQL2005把sa歸類為特殊主體,結果要把sa的權限加到資料庫時,出現無法使用特殊主體 'sa'的訊息 ,解決方法有二:
資料庫的相容性層級需要是:90
可用下列的指令調整:
USE [master]
GO
EXEC dbo.sp_dbcmptlevel @dbname=N'資料庫名稱', @new_cmptlevel=90
GO
資料庫應該要具備有效的擁有者。
請使用以下的指令來進行調整:
USE master
GO
ALTER AUTHORIZATION ON DATABASE::資料庫名稱 TO sa
或
USE [資料庫名稱]
GO
EXEC dbo.sp_changedbowner @loginame = N'sa', @map = false
GO
使用 SSMS 建立 Login 的使用者對應時,遇到"使用者群組或角色在【資料庫名稱】的目前資料庫中已經存在"的問題排除
引用來源
--
當您將資料庫伺服器 A 中的資料庫於資料庫伺服器 B 還原後,嘗試建立 Login(以下稱登入)DB與 User(以下稱使用者)對應時,可能遇到使用者群組或角色在[資料庫名稱]的目前資料庫中已經存在的錯誤訊息。
這是因為當使用 SQL Server Management Studio(以下簡稱 SSMS)為名稱為 NWUser 的登入建立對應至 Northwind 資料庫名稱為 NWUser 的使用者時(如下圖),SSMS 其實幫您執行了以下的 T-SQL 敘述。
USE [master]
GO
CREATE LOGIN [NWUser] WITH PASSWORD=N'密碼', DEFAULT_DATABASE=[master], CHECK_EXPIRATION=OFF, CHECK_POLICY=OFF
GO
USE [Northwind]
GO
CREATE USER [NWUser] FOR LOGIN [NWUser]
GO
USE [Northwind]
GO
ALTER USER [NWUser] WITH DEFAULT_SCHEMA=[dbo]
GO
所以, 因為NWUser早就存在,當然就發生錯誤了。
解決方式就是下指令:
一、使用ALTER USER敘述
使用下列 T-SQL 敘述來建立資料庫使用者與登入的對應,首先必須先將作用中的資料庫切換至要建立對應的資料庫,接著使用 ALTER USER 敘述來指定使用者所要對應的登入。
USE Northwind
GO
ALTER USER NWUser WITH LOGIN = NWUser
GO
二、使用 sp_change_users_login 系統預存程序
使用下列 T-SQL 敘述來建立資料庫使用者與登入的對應。
USE [Northwind]
GO
EXEC sp_change_users_login 'Update_One','NWUser','NWUser'
GO
--
當您將資料庫伺服器 A 中的資料庫於資料庫伺服器 B 還原後,嘗試建立 Login(以下稱登入)DB與 User(以下稱使用者)對應時,可能遇到使用者群組或角色在[資料庫名稱]的目前資料庫中已經存在的錯誤訊息。
這是因為當使用 SQL Server Management Studio(以下簡稱 SSMS)為名稱為 NWUser 的登入建立對應至 Northwind 資料庫名稱為 NWUser 的使用者時(如下圖),SSMS 其實幫您執行了以下的 T-SQL 敘述。
USE [master]
GO
CREATE LOGIN [NWUser] WITH PASSWORD=N'密碼', DEFAULT_DATABASE=[master], CHECK_EXPIRATION=OFF, CHECK_POLICY=OFF
GO
USE [Northwind]
GO
CREATE USER [NWUser] FOR LOGIN [NWUser]
GO
USE [Northwind]
GO
ALTER USER [NWUser] WITH DEFAULT_SCHEMA=[dbo]
GO
所以, 因為NWUser早就存在,當然就發生錯誤了。
解決方式就是下指令:
一、使用ALTER USER敘述
使用下列 T-SQL 敘述來建立資料庫使用者與登入的對應,首先必須先將作用中的資料庫切換至要建立對應的資料庫,接著使用 ALTER USER 敘述來指定使用者所要對應的登入。
USE Northwind
GO
ALTER USER NWUser WITH LOGIN = NWUser
GO
二、使用 sp_change_users_login 系統預存程序
使用下列 T-SQL 敘述來建立資料庫使用者與登入的對應。
USE [Northwind]
GO
EXEC sp_change_users_login 'Update_One','NWUser','NWUser'
GO
mssql 資料庫還原後刪除帳號
奇怪的問題,之前也類似發生
但都可以刪掉
在sql 2008 r2 express 卻不行
這問題,倒是已有人找出解套方法了
請參考:[SQL] 資料庫還原到另一台主機無法登入 - 第二回
資料庫還原後,須卸除 DB 帳號:
ALTER USER 帳號(test) WITH Login = 帳號(test)
但都可以刪掉
在sql 2008 r2 express 卻不行
這問題,倒是已有人找出解套方法了
請參考:[SQL] 資料庫還原到另一台主機無法登入 - 第二回
資料庫還原後,須卸除 DB 帳號:
ALTER USER 帳號(test) WITH Login = 帳號(test)
2012年5月30日 星期三
Google Public DNS
Google Public DNS:
慣用 DNS 伺服器:8.8.8.8
其他 DNS 伺服器:8.8.4.4
hinet dns:
168.95.1.1
168.95.192.1
不想再用hinet的 dns , 可試試 google dns 唷!!
慣用 DNS 伺服器:8.8.8.8
其他 DNS 伺服器:8.8.4.4
hinet dns:
168.95.1.1
168.95.192.1
不想再用hinet的 dns , 可試試 google dns 唷!!
2012年5月27日 星期日
datagridview disable the default Enter/Return key
參考引用
--
Private Sub DataGridView1_Keydown (...) Handlers DataGridView1.KeyDown
If e.KeyCode = Keys.Enter Then
' Your code here
e.SuppessKeyPress = True
End If
End Sub
--
Private Sub DataGridView1_Keydown (...) Handlers DataGridView1.KeyDown
If e.KeyCode = Keys.Enter Then
' Your code here
e.SuppessKeyPress = True
End If
End Sub
2012年5月26日 星期六
reloading Form
Dim es As System.EventArgs
Dim sndr As System.Object
Private Sub ResetThings()
Try
Dim c As Form.ControlCollection = Me.Controls
'c= me.co
Dim i As Integer = c.Count
'Dim cnt As Integer = c.Count
While i <> 0
c.Item(0).Dispose()
i -= 1
End While
Me.InitializeComponent()
'Ur Form Name in place of frmDailySales_Load(sndr,es)
Me.frmDailySales_Load(sndr, es)
Catch ex As Exception
MsgBox(ex.ToString())
'Exit Sub
End Try
End Sub
Private Sub frmDailySales_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
MsgBox("Load Called")
End Sub
2012年5月25日 星期五
Spire.DataExport Free
e-iceblue 官網 download free
真是福音呀,套這可省N倍時間練丹
要先註冊後,就可下載了
Spire.DataExport Community Edition
Community Edition of Spire.DataExport is 100% Free Data Export Component. This free Data Export Component can easily help you export data from SQL/DataTable to XLS, PDF and MS Word, HTML, MS clipboard ,XML, PDF, DBF, SQL Script, SYLK, DIF, CSV.
Spire PDF Converter
Spire PDF Converter is a 100% Free PDF Converter which can help you convert popular files to PDF format. It includes converting Excel to PDF, Word doc to PDF, HTML to PDF, Text to PDF and Images to PDF
真是福音呀,套這可省N倍時間練丹
要先註冊後,就可下載了
Spire.DataExport Community Edition
Community Edition of Spire.DataExport is 100% Free Data Export Component. This free Data Export Component can easily help you export data from SQL/DataTable to XLS, PDF and MS Word, HTML, MS clipboard ,XML, PDF, DBF, SQL Script, SYLK, DIF, CSV.
Spire PDF Converter
Spire PDF Converter is a 100% Free PDF Converter which can help you convert popular files to PDF format. It includes converting Excel to PDF, Word doc to PDF, HTML to PDF, Text to PDF and Images to PDF
vb.net 輸出 dbf 並壓縮
Imports System.Data.OleDb
Imports Lion.IO.SharpZIP.Zip
Imports Lion.IO.SharpZIP.Checksums
Imports System.IO
Module Module1
Sub Main()
'Try
Dim cn1 As New OleDbConnection( _
"Provider=VFPOLEDB.1;Data Source=C:\Temp\;")
cn1.Open()
'-- Make some VFP data to play with
Dim cmd1 As New OleDbCommand( _
"Create Table TestDBF (Field1 I, Field2 C(10))", cn1)
Dim cmd2 As New OleDbCommand( _
"Insert Into TestDBF Values (1, '行贿)", cn1)
Dim cmd3 As New OleDbCommand( _
"Insert Into TestDBF Values (2, '受贿')", cn1)
cmd1.ExecuteNonQuery()
cmd2.ExecuteNonQuery()
cmd3.ExecuteNonQuery()
cn1.Close()
Dim cn2 As New OleDbConnection( _
"Provider=VFPOLEDB.1;Data Source=C:\Temp\;")
cn2.Open()
Dim cmd4 As New OleDbCommand( _
"Select * From TestDBF", cn2)
Dim da1 As New OleDbDataAdapter(cmd4)
Dim ds1 As New DataSet
Dim dr1 As DataRow
da1.Fill(ds1)
For Each dr1 In ds1.Tables(0).Rows
Console.WriteLine(dr1.Item(1).ToString())
Next
cn2.Close()
Dim crc As New Crc32
Dim s As New ZipOutputStream(System.IO.File.Create("c:\temp\dbf.zip"))
s.SetLevel(6)
Dim fs As FileStream = File.OpenRead("c:\temp\testdbf.dbf")
Dim b(fs.Length - 1) As Byte'c#中的语句为byte[] b = byte[fs.Length ];要注意这点
fs.Read(b, 0, b.Length)
Dim entry As ZipEntry = New ZipEntry("c:\temp\testdbf.dbf")
entry.DateTime = DateTime.Now
entry.Size = fs.Length
fs.Close()
crc.Reset()
crc.Update(b)
entry.Crc = crc.Value
s.PutNextEntry(entry)
s.Write(b, 0, b.Length)
s.Finish()
s.Close()
Console.ReadLine()
'Catch e As Exception
'MsgBox(e.ToString())
'End Try
End Sub
End Module
數字轉國字格式-Crystal Reports公式 (Crystal Reports)
參考引用
---
數字轉換成支票格式的國字 銷售報表還蠻常看到的
先於公式欄式 新增公式名稱 num_chinese
右鍵編輯按ctrl+T
選擇basic語法 (非公式專家模式)
{pssales.Total_amt}是我要轉換的資料庫欄位名稱
輸入以下程式碼 儲存
Dim intPos As Number
Dim intI As Number
Dim intLength As Number
Dim strChaneseNo As String
Dim strCardinal1 As String
Dim strCardinal2 As String
Dim strTotal As String
Dim strTemp As String
Dim strX As String
strTotal = Cstr({pssales.Total_amt})
intPos = Instr(strTotal, ",")
While intPos > 1
strTemp = strTemp & Left(strTotal, intPos-1)
strTotal = Mid(strTotal, intPos + 1)
intPos = Instr(strTotal, ",")
Wend
strTotal = strTemp & strTotal
if Instr(strTotal,".") > 1 Then
strTotal = Mid(strTotal, 1, Len(strTotal) -3)
end if
strChaneseNo = "零壹貳參肆伍陸柒捌玖"
strCardinal1 = " 拾佰仟 拾佰仟 拾佰仟 拾佰仟"
strCardinal2 = "圓萬億兆"
intLength = Len(strTotal)
For intI = 1 To intLength Step 1
If Val(Mid(strTotal, intI, 1)) = 0 AND (Val(Mid(strTotal, intI+1, 1)) = 0 Or (intLength - intI + 1 ) Mod 4 = 1) Then
strX = strX & ""
Else
strX = strX & Mid(strChaneseNo, Val(Mid(strTotal, intI, 1)) +1 , 1)
End If
If (intLength - intI + 1) Mod 4 = 1 Or Val(Mid(strTotal, intI, 1)) = 0 Then
strX=strX & ""
Else
strX = strX & Mid(strCardinal1, (intLength - intI + 1), 1)
End If
If (intLength - intI + 1) Mod 4 = 1 Then
strX = strX & Mid(strCardinal2, (intLength - intI + 1) \ 4 + 1, 1)
If IntI > 3 And (IntLength - IntI + 1) > 1 Then
If Mid(strTotal,intI - 3, 4) = "0000" Then
strX = Left(strX, Len(strX) - 1)
End if
End If
End If
Next
Formula = strX & "整"
---
數字轉換成支票格式的國字 銷售報表還蠻常看到的
先於公式欄式 新增公式名稱 num_chinese
右鍵編輯按ctrl+T
選擇basic語法 (非公式專家模式)
{pssales.Total_amt}是我要轉換的資料庫欄位名稱
輸入以下程式碼 儲存
Dim intPos As Number
Dim intI As Number
Dim intLength As Number
Dim strChaneseNo As String
Dim strCardinal1 As String
Dim strCardinal2 As String
Dim strTotal As String
Dim strTemp As String
Dim strX As String
strTotal = Cstr({pssales.Total_amt})
intPos = Instr(strTotal, ",")
While intPos > 1
strTemp = strTemp & Left(strTotal, intPos-1)
strTotal = Mid(strTotal, intPos + 1)
intPos = Instr(strTotal, ",")
Wend
strTotal = strTemp & strTotal
if Instr(strTotal,".") > 1 Then
strTotal = Mid(strTotal, 1, Len(strTotal) -3)
end if
strChaneseNo = "零壹貳參肆伍陸柒捌玖"
strCardinal1 = " 拾佰仟 拾佰仟 拾佰仟 拾佰仟"
strCardinal2 = "圓萬億兆"
intLength = Len(strTotal)
For intI = 1 To intLength Step 1
If Val(Mid(strTotal, intI, 1)) = 0 AND (Val(Mid(strTotal, intI+1, 1)) = 0 Or (intLength - intI + 1 ) Mod 4 = 1) Then
strX = strX & ""
Else
strX = strX & Mid(strChaneseNo, Val(Mid(strTotal, intI, 1)) +1 , 1)
End If
If (intLength - intI + 1) Mod 4 = 1 Or Val(Mid(strTotal, intI, 1)) = 0 Then
strX=strX & ""
Else
strX = strX & Mid(strCardinal1, (intLength - intI + 1), 1)
End If
If (intLength - intI + 1) Mod 4 = 1 Then
strX = strX & Mid(strCardinal2, (intLength - intI + 1) \ 4 + 1, 1)
If IntI > 3 And (IntLength - IntI + 1) > 1 Then
If Mid(strTotal,intI - 3, 4) = "0000" Then
strX = Left(strX, Len(strX) - 1)
End if
End If
End If
Next
Formula = strX & "整"
vbnet 製作QRcode報表
引用來源
--
--
Imports System.Data.OleDb Imports System.Drawing.Printing 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 button1 As System.Windows.Forms.Button Friend WithEvents _c1BarCode As C1.Win.C1BarCode.C1QRCodeEnd ClassPrivate Sub InitializeComponent() Me.button1 = New System.Windows.Forms.Button() Me._c1BarCode = New C1.Win.C1BarCode.C1QRCode() Me.SuspendLayout() ' 'button1 ' Me.button1.Location = New System.Drawing.Point(8, 9) Me.button1.Name = "button1" Me.button1.Size = New System.Drawing.Size(112, 37) Me.button1.TabIndex = 3 Me.button1.Text = "Show Document" ' '_c1BarCode ' Me._c1BarCode.Location = New System.Drawing.Point(128, 9) Me._c1BarCode.Name = "_c1BarCode" Me._c1BarCode.Size = New System.Drawing.Size(75, 27) Me._c1BarCode.TabIndex = 2 Me._c1BarCode.Text = "c1BarCode1" Me._c1BarCode.Visible = False ' 'Form1 ' Me.AutoScaleBaseSize = New System.Drawing.Size(5, 15) Me.ClientSize = New System.Drawing.Size(224, 45) Me.Controls.Add(Me.button1) Me.Controls.Add(Me._c1BarCode) Me.Name = "Form1" Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen Me.Text = "C1QrCode" Me.ResumeLayout(False) End Sub #End Region Dim _dt As New DataTable() Dim _item As Integer Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load ' get some data for the report Dim sql As String = "select ProductID,ProductName from Products order by productid asc" Dim conn As String = GetConnectionString() Dim da As New OleDbDataAdapter(sql, conn) da.Fill(_dt) End Sub Private Sub button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles button1.Click ' create PrintDocument Dim printDoc As New PrintDocument() AddHandler printDoc.BeginPrint, New PrintEventHandler(AddressOf Me._beginPrint) AddHandler printDoc.PrintPage, New PrintPageEventHandler(AddressOf Me._printPage) ' show preview Dim dlg As New PrintPreviewDialog() dlg.Document = printDoc dlg.ShowDialog() End Sub Private Sub _beginPrint(ByVal sender As Object, ByVal e As PrintEventArgs) _item = 0 End Sub Private Sub _printPage(ByVal sender As Object, ByVal e As PrintPageEventArgs) Dim g As Graphics = e.Graphics Dim f As New Font("Tahoma", 12.0!) Dim rcPage As RectangleF = New RectangleF(e.MarginBounds.X, e.MarginBounds.Y, e.MarginBounds.Width, e.MarginBounds.Height) Dim rc1 As RectangleF = rcPage ' rc1.Height = 30 rc1.Width = 100 rc1.Height = 80 Dim rc2 As RectangleF = rc1 rc2.Offset(rc1.Width, 0) rc2.Width = 300 rc2.Height = 80 Dim rc3 As RectangleF = rc2 rc3.Offset(rc2.Width, 0) rc3.Width = 80 rc3.Height = 80 ' show header at the top of the page g.DrawString("Product ID", f, Brushes.Black, CType(rc1, RectangleF)) g.DrawString("Name", f, Brushes.Black, CType(rc2, RectangleF)) g.DrawString("Code", f, Brushes.Black, CType(rc3, RectangleF)) rc1.Y = (rc1.Y + 60) rc2.Y = (rc2.Y + 60) rc3.Y = (rc3.Y + 60) ' loop through rows until done (or until out of room) Do While ((rc1.Bottom <= rcPage.Bottom) AndAlso (Me._item < Me._dt.Rows.Count)) Dim row1 As DataRow = Me._dt.Rows.Item(_item) 'Dim text1 As String = String.Format("{0:0000}", row1.Item("ProductID")) Dim text1 As String = String.Format("{0:00000}", row1.Item(0)) ' Dim text2 As String = CType(row1.Item("ProductName"), String) Dim text2 As String = CType(row1.Item(1), String) g.DrawString(text1, f, Brushes.Black, CType(rc1, RectangleF)) g.DrawString(text2, f, Brushes.Black, CType(rc2, RectangleF)) Me._c1BarCode.Text = text1 g.DrawImage(Me._c1BarCode.Image, rc3) rc1.Y = (rc1.Y + (rc1.Height + 60)) rc2.Y = (rc2.Y + (rc2.Height + 60)) rc3.Y = (rc3.Y + (rc3.Height + 60)) Me._item += 1 Loop ' continue if necessary e.HasMorePages = (Me._item < (Me._dt.Rows.Count - 1)) End Sub Private Function GetConnectionString() As String Dim conn As String = "provider=microsoft.jet.oledb.4.0;data source=" & Application.StartupPath & "\Northwind.mdb" & "" Return conn End Function
vbnet Word.Application
Dim appWord As New Word.Application
Dim docWord As New Word.Document
docWord = appWord.Documents.Open(“C:\Infofarm\test.doc”)
Try
Dim myStoryRange As Microsoft.Office.Interop.Word.Range
For Each myStoryRange In docWord.StoryRanges
With myStoryRange.Find
.Text = “<-email->”
.Replacement.Text = “aaa@oooo.com”
.Wrap = Microsoft.Office.Interop.Word.WdFindWrap.wdFindContinue
.Execute(Replace:=Microsoft.Office.Interop.Word.WdReplace.wdReplaceAll)
End With
Next myStoryRange
docWord.Save()
appWord.Quit()
docWord = Nothing
appWord = Nothing
Catch ex As Exception
MsgBox(ex.Message)
End Try
vbnet dbf
參考1
參考2
參考3
DBF檔請先匯出成dbase IV 格式
Dim cnn As OleDb.OleDbConnection
cnn = New OleDb.OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\POLLYPRO\DATA\NSAMPLE;Extended Properties=DBASE IV;")
Dim da As New OleDbDataAdapter("Select * From test.DBF", cnn)
Dim ds As New DataSet
da.Fill(ds)
GridView1.DataSource = ds.Tables(0)
參考2
參考3
DBF檔請先匯出成dbase IV 格式
Dim cnn As OleDb.OleDbConnection
cnn = New OleDb.OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\POLLYPRO\DATA\NSAMPLE;Extended Properties=DBASE IV;")
Dim da As New OleDbDataAdapter("Select * From test.DBF", cnn)
Dim ds As New DataSet
da.Fill(ds)
GridView1.DataSource = ds.Tables(0)
2012年5月23日 星期三
2012年5月21日 星期一
KB2518864,KB2572073,KB2633880 Update
今天的 XP 更新是怎了?
都更新了也重開機了,還是一直出現要 update !?
-----------------
2012/5/23
當您的XP或windows 2003 出現這更新後,一直出現!
請選[自訂]後將此3個更新項目取消勾選後按確定(不再提示)
都更新了也重開機了,還是一直出現要 update !?
-----------------
2012/5/23
當您的XP或windows 2003 出現這更新後,一直出現!
請選[自訂]後將此3個更新項目取消勾選後按確定(不再提示)
vbnet 讀取 dbf、Excel、Access
引用來源
--
--
Imports System.Data.OleDb Public Class Form1Class Form1 Dim dbfconn As OleDb.OleDbConnection = New OleDb.OleDbConnection Private Sub Button1_Click()Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click 'dbf文件操作 'http://www.connectionstrings.com/?carrier=dbffoxpro Dim path, FileName As String Me.OpenFileDialog1.Title = "选择dbf文件" Me.OpenFileDialog1.Filter = "dbf文件|*.dbf" If Me.OpenFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then path = System.IO.Path.GetDirectoryName(OpenFileDialog1.FileName) FileName = System.IO.Path.GetFileName(OpenFileDialog1.FileName) FileName = Microsoft.VisualBasic.Left(FileName.ToUpper, FileName.Length - 4) Dim conn As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & path & ";Extended Properties=dBASE IV;User ID=Admin;Password=;" 'Dim conn As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=e: mp;Extended Properties=dBASE IV;User ID=Admin;Password=;" Dim dbfconn As OleDb.OleDbConnection = New OleDb.OleDbConnection dbfconn.ConnectionString = conn 'Dim cmd As String = "select * from w" Dim cmd As String = "select * from " & FileName Dim adapter As New OleDbDataAdapter(cmd, dbfconn) Dim topics As New DataSet adapter.Fill(topics) Me.DataGridView1.DataSource = topics.Tables(0) Me.DataGridView1.Refresh() End If End Sub Private Sub open_excel_Click()Sub open_excel_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles open_excel.Click Dim path, FileName, FileExname As String Dim conn As String Me.OpenFileDialog1.Title = "选择Excel文件" Me.OpenFileDialog1.Filter = "Excel 文件|*.xls*" If Me.OpenFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then path = System.IO.Path.GetFullPath(OpenFileDialog1.FileName) FileName = System.IO.Path.GetFileName(OpenFileDialog1.FileName) FileExname = System.IO.Path.GetExtension(OpenFileDialog1.FileName).ToUpper FileName = Microsoft.VisualBasic.Left(FileName.ToUpper, FileName.Length - 4) If FileExname = "XLSX" Then conn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & path & ";Extended Properties='Excel 8.0;HDR=Yes;IMEX=1';" Else conn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & path & ";Extended Properties='Excel 12.0;HDR=YES';" End If dbfconn.ConnectionString = conn '获取数据表列表 Dim table_list As Data.DataTable = GetSchemaTable(dbfconn, "TABLE") '在combbox列表控件中显示数据库中包含的数据表 Me.cb_table_list.DataSource = table_list.DefaultView Me.cb_table_list.ValueMember = "TABLE_NAME" Me.cb_table_list.DisplayMember = "TABLE_NAME" End If End Sub Private Function GetSchemaTable()Function GetSchemaTable(ByVal connection As Data.OleDb.OleDbConnection, ByVal Type As String) ' 获取数据表列表 'Type 有:"TABLE,VIEW,ACCESS TABLE,SYSTEM TABLE", Type = Type.ToUpper connection.Open() Dim table_list As Data.DataTable table_list = connection.GetOleDbSchemaTable(Data.OleDb.OleDbSchemaGuid.Tables, New Object() {Nothing, Nothing, Nothing, Type}) connection.Close() Return table_list End Function Private Sub table_list_SelectedIndexChanged()Sub table_list_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cb_table_list.SelectedIndexChanged ''获取数据表的内容 'MsgBox(Me.cb_table_list.SelectedValue) If Me.cb_table_list.SelectedValue.ToString <> "System.Data.DataRowView" Then Dim cmd As String = "select * from [" & Me.cb_table_list.SelectedValue.ToString & "]" Dim adapter As New OleDbDataAdapter(cmd, dbfconn) Dim topics As New DataSet adapter.Fill(topics) Me.DataGridView1.DataSource = topics.Tables(0) Me.DataGridView1.Refresh() End If End Sub Private Sub Open_Access_Click()Sub Open_Access_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Open_Access.Click Dim path, FileName, FileExname As String Dim conn As String Me.OpenFileDialog1.Title = "选择Access文件" Me.OpenFileDialog1.Filter = "Access 文件|*.mdb|Access 2007 文件|*.accdb" If Me.OpenFileDialog1.ShowDialog() = Windows.Forms.DialogResult.OK Then path = System.IO.Path.GetFullPath(OpenFileDialog1.FileName) FileName = System.IO.Path.GetFileName(OpenFileDialog1.FileName) FileExname = System.IO.Path.GetExtension(OpenFileDialog1.FileName).ToUpper FileName = Microsoft.VisualBasic.Left(FileName.ToUpper, FileName.Length - 4) If FileExname = "MDB" Then 'access 97 -2003 连接字符串 conn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & path & ";Jet OLEDB:Database Password=;" Else 'access 2007 连接字符串 conn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & path & ";Jet OLEDB:Database Password=MyDbPassword;" End If dbfconn.ConnectionString = conn '获取数据表列表 Dim table_list As Data.DataTable , = GetSchemaTable(dbfconn, "TABLE") Me.cb_table_list.DataSource = table_list.DefaultView Me.cb_table_list.ValueMember = "TABLE_NAME" Me.cb_table_list.DisplayMember = "TABLE_NAME" End If End Sub End Class
vb6 utf8 to ansi
根据反馈,代码已作修改并调试通过:
分二步:
一、建立一个模块,复制下面代码
Option Explicit
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Const CP_UTF8 = 65001
'读文件至变量
Private Function GetFile(FileName As String) As String
Dim i As Integer, BB() As Byte
If Dir(FileName) = "" Then Exit Function
i = FreeFile
ReDim BB(FileLen(FileName) - 1)
Open FileName For Binary As #i
Get #i, , BB
Close #i
GetFile = BB
End Function
'功能: 把Utf8字符转化成ANSI字符
Public Function UTF8_Decode(FileName As String) As String
Dim sUTF8 As String
Dim lngUtf8Size As Long
Dim strBuffer As String
Dim lngBufferSize As Long
Dim lngResult As Long
Dim bytUtf8() As Byte
Dim n As Long
sUTF8 = GetFile(FileName)
If LenB(sUTF8) = 0 Then Exit Function
On Error GoTo EndFunction
bytUtf8 = sUTF8
lngUtf8Size = UBound(bytUtf8) + 1
lngBufferSize = lngUtf8Size * 2
strBuffer = String$(lngBufferSize, vbNullChar)
lngResult = MultiByteToWideChar(CP_UTF8, 0, bytUtf8(0), _
lngUtf8Size, StrPtr(strBuffer), lngBufferSize)
If lngResult Then
UTF8_Decode = Left(strBuffer, lngResult)
End If
EndFunction:
End Function
二、调用举例:
如果你想把一个"c:\1.txt"的UTF-8文件转换为ANSI编码,可这样调用
dim s as string
s=UTF8_Decode("c:\1.txt") '文件名请根据实际修改
此时,s存放的就是ANSI格式编码了,不会出现乱码问题
VB6 uft8 轉 gb2312
'函数名:UrlEncoding
'作 用:转换编码
'===============================================
Function UrlEncoding(DataStr)
Dim StrReturn,Si,ThisChr,InnerCode,Hight8,Low8
StrReturn = ""
For Si = 1 To Len(DataStr)
ThisChr = Mid(DataStr,Si,1)
If Abs(Asc(ThisChr)) < &HFF Then
StrReturn = StrReturn & ThisChr
Else
InnerCode = Asc(ThisChr)
If InnerCode < 0 Then
InnerCode = InnerCode + &H10000
End If
Hight8 = (InnerCode And &HFF00)\ &HFF
Low8 = InnerCode And &HFF
StrReturn = StrReturn & "%" & Hex(Hight8) & "%" & Hex(Low8)
End If
Next
UrlEncoding = StrReturn
End Function
2012年5月19日 星期六
如何使用VB判斷SQL中某欄位是否存在
sql="select * from tablename"
rs.Open sql, conn, adOpenStatic, adLockOptimistic
for i=0 to rs.Fields.Count-1
If rs(i).Name="你想要尋找的欄位名稱" Then
MsgBox "欄位有找到!"
End If
Next i
2012年5月16日 星期三
2012年5月15日 星期二
2012年5月14日 星期一
2012年5月12日 星期六
Win32_NetworkAdapterConfiguration
SELECT * FROM Win32_NetworkAdapterConfiguration
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim mc As System.Management.ManagementClass
Dim mo As ManagementObject
mc = New ManagementClass("Win32_NetworkAdapterConfiguration")
Dim moc As ManagementObjectCollection = mc.GetInstances()
For Each mo In moc
If mo.Item("IPEnabled") = True Then
ListBox1.Items.Add("MAC address " & mo.Item("MacAddress").ToString())
ListBox1.Items.Add("MAC address " & mo.Item("IPEnabled").ToString())
End If
Next
End Sub
vbnet 組合鍵
Private Sub Form1_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
If e.Shift And e.KeyCode = Keys.C Then
Button1_Click(sender, e)
End If
End Sub
2012年5月11日 星期五
64位系统下,利用c#获取ipv4的DNS
inPar = null; outPar = null; mc = new ManagementClass("Win32_NetworkAdapterConfiguration"); moc = mc.GetInstances(); foreach (ManagementObject mo in moc) { if (Convert.ToBoolean(mo["ipEnabled"])) { // 獲取Ip,子網掩碼,網關 ipAddress = (mo["IPAddress"] as string[])[0]; ipSubNet = (mo["IPSubnet"] as string[])[0]; ipGateway = (mo["DefaultIPGateway"] as string[])[0]; // 判斷DNS數量,並取值 int dnsCount = (mo["DNSServerSearchOrder"] as string[]).Length; if (dnsCount > 0) { firstDns = (mo["DNSServerSearchOrder"] as string[])[0]; } if (dnsCount > 1) { secondDns = (mo["DNSServerSearchOrder"] as string[])[1]; } break; } }
================================================================================================
獲取本機ip本來是很容易的,IPAddress _ip = Dns.GetHostAddresses(Dns.GetHostName())[0];就行了
但是在vista win7等系統裡面這樣獲得的是ipv6地址,另外有多張網卡的時候問題就更複雜了
以前我都是根據自己的ip修改數組的下標,不過那樣畢竟不是好的辦法,用AddressFamily來判斷更好
以下是我自己查msdn寫出來的,思路就是先用GetHostAddresses獲得所有ip地址,然後找出ipv4地址,儲存在StringCollection裡面。當然如果只是想獲取第一個ip就不用寫這麼麻煩。
using System;
using System.Text;
using System.Windows.Forms;
using System.Net;
using System.Net.Sockets;
using System.Collections.Specialized;
namespace GetIpv4Test
{
public partial class Form1 : Form
{
public Form1()
{
InitializeComponent();
ShowIP();
}
void ShowIP()
{
//ipv4地址也可能不止一個
foreach(string ip in GetLocalIpv4())
{
this.richTextBoxIPv4.AppendText(ip.ToString());
}
return;
}
string[] GetLocalIpv4()
{
//事先不知道ip的個數,數組長度未知,因此用StringCollection儲存
try
{
IPAddress[] localIPs;
localIPs = Dns.GetHostAddresses(Dns.GetHostName());
StringCollection IpCollection = new StringCollection();
foreach (IPAddress ip in localIPs)
{
//根據AddressFamily判斷是否為ipv4,如果是InterNetWork則為ipv6
if (ip.AddressFamily == AddressFamily.InterNetwork)
IpCollection.Add(ip.ToString());
}
string[] IpArray = new string[IpCollection.Count];
IpCollection.CopyTo(IpArray, 0);
return IpArray;
}
catch (Exception ex)
{
MessageBox.Show("Error: " + ex.Message);
}
return null;
}
}
如何讓panel中的捲軸能夠用滑鼠滾輪控制
如下所示,該怎麼讓滑鼠中間滾輪能捲動畫面?謝謝大大。
Public Class Form1
Dim obj() As PictureBox
Dim objlabel() As Label
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
ReDim obj(23)
ReDim objlabel(23)
Panel1.AutoScroll = True
For i As Integer = 0 To 3
For j As Integer = 0 To 5
Dim n As Integer = i * 6 + j
obj(n) = New PictureBox
obj(n).Location = New Point(20 + i * 152, 20 + j * 130)
obj(n).BorderStyle = BorderStyle.Fixed3D
obj(n).Size = New Size(132, 100)
objlabel(n) = New Label
objlabel(n).Text = "Label" & CStr(n)
objlabel(n).Location = New Point(20 + i * 152, 120 + j * 130)
objlabel(n).TextAlign = ContentAlignment.MiddleCenter
objlabel(n).BorderStyle = BorderStyle.FixedSingle
objlabel(n).Size = New Size(132, 20)
Panel1.Controls.Add(obj(n))
Panel1.Controls.Add(objlabel(n))
Next
Next
End Sub
End Class
Answer:
測試看看在Form的MouseWheel事件中加入以下程式碼看看能否達到您的需求,目前測試看起來panel收不到MouseWheel事件,詳細部分要再找資料看看
Private Sub Form1_MouseWheel(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseWheel
Panel1.AutoScrollPosition = New Point(0, Panel1.VerticalScroll.Value + Not e.Delta)
End Sub
2012年5月10日 星期四
ms-sql try catch 練丹
TRY...CATCH (Transact-SQL)
--
--練丹1
begin try
select 1/0
end try
begin catch
select
ERROR_NUMBER() AS ErrorNumber
,ERROR_SEVERITY() AS ErrorSeverity
,ERROR_STATE() AS ErrorState
,ERROR_PROCEDURE() AS ErrorProcedure
,ERROR_LINE() AS ErrorLine
,ERROR_MESSAGE() AS ErrorMessage
end catch
--練丹2
begin transaction
declare @tcount int
set @tcount=0
begin try
set @tcount+=1
select * from books
select 1/0
end try
begin catch
select
ERROR_NUMBER() AS ErrorNumber
,ERROR_SEVERITY() AS ErrorSeverity
,ERROR_STATE() AS ErrorState
,ERROR_PROCEDURE() AS ErrorProcedure
,ERROR_LINE() AS ErrorLine
,ERROR_MESSAGE() AS ErrorMessage
--if @tcount>1
set @tcount=0
rollback transaction
end catch
if @tcount >1
begin
commit transaction
end
--
--練丹1
begin try
select 1/0
end try
begin catch
select
ERROR_NUMBER() AS ErrorNumber
,ERROR_SEVERITY() AS ErrorSeverity
,ERROR_STATE() AS ErrorState
,ERROR_PROCEDURE() AS ErrorProcedure
,ERROR_LINE() AS ErrorLine
,ERROR_MESSAGE() AS ErrorMessage
end catch
--練丹2
begin transaction
declare @tcount int
set @tcount=0
begin try
set @tcount+=1
select * from books
select 1/0
end try
begin catch
select
ERROR_NUMBER() AS ErrorNumber
,ERROR_SEVERITY() AS ErrorSeverity
,ERROR_STATE() AS ErrorState
,ERROR_PROCEDURE() AS ErrorProcedure
,ERROR_LINE() AS ErrorLine
,ERROR_MESSAGE() AS ErrorMessage
--if @tcount>1
set @tcount=0
rollback transaction
end catch
if @tcount >1
begin
commit transaction
end
MS SQL TRY CATCH
參考:
Handling Errors With SQL Server 2005's TRY...CATCH Blocks
TRY CATCH 陳述式
用法:
BEGIN TRY
Try Statement 1
Try Statement 2
...
Try Statement M
END TRY
BEGIN CATCH
Catch Statement 1
Catch Statement 2
...
Catch Statement N
END CATCH
Take a look at below example,
BEGIN TRY
SELECT GETDATE()
SELECT 1/0--Evergreen divide by zero example!
END TRY
BEGIN CATCH
SELECT 'There was an error! ' + ERROR_MESSAGE()
RETURN
END CATCH;
Handling Errors With SQL Server 2005's TRY...CATCH Blocks
TRY CATCH 陳述式
用法:
BEGIN TRY
Try Statement 1
Try Statement 2
...
Try Statement M
END TRY
BEGIN CATCH
Catch Statement 1
Catch Statement 2
...
Catch Statement N
END CATCH
Take a look at below example,
BEGIN TRY
SELECT GETDATE()
SELECT 1/0--Evergreen divide by zero example!
END TRY
BEGIN CATCH
SELECT 'There was an error! ' + ERROR_MESSAGE()
RETURN
END CATCH;
交易在鎖定資源上被另一個處理序鎖死
SQL Deadlock 的處理經驗談
KB-Catch Deadlock Event in SQL 2005
淺談偵測「死結(DeadLock)」的作法,以使用「追蹤旗標(Trace flag)」1204、1222為例
--
我現遇到的是:
交易 (處理序識別碼 1050) 在 鎖定 資源上被另一個處理序鎖死並已被選擇作為死結的犧牲者。請重新執行該交易。
參考了第一篇:
看起來是同步處理一條命令所造成鎖死 !
參考了第三篇:
看起來是釋放的時間差(在相交叉範圍內{同步})
以上應均是"同時間內" 造成的
KB-Catch Deadlock Event in SQL 2005
淺談偵測「死結(DeadLock)」的作法,以使用「追蹤旗標(Trace flag)」1204、1222為例
--
我現遇到的是:
交易 (處理序識別碼 1050) 在 鎖定 資源上被另一個處理序鎖死並已被選擇作為死結的犧牲者。請重新執行該交易。
參考了第一篇:
看起來是同步處理一條命令所造成鎖死 !
參考了第三篇:
看起來是釋放的時間差(在相交叉範圍內{同步})
以上應均是"同時間內" 造成的
C# Form內的物件要如何等比放大
參考引用
--
--
private void Form1_Load(object sender, EventArgs e) { this.Tag = this.Height + "|" + this.Width; foreach (Control o in this.Controls) { o.Tag = o.Top + "|" + o.Left + "|" + o.Height + "|" + o.Width; } } private void Form1_Resize(object sender, EventArgs e) { foreach (Control o in this.Controls) { o.Width =(int)(double.Parse(o.Tag.ToString().Split('|')[3]) * (this.Width / double.Parse(this.Tag.ToString().Split('|')[1]))); o.Height =(int)(double.Parse(o.Tag.ToString().Split('|')[2]) * (this.Height / double.Parse(this.Tag.ToString().Split('|')[0]))); o.Left =(int)(double.Parse(o.Tag.ToString().Split('|')[1]) * (this.Width / double.Parse(this.Tag.ToString().Split('|')[1]))); o.Top =(int)(double.Parse(o.Tag.ToString().Split('|')[0]) * (this.Height / double.Parse(this.Tag.ToString().Split('|')[0]))); } }
取得螢幕解析度與工作區域大小
以vb.net 2005 為範例
一、取得螢幕解析度
Dim Screen_X
Dim Screen_Y
Screen_X= Screen.PrimaryScreen Screen.PrimarBounds.Width
Screen_Y= Screen.PrimaryScreen Screen.PrimarBounds.Height
MessageBox.Show("螢幕解析度" & Screen_X & "X" & Screen_Y)
二、取得工作區域大小(桌面大小)
Dim workarea_Hight As Integer
Dim workerarea_width As Integer
workarea_Hight = Screen.PrimaryScreen.WorkingArea.Width
workerarea_width = Screen.PrimaryScreen.WorkingArea.Height
MessageBox.Show("工作區域大小" & workerarea_width & "X" & workarea_Hight)
窗体的控件随窗体变化自动调整大小
在程序的使用中,如果用户点击最大化或调整窗体的时候,窗体的控件依然不变化,非常不好看,所以我将这段源码贴上,供参考!
非常方便!
Option Explicit
Private ObjOldWidth As Long '保存窗体的原始宽度
Private ObjOldHeight As Long '保存窗体的原始高度
Private ObjOldFont As Single '保存窗体的原始字体比
'在调用ResizeForm前先调用本函数
Public Sub ResizeInit(FormName As Form)
Dim Obj As Control
ObjOldWidth = FormName.ScaleWidth
ObjOldHeight = FormName.ScaleHeight
ObjOldFont = FormName.Font.Size / ObjOldHeight
On Error Resume Next
For Each Obj In FormName
Obj.Tag = Obj.Left & " " & Obj.Top & " " & Obj.Width & " " & Obj.Height & " "
Next Obj
On Error GoTo 0
End Sub
'按比例改变表单内各元件的大小,
'在调用ReSizeForm前先调用ReSizeInit函数
Public Sub ResizeForm(FormName As Form)
Dim Pos(4) As Double
Dim i As Long, TempPos As Long, StartPos As Long
Dim Obj As Control
Dim ScaleX As Double, ScaleY As Double
ScaleX = FormName.ScaleWidth / ObjOldWidth
'保存窗体宽度缩放比例
ScaleY = FormName.ScaleHeight / ObjOldHeight
'保存窗体高度缩放比例
On Error Resume Next
For Each Obj In FormName
StartPos = 1
For i = 0 To 4
'读取控件的原始位置与大小
TempPos = InStr(StartPos, Obj.Tag, " ", vbTextCompare)
If TempPos > 0 Then
Pos(i) = Mid(Obj.Tag, StartPos, TempPos - StartPos)
StartPos = TempPos + 1
Else
Pos(i) = 0
End If
'根据控件的原始位置及窗体改变大
'小的比例对控件重新定位与改变大小
Obj.Move Pos(0) * ScaleX, Pos(1) * ScaleY, Pos(2) * ScaleX, Pos(3) * ScaleY
Obj.Font.Size = ObjOldFont * FormName.ScaleHeight
Next i
Next Obj
On Error GoTo 0
End Sub
Private Sub Form_Resize()
'确保窗体改变时控件随之改变
Call ResizeForm(Me)
End Sub
Private Sub Form_Load()
'在程序装入时必须加入
Call ResizeInit(Me)
End Sub
VB.Net 動態生成子控制(Button,TextBox)
參考來源
動態生成子控制不是問題,重點是怎麼把對應的函式自動加進去。
範例一 - 動態生成 TextBox
Public Class Form
' 動態生成 TextBox
Private Sub Form_Shown(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Shown
Dim myTextBox As TextBox
' const declare
Const x0 As Int32 = 20
Const y0 As Int32 = 20
Const w As Int32 = 100
Const h As Int32 = 30
Const hd As Int32 = 10
Const cnt As Int32 = 4
Dim i As Int32 = 0
' 動態生成 TextBox
For i = 0 To cnt - 1
myTextBox = New TextBox()
myTextBox.Text = "button" & i
myTextBox.Left = x0
myTextBox.Top = y0 + i * (h + hd)
myTextBox.Width = w
myTextBox.Height = h
Me.Controls.Add(myTextBox)
AddHandler myTextBox.Click, AddressOf myTextBoxClick ' 交附給函式
Next
End Sub
Private Sub myTextBoxClick(ByVal sender As Object, ByVal e As System.EventArgs)
System.Windows.Forms.MessageBox.Show(CType(sender, TextBox).Text)
End Sub
End Class
範例二 - 動態生成 Button (1)
初版的動態生成 Button 缺點不少,這裡是將 myButton 使用動態陣列,每個陣列名字都長得差不多,另外對應函式是用一個一個 map 起來的。原始碼如下
Public Class Form
' 動態生成按扭
Private myButton() As Button
Private Sub Form_Shown(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Shown
' const declare
Const x0 As Int32 = 20
Const y0 As Int32 = 20
Const w As Int32 = 100
Const h As Int32 = 30
Const hd As Int32 = 10
Const cnt As Int32 = 4
Dim i As Int32 = 0
ReDim myButton(cnt)
' 動態生成 button
For i = 0 To cnt - 1
myButton(i) = New Button()
myButton(i).Text = "button" & i
myButton(i).Left = x0
myButton(i).Top = y0 + i * (h + hd)
myButton(i).Width = w
myButton(i).Height = h
Me.Controls.Add(myButton(i))
Next
' 進行函式對應
AddHandler myButton(0).Click, AddressOf Func0
AddHandler myButton(1).Click, AddressOf Func1
AddHandler myButton(2).Click, AddressOf Func2
AddHandler myButton(3).Click, AddressOf Func3
End Sub
Sub Func0()
MsgBox("func0")
End Sub
Sub Func1()
MsgBox("func1")
End Sub
Sub Func2()
MsgBox("func2")
End Sub
Sub Func3()
MsgBox("func3")
End Sub
End Class
範例三 - 動態生成 Button (2)
第二版動態生成按鈕改善了一點點,由於這幾顆按鈕做的事都一樣,所以便用委派方式給同一個函式執行,但實際上效果並不彰。
Public Class Form
' 動態生成按扭
Private myButton() As Button
Private Sub Form_Shown(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Shown
' const declare
Const x0 As Int32 = 20
Const y0 As Int32 = 20
Const w As Int32 = 100
Const h As Int32 = 30
Const hd As Int32 = 10
Const cnt As Int32 = 4
Dim i As Int32 = 0
ReDim myButton(cnt)
' 動態生成 button
For i = 0 To cnt - 1
myButton(i) = New Button()
myButton(i).Text = "button" & i
myButton(i).Left = x0
myButton(i).Top = y0 + i * (h + hd)
myButton(i).Width = w
myButton(i).Height = h
Me.Controls.Add(myButton(i))
AddHandler myButton(i).Click, AddressOf myButtonClick
Next
End Sub
' 委派函式
Private Sub myButtonClick(ByVal sender As Object, ByVal e As System.EventArgs)
System.Windows.Forms.MessageBox.Show(CType(sender, Button).Text)
End Sub
End Class
範例四 - 動態生成 Button (3)
第三版動態生成按鈕改善了二個部份,我們可以借由自己寫的函式,把 Button Name 一次全換掉;除此之外,事實上 myButton 可以不用 array 方式建立,同時也可以不用宣告到全域。
注意的是那個 SetButtonName,它的引數記得是放 string,不要直接傳 Button 實體進去,傳 Button 實體進去的話,做法就要等 Button 全都建完之後才可以去呼叫 SetButtonName,效率不彰。
Public Class Form
' 動態生成按扭
' 設定按鈕名稱
Private Sub SetButtonName(ByRef btnName() as String, ByVal ParamArray Name() As String)
For i As Int32 = 0 To UBound(btnName) - 1
btnName(i) = Name(i)
Next i
End Sub
Private Sub Form_Shown(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Shown
Dim btnName() As String
' const declare
Const x0 As Int32 = 20
Const y0 As Int32 = 20
Const w As Int32 = 100
Const h As Int32 = 30
Const hd As Int32 = 10
Const cnt As Int32 = 4
Dim i As Int32 = 0
Dim myButton As Button
ReDim btnName(cnt)
SetButtonName(btnName, "OK", "ERROR", "WARNNING", "RETRY")
' 動態生成 button
For i = 0 To cnt - 1
myButton = New Button()
myButton.Text = btnName(i)
myButton.Left = x0
myButton.Top = y0 + i * (h + hd)
myButton.Width = w
myButton.Height = h
Me.Controls.Add(myButton)
AddHandler myButton.click, AddressOf myButtonClick
Next
End Sub
Private Sub myButtonClick(ByVal sender As Object, ByVal e As System.EventArgs)
System.Windows.Forms.MessageBox.Show(CType(sender, Button).Text)
End Sub
End Class
總結
動態生成子控制大致上就像上述那樣,這裡提醒的是,如果每個 Button 實際上做的動態差很多,可以考慮把 myButton 宣告成陣列型態(這不是必然,不是用陣列去做時到時 mapping 會比較清楚、簡單),接著再手動去寫一份 map,至於 Rename 部份仍可以在建立實際 Button 時進行。最後結束前,再給最後一個範例,說明建立四個 button,名稱差很多,處理的東西也差很多,寫出來會是怎樣。
Public Class Form
' 動態生成按扭
Private Sub SetButtonName(ByRef btnName() As String, ByVal ParamArray Name() As String)
For i As Int32 = 0 To UBound(btnName) - 1
btnName(i) = Name(i)
Next i
End Sub
Private Sub Form_Shown(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Shown
Dim BtnName() As String
' const declare
Const x0 As Int32 = 20
Const y0 As Int32 = 20
Const w As Int32 = 100
Const h As Int32 = 30
Const hd As Int32 = 10
Const cnt As Int32 = 4
Dim i As Int32 = 0
Dim myButton As Button
ReDim BtnName(cnt)
SetButtonName(BtnName, "OK", "ERROR", "WARNNING", "RETRY")
' 動態生成 button
For i = 0 To cnt - 1
myButton = New Button()
myButton.Text = BtnName(i)
myButton.Name = "btn_" & i ' 注意,這裡視為是 button ID, 不是 button text
myButton.Left = x0
myButton.Top = y0 + i * (h + hd)
myButton.Width = w
myButton.Height = h
Me.Controls.Add(myButton)
AddHandler myButton.Click, AddressOf myButtonClick
Next
End Sub
Dim btnIndex As Int32
Private Sub myButtonClick(ByVal sender As Object, ByVal e As System.EventArgs)
' 取得是由哪個 button ID 發出來的訊息
btnIndex = Val(CType(sender, Button).Name.Split("_")(1))
' 根據發出來的 button ID 做相對應的 function map,這部份比較麻煩
Select Case btnIndex
Case 0
Func0()
Case 1
Func1()
Case 2
Func2()
Case 3
Func3()
End Select
End Sub
Public Sub Func0()
MsgBox("func0")
End Sub
Public Sub Func1()
MsgBox("func1")
End Sub
Public Sub Func2()
MsgBox("func2")
End Sub
Public Sub Func3()
MsgBox("func3")
End Sub
Public Sub Func4()
MsgBox("func4")
End Sub
End Class
動態生成子控制不是問題,重點是怎麼把對應的函式自動加進去。
範例一 - 動態生成 TextBox
Public Class Form
' 動態生成 TextBox
Private Sub Form_Shown(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Shown
Dim myTextBox As TextBox
' const declare
Const x0 As Int32 = 20
Const y0 As Int32 = 20
Const w As Int32 = 100
Const h As Int32 = 30
Const hd As Int32 = 10
Const cnt As Int32 = 4
Dim i As Int32 = 0
' 動態生成 TextBox
For i = 0 To cnt - 1
myTextBox = New TextBox()
myTextBox.Text = "button" & i
myTextBox.Left = x0
myTextBox.Top = y0 + i * (h + hd)
myTextBox.Width = w
myTextBox.Height = h
Me.Controls.Add(myTextBox)
AddHandler myTextBox.Click, AddressOf myTextBoxClick ' 交附給函式
Next
End Sub
Private Sub myTextBoxClick(ByVal sender As Object, ByVal e As System.EventArgs)
System.Windows.Forms.MessageBox.Show(CType(sender, TextBox).Text)
End Sub
End Class
範例二 - 動態生成 Button (1)
初版的動態生成 Button 缺點不少,這裡是將 myButton 使用動態陣列,每個陣列名字都長得差不多,另外對應函式是用一個一個 map 起來的。原始碼如下
Public Class Form
' 動態生成按扭
Private myButton() As Button
Private Sub Form_Shown(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Shown
' const declare
Const x0 As Int32 = 20
Const y0 As Int32 = 20
Const w As Int32 = 100
Const h As Int32 = 30
Const hd As Int32 = 10
Const cnt As Int32 = 4
Dim i As Int32 = 0
ReDim myButton(cnt)
' 動態生成 button
For i = 0 To cnt - 1
myButton(i) = New Button()
myButton(i).Text = "button" & i
myButton(i).Left = x0
myButton(i).Top = y0 + i * (h + hd)
myButton(i).Width = w
myButton(i).Height = h
Me.Controls.Add(myButton(i))
Next
' 進行函式對應
AddHandler myButton(0).Click, AddressOf Func0
AddHandler myButton(1).Click, AddressOf Func1
AddHandler myButton(2).Click, AddressOf Func2
AddHandler myButton(3).Click, AddressOf Func3
End Sub
Sub Func0()
MsgBox("func0")
End Sub
Sub Func1()
MsgBox("func1")
End Sub
Sub Func2()
MsgBox("func2")
End Sub
Sub Func3()
MsgBox("func3")
End Sub
End Class
範例三 - 動態生成 Button (2)
第二版動態生成按鈕改善了一點點,由於這幾顆按鈕做的事都一樣,所以便用委派方式給同一個函式執行,但實際上效果並不彰。
Public Class Form
' 動態生成按扭
Private myButton() As Button
Private Sub Form_Shown(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Shown
' const declare
Const x0 As Int32 = 20
Const y0 As Int32 = 20
Const w As Int32 = 100
Const h As Int32 = 30
Const hd As Int32 = 10
Const cnt As Int32 = 4
Dim i As Int32 = 0
ReDim myButton(cnt)
' 動態生成 button
For i = 0 To cnt - 1
myButton(i) = New Button()
myButton(i).Text = "button" & i
myButton(i).Left = x0
myButton(i).Top = y0 + i * (h + hd)
myButton(i).Width = w
myButton(i).Height = h
Me.Controls.Add(myButton(i))
AddHandler myButton(i).Click, AddressOf myButtonClick
Next
End Sub
' 委派函式
Private Sub myButtonClick(ByVal sender As Object, ByVal e As System.EventArgs)
System.Windows.Forms.MessageBox.Show(CType(sender, Button).Text)
End Sub
End Class
範例四 - 動態生成 Button (3)
第三版動態生成按鈕改善了二個部份,我們可以借由自己寫的函式,把 Button Name 一次全換掉;除此之外,事實上 myButton 可以不用 array 方式建立,同時也可以不用宣告到全域。
注意的是那個 SetButtonName,它的引數記得是放 string,不要直接傳 Button 實體進去,傳 Button 實體進去的話,做法就要等 Button 全都建完之後才可以去呼叫 SetButtonName,效率不彰。
Public Class Form
' 動態生成按扭
' 設定按鈕名稱
Private Sub SetButtonName(ByRef btnName() as String, ByVal ParamArray Name() As String)
For i As Int32 = 0 To UBound(btnName) - 1
btnName(i) = Name(i)
Next i
End Sub
Private Sub Form_Shown(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Shown
Dim btnName() As String
' const declare
Const x0 As Int32 = 20
Const y0 As Int32 = 20
Const w As Int32 = 100
Const h As Int32 = 30
Const hd As Int32 = 10
Const cnt As Int32 = 4
Dim i As Int32 = 0
Dim myButton As Button
ReDim btnName(cnt)
SetButtonName(btnName, "OK", "ERROR", "WARNNING", "RETRY")
' 動態生成 button
For i = 0 To cnt - 1
myButton = New Button()
myButton.Text = btnName(i)
myButton.Left = x0
myButton.Top = y0 + i * (h + hd)
myButton.Width = w
myButton.Height = h
Me.Controls.Add(myButton)
AddHandler myButton.click, AddressOf myButtonClick
Next
End Sub
Private Sub myButtonClick(ByVal sender As Object, ByVal e As System.EventArgs)
System.Windows.Forms.MessageBox.Show(CType(sender, Button).Text)
End Sub
End Class
總結
動態生成子控制大致上就像上述那樣,這裡提醒的是,如果每個 Button 實際上做的動態差很多,可以考慮把 myButton 宣告成陣列型態(這不是必然,不是用陣列去做時到時 mapping 會比較清楚、簡單),接著再手動去寫一份 map,至於 Rename 部份仍可以在建立實際 Button 時進行。最後結束前,再給最後一個範例,說明建立四個 button,名稱差很多,處理的東西也差很多,寫出來會是怎樣。
Public Class Form
' 動態生成按扭
Private Sub SetButtonName(ByRef btnName() As String, ByVal ParamArray Name() As String)
For i As Int32 = 0 To UBound(btnName) - 1
btnName(i) = Name(i)
Next i
End Sub
Private Sub Form_Shown(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Shown
Dim BtnName() As String
' const declare
Const x0 As Int32 = 20
Const y0 As Int32 = 20
Const w As Int32 = 100
Const h As Int32 = 30
Const hd As Int32 = 10
Const cnt As Int32 = 4
Dim i As Int32 = 0
Dim myButton As Button
ReDim BtnName(cnt)
SetButtonName(BtnName, "OK", "ERROR", "WARNNING", "RETRY")
' 動態生成 button
For i = 0 To cnt - 1
myButton = New Button()
myButton.Text = BtnName(i)
myButton.Name = "btn_" & i ' 注意,這裡視為是 button ID, 不是 button text
myButton.Left = x0
myButton.Top = y0 + i * (h + hd)
myButton.Width = w
myButton.Height = h
Me.Controls.Add(myButton)
AddHandler myButton.Click, AddressOf myButtonClick
Next
End Sub
Dim btnIndex As Int32
Private Sub myButtonClick(ByVal sender As Object, ByVal e As System.EventArgs)
' 取得是由哪個 button ID 發出來的訊息
btnIndex = Val(CType(sender, Button).Name.Split("_")(1))
' 根據發出來的 button ID 做相對應的 function map,這部份比較麻煩
Select Case btnIndex
Case 0
Func0()
Case 1
Func1()
Case 2
Func2()
Case 3
Func3()
End Select
End Sub
Public Sub Func0()
MsgBox("func0")
End Sub
Public Sub Func1()
MsgBox("func1")
End Sub
Public Sub Func2()
MsgBox("func2")
End Sub
Public Sub Func3()
MsgBox("func3")
End Sub
Public Sub Func4()
MsgBox("func4")
End Sub
End Class
2012年5月9日 星期三
nvarchar 與 sysmane
當為了讓sql 支援 unicode , 開型態為 nvarchar
在查 table 欄位值,卻會多一個 sysname 的隱藏欄位
以前均未發現有此一處理模式
這會造成開發在自動取欄位時,發生無法和實體運作的欄位相對應
還是放棄這 nvarchar 的念頭..
在查 table 欄位值,卻會多一個 sysname 的隱藏欄位
以前均未發現有此一處理模式
這會造成開發在自動取欄位時,發生無法和實體運作的欄位相對應
還是放棄這 nvarchar 的念頭..
2012年5月8日 星期二
vb.net Application.AddMessageFilter
Visual Basic複製程式碼
' Creates a message filter.
_
Public Class TestMessageFilter
Implements IMessageFilter
_
Public Function PreFilterMessage(ByRef m As System.Windows.Forms.Message) _
As Boolean Implements IMessageFilter.PreFilterMessage
' Blocks all the messages relating to the left mouse button.
If ((m.Msg >= 513) And (m.Msg <= 515)) Then
Console.WriteLine("Processing the messages : " & m.Msg)
Return True
End If
Return False
End Function
End Class
informix 匯出資料庫
dbschema -d yohomis -t rfid_card_m -ss rfid_card_m.sql2
匯出yohomis 裡的 rfid_card_m 到 rfid_card_m.sql2文字檔內
vi rfid_card_m.sql2
編輯 rfid_card_m.sql2 文字檔
dd 刪行
u 回復
yy 複製
p 貼上
x 刪字
vb.net 輸入pn300 ( ScanCode ) (模擬輸入)
'API 宣告
Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Integer
Dim SCode As Integer
V_caps_lock_stats = My.Computer.Keyboard.CapsLock '是否按下caps lock
For Ii = 1 To V_data1.Length
tmp_str = Mid(V_data1, Ii, 1) '第幾個字
SCode = MapVirtualKey(Asc(tmp_str), 0) '找出scane code
If V_caps_lock_stats = False Then
keybd_event(&H14, 0, &H0, 0) 'caps lockey down
keybd_event(&H14, 0, &H2, 0)
End If
keybd_event(Asc(tmp_str), SCode, 0, 0) '送出字串以及scan code
keybd_event(Asc(tmp_str), SCode, 2, 0) '
If V_caps_lock_stats = False Then '
keybd_event(&H14, 0, &H0, 0) 'caps lockey down
keybd_event(&H14, 0, &H2, 0) '
End If
Next
'For Ii = 1 To 200
' Threading.Thread.Sleep(1)
' Application.DoEvents()
'Next
keybd_event(13, MapVirtualKey(13, 0), &H0, 0) 'enter lockey down
keybd_event(13, MapVirtualKey(13, 0), &H2, 0)
vb.net 播放音樂
Public Class Form1
' 宣告 API
Private Declare Function mciSendStringA Lib "winmm.dll" _
(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
ByVal uReturnLength As Integer, ByVal hwndCallback As Integer) As Integer
Private Sub Button1_Click(ByVal s As Object, ByVal e As EventArgs) Handles Button1.Click
PlayMidiFile("C:\死了都要愛.mp3") ' 播放 MP3 音樂
'或
'PlayMidiFile("C:\頑皮豹.mid") ' 播放 MIDI 音樂
End Sub
Private Sub Button2_Click(ByVal s As Object, ByVal e As EventArgs) Handles Button2.Click
StopMidi() ' 停止播放
End Sub
Private Sub Button3_Click(ByVal s As Object, ByVal e As EventArgs) Handles Button3.Click
PauseMidi() ' 暫停播放
End Sub
Private Sub Button4_Click(ByVal s As Object, ByVal e As EventArgs) Handles Button4.Click
ContinueMidi() ' 繼續播放
End Sub
Private Function PlayMidiFile(ByVal MusicFile As String) As Boolean
If System.IO.File.Exists(MusicFile) Then
mciSendStringA("stop music", "", 0, 0)
mciSendStringA("close music", "", 0, 0)
mciSendStringA("open " & MusicFile & " alias music", "", 0, 0)
PlayMidiFile = mciSendStringA("play music", "", 0, 0) = 0
End If
End Function
Private Function StopMidi() As Boolean
StopMidi = mciSendStringA("stop music", "", 0, 0) = 0
mciSendStringA("close music", "", 0, 0)
End Function
Private Function PauseMidi() As Boolean
Return mciSendStringA("pause music", "", 0, 0) = 0
End Function
Private Function ContinueMidi() As Boolean
Return mciSendStringA("play music", "", 0, 0) = 0
End Function
End Class
vb.net動態設定活頁(TagPage)
'裝載活頁Tag
Private SavePages As New ArrayList
Dim Ii As Integer
'權限設定
For i As Integer = 0 To TabControl1.TabPages.Count - 1
SavePages.Add(TabControl1.TabPages(i))
Next
'全關
For ii = TabControl1.TabPages.Count - 1 To 0 Step -1
TabControl1.TabPages.RemoveAt(ii)
Next
'只顯示第一個跟最後一個
TabControl1.TabPages.Add(DirectCast(SavePages(0), TabPage))
TabControl1.TabPages.Add(DirectCast(SavePages(4), TabPage))
VB.net 設定熱鍵 HotKey(非完整)
Public Const MOD_ALT As Integer = &H1 'Alt key
'宣告必須 API
Public Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As IntPtr, ByVal id As Integer, ByVal fsModifiers As Integer, ByVal vk As Long) As Integer
Public Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As IntPtr, ByVal id As Integer) As Integer
'新增HotKey
Public Overridable Function RegKey(ByRef KeyName As String) As Boolean
If RegisterHotKey(Me.Handle, 29, 0, Keys.Enter) = False Then
KeyName = "Enter"
Return False
End If
If RegisterHotKey(Me.Handle, 1, 0, Keys.F1) = False Then '查詢
KeyName = "F1"
Return False
End If
If RegisterHotKey(Me.Handle, 2, 0, Keys.F2) = False Then '新增
KeyName = "F2"
Return False
End If
If RegisterHotKey(Me.Handle, 3, 0, Keys.F3) = False Then '修改
KeyName = "F3"
Return False
End If
If RegisterHotKey(Me.Handle, 4, 0, Keys.F4) = False Then '刪除
KeyName = "F4"
Return False
End If
If RegisterHotKey(Me.Handle, 5, 0, Keys.F5) = False Then '輸入確認
KeyName = "F5"
Return False
End If
If RegisterHotKey(Me.Handle, 6, 0, Keys.F6) = False Then '取消
KeyName = "F6"
Return False
End If
If RegisterHotKey(Me.Handle, 7, 0, Keys.F7) = False Then
KeyName = "F7"
Return False
End If
If RegisterHotKey(Me.Handle, 8, 0, Keys.F8) = False Then '第一筆
KeyName = "F8"
Return False
End If
If RegisterHotKey(Me.Handle, 9, 0, Keys.F9) = False Then '上一筆
KeyName = "F9"
Return False
End If
If RegisterHotKey(Me.Handle, 10, 0, Keys.F10) = False Then '下一筆
KeyName = "F10"
Return False
End If
If RegisterHotKey(Me.Handle, 11, 0, Keys.F11) = False Then '最後一筆
KeyName = "F11"
Return False
End If
'If RegisterHotKey(Me.Handle, 12, 0, Keys.F12) = False Then '
' KeyName = "F12"
' Return False
'End If
If RegisterHotKey(Me.Handle, 13, MOD_ALT, Keys.F1) = False Then 'detail 查詢
KeyName = "ALT+F1"
Return False
End If
If RegisterHotKey(Me.Handle, 14, MOD_ALT, Keys.F2) = False Then 'detail 新增
KeyName = "ALT+F2"
Return False
End If
If RegisterHotKey(Me.Handle, 15, MOD_ALT, Keys.F3) = False Then 'detail 修改
KeyName = "ALT+F3"
Return False
End If
If RegisterHotKey(Me.Handle, 16, MOD_ALT, Keys.F4) = False Then 'detail 刪除
KeyName = "ALT+F4"
Return False
End If
If RegisterHotKey(Me.Handle, 17, MOD_ALT, Keys.D1) = False Then
KeyName = "ALT+D1"
Return False
End If
If RegisterHotKey(Me.Handle, 18, MOD_ALT, Keys.D2) = False Then
KeyName = "ALT+D2"
Return False
End If
If RegisterHotKey(Me.Handle, 19, MOD_ALT, Keys.D3) = False Then
KeyName = "ALT+D3"
Return False
End If
If RegisterHotKey(Me.Handle, 20, MOD_ALT, Keys.D4) = False Then
KeyName = "ALT+D4"
Return False
End If
If RegisterHotKey(Me.Handle, 21, MOD_ALT, Keys.D5) = False Then
KeyName = "ALT+D5"
Return False
End If
If RegisterHotKey(Me.Handle, 22, MOD_ALT, Keys.D6) = False Then
KeyName = "ALT+D6"
Return False
End If
If RegisterHotKey(Me.Handle, 23, MOD_ALT, Keys.D7) = False Then
KeyName = "ALT+D7"
Return False
End If
If RegisterHotKey(Me.Handle, 24, MOD_ALT, Keys.D8) = False Then
KeyName = "ALT+D8"
Return False
End If
If RegisterHotKey(Me.Handle, 25, MOD_ALT, Keys.D9) = False Then
KeyName = "ALT+D9"
Return False
End If
If RegisterHotKey(Me.Handle, 26, MOD_ALT, Keys.D0) = False Then
KeyName = "ALT+D0"
Return False
End If
Return True
End Function
'解除HotKey
Public Sub UnRegKey()
Call UnregisterHotKey(Me.Handle, 1)
Call UnregisterHotKey(Me.Handle, 2)
Call UnregisterHotKey(Me.Handle, 3)
Call UnregisterHotKey(Me.Handle, 4)
Call UnregisterHotKey(Me.Handle, 5)
Call UnregisterHotKey(Me.Handle, 6)
Call UnregisterHotKey(Me.Handle, 7)
Call UnregisterHotKey(Me.Handle, 8)
Call UnregisterHotKey(Me.Handle, 9)
Call UnregisterHotKey(Me.Handle, 10)
Call UnregisterHotKey(Me.Handle, 11)
Call UnregisterHotKey(Me.Handle, 12)
Call UnregisterHotKey(Me.Handle, 13)
Call UnregisterHotKey(Me.Handle, 14)
Call UnregisterHotKey(Me.Handle, 15)
Call UnregisterHotKey(Me.Handle, 16)
Call UnregisterHotKey(Me.Handle, 17)
Call UnregisterHotKey(Me.Handle, 18)
Call UnregisterHotKey(Me.Handle, 19)
Call UnregisterHotKey(Me.Handle, 20)
Call UnregisterHotKey(Me.Handle, 21)
Call UnregisterHotKey(Me.Handle, 22)
Call UnregisterHotKey(Me.Handle, 23)
Call UnregisterHotKey(Me.Handle, 24)
Call UnregisterHotKey(Me.Handle, 25)
Call UnregisterHotKey(Me.Handle, 26)
Call UnregisterHotKey(Me.Handle, 29)
End Sub
'攔截Windows 訊息
Protected Overloads Overrides Sub WndProc(ByRef m As Message)
'相關資料http://msdn.microsoft.com/zh-tw/library/dd229215.aspx
Const WM_HOTKEY As Integer = &H312
Select Case m.Msg
Case (WM_HOTKEY)
Select Case m.WParam.ToInt32()
Case (1)
F1_KEY()
Case (2)
F2_KEY()
Case (3)
F3_KEY()
Case (4)
F4_KEY()
Case (5)
F5_KEY()
Case (6)
F6_KEY()
Case (7)
F7_KEY()
Case (8)
F8_KEY()
Case (9)
F9_KEY()
Case (10)
F10_KEY()
Case (11)
F11_KEY()
Case (12)
F12_KEY()
Case (13)
ALTF1()
Case (14)
ALTF2()
Case (15)
ALTF3()
Case (16)
ALTF4()
Case (17)
ALTD1()
Case (18)
ALTD2()
Case (19)
ALTD3()
Case (20)
ALTD4()
Case (21)
ALTD5()
Case (22)
ALTD6()
Case (23)
ALTD7()
Case (24)
ALTD8()
Case (25)
ALTD9()
Case (26)
ALTD0()
Case (29)
Enter_KEY()
End Select
Case &H6
If m.WParam.ToInt32() = 1 Or m.WParam.ToInt32() = 2 Then
Dim V_str As String
RegKey(V_str)
'Console.WriteLine("啟動hotkey1")
'Console.WriteLine(V_str)
End If
If m.WParam.ToInt32() = 2097152 Or m.WParam.ToInt32() = 0 Then
UnRegKey()
'Console.WriteLine("移除hotkey1")
End If
'Console.WriteLine(m.WParam.ToInt32() & " @" & Date.Now.ToString("HH:mm:ss"))
End Select
MyBase.WndProc(m)
End Sub
有關於單一執行個體 (不允許重覆執行)
在Form load裡面
Dim intTimes As Integer
Dim strMeName() As String
Dim strName As String
intTimes = 0
'取出名字,包涵檔名路徑
strMeName = Split(Application.ExecutablePath, "\")
'真正的名字是在最後一個
strName = strMeName(strMeName.Length - 1).ToUpper
'不要.exe結尾
strName = Split(strName, ".EXE")(0)
'偵測有無執行過了
For Each p As Process In Process.GetProcesses()
Try
For Each m As ProcessModule In p.Modules
If Mid(m.ModuleName, 1, strName.Length).ToUpper = strName Then
intTimes = intTimes + 1
End If
Next
Catch ex As Exception
End Try
Next
Try
'如果有兩個人,就離開
If intTimes > 1 Then
'自殺
'離開並關閉執行緒
Environment.Exit(Environment.ExitCode)
Application.Exit()
End If
Catch ex As Exception
End Try
vbnet word 插入統計圖表
'方法一:用word內建函數
Imports System.Runtime.InteropServices
Imports Microsoft.Office.Interop
Imports owc11 = Microsoft.Office.Interop.Owc11
Dim oWord As Word.Application
Dim oDoc As Word.Document
Dim oRng As Word.Range
Dim oShape As Word.InlineShape
Dim oChart As Object
oShape = oDoc.Bookmarks.Item("\endofdoc").Range.InlineShapes.AddOLEObject( _
ClassType:="MSGraph.Chart", FileName _
:="", LinkToFile:=False, DisplayAsIcon:=False)
oChart = oShape.OLEFormat.Object
oChart.charttype = 5 'xlLine = 4
'都沒有=立體圖(長條圖) 1=一般 4=線圖 5=圓餅圖
oChart.Application.Update()
oChart.Application.Quit()
'If desired, you can proceed from here using the Microsoft Graph
'Object model on the oChart object to make additional changes to the
'chart.
oShape.Width = oWord.InchesToPoints(6.25)
oShape.Height = oWord.InchesToPoints(3.57)
'方法2:用vb.net(word) 內建控制項繪製,轉成圖片,插入word文件
'ACS=AxCharSpace
Dim oWord As New Word.Application
Dim oDoc As Word.Document
Dim oRng As Word.Range
Dim ii As Integer
Dim rowIndex, colIndex As Integer
Dim missing = System.Reflection.Missing.Value
Dim aX, aY
ReDim aX(5)
ReDim aY(5)
Dim DS As New DataSet
DS.Tables.Add()
DS.Tables(0).Columns.Add("姓名")
DS.Tables(0).Columns.Add("成績")
DS.Tables(0).Rows.Add()
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("姓名") = "陳小邦"
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("成績") = "93"
DS.Tables(0).Rows.Add()
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("姓名") = "張小千"
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("成績") = "66"
DS.Tables(0).Rows.Add()
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("姓名") = "林小狗"
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("成績") = "89"
DS.Tables(0).Rows.Add()
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("姓名") = "王宜靜"
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("成績") = "99"
DS.Tables(0).Rows.Add()
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("姓名") = "張大飛"
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("成績") = "78"
DS.Tables(0).Rows.Add()
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("姓名") = "桶一針"
DS.Tables(0).Rows(DS.Tables(0).Rows.Count - 1).Item("成績") = "79"
For ii = 0 To DS.Tables(0).Rows.Count - 1
aX(ii) = DS.Tables(0).Rows(ii).Item("姓名")
aY(ii) = DS.Tables(0).Rows(ii).Item("成績")
Next
oRng = oDoc.Bookmarks.Item("\endofdoc").Range
oRng.InsertParagraphAfter()
Dim Chart1 As Owc11.ChChart
Chart1 = ChartSpace1.Charts.Add() '在ChartSpace1繪圖空間內建一個新圖表(繒圖區)
Dim Chart1_Series1 As Owc11.ChSeries
'宣告資料列...
Chart1_Series1 = Chart1.SeriesCollection.Add(0) '在Chart1圖表中加一個資料列
Chart1_Series1.Type = Owc11.ChartChartTypeEnum.chChartTypeBarClustered
'命名資料系列(名稱將在圖例中顯示出來)
Chart1_Series1.SetData(Owc11.ChartDimensionsEnum.chDimSeriesNames, Owc11.ChartSpecialDataSourcesEnum.chDataLiteral, "成績")
'將資料組中的資料填入圖表
Chart1_Series1.SetData(Owc11.ChartDimensionsEnum.chDimCategories, Owc11.ChartSpecialDataSourcesEnum.chDataLiteral, aX) '姓名軸
Chart1_Series1.SetData(Owc11.ChartDimensionsEnum.chDimValues, Owc11.ChartSpecialDataSourcesEnum.chDataLiteral, aY) '成績軸
Chart1_Series1.SetData(ChartDimensionsEnum.chDimHighValues, Owc11.ChartSpecialDataSourcesEnum.chDataLiteral, 100)
'匯出圖片
ACS.ExportPicture(Application.StartupPath & "\1.GIF", "GIF", ACS.Width, ACS.Height)
'尋找文件結尾
missing = System.Reflection.Missing.Value
Dim unit = Word.WdUnits.wdStory
oWord.Selection.EndKey(unit, missing)
oWord.Selection.InlineShapes.AddPicture(Application.StartupPath & "\1.GIF", False, True, missing)
'Add text after the chart.
oRng.InsertParagraphAfter()
oDoc.SaveAs(Application.StartupPath & "\1.doc")
oDoc.Close(True)
oWord.Quit(True)
oDoc = Nothing
oWord = Nothing
vbnet 建立 word
Public Class WordOpLib
Private oWordApplic As Word.Application
Private oDocument As Word.Document
Private oRange As Word.Range
Private oSelection As Word.Selection
Public Sub New()
'啟動com word介面
oWordApplic = New Word.Application
oWordApplic.Visible = True
End Sub
'設置選定文本
Public Sub SetRange(ByVal para As Integer)
oRange = oDocument.Paragraphs(para).Range
oRange.Select()
End Sub
Public Sub SetRange(ByVal para As Integer, ByVal sent As Integer)
oRange = oDocument.Paragraphs(para).Range.Sentences(sent)
oRange.Select()
End Sub
Public Sub SetRange(ByVal startpoint As Integer, ByVal endpoint As Integer, ByVal flag As Boolean)
If flag = True Then
oRange = oDocument.Range(startpoint, endpoint)
oRange.Select()
Else
End If
End Sub
'生成空的新文檔
Public Sub NewDocument()
Dim missing = System.Reflection.Missing.Value
Dim isVisible As Boolean = True
oDocument = oWordApplic.Documents.Add(missing, missing, missing, missing)
oDocument.Activate()
End Sub
'使用範本生成新文檔
Public Sub NewDocWithModel(ByVal FileName As String)
Dim missing = System.Reflection.Missing.Value
Dim isVisible As Boolean = True
Dim strName As String
strName = FileName
oDocument = oWordApplic.Documents.Add(strName, missing, missing, isVisible)
oDocument.Activate()
End Sub
'打開已有文檔
Public Sub OpenFile(ByVal FileName As String)
Dim strName As String
Dim isReadOnly As Boolean
Dim isVisible As Boolean
Dim missing = System.Reflection.Missing.Value
strName = FileName
isReadOnly = False
isVisible = True
oDocument = oWordApplic.Documents.Open(strName, missing, isReadOnly, missing, missing, missing, missing, missing, missing, missing, missing, isVisible, missing, missing, missing, missing)
oDocument.Activate()
End Sub
Public Sub OpenFile(ByVal FileName As String, ByVal isReadOnly As Boolean)
Dim strName As String
Dim isVisible As Boolean
Dim missing = System.Reflection.Missing.Value
strName = FileName
isVisible = True
oDocument = oWordApplic.Documents.Open(strName, missing, isReadOnly, missing, missing, missing, missing, missing, missing, missing, missing, isVisible, missing, missing, missing, missing)
oDocument.Activate()
End Sub
'退出Word
Public Sub Quit()
Dim missing = System.Reflection.Missing.Value
oWordApplic.Quit()
System.Runtime.InteropServices.Marshal.ReleaseComObject(oWordApplic)
oWordApplic = Nothing
End Sub
'關閉所有打開的文檔
Public Sub CloseAllDocuments()
oWordApplic.Documents.Close(Word.WdSaveOptions.wdDoNotSaveChanges)
End Sub
'關閉當前的文檔
Public Sub CloseCurrentDocument()
oDocument.Close(Word.WdSaveOptions.wdDoNotSaveChanges)
End Sub
'保存當前文檔
Public Sub Save()
Try
oDocument.Save()
Catch
MsgBox(Err.Description)
End Try
End Sub
'另存為文檔
Public Sub SaveAs(ByVal FileName As String)
Dim strName As String
Dim missing = System.Reflection.Missing.Value
strName = FileName
oDocument.SaveAs(strName, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing)
End Sub
'保存為Html檔
Public Sub SaveAsHtml(ByVal FileName As String)
Dim missing = System.Reflection.Missing.Value
Dim strName As String
strName = FileName
Dim format = CInt(Word.WdSaveFormat.wdFormatHTML)
oDocument.SaveAs(strName, format, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing, missing)
End Sub
'插入文本
Public Sub InsertText(ByVal text As String)
oWordApplic.Selection.TypeText(text)
End Sub
'插入一個空行
Public Sub InsertLineBreak()
oWordApplic.Selection.TypeParagraph()
End Sub
'插入指定行數的空行
Public Sub InsertLineBreak(ByVal lines As Integer)
Dim i As Integer
For i = 1 To lines
oWordApplic.Selection.TypeParagraph()
Next
End Sub
'插入表格
Public Sub InsertTable(ByRef table As DataTable)
Dim oTable As Word.Table
Dim rowIndex, colIndex, NumRows, NumColumns As Integer
rowIndex = 1
colIndex = 0
NumRows = table.Rows.Count + 1
NumColumns = table.Columns.Count
oTable = oDocument.Tables.Add(oWordApplic.Selection.Range(), NumRows, NumColumns)
'初始化列
Dim Row As DataRow
Dim Col As DataColumn
For Each Col In table.Columns
colIndex = colIndex + 1
oTable.Cell(1, colIndex).Range.InsertAfter(Col.ColumnName)
Next
'將行添入表格
For Each Row In table.Rows
rowIndex = rowIndex + 1
colIndex = 0
For Each Col In table.Columns
colIndex = colIndex + 1
oTable.Cell(rowIndex, colIndex).Range.InsertAfter(Row(Col.ColumnName))
Next
Next
oTable.AllowAutoFit = True
oTable.ApplyStyleFirstColumn = True
oTable.ApplyStyleHeadingRows = True
End Sub
'設置對齊
Public Sub SetAlignment(ByVal strType As String)
Select Case strType
Case "center"
oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphCenter
Case "left"
oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphLeft
Case "right"
oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphRight
Case "justify"
oWordApplic.Selection.ParagraphFormat.Alignment = Word.WdParagraphAlignment.wdAlignParagraphJustify
End Select
End Sub
'設置字體
Public Sub SetStyle(ByVal strFont As String)
Select Case strFont
Case "bold"
oWordApplic.Selection.Font.Bold = 1
Case "italic"
oWordApplic.Selection.Font.Italic = 1
Case "underlined"
oWordApplic.Selection.Font.Subscript = 1
End Select
End Sub
'取消字體風格
Public Sub DissableStyle()
oWordApplic.Selection.Font.Bold = 0
oWordApplic.Selection.Font.Italic = 0
oWordApplic.Selection.Font.Subscript = 0
End Sub
'設置字體字型大小
Public Sub SetFontSize(ByVal nSize As Integer)
oWordApplic.Selection.Font.Size = nSize
End Sub
'跳過本頁
Public Sub InsertPageBreak()
Dim pBreak As Integer
pBreak = CInt(Word.WdBreakType.wdPageBreak)
oWordApplic.Selection.InsertBreak(pBreak)
End Sub
'轉到書簽
Public Sub GotoBookMark(ByVal strBookMark As String)
Dim missing = System.Reflection.Missing.Value
Dim BookMark = CInt(Word.WdGoToItem.wdGoToBookmark)
oWordApplic.Selection.GoTo(BookMark, missing, missing, strBookMark)
End Sub
'判斷書簽是否存在
Public Function BookMarkExist(ByVal strBookMark As String) As Boolean
Dim Exist As Boolean
Exist = oDocument.Bookmarks.Exists(strBookMark)
Return Exist
End Function
'轉到文檔結尾
Public Sub GotoTheEnd()
Dim missing = System.Reflection.Missing.Value
Dim unit = Word.WdUnits.wdStory
oWordApplic.Selection.EndKey(unit, missing)
End Sub
'轉到文檔開頭
Public Sub GotoTheBegining()
Dim missing = System.Reflection.Missing.Value
Dim unit = Word.WdUnits.wdStory
oWordApplic.Selection.HomeKey(unit, missing)
End Sub
'轉到表格
Public Sub GotoTheTable(ByVal ntable As Integer)
'Dim missing = System.Reflection.Missing.Value
'Dim what = Word.WdGoToItem.wdGoToTable
'Dim which = Word.WdGoToDirection.wdGoToFirst
'Dim count = ntable
'oWordApplic.Selection.GoTo(what, which, count, missing)
'oWordApplic.Selection.ClearFormatting()
'oWordApplic.Selection.Text = ""
oRange = oDocument.Tables(ntable).Cell(1, 1).Range
oRange.Select()
End Sub
'轉到表格的某個儲存格
Public Sub GotoTableCell(ByVal ntable As Integer, ByVal nRow As Integer, ByVal nColumn As Integer)
oRange = oDocument.Tables(ntable).Cell(nRow, nColumn).Range
oRange.Select()
End Sub
'表格中轉到右面的儲存格
Public Sub GotoRightCell()
Dim missing = System.Reflection.Missing.Value
Dim direction = Word.WdUnits.wdCell
oWordApplic.Selection.MoveRight(direction, missing, missing)
End Sub
'表格中轉到左面的儲存格
Public Sub GotoLeftCell()
Dim missing = System.Reflection.Missing.Value
Dim direction = Word.WdUnits.wdCell
oWordApplic.Selection.MoveLeft(direction, missing, missing)
End Sub
'表格中轉到下麵的儲存格
Public Sub GotoDownCell()
Dim missing = System.Reflection.Missing.Value
Dim direction = Word.WdUnits.wdCell
oWordApplic.Selection.MoveDown(direction, missing, missing)
End Sub
'表格中轉到上面的儲存格
Public Sub GotoUpCell()
Dim missing = System.Reflection.Missing.Value
Dim direction = Word.WdUnits.wdCell
oWordApplic.Selection.MoveUp(direction, missing, missing)
End Sub
'插入圖片
Public Sub InsertPic(ByVal FileName As String)
Dim missing = System.Reflection.Missing.Value
oWordApplic.Selection.InlineShapes.AddPicture(FileName, False, True, missing)
End Sub
End Class
動態call form
Private Sub ShowForm(ByVal FormName As String)
Dim ProjectName As String =
Reflection.Assembly.GetExecutingAssembly.GetName.Name
Try
Dim tyOfStringVariable As Type = Type.GetType(ProjectName & "." &
FormName)
Dim frmObject As Object = Activator.CreateInstance(tyOfStringVariable)
DirectCast(frmObject, Form).StartPosition =
FormStartPosition.CenterParent
DirectCast(frmObject, Form).ShowDialog()
Catch ex As Exception
' TODO
End Try
End Sub
讀取資料庫的圖片
'方法一,不需寫成檔案即可讀成圖片
Dim V_byte() As Byte
V_byte = DS.Tables(0).Rows(0).Item("pic")
Dim intLength As Integer = UBound(V_byte)
Dim V_stream As New System.IO.MemoryStream(V_byte, 0, intLength)
PictureBox1.Image = Image.FromStream(V_stream)
'方法二,寫成圖片檔
My.Computer.FileSystem.WriteAllBytes(Trim(DS.Tables(0).Rows(0).Item("filename")), DS.Tables(0).Rows(0).Item("pic"), True)
V_image = Image.FromFile(Application.StartupPath & "\" & Trim(DS.Tables(0).Rows(0).Item("filename")), False)
PictureBox1.Image = V_image
用程式寄信 (gmail 發信)
Imports System.Text
Imports System.Net
Imports System.Net.Mail
Imports System.ComponentModel
public sub Send_mail()
' Mail Message Setting
Dim fromEmail As String = "xxxxx@gmail.com"
Dim fromName As String = "name"
Dim from As New MailAddress(fromEmail, fromName, Encoding.UTF8)
Dim toEmail As String = "xxxxx@hotmail.com"
Dim mail As New MailMessage(from, New MailAddress(toEmail))
Dim subject As String = "Test Subject"
mail.Subject = subject
mail.SubjectEncoding = Encoding.UTF8
Dim body As String = "Test Body"
mail.Body = body
mail.BodyEncoding = Encoding.UTF8
mail.IsBodyHtml = False
mail.Priority = MailPriority.High
mail.Attachments.Add(New Mail.Attachment("c:\temp.jpg"))
' SMTP Setting
Dim client As New SmtpClient()
client.Host = "smtp.gmail.com"
client.Port = 587
client.Credentials = New NetworkCredential("xxxxxx@gmail.com", "*******")
client.EnableSsl = True
' Send Mail
client.SendAsync(mail, mail)
AddHandler client.SendCompleted, AddressOf client_SendCompleted
' Sent Compeleted Eevet
end sub
Private Sub client_SendCompleted(ByVal sender As Object, ByVal e As AsyncCompletedEventArgs)
If e.[Error] IsNot Nothing Then
MessageBox.Show(e.[Error].ToString())
Else
MessageBox.Show("Message sent.")
End If
End Sub
form load 和 DevExpress
對 DevExpress free 50 個的真是不敢再領教了
雖然美美的 GUI , 但嚴重影響效率和速度
在前2篇連續引了 thread , 主要是參考如何把 form load 過慢的問題用另外的方式來處理
之前在用 DevExpress 並沒想到這麼多,想說有送 50 free 的元件
就用,結果用太多了;導致整個 form 和效率都慢....
windowsform 開發大型的,還是原味的較實在;效率和穩定度都好
雖然美美的 GUI , 但嚴重影響效率和速度
在前2篇連續引了 thread , 主要是參考如何把 form load 過慢的問題用另外的方式來處理
之前在用 DevExpress 並沒想到這麼多,想說有送 50 free 的元件
就用,結果用太多了;導致整個 form 和效率都慢....
windowsform 開發大型的,還是原味的較實在;效率和穩定度都好
Window Form 事件順序
微軟MSND中也提到:對於需要輪流處理 Windows Form 應用程式中每個事件的開發人員來說,事件
的引發順序就十分重要。當某個狀況呼叫嚴密的事件處理,如重新繪製表單的部分時,有必要了解事件
在執行階段時的明確引發順序。下面列出Windows Form 中事件的順序,以方
便日後參考。
Form 和 Control 有關啟動與關閉的事件順序為可分為兩大類,當 Windows Form 應用程式啟動時,
會以下列順序引發主要表單的啟動事件:
* Control.HandleCreated
* Control.BindingContextChanged
* Form.Load
* Control.VisibleChanged
* Form.Activated
* Form.Shown
當應用程式關閉時,會以下列順序引發主要表單的關閉事件:
* Form.Closing
* Form.FormClosing
* Form.Closed
* Form.FormClosed
* Form.Deactivate
焦點和驗證事件:當透過使用鍵盤按鍵 (TAB、SHIFT+TAB 等)、呼叫 Select 或 SelectNextControl 方法,
或是將 ActiveControl 屬性設定成目前的表單等作法,變更焦點時,Control 類別的焦點事件就會以下列順序發生:
* Enter
* GotFocus
* Leave
* Validating
* Validated
* LostFocus
當使用滑鼠或呼叫 Focus 方法來變更焦點時,Control 類別的焦點事件會以下列順序發生:
* Enter
* GotFocus
* LostFocus
* Leave
* Validating
* Validated
訂閱:
文章 (Atom)