Помогите исправить код

[garuna]

Добрый день!

Есть массив записей, который содержит дату, ФИО сотрудника, сумму и отдел в котором он работает.

Стоит задача сделать два списка, в первом списке нужно вывести дату, ФИО и отдел.
Во втором списке по каждому отделу вывести общую сумму для всех сотрудников и отсортировать список по сумме.

Первый список сделал, а вот со вторым проблема. Часа полтора уже смотрю на код и не могу понять что не так. Должно получиться вот так:

Финансовый отдел     210133
Бухгалтерия          145500
Отдел метрологии     109600
Транспортный цех     88000

Но получается как на скрине:



Буду очень благодарен, если у кого-то найдется пару минут глянуть код и подсказать в чем проблема.

Исходник: https://yadi.sk/d/RFi6BmevohgCi

[Sibedir]

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

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

не мудрено...

type
  TLRec = record
    _1, _2, _3, _4, _5: string;
    Cached: Boolean;
  end;
  TLArr = array of TLRec;

  TStatistics = record
    Otdel: string;
    Kabinet: string;
    Summa: integer;
    DataVremja: string;
  end;
  TStatArr = array of TStatistics;

var
  Form1: TForm1;
  Arr: TLArr;
  StatArr: TStatArr;

implementation

{$R *.dfm}

procedure SortArray(var A: array of TStatistics; SortBy: integer);
var
  i, j: Integer;
  buf: TStatistics;
  cmp: Boolean;
begin
  for i := High(A) downto Low(A)+1 do begin
    for j := i downto Low(A)+1 do begin
      case SortBy of
        0: cmp := AnsiLowerCase(A[j].Otdel) > AnsiLowerCase(A[j-1].Otdel);
        1: cmp :=               A[j].Summa  >               A[j-1].Summa ;
        else cmp := False;
      end;
      if cmp then begin
        buf    := A[j]  ;
        A[j]   := A[j-1];
        A[j-1] := buf   ;
      end;
    end;
  end;
end;

procedure TForm1.btn1Click(Sender: TObject);
var
  i, j: integer;
  tmp: TLRec;

  function FindInStatArr (rec: TLRec): Integer;
  var
    _i: Integer;
  begin
    Result := Low(StatArr) - 1;
    for _i := Low(StatArr) to High(StatArr) do begin
      if StatArr[_i].Otdel = rec._4 then begin
        Result := _i;
        Break;
      end;
    end;
  end;

  function AddToStatArr (rec: TLRec): Integer;
  begin
    SetLength (StatArr, Length(StatArr)+1);
    Result := High(StatArr);
    StatArr[Result].Otdel      :=          rec._4;
    StatArr[Result].Kabinet    :=          rec._3;
    StatArr[Result].Summa      := StrToInt(rec._5);
    StatArr[Result].DataVremja :=          rec._1;
  end;

begin
  SetLength (StatArr, 0);
  for i := Low(Arr) to High(Arr) do begin
    tmp := Arr[i];
    j := FindInStatArr (tmp);
    if j < Low(StatArr) then begin
      AddToStatArr (tmp);
    end
    else begin
      StatArr[j].DataVremja := tmp._1;
      StatArr[j].Summa      := StatArr[j].Summa + StrToInt(tmp._5);
    end;
  end;
  SortArray (StatArr, 1);
  lv1.Items.Count:= Length(StatArr);
end;

Один из тех случаев, когда проще написать с нуля, чем искать ошибку

[garuna]

Sibedir,

действительно, так намного лучше! спасибо, очень выручил )
Вопрос наконец-то решен.

[Sibedir]

А TLIst использовать можно?

[garuna]

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

А TLIst использовать можно?

да, но с ним как-то не приходилось еще работать, поэтому через массивы записей решил сделать

[Sibedir]

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls;

type
  TForm1 = class(TForm)
    lv1: TListView;
    lv2: TListView;
    btn1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure lv2Data(Sender: TObject; Item: TListItem);
    procedure btn1Click(Sender: TObject);
    procedure lv1Data(Sender: TObject; Item: TListItem);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  PLRec = ^TLRec;
  TLRec = record
    _1, _2, _3, _4, _5: string;
    Cached: Boolean;
  end;

  PStatistics = ^TStatistics;
  TStatistics = record
    Otdel: string;
    Kabinet: string;
    Summa: integer;
    DataVremja: string;
  end;

