表計算風？項目入力例 <TOP>
表計算のような項目に入力する場合、FlexGridのようなものがないので文字数固定のセルを２頁に分けて入力する方法を考えてみました。
エディットボックスで入力しフォーカスが外れるとピクチャボックスに書き出しています。
マウスを置いたセルは淡い黄色の背景色になり、文字入力後【Enter】押下で次のセルに移動します。
図の例では、住所１のセル入力後【Enter】で次のセルに移動しますが、住所２のセルは途中で切れているので２頁目に切り替わります。
セルに文字が入っている場合は文字の最後尾にカーソルが移動し、数値が入っている場合は全範囲選択状態で入力待ちになります。
手っ取り早く試用できるようGRID.LZHにテストデータ共々入れてあります。
メインフォームにエディットボックス、ピクチャボックス、水平スクロールバー、コマンドボタンを貼り付けます。
エディットボックス：複数行入力あり(Enter移動部の方法にる)、垂直オートスクロールあり、３D表示なし、可視なしに設定します。
枠無し、背景色を淡い黄色に設定するためリソースを書き換える必要があります。
フォーム ：ピクセルモード
ピクチャボックス ：ピクセルモード、境界線あり、境界線あり、可視なしに設定。保存ボタンは確認のために設けています。
スクロールバー ：あまり意味はありません。テスト用です。
リソースの書き換え（初期状態）
__BEGIN
__CREATE3, XWT_EDIT, 0x40810144L, 0x0L
__ATTRDATA3, 0x0L
__WINDOWTITLE, "\0"
__CONTROLNAME, "EDIT1\0"
__LIMITTEXT3, 0x12L
__CTRLTEXTCOLOR, 0x0L
__CTRLBACKCOLOR, 0xffffffL
__FONTSIZE, 8
__FONTNAME2, "ＭＳ ゴシック\0",
1, 186
__IMEMODE3, 0x1L
__WINDOWSIZE3, 0x0L, 0x10L,
0x22L, 0x5eL, 0x16L
__EVENT
上記赤文字の部分を下記のとおり書き換えます。
イ.境界線なし
__CREATE3,
XWT_EDIT, 0x40810144L, 0x0L
↓8を0に
__CREATE3,
XWT_EDIT, 0x40010144L, 0x0L
ロ.白を薄い黄色に(あまり薄色に設定すると液晶では判別しにくいようです)
__CTRLBACKCOLOR,
0xffffffL
↓
__CTRLBACKCOLOR,
0xe0ffffL
'================================================================
'= EXCEL風入力テスト
'================================================================
#include "Windows.bi"
Var Shared MainForm As Object
Var Shared Edit As Object
Var Shared Picture As Object
Var Shared HScroll As Object
Var Shared Button As Object
Var Shared CrLf$ As String '
Var Shared EPos As Integer 'CRLF取得位置(Enter移動用)
Var Shared Col As Integer '列番号(項目)
Var Shared Row As Integer '行番号
Var Shared ColMax As Integer 'セル最大値
Var Shared ColMax1 As Integer '１面表示(1～Col1)
Var Shared ColMax2 As Integer '２面表示(ColMax2～ColMax)
Var Shared RowMax As Integer '行最大値
Var Shared RowHeight As Integer '行間隔
Var Shared YPos As Integer 'Y軸(横罫線､文字表示位置)
Var Shared XPos(21) As Integer 'X軸(縦罫線､文字表示位置)
Var Shared Mx As Integer 'X軸(マウスクリック位置)
Var Shared My As Integer 'Y軸(マウスクリック位置)
Var Shared Dt$(21,30) As String 'データ格納(最大20×30)
Var Shared Item$(21,3) As String '0:項目名 1:文字数 2:IME制御 3:数値扱
Var Shared CellWidth(21) As Integer 'セル幅
Var Shared FtName$ As String 'フォント
Var Shared FrameTop As Integer '枠上位置
Var Shared FrameBottom As Integer '枠下位置
Var Shared FrameLeft As Integer '枠左位置
Var Shared FrameRight As Integer '枠右位置
Var Shared FrameWidth As Integer '１面+２面項目総幅
Var Shared FrameWidth2 As Integer '２面項目総幅
Var Shared FontSize As Integer 'フォントサイズ
Var Shared FrmWidth As Integer 'フォーム幅
Var Shared FrmHeight As Integer 'フォーム高
Var Shared DataMax As Long '
Var Shared PageFlg As byte '1面/2面
Var Shared ColOfst As Integer '
Var Shared OffSet As Integer '
MainForm.Attach GethWnd
Edit.Attach GetDlgItem("Edit1")
Picture.Attach GetDlgItem("Picture1")
HScroll.Attach GetDlgItem("HScroll1")
Button.Attach GetDlgItem("Button1")
Declare Sub MainForm_Start edecl ()
Declare Sub Picture1_Click edecl () 'マウスクリック位置確認
Declare Sub EditBox_Move edecl () 'EditBox表示位置
Declare Sub Grid_Draw edecl () '★Picture1
Declare Sub Data_Read edecl ()
Declare Sub Data_Dsp edecl ()
Declare Sub Separate_Point edecl ()
'================================================================
'= 例：20項目のデータを用意
'================================================================
Sub MainForm_Start()
SetMapMode 1
CrLf$ = Chr$(13,10)
'▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼▼
' 項目名 半角換算文字数 IME制御 文字･数値
' Item$(x,0) Item$(x,1) Item$(x,2) Item$(x,3)
'--------------------------------------------------
data "名前" ,20 ,4 ,0
data "ヨミ" ,10 ,6 ,0
data "敬称" ,6 ,4 ,0
data "連名１" ,8 ,4 ,0
data "連名２" ,8 ,4 ,0
data "連名３" ,8 ,4 ,0
data "会社名" ,20 ,4 ,0
data "役職" ,14 ,4 ,0
data "〒№" ,8 ,2 ,0
data "住所１" ,40 ,4 ,0
data "住所２" ,40 ,4 ,0
data "電話" ,15 ,2 ,0
data "金額" ,10 ,2 ,1
data "文字１" ,10 ,4 ,0
data "文字２" ,16 ,4 ,0
data "文字３" ,20 ,4 ,0
data "数値１" ,8 ,2 ,1
data "数値２" ,8 ,2 ,1
data "数値３" ,8 ,2 ,1
data "数値４" ,8 ,2 ,1
'--------------------------------------------------
If GetDeviceCaps(8) < 1280 Then
FontSize = 12 'フォントサイズ(18P以下偶数)
Else
FontSize = 14 'フォントサイズ(18P以下偶数)
End If
ColMax = 20 '項目数
RowMax = 30 '行数
RowHeight = FontSize + 8 '行間隔(ﾄﾞｯﾄ)文字位置(上4ﾄﾞｯﾄ/下4ﾄﾞｯﾄ)
FrameLeft = 24 'グリッド左位置
FrameTop = 24 'グリッド上位置
FrameBottom = FrameTop + RowMax * RowHeight 'グリッド下位置
FtName$ = "ＭＳ ゴシック"
MainForm.MaximizeWindow 'フォーム最大
MainForm.MoveWindow 0, 0
FrmWidth = MainForm.GetWidth 'フォーム幅
FrmHeight = MainForm.GetHeight 'フォーム高
MainForm.ShowWindow -1 '
'▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲▲
MainForm.SetFontName FtName$
Picture.SetFontName FtName$
Picture.SetFontBold 0
MainForm.SetFontSize FontSize
Picture.SetFontSize FontSize
Button.SetFontSize FontSize
'******************************
'項目名,入力可能文字数(半角換算),IME制御読込
'******************************
XPos(0) = 0
FrameWidth = 0
For i = 1 To ColMax
For J = 0 To 3
Read Item$(I, J)
Next J
If i > 0 Then CellWidth(I) = Val(Item$(i, 1)) * FontSize / 2 + 8 '+8：文字前後4ﾄﾞｯﾄ
XPos(i) = XPos(i - 1) + CellWidth(i) + 1
FrameWidth = FrameWidth + CellWidth(i) + 1 'グリッド幅
Next I
'------------------------------
'ピクチャボックス用意
'------------------------------
Picture.SetWindowSize FrmWidth - 8 - FrameLeft * 2, FrameBottom '-8(4 * 2：フォーム枠立体部)
Picture.MoveWindow FrameLeft, FrameTop
Button.SetWindowSize 30, 24 '保存(テスト用)
Button.MoveWindow 4, FrmHeight - 60 '
Button.ShowWindow -1
Separate_Point '面/２面区切位置取得
If RowMax * RowHeight + FrameTop + 20 > FrmHeight Then
A% = MessageBox(GetWindowText, "行数を減らしてください！", 0, 2) : Stop : End
Else If FrameWidth2 > FrmWidth - 8 - FrameLeft * 2 Then
A% = MessageBox(GetWindowText, "フィールド数を減らすかフォントサイズを小さくしてください！", 0, 2) : Stop : End
Else If FontSize Mod 2 <> 0 Then
A% = MessageBox(GetWindowText, "フォントサイズは偶数で指定してください！", 0, 2) : Stop : End
End If
PageFlg = 0
OffSet = 0
Col = 1
Row = 1
Grid_Draw
Data_Read
Data_Dsp
Picture.ShowWindow -1
EditBox_Move
End sub
'================================================================
'= 切替位置取得
'================================================================
Sub Separate_Point()
WD = 0
For i = 1 To ColMax
WD = WD + CellWidth(I) + 1
If WD > FrmWidth - FrameLeft * 2 Then
ColMax1 = i - 1 '★１面(1～ColMax1)
Exit For
End If
Next i
WD = 0
For i = ColMax To 1 Step -1
WD = WD + CellWidth(i) + 1
If WD >= FrmWidth - FrameLeft * 2 Then
ColMax2 = i '★２面(ColMax2～ColMax)
Exit For
End If
Next i
WD = 0
For i = ColMax1 + 1 To ColMax
WD = WD + CellWidth(i) + 1
Next i
FrameWidth2 = WD '２面項目総幅
WD = 0
For i = 1 To ColMax2
WD = WD + CellWidth(i) + 1
Next i
ColOfst = WD 'オフセット
End sub
'================================================================
'= Picture1描画
'================================================================
Sub Grid_Draw()
Picture.Cls
Picture.Line(XPos(0), 0) - (XPos(ColMax) - 1, RowHeight), , 14, bf '項目名下罫線
For i = 0 To ColMax
Picture.Line(XPos(i) - OffSet, 0)-(XPos(i) - OffSet, RowHeight), , 1 '縦罫線(項目)
Picture.Line(XPos(i + 1) - OffSet, RowHeight) - (XPos(i + 1) - OffSet, FrameBottom), , 14 '縦罫線
If i < ColMax Then Picture.Line(XPos(i) - OffSet + 1, 0) - (XPos(i) - OffSet + 1, RowHeight), , 15 '縦罫線
Next
Picture.Line(XPos(0), RowHeight) - (XPos(ColMax) - 1, RowHeight), , 1 '項目名下罫線
Picture.Line(XPos(0), 1) - (XPos(ColMax), 1), , 15 '横罫線
Picture.Line(XPos(0), RowHeight) - (XPos(ColMax), RowHeight), , 1 '横罫線
For i = RowHeight * 2 To RowHeight * RowMax Step RowHeight
Picture.Line(XPos(0), i) - (XPos(ColMax), i), , 14 '横罫線
Next
Picture.Line(XPos(0), 0) - (FrmWidth - FrameLeft * 2 - 1, FrameBottom), , 0, b '外枠(ﾋﾟｸﾁｭｱﾎﾞｯｸｽ境界線なし時)
HScroll.SetWindowSize FrmWidth - 8 - FrameLeft * 2, 16
HScroll.MoveWindow FrameLeft, FrameBottom + RowHeight + 4
HScroll.ShowWindow -1
HScroll.SetScrollRange 0, ColMax + 1
HScroll.SetScrollPos Col
HScroll.SetScrollStep 1, 1
For i = 1 To ColMax
Picture.Symbol(XPos(i - 1) - OffSet + (CellWidth(i) - Len(Item$(i, 0)) * FontSize / 2) / 2 + 4, 6), Item$(i, 0), 1, 1, 0
Next
Data_Dsp
End sub
'================================================================
'= データ表示
'================================================================
Sub Data_Dsp()
YPos = RowHeight
If PageFlg = 0 Then
ST = 1
ED = ColMax
Else
ST = ColMax2 + 1
ED = ColMax
End If
For i = 1 To RowMax
For j = ST To ED
If Val(Item$(J, 3)) = 1 Then '数値表示
Num$ = Right$("###,###,###,###",Val(Item$(J, 1)))
If Left$(Num$, 1) = "," Then Num$ = " " & Right$(Num$, Len(Num$) -1)
Picture.Symbol(XPos(J - 1) - OffSet + 4, YPos + (i - 1) * RowHeight + 4), Format$(Val(Dt$(j, i)), Num$), 1, 1
Else '文字表示
Picture.Symbol(XPos(J - 1) - OffSet + 4, YPos+(I - 1) * RowHeight + 4), Left$(Dt$(j, i), Val(Item$(j, 1))), 1, 1
End If
Next j
Next i
End sub
'================================================================
'= スクロールバーでの移動
'================================================================
Declare Sub HScroll1_Change edecl ()
Sub HScroll1_Change()
Col = HScroll.GetScrollPos '位置取得
If PageFlg = 0 Then '★１面
If Col > ColMax1 Then '最大項目を超過
Edit.ShowWindow 0
PageFlg = 1
OffSet = ColOfst
Grid_Draw
Else If Col < 1 Then
Edit.ShowWindow 0
Col = ColMax
Row = Row - 1 : If Row < 1 Then Row = 1
PageFlg = 1
OffSet = ColOfst
Grid_Draw
End If
Else '★２面
If Col > ColMax Then
Edit.ShowWindow 0
Col = 1
Row = Row + 1 : If Row > RowMax Then Row = 1 '行制限
PageFlg = 0
OffSet = 0
Grid_Draw
Else If Col <= ColMax2 Then
Edit.ShowWindow 0
Row = Row - 1 : If Row < 1 Then Row = 1
PageFlg = 0
OffSet = 0
Grid_Draw
End If
End If
EditBox_Move
End sub
'================================================================
'= マウスによる行位置取得
'================================================================
Sub Picture1_Click()
Mx = Mouse(0)
My = Mouse(1)
If PageFlg = 0 Then ColMaxEnd = ColMax1 Else ColMaxEnd = ColMax
For i = 1 To ColMaxEnd
If Mx + OffSet > XPos(i - 1) And Mx + OffSet < XPos(i) Then
Col = i
Exit for
Else
Col = 0
End If
Next i
Select Case My
Case RowHeight To FrameBottom
Row = (My - FrameTop) \ RowHeight + 1
YPos = FrameTop + (Row - 1) * RowHeight
Case Else
Row = 0
End Select
EditBox_Move
End sub
'================================================================
'= EditBox移動
'================================================================
Sub EditBox_Move()
'面・カーソル位置確認
txt$ = AKCnv$(Trim$(Str$(PageFlg + 1))) & "面/Col=" & Format$(Col, "##")
txt$ = txt$ & "/Row=" & Format$(Row, "##") & "/Mx=" & Format$(Mx, "####") & "/My=" & Format$(My, "####")
MainForm.SetWindowText txt$
'マウスのセル範囲外クリック時
If Col = 0 Or Row = 0 Then
Edit.ShowWindow 0
Exit Sub
End If
YPos = FrameTop+RowHeight + (Row - 1) * RowHeight
Edit.SetImeMode Val(Item$(Col, 2)) 'IMEモード設定
Edit.SetWindowSize CellWidth(Col), RowHeight - 1 '-1：罫線消去防止
Edit.MoveWindow XPos(Col - 1) - OffSet + FrameLeft + 2, YPos + 2
Edit.ShowWindow -1
Edit.SetLimitText Val(Item$(Col, 1)) + 2 '+2：CrLf$(Enter移動方法による)
Edit.SetWindowText RTrim$(Left$(Dt$(Col, Row), Val(Item$(Col, 1))))
If Val(Item$(Col, 3)) = 1 Then '数値選択の場合
Edit.SetSelText 0, -1
Else '文字選択の場合
Edit.SetSelText Len(RTrim$(Dt$(Col, Row))), Len(RTrim$(Dt$(Col, Row)))
End If
HScroll.SetScrollPos Col
Edit.SetFontName FtName$
Edit.SetFontSize FontSize
Edit.SetFontBold 0
Edit.SETFOCUS
End sub
'================================================================
'= イベント
'================================================================
While 1
WaitEvent
Wend
'================================================================
'= 文字入力
'================================================================
Declare Sub Edit1_Change edecl ()
Sub Edit1_Change()
If PageFlg = 0 Then OffSet = 0 Else OffSet = ColOfst
OldDt$ = Dt$(Col, Row)
Dt$(Col, Row) = Edit.GetWindowText()
EPos = InStr(Dt$(Col, Row), CrLf$)
If EPos <> 0 Then
Dt$(Col, Row) = Mid$(Dt$(Col, Row), 1, EPos - 1) & Mid$(Dt$(Col, Row), EPos + 2)
Edit.SetWindowText Dt$(Col, Row)
If Dt$(Col, Row) = "" Then Dt$(Col, Row) = OldDt$
OldDt$ = Dt$(Col, Row)
Picture.Line(XPos(Col - 1) - OffSet + 2, YPos - FrameTop + 1) - (XPos(Col - 1) - OffSet + CellWidth(Col), YPos - FrameTop + RowHeight - 1), , 15, bf
If Val(Item$(Col,3)) = 1 Then '数値表示
Num$ = Right$("###,###,###,###", Val(Item$(Col, 1)))
If Left$(Num$, 1) = "," Then Num$ = " " + Right$(Num$, Len(Num$) - 1)
Picture.Symbol(XPos(Col - 1) - OffSet + 4, YPos - FrameTop + 4), Format$(Val(Dt$(Col, Row)), Num$), 1, 1
Else '文字表示
Picture.Symbol(XPos(Col - 1) - OffSet + 4, YPos - FrameTop + 4), Dt$(Col, Row), 1, 1
End If
'--------------------
Col = Col + 1 '次列
If PageFlg = 0 Then '★１面
If Col > ColMax1 Then
PageFlg = 1
OffSet = ColOfst
Edit.ShowWindow 0
Grid_Draw
End If
If Col > ColMax Then '最終列の場合
Row = Row + 1 '次行の
Col = 1 '最初の列
If Row > RowMax Then Row = RowMax '最終行の場合
End If
EditBox_Move 'EditBox移動
Else '★２面
If Col < ColMax1 Or Col > ColMax Then
PageFlg = 0
OffSet = 0
Edit.ShowWindow 0
Grid_Draw
End If
If Col > ColMax Then '最終列の場合
Col = 1 '最初の列
Row = Row+1 : If Row > RowMax Then Row = 1 '最終行の場合
End If
EditBox_Move 'EditBox移動
End If
End If
End sub
'================================================================
'= ＣＳＶデータ読込
'================================================================
Sub Data_Read()
On Error Goto *Er_Trap
FlNo = FreeFile
Open "TEST.CSV" For Input As #FlNo
i = 0
SetMousePointer 2
Do Until Eof(FlNo)
i = i + 1
Input #FlNo, Dt$(1, i)
Input #FlNo, Dt$(2, i)
Input #FlNo, Dt$(3, i)
Input #FlNo, Dt$(4, i)
Input #FlNo, Dt$(5, i)
Input #FlNo, Dt$(6, i)
Input #FlNo, Dt$(7, i)
Input #FlNo, Dt$(8, i)
Input #FlNo, Dt$(9, i)
Input #FlNo, Dt$(10, i)
Input #FlNo, Dt$(11, i)
Input #FlNo, Dt$(12, i)
Input #FlNo, Dt$(13, i)
Input #FlNo, Dt$(14, i)
Input #FlNo, Dt$(15, i)
Input #FlNo, Dt$(16, i)
Input #FlNo, Dt$(17, i)
Input #FlNo, Dt$(18, i)
Input #FlNo, Dt$(19, i)
Input #FlNo, Dt$(20, i)
Loop
Close #FlNo
DataMax = i
SetMousePointer 0
Exit Sub
*Er_Trap
SetMousePointer 0
Close #FlNo
A% = MessageBox(GetWindowText, "読込に失敗しました！『TEST.CSV』が用意されていないか、データ形式が違います！(i=" & Trim$(Str$(i)) & ")", 0, 0)
Resume *Er_Return
*Er_Return
On Error Goto 0
End sub
'================================================================
'= ＣＳＶデータ保存(DataMax固定)
'================================================================
Declare Sub Button1_ON edecl ()
Sub Button1_ON()
FlNo = freefile
On Error Goto *Er_Trap
If DataMax = 0 Then A% = MessageBox(GetWindowText, "保存するデータがありません！", 0, 2) : Exit Sub
Open "TEST.CSV" For Create As #FlNo
SetMousePointer 2
For i = 1 To DataMax
ZD$ = ""
ZD$ = ZD$ & RTrim$(Dt$(1, i)) & ","
ZD$ = ZD$ & RTrim$(Dt$(2, i)) & ","
ZD$ = ZD$ & RTrim$(Dt$(3, i)) & ","
ZD$ = ZD$ & RTrim$(Dt$(4, i)) & ","
ZD$ = ZD$ & RTrim$(Dt$(5, i)) & ","
ZD$ = ZD$ & RTrim$(Dt$(6, i)) & ","
ZD$ = ZD$ & RTrim$(Dt$(7, i)) & ","
ZD$ = ZD$ & RTrim$(Dt$(8, i)) & ","
ZD$ = ZD$ & RTrim$(Dt$(9, i)) & ","
ZD$ = ZD$ & RTrim$(Dt$(10, i)) & ","
ZD$ = ZD$ & RTrim$(Dt$(11, i)) & ","
ZD$ = ZD$ & RTrim$(Dt$(12, i)) & ","
ZD$ = ZD$ & RTrim$(Dt$(13, i)) & ","
ZD$ = ZD$ & RTrim$(Dt$(14, i)) & ","
ZD$ = ZD$ & RTrim$(Dt$(15, i)) & ","
ZD$ = ZD$ & RTrim$(Dt$(16, i)) & ","
ZD$ = ZD$ & RTrim$(Dt$(17, i)) & ","
ZD$ = ZD$ & RTrim$(Dt$(18, i)) & ","
ZD$ = ZD$ & RTrim$(Dt$(19, i)) & ","
ZD$ = ZD$ & RTrim$(Dt$(20, i))
Print #FlNo,ZD$
Next
Close #FlNo
SetMousePointer 0
A% = MessageBox(GetWindowText, "ＣＳＶ型式で保存しました！", 0, 2)
Exit Sub
*Er_Trap
SetMousePointer 0
Close #FlNo
A% = MessageBox(GetWindowText, "保存に失敗しました！(Erl=" & Str$(Erl) & "/Err=" & Str$(Err) & "/i=" & Trim$(Str$(i)) & ")", 0, 2)
Resume *Er_Return
*Er_Return
On Error Goto 0
End sub