VB2010 排座位程式

Public Class form1




Private WithEvents document As New System.Drawing.Printing.PrintDocument

Dim TreeView1 As New TreeView

' Initalize the dialog.

Dim btnprint As Boolean = False

Dim btncolor As Boolean = False

Dim instance As PageSetupDialog



Dim a, b, n1, n2, n3, i, kk, i2, clicknum As Integer



Dim dtextbox(n3) As RichTextBox





Dim myxls As Object



Dim mybooks As Object



Dim mybook As Object



Dim mySht As Object



Dim myRange, myRange2 As Object

Dim dtextboxA1, dtextboxA2, dtextboxA3 As New RichTextBox

'Dim a, b As Integer

'Dim btn As Object

Dim x As String

Dim FillErrorEventHandler As Object

Dim y As Integer







Private Sub Btnpath_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnpath.Click



Dim ofd As New OpenFileDialog

'If ofd.ShowDialog() = DialogResult.OK Then

'If ofd.FileName <> "" Then



'End If

'End If

ofd.ShowDialog()

Tetpath.Text = CStr(ofd.FileName)

End Sub



Public Sub startbtnClick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles startbtn.Click



' Me.ActiveMdiChild.Close()

'Form2.Show()

If Tetpath.Text = "" Then

MsgBox("請輸入正確的Excel檔.Xls路徑")

Exit Sub

End If

If Microsoft.VisualBasic.Right(Tetpath.Text, 3) = "xls" Then

GoTo 3

Else

MsgBox("你選的並非Excel檔,請重新選擇正確 Xls路徑")

Exit Sub

End If

'宣告Excel各種物件



3: '啟動Excel

myxls = CreateObject("Excel.Application")

' myxls.Visible = True '''顯示Excel

mybooks = myxls.workbooks

'開檔案

mybook = mybooks.open(Tetpath.Text)

'取得Sheet

mySht = mybook.sheets(1)

'mySht.Activate()



Dim c, d As String



'取得Cell

Dim i, kk As Integer



Dim myRange, myRange2 As Object

For kk = 1 To 100

c = "a" & CStr(kk)

myRange = mySht.range(c)

If IsNothing(myRange.value) = True Then

kk = kk - 1

GoTo 5

End If

Next

5:



n1 = NumericUpDown1.Value

n2 = NumericUpDown2.Value

n3 = n1 * n2

Dim dtextbox(n3) As RichTextBox

Dim w1, w2, h1, h2 As Integer

Dim jarray(kk) As Integer

'Location = New Point(10, 0)

'=============================

Select Case n1

Case n1 < 6

w1 = 80

w2 = 100

Case n1 = 6, 7

w1 = 80

w2 = 90

Case n1 > 7

w1 = 80

w2 = 85

End Select

Select Case n2

Case n2 < 7

h1 = 60

h2 = 80

Case n2 = 7, 8

h1 = 60

h2 = 70

Case n2 > 8

h1 = 60

h2 = 65

End Select

'MsgBox(w1, h1)

For i = 0 To n3 - 1

15:

Randomize()

Dim j As Integer = CInt(Int((kk * Rnd()) + 1))

If i >= kk Then

x = Nothing

GoTo 30

End If

'不重複

If jarray(j) = 0 Then

jarray(j) = 13

GoTo 20

Else

GoTo 15

End If

'''''''''

'''''''''

20:

a = j + 1

b = a + 1

c = "a" & CStr(j)

d = "b" & CStr(j)

myRange = mySht.range(c)

myRange2 = mySht.range(d)

x = myRange2.value & Chr(13) & Chr(10) & myRange.value()

30:



dtextbox(i) = New RichTextBox



dtextbox(i).Tag = i

dtextbox(i).Name = "dtextbox" & CStr(i)

dtextbox(i).Width = 90



dtextbox(i).Height = 60

'MsgBox(w1, h1)

dtextbox(i).Left = 100 * (i Mod n1 + 1)

dtextbox(i).Top = 80 * (i \ n1 + 1)



