FreeBASIC マニュアルのトップに戻る

FreeBASIC 簡単な Windows API

目次→フォーラム→FreeBASIC→補足→Constructing a dll for Excel (tutorial for newbies like me)←オリジナル・サイト

簡単な Windows API　左にメニュー・フレームが表示されていない場合は、ここをクリックして下さい

←リンク元に戻る　プログラム開発関連に戻る
　Win32 API 日本語マニュアルは、下記でダウンロードして下さい。
Win32JP.zip

　関連で「GUI ライブラリ Window9」も参照下さい。プログラムが簡単になります。

Window
Static Box
Button
Edit Box
Track Bar
Progress Bar
Menu Bar
Editbox
Trackbar
CenteredEditbox
GetPrivateProfileSectionNames


注：MessageBox()の構文
int MessageBox(HWND hWnd , LPCTSTR lpText , LPCTSTR lpCaption , UINT uType)
hWnd - オーナーウィンドウを指定。NULLの場合はオーナーウィンドウを持ちません
lpText - メッセージボックスに表示する文字列
lpCaption - タイトルバーに表示される文字列
uType - メッセージボックスの内容

戻り値 - メッセージボックスの押されたボタンを整数値で返します


　Window

#Include "windows.bi"

Dim As MSG msg     ' メッセージ変数 (メッセージを保管)
Dim As HWND hWnd   ' Window 変数

' Create window
hWnd = CreateWindowEx( 0, "#32770", "Hello", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, 100, 100, 500, 300, 0, 0, 0, 0 )

While GetMessage( @msg, 0, 0, 0 )    ' window からメッセージを取得
  TranslateMessage( @msg )
  DispatchMessage( @msg )
  
  Select Case msg.hwnd
    Case hWnd        ' msg が window hwnd なら: window からメッセージを取得
      Select Case msg.message
        Case 273    ' 'X' が渡されるとメッセージを取得
          End
      End Select
  End Select
Wend

Static Box

#Include "windows.bi"

Dim As MSG msg          ' メッセージ変数 (メッセージを保管)
Dim As HWND hWnd, stc1  ' Window 変数 と オブジェクト変数

' Create window
hWnd = CreateWindowEx( 0, "#32770", "Hello", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, 100, 100, 500, 300, 0, 0, 0, 0 )
' Create static box
stc1 = CreateWindowEx( 0, "STATIC", "今日は、世界！", WS_VISIBLE Or WS_CHILD, 0, 0, 300, 30, hWnd, 0, 0, 0 )

While GetMessage( @msg, 0, 0, 0 )    ' window からメッセージを取得
  TranslateMessage( @msg )
  DispatchMessage( @msg )

  Select Case msg.hwnd
    Case hWnd        ' msg が window hwnd なら: window からメッセージを取得
      Select Case msg.message
        Case 273
        End
    End Select
  End Select
Wend

Button

#Include "windows.bi"

Dim As MSG msg     ' メッセージ変数 (メッセージを保管)
Dim As HWND hWnd, btn1   ' Window 変数 と オブジェクト変数

' Create window
hWnd = CreateWindowEx( 0, "#32770", "Hello", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, 100, 100, 500, 300, 0, 0, 0, 0 )
' Create button
btn1 = CreateWindowEx( 0, "BUTTON", "クリックして下さい！", WS_VISIBLE Or WS_CHILD, 0, 0, 0, 0, hWnd, 0, 0, 0 )

While GetMessage( @msg, 0, 0, 0 )    ' window からメッセージを取得
  TranslateMessage( @msg )
  DispatchMessage( @msg )
 
  Select Case msg.hwnd
    Case hWnd        ' msg が window hwnd なら: window からメッセージを取得
      Select Case msg.message
        Case 273
          End
         
        Case Else
          Dim As RECT rct: GetClientRect( hWnd, @rct )
          MoveWindow( btn1, 10, 10, rct.right-20, rct.bottom-20, TRUE )
      End Select

    Case btn1        ' msg が button hwnd なら: button からメッセージを取得
      Select Case msg.message
        Case WM_LBUTTONDOWN        ' 左ボタンが押されたら、メッセージボックスを表示
          MessageBox( hWnd, "ボタンが押されました！", "Message", MB_OK Or MB_ICONINFORMATION )
         
    End Select
  End Select
