ubaseform.pas

delphi 源码 小型企业管理软件

unit uBaseForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, ExtCtrls, DBCtrls, ToolWin, ComCtrls, DB, ADODB,
  wwSpeedButton, wwDBNavigator, wwclearpanel, uManData;

type
  TfrmBase = class(TForm)
    sbPaste: TSpeedButton;
    sbCopy: TSpeedButton;
    SB6: TSpeedButton;
    Panel1a: TPanel;
    wwDBNavigator1: TwwDBNavigator;
    wwDBNavigator1First: TwwNavButton;
    wwDBNavigator1PriorPage: TwwNavButton;
    wwDBNavigator1Prior: TwwNavButton;
    wwDBNavigator1Next: TwwNavButton;
    wwDBNavigator1NextPage: TwwNavButton;
    wwDBNavigator1Last: TwwNavButton;
    wwDBNavigator1SaveBookmark: TwwNavButton;
    wwDBNavigator1RestoreBookmark: TwwNavButton;
    Panel2a: TPanel;
    SpeedButton2: TSpeedButton;
    wwDBNavigator2: TwwDBNavigator;
    wwNavButton1: TwwNavButton;
    wwNavButton2: TwwNavButton;
    wwNavButton3: TwwNavButton;
    wwNavButton4: TwwNavButton;
    wwNavButton5: TwwNavButton;
    wwNavButton6: TwwNavButton;
    wwNavButton7: TwwNavButton;
    wwNavButton8: TwwNavButton;
    sbOK: TSpeedButton;
    SpeedButton1: TSpeedButton;
    SpeedButton3: TSpeedButton;
    procedure SB6Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormDestroy(Sender: TObject);
    procedure sbCopyClick(Sender: TObject);
    procedure sbPasteClick(Sender: TObject);
  private
    FMasterDataset,FDetailDataset: TDataset;
    FKeyField,FsubKeyField,FKeyValue,FTablename: string;
    function GetDetailDataset: TDataset;
    function GetMasterDataset: TDataset;
    procedure SaveData;
    { Private declarations }
  public
    AManData,AManData2: TManData;
    procedure SetDataCopyParam(const Tablename, KeyField1: string;
      const KeyField2:string='');
    property MasterDS: TDataset read GetMasterDataset write FMasterDataset;
    property DetailDS: TDataset read GetDetailDataset write FDetailDataset;

    { Public declarations }
  end;

var
  frmBase: TfrmBase;

implementation

uses uFunc;

{$R *.dfm}

function TfrmBase.GetDetailDataset: TDataset;
begin
  Result := FDetailDataset;
  if Result=nil then abort;
end;

function TfrmBase.GetMasterDataset: TDataset;
begin
  Result := FMasterDataset;
  if Result=nil then abort;
end;

procedure TfrmBase.SB6Click(Sender: TObject);
begin
  Close;
end;

procedure TfrmBase.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  Case Key of
    vk_Insert :         // 新增 - Ins
      MasterDS.Insert;
    vk_Escape :         // 取消 - ESC
      MasterDS.Cancel;
    Ord('S') :            // 存档 - Ctrl+S
      if Shift=[ssCtrl] then begin
        SaveData;
      end;
//    vk_F5 :
//      Table1.Refresh;
//    vk_Delete :         // 删除 - Ctrl + Del
//    begin
//      if Shift=[ssCtrl] then
//      begin
//        if not MasterDS.IsEmpty then
//          if R_YesNoMessage(['您确定要删除该笔资料吗?']) then
//            MasterDS.Delete;
//        Key := 0;
//      end;
//    end;
    vk_Home :            // 首笔 - Ctrl + Home  ;  上一笔 - Alt + Home
    begin
      if Shift=[ssCtrl] then MasterDS.First
        else if Shift=[ssAlt] then MasterDS.Prior;
    end;
    vk_End :            // 未笔 - Alt + Home  ;  下一笔 - Alt + End
    begin
      if Shift=[ssCtrl] then begin MasterDS.Last;  Key:=0; end
        else if Shift=[ssAlt] then MasterDS.Next;
    end;
  End;
