Показать сообщение отдельно
  #2  
Старый 20.04.2008, 23:38
lmikle lmikle вне форума
Модератор
 
Регистрация: 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.
Ответить с цитированием