lazarus/examples/database/sqlite_mushrooms/unit1.pas
2014-01-22 20:39:40 +00:00

209 lines
5.3 KiB
ObjectPascal

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.