Changeset 547


Ignore:
Timestamp:
Jul 13, 2008, 11:54:55 PM (16 years ago)
Author:
イグトランス (egtra)
Message:

Applicationクラスの追加

Location:
trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI
Files:
3 added
3 edited

Legend:

Unmodified
Added
Removed

  • trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/Control.ab

    r545 r547  
    1212
    1313Class Control
     14    Inherits WindowHandle
    1415Public
     16
    1517    Sub Control()
    1618    End Sub
    … …  
    2527    Static Function FromHWnd(hwnd As HWND) As Control
    2628        FromHWnd = Nothing
    27         If IsWindow(hwnd) Then
     29        If _System_IsWindow(hwnd) Then
    2830            FromHWnd = FromHWndCore(hwnd)
    2931        End If
    … …  
    3234Private
    3335    Static Function FromHWndCore(hwnd As HWND) As Control
    34         If GetClassLongPtr(hwnd, GCW_ATOM) = atom Then
     36        If _System_GetClassLongPtr(hwnd, GCW_ATOM) = atom Then
    3537            Dim gchValue = GetProp(hwnd, PropertyInstance As ULONG_PTR As PCTSTR) As ULONG_PTR
    3638            If gchValue <> 0 Then
    … …  
    4446'--------------------------------
    4547' ウィンドウ作成
    46 /*
    47     Function Create(
    48         parent As HWND,
    49         rect As RECT,
    50         name As String,
    51         style As DWord,
    52         exStyle = 0 As DWord,
    53         menu = 0 As HMENU) As HWND
    54 */
     48'   Function Create(
     49'       parent As HWND,
     50'       rect As RECT,
     51'       name As String,
     52'       style As DWord,
     53'       exStyle = 0 As DWord,
     54'       menu = 0 As HMENU) As HWND
    5555
    5656Public
    57     Function Create() As Boolean
     57    Sub Create()
    5858        Dim cs As CREATESTRUCT
    5959        cs.hInstance = hInstance
    6060        cs.lpszClass = (atom As ULONG_PTR) As LPCTSTR
    6161        GetCreateStruct(cs)
    62         Create = createImpl(cs)
    63     End Function
     62        createImpl(cs)
     63    End Sub
    6464
    6565Protected
    6666    Abstract Sub GetCreateStruct(ByRef cs As CREATESTRUCT)
    6767
    68     Function createImpl(ByRef cs As CREATESTRUCT) As Boolean
     68    Sub createImpl(ByRef cs As CREATESTRUCT)
    6969        Imports System.Runtime.InteropServices
    7070
    … …  
    7777            Dim hwnd = CreateWindowEx(.dwExStyle, .lpszClass, .lpszName, .style,
    7878                .x, .y, .cx, .cy, .hwndParent, .hMenu, .hInstance, .lpCreateParams)
    79             createImpl = hwnd <> 0
     79            If hwnd = 0 Then
     80                ActiveBasic.Windows.ThrowByWindowsError(GetLastError())
     81            End If
    8082        End With
    81     End Function
     83    End Sub
    8284
    8385'--------------------------------
    … …  
    125127    */
    126128    Sub StartWndProc()
    127         Dim t = This '#177対策
    128         AddMessageEvent(WM_ERASEBKGND, AddressOf(t.OnEraseBackground))
    129         Dim md = New MessageEventHandler(AddressOf(t.OnMouseDownBase))
     129        AddMessageEvent(WM_ERASEBKGND, AddressOf(OnEraseBackground))
     130        Dim md = New MessageEventHandler(AddressOf(OnMouseDownBase))
    130131        AddMessageEvent(WM_LBUTTONDOWN, md)
    131132        AddMessageEvent(WM_RBUTTONDOWN, md)
    132133        AddMessageEvent(WM_MBUTTONDOWN, md)
    133134        AddMessageEvent(WM_XBUTTONDOWN, md)
    134         Dim mu = New MessageEventHandler(AddressOf(t.OnMouseUpBase))
     135        Dim mu = New MessageEventHandler(AddressOf(OnMouseUpBase))
    135136        AddMessageEvent(WM_LBUTTONUP, mu)
    136137        AddMessageEvent(WM_RBUTTONUP, mu)
    137138        AddMessageEvent(WM_MBUTTONUP, mu)
    138139        AddMessageEvent(WM_XBUTTONUP, mu)
    139         Dim mb = New MessageEventHandler(AddressOf(t.OnMouseDblClkBase))
     140        Dim mb = New MessageEventHandler(AddressOf(OnMouseDblClkBase))
    140141        AddMessageEvent(WM_LBUTTONDBLCLK, mu)
    141142        AddMessageEvent(WM_RBUTTONDBLCLK, mu)
    … …  
    143144        AddMessageEvent(WM_XBUTTONDBLCLK, mu)
    144145
    145         AddMessageEvent(WM_MOUSELEAVE, AddressOf(t.OnMouseLeaveBase))
    146         AddMessageEvent(WM_PAINT, AddressOf(t.OnPaintBase))
    147         AddMessageEvent(WM_KEYDOWN, AddressOf(t.OnKeyDownBase))
    148 '       AddMessageEvent(WM_CHAR, AddressOf(t.OnChar))   
    149         AddMessageEvent(WM_CREATE, AddressOf(t.OnCreateBase))
     146        AddMessageEvent(WM_MOUSEMOVE, AddressOf(OnMouseMoveBase))
     147        AddMessageEvent(WM_MOUSELEAVE, AddressOf(OnMouseLeaveBase))
     148        AddMessageEvent(WM_PAINT, AddressOf(OnPaintBase))
     149        AddMessageEvent(WM_KEYDOWN, AddressOf(OnKeyDownBase))
     150'       AddMessageEvent(WM_CHAR, AddressOf(OnChar))
     151        AddMessageEvent(WM_CREATE, AddressOf(OnCreateBase))
    150152    End Sub
    151153
    152154    Sub OnEraseBackground(sender As Object, e As MessageEventArgs)
    153         Dim rc As RECT
    154         Dim r = GetClientRect(hwnd, rc)
     155        Dim rc = ClientRect
    155156        FillRect(e.WParam As HDC, rc, (COLOR_3DFACE + 1) As HBRUSH)
    156157        e.LResult = TRUE
    … …  
    197198    Sub OnPaintBase(sender As Object, e As MessageEventArgs)
    198199        Dim ps As PAINTSTRUCT
    199         BeginPaint(hwnd, ps)
     200        BeginPaint(ps)
    200201        Try
    201202            OnPaintDC(New PaintDCEventArgs(ps.hdc, ps.rcPaint))
    202203        Finally
    203             EndPaint(hwnd, ps)
     204            EndPaint(ps)
    204205        End Try
    205206    End Sub
    … …  
    272273' インスタンスメンバ変数
    273274Private
    274     hwnd As HWND
    275275    /*!
    276276    @brief マウスカーソルがクライアント領域に入っているかどうかのフラグ
    … …  
    291291        Imports System.Runtime.InteropServices
    292292
    293         Dim rThis = Control.FromHWndCore(hwnd)
     293        Dim rThis = FromHWndCore(hwnd)
    294294        If IsNothing(rThis) Then
    295295            Dim gchValue = TlsGetValue(tlsIndex) As LONG_PTR
    … …  
    306306            End If
    307307            rThis.hwnd = hwnd
    308             SetProp(hwnd, PropertyInstance As ULONG_PTR As PCSTR, gchValue As HANDLE)
     308            rThis.Prop[PropertyInstance] = gchValue As HANDLE
    309309        End If
    310310        WndProcFirst = rThis.WndProc(msg, wp, lp)
    311311        If msg = WM_NCDESTROY Then
    312             Dim gchValue = GetProp(hwnd, PropertyInstance As ULONG_PTR As PCTSTR) As ULONG_PTR
     312            Dim gchValue = rThis.Prop(PropertyInstance) As ULONG_PTR
    313313            If gchValue <> 0 Then
    314                 Dim gch = GCHandle.FromIntPtr(gchValue)
    315                 gch.Free()
     314                GCHandle.FromIntPtr(gchValue).Free()
    316315            End If
    317316        End If
    … …  
    320319
    321320    *InstanceIsNotFound
    322         OutputDebugString("ActiveBasic.Windows.UI.Control.WndProcFirst: The attached instance is not found.")
     321        OutputDebugString(Ex"ActiveBasic.Windows.UI.Control.WndProcFirst: The attached instance is not found.\r\n")
    323322        WndProcFirst = DefWindowProc(hwnd, msg, wp, lp)
    324323    End Function
    … …  
    408407End Class
    409408
    410 Class Form '仮
    411     Inherits Control
    412 Protected
    413     Override Sub GetCreateStruct(ByRef cs As CREATESTRUCT)
    414         With cs
    415             .lpCreateParams = 0
    416             '.hInstance
    417             .hMenu = 0
    418             .hwndParent = 0
    419             .cy = CW_USEDEFAULT
    420             .cx = CW_USEDEFAULT
    421             .y = CW_USEDEFAULT
    422             .x = CW_USEDEFAULT
    423             .style = WS_OVERLAPPEDWINDOW
    424             .lpszName = ""
    425             '.lpszClass
    426             .dwExStyle = 0
    427         End With
    428     End Sub
    429 Public
    430 
    431     Override Function WndProc(msg As DWord, wp As WPARAM, lp As LPARAM) As LRESULT
    432         WndProc = 0
    433         Select Case msg
    434             Case Else
    435                 WndProc = Super.WndProc(msg, wp, lp)
    436         End Select
    437     End Function
    438 End Class
    439 
    440409End Namespace 'UI
    441410End Namespace 'Widnows
    442411End Namespace 'ActiveBasic
    443 
    444 '----------
    445 'テスト実行用
    446 
    447 Imports ActiveBasic.Windows.UI
    448 
    449 'OleInitialize()
    450 Control.Initialize(GetModuleHandle(0))
    451 
    452 Class MyForm
    453     Inherits Form
    454 Public
    455     Sub MyForm()
    456         Dim f = This
    457         f.AddMessageEvent(WM_DESTROY, AddressOf (f.Destory))
    458         f.AddPaintDC(AddressOf (f.Paint))
    459     End Sub
    460 
    461     Sub Destory(sender As Object, e As EventArgs)
    462         OutputDebugString(Ex"Destory\r\n")
    463         PostQuitMessage(0)
    464     End Sub
    465 
    466     Sub Paint(sender As Object, e As PaintDCEventArgs)
    467         TextOut(e.Handle, 10, 10, "Hello world!", 12)
    468     End Sub
    469 End Class
    470 
    471 Dim f = New MyForm
    472 f.Create()
    473 ShowWindow(f.Handle, SW_SHOW)
    474 
    475 Dim m As MSG
    476 Do
    477     Dim ret = GetMessage(m, 0, 0, 0)
    478     If ret = 0 Then
    479         Exit Do
    480     ElseIf ret = -1 Then
    481         ExitProcess(-1)
    482     End If
    483 
    484     TranslateMessage(m)
    485     DispatchMessage(m)
    486 Loop
    487 
    488 f = Nothing
    489 System.GC.Collect()
    490 
    491 Control.Uninitialize()
    492 'OleUninitialize()
    493 
    494 End

  • trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/EventArgs.ab

    r545 r547  
    88Namespace UI
    99
    10 TypeDef EventArgs = System.EventArgs
    11 TypeDef EventHandler = System.EventHandler
     10'TypeDef EventArgs = System.EventArgs
     11'TypeDef EventHandler = System.EventHandler
     12Class EventArgs
     13Public
     14    Static Empty = Nothing As EventArgs
     15End Class
     16Delegate Sub EventHandler(sender As Object, e As EventArgs)
    1217
    1318Class MessageEventArgs
    … …  
    118123        This.clicks = clicks
    119124        This.pt = New System.Drawing.Point(x, y)
     125        OutputDebugString(ToTCStr(Hex$(y) + " " + Hex$(pt.Y) + " " +  Ex" mea\r\n"))
    120126        This.delta = delta
    121127    End Sub
    … …  
    445451    'Menu: pcs->hMenu
    446452
    447     Const Function Parent() As Control
    448         'Parent = Control.FromHandle(pcs->hwndParent)
    449     End Function
     453'   Const Function Parent() As Control
     454'       Parent = Control.FromHandle(pcs->hwndParent)
     455'   End Function
    450456
    451457    Const Function Height() As Long

  • trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/UI/WindowHandle.sbp

    r545 r547  
    3131Declare Function _System_IsWindow Lib "user32" Alias "IsWindow" (hWnd As HWND) As BOOL
    3232Declare Function _System_IsIconic Lib "user32" Alias "IsIconic" (hWnd As HWND) As BOOL
    33 Declare Function _System_GetClientRect Lib "user32" Alias "GetClientRect" (hWnd As HWND, ByRef Rect As RECT) As BOOL
    34 Declare Function _System_GetProp Lib "user32" Alias _FuncName_GetProp (hWnd As HWND, pString As PCTSTR) As HANDLE
    35 Declare Function _System_SetProp Lib "user32" Alias _FuncName_SetProp (hWnd As HWND, pString As PCTSTR, hData As HANDLE) As BOOL
    3633Declare Function _System_GetClassName Lib "user32" Alias _FuncName_GetClassName (hWnd As HWND, lpClassName As PTSTR, nMaxCount As Long) As Long
    3734Declare Function _System_GetScrollInfo Lib "user32" Alias "GetScrollInfo" (hWnd As HWND, fnBar As Long, ByRef lpsi As SCROLLINFO) As BOOL
    … …  
    6966        Return hwnd
    7067    End Function
    71 
     68/*
     69    Static Function FromHWnd(hwnd As HWND) As WindowHandle
     70        FromHWnd = Control.FromHWnd(hwnd)
     71        If IsNothing(FromHWnd) Then
     72            FromHWnd = New WindowHandle(hwnd)
     73        End If
     74    End Function
     75*/
    7276    Function BringToTop() As Boolean
    7377        Return BringWindowToTop(hwnd) As Boolean
    … …  
    7680    Function BeginPaint(ByRef ps As PAINTSTRUCT) As HDC
    7781        Return _System_BeginPaint(hwnd, ps)
     82    End Function
     83
     84    Function BeginPaint() As PAINTSTRUCT
     85        _System_BeginPaint(hwnd, BeginPaint)
    7886    End Function
    7987/*
    … …  
    139147    End Function
    140148
    141     Const Function GetClientRect(ByRef rc As RECT) As Boolean
    142         Return _System_GetClientRect(hwnd, rc) As Boolean
    143     End Function
    144149/*
    145150    Const Function GetContextHelpId() As DWord
    … …  
    175180    End Function
    176181*/
    177     Const Function GetProp(str As String) As HANDLE
    178         Return _System_GetProp(hwnd, ToTCStr(str))
    179     End Function
    180 
    181     Const Function GetProp(psz As PCTSTR) As HANDLE
    182         Return _System_GetProp(hwnd, psz)
    183     End Function
    184 
    185     Const Function GetProp(atom As ATOM) As HANDLE
    186         Return _System_GetProp(hwnd, atom As ULONG_PTR As PCTSTR)
    187     End Function
    188 
    189182    Const Function GetScrollInfo(fnBar As Long, ByRef si As SCROLLINFO) As Boolean
    190183        Return _System_GetScrollInfo(hwnd, fnBar, si) As Boolean
    … …  
    219212    End Function
    220213*/
    221     Const Function GetWindowRect(ByRef rc As RECT) As Boolean
    222         Return _System_GetWindowRect(hwnd, rc) As Boolean
    223     End Function
    224 
    225214    Const Function GetText(ps As PTSTR, maxCount As Long) As Boolean
    226215        Return GetWindowText(hwnd, ps, maxCount) As Boolean
    227     End Function
    228 
    229     Const Function GetTextLength() As Long
    230         Return GetWindowTextLength(hwnd)
    231     End Function
    232 
    233     Const Function GetWindowThreadId() As DWord
    234         Return _System_GetWindowThreadProcessId(hwnd, 0)
    235216    End Function
    236217
    … …  
    444425    End Function
    445426
    446     Function SetProp(str As String, hData As HANDLE) As Boolean
    447         Return _System_SetProp(hwnd, ToTCStr(str), hData) As Boolean
    448     End Function
    449 
    450     Function SetProp(psz As PCTSTR, hData As HANDLE) As Boolean
    451         Return _System_SetProp(hwnd, psz, hData) As Boolean
    452     End Function
    453 
    454     Function SetProp(atom As ATOM, hData As HANDLE) As Boolean
    455         Return This.SetProp((atom As ULONG_PTR) As PCTSTR, hData) As Boolean
    456     End Function
    457 
    458427    Function SetScrollInfo(fnBar As Long, ByRef si As SCROLLINFO, redraw As Boolean) As Boolean
    459428        Return _System_SetScrollInfo(hwnd, fnBar, si, redraw) As Boolean
    … …  
    502471    End Function
    503472
    504     Function SetText(psz As PCTSTR) As Boolean
    505         Return SetWindowText(hwnd, psz) As Boolean
    506     End Function
    507 
    508     Function SetText(str As String) As Boolean
    509         Return SetWindowText(hwnd, ToTCStr(str)) As Boolean
    510     End Function
    511 
    512473    Function ShowCaret() As Boolean
    513474        Return _System_ShowCaret(hwnd) As Boolean
    … …  
    546507    End Function
    547508
    548     ' Get/SetWindowLongPtr Wrappers
    549 
    550     Const Function GetExStyle() As DWord
    551         Return _System_GetWindowLongPtr(hwnd, GWL_EXSTYLE) As DWord
    552     End Function
    553 
    554     Const Function GetStyle() As DWord
    555         Return _System_GetWindowLongPtr(hwnd, GWL_STYLE) As DWord
    556     End Function
    557 #ifdef _UNDEF
    558     Const Function GetWndProc() As WNDPROC
    559         Return _System_GetWindowLongPtr(hwnd, GWLP_WNDPROC) As WNDPROC
    560     End Function
    561 #endif
    562     Const Function GetInstance() As HINSTANCE
    563         Return _System_GetWindowLongPtr(hwnd, GWLP_HINSTANCE) As HINSTANCE
    564     End Function
    565 
    566     Const Function GetUserData() As LONG_PTR
    567         Return _System_GetWindowLongPtr(hwnd, GWLP_USERDATA)
    568     End Function
    569 
    570     Function SetExStyle(style As DWord) As DWord
    571         Return _System_SetWindowLongPtr(hwnd, GWL_EXSTYLE, style) As DWord
    572     End Function
    573 
    574     Function SetStyle(style As DWord) As DWord
    575         Return _System_SetWindowLongPtr(hwnd, GWL_STYLE, style) As DWord
    576     End Function
    577 #ifdef _UNDEF
    578     Function SetWndProc(wndProc As WNDPROC) As WNDPROC
    579         Return _System_SetWindowLongPtr(hwnd, GWLP_WNDPROC, wndProc As WNDPROC) As WNDPROC
    580     End Function
    581 #endif
    582     Function SetUserData(value As LONG_PTR) As LONG_PTR
    583         Return _System_SetWindowLongPtr(hwnd, GWLP_USERDATA, value As LONG_PTR)
    584     End Function
    585 
    586509    ' Propaties
    587510
    588511    Const Function ClientRect() As RECT
    589         _System_GetClientRect(hwnd, ClientRect)
     512        GetClientRect(hwnd, ClientRect)
    590513    End Function
    591514#ifdef _UNDEF
    … …  
    717640
    718641    Const Function Prop(str As String) As HANDLE
    719         Return GetProp(str)
     642        Return GetProp(hwnd, ToTCStr(str))
    720643    End Function
    721644
    722645    Const Function Prop(psz As PCTSTR) As HANDLE
    723         Return GetProp(psz)
     646        Return GetProp(hwnd, psz)
    724647    End Function
    725648
    726649    Const Function Prop(atom As ATOM) As HANDLE
    727         Return GetProp(atom)
    728     End Function
     650        Return GetProp(hwnd, atom As ULONG_PTR As PCTSTR)
     651    End Function
     652
     653    Sub Prop(str As String, hData As HANDLE)
     654        SetProp(hwnd, ToTCStr(str), hData)
     655    End Sub
    729656
    730657    Sub Prop(str As PCTSTR, h As HANDLE)
    731         SetProp(str, h)
     658        SetProp(hwnd, str, h)
    732659    End Sub
    733660
    734661    Sub Prop(atom As ATOM, h As HANDLE)
    735         SetProp(atom, h)
     662        SetProp(hwnd, atom As ULONG_PTR As PCTSTR, h)
    736663    End Sub
    737664
    738665    Const Function Text() As String
    739666        Dim size = GetWindowTextLength(hwnd) + 1
    740         Dim p = GC_malloc_atomic(SizeOf (TCHAR) * size) As PTSTR
    741         Dim length = GetWindowText(hwnd, p, size)
    742         Text = New String(p, length As Long)
     667        Dim sb = New System.Text.StringBuilder(size)
     668        sb.Length = size
     669        Dim length = GetWindowText(hwnd, StrPtr(sb), size)
     670        Text = sb.ToString
    743671    End Function
    744672
Note: See TracChangeset for help on using the changeset viewer.