lazarus/components/tachart/tadatapointseditor.pas

{
 *****************************************************************************
  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************

  Author: Alexander Klenin

}
unit TADataPointsEditor;

{$H+}

interface

uses
  ButtonPanel, Classes, ExtCtrls, Grids, Menus, SysUtils, Forms, Controls,
  Graphics, Dialogs, TASources;

type

  TDataPointsEditorOption = (dpeHideColorColumn, dpeHideTextColumn);
  TDataPointsEditorOptions = set of TDataPointsEditorOption;

  { TDataPointsEditorForm }

  TDataPointsEditorForm = class(TForm)
    ButtonPanel1: TButtonPanel;
    cdItemColor: TColorDialog;
    miMoveDown: TMenuItem;
    miMoveUp: TMenuItem;
    miSeparator: TMenuItem;
    miInsertRow: TMenuItem;
    miDeleteRow: TMenuItem;
    pmRows: TPopupMenu;
    sgData: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure miDeleteRowClick(Sender: TObject);
    procedure miInsertRowClick(Sender: TObject);
    procedure miMoveDownClick(Sender: TObject);
    procedure miMoveUpClick(Sender: TObject);
    procedure OKButtonClick(Sender: TObject);
    procedure pmRowsPopup(Sender: TObject);
    procedure sgDataButtonClick(ASender: TObject; ACol, ARow: Integer);
    procedure sgDataDrawCell(
      ASender: TObject; ACol, ARow: Integer; ARect: TRect;
      AState: TGridDrawState);
    procedure sgDataPrepareCanvas(sender: TObject; aCol, aRow: Integer;
      aState: TGridDrawState);
  strict private
    FCurrentRow: Integer;
    FDataPoints: TStrings;
    FXCount: Integer;
    FYCount: Integer;
    FOptions: TDataPointsEditorOptions;
    procedure UpdateCmds;
    function ValidData(out ACol, ARow: Integer; out AMsg: String): Boolean;
  public
    procedure InitData(AXCount, AYCount: Integer; ADataPoints: TStrings;
      AOptions: TDataPointsEditorOptions = []);
    procedure ExtractData(out AModified: Boolean);
    property Options: TDatapointsEditorOptions read FOptions;
  end;

function DataPointsEditor(AListChartSource: TListChartsource;
  AOptions: TDataPointsEditorOptions = []): Boolean;


implementation

uses
  LCLIntf, LCLType, Math, StdCtrls,
  TAChartStrConsts, TAChartUtils;

{$R *.lfm}

function DataPointsEditor(AListChartSource: TListChartsource;
  AOptions: TDataPointsEditorOptions = []): Boolean;
var
  F: TDataPointsEditorForm;
  wasSorted: Boolean;
begin
  Result := false;
  F := TDataPointsEditorForm.Create(Application);
  try
    wasSorted := AListChartSource.Sorted;
    AListChartSource.Sorted := false;
    F.InitData(
      AListChartSource.XCount,
      AListChartSource.YCount,
      AListChartSource.DataPoints,
      AOptions
    );
    if F.ShowModal = mrOK then begin
      F.ExtractData(Result);
      if wasSorted then AListChartSource.Sorted := true;
    end;
  finally
    F.Free;
  end;
end;

function EditText(var AText: String): Boolean;
var
  F: TForm;
  memo: TMemo;
begin
  F := TForm.CreateNew(Application);
  try
    F.Caption := 'Data point text';
    F.Position := poScreenCenter;
    memo := TMemo.Create(F);
    with memo do begin
      Parent := F;
      Align := alClient;
      BorderSpacing.Around := 6;
      Lines.Text := AText;
    end;
    with TButtonPanel.Create(F) do begin
      Parent := F;
      Align := alBottom;
      BorderSpacing.Around := 6;
      ShowButtons := [pbOK, pbCancel];
    end;
    Result := F.ShowModal = mrOK;
    if Result then AText := memo.Lines.Text;
  finally
    F.Free;
  end;
end;


{ TDataPointsEditorForm }

procedure TDataPointsEditorForm.ExtractData(out AModified: Boolean);
var
  i: Integer;
  s: String;
  oldDataPoints: String;
