uafieldsdesignereditor.pas

基于Midas 技术的多层应用开发包第二版（带开发文档）

unit UAFieldsDesignerEditor;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls,Variants,DBClient,DB,

{$IFDEF VER140}
  DesignIntf, DesignWindows,
{$ELSE}
  DsgnIntf, DsgnWnds,
{$ENDIF}
  UAClientDataSet,UAServiceClient, Spin;


type
  TFieldsDesignerEditor = class(TDesignWindow)
    OKBtn: TButton;
    CancelBtn: TButton;
    RefreshBtn: TButton;
    RequestBtn: TButton;
    lb_Fields: TListBox;
    gb_FieldProperty: TGroupBox;
    Label2: TLabel;
    Label3: TLabel;
    edt_DisplayLabel: TEdit;
    cb_Required: TCheckBox;
    cb_ReadOnly: TCheckBox;
    sEdt_DisplayWidth: TSpinEdit;
    cb_Visible: TCheckBox;
    procedure CancelBtnClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure OKBtnClick(Sender: TObject);
    procedure RequestBtnClick(Sender: TObject);
    procedure edt_DisplayLabelChange(Sender: TObject);
    procedure sEdt_DisplayWidthChange(Sender: TObject);
    procedure cb_ReadOnlyClick(Sender: TObject);
    procedure cb_VisibleClick(Sender: TObject);
    procedure cb_RequiredClick(Sender: TObject);
    procedure lb_FieldsClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  protected
    UAFieldsDesigner: TUAFieldsDesigner;
    FSwapCds:TClientDataSet;
    procedure InitAllFields;
    procedure RefreshFieldListByCds(Cds:TClientDataSet);
    function  GetCurrField(Idx:Integer):TField;
    procedure WriteAllFieldsToDataSet(const IsAppend:Boolean = false);
    procedure RequestAllFields;
  public
  end;



procedure ShowUAFieldsDesigner(Designer: IDesigner; UAFieldsDesigner: TUAFieldsDesigner);

implementation

{$R *.DFM}

procedure ShowUAFieldsDesigner(Designer: IDesigner; UAFieldsDesigner: TUAFieldsDesigner);
var
  Editor: TFieldsDesignerEditor;

  function FindEditor( UAFieldsDesigner: TUAFieldsDesigner): TFieldsDesignerEditor;
  var
    I: Integer;
  begin
    Result := nil;
    for I := 0 to Screen.FormCount - 1 do
     if Screen.Forms[I] is TFieldsDesignerEditor then
      if TFieldsDesignerEditor(Screen.Forms[I]).UAFieldsDesigner = UAFieldsDesigner then
       begin
        Result := TFieldsDesignerEditor(Screen.Forms[I]);
        Break;
       end;
  end;