end;

procedure TfrmBase.SaveData;
begin
  if AManData<>nil then begin
    AManData.SaveData;
    FreeAndNil(AManData);
  end;
  if AManData2<>nil then begin
    AManData2.SaveData;
    FreeAndNil(AManData2);
  end;
end;

procedure TfrmBase.FormDestroy(Sender: TObject);
begin
  SaveData;
end;

procedure TfrmBase.sbCopyClick(Sender: TObject);
begin
  if FKeyField='' then
    FKeyValue := ''
  else
    FKeyValue := MasterDS.FieldByName(FKeyField).AsString;
    
  sbPaste.Enabled := True;   
end;

function DSHasField(DS:TDataset;FieldName:string):Boolean;
var
  i: integer;
begin
  Result := False;
  for i:=0 to DS.FieldCount-1 do
    if SameText(DS.Fields[i].FieldName,FieldName) then
    begin
      Result := True;
      Exit;
    end;
end;

procedure TfrmBase.sbPasteClick(Sender: TObject);
var
  cloneDS: TCustomADODataSet;
  i,j: integer;
  bm: TBookmark;
  NewKeyValue: string;
begin
//  if FKeyValue='' then exit;
  cloneDS := TCustomADODataSet.Create(nil);

  try
    cloneDS.Clone(TCustomADODataSet(MasterDS));
    cloneDS.Locate(FKeyField,FKeyValue,[]);

    //复制主表
    with MasterDS do begin
      Append;

      for i:=0 to cloneDS.FieldCount-1 do begin
        if (cloneDS.Fields[i].FieldKind=fkData) and DSHasField(MasterDS,cloneDS.Fields[i].FieldName)
        then begin
           if cloneDS.Fields[i].FieldName='rid' then
             FieldByName(cloneDS.Fields[i].FieldName).Value := GetID
           else
             FieldByName(cloneDS.Fields[i].FieldName).Value := cloneDS.Fields[i].Value;
        end;
      end;

      if FKeyValue<>'' then begin
        //关键字栏位已有值时，不再计算
        if True{FieldByName(FKeyField).IsNull} then begin
          NewKeyValue := IntToStr(GetMaxInt(FTablename,FKeyField));
          FieldByName(FKeyField).Value := NewKeyValue;
        end else
          NewKeyValue := FieldByName(FKeyField).Value;
      end;

      Post;
    end;

    ////复制从表
    if FDetailDataset<>nil then begin
      bm := MasterDS.GetBookmark;
      MasterDS.Locate(FKeyField,FKeyValue,[]);
      cloneDS.Clone(TCustomADODataSet(DetailDS));
      MasterDS.GotoBookmark(bm);

      with cloneDS do begin
        First;

        while not eof do begin
          DetailDS.Append ;

          for i:=0 to FieldCount-1 do begin
            if (Fields[i].FieldKind=fkData) and DSHasField(DetailDS,cloneDS.Fields[i].FieldName)
            then begin
              if Fields[i].FieldName='rid' then
                DetailDS.FieldByName(Fields[i].FieldName).Value := GetID
              else
                DetailDS.FieldByName(Fields[i].FieldName).Value := Fields[i].Value;
            end;
          end;

          if FKeyValue<>'' then
            DetailDS.FieldByName(FsubKeyField).Value := NewKeyValue;

          DetailDS.Post;
          Next;
        end;
      end;
    end;
  finally
    cloneDS.Free ;
  end;


end;

procedure TfrmBase.SetDataCopyParam(const Tablename, KeyField1: string;
  const KeyField2:string='');
begin
  FTablename :=  Tablename;
  FKeyField := KeyField1;
  FsubKeyField := KeyField2;
  if FsubKeyField='' then FsubKeyField := FKeyField;

  sbCopy.Enabled := True;

end;

end.