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

        CREATE DirString            MAXSTRING ALLOT
        CREATE CurrentDirString    MAXSTRING ALLOT
        variable OldLeftSel
        variable OldRightSel
( \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ )

       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_Left
                        CREATE SizeButton_Left          105 , 230 , 40 ,  25 ,
                        4 CONSTANT LeftID
                    ButtonControl Button_AllLeft
                        CREATE SizeButton_AllLeft       10  , 230 , 80 ,  25 ,
                        7 CONSTANT AllLeftID

                ListControl RightList
                    CREATE SizeRightList                160 , 20 , 120 , 200 ,
                    StaticControl RightText
                        CREATE SizeRightText            160 , 0 , 80 , 20 ,
                    ButtonControl Button_Right
                        CREATE SizeButton_Right         155  , 230 , 40 , 25 ,
                        5 CONSTANT RightID
                    ButtonControl Button_AllRight
                        CREATE SizeButton_AllRight      210  , 230 , 80  , 25 ,
                        6 CONSTANT AllRightID

                ComboListControl DirList
                    CREATE SizeDirList                  65 , 270 , 170 , 200 ,
                    ButtonControl DirButton
                        CREATE SizeDirButton            10 , 270 , 40 , 25 ,
                    3 CONSTANT DirID

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



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

                              0 0 LB_RESETCONTENT GetID: LeftList
                                                  SendDlgItemMessage: self 2drop
                              z" *.*" rel>abs 0 LB_DIR    GetID: LeftList
                                                   SendDlgItemMessage: SELF 2drop
                       ;

                : 磁碟機選擇
                       0 0 CB_RESETCONTENT GetID: DirList
                                         SendDlgItemMessage: self drop
                       z" 選擇磁碟機" rel>abs 0 CB_ADDSTRING GetID: DirList
                                         SendDlgItemMessage: self drop
                       z" a:\" rel>abs 0 CB_ADDSTRING    GetID: DirList
                                         SendDlgItemMessage: self drop
                       z" b:\" rel>abs 0 CB_ADDSTRING    GetID: DirList
                                         SendDlgItemMessage: self drop
                       z" c:\" rel>abs 0 CB_ADDSTRING    GetID: DirList
                                         SendDlgItemMessage: self drop
                       z" d:\" rel>abs 0 CB_ADDSTRING    GetID: DirList
                                         SendDlgItemMessage: self drop
                       z" e:\" rel>abs 0 CB_ADDSTRING    GetID: DirList
                                         SendDlgItemMessage: self drop
                       z" f:\" rel>abs 0 CB_ADDSTRING    GetID: DirList
                                         SendDlgItemMessage: self drop
                       0 0 CB_SETCURSEL    GetID: DirList
                                           SendDlgItemMessage: self drop
                       ;


                : LeftOp
                             0 0 LB_GETCURSEL GETID: LeftList
                                     SendDlgItemMessage: self

                             OldLeftSel @  <> if

                             0 0 LB_GETCOUNT GETID: LeftList
                                     SendDlgItemMessage: self
                         0<> IF
                             0 0 LB_GETANCHORINDEX GETID: LeftList
                                     SendDlgItemMessage: self

                             0 0 LB_GETCURSEL GETID: LeftList
                                     SendDlgItemMessage: self 1+

                             2dup max rot rot min dup rot rot
                        ?do
                             dup  fontname 1+ rel>abs swap LB_GETTEXT
                             GETID: LeftList SendDlgItemMessage: self
                             dup 0< 0=
                             if
                                 127 min fontname c!
                             then

                             0 fontname 1+ rel>abs swap LB_ADDSTRING
                             GETID: RightList
                             SendDlgItemMessage: self drop
                              dup 0 swap   LB_DELETESTRING GetID: LeftList
                                   SendDlgItemMessage: self drop
                        loop
                                drop

                             0 0 LB_GETCURSEL GETID: LeftList
                                     SendDlgItemMessage: self
                             OldLeftSel !
                         then
                         then
                         ;
                : AllLeftOp
                             0 0 LB_GETCOUNT GETID: LeftList
                                     SendDlgItemMessage: self
                             0
                             2dup max rot rot min dup rot rot
                        ?do
                             dup  fontname 1+ rel>abs swap LB_GETTEXT
                             GETID: LeftList SendDlgItemMessage: self
                             dup 0< 0=
                             if
                                 127 min fontname c!
                             then

                             0 fontname 1+ rel>abs swap LB_ADDSTRING
                             GETID: RightList
                             SendDlgItemMessage: self drop
                              dup 0 swap   LB_DELETESTRING GetID: LeftList
                                   SendDlgItemMessage: self drop
                        loop
                                drop
                         ;
                 : RightOp

                             0 0 LB_GETCURSEL GETID: RightList
                                     SendDlgItemMessage: self

                             OldRightSel @  <> if

                             0 0 LB_GETCOUNT GETID: RightList
                                     SendDlgItemMessage: self
                          0 <> if
                             0 0 LB_GETANCHORINDEX GETID: RightList
                                     SendDlgItemMessage: self

                             0 0 LB_GETCURSEL GETID: RightList
                                     SendDlgItemMessage: self 1+
                             2dup max rot rot min dup rot rot
                        ?do
                             dup  fontname 1+ rel>abs swap LB_GETTEXT
                             GETID: RightList SendDlgItemMessage: self
                             dup 0< 0=
                             if
                                 127 min fontname c!
                             then

                             0 fontname 1+ rel>abs swap LB_ADDSTRING
                             GETID: LeftList
                             SendDlgItemMessage: self drop
                              dup 0 swap   LB_DELETESTRING GetID: RightList
                                   SendDlgItemMessage: self drop
                        loop
                                drop
                             0 0 LB_GETCURSEL GETID: RightList
                                     SendDlgItemMessage: self
                             OldRightSel !
                        then
                        then
                        ;

                 : AllRightOp
                             0 0 LB_GETCOUNT GETID: RightList
                                     SendDlgItemMessage: self
                                     0
                             2dup max rot rot min dup rot rot
                        ?do
                             dup  fontname 1+ rel>abs swap LB_GETTEXT
                             GETID: RightList SendDlgItemMessage: self
                             dup 0< 0=
                             if
                                 127 min fontname c!
                             then
                             0 fontname 1+ rel>abs swap LB_ADDSTRING
                             GETID: LeftList
                             SendDlgItemMessage: self drop
                              dup 0 swap   LB_DELETESTRING GetID: RightList
                                   SendDlgItemMessage: self drop
                        loop
                                drop
                        ;
                 : OKOp
                        0 0 LB_GETANCHORINDEX GETID: LeftList
                                    SendDlgItemMessage: self
                        0 0 LB_GETCURSEL GETID: LeftList
                                    SendDlgItemMessage: self
                                     DUP
                        fontname 1+ rel>abs swap LB_GETTEXT
                         GETID: LeftList
                                    SendDlgItemMessage: self
                        dup 0< 0=
                        if      127 min fontname c! cr fontname
                         count type
                          else    DROP    CLOSE: SELF
                         then   CLOSE: SELF
                        CR
                        ." YOUR SELECT IS : " SWAP . ." 至 " .
                         ." 項"
                        key
                        bye
                        ;


                : DirList更新
                        self  Close: DirList
                        self  Start: DirList
                              SizeDirList dup 2dup  @ swap 4 + @  2swap 8 + @
                               swap 12 + @ Move: DirList
                        0 0 CB_RESETCONTENT
                        GetID: DirList SendDlgItemMessage: self drop

                        z" 選擇磁碟機" rel>abs 0 CB_ADDSTRING
                                  GetID: DirList SendDlgItemMessage: self drop
                        0 0 CB_SETCURSEL GetID: DirList
                                                 SendDlgItemMessage: self drop

                        0 to total-file-bytes
                        0 to #files                          \ reset # of files in dir
                        s" *.*" temp$ place temp$ count
                        find-first-file nip                  \ adrd ior - find first file
                        0 <> if exit then                    \ if file is not found, exit
                        _win32-find-data @ FILE_ATTRIBUTE_DIRECTORY and
                         if
                                  get-file-name rel>abs 0 CB_ADDSTRING    GetID: DirList
                                                       SendDlgItemMessage: SELF   drop
                             then

                          1 +to #files                         \ update file number

                          begin find-next-file nip 0=          \ ior - find next file
                          while 1 +to #files                   \ update file number
                          50 ?cr
                          _win32-find-data @ FILE_ATTRIBUTE_DIRECTORY and if
                              get-file-name rel>abs 0 CB_ADDSTRING    GetID: DirList
                                                   SendDlgItemMessage: SELF drop
                                then
                               start/stop
                          repeat

                        ;

                : 清除改磁碟
                     0 DirString  c!
                              self Close: DirList self  Start: DirList
                              SizeDirList dup 2dup  @ swap 4 + @  2swap 8 + @
                              swap 12 + @ Move: DirList
                          磁碟機選擇
                        ;

                : GetDirString
                        0 0 CB_GETCURSEL GETID: DirList
                                    SendDlgItemMessage: self

                        fontname 1+ rel>abs swap CB_GETLBTEXT
                                     GETID: DirList
                                    SendDlgItemMessage: self
                        dup 0< 0=
                        if      127 min Fontname c!
                                Fontname count TempDirString place
                         else    DROP
                         then

                        0 0 CB_GETCURSEL GETID: DirList
                                    SendDlgItemMessage: self
                        ;

                : 移動路徑
                        Fontname dup 1+  rel>abs call SetCurrentDirectory  2drop
                        ;

                : DirOp
                        GetDirString
                        0 =
                        if
                             清除改磁碟
                        else
                              self Close: DirList
                              移動路徑
                              self Start: DirList
                              SizeDirList dup 2dup  @ swap 4 + @  2swap 8 + @
                               swap 12 + @ Move: DirList      drop
                              DirList更新
                              self Close: LeftList
                              FileList更新
                        then
                        ;
                :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" 檔案清單 : "   SetText: LeftText
                              FileList更新
                        self  Start: RightList
                              SizeRightList 4X4@ Move: RightList
                              self  Start: RightText
                              SizeRightText 4X4@ Move: RightText
                              s" 轉圖清單 : "   SetText: RightText
                        self  Start: DirList
                              SizeDirList  4X4@ Move: DirList
                              磁碟機選擇
                        DirID SetID: DirButton
                        self  Start: DirButton
                              SizeDirButton 4X4@ Move: DirButton
                              s" 更新"   SetText: DirButton
                        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
                        LeftID   SetID: Button_Left
                        self   Start: Button_Left
                              SizeButton_Left 4X4@ Move: Button_Left
                               s" 加入"           SetText: Button_Left
                        RightID   SetID: Button_Right
                        self  Start: Button_Right
                              SizeButton_Right 4X4@ Move: Button_Right
                               s" 還原"           SetText: Button_Right
                        AllLeftID   SetID: Button_AllLeft
                        self Start: Button_AllLeft
                              SizeButton_AllLeft 4X4@ Move: Button_AllLeft
                               s" 全部加入"           SetText: Button_AllLeft
                        AllRightID   SetID: Button_AllRight
                        self Start: Button_AllRight
                              SizeButton_AllRight 4X4@ Move: Button_AllRight
                               s" 全部還原"           SetText: Button_AllRight
                        ;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
                                LeftID  of      2drop LeftOp     endof
                                RightID of      2drop RightOp    endof
                                DirID   of      2drop DirOp      endof
                                AllLeftID  of   2drop AllLeftOp  endof
                                AllRightID of   2drop AllRightOp endof
                        endcase
                         ;M
                ;OBJECT

        : Listdemo          ( -- )
                Start: ListSample
                bye
                 ;
    '  Listdemo turnkey list
    listdemo