CommonStringSetFig = 1 Ierror = 0 Dim なんたらかーたら Call あれれ.○×▼initialize IF (Ierror = 0) then CommonStringSetFig = 2 End Sub
で初期化して
Sub なんか仕様() IF (CommonStringSetFig = 0) then Call CommonStringSet()
IF (CommonStringSetFig <= 0) then '未初期化、初期化ルーチンの障害等 ElseIF (CommonStringSetFig = 1) then '初期化作業中 'あれれ.frmから参照がある場合等 ElseIF (CommonStringSetFig = 2) then '初期化終了 else '致命的障害・終了処理中 end IF End sub
同じくIDC_BTN4-IDC_BTN6でちょっと違う。 Case IDC_BTN4 → Case IDC_BTN5 → Case IDC_BTN6 Dim As Long IAA, IBB, ICC IBB = BBBB(TakahWnd) → IBB = BBBBByVal(TakahWnd) → IBB = BBBBByRef(TakahWnd)
以下 D:\bas\Projects\DimChk11E\DimChk11E01.basの内容。 Function AAAA( IAA As Long) As Long IAA = 5 AAAA = 8 End Function 以下、AAAA系統で、異なる点だけ。 Function AAAAbyVal(ByVal IAA As Long) As Long AAAAbyVal = 8 Function AAAAbyRef(ByRef IAA As Long) As Long AAAAbyRef = 8
次にBBBB系統。 Function BBBB(TakahWnd As HWND) As Long Dim As Long IAA, IBB, ICC IAA = 10 ICC = IAA IBB = AAAA( IAA) MessageBox(TakaHWND, "Hello E("+ Str$(IBB)+") " + Str(IAA) +"/"+Str$(ICC), "Messagebox caption", MB_ICONINFORMATION) BBBB = 9 End Function 違うところだけ Function BBBBbyVal(TakahWnd As HWND) As Long IBB = AAAAbyVal( IAA) BBBBbyVal = 9 Function BBBBbyRef(TakahWnd As HWND) As Long IBB = AAAAbyRef( IAA) BBBBbyRef = 9
構造体の初期化に関して、 手持ちのMIDIによるBEEP音が 'park7.wakwak.com/~efc21/cgi-bin/exqalounge.cgi?print+200707/07070177.txt しかないので、これ関係。 'declare function midiOutOpen(byval phmo as LPHMIDIOUT, byval uDeviceID as UINT, byval dwCallback as DWORD_PTR, byval dwInstance as DWORD_PTR, byval fdwOpen as DWORD) as MMRESULT より、 Dim midHnd As HMIDIOUT__ Dim ImidHndPTR As HMIDIOUT = @midHnd Dim ImidHndPTRPTR As LPHMIDIOUT = @ImidHndPTR を用意して midHnd.unused = 0 If (ImidHndPTR <> @midHnd) Then MessageBox(TakaHWND, "Hello (ImidHndPTR) 範囲外" + Str(ImidHndPTR)+","+Str$(@midHnd), "Messagebox caption", MB_ICONINFORMATION) EndIf If (ImidHndPTRPTR <> @ImidHndPTR) Then MessageBox(TakaHWND, "Hello (ImidHndPTRPTR) 範囲外" + Str(ImidHndPTRPTR)+","+Str$(@ImidHndPTR), "Messagebox caption", MB_ICONINFORMATION) EndIf とやったらば、MessageBox()が実行されなかった。だから、構造体に値が入っているかどうかは別にして、 アドレス(ポインター)はDimで決定されるみたい。
MSReturnCode = midiOutOpen(@ImidHndPTR, MIDI_MAPPER, 0, 0, CALLBACK_NULL) MSReturnCode = midiOutClose(@midHnd) Private Function BeepMidiOut(ImidHnd As HMIDIOUT__, DataString as String) As Long 'ルーチン名の変更 Sub Midi_out() →
Function PlayMIDIfile1(ByRef ActionType As Integer) As Long Dim As Long IAA, IBB PlayMIDIfile1 = 0 If (IAA = IBB) Then ActionType =0 Else ActionType =1 Dim As Long Ptr IAAptr = @IAA IBB = *IAAptr 'エラー発生せず EndIf
If ( ActionType =1 ) Then ' IBB = *IAAptr: 'ここでエラー 'BeepFmod.bas(45) error 41: Variable not declared, IAAptr in 'IBB = *IAAptr' EndIf End Function
前者を制御しているのが゜Sleep 命令らしい、というところまではつかんだ。 www.fmod.org/ ではゲーム音楽が主体という解説があり、何らかの手段でマルチタスク化、つまり、音楽再生を続けたまま制御が参照側に戻るという処理があるはずなのだが UsingFMOD_A_Tutorial\basic_fmod_guide.txt には、 If your needs extend beyond this tutorial, you are encouraged to explore additional FMOD calls and its documentation. このチュートリアルを超えて使用する必要性がある場合は、FMODのマニュアルに追加されたのFMOD関係参照を調べることをお勧めします。 とあり、basic_fmod_guide.txtの英文解読が必要の模様。 FMODのマニュアルは会員制のため、英語が天才的にできない吾輩としては、あきらめる必要がある。
任意の旗。 通常の睡眠に対して、0 の値を与えます。 Optional flag; give it a value of 0 for a normal sleep, より、日本語訳の「旗」、原文の「flag」は、ユーザーが指定するから、スイッチの意味と思わせれる。 「通常の睡眠」は、「通常のsleep(命令)」の意味でしょう。 「「深い」睡眠」、原文の「 a "deep" sleep」は、""が使われていることから辞書用語 https://kotobank.jp/ejword/deep ではあまり使われない「5 （程度が）強度の, 極度の, 強烈な」の意味と思われます。 キー入力を受け付けない、ことを「deep」と表現しているものと思われます。 []
>>902 #include once "windows.bi" #include once "win\mmsystem.bi"
type MidiMessage field=1 Number as UByte ParmA as UByte ParmB as UByte Reserved as UByte end Type
#define MidiSendMessage(MSGVAR) midiOutShortMsg(MYPLAYDEVICE, *cptr(integer ptr,@MSGVAR)) dim shared as HMIDIOUT MYPLAYDEVICE '// MIDI device interface for sending MIDI output var FLAG = midiOutOpen(@MYPLAYDEVICE, MIDI_MAPPER, 0, 0, null) if (FLAG <> MMSYSERR_NOERROR) Then print "Error opening MIDI Output." end If
Dim Shared as MidiMessage MidiMsg MidiMsg.Reserved = 0 Sub NoteOn(channel As UByte, note As UByte, velocity As UByte) MidiMsg.Number = &h90 + (channel And &hf) MidiMsg.ParmA = (note And &h7f) 'NOTE MidiMsg.ParmB = (velocity And &h7f) 'volume MidiSendMessage(MidiMsg) End Sub
Dim I As Integer For I =1 To 50 NoteOn(0,I,127) Sleep 200 Next I
私の Win10 32bit では、 makoto-watanabe.main.jp/freebasic/tipsMIDI.html の「QB like PLAY plus more...」の「BrazillianThemeMusic.bas」(PlayMidi.bas を含む。PlayFMOD.bas ではないので注意。) を実行したところ、単音ですが音楽を再生できました。
Public Function StringPeek(ActionType As Long) As long StringPeek = 0 Const LenZstring = 20 Dim As ZString * LenZstring AAzstring, BBzstring, CCzstring Dim As String AAstring, BBstring Dim As Long IAA, IBB, ICC Dim As ZString Ptr AAzstringPTR
AAstring = "" For IAA = 1 To LenZstring AAstring = AAstring + Str$(IAA Mod 10) Next IAA AAZString = AAstring AAzstringPTR = @AAZString MessageBox(TakaHWND,"Hello ("+AAZString+")"+Str$(Len(AAzstring))+" , "+Str$(len(CCzstring)),"Messagebox caption",MB_ICONINFORMATION) BBstring = "" For IAA = 0 To LenZstring -1 IBB = Peek(UByte, AAzstringPTR + IAA) BBstring = BBstring + Str$(IBB - &h30) Next IAA BBZString = BBstring If (AAZString <> BBZString) Then MessageBox(TakaHWND,"Hello ("+BBZString+") ("+AAzstring+")","Messagebox caption",MB_ICONINFORMATION) Else MessageBox(TakaHWND,"Hello ("+BBZString+")"+Str$(Len(AAzstring))+" , "+Str$(len(CCzstring)),"Messagebox caption",MB_ICONINFORMATION) EndIf End Function とまー、何とか領域が確保できた。
Const MLMsgTSU = 64 Dim MLMsg() As UByte Dim MLMsgString as String, MLMsgZString as ZString * MLMsgTSU Dim As Long IAA, IBB, MLMsgSU Dim lpMidiOutHdr As MIDIHDR: ' MIDIHDR 構造体 Dim ImidHndPTRPTR As LPHMIDIOUT ImidHndPTRPTR = @ImidHndPTR: 'ImidHndPTR = @ImidHnd
IBB =
988 名前：Len(DataString): IAA = IBB Mod 2& If (IAA <> 0&) Then DataString = Left$(DataString, Len(DataString) - 1&) MLMsgSU = Len(DataString) \ 2& - 1& If (MLMsgSU <= 0&) OR (MLMsgSU > MLMsgTSU- 3)Then Else ReDim MLMsg(0& To MLMsgSU): MLMsgString = "" For IAA = 1& To Len(DataString) Step 2& IBB =Val("&H" & Mid(DataString, IAA, 2&)) MLMsg((IAA - 1&) \ 2&) = IBB MLMsgString = MLMsgString + Chr$(IBB) Next IAA MLMsgZString = MLMsgString For IAA = 0& To MLMsgSU If Asc(Mid$(MLMsgZString, IAA+1,1)) <>MLMsg(IAA) Then MessageBox(TakaHWND, "ZString("+Str$(MLMsg(IAA))+") と異なります"+Str$(IAA), "Messagebox caption", MB_ICONINFORMATION) Next IAA lpMidiOutHdr.lpData = VarPtr(MLMsgZString) lpMidiOutHdr.dwBufferLength = MLMsgSU + 1& lpMidiOutHdr.dwFlags = 0& MSReturnCode = midiOutPrepareHeader(ImidHndPTR, @lpMidiOutHdr, Len(lpMidiOutHdr)) []
音量調節関係 Public Function BeepInfomation(ActionType As Integer, ByRef CurrentVolLeft As ULong, ByRef CurrentVolRight As ULong, ByRef IER As Long) As Long '*-* 音量調節 'ActionType = {1;音量取得, -1;音量設定} Dim BothVolumes As DWORD Dim MSerrorCodeMM as MMRESULT
Dim WAVEOUT as HWAVEOUT__ Dim WAVEOUTptr as HWAVEOUT Dim WAVEOUTptrPtr as LPHWAVEOUT WAVEOUTptr = @WAVEOUT WAVEOUTptrPtr = @WAVEOUTptr
BeepInfomation = 0 IER = 0 If (ActionType = 1) Then MSerrorCodeMM = waveOutGetVolume(0, @BothVolumes) CurrentVolLeft = LoWord(BothVolumes) CurrentVolRight = HiWord(BothVolumes) ElseIf (ActionType = -1) Then BothVolumes = CurrentVolRight * &h10000 + CurrentVolLeft MSerrorCodeMM = waveOutSetVolume(WAVEOUTptr, BothVolumes) Else IER = 10 End If End Function で音量変更ができた。次回はミュート関係の予定。
起動*.bas (Gr03.bas)で存在しないルーチン名 Declare Function Beep03SC_CommonStringSet(ByVal hWin As HWND) As long を定義して IAA = Beep03SC_CommonStringSet(TakaHWND) と参照すると、 Gr03.o:fake:(.text+0x42): undefined reference to `BEEP03SC_COMMONSTRINGSET@4' と、存在しないサブルーチンを参照しているとの警告メッセージ゜が出る。 リンカーメッセージだと思うが、ルーチン名が大文字になっているので気が付きにくい。
Public Function getVolInfo(DevString As String, ByRef VSNoString As String, ByRef FlStmString As String, ByRef MaxPathLenLong As Long, ByRef DevTypeLong As Long) As Long Const TakaSubRoutineNo as long = 3& '*-* ボリウムシリアルナンバーとファイルシステムを取得する 'VSNoString (出)ボリウムシリアルNo 'FlStmString (出)ファイルシステム名 'MaxPathLenLong (出)最大パス長さ, 0;障害 'DevTypeLong (出) 0;(障害), 1;交換可能ディスク(FD/MOなど), 2;固定ディスク, 3;リモート or ネットワークドライブ, 4;CD_ROMドライブ, 5;RAMディスク, (他);未定義}
'Const MAX_PATH& = 260 Const FileSystemNameBufferLenULng As ULong = 32& Dim RootPathNameString As String 'ルートディレクトリ Dim strVolumeNameBuffer As String * MAX_PATH = space$(MAX_PATH) 'ボリューム名バッファ Dim VolumeSerialNumberULng As ULong 'ボリュームのシリアル番号 Dim MaximumComponentLengthULng As ULong 'ファイル名の最大の長さ Dim lngFileSystemFlagsULong As ULong 'ファイルシステムのオプション Dim FileSystemNameBufferString As String * FileSystemNameBufferLenULng = space$(FileSystemNameBufferLenULng) 'ファイルシステム名を格納するバッファ Dim As Long IErrorLong Dim As String AAString
RootPathNameString = Left$(DevString, 2) & "\" + Chr$(&H00) AAString = "" IF (Mid(RootPathNameString, 2,1) <> ":") then AAString = AAString & "(" & RootPathNameString & ")" & "デバイスの指定がありません。" else IErrorLong = GetVolumeInformation(RootPathNameString, strVolumeNameBuffer, MAX_PATH, @VolumeSerialNumberULng, @MaximumComponentLengthULng, @lngFileSystemFlagsULong, FileSystemNameBufferString, FileSystemNameBufferLenULng) IF (IErrorLong = 0) then '障害発生 end if If (lngFileSystemFlagsULong) Then '(2005.09.05 済) Sub getVolInfo() ボリウムシリアルNoを４桁から８桁に変更 VSNoString = NHexStringUL(VolumeSerialNumberULng, 8): 'ボリウムシリアルNo FlStmString = NulCatString(FileSystemNameBufferString): 'ファイルシステム名 MaxPathLenLong = MaximumComponentLengthULng: '最大パス長さ
If (lngFileSystemFlagsULong And FS_CASE_IS_PRESERVED) Then AAString = AAString & "ファイル名大文字小文字維持" If (lngFileSystemFlagsULong And FS_CASE_SENSITIVE) Then AAString = AAString & "ファイル名大文字小文字区別" (中略、こんな調子で、属性フラグを作成しているのだが、ロボットチェックに引っかかってかけないんだわ)
If (lngFileSystemFlagsULong And FILE_SUPPORTS_SPARSE_FILES) Then AAString = AAString & "スパースファイル" If (lngFileSystemFlagsULong And FILE_VOLUME_QUOTAS) Then AAString = AAString & "ディスククォータ" Else ' エラーを表示 AAString = AAString & "(" & RootPathNameString & ")" & "属性は取得できません。" VSNoString = "" FlStmString = "" MaxPathLenLong = 0&: '(2008.05.30 済) Sub getVolInfo() 障害時に0を返すように変更 EndIf EndIf
IF (Mid(RootPathNameString, 2,1) <> ":") then IErrorLong = 0 else 'declare function GetDriveTypeA(byval lpRootPathName as LPCSTR) as UINT IErrorLong = GetDriveType(RootPathNameString) EndIf DevTypeLong = IErrorLong - 1& If (DevTypeLong < 0&) Then DevTypeLong = 0& End Function
>>954 のつづき。 Make tuneup failed (complaints about missing file) 調整には失敗した(不足しているファイルについての問題)。
test_gmp.bas A (sort of) program I made to test the new header file, don't take it to serious. 新しいヘッダファイルをテストするために作った(ある種の)プログラム。 複雑にしないでください。
D:\FreeBASIC-1.00.0-win32 +--bin +--doc +--inc <== bmp.bi needs to go here (rename or save the old gmp.bi file if you want to preserve it). bmp.bi はここの保存する必要がある(古いファイルを保存したい場合には、名前を変更するか他の場所に保存する)。 \--lib \--win32 <== libgmp.a needs to go here (if you have installed a libgmp.a by yourself rename/
1038 名前：save the old one). libgmp.a はここの保存する必要がある(libgmp.a を使用したい場合には、名前を変更するか他の場所に保存する)。 The gmp.bi file need two files to work properly, long.bi and stddef.bi. gmp.biファイルが正しく動作するために2つのファイル、long.bi と stddef.biが必要です。 []
タスクの重複起動を禁止するために 実行形式ファイル DimChk16.exe を占有することを模索。 書き込みのみを禁止する方法は発見できたが、読み取りを禁止する方法は発見できず File = Exepath + "\AAA.txt" FileNoLong = FreeFile 'Open File For Input Lock Read Write As #FileNoLong (読み書き可能) 'Open File For Input Lock Read As #FileNoLong (読み書き可能) 'Open File For Input Lock As #FileNoLong (読み書き可能) 'Open File For Input, Read As #FileNoLong (エラー) 'Open File For Input Read As #FileNoLong (エラー) 'Open File For Input, Lock Read As #FileNoLong (エラー) 'Open File For Binary As #FileNoLong: '他タスクによる書き込みだけ禁止 'Open File For Binary Shared As #FileNoLong: '他タスクによる書き込みだけ禁止 Open File For Binary Lock As #FileNoLong: '他タスクによる書き込みだけ禁止 MessageBox(TakaHWND,"Hello ","Messagebox caption",MB_ICONINFORMATION) Close #FileNoLong
Dim Shared CtrlFile5String As String: '重複起動検査用 Const IniNameString as String = "taka01b" Dim Shared AppExeNameString As String
Private Function Local_CommonStringSet(ActionType as Integer) As long Const TakaSubRoutineNo as long = 2& 'このファイルを使用するときに初期化する必要がある内容 IF (CommonStringSetFig = 0) then CommonStringSetFig = 1 Local_CommonStringSet = 0 CtrlFile5String = Exepath + "\" + IniNameString + ".Txt" AppExeNameString = Right(Command( 0 ), Len(Command( 0 )) - InStrRev(Command( 0 ), "\")) CommonStringSetFig = 2 else Local_CommonStringSet = 1 end if End Function
Public Function IniFileWrite(FileString as String, SecNameString as String, KeyNameString as String, KeyValString as String) as long Const TakaSubRoutineNo as long = 20& Dim As Long IErrorRetCodeLong 'Win 2000 では、&H09が使用可能、Win98では不可 TakaDammyReturnCode4 = TakaErrorPointSach(IniNameString, TakaSubRoutineNo) If (Len(FileString) = 0&) Or (Len(SecNameString) <= 0&) Or (Len(KeyNameString) = 0&) Or (Len(KeyValString) = 0&) Then IniFileWrite = 1 Else IErrorRetCodeLong = WritePrivateProfileString(SecNameString, KeyNameString, KeyValString, FileString) IniFileWrite = abs(sgn(IErrorRetCodeLong))-1 End If End Function
Public Function IniFileRead2(FileString As String, SecNameString As String, KeyNameString As String, ByRef KeyValLong as Long) as Long Const TakaSubRoutineNo as long = 25& 'IniFileRead の倍精度整数用 Dim strValue As String * IniBuffSize: '1024 Dim as Long StrLength, IErrorRetCodeLong, IAA TakaDammyReturnCode4 = TakaErrorPointSach(IniNameString, TakaSubRoutineNo) StrLength = Len(strValue) IniFileRead2 = 0 If (Len(FileString) = 0) Or (Len(SecNameString) <= 0) Or (Len(KeyNameString) <= 0) Then KeyValLong = 0& Else IErrorRetCodeLong = GetPrivateProfileString(SecNameString, KeyNameString, "", strValue, StrLength, FileString) KeyValLong = Val(strValue) End If End Function
Public Function IniFileSecDelete(FileString As String, SecNameString As String) As Long Const TakaSubRoutineNo as long = 32& Dim As Long IErrorRetCodeLong TakaDammyReturnCode4 = TakaErrorPointSach(IniNameString, TakaSubRoutineNo) IniFileSecDelete = 0 If (Len(FileString) = 0) Or (Len(SecNameString) <= 0) Then Else IErrorRetCodeLong = WritePrivateProfileString(SecNameString, 0, 0, FileString) End If End Function
ライブラリーの整理の都合で、タイムゾーン関係をいじり始めることになった。 msのサイトを見ても、よくわからないので、見つけた関数を試している。 Function TimeZonTest(ActonType As Integer) As Long
'Dim TakaTimeZon As DYNAMIC_TIME_ZONE_INFORMATION 'Dim TakaTimeZonPtr As PDYNAMIC_TIME_ZONE_INFORMATION Dim TakaTimeZon2 As _TIME_ZONE_INFORMATION Dim TakaTimeZon2Ptr As LPTIME_ZONE_INFORMATION
Dim MsRetCode As DWORD 'TakaTimeZonPtr = @TakaTimeZon TakaTimeZon2Ptr = @TakaTimeZon2 TimeZonTest = 0
1062 名前：ﾓ。半角⇔全角の変換命令がないので作った。余計な部分は、大域変数として宣言すると常駐するための物。 現時点でどのライブファイルが担当するのか決めていないので、局所宣言になっている。 Public Function StrConvAsc2SjisString(ChacterType As Integer, AAString As String) As String Const TakaSubRoutineNo as long = 10& '*-* ASC半角カタカナを全角平仮名・全角片仮名に書き換える 'ChacterType (入);{2;全角平仮名, (他);全角片仮名} 'AAString (入);書き換え前の文字列 'StrConvAsc2SjisString (出);書き換え後の文字列 Dim As String ChacterGLstring(&h20 To &h7E), ChacterGHstring(&hA0 To &hDF) Dim As Long ChacterGAsetFig1 = 0 Dim As Integer ChacterGAsetFig2 = 0 Const GLstring = " ！”＃＄％＆’（）＊＋，－．／０１２３４５６７８９：；＜＝＞？＠ＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺ［￥］＾＿‘ａｂｃｄｅｆｇｈｉｊｋｌｍｎｏｐｑｒｓｔｕｖｗｘｙｚ｛｜｝￣" Const GHstring1 = " 。「」、・ヲァィゥェォャュョッーアイウエオカキクケコサシスセソタチツテトナニヌネノハヒフヘホマミムメモヤユヨラリルレロワン゛゜" Const GHstring2 = " 。「」、・をぁぃぅぇぉゃゅょっーあいうえおかきくけこさしすせそたちつてとなにぬねのはひふへほまみむめもやゆよらりるれろわん゛゜" Dim As Long IAA, IBB Dim As String BBstring
TakaDammyReturnCode4 = TakaErrorPointSach(IniNameString, TakaSubRoutineNo) IF (ChacterGAsetFig1 = 0) or (ChacterGAsetFig2 <> ChacterType) then ChacterGAsetFig1 = 1 IBB = 0 []
>>978 のつづき。 Dim Shared As String TestFileString, ReadDataString Dim Shared As Long FileNoLong Dim Shared As UByte aByte(0 To &h0F) と大域宣言して TestFileString = ExePath + "\test.test.txt" FileNoLong = FreeFile Open TestFileString For Output As #FileNoLong Print #FileNoLong,"0123456789ABCDEF"; Print #FileNoLong,"0123456789ABCDEF"; Print #FileNoLong,"0123456789ABCDEF"; Print #FileNoLong,"0123456789ABCDEF"; Close #FileNoLong と、試験ファイルを作成して。 TestFileString = ExePath + "\test.test.txt" Open TestFileString For Binary Access Read Write Lock Read Write As #FileNoLong For IBB = 1 To 3 Get #FileNoLong, , aByte() ReadDataString = "" For IAA = LBound(aByte) To UBound(aByte): ReadDataString = ReadDataString + Chr$(aByte(IAA))+"
1068 名前： ": Next IAA MessageBox(TakaHWND, "Hello ("+ReadDataString +")", "Messagebox caption", MB_ICONINFORMATION) Next IBB Close #FileNoLong と、読みだすと、メッセージボックス表示中に、ノートパットで中身を覗ける []
makoto-watanabe.main.jp/freebasic/ExtLibZip.html#start の見本ファイルが構文障害で動作せず。 Private Sub unpack_zip_file(ByVal zip As zip_t Ptr, ByVal i As Integer) Dim As zip_file_t Ptr fi = zip_fopen_index(zip, i, 0) と、 As zip → As zip_t、As zip_file → As zip_file_t の変数型の変更で動作するようになった。
"C:\tool\FreeBASIC\inc\zip.bi" から、 Dim As String filename = *zip_get_name(zip, i, 0) より「zip_get_name」の宣言文を見つけて、引数「zip」の宣言に合わせた。 以下同様。
