|
Documentation component by
D.Glodt (c)2004 |
Appendix A:
QTabControlEx |
|
|
|
|
Fields |
Type |
R/W |
Default |
|
|
|
|
|
|
|
|
TabCount |
INTEGER |
R |
0 |
|
|
Tab count |
|
|
Method |
Type |
Description |
Params |
|
|
|
|
|
|
|
|
DeleteTabs |
SUBI(Index&) |
Delete tabs |
1 |
|
|
Clear |
SUB |
Remove all |
0 |
|
Event |
Type |
Occurs when... |
Params |
|
|
|
|
|
|
|
' From Paul Ludgate alias
snakedile@yahoo.com
' Re:- QTabControl Deltabs (and finding out number of tabs)
' I've only just joined your group so sorry I'm late.
' A fresh approach (I think)
' There are ways of doing this with API calls.
' One small problem... you need the tabcontrol's handle
' and RapidQ doesn't provide one!
' The best way I find to get one is to wrap the tabcontrol
' in a QPanel and find the handle of its child.
' The tabcontrol is aligned as alClient to this Qpanel
' so any resizing or further aligning should be applied
' to the QPanel and not directly to the tabcontrol.
' Now if you try the new QObject (QTabControlEx)
' noting the line just before Form.ShowModal,
' I think you'll find that DelTabs behaves exactly
' how it should have in QTabControl.
' Plus I've thrown in three extra methods that could
' solve some other needs.
' METHOD TYPE
' SetMinTabWidth SUB(Width%)
' Clear SUB()
' TabCount FUNCTION() AS INTEGER
CONST TCM_GETITEMCOUNT = &H1304
CONST TCM_DELETEITEM = &H1308
CONST TCM_DELETEALLITEMS = &H1309
CONST TCM_SETMINTABWIDTH = &H1331
CONST GW_CHILD = 5
DECLARE FUNCTION GetWindow LIB "USER32" ALIAS "GetWindow" (hWnd%, wCmd%) AS
LONG
DECLARE FUNCTION SendMessageGet LIB "USER32" ALIAS "SendMessageA" (hWnd%,
wMsg%, wParam%, lParam%) AS LONG
TYPE QTabControlEx EXTENDS QTABCONTROL
Handle AS INTEGER
SUBI DelTabs(...)
FOR I% = ParamValCount TO 1 STEP - 1
SendMessage(QTabControlEx.Handle, TCM_DELETEITEM, ParamVal(I%), 0&)
NEXT
END SUB
SUB Clear()
SendMessage(Tab.Handle, TCM_DELETEALLITEMS, 0&, 0&)
END SUB
SUB SetMinTabWidth(Width%)
SendMessage(Tab.Handle, TCM_SETMINTABWIDTH, 0&, Width%)
END SUB
FUNCTION TabCount() AS INTEGER
QTabControlEx.TabCount = SendMessageGet(Tab.Handle, TCM_GETITEMCOUNT, 0&, 0&)
END FUNCTION
END TYPE
DECLARE SUB Demo1
DECLARE SUB Demo2
DECLARE SUB Demo3
CREATE Form AS QFORM
Width = 500
Height = 300
Caption = "QTabControlEx Demo"
Center
CREATE ButtonBar AS QPANEL
Height = 44
Align = 1
Color = &HFFC080
BevelOuter = 1
CREATE Button1 AS QBUTTON
Top = 10
Left = 10
Width = 150
Caption = "Tab.SetMinTabWidth 60"
OnClick = Demo1
END CREATE
CREATE Button2 AS QBUTTON
Top = 10
Left = 170
Width = 70
Width = 150
Caption = "Tab.DelTabs 1,3"
OnClick = Demo2
END CREATE
CREATE Button3 AS QBUTTON
Top = 10
Left = 330
Width = 150
Caption = "Tab.Clear"
OnClick = Demo3
END CREATE
END CREATE
CREATE TabWrapper AS QPANEL
BevelOuter = 0
Align = 5
CREATE Tab AS QTabControlEx
Align = 5
AddTabs "Tab 0", "Tab 1", "Tab 2 with long name not subject to MinTabWidth",
"Tab 3", "Tab 4"
END CREATE
END CREATE
END CREATE
' get the handle of the TabControl
Tab.Handle = GetWindow(TabWrapper.Handle, GW_CHILD)
Form.ShowModal
SUB Demo1
Tab.SetMinTabWidth 60
Form.Caption = "QTabControlEx Demo"
END SUB
SUB Demo2
Tab.DelTabs 1,3
Form.Caption = "Number of Tabs = " + STR$(Tab.TabCount)
END SUB
SUB Demo3
Tab.Clear
Form.Caption = "Number of Tabs = " + STR$(Tab.TabCount)
END SUB
Example 2.
Burkley David.
$Include "RapidQ.inc"
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (hWnd As
Long, nIndex As Long, dwNewLong As Long) As Long
Declare Function SendMessageAPI Lib "user32" Alias "SendMessageA" (hWnd As Long,
Msg As Long, wParam As Long, lParam As Long) As Long
Declare Function GetParent Lib "user32" Alias "GetParent" (hWnd As Long) As Long
Declare Sub FileOpen
Declare Sub FileNewTab
Declare Sub FileClearTab
Declare Sub FileCloseTab
Declare Sub FormExit
Declare Sub TabChanged
Declare Sub TabCheck
Const TCM_DELETEITEM = &H1308 'need to use this when you delete a tab
DefStr NameOfTab, NameOfFile
DefInt TabIdx, TabCnt
DefInt REditCnt = 1
Dim FileNames As QStringList
Dim OpenDialog As QOpenDialog
OpenDialog.Filter = "All Files|*.*"
Dim InactiveTabFont As QFont
InactiveTabFont.Name = "Arial"
InactiveTabFont.Color = RGB(255,255,255)
InactiveTabFont.Bold = True
Dim ActiveTabFont As QFont
ActiveTabFont.Name = "Arial"
ActiveTabFont.Color = RGB(000,000,000)
Dim RichEditFont As QFont
RichEditFont.Name = "Courier New"
RichEditFont.Size = 10
Dim MainForm as QForm
MainForm.Caption = " TabControl Demo (that includes a fully functional Close Tab
option)"
MainForm.Width = 640
MainForm.Height = 480
MainForm.Center
MainForm.OnClose = FormExit
Dim MainMenu As QMainMenu
MainMenu.Parent = MainForm
Dim File As QMenuItem
File.Caption = "&File"
MainMenu.AddItems File
Dim fOpen As QMenuItem
fOpen.Caption = "Open a File..."
fOpen.OnClick = FileOpen
File.AddItems fOpen
Dim fLine1 As QMenuItem
fLine1.Caption = "-"
File.AddItems fLine1
Dim fNewTab As QMenuItem
fNewTab.Caption = "Open New Tab"
fNewTab.Enabled = False
fNewTab.Onclick = FileNewTab
File.AddItems fNewTab
Dim fClearTab As QMenuItem
fClearTab.Caption = "Clear This Tab"
fClearTab.Enabled = False
fClearTab.Onclick = FileClearTab
File.AddItems fClearTab
Dim fCloseTab As QMenuItem
fCloseTab.Caption = "Close This Tab"
fCloseTab.Enabled = False
fCloseTab.Onclick = FileCloseTab
File.AddItems fCloseTab
Dim fLine2 As QMenuItem
fLine2.Caption = "-"
File.AddItems fLine2
Dim fExit As QMenuItem
fExit.Caption = "Exit"
fExit.OnClick = FormExit
File.AddItems fExit
Dim StatusBar As QStatusBar
StatusBar.Parent = MainForm
StatusBar.SizeGrip = False
StatusBar.AddPanels "" , ""
StatusBar.Panel(0).Width = 60
StatusBar.Panel(0).Alignment = taCenter
Dim TabControl As QTabControl
TabControl.Parent = MainForm
TabControl.Align = alClient
TabControl.Font = ActiveTabFont
TabControl.TabInactiveFont = InactiveTabFont
TabControl.TabInactiveColor = RGB(000,000,000)
TabControl.AddTabs ""
TabControl.MultiLine = True
TabControl.OnChange = TabChanged
Dim RichEdit(1) As QRichEdit
RichEdit(1).Parent = TabControl
RichEdit(1).Align = alClient
RichEdit(1).ScrollBars = ssBoth
RichEdit(1).HideSelection = False
RichEdit(1).WordWrap = False
RichEdit(1).SelectAll 'start of fix for Win98 quirk with setting the font
RichEdit(1).Font = RichEditFont 'this is typical for Win98 and WinXP and not
part of the fix
RichEdit(1).SelStart = 0 'end of fix for Win98 quirk
RichEdit(1).PlainText = True
SendMessageAPI(RichEdit(1).Handle, &H435, 0, 1024*1024*2)
SetWindowLong(MainForm.Handle, -8, 0)
SetWindowLong(Application.Handle, -8, MainForm.Handle)
MainForm.ShowModal
Sub FileOpen
If OpenDialog.Execute Then
NameOfFile = OpenDialog.FileName
TabIdx = TabControl.TabIndex
REditCnt = TabIdx + 1
If FileNames.ItemCount = 0 Then FileNames.AddItems(NameOfFile)
If FileNames.ItemCount > 0 And FileNames.Item(TabIdx) <> NameOfFile Then
FileNames.Item(TabIdx) = NameOfFile
NameOfTab = " " + Right$(NameOfFile, Len(NameOfFile) - rInStr(NameOfFile,"\")) +
" "
TabControl.Tab(TabIdx) = NameOfTab
RichEdit(REditCnt).Parent = TabControl
RichEdit(REditCnt).Align = alClient
RichEdit(REditCnt).ScrollBars = ssBoth
RichEdit(REditCnt).HideSelection = False
RichEdit(REditCnt).WordWrap = False
RichEdit(REditCnt).SelectAll 'start of fix for Win98 quirk with setting the font
RichEdit(REditCnt).Font = RichEditFont 'this is typical for Win98 and WinXP and
not part of the fix
RichEdit(REditCnt).SelStart = 0 'end of fix for Win98 quirk
RichEdit(REditCnt).PlainText = True
RichEdit(REditCnt).Clear
RichEdit(REditCnt).LoadFromFile NameOfFile
RichEdit(REditCnt).Modified = False
SendMessageAPI(RichEdit(REditCnt).Handle, &H435, 0, 1024*1024*2)
StatusBar.Panel(1).Caption = FileNames.Item(TabIdx)
fClearTab.Enabled = True
TabCheck
End If
End Sub
Sub FileNewTab
INC(TabCnt)
REditCnt = TabCnt + 1
ReDim RichEdit(REditCnt) As QRichEdit
TabControl.AddTabs ""
RichEdit(REditCnt).Parent = TabControl
RichEdit(REditCnt).Align = alClient
RichEdit(REditCnt).ScrollBars = ssBoth
RichEdit(REditCnt).HideSelection = False
RichEdit(REditCnt).WordWrap = False
RichEdit(REditCnt).SelectAll 'start of fix for Win98 quirk with setting the font
RichEdit(REditCnt).Font = RichEditFont 'this is typical for Win98 and WinXP and
not part of the fix
RichEdit(REditCnt).SelStart = 0 'end of fix for Win98 quirk
RichEdit(REditCnt).PlainText = True
RichEdit(REditCnt).Clear
SendMessageAPI(RichEdit(REditCnt).Handle, &H435, 0, 1024*1024*2)
StatusBar.Panel(1).Caption = ""
FileNames.AddItems("")
TabControl.TabIndex = TabCnt
TabChanged
TabCheck
FileOpen
End Sub
Sub FileClearTab
TabIdx = TabControl.TabIndex
ReEditIdx = TabIdx + 1
RichEdit(ReEditIdx).Clear
TabControl.Tab(TabIdx) = ""
FileNames.Item(TabIdx) = ""
StatusBar.Panel(1).Caption = ""
fClearTab.Enabled = False
TabCheck
End Sub
Sub FileCloseTab
TabIdx = TabControl.TabIndex
'the next two (if/then) conditions are needed "before" you delete a tab so you
don't
'lose any information about objects within "any other" tabs and so that when you
'reference information about those objext... things will get pointed to the
"correct"
'information.
If TabControl.TabIndex < TabCnt Then
ReEditIdx = TabIdx + 1
FileNames.DelItems(TabIdx)
For I = ReEditIdx To TabCnt
RichEdit(I).Text = RichEdit(I+1).Text
Next I
End If
If TabControl.TabIndex = TabCnt Then
ReEditIdx = TabIdx + 1
FileNames.DelItems(TabIdx)
RichEdit(ReEditIdx).Visible = False
End If
'this is the workaround to the missing Handle class for a QTabControl object.
'just get the handle of the parent for an object already within the QTabControl
object.
TabCtrl = GetParent(RichEdit(ReEditIdx).Handle)
'simple API call to delete a tab.
'just pass the Handle of the QTabControl object and also the TabIndex to be
deleted.
SendMessageAPI(TabCtrl, TCM_DELETEITEM, TabIdx, 0)
DEC(TabCnt)
DEC(REditCnt)
StatusBar.Panel(1).Caption = FileNames.Item(TabCnt)
'point the TabIndex to the "last" opened tab so that the QTabControl
'will get painted properly... if there's multiple tabs still opened.
TabControl.TabIndex = TabCnt
TabChanged
TabCheck
End Sub
Sub FormExit
Application.Terminate
End Sub
Sub TabChanged
StatusBar.Panel(1).Caption = ""
For I = 0 To TabCnt
If I = TabControl.TabIndex Then
RichEdit(I+1).Visible = True
StatusBar.Panel(1).Caption = FileNames.Item(I)
If RichEdit(I+1).Text <> "" Then
fClearTab.Enabled = True
Else
fClearTab.Enabled = False
End If
Else
RichEdit(I+1).Visible = False
End If
Next I
TabCheck
End Sub
Sub TabCheck
fNewTab.Enabled = True
For I = 0 To TabCnt
If RichEdit(I+1).Text = "" Then fNewTab.Enabled = False
Next I
fCloseTab.Enabled = IIF(TabCnt>0, True, False)
End Sub