blobpictures.pas

Oracle Data Access Components Source Code ODAC v.6.70.0.45

unit BlobPictures;

interface

uses
{$IFDEF LINUX}
  SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs, QStdCtrls,
  QDBCtrls, QComCtrls, QExtCtrls, QGrids, QDBGrids, QButtons, OdacClx,
{$ELSE}
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DBCtrls, ExtCtrls, Grids, DBGrids, StdCtrls, ToolWin, ComCtrls, ExtDlgs,
  Buttons, OdacVcl,
{$ENDIF}
  Db, Ora, OraScript, DAScript, MemDS, DBAccess, OraSmart, MemData,
  OdacDemoForm,
  OdacDemoFrame;

type
  TBlobPicturesFrame = class(TOdacDemoFrame)
    Query: TSmartQuery;
    OraDataSource1: TOraDataSource;
    DBGrid1: TDBGrid;
    DBImage: TDBImage;
    ToolBar: TPanel;
    Splitter1: TSplitter;
    ToolBar1: TPanel;
    OraStoredProc: TOraStoredProc;
    ToolButton3: TToolButton;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    DBNavigator: TDBNavigator;
    btClose: TSpeedButton;
    btOpen: TSpeedButton;
    btAddRecord: TSpeedButton;
    btClear: TSpeedButton;
    btSave: TSpeedButton;
    btLoad: TSpeedButton;
    QueryID: TFloatField;
    QueryTITLE: TStringField;
    QueryPIC: TBlobField;
    QuerySize: TIntegerField;
    QueryCompressedSize: TIntegerField;
    QueryServerSize: TIntegerField;
    Panel4: TPanel;
    Panel5: TPanel;
    Panel6: TPanel;
    cbDefLobRead: TCheckBox;
    cbCacheLobs: TCheckBox;
    cbTemporaryLobUpdate: TCheckBox;
    Panel7: TPanel;
    cbxCompression: TComboBox;
    Panel8: TPanel;
    procedure btLoadClick(Sender: TObject);
    procedure btSaveClick(Sender: TObject);
    procedure btOpenClick(Sender: TObject);
    procedure btCloseClick(Sender: TObject);
    procedure btClearClick(Sender: TObject);
    procedure btAddRecordClick(Sender: TObject);
    procedure cbDefLobReadClick(Sender: TObject);
    procedure cbCacheLobsClick(Sender: TObject);
    procedure scCreateError(Sender: TObject; E: Exception; SQL: String;
      var Action: TErrorAction);
    procedure cbTemporaryLobUpdateClick(Sender: TObject);
    procedure QueryCalcFields(DataSet: TDataSet);
    procedure cbxCompressionChange(Sender: TObject);
  private
    procedure GetCompressionType;
    procedure SetCompressionType;
  public
    procedure Initialize; override;
    procedure SetDebug(Value: boolean); override;
end;

implementation

{$IFDEF CLR}
{$R *.nfm}
{$ENDIF}
{$IFDEF WIN32}
{$R *.dfm}
{$ENDIF}
{$IFDEF LINUX}
{$R *.xfm}
{$ENDIF}

procedure TBlobPicturesFrame.SetDebug(Value: boolean);
begin
  Query.Debug := Value;
  OraStoredProc.Debug := Value;
end;

procedure TBlobPicturesFrame.Initialize;
begin
  inherited;

  Query.Connection := Connection;
  OraStoredProc.Connection := Connection;

  cbDefLobRead.Checked := Query.Options.DeferredLobRead;
  cbCacheLobs.Checked := Query.Options.CacheLobs;
  cbTemporaryLobUpdate.Checked := Query.Options.TemporaryLobUpdate;
  GetCompressionType;
end;

procedure TBlobPicturesFrame.GetCompressionType;
begin
{$IFNDEF CLR}
  case Query.Options.CompressBlobMode of
    cbNone:
      cbxCompression.ItemIndex := 0;
    cbClient:
      cbxCompression.ItemIndex := 1;
    cbServer:
      cbxCompression.ItemIndex := 2;
    cbClientServer:
      cbxCompression.ItemIndex := 3;
  end;
{$ENDIF}
end;