dtextbox(i).Text = x '"Btn" & i

dtextbox(i).SelectionFont = New Font("標楷體", 12, FontStyle.Bold)



dtextbox(i).ScrollBars = RichTextBoxScrollBars.None



Me.Controls.Add(dtextbox(i))



AddHandler dtextbox(i).Click, AddressOf dtextbox_Click

Next

'mybook.save()



mybook.close()

GC.Collect()





'mybooks.quit()

myRange = Nothing

myRange2 = Nothing

mySht = Nothing

mybooks = Nothing







End Sub



Private Sub dtextbox_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)

If btncolor = True Then

CType(sender, RichTextBox).BackColor = Color.White

btncolor = False



GoTo 45

End If

If btnprint = True Then

GoTo 40

End If

clicknum = clicknum + 1

If clicknum > 2 Then

dtextboxA1.BackColor = Color.White

dtextboxA2.BackColor = Color.White

clicknum = 1

End If

Select Case clicknum

Case 1

'dtextboxA1.Name = CType(sender, RichTextBox).Name

i = CType(sender, RichTextBox).Tag

'MsgBox(CType(sender, RichTextBox).Name)

' i2 = i

dtextboxA1 = CType(sender, RichTextBox)

CType(sender, RichTextBox).BackColor = Color.Orange

'dtextbox(i).Name = "jjjjjj"

Case 2

'dtextboxA2.Name = CType(sender, RichTextBox).Name

i2 = CType(sender, RichTextBox).Tag

'MsgBox(CType(sender, RichTextBox).Name)

' i2 = i

dtextboxA2 = CType(sender, RichTextBox)

CType(sender, RichTextBox).BackColor = Color.Orchid

'dtextbox(i2) = dtextboxA2

End Select

40:





CType(sender, RichTextBox).BackColor = Color.Orchid



45: 'btnprint = True

End Sub











Private Sub exchangeBtn_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles exchangeBtn.Click

Dim dtextbox(n3) As RichTextBox

dtextboxA3.Text = dtextboxA1.Text



dtextboxA1.Text = dtextboxA2.Text



dtextboxA2.Text = dtextboxA3.Text

dtextboxA1.BackColor = System.Drawing.Color.White

dtextboxA2.BackColor = System.Drawing.Color.White



'CType(sender, RichTextBox).ForeColor = Color.Black

End Sub







Private Sub buttonprint_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles buttonprint.Click



Tetpath.Visible = False

Me.btnpath.Visible = False

Me.startbtn.Visible = False

Me.NumericUpDown1.Visible = False

Me.Label1.Visible = False

Me.NumericUpDown2.Visible = False

Me.Label2.Visible = False

Me.Label3.Visible = False

Me.exchangeBtn.Visible = False

Me.buttonprint.Visible = False

Me.Buttonfont.Visible = False

Me.Buttonclass.Visible = True

Buttoncolorreset.Visible = False





Dim PD As New PrintDialog





If PD.ShowDialog() = Windows.Forms.DialogResult.Cancel Then

Me.buttonprint.Visible = True

Me.Buttonfont.Visible = True



Exit Sub

End If



Dim PN = PD.PrinterSettings.PrinterName



PrintForm1.Form = Me



PrintForm1.PrinterSettings.PrinterName = PN



PrintForm1.PrintAction = Printing.PrintAction.PrintToPreview

'PrintForm1.PrintAction = Printing.PrintAction.PrintToFile

PrintForm1.Print()

Me.buttonprint.Visible = True

Me.Buttonfont.Visible = True

End Sub











Private Sub Buttonfont_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Buttonfont.Click

btnprint = True

Tetpath.Visible = False

Me.btnpath.Visible = False

Me.startbtn.Visible = False

Me.NumericUpDown1.Visible = False

Me.Label1.Visible = False

Me.NumericUpDown2.Visible = False

Me.Label2.Visible = False

Me.Label3.Visible = False

Me.exchangeBtn.Visible = False

Me.buttonprint.Visible = True

Me.Buttonfont.Visible = False

