disqlite3_image_bitmap_fmain.pas

来自「DELPHI 访问SQLITE3 数据库的VCL控件」· PAS 代码 · 共 309 行

{ This DISQLite3 example project shows how to display bitmap images stored in
  a database. It also demonstrates simple filter technique with SQL LIKE.

  This demo was asked for by a user who wanted to read and display bitmap
  images with DISQLite3. It is meant to help understand basic Database
  operations and therefore intentionally kept simple.

  The database component is created at runtime to avoid problems if the
  DISQLite3 components are not installed into the IDE.

  Even though this project uses WideStrings as much as possible, the Delphi VCL
  limits text display to AnsiStrings only. WideString VCL extensions are
  available for download from the Internet if required.

  Visit the DISQLite3 Internet site for latest information and updates:

    http://www.yunqa.de/delphi/

  Copyright (c) 2007 Ralf Junker, The Delphi Inspiration <[e-mail]>

------------------------------------------------------------------------------ }

unit DISQLite3_Image_Bitmap_fMain;

interface

uses
  Classes, Controls, Forms, StdCtrls, ExtCtrls, Grids,
  DISQLite3Database;

type
  TfrmImageBitmap = class(TForm)
    pnlLeft: TPanel;
    btnOpenDatabase: TButton;
    btnFirst: TButton;
    btnSetFilter: TButton;
    btnNext: TButton;
    btnCloseDatabase: TButton;
    pnlRight: TPanel;
    lblCountry: TLabel;
    lblArea: TLabel;
    lblPopulation: TLabel;
    lblBackground: TLabel;
    lblBirthRate: TLabel;
    lblLifeExpectancy: TLabel;
    edtName: TEdit;
    edtArea: TEdit;
    edtPopulation: TEdit;
    edtBirthRate: TEdit;
    edtLifeExpectancy: TEdit;
    edtBackground: TMemo;
    imgFlag: TImage;
    edtFilterExpression: TEdit;
    lblFilterExpression: TLabel;
    btnRemoveFilter: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnOpenDatabase_Click(Sender: TObject);
    procedure btnFirst_Click(Sender: TObject);
    procedure btnNextClick(Sender: TObject);
    procedure edtFilterExpressionKeyPress(Sender: TObject; var Key: Char);
    procedure btnSetFilterClick(Sender: TObject);
    procedure btnRemoveFilterClick(Sender: TObject);
    procedure btnCloseDatabase_Click(Sender: TObject);
  private
    FDatabase: TDISQLite3Database;
    FStatement: TDISQLite3Statement;
    procedure PrepareStatement(const AFilter: WideString = '');
    procedure GotoFirst;
    procedure GotoNext;
    procedure PopulateControls;
    procedure ClearControls;
  end;

const
  APP_TITLE = 'DISQLite3 Demo: Image Bitmap';

var
  frmImageBitmap: TfrmImageBitmap;

implementation

uses
  SysUtils, Graphics,
  DISQLite3Api;

{$R *.dfm}

//------------------------------------------------------------------------------

procedure TfrmImageBitmap.FormCreate(Sender: TObject);
begin
  Caption := APP_TITLE;
  { Create a new database object and specify the file name. }
  FDatabase := TDISQLite3Database.Create(nil);
  FDatabase.DatabaseName := '..\World.db3';

  PrepareStatement;
end;

//------------------------------------------------------------------------------

procedure TfrmImageBitmap.FormDestroy(Sender: TObject);
begin
  { Since we have created the database and statement objects in code,
    we need to free them when the form destroys. }
  FStatement.Free;
  FDatabase.Free;
end;

//------------------------------------------------------------------------------

procedure TfrmImageBitmap.GotoFirst;
begin
  { Move the statement to the first record is a simple two-step process:
      * Reset the statement.
      * Step to the next record (which will be the first). }
  FStatement.Reset;
  btnNext.Enabled := True;
  GotoNext;
end;

//------------------------------------------------------------------------------

procedure TfrmImageBitmap.GotoNext;
begin
  { Move to the next database record ... }
  case FStatement.Step of
    SQLITE_ROW: { ... and fill the controls if it is available. }
      begin
        PopulateControls;
      end;
    SQLITE_DONE: { ... or disable the "Next" button if the end is reached. }
      begin
        btnNext.Enabled := False;
      end;
  end;
end;

//------------------------------------------------------------------------------

{ Prepares a new statement and optionally sets a filter expression on the
  country name. }
procedure TfrmImageBitmap.PrepareStatement(const AFilter: WideString = '');
const
  { The unfiltered statement is a very simple SQL select. }
  SQL_Unfiltered = 'SELECT * FROM Countries ORDER BY Name COLLATE NoCase;';
  { The filtered SQL adds a WHERE clause which tests if the name is LIKE the
    filter expression. The two pipes '||' are string concatenation in SQL, just
    as '+' is in Pascal. They add a '%' wildcard before and after the filter
    expression. For the 'United' filter expression, this is equal to:

      SELECT * FROM Countries WHERE Name LIKE '%United%' ORDER BY ...

    LIKE is the SQL wildcard function, except that the percent sign '%'
    replaces the DOS asterisk '*' and the underscore '_' the questionmark '?'. }
  SQL_Filtered = 'SELECT * FROM Countries WHERE Name LIKE ''%'' || ? || ''%'' ORDER BY Name COLLATE NoCase;';
