ちょっと考えてます

　　ちょっと考えてます H,O 2004/09/03 20:05:09 
　　├FILEGETNAMEs$,"bas" 青木太一 2004/09/04 05:12:59 
　　└このプログラムは shino 2004/09/04 18:25:22 
　　　└!初期化 shino 2004/09/04 18:27:09 
　　　　└まだ続きます。 shino 2004/09/04 18:29:05 
　　　　　└半分くらいです。 shino 2004/09/04 18:30:24 
　　　　　　└続き shino 2004/09/04 18:32:06 
　　　　　　　└あと３分の１くらいです。 shino 2004/09/04 18:33:18 
　　　　　　　　└あと少しですかね。 shino 2004/09/04 18:35:51 
　　　　　　　　　└あと残りわずかです。 shino 2004/09/04 18:37:25 
　　　　　　　　　　└これで終わりです。 shino 2004/09/04 18:42:07 
　　　　　　　　　　　└ありがとうございました。とても参考になり... H,O 2004/09/04 18:49:19

　　ちょっと考えてます H,O 2004/09/03 20:05:09  ツリーへ

ちょっと考えてます 返事を書く

H,O 2004/09/03 20:05:09

BASICでメニューっていうものはつくれますか？
メニューでは、いくつかのBASファイルの名前をだして、そこをクリックしたらそのファイルが開くっていうものです。できなければ、他の方法で考えてみます。どうかよろしくお願いします。

　　├FILEGETNAMEs$,"bas" 青木太一 2004/09/04 05:12:59  ツリーへ

Re: ちょっと考えてます 返事を書く

青木太一 2004/09/04 05:12:59

FILE GETNAME s$,"bas"
print s$
end

メニューは作れないけど、やりたいことは上のサンプルコードでできると思います。
とりあえず上のサンプルコードはファイル選択ダイアログが出現して、選択したファイル名を2行目で表示するだけです。
そのファイルを開いて何らかの処理をしたい場合はopen文などをご利用下さい。
file getnameについては
ヘルプ-目次-ファイル-独自の拡張
をご覧下さい。

なお、「メニューが作れない」というのは若干不正確で、
file list文やグラフィックスを駆使すれば作れないことはないでしょうが、大変な回り道になると思います。
またWindowsAPIを使う方法もあるのかもしれませんが、これも大変だと思います。

これを知った上での質問でしたら失礼

　　└このプログラムは shino 2004/09/04 18:25:22  ツリーへ

Re: ちょっと考えてます 返事を書く

shino 2004/09/04 18:25:22

このプログラムは
私も考えたことがあるのですが、
あまり使えたものではないと思います。
肝心の編集をすることができませんから。
とりあえず、メニューだけ作ってみましたので
参考にどうぞ。

プログラムは右クリックで終了です。

REM 簡易ファイルメニュー

! ==== SUB ====
DECLARE EXTERNAL SUB Menu.FileMenu

! ==== 関数 ====
DECLARE EXTERNAL FUNCTION GetForegroundWindow ! 最前ウインドウのハンドルを得る
DECLARE EXTERNAL FUNCTION ShowWnd ! ウインドウ命令
DECLARE EXTERNAL FUNCTION MesBox ! メッセージボックス

! ==== 絵 ====
DECLARE EXTERNAL PICTURE Rectangle ! 矩形

DECLARE NUMERIC n,hwnd
SET bitmap SIZE 1024,692
SET WINDOW -345,678,-345,346
LET hwnd=GetForeGroundWindow ! 最前ウインドウのハンドルを得る
LET n=ShowWnd(hwnd,3) ! ウインドウをできるだけ最大化

SET ECHO "off" ! 文字入力時反復なし

CALL FileMenu

END

! XXX メニューモジュール XXX
MODULE Menu

! ==== 副プログラム ====
PUBLIC SUB FileMenu ! メインプログラム
SHARE SUB SetOption ! オプション(とりあえず終了オプションのみ)
SHARE SUB SaveFileList ! ファイルリストのセーブ
SHARE SUB Event ! イベントコール
SHARE SUB SelectFile ! ファイル選択
SHARE SUB ScrollList1 ! 直接スクロール
SHARE SUB ScrollList2 ! 間接スクロール
SHARE SUB GetNewFile ! 新規ファイルの登録
SHARE SUB DeleteFile ! ファイルの削除
SHARE SUB Waiter ! 待ち役

! ==== 関数 ====
SHARE FUNCTION GetList ! ファイルリストの獲得
SHARE FUNCTION ExtractString$ ! 文字列の抽出
SHARE FUNCTION MakeDateString$ ! 日時を表す文字列

! ==== 絵 ====
SHARE PICTURE ListBox ! ファイルリスト
SHARE PICTURE button ! ボタン類
SHARE PICTURE PictureA ! 動作確認用

! ==== 共用変数 ====
SHARE NUMERIC FileNumber ! ファイルの数
SHARE NUMERIC SelectionNumber ! 選択中のファイル番号
SHARE NUMERIC Lower,Higher ! 表示ファイル下限上限
SHARE NUMERIC lb_box_color ! リストボックス上部箱の色
SHARE NUMERIC lb_bar_color ! リストボックス選択線の色
SHARE NUMERIC sb_bar_color ! スクロールバーの色
SHARE NUMERIC sb_bg_color ! スクロールバー背景色
SHARE NUMERIC bt_color1(2) ! ボタンの色
SHARE STRING ListName$ ! ファイルリスト名
! ファイル名、登録日時、最終利用日、種類、コメント
SHARE STRING FileName$(100),EntryDate$(100),LastDate$(100),Sort$(100),Comment$(100)
! ボタン情報ボタンの種類、中央位置、縦横幅、フォントサイズ、付加文字列
SHARE NUMERIC b_type(10),b_ox(10),b_oy(10),b_dx(10),b_dy(10),b_fs(10)
SHARE STRING b_bh$(10)

DECLARE NUMERIC i

　　　└!初期化 shino 2004/09/04 18:27:09  ツリーへ

Re: このプログラムは 返事を書く

shino 2004/09/04 18:27:09

! 初期化
LET SelectionNumber = 1
LET Lower=1
LET lb_box_color=73
LET lb_bar_color=230
LET bt_color1(1)=73
LET bt_color1(2)=15
LET sb_bar_color=73
LET sb_bg_color=15

DATA 4,155,80,448,199,10,""
DATA 2,621,80,14,177,10,""
DATA 1,621,270,14,11,10,"上"
DATA 1,621,-110,14,11,10,"下"
DATA 1,-185,-300,100,14,10,"ファイルリストを開く"
DATA 1, 30,-300,100,14,10,"新規ファイルの追加"
DATA 1,245,-300,100,14,10,"ファイルリストから削除"
DATA 1,400,-300,40,14,10,"開く"
DATA 1,495,-300,40,14,10,"実行"
DATA 1,590,-300,40,14,10,"修正"
FOR i=1 TO 10
READ b_type(i),b_ox(i),b_oy(i),b_dx(i),b_dy(i),b_fs(i),b_bh$(i)
NEXT i

