Changeset 223


Ignore:
Timestamp:
Apr 30, 2007, 1:56:57 PM (18 years ago)
Author:
イグトランス (egtra)
Message:

Controlがコンパイルできるように修正

Location:
Include
Files:
1 added
18 edited

Legend:

Unmodified
Added
Removed

  • Include/Classes/System/Drawing/Point.ab

    r212 r223  
    44#define __SYSTEM_DRAWING_POINT_AB__
    55
    6 #include <Classes/System/Drawing/PointF.ab>
    7 #include <Classes/System/Drawing/Size.ab>
    8 #include <Classes/System/Drawing/SizeF.ab>
     6#require <Classes/System/Drawing/PointF.ab>
     7#require <Classes/System/Drawing/Size.ab>
     8#require <Classes/System/Drawing/SizeF.ab>
    99
    1010Class Point
    … …  
    2020    End Sub
    2121
    22     Sub Point(pt As Point)
    23         x = pt.x
    24         y = pt.y
    25     End Sub
    26 
    27     Sub Point(ByRef sz As Size)
     22    Sub Point(sz As Size)
    2823        x = sz.Width
    2924        y = sz.Height
    … …  
    5449        Return x = 0 And y = 0
    5550    End Function
    56 /*
    57     Sub Operator = (ByRef pt As Point)
    58         x = pt.x
    59         y = pt.y
    60     End Sub
    61 */
     51
    6252    Function Operator + (pt As Point) As Point
    6353        Return Add(This, pt)

  • Include/Classes/System/Drawing/Rectangle.ab

    r212 r223  
    44#define __SYSTEM_DRAWING_RECTANGLE_AB__
    55
    6 #include <Classes/System/Math.ab>
    7 #include <Classes/System/Drawing/RectangleF.ab>
    8 #include <Classes/System/Drawing/Point.ab>
    9 #include <Classes/System/Drawing/Size.ab>
     6#require <Classes/System/Math.ab>
     7#require <Classes/System/Drawing/RectangleF.ab>
     8#require <Classes/System/Drawing/Point.ab>
     9#require <Classes/System/Drawing/Size.ab>
    1010
    1111Class Rectangle
    … …  
    3232    End Sub
    3333
    34     Sub Rectangle(ByRef r As Rectangle)
    35         x = r.x
    36         y = r.y
    37         width = r.width
    38         height = r.height
    39     End Sub
    40 
    4134    Sub Rectangle(ByRef r As RECT)
    42         This = FromLTRB(r.left, r.top, r.right, r.bottom)
     35        x = r.left
     36        y = r.top
     37        width = r.right - r.left
     38        height = r.top - r.bottom
    4339    End Sub
    4440
    … …  
    111107
    112108    Function IsEmpty() As Boolean
    113         If Width <= 0 Or Height <= 0 Then
    114             IsEmpty = _System_TRUE
    115         Else
    116             IsEmpty = _System_FALSE
    117         End If
    118     End Function
    119 /*
    120     Function Operator = (rc As Rectangle)
    121         With rc
    122             x = .x
    123             y = .y
    124             width = .width
    125             height = .height
    126         End With
    127     End Function
    128 */
     109        Return Width <= 0 Or Height <= 0
     110    End Function
     111
    129112    Function Operator == (rc As Rectangle)
    130113        Return Equals(rc)
    … …  
    140123
    141124    Function Equals(rc As Rectangle) As Boolean
    142         If X = rc.X And Y = rc.Y And Width = rc.Width And Height = rc.Height Then
    143             Return True
    144         Else
    145             Return False
    146         End If
     125        Return X = rc.X And Y = rc.Y And Width = rc.Width And Height = rc.Height
    147126    End Function
    148127
    149128    Override Function GetHashCode() As Long
    150         Return x Xor _System_BSwap(y) Xor width Xor _System_BSwap(height)
     129        Return x As DWord Xor _System_BSwap(y As DWord) Xor width As DWord Xor _System_BSwap(height As DWord)
    151130    End Function
    152131
    153132    Static Function FromLTRB(l As Long, t As Long, r As Long, b As Long) As Rectangle
    154         return New Rectangle(l, t, r - l, r - b)
     133        return New Rectangle(l, t, r - l, b - t)
    155134    End Function
    156135
    157136    Function Contains(x As Long, y As Long) As Boolean
    158         If x >= X And x < X + Width And y >= Y And y < Y + Height Then
    159             Return True
    160         Else
    161             Return False
    162         End If
     137        Return x >= X And x < X + Width And y >= Y And y < Y + Height
    163138    End Function
    164139
    … …  
    168143
    169144    Function Contains(rc As Rectangle) As Boolean
    170         If X <= rc.X And rc.Right <= Right And Y <= rc.Y And rc.Bottom <= Bottom Then
    171             Return True
    172         Else
    173             Return False
    174         End If
     145        Return X <= rc.X And rc.Right <= Right And Y <= rc.Y And rc.Bottom <= Bottom
    175146    End Function
    176147
    … …  
    205176
    206177    Function IntersectsWith(rc As Rectangle) As Boolean
    207         If Left < rc.Right And _
     178        Return Left < rc.Right And _
    208179            Top < rc.Bottom And _
    209180            Right > rc.Left And _
    210             Bottom > rc.Top Then
    211             Return True
    212         Else
    213             Return False
    214         End If
     181            Bottom > rc.Top
    215182    End Function
    216183

  • Include/Classes/System/Drawing/Size.ab

    r212 r223  
    7777
    7878    Override Function GetHashCode() As Long
    79         Return width Xor _System_BSwap(height)
     79        Return width As DWord Xor _System_BSwap(height As DWord)
    8080    End Function
    8181

  • Include/Classes/System/Drawing/SizeF.ab

    r212 r223  
    6464*/
    6565    Function Equals(sz As SizeF) As Boolean
    66         If width = sz.width And height = sz.height Then
    67             Equals = _System_TRUE
    68         Else
    69             Equals = _System_FALSE
    70         End If
     66        Return width = sz.width And height = sz.height
    7167    End Function
    7268
    7369    Override Function GetHashCode() As Long
    7470        Return VarPtr(GetDWord(width)) Xor _System_BSwap(VarPtr(GetDWord(height)))
     71    End Function
    7572
    7673    Function IsEmpty() As Boolean
    77         If width = 0 And height = 0 Then
    78             Empty = _System_TRUE
    79         Else
    80             Empty = _System_FALSE
    81         End If
     74        Return width = 0 And height = 0
    8275    End Function
    8376

  • Include/Classes/System/Runtime/InteropServices/GCHandle.ab

    r208 r223  
    1212    Sub Target(obj As Object)
    1313        allocated.Add(obj)
     14        handle = GetPointer(VarPtr(obj))
    1415    End Sub
    1516
    … …  
    2425
    2526    Sub Free()
    26         Dim pobj = VarPtr(handle) As *Object
    2727        allocated.Remove(Target)
    2828        handle = 0
    … …  
    3030
    3131    Static Function ToIntPtr(h As GCHandle) As LONG_PTR
    32         Return h.handle As LONG_PTR Xor &hffffffff As LONG_PTR
     32        Return h.handle As LONG_PTR
    3333    End Function
    3434
    3535    Static Function FromIntPtr(ip As LONG_PTR) As GCHandle
    3636        FromIntPtr = New GCHandle
    37         FromIntPtr.handle = (ip Xor &hffffffff As LONG_PTR) As VoidPtr
     37        FromIntPtr.handle = ip As VoidPtr
    3838    End Function
    3939

  • Include/Classes/System/Windows/Forms/Control.ab

    r132 r223  
    44#define __SYSTEM_WINDOWS_FORMS_CONTROL_AB__
    55
    6 #include <windows/WindowHandle.sbp>
    7 #include <Classes/System/Windows/Forms/misc.ab>
    8 #include <Classes/System/Windows/Forms/CreateParams.ab>
    9 #include <Classes/System/Windows/Forms/Message.ab>
    10 #include <Classes/System/Windows/Forms/PaintEventArgs.ab>
    11 #include <Classes/System/misc.ab>
    12 #include <Classes/System/Math.ab>
    13 #include <Classes/System/Threading/WaitHandle.ab>
    14 #include <Classes/System/Drawing/Color.ab>
    15 #include <Classes/System/Drawing/Point.ab>
    16 #include <Classes/System/Drawing/Size.ab>
    17 #include <Classes/System/Drawing/Rectangle.ab>
     6#require <windows/WindowHandle.sbp>
     7#require <Classes/System/Windows/Forms/misc.ab>
     8#require <Classes/System/Windows/Forms/CreateParams.ab>
     9#require <Classes/System/Windows/Forms/Message.ab>
     10#require <Classes/System/Windows/Forms/PaintEventArgs.ab>
     11#require <Classes/System/misc.ab>
     12#require <Classes/System/Math.ab>
     13#require <Classes/System/Threading/WaitHandle.ab>
     14#require <Classes/System/Drawing/Color.ab>
     15#require <Classes/System/Drawing/Point.ab>
     16#require <Classes/System/Drawing/Size.ab>
     17#require <Classes/System/Drawing/Rectangle.ab>
     18#require <Classes/System/Runtime/InteropServices/GCHandle.ab>
     19
     20TypeDef InvokeProc = *Function(p As VoidPtr) As VoidPtr
    1821
    1922Class AsyncResultForInvoke
    … …  
    2528    End Sub
    2629
    27     Override Function AsyncState() As *IObject
    28         Return 0
    29     End Function
    30 
    31     Override Function AsyncWaitHandle() As *WaitHandle
    32         Return VarPtr(AsyncWaitHandle)
     30    Override Function AsyncState() As IObject
     31        Return Nothing
     32    End Function
     33
     34    Override Function AsyncWaitHandle() As WaitHandle
     35        Return waitHandle
    3336    End Function
    3437
    … …  
    3841
    3942    Override Function IsCompleted() As BOOL
    40         Return AsyncWaitHandle()->WaitOne(0, FALSE)
     43        Return waitHandle.WaitOne(0, FALSE)
    4144    End Function
    4245
    … …  
    5659Class AsyncInvokeData
    5760Public
    58     FuncPtr As *Function(p As VoidPtr) As VoidPtr
     61    FuncPtr As InvokeProc
    5962    Data As *VoidPtr
    60     AsyncResult As *AsyncResultForInvoke
     63    AsyncResult As AsyncResultForInvoke
    6164End Class
    6265
    6366Class Control
    64     Inherits IWin32Window
     67'   Inherits IWin32Window
    6568Public
    6669    '---------------------------------------------------------------------------
    6770    ' Public Properties
    6871
    69     Function AllowDrop() As BOOL
    70     End Function
    71 
    72     Override Function Handle() As HWND
     72    Function AllowDrop() As Boolean
     73    End Function
     74
     75    /*Override*/ Function Handle() As HWND
    7376        Return wnd.HWnd
    7477    End Function
    7578
    7679    ' IDropTargetを実装するのでDragAcceptFiles関数は呼ばない。
    77     Sub AllowDrop(a As BOOL)
    78     End Sub
    79 
    80     Const Function Visible() As BOOL
     80    Sub AllowDrop(a As Boolean)
     81    End Sub
     82
     83    Const Function Visible() As Boolean
    8184        Return wnd.Visible
    8285    End Function
    8386
    84     Sub Visible(v As BOOL)
     87    Sub Visible(v As Boolean)
    8588        wnd.Visible(v)
    8689    End Sub
    … …  
    9699    End Sub
    97100
    98     Const Function Enabled() As BOOL
     101    Const Function Enabled() As Boolean
    99102        Return wnd.Enabled
    100103    End Function
    101104
    102     Sub Enabled(e As BOOL)
     105    Sub Enabled(e As Boolean)
    103106        ' OnEnabledChangedはWM_ENABLE経由で呼ばれる
    104107        wnd.Enabled(e)
    … …  
    108111        Dim wr As RECT
    109112        wr = wnd.WindowRect
    110         Dim r As Rectangle(wr)
     113        Dim r = New Rectangle(wr)
    111114        Dim parent = Parent
    112         If parent <> 0 Then
     115        If Object.ReferenceEquals(parent, Nothing) Then
    113116            Return parent->RectangleToClient(r)
    114117        Else
    … …  
    117120    End Function
    118121
    119     Sub Bounds(ByRef r As Rectangle)
     122    Sub Bounds(r As Rectangle)
    120123        SetBoundsCore(r.X, r.Y, r.Width, r.Height, BoundsSpecified.All)
    121124    End Sub
    … …  
    138141
    139142    Const Function ClientRectangle() As Rectangle
    140         Dim r As Rectangle(wnd.ClientRect)
    141         Return r
     143        Return New Rectangle(wnd.ClientRect)
    142144    End Function
    143145
    … …  
    191193
    192194    Const Function PointToScreen(p As Point) As Point
    193         wnd.ClientToScreen(ByVal VarPtr(p) As *POINTAPI)
    194         Return r
     195        PointToScreen = New Point
     196        ret.X = p.X
     197        ret.Y = p.Y
     198        wnd.ClientToScreen(ByVal VarPtr(PointToScreen) As *POINTAPI)
    195199    End Function
    196200
    197201    Const Function PointToClient(p As Point) As Point
    198         wnd.ScreenToClient(ByVal VarPtr(p) As *POINTAPI)
    199         Return r
    200     End Function
    201 
    202     Const Function RectangleToScreen(p As Rectangle) As Rectangle
    203         wnd.ClientToScreen(ByVal VarPtr(p) As *POINTAPI)
    204         Return p
    205     End Function
    206 
    207     Const Function RectangleToClient(p As Rectangle) As Rectangle
    208         wnd.ScreenToClient(ByVal VarPtr(p) As *POINTAPI)
    209         Return p
    210     End Function
    211 
    212     Const Function InvokeRequired() As BOOL
     202        PointToScreen = New Point
     203        ret.X = p.X
     204        ret.Y = p.Y
     205        wnd.ScreenToClient(ByVal VarPtr(PointToScreen) As *POINTAPI)
     206    End Function
     207
     208    Const Function RectangleToScreen(r As Rectangle) As Rectangle
     209        Dim rc = r.ToRECT
     210        wnd.ClientToScreen(rc)
     211        Return New Rectangle(rc)
     212    End Function
     213
     214    Const Function RectangleToClient(r As Rectangle) As Rectangle
     215        Dim rc As RECT
     216        rc = r.ToRECT()
     217        wnd.ScreenToClient(rc)
     218        Return New Rectangle(rc)
     219    End Function
     220
     221    Const Function InvokeRequired() As Boolean
    213222        Return wnd.ThreadID <> GetCurrentThreadId()
    214223    End Function
    … …  
    224233    End Sub
    225234
    226     Function Parent() As *Control
     235    Function Parent() As Control
    227236        Return parent
     237    End Function
     238
     239    Const Function IsHandleCreated() As Boolean
     240        Return wnd.HWnd <> 0
    228241    End Function
    229242
    … …  
    240253    End Sub
    241254
    242     Sub Control(ByRef text As String)
     255    Sub Control(text As String)
    243256        Dim sz = DefaultSize()
    244257        Control(text, 100, 100, sz.Width, sz.Height)
    245258    End Sub
    246259
    247     Sub Control(ByRef parent As Control, ByRef text As String)
     260    Sub Control(parent As Control, text As String)
    248261        Dim sz = DefaultSize()
    249262        Control(parent, text, 100, 100, sz.Width, sz.Height)
    250263    End Sub
    251264
    252     Sub Control(ByRef text As String, left As Long, top As Long, width As Long, height As Long)
     265    Sub Control(text As String, left As Long, top As Long, width As Long, height As Long)
    253266        This.text = text
    254267        bkColor = DefaultBackColor
    … …  
    257270    End Sub
    258271
    259     Sub Control(ByRef parent As Control, ByRef text As String, left As Long, top As Long, width As Long, height As Long)
     272    Sub Control(parent As Control, text As String, left As Long, top As Long, width As Long, height As Long)
    260273        This.parent = VarPtr(parent)
    261274        Control(text, left, top, width, height)
    … …  
    276289    ' 同期関数呼出、Controlが作成されたスレッドで関数を実行する。
    277290    ' 関数は同期的に呼び出されるので、関数が終わるまでInvokeは制御を戻さない。
    278     Function Invoke(pfn As *Function(p As VoidPtr) As VoidPtr, p As VoidPtr) As VoidPtr
     291    Function Invoke(pfn As InvokeProc, p As VoidPtr) As VoidPtr
    279292        Return wnd.SendMessage(WM_CONTROL_INVOKE, p As WPARAM, pfn As LPARAM) As VoidPtr
    280293    End Function
    … …  
    283296    ' 関数は非同期的に呼び出されるので、BeginInvokeはすぐに制御を戻す。
    284297    ' 後にEndInvokeを呼び出すことにより、関数の戻り値を受け取れる。
    285     ' 注意：現状の実装では必ずEndInvokeを呼び出す必要がある。
    286     Function BeginInvoke(pfn As *Function(p As VoidPtr) As VoidPtr, p As VoidPtr) As *IAsyncResult
     298    Function BeginInvoke(pfn As InvokeProc, p As VoidPtr) As IAsyncResult
    287299        ' EndInvokeがDeleteする
    288         Dim pAsyncResult = New AsyncResultForInvoke(CreateEvent(0, FALSE, FALSE, 0))
     300        Dim asyncResult = New AsyncResultForInvoke(CreateEvent(0, FALSE, FALSE, 0))
    289301        ' OnControlBeginInvokeがDeleteする
    290         Dim pAsyncInvokeData = New AsyncInvokeData
    291         With pAsyncInvokeData[0]
     302        Dim asyncInvokeData = New AsyncInvokeData
     303        With asyncInvokeData
    292304            .FuncPtr = pfn
    293305            .Data = p
    294             .AsyncResult = pAsyncResult
     306            .AsyncResult = asyncResult
    295307        End With
    296         wnd.PostMessage(WM_CONTROL_BEGININVOKE, 0, pAsyncInvokeData As LPARAM)
     308        Dim gch = GCHandle.Alloc(asyncInvokeData)
     309        wnd.PostMessage(WM_CONTROL_BEGININVOKE, 0, GCHandle.ToIntPtr(gch))
    297310        Return pAsyncResult
    298311    End Function
    … …  
    300313    ' BeginInvokeで呼び出した関数の戻り値を受け取る。
    301314    ' その関数がまだ終了していない場合、終了するまで待機する。
    302     Function EndInvoke(ar As *IAsyncResult) As VoidPtr
    303         ar->WaitHandle->WaitOne()
    304         Dim arInvoke = ar As *AsyncResultForInvoke
    305         Dim result = arInvoke->Result
    306         Delete arInvoke
    307         Return result
     315    Function EndInvoke(ar As IAsyncResult) As VoidPtr
     316        ar.WaitHandle.WaitOne()
     317        Dim arInvoke = ar As AsyncResultForInvoke
     318        Return arInvoke.Result
    308319    End Function
    309320
    310321    ' 与えられたウィンドウハンドルがControl（若しくはその派生クラス）の
    311322    ' インスタンスに対応するものであった場合、
    312     ' 元のインスタンスへのポインタを返す。
    313     ' そうでなければヌルポインタを返す。
    314     Static Function FromHandle(hwnd As HWND) As *Control
     323    ' 元のインスタンスを返す。
     324    ' そうでなければNothingを返す。
     325    Static Function FromHandle(hwnd As HWND) As Control
    315326        If IsWindow(hwnd) Then
    316             Dim className[19] As Byte 'Len (WindowClassName)
    317             GetClassName(hwnd, className, Len (className))
    318             If memcmp(className, WindowClassName, Len (WindowClassName)) = 0 Then
    319                 Return GetWindowLongPtr(hwnd, GWLP_THIS) As *Control
     327            If GetClassLongPtr(hwnd, GCW_ATOM) = atom Then
     328                Dim gch = GCHandle.FromIntPtr(GetWindowLongPtr(hwnd, GWLP_THIS))
     329                Return gch.Target As Control
    320330            End If
    321331        End If
    322         Return 0 As *Control
     332        Return Nothing As Control
    323333    End Function
    324334
    … …  
    327337    End Sub
    328338
    329     /*Override*/ Virtual Function ToString() As String
     339    Override Function ToString() As String
    330340        Return text
    331341    End Function
    … …  
    351361    '---------------------------------------------------------------------------
    352362    ' Protected Properties
    353 '   Const Virtual Function CanRaiseEvents() As BOOL
    354     Virtual Function CreateParams() As *CreateParams
    355         Return VarPtr(createParams)
     363'   Const Virtual Function CanRaiseEvents() As Boolean
     364    Virtual Function CreateParams() As CreateParams
     365        Return createParams
    356366    End Function
    357367
    … …  
    373383    Virtual Sub CreateHandle()
    374384        Dim createParams = CreateParams()
    375         TlsSetValue(tlsIndex, VarPtr(This))
     385        Dim gch = GCHandle.Alloc(This)
     386        TlsSetValue(tlsIndex, GCHandle.ToIntPtr(gch) As VoidPtr)
    376387        With createParams[0]
    377388            Dim hwndParent = 0 As HWND
    378             If parent <> 0 Then
    379                 hwndParent = parent->Handle
     389            If Not Object.ReferenceEquals(parent, Nothing) Then
     390                hwndParent = parent.Handle
    380391            End If
    381392            If CreateWindowEx(.ExStyle, atom As ULONG_PTR As PCSTR, text, .Style, _
    … …  
    383394                hwndParent, 0, hInstance, 0) = 0 Then
    384395                ' Error
    385                 Dim buf[1023] As Byte
    386                 wsprintf(buf, Ex"Control: CreateWindowEx failed. Error code: &h%08X\r\n", GetLastError())
     396                Dim buf[1023] As TCHAR
     397                wsprintf(buf, ToTCStr(Ex"Control: CreateWindowEx failed. Error code: &h%08X\r\n"), GetLastError())
    387398                OutputDebugString(buf)
    388399'               Debug
    … …  
    390401            End If
    391402        End With
    392     End Sub
    393 
    394     Virtual Sub DefWndProc(ByRef m As Message)
     403        gch.Free()
     404    End Sub
     405
     406    Virtual Sub DefWndProc(m As Message)
    395407        m.Result = DefWindowProc(m.HWnd, m.Msg, m.WParam, m.LParam)
    396408    End Sub
    397409
    398     Virtual Sub WndProc(ByRef m As Message)
     410    Virtual Sub WndProc(m As Message)
    399411        With m
    400412            Select Case .Msg
    … …  
    402414                    .Result = text.Length
    403415                Case WM_GETTEXT
    404                     Dim size = Math.Min(.WParam As ULONG_PTR, text.Length As ULONG_PTR + 1)
    405                     memcpy(.LParam As *Byte, text.StrPtr, size)
     416                    Dim size = Math.Min(.WParam As ULONG_PTR, (text.Length + 1) As ULONG_PTR)
     417                    memcpy(.LParam As PCTSTR, ToTCStr(text), size * SizeOf (TCHAR))
    406418                    .Result = size
    407419                Case WM_SETTEXT
    408                     text = .LParam As *Byte
     420                    text = New String(.LParam As PCTSTR)
    409421                Case WM_ENABLE
    410                     Dim e As EventArgs
    411                     OnEnabledChanged(e)
     422                    OnEnabledChanged(EventArgs.Empty)
    412423                Case WM_ERASEBKGND
    413424                    ' OnPaintBackgroundに移すべき
    … …  
    420431                    DeleteObject(hbr)
    421432                Case WM_CONTROL_INVOKE
    422                     Dim pfn As *Function(p As VoidPtr) As VoidPtr
    423                     pfn = .LParam As *Function(p As VoidPtr) As VoidPtr
     433                    Dim pfn = .LParam As InvokeProc
    424434                    .Result = pfn(m.WParam As VoidPtr) As LRESULT
    425435                Case WM_CONTROL_BEGININVOKE
    426436                    OnControlBeginInvoke(m)
     437                Case WM_CREATE
     438                    OnHandleCreated(EventArgs.Empty)
    427439                Case Else
    428440                    DefWndProc(m)
    … …  
    450462
    451463    Virtual Sub SetBoundsCore(x As Long, y As Long, width As Long, height As Long, bs As BoundsSpecified)
    452         If Not (bs As DWord And BoundsSpecified.X As DWord) Then
     464'       If Not (bs As DWord And BoundsSpecified.X As DWord) Then
    453465            x = Left
    454         End If
    455         If Not (bs As DWord And BoundsSpecified.Y As DWord) Then
     466'       End If
     467'       If Not (bs As DWord And BoundsSpecified.Y As DWord) Then
    456468            y = Right
    457         End If
    458         If Not (bs As DWord And BoundsSpecified.Width As DWord) Then
     469'       End If
     470'       If Not (bs As DWord And BoundsSpecified.Width As DWord) Then
    459471            width = Width
    460         End If
    461         If Not (bs As DWord And BoundsSpecified.Height As DWord) Then
     472'       End If
     473'       If Not (bs As DWord And BoundsSpecified.Height As DWord) Then
    462474            height = Height
    463         End If
     475'       End If
    464476        wnd.Move(x, y, width, height)
    465477    End Sub
    … …  
    471483    End Sub
    472484
    473     Virtual Sub OnPaintBackground(ByRef e As PaintEventArgs) : End Sub
    474     Virtual Sub OnEnabledChanged(ByRef e As EventArgs) : End Sub
    475     Virtual Sub OnBackColorChanged(ByRef e As EventArgs) : End Sub
    476     Virtual Sub OnTextChanged(ByRef e As EventArgs)
    477         wnd.SetText(text.StrPtr)
     485    Virtual Sub OnPaintBackground(e As PaintEventArgs) : End Sub
     486    Virtual Sub OnEnabledChanged(e As EventArgs) : End Sub
     487    Virtual Sub OnBackColorChanged(e As EventArgs) : End Sub
     488    Virtual Sub OnHandleCreated(e As EventArgs) : End Sub
     489    Virtual Sub OnTextChanged(e As EventArgs)
     490        wnd.SetText(ToTCStr(text))
    478491    End Sub
    479492
    … …  
    482495    wnd As WindowHandle
    483496    text As String
    484     parent As *Control
     497    parent As Control
    485498    bkColor As Color
    486499
    … …  
    496509    Static Const WM_CONTROL_BEGININVOKE = WM_USER + 1 As DWord
    497510
    498     Static Const WindowClassName = "ActiveBasic Control" As *Byte
     511    Static Const WindowClassName = "ActiveBasic Control"
    499512Public
    500513    Static Sub Initialize(hinst As HINSTANCE)
    … …  
    519532        atom = RegisterClassEx(wcx)
    520533        If atom = 0 Then
    521             Dim buf[1023] As Byte
    522             wsprintf(buf, Ex"Control: RegisterClasseEx failed. Error code: &h%08X\r\n", GetLastError())
     534            Dim buf[1023] As TCHAR
     535            wsprintf(buf, ToTCStr(Ex"Control: RegisterClasseEx failed. Error code: &h%08X\r\n"), GetLastError())
    523536            OutputDebugString(buf)
    524537            Debug
    … …  
    543556    ' Windowsから呼ばれるウィンドウプロシージャ。WndProc
    544557    Static Function WndProcFirst(hwnd As HWND, msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
    545         Dim pThis = Control.FromHandle(hwnd) As *Control
    546         If pThis = 0 Then
    547             pThis = TlsGetValue(tlsIndex)
     558        Dim rThis = Control.FromHandle(hwnd) As Control
     559        If Object.ReferenceEquals(rThis As Object, Nothing) Then
     560            Dim gchValue = TlsGetValue(tlsIndex) As LONG_PTR
     561            Dim gch = GCHandle.FromIntPtr(gchValue)
     562            rThis = gch.Target As Control
    548563            ' ウィンドウが作られて最初にWndProcFirstが呼ばれたとき
    549             TlsSetValue(tlsIndex, 0)
    550             If pThis = 0 Then
     564            If Object.ReferenceEquals(rThis, Nothing) Then
    551565                ' あってはならない事態
    552566                Debug
    … …  
    554568            End If
    555569'           Debug
    556             pThis->wnd = hwnd
    557             SetWindowLongPtr(hwnd, GWLP_THIS, pThis As LONG_PTR)
     570            rThis.wnd = New WindowHandle(hwnd)
     571            SetWindowLongPtr(hwnd, GWLP_THIS, gchValue)
    558572        End If
    559573        Dim m As Message
    560574        m = Message.Create(hwnd, msg, wp, lp)
    561         pThis->WndProc(m)
     575        rThis.WndProc(m)
    562576        Return m.Result
    563577    End Function
    564578
    565579    ' BeginInvokeが呼ばれたときの処理
    566     Sub OnControlBeginInvoke(ByRef m As Message)
    567         Dim data As *AsyncInvokeData
    568         data = m.LParam As *AsyncInvokeData
    569         Dim asyncResult As *AsyncResultForInvoke
    570         asyncResult->Result = data->FuncPtr(data->Data)
    571         Dim wh = asyncResult->AsyncWaitHandle
    572         SetEvent(wh->Handle)
    573         Delete data
     580    Sub OnControlBeginInvoke(m As Message)
     581        Dim gch = GCHandle.FromIntPtr(m.LParam)
     582        Dim data = gch.Target As AsyncInvokeData
     583        With data
     584            Dim pfn = .FuncPtr
     585            .AsyncResult.Result = pfn(.Data)
     586            SetEvent(.AsyncResult.AsyncWaitHandle.Handle)
     587        End With
    574588    End Sub
    575589End Class

  • Include/Classes/System/Windows/Forms/Message.ab

    r77 r223  
    44#define __SYSTEM_WINDOWS_FORMS_MESSAGE_AB__
    55
     6#require <windows.sbp>
     7
    68Class Message
    79Public
    8     Sub Operator =(ByRef x As Message)
    9         hwnd = x.hwnd
    10         msg = x.msg
    11         wp = x.wp
    12         lp = x.lp
    13         lr = x.lr
    14     End Sub
    15 
    16     /*Const*/ Function HWnd() As HWND
     10    Const Function HWnd() As HWND
    1711        Return hwnd
    1812    End Function
    … …  
    2216    End Sub
    2317
    24     /*Const*/ Function Msg() As DWord
     18    Const Function Msg() As DWord
    2519        Return msg
    2620    End Function
    … …  
    3024    End Sub
    3125
    32     /*Const*/ Function WParam() As WPARAM
     26    Const Function WParam() As WPARAM
    3327        Return wp
    3428    End Function
    … …  
    3832    End Sub
    3933
    40     /*Const*/ Function LParam() As LPARAM
     34    Const Function LParam() As LPARAM
    4135        Return lp
    4236    End Function
    … …  
    4640    End Sub
    4741
    48     /*Const*/ Function Result() As LRESULT
     42    Const Function Result() As LRESULT
    4943        Return lr
    5044    End Function
    … …  
    5448    End Sub
    5549
    56     /*Const*/ Function Equals(x As Message) As BOOL
     50    /*Const*/ Function Equals(x As Message) As Boolean
    5751        Return hwnd = x.hwnd And _
    5852            msg = x.msg And _
    … …  
    6256    End Function
    6357
    64     /*Const*/ Function Operator ==(x As Message) As BOOL
     58    Override Function GetHashCode() As Long
     59        Return _System_HashFromPtr(hwnd) Xor (Not msg) Xor _System_HashFromPtr(wp As VoidPtr) Xor _
     60            (Not _System_HashFromPtr(lp As VoidPtr)) Xor _System_HashFromPtr(lr As VoidPtr)
     61    End Function
     62
     63    Const Function Operator ==(x As Message) As BOOL
    6564        Return Equals(x)
    6665    End Function
    6766
    68     /*Const*/ Function Operator <>(x As Message) As BOOL
     67    Const Function Operator <>(x As Message) As BOOL
    6968        Return Not Equals(x)
    7069    End Function

  • Include/Classes/System/Windows/Forms/PaintEventArgs.ab

    r77 r223  
    44#define __SYSTEM_WINDOWS_FORMS_PAINTEVENTARGS_AB__
    55
    6 #include <Classes/System/misc.ab>
     6#require <Classes/System/misc.ab>
    77
    88Class PaintEventArgs

  • Include/Classes/System/Windows/Forms/index.ab

    r77 r223  
    44#define __SYSTEM_WINDOWS_FORMS_INDEX_AB__
    55
    6 #include <Classes/System/Windows/Forms/misc.ab>
    7 #include <Classes/System/Windows/Forms/Control.ab>
    8 #include <Classes/System/Windows/Forms/Message.ab>
    9 #include <Classes/System/Windows/Forms/CreateParams.ab>
    10 #include <Classes/System/Windows/Forms/EventArgs.ab>
    11 #include <Classes/System/Windows/Forms/PaintEventArgs.ab>
     6#require <Classes/System/Windows/Forms/misc.ab>
     7#require <Classes/System/Windows/Forms/Control.ab>
     8#require <Classes/System/Windows/Forms/Message.ab>
     9#require <Classes/System/Windows/Forms/CreateParams.ab>
     10#require <Classes/System/Windows/Forms/PaintEventArgs.ab>
    1211
    1312#endif '__SYSTEM_WINDOWS_FORMS_INDEX_AB__

  • Include/Classes/System/Windows/Forms/misc.ab

    r77 r223  
    99
    1010Enum BoundsSpecified
    11     None = 0
     11    None = &h0
    1212    X = &h1
    1313    Y = &h2

  • Include/Classes/System/misc.ab

    r77 r223  
    44#define __SYSTEM_MISC_AB__
    55
    6 #include <Classes/System/Threading/WaitHandle.ab>
     6#require <Classes/System/Threading/WaitHandle.ab>
    77
    88Interface IObject
    … …  
    2828
    2929Class EventArgs
     30Public
     31    Static Empty = New EventArgs
    3032End Class
    3133

  • Include/OAIdl.ab

    r211 r223  
    11' OAIdl.sbp
    22' 本来はOAIdl.idlから生成するのが正当ですが、
    3 ' これは手動で必要最低限のもののみ移植したものです。
     3' これは手動で移植したものです。
    44
    55#ifndef _INC_OAIDL_AB
    … …  
    939939    Function SetGuid(
    940940        /* [in] */ ByRef guid As GUID) As HRESULT
    941 
    942941    Function SetTypeFlags(
    943942        /* [in] */ uTypeFlags As DWord) As HRESULT
    944 
    945943    Function SetDocString(
    946944        /* [in] */ pStrDoc As LPOLESTR) As HRESULT
    947 
    948945    Function SetHelpContext(
    949946        /* [in] */ dwHelpContext As DWord) As HRESULT
    950 
    951947    Function SetVersion(
    952948        /* [in] */ wMajorVerNum As Word,
    953949        /* [in] */ wMinorVerNum As Word) As HRESULT
    954 
    955950    Function AddRefTypeInfo(
    956951        /* [in] */ pTInfo As VoidPtr /* *ITypeInfo */,
    957952        /* [in] */ByRef hRefType As HREFTYPE) As HRESULT
    958 
    959953    Function AddFuncDesc(
    960954        /* [in] */ index As DWord,
    961955        /* [in] */ ByRef FuncDesc As FUNCDESC) As HRESULT
    962 
    963956    Function AddImplType(
    964957        /* [in] */ index As DWord,
    965958        /* [in] */ hRefType As HREFTYPE) As HRESULT
    966 
    967959    Function SetImplTypeFlags(
    968960        /* [in] */ index As DWord,
    969961        /* [in] */ implTypeFlags As Long) As HRESULT
    970 
    971962    Function SetAlignment(
    972963        /* [in] */ cbAlignment As Long) As HRESULT
    973 
    974964    Function SetSchema(
    975965        /* [in] */ pStrSchema As LPOLESTR) As HRESULT
    976 
    977966    Function AddVarDesc(
    978967        /* [in] */ index As DWord,
    979968        /* [in] */ ByRef VarDesc As VARDESC) As HRESULT
    980 
    981969    Function SetFuncAndParamNames(
    982970        /* [in] */ index As DWord,
    983971        /* [in][size_is][in] */ rgszNames As *LPOLESTR,
    984972        /* [in] */ cNames As DWord) As HRESULT
    985 
    986973    Function SetVarName(
    987974        /* [in] */ index As DWord,
    988975        /* [in] */ szName As LPOLESTR) As HRESULT
    989 
    990976    Function SetTypeDescAlias(
    991977        /* [in] */ ByRef TDescAlias As TYPEDESC) As HRESULT
    992 
    993978    Function DefineFuncAsDllEntry(
    994979        /* [in] */ index As DWord,
    995980        /* [in] */ szDllName As LPOLESTR,
    996981        /* [in] */ zProcName As LPOLESTR) As HRESULT
    997 
    998982    Function SetFuncDocString(
    999983        /* [in] */ index As DWord,
    1000984        /* [in] */ szDocString As LPOLESTR) As HRESULT
    1001 
    1002985    Function SetVarDocString(
    1003986        /* [in] */ index As DWord,
    1004987        /* [in] */ szDocString As LPOLESTR) As HRESULT
    1005 
    1006988    Function SetFuncHelpContext(
    1007989        /* [in] */ index As DWord,
    1008990        /* [in] */ dwHelpContext As DWord) As HRESULT
    1009 
    1010991    Function SetVarHelpContext(
    1011992        /* [in] */ index As DWord,
    1012993        /* [in] */ dwHelpContext As DWord) As HRESULT
    1013 
    1014994    Function SetMops(
    1015995        /* [in] */ index As DWord,
    1016996        /* [in] */ bstrMops As BSTR) As HRESULT
    1017 
    1018997    Function SetTypeIdldesc(
    1019998        /* [in] */ ByRef IdlDesc As IDLDESC) As HRESULT
    1020 
    1021999    Function LayOut() As HRESULT
    10221000End Interface

  • Include/api_gdi.sbp

    r176 r223  
    198198End Type
    199199
    200 
     200Type LOGPALETTE
     201    palVersion As Word
     202    palNumEntries As Word
     203    palPalEntry[ELM(1)] As PALETTEENTRY
     204End Type
    201205
    202206' raster operations

  • Include/basic/function.sbp

    r214 r223  
    10591059Function _System_BSwap(x As Word) As Word
    10601060    Dim src = VarPtr(x) As *Byte
    1061     Dim dst = VarPtr(_System_BSwap) As *SByte
     1061    Dim dst = VarPtr(_System_BSwap) As *Byte
    10621062    dst[0] = src[1]
    10631063    dst[1] = src[0]
    … …  
    10661066Function _System_BSwap(x As DWord) As DWord
    10671067    Dim src = VarPtr(x) As *Byte
    1068     Dim dst = VarPtr(_System_BSwap) As *SByte
     1068    Dim dst = VarPtr(_System_BSwap) As *Byte
    10691069    dst[0] = src[3]
    10701070    dst[1] = src[2]
    … …  
    10751075Function _System_BSwap(x As QWord) As QWord
    10761076    Dim src = VarPtr(x) As *Byte
    1077     Dim dst = VarPtr(_System_BSwap) As *SByte
     1077    Dim dst = VarPtr(_System_BSwap) As *Byte
    10781078    dst[0] = src[7]
    10791079    dst[1] = src[6]

  • Include/objidl.sbp

    r211 r223  
    192192    Inherits IUnknown
    193193
    194     Function CreateStream( 
     194    Function CreateStream(
    195195        /* [string][in] */ pwcsName As *OLECHAR,
    196196        /* [in] */ grfMode As DWord,
    … …  
    198198        /* [in] */ reserved2 As DWord,
    199199        /* [out] */ ByRef pstm As *IStream) As HRESULT
    200     /* [local] */ Function OpenStream( 
     200    /* [local] */ Function OpenStream(
    201201        /* [string][in] */ pwcsName As *OLECHAR,
    202202        /* [unique][in] */ reserved1 As VoidPtr,
    … …  
    204204        /* [in] */ reserved2 As DWord,
    205205        /* [out] */ ByRef pstm As *IStream) As HRESULT
    206     Function CreateStorage( 
     206    Function CreateStorage(
    207207        /* [string][in] */ pwcsName As *OLECHAR,
    208208        /* [in] */ grfMode As DWord,
    … …  
    210210        /* [in] */ reserved2 As DWord,
    211211        /* [out] */ ByRef pstg As *IStorage) As HRESULT
    212     Function OpenStorage( 
     212    Function OpenStorage(
    213213        /* [string][unique][in] */ pwcsName As *OLECHAR,
    214214        /* [unique][in] */ pstgPriority As IStorage,
    … …  
    217217        /* [in] */ reserved As DWord,
    218218        /* [out] */ ByRef pstg As *IStorage) As HRESULT
    219     /* [local] */ Function CopyTo( 
     219    /* [local] */ Function CopyTo(
    220220        /* [in] */ ciidExclude As DWord,
    221221        /* [size_is][unique][in] */ ByRef rgiidExclude As * /*Const*/ IID,
    222222        /* [unique][in] */ snbExclude As SNB,
    223223        /* [unique][in] */ pstgDest As *IStorage) As HRESULT
    224     Function MoveElementTo( 
     224    Function MoveElementTo(
    225225        /* [string][in] */ pwcsName As *OLECHAR,
    226226        /* [unique][in] */ pstgDest As *IStorage,
    227227        /* [string][in] */ pwcsNewName As *OLECHAR,
    228228        /* [in] */ grfFlags As DWord) As HRESULT
    229     Function Commit( 
     229    Function Commit(
    230230        /* [in] */ grfCommitFlags As DWord) As HRESULT
    231231    Function Revert() As HRESULT
    232     /* [local] */ Function EnumElements( 
     232    /* [local] */ Function EnumElements(
    233233        /* [in] */ reserved1 As DWord,
    234234        /* [size_is][unique][in] */ reserved2 As VoidPtr,
    235235        /* [in] */ reserved3 As DWord,
    236236        /* [out] */ ByRef penum As *IEnumSTATSTG) As HRESULT
    237     Function DestroyElement( 
     237    Function DestroyElement(
    238238        /* [string][in] */ pwcsName As *OLECHAR) As HRESULT
    239     Function RenameElement( 
     239    Function RenameElement(
    240240        /* [string][in] */ pwcsOldName As *OLECHAR,
    241241        /* [string][in] */ pwcsNewName As *OLECHAR) As HRESULT
    242     Function SetElementTimes( 
     242    Function SetElementTimes(
    243243            /* [string][unique][in] */ pwcsName As *OLECHAR,
    244244            /* [unique][in] */ ByRef ctime As /*Const*/ FILETIME,
    245245            /* [unique][in] */ ByRef atime As /*Const*/ FILETIME,
    246246            /* [unique][in] */ ByRef mtime As /*Const*/ FILETIME) As HRESULT
    247     Function SetClass( 
     247    Function SetClass(
    248248            /* [in] */ ByRef clsid As CLSID) As HRESULT
    249     Function SetStateBits( 
     249    Function SetStateBits(
    250250            /* [in] */ grfStateBits As DWord,
    251251            /* [in] */ grfMask As DWord) As HRESULT
    252     Function Stat( 
     252    Function Stat(
    253253            /* [out] */ ByRef statstg As STATSTG,
    254254            /* [in] */ grfStatFlag As DWord) As HRESULT

  • Include/ole2.ab

    r211 r223  
    55
    66' 暫定措置
    7 Interface IOleClientSite
    8     Inherits IUnknown
    9 End Interface
    107
    118Interface IPersistStorage
    … …  
    2623
    2724Interface IOleInPlaceActiveObject
    28     Inherits IUnknown
    29 End Interface
    30 
    31 Interface IOleObject
    3225    Inherits IUnknown
    3326End Interface
    … …  
    7568/* pull in the MIDL generated header */
    7669
    77 '#include <oleidl.h>
     70#require <oleidl.ab>
    7871
    7972/****** DV APIs ***********************************************************/

  • Include/system/string.sbp

    r208 r223  
    1010
    1111Function ZeroString(length As Long) As String
    12     Return New String(0, length)
     12    Return New String(0 As StrChar, length)
    1313End Function
    1414

  • Include/windows/WindowHandle.sbp

    r208 r223  
    372372    End Function
    373373
     374    Const Function ScreenToClient(ByRef rc As RECT) As Boolean
     375        Dim ppt = VarPtr(rc) As *POINTAPI
     376        Return _System_ScreenToClient(hwnd, ppt[0]) And _System_ScreenToClient(hwnd, ppt[1])
     377    End Function
     378
    374379    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
    375380        Return ScrollWindowEx(hwnd, dx, dy, rcScroll, rcClip, hrgnUpdate, rcUpdate, flags) As Boolean
    … …  
    626631    End Function
    627632
    628     Sub Style(newStyle As DWord) DWord
     633    Sub Style(newStyle As DWord)
    629634        _System_SetWindowLongPtr(hwnd, GWLP_STYLE, newStyle)
    630635    End Sub
    … …  
    677682
    678683    Const Function Parent() As WindowHandle
    679         Return _System_GetParent(hwnd)
     684        Return New WindowHandle(_System_GetParent(hwnd))
    680685    End Function
    681686
    … …  
    714719    Sub Prop(str As PCTSTR, h As HANDLE)
    715720        SetProp(str, h)
    716     End Sub
    717 
    718     Sub Prop(psz As PCTSTR, h As HANDLE)
    719         SetProp(psz, h)
    720721    End Sub
    721722
Note: See TracChangeset for help on using the changeset viewer.