ab.com コミュニティ

コード: 全て選択

'-----------------------------------------------------------------------------
'  イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hMainWnd

' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。

Const ID_TOOLBAR = 70    'ツールバーのID
Dim hToolbar As DWord    'ツールバーのハンドル

Dim hImageList As DWord  'イメージリストのハンドル

Const ID_STATUS = 71  'ステータスバーのID
Dim hStatus As DWord     'ステータスバーのハンドル

Sub SetTbButtonData(ByRef ptb As TBBUTTON, iBitmap As Long, idCommand As Long, fsState As Byte, fsStyle As Byte)
	'ptb（TBBUTTON構造体）にボタン情報を格納する
	With ptb
		.iBitmap=iBitmap
		.idCommand=idCommand
		.fsState=fsState
		.fsStyle=fsStyle
		.dwData=0
		.iString=0
	End With
End Sub

Dim file_path As String

' ウィンドウメッセージを処理するためのコールバック関数

Function MainWndProc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As DWord
	' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。

	' イベントプロシージャの呼び出しを行います。
	MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function

'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。

Sub MainWnd_Destroy()
    'イメージリストを破棄
    ImageList_Destroy(hImageList)

	AppendMissionEditor_DestroyObjects()
	PostQuitMessage(0)
End Sub

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
    Dim ic As INITCOMMONCONTROLSEX
    Dim tbb[12] As TBBUTTON

    'コモンコントロールの初期化
    ic.dwSize=Len(ic)
    ic.dwICC=ICC_BAR_CLASSES
    InitCommonControlsEx(ic)

    'ボタン情報をセット
    SetTbButtonData(tbb[0],0,IDM_NEW,TBSTATE_ENABLED,TBSTYLE_BUTTON)
    SetTbButtonData(tbb[1],1,IDM_OPEN,TBSTATE_ENABLED,TBSTYLE_BUTTON)
    SetTbButtonData(tbb[2],2,IDM_SAVE,TBSTATE_ENABLED,TBSTYLE_BUTTON)
    SetTbButtonData(tbb[3],3,IDM_USAVE,TBSTATE_ENABLED,TBSTYLE_BUTTON)
    SetTbButtonData(tbb[4],0,0,TBSTATE_ENABLED,TBSTYLE_SEP)
    SetTbButtonData(tbb[5],4,IDM_CUT,TBSTATE_ENABLED,TBSTYLE_BUTTON)
    SetTbButtonData(tbb[6],5,IDM_COPY,TBSTATE_ENABLED,TBSTYLE_BUTTON)
    SetTbButtonData(tbb[7],6,IDM_PASTE,TBSTATE_ENABLED,TBSTYLE_BUTTON)
    SetTbButtonData(tbb[8],7,IDM_UNDO,TBSTATE_ENABLED,TBSTYLE_BUTTON)
    SetTbButtonData(tbb[9],0,0,TBSTATE_ENABLED,TBSTYLE_SEP)
    SetTbButtonData(tbb[10],8,IDM_SENDMAIL,TBSTATE_ENABLED,TBSTYLE_BUTTON)
    SetTbButtonData(tbb[11],0,0,TBSTATE_ENABLED,TBSTYLE_SEP)
    SetTbButtonData(tbb[12],9,IDM_ABOUT,TBSTATE_ENABLED,TBSTYLE_BUTTON)
    
    'ツールバーを生成
    hToolbar=CreateToolbarEx(hMainWnd, _
        WS_CHILD or WS_VISIBLE or TBSTYLE_TOOLTIPS, _
        ID_TOOLBAR, _
        10, _                        'ビットマップの個数
        GetModuleHandle(0), _
        IDB_BITMAP1, _              'ビットマップのリソースID
        tbb, _
        13, _                        'ボタンの個数
        0,0, _                      'ボタンサイズ（0指定で自動セットに）
        16,15, _                   'ビットマップサイズ
        Len(tbb[0]))

    'ウィンドウスタイルにTBSTYLE_FLATを追加
    Dim style As Long
    style=GetWindowLong(hToolbar,GWL_STYLE)
    style=style or TBSTYLE_FLAT
    SetWindowLong(hToolbar,GWL_STYLE,style)

    'イメージリストを作成（フルカラー）
    hImageList=ImageList_LoadImage(GetModuleHandle(0), _
        IDB_BITMAP2, _
        16, 0, RGB(192,192,192), _
        IMAGE_BITMAP,LR_CREATEDIBSECTION)

    'ホットイメージを設定
    SendMessage(hToolbar, TB_SETHOTIMAGELIST, 0, hImageList)

    'ステータスバーを生成
    hStatus = CreateStatusWindow( _
        WS_CHILD or WS_VISIBLE or CCS_BOTTOM or SBARS_SIZEGRIP, _
        NULL, _
        hMainWnd, _
        ID_STATUS)
