[dimian80]

Не могу разобраться с программой, которая должна обновлять ряд колонок в пустой таблице из заполненой, может кто поможет:

Include "MapBasic.Def"
Include "Menu.Def"
Include "Icons.Def"
Include "..\Inc\Auto_Lib.Def"

Declare Sub Main
Declare Sub InfoEntryDlg
Declare Sub SetColumnList
Declare Sub SetColumnList1
Declare Sub SearchAndReplace
Declare Sub SRC
Declare Sub Update
Declare Sub Finish
Declare Sub AboutSearchAndReplace
Declare Function GetColList(List() As String, ByVal TabName As String) As Integer
Declare Function GetTableList(List() As String) As Integer

Global TabArray() As String
Global ColArray() As String

Global SearchColumnF As String
Global SearchColumnS As String
Global SearchColumnF1 As String
Global SearchColumnS1 As String

Global SearchTableF,SearchTableS,SearchString,ReplacementString As String
Global CaseSense As Logical
Global LCV As Integer
Global LCV1 As Integer
Sub Main

Create Menu "Автоматическое обновление" As
"Обновить как есть" Calling Update,
"(-",
"Выбрать колонки" Calling InfoEntryDlg,
"(-",
"&О программе..." Calling AboutSearchAndReplace,
"&Выход" Calling Finish

Call set_tools_menu("Автоматическое обновление")

End Sub


Sub Update

Dim FTab As String
Dim STab As String
Dim nameFTab As String
Dim nameSTab As String
FTab=FileOpenDlg ("","","TAB","Открыть таблицу с данными")
STab=FileOpenDlg("","","TAB","Открыть пустую таблицу")
Open Table FTab
nameFTab=TableInfo(0,TAB_INFO_NAME)
Browse * From nameFTab
Open Table STab
nameSTab=TableInfo(0,TAB_INFO_NAME)
Browse * From nameSTab
Update nameSTab Set тип_населенного_пункта = "город"
Update nameSTab Set населенный_пункт = "Новороссийск"
Add Column nameFTab (адрес )From nameSTab Set To Местоположение_участка Where COL9 = COL2
Add Column nameFTab (категория_земель )From nameSTab Set To Категория_земель Where COL9 = COL2
Add Column nameFTab (разрешенное_использование )From nameSTab Set To Разрешенное_использование Where COL9 = COL2
Add Column nameFTab (фактическое_использование )From nameSTab Set To Фактическое_использование Where COL9 = COL2
Add Column nameFTab (площадь )From nameSTab Set To Площадь Where COL9 = COL2
Add Column nameFTab (сведения_о_правах )From nameSTab Set To Сведения_о_правах Where COL9 = COL2
Add Column nameFTab (тип_субъекта_права )From nameSTab Set To Тип_субъекта_права Where COL9 = COL2


End Sub



Sub InfoEntryDlg
Dim TabCount,ColCountLocal As Integer
Dim FTab As String
Dim STab As String
Dim nameFTab As String
Dim nameSTab As String
FTab=FileOpenDlg ("","","TAB","Открыть таблицу с данными")
STab=FileOpenDlg("","","TAB","Открыть пустую таблицу")
Open Table FTab
nameFTab=TableInfo(0,TAB_INFO_NAME)
Browse * From nameFTab
Open Table STab
nameSTab=TableInfo(0,TAB_INFO_NAME)
Browse * From nameSTab

LCV=0
LCV1=0
ReDim ColArray(0)
TabCount=GetTableList(TabArray)
While UBound(ColArray)<1
LCV=LCV+1
ColCountLocal=GetColList(ColArray,TabArray(LCV))
Wend
Do Case LCV
Case 0
LCV1=1
Case 1
LCV1=0
End Case

Dialog
Title "Выбор таблиц "
Width 365
Height 175
Control StaticText
Title "Таблица с данными "
Position 4,4

Control StaticText
Title "Пустая таблица "
Position 180,4

Control PopUpMenu
Title From Variable TabArray
Position 80,3
Width 88
Value LCV
ID 1
Calling SetColumnList
Into SearchTableF

