2022.02
20220200
2
1
0
0
0
0
2.1.2
2.1.2
2006/12/20
0
1
0
0
0
134217984
6144
0
0
1768123448
81FBFBFBFBFBFBFBFCFCFCFCFCFCFCACACACACF5000000000000000000000000FB00002A002A002A002A2A00F500F500F500FCFBF50000000000000000000000FB002A002A2A2A2A2A2A2AF500F500FBFBFBFBFBFBFBFBFBFB00000000000000FB2A002A2A2A2A2A2A2A5500F500FBC0C0C0C0C0C0C0C0FBFB00000000000000FB002A2A2A2A2A2A2A2A2AF500FBC0C0C0C0C0C0C0C0FBC0FB00000000000000FB2A2A2A2A2A2A2A2A2A5500FBC0C0C0C0C0C0C0C0FBC0C0FB00000000000000FB002A2A2A2A2A2A2A552AFBFBFBFBFBFBFBFBFBFBC0C0C0FB00000000000000FB2A2A2A2A2A2A2A2A2A55FBC0C0C0C0C0C0C0C0FBC0C0C0FB00000000000000FB002A2A2A2A2A552A552AFBC0FFC0FFFFFFFFC0FBC0C0C0FB00000000000000FB2A2A2A552A552A552A55FBC0FFC0FFC0C0C0C0FBC0C0C0FB00000000000000FB00000000F500F500F500FBFFFFFFFFFFFFFFC0FBC0C0C0FB00000000000000FB000000F500F500F500F5FBC0FFC0FFC0FFC0C0FBC0C0C0FB00000000000000FC0000F500F500F500F500FBC0FFFFFFFFFFFFC0FBC0C0C0FB00000000000000FC000000F500F500F500F5FBC0FFC0FFC0FFFFC0FBC0C0C0FB00000000000000FC0000F500F500F500F500FBFFFFFAFFC0FFC0C0FBC0C0C0FB00000000000000FC000000F500F500F500F5FBC0FFFFC0FAC0FFC0FBC0C0C0FB00000000000000FC0000F500F500F500F500FBC0C0C0C0C0C0C0C0FBC0C0C0FB00000000000000FC000000F500F500F500F5FBC0C0C0C0C0C0C0C0FBC0C0C0FB00000000000000FC0000F500F500F500F500FBC0C0C0C0C0C0C0C0FBC0C0C0FB00000000000000FC000000F500F500F500F5FBC0C0C0C0C0C0C0C0FBC0C0C0FB00000000000000FC0000F500F500F500F500FBC0FFC0C0C0C0C0C0FBC0C0C0FB00000000000000FC000000F500F500F500F5FBC0FFC0FFFFFFFFC0FBC0C0C0FB00000000000000AC0000F500F500F500F500FBF9FFC0C0C0C0C0C0FBC0C0C0FB00000000000000AC000000F500F500F500F5FBFFFCFFFFFFFFFFFFFBC0C0C0FB00000000000000AC0000F500F500F500F500FBC0FFC0C0FFC0C0C0FBC0C0C0FB00000000000000AC000000F500F500F500F5FBC0FFC0FFFAC0FFC0FBC0C0C0FB00000000000000AC0000F500F500F500F500FBC0FFFFFCFFFFFCFFFBC0C0C0FBF6F50000000000AC00F500F500F500F5F5F5FBC0FFF9FAC0C0C0FAFBC0C0C0FBF8F7F6F5000000AC0000F500F500F500F5F5FBC0C0C0C0C0C0C0C0FBC0C0FBFFF9F8F72BF6F500AC00F500F500F5F5F5F5F5FBC0C0C0C0C0C0C0C0FBC0FBF7FFFAF9F8F8F7F500AC0000F5F5F5F5F5F5F5F5FBC0C0C0C0C0C0C0C0FBFBF6F7FFFAFA56F82BF500ACFDFDFDFDFDFDFDFDFDFEFBFBFBFBFBFBFBFBFBFBFFFFFFFFFAF956F7F60000
1229147683
FFFFF000956AB800AFF5FF80DFEBFF80BFF7FF80FFEFFF80BFFFFF80FFFFFF80BFFFFF80FFFFFF80855FFF808ABFFF80955FFF808ABFFF80955FFF808ABFFF80955FFF808ABFFF80955FFF808ABFFF80955FFF808ABFFF80955FFF808ABFFF80955FFF808ABFFF80955FFFE0AAFFFFF8957FFFFEABFFFFFE9FFFFFFEFFFFFFFCFFFFF000956AB800AFF5FF80DFEBFF80BFF7FF80FFEFFF80BFFFFF80FFFFFF80BFFFFF80FFFFFF80855FFF808ABFFF80955FFF808ABFFF80955FFF808ABFFF80955FFF808ABFFF80955FFF808ABFFF80955FFF808ABFFF80955FFF808ABFFF80955FFF808ABFFF80955FFFE0AAFFFFF8957FFFFEABFFFFFE9FFFFFFEFFFFFFFC
Na08
振替伝票
accountmanager.norizuki.com
My Application
AppName.exe
0
0
MyApplication
1
text
R*ch
TEXT
0
Text
1
9
public.data
1
0
0
0
{35138b9a-5d96-4fbd-8e2d-a2440225f93a}|{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}|{1f676c76-80e1-4239-95bb-83d0f6d0da78}|{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}
0
FileTypes
0
text
R*ch
TEXT
0
Text
1
9
public.data
AccountManager
0
1
Window
1
0
EnableMenuItems
1
958359551
134217984
Sub EnableMenuItems()
//各メニューを使用可能に
AppleU.Enabled = True
Save.Enabled = True
Print.Enabled = True
TekiyouEdit.Enabled = True
PageSetup.Enabled = True
ChangeDate.Enabled = True
End Sub
Open
1
78196735
134217984
Sub Open()
Dim tLineCount as Integer
Dim K as Date
Dim tWindow as CalendarWindow
Dim tMsgWindow as MsgDlg
Dim tBoolean as Boolean
Dim tFolderItem as FolderItem
Dim FileReadFrom as TextInputStream
// ファイルを開く
tFolderItem = MakeFolder(gBasicPath + "振替伝票データ")
tFolderItem = GetFolderItem(tFolderItem.AbsolutePath + "プリンター設定")
If tFolderItem <> Nil Then //SP
FileReadFrom=tFolderItem.OpenAsTextfile
IF FileReadFrom <> Nil Then// 2#
Settings = FileReadFrom.ReadAll
FileReadFrom.Close
ELSE// 2#
END IF// 2#
END IF//SP
K = new date
OpenYear = K.Year
OpenMonth = K.Month
OpenDay = K.Day
ProgressBar1.maximum = 1500
ProgressBar1.value = 0
ProgressBar1.Refresh
//使用会社名
//ソフトウエアのバージョン
gVersionString = "振替伝票 Ver 2.0.4 2001/09/3"
//2000/3/2 起動時に出力された振替伝票を自動保存
//2000/3/7 印刷されていない伝票を警告
//2000/3/7 自動保存機能の追加により保存ボタン削除
//2000/3/10 摘要エディタの修正
//2000/4/11 出力された振替伝票の削除からフォルダ移動へ変更
//2000/4/17 印刷待ちの書類を印刷注意ダイアログで修正出来るように変更
//2000/4/18 Trimで は行が無くなる問題を解決。
//2000/4/27 デバックがらくなように出力された振替伝票の名前の後に時間をいれた。
//2000/5/02 区分振り分け番号を入力の後にリターンで決定出来るように修正
//2000/5/23 自動リマインダーの読み込み失敗を修正。
//2000/6/08 自動リマインダーが自分で振替伝票のファイルを作れない問題が発生TRTransを修正
//2000/7/3 保存の時に「出力された振替伝票」フォルダの中身を削除しないようにコメント化
//2000/7/3 印刷ボタンが押された時「出力された振替伝票」の自動保存を追加。
// これによって振替伝票入力中に「出力された振替伝票」フォルダにファイルが入ってきても
// 印刷される前に更新される。
//2000/7/12 TRTransでシーク位置を「-11」しているカ所（２ヶ所）をコメントに変更
//2000/7/13 TRTransで200個用意されていた配列を1000個に増やす
//2001/2/13 左右科目で番号変換できないように修正
//2001/8/30 印刷注意ダイアログの廃止。
//2001/9/3 印刷注意ダイアログの廃止に伴い、カレンダーウインドウも処理をカット
//2001/9/3 クリックでフィールド移動に対応（バージョン2.0.4)
//2004/3/18 レーザープリンター対応。
//2004/11/29 OutplotとOutprintで印刷位置を下げた
//プリントで区分の廃止
//2005/01/08 リストの区分の入力なしで操作可能
//2005/01/09 リストの区分を廃止
//2005/01/11 プリントで借方合計が表示されない問題を解決。
//★OS-X対応以降に繰り越しの計算をしない問題が発生。
//2005/1/14 "2005/1/14"で検索するとDoLoopにいく。そのループ内を修正。
// 繰越計算（SaveTransfer）が来月の振伝がないと実行されなかった
//2005/09/07 繰り越しファイルを振替伝票に作らせるのをやめた。試算表にやらせる！！
//2005/9/13 プリントで科目を均等割に修正
//2006/11/29 安全の為TRTTransfer の前に出力された振替伝票フォルダの中身をコピーフォルダに複製する”ReadCopyFile”
//２００６/12/5 ReadOutputAccountで区分読み込みの処理変更。
//2006/12/6 TRTransの廃止
//2006/12/21 ReadOutputAccountの中で"もう一度"の部分を追加
// 毎朝１回目のファイル処理でフォルダが見つからない為、失敗しても２回まで処理するように変更
//2007/05/22 カレンダーボタンを押したら、必ず保存するように変更 検索ワード”2007.5.22”
//=======改ページの最大行数を変更するには”ページカウンタ”で検索するとその場所に行けます。
//基本パスの設定
gBasicPath = GetFolderItem("").AbsolutePath
//保存フラグの設定
gSaveCheak = "保存済"
//ウィンドウの位置を調整する
left=screen(0).width/2-width/2
top=screen(0).height/2-height/2
//振替伝票初期設定ファイルの出力
SetPreferencesFolder()
//クライアントリスト初期化
MainList.columncount = 6
MainList.RowCount = 11
MainList.columnwidths "13,12,36,6,12,13"
MainList.columnheaders " 借 方 金 額, 借 方 科 目, 適 用,, 貸 方 科 目, 貸 方 金 額"
MainList.columnmasks "0,1,0,0,1,0"
MainList.DrawUp "r0,l,l,l,l,r0"
MainList.TextField = MainListField
MainList.ScrollBar = MainListScrollBar
MainList.EditMode = 0
MainList.GetReady
//メインボタン初期化
//ボタンの横列数
MainButton.ColCount = 9
//ボタンの縦行数
MainButton.RowCount = 15
//使用フォント
MainButton.TextFont = "アニト-Ｌ等幅"
//使用フォントサイズ
MainButton.TextSize = 18
'//ボタンの横幅
'MainButton.CellWidth = MainButton.width/MainButton.ColCount
'//ボタンの縦幅
'MainButton.CellHeight = MainButton.height/MainButton.RowCount
//ボタンの動き 0=MouseUpをとる 1=凹んでいるのは常にひとつ 2=もう一度押されないと戻らない
MainButton.ButtonType = 0
//押しても反応しないボタンの設定
MainButton.BadName = "***"
//勘定科目の読み込み
ReadKamoku()
//サブボタン初期化
subButton.left=MainButton.left
subButton.top=MainButton.top
//ボタンの横列数
SubButton.ColCount = 3
//ボタンの縦行数
SubButton.RowCount = 15
//使用フォント
SubButton.TextFont = "アニト-Ｌ等幅"
//使用フォントサイズ
SubButton.TextSize = 18
'//ボタンの横幅
'SubButton.CellWidth = SubButton.width/SubButton.ColCount
'//ボタンの縦幅
'SubButton.CellHeight = SubButton.height/SubButton.RowCount
//ボタンの動き 0=MouseUpをとる 1=凹んでいるのは常にひとつ 2=もう一度押されないと戻らない
SubButton.ButtonType = 0
//押しても反応しないボタンの設定
SubButton.BadName = ""
//ボタン位置の初期化
SubButton.PushButtonCol = -1
SubButton.PushButtonRow = -1
SubButton.ChangeButtonColor
SubButton.ChangeButtonColorDark
//適用内容の読み込
ReadTekiyou()
//メインリストの位置設定
MainList.MoveCell(1,1)
MainListField.Top = -100
//日付けを入れる
DateField.year = K.Year
DateField.Month = K.Month
DateField.Day = K.Day
DateField.Redraw
//TRTrans //自動リマインダー
//日付けウインドウを表示
OpenYear = DateField.year
OpenMonth = DateField.Month
OpenDay = DateField.Day
If gSaveCheak = "未保存" Then
tBoolean = SaveEvent()//●データ保存●
ELSE
tWindow = New CalendarWindow
tWindow.ShowModal
gSaveCheak = "保存済"
End If
End Sub
AppleU
1
1419073535
134217984
Function AppleU() As Boolean
Dim tWindow as AboutWindow
tWindow = New AboutWindow
End Function
Save
1
1540665343
134217984
Function Save() As Boolean
Dim tBoolean as Boolean
tBoolean = SaveEvent()
End Function
Print
1
2044399615
134217984
Function Print() As Boolean
//Dim tWindow as PrintWindow
Dim tGraph as Graphics
Dim tPrintFlag as Boolean
Dim tPrintSetting as PrinterSetup
Dim kesuhizuke as String
Dim tFolderItem as FolderItem
Dim tBinaryOutput as BinaryStream
Dim i as Integer
Dim Damy as String
Dim tBoolean as Boolean
tBoolean = SaveEvent()//●データ保存●
InDay = Val(Left(RightB(DateField.text,10),4)+Mid(RightB(DateField.text,10),6,2)+Right(RightB(DateField.text,10),2))
kesuhizuke = Trim(DateField.text)
If MainList.Cell(1,3) <> "" Then
//=========================================
If ErrorCheck() = True Then
tPrintSetting = New PrinterSetup
tPrintSetting.SetupString = Settings
tGraph = OpenPrinterDialog(tPrintSetting)
Else
End If
If tGraph <> Nil Then
SlipPrint(tGraph,0,50,"振 替 伝 票","")
Else
MsgBox "プリンタが開けませんでした"
End If
gScreenX = 0
gScreenY = 50
//もし印刷待ち書類の中に印刷された日付けがあったら消す
//===================メモ=====================
tFolderItem = MakeFolder(gBasicPath + "振替伝票データ")
tFolderItem = GetFolderItem(tFolderItem.AbsolutePath + "印刷待")
If tFolderItem <> Nil Then
//振伝データファイルを開く
tBinaryOutput = tFolderItem.OpenAsBinaryFile(True)
//もし、存在しなければ作成する
If tBinaryOutput = Nil Then
tBinaryOutput = tFolderItem.CreateBinaryFile("TEXT")
tBinaryOutput.Close
ELSE//存在する
If tBinaryOutput <> Nil Then
tBinaryOutput.LittleEndian = True
For i = 1 to 100
Damy = Trim(tBinaryOutput.ReadPString(Encodings.MacJapanese))
If Damy = "0000000000" OR Damy = ""Then
ELSE
IF Damy = kesuhizuke THEN
Damy = Trim(tBinaryOutput.ReadPString(Encodings.MacJapanese))
tBinaryOutput.Position = tBinaryOutput.Position - 13
tBinaryOutput.WritePString "0000000000"
tBinaryOutput.WritePString CHR(13)
i = 100
ELSE
Damy = Trim(tBinaryOutput.ReadPString(Encodings.MacJapanese))
END IF
END IF
NEXT
tBinaryOutput.Close
END IF
End If
END IF
//============================================
//===========================================
Else
Msgbox "データが無いので印刷できません。"
End If
End Function
TekiyouEdit
1
556673023
134217984
Function TekiyouEdit() As Boolean
Dim tWindow as TekiyouEditWindow
Dim tBoolean as Boolean
tBoolean = SaveEvent()//●データ保存●
tWindow = New TekiyouEditWindow
End Function
FileQuit
1
1042943999
134217984
Function FileQuit() As Boolean
Dim tMsgWindow as MsgDlg
Dim tBoolean as Boolean
'If gSaveCheak = "未保存" Then
//tMsgWindow = New MsgDlg
//tMsgWindow.SetMessage "終了する前に変更内容を保存しますか？"
//tMsgWindow.setMode "保存"
//tMsgWindow.showmodal
//保存ならデータを保存し、保存しないなら保存せずに終了処理を続ける
//If tMsgWindow.QuitMode = "保存" Then
tBoolean = SaveEvent()
//ElseIf tMsgWindow.QuitMode = "キャンセル" Then
//Return True
//End If
'End If
'If tBoolean = True Then
'SaveTekiyou()
'Else
'Return True
'End If
End Function
PageSetup
1
577531903
134217984
Function PageSetup() As Boolean
Dim tFolderItem as FolderItem
Dim tTextOutput as TextOutputStream
Dim Pa as PrinterSetup
Pa = New PrinterSetup
Pa.SetupString = settings
If Pa.PageSetupDialog Then
settings = Pa.SetupString
// ファイルを開く
tFolderItem = MakeFolder(gBasicPath + "振替伝票データ")
tFolderItem = GetFolderItem(tFolderItem.AbsolutePath + "プリンター設定")
If tFolderItem <> Nil Then //SP
tTextOutput=tFolderItem.CreateTextfile
IF tTextOutput <> Nil Then// 2#
tTextOutput.Write settings
tTextOutput.Close
END IF//// 2#
End If//SP
END IF
End Function
ChangeDate
1
1655281663
134217984
Function ChangeDate() As Boolean
//日付けの変更
Dim tWindow as ChangeDateWindow
Dim tBoolean as Boolean
tBoolean = SaveEvent()//●データ保存●
tWindow = New ChangeDateWindow
End Function
SaveAccount
1
552906751
134217984
Sub SaveAccount()
//区分対応終了
//振伝データの保存
// 振伝を保存（新しいキャッシュファイルに保存して古いファイルと入れ替える保存方法）
Dim tFolderItem as FolderItem
Dim tFolderItemBuffer as FolderItem
Dim tBinaryOutput as BinaryStream
Dim tBinaryOutputBuffer as BinaryStream
Dim tReadString as String
Dim tKariKamoku as String
Dim tKasiKamoku as String
Dim tKariKingaku as String
Dim tKasiKingaku as String
Dim tKubun as String
Dim i as Integer
//今月の振伝データのFolderItemを得る
tFolderItem = MakeFolder(gBasicPath + "振替伝票データ")
tFolderItem = MakeFolder(tFolderItem.AbsolutePath + NthField(DateField.Text,"/",1))
tFolderItem = GetFolderItem(tFolderItem.AbsolutePath + "振伝" + Left(DateField.Text,7))
//書き込み用バッファデータのFolderItemを得る
tFolderItemBuffer = MakeFolder(gBasicPath + "振替伝票データ")
tFolderItemBuffer = MakeFolder(tFolderItemBuffer.AbsolutePath + NthField(DateField.Text,"/",1))
tFolderItemBuffer = GetFolderItem(tFolderItemBuffer.AbsolutePath + "振伝バッファ")
//両方のFolderItemが得られたら
If tFolderItem <> Nil And tFolderItemBuffer <> Nil Then
//振伝データファイルを開く
tBinaryOutput = tFolderItem.OpenAsBinaryFile(True)
//もし、存在しなければ作成する
If tBinaryOutput = Nil Then
tBinaryOutput = tFolderItem.CreateBinaryFile("TEXT")
End If
//書き込み用バッファデータを作成する
tBinaryOutputBuffer = tFolderItemBuffer.CreateBinaryFile("TEXT")
//両方のファイルが開けたら
If tBinaryOutput <> Nil And tBinaryOutputBuffer <> Nil Then
tBinaryOutput.LittleEndian = True
tBinaryOutputBuffer.LittleEndian = True
//振伝データから一行読込み、これから保存する日付と違っていたらバッファファイルへ書き込む
For i = 1 to 15000
tKubun = ""
tReadString = Trim(tBinaryOutput.ReadPString(Encodings.MacJapanese))
If tReadString <> "" Then
If tReadString <> DateField.Text Then
//日付
tBinaryOutputBuffer.WritePString SpaceSup(tReadString,10)
//借方金額
tKariKingaku = Trim(tBinaryOutput.ReadPString(Encodings.MacJapanese))
tBinaryOutputBuffer.WritePString SpaceSup(tKariKingaku,14)
//借方科目番号
tKariKamoku = Trim(tBinaryOutput.ReadPString(Encodings.MacJapanese))
tBinaryOutputBuffer.WritePString SpaceSup(tKariKamoku,4)
//借方科目
tBinaryOutputBuffer.WritePString SpaceSup(Trim(tBinaryOutput.ReadPString(Encodings.MacJapanese)),12)
//適用
tBinaryOutputBuffer.WritePString SpaceSup(Trim(tBinaryOutput.ReadPString(Encodings.MacJapanese)),38)
//番号
tBinaryOutputBuffer.WritePString SpaceSup(Trim(tBinaryOutput.ReadPString(Encodings.MacJapanese)),6)
//貸方科目番号
tKasiKamoku = Trim(tBinaryOutput.ReadPString(Encodings.MacJapanese))
tBinaryOutputBuffer.WritePString SpaceSup(tKasiKamoku,4)
//貸方科目
tBinaryOutputBuffer.WritePString SpaceSup(Trim(tBinaryOutput.ReadPString(Encodings.MacJapanese)),12)
//貸方金額
tKasiKingaku = Trim(tBinaryOutput.ReadPString(Encodings.MacJapanese))
tBinaryOutputBuffer.WritePString SpaceSup(tKasiKingaku,14)
//区分
tKubun = tBinaryOutput.ReadPString(Encodings.MacJapanese)
If LenB(tKubun) = 2 Then
tBinaryOutputBuffer.WritePString SpaceSup(Trim(tKubun),2)
//予備空間
tBinaryOutputBuffer.WritePString SpaceSup("",31)
//改行
tBinaryOutputBuffer.WritePString CHR(13)
//読み飛ばし
tBinaryOutput.Position = tBinaryOutput.Position + 34
Else
//読み飛ばし
tBinaryOutput.Position = tBinaryOutput.Position + 2
//予備空間
tBinaryOutputBuffer.WritePString SpaceSup("",34)
//改行
tBinaryOutputBuffer.WritePString CHR(13)
End If
If tKariKamoku <> "" Then
MakeTransfer(Val(tKariKamoku),ChangeSequence(tKariKingaku),0,tKubun)
End If
If tKasiKamoku <> "" Then
MakeTransfer(Val(tKasiKamoku),0,ChangeSequence(tKasiKingaku),tKubun)
End If
Else
//読み飛ばし
tBinaryOutput.Position = tBinaryOutput.Position + 149
End If
Else
Exit
End If
ProgressBar1.value = ProgressBar1.value+1//※
ProgressBar1.Refresh
Next
//ファイルを閉じて
tBinaryOutput.Close
//振伝データを削除する
tFolderItem.Delete
//バッファファイルへ今表示しているデータを追加する
For i = 1 to 500
ProgressBar1.value = ProgressBar1.value+1//※
ProgressBar1.Refresh
If MainList.Cell(i,3) <> "" Then
//日付
tBinaryOutputBuffer.WritePString SpaceSup(DateField.Text,10)
//借方金額
tBinaryOutputBuffer.WritePString SpaceSup(MainList.Cell(i,1),14)
//借方科目番号
tBinaryOutputBuffer.WritePString SpaceSup(KamokuNumber(MainList.Cell(i,2)),4)
//借方科目
tBinaryOutputBuffer.WritePString SpaceSup(MainList.Cell(i,2),12)
//適用
tBinaryOutputBuffer.WritePString SpaceSup(MainList.Cell(i,3),38)
//番号
tBinaryOutputBuffer.WritePString SpaceSup(MainList.Cell(i,4),6)
//貸方科目番号
tBinaryOutputBuffer.WritePString SpaceSup(KamokuNumber(MainList.Cell(i,5)),4)
//貸方科目
tBinaryOutputBuffer.WritePString SpaceSup(MainList.Cell(i,5),12)
//貸方金額
tBinaryOutputBuffer.WritePString SpaceSup(MainList.Cell(i,6),14)
//区分
tBinaryOutputBuffer.WritePString SpaceSup("1",2)
If MainList.Cell(i,2) <> "" Then
MakeTransfer(Val(MainList.Cell(i,8)),ChangeSequence(MainList.Cell(i,1)),0,"1")
End If
If MainList.Cell(i,5) <> "" Then
MakeTransfer(Val(MainList.Cell(i,9)),0,ChangeSequence(MainList.Cell(i,6)),"1")
End If
//予備空間
tBinaryOutputBuffer.WritePString SpaceSup("",31)
//改行
tBinaryOutputBuffer.WritePString Chr(13)
End If
Next
//バッファファイルを閉じて
tBinaryOutputBuffer.Close
//バッファファイルのファイル名を"振伝" + Left(DateField,7)へ変更
tFolderItemBuffer.Name = "振伝" + Left(DateField.Text,7)
//画面をリフレッシュ
MainList.aListRefresh
End If
End If
End Sub
134217984
0
0
MainListClear
1
843100159
134217984
Sub MainListClear()
//区分対応終了
//メインリストの初期化
Dim i as Integer
Dim j as Integer
For i = 1 to 500
For j = 1 to 9
MainList.Cell(i,j) = ""
Next
Next
MainList.aListRefresh
KariTotal.Text = ""
KasiTotal.Text = ""
End Sub
134217984
0
0
ReadAccount
1
776679423
134217984
Function ReadAccount(tLineInteger as Integer) As Integer
//区分対応終了
//振伝データの読み込み
Dim tFolderItem as FolderItem
Dim tBinaryInput as BinaryStream
Dim i as Integer
dim tstring as string
Dim Damy(999) as String
//売上伝票Indexファイルを作成する
tFolderItem = MakeFolder(gBasicPath + "振替伝票データ")
tFolderItem = MakeFolder(tFolderItem.AbsolutePath + NthField(DateField.Text,"/",1))
tFolderItem = GetFolderItem(tFolderItem.AbsolutePath + "振伝" + Left(DateField.Text,7))
If tFolderItem <> Nil Then
tBinaryInput = tFolderItem.OpenAsBinaryFile(false)
If tBinaryInput <> Nil Then
tBinaryInput.LittleEndian = True
i = tLineInteger
While tBinaryInput.EOF = False
//日付
tstring = DateField.Text
tstring = tBinaryInput.ReadPString(Encodings.MacJapanese)
If DateField.Text = tstring then'tBinaryInput.ReadPString(Encodings.MacJapanese) Then
i = i + 1
//借方金額
MainList.Cell(i,1) = SpaceSup(Trim(tBinaryInput.ReadPString(Encodings.MacJapanese)),13)
//借方科目番号
MainList.Cell(i,8) = Trim(tBinaryInput.ReadPString(Encodings.MacJapanese))
//借方科目
MainList.Cell(i,2) = Trim(tBinaryInput.ReadPString(Encodings.MacJapanese))
//適用
MainList.Cell(i,3) = Trim(tBinaryInput.ReadPString(Encodings.MacJapanese))
//番号
MainList.Cell(i,4) = Trim(tBinaryInput.ReadPString(Encodings.MacJapanese))
//貸方科目番号
MainList.Cell(i,9) = Trim(tBinaryInput.ReadPString(Encodings.MacJapanese))
//貸方科目
MainList.Cell(i,5) = Trim(tBinaryInput.ReadPString(Encodings.MacJapanese))
//貸方金額
MainList.Cell(i,6) = SpaceSup(Trim(tBinaryInput.ReadPString(Encodings.MacJapanese)),13)
//区分
Damy(i) = Trim(tBinaryInput.ReadPString(Encodings.MacJapanese))
If Damy(i) <> "" Then
//予備空間 改行
tBinaryInput.Position = tBinaryInput.Position + 34
Else
//改行
tBinaryInput.Position = tBinaryInput.Position + 2
End If
Else
//予備空間 改行
tBinaryInput.Position = tBinaryInput.Position + 149
End If
Wend
tBinaryInput.Close
End If
End If
Return i
End Function
134217984
0
0
tLineInteger as Integer
Integer
SlipPrint
1
903938047
134217984
Sub SlipPrint(tGraph as Graphics,tSetOrgX as Integer,tSetOrgY as Integer,tDaimeiString as String,tType as String)
//振伝の印刷
Dim i as Integer
Dim tPrintString as string
Dim tPrintPage as Integer
Dim tKari as Double
Dim tKasi as Double
tKari = 0
tKasi = 0
//ページカウンタ 61;61下の行の配列５番目
OpenPrint(tGraph,tSetOrgX,tSetOrgY,"20;20;20;20","45;45","12;9;31;6;9;12","借方金額" + Chr(9) + "借方科目" + Chr(9) + "適用" + Chr(9) + " " + Chr(9) + "貸方科目" + Chr(9) + "貸方金額","R;M;L;L;M;R","ヒラギノ明朝 Pro W3","10")
For i = 1 to 500
If Trim(MainList.Cell(i,3)) <> "" Then
tPrintString = Trim(MainList.Cell(i,1)) + Chr(9)
tKari = tKari + ChangeSequence(MainList.Cell(i,1))
tPrintString = tPrintString + SetKamoku(Trim(MainList.Cell(i,2))) + Chr(9)
tPrintString = tPrintString + Trim(MainList.Cell(i,3)) + Chr(9)
tPrintString = tPrintString + Trim(MainList.Cell(i,4)) + Chr(9)
tPrintString = tPrintString + SetKamoku(Trim(MainList.Cell(i,5))) + Chr(9)
tPrintString = tPrintString + Trim(MainList.Cell(i,6))
tKasi = tKasi + ChangeSequence(MainList.Cell(i,6))
tPrintPage = AddPrint(tGraph,tPrintString)
End If
If lPageLineNumber(1) = 2 Then
HeardFootPrint(tGraph,tSetOrgX,tSetOrgY,tDaimeiString)
End If
Next
If lPageLineNumber(1) - 1 <> 0 Then
OutPlot tGraph,lPrintData(6),lPrintData(7) + lPrintData(4) * lPageLineNumber(1),lPrintData(8) ,lPrintData(7) + lPrintData(4) * lPageLineNumber(1)
tPrintString = Format(tKari,",#") + Chr(9) + Chr(9) + Chr(9) + Chr(9) + Chr(9) + Format(tKasi,",#")
tPrintPage = AddPrint(tGraph,tPrintString)
ListPrint tGraph,lPageLineNumber(1)
End If
End Sub
134217984
0
0
tGraph as Graphics,tSetOrgX as Integer,tSetOrgY as Integer,tDaimeiString as String,tType as String
MakeTransfer
1
1884944383
134217984
Sub MakeTransfer(tKamoku as Integer,tKariDouble as Double,tKasiDouble as Double,tKubun as String)
//区分対応終了
//繰越の足し込み
gKingaku(tKamoku,1) = gKingaku(tKamoku,1) + tKariDouble
gKingaku(tKamoku,2) = gKingaku(tKamoku,2) + tKasiDouble
If tKubun = "1" Then
gKougei(tKamoku,1) = gKougei(tKamoku,1) + tKariDouble
gKougei(tKamoku,2) = gKougei(tKamoku,2) + tKasiDouble
ElseIf tKubun = "2" Then
gSystem(tKamoku,1) = gSystem(tKamoku,1) + tKariDouble
gSystem(tKamoku,2) = gSystem(tKamoku,2) + tKasiDouble
ElseIf tKubun = "3" Then
gFishing(tKamoku,1) = gFishing(tKamoku,1) + tKariDouble
gFishing(tKamoku,2) = gFishing(tKamoku,2) + tKasiDouble
ElseIf tKubun = "4" Then
gManagement(tKamoku,1) = gManagement(tKamoku,1) + tKariDouble
gManagement(tKamoku,2) = gManagement(tKamoku,2) + tKasiDouble
End If
End Sub
134217984
0
0
tKamoku as Integer,tKariDouble as Double,tKasiDouble as Double,tKubun as String
ClearTransfer
1
833314815
134217984
Sub ClearTransfer()
//区分対応終了
//繰越データの初期化
Dim i as Integer
For i = 1 to 135
gKingaku(i,1) = 0
gKingaku(i,2) = 0
gKougei(i,1) = 0
gKougei(i,2) = 0
gSystem(i,1) = 0
gSystem(i,2) = 0
gFishing(i,1) = 0
gFishing(i,2) = 0
gManagement(i,1) = 0
gManagement(i,2) = 0
Next
End Sub
134217984
0
0
ReadAccountMakeTransfer
1
656467967
134217984
Sub ReadAccountMakeTransfer(tDateString as String)
//過去の振伝データを読み込んで繰越データを得る
Dim tFolderItem as FolderItem
Dim tBinaryInput as BinaryStream
Dim tKariKamoku as String
Dim tKasiKamoku as String
Dim tKariKingaku as String
Dim tKasiKingaku as String
Dim tKubun as String
Dim i as Integer
//今月の振伝データのFolderItemを得る
tFolderItem = MakeFolder(gBasicPath + "振替伝票データ")
tFolderItem = MakeFolder(tFolderItem.AbsolutePath + NthField(tDateString,"/",1))
tFolderItem = GetFolderItem(tFolderItem.AbsolutePath + "振伝" + Left(tDateString,7))
//FolderItemが得られたら
If tFolderItem <> Nil Then
//振伝データファイルを開く
tBinaryInput = tFolderItem.OpenAsBinaryFile(false)
//もし、存在しなければ関数を抜ける
If tBinaryInput = Nil Then
Return
End If
//ファイルが開けたら
If tBinaryInput <> Nil Then
tBinaryInput.LittleEndian = True
//振伝データを読込み繰越額を得る
While tBinaryInput.EOF = False
//日付読み飛ばし
tBinaryInput.Position = tBinaryInput.Position + 11
//借方金額
tKariKingaku = tBinaryInput.ReadPString(Encodings.MacJapanese)
//借方科目番号
tKariKamoku = Trim(tBinaryInput.ReadPString(Encodings.MacJapanese))
//読み飛ばし
tBinaryInput.Position = tBinaryInput.Position + 59
//貸方科目番号
tKasiKamoku = Trim(tBinaryInput.ReadPString(Encodings.MacJapanese))
//読み飛ばし
tBinaryInput.Position = tBinaryInput.Position + 13
//貸方金額
tKasiKingaku = tBinaryInput.ReadPString(Encodings.MacJapanese)
//区分
tKubun = Trim(tBinaryInput.ReadPString(Encodings.MacJapanese))
If tKariKamoku <> "" Then
MakeTransfer(Val(tKariKamoku),ChangeSequence(tKariKingaku),0,tKubun)
End If
If tKasiKamoku <> "" Then
MakeTransfer(Val(tKasiKamoku),0,ChangeSequence(tKasiKingaku),tKubun)
End If
//読み飛ばし
tBinaryInput.Position = tBinaryInput.Position + 34
ProgressBar1.value = ProgressBar1.value+1//※
ProgressBar1.Refresh
Wend
//ファイルを閉じて
tBinaryInput.Close
End If
End If
End Sub
134217984
0
0
tDateString as String
HeardFootPrint
1
1438328831
134217984
Sub HeardFootPrint(tGraph as Graphics,tSetOrgX as Integer,tSetOrgY as Integer,tDaimeiString as String)
//ヘッダ＆フッタの印刷
tGraph.TextFont = "ヒラギノ明朝 Pro W3"
tGraph.Bold = False
tGraph.TextSize = 14
OutPrintP tGraph,lPrintData(6)+5,lPrintData(7) - 8, Str(DateField.Year) + "年" + Str(DateField.Month) + "月" + Str(DateField.Day) + "日","L"
tGraph.TextSize = 12
EvenlyPrint tGraph,lPrintData(8) - 1,lPrintData(7) - 8,"N o ." + Str(lPageLineNumber(0))
tGraph.TextFont = "ヒラギノ明朝 Pro W3"
tGraph.TextSize = 18
CenterPrintP tGraph,tDaimeiString,0,lPrintData(0),0,10
End Sub
134217984
0
0
tGraph as Graphics,tSetOrgX as Integer,tSetOrgY as Integer,tDaimeiString as String
ErrorCheck
1
471177215
134217984
Function ErrorCheck() As Boolean
//保存などのエラーチェック
Dim tErrorType as Integer
Dim tCheckList(6) as Integer
Dim tCheck as Integer
Dim i as Integer
Dim j as Integer
For i = 1 to 500
For j = 1 to 6
If Trim(MainList.Cell(i,j)) <> "" then
tCheckList(j) = 1
Else
tCheckList(j) = 0
End If
Next
//10進数に変換に変換
tCheck = (tCheckList(1) * 16) + (tCheckList(2) * 8) + (tCheckList(3) * 4) + (tCheckList(5) * 2) + tCheckList(6)
If tCheck <> 31 And tCheck <> 28 And tCheck <> 7 And tCheck <> 0 Then
If tCheck = 30 Then
tErrorType = 6
ElseIf tCheck = 28 Or tCheck = 29 Then
tErrorType = 5
ElseIf 24<= tCheck And tCheck <= 27 then
tErrorType = 4
ElseIf 16<= tCheck And tCheck <= 23 then
tErrorType = 3
ElseIf 1<= tCheck And tCheck <= 15 then
tErrorType = 2
End If
Exit
End If
Next
If ChangeSequence(KariTotal.Text) <> ChangeSequence(KasiTotal.Text) Then
tErrorType = 1
End If
Select Case tErrorType
Case 1
MsgBox "左右金額が正しくありません。" + CHR(13) + "もう一度確認してください。"
MainList.ClickPosX = 0
MainList.ClickPosY = 0
MainListScrollBar.Value = 1
Case 2
MsgBox Str(i) + "行目の借方金額が抜けています。" + CHR(13) + "もう一度確認してください。"
MainList.ClickPosX = 1
MainList.ClickPosY = i
MainListScrollBar.Value = i - 5
Case 3
MsgBox Str(i) + "行目の借方科目が抜けています。" + CHR(13) + "もう一度確認してください。"
MainList.ClickPosX = 2
MainList.ClickPosY = i
MainListScrollBar.Value = i - 5
Case 4
MsgBox Str(i) + "行目の適用内容が抜けています。" + CHR(13) + "もう一度確認してください。"
MainList.ClickPosX = 3
MainList.ClickPosY = i
MainListScrollBar.Value = i - 5
Case 5
MsgBox Str(i) + "行目の貸方科目が抜けています。" + CHR(13) + "もう一度確認してください。"
MainList.ClickPosX = 5
MainList.ClickPosY = i
MainListScrollBar.Value = i - 5
Case 6
MsgBox Str(i) + "行目の貸方金額が抜けています。" + CHR(13) + "もう一度確認してください。"
MainList.ClickPosX = 6
MainList.ClickPosY = i
MainListScrollBar.Value = i - 5
End Select
MainList.Refresh
If tErrorType = 0 Then
Return True
Else
Return False
End if
End Function
134217984
0
0
Boolean
ReadTekiyou
1
1754456063
134217984
Sub ReadTekiyou()
//適用内容の読み込み
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(false)
//ファイルを開くことができる（=tBinaryInputが存在している）なら
If tBinaryInput <> Nil Then
//ファイルの最後まで読みつづける
While tBinaryInput.EOF = False
//適用内容をButtonNameへ代入
SubButton.ButtonName(i,j) = Trim(tBinaryInput.ReadPString(Encodings.MacJapanese))
//ボタンの色をButtonColorへ代入
SubButton.ButtonColor(i,j) = Val(Trim(tBinaryInput.ReadPString(Encodings.MacJapanese))) + 1
//コード番号をButtonDataへ代入
SubButton.ButtonData1(i,j) = Trim(tBinaryInput.ReadPString(Encodings.MacJapanese))
//読み飛ばし
tBinaryInput.Position = tBinaryInput.Position + 33
If j = SubButton.RowCount Then
i = i + 1
j = 1
Else
j = j + 1
End If
If i > SubButton.ColCount Then
Exit
End If
Wend
tBinaryInput.Close
End If
End If
End Sub
134217984
0
0
SaveTekiyou
1
223465471
134217984
Sub SaveTekiyou()
//適用内容の保存
Dim tFolderItem as FolderItem
Dim tBinaryOutput 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
//そのファイルを書き込みモードで開く
tBinaryOutput = tFolderItem.CreateBinaryFile("TEXT")
//ファイルを開くことができる（=tTextInputが存在している）なら
If tBinaryOutput <> Nil Then
While SubButton.ButtonName(i,j) <> "" Or SubButton.ButtonColor(i,j) <> 0 Or SubButton.ButtonData1(i,j) <> ""
//適用内容をButtonNameへ代入
tBinaryOutput.WritePString ConvertEncoding(SpaceSup(SubButton.ButtonName(i,j),38),Encodings.MacJapanese)
//ボタンの色をButtonColorへ代入
tBinaryOutput.WritePString ConvertEncoding(SpaceSup(Str(SubButton.ButtonColor(i,j) - 1),2),Encodings.MacJapanese)
//コード番号をButtonDataへ代入
tBinaryOutput.WritePString ConvertEncoding(SpaceSup(SubButton.ButtonData1(i,j),4),Encodings.MacJapanese)
//予備空間
tBinaryOutput.WritePString ConvertEncoding(SpaceSup("",30),Encodings.MacJapanese)
//改行コード
tBinaryOutput.WritePString CHR(13)
If j = MainButton.RowCount Then
i = i + 1
j = 1
Else
j = j + 1
End If
Wend
tBinaryOutput.Close
End If
End If
End Sub
134217984
0
0
ReadKamoku
1
360806399
134217984
Sub ReadKamoku()
//勘定科目の読み込み
Dim tFolderItem as FolderItem
Dim tBinaryInput as BinaryStream
Dim tReadString as String
Dim i as Integer
Dim j as Integer
Dim k as Integer
i = 1
j = 1
k = 1
//適用内容ファイルのある場所（=FolderItem）を得る
tFolderItem = GetFolderItem(gBasicPath + "設定:勘定科目")
//ファイルが存在している（=FolderItemが存在している）なら
If tFolderItem <> Nil Then
//そのファイルを読みモードで開く
tBinaryInput = tFolderItem.OpenAsBinaryFile(false)
//ファイルを開くことができる（=tBinaryInputが存在している）なら
If tBinaryInput <> Nil Then
//ファイルの最後まで読みつづける
While tBinaryInput.EOF = False
//勘定科目をButtonNameへ代入
MainButton.ButtonName(i,j) = Trim(tBinaryInput.ReadPString(Encodings.MacJapanese))
//ボタンの色をButtonColorへ代入
MainButton.ButtonColor(i,j) = Val(Trim(tBinaryInput.ReadPString(Encodings.MacJapanese))) + 1
//コード番号をButtonData1へ代入
MainButton.ButtonData1(i,j) = Trim(tBinaryInput.ReadPString(Encodings.MacJapanese))
//科目番号をButtonData1へ代入
MainButton.ButtonData2(i,j) = Trim(tBinaryInput.ReadPString(Encodings.MacJapanese))
If MainButton.ButtonName(i,j) <> "***" Then
gKamoku(k) = MainButton.ButtonName(i,j)
gKamokuType(k) = MainButton.ButtonColor(i,j)
gKamokuNo(k) = Val(MainButton.ButtonData1(i,j))
k = k + 1
End If
//読み飛ばし
tBinaryInput.Position = tBinaryInput.Position + 22
j = j + 1
If j = MainButton.RowCount + 1Then
i = i + 1
j = 1
End If
If i > MainButton.ColCount Then
Exit
End If
Wend
tBinaryInput.Close
End If
End If
End Sub
134217984
0
0
SaveMototyou
1
942794751
134217984
Sub SaveMototyou()
//現在未使用
//元帳の保存
Dim tFolderItem as FolderItem
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 tKariDouble as Double
Dim tKasiDouble as Double
Dim tKariCount as Integer
Dim tKasiCount as Integer
Dim i as Integer
Dim j as Integer
//元帳データのFolderItemを得る
tFolderItem = MakeFolder(gBasicPath + "振替伝票データ")
tFolderItem = MakeFolder(tFolderItem.AbsolutePath + NthField(DateField.Text,"/",1))
tFolderItem = MakeFolder(tFolderItem.AbsolutePath + "元帳")
tFolderItem = MakeFolder(tFolderItem.AbsolutePath + NthField(DateField.Text,"/",2) + "月")
//元帳フォルダに入っている元帳データファイルから
//これから保存する日付けのデータを消去する
For i = 1 to tFolderItem.Count
ReadMototyouMakeMototyou(tFolderItem.Item(i),DateField.Text)
Next
i = 1
While MainList.Cell(i,3) <> ""
j = 1
tKariDouble = 0
tKasiDouble = 0
tKariCount = 0
tKasiCount = 0
Do
tDateString(j) = DateField.Text
tKariKingaku(j) = Format(ChangeSequence(MainList.Cell(i,1)),"-,#")
tKariDouble = tKariDouble + ChangeSequence(MainList.Cell(i,1))
tKariKamoku(j) = Trim(MainList.Cell(i,2))
If tKariKamoku(j) <> "" Then
tKariCount = tKariCount + 1
End If
tTekiyouString(j) = "1"
tBangouString(j) = Trim(MainList.Cell(i,3))
tKasiKamoku(j) = Trim(MainList.Cell(i,4))
If tKasiKamoku(j) <> "" Then
tKasiCount = tKasiCount + 1
End If
tKasiKingaku(j) = Format(ChangeSequence(MainList.Cell(i,5)),"-,#")
tKasiDouble = tKasiDouble + ChangeSequence(MainList.Cell(i,5))
i = i + 1
If tKariDouble = tKasiDouble Then
Exit
Else
j = j + 1
End If
Loop
If tKariCount = 1 And tKasiCount = 1 Then
//１対１
WriteMototyouFile tKariKamoku(1),tDateString(1),tKasiKamoku(1),tTekiyouString(1),tBangouString(1),tKariKingaku(1),"0"
WriteMototyouFile tKasiKamoku(1),tDateString(1),tKariKamoku(1),tTekiyouString(1),tBangouString(1),"0",tKasiKingaku(1)
ElseIf tKariCount > 1 And tKasiCount = 1 Then
//複数対１
For j = 1 to tKariCount
WriteMototyouFile tKariKamoku(j),tDateString(j),tKasiKamoku(1),tTekiyouString(j),tBangouString(j),tKariKingaku(j),"0"
Next
WriteMototyouFile tKasiKamoku(1),tDateString(1),"諸口",tTekiyouString(1),tBangouString(1),"0",tKasiKingaku(1)
ElseIf tKariCount = 1 And tKasiCount > 1 Then
//１対複数
WriteMototyouFile tKariKamoku(1),tDateString(1),"諸口",tTekiyouString(1),tBangouString(1),tKariKingaku(1),"0"
For j = 1 to tKasiCount
WriteMototyouFile tKasiKamoku(j),tDateString(j),tKariKamoku(1),tTekiyouString(j),tBangouString(j),"0",tKasiKingaku(j)
Next
ElseIf tKariCount > 1 And tKasiCount > 1 Then
//複数対複数
For j = 1 to tKariCount
WriteMototyouFile tKariKamoku(j),tDateString(j),"諸口",tTekiyouString(j),tBangouString(j),tKariKingaku(j),"0"
Next
For j = 1 to tKasiCount
WriteMototyouFile tKasiKamoku(j),tDateString(j),"諸口",tTekiyouString(j),tBangouString(j),"0",tKasiKingaku(j)
Next
End If
Wend
End Sub
134217984
0
0
WriteMototyouFile
1
756568063
134217984
Sub WriteMototyouFile(tFileName as String,tDate as String,tKamoku as String,tTekiyou as String,tBangou as String,tKari as String,tKasi as String)
//現在未使用
//元帳の出力
Dim tFolderItem as FolderItem
Dim tBinaryOutput as BinaryStream
Dim tReadString as String
//元帳データのFolderItemを得る
tFolderItem = MakeFolder(gBasicPath + "振替伝票データ")
tFolderItem = MakeFolder(tFolderItem.AbsolutePath + NthField(DateField.Text,"/",1))
tFolderItem = MakeFolder(tFolderItem.AbsolutePath + "元帳")
tFolderItem = MakeFolder(tFolderItem.AbsolutePath + NthField(tDate,"/",2) + "月")
tFolderItem = GetFolderItem(tFolderItem.AbsolutePath + tFileName)
If tFolderItem <> Nil Then
//元帳データファイルを開く
tBinaryOutput = tFolderItem.OpenAsBinaryFile(True)
If tBinaryOutput = Nil Then
tBinaryOutput = tFolderItem.CreateBinaryFile("TEXT")
End If
//テンポラリファイルを開く
If tBinaryOutput <> Nil Then
tBinaryOutput.LittleEndian = True
tBinaryOutput.Position = tBinaryOutput.Length
tBinaryOutput.WritePString SpaceSup(tDate,10)
tBinaryOutput.WritePString SpaceSup(tKamoku,12)
tBinaryOutput.WritePString SpaceSup(tTekiyou,38)
tBinaryOutput.WritePString SpaceSup(tBangou,6)
If tKari <> "0" Then
tBinaryOutput.WritePString SpaceSup(tKari,14)
Else
tBinaryOutput.WritePString SpaceSup("",14)
End If
If tKasi <> "0" Then
tBinaryOutput.WritePString SpaceSup(tKasi,14)
Else
tBinaryOutput.WritePString SpaceSup("",14)
End If
tBinaryOutput.WritePString SpaceSup("",41)
tBinaryOutput.WritePString CHR(13)
tBinaryOutput.Close
End If
End If
End Sub
134217984
0
0
tFileName as String,tDate as String,tKamoku as String,tTekiyou as String,tBangou as String,tKari as String,tKasi as String
ReadMototyouMakeMototyou
1
849076223
134217984
Sub ReadMototyouMakeMototyou(tFileName as FolderItem,tDate as String)
//現在未使用
//元帳データから、今保存のかけられた日付のデータのみ取り除く
Dim tTempFolderItem as FolderItem
Dim tBinaryOutput as BinaryStream
Dim tTempBinaryOutput as BinaryStream
Dim tReadString as String
//元帳データのテンポラリのFolderItemを得る
tTempFolderItem = MakeFolder(gBasicPath + "振替伝票データ")
tTempFolderItem = MakeFolder(tTempFolderItem.AbsolutePath + NthField(DateField.Text,"/",1))
tTempFolderItem = MakeFolder(tTempFolderItem.AbsolutePath + "元帳")
tTempFolderItem = GetFolderItem(tTempFolderItem.AbsolutePath + NthField(tDate,"/",2) + "月:テンポラリファイル")
If tFileName <> Nil And tTempFolderItem <> Nil Then
//元帳データファイルを開く
tBinaryOutput = tFileName.OpenAsBinaryFile(false)
//テンポラリファイルを開く
tTempBinaryOutput = tTempFolderItem.CreateBinaryFile("TEXT")
If tBinaryOutput <> Nil And tTempBinaryOutput <> Nil Then
tBinaryOutput.LittleEndian = True
tTempBinaryOutput.LittleEndian = True
While tBinaryOutput.EOF = False
tReadString = Trim(tBinaryOutput.ReadPString(Encodings.MacJapanese))
If tReadString <> tDate And tReadString <> "" Then
tTempBinaryOutput.WritePString SpaceSup(tReadString,10)
tTempBinaryOutput.WritePString SpaceSup(Trim(tBinaryOutput.ReadPString(Encodings.MacJapanese)),12)
tTempBinaryOutput.WritePString SpaceSup(Trim(tBinaryOutput.ReadPString(Encodings.MacJapanese)),38)
tTempBinaryOutput.WritePString SpaceSup(Trim(tBinaryOutput.ReadPString(Encodings.MacJapanese)),6)
tTempBinaryOutput.WritePString SpaceSup(Trim(tBinaryOutput.ReadPString(Encodings.MacJapanese)),14)
tTempBinaryOutput.WritePString SpaceSup(Trim(tBinaryOutput.ReadPString(Encodings.MacJapanese)),14)
tTempBinaryOutput.WritePString SpaceSup("",41)
tTempBinaryOutput.WritePString CHR(13)
tBinaryOutput.Position = tBinaryOutput.Position + 44
Else
tBinaryOutput.Position = tBinaryOutput.Position + 133
End If
Wend
tBinaryOutput.Close
tTempBinaryOutput.Close
End If
End If
tReadString = tFileName.Name
tFileName.Delete
tTempFolderItem.Name = tReadString
End Sub
134217984
0
0
tFileName as FolderItem,tDate as String
SaveEvent
1
361631743
134217984
Function SaveEvent() As Boolean
//保存の全過程
Dim tFolderItem as FolderItem
Dim tBinaryOutput as BinaryStream
Dim tDateString as String
Dim i as Integer
Dim tBoolean as Boolean
ProgressBar1.visible = true // プログレスバー表示
ProgressBar1.value = 0 //※
tBoolean = ErrorCheck()
If tBoolean = True Then
tDateString = DateField.Text
MainListField.Top = -100
Canvas1.Visible = True
Canvas1.Refresh
SaveAccount()//振伝を保存（新しいキャッシュファイルに保存して古いファイルと入れ替える保存方法）
//DoLoopで変更された月から順に繰り越しを計算し直す。2005/1/14このループ内修正
Do
tDateString = IncMonth(tDateString)//YY/MM/DDを受けて一月進める
//今月の振伝データのFolderItemを得る
tFolderItem = MakeFolder(gBasicPath + "振替伝票データ")
tFolderItem = MakeFolder(tFolderItem.AbsolutePath + NthField(tDateString,"/",1))
tFolderItem = GetFolderItem(tFolderItem.AbsolutePath + "振伝" + Left(tDateString,7))
//FolderItemが得られたら
If tFolderItem <> Nil Then
ProgressBar1.value = ProgressBar1.value+1//※
ProgressBar1.Refresh
ReadAccountMakeTransfer(tDateString)
tBinaryOutput = tFolderItem.OpenAsBinaryFile(True)
If tBinaryOutput <> Nil Then
tBinaryOutput.Close
Else
Exit
End If
Else
MsgBox "SaveEventエラー:振替伝票データの振伝ファイルが開けません...."
End If
Loop
ClearTransfer()
Canvas1.Visible = False
Canvas1.Refresh
gSaveCheak = "保存済"
End If
ProgressBar1.value = 1500//※
ProgressBar1.Refresh
ProgressBar1.visible = false // プログレスバー非表示
Return tBoolean
End Function
134217984
0
0
Boolean
SetPreferencesFolder
1
616173567
134217984
Sub SetPreferencesFolder()
//初期設定フォルダへ自分（=振替伝票）がどこのパスにいるのかを出力する
Dim tFolderItem as FolderItem
Dim tBinaryOutput as BinaryStream
tFolderItem = GetFolderItem(SpecialFolder.Preferences.AbsolutePath + "振替伝票初期設定ファイル")
//FolderItemが得られたら
If tFolderItem <> Nil Then
tBinaryOutput = tFolderItem.CreateBinaryFile("TEXT")
If tBinaryOutput <> Nil Then
tBinaryOutput.WritePString gBasicPath
End If
tBinaryOutput.Close
End If
End Sub
134217984
0
0
ReadOutputAccount
1
153808895
134217984
Function ReadOutputAccount(tLineInteger as Integer) As Integer
//区分対応終了
//販売管理より出力された振伝を読み込む
Dim tFolderItemA as FolderItem
Dim tFolderItem as FolderItem
Dim tBinaryInput as BinaryStream
Dim i as Integer
Dim FI as FolderItem
Dim FIA as FolderItem
Dim d as Date
Dim sollo as String
Dim Damy(999) As String
D = new date
FI = MakeFolder(gBasicPath + "出力された振替伝票（済）")
FIA = MakeFolder(gBasicPath + "出力された振替伝票（コピー）")
//売上伝票Indexファイルを作成する
tFolderItemA = MakeFolder(gBasicPath + "出力された振替伝票")
tFolderItem = GetFolderItem(tFolderItemA.AbsolutePath + "振替伝票" + DateField.Text)
If tFolderItem <> Nil Then
IF tFolderItem.Exists THEN//====================================================
tFolderItem.CopyFileTo FIA //出力された振替伝票データを出力された振替伝票データ（コピー）にコピー
//コピー後に名前を変える
If FIA.Exists Then
FIA = GetFolderItem(FIA.AbsolutePath + "振替伝票" + DateField.Text)
FIA.name = FIA.name+"-"+STR(D.day)+"/"+STR(D.Hour)+STR(D.Minute)+STR(D.Second)+"R"
Else
//=========もう一度==========○
If FIA.Exists Then
FIA = GetFolderItem(FIA.AbsolutePath + "振替伝票" + DateField.Text)
FIA.name = FIA.name+"-"+STR(D.day)+"/"+STR(D.Hour)+STR(D.Minute)+STR(D.Second)+"R"
Else
MsgBox "出力された振替伝票（コピー）のフォルダアイテムが見つかりません"
End If
//========================○
End If
Else
//=========もう一度==========●
tFolderItemA = MakeFolder(gBasicPath + "出力された振替伝票")
tFolderItem = GetFolderItem(tFolderItemA.AbsolutePath + "振替伝票" + DateField.Text)
IF tFolderItem.Exists THEN
tFolderItem.CopyFileTo FIA //出力された振替伝票データを出力された振替伝票データ（コピー）にコピー
//コピー後に名前を変える
If FIA.Exists Then
FIA = GetFolderItem(FIA.AbsolutePath + "振替伝票" + DateField.Text)
FIA.name = FIA.name+"-"+STR(D.day)+"/"+STR(D.Hour)+STR(D.Minute)+STR(D.Second)+"R"
Else
//=========もう一度==========○
If FIA.Exists Then
FIA = GetFolderItem(FIA.AbsolutePath + "振替伝票" + DateField.Text)
FIA.name = FIA.name+"-"+STR(D.day)+"/"+STR(D.Hour)+STR(D.Minute)+STR(D.Second)+"R"
Else
MsgBox "出力された振替伝票（コピー）のフォルダアイテムが見つかりません"
End If
//========================○
End If
End If
//=========================●
End If//=====================================================================
tBinaryInput = tFolderItem.OpenAsBinaryFile(false)
If tBinaryInput <> Nil Then
tBinaryInput.LittleEndian = True
i = tLineInteger
While tBinaryInput.EOF = False
//日付
If DateField.Text = tBinaryInput.ReadPString(Encodings.MacJapanese) Then
i = i + 1
//借方金額
MainList.Cell(i,1) = SpaceSup(Trim(tBinaryInput.ReadPString(Encodings.MacJapanese)),13)
//借方科目番号
MainList.Cell(i,8) = Trim(tBinaryInput.ReadPString(Encodings.MacJapanese))
//借方科目
MainList.Cell(i,2) = Trim(tBinaryInput.ReadPString(Encodings.MacJapanese))
If MainList.Cell(i,8) = "" Then
MainList.Cell(i,8) = KamokuNumber(MainList.Cell(i,2))
End If
//適用
MainList.Cell(i,3) = Trim(tBinaryInput.ReadPString(Encodings.MacJapanese))
//番号
MainList.Cell(i,4) = Trim(tBinaryInput.ReadPString(Encodings.MacJapanese))
//貸方科目番号
MainList.Cell(i,9) = Trim(tBinaryInput.ReadPString(Encodings.MacJapanese))
//貸方科目
MainList.Cell(i,5) = Trim(tBinaryInput.ReadPString(Encodings.MacJapanese))
If MainList.Cell(i,9) = "" Then
MainList.Cell(i,9) = KamokuNumber(MainList.Cell(i,5))
End If
//貸方金額
MainList.Cell(i,6) = SpaceSup(Trim(tBinaryInput.ReadPString(Encodings.MacJapanese)),13)
//区分
Damy(i) = Trim(tBinaryInput.ReadPString(Encodings.MacJapanese))
If Damy(i) <> "" Then
//予備空間 改行
tBinaryInput.Position = tBinaryInput.Position + 34
Else
//改行
//tBinaryInput.Position = tBinaryInput.Position + 2//上の行をコメントして此の行を追加
tBinaryInput.Position = tBinaryInput.Position + 34
End If
Else
//予備空間 改行
tBinaryInput.Position = tBinaryInput.Position + 149
End If
Wend
tBinaryInput.Close
IF tFolderItem.Exists THEN
//=====================================================================
Sollo = tFolderItem.name+"-"+STR(D.day)+"/"+STR(D.Hour)+STR(D.Minute)+STR(D.Second)+"R"
tFolderItem.name = Sollo
tFolderItem.MoveFileTo FI //出力された振替伝票データを出力された振替伝票データ（済）に移動
//=====================================================================
END IF
End If
End If
Return i
End Function
134217984
0
0
tLineInteger as Integer
Integer
ClearOutputAccount
1
316602367
134217984
Sub ClearOutputAccount()
//区分対応終了
//売上伝票Indexファイルを作成する
Dim tFolderItem as FolderItem
tFolderItem = MakeFolder(gBasicPath + "出力された振替伝票")
tFolderItem = GetFolderItem(tFolderItem.AbsolutePath + "振替伝票" + DateField.Text)
If tFolderItem <> Nil Then
tFolderItem.Delete
End If
End Sub
134217984
0
0
KamokuNumber
1
1077221375
134217984
Function KamokuNumber(tKamoku as String) As String
//科目の内部処理番号を得る
Dim tString as String
Dim i as Integer
Dim j as Integer
Dim k as Integer
i = 1
j = 1
For k = 1 to 135
If MainButton.ButtonName(i,j) = tKamoku Then
tString = MainButton.ButtonData1(i,j)
Exit
Else
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
End If
Next
Return tString
End Function
134217984
0
0
tKamoku as String
String
SetTotal
1
331259903
134217984
Sub SetTotal()
//区分対応終了
//総合計を計算し出力する
Dim i as Integer
Dim tKariDouble as Double
Dim tKasiDouble as Double
For i = 1 to 500
If MainList.Cell(i,3) <> "" Then
tKariDouble = tKariDouble + ChangeSequence(Trim(MainList.Cell(i,1)))
tKasiDouble = tKasiDouble + ChangeSequence(Trim(MainList.Cell(i,6)))
Else
Exit
End If
Next
If tKariDouble = tKasiDouble Then
KariTotal.TextColor = RGB(0,0,0)
KasiTotal.TextColor = RGB(0,0,0)
Else
KariTotal.TextColor = RGB(255,0,0)
KasiTotal.TextColor = RGB(255,0,0)
End If
KariTotal.Text = Format(tKariDouble,"-,#")
KasiTotal.Text = Format(tKasiDouble,"-,#")
MainList.aListRefresh
End Sub
134217984
0
0
SetKamoku
1
1145970687
134217984
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
134217984
0
0
tKamoku as String
String
AprilSaveTransfer
1
638625791
134217984
Sub AprilSaveTransfer(tIncDate as String)
//繰越データの保存
Dim tFolderItemInc as FolderItem
Dim tBinaryOutputInc as BinaryStream
Dim i as Integer
//来月の繰越データのFolderItemを得る
tFolderItemInc = MakeFolder(gBasicPath + "振替伝票データ")
tFolderItemInc = MakeFolder(tFolderItemInc.AbsolutePath + NthField(tIncDate,"/",1))
tFolderItemInc = GetFolderItem(tFolderItemInc.AbsolutePath + "繰越" + LeftB(tIncDate,7))
//FolderItemが得られたら
If tFolderItemInc <> Nil Then
//振伝データファイルを作成する
tBinaryOutputInc = tFolderItemInc.CreateBinaryFile("TEXT")
//ファイルが開けたら
If tBinaryOutputInc <> Nil Then
tBinaryOutputInc.LittleEndian = True
For i = 1 to 135
If gKamoku(i) <> "" And gKamoku(i) <> "***" Then
If gKamokuType(i) = 1 Then
//資産
tBinaryOutputInc.WritePString SpaceSup(gKamoku(i),12)
tBinaryOutputInc.WritePString SpaceSup(Format(gKingaku(gKamokuNo(i),1) - gKingaku(gKamokuNo(i),2),"#"),14)
tBinaryOutputInc.WritePString SpaceSup("0",14)
tBinaryOutputInc.WritePString SpaceSup("",34)
tBinaryOutputInc.WritePString CHR(13)
gKingaku(i,1) = gKingaku(gKamokuNo(i),1) - gKingaku(gKamokuNo(i),2)
gKingaku(i,2) = 0
ElseIF gKamokuType(i) = 2 Or gKamokuType(i) = 3 Then
//負債、資本
tBinaryOutputInc.WritePString SpaceSup(gKamoku(i),12)
tBinaryOutputInc.WritePString SpaceSup("0",14)
tBinaryOutputInc.WritePString SpaceSup(Format(gKingaku(gKamokuNo(i),1) - gKingaku(gKamokuNo(i),2),"#"),14)
tBinaryOutputInc.WritePString SpaceSup("",34)
tBinaryOutputInc.WritePString CHR(13)
gKingaku(i,1) = 0
gKingaku(i,2) = gKingaku(gKamokuNo(i),2) - gKingaku(gKamokuNo(i),1)
Else
//それ以外
tBinaryOutputInc.WritePString SpaceSup(gKamoku(i),12)
tBinaryOutputInc.WritePString SpaceSup("0",14)
tBinaryOutputInc.WritePString SpaceSup("0",14)
tBinaryOutputInc.WritePString SpaceSup("",34)
tBinaryOutputInc.WritePString CHR(13)
gKingaku(i,1) = 0
gKingaku(i,2) = 0
End If
End If
Next
tBinaryOutputInc.Close
End If
End If
End Sub
134217984
0
0
tIncDate as String
TRTrans
1
862046207
134217984
Sub TRTrans()
//販売管理より出力された振伝を読み込む
Dim tFolderItem as FolderItem
Dim tFolderItemA as FolderItem
Dim LtBinaryInput as BinaryStream
Dim LtBinaryOutput as BinaryStream
Dim i as Integer
Dim Kam1(1000) as String//借方金額
Dim Kam2(1000) as String//借方科目
Dim Kam3(1000) as String//適用
Dim Kam4(1000) as String//番号
Dim Kam5(1000) as String//貸方科目
Dim Kam6(1000) as String//貸方金額
Dim Kam7(1000) as String//借方科目番号
Dim Kam8(1000) as String//貸方科目番号
Dim KountA as Integer
Dim KountB as Integer
Dim LtKingaku as String
Dim LtKamoku as String
Dim Damy as String
Dim count as Integer
Dim K as Integer
dim tstring as string
tFolderItemA = MakeFolder(gBasicPath + "出力された振替伝票")
If tFolderItemA <> Nil Then
IF tFolderItemA.Count <> 0 THEN
count =tFolderItemA.Count
For K = 1 to count//★★
//売上伝票Indexファイルを作成する
tFolderItem = MakeFolder(gBasicPath + "出力された振替伝票")
tFolderItem = GetFolderItem(tFolderItem.AbsolutePath + tFolderItemA.Item(K).Name)
If tFolderItem <> Nil Then//★●
LtBinaryInput = tFolderItem.OpenAsBinaryFile(false)
If LtBinaryInput <> Nil Then//◎
LtBinaryInput.LittleEndian = True
i = 0
While LtBinaryInput.EOF = False
//日付
tstring = LtBinaryInput.ReadPString(Encodings.MacJapanese)
If Right(tFolderItemA.Item(K).Name,10) = tstring Then
i = i + 1
KountB = i
//借方金額
Kam1(i) = SpaceSup(Trim(LtBinaryInput.ReadPString(Encodings.MacJapanese)),13)
//借方科目番号
Kam7(i) = Trim(LtBinaryInput.ReadPString(Encodings.MacJapanese))
//借方科目
Kam2(i) = Trim(LtBinaryInput.ReadPString(Encodings.MacJapanese))
If Kam7(i) = "" Then
Kam7(i) = KamokuNumber(Kam2(i))
End If
//適用
Kam3(i) = Trim(LtBinaryInput.ReadPString(Encodings.MacJapanese))
//番号
Kam4(i) = Trim(LtBinaryInput.ReadPString(Encodings.MacJapanese))
//貸方科目番号
Kam8(i) = Trim(LtBinaryInput.ReadPString(Encodings.MacJapanese))
//貸方科目
Kam5(i) = Trim(LtBinaryInput.ReadPString(Encodings.MacJapanese))
If Kam8(i) = "" Then
Kam8(i) = KamokuNumber(Kam5(i))
End If
//貸方金額
Kam6(i) = SpaceSup(Trim(LtBinaryInput.ReadPString(Encodings.MacJapanese)),13)
//予備空間 改行
LtBinaryInput.Position = LtBinaryInput.Position + 37
Else
//予備空間 改行
LtBinaryInput.Position = LtBinaryInput.Position + 149
End If
Wend
LtBinaryInput.Close
KountA = KountB
KountB = 1
//今月の振伝データのFolderItemを得る
tFolderItem = MakeFolder(gBasicPath + "振替伝票データ")
tFolderItem = MakeFolder(tFolderItem.AbsolutePath + NthField(Right(tFolderItemA.Item(K).Name,10),"/",1))
tFolderItem = GetFolderItem(tFolderItem.AbsolutePath + "振伝" + Left(Right(tFolderItemA.Item(K).Name,10),7))
If tFolderItem <> Nil Then//○
//振伝データファイルを開く
LtBinaryOutput = tFolderItem.OpenAsBinaryFile(True)
//もし、存在しなければ作成する
If LtBinaryOutput = Nil Then//========================
LtBinaryOutput = tFolderItem.CreateBinaryFile("TEXT")
If LtBinaryOutput <> Nil Then//●
LtBinaryOutput.LittleEndian = True
LtBinaryOutput.Position = 0
For i = 1 to 15000//★
Damy = Trim(LtBinaryOutput.ReadPString(Encodings.MacJapanese))
If Damy = "" Then
//日付
LtBinaryOutput.WritePString SpaceSup(Right(tFolderItemA.Item(K).Name,10),10)
//借方金額
LtKingaku = Trim(Kam1(KountB))
Damy = Trim(Kam1(KountB))
LtBinaryOutput.WritePString SpaceSup(LtKingaku,14)
//借方科目番号
LtKamoku = Trim(Kam7(KountB))
LtBinaryOutput.WritePString SpaceSup(LtKamoku,4)
//借方科目
LtBinaryOutput.WritePString SpaceSup(Trim(Kam2(KountB)),12)
//適用
LtBinaryOutput.WritePString SpaceSup(Trim(Kam3(KountB)),38)
//番号
LtBinaryOutput.WritePString SpaceSup(Trim(Kam4(KountB)),6)
//貸方科目番号
LtKamoku = Trim(Kam8(KountB))
LtBinaryOutput.WritePString SpaceSup(LtKamoku,4)
//貸方科目
LtBinaryOutput.WritePString SpaceSup(Trim(Kam5(KountB)),12)
//貸方金額
LtKingaku = Trim(Kam6(KountB))
LtBinaryOutput.WritePString SpaceSup(LtKingaku,14)
//区分
LtBinaryOutput.WritePString SpaceSup("1",2)
//予備空間
LtBinaryOutput.WritePString SpaceSup("",31)
//改行
LtBinaryOutput.WritePString CHR(13)
KountB = KountB + 1
IF KountB = (KountA+1) THEN
i = 15000
END IF
Else
//読み飛ばし
LtBinaryOutput.Position = LtBinaryOutput.Position + 149// -11
End If
Next//★
LtBinaryOutput.Close
END IF//●
ELSE//当月の振替伝票がある
If LtBinaryOutput <> Nil Then//●
LtBinaryOutput.LittleEndian = True
For i = 1 to 15000//★
Damy = Trim(LtBinaryOutput.ReadPString(Encodings.MacJapanese))
If Damy = "" Then
LtBinaryOutput.Position = LtBinaryOutput.Position -2
LtBinaryOutput.WritePString CHR(13)
//日付
LtBinaryOutput.WritePString SpaceSup(Right(tFolderItemA.Item(K).Name,10),10)
//借方金額
LtKingaku = Trim(Kam1(KountB))
Damy = Trim(Kam1(KountB))
LtBinaryOutput.WritePString SpaceSup(LtKingaku,14)
//借方科目番号
LtKamoku = Trim(Kam7(KountB))
LtBinaryOutput.WritePString SpaceSup(LtKamoku,4)
//借方科目
LtBinaryOutput.WritePString SpaceSup(Trim(Kam2(KountB)),12)
//適用
LtBinaryOutput.WritePString SpaceSup(Trim(Kam3(KountB)),38)
//番号
LtBinaryOutput.WritePString SpaceSup(Trim(Kam4(KountB)),6)
//貸方科目番号
LtKamoku = Trim(Kam8(KountB))
LtBinaryOutput.WritePString SpaceSup(LtKamoku,4)
//貸方科目
LtBinaryOutput.WritePString SpaceSup(Trim(Kam5(KountB)),12)
//貸方金額
LtKingaku = Trim(Kam6(KountB))
LtBinaryOutput.WritePString SpaceSup(LtKingaku,14)
//区分
LtBinaryOutput.WritePString SpaceSup("1",2)
//予備空間
LtBinaryOutput.WritePString SpaceSup("",31)
//改行
LtBinaryOutput.WritePString CHR(13)
KountB = KountB + 1
IF KountB = (KountA+1) THEN
i = 15000
END IF
Else
//読み飛ばし
LtBinaryOutput.Position = LtBinaryOutput.Position + 149// -11
End If
Next//★
LtBinaryOutput.Close
END IF//●
End If//========================
END IF//○
End If//◎
End If//★●
Next//★★
END IF
END IF
End Sub
134217984
0
0
InsatuCount
1
930985983
134217984
InsatuCount As Integer
134217984
InsatuCount As Integer
0
0
InDay
1
275871743
134217984
InDay As Integer
134217984
InDay As Integer
0
0
OpenDay
1
1792016383
134217984
OpenDay As Integer
134217984
OpenDay As Integer
0
0
OpenMonth
1
505866239
134217984
OpenMonth As Integer
134217984
OpenMonth As Integer
0
0
OpenYear
1
1724911615
134217984
OpenYear As Integer
134217984
OpenYear As Integer
0
0
CellCheck
1
1073051647
134217984
CellCheck As Integer
134217984
CellCheck As Integer
0
0
CellCheck2
1
264808447
134217984
CellCheck2 As Integer
134217984
CellCheck2 As Integer
0
0
CRCheck
1
497528831
134217984
CRCheck As Boolean
134217984
CRCheck As Boolean
0
0
Settings
1
707909631
134217984
Settings As String
134217984
Settings As String
0
0
False
True
2
0
16777215
16777215
False
False
True
0
0
True
False
0
False
False
False
False
False
False
False
False
False
振替伝票
0
0
32000
32000
32000
32000
64
64
64
64
930
1114
MinimumWidth
1
Size
64
Integer
MinimumHeight
1
Size
64
Integer
MaximumWidth
1
Size
32000
Integer
MaximumHeight
1
Size
32000
Integer
Type
1
Frame
0
Types
Enum
0 - Document
1 - Movable Modal
2 - Modal Dialog
3 - Floating Window
4 - Plain Box
5 - Shadowed Box
6 - Rounded Window
7 - Global Floating Window
8 - Sheet Window
9 - Metal Window
11 - Modeless Dialog
HasCloseButton
1
Frame
True
Boolean
HasMaximizeButton
1
Frame
True
Boolean
HasMinimizeButton
1
Frame
True
Boolean
HasFullScreenButton
1
Frame
False
Boolean
DefaultLocation
1
Behavior
0
Locations
Enum
0 - Default
1 - Parent Window
2 - Main Screen
3 - Parent Window Screen
4 - Stagger
HasBackgroundColor
1
Background
False
Boolean
BackgroundColor
1
Background
&hFFFFFF
Color
Color
Name
1
ID
String
Interfaces
1
ID
String
Super
1
ID
String
Width
1
Position
600
Integer
Height
1
Position
400
Integer
Composite
1
Appearance
False
Boolean
Backdrop
1
Appearance
Picture
Title
1
Appearance
Untitled
String
Visible
1
Appearance
True
Boolean
FullScreen
1
Appearance
False
Boolean
MenuBarVisible
1
Appearance
True
Boolean
Resizeable
1
Appearance
True
Boolean
MacProcID
1
Appearance
0
Integer
MenuBar
1
Appearance
MenuBar
ImplicitInstance
1
Appearance
True
Boolean
InsatuCount
Behavior
Integer
InDay
Behavior
Integer
OpenDay
Behavior
Integer
OpenMonth
Behavior
Integer
OpenYear
Behavior
Integer
CellCheck
Behavior
Integer
CellCheck2
Behavior
Integer
CRCheck
Behavior
Boolean
Settings
Behavior
String
MultiLineEditor
PushButton
Action
1
761929727
134217984
Sub Action()
//Dim tWindow as PrintWindow
Dim tGraph as Graphics
Dim tPrintFlag as Boolean
Dim tPrintSetting as PrinterSetup
Dim kesuhizuke as String
Dim tFolderItem as FolderItem
Dim tBinaryOutput as BinaryStream
Dim i as Integer
Dim Damy as String
Dim tBoolean as Boolean
tBoolean = SaveEvent()//●データ保存●
//TRTrans //●自動リマインダー●
InDay = Val(Left(RightB(DateField.text,10),4)+Mid(RightB(DateField.text,10),6,2)+Right(RightB(DateField.text,10),2))
kesuhizuke = Trim(DateField.text)
If MainList.Cell(1,3) <> "" Then
//=========================================
If ErrorCheck() = True Then
tPrintSetting = New PrinterSetup
tPrintSetting.SetupString = Settings
tGraph = OpenPrinterDialog(tPrintSetting)
Else
End If
If tGraph <> Nil Then
SlipPrint(tGraph,0,50,"振 替 伝 票","")
Else
MsgBox "プリンタが開けませんでした"
End If
gScreenX = 0
gScreenY = 0
//もし印刷待ち書類の中に印刷された日付けがあったら消す
//===================メモ=====================
tFolderItem = MakeFolder(gBasicPath + "振替伝票データ")
tFolderItem = GetFolderItem(tFolderItem.AbsolutePath + "印刷待")
If tFolderItem <> Nil Then
//振伝データファイルを開く
tBinaryOutput = tFolderItem.OpenAsBinaryFile(True)
//もし、存在しなければ作成する
If tBinaryOutput = Nil Then
tBinaryOutput = tFolderItem.CreateBinaryFile("TEXT")
tBinaryOutput.Close
ELSE//存在する
If tBinaryOutput <> Nil Then
tBinaryOutput.LittleEndian = True
For i = 1 to 100
Damy = Trim(tBinaryOutput.ReadPString(Encodings.MacJapanese))
If Damy = "0000000000" OR Damy = ""Then
ELSE
IF Damy = kesuhizuke THEN
Damy = Trim(tBinaryOutput.ReadPString(Encodings.MacJapanese))
tBinaryOutput.Position = tBinaryOutput.Position - 13
tBinaryOutput.WritePString "0000000000"
tBinaryOutput.WritePString CHR(13)
i = 100
ELSE
Damy = Trim(tBinaryOutput.ReadPString(Encodings.MacJapanese))
END IF
END IF
NEXT
tBinaryOutput.Close
END IF
End If
END IF
//============================================
//===========================================
Else
Msgbox "データが無いので印刷できません。"
End If
End Sub
PushButton
Action
1
1827813375
134217984
Sub Action()
Dim tMsgWindow as MsgDlg
Dim tBoolean as Boolean
'If gSaveCheak = "未保存" Then
//tMsgWindow = New MsgDlg
//tMsgWindow.SetMessage "終了する前に変更内容を保存しますか？"
//tMsgWindow.setMode "保存"
//tMsgWindow.showmodal
//保存ならデータを保存し、保存しないなら保存せずに終了処理を続ける
//If tMsgWindow.QuitMode = "保存" Then
tBoolean = SaveEvent()//●データ保存●
//ElseIf tMsgWindow.QuitMode = "キャンセル" Then
//Return
//End If
'End If
If tBoolean = True Then
'SaveTekiyou()
Quit
Else
Return
End If
End Sub
PushButton
Action
1
178943999
134217984
Sub Action()
Dim tWindow as CalendarWindow
Dim tMsgWindow as MsgDlg
Dim tBoolean as Boolean
OpenYear = DateField.year
OpenMonth = DateField.Month
OpenDay = DateField.Day
//If gSaveCheak = "未保存" Then 必ず保存するようにコメント2007.5.22
tBoolean = SaveEvent()//●データ保存●
gSaveCheak = "保存済"
//End If
tWindow = New CalendarWindow
//ウィンドウの位置を調整する
if screen(0).width = 640 then
tWindow.Left = AccountManager.Left + AccountManager.Width - tWindow.Width - 1
Else
tWindow.Left = Me.Left + AccountManager.Left + 1
end if
tWindow.Top = Me.Top + Me.Height + AccountManager.Top + 1
tWindow.ShowModal
End Sub
DateFieldClass
aList
DropObject
1
1813895167
134217984
Sub DropObject(obj As DragItem, action As Integer)
msgbox obj.text
End Sub
CellChange
1
1143574527
134217984
Sub CellChange(Row as integer, Col as integer)
Dim tKarikataDouble as Double
Dim tKasikataDouble as Double
Dim i as Integer
//区分対応終了
IF CRCheck = False Then//リターンで入力の場合は処理をしない。
IF CellCheck2 = Row And CellCheck = Col Then
Else
//gSaveCheak = "未保存"
Select Case CellCheck
Case 1
tKarikataDouble = 0
tKasikataDouble = 0
//左右合計
For i = 0 to 500
If i = CellCheck2 Then
If CellCheck = 1 Then
tKarikataDouble = tKarikataDouble + ChangeSequence(MainListField.Text)
tKasikataDouble = tKasikataDouble + ChangeSequence(MainList.Cell(i,6))
ElseIf CellCheck = 6 Then
tKarikataDouble = tKarikataDouble + ChangeSequence(MainList.Cell(i,1))
tKasikataDouble = tKasikataDouble + ChangeSequence(MainListField.Text)
End If
Else
tKarikataDouble = tKarikataDouble + ChangeSequence(MainList.Cell(i,1))
tKasikataDouble = tKasikataDouble + ChangeSequence(MainList.Cell(i,6))
End If
Next
If tKarikataDouble = tKasikataDouble Then
KariTotal.TextColor = RGB(0,0,0)
KasiTotal.TextColor = RGB(0,0,0)
Else
KariTotal.TextColor = RGB(255,0,0)
KasiTotal.TextColor = RGB(255,0,0)
End If
KariTotal.Text = Format(tKarikataDouble,"-,#")
KasiTotal.Text = Format(tKasikataDouble,"-,#")
IF MainListField.Text <> "" Then
MainList.Cell(CellCheck2,CellCheck) = SpaceSup(Format(ChangeSequence(MainListField.Text),"-,#"),13)
End IF
Case 2
Case 3
IF MainListField.Text <> "" Then
MainList.Cell(CellCheck2,CellCheck) = Trim(MainListField.text)
End IF
Case 4
MainList.Cell(CellCheck2,CellCheck) = MainListField.Text
Case 5
MainList.Cell(CellCheck2,CellCheck) = MainListField.Text
Case 6
Case 7
tKarikataDouble = 0
tKasikataDouble = 0
//左右合計
For i = 0 to 500
If i = CellCheck2 Then
If CellCheck = 1 Then
tKarikataDouble = tKarikataDouble + ChangeSequence(MainListField.Text)
tKasikataDouble = tKasikataDouble + ChangeSequence(MainList.Cell(i,6))
ElseIf CellCheck = 7 Then
tKarikataDouble = tKarikataDouble + ChangeSequence(MainList.Cell(i,1))
tKasikataDouble = tKasikataDouble + ChangeSequence(MainListField.Text)
End If
Else
tKarikataDouble = tKarikataDouble + ChangeSequence(MainList.Cell(i,1))
tKasikataDouble = tKasikataDouble + ChangeSequence(MainList.Cell(i,6))
End If
Next
If tKarikataDouble = tKasikataDouble Then
KariTotal.TextColor = RGB(0,0,0)
KasiTotal.TextColor = RGB(0,0,0)
Else
KariTotal.TextColor = RGB(255,0,0)
KasiTotal.TextColor = RGB(255,0,0)
End If
KariTotal.Text = Format(tKarikataDouble,"-,#")
KasiTotal.Text = Format(tKasikataDouble,"-,#")
IF MainListField.Text <> "" Then
MainList.Cell(CellCheck2,CellCheck) = SpaceSup(Format(ChangeSequence(MainListField.Text),"-,#"),13)
End If
End Select
End IF
MainList.aListRefresh
End IF
//----------セルに入った-----------
Select Case Col
Case 1
If MainButton.Visible <> False Or SubButton.Visible <> False Then
gSaveCheak = "未保存"
MainButton.Visible = False
SubButton.Visible = False
End If
Case 2
If MainButton.Visible <> True Or SubButton.Visible <> False Then
gSaveCheak = "未保存"
MainButton.Visible = True
SubButton.Visible = False
End If
Case 3
If MainButton.Visible <> False Or SubButton.Visible <> True Then
gSaveCheak = "未保存"
MainButton.Visible = False
SubButton.Visible = True
End If
Case 4
If MainButton.Visible <> False Or SubButton.Visible <> False Then
gSaveCheak = "未保存"
MainButton.Visible = False
SubButton.Visible = False
End If
Case 5
If MainButton.Visible <> True Or SubButton.Visible <> False Then
gSaveCheak = "未保存"
MainButton.Visible = True
SubButton.Visible = False
End If
Case 6
If MainButton.Visible <> False Or SubButton.Visible <> False Then
gSaveCheak = "未保存"
MainButton.Visible = False
SubButton.Visible = False
End If
End Select
CellCheck = Col
CellCheck2 = Row
CRCheck = False
End Sub
MouseWheel
1
788580351
134217984
Function MouseWheel(X As Integer, Y As Integer, deltaX as Integer, deltaY as Integer) As Boolean
MainListScrollBar.value = MainListScrollBar.value+deltaY
End Function
TextField
KeyDown
1
1797636095
134217984
Function KeyDown(Key As String) As Boolean
//区分対応終了
Dim tKarikataDouble as Double
Dim tKasikataDouble as Double
Dim tClickInteger as Integer
Dim i as Integer
Dim j as Integer
//このフィールドでリターンがおされたら
If Asc(Key) = 3 Or Asc(Key) = 13 Then
CRCheck = true
//そのうえ、借り貸し金額フィールドだったとき
If MainList.ClickPosX = 1 Or MainList.ClickPosX = 6 Then
tKarikataDouble = 0
tKasikataDouble = 0
//左右合計
For i = 1 to 500
If i = MainList.ClickPosY Then
If MainList.ClickPosX = 1 Then
tKarikataDouble = tKarikataDouble + ChangeSequence(Me.Text)
tKasikataDouble = tKasikataDouble + ChangeSequence(MainList.Cell(i,6))
ElseIf MainList.ClickPosX = 6 Then
tKarikataDouble = tKarikataDouble + ChangeSequence(MainList.Cell(i,1))
tKasikataDouble = tKasikataDouble + ChangeSequence(Me.Text)
End If
Else
tKarikataDouble = tKarikataDouble + ChangeSequence(MainList.Cell(i,1))
tKasikataDouble = tKasikataDouble + ChangeSequence(MainList.Cell(i,6))
End If
Next
MainList.aListRefresh
If tKarikataDouble = tKasikataDouble Then
KariTotal.TextColor = RGB(0,0,0)
KasiTotal.TextColor = RGB(0,0,0)
Else
KariTotal.TextColor = RGB(255,0,0)
KasiTotal.TextColor = RGB(255,0,0)
End If
KariTotal.Text = Format(tKarikataDouble,"-,#")
KasiTotal.Text = Format(tKasikataDouble,"-,#")
//借り貸し科目の時
ElseIf MainList.ClickPosX = 2 Or MainList.ClickPosX = 5 Then
ElseIf MainList.ClickPosX = 3 Then
i = 1
j = 1
Do
If SubButton.ButtonData1(i,j) = Me.Text Then
Me.Text = SubButton.ButtonName(i,j)
Exit
End If
j = j + 1
If j = SubButton.RowCount + 1 Then
i = i + 1
j = 1
End If
If j = SubButton.RowCount And i = SubButton.ColCount Then
Exit
End If
Loop
End If
gSaveCheak = "未保存"
Select Case MainList.ClickPosX + 1
Case 1
If MainButton.Visible <> False Or SubButton.Visible <> False Then
MainButton.Visible = False
SubButton.Visible = False
End If
Case 2
If MainButton.Visible <> True Or SubButton.Visible <> False Then
MainButton.Visible = True
SubButton.Visible = False
End If
Case 3
If MainButton.Visible <> False Or SubButton.Visible <> True Then
MainButton.Visible = False
SubButton.Visible = True
End If
Case 4
If MainButton.Visible <> False Or SubButton.Visible <> False Then
MainButton.Visible = False
SubButton.Visible = False
End If
Case 5
If MainButton.Visible <> True Or SubButton.Visible <> False Then
MainButton.Visible = True
SubButton.Visible = False
End If
Case 6
If MainButton.Visible <> False Or SubButton.Visible <> False Then
MainButton.Visible = False
SubButton.Visible = False
End If
End Select
ElseIf Asc(Key) = 8 Or Asc(Key) = 27 Then
If MainList.ClickPosX = 2 Then
MainList.Cell(MainList.ClickPosY,8) = ""
ElseIf MainList.ClickPosX = 3 Then
MainList.Cell(MainList.ClickPosY,9) = ""
End If
MainList.Cell(MainList.ClickPosY,MainList.ClickPosX) = ""
End If
Return MainList.KeyPress(Key)
End Function
ScrollBar
ValueChanged
1
729747455
134217984
Sub ValueChanged()
MainList.topIndex = MainListScrollBar.value
MainListField.Enabled = False
MainList.aListRefresh
End Sub
Rectangle
Label
Rectangle
Label
Rectangle
Label
Canvas
ProgressBar
CellButton
MouseClick
1
659818495
134217984
Sub MouseClick(Col as Integer,Row as Integer)
//区分対応終了
gSaveCheak = "未保存"
MainListField.Text = LeftB(MainList.Cell(MainList.ClickPosY,3) + SubButton.ButtonName(Col,Row),38)
MainList.Cell(MainList.ClickPosY,3) = LeftB(MainList.Cell(MainList.ClickPosY,3) + SubButton.ButtonName(Col,Row),38)
MainList.aListRefresh
MainListField.Refresh
End Sub
CellButton
MouseClick
1
602879999
134217984
Sub MouseClick(Col as Integer,Row as Integer)
//区分対応終了
MainListField.Text = MainButton.ButtonName(Col,Row)
MainList.Cell(MainList.ClickPosY,MainList.ClickPosX) = MainButton.ButtonName(Col,Row)
MainListField.Text = MainButton.ButtonData1(Col,Row)
If MainList.ClickPosX = 2 Then
MainList.Cell(MainList.ClickPosY,8) = MainButton.ButtonData1(Col,Row)
ElseIf MainList.ClickPosX = 6 Then
MainList.Cell(MainList.ClickPosY,9) = MainButton.ButtonData1(Col,Row)
End If
MainList.aListRefresh
MainListField.Refresh
End Sub
PushButton
PushButton
True
False
False
印刷
False
True
Osaka
1.2e+1
0
32
-2147483648
False
901
False
False
False
False
0
PushButton2
0
PushButton
2
0
True
17
True
False
True
85
0
0
485832703
PushButton
PushButton
True
False
False
終了
False
True
Osaka
1.2e+1
0
32
-2147483648
False
1008
False
False
False
False
0
PushButton3
0
PushButton
3
0
True
17
True
False
True
85
1
0
1433241599
PushButton
PushButton
True
False
False
カレンダー
False
True
Osaka
1.2e+1
0
32
-2147483648
False
221
False
False
False
False
0
PushButton4
0
PushButton
4
0
True
17
True
False
True
80
2
0
714670079
DateFieldClass
DateFieldClass
True
True
False
False
16777215
False
0
0
True
アニト-Ｌ等幅
2.8e+1
0
True
32
-2147483648
False
22
False
False
False
False
0
0
DateField
False
True
0
DateFieldClass
5
0
True
0
0
17
True
False
True
0
187
0
3
0
2132930559
aList
aList
True
False
True
False
0
0
0
0
0
False
0
True
True
18
404
-2147483648
22
False
False
False
False
MainList
0
0
aList
6
0
True
アニト-Ｌ等幅
18
61
0
True
True
1055
4
0
1581254655
TextField
TextField
True
True
False
False
16777215
False
False
アニト-Ｌ等幅
1.8e+1
0
True
18
-2147483648
MainList
False
37
False
False
False
False
0
MainListField
False
False
0
TextField
0
0
True
0
0
122
True
False
False
80
5
0
667590655
ScrollBar
ScrollBar
True
True
True
True
404
-2147483648
1077
1
False
False
False
False
500
0
MainListScrollBar
10
0
ScrollBar
7
0
True
61
True
0
True
16
6
0
1913595903
Rectangle
Rectangle
True
1.00
0
True
13434828
24
-2147483648
162
False
False
False
False
Rectangle1
0
Rectangle
9
0
True
463
0
True
True
701
7
0
1381945343
Label
Label
True
False
True
アニト-Ｌ等幅
1.8e+1
0
22
-2147483648
Rectangle1
False
162
False
False
False
False
False
StaticText1
0
False
Label
0
0
True
合 計
2
0
465
False
False
True
701
8
0
810463231
Rectangle
Rectangle
True
1.00
0
True
13434828
24
-2147483648
22
False
False
False
False
Rectangle2
0
Rectangle
10
0
True
463
0
True
True
141
9
0
1218400255
Label
Label
True
False
True
アニト-Ｌ等幅
1.8e+1
0
24
-2147483648
False
19
False
False
False
False
False
KariTotal
0
False
Label
11
0
True
3
0
463
False
False
True
141
10
0
2142980095
Rectangle
Rectangle
True
1.00
0
True
13434828
24
-2147483648
862
False
False
False
False
Rectangle3
0
Rectangle
12
0
True
463
0
True
True
141
11
0
540002303
Label
Label
True
False
True
アニト-Ｌ等幅
1.8e+1
0
24
-2147483648
False
858
False
False
False
False
False
KasiTotal
0
False
Label
13
0
True
3
0
463
False
False
True
141
12
0
1721001983
Canvas
Canvas
True
False
True
False
0
False
False
True
96
-2147483648
123
False
False
False
False
Canvas1
0
Canvas
15
0
True
65
True
False
395
13
0
776929279
ProgressBar
ProgressBar
True
True
12
False
-2147483648
678
False
False
False
False
100
ProgressBar1
0
ProgressBar
12
0
True
27
True
0.00
False
204
14
0
2103902207
CellButton
CellButton
True
False
True
False
0
0
0.00
0.00
0
False
True
True
408
-2147483648
22
0
False
False
False
False
SubButton
0
0
0
0
CellButton
16
0
True
0
522
0
True
False
1071
15
0
822511615
CellButton
CellButton
True
False
True
False
0
0
0.00
0.00
0
False
True
True
408
-2147483648
22
0
False
False
False
False
MainButton
0
0
0
0
CellButton
17
0
True
0
502
0
True
False
1071
16
0
854714367
Menu
0
AboutWindow
36
1
Window
1
0
Open
1
233703423
134217984
Sub Open()
AppNameText.Text =AccountManager.Title
VerText.Text = gVersionString
End Sub
False
True
0
0
16777215
16777215
True
True
True
0
0
True
False
0
False
True
False
True
True
True
True
True
True
4
4
32000
32000
32000
32000
64
64
64
64
300
300
MinimumWidth
1
Size
64
Integer
MinimumHeight
1
Size
64
Integer
MaximumWidth
1
Size
32000
Integer
MaximumHeight
1
Size
32000
Integer
Type
1
Frame
0
Types
Enum
0 - Document
1 - Movable Modal
2 - Modal Dialog
3 - Floating Window
4 - Plain Box
5 - Shadowed Box
6 - Rounded Window
7 - Global Floating Window
8 - Sheet Window
9 - Metal Window
11 - Modeless Dialog
HasCloseButton
1
Frame
True
Boolean
HasMaximizeButton
1
Frame
True
Boolean
HasMinimizeButton
1
Frame
True
Boolean
HasFullScreenButton
1
Frame
False
Boolean
DefaultLocation
1
Behavior
0
Locations
Enum
0 - Default
1 - Parent Window
2 - Main Screen
3 - Parent Window Screen
4 - Stagger
HasBackgroundColor
1
Background
False
Boolean
BackgroundColor
1
Background
&hFFFFFF
Color
Color
Name
1
ID
String
Interfaces
1
ID
String
Super
1
ID
String
Width
1
Position
600
Integer
Height
1
Position
400
Integer
Composite
1
Appearance
False
Boolean
Backdrop
1
Appearance
Picture
Title
1
Appearance
Untitled
String
Visible
1
Appearance
True
Boolean
FullScreen
1
Appearance
False
Boolean
MenuBarVisible
1
Appearance
True
Boolean
Resizeable
1
Appearance
True
Boolean
MacProcID
1
Appearance
0
Integer
MenuBar
1
Appearance
MenuBar
ImplicitInstance
1
Appearance
True
Boolean
Canvas
Label
Label
PushButton
Action
1
1788633087
134217984
Sub Action()
Close
End Sub
Label
Label
Canvas
Canvas
True
False
True
False
0
False
True
64
-2147483648
75
False
False
False
False
Canvas1
Canvas
0
0
True
165
True
True
146
0
0
19290111
Label
Label
True
False
True
Osaka
1.2e+1
0
18
-2147483648
False
50
False
False
False
False
False
StaticText1
False
Label
1
0
True
Norizuki Industrial Arts Co.,Ltd.
0
124
True
False
True
200
1
0
275947519
Label
Label
True
False
True
Osaka
1.8e+1
0
35
-2147483648
False
50
False
False
False
False
False
AppNameText
False
Label
2
0
True
2
0
36
True
False
True
200
2
0
1410177023
PushButton
PushButton
True
False
False
OK
True
True
Osaka
1.2e+1
0
20
-2147483648
False
50
False
False
False
False
0
PushButton1
PushButton
3
0
True
247
True
False
True
200
3
0
589926399
Label
Label
True
False
True
Osaka
1.2e+1
0
16
-2147483648
False
50
False
False
False
False
False
StaticText3
False
Label
4
0
True
System開発
2
0
142
True
False
True
200
4
0
968998911
Label
Label
True
False
True
Osaka
1.2e+1
0
16
-2147483648
False
50
False
False
False
False
False
VerText
False
Label
5
0
True
2
0
76
True
False
True
200
5
0
631586815
Grobal
34
0
1
0
gVersionString
1
2115170303
134217984
gVersionString As String
134217984
gVersionString As String
0
0
gBasicPath
1
877213695
134217984
gBasicPath As String
134217984
gBasicPath As String
0
0
gKamoku(135)
1
59598847
134217984
gKamoku(135) As String
134217984
gKamoku(135) As String
0
0
gKingaku(135,2)
1
1393713151
134217984
gKingaku(135,2) As Double
134217984
gKingaku(135,2) As Double
0
0
gSaveCheak
1
1606590463
134217984
gSaveCheak As String
134217984
gSaveCheak As String
0
0
gKamokuType(135)
1
1772720127
134217984
gKamokuType(135) As Integer
134217984
gKamokuType(135) As Integer
0
0
gKougei(135,2)
1
1263110143
134217984
gKougei(135,2) As Double
134217984
gKougei(135,2) As Double
0
0
gSystem(135,2)
1
101941247
134217984
gSystem(135,2) As Double
134217984
gSystem(135,2) As Double
0
0
gFishing(135,2)
1
621676543
134217984
gFishing(135,2) As Double
134217984
gFishing(135,2) As Double
0
0
gManagement(135,2)
1
877699071
134217984
gManagement(135,2) As Double
134217984
gManagement(135,2) As Double
0
0
gKamokuNo(135)
1
1146638335
134217984
gKamokuNo(135) As Integer
134217984
gKamokuNo(135) As Integer
0
0
Name
1
ID
String
Index
1
ID
-2147483648
Integer
Super
1
ID
String
Left
1
Position
0
Integer
Top
1
Position
0
Integer
gVersionString
Behavior
String
MultiLineEditor
gBasicPath
Behavior
String
MultiLineEditor
gSaveCheak
Behavior
String
MultiLineEditor
TekiyouEditWindow
36
1
Window
1
0
Open
1
979664895
134217984
Sub Open()
Dim i as Integer
Dim j as Integer
Dim k as Integer
dim tstring as string
//適用リスト初期化
TekiyouList.columncount = 4
TekiyouList.RowCount = 10
TekiyouList.columnwidths "38,8,4"
TekiyouList.columnheaders "適用内容,ボタン色,番号"
TekiyouList.columnmasks "@,@,@"
TekiyouList.DrawUp "l,l,l"
TekiyouList.TextField = TekiyouListField
TekiyouList.ScrollBar = TekiyouListScrollBar
TekiyouList.EditMode = 1
TekiyouList.GetReady
i = 1
j = 1
For k = 1 to 45
If AccountManager.SubButton.ButtonName(i,j) <> "" Then
//適用内容をButtonNameへ代入
TekiyouList.Cell(k,1) = AccountManager.SubButton.ButtonName(i,j)
//ボタンの色をButtonColorへ代入
TekiyouList.Cell(k,2) = ButtonColor(AccountManager.SubButton.ButtonColor(i,j) - 1).Caption
TekiyouList.Cell(k,4) = Str(AccountManager.SubButton.ButtonColor(i,j) - 1)
//コード番号をButtonDataへ代入
TekiyouList.Cell(k,3) = AccountManager.SubButton.ButtonData1(i,j)
End If
If j = AccountManager.SubButton.RowCount Then
i = i + 1
j = 1
Else
j = j + 1
End If
If j = AccountManager.SubButton.RowCount +1 And i = AccountManager.SubButton.ColCount +1 Then
Exit
End If
Next
TekiyouList.Refresh
End Sub
False
True
0
0
16777215
16777215
False
False
True
0
0
True
False
0
False
False
False
False
False
False
False
False
False
適用編集
1
1
32000
32000
32000
32000
64
64
64
64
523
589
MinimumWidth
1
Size
64
Integer
MinimumHeight
1
Size
64
Integer
MaximumWidth
1
Size
32000
Integer
MaximumHeight
1
Size
32000
Integer
Type
1
Frame
0
Types
Enum
0 - Document
1 - Movable Modal
2 - Modal Dialog
3 - Floating Window
4 - Plain Box
5 - Shadowed Box
6 - Rounded Window
7 - Global Floating Window
8 - Sheet Window
9 - Metal Window
11 - Modeless Dialog
HasCloseButton
1
Frame
True
Boolean
HasMaximizeButton
1
Frame
True
Boolean
HasMinimizeButton
1
Frame
True
Boolean
HasFullScreenButton
1
Frame
False
Boolean
DefaultLocation
1
Behavior
0
Locations
Enum
0 - Default
1 - Parent Window
2 - Main Screen
3 - Parent Window Screen
4 - Stagger
HasBackgroundColor
1
Background
False
Boolean
BackgroundColor
1
Background
&hFFFFFF
Color
Color
Name
1
ID
String
Interfaces
1
ID
String
Super
1
ID
String
Width
1
Position
600
Integer
Height
1
Position
400
Integer
Composite
1
Appearance
False
Boolean
Backdrop
1
Appearance
Picture
Title
1
Appearance
Untitled
String
Visible
1
Appearance
True
Boolean
FullScreen
1
Appearance
False
Boolean
MenuBarVisible
1
Appearance
True
Boolean
Resizeable
1
Appearance
True
Boolean
MacProcID
1
Appearance
0
Integer
MenuBar
1
Appearance
MenuBar
ImplicitInstance
1
Appearance
True
Boolean
GroupBox
TextField
GroupBox
RadioButton
GroupBox
TextField
PushButton
Action
1
698370047
134217984
Sub Action()
Dim i as Integer
//入力フィールドに入力された内容をリストボックスへ追加
If InputField.Text <> "" Then
TekiyouList.Cell(TekiyouList.ClickPosY,1) = InputField.Text
TekiyouList.Cell(TekiyouList.ClickPosY,3) = NumberField.Text
For i = 0 to 8
If ButtonColor(i).Value = True Then
TekiyouList.Cell(TekiyouList.ClickPosY,2) = ButtonColor(i).Caption
TekiyouList.Cell(TekiyouList.ClickPosY,4) = Str(i)
Exit
End If
Next
TekiyouList.Refresh
End If
End Sub
PushButton
Action
1
1504053247
134217984
Sub Action()
Dim i as Integer
Dim j as Integer
Dim k as Integer
dim tstring as string
i = 1
j = 1
For k = 1 to 45
If TekiyouList.Cell(k,1) <> "" Then
//適用内容をButtonNameへ代入
AccountManager.SubButton.ButtonName(i,j) = TekiyouList.Cell(k,1)
//ボタンの色をButtonColorへ代入
AccountManager.SubButton.ButtonColor(i,j) = Val(TekiyouList.Cell(k,4)) + 1
//コード番号をButtonDataへ代入
AccountManager.SubButton.ButtonData1(i,j) = TekiyouList.Cell(k,3)
End If
If j = AccountManager.SubButton.RowCount Then
i = i + 1
j = 1
Else
j = j + 1
End If
If j = AccountManager.SubButton.RowCount + 1 And i = AccountManager.SubButton.ColCount + 1Then
Exit
End If
Next
If AccountManager.SubButton.Visible = True Then
AccountManager.SubButton.Refresh
End If
AccountManager.SaveTekiyou
Close
End Sub
aList
CellChange
1
782366719
134217984
Sub CellChange(Row as integer, Col as integer)
InputField.Text = Me.Cell(Row,1)
NumberField.Text = Me.Cell(Row,3)
ButtonColor(Val(Me.Cell(Row,4))).Value = True
End Sub
MouseWheel
1
2042118143
134217984
Function MouseWheel(X As Integer, Y As Integer, deltaX as Integer, deltaY as Integer) As Boolean
TekiyouListScrollBar.value=TekiyouListScrollBar.value+deltaY
End Function
TextField
ScrollBar
ValueChanged
1
1536184319
134217984
Sub ValueChanged()
TekiyouList.topIndex = TekiyouListScrollBar.value
TekiyouList.refresh
End Sub
PushButton
Action
1
694431743
134217984
Sub Action()
Dim i as Integer
For i = 1 to 4
TekiyouList.Cell(TekiyouList.ClickPosY,i) = ""
Next
InputField.Text = ""
NumberField.Text = ""
TekiyouList.Refresh
End Sub
GroupBox
GroupBox
True
False
番号
True
Osaka
1.2e+1
0
56
-2147483648
False
457
False
False
False
False
GroupBox3
0
GroupBox
0
0
True
295
True
False
True
112
0
0
740073471
TextField
TextField
True
True
False
False
16777215
False
True
アニト-Ｌ等幅
1.8e+1
0
True
24
-2147483648
GroupBox3
False
478
False
False
False
False
4
NumberField
False
False
0
TextField
0
0
True
0
0
318
True
False
True
75
1
0
1174585343
GroupBox
GroupBox
True
False
色区分
True
Osaka
1.2e+1
0
106
-2147483648
False
20
False
False
False
False
GroupBox1
0
GroupBox
1
0
True
353
True
False
True
549
2
0
1667239935
RadioButton
RadioButton
True
False
薄い灰色
True
Osaka
1.2e+1
0
20
8
GroupBox1
False
283
False
False
False
False
ButtonColor
0
RadioButton
0
0
True
431
True
False
False
True
82
3
0
630530047
RadioButton
RadioButton
True
False
ぴんく
True
Osaka
1.2e+1
0
20
5
GroupBox1
False
180
False
False
False
False
ButtonColor
0
RadioButton
1
0
True
431
True
False
False
True
70
3
0
1853896703
RadioButton
RadioButton
True
False
きみどり
True
Osaka
1.2e+1
0
20
2
GroupBox1
False
75
False
False
False
False
ButtonColor
0
RadioButton
2
0
True
431
True
False
False
True
70
3
0
1232271359
RadioButton
RadioButton
True
False
赤
True
Osaka
1.2e+1
0
20
7
GroupBox1
False
283
False
False
False
False
ButtonColor
0
RadioButton
3
0
True
402
True
False
False
True
70
3
0
1413656575
RadioButton
RadioButton
True
False
きいろ
True
Osaka
1.2e+1
0
20
4
GroupBox1
False
180
False
False
False
False
ButtonColor
0
RadioButton
4
0
True
402
True
False
False
True
70
3
0
939986943
RadioButton
RadioButton
True
False
オレンジ
True
Osaka
1.2e+1
0
20
1
GroupBox1
False
75
False
False
False
False
ButtonColor
0
RadioButton
5
0
True
402
True
False
False
True
70
3
0
515438591
RadioButton
RadioButton
True
False
シアン
True
Osaka
1.2e+1
0
20
0
GroupBox1
False
75
False
False
False
False
ButtonColor
0
RadioButton
6
0
True
375
True
False
False
True
70
3
0
1962991615
RadioButton
RadioButton
True
False
みずいろ
True
Osaka
1.2e+1
0
20
3
GroupBox1
False
180
False
False
False
False
ButtonColor
0
RadioButton
7
0
True
375
True
False
False
True
70
3
0
1786417151
RadioButton
RadioButton
True
False
グレー
True
Osaka
1.2e+1
0
20
6
GroupBox1
False
283
False
False
False
False
ButtonColor
0
RadioButton
8
0
True
375
True
False
False
True
70
3
0
1028087807
GroupBox
GroupBox
True
False
適用内容
True
Osaka
1.2e+1
0
56
-2147483648
False
20
False
False
False
False
GroupBox2
0
GroupBox
2
0
True
295
True
False
True
423
4
0
711559167
TextField
TextField
True
True
False
False
16777215
False
True
アニト-Ｌ等幅
1.8e+1
0
True
24
-2147483648
GroupBox2
False
39
False
False
False
False
38
InputField
False
False
0
TextField
0
0
True
0
0
318
True
False
True
385
5
0
1149390847
PushButton
PushButton
True
False
False
登録
True
True
Osaka
1.2e+1
0
32
-2147483648
False
489
False
False
False
False
0
PushButton1
0
PushButton
4
0
True
471
True
False
True
80
6
0
1317099519
PushButton
PushButton
True
False
False
終了
False
True
Osaka
1.2e+1
0
32
-2147483648
False
386
False
False
False
False
0
PushButton5
0
PushButton
5
0
True
471
True
False
True
80
7
0
1385562111
aList
aList
True
False
True
False
0
0
0
0
0
False
0
True
True
18
274
-2147483648
20
False
False
False
False
TekiyouList
0
0
aList
16
0
True
アニト-Ｌ等幅
18
14
0
True
True
533
8
0
897843199
TextField
TextField
True
True
False
False
16777215
False
False
Osaka
1.2e+1
0
True
16
-2147483648
TekiyouList
False
49
False
False
False
False
0
TekiyouListField
False
False
0
TextField
0
0
True
0
0
68
True
False
False
80
9
0
698345471
ScrollBar
ScrollBar
True
True
True
True
272
-2147483648
553
1
False
False
False
False
46
1
TekiyouListScrollBar
10
0
ScrollBar
17
0
True
14
True
1
True
16
10
0
1241677823
PushButton
PushButton
True
False
False
削除
False
True
Osaka
1.2e+1
0
32
-2147483648
False
20
False
False
False
False
0
PushButton2
0
PushButton
19
0
True
471
True
False
True
60
11
0
1434845183
SaveWindow
36
1
Window
1
0
False
True
0
0
16777215
16777215
False
False
True
0
0
True
False
0
False
False
False
False
False
False
False
False
False
Untitled
2
2
32000
32000
32000
32000
64
64
64
64
83
382
MinimumWidth
1
Size
64
Integer
MinimumHeight
1
Size
64
Integer
MaximumWidth
1
Size
32000
Integer
MaximumHeight
1
Size
32000
Integer
Type
1
Frame
0
Types
Enum
0 - Document
1 - Movable Modal
2 - Modal Dialog
3 - Floating Window
4 - Plain Box
5 - Shadowed Box
6 - Rounded Window
7 - Global Floating Window
8 - Sheet Window
9 - Metal Window
11 - Modeless Dialog
HasCloseButton
1
Frame
True
Boolean
HasMaximizeButton
1
Frame
True
Boolean
HasMinimizeButton
1
Frame
True
Boolean
HasFullScreenButton
1
Frame
False
Boolean
DefaultLocation
1
Behavior
0
Locations
Enum
0 - Default
1 - Parent Window
2 - Main Screen
3 - Parent Window Screen
4 - Stagger
HasBackgroundColor
1
Background
False
Boolean
BackgroundColor
1
Background
&hFFFFFF
Color
Color
Name
1
ID
String
Interfaces
1
ID
String
Super
1
ID
String
Width
1
Position
600
Integer
Height
1
Position
400
Integer
Composite
1
Appearance
False
Boolean
Backdrop
1
Appearance
Picture
Title
1
Appearance
Untitled
String
Visible
1
Appearance
True
Boolean
FullScreen
1
Appearance
False
Boolean
MenuBarVisible
1
Appearance
True
Boolean
Resizeable
1
Appearance
True
Boolean
MacProcID
1
Appearance
0
Integer
MenuBar
1
Appearance
MenuBar
ImplicitInstance
1
Appearance
True
Boolean
Label
Label
Label
True
False
True
Osaka
1.4e+1
0
23
-2147483648
False
26
False
False
False
False
False
StaticText1
0
False
Label
0
0
True
振替伝票を保存中です。しばらくお待ちください。
0
27
False
False
True
331
0
0
1182568447
MsgDlg
36
1
Window
1
0
SetMode
1
1936066559
134217984
Sub SetMode(tMode as string)
if InStr(1,tMode, "保存")<>0 then
//MessageCap.text = "変更内容を保存して終了しますか？"
DialogMode = "Save"
IconMode="Stop"
end if
if InStr(1,tMode, "注意")<>0 then
IconMode="Note"
end if
if InStr(1,tMode, "警告")<>0 then
IconMode="Caution"
end if
if InStr(1,tMode, "停止")<>0 then
IconMode="Stop"
end if
if InStr(1,tMode, "OK")<>0 then
DialogMode = "OK"
end if
if InStr(1,tMode, "Cancel")<>0 or 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
134217984
0
0
tMode as string
SetMessage
1
1998622719
134217984
Sub SetMessage(tMessage as String)
MessageCap.text = tMessage
End Sub
134217984
0
0
tMessage as String
QuitMode
1
528416767
134217984
QuitMode As String
134217984
QuitMode As String
0
0
DialogMode
1
1493612543
134217984
DialogMode As String
134217984
DialogMode As String
0
0
IconMode
1
871397375
134217984
IconMode As string
134217984
IconMode As string
0
0
False
True
0
0
16777215
16777215
False
False
False
0
0
True
False
0
False
True
False
True
True
True
True
True
True
Untitled
2
2
32000
32000
32000
32000
64
64
64
64
111
364
MinimumWidth
1
Size
64
Integer
MinimumHeight
1
Size
64
Integer
MaximumWidth
1
Size
32000
Integer
MaximumHeight
1
Size
32000
Integer
Type
1
Frame
0
Types
Enum
0 - Document
1 - Movable Modal
2 - Modal Dialog
3 - Floating Window
4 - Plain Box
5 - Shadowed Box
6 - Rounded Window
7 - Global Floating Window
8 - Sheet Window
9 - Metal Window
11 - Modeless Dialog
HasCloseButton
1
Frame
True
Boolean
HasMaximizeButton
1
Frame
True
Boolean
HasMinimizeButton
1
Frame
True
Boolean
HasFullScreenButton
1
Frame
False
Boolean
DefaultLocation
1
Behavior
0
Locations
Enum
0 - Default
1 - Parent Window
2 - Main Screen
3 - Parent Window Screen
4 - Stagger
HasBackgroundColor
1
Background
False
Boolean
BackgroundColor
1
Background
&hFFFFFF
Color
Color
Name
1
ID
String
Interfaces
1
ID
String
Super
1
ID
String
Width
1
Position
600
Integer
Height
1
Position
400
Integer
Composite
1
Appearance
False
Boolean
Backdrop
1
Appearance
Picture
Title
1
Appearance
Untitled
String
Visible
1
Appearance
True
Boolean
FullScreen
1
Appearance
False
Boolean
MenuBarVisible
1
Appearance
True
Boolean
Resizeable
1
Appearance
True
Boolean
MacProcID
1
Appearance
0
Integer
MenuBar
1
Appearance
MenuBar
ImplicitInstance
1
Appearance
True
Boolean
QuitMode
Behavior
String
MultiLineEditor
DialogMode
Behavior
String
MultiLineEditor
IconMode
Behavior
string
MultiLineEditor
PushButton
Action
1
580829183
134217984
Sub Action(index as Integer)
QuitMode = Button(Index).caption
hide
End Sub
Label
Canvas
Paint
1
586067967
134217984
Sub Paint(g As Graphics, areas() As REALbasic.Rect)
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
True
False
False
保存
False
True
Osaka
1.2e+1
0
20
0
False
289
False
False
False
False
0
Button
0
PushButton
0
0
True
78
True
False
True
60
0
0
378865663
PushButton
PushButton
True
False
False
キャンセル
False
True
Osaka
1.2e+1
0
20
1
False
171
False
False
False
False
0
Button
0
PushButton
1
0
True
78
True
False
True
84
0
0
270864383
Label
Label
True
False
True
Osaka
1.2e+1
0
50
-2147483648
False
59
False
False
False
False
True
MessageCap
0
False
Label
2
0
True
SetMode "保存,警告,停止,注意,OK,キャンセル" SetMessage "表示したい内容" / ShowModal / QuitMode
0
13
False
False
True
290
1
0
66136063
PushButton
PushButton
True
False
False
保存しない
False
True
Osaka
1.2e+1
0
20
2
False
27
False
False
False
False
0
Button
0
PushButton
3
0
True
78
True
False
True
88
0
0
287019007
Canvas
Canvas
True
False
True
False
0
False
True
True
32
-2147483648
13
False
False
False
False
IconBox
0
Canvas
4
0
True
13
True
True
32
2
0
189691903
ChangeDateWindow
36
1
Window
1
0
False
True
0
0
16777215
16777215
False
False
True
0
0
True
False
0
False
False
False
False
False
False
False
False
False
日付の変更
1
1
32000
32000
32000
32000
64
64
64
64
216
449
MinimumWidth
1
Size
64
Integer
MinimumHeight
1
Size
64
Integer
MaximumWidth
1
Size
32000
Integer
MaximumHeight
1
Size
32000
Integer
Type
1
Frame
0
Types
Enum
0 - Document
1 - Movable Modal
2 - Modal Dialog
3 - Floating Window
4 - Plain Box
5 - Shadowed Box
6 - Rounded Window
7 - Global Floating Window
8 - Sheet Window
9 - Metal Window
11 - Modeless Dialog
HasCloseButton
1
Frame
True
Boolean
HasMaximizeButton
1
Frame
True
Boolean
HasMinimizeButton
1
Frame
True
Boolean
HasFullScreenButton
1
Frame
False
Boolean
DefaultLocation
1
Behavior
0
Locations
Enum
0 - Default
1 - Parent Window
2 - Main Screen
3 - Parent Window Screen
4 - Stagger
HasBackgroundColor
1
Background
False
Boolean
BackgroundColor
1
Background
&hFFFFFF
Color
Color
Name
1
ID
String
Interfaces
1
ID
String
Super
1
ID
String
Width
1
Position
600
Integer
Height
1
Position
400
Integer
Composite
1
Appearance
False
Boolean
Backdrop
1
Appearance
Picture
Title
1
Appearance
Untitled
String
Visible
1
Appearance
True
Boolean
FullScreen
1
Appearance
False
Boolean
MenuBarVisible
1
Appearance
True
Boolean
Resizeable
1
Appearance
True
Boolean
MacProcID
1
Appearance
0
Integer
MenuBar
1
Appearance
MenuBar
ImplicitInstance
1
Appearance
True
Boolean
CalendarClass
MouseClick
1
718448639
134217984
Sub MouseClick()
DateBufferField.Year = Me.Year
DateBufferField.Month = Me.Month
DateBufferField.Day = Me.Day
DateBufferField.Redraw
End Sub
PushButton
Action
1
1463566335
134217984
Sub Action()
Calendar.DecMonth
Calendar.Redraw
End Sub
PushButton
Action
1
1573801983
134217984
Sub Action()
Calendar.IncMonth
Calendar.Redraw
End Sub
DateFieldClass
Label
Label
Label
PushButton
Action
1
1780738047
134217984
Sub Action()
Dim tLineCount as Integer
AccountManager.DateField.Year = Val(NthField(DateBufferField.Text,"/",1))
AccountManager.DateField.Month = Val(NthField(DateBufferField.Text,"/",2))
AccountManager.DateField.Day = Val(NthField(DateBufferField.Text,"/",3))
AccountManager.DateField.Redraw
Close
End Sub
PushButton
Action
1
1008222207
134217984
Sub Action()
Close
End Sub
Label
CalendarClass
CalendarClass
True
False
True
False
0
0
0
0
0
0
0
0
False
True
True
165
-2147483648
20
False
False
False
False
0
Calendar
0
0
0
0
CalendarClass
0
0
True
14
0
32
0
41
True
True
253
0
0
0
1129762815
PushButton
PushButton
True
False
False
＜＜
False
True
Osaka
1.2e+1
0
20
-2147483648
False
194
False
False
False
False
0
PushButton1
0
PushButton
1
0
True
13
True
False
True
35
1
0
886368255
PushButton
PushButton
True
False
False
＞＞
False
True
Osaka
1.2e+1
0
20
-2147483648
False
238
False
False
False
False
0
PushButton2
0
PushButton
2
0
True
13
True
False
True
35
2
0
975630335
DateFieldClass
DateFieldClass
True
True
False
False
16777215
False
0
0
True
Osaka
1.2e+1
0
True
22
-2147483648
False
325
False
False
False
False
0
0
DateBufferField
False
False
0
DateFieldClass
3
0
True
0
0
85
True
False
True
0
88
0
3
0
1851652095
Label
Label
True
False
True
Osaka
1.2e+1
0
18
-2147483648
False
286
False
False
False
False
False
StaticText1
0
False
Label
4
0
True
現在表示している振伝の
0
63
False
False
True
133
4
0
479567871
Label
Label
True
False
True
Osaka
1.2e+1
0
17
-2147483648
False
417
False
False
False
False
False
StaticText2
0
False
Label
5
0
True
に
0
88
False
False
True
11
5
0
342390783
Label
Label
True
False
True
Osaka
1.2e+1
0
17
-2147483648
False
286
False
False
False
False
False
StaticText3
0
False
Label
6
0
True
変更します。
0
115
False
False
True
96
6
0
2024364031
PushButton
PushButton
True
False
False
OK
False
True
Osaka
1.2e+1
0
20
-2147483648
False
366
False
False
False
False
0
PushButton3
0
PushButton
7
0
True
174
True
False
True
70
7
0
665335807
PushButton
PushButton
True
False
False
キャンセル
False
True
Osaka
1.2e+1
0
20
-2147483648
False
286
False
False
False
False
0
PushButton4
0
PushButton
8
0
True
174
True
False
True
70
8
0
1139597311
Label
Label
True
False
True
Osaka
1.2e+1
0
17
-2147483648
False
286
False
False
False
False
False
StaticText4
0
False
Label
9
0
True
日付を
0
88
False
False
True
35
9
0
626466815
Class
0
Module
0
Graphics
0
Window
0
CalendarWindow
36
1
Window
1
0
Open
1
1414279167
134217984
Sub Open()
left=screen(0).width/2-width/2
top=screen(0).height/2-height/2
End Sub
False
0DE2978FE9BB92E381A7E8A1A8E7A4BAE38197E381A6E38182E3828BE697A5E381AFE38387E383BCE382BFE381AEE585A5E58A9BE3818CE381AAE38184E697A5E381A7E38199E380820DE2978FE382B0E383ACE383BCE381A7E8A1A8E7A4BAE38197E381A6E38182E3828BE697A5E381AFE38387E383BCE382BFE3818CE38182E3828AE381BEE38199E380820DE2978FE382B0E383ACE383BCE381A7E382A2E383B3E38380E383BCE383A9E382A4E383B3E3818CE8A1A8E7A4BAE38197E381A6E38182E3828BE697A5E381AFE38387E383BCE382BFE3818CE38182E3828AE381BEE38199E3818CE38081E58DB0E588B7E3818CE381BEE381A0E381AEE78AB6E6858BE381A7E38199E38082E380800D0DE4BBA5E5898DE381ABE58DB0E588B7E38292E38199E381BEE3819BE381A6E38184E3828BE381AEE381ABE382A2E383B3E38380E383BCE383A9E382A4E383B3E3818CE4BB98E38184E381A6E38184E3828BE5A0B4E59088E381AFE58DB0E588B7E5BE8CE381ABE694AFE68995E7AD89E381AEE382A2E38397E383AAE382B1E383BCE382B7E383A7E383B3E3818BE38289E887AAE58B95E381A7E38387E383BCE382BFE381AEE585A5E58A9BE3818CE38182E3828AE38081E38387E383BCE382BFE3818CE69BB4E696B0E38195E3828CE3819FE789A9E381A7E38199E38082
True
0
0
16777215
16777215
False
False
False
0
0
True
False
0
False
False
False
True
True
True
True
False
False
カレンダー
1
1
32000
32000
32000
32000
64
64
64
64
396
512
MinimumWidth
1
Size
64
Integer
MinimumHeight
1
Size
64
Integer
MaximumWidth
1
Size
32000
Integer
MaximumHeight
1
Size
32000
Integer
Type
1
Frame
0
Types
Enum
0 - Document
1 - Movable Modal
2 - Modal Dialog
3 - Floating Window
4 - Plain Box
5 - Shadowed Box
6 - Rounded Window
7 - Global Floating Window
8 - Sheet Window
9 - Metal Window
11 - Modeless Dialog
HasCloseButton
1
Frame
True
Boolean
HasMaximizeButton
1
Frame
True
Boolean
HasMinimizeButton
1
Frame
True
Boolean
HasFullScreenButton
1
Frame
False
Boolean
DefaultLocation
1
Behavior
0
Locations
Enum
0 - Default
1 - Parent Window
2 - Main Screen
3 - Parent Window Screen
4 - Stagger
HasBackgroundColor
1
Background
False
Boolean
BackgroundColor
1
Background
&hFFFFFF
Color
Color
Name
1
ID
String
Interfaces
1
ID
String
Super
1
ID
String
Width
1
Position
600
Integer
Height
1
Position
400
Integer
Composite
1
Appearance
False
Boolean
Backdrop
1
Appearance
Picture
Title
1
Appearance
Untitled
String
Visible
1
Appearance
True
Boolean
FullScreen
1
Appearance
False
Boolean
MenuBarVisible
1
Appearance
True
Boolean
Resizeable
1
Appearance
True
Boolean
MacProcID
1
Appearance
0
Integer
MenuBar
1
Appearance
MenuBar
ImplicitInstance
1
Appearance
True
Boolean
CalendarClass
MouseClick
1
992321535
134217984
Sub MouseClick()
DateBufferField.Year = Calendar.Year
DateBufferField.Month = Calendar.Month
DateBufferField.Day = Calendar.Day
DateBufferField.Redraw
//Redraw
End Sub
PushButton
Action
1
604383231
134217984
Sub Action()
Calendar.DecMonth
Calendar.Redraw
End Sub
PushButton
Action
1
104441855
134217984
Sub Action()
Calendar.IncMonth
Calendar.Redraw
End Sub
PushButton
Action
1
104476671
134217984
Sub Action()
Dim tLineCount as Integer
AccountManager.DateField.Year = Val(NthField(DateBufferField.Text,"/",1))
AccountManager.DateField.Month = Val(NthField(DateBufferField.Text,"/",2))
AccountManager.DateField.Day = Val(NthField(DateBufferField.Text,"/",3))
AccountManager.DateField.Redraw
AccountManager.MainListClear
tLineCount = AccountManager.ReadAccount(tLineCount)
tLineCount = AccountManager.ReadOutputAccount(tLineCount)
AccountManager.SetTotal()
AccountManager.MainList.aListRefresh
AccountManager.MainListScrollBar.Value = 1
Close
End Sub
DateFieldClass
CalendarClass
CalendarClass
True
False
True
False
0
0
0
0
0
0
0
0
False
True
True
323
-2147483648
20
False
False
False
False
0
Calendar
0
0
0
0
CalendarClass
0
0
True
24
0
32
0
53
True
True
472
0
0
0
664311807
PushButton
PushButton
True
False
False
＜＜
False
True
Osaka
1.2e+1
0
32
-2147483648
False
210
False
False
False
False
0
PushButton1
0
PushButton
1
0
True
9
True
False
True
35
1
0
1349834751
PushButton
PushButton
True
False
False
＞＞
False
True
Osaka
1.2e+1
0
32
-2147483648
False
257
False
False
False
False
0
PushButton2
0
PushButton
2
0
True
9
True
False
True
35
2
0
2132174847
PushButton
PushButton
True
False
False
OK
False
True
Osaka
1.2e+1
0
32
-2147483648
False
120
False
False
False
False
0
PushButton3
0
PushButton
3
0
True
9
True
False
True
60
3
0
1551020031
DateFieldClass
DateFieldClass
True
False
False
False
16777215
False
0
0
True
Osaka
1.2e+1
0
True
22
-2147483648
False
20
False
False
False
False
0
0
DateBufferField
False
False
0
DateFieldClass
4
0
True
0
0
14
True
False
True
0
88
0
4
0
1015846911
FunctionM
34
0
1
0
gsPrintV
1
264464383
134217984
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
OutPlot tGraph,tObjL,tObjT,tObjR,tObjT
OutPlot tGraph,tObjL,tObjB,tObjR,tObjB
OutPlot tGraph,tObjL,tObjT,tObjL,tObjB
tLeftPoint = tObjL
For i = 1 To 255
tString = NthField(tFormat,";",i)
If tString = "" Then
i = 255
Else
tLeftPoint = tLeftPoint + Val(tString)
OutPlot tGraph,tLeftPoint,tObjT,tLeftPoint,tObjB
End If
Next
End Sub
134217984
0
0
tGraph as Graphics,tObjL as Integer,tObjT as Integer,tObjR as Integer,tObjB as Integer,tFormat as String
SetOrg
1
1096460287
134217984
Sub SetOrg(tX as Integer,tY as Integer)
gScreenX = tX
gScreenY = tY
End Sub
134217984
0
0
tX as Integer,tY as Integer
OutPlot
1
720453631
134217984
Sub OutPlot(tGraph as Graphics,tObjL as Integer,tObjT as Integer,tObjR as Integer,tObjB as Integer)
tGraph.DrawLine tObjL + gScreenX,tObjT + gScreenY+50,tObjR + gScreenX,tObjB + gScreenY+50
End Sub
134217984
0
0
tGraph as Graphics,tObjL as Integer,tObjT as Integer,tObjR as Integer,tObjB as Integer
OutPrint
1
1221824511
134217984
Sub OutPrint(tGraph as Graphics,tX as Integer,tY as Integer,tString as String)
tGraph.DrawString tString,tX + gScreenX,tY + gScreenY
End Sub
134217984
0
0
tGraph as Graphics,tX as Integer,tY as Integer,tString as String
ZeroSup
1
611219455
134217984
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
134217984
0
0
tNumerical as Double,tKeta as Integer
String
CenterPrint
1
191209471
134217984
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
134217984
0
0
tGraph as Graphics,tString as String,tLeft as Integer,tRight as Integer,tTop as Integer,tBtm as Integer
EvenlyPrint
1
2092466175
134217984
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
134217984
0
0
tGraph as Graphics,tX as Integer,tY as Integer,tString as String
SpaceSup
1
823597055
134217984
Function SpaceSup(tNumerical as String,tKeta as Integer) As String
Dim tString as String
tString = " " + tNumerical
tString = RightB(tString,tKeta)
Return ConvertEncoding(tString,Encodings.MacJapanese)
End Function
134217984
0
0
tNumerical as String,tKeta as Integer
String
GetMiddleDate
1
8710143
134217984
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
134217984
0
0
tDate as String
String
RemoveString
1
745015295
134217984
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 + NthField(tString,tRemoveString,i)
Next
Return tReturnString
End Function
134217984
0
0
tString as String,tRemoveString as String
String
ChangeSequence
1
675104767
134217984
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
134217984
0
0
tString as String
Double
ChangeDateInteger
1
1846949887
134217984
Function ChangeDateInteger(tDateString as String) As Integer
//日付けを受け取って8桁整数にして返す
//日付けの文字列は"."でも"/"でも何でも使用可
Dim tString as String
Dim tInteger as Integer
tString = LeftB(tDateString,4) + ZeroSup(Val(NthField(tDateString,"/",2)),2) + ZeroSup(Val(NthField(tDateString,"/",3)),2)
tInteger = Val(tString)
Return tInteger
End Function
134217984
0
0
tDateString as String
Integer
ChangeDateYMD
1
546516991
134217984
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(NthField(tDateString,".",1)),2) + "/" + ZeroSup(Val(NthField(tDateString,".",2)),2) + "/" + ZeroSup(Val(NthField(tDateString,".",3)),2)
Return tString
End Function
134217984
0
0
tDateString as String
String
ChangeDateString
1
1478825983
134217984
Function ChangeDateString(tDateString as String) As String
//日付けを受け取って8桁文字列にして返す
//日付けの文字列は"."でも"/"でも何でも使用可
//しかし、先頭年数は2桁のこと
Dim tString as String
tString = LeftB(tDateString,4) + ZeroSup(Val(NthField(tDateString,"/",2)),2) + ZeroSup(Val(NthField(tDateString,"/",3)),2)
Return tString
End Function
134217984
0
0
tDateString as String
String
IncMonth
1
1737410559
134217984
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(NthField(tDate,"/",1))
tMonth = Val(NthField(tDate,"/",2))
tDay = Val(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
134217984
0
0
tDate as String
String
DecMonth
1
2002681855
134217984
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(NthField(tDate,"/",1))
tMonth = Val(NthField(tDate,"/",2))
tDay = Val(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
134217984
0
0
tDate as String
String
MakeFolder
1
385884159
134217984
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
134217984
0
0
tFolderName as String
FolderItem
SpaceSupB
1
496400383
134217984
Function SpaceSupB(tNumerical as String,tKeta as Integer) As String
Dim tString as String
tString = tNumerical + " "
tString = LeftB(tString,tKeta)
Return tString
End Function
134217984
0
0
tNumerical as String,tKeta as Integer
String
DeBugLog
1
134682623
134217984
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
134217984
0
0
tPath as String,tWriteString as String
DecimalPointDouble
1
1306566655
134217984
Function DecimalPointDouble(tDouble as Double) As Double
Dim tDecimalDouble as Double
Select Case gDecimal
Case 1
tDecimalDouble = Floor(tDouble)
Case 2
tDecimalDouble = Ceil(tDouble)
Case 3
tDecimalDouble =Round(tDouble)
End Select
Return tDecimalDouble
End Function
134217984
0
0
tDouble as Double
Double
CheakPopupCout
1
1538936831
134217984
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
134217984
0
0
tPopupName as PopupMenu
Boolean
OpenPrint
1
964085759
134217984
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 j as Integer
dim tstring as string
gScreenX = tScreenX
gScreenY = tScreenY
//一頁目のヘッダ高
lHeadFootLine(0) = Val(NthField(tHeadFoot,";",1))
//一頁目のフッタ高
lHeadFootLine(1) = Val(NthField(tHeadFoot,";",2))
//以降頁のヘッタ高
lHeadFootLine(2) = Val(NthField(tHeadFoot,";",3))
//以降頁のフッタ高
lHeadFootLine(3) = Val(NthField(tHeadFoot,";",4))
//一頁めの最大行数
lMaxPage(0) = Val(NthField(tMaxPage,";",1))
//以降頁の最大行数
lMaxPage(1) = Val(NthField(tMaxPage,";",2))
//ページ番号
lPageLineNumber(0) = 1
//そのページ内で印刷した行数
lPageLineNumber(1) = 1
//各セルのサイズと、みだし
i = 0
While NthField(tSegmentNumber,";",i + 1) <> ""
lSegmentSizeBuffer(i) = Val(NthField(tSegmentNumber,";",i + 1))
lSegmentString(i) = NthField(tSegmentString,Chr(9),i + 1)
lSegmentPosition(i) = 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
134217984
0
0
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
AddPrint
1
81457151
134217984
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) = NthField(tString,Chr(9),i + 1)
Next
//ページのカウンタを一つ増やす
lPageLineNumber(1) = lPageLineNumber(1) + 1
//引き受けた文字列を印刷
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) + 4 , lPrintData(7) + (lPrintData(4) * lPageLineNumber(1)) - 2,tPrintString(i),"R"
Case ""
Exit
End Select
Next
//今回書いた頁を返す
Return lPageLineNumber(0)
End Function
134217984
0
0
tGraph as Graphics,tString as String
Integer
ListPrint
1
2111467519
134217984
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))-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
134217984
0
0
tGraph as Graphics,tLastPrint as Integer
SpaceMid
1
1737076735
134217984
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
134217984
0
0
tString as String,tMozi as Integer
String
ClearPrintSet
1
1418285055
134217984
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
134217984
0
0
GetDayOfWeek
1
580179967
134217984
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
134217984
0
0
tYear as Integer,tMonth as Integer,tDay as Integer
Integer
GetDaysOfMonth
1
1286260735
134217984
Function GetDaysOfMonth(tYear as Integer,tMonth as Integer) As Integer
//関数説明：指定された月が何日あるか求める
//引き数 ：年、月
//返り値 ：その月の日数
//作成日 ：1998/12/21(Mon)
//備考 ：
Dim tDays as Integer
dim tinteger as integer
//その月の日数を返す
tDays = Val(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
134217984
0
0
tYear as Integer,tMonth as Integer
Integer
IsLeapYear
1
711743487
134217984
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
134217984
0
0
tYear as Integer
Boolean
ReturnDate
1
1875943423
134217984
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(NthField(tStartDate,"/",3))
tEndDay = Val(NthField(tEndDate,"/",3))
//終了日 - 開始日 + 1
tTemp = tEndDay - tStartDay + 1
//月の分だけループしながら日数を加えていく
tStartDay = Val(NthField(tStartDate,"/",1)) * 100 + Val(NthField(tStartDate,"/",2))
tEndDay = Val(NthField(tEndDate,"/",1)) * 100 + Val(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
134217984
0
0
tStartDate as String,tEndDate as String
Integer
IncDay
1
1948542975
134217984
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(NthField(tDate,"/",1))
tMonth = Val(NthField(tDate,"/",2))
tDay = Val(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
134217984
0
0
tDate as String
String
DecDay
1
553742335
134217984
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(NthField(tDate,"/",1))
tMonth = Val(NthField(tDate,"/",2))
tDay = Val(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
134217984
0
0
tDate as String
String
FloorBug
1
903370751
134217984
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
134217984
0
0
tDouble as Double
Double
OutPrintP
1
1573449727
134217984
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+3,tY + gScreenY+50
ElseIf Trim(posiset) = "M" Then
wDrawString(tGraph, tString,tX + gScreenX,tY + gScreenY+50,60)
ElseIf Trim(posiset) = "R" Then
rDrawString(tGraph,tString,(tX + gScreenX)+80,tY + gScreenY+50)
Else
tGraph.DrawString tString,tX + gScreenX,tY + gScreenY+50
End IF
End Sub
134217984
0
0
tGraph as Graphics,tX as Integer,tY as Integer,tString as String,posiset as string
CenterPrintP
1
446957567
134217984
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
134217984
0
0
tGraph as Graphics,tString as String,tLeft as Integer,tRight as Integer,tTop as Integer,tBtm as Integer
gScreenX
1
1782065151
134217984
gScreenX As Integer
134217984
gScreenX As Integer
0
0
gScreenY
1
864671743
134217984
gScreenY As Integer
134217984
gScreenY As Integer
0
0
Vre133
1
421695487
134217984
Vre133 As String
134217984
Vre133 As String
0
0
gDecimal
1
1616982015
134217984
gDecimal As Integer
134217984
gDecimal As Integer
0
0
lHeadFootLine(3)
1
722186239
134217984
lHeadFootLine(3) As Integer
134217984
lHeadFootLine(3) As Integer
1
0
lMaxPage(1)
1
319152127
134217984
lMaxPage(1) As Integer
134217984
lMaxPage(1) As Integer
1
0
lPageLineNumber(1)
1
703295487
134217984
lPageLineNumber(1) As Integer
134217984
lPageLineNumber(1) As Integer
0
0
lSegmentNumber
1
572887039
134217984
lSegmentNumber As Integer
134217984
lSegmentNumber As Integer
0
0
lSegmentString(50)
1
1396211711
134217984
lSegmentString(50) As String
134217984
lSegmentString(50) As String
0
0
lSegmentPosition(50)
1
1587320831
134217984
lSegmentPosition(50) As String
134217984
lSegmentPosition(50) As String
1
0
lSegmentSize(50)
1
456224767
134217984
lSegmentSize(50) As Integer
134217984
lSegmentSize(50) As Integer
0
0
lSegmentSizeBuffer(50)
1
2138810367
134217984
lSegmentSizeBuffer(50) As Integer
134217984
lSegmentSizeBuffer(50) As Integer
0
0
lGraphHeight
1
848013311
134217984
lGraphHeight As Integer
134217984
lGraphHeight As Integer
1
0
lPrintData(50)
1
1784911871
134217984
lPrintData(50) As Integer
134217984
lPrintData(50) As Integer
0
0
lCellSegment
1
1777743871
134217984
lCellSegment As String
134217984
lCellSegment As String
1
0
lPrintFont(1)
1
1291073535
134217984
lPrintFont(1) As String
134217984
lPrintFont(1) As String
0
0
gBasicPath
1
358475775
134217984
gBasicPath As String
134217984
gBasicPath As String
0
0
gVersionString
1
305125375
134217984
gVersionString As String
134217984
gVersionString As String
0
0
gPrintSettings
1
646307839
134217984
gPrintSettings As String
134217984
gPrintSettings As String
0
0
Name
1
ID
String
Index
1
ID
-2147483648
Integer
Super
1
ID
String
Left
1
Position
0
Integer
Top
1
Position
0
Integer
gScreenX
Behavior
Integer
gScreenY
Behavior
Integer
Vre133
Behavior
String
MultiLineEditor
gDecimal
Behavior
Integer
lSegmentNumber
Behavior
Integer
gBasicPath
Behavior
String
MultiLineEditor
gVersionString
Behavior
String
MultiLineEditor
gPrintSettings
Behavior
String
MultiLineEditor
Module1
0
0
1
0
lDrawString
1
783857663
134217984
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 = mid(s,i,1)
g.DrawString c,x+(lenB(lens)-1)*fw,y
lens=lens+c
next
End Sub
134217984
0
0
g as Graphics, s as String, x as Integer, y as Integer
wDrawString
1
1336580095
134217984
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 mid(s,i,1),x+tW/(cnt-1)*(i-1),y
next
End Sub
134217984
0
0
g as Graphics, s as String, x as Integer, y as Integer, w as Integer
rDrawString
1
1740851199
134217984
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 = mid(s,i,1)
g.DrawString c,tx+(lenB(lens)-1)*fw,y
lens=lens+c
next
End Sub
134217984
0
0
g as Graphics, s as String, x as Integer, y as Integer
Name
1
ID
String
Index
1
ID
-2147483648
Integer
Super
1
ID
String
Left
1
Position
0
Integer
Top
1
Position
0
Integer
App
0
1
Application
1
0
1
2
aList
32
1
Canvas
1
0
Open
1
573894655
134217984
Sub Open()
Graphics.textfont=TextFont
Graphics.textSize=TextSize
TopIndex = 1
End Sub
MouseDown
1
1011087359
134217984
Function MouseDown(X As Integer, Y As Integer) As Boolean
ClickCell X, Y
End Function
Paint
1
169371647
134217984
Sub Paint(g As Graphics, areas() As REALbasic.Rect)
SubPaint
End Sub
ColumnWidths
1
1239756799
134217984
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
134217984
0
0
s as String
aListRefresh
1
332406783
134217984
Sub aListRefresh()
Redraw Graphics
End Sub
134217984
0
0
ColumnHeaders
1
360568831
134217984
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
134217984
0
0
s as String
Redraw
1
1083668479
134217984
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 + 4
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 + headerheight, ColumnWidth(j) * cw - 1, ch
g.forecolor = rgb(255, 255, 255)
g.drawstring cell(TopIndex + i, j) , x + 4, i * ch + ch/2+g.textascent/2 + headerheight
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 + headerheight, ColumnWidth(j) * cw - 1, ch
g.forecolor = rgb(0, 0, 0)
g.drawstring cell(TopIndex + i, j) , x + 4, i * ch + ch/2+g.textascent/2 + headerheight
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 + headerheight, ColumnWidth(j) * cw - 1, ch
g.forecolor = rgb(255, 255, 255)
g.drawstring cell(TopIndex + i, j) , x + 4, i * ch + ch/2+g.textascent/2 + headerheight
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 + headerheight, ColumnWidth(j) * cw - 1, ch
g.forecolor = rgb(0, 0, 0)
g.drawstring cell(TopIndex + i, j) , x + 4, i * ch + ch/2+g.textascent/2 + headerheight
end if
x = x + ColumnWidth(j) * cw
next
next
end select
End Sub
134217984
0
0
g as Graphics
ClickCell
1
135645183
134217984
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 + 4
if Y > 16 then
ClickPosY = (y - headerheight) / 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
134217984
0
0
X as integer, Y as integer
MoveCell
1
1175916543
134217984
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 + 4
TextField.Top = -100
TextField.width = ColumnWidth(i) * cw + 1
TextField.Left = t * cw + Left
TextField.Top = (row - TopIndex) * ch + Top + headerheight
TextField.Height=ch
TextField.SelStart=999
CellChange ClickPosY, ClickPosX
TextField.Visible = true
TextField.Enabled = true
If ColumnDrawUp(ClickPosX) = "l" Or ColumnDrawUp(ClickPosX) = "" Then
TextField.LimitText = ColumnWidth(Column) - 1
TextField.Text = Trim(cell(row, column))
ElseIf ColumnDrawUp(ClickPosX) = "r0" Then
TextField.LimitText = ColumnWidth(Column) - 4
TextField.Text = ReplaceAll(Trim(cell(row, column)),",","")
ElseIf ColumnDrawUp(ClickPosX) = "r1" Then
TextField.LimitText = ColumnWidth(Column) - 6
TextField.Text = ReplaceAll(Trim(cell(row, column)),",","")
ElseIf ColumnDrawUp(ClickPosX) = "r2" Then
TextField.LimitText = ColumnWidth(Column) - 7
TextField.Text = ReplaceAll(Trim(cell(row, column)),",","")
End If
TextField.SelStart=999
TextField.SetFocus
case 1
CellChange ClickPosY, 0
Redraw Graphics
end select
End Sub
134217984
0
0
row as integer, column as integer
ColumnMasks
1
429418495
134217984
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
134217984
0
0
s as String
KeyPress
1
757440511
134217984
Function KeyPress(s as String) As Boolean
dim tstring as integer
Select Case Asc(s)
case 28 // up
MoveLeft()
TextField.Top = -100
case 29 // down
MoveRight()
TextField.Top = -100
case 30 // up
MoveUp()
TextField.Top = -100
case 31 // down
MoveDown()
TextField.Top = -100
case 13 // return
if Mask(ClickPosX) = "0" then
If ColumnDrawUp(ClickPosX) = "l" Or ColumnDrawUp(ClickPosX) = "" Then
cell(ClickPosY, ClickPosX) = TextField.Text
ElseIf ColumnDrawUp(ClickPosX) = "r0" And ChangeSequence(TextField.Text) <> 0 Then
cell(ClickPosY, ClickPosX) = SpaceSup(Format(ChangeSequence(TextField.Text),"-,#"),ColumnWidth(ClickPosX) - 1)
ElseIf ColumnDrawUp(ClickPosX) = "r1" And ChangeSequence(TextField.Text) <> 0 Then
cell(ClickPosY, ClickPosX) = SpaceSup(Format(ChangeSequence(TextField.Text),"-,#.0"),ColumnWidth(ClickPosX) - 1)
ElseIf ColumnDrawUp(ClickPosX) = "r2" And ChangeSequence(TextField.Text) <> 0 Then
cell(ClickPosY, ClickPosX) = SpaceSup(Format(ChangeSequence(TextField.Text),"-,#.00"),ColumnWidth(ClickPosX) - 1)
Else
cell(ClickPosY, ClickPosX) = ""
End If
End If
If Columncount = ClickPosX Then
MoveRight()
TextField.Top = -100
Else
TextField.Text = ""
ClickPosX = ClickPosX + 1
TextField.Text = Cell(ClickPosY,ClickPosX)
TextField.Top = -100
End If
case 3 // enter
if Mask(ClickPosX) = "0" then
If ColumnDrawUp(ClickPosX) = "l" Or ColumnDrawUp(ClickPosX) = "" Then
cell(ClickPosY, ClickPosX) = TextField.Text
ElseIf ColumnDrawUp(ClickPosX) = "r0" And ChangeSequence(TextField.Text) <> 0 Then
cell(ClickPosY, ClickPosX) = SpaceSup(Format(ChangeSequence(TextField.Text),"-,#"),ColumnWidth(ClickPosX) - 1)
ElseIf ColumnDrawUp(ClickPosX) = "r1" And ChangeSequence(TextField.Text) <> 0 Then
cell(ClickPosY, ClickPosX) = SpaceSup(Format(ChangeSequence(TextField.Text),"-,#.0"),ColumnWidth(ClickPosX) - 1)
ElseIf ColumnDrawUp(ClickPosX) = "r2" And ChangeSequence(TextField.Text) <> 0 Then
cell(ClickPosY, ClickPosX) = SpaceSup(Format(ChangeSequence(TextField.Text),"-,#.00"),ColumnWidth(ClickPosX) - 1)
Else
cell(ClickPosY, ClickPosX) = ""
End If
End If
If Columncount = ClickPosX Then
MoveRight()
TextField.Top = -100
Else
TextField.Text = ""
ClickPosX = ClickPosX + 1
TextField.Text = Cell(ClickPosY,ClickPosX)
TextField.Top = -100
End If
else
if TextField.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
134217984
0
0
s as String
Boolean
GetReady
1
1300342783
134217984
Sub GetReady()
ScrollBar.minimum = 1
ScrollBar.maximum = ScrollBar.Maximum - ScrollBar.PageStep
End Sub
134217984
0
0
DrawUp
1
2076706815
134217984
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
134217984
0
0
tString as String
MoveRight
1
797808639
134217984
Sub MoveRight()
if ClickPosX < ColumnCount then
ClickPosX = ClickPosX+ 1
MoveCell ClickPosY, ClickPosX
else
ClickPosX = 1
MoveDown()
end if
TextField.Text = Cell(ClickPosY,ClickPosX)
End Sub
134217984
0
0
MoveLeft
1
1171441663
134217984
Sub MoveLeft()
if ClickPosX > 1 then
ClickPosX = ClickPosX - 1
MoveCell ClickPosY, ClickPosX
else
ClickPosX = ColumnCount
MoveUp()
end if
TextField.Text = Cell(ClickPosY,ClickPosX)
End Sub
134217984
0
0
MoveUp
1
85383167
134217984
Sub MoveUp()
if ClickPosY > 1 then
ClickPosY = ClickPosY - 1
end if
if ClickPosY < topIndex then
topIndex = ClickPosY
end if
ScrollBar.value = topIndex
//MainListTextField.Enabled = False
Refresh
MoveCell ClickPosY, ClickPosX
TextField.Text = Cell(ClickPosY,ClickPosX)
End Sub
134217984
0
0
MoveDown
1
1942351871
134217984
Sub MoveDown()
if ClickPosX < 300 then
ClickPosY = ClickPosY + 1
end if
if ClickPosY > topIndex + rowCount then
topIndex = ClickPosY - rowCount
end if
ScrollBar.value = topIndex
//MainListTextField.Enabled = False
Refresh
MoveCell ClickPosY, ClickPosX
TextField.Text = Cell(ClickPosY,ClickPosX)
End Sub
134217984
0
0
ChangeSequence
1
992894975
134217984
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
134217984
0
0
tString as String
Double
SpaceSup
1
469819391
134217984
Function SpaceSup(tNumerical as String,tKeta as Integer) As String
Dim tString as String
tString = " " + tNumerical
tString = RightB(tString,tKeta)
Return tString
End Function
134217984
0
0
tNumerical as String,tKeta as Integer
String
RemoveString
1
964483071
134217984
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 Len(tString)
tReturnString = tReturnString + NthField(tString,tRemoveString,i)
Next
Return tReturnString
End Function
134217984
0
0
tString as String,tRemoveString as String
String
SubPaint
1
2001184767
134217984
Sub SubPaint()
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
headerheight=g.textheight+4
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, headerheight, w, h - headerheight
g.forecolor = rgb(184, 184, 184)
g.drawline w, 1, w, headerheight
g.drawline w, headerheight-2, 1, headerheight-2
x = 0
for i = 1 to ColumnCount
x = x + ColumnWidth(i) * cw
g.forecolor = rgb(64, 128, 64)
g.drawline x, 1, x, headerheight-1
g.forecolor = rgb(255, 255, 255)
g.drawline x+1, 1, x+1, headerheight-1
next
g.forecolor = rgb(0, 0, 0)
g.drawrect 0, 0, g.width-1, g.height-1 // frame
g.drawline 0,headerheight-1, w, headerheight-1 // header underline
x = 0
for i = 1 to ColumnCount
g.drawstring Header(i), x + 4, headerheight/2+g.textascent/2
x = x + ColumnWidth(i) * cw
next
Redraw g
End Sub
134217984
0
0
CellChange
134217984
33
0
Row as integer, Col as integer
ColumnCount
1
1743788031
134217984
ColumnCount As integer
134217984
ColumnCount As integer
0
0
ColumnWidth(32)
1
1192900607
134217984
ColumnWidth(32) As integer
134217984
ColumnWidth(32) As integer
0
0
TopIndex
1
715958271
134217984
TopIndex As integer
134217984
TopIndex As integer
0
0
Cell(2000,32)
1
1049915391
134217984
Cell(2000,32) As String
134217984
Cell(2000,32) As String
0
0
Header(32)
1
1265172479
134217984
Header(32) As String
134217984
Header(32) As String
0
0
CurrentRow
1
223916031
134217984
CurrentRow As integer
134217984
CurrentRow As integer
0
0
ClickPosX
1
479186943
134217984
ClickPosX As integer
134217984
ClickPosX As integer
0
0
ClickPosY
1
2035824639
134217984
ClickPosY As integer
134217984
ClickPosY As integer
0
0
TextField
1
1091827711
134217984
TextField As TextField
134217984
TextField As TextField
0
0
Mask(32)
1
1361858559
134217984
Mask(32) As String
134217984
Mask(32) As String
0
0
ScrollBar
1
324112383
134217984
ScrollBar As ScrollBar
134217984
ScrollBar As ScrollBar
0
0
EditMode
1
178198527
134217984
EditMode As integer
134217984
EditMode As integer
0
0
ColumnDrawUp(32)
1
1594279935
134217984
ColumnDrawUp(32) As String
134217984
ColumnDrawUp(32) As String
0
0
RowCount
1
633350143
134217984
RowCount As Integer
134217984
RowCount As Integer
0
0
Ver115
1
413691903
134217984
Ver115 As String
134217984
Ver115 As String
0
0
TextFont
1
1700710399
134217984
TextFont As String = "アニト-Ｌ等幅"
134217984
TextFont As String = "アニト-Ｌ等幅"
0
0
TextSize
1
179038207
134217984
TextSize As Integer = 14
134217984
TextSize As Integer = 14
0
0
headerheight
1
113367039
134217984
headerheight As Integer = 18
134217984
headerheight As Integer = 18
0
0
AllowAutoDeactivate
1
Appearance
True
Boolean
Tooltip
1
Appearance
String
MultiLineEditor
AllowFocusRing
1
Appearance
True
Boolean
AllowFocus
1
Behavior
False
Boolean
AllowTabs
1
Behavior
False
Boolean
Transparent
1
Behavior
True
Boolean
Name
1
ID
String
Index
1
ID
Integer
Super
1
ID
String
InitialParent
初期値
String
Left
1
Position
Integer
Top
1
Position
Integer
Width
1
Position
100
Integer
Height
1
Position
100
Integer
LockLeft
1
Position
Boolean
LockTop
1
Position
Boolean
LockRight
1
Position
Boolean
LockBottom
1
Position
Boolean
TabPanelIndex
Position
0
Integer
TabIndex
1
Position
0
Integer
TabStop
1
Position
True
Boolean
Visible
1
Appearance
True
Boolean
Enabled
1
Appearance
True
Boolean
Backdrop
1
Appearance
Picture
DoubleBuffer
1
Behavior
False
Boolean
ColumnCount
Behavior
integer
TopIndex
Behavior
integer
CurrentRow
Behavior
integer
ClickPosX
Behavior
integer
ClickPosY
Behavior
integer
EditMode
Behavior
integer
RowCount
Behavior
Integer
Ver115
Behavior
String
MultiLineEditor
TextFont
1
Behavior
アニト-Ｌ等幅
String
MultiLineEditor
TextSize
1
Behavior
14
Integer
headerheight
Behavior
18
Integer
DateFieldClass
32
1
TextField
1
0
KeyDown
1
895803391
134217984
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
1
333228031
134217984
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
1
876290047
134217984
Sub GotFocus()
redraw
EnterField
End Sub
Open
1
1676005375
134217984
Sub Open()
dim s as string
me.date = new date
Year = date.Year
Month = date.Month
Day = date.Day
currentPos = 3
redraw
End Sub
redraw
1
1400895487
134217984
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
134217984
0
0
Inc
1
116987903
134217984
Sub Inc()
select case currentPos
case 1//Year
IncYear()
case 2//Month
IncMonth()
case 3//Day
IncDay()
end select
Redraw
End Sub
134217984
0
0
Dec
1
1339162623
134217984
Sub Dec()
select case currentPos
case 1//Year
DecYear()
case 2//Month
DecMonth()
case 3//Day
DecDay()
end select
Redraw
End Sub
134217984
0
0
IsLeapYear
1
1006473215
134217984
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
134217984
0
0
Boolean
GetDaysOfMonth
1
725807103
134217984
Function GetDaysOfMonth() As Integer
dim days as integer
//その月の日数を返す
days = val(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
134217984
0
0
Integer
DecMonth
1
1596719103
134217984
Sub DecMonth()
Month = Month - 1
if Month = 0 then
DecYear()
Month = 12
end if
End Sub
134217984
0
0
DecDay
1
1999276031
134217984
Sub DecDay()
Day = Day - 1
if Day = 0 then
DecMonth()
Day = GetDaysOfMonth()
end if
End Sub
134217984
0
0
IncMonth
1
133208063
134217984
Sub IncMonth()
Month = Month + 1
if Month = 13 then
Month = 1
IncYear()
end if
End Sub
134217984
0
0
IncDay
1
199456767
134217984
Sub IncDay()
Day = Day + 1
if Day > GetDaysOfMonth() then
Day = 1
IncMonth()
end if
End Sub
134217984
0
0
IncYear
1
466538495
134217984
Sub IncYear()
Year = Year + 1
if Year > 2100 then
Year = 2100
end if
End Sub
134217984
0
0
DecYear
1
2068029439
134217984
Sub DecYear()
Year = Year - 1
if Year < 1920 then
Year = 1920
end if
End Sub
134217984
0
0
EnterField
134217984
33
0
year
1
1787521023
134217984
year As integer
134217984
year As integer
0
0
month
1
180004863
134217984
month As integer
134217984
month As integer
0
0
day
1
467439615
134217984
day As integer
134217984
day As integer
0
0
weekDay
1
1414731775
134217984
weekDay As integer
134217984
weekDay As integer
0
0
date
1
508231679
134217984
date As date
134217984
date As date
0
0
format
1
138768383
134217984
format As string
134217984
format As string
0
0
currentPos
1
438484991
134217984
currentPos As integer
134217984
currentPos As integer
0
0
RedrawFlg
1
126795775
134217984
RedrawFlg As boolean
134217984
RedrawFlg As boolean
0
0
AllowAutoDeactivate
1
Appearance
True
Boolean
BackgroundColor
1
Appearance
&hFFFFFF
Color
Color
HasBorder
1
Appearance
True
Boolean
Tooltip
1
Appearance
String
MultiLineEditor
Transparent
1
Appearance
False
Boolean
AllowFocusRing
1
Appearance
True
Boolean
FontName
1
Font
System
String
FontSize
1
Font
0
Single
FontUnit
1
Font
0
FontUnits
Enum
0 - Default
1 - Pixel
2 - Point
3 - Inch
4 - Millimeter
Hint
1
Initial State
String
MultiLineEditor
AllowTabs
1
Behavior
False
Boolean
TextAlignment
1
Behavior
0
TextAlignments
Enum
0 - Default
1 - Left
2 - Center
3 - Right
AllowSpellChecking
1
Behavior
False
boolean
MaximumCharactersAllowed
1
Behavior
0
Integer
ValidationMask
1
Behavior
String
Name
1
ID
String
Index
1
ID
Integer
Super
1
ID
String
Left
1
Position
Integer
Top
1
Position
Integer
Width
1
Position
80
Integer
Height
1
Position
22
Integer
LockLeft
1
Position
Boolean
LockTop
1
Position
Boolean
LockRight
1
Position
Boolean
LockBottom
1
Position
Boolean
TabPanelIndex
Position
0
Integer
TabIndex
1
Position
0
Integer
TabStop
1
Position
True
Boolean
Password
1
Appearance
Boolean
TextColor
1
Appearance
&h000000
Color
Color
Enabled
1
Appearance
True
Boolean
Format
1
Appearance
String
Visible
1
Appearance
True
Boolean
Bold
1
Font
Boolean
Italic
1
Font
Boolean
Underline
1
Font
Boolean
Text
1
Initial State
String
MultiLineEditor
ReadOnly
1
Behavior
Boolean
DataSource
1
Database Binding
String
DataSource
DataField
1
Database Binding
String
DataField
year
Behavior
integer
month
Behavior
integer
day
Behavior
integer
weekDay
Behavior
integer
currentPos
Behavior
integer
RedrawFlg
Behavior
boolean
Spin
32
1
Canvas
1
0
Open
1
1914978303
134217984
Sub Open()
value = 0
maximum = 100
minimum = 0
stepValue = 1
End Sub
MouseUp
1
1744263167
134217984
Sub MouseUp(X As Integer, Y As Integer)
dim g as Graphics
g = me.graphics
redraw g
MouseClick
End Sub
MouseDown
1
214851583
134217984
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
1
1120776191
134217984
Sub Paint(g As Graphics, areas() As REALbasic.Rect)
redraw g
End Sub
redraw
1
497149951
134217984
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
134217984
0
0
g as graphics
MouseClick
134217984
33
0
UpClick
134217984
33
0
DownClick
134217984
33
0
value
1
1952024575
134217984
value As integer
134217984
value As integer
0
0
minimum
1
988833791
134217984
minimum As integer
134217984
minimum As integer
0
0
maximum
1
1311592447
134217984
maximum As integer
134217984
maximum As integer
0
0
stepValue
1
1096237055
134217984
stepValue As integer
134217984
stepValue As integer
0
0
AllowAutoDeactivate
1
Appearance
True
Boolean
Tooltip
1
Appearance
String
MultiLineEditor
AllowFocusRing
1
Appearance
True
Boolean
AllowFocus
1
Behavior
False
Boolean
AllowTabs
1
Behavior
False
Boolean
Transparent
1
Behavior
True
Boolean
Name
1
ID
String
Index
1
ID
Integer
Super
1
ID
String
Left
1
Position
Integer
Top
1
Position
Integer
Width
1
Position
100
Integer
Height
1
Position
100
Integer
LockLeft
1
Position
Boolean
LockTop
1
Position
Boolean
LockRight
1
Position
Boolean
LockBottom
1
Position
Boolean
TabPanelIndex
Position
0
Integer
TabIndex
1
Position
0
Integer
TabStop
1
Position
True
Boolean
Visible
1
Appearance
True
Boolean
Enabled
1
Appearance
True
Boolean
Backdrop
1
Appearance
Picture
DoubleBuffer
1
Behavior
False
Boolean
InitialParent
String
value
Behavior
integer
minimum
Behavior
integer
maximum
Behavior
integer
stepValue
Behavior
integer
CellButton
32
1
Canvas
1
0
MouseUp
1
2036932607
134217984
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
1
1341878271
134217984
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
679739391
134217984
Sub Paint(g As Graphics, areas() As REALbasic.Rect)
MakeButton g
End Sub
Open
1
379836415
134217984
Sub Open()
ChangeButtonColor()
ChangeButtonColorDark()
ChangeButtonColorLight()
PushButtonCol = -1
PushButtonRow = -1
LeftMargin = 1
TopMargin = 1
End Sub
ChangeButtonColor
1
620351487
134217984
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
134217984
0
0
ChangeButtonColorDark
1
1234307071
134217984
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
134217984
0
0
RedrawDown
1
1961879551
134217984
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
134217984
0
0
tGraphics as Graphics,CellX as Integer,CellY as Integer
RedrawUp
1
846847999
134217984
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
134217984
0
0
tGraphics as Graphics,CellX as Integer,CellY as Integer
MakeButton
1
1391499263
134217984
Sub MakeButton(tGraph as Graphics)
Dim i as Integer
Dim j as Integer
cellWidth=(width-3)/ColCount
cellHeight=(height-3)/rowCount
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
134217984
0
0
tGraph as Graphics
ChangeButtonColorLight
1
1720524799
134217984
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
134217984
0
0
MouseUp
134217984
33
0
Col as Integer,Row as Integer
MouseDown
134217984
33
0
Col as Integer,Row as Integer
MouseClick
134217984
33
0
Col as Integer,Row as Integer
ButtonName(96,32)
1
268578815
134217984
ButtonName(96,32) As String
134217984
ButtonName(96,32) As String
0
0
ColCount
1
1355610111
134217984
ColCount As Integer
134217984
ColCount As Integer
0
0
RowCount
1
271310847
134217984
RowCount As Integer
134217984
RowCount As Integer
0
0
CellWidth
1
974235647
134217984
CellWidth As Double
134217984
CellWidth As Double
0
0
CellHeight
1
2049732607
134217984
CellHeight As Double
134217984
CellHeight As Double
0
0
TextFont
1
70932479
134217984
TextFont As String
134217984
TextFont As String
0
0
TextSize
1
50735103
134217984
TextSize As Integer
134217984
TextSize As Integer
0
0
ButtonColor(96,32)
1
234758143
134217984
ButtonColor(96,32) As Integer
134217984
ButtonColor(96,32) As Integer
0
0
ButtonData1(96,32)
1
1855899647
134217984
ButtonData1(96,32) As String
134217984
ButtonData1(96,32) As String
0
0
Ver110
1
580442111
134217984
Ver110 As String
134217984
Ver110 As String
0
0
ButtonType
1
2032707583
134217984
ButtonType As Integer
134217984
ButtonType As Integer
0
0
ButtonStatus(96,32)
1
621690879
134217984
ButtonStatus(96,32) As Integer
134217984
ButtonStatus(96,32) As Integer
0
0
PushButtonCol
1
1494814719
134217984
PushButtonCol As Integer
134217984
PushButtonCol As Integer
0
0
PushButtonRow
1
1611204607
134217984
PushButtonRow As Integer
134217984
PushButtonRow As Integer
0
0
BadName
1
1036316671
134217984
BadName As String
134217984
BadName As String
0
0
gButtonColor(10)
1
307486719
134217984
gButtonColor(10) As Color
134217984
gButtonColor(10) As Color
0
0
gButtonColorDark(10)
1
624824319
134217984
gButtonColorDark(10) As Color
134217984
gButtonColorDark(10) As Color
0
0
ButtonData2(96,32)
1
868651007
134217984
ButtonData2(96,32) As String
134217984
ButtonData2(96,32) As String
0
0
gButtonColorLight(10)
1
1586876415
134217984
gButtonColorLight(10) As Color
134217984
gButtonColorLight(10) As Color
0
0
LeftMargin
1
838307839
134217984
LeftMargin As Integer
134217984
LeftMargin As Integer
0
0
TopMargin
1
507025407
134217984
TopMargin As Integer
134217984
TopMargin As Integer
0
0
AllowAutoDeactivate
1
Appearance
True
Boolean
Tooltip
1
Appearance
String
MultiLineEditor
AllowFocusRing
1
Appearance
True
Boolean
AllowFocus
1
Behavior
False
Boolean
AllowTabs
1
Behavior
False
Boolean
Transparent
1
Behavior
True
Boolean
Name
1
ID
String
Index
1
ID
Integer
Super
1
ID
String
Left
1
Position
Integer
Top
1
Position
Integer
Width
1
Position
100
Integer
Height
1
Position
100
Integer
LockLeft
1
Position
Boolean
LockTop
1
Position
Boolean
LockRight
1
Position
Boolean
LockBottom
1
Position
Boolean
TabPanelIndex
Position
0
Integer
TabIndex
1
Position
0
Integer
TabStop
1
Position
True
Boolean
Visible
1
Appearance
True
Boolean
Enabled
1
Appearance
True
Boolean
Backdrop
1
Appearance
Picture
DoubleBuffer
1
Behavior
False
Boolean
InitialParent
String
ColCount
Behavior
Integer
RowCount
Behavior
Integer
CellWidth
Behavior
Double
CellHeight
Behavior
Double
TextFont
Behavior
String
MultiLineEditor
TextSize
Behavior
Integer
Ver110
Behavior
String
MultiLineEditor
ButtonType
Behavior
Integer
PushButtonCol
Behavior
Integer
PushButtonRow
Behavior
Integer
BadName
Behavior
String
MultiLineEditor
LeftMargin
Behavior
Integer
TopMargin
Behavior
Integer
LabelButton
32
1
Canvas
1
0
MouseUp
1
1617860607
134217984
Sub MouseUp(X As Integer, Y As Integer)
Redraw Graphics
MouseClick
End Sub
MouseDown
1
1096747007
134217984
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
1938339839
134217984
Sub Paint(g As Graphics, areas() As REALbasic.Rect)
Redraw g
End Sub
Redraw
1
1609324543
134217984
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
134217984
0
0
g as Graphics
MouseClick
134217984
33
0
AllowAutoDeactivate
1
Appearance
True
Boolean
Tooltip
1
Appearance
String
MultiLineEditor
AllowFocusRing
1
Appearance
True
Boolean
AllowFocus
1
Behavior
False
Boolean
AllowTabs
1
Behavior
False
Boolean
Transparent
1
Behavior
True
Boolean
Name
1
ID
String
Index
1
ID
Integer
Super
1
ID
String
Left
1
Position
Integer
Top
1
Position
Integer
Width
1
Position
100
Integer
Height
1
Position
100
Integer
LockLeft
1
Position
Boolean
LockTop
1
Position
Boolean
LockRight
1
Position
Boolean
LockBottom
1
Position
Boolean
TabPanelIndex
Position
0
Integer
TabIndex
1
Position
0
Integer
TabStop
1
Position
True
Boolean
Visible
1
Appearance
True
Boolean
Enabled
1
Appearance
True
Boolean
Backdrop
1
Appearance
Picture
DoubleBuffer
1
Behavior
False
Boolean
InitialParent
String
CalendarClass
32
1
Canvas
1
0
MouseUp
1
983285759
134217984
Sub MouseUp(X As Integer, Y As Integer)
DrawDayCell previousDay, 1, Graphics
End Sub
MouseExit
1
627294207
134217984
Sub MouseExit()
DrawDayCell previousDay, 2, Graphics
previousDay = 32
End Sub
MouseMove
1
1122277375
134217984
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
1
413337599
134217984
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
Open
1
1187987455
134217984
Sub Open()
dim d as Date
dim g as Graphics
g = Graphics
offScrn = newPicture(g.width, g.height,32)
d = new Date
Year = d.Year
Month = d.Month
Day = d.Day
CurrentYear = d.year
CurrentMonth = d.Month
Today = d.day
SideMargin = 8
TitleHeight = TextSize
//TextSize = 18
SelectTextSize = TextSize
TitleTextSize = TextSize*2
Redraw
End Sub
Paint
1
2138169343
134217984
Sub Paint(g As Graphics, areas() As REALbasic.Rect)
g.DrawPicture OffScrn, 0, 0, g.width, g.height, 0, 0, g.width, g.height
End Sub
IsLeapYear
1
131579903
134217984
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
134217984
0
0
Boolean
GetDaysOfMonth
1
855250943
134217984
Function GetDaysOfMonth(tMonth as Integer) As Integer
//その月の日数を返す
dim days as integer
days = val(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
134217984
0
0
tMonth as Integer
Integer
GetDayOfWeek
1
1874018303
134217984
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
134217984
0
0
tDay as integer
Integer
DrawDayCell
1
1468846079
134217984
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
134217984
0
0
tDay as integer, tAttr as integer, g as Graphics
IncMonth
1
245104639
134217984
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
134217984
0
0
DecMonth
1
1027465215
134217984
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
134217984
0
0
Redraw
1
1740898303
134217984
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(224,224,224)
g.FillRect 2, 2, w- 4, h - 4
//タイトルの描画
g.ForeColor = rgb(192, 192, 192)
//後日ルーチン化
g.TextFont = "Verdana"
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 = "Verdana"
g.TextSize = TextSize-TextSize/10
g.Bold = false
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 nthField("SUN MON TUE WED THU FRI SAT", " ", i + 1), w / 7 * i + DaysLeft + w / 7 / 2 - g.TextHeight / 2 * 3 / 2, TitleHeight/2 + g.TextHeight/2
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
134217984
0
0
MouseClick
134217984
33
0
Year
1
1964144639
134217984
Year As integer
134217984
Year As integer
0
0
Month
1
1988188159
134217984
Month As integer
134217984
Month As integer
0
0
Day
1
1746173951
134217984
Day As integer
134217984
Day As integer
0
0
TitleHeight
1
649711615
134217984
TitleHeight As integer
134217984
TitleHeight As integer
0
0
SideMargin
1
964847615
134217984
SideMargin As integer
134217984
SideMargin As integer
0
0
DaysLeft
1
316403711
134217984
DaysLeft As integer
134217984
DaysLeft As integer
0
0
DaysTop
1
626890751
134217984
DaysTop As integer
134217984
DaysTop As integer
0
0
DaysWidth
1
2110908415
134217984
DaysWidth As integer
134217984
DaysWidth As integer
0
0
DaysHeight
1
1668702207
134217984
DaysHeight As integer
134217984
DaysHeight As integer
0
0
PreviousDay
1
1577101311
134217984
PreviousDay As integer
134217984
PreviousDay As integer
1
0
TitleTextSize
1
1032902655
134217984
TitleTextSize As integer = 32
134217984
TitleTextSize As integer = 32
0
0
TextSize
1
1328504831
134217984
TextSize As integer = 14
134217984
TextSize As integer = 14
0
0
SelectTextSize
1
1316249599
134217984
SelectTextSize As integer
134217984
SelectTextSize As integer
0
0
Today
1
907591679
134217984
Today As integer
134217984
Today As integer
0
0
OffScrn
1
1411713023
134217984
OffScrn As Picture
134217984
OffScrn As Picture
0
0
CurrentMonth
1
620169215
134217984
CurrentMonth As integer
134217984
CurrentMonth As integer
0
0
CurrentYear
1
318345215
134217984
CurrentYear As integer
134217984
CurrentYear As integer
0
0
AllowAutoDeactivate
1
Appearance
True
Boolean
Tooltip
1
Appearance
String
MultiLineEditor
AllowFocusRing
1
Appearance
True
Boolean
AllowFocus
1
Behavior
False
Boolean
AllowTabs
1
Behavior
False
Boolean
Transparent
1
Behavior
True
Boolean
Name
1
ID
String
Index
1
ID
Integer
Super
1
ID
String
InitialParent
初期値
String
Left
1
Position
Integer
Top
1
Position
Integer
Width
1
Position
100
Integer
Height
1
Position
100
Integer
LockLeft
1
Position
Boolean
LockTop
1
Position
Boolean
LockRight
1
Position
Boolean
LockBottom
1
Position
Boolean
TabPanelIndex
Position
0
Integer
TabIndex
1
Position
0
Integer
TabStop
1
Position
True
Boolean
Visible
1
Appearance
True
Boolean
Enabled
1
Appearance
True
Boolean
Backdrop
1
Appearance
Picture
DoubleBuffer
1
Behavior
False
Boolean
Year
Behavior
integer
Month
Behavior
integer
Day
Behavior
integer
TitleHeight
Behavior
integer
SideMargin
Behavior
integer
DaysLeft
Behavior
integer
DaysTop
Behavior
integer
DaysWidth
Behavior
integer
DaysHeight
Behavior
integer
TitleTextSize
Behavior
32
integer
TextSize
1
Behavior
14
integer
SelectTextSize
1
Behavior
integer
Today
Behavior
integer
OffScrn
Behavior
Picture
CurrentMonth
Behavior
integer
CurrentYear
Behavior
integer
MonthCalendarClass
32
1
Canvas
1
0
MouseDown
1
169129983
134217984
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
refresh
MouseClick()
return true
end if
next
End Function
Open
1
274042879
134217984
Sub Open()
dim d as date
dim g as Graphics
g = Graphics
offScrn = newPicture(g.width, g.height,32)
Calendar(0) = newPicture((g.width-4)/3-8, g.height-4-8, 32)
Calendar(1) = newPicture((g.width-4)/3-8, g.height-4-8, 32)
Calendar(2) = newPicture((g.width-4)/3-8, g.height-4-8, 32)
d = new date
Year = d.Year
Month = d.Month
CurrentYear = Year
CurrentMonth = Month
End Sub
Paint
1
1560872959
134217984
Sub Paint(g As Graphics, areas() As REALbasic.Rect)
Redraw
End Sub
DrawCalendar
1
679493631
134217984
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(224,224,224)
g.FillRect 0, 0, g.width, g.height
//曜日描画
g.TextFont = "アニト-Ｍ等幅"
g.TextSize = 16
for i = 0 to 6
select case i
case 0
g.ForeColor = rgb(192, 128, 128)
case 6
g.ForeColor = rgb(128, 128, 192)
else
g.ForeColor = rgb(128, 128, 128)
end select
g.DrawString 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(192, 128, 128)
case 6
g.ForeColor = rgb(128, 128, 192)
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 = 80
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 = 32
if tMonth = 1 then
g.DrawString str(tYear) + ".", l, t + g.textheight
end if
End Sub
134217984
0
0
index as integer, tYear as integer, tMonth as integer
IsLeapYear
1
541870079
134217984
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
134217984
0
0
tYear as integer
Boolean
GetDaysOfMonth
1
129003519
134217984
Function GetDaysOfMonth(tYear as integer, tMonth as integer) As Integer
//その月の日数を返す
dim days as integer
days = val(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
134217984
0
0
tYear as integer, tMonth as integer
Integer
GetDayOfWeek
1
1679101951
134217984
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
134217984
0
0
tYear as integer, tMonth as integer
Integer
DecMonth
1
353806335
134217984
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
134217984
0
0
IncMonth
1
1822646271
134217984
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
'refresh
'next
g.DrawPicture OffScrn, 0, 0, g.width, g.height, 0, 0, g.width, g.height
End Sub
134217984
0
0
Redraw
1
1855154175
134217984
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
134217984
0
0
DrawAll
1
1134843903
134217984
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 tMonth as integer
dim tYear as integer
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(224,224,224)
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(192,192,192)
g.DrawLine r-1, t+1, r-1, b-1
g.DrawLine r-1, b-1, l+1, b-1
g.ForeColor = rgb(160,160,160)
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
134217984
0
0
MakeCalendar
1
1655988223
134217984
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
134217984
0
0
MouseClick
134217984
33
0
Year
1
175230975
134217984
Year As integer
134217984
Year As integer
0
0
Month
1
1704161279
134217984
Month As integer
134217984
Month As integer
0
0
OffScrn
1
1011447807
134217984
OffScrn As Picture
134217984
OffScrn As Picture
0
0
CurrentMonth
1
1296893951
134217984
CurrentMonth As integer
134217984
CurrentMonth As integer
0
0
CurrentYear
1
1264928767
134217984
CurrentYear As integer
134217984
CurrentYear As integer
0
0
Calendar(3)
1
1299179519
134217984
Calendar(3) As Picture
134217984
Calendar(3) As Picture
0
0
AllowAutoDeactivate
1
Appearance
True
Boolean
Tooltip
1
Appearance
String
MultiLineEditor
AllowFocusRing
1
Appearance
True
Boolean
AllowFocus
1
Behavior
False
Boolean
AllowTabs
1
Behavior
False
Boolean
Transparent
1
Behavior
True
Boolean
Name
1
ID
String
Index
1
ID
Integer
Super
1
ID
String
Left
1
Position
Integer
Top
1
Position
Integer
Width
1
Position
100
Integer
Height
1
Position
100
Integer
LockLeft
1
Position
Boolean
LockTop
1
Position
Boolean
LockRight
1
Position
Boolean
LockBottom
1
Position
Boolean
TabPanelIndex
Position
0
Integer
TabIndex
1
Position
0
Integer
TabStop
1
Position
True
Boolean
Visible
1
Appearance
True
Boolean
Enabled
1
Appearance
True
Boolean
Backdrop
1
Appearance
Picture
DoubleBuffer
1
Behavior
False
Boolean
InitialParent
String
Year
Behavior
integer
Month
Behavior
integer
OffScrn
Behavior
Picture
CurrentMonth
Behavior
integer
CurrentYear
Behavior
integer
Build Automation
0
Linux
1374586879
Build
1325434879
Mac OS X
1374586879
Build
1922693119
Sign
1922693119
Windows
1374586879
Build
1959622655
0
1
0
0