Wend

Edit Box

#Include "windows.bi"

Dim As MSG msg
Dim As HWND hWnd, btn1, edt1

' Create window
hWnd = CreateWindowEx( 0, "#32770", "Hello", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, 100, 100, 500, 300, 0, 0, 0, 0 )
' Create button
btn1 = CreateWindowEx( 0, "BUTTON", "Button #1", WS_VISIBLE Or WS_CHILD, 20, 10, 100, 30, hWnd, 0, 0, 0 )
' Create edit box
edt1 = CreateWindowEx( 0, "EDIT", "ここに文字を入力して下さい...", ws_border Or WS_VISIBLE Or WS_CHILD Or WS_HSCROLL Or WS_VSCROLL Or ES_AUTOHSCROLL Or ES_AUTOVSCROLL Or ES_MULTILINE, 20, 50, 200, 100, hWnd, 0, 0, 0 )

While GetMessage( @msg, 0, 0, 0 )
  TranslateMessage( @msg )
  DispatchMessage( @msg )
  
  Select Case msg.hwnd
    Case hWnd
      Select Case msg.message
        Case 273
          End
          
        ' If left mouse button was pressed in window area then
        ' check if is edit box text = "". If it is then set
        ' the edit box text to "Type text here" and set focus
        ' to the window
        Case WM_LBUTTONDOWN
          Dim As ZString*1024 txt
          
          GetWindowText( edt1, txt, SizeOf( txt ) )
          If txt = "" Then SetWindowText( edt1, "Type text here..." )
          
          SetFocus( hWnd )  ' Set focus to the window
          
        Case Else
          ' Create rect variable and store window size in it
          Dim As RECT rct: GetClientRect( hWnd, @rct )
          
          ' Resize the edit box
          MoveWindow( edt1, 20, 50, rct.right-40, rct.bottom-60, TRUE )
      End Select
      
    Case btn1
      Select Case msg.message
        ' If left mouse button was pressed in button area then
        ' check if is edit box text = "". If it is then set
        ' the edit box text to "Type text here"
        Case WM_LBUTTONDOWN
          ' When button is pressed set the text
          ' of button to "pressed"
          SetWindowText( btn1, "Clicked!" )
          
          Dim As ZString*1024 txt
          
          GetWindowText( edt1, txt, SizeOf( txt ) )
          If txt = "" Then SetWindowText( edt1, "Type text here..." )
          
        ' If left mouse button was released from the button area
        ' then set the button text to "Button #1" and show
        ' massage box with text from text box
        Case WM_LBUTTONUP
          SetWindowText( btn1, "Button #1" )
          
          Dim As ZString*1024 txt
          
          GetWindowText( edt1, txt, SizeOf( txt ) )
          MessageBox( hWnd, txt, "Hello", MB_OK )
      End Select
      
    Case edt1
      Select Case msg.message
        ' When textbox was pressed then clar the textbox text if
        ' text = "Type text here..."
        Case WM_LBUTTONDOWN
          Dim As ZString*1024 txt
          
          GetWindowText( edt1, txt, SizeOf( txt ) )
          If txt = "Type text here..." Then SetWindowText( edt1, "" )
      End Select
  End Select
Wend

Track Bar

#Include "windows.bi"

' To use TrackBar include commctrl.bi and use InitCommonControls()
#Include "win/commctrl.bi"
InitCommonControls( )

Dim As MSG msg
Dim As HWND hWnd, tbr1, stc1

