Ignore:
Timestamp:
Mar 8, 2008, 12:40:31 PM (17 years ago)
Author:
dai
Message:

Form周りを整理。一旦コミット。

Location:
trunk/Include/Classes/System/Windows/Forms
Files:
5 added
4 edited

Legend:

Unmodified
Added
Removed

  • trunk/Include/Classes/System/Windows/Forms/Application.ab

    r388 r461  
    3131        PostQuitMessage(0)
    3232    End Sub
     33
     34    /*!
     35    @brief  現在のスレッドで標準のアプリケーション メッセージ ループの実行を開始し、
     36            指定したフォームを表示します。
     37    */
     38    Static Sub Run( form As Form )
     39
     40        ' フォームを表示する
     41        form.Show()
     42
     43        Dim msgMain As MSG, iResult As Long
     44        Do
     45            iResult=GetMessage(msgMain,0,0,0)
     46            If iResult=0 or iResult=-1 Then Exit Do
     47            TranslateMessage(msgMain)
     48            DispatchMessage(msgMain)
     49        Loop
     50    End Sub
    3351End Class
    3452   

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

    r388 r461  
    11' Classes/System/Windows/Forms/Control.ab
    22
    3 #ifndef __SYSTEM_WINDOWS_FORMS_CONTROL_AB__
    4 #define __SYSTEM_WINDOWS_FORMS_CONTROL_AB__
    5 
    6 /*
    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 */
    15 #require <Classes/System/Drawing/Color.ab>
    16 #require <Classes/System/Drawing/Point.ab>
    17 #require <Classes/System/Drawing/Size.ab>
    18 #require <Classes/System/Drawing/Rectangle.ab>
    19 /*
    20 #require <Classes/System/Runtime/InteropServices/GCHandle.ab>
    21 #require <Classes/ActiveBasic/Windows/WindowHandle.sbp>
    22 #require <Classes/ActiveBasic/Strings/Strings.ab>
    23 */
    243Namespace System
    254Namespace Windows
    … …  
    7756
    7857Class Control
    79 
    80 '   Inherits IWin32Window
     58    Implements IWin32Window
    8159Public
    8260    '---------------------------------------------------------------------------
    … …  
    10078    'CheckForIllegalCrossThreadCalls
    10179
    102     /*Override*/ Function Handle() As HWND
     80    Override Function Handle() As HWND
    10381        Return wnd.HWnd
    10482    End Function
    … …  
    301279
    302280    Sub init(parent As Control, text As String, left As Long, top As Long, width As Long, height As Long)
     281        This.text = text
    303282        This.parent = parent
    304 '       CreateControl()
     283
     284        Dim rgb = GetSysColor( COLOR_HIGHLIGHT )
     285        This.bkColor = New Color( GetRValue(rgb) As Byte, GetGValue(rgb) As Byte, GetBValue(rgb) As Byte )
     286
     287        Dim hParentWnd = NULL As HWND
     288        If Not ActiveBasic.IsNothing( parent ) Then
     289            hParentWnd = parent.Handle
     290        End If
     291
     292        createParams = New CreateParams()
     293        With createParams
     294            .Caption = text
     295            .X = left
     296            .Y = top
     297            .Width = width
     298            .Height = height
     299            .Parent = hParentWnd
     300        End With
     301
     302        CreateControl()
    305303    End Sub
    306304   
    … …  
    358356        If IsWindow(hwnd) Then
    359357            If GetClassLongPtr(hwnd, GCW_ATOM) = atom Then
    360                 Dim gch = System.Runtime.InteropServices.GCHandle.FromIntPtr(GetWindowLongPtr(hwnd, GWLP_THIS))
    361                 Return gch.Target As Control
     358                Dim lpValue = GetWindowLongPtr(hwnd, GWLP_THIS)
     359                If lpValue Then
     360                    Dim gch = System.Runtime.InteropServices.GCHandle.FromIntPtr( lpValue )
     361                    Return gch.Target As Control
     362                End If
    362363            End If
    363364        End If
    … …  
    370371
    371372    Override Function ToString() As String
    372         Return text
     373        Return Super.ToString + ", Text: " + This.Text
    373374    End Function
    374375
    … …  
    383384
    384385    Sub Show()
    385         Debug
    386386        wnd.Show(SW_SHOW)
    387387    End Sub
    … …  
    418418    ' Protected Methods
    419419    Virtual Sub CreateHandle()
    420         Debug
    421420        If Not Object.ReferenceEquals(wnd, Nothing) Then
    422421            If wnd.HWnd <> 0 Then
    … …  
    424423            End If
    425424        End If
    426        
    427         Dim createParams = CreateParams()
     425
    428426        Dim gch = System.Runtime.InteropServices.GCHandle.Alloc(This)
    429427        TlsSetValue(tlsIndex, System.Runtime.InteropServices.GCHandle.ToIntPtr(gch) As VoidPtr)
    430         With createParams
    431             Dim pText As PCTSTR
    432             If String.IsNullOrEmpty(text) Then
    433                 pText = "" As PCTSTR
    434             Else
    435                 pText = ToTCStr(text)
    436             End If
    437 
    438             If CreateWindowEx(.ExStyle, atom As ULONG_PTR As PCSTR, pText, .Style, _
    439                 .X, .Y, .Width, .Height, _
    440                 .Parent, 0, hInstance, 0) = 0 Then
    441                 ' Error
    442                 Dim buf[1023] As TCHAR
    443                 wsprintf(buf, ToTCStr(Ex"Control: CreateWindowEx failed. Error code: &h%08X\r\n"), GetLastError())
    444                 OutputDebugString(buf)
    445 
    446                 gch.Free()
     428
     429        Dim pText As PCTSTR
     430        If String.IsNullOrEmpty(text) Then
     431            pText = "" As PCTSTR
     432        Else
     433            pText = ToTCStr(text)
     434        End If
     435
     436        Dim result As HANDLE
     437        With This.CreateParams
     438            result = CreateWindowEx(
     439                .ExStyle,                       ' 拡張ウィンドウ スタイル
     440                atom As ULONG_PTR As PCSTR,     ' クラス名
     441                pText,                          ' キャプション
     442                .Style,                         ' ウィンドウ スタイル
     443                .X,                             ' X座標
     444                .Y,                             ' Y座標
     445                .Width,                         ' 幅
     446                .Height,                        ' 高さ
     447                .Parent,                        ' 親ウィンドウ ハンドル
     448                0,                              ' メニュー ハンドル
     449                hInstance,                      ' アプリケーション インスタンス ハンドル
     450                0)                              ' ウィンドウ作成データ
     451        End With
     452
     453        If result = NULL Then
     454            ' Error
     455            Dim buf[1023] As TCHAR
     456            wsprintf(buf, ToTCStr(Ex"Control: CreateWindowEx failed. Error code: &h%08X\r\n"), GetLastError())
     457            OutputDebugString(buf)
     458
     459            gch.Free()
    447460'               Debug
    448                 ExitThread(0)
    449             End If
    450         End With
     461            ExitThread(0)
     462        End If
    451463       
    452464    End Sub
    … …  
    549561    ' Member variables
    550562    wnd As ActiveBasic.Windows.WindowHandle
     563    createParams As CreateParams
    551564    text As String
    552565    parent As Control
    553566    bkColor As Color
    554 
    555     Static createParams As CreateParams
    556567
    557568    'ウィンドウ作成時にウィンドウプロシージャへThisを伝えるためのもの
    … …  
    593604            ExitThread(0)
    594605        End If
    595 
    596         With createParams
    597             ' 値は暫定的なもの
    598             .Style = WS_OVERLAPPEDWINDOW
    599             .ExStyle = WS_EX_APPWINDOW
    600             .Caption = String.Empty
    601             .X = 0
    602             .Y = 0
    603             .Width = 0
    604             .Height = 0
    605         End With
    606606    End Sub
    607607
    … …  
    672672End Namespace 'Widnows
    673673End Namespace 'System
    674 
    675 #endif '__SYSTEM_WINDOWS_FORMS_CONTROL_AB__
    676 

  • trunk/Include/Classes/System/Windows/Forms/CreateParams.ab

    r282 r461  
    1 ' Classes/System/Windows/Forms/CreateParams.ab
    2 
    3 #ifndef __SYSTEM_WINDOWS_FORMS_CREATEPARAMS_AB__
    4 #define __SYSTEM_WINDOWS_FORMS_CREATEPARAMS_AB__
    51
    62Namespace System
    … …  
    2622End Namespace 'Widnows
    2723End Namespace 'System
    28 
    29 #endif '__SYSTEM_WINDOWS_FORMS_CREATEPARAMS_AB__

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

    r388 r461  
    222222*/
    223223
    224 TypeDef DialogResult = DWord
    225224TypeDef MouseButtons = DWord
    226225
Note: See TracChangeset for help on using the changeset viewer.