IPアドレスコントロール          <TOP>


ウィンドウ(コントロール)をコードで作成します。

InitCommonControlsEx 特定のコモンコントロールを作成

CreateWindowEx ウィンドウ(コントロール)を作成

GetWindowText ウィンドウのタイトル文字列を取得

SetWindowText ウィンドウのタイトルを変更

SetFocus ウィンドウにフォーカスを設定

GetClientRect ウィンドウのクライアント領域の座標を取得

 

PictureBoxをIPアドレスコントロールとして作成します。

 

PictureBoxの代わりにEditBox、TextBoxでもOKです。その場合は、

IpInp = Api_CreateWindowEx(0, WC_IPADDRESS, ByVal 0, WS_CHILD Or WS_VISIBLE Or WS_OVERLAPPED, 0, 0, rct.Right, rct.Bottom, Text1.GethWnd, 0, GethInst, ByVal 0)

のようにコントロールのハンドルを指定します。

 

'================================================================
'= IPアドレスコントロール
'=    (IpAddress4.bas)
'================================================================
#include "Windows.bi"

Type INITCOMMONCONTROLSEX
    dwSize As Long
    dwICC  As Long
End Type

Type RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type

#define WC_IPADDRESS "SysIPAddress32"   'IPアドレスコントロール
#define ICC_INTERNET_CLASSES &H800      'IPアドレスコントロール(Version 4.71 以降)
#define WS_CHILD &H40000000             '親ウィンドウを持つコントロール(子ウィンドウ)を作成する
#define WS_OVERLAPPED &H0               'オーバーラップウィンドウを作成する
#define WS_VISIBLE &H10000000           '可視状態のウィンドウを作成する
#define vbCrLf (Chr$(13) & Chr$(10))    'キャリッジリターンとラインフィード(\r\n)

' コモンコントロールのダイナミックリンクライブラリ(DLL)に含まれている、特定のコモンコントロールクラスを登録
Declare Function Api_InitCommonControlsEx& Lib "comctl32" Alias "InitCommonControlsEx" (lpInitCtrls As INITCOMMONCONTROLSEX)

' ウィンドウ(コントロール)を作成
Declare Function Api_CreateWindowEx& Lib "user32" Alias "CreateWindowExA" (ByVal ExStyle&, ByVal ClassName$, ByVal WinName$, ByVal Style&, ByVal x&, ByVal y&, ByVal nWidth&, ByVal nHeight&, ByVal Parent&, ByVal Menu&, ByVal Instance&, ByVal Param&)

' ウィンドウのタイトル文字列を取得
Declare Function Api_GetWindowText& Lib "user32" Alias "GetWindowTextA" (ByVal hWnd&, ByVal lpString$, ByVal cch&)

' ウィンドウのタイトルを変更
Declare Function Api_SetWindowText& Lib "user32" Alias "SetWindowTextA" (ByVal hWnd&, ByVal lpString$)

' ウィンドウにフォーカスを設定
Declare Function Api_SetFocus& Lib "user32" Alias "SetFocus" (ByVal hWnd&)

' ウィンドウのクライアント領域の座標を取得
Declare Function Api_GetClientRect& Lib "user32" Alias "GetClientRect" (ByVal hWnd&, lpRect As RECT)

Var Shared IpInp As Long

Var Shared Picture1 As Object
Var Shared Text1 As Object
Var Shared Button1 As Object

Picture1.Attach GetDlgItem("Picture1")
Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

'================================================================
'=
'================================================================
Declare Sub Picture1_MouseMove edecl ()
Sub Picture1_MouseMove()
    Var Ret As Long

    Ret = Api_SetFocus(IpInp)
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Var rct As RECT
    Var icc As INITCOMMONCONTROLSEX
    Var Ret As Long
    
    Ret = Api_GetClientRect(Picture1.GethWnd, rct)
    icc.dwSize = Len(icc)
    icc.dwICC = ICC_INTERNET_CLASSES
    
    Ret = Api_InitCommonControlsEx(icc)
    IpInp = Api_CreateWindowEx(0, WC_IPADDRESS, ByVal 0, WS_CHILD Or WS_VISIBLE Or WS_OVERLAPPED, 0, 0, rct.Right, rct.Bottom, Picture1.GethWnd, 0, GethInst, ByVal 0)
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var IPAddr As String * 15
    Var Ret As Long
    
    Ret = Api_GetWindowText(IpInp, IPAddr, 15)
    Text1.SetWindowText Left$(IPAddr, InStr(1, IPAddr, Chr$(0)) - 1)
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End