lazarus/examples/database/sqlite_mushrooms/unit1.pas

unit Unit1;
// J.P  August 2013
{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LR_Class, LR_DBSet, Forms, Controls, Graphics,
  Dialogs, DbCtrls, Buttons, ExtCtrls, StdCtrls, DBGrids,
  db, sqldb, sqlite3conn, Grids;

type

  { TForm1 }

  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    Button1: TButton;
    Bt_Print: TButton;
    Datasource1: TDatasource;
    DBEdit1: TDBEdit;
    DBGrid1: TDBGrid;
    DBImage1: TDBImage;
    DBMemo1: TDBMemo;
    DBNavigator1: TDBNavigator;
    DBText1: TDBText;
    frDBDataSet1: TfrDBDataSet;
    frReport1: TfrReport;
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    OpenDialog1: TOpenDialog;
    Panel1: TPanel;
    Panel2: TPanel;
    SQLite3Connection1: TSQLite3Connection;
    SQLQuery1: TSQLQuery;
    SQLTransaction1: TSQLTransaction;
    procedure Button1Click(Sender: TObject);
    procedure Bt_PrintClick(Sender: TObject);
    procedure Datasource1DataChange(Sender: TObject; Field: TField);
    procedure DBGrid1PrepareCanvas(sender: TObject; DataCol: Integer;
      Column: TColumn; AState: TGridDrawState);
    procedure DBImage1DblClick(Sender: TObject);
    procedure DBNavigator1BeforeAction(Sender: TObject; Button: TDBNavButtonType
      );
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure frReport1EnterRect(Memo: TStringList; View: TfrView);
  private
    { private declarations }
    procedure UpdateImageLink;
    procedure ChangeImage;
    procedure LoadDbImage(aFileName: string);
    function RecreateDB: boolean;
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
begin
  ChangeImage;
end;

procedure TForm1.Bt_PrintClick(Sender: TObject);
begin
  frReport1.LoadFromFile(ExtractFilePath(application.ExeName) +
    'Mushroom_Report.lrf');
  frReport1.ShowReport();
end;

procedure TForm1.Datasource1DataChange(Sender: TObject; Field: TField);
begin
  if Field=nil then
    UpdateImageLink;
end;

procedure TForm1.DBGrid1PrepareCanvas(sender: TObject; DataCol: Integer;
  Column: TColumn; AState: TGridDrawState);
  var MyTextStyle: TTextStyle;
begin
  if (DataCol =5) then
  begin
    MyTextStyle := DbGrid1.Canvas.TextStyle;
    MyTextStyle.SingleLine := false;
    DbGrid1.Canvas.TextStyle := MyTextStyle;
  end;
end;

procedure TForm1.DBImage1DblClick(Sender: TObject);
begin
  ChangeImage;
end;

procedure TForm1.DBNavigator1BeforeAction(Sender: TObject;
  Button: TDBNavButtonType);
begin
  if Button = nbRefresh then
  begin
   SQLQuery1.ApplyUpdates;
   SQLTransaction1.CommitRetaining;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  SQLQuery1.ApplyUpdates;
  SQLTransaction1.Commit;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SQLQuery1.Close;
  SQLite3Connection1.DatabaseName:= ExtractFilePath(ParamStr(0)) + 'ImageTest.db3';
  try
    SQLQuery1.Active := true;
  except
    on E:Exception do begin
      //WriteLn(E.ClassName,': '+E.Message);
      if RecreateDb then begin
        SQLQuery1.Active := true;
        ShowMessage('The database has been recreated');
      end;
    end;
  end;
end;

procedure TForm1.frReport1EnterRect(Memo: TStringList; View: TfrView);
begin
   if  (View.Name = 'Picture2') AND
   (frDBDataSet1.DataSet.FieldByName('Image_Link').AsString <> '') then
    TFrPictureView(View).Picture.LoadFromFile(ExtractFilePath(ParamStr(0)) +
  'images' +  DirectorySeparator +  frDBDataSet1.DataSet.FieldByName('Image_Link').AsString);
end;

procedure TForm1.UpdateImageLink;
var
  s: String;
begin
  if   DBEdit1.Text <> '' then begin
    s := ExtractFilePath(ParamStr(0)) + 'images' +  DirectorySeparator +  DBEdit1.Text;
    Image1.Picture.LoadFromFile(s);
  end else
    Image1.Picture.Clear;
end;

procedure TForm1.ChangeImage;
var
  WasEditing: Boolean;
begin
  if SQLQuery1.Active then begin
    OpenDialog1.Filter :=
    'All image files (*.bmp,*.jpg,*.png,*.gif)|*.bmp;*.jpg;*.png;*.gif|' +
    'BMP files (*.bmp)|*.bmp|' +
    'JPEG files (*.jpg)|*.jpg|' +
    'PNG files (*.png)|*.png|' +
    'GIF files (*.gif)|*.gif';
    OpenDialog1.InitialDir := ExtractFilePath(ParamStr(0)) + 'images';
    if OpenDialog1.Execute then begin
      WasEditing := (SQLQuery1.State = dsEdit);
      if not WasEditing then
        SQLQuery1.Edit;
      DBEdit1.Text := ExtractFileName(OpenDialog1.FileName);
      LoadDbImage(OpenDialog1.FileName);
      if not WasEditing then
        SQLQuery1.Post;
    end;
  end;
end;

procedure TForm1.LoadDbImage(aFileName: string);
begin
  DbImage1.WriteHeader:=false;
  DbImage1.Picture.LoadFromFile(aFileName);
end;

function TForm1.RecreateDB: boolean;
begin
  try
    SQLite3Connection1.ExecuteDirect(
    'CREATE TABLE DeadlyMushrooms '+LineEnding+
    '-- This table created by Jurassic Pork '+LineEnding+
    '-- for Free Pascal Lazarus '+LineEnding+
    '-- Create date:2013-08-05 23:55:09 '+LineEnding+
    '( '+LineEnding+
    '       ID INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, '+LineEnding+
    '       Scientific_Name VARCHAR NOT NULL, '+LineEnding+
    '       Common_Name VARCHAR, '+LineEnding+
    '       `Order`  VARCHAR, `Genus`  VARCHAR, `Notes`  TEXT, `Picture`  BLOB, `Image_Link`  VARCHAR)'
    );
    result := true;
  except
    result := false;
  end;
end;


end.