procedure TBlobPicturesFrame.SetCompressionType;
begin
{$IFNDEF CLR}
  case cbxCompression.ItemIndex of
    0: begin
      Query.Options.CompressBlobMode := cbNone;
      OraStoredProc.Options.CompressBlobMode := cbNone;
    end;
    1: begin
      Query.Options.CompressBlobMode := cbClient;
      OraStoredProc.Options.CompressBlobMode := cbClient;
    end;
    2: begin
      Query.Options.CompressBlobMode := cbServer;
      OraStoredProc.Options.CompressBlobMode := cbServer;
    end;
    3: begin
      Query.Options.CompressBlobMode := cbClientServer;
      OraStoredProc.Options.CompressBlobMode := cbClientServer;
    end;
  end;
{$ENDIF}
end;

procedure TBlobPicturesFrame.btOpenClick(Sender: TObject);
begin
  Query.Open;
end;

procedure TBlobPicturesFrame.btCloseClick(Sender: TObject);
begin
  Query.Close;
end;

procedure TBlobPicturesFrame.btLoadClick(Sender: TObject);
begin
{$IFDEF LINUX}
  with TOpenDialog.Create(nil) do
{$ELSE}
  with TOpenPictureDialog.Create(nil) do
{$ENDIF}
    try
      InitialDir := ExtractFilePath(Application.ExeName) + 'Pictures';
      if Query.Active and Execute then begin
        if Query.State = dsBrowse then
          Query.Edit;

        TBlobField(Query.FieldByName('Pic')).LoadFromFile(FileName);
      end;
    finally
      Free;
    end;
end;

procedure TBlobPicturesFrame.btSaveClick(Sender: TObject);
begin
{$IFDEF LINUX}
  with TSaveDialog.Create(nil) do
{$ELSE}
  with TSavePictureDialog.Create(nil) do
{$ENDIF}
    try
      InitialDir := ExtractFilePath(Application.ExeName) + 'Pictures';
      if not Query.EOF and Execute then
        TBlobField(Query.FieldByName('Pic')).SaveToFile(FileName);
    finally
      Free;
    end;
end;

procedure TBlobPicturesFrame.btClearClick(Sender: TObject);
begin
  if Query.State = dsBrowse then
    Query.Edit;

  TBlobField(Query.FieldByName('Pic')).Clear;
end;

procedure TBlobPicturesFrame.btAddRecordClick(Sender: TObject);
begin
{$IFDEF LINUX}
  with TOpenDialog.Create(nil) do
{$ELSE}
  with TOpenPictureDialog.Create(nil) do
{$ENDIF}
    try
      InitialDir := '.';    
      if Execute then begin
        with OraStoredProc do begin
          StoredProcName := 'ODAC_BLOB_Insert';
          PrepareSQL;  // receive parameters

          Randomize;
          ParamByName('p_ID').AsInteger := Random(1000);
          ParamByName('p_Title').AsString := ExtractFileName(FileName);

          ParamByName('p_Pic').ParamType := ptInput;  // to transfer Lob data to Oracle
          ParamByName('p_Pic').AsOraBlob.LoadFromFile(FileName);
          Execute;
        end;
        Query.Refresh;
      end;
    finally
      Free;
    end;
end;

procedure TBlobPicturesFrame.cbDefLobReadClick(Sender: TObject);
begin
  Query.Options.DeferredLobRead := cbDefLobRead.Checked;
end;

procedure TBlobPicturesFrame.cbCacheLobsClick(Sender: TObject);
begin
  try
    Query.Options.CacheLobs := cbCacheLobs.Checked;
  except
    cbCacheLobs.Checked := Query.Options.CacheLobs;
    raise;
  end;
end;

procedure TBlobPicturesFrame.cbTemporaryLobUpdateClick(Sender: TObject);
begin
  Query.Options.TemporaryLobUpdate := cbTemporaryLobUpdate.Checked;
end;

procedure TBlobPicturesFrame.scCreateError(Sender: TObject; E: Exception; SQL: String;
  var Action: TErrorAction);
begin
//
end;

procedure TBlobPicturesFrame.QueryCalcFields(DataSet: TDataSet);
begin
  Query.FieldByName('Size').AsInteger := TBlobField(Query.FieldByName('Pic')).BlobSize;
  Query.FieldByName('ServerSize').AsInteger := Query.GetLob('Pic').LengthLob;
{$IFNDEF CLR}
  if Query.GetLob('Pic').Compressed then
    Query.FieldByName('CompressedSize').AsInteger := Query.GetLob('Pic').CompressedSize
  else
    Query.FieldByName('CompressedSize').AsString := '';
{$ENDIF}
end;

procedure TBlobPicturesFrame.cbxCompressionChange(Sender: TObject);
begin
  try
    SetCompressionType;
  except
    GetCompressionType;
    raise;
  end;
end;

end.