begin
  { Free any existing statement ... }
  FStatement.Free;
  { ... and create a new one based on the filter setting. }
  if AFilter = '' then
    begin
      FStatement := FDatabase.Prepare16(SQL_Unfiltered);
    end
  else
    begin
      FStatement := FDatabase.Prepare16(SQL_Filtered);
      { For the filtered statement, bind the filter expression to the SQL
        WHERE clause. }
      FStatement.bind_Str16(1, edtFilterExpression.Text);
    end;
  ClearControls;
  GotoFirst;
end;

//------------------------------------------------------------------------------

procedure TfrmImageBitmap.PopulateControls;
var
  Image: TGraphic;
  ImageBuffer: Pointer;
  ImageBufferLength: Integer;
  MemoryStream: TMemoryStream;
begin
  { Populate edit and memo controls. This is simple and straightforward. }

  edtName.Text := FStatement.Column_Str16(1);
  edtBackground.Text := FStatement.Column_Str16(2);
  { Area and Population are actually INTEGER columns, but Column_Text
    converts them to text automatically. }
  edtArea.Text := FStatement.Column_Str16(3);
  edtPopulation.Text := FStatement.Column_Str16(4);
  { Area and Population are actually REAL (double) columns, but Column_Text
    converts them to text automatically. }
  edtBirthRate.Text := FStatement.Column_Str16(5);
  edtLifeExpectancy.Text := FStatement.Column_Str16(6);

  { Populate the TImage control with the flag bitmap.

    The TImage control can display various types of images (TBitmap, TIcon,
    TMetafile, TJpegImage), which are all descendants of TGraphic. Since our
    database contains bitmap images, we use TBitmap. If your database contains
    JPEG image data, you should use TJpegImage here. }
  Image := TBitMap.Create;
  try
    { Since TBitmap needs a TStream descendant from where to load the image
      data, we prepare a TMemoryStream for this. This works well for other
      image classes as well. }
    MemoryStream := TMemoryStream.Create;
    try
      { Fill the memory stream with the bitmap data from the database. The
        image data is stored as a blob, so Column_Blob returns a pointer to
        that memory, and Column_Bytes returns the amount of memory available. }
      ImageBuffer := FStatement.Column_Blob(7);
      ImageBufferLength := FStatement.Column_Bytes(7);
      MemoryStream.Write(ImageBuffer^, ImageBufferLength);
      { Set the stream's position to the beginning where the image starts. }
      MemoryStream.Seek(0, soFromBeginning);
      { Finally we can load the image from our memorystream ... }
      Image.LoadFromStream(MemoryStream);
      { ... and assign it to imgFlag.Pictur for display. }
      imgFlag.Picture.Assign(Image);
    finally
      MemoryStream.Free;
    end;
  finally
    Image.Free;
  end;
end;

//------------------------------------------------------------------------------

procedure TfrmImageBitmap.ClearControls;
var
  i: Integer;
  c: TControl;
begin
  { Loop through all controls and clear their contents. }
  for i := 0 to pnlRight.ControlCount - 1 do
    begin
      c := pnlRight.Controls[i];
      if c is TCustomEdit
        then (c as TCustomEdit).Clear
      else
        if c is TImage then
          (c as TImage).Picture.Bitmap.Assign(nil);
    end;
end;

//------------------------------------------------------------------------------

procedure TfrmImageBitmap.btnOpenDatabase_Click(Sender: TObject);
begin
  FDatabase.Open;
  PrepareStatement;
end;

//------------------------------------------------------------------------------

procedure TfrmImageBitmap.btnFirst_Click(Sender: TObject);
begin
  GotoFirst;
end;

//------------------------------------------------------------------------------

procedure TfrmImageBitmap.btnNextClick(Sender: TObject);
begin
  GotoNext;
end;

//------------------------------------------------------------------------------

procedure TfrmImageBitmap.edtFilterExpressionKeyPress(Sender: TObject; var Key: Char);
begin
  { Make the filter expression edit respond to the <Return> key. }
  if Key = #13 then btnSetFilterClick(nil);
end;

//------------------------------------------------------------------------------

procedure TfrmImageBitmap.btnSetFilterClick(Sender: TObject);
begin
  { To set a filter, call PrepareStatement with the filter expression. }
  PrepareStatement(edtFilterExpression.Text);
end;

//------------------------------------------------------------------------------

procedure TfrmImageBitmap.btnRemoveFilterClick(Sender: TObject);
begin
  { To remove a filter, call PrepareStatement without a filter expression. }
  PrepareStatement;
end;

//------------------------------------------------------------------------------

procedure TfrmImageBitmap.btnCloseDatabase_Click(Sender: TObject);
begin
  FDatabase.Close;
  ClearControls;
end;

//------------------------------------------------------------------------------

end.