unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Graphics, dbf, db, Forms, StdCtrls, ExtCtrls, ComCtrls,
Grids, Dialogs;
type
{ TForm1 }
TForm1 = class(TForm)
btnOpen: TButton;
DataSource1: TDataSource;
Dbf1: TDbf;
Label1: TLabel;
StringGrid1: TStringGrid;
procedure btnOpenClick(Sender: TObject);
procedure StringGrid1Click(Sender: TObject);
procedure StringGrid1EditingDone(Sender: TObject);
procedure StringGrid1PrepareCanvas(sender: TObject; aCol, aRow: Integer;
aState: TGridDrawState);
end;
const
DataFileName = 'MyData.dbf';
type
TPosition = record
Col: Integer;
Row: Integer
end;
var
Form1: TForm1;
Results: array of TPosition;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.btnOpenClick(Sender: TObject);
var
i: Integer;
begin
// Open the database
Dbf1.FilePathFull := ExtractFileDir(ParamStr(0));
Dbf1.TableName := DataFileName;
Dbf1.Open;
// Set StringGrid's row and column
StringGrid1.RowCount := Dbf1.RecordCount + 2; // +2 because it includes header and search row
for i := 1 to Dbf1.FieldCount do
begin
StringGrid1.Columns.Add;
StringGrid1.Columns[i-1].Title.Caption := Dbf1.FieldDefs[i-1].Name;
StringGrid1.Columns[i-1].Title.Alignment := taCenter;
StringGrid1.Columns[i-1].Title.Font.Style := [fsBold];
StringGrid1.Columns[i-1].Width := 120;
end;
// Load data to StringGrid
Dbf1.First;
while not(Dbf1.EOF) do
begin
StringGrid1.Cells[0, Dbf1.RecNo+1] := IntToStr(Dbf1.RecNo);
for i := 0 to (Dbf1.FieldCount-1) do
StringGrid1.Cells[i+1, Dbf1.RecNo+1] := Dbf1.Fields[i].AsString;
Dbf1.Next;
end;
// Close the database
Dbf1.Close;
StringGrid1.Enabled := True;
StringGrid1.AutoAdvance := aaNone; // Disable it to prevent problem
btnOpen.Enabled := False;
Label1.Visible := True;
StringGrid1Click(Sender); // Show row:column info
end;
procedure TForm1.StringGrid1Click(Sender: TObject);
var
ActiveRow, ActiveCol: Integer;
i: Integer;
begin
ActiveRow := StringGrid1.Row;
ActiveCol := StringGrid1.Col;
// Allow editing on first row
if (ActiveRow = 1) then
StringGrid1.Options := StringGrid1.Options+[goAlwaysShowEditor, goEditing]
else
StringGrid1.Options := StringGrid1.Options-[goAlwaysShowEditor, goEditing];
// Show row:column information
Label1.Caption := 'R:C = ' + IntToStr(ActiveRow-1) +':'+ IntToStr(ActiveCol);
// Change selected column's header text color
for i := 0 to (StringGrid1.Columns.Count-1) do
if (i = StringGrid1.Col-1) then
StringGrid1.Columns[i].Title.Font.Color := clWhite
else
StringGrid1.Columns[i].Title.Font.Color := clBlack;
end;
// Use OnEditingDone to do searching
procedure TForm1.StringGrid1EditingDone(Sender: TObject);
var
SearchText: string;
c, r: Integer;
begin
SetLength(Results, 0);
for c := 1 to StringGrid1.Columns.Count do
begin
SearchText := StringGrid1.Cells[c, 1];
if (SearchText <> '') then
begin
for r := 2 to (StringGrid1.RowCount-1) do
begin
if Pos(SearchText, StringGrid1.Cells[c, r]) > 0 then
begin
SetLength(Results, Length(Results)+1);
Results[High(Results)].Col := c;
Results[High(Results)].Row := r;
end;
end;
StringGrid1.Repaint;
end;
end;
end;
procedure TForm1.StringGrid1PrepareCanvas(sender: TObject; aCol, aRow: Integer;
aState: TGridDrawState);
var
i: Integer;
begin
if not(sender is TStringGrid) then Exit;
// Background of the search row is moneygreen
if (aRow = 1) and (aCol > 0) then
(sender as TStringGrid).Canvas.Brush.Color := clMoneyGreen;
// If search cell has text, change the cell color to red
if (aRow = 1) and (StringGrid1.Cells[aCol, aRow] <> '') then
(sender as TStringGrid).Canvas.Brush.Color := clAqua;
// Highlight selected column's header with green
if (aRow = 0) and (aCol = StringGrid1.Col) then
(sender as TStringGrid).Canvas.Brush.Color := clGreen;
// Background of search result cells is yellow
for i := Low(Results) to High(Results) do
if (Results[i].Col = aCol) and (Results[i].Row = aRow) then
begin
(sender as TStringGrid).Canvas.Brush.Color := clYellow;
Exit; // Exit immediately after found, to improve performance
end;
end;
end.