treemodelform.pas

实达企业在线EOL源码

unit TreeModelForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  SingleModelForm, Grids, DBGrids, ComCtrls, sDBTree, Db, DbClient,
  SingleBillFrame, StdCtrls, ExtCtrls, SingleFrame, Wwdbigrd, Wwdbgrid;

type
  TDataDo= (doLocate,doFilter);

  TTreeModelFrm = class(TSingleModelFrm)
    sDBTree1: TsDBTree;
    Splitter2: TSplitter;
    PageControl: TPageControl;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    wwDBGrid1: TwwDBGrid;
    procedure wwDBGrid1DblClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure SingleBillFrame1BtnNewClick(Sender: TObject);
    procedure SingleBillFrame1BtnSaveClick(Sender: TObject);
    procedure SingleBillFrame1BtnDeleteClick(Sender: TObject);
    procedure sDBTree1Click(Sender: TObject);
    procedure sDBTree1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure sDBTree1DblClick(Sender: TObject);
  private
    { Private declarations }
    FDataDo: TDataDo;
    FOldFilter: string;
    FOldFiltered: Boolean;
//    procedure FilterData;
    procedure LocateData;virtual;
  protected
    // Modify By Kanty 主要用于后代继承
    function CheckDbTree: boolean;
    function CheckDataSet: Boolean;
    
    procedure FilterData;virtual;
  public
    { Public declarations }
    property DataDo: TDataDo write FDataDo;
  end;

var
  TreeModelFrm: TTreeModelFrm;

implementation

{$R *.DFM}

uses
  GlobalUnit,SystemConstUnit,Pub_DBFunction;

function FixLengthStr(S: string; L: integer): string;
begin
  if Length(S) > L then result := Copy(S,1,L)
  else if Length(S) = L then result := S
  else result := S + StringOfChar(' ',L-Length(S));
end;

function TTreeModelFrm.CheckDbTree: Boolean;
begin
  Result := (sDbTree1.KeyField <> '') and (sDbTree1.UpKeyField <> '');
end;

function TTreeModelFrm.CheckDataSet: Boolean;
begin
  Result := Assigned(dsMast.Dataset);
end;

procedure TTreeModelFrm.LocateData;
var
  Key : string;
begin
  if not CheckDataset or not CheckDBTree then Exit;
  Key := StrValueOfField(sDBTree1.SelectedKey);
  if Key <> '' then
    with dsMast.DataSet,sDBTree1 do
      Locate(KeyField,VarArrayOf([Key]),[]);
end;

procedure TTreeModelFrm.FilterData;
var
  Key : string;
begin
  //所有下级的。。。???
  if not CheckDataset or not CheckDBTree then Exit;
  Key := StrValueOfField(sDBTree1.SelectedKey);
  if Key <> '' then
  begin
    with dsMast.DataSet,sDBTree1 do
    begin
      Close;
      TClientDataSet(dsMast.DataSet).Params.ParamByName('ItemType').AsString := Key;
//      Filtered := False;
//      Filter := Format('%s=''%s''',[KeyField,Key]);
//      Filtered := True;
      Open;
    end;
  end
  else dsMast.Dataset.Filtered := False;
end;

//*********************************** Form ***********************************//

procedure TTreeModelFrm.FormShow(Sender: TObject);
begin
  inherited;
  PageControl.ActivePageIndex := 0;
  FDataDo := doFilter;
  if CheckDbTree then
  begin
    sDbtree1.Reset;
    sDBTree1.RootNode.Expand(False);
  end;
  if CheckDataSet then
  try
    with dsMast.Dataset do
    begin
      Close;
      Open;
      FOldFilter := Filter;
      FOldFiltered := Filtered;
    end;
  except
    Global.AccessDialog.ShowError(Format(OPENDATASETERROR,['']));
  end;
end;

procedure TTreeModelFrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if CheckDataSet then
    with dsMast.DataSet do
    try
      Filter := FOldFilter;
      Filtered := FOldFiltered;
    finally  
      Close;
    end;
  //inherited;  
end;

//********************************* sDBTree **********************************//

procedure TTreeModelFrm.sDBTree1Click(Sender: TObject);
begin
  inherited;
  if sDBTree1.Selected = nil then Exit;
  if sDBTree1.NodeOnMouseDown = sDBTree1.Selected then
  case FDataDo of
    doLocate : LocateData;
    doFilter : FilterData;
  end;
end;

procedure TTreeModelFrm.sDBTree1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if sDBTree1.Selected = nil then Exit;
  if Key in [VK_UP,VK_DOWN,VK_LEFT,VK_RIGHT] then
  case FDataDo of
    doLocate : LocateData;
    doFilter : FilterData;
  end;
end;

procedure TTreeModelFrm.sDBTree1DblClick(Sender: TObject);
begin
  inherited;
  if sDBTree1.Selected = nil then Exit;
  if sDBTree1.NodeOnMouseDown = sDBTree1.Selected then
    if sDBTree1.SelectedKey = '' then
    begin
      sDBTree1.ExpandFirstLevel;
      sDBTree1.RootNode.Expand(False);
    end;
end;

//***************************** SingleBillFrame ******************************//