! ==== 定義部 ====

! ### ファイルメニュー ###
EXTERNAL SUB FileMenu
DECLARE NUMERIC x,y,left,right
DECLARE NUMERIC i
SET TEXT font "ＭＳゴシック",10
DRAW ListBox(0)
FOR i=1 TO 10
DRAW button(i,0)
NEXT i
DO
SET DRAW mode hidden
mouse poll x,y,left,right
IF right = 1 THEN CALL SetOption(x,y) ! オプション呼び出し
DRAW PictureA ! 実行中を示す絵
FOR i=1 TO 10 ! ボタン領域内にある場合イベント呼び出し
IF ABS(x-b_ox(i))<=b_dx(i) AND ABS(y-b_oy(i))<=b_dy(i) THEN
CALL Event(i,left)
END IF
NEXT i
SET DRAW mode explicit
WAIT DELAY 0.01
LOOP
END SUB
! ###

! ### オプション ###
EXTERNAL SUB SetOption(x_ini,y_ini)
DECLARE NUMERIC x,y,left,right
DECLARE NUMERIC n
CALL waiter(x,y,left,right)
! 終了オプション
IF MesBox(0,"終了しますか？"," BASIC",4)=6 THEN
SET DRAW mode explicit
STOP
END IF
END SUB
! ###

! ### イベント ###
EXTERNAL SUB Event(i,left)
DECLARE NUMERIC x,y,l,r
DECLARE NUMERIC n
DECLARE STRING path$,name$,ext$
SELECT CASE i
CASE 1 ! ファイル選択
IF left=1 THEN CALL SelectFile(i)
CASE 2 ! 直接スクロール
IF left=1 THEN CALL ScrollList1(i)
CASE 3,4 ! スクロールボタン上下
IF left=1 THEN CALL ScrollList2(i)
CASE 5 ! ファイルリストを開く
IF left=1 THEN
DRAW button(i,1)
SET DRAW mode explicit
SET DRAW mode hidden
CALL Waiter(x,y,l,r)
LET n=GetList(0)
IF n>0 THEN ! ファイルオープン成功ならば
! 初期化
LET FileNumber = n
LET Lower = 1
LET SelectionNumber = 1
DRAW ListBox(0)
DRAW button(2,0)
END IF
DRAW button(i,0)
END IF

　　　　└まだ続きます。 shino 2004/09/04 18:29:05  ツリーへ

Re: !初期化 返事を書く

shino 2004/09/04 18:29:05

まだ続きます。

CASE 6 ! 新規ファイル追加
IF left=1 THEN CALL GetNewFile(i)
CASE 7 ! ファイル削除
IF left=1 THEN CALL DeleteFile(i)
CASE 8,9,10 ! ファイルを開く(ノートパッド)、実行、情報修正
IF left=1 THEN
DRAW button(i,1)
SET DRAW mode explicit
SET DRAW mode hidden
CALL Waiter(x,y,l,r)
DRAW button(i,0)
! 選択しているファイルが可視のファイルリスト中にある場合
IF SelectionNumber>=Lower AND SelectionNumber<=Higher THEN
IF i<10 THEN ! 開く、実行は先に保存しておく
LET LastDate$(SelectionNumber)=MakeDateString$
CALL SaveFileList(-1)
END IF
IF i=8 THEN ! ノートパッドで開く
WHEN EXCEPTION IN
execute "c:\windows\notepad.exe" WITH (FileName$(SelectionNumber))
USE
LET n=MesBox(0,"ファイルが存在しません"," BASIC",1)
END WHEN
ELSEIF i=9 THEN ! 実行
file splitname (FileName$(SelectionNumber)) path$,name$,ext$
WHEN EXCEPTION IN
SET directory path$
execute name$
USE
LET n=MesBox(0,"ファイルを実行できません"," BASIC",1)
END WHEN
ELSEIF i=10 THEN ! 情報修正
INPUT PROMPT " ファイルの種類を入力してください" : Sort$(SelectionNumber)
INPUT PROMPT " コメントを入力してください" : Comment$(SelectionNumber)
CALL SaveFileList(-1)
END IF
DRAW ListBox(0)
END IF
END IF
CASE ELSE
END SELECT
END SUB
! ###

! ### ファイルセレクト ###
EXTERNAL SUB SelectFile(i)
DECLARE NUMERIC x,y,l,r
DRAW button(i,1)
CALL Waiter(x,y,l,r)
IF ABS(x-b_ox(i))<=b_dx(i) AND ABS(y-b_oy(i))<=b_dy(i) THEN
LET SelectionNumber = Lower - INT((y-260)/20)
END IF
DRAW ListBox(0)
END SUB
! ###

　　　　　└半分くらいです。 shino 2004/09/04 18:30:24  ツリーへ

Re: まだ続きます。 返事を書く

shino 2004/09/04 18:30:24

半分くらいです。

! ### 直接スクロール ###
EXTERNAL SUB ScrollList1(i)
DECLARE NUMERIC x,y,l,r
DECLARE NUMERIC upper,HitArea,bar_length,d
IF FileNumber<=20 THEN ! スクロール不可ならば終了
CALL Waiter(x,y,l,r)
EXIT SUB
END IF
LET bar_length = b_dy(i)*20/FileNumber ! スクロールバー長
LET HitArea = b_dy(i)*(1-20/FileNumber) ! 可動域
LET upper = b_oy(i)+HitArea ! 可動上限
DO
mouse poll x,y,l,r
! yの領域でスクロール位置を判断
IF ABS(y-b_oy(i))<=HitArea THEN
LET Lower = 1 + (upper-y)/(bar_length/10)
LET d = 20*FP(Lower)
LET Lower = INT(Lower)
ELSEIF y>b_oy(i) THEN ! 上方向にはみ出し
LET Lower = 1
LET d=0
ELSE ! 下方向にはみ出し
LET Lower = FileNumber-19
LET d=0
END IF
DRAW ListBox(d)
DRAW button(i,0)
SET DRAW mode explicit
WAIT DELAY 0.01
SET DRAW mode hidden
LOOP WHILE l=1
LET Lower = INT(Lower+d/20+0.5)
DRAW ListBox(0)
DRAW button(i,0)
END SUB
! ###