Buttoncolorreset.Visible = True



FontDialog1.ShowColor = True



FontDialog1.Font = Me.Font

FontDialog1.Color = Me.ForeColor

'FontDialog1.ShowDialog()

If FontDialog1.ShowDialog() <> DialogResult.Cancel Then

Me.Font = FontDialog1.Font

Me.ForeColor = FontDialog1.Color

End If



End Sub



Private Sub form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load



End Sub



Private Sub Buttoncolorreset_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Buttoncolorreset.Click

btncolor = True

End Sub







End Class

計算機vb2010

Public Class calculator

Const textbox1length = 20

Sub shownum(ByVal num As Integer)

If TextBox1.Text.Length > textbox1length Then Exit Sub

TextBox1.Text = TextBox1.Text & CStr(num)

End Sub









Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

If TextBox1.Text = "0" Then

TextBox1.Text = ""

TextBox1.Text = "1"

Else



TextBox1.Text = TextBox1.Text + "1"

End If

End Sub



Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click

If TextBox1.Text = "0" Then

TextBox1.Text = ""

TextBox1.Text = "2"

Else



TextBox1.Text = TextBox1.Text + "2"

End If

End Sub





Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click

If TextBox1.Text = "0" Then

TextBox1.Text = ""

TextBox1.Text = "3"

Else



TextBox1.Text = TextBox1.Text + "3"

End If

End Sub



Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click

If TextBox1.Text = "0" Then

TextBox1.Text = ""

TextBox1.Text = "4"

Else



TextBox1.Text = TextBox1.Text + "4"

End If

End Sub



Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click

If TextBox1.Text = "0" Then

TextBox1.Text = ""

TextBox1.Text = "5"

Else



TextBox1.Text = TextBox1.Text + "5"

End If

End Sub



Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click

If TextBox1.Text = "0" Then

TextBox1.Text = ""

TextBox1.Text = "6"

Else



TextBox1.Text = TextBox1.Text + "6"

End If

End Sub



Private Sub Button7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button7.Click

If TextBox1.Text = "0" Then

TextBox1.Text = ""

TextBox1.Text = "7"

Else



TextBox1.Text = TextBox1.Text + "7"

End If

End Sub



Private Sub Button8_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button8.Click

If TextBox1.Text = "0" Then

TextBox1.Text = ""

TextBox1.Text = "8"

Else



TextBox1.Text = TextBox1.Text + "8"

End If

End Sub



Private Sub Button9_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button9.Click

If TextBox1.Text = "0" Then

TextBox1.Text = ""

TextBox1.Text = "9"

Else



TextBox1.Text = TextBox1.Text + "9"

End If

End Sub



Private Sub Button10_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button10.Click

If TextBox1.Text = "0" Then



TextBox1.Text = TextBox1.Text

Else



TextBox1.Text = TextBox1.Text + "0"

End If

End Sub



Private Sub Buttonclear_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Buttonclear.Click

TextBox1.Text = "0"

End Sub



Private Sub Button11_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button11.Click

Dim dot1, dot2 As String

dot1 = TextBox1.Text

dot2 = Microsoft.VisualBasic.Right(dot1, 1)

If dot2 = "." Then

GoTo 22

End If



If CDec(TextBox1.Text) = CInt(TextBox1.Text) Then

TextBox1.Text = TextBox1.Text + "."

End If

22:

End Sub

Dim opr As String



Dim a, b As Double

Private Sub Buttonplus_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Buttonplus.Click

a = CDec(TextBox1.Text)

TextBox1.Text = "0"

opr = "+"

End Sub



Private Sub Buttonminus_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Buttonminus.Click

a = CDec(TextBox1.Text)

TextBox1.Text = "0"

opr = "-"

End Sub



Private Sub Buttonmulti_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Buttonmulti.Click

a = CDec(TextBox1.Text)

TextBox1.Text = "0"

opr = "*"

End Sub



Private Sub Button13_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button13.Click

a = CDec(TextBox1.Text)

TextBox1.Text = "0"

opr = "/"

End Sub



