Пример Назад В начало Вперед
// ------------ Описание -------------------
objInterface iTest;
 property pName : string[20] read;

 index iByName = pName;
end;

// ------------ Реализация -----------------
#include IManualIndex.vih

vipInterface cTest1 implements iManualIndex, iTest;

interface cTest1;
 const LENGTH = 5;
 end;
 create view;
 var curPos : integer;
	 tmpPos : integer;
	 mas : array [1..1] of string[20];

 function OpName(n : byte) : string;
 {
  case n
   of cndEqual		: OpName := '==';
	cndGreater		: OpName := '<<';
	cndLess		 : OpName := '>>';
	cndNotEqual	 : OpName := '<>';
	cndGreaterOrEqual : OpName := '<<=';
	cndLessOrEqual	: OpName := '>>=';
  end;
 }

 function PropertyName(n : longInt) : string;
 {
  case n
   of pnITest_pName : PropertyName := 'ITest.pName';
  end;
 }

 property pName : string[20] read mas[curPos];

 index iByName manual;

 function IManualIndex.IndexActivated(indexNum : longInt) : word;
 {
  if indexNum = inITest_iByName then
   result := tsOk;
  else
   result := tsIndexNotFound;
 }

 function IManualIndex.IndexDeactivated(indexNum : longInt) : word;
 {
  if indexNum = inITest_iByName then
   result := tsOk;
  else
   result := tsIndexNotFound;
 }

 function IManualIndex.Find(direction : byte) : word;
 {
  var value : string;
  var op : byte;
  var pr : longInt;

  tmpPos := curPos;

  if FilterSegsCount > 0 then
  {
   GetFilterSeg(0, value, op, pr);
   if pr <> pnITest_pName then
   {
	Message('tsInternalError');
	result := tsInternalError;
	exit;
   }

   if direction = idForward then
   {
	for(curPos := 1; curPos <= LENGTH; curPos := curPos + 1)
	{
	 if (ValidateAllFilterSegs = true) and (ValidateBooleanFilters = true) then
	 {
	result := tsOk;
	exit;
	 }
}
   }
   else
   {
	for(curPos := LENGTH; curPos >= 1; curPos := curPos - 1)
	{
	 if (ValidateAllFilterSegs = true) and (ValidateBooleanFilters = true) then
	 {
	result := tsOk;
	exit;
	 }
}
   }
   curPos := tmpPos;
   result := tsNotFound;
  }
  else
  {
   if direction = idForward then
	curPos := 1;
   else
	curPos := LENGTH;
   result := tsOk;
  }
 }

 Function IManualIndex.Move(direction : byte) : word;
 {
  var value : string;
  var op : byte;
  var pr : longInt;

  tmpPos := curPos;

  if FilterSegsCount > 0 then
  {
   GetFilterSeg(0, value, op, pr);
   if pr <> pnITest_pName then
   {
	Message('tsInternalError');
	result := tsInternalError;
	exit;
   }
  }

  if direction = idForward then
  {
   if curPos < LENGTH then
   {
	curPos := curPos + 1;
	if (ValidateAllFilterSegs = true) and (ValidateBooleanFilters = true) then
	{
	 result := tsOk;
	 exit;
}
   }
  }
  else
  {
   if curPos > 1 then
   {
	curPos := curPos - 1;
	if (ValidateAllFilterSegs = true) and (ValidateBooleanFilters = true) then
	{
	 result := tsOk;
	 exit;
}
   }
  }
  curPos := tmpPos;
  result := tsNotFound;
 }

 function IManualIndex.GetAddr(var address : comp) : word;
 {
  address := curPos;
  result := tsOk;
 }

 function IManualIndex.GetDirect(address : comp) : word;
 {
  curPos := address;
  result := tsOk;
 }

 function IManualIndex.FilterChanged : word;
 {
  result := tsOk;
 }

 function IManualIndex.Count : longInt;
 {
  result := LENGTH;
 }

handleEvent
cmInit:
{
 mas[1] := 'x$ATTR';
 mas[2] := 'x$FIELDS';
 mas[3] := 'x$FILES';
 mas[4] := 'x$INDEXES';
 mas[5] := 'x$RESOURCES';
 curPos := 1;
}

cmOnVipLoad:
{
 ProcessCommand(cmInit);
}

end;

end.

// ------------ Использование --------------
interface test;
  var pTest : ITest(cTest1) new;

  create view as
	select * from x$files, pTest
	where ((xf$name == pName and 'X$' << xf$name))
	order by xf$name;

  panel p0
	show at (,,,15);
	table x$files;
	browse b0 'Пример использования навигационных и реляционных свойств объектов';
	fields
		pName 'pName' : protect;
		xf$name 'xf$name' : protect;
	end; // browse b0
  end; // panel p0
end. // interface test

interface test2;
  var pTest : ITest(cTest1) new;

  create view as
	select * from x$files, pTest
	where ((pName == xf$name and 'x$FIELDS' <<= pName))
	order by pName;

  panel p0
	show at (,,,15);
	table pTest;
	browse b0 'Пример использования навигационных и реляционных свойств объектов';
	fields
		pName 'pName' : protect;
		xf$name 'xf$name' : protect;
	end; // browse b0
  end; // panel p0
end. // interface test2