
20.04.2008, 23:38
|
Модератор
|
|
Регистрация: 17.04.2008
Сообщения: 8,087
Версия Delphi: 7, XE3, 10.2
Репутация: 49089
|
|
Не могу скачать архив - совсем рапидшара офонарела со своими кодами.
Должно быть что-то типа того (инициализация для простоты случайным образом)
Форма:
Код:
object Form1: TForm1
Left = 192
Top = 114
Width = 696
Height = 480
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 8
Top = 8
Width = 22
Height = 13
Caption = 'Исх:'
end
object Label2: TLabel
Left = 168
Top = 8
Width = 53
Height = 13
Caption = 'Фильтр.'
end
object StringGrid1: TStringGrid
Left = 8
Top = 24
Width = 137
Height = 409
ColCount = 2
FixedCols = 0
RowCount = 1
FixedRows = 0
TabOrder = 0
end
object Button1: TButton
Left = 328
Top = 24
Width = 75
Height = 25
Caption = 'Go'
TabOrder = 1
OnClick = Button1Click
end
object StringGrid2: TStringGrid
Left = 168
Top = 24
Width = 137
Height = 409
ColCount = 2
FixedCols = 0
RowCount = 1
FixedRows = 0
TabOrder = 2
end
end
Собственно программа:
Код:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids;
type
TForm1 = class(TForm)
StringGrid1: TStringGrid;
Button1: TButton;
StringGrid2: TStringGrid;
Label1: TLabel;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
ar1 : Array Of String; // шифры
ar2 : Array Of Double; // параметры
ar3 : Array Of Integer; // индексы отфильтровки
procedure Init; // инициализация. Для простоты - случайным образом.
procedure PrintOut; // вывод
procedure Filtr; // фидьрация
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
Init;
Filtr;
PrintOut;
end;
procedure TForm1.Filtr;
var
I : Integer;
begin
SetLength(Ar3,0); // длинна массива = 0
For I := Low(Ar2) To High(Ar2) Do // перебираем все параметры
If Ar2[i] > 0.5 Then //твое условие отбора. здесь - парам. > 0.5
Begin
SetLength(Ar3,Length(ar3)+1); // увеличить длинну массива на 1
Ar3[High(Ar3)] := I; // сохранить в новом элементе текущий индекс
End;
end;
procedure TForm1.Init;
var
N : Integer;
I : Integer;
begin
// Сколько будет исходный данных
Randomize;
N := 1 + Round(20 * Random);
// Ставим длинну
SetLength(Ar1,N);
SetLength(Ar2,N);
// инициализируем массивы
For I := Low(Ar1) To High(Ar1) Do
begin
Ar1[i] := Chr(Round(26 * Random) + 65) + IntToStr(I); // буква + номер
Ar2[i] := Random;
end;
// Выводим для наглядности
StringGrid1.RowCount := N + 1; // 1- заголовок
StringGrid1.Cells[0,0] := 'Шифр';
StringGrid1.Cells[1,0] := 'Парам.';
For I := 0 To Length(Ar1) - 1 Do
Begin
StringGrid1.Cells[0,I+1] := Ar1[i];
StringGrid1.Cells[1,I+1] := FloatToStr(Ar2[i]);
End;
end;
procedure TForm1.PrintOut;
var
I : Integer;
begin
StringGrid2.RowCount := Length(Ar3) + 1; // 1- заголовок
StringGrid2.Cells[0,0] := 'Шифр';
StringGrid2.Cells[1,0] := 'Парам.';
For I := 0 To Length(Ar3) - 1 Do
Begin
StringGrid2.Cells[0,I+1] := Ar1[Ar3[i]];
StringGrid2.Cells[1,I+1] := FloatToStr(Ar2[Ar3[i]]);
End;
end;
end.
|