! ### 間接スクロール ###
EXTERNAL SUB ScrollList2(i)
DECLARE NUMERIC x,y,l,r
DECLARE NUMERIC l_drag,d
DRAW button(i,1)
LET l_drag=1 ! マウスドラッグオン
DO
! それ以上スクロールできなければ終了
IF Lower=1 AND i=3 OR Lower=FileNumber-19 AND i=4 THEN
SET DRAW mode explicit
DRAW button(2,0)
SET DRAW mode hidden
CALL Waiter(x,y,l,r)
IF i=3 THEN LET Lower=1
IF i=4 THEN LET Lower=FileNumber-19
EXIT DO
END IF
DO ! 2週目以降は一度ずつしか通らない
mouse poll x,y,l,r
IF l=0 THEN LET l_drag=0
DRAW ListBox(d)
DRAW button(2,0)
LET d = d + 2*SGN(i-3.5)
SET DRAW mode explicit
WAIT DELAY 0.01
SET DRAW mode hidden
LOOP WHILE ABS(d)<20
LET d=SGN(i-3.5)*20
LET Lower = Lower + SGN(i-3.5)
LOOP WHILE l_drag=1 ! マウスドラッグ中は続ける
DRAW ListBox(0)
DRAW button(2,0)
DRAW button(i,0)
END SUB
! ###

　　　　　　└続き shino 2004/09/04 18:32:06  ツリーへ

Re: 半分くらいです。 返事を書く

shino 2004/09/04 18:32:06

続き

! ### 新規ファイルの追加 ###
EXTERNAL SUB GetNewFile(i)
DECLARE NUMERIC x,y,l,r
DECLARE NUMERIC n
DECLARE STRING f_name$
DRAW button(i,1)
SET DRAW mode explicit
SET DRAW mode hidden
CALL Waiter(x,y,l,r)
IF FileNumber=100 THEN
LET n=MesBox(0,"これ以上追加できません。"," BASIC",1)
DRAW button(i,0)
EXIT SUB
END IF
file getname f_name$,"bas"
IF f_name$ = "" THEN ! キャンセル
ELSE
LET FileNumber=FileNumber+1
IF FileNumber>20 THEN ! ファイル数によって表示下限を決定
LET Lower = FileNumber-19
ELSE
LET Lower = 1
END IF
LET SelectionNumber = FileNumber ! 選択位置は今選択したものに合わせる
LET FileName$(SelectionNumber) = f_name$
LET EntryDate$(SelectionNumber)=MakeDateString$
INPUT PROMPT " ファイルの種類を入力してください" : Sort$(SelectionNumber)
INPUT PROMPT " コメントを入力してください" : Comment$(SelectionNumber)
CALL SaveFileList(-1)
END IF
DRAW button(i,0)
DRAW ListBox(0)
DRAW button(2,0)
END SUB
! ###

! ### ファイルの削除 ###
EXTERNAL SUB DeleteFile(i)
DECLARE NUMERIC x,y,l,r
DECLARE NUMERIC n
DECLARE STRING path$,name$,ext$
DRAW button(i,1)
SET DRAW mode explicit
SET DRAW mode hidden
CALL Waiter(x,y,l,r)
IF FileNumber=0 THEN
LET n=MesBox(0,"削除できません。"," BASIC",1)
DRAW button(i,0)
EXIT SUB
END IF
file splitname (FileName$(SelectionNumber)) path$,name$,ext$
IF MesBox(0,ExtractString$(name$,20) & "を削除します。よろしいですか？"," BASIC",1)=1 THEN
CALL SaveFileList(SelectionNumber) ! 消したいファイルを飛ばして記録
LET FileNumber = GetList(1) ! 再度読み込み
END IF
DRAW button(i,0)
DRAW ListBox(0)
DRAW button(2,0)
END SUB
! ###

　　　　　　　└あと３分の１くらいです。 shino 2004/09/04 18:33:18  ツリーへ

Re: 続き 返事を書く

shino 2004/09/04 18:33:18

あと３分の１くらいです。

! ### ファイルリストの記録 ###
EXTERNAL SUB SaveFileList(DeleteNumber)
DECLARE NUMERIC i,n
DECLARE STRING l_name$
IF ListName$="" THEN
LET n=MesBox(0,"ファイルが開かれていません。新しいファイルを開きますか?"," BASIC",4)
IF n<>6 THEN EXIT SUB ! キャンセル
file getname l_name$,"dat"
IF l_name$="" THEN EXIT SUB ! キャンセル
LET ListName$=l_name$
END IF
OPEN #1:NAME ListName$ , ACCESS OUTIN , RECTYPE INTERNAL
ERASE #1
WRITE #1 : "このファイルは FileMenu.bas のデータファイルです。"
FOR i=1 TO FileNumber ! 消去したいデータを飛ばして記録
IF i<>DeleteNumber THEN WRITE #1 : FileName$(i),EntryDate$(i),LastDate$(i),Sort$(i),Comment$(i)
NEXT i
CLOSE #1
END SUB
! ###

! ### 待ち ###
EXTERNAL SUB Waiter(x,y,left,right)
DO
mouse poll x,y,left,right
WAIT DELAY 0.01
LOOP WHILE left=1 OR right=1
END SUB
! ###

! +++ リストの獲得 +++
EXTERNAL FUNCTION GetList(j)
DECLARE NUMERIC i,n
DECLARE STRING def$ ! ファイル先頭文字列
LET GetList = -1
IF j=0 THEN file getname ListName$,"dat"
IF ListName$="" THEN EXIT FUNCTION ! キャンセル
WHEN EXCEPTION IN
OPEN #1:NAME ListName$ , ACCESS OUTIN , RECTYPE INTERNAL
USE
LET n=MesBox(0,"ファイルを開けません"," BASIC ",1)
END WHEN
WHEN EXCEPTION IN
READ #1: def$
USE
CLOSE #1
LET n=MesBox(0,"ファイルの形式が違います"," BASIC ",1)
EXIT FUNCTION
END WHEN
! ファイル先頭で判断
IF def$="このファイルは FileMenu.bas のデータファイルです。" THEN
! 初期化
MAT FileName$ = NUL$
MAT EntryDate$ = NUL$
MAT LastDate$ = NUL$
MAT Sort$ = NUL$
MAT Comment$ = NUL$
! 読み込み
FOR i=1 TO 100
READ #1,IF MISSING THEN EXIT FOR:FileName$(i),EntryDate$(i),LastDate$(i),Sort$(i),Comment$(i)
NEXT i
LET GetList=i-1
ELSE
LET n=MesBox(0,"ファイルの形式が違います"," BASIC ",1)
END IF
CLOSE #1
END FUNCTION
! +++

　　　　　　　　└あと少しですかね。 shino 2004/09/04 18:35:51  ツリーへ

Re: あと３分の１くらいです。 返事を書く

shino 2004/09/04 18:35:51

あと少しですかね。

! +++ 文字列の抽出 +++
EXTERNAL FUNCTION ExtractString$(Base$,StrLength)
DECLARE NUMERIC i
DECLARE STRING ExtStr$
! 前から順にバイト単位で取り出す
IF BLEN(base$)>StrLength THEN
LET i=LEN(Base$)
DO
LET i=i-1
LET ExtStr$=Base$(1:i)
LOOP WHILE BLEN(ExtStr$)>StrLength-2
LET ExtractString$ = ExtStr$ & "…"
ELSE
LET ExtractString$ = base$
END IF
END FUNCTION
! +++

