lazarus/components/sqlite/tableeditorform.pas

unit tableeditorform;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Dialogs, StdCtrls,
  Buttons, sqliteds, ComponentEditors, LazarusPackageIntf, PropEdits, LazIdeIntf;

type

  {TSqliteEditor}
  
  TSqliteEditor = class(TComponentEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
    procedure Edit; override;
  end;

  { TSqliteTableEditorForm }

  TSqliteTableEditorForm = class(TForm)
    butCreate: TButton;
    butClose: TButton;
    butAdd: TButton;
    butDelete: TButton;
    comboFieldType: TComboBox;
    editFieldName: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    lblFilePath: TLabel;
    listFields: TListBox;
    DataSet: TSqliteDataSet;
    procedure SqliteTableEditorFormShow(Sender: TObject);
    procedure butAddClick(Sender: TObject);
    procedure butCancelClick(Sender: TObject);
    procedure butDeleteClick(Sender: TObject);
    procedure butOkClick(Sender: TObject);
    procedure comboFieldTypeChange(Sender: TObject);
    procedure editFieldNameEditingDone(Sender: TObject);
    procedure listFieldsSelectionChange(Sender: TObject; User: boolean);
  private
    { private declarations }
  public
    { public declarations }
  end; 
  
  procedure Register;
  
var
  SqliteTableEditorForm: TSqliteTableEditorForm;
  
implementation

procedure RegisterUnitSqliteds;
begin
  RegisterComponents('Data Access',[TSqliteDataset]);
end;  

procedure Register;
begin
  RegisterUnit('sqliteds',@RegisterUnitSqliteds);
  RegisterComponentEditor(TSqliteDataset,TSqliteEditor) ;
  RegisterPropertyEditor(TypeInfo(String),TSqliteDataset,'FileName',
                         TFileNamePropertyEditor);
end;  

function StringListHasDuplicates(const List:TStrings):boolean;
var
  i,j:Integer;
begin
  Result:=False;
  for i := 0 to List.Count - 1 do
    for j:= i+1 to List.Count - 1 do
      if AnsiCompareText(List[i],List[j]) = 0 then
      begin
        Result:=True;
        Exit;
      end;
end;

{TSqliteEditor}

procedure TSqliteEditor.ExecuteVerb(Index: Integer);
begin
  case Index of
    0:Edit;
  end;
end;

function TSqliteEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0:Result:='Create Table';
  end;
end;

function TSqliteEditor.GetVerbCount: Integer;
begin
  Result:=1;
end;

procedure TSqliteEditor.Edit;
var
  ADataSet:TSqliteDataSet;
  OldDir:String;
begin
  ADataSet:=TSqliteDataSet(GetComponent);
  if ADataSet.Filename = '' then
  begin
    ShowMessage('FileName not set: it''s not possible to create a table');
    exit;
  end;  
  if ADataSet.TableName = '' then
  begin
    ShowMessage('TableName not set: it''s not possible to create a table');
    exit;
  end;
    
  with TSqliteTableEditorForm.Create(Application) do
  begin
    try
      // In case Filename is a relative one, change dir to project dir
      // so the datafile will be created in the right place
      OldDir:=GetCurrentDir;
      if ExtractFilePath (LazarusIDE.ActiveProject.MainFile.FileName) <> '' then
        ChDir(ExtractFilePath (LazarusIDE.ActiveProject.MainFile.FileName));
      Dataset:=ADataset;
      ShowModal;
    finally
      chdir(OldDir);
      Free;
    end;  
  end;    
end;  

{ TSqliteTableEditorForm }

procedure TSqliteTableEditorForm.butAddClick(Sender: TObject);
begin
  listFields.Items.AddObject('AFieldName',TObject(0));
  listFields.ItemIndex:=listFields.Items.Count-1;
  comboFieldType.ItemIndex:=0;
  editFieldName.Text:='AFieldName';
  editFieldName.SetFocus;
end;

procedure TSqliteTableEditorForm.SqliteTableEditorFormShow(Sender: TObject);
begin
  lblFilePath.Caption:='File Path: '+ExpandFileName(DataSet.FileName);
  label3.caption:='Table Name: '+ DataSet.TableName;
end;

procedure TSqliteTableEditorForm.butCancelClick(Sender: TObject);
begin
  Close;
end;

procedure TSqliteTableEditorForm.butDeleteClick(Sender: TObject);
begin
  if listFields.ItemIndex <> -1 then
    listFields.Items.Delete(listFields.ItemIndex);
end;

procedure TSqliteTableEditorForm.butOkClick(Sender: TObject);
var
  i:Integer;
  ASql:String;
begin
  if Dataset.TableExists then
  begin
    if MessageDlg('A Table named "'+Dataset.TableName+'"already exists. Are you sure you want to replace this table?'#13#10'All data stored will be lost',
       mtWarning,[mbYes,MbNo],0) = mrNo then
      exit
    else
      DataSet.ExecSQL('DROP TABLE '+DataSet.TableName+';');
  end;

  if listFields.Items.Count = 0 then
  begin;
    ShowMessage('No fields added');
    Exit;
  end;
  
  if StringListHasDuplicates(listFields.Items) then
  begin
    ShowMessage('It''s not allowed fields with the same name');
    Exit;
  end;

  ASql:='CREATE TABLE '+ DataSet.TableName + ' (';
  with listFields do
  for i := 0 to Items.Count - 1 do
  begin
    ASql:=ASql+Items[i]+' ';
    if comboFieldType.Items[longint(Items.Objects[i])] = 'String' then
      ASql:=ASql+'VARCHAR'
    else
      ASql:=ASql+ Upcase(comboFieldType.Items[longint(Items.Objects[i])]);
    if i <>  Items.Count - 1 then
      ASql:=ASql+ ' , ';
  end;
  ASql:=ASql+');';
  DataSet.ExecSQL(ASql);
  if Dataset.TableExists then
    ShowMessage('Table created successfully')
  else
    ShowMessage('It was not possible to create the table');
end;

procedure TSqliteTableEditorForm.comboFieldTypeChange(Sender: TObject);
begin
  if listFields.ItemIndex <> -1 then
    listFields.Items.Objects[listFields.ItemIndex]:=TObject(comboFieldType.ItemIndex);
end;

procedure TSqliteTableEditorForm.editFieldNameEditingDone(Sender: TObject);
begin
  if listFields.ItemIndex <> -1 then
    listFields.Items[listFields.ItemIndex]:=editFieldName.Text;
end;

procedure TSqliteTableEditorForm.listFieldsSelectionChange(Sender: TObject;
  User: boolean);
begin
  if listFields.ItemIndex <> -1 then
  begin
    editFieldName.Text:=listFields.Items[listFields.ItemIndex];
    comboFieldType.ItemIndex:=LongInt(listFields.Items.Objects[listFields.ItemIndex]);
  end;
end;

initialization
  {$I tableeditorform.lrs}
  {$i sqliteds.lrs}

end.