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.