End Sub

Sub MainWnd_QueryClose(ByRef cancel As Integer)
    '変更されているなら終了しない、変更されていないなら終了する。
    cancel=SendDlgItemMessage(hMainWnd,EditBox1,EM_GETMODIFY,NULL,NULL)
End Sub

Sub MainWnd_IDM_NEW_MenuClick()
    Dim hEdit As Long

    'EditBox1のハンドルを取得
    hEdit=GetDlgItem(hMainWnd, EditBox1)

    'hEditの内容を空にする
    SetWindowText(hEdit,"")
End Sub

Sub MainWnd_IDM_OPEN_MenuClick()
    Dim hEdit As Long
    Dim ofn As OPENFILENAME
    Dim hFile As Long
    Dim dwFileSize As DWord
    Dim dwAccessByte As DWord
    Dim FileName[MAX_PATH-1] As Byte
    Dim buffer As BytePtr

    'OPENFILENAME構造体の初期化
    FillMemory(VarPtr(ofn),Len(ofn),0)
    ofn.lStructSize=Len(ofn)
    ofn.hwndOwner=hMainWnd
    ofn.lpstrFilter=Ex"AppendMissionFiles\0*.apm\0すべてのファイル(*.*)\0*\0\0"
    ofn.nFilterIndex=1
    ofn.lpstrFile=FileName
    ofn.nMaxFile=MAX_PATH
    ofn.lpstrTitle="ファイルを開く"
    ofn.Flags=OFN_FILEMUSTEXIST or OFN_HIDEREADONLY or OFN_PATHMUSTEXIST
    ofn.lpstrDefExt="*"

    '「ファイルを開く」ダイアログ ボックスを表示
    If GetOpenFileName(ofn)=0 Then Exit Sub


    '-------------------
    ' ファイル オープン
    '-------------------

    hFile=CreateFile(ofn.lpstrFile, GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, _
                     ByVal 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
    If hFile=INVALID_HANDLE_VALUE Then
        MessageBox(hMainWnd,"ファイルオープンに失敗","AppendMissionEditor",MB_OK or MB_ICONEXCLAMATION)
        Exit Sub
    End If

    'ファイルサイズを取得し、バッファを確保する
    dwFileSize=GetFileSize(hFile,0)
    buffer=malloc(dwFileSize+1)

    'ファイルの内容を文字列変数bufferに読み込む
    ReadFile(hFile,buffer,dwFileSize,VarPtr(dwAccessByte),ByVal 0)
    buffer[dwAccessByte]=0

    'ファイル ハンドルを閉じる
    CloseHandle(hFile)

    '-------------------


    'EditBox1のハンドルを取得
    hEdit=GetDlgItem(hMainWnd, EditBox1)

    'hEditにバッファをセットする
    SetWindowText(hEdit,buffer)

    'バッファを解放する
    free(buffer)

    'hEditにフォーカスをセット
    SetFocus(hEdit)
End Sub

Sub MainWnd_IDM_SAVE_MenuClick()
    Dim hEdit As Long
    Dim ofn As OPENFILENAME
    Dim hFile As Long
    Dim length As DWord
    Dim dwAccessByte As DWord
    Dim FileName[MAX_PATH] As Byte
    Dim buffer As String

    'OPENFILENAME構造体の初期化
    FillMemory(VarPtr(ofn),Len(ofn),0)
    ofn.lStructSize=Len(ofn)
    ofn.hwndOwner=hMainWnd
    ofn.lpstrFilter=Ex"AppendMissionFiles\0*.apm\0すべてのファイル(*.*)\0*\0\0"
    ofn.nFilterIndex=1
    ofn.lpstrFile=FileName
    ofn.nMaxFile=MAX_PATH
    ofn.lpstrTitle="ファイルの保存"
    ofn.Flags=OFN_FILEMUSTEXIST or OFN_HIDEREADONLY or OFN_PATHMUSTEXIST
    ofn.lpstrDefExt="*"

    '「ファイルの保存」ダイアログ ボックスを表示
    If GetSaveFileName(ofn)=0 Then Exit Sub


    'EditBox1のハンドルを取得
    hEdit=GetDlgItem(hMainWnd, EditBox1)

    'テキスト データを格納するためのバッファ領域を確保
    length=GetWindowTextLength(hEdit)
    buffer=ZeroString(length+1)

    'テキスト バッファを取得
    GetWindowText(hEdit, buffer, length+1)


    '----------------
    ' ファイルへ保存
    '----------------

    hFile=CreateFile(ofn.lpstrFile, GENERIC_WRITE, 0, _
                     ByVal 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
    If hFile=INVALID_HANDLE_VALUE Then
        MessageBox(hMainWnd,"ファイルオープンに失敗","AppendMissionEditor",MB_OK or MB_ICONEXCLAMATION)
        Exit Sub
    End If

    '書き込む
    WriteFile(hFile,buffer,length,VarPtr(dwAccessByte),ByVal 0)

    'ファイル ハンドルを閉じる
    CloseHandle(hFile)
End Sub

Sub file_OverWrite()
    Dim hEdit As HWND
    Dim hFile As HFILE
    Dim pStr As BytePtr
    Dim length As DWord
    Dim dwAccessByte As DWord

    hEdit=GetDlgItem(hMainWnd,EditBox1)
    length=GetWindowTextLength(hEdit)+1
    pStr=calloc(length)
    GetWindowText(hEdit,pStr,length)

    If file_path[0]=0 Then
        '名前を付けて保存か、名前を付けて保存する関数の呼び出し
    Else
        '上書き
        hFile=CreateFile(file_path,GENERIC_WRITE,NULL,ByVal 0,
                CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL,NULL)
        If hFile<>INVALID_HANDLE_VALUE Then
            WriteFile(hFile,pStr,length-1,VarPtr(dwAccessByte),ByVal 0)
            CloseHandle(hFile)
        Else
            MessageBox(hMainWnd,"ファイルオープンに失敗",
                "AppendMissionEditor",MB_OK or MB_ICONEXCLAMATION)
        End If
    End If

    free(pStr)
End Sub 

Sub MainWnd_IDM_EXIT_MenuClick()
    SendMessage(hMainWnd,WM_CLOSE,0,0)
End Sub

Sub MainWnd_IDM_UNDO_MenuClick()
    SendMessage(GetDlgItem(hMainWnd,EditBox1), WM_UNDO, 0, 0)
End Sub

Sub MainWnd_IDM_CUT_MenuClick()
    SendMessage(GetDlgItem(hMainWnd,EditBox1), WM_CUT, 0, 0)
End Sub

Sub MainWnd_IDM_COPY_MenuClick()
    SendMessage(GetDlgItem(hMainWnd,EditBox1), WM_COPY, 0, 0)
End Sub

Sub MainWnd_IDM_PASTE_MenuClick()
    SendMessage(GetDlgItem(hMainWnd,EditBox1), WM_PASTE, 0, 0)
End Sub

Sub MainWnd_IDM_ALLSELECT_MenuClick()
    Dim hEdit As Long
    Dim length As Long

    'EditBox1のハンドルを取得
    hEdit=GetDlgItem(hMainWnd,EditBox1)

    'テキスト データの長さを取得
    length=GetWindowTextLength(hEdit)

    'すべての部分を選択する
    SendMessage(hEdit,EM_SETSEL,0,length)
End Sub

Sub MainWnd_IDM_ABOUT_MenuClick()
    MessageBox(hMainWnd,"AppendMissionEditor Ver1.00","バージョン情報",MB_OK or MB_ICONINFORMATION)
End Sub

Sub MainWnd_IDM_SENDMAIL_MenuClick()
    '「メールで送信」ダイアログボックスを開く
    DialogBox(hMainWnd,"SendMail")
End Sub

Sub MainWnd_Notify(ByRef nmHdr As NMHDR)
    Dim pToolTipText As *TOOLTIPTEXT

    If nmHdr.code=TTN_NEEDTEXT Then
        pToolTipText=VarPtr(nmHdr)
        Select Case nmHdr.idFrom
            Case IDM_NEW
                pToolTipText->lpszText="新規作成"
            Case IDM_OPEN
                pToolTipText->lpszText="開く"
            Case IDM_SAVE
                pToolTipText->lpszText="保存"
            Case IDM_EXIT
                pToolTipText->lpszText="終了"
            Case IDM_CUT
                pToolTipText->lpszText="切り取り"
            Case IDM_COPY
                pToolTipText->lpszText="コピー"
            Case IDM_PASTE
                pToolTipText->lpszText="貼り付け"
            Case IDM_UNDO
                pToolTipText->lpszText="元に戻す"
            Case IDM_SENDMAIL
                pToolTipText->lpszText="メールで送信"
            Case IDM_ABOUT
                pToolTipText->lpszText="ヘルプ"
        End Select
    End If
End Sub

Sub AddEditBoxText(ByVal hDlg As HWND,ByVal nIDDlgItem As Long,ByVal lpString As BytePtr)
Dim hEdit As HWND
    hEdit=GetDlgItem(hDlg,nIDDlgItem)
    SendMessage(hEdit,EM_SETSEL,GetWindowTextLength(hEdit),-1)
    SendMessage(hEdit,EM_REPLACESEL,TRUE,lpString As LPARAM)
    SetFocus(hEdit)
End Sub

Sub MainWnd_CommandButton1_Click()
	AddEditBoxText(hMainWnd,EditBox1,Ex"[Mission]\r\n")
	Dim hEdit As HWND
    hEdit=GetDlgItem(hMainWnd,EditBox1)
    SendMessage(hEdit,EM_SETSEL,GetWindowTextLength(hEdit),-1)
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Name=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Author=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Rank=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"PlaneSelectable=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"SubSelectable=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"DfPlane=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"DfSub=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Sky=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Map=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Reward=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Capt_Win=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Capt_Lose=r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Message=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Type=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Atlas_Sort=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Atlas_X=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Atlas_Y=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"WinAtLimit=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Limit_Comment=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"ReversePrior=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"BGM=\r\n")
End Sub

Sub MainWnd_CommandButton2_Click()
    AddEditBoxText(hMainWnd,EditBox1,Ex"[PlayerUnit]\r\n")
    Dim hEdit As HWND
    hEdit=GetDlgItem(hMainWnd,EditBox1)
    SendMessage(hEdit,EM_SETSEL,GetWindowTextLength(hEdit),-1)
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Block=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Sector=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Factor=\r\n")
End Sub


Sub MainWnd_CommandButton3_Click()
    AddEditBoxText(hMainWnd,EditBox1,Ex"[Camp1]\r\n")
    Dim hEdit As HWND
    hEdit=GetDlgItem(hMainWnd,EditBox1)
    SendMessage(hEdit,EM_SETSEL,GetWindowTextLength(hEdit),-1)
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"WinCond=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Escape=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave1_comment=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave2_comment=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave2_time=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave3_comment=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave3_time=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave4_comment=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave4_time=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave5_comment=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave5_time=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex";必要に応じてWave6以下は入力してください。\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"WinComment=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"SplashEnemyPer=SplashTargetPer=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"SplashTargetPer=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"EscFriendTargetPer=\r\n")
End Sub

Sub MainWnd_CommandButton4_Click()
    AddEditBoxText(hMainWnd,EditBox1,Ex"[Camp2]\r\n")
    Dim hEdit As HWND
    hEdit=GetDlgItem(hMainWnd,EditBox1)
    SendMessage(hEdit,EM_SETSEL,GetWindowTextLength(hEdit),-1)
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"WinCond=Escape=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Escape=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave2_comment=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave2_time=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave3_comment=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave3_time=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave4_comment=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave4_time=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave5_comment=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave5_time=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex";必要に応じてWave6以下は入力してください。\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"WinComment=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"SplashEnemyPer=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"SplashTargetPer=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"EscFriendTargetPer=\r\n")
End Sub

    'グローバル領域に整数型変数cntを宣言
Dim cnt=0 As Long

Sub MainWnd_CommandButton5_Click()
    Dim bStr[256] As Byte

    cnt=cnt+1
    '300を超えたら1に戻す
    If 300<cnt Then
        cnt=1
    End If
    lstrcpy(bStr,"[UnitSet"+Str$(cnt)+Ex"]\r\n")
    AddEditBoxText(hMainWnd,EditBox1,bStr)
    Dim hEdit As HWND
    hEdit=GetDlgItem(hMainWnd,EditBox1)
    SendMessage(hEdit,EM_SETSEL,GetWindowTextLength(hEdit),-1)
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"UnitName=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex";SetName=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Num=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"camp=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"wave=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Level=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Block=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Sector=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Factor=\r\n")
End Sub

コード: 全て選択

Sub MainWnd_Notify(ByRef nmHdr As NMHDR)
	Dim pToolTipText As *TOOLTIPTEXT

	If nmHdr.code=TTN_NEEDTEXT Then
		pToolTipText=calloc(SizeOf(TOOLTIPTEXT))
		memcpy(pToolTipText,VarPtr(nmHdr),SizeOf(TOOLTIPTEXT))
		Select Case nmHdr.idFrom
			Case IDM_NEW
				pToolTipText->lpszText="新規作成"
			Case IDM_OPEN
				pToolTipText->lpszText="開く"
			Case IDM_SAVE
				pToolTipText->lpszText="保存"
			Case IDM_EXIT
				pToolTipText->lpszText="終了"
			Case IDM_CUT
				pToolTipText->lpszText="切り取り"
			Case IDM_COPY
				pToolTipText->lpszText="コピー"
			Case IDM_PASTE
				pToolTipText->lpszText="貼り付け"
			Case IDM_UNDO
				pToolTipText->lpszText="元に戻す"
			Case IDM_SENDMAIL
				pToolTipText->lpszText="メールで送信"
			Case IDM_ABOUT
				pToolTipText->lpszText="ヘルプ"
		End Select
		memcpy(VarPtr(nmHdr),pToolTipText,SizeOf(TOOLTIPTEXT))		
		free(pToolTipText)
	End If
End Sub

コード: 全て選択

'-----------------------------------------------------------------------------
'  イベント プロシージャ
'-----------------------------------------------------------------------------
' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hMainWnd

' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。

Const ID_TOOLBAR = 70    'ツールバーのID
Dim hToolbar As DWord    'ツールバーのハンドル

Dim hImageList As DWord  'イメージリストのハンドル

Const ID_STATUS = 71  'ステータスバーのID
Dim hStatus As DWord     'ステータスバーのハンドル

Sub SetTbButtonData(ByRef ptb As TBBUTTON, iBitmap As Long, idCommand As Long, fsState As Byte, fsStyle As Byte)
    'ptb（TBBUTTON構造体）にボタン情報を格納する
    With ptb
        .iBitmap=iBitmap
        .idCommand=idCommand
        .fsState=fsState
        .fsStyle=fsStyle
        .dwData=0
        .iString=0
    End With
End Sub

Dim file_path As String

' ウィンドウメッセージを処理するためのコールバック関数

Function MainWndProc(hWnd As DWord, dwMsg As DWord, wParam As DWord, lParam As DWord) As DWord
	' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。

	' イベントプロシージャの呼び出しを行います。
	MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function

'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。

Sub MainWnd_Destroy()
    'イメージリストを破棄
    ImageList_Destroy(hImageList)

	AppendMissionEditor_DestroyObjects()
	PostQuitMessage(0)
End Sub

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
    Dim ic As INITCOMMONCONTROLSEX
    Dim tbb[12] As TBBUTTON

    'コモンコントロールの初期化
    ic.dwSize=Len(ic)
    ic.dwICC=ICC_BAR_CLASSES
    InitCommonControlsEx(ic)

    'ボタン情報をセット
    SetTbButtonData(tbb[0],0,IDM_NEW,TBSTATE_ENABLED,TBSTYLE_BUTTON)
    SetTbButtonData(tbb[1],1,IDM_OPEN,TBSTATE_ENABLED,TBSTYLE_BUTTON)
    SetTbButtonData(tbb[2],2,IDM_SAVE,TBSTATE_ENABLED,TBSTYLE_BUTTON)
    SetTbButtonData(tbb[3],3,IDM_FILEOVERWRITE,TBSTATE_ENABLED,TBSTYLE_BUTTON)
    SetTbButtonData(tbb[4],0,0,TBSTATE_ENABLED,TBSTYLE_SEP)
    SetTbButtonData(tbb[5],4,IDM_CUT,TBSTATE_ENABLED,TBSTYLE_BUTTON)
    SetTbButtonData(tbb[6],5,IDM_COPY,TBSTATE_ENABLED,TBSTYLE_BUTTON)
    SetTbButtonData(tbb[7],6,IDM_PASTE,TBSTATE_ENABLED,TBSTYLE_BUTTON)
    SetTbButtonData(tbb[8],7,IDM_UNDO,TBSTATE_ENABLED,TBSTYLE_BUTTON)
    SetTbButtonData(tbb[9],0,0,TBSTATE_ENABLED,TBSTYLE_SEP)
    SetTbButtonData(tbb[10],8,IDM_SENDMAIL,TBSTATE_ENABLED,TBSTYLE_BUTTON)
    SetTbButtonData(tbb[11],0,0,TBSTATE_ENABLED,TBSTYLE_SEP)
    SetTbButtonData(tbb[12],9,IDM_ABOUT,TBSTATE_ENABLED,TBSTYLE_BUTTON)
    
    'ツールバーを生成
    hToolbar=CreateToolbarEx(hMainWnd, _
        WS_CHILD or WS_VISIBLE or TBSTYLE_TOOLTIPS, _
        ID_TOOLBAR, _
        10, _                        'ビットマップの個数
        GetModuleHandle(0), _
        IDB_BITMAP1, _              'ビットマップのリソースID
        tbb, _
        13, _                        'ボタンの個数
        0,0, _                      'ボタンサイズ（0指定で自動セットに）
        16,15, _                    'ビットマップサイズ
        Len(tbb[0]))

    'ウィンドウスタイルにTBSTYLE_FLATを追加
    Dim style As Long
    style=GetWindowLong(hToolbar,GWL_STYLE)
    style=style or TBSTYLE_FLAT
    SetWindowLong(hToolbar,GWL_STYLE,style)

    'イメージリストを作成（フルカラー）
    hImageList=ImageList_LoadImage(GetModuleHandle(0), _
        IDB_BITMAP2, _
        16, 0, RGB(192,192,192), _
        IMAGE_BITMAP,LR_CREATEDIBSECTION)

    'ホットイメージを設定
    SendMessage(hToolbar, TB_SETHOTIMAGELIST, 0, hImageList)

End Sub

Sub file_OverWrite()
    Dim hEdit As HWND
    Dim hFile As HFILE
    Dim pStr As BytePtr
    Dim length As DWord
    Dim dwAccessByte As DWord

    hEdit=GetDlgItem(hMainWnd,EditBox1)
    length=GetWindowTextLength(hEdit)+1
    pStr=calloc(length)
    GetWindowText(hEdit,pStr,length)

    If file_path[0]=0 Then
        '名前を付けて保存か、名前を付けて保存する関数の呼び出し
    Else
        '上書き
        hFile=CreateFile(file_path,GENERIC_WRITE,NULL,ByVal 0,
                CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL,NULL)
        If hFile<>INVALID_HANDLE_VALUE Then
            WriteFile(hFile,pStr,length-1,VarPtr(dwAccessByte),ByVal 0)
            CloseHandle(hFile)
        Else
            MessageBox(hMainWnd,"ファイルオープンに失敗",
                "AppendMissionEditor",MB_OK or MB_ICONEXCLAMATION)
        End If
    End If

    free(pStr)
End Sub

'hEditはグローバル変数
Sub MainWnd_IDM_NEW_MenuClick()
	Dim hEdit As Long
    'hEditとファイルパスの初期化
    file_OverWrite()
    SetWindowText(hEdit,"")
End Sub

Sub MainWnd_IDM_OPEN_MenuClick()
    Dim hEdit As Long
    Dim ofn As OPENFILENAME
    Dim hFile As Long
    Dim dwFileSize As DWord
    Dim dwAccessByte As DWord
    Dim FileName[MAX_PATH-1] As Byte
    Dim buffer As BytePtr

    file_OverWrite()

    'OPENFILENAME構造体の初期化
    FillMemory(VarPtr(ofn),Len(ofn),0)
    ofn.lStructSize=Len(ofn)
    ofn.hwndOwner=hMainWnd
    ofn.lpstrFilter=Ex"AppendMissionFiles\0*.apm\0すべてのファイル(*.*)\0*\0\0"
    ofn.nFilterIndex=1
    ofn.lpstrFile=FileName
    ofn.nMaxFile=MAX_PATH
    ofn.lpstrTitle="ファイルを開く"
    ofn.Flags=OFN_FILEMUSTEXIST or OFN_HIDEREADONLY or OFN_PATHMUSTEXIST
    ofn.lpstrDefExt="*"

    '「ファイルを開く」ダイアログ ボックスを表示
    If GetOpenFileName(ofn)=0 Then Exit Sub


    '-------------------
    ' ファイル オープン
    '-------------------

    hFile=CreateFile(ofn.lpstrFile, GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, _
                     ByVal 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
    If hFile=INVALID_HANDLE_VALUE Then
        MessageBox(hMainWnd,"ファイルオープンに失敗","AppendMissionEditor",MB_OK or MB_ICONEXCLAMATION)
        Exit Sub
    End If

    'ファイルサイズを取得し、バッファを確保する
    dwFileSize=GetFileSize(hFile,0)
    buffer=malloc(dwFileSize+1)

    'ファイルの内容を文字列変数bufferに読み込む
    ReadFile(hFile,buffer,dwFileSize,VarPtr(dwAccessByte),ByVal 0)
    buffer[dwAccessByte]=0

    'ファイル ハンドルを閉じる
    CloseHandle(hFile)

    '-------------------


    'EditBox1のハンドルを取得
    hEdit=GetDlgItem(hMainWnd, EditBox1)

    'hEditにバッファをセットする
    SetWindowText(hEdit,buffer)

    'バッファを解放する
    free(buffer)

    'hEditにフォーカスをセット
    SetFocus(hEdit)
End Sub

Sub MainWnd_IDM_SAVE_MenuClick()
    Dim hEdit As Long
    Dim ofn As OPENFILENAME
    Dim hFile As Long
    Dim length As DWord
    Dim dwAccessByte As DWord
    Dim FileName[MAX_PATH] As Byte
    Dim buffer As String

    file_OverWrite()

    'OPENFILENAME構造体の初期化
    FillMemory(VarPtr(ofn),Len(ofn),0)
    ofn.lStructSize=Len(ofn)
    ofn.hwndOwner=hMainWnd
    ofn.lpstrFilter=Ex"AppendMissionFiles\0*.apm\0すべてのファイル(*.*)\0*\0\0"
    ofn.nFilterIndex=1
    ofn.lpstrFile=FileName
    ofn.nMaxFile=MAX_PATH
    ofn.lpstrTitle="ファイルの保存"
    ofn.Flags=OFN_FILEMUSTEXIST or OFN_HIDEREADONLY or OFN_PATHMUSTEXIST
    ofn.lpstrDefExt="*"

    '「ファイルの保存」ダイアログ ボックスを表示
    If GetSaveFileName(ofn)=0 Then Exit Sub


    'EditBox1のハンドルを取得
    hEdit=GetDlgItem(hMainWnd, EditBox1)

    'テキスト データを格納するためのバッファ領域を確保
    length=GetWindowTextLength(hEdit)
    buffer=ZeroString(length+1)

    'テキスト バッファを取得
    GetWindowText(hEdit, buffer, length+1)


    '----------------
    ' ファイルへ保存
    '----------------

    hFile=CreateFile(ofn.lpstrFile, GENERIC_WRITE, 0, _
                     ByVal 0, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)
    If hFile=INVALID_HANDLE_VALUE Then
        MessageBox(hMainWnd,"ファイルオープンに失敗","AppendMissionEditor",MB_OK or MB_ICONEXCLAMATION)
        Exit Sub
    End If

    '書き込む
    WriteFile(hFile,buffer,length,VarPtr(dwAccessByte),ByVal 0)

    'ファイル ハンドルを閉じる
    CloseHandle(hFile)
End Sub 

Sub MainWnd_IDM_FILEOVERWRITE_MenuClick()
	file_OverWrite()
End Sub

Sub MainWnd_IDM_EXIT_MenuClick()
    SendMessage(hMainWnd,WM_CLOSE,0,0)
End Sub

Sub MainWnd_IDM_UNDO_MenuClick()
    SendMessage(GetDlgItem(hMainWnd,EditBox1), WM_UNDO, 0, 0)
End Sub

Sub MainWnd_IDM_CUT_MenuClick()
    SendMessage(GetDlgItem(hMainWnd,EditBox1), WM_CUT, 0, 0)
End Sub

Sub MainWnd_IDM_COPY_MenuClick()
    SendMessage(GetDlgItem(hMainWnd,EditBox1), WM_COPY, 0, 0)
End Sub

Sub MainWnd_IDM_PASTE_MenuClick()
    SendMessage(GetDlgItem(hMainWnd,EditBox1), WM_PASTE, 0, 0)
End Sub

Sub MainWnd_IDM_ALLSELECT_MenuClick()
    Dim hEdit As Long
    Dim length As Long

    'EditBox1のハンドルを取得
    hEdit=GetDlgItem(hMainWnd,EditBox1)

    'テキスト データの長さを取得
    length=GetWindowTextLength(hEdit)

    'すべての部分を選択する
    SendMessage(hEdit,EM_SETSEL,0,length)
End Sub

Sub MainWnd_IDM_ABOUT_MenuClick()
    MessageBox(hMainWnd,"AppendMissionEditor Ver1.00","バージョン情報",LoadIcon(GetModuleHandle(0),101))
End Sub

Sub MainWnd_IDM_SENDMAIL_MenuClick()
    '「メールで送信」ダイアログボックスを開く
    DialogBox(hMainWnd,"SendMail")
End Sub

Sub MainWnd_Notify(ByRef nmHdr As NMHDR)
    Dim pToolTipText As *TOOLTIPTEXT

    If nmHdr.code=TTN_NEEDTEXT Then
        pToolTipText=calloc(SizeOf(TOOLTIPTEXT))
        memcpy(pToolTipText,VarPtr(nmHdr),SizeOf(TOOLTIPTEXT))
        Select Case nmHdr.idFrom
            Case IDM_NEW
                pToolTipText->lpszText="新規作成"
            Case IDM_OPEN
                pToolTipText->lpszText="開く"
            Case IDM_SAVE
                pToolTipText->lpszText="保存"
            Case IDM_FILEOVERWRITE
                pToolTipText->lpszText="上書き保存"
            Case IDM_EXIT
                pToolTipText->lpszText="終了"
            Case IDM_CUT
                pToolTipText->lpszText="切り取り"
            Case IDM_COPY
                pToolTipText->lpszText="コピー"
            Case IDM_PASTE
                pToolTipText->lpszText="貼り付け"
            Case IDM_UNDO
                pToolTipText->lpszText="元に戻す"
            Case IDM_SENDMAIL
                pToolTipText->lpszText="メールで送信"
            Case IDM_ABOUT
                pToolTipText->lpszText="ヘルプ"
        End Select
        memcpy(VarPtr(nmHdr),pToolTipText,SizeOf(TOOLTIPTEXT))        
        free(pToolTipText)
    End If
End Sub

Sub AddEditBoxText(ByVal hDlg As HWND,ByVal nIDDlgItem As Long,ByVal lpString As BytePtr)
Dim hEdit As HWND
    hEdit=GetDlgItem(hDlg,nIDDlgItem)
    SendMessage(hEdit,EM_SETSEL,GetWindowTextLength(hEdit),-1)
    SendMessage(hEdit,EM_REPLACESEL,TRUE,lpString As LPARAM)
    SetFocus(hEdit)
End Sub

Sub MainWnd_CommandButton1_Click()
	DialogBox(hMainWnd,"Mission")
End Sub

Sub MainWnd_CommandButton2_Click()
    AddEditBoxText(hMainWnd,EditBox1,Ex"[PlayerUnit]\r\n")
    Dim hEdit As HWND
    hEdit=GetDlgItem(hMainWnd,EditBox1)
    SendMessage(hEdit,EM_SETSEL,GetWindowTextLength(hEdit),-1)
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Block=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Sector=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Factor=\r\n")
End Sub


Sub MainWnd_CommandButton3_Click()
    AddEditBoxText(hMainWnd,EditBox1,Ex"[Camp1]\r\n")
    Dim hEdit As HWND
    hEdit=GetDlgItem(hMainWnd,EditBox1)
    SendMessage(hEdit,EM_SETSEL,GetWindowTextLength(hEdit),-1)
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"WinCond=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Escape=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave1_comment=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave2_comment=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave2_time=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave3_comment=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave3_time=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave4_comment=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave4_time=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave5_comment=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave5_time=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex";必要に応じてWave6以下は入力してください。\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"WinComment=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"SplashEnemyPer=SplashTargetPer=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"SplashTargetPer=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"EscFriendTargetPer=\r\n")
End Sub

Sub MainWnd_CommandButton4_Click()
    AddEditBoxText(hMainWnd,EditBox1,Ex"[Camp2]\r\n")
    Dim hEdit As HWND
    hEdit=GetDlgItem(hMainWnd,EditBox1)
    SendMessage(hEdit,EM_SETSEL,GetWindowTextLength(hEdit),-1)
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"WinCond=Escape=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Escape=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave2_comment=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave2_time=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave3_comment=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave3_time=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave4_comment=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave4_time=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave5_comment=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Wave5_time=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex";必要に応じてWave6以下は入力してください。\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"WinComment=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"SplashEnemyPer=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"SplashTargetPer=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"EscFriendTargetPer=\r\n")
End Sub

    'グローバル領域に整数型変数cntを宣言
Dim cnt=0 As Long

Sub MainWnd_CommandButton5_Click()
    Dim bStr[256] As Byte

    cnt=cnt+1
    '300を超えたら1に戻す
    If 300<cnt Then
        cnt=1
    End If
    lstrcpy(bStr,"[UnitSet"+Str$(cnt)+Ex"]\r\n")
    AddEditBoxText(hMainWnd,EditBox1,bStr)
    Dim hEdit As HWND
    hEdit=GetDlgItem(hMainWnd,EditBox1)
    SendMessage(hEdit,EM_SETSEL,GetWindowTextLength(hEdit),-1)
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"UnitName=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex";SetName=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Num=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"camp=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"wave=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Level=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Block=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Sector=\r\n")
    SendMessage(hEdit,EM_REPLACESEL,TRUE,Ex"Factor=\r\n")
End Sub