u_createdbeditor.pas

控件作用: 自动创建SQL数据库(可以同时间创建多个数据库) 控件用法: 1:添加数据库(可以添加多个数据库)选择相应的数据库. 2:添加SQL文件(创建数据表,视图,过程.可从SQL文件中

unit u_CreateDBEditor;

interface

uses
  {$IFDEF VER140}
  DesignIntf, DesignEditors,
  {$ELSE}
  DsgnIntf,
  {$ENDIF}
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, cCreateDb, ComObj, ImgList, ToolWin,
  ExtCtrls, cSplitter, Buttons;

type
  TCreateDBEditor = class(TForm)
    lv_dbs: TListView;
    Panel1: TPanel;
    ImageList1: TImageList;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    tBtn_Add: TToolButton;
    tBtn_Del: TToolButton;
    tBtn_Save: TToolButton;
    tBtn_Exit: TToolButton;
    cSp1: TcSplitter;
    pnl_Default: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    cSp2: TcSplitter;
    pnl_Struct: TPanel;
    Panel7: TPanel;
    Panel8: TPanel;
    Panel9: TPanel;
    Panel2: TPanel;
    SpeedButton1: TSpeedButton;
    rEdt_Struct: TMemo;
    Panel6: TPanel;
    SpeedButton2: TSpeedButton;
    rEdt_Default: TMemo;
    procedure FormShow(Sender: TObject);
    procedure REdt_StructChange(Sender: TObject);
    procedure REdt_DefaultChange(Sender: TObject);
    procedure tBtn_SaveClick(Sender: TObject);
    procedure tBtn_ExitClick(Sender: TObject);
    procedure tBtn_AddClick(Sender: TObject);
    procedure tBtn_DelClick(Sender: TObject);
    procedure cSp1Moved(Sender: TObject);
    procedure cSp1RClick(Sender: TObject);
    procedure lv_dbsDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure cSp2Moved(Sender: TObject);
    procedure Panel9Click(Sender: TObject);
    procedure Panel5Click(Sender: TObject);
    procedure lv_dbsEndDrag(Sender, Target: TObject; X, Y: Integer);
    procedure lv_dbsEdited(Sender: TObject; Item: TListItem;
      var S: String);
    procedure FormDestroy(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure lv_dbsSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure SpeedButton2Click(Sender: TObject);
  private
    { Private declarations }
    FResult: Boolean;
  public
    { Public declarations }
    inDbs: TcDatabases;
    outDbs: TcDatabases;
    function Execute: Boolean;
  end;

  type TcCreateDBEditor = Class(TComponentEditor)
  public
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
    procedure ExecuteVerb(Index: Integer); override;
    procedure Edit; override;
  end;

  procedure Register;
  
var
  CreateDBEditor: TCreateDBEditor;
  
implementation

{$R *.dfm}

procedure TCreateDBEditor.FormShow(Sender: TObject);
var
  i: Integer;
begin
  lv_dbs.Clear;
  for i := 0 to inDbs.Count -1 do
    with lv_dbs.Items.Add do begin
      Caption := inDbs.Items[i].DBName;
      Data := inDbs.Items[i];
      ImageIndex := 4;
    end;
end;

procedure TCreateDBEditor.REdt_StructChange(Sender: TObject);
begin
  if Assigned(lv_dbs.Selected) then
    TcDatabase(lv_dbs.Selected.Data).StrucDef.Assign(rEdt_Struct.Lines);
end;

procedure TCreateDBEditor.REdt_DefaultChange(Sender: TObject);
begin
  if Assigned(lv_dbs.Selected) then
    TcDatabase(lv_dbs.Selected.Data).SuspendData.Assign(rEdt_Default.Lines);
end;

function TCreateDBEditor.Execute: Boolean;
begin
  FResult := false;
  ShowModal;
  result := FResult;
end;

procedure TCreateDBEditor.tBtn_SaveClick(Sender: TObject);
var
  i: Integer;
begin
  outDbs := TcDatabases.Create(TcDatabase);
  for i := 0 to lv_dbs.Items.Count - 1 do
    With outDbs.Add do begin
      DBName := lv_dbs.Items[i].Caption;
      StrucDef.Assign(TcDatabase(lv_dbs.Items[i].Data).StrucDef);
      SuspendData.Assign(TcDatabase(lv_dbs.Items[i].Data).SuspendData);
    end;
  FResult := true;
  Close;
end;

procedure TCreateDBEditor.tBtn_ExitClick(Sender: TObject);
begin
  Close;
end;

procedure TCreateDBEditor.tBtn_AddClick(Sender: TObject);
var
  adb: TcDatabase;
begin
  adb := inDbs.Add;
  adb.DBName := 'NewDatabase';
  With lv_dbs.Items.Add do begin
    Caption := adb.DBName;
    Data := adb;
    ImageIndex := 4;
  end;
end;

procedure TCreateDBEditor.tBtn_DelClick(Sender: TObject);
begin
  if Assigned(lv_dbs.Selected) then begin
    inDbs.Delete(TcDatabase(lv_dbs.Selected.Data).Index);
    lv_dbs.DeleteSelected;
  end;
end;

procedure TCreateDBEditor.cSp1Moved(Sender: TObject);
begin
  if lv_dbs.Width < cSp1.MinSize then
    lv_dbs.Width := cSp1.MinSize;
end;

procedure TCreateDBEditor.cSp1RClick(Sender: TObject);
begin
  if cSp1.Tag = 0 then begin
    While lv_dbs.Width > cSp1.MinSize do
      lv_dbs.Width := lv_dbs.Width - 10;
    cSp1.Tag := 1;
  end else begin
    While lv_dbs.Width < cSp1.MaxSize do
      lv_dbs.Width := lv_dbs.Width + 10;
    cSp1.Tag := 0;
  end;
end;

procedure TCreateDBEditor.lv_dbsDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
var
  li: TListItem;
begin
  Application.ProcessMessages;
  li := lv_dbs.GetItemAt(X, Y);
  if Assigned(li) then
    Accept := true
  else
    Accept := false;
end;

procedure TCreateDBEditor.cSp2Moved(Sender: TObject);
begin
  if pnl_Struct.Height < cSp2.MinSize then
    pnl_Struct.Height := cSp2.MinSize;
end;

procedure TCreateDBEditor.Panel9Click(Sender: TObject);
var
  p1, p2: TNotifyEvent;
begin
  p1 := rEdt_Struct.OnChange;
  p2 := rEdt_Default.OnChange;
  rEdt_Struct.OnChange := Nil;
  rEdt_Default.OnChange := Nil;
  While pnl_Default.Height > cSp2.MinSize + 10 do
    pnl_Struct.Height := pnl_Struct.Height + 10;
  rEdt_Struct.OnChange := p1;
  rEdt_Default.OnChange := p2;
end;

procedure TCreateDBEditor.Panel5Click(Sender: TObject);
var
  p1, p2: TNotifyEvent;
begin
  p1 := rEdt_Struct.OnChange;
  p2 := rEdt_Default.OnChange;
  rEdt_Struct.OnChange := Nil;
  rEdt_Default.OnChange := Nil;
  While pnl_Struct.Height > cSp2.MinSize + 10 do
    pnl_Struct.Height := pnl_Struct.Height - 10;
  rEdt_Struct.OnChange := p1;
  rEdt_Default.OnChange := p2;
end;

procedure TCreateDBEditor.lv_dbsEdited(Sender: TObject; Item: TListItem;
  var S: String);
begin
  TcDatabase(Item.Data).DBName := S;
end;

procedure TCreateDBEditor.lv_dbsEndDrag(Sender, Target: TObject; X, Y: Integer);
var
  i: Integer;
  li: TListItem;
begin
  if (X <> 0) and (Y <> 0) then
    try
      li := lv_dbs.GetItemAt(X, Y);
      if lv_dbs.Selected.Index > li.Index then
        i := li.Index
      else
        i := li.Index + 1;
      With lv_dbs.Items.Insert(i) do begin
        Caption := lv_dbs.Selected.Caption;
        Data := lv_dbs.Selected.Data;
        ImageIndex := 4;
        i := Index;
      end;
      lv_dbs.DeleteSelected;
      lv_dbs.ItemIndex := i;
    except
    end;
end;

procedure TCreateDBEditor.FormDestroy(Sender: TObject);
begin
  if Assigned(inDbs) then
    inDbs.Free;
  if Assigned(outDbs) then
    outDbs.Free;
end;

procedure TCreateDBEditor.SpeedButton1Click(Sender: TObject);
var
  oDlg: TOpenDialog;
  hF: textfile;
  s: String;
  sT: TStrings;
  p: TNotifyEvent;
begin
  oDlg := TOpenDialog.Create(Application);
  oDlg.Filter := 'Text files (*.txt)|*.TXT|all files (*.*)|*.*';
  if oDlg.Execute then
    try
      AssignFile(hF, oDlg.FileName);
      Reset(hF);
      sT := TStringList.Create;
      While Not Eof(hF) do begin
        Readln(hF, s);
        sT.Add(s);
      end;
      p := rEdt_Struct.OnChange;
      rEdt_Struct.OnChange := Nil;
      rEdt_Struct.Lines.Assign(sT);
      rEdt_Struct.OnChange := p;
      p(rEdt_Struct);
      CloseFile(hF);
    except
      ShowMessage('Failed!');
    end;
  oDlg.Free;
end;

procedure TCreateDBEditor.lv_dbsSelectItem(Sender: TObject;
  Item: TListItem; Selected: Boolean);
begin
  if Assigned(lv_dbs.Selected) and (Not Assigned(lv_dbs.DropTarget)) then begin
    rEdt_Struct.Lines.Text := TcDatabase(lv_dbs.Selected.Data).StrucDef.Text;
    rEdt_Default.Lines.Text := TcDatabase(lv_dbs.Selected.Data).SuspendData.Text;
    pnl_Struct.Enabled := true;
    pnl_Default.Enabled := true;
  end else begin
    pnl_Struct.Enabled := false;
    pnl_Default.Enabled := false;
    rEdt_Struct.Lines.Clear;
    rEdt_Default.Lines.Clear;
  end;

end;

procedure TCreateDBEditor.SpeedButton2Click(Sender: TObject);
var
  oDlg: TOpenDialog;
  hF: textfile;
  s: String;
  sT: TStrings;
  p: TNotifyEvent;
begin
  oDlg := TOpenDialog.Create(Application);
  oDlg.Filter := 'Text files (*.txt)|*.TXT|all files (*.*)|*.*';
  if oDlg.Execute then
    try
      AssignFile(hF, oDlg.FileName);
      Reset(hF);
      sT := TStringList.Create;
      While Not Eof(hF) do begin
        Readln(hF, s);
        sT.Add(s);
      end;
      p := rEdt_Default.OnChange;
      rEdt_Default.OnChange := Nil;
      rEdt_Default.Lines.Assign(sT);
      rEdt_Default.OnChange := p;
      p(rEdt_Default);
      CloseFile(hF);
    except
      ShowMessage('Failed!');
    end;
  oDlg.Free;
end;

{ TcCreateDBEditor }

procedure TcCreateDBEditor.Edit;
begin
  CreateDBEditor := TCreateDBEditor.Create(Application);
  try
    CreateDBEditor.inDBs := TcDatabases.Create(TcDatabase);
    if Assigned(TcCreateDBV2(Component).Databases) then
      CreateDBEditor.inDbs.Assign(TcCreateDBV2(Component).Databases);
    if CreateDBEditor.Execute then begin
      TcCreateDBV2(Component).Databases.Assign(CreateDBEditor.outDbs);
      Designer.Modified;
    end;
  finally
    CreateDBEditor.Free;
  end;
end;

procedure TcCreateDBEditor.ExecuteVerb(Index: Integer);
begin
  Edit;
end;

function TcCreateDBEditor.GetVerb(Index: Integer): string;
begin
  result := 'Edit...';
end;

function TcCreateDBEditor.GetVerbCount: Integer;
begin
  result := 1;
end;

procedure Register;
begin
  RegisterComponents('ZZCC', [TcCreateDB]);
  RegisterComponents('ZZCC', [TcCreateDBV2]);
  RegisterComponentEditor(TcCreateDBV2, TcCreateDBEditor);
end;

end.