' Create window
hWnd = CreateWindowEx( 0, "#32770", "Hello", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, 100, 100, 500, 300, 0, 0, 0, 0 )
' Create track bar
tbr1 = CreateWindowEx( 0, TRACKBAR_CLASS, "", WS_VISIBLE Or WS_CHILD Or TBS_AUTOTICKS Or TBS_ENABLESELRANGE, 20, 10, 200, 30, hWnd, 0, 0, 0 )
' Create static box
stc1 = CreateWindowEx( 0, "STATIC", "0", WS_VISIBLE Or WS_CHILD, 225, 10, 50, 30, hWnd, 0, 0, 0 )

' Set track bar maximum value to 10
SendMessage( tbr1, TBM_SETRANGEMAX, 0, 10 )

While GetMessage( @msg, 0, 0, 0 )
  TranslateMessage( @msg )
  DispatchMessage( @msg )
  
  Select Case msg.hwnd
    Case hWnd
      Select Case msg.message
        Case 273
          End
      End Select
      
    Case tbr1
      Select Case msg.message
        Case Else
          ' Get trackbar value and set that number to static box text
          SetWindowText( stc1, Str( SendMessage( tbr1, TBM_GETPOS, 0, 0 ) ) )
      End Select
  End Select
Wend

Progress Bar

#Include "windows.bi"

' To use ProgressBar include commctrl.bi and use InitCommonControls()
#Include "win/commctrl.bi"
InitCommonControls( )

' Define pbm_setbkcolor message
#Define PBM_SETBKCOLOR 8193

Dim As MSG msg
Dim As HWND hWnd, pgb1, pgb2, pgb3, pgb4, pgb5  ' Define window and progress bars

' Create Window
hWnd = CreateWindowEx( 0, "#32770", "Hello", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, 100, 100, 500, 300, 0, 0, 0, 0 )
' Create 5 progress bars
pgb1 = CreateWindowEx( 0, PROGRESS_CLASS, "", WS_VISIBLE Or WS_CHILD, 20, 20, 460, 20, hWnd, 0, 0, 0 )
pgb2 = CreateWindowEx( 0, PROGRESS_CLASS, "", WS_VISIBLE Or WS_CHILD, 20, 50, 460, 20, hWnd, 0, 0, 0 )
pgb3 = CreateWindowEx( 0, PROGRESS_CLASS, "", WS_VISIBLE Or WS_CHILD, 20, 80, 460, 20, hWnd, 0, 0, 0 )
pgb4 = CreateWindowEx( 0, PROGRESS_CLASS, "", WS_VISIBLE Or WS_CHILD, 20, 110, 460, 20, hWnd, 0, 0, 0 )
pgb5 = CreateWindowEx( 0, PROGRESS_CLASS, "", WS_VISIBLE Or WS_CHILD, 20, 140, 460, 20, hWnd, 0, 0, 0 )

' Set progressbar ranges from 1 to 10
SendMessage( pgb1, PBM_SETRANGE, 0, MAKELPARAM( 1, 10 ) )
SendMessage( pgb2, PBM_SETRANGE, 0, MAKELPARAM( 1, 10 ) )
SendMessage( pgb3, PBM_SETRANGE, 0, MAKELPARAM( 1, 10 ) )
SendMessage( pgb4, PBM_SETRANGE, 0, MAKELPARAM( 1, 10 ) )
SendMessage( pgb5, PBM_SETRANGE, 0, MAKELPARAM( 1, 10 ) )

' Set progres bar foreground color
SendMessage( pgb1, PBM_SETBARCOLOR, 0, BGR( 255, 0, 0 ) )
SendMessage( pgb2, PBM_SETBARCOLOR, 0, BGR( 255, 255, 0 ) )
SendMessage( pgb3, PBM_SETBARCOLOR, 0, BGR( 255, 0, 255 ) )
SendMessage( pgb4, PBM_SETBARCOLOR, 0, BGR( 0, 255, 0 ) )
SendMessage( pgb5, PBM_SETBARCOLOR, 0, BGR( 0, 0, 255 ) )

