2010年12月29日星期三

租用的ASP網站亂碼問題

以VWD2008 建立一個3.5的網站
web.confign
內

＜system.web＞
＜globalization fileEncoding="big5" /＞
＜/system.web＞

2010年11月27日星期六

2010年11月23日星期二

VB.net itext.net vbcode範例

除了VB也有C#

不過itext.net 好像和 itextsharp 不一定完全相同

http://www.ujihara.jp/iTextdotNET/en/examplesvb.html

2010年11月8日星期一

'*************************************************************
' 前端
'*************************************************************
需有以下的設定，此標籤必須原來就存在，無法動態產生此標籤再來下載。
解法：先有此標籤，href屬性動態指定即可。
$('#outputxml').attr("href",'OutputUD.ashx?selsi=' + si + '&selsn=' + SelSub);

'*************************************************************
' 後端
'*************************************************************
OutputUD.ashx

990125 防止其它網域的使用者呼叫!
If context.Request.UrlReferrer.Host <> context.Request.ServerVariables("SERVER_NAME") Then
FormsAuthentication.SignOut() '981208
context.Response.Redirect("ShowUserRdr.aspx")
End If

context.Response.ClearHeaders()
context.Response.Clear()
context.Response.Expires = 0
context.Response.Buffer = True
context.Response.AddHeader("Accept-Language", "zh-tw")

'檔案名稱
Dim strContentDisposition As String = "attachment; filename=UserRecord.xml"
context.Response.AddHeader("Content-Disposition", strContentDisposition)
context.Response.ContentType = "Application/octet-stream"

'檔案內容
Dim settings As New XmlWriterSettings
settings.Indent = True
settings.OmitXmlDeclaration = False
settings.NewLineOnAttributes = True
settings.Encoding = Encoding.UTF8

'將XML寫入的結果放在 context.Response.OutputStream內
Dim MyWriter As XmlWriter = XmlWriter.Create(context.Response.OutputStream, settings)

Dim sb As New StringBuilder
Dim i As Integer
'*********************************************************************************************** ' 990115 XML資料架構
' 1. UserRdr (root)
' |
' ----- SelectQ
' :
' ---------1. QASubject (選擇題目) 其下標籤

' :
' --------2. QAChinese (申論題目) 其下標籤
' :
' --------3. Customize (自訂或重點資料列表) 其下標籤
' :
' --------4. LawInfo (法規命令) 其下標籤
' :
' --------5. PointRecover (選擇題複習重點) 其下標籤

' :
' :------- 0. Finfo 關於檔案之資訊
'*********************************************************************************************** MyWriter.WriteStartElement("UserRdr")
MyWriter.WriteStartElement("SelectQ")

....................
'990104 考題出處
'MyWriter.WriteElementString("QFrom", "")
MyWriter.WriteStartElement("QFrom")
MyWriter.WriteCData(dr("QSource"))
MyWriter.WriteEndElement()

'990104 科目(僅抓取第一個編號避免 x6x33x 這種多編碼形式!)
'MyWriter.WriteElementString("Qsub", "")
MyWriter.WriteStartElement("Qsub")
MyWriter.WriteCData(OutSubName)
MyWriter.WriteEndElement()
End While
MyWriter.WriteEndElement()

'990120 最後輸出檔案的相關資訊!
MyWriter.WriteStartElement("Finfo") '< S >
MyWriter.WriteElementString("WDate", Now)
MyWriter.WriteElementString("S1", "")
MyWriter.WriteElementString("S2", "")
MyWriter.WriteElementString("S3", "")
MyWriter.WriteElementString("S4", "")
MyWriter.WriteEndElement()

'輸出結束標記!
MyWriter.WriteEndElement()
MyWriter.WriteEndElement()
'將XML輸出
MyWriter.Flush()

'將 context.Response.OutputStream 內容輸出
context.Response.OutputStream.ToString()

context.Response.End()

'判斷是否空字串 DBNull 或特殊字元 ^\x09\x0A\x0D\x20-\xD7FF\xE000-\xFFFD\x10000-x10FFFF
Function ReplaceSpChr(ByVal k As String) As String
'Return Regex.Replace(k, "[^\x09\x0A\x0D\x20-\xD7FF\xE000-\xFFFD\x10000-x10FFFF]", "", RegexOptions.IgnoreCase)
Return Regex.Replace(k, "[\f]", "", RegexOptions.IgnoreCase)
End Function

ASP.NET JQuery 從後端載入XML資料，然後將XML的tag放到相對應的HTML欄位

從後端載入XML資料，然後將XML的tag放到相對應的HTML欄位內。

