The code is posted as public domain. Use as you see fit.
Code:
#COMPILE EXE
DEFLNG A - Z
#INCLUDE "WIN32API.INC"
#INCLUDE "COMMCTRL.INC"
TYPE TreeViewItem
ItemHndl AS DWORD
Selected AS BYTE
EXPANDED AS BYTE
TEXT AS ASCIIZ * 32
END TYPE
%TV_AI = 1001
%TV_PL = 1002
%BT_EXIT = 1003
%LBOX_AI = 1004
%LBOX_PL = 1005
$NULSPC = CHR$(0) + CHR$(32)
DECLARE SUB Diplomacy_DLG()
DECLARE SUB Tv_Data(AiData$(), PlData$(), Ubnd)
DECLARE SUB Fill_TvItem_Struct(tTv_Item AS TV_ITEM, BYVAL Tree_Item AS DWORD, _
BYVAL zStrSize AS LONG, BYVAL zStr_Ptr AS ASCIIZ POINTER)
DECLARE SUB Pop_Treview(TvData$(), BYVAL hdlg AS DWORD, BYVAL Cnt AS LONG, _
tView() AS TreeViewItem, BYVAL Tv_Id AS LONG, RetVal)
DECLARE FUNCTION TV_InsertItem(BYVAL hTree AS DWORD, BYVAL hParent AS _
DWORD, sItem AS STRING) AS LONG
DECLARE FUNCTION Tv_Root_Item(tAi() AS TreeViewItem, tPl() AS TreeViewItem, BYVAL vItem AS LONG, _
BYVAL Ubnd AS LONG) AS LONG
DECLARE FUNCTION Expand_Root(BYVAL AHndl AS DWORD, PHndl AS DWORD, tAView() AS TreeViewItem, _
tPView() AS TreeViewItem, BYVAL HitItem AS DWORD, _
BYVAL RetVal AS LONG) AS LONG
DECLARE FUNCTION Get_Match(BYVAL Tree_ItemHndl AS DWORD, BYVAL TreeHndl AS DWORD, _
sA AS STRING) AS DWORD
DECLARE CALLBACK FUNCTION Diplomacy_CB()
FUNCTION PBMAIN () AS LONG
CALL Diplomacy_DLG
END FUNCTION
'-----------------------------------------------------------------
'-----------------------------------------------------------------
SUB Diplomacy_DLG
LOCAL lRslt AS LONG
LOCAL hDlg AS DWORD
DIALOG NEW hParent, "Dialog1", 103, 48, 357, 270, %WS_POPUP OR _
%WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _
%DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
%WS_EX_RIGHTSCROLLBAR, TO hDlg
CONTROL ADD "SysTreeView32", hDlg, %TV_AI, "SysTreeView32_1", 10, 15, 100, _
190, %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %TVS_SHOWSELALWAYS OR _
%TVS_FULLROWSELECT, %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
%WS_EX_RIGHTSCROLLBAR
CONTROL ADD "SysTreeView32", hDlg, %TV_PL, "SysTreeView32_1", 245, 15, 100, _
190, %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %TVS_SHOWSELALWAYS OR _
%TVS_FULLROWSELECT, %WS_EX_LEFT OR %WS_EX_LTRREADING OR _
%WS_EX_RIGHTSCROLLBAR
CONTROL ADD LISTBOX, hDlg, %LBOX_AI, , 10, 210, 100, 30, %WS_CHILD OR _
%WS_VISIBLE OR %WS_TABSTOP OR %WS_VSCROLL OR %LBS_NOTIFY, %WS_EX_LEFT OR _
%WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
CONTROL ADD LISTBOX, hDlg, %LBOX_PL, , 245, 215, 100, 30, %WS_CHILD OR _
%WS_VISIBLE OR %WS_TABSTOP OR %WS_VSCROLL OR %LBS_NOTIFY, %WS_EX_LEFT OR _
%WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR
CONTROL ADD BUTTON, hDlg, %BT_EXIT, "Exit", 140, 245, 75, 15
DIALOG SHOW MODAL hDlg, CALL Diplomacy_CB TO lRslt
END SUB
'--------------------------------------------------------------------------------
'--------------------------------------------------------------------------------
CALLBACK FUNCTION Diplomacy_CB()
LOCAL NmHdr_Ptr AS NMHDR POINTER
LOCAL NmTreeView_Ptr AS NM_TREEVIEW POINTER
LOCAL tTv_Item AS TV_ITEM
LOCAL tTv_HitTest AS TV_HITTESTINFO
LOCAL Tv_Hndl AS DWORD
LOCAL CurPos AS DWORD
LOCAL ItemHndl AS DWORD
LOCAL DlgHndl AS DWORD
LOCAL Temp AS INTEGER
LOCAL TempStr AS ASCIIZ * 256
LOCAL A AS STRING
LOCAL TempStrPtr AS ASCIIZ POINTER
STATIC AiData() AS STRING
STATIC PlData() AS STRING
STATIC tView AS NM_TREEVIEW
STATIC tAiView() AS TreeViewItem
STATIC tPlView() AS TreeViewItem
STATIC RetVal AS LONG
STATIC Flag AS LONG
STATIC datav AS LONG
STATIC AivHndl AS DWORD
STATIC PlvHndl AS DWORD
STATIC AiLbHndl AS DWORD
STATIC PlLbHndl AS DWORD
DlgHndl = CBHNDL
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG ' Initialization handler
CONTROL HANDLE DlgHndl, %TV_AI TO AivHndl
CONTROL HANDLE DlgHndl, %TV_PL TO PlvHndl
CONTROL HANDLE DlgHndl, %LBOX_PL TO PlLbHndl
CONTROL HANDLE DlgHndl, %LBOX_AI TO AiLbHndl
DIM tAiView(1 TO 1)
DIM tPlView(1 TO 1)
DIM AiData$(1 TO 1)
DIM PlData$(1 TO 1)
CALL Tv_Data(AiData$(), PlData$(), Ubnd)
CALL Pop_Treview(AIData$(), DlgHndl, Ubnd, tAiView(), %TV_AI, RetVal)
CALL Pop_Treview(PlData$(), DlgHndl, Ubnd, tPlView(), %TV_PL, RetVal)
CASE %WM_NCACTIVATE
STATIC hWndSaveFocus AS DWORD
IF ISFALSE CBWPARAM THEN ' Save control focus
hWndSaveFocus = GetFocus()
ELSEIF hWndSaveFocus THEN ' Restore control focus
SetFocus(hWndSaveFocus)
hWndSaveFocus = 0
END IF
CASE %WM_COMMAND ' Process control notifications
SELECT CASE AS LONG CBCTL
CASE %BT_EXIT
DIALOG END CBHNDL
END SELECT
CASE %WM_NOTIFY
Nmhdr_Ptr = CBLPARAM
SELECT CASE @NmHdr_Ptr.Code
CASE %NM_CLICK
CurPos = GetMessagePos
tTv_Hittest.Pt.X = LO(WORD, CurPos)
tTv_Hittest.Pt.Y = HI(WORD, CurPos)
Tv_Hndl = @NmHdr_Ptr.HwndFrom
MapWindowPoints(%HWND_DESKTOP, Tv_Hndl, tTv_HitTest.Pt, 1)
CALL TreeView_HitTest(Tv_Hndl, BYVAL VARPTR(tTv_HitTest))
IF (tTv_HitTest.Flags = %TVHT_ONITEMLABEL) OR _ 'allow selection to be close
(tTv_HitTest.Flags = %TVHT_ONITEMRIGHT) OR _
(tTv_HitTest.Flags = %TVHT_ONITEM) THEN
I = Expand_Root(AivHndl, PlvHndl, tAiView(), tPlView(), tTv_HitTest.Hitem, RetVal)
IF I THEN
FUNCTION = 1
EXIT FUNCTION
END IF
ParentHndl = SendMessage(Tv_Hndl, %TVM_GETNEXTITEM, %TVGN_PARENT, tTv_HitTest.Hitem)
I = Tv_Root_Item(tAiView(), tPlView(), ParentHndl, RetVal)
IF I THEN
A$ = TRIM$(tPlView(I).TEXT, ANY $NULSPC)
IF A$ = "DIPLOMATIC AGGREMENTS" THEN
CALL Fill_TvItem_Struct(tTv_Item, tTv_HitTest.Hitem, SIZEOF(TempStr$), _
VARPTR(TempStr$))
CALL Treeview_GetItem(Tv_Hndl, BYVAL VARPTR(tTv_Item))
A$ = TRIM$(TempStr$, ANY $NULSPC)
SELECT CASE Tv_Hndl
CASE PlvHndl
ItemHndl = Get_Match(tAiView(I).ItemHndl, AivHndl, A$)
IF ItemHndl THEN
SendMessage(PlvHndl, %TVM_DELETEITEM, 0, tTv_HitTest.Hitem)
SendMessage(AivHndl, %TVM_DELETEITEM, 0, ItemHndl)
PostMessage(AivHndl, %TVM_SELECTITEM, %TVGN_CARET, 0)
PostMessage(PlvHndl, %TVM_SELECTITEM, %TVGN_CARET, 0)
SendMessage(PlLbHndl, %LB_ADDSTRING, 0, STRPTR(A$))
SendMessage(AiLbHndl, %LB_ADDSTRING, 0, STRPTR(A$))
END IF
FUNCTION = 1
EXIT FUNCTION
CASE AivHndl
ItemHndl = Get_Match(tPlView(I).ItemHndl, PlvHndl, A$)
IF ItemHndl THEN
SendMessage(AivHndl, %TVM_DELETEITEM, 0, tTv_HitTest.Hitem)
SendMessage(PlvHndl, %TVM_DELETEITEM, 0, ItemHndl)
PostMessage(AivHndl, %TVM_SELECTITEM, %TVGN_CARET, 0)
PostMessage(PlvHndl, %TVM_SELECTITEM, %TVGN_CARET, 0)
SendMessage(PlLbHndl, %LB_ADDSTRING, 0, STRPTR(A$))
SendMessage(AiLbHndl, %LB_ADDSTRING, 0, STRPTR(A$))
END IF
FUNCTION = 1
EXIT FUNCTION
END SELECT
END IF
END IF
END IF
CALL Fill_TvItem_Struct(tTv_Item, tTv_HitTest.Hitem, SIZEOF(TempStr$), _
VARPTR(TempStr$))
CALL Treeview_GetItem(Tv_Hndl, BYVAL VARPTR(tTv_Item))
A$ = TRIM$(TempStr$, ANY $NULSPC)
SendMessage(Tv_Hndl, %TVM_DELETEITEM, 0, tTv_HitTest.Hitem)
PostMessage(Tv_Hndl, %TVM_SELECTITEM, %TVGN_CARET, 0)
SELECT CASE Tv_Hndl
CASE AivHndl
SendMessage(AiLbHndl, %LB_ADDSTRING, 0, STRPTR(A$))
CASE PlvHndl
SendMessage(PlLbHndl, %LB_ADDSTRING, 0, STRPTR(A$))
END SELECT
FUNCTION = 1
EXIT FUNCTION
SELECT CASE @NmHdr_Ptr.IdFrom
CASE %TV_AI
' MSGBOX "clicked on left"
CASE %TV_PL
' MSGBOX "clicked on right"
END SELECT
END SELECT
END SELECT
END FUNCTION
'----------------------------------------------------------------
'----------------------------------------------------------------
SUB Tv_Data(AiData$(), PlData$(), Ubnd)
DATA "|ROOT| DIPLOMATIC AGGREMENTS"
DATA "Non-aggression Pact"
DATA "Mutual Protection Pact"
DATA "Safe Passage Pact"
DATA "Trade-Worker Passage Pact"
DATA "Preferred Trader Pact"
DATA "|EROOT|"
DATA "|ROOT| MILITARY AGGREMENTS"
DATA "|EROOT|
DATA "|ROOT| MONEY
DATA "Per Turn"
DATA "Lump Sum"
DATA "|EROOT|"
DATA "|ROOT| TRADE"
DATA "|EROOT|"
DATA "|ROOT| STRATIGIC RESOURCES"
DATA "Coal"
DATA "Iron"
DATA "Copper"
DATA "Lead"
DATA "Tin"
DATA "Zinc"
DATA "Petroleum"
DATA "Aluminum"
DATA "Titanium"
DATA "Uranium"
DATA "Horses"
DATA "|EROOT|"
DATA "|ROOT| FOOD RESOURCES"
DATA "Sheep"
DATA "Pigs"
DATA "Beef"
DATA "Chickens"
DATA "Clams"
DATA "Oysters"
DATA "Shrimp"
DATA "Lobsters"
DATA "Crabs"
DATA "Fish"
DATA "Whale"
DATA "Wheat"
DATA "Corn"
DATA "Oats"
DATA "Barley"
DATA "Hops"
DATA "Grapes"
DATA "Bannanas"
DATA "Pinapple"
DATA "Sugar"
DATA "Salt"
DATA "Spices"
DATA "|EROOT|"
DATA "|ROOT| LUXURIES"
DATA "Beaver Fur"
DATA "Mink Fur"
DATA "Linx Fur"
DATA "Crocodile Skin"
DATA "Eel Skin"
DATA "Shark Skin"
DATA "Wine"
DATA "Beer"
DATA "Gold"
DATA "Platinium"
DATA "Diamonds"
DATA "Rubies"
DATA "Pearls"
DATA "Incense"
DATA "|EROOT|"
FOR I = 1 TO DATACOUNT
REDIM PRESERVE AiData$(1 TO I)
REDIM PRESERVE PlData$(1 TO I)
AiData$(I) = READ$(I)
PlData$(I) = AiData$(I)
NEXT I
Ubnd = DATACOUNT
END SUB
'--------------------------------------------------------------------
'--------------------------------------------------------------------
SUB Pop_Treview(TvData$(), BYVAL hdlg AS DWORD, BYVAL Cnt AS LONG, _
tView() AS TreeViewItem, BYVAL Tv_Id AS LONG, RetVal)
LOCAL i AS LONG
LOCAL j AS LONG
LOCAL k AS LONG
LOCAL hCtl AS DWORD
LOCAL hRoot AS DWORD
LOCAL hParent AS DWORD
LOCAL BRoot AS STRING
LOCAL ERoot AS STRING
LOCAL A AS STRING
BRoot$ = "|ROOT|"
ERoot$ = "|EROOT|"
CONTROL HANDLE hDlg, TV_Id TO hCtl
I = 1
J = 0
DO
A$ = TvData$(I)
IF INSTR(TvData$(I), BRoot$) THEN
A$ = REMOVE$(A$, BRoot$)
hRoot = TV_InsertItem(hCtl, %TVI_ROOT, A$)
TvData$(I) = TvData$(I) + USING$(" = #", hRoot)
INCR J
REDIM PRESERVE tView(1 TO J)
tView(J).ItemHndl = hRoot
tView(J).TEXT = A$
DO
INCR I
IF I >= Cnt THEN EXIT DO
IF INSTR(TvData$(I), ERoot$) THEN
INCR I
EXIT DO
END IF
A$ = TvData$(I)
hParent = TV_InsertItem(hCtl, hRoot, A$)
TvData$(I) = TvData$(I) + USING$(" = #", hParent)
LOOP
END IF
LOOP UNTIL I >= Cnt
RetVal = J
END SUB
'--------------------------------------------------------------------
'--------------------------------------------------------------------
FUNCTION TV_InsertItem(BYVAL hTree AS DWORD, BYVAL hParent AS _
DWORD, sItem AS STRING) AS LONG
LOCAL tTVItem AS TV_ITEM
LOCAL tTVInsert AS TV_INSERTSTRUCT
IF hParent THEN
tTVItem.mask = %TVIF_CHILDREN OR %TVIF_HANDLE
tTVItem.hItem = hParent
tTVItem.cchildren = 1
TreeView_SetItem hTree, tTVItem
END IF
tTVInsert.hParent = hParent
tTVInsert.Item.Item.mask = %TVIF_TEXT
tTVInsert.Item.Item.pszText = STRPTR(sItem)
tTVInsert.Item.Item.cchTextMax = LEN(sItem)
TV_InsertItem = TreeView_InsertItem(hTree, tTVInsert)
END FUNCTION
'--------------------------------------------------------------
'--------------------------------------------------------------
FUNCTION Tv_Root_Item(tAi() AS TreeViewItem, tPl() AS TreeViewItem, BYVAL vItem AS LONG, _
BYVAL Ubnd AS LONG) AS LONG
'==================================================================
' determines if the item selected is a root root item
' probably could have used sendmessage with TVGN_PARENT
' paramenter to shorten the code
'==================================================================
FOR I = 1 TO Ubnd
IF ((tAi(I).ItemHndl = vItem) + (tPl(I).ItemHndl = vItem)) THEN
Tv_Root_Item = I
EXIT FUNCTION
END IF
NEXT I
Tv_Root_Item = 0
END FUNCTION
'---------------------------------------------------------------
'---------------------------------------------------------------
SUB Fill_TvItem_Struct(tTv_Item AS TV_ITEM, BYVAL Tree_Item AS DWORD, _
BYVAL zStrSize AS LONG, BYVAL zStr_Ptr AS ASCIIZ POINTER)
tTv_Item.Mask = %TVIF_STATE OR %TVIF_HANDLE OR %TVIF_TEXT
tTv_Item.StateMask = %TVIS_STATEIMAGEMASK
tTv_Item.CchTextMax = zStrSize
tTv_Item.PszText = zStr_Ptr
tTv_Item.Hitem = Tree_Item
END SUB
'----------------------------------------------------------------
'----------------------------------------------------------------
FUNCTION Get_Match(BYVAL Tree_ItemHndl AS DWORD, BYVAL TreeHndl AS DWORD, sA AS STRING) AS DWORD
'================================================================
' finds a matching item in the other treeview control
'
' Tree_ItemHndl = item's parent
' Tree_Hndl = handle of control
'================================================================
LOCAL tTview_Item AS TV_ITEM
LOCAL zStr AS ASCIIZ * 32
LOCAL zStrPtr AS ASCIIZ POINTER
LOCAL zSize AS LONG
LOCAL ItemHndl AS DWORD
zSize = SIZEOF(zStr$)
zStrPtr = VARPTR(zStr)
CALL Fill_TvItem_Struct(tTview_Item, Tree_ItemHndl, zSize, zStrPtr)
'============================================================================
' set treeview selection to parent of selected item in other treeview control
' and get the first child of the parent
'============================================================================
CALL Treeview_GetItem(TreeHndl, BYVAL VARPTR(tTview_Item))
ItemHndl = SendMessage(TreeHndl, %TVM_GETNEXTITEM, %TVGN_CHILD, Tree_ItemHndl)
N_Item: '
CALL Fill_TvItem_Struct(tTview_Item, ItemHndl, zSize, zStrPtr)
I = Treeview_GetItem(TreeHndl, BYVAL VARPTR(tTview_Item))
IF I THEN
IF TRIM$(zStr$, ANY $NULSPC) <> sA$ THEN
ItemHndl = SendMessage(TreeHndl, %TVM_GETNEXTITEM, %TVGN_NEXT, ItemHndl)
GOTO N_Item
END IF
END IF
Get_Match = ItemHndl
END FUNCTION
'-------------------------------------------------------------------------
'-------------------------------------------------------------------------
FUNCTION Expand_Root(BYVAL AHndl AS DWORD, PHndl AS DWORD, tAView() AS TreeViewItem, _
tPView() AS TreeViewItem, BYVAL HitItem AS DWORD, _
BYVAL RetVal AS LONG) AS LONG
'=========================================================================
' expands or collapes the root item based on results of tv_root_Item
' and makes it visible
'=========================================================================
I = Tv_Root_Item(tAView(), tPView(), HitItem, RetVal)
IF I THEN
IF tAView(I).Expanded THEN
PostMessage(AHndl, %TVM_EXPAND, %TVE_COLLAPSE, tAView(I).ItemHndl)
PostMessage(PHndl, %TVM_EXPAND, %TVE_COLLAPSE, tPView(I).ItemHndl)
tAView(I).Expanded = 0
tPView(I).Expanded = 0
ELSE
PostMessage(AHndl, %TVM_EXPAND, %TVE_EXPAND, tAView(I).ItemHndl)
PostMessage(PHndl, %TVM_EXPAND, %TVE_EXPAND, tPView(I).ItemHndl)
tAView(I).Expanded = 1
tPView(I).Expanded = 1
END IF
PostMessage(Ahndl, %TVM_SELECTITEM, %TVGN_FIRSTVISIBLE, tAview(I).ItemHndl)
PostMessage(PHndl, %TVM_SELECTITEM, %TVGN_FIRSTVISIBLE, tPview(I).ItemHndl)
PostMessage(AHndl, %TVM_SELECTITEM, %TVGN_CARET, 0)
PostMessage(PHndl, %TVM_SELECTITEM, %TVGN_CARET, 0)
Expand_Root = 1
EXIT FUNCTION
END IF
Expand_Root = 0
END FUNCTION