Private Sub Buttonmod_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Buttonmod.Click

a = CDec(TextBox1.Text)

TextBox1.Text = "0"

opr = "mod"

End Sub



Private Sub Buttonresult_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Buttonresult.Click

b = CDec(TextBox1.Text)



Select Case opr

Case "+"

TextBox1.Text = a + b

Case "-"

TextBox1.Text = a - b

Case "*"

TextBox1.Text = a * b

Case "/"

TextBox1.Text = a / b

Case "mod"

TextBox1.Text = a Mod b

End Select

End Sub



Private Sub calculator_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load



End Sub



Private Sub TextBox2_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox2.TextChanged



End Sub



Private Sub Buttonme_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Buttonme.Click

TextBox2.Text = TextBox1.Text

End Sub



Private Sub Buttonmr_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Buttonmr.Click

TextBox1.Text = TextBox2.Text

End Sub

End Class

荷蘭鐵殼小船

荷蘭水鄉澤國；船；自然是輕易可見

每艘船看起來都簡單、乾淨、俐落

以鐵殼打造 (似乎是不鏽鋼材) 一點兒鏽痕都沒

給人堅固耐用質感

想想台灣的漁港裡漁船多以木造居多，遊艇又以塑鋼FRP為主

鮮少見鐵材質造的小船

後來想想或許是氣候關係吧?

如果夏季台灣高達35度的炎熱高溫

鐵殼是會燙傷人的不是嗎?

傳說中的黃山光明頂

傳說中的黃山光明頂

金庸小說筆下的光明頂活生生的就在眼前腳下

遠眺真有一坪頂，但平地面積沒想像得大，豈容得下七大門派圍攻?

不過今日的遊客之眾可能更勝於當時吧!

這段路現在已經有纜車

只有一段約兩小時路程爬升，且沿路風景美到讓人忘了疲憊

加上以緩坡占多數所以是剛剛好適合多數人的大眾化登山路徑

徽派建築之美

安徽古建築自成一派稱為徽派；特重上樑，不夠巨大挑不起大樑

因此須從各地運來百年巨木當地稱為冬瓜樑

可以顯現家族的氣派

 宏村聚落被列名人類共同遺產，當中的家族私塾廳堂裡就可見到這般的棟樑
兩側的[忠孝] [廉節]是給有志科舉從政的宏村的惕勵，也是品格教育
科舉一途方能為官，而當官就是為君王服務的官僚；官僚文官體系正是國家的棟樑
因此儒家會高舉[忠孝] [廉節]的思想正是符合當權所企盼

羊角村

荷蘭低地國在萊茵河三角洲，沼澤灘地很多，自古河蘭人就擅於圩田造陸；

羊角村體現了荷蘭人的這項能力

他們常以木樁打入沼澤地再以木板穩固土壤，最後再把河湖的汙泥填高陸地，十年百年後就是一塊塊可以安居的村落了。

一幢幢的精巧建築就建築在這得來不易的土地上，夏日時光是這高緯度國家最精彩的一季，所有人都把握時間去戶外活動，湖上泛舟，也可以下船用走的，再不更可以上岸騎腳踏車，
荷蘭騎腳踏車的比率真的高的驚人

遇見比雅久(PIAGGIO)機車

在西歐各國騎摩托車的人不多,但巴黎市區卻有不少;

紅燈時可以見到前排多是摩托騎士跟台灣差不多

眼前這台三輪的機車,曾經在台灣周杰倫代言的機車廣告看過,不過並未正式發表

而在巴黎處處可見!!

下圖的照片是剛好停在身旁的機車,比雅久在台灣曾經風行一時,目前好像已經淡出,本以為經營不善了,沒想到在法國一看,人家在歐洲仍是一霸哩!

引發好奇之後,上網瞧瞧才知PIAGGIO, VESPA都還健在且身價不同凡響

125CC要價5999.歐元 300cc要價7699.歐元

也就等於都要十多萬起跳才有!

想想人家義大利的工業才真叫做產業升級!!

比雅久網頁