lazarus-ccr/components/rx/seldsfrm.pas

unit seldsfrm;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
  Buttons, ComponentEditors, DB, ButtonPanel;

type

  { TSelectDataSetForm }

  TSelectDataSetForm = class(TForm)
    ButtonPanel1: TButtonPanel;
    CheckBox1: TCheckBox;
    Label1: TLabel;
    DataSetList: TListBox;
    procedure CheckBox1Change(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
    procedure ListBox1KeyPress(Sender: TObject; var Key: char);
  private
    FDesigner: TComponentEditorDesigner;
    FExclude: string;
    procedure FillDataSetList(ExcludeDataSet: TDataSet);
    procedure AddDataSet(const S: string);
  public
    { public declarations }
  end; 

  { TMemDataSetEditor }

  TMemDataSetEditor = class(TComponentEditor)
  private
    DefaultEditor: TBaseComponentEditor;
    function UniqueName(Field: TField): string;
    procedure BorrowStructure;
  protected
    function CopyStructure(Source, Dest: TDataSet): Boolean; virtual;
  public
    constructor Create(AComponent: TComponent; ADesigner: TComponentEditorDesigner); override;
    destructor Destroy; override;
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

function SelectDataSet(ADesigner: TComponentEditorDesigner; const ACaption: string;
  ExcludeDataSet: TDataSet): TDataSet;

var
  SelectDataSetForm: TSelectDataSetForm;

implementation
uses rxmemds;

function SelectDataSet(ADesigner: TComponentEditorDesigner; const ACaption: string;
  ExcludeDataSet: TDataSet): TDataSet;
begin
  Result := nil;
  with TSelectDataSetForm.Create(Application) do
  try
    if ACaption <> '' then Caption := ACaption;
    FDesigner := ADesigner;
    FillDataSetList(ExcludeDataSet);
    if ShowModal = mrOk then
      if DataSetList.ItemIndex >= 0 then
      begin
        with DataSetList do
          Result := FDesigner.Form.FindComponent(Items[ItemIndex]) as TDataSet;
      end;
  finally
    Free;
  end;
end;

{ TSelectDataSetForm }

procedure TSelectDataSetForm.CheckBox1Change(Sender: TObject);
begin
  Label1.Enabled:=not CheckBox1.Checked;
  DataSetList.Enabled:=not CheckBox1.Checked;
end;

procedure TSelectDataSetForm.ListBox1DblClick(Sender: TObject);
begin
  if DataSetList.ItemIndex >= 0 then ModalResult := mrOk;
end;

procedure TSelectDataSetForm.ListBox1KeyPress(Sender: TObject; var Key: char);
begin
  if (Key = #13) and (DataSetList.ItemIndex >= 0) then
    ModalResult := mrOk;
end;

procedure TSelectDataSetForm.FillDataSetList(ExcludeDataSet: TDataSet);
var
  I: Integer;
  Component: TComponent;
begin
  DataSetList.Items.BeginUpdate;
  try
    DataSetList.Clear;
    FExclude := '';
    if ExcludeDataSet <> nil then FExclude := ExcludeDataSet.Name;
    for I := 0 to FDesigner.Form.ComponentCount - 1 do
    begin
      Component := FDesigner.Form.Components[I];
      if (Component is TDataSet) and (Component <> ExcludeDataSet) then
        AddDataSet(Component.Name);
    end;
    with DataSetList do
    begin
      if Items.Count > 0 then ItemIndex := 0;
      Enabled := Items.Count > 0;
      ButtonPanel1.OKButton.Enabled:= (ItemIndex >= 0);
    end;
  finally
    DataSetList.Items.EndUpdate;
  end;
end;

procedure TSelectDataSetForm.AddDataSet(const S: string);
begin
  if (S <> '') and (S <> FExclude) then DataSetList.Items.Add(S);
end;

{ TMemDataSetEditor }

function TMemDataSetEditor.UniqueName(Field: TField): string;
const
  AlphaNumeric = ['A'..'Z', 'a'..'z', '_'] + ['0'..'9'];
var
  Temp: string;
  Comp: TComponent;
  I: Integer;
begin
  Result := '';
  if (Field <> nil) then begin
    Temp := Field.FieldName;
    for I := Length(Temp) downto 1 do
      if not (Temp[I] in AlphaNumeric) then System.Delete(Temp, I, 1);
    if (Temp = '') or not IsValidIdent(Temp) then begin
      Temp := Field.ClassName;
      if (UpCase(Temp[1]) = 'T') and (Length(Temp) > 1) then
        System.Delete(Temp, 1, 1);
    end;
  end
  else Exit;
  Temp := Component.Name + Temp;
  I := 0;
  repeat
    Result := Temp;
    if I > 0 then Result := Result + IntToStr(I);
    Comp := Designer.Form.FindComponent(Result);
    Inc(I);
  until (Comp = nil) or (Comp = Field);
end;

procedure TMemDataSetEditor.BorrowStructure;
var
  DataSet: TDataSet;
  I: Integer;
  Caption: string;
begin
  Caption := Component.Name;
  if (Component.Owner <> nil) and (Component.Owner.Name <> '') then
    Caption := Format('%s.%s', [Component.Owner.Name, Caption]);
  DataSet := SelectDataSet(Designer, Caption, TDataSet(Component));
  if DataSet <> nil then
  begin
//    StartWait;
    try
      if not CopyStructure(DataSet, Component as TDataSet) then Exit;
      with TDataSet(Component) do
      begin
        for I := 0 to FieldCount - 1 do
          if Fields[I].Name = '' then
            Fields[I].Name := UniqueName(Fields[I]);
      end;
      Modified;
    finally
//      StopWait;
    end;
    Designer.Modified;
  end;
end;

function TMemDataSetEditor.CopyStructure(Source, Dest: TDataSet): Boolean;
begin
  Result := Dest is TRxMemoryData;
  if Result then
    TRxMemoryData(Dest).CopyStructure(Source);
end;

type
  PClass = ^TClass;

constructor TMemDataSetEditor.Create(AComponent: TComponent;
  ADesigner: TComponentEditorDesigner);
var
  CompClass: TClass;
begin
  inherited Create(AComponent, ADesigner);
  CompClass := PClass(Acomponent)^;
  try
    PClass(AComponent)^ := TDataSet;
    DefaultEditor := GetComponentEditor(AComponent, ADesigner);
  finally
    PClass(AComponent)^ := CompClass;
  end;
end;

destructor TMemDataSetEditor.Destroy;
begin
  DefaultEditor.Free;
  inherited Destroy;
end;

procedure TMemDataSetEditor.ExecuteVerb(Index: Integer);
begin
  if Index < DefaultEditor.GetVerbCount then
    DefaultEditor.ExecuteVerb(Index)
  else
  begin
    case Index - DefaultEditor.GetVerbCount of
      0:BorrowStructure;
    end;
  end;
end;

function TMemDataSetEditor.GetVerb(Index: Integer): string;
begin
  if Index < DefaultEditor.GetVerbCount then
    Result := DefaultEditor.GetVerb(Index)
  else
  begin
    case Index - DefaultEditor.GetVerbCount of
      0:Result:='Borrow structure...';
    end;
  end;
end;

function TMemDataSetEditor.GetVerbCount: Integer;
begin
  Result:=DefaultEditor.GetVerbCount + 1;
end;

initialization
  {$I seldsfrm.lrs}

end.