var
  Form1: TForm1;

implementation

var
  Arr: TList;
  StatArr: TList;

function _CompareStatistics_Summa (Item1, Item2: Pointer): Integer;
begin
  Result := PStatistics(Item2).Summa - PStatistics(Item1).Summa;
end;

function FindInStatArr (aOtdel: string): Integer;
var
  i: Integer;
begin
  Result := -1;
  for i := 0 to StatArr.Count-1 do begin
    if PStatistics(StatArr[i]).Otdel = aOtdel then begin
      Result := i;
      Break;
    end;
  end;
end;

function AddToStatArr (rec: PLRec): Integer;
var
  buf: PStatistics;
begin
  Result := StatArr.Count;
  StatArr.Count := StatArr.Count + 1;
  New(buf);
  buf.Otdel      :=          rec._4;
  buf.Kabinet    :=          rec._3;
  buf.Summa      := StrToInt(rec._5);
  buf.DataVremja :=          rec._1;
  StatArr[Result] := buf;
end;


{$R *.dfm}

procedure TForm1.btn1Click(Sender: TObject);
var
  i, j: integer;
  tmp: PLRec;
begin
  StatArr.Clear;
  for i := 0 to Arr.Count-1 do begin
    tmp := PLRec (Arr[i]);
    j := FindInStatArr (tmp._4);
    if j < 0 then begin
      AddToStatArr (tmp);
    end
    else begin
      PStatistics (StatArr[j]).DataVremja := tmp._1;
      PStatistics (StatArr[j]).Summa      := PStatistics (StatArr[j]).Summa + StrToInt(tmp._5);
    end;
  end;

  StatArr.Sort (_CompareStatistics_Summa);
  lv1.Items.Count:= StatArr.Count;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  buf: PLRec;
begin
  Arr := TList.Create;
  StatArr := TList.Create;

  New (buf);
  buf._1:= '12.10.15 12:09:15';
  buf._2:= 'Иванов И.Ф.';
  buf._3:= 'кб. 318';
  buf._4:= 'Бухгалтерия';
  buf._5:= '40000';
  Arr.Add (buf);

...

  lv2.Items.Count:= 12;
end;

procedure TForm1.lv2Data(Sender: TObject; Item: TListItem);
var
  buf: PLRec;
begin
  if Arr.Count > 0 then begin
    buf := PLRec (Arr[Item.Index]);
    Item.Caption    := buf._1;
    Item.SubItems.Add (buf._2);
    Item.SubItems.Add (buf._4 + ' (' + buf._3 + ')');
  end;
end;

procedure TForm1.lv1Data(Sender: TObject; Item: TListItem);
var
  buf: PStatistics;
begin
  if StatArr.Count > 0 then begin
    buf := PStatistics (StatArr[Item.Index]);
    Item.Caption              := buf.Otdel;
    Item.SubItems.Add (IntToStr (buf.Summa     ));
    Item.SubItems.Add (          buf.DataVremja );
  end;
end;

end.

[xxbesoxx]

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

Добрый день!

Есть массив записей, который содержит дату, ФИО сотрудника, сумму и отдел в котором он работает.

Стоит задача сделать два списка, в первом списке нужно вывести дату, ФИО и отдел.
Во втором списке по каждому отделу вывести общую сумму для всех сотрудников и отсортировать список по сумме.

Не какой слова про СУБД , не какой слова про структуру таблицы ,про SQL запросов нечего .... Толь "массив" что имеется в виду если не секрет ?

[Аватар]

СУБД при каких делах? Массив он и есть массив, хоть структур, хоть чего угодно

[xxbesoxx]

Сообщение от Аватар

СУБД при каких делах?

1. Я прошу прошения если не по тему
2. Удивительно... Кому нужно в массиве "ФИО сотрудника" ?

[northener]

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

1. Я прошу прошения если не по тему
2. Удивительно... Кому нужно в массиве "ФИО сотрудника" ?

Преподу.
Который якобы преподает программирование на Делфи, но кроме паскаля ничего не знает.