This is a continuation of my User Interface Com Server.
The source is still a mess and incomplete so I have not included it in the zip.
Posted here to show some ideas I have come up with over the course of the last
few months.
James
'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'Example Demo using a work in progress COM UISERVER
'James C. Fuller
'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
'SED_PBWIN
'=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*
#COMPILE EXE
#DIM ALL
#TOOLS OFF
'------------------------------------------------------------------------------
'José Include files
#INCLUDE ONCE "Windows.Inc"
#INCLUDE ONCE "CommCtrl.inc"
'------------------------------------------------------------------------------
'Conditional Compile Equates for PBLIB95.BAS"
%USE_MakeFont2 = 1
%USE_VSpaceControls = 1
%USE_CenterWindow = 1
%USE_VCenterCtrlOnDialog = 1
%USE_RECTWIDTH = 1
%USE_RECTHEIGHT = 1
#INCLUDE "PBLIB95.BAS"
'------------------------------------------------------------------------------
'Conditional Compile Equates for PbUIServer01.Bas
%Use_cDisplayOpenFileClass = 1
%Use_cDisplayBrowseClass = 1
%Use_cTabControlClass = 1
%Use_cControlClass = 1
%Use_cRaGridClass = 1
%Use_cRaGridColClass = 1
%Use_cWindowClass = 1
%Use_cAppClass = 1
%Use_Server = 1
#IF %DEF(%Use_Server)
%RemoveProps = 2
TYPE CtlInfoType
Class AS LONG
ObjPtr AS DWORD
END TYPE
$ObjInfo = "ObjInfo"
CLASS cApp
INTERFACE iApp : INHERIT IUNKNOWN
METHOD MsgLoop() AS LONG
LOCAL hWndModeless AS LONG
LOCAL Msg AS tagMsg
WHILE GetMessage(Msg, %NULL, 0, 0)
hWndModeless = Me.GetFormHandle(GetFocus())
IF (hWndModeless = %NULL) OR (IsDialogMessage(hWndModeless, msg) = 0) THEN
TranslateMessage msg
DispatchMessage msg
END IF
WEND
METHOD = Msg.wParam
END METHOD
METHOD GetFormHandle( BYVAL hWnd AS DWORD) AS DWORD
WHILE (GetWindowLong(hWnd, %GWL_STYLE) AND %WS_CHILD)
IF (GetWindowLong(hWnd, %GWL_EXSTYLE) AND %WS_EX_MDICHILD) THEN
EXIT LOOP
END IF
hWnd = GetParent(hWnd)
WEND
METHOD = hWnd
END METHOD
END INTERFACE
END CLASS
#INCLUDE ONCE "RAGrid.inc"
#INCLUDE ONCE "PBUISERVER.inc"
#ELSE
#INCLUDE ONCE "PBUISERVER01.Bas"
#ENDIF
'==============================================================================
%GETFILEBUT = 1003
%DATABUT = 105
#IF %DEF(%Use_Server)
MACRO NewWindow = NEWCOM CLSID $CLSID_CWINDOW LIB "PBUISERVER.DLL"
MACRO NewControl = NEWCOM CLSID $CLSID_CCONTROL LIB "PBUISERVER.DLL"
MACRO NewGridCol = NEWCOM CLSID $CLSID_CGRIDCOL LIB "PBUISERVER.DLL"
MACRO NewOpenFile = NEWCOM CLSID $CLSID_CDISPLAYOPENFILE LIB "PBUISERVER.DLL"
#ELSE
MACRO NewWindow = CLASS "cWindow"
MACRO NewControl = CLASS "cControl"
MACRO NewGridCol = CLASS "cGridCol"
MACRO NewOpenFile = CLASS "cDisplayOpenFile"
#ENDIF
'==============================================================================
GLOBAL goApp AS iSdkWinApp
' I think I like this concept for use with control Id's
'It keeps them all in one place and I can use arrays to initialize
CLASS cConst
INSTANCE GetFileButton,GridDataBut,LBox,Combo,OkBut,CancelBut AS LONG
INSTANCE Panel_Id(),Option_Id(),Check_Id(),TabPages_Id() AS LONG
INSTANCE Tab_Id,Status_Id AS LONG
INSTANCE Edit_01,Edit_02,Memo_01,DismissBut AS LONG
INSTANCE Menu_New,Menu_Open,Menu_Save,Menu_SaveAs,Menu_Delete,Menu_Print,Menu_Exit AS LONG
CLASS METHOD CREATE
LOCAL i AS LONG
REDIM Panel_Id(10)
REDIM Option_Id(5)
REDIM TabPages_Id(5)
REDIM Check_Id(5)
GetFileButton = 1003
LBox = 1004
Combo = 1005
Edit_01 = 1006
Edit_02 = 1007
Memo_01 = 1008
GridDataBut = 1009
Tab_Id = 1300
Status_Id = 1310
OkBut = %IDOK
CancelBut = %IDCANCEL
Menu_New = 3000
Menu_Open = 3001
Menu_Save = 3001
Menu_SaveAs = 3002
Menu_Delete = 3003
Menu_Print = 3004
Menu_Exit = 3005
FOR i = 0 TO 10
Panel_Id(i) = i+1100
NEXT i
FOR i = 0 TO 5
Option_Id(i) = i + 1150
TabPages_Id(i) = i + 1200
Check_Id(i) = i+ 1250
NEXT i
END METHOD
INTERFACE iConst : INHERIT IUNKNOWN
PropGet(Menu_New,LONG)
PropGet(Menu_Open,LONG)
PropGet(Menu_Save,LONG)
PropGet(Menu_SaveAs,LONG)
PropGet(Menu_Delete,LONG)
PropGet(Menu_Print,LONG)
PropGet(Menu_Exit,LONG)
PropGet(GetFileButton,LONG)
PropGet(Tab_Id,LONG)
PropGet(Status_Id,LONG)
PropGet(Lbox,LONG)
PropGet(Combo,LONG)
PropGet(Edit_01,LONG)
PropGet(Edit_02,LONG)
PropGet(Memo_01,LONG)
PropGet(GridDataBut,LONG)
PropGet(OkBut,LONG)
PropGet(CancelBut,LONG)
PROPERTY GET Option_Id(BYVAL Index AS LONG) AS LONG
PROPERTY = Option_Id(Index)
END PROPERTY
'------------------------------------------------------------------------------
PROPERTY GET Check_Id(BYVAL Index AS LONG) AS LONG
PROPERTY = Check_Id(Index)
END PROPERTY
'------------------------------------------------------------------------------
PROPERTY GET Panel_Id(BYVAL Index AS LONG) AS LONG
PROPERTY = Panel_Id(Index)
END PROPERTY
'------------------------------------------------------------------------------
PROPERTY GET TabPages_Id(BYVAL Index AS LONG) AS LONG
PROPERTY = TabPages_Id(Index)
END PROPERTY
'------------------------------------------------------------------------------
END INTERFACE
END CLASS
GLOBAL Const AS iConst
'==============================================================================
CLASS cSdkWinApp
INSTANCE oMainWin AS iWindow
INSTANCE hInst AS LONG
INSTANCE hWin AS DWORD
INSTANCE oOkBut,oStatus,oCancelBut,oBut2,oTabCtl,oFileBut,oLBox,oCombo AS iControl
INSTANCE oEdit_01,oEdit_02,oMemo_01,oGrid,oGridDataBut AS iControl
INSTANCE oTab AS iTabControl
INSTANCE oPanel() AS iControl
INSTANCE oTabPage() AS iWindow
INSTANCE oOption() AS iControl
INSTANCE oCheck() AS iControl
INSTANCE oRAGrid AS iRAGrid
INSTANCE oGridCol AS iGridCol
INTERFACE iSdkWinApp : INHERIT cApp,iApp
PropGet(hInst,LONG)
PropSet(hInst,LONG)
METHOD Run() AS LONG
LOCAL hFont,i,j,RetVal,hMenu,hPopUp AS LONG
REDIM oTabPage(4)
REDIM hBtns(1 TO 2) AS DWORD
REDIM oPanel(10)
REDIM oOption(3)
REDIM oCheck(3)
oMainWin = NewWindow
IF ISNOTHING(oMainWin) THEN RET_M(-1)
oMainWin.CallBackProc = CODEPTR(MainWinCallBack)
oMainWin.BackColor = GetSysColor(%COLOR_BTNFACE)
oMainWin.Style = %WS_OVERLAPPED OR %WS_MINIMIZEBOX OR %WS_SYSMENU
oMainWin.Width = 780
oMainWin.Height = 580
hWin = oMainWin.CreateWin
IF hWin = 0 THEN RET_M(-2)
CenterWindow oMainWin.Handle
hFont = MakeFont2("Tahoma",11,%FW_NORMAL)
'Menu
MENU NEW BAR TO hMenu
MENU NEW POPUP TO hPopup
MENU ADD STRING, hPopup, "&New", Const.Menu_New, %MF_ENABLED
MENU ADD STRING, hPopup, "&Open", Const.Menu_Open, %MF_ENABLED
MENU ADD STRING, hPopup, "&Save", Const.Menu_Save, %MF_ENABLED
MENU ADD STRING, hPopup, "Save &As", Const.Menu_SaveAs, %MF_ENABLED
MENU ADD STRING, hPopup, "-",0,0
MENU ADD STRING, hPopup, "&Delete", Const.Menu_Delete, %MF_ENABLED
MENU ADD STRING, hPopup, "-",0,0
MENU ADD STRING, hPopup, "&Print", Const.Menu_Print, %MF_ENABLED
MENU ADD STRING, hPopup, "-",0,0
MENU ADD STRING, hPopup, "E&xit", Const.Menu_Exit, %MF_ENABLED
MENU ADD POPUP, hMenu, "&File", hPopup, %MF_ENABLED
MENU ATTACH hMenu, hWin
'Ok Command Button
oOkBut = NewControl
IF ISNOTHING(oOkBut) THEN RET_M(-3)
oOkBut.Class = "BUTTON"
oOkBut.Name = "Ok Button"
oOkBut.Id = %IDOK
oOkBut.Text = "OK"
oOkBut.Parent = oMainWin.Handle
oOkBut.Top = oMainWin.Height - 120'500
oOkBut.Width = 80
oOkBut.Height = 30
oOkBut.Font = hFont
oOkBut.CreateControl
hBtns(1) = oOkBut.Id
'Cancel Command Button
oCancelBut = NewControl
IF ISNOTHING(oCancelBut) THEN RET_M(-3)
oCancelBut.Class = "BUTTON"
oCancelBut.Name = "Cancel Button"
oCancelBut.Id = %IDCANCEL
oCancelBut.Text = "Dismiss"
oCancelBut.Parent = hWin
oCancelBut.Top = oOkBut.Top'500
oCancelBut.Left = 100
oCancelBut.Height = 30
oCancelBut.Width = 80
oCancelBut.Font = hFont
oCancelBut.CreateControl
hBtns(2) = oCancelBut.Id
'Even space buttons Vertically
VSpaceControls hWin,hBtns()
'Create some windows to be used with the Tab Control
oTabPage(0) = NewWindow
IF ISNOTHING(oTabPage(0)) THEN RET_M(-1)
oTabPage(0).Parent = hWin
oTabPage(0).BackColor = GetSysColor(%COLOR_BTNFACE)
oTabPage(0).Left = 20
oTabPage(0).Top = 80
'oTabPage(0).ExStyle = %WS_EX_DLGMODALFRAME
oTabPage(0).Width = 730
oTabPage(0).Height = 260
oTabPage(0).CallBackProc = CODEPTR(MainWinCallBack)
'oTabPage(0).Id = Const.TabPages_Id(0)
oTabPage(0).Style = %WS_VISIBLE
oTabPage(0).CreateChildWin
TracePrint("oTabPage(0).Handle -> " + FORMAT$(oTabPage(0).Handle))
'Raised Panel on oTabPage(0)
oPanel(0) = NewControl
IF ISNOTHING(oPanel(0)) THEN RET_M(-3)
oPanel(0).Class = "RPANEL"
oPanel(0).Name = "oPanel(0)"
oPanel(0).Id = Const.Panel_Id(0)
oPanel(0).Text = " Select A File"
oPanel(0).Left = 16
oPanel(0).Top = 16
oPanel(0).Width = 700
oPanel(0).Height = 55
oPanel(0).Parent = oTabPage(0).Handle
oPanel(0).ForeColor = &H8E6B23
oPanel(0).CreateControl
'Inner sunken panel
oPanel(1) = NewControl
IF ISNOTHING(oPanel(1)) THEN RET_M(-3)
oPanel(1).Class = "SPANEL"
oPanel(1).Name = "oPanel(1)"
oPanel(1).Id = Const.Panel_Id(1)
oPanel(1).Text = ""
oPanel(1).Left = 32
oPanel(1).Top = 36
oPanel(1).Width = 620
oPanel(1).Height = 22
oPanel(1).Parent = oTabPage(0).Handle
oPanel(1).ForeColor = &HC00000
oPanel(1).Font = hFont
oPanel(1).CreateControl
'GetFile Name Button
oFileBut = NewControl
IF ISNOTHING(oFileBut) THEN RET_M(-3)
oFileBut.Class = "BUTTON"
oFileBut.Name = "Ok Button"
oFileBut.Id = Const.GetFileButton
oFileBut.Text = "..."
oFileBut.Parent = oTabPage(0).Handle
oFileBut.Top = 36
oFileBut.Left = 670
oFileBut.Width = 30
oFileBut.Height = 22
oFileBut.Font = hFont
oFileBut.CreateControl
'Raised Panel For Option Buttons
oPanel(2) = NewControl
IF ISNOTHING(oPanel(2)) THEN RET_M(-3)
oPanel(2).Class = "RPANEL"
oPanel(2).Name = "oPanel(2)"
oPanel(2).TextAlign = "CENTER"
oPanel(2).Id = Const.Panel_Id(2)
oPanel(2).Text = "Your Options"
oPanel(2).Left = 16
oPanel(2).Top = 100
oPanel(2).Width = 150
oPanel(2).Height = 150
oPanel(2).Parent = oTabPage(0).Handle
oPanel(2).ForeColor = &H8E6B23
oPanel(2).CreateControl
j = 130
FOR i = 0 TO 3
'oOption(i) = CLASS "cControl"
oOption(i) = NewControl
IF ISNOTHING(oOption(i)) THEN RET_M(-3)
oOption(i).Class = "OPTION"
oOption(i).Id = Const.Option_Id(i)
oOption(i).Parent = oTabPage(0).Handle
oOption(i).Left = 50
oOption(i).Width = 100
oOption(i).Text = "Option_"+FORMAT$(i)
oOption(i).Top = j
oOption(i).Font = hFont
oOption(i).ForeColor = &H8E6B23
oOption(i).CreateControl
j+=25
NEXT i
'Raised Panel For CheckBoxes
oPanel(3) = NewControl
IF ISNOTHING(oPanel(3)) THEN RET_M(-3)
oPanel(3).Class = "RPANEL"
oPanel(3).Name = "oPanel(3)"
oPanel(3).TextAlign = "CENTER"
oPanel(3).Id = Const.Panel_Id(3)
oPanel(3).Text = "Check Boxes"
oPanel(3).Left = 200
oPanel(3).Top = 100
oPanel(3).Width = 150
oPanel(3).Height = 150
oPanel(3).Parent = oTabPage(0).Handle
oPanel(3).ForeColor = &H8E6B23
oPanel(3).CreateControl
'Check Boxes
j = 130
FOR i = 0 TO 3
oCheck(i) = NewControl
IF ISNOTHING(oCheck(i)) THEN RET_M(-3)
oCheck(i).Class = "CHECKBOX"
oCheck(i).Id = Const.Check_Id(i)
oCheck(i).Parent = oTabPage(0).Handle
oCheck(i).Left = 234
oCheck(i).Width = 100
oCheck(i).Text = "Check_"+FORMAT$(i)
oCheck(i).Top = j
oCheck(i).Font = hFont
oCheck(i).ForeColor = &H8E6B23
oCheck(i).CreateControl
j+=25
NEXT i
'List Box Raised Panel
oPanel(4) = NewControl
IF ISNOTHING(oPanel(4)) THEN RET_M(-3)
oPanel(4).Class = "RPANEL"
oPanel(4).Name = "oPanel(4)"
oPanel(4).TextAlign = "CENTER"
oPanel(4).Id = Const.Panel_Id(4)
oPanel(4).Text = "List Box"
oPanel(4).Left = 380
oPanel(4).Top = 100
oPanel(4).Width = 150
oPanel(4).Height = 150
oPanel(4).Parent = oTabPage(0).Handle
oPanel(4).ForeColor = &H8E6B23
oPanel(4).CreateControl
'List Box
oLBox = NewControl
IF ISNOTHING(oLBox) THEN RET_M(-3)
oLBox.Class = "LISTBOX"
oLBox.Name = "LBox1"
oLBox.Id = Const.LBox
oLBox.Left = 410
oLBox.Top = 125
oLBox.Width = 100
oLBox.Height = 120
oLBox.Font = hFont
oLBox.ForeColor = &HC00000
oLBox.Style = %LBS_NOTIFY OR %LBS_STANDARD OR %WS_TABSTOP OR %WS_VISIBLE OR %WS_CHILD
oLBox.List = "Item One,Item Two,Item Three,Item Four,Item Five,Item Six,Item Seven,Item Eight"
oLBox.Parent = oTabPage(0).Handle
oLBox.CreateControl
'Combo Box Raised Panel
oPanel(5) = NewControl
IF ISNOTHING(oPanel(5)) THEN RET_M(-3)
oPanel(5).Class = "RPANEL"
oPanel(5).Name = "oPanel_6"
oPanel(5).TextAlign = "CENTER"
oPanel(5).Id = Const.Panel_Id(5)
oPanel(5).Text = "Combo Box"
oPanel(5).Left = 566
oPanel(5).Top = 100
oPanel(5).Width = 150
oPanel(5).Height = 150
oPanel(5).Parent = oTabPage(0).Handle
oPanel(5).ForeColor = &H8E6B23
oPanel(5).CreateControl
'Combo
oCombo = NewControl
IF ISNOTHING(oCombo) THEN RET_M(-3)
oCombo.Class = "COMBOBOX"
oCombo.Name = "Combo"
oCombo.id = Const.Combo
oCombo.Left = 580
oCombo.Top = 125
oCombo.Width = 120
oCombo.Height = 100
oCombo.Font = hFont
oCombo.ForeColor = &H00C0C0
oCombo.Style = %CBS_DROPDOWN OR %WS_VSCROLL OR %WS_TABSTOP OR %WS_VISIBLE OR %WS_CHILD
oCombo.List = "One,Two,Three,Four,Five,Six,Seven,Eight,Nine,Ten,Eleven,Twelve"
oCombo.Parent = oTabPage(0).Handle
oCombo.CreateControl
'Child Window For Tab Page 1
oTabPage(1) = NewWindow
IF ISNOTHING(oTabPage(1)) THEN RET_M(-1)
oTabPage(1).Parent = hWin
oTabPage(1).BackColor = GetSysColor(%COLOR_BTNFACE)
oTabPage(1).Left = 20
oTabPage(1).Top = 80
'oTabPage(1).ExStyle = %WS_EX_DLGMODALFRAME
oTabPage(1).Width = 730
oTabPage(1).Height = 280
oTabPage(1).CallBackProc = CODEPTR(MainWinCallBack)
oTabPage(1).Id = Const.TabPages_Id(1)
oTabPage(1).CreateChildWin
'Raised Panel For EditFields
oPanel(6) = NewControl
IF ISNOTHING(oPanel(6)) THEN RET_M(-3)
oPanel(6).Class = "RPANEL"
oPanel(6).Name = "oPanel(6)"
oPanel(6).TextAlign = "CENTER"
oPanel(6).Id = Const.Panel_Id(6)
oPanel(6).Text = "Edit Fields"
oPanel(6).Left = 8
oPanel(6).Top = 60
oPanel(6).Width = 130
oPanel(6).Height = 150
oPanel(6).Parent = oTabPage(1).Handle
oPanel(6).ForeColor = &H8E6B23
oPanel(6).CreateControl
'Edit Control
oEdit_01 = NewControl
IF ISNOTHING(oEdit_01) THEN RET_M(-3)
oEdit_01.Class = "EDIT"
oEdit_01.Name = "oEdit_01"
oEdit_01.Id = Const.Edit_01
oEdit_01.Text = "James Fuller"
oEdit_01.Left = 20
oEdit_01.Top = 100
oEdit_01.Height = 25
oEdit_01.Width = 110
oEdit_01.Parent = oTabPage(1).Handle
oEdit_01.Font = hFont
oEdit_01.CreateControl
'Edit Control
oEdit_02 = NewControl
IF ISNOTHING(oEdit_02) THEN RET_M(-3)
oEdit_02.Class = "EDIT"
oEdit_02.Name = "oEdit_02"
oEdit_02.Id = Const.Edit_02
oEdit_02.Text = "James Fuller"
oEdit_02.Left = 20
oEdit_02.Top = 150
oEdit_02.Height = 25
oEdit_02.Width = 110
oEdit_02.Parent = oTabPage(1).Handle
oEdit_02.Font = hFont
oEdit_02.BackColor = &HC00000
oEdit_02.ForeColor = &HFFFFFF
oEdit_02.CreateControl
'Raised Panel For Grid
oPanel(7) = NewControl
IF ISNOTHING(oPanel(7)) THEN RET_M(-3)
oPanel(7).Class = "RPANEL"
oPanel(7).Name = "oPanel(6)"
oPanel(7).TextAlign = "CENTER"
oPanel(7).Id = Const.Panel_Id(6)
oPanel(7).Text = "The KetilO Grid"
oPanel(7).Left = 150
oPanel(7).Top = 20
oPanel(7).Width = 410
oPanel(7).Height = 240
oPanel(7).Parent = oTabPage(1).Handle
oPanel(7).ForeColor = &H8E6B23
oPanel(7).CreateControl
'Get Grid Cell Data Button
oGridDataBut = NewControl
IF ISNOTHING(oGridDataBut) THEN RET_M(-3)
oGridDataBut.Class = "BUTTON"
oGridDataBut.Name = "oDataBut"
oGridDataBut.Id = Const.GridDataBut
oGridDataBut.Text = "Get Cell Data"
oGridDataBut.Parent = oTabPage(1).Handle
oGridDataBut.Left = 310
oGridDataBut.Top = oTabPage(1).Height - 70
oGridDataBut.Width = 100
oGridDataBut.Height = 30
oGridDataBut.Font = hFont
oGridDataBut.CreateControl
'iControl RAGrid
oGrid = NewControl
IF ISNOTHING(oGrid) THEN RET_M(-4)
oGrid.Class = "RAGrid"
oGrid.Id = 700
oGrid.Parent = oTabPage(1).Handle
oGrid.Top = 50
oGrid.Left = 165
oGrid.Width = 380
oGrid.Height = 142
oGrid.Style = &H5001000D OR %WS_BORDER
oGrid.CreateControl
'Contained RAGrid Class Created in iControl
oRAGrid = oGrid.oRAGrid
oRAGrid.BackColor = &HC0FFFF
oRAGrid.GridColor = &H808080
oRAGrid.TextColor = &H800000
oRAGrid.HeaderHeight = 50
'Add Columns
'This is the Col data UDT turned into a Class
oGridCol = NewGridCol
IF ISNOTHING(oGridCol) THEN RET_M(-5)
'Add Col 0
oGridCol.Width = 100
oGridCol.HeaderText = $CR+"Name"
oGridCol.HeaderAlign = %GA_ALIGN_CENTER
oGridCol.ColAlign = %GA_ALIGN_LEFT
oGridCol.ColDataType = %TYPE_EDITTEXT
oGridCol.TextMax = 31
oRAGrid.AddColumn(oGridCol)
'Add Col 1
oGridCol.HeaderText = $CR+"Address"
oRAGrid.AddColumn(oGridCol)
'Add Col 2
oGridCol.HeaderText = $CR+"Points"
oGridCol.ColDataType = %TYPE_EDITLONG
oGridCol.HeaderAlign = %GA_ALIGN_CENTER
oGridCol.ColAlign = %GA_ALIGN_RIGHT
oGridCol.TextMax = 4
oRAGrid.AddColumn(oGridCol)
'Add Col 3
oGridCol.HeaderText = $CR+"Button"
oGridCol.Width = 60
oGridCol.HeaderAlign = %GA_ALIGN_CENTER
oGridCol.ColAlign = %GA_ALIGN_LEFT
oGridCol.ColDataType = %TYPE_COMBOBOX
oGridCol.TextMax = %MAX_PATH
oGridCol.FormatStr = ""
oRAGrid.AddColumn(oGridCol)
'Add Row Data
RetVal = oRAGrid.AddComboData(3,",one,two")
RetVal = oRAGrid.AddRowData("Name#1,Address#1,1000")
RetVal = oRAGrid.AddRowData("Name#2,Address#2,2000")
RetVal = oRAGrid.AddRowData("Name#3,Address#3,3000")
RetVal = oRAGrid.AddRowData("Name#4,Address#4,4000")
RetVal = oRAGrid.AddRowData("Name#5,Address#5,5000")
RetVal = oRAGrid.AddRowData("Name#6,Address#6,6000")
RetVal = oRAGrid.AddRowData("Name#7,Address#7,7000")
RetVal = oRAGrid.AddRowData("Name#8,Address#8,8000")
RetVal = oRAGrid.AddRowData("Name#9,Address#9,9000")
RetVal = oRAGrid.AddRowData("Name#10,Address#10,10000")
'Panel for MEMO
oPanel(8) = NewControl
IF ISNOTHING(oPanel(8)) THEN RET_M(-3)
oPanel(8).Class = "RPANEL"
oPanel(8).Name = "oPanel_6"
oPanel(8).TextAlign = "CENTER"
oPanel(8).Id = Const.Panel_Id(8)
oPanel(8).Text = "Memo "
oPanel(8).Left = 580
oPanel(8).Top = 60
oPanel(8).Width = 130
oPanel(8).Height = 150
oPanel(8).Parent = oTabPage(1).Handle
oPanel(8).ForeColor = &H8E6B23
oPanel(8).CreateControl
'Multi lined edit control
oMemo_01 = NewControl
IF ISNOTHING(oMemo_01) THEN RET_M(-3)
oMemo_01.Class = "MEMO"
oMemo_01.Name = "Memo_01"
oMemo_01.Id = Const.Memo_01
oMemo_01.Text = "Multi Line Memo Control"+$CRLF+ "with enough text to activate the scroll bar"
oMemo_01.Left = 590
oMemo_01.Top = 90
oMemo_01.Height = 110
oMemo_01.Width = 110
oMemo_01.Parent = oTabPage(1).Handle
oMemo_01.Font = hFont
oMemo_01.CreateControl
'Tab Control
'Here I use containment in the library where I First Create a generic iControl Object
'and then create a specific oTabCtl.oTab Object
oTabCtl = NewControl
IF ISNOTHING(oTabCtl) THEN
?"No oTabCtl
RET_M(-4)
END IF
oTabCtl.Class = "TAB"
oTabCtl.Name = "oTab"
oTabCtl.Id = Const.Tab_Id
oTabCtl.Parent = hWin
oTabCtl.Style = %WS_CHILD OR %WS_VISIBLE OR %WS_GROUP OR %WS_TABSTOP OR _
%TCS_TABS OR %TCS_SINGLELINE OR %TCS_RAGGEDRIGHT
oTabCtl.Top = 50
oTabCtl.Height = 320
oTabCtl.Width = 740
oTabCtl.Font = hFont
oTabCtl.ForeColor = &H8E6B23
oTabCtl.CreateControl
'Get the Tab Control Object
oTab = oTabCtl.oTab
IF ISNOTHING(oTab) THEN
?"No oTab"
RET_M(-4)
END IF
oTab.AddTab("Page One")
oTab.AddTabPage(oTabPage(0).Handle)
oTab.AddTab("Page Two")
oTab.AddTabPage(oTabPage(1).Handle)
'Status Bar
oStatus = NewControl
IF ISNOTHING(oStatus) THEN RET_M(-3)
oStatus.Id = Const.Status_Id
oStatus.StatusParts = "50;30;10;10" 'in %; should total 100%
oStatus.Class = "STATUSBAR"
oStatus.Style = &H50000003
oStatus.Parent = hWin
oStatus.Text = "Status Bar"
oStatus.CreateControl
ShowWindow hWin,%SW_SHOW
RET_M(MYBASE.MsgLoop)
IF hFont THEN
DeleteObject hFont
END IF
END METHOD
PROPERTY GET TabPage(BYVAL Index AS LONG) AS iWindow
PROPERTY = oTabPage(Index)
END PROPERTY
PROPERTY GET oPanel(BYVAL Index AS LONG) AS iControl
PROPERTY = oPanel(Index)
END PROPERTY
PropGet(oRAGrid,iRAGrid)
END INTERFACE
END CLASS
'------------------------------------------------------------------------------
CALLBACK FUNCTION MainWinCallBack() AS LONG
LOCAL lpCtlInfo AS CtlInfoType PTR
LOCAL oCtl AS iControl
local oTab AS iTabControl
LOCAL oDop AS iDisplayOpenFile
LOCAL lpNmHdr AS NMHDR PTR
local PageNum AS LONG
LOCAL sFile,sCellData AS STRING
SELECT CASE CB.MSG
CASE %WM_CLOSE
DestroyWindow CB.HNDL
CASE %WM_DESTROY
EnumChildWindows CB.HNDL,CODEPTR(EnumChildProc),%RemoveProps
RemoveProp CB.HNDL,$ObjInfo
PostQuitMessage 0
CASE %WM_CTLCOLORSTATIC,%WM_CTLCOLORBTN,%WM_CTLCOLOREDIT,%WM_CTLCOLORLISTBOX
lpCtlInfo = GetProp(CB.LPARAM,$ObjInfo)
IF lpCtlInfo THEN
POKE DWORD,VARPTR(oCtl),@lpCtlInfo.ObjPtr
IF ISNOTHING(oCtl) THEN RET_F(0)
oCtl.AddRef
IF oCtl.hBkBrush THEN
SetBkMode CB.WPARAM,%OPAQUE
SetBkColor CB.WPARAM,oCtl.BackColor
SetTextColor CB.WPARAM,oCtl.ForeColor
RET_F(oCtl.hBkBrush)
END IF
END IF
CASE %WM_COMMAND
IF CB.CTLMSG = %BN_CLICKED THEN
SELECT CASE CB.CTL
CASE Const.CancelBut,Const.Menu_Exit
SendMessage CB.HNDL,%WM_CLOSE,0,0
CASE Const.OkBut
?"Ok Button Pressed"
CASE Const.GetFileButton
oDop = NewOpenFile
IF ISNOTHING(oDop) THEN EXIT SELECT
sFile = oDop.GetName
IF LEN(sFile) THEN
SetWindowText goApp.oPanel(1).Handle,""
SetWindowText goApp.oPanel(1).Handle,BYVAL STRPTR(sFile)
END IF
CASE Const.GridDataBut
sCellData = goApp.oRAGrid.GetCurrentCellStringData()
?sCellData
END SELECT
END IF
CASE %WM_NOTIFY
lpNmHdr = CB.LPARAM
SELECT CASE @lpNmHdr.code
CASE %TCN_LAST TO %TCN_FIRST
lpCtlInfo = GetProp(@lpNmHdr.hWndFrom,$ObjInfo)
IF lpCtlInfo THEN
POKE DWORD,VARPTR(oCtl),@lpCtlInfo.ObjPtr
IF ISNOTHING(oCtl) THEN RET_F(0)
oCtl.AddRef
oTab = oCtl.oTab
IF ISNOTHING(oTab) THEN RET_F(0)
SELECT CASE @lpNmHdr.code
CASE %TCN_SELCHANGING
PageNum =oTab.GetCurSel
oTab.HidePage(PageNum)
CASE %TCN_SELCHANGE
PageNum =oTab.GetCurSel
oTab.ShowPage(PageNum)
END SELECT
END IF
END SELECT
END SELECT
FUNCTION = DefWindowProc(CB.HNDL, CB.MSG, CB.WPARAM, CB.LPARAM)
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION EnumChildProc(BYVAL hChild AS DWORD,BYVAL lParam AS LONG)AS LONG
'Remove Props
IF lParam = %RemoveProps THEN
RemoveProp hChild,$ObjInfo
END IF
END FUNCTION
'------------------------------------------------------------------------------
'==============================================================================
FUNCTION WINMAIN (BYVAL hInstance AS LONG, _
BYVAL hPrevInstance AS LONG, _
BYVAL lpCmdLine AS ASCIIZ PTR, _
BYVAL iCmdShow AS LONG) AS LONG
TRACE NEW "SDK05_TRACE.TXT"
LOCAL iccx AS INIT_COMMON_CONTROLSEX
LOCAL hRaGrid AS DWORD
iccx.dwsize = SIZEOF(iccx)
iccx.dwicc = %ICC_BAR_CLASSES OR %ICC_TAB_CLASSES
InitCommonControlsEx iccx
Const = CLASS "cConst"
'InitCommonControls
'Load RAGrid
hRaGrid = LoadLibrary("RAGrid.dll")
IF hRAGrid = 0 THEN RET_F(0)
'On No a GLOBAL
goApp = CLASS "cSdkWinApp"
goApp.hInst = hInstance
goApp.Run
FreeLibrary hRaGrid
TRACE CLOSE
END FUNCTION