procedure TTreeModelFrm.SingleBillFrame1BtnSaveClick(Sender: TObject);
var
  DataInsert : Boolean;
  ParentNode : TTreeNode;
  i : integer;
  Expanded : Boolean;
begin
  //此处仍有问题：
  //1。悬空节点的回收（新增/修改主键）
  //2。若修改了主键，其当前下级怎么办
  //解决方法：
  //1。不能删除有下级的节点
  //2。不能修改主键
  //以下为待改进！???
  //2’修改主键也可以，但必须
  //     或者只能修改最低级的主键
  //     或者同时修改下级的上级主键
  DataInsert := dsMast.DataSet.State in [dsInsert];
  inherited;
  if FDataDo = doLocate then
  begin
    //新增
    if DataInsert then
    begin
      ParentNode := sDBTree1.Selected;
      if ParentNode = sDBTree1.RootNode then
        sDBTree1.ExpandFirstLevel
      else begin
        sDBTree1.ExpandThisNode(ParentNode);
      end;
      ParentNode.Expand(False);
      sDBTree1.ExpandNextLevel(ParentNode);
    end
    //修改
    else if sDBTree1.SelectedKey =
      Trim(dsMast.DataSet.FieldByName(sDBTree1.KeyField).AsString) then
    begin
      ParentNode := sDBTree1.Selected.Parent;
      if ParentNode = sDBTree1.RootNode then
        sDBTree1.ExpandFirstLevel
      else begin
        sDBTree1.ExpandThisNode(ParentNode);
      end;
      ParentNode.Expand(False);
      sDBTree1.ExpandNextLevel(ParentNode);
    end
    else begin
      for i := 0 to sDBTree1.Items.Count - 1 do
      begin
        if sDBTree1.NodeKey(sDBTree1.Items[i]) =
          Trim(dsMast.DataSet.FieldByName(sDBTree1.UpKeyField).AsString) then
        begin
          ParentNode := sDBTree1.Items[i];
          Expanded := ParentNode.Expanded;
          if ParentNode = sDBTree1.RootNode then
            sDBTree1.ExpandFirstLevel
          else begin
            sDBTree1.ExpandThisNode(ParentNode);
          end;
          if Expanded then
          begin
            ParentNode.Expand(False);
            sDBTree1.ExpandNextLevel(ParentNode);
          end;
          Break;
        end;
      end;
    end;
  end;
end;

procedure TTreeModelFrm.SingleBillFrame1BtnDeleteClick(Sender: TObject);
var
  BookMark : TBookMark;
  HasChild : Boolean;
  Value : string;
  ParentValue : string;
  ParentNode : TTreeNode;
  i : integer;
  Expanded : Boolean;
begin
  //检查有无下级
  if FDataDo = doLocate then
  begin
    dsMast.DataSet.DisableControls;
    BookMark := dsMast.DataSet.GetBookmark;
    Value := TrimRight(dsMast.DataSet.FieldByName(sDBTree1.KeyField).AsString);
    Value := StrValueOfField(Value);
    HasChild := dsMast.DataSet.Locate(sDBTree1.UpKeyField,Value,[]);

    dsMast.DataSet.GotoBookmark(BookMark);
    dsMast.DataSet.FreeBookmark(BookMark);
    dsMast.DataSet.EnableControls;
    //如有下级，则不能删除
    if HasChild then
    begin
      Global.AccessDialog.ShowWarning('不能删除记录，因为它有下级！');
      Exit;
    end;
    //取得上级代码
    ParentValue := Trim(dsMast.DataSet.FieldByName(sDBTree1.UpKeyField).AsString);
  end;
  inherited;
  if FDataDo = doLocate then
  begin
    //有下级
    //此处仍有问题：
    //1。造成悬空节点
    //2。由于不能修改上级主键，悬空节点大都只有被逐级删除，被回收的机会很少
    //   因为那样，就不必删除原来的记录，只要修改即可
    //解决方法：
    //不能删除有下级的节点
    if HasChild then
    begin
      sDBTree1.ExpandFirstLevel;
      sDBTree1.RootNode.Expand(False);
    end
    //无下级，必要时刷新上级的下级
    else begin
      for i := 0 to sDBTree1.Items.Count - 1 do
      begin
        if sDBTree1.NodeKey(sDBTree1.Items[i]) = ParentValue then
        begin
          ParentNode := sDBTree1.Items[i];
          Expanded := ParentNode.Expanded;
          if ParentNode = sDBTree1.RootNode then
            sDBTree1.ExpandFirstLevel
          else begin
            sDBTree1.ExpandThisNode(ParentNode);
          end;
          if Expanded then
          begin
            ParentNode.Expand(False);
            sDBTree1.ExpandNextLevel(ParentNode);
          end;
          LocateData;
          Break;
        end;
      end;
    end;
  end;
end;

procedure TTreeModelFrm.SingleBillFrame1BtnNewClick(Sender: TObject);
begin
  //必须先换页，后继承！
  PageControl.ActivePageIndex := 1;
  inherited;
end;

procedure TTreeModelFrm.wwDBGrid1DblClick(Sender: TObject);
begin
  inherited;
  PageControl.ActivePageIndex := 1;
end;

end.