asgsqlite3dsg.pas

DELPHI 访问SQLITE3 数据库的VCL控件

unit ASGSQLite3Dsg;

{*_* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *

Author:       Albert Drent
Description:  SQLite Design time component class
              For a description of changes, bugfixes, enhancements etc.,
              look into the ASGSQLite3.pas file.  
Creation:     November 2003
Version:      2005.02.A
EMail:        [e-mail] (sqlite.aducom.com)
Support:      [e-mail] (sqlite.aducom.com)
              for questions, remarks etc. please register on the forum on
              www.aducom.com/sqlite  
Legal issues: Copyright (C) 2003..2006 by Aducom Software

              Aducom Software
              Eckhartstr 61
              9746 BN  Groningen
              Netherlands

              Open Source licence (BSD: http://www.opensource.org/licenses/bsd-license.php)

              Copyright (c) 2006, Aducom Software
              All rights reserved.

              Redistribution and use in source and binary forms, with or without modification,
              are permitted provided that the following conditions are met:

              Redistributions of source code must retain the above copyright notice,
              this list of conditions and the following disclaimer.
              Redistributions in binary form must reproduce the above copyright notice,
              this list of conditions and the following disclaimer in the documentation
              and/or other materials provided with the distribution.
              Neither the name of Aducom Software nor the names of its contributors
              may be used to endorse or promote products derived from this software
              without specific prior written permission.
              THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
              "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
              TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
              PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
              COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
              INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
              DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
              GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
              HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
              STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
              IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
              POSSIBILITY OF SUCH DAMAGE.

Acknowledgement
              These components were written for our own needs. Since SQLite is
              a freeware component we like to donate this one to the community
              too. Parts of the code is adapted from several sources, but mainly
              from the sample of Borland itself. And, of course, we did a lot
              and still are...
To Do
              A lot...
              We are very busy, but will develop on our needs. If anyone can
              contribute, please feel welcome. Alter the source with lots of comment
              and mail it to me. If it works right I will add it to the official
              source and add your credit here below. Before you start, please
              put a request on the forum. It would be a shame if you develop something
              which already is...
*_* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }

interface

uses
{$I asqlite_def.inc}
{$IFDEF ASQLITE_D6PLUS}
  DesignIntf, DesignEditors,
{$ELSE}
  DsgnIntf,
{$ENDIF}

 FileCtrl,Classes, Controls, AMDSqlite3;

type

  TASQLiteEditor = Class( TComponentEditor )
    Function GetVerbCount: integer; Override;
    Function GetVerb( Index: integer ): String; Override;
    Procedure ExecuteVerb( Index: integer ); Override;
  End;

  TDatabasePropertyEditor = class(TPropertyEditor)
  public
    function GetAttributes      : TPropertyAttributes; override;
    function GetValue           : string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

  { Property editor for TASQLiteTable }
  TASQLite3DatabaseProperty = class(TDatabasePropertyEditor)
//    procedure GetValueList(Values: TStringList);
  end;

  TTablePropertyEditor = class(TPropertyEditor)
  public
    function GetAttributes      : TPropertyAttributes; override;
    function GetValue           : string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

  { Property editor for TASQLiteTableNames }
  TASQLite3TableNameProperty = class(TTablePropertyEditor)
//    procedure GetValueList(Values: TStringList);
  end;

  TMasterDetailPropertyEditor = class(TPropertyEditor)
  public
    function GetAttributes      : TPropertyAttributes; override;
    function GetValue           : string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

  { Property editor for TASQLiteMasterDetail fields }
  TASQLite3MasterDetailProperty = class(TMasterDetailPropertyEditor)
//    procedure GetValueList(Values: TStringList);
  end;

  TStoragePropertyEditor = class(TPropertyEditor)
  public
    function GetAttributes      : TPropertyAttributes; override;
    function GetValue           : string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

  { Property editor for TASQLiteStorage fields }
  TASQLite3StorageProperty = class(TStoragePropertyEditor)
//    procedure GetValueList(Values: TStringList);
  end;

  TSyncPropertyEditor = class(TPropertyEditor)
  public
    function GetAttributes      : TPropertyAttributes; override;
    function GetValue           : string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

  { Property editor for TASQLiteStorage fields }
  TASQLite3SyncProperty = class(TSyncPropertyEditor)
//    procedure GetValueList(Values: TStringList);
  end;

  TDirPropertyEditor = class(TPropertyEditor)
  public
    function GetAttributes      : TPropertyAttributes; override;
    function GetValue           : string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

  { Property editor for TASQLiteStorage fields }
  TASQLite3DirProperty = class(TDirPropertyEditor)
//    procedure GetValueList(Values: TStringList);
  end;

  TDLLDirPropertyEditor = class(TPropertyEditor)
  public
    function GetAttributes      : TPropertyAttributes; override;
    function GetValue           : string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

  { Property editor for DLL directory}
  TASQLite3DLLDirProperty = class(TDLLDirPropertyEditor)
//    procedure GetValueList(Values: TStringList);
  end;

  TFileTypePropertyEditor = class(TPropertyEditor)
  public
    function GetAttributes      : TPropertyAttributes; override;
    function GetValue           : string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

  { Property editor for TASQLiteOutputtype fields }
  TASQLite3FileTypeProperty = class(TFileTypePropertyEditor)
//    procedure GetValueList(Values: TStringList);
  end;

  TTransactionPropertyEditor = class(TPropertyEditor)
  public
    function GetAttributes      : TPropertyAttributes; override;
    function GetValue           : string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

  { Property editor for TASQLiteOutputtype fields }
  TASQLite3TransactionProperty = class(TTransactionPropertyEditor)
//    procedure GetValueList(Values: TStringList);
  end;

  TCharEncPropertyEditor = class(TPropertyEditor)
  public
    function GetAttributes      : TPropertyAttributes; override;
    function GetValue           : string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

  { Property editor for TASQLiteOutputtype fields }
  TASQLite3CharEncProperty = class(TCharEncPropertyEditor)
//    procedure GetValueList(Values: TStringList);
  end;
procedure Register;

implementation

uses ASGSQLite3, SysUtils, Forms, Dialogs;

// *************************************************************************************
// ** GetVerbCount
// *************************************************************************************

Function TASQLiteEditor.GetVerbCount: integer;
Begin
     Result := 1;
End;

// *************************************************************************************
// ** GetVerb
// *************************************************************************************

Function TASQLiteEditor.GetVerb( Index: integer ): String;
Begin
     Case Index Of
          0: Result := 'Aducom Software';
     End;
End;

// *************************************************************************************
// ** ExecuteVerb
// *************************************************************************************

Procedure TASQLiteEditor.ExecuteVerb( Index: integer );
Begin
     Case Index Of
          0: ;//ShowAboutBox( 'Max''s WebUpdate Component' );
     End;
End;

function TDatabasePropertyEditor.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paDialog, paValueList, paRevertable];
end;

procedure TDatabasePropertyEditor.GetValues(Proc: TGetStrProc);
var
  sr: TSearchRec;
begin
  with GetComponent(0) as TASQLite3DB do begin
    if DefaultExt = '' then DefaultExt := '.sqb';
    if DefaultExt[1]<> '.' then DefaultExt := '.'+DefaultExt;
    if DefaultDir <> '' then
       if DefaultDir[Length(DefaultDir)]<>'\' then
          DefaultDir := DefaultDir + '\';
    if FindFirst(DefaultDir+'*'+DefaultExt,faAnyFile, sr) = 0 then begin
       repeat
         Proc(sr.Name);
       until FindNext(sr) <> 0;
       FindClose(sr);
    end;
  end;
  Proc(':memory:');
end;

function TDatabasePropertyEditor.GetValue: string;
begin
  Result := GetStrValue;
end;

procedure TDatabasePropertyEditor.SetValue(const Value: string);
begin
  SetStrValue(Value);
end;

//procedure TASQLiteTableNameProperty.GetValueList(Values: TStringList);
//begin
//end;

function TTablePropertyEditor.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paDialog, paValueList, paRevertable];
end;

procedure TTablePropertyEditor.GetValues(Proc: TGetStrProc);
var MyList : TStringList;