[poli-smen]

Сообщение от M.A.D.M.A.N.

Ему надо кусок кода.

Написал ещё позавчера, но не выкладывал, надеялся что он сам справится:

Код:

type
  TDataItem = record
    Name: String;
    Time: TTime;
    IsEnter: Boolean;
  end;
  TDataList = array of TDataItem;

var
  DataList: TDataList;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  slData, slNames, slLine: TStringList;
  i: Integer;
begin
  if OpenDialog1.Execute then
  begin
    ListBox1.Clear;

    slData := TStringList.Create;
    try
      slData.LoadFromFile(OpenDialog1.FileName);
      SetLength(DataList, slData.Count);

      slNames := TStringList.Create;
      try
        slNames.Duplicates := dupIgnore;
        slNames.Sorted := True;

        slLine := TStringList.Create;
        try
          slLine.Delimiter := ';';

          for i := 0 to slData.Count - 1 do
          begin
            slLine.DelimitedText := slData[i];
            slNames.Add(slLine[0]);
            DataList[i].Name := slLine[0];
            DataList[i].Time := StrToTime(slLine[1]);
            DataList[i].IsEnter := AnsiSameText(slLine[2], 'пришел');
          end;
        finally
          slLine.Free;
        end;

        ListBox1.Items.Assign(slNames);
      finally
        slNames.Free;
      end;

    finally
      slData.Free;
    end;
  end;
end;

procedure DrawTime(Canvas: TCanvas; aRect: TRect; Name: String);
var
  EnterTime, ExitTime: TTime;
  i, aWidth: Integer;
begin
  Canvas.Pen.Color := clBlack;
  Canvas.Brush.Color := clSilver;
  Canvas.Rectangle(aRect);

  Canvas.Pen.Color := clGreen;
  Canvas.Brush.Color := clLime;

  aWidth := aRect.Right - aRect.Left;
  EnterTime := -1;
  for i := Low(DataList) to High(DataList) do
  begin
    if AnsiSameText(Name, DataList[i].Name) then
    begin
      if DataList[i].IsEnter then
      begin
        if EnterTime < 0 then EnterTime := DataList[i].Time;
      end else
      begin
        if EnterTime >= 0 then
        begin
          ExitTime := DataList[i].Time;
          Canvas.Rectangle(Trunc(aWidth * EnterTime), aRect.Top, Trunc(aWidth * ExitTime), aRect.Bottom);
          EnterTime := -1;
        end;
      end;
    end;
  end;

  if EnterTime >= 0 then
  begin
    ExitTime := 1;
    Canvas.Rectangle(Trunc(aWidth * EnterTime), aRect.Top, Trunc(aWidth * ExitTime), aRect.Bottom);
  end;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
var
  aRect: TRect;
  i, aWidth, X: Integer;
  s: string;
begin
  aRect := Rect(10, 10, ClientWidth - 10, 30);
  Repaint;

  DrawTime(Canvas, aRect, ListBox1.Items[ListBox1.ItemIndex]);

  Canvas.Brush.Color := Color;
  Canvas.Pen.Color := clBlack;
  aWidth := aRect.Right - aRect.Left;
  for i := 0 to 24 do
  begin
    X := aRect.Left + (aWidth * i div 24);
    Canvas.MoveTo(X, aRect.Bottom + 4);
    Canvas.LineTo(X, aRect.Bottom - 4);
    s := IntToStr(i);
    Canvas.TextOut(X - Canvas.TextWidth(s) div 2, aRect.Bottom + 4, s);
  end;
end;