cls

        : 4X4@  ( a1 --- )
                dup 2dup
                @
                swap  4 + @
                2swap 8 + @
                swap 12 + @
                ;


       cr .( ReLoading Low Level Controls...)

       :Class ListControl <SUPER CONTROL               \ a list box
                :M WindowStyle: ( -- Style )
                    WindowStyle: SUPER
                          WS_VSCROLL OR
                          LBS_DISABLENOSCROLL OR
                          LBS_NOTIFY OR           \ enable parent notify
                          LBS_NOINTEGRALHEIGHT OR \ disable integral height
                          LBS_EXTENDEDSEL OR      \
                          LBS_WANTKEYBOARDINPUT OR      \
                          ws_border or
                          WS_TABSTOP OR
                          ;M
                :M Start:       ( Parent -- )
                          TO Parent
                          z" LISTBOX" Create-Control
                          ;M
                ;Class

( \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ )

       cr .( 示範 範例 ..... )
        :OBJECT ListSample <SUPER DialogWindow

         128 bytes TempDirString
                CREATE SizeWindow_ListSample 180 , 180 , 300 , 330 , ( x y Witdth High )
                    128 bytes fontname

                ListControl LeftList
                    CREATE SizeLeftList                 20 , 20 , 120 , 200 ,
                    StaticControl LeftText
                        CREATE SizeLeftText             20 , 0 , 80 , 20 ,


                ButtonControl Button_OK
                    CREATE SizeButton_OK                250 , 270 , 40 ,  25 ,



                : LPTList更新
                        self  Start: LeftList
                              SizeLeftList dup 2dup  @ swap 4 + @  2swap 8 + @
                              swap 12 + @  Move: LeftList

                              0 0 LB_RESETCONTENT GetID: LeftList
                                                  SendDlgItemMessage: self 2drop
                              z" LPT1" rel>abs 0 LB_ADDSTRING    GetID: LeftList
                                                   SendDlgItemMessage: SELF 2drop
                              z" LPT2" rel>abs 0 LB_ADDSTRING    GetID: LeftList
                                                   SendDlgItemMessage: SELF 2drop
                              z" LPT3" rel>abs 0 LB_ADDSTRING    GetID: LeftList
                                                   SendDlgItemMessage: SELF 2drop
                       ;



                 : OKOp
                        0 0 LB_GETCURSEL GETID: LeftList
                                    SendDlgItemMessage: self
                        CR  ." 你選擇的是 : LPT "  1+ .      CR
                                            CLOSE: SELF
                        ;

                :M WindowStyle: ( -- style )
                        WindowStyle: SUPER
                        0    AND
                        WS_OVERLAPPED OR
                        ;M
                :M WindowTitle: ( -- title )
                        z" List 示範範例"
                        ;M
                :M StartSize:   ( -- width height )
                        SizeWindow_ListSample dup 8 + @ swap 12 + @
                        ;M
                :M StartPos:    ( -- x y )
                        SizeWindow_ListSample dup  @ swap 4 + @
                        ;M
                :M On_Init:     ( -- )
                        On_Init: super

                        self  Start: LeftText
                              SizeLeftText 4X4@ Move: LeftText
                              s" LPT埠選單 : "   SetText: LeftText
                              LPTList更新

                        IDOK   SetID: Button_OK
                        self Start: Button_OK
                              SizeButton_OK 4X4@ Move: Button_OK
                              s" OK"           SetText: Button_OK
                              GetStyle: Button_OK
                              BS_DEFPUSHBUTTON OR
                              SetStyle: Button_OK
                        ;M

                :M On_Paint:    ( -- )          \ screen redraw procedure
                         0 0 SizeWindow_ListSample dup 8 + @ swap 12 + @
                         LTGRAY FillArea: dc
                         ;M
                :M Close:       ( -- )
                         Close: SUPER
                         ;M
                :M WM_COMMAND  ( hwnd msg wparam lparam -- res )
                        over LOWORD ( ID )
                        case
                                IDOK    of      2drop OKOp       endof
                        endcase
                         ;M
                ;OBJECT

        : Listdemo          ( -- )
                Start: ListSample
                 ;
    listdemo