lazarus-ccr/components/tvplanit/source/vpimportpreview.pas

unit VpImportPreview;

{$mode objfpc}{$H+}

interface

uses  
  Classes, SysUtils, Graphics, Types,
  Forms, Controls, Dialogs, Grids, ExtCtrls, StdCtrls, VpBaseDS;

type
  { TVpImportGrid }

  TVpImportGrid = class(TDrawGrid)
  protected
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X,Y: Integer); override;
  public
    procedure DrawCellCheckboxBitmaps(const ACol, ARow: Integer; const ARect: TRect);

  end;


  { TVpImportPreviewForm }

  TVpImportPreviewForm = class(TForm)
    btnExecute: TButton;
    btnCancel: TButton;
    ButtonPanel: TPanel;
    procedure FormShow(Sender: TObject);
    procedure GridDrawCell(Sender: TObject; aCol, aRow: Integer; aRect: TRect;
      {%H-}aState: TGridDrawState);
    procedure GridGetCheckboxState(Sender: TObject; {%H-}ACol, ARow: Integer; 
      var Value: TCheckboxState);
    procedure GridPrepareCanvas({%H-}sender: TObject; aCol, {%H-}aRow: Integer; 
      {%H-}aState: TGridDrawState);
    procedure GridSetCheckboxState(Sender: TObject; {%H-}ACol, ARow: Integer; 
      const Value: TCheckboxState);
  private
    FDatastore: TVpCustomDatastore;
    FGrid: TVpImportGrid;
    procedure SetDatastore(const AValue: TVpCustomDatastore);

  protected
    FItems: TFPList;
    FCol0CheckState: TCheckboxState;
    FLockCheckState: Integer;
    procedure CalcRowHeights;
    function GetCellText({%H-}ACol, {%H-}ARow: Integer): String; virtual;
    procedure PrepareItems; virtual;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CheckItem({%H-}ARow: Integer; {%H-}AChecked: Boolean); virtual;
    function Execute: Boolean; 
    function IsChecked({%H-}ARow: Integer): Boolean; virtual;
    property Datastore: TVpCustomDatastore read FDatastore write SetDatastore;
    property Grid: TVpImportGrid read FGrid;

  end;

var
  VpImportPreviewForm: TVpImportPreviewForm;

implementation

{$R *.lfm}

uses
  LCLIntf, LCLType, Themes,
  VpSR;

{ TVpImportGrid }

procedure TVpImportGrid.DrawCellCheckboxBitmaps(const ACol, ARow: Integer;
  const ARect: TRect);
var
  checkboxState: TCheckboxState;
begin
  checkboxState := cbUnchecked;
  GetCheckBoxState(ACol, ARow, checkboxState);
  DrawGridCheckboxBitmaps(ACol, ARow, ARect, checkboxState);
end;

procedure TVpImportGrid.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X,Y: Integer);
var
  cell: TPoint;
  R: TRect;
  lSize: TSize;
  Details: TThemedElementDetails;
  checkboxState: TCheckboxState;
begin
  inherited;
  cell := MouseToCell(Point(x,y));
  if (cell.X = 0) and (cell.Y = 0) then
  begin
    R := CellRect(cell.X, cell.Y);
    details := ThemeServices.GetElementDetails(tbCheckBoxCheckedNormal);
    lSize := ThemeServices.GetDetailSize(Details);
    lSize.cx := MulDiv(lSize.cx, Font.PixelsPerInch, Screen.PixelsPerInch);
    lSize.cy := MulDiv(lSize.cy, Font.PixelsPerInch, Screen.PixelsPerInch);
    OffsetRect(R, (R.Left+R.Right-lSize.CX) div 2, (R.Top+R.Bottom-lSize.CY) div 2);
    R.Right := R.Left + lSize.CX;
    R.Bottom := R.Top + lSize.CY;
    if PtInRect(R, Point(x, y)) then
    begin
      checkboxState := cbGrayed;
      GetCheckboxState(cell.x, cell.Y, checkboxState);
      case checkboxState of
        cbChecked:
          SetCheckboxState(cell.X, cell.Y, cbUnchecked);
        cbUnchecked,
        cbGrayed:
          SetCheckboxState(cell.X, cell.Y, cbChecked);
      end;
    end;
    InvalidateCell(cell.X, cell.Y);
  end;
end;


{ TVpImportPreviewForm }

constructor TVpImportPreviewForm.Create(AOwner: TComponent);
begin
  inherited;

  FCol0CheckState := cbChecked;

  FGrid := TVpImportGrid.Create(self);
  with FGrid do
  begin
    Align := alClient;
    Parent := self;
    Columns.Clear;
    with Columns.Add do
    begin
      Alignment := taCenter;
      ButtonStyle := cbsCheckboxColumn;
      Title.Caption := '';
      SizePriority := 0;
      Width := 33;
    end;
    with Columns.Add do
    begin
      ReadOnly := true;
      SizePriority := 1;
      Title.Caption := '';
    end;
    with Columns.Add do
    begin
      ButtonStyle := cbsPickList;
      Title.Caption := '';
      SizePriority := 0;
      Width := 160;
    end;
    AutoFillColumns := true;
    ExtendedSelect := false;
    FixedCols := 0;
    Options := [goEditing, goRowSelect, goThumbTracking,
      goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine,
      goRangeSelect, goSmoothScroll];
    OnDrawCell := @GridDrawCell;
    OnGetCheckboxState := @GridGetCheckboxState;
    OnPrepareCanvas := @GridPrepareCanvas;
    OnSetCheckboxState := @GridSetCheckboxState;
  end;

  FItems := TFPList.Create;

  btnExecute.Caption := RSImportCheckedItems;
  btnCancel.Caption := RSCancelBtn;
end;

destructor TVpImportPreviewForm.Destroy;
begin
  FItems.Free;
  inherited;
end;

procedure TVpImportPreviewForm.CalcRowHeights;
var
  bmp: TBitmap;
  row: Integer;
  R: TRect;
  flags: Integer;
  s: String;
begin
  flags := DT_CALCRECT + DT_WORDBREAK;
  bmp := TBitmap.Create;
  try
    bmp.SetSize(1, 1);
    bmp.Canvas.Font := Grid.Font;
    for row := 1 to Grid.RowCount-1 do
    begin
      R := Rect(0, 0, MaxInt, 0);
      s := GetCellText(1, row);
      if s <> '' then
      begin
        DrawText(bmp.Canvas.Handle, PChar(s), Length(s), R, flags); 
        Grid.RowHeights[row] := R.Bottom - R.Top + 2*varCellPadding;
      end else
        Grid.RowHeights[row] := Grid.DefaultRowHeight;
    end;
  finally
    bmp.Free;
  end;
end;

{ Marks the item in the specified row to be accepted for import. 
  To be overridden by ancestors. }
procedure TVpImportPreviewForm.CheckItem(ARow: Integer; AChecked: Boolean);
var
  r: Integer;
  allcheckstate, cbs: TCheckboxState;
begin
  if ARow > 0 then
  begin
    Grid.GetCheckboxState(0, 1, allcheckstate{%H-});
    for r := 2 to Grid.RowCount-1 do
    begin
      Grid.GetCheckboxState(0, r, cbs{%H-});
      if cbs <> allcheckstate then
      begin
        FCol0Checkstate := cbGrayed;
        exit;
      end;
      FCol0CheckState := allcheckstate;
    end;
  end;
end;

function TVpImportPreviewForm.Execute: Boolean;
begin
  Result := ShowModal = mrOK;
end;

{ Returns the text to be displayed in the grid. 
  To be overridden by ancestors. }
function TVpImportPreviewForm.GetCellText(ACol, ARow: Integer): String;
begin
  Result := '';
end;

procedure TVpImportPreviewForm.GridDrawCell(Sender: TObject; aCol, 
  aRow: Integer; aRect: TRect; aState: TGridDrawState);
var
  s: String;
  R: TRect;
begin
  R := ARect;
  if (ACol = 0) and (ARow = 0) then
    Grid.DrawCellCheckboxBitmaps(aCol, aRow, R)
  else
  begin
    InflateRect(R, -varCellPadding, - varCellPadding);
    s := GetCellText(ACol, ARow);
    Grid.Canvas.TextRect(R, R.Left, R.Top, s);
  end;
end;

procedure TVpImportPreviewForm.FormShow(Sender: TObject);
var
  col: TGridColumn;
begin
  col := Grid.Columns[Grid.Columns.Count-1];
  col.Width := Grid.Canvas.TextWidth(col.Title.Caption) + 4*varCellPadding;
end;

procedure TVpImportPreviewForm.GridGetCheckboxState(Sender: TObject; ACol, 
  ARow: Integer; var Value: TCheckboxState);
begin
  if (ARow = 0) and (ACol = 0) then
    Value := FCol0CheckState
  else
  if ARow >= Grid.FixedRows then
  begin
    if IsChecked(ARow) then 
      Value := cbChecked
    else
      Value := cbUnChecked;
  end;
end;

procedure TVpImportPreviewForm.GridPrepareCanvas(sender: TObject; aCol, 
  aRow: Integer; aState: TGridDrawState);
var
  ts: TTextStyle;
begin
  if ACol = 1 then
  begin
    ts := Grid.Canvas.TextStyle;
    ts.SingleLine := false;
    ts.EndEllipsis := true;
    Grid.Canvas.TextStyle := ts;
  end;
end;

procedure TVpImportPreviewForm.GridSetCheckboxState(Sender: TObject; ACol, 
  ARow: Integer; const Value: TCheckboxState);
var
  r: Integer;
begin
  if (ARow = 0) and (ACol = 0) then
  begin
    FCol0CheckState := Value;
    if Value <> cbGrayed then
      for r := Grid.FixedRows to Grid.RowCount-1 do
        CheckItem(r, Value = cbChecked);
    Grid.Invalidate;
  end
  else
  if ARow >= Grid.FixedRows then
  begin
    CheckItem(ARow, Value = cbChecked);
    Grid.Invalidate;
  end;
end;

{ Returns that the item in the given row should be included in the import process. 
  To be overridden by ancestors. }
function TVpImportPreviewForm.IsChecked(ARow: Integer): Boolean;
begin
  Result := false;
end;

{ Must be overridden to add the items to be imported from the external list to
  the internal list FList.
  Must call inherited at the end to set the grid's RowCount and row heights. }
procedure TVpImportPreviewForm.PrepareItems;
begin
  // populate FList here...
  Grid.RowCount := Grid.FixedRows + FItems.Count;
  CalcRowHeights;
end;

procedure TVpImportPreviewForm.SetDatastore(const AValue: TVpCustomDatastore);
begin
  if AValue <> FDatastore then
  begin
    FDatastore := AValue;
    PrepareItems;
  end;
end;

end.