Index: /Include/Classes/System/Drawing/Color.ab =================================================================== --- /Include/Classes/System/Drawing/Color.ab (revision 76) +++ /Include/Classes/System/Drawing/Color.ab (revision 77) @@ -50,17 +50,17 @@ Function A() As Byte - Return (Argb >> Color_AlphaShift) As Byte + Return (argb >> ALPHA_SHIFT) As Byte End Function Function R() As Byte - Return (Argb >> Color_RedShift) As Byte + Return (argb >> RED_SHIFT) As Byte End Function Function G() As Byte - Return (Argb >> Color_GreenShift) As Byte + Return (argb >> GREEN_SHIFT) As Byte End Function Function B() As Byte - GetBlue = (argb >> Color_BlueShift) As Byte + Return (argb >> BLUE_SHIFT) As Byte End Function @@ -306,8 +306,8 @@ */ Static Function MakeARGB(a As Byte, r As Byte, g As Byte, b As Byte) As ARGB - MakeARGB = (((b As ARGB) << Color_BlueShift) Or _ - ((g As ARGB) << Color_GreenShift) Or _ - ((r As ARGB) << Color_RedShift) Or _ - ((a As ARGB) << Color_AlphaShift)) + MakeARGB = (((b As ARGB) << BLUE_SHIFT) Or _ + ((g As ARGB) << GREEN_SHIFT) Or _ + ((r As ARGB) << RED_SHIFT) Or _ + ((a As ARGB) << ALPHA_SHIFT)) End Function Index: /Include/Classes/System/Drawing/Drawing2D/Matrix.ab =================================================================== --- /Include/Classes/System/Drawing/Drawing2D/Matrix.ab (revision 77) +++ /Include/Classes/System/Drawing/Drawing2D/Matrix.ab (revision 77) @@ -0,0 +1,9 @@ +' Classes/System/Drawing/Drawing2D/Matrix.ab + +#ifndef __SYSTEM_DRAWING_DRAWING2D_MATRIX_AB__ +#define __SYSTEM_DRAWING_DRAWING2D_MATRIX_AB__ + +Class Matrix +End Class + +#endif '__SYSTEM_DRAWING_DRAWING2D_MATRIX_AB__ Index: /Include/Classes/System/Drawing/Drawing2D/misc.ab =================================================================== --- /Include/Classes/System/Drawing/Drawing2D/misc.ab (revision 77) +++ /Include/Classes/System/Drawing/Drawing2D/misc.ab (revision 77) @@ -0,0 +1,87 @@ +' Classes/System/Drawing/Drawing2D/misc.ab + +#ifndef __SYSTEM_DRAWING_DRAWING2D_MISC_AB__ +#define __SYSTEM_DRAWING_DRAWING2D_MISC_AB__ + +Enum CombineMode + Replace ' 0 + Intersect ' 1 + Union ' 2 + Xor ' 3 + Exclude ' 4 + Complement ' 5 +End Enum + +Enum CompositingMode + ModeSourceOver ' 0 + ModeSourceCopy ' 1 +End Enum + +Enum QualityMode + Invalid = -1 + Default = 0 + Low = 1 ' Best performance + High = 2 ' Best rendering quality +End Enum + +Enum CompositingQuality + Invalid = QualityMode.Invalid + Default = QualityMode.Default + HighSpeed = QualityMode.Low + HighQuality = QualityMode.High + GammaCorrected + AssumeLinear +End Enum + +Enum InterpolationMode + Invalid = QualityMode.Invalid + Default = QualityMode.Default + LowQuality = QualityMode.Low + HighQuality = QualityMode.High + Bilinear + Bicubic + NearestNeighbor + HighQualityBilinear + HighQualityBicubic +End Enum + +Enum SmoothingMode + Invalid = QualityMode.Invalid + Default = QualityMode.Default + HighSpeed = QualityMode.Low + HighQuality = QualityMode.High + None + AntiAlias +End Enum + +Enum PixelOffsetMode + Invalid = QualityMode.Invalid + Default = QualityMode.Default + HighSpeed = QualityMode.Low + HighQuality = QualityMode.High + None + Half +End Enum + +Enum FlushIntention + Flush + Sync +End Enum + +Enum FillMode + Alternate + Winding +End Enum + +Enum MatrixOrder + Prepend + Append +End Enum + +Enum CoordinateSpace + World + Page + Device +End Enum + +#endif '__SYSTEM_DRAWING_DRAWING2D_MISC_AB__ Index: /Include/Classes/System/Drawing/Imaging/misc.ab =================================================================== --- /Include/Classes/System/Drawing/Imaging/misc.ab (revision 76) +++ /Include/Classes/System/Drawing/Imaging/misc.ab (revision 77) @@ -14,8 +14,8 @@ End Enum -Const ALPHA_SHIFT = 24 -Const RED_SHIFT = 16 -Const GREEN_SHIFT = 8 -Const BLUE_SHIFT = 0 +Const ALPHA_SHIFT = 24 As DWord +Const RED_SHIFT = 16 As DWord +Const GREEN_SHIFT = 8 As DWord +Const BLUE_SHIFT = 0 As DWord Const ALPHA_MASK = ((&hff As ARGB) << ALPHA_SHIFT) Index: /Include/Classes/System/Drawing/PointF.ab =================================================================== --- /Include/Classes/System/Drawing/PointF.ab (revision 76) +++ /Include/Classes/System/Drawing/PointF.ab (revision 77) @@ -110,5 +110,5 @@ End Function - Static Function Substract((pt1 As PointF, pt2 As PointF) As PointF + Static Function Substract(pt1 As PointF, pt2 As PointF) As PointF Dim ret As PointF(pt1.x - pt2.x, pt1.y - pt2.y) Return ret Index: /Include/Classes/System/Drawing/Rectangle.ab =================================================================== --- /Include/Classes/System/Drawing/Rectangle.ab (revision 76) +++ /Include/Classes/System/Drawing/Rectangle.ab (revision 77) @@ -18,5 +18,5 @@ End Sub - Sub Rectangle(x As Single, y As Single, width As Single, height As Single) + Sub Rectangle(x As Long, y As Long, width As Long, height As Long) x = x y = y @@ -25,16 +25,20 @@ End Sub - Sub Rectangle(location As Point, size As Size) - x = location.X - y = location.Y - width = size.Height - height = size.Height - End Sub - - Sub Rectangle(ByRef rc As Rectangle) - x = rc.x - y = rc.y - width = rc.width - height = rc.height + Sub Rectangle(l As Point, s As Size) + x = l.X + y = l.Y + width = s.Height + height = s.Height + 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) End Sub @@ -58,49 +62,49 @@ End Sub - Function X() As Single + Function X() As Long Return x End Function - Sub X(value As Single) + Sub X(value As Long) x = value End Sub - Function Y() As Single + Function Y() As Long Return y End Function - Sub Y(value As Single) + Sub Y(value As Long) y = value End Sub - Function Width() As Single + Function Width() As Long Return width End Function - Sub Width(value As Single) + Sub Width(value As Long) width = value End Sub - Function Height() As Single + Function Height() As Long Return height End Function - Sub Height(value As Single) + Sub Height(value As Long) height = value End Sub - Function Left() As Single + Function Left() As Long Return X End Function - Function Top() As Single + Function Top() As Long Return Y End Function - Function Right() As Single + Function Right() As Long Return X + Width End Function - Function Bottom() As Single + Function Bottom() As Long Return Y + Height End Function @@ -144,10 +148,10 @@ End Function - Static Function FromLTRB(l As Single, t As Single, r As Single, b As Single) As Rectangle + Static Function FromLTRB(l As Long, t As Long, r As Long, b As Long) As Rectangle Dim rect As Rectangle(l, t, r - l, r - b) return rect End Function - Function Contains(x As Single, y As Single) As BOOL + Function Contains(x As Long, y As Long) As BOOL If x >= X And x < X + Width And y >= Y And y < Y + Height Then Contains = _System_TRUE @@ -169,5 +173,5 @@ End Function - Sub Inflate(dx As Single, dy As Single) + Sub Inflate(dx As Long, dy As Long) X -= dx Y -= dy @@ -180,5 +184,5 @@ End Sub - Static Function Inflate(ByRef rc As Rectangle, x As Single, y As Single) As Rectangle + Static Function Inflate(ByRef rc As Rectangle, x As Long, y As Long) As Rectangle Inflate = rc Inflate.Inflate(x, y) @@ -190,5 +194,5 @@ Static Function Intersect(ByRef a As Rectangle, ByRef b As Rectangle) As Rectangle - Dim right As Single, bottom As Single, left As Single, top As Single + Dim right As Long, bottom As Long, left As Long, top As Long right = Math.Min(a.Right, b.Right) bottom = Math.Min(a.Bottom, b.Bottom) @@ -210,5 +214,5 @@ Static Function Union(ByRef a As Rectangle, ByRef b As Rectangle) As Rectangle - Dim right As Single, bottom As Single, left As Single, top As Single + Dim right As Long, bottom As Long, left As Long, top As Long right = Math.Max(a.Right(), b.Right()) bottom = Math.Max(a.Bottom(), b.Bottom()) @@ -222,5 +226,5 @@ End Sub - Sub Offset(dx As Single, dy As Single) + Sub Offset(dx As Long, dy As Long) X += dx Y += dy @@ -254,9 +258,18 @@ End Function + Function ToRECT() As RECT + With ToRECT + .left = x + .top = y + .right = x + width + .bottom = y + height + End With + End Function + Public - x As Single - y As Single - width As Single - height As Single + x As Long + y As Long + width As Long + height As Long End Class Index: /Include/Classes/System/Drawing/Text/misc.ab =================================================================== --- /Include/Classes/System/Drawing/Text/misc.ab (revision 77) +++ /Include/Classes/System/Drawing/Text/misc.ab (revision 77) @@ -0,0 +1,15 @@ +' Classes/System/Drawing/Text/misc.ab + +#ifndef __SYSTEM_DRAWING_TEXT_MISC_AB__ +#define __SYSTEM_DRAWING_TEXT_MISC_AB__ + +Enum TextRenderingHint + SystemDefault = 0 + SingleBitPerPixelGridFit + SingleBitPerPixel + AntiAliasGridFit + AntiAlias + ClearTypeGridFit +End Enum + +#endif '__SYSTEM_DRAWING_TEXT_MISC_AB__ Index: /Include/Classes/System/Drawing/index.ab =================================================================== --- /Include/Classes/System/Drawing/index.ab (revision 77) +++ /Include/Classes/System/Drawing/index.ab (revision 77) @@ -0,0 +1,17 @@ +' Classes/System/Drawing/index.ab + +#ifndef __SYSTEM_DRAWING_INDEX_AB__ +#define __SYSTEM_DRAWING_INDEX_AB__ + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +#endif '__SYSTEM_DRAWING_INDEX_AB__ Index: /Include/Classes/System/Threading/WaitHandle.ab =================================================================== --- /Include/Classes/System/Threading/WaitHandle.ab (revision 76) +++ /Include/Classes/System/Threading/WaitHandle.ab (revision 77) @@ -6,10 +6,7 @@ Class WaitHandle Public - Virtual Sub ~WaitHandle() - Close() - End Sub - - ' Const Function SafeWaitHandle() As SafeWaitHandle - ' Sub SafeWaitHandle(h As SafeWaitHandle) + ' Properties +' Const Function SafeWaitHandle() As SafeWaitHandle +' Sub SafeWaitHandle(h As SafeWaitHandle) Const Virtual Function Handle() As HANDLE @@ -19,4 +16,10 @@ Virtual Sub Handle(newHandle As HANDLE) h = newHandle + End Sub + + ' Methods + + Virtual Sub ~WaitHandle() + Close() End Sub Index: /Include/Classes/System/Windows/Forms/Control.ab =================================================================== --- /Include/Classes/System/Windows/Forms/Control.ab (revision 77) +++ /Include/Classes/System/Windows/Forms/Control.ab (revision 77) @@ -0,0 +1,588 @@ +' Classes/System/Windows/Forms/Control.ab + +#ifndef __SYSTEM_WINDOWS_FORMS_CONTROL_AB__ +#define __SYSTEM_WINDOWS_FORMS_CONTROL_AB__ + +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include +#include + +Class AsyncResultForInvoke + Inherits IAsyncResult +Public + ' Properties + Sub AsyncResultForInvoke(h As HANDLE) + waitHandle.Handle = h + End Sub + + Override Function AsyncState() As *IObject + Return 0 + End Function + + Override Function AsyncWaitHandle() As *WaitHandle + Return VarPtr(AsyncWaitHandle) + End Function + + Override Function CompletedSynchronously() As BOOL + Return FALSE + End Function + + Override Function IsCompleted() As BOOL + Return AsyncWaitHandle()->WaitOne(0, FALSE) + End Function + + Const Function Result() As VoidPtr + Return result + End Function + + Sub Result(r As VoidPtr) + result = r + End Sub + +Private + waitHandle As WaitHandle + result As VoidPtr +End Class + +Class AsyncInvokeData +Public + FuncPtr As *Function(p As VoidPtr) As VoidPtr, p As VoidPtr + Data As *VoidPtr + AsyncResult As *AsyncResultForInvoke +End Class + +Class Control + Inherits IWin32Window +Public + ' Properties + + Function AllowDrop() As BOOL + 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 + Return wnd.Visible + End Function + + Sub Visible(v As BOOL) + wnd.Visible(v) + End Sub + + Const Function Text() As String + Return text + End Function + + Sub Text(ByRef t As String) + text = t + Dim e As EventArgs + OnTextChanged(e) + End Sub + + Const Function Enabled() As BOOL + Return wnd.Enabled + End Function + + Sub Enabled(e As BOOL) + ' OnEnabledChangedはWM_ENABLE経由で呼ばれる + wnd.Enabled(e) + End Sub + + Const Function Bounds() As Rectangle + Dim wr As RECT + wr = wnd.WindowRect + Dim r As Rectangle(wr) + Dim parent = Parent + If parent <> 0 Then + Return parent->RectangleToClient(r) + Else + Return r + End If + End Function + + Sub Bounds(ByRef 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) + End Sub + + Const Function ClientRectangle() As Rectangle + Dim r As Rectangle(wnd.ClientRect) + Return r + End Function + + Const Function ClientSize() As Size + 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 + Return Left + Width + End Function + + Const Function Bottom() As Long + Return Top + Height + End Function + + Const Function PointToScreen(p As Point) As Point + wnd.ClientToScreen(ByVal VarPtr(p) As *POINTAPI) + Return r + 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 + Return wnd.ThreadID <> GetCurrentThreadId() + End Function + + Const Virtual Function BackColor() As Color + Return bkColor + End Function + + Virtual Sub BackColor(c As Color) + c = bkColor + Dim e As EventArgs + OnBackColorChanged(e) + End Sub + + ' Constractors + + Sub Control() + Dim sz = DefaultSize() + Control("", 100, 100, sz.Width, sz.Height) + End Sub + + Sub Control(ByRef 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) + Dim sz = DefaultSize() + Control(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 +' Debug + CreateHandle() + End Sub + + Sub Control(ByRef parent As Control, ByRef 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) + End Sub + + Function Parent() As *Control + Return parent + End Function + + Static Function DefaultBackColor() As Color + Return Color.FromArgb(255, 255, 255) + End Function + + ' Destractor + + Virtual Sub ~Control() + If wnd.IsWindow Then + wnd.Destroy() ' 暫定 + End If + End Sub + + ' Methods + + ' 同期関数呼出、Controlが作成されたスレッドで関数を実行する。 + ' 関数は同期的に呼び出されるので、関数が終わるまでInvokeは制御を戻さない。 + Function Invoke(pfn As *Function(p As VoidPtr) As VoidPtr, p As VoidPtr) As VoidPtr + Return wnd.SendMessage(WM_CONTROL_INVOKE, p As WPARAM, pfn As LPARAM) As VoidPtr + End Function + + ' 非同期関数呼出、Controlが作成されたスレッドで関数を実行する。 + ' 関数は非同期的に呼び出されるので、BeginInvokeはすぐに制御を戻す。 + ' 後にEndInvokeを呼び出すことにより、関数の戻り値を受け取れる。 + ' 注意：現状の実装では必ずEndInvokeを呼び出す必要がある。 + Function BeginInvoke(pfn As *Function(p As VoidPtr) As VoidPtr, p As VoidPtr) As *IAsyncResult + ' EndInvokeがDeleteする + Dim pAsyncResult = New AsyncResultForInvoke(CreateEvent(0, FALSE, FALSE, 0)) + ' OnControlBeginInvokeがDeleteする + Dim pAsyncInvokeData = New AsyncInvokeData + With pAsyncInvokeData[0] + .FuncPtr = pfn + .Data = p + .AsyncResult = pAsyncResult + End With + wnd.PostMessage(WM_CONTROL_BEGININVOKE, 0, pAsyncInvokeData As LPARAM) + Return pAsyncResult + End Function + + ' BeginInvokeで呼び出した関数の戻り値を受け取る。 + ' その関数がまだ終了していない場合、終了するまで待機する。 + Function EndInvoke(ar As *IAsyncResult) As VoidPtr + ar->WaitHandle->WaitOne() + Dim arInvoke = ar As *AsyncResultForInvoke + Dim result = arInvoke->Result + Delete arInvoke + Return result + End Function + + ' 与えられたウィンドウハンドルがControl（若しくはその派生クラス）の + ' インスタンスに対応するものであった場合、 + ' 元のインスタンスへのポインタを返す。 + ' そうでなければヌルポインタを返す。 + 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 + End If + End If + Return 0 As *Control + End Function + + Virtual Sub ResetText() + text = "" + End Sub + + /*Override*/ Virtual Function ToString() As String + Return text + End Function + + ' Wrapper Methods + Sub BringToFront() + wnd.BringToTop() + End Sub + + Sub Hide() + wnd.Show(SW_HIDE) + End Sub + + Sub Show() + wnd.Show(SW_SHOW) + End Sub + + Sub Update() + wnd.Update() + End Sub + +Protected + ' Properties +' Const Virtual Function CanRaiseEvents() As BOOL + Virtual Function CreateParams() As *CreateParams + Return VarPtr(createParams) + End Function + +' Virtual Function DefaultCursor() As Cursor + + Virtual Function DefaultSize() As Size + Dim s As Size(300, 300) + Return s + End Function + +' Function FontHeight() As Long +' Sub FontHeight(h As Long) + +' Const Virtual Function Cursor() As Cursor +' Virtual Sub Cursor(ByRef c As Cursor) + + ' Methods + Virtual Sub CreateHandle() + Dim createParams = CreateParams() + TlsSetValue(tlsIndex, VarPtr(This)) + With createParams[0] + Dim hwndParent = 0 As HWND + If parent <> 0 Then + hwndParent = parent->Handle + End If + If CreateWindowEx(.ExStyle, atom As ULONG_PTR As PCSTR, text, .Style, _ + CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, _ + 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()) + OutputDebugString(buf) +' Debug + ExitThread(0) + End If + End With + End Sub + + Virtual Sub DefWndProc(ByRef m As Message) + m.Result = DefWindowProc(m.HWnd, m.Msg, m.WParam, m.LParam) + End Sub + + Virtual Sub WndProc(ByRef m As Message) + With m + Select Case .Msg + Case WM_GETTEXTLENGTH + .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) + .Result = size + Case WM_SETTEXT + text = .LParam As *Byte + Case WM_ENABLE + Dim e As EventArgs + OnEnabledChanged(e) + Case WM_ERASEBKGND + ' OnPaintBackgroundに移すべき + Dim hdc As HDC + hdc = .WParam As HDC + Dim hbr = CreateSolidBrush(bkColor.ToCOLORREF()) + Dim hbrOld = SelectObject(hdc, hbr) + Dim rc As RECT + rc = wnd.ClientRect + Rectangle(hdc, rc.left, rc.top, rc.right, rc.bottom) + SelectObject(hdc, hbrOld) + DeleteObject(hbr) + Case WM_CONTROL_INVOKE + Dim pfn As *Function(p As VoidPtr) As VoidPtr + pfn = .LParam As *Function(p As VoidPtr) As VoidPtr + .Result = pfn(m.WParam As VoidPtr) As LRESULT + Case WM_CONTROL_BEGININVOKE + OnControlBeginInvoke(m) + Case Else + DefWndProc(m) + End Select + End With + End Sub + + Virtual Sub SetClientSizeCore(x As Long, y As Long) + Dim rc As RECT + With rc + .left = 0 + .top = 0 + .right = x + .bottom = y + End With + Dim hasMenu = FALSE As BOOL + If wnd.Parent As HWND = 0 Then + If wnd.Menu <> 0 Then + hasMenu = TRUE + End If + End If + AdjustWindowRectEx(rc, wnd.Style, hasMenu, wnd.ExStyle) + wnd.Move(rc) + End Sub + + 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 + x = Left + 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 + width = Width + End If + If Not (bs As DWord And BoundsSpecified.Height As DWord) Then + height = Height + End If + wnd.Move(x, y, width, height) + End Sub + + Virtual Sub NotifyInvalidate(r As Rectangle) + Dim rc As RECT + rc = r.ToRECT() + wnd.InvalidateRect(rc) + 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) + End Sub + +Private + ' Member variables + wnd As WindowHandle + text As String + parent As *Control + bkColor As Color + + Static createParams As CreateParams + + 'ウィンドウ作成時にウィンドウプロシージャへThisを伝えるためのもの + Static tlsIndex As DWord + + Static hInstance As HINSTANCE + Static atom As ATOM + + Static Const WM_CONTROL_INVOKE = WM_USER + 0 As DWord + Static Const WM_CONTROL_BEGININVOKE = WM_USER + 1 As DWord + + Static Const WindowClassName = "ActiveBasic Control" As *Byte +Public + Static Sub Initialize(hinst As HINSTANCE) + tlsIndex = TlsAlloc() + hInstance = hinst + + Dim wcx As WNDCLASSEX + With wcx + .cbSize = Len (wcx) + .style = CS_HREDRAW Or CS_VREDRAW Or CS_DBLCLKS + .lpfnWndProc = AddressOf (WndProcFirst) + .cbClsExtra = 0 + .cbWndExtra = SizeOf (LONG_PTR) * 2 + .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 = WindowClassName + .hIconSm = 0 + End With + 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()) + OutputDebugString(buf) + Debug + ExitThread(0) + End If + + With createParams + ' 値は暫定的なもの + .Style = WS_OVERLAPPEDWINDOW + .ExStyle = WS_EX_APPWINDOW + End With + End Sub + + Static Sub Uninitialize() + UnregisterClass(atom As ULONG_PTR As PCSTR, hInstance) + TlsFree(tlsIndex) + End Sub +Private + Static Const GWLP_THIS = SizeOf (LONG_PTR) * 0 As Long + Static Const GWLP_TAG = SizeOf (LONG_PTR) * 1 As Long + + ' 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) + ' ウィンドウが作られて最初にWndProcFirstが呼ばれたとき + TlsSetValue(tlsIndex, 0) + If pThis = 0 Then + ' あってはならない事態 + Debug + ExitThread(0) + End If +' Debug + pThis->wnd = hwnd + SetWindowLongPtr(hwnd, GWLP_THIS, pThis As LONG_PTR) + End If + Dim m As Message + m = Message.Create(hwnd, msg, wp, lp) + pThis->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 + End Sub +End Class + +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_ + +#endif '__SYSTEM_WINDOWS_FORMS_CONTROL_AB__ Index: /Include/Classes/System/Windows/Forms/CreateParams.ab =================================================================== --- /Include/Classes/System/Windows/Forms/CreateParams.ab (revision 77) +++ /Include/Classes/System/Windows/Forms/CreateParams.ab (revision 77) @@ -0,0 +1,21 @@ +' Classes/System/Windows/Forms/CreateParams.ab + +#ifndef __SYSTEM_WINDOWS_FORMS_CREATEPARAMS_AB__ +#define __SYSTEM_WINDOWS_FORMS_CREATEPARAMS_AB__ + +Class CreateParams +Public + Caption As String + ClassName As String + ClassStyle As DWord + Style As DWord + ExStyle As DWord + X As Long + Y As Long + Widht As Long + Height As Long + Parent As HWND + Param As VoidPtr +End Class + +#endif '__SYSTEM_WINDOWS_FORMS_CREATEPARAMS_AB__ Index: /Include/Classes/System/Windows/Forms/Message.ab =================================================================== --- /Include/Classes/System/Windows/Forms/Message.ab (revision 77) +++ /Include/Classes/System/Windows/Forms/Message.ab (revision 77) @@ -0,0 +1,91 @@ +' Classes/System/Windows/Forms/Message.ab + +#ifndef __SYSTEM_WINDOWS_FORMS_MESSAGE_AB__ +#define __SYSTEM_WINDOWS_FORMS_MESSAGE_AB__ + +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 + Return hwnd + End Function + + Sub HWnd(hw As HWND) + hwnd = hw + End Sub + + /*Const*/ Function Msg() As DWord + Return msg + End Function + + Sub Msg(m As DWord) + msg = m + End Sub + + /*Const*/ Function WParam() As WPARAM + Return wp + End Function + + Sub WParam(wParam As WPARAM) + wp = wParam + End Sub + + /*Const*/ Function LParam() As LPARAM + Return lp + End Function + + Sub LParam(lParam As LPARAM) + lp = lParam + End Sub + + /*Const*/ Function Result() As LRESULT + Return lr + End Function + + Sub Result(res As LRESULT) + lr = res + End Sub + + /*Const*/ Function Equals(x As Message) As BOOL + Return hwnd = x.hwnd And _ + msg = x.msg And _ + wp = .wp And _ + lp = .lp And _ + lr = .lr + End Function + + /*Const*/ Function Operator ==(x As Message) As BOOL + Return Equals(x) + End Function + + /*Const*/ Function Operator <>(x As Message) As BOOL + Return Not Equals(x) + End Function + + Static Function Create(hwnd As HWND, msg As DWord, wp As WPARAM, lp As LPARAM) As Message + Dim m As Message + With m + .hwnd = hwnd + .msg = msg + .wp = wp + .lp = lp + End With + Return m + End Function + +Private + hwnd As HWND + msg As DWord + wp As WPARAM + lp As LPARAM + lr As LRESULT +End Class + +#endif '__SYSTEM_WINDOWS_FORMS_MESSAGE_AB__ Index: /Include/Classes/System/Windows/Forms/PaintEventArgs.ab =================================================================== --- /Include/Classes/System/Windows/Forms/PaintEventArgs.ab (revision 77) +++ /Include/Classes/System/Windows/Forms/PaintEventArgs.ab (revision 77) @@ -0,0 +1,12 @@ +' Classes/System/Windows/Forms/PaintEventArgs.ab + +#ifndef __SYSTEM_WINDOWS_FORMS_PAINTEVENTARGS_AB__ +#define __SYSTEM_WINDOWS_FORMS_PAINTEVENTARGS_AB__ + +#include + +Class PaintEventArgs + Inherits EventArgs +End Class + +#endif '__SYSTEM_WINDOWS_FORMS_PAINTEVENTARGS_AB__ Index: /Include/Classes/System/Windows/Forms/index.ab =================================================================== --- /Include/Classes/System/Windows/Forms/index.ab (revision 77) +++ /Include/Classes/System/Windows/Forms/index.ab (revision 77) @@ -0,0 +1,13 @@ +' Classes/System/Windows/Forms/index.ab + +#ifndef __SYSTEM_WINDOWS_FORMS_INDEX_AB__ +#define __SYSTEM_WINDOWS_FORMS_INDEX_AB__ + +#include +#include +#include +#include +#include +#include + +#endif '__SYSTEM_WINDOWS_FORMS_INDEX_AB__ Index: /Include/Classes/System/Windows/Forms/misc.ab =================================================================== --- /Include/Classes/System/Windows/Forms/misc.ab (revision 77) +++ /Include/Classes/System/Windows/Forms/misc.ab (revision 77) @@ -0,0 +1,21 @@ +' Classes/System/Windows/Forms/misc.ab + +#ifndef __SYSTEM_WINDOWS_FORMS_MISC_AB__ +#define __SYSTEM_WINDOWS_FORMS_MISC_AB__ + +Interface IWin32Window + /*Const*/ Function Handle() As HWND +End Interface + +Enum BoundsSpecified + None = 0 + X = &h1 + Y = &h2 + Width = &h4 + Height = &h8 + Location = BoundsSpecified.X Or BoundsSpecified.Y + Size = BoundsSpecified.Width Or BoundsSpecified.Height + All = BoundsSpecified.Location Or BoundsSpecified.Size +End Enum + +#endif '__SYSTEM_WINDOWS_FORMS_MISC_AB__ Index: /Include/Classes/System/misc.ab =================================================================== --- /Include/Classes/System/misc.ab (revision 77) +++ /Include/Classes/System/misc.ab (revision 77) @@ -0,0 +1,32 @@ +' Classes/System/misc.ab + +#ifndef __SYSTEM_MISC_AB__ +#define __SYSTEM_MISC_AB__ + +#include + +Interface IObject +End Interface + +Interface IAsyncResult + ' Properties + Function AsyncState() As *IObject + Function AsyncWaitHandle() As WaitHandle + Function CompletedSynchronously() As BOOL + Function IsCompleted() As BOOL +End Interface + +Interface IClonable + ' Method + Function Clone() As *IObject +End Interface + +Interface IComparable + ' Method + Function CompareTo(ByRef obj As IObject) As Long +End Interface + +Class EventArgs +End Class + +#endif '__SYSTEM_MISC_AB__ Index: /Include/GdiPlusInit.ab =================================================================== --- /Include/GdiPlusInit.ab (revision 76) +++ /Include/GdiPlusInit.ab (revision 77) @@ -5,6 +5,6 @@ Enum DebugEventLevel - DebugEventLevelFatal - DebugEventLevelWarning + DebugEventLevelFatal + DebugEventLevelWarning End Enum Index: /Include/OAIdl.ab =================================================================== --- /Include/OAIdl.ab (revision 76) +++ /Include/OAIdl.ab (revision 77) @@ -936,87 +936,87 @@ Inherits IUnknown - 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 + 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 @@ -1239,5 +1239,5 @@ /* [unique][uuid][object] */ -Typedef /* [unique] */ LPENUMVARIANT = *IEnumVARIANT +Typedef LPENUMVARIANT = /* [unique] */ *IEnumVARIANT Dim IID_IEnumVARIANT = [&h00020404, &h0000, &h0000, [&hC0, &h00, &h00, &h00, &h00, &h00, &h00, &h46]] As IID @@ -1260,6 +1260,4 @@ #endif /* __IEnumVARIANT_INTERFACE_DEFINED__ */ -#ifdef __UNDECLARED__ - #ifndef __ITypeComp_INTERFACE_DEFINED__ #define __ITypeComp_INTERFACE_DEFINED__ @@ -1268,5 +1266,5 @@ /* [unique][uuid][object] */ -TypeDef /* [unique] */ ITypeComp *LPTYPECOMP; +TypeDef LPTYPECOMP = /* [unique] */ *ITypeComp /* [v1_enum] */ @@ -1285,33 +1283,32 @@ lptcomp As *ITypeComp End Union +*/ +Type BINDPTR + p As VoidPtr '暫定 +End Type TypeDef LPBINDPTR = *BINDPTR -*/ - -EXTERN_C const IID IID_ITypeComp; - - MIDL_INTERFACE("00020403-0000-0000-C000-000000000046") - ITypeComp : public IUnknown - { - public: - virtual /* [local] */ HRESULT STDMETHODCALLTYPE Bind( - /* [in] */ LPOLESTR szName, - /* [in] */ ULONG lHashVal, - /* [in] */ WORD wFlags, - /* [out] */ ITypeInfo **ppTInfo, - /* [out] */ DESCKIND *pDescKind, - /* [out] */ BINDPTR *pBindPtr) As HRESULT - - virtual /* [local] */ HRESULT STDMETHODCALLTYPE BindType( - /* [in] */ LPOLESTR szName, - /* [in] */ ULONG lHashVal, - /* [out] */ ITypeInfo **ppTInfo, - /* [out] */ ITypeComp **ppTComp) As HRESULT - - }; - + +Dim IID_ITypeComp = [&h00020403, &h0000, &h0000, [&hC0, &h00, &h00, &h00, &h00, &h00, &h00, &h46]] As IID + +Interface ITypeComp + Inherits IUnknown + + Function /* [local] */ Bind( + /* [in] */ szName As LPOLESTR, + /* [in] */ HashVal As DWord, + /* [in] */ wFlags As Word, + /* [out] */ ByRef pTInfo As *ITypeInfo, + /* [out] */ ByRef DescKind As DESCKIND, + /* [out] */ ByRef BindPtr As BINDPTR) As HRESULT + + Function /* [local] */ BindType( + /* [in] */ szName As LPOLESTR, + /* [in] */ HashVal As DWord, + /* [out] */ ByRef pTInfo As *ITypeInfo, + /* [out] */ ByRef pTComp As *ITypeComp) As HRESULT +End Interface #endif /* __ITypeComp_INTERFACE_DEFINED__ */ - #ifndef __ITypeInfo_INTERFACE_DEFINED__ @@ -1321,104 +1318,100 @@ /* [unique][uuid][object] */ -TypeDef /* [unique] */ ITypeInfo *LPTYPEINFO; - - -EXTERN_C const IID IID_ITypeInfo; - - MIDL_INTERFACE("00020401-0000-0000-C000-000000000046") - ITypeInfo : public IUnknown - { - public: - virtual /* [local] */ HRESULT STDMETHODCALLTYPE GetTypeAttr( - /* [out] */ TYPEATTR **ppTypeAttr) As HRESULT - - Function GetTypeComp( - /* [out] */ ITypeComp **ppTComp) As HRESULT - - virtual /* [local] */ HRESULT STDMETHODCALLTYPE GetFuncDesc( - /* [in] */ UINT index, - /* [out] */ FUNCDESC **ppFuncDesc) As HRESULT - - virtual /* [local] */ HRESULT STDMETHODCALLTYPE GetVarDesc( - /* [in] */ UINT index, - /* [out] */ VARDESC **ppVarDesc) As HRESULT - - virtual /* [local] */ HRESULT STDMETHODCALLTYPE GetNames( - /* [in] */ MEMBERID memid, - /* [length_is][size_is][out] */ BSTR *rgBstrNames, - /* [in] */ UINT cMaxNames, - /* [out] */ UINT *pcNames) As HRESULT - - Function GetRefTypeOfImplType( - /* [in] */ UINT index, - /* [out] */ HREFTYPE *pRefType) As HRESULT - - Function GetImplTypeFlags( - /* [in] */ UINT index, - /* [out] */ INT *pImplTypeFlags) As HRESULT - - virtual /* [local] */ HRESULT STDMETHODCALLTYPE GetIDsOfNames( - /* [size_is][in] */ LPOLESTR *rgszNames, - /* [in] */ UINT cNames, - /* [size_is][out] */ MEMBERID *pMemId) As HRESULT - - virtual /* [local] */ HRESULT STDMETHODCALLTYPE Invoke( - /* [in] */ PVOID pvInstance, - /* [in] */ MEMBERID memid, - /* [in] */ WORD wFlags, - /* [out][in] */ DISPPARAMS *pDispParams, - /* [out] */ VARIANT *pVarResult, - /* [out] */ EXCEPINFO *pExcepInfo, - /* [out] */ UINT *puArgErr) As HRESULT - - virtual /* [local] */ HRESULT STDMETHODCALLTYPE GetDocumentation( - /* [in] */ MEMBERID memid, - /* [out] */ BSTR *pBstrName, - /* [out] */ BSTR *pBstrDocString, - /* [out] */ DWORD *pdwHelpContext, - /* [out] */ BSTR *pBstrHelpFile) As HRESULT - - virtual /* [local] */ HRESULT STDMETHODCALLTYPE GetDllEntry( - /* [in] */ MEMBERID memid, - /* [in] */ INVOKEKIND invKind, - /* [out] */ BSTR *pBstrDllName, - /* [out] */ BSTR *pBstrName, - /* [out] */ WORD *pwOrdinal) As HRESULT - - Function GetRefTypeInfo( - /* [in] */ HREFTYPE hRefType, - /* [out] */ ITypeInfo **ppTInfo) As HRESULT - - virtual /* [local] */ HRESULT STDMETHODCALLTYPE AddressOfMember( - /* [in] */ MEMBERID memid, - /* [in] */ INVOKEKIND invKind, - /* [out] */ PVOID *ppv) As HRESULT - - virtual /* [local] */ HRESULT STDMETHODCALLTYPE CreateInstance( - /* [in] */ IUnknown *pUnkOuter, - /* [in] */ REFIID riid, - /* [iid_is][out] */ PVOID *ppvObj) As HRESULT - - Function GetMops( - /* [in] */ MEMBERID memid, - /* [out] */ BSTR *pBstrMops) As HRESULT - - virtual /* [local] */ HRESULT STDMETHODCALLTYPE GetContainingTypeLib( - /* [out] */ ITypeLib **ppTLib, - /* [out] */ UINT *pIndex) As HRESULT - - virtual /* [local] */ void STDMETHODCALLTYPE ReleaseTypeAttr( - /* [in] */ TYPEATTR *pTypeAttr) As HRESULT - - virtual /* [local] */ void STDMETHODCALLTYPE ReleaseFuncDesc( - /* [in] */ FUNCDESC *pFuncDesc) As HRESULT - - virtual /* [local] */ void STDMETHODCALLTYPE ReleaseVarDesc( - /* [in] */ VARDESC *pVarDesc) As HRESULT - - }; +TypeDef LPTYPEINFO = /* [unique] */ *ITypeInfo + +Dim IID_ITypeInfo = [&H00020401, &h0000, &h0000, [&hC0, &h00, &h00, &h00, &h00, &h00, &h00, &h46]] As IID + +Interface ITypeInfo + Inherits IUnknown + + Function /* [local] */ GetTypeAttr( + /* [out] */ ByRef pTypeAttr As *TYPEATTR) As HRESULT + + Function GetTypeComp( + /* [out] */ ByRef pTComp As *ITypeComp) As HRESULT + + Function /* [local] */ GetFuncDesc( + /* [in] */ index As DWord, + /* [out] */ ByRef pFuncDesc As *FUNCDESC) As HRESULT + + Function /* [local] */ GetVarDesc( + /* [in] */ index As DWord, + /* [out] */ ByRef pVarDesc As *VARDESC) As HRESULT + + Function /* [local] */ GetNames( + /* [in] */ memid As MEMBERID, + /* [length_is][size_is][out] */ rgBstrNames As *BSTR, + /* [in] */ cMaxNames As DWord, + /* [out] */ ByRef cNames As DWord) As HRESULT + + Function GetRefTypeOfImplType( + /* [in] */ index As DWord, + /* [out] */ ByRef RefType As HREFTYPE) As HRESULT + + Function GetImplTypeFlags( + /* [in] */ index As DWord, + /* [out] */ ByRef ImplTypeFlags As Long) As HRESULT + + Function /* [local] */ GetIDsOfNames( + /* [size_is][in] */ rgszNames As *LPOLESTR, + /* [in] */ cNames As DWord, + /* [size_is][out] */ pMemId As *MEMBERID) As HRESULT + + Function /* [local] */ Invoke( + /* [in] */ pvInstance As VoidPtr, + /* [in] */ memid As MEMBERID, + /* [in] */ wFlags As Word, + /* [out][in] */ ByRef DispParams As DISPPARAMS, + /* [out] */ ByRef VarResult As VARIANT, + /* [out] */ ByRef ExcepInfo As EXCEPINFO, + /* [out] */ ByRef uArgErr As DWord) As HRESULT + + Function /* [local] */ GetDocumentation( + /* [in] */ memid As MEMBERID, + /* [out] */ ByRef BstrName As BSTR, + /* [out] */ ByRef BstrDocString As BSTR, + /* [out] */ ByRef dwHelpContext As DWord, + /* [out] */ ByRef BstrHelpFile As BSTR) As HRESULT + + Function /* [local] */ GetDllEntry( + /* [in] */ memid As MEMBERID, + /* [in] */ invKind As INVOKEKIND, + /* [out] */ ByRef BstrDllName As BSTR, + /* [out] */ ByRef BstrName As BSTR, + /* [out] */ ByRef wOrdinal As Word) As HRESULT + + Function GetRefTypeInfo( + /* [in] */ hRefType As HREFTYPE, + /* [out] */ ByRef pTInfo As *ITypeInfo) As HRESULT + + Function /* [local] */ AddressOfMember( + /* [in] */ memid As MEMBERID, + /* [in] */ invKind As INVOKEKIND, + /* [out] */ ByRef pv As VoidPtr) As HRESULT + + Function /* [local] */ CreateInstance( + /* [in] */ pUnkOuter As *IUnknown, + /* [in] */ ByRef riid As IID, + /* [iid_is][out] */ ByRef pvObj As Any) As HRESULT + + Function GetMops( + /* [in] */ memid As MEMBERID, + /* [out] */ ByRef BstrMops As BSTR) As HRESULT + + Function /* [local] */ GetContainingTypeLib( + /* [out] */ ByRef pTLib As *ITypeLib, + /* [out] */ ByRef Index As UINT) As HRESULT + + Function /* [local] */ void STDMETHODCALLTYPE ReleaseTypeAttr( + /* [in] */ pTypeAttr As *TYPEATTR) As HRESULT + + Function /* [local] */ void STDMETHODCALLTYPE ReleaseFuncDesc( + /* [in] */ pFuncDesc As *FUNCDESC) As HRESULT + + Function /* [local] */ void STDMETHODCALLTYPE ReleaseVarDesc( + /* [in] */ pVarDesc As *VARDESC) As HRESULT +End Interface #endif /* __ITypeInfo_INTERFACE_DEFINED__ */ - #ifndef __ITypeInfo2_INTERFACE_DEFINED__ @@ -1428,85 +1421,68 @@ /* [unique][uuid][object] */ -TypeDef /* [unique] */ ITypeInfo2 *LPTYPEINFO2; - - -EXTERN_C const IID IID_ITypeInfo2; - - MIDL_INTERFACE("00020412-0000-0000-C000-000000000046") - ITypeInfo2 : public ITypeInfo - { - public: - Function GetTypeKind( - /* [out] */ TYPEKIND *pTypeKind) As HRESULT - - Function GetTypeFlags( - /* [out] */ ULONG *pTypeFlags) As HRESULT - - Function GetFuncIndexOfMemId( - /* [in] */ MEMBERID memid, - /* [in] */ INVOKEKIND invKind, - /* [out] */ UINT *pFuncIndex) As HRESULT - - Function GetVarIndexOfMemId( - /* [in] */ MEMBERID memid, - /* [out] */ UINT *pVarIndex) As HRESULT - - Function GetCustData( - /* [in] */ REFGUID guid, - /* [out] */ VARIANT *pVarVal) As HRESULT - - Function GetFuncCustData( - /* [in] */ UINT index, - /* [in] */ REFGUID guid, - /* [out] */ VARIANT *pVarVal) As HRESULT - - Function GetParamCustData( - /* [in] */ UINT indexFunc, - /* [in] */ UINT indexParam, - /* [in] */ REFGUID guid, - /* [out] */ VARIANT *pVarVal) As HRESULT - - Function GetVarCustData( - /* [in] */ UINT index, - /* [in] */ REFGUID guid, - /* [out] */ VARIANT *pVarVal) As HRESULT - - Function GetImplTypeCustData( - /* [in] */ UINT index, - /* [in] */ REFGUID guid, - /* [out] */ VARIANT *pVarVal) As HRESULT - - virtual /* [local] */ HRESULT STDMETHODCALLTYPE GetDocumentation2( - /* [in] */ MEMBERID memid, - /* [in] */ LCID lcid, - /* [out] */ BSTR *pbstrHelpString, - /* [out] */ DWORD *pdwHelpStringContext, - /* [out] */ BSTR *pbstrHelpStringDll) As HRESULT - - Function GetAllCustData( - /* [out] */ CUSTDATA *pCustData) As HRESULT - - Function GetAllFuncCustData( - /* [in] */ UINT index, - /* [out] */ CUSTDATA *pCustData) As HRESULT - - Function GetAllParamCustData( - /* [in] */ UINT indexFunc, - /* [in] */ UINT indexParam, - /* [out] */ CUSTDATA *pCustData) As HRESULT - - Function GetAllVarCustData( - /* [in] */ UINT index, - /* [out] */ CUSTDATA *pCustData) As HRESULT - - Function GetAllImplTypeCustData( - /* [in] */ UINT index, - /* [out] */ CUSTDATA *pCustData) As HRESULT - - }; - +TypeDef LPTYPEINFO2 = /* [unique] */ *ITypeInfo2 + +Dim IID_ITypeInfo2 = [&H00020412, &h0000, &h0000, [&hC0, &h00, &h00, &h00, &h00, &h00, &h00, &h46]] As IID + +Interface ITypeInfo2 + Inherits ITypeInfo + + Function GetTypeKind( + /* [out] */ ByRef TypeKind As TYPEKIND) As HRESULT + Function GetTypeFlags( + /* [out] */ ByRef TypeFlags As DWord) As HRESULT + Function GetFuncIndexOfMemId( + /* [in] */ memid As MEMBERID, + /* [in] */ invKind As INVOKEKIND, + /* [out] */ ByRef FuncIndex As DWord) As HRESULT + Function GetVarIndexOfMemId( + /* [in] */ memid As MEMBERID, + /* [out] */ ByRef pVarIndex As DWord) As HRESULT + Function GetCustData( + /* [in] */ ByRef guid As GUID, + /* [out] */ ByRef VarVal As VARIANT) As HRESULT + Function GetFuncCustData( + /* [in] */ index As DWord, + /* [in] */ ByRef guid As GUID, + /* [out] */ ByRef VarVal As VARIANT) As HRESULT + Function GetParamCustData( + /* [in] */ indexFunc As DWord, + /* [in] */ indexParam As DWord, + /* [in] */ ByRef guid As GUID, + /* [out] */ ByRef VarVal As VARIANT) As HRESULT + Function GetVarCustData( + /* [in] */ UINT index, + /* [in] */ ByRef guid As GUID, + /* [out] */ ByRef VarVal As VARIANT) As HRESULT + Function GetImplTypeCustData( + /* [in] */ UINT index, + /* [in] */ ByRef guid As GUID, + /* [out] */ ByRef VarVal As VARIANT) As HRESULT + virtual /* [local] */ HRESULT STDMETHODCALLTYPE GetDocumentation2( + /* [in] */ memid As MEMBERID, + /* [in] */ lcid As LCID, + /* [out] */ ByRef bstrHelpString As BSTR, + /* [out] */ ByRef dwHelpStringContext As DWord, + /* [out] */ ByRef bstrHelpStringDll As BSTR) As HRESULT + Function GetAllCustData( + /* [out] */ ByRef CustData As CUSTDATA) As HRESULT + Function GetAllFuncCustData( + /* [in] */ index As DWord, + /* [out] */ ByRef CustData As CUSTDATA) As HRESULT + Function GetAllParamCustData( + /* [in] */ indexFunc As DWord, + /* [in] */ indexParam As DWord, + /* [out] */ ByRef CustData As CUSTDATA) As HRESULT + Function GetAllVarCustData( + /* [in] */ index As DWord, + /* [out] */ ByRef CustData As CUSTDATA) As HRESULT + Function GetAllImplTypeCustData( + /* [in] */ index As DWord, + /* [out] */ ByRef CustData As CUSTDATA) As HRESULT +End Interface #endif /* __ITypeInfo2_INTERFACE_DEFINED__ */ +#ifdef __UNDECLARED__ #ifndef __ITypeLib_INTERFACE_DEFINED__ @@ -1516,31 +1492,30 @@ /* [unique][uuid][object] */ -TypeDef /* [v1_enum] */ -enum tagSYSKIND - { SYS_WIN16 = 0, - SYS_WIN32 = SYS_WIN16 + 1, - SYS_MAC = SYS_WIN32 + 1, +/* [v1_enum] */ +Enum SYSKIND + SYS_WIN16 = 0 + SYS_WIN32 = SYS_WIN16 + 1 + SYS_MAC = SYS_WIN32 + 1 SYS_WIN64 = SYS_MAC + 1 - } SYSKIND; - -TypeDef /* [v1_enum] */ -enum tagLIBFLAGS - { LIBFLAG_FRESTRICTED = 0x1, - LIBFLAG_FCONTROL = 0x2, - LIBFLAG_FHIDDEN = 0x4, - LIBFLAG_FHASDISKIMAGE = 0x8 - } LIBFLAGS; +End Enum + +/* [v1_enum] */ +Enum LIBFLAGS + LIBFLAG_FRESTRICTED = &h1 + LIBFLAG_FCONTROL = &h2 + LIBFLAG_FHIDDEN = &h4 + LIBFLAG_FHASDISKIMAGE = &h8 +End Enum TypeDef /* [unique] */ ITypeLib *LPTYPELIB; -TypeDef struct tagTLIBATTR - { - GUID guid; - LCID lcid; - SYSKIND syskind; - WORD wMajorVerNum; - WORD wMinorVerNum; - WORD wLibFlags; - } TLIBATTR; +Type TLIBATTR + guid As GUID + lcid As LCID + syskind As SYSKIND + wMajorVerNum As Word + wMinorVerNum As Word + wLibFlags As Word +End Type TypeDef struct tagTLIBATTR *LPTLIBATTR; Index: /Include/api_window.sbp =================================================================== --- /Include/api_window.sbp (revision 76) +++ /Include/api_window.sbp (revision 77) @@ -204,6 +204,8 @@ ' Window API -Declare Function AdjustWindowRect Lib "user32"(ByRef Rect As RECT, dwStyle As DWord, bMenu As BOOL) As BOOL -Declare Function AdjustWindowRectEx Lib "user32"(ByRef Rect As RECT, dwStyle As DWord, bMenu As BOOL, dwExStyle As DWord) As BOOL +Declare Function AdjustWindowRect Lib "user32" (ByRef Rect As RECT, dwStyle As DWord, bMenu As BOOL) As BOOL +Declare Function AdjustWindowRectEx Lib "user32" (ByRef Rect As RECT, dwStyle As DWord, bMenu As BOOL, dwExStyle As DWord) As BOOL +Declare Function AnyPopup Lib "user32" () As BOOL +Declare Function ArrangeIconicWindows Lib "user32" (hWnd As HWND) As DWord Type PAINTSTRUCT @@ -215,5 +217,5 @@ rgbReserved(31) As Byte End Type -Declare Function BeginPaint Lib "user32" (hWnd As HWND, ByRef lpPaint As PAINTSTRUCT) As HDC +Declare Function BeginPaint Lib "user32" (hWnd As HWND, ByRef Paint As PAINTSTRUCT) As HDC Declare Function BringWindowToTop Lib "user32" (hWnd As HWND) As Long @@ -800,5 +802,5 @@ Declare Function RedrawWindow Lib "user32" (hWnd As HWND, ByRef lprcUpdate As RECT, hrgnUpdate As HRGN, flags As DWord) As BOOL -Declare Function RegisterClassEx Lib "user32" Alias "RegisterClassExA" (ByRef lpwcx As WNDCLASSEX) As BOOL +Declare Function RegisterClassEx Lib "user32" Alias "RegisterClassExA" (ByRef wcx As WNDCLASSEX) As ATOM Declare Function RegisterClipboardFormat Lib "user32" Alias "RegisterClipboardFormatA" (lpszFormat As PCSTR) As DWord Declare Function RegisterWindowMessage Lib "user32" Alias "RegisterWindowMessageA" (lpString As PCSTR) As DWord @@ -809,10 +811,10 @@ Declare Function TranslateMessage Lib "user32" (ByRef lpMsg As MSG) As Long Declare Function ScreenToClient Lib "user32" (hWnd As HWND, ByRef lpPoint As POINTAPI) As BOOL -Declare Function ScrollDC Lib "user32" (hdc As HDC, dx As Long, dy As Long, ByRef lprcScroll As RECT, ByRef lprcClip As RECT, hrgnUpdate As HRGN, ByRef lprcUpdate As RECT) As BOOL +Declare Function ScrollDC Lib "user32" (hdc As HDC, dx As Long, dy As Long, ByRef rcScroll As RECT, ByRef rcClip As RECT, hrgnUpdate As HRGN, ByRef rcUpdate As RECT) As BOOL Const SW_SCROLLCHILDREN = &H0001 Const SW_INVALIDATE = &H0002 Const SW_ERASE = &H0004 -Declare Function ScrollWindowEx Lib "user32" (hWnd As HWND, dx As Long, dy As Long, ByRef lprcScroll As RECT, ByRef lprcClip As RECT, hrgnUpdate As HRGN, ByRef lprcUpdate As RECT, flags As DWord) As BOOL +Declare Function ScrollWindowEx Lib "user32" (hWnd As HWND, 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 BOOL Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (hDlg As HWND, nIDDlgItem As Long, Msg As DWord, wParam As WPARAM, lParam As LPARAM) As LRESULT Index: /Include/windows/WindowHandle.sbp =================================================================== --- /Include/windows/WindowHandle.sbp (revision 76) +++ /Include/windows/WindowHandle.sbp (revision 77) @@ -1,4 +1,32 @@ #ifndef __WINDOWSHANDLE_SBP__ #define __WINDOWSHANDLE_SBP__ + +#ifdef _WIN64 +Declare Function _System_GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" (hWnd As HWND, nIndex As Long) As LONG_PTR +Declare Function _System_SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" (hWnd As HWND, nIndex As Long, l As LONG_PTR) As LONG_PTR +#else +Declare Function _System_GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (hWnd As HWND, nIndex As Long) As LONG_PTR +Declare Function _System_SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (hWnd As HWND, nIndex As Long, l As LONG_PTR) As LONG_PTR +#endif +Declare Function _System_GetParent Lib "user32" Alias "GetParent" (hWnd As HWND) As HWND +Declare Function _System_SetParent Lib "user32" Alias "SetParent" (hWnd As HWND) As HWND +Declare Function _System_GetMenu Lib "user32" Alias "GetMenu" (hWnd As HWND) As HMENU +Declare Function _System_SetMenu Lib "user32" Alias "SetMenu" (hWnd As HWND) As HMENU +Declare Function _System_InvalidateRect Lib "user32" Alias "InvalidateRect" (hWnd As HWND, ByRef Rect As RECT, bErase As BOOL) As BOOL +Declare Function _System_InvalidateRgn Lib "user32" Alias "InvalidateRgn" (hWnd As HWND, hRgn As HRGN, bErase As BOOL) As BOOL +Declare Function _System_ValidateRect Lib "user32" Alias "ValidateRect" (hWnd As HWND, ByRef Rect As RECT) As BOOL +Declare Function _System_ValidateRgn Lib "user32" Alias "ValidateRgn" (hWnd As HWND, hRgn As HRGN) As BOOL +Declare Function _System_BeginPaint Lib "user32" Alias "BeginPaint" (hWnd As HWND, ByRef ps As PAINTSTRUCT) As HDC +Declare Function _System_EndPaint Lib "user32" Alias "EndPaint" (hWnd As HWND, ByRef lpPaint As PAINTSTRUCT) As HDC +Declare Function _System_ClientToScreen Lib "user32" Alias "ClientToScreen" (hWnd As HWND, ByRef lpPoint As POINTAPI) As BOOL +Declare Function _System_ScreenToClient Lib "user32" Alias "ScreenToClient" (hWnd As HWND, ByRef lpPoint As POINTAPI) As BOOL +Declare Function _System_CreateCaret Lib "user32" Alias "CreateCaret" (hWnd As HWND, hBitmap As HBITMAP, nWidth As Long, nHeight As Long) As BOOL +Declare Function _System_HideCaret Lib "user32" Alias "HideCaret" (hWnd As HWND) As BOOL +Declare Function _System_ShowCaret Lib "user32" Alias "ShowCaret" (hWnd As HWND) As BOOL +Declare Function _System_DrawMenuBar Lib "user32" Alias "DrawMenuBar" (hwnd As HWND) As BOOL +Declare Function _System_GetWindowRect Lib "user32" Alias "DrawMenuBar" (hWnd As HWND, ByRef Rect As RECT) As BOOL +Declare Function _System_IsWindow Lib "user32" Alias "IsWindow" (hWnd As HWND) As BOOL +Declare Function _System_Isiconic Lib "user32" Alias "Isiconic" (hWnd As HWND) As BOOL +Declare Function _System_GetClientRect Lib "user32" Alias "GetClientRect" (hWnd As HWND, ByRef lpRect As RECT) As BOOL Class WindowHandle @@ -21,34 +49,38 @@ End Sub - Function HWnd() As HWND + Const Function HWnd() As HWND Return hwnd End Function - Function Operator() As HWND + Const Function Operator() As HWND Return hwnd End Function + Function BringToTop() As BOOL + Return BringWindowToTop(hwnd) + End Function + Function BeginPaint(ByRef ps As PAINTSTRUCT) As HDC - Return BeginPaint(hwnd, ps) - End Function - - Function ChildFromPoint(x As Long, y As Long) As HWND + Return _System_BeginPaint(hwnd, ps) + End Function + + Const Function ChildFromPoint(x As Long, y As Long) As HWND Return ChildWindowFromPoint(hwnd, x, y) End Function - Function ChildFromPointEx(x As Long, y As Long, flags As DWord) As HWND + Const Function ChildFromPointEx(x As Long, y As Long, flags As DWord) As HWND Return ChildWindowFromPointEx(hwnd, x, y, flags) End Function - Function ClientToScreen(ByRef pt As POINTAPI) As BOOL - Return ClientToScreen(pt) + Const Function ClientToScreen(ByRef pt As POINTAPI) As BOOL + Return _System_ClientToScreen(hwnd, pt) End Function Function Close() As BOOL - Return CloseWindow() + Return CloseWindow(hwnd) End Function Function CreateCaret(hbmp As HBITMAP, width As Long, height As Long) As BOOL - Return CreateCaret(hwnd, hbmp, width, hegiht) + Return _System_CreateCaret(hwnd, hbmp, width, hegiht) End Function @@ -58,5 +90,5 @@ Function DrawMenuBar() As BOOL - Return DrawMenuBar(hwnd) + Return _System_DrawMenuBar(hwnd) End Function @@ -70,8 +102,8 @@ Function EndPaint(ByRef ps As PAINTSTRUCT) As BOOL - Return EndPaint(hwnd, ps) - End Function - - Function EnumChilds(enumFunc As WNDENUMPROC, lp As LPARAM) As BOOL + Return _System_EndPaint(hwnd, ps) + End Function + + Const Function EnumChilds(enumFunc As WNDENUMPROC, lp As LPARAM) As BOOL Return EnumChildWindows(hwnd, enumFunc, lp) End Function @@ -81,14 +113,18 @@ End Function - Function GetClassLongPtr(index As Long) As LONG_PTR + Const Function GetClassLongPtr(index As Long) As LONG_PTR Return GetClassLongPtr(hwnd, index) End Function - Function GetClassName(className As PSTR, maxCount As Long) As Long + Const Function GetClassName(className As PSTR, maxCount As Long) As Long Return GetClassName(className, maxCount) End Function - Function GetClientRect(ByRef rc As RECT) As BOOL - Return GetClientRect(hwnd, rc) + Const Function GetClientRect(ByRef rc As RECT) As BOOL + Return _System_GetClientRect(hwnd, rc) + End Function + + Const Function GetContextHelpId() As DWord + Return GetWindowContextHelpId(hwnd) End Function @@ -101,58 +137,51 @@ End Function - Function GetDlgCtrlID() As Long + Const Function GetDlgCtrlID() As Long Return GetDlgCtrlID(hwnd) End Function - Function GetDlgItem(idDlgItem As Long) As WindowHandle + Const Function GetDlgItem(idDlgItem As Long) As WindowHandle Return GetDlgItem(hwnd, idDlgItem) End Function - Function GetDlgItemText(idDlgItem As Long, ps As PSTR, maxCount As Long) As Long + Const Function GetDlgItemText(idDlgItem As Long, ps As PSTR, maxCount As Long) As Long Return GetDlgItemText(hwnd, idDlgItem, ps, maxCount) End Function - Function GetMenu() As HMENU - Return GetMenu(hwnd) - End Function - - Function GetParent() As WindowHandle - Return GetParent(hwnd) - End Function - - Function GetProp(psz As PCSTR) As HANDLE + Const Function GetMenu() As HMENU + Return _System_GetMenu(hwnd) + End Function + + Const Function GetParent() As WindowHandle + Dim w As WindowHandle(_System_GetParent(hwnd)) + Return w + End Function + + Const Function GetProp(psz As PCSTR) As HANDLE Return GetProp(hwnd, psz) End Function - Function GetProp(atom As ATOM) As HANDLE + Const Function GetProp(atom As ATOM) As HANDLE Return GetProp(hwnd, atom As ULONG_PTR As PCSTR) End Function - Function GetScrollInfo(fnBar As Long, ByRef si As SCROLLINFO) As BOOL + Const Function GetScrollInfo(fnBar As Long, ByRef si As SCROLLINFO) As BOOL Return GetScrollInfo(hwnd, fnBar, si) End Function - Function GetSystemMenu(revert As BOOL) As HMENU + Const Function GetSystemMenu(revert As BOOL) As HMENU Return GetSystemMenu(hwnd, revert) End Function - Function GetUpdateRect(ByRef rc As RECT, erase As BOOL) As BOOL + Const Function GetUpdateRect(ByRef rc As RECT, erase As BOOL) As BOOL Return GetUpdateRact(hwnd, rc, erase) End Function - Function GetUpdateRgn(hrgn As HRGN, erase As BOOL) As BOOL + Const Function GetUpdateRgn(hrgn As HRGN, erase As BOOL) As BOOL Return GetUpdateRgn(hwnd, hrgn, erase) End Function - Function GetWindow(cmd As DWord) As WindowHandle + Const Function GetWindow(cmd As DWord) As WindowHandle Return GetWindow(hwnd, cmd) - End Function - - Function GetWindowPlacement(ByRef wndpl As WINDOWPLACEMENT) As BOOL - Return GetWindowPlacement(hwnd, wndpl) - End Function - - Function GetContextHelpId() As DWord - Return GetWindowContextHelpId(hwnd) End Function @@ -161,89 +190,89 @@ End Function - Function GetWindowLongPtr(index As Long) As LONG_PTR - Return GetWindowLongPtr(hwnd, index) - End Function - - Function GetWindowPlasement(ByRef wndpl As WINDOWPLACEMENT) As BOOL + Const Function GetWindowLongPtr(index As Long) As LONG_PTR + Return _System_GetWindowLongPtr(hwnd, index) + End Function + + Const Function GetWindowPlasement(ByRef wndpl As WINDOWPLACEMENT) As BOOL Return GetWindowPlasement(hwnd, wndpl) End Function - Function GetWindowRect(ByRef rc As RECT) As BOOL - Return GetWindowRect(rc) - End Function - - Function GetText(ps As PSTR, maxCount As Long) As BOOL + Const Function GetWindowRect(ByRef rc As RECT) As BOOL + Return _System_GetWindowRect(rc) + End Function + + Const Function GetText(ps As PSTR, maxCount As Long) As BOOL Return GetWindowText(ps, maxCount) End Function - Function GetTextLength() As Long + Const Function GetTextLength() As Long Return GetWindowTextLength(hwnd) End Function - Function GetWindowThreadId() As DWord + Const Function GetWindowThreadId() As DWord Return GetWindowProcessThreadId(hwnd, 0) End Function - Function GetWindowProcessThreadId(ByRef processId As DWord) As DWord + Const Function GetWindowProcessThreadId(ByRef processId As DWord) As DWord Return GetWindowProcessThreadId(hwnd, processId) End Function Function HideCaret() As BOOL - Return HideCaret(hwnd) + Return _System_HideCaret(hwnd) End Function Function InvalidateRect(ByRef rc As RECT, erace As BOOL) As BOOL - Return InvalidateRect(hwnd, rc, erace) + Return _System_InvalidateRect(hwnd, rc, erace) End Function Function InvalidateRect(ByRef rc As RECT) As BOOL - Return InvalidateRect(hwnd, rc, TRUE) + Return _System_InvalidateRect(hwnd, rc, TRUE) End Function Function InvalidateRgn(hrgn As HRGN, erace As BOOL) As BOOL - Return InvalidateRgn(hwnd, hrgn, erace) + Return _System_InvalidateRgn(hwnd, hrgn, erace) End Function Function InvalidateRgn(hrgn As HRGN) As BOOL - Return InvalidateRgn(hwnd, hrgn, TRUE) + Return _System_InvalidateRgn(hwnd, hrgn, TRUE) End Function Function Invalidate(erace As BOOL) As BOOL - Return InvalidateRect(hwnd, ByVal 0, erace) + Return _System_InvalidateRect(hwnd, ByVal 0, erace) End Function Function Invalidate() As BOOL - Return InvalidateRect(hwnd, ByVal 0, TRUE) - End Function - - Function IsChild(hwnd As HWND) As BOOL + Return _System_InvalidateRect(hwnd, ByVal 0, TRUE) + End Function + + Const Function IsChild(hwnd As HWND) As BOOL Return IsChild(This.hwnd, hwnd) End Function - Function IsDialogMessage(ByRef msg As MSG) As BOOL + Const Function IsDialogMessage(ByRef msg As MSG) As BOOL Return IsDialogMessage(hwnd, msg) End Function - Function IsIconic() As BOOL - Return IsIconic(hwnd) - End Function - - Function IsWindow() As BOOL - Return IsWindow(hwnd) - End Function - - Function IsEnabled() As BOOL + Const Function IsIconic() As BOOL + Return _System_IsIconic(hwnd) + End Function + + Const Function IsWindow() As BOOL + Return _System_IsWindow(hwnd) + End Function + + Const Function IsEnabled() As BOOL Return IsWindowEnabled(hwnd) End Function - Function IsUnicode() As BOOL + Const Function IsUnicode() As BOOL Return IsWindowUnicode(hwnd) End Function - Function IsVisible() As BOOL + Const Function IsVisible() As BOOL Return IsWindowVisible(hwnd) End Function - Function IsZoomed() As BOOL + Const Function IsZoomed() As BOOL Return IsZoomed(hwnd) End Function @@ -265,25 +294,25 @@ End Function - Function MessageBox(text As PCSTR, caption As PCSTR, uType As DWord) As Long + Const Function MessageBox(text As PCSTR, caption As PCSTR, uType As DWord) As Long Return MessageBox(hwnd, text, caption, uType) End Function - Function MessageBox(text As PCSTR, caption As PCSTR) As Long + Const Function MessageBox(text As PCSTR, caption As PCSTR) As Long Return MessageBox(hwnd, text, caption, MB_OK) End Function - Function MessageBox(text As PCSTR) As Long + Const Function MessageBox(text As PCSTR) As Long Return MessageBox(hwnd, text, 0, MB_OK) End Function - Function MoveWindow(x As Long, y As Long, width As Long, height As Long, repaint As BOOL) As BOOL + Function Move(x As Long, y As Long, width As Long, height As Long, repaint As BOOL) As BOOL Return MoveWindow(hwnd, x, y, width, height, repaint) End Function - Function MoveWindow(x As Long, y As Long, width As Long, height As Long) As BOOL + Function Move(x As Long, y As Long, width As Long, height As Long) As BOOL Return MoveWindow(hwnd, x, y, width, height, TRUE) End Function - Function MoveWindow(ByRef rc As RECT, repeaint As BOOL) As BOOL + Function Move(ByRef rc As RECT, repeaint As BOOL) As BOOL With rc Return MoveWindow(hwnd, .left, .top, .right - .left, .bottom - .top, repaint) @@ -291,5 +320,5 @@ End Function - Function MoveWindow(ByRef rc As RECT) As BOOL + Function Move(ByRef rc As RECT) As BOOL With rc Return MoveWindow(hwnd, .left, .top, .right - .left, .bottom - .top, TRUE) @@ -329,6 +358,6 @@ End Function - Function ScreenToClient(ByRef pt As POINTAPI) As BOOL - Return ScreenToClient(hwnd, pt) + Const Function ScreenToClient(ByRef pt As POINTAPI) As BOOL + Return _System_ScreenToClient(hwnd, pt) End Function @@ -378,9 +407,9 @@ Function SetMenu(hmenu As HMENU) As BOOL - Return SetMenu(hwnd, hmenu) + Return _System_SetMenu(hwnd, hmenu) End Function Function SetParent(hwndNewParent As HWND) As HWND - Return SetParent(hwnd, hwndNewParent) + Return _System_SetParent(hwnd, hwndNewParent) End Function @@ -414,5 +443,5 @@ Function SetWindowLongPtr(index As Long, newLong As LONG_PTR) As LONG_PTR - Return SetWindowLongPtr(hwnd, index, newLong) + Return _System_SetWindowLongPtr(hwnd, index, newLong) End Function @@ -443,4 +472,8 @@ End Function + Function ShowCaret() As BOOL + Return _System_ShowCaret(hwnd) + End Function + Function ShowScrollBar(bar As DWord, show As BOOL) As BOOL Return ShowScrollBar(hwnd, bar, show) @@ -464,58 +497,58 @@ Function ValidateRect(ByRef rc As RECT) As BOOL - Return ValidateRect(hwnd, rc) + Return _System_ValidateRect(hwnd, rc) End Function Function ValidateRgn(hrgn As HRGN) As BOOL - Return ValidateRgn(hwnd, hrgn) + Return _System_ValidateRgn(hwnd, hrgn) End Function Function Validate() As BOOL - Return ValidateRect(hwnd, ByVal 0) + Return _System_ValidateRect(hwnd, ByVal 0) End Function ' Get/SetWindowLongPtr Wrappers - Function GetExStyle() As DWord - Return GetWindowLongPtr(hwnd, GWL_EXSTYLE) As DWord - End Function - - Function GetStyle() As DWord - Return GetWindowLongPtr(hwnd, GWL_STYLE) As DWord - End Function - - Function GetWndProc() As WNDPROC - Return GetWindowLongPtr(hwnd, GWLP_HINSTANCE) As WNDPROC - End Function - - Function GetInstance() As HINSTANCE - Return GetWindowLongPtr(hwnd, GWLP_HINSTANCE) As HINSTANCE - End Function - - Function GetUserData() As LONG_PTR - Return GetWindowLongPtr(hwnd, GWLP_USERDATA) + Const Function GetExStyle() As DWord + Return _System_GetWindowLongPtr(hwnd, GWL_EXSTYLE) As DWord + End Function + + Const Function GetStyle() As DWord + Return _System_GetWindowLongPtr(hwnd, GWL_STYLE) As DWord + End Function + + Const Function GetWndProc() As WNDPROC + Return _System_GetWindowLongPtr(hwnd, GWLP_HINSTANCE) As WNDPROC + End Function + + Const Function GetInstance() As HINSTANCE + Return _System_GetWindowLongPtr(hwnd, GWLP_HINSTANCE) As HINSTANCE + End Function + + Const Function GetUserData() As LONG_PTR + Return _System_GetWindowLongPtr(hwnd, GWLP_USERDATA) End Function Function SetExStyle(style As DWord) As DWord - Return SetWindowLongPtr(hwnd, GWL_EXSTYLE, style) As DWord + Return _System_SetWindowLongPtr(hwnd, GWL_EXSTYLE, style) As DWord End Function Function SetStyle(style As DWord) As DWord - Return SetWindowLongPtr(hwnd, GWL_STYLE, style) As DWord + Return _System_SetWindowLongPtr(hwnd, GWL_STYLE, style) As DWord End Function Function SetWndProc(wndProc As WNDPROC) As WNDPROC - Return SetWindowLongPtR(hwnd, GWLP_WNDPROC, wndProc As WNDPROC) As WNDPROC + Return _System_SetWindowLongPtR(hwnd, GWLP_WNDPROC, wndProc As WNDPROC) As WNDPROC End Function Function SetUserData(value As LONG_PTR) As LONG_PTR - Return SetWindowLongPtr(value As LONG_PTR) + Return _System_SetWindowLongPtr(value As LONG_PTR) End Function ' Propaties - Function ClientRect() As RECT + Const Function ClientRect() As RECT Dim rc As RECT - GetClientRect(hwnd, rc) + _System_GetClientRect(hwnd, rc) Return rc End Function @@ -532,7 +565,7 @@ End Sub - Function WindowRect() As RECT + Const Function WindowRect() As RECT Dim rc As RECT - GetWindowRect(hwnd, rc) + _System_GetWindowRect(hwnd, rc) Return rc End Function @@ -542,41 +575,42 @@ End Sub - Function ContextHelpID() As DWord + Const Function ContextHelpID() As DWord Return GetContextHelpId(hwnd) End Function Sub ContextHelpID(newID As DWord) - SetContextHelpId(hwnd, newId) - End Sub - - Function DlgCtrlID() As Long + _System_SetContextHelpId(hwnd, newId) + End Sub + + Const Function DlgCtrlID() As Long Return GetDlgCtrlID(hwnd) End Function Sub DlgCtrlId(newId As Long) - SetWindowLongPtr(hwnd, GWLP_ID, newId) + _System_SetWindowLongPtr(hwnd, GWLP_ID, newId) End Sub Function DlgItem(idDlgItem As Long) As WindowHandle - Return GetDlgItem(hwnd, idDlgItem) - End Function - - Function ExStyle() As DWord - Return GetWindowLongPtr(hwnd, GWL_EXSTYLE) As DWord + Dim w As WindowHandle(GetDlgItem(hwnd, idDlgItem)) + Return w + End Function + + Const Function ExStyle() As DWord + Return _System_GetWindowLongPtr(hwnd, GWL_EXSTYLE) As DWord End Function Sub ExStyle(newExStyle As DWord) - SetWindowLongPtr(hwnd, GWL_EXSTYLE, newExStyle) - End Sub - - Function Style() As DWord - Return GetWindowLongPtr(hwnd, GWL_STYLE) As DWord + _System_SetWindowLongPtr(hwnd, GWLP_EXSTYLE, newExStyle) + End Sub + + Const Function Style() As DWord + Return _System_GetWindowLongPtr(hwnd, GWL_STYLE) As DWord End Function Sub Style(newStyle As DWord) DWord - SetWindowLongPtr(hwnd, GWL_STYLE, newStyle) - End Sub - - Function Enabled() As BOOL + _System_SetWindowLongPtr(hwnd, GWLP_STYLE, newStyle) + End Sub + + Const Function Enabled() As BOOL Return IsWindowEnabled(hwnd) End Function @@ -586,5 +620,5 @@ End Sub - Function Font() As HFONT + Const Function Font() As HFONT Return SendMessage(hwnd, WM_GETFONT, 0, 0) As HFONT End Function @@ -594,5 +628,5 @@ End Sub - Function Maximized() As BOOL + Const Function Maximized() As BOOL Return IsIconic(hwnd) End Function @@ -606,5 +640,5 @@ End Sub - Function Minimized() As BOOL + Const Function Minimized() As BOOL Return IsIconic(hwnd) End Function @@ -618,35 +652,35 @@ End Sub - Function Instance() As HINSTANCE - Return GetWindowLongPtr(hwnd, GWLP_HINSTANCE) As HINSTANCE + Const Function Instance() As HINSTANCE + Return _System_GetWindowLongPtr(hwnd, GWLP_HINSTANCE) As HINSTANCE End Function ' IsWindow, IsUnicodeはメソッドと同じ。 - Function Parent() As WindowHandle - Return GetParent(hwnd) + Const Function Parent() As WindowHandle + Return _System_GetParent(hwnd) End Function Sub Parent(hwndNewParent As HWND) - SetParent(hwnd, hwndNewParent) - End Sub - - Function ProcessID() As DWord + _System_SetParent(hwnd, hwndNewParent) + End Sub + + Const Function ProcessID() As DWord GetWindowProcessThreadId(ProcessID) End Function - Function ThreadID() As DWord + Const Function ThreadID() As DWord Return GetWindowProcessThreadId(ByVal 0) End Function - Function Menu() As HMENU - Return GetMenu(hwnd) + Const Function Menu() As HMENU + Return _System_GetMenu(hwnd) End Function Sub Menu(hmenuNew As HMENU) - SetMenu(hwnd, hmenuNew) - End Sub - - Function Text() As String + _System_SetMenu(hwnd, hmenuNew) + End Sub + + Const Function Text() As String With Text .ReSize(GetWindowTextLength(hwnd)) @@ -659,17 +693,17 @@ End Sub - Function TextLength() As Long + Const Function TextLength() As Long Return GetWindowTextLength(hwnd) End Function - Function UserData() As LONG_PTR - Return GetWindowLongPtr(hwnd, GWLP_USERDATA) + Const Function UserData() As LONG_PTR + Return _System_GetWindowLongPtr(hwnd, GWLP_USERDATA) End Function Sub UserData(newValue As LONG_PTR) - SetWindowLongPtr(hwnd, GWLP_USERDATA, newValue) - End Sub - - Function Visible() As BOOL + _System_SetWindowLongPtr(hwnd, GWLP_USERDATA, newValue) + End Sub + + Const Function Visible() As BOOL Return IsVisible(hwnd) End Function @@ -683,5 +717,5 @@ End Sub - Function WindowPlacement() As WINDOWPLACEMENT + Const Function WindowPlacement() As WINDOWPLACEMENT WindowPlacement.length = Len(WindowPlacement) GetWindowPlacement(hwnd, WindowPlacement) @@ -692,10 +726,10 @@ End Sub - Function WndProc() As WNDPROC - Return GetWindowLongPtr(hwnd, GWLP_HINSTANCE) As WNDPROC + Const Function WndProc() As WNDPROC + Return _System_GetWindowLongPtr(hwnd, GWLP_HINSTANCE) As WNDPROC End Function Sub WndProc(newWndProc As WNDPROC) - SetWindowLongPtr(hwnd, GWLP_WNDPROC, newWndProc As LONG_PTR) + _System_SetWindowLongPtr(hwnd, GWLP_WNDPROC, newWndProc As LONG_PTR) End Sub