Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2004.08.01;
Скачать: [xml.tar.bz2];

Вниз

входные данныйе одной функции разных типов....   Найти похожие ветки 

 
sectus ©   (2004-07-14 20:16) [0]

unit GameFunc;

interface
type TDynamicVArray = array of Variant;

function LookIn(sub:variant;a:TDynamicVArray):integer;  //стмотрим, есть ли элемент в  "множестве", выдаем обратно номер элемента, или -1
procedure Add_Element(e:variant;var a:TDynamicVArray); //если Asset=true, то элемент добавляется, если его не было, False-добавляется в любом случае
procedure Add_AnyWay(e:variant;var a:TDynamicVArray);
procedure Delete_Element(e:variant; var a:TDynamicVArray);
function Sum(a,a1:TDynamicVArray):TDynamicVArray;
function Cross(a,a1:TDynamicVArray):TDynamicVArray;
function Difference(a,a1:TDynamicVArray):TDynamicVArray;

implementation

function LookIn(sub:variant;a:TDynamicVArray):integer;
var i:integer;
begin
i:=-1;         //на случай, если массив нулевой
while (i<length(a)-1) do    //бежим от начала, до конца массива
 begin
 inc(i);
 if a[i]=sub then        //если элемент найден
  begin
   result:=i;            //возвращаем его порядковый номер
   break;                //прерываем цикл поиска
  end
  else result:=-1;       //если элемент не найден - возвращаем -1
 end;
end;

procedure add_element(e:variant; var a:TDynamicVArray);
begin
 if length(a)<=0 then            //если массив пока нулевой
  begin
   setlength(a,1);               //устанавливаем длину массива равной 1
   a[0]:=e;                      //присваиваем первому елементу требуемое значение
  end
 else
  if LookIn(e, a)=-1 then     //если массив ненулевой, то проверяем, есть ли там уже это значение
           begin
            setlength(a,length(a)+1); //если нет-увеличиваем длину массива
            a[length(a)-1]:=e;        //присваиваем последнему элементу требуемой значение
           end
end;

procedure add_AnyWay(e:variant; var a:TDynamicVArray);
begin
 if length(a)<=0 then            //если массив пока нулевой
  begin
   setlength(a,1);               //устанавливаем длину массива равной 1
   a[0]:=e;                      //присваиваем первому елементу требуемое значение
  end
 else
  begin
   setlength(a,length(a)+1); //если нет-увеличиваем длину массива
   a[length(a)-1]:=e;        //присваиваем последнему элементу требуемой значение
  end
end;

procedure delete_element(e:variant; var a:TDynamicVArray);
begin
if LookIn(e,a)>=0 then   //если такой элемент в "множестве" найден
 begin
  a[LookIn(e,a)]:=a[length(a)-1]; //присваиваем, убитому элементу значение последнего элемента
  setlength(a, length(a)-1);      //сокращаем массив на один элемент
 end;
end;

function sum(a,a1:TDynamicVArray):TDynamicVArray;
var i:integer;
begin
result:=a;
for i:=0 to length(a1)-1 do
 if (LookIn(a1[i],a)=-1) then
   begin
   setlength(result, length(result)+1);
   result[length(result)-1]:=a1[i];
   end;
end;

function cross(a,a1:TDynamicVArray):TDynamicVArray;
var i:integer;
begin
for i:=0 to length(a1)-1 do
 if (LookIn(a1[i],a)>=0) then
   begin
   setlength(result, length(result)+1);
   result[length(result)-1]:=a1[i];
   end;
end;

function difference(a,a1:TDynamicVArray):TDynamicVArray;
var i:integer;
begin
result:=a;
for i:=0 to length(a1)-1 do
   delete_element(a1[i], result);
end;

end.

это юнит для работы с массивами...
но работать он будет с масссивами типа вариант, а мне нужно чтобы с любыми типами работали эти функции и процедуры...
вот например с таким типом:
type TPixel=record
item_there:boolean;
item_id:integer;
item_see:integer;
end;


 
Anatoly Podgoretsky ©   (2004-07-14 20:21) [1]

Это лучше не в ветку, а на какой ни будь файловый архив.


 
sectus ©   (2004-07-14 20:36) [2]

это все wisekaa он(она, оно) посоветовал(а,о)....


 
Palladin ©   (2004-07-14 20:41) [3]

Ты код коллекционируешь?


 
sectus ©   (2004-07-15 09:43) [4]

если честно, то вопрос не понял....


 
Anatoly Podgoretsky ©   (2004-07-15 12:00) [5]

sectus ©   (15.07.04 09:43) [4]
Вопрос в том зачем ты этот код опубликовал, такие вещи надо помещать в специализированые места, здесь он все равно уйдет в архив.


 
sectus ©   (2004-07-16 20:33) [6]

ладно... больше шума подняли... пытался я задавать вопрос... все : а как это то? а конкретнее?
вот код, что может быть конкретнее... а теперь код слишком большой.... а просто посмотреть всем лень...

а на вопрос я сам себе отвечу...
нельзя сравнивать такие типы знаком равно или любым другим...
эх...


 
Mim1 ©   (2004-07-16 21:38) [7]


> [6] sectus ©   (16.07.04 20:33)

А задавать вы его пробывали? чтобы ответить мог кто нибудь ктото кроме вас?
:)
А то как то странно получается сам спросил сам ответил.

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



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2004.08.01;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.47 MB
Время: 0.052 c
1-1090321048
Vist
2004-07-20 14:57
2004.08.01
Максимизация главной формы при запуске


1-1089844651
k2kator
2004-07-15 02:37
2004.08.01
Связь программы через телефон


1-1089868033
cyborg
2004-07-15 09:07
2004.08.01
Проверка имени файла на недопустимые символы


14-1089396760
Mell
2004-07-09 22:12
2004.08.01
Кто нить знает хоть один адрес типа рамблер.ру русскими буквам


14-1089323624
SSSSS
2004-07-09 01:53
2004.08.01
Кто хочет (за оплату) пописать плагины для АСТРОЛОГИЧЕСКОЙ ПРОГИ?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский