{ fpGUI - Free Pascal GUI Toolkit Copyright (C) 2006 - 2008 See the file AUTHORS.txt, included in this distribution, for details of the copyright. See the file COPYING.modifiedLGPL, included in this distribution, for details about redistributing fpGUI. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. Description: Defines a File Grid and String Grid. Both are decendants of Custom Grid. } unit gui_grid; {$mode objfpc}{$H+} { TODO: * TCustomStringGrid: Col[] and Row[] properties need to be implemented, returning a TStrings with all related text inserted. * File Grid: Introduce support for images based on file types. User must be able to override the default images with their own. * Remove the usage of libc unit. libc is linux/x86 specific. } interface uses Classes, SysUtils, gfxbase, fpgfx, gui_basegrid, gui_customgrid; type TfpgFileGrid = class(TfpgCustomGrid) private FFileList: TfpgFileList; FFixedFont: TfpgFont; protected function GetRowCount: Integer; override; procedure DrawCell(ARow, ACol: Integer; ARect: TfpgRect; AFlags: TfpgGridDrawState); override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function CurrentEntry: TFileEntry; property FixedFont: TfpgFont read FFixedFont; property FileList: TfpgFileList read FFileList; property DefaultRowHeight; property Font; property HeaderFont; published property FontDesc; property HeaderFontDesc; property RowCount; property ColumnCount; property Columns; property FocusRow; property ScrollBarStyle; property TabOrder; property OnRowChange; property OnDoubleClick; end; TfpgStringColumn = class(TfpgGridColumn) private FCells: TStringList; public constructor Create; override; destructor Destroy; override; property Cells: TStringList read FCells write FCells; end; TfpgCustomStringGrid = class(TfpgCustomGrid) private function GetCell(ACol, ARow: Integer): string; function GetColumnTitle(ACol: Integer): string; function GetObjects(ACol, ARow: Integer): TObject; procedure SetCell(ACol, ARow: Integer; const AValue: string); procedure SetColumnTitle(ACol: Integer; const AValue: string); procedure SetObjects(ACol, ARow: Integer; const AValue: TObject); protected function GetColumnWidth(ACol: Integer): integer; override; procedure SetColumnWidth(ACol: Integer; const AValue: integer); override; function GetColumns(AIndex: Integer): TfpgStringColumn; reintroduce; procedure DoDeleteColumn(ACol: integer); override; procedure DoSetRowCount(AValue: integer); override; function DoCreateColumnClass: TfpgStringColumn; reintroduce; override; procedure DrawCell(ARow, ACol: Integer; ARect: TfpgRect; AFlags: TfpgGridDrawState); override; property Columns[AIndex: Integer]: TfpgStringColumn read GetColumns; public constructor Create(AOwner: TComponent); override; function AddColumn(ATitle: string; AWidth: integer; AAlignment: TAlignment = taLeftJustify; AbackgroundColor: TfpgColor = clDefault; ATextColor: TfpgColor = clDefault): TfpgStringColumn; overload; property Cells[ACol, ARow: Integer]: string read GetCell write SetCell; property Objects[ACol, ARow: Integer]: TObject read GetObjects write SetObjects; property ColumnTitle[ACol: Integer]: string read GetColumnTitle write SetColumnTitle; property ColumnWidth[ACol: Integer]: integer read GetColumnWidth write SetColumnWidth; property ColumnBackgroundColor[ACol: Integer]: TfpgColor read GetColumnBackgroundColor write SetColumnBackgroundColor; property ColumnTextColor[ACol: Integer]: TfpgColor read GetColumnTextColor write SetColumnTextColor; // property Cols[index: Integer]: TStrings read GetCols write SetCols; // property Rows[index: Integer]: TStrings read GetRows write SetRows; end; TfpgStringGrid = class(TfpgCustomStringGrid) published property BackgroundColor; // property ColResizing; property ColumnCount; property Columns; property ColumnWidth; property DefaultColWidth; property DefaultRowHeight; property FocusCol; property FocusRow; property FontDesc; property HeaderFontDesc; property HeaderHeight; property RowCount; property RowSelect; property ScrollBarStyle; property ShowGrid; property ShowHeader; property TabOrder; property TopRow; property OnCanSelectCell; property OnDrawCell; property OnDoubleClick; property OnFocusChange; property OnKeyPress; property OnRowChange; end; function CreateStringGrid(AOwner: TComponent; x, y, w, h: TfpgCoord; AColumnCount: integer = 0): TfpgStringGrid; implementation uses gfx_constants; function CreateStringGrid(AOwner: TComponent; x, y, w, h: TfpgCoord; AColumnCount: integer = 0): TfpgStringGrid; begin Result := TfpgStringGrid.Create(AOwner); Result.Left := x; Result.Top := y; Result.Width := w; Result.Height := h; Result.ColumnCount := AColumnCount; end; { TfpgFileGrid } function TfpgFileGrid.GetRowCount: Integer; begin Result := FFileList.Count; end; procedure TfpgFileGrid.DrawCell(ARow, ACol: Integer; ARect: TfpgRect; AFlags: TfpgGridDrawState); const picture_width = 20; var e: TFileEntry; x: integer; y: integer; s: string; img: TfpgImage; begin e := FFileList.Entry[ARow]; if e = nil then Exit; //==> x := ARect.Left + 2; y := ARect.Top;// + 1; s := ''; if (e.EntryType = etDir) and (ACol = 0) then Canvas.SetFont(HeaderFont) else Canvas.SetFont(Font); case ACol of 0: begin if e.EntryType = etDir then img := fpgImages.GetImage('stdimg.folder') // Do NOT localize else if e.IsExecutable then img := fpgImages.GetImage('stdimg.executable') // Do NOT localize else img := fpgImages.GetImage('stdimg.document'); // Do NOT localize if img <> nil then Canvas.DrawImage(ARect.Left + (picture_width - img.Width) div 2, y + (ARect.Height - img.Height) div 2, img); if e.IsLink then // paint shortcut link symbol over existing image Canvas.DrawImage(ARect.Left+1, ARect.Top+1, fpgImages.GetImage('stdimg.link')); x := ARect.Left + picture_width; s := e.Name; end; 1: begin s := FormatFloat('###,###,###,##0', e.size); x := ARect.Right - Font.TextWidth(s) - 1; if x < (ARect.Left + 2) then x := ARect.Left + 2; end; 2: s := FormatDateTime('yyyy-mm-dd hh:nn', e.ModTime); 3: begin if FFileList.HasFileMode then // on unix s := e.Mode else // on windows s := e.Attributes; Canvas.SetFont(FixedFont); end; end; if FFileList.HasFileMode then // unix case ACol of 4: s := e.Owner; 5: s := e.Group; end; // centre text in row height y := y + ((DefaultRowHeight - Canvas.Font.Height) div 2); Canvas.DrawString(x, y, s); end; constructor TfpgFileGrid.Create(AOwner: TComponent); begin FFileList := TfpgFileList.Create; inherited Create(AOwner); ColumnCount := 0; RowCount := 0; FFixedFont := fpgGetFont('Courier New-9'); if FFileList.HasFileMode then AddColumn(rsName, 220) // save space for file mode, owner and group else AddColumn(rsName, 320); // more space to filename AddColumn(rsSize, 80); AddColumn(rsFileModifiedTime, 108); if FFileList.HasFileMode then begin AddColumn(rsFileRights, 78); AddColumn(rsFileOwner, 54); AddColumn(rsFileGroup, 54); end else AddColumn(rsFileAttributes, 78); RowSelect := True; DefaultRowHeight := fpgImages.GetImage('stdimg.document').Height + 2; end; destructor TfpgFileGrid.Destroy; begin OnRowChange := nil; FFixedFont.Free; FFileList.Free; inherited Destroy; end; function TfpgFileGrid.CurrentEntry: TFileEntry; begin Result := FFileList.Entry[FocusRow]; end; { TfpgStringColumn } constructor TfpgStringColumn.Create; begin inherited Create; FCells := TStringList.Create; end; destructor TfpgStringColumn.Destroy; begin FCells.Free; inherited Destroy; end; { TfpgCustomStringGrid } function TfpgCustomStringGrid.GetCell(ACol, ARow: Integer): string; begin if ACol > ColumnCount-1 then Exit; //==> if ARow > RowCount-1 then Exit; //==> Result := TfpgStringColumn(FColumns.Items[ACol]).Cells[ARow]; end; function TfpgCustomStringGrid.GetColumnTitle(ACol: Integer): string; begin if ACol > ColumnCount-1 then Exit; //==> Result := TfpgStringColumn(FColumns.Items[ACol]).Title; end; function TfpgCustomStringGrid.GetObjects(ACol, ARow: Integer): TObject; begin if ACol > ColumnCount-1 then Exit; //==> if ARow > RowCount-1 then Exit; //==> Result := TfpgStringColumn(FColumns.Items[ACol]).Cells.Objects[ARow]; end; function TfpgCustomStringGrid.GetColumnWidth(ACol: Integer): integer; begin if ACol > ColumnCount-1 then Exit; //==> Result := TfpgStringColumn(FColumns.Items[ACol]).Width; end; procedure TfpgCustomStringGrid.SetCell(ACol, ARow: Integer; const AValue: string); begin if ACol > ColumnCount-1 then Exit; //==> if ARow > RowCount-1 then Exit; //==> if TfpgStringColumn(FColumns.Items[ACol]).Cells[ARow] <> AValue then begin BeginUpdate; TfpgStringColumn(FColumns.Items[ACol]).Cells[ARow] := AValue; EndUpdate; end; end; procedure TfpgCustomStringGrid.SetColumnTitle(ACol: Integer; const AValue: string); begin if ACol > ColumnCount-1 then Exit; //==> BeginUpdate; TfpgStringColumn(FColumns.Items[ACol]).Title := AValue; EndUpdate; end; procedure TfpgCustomStringGrid.SetObjects(ACol, ARow: Integer; const AValue: TObject); begin if ACol > ColumnCount-1 then Exit; //==> if ARow > RowCount-1 then Exit; //==> TfpgStringColumn(FColumns.Items[ACol]).Cells.Objects[ARow] := AValue; end; procedure TfpgCustomStringGrid.SetColumnWidth(ACol: Integer; const AValue: integer); begin if ACol > ColumnCount-1 then Exit; //==> BeginUpdate; TfpgStringColumn(FColumns.Items[ACol]).Width := AValue; EndUpdate; end; function TfpgCustomStringGrid.GetColumns(AIndex: Integer): TfpgStringColumn; begin if (AIndex < 0) or (AIndex > ColumnCount-1) then Result := nil else Result := TfpgStringColumn(FColumns.Items[AIndex]); end; procedure TfpgCustomStringGrid.DoDeleteColumn(ACol: integer); begin TfpgStringColumn(FColumns.Items[ACol]).Free; FColumns.Delete(ACol); end; procedure TfpgCustomStringGrid.DoSetRowCount(AValue: integer); var diff: integer; c: integer; begin inherited DoSetRowCount(AValue); if FColumns.Count = 0 then Exit; //==> diff := AValue - TfpgStringColumn(FColumns.Items[0]).Cells.Count; if diff > 0 then // We need to add rows begin for c := 0 to FColumns.Count - 1 do begin while TfpgStringColumn(FColumns[c]).Cells.Count <> AValue do TfpgStringColumn(FColumns[c]).Cells.Append(''); end; end; end; function TfpgCustomStringGrid.DoCreateColumnClass: TfpgStringColumn; begin Result := TfpgStringColumn.Create; end; procedure TfpgCustomStringGrid.DrawCell(ARow, ACol: Integer; ARect: TfpgRect; AFlags: TfpgGridDrawState); var x: TfpgCoord; begin if Cells[ACol, ARow] <> '' then begin if not Enabled then Canvas.SetTextColor(clShadow1); case Columns[ACol].Alignment of taLeftJustify: begin x := ARect.Left + 1; end; taCenter: begin x := (ARect.Width - Font.TextWidth(Cells[ACol, ARow])) div 2; Inc(x, ARect.Left); end; taRightJustify: begin x := ARect.Right - Font.TextWidth(Cells[ACol, ARow]) - 1; if x < (ARect.Left + 1) then x := ARect.Left + 1; end; end; { case } Canvas.DrawString(x, ARect.Top+1, Cells[ACol, ARow]); end; end; constructor TfpgCustomStringGrid.Create(AOwner: TComponent); begin inherited Create(AOwner); ColumnCount := 0; RowCount := 0; end; function TfpgCustomStringGrid.AddColumn(ATitle: string; AWidth: integer; AAlignment: TAlignment; ABackgroundColor: TfpgColor; ATextColor: TfpgColor): TfpgStringColumn; var r: integer; begin Updating; Result := TfpgStringColumn(inherited AddColumn(ATitle, AWidth)); Result.Alignment := AAlignment; if ABackgroundColor = clDefault then Result.BackgroundColor := clBoxColor else Result.BackgroundColor:= ABackgroundColor; if ATextColor = clDefault then Result.TextColor := TextColor else Result.TextColor:= ATextColor; for r := 0 to RowCount-1 do Result.Cells.Append(''); if UpdateCount = 0 then Updated; // if we called .BeginUpdate then don't clear csUpdating here end; end.