Control PopUpMenu
Title From Variable TabArray
Position 260,3
Width 88
Value LCV1
ID 2
Calling SetColumnList1
Into SearchTableS
Control StaticText
Title "Исходные колонки "
Position 4,20
Control StaticText
Title "Совпадающие колонки "
Position 180,20
Control MultiListBox
Title From Variable ColArray
Position 80,19
Width 88
ID 3
Into SearchColumnF
Control MultiListBox
Title From Variable ColArray
Position 260,19
Width 88
ID 4
Into SearchColumnS
Control GroupBox
Title "Колонки для объединения "
Position 4,95
Height 55 Width 180
Control PopupMenu
Title From Variable ColArray
Position 15,125
Width 75
ID 5
Into SearchColumnF1
Control PopupMenu
Title From Variable ColArray
Position 90,125
Width 75
ID 6
Into SearchColumnS1

Control CancelButton
Control OKButton

If CommandInfo(CMD_INFO_DLG_OK) Then
Call SearchAndReplace 'SRC
End If
End Sub

Sub SearchAndReplace
Dim ColReference As Alias


Set Event Processing Off
If CaseSense Then
ColReference=ColArray(SearchColumn)
Select * from TabArray(SearchTable)
Where Instr(1,ColReference,SearchString)>0
If SelectionInfo(SEL_INFO_NROWS)>0 Then
Update Selection Set ColArray(SearchColumn)=
Left$(ColReference,(Instr(1,ColReference,SearchString)-1))
+ReplacementString
+Mid$(ColReference,(Instr(1,ColReference,SearchString)+Len(SearchString)),Len(ColReference))
Close Table TableInfo(0,TAB_INFO_NAME)
Close Table Selection
Else
Note "No matching strings were found"
End If
Else
SearchString=UCase$(SearchString)
ColReference=ColArray(SearchColumn)
Select * from TabArray(SearchTable)
Where Instr(1,UCase$(ColReference),UCase$(SearchString))>0
If SelectionInfo(SEL_INFO_NROWS)>0 Then
Update Selection Set ColArray(SearchColumn)=
Left$(ColReference,(Instr(1,UCase$(ColReference),UCase$(SearchString))-1))
+ReplacementString
+Mid$(ColReference,(Instr(1,UCase$(ColReference),UCase$(SearchString))+Len(SearchString)),Len(ColReference))
Close Table TableInfo(0,TAB_INFO_NAME)
Close Table Selection
Else
Note "No matching strings were found"
End If
End If
ReDim ColArray(0)
Set Event Processing On
End Sub

Sub SRC
Dim ColReferenceF As Alias
Dim ColReferenceS As Alias
Dim Col_numberF As Integer
Dim Col_numberS As Integer
Dim Col_numberF1 As Integer
Dim Col_numberS1 As Integer
Dim ColRef1() As String
Dim ColRef2() As String
Dim NF,NS,i1 As Integer
Dim CRef1 As Alias
Dim CRef2 As Alias


Col_numberF1 = Readcontrolvalue(3)
NF=0
While Col_numberF1 <> 0
NF=NF+1
SearchColumnF=ColArray(Col_numberF1)
ReDim ColRef1(NF)
ColRef1(NF)=SearchColumnF
Col_numberF1 = Readcontrolvalue(3)
Wend
Col_numberS1 = Readcontrolvalue(4)
NS=0
While Col_numberS1 <> 0
NS=NS+1
SearchColumnS=ColArray(Col_numberS1)
ReDim ColRef2(NS)
ColRef2(NS)=SearchColumnS
Col_numberS1 = Readcontrolvalue(4)
Wend
Col_numberF = Readcontrolvalue(5)
SearchColumnF1=ColArray(Col_numberF)
ColReferenceF=SearchColumnF1
Col_numberS = Readcontrolvalue(6)
SearchColumnS1=ColArray(Col_numberS)
ColReferenceS=SearchColumnS1
For i1=1 to NF
CRef1=ColRef1(NF)
CRef2=ColRef2(NF)
Add Column nameSTab (CRef1) From nameFTab Set To CRef2 Where ColReferenceS=ColReferenceF
Next

End Sub

Sub SetColumnList
Dim ColCount As Integer

ColCount=GetColList(ColArray,TabArray(ReadControlValue(1)))
Alter Control 3 Title From Variable ColArray
Alter Control 5 Title From Variable ColArray

End Sub

Sub SetColumnList1
Dim ColCount1 As Integer

ColCount1=GetColList(ColArray,TabArray(ReadControlValue(2)))
Alter Control 4 Title From Variable ColArray
Alter Control 6 Title From Variable ColArray

End Sub



Sub Finish
End Program
End Sub