! +++ 時刻文字列の作成 +++
EXTERNAL FUNCTION MakeDateString$
LET MakeDateString$ = MID$(DATE$,1,4) & "/" & MID$(DATE$,5,2) & "/" & MID$(DATE$,7,2) & " " & TIME$
END FUNCTION
! +++

! *** リストボックス ***
EXTERNAL PICTURE ListBox(d)
DECLARE NUMERIC i,j
DECLARE NUMERIC StartNumber,EndNumber ! 表示開始、終了番号
DECLARE NUMERIC bar_post ! 選択バーの位置
DECLARE STRING path$,name$,ext$
SET TEXT JUSTIFY "left","half"
! まず真っ白にして下準備
DRAW Rectangle(5,391,895,11,0,2) WITH SHIFT(-290,270)
! 表示範囲の決定
IF FileNumber>20 THEN
LET Higher=19+Lower
ELSE
LET Higher=FileNumber
END IF
LET StartNumber = 0
LET EndNumber = Higher-Lower
! スクロール方向により表示ファイル追加
IF d>0 THEN LET EndNumber=EndNumber+1
IF d<0 THEN LET StartNumber=-1
! 選択バー
IF SelectionNumber>0 THEN
LET bar_post=270-20*(SelectionNumber-Lower)+d
IF ABS(bar_post-80)>=190 THEN LET bar_post=SGN(bar_post-80)*190+80
DRAW Rectangle(3,9,893,9,lb_bar_color,2) WITH SHIFT(-290,bar_post)
END IF

　　　　　　　　　└あと残りわずかです。 shino 2004/09/04 18:37:25  ツリーへ

Re: あと少しですかね。 返事を書く

shino 2004/09/04 18:37:25

あと残りわずかです。

! ファイルリスト
SET TEXT COLOR 1
FOR i=StartNumber TO EndNumber
! 長い文字列は省略して表示する
FILE SPLITNAME (FileName$(Lower+i)) path$, name$, ext$
PLOT TEXT,AT -290,270-20*i+d : STR$(Lower+i)
PLOT TEXT,AT -250,270-20*i+d : ExtractString$(name$,20)
PLOT TEXT,AT -80,270-20*i+d : EntryDate$(Lower+i)
PLOT TEXT,AT 80,270-20*i+d : LastDate$(Lower+i)
PLOT TEXT,AT 240,270-20*i+d : ExtractString$(Sort$(Lower+i),8)
PLOT TEXT,AT 320,270-20*i+d : ExtractString$(Comment$(Lower+i),40)
NEXT i
! はみ出した部分は塗りつぶし
DRAW Rectangle(5,13,895,13,0,1) WITH SHIFT(-290,295)
DRAW Rectangle(5,10,895,10,0,2) WITH SHIFT(-290,-131)
! 枠類
DRAW Rectangle(5,391,895,11,1,1) WITH SHIFT(-290,270)
DRAW Rectangle(7,418,927,14,1,1) WITH SHIFT(-290,295)
DRAW Rectangle(5,12,34,12,lb_box_color,4) WITH SHIFT(-290,295)
DRAW Rectangle(4,12,164,12,lb_box_color,4) WITH SHIFT(-250,295)
DRAW Rectangle(4,12,154,12,lb_box_color,4) WITH SHIFT(-80,295)
DRAW Rectangle(4,12,154,12,lb_box_color,4) WITH SHIFT(80,295)
DRAW Rectangle(4,12,74,12,lb_box_color,4) WITH SHIFT(240,295)
DRAW Rectangle(4,12,285,12,lb_box_color,4) WITH SHIFT(320,295)
PLOT TEXT,AT -250,294 : "ファイル名"
PLOT TEXT,AT -80,294 : "登録日時"
PLOT TEXT,AT 80,294 : "最終利用日時"
PLOT TEXT,AT 240,294 : "種類"
PLOT TEXT,AT 320,294 : "コメント"
FILE SPLITNAME (ListName$) path$, name$, ext$
PLOT TEXT,AT -280,328 : "リスト : " & name$
SET TEXT JUSTIFY "center","half"
END PICTURE
! ***

! *** ボタン ***
EXTERNAL PICTURE button(i,b_state)
DECLARE NUMERIC bar_length,bar_post ! スクロールバー長、位置
SELECT CASE b_type(i)
CASE 1 ! 通常ボタン
SET LINE COLOR 1
DRAW Rectangle(b_dx(i),b_dy(i),b_dx(i),b_dy(i),bt_color1(b_state+1),4) WITH SHIFT(b_ox(i),b_oy(i))
SET TEXT font "",b_fs(i)
PLOT TEXT,AT b_ox(i),b_oy(i) : b_bh$(i)
CASE 2 ! スクロールバー
IF FileNumber>20 THEN ! スクロール可ならば表示
SET LINE COLOR 1
DRAW Rectangle(b_dx(i),b_dy(i)+1,b_dx(i),b_dy(i)+1,sb_bg_color,2) WITH SHIFT(b_ox(i),b_oy(i))
LET bar_length = b_dy(i)*20/FileNumber
LET bar_post = b_oy(i) + (b_dy(i)-bar_length)*(1-2*(Lower-1)/(FileNumber-20))
DRAW Rectangle(b_dx(i),bar_length,b_dx(i),bar_length,sb_bar_color,4) WITH SHIFT(b_ox(i),bar_post)
END IF
CASE 3
CASE 4
CASE ELSE
END SELECT
END PICTURE
! ***

! *** 動作確認用絵 ***
EXTERNAL PICTURE PictureA
SET COLOR mode "native"
SET AREA COLOR colorindex(0.2*(SIN(2*TIME)+1),0.5*(SIN(3*TIME+PI*2/3)+1),0.5*(SIN(4*TIME+PI*4/3)+1))
DRAW disk WITH SCALE(10*COS(TIME),10*SIN(TIME))*ROTATE(TIME)*SHIFT(621,295)
SET COLOR mode "regular"
END PICTURE
! ***
END MODULE

　　　　　　　　　　└これで終わりです。 shino 2004/09/04 18:42:07  ツリーへ

Re: あと残りわずかです。 返事を書く

shino 2004/09/04 18:42:07

これで終わりです。
すいません。思っていたより長かったですね。
随分長くなってしまいました。
どうも申し訳ありませんでした。

! +++ 最前ウインドウのハンドルを得る +++
EXTERNAL FUNCTION GetForeGroundWindow
ASSIGN "user32.dll","GetForegroundWindow"
END FUNCTION
! +++

! +++ ウインドウ命令 +++
EXTERNAL FUNCTION ShowWnd(hWnd, nCmdShow)
ASSIGN "user32.dll","ShowWindow"
END FUNCTION
! +++

! +++ メッセージボックス +++
EXTERNAL FUNCTION MesBox(owner,text$,caption$,flag)
ASSIGN "user32.dll","MessageBoxA"
END FUNCTION
! +++

! *** 矩形 ***
EXTERNAL PICTURE Rectangle(x1,y1,x2,y2,r_color,dtype)
SELECT CASE dtype
CASE 1 ! 枠のみ
SET LINE COLOR r_color
PLOT LINES : -x1,-y1 ; -x1,y2 ; x2,y2 ; x2,-y1 ; -x1,-y1
CASE 2 ! 内部のみ
SET AREA COLOR r_color
PLOT AREA : -x1,-y1 ; -x1,y2 ; x2,y2 ; x2,-y1 ; -x1,-y1
CASE 3 ! 色枠
SET LINE COLOR r_color
PLOT AREA : -x1,-y1 ; -x1,y2 ; x2,y2 ; x2,-y1 ; -x1,-y1
PLOT LINES : -x1,-y1 ; -x1,y2 ; x2,y2 ; x2,-y1 ; -x1,-y1
CASE 4 ! 色塗りつぶし
SET AREA COLOR r_color
PLOT AREA : -x1,-y1 ; -x1,y2 ; x2,y2 ; x2,-y1 ; -x1,-y1
PLOT LINES : -x1,-y1 ; -x1,y2 ; x2,y2 ; x2,-y1 ; -x1,-y1
END SELECT
END PICTURE
! ***

　　　　　　　　　　　└ありがとうございました。とても参考になり... H,O 2004/09/04 18:49:19  ツリーへ

Re: これで終わりです。 返事を書く

H,O 2004/09/04 18:49:19

ありがとうございました。とても参考になりました。

インデックスへ EXIT
新規発言を反映させるにはブラウザの更新ボタンを押してください。

ちょっと考えてます	返事を書く
H,O 2004/09/03 20:05:09
BASICでメニューっていうものはつくれますか？メニューでは、いくつかのBASファイルの名前をだして、そこをクリックしたらそのファイルが開くっていうものです。できなければ、他の方法で考えてみます。どうかよろしくお願いします。

Re: ちょっと考えてます	返事を書く
青木太一 2004/09/04 05:12:59
FILE GETNAME s$,"bas" print s$ end メニューは作れないけど、やりたいことは上のサンプルコードでできると思います。とりあえず上のサンプルコードはファイル選択ダイアログが出現して、選択したファイル名を2行目で表示するだけです。そのファイルを開いて何らかの処理をしたい場合はopen文などをご利用下さい。 file getnameについてはヘルプ-目次-ファイル-独自の拡張をご覧下さい。なお、「メニューが作れない」というのは若干不正確で、 file list文やグラフィックスを駆使すれば作れないことはないでしょうが、大変な回り道になると思います。またWindowsAPIを使う方法もあるのかもしれませんが、これも大変だと思います。これを知った上での質問でしたら失礼

Re: ちょっと考えてます	返事を書く
shino 2004/09/04 18:25:22
このプログラムは私も考えたことがあるのですが、あまり使えたものではないと思います。肝心の編集をすることができませんから。とりあえず、メニューだけ作ってみましたので参考にどうぞ。プログラムは右クリックで終了です。 REM 簡易ファイルメニュー ! ==== SUB ==== DECLARE EXTERNAL SUB Menu.FileMenu ! ==== 関数 ==== DECLARE EXTERNAL FUNCTION GetForegroundWindow ! 最前ウインドウのハンドルを得る DECLARE EXTERNAL FUNCTION ShowWnd ! ウインドウ命令 DECLARE EXTERNAL FUNCTION MesBox ! メッセージボックス ! ==== 絵 ==== DECLARE EXTERNAL PICTURE Rectangle ! 矩形 DECLARE NUMERIC n,hwnd SET bitmap SIZE 1024,692 SET WINDOW -345,678,-345,346 LET hwnd=GetForeGroundWindow ! 最前ウインドウのハンドルを得る LET n=ShowWnd(hwnd,3) ! ウインドウをできるだけ最大化 SET ECHO "off" ! 文字入力時反復なし CALL FileMenu END ! XXX メニューモジュール XXX MODULE Menu ! ==== 副プログラム ==== PUBLIC SUB FileMenu ! メインプログラム SHARE SUB SetOption ! オプション(とりあえず終了オプションのみ) SHARE SUB SaveFileList ! ファイルリストのセーブ SHARE SUB Event ! イベントコール SHARE SUB SelectFile ! ファイル選択 SHARE SUB ScrollList1 ! 直接スクロール SHARE SUB ScrollList2 ! 間接スクロール SHARE SUB GetNewFile ! 新規ファイルの登録 SHARE SUB DeleteFile ! ファイルの削除 SHARE SUB Waiter ! 待ち役 ! ==== 関数 ==== SHARE FUNCTION GetList ! ファイルリストの獲得 SHARE FUNCTION ExtractString$ ! 文字列の抽出 SHARE FUNCTION MakeDateString$ ! 日時を表す文字列 ! ==== 絵 ==== SHARE PICTURE ListBox ! ファイルリスト SHARE PICTURE button ! ボタン類 SHARE PICTURE PictureA ! 動作確認用 ! ==== 共用変数 ==== SHARE NUMERIC FileNumber ! ファイルの数 SHARE NUMERIC SelectionNumber ! 選択中のファイル番号 SHARE NUMERIC Lower,Higher ! 表示ファイル下限上限 SHARE NUMERIC lb_box_color ! リストボックス上部箱の色 SHARE NUMERIC lb_bar_color ! リストボックス選択線の色 SHARE NUMERIC sb_bar_color ! スクロールバーの色 SHARE NUMERIC sb_bg_color ! スクロールバー背景色 SHARE NUMERIC bt_color1(2) ! ボタンの色 SHARE STRING ListName$ ! ファイルリスト名 ! ファイル名、登録日時、最終利用日、種類、コメント SHARE STRING FileName$(100),EntryDate$(100),LastDate$(100),Sort$(100),Comment$(100) ! ボタン情報ボタンの種類、中央位置、縦横幅、フォントサイズ、付加文字列 SHARE NUMERIC b_type(10),b_ox(10),b_oy(10),b_dx(10),b_dy(10),b_fs(10) SHARE STRING b_bh$(10) DECLARE NUMERIC i