begin
  oldDataPoints := FDataPoints.Text;
  FDataPoints.BeginUpdate;
  try
    FDataPoints.Clear;
    for i := 1 to sgData.RowCount - 1 do begin
      with sgData.Rows[i] do begin
        Delimiter := '|';
        StrictDelimiter := true;
        s := DelimitedText;
      end;
      if Length(s) >= sgData.ColCount then
        FDataPoints.Add(Copy(s, 2, MaxInt));
    end;
  finally
    FDataPoints.EndUpdate;
    AModified := FDataPoints.Text <> oldDataPoints;
  end;
end;

procedure TDataPointsEditorForm.InitData(AXCount, AYCount: Integer;
  ADataPoints: TStrings; AOptions: TDataPointsEditorOptions = []);
var
  i: Integer;
  w: Integer;
begin
  FXCount := AXCount;
  FYCount := AYCount;
  FDataPoints := ADataPoints;
  FOptions := AOptions;
  sgData.RowCount := Max(ADataPoints.Count + 1, 2);
  for i := 1 to AYCount do
    with sgData.Columns.Add do begin
      Assign(sgData.Columns[0]); // Columns[0] is a template column
      if AYCount = 1 then
        Title.Caption := 'Y'
      else
        Title.Caption := 'Y' + IntToStr(i);
      Index := i;
    end;
  for i := 1 to AXCount do
    with sgData.Columns.Add do begin
      Assign(sgData.Columns[0]); // Columns[0] is a template column
      if AXCount = 1 then
        Title.Caption := 'X'
      else
        Title.Caption := 'X' + IntToStr(i);
      Index := i;
    end;
  sgData.Columns.Delete(0); // remove the template column
  sgData.Columns[sgData.Columns.Count-2].Visible := not (dpeHideColorColumn in FOptions);
  sgData.Columns[sgData.Columns.Count-1].Visible := not (dpeHideTextColumn in FOptions);
  for i := 0 to ADataPoints.Count - 1 do
    Split('|' + ADataPoints[i], sgData.Rows[i + 1]);

  // Adjust column widths
  w := sgData.Canvas.TextWidth('$000000') + 3*varCellPadding + sgData.DefaultRowHeight;
  for i := 0 to sgData.Columns.Count-2 do
    sgData.Columns[i].Width := w;
  sgData.Columns[sgData.Columns.Count-1].Width := 3*w;

  w := sgData.ColWidths[0] + sgData.Left * 2;
  for i := 0 to sgData.Columns.Count-1 do
    inc(w, sgData.Columns[i].Width);
 {$IFDEF WINDOWS}
  Width := Min(Screen.Width, w + 1 + IfThen(sgData.BorderStyle = bsNone, 0, 3));
 {$ELSE}
  Width := Min(Screen.Width, w + sgData.GridLineWidth * (sgData.Columns.Count-1));
 {$ENDIF}
end;

procedure TDataPointsEditorForm.miDeleteRowClick(Sender: TObject);
begin
  if sgData.RowCount <= 2 then begin
    sgData.Rows[1].Clear;
    exit;
  end;
  if InRange(FCurrentRow, 1, sgData.RowCount - 1) then
    sgData.DeleteRow(FCurrentRow);
end;

procedure TDataPointsEditorForm.FormCreate(Sender: TObject);
begin
  Caption := desDatapointEditor;
  sgData.Columns[1].Title.Caption := desColor;
  sgData.Columns[2].Title.Caption := desText;
  miInsertRow.Caption := desInsertRow;
  miDeleteRow.Caption := desDeleteRow;
  miMoveUp.Caption := desMoveUp;
  miMoveDown.Caption := desMoveDown;
  if IsRightToLeft then
    sgData.AutoAdvance := aaLeftDown
  else
    sgData.AutoAdvance := aaRightDown;
end;

procedure TDataPointsEditorForm.miInsertRowClick(Sender: TObject);
begin
  sgData.InsertColRow(false, FCurrentRow);
end;

procedure TDataPointsEditorForm.miMoveDownClick(Sender: TObject);
begin
  if sgData.Row < sgData.RowCount-1 then
    sgData.ExchangeColRow(false, sgData.Row, sgData.Row+1);