Sub AboutSearchAndReplace
Dialog Title "About SearchAndReplace"
Control statictext Title "Search And Replace will search a" position 10,10
Control statictext Title "character column for a specified string" position 10,20
Control statictext Title "and replace it with another string." position 10,30
Control statictext Title "The user may specify the search" position 10,40
Control statictext Title "string to be case sensitive." position 10,50
Control OKButton position 49,92
End Sub

Function GetColList(List() As String, ByVal TabName As String) As Integer
Dim test_condition As SmallInt
Dim Column_count,I,J As Integer
Dim col_name As String
Column_count = 0 'Originate the table count
ReDim list(0) 'Clear out array
ReDim list(NumCols(TabName)) 'Dimension work array to max number
For I = 1 to NumCols(TabName)
col_name = ColumnInfo(TabName,"col" + I, COL_INFO_NAME)

Column_count = Column_count + 1
list(Column_count) = col_name 'case all
Next
GetColList = Column_count 'Assign return value
ReDim list(Column_count) 'Re Dimension array to number of tables added
End Function

Function GetTableList(List() As String) As Integer

Dim table_count,I,J As Integer
Dim table_name,table_path_name As String
table_count = 0 'Originate the table count
ReDim list(0) 'Clear out array
ReDim list(NumTables()) 'Dimension work array to max number
For I = 1 to NumTables()

table_name = TableInfo(I,TAB_INFO_NAME) 'assign table name
'table_path_name = TrueFileName$(table_name)+ ".ind" 'determine path

table_count = table_count + 1
list(table_count) = table_name 'case all
Next
GetTableList = table_count 'Assign return value
ReDim list(table_count) 'Re Dimension array to number of tables added
End Function

[Shadow_Fighter]

что ты понимаешь под "разобраться"? Что именно непонятно? РТФМ

[dimian80]

В первой части все работает как надо, не могу разобраться в процедуре предусматривающей выбор ячеек,

Sub SRC
Dim ColReferenceF As Alias
Dim ColReferenceS As Alias
Dim Col_numberF As Integer
Dim Col_numberS As Integer
Dim Col_numberF1 As Integer
Dim Col_numberS1 As Integer
Dim ColRef1() As String
Dim ColRef2() As String
Dim NF,NS,i1 As Integer
Dim CRef1 As Alias
Dim CRef2 As Alias
Col_numberF1 = Readcontrolvalue(3)
NF=0
While Col_numberF1 <> 0
NF=NF+1
SearchColumnF=ColArray(Col_numberF1)
ReDim ColRef1(NF)
ColRef1(NF)=SearchColumnF
Col_numberF1 = Readcontrolvalue(3)
Wend
Col_numberS1 = Readcontrolvalue(4)
NS=0
While Col_numberS1 <> 0
NS=NS+1
SearchColumnS=ColArray(Col_numberS1)
ReDim ColRef2(NS)
ColRef2(NS)=SearchColumnS
Col_numberS1 = Readcontrolvalue(4)
Wend
Col_numberF = Readcontrolvalue(5)
SearchColumnF1=ColArray(Col_numberF)
ColReferenceF=SearchColumnF1
Col_numberS = Readcontrolvalue(6)
SearchColumnS1=ColArray(Col_numberS)
ColReferenceS=SearchColumnS1
For i1=1 to NF
CRef1=ColRef1(NF)
CRef2=ColRef2(NF)
Add Column nameSTab (CRef1) From nameFTab Set To CRef2 Where ColReferenceS=ColReferenceF
Next
End Sub

не до конца ясен результат функции

Function GetColList(List() As String, ByVal TabName As String) As Integer
Dim test_condition As SmallInt
Dim Column_count,I,J As Integer
Dim col_name As String
Column_count = 0 'Originate the table count
ReDim list(0) 'Clear out array
ReDim list(NumCols(TabName)) 'Dimension work array to max number
For I = 1 to NumCols(TabName)
col_name = ColumnInfo(TabName,"col" + I, COL_INFO_NAME)

Column_count = Column_count + 1
list(Column_count) = col_name 'case all
Next
GetColList = Column_count 'Assign return value
ReDim list(Column_count) 'Re Dimension array to number of tables added
End Function

при каждом вызове она вернет разный массив строк???

И как мне кажется главная проблема в этой функции и в том что я не могу корректно передать список строк, т.е. у меня при вызове ID 3 и ID 4, данные читаются из массива ColArray, а как сделать два разных массива для двух таблиц не дойдет до меня никак (НОВИЧЕК),
наверное надо править Function GetColList???