Index: /Include/Classes/System/Drawing/Point.ab =================================================================== --- /Include/Classes/System/Drawing/Point.ab (revision 222) +++ /Include/Classes/System/Drawing/Point.ab (revision 223) @@ -4,7 +4,7 @@ #define __SYSTEM_DRAWING_POINT_AB__ -#include -#include -#include +#require +#require +#require Class Point @@ -20,10 +20,5 @@ End Sub - Sub Point(pt As Point) - x = pt.x - y = pt.y - End Sub - - Sub Point(ByRef sz As Size) + Sub Point(sz As Size) x = sz.Width y = sz.Height @@ -54,10 +49,5 @@ Return x = 0 And y = 0 End Function -/* - Sub Operator = (ByRef pt As Point) - x = pt.x - y = pt.y - End Sub -*/ + Function Operator + (pt As Point) As Point Return Add(This, pt) Index: /Include/Classes/System/Drawing/Rectangle.ab =================================================================== --- /Include/Classes/System/Drawing/Rectangle.ab (revision 222) +++ /Include/Classes/System/Drawing/Rectangle.ab (revision 223) @@ -4,8 +4,8 @@ #define __SYSTEM_DRAWING_RECTANGLE_AB__ -#include -#include -#include -#include +#require +#require +#require +#require Class Rectangle @@ -32,13 +32,9 @@ End Sub - Sub Rectangle(ByRef r As Rectangle) - x = r.x - y = r.y - width = r.width - height = r.height - End Sub - Sub Rectangle(ByRef r As RECT) - This = FromLTRB(r.left, r.top, r.right, r.bottom) + x = r.left + y = r.top + width = r.right - r.left + height = r.top - r.bottom End Sub @@ -111,20 +107,7 @@ Function IsEmpty() As Boolean - If Width <= 0 Or Height <= 0 Then - IsEmpty = _System_TRUE - Else - IsEmpty = _System_FALSE - End If - End Function -/* - Function Operator = (rc As Rectangle) - With rc - x = .x - y = .y - width = .width - height = .height - End With - End Function -*/ + Return Width <= 0 Or Height <= 0 + End Function + Function Operator == (rc As Rectangle) Return Equals(rc) @@ -140,25 +123,17 @@ Function Equals(rc As Rectangle) As Boolean - If X = rc.X And Y = rc.Y And Width = rc.Width And Height = rc.Height Then - Return True - Else - Return False - End If + Return X = rc.X And Y = rc.Y And Width = rc.Width And Height = rc.Height End Function Override Function GetHashCode() As Long - Return x Xor _System_BSwap(y) Xor width Xor _System_BSwap(height) + Return x As DWord Xor _System_BSwap(y As DWord) Xor width As DWord Xor _System_BSwap(height As DWord) End Function Static Function FromLTRB(l As Long, t As Long, r As Long, b As Long) As Rectangle - return New Rectangle(l, t, r - l, r - b) + return New Rectangle(l, t, r - l, b - t) End Function Function Contains(x As Long, y As Long) As Boolean - If x >= X And x < X + Width And y >= Y And y < Y + Height Then - Return True - Else - Return False - End If + Return x >= X And x < X + Width And y >= Y And y < Y + Height End Function @@ -168,9 +143,5 @@ Function Contains(rc As Rectangle) As Boolean - If X <= rc.X And rc.Right <= Right And Y <= rc.Y And rc.Bottom <= Bottom Then - Return True - Else - Return False - End If + Return X <= rc.X And rc.Right <= Right And Y <= rc.Y And rc.Bottom <= Bottom End Function @@ -205,12 +176,8 @@ Function IntersectsWith(rc As Rectangle) As Boolean - If Left < rc.Right And _ + Return Left < rc.Right And _ Top < rc.Bottom And _ Right > rc.Left And _ - Bottom > rc.Top Then - Return True - Else - Return False - End If + Bottom > rc.Top End Function Index: /Include/Classes/System/Drawing/Size.ab =================================================================== --- /Include/Classes/System/Drawing/Size.ab (revision 222) +++ /Include/Classes/System/Drawing/Size.ab (revision 223) @@ -77,5 +77,5 @@ Override Function GetHashCode() As Long - Return width Xor _System_BSwap(height) + Return width As DWord Xor _System_BSwap(height As DWord) End Function Index: /Include/Classes/System/Drawing/SizeF.ab =================================================================== --- /Include/Classes/System/Drawing/SizeF.ab (revision 222) +++ /Include/Classes/System/Drawing/SizeF.ab (revision 223) @@ -64,20 +64,13 @@ */ Function Equals(sz As SizeF) As Boolean - If width = sz.width And height = sz.height Then - Equals = _System_TRUE - Else - Equals = _System_FALSE - End If + Return width = sz.width And height = sz.height End Function Override Function GetHashCode() As Long Return VarPtr(GetDWord(width)) Xor _System_BSwap(VarPtr(GetDWord(height))) + End Function Function IsEmpty() As Boolean - If width = 0 And height = 0 Then - Empty = _System_TRUE - Else - Empty = _System_FALSE - End If + Return width = 0 And height = 0 End Function Index: /Include/Classes/System/Runtime/InteropServices/GCHandle.ab =================================================================== --- /Include/Classes/System/Runtime/InteropServices/GCHandle.ab (revision 222) +++ /Include/Classes/System/Runtime/InteropServices/GCHandle.ab (revision 223) @@ -12,4 +12,5 @@ Sub Target(obj As Object) allocated.Add(obj) + handle = GetPointer(VarPtr(obj)) End Sub @@ -24,5 +25,4 @@ Sub Free() - Dim pobj = VarPtr(handle) As *Object allocated.Remove(Target) handle = 0 @@ -30,10 +30,10 @@ Static Function ToIntPtr(h As GCHandle) As LONG_PTR - Return h.handle As LONG_PTR Xor &hffffffff As LONG_PTR + Return h.handle As LONG_PTR End Function Static Function FromIntPtr(ip As LONG_PTR) As GCHandle FromIntPtr = New GCHandle - FromIntPtr.handle = (ip Xor &hffffffff As LONG_PTR) As VoidPtr + FromIntPtr.handle = ip As VoidPtr End Function Index: /Include/Classes/System/Windows/Forms/Control.ab =================================================================== --- /Include/Classes/System/Windows/Forms/Control.ab (revision 222) +++ /Include/Classes/System/Windows/Forms/Control.ab (revision 223) @@ -4,16 +4,19 @@ #define __SYSTEM_WINDOWS_FORMS_CONTROL_AB__ -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include +#require +#require +#require +#require +#require +#require +#require +#require +#require +#require +#require +#require +#require + +TypeDef InvokeProc = *Function(p As VoidPtr) As VoidPtr Class AsyncResultForInvoke @@ -25,10 +28,10 @@ End Sub - Override Function AsyncState() As *IObject - Return 0 - End Function - - Override Function AsyncWaitHandle() As *WaitHandle - Return VarPtr(AsyncWaitHandle) + Override Function AsyncState() As IObject + Return Nothing + End Function + + Override Function AsyncWaitHandle() As WaitHandle + Return waitHandle End Function @@ -38,5 +41,5 @@ Override Function IsCompleted() As BOOL - Return AsyncWaitHandle()->WaitOne(0, FALSE) + Return waitHandle.WaitOne(0, FALSE) End Function @@ -56,31 +59,31 @@ Class AsyncInvokeData Public - FuncPtr As *Function(p As VoidPtr) As VoidPtr + FuncPtr As InvokeProc Data As *VoidPtr - AsyncResult As *AsyncResultForInvoke + AsyncResult As AsyncResultForInvoke End Class Class Control - Inherits IWin32Window +' Inherits IWin32Window Public '--------------------------------------------------------------------------- ' Public Properties - Function AllowDrop() As BOOL - End Function - - Override Function Handle() As HWND + Function AllowDrop() As Boolean + End Function + + /*Override*/ Function Handle() As HWND Return wnd.HWnd End Function ' IDropTargetを実装するのでDragAcceptFiles関数は呼ばない。 - Sub AllowDrop(a As BOOL) - End Sub - - Const Function Visible() As BOOL + Sub AllowDrop(a As Boolean) + End Sub + + Const Function Visible() As Boolean Return wnd.Visible End Function - Sub Visible(v As BOOL) + Sub Visible(v As Boolean) wnd.Visible(v) End Sub @@ -96,9 +99,9 @@ End Sub - Const Function Enabled() As BOOL + Const Function Enabled() As Boolean Return wnd.Enabled End Function - Sub Enabled(e As BOOL) + Sub Enabled(e As Boolean) ' OnEnabledChangedはWM_ENABLE経由で呼ばれる wnd.Enabled(e) @@ -108,7 +111,7 @@ Dim wr As RECT wr = wnd.WindowRect - Dim r As Rectangle(wr) + Dim r = New Rectangle(wr) Dim parent = Parent - If parent <> 0 Then + If Object.ReferenceEquals(parent, Nothing) Then Return parent->RectangleToClient(r) Else @@ -117,5 +120,5 @@ End Function - Sub Bounds(ByRef r As Rectangle) + Sub Bounds(r As Rectangle) SetBoundsCore(r.X, r.Y, r.Width, r.Height, BoundsSpecified.All) End Sub @@ -138,6 +141,5 @@ Const Function ClientRectangle() As Rectangle - Dim r As Rectangle(wnd.ClientRect) - Return r + Return New Rectangle(wnd.ClientRect) End Function @@ -191,24 +193,31 @@ Const Function PointToScreen(p As Point) As Point - wnd.ClientToScreen(ByVal VarPtr(p) As *POINTAPI) - Return r + PointToScreen = New Point + ret.X = p.X + ret.Y = p.Y + wnd.ClientToScreen(ByVal VarPtr(PointToScreen) As *POINTAPI) End Function Const Function PointToClient(p As Point) As Point - wnd.ScreenToClient(ByVal VarPtr(p) As *POINTAPI) - Return r - End Function - - Const Function RectangleToScreen(p As Rectangle) As Rectangle - wnd.ClientToScreen(ByVal VarPtr(p) As *POINTAPI) - Return p - End Function - - Const Function RectangleToClient(p As Rectangle) As Rectangle - wnd.ScreenToClient(ByVal VarPtr(p) As *POINTAPI) - Return p - End Function - - Const Function InvokeRequired() As BOOL + PointToScreen = New Point + ret.X = p.X + ret.Y = p.Y + wnd.ScreenToClient(ByVal VarPtr(PointToScreen) As *POINTAPI) + End Function + + Const Function RectangleToScreen(r As Rectangle) As Rectangle + Dim rc = r.ToRECT + wnd.ClientToScreen(rc) + Return New Rectangle(rc) + End Function + + Const Function RectangleToClient(r As Rectangle) As Rectangle + Dim rc As RECT + rc = r.ToRECT() + wnd.ScreenToClient(rc) + Return New Rectangle(rc) + End Function + + Const Function InvokeRequired() As Boolean Return wnd.ThreadID <> GetCurrentThreadId() End Function @@ -224,6 +233,10 @@ End Sub - Function Parent() As *Control + Function Parent() As Control Return parent + End Function + + Const Function IsHandleCreated() As Boolean + Return wnd.HWnd <> 0 End Function @@ -240,15 +253,15 @@ End Sub - Sub Control(ByRef text As String) + Sub Control(text As String) Dim sz = DefaultSize() Control(text, 100, 100, sz.Width, sz.Height) End Sub - Sub Control(ByRef parent As Control, ByRef text As String) + Sub Control(parent As Control, text As String) Dim sz = DefaultSize() Control(parent, text, 100, 100, sz.Width, sz.Height) End Sub - Sub Control(ByRef text As String, left As Long, top As Long, width As Long, height As Long) + Sub Control(text As String, left As Long, top As Long, width As Long, height As Long) This.text = text bkColor = DefaultBackColor @@ -257,5 +270,5 @@ End Sub - Sub Control(ByRef parent As Control, ByRef text As String, left As Long, top As Long, width As Long, height As Long) + Sub Control(parent As Control, text As String, left As Long, top As Long, width As Long, height As Long) This.parent = VarPtr(parent) Control(text, left, top, width, height) @@ -276,5 +289,5 @@ ' 同期関数呼出、Controlが作成されたスレッドで関数を実行する。 ' 関数は同期的に呼び出されるので、関数が終わるまでInvokeは制御を戻さない。 - Function Invoke(pfn As *Function(p As VoidPtr) As VoidPtr, p As VoidPtr) As VoidPtr + Function Invoke(pfn As InvokeProc, p As VoidPtr) As VoidPtr Return wnd.SendMessage(WM_CONTROL_INVOKE, p As WPARAM, pfn As LPARAM) As VoidPtr End Function @@ -283,16 +296,16 @@ ' 関数は非同期的に呼び出されるので、BeginInvokeはすぐに制御を戻す。 ' 後にEndInvokeを呼び出すことにより、関数の戻り値を受け取れる。 - ' 注意：現状の実装では必ずEndInvokeを呼び出す必要がある。 - Function BeginInvoke(pfn As *Function(p As VoidPtr) As VoidPtr, p As VoidPtr) As *IAsyncResult + Function BeginInvoke(pfn As InvokeProc, p As VoidPtr) As IAsyncResult ' EndInvokeがDeleteする - Dim pAsyncResult = New AsyncResultForInvoke(CreateEvent(0, FALSE, FALSE, 0)) + Dim asyncResult = New AsyncResultForInvoke(CreateEvent(0, FALSE, FALSE, 0)) ' OnControlBeginInvokeがDeleteする - Dim pAsyncInvokeData = New AsyncInvokeData - With pAsyncInvokeData[0] + Dim asyncInvokeData = New AsyncInvokeData + With asyncInvokeData .FuncPtr = pfn .Data = p - .AsyncResult = pAsyncResult + .AsyncResult = asyncResult End With - wnd.PostMessage(WM_CONTROL_BEGININVOKE, 0, pAsyncInvokeData As LPARAM) + Dim gch = GCHandle.Alloc(asyncInvokeData) + wnd.PostMessage(WM_CONTROL_BEGININVOKE, 0, GCHandle.ToIntPtr(gch)) Return pAsyncResult End Function @@ -300,25 +313,22 @@ ' BeginInvokeで呼び出した関数の戻り値を受け取る。 ' その関数がまだ終了していない場合、終了するまで待機する。 - Function EndInvoke(ar As *IAsyncResult) As VoidPtr - ar->WaitHandle->WaitOne() - Dim arInvoke = ar As *AsyncResultForInvoke - Dim result = arInvoke->Result - Delete arInvoke - Return result + Function EndInvoke(ar As IAsyncResult) As VoidPtr + ar.WaitHandle.WaitOne() + Dim arInvoke = ar As AsyncResultForInvoke + Return arInvoke.Result End Function ' 与えられたウィンドウハンドルがControl（若しくはその派生クラス）の ' インスタンスに対応するものであった場合、 - ' 元のインスタンスへのポインタを返す。 - ' そうでなければヌルポインタを返す。 - Static Function FromHandle(hwnd As HWND) As *Control + ' 元のインスタンスを返す。 + ' そうでなければNothingを返す。 + Static Function FromHandle(hwnd As HWND) As Control If IsWindow(hwnd) Then - Dim className[19] As Byte 'Len (WindowClassName) - GetClassName(hwnd, className, Len (className)) - If memcmp(className, WindowClassName, Len (WindowClassName)) = 0 Then - Return GetWindowLongPtr(hwnd, GWLP_THIS) As *Control + If GetClassLongPtr(hwnd, GCW_ATOM) = atom Then + Dim gch = GCHandle.FromIntPtr(GetWindowLongPtr(hwnd, GWLP_THIS)) + Return gch.Target As Control End If End If - Return 0 As *Control + Return Nothing As Control End Function @@ -327,5 +337,5 @@ End Sub - /*Override*/ Virtual Function ToString() As String + Override Function ToString() As String Return text End Function @@ -351,7 +361,7 @@ '--------------------------------------------------------------------------- ' Protected Properties -' Const Virtual Function CanRaiseEvents() As BOOL - Virtual Function CreateParams() As *CreateParams - Return VarPtr(createParams) +' Const Virtual Function CanRaiseEvents() As Boolean + Virtual Function CreateParams() As CreateParams + Return createParams End Function @@ -373,9 +383,10 @@ Virtual Sub CreateHandle() Dim createParams = CreateParams() - TlsSetValue(tlsIndex, VarPtr(This)) + Dim gch = GCHandle.Alloc(This) + TlsSetValue(tlsIndex, GCHandle.ToIntPtr(gch) As VoidPtr) With createParams[0] Dim hwndParent = 0 As HWND - If parent <> 0 Then - hwndParent = parent->Handle + If Not Object.ReferenceEquals(parent, Nothing) Then + hwndParent = parent.Handle End If If CreateWindowEx(.ExStyle, atom As ULONG_PTR As PCSTR, text, .Style, _ @@ -383,6 +394,6 @@ hwndParent, 0, hInstance, 0) = 0 Then ' Error - Dim buf[1023] As Byte - wsprintf(buf, Ex"Control: CreateWindowEx failed. Error code: &h%08X\r\n", GetLastError()) + Dim buf[1023] As TCHAR + wsprintf(buf, ToTCStr(Ex"Control: CreateWindowEx failed. Error code: &h%08X\r\n"), GetLastError()) OutputDebugString(buf) ' Debug @@ -390,11 +401,12 @@ End If End With - End Sub - - Virtual Sub DefWndProc(ByRef m As Message) + gch.Free() + End Sub + + Virtual Sub DefWndProc(m As Message) m.Result = DefWindowProc(m.HWnd, m.Msg, m.WParam, m.LParam) End Sub - Virtual Sub WndProc(ByRef m As Message) + Virtual Sub WndProc(m As Message) With m Select Case .Msg @@ -402,12 +414,11 @@ .Result = text.Length Case WM_GETTEXT - Dim size = Math.Min(.WParam As ULONG_PTR, text.Length As ULONG_PTR + 1) - memcpy(.LParam As *Byte, text.StrPtr, size) + Dim size = Math.Min(.WParam As ULONG_PTR, (text.Length + 1) As ULONG_PTR) + memcpy(.LParam As PCTSTR, ToTCStr(text), size * SizeOf (TCHAR)) .Result = size Case WM_SETTEXT - text = .LParam As *Byte + text = New String(.LParam As PCTSTR) Case WM_ENABLE - Dim e As EventArgs - OnEnabledChanged(e) + OnEnabledChanged(EventArgs.Empty) Case WM_ERASEBKGND ' OnPaintBackgroundに移すべき @@ -420,9 +431,10 @@ DeleteObject(hbr) Case WM_CONTROL_INVOKE - Dim pfn As *Function(p As VoidPtr) As VoidPtr - pfn = .LParam As *Function(p As VoidPtr) As VoidPtr + Dim pfn = .LParam As InvokeProc .Result = pfn(m.WParam As VoidPtr) As LRESULT Case WM_CONTROL_BEGININVOKE OnControlBeginInvoke(m) + Case WM_CREATE + OnHandleCreated(EventArgs.Empty) Case Else DefWndProc(m) @@ -450,16 +462,16 @@ Virtual Sub SetBoundsCore(x As Long, y As Long, width As Long, height As Long, bs As BoundsSpecified) - If Not (bs As DWord And BoundsSpecified.X As DWord) Then +' If Not (bs As DWord And BoundsSpecified.X As DWord) Then x = Left - End If - If Not (bs As DWord And BoundsSpecified.Y As DWord) Then +' End If +' If Not (bs As DWord And BoundsSpecified.Y As DWord) Then y = Right - End If - If Not (bs As DWord And BoundsSpecified.Width As DWord) Then +' End If +' If Not (bs As DWord And BoundsSpecified.Width As DWord) Then width = Width - End If - If Not (bs As DWord And BoundsSpecified.Height As DWord) Then +' End If +' If Not (bs As DWord And BoundsSpecified.Height As DWord) Then height = Height - End If +' End If wnd.Move(x, y, width, height) End Sub @@ -471,9 +483,10 @@ End Sub - Virtual Sub OnPaintBackground(ByRef e As PaintEventArgs) : End Sub - Virtual Sub OnEnabledChanged(ByRef e As EventArgs) : End Sub - Virtual Sub OnBackColorChanged(ByRef e As EventArgs) : End Sub - Virtual Sub OnTextChanged(ByRef e As EventArgs) - wnd.SetText(text.StrPtr) + Virtual Sub OnPaintBackground(e As PaintEventArgs) : End Sub + Virtual Sub OnEnabledChanged(e As EventArgs) : End Sub + Virtual Sub OnBackColorChanged(e As EventArgs) : End Sub + Virtual Sub OnHandleCreated(e As EventArgs) : End Sub + Virtual Sub OnTextChanged(e As EventArgs) + wnd.SetText(ToTCStr(text)) End Sub @@ -482,5 +495,5 @@ wnd As WindowHandle text As String - parent As *Control + parent As Control bkColor As Color @@ -496,5 +509,5 @@ Static Const WM_CONTROL_BEGININVOKE = WM_USER + 1 As DWord - Static Const WindowClassName = "ActiveBasic Control" As *Byte + Static Const WindowClassName = "ActiveBasic Control" Public Static Sub Initialize(hinst As HINSTANCE) @@ -519,6 +532,6 @@ atom = RegisterClassEx(wcx) If atom = 0 Then - Dim buf[1023] As Byte - wsprintf(buf, Ex"Control: RegisterClasseEx failed. Error code: &h%08X\r\n", GetLastError()) + Dim buf[1023] As TCHAR + wsprintf(buf, ToTCStr(Ex"Control: RegisterClasseEx failed. Error code: &h%08X\r\n"), GetLastError()) OutputDebugString(buf) Debug @@ -543,10 +556,11 @@ ' Windowsから呼ばれるウィンドウプロシージャ。WndProc Static Function WndProcFirst(hwnd As HWND, msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT - Dim pThis = Control.FromHandle(hwnd) As *Control - If pThis = 0 Then - pThis = TlsGetValue(tlsIndex) + Dim rThis = Control.FromHandle(hwnd) As Control + If Object.ReferenceEquals(rThis As Object, Nothing) Then + Dim gchValue = TlsGetValue(tlsIndex) As LONG_PTR + Dim gch = GCHandle.FromIntPtr(gchValue) + rThis = gch.Target As Control ' ウィンドウが作られて最初にWndProcFirstが呼ばれたとき - TlsSetValue(tlsIndex, 0) - If pThis = 0 Then + If Object.ReferenceEquals(rThis, Nothing) Then ' あってはならない事態 Debug @@ -554,22 +568,22 @@ End If ' Debug - pThis->wnd = hwnd - SetWindowLongPtr(hwnd, GWLP_THIS, pThis As LONG_PTR) + rThis.wnd = New WindowHandle(hwnd) + SetWindowLongPtr(hwnd, GWLP_THIS, gchValue) End If Dim m As Message m = Message.Create(hwnd, msg, wp, lp) - pThis->WndProc(m) + rThis.WndProc(m) Return m.Result End Function ' BeginInvokeが呼ばれたときの処理 - Sub OnControlBeginInvoke(ByRef m As Message) - Dim data As *AsyncInvokeData - data = m.LParam As *AsyncInvokeData - Dim asyncResult As *AsyncResultForInvoke - asyncResult->Result = data->FuncPtr(data->Data) - Dim wh = asyncResult->AsyncWaitHandle - SetEvent(wh->Handle) - Delete data + Sub OnControlBeginInvoke(m As Message) + Dim gch = GCHandle.FromIntPtr(m.LParam) + Dim data = gch.Target As AsyncInvokeData + With data + Dim pfn = .FuncPtr + .AsyncResult.Result = pfn(.Data) + SetEvent(.AsyncResult.AsyncWaitHandle.Handle) + End With End Sub End Class Index: /Include/Classes/System/Windows/Forms/Message.ab =================================================================== --- /Include/Classes/System/Windows/Forms/Message.ab (revision 222) +++ /Include/Classes/System/Windows/Forms/Message.ab (revision 223) @@ -4,15 +4,9 @@ #define __SYSTEM_WINDOWS_FORMS_MESSAGE_AB__ +#require + Class Message Public - Sub Operator =(ByRef x As Message) - hwnd = x.hwnd - msg = x.msg - wp = x.wp - lp = x.lp - lr = x.lr - End Sub - - /*Const*/ Function HWnd() As HWND + Const Function HWnd() As HWND Return hwnd End Function @@ -22,5 +16,5 @@ End Sub - /*Const*/ Function Msg() As DWord + Const Function Msg() As DWord Return msg End Function @@ -30,5 +24,5 @@ End Sub - /*Const*/ Function WParam() As WPARAM + Const Function WParam() As WPARAM Return wp End Function @@ -38,5 +32,5 @@ End Sub - /*Const*/ Function LParam() As LPARAM + Const Function LParam() As LPARAM Return lp End Function @@ -46,5 +40,5 @@ End Sub - /*Const*/ Function Result() As LRESULT + Const Function Result() As LRESULT Return lr End Function @@ -54,5 +48,5 @@ End Sub - /*Const*/ Function Equals(x As Message) As BOOL + /*Const*/ Function Equals(x As Message) As Boolean Return hwnd = x.hwnd And _ msg = x.msg And _ @@ -62,9 +56,14 @@ End Function - /*Const*/ Function Operator ==(x As Message) As BOOL + Override Function GetHashCode() As Long + Return _System_HashFromPtr(hwnd) Xor (Not msg) Xor _System_HashFromPtr(wp As VoidPtr) Xor _ + (Not _System_HashFromPtr(lp As VoidPtr)) Xor _System_HashFromPtr(lr As VoidPtr) + End Function + + Const Function Operator ==(x As Message) As BOOL Return Equals(x) End Function - /*Const*/ Function Operator <>(x As Message) As BOOL + Const Function Operator <>(x As Message) As BOOL Return Not Equals(x) End Function Index: /Include/Classes/System/Windows/Forms/PaintEventArgs.ab =================================================================== --- /Include/Classes/System/Windows/Forms/PaintEventArgs.ab (revision 222) +++ /Include/Classes/System/Windows/Forms/PaintEventArgs.ab (revision 223) @@ -4,5 +4,5 @@ #define __SYSTEM_WINDOWS_FORMS_PAINTEVENTARGS_AB__ -#include +#require Class PaintEventArgs Index: /Include/Classes/System/Windows/Forms/index.ab =================================================================== --- /Include/Classes/System/Windows/Forms/index.ab (revision 222) +++ /Include/Classes/System/Windows/Forms/index.ab (revision 223) @@ -4,10 +4,9 @@ #define __SYSTEM_WINDOWS_FORMS_INDEX_AB__ -#include -#include -#include -#include -#include -#include +#require +#require +#require +#require +#require #endif '__SYSTEM_WINDOWS_FORMS_INDEX_AB__ Index: /Include/Classes/System/Windows/Forms/misc.ab =================================================================== --- /Include/Classes/System/Windows/Forms/misc.ab (revision 222) +++ /Include/Classes/System/Windows/Forms/misc.ab (revision 223) @@ -9,5 +9,5 @@ Enum BoundsSpecified - None = 0 + None = &h0 X = &h1 Y = &h2 Index: /Include/Classes/System/misc.ab =================================================================== --- /Include/Classes/System/misc.ab (revision 222) +++ /Include/Classes/System/misc.ab (revision 223) @@ -4,5 +4,5 @@ #define __SYSTEM_MISC_AB__ -#include +#require Interface IObject @@ -28,4 +28,6 @@ Class EventArgs +Public + Static Empty = New EventArgs End Class Index: /Include/OAIdl.ab =================================================================== --- /Include/OAIdl.ab (revision 222) +++ /Include/OAIdl.ab (revision 223) @@ -1,5 +1,5 @@ ' OAIdl.sbp ' 本来はOAIdl.idlから生成するのが正当ですが、 -' これは手動で必要最低限のもののみ移植したものです。 +' これは手動で移植したものです。 #ifndef _INC_OAIDL_AB @@ -939,84 +939,62 @@ Function SetGuid( /* [in] */ ByRef guid As GUID) As HRESULT - Function SetTypeFlags( /* [in] */ uTypeFlags As DWord) As HRESULT - Function SetDocString( /* [in] */ pStrDoc As LPOLESTR) As HRESULT - Function SetHelpContext( /* [in] */ dwHelpContext As DWord) As HRESULT - Function SetVersion( /* [in] */ wMajorVerNum As Word, /* [in] */ wMinorVerNum As Word) As HRESULT - Function AddRefTypeInfo( /* [in] */ pTInfo As VoidPtr /* *ITypeInfo */, /* [in] */ByRef hRefType As HREFTYPE) As HRESULT - Function AddFuncDesc( /* [in] */ index As DWord, /* [in] */ ByRef FuncDesc As FUNCDESC) As HRESULT - Function AddImplType( /* [in] */ index As DWord, /* [in] */ hRefType As HREFTYPE) As HRESULT - Function SetImplTypeFlags( /* [in] */ index As DWord, /* [in] */ implTypeFlags As Long) As HRESULT - Function SetAlignment( /* [in] */ cbAlignment As Long) As HRESULT - Function SetSchema( /* [in] */ pStrSchema As LPOLESTR) As HRESULT - Function AddVarDesc( /* [in] */ index As DWord, /* [in] */ ByRef VarDesc As VARDESC) As HRESULT - Function SetFuncAndParamNames( /* [in] */ index As DWord, /* [in][size_is][in] */ rgszNames As *LPOLESTR, /* [in] */ cNames As DWord) As HRESULT - Function SetVarName( /* [in] */ index As DWord, /* [in] */ szName As LPOLESTR) As HRESULT - Function SetTypeDescAlias( /* [in] */ ByRef TDescAlias As TYPEDESC) As HRESULT - Function DefineFuncAsDllEntry( /* [in] */ index As DWord, /* [in] */ szDllName As LPOLESTR, /* [in] */ zProcName As LPOLESTR) As HRESULT - Function SetFuncDocString( /* [in] */ index As DWord, /* [in] */ szDocString As LPOLESTR) As HRESULT - Function SetVarDocString( /* [in] */ index As DWord, /* [in] */ szDocString As LPOLESTR) As HRESULT - Function SetFuncHelpContext( /* [in] */ index As DWord, /* [in] */ dwHelpContext As DWord) As HRESULT - Function SetVarHelpContext( /* [in] */ index As DWord, /* [in] */ dwHelpContext As DWord) As HRESULT - Function SetMops( /* [in] */ index As DWord, /* [in] */ bstrMops As BSTR) As HRESULT - Function SetTypeIdldesc( /* [in] */ ByRef IdlDesc As IDLDESC) As HRESULT - Function LayOut() As HRESULT End Interface Index: /Include/api_gdi.sbp =================================================================== --- /Include/api_gdi.sbp (revision 222) +++ /Include/api_gdi.sbp (revision 223) @@ -198,5 +198,9 @@ End Type - +Type LOGPALETTE + palVersion As Word + palNumEntries As Word + palPalEntry[ELM(1)] As PALETTEENTRY +End Type ' raster operations Index: /Include/basic/function.sbp =================================================================== --- /Include/basic/function.sbp (revision 222) +++ /Include/basic/function.sbp (revision 223) @@ -1059,5 +1059,5 @@ Function _System_BSwap(x As Word) As Word Dim src = VarPtr(x) As *Byte - Dim dst = VarPtr(_System_BSwap) As *SByte + Dim dst = VarPtr(_System_BSwap) As *Byte dst[0] = src[1] dst[1] = src[0] @@ -1066,5 +1066,5 @@ Function _System_BSwap(x As DWord) As DWord Dim src = VarPtr(x) As *Byte - Dim dst = VarPtr(_System_BSwap) As *SByte + Dim dst = VarPtr(_System_BSwap) As *Byte dst[0] = src[3] dst[1] = src[2] @@ -1075,5 +1075,5 @@ Function _System_BSwap(x As QWord) As QWord Dim src = VarPtr(x) As *Byte - Dim dst = VarPtr(_System_BSwap) As *SByte + Dim dst = VarPtr(_System_BSwap) As *Byte dst[0] = src[7] dst[1] = src[6] Index: /Include/objidl.sbp =================================================================== --- /Include/objidl.sbp (revision 222) +++ /Include/objidl.sbp (revision 223) @@ -192,5 +192,5 @@ Inherits IUnknown - Function CreateStream( + Function CreateStream( /* [string][in] */ pwcsName As *OLECHAR, /* [in] */ grfMode As DWord, @@ -198,5 +198,5 @@ /* [in] */ reserved2 As DWord, /* [out] */ ByRef pstm As *IStream) As HRESULT - /* [local] */ Function OpenStream( + /* [local] */ Function OpenStream( /* [string][in] */ pwcsName As *OLECHAR, /* [unique][in] */ reserved1 As VoidPtr, @@ -204,5 +204,5 @@ /* [in] */ reserved2 As DWord, /* [out] */ ByRef pstm As *IStream) As HRESULT - Function CreateStorage( + Function CreateStorage( /* [string][in] */ pwcsName As *OLECHAR, /* [in] */ grfMode As DWord, @@ -210,5 +210,5 @@ /* [in] */ reserved2 As DWord, /* [out] */ ByRef pstg As *IStorage) As HRESULT - Function OpenStorage( + Function OpenStorage( /* [string][unique][in] */ pwcsName As *OLECHAR, /* [unique][in] */ pstgPriority As IStorage, @@ -217,38 +217,38 @@ /* [in] */ reserved As DWord, /* [out] */ ByRef pstg As *IStorage) As HRESULT - /* [local] */ Function CopyTo( + /* [local] */ Function CopyTo( /* [in] */ ciidExclude As DWord, /* [size_is][unique][in] */ ByRef rgiidExclude As * /*Const*/ IID, /* [unique][in] */ snbExclude As SNB, /* [unique][in] */ pstgDest As *IStorage) As HRESULT - Function MoveElementTo( + Function MoveElementTo( /* [string][in] */ pwcsName As *OLECHAR, /* [unique][in] */ pstgDest As *IStorage, /* [string][in] */ pwcsNewName As *OLECHAR, /* [in] */ grfFlags As DWord) As HRESULT - Function Commit( + Function Commit( /* [in] */ grfCommitFlags As DWord) As HRESULT Function Revert() As HRESULT - /* [local] */ Function EnumElements( + /* [local] */ Function EnumElements( /* [in] */ reserved1 As DWord, /* [size_is][unique][in] */ reserved2 As VoidPtr, /* [in] */ reserved3 As DWord, /* [out] */ ByRef penum As *IEnumSTATSTG) As HRESULT - Function DestroyElement( + Function DestroyElement( /* [string][in] */ pwcsName As *OLECHAR) As HRESULT - Function RenameElement( + Function RenameElement( /* [string][in] */ pwcsOldName As *OLECHAR, /* [string][in] */ pwcsNewName As *OLECHAR) As HRESULT - Function SetElementTimes( + Function SetElementTimes( /* [string][unique][in] */ pwcsName As *OLECHAR, /* [unique][in] */ ByRef ctime As /*Const*/ FILETIME, /* [unique][in] */ ByRef atime As /*Const*/ FILETIME, /* [unique][in] */ ByRef mtime As /*Const*/ FILETIME) As HRESULT - Function SetClass( + Function SetClass( /* [in] */ ByRef clsid As CLSID) As HRESULT - Function SetStateBits( + Function SetStateBits( /* [in] */ grfStateBits As DWord, /* [in] */ grfMask As DWord) As HRESULT - Function Stat( + Function Stat( /* [out] */ ByRef statstg As STATSTG, /* [in] */ grfStatFlag As DWord) As HRESULT Index: /Include/ole2.ab =================================================================== --- /Include/ole2.ab (revision 222) +++ /Include/ole2.ab (revision 223) @@ -5,7 +5,4 @@ ' 暫定措置 -Interface IOleClientSite - Inherits IUnknown -End Interface Interface IPersistStorage @@ -26,8 +23,4 @@ Interface IOleInPlaceActiveObject - Inherits IUnknown -End Interface - -Interface IOleObject Inherits IUnknown End Interface @@ -75,5 +68,5 @@ /* pull in the MIDL generated header */ -'#include +#require /****** DV APIs ***********************************************************/ Index: /Include/oleidl.ab =================================================================== --- /Include/oleidl.ab (revision 223) +++ /Include/oleidl.ab (revision 223) @@ -0,0 +1,88 @@ +'oleidl.ab + +Const Enum OLERENDER + OLERENDER_NONE = 0 + OLERENDER_DRAW = 1 + OLERENDER_FORMAT = 2 + OLERENDER_ASIS = 3 +End Enum + +Dim IID_IOleClientSite = [&h00000118, &h0000, &h0000, [&hC0, &h00, &h00, &h00, &h00, &h00, &h00, &h46]] As IID +Interface IOleClientSite + Inherits IUnknown + + Function SaveObject() As HRESULT + Function GetMoniker( + /* [in] */ dwAssign As DWord, + /* [in] */ dwWhichMoniker As DWord, + /* [out] */ ByRef pmk As *IMoniker) As HRESULT + Function GetContainer( + /* [out] */ ByRef pContainer As VoidPtr /* *IOleContainer*/) As HRESULT + Function ShowObject() As HRESULT + Function OnShowWindow( + fShow As BOOL) As HRESULT + Function RequestNewObjectLayout() As HRESULT +End Interface + +Dim IID_IOleObject = [&h00000112, &h0000, &h0000, [&hC0, &h00, &h00, &h00, &h00, &h00, &h00, &h46]] As IID +Interface IOleObject + Inherits IUnknown + + Function SetClientSite( + /* [unique][in] */ pClientSite As IOleClientSite) As HRESULT + Function GetClientSite( + /* [out] */ ByRef pClientSite As *IOleClientSite) As HRESULT + Function SetHostNames( + /* [in] */ szContainerApp As LPCOLESTR, + /* [unique][in] */ szContainerObj As LPCOLESTR) As HRESULT + Function Close( + /* [in] */ dwSaveOption As DWord) As HRESULT + Function SetMoniker( + /* [in] */ dwWhichMoniker As DWord, + /* [unique][in] */ pmk As *IMoniker) As HRESULT + Function GetMoniker( + /* [in] */ dwAssign As DWord, + /* [in] */ dwWhichMoniker As DWord, + /* [out] */ ByRef pmk As *IMoniker) As HRESULT + Function InitFromData( + /* [unique][in] */ pDataObject As IDataObject, + /* [in] */ fCreation As BOOL, + /* [in] */ dwReserved As DWord) As HRESULT + Function GetClipboardData( + /* [in] */ dwReserved As DWord, + /* [out] */ ByRef pDataObject As *IDataObject) As HRESULT + Function DoVerb( + /* [in] */ iVerb As Long, + /* [unique][in] */ lpmsg As *MSG, + /* [unique][in] */ pActiveSite As IOleClientSite, + /* [in] */ lindex As Long, + /* [in] */ hwndParent As HWND, + /* [unique][in] */ lprcPosRect As *RECT /*LPCRECT*/) As HRESULT + Function EnumVerbs( + /* [out] */ ByRef pEnumOleVerb As *IUnknown /*IEnumOLEVERB*/) As HRESULT + Function Update() As HRESULT + Function IsUpToDate() As HRESULT + Function GetUserClassID( + /* [out] */ ByRef Clsid As CLSID) As HRESULT + Function GetUserType( + /* [in] */ dwFormOfType As DWord, + /* [out] */ ByRef pszUserType As LPOLESTR) As HRESULT + Function SetExtent( + /* [in] */ dwDrawAspect As DWord, + /* [in] */ ByRef sizel As SIZEL) As HRESULT + Function GetExtent( + /* [in] */ dwDrawAspect As DWord, + /* [out] */ ByRef sizel As SIZEL) As HRESULT + Function Advise( + /* [unique][in] */ pAdvSink As *IAdviseSink, + /* [out] */ ByRef dwConnection As DWord) As HRESULT + Function Unadvise( + /* [in] */ dwConnection As DWord) As HRESULT + Function EnumAdvise( + /* [out] */ ByRef penumAdvise As IEnumSTATDATA) As HRESULT + Function GetMiscStatus( + /* [in] */ dwAspect As DWord, + /* [out] */ ByRef dwStatus As DWord) As HRESULT + Function SetColorScheme( + /* [in] */ ByRef Logpal As LOGPALETTE) As HRESULT +End Interface Index: /Include/system/string.sbp =================================================================== --- /Include/system/string.sbp (revision 222) +++ /Include/system/string.sbp (revision 223) @@ -10,5 +10,5 @@ Function ZeroString(length As Long) As String - Return New String(0, length) + Return New String(0 As StrChar, length) End Function Index: /Include/windows/WindowHandle.sbp =================================================================== --- /Include/windows/WindowHandle.sbp (revision 222) +++ /Include/windows/WindowHandle.sbp (revision 223) @@ -372,4 +372,9 @@ End Function + Const Function ScreenToClient(ByRef rc As RECT) As Boolean + Dim ppt = VarPtr(rc) As *POINTAPI + Return _System_ScreenToClient(hwnd, ppt[0]) And _System_ScreenToClient(hwnd, ppt[1]) + End Function + Function Scroll(dx As Long, dy As Long, ByRef rcScroll As RECT, ByRef rcClip As RECT, hrgnUpdate As HRGN, ByRef rcUpdate As RECT, flags As DWord) As Boolean Return ScrollWindowEx(hwnd, dx, dy, rcScroll, rcClip, hrgnUpdate, rcUpdate, flags) As Boolean @@ -626,5 +631,5 @@ End Function - Sub Style(newStyle As DWord) DWord + Sub Style(newStyle As DWord) _System_SetWindowLongPtr(hwnd, GWLP_STYLE, newStyle) End Sub @@ -677,5 +682,5 @@ Const Function Parent() As WindowHandle - Return _System_GetParent(hwnd) + Return New WindowHandle(_System_GetParent(hwnd)) End Function @@ -714,8 +719,4 @@ Sub Prop(str As PCTSTR, h As HANDLE) SetProp(str, h) - End Sub - - Sub Prop(psz As PCTSTR, h As HANDLE) - SetProp(psz, h) End Sub