Составить функцию

serj71298 · #1 22.02.2009, 16:16

Помогите составить функцию, возвращающую значение TRUE, еслив двух заданных одномерных массивах нет равных элементов,FALSE в противном случае.

Заранее спасибо.

4EJIOBEK · #2 22.02.2009, 22:27

Если у Вас есть цикл и в нем более 1 действия то ОБЯЗАТЕЛЬНО надо ставить Begin...End

Как мне кажется ошибка здесь...

Код:

procedure TForm1.Button3Click(Sender: TObject);
var

found: boolean;
i: longint;
begin
for i:=1 to n do                                      // Цикл без Begin..End
a[i]:=StrToInt(StringGrid1.Cells [i-1,0]);    //  a[1]..a[n] 
b[i]:= StrToInt(StringGrid2.Cells [i-1,0]);   //  b[n] only
found:=False;                        // c While\Repeat тож надо Begin..end
i:=1; 
repeat
if a[i]= b[i] then
found:=True
else
i:=i+1;
until (i>n) or (found = True);
if found then
ShowMessage ( ' ' + IntToStr(i)+#13+' ')
else
ShowMessage ( ' ');


end;

И пожалуйста... Для кода есть специальный тег Code /code

serj71298 · #3 23.02.2009, 18:02

Как я понимаю нужно что-то вроде этого. Проблема с созданием функции созданной программистом. И завершением программы.

Код:

function NoEqual ( n: integer; var a: TA; b: TA1 ) : boolean;
var i: integer;
begin
for i:=1 to n do
begin
if  a[i] = b[i]  then
Result := false
else
Result:= true;
end;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
i: longint;
begin
for i:=1 to n do
a[i]:=StrToInt(StringGrid1.Cells [i-1,0]);
b[i]:= StrToInt(StringGrid2.Cells [i-1,0]);
NoEqual:=False;
i:=1;
repeat
if a[i]= b[i] then
NoEqual:=False;
 ShowMessage ( ' ' + IntToStr(i)+#13+' '
else
i:=i+1;
until (i>n) or (NoEqual = True);
if NoEqual then
)
//else
ShowMessage ( ' ');



end;
 begin

ShowMessage ( '     ')
else
 ShowMessage ( '    ');



end;

end.

4EJIOBEK · #4 23.02.2009, 20:28

Цитата:

Сообщение от serj71298

Помогите составить функцию, возвращающую значение TRUE, еслив двух заданных одномерных массивах нет равных элементов,FALSE в противном случае.

Код:

var
  Form1: TForm1;
  length:array [1..2] of word;
  Arr1:Array of real;
  Arr2:Array of real;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var i,lk,k:word;
begin
length[1]:=StrToInt(Edit1.Text);
length[2]:=StrToInt(Edit2.Text);
for k:=1 to 2 do
Begin
lk:=Length[k];
for i:=1 to lk do
Stringgrid1.Cells[i,k]:=FloatToStr(StrToFloat(InputBox('','','')));
End;
SetLength(Arr1,Length[1]);
SetLength(Arr2,Length[2]);
For i:=0 to length[1]-1 do
Arr1[i]:=StrToInt(Stringgrid1.Cells[i+1,1]);
For i:=0 to length[2]-1 do
Arr2[i]:=StrToInt(Stringgrid1.cells[i+1,2]);
end;
Function Equal (var len1,len2:word):boolean;
Var i:word;
Begin
If (Len1=Len2) then
Begin
Equal:=True;
For i:=0 to (len1-1) do
If (Arr1[i]=Arr2[i]) then
Begin
Equal:=False;
Break;
End;
End
Else

End;

procedure TForm1.Button3Click(Sender: TObject);
begin
Label1.Caption:=BoolToStr(Equal(length[1],length[2]));
end;

Вот... У меня все работает...

Но если True, то в Label1 , будет 0...
А если False то -1

Zigfreed1 · #5 23.02.2009, 21:28

Цитата:

Но если True, то в Label1 , будет 0...

исполюзуй конструкцию if что бы вместо 0 и 1 было то что ты хочеш...)

