{ 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 } TfpgCustomStringGrid = class(TfpgCustomGrid) private function GetCell(ACol, ARow: Integer): string; function GetColumnAlignment(ACol: Integer): TAlignment; function GetColumnTitle(ACol: Integer): string; function GetObjects(ACol, ARow: Integer): TObject; procedure SetCell(ACol, ARow: Integer; const AValue: string); procedure SetColumnAlignment(ACol: Integer; const AValue: TAlignment); 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; procedure DoAfterAddColumn(ACol: 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 ColumnAlignment[ACol: Integer]: TAlignment read GetColumnAlignment write SetColumnAlignment; property ColumnBackgroundColor; property ColumnTextColor; // 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 Options; property ParentShowHint; property RowCount; property RowSelect; property ScrollBarStyle; property ShowGrid; property ShowHeader; property ShowHint; property TabOrder; property TopRow; property VisibleRows; 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 if e.EntryType = etDir then s := '' else 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.GetColumnAlignment(ACol: Integer): TAlignment; begin if ACol > ColumnCount-1 then Exit; //==> Result := TfpgStringColumn(FColumns.Items[ACol]).Alignment; 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.SetColumnAlignment(ACol: Integer; const AValue: TAlignment); begin if ACol > ColumnCount-1 then Exit; //==> BeginUpdate; TfpgStringColumn(FColumns.Items[ACol]).Alignment := AValue; EndUpdate; 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; procedure TfpgCustomStringGrid.DoAfterAddColumn(ACol: integer); var r: integer; begin inherited DoAfterAddColumn(ACol); // initialize cells for existing rows for r := 0 to RowCount-1 do TfpgStringColumn(FColumns.Items[ACol]).Cells.Append(''); end; function TfpgCustomStringGrid.DoCreateColumnClass: TfpgStringColumn; begin Result := TfpgStringColumn.Create; end; procedure TfpgCustomStringGrid.DrawCell(ARow, ACol: Integer; ARect: TfpgRect; AFlags: TfpgGridDrawState); var Flags: TFTextFlags; txt: string; begin if Cells[ACol, ARow] <> '' then begin txt := Cells[ACol, ARow]; Flags:= []; if not Enabled then Include(Flags,txtDisabled); case Columns[ACol].Alignment of taLeftJustify: Include(Flags,txtLeft); taCenter: Include(Flags,txtHCenter); taRightJustify: Include(Flags,txtRight); end; { case } case Columns[ACol].Layout of tlTop: Include(Flags,txtTop); tlCenter: Include(Flags,txtVCenter); tlBottom: Include(Flags,txtBottom); end; { case } with ARect,Columns[ACol] do Canvas.DrawText(Left+HMargin,Top,Right-Left-HMargin,Bottom-Top, txt, Flags); 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; 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; if UpdateCount = 0 then Updated; // if we called .BeginUpdate then don't clear csUpdating here end; end.