begin
{  if UAFieldsDesigner = nil then Exit;
  Editor := FindEditor(UAFieldsDesigner);
  if Editor <> nil then
   begin
    Editor.InitAllFields;
    Editor.Show;
    if Editor.WindowState = wsMinimized then
      Editor.WindowState := wsNormal;
   end
  else
   begin
    Editor := TFieldsDesignerEditor.Create(Application);
    try
      {$IFDEF VER140}
//      Editor.Designer := Designer;
//      {$ELSE}
//      Editor.Designer := IFormDesigner(Designer);
//      {$ENDIF}
{      Editor.UAFieldsDesigner := UAFieldsDesigner;
      Editor.InitAllFields;
      Editor.Show;
    except
      Editor.Free;
      raise;
    end;
  end;}
end;

// ---------------------------------------------------

procedure TFieldsDesignerEditor.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TFieldsDesignerEditor.CancelBtnClick(Sender: TObject);
begin
  Close;
end;

procedure TFieldsDesignerEditor.OKBtnClick(Sender: TObject);
begin
  WriteAllFieldsToDataSet;
  Designer.Modified;
  Close;
end;

procedure TFieldsDesignerEditor.InitAllFields;
var
  i:integer;
begin

  if not Assigned(UAFieldsDesigner.OwnerDataSet.MasterUAServiceClient) then
    raise Exception.Create('must define UAServiceClient!');


  if not UAFieldsDesigner.OwnerDataSet.Active then Exit;

  with FSwapCds do
  begin
   FieldDefs.Clear;
   for i := 0 to UAFieldsDesigner.OwnerDataSet.FieldDefs.Count -1 do
   begin
     with FSwapCds.FieldDefs.AddFieldDef do
     begin
       Name := UAFieldsDesigner.OwnerDataSet.FieldDefs[i].Name;
       DataType := UAFieldsDesigner.OwnerDataSet.FieldDefs[i].DataType;
       Size := UAFieldsDesigner.OwnerDataSet.FieldDefs[i].Size;
       Precision := UAFieldsDesigner.OwnerDataSet.FieldDefs[i].Size;
       Attributes := UAFieldsDesigner.OwnerDataSet.FieldDefs[i].Attributes;
       Required := UAFieldsDesigner.OwnerDataSet.FieldDefs[i].Required;
       DisplayName := UAFieldsDesigner.OwnerDataSet.FieldDefs[i].DisplayName;
     end;
   end;
  end;
  FSwapCds.CreateDataSet;
  RefreshFieldListByCds(FSwapCds);

end;

procedure TFieldsDesignerEditor.WriteAllFieldsToDataSet(
  const IsAppend: Boolean);
var
  i:integer;
  sField:string;
  lFDef:TFieldDef;
begin

  for i := 0 to FSwapCds.FieldDefs.Count -1 do
  begin
    sField := FSwapCds.FieldDefs[i].Name;
    if UAFieldsDesigner.OwnerDataSet.FindField(sField) = nil then
    begin
      with UAFieldsDesigner.OwnerDataSet.FieldDefs.AddFieldDef do
      begin
        Name := FSwapCds.FieldDefs[i].Name;
        DataType := FSwapCds.FieldDefs[i].DataType;
        Size := FSwapCds.FieldDefs[i].Size;
        Precision := FSwapCds.FieldDefs[i].Size;
        Attributes := FSwapCds.FieldDefs[i].Attributes;
        Required := FSwapCds.FieldDefs[i].Required;
        DisplayName := FSwapCds.FieldDefs[i].DisplayName;
      end;
    end
    else
    begin
      lFDef := UAFieldsDesigner.OwnerDataSet.FieldDefs.Find(sField);
      lFDef.Size := FSwapCds.FieldDefs[i].Size;
      lFDef.Precision := FSwapCds.FieldDefs[i].Size;
      lFDef.Attributes := FSwapCds.FieldDefs[i].Attributes;
      lFDef.Required := FSwapCds.FieldDefs[i].Required;
    end;
  end;

  for i :=UAFieldsDesigner.OwnerDataSet.FieldDefs.Count -1 downto 0 do
  begin
    sField := UAFieldsDesigner.OwnerDataSet.FieldDefs[i].Name;
    if FSwapCds.FieldDefs.Find(sField) = nil then
      UAFieldsDesigner.OwnerDataSet.FieldDefs.Delete(i);
  end;

  UAFieldsDesigner.OwnerDataSet.CreateDataSet;

end;

procedure TFieldsDesignerEditor.RequestAllFields;
var
  aTmpSrvCli:TUAServiceClient;
  vOut:OleVariant;
  aTmpCDS:TClientDataSet;
  i:integer;
  sAliasTableName:string;
begin

  aTmpCDS := TClientDataSet.Create(nil);
  aTmpSrvCli := UAFieldsDesigner.OwnerDataSet.MasterUAServiceClient;
  sAliasTableName := UAFieldsDesigner.OwnerDataSet.AliasTableName;
  if not Assigned(aTmpSrvCli) then
    raise Exception.Create('UAServiceClient not Assigned!');
  if trim(sAliasTableName) = '' then
    raise Exception.Create('AliasTableName not Assigned!');

  try
    try
      aTmpSrvCli.UAServiceAdapter.Request('srvobjdesign','requesttblstrus',sAliasTableName+'-'+aTmpSrvCli.UAServiceAdapter.DefaultDBName,vOut);
      if (not VarIsEmpty(vOut)) and (VarCompareValue(vOut,Unassigned)<>vrEqual) then
      begin
        aTmpCDS.Data := vOut;
        aTmpCDS.Active := true;
        for i := 0 to aTmpCDS.FieldDefs.Count -1 do
        begin
           //如果后台数据库新增了字段
          if FSwapCds.FieldDefs.Find(aTmpCDS.FieldDefs.Items[i].Name) = nil then
          begin
            with FSwapCds.FieldDefs.AddFieldDef do
            begin
              Name := aTmpCDS.FieldDefs[i].Name;
              DataType := aTmpCDS.FieldDefs[i].DataType;
              Size := aTmpCDS.FieldDefs[i].Size;
              Precision := aTmpCDS.FieldDefs[i].Size;
              Attributes := aTmpCDS.FieldDefs[i].Attributes;
              Required := aTmpCDS.FieldDefs[i].Required;
              DisplayName := aTmpCDS.FieldDefs[i].DisplayName;
            end;
          end
          else
          begin //如果后台数据库修改了字段属性
            with FSwapCds.FieldDefs.Find(aTmpCDS.FieldDefs.Items[i].Name) do
            begin
              Name := aTmpCDS.FieldDefs[i].Name;
              DataType := aTmpCDS.FieldDefs[i].DataType;
              Size := aTmpCDS.FieldDefs[i].Size;
              Precision := aTmpCDS.FieldDefs[i].Size;
              Attributes := aTmpCDS.FieldDefs[i].Attributes;
              Required := aTmpCDS.FieldDefs[i].Required;
            end;
          end;
        end;
         //如果后台数据库删除了字段属性
        for i := FSwapCds.FieldDefs.Count -1 downto  0 do
        begin
          if aTmpCds.FieldDefs.Find(FSwapCds.FieldDefs.Items[i].Name) = nil then
            FSwapCds.FieldDefs.Delete(i);
        end;
        FSwapCds.CreateDataSet;
        RefreshFieldListByCds(FSwapCds);
      end;
    except
      on E:Exception do
         begin

         end;
    end;
  finally
    if Assigned(aTmpCDS) then
      FreeAndNil(aTmpCDS);
    if aTmpSrvCli.UAServiceAdapter.Connected then
      aTmpSrvCli.UAServiceAdapter.Connected := false;
  end;

end;

procedure TFieldsDesignerEditor.RequestBtnClick(Sender: TObject);
begin
  RequestAllFields;
end;

function TFieldsDesignerEditor.GetCurrField(Idx: Integer): TField;
begin

  Result := nil;
  if Idx = -1 then Exit;
  Result := TField(lb_Fields.Items.Objects[Idx]);

end;

procedure TFieldsDesignerEditor.edt_DisplayLabelChange(Sender: TObject);
var
  Idx,Idx1:integer;
  lField:TField;
begin

  Idx := lb_Fields.ItemIndex;
  lField := GetCurrField(Idx);
  lField.DisplayLabel := trim(edt_DisplayLabel.Text);
  RefreshFieldListByCds(FSwapCds);


end;

procedure TFieldsDesignerEditor.sEdt_DisplayWidthChange(Sender: TObject);
var
  Idx:integer;
begin
  Idx := lb_Fields.ItemIndex;
  GetCurrField(Idx).DisplayWidth := sEdt_DisplayWidth.Value;
end;

procedure TFieldsDesignerEditor.cb_ReadOnlyClick(Sender: TObject);
var
  Idx:integer;
begin

  Idx := lb_Fields.ItemIndex;
  GetCurrField(Idx).ReadOnly:= cb_ReadOnly.Checked;

end;

procedure TFieldsDesignerEditor.cb_VisibleClick(Sender: TObject);
var
  Idx:integer;
begin

  Idx := lb_Fields.ItemIndex;
  GetCurrField(Idx).Visible:= cb_Visible.Checked;

end;

procedure TFieldsDesignerEditor.cb_RequiredClick(Sender: TObject);
var
  Idx:integer;
begin

  Idx := lb_Fields.ItemIndex;
  GetCurrField(Idx).Required:= cb_Required.Checked;

end;

procedure TFieldsDesignerEditor.lb_FieldsClick(Sender: TObject);
var
  Idx:integer;
begin

  Idx := lb_Fields.ItemIndex;
  with GetCurrField(Idx) do
  begin
    cb_Required.Checked := Required;
    edt_DisplayLabel.Text := DisplayLabel;
    sEdt_DisplayWidth.Value := DisplayWidth;
    cb_ReadOnly.Checked := ReadOnly;
    cb_Visible.Checked := Visible;
  end;

end;

procedure TFieldsDesignerEditor.FormCreate(Sender: TObject);
begin
  FSwapCds := TClientDataSet.Create(Self);
end;

procedure TFieldsDesignerEditor.FormDestroy(Sender: TObject);
begin
  FSwapCds.Free;
end;

procedure TFieldsDesignerEditor.RefreshFieldListByCds(Cds: TClientDataSet);
var
  i:integer;
begin

  with Cds do
  begin
    edt_DisplayLabel.Text := '';
    lb_Fields.Items.BeginUpdate;
    lb_Fields.Clear;
    if Fields.Count <> 0 then
    begin
      for i := 0 to Fields.Count -1 do
        lb_Fields.AddItem(Fields[i].FieldName,Fields[i]);
    end;
    lb_Fields.Items.EndUpdate;
  end;

end;

end.