Re: このプログラムは	返事を書く
shino 2004/09/04 18:27:09
! 初期化 LET SelectionNumber = 1 LET Lower=1 LET lb_box_color=73 LET lb_bar_color=230 LET bt_color1(1)=73 LET bt_color1(2)=15 LET sb_bar_color=73 LET sb_bg_color=15 DATA 4,155,80,448,199,10,"" DATA 2,621,80,14,177,10,"" DATA 1,621,270,14,11,10,"上" DATA 1,621,-110,14,11,10,"下" DATA 1,-185,-300,100,14,10,"ファイルリストを開く" DATA 1, 30,-300,100,14,10,"新規ファイルの追加" DATA 1,245,-300,100,14,10,"ファイルリストから削除" DATA 1,400,-300,40,14,10,"開く" DATA 1,495,-300,40,14,10,"実行" DATA 1,590,-300,40,14,10,"修正" FOR i=1 TO 10 READ b_type(i),b_ox(i),b_oy(i),b_dx(i),b_dy(i),b_fs(i),b_bh$(i) NEXT i ! ==== 定義部 ==== ! ### ファイルメニュー ### EXTERNAL SUB FileMenu DECLARE NUMERIC x,y,left,right DECLARE NUMERIC i SET TEXT font "ＭＳゴシック",10 DRAW ListBox(0) FOR i=1 TO 10 DRAW button(i,0) NEXT i DO SET DRAW mode hidden mouse poll x,y,left,right IF right = 1 THEN CALL SetOption(x,y) ! オプション呼び出し DRAW PictureA ! 実行中を示す絵 FOR i=1 TO 10 ! ボタン領域内にある場合イベント呼び出し IF ABS(x-b_ox(i))<=b_dx(i) AND ABS(y-b_oy(i))<=b_dy(i) THEN CALL Event(i,left) END IF NEXT i SET DRAW mode explicit WAIT DELAY 0.01 LOOP END SUB ! ### ! ### オプション ### EXTERNAL SUB SetOption(x_ini,y_ini) DECLARE NUMERIC x,y,left,right DECLARE NUMERIC n CALL waiter(x,y,left,right) ! 終了オプション IF MesBox(0,"終了しますか？"," BASIC",4)=6 THEN SET DRAW mode explicit STOP END IF END SUB ! ### ! ### イベント ### EXTERNAL SUB Event(i,left) DECLARE NUMERIC x,y,l,r DECLARE NUMERIC n DECLARE STRING path$,name$,ext$ SELECT CASE i CASE 1 ! ファイル選択 IF left=1 THEN CALL SelectFile(i) CASE 2 ! 直接スクロール IF left=1 THEN CALL ScrollList1(i) CASE 3,4 ! スクロールボタン上下 IF left=1 THEN CALL ScrollList2(i) CASE 5 ! ファイルリストを開く IF left=1 THEN DRAW button(i,1) SET DRAW mode explicit SET DRAW mode hidden CALL Waiter(x,y,l,r) LET n=GetList(0) IF n>0 THEN ! ファイルオープン成功ならば ! 初期化 LET FileNumber = n LET Lower = 1 LET SelectionNumber = 1 DRAW ListBox(0) DRAW button(2,0) END IF DRAW button(i,0) END IF

Re: !初期化	返事を書く
shino 2004/09/04 18:29:05
まだ続きます。 CASE 6 ! 新規ファイル追加 IF left=1 THEN CALL GetNewFile(i) CASE 7 ! ファイル削除 IF left=1 THEN CALL DeleteFile(i) CASE 8,9,10 ! ファイルを開く(ノートパッド)、実行、情報修正 IF left=1 THEN DRAW button(i,1) SET DRAW mode explicit SET DRAW mode hidden CALL Waiter(x,y,l,r) DRAW button(i,0) ! 選択しているファイルが可視のファイルリスト中にある場合 IF SelectionNumber>=Lower AND SelectionNumber<=Higher THEN IF i<10 THEN ! 開く、実行は先に保存しておく LET LastDate$(SelectionNumber)=MakeDateString$ CALL SaveFileList(-1) END IF IF i=8 THEN ! ノートパッドで開く WHEN EXCEPTION IN execute "c:\windows\notepad.exe" WITH (FileName$(SelectionNumber)) USE LET n=MesBox(0,"ファイルが存在しません"," BASIC",1) END WHEN ELSEIF i=9 THEN ! 実行 file splitname (FileName$(SelectionNumber)) path$,name$,ext$ WHEN EXCEPTION IN SET directory path$ execute name$ USE LET n=MesBox(0,"ファイルを実行できません"," BASIC",1) END WHEN ELSEIF i=10 THEN ! 情報修正 INPUT PROMPT " ファイルの種類を入力してください" : Sort$(SelectionNumber) INPUT PROMPT " コメントを入力してください" : Comment$(SelectionNumber) CALL SaveFileList(-1) END IF DRAW ListBox(0) END IF END IF CASE ELSE END SELECT END SUB ! ### ! ### ファイルセレクト ### EXTERNAL SUB SelectFile(i) DECLARE NUMERIC x,y,l,r DRAW button(i,1) CALL Waiter(x,y,l,r) IF ABS(x-b_ox(i))<=b_dx(i) AND ABS(y-b_oy(i))<=b_dy(i) THEN LET SelectionNumber = Lower - INT((y-260)/20) END IF DRAW ListBox(0) END SUB ! ###

Re: まだ続きます。	返事を書く
shino 2004/09/04 18:30:24
半分くらいです。 ! ### 直接スクロール ### EXTERNAL SUB ScrollList1(i) DECLARE NUMERIC x,y,l,r DECLARE NUMERIC upper,HitArea,bar_length,d IF FileNumber<=20 THEN ! スクロール不可ならば終了 CALL Waiter(x,y,l,r) EXIT SUB END IF LET bar_length = b_dy(i)20/FileNumber ! スクロールバー長 LET HitArea = b_dy(i)(1-20/FileNumber) ! 可動域 LET upper = b_oy(i)+HitArea ! 可動上限 DO mouse poll x,y,l,r ! yの領域でスクロール位置を判断 IF ABS(y-b_oy(i))<=HitArea THEN LET Lower = 1 + (upper-y)/(bar_length/10) LET d = 20FP(Lower) LET Lower = INT(Lower) ELSEIF y>b_oy(i) THEN ! 上方向にはみ出し LET Lower = 1 LET d=0 ELSE ! 下方向にはみ出し LET Lower = FileNumber-19 LET d=0 END IF DRAW ListBox(d) DRAW button(i,0) SET DRAW mode explicit WAIT DELAY 0.01 SET DRAW mode hidden LOOP WHILE l=1 LET Lower = INT(Lower+d/20+0.5) DRAW ListBox(0) DRAW button(i,0) END SUB ! ### ! ### 間接スクロール ### EXTERNAL SUB ScrollList2(i) DECLARE NUMERIC x,y,l,r DECLARE NUMERIC l_drag,d DRAW button(i,1) LET l_drag=1 ! マウスドラッグオン DO ! それ以上スクロールできなければ終了 IF Lower=1 AND i=3 OR Lower=FileNumber-19 AND i=4 THEN SET DRAW mode explicit DRAW button(2,0) SET DRAW mode hidden CALL Waiter(x,y,l,r) IF i=3 THEN LET Lower=1 IF i=4 THEN LET Lower=FileNumber-19 EXIT DO END IF DO ! 2週目以降は一度ずつしか通らない mouse poll x,y,l,r IF l=0 THEN LET l_drag=0 DRAW ListBox(d) DRAW button(2,0) LET d = d + 2SGN(i-3.5) SET DRAW mode explicit WAIT DELAY 0.01 SET DRAW mode hidden LOOP WHILE ABS(d)<20 LET d=SGN(i-3.5)*20 LET Lower = Lower + SGN(i-3.5) LOOP WHILE l_drag=1 ! マウスドラッグ中は続ける DRAW ListBox(0) DRAW button(2,0) DRAW button(i,0) END SUB ! ###

