unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Graphics, dbf, db, Forms, StdCtrls, ExtCtrls, ComCtrls,
Grids;
type
{ TForm1 }
TForm1 = class(TForm)
btnOpen: TButton;
btnSearch: TButton;
DataSource1: TDataSource;
Dbf1: TDbf;
Label1: TLabel;
LabeledEdit1: TLabeledEdit;
RadioGroup1: TRadioGroup;
StatusBar1: TStatusBar;
StringGrid1: TStringGrid;
procedure btnOpenClick(Sender: TObject);
procedure btnSearchClick(Sender: TObject);
procedure StringGrid1Click(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 + 1;
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] := IntToStr(Dbf1.RecNo);
for i := 0 to (Dbf1.FieldCount-1) do
StringGrid1.Cells[i+1, Dbf1.RecNo] := Dbf1.Fields[i].AsString;
Dbf1.Next;
end;
// Close the database
Dbf1.Close;
StringGrid1.Enabled := True;
btnOpen.Enabled := False;
Label1.Visible := True;
Height := 380;
StringGrid1Click(Sender); // Show row:column info and paint header color
end;
procedure TForm1.btnSearchClick(Sender: TObject);
var
c, r: Integer;
begin
// Abort search if user does not provide text to search
if (LabeledEdit1.Text = '') then
begin
StatusBar1.SimpleText := ' Error, please provide search text.';
Exit;
end;
// Search items in a column
if (RadioGroup1.ItemIndex = 0) then
begin
SetLength(Results, 0);
for r := 0 to (StringGrid1.RowCount-1) do
begin
if Pos(LabeledEdit1.Text, StringGrid1.Cells[StringGrid1.Col, r]) > 0 then
begin
SetLength(Results, Length(Results)+1);
Results[High(Results)].Col := StringGrid1.Col;
Results[High(Results)].Row := r;
end;
end;
StringGrid1.Repaint;
StatusBar1.SimpleText :=
' Search result: ' + IntToStr(Length(Results)) + ' item(s).';;
end;
// Search all
if (RadioGroup1.ItemIndex = 1) then
begin
SetLength(Results, 0);
for c := 0 to (StringGrid1.Columns.Count-1) do
for r := 0 to (StringGrid1.RowCount-1) do
begin
if Pos(LabeledEdit1.Text, 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;
StatusBar1.SimpleText :=
' Search result: ' + IntToStr(Length(Results)) + ' item(s).';;
end;
end;
procedure TForm1.StringGrid1Click(Sender: TObject);
var
i: Integer;
begin
// Show StringGrid's row:column position
Label1.Caption := IntToStr(StringGrid1.Row) +':'+ IntToStr(StringGrid1.Col);
// Change StringGrid header color
for i := 0 to (StringGrid1.Columns.Count-1) do
if (i = StringGrid1.Col-1) then
StringGrid1.Columns[i].Title.Font.Color := clRed
else
StringGrid1.Columns[i].Title.Font.Color := clBlack;
// Change info in search method option
RadioGroup1.Items[0] := StringGrid1.Columns[StringGrid1.Col-1].Title.Caption;
end;
procedure TForm1.StringGrid1PrepareCanvas(sender: TObject; aCol, aRow: Integer;
aState: TGridDrawState);
var
i: Integer;
begin
if not(sender is TStringGrid) then Exit;
// Paint the background yellow for the results
for i := Low(Results) to High(Results) do
if (Results[i].Col = aCol) and (Results[i].Row = aRow) then
(sender as TStringGrid).Canvas.Brush.Color := clYellow;
end;
end.
Recent
