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.