serj71298 · #6 27.02.2009, 02:11

Здравствуйте. В 1 варианте я начудил. Вроде бы переделал, сейчас проблема в вводе знач. в массив. Програм. ругается " Access violation at accress 004601c8 in module ' Project. exe' Write of address 00000008", в англ "0".

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids;

type
  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    StringGrid2: TStringGrid;
    //Label1: TLabel;
   // Label2: TLabel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
   
  private
    { Private declarations }
  public
    { Public declarations }
   
  end;

   Type Mass  = array of real;
        Mass1 = array of real;
var
  Form1: TForm1;
  a: Mass;
  b: Mass1;
  n: Longint;
 
implementation

{$R *.dfm}

function nalichie (a, b:array of real;  n: Longint): boolean;
  var

   i: integer;

begin

   result:= true;
    i:= 1;
repeat

if a[i] = b[i] then
 Result:= False
 else
 i:= i+1;
 until (i>n) or (Result=False);
 if Result then

   ShowMessage ('нет равных элементов' )
   else
    ShowMessage ( 'есть равные элементы ');

end;



procedure TForm1.Button1Click(Sender: TObject);

begin
 n:= StrToInt (Trim (Edit1.Text));
 SetLength(a,n);
 StringGrid1.RowCount:= 1;
 StringGrid1.ColCount:=n;
 end;

procedure TForm1.Button2Click(Sender: TObject);

begin
 n:= StrToInt (Trim (Edit2.Text));
 SetLength(a,n);
 StringGrid2.RowCount:= 1;
 StringGrid2.ColCount:=n;
 end;





procedure TForm1.Button3Click(Sender: TObject);


var
i: Longint;
 
begin


for i:= 1 to n do
    a[i]:= StrToInt (StringGrid1.Cells [ i-1, 0]);

for i:= 1 to n do
    b[i]:= StrToInt (StringGrid2.Cells [ i-1, 0]);
   
    
 nalichie (a,b,n)
  end;


end.

Rokuell · #7 27.02.2009, 02:18

Type Mass = array of real;

Индексация динамического массива начинается с 0, т.е [0..n-1]
n - длина массива.

Исправляй.

Aristarh Dark · #8 27.02.2009, 06:27

Вот, взято из AcedUtils:

Код:

{ G_SameLongs выполняет побайтное сравнение массивов 4-байтных элементов
  (например, типа Integer), адресуемых P1 и P2. Количество элементов в каждом
  из массивов задается параметром Count. Функция возвращает True, если все
  соответствующие элементы обоих массивов равны, в противном случае возвращает
  False. }

function G_SameLongs(P1, P2: Pointer; Count: Cardinal): Boolean;

ну и сама реализация

Код:

function G_SameLongs(P1, P2: Pointer; Count: Cardinal): Boolean;
asm
        CMP     EAX,EDX
        JE      @@ex
        PUSH    ESI
        PUSH    EBX
        MOV     ESI,ECX
        AND     ECX,$7
        SHR     ESI,3
        JE      @@nx
@@lp1:  MOV     EBX,[EAX]
        CMP     EBX,[EDX]
        JNE     @@zq1
        MOV     EBX,[EAX+4]
        CMP     EBX,[EDX+4]
        JNE     @@zq1
        MOV     EBX,[EAX+8]
        CMP     EBX,[EDX+8]
        JNE     @@zq1
        MOV     EBX,[EAX+12]
        CMP     EBX,[EDX+12]
        JNE     @@zq1
        MOV     EBX,[EAX+16]
        CMP     EBX,[EDX+16]
        JNE     @@zq1
        MOV     EBX,[EAX+20]
        CMP     EBX,[EDX+20]
        JNE     @@zq1
        MOV     EBX,[EAX+24]
        CMP     EBX,[EDX+24]
        JNE     @@zq1
        MOV     EBX,[EAX+28]
        CMP     EBX,[EDX+28]
        JNE     @@zq1
        ADD     EAX,32
        ADD     EDX,32
        DEC     ESI
        JNE     @@lp1
