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.