Re: 半分くらいです。	返事を書く
shino 2004/09/04 18:32:06
続き ! ### 新規ファイルの追加 ### EXTERNAL SUB GetNewFile(i) DECLARE NUMERIC x,y,l,r DECLARE NUMERIC n DECLARE STRING f_name$ DRAW button(i,1) SET DRAW mode explicit SET DRAW mode hidden CALL Waiter(x,y,l,r) IF FileNumber=100 THEN LET n=MesBox(0,"これ以上追加できません。"," BASIC",1) DRAW button(i,0) EXIT SUB END IF file getname f_name$,"bas" IF f_name$ = "" THEN ! キャンセル ELSE LET FileNumber=FileNumber+1 IF FileNumber>20 THEN ! ファイル数によって表示下限を決定 LET Lower = FileNumber-19 ELSE LET Lower = 1 END IF LET SelectionNumber = FileNumber ! 選択位置は今選択したものに合わせる LET FileName$(SelectionNumber) = f_name$ LET EntryDate$(SelectionNumber)=MakeDateString$ INPUT PROMPT " ファイルの種類を入力してください" : Sort$(SelectionNumber) INPUT PROMPT " コメントを入力してください" : Comment$(SelectionNumber) CALL SaveFileList(-1) END IF DRAW button(i,0) DRAW ListBox(0) DRAW button(2,0) END SUB ! ### ! ### ファイルの削除 ### EXTERNAL SUB DeleteFile(i) DECLARE NUMERIC x,y,l,r DECLARE NUMERIC n DECLARE STRING path$,name$,ext$ DRAW button(i,1) SET DRAW mode explicit SET DRAW mode hidden CALL Waiter(x,y,l,r) IF FileNumber=0 THEN LET n=MesBox(0,"削除できません。"," BASIC",1) DRAW button(i,0) EXIT SUB END IF file splitname (FileName$(SelectionNumber)) path$,name$,ext$ IF MesBox(0,ExtractString$(name$,20) & "を削除します。よろしいですか？"," BASIC",1)=1 THEN CALL SaveFileList(SelectionNumber) ! 消したいファイルを飛ばして記録 LET FileNumber = GetList(1) ! 再度読み込み END IF DRAW button(i,0) DRAW ListBox(0) DRAW button(2,0) END SUB ! ###

Re: 続き	返事を書く
shino 2004/09/04 18:33:18
あと３分の１くらいです。 ! ### ファイルリストの記録 ### EXTERNAL SUB SaveFileList(DeleteNumber) DECLARE NUMERIC i,n DECLARE STRING l_name$ IF ListName$="" THEN LET n=MesBox(0,"ファイルが開かれていません。新しいファイルを開きますか?"," BASIC",4) IF n<>6 THEN EXIT SUB ! キャンセル file getname l_name$,"dat" IF l_name$="" THEN EXIT SUB ! キャンセル LET ListName$=l_name$ END IF OPEN #1:NAME ListName$ , ACCESS OUTIN , RECTYPE INTERNAL ERASE #1 WRITE #1 : "このファイルは FileMenu.bas のデータファイルです。" FOR i=1 TO FileNumber ! 消去したいデータを飛ばして記録 IF i<>DeleteNumber THEN WRITE #1 : FileName$(i),EntryDate$(i),LastDate$(i),Sort$(i),Comment$(i) NEXT i CLOSE #1 END SUB ! ### ! ### 待ち ### EXTERNAL SUB Waiter(x,y,left,right) DO mouse poll x,y,left,right WAIT DELAY 0.01 LOOP WHILE left=1 OR right=1 END SUB ! ### ! +++ リストの獲得 +++ EXTERNAL FUNCTION GetList(j) DECLARE NUMERIC i,n DECLARE STRING def$ ! ファイル先頭文字列 LET GetList = -1 IF j=0 THEN file getname ListName$,"dat" IF ListName$="" THEN EXIT FUNCTION ! キャンセル WHEN EXCEPTION IN OPEN #1:NAME ListName$ , ACCESS OUTIN , RECTYPE INTERNAL USE LET n=MesBox(0,"ファイルを開けません"," BASIC ",1) END WHEN WHEN EXCEPTION IN READ #1: def$ USE CLOSE #1 LET n=MesBox(0,"ファイルの形式が違います"," BASIC ",1) EXIT FUNCTION END WHEN ! ファイル先頭で判断 IF def$="このファイルは FileMenu.bas のデータファイルです。" THEN ! 初期化 MAT FileName$ = NUL$ MAT EntryDate$ = NUL$ MAT LastDate$ = NUL$ MAT Sort$ = NUL$ MAT Comment$ = NUL$ ! 読み込み FOR i=1 TO 100 READ #1,IF MISSING THEN EXIT FOR:FileName$(i),EntryDate$(i),LastDate$(i),Sort$(i),Comment$(i) NEXT i LET GetList=i-1 ELSE LET n=MesBox(0,"ファイルの形式が違います"," BASIC ",1) END IF CLOSE #1 END FUNCTION ! +++

Re: あと３分の１くらいです。	返事を書く
shino 2004/09/04 18:35:51
あと少しですかね。 ! +++ 文字列の抽出 +++ EXTERNAL FUNCTION ExtractString$(Base$,StrLength) DECLARE NUMERIC i DECLARE STRING ExtStr$ ! 前から順にバイト単位で取り出す IF BLEN(base$)>StrLength THEN LET i=LEN(Base$) DO LET i=i-1 LET ExtStr$=Base$(1:i) LOOP WHILE BLEN(ExtStr$)>StrLength-2 LET ExtractString$ = ExtStr$ & "…" ELSE LET ExtractString$ = base$ END IF END FUNCTION ! +++ ! +++ 時刻文字列の作成 +++ EXTERNAL FUNCTION MakeDateString$ LET MakeDateString$ = MID$(DATE$,1,4) & "/" & MID$(DATE$,5,2) & "/" & MID$(DATE$,7,2) & " " & TIME$ END FUNCTION ! +++ ! * リストボックス * EXTERNAL PICTURE ListBox(d) DECLARE NUMERIC i,j DECLARE NUMERIC StartNumber,EndNumber ! 表示開始、終了番号 DECLARE NUMERIC bar_post ! 選択バーの位置 DECLARE STRING path$,name$,ext$ SET TEXT JUSTIFY "left","half" ! まず真っ白にして下準備 DRAW Rectangle(5,391,895,11,0,2) WITH SHIFT(-290,270) ! 表示範囲の決定 IF FileNumber>20 THEN LET Higher=19+Lower ELSE LET Higher=FileNumber END IF LET StartNumber = 0 LET EndNumber = Higher-Lower ! スクロール方向により表示ファイル追加 IF d>0 THEN LET EndNumber=EndNumber+1 IF d<0 THEN LET StartNumber=-1 ! 選択バー IF SelectionNumber>0 THEN LET bar_post=270-20(SelectionNumber-Lower)+d IF ABS(bar_post-80)>=190 THEN LET bar_post=SGN(bar_post-80)190+80 DRAW Rectangle(3,9,893,9,lb_bar_color,2) WITH SHIFT(-290,bar_post) END IF

