Index: trunk/Include/Classes/System/Windows/Forms/Application.ab =================================================================== --- trunk/Include/Classes/System/Windows/Forms/Application.ab (revision 381) +++ trunk/Include/Classes/System/Windows/Forms/Application.ab (revision 388) @@ -27,6 +27,9 @@ Return System.IO.Path.GetDirectoryName( ExecutablePath ) End Function + + Static Sub ExitThread() + PostQuitMessage(0) + End Sub End Class - End Namespace Index: trunk/Include/Classes/System/Windows/Forms/Control.ab =================================================================== --- trunk/Include/Classes/System/Windows/Forms/Control.ab (revision 381) +++ trunk/Include/Classes/System/Windows/Forms/Control.ab (revision 388) @@ -4,4 +4,5 @@ #define __SYSTEM_WINDOWS_FORMS_CONTROL_AB__ +/* #require #require @@ -11,12 +12,14 @@ #require #require +*/ #require #require #require #require +/* #require #require #require - +*/ Namespace System Namespace Windows @@ -143,21 +146,21 @@ End If End Function - +/* BoundsSpecifiedが使用不能なのでコメントアウト Sub Bounds(r As Rectangle) SetBoundsCore(r.X, r.Y, r.Width, r.Height, BoundsSpecified.All) End Sub - +*/ Const Function Location() As Point Return Bounds.Location End Function - +/* Sub Location(p As Point) SetBoundsCore(p.X, p.Y, 0, 0, BoundsSpecified.Location) End Sub - +*/ Const Function Size() As Size Return Bounds.Size End Function - +/* Sub Size(s As Size) SetBoundsCore(0, 0, s.Width, s.Height, BoundsSpecified.Size) @@ -171,41 +174,41 @@ Return ClientRectangle.Size End Function - +*/ Const Function Left() As Long Dim b = Bounds Return b.Left End Function - +/* Sub Left(l As Long) SetBoundsCore(l, 0, 0, 0, BoundsSpecified.X) End Sub - +*/ Const Function Top() As Long Dim b = Bounds Return b.Top End Function - +/* Sub Top(t As Long) SetBoundsCore(0, t, 0, 0, BoundsSpecified.Y) End Sub - +*/ Const Function Width() As Long Dim b = Bounds Return b.Width End Function - +/* Sub Width(w As Long) SetBoundsCore(0, 0, w, 0, BoundsSpecified.Width) End Sub - +*/ Const Function Height() As Long Dim b = Bounds Return b.Height End Function - +/* Sub Height(h As Long) SetBoundsCore(0, 0, 0, h, BoundsSpecified.Height) End Sub - +*/ Const Function Right() As Long Dim b = Bounds @@ -273,32 +276,37 @@ Sub Control() - Debug Dim sz = DefaultSize() - Control("", 100, 100, sz.Width, sz.Height) + init(Nothing, "", 100, 100, sz.Width, sz.Height) End Sub Sub Control(text As String) Dim sz = DefaultSize() - Control(text, 100, 100, sz.Width, sz.Height) + init(Nothing, text, 100, 100, sz.Width, sz.Height) End Sub Sub Control(parent As Control, text As String) Dim sz = DefaultSize() - Control(parent, text, 100, 100, sz.Width, sz.Height) + init(parent, text, 100, 100, sz.Width, sz.Height) End Sub Sub Control(text As String, left As Long, top As Long, width As Long, height As Long) - This.text = text - bkColor = DefaultBackColor + init(Nothing, text, left, top, width, height) End Sub Sub Control(parent As Control, text As String, left As Long, top As Long, width As Long, height As Long) + init(parent, text, left, top, width, height) + End Sub + +Private + + Sub init(parent As Control, text As String, left As Long, top As Long, width As Long, height As Long) This.parent = parent - Control(text, left, top, width, height) - End Sub +' CreateControl() + End Sub + '--------------------------------------------------------------------------- ' Destractor - +Public Virtual Sub ~Control() If Not Object.ReferenceEquals(wnd, Nothing) Then @@ -398,6 +406,5 @@ Virtual Function DefaultSize() As Size - Dim s As Size(300, 300) - Return s + Return New Size(300, 300) End Function @@ -411,12 +418,15 @@ ' Protected Methods Virtual Sub CreateHandle() + Debug + If Not Object.ReferenceEquals(wnd, Nothing) Then + If wnd.HWnd <> 0 Then + Exit Sub + End If + End If + Dim createParams = CreateParams() Dim gch = System.Runtime.InteropServices.GCHandle.Alloc(This) TlsSetValue(tlsIndex, System.Runtime.InteropServices.GCHandle.ToIntPtr(gch) As VoidPtr) With createParams - Dim hwndParent = 0 As HWND - If Not Object.ReferenceEquals(parent, Nothing) Then - hwndParent = parent.Handle - End If Dim pText As PCTSTR If String.IsNullOrEmpty(text) Then @@ -427,15 +437,17 @@ If CreateWindowEx(.ExStyle, atom As ULONG_PTR As PCSTR, pText, .Style, _ - CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, _ - hwndParent, 0, hInstance, 0) = 0 Then + .X, .Y, .Width, .Height, _ + .Parent, 0, hInstance, 0) = 0 Then ' Error Dim buf[1023] As TCHAR wsprintf(buf, ToTCStr(Ex"Control: CreateWindowEx failed. Error code: &h%08X\r\n"), GetLastError()) OutputDebugString(buf) + + gch.Free() ' Debug ExitThread(0) End If End With - gch.Free() + End Sub @@ -475,4 +487,8 @@ Case WM_DESTROY OnHandleDestroyed(System.EventArgs.Empty) + + Case WM_LBUTTONDOWN + Goto *ButtonDown +*ButtonDown Case Else DefWndProc(m) @@ -521,5 +537,5 @@ End Sub - Virtual Sub OnPaintBackground(e As PaintEventArgs) : End Sub +' Virtual Sub OnPaintBackground(e As PaintEventArgs) : End Sub Virtual Sub OnEnabledChanged(e As System.EventArgs) : End Sub Virtual Sub OnBackColorChanged(e As System.EventArgs) : End Sub @@ -582,4 +598,9 @@ .Style = WS_OVERLAPPEDWINDOW .ExStyle = WS_EX_APPWINDOW + .Caption = String.Empty + .X = 0 + .Y = 0 + .Width = 0 + .Height = 0 End With End Sub @@ -608,4 +629,7 @@ rThis.wnd = New ActiveBasic.Windows.WindowHandle(hwnd) SetWindowLongPtr(hwnd, GWLP_THIS, gchValue) + ElseIf msg = WM_NCDESTROY Then + Dim gch = System.Runtime.InteropServices.GCHandle.FromIntPtr(GetWindowLongPtr(hwnd, GWLP_THIS)) + gch.Free() End If Index: trunk/Include/Classes/System/Windows/Forms/Message.ab =================================================================== --- trunk/Include/Classes/System/Windows/Forms/Message.ab (revision 381) +++ trunk/Include/Classes/System/Windows/Forms/Message.ab (revision 388) @@ -4,5 +4,5 @@ #define __SYSTEM_WINDOWS_FORMS_MESSAGE_AB__ -#require +'#require Namespace System @@ -65,9 +65,9 @@ End Function - Const Function Operator ==(x As Message) As BOOL + Const Function Operator ==(x As Message) As Boolean Return Equals(x) End Function - Const Function Operator <>(x As Message) As BOOL + Const Function Operator <>(x As Message) As Boolean Return Not Equals(x) End Function Index: trunk/Include/Classes/System/Windows/Forms/MessageBox.ab =================================================================== --- trunk/Include/Classes/System/Windows/Forms/MessageBox.ab (revision 381) +++ trunk/Include/Classes/System/Windows/Forms/MessageBox.ab (revision 388) @@ -1,6 +1,6 @@ 'Classes/System/Windows/Forms/MessageBox.ab -#require -#require +'#require +'#require Namespace System Index: trunk/Include/Classes/System/Windows/Forms/PaintEventArgs.ab =================================================================== --- trunk/Include/Classes/System/Windows/Forms/PaintEventArgs.ab (revision 381) +++ trunk/Include/Classes/System/Windows/Forms/PaintEventArgs.ab (revision 388) @@ -3,6 +3,4 @@ #ifndef __SYSTEM_WINDOWS_FORMS_PAINTEVENTARGS_AB__ #define __SYSTEM_WINDOWS_FORMS_PAINTEVENTARGS_AB__ - -#require Namespace System Index: trunk/Include/Classes/System/Windows/Forms/misc.ab =================================================================== --- trunk/Include/Classes/System/Windows/Forms/misc.ab (revision 381) +++ trunk/Include/Classes/System/Windows/Forms/misc.ab (revision 388) @@ -9,7 +9,9 @@ Interface IWin32Window - /*Const*/ Function Handle() As HWND + Function Handle() As HWND End Interface +TypeDef BoundsSpecified = Long +/* Enum BoundsSpecified None = &h0 @@ -22,5 +24,7 @@ All = BoundsSpecified.Location Or BoundsSpecified.Size End Enum - +*/ + +/* Enum Keys LButton = VK_LBUTTON @@ -208,4 +212,36 @@ End Enum +Enum MouseButtons + None = 0 + Left = &h00100000 + Right = &h00200000 + Middle = &h00400000 + XButton1 = &h00800000 + XButton2 = &h01000000 +End Enum +*/ + +TypeDef DialogResult = DWord +TypeDef MouseButtons = DWord + +Class MouseEventArgs + Inherits System.EventArgs +Public + + Sub MouseEventArgs(button As MouseButtons, clicks As Long, x As Long, y As Long, delta As Long) + MouseButton = button + Clicks = clicks + X = x + Y = y + Delta = delta + End Sub + + Const MouseButton As MouseButtons + Const Clicks As Long + Const X As Long + Const Y As Long + Const Delta As Long +End Class + End Namespace 'Forms End Namespace 'Widnows