' Set progress bar background color
SendMessage( pgb1, PBM_SETBKCOLOR, 0, BGR( 128, 0, 0 ) )
SendMessage( pgb2, PBM_SETBKCOLOR, 0, BGR( 128, 128, 0 ) )
SendMessage( pgb3, PBM_SETBKCOLOR, 0, BGR( 128, 0, 128 ) )
SendMessage( pgb4, PBM_SETBKCOLOR, 0, BGR( 0, 128, 0 ) )
SendMessage( pgb5, PBM_SETBKCOLOR, 0, BGR( 0, 0, 128 ) )

Dim As UInteger r1, r2, r3, r4, r5  ' Define variables to store progress values
SetTimer( hWnd, 0, 1, 0 )    ' Set timer to 1 milisecond

While GetMessage( @msg, 0, 0, 0 )
  TranslateMessage( @msg )
  DispatchMessage( @msg )
  
  Select Case msg.hwnd
    Case hWnd
      Select Case msg.message
        Case 273
          End
          
        Case WM_TIMER    ' When timer was changed do some stuff
          If r1 > 10 Then r1 = 0: r2 += 1
          If r2 > 10 Then r2 = 0: r3 += 1
          If r3 > 10 Then r3 = 0: r4 += 1
          If r4 > 10 Then r4 = 0: r5 += 1
          If r5 > 10 Then r5 = 0
          
          r1 += 1
          
          ' Set progress bar values
          SendMessage( pgb1, PBM_SETPOS, r1, 0 )
          SendMessage( pgb2, PBM_SETPOS, r2, 0 )
          SendMessage( pgb3, PBM_SETPOS, r3, 0 )
          SendMessage( pgb4, PBM_SETPOS, r4, 0 )
          SendMessage( pgb5, PBM_SETPOS, r5, 0 )
      End Select
  End Select
Wend

Menu Bar

#Include "windows.bi"

Dim As MSG msg
Dim As HWND hWnd, edt1
Dim As HMENU hMenu, hMessages, hEdit  ' Menu variables

hWnd = CreateWindowEx( 0, "#32770", "Hello", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, 100, 100, 500, 300, 0, 0, 0, 0 )
edt1 = CreateWindowEx( WS_EX_CLIENTEDGE, "EDIT", "Hello", WS_VISIBLE Or WS_CHILD, 0, 0, 300, 30, hWnd, 0, 0, 0 )

' Create menus
hMenu = CreateMenu( )
hMessages = CreateMenu( )
hEdit = CreateMenu( )

' Create menus
InsertMenu( hMenu, 0, MF_POPUP, CInt( hMessages ), "&Messages" )
InsertMenu( hMenu, 0, MF_POPUP, CInt( hEdit ), "&Edit" )

' Create Messages submenus
AppendMenu( hMessages, 0, 1, "Message &Hello" )
AppendMenu( hMessages, 0, 2, "Message &Error" )
AppendMenu( hMessages, 0, 3, "Message &Information" )
AppendMenu( hMessages, 0, 4, "Message &Question" )
AppendMenu( hMessages, 0, 0, 0 )
AppendMenu( hMessages, 0, 5, "E&xit" )

' Create Edit submenus
AppendMenu( hEdit, 0, 6, "Set &Title" )

' Set hMenu to hWnd window
SetMenu( hWnd, hMenu )
' Draw menu bar
DrawMenuBar( hWnd )

