Update of /cvsroot/win32forth/win32forth/demos
In directory sc8-pr-cvs9.sourceforge.net:/tmp/cvs-serv22849/demos
Added Files:
TabControlDemo.f
Log Message:
New demo for a window that contains a tabulator control. Within the client area of the tabulator control listview controls are displayed.
--- NEW FILE: TabControlDemo.f ---
\ $Id: TabControlDemo.f,v 1.1 2006/05/28 09:05:31 dbu_de Exp $
\
\ Demo for a window that contains a tabulator control.
\ Within the client area of the tabulator control listview controls
\ are displayed.
\
\ Written by Dirk Busch
needs ExControls.f
Needs ListView.f
anew -TabControlDemo.f
internal
external
\ ------------------------------------------------------------------------
\ ------------------------------------------------------------------------
:class TabControlEx <super TabControl
:M WndClassStyle: ( -- style )
\ Set the style member of the the WNDCLASS structure.
CS_DBLCLKS ;M
:M Start: ( Parent -- )
Start: super
DEFAULT_GUI_FONT call GetStockObject SetFont: self
;M
;class
\ ------------------------------------------------------------------------
\ ------------------------------------------------------------------------
:class ListViewEx <super ListView
:M WindowStyle: ( -- style )
WindowStyle: super
[ LVS_REPORT LVS_SHOWSELALWAYS OR LVS_EDITLABELS or ] literal or
;M
:M WndClassStyle: ( -- style )
\ Set the style member of the the WNDCLASS structure.
CS_DBLCLKS ;M
;class
\ ------------------------------------------------------------------------
\ ------------------------------------------------------------------------
:object DemoWindow <super Window
TabControlEx cTab
ListViewEx cFileList
ListViewEx cBrowserList
LV_ITEM LvItem
LV_COLUMN lvc
:M ReSize: ( -- )
\ Resize the controls within the main window.
AutoSize: cTab
ClientSize: cTab Move: cFileList
ClientSize: cTab Move: cBrowserList
;M
:M On_Size: ( -- )
\ Handle the WM_SIZE message.
On_Size: super
\ Note: This method can be called before the controls within the window
\ are created, so we should better check if the parent of the tab control
\ is valid or not!
GetParent: cTab
if ReSize: self
then ;M
:M SelChange: ( -- )
\ Show the listview control for the currently selected tab.
GetSelectedTab: cTab 0=
if SW_HIDE Show: cBrowserList
SW_SHOW Show: cFileList
else SW_HIDE Show: cFileList
SW_SHOW Show: cBrowserList
then ;M
: selchange-func { lParam obj \ Parent -- false }
\ This function es executed when the currently selected tab has changed.
\ lParam is the adress of the Address of an NMHDR structure.
\ obj is the address of the TabControl object that has send the
\ notification message.
GetParent: obj to Parent
SelChange: Parent
false ;
:M WM_NOTIFY ( h m w l -- f )
\ Handle the notification messages of the tab control.
dup @ GetHandle: cTab =
if Handle_Notify: cTab
then false
;M
:M Start: ( -- )
Start: super
self Start: cFileList
self Start: cBrowserList
self Start: cTab
\ ------------------------------------------------------------------------
['] selchange-func IsChangeFunc: cTab
TCIF_TEXT IsMask: cTab
z" Files" IsPszText: cTab
1 InsertTab: cTab
TCIF_TEXT IsMask: cTab
z" Browser" IsPszText: cTab
2 InsertTab: cTab
\ ------------------------------------------------------------------------
[ LVCF_FMT LVCF_WIDTH or LVCF_TEXT or LVCF_SUBITEM or ] literal Setmask: lvc
LVCFMT_LEFT Setfmt: lvc
50 Setcx: lvc
z" Files" SetpszText: lvc
Addr: lvc 1 InsertColumn: cFileList drop
z" Words" SetpszText: lvc
Addr: lvc 1 InsertColumn: cBrowserList drop
\ ------------------------------------------------------------------------
LVIF_TEXT SetMask: LvItem
z" File 1" SetpszText: LvItem
Addr: LvItem InsertItem: cFileList drop
z" File 2" SetpszText: LvItem
Addr: LvItem InsertItem: cFileList drop
z" abc" SetpszText: LvItem
Addr: LvItem InsertItem: cBrowserList drop
z" def" SetpszText: LvItem
Addr: LvItem InsertItem: cBrowserList drop
\ ------------------------------------------------------------------------
ReSize: self \ resize the controls within the main window
SelChange: self \ show the control for the currently selected tab
;M
:M WindowTitle: ( -- Zstring )
\ Set the window caption. Default is "Window".
z" Tabulator control Demo" ;M
;object
module
Start: DemoWindow
|
