Attribute VB_Name = "Module1" '============================================================================= ' 「iii/Win」 VisualBasic用サンプルプログラム '============================================================================= Type ItemRec ' 明細部データ SCode As String * 5 SName As String * 20 Qty As Double UTanka As Double STanka As Double Ukingaku As Double Skingaku As Double End Type Dim DenNo As Integer ' 伝票番号 '----------------------------------------------------------------------------- ' 業務メニューの選択： この例では6番(項目C)のみ有効 '----------------------------------------------------------------------------- Sub Main() Dim SelNo As Integer ' 選択項目の番号 Dim Btn As String ' PsMsgBox()の終了コード ChDrive App.Path ' カレントドライブの設定 ChDir App.Path ' カレントディレクトリの設定 DenNo = 10001 ' 伝票番号の初期値 PsInit ' 画面プロセッサを初期化 PsScrn "URIMNU.SCR" ' 業務メニュー画面を表示 SelNo = 1 Do SelNo = PsSlct(SelNo) ' 業務メニューの選択 Select Case SelNo Case 6 ' 項目No6 : 伝票入力処理へ PsScrn "URI122.SCR" ' 伝票入力画面の表示 DenpyoInput ' 伝票入力処理 PsScrn "URIMNU.SCR" ' 戻った後、メニュー画面を再表示 Case 132 ' メニュー項目[F2=終了] : 終了処理へ Btn = PsMsgBox(" 販売管理システム", _ "処理をすべて終了します。%10よろしいですか？ (Y,N)" _ , "*Y=[終了する(~Y)]/N=[処理を続行する(~N)]", "QS") If Btn = "Y" Then Exit Do Else SelNo = 1 Case Else ' 無効な選択 PsAlarm "", "項目Ｃ以外は選択できません。" End Select Loop ' 終了処理 PsQuit End Sub '----------------------------------------------------------------------------- ' 伝票入力処理： メニュー項目[F2=終了]が選ばれるまで行う '----------------------------------------------------------------------------- Sub DenpyoInput() Dim ItemID As Integer ' メニューバーのメニュー項目のID Dim EventNo As Integer ' イベント番号 PsIPut "DVCODE", DenNo ' 伝票番号を表示 PsDSet "DATE" ' 本日の日付をセット Do ' フルスクリーン入力 EventNo = PsInpt("/nextv") If EventNo = 133 Then Exit Do ' メニュー項目[F2=終了] ' 入力の結果フィールド値が変化していれば必要な後処理を行う If PsChnd() = 1 Then ' 内容が変わったか? ' 今、入力を終えたフィールド(/CUR)の処理コードに応じて金額欄の表示を更新 Select Case (PsCode("/CUR")) ' 注："/*FieldName"は/CURと同行の配列フィールドを意味する ' 数量欄 Case "Q": KingakuPut "/*UTANKA", "/*UKIN" KingakuPut "/*STANKA", "/*SKIN" ' 販売単価欄 Case "U": KingakuPut "/*UTANKA", "/*UKIN" ' 仕入単価欄 Case "I": KingakuPut "/*STANKA", "/*SKIN" End Select End If ' メニューバー項目の選択に対応する処理に分岐 If EventNo = 132 Then ' メニューバーのイベント ItemID = PsIQuery("MN_SELECTNO", "", "") ' 選択されたメニュー項目のID Select Case ItemID Case 2 ' メニュー項目[F4=行削除] : 一行削除処理へ LineShift "U" Case 3 ' メニュー項目[F5=行挿入] : 一行挿入処理へ LineShift "D" Case 401 ' サブメニュー項目[営業１課] : 得意先の選択処理へ TokuiWindow Case 501 ' サブメニュー項目[文具メーカーＡ] : 商品の選択処理へ SyouhinWindow Case 6 ' メニュー項目[F6=印刷] : 印刷指定処理へ PrintSyori Case 7 ' メニュー項目[F9=書込み] : ファイル出力処理へ FileWrite Case 8 ' メニュー項目[F1=ヘルプ] : ヘルプ画面表示を行う PsWndw "URIHLP.SCR" ' 内容はファイルから自動ロード PsInpt ("/EVENT") ' イベント待ち PsRstr ' ヘルプ画面を閉じる Case Else ' 無効な選択 PsAlarm "", "該当のデータは登録されていません。" End Select End If Loop End Sub '----------------------------------------------------------------------------- ' 販売金額を算出して表示する ' 引数：単価欄のフィールド名と（販売用または仕入れ用の）金額欄のフィールド名 '----------------------------------------------------------------------------- Sub KingakuPut(TankaFName As String, KingakuFName As String) Dim TFLen As Integer ' フィールド内の文字数 Dim QFLen As Integer ' フィールド内の文字数 Dim Qty As Double ' 数量 Dim Tanka As Double ' 単価 Dim Kingaku As Double ' 金額 QFLen = PsFLen("/*QTY") ' 数量フィールドの文字数 TFLen = PsFLen(TankaFName) ' 単価フィールドの文字数 ' 単価と数量が共に空白でなければ金額表示 If TFLen <> 0 And QFLen <> 0 Then Qty = PsRGet("/*QTY") ' 数量の取り込み Tanka = PsRGet(TankaFName) ' 単価の取り込み Kingaku = Qty * Tanka If Kingaku > 9999999# Then PsAlarm "", "数量が大きすぎます。" PsFClr KingakuFName PsPosn "/*QTY" Else PsRPut KingakuFName, Kingaku ' 金額の表示 End If ' 単価または数量のいずれかが空白だと金額をクリア Else PsFClr KingakuFName End If End Sub '----------------------------------------------------------------------------- ' 伝票の内容をファイルに出力する '----------------------------------------------------------------------------- Sub FileWrite() Dim Idx As Integer Dim Item(1 To 5) As ItemRec If PsIChk() = 0 Then ' 画面上の必要な入力が完了していれば書き込みへ ' 明細部のフィールドのデータの取得 ' 配列フィールドをループ処理で順次アクセスする例 For Idx = 1 To 5 Call PsSGetN("SVCODE", Idx, Item(Idx).SCode) Call PsSGetN("SVNAME", Idx, Item(Idx).SName) Item(Idx).Qty = PsRGetN("QTY", Idx) Item(Idx).UTanka = PsRGetN("UTANKA", Idx) Item(Idx).STanka = PsRGetN("STANKA", Idx) Item(Idx).Ukingaku = PsRGetN("UKIN", Idx) Item(Idx).Skingaku = PsRGetN("SKIN", Idx) Next Idx '------------------------------- ' ファイル出力処理(省略) '------------------------------- PsAlarm "", "ファイルに書き込みました。" ' 次の入力の準備 PsPosn "/home" PsFClr "/all" DenNo = DenNo + 1 PsIPut "DVCODE", DenNo PsDSet "DATE" End If End Sub '----------------------------------------------------------------------------- ' 得意先ウィンドウを表示して得意先名を選択する ' TVLB.SCRのリストボックスにはデータファイル名が定義されているため、 ' 画面表示を指示するだけでそのデータが自動的にロードされる。 ' また、リストボックスとのデータの授受は、行単位ではなくフィールド単位で行な ' えるので非常に取り扱いが便利です。 ' ' 放棄終了 : イベント111 = [ESC]キー、取り消しボタン ' 選択決定 : イベント210 = リストボックス上の行の選択 ' 190 = 確定ボタン '----------------------------------------------------------------------------- Sub TokuiWindow() Dim TCode As String ' 得意先コード Dim TName As String ' 得意先名 Dim EventNo As Integer ' イベント番号 Dim LbSelNo As Integer ' リストボックス上での選択行番号 PsWndw "TVLB.SCR" PsSet "LB_SELECTNO", "LB1", "1" ' 先頭の行に選択バーをセット EventNo = PsInpt("/EVENT") ' イベント待ち If EventNo = 111 Then ' 取り消しの場合 PsRstr ' 親画面に戻る Else ' 有効な選択の場合 ' 選択されたリストボックスの行のデータ取得 LbSelNo = PsIQuery("LB_SELECTNO", "LB1", "") Call PsSGetN("TVCODE", LbSelNo, TCode) Call PsSGetN("TVNAME", LbSelNo, TName) ' 親画面に戻り、選択された得意先を表示 PsRstr PsFClr "TVADR" PsSPut "TVCODE", TCode PsSPut "TVNAME", TName End If End Sub '----------------------------------------------------------------------------- ' 商品ウィンドウを表示して商品名を選択する ' SVLB.SCRのリストボックスにはデータファイル名が定義されているため、 ' 画面表示を指示するだけでそのデータが自動的にロードされる。 ' また、リストボックスとのデータの授受は、行単位ではなくフィールド単位で行な ' えるので非常に取り扱いが便利です。 ' ' 放棄終了 : イベント111 = [ESC]キー、取り消しボタン ' 選択決定 : イベント210 = リストボックス上の行の選択 ' 190 = 確定ボタン '----------------------------------------------------------------------------- Sub SyouhinWindow() Dim LbSelNo As Integer ' リストボックス上での選択行番号 Dim EventNo As Integer ' イベント番号 Dim FCode As String ' フィールドコード Dim SCode As String ' 商品コード Dim SName As String ' 商品名 Dim UTanka As String ' 販売単価 Dim STanka As String ' 仕入単価 FCode = PsCode("/CUR") If InStr("SQIUN", FCode) = 0 Then PsAlarm "", "商品の選択は明細行の入力時に行なって下さい。" Exit Sub End If PsWndw "SVLB.SCR" PsSet "LB_SELECTNO", "LB1", "1" EventNo = PsInpt("/EVENT") If EventNo = 111 Then ' 取り消しの場合 PsRstr ' 親画面に戻る Else ' 有効な選択の場合 ' 選択されたリストボックスの行のデータ取得 LbSelNo = PsIQuery("LB_SELECTNO", "LB1", "") Call PsSGetN("SVCODE", LbSelNo, SCode) Call PsSGetN("SVNAME", LbSelNo, SName) Call PsSGetN("UTANKA", LbSelNo, UTanka) Call PsSGetN("STANKA", LbSelNo, STanka) ' 親画面に戻り、選択された得意先を表示 PsRstr PsSPut "/*SVCODE", SCode PsSPut "/*SVNAME", SName PsSPut "/*UTANKA", UTanka PsSPut "/*STANKA", STanka PsFClr "/*UKIN" PsFClr "/*SKIN" PsFClr "/*QTY" PsPosn "/*QTY" End If End Sub '----------------------------------------------------------------------------- ' 一行の挿入または削除の処理 ' カレントフィールドの処理コードによって、現在、明細部に入力している事を確認し、 ' 各フィールドのプッシュまたはポップを行う ' 注："/E"は最終番号の配列フィールドを意味する '----------------------------------------------------------------------------- Sub LineShift(Mode As String) Dim FCode As String ' フィールドコード FCode = PsCode("/CUR") If InStr("SQIUN", FCode) = 0 Then Exit Sub If Mode = "D" Then ' 一行挿入（繰り下げ） PsPush "/*SVCODE", "/E" PsPush "/*SVNAME", "/E" PsPush "/*QTY", "/E" PsPush "/*UTANKA", "/E" PsPush "/*UKIN", "/E" PsPush "/*STANKA", "/E" PsPush "/*SKIN", "/E" Else ' 一行削除（繰り上げ） PsPop "/*SVCODE", "/E" PsPop "/*SVNAME", "/E" PsPop "/*QTY", "/E" PsPop "/*UTANKA", "/E" PsPop "/*UKIN", "/E" PsPop "/*STANKA", "/E" PsPop "/*SKIN", "/E" End If End Sub '----------------------------------------------------------------------------- ' 印刷処理 ' イベント 111 = [取消]ボタンと [ESC]キー ' イベント 101 = [印刷実行]ボタン '----------------------------------------------------------------------------- Sub PrintSyori() Dim EventNo As Integer ' イベント番号 ' ウィンドウ表示と各ボタンの初期状態設定 PsWndw "URIPRN.SCR" PsIPut "C01", 1 PsIPut "R02", 1 PsIPut "R03", 1 Do EventNo = PsInpt("/NEXT") If EventNo = 111 Then Exit Do If EventNo = 101 Then If PsFLen("F01") = 0 Or PsFLen("F02") = 0 Then PsAlarm "", "開始番号と終了番号を入力して下さい。" Else PsAlarm "", "サンプルですので実際の印刷はできません。" Exit Do End If End If Loop PsRstr End Sub