Index: trunk/Include/Classes/ActiveBasic/Windows/UI/Forms/Control.ab =================================================================== --- trunk/Include/Classes/ActiveBasic/Windows/UI/Forms/Control.ab (revision 473) +++ trunk/Include/Classes/ActiveBasic/Windows/UI/Forms/Control.ab (revision 473) @@ -0,0 +1,332 @@ +'Classes/ActiveBasic/Windows/UI/Control.ab + +#require + +Namespace ActiveBasic +Namespace Windows +Namespace UI +Namespace Forms + +Class Control +Public + +'1 + + Sub Control() + End Sub + + Virtual Sub ~Control() + End Sub + + Function Handle() As WindowHandle + Handle = wnd + End Function + + Static Function FromHWnd(hwnd As HWND) As Control + FromHWnd = Nothing + If IsWindow(hwnd) Then + FromHWnd = FromHWndCore(hwnd) + End If + End Function + +Private + Static Function FromHWndCore(hwnd As HWND) As Control + If GetClassLongPtr(hwnd, GCW_ATOM) = atom Then + Dim gchValue = GetProp(hwnd, PropertyInstance As ULONG_PTR As PCTSTR) As ULONG_PTR + If gchValue <> 0 Then + Dim gch = System.Runtime.InteropServices.GCHandle.FromIntPtr(gchValue) + FromHWndCore = gch.Target As Control + Exit Function + End If + End If + End Function + +'-------------------------------- +' 1 ウィンドウ作成 +/* + Function Create( + parent As HWND, + rect As RECT, + name As String, + style As DWord, + exStyle = 0 As DWord, + menu = 0 As HMENU) As HWND +*/ +Public + Function Create() As Boolean + Dim cs As CREATESTRUCT + cs.hInstance = hInstance + cs.lpszClass = (atom As ULONG_PTR) As LPCTSTR + GetCreateStruct(cs) + Create = createImpl(cs) + End Function + +Protected + Abstract Sub GetCreateStruct(ByRef cs As CREATESTRUCT) + + Function createImpl(ByRef cs As CREATESTRUCT) As Boolean + Imports System.Runtime.InteropServices + + Dim gch = GCHandle.Alloc(This) + TlsSetValue(tlsIndex, GCHandle.ToIntPtr(gch) As VoidPtr) + + With cs + Dim hwnd = CreateWindowEx(.dwExStyle, .lpszClass, .lpszName, .style, + .x, .y, .cx, .cy, .hwndParent, .hMenu, .hInstance, .lpCreateParams) + createImpl = hwnd <> 0 + End With + End Function + +'-------------------------------- +' ウィンドウプロシージャ +'Protected +Public + Virtual Function WndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT + Select Case msg + Case WM_ERASEBKGND + Dim rc = wnd.ClientRect + Dim e = New PaintDCHandledEventArgs(wp As HDC, rc) + OnPaintBackground(e) + WndProc = e.Handled + Case WM_PAINT + Dim ps As PAINTSTRUCT + wnd.BeginPaint(ps) + Try + Dim e = New PaintDCEventArgs(ps.hdc, ps.rcPaint) + OnPaintDC(e) + Finally + wnd.EndPaint(ps) + End Try + Case WM_LBUTTONDOWN, WM_RBUTTONDOWN, WM_MBUTTONDOWN, WM_XBUTTONDOWN + OnMouseDown(New MouseEventArgs(LOWORD(wp) As MouseButtons, 1, GET_X_LPARAM(lp), GET_Y_LPARAM(lp), 0)) + Case WM_LBUTTONUP, WM_RBUTTONUP, WM_MBUTTONUP, WM_XBUTTONUP + OnMouseUp(New MouseEventArgs(LOWORD(wp) As MouseButtons, 1, GET_X_LPARAM(lp), GET_Y_LPARAM(lp), 0)) +/* + Case WM_KEYDOWN + OnKeyDown(New KeyEventArgs(makeKeysFormWPLP(wp, lp))) + Case WM_KEYUP + OnKeyUp(New KeyEventArgs(makeKeysFormWPLP(wp, lp))) + Case WM_CHAR + OnKeyPress(New KeyPressEventArgs(wParam As Char)) + Case WM_ENABLE + OnEnableChanged(EventArgs.Empty) + Case WM_MOVE + OnMove(EventArgs.Empty) + Case WM_SIZE + OnResize(EventArgs.Empty) +*/ + Case Else + WndProc = DefWndProc(msg, wp, lp) + End Select + End Function + + Virtual Function DefWndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT + DefWndProc = DefWindowProc(wnd.HWnd, msg, wp, lp) + End Function + +Private + Function makeKeysFormWPLP(wp As WPARAM, lp As LPARAM) As Keys + Dim t As DWord + t = wp And Keys.KeyCode + t Or= (GetKeyState(VK_SHIFT) As Word And &h8000) << 1 + t Or= (GetKeyState(VK_CONTROL) As Word And &h8000) << 2 + t Or= (GetKeyState(VK_MENU) As Word And &h8000) << 3 + makeKeysFormWPLP = t As Keys + End Function + + +'-------------------------------- +' ウィンドウメッセージ処理 + +'-------- +' 2 + +Protected + /*! + @biref ウィンドウの背景を描画する。 + @date 2007/12/04 + */ + Virtual Sub OnPaintBackground(e As PaintDCBackGroundEventArgs) + Dim hbr = (COLOR_3DFACE + 1) As HBRUSH + FillRect(e.Handle, e.ClipRect, hbr) + e.Handled = True + End Sub + +'-------- +'イベント +' 3 + +#include "ControlEvent.sbp" + +'-------------------------------- +' 1 インスタンスメンバ変数 +Private + wnd As WindowHandle + +'-------------------------------- +' 1 初期ウィンドウクラス +Private + Static Function WndProcFirst(hwnd As HWND, msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT + Imports System.Runtime.InteropServices + + Dim rThis = Control.FromHWndCore(hwnd) + If IsNothing(rThis) Then + Dim gchValue = TlsGetValue(tlsIndex) As LONG_PTR + TlsSetValue(tlsIndex, 0) + If gchValue = 0 Then + Goto *InstanceIsNotFound + End If + Dim gch = GCHandle.FromIntPtr(gchValue) + rThis = gch.Target As Control + ' ウィンドウが作られて最初にWndProcFirstが呼ばれたとき + + If IsNothing(rThis) Then + Goto *InstanceIsNotFound + End If + rThis.wnd = New WindowHandle(hwnd) + rThis.wnd.SetProp(PropertyInstance, gchValue As HANDLE) + End If + WndProcFirst = rThis.WndProc(msg, wp, lp) + If msg = WM_NCDESTROY Then + Dim gchValue = GetProp(hwnd, PropertyInstance As ULONG_PTR As PCTSTR) As ULONG_PTR + If gchValue <> 0 Then + Dim gch = GCHandle.FromIntPtr(gchValue) + gch.Free() + End If + End If + + Exit Function + + *InstanceIsNotFound + OutputDebugString("ActiveBasic.Windows.UI.Control.WndProcFirst: The attached instance is not found.") + WndProcFirst = DefWindowProc(hwnd, msg, wp, lp) + End Function + +' Static Const WM_CONTROL_INVOKE = WM_USER + 0 As DWord +' Static Const WM_CONTROL_BEGININVOKE = WM_USER + 1 As DWord + +'-------------------------------- +' 1 初期化終了関連（特にウィンドウクラス） + + 'ウィンドウ作成時にウィンドウプロシージャへThisを伝えるためのもの + Static tlsIndex As DWord + + Static hInstance As HINSTANCE + Static atom As ATOM + + Static Const WindowClassName = "ActiveBasic.Windows.UI.Control" + Static Const PropertyInstance = 0 As ATOM +Public + Static Sub Initialize(hinst As HINSTANCE) + tlsIndex = TlsAlloc() + hInstance = hinst + + Dim PropertyInstanceString = WindowClassName + " " + Hex$(GetCurrentProcessId()) + PropertyInstance = GlobalAddAtom(ToTCStr(PropertyInstanceString)) + + Dim wcx As WNDCLASSEX + With wcx + .cbSize = Len (wcx) + .style = CS_HREDRAW Or CS_VREDRAW Or CS_DBLCLKS + .lpfnWndProc = AddressOf (WndProcFirst) + .cbClsExtra = 0 + .cbWndExtra = 0 + .hInstance = hinst + .hIcon = 0 + .hCursor = LoadImage(0, MAKEINTRESOURCE(IDC_ARROW), IMAGE_CURSOR, 0, 0, LR_DEFAULTSIZE Or LR_SHARED) As HCURSOR + .hbrBackground = 0 + .lpszMenuName = 0 + .lpszClassName = ToTCStr(WindowClassName) + .hIconSm = 0 + End With + atom = RegisterClassEx(wcx) + If atom = 0 Then + Dim buf[1023] As TCHAR + wsprintf(buf, Ex"ActiveBasic.Windows.UI.Control.Control: RegisterClasseEx failed. Error code: &h%08X\r\n", GetLastError()) + OutputDebugString(buf) + Debug + ExitThread(0) + End If + End Sub + + Static Sub Uninitialize() + UnregisterClass(atom As ULONG_PTR As PCSTR, hInstance) + TlsFree(tlsIndex) + GlobalDeleteAtom(PropertyInstance) + End Sub +End Class + +Namespace Detail +Class _System_ControlIinitializer +Public + Sub _System_ControlIinitializer(hinst As HINSTANCE) + Control.Initialize(hinst) + End Sub + + Sub ~_System_ControlIinitializer() + Control.Uninitialize() + End Sub +End Class + +#ifndef _SYSTEM_NO_INITIALIZE_CONTROL_ +Dim _System_ControlInitializer As _System_ControlIinitializer(GetModuleHandle(0)) +#endif '_SYSTEM_NO_INITIALIZE_CONTROL_ + +End Namespace 'Detail + +Class Form + Inherits Control +Protected + Override Sub GetCreateStruct(ByRef cs As CREATESTRUCT) + With cs + .lpCreateParams = 0 + '.hInstance + .hMenu = 0 + .hwndParent = 0 + .cy = CW_USEDEFAULT + .cx = CW_USEDEFAULT + .y = CW_USEDEFAULT + .x = CW_USEDEFAULT + .style = WS_OVERLAPPEDWINDOW + .lpszName = "" + '.lpszClass + .dwExStyle = 0 + End With + End Sub +Public '仮 + Override Function WndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT + WndProc = 0 + Select Case msg + Case WM_DESTROY + PostQuitMessage(0) + Case Else + WndProc = Super.WndProc(msg, wp, lp) + End Select + End Function +End Class + +End Namespace 'Forms +End Namespace 'UI +End Namespace 'Widnows +End Namespace 'ActiveBasic + +'---------- +'テスト実行用 + +Imports ActiveBasic.Windows.UI.Forms + +Class Bar +Public +Static Sub PaintDCEvent(sender As Object, et As PaintDCEventArgs) + Dim e = et As PaintDCEventArgs + TextOut(e.Handle, 10, 10, "Hello, world", 12) +End Sub +End Class + +Dim f = New Form +f.Create() +Dim v = New PaintDCEventHandler(AddressOf (Bar.PaintDCEvent)) +f.AddPaintDC(v) +f.Handle.Show(SW_SHOW) + +MessageBox(0, "hello", "", 0) Index: trunk/Include/Classes/ActiveBasic/Windows/UI/Forms/ControlEvent.sbp =================================================================== --- trunk/Include/Classes/ActiveBasic/Windows/UI/Forms/ControlEvent.sbp (revision 473) +++ trunk/Include/Classes/ActiveBasic/Windows/UI/Forms/ControlEvent.sbp (revision 473) @@ -0,0 +1,150 @@ +Public + /*! + @brief PaintDCイベントハンドラを追加する + */ + Sub AddPaintDC(h As PaintDCEventHandler) + If IsNothing(paintDC) Then + paintDC = New PaintDCEventHandler + End If + paintDC += h + End Sub + /*! + @brief PaintDCイベントハンドラを削除する + */ + Sub RemovePaintDC(h As PaintDCEventHandler) + If Not IsNothing(paintDC) Then + paintDC -= h + End If + End Sub +Protected + /*! + @brief ウィンドウの描画が必要なときに呼び出されます。 + */ + Virtual Sub OnPaintDC(e As PaintDCEventArgs) + If Not IsNothing(paintDC) Then + paintDC(This, e) + End If + End Sub +Private + paintDC As PaintDCEventHandler + +Public + /*! + @brief Clickイベントハンドラを追加する + */ + Sub AddClick(h As EventHandler) + If IsNothing(click) Then + click = New EventHandler + End If + click += h + End Sub + /*! + @brief Clickイベントハンドラを削除する + */ + Sub RemoveClick(h As EventHandler) + If Not IsNothing(click) Then + click -= h + End If + End Sub +Protected + /*! + @brief クリックされたときに呼び出されます。 + */ + Virtual Sub OnClick(e As EventArgs) + If Not IsNothing(click) Then + click(This, e) + End If + End Sub +Private + click As EventHandler + +Public + /*! + @brief DoubleClickイベントハンドラを追加する + */ + Sub AddDoubleClick(h As EventHandler) + If IsNothing(doubleClick) Then + doubleClick = New EventHandler + End If + doubleClick += h + End Sub + /*! + @brief DoubleClickイベントハンドラを削除する + */ + Sub RemoveDoubleClick(h As EventHandler) + If Not IsNothing(doubleClick) Then + doubleClick -= h + End If + End Sub +Protected + /*! + @brief ダブルクリックされたときに呼び出されます。 + */ + Virtual Sub OnDoubleClick(e As EventArgs) + If Not IsNothing(doubleClick) Then + doubleClick(This, e) + End If + End Sub +Private + doubleClick As EventHandler + +Public + /*! + @brief MouseDownイベントハンドラを追加する + */ + Sub AddMouseDown(h As MouseEventHandler) + If IsNothing(mouseDown) Then + mouseDown = New MouseEventHandler + End If + mouseDown += h + End Sub + /*! + @brief MouseDownイベントハンドラを削除する + */ + Sub RemoveMouseDown(h As MouseEventHandler) + If Not IsNothing(mouseDown) Then + mouseDown -= h + End If + End Sub +Protected + /*! + @brief マウスボタンが押されたときに呼び出されます。 + */ + Virtual Sub OnMouseDown(e As MouseEventArgs) + If Not IsNothing(mouseDown) Then + mouseDown(This, e) + End If + End Sub +Private + mouseDown As MouseEventHandler + +Public + /*! + @brief MouseUpイベントハンドラを追加する + */ + Sub AddMouseUp(h As MouseEventHandler) + If IsNothing(mouseUp) Then + mouseUp = New MouseEventHandler + End If + mouseUp += h + End Sub + /*! + @brief MouseUpイベントハンドラを削除する + */ + Sub RemoveMouseUp(h As MouseEventHandler) + If Not IsNothing(mouseUp) Then + mouseUp -= h + End If + End Sub +Protected + /*! + @brief マウスボタンが離されたときに呼び出されます。 + */ + Virtual Sub OnMouseUp(e As MouseEventArgs) + If Not IsNothing(mouseUp) Then + mouseUp(This, e) + End If + End Sub +Private + mouseUp As MouseEventHandler + Index: trunk/Include/Classes/ActiveBasic/Windows/UI/Forms/ControlEventList.txt =================================================================== --- trunk/Include/Classes/ActiveBasic/Windows/UI/Forms/ControlEventList.txt (revision 473) +++ trunk/Include/Classes/ActiveBasic/Windows/UI/Forms/ControlEventList.txt (revision 473) @@ -0,0 +1,21 @@ +PaintDC PaintDCEvent ウィンドウの描画が必要なときに呼び出されます。 +Click Event クリックされたときに呼び出されます。 +DoubleClick Event ダブルクリックされたときに呼び出されます。 +'EnableChanged Event 有効状態が変化したときに呼び出されます。 +'Move Event ウィンドウが移動したときに呼び出されます。 +'Resize Event ウィンドウの大きさが変化したときに呼び出されます。 +'VisibleChanged Event ウィンドウの表示状態が変化したときに呼び出されます。 +'GotFocus Event フォーカスを得たときに呼び出されます。 +'LostFocus Event フォーカスを失ったときに呼び出されます。 +'MouseEnter MouseEvent マウスカーソルがコントロールに入ってくると呼び出されます。 +'MouseMove MouseEvent マウスカーソルがコントロール上で移動すると呼び出されます +'MouseHover MouseEvent マウスカーソルがコントロール上で静止すると呼び出されます。 +'MouseLeave MouseEvent マウスカーソルがコントロールから出て行くと呼び出されます。 +MouseDown MouseEvent マウスボタンが押されたときに呼び出されます。 +'MouseClick MouseEvent マウスでクリックされたときに呼び出されます。 +'MouseDoubleClick MouseEvent マウスでダブルクリックされたときに呼び出されます。 +MouseUp MouseEvent マウスボタンが離されたときに呼び出されます。 +'MouseWheel MouseEvent マウスホイールが回されたときに呼び出されます。 +'KeyDown KeyEvent キーが押されたときに呼ばれます。 +'KeyUp KeyEvent キーが離されたときに呼ばれます。 +'KeyPress KeyPressEvent キーが押されて文字が打たれたときに呼ばれます。 Index: trunk/Include/Classes/ActiveBasic/Windows/UI/Forms/EventArgs.ab =================================================================== --- trunk/Include/Classes/ActiveBasic/Windows/UI/Forms/EventArgs.ab (revision 473) +++ trunk/Include/Classes/ActiveBasic/Windows/UI/Forms/EventArgs.ab (revision 473) @@ -0,0 +1,387 @@ +/** +@file Include/Classes/ActiveBasic/Windows/UI/EventArgs.ab +@brief イベントハンドラ関連 +*/ + +Namespace ActiveBasic +Namespace Windows +Namespace UI +Namespace Forms + +TypeDef EventArgs = System.EventArgs +TypeDef EventHandler = System.EventHandler + +Class PaintDCEventArgs + Inherits EventArgs +Public + Sub PaintDCEventArgs(hdcTarget As HDC, ByRef rect As RECT) + hdc = hdcTarget + rc = rect + End Sub + + Function Handle() As HDC + Handle = hdc + End Function + + Function ClipRect() As RECT + ClipRect = rc + End Function + +Private + hdc As HDC + rc As RECT +End Class + +Delegate Sub PaintDCEventHandler(sender As Object, e As PaintDCEventArgs) + +Class PaintDCHandledEventArgs + Inherits PaintDCEventArgs +Public + Sub PaintDCHandledEventArgs(hdcTarget As HDC, ByRef rect As RECT) + PaintDCEventArgs(hdcTarget, rect) + End Sub + + Function Handled() As Boolean + Handled = h + End Function + + Sub Handled(handled As Boolean) + h = handled + End Sub + +Private + h As Boolean +End Class + +TypeDef PaintDCBackGroundEventArgs = PaintDCHandledEventArgs + +Enum MouseButtons + None = 0 + Left = MK_LBUTTON + Right = MK_RBUTTON + Middle = MK_MBUTTON + XButton1 = MK_XBUTTON1 + XButton2 = MK_XBUTTON2 +End Enum + +Class MouseEventArgs + Inherits EventArgs +Public + Sub MouseEventArgs(button As MouseButtons, clicks As Long, x As Long, y As Long, delta As Long) + This.button = button + This.clicks = clicks + This.pt = New System.Drawing.Point(x, y) + This.delta = delta + End Sub + + Const Function Button() As MouseButtons + Button = button + End Function + + Const Function Clicks() As Long + Clicks = clicks + End Function + + Const Function Delta() As Long + Delta = delta + End Function + + Const Function Locale() As System.Drawing.Point + Locale = New System.Drawing.Point(pt.X, pt.Y) + End Function + + Const Function X() As Long + X = pt.X + End Function + + Const Function Y() As Long + Y = pt.Y + End Function + +Private + pt As System.Drawing.Point + button As MouseButtons + clicks As Long + delta As Long +End Class + +Delegate Sub MouseEventHandler(sender As Object, e As MouseEventArgs) + +Class KeyPressEventArgs + Inherits EventArgs +Public + Sub KeyPressEventArgs(keyChar As Char) + key = keyChar + End Sub + + Sub KeyChar(keyChar As Char) + key = keyChar + End Sub + + Const Function KeyChar() As Char + KeyChar = key + End Function + + Sub Handled(handled As Boolean) + h = handled + End Sub + + Const Function Handled() As Boolean + Handled = h + End Function +Private + key As Char + h As Boolean +End Class + +Delegate Sub KeyPressEventHandler(sender As Object, e As KeyPressEventArgs) + +Enum Keys + None = 0 + LButton = VK_LBUTTON + RButton = VK_RBUTTON + Cancel = VK_CANCEL + MButton = VK_MBUTTON + XButton1 = VK_XBUTTON1 + XButton2 = VK_XBUTTON2 + Back = VK_BACK + Tab = VK_TAB + LineFeed = &ha + Clear = VK_CLEAR + Enter = VK_RETURN + Return_ = VK_RETURN + ShiftKey = VK_SHIFT + ControlKey = VK_CONTROL + Menu = VK_MENU + Pause = VK_PAUSE + Capital = VK_CAPITAL + KanaMode = VK_KANA + HangulMode = VK_HANGUL + JunjaMode = VK_JUNJA + FinalMode = VK_FINAL + KanjiMode = VK_KANJI + HanjaMode = VK_HANJA + Escape = VK_ESCAPE + IMEConvert = VK_CONVERT + IMENonconvert = VK_NONCONVERT + IMEAccept = VK_ACCEPT + IMEModeChange = VK_MODECHANGE + Space = VK_SPACE + Prior = VK_PRIOR + PageUp = VK_PRIOR + PageDown = VK_NEXT + Next_ = VK_NEXT + End_ = VK_END + Home = VK_HOME + Left = VK_LEFT + Up = VK_UP + Right = VK_RIGHT + Down = VK_DOWN + Select_ = VK_SELECT + Print = VK_PRINT + Execute = VK_EXECUTE + Snapshot = VK_SNAPSHOT + Insert = VK_INSERT + Delete_ = VK_DELETE + Help = VK_HELP + D0 = &h30 + D1 = &h31 + D2 = &h32 + D3 = &h33 + D4 = &h34 + D5 = &h35 + D6 = &h36 + D7 = &h37 + D8 = &h38 + D9 = &h39 + A = &h41 + B = &h42 + C = &h43 + D = &h44 + E = &h45 + F = &h46 + G = &h47 + H = &h48 + I = &h49 + J = &h4a + K = &h4b + L = &h4c + M = &h4d + N = &h4e + O = &h4f + P = &h50 + Q = &h51 + R = &h52 + S = &h53 + T = &h54 + U = &h55 + V = &h56 + W = &h57 + X = &h58 + Y = &h59 + Z = &h5A + LWin = VK_LWIN + RWin = VK_RWIN + Apps = VK_APPS + Sleep = VK_SLEEP + NumPad0 = VK_NUMPAD0 + NumPad1 = VK_NUMPAD1 + NumPad2 = VK_NUMPAD2 + NumPad3 = VK_NUMPAD3 + NumPad4 = VK_NUMPAD4 + NumPad5 = VK_NUMPAD5 + NumPad6 = VK_NUMPAD6 + NumPad7 = VK_NUMPAD7 + NumPad8 = VK_NUMPAD8 + NumPad9 = VK_NUMPAD9 + Multiply = VK_MULTIPLY + Add = VK_ADD + Separator = VK_SEPARATOR + Substract = VK_SUBTRACT + Decimal = VK_DECIMAL + Divide = VK_DIVIDE + F1 = VK_F1 + F2 = VK_F2 + F3 = VK_F3 + F4 = VK_F4 + F5 = VK_F5 + F6 = VK_F6 + F7 = VK_F7 + F8 = VK_F8 + F9 = VK_F9 + F10 = VK_F10 + F11 = VK_F11 + F12 = VK_F12 + F13 = VK_F13 + F14 = VK_F14 + F15 = VK_F15 + F16 = VK_F16 + F17 = VK_F17 + F18 = VK_F18 + F19 = VK_F19 + F20 = VK_F20 + F21 = VK_F21 + F22 = VK_F22 + F23 = VK_F23 + F24 = VK_F24 + NumLock = VK_NUMLOCK + Scroll = VK_SCROLL + LShiftKey = VK_LSHIFT + RShiftKey = VK_RSHIFT + LControlKey = VK_LCONTROL + RControlKey = VK_RCONTROL + LMenu = VK_LMENU + RMenu = VK_RMENU + BrowserBack = VK_BROWSER_BACK + BrowserForward = VK_BROWSER_FORWARD + BrowserRefresh = VK_BROWSER_REFRESH + BrowserStop = VK_BROWSER_STOP + BrowserSearch = VK_BROWSER_SEARCH + BrowserFavorites = VK_BROWSER_FAVORITES + BrowserHome = VK_BROWSER_HOME + VolumeMute = VK_VOLUME_MUTE + VolumeDown = VK_VOLUME_DOWN + VolumeUp = VK_VOLUME_UP + MediaNextTrack = VK_MEDIA_NEXT_TRACK + MediaPreviousTrack = VK_MEDIA_PREV_TRACK + MediaStop = VK_MEDIA_STOP + MediaPlayPause = VK_MEDIA_PLAY_PAUSE + LaunchMail = VK_LAUNCH_MAIL + SelectMedia = VK_LAUNCH_MEDIA_SELECT + LaunchApplication1 = VK_LAUNCH_APP1 + LaunchApplication2 = VK_LAUNCH_APP2 + Oem1 = VK_OEM_1 + Oemplus = VK_OEM_PLUS + Oemcomma = VK_OEM_COMMA + OemMinus = VK_OEM_MINUS + OemPeriod = VK_OEM_PERIOD + Oem2 = VK_OEM_2 + OemQuestion = VK_OEM_2 + Oem3 = VK_OEM_3 + Oemtilde = VK_OEM_3 + Oem4 = VK_OEM_4 + OemOpenBrackets = VK_OEM_4 + Oem5 = VK_OEM_5 + OemPipe = VK_OEM_5 + Oem6 = VK_OEM_6 + OemCloseBrackets = VK_OEM_6 + Oem7 = VK_OEM_7 + OemQuotes = VK_OEM_7 + Oem8 = VK_OEM_8 + Oem102 = VK_OEM_102 + OemBackslash = VK_OEM_102 + ProcessKey = VK_PROCESSKEY + Packet = VK_PACKET + Attn = VK_ATTN + Crsel = VK_CRSEL + Exsel = VK_EXSEL + EraseEof = VK_EREOF + Play = VK_PLAY + NoName = VK_NONAME + Zoom = VK_ZOOM + Pa1 = VK_PA1 + OemClear = VK_OEM_CLEAR + + KeyCode = &hffff + + Shift = &h10000 + Control = &h20000 + Alt = &h40000 + + Modifiers = &hffff +End Enum + +Class KeyEventArgs + Inherits EventArgs +Public + Sub KeyEventArgs(keyData As Keys) + key = keyData + End Sub + + Function Alt() As Boolean + Alt = key And Keys.Menu + End Function + + Function Control() As Boolean + Control = key And Keys.Control + End Function + + Function Shift() As Boolean + Shift = key And Keys.Shift + End Function + + Function KeyCode() As Keys + KeyCode = key And Keys.KeyCode + End Function + + Function KeyData() As Keys + KeyData = key + End Function + + Function Modifiers() As Keys + Modifiers = key And Keys.Modifiers + End Function + + Function KeyValue() As Long + KeyValue = key As Long + End Function + + Sub Handled(handled As Boolean) + h = handled + End Sub + + Function Handled() As Boolean + Handled = h + End Function + +Private + key As Keys + h As Boolean +End Class + +Delegate Sub KeyEventHandler(sender As Object, e As KeyEventArgs) + +End Namespace 'Forms +End Namespace 'UI +End Namespace 'Widnows +End Namespace 'ActiveBasic Index: trunk/Include/Classes/ActiveBasic/Windows/UI/Forms/MakeControlEventHandler.ab =================================================================== --- trunk/Include/Classes/ActiveBasic/Windows/UI/Forms/MakeControlEventHandler.ab (revision 473) +++ trunk/Include/Classes/ActiveBasic/Windows/UI/Forms/MakeControlEventHandler.ab (revision 473) @@ -0,0 +1,79 @@ +/* +注意：インクルードファイルではありません。 +イベント処理の実装コード生成プログラム。 +*/ + +Imports System +Imports System.IO +Imports System.Text +Imports ActiveBasic +Imports ActiveBasic.CType + +Function EventNameToMemberVariableName(eventName As String) As String + '先頭1字を小文字化 + Dim t = New StringBuilder(eventName) + t[0] = ToLower(t[0]) + Return t.ToString +End Function + +Sub OutputEventHandlerCode(out As TextWriter, eventName As String, argBase As String, comment As String) + Dim eventMember = EventNameToMemberVariableName(eventName) + Dim handlerType = argBase & "Handler" + Dim argsType = argBase & "Args" + out.WriteLine("Public") + out.WriteLine(Ex"\t/*!") + out.WriteLine(Ex"\t@brief " & eventName & "イベントハンドラを追加する") + out.WriteLine(Ex"\t*/") + out.WriteLine(Ex"\tSub Add" & eventName & "(h As " & handlerType & ")") + out.WriteLine(Ex"\t\tIf IsNothing(" & eventMember & ") Then") + out.WriteLine(Ex"\t\t\t" & eventMember & " = New " & handlerType) + out.WriteLine(Ex"\t\tEnd If") + out.WriteLine(Ex"\t\t" & eventMember & " += h") + out.WriteLine(Ex"\tEnd Sub") + out.WriteLine(Ex"\t/*!") + out.WriteLine(Ex"\t@brief " & eventName & "イベントハンドラを削除する") + out.WriteLine(Ex"\t*/") + out.WriteLine(Ex"\tSub Remove" & eventName & "(h As " & handlerType & ")") + out.WriteLine(Ex"\t\tIf Not IsNothing(" & eventMember & ") Then") + out.WriteLine(Ex"\t\t\t" & eventMember & " -= h") + out.WriteLine(Ex"\t\tEnd If") + out.WriteLine(Ex"\tEnd Sub") + out.WriteLine("Protected") + out.WriteLine(Ex"\t/*!") + out.WriteLine(Ex"\t@brief " & comment) + out.WriteLine(Ex"\t*/") + out.WriteLine(Ex"\tVirtual Sub On" & eventName & "(e As " & argsType & ")") + out.WriteLine(Ex"\t\tIf Not IsNothing(" & eventMember & ") Then") + out.WriteLine(Ex"\t\t\t" & eventMember & "(This, e)") + out.WriteLine(Ex"\t\tEnd If") + out.WriteLine(Ex"\tEnd Sub") + out.WriteLine("Private") + out.WriteLine(Ex"\t" & eventMember & " As " & handlerType) + out.WriteLine() +End Sub + +'OutputEventHandlerCode("PaintDC", "PaintDCEventHandler", +' "ウィンドウの描画が必要なときに呼び出されます。") + +Sub MakeControlEvent(t As String) + Dim event As String, handler As String, comment As String + Dim n As DWord, i As DWord + /*Using*/ Dim in = New StreamReader(t + "EventList.txt") + /*Using*/ Dim out = New StreamWriter(t + "Event.sbp") + Do + Dim s = in.ReadLine + If IsNothing(s) Then + Exit Do + End If + If s[0] = Asc("'") Then Continue + Dim a = ActiveBasic.Strings.Detail.Split(s, 9) 'Tab + If a.Count >= 3 Then + OutputEventHandlerCode(out, a[0], a[1], a[2]) + End If + Loop + in.Close() 'End Using + out.Close() 'End Using +End Sub + +MakeControlEvent("Control") +End Index: trunk/Include/Classes/ActiveBasic/Windows/WindowHandle.sbp =================================================================== --- trunk/Include/Classes/ActiveBasic/Windows/WindowHandle.sbp (revision 439) +++ trunk/Include/Classes/ActiveBasic/Windows/WindowHandle.sbp (revision 473) @@ -586,7 +586,5 @@ Const Function ClientRect() As RECT - Dim rc As RECT - _System_GetClientRect(hwnd, rc) - Return rc + _System_GetClientRect(hwnd, ClientRect) End Function #ifdef _UNDEF @@ -603,7 +601,5 @@ #endif Const Function WindowRect() As RECT - Dim rc As RECT - _System_GetWindowRect(hwnd, rc) - Return rc + _System_GetWindowRect(hwnd, WindowRect) End Function