| 2003年4月29日 | 2003年10月12日 |
proc filecloseremovehistory()
dim fn$,tmp
if @hwnd=0 then end '文章を編集していない
fn$=@pathname$
tmp=@hwnd
@fileclose
if tmp=@hwnd then end '閉じなかった場合
for tmp=1 to 60
if ucase$(@@FileHistory$(tmp))=ucase$(fn$) then
@@FileHistoryDelete tmp,0
print fn$+"を履歴から除外しました。"
end
end if
next
end proc
proc main
'カレント文書が無ければ終了
if @hwnd=0 then end
'カレント文書がマクロなら同名保存したうえで実行
if sub1(@pathname$)=TRUE then
@filesave
@@jumpmacro @pathname$+",main"
end
end if
'変数の宣言
dim handle[63] as hwnd
dim nowhandle as hwnd
dim macroname$[63]
dim i,mx,mx2,ret
'カレント文書のウィンドウハンドルを保存
nowhandle=@hwnd
'編集中の文書の全ウィンドウハンドルを取得
mx=0
handle[mx++]=@@gethwnd(1)
do while handle[mx-1]
handle[mx++]=@@gethwnd(0)
loop
'編集中の全文書のファイル名をチェック
mx2=1
for i=0 to mx-1
@@Activehwnd2 handle[i]
if sub1(@pathname$)=TRUE then
macroname$[mx2++]=@pathname$
end if
next
@@activehwnd2 nowhandle
'編集中のファイル内にMACが幾つあるかで処理が変わる
if mx2=1 then end 'マクロなし
if mx2=2 then @@jumpmacro macroname$[1]+",main":end 'マクロ1つ
'マクロが複数選択されているので選択して実行
ret=popupmenu(macroname$,0,0)
if macroname$[ret]="" then end
@@jumpmacro macroname$[ret]+",main"
end
end proc
function sub1(a$) '良い名前が浮かばなかったので適当
if ucase$(a$)=ucase$(macrofilename$) then exit function
if ucase$(mid$(a$,inrstr(a$,".")+1))="MAC"then
sub1=TRUE
end if
end function
proc shift4tab
'範囲選択しているならアンインデント
'範囲選択していないなら常駐リストをアクティブに
'管理人はShift+Tabに登録して使用しています。
if @hwnd=0 then end
if @select=0 then
@ModeToolListActive
else
@blockunindent
end if
end proc
proc fontbig
'フォントを引数に指定したドット数大きくします
'引数を省略すると1ドットと見なします
dim tmp
if @hwnd = 0 then exit proc
tmp=val(command$(1))
if tmp=0 then tmp=1
@redraw=0
if @fontsize+tmp=<60 then
@fontsize=@fontsize+tmp
end if
@redraw=1
print "FontSize="+str$(@fontsize)+"dots,１行"+str$(@width)+"文字."
end proc
proc fontsmall
'フォントを引数に指定したドット数小さくします
'引数を省略すると1ドットと見なします
dim tmp
if @hwnd = 0 then exit proc
tmp=val(command$(1))
if tmp=0 then tmp=1
@redraw=0
if @fontsize-tmp>=10 then
@fontsize=@fontsize-tmp
end if
@redraw=1
print "FontSize="+str$(@fontsize)+"dots,１行"+str$(@width)+"文字."
end proc
proc colorreverse
'フォント色と背景色などを反転させる
'書式設定の設定は変更しません
if @hwnd=0 then end
@redraw=0
'将来の仕様変更に合わせた追加変更を
'容易に行うため、敢えて内容を羅列した。
colorreverse_sub1"text"
colorreverse_sub1"Article"
colorreverse_sub1"ZenSpace"
colorreverse_sub1"FontChar"
colorreverse_sub1"FontCharHk"
colorreverse_sub1"Search"
colorreverse_sub1"Select"
colorreverse_sub1"EOF"
colorreverse_sub1"Url"
colorreverse_sub1"Quote"
colorreverse_sub1"Word1"
colorreverse_sub1"Word2"
colorreverse_sub1"Word3"
colorreverse_sub1"Word4"
colorreverse_sub1"Word5"
colorreverse_sub1"Word6"
colorreverse_sub1"Comment"
colorreverse_sub1"String"
colorreverse_sub1"Caption1"
colorreverse_sub1"Caption2"
colorreverse_sub1"Caption3"
colorreverse_sub1"Caption4"
colorreverse_sub1"Caption5"
colorreverse_sub1"Caption6"
colorreverse_sub1"Caption7"
colorreverse_sub1"Caption8"
colorreverse_sub1"Caption9"
colorreverse_sub1"Caption10"
colorreverse_sub1"CaptionNum"
colorreverse_sub1"CaptionMNum"
colorreverse_sub1"CaptionAlp"
colorreverse_sub1"CaptionKana"
colorreverse_sub1"CaptionDai"
colorreverse_sub1"Memo"
colorreverse_sub1"Code"
colorreverse_sub1"Paren"
colorreverse_sub1"CompList1"
colorreverse_sub1"CompList2"
colorreverse_sub1"CompList3"
colorreverse_sub1"CompList4"
colorreverse_sub1"CompList5"
colorreverse_sub1"ToolList"
colorreverse_sub1"Tooltip"
colorreverse_sub1"Dictionary"
colorreverse_sub2"Tab"
colorreverse_sub2"Return"
colorreverse_sub2"PReturn"
colorreverse_sub2"ReturnLF"
colorreverse_sub2"ReturnCr"
colorreverse_sub2"FrmReturn"
colorreverse_sub2"Fold"
colorreverse_sub2"Modify"
colorreverse_sub2"Modify2"
colorreverse_sub2"Mark"
colorreverse_sub2"NumLine"
colorreverse_sub2"VertRule"
colorreverse_sub2"LineRule"
colorreverse_sub2"GenkoRule"
colorreverse_sub2"GenkoPage"
colorreverse_sub2"Underline"
@redraw=1
end proc
sub colorreverse_sub2(a1$)
dim n1,f1,c1,v[3]
dim tmp$,tmp
n1=@@ColorIndex(a1$)
c1=@colorget(n1+2000)
tmp$=right$("000000"+hex$(c1),6)
v[1]=val("&H"+mid$(tmp$,1,2))
v[2]=val("&H"+mid$(tmp$,3,2))
v[3]=val("&H"+mid$(tmp$,5,2))
for tmp=1 to 3
v[tmp]=255-v[tmp]
next
@colorset n1,v[1]*65536+v[2]*256+v[3]
end sub
sub colorreverse_sub1(a1$)
'フォント色と背景色を反転させる
dim n1,c1,n2,c2
dim a2$
a2$=a1$+"back"
n1=@@ColorIndex(a1$)
c1=@colorget(n1+2000)
n2=@@ColorIndex(a2$)
c2=@colorget(n2+2000)
@colorset n1,c2
@colorset n2,c1
end sub
proc main
if @canedit=0 then end
call iskeypressed(0)
print "Clipモード開始。終了はENTERキー。"
clipboard$=""
do while iskeypressed(KEY_RETURN)=0
call _sleep(100)
if val(clipboard$(-1))<>0 then
dim size
size=val(clipboard$(-1))
do
call _sleep(200)
loop while size<>val(clipboard$(-1))
dim n,tmp$
@charreturn
@charreturn
@input "------[ "+date0$+" "+time0$+" ]------"
@charreturn
@charreturn
for n=1 to val(clipboard$(-2))
tmp$=clipboard$(n)
if right$(tmp$,1)=chr$(10)then tmp$=left$(tmp$,len(tmp$)-1)
if right$(tmp$,1)=chr$(13)then tmp$=left$(tmp$,len(tmp$)-1)
@input tmp$
@charreturn2
next
beep
clipboard$=""
print "Clipモード開始。終了はENTERキー。"
end if
loop
print"Clipモードを終了しました。"
end proc
proc main
if @hwnd=0 then exit sub
dim hwnd[@@ParametersInfo(1)]
dim i,n 'i...編集中の窓の数 n...何番目の編集窓なのか
i=1
hwnd[i]=@@gethwnd(2)
do
if @hwnd=hwnd[i] then n=i
i++
hwnd[i]=@@gethwnd(0)
loop while hwnd[i]
n++
if n=i then n=1
@@Activehwnd hwnd[n]
end proc
proc main
if @hwnd=0 then exit sub
dim hwnd[@@ParametersInfo(1)]
dim i,n 'i...編集中の窓の数 n...何番目の編集窓なのか
i=1
hwnd[i]=@@gethwnd(2)
do
if @hwnd=hwnd[i] then n=i
i++
hwnd[i]=@@gethwnd(0)
loop while hwnd[i]
n--
if n=0 then n=i-1
@@Activehwnd hwnd[n]
end proc
'QXマクロ上で動作する簡易ファイラ。機能の充実、速度の向上、エラー処理などが今後の課題。当然、未保証。
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'QXマクロ上で動作する簡易ファイラ（α1版）2003/10/10
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'１．いわゆる1画面ファイラです。移動先や複写先の指定はフォルダリストで行います。
'２．機能は『QXで開く』『複写』『移動』『削除』『名前変更』のみ。
'３．SPACEでファイル選択しENTERでファイル処理メニューを表示。ESCで終了メニュー表示。
proc main()
'宣言と定数
dim wildcard$,currentfolder$ 'wildcard$は将来の拡張用
dim escmenu$[15],escmenucmd[15] 'ESCメニュー
dim entermenu$[15],entermenucmd[15] 'ENTERメニュー
dim execlist$ 'SHFileOperation用の作業対象ファイルリスト
dim viewlist$[1023],viewname$[1023] 'ViewList用
dim viewfolderflag[1023],viewchoiceflag[1023]
dim viewmax
dim flagnorefresh '表示の行進をしないフラグ
dim tmp$,tmp,i,cmd '雑用
dim filename$,extname$ '雑用2
'定数
const idviewlist =100 'コントロール
const idadress =101
const idstatus =102
const idsort =103
const ESC_CHRDIR = 1 'ESCメニュー
const ESC_CLOSE = 2
const ESC_NEWFILE = 3
const ESC_NEWFOLDER = 4
const ENTER_QXOPEN =100 'ENTERメニュー
const ENTER_RENAME =101
const ENTER_DELETE =102
const ENTER_COPY =103
const ENTER_MOVE =104
'WindowsAPIのファイル操作命令
Const LB_ADDSTRING = &H180
Const LB_INSERTSTRING = &H181
Const LB_DELETESTRING = &H182
Const LB_SELITEMRANGEEX = &H183
Const LB_RESETCONTENT = &H184
Const LB_SETSEL = &H185
Const LB_SETCURSEL = &H186
Const LB_GETSEL = &H187
Const LB_GETCURSEL = &H188
Const LB_GETTEXT = &H189
Const LB_GETTEXTLEN = &H18A
Const LB_GETCOUNT = &H18B
Const LB_SELECTSTRING = &H18C
Const LB_DIR = &H18D
Const LB_GETTOPINDEX = &H18E
Const LB_FINDSTRING = &H18F
Const LB_GETSELCOUNT = &H190
Const LB_GETSELITEMS = &H191
Const LB_SETTABSTOPS = &H192
Const LB_GETHORIZONTALEXTENT = &H193
Const LB_SETHORIZONTALEXTENT = &H194
Const LB_SETCOLUMNWIDTH = &H195
Const LB_ADDFILE = &H196
Const LB_SETTOPINDEX = &H197
Const LB_GETITEMRECT = &H198
Const LB_GETITEMDATA = &H199
Const LB_SETITEMDATA = &H19A
Const LB_SELITEMRANGE = &H19B
Const LB_SETANCHORINDEX = &H19C
Const LB_GETANCHORINDEX = &H19D
Const LB_SETCARETINDEX = &H19E
Const LB_GETCARETINDEX = &H19F
Const LB_SETITEMHEIGHT = &H1A0
Const LB_GETITEMHEIGHT = &H1A1
Const LB_FINDSTRINGEXACT = &H1A2
Const LB_SETLOCALE = &H1A5
Const LB_GETLOCALE = &H1A6
Const LB_SETCOUNT = &H1A7
Const LB_MSGMAX = &H1A8
Const FO_MOVE = &H1
Const FO_COPY = &H2
Const FO_DELETE = &H3
Const FO_RENAME = &H4
Const FOF_MULTIDESTFILES = &H1
Const FOF_CONFIRMMOUSE = &H2
Const FOF_SILENT = &H4 ' don't create progress/report
Const FOF_RENAMEONCOLLISION = &H8
Const FOF_NOCONFIRMATION = &H10 ' Don't prompt the user.
Const FOF_WANTMAPPINGHANDLE = &H20 ' Fill in SHFILEOPSTRUCT.hNameMappings
Const FOF_ALLOWUNDO = &H40
Const FOF_FILESONLY = &H80 ' on *.*, do only files
Const FOF_SIMPLEPROGRESS = &H100 ' means don't show names of files
Const FOF_NOCONFIRMMKDIR = &H200 ' don't confirm making any needed dirs
type SHFILEOPSTRUCT
dhwnd as HWND
wFunc as long'1:移動,2:複写,3:削除
pFrom as long
pTo as long
fFlags as integer
fAnyOperationsAborted as long
hNameMappings as long
lpszProgressTitle as long
end type
dllname "SHELL32.DLL"
cdeclare long SHFileOperation(SHFILEOPSTRUCT *)
dim shfo as SHFILEOPSTRUCT
'初期化
if @hwnd<>0 then
currentfolder$=@pathname$
currentfolder$=left$(currentfolder$,inrstr(currentfolder$,"\"))
end if
if currentfolder$="" then currentfolder$=@@qxdirectory$
wildcard$="*.*"
i=1 'ESCメニュー
escmenucmd[i]=ESC_CHRDIR :escmenu$[i++]="フォルダ変更(&M)"
escmenucmd[i]=0 :escmenu$[i++]="-"
escmenucmd[i]=ESC_NEWFILE :escmenu$[i++]="空ファイルの作成(&N)"
escmenucmd[i]=ESC_NEWFOLDER :escmenu$[i++]="フォルダの作成(&F)"
escmenucmd[i]=0 :escmenu$[i++]="-"
escmenucmd[i]=ESC_CLOSE :escmenu$[i++]="閉じる(&C)"
i=1 'ENTERメニュー
entermenucmd[i]=ENTER_QXOPEN :entermenu$[i++]="QXで開く(&Q)"
entermenucmd[i]=ENTER_RENAME :entermenu$[i++]="名前変更(&R)"
entermenucmd[i]=0 :entermenu$[i++]="-"
entermenucmd[i]=ENTER_MOVE :entermenu$[i++]="移動(&M)"
entermenucmd[i]=ENTER_COPY :entermenu$[i++]="複写(&C)"
entermenucmd[i]=0 :entermenu$[i++]="-"
entermenucmd[i]=ENTER_DELETE :entermenu$[i++]="削除(&D)"
'ダイアログの作成
dialog "簡易ファイラ",0,0,50*4,17*8,0,"FixedSys"
control "",idviewlist,"LISTBOX",WS_HSCROLL+WS_VSCROLL+LBS_MULTIPLESEL+ _
LBS_DISABLENOSCROLL+WS_BORDER,4,12,48*4,14*8
control "OK",IDOK,"BUTTON",BS_PUSHBUTTON,100*4,100*8,8*4,2*8
control "Menu",IDCANCEL,"BUTTON",BS_PUSHBUTTON,100*4,15*8,8*4,2*8
control "Help:SPACEで選択しENTERでファイルを操作。ESCで特殊機能。",idstatus,"STATUSBAR",0,0,0,0,0
control "",idadress,"STATIC",0,4,2,50*4,10
control "SORT用",idsort,"LISTBOX",LBS_SORT,100*4,0,0,0
do while -1 'とりあえず無限ループ
'ファイルリストの作成
if flagnorefresh=1 then
flagnorefresh=0
else
print "ファイル情報を取得中..."
if right$(currentfolder$,1)<>"\" then currentfolder$=currentfolder$+"\"
tmp$=dir$(currentfolder$+wildcard$)
i=0
do while tmp$<>""
if tmp$="." or ((tmp$="RECYCLED" or tmp$="..") and len(currentfolder$)=3) then
else
i=i+1
viewname$(i)=tmp$
end if
tmp$=dir$()
loop
viewmax=i
for i=1 to viewmax
tmp$=viewname$[i]
'ファイル名と拡張子を分ける
if instr(tmp$,".")=0 then
filename$=tmp$
extname$=""
elseif tmp$=".."then
filename$=".."
extname$=""
else
filename$=left$(tmp$,inrstr(tmp$,".")-1)
extname$=mid$(tmp$,inrstr(tmp$,".")+1)
end if
'ファイル名
viewlist$(i)=leftb$(leftb$(filename$,15)+space$(15),15)
if lenb(tmp$)>19 then
viewlist$[i]=viewlist$[i]+"~ "
else
viewlist$[i]=viewlist$[i]+" "
end if
'拡張子
viewlist$(i)=viewlist$(i)+leftb$(leftb$(extname$,4)+space$(5),5)
'サイズ
tmp=getattr(currentfolder$+tmp$)
if(tmp and &H10) then
tmp$="<<Dir>>"
tmp$=leftb$("<<Dir>>"+space$(10),10)
viewfolderflag[i]=1
else
if filelen(currentfolder$+viewname$[i])=0 then
tmp$="0"
else
tmp$=str$(filelen(currentfolder$+viewname$[i])/1024+1)
end if
tmp$=rightb$(rightb$(space$(9)+tmp$+" k",10),10)
viewfolderflag[i]=0
end if
viewlist$[i]=viewlist$[i]+tmp$
'日付
tmp$=filedatetime$(currentfolder$+viewname$[i])
viewlist$[i]=viewlist$[i]+" "+tmp$
if i mod 20=0 then print str$(i)+"件目のファイル情報を取得中..."
next
print
viewmax=i
i++:viewlist$(i)=""
dlglistboxarray idviewlist,viewlist$
dlgtext$ idadress,currentfolder$+wildcard$
dlgvalue idviewlist,1
end if
'ユーザー操作
cmd=dialog(1+DLGN_DOUBLECLICKED)
if cmd=IDOK then 'ENTERを押したとき
tmp=dlgitemcmd(idviewlist,LB_GETSELCOUNT,0,0)
if tmp=0 then '選択せずにENTER
tmp=dlgvalue(idviewlist)+1
if viewfolderflag[tmp]=1 then 'フォルダ移動
if viewname$[tmp]=".." then
currentfolder$=left$(currentfolder$,len(currentfolder$)-1)
currentfolder$=left$(currentfolder$,inrstr(currentfolder$,"\"))
else
currentfolder$=currentfolder$+viewname$[tmp]+"\"
end if
else 'ファイルをQXで開く
call @@openfile(currentfolder$+viewname$[tmp])
end
end if
else '選択してENTER
cmd=entermenucmd[popupmenu(entermenu$,0,0)]
execlist$=""
for i=1 to viewmax
if dlgitemcmd(idviewlist,LB_GETSEL,i-1,0)>0 then
execlist$=execlist$+currentfolder$+viewname$[i]+chr$(0)
end if
next
execlist$=execlist$+chr$(0)
if cmd=ENTER_QXOPEN then
for i=1 to viewmax
if dlgitemcmd(idviewlist,LB_GETSEL,i-1,0)>0 then
call @@openfile(currentfolder$+viewname$[i])
end if
next
end
elseif cmd=ENTER_RENAME or cmd=ENTER_DELETE or _
cmd=ENTER_MOVE or cmd=ENTER_COPY then
if cmd=ENTER_RENAME and tmp<>1 then
call msgbox("ファイルが複数選択されています。")
else
if cmd=ENTER_RENAME then
tmp$=left$(execlist$,len(execlist$)-2)
tmp$=mid$(tmp$,inrstr(tmp$,"\")+1)
tmp$=inputbox$("新しい名前を入力してください。","名前の変更",tmp$,"")
tmp$=currentfolder$+tmp$
tmp=4
elseif cmd=ENTER_MOVE then
tmp$ = getfolder$("移動先のフォルダを選んで下さい。",currentfolder$)
tmp=1
elseif cmd=ENTER_COPY then
tmp$ = getfolder$("複写先のフォルダを選んで下さい。",currentfolder$)
tmp=2
elseif cmd=ENTER_DELETE then
tmp$=chr$(0)
tmp=3
end if
end if
if tmp$<>"" then
tmp$=tmp$+chr$(0)
shfo.dhwnd =@@hwnd
shfo.wFunc =tmp'1:移動,2:複写,3:削除,4:名前変更
shfo.pFrom =varptr(execlist$)
shfo.pTo =varptr(tmp$)
shfo.fFlags =FOF_ALLOWUNDO
call SHFileOperation(shfo)
beep
end if
end if
end if
elseif cmd=IDCANCEL then 'ESCを押したとき
cmd=escmenucmd[popupmenu(escmenu$,0,0)]
if cmd=ESC_CLOSE then
end
elseif cmd=ESC_CHRDIR then
tmp$ = getfolder$("表示したいフォルダを選んで下さい。",currentfolder$)
if tmp$<>"" then currentfolder$=tmp$
if right$(currentfolder$,1)<>"\" then currentfolder$=currentfolder$+"\"
elseif cmd=ESC_NEWFILE then
tmp$=inputbox$("ファイル名を入力してください。","空ファイルの新規作成","","")
if tmp$<>"" then
open currentfolder$+tmp$ for output as #1
close#1
end if
elseif cmd=ESC_NEWFOLDER then
tmp$=inputbox$("フォルダ名を入力してください。","フォルダの新規作成","","")
if tmp$<>"" then
mkdir currentfolder$+tmp$
end if
end if
if cmd=0 then
flagnorefresh=1
end if
end if
loop
end proc