Re: あと少しですかね。	返事を書く
shino 2004/09/04 18:37:25
あと残りわずかです。 ! ファイルリスト SET TEXT COLOR 1 FOR i=StartNumber TO EndNumber ! 長い文字列は省略して表示する FILE SPLITNAME (FileName$(Lower+i)) path$, name$, ext$ PLOT TEXT,AT -290,270-20i+d : STR$(Lower+i) PLOT TEXT,AT -250,270-20i+d : ExtractString$(name$,20) PLOT TEXT,AT -80,270-20i+d : EntryDate$(Lower+i) PLOT TEXT,AT 80,270-20i+d : LastDate$(Lower+i) PLOT TEXT,AT 240,270-20i+d : ExtractString$(Sort$(Lower+i),8) PLOT TEXT,AT 320,270-20i+d : ExtractString$(Comment$(Lower+i),40) NEXT i ! はみ出した部分は塗りつぶし DRAW Rectangle(5,13,895,13,0,1) WITH SHIFT(-290,295) DRAW Rectangle(5,10,895,10,0,2) WITH SHIFT(-290,-131) ! 枠類 DRAW Rectangle(5,391,895,11,1,1) WITH SHIFT(-290,270) DRAW Rectangle(7,418,927,14,1,1) WITH SHIFT(-290,295) DRAW Rectangle(5,12,34,12,lb_box_color,4) WITH SHIFT(-290,295) DRAW Rectangle(4,12,164,12,lb_box_color,4) WITH SHIFT(-250,295) DRAW Rectangle(4,12,154,12,lb_box_color,4) WITH SHIFT(-80,295) DRAW Rectangle(4,12,154,12,lb_box_color,4) WITH SHIFT(80,295) DRAW Rectangle(4,12,74,12,lb_box_color,4) WITH SHIFT(240,295) DRAW Rectangle(4,12,285,12,lb_box_color,4) WITH SHIFT(320,295) PLOT TEXT,AT -250,294 : "ファイル名" PLOT TEXT,AT -80,294 : "登録日時" PLOT TEXT,AT 80,294 : "最終利用日時" PLOT TEXT,AT 240,294 : "種類" PLOT TEXT,AT 320,294 : "コメント" FILE SPLITNAME (ListName$) path$, name$, ext$ PLOT TEXT,AT -280,328 : "リスト : " & name$ SET TEXT JUSTIFY "center","half" END PICTURE ! * ! * ボタン *** EXTERNAL PICTURE button(i,b_state) DECLARE NUMERIC bar_length,bar_post ! スクロールバー長、位置 SELECT CASE b_type(i) CASE 1 ! 通常ボタン SET LINE COLOR 1 DRAW Rectangle(b_dx(i),b_dy(i),b_dx(i),b_dy(i),bt_color1(b_state+1),4) WITH SHIFT(b_ox(i),b_oy(i)) SET TEXT font "",b_fs(i) PLOT TEXT,AT b_ox(i),b_oy(i) : b_bh$(i) CASE 2 ! スクロールバー IF FileNumber>20 THEN ! スクロール可ならば表示 SET LINE COLOR 1 DRAW Rectangle(b_dx(i),b_dy(i)+1,b_dx(i),b_dy(i)+1,sb_bg_color,2) WITH SHIFT(b_ox(i),b_oy(i)) LET bar_length = b_dy(i)20/FileNumber LET bar_post = b_oy(i) + (b_dy(i)-bar_length)(1-2(Lower-1)/(FileNumber-20)) DRAW Rectangle(b_dx(i),bar_length,b_dx(i),bar_length,sb_bar_color,4) WITH SHIFT(b_ox(i),bar_post) END IF CASE 3 CASE 4 CASE ELSE END SELECT END PICTURE ! ! * 動作確認用絵 *** EXTERNAL PICTURE PictureA SET COLOR mode "native" SET AREA COLOR colorindex(0.2(SIN(2TIME)+1),0.5(SIN(3TIME+PI2/3)+1),0.5(SIN(4TIME+PI4/3)+1)) DRAW disk WITH SCALE(10COS(TIME),10SIN(TIME))ROTATE(TIME)SHIFT(621,295) SET COLOR mode "regular" END PICTURE ! *** END MODULE

Re: あと残りわずかです。	返事を書く
shino 2004/09/04 18:42:07
これで終わりです。すいません。思っていたより長かったですね。随分長くなってしまいました。どうも申し訳ありませんでした。 ! +++ 最前ウインドウのハンドルを得る +++ EXTERNAL FUNCTION GetForeGroundWindow ASSIGN "user32.dll","GetForegroundWindow" END FUNCTION ! +++ ! +++ ウインドウ命令 +++ EXTERNAL FUNCTION ShowWnd(hWnd, nCmdShow) ASSIGN "user32.dll","ShowWindow" END FUNCTION ! +++ ! +++ メッセージボックス +++ EXTERNAL FUNCTION MesBox(owner,text$,caption$,flag) ASSIGN "user32.dll","MessageBoxA" END FUNCTION ! +++ ! * 矩形 * EXTERNAL PICTURE Rectangle(x1,y1,x2,y2,r_color,dtype) SELECT CASE dtype CASE 1 ! 枠のみ SET LINE COLOR r_color PLOT LINES : -x1,-y1 ; -x1,y2 ; x2,y2 ; x2,-y1 ; -x1,-y1 CASE 2 ! 内部のみ SET AREA COLOR r_color PLOT AREA : -x1,-y1 ; -x1,y2 ; x2,y2 ; x2,-y1 ; -x1,-y1 CASE 3 ! 色枠 SET LINE COLOR r_color PLOT AREA : -x1,-y1 ; -x1,y2 ; x2,y2 ; x2,-y1 ; -x1,-y1 PLOT LINES : -x1,-y1 ; -x1,y2 ; x2,y2 ; x2,-y1 ; -x1,-y1 CASE 4 ! 色塗りつぶし SET AREA COLOR r_color PLOT AREA : -x1,-y1 ; -x1,y2 ; x2,y2 ; x2,-y1 ; -x1,-y1 PLOT LINES : -x1,-y1 ; -x1,y2 ; x2,y2 ; x2,-y1 ; -x1,-y1 END SELECT END PICTURE ! ***

Re: これで終わりです。	返事を書く
H,O 2004/09/04 18:49:19
ありがとうございました。とても参考になりました。