@@nx:   JMP     DWORD PTR @@tV[ECX*4]
@@ex:   MOV     EAX,1
        RET
@@tV:   DD      @@tu0, @@tu1, @@tu2, @@tu3
        DD      @@tu4, @@tu5, @@tu6, @@tu7
@@zq1:  POP     EBX
        POP     ESI
        XOR     EAX,EAX
        RET
@@tu7:  MOV     EBX,[EAX+ECX*4-28]
        CMP     EBX,[EDX+ECX*4-28]
        JNE     @@zq2
@@tu6:  MOV     EBX,[EAX+ECX*4-24]
        CMP     EBX,[EDX+ECX*4-24]
        JNE     @@zq2
@@tu5:  MOV     EBX,[EAX+ECX*4-20]
        CMP     EBX,[EDX+ECX*4-20]
        JNE     @@zq2
@@tu4:  MOV     EBX,[EAX+ECX*4-16]
        CMP     EBX,[EDX+ECX*4-16]
        JNE     @@zq2
@@tu3:  MOV     EBX,[EAX+ECX*4-12]
        CMP     EBX,[EDX+ECX*4-12]
        JNE     @@zq2
@@tu2:  MOV     EBX,[EAX+ECX*4-8]
        CMP     EBX,[EDX+ECX*4-8]
        JNE     @@zq2
@@tu1:  MOV     EBX,[EAX+ECX*4-4]
        CMP     EBX,[EDX+ECX*4-4]
        JNE     @@zq2
@@tu0:  POP     EBX
        POP     ESI
        MOV     EAX,1
        RET
@@zq2:  POP     EBX
        POP     ESI
        XOR     EAX,EAX
end;

serj71298 · #9 27.02.2009, 23:25

Наконец-то разобрался.
Всем, кто помогал, спасибо. Вроде все работает.
Скидываю [код], может кому пригодится.
Если можно проще поправьте.

Код:

 Type Mass  = array of real;
        Mass1 = array of real;
var
  Form1: TForm1;
  a: Mass;
  b: Mass1;
  n: Longint;

implementation

{$R *.dfm}

Function nalichie (a,b: array of real; n: Longint): Boolean;
var
   i: Longint;

begin
   Result:= True;
   i:= 0;

 repeat
 if a[i] = b[i] then Result:= False
 else i:=i+1;
 Until (i>n) or (Result= False);

  if Result then
  ShowMessage ('В массивах нет равных элементов')
  else
  ShowMessage ('В массивах равные элементы'
  + #13+ ' Элемент №'' '+ IntToStr (i));
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 n:= StrToInt (Trim (Edit1.Text));
 SetLength(a,n);
 StringGrid1.RowCount:=0;
 StringGrid1.ColCount:=n;
 end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 n:= StrToInt (Trim (Edit2.Text));
 SetLength(b,n);
 StringGrid2.RowCount:=0;
 StringGrid2.ColCount:=n;
 end;

procedure TForm1.Button3Click(Sender: TObject);
var
   i: Longint;

begin
 for i:=0 to n-1 do
    a[i]:= StrToFloat (StringGrid1.cells[i,0]);
 for i:=0 to n-1 do
    b[i]:= StrToFloat (StringGrid2.cells[i,0]);
    nalichie (a,b,n)
end;

serj71298 · #10 28.02.2009, 14:53

Извините, маленькая проблема возникла:
При вводе « n» - разного количества в массивы прог. ругается
(i>n) при любых условиях: <=, >=, =.

Код:

 
repeat
 if a[i] = b[i] then Result:= False
 else i:=i+1;
 Until (i>n) or (Result= False);

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	RSS лента	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Новости сайта Новости форума	Ссылки и Баннеры Donate О сайте Реклама Контакты