1
0
3
0
0
1.0.3
1.0.3
2005/09/14
0
1
0
0
1
4
1768123448
81FBFBFBFBFBFBFBFCFCFCFCFCFCFCACACACACF5000000000000000000000000FB00002A002A002A002A2A00F500F500F500FCFBF50000000000000000000000FB002A002A2A2A2A2A2A2AF500F500FBFBFBFBFBFBFBFBFBFB00000000000000FB2A002A2A2A2A2A2A2A5500F500FBE3E3E3E3E3E3E3E3FBFB00000000000000FB002A2A2A2A2A2A2A2A2AF500FBE3E3E3E3E3E3E3E3FBE3FB00000000000000FB2A2A2A2A2A2A2A2A2A5500FBE3E3E3E3E3E3E3E3FBE3E3FB00000000000000FB002A2A2A2A2A2A2A552AFBFBFBFBFBFBFBFBFBFBE3E3E3FB00000000000000FB2A2A2A2A2A2A2A2A2A55FBE3E3E3E3E3E3E3E3FBE3E3E3FB00000000000000FB002A2A2A2A2A552A552AFBE3E3E3E3E3E3E3E3FBE3E3E3FB00000000000000FB2A2A2A552A552A552A55FBE3E3FFFFFFFFE3E3FBE3E3E3FB00000000000000FB00000000F500F500F500FBE3E3E3E3E3E3E3E3FBE3E3E3FB00000000000000FB000000F500F500F500F5FBE3FFFFFFFFFFFFE3FBE3E3E3FB00000000000000FC0000F500F500F500F500FBE3E3FFE3FFE3E3E3FBE3E3E3FB00000000000000FC000000F500F500F500F5FBE3E3FFE3FFE3FFE3FBE3E3E3FB00000000000000FC0000F500F500F500F500FBE3FFFAE3FAFFFAE3FBE3E3E3FB00000000000000FC000000F500F500F500F5FBE3E3E3E3E3E3E3E3FBE3E3E3FB00000000000000FC0000F500F500F500F500FBE3E3E3E3E3E3E3E3FBE3E3E3FB00000000000000FC000000F500F500F500F5FBE3E3E3E3E3E3E3E3FBE3E3E3FB00000000000000FC0000F500F500F500F500FBE3E3FFE3FAFFFFE3FBE3E3E3FB00000000000000FC000000F500F500F500F5FBE3FAFFFAFFE3E3E3FBE3E3E3FB00000000000000FC0000F500F500F500F500FBE3FFFFFFFFFFFFE3FBE3E3E3FB00000000000000FC000000F500F500F500F5FBE3FFFFFFFFE3E3E3FBE3E3E3FB00000000000000AC0000F500F500F500F500FBE3FFFFFFFFFFFFFAFBE3E3E3FB00000000000000AC000000F500F500F500F5FBE3E3FFFFFFFFE3E3FBE3E3E3FB00000000000000AC0000F500F500F500F500FBE3E3FFE3FFE3FFE3FBE3E3E3FB00000000000000AC000000F500F500F500F5FBE3E3FFE3FFFFE3FAFBE3E3E3FB00000000000000AC0000F500F500F500F500FBE3E3E3E3E3E3E3E3FBE3E3E3FBF6F50000000000AC00F500F500F500F5F5F5FBE3E3E3E3E3E3E3E3FBE3E3E3FBF8F7F6F5000000AC0000F500F500F500F5F5FBE3E3E3E3E3E3E3E3FBE3E3FBFFF9F8F72BF6F500AC00F500F500F5F5F5F5F5FBE3E3E3E3E3E3E3E3FBE3FBF7FFFAF9F8F8F7F500AC0000F5F5F5F5F5F5F5F5FBE3E3E3E3E3E3E3E3FBFBF6F7FFFAFA56F82BF500ACFDFDFDFDFDFDFDFDFDFEFBFBFBFBFBFBFBFBFBFBFFFFFFFFFAF956F7F60000
1229147683
FFFFE000800030008001FF808003FF808007FF80800FFF80801FFF80801FFF80801FFF80801FFF80801FFF80801FFF80801FFF80801FFF80801FFF80801FFF80801FFF80801FFF80801FFF80801FFF80801FFF80801FFF80801FFF80801FFF80801FFF80801FFF80801FFF80801FFF80801FFF80801FFEC0801FFCE0FFFFFFC0FFFFF000956AB800AFF5FF80DFEBFF80BFF7FF80FFEFFF80BFFFFF80FFFFFF80BFFFFF80FFFFFF80855FFF808ABFFF80955FFF808ABFFF80955FFF808ABFFF80955FFF808ABFFF80955FFF808ABFFF80955FFF808ABFFF80955FFF808ABFFF80955FFF808ABFFF80955FFFE0AAFFFFF8957FFFFEABFFFFFE9FFFFFFEFFFFFFFC
0
-1
-1
-1
-1
-1
-1
-1
-1
-1
-1
-1
-1
-1
-1
-1
-1
Na09
醍誨鋨貳銠
My Application (Mac OS X)
20971520
10289152
My Application
AppName.exe
0
text
R*ch
TEXT
0
Mototyou
0
165
168
115
Mototyou
0
False
16777215
0
醍誨鋨貳銠
True
False
True
False
False
False
0
0
640
460
64
64
32000
32000
Mototyou
120
Window
0
MainListClear
0
9
0
9
0
Sub MainListClear()
Dim i as Integer
Dim j as Integer
For i = 1 to 2000
For j = 1 to 8
MainList.Cell(i,j) = ""
gFileReadRecord(i,j) = ""
Next
Next
MainList.aListRefresh
KariTotal.Text = ""
KasiTotal.Text = ""
AllKariTotal.Text = ""
AllKasiTotal.Text = ""
End Sub
ReadAccount
tKamokuString as String,tKubun as Integer
0
225
0
225
0
Sub ReadAccount(tKamokuString as String,tKubun as Integer)
Dim tFolderItem as FolderItem
Dim tBinaryInput as BinaryStream
Dim tKariDouble as Double
Dim tKasiDouble as Double
Dim tDateString(50) as String
Dim tKariKingaku(50) as String
Dim tKariKamoku(50) as String
Dim tTekiyouString(50) as String
Dim tBangouString(50) as String
Dim tKasiKamoku(50) as String
Dim tKasiKingaku(50) as String
Dim tReadKubun(50) as String
Dim tKamoku(50) as String
Dim tTekiyou(50) as String
Dim tBangou(50) as String
Dim tKari(50) as String
Dim tKasi(50) as String
Dim tWriteKubun(50) as String
Dim tKariCount as Integer
Dim tKasiCount as Integer
Dim tHyouziFlag as Integer
Dim tHyouziGyou as Integer
Dim tTotalKari as Double
Dim tTotalKasi as Double
Dim tKamokuFlag as Integer
Dim SelectLineGyou as Integer
Dim i as Integer
Dim j as Integer
tTotalKari = 0
tTotalKasi = 0
//钄迣鍠镛Index荴荀荃莋苰跬邬芷苩
tFolderItem = MakeFolder(gBasicPath + "違釖鍠镛荦腛荞")
tFolderItem = MakeFolder(tFolderItem.AbsolutePath + LeftB(DateField.Text,4))
tFolderItem = GetFolderItem(tFolderItem.AbsolutePath + "違鍠" + LeftB(DateField.Text,4) + "/" + MidB(DateField.Text,7,2))
If tFolderItem <> Nil Then
tBinaryInput = tFolderItem.OpenAsBinaryFile(False)
If tBinaryInput <> Nil Then
tBinaryInput.LittleEndian = True
tHyouziGyou = 1'2
While tBinaryInput.EOF = False
i = 0
tKariDouble = 0
tKasiDouble = 0
tKariCount = 0
tKasiCount = 0
Do
i = i + 1
//鏺镴
tDateString(i) = Trim(tBinaryInput.ReadPString)
//軘闻诠詺
tKariKingaku(i) = Trim(tBinaryInput.ReadPString)
tKariDouble = tKariDouble + ChangeSequence(tKariKingaku(i))
//軘闻览雚铔趆
tBinaryInput.Position = tBinaryInput.Position + 5
//軘闻览雚
tKariKamoku(i) = Trim(tBinaryInput.ReadPString)
If tKariKamoku(i) <> "" Then
tKariCount = tKariCount + 1
End If
//鍅靶
tTekiyouString(i) = Trim(tBinaryInput.ReadPString)
//铔趆
tBangouString(i) = Trim(tBinaryInput.ReadPString)
//針闻览雚铔趆
tBinaryInput.Position = tBinaryInput.Position + 5
//針闻览雚
tKasiKamoku(i) = Trim(tBinaryInput.ReadPString)
If tKasiKamoku(i) <> "" Then
tKasiCount = tKasiCount + 1
End If
//針闻诠詺
tKasiKingaku(i) = Trim(tBinaryInput.ReadPString)
tKasiDouble = tKasiDouble + ChangeSequence(tKasiKingaku(i))
//详閪
tReadKubun(i) = tBinaryInput.ReadPString
If Len(tReadKubun(i)) = 2 Then
//靜铵诳諔腀觼赳
tBinaryInput.Position = tBinaryInput.Position + 34
Else
//觼赳
tBinaryInput.Position = tBinaryInput.Position + 2
End If
tReadKubun(i) = Trim(tReadKubun(i))
If tKamokuFlag = 0 And (tKamokuString = tKariKamoku(i) Or tKamokuString = tKasiKamoku(i)) Then
tKamokuFlag = 1
End If
If tKubun <> 0 Then
If Val(tReadKubun(i)) <> tKubun Then
tKamokuFlag = 0
tKariDouble = 0
tKasiDouble = 0
End If
End If
Loop Until tKariDouble = tKasiDouble
SelectLineGyou = 0
If tKamokuFlag = 1 Then
If tKariCount = 1 And tKasiCount = 1 Then
//艐野艐
j = 0
If tKamokuString = tKariKamoku(i) Then
j = j + 1
SelectLineGyou = SelectLineGyou + 1
tKamoku(j) = tKasiKamoku(i)
tTekiyou(j) = tTekiyouString(i)
tBangou(j) = tBangouString(i)
tKari(j) = tKariKingaku(i)
tKasi(j) = "0"
tWriteKubun(j) = tReadKubun(j)
tHyouziFlag = 1
End If
If tKamokuString = tKasiKamoku(i) Then
'ElseIf tKamokuString = tKasiKamoku(i) Then
j = j + 1
SelectLineGyou = SelectLineGyou + 1
tKamoku(j) = tKariKamoku(i)
tTekiyou(j) = tTekiyouString(i)
tBangou(j) = tBangouString(i)
tKari(j) = "0"
tKasi(j) = tKasiKingaku(i)
tWriteKubun(j) = tReadKubun(j)
tHyouziFlag = 1
End If
ElseIf tKariCount > 1 And tKasiCount = 1 Then
//閡邔野艐
For j = 1 to i
If tKamokuString = tKariKamoku(j) Then
SelectLineGyou = SelectLineGyou + 1
tKamoku(SelectLineGyou) = tKasiKamoku(1)
tTekiyou(SelectLineGyou) = tTekiyouString(j)
tBangou(SelectLineGyou) = tBangouString(j)
tKari(SelectLineGyou) = tKariKingaku(j)
tKasi(SelectLineGyou) = "0"
tWriteKubun(SelectLineGyou) = tReadKubun(j)
tHyouziFlag = 1
End If
If tKamokuString = tKasiKamoku(j) Then
SelectLineGyou = SelectLineGyou + 1
tKamoku(SelectLineGyou) = "辔賻"
tTekiyou(SelectLineGyou) = tTekiyouString(j)
tBangou(SelectLineGyou) = tBangouString(j)
tKari(SelectLineGyou) = "0"
tKasi(SelectLineGyou) = tKasiKingaku(j)
tWriteKubun(SelectLineGyou) = tReadKubun(j)
tHyouziFlag = 1
End If
Next
ElseIf tKariCount = 1 And tKasiCount > 1 Then
//艐野閡邔
For j = 1 to i
If tKamokuString = tKariKamoku(j) Then
SelectLineGyou = SelectLineGyou + 1
tKamoku(SelectLineGyou) = "辔賻"
tTekiyou(SelectLineGyou) = tTekiyouString(j)
tBangou(SelectLineGyou) = tBangouString(j)
tKari(SelectLineGyou) = tKariKingaku(j)
tKasi(SelectLineGyou) = "0"
tWriteKubun(SelectLineGyou) = tReadKubun(j)
tHyouziFlag = 1
End If
If tKamokuString = tKasiKamoku(j) Then
SelectLineGyou = SelectLineGyou + 1
tKamoku(SelectLineGyou) = tKariKamoku(1)
tTekiyou(SelectLineGyou) = tTekiyouString(j)
tBangou(SelectLineGyou) = tBangouString(j)
tKari(SelectLineGyou) = "0"
tKasi(SelectLineGyou) = tKasiKingaku(j)
tWriteKubun(SelectLineGyou) = tReadKubun(j)
tHyouziFlag = 1
End If
Next
ElseIf tKariCount > 1 And tKasiCount > 1 Then
//閡邔野閡邔
For j = 1 to i
If tKamokuString = tKariKamoku(j) Then
SelectLineGyou = SelectLineGyou + 1
tKamoku(SelectLineGyou) = "辔賻"
tTekiyou(SelectLineGyou) = tTekiyouString(j)
tBangou(SelectLineGyou) = tBangouString(j)
tKari(SelectLineGyou) = tKariKingaku(j)
tKasi(SelectLineGyou) = "0"
tWriteKubun(SelectLineGyou) = tReadKubun(j)
tHyouziFlag = 1
End If
If tKamokuString = tKasiKamoku(j) Then
SelectLineGyou = SelectLineGyou + 1
tKamoku(SelectLineGyou) = "辔賻"
tTekiyou(SelectLineGyou) = tTekiyouString(j)
tBangou(SelectLineGyou) = tBangouString(j)
tKari(SelectLineGyou) = "0"
tKasi(SelectLineGyou) = tKasiKingaku(j)
tWriteKubun(SelectLineGyou) = tReadKubun(j)
tHyouziFlag = 1
End If
Next
End If
If tHyouziFlag = 1 Then
For j = 1 to SelectLineGyou
gFileReadRecord(tHyouziGyou,1) = Right(tDateString(1),5)
gFileReadRecord(tHyouziGyou,2) = tKamoku(j)
gFileReadRecord(tHyouziGyou,3) = tWriteKubun(j)
gFileReadRecord(tHyouziGyou,4) = tTekiyou(j)
gFileReadRecord(tHyouziGyou,5) = tBangou(j)
gFileReadRecord(tHyouziGyou,6) = SpaceSup(tKari(j),13)
tTotalKari = tTotalKari + ChangeSequence(MainList.Cell(tHyouziGyou,5))
gFileReadRecord(tHyouziGyou,7) = SpaceSup(tKasi(j),13)
tHyouziFlag = 0
tHyouziGyou = tHyouziGyou + 1
Next
End If
tKamokuFlag = 0
End If
Wend
tBinaryInput.Close
KariTotal.Text = Format(tTotalKari,"-,#")
KasiTotal.Text = Format(tTotalKasi,"-,#")
AllKariTotal.Text = Format(tTotalKari + ChangeSequence(MainList.Cell(1,6)),"-,#")
AllKasiTotal.Text = Format(tTotalKasi + ChangeSequence(MainList.Cell(1,7)),"-,#")
End IF
End If
End Sub
ClearTransfer
0
7
4
7
4
Sub ClearTransfer()
Dim i as Integer
For i = 1 to 135
gKamoku(i) = ""
gKingaku(i,1) = 0
gKingaku(i,2) = 0
Next
End Sub
ReadTransfer
tDateString as String,tKamokuName as String,tKamokuType as Integer,tKubun as Integer
0
42
0
42
0
Sub ReadTransfer(tDateString as String,tKamokuName as String,tKamokuType as Integer,tKubun as Integer)
//MainList苌裪赳雚苉豊苨襺芵苰鏼苪苩
Dim tFolderItem as FolderItem
Dim tBinaryInput as BinaryStream
Dim tReadString as String
Dim i as Integer
//趡貎苌豊襺荦腛荞苌FolderItem苰鎾苩
tFolderItem = MakeFolder(gBasicPath + "違釖鍠镛荦腛荞")
tFolderItem = MakeFolder(tFolderItem.AbsolutePath + LeftB(DateField.Text,4))
If tKubun = 0 Then
tFolderItem = GetFolderItem(tFolderItem.AbsolutePath + "豊襺" + LeftB(tDateString,4) + "/" + MidB(tDateString,7,2))
Else
tFolderItem = GetFolderItem(tFolderItem.AbsolutePath + PopupMenu1.Text + "豊襺" + LeftB(tDateString,4) + "/" + MidB(tDateString,7,2))
End If
//FolderItem芪鎾苧苪芽苧
If tFolderItem <> Nil Then
//違鍠荦腛荞荴荀荃莋苰跬邬芷苩
tBinaryInput = tFolderItem.OpenAsBinaryFile(True)
//荴荀荃莋芪詊芯芽苧
If tBinaryInput <> Nil Then
tBinaryInput.LittleEndian = True
i = 1
While tBinaryInput.EOF = False
tReadString = Trim(tBinaryInput.ReadPString)
If tReadString = tKamokuName Then
MainList.Cell(1,6) = SpaceSup(Format(Val(Trim(tBinaryInput.ReadPString)),"-,#"),13)
MainList.Cell(1,7) = SpaceSup(Format(Val(Trim(tBinaryInput.ReadPString)),"-,#"),13)
If tKamokuType =2 Or tKamokuType = 3 Or tKamokuType = 5 Or tKamokuType = 7 Then
MainList.Cell(1,8) = SpaceSup(Format(ABS(ChangeSequence(MainList.Cell(1,6)) - ChangeSequence(MainList.Cell(1,7))),"-,#"),13)
Else
MainList.Cell(1,8) = SpaceSup(Format(ChangeSequence(MainList.Cell(1,6)) - ChangeSequence(MainList.Cell(1,7)),"-,#"),13)
End If
Exit
End If
tBinaryInput.Position = tBinaryInput.Position + 67
Wend
tBinaryInput.Close
End If
End If
If MidB(tDateString,7,2) = "04" Then
MainList.Cell(1,4) = "酏腀諺腀豊腀襺"
Else
MainList.Cell(1,4) = "酏腀貎腀豊腀襺"
End If
End Sub
ReadKamoku
0
10
6
10
6
Sub ReadKamoku()
Dim tFolderItem as FolderItem
Dim tBinaryInput as BinaryStream
Dim tReadString as String
Dim i as Integer
Dim j as Integer
i = 1
j = 1
//鍅靶鏠靥荴荀荃莋苌芠苩迪辊腩=FolderItem腪苰鎾苩
tFolderItem = GetFolderItem(gBasicPath + "郝鋨:誨鋨览雚")
//荴荀荃莋芪醶距芵苄芢苩腩=FolderItem芪醶距芵苄芢苩腪苈苧
If tFolderItem <> Nil Then
//芻苌荴荀荃莋苰鏇苝辑芫莂腛荨苅詊芭
tBinaryInput = tFolderItem.OpenAsBinaryFile(True)
//荴荀荃莋苰詊芭花苆芪苅芫苩腩=tBinaryInput芪醶距芵苄芢苩腪苈苧
If tBinaryInput <> Nil Then
//荴荀荃莋苌跅賣苜苅鏇苝苂苃芯苩
While tBinaryInput.EOF = False
//誨鋨览雚苰ButtonName苖釣鏼
MainButton.ButtonName(i,j) = Trim(tBinaryInput.ReadPString)
//荻荞莓苌遆苰ButtonColor苖釣鏼
MainButton.ButtonColor(i,j) = Val(Trim(tBinaryInput.ReadPString)) + 1
//荒腛荨铔趆苰ButtonData苖釣鏼
MainButton.ButtonData1(i,j) = Trim(tBinaryInput.ReadPString)
//鏇苝铲苎芵
tBinaryInput.Position = tBinaryInput.Position + 27
j = j + 1
If j = MainButton.RowCount + 1Then
i = i + 1
j = 1
End If
If j = MainButton.RowCount And i = MainButton.ColCount Then
Exit
End If
Wend
tBinaryInput.Close
End If
End If
End Sub
DataSort
tKamokuType as Integer
0
70
0
70
0
Sub DataSort(tKamokuType as Integer)
Dim tDay1(31) as Integer
Dim tDay2(31) as Integer
Dim tDayInteger as Integer
Dim tLastDay as Integer
Dim tFlag as Integer
Dim i as Integer
Dim tTotalKari as Double
Dim tTotalKasi as Double
dim tstring as string
//Step.1腀詥鏺镴苍芢芭苂苃苂芠苩苌芩腈
For i = 1 to 2000
If gFileReadRecord(i,4) <> "" Then
tDayInteger = Val(RightB(gFileReadRecord(i,1),2))
tDay1(tDayInteger) = tDay1(tDayInteger) + 1
Else
Exit
End If
Next
//Step.2腀芻苪芼苪苌鏺镴苌郦鎪苌荁荨莌荘苰鎾苩
tFlag = 0
For i = 1 to 31
If tDay1(i) <> 0 And tFlag = 0 Then
//跅辉苉tDay1芪0苉苈苁芽苆花苫苰tDay2苌郦鎪苉貈鋨芷苩
tDay2(i) = 1
tFlag = 1
tLastDay = i
ElseIf tDay1(i) <> 0 Then
tDay2(i) = tDay1(tLastDay) + tDay2(tLastDay)
tLastDay = i
End If
Next
//Step.3腀詥荁荨莌荘苉荦腛荞苰趷芵趞英苅芢芭
For i = 1 to 2000
If gFileReadRecord(i,4) <> "" Then
tDayInteger = Val(RightB(gFileReadRecord(i,1),2))
MainList.Cell(tDay2(tDayInteger) + 1,1) = gFileReadRecord(i,1)
MainList.Cell(tDay2(tDayInteger) + 1,2) = gFileReadRecord(i,2)
MainList.Cell(tDay2(tDayInteger) + 1,3) = gFileReadRecord(i,3)
MainList.Cell(tDay2(tDayInteger) + 1,4) = gFileReadRecord(i,4)
MainList.Cell(tDay2(tDayInteger) + 1,5) = gFileReadRecord(i,5)
MainList.Cell(tDay2(tDayInteger) + 1,6) = gFileReadRecord(i,6)
MainList.Cell(tDay2(tDayInteger) + 1,7) = gFileReadRecord(i,7)
tDay2(tDayInteger) = tDay2(tDayInteger) + 1
Else
Exit
End If
Next
For i = 2 to 2000
If MainList.Cell(i,4) <> "" Then
tTotalKari = tTotalKari + ChangeSequence(MainList.Cell(i,6))
tTotalKasi = tTotalKasi + ChangeSequence(MainList.Cell(i,7))
If tKamokuType =2 Or tKamokuType = 3 Or tKamokuType = 5 Or tKamokuType = 7 Then
MainList.Cell(i,8) = SpaceSup(Format(ABS(ChangeSequence(MainList.Cell(i - 1,8)) * (-1) + ChangeSequence(MainList.Cell(i,6)) - ChangeSequence(MainList.Cell(i,7))),"-,#"),13)
Else
MainList.Cell(i,8) = SpaceSup(Format(ChangeSequence(MainList.Cell(i - 1,8)) + ChangeSequence(MainList.Cell(i,6)) - ChangeSequence(MainList.Cell(i,7)),"-,#"),13)
End If
Else
Exit
End If
Next
KariTotal.Text = Format(tTotalKari,"-,#")
KasiTotal.Text = Format(tTotalKasi,"-,#")
AllKariTotal.Text = Format(tTotalKari + ChangeSequence(MainList.Cell(1,6)),"-,#")
AllKasiTotal.Text = Format(tTotalKasi + ChangeSequence(MainList.Cell(1,7)),"-,#")
End Sub
Close
1
0
1
0
Sub Close()
End Sub
EnableMenuItems
2
28
2
28
Sub EnableMenuItems()
AppleU.Enabled = True
FilePageSetup.Enabled = True
Print.Enabled = True
End Sub
CancelClose
1
0
1
0
Function CancelClose() As Boolean
End Function
Open
26
16
26
18
Sub Open()
//2000.11.2 譎鎮躞苉荊莌莓荟腛荅荃莓荨荅苰詊芭苦芤苉闏赘
//2002.12.2 莌腛荕腛荶莊莓荞苉野覞腂
Dim tDate as Date
Dim tWindow as CalendarWindow
Dim tFolderItem as FolderItem
Dim FileReadFrom as TextInputStream
gBasicPath = GetFolderItem("").AbsolutePath
//腀荴荀荃莋苰詊芭
tFolderItem = MakeFolder(gBasicPath + "郝鋨")
tFolderItem = GetFolderItem(tFolderItem.AbsolutePath + "貳銠荶莊莓荞腛郝鋨")
If tFolderItem <> Nil Then //SP
FileReadFrom=tFolderItem.OpenAsTextfile
IF FileReadFrom <> Nil Then// 2#
gPrintSettings = FileReadFrom.ReadAll
FileReadFrom.Close
ELSE// 2#
END IF// 2#
END IF//SP
gVersionString = "醍誨鋨貳銠 Ver 2.0.3 2000/01/27"
//蹧靰觯軐隼
gCompanyType = "陀貎赈豼軐"
tDate = New Date
DateField.Text = Str(tDate.Year) + "鑎" + ZeroSup(tDate.Month,2) + "貎費距"
//荅荂莓荨荅苌裊鉵苰銲邮芷苩
if screen(0).width = 640 then
left = 0
top = 20
end if
//莁荃莓莊荘荧辉諺覻
MainList.columncount = 8
MainList.RowCount = 11
MainList.columnwidths "5,12,1,29,6,13,13,13"
MainList.columnheaders "鏺镴,览雚,,鍅腀腀腀靶,,軘闻,針闻,蹣趂"
MainList.columnmasks "@,@,@,@,@,@,@"
MainList.DrawUp "r0,l,l,l,l,l,r0"
MainList.EditField = MainListField
MainList.ScrollBar = MainListScrollBar
MainList.EditMode = 1
MainList.GetReady
//莁荃莓荻荞莓辉諺覻
//荻荞莓苌覡韱邔
MainButton.ColCount = 9
//荻荞莓苌轣赳邔
MainButton.RowCount = 15
//蹧靰荴荈莓荧
MainButton.TextFont = "Osaka"
//蹧靰荴荈莓荧荔荃荙
MainButton.TextSize = 10
//荻荞莓苌覡閝
MainButton.CellWidth = 68
//荻荞莓苌轣閝
MainButton.CellHeight = 14
//荻荞莓苌鎮芫腀0=MouseUp苰苆苩腀1=覚英苅芢苩苌苍迭苉苐苆苂腀2=苠芤裪鍸覟芳苪苈芢苆雟苧苈芢
MainButton.ButtonType = 1
MainButton.BadName = "***"
ReadKamoku()
PopupMenu1.ListIndex = 0
MainList.MoveCell(1,1)
MainListField.Top = -100
//=====荊莌莓荟腛荅荃莓荨荅苰詊芭=====
tWindow = New CalendarWindow
//荅荂莓荨荅苌裊鉵苰銲邮芷苩
if screen(0).width = 640 then
tWindow.Left = Mototyou.Left + Mototyou.Width - tWindow.Width - 1
Else
tWindow.Left = Me.Left + Mototyou.Left + 1
end if
tWindow.Top = 50//Me.Top + Me.Height + Mototyou.Top + 1
tWindow.ShowModal
//====================================
End Sub
AppleU
3
25
3
25
Function Action As Boolean
Dim tWindow as AboutWindow
tWindow = New AboutWindow
End Function
Print
2
0
2
0
Function Action As Boolean
Dim tWindow as PrintMenu
tWindow = New PrintMenu
End Function
FilePageSetup
13
31
13
31
Function Action As Boolean
Dim tFolderItem as FolderItem
Dim tTextOutput as TextOutputStream
Dim Pa as PrinterSetup
Pa = New PrinterSetup
Pa.SetupString = gPrintSettings
If Pa.PageSetupDialog Then
gPrintSettings = Pa.SetupString
//腀荴荀荃莋苰詊芭
tFolderItem = MakeFolder(gBasicPath + "郝鋨")
tFolderItem = GetFolderItem(tFolderItem.AbsolutePath + "貳銠荶莊莓荞腛郝鋨")
If tFolderItem <> Nil Then //SP
tTextOutput=tFolderItem.CreateTextfile
IF tTextOutput <> Nil Then// 2#
tTextOutput.Write gPrintSettings
tTextOutput.Close
END IF//// 2#
End If//SP
END IF
End Function
168
aList
0
MouseDrag
1
0
1
0
Sub MouseDrag(X As Integer, Y As Integer)
End Sub
CellChange
1
0
1
0
Sub CellChange(Row as integer, Col as integer)
End Sub
120
ScrollBar
0
ValueChanged
3
21
3
21
Sub ValueChanged()
MainList.topIndex = MainListScrollBar.value
MainListField.Enabled = False
MainList.aListRefresh
End Sub
156
EditField
0
KeyDown
1
0
1
0
Function KeyDown(Key As String) As Boolean
End Function
192
CellButton
0
DropObject
1
0
1
0
Sub DropObject(obj As DragItem)
End Sub
Close
1
0
1
0
Sub Close()
End Sub
MouseClick
6
25
6
25
Sub MouseClick(Col as Integer,Row as Integer)
KamokuName.Text = MainButton.ButtonName(Col,Row)
KamokuName.Refresh
//莁荃莓莊荘荧荎莊荁 2000
MainListClear()
//豊苨襺芵荦腛荞鏇苝趞苝 ?
ReadTransfer(DateField.Text,MainButton.ButtonName(Col,Row),MainButton.ButtonColor(Col,Row),PopupMenu1.ListIndex)
//違鍠荦腛荞鏇苝趞苝腩違鍠荦腛荞芩苧貳銠苰跬邬腪?
ReadAccount(MainButton.ButtonName(Col,Row),PopupMenu1.ListIndex)
//鏺镴芯苌荜腛荧 6031
DataSort(MainButton.ButtonColor(Col,Row))
//莁荃莓莊荘荧苌赘遖
MainList.aListRefresh
End Sub
MouseDown
1
0
1
0
Sub MouseDown(Col as Integer,Row as Integer)
End Sub
MouseUp
1
0
1
0
Sub MouseUp(Col as Integer,Row as Integer)
End Sub
MouseExit
1
0
1
0
Sub MouseExit()
End Sub
MouseEnter
1
0
1
0
Sub MouseEnter()
End Sub
MouseMove
1
0
1
0
Sub MouseMove(X As Integer, Y As Integer)
End Sub
MouseDrag
1
0
1
0
Sub MouseDrag(X As Integer, Y As Integer)
End Sub
128
StaticText
0
108
Rectangle
0
128
StaticText
0
108
Rectangle
0
128
StaticText
0
108
Rectangle
0
108
Rectangle
0
128
StaticText
0
108
Rectangle
0
128
StaticText
0
108
Rectangle
0
128
StaticText
0
108
Rectangle
0
108
Rectangle
0
MouseMove
1
0
1
0
Sub MouseMove(X As Integer, Y As Integer)
End Sub
128
StaticText
0
Open
1
0
1
0
Sub Open()
End Sub
MouseMove
1
0
1
0
Sub MouseMove(X As Integer, Y As Integer)
End Sub
128
StaticText
0
108
Rectangle
0
120
PushButton
0
Action
1
4
1
4
Sub Action()
Quit
End Sub
120
PushButton
0
LostFocus
1
0
1
0
Sub LostFocus()
End Sub
Action
3
23
3
23
Sub Action()
Dim tWindow as PrintMenu
tWindow = New PrintMenu
End Sub
120
PushButton
0
Action
11
17
11
17
Sub Action()
Dim tWindow as CalendarWindow
tWindow = New CalendarWindow
//荅荂莓荨荅苌裊鉵苰銲邮芷苩
if screen(0).width = 640 then
tWindow.Left = Mototyou.Left + Mototyou.Width - tWindow.Width - 1
Else
tWindow.Left = Me.Left + Mototyou.Left + 1
end if
tWindow.Top = Me.Top + Me.Height + Mototyou.Top + 1
tWindow.ShowModal
End Sub
132
PopupMenu
0
Change
1
0
1
0
Sub Change()
End Sub
PushButton
PushButton
PushButton2
-2147483648
0
True
494
7
60
20
True
False
False
False
False
Osaka腼鎙閝
12
False
False
False
裳跼
False
False
True
22
PushButton
PushButton
PushButton1
-2147483648
0
True
562
7
60
20
True
False
False
False
False
Osaka腼鎙閝
12
False
False
False
轉鞹
False
False
True
21
PushButton
PushButton
PushButton3
-2147483648
0
True
342
7
80
20
True
False
False
False
False
Osaka腼鎙閝
12
False
False
False
荊莌莓荟腛
False
False
True
23
Rectangle
Rectangle
Rectangle9
-2147483648
0
True
228
7
108
21
True
False
False
False
False
True
15658734
1
0
0
20
StaticText
StaticText
DateField
-2147483648
0
True
233
10
96
16
True
False
False
False
False
Osaka
12
False
False
False
0
0
False
True
19
Canvas
Canvas
MainList
-2147483648
0
True
11
34
602
143
True
False
False
False
False
0
True
True
False
False
0
ScrollBar
ScrollBar
MainListScrollBar
-2147483648
0
True
612
34
16
143
True
False
False
False
False
0
0
2000
True
1
10
True
1
EditField
EditField
MainListField
-2147483648
0
False
11
57
80
16
True
False
False
False
False
Osaka腼鎙閝
12
False
False
False
True
False
False
False
False
False
False
True
False
0
False
0
0
16777215
False
2
Rectangle
Rectangle
Rectangle1
-2147483648
0
True
11
193
352
18
True
False
False
False
False
True
13434828
1
0
0
17
Rectangle
Rectangle
Rectangle2
-2147483648
0
True
443
193
88
18
True
False
False
False
False
True
13434828
1
0
0
16
StaticText
StaticText
AllKasiTotal
-2147483648
0
True
440
193
85
18
True
False
False
False
False
Osaka腼鎙閝
12
False
False
False
2
0
False
True
15
Rectangle
Rectangle
Rectangle3
-2147483648
0
True
527
193
86
18
True
False
False
False
False
True
13434828
1
0
0
14
StaticText
StaticText
StaticText1
-2147483648
0
True
156
194
85
18
True
False
False
False
False
Osaka
12
False
False
False
韝腀腀腀腀豶
1
0
False
True
13
Rectangle
Rectangle
Rectangle4
-2147483648
0
True
359
193
85
18
True
False
False
False
False
True
13434828
1
0
0
12
StaticText
StaticText
AllKariTotal
-2147483648
0
True
356
193
85
18
True
False
False
False
False
Osaka腼鎙閝
12
False
False
False
2
0
False
True
11
Rectangle
Rectangle
Rectangle5
-2147483648
0
True
11
176
352
18
True
False
False
False
False
True
13434828
1
0
0
10
Rectangle
Rectangle
Rectangle6
-2147483648
0
True
443
176
88
18
True
False
False
False
False
True
13434828
1
0
0
9
StaticText
StaticText
KasiTotal
-2147483648
0
True
440
176
85
18
True
False
False
False
False
Osaka腼鎙閝
12
False
False
False
2
0
False
True
8
Rectangle
Rectangle
Rectangle7
-2147483648
0
True
527
176
86
18
True
False
False
False
False
True
13434828
1
0
0
7
StaticText
StaticText
StaticText5
-2147483648
0
True
160
177
80
18
True
False
False
False
False
Osaka
12
False
False
False
鎖腀貎腀趇腀豶
1
0
False
True
6
Rectangle
Rectangle
Rectangle8
-2147483648
0
True
359
176
85
18
True
False
False
False
False
True
13434828
1
0
0
5
StaticText
StaticText
KariTotal
-2147483648
0
True
356
176
85
18
True
False
False
False
False
Osaka腼鎙閝
12
False
False
False
2
0
False
True
4
Canvas
Canvas
MainButton
-2147483648
0
True
13
230
614
212
True
False
False
False
False
0
True
True
False
False
3
StaticText
StaticText
KamokuName
-2147483648
0
True
13
2
115
27
True
False
False
False
False
Osaka
18
False
False
False
1
0
False
True
18
PopupMenu
PopupMenu
PopupMenu1
-2147483648
0
True
133
8
83
20
True
False
False
False
False
Osaka腼鎙閝
12
False
False
False
True
915391CC0D8D488C7C8ED00D53797374656D0D46697368696E670D8AC7979D
0
24
Menu
0
aList
35
-1000
1
aList
168
Canvas
0
ColumnCount as integer
ColumnWidth(32) as integer
TopIndex as integer
Cell(2000, 32) as String
Header(32) as String
CurrentRow as integer
ClickPosX as integer
ClickPosY as integer
EditField as EditField
Mask(32) as String
ScrollBar as ScrollBar
EditMode as integer
ColumnDrawUp(32) as String
RowCount as Integer
Ver115 as String
ColumnWidths
s as String
0
11
2
11
6
Sub ColumnWidths(s as String)
dim i as integer // text length
dim j as integer // current column
dim t as string // current length
dim c as string // current character
j = 1
for i = 1 to len(s)
c = mid(s, i, 1)
if c = "," then
ColumnWidth(j) = val(t) + 1
t = ""
j = j + 1
if j > 32 then
beep
msgbox "error:aList苌荊莉莀邔芪32韱苰銴芦苜芵芽"
exit
end if
else
if (asc(c) > asc("9") or asc(c) < asc("0")) then
beep
msgbox "error:aList苌ColumnWidths苅镳邳苈閶躚芪蹷鋨芳苪苜芵芽"
exit
else
t = t + c
end if
end if
next
ColumnWidth(j) = val(t) + 1
End Sub
aListRefresh
0
2
0
2
0
Sub aListRefresh()
Redraw Graphics
End Sub
ColumnHeaders
s as String
0
11
2
11
6
Sub ColumnHeaders(s as String)
dim i as integer // text length
dim j as integer // current column
dim t as string // current length
dim c as string // current character
j = 1
for i = 1 to len(s)
c = mid(s, i, 1)
if c = "," then
Header(j) = t
t = ""
j = j + 1
if j > 32 then
beep
msgbox "error:aList苌荷荢荟荊莉莀邔芪32韱苰銴芦苜芵芽"
exit
end if
else
t = t + c
end if
next
Header(j) = t
End Sub
Redraw
g as Graphics
0
34
0
34
0
Sub Redraw(g as Graphics)
dim w as integer
dim h as integer
dim i as integer
dim j as integer
dim ch as integer
dim cw as integer
dim x as integer
w = g.width -2
h = g.height -2
ch = g.textheight + 2
cw = g.textheight / 2
g.forecolor = rgb(64, 128, 64)
x = 0
for i = 1 to ColumnCount
x = x + ColumnWidth(i) * cw
g.drawline x, 16, x, h
next
RowCount = floor((h-15) / ch)-1
select case EditMode
case 0
for i = 0 to RowCount
x = 0
for j = 1 to ColumnCount
if j = ClickPosX and i + TopIndex = ClickPosY then
g.forecolor = rgb(0, 0, 64)
g.fillrect x + 1, i * ch + 16, ColumnWidth(j) * cw - 1, ch
g.forecolor = rgb(255, 255, 255)
g.drawstring cell(TopIndex + i, j) , x + 4, i * ch + ch + 14
else
if (i mod 2) = 0 then
g.forecolor = rgb(192, 255, 192)
else
g.forecolor = rgb(255, 255, 255)
end if
g.fillrect x + 1, i * ch + 16, ColumnWidth(j) * cw - 1, ch
g.forecolor = rgb(0, 0, 0)
g.drawstring cell(TopIndex + i, j) , x + 4, i * ch + ch + 14
end if
x = x + ColumnWidth(j) * cw
next
next
case 1
for i = 0 to RowCount
x = 0
for j = 1 to ColumnCount
if i + TopIndex = ClickPosY then
g.forecolor = rgb(0, 0, 64)
g.fillrect x + 1, i * ch + 16, ColumnWidth(j) * cw - 1, ch
g.forecolor = rgb(255, 255, 255)
g.drawstring cell(TopIndex + i, j) , x + 4, i * ch + ch + 14
else
if (i mod 2) = 0 then
g.forecolor = rgb(192, 255, 192)
else
g.forecolor = rgb(255, 255, 255)
end if
g.fillrect x + 1, i * ch + 16, ColumnWidth(j) * cw - 1, ch
g.forecolor = rgb(0, 0, 0)
g.drawstring cell(TopIndex + i, j) , x + 4, i * ch + ch + 14
end if
x = x + ColumnWidth(j) * cw
next
next
end select
End Sub
ClickCell
X as integer, Y as integer
0
21
0
21
8
Sub ClickCell(X as integer, Y as integer)
dim i as integer
dim t as integer
dim ch as integer
dim cw as integer
cw = Graphics.textheight / 2
ch = Graphics.textheight + 2
if Y > 16 then
ClickPosY = (y - 16) / ch + TopIndex
for i = 1 to ColumnCount
if X < t + ColumnWidth(i) * cw then
ClickPosX = i
exit
end if
t = t + ColumnWidth(i) * cw
next
Redraw Graphics
MoveCell ClickPosY, ClickPosX
end if
End Sub
MoveCell
row as integer, column as integer
0
32
10
32
19
Sub MoveCell(row as integer, column as integer)
dim i as integer
dim t as integer
dim ch as integer
dim cw as integer
for i = 1 to column - 1
t = t + ColumnWidth(i)
next
select case EditMode
case 0
cw = Graphics.textheight / 2
ch = Graphics.textheight + 2
EditField.Top = -100
EditField.width = ColumnWidth(i) * cw + 1
EditField.Left = t * cw + Left
EditField.Top = (row - TopIndex) * ch + Top + 16
CellChange ClickPosY, ClickPosX
EditField.Visible = true
EditField.Enabled = true
If ColumnDrawUp(ClickPosX) = "l" Or ColumnDrawUp(ClickPosX) = "" Then
EditField.LimitText = ColumnWidth(Column) - 1
ElseIf ColumnDrawUp(ClickPosX) = "r0" Then
EditField.LimitText = ColumnWidth(Column) - 4
ElseIf ColumnDrawUp(ClickPosX) = "r1" Then
EditField.LimitText = ColumnWidth(Column) - 6
ElseIf ColumnDrawUp(ClickPosX) = "r2" Then
EditField.LimitText = ColumnWidth(Column) - 7
End If
EditField.Text = cell(row, column)
EditField.SetFocus
case 1
CellChange ClickPosY, 0
Redraw Graphics
end select
End Sub
ColumnMasks
s as String
0
11
2
11
6
Sub ColumnMasks(s as String)
dim i as integer // text length
dim j as integer // current column
dim t as string // current length
dim c as string // current character
j = 1
for i = 1 to len(s)
c = mid(s, i, 1)
if c = "," then
Mask(j) = t
t = ""
j = j + 1
if j > 32 then
beep
msgbox "error:aList苌荽荘荎荊莉莀邔芪32韱苰銴芦苜芵芽"
exit
end if
else
t = t + c
end if
next
Mask(j) = t
End Sub
KeyPress
s as String
Boolean
0
66
0
66
8
Function KeyPress(s as String) As Boolean
dim tstring as integer
Select Case Asc(s)
case 28 // up
MoveLeft()
EditField.Top = -100
case 29 // down
MoveRight()
EditField.Top = -100
case 30 // up
MoveUp()
EditField.Top = -100
case 31 // down
MoveDown()
EditField.Top = -100
case 13 // return
if Mask(ClickPosX) = "0" then
If ColumnDrawUp(ClickPosX) = "l" Or ColumnDrawUp(ClickPosX) = "" Then
cell(ClickPosY, ClickPosX) = EditField.Text
ElseIf ColumnDrawUp(ClickPosX) = "r0" And ChangeSequence(EditField.Text) <> 0 Then
cell(ClickPosY, ClickPosX) = SpaceSup(Format(ChangeSequence(EditField.Text),"-,#"),ColumnWidth(ClickPosX) - 1)
ElseIf ColumnDrawUp(ClickPosX) = "r1" And ChangeSequence(EditField.Text) <> 0 Then
cell(ClickPosY, ClickPosX) = SpaceSup(Format(ChangeSequence(EditField.Text),"-,#.0"),ColumnWidth(ClickPosX) - 1)
ElseIf ColumnDrawUp(ClickPosX) = "r2" And ChangeSequence(EditField.Text) <> 0 Then
cell(ClickPosY, ClickPosX) = SpaceSup(Format(ChangeSequence(EditField.Text),"-,#.00"),ColumnWidth(ClickPosX) - 1)
Else
cell(ClickPosY, ClickPosX) = ""
End If
End If
If Columncount = ClickPosX Then
MoveRight()
EditField.Top = -100
Else
EditField.Text = ""
ClickPosX = ClickPosX + 1
Editfield.Text = Cell(ClickPosY,ClickPosX)
EditField.Top = -100
End If
case 3 // enter
if Mask(ClickPosX) = "0" then
If ColumnDrawUp(ClickPosX) = "l" Or ColumnDrawUp(ClickPosX) = "" Then
cell(ClickPosY, ClickPosX) = EditField.Text
ElseIf ColumnDrawUp(ClickPosX) = "r0" And ChangeSequence(EditField.Text) <> 0 Then
cell(ClickPosY, ClickPosX) = SpaceSup(Format(ChangeSequence(EditField.Text),"-,#"),ColumnWidth(ClickPosX) - 1)
ElseIf ColumnDrawUp(ClickPosX) = "r1" And ChangeSequence(EditField.Text) <> 0 Then
cell(ClickPosY, ClickPosX) = SpaceSup(Format(ChangeSequence(EditField.Text),"-,#.0"),ColumnWidth(ClickPosX) - 1)
ElseIf ColumnDrawUp(ClickPosX) = "r2" And ChangeSequence(EditField.Text) <> 0 Then
cell(ClickPosY, ClickPosX) = SpaceSup(Format(ChangeSequence(EditField.Text),"-,#.00"),ColumnWidth(ClickPosX) - 1)
Else
cell(ClickPosY, ClickPosX) = ""
End If
End If
If Columncount = ClickPosX Then
MoveRight()
EditField.Top = -100
Else
EditField.Text = ""
ClickPosX = ClickPosX + 1
Editfield.Text = Cell(ClickPosY,ClickPosX)
EditField.Top = -100
End If
else
if EditField.Top = -100 then
MoveCell ClickPosY, ClickPosX
end if
if Mask(ClickPosX) = "@" then
return true
end if
return false
end select
Redraw Graphics
return false
End Function
GetReady
0
2
58
2
58
Sub GetReady()
ScrollBar.minimum = 1
ScrollBar.maximum = ScrollBar.Maximum - ScrollBar.PageStep
End Sub
DrawUp
tString as String
0
7
12
7
12
Sub DrawUp(tString as String)
dim i as integer // text length
dim j as integer // current column
dim t as string // current length
dim c as string // current character
j = 1
for i = 1 to len(tString)
c = mid(tString, i, 1)
if c = "," then
ColumnDrawUp(j) = t
t = ""
j = j + 1
if j > 32 then
beep
msgbox "error:aList苌荷荢荟荊莉莀邔芪32韱苰銴芦苜芵芽"
exit
end if
else
t = t + c
end if
next
ColumnDrawUp(j) = t
End Sub
MoveRight
0
3
0
3
0
Sub MoveRight()
if ClickPosX < ColumnCount then
ClickPosX = ClickPosX+ 1
MoveCell ClickPosY, ClickPosX
else
ClickPosX = 1
MoveDown()
end if
Editfield.Text = Cell(ClickPosY,ClickPosX)
End Sub
MoveLeft
0
3
0
3
0
Sub MoveLeft()
if ClickPosX > 1 then
ClickPosX = ClickPosX - 1
MoveCell ClickPosY, ClickPosX
else
ClickPosX = ColumnCount
MoveUp()
end if
Editfield.Text = Cell(ClickPosY,ClickPosX)
End Sub
MoveUp
0
10
0
11
0
Sub MoveUp()
if ClickPosY > 1 then
ClickPosY = ClickPosY - 1
end if
if ClickPosY < topIndex then
topIndex = ClickPosY
end if
ScrollBar.value = topIndex
//MainListEditField.Enabled = False
Refresh
MoveCell ClickPosY, ClickPosX
Editfield.Text = Cell(ClickPosY,ClickPosX)
End Sub
MoveDown
0
10
0
10
8
Sub MoveDown()
if ClickPosX < 300 then
ClickPosY = ClickPosY + 1
end if
if ClickPosY > topIndex + rowCount then
topIndex = ClickPosY - rowCount
end if
ScrollBar.value = topIndex
//MainListEditField.Enabled = False
Refresh
MoveCell ClickPosY, ClickPosX
Editfield.Text = Cell(ClickPosY,ClickPosX)
End Sub
ChangeSequence
tString as String
Double
0
8
0
8
46
Function ChangeSequence(tString as String) As Double
//論邔郠难腆荊莓荽苌趬芶苁芽邔躚閶躚韱苰Double苉芵苄闔芷
//裸芫邔腀腆String
//闔苨鉬腀腆Double
//跬邬鏺腀腆1998/07/03(Fri)
//铵赬腀腀腆
Dim tReturnDouble as Double
tReturnDouble = Val(RemoveString(tString,","))
Return tReturnDouble
End Function
SpaceSup
tNumerical as String,tKeta as Integer
String
0
6
14
6
14
Function SpaceSup(tNumerical as String,tKeta as Integer) As String
Dim tString as String
tString = " " + tNumerical
tString = RightB(tString,tKeta)
Return tString
End Function
RemoveString
tString as String,tRemoveString as String
String
0
12
42
12
42
Function RemoveString(tString as String,tRemoveString as String) As String
//論邔郠难腆閶躚韱芩苧腁蹷鋨芳苪芽閶躚裈詏苰軦苨软芷
//裸芫邔腀腆閶躚韱腁閶躚韱芩苧軦苨辜芫芽芢閶躚
//闔苨鉬腀腆軦苨辜芩苪芽閶躚韱
//跬邬鏺腀腆1998/--/--(---)
//轃邳鏺腀腆1998/09/23(Wed)腀花苌荒莁莓荧苰镴芯芽
//铵赬腀腀腆
Dim i as Integer
Dim tReturnString as String
tReturnString = ""
For i = 1 to LenB(tString)
tReturnString = tReturnString + Y_NthField(tString,tRemoveString,i)
Next
Return tReturnString
End Function
CellChange
Row as integer, Col as integer
Close
1
0
1
0
Sub Close()
End Sub
MouseExit
1
0
1
0
Sub MouseExit()
End Sub
MouseEnter
1
0
1
0
Sub MouseEnter()
End Sub
MouseMove
1
0
1
0
Sub MouseMove(X As Integer, Y As Integer)
End Sub
MouseDrag
1
0
1
0
Sub MouseDrag(X As Integer, Y As Integer)
End Sub
Open
1
13
1
17
Sub Open()
Graphics.textfont="Osaka腼鎙閝"
TopIndex = 1
End Sub
MouseUp
1
0
1
0
Sub MouseUp(X As Integer, Y As Integer)
End Sub
MouseDown
1
0
1
0
Function MouseDown(X As Integer, Y As Integer) As Boolean
ClickCell X, Y
End Function
Paint
1
0
46
0
Sub Paint(g As Graphics)
dim w as integer
dim h as integer
dim i as integer
dim j as integer
dim g as Graphics
dim ch as integer
dim cw as integer
dim x as integer
g = Graphics
w = g.width -2
h = g.height -2
cw = g.textheight / 2
ch = g.textheight + 2
g.forecolor = rgb(255, 255, 255)
g.drawline 1, 15, 1, 1 // header leftline
g.drawline 1, 1, w, 1 // header topline
g.fillrect 1, 16, w, h - 16
g.forecolor = rgb(184, 184, 184)
g.drawline w, 1, w, 14
g.drawline w, 14, 1, 14
x = 0
for i = 1 to ColumnCount
x = x + ColumnWidth(i) * cw
g.forecolor = rgb(64, 128, 64)
g.drawline x, 1, x, 15
g.forecolor = rgb(255, 255, 255)
g.drawline x+1, 1, x+1, 15
next
g.forecolor = rgb(0, 0, 0)
g.drawrect 0, 0, g.width-1, g.height-1 // frame
g.drawline 0, 15, w, 15 // header underline
x = 0
for i = 1 to ColumnCount
g.drawstring Header(i), x + 4, 12
x = x + ColumnWidth(i) * cw
next
Redraw g
End Sub
AboutWindow
34
-1000
451
383
AboutWindow
4
True
16777215
0
True
False
True
False
False
False
0
0
300
300
64
64
32000
32000
AboutWindow
120
Window
0
Open
1
26
1
26
Sub Open()
AppNameText.Text =Mototyou.Title
VerText.Text = gVersionString
End Sub
108
Canvas
0
MouseDown
1
0
1
0
Function MouseDown(X As Integer, Y As Integer) As Boolean
End Function
Paint
1
0
1
0
Sub Paint(g As Graphics)
End Sub
128
StaticText
0
MouseMove
1
0
1
0
Sub MouseMove(X As Integer, Y As Integer)
End Sub
120
PushButton
0
Action
1
5
1
5
Sub Action()
Close
End Sub
128
StaticText
0
128
StaticText
0
128
StaticText
0
MouseMove
1
0
1
0
Sub MouseMove(X As Integer, Y As Integer)
End Sub
Canvas
Canvas
Canvas1
-2147483648
0
True
75
165
146
64
True
False
False
False
False
0
True
True
False
False
0
StaticText
StaticText
StaticText1
-2147483648
0
True
50
124
200
18
True
False
False
False
False
Osaka
12
False
False
False
Norizuki Industrial Arts Co.,Ltd.
0
0
False
True
1
StaticText
StaticText
AppNameText
-2147483648
0
True
50
36
200
35
True
False
False
False
False
Osaka
18
False
False
False
1
0
False
True
5
PushButton
PushButton
PushButton1
-2147483648
0
True
50
247
200
20
True
False
False
False
False
Osaka
12
False
False
False
OK
True
False
True
2
StaticText
StaticText
StaticText3
-2147483648
0
True
50
142
200
16
True
False
False
False
False
Osaka
12
False
False
False
System詊钭
1
0
False
True
3
StaticText
StaticText
VerText
-2147483648
0
True
50
76
200
16
True
False
False
False
False
Osaka
12
False
False
False
1
0
False
True
4
DateField
35
-1000
1
DateField
185
EditField
0
year as integer
month as integer
day as integer
weekDay as integer
date as date
format as string
currentPos as integer
RedrawFlg as boolean
redraw
0
16
0
16
0
Sub redraw()
RedrawFlg = true
Text = format(Year, "0000") + "/" + format(Month, "00") + "/" + format(Day, "00")
select case currentPos
case 1
me.selstart = 0
me.sellength = 4
case 2
me.selstart = 5
me.sellength = 2
case 3
me.selstart = 8
me.sellength = 2
end select
RedrawFlg = false
End Sub
Inc
0
13
0
13
0
Sub Inc()
select case currentPos
case 1//Year
IncYear()
case 2//Month
IncMonth()
case 3//Day
IncDay()
end select
Redraw
End Sub
Dec
0
13
0
13
0
Sub Dec()
select case currentPos
case 1//Year
DecYear()
case 2//Month
DecMonth()
case 3//Day
DecDay()
end select
Redraw
End Sub
IsLeapYear
Boolean
0
4
0
4
0
Function IsLeapYear() As Boolean
//荊莌莓荧鑎芪襛鑎苈苧True
return (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0))
//1920/1/1 Thursday
End Function
GetDaysOfMonth
Integer
0
4
21
4
21
Function GetDaysOfMonth() As Integer
dim days as integer
//芻苌貎苌鏺邔苰闔芷
days = val(Y_NthField("31,28,31,30,31,30,31,31,30,31,30,31", ",",month))
//襛鑎苈苧艑貎苉艐见蹚
if (month = 2) and IsLeapYear then
days = days + 1
end if
return days
End Function
DecMonth
0
5
0
5
0
Sub DecMonth()
Month = Month - 1
if Month = 0 then
DecYear()
Month = 12
end if
End Sub
DecDay
0
3
0
3
0
Sub DecDay()
Day = Day - 1
if Day = 0 then
DecMonth()
Day = GetDaysOfMonth()
end if
End Sub
IncMonth
0
6
0
6
0
Sub IncMonth()
Month = Month + 1
if Month = 13 then
Month = 1
IncYear()
end if
End Sub
IncDay
0
6
0
6
0
Sub IncDay()
Day = Day + 1
if Day > GetDaysOfMonth() then
Day = 1
IncMonth()
end if
End Sub
IncYear
0
5
0
5
0
Sub IncYear()
Year = Year + 1
if Year > 2100 then
Year = 2100
end if
End Sub
DecYear
0
3
11
3
11
Sub DecYear()
Year = Year - 1
if Year < 1920 then
Year = 1920
end if
End Sub
EnterField
LostFocus
1
0
1
0
Sub LostFocus()
End Sub
TextChange
1
0
1
0
Sub TextChange()
End Sub
KeyDown
3
0
3
10
Function KeyDown(Key As String) As Boolean
select case key
case chr(29)
currentPos = currentPos + 1
if currentPos > 3 then
currentPos = 1
end if
case chr(28)
currentPos = currentPos - 1
if currentPos < 1 then
currentPos = 3
end if
case chr(30)
Inc()
case chr(31)
Dec()
end select
if Key < "0" or Key > "9" then
redraw
return true
end if
select case currentPos
case 1
case 2
case 3
end select
End Function
SelChange
5
0
11
6
Sub SelChange()
if RedrawFlg = true then
return
end if
if me.selstart < 4 then
currentPos = 1
elseif me.selstart < 8 then
currentPos = 2
else
currentPos = 3
end if
redraw
End Sub
GotFocus
2
10
2
10
Sub GotFocus()
redraw
EnterField
End Sub
Open
9
0
9
0
Sub Open()
dim s as string
me.date = new date
Year = date.Year
Month = date.Month
Day = date.Day
currentPos = 3
redraw
End Sub
MsgDlg
34
181
97
89
MsgDlg
2
False
16777215
0
Untitled
False
False
True
False
False
False
0
0
364
111
64
64
32000
32000
MsgDlg
132
Window
0
QuitMode as String
DialogMode as String
IconMode as string
SetMode
tMode as string
0
23
46
23
46
Sub SetMode(tMode as string)
if Y_InStr(1,tMode, "闛醶")<>0 then
MessageCap.text = "闏赘鏠靥苰闛醶芵苄轉鞹芵苜芷芩腈"
DialogMode = "Save"
IconMode="Stop"
end if
if Y_InStr(1,tMode, "銍裓")<>0 then
IconMode="Note"
end if
if Y_InStr(1,tMode, "豸趐")<>0 then
IconMode="Caution"
end if
if Y_InStr(1,tMode, "鋢蹾")<>0 then
IconMode="Stop"
end if
if Y_InStr(1,tMode, "OK")<>0 then
DialogMode = "OK"
end if
if Y_InStr(1,tMode, "Cancel")<>0 or Y_InStr(1,tMode, "荌莃莓荚莋")<>0 then
DialogMode = "OKCancel"
end if
select case DialogMode
case "闛醶"
button(0).caption ="闛醶"
button(1).caption ="荌莃莓荚莋"
button(2).caption ="闛醶芵苈芢"
button(0).visible = true
button(1).visible = true
button(2).visible = true
case "OK"
button(0).caption ="OK"
button(0).visible = true
button(1).visible = false
button(2).visible = false
case "OKCancel"
button(0).caption ="OK"
button(1).caption ="荌莃莓荚莋"
button(0).visible = true
button(1).visible = true
button(2).visible = false
end select
visible = true
End Sub
SetMessage
tMessage as String
0
2
0
2
0
Sub SetMessage(tMessage as String)
MessageCap.text = tMessage
End Sub
Open
1
0
1
0
Sub Open()
End Sub
120
PushButton
0
Action
1
32
1
32
Sub Action(Index As Integer)
QuitMode = Button(Index).caption
hide
End Sub
128
StaticText
0
108
Canvas
0
Paint
1
20
1
20
Sub Paint(g As Graphics)
select case IconMode
case "Note"
g.DrawNoteIcon 0,0
case "Caution"
g.DrawCautionIcon 0,0
case "Stop"
g.DrawStopIcon 0,0
end select
End Sub
PushButton
PushButton
Button
0
0
True
289
78
60
20
True
False
False
False
False
Osaka
12
False
False
False
闛醶
False
False
True
0
PushButton
PushButton
Button
1
0
True
171
78
84
20
True
False
False
False
False
Osaka
12
False
False
False
荌莃莓荚莋
False
False
True
0
StaticText
StaticText
MessageCap
-2147483648
0
True
59
13
290
50
True
False
False
False
False
Osaka
12
False
False
False
SetMode "闛醶,豸趐,鋢蹾,銍裓,OK,荌莃莓荚莋" SetMessage "镜躦芵芽芢鏠靥" / ShowModal / QuitMode
0
0
True
True
1
PushButton
PushButton
Button
2
0
True
27
78
88
20
True
False
False
False
False
Osaka
12
False
False
False
闛醶芵苈芢
False
False
True
0
Canvas
Canvas
IconBox
-2147483648
0
True
13
13
32
32
True
False
False
False
False
0
True
True
False
False
2
Spin
35
-1000
1
Spin
124
Canvas
0
value as integer
minimum as integer
maximum as integer
stepValue as integer
redraw
g as graphics
0
32
32
32
32
Sub redraw(g as graphics)
dim w as integer
dim h as integer
dim i as integer
w = g.width -1
h = g.height -1
g.forecolor = rgb(0, 0, 0)
g.drawline 1, 0, w - 1, 0
g.drawline w, 1, w, h - 1
g.drawline w - 1, h, 1, h
g.drawline 0, h - 1, 0, 1
g.drawline 0, h/2, w, h/2
g.forecolor = rgb(208, 208, 208)
g.fillrect 2, 2, w-3, h/2-2
g.forecolor = rgb(160, 160, 160)
g.drawline w-1, 1, w-1, h/2-1
g.drawline w-1, h/2-1, 1, h/2-1
g.forecolor = rgb(255, 255, 255)
g.drawline w-1, 1, 1, 1
g.drawline 1, 1, 1, h/2-1
g.forecolor = rgb(0, 0, 0)
for i = 0 to 3
g.drawline w/2-i, 4+i, w/2+i, 4+i
next
g.forecolor = rgb(208, 208, 208)
g.fillrect 2, h/2+2, w-3, h/2-2
g.forecolor = rgb(160, 160, 160)
g.drawline w-1, h/2+1, w-1, h-1
g.drawline w-1, h-1, 1, h-1
g.forecolor = rgb(255, 255, 255)
g.drawline w-1, h/2+1, 1, h/2+1
g.drawline 1, h/2+1, 1, h-1
g.forecolor = rgb(0, 0, 0)
for i = 0 to 3
g.drawline w/2-i, h-4-i, w/2+i, h-4-i
next
End Sub
MouseClick
UpClick
DownClick
MouseMove
1
0
1
0
Sub MouseMove(X As Integer, Y As Integer)
End Sub
Close
1
0
1
0
Sub Close()
End Sub
Open
5
0
5
0
Sub Open()
value = 0
maximum = 100
minimum = 0
stepValue = 1
End Sub
MouseDrag
1
0
1
0
Sub MouseDrag(X As Integer, Y As Integer)
End Sub
MouseUp
5
0
5
0
Sub MouseUp(X As Integer, Y As Integer)
dim g as Graphics
g = me.graphics
redraw g
MouseClick
End Sub
MouseDown
48
11
48
11
Function MouseDown(X As Integer, Y As Integer) As Boolean
dim w as integer
dim h as integer
dim i as integer
dim g as graphics
g = me.Graphics
w = g.width -1
h = g.height -1
if y < h/2 then
g.forecolor = rgb(96, 96, 96)
g.fillrect 2, 2, w-3, h/2-2
g.forecolor = rgb(160, 160, 160)
g.drawline w-1, 1, w-1, h/2-1
g.drawline w-1, h/2-1, 1, h/2-1
g.forecolor = rgb(64, 64, 64)
g.drawline w-1, 1, 1, 1
g.drawline 1, 1, 1, h/2-1
g.forecolor = rgb(255, 255, 255)
for i = 0 to 3
g.drawline w/2-i, 4+i, w/2+i, 4+i
next
value = value + stepValue
if value > maximum then
value = maximum
end if
UpClick
else
g.forecolor = rgb(96, 96, 96)
g.fillrect 2, h/2+2, w-3, h/2-2
g.forecolor = rgb(160, 160, 160)
g.drawline w-1, h/2+1, w-1, h-1
g.drawline w-1, h-1, 1, h-1
g.forecolor = rgb(64, 64, 64)
g.drawline w-1, h/2+1, 1, h/2+1
g.drawline 1, h/2+1, 1, h-1
g.forecolor = rgb(255, 255, 255)
for i = 0 to 3
g.drawline w/2-i, h-4-i, w/2+i, h-4-i
next
value = value - stepValue
if value < minimum then
value = minimum
end if
DownClick
end if
return true
End Function
Paint
2
0
2
0
Sub Paint(g As Graphics)
redraw g
End Sub
Grobal
36
-1000
0
Grobal
52
0
gVersionString as String
gBasicPath as String
gKamoku(135) as String
gKingaku(135,2) as Double
gFileReadRecord(2000,8) as String
gCompanyType as String
gPrintSettings as String
CalendarWindow
34
130
302
328
CalendarWindow
1
False
16777215
0
荊莌莓荟腛
True
False
True
False
False
False
0
0
400
200
64
64
32000
32000
CalendarWindow
120
Window
0
Open
1
0
1
46
Sub Open()
DateBufferField.Text = Mototyou.DateField.Text
End Sub
132
MonthCalendar
0
MouseClick
1
0
1
75
Sub MouseClick()
DateBufferField.Text = Str(Me.Year) + "鑎" + ZeroSup(Me.Month,2) + "貎費距"
End Sub
120
PushButton
0
Action
2
15
2
15
Sub Action()
Calendar.DecMonth
Calendar.Redraw
End Sub
120
PushButton
0
Action
1
0
1
8
Sub Action()
Calendar.IncMonth
Calendar.Redraw
End Sub
120
PushButton
0
Action
3
9
3
22
Sub Action()
Mototyou.DateField.Text = DateBufferField.Text
Mototyou.MainListClear
Mototyou.MainList.aListRefresh
Mototyou.MainListScrollBar.Value = 1
Close
End Sub
108
Rectangle
0
128
StaticText
0
108
Rectangle
0
128
StaticText
0
Canvas
Canvas
Calendar
-2147483648
0
True
20
41
357
145
True
False
False
False
False
0
True
True
False
False
0
PushButton
PushButton
PushButton1
-2147483648
0
True
296
13
35
20
True
False
False
False
False
Osaka
12
False
False
False
膃膃
False
False
True
1
PushButton
PushButton
PushButton2
-2147483648
0
True
342
13
35
20
True
False
False
False
False
Osaka
12
False
False
False
膄膄
False
False
True
2
PushButton
PushButton
PushButton3
-2147483648
0
True
138
12
60
20
True
False
False
False
False
Osaka
12
False
False
False
OK
False
False
True
3
Rectangle
Rectangle
Rectangle9
-2147483648
0
True
504
8
108
21
True
False
False
False
False
True
15658734
1
0
0
4
StaticText
StaticText
StaticText2
-2147483648
0
True
509
11
104
16
True
False
False
False
False
Osaka
12
False
False
False
1998鑎12貎費距
0
0
False
True
5
Rectangle
Rectangle
Rectangle1
-2147483648
0
True
25
12
108
21
True
False
False
False
False
True
15658734
1
0
0
6
StaticText
StaticText
DateBufferField
-2147483648
0
True
29
15
104
16
True
False
False
False
False
Osaka
12
False
False
False
0
0
False
True
7
CellButton
35
-1000
1
CellButton
192
Canvas
0
ButtonName(96,32) as String
ColCount as Integer
RowCount as Integer
CellWidth as Integer
CellHeight as Integer
TextFont as String
TextSize as Integer
ButtonColor(96,32) as Integer
ButtonData1(96,32) as String
Ver110 as String
ButtonType as Integer
ButtonStatus(96,32) as Integer
PushButtonCol as Integer
PushButtonRow as Integer
BadName as String
gButtonColor(10) as Color
gButtonColorDark(10) as Color
ButtonData2(96,32) as String
gButtonColorLight(10) as Color
LeftMargin as Integer
TopMargin as Integer
ChangeButtonColor
0
17
9
17
11
Sub ChangeButtonColor()
'蹷躦芳苪苄芢苈芢苠苌苍詄遆
gButtonColor(0)= RGB(100,100,100)
'躑蹙腩郂腪
gButtonColor(1) = RGB(192,192,255)
'閉跂腩草莌莓荗腪
gButtonColor(2) = RGB(255,192,192)
'躑陻腩覩韎腪
gButtonColor(3) = RGB(192,255,192)
'蹤鏼腩邅遆腪
gButtonColor(4) = RGB(192,255,255)
'钄苨迣芰腩覩遆腪
gButtonColor(5) = RGB(255,236,192)
'豯铯腩钖芢荳莓荎腪
gButtonColor(6) = RGB(255,192,255)
'"襣识詏軻襶腩詄遆腪
gButtonColor(7) = RGB(192,192,192)
'襣识詏铯靰腩荳莓荎腪
gButtonColor(8) = RGB(236,174,236)
'"赈迪豯铯腩鑚芢郂腪
gButtonColor(9) = RGB(212,212,212)
End Sub
ChangeButtonColorDark
0
17
9
17
11
Sub ChangeButtonColorDark()
'蹷躦芳苪苄芢苈芢苠苌苍詄遆
gButtonColorDark(0)= RGB(100,100,100)
'躑蹙腩郂腪
gButtonColorDark(1) = RGB(152,152,239)
'閉跂腩草莌莓荗腪
gButtonColorDark(2) = RGB(239,152,152)
'躑陻腩覩韎腪
gButtonColorDark(3) = RGB(152,239,152)
'蹤鏼腩邅遆腪
gButtonColorDark(4) = RGB(152,239,239)
'钄苨迣芰腩覩遆腪
gButtonColorDark(5) = RGB(192,192,152)
'豯铯腩钖芢荳莓荎腪
gButtonColorDark(6) = RGB(239,152,239)
'"襣识詏軻襶腩詄遆腪
gButtonColorDark(7) = RGB(160,160,160)
'襣识詏铯靰腩荳莓荎腪
gButtonColorDark(8) = RGB(192,128,192)
'"赈迪豯铯腩鑚芢郂腪
gButtonColorDark(9) = RGB(174,174,174)
End Sub
RedrawDown
tGraphics as Graphics,CellX as Integer,CellY as Integer
0
17
18
17
26
Sub RedrawDown(tGraphics as Graphics,CellX as Integer,CellY as Integer)
Dim tGraph as Graphics
Dim l as Integer
Dim t as Integer
l = LeftMargin
t = TopMargin
tGraph = tGraphics
tGraph.ForeColor = gButtonColor(ButtonColor(CellX,CellY))
tGraph.FillRect l + CellWidth * (CellX - 1),t + CellHeight * (CellY - 1),CellWidth,CellHeight
tGraph.ForeColor = gButtonColorDark(ButtonColor(CellX,CellY))
tGraph.DrawLine l + CellWidth * (CellX - 1),t + CellHeight * (CellY - 1),l + CellWidth * (CellX - 1),t + CellHeight * CellY-1
tGraph.DrawLine l + CellWidth * (CellX - 1),t + CellHeight * (CellY - 1),l + CellWidth * CellX -1,t + CellHeight * (CellY - 1)
tGraph.TextFont = TextFont
tGraph.TextSize = TextSize
tGraph.ForeColor = RGB(0,0,0)
CenterPrint tGraph,ButtonName(CellX,CellY),l + CellWidth * CellX + 1,t + CellWidth * (CellX - 1) + 1,CellHeight * CellY + 1,CellHeight * (CellY - 1) - 1
//荻荞莓芪覟芳苪芽
ButtonStatus(CellX,CellY) = 1
//覟芳苪芽荻荞莓苌裊鉵苰詯芦苩
PushButtonCol = CellX
PushButtonRow = CellY
End Sub
RedrawUp
tGraphics as Graphics,CellX as Integer,CellY as Integer
0
21
18
21
26
Sub RedrawUp(tGraphics as Graphics,CellX as Integer,CellY as Integer)
Dim tGraph as Graphics
Dim l as Integer
Dim t as Integer
l = LeftMargin
t = TopMargin
tGraph = tGraphics
tGraph.ForeColor = gButtonColor(ButtonColor(CellX,CellY))
tGraph.FillRect l + CellWidth * (CellX - 1),t + CellHeight * (CellY - 1),CellWidth,CellHeight
tGraph.ForeColor = gButtonColorDark(ButtonColor(CellX,CellY))
tGraph.DrawLine l + CellWidth * (CellX - 1),t + CellHeight * CellY - 1,l + CellWidth * CellX - 2,t + CellHeight * CellY - 1
tGraph.DrawLine l + CellWidth * CellX - 1,t + CellHeight * (CellY - 1) - 1,l + CellWidth * CellX - 1,t + CellHeight * CellY - 1
tGraph.ForeColor = gButtonColorLight(ButtonColor(CellX,CellY))
tGraph.DrawLine l + CellWidth * (CellX -1),t + CellHeight * (CellY - 1),l + CellWidth * CellX - 1,t + CellHeight * (CellY - 1)
tGraph.DrawLine l + CellWidth * (CellX -1),t + CellHeight * (CellY - 1),l + CellWidth * (CellX -1),t + CellHeight * CellY - 1
tGraph.TextFont = TextFont
tGraph.TextSize = TextSize
tGraph.ForeColor = RGB(0,0,0)
CenterPrint tGraph,ButtonName(CellX,CellY),l + CellWidth * CellX,t + CellWidth * (CellX - 1),CellHeight * CellY,CellHeight * (CellY - 1) - 2
//荻荞莓苍躝芿迣芪苁苄苠苆苉雟苁芽
ButtonStatus(CellX,CellY) = 0
End Sub
MakeButton
tGraph as Graphics
0
9
17
9
17
Sub MakeButton(tGraph as Graphics)
Dim i as Integer
Dim j as Integer
tGraph.ForeColor = rgb(0, 0, 0)
tGraph.DrawRect 0, 0, tGraph.Width-1, tGraph.Height-1
For i = 1 to ColCount
For j = 1 to RowCount
If ButtonStatus(i,j) = 0 Then
RedrawUp tGraph,i,j
Else
RedrawDown tGraph,i,j
End If
Next
Next
End Sub
ChangeButtonColorLight
0
17
9
17
11
Sub ChangeButtonColorLight()
'蹷躦芳苪苄芢苈芢苠苌苍詄遆
gButtonColorLight(0)= RGB(100,100,100)
'躑蹙腩郂腪
gButtonColorLight(1) = RGB(224,224,255)
'閉跂腩草莌莓荗腪
gButtonColorLight(2) = RGB(255,224,224)
'躑陻腩覩韎腪
gButtonColorLight(3) = RGB(224,255,224)
'蹤鏼腩邅遆腪
gButtonColorLight(4) = RGB(224,255,255)
'钄苨迣芰腩覩遆腪
gButtonColorLight(5) = RGB(255,236,224)
'豯铯腩钖芢荳莓荎腪
gButtonColorLight(6) = RGB(255,224,255)
'"襣识詏軻襶腩詄遆腪
gButtonColorLight(7) = RGB(208,208,208)
'襣识詏铯靰腩荳莓荎腪
gButtonColorLight(8) = RGB(236,192,236)
'"赈迪豯铯腩鑚芢郂腪
gButtonColorLight(9) = RGB(236,236,236)
End Sub
MouseUp
Col as Integer,Row as Integer
MouseDown
Col as Integer,Row as Integer
MouseClick
Col as Integer,Row as Integer
Close
1
0
1
0
Sub Close()
End Sub
Open
1
0
1
0
Sub Open()
ChangeButtonColor()
ChangeButtonColorDark()
ChangeButtonColorLight()
PushButtonCol = -1
PushButtonRow = -1
LeftMargin = 1
TopMargin = 1
End Sub
MouseMove
1
0
1
0
Sub MouseMove(X As Integer, Y As Integer)
End Sub
MouseExit
1
0
1
0
Sub MouseExit()
End Sub
MouseEnter
1
0
1
0
Sub MouseEnter()
End Sub
MouseDrag
1
0
1
0
Sub MouseDrag(X As Integer, Y As Integer)
End Sub
MouseUp
2
0
2
0
Sub MouseUp(X As Integer, Y As Integer)
Dim tGraph as Graphics
//ButtonType芪0苈苧苎MouseUp苰赳芤
If ButtonType = 0 Then
tGraph = Me.Graphics
RedrawUp tGraph,PushButtonCol,PushButtonRow
End If
MouseClick PushButtonCol,PushButtonRow
End Sub
MouseDown
21
29
21
29
Function MouseDown(X As Integer, Y As Integer) As Boolean
Dim tGraph as Graphics
Dim CellX as Integer
Dim CellY as Integer
tGraph = Me.Graphics
CellX = (X / CellWidth) + 1
CellY = (Y / CellHeight) + 1
If ButtonName(CellX,CellY) <> BadName Then
//苠芵腁ButtonType芪0苈苧趡覟芳苪芽荻荞莓苰覚苜芹苩
If ButtonType = 0 Then
RedrawDown tGraph,CellX,CellY
End If
//苠芵腁ButtonType芪1苅裪鍸苅苠荻荞莓芪覟芳苪苄芢苩苈苧
//酏觱覟芳苪芽荻荞莓苰躝芿迣芰苄苠苆苉雟芷
//芻苪裈詏苌躞苉苍荻荞莓苰覚苜芹苩
If ButtonType = 1 And PushButtonCol <> -1 And PushButtonRow <> -1 Then
RedrawUp tGraph,PushButtonCol,PushButtonRow
RedrawDown tGraph,CellX,CellY
ElseIf ButtonType = 1 Then
RedrawDown tGraph,CellX,CellY
End If
//苠芵腁ButtonType芪2苅趡覟芳苪芽荻荞莓芪覚英苅芢苩苈苧
//覚英芾荻荞莓苰躝芿迣芰苄苠苆苉雟芷
//芻苪裈詏苌躞苉苍荻荞莓苰覚苜芹苩
If ButtonType = 2 And ButtonStatus(CellX,CellY) = 1 Then
RedrawUp tGraph,CellX,CellY
ElseIf ButtonType = 2 Then
RedrawDown tGraph,CellX,CellY
End If
Return True
End If
End Function
Paint
1
12
1
12
Sub Paint(g As Graphics)
MakeButton g
End Sub
PrintMenu
34
201
147
135
PrintMenu
1
False
16777215
0
裳跼鏠靥酉釰
True
False
True
False
False
False
0
0
271
276
64
64
32000
32000
PrintMenu
120
Window
0
SlipPrint
tGraph as Graphics,tSetOrgX as Integer,tSetOrgY as Integer,tDaimeiString as String
0
37
6
37
6
Sub SlipPrint(tGraph as Graphics,tSetOrgX as Integer,tSetOrgY as Integer,tDaimeiString as String)
Dim i as Integer
Dim tPrintString as string
Dim tPrintPage as Integer
OpenPrint(tGraph,tSetOrgX,tSetOrgY,"20;20;20;20","37;37","4;9;31;5;11;11;11","鏺镴" + Chr(9) + "览雚" + Chr(9) + "鍅腀腀靶" + Chr(9) + " " + Chr(9) + "軘闻" + Chr(9) + "針闻" + Chr(9) + "蹣趂","L;M;L;L;R;R;R","荱莉荍荭难銩 Pro W3","10")
For i = 1 to 2000
If Trim(Mototyou.MainList.Cell(i,4)) <> "" Then
tPrintString = Trim(Mototyou.MainList.Cell(i,1)) + Chr(9)
tPrintString = tPrintString + SetKamoku(Trim(Mototyou.MainList.Cell(i,2))) + Chr(9)
tPrintString = tPrintString + Trim(Mototyou.MainList.Cell(i,4)) + Chr(9)
tPrintString = tPrintString + Trim(Mototyou.MainList.Cell(i,5)) + Chr(9)
tPrintString = tPrintString + Trim(Mototyou.MainList.Cell(i,6)) + Chr(9)
tPrintString = tPrintString + Trim(Mototyou.MainList.Cell(i,7)) + Chr(9)
tPrintString = tPrintString + Trim(Mototyou.MainList.Cell(i,8))
tPrintPage = AddPrint(tGraph,tPrintString)
If lPageLineNumber(1) = 2 Then
HeardFootPrint(tGraph,tSetOrgX,tSetOrgY,tDaimeiString)
End If
End If
Next
If lPageLineNumber(1) - 1 <> 0 Then
OutPlotP tGraph,lPrintData(6),lPrintData(7) + lPrintData(4) * lPageLineNumber(1),lPrintData(8) ,lPrintData(7) + lPrintData(4) * lPageLineNumber(1)
tPrintString = Chr(9) + Chr(9) + " 腀腀腀腀腀腀鎖腀貎腀趇腀豶" + Chr(9) + Chr(9) + Mototyou.KariTotal.Text + Chr(9) + Mototyou.KasiTotal.Text + Chr(9)
tPrintPage = AddPrint(tGraph,tPrintString)
OutPlotP tGraph,lPrintData(6),lPrintData(7) + lPrintData(4) * lPageLineNumber(1),lPrintData(8) ,lPrintData(7) + lPrintData(4) * lPageLineNumber(1)
tPrintString = Chr(9) + Chr(9) + "腀腀腀腀腀腀腀腀韝腀腀豶" + Chr(9) + Chr(9) + Mototyou.AllKariTotal.Text + Chr(9) + Mototyou.AllKasiTotal.Text + Chr(9)
tPrintPage = AddPrint(tGraph,tPrintString)
ListPrint tGraph,lPageLineNumber(1)
End If
End Sub
HeardFootPrint
tGraph as Graphics,tSetOrgX as Integer,tSetOrgY as Integer,tDaimeiString as String
0
20
0
20
0
Sub HeardFootPrint(tGraph as Graphics,tSetOrgX as Integer,tSetOrgY as Integer,tDaimeiString as String)
tGraph.TextFont = "荱莉荍荭难銩 Pro W3"
tGraph.TextSize = 14
tGraph.bold = false
OutPrintP tGraph,lPrintData(6),lPrintData(7) - 8, LeftB(Mototyou.DateField.Text,10) +"隖費距","L"
tGraph.TextFont = "艣艥韪辑里"
tGraph.TextSize = 12
tGraph.bold = false
OutPrintP tGraph,lSegmentSize(6) + 75,lPrintData(7) - 8, "誔躮觯軐","L"
tGraph.TextSize = 14
OutPrintP tGraph,lSegmentSize(6) + 130,lPrintData(7) - 8, "陀貎赈豼軐","L"
CenterPrintP tGraph,"Norizuki Industrial Arts Co.,Ltd.",0,lPrintData(0),630,640
tGraph.TextFont = "荱莉荍荭难銩 Pro W3"
tGraph.TextSize = 18
tGraph.bold = true
CenterPrintP tGraph,tDaimeiString,0,lPrintData(0),lPrintData(7) - 8,10//費诠苆芩
End Sub
SetKamoku
tKamoku as String
String
0
5
37
5
37
Function SetKamoku(tKamoku as String) As String
Dim tReturnString as String
Select Case LenB(tKamoku)
Case 4
tReturnString = LeftB(tKamoku,2) + " " + RightB(tKamoku,2)
Case 6
tReturnString = LeftB(tKamoku,2) + "腀" + MidB(tKamoku,3,2) + "腀" + RightB(tKamoku,2)
Case 8
tReturnString = LeftB(tKamoku,2) + " " + MidB(tKamoku,3,2) + " " + MidB(tKamoku,5,2) + " " + RightB(tKamoku,2)
Else
tReturnString = tKamoku
End Select
Return tReturnString
End Function
Open
1
0
1
0
Sub Open()
End Sub
108
GroupBox
0
124
RadioButton
0
Action
1
0
1
0
Sub Action()
End Sub
124
RadioButton
0
Action
1
0
1
0
Sub Action()
End Sub
124
RadioButton
0
Action
1
0
1
0
Sub Action()
End Sub
120
PushButton
0
Action
21
70
21
70
Sub Action()
Dim tGraph as Graphics
Dim i as Integer
Dim j as Integer
Dim tPrintSetting as PrinterSetup
tPrintSetting = New PrinterSetup
tPrintSetting.SetupString = gPrintSettings
tGraph = OpenPrinterDialog(tPrintSetting)
If tGraph <> Nil Then
If RadioButton3.Value <> True Then
//酓详閪裳跼
i = 1
j = 1
While Mototyou.MainButton.ButtonName(i,j) <> ""
If Mototyou.MainButton.ButtonName(i,j) <> Mototyou.MainButton.BadName Then
//莁荃莓莊荘荧荎莊荁
Mototyou.MainListClear()
//豊苨襺芵荦腛荞鏇苝趞苝
Mototyou.ReadTransfer(Mototyou.DateField.Text,Mototyou.MainButton.ButtonName(i,j),Mototyou.MainButton.ButtonColor(i,j),Mototyou.PopupMenu1.ListIndex)
//違鍠荦腛荞鏇苝趞苝腩花苁芿苰靌賸苉芷苩苆腁違鍠荦腛荞芩苧貳銠苰跬邬腪
Mototyou.ReadAccount(Mototyou.MainButton.ButtonName(i,j),Mototyou.PopupMenu1.ListIndex)
//鏺镴芯苌荜腛荧
Mototyou.DataSort(Mototyou.MainButton.ButtonColor(i,j))
If RadioButton2.Value = True Or (RadioButton1.Value = True And Mototyou.MainList.Cell(2,3) <> "") Then
SlipPrint(tGraph,0,0,Mototyou.MainButton.ButtonName(i,j))
tGraph.NeXTPage
End If
End If
j = j + 1
If j = Mototyou.MainButton.RowCount + 1Then
i = i + 1
j = 1
End If
If j = Mototyou.MainButton.RowCount And i = Mototyou.MainButton.ColCount Then
Exit
End If
Wend
Else
SlipPrint(tGraph,0,0,Mototyou.KamokuName.Text)
End If
Else
MsgBox "荶莊莓荞芪詊芯苜芹英苅芵芽"
End If
gScreenX = 0
gScreenY = 0
Close
End Sub
120
PushButton
0
Action
1
5
1
5
Sub Action()
Close
End Sub
GroupBox
GroupBox
GroupBox1
-2147483648
0
True
13
13
245
87
True
False
False
False
False
Osaka
12
False
False
False
裳跼鏠靥
True
0
RadioButton
RadioButton
RadioButton1
-2147483648
0
True
46
34
180
20
True
False
False
False
False
Osaka
12
False
False
False
闏鎮苌芠苩酓苄苌览雚苰裳跼
True
True
1
RadioButton
RadioButton
RadioButton2
-2147483648
0
True
46
52
180
20
True
False
False
False
False
Osaka
12
False
False
False
酓苄苌览雚苰裳跼
False
True
2
RadioButton
RadioButton
RadioButton3
-2147483648
0
True
46
70
180
20
True
False
False
False
False
Osaka
12
False
False
False
費距镜躦銆苌览雚苰裳跼
False
True
3
PushButton
PushButton
PushButton1
-2147483648
0
True
178
242
80
20
True
False
False
False
False
Osaka
12
False
False
False
裳跼...
True
False
True
4
PushButton
PushButton
PushButton2
-2147483648
0
True
13
242
80
20
True
False
False
False
False
Osaka
12
False
False
False
荌莃莓荚莋
False
False
True
5
Window
0
Class
0
Module
0
LabelButton
35
-1000
1
LabelButton
108
Canvas
0
Redraw
g as Graphics
0
12
32
12
32
Sub Redraw(g as Graphics)
dim w as integer
dim h as integer
w = g.width - 1
h = g.height - 1
g.ForeColor = rgb(204, 204, 255)
g.FillRect 0, 0, w, h
g.ForeColor = rgb(153, 153, 204)
g.DrawLine 0, h, 0, 0
g.DrawLine 0, 0, w, 0
g.ForeColor = rgb(255, 255, 255)
'g.DrawLine w, 0, w, h
g.DrawLine w, h, 0, h
h = h - 1
if Enabled = true then
g.ForeColor = rgb(255, 255, 255)
g.DrawLine 1, h - 1, 1, 1
g.DrawLine 1, 1, w, 1
g.ForeColor = rgb(153, 153, 204)
g.DrawLine w, 2, w, h
g.DrawLine w, h, 2, h
end if
g.ForeColor = rgb(0, 0, 0)
g.DrawString BalloonHelp, w / 2 - g.TextHeight / 2 * len(BalloonHelp) / 2, g.TextHeight
End Sub
MouseClick
MouseDrag
1
0
1
0
Sub MouseDrag(X As Integer, Y As Integer)
End Sub
MouseUp
3
0
3
0
Sub MouseUp(X As Integer, Y As Integer)
Redraw Graphics
MouseClick
End Sub
MouseDown
12
0
12
0
Function MouseDown(X As Integer, Y As Integer) As Boolean
dim w as integer
dim h as integer
dim g as Graphics
g = Graphics
w = g.width - 1
h = g.height - 2
g.ForeColor = rgb(204, 204, 255)
'g.ForeColor = rgb(153, 153, 204)
g.FillRect 1, 1, w, h
'w = w - 2
h = h - 1
if Enabled = true then
'g.ForeColor = rgb(104, 104, 204)
'g.DrawLine 0, h, 0, 0
'g.DrawLine 0, 0, w, 0
'g.ForeColor = rgb(204, 204, 255)
'g.DrawLine w, 0, w, h
'g.DrawLine w, h, 0, h
end if
g.ForeColor = rgb(0, 0, 0)
g.DrawString BalloonHelp, w / 2 - g.TextHeight / 2 * len(BalloonHelp) / 2+1, g.TextHeight +1
return true
End Function
Paint
1
8
1
8
Sub Paint(g As Graphics)
Redraw g
End Sub
Calendar
35
-1000
1
Calendar
176
Canvas
0
Year as integer
Month as integer
Day as integer
TitleHeight as integer
SideMargin as integer
DaysLeft as integer
DaysTop as integer
DaysWidth as integer
DaysHeight as integer
PreviousDay as integer
TitleTextSize as integer
TextSize as integer
SelectTextSize as integer
Today as integer
OffScrn as Picture
CurrentMonth as integer
CurrentYear as integer
IsLeapYear
Boolean
0
1
0
5
0
Function IsLeapYear() As Boolean
//荊莌莓荧鑎芪襛鑎苈苧True
return (Year mod 4 = 0) and ((Year mod 100 <> 0) or (Year mod 400 = 0))
//1920/1/1 Thursday
End Function
GetDaysOfMonth
tMonth as Integer
Integer
0
4
21
4
21
Function GetDaysOfMonth(tMonth as Integer) As Integer
//芻苌貎苌鏺邔苰闔芷
dim days as integer
days = val(Y_NthField("31,28,31,30,31,30,31,31,30,31,30,31", ",",tMonth))
//襛鑎苈苧艑貎苉艐见蹚
if (tMonth = 2) and IsLeapYear then
days = days + 1
end if
return days
End Function
GetDayOfWeek
tDay as integer
Integer
0
18
0
18
0
Function GetDayOfWeek(tDay as integer) As Integer
dim i as integer
dim days as integer
//1920/1/1 Thursday
days = 4 + 365 * (Year - 1920) + tDay - 1
for i = 1920 to Year - 1
if (i mod 4 = 0) and ((i mod 100 <> 0) or (i mod 400 = 0)) then
days = days + 1
end if
next
for i = 1 to Month - 1
days = days + GetDaysOfMonth(i)
next
return days mod 7
End Function
DrawDayCell
tDay as integer, tAttr as integer, g as Graphics
0
69
19
69
27
Sub DrawDayCell(tDay as integer, tAttr as integer, g as Graphics)
dim x as integer
dim y as integer
dim l as integer
dim t as integer
dim tw as integer
dim wc as integer//week count
if tDay = 0 then
return
end if
wc = 6
x = (GetDayOfWeek(1) + tDay - 1) mod 7
y = (GetDayOfWeek(1) + tDay - 1) / 7 //integer苅芠苩苌苅雟苨鉬苍躩鎮鍉苉Floor芳苪苩
g.TextFont = "Helvetica"
select case tAttr
case 0
if tDay = Today and Month = CurrentMonth and Year = CurrentYear then
g.Bold = true
end if
g.TextSize = TextSize
//g.ForeColor= rgb(212, 212, 212)
//g.FillRect DaysLeft + DaysWidth / 7 * x, DaysTop + DaysHeight / wc * y,DaysWidth / 7, DaysHeight / wc
g.ForeColor= rgb(255, 255, 255)
g.DrawLine DaysLeft + DaysWidth / 7 * x, DaysTop + DaysHeight / wc * y + DaysHeight / wc - 2, DaysLeft + DaysWidth / 7 * x, DaysTop + DaysHeight / wc * y
g.DrawLine DaysLeft + DaysWidth / 7 * x, DaysTop + DaysHeight / wc * y, DaysLeft + DaysWidth / 7 * x + DaysWidth / 7 - 2, DaysTop + DaysHeight / wc * y
//g.DrawLine DaysLeft + DaysWidth / 7 * x + 1, DaysTop + DaysHeight / wc * y + DaysHeight / wc - 3, DaysLeft + DaysWidth / 7 * x + 1, DaysTop + DaysHeight / wc * y + 1
//g.DrawLine DaysLeft + DaysWidth / 7 * x + 1, DaysTop + DaysHeight / wc * y + 1, DaysLeft + DaysWidth / 7 * x + DaysWidth / 7 - 3, DaysTop + DaysHeight / wc * y + 1
g.ForeColor= rgb(168, 168, 168)
g.DrawLine DaysLeft + DaysWidth / 7 * x + DaysWidth / 7 - 1, DaysTop + DaysHeight / wc * y + 2, DaysLeft + DaysWidth / 7 * x + DaysWidth / 7 - 1, DaysTop + DaysHeight / wc * y + DaysHeight / wc - 1
g.DrawLine DaysLeft + DaysWidth / 7 * x + DaysWidth / 7 - 1, DaysTop + DaysHeight / wc * y + DaysHeight / wc - 1, DaysLeft + DaysWidth / 7 * x + 2, DaysTop + DaysHeight / wc * y + DaysHeight / wc - 1
//g.ForeColor= rgb(128, 128, 128)
//g.DrawLine DaysLeft + DaysWidth / 7 * x + DaysWidth / 7 , DaysTop + DaysHeight / wc * y + 2, DaysLeft + DaysWidth / 7 * x + DaysWidth / 7 , DaysTop + DaysHeight / wc * y + DaysHeight / wc
//g.DrawLine DaysLeft + DaysWidth / 7 * x + DaysWidth / 7 , DaysTop + DaysHeight / wc * y + DaysHeight / wc , DaysLeft + DaysWidth / 7 * x + 2, DaysTop + DaysHeight / wc * y + DaysHeight / wc
select case x
case 0
g.ForeColor = rgb(255, 0, 0)
case 6
g.ForeColor = rgb(0, 0, 255)
else
g.ForeColor = rgb(0, 0, 0)
end select
tw = g.TextHeight / 2 * len(str(tDay)) / 2
g.DrawString str(tDay), DaysLeft + DaysWidth / 7 * x + DaysWidth / 7 / 2 - tw, DaysTop + DaysHeight / wc * y + DaysHeight / wc / 2 + g.TextHeight / 4
case 1
if tDay = Today and Month = CurrentMonth and Year = CurrentYear then
g.Bold = true
end if
g.TextSize = SelectTextSize
g.ForeColor= rgb(212, 212, 255)
g.FillRect DaysLeft + DaysWidth / 7 * x, DaysTop + DaysHeight / wc * y,DaysWidth / 7, DaysHeight / wc
select case x
case 0
g.ForeColor = rgb(255, 0, 0)
case 6
g.ForeColor = rgb(0, 0, 255)
else
g.ForeColor = rgb(0, 0, 0)
end select
tw = g.TextHeight / 2 * len(str(tDay)) / 2
g.DrawString str(tDay), DaysLeft + DaysWidth / 7 * x + DaysWidth / 7 / 2 - tw, DaysTop + DaysHeight / wc * y + DaysHeight / wc / 2 + g.TextHeight / 4
case 2
g.DrawPicture OffScrn, DaysLeft + DaysWidth / 7 * x, DaysTop + DaysHeight / wc * y, DaysWidth / 7, DaysHeight / wc, DaysLeft + DaysWidth / 7 * x, DaysTop + DaysHeight / wc * y, DaysWidth / 7, DaysHeight / wc
case 3
if tDay = Today and Month = CurrentMonth and Year = CurrentYear then
g.Bold = true
end if
g.TextSize = SelectTextSize
g.ForeColor= rgb(212, 212, 255)
g.FillRect DaysLeft + DaysWidth / 7 * x, DaysTop + DaysHeight / wc * y,DaysWidth / 7, DaysHeight / wc
g.ForeColor= rgb(128, 128, 255)
g.DrawLine DaysLeft + DaysWidth / 7 * x, DaysTop + DaysHeight / wc * y + DaysHeight / wc - 2, DaysLeft + DaysWidth / 7 * x, DaysTop + DaysHeight / wc * y
g.DrawLine DaysLeft + DaysWidth / 7 * x, DaysTop + DaysHeight / wc * y, DaysLeft + DaysWidth / 7 * x + DaysWidth / 7 - 2, DaysTop + DaysHeight / wc * y
g.ForeColor= rgb(168, 168, 255)
g.DrawLine DaysLeft + DaysWidth / 7 * x + 1, DaysTop + DaysHeight / wc * y + DaysHeight / wc - 3, DaysLeft + DaysWidth / 7 * x + 1, DaysTop + DaysHeight / wc * y + 1
g.DrawLine DaysLeft + DaysWidth / 7 * x + 1, DaysTop + DaysHeight / wc * y + 1, DaysLeft + DaysWidth / 7 * x + DaysWidth / 7 - 3, DaysTop + DaysHeight / wc * y + 1
g.ForeColor= rgb(255, 255, 255)
g.DrawLine DaysLeft + DaysWidth / 7 * x + DaysWidth / 7 - 2, DaysTop + DaysHeight / wc * y + 2, DaysLeft + DaysWidth / 7 * x + DaysWidth / 7 - 2, DaysTop + DaysHeight / wc * y + DaysHeight / wc - 2
g.DrawLine DaysLeft + DaysWidth / 7 * x + DaysWidth / 7 - 2, DaysTop + DaysHeight / wc * y + DaysHeight / wc - 2, DaysLeft + DaysWidth / 7 * x + 2, DaysTop + DaysHeight / wc * y + DaysHeight / wc - 2
select case x
case 0
g.ForeColor = rgb(255, 0, 0)
case 6
g.ForeColor = rgb(0, 0, 255)
else
g.ForeColor = rgb(0, 0, 0)
end select
tw = g.TextHeight / 2 * len(str(tDay)) / 2
g.DrawString str(tDay), DaysLeft + DaysWidth / 7 * x + DaysWidth / 7 / 2 - tw + 1, DaysTop + DaysHeight / wc * y + DaysHeight / wc / 2 + g.TextHeight / 4 + 1
end select
g.Bold = false
End Sub
IncMonth
0
10
0
10
0
Sub IncMonth()
Month = Month + 1
if Month = 13 then
Month = 1
Year = Year + 1
if Year > 2100 then
Year = 2100
end if
end if
Redraw
End Sub
DecMonth
0
10
0
10
0
Sub DecMonth()
Month = Month - 1
if Month = 0 then
Month = 12
Year = Year - 1
if Year < 1920 then
Year = 1920
end if
end if
Redraw
End Sub
Redraw
0
48
13
48
21
Sub Redraw()
dim w as integer
dim h as integer
dim d as integer
dim i as integer
dim g as Graphics
g = OffScrn.Graphics
w = g.width - 1
h = g.height - 1
//裪铔詏顧腩覚鏊腪苌镠触
g.ForeColor = rgb(128, 128, 128)
g.DrawLine 0, h, 0, 0
g.DrawLine 0, 0, w, 0
g.ForeColor = rgb(255, 255, 255)
g.DrawLIne w, 0, w, h
g.DrawLIne w, h, 0, h
//艑铔雚苌顧腩趕遆腪苌镠触
g.ForeColor = rgb(0, 0, 0)
g.DrawRect 1, 1, w - 2, h - 2
//鏠醤苰钒遆苉鍨苨鋗芷
g.ForeColor = rgb(212, 212, 212)
g.FillRect 2, 2, w- 4, h - 4
//荞荃荧莋苌镠触
g.ForeColor = rgb(192, 192, 192)
//賣鏺莋腛荠莓覻
g.TextFont = "Helvetica"
g.Bold = True
g.TextSize = TitleTextSize
g.drawstring str(year)+"."+str(month), w - g.textheight / 2 * 7, h - 8
//镠触韌裦蹚软
DaysWidth = w - 4 - SideMargin * 2
DaysHeight = h - TitleHeight - 4 - 8
DaysLeft = 2 + SideMargin
DaysTop = TitleHeight + 8
w = DaysWidth
h = DaysHeight
//靪鏺镠触
g.TextFont = "Helvetica"
g.TextSize = TextSize
for i = 0 to 6
select case i
case 0
g.ForeColor = rgb(255, 0, 0)
case 6
g.ForeColor = rgb(0, 0, 255)
else
g.ForeColor = rgb(0, 0, 0)
end select
g.DrawString Y_NthField("SUN MON TUE WED THU FRI SUT", " ", i + 1), w / 7 * i + DaysLeft + w / 7 / 2 - g.TextHeight / 2 * 3 / 2, DaysTop - 16 + g.TextHeight
next
//鏺镠触
for i = 1 to GetDaysOfMonth(Month)
DrawDayCell i, 0, g
next
g = Graphics
g.DrawPicture OffScrn, 0, 0, g.width, g.height, 0, 0, g.width, g.height
End Sub
MouseClick
MouseUp
1
26
1
26
Sub MouseUp(X As Integer, Y As Integer)
DrawDayCell previousDay, 1, Graphics
End Sub
MouseEnter
1
0
1
0
Sub MouseEnter()
End Sub
MouseExit
2
16
2
16
Sub MouseExit()
DrawDayCell previousDay, 2, Graphics
previousDay = 32
End Sub
MouseMove
14
6
14
6
Sub MouseMove(X As Integer, Y As Integer)
dim d as integer
dim g as Graphics
g = Graphics
if X > DaysLeft and X < (DaysLeft + DaysWidth) and Y > DaysTop and Y < (DaysTop + DaysHeight) then
d = (X - DaysLeft) / (DaysWidth / 7) + Floor((Y - DaysTop) / Floor(DaysHeight / 6)) * 7 - GetDayOfWeek(1) +1
if d < 1 or d > GetDaysOfMonth(Month) then
d = 0
end if
if d <> previousDay then
//DrawDayCell previousDay, 2, g
//DrawDayCell d, 1, g
previousDay = d
end if
else
//DrawDayCell previousDay, 2, g
end if
End Sub
MouseDown
12
0
12
0
Function MouseDown(X As Integer, Y As Integer) As Boolean
dim d as integer
if X > DaysLeft and X < (DaysLeft + DaysWidth) and Y > DaysTop and Y < (DaysTop + DaysHeight) then
d = (X - DaysLeft) / (DaysWidth / 7) + Floor((Y - DaysTop) / Floor(DaysHeight / 6)) * 7 - GetDayOfWeek(1) + 1
if d >= 1 and d <= GetDaysOfMonth(Month) then
DrawDayCell d, 3, Graphics
day = d
MouseClick()
end if
end if
return true
End Function
Close
1
0
1
0
Sub Close()
End Sub
Open
20
5
20
13
Sub Open()
dim d as Date
dim g as Graphics
g = Graphics
offScrn = newPicture(g.width, g.height,16)
d = new Date
Year = d.Year
Month = d.Month
Day = d.Day
CurrentYear = d.year
CurrentMonth = d.Month
Today = d.day
SideMargin = 8
TitleHeight = 8
TextSize = 12
SelectTextSize = 12
TitleTextSize = 36
Redraw
End Sub
Paint
2
0
2
0
Sub Paint(g As Graphics)
g.DrawPicture OffScrn, 0, 0, g.width, g.height, 0, 0, g.width, g.height
End Sub
MonthCalendar
35
-1000
1
MonthCalendar
132
Canvas
0
Year as integer
Month as integer
OffScrn as Picture
CurrentMonth as integer
CurrentYear as integer
Calendar(3) as Picture
DrawCalendar
index as integer, tYear as integer, tMonth as integer
0
74
2
74
10
Sub DrawCalendar(index as integer, tYear as integer, tMonth as integer)
dim g as Graphics
dim i as integer
dim x as integer
dim y as integer
dim t as integer
dim h as integer
dim l as integer
dim w as integer
dim r as integer
dim b as integer
g = Calendar(index).Graphics
l = 4
t = 4
h = g.height - 8
w = g.width - 8
g.ForeColor = rgb(192, 192, 192)
g.FillRect 0, 0, g.width, g.height
//靪鏺镠触
g.TextFont = "Osaka腼鎙閝"
g.TextSize = 9
for i = 0 to 6
select case i
case 0
g.ForeColor = rgb(255, 128, 128)
case 6
g.ForeColor = rgb(128, 128, 255)
else
g.ForeColor = rgb(128, 128, 128)
end select
g.DrawString Y_NthField("SUN MON TUE WED THU FRI SUT", " ", i + 1), l + w / 7 * i + w / 7 / 2 - g.TextHeight / 2 * 3 / 2, t + g.TextHeight
next
h = h - 8
t = t + 8
//荊莌莓荟腛镠触
x = (GetDayOfWeek(tYear, tMonth)) mod 7
y = (GetDayOfWeek(tYear, tMonth)) / 7 //integer苅芠苩苌苅雟苨鉬苍躩鎮鍉苉Floor芳苪苩
for i = 1 to GetDaysOfMonth(tYear, tMonth)
select case x
case 0
g.ForeColor = rgb(255, 128, 128)
case 6
g.ForeColor = rgb(128, 128, 255)
else
g.ForeColor = rgb(128, 128, 128)
end select
g.DrawString str(i), l + w / 7 * x + w / 7 / 2 - g.TextHeight / 2 * len(str(i)) / 2, t + h / 6 * y + h / 6 / 2 + g.TextHeight
x = x + 1
if x > 6 then
x = 0
y = y + 1
end if
next
h = h + 8
t = t - 8
//荞荃荧莋苌镠触
g.ForeColor = rgb(0, 0, 0)
g.TextFont = "Helvetica"
g.Bold = True
g.TextSize = 48
g.drawstring str(tMonth), l + w / 2 - g.textheight / 2 * len(str(tMonth)) / 2, t + h / 2 + g.textheight / 2
g.Bold = False
g.TextSize = 24
if tMonth = 1 then
g.DrawString str(tYear) + ".", l, t + g.textheight
end if
End Sub
IsLeapYear
tYear as integer
Boolean
0
1
0
4
0
Function IsLeapYear(tYear as integer) As Boolean
//荊莌莓荧鑎芪襛鑎苈苧True
return (tYear mod 4 = 0) and ((tYear mod 100 <> 0) or (tYear mod 400 = 0))
//1920/1/1 Thursday
End Function
GetDaysOfMonth
tYear as integer, tMonth as integer
Integer
0
4
21
4
21
Function GetDaysOfMonth(tYear as integer, tMonth as integer) As Integer
//芻苌貎苌鏺邔苰闔芷
dim days as integer
days = val(Y_NthField("31,28,31,30,31,30,31,31,30,31,30,31", ",",tMonth))
//襛鑎苈苧艑貎苉艐见蹚
if (tMonth = 2) and IsLeapYear(tYear) then
days = days + 1
end if
return days
End Function
GetDayOfWeek
tYear as integer, tMonth as integer
Integer
0
15
0
15
0
Function GetDayOfWeek(tYear as integer, tMonth as integer) As Integer
dim i as integer
dim days as integer
//1920/1/1 Thursday
days = 4 + 365 * (tYear - 1920)
for i = 1920 to tYear - 1
if (i mod 4 = 0) and ((i mod 100 <> 0) or (i mod 400 = 0)) then
days = days + 1
end if
next
for i = 1 to tMonth - 1
days = days + GetDaysOfMonth(tYear, i)
next
return days mod 7
End Function
DecMonth
0
6
0
46
0
Sub DecMonth()
dim i as integer
dim g as Graphics
dim tCurrentYear as integer
dim tCurrentMonth as integer
// 費距苌貎苰艐苂貸苧芷
CurrentMonth = CurrentMonth - 1
if CurrentMonth = 0 then
CurrentMonth = 12
CurrentYear = CurrentYear - 1
if CurrentYear < 1920 then
CurrentYear = 1920
end if
end if
//遞英銆苆襅醤苌荊莌莓荟腛苰镠芫銼芷
Calendar(2).Graphics.DrawPicture Calendar(1), 0, 0
Calendar(1).Graphics.DrawPicture Calendar(0), 0, 0
//裪铔趶苍芳苧苉艐苂酏苌貎苈苌苅費距苌鑎貎苰釒铰芵苄貎苰貸苧芷
tCurrentYear = CurrentYear
tCurrentMonth = CurrentMonth
CurrentMonth = CurrentMonth - 1
if CurrentMonth = 0 then
CurrentMonth = 12
CurrentYear = CurrentYear - 1
if CurrentYear < 1920 then
CurrentYear = 1920
end if
end if
//裪铔趶苌荊莌莓荟腛苰镠触
DrawCalendar 0, CurrentYear, CurrentMonth
//鑎貎苰貳苉雟芷
CurrentYear = tCurrentYear
CurrentMonth = tCurrentMonth
//荊莌莓荟腛酓里苰镠触
DrawAll()
//荘荎莍腛莋辈鞝
g = Graphics
for i = 1 to g.width / 3 step 2
g.DrawPicture OffScrn, 2, 2, g.width / 3 * 2 + i - 2, g.height - 4, g.width / 3 * 1 - i + 2, 2, g.width / 3 * 2 + i - 2, g.height - 4
next
g.DrawPicture OffScrn, 0, 0, g.width, g.height, 0, 0, g.width, g.height
End Sub
IncMonth
0
49
0
49
0
Sub IncMonth()
dim i as integer
dim g as Graphics
dim tCurrentYear as integer
dim tCurrentMonth as integer
// 費距苌貎苰艐苂醝苢芷
CurrentMonth = CurrentMonth + 1
if CurrentMonth = 13 then
CurrentMonth = 1
CurrentYear = CurrentYear + 1
if CurrentYear > 2100 then
CurrentYear = 2100
end if
end if
//遞英銆苆趶醤苌荊莌莓荟腛苰镠芫銼芷
Calendar(0).Graphics.DrawPicture Calendar(1), 0, 0
Calendar(1).Graphics.DrawPicture Calendar(2), 0, 0
//裪铔襅苍芳苧苉艐苂躟苌貎苈苌苅費距苌鑎貎苰釒铰芵苄貎苰醝苢芷
tCurrentYear = CurrentYear
tCurrentMonth = CurrentMonth
CurrentMonth = CurrentMonth + 1
if CurrentMonth = 13 then
CurrentMonth = 1
CurrentYear = CurrentYear + 1
if CurrentYear > 2100 then
CurrentYear = 2100
end if
end if
//裪铔襅苌荊莌莓荟腛苰镠触
DrawCalendar 2, CurrentYear, CurrentMonth
//鑎貎苰貳苉雟芷
CurrentYear = tCurrentYear
CurrentMonth = tCurrentMonth
//荊莌莓荟腛酓里苰镠触
DrawAll()
g = Graphics
//for i = 1 to g.width / 3 // step g.width / 10
//g.DrawPicture OffScrn, 2, 2, g.width - i - 4, g.height - 4, i + 2, 2, g.width - i - 4, g.height - 4
//next
for i = 1 to g.width / 3 step 2 // step g.width / 10
g.DrawPicture OffScrn, g.width / 3 * 1 - i + 2, 2, g.width / 3 * 2 + i - 4, g.height - 4, 2, 2, g.width / 3 * 2 + i - 4, g.height - 4
next
g.DrawPicture OffScrn, 0, 0, g.width, g.height, 0, 0, g.width, g.height
End Sub
Redraw
0
8
0
8
0
Sub Redraw()
dim g as Graphics
MakeCalendar()
DrawAll()
g = Graphics
g.DrawPicture OffScrn, 0, 0, g.width, g.height, 0, 0, g.width, g.height
End Sub
DrawAll
0
69
0
69
0
Sub DrawAll()
dim w as double
dim h as integer
dim l as integer
dim t as integer
dim r as integer
dim b as integer
dim d as integer
dim i as integer
dim j as double
dim g as Graphics
dim i as integer
dim tMonth as integer
dim tYear as integer
dim g as Graphics
tYear = CurrentYear
tMonth = CurrentMonth
//1莖貎镠触
CurrentMonth = CurrentMonth - 1
if CurrentMonth = 0 then
CurrentMonth = 12
CurrentYear = CurrentYear - 1
if CurrentYear < 1920 then
CurrentYear = 1920
end if
end if
g = OffScrn.Graphics
w = g.width - 1
h = g.height - 1
//裪铔詏顧腩覚鏊腪苌镠触
g.ForeColor = rgb(128, 128, 128)
g.DrawLine 0, h, 0, 0
g.DrawLine 0, 0, w, 0
g.ForeColor = rgb(255, 255, 255)
g.DrawLIne w, 0, w, h
g.DrawLIne w, h, 0, h
//艑铔雚苌顧腩趕遆腪苌镠触
g.ForeColor = rgb(0, 0, 0)
g.DrawRect 1, 1, w - 2, h - 2
//鏠醤苰钒遆苉鍨苨鋗芷
g.ForeColor = rgb(192, 192, 192)
g.FillRect 2, 2, w- 3, h - 3
w = w - 3
h = h - 3
w = Round(w / 3)
for i = 0 to 2
l = w*i+ 2
t = 2
r = l+w-1
b = t+h-1
if CurrentYear = Year and CurrentMonth = Month then
//g.ForeColor = rgb(192, 192, 192)
//g.FillRect l, t, width+1, height+1
g.DrawPicture Calendar(i), l+5, t+5
else
g.ForeColor = rgb(255, 255, 255)
g.DrawLine l+1, t+1, l+1, b-1
g.DrawLine l+1, t+1, r-1, t+1
g.ForeColor = rgb(160, 160, 160)
g.DrawLine r-1, t+1, r-1, b-1
g.DrawLine r-1, b-1, l+1, b-1
g.ForeColor = rgb(128, 128, 128)
g.DrawLine r, t, r, b
g.DrawLine r, b, l, b
g.DrawPicture Calendar(i), l+4, t+4
end if
CurrentMonth = CurrentMonth + 1
if CurrentMonth = 13 then
CurrentMonth = 1
CurrentYear = CurrentYear + 1
if CurrentYear > 2100 then
CurrentYear = 2100
end if
end if
next
CurrentYear = tYear
CurrentMonth = tMonth
//g.DrawPicture Calendar(0), Round(w / 3 * 0) + 2, 0
//g.DrawPicture Calendar(1), Round(w / 3 * 1) + 2, 0
//g.DrawPicture Calendar(2), Round(w / 3 * 2) + 2, 0
End Sub
MakeCalendar
0
34
0
34
0
Sub MakeCalendar()
dim i as integer
dim tMonth as integer
dim tYear as integer
dim g as Graphics
tYear = CurrentYear
tMonth = CurrentMonth
//1莖貎镠触
CurrentMonth = CurrentMonth - 1
if CurrentMonth = 0 then
CurrentMonth = 12
CurrentYear = CurrentYear - 1
if CurrentYear < 1920 then
CurrentYear = 1920
end if
end if
for i = 0 to 2
DrawCalendar i, CurrentYear, CurrentMonth
CurrentMonth = CurrentMonth + 1
if CurrentMonth = 13 then
CurrentMonth = 1
CurrentYear = CurrentYear + 1
if CurrentYear > 2100 then
CurrentYear = 2100
end if
end if
next
CurrentYear = tYear
CurrentMonth = tMonth
End Sub
MouseClick
MouseDrag
1
0
1
0
Sub MouseDrag(X As Integer, Y As Integer)
End Sub
MouseDown
18
0
18
0
Function MouseDown(X As Integer, Y As Integer) As Boolean
dim g as Graphics
dim i as integer
g = Graphics
for i = 1 to 3
if x < g.width / 3 * i then
Year = CurrentYear
Month = CurrentMonth + i - 2
if Month = 0 then
Month = 12
Year = CurrentYear - 1
end if
if Month = 13 then
Month = 1
Year = CurrentYear + 1
end if
DrawAll()
g.DrawPicture OffScrn, 0, 0, g.width, g.height, 0, 0, g.width, g.height
MouseClick()
return true
end if
next
End Function
Open
5
10
5
20
Sub Open()
dim d as date
dim g as Graphics
g = Graphics
offScrn = newPicture(g.width, g.height,16)
Calendar(0) = newPicture((g.width-4)/3-8, g.height-4-8, 16)
Calendar(1) = newPicture((g.width-4)/3-8, g.height-4-8, 16)
Calendar(2) = newPicture((g.width-4)/3-8, g.height-4-8, 16)
d = new date
Year = d.Year
Month = d.Month
CurrentYear = Year
CurrentMonth = Month
End Sub
Paint
1
6
1
6
Sub Paint(g As Graphics)
Redraw
End Sub
Graphics
0
Function
36
-1000
0
Function
100
0
gScreenX as Integer
gScreenY as Integer
Vre133 as String
gDecimal as Integer
lHeadFootLine(3) as Integer
lMaxPage(1) as Integer
lPageLineNumber(1) as Integer
lSegmentNumber as Integer
lSegmentString(50) as String
lSegmentPosition(50) as String
lSegmentSize(50) as Integer
lSegmentSizeBuffer(50) as Integer
lGraphHeight as Integer
lPrintData(50) as Integer
lCellSegment as String
lPrintFont(1) as String
gBasicPath as String
gVersionString as String
gPrintSettings as String
gsPrintV
tGraph as Graphics,tObjL as Integer,tObjT as Integer,tObjR as Integer,tObjB as Integer,tFormat as String
0
18
4
18
4
Sub gsPrintV(tGraph as Graphics,tObjL as Integer,tObjT as Integer,tObjR as Integer,tObjB as Integer,tFormat as String)
Dim i as Integer
Dim tLeftPoint as Integer
Dim tString as String
OutPlotP tGraph,tObjL,tObjT,tObjR,tObjT
OutPlotP tGraph,tObjL,tObjB,tObjR,tObjB
OutPlotP tGraph,tObjL,tObjT,tObjL,tObjB
tLeftPoint = tObjL
For i = 1 To 255
tString = Y_NthField(tFormat,";",i)
If tString = "" Then
i = 255
Else
tLeftPoint = tLeftPoint + Val(tString)
OutPlotP tGraph,tLeftPoint,tObjT,tLeftPoint,tObjB
End If
Next
End Sub
SetOrg
tX as Integer,tY as Integer
0
1
0
1
8
Sub SetOrg(tX as Integer,tY as Integer)
gScreenX = tX
gScreenY = tY
End Sub
OutPlot
tGraph as Graphics,tObjL as Integer,tObjT as Integer,tObjR as Integer,tObjB as Integer
0
1
66
1
66
Sub OutPlot(tGraph as Graphics,tObjL as Integer,tObjT as Integer,tObjR as Integer,tObjB as Integer)
tGraph.DrawLine tObjL + gScreenX,tObjT + gScreenY,tObjR + gScreenX,tObjB + gScreenY
End Sub
OutPrint
tGraph as Graphics,tX as Integer,tY as Integer,tString as String
0
1
39
1
39
Sub OutPrint(tGraph as Graphics,tX as Integer,tY as Integer,tString as String)
tGraph.DrawString tString,tX + gScreenX,tY + gScreenY
End Sub
ZeroSup
tNumerical as Double,tKeta as Integer
String
0
3
54
3
59
Function ZeroSup(tNumerical as Double,tKeta as Integer) As String
Dim tString as String
tString = "0000000000000000000000" + Str(tNumerical)//Right(Str(tNumerical),Len(Str(tNumerical)) - 1)
tString = RightB(tString,tKeta)
Return tString
End Function
CenterPrint
tGraph as Graphics,tString as String,tLeft as Integer,tRight as Integer,tTop as Integer,tBtm as Integer
0
1
0
13
64
Sub CenterPrint(tGraph as Graphics,tString as String,tLeft as Integer,tRight as Integer,tTop as Integer,tBtm as Integer)
Dim tPrintSizeLR as Integer
Dim tPrintSizeTB as Integer
Dim tStringSize as Integer
Dim tGomi as String
tStringSize = tGraph.StringWidth(tString)
tPrintSizeLR = ((tRight - tLeft) - tStringSize) / 2
tGomi = LeftB(tString,2)
tStringSize = tGraph.StringWidth(tGomi)
tPrintSizeTB = ((tBtm - tTop) - tStringSize) / 2
OutPrint tGraph,tLeft + tPrintSizeLR,tBtm - tPrintSizeTB,tString
End Sub
EvenlyPrint
tGraph as Graphics,tX as Integer,tY as Integer,tString as String
0
6
40
6
40
Sub EvenlyPrint(tGraph as Graphics,tX as Integer,tY as Integer,tString as String)
Dim tFontSize as Integer
Dim tXzahyou as Integer
tFontSize = tGraph.StringWidth(tString)
tXzahyou = tX - tFontSize
OutPrintP tGraph,tXzahyou,tY,tString,"L"
End Sub
SpaceSup
tNumerical as String,tKeta as Integer
String
0
3
60
3
61
Function SpaceSup(tNumerical as String,tKeta as Integer) As String
Dim tString as String
tString = " " + tNumerical
tString = RightB(tString,tKeta)
Return tString
End Function
GetMiddleDate
tDate as String
String
0
9
4
9
4
Function GetMiddleDate(tDate as String) As String
//論邔郠难腆4貅邼韯苰闔芷腀裸芫邔芪60裈迣苈苧19**腂裈覺苈苧20**苰闔芷
//裸芫邔腀腆2貅苌閶躚韱腩邔鉬苌苝腪
//闔苨鉬腀腆4貅苌閶躚韱腩4貅邼韯腪
Dim tString as String
If Val(LeftB(tDate,2)) >= 60 Then
tString = "19" + tDate
Else
tString = "20" + tDate
End If
Return tString
End Function
RemoveString
tString as String,tRemoveString as String
String
0
12
42
12
42
Function RemoveString(tString as String,tRemoveString as String) As String
//論邔郠难腆閶躚韱芩苧腁蹷鋨芳苪芽閶躚裈詏苰軦苨软芷
//裸芫邔腀腆閶躚韱腁閶躚韱芩苧軦苨辜芫芽芢閶躚
//闔苨鉬腀腆軦苨辜芩苪芽閶躚韱
//跬邬鏺腀腆1998/--/--(---)
//轃邳鏺腀腆1998/09/23(Wed)腀花苌荒莁莓荧苰镴芯芽
//铵赬腀腀腆
Dim i as Integer
Dim tReturnString as String
tReturnString = ""
For i = 1 to LenB(tString)
tReturnString = tReturnString + Y_NthField(tString,tRemoveString,i)
Next
Return tReturnString
End Function
ChangeSequence
tString as String
Double
0
10
0
10
0
Function ChangeSequence(tString as String) As Double
//論邔郠难腆荊莓荽苌趬芶苁芽邔躚閶躚韱苰Double苉芵苄闔芷
//裸芫邔腀腆String
//闔苨鉬腀腆Double
//跬邬鏺腀腆1998/07/03(Fri)
//铵赬腀腀腆
Dim tReturnDouble as Double
tReturnDouble = Val(RemoveString(tString,","))
Return tReturnDouble
End Function
ChangeDateInteger
tDateString as String
Integer
0
6
103
6
103
Function ChangeDateInteger(tDateString as String) As Integer
//鏺镴芯苰軳芯軦苁苄8貅邮邔苉芵苄闔芷
//鏺镴芯苌閶躚韱苍"."苅苠"/"苅苠覽苅苠蹧靰观
Dim tString as String
Dim tInteger as Integer
tString = LeftB(tDateString,4) + ZeroSup(Val(Y_NthField(tDateString,"/",2)),2) + ZeroSup(Val(Y_NthField(tDateString,"/",3)),2)
tInteger = Val(tString)
Return tInteger
End Function
ChangeDateYMD
tDateString as String
String
0
8
140
8
140
Function ChangeDateYMD(tDateString as String) As String
//論邔郠难腆ShortDate苰軳芯苄YY/MM/DD苅闔芷
//裸芫邔腀腆ShortDate
//闔苨鉬腀腆YY/MM/DD
//跬邬鏺腀腆1998/07/03(Fri)
//铵赬腀腀腆
Dim tString as String
tString = ZeroSup(Val(Y_NthField(tDateString,".",1)),2) + "/" + ZeroSup(Val(Y_NthField(tDateString,".",2)),2) + "/" + ZeroSup(Val(Y_NthField(tDateString,".",3)),2)
Return tString
End Function
ChangeDateString
tDateString as String
String
0
6
103
6
103
Function ChangeDateString(tDateString as String) As String
//鏺镴芯苰軳芯軦苁苄8貅閶躚韱苉芵苄闔芷
//鏺镴芯苌閶躚韱苍"."苅苠"/"苅苠覽苅苠蹧靰观
//芵芩芵腁郦鎪鑎邔苍2貅苌花苆
Dim tString as String
tString = LeftB(tDateString,4) + ZeroSup(Val(Y_NthField(tDateString,"/",2)),2) + ZeroSup(Val(Y_NthField(tDateString,"/",3)),2)
Return tString
End Function
IncMonth
tDate as String
String
0
14
21
14
21
Function IncMonth(tDate as String) As String
//論邔郠难腆YY/MM/DD苰軳芯苄裪貎適苟苩
//裸芫邔腀腆YY/MM/DD
//闔苨鉬腀腆YY/MM/DD
//跬邬鏺腀腆1998/07/27(Mon)
//轃邳鏺腀腆1998/08/10(Mon)
//腀腀腀腀腀1998/09/14(Mon)腀4貅邼韯苈苧4貅苅腁2貅邼韯苈苧2貅苅闔芷苦芤苉闏赘
//铵赬腀腀腆
Dim tYear as Integer
Dim tMonth as Integer
Dim tDay as Integer
tYear = Val(Y_NthField(tDate,"/",1))
tMonth = Val(Y_NthField(tDate,"/",2))
tDay = Val(Y_NthField(tDate,"/",3))
If tMonth = 12 Then
tYear = tYear + 1
tMonth = 1
Else
tMonth = tMonth + 1
End If
If tMonth = 2 Then
If (Val(GetMiddleDate(Str(tYear))) Mod 4) = 0 Then
If tDay >= 30 Then
tDay = 29
End If
Else
If tDay >= 29 Then
tDay = 28
End If
End If
ElseIf tMonth = 4 Or tMonth = 6 Or tMonth = 9 Or tMonth = 11 Then
If tDay >= 31 Then
tDay = 30
End If
End If
Return Str(tYear) + "/" + ZeroSup(tMonth,2) + "/" + ZeroSup(tDay,2)
End Function
DecMonth
tDate as String
String
0
14
21
14
21
Function DecMonth(tDate as String) As String
//論邔郠难腆YY/MM/DD苰軳芯苄裪貎雟芷
//裸芫邔腀腆YY/MM/DD
//闔苨鉬腀腆YY/MM/DD
//跬邬鏺腀腆1998/07/27(Mon)
//轃邳鏺腀腆1998/08/10(Mon)
//腀腀腀腀腀1998/09/14(Mon)腀4貅邼韯苈苧4貅苅腁2貅邼韯苈苧2貅苅闔芷苦芤苉闏赘
//铵赬腀腀腆
Dim tYear as Integer
Dim tMonth as Integer
Dim tDay as Integer
tYear = Val(Y_NthField(tDate,"/",1))
tMonth = Val(Y_NthField(tDate,"/",2))
tDay = Val(Y_NthField(tDate,"/",3))
If tMonth= 1 Then
tYear = tYear - 1
tMonth = 12
Else
tMonth = tMonth - 1
End If
If tMonth = 2 Then
If (Val(GetMiddleDate(Str(tYear))) Mod 4) = 0 Then
If tDay >= 30 Then
tDay = 29
End If
Else
If tDay >= 29 Then
tDay = 28
End If
End If
ElseIf tMonth = 4 Or tMonth = 6 Or tMonth = 9 Or tMonth = 11 Then
If tDay >= 31 Then
tDay = 30
End If
End If
Return Str(tYear) + "/" + ZeroSup(tMonth,2) + "/" + ZeroSup(tDay,2)
End Function
MakeFolder
tFolderName as String
FolderItem
0
11
18
11
18
Function MakeFolder(tFolderName as String) As FolderItem
//論邔郠难腆軳芯芽隼酏苌荴荈莋荟苰跬邬芷苩
//裸芫邔腀腆荴荈莋荟隼腩荰荘芢苨苅腪
//闔苨鉬腀腆FolderItem
//跬邬鏺腀腆1998/07/17(Fri)
//铵赬腀腀腆
Dim tFolderItem as FolderItem
tFolderItem = GetFolderItem(tFolderName)
tFolderItem.CreateAsFolder
Return tFolderItem
End Function
SpaceSupB
tNumerical as String,tKeta as Integer
String
0
6
13
6
13
Function SpaceSupB(tNumerical as String,tKeta as Integer) As String
Dim tString as String
tString = tNumerical + " "
tString = LeftB(tString,tKeta)
Return tString
End Function
DeBugLog
tPath as String,tWriteString as String
0
42
45
42
45
Sub DeBugLog(tPath as String,tWriteString as String)
//論邔郠难腆荦药荢荏莍荏苌软韍
//裸芫邔腀腆软韍芷苩荴荀荃莋苌荰荘腁辑芫软芷鏠靥
//闔苨鉬腀腆苈芵
//跬邬鏺腀腆1999/08/05(Thu)
//轃邳鏺腀腆1999/08/19(Thu)腀软韍荴荀荃莋苰荥荌荘荧芩苧药荃荩莊苖闏赘腅跅釥赳邔苌鋇见
//腀腀腀腀腆2000/10/18(Wed)腀跬邬芷苩荴荀荃莋荞荃荶苰text/plain腵text/plain腶苉闏赘
//铵赬腀腀腆软韍苅芫苩閶躚邔苍雱80药荃荧腁跅釥999赳苜苅
Dim tFolderItem as FolderItem
Dim tBinaryStream as BinaryStream
Dim tLine as Integer
Dim tString as String
Dim tDate as Date
tDate = New Date
tFolderItem = GetFolderItem(tPath)
If tFolderItem <> Nil Then
tBinaryStream = tFolderItem.OpenAsBinaryFile(True)
End If
If tBinaryStream = Nil Then
tBinaryStream = tFolderItem.CreateBinaryFile("text/plain")
End If
tLine = 0
If tBinaryStream <> Nil Then
tLine = Val(tBinaryStream.Read(150))
If tLine = 99999 Then
tLine = 0
End If
tLine = tLine + 1
#If TargetMacOS Then
tBinaryStream.Position = 0
tBinaryStream.Write SpaceSupB(ZeroSup(tLine,5),150) + CHR(13)
tString = ZeroSup(tLine,5) + " " + tDate.ShortDate + " " + tDate.LongTime + " " + tWriteString
tBinaryStream.Position = tLine * 151
tBinaryStream.Write SpaceSupB(tString,150) + CHR(13)
#Else
tBinaryStream.Position = 0
tBinaryStream.Write SpaceSupB(ZeroSup(tLine,5),150) + CHR(13) + CHR(10)
tString = ZeroSup(tLine,5) + " " + tDate.ShortDate + " " + tDate.LongTime + " " + tWriteString
tBinaryStream.Position = tLine * 152
tBinaryStream.Write SpaceSupB(tString,150) + CHR(13) + CHR(10)
#Endif
tBinaryStream.Close
tFolderItem.MacType = "TEXT"
tFolderItem.MacCreator = "ttxt"
End If
End Sub
DecimalPointDouble
tDouble as Double
Double
0
12
21
12
21
Function DecimalPointDouble(tDouble as Double) As Double
Dim tDecimalDouble as Double
Select Case gDecimal
Case 1
tDecimalDouble = FloorBug(tDouble)
Case 2
tDecimalDouble = Ceil(tDouble)
Case 3
tDecimalDouble =Round(tDouble)
End Select
Return tDecimalDouble
End Function
CheakPopupCout
tPopupName as PopupMenu
Boolean
0
18
15
18
15
Function CheakPopupCout(tPopupName as PopupMenu) As Boolean
//論邔郠难腆荼荢荶荁荢荶苉閶躚韱苍芠苩芩腈苈芢芩腈
//裸芫邔腀腆PopupMenu
//闔苨鉬腀腆芠苩膄膄True腀腀苈芢膄膄False
//跬邬鏺腀腆1998/09/04(Fri)
//铵赬腀腀腆
Dim tString as String
Dim tBoolean as Boolean
tPopupName.ListIndex = 0
tString = tPopupName.Text
If tString <> "" Then
tBoolean = True
Else
tBoolean = False
End If
Return tBoolean
End Function
OpenPrint
tGraph as Graphics,tScreenX as Integer,tScreenY as Integer,tHeadFoot as String,tMaxPage as String,tSegmentNumber as String,tSegmentString as String,tSegmentPosition as String,tFontName as String,tFontSize as String
0
66
7
66
15
Sub OpenPrint(tGraph as Graphics,tScreenX as Integer,tScreenY as Integer,tHeadFoot as String,tMaxPage as String,tSegmentNumber as String,tSegmentString as String,tSegmentPosition as String,tFontName as String,tFontSize as String)
//論邔郠难腆镜裳跼苉镋靶苈荦腛荞苰见赈芷苩
//裸芫邔腀腆Graphics腁tScreenX腁tScreenX腁荷荢荞膕荴荢荞裊鉵腁裪闅雚膕芻苪裈赾荹腛荗苌跅釥赳邔
//腀腀腀腀腀荚莋苌荔荃荙腁镜釨腁镜躦裊鉵腁荴荈莓荧腁荴荈莓荧荔荃荙腩镜釨苰辜芫酓苄详郘苨閶躚苍腷^腩钼詰腪腸苰蹧靰苌躖腪
//闔苨鉬腀腆苈芵
//跬邬鏺腀腆1998/09/06(Sun)
//轃邳鏺腀腆1998/10/01(Thu)腀荴荈莓荧苆荔荃荙苰蹷鋨苅芫苩靬苉闏赘
//轃邳鏺腀腆1998/11/19(Thu)腀镜苌襅鉛跀镗苰lPrintData(8)苉鋇见
//轃邳鏺腀腆1999/05/17(Mon)腀荴荈莓荧荔荃荙苌铷銲邮腩醽閪OS8.6苌鏠閔闏赘苌裗腪
//铵赬腀腀腆OpenPritn苆ListPrint苌3荚荢荧苅蹧靰芷苩
Dim i as Integer
Dim tTextHeight as Integer
Dim tTextWidth as Integer
Dim tCellSegment as String
Dim tCellLength as Integer
Dim tCellHeight as Integer
Dim tCellWidth as Integer
Dim tListLeft as Integer
Dim tListTop as Integer
Dim tPrintString(50) as String
Dim tCenterPrintInteger as Integer
Dim i as Integer
Dim j as Integer
dim tstring as string
gScreenX = tScreenX
gScreenY = tScreenY
//裪闅雚苌荷荢荟趂
lHeadFootLine(0) = Val(Y_NthField(tHeadFoot,";",1))
//裪闅雚苌荴荢荞趂
lHeadFootLine(1) = Val(Y_NthField(tHeadFoot,";",2))
//裈赾闅苌荷荢荞趂
lHeadFootLine(2) = Val(Y_NthField(tHeadFoot,";",3))
//裈赾闅苌荴荢荞趂
lHeadFootLine(3) = Val(Y_NthField(tHeadFoot,";",4))
//裪闅苟苌跅釥赳邔
lMaxPage(0) = Val(Y_NthField(tMaxPage,";",1))
//裈赾闅苌跅釥赳邔
lMaxPage(1) = Val(Y_NthField(tMaxPage,";",2))
//荹腛荗铔趆
lPageLineNumber(0) = 1
//芻苌荹腛荗鏠苅裳跼芵芽赳邔
lPageLineNumber(1) = 1
//詥荚莋苌荔荃荙苆腁苝芾芵
i = 0
While Y_NthField(tSegmentNumber,";",i + 1) <> ""
lSegmentSizeBuffer(i) = Val(Y_NthField(tSegmentNumber,";",i + 1))
lSegmentString(i) = Y_NthField(tSegmentString,Chr(9),i + 1)
lSegmentPosition(i) = Y_NthField(tSegmentPosition,";",i + 1)
i = i + 1
Wend
lSegmentNumber = i
lPrintFont(0) = tFontName
lPrintFont(1) = tFontSize
tGraph.TextFont = lPrintFont(0)
tGraph.TextSize = Val(lPrintFont(1))
//閝苌邔鉬苍酓苄荳荎荚莋
//裳跼观鑜覡閝
lPrintData(0) = tGraph.Width
//裳跼观鑜轣閝
lPrintData(1) = tGraph.Height
//費距苌荴荈莓荧苅苌裪閶躚腩钼詰腪苌覡閝
lPrintData(2) = tGraph.StringWidth("膡") / 2 + 1
//費距苌荴荈莓荧苅苌裪閶躚腩钼詰腪苌轣閝
lPrintData(3) = tGraph.StringWidth("膡")
//費距苌荴荈莓荧苅苌裪赳裳跼苌轣閝
lPrintData(4) = tGraph.TextHeight
lCellSegment = ""
tCellWidth = 0
For i = 0 to 49
If lSegmentSizeBuffer(i) > 0 Then
//镜跬邬躞苌详郘苨苰跬苩
lCellSegment = lCellSegment + Str((lSegmentSizeBuffer(i) + 2) * lPrintData(2)) + ";"
//镜苌轣苰鎾苩
tCellWidth = tCellWidth + (lSegmentSizeBuffer(i) + 2) * lPrintData(2)
//跄苑詥荚莋苌荔荃荙苰鎾苩
lSegmentSize(i + 1) = tCellWidth
Else
//镜跬邬躞苌详郘苨苌跅賣苌裪閶躚腩跅賣苉腨腇腨芪镴芢苄芵苜芤芽苟苉腪苰苍芸芷
lCellSegment = LeftB(lCellSegment,LenB(lCellSegment) - 1)
Exit
End If
Next
//镜苌轣閝苰鎾苩
lPrintData(5) = lPrintData(4) * lMaxPage(0)
//詥郝鋨迣芩苧豶蹚芵芽镜苌趶鉛跀镗
lPrintData(6) = (lPrintData(0) - tCellWidth) / 2
//荚莋荔荃荙苉镜苌趶鉛苌跀镗苰醫芵趞苞
lSegmentSize(0) = tListLeft
For j = 1 to 49
lSegmentSize(j) = lSegmentSize(j) + tListLeft
Next
//詥郝鋨迣芩苧豶蹚芵芽镜苌迣閔跀镗
lPrintData(7) = lHeadFootLine(0) + 20
//詥芭郝鋨迣芩苧豶蹚芵芽镜苌襅鉛跀镗
lPrintData(8) = lPrintData(0) - (lPrintData(0) - lSegmentSize(lSegmentNumber)) / 2
End Sub
AddPrint
tGraph as Graphics,tString as String
Integer
0
53
19
53
19
Function AddPrint(tGraph as Graphics,tString as String) As Integer
//論邔郠难腆裪赳裳跼芷苩
//裸芫邔腀腆Graphics,裳跼閶躚韱
//闔苨鉬腀腆裳跼芵芽赳
//跬邬鏺腀腆1998/09/06(Sun)
//轃邳鏺腀腆1998/10/01(Thu)腀荴荈莓荧苆荔荃荙苰蹷鋨苅芫苩靬苉闏赘
//腀腀腀腀腆1998/10/06(Tue)腀裳跼裊鉵苌镳误趇苰觰迁
//腀腀腀腀腆1998/10/28(Wed) 銆道裳跼苌镳误趇轃邳
//铵赬腀腀腆OpenPritn苆ListPrint苌3荚荢荧苅蹧靰芷苩
Dim tPrintString(50) as String
Dim tPrintInteger as Integer
Dim i as Integer
tGraph.TextFont = lPrintFont(0)
tGraph.TextSize = Val(lPrintFont(1))-1
//裳跼荹腛荗芪艐闅雚芩芻苪裈詏芩苅裳跼赳邔苰闏赘
If lPageLineNumber(0) = 1 Then
tPrintInteger = 0
Else
tPrintInteger = 1
End If
//荹腛荗苌跅釥赳邔苉苈苁芽苧镜苰辑芫荹腛荗苰醗苩
If lMaxPage(tPrintInteger) = lPageLineNumber(1) Then
//镜苌镠触
ListPrint tGraph,lPageLineNumber(1)
//荹腛荗苰醗苩
tGraph.NextPage
//荹腛荗荊荅莓荞苰裪苂醝苢芵腁裳跼赳荊荅莓荞苰莊荚荢荧
lPageLineNumber(0) = lPageLineNumber(0) + 1
lPageLineNumber(1) = 1
//镜苌轣閝苰鎾苩
lPrintData(5) = lPrintData(4) * lMaxPage(1)
//詥郝鋨迣芩苧豶蹚芵芽镜苌迣閔跀镗
lPrintData(7) = lHeadFootLine(2) + 20
End If
For i = 0 to 49
//裳跼鏠靥苰鑺韱苖詩鑛
tPrintString(i) = Y_NthField(tString,Chr(9),i + 1)
Next
//荹腛荗苌荊荅莓荞苰裪苂醝苢芷
lPageLineNumber(1) = lPageLineNumber(1) + 1
//裸芫軳芯芽閶躚韱苰裳跼
tGraph.TextFont = "荱莉荍荭难銩 Pro W3"
tGraph.TextSize = 10
tGraph.bold = false
For i = 0 to 50
Select Case lSegmentPosition(i)
Case "L"
OutPrintP tGraph , lPrintData(6) + lSegmentSize(i) + 4 , lPrintData(7) + (lPrintData(4) * lPageLineNumber(1)) - 2,tPrintString(i),"L"
Case "M"
OutPrintP tGraph , lPrintData(6) + lSegmentSize(i) + 3 , lPrintData(7) + (lPrintData(4) * lPageLineNumber(1)) - 2,tPrintString(i),"M"
Case "R"
OutPrintP tGraph , lPrintData(6) + lSegmentSize(i) , lPrintData(7) + (lPrintData(4) * lPageLineNumber(1)) - 2,tPrintString(i),"R"
Case ""
Exit
End Select
Next
//趡觱辑芢芽闅苰闔芷
Return lPageLineNumber(0)
End Function
ListPrint
tGraph as Graphics,tLastPrint as Integer
0
11
7
11
15
Sub ListPrint(tGraph as Graphics,tLastPrint as Integer)
//論邔郠难腆镜苆镜釨苰跬邬芷苩
//裸芫邔腀腆Graphics,裳跼芵芽赳邔腩镜苌铍裍苉蹧靰腪
//闔苨鉬腀腆苈芵
//跬邬鏺腀腆1998/09/06(Sun)
//轃邳鏺腀腆1998/10/01(Thu)腀跀镗裊鉵苰-1芵芽
//腀腀腀腀腆1998/10/06(Tue)腀裳跼裊鉵苌镳误趇苰觰迁
//铵赬腀腀腆OpenPritn苆ListPrint苌3荚荢荧苅蹧靰芷苩
Dim i as Integer
tGraph.TextFont = lPrintFont(0)
tGraph.TextSize = Val(lPrintFont(1))
//镜苰跬苩
gsPrintV tGraph , lPrintData(6) , lPrintData(7) , lPrintData(0) - lPrintData(6) - 1, lPrintData(7) + lPrintData(4) , lCellSegment
gsPrintV tGraph , lPrintData(6) , lPrintData(7) + lPrintData(4) , lPrintData(0) - lPrintData(6) - 1 ,lPrintData(7) + tLastPrint * lPrintData(4) , lCellSegment
//镜釨苰跬苩
For i = 0 to 50
If lSegmentString(i) <> "" Then
CenterPrintP tGraph , lSegmentString(i) , lPrintData(6) + lSegmentSize(i) , lPrintData(6) + lSegmentSize(i + 1) + 4, lPrintData(7) , lPrintData(7) + lPrintData(4) - 2
Else
Exit
End If
Next
//裳跼赳邔荊荅莓荞苰裪苂醝苢芷
lPageLineNumber(1) = lPageLineNumber(1) + 1
End Sub
SpaceMid
tString as String,tMozi as Integer
String
0
10
19
10
19
Function SpaceMid(tString as String,tMozi as Integer) As String
Dim tSpace as Integer
Dim tSpaceString as String
tSpace = Floor((tMozi -Len(tString)) / 2)
tSpaceString = SpaceSupB(tString,tSpace + Len(tString))
tSpaceString = SpaceSup(tSpaceString,tMozi)
Return tSPaceString
End Function
ClearPrintSet
0
37
6
37
10
Sub ClearPrintSet()
//論邔郠难腆裳跼莋腛荠莓苅蹧靰芵芽闏邔苰荎莊荁芷苩
//裸芫邔腀腆苈芵
//闔苨鉬腀腆苈芵
//跬邬鏺腀腆1998/11/19(Thu)
//铵赬腀腀腆OpenPritn苆ListPrint苆AddPrint苌4荚荢荧苅蹧靰芷苩
Dim i as Integer
gScreenX = 0
gScreenY = 0
For i = 0 to 3
lHeadFootLine(i) = 0
Next
lMaxPage(0) = 0
lMaxPage(1) = 0
lPageLineNumber(0) = 0
lPageLineNumber(1) = 0
For i = 1 to 50
lSegmentSize(i) = 0
lSegmentString(i) = ""
lSegmentPosition(i) = ""
lSegmentSizeBuffer(i) = 0
Next
lSegmentNumber = 0
lCellSegment = ""
For i = 0 to 8
lPrintData(i) = 0
Next
lPrintFont(0) = ""
lPrintFont(1) = ""
End Sub
GetDayOfWeek
tYear as Integer,tMonth as Integer,tDay as Integer
Integer
0
25
70
25
70
Function GetDayOfWeek(tYear as Integer,tMonth as Integer,tDay as Integer) As Integer
//論邔郠难腆蹷鋨芳苪芽鏺镴芪覽靪鏺芩讁苟苩
//裸芫邔腀腆鑎腁貎腁鏺
//闔苨鉬腀腆1腆貎靪鏺腀2腆觎靪鏺腀3腆邅靪鏺腀4腆雘靪鏺腀5腆诠靪鏺腀6腆鍹靪鏺腀0腆鏺靪鏺
//跬邬鏺腀腆1998/12/21(Mon)
//铵赬腀腀腆
Dim i as Integer
Dim tBufferDay as Integer
tBufferDay = tDay
//1920/1/1 Thursday
tBufferDay = 4 + 365 * (tYear - 1920) + tBufferDay - 1
For i = 1920 to tYear - 1
If (i Mod 4 = 0) And ((i Mod 100 <> 0) Or (i Mod 400 = 0)) Then
tBufferDay = tBufferDay + 1
End If
Next
For i = 1 to tMonth - 1
tBufferDay = tBufferDay + GetDaysOfMonth(tYear,i)
Next
Return tBufferDay Mod 7
// 1腆貎靪鏺腀2腆觎靪鏺腀3腆邅靪鏺腀4腆雘靪鏺腀5腆诠靪鏺腀6腆鍹靪鏺腀0腆鏺靪鏺
End Function
GetDaysOfMonth
tYear as Integer,tMonth as Integer
Integer
0
9
22
9
22
Function GetDaysOfMonth(tYear as Integer,tMonth as Integer) As Integer
//論邔郠难腆蹷鋨芳苪芽貎芪覽鏺芠苩芩讁苟苩
//裸芫邔腀腆鑎腁貎
//闔苨鉬腀腆芻苌貎苌鏺邔
//跬邬鏺腀腆1998/12/21(Mon)
//铵赬腀腀腆
Dim tDays as Integer
dim tinteger as integer
//芻苌貎苌鏺邔苰闔芷
tDays = Val(Y_NthField("31,28,31,30,31,30,31,31,30,31,30,31", ",",tMonth))
tinteger = tyear
tinteger = tmonth
//襛鑎苈苧艑貎苉艐见蹚
If (tMonth = 2) And IsLeapYear(tYear) Then
tDays = tDays + 1
End If
Return tDays
End Function
IsLeapYear
tYear as Integer
Boolean
0
9
19
9
19
Function IsLeapYear(tYear as Integer) As Boolean
//論邔郠难腆蹷鋨芳苪芽鑎芪襛鑎芩讁苟苩
//裸芫邔腀腆鑎
//闔苨鉬腀腆襛鑎苈苧True
//跬邬鏺腀腆1998/12/21(Mon)
//铵赬腀腀腆
//荊莌莓荧鑎芪襛鑎苈苧True
Return (tYear Mod 4 = 0) And ((tYear Mod 100 <> 0) Or (tYear Mod 400 = 0))
//1920/1/1 Thursday
End Function
ReturnDate
tStartDate as String,tEndDate as String
Integer
0
19
64
19
64
Function ReturnDate(tStartDate as String,tEndDate as String) As Integer
//論邔郠难腆詊蹮鏺芩苧轉鞹鏺苜苅覽鏺芠苩芩讁苟苩
//裸芫邔腀腆詊蹮鏺腁轉鞹鏺
//闔苨鉬腀腆芻苌諔苌鏺邔
//跬邬鏺腀腆1998/12/21(Mon)
//铵赬腀腀腆
Dim tStartDay as Integer
Dim tEndDay as Integer
Dim tTemp as Integer
Dim i as integer
//詊蹮鏺苆轉鞹鏺苰鎾苩
tStartDay = Val(Y_NthField(tStartDate,"/",3))
tEndDay = Val(Y_NthField(tEndDate,"/",3))
//轉鞹鏺腀-腀詊蹮鏺腀+腀1
tTemp = tEndDay - tStartDay + 1
//貎苌閪芾芯莋腛荶芵苈芪苧鏺邔苰见芦苄芢芭
tStartDay = Val(Y_NthField(tStartDate,"/",1)) * 100 + Val(Y_NthField(tStartDate,"/",2))
tEndDay = Val(Y_NthField(tEndDate,"/",1)) * 100 + Val(Y_NthField(tEndDate,"/",2))
For i = tStartDay to tEndDay - 1
tTemp = tTemp + GetDaysOfMonth(Val(LeftB(Str(i),4)),Val(RightB(Str(i),2)))
//貎芪腷12腸苉苈苁芽苧腷88腸苰醫芵苄鑎苰適苟苩
If RightB(Str(i),2) = "12" Then
i = i + 88
End If
Next
Return tTemp
End Function
IncDay
tDate as String
String
0
13
21
13
21
Function IncDay(tDate as String) As String
//論邔郠难腆YY/MM/DD苰軳芯苄裪鏺適苟苩
//裸芫邔腀腆YY/MM/DD
//闔苨鉬腀腆YY/MM/DD
//跬邬鏺腀腆1998/12/22(Tue)
//铵赬腀腀腆
Dim tYear as Integer
Dim tMonth as Integer
Dim tDay as Integer
Dim tReturnString as String
tYear = Val(Y_NthField(tDate,"/",1))
tMonth = Val(Y_NthField(tDate,"/",2))
tDay = Val(Y_NthField(tDate,"/",3))
tDay = tDay + 1
If tDay > GetDaysOfMonth(tYear,tMonth) Then
tDay = 1
tReturnString = IncMonth(Str(tYear) + "/" + ZeroSup(tMonth,2) + "/" + Str(tDay))
Else
tReturnString = Str(tYear) + "/" + ZeroSup(tMonth,2) + "/" + Str(tDay)
End If
Return tReturnString
End Function
DecDay
tDate as String
String
0
14
21
14
21
Function DecDay(tDate as String) As String
//論邔郠难腆YY/MM/DD苰軳芯苄裪鏺雟芷
//裸芫邔腀腆YY/MM/DD
//闔苨鉬腀腆YY/MM/DD
//跬邬鏺腀腆1998/12/22(Tue)
//轃邳鏺腀腆1999/01/06(Wed)腀艐鏺苌酏鏺腩=酏貎苌隖鏺腪苌豶蹚芪諔裡苁苄芢苩苌苰轃邳
//铵赬腀腀腆
Dim tYear as Integer
Dim tMonth as Integer
Dim tDay as Integer
Dim tReturnString as String
tYear = Val(Y_NthField(tDate,"/",1))
tMonth = Val(Y_NthField(tDate,"/",2))
tDay = Val(Y_NthField(tDate,"/",3))
tDay = tDay - 1
If tDay = 0 Then
tMonth = tMonth - 1
If tMonth = 0 Then
tYear = tYear - 1
tMonth = 12
End If
tDay = GetDaysOfMonth(tYear,tMonth)
End If
tReturnString = Str(tYear) + "/" + ZeroSup(tMonth,2) + "/" + Str(tDay)
Return tReturnString
End Function
FloorBug
tDouble as Double
Double
0
5
68
5
68
Function FloorBug(tDouble as Double) As Double
//論邔郠难腆Floor蹧靰躞苌離釨苰觰貈芷苩
//裸芫邔腀腆Double
//闔苨鉬腀腆Double
//跬邬鏺腀腆1999/01/15(Fri)
//铵赬腀腀腆Double苰蹧靰芵苄苠邸鍸迣離釨芪钭邶芷苩苌苅花苌論邔苅觱铰
Dim tString as String
Dim tReturnDouble as Double
tString = format(tDouble - Ceil(tDouble - 1) + 0.000000001,"#.000000000000000000000")
If Val(tString) >= 1 Then
tReturnDouble = Ceil(tDouble)
Else
tReturnDouble = Floor(tDouble)
End If
Return tReturnDouble
End Function
OutPrintP
tGraph as Graphics,tX as Integer,tY as Integer,tString as String,posiset as string
0
1
0
1
0
Sub OutPrintP(tGraph as Graphics,tX as Integer,tY as Integer,tString as String,posiset as string)
If Trim(posiset) = "L" Then
tGraph.DrawString tString,tX + gScreenX+30,tY + gScreenY
ElseIf Trim(posiset) = "M" Then
wDrawString(tGraph, tString,tX + gScreenX+30,tY + gScreenY,60)
ElseIf Trim(posiset) = "R" Then
rDrawString(tGraph,tString,(tX + gScreenX+30)+80,tY + gScreenY)
Else
tGraph.DrawString tString,tX + gScreenX+30,tY + gScreenY
End IF
End Sub
OutPlotP
tGraph as Graphics,tObjL as Integer,tObjT as Integer,tObjR as Integer,tObjB as Integer
0
1
89
1
89
Sub OutPlotP(tGraph as Graphics,tObjL as Integer,tObjT as Integer,tObjR as Integer,tObjB as Integer)
tGraph.DrawLine tObjL + gScreenX+30,tObjT + gScreenY,tObjR + gScreenX+30,tObjB + gScreenY
End Sub
CenterPrintP
tGraph as Graphics,tString as String,tLeft as Integer,tRight as Integer,tTop as Integer,tBtm as Integer
0
13
69
13
69
Sub CenterPrintP(tGraph as Graphics,tString as String,tLeft as Integer,tRight as Integer,tTop as Integer,tBtm as Integer)
Dim tPrintSizeLR as Integer
Dim tPrintSizeTB as Integer
Dim tStringSize as Integer
Dim tGomi as String
tStringSize = tGraph.StringWidth(tString)
tPrintSizeLR = ((tRight - tLeft) - tStringSize) / 2
tGomi = LeftB(tString,2)
tStringSize = tGraph.StringWidth(tGomi)
tPrintSizeTB = ((tBtm - tTop) - tStringSize) / 2
OutPrintP tGraph,tLeft + tPrintSizeLR,tBtm - tPrintSizeTB,tString,"L"
End Sub
Module1
0
-1000
0
Module1
24
0
lDrawString
g as Graphics, s as String, x as Integer, y as Integer
0
7
22
7
22
Sub lDrawString(g as Graphics, s as String, x as Integer, y as Integer)
dim i as integer
dim cnt as integer
dim fw as integer
dim lens as String
dim c as string
fw = g.stringWidth("00") / 2
cnt = len(s)
for i=1 to cnt
c = y_mid(s,i,1)
g.DrawString c,x+(lenB(lens)-1)*fw,y
lens=lens+c
next
End Sub
wDrawString
g as Graphics, s as String, x as Integer, y as Integer, w as Integer
0
12
12
12
12
Sub wDrawString(g as Graphics, s as String, x as Integer, y as Integer, w as Integer)
dim i as integer
dim cnt as integer
dim tW as double
if len(s) = 1 then
g.DrawString s,x+w/2-g.stringWidth(s)/2,y
return
else
tW = w - g.stringWidth(right(s,1))
end if
cnt = len(s)
for i=1 to cnt
g.DrawString y_mid(s,i,1),x+tW/(cnt-1)*(i-1),y
next
End Sub
rDrawString
g as Graphics, s as String, x as Integer, y as Integer
0
8
22
8
22
Sub rDrawString(g as Graphics, s as String, x as Integer, y as Integer)
dim i as integer
dim cnt as integer
dim fw as integer
dim lens as String
dim c as string
dim tx as integer
fw = g.stringWidth("00") / 2
cnt = len(s)
tx = x - lenB(s) * fw
for i=1 to cnt
c = y_mid(s,i,1)
g.DrawString c,tx+(lenB(lens)-1)*fw,y
lens=lens+c
next
End Sub