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

unit VpImportPreview;

{$mode objfpc}{$H+}

interface

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

type
  { TVpImportPreviewForm }

  TVpImportPreviewForm = class(TForm)
    btnExecute: TButton;
    btnCancel: TButton;
    Grid: TDrawGrid;
    ButtonPanel: TPanel;
    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
    
  protected
    FItems: TFPList;
    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;

  end;

var
  VpImportPreviewForm: TVpImportPreviewForm;

implementation

{$R *.lfm}

uses
  LCLIntf, LCLType;

{ TVpImportPreviewForm }

constructor TVpImportPreviewForm.Create(AOwner: TComponent);
begin
  inherited;
  Grid.Options := Grid.Options + [goEditing, goRowSelect, goThumbTracking];
  FItems := TFPList.Create;
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);
begin
  //
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;
  InflateRect(R, -varCellPadding, - varCellPadding);
  s := GetCellText(ACol, ARow);
  Grid.Canvas.TextRect(R, R.Left, R.Top, s);
end;

procedure TVpImportPreviewForm.GridGetCheckboxState(Sender: TObject; ACol, 
  ARow: Integer; var Value: TCheckboxState);
begin
  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);
begin
  if ARow >= Grid.FixedRows then
    CheckItem(ARow, Value = cbChecked);
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;

end.