While GetMessage( @msg, 0, 0, 0 )
  TranslateMessage( @msg )
  DispatchMessage( @msg )
  
  Select Case msg.hwnd
    Case hWnd
      Select Case msg.message
        Case 161
          If msg.wParam = 20 Then
            Dim As Integer res
            
            ' Confirm window close
            res = MessageBox( hWnd, "Do you realy want to quit?", "Exit", MB_YESNO Or MB_ICONQUESTION )
            If res = 6 Then End
          EndIf
          
        Case 273 ' Menu commands
          Select Case msg.wParam
            ' Messages menu
            Case 1 ' Message hello
              MessageBox( hWnd, "Hello, World!", "Hello", MB_OK )
              
            Case 2 ' Message error
              MessageBox( hWnd, "This is error message!", "Error", MB_OK Or MB_ICONERROR )
              
            Case 3 ' Message information
              MessageBox( hWnd, "This is information message!", "Information", MB_OK Or MB_ICONINFORMATION )
              
            Case 4 ' Message question
              Dim As Integer res
              
              showagain:
              res = MessageBox( hWnd, "This is question message! Show again?", "Question", MB_YESNO Or MB_ICONQUESTION )
              
              ' if result = 6 (Yes) then show again the message
              If res = 6 Then GoTo showagain
              
            Case 5 ' Exit
              Dim As Integer res
              
              ' Confirm exit
              res = MessageBox( hWnd, "Do you realy want to quit?", "Exit", MB_YESNO Or MB_ICONQUESTION )
              If res = 6 Then End
            
            ' Edit menu
            Case 6 ' Set title
              Dim As ZString*255 txt
              
              GetWindowText( edt1, @txt, SizeOf( txt ) )
              SetWindowText( hWnd, txt )
          End Select
      End Select
  End Select
Wend

Example 1: Editbox.bas

#Include "windows.bi"

Dim As MSG msg
Dim As HWND hWnd, btn1, edt1
'--------------------------------------------------------------------
Dim As hfont hfont1,hfont2
hfont1 = CreateFont(20, 10, 0, 0, _
                   FW_NORMAL, TRUE, TRUE, TRUE,_
                   ANSI_CHARSET, OUT_DEFAULT_PRECIS,_
                   CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,_
                   DEFAULT_PITCH or FF_ROMAN,_
                   "Arial")
hfont2 = CreateFont(20, 20, 0, 0, _
                   FW_NORMAL, FALSE, TRUE, FALSE,_
                   ANSI_CHARSET, OUT_DEFAULT_PRECIS,_
                   CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,_
                   DEFAULT_PITCH or FF_ROMAN,_
                   "Comic")
'--------------------------------------------------------------------
' Create window
hWnd = CreateWindowEx( 0, "#32770", "Hello", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, 100, 100, 500, 300, 0, 0, 0, 0 )
' Create button
btn1 = CreateWindowEx( 0, "BUTTON", "Button #1", WS_VISIBLE Or WS_CHILD, 20, 10, 100, 30, hWnd, 0, 0, 0 )
' Create edit box
edt1 = CreateWindowEx( 0, "EDIT", "Type text here...", ws_border Or WS_VISIBLE Or WS_CHILD Or WS_HSCROLL Or WS_VSCROLL Or ES_AUTOHSCROLL Or ES_AUTOVSCROLL Or ES_MULTILINE, 20, 50, 200, 100, hWnd, 0, 0, 0 )
'------------------------------------------------------------------------------------                                    
SendMessage(btn1, WM_SETFONT, hfont1, TRUE) ' Change font in Control using its handle and Font handle
'------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------                               
SendMessage(edt1, WM_SETFONT, hfont2, TRUE) ' Change font in Control using its handle and Font handle
'-------------------------------------------------------------------------------------
While GetMessage( @msg, 0, 0, 0 )
  TranslateMessage( @msg )
  DispatchMessage( @msg )
  
  Select Case msg.hwnd
    Case hWnd
      Select Case msg.message
        Case 273
          End
          
        ' If left mouse button was pressed in window area then
        ' check if is edit box text = "". If it is then set
        ' the edit box text to "Type text here" and set focus
        ' to the window
        Case WM_LBUTTONDOWN
          Dim As ZString*1024 txt
          
          GetWindowText( edt1, txt, SizeOf( txt ) )
          If txt = "" Then SetWindowText( edt1, "Type text here..." )
          
          SetFocus( hWnd )  ' Set focus to the window
          
        Case Else
          ' Create rect variable and store window size in it
          Dim As RECT rct: GetClientRect( hWnd, @rct )
          
          ' Resize the edit box
          MoveWindow( edt1, 20, 50, rct.right-40, rct.bottom-60, TRUE )
      End Select
      
    Case btn1
      Select Case msg.message
        ' If left mouse button was pressed in button area then
        ' check if is edit box text = "". If it is then set
        ' the edit box text to "Type text here"
        Case WM_LBUTTONDOWN
          ' When button is pressed set the text
          ' of button to "pressed"
          SetWindowText( btn1, "Clicked!" )
          
          Dim As ZString*1024 txt
          
          GetWindowText( edt1, txt, SizeOf( txt ) )
          If txt = "" Then SetWindowText( edt1, "Type text here..." )
          
        ' If left mouse button was released from the button area
        ' then set the button text to "Button #1" and show
        ' massage box with text from text box
        Case WM_LBUTTONUP
          SetWindowText( btn1, "Button #1" )
          
          Dim As ZString*1024 txt
          
          GetWindowText( edt1, txt, SizeOf( txt ) )
          MessageBox( hWnd, txt, "Hello", MB_OK )
      End Select
      
    Case edt1
      Select Case msg.message
        ' When textbox was pressed then clar the textbox text if
        ' text = "Type text here..."
        Case WM_LBUTTONDOWN
          Dim As ZString*1024 txt
          
          GetWindowText( edt1, txt, SizeOf( txt ) )
          If txt = "Type text here..." Then SetWindowText( edt1, "" )
      End Select
  End Select
Wend

Example 2: Trackbar.bas

#Include "windows.bi"

' To use TrackBar include commctrl.bi and use InitCommonControls()
#Include "win/commctrl.bi"
InitCommonControls( )

Dim As MSG msg
Dim As HWND hWnd, tbr1, stc1
'--------------------------------------------------------------
Dim hfont As hfont
hfont = CreateFont(20, 20, 0, 0, _
                   FW_NORMAL, FALSE, TRUE, FALSE,_
                   ANSI_CHARSET, OUT_DEFAULT_PRECIS,_
                   CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,_
                   DEFAULT_PITCH or FF_ROMAN,_
                   "Comic")
'--------------------------------------------------------------               
' Create window
hWnd = CreateWindowEx( 0, "#32770", "Hello", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, 100, 100, 500, 300, 0, 0, 0, 0 )
' Create track bar
tbr1 = CreateWindowEx( 0, TRACKBAR_CLASS, "", WS_VISIBLE Or WS_CHILD Or TBS_AUTOTICKS Or TBS_ENABLESELRANGE, 20, 10, 200, 30, hWnd, 0, 0, 0 )
' Create static box
stc1 = CreateWindowEx( 0, "STATIC", "0", WS_VISIBLE Or WS_CHILD, 225, 10, 50, 30, hWnd, 0, 0, 0 )
                                     ' Get Handle for a Control using its ID nr and its Parent Handle

'---------------------------------------------------------------------------  
SendMessage(stc1, WM_SETFONT, hfont, TRUE) ' Change font in Control                     using its handle and Font handle
'-----------------------------------------------------------------------------

' Set track bar maximum value to 10
SendMessage( tbr1, TBM_SETRANGEMAX, 0, 10 )

While GetMessage( @msg, 0, 0, 0 )
  TranslateMessage( @msg )
  DispatchMessage( @msg )
  
  Select Case msg.hwnd
    Case hWnd
      Select Case msg.message
        Case 273
          End
      End Select
      
    Case tbr1
      Select Case msg.message
        Case Else
          ' Get trackbar value and set that number to static box text
          SetWindowText( stc1, Str( SendMessage( tbr1, TBM_GETPOS, 0, 0 ) ) )
      End Select
  End Select
Wend