end;

procedure TDataPointsEditorForm.miMoveUpClick(Sender: TObject);
begin
  if sgData.Row > 1 then
    sgData.ExchangeColRow(false, sgData.Row, sgData.Row-1);
end;

procedure TDataPointsEditorForm.OKButtonClick(Sender: TObject);
var
  c, r: Integer;
  msg: String;
begin
  if not ValidData(c, r, msg) then begin
    sgData.Row := r;
    sgData.Col := c;
    sgData.SetFocus;
    MessageDlg(msg, mtError, [mbOK], 0);
    ModalResult := mrNone;
  end;
end;

procedure TDataPointsEditorForm.pmRowsPopup(Sender: TObject);
begin
  FCurrentRow := sgData.MouseToCell(sgData.ScreenToClient(Mouse.CursorPos)).Y;
  if not InRange(FCurrentRow, 1, sgData.RowCount - 1) then
    Abort;
  sgData.Row := FCurrentRow;
  UpdateCmds;
end;

procedure TDataPointsEditorForm.sgDataButtonClick(
  ASender: TObject; ACol, ARow: Integer);
var
  s: String;
begin
  Unused(ASender);
  if (ARow < 1) then exit;

  if (ACol = FXCount + FYCount + 1) then begin
    cdItemColor.Color := StrToIntDef(sgData.Cells[ACol, ARow], clRed);
    if cdItemColor.Execute then
      sgData.Cells[ACol, ARow] := IntToColorHex(cdItemColor.Color);
  end else
  if (ACol = FXCount + FYCount + 2) then begin
    s := sgData.Cells[ACol, ARow];
    if EditText(s) then sgData.Cells[ACol, ARow] := s;
  end;
end;

procedure TDataPointsEditorForm.sgDataDrawCell(
  ASender: TObject; ACol, ARow: Integer; ARect: TRect; AState: TGridDrawState);
var
  c: Integer;
begin
  Unused(ASender, AState);
  if (ARow < 1) or (ACol <> FXCount + FYCount + 1) then exit;
  if not TryStrToInt(sgData.Cells[ACol, ARow], c) then exit;
  sgData.Canvas.Pen.Color := clBlack;
  sgData.Canvas.Brush.Color := c;
  InflateRect(ARect, -varCellPadding, -varCellPadding);
  ARect.Left := ARect.Right - (ARect.Bottom - ARect.Top);;
  sgData.Canvas.Rectangle(ARect);
end;

procedure TDataPointsEditorForm.sgDataPrepareCanvas(sender: TObject; aCol,
  aRow: Integer; aState: TGridDrawState);
var
  ts: TTextStyle;
begin
  Unused(aRow, aState);
  if ACol = 0 then begin
    ts := TStringGrid(Sender).Canvas.TextStyle;
    ts.Alignment := taRightJustify;
    TStringGrid(Sender).Canvas.TextStyle := ts;
  end;
end;

procedure TDataPointsEditorForm.UpdateCmds;
begin
  miDeleteRow.Enabled := sgData.Row > 0;
  miMoveUp.Enabled := sgData.Row > 1;
  miMovedown.Enabled := sgData.Row < sgData.RowCount-1;
end;

function TDataPointsEditorForm.ValidData(out ACol, ARow: Integer;
  out AMsg: String): Boolean;
var
  x: Double;
  i: Integer;
  r, c: Integer;
  s: String;
begin
  Result := false;
  for r := 1 to sgData.RowCount-1 do begin
    for c := 1 to sgData.ColCount-3 do begin
      s := sgData.Cells[c, r];
      if (s <> '') and not TryStrToFloat(s, x) and not TryStrToFloat(s, x, DefSeparatorSettings) then
      begin
        ACol := c;
        ARow := r;
        AMsg := desNoNumber;
        exit;
      end;
    end;
    s := sgData.Cells[sgData.ColCount - 2, r];
    if (s <> '') and (s <> '?') and not TryStrToInt(s, i) then begin
      ACol := sgData.ColCount - 2;
      ARow := r;
      AMsg := desNoInteger;
      exit;
    end;
  end;
  Result := true;
end;

end.