'*************************************************************
' 前端
'*************************************************************
/* 選取不同的科目類別 ----------------------------------------------------- */
$('#LoginView1_ddlSubject').change(function() {
var si = $('#LoginView1_ddlSubject option:selected').val();
var SelSub=$('#LoginView1_ddlSubject option:selected').text() ;
if ( si !=0 ) {
$.blockUI({message: '

使用者紀錄載入中，請耐心稍後喔…

'});
//針對不同的科目id顯示對應的 [匯出記錄]超連結
$('#outputxml').attr("href",'OutputUD.ashx?selsi=' + si + '&selsn=' + SelSub);
//執行ajax功能
$.ajax({
url: "FetchRdr.ashx",
type: "POST", /* 傳輸量若太多要改用POST */
data: "V=" + si ,
cache: false,
/*dataType: "xml", 回傳格式 xml */
success: function(response) {
// ................")
//var x = $("" + response + "");
var x = $(response );
//alert (x.find("SecionA").text());
$("#RdrS1").html(x.find("SecionA").text());
$("#RdrS2").html(x.find("SecionB").text());
$("#RdrS3").html(x.find("SecionC").text());
$("#RdrS4").html(x.find("SecionD").text() + x.find("SecionE").text()); //此區塊一併寫入重點參數!
//$("#RdrS1").html(response);
$.unblockUI(); //取消動畫！
}, /* 若不成功，大部分是伺服端APSX的問題且客戶端送出的字串前後結尾不可以有雙引號等特殊字元 */
error: function(xhr, textStatus, thrownError) { alert("錯誤:" + xhr.responseText); }
}) /* data: "acc='abc'",*/
}
else { // 沒有選擇科目時
//alert('請先選擇要複習的科目喔~ \n\n 提醒：匯出使用者記錄，只允許每次匯出一個科目....') ;
$('.OutputUserData').attr("href",'#');
}
});

'*************************************************************
' 後端
'*************************************************************

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'
' 配合 XML 設定 (只是仿製為XML的用法，＜！[CDATA[xxx]]＞可避開標籤的問題!) JQuery 將字串前後包住即可使用XML工具FIND的函數!
'
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
sb.Append("＜xml＞＜udr＞＜seciona＞＜！[CDATA[xxxxxxxx]]＞＜/SecionA＞")
sb.Append("＜secionb＞＜！[CDATA[xxxxxxxxxxxxx]]＞＜/SecionE＞＜/Udr＞＜/xml＞")
context.Response.Write(sb.ToString)
'最後輸出
context.Response.End()

ASP.NET 利用 BlockUI 做為文章預覽畫面

作法：
當文章送出之前，以BlockUI產生一個文章預覽畫面，這樣就不用再多做一個頁面顯示了，也不影響Server的效能。

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
前端
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

$('#MakeSure').click(function() {
$.unblockUI();
//執行指定輸入功能
WebForm_DoPostBackWithOptions(new WebForm_PostBackOptions("LoginView1$FormView1$InsertButton" , "", true,"" ,"" , false, true)) ;
return true;
});

$('#CancelInput').click(function() {
$.unblockUI();
return false;
});

/* 取消預定寫入事件，以預覽文章視窗替代 */
/*------------------------------------------------------------------------------------------------*/
$("#LoginView1_FormView1_InsertButton").click(function() {
// 寫入預覽內容!
var Sub=$("#LoginView1_FormView1_txtSubject").val();
var XXX=$("#LoginView1_FormView1_txtContent").val();
// 避免特殊符號寫入文章內容
XXX=XXX.replace(/[\!\\+=_\[\]#$%^&*|"';?/><,.]/g,''); // 確定要顯示內容的相對位置請配合 CSS對於相關區塊的語法 var FormWidth= 770; var FormHeight= 300; var lPos= (screen.width/2)-(FormWidth/2) +'px' ; //var tPos= (screen.height /2)-(FormHeight/2) +'px'; var tPos= '50px'; FormWidth=FormWidth+ 'px'; XXX =XXX.replace(/\n/g,'
'); // textarea 回車符號
$("#AricleResult").html('標題：' + Sub + '

'+ XXX);
$.blockUI({ message: $('#ArtPreview'), css: { width: FormWidth ,top: tPos , left: lPos } });
// $.blockUI({ message: $('#ArtPreview'), css: { width: '400px' } });
return false;
});

預覽結果

請注意!! 系統會自動排除半形的特殊符號(例如:#$%^&*|"'<>等)。請改以全形符號取代(例如：＃＄％︿＆＊＂’＜＞等)

ASP.NET JQuery JSON示例

---------------------------------------------
前端
---------------------------------------------
以下的作法，是利用TagArticle函數將文章透過$.getJSON QueryArticle.ashx來取回資料。

function TagArticle(Sid,controlName,Ds ) { //標記文章
$.blockUI({ message: '

處理中，請耐心稍後喔…

' });
//990714 改善GET的Cache問題
$.getJSON("QueryArticle.ashx?Qid=" + Sid + "&d=" + Ds +"&q="+new Date().getTime(), function(Vdata) {
//處理 TAG 陣列
var tn="";
tn=Vdata.TagV;
//自動產生 Tag標記
var Slt='';
var cnt=0;
for( var i = 0; i < tagCnt; i++ ) { if( tn.indexOf("x" + (i+1) + "x" ) !=-1 ) { Slt=Slt + "" + (i+1) +'.' + tagN[i+1] + ' ' ;
} else {
Slt=Slt + "" + (i+1) +'.' + tagN[i+1] + ' ' ;
}
//每行排列三個控制項
cnt+=1 ;
if (cnt==4) {
Slt=Slt + "
"
cnt=0;
}
}
var XXX='';
XXX=Vdata.SugV
$("#Subj").html(XXX );
XXX=Vdata.MsgV
XXX =XXX.replace(/
/g,"\n")
XXX =XXX.replace(/(^\s*)|(\s*$)/g, "");
$("#Ac").val(XXX );
$("#Tagzone").html( Slt);
});
$.unblockUI(); //取消動畫！

---------------------------------------------
後端 QueryArticle.ashx
---------------------------------------------
'取得文章！
Dim ads As New AccessDataSource("~/App_Data/history.mdb", "")
Dim dv As Data.DataView
Dim s As String = ""
Dim LinkS As String = ""
ads.SelectCommand = "select tag,subject,Message,DiscussID from [oldarticle] where DiscussID=" & Qid
'990507以 StringBuilder 寫入 JSON 格式以供前端JS再使用
Dim sb As New StringBuilder
dv = ads.Select(New DataSourceSelectArguments)
If dv.Count <> 0 Then
'MsgBox(dv.Item(0).Item("tag") & " " & dv.Item(0).Item("Message"))
'JOSN的基本格式如下()
'{ 'dataset' : [ {'categoryid' : 'A' , 'categoryname' : 'Cat'}
', {'categoryid' : 'B' , 'categoryname' : 'Mouse'}
', {'categoryid' : 'B' , 'categoryname' : 'Dog'}]}
'990507 因簡易版，只有1筆資料故採此架構
'{
' "foo": "afsdfsafsdf.",
' "bar": "ABCDEFG",
' "baz": [52, 97]
'}
sb.Append("{ ")
sb.Append("""TagV"" : """ & dv.Item(0).Item("tag") & """ , ") '寫入第一個參數，tag
sb.Append("""SugV"" : """ & dv.Item(0).Item("subject") & """, ")

If SelDataSource = 0 Then '資料庫的名稱不同

Dim ads2 As New AccessDataSource("~/App_Data/@history.mdb", "")
Dim dv2 As Data.DataView
ads2.SelectCommand = "select Message,DiscussID from [oldarticle] where DiscussID=" & Qid
dv2 = ads2.Select(New DataSourceSelectArguments)
If dv2.Count <> 0 Then
sb.Append("""MsgV"" : """ & dv2.Item(0).Item("Message") & """} ") '寫入第2個參數，Message
End If
Else
sb.Append("""MsgV"" : """ & dv.Item(0).Item("Message") & """} ") '寫入第2個參數，Message
End If

'看不見的段落字元很恐怖!! 會導致 JSON出現錯誤! 990622
sb.Replace(vbCrLf, "
")
sb.Replace(vbCr, "
")
sb.Replace(vbLf, "
")
'sb.Replace("

", "
")
' context.Response.Write(Replace(dv.Item(0).Item("tag") & "ckvkc" & dv.Item(0).Item("Message"), vbCrLf, "
"))
context.Response.Write(sb.ToString)

2010年11月7日星期日

電腦技巧圖片 -> PDF 工具使用心得(i2pdf)

若是僅要將圖片轉成PDF檔，這個軟體和之前介紹的PDFill，好用多了。
PDFill除了要安裝好幾個程式外，所產生的暫存檔及處理速度也是相當驚人的差

若需求簡單，可直接用i2pdf，因他不需要安裝，在不壓縮圖片的情形下轉成PDF相當快速。
下載位置 http://www.softpedia.com/progDownload/i2pdf-Download-158298.html

2010年10月31日星期日

GoolgeMaps 圖示資源及本機載入

蒐集很多ICON的地方
http://code.google.com/p/google-maps-icons/wiki/EducationIcons

'http:網路
letteredIcon.image = "http://gmaps-samples.googlecode.com/svn/trunk/markers/blue/marker" + ClusterCnt[seli] + ".png";
'本機電腦上的路徑
letteredIcon.image = "file:///C:/school.png";

2010年10月26日星期二

VS2008 Dotfuscator簡易使用

開啟VS2008
選取(工具)-> Dotfuscator Community Edition
選擇建立新專案
在[輸入]頁籤中，將要模糊的模糊的DLL或EXE檔案加進來。
在[建置]頁籤中，點選建置。

完成之後，會產生一個 [Dotfuscated]資料夾
內含一個map.xml及剛才輸入要模糊的DLL或EXE檔案

電腦技巧圖片 -> PDF 工具使用心得(PDFill)

之前有掃描一下書籍中某些章節的內容資料，若能製作成PDF格式，並使用Pdf x-changer Viewer 軟體加註心得，那就太棒了。

以下是所需要的軟體(Free)
1.安裝 GhostScript 8.63 w32
2.安裝 FREE PDF Tools PDFill
3.系統會問要安裝 java虛擬機器

將要製作為PDF的圖片，選取後，以XP內建的相片列印精靈列印。
點選[列印喜好設定]進入[版面配置]，選擇[旋轉橫印](很重要，才能符合一般的閱讀角度)
確定後，下一步，選擇[全頁傳真列印]，下一步到結束。
最後輸入要的檔案名稱即可。

2010年10月21日星期四

Excel 關閉XLS檔案出現的未清除剪貼簿資訊

使用前必須確定已引用 MS Forms 2.0 Object Library。
在引用項目點選[瀏覽] 目錄 windows\system32\fm20.dll
即會出現 MS Forms 2.0 Object Library。

若是在刪除頁籤時，出現要被刪除的頁籤有資料時的確認對話框
請用以下Code即可，無須使用剪貼簿的方式刪除
Application.DisplayAlerts = False

資料來源
http://gb.twbts.com/index.php/topic,1878.0.html

Sub 取得剪貼簿內容()
　Dim data As New DataObject
　data.GetFromClipboard
　Range("A1") = data.GetText(1)
End Sub

Sub 寫入剪貼簿()
　Dim data As New DataObject
　chars = [A1].Characters(3, 5).Text '取得A1部份內容
　data.SetText chars '寫入DataObject
　data.PutInClipboard '寫入剪貼簿
　[B1].Select
　ActiveSheet.Paste '再貼到B1
End Sub

Sub 清除剪貼簿內容()
　Dim data As New DataObject
　Set data = New DataObject
　data.SetText ""
　data.PutInClipboard
End Sub

運用的範例Code

Fn = GetFileTailer(.FoundFiles(i))

Workbooks.Open Filename:=.FoundFiles(i)

'MsgBox GetFileTailer(.FoundFiles(i))
'要複製的「來源」範圍
'---------------------------------------------------------------
Windows(Fn).Activate
Sheets("復原_Sheet1").Select
Range("A1:P65535").Select

'故意使用這個指令，以避免出現其他檔案的拷貝區域，然後出現對話框
Selection.Copy

'要被複製的「目的」範圍
'---------------------------------------------------------------
Windows(ThisWorkbook.Name).Activate
Sheets("Load").Select
Range("A1").Select

ActiveSheet.Paste

Dim DATA As New DataObject
Set DATA = New DataObject
DATA.SetText ""
DATA.PutInClipboard

'關閉
Workbooks(Fn).Close False, Fn

2010年10月20日星期三

VB.net EXCEL FillAcrossSheets用法

複製[來源]頁籤到其他[所有]的頁籤
若有ABCD四個頁籤，亦即複製A到BCD頁籤

MSDN 的範例
is example fills the range A1:C5 on Sheet1, Sheet5, and Sheet7 with the contents of the same range on Sheet1.

x = Array("Sheet1", "Sheet5", "Sheet7")
Sheets(x).FillAcrossSheets _
Worksheets("Sheet1").Range("A1:C5")

.net 可用的Code如下

XlsBook.Worksheets.FillAcrossSheets(XlsBook.Sheets(SelTargetList).Range("B7:D16"), Excel.XlFillWith.xlFillWithAll)

　　　

2010年10月19日星期二

VB.net EXCEL 跨頁籤(Sheet)複製表格內容

建議將EXCEL以早期繫結( early binding)的方式來做引用
Dim xlsExcel As New Excel.Application
Dim xlsBook As Excel.Workbook
Dim xlsSheet As Excel.Worksheet
Dim xlsRange As Excel.Range
xlsBook = xlsExcel.Workbooks.Open(My.Application.Info.DirectoryPath & "\file.xls")
xlsExcel.DisplayAlerts = False

為求處理上之效率，我們假設將已經有完備格式的Source頁籤，拷貝多份套入個別的數據。
假設要5份，分成複製套表5份，實際內容5份，共計10份。
複製後，將儲存內容的頁籤刪除
刪除頁籤時，別忘了頁籤若有內容，EXCEL會提醒，為避免程式無法遂行刪除作業，記得將 DisplayAlerts = False即可

For Each PP In DocNeedTelphoneInfo

'複製頁籤
xlsSheet = xlsExcel.Sheets("Source")
xlsSheet.Copy(xlsSheet)
xlsExcel.Sheets("Source (2)").Name = PP.Name & "A" '修改頁籤名稱

'跨頁籤拷貝資料內容
xlsSheet = CType(xlsBook.Worksheets(PP.Name), Excel.Worksheet)
'決定要拷貝的範圍
xlsRange = xlsSheet.Range("A6:O" & XlsCellCountList.Item(TargetI) + 6)
xlsRange.Copy()
xlsSheet = CType(xlsBook.Worksheets(PP.Name & "A"), Excel.Worksheet)
xlsRange = xlsSheet.Range("A6:O" & XlsCellCountList.Item(TargetI) + 6)
'貼上
xlsRange.PasteSpecial(Excel.XlPasteType.xlPasteAll, Excel.XlPasteSpecialOperation.xlPasteSpecialOperationNone, False, False)
'畫框線
xlsRange.Borders.LineStyle = Excel.XlLineStyle.xlContinuous
'解除之前的選取狀態
xlsRange = xlsSheet.Range("A6")
xlsRange.Select()

'刪除
xlsExcel.Sheets(PP.Name).delete()
'修改
'xlsExcel.Sheets(PP.Name & "A").Name = PP.Name '修改頁籤名稱
xlsExcel.Sheets(PP.Name & "A").Name = "d" & PP.Name '修改頁籤名稱

2010年10月18日星期一

VB.net EXCEL Sheet.copy導致的效率問題

使用頁籤的整個COPY可以節省程式碼的撰寫。
例如：活頁簿中有一個頁籤範本，若要針對一組號碼個別製作一個頁籤，並輸入資料在上頭。

若依照下列邏輯，會有大災難，效能會很差，甚至導致整個程式當掉。

依照個別目標，複製一頁，寫入資料，依此重複.....

For Each x In TargetList
'------------------------------------------------------------
objSheet = objExcel.sheets("Source")
objSheet.Copy(objSheet)
objExcel.sheets("Source (2)").Name = SelTargetList '修改頁籤名稱

SQL.....
range("A6")....、Cell
....

Next

若改為以下

先寫好所有內容(SQL-->Range、Cell)，最後再做copy頁籤的動作，然後複製到新COPY的頁籤，刪除所在的頁籤....
雖然寫起來有點複雜，但時間上會比較節省，提供參考。

2010年10月14日星期四

VB.net Listview 使用方式

'設定標題ListView1 Header
'********************************************************************************************************
With ListView1
.View = View.Details
.Columns.Add("A", 200, HorizontalAlignment.Left) '每次增加一個欄名稱欄寬度對齊
.Columns.Add("B", 150)
.Columns.Add("C", 50)
.Columns.Add("D", 110)
.Columns.Add("開始時間", 180
.GridLines = True
.LargeImageList = ImageList1 '增加 ICON 圖示對應
.SmallImageList = ImageList1 '增加 ICON 圖示對應
End With

'清除ListView1項目
ListView1.Items.Clear()

'以程式碼新增一筆資料
Dim Nitem As New ListViewItem(dr(0).ToString, 4) '4 wav.icon圖示
Nitem.SubItems.Add(TalkDirection)
Nitem.SubItems.Add(dr(2).ToString)
Nitem.SubItems.Add(dr(3).ToString)
Nitem.SubItems.Add(dr(4).ToString)
Nitem.SubItems.Add(dr(5).ToString)
ListView1.Items.Add(Nitem)

VB.net Listview 全選/全不選勾選框沒有反應?

請注意勾選框若要有反應 .Checked = True
.Selected = True 好像是用在無 CheckBox的狀態，不可與之混淆

MsgBox(ListView1.SelectedItems.Count)' 取得被選取的項目數量
MsgBox(ListView1.CheckedItems.Count) ' 取得被勾選的項目數量

'全選 / 全不選 ListView1
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
' / 全不選

If Button1.Text = "全選" Then

ListView1.MultiSelect = True '允許多選
For Each item As ListViewItem In ListView1.Items
item.Checked = True '勾選框才有反應
item.Selected = True'選取項目才有反應
Next

Button1.Text = "全不選"
Else

ListView1.MultiSelect = True '允許多選
For Each item As ListViewItem In ListView1.Items
item.Checked = False '勾選框才有反應
item.Selected = FalseTrue'選取項目才有反應

Next

Button1.Text = "全選"
End If
End Sub

2010年10月12日星期二

VS2008 IDE：XML檔案若無法依照階層排序的處理

若用VS2008開啟XML檔案時，XML呈現一整串字，而不是階層時。
請全選複製文字，剪下再重貼一次，即可呈現階層的XML文件。

2010年10月11日星期一

VB.net 全域變數? --> 類別shared

參考資料：
請問vb_net中全域變數要如何設定？
http://chip.byipo.cn/article/268478.html
[C#]如何達成全域變數的功能
http://www.dotblogs.com.tw/chou/archive/2009/03/11/7438.aspx

在VB.net裡已經沒有全域變數，請改用類別變數。
該類別變數，若要在整個應用程式中給其他類別使用，例如:Public Class FormXXXX 某表單
提供其他類別存取時，必須使用Shared關鍵字來宣告。

A:類別內使用
Public Class testUse
Dim Usetimes as integer
end Class

B:整個應用程式都可使用
Public Class testUse
public Shared Usetimes as integer
end Class

B部分，若不加上Shared ，引用相關程式碼時，會發生錯誤[會出現參考非共用成員需要物件參考]
例如：msgbox (testUse.Usetimes )

2010年10月10日星期日

VB.net 類別內有陣列的寫法(宣告，寫入，讀取)

Public Class MainParentCluster
Private _TargetIdentifier As String '目標名稱
Private _ConnectCount As Long '連結之物件數量

Private _aArrary() As Long '陣列，儲存數個數值

Public Property TargetIdentifier() As String '名稱
Get
Return _TargetIdentifier
End Get
Set(ByVal Value As String)
_TargetIdentifier = Value
End Set
End Property
Public Property ConnectCount() As Long '連結之物件數量
Get
Return _ConnectCount
End Get
Set(ByVal Value As Long)
_ConnectCount = Value
End Set
End Property
'屬性為陣列的用法
Public Property aArrary() As Long()
Get
Return _aArrary
End Get
Set(ByVal Value As Long())
_aArrary = Value
End Set
End Property
End Class

'寫入 ------------------------------------
Dim MainClusterObj As New List(Of ParentObj_SubCount)
Dim preCluster As String = ""
Dim ccnt As Long = 0
Dim i As Long
Dim k As New List(Of Long)

For i = 1 To 10 '測試寫入10筆資料!
preCluster = "A" & i
ccnt = i * 10
'自訂測試給予類別內的陣列 3筆資料
k.Add(i)
k.Add(i + 1)
k.Add(i + 2)
MainClusterObj.Add(New ParentObj_SubCount With {.ParentObjName = preCluster, .ChildCount = ccnt, .LineArrary = k.ToArray})
k.Clear()

Next

'讀取 ------------------------------------

Dim PP As ParentObj_SubCount
'Dim PP As MainParentCluster

Dim PPArray As String

For Each PP In MainClusterObj
PPArray = ""
For i = 0 To PP.LineArrary.Length - 1

PPArray &= i & "值=" & PP.LineArrary(i).ToString & ","
Next
Debug.Print(PP.ParentObjName & " " & PP.ChildCount & " " & PPArray)
Next

C# to VB.net 轉換網站

免費的C# to VB.net 轉換網站
http://www.developerfusion.com/tools/convert/csharp-to-vb/
上述測試過namespaces 轉換的OK

2010年10月1日星期五

VB.net 修改新增EXCEL頁籤

objExcel 為之前文件宣告過的物件

SelTargetList="想要的頁籤名稱"
'新增頁籤並設定相關欄位
objExcel.sheets.Add.Name = SelTargetList
With objExcel.sheets(SelTargetList)
.Range("A1").offset(0, 14).Value = "備考" '
End With

'修改現有的頁籤名稱 Sheet1 --> SelTargetList變數
objExcel.sheets("Sheet1").Name = SelTargetList

VB.net Excel新增超連結(網頁GoogleMaps、本機檔案路徑)

宣告物件方式，省略，因之前文件有介紹過了
寫入本機目錄，可開啟檔案。
若寫入網址，可開啟網頁。
以下為利用GoogleMaps查詢地址名稱及經緯度的範例

http://maps.google.com.tw/maps?q=臺北市忠孝東路一段xxx號
http://maps.google.com.tw/maps?q=25.xxx,121.xxxx

dr(xx).ToString '為資料庫擷取出來的資料

With objExcel.sheets("sheet1")

'基地台有資料，再送GOOGLE 查詢
.Hyperlinks.Add(.Range("A2").offset(i, 11), "http://maps.google.com.tw/maps?q=" & TransFmt_Address990930(dr(21).ToString), "", "點選我開啟網頁喔", dr(21).ToString)
.Hyperlinks.Add(.Range("A2").offset(i, 15), "http://maps.google.com.tw/maps?q=" & dr(24).ToString & "," & dr(23).ToString, "", "點選我開啟網頁喔", dr(21).ToString)

End If

2010年9月28日星期二

VB.net 類別內 Redim某陣列大小並設定值

'物件類別 Class ParentObj_SubCount
Public Class ParentObj_SubCount
Private _ParentObjName As String '父物件名稱
Private _Parentidx As Double '父物件ID
Private _ChildCount As Integer '共有多少子物件
Public aArrary(10) As Double'子物件的ID號碼
'Public aArrary() As Double = New Double() {} '子物件的ID號碼 (也可以先不指定)

Public Property ParentObjName() As String '父物件名稱
Get
Return _ParentObjName
End Get
Set(ByVal value As String)
_ParentObjName = value
End Set
End Property

Public Property Parentidx() As String '父物件ID
Get
Return _Parentidx
End Get

Set(ByVal value As String)
_Parentidx = value
End Set
End Property

Public Property ChildCount() As String '共有多少子物件
Get
Return _ChildCount
End Get

Set(ByVal value As String)
_ChildCount = value
End Set
End Property
End Class

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

程式內引用

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

Dim PosList As New List(Of ParentObj_SubCount)

Dim n As Integer
For n = 0 To 10
Dim Ps As New ParentObj_SubCount
Ps.Parentidx = n + 1
Ps.ParentObjName = "obj" & n.ToString

'ReDim Ps.aArrary(100) 此程式碼可重新指定陣列大小
Ps.aArrary(0) = 1 '指定值
Ps.aArrary(1) = 2 '指定值

PosList.Add(Ps) '新增入陣列

Next

Debug.Print(PosList(0).aArrary(0))
Debug.Print(PosList(0).aArrary(1))
Debug.Print("--------------------")
Debug.Print(PosList(1).aArrary(1))
Debug.Print(PosList(1).aArrary(2))

VB.net 不規則陣列

'宣告不規則陣列的格式
Dim a()() As String = New String(4)() {}

a(0) = New String() {"A", "B", "C", "D", "E"}
a(1) = New String() {"A", "C", "D"}
a(2) = New String() {"D", "E"}
a(3) = New String() {"F"}

'若要新增一個陣列的[內容]時，可使用以下方式
Dim mylist As New List(Of String)
mylist.Add("ss1")
mylist.Add("ss2")
a(4) = mylist.ToArray

'讀取不規則陣列
'以For Next
For i = 0 To a.Length - 1
For j = 0 To a(i).Length - 1
Debug.Print(a(i)(j))
Next
Next

'以For Each
Dim achild ()
Dim ChildStr As String
For Each achild In a
For Each ChildStr In achild
Debug.Print( ChildStr )
Next

Next

'若一開始不指定陣列大小，動態處理則....
Dim a()() As String = New String()() {}
ReDim a(3)

'若一開始沒有ReDim 陣列大小，會發生問題，若資料增加後才發現陣列不夠，請加上Preserve辜關鍵字，如下
ReDim Preserve a(3)

2010年9月27日星期一

WPF 圖片載入的問題 [找不到關於此像素格式的資訊]

暫時無解
DD.Source = Imgbmp '為何此行取消，就會有問題?

DD是一個既有的標籤物件。程式碼若不加上這一行，就會出現[找不到關於此像素格式的資訊]

Sub GenTelphone()

'讀取 BitmapImage
Dim Imgbmp As BitmapImage = New BitmapImage()
Dim ImgBrh As ImageBrush = New ImageBrush()
Imgbmp = New BitmapImage(New Uri("\image\mobile.gif", UriKind.RelativeOrAbsolute))

DD.Source = Imgbmp '為何此行取消，就會有問題?

Dim i As Integer

For i = 1 To 9

Dim Tb As New TextBlock

Dim img As New Image
img.Source = Imgbmp
img.Name = "Img" & i.ToString

Tb.Name = "Tbk" & i.ToString

Tb.TextAlignment = TextAlignment.Center '字型置中
Tb.Inlines.Add(img)

'在第一個段落後增加段落字元
Tb.Inlines.InsertAfter(Tb.Inlines.FirstInline, New LineBreak)

Tb.Inlines.Add(New Run("顯示資訊" & i.ToString))

Canvas.SetLeft(Tb, 50 * i)
Canvas.SetTop(Tb, 50 * i)

Canvas.SetZIndex(Tb, 25) '數字愈大，愈上層
Canvas.SetZIndex(Ln, 20)

'Canvas.SetLeft(img, 50 * i)
'Canvas.SetTop(img, 50 * i)
Tb.ToolTip = "我的NAME是 " & vbCrLf & vbCrLf & Tb.Name

MYCS.Children.Add(Tb)
Next

End Sub

2010年9月24日星期五

WPF (經驗談) 標籤內嵌事件與 AddHandler 之問題

若出現事件出現問題，若該事件是內嵌在XAML內，不妨取消。改以AddHandler 載入試試看。

例如以下Slider標籤，ValueChanged事件，將無法執行

若改以在WindowLoaded事件載入，就可以正常運作

AddHandler slider.ValueChanged, AddressOf slider_ValueChanged

Private Sub slider_ValueChanged(ByVal sender As System.Object, ByVal e As System.Windows.RoutedPropertyChangedEventArgs(Of System.Double))
Dim i As Integer
scaleTransform1.ScaleX = e.NewValue
scaleTransform1.ScaleY = e.NewValue

Dim centerOfViewport = New Point(scrollViewer.ViewportWidth / 2, scrollViewer.ViewportHeight / 2)
lastCenterPositionOnTarget = scrollViewer.TranslatePoint(centerOfViewport, grid)

WPF Drag-to-Scroll in WPF改寫為VBCode

資料來源
http://blogs.vertigo.com/personal/swarren/Blog/archive/2007/05/30/drag-to-scroll-in-wpf.aspx

改寫VBCODE如下

Xaml
---------------------------
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
Title="Window2" Height="300" Width="300" Loaded="Window_Loaded" PreviewMouseDown="Window_PreviewMouseDown" PreviewMouseMove="Window_PreviewMouseMove" PreviewMouseUp="Window_PreviewMouseUp">

HorizontalScrollBarVisibility="Hidden"
VerticalScrollBarVisibility="Hidden"
>

Code
---------------------------
Partial Public Class Window2

Private mouseDragStartPoint As Point
Private scrollStartOffset As Point

Private Sub Window_PreviewMouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Input.MouseButtonEventArgs)
mouseDragStartPoint = e.GetPosition(Me)

scrollStartOffset.X = myScrollViewer.HorizontalOffset
scrollStartOffset.Y = myScrollViewer.VerticalOffset

' Update the cursor if scrolling is possible
'this.Cursor = (myScrollViewer.ExtentWidth > myScrollViewer.ViewportWidth) ||
' (myScrollViewer.ExtentHeight > myScrollViewer.ViewportHeight) ?
' Cursors.ScrollAll : Cursors.Arrow;

Me.CaptureMouse()
MyBase.OnPreviewMouseDown(e)

End Sub

Private Sub Window_PreviewMouseMove(ByVal sender As System.Object, ByVal e As System.Windows.Input.MouseEventArgs)
If (Me.IsMouseCaptured) Then

' Get the new mouse position.
Dim mouseDragCurrentPoint As Point = e.GetPosition(Me)

'Determine the new amount to scroll.
Dim delta As New Point

If mouseDragCurrentPoint.X > Me.mouseDragStartPoint.X Then
delta.X = -(mouseDragCurrentPoint.X - Me.mouseDragStartPoint.X)
Else
delta.X = Me.mouseDragStartPoint.X - mouseDragCurrentPoint.X
End If

If mouseDragCurrentPoint.Y > Me.mouseDragStartPoint.Y Then
delta.Y = -(mouseDragCurrentPoint.Y - Me.mouseDragStartPoint.Y)
Else
delta.Y = Me.mouseDragStartPoint.Y - mouseDragCurrentPoint.Y
End If
'Scroll to the new position.
myScrollViewer.ScrollToHorizontalOffset(Me.scrollStartOffset.X + delta.X)
myScrollViewer.ScrollToVerticalOffset(Me.scrollStartOffset.X + delta.Y)

End If

MyBase.OnPreviewMouseMove(e)
End Sub
Private Sub Window_PreviewMouseUp(ByVal sender As System.Object, ByVal e As System.Windows.Input.MouseButtonEventArgs)
If (Me.IsMouseCaptured) Then
Me.Cursor = Cursors.Arrow
Me.ReleaseMouseCapture()
End If

MyBase.OnPreviewMouseUp(e)

End Sub
Private Sub Window_Loaded(ByVal sender As System.Object, ByVal e As System.Windows.RoutedEventArgs)
''center the label initially
myLabel.SetValue(Canvas.LeftProperty, ((myScrollViewer.ExtentWidth / 2) - (myLabel.ActualWidth / 2)))
myLabel.SetValue(Canvas.TopProperty, ((myScrollViewer.ExtentHeight / 2) - (myLabel.ActualHeight / 2)))
myScrollViewer.ScrollToHorizontalOffset((myScrollViewer.ExtentWidth / 2) - (myScrollViewer.ViewportWidth / 2))
myScrollViewer.ScrollToVerticalOffset((myScrollViewer.ExtentHeight / 2) - (myScrollViewer.ViewportHeight / 2))

End Sub

End Class

WPF 滑鼠滾輪事件MouseWheel 圖片放大縮小

MouseWheel的事件是寫在 WINDOW內，也可以寫在Image (但沒成功，可能要利用事件傳遞來完成!)

XAML
****************************************************
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
Title="Window1" Height="600" Width="600" MouseWheel="Image_MouseWheel" >

Code
****************************************************

Private Sub Image_MouseWheel(ByVal sender As System.Object, ByVal e As System.Windows.Input.MouseWheelEventArgs)

If e.Delta > 0 Then

imageScale.ScaleX = imageScale.ScaleX * 1.2
imageScale.ScaleY = imageScale.ScaleY * 1.2
Else
imageScale.ScaleX = imageScale.ScaleX * 0.8
imageScale.ScaleY = imageScale.ScaleY * 0.8

End If

End Sub

WPF 滑鼠滾輪事件MouseWheel

請注意，若有ScrollViewer此事件會被吸收掉。

XAML
'===================================================
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
Title="Window1" Height="600" Width="600" MouseWheel="Window_MouseWheel" >

程式碼
'===================================================
Private Sub Window_MouseWheel(ByVal sender As System.Object, ByVal e As System.Windows.Input.MouseWheelEventArgs)
If e.Delta > 0 Then
Me.Title = "往上滾動"
Else
Me.Title = "往下滾動"
End If
End Sub

WPF 滑鼠移動事件

假設已經動態產生以下物件，並指定事件
'設定當滑鼠指標移入 Ellipse 物件上方時所要執行的事件處理常式。

AddHandler Elp.MouseLeftButtonDown, AddressOf Elp_MouseDown
AddHandler Elp.MouseMove, AddressOf Elp_MouseMove
AddHandler Elp.MouseLeftButtonUp, AddressOf Elp_MouseUP

滑鼠事件：按下
'-----------------------------
Private Sub Elp_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs)

gloOriPos = e.GetPosition(Me.MYCS) '對哪一個物件取座標位置!
'偵測來源 sender 物件並進行轉換
Select Case sender.GetType.ToString
Case "System.Windows.Shapes.Ellipse"
Dim Selobj As Ellipse = TryCast(sender, Ellipse)
gloSelObjName = Selobj.Name
Dim idx As Integer = 2
'改變顏色
Selobj.Fill = New SolidColorBrush(Color.FromRgb(ToRGB(idx).R, ToRGB(idx).G, ToRGB(idx).B))

'********** 以目前選取的物件補捉滑鼠 ********** 這裡很重要
Selobj.CaptureMouse()

Case "System.Windows.Controls.TextBlock"
End Select

End Sub

滑鼠事件：　移動
'-----------------------------
Private Sub Elp_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs)

'偵測滑鼠左鍵是否仍然被按下
If e.LeftButton = MouseButtonState.Pressed Then

Dim NowPos As Point ' = e.GetPosition(Me.MYCS) '對哪一個物件取座標位置!
NowPos = e.GetPosition(Me.MYCS)

'滑鼠移動量()
Dim dx As Double = NowPos.X - gloOriPos.X
Dim dy As Double = NowPos.Y - gloOriPos.Y

'Me.Title = e.GetPosition(Me.MYCS).X & "," & e.GetPosition(Me.MYCS).Y

'偵測來源物件並轉型
Select Case sender.GetType.ToString
Case "System.Windows.Shapes.Ellipse"

Dim Selobj As Ellipse = TryCast(sender, Ellipse)

Canvas.SetLeft(Selobj, NowPos.X - (gloEllipseWidth / 2))
Canvas.SetTop(Selobj, NowPos.Y - (gloEllipseWidth / 2))
gloSelObjName = Selobj.Name

'呼叫移動線段的程式碼（假設該目標有好幾個線段連結）
Call LineMove("EL", Selobj)

Case "System.Windows.Controls.TextBlock"

End Select
'紀錄上次的位置
gloOriPos.X = NowPos.X
gloOriPos.Y = NowPos.Y

End If
　　
End Sub

滑鼠事件：放開
'-----------------------------
Private Sub Elp_MouseUP(ByVal sender As Object, ByVal e As MouseEventArgs)
'偵測來源物件並進行轉型
Select Case sender.GetType.ToString
Case "System.Windows.Shapes.Ellipse"
Dim Selobj As Ellipse = TryCast(sender, Ellipse)
gloSelObjName = Selobj.Name
'釋放滑鼠事件
Selobj.ReleaseMouseCapture()
'恢復原來的顏色
Dim idx As Integer = 1
Selobj.Fill = New SolidColorBrush(Color.FromRgb(ToRGB(idx).R, ToRGB(idx).G, ToRGB(idx).B))

Case "System.Windows.Controls.TextBlock"

End Select

End Sub

WPF 新增image於TextBlock內

' 讀取 BitmapImage
Dim Imgbmp As BitmapImage = New BitmapImage()
Dim ImgBrh As ImageBrush = New ImageBrush()
Imgbmp = New BitmapImage(New Uri("\image\mobile.gif", UriKind.RelativeOrAbsolute))

Dim i As Integer

For i = 1 To 5

Dim tb As New TextBlock

Dim img As New Image
img.Source = Imgbmp
img.Name = "IMG_" & i.ToString

tb.Name = "tb_" & i.ToString

'加入textblock元件內
tb.Inlines.Add(img)
tb.Inlines.Add(New Run("想要顯示的識別名稱"))

Canvas.SetLeft(tb, 50 * i)
Canvas.SetTop(tb, 50 * i)

tb.ToolTip = "我的NAME是 " & vbCrLf & vbCrLf & tb.Name

AddHandler tb.MouseMove, AddressOf Elp_MouseMove
AddHandler tb.MouseLeftButtonDown, AddressOf Elp_MouseDown
AddHandler tb.MouseLeftButtonUp, AddressOf Elp_MouseUP

MYCS.Children.Add(tb)
Next

2010年9月16日星期四

燒錄簡體檔名 ConvertZ軟體使用

下載位置
http://reg.softking.com.tw/freeware/download.asp?fid3=1763
http://ftp.isu.edu.tw/pub/Windows/softking/soft/cn/c/convertz802.zip

ConvertZ 批次幫檔案、資料夾名稱執行「繁/簡轉換」！
http://briian.com/?p=5784

將整個目錄下面的檔案簡體檔名轉用ConvertZ 轉換OK後，再拖到燒錄軟體內處理即可

2010年9月15日星期三

JavaScript TextArea 顯示段落符號的問題

引用文章
http://bshadow.pixnet.net/blog/post/23012030

此問題，不是從資料庫內擷取，再將
符號轉換成 \n
若資料是從cookies內讀取出來，要將 \n轉為 \r 或 \r\n
xxx.replace(/\n/g,'\r')

if ($.cookie(ThisA)!='') {

var XXX=$.cookie(ThisA);
XXX =XXX.replace(/\n/g,'\r'); // textarea 回車符號

$("#LoginView1_FormView1_txtContent").text(XXX);

}

2010年9月8日星期三

JQuery SetTimeOut的寫法

setTimeout(function ()
{ '要定期執行的程式碼}, 1000(一秒));
}

2010年8月31日星期二

JavaScript 下拉式選單，群組依照不同項目名稱區隔顏色

若FORM及SELECT元件均無ID，可用以下CODE
document.forms[0].group.options.length //取得SELECT項目的數量
NowV = document.forms[0].group.options[i].text; //取得現在項目的名稱

//初始化顏色
//----------------------------------------------------------------------------------------------------------------------
function InitColorAndSetCookies() {
var i = 0;
var lastV = 'test'; //紀錄上一筆項目的名稱，以供下次比對
var nowV = ''; //取得現在項目的名稱
var k = 0; //切換顏色用

for (i = 0; i < document.userForm.group.length; i++) {
//第一個不用處理外，其餘皆要處理
if (i != 0) {
//取得現在項目的名稱
nowV = document.getElementById("unit1").options[i].text;

//比對兩個項目的前三碼是否相同，含[xxxx] '比較長的單位名稱
if (lastV.indexOf("xxxx") == -1) {
if (nowV.substring(0, 3) != lastV.substring(0, 3)) { k = (k + 1) % 2; }
} else {
if (nowV.substring(0, 6) != lastV.substring(0, 6)) { k = (k + 1) % 2; }

}

if (k == 1) {
document.getElementById("unit1").options[i].style.backgroundColor = '#B3DFA7';
document.getElementById("unit1").options[i].style.color = 'black';
} else {
document.getElementById("unit1").options[i].style.backgroundColor = '#FFFF87';
document.getElementById("unit1").options[i].style.color = 'black';
}

//紀錄上一筆項目的名稱，以供下次比對
lastV = document.getElementById("unit1").options[i].text;
}
}
}

<表單 name="'userForm'" method="post" action="">
<下拉式選單 name=group id= unit1 >

2010年8月27日星期五

Clonezilla Live 、Ghost15、True Image等還原功能 EASEUS Partition

到網頁下載ISO燒錄成光碟

注意不管是saveparts或restoreparts
都是先選擇備份檔在的磁碟機(來源)
最後才是選要還原的地磁碟機(目的)

備份速度還蠻快的，但經過測試後，好像原始的來源不要超過16GB會比較好，Img存的大小約10GB左右

Ghost 15 感覺上系統很大，且備份及還原速度普普
由其是救援光牒的載入速度更是慢

True Image 備份速度不錯
且救援光牒的載入速度也不賴，排第二名。

EASEUS Partition Master v6.1.1 硬碟分割、管理、格式化工具！
也不錯用。

2010年8月26日星期四

XP換主機板不用重灌之心得(失敗)

將舊的硬碟系統轉移到新的硬碟上

前置作業
1.裝置管理員，將[電腦] 更新驅動程式為 [標準PC]
參考
"標準PC"<--任何電腦都適用(不支援ATX電源自動關閉) "Advanced Configuration and Power Interface (ACPI) PC"<--P2及P3等級以上電腦適用 "ACPI Multiprocessor PC"<--P4等級以上電腦適用 2.將正版光碟上的Driver.cab解壓縮四個檔案，複製到路徑為C:\WINDOWS\system32\drivers\
(atapi.sys intelide.sys pciide.sys pciidex.sys)
沒有的話,請放入XP光碟找I386資料夾裡面的driver.cab解開

3.然後把登錄檔 MERGEIDE.REG 匯入，再換主機板，重開機就會自動更新搜尋新的硬體
4.若需要做系統備份為映像檔，請先不用重新開機。

5.若仍無法開機，可先用ERD 2005將系統管理員的密碼去除，再用正版XP開機，使用R主控修復臺，協助處理。

6.

http://support.microsoft.com/kb/824125/zh-tw

取代失敗的主機板

Windows XP：

如果您正在提示 若要設定 Windows 現在，按 ENTER 鍵，按下 ENTER 鍵。

安裝程式會尋找任何先前安裝的硬碟上的 Windows XP，，然後顯示它找到任何先前安裝的清單。
使用方向鍵來選取您想要修復，在安裝，然後按下 R 以選取 [修復選取的 Windows 安裝，請按 R] 選項。

這會啟動先前的 Windows XP 安裝修復。

以上問題，尚未成功解決。

注意改成標準PC，要注意改的回來否。

另外，移植後，據說要等30-40分鐘，但沒有時間這麼嘗試

建議可以使用 Acroins True Image (With Universal Restore) 可以做到異機還原

2010年8月25日星期三

Windows 7 磁碟分割(C，再多分D或E)

Windows 7

在桌面上[我的電腦]右鍵按下[管理]
找[存放裝置]->[磁碟管理]
對某個磁碟區，按下右鍵[壓縮磁碟區]。例如C。Windows 7 好像會保留一個系統磁碟 (隱藏)?
看要對可用的空間，選擇多少成立新空間。
會產生一個未配置區。格式化後即可使用。

資料參考來源
http://7club.ithome.com.tw/question/10005353

2010年8月18日星期三

電腦採購各款CPU效能評比

http://www.anandtech.com/bench/CPU/25

裡頭可將多款CPU與多項軟體評測結果列出，值得參考

還有另外一個網站 cpu bench
http://7club.ithome.com.tw/question/10010526

http://www.tomshardware.com/charts/2009-desktop-cpu-charts-update-1/Adobe-Photoshop-CS-4,1387.html

2010年8月6日星期五

WORD VBA 表格合併時，如何對欄位取值

利用VBA迴圈取座標值時，若表格TABLE有合併的情形，取值時要注意使用 on error resume next，以避免錯誤。

而表A，取出的座標值結果，會如圖B。

Word VBA 取得文件內所有的表格，其欄位值分析

Sub tbl()

On Error Resume Next '忽略錯誤

Dim tblcnt As Integer
Dim R As Integer
Dim C As Integer
Dim i As Integer
Dim j As Integer

Dim tbs As Integer
tblcnt = Application.ActiveDocument.Tables.Count

'Debug.Print "tabel有 " & tblcnt & " 個 "
'Debug.Print "tabel一 R 有 " & R & " 個 C 有 " & C & " 個"

Dim S As String
Dim DataS As String

For tbs = 1 To tblcnt
Debug.Print "表格 " & tbs
Debug.Print "-------------------------------------------------------------------------------"

R = Application.ActiveDocument.Tables(tbs).Rows.Count
C = Application.ActiveDocument.Tables(tbs).Columns.Count

For i = 1 To R

DataS = " | "
For j = 1 To C
'Debug.Print Application.ActiveDocument.Tables(1).Cell(i, j).Range.Text
'S = Replace(Application.ActiveDocument.Tables(tbs).Cell(i, j).Range.Text, vbCrLf, "")
'若有些表格被合併時

S = Application.ActiveDocument.Tables(tbs).Cell(i, j).Range.Text

S = Replace(S, vbCr, "")
S = Replace(S, vbLf, "")

If Len(S) = 0 Then
DataS = DataS & " - | "
Else
DataS = DataS & "(" & i & "," & j & ") " & S & " | "
End If

Next

Debug.Print DataS
DataS = ""
Next

Debug.Print vbCrLf
Debug.Print vbCrLf

Next

End Sub

'輸出結果範例
'-----------------------------------------------------------------------------------

表格 1
-------------------------------------------------------------------------------
| (1,1) 1,1 | (1,2) 結束案件數 | (1,3) 7日內報案件數 | (1,4) 未於7日內報案件數 | (1,5) 未案件數 |
| (2,1) 93年 | (2,2) | (2,3) | (2,4) | (2,5) |
| (3,1) 94年 | (3,2) 19 | (3,3) 19 | (3,4) | (3,5) |
| (4,1) 95年 | (4,2) 25 | (4,3) 25 | (4,4) | (4,5) |
| (5,1) 96年 | (5,2) 37 | (5,3) 37 | (5,4) | (5,5) |
| (6,1) 97年 | (6,2) 62 | (6,3) 62 | (6,4) | (6,5) |
| (7,1) 98年 | (7,2) 106 | (7,3) 106 | (7,4) | (7,5) |
| (8,1) 合計 | (8,2) 252 | (8,3) 252 | (8,4) | (8,5) |

表格 2
-------------------------------------------------------------------------------
| (1,1) 各單位 | (1,2) 結束案件數 | (1,3) 7日內報案件數 | (1,4) 未於7日內報案件數 | (1,5) 未報案件數 |
| (2,1) 93年 | (2,2) 2,2 | (2,3) | (2,4) | (2,5) |
| (3,1) 94年 | (3,2) | (3,3) | (3,4) | (3,5) |
| (4,1) 95年 | (4,2) | (4,3) | (4,4) | (4,5) |
| (5,1) 96年 | (5,2) | (5,3) | (5,4) | (5,5) |
| (6,1) 97年 | (6,2) | (6,3) | (6,4) | (6,5) |
| (7,1) 98年 | (7,2) | (7,3) | (7,4) | (7,5) |
| (8,1) 合計 | (8,2) | (8,3) | (8,4) | (8,5) |

2010年8月5日星期四

Access 隨機文章的作法

SELECT 文章ID,文章內容 From [文章庫] Order By Rnd(文章ID)
或
SELECT 文章ID,文章內容 FROM [文章庫] ORDER BY Rnd(文章ID-timer())
(ORDER後，順序會不同)

參考自
http://www.softbunny.net/post/235.shtml

2010年7月29日星期四

VB.net AccessUpdate多個欄位的語法出錯問題

更新一個欄位，變數不加上[]，不會出問題
sql = "Update [1request] Set Warrantsn='" & MyC & "' where DocNo='" & Glo_Oid & "'"
'MsgBox(sql)
cmd = New OleDbCommand(sql, conn) '誇號裡的第一個是SQL的字串,第二個是資料庫的聯結=OleDbConnection

若有多個參數需要更新，記得每個欄位要加上[]
sql = "Update [2request_Record] Set [aleFound]='" & Sv(2) & "', [id]='" & Sv(3) & "', [mac]='" & Sv(4) & "', [msisdn]='" & Sv(5) & "', [user]='" & Sv(6) & "', [Palesn]='" & Sv(7) & "' where [Record_Seq]='" & Sv(1) & "'"

2010年7月28日星期三

StarDict 字典檔之使用、規格及初步處理

請於StarDict網站下載字典檔，以下為繁體字典檔下載位置
http://www.huzheng.org/stardict-iso/stardict-dic/zh_TW/
假設我們要下載的檔案路徑如下
http://www.huzheng.org/stardict-iso/stardict-dic/zh_TW/stardict-oxford-big5-2.4.2.tar.bz2

stardict-oxford-big5-2.4.2.tar.bz2
附檔名 .bz2 可直接用WinRAR解壓縮，請注意解壓縮時，winrar對於有簡體的文字時，壓縮會產生錯誤，請先改回正體字

解壓縮後會產生三個檔案，如下
1. oxford-big5.ifo
2. oxford-big5.idx (字典索引檔)
3. oxford-big5.dict.dz (字典內容檔)

序號1不用管，只處理2. 3.即可。
3.oxford-big5.dict.dz，請再用7Zip這個免費軟體，解壓縮
會解出oxford-big5.dict這個檔案，接下來才可以用程式處理。

Stradict檔案格式如下

oxford-big5.idx
-------------------------------------------------------------------------------
檔案內容的排列格式如下，每個單字均依照以下格式編排。
utf8 charset

word_str + '\0' + word_data_offset(4bytes =>32bit) + word_data_size(4bytes =>32bit)

單字 + '\0' + 單字所在的資料起始位置 (4bytes =>32bit) + 單字所含的資料量 (4bytes =>32bit)

請注意，在讀取word_data_offset及 word_data_size必須注意Big Endian與Little Endian的轉換(兩個互為顛倒)，取出值才會正確。
例如: ABCD ->DCBA

http://jyhshin.pixnet.net/blog/post/26587992
http://tw.myblog.yahoo.com/jw!oK9tZceCFQNXvuvgM5.r4fgC0css/article?mid=2052&prev=2053&next=2051
http://junxian-huang.blogspot.com/2008/10/big-endian-vs-little-endian.html

2的1次方=1
2的8次方=256
2的16次方=65536
2的32次方=16777216

位元往右移1，等於32

若用vb的BinaryReader的ReadByte方法，第一個讀取的位元
pos= Br.ReadByte() * 16777216 + Br.ReadByte() * 65536 + Br.ReadByte() * 256 + Br.ReadByte()

vb每執行ReadByte方法，讀取位置會自動往下一個Byte

oxford-big5.dict
-------------------------------------------------------------------------------
由oxford-big5.idx 取得相關的資料後，可以先存自定結構或類別中。
再逐byte去取得相關的內容

2010年7月26日星期一

壓縮 CSS 和 JavaScript 檔

CSS、JavaScript 在多檔合併後，應該進一步壓縮。
壓縮的動作會移除註解、空白處以及縮短變數名稱。許多工具都提供不同程度的壓縮功能。不過某些壓縮率較高的工具，可以在壓縮 CSS 和 JavaScript 檔案時，帶來更好的效果。
minify、YUI compressor、shrinksafe 和 Closure Compiler。這些工具功能複雜，其實用簡單的工具也能達到相同目的，不過還是有值得推薦的地方。

舉例來說，有些工具提供了線上壓縮功能（例如 Shrinksafe 和 YUI Compressor）。).

摘要自 http://msdn.microsoft.com/zh-tw/scriptjunkie/ff743754.aspx
改善網頁下載時間的最佳做法
Cody Lindley | 2010 年 6 月 11 日

鄭子璉網站 [Office 2010]Microsoft Office Document Imaging (MODI) 替代方案

資料來源
http://tlcheng.spaces.live.com/blog/cns!145419920BFD55A7!4905.entry

[Office 2010]Microsoft Office Document Imaging (MODI) 替代方案
MODI: Microsoft Office Document Imaging 包含幾個部分：

1. 虛擬印表機：Microsoft Office Document Image Writer
2. Microsoft Office Document Imaging Viewer (MSPView.exe)
3. Microsoft Office Document Scanning (MSPScan.exe)
4. 內嵌其中的 OCR 功能
5. 可程式化的 COM 元件

Office 2010 已移除了 MODI，若先前有安裝 MODI 時，在安裝 Office 2010 也會被自動移除。而從微軟在 Office 2007 的策略來看，微軟已經打定主意使用 XPS 取代 MODI ，但 XPS 檔案較大，且需要使用 IE 才能瀏覽，所以我一直不喜歡用，我通常的選擇是先用 MODI ，其次是 pdf 。

替代方案：

上述 3/4 的部分，在 Office 2010 是設計使用 OneNote 2010 內建的來取代，但是 OneNote 裡面的 OCR 辨識率低，很多人用不爽。

上述 1 的部分，可以安裝 Microsoft Office Live Meeting (2010 四月號) ，會自動建立一個虛擬印表機：Microsoft Office Live Meeting 2007 Document Writer ，此功能同 1，此軟體為線上會議使用，平常可瀏覽、參加微軟線上研討會，公司若有安裝 Server ，也可以用作公司線上會議使用。 (註：Download the Microsoft Office Live Meeting 2007 client 請在此下載，中文版網頁短路了，沒有連結)

上述 2 的部分，謠傳微軟將在近期提供 MODI Viewer 的軟體給使用者下載，解決目前無法瀏覽 MODI 文件的問題。

上述 5 的部分目前沒看到替代方案，早先由於 MODI 的功能強大，很多開發者到微軟網站下載 MODI SDK 線上手冊，來開發對應功能，例如先用 VBNET 將圖檔存成 tif 格式後，再用 MODI 載入，用其中的 OCR 功能識別文字等。

拆成這麼散，所以當然不方便使用，所以微軟建議若有需要此功能，暫時可在安裝完 Office 2010 後，再用自訂安裝 Office 2007 將 MODI 裝起來，我目前是這樣裝啦，不過很不方便，所以我一般虛擬文件應該會改投向 pdf 了。

我目前是用 Bullzip 的 PDF Printer，這套是免費的，官網有中文可下載，可另存為多種圖檔格式，無廣告，且產生的 pdf 檔案較小，在 6.x 版以前，中文路徑或檔名可能發生錯誤，在 7.x 以後已沒遇過此問題。

MODI 看起來是微軟在 Office 元件中，繼 OWC 後下一個被砍的好用功能，說實在的，不知道微軟上層腦袋在想啥，OWC / MODI 都是很好用的東西，居然都被停止支援，弄得使用者怨聲載道，這也是一種神奇。

2010年7月25日星期日

ASP.net getjson 處理回傳的Json 格式

function GetArticle(Sid,controlName,Ds ) { //標記文章
Selid=Sid; //將文章ID記錄下來
NowPos =controlName; //990714紀錄在表格中的位置
$("#Tagzone").html("");

$("#Subj").val("");
$("#Ac").val("");
$.blockUI({ message: '

處理中，請耐心稍後喔…

' });

//$.getJSON("QueryArticle.ashx?Qid=" + Sid, function(Vdata) {
//990714 改善GET的Cache問題
$.getJSON("QueryArticle.ashx?Qid=" + Sid + "&d=" + Ds +"&q="+new Date().getTime(), function(Vdata) {
//處理 TAG 陣列
var tn="";
tn=Vdata.TagV;

XXX=Vdata.SugV
$("#Subj").html(XXX );

XXX=Vdata.MsgV
//將原本是段落字元的部分，轉換為

XXX =XXX.replace(/
/g,"\n")
XXX =XXX.replace(/(^\s*)|(\s*$)/g, "");

$("#Ac").val(XXX );

});

ASP.net 產生Json 格式(注意段落字元)

引用資料庫與法(略)
dv = ads.Select(New DataSourceSelectArguments)

If dv.Count <> 0 Then
'JOSN的基本格式如下() 多筆資料的寫法
'{ 'dataset' : [ {'id' :'1' , 'name' : 'ABC'}
', {'id' : '2', 'name' : 'CDE'}
', {'id' : '3', 'name' : 'EFD'}]}

'990507 因簡易版，只有1筆資料故採此架構
'{ "A": "xxxxxxx.",
' "B": "yyyyyyyyyyyy",
' "C": [1, 2]
'}
sb.Append("{ ")
sb.Append("""TagV"" : """ & dv.Item(0).Item("tag") & """ , ") '寫入第一個參數，tag
sb.Append("""SugV"" : """ & dv.Item(0).Item("subject") & """, ")
sb.Append("""MsgV"" : """ & ReplaceComma(dv.Item(0).Item("Message")) & """} ") '寫入第2個參數，Message

'看不見的段落字元很恐怖!! 會導致 JSON出現錯誤! 990622
sb.Replace(vbCrLf, "
")
sb.Replace(vbCr, "
")
sb.Replace(vbLf, "
")
context.Response.Write(sb.ToString)

2010年7月22日星期四

EXCEL VBA 呼叫WORD VBA輸出文檔(依照文章數量切割檔案)

'主文件
'-----------------------------------------------------------
'載入資料庫所需引用相關變數
Dim Conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim SqlString As String
Dim i As Integer

Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.Path & "\xxxx.MDB"

Dim StartTime As Date
StartTime = Now

SqlString = " Select * from [a] order by BuildTime desc"

Dim OriV As String
Dim Nowid As Integer

'*******************************************************************
'
' 變數資料處理完成，傳送資料到WORD應用程式。
'
'*******************************************************************
Dim Myword As New Word.Application
Dim Newdoc As Word.Document

Myword.Caption = ""
'Myword.Visible = True

Set Newdoc = Myword.Documents.Open(ThisWorkbook.Path & "\模板.doc", , True) '設定成「唯讀」以免資料被寫入。
Dim objSelection
Set objSelection = Myword.Selection

Dim Spage As String '要寫入目前的頁數
Dim SelContent As String '寫入的內容暫存用
Dim SeparatePage As Integer 一個檔案要多少頁
Dim SeparatePageFileCount As Integer 分頁的檔案編號
SeparatePage = 50 1頁要多少筆資料
SeparatePageFileCount = 0
Const PerItem As Integer = 8

'停用文法檢查避免資料輸出太多時的檢查
'Newdoc.GrammarChecked = False

Dim Fn As String

'Myword.Selection.HomeKey

objSelection.TypeParagraph
objSelection.TypeParagraph

'NewDoc.FormFields("pName").Range.Text = Range("E2")
i = 0
While Not rs.EOF

DoEvents '避免當機
i = i + 1

'為利分段處理將 I 列入統計
If i >= 1 Then

'************************************************************************************************************************
'
' 每 800筆，製作一個檔案因為每 8 筆一頁
'
'************************************************************************************************************************
If ((i) Mod (SeparatePage * PerItem)) = 1 And (i <> 1) Then '每頁*幾筆?

'最後插入目錄
objSelection.HomeKey Unit:=wdStory, Extend:=wdMove '移到最前方

'產生目錄(這個部分從WORD 錄製巨集後，複製過來時要修改一些參數，例如 With Newdoc、 objSelection.Range )
With Newdoc
.TablesOfContents.Add Range:=objSelection.Range, RightAlignPageNumbers:= _
True, UseHeadingStyles:=True, UpperHeadingLevel:=1, _
LowerHeadingLevel:=2, IncludePageNumbers:=True, AddedStyles:="", _
UseHyperlinks:=True, HidePageNumbersInWeb:=True, UseOutlineLevels:= _
True
.TablesOfContents(1).TabLeader = wdTabLeaderDots
.TablesOfContents.Format = wdIndexIndent
End With

Debug.Print i & " " & rs("DiscussID")

'先存上一個檔案，再開啟一個新檔案
SeparatePageFileCount = SeparatePageFileCount + 1
Fn = Year(Date) - 1911 & "-" & Month(Date) & "-" & Day(Date) & " [ 筆數 " & (i - SeparatePage * PerItem) & "-" & (i - 1) & " ]文章" & Right("0" & SeparatePageFileCount, 2) & ".doc"
Newdoc.SaveAs ThisWorkbook.Path & "\" & Fn

Newdoc.Close
Set Newdoc = Nothing

Set Newdoc = Myword.Documents.Open(ThisWorkbook.Path & "\文章.doc", , True) '設定成「唯讀」以免資料被寫入。
Set objSelection = Myword.Selection
objSelection.TypeParagraph
objSelection.TypeParagraph

End If

If (i Mod PerItem) = 1 Then
Spage = -Int(-i / PerItem)
objSelection.TypeText ("頁碼： " & Spage) '無條件進位!
objSelection.Style = Newdoc.Styles("標題 1")
objSelection.TypeParagraph
End If

'If Year(UPdateTime) >= 2010 And Month(UPdateTime) >= 7 Then
' objSelection.TypeText ("編號： " & rs("DiscussID") & " " & " 已OK ")
' objSelection.Style = Newdoc.Styles("標題 2")
' objSelection.TypeParagraph
'Else

SelContent = "編號： " & rs("DiscussID") & " " & rs("Subject")
SelContent = Replace(SelContent, vbCrLf, "")
SelContent = Replace(SelContent, vbCr, "")
SelContent = Replace(SelContent, vbLf, "")

objSelection.TypeText (SelContent)
objSelection.Style = Newdoc.Styles("標題 2")
objSelection.TypeParagraph

'處理字串
SelContent = Replace(rs("Message"), ",", "，")
SelContent = Replace(SelContent, ";", "；")

SelContent = Replace(SelContent, vbCrLf, "
")
SelContent = Replace(SelContent, vbCr, "
")
SelContent = Replace(SelContent, vbLf, "
")

SelContent = Replace(SelContent, "

", vbCrLf)
SelContent = Replace(SelContent, "
", vbCrLf)

objSelection.TypeText (SelContent)
'End If

'objSelection.Style = ActiveDocument.Styles("標題 3")

objSelection.TypeParagraph
objSelection.TypeParagraph
objSelection.TypeParagraph
objSelection.TypeParagraph

'Debug.Print i & " " & rs("DiscussID")
rs.MoveNext

'If i > 50 Then
' GoTo lab:
'End If

End If

Wend

lab:

'最後插入目錄
objSelection.HomeKey Unit:=wdStory, Extend:=wdMove '移到最前方

'產生目錄(這個部分從WORD 錄製巨集後，複製過來時要修改一些參數，例如 With Newdoc、 objSelection.Range )
With Newdoc
.TablesOfContents.Add Range:=objSelection.Range, RightAlignPageNumbers:= _
True, UseHeadingStyles:=True, UpperHeadingLevel:=1, _
LowerHeadingLevel:=2, IncludePageNumbers:=True, AddedStyles:="", _
UseHyperlinks:=True, HidePageNumbersInWeb:=True, UseOutlineLevels:= _
True
.TablesOfContents(1).TabLeader = wdTabLeaderDots
.TablesOfContents.Format = wdIndexIndent
End With

'修改滑鼠游標
'Me.MousePointer = vbNormal
SeparatePageFileCount = SeparatePageFileCount + 1
Fn = Year(Date) - 1911 & "-" & Month(Date) & "-" & Day(Date) & " [ 筆數 " & (i - SeparatePage * PerItem) & "-" & (i - 1) & " ]文章" & Right("0" & SeparatePageFileCount, 2) & ".doc"

Newdoc.SaveAs ThisWorkbook.Path & "\" & Fn

'清除與WORD物件的連結。
Newdoc.Close
Myword.Quit

Set Newdoc = Nothing
Set Myword = Nothing

MsgBox "請在程式所在目錄之下尋找剛才所建立的WORD檔案！" & vbCrLf & "檔名：" & Fn

MsgBox "完成! 耗時 " & DateDiff("s", StartTime, Now) & "秒"

注意，在處理多個檔案時，Newdoc.Close、Myword.Quit會減少記憶體的耗用!很重要，以免當機。

WORD VBA的參考資料

http://www.feiesoft.com/vba/word/
http://msdn.microsoft.com/en-us/library/aa172318%28office.11%29.aspx

vb 無條件進位法

vb6 無條件進位法

b = -Int(-a)

注意一下
使用Int 和 Fix函數都會去掉數字的小數點部份，回傳整數
當數字為<0時，Int函數會傳回小於或等於數字的第一個負整數，而 Fix函數則會傳回大於或等於數字的第一個負整數。
例如：
Int 將 -1.3 轉成 -2
Fix 將 -7.3 轉成 -7

2010年7月14日星期三

JQuery getJson與timespan

$.blockUI({ message: '

處理中，請耐心稍後喔…

' });

// 改善GET的Cache問題
$.getJSON("QueryArticle.ashx?Qid=" + Sid +"&T="+new Date().getTime(), function(Vdata) {
//處理 TAG 陣列
var tn="";
tn=Vdata.TagV;
//自動產生 Tag標記
var Slt='';
var cnt=0;

for( var i = 0; i < tagCnt; i++ ) {
if( tn.indexOf("x" + (i+1) + "x" ) !=-1 ) {
//alert((i+1) + ' _ ' + tn + ' ' + tn.indexOf("x" + i + "x" ) );
//Slt=Slt + "" + tagN[i+1] + '' ;
Slt=Slt + "" + (i+1) +'.' + tagN[i+1] + ' ' ;

} else {
//Slt=Slt + "" + tagN[i+1] + '' ;
Slt=Slt + "" + (i+1) +'.' + tagN[i+1] + ' ' ;

}
//每行排列三個控制項 cnt+=1 ;
if (cnt==4) {

Slt=Slt + "
"
cnt=0;
}

}

2010年6月28日星期一

ASP.net 將動態資料寫成HTML再以JS載入

前端
--------------------------------------------------------------------------------------

'原來的跑馬燈改為以JS載入

/* 以 JS 載入跑馬燈內容 */
$('#marqueeText').load('../Marquee.html');

後端
--------------------------------------------------------------------------------------

Protected Sub FormView1_ItemUpdated(ByVal sender As Object, ByVal e As System.Web.UI.WebControls.FormViewUpdatedEventArgs)

'只要有更新過資料，就寫入新的設定檔 990617
Dim OutPutMsg As String = ""
Dim sw As New System.IO.StreamWriter(Server.MapPath("../Marquee.html"), False, System.Text.Encoding.UTF8)

'取得SQL 資料庫內容
'***************************************************************************************************************
Dim ads As New AccessDataSource("~/App_Data/AAA.mdb", "")
Dim dv As Data.DataView
Dim sb As New StringBuilder
Dim i As Integer
Dim markS As String = " "
ads.SelectCommand = " SELECT * FROM [marquee] WHERE VIS = 1 ORDER BY CTIME DESC "
dv = ads.Select(New DataSourceSelectArguments)
If dv.Count <> 0 Then
For i = 0 To dv.Count - 1
sb.Append("" & markS & markS & "

" & markS & markS & dv.Item(i).Item("marqueeText") & " ")
Next
End If
sw.WriteLine(sb.ToString)
sw.Flush()
sw.Close()
sw.Dispose()

'***************************************************************************************************************

End Sub

WORDVBA 設定文件內的圖剪裁大小

Sub getPic()

Dim objDoc As Document
Dim oPic As InlineShape

Set objDoc = ActiveDocument
Application.ScreenUpdating = True

For Each oPic In objDoc.InlineShapes

oPic.PictureFormat.CropTop = 105
oPic.PictureFormat.CropBottom = 10
'oPic.ScaleHeight = 35 ', msoFalse, msoScaleFromTopLeft

Next
MsgBox "OK"

End Sub

EXCEL VBA 輸出陣列到 WORD TABLE(月曆) 摘要

'*******************************************************************
'
' 變數資料處理完成，傳送資料到WORD應用程式。
'
'*******************************************************************
Dim Myword As New Word.Application
Dim Newdoc As Word.Document
Dim tbl As Word.Table

'Set Myword = CreateObject("Word.Application")
Myword.Caption = ""

'Myword.ActiveDocument.Path
'Myword.Visible = True

Set Newdoc = Myword.Documents.Open(ThisWorkbook.Path & "\Month.doc", , True) '設定成「唯讀」以免資料被寫入。

Newdoc.FormFields("MonthV").Range.Text = SelMonth & "月份一覽表"

'NewDoc.FormFields("pName").Range.Text = Range("E2")

'*************************************************************8
'增加表格

SelDate = DateSerial(Year(Date), SelMonth, 1)
SelDate2 = DateAdd("m", 1, SelDate)
TotalDays = DateDiff("d", SelDate, SelDate2)
' Debug.Print SelDate & " " & SelDate2
' Debug.Print TotalDays & " " & Selw

'Exit Sub

Set tbl = Newdoc.Tables(1)

Dim Rows As Integer
Rows = 2
'依照(陣列)資料輸出到表格
For i = 1 To TotalDays
SelDate2 = DateAdd("d", i - 1, SelDate)
Selw = Weekday(SelDate2, vbSunday)

tbl.Cell(Rows - 1, Selw).Range.Text = SelMonth & "/" & Day(SelDate2) & "(" & TransWeekName(Selw) & ")"
tbl.Cell(Rows, Selw).Range.Text = DayArray(i)

Debug.Print " (" & (Rows - 1) & "," & Selw & ") " & SelMonth & "/" & Day(SelDate2) & "(" & TransWeekName(Selw) & ")"
Debug.Print " (" & (Rows) & "," & Selw & ") " & SelMonth & "/" & Day(SelDate2) & "(" & TransWeekName(Selw) & ")"

If Selw = 7 Then '7星期六 1 星期日
Rows = Rows + 2
End If
Next

If Rows <= 10 Then
tbl.Rows.Last.Delete
tbl.Rows.Last.Delete
End If

'修改滑鼠游標
'Me.MousePointer = vbNormal
Dim Fn As String
Fn = Year(Date) - 1911 & "-" & Month(Date) & "-" & Day(Date) & " [ " & SelMonth & " ]月份差假表" & ".doc"

Newdoc.SaveAs ThisWorkbook.Path & "\" & Fn

'清除與WORD物件的連結。
Newdoc.Close
Myword.Quit

Set Newdoc = Nothing
Set Myword = Nothing

MsgBox "請在程式所在目錄之下尋找剛才所建立的WORD檔案！" & vbCrLf & "檔名：" & Fn

EXCEL VBA ADO CRUD的命令執行

'載入資料庫所需引用相關變數
Dim conn2 As New ADODB.Connection
Dim rs2 As ADODB.Recordset
Dim SqlString As String
Dim i As Integer

conn2.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.Path & "\holidaydb.MDB"

SqlString = " insert into [db](rank,name,class,fromwhen,towhen,Hcount) values('" & _
x1 & "','" & x2 & "','" & x3 & "','" & x4 & "','" & x5 & "'," & x6 & ")"

conn2.Execute (SqlString)

ret = MsgBox("請問是否寄信通知當事人?", vbYesNo, "提醒寄送電子郵件")

If ret = vbYes Then
' Call MailSend(Range("B16"))
MsgBox "您已成功新增一筆資料，並寄出通知信!"
Else
MsgBox "您已成功新增一筆資料!"
End If

End Sub

EXCEL VBA ADO資料操作 WHILE WEND

'載入資料庫所需引用相關變數
Dim conn2 As New ADODB.Connection
Dim rs2 As New ADODB.Recordset
Dim SqlString As String
Dim i As Integer

conn2.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.Path & "\holidaydb.MDB"

SqlString = " select * From [DB] "

rs2.Open SqlString, conn2, adOpenKeyset, adLockOptimistic

rs2.MoveLast
rs2.Delete
rs2.Update

MsgBox "您已成功刪除[剛才建立的資料]!"

>>>>>>
While not rs2.eof
xxxxxxxxxxxxx
rs2.movenext
wend

EXCEL VBA呼叫OUTLOOK寄信(單一收件者，沒附件)

'產生郵件內容!! (傳入要寄送的EmailAddress)
Sub MailSend(ByVal EmailCC As String)

Dim i As Integer
Dim MailContent As String
Dim MySubject As String

'依照個人訊息決定的動態郵件內容
Dim MailComboMsg As String

Dim SenderEml As String '副本接收者

MySubject = Sheets("mailContent").Range("B1")
MailContent = Sheets("mailContent").Range("B2")
SenderEml = Sheets("mailContent").Range("B3")

'MailContent = Replace(MailContent, "", Sheets("input").Range("C5"))
'MailContent = Replace(MailContent, "", Sheets("input").Range("E5"))
'MailContent = Replace(MailContent, "", Sheets("input").Range("B7"))
'MailContent = Replace(MailContent, "", Sheets("input").Range("B13"))
'MailContent = Replace(MailContent, "", Sheets("input").Range("B14"))
'MailContent = Replace(MailContent, "", Sheets("input").Range("B15"))
'MsgBox MailContent
'Exit Sub

Dim ol As Outlook.Application
Dim ns As Outlook.Namespace
Dim newMail As Outlook.MailItem

Dim k As String
'目前清單的範圍

'同一個人代為聯絡的數量
Dim nCount As Integer
'Set fso = CreateObject("Scripting.FileSystemObject")

Set ol = New Outlook.Application
'Return a reference to the MAPI layer.
'-------------------------------------------------------------------------------------------------

'準備寫入郵件！
'******************************************************************************************
Set ns = ol.GetNamespace("MAPI")
ns.Logon
'Create a new mail message item.
Set newMail = ol.CreateItem(olMailItem)

With newMail

'Add the subject of the mail message.
.Subject = MySubject

'Create some body text.

'Add a recipient and CC and test to make sure that the
'addresses are valid using the Resolve method.
'郵件位址判斷使用者是要使用字串或是清單

'MsgBox "收件者：" & X.Value

With .Recipients.Add(EmailCC)

.Type = olTo

If Not .Resolve Then
MsgBox "Unable to resolve address: TO", vbInformation
Exit Sub
End If
End With

With .Recipients.Add(SenderEml)
.Type = olBCC
If Not .Resolve Then
MsgBox "Unable to resolve address: Bcc", vbInformation
Exit Sub
End If
End With

'.Body = txtContentString.Text
'"nnn@email.ccc.tw"

MailContent = Replace(MailContent, "", Sheets("input").Range("C5"))
MailContent = Replace(MailContent, "", Sheets("input").Range("E5"))
MailContent = Replace(MailContent, "", Sheets("input").Range("B7"))
MailContent = Replace(MailContent, "", Sheets("input").Range("B13"))
MailContent = Replace(MailContent, "", Sheets("input").Range("B14"))
MailContent = Replace(MailContent, "", Sheets("input").Range("B15"))

.Body = MailContent
'.Attachments.Add (ThisWorkbook.Path & "\xxxx.doc")
'.Attachments.Add (ThisWorkbook.Path & "\" & num1 & "文章.doc")

'Send the mail message.
.Send

End With

ns.Logoff

Set ns = Nothing
Set newMail = Nothing

'----------------------------------------------------------------------------------------------------
'Release memory.
Set ol = Nothing
'MsgBox "寄送完成"

End Sub

EXCEL VBA壓縮ACCESS資料庫(版本2003)

先在【專案】【設定引用項目】中加入 Microsoft Jet and Replication Objects X.X library

有密碼的版本
jro.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & txt1.Text & ";Jet OLEDB:Database Password=" & txt2.Text, _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & txt3.Text & ";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Password=" & txt4.Text
壓縮時，可同時改MDB的密碼

Public Sub CompactJetDatabase()
Dim ret

ret = MsgBox("請問是否進行資料壓縮?", vbYesNo, "資料庫壓縮")

If ret = vbNo Then
Exit Sub
End If

Dim SelDB As String
Dim SelDB2 As String
SelDB = ThisWorkbook.Path & "\" & "A1.mdb"
SelDB2 = ThisWorkbook.Path & "\" & "A2.mdb"

Dim jro As jro.JetEngine
Set jro = New jro.JetEngine

'引擎版本號
'Jet OLEDB:Engine Type -> Jet x.x Format MDB Files
'1 -> JET10
'2 -> JET11
'3 -> JET2X
'4 -> JET3X
'5 -> JET4X

jro.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & A1 , "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & A2 & ";Jet OLEDB:Engine Type=5"

Kill A1 '刪除舊的
Name A2 As A1 '變更名稱

MsgBox "壓縮/修復成功!"

End Sub

2010年6月22日星期二

EXCEL 計算文字的ASCII碼

Sub cal()

'計算文字的ASCII碼
Application.ScreenUpdating = False
Dim MyRng As Range
Dim x As Range
Dim i As Integer
Dim p As Integer

Dim cnt As Double

Set MyRng = Range("C2:C" & Range("C65535").End(xlUp).Row)

For Each x In MyRng

p = Len(x.Value)

For i = 1 To p
cnt = cnt + Asc(Mid(x.Value, i, 1))

Next
x.Offset(0, 1).Value = cnt
cnt = 0
Next

MsgBox "SUCCESS"

End Sub

2010年6月9日星期三

[野生動物保育法]筆記：非業者賣放生鳥的法律責任(純屬個人見解)

Q 路邊販賣放生鳥(非保育類)的人，有無法律責任，目前找的資料參考如下

第三十六條
以營利為目的，經營野生動物之飼養、繁殖、買賣、加工、進口或出口者，應先向直轄市、縣 (市) 主管機關申請許可，並依法領得營業證照，方得為之。
野生動物之飼養、繁殖、管理辦法，由中央主管機關定之。

第四十九條
有下列情形之一，處新台幣六萬元以上三十萬元以下罰鍰：
一、違反第十七條第一項或第二項管制事項者。
二、違反第十九條第一項規定，使用禁止之方式，獵捕一般類野生動物者。
三、違反第十九條第二項或第三十三條規定，規避、拒絕或妨礙者。
四、違反第二十七條第一項規定者。
五、違反第三十四條規定，其場所及設備不符合標準者。
六、違反第十八條第二項或第三十六條規定，未申請許可者。
違反第十七條第一項、第二項或第十九條第一項規定，該管直轄市、縣 (市) 主管機關得撤銷其許可證。

Q 抓放生鳥的方法(不得以下列方法為之)

第十九條
獵捕野生動物，不得以下列方法為之：
一、使用炸藥或其他爆裂物。
二、使用毒物。
三、使用電氣、麻醉物或麻痺之方法。
四、架設網具。
五、使用獵槍以外之其他種類槍械。
六、使用陷阱、獸鋏或特殊獵捕工具。
七、其他經主管機關公告禁止之方法。
未經許可擅自設置網具、陷阱、獸鋏或其他獵具，主管機關得逕予拆除並銷毀之。土地所有人、使用人或管理人不得規避、拒絕或妨礙。

2010年6月4日星期五

WPF 圖檔與設定至SHAPE

'宣告陣列，將陣列值加入LIST控件中
Dim ss() As String = {"hills.jpg", "Suns.jpg", "lilies.jpg", "Wins.jpg"}
Lst_Img.Items.Add(ss(0))
Lst_Img.Items.Add(ss(1))
Lst_Img.Items.Add(ss(2))
Lst_Img.Items.Add(ss(3))

'插入圖片
Private Function ImgAddIn() As Boolean

Dim Imgbmp As BitmapImage = New BitmapImage() '圖片物件
Dim ImgBrh As ImageBrush = New ImageBrush() '影像筆刷

'BitmapImage
Imgbmp = New BitmapImage(New Uri(sAdImg, UriKind.RelativeOrAbsolute))
ImgBrh.ImageSource = Imgbmp '影像控件載入圖片

Dim res As Boolean
'只有圓,矩形,橢圓可以設定圖檔
Select Case SelNm.Substring(0, 2)
Case "Ci"
Canvas_Draw.Children(SelNo).SetValue(Ellipse.FillProperty, ImgBrh)
res = True
Case "Re"
Canvas_Draw.Children(SelNo).SetValue(Rectangle.FillProperty, ImgBrh)
res = True
Case "Ep"
Canvas_Draw.Children(SelNo).SetValue(Ellipse.FillProperty, ImgBrh)
res = True
End Select
Return res
End Function

WPF 刪除物件

'找出選取物件
If Canvas_Draw.FindName("Rec" + RecRec(0).ToString()) IsNot Nothing Then
Canvas_Draw.Children.RemoveAt(RecRec(0))
AllNo = AllNo - 1
End If
If Canvas_Draw.FindName("Rec" + RecRec(1).ToString()) IsNot Nothing Then
Canvas_Draw.Children.RemoveAt(RecRec(1) - 1)
AllNo = AllNo - 1
End If

'刪除選取的元件
Dim Rs As MessageBoxResult
Rs = MessageBox.Show("確定要刪除" + SelNm + "嗎?", "刪除元件", MessageBoxButton.OKCancel)
If Rs.ToString() = "OK" Then
Canvas_Draw.Children.RemoveAt(SelNo)
End If
Bdel = False

WPF 計算移動量

Public Sub EpsAdj(ByVal adjN)
Dim w1, h1, dx, dy As Double
'上方,垂直調整
If adjN = 0 Then

'計算垂直移動量
dy = CurPos.Y - Atp

If Math.Abs(dy) < h1 =" Math.Abs(Ahh"> Ahh Then
h1 = Math.Abs(Ahh + dy)
End If

If h1 > 0.0 Then
Canvas_Draw.Children(SelNo).SetValue(Canvas.LeftProperty, Alf)
Canvas_Draw.Children(SelNo).SetValue(Canvas.TopProperty, CurPos.Y)
Canvas_Draw.Children(SelNo).SetValue(Ellipse.WidthProperty, Aww)
Canvas_Draw.Children(SelNo).SetValue(Ellipse.HeightProperty, h1)
End If
ElseIf adjN = 1 Then
'計算垂直移動量
dx = CurPos.X - OldPos.X
If Math.Abs(dy) < w1 =" Math.Abs(Aww"> Aww Then
w1 = Math.Abs(Aww + dx)
End If
If w1 > 0.0 Then
Canvas_Draw.Children(SelNo).SetValue(Canvas.LeftProperty, Alf)
Canvas_Draw.Children(SelNo).SetValue(Canvas.TopProperty, Atp)
Canvas_Draw.Children(SelNo).SetValue(Ellipse.WidthProperty, w1)
Canvas_Draw.Children(SelNo).SetValue(Ellipse.HeightProperty, Ahh)
End If
ElseIf adjN = 2 Then

'計算垂直移動量
dy = CurPos.Y - OldPos.Y
If Math.Abs(dy) < h1 =" Math.Abs(Ahh"> Ahh Then
h1 = Math.Abs(Ahh - dy)
End If

End Sub

WPF 取得Children下的屬性

SelNo是先前取得的位置，若物件有增刪，就要重新取得
GetValue還要看物件是哪一種，再確認

Mh = Canvas_Draw.Children(SelNo).GetValue(Ellipse.HeightProperty)
Mw = Canvas_Draw.Children(SelNo).GetValue(Line.X2Property)

WPF 選取物件範例

Public Sub SelObj(ByVal e As System.Windows.Input.MouseEventArgs)
Dim OPos As Point = e.GetPosition(Me.Canvas_Draw)
Dim i As Integer
Dim s1 As String = ""
Dim sObj As String = ""
Dim x11, ww, y11, hh As Double

'找出選取物件
For i = 0 To Canvas_Draw.Children.Count - 1
s1 = Canvas_Draw.Children(i).GetValue(NameProperty)
Select Case s1.Substring(0, 2)
Case "Pt"
x11 = Canvas_Draw.Children(i).GetValue(Canvas.LeftProperty)
ww = x11 + Canvas_Draw.Children(i).GetValue(Canvas.WidthProperty)
y11 = Canvas_Draw.Children(i).GetValue(Canvas.TopProperty)
hh = y11 + Canvas_Draw.Children(i).GetValue(Canvas.HeightProperty)
If ((x11 <> OPos.X) And (y11 <> OPos.Y)) Then
sObj = i.ToString() + ","
SelNo = i
SelNm = s1
End If
Case "Ln"
x11 = Canvas_Draw.Children(i).GetValue(Canvas.LeftProperty)
ww = x11 + Canvas_Draw.Children(i).GetValue(Line.X2Property)
y11 = Canvas_Draw.Children(i).GetValue(Canvas.TopProperty)
hh = y11 + Canvas_Draw.Children(i).GetValue(Line.Y2Property)
If ((x11 <> OPos.X) And (y11 <> OPos.Y)) Or _
((x11 <> OPos.X) And (y11 > OPos.Y And hh <> OPos.X And ww <> OPos.Y)) Or _
((x11 > OPos.X And ww <> OPos.Y And hh < sobj =" i.ToString()" selno =" i" selnm =" s1" x11 =" Canvas_Draw.Children(i).GetValue(Canvas.LeftProperty)" ww =" x11" y11 =" Canvas_Draw.Children(i).GetValue(Canvas.TopProperty)" hh =" y11"> OPos.X) And (y11 <> OPos.Y)) Then
sObj = i.ToString() + ","
SelNo = i
SelNm = s1
End If
Case "Ep"
x11 = Canvas_Draw.Children(i).GetValue(Canvas.LeftProperty)
ww = x11 + Canvas_Draw.Children(i).GetValue(Canvas.WidthProperty)
y11 = Canvas_Draw.Children(i).GetValue(Canvas.TopProperty)
hh = y11 + Canvas_Draw.Children(i).GetValue(Canvas.HeightProperty)
If ((x11 <> OPos.X) And (y11 <> OPos.Y)) Then
sObj = i.ToString() + ","
SelNo = i
SelNm = s1
End If
Case "Re"
x11 = Canvas_Draw.Children(i).GetValue(Canvas.LeftProperty)
ww = x11 + Canvas_Draw.Children(i).GetValue(Canvas.WidthProperty)
y11 = Canvas_Draw.Children(i).GetValue(Canvas.TopProperty)
hh = y11 + Canvas_Draw.Children(i).GetValue(Canvas.HeightProperty)
If ((x11 <> OPos.X) And (y11 <> OPos.Y)) Then
sObj = i.ToString() + ","
SelNo = i
SelNm = s1
End If
End Select
Next
'如果多個被選取,取出距離最小
If sObj <> "" Then
sObj = sObj.Substring(0, sObj.Length - 1)
Dim ss1() As String
ss1 = sObj.Split(",")
Dim xc() As Double = New Double(ss1.Count) {}
Dim yc() As Double = New Double(ss1.Count) {}
Dim Lst1 As New List(Of Double)
Dim Lst2 As New List(Of Double)
Dim Lst3 As New List(Of Integer)
Dim minV As Double = 0

'判定被選取物件
For i = 0 To ss1.Count - 1
Dim nn As Integer = CInt(ss1(i))
Lst3.Add(nn)
Select Case SelNm.Substring(0, 2)
Case "Pt"
xc(i) = (Canvas_Draw.Children(nn).GetValue(Canvas.LeftProperty) + Canvas_Draw.Children(nn).GetValue(Canvas.WidthProperty)) / 2
yc(i) = (Canvas_Draw.Children(nn).GetValue(Canvas.TopProperty) + Canvas_Draw.Children(nn).GetValue(Canvas.HeightProperty)) / 2
Dim dd As Double = System.Math.Sqrt((OPos.X - xc(i)) * (OPos.X - xc(i)) + (OPos.Y - yc(i)) * (OPos.Y - yc(i)))
Lst1.Add(dd)
Lst2.Add(dd)
Case "Ln"
xc(i) = Canvas_Draw.Children(nn).GetValue(Line.X1Property) + Canvas_Draw.Children(nn).GetValue(Line.X2Property) / 2
yc(i) = Canvas_Draw.Children(nn).GetValue(Line.Y1Property) + Canvas_Draw.Children(nn).GetValue(Line.Y2Property) / 2
Dim dd As Double = System.Math.Sqrt((OPos.X - xc(i)) * (OPos.X - xc(i)) + (OPos.Y - yc(i)) * (OPos.Y - yc(i)))
Lst1.Add(dd)
Lst2.Add(dd)
Case "Ci"
xc(i) = (Canvas_Draw.Children(nn).GetValue(Canvas.LeftProperty) + Canvas_Draw.Children(nn).GetValue(Canvas.WidthProperty)) / 2
yc(i) = (Canvas_Draw.Children(nn).GetValue(Canvas.TopProperty) + Canvas_Draw.Children(nn).GetValue(Canvas.HeightProperty)) / 2
Dim dd As Double = System.Math.Sqrt((OPos.X - xc(i)) * (OPos.X - xc(i)) + (OPos.Y - yc(i)) * (OPos.Y - yc(i)))
Lst1.Add(dd)
Lst2.Add(dd)
Case "Ep"
xc(i) = (Canvas_Draw.Children(nn).GetValue(Canvas.LeftProperty) + Canvas_Draw.Children(nn).GetValue(Canvas.WidthProperty)) / 2
yc(i) = (Canvas_Draw.Children(nn).GetValue(Canvas.TopProperty) + Canvas_Draw.Children(nn).GetValue(Canvas.HeightProperty)) / 2
Dim dd As Double = System.Math.Sqrt((OPos.X - xc(i)) * (OPos.X - xc(i)) + (OPos.Y - yc(i)) * (OPos.Y - yc(i)))
Lst1.Add(dd)
Lst2.Add(dd)
Case "Re"
xc(i) = (Canvas_Draw.Children(nn).GetValue(Canvas.LeftProperty) + Canvas_Draw.Children(nn).GetValue(Canvas.WidthProperty)) / 2
yc(i) = (Canvas_Draw.Children(nn).GetValue(Canvas.TopProperty) + Canvas_Draw.Children(nn).GetValue(Canvas.HeightProperty)) / 2
Dim dd As Double = System.Math.Sqrt((OPos.X - xc(i)) * (OPos.X - xc(i)) + (OPos.Y - yc(i)) * (OPos.Y - yc(i)))
Lst1.Add(dd)
Lst2.Add(dd)
End Select

Next
'排序
Lst1.Sort()
Dim n0 As Integer = Lst2.IndexOf(Lst1(0))
'取出物件號碼
Dim n1 As Integer = Lst3(n0)
'設定被選取物件為紅色
For i = 0 To Canvas_Draw.Children.Count - 1
If i <> n1 Then
Dim s7 As String = Canvas_Draw.Children(i).GetValue(NameProperty)
Select Case s7.Substring(0, 2)
Case "Pt"
Canvas_Draw.Children(i).SetValue(Ellipse.FillProperty, Ys)
Canvas_Draw.Children(i).SetValue(Ellipse.StrokeProperty, Ys)
Case "Ln"
Canvas_Draw.Children(i).SetValue(Line.StrokeProperty, Ys)
Case "Ci"
Canvas_Draw.Children(i).SetValue(Ellipse.StrokeProperty, Ys)
Case "Ep"
Canvas_Draw.Children(i).SetValue(Ellipse.StrokeProperty, Ys)
Case "Re"
Canvas_Draw.Children(i).SetValue(Rectangle.StrokeProperty, Ys)
End Select
Else
Select Case SelNm.Substring(0, 2)
Case "Pt"
Canvas_Draw.Children(i).SetValue(Ellipse.FillProperty, Rs)
Canvas_Draw.Children(i).SetValue(Ellipse.StrokeProperty, Rs)
Case "Ln"
Canvas_Draw.Children(i).SetValue(Line.StrokeProperty, Rs)
Case "Ci"
Canvas_Draw.Children(i).SetValue(Ellipse.StrokeProperty, Rs)
Case "Ep"
Canvas_Draw.Children(i).SetValue(Ellipse.StrokeProperty, Rs)
Case "Re"
Canvas_Draw.Children(i).SetValue(Rectangle.StrokeProperty, Rs)
End Select

End If
Next
End If
End Sub

WPF 遍歷與 FindName

Try
'滑鼠水平移動量
Dim dx As Double = e.GetPosition(Me.Canvas_Draw).X - OldPos.X
'滑鼠垂直移動量
Dim dy As Double = e.GetPosition(Me.Canvas_Draw).Y - OldPos.Y
'計算圓半徑
Dim rr As Double = System.Math.Abs(System.Math.Sqrt(dx * dx + dy * dy))

'判定圓名稱是否不存在
If Me.Canvas_Draw.FindName("Cir" + CirNo.ToString()) Is Nothing Then
'建立新圓
Dim Cir As New Ellipse
Dim x1 As Double = OldPos.X - rr
Dim y1 As Double = OldPos.Y - rr
'設定名稱
Cir.SetValue(NameProperty, "Cir" + CirNo.ToString())
'設定圓左邊屬性
Cir.SetValue(Canvas.LeftProperty, x1)
'設定圓上邊屬性
Cir.SetValue(Canvas.TopProperty, y1)
'設定圓寬度屬性
Cir.Width = 2 * rr
'設定圓高度屬性
Cir.Height = 2 * rr
'設定顏色屬性
Cir.Stroke = Ys
'加入繪圖區
Me.Canvas_Draw.Children.Add(Cir)
txtInfo.Text = " 建立圓: Cir" + CirNo.ToString()
Else
'搜尋繪圖區所有元件
For i = 0 To Canvas_Draw.Children.Count - 1
'判定圓是否存在
If Canvas_Draw.Children(i).GetValue(NameProperty) = "Cir" + CirNo.ToString() Then
'改變圓寬度
Canvas_Draw.Children(i).SetValue(Ellipse.WidthProperty, rr)
'改變圓高度
Canvas_Draw.Children(i).SetValue(Ellipse.HeightProperty, rr)
End If
Next
End If
Catch e1 As Exception
'發生錯誤,布林參數設為false
Bcir = False
'圓號碼減一
CirNo = CirNo - 1
End Try

訂閱：文章 (Atom)

2010年12月29日 星期三

2010年11月27日 星期六

2010年11月23日 星期二

2010年11月8日 星期一

使用者紀錄載入中，請耐心稍後喔…

預覽結果

處理中，請耐心稍後喔…

2010年11月7日 星期日

2010年10月31日 星期日

2010年10月26日 星期二

2010年10月21日 星期四

2010年10月20日 星期三

2010年10月19日 星期二

2010年10月18日 星期一

2010年10月14日 星期四

2010年10月12日 星期二

2010年10月11日 星期一

2010年10月10日 星期日

2010年10月1日 星期五

2010年9月28日 星期二

2010年9月27日 星期一

2010年9月24日 星期五

2010年9月16日 星期四

2010年9月15日 星期三

2010年9月8日 星期三

2010年8月31日 星期二

2010年8月27日 星期五

2010年8月26日 星期四

取代失敗的主機板

2010年8月25日 星期三

2010年8月18日 星期三

2010年8月6日 星期五

2010年8月5日 星期四

2010年7月29日 星期四

2010年7月28日 星期三

2010年7月26日 星期一

2010年7月25日 星期日

處理中，請耐心稍後喔…

2010年7月22日 星期四

2010年7月14日 星期三

處理中，請耐心稍後喔…

2010年6月28日 星期一

2010年6月22日 星期二

2010年6月9日 星期三

2010年6月4日 星期五

追蹤者

關於我自己

總網頁瀏覽量

熱門文章

2010年12月29日星期三

2010年11月27日星期六

2010年11月23日星期二

2010年11月8日星期一

2010年11月7日星期日

2010年10月31日星期日

2010年10月26日星期二

2010年10月21日星期四

2010年10月20日星期三

2010年10月19日星期二

2010年10月18日星期一

2010年10月14日星期四

2010年10月12日星期二

2010年10月11日星期一

2010年10月10日星期日

2010年10月1日星期五

2010年9月28日星期二

2010年9月27日星期一

2010年9月24日星期五

2010年9月16日星期四

2010年9月15日星期三

2010年9月8日星期三

2010年8月31日星期二

2010年8月27日星期五

2010年8月26日星期四

2010年8月25日星期三

2010年8月18日星期三

2010年8月6日星期五

2010年8月5日星期四

2010年7月29日星期四

2010年7月28日星期三

2010年7月26日星期一

2010年7月25日星期日

2010年7月22日星期四

2010年7月14日星期三

2010年6月28日星期一

2010年6月22日星期二

2010年6月9日星期三

2010年6月4日星期五