Editbox の主ウインドウを配置するには:
CreatewindowEx のパラメータ 5 (xoffset) と 6 (yoffset) を変更します。
Editbox の例での主ウインドウ(hWnd)は、これです:
hWnd = CreateWindowEx( 0, "#32770", "Hello", WS_OVERLAPPEDWINDOW Or WS_VISIBLE, 100, 100, 500, 300, 0, 0, 0, 0 )
パラメーター 7 はウィンドウの幅です。パラメーター 8 はウィンドウの高さです。
Editbox (GetSystemMetrics を備えた)の主ウインドウを中央に配置するには:

CenteredEditbox.bas

#Include "windows.bi"

Dim As MSG msg
Dim As HWND hWnd, btn1, edt1

Dim As hfont hfont1,hfont2
hfont1 = CreateFont(20, 10, 0, 0, _
                   FW_NORMAL, TRUE, TRUE, TRUE,_
                   ANSI_CHARSET, OUT_DEFAULT_PRECIS,_
                             CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,_
                             DEFAULT_PITCH or FF_ROMAN,_
                                  "Arial")
hfont2 = CreateFont(20, 20, 0, 0, _
                   FW_NORMAL, FALSE, TRUE, FALSE,_
                   ANSI_CHARSET, OUT_DEFAULT_PRECIS,_
                             CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,_
                             DEFAULT_PITCH or FF_ROMAN,_
                                  "Comic")

'--------------------------------------------------------------------
' added and/or changed code
'--------------------------------------------------------------------
Dim As Integer xres,yres
Dim As Integer w=500,h=300
xres=GetSystemMetrics (SM_CXSCREEN)
yres=GetSystemMetrics (SM_CYSCREEN)

' Create window
hWnd = CreateWindowEx( 0, "#32770", "Hello", WS_OVERLAPPEDWINDOW Or WS_VISIBLE , xres\2-w\2, yres\2-h\2, w, h, 0, 0, 0, 0 )
'--------------------------------------------------------------------
' end added and/or changed code
'-----------------------------------------------------------------------

' Create button
btn1 = CreateWindowEx( 0, "BUTTON", "Button #1", WS_VISIBLE Or WS_CHILD, 20, 10, 100, 30, hWnd, 0, 0, 0 )
' Create edit box
edt1 = CreateWindowEx( 0, "EDIT", "Type text here...", ws_border Or WS_VISIBLE Or WS_CHILD Or WS_HSCROLL Or WS_VSCROLL Or ES_AUTOHSCROLL Or ES_AUTOVSCROLL Or ES_MULTILINE, 20, 50, 200, 100, hWnd, 0, 0, 0 )

SendMessage(btn1, WM_SETFONT, hfont1, TRUE) ' Change font in Control using its handle and Font handle

SendMessage(edt1, WM_SETFONT, hfont2, TRUE) ' Change font in Control using its handle and Font handle

While GetMessage( @msg, 0, 0, 0 )
  TranslateMessage( @msg )
  DispatchMessage( @msg )
  
  Select Case msg.hwnd
    Case hWnd
      Select Case msg.message
        Case 273
          End
          
        ' If left mouse button was pressed in window area then
        ' check if is edit box text = "". If it is then set
        ' the edit box text to "Type text here" and set focus
        ' to the window
        Case WM_LBUTTONDOWN
          Dim As ZString*1024 txt
          
          GetWindowText( edt1, txt, SizeOf( txt ) )
          If txt = "" Then SetWindowText( edt1, "Type text here..." )
          
          SetFocus( hWnd )  ' Set focus to the window
          
        Case Else
          ' Create rect variable and store window size in it
          Dim As RECT rct: GetClientRect( hWnd, @rct )
          
          ' Resize the edit box
          MoveWindow( edt1, 20, 50, rct.right-40, rct.bottom-60, TRUE )
      End Select
      
    Case btn1
      Select Case msg.message
        ' If left mouse button was pressed in button area then
        ' check if is edit box text = "". If it is then set
        ' the edit box text to "Type text here"
        Case WM_LBUTTONDOWN
          ' When button is pressed set the text
          ' of button to "pressed"
          SetWindowText( btn1, "Clicked!" )
          
          Dim As ZString*1024 txt
          
          GetWindowText( edt1, txt, SizeOf( txt ) )
          If txt = "" Then SetWindowText( edt1, "Type text here..." )
          
        ' If left mouse button was released from the button area
        ' then set the button text to "Button #1" and show
        ' massage box with text from text box
        Case WM_LBUTTONUP
          SetWindowText( btn1, "Button #1" )
          
          Dim As ZString*1024 txt
          
          GetWindowText( edt1, txt, SizeOf( txt ) )
          MessageBox( hWnd, txt, "Hello", MB_OK )
      End Select
      
    Case edt1
      Select Case msg.message
        ' When textbox was pressed then clar the textbox text if
        ' text = "Type text here..."
        Case WM_LBUTTONDOWN
          Dim As ZString*1024 txt
          
          GetWindowText( edt1, txt, SizeOf( txt ) )
          If txt = "Type text here..." Then SetWindowText( edt1, "" )
      End Select
  End Select
Wend

GetPrivateProfileSectionNames を使う(getSectionNames.bas)
２ちゃんねる【QBASIC互換!?】FreeBasic【GPL】のデフォルトの名無しさんに教えていただきました。
下の「VB.ini」を、同じフォルダに登録して実行してみて下さい。
#Include Once "windows.bi"

'' 渡したファイル(.ini とか .txt)から、セクション名([]で囲まれたテキスト)を取り出し、配列に格納し、
'' そのサイズ(セクション数)を返す。
'' path: 対象とするファイルのファイルパス
'' sections: セクション名を格納する動的配列
Declare Function getSectionNames(ByRef fileName As Const String, sections() As String) As Integer


'' Main
Scope
    Dim As String path = ExePath + "/VB.ini"
    Dim As String sections(Any)

    Dim As Integer elements = getSectionNames(path, sections())

    Print "elements: "; elements

    For i As Integer = LBound(sections) To UBound(sections)
        Print sections(i)
    Next i
End Scope

Sleep
End


Const INITIAL_BUFFER_SIZE = 8
Const NULL_CHARACTER = &h00
Const BUFFER_EXPANSION_COEFFICIENT = 2

Function getSectionNames(ByRef path As Const String, sections() As String) As Integer
    Dim As String buffer     = String(INITIAL_BUFFER_SIZE, NULL_CHARACTER)
    Dim As Long   bufferSize = INITIAL_BUFFER_SIZE
    Dim As Long   dataSize

    While TRUE
        dataSize = GetPrivateProfileSectionNames(StrPtr(buffer), bufferSize, path)

        If (bufferSize - dataSize) = 2 Then
            bufferSize *= BUFFER_EXPANSION_COEFFICIENT
            buffer      = String(bufferSize, NULL_CHARACTER)
        Else
            Exit While
        EndIf
    Wend

    Dim As Integer     elements
    Dim As ZString Ptr pFirst = StrPtr(buffer)
    Dim As ZString Ptr pEnd   = pFirst + dataSize

    While pFirst < pEnd
        ReDim Preserve sections(elements)

        sections(elements) = *pFirst

        pFirst   += Len(*pFirst) + 1
        elements += 1
    Wend

    Return elements
End Function
ファイル名「VB.ini」で上のプログラムと同じフォルダに保存して下さい。
[AAA]
a=1
[BBB]
b=1
[CCC]
c=1
[セクション１]
line0=a,b,c
line1=a,bb,ccc,
line2=aa,b,c
[セクション２]
line0=x,y,z
line1=xx,y,
line2=x,y,zz
 
補足 に戻る
←リンク元に戻る　プログラム開発関連に戻る
ページ歴史:2016-09-20 20:00
ページ歴史:2010-12-18 22:10
日本語翻訳：WATANABE Makoto、原文著作者：bojan.dosen & Rens & デフォルトの名無しさん

ホームページのトップに戻る

表示-非営利-継承