baseinfo.pas

胜天财务进销存2003源代码,SQLSERVER版,目前最完整的财务进销存系统.

unit BaseInfo;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ListForm, ImgList, ExtCtrls, dxCntner, dxTL, SysPublic,
  dxDBCtrl, dxDBTL, BaseInfoEdit, DBData, Db, ADODB, Menus, dxBar,
  dxBarExtItems, KsHooks, KsForms, KsSkinForms, KsControls, KsPanels,
  KsSkinPanels, dxExEdtr, dxEdLib, dxEditor, StdCtrls;

type
  TfrmBaseInfo = class(TfrmListForm)
    treeMain: TdxDBTreeList;
    dsBaseInfo: TDataSource;
    ADOSetBaseInfo: TADODataSet;
    procedure bbAddClick(Sender: TObject);
    procedure bbEditClick(Sender: TObject);
    procedure bbDelClick(Sender: TObject);
    procedure bbSubClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure bbSelectClick(Sender: TObject);
    procedure treeMainGetImageIndex(Sender: TObject; Node: TdxTreeListNode;
      var Index: Integer);
    procedure treeMainGetSelectedIndex(Sender: TObject;
      Node: TdxTreeListNode; var Index: Integer);
    procedure treeMainChangeNodeEx(Sender: TObject);
    procedure treeMainKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure treeMainDblClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ADOSetBaseInfoAfterInsert(DataSet: TDataSet);
    procedure bbRefreshClick(Sender: TObject);
    procedure bbFindClick(Sender: TObject);
    procedure bbFilterClick(Sender: TObject);
  private
    { Private declarations }
    sReturn, sFilter: string;
    sSql, sField, sFieldCn, sCaption, sCbxStr: string;
    lMode, lSelect: Integer;
    ADOSetBase: TADODataSet;
    function FilterData: Integer;
    procedure ToolShow;
    procedure LoadGrid;
    procedure MainShow;
    procedure LoadData;
  public
    { Public declarations }
    lParentID: Integer;
  end;

function BaseInfoShow(s1Sql, s1Field, s1FieldCn, s1CbxStr, s1Caption, sFilter1:
  string; l1Mode, l1Select: Integer): string;
//(SQL语句,数据库字段,表头字段,ComboBox可选项,标题,过滤,唯一标识,是否有选择键)
implementation

{$R *.DFM}

function BaseInfoShow(s1Sql, s1Field, s1FieldCn, s1CbxStr, s1Caption, sFilter1:
  string; l1Mode, l1Select: Integer): string;
var
  frmBaseInfo: TfrmBaseInfo;
begin
  frmBaseInfo := TfrmBaseInfo.Create(Application);
  with frmBaseInfo do
  begin
    sSql := s1Sql;
    lMode := l1Mode;
    sField := s1Field;
    sCbxStr := s1CbxStr;
    sFieldCn := s1FieldCn;
    sCaption := s1Caption;
    sFilter := sFilter1;
    lSelect := l1Select;
    sReturn := '';
    MainShow;
    Result := sReturn;
    Free;
  end;
end;

procedure TfrmBaseInfo.MainShow;
begin
  if (sSql = '') or (sField = '') or (sFieldCn = '') then
    Exit;
  LoadGrid;
  LoadData;
  FilterData;
  ToolShow;
  if (lSelect = 1) then FilterData;
  ShowModal; //如果就选取择又只有一条记录就直接返回
end;

procedure TfrmBaseInfo.LoadGrid;
begin
  Caption := sCaption;
  if lSelect = 0 then
  begin
    bbSelect.Visible := ivNever;
    bbDel.Visible := ivAlways;
  end
  else
  begin
    bbDel.Visible := ivNever;
    bbSelect.Visible := ivAlways;
  end;
  StrToTreeField(treeMain, sField, sFieldCn, '');
end;

function TfrmBaseInfo.FilterData: Integer;
var
  s1: string;
begin
  Result := 0;
  if sFilter = '' then
    ADOSetBaseInfo.Filtered := false
  else
    ADOSetBaseInfo.Filtered := True;
  if sFilter <> '' then
  begin
    s1 := 'Name1 Like ''*' + sFilter + '*''';
  end
  else
    s1 := '';
  try
    ADOSetBaseInfo.Filter := s1;
    Result := ADOSetBaseInfo.RecordCount;
  except
    Exit;
  end;
end;

procedure TfrmBaseInfo.LoadData;
begin
  ADOSetBase := ADOSetBaseInfo;
  OpenDataSet(ADOSetBase, sSql);
end;

procedure TfrmBaseInfo.ToolShow;
begin
  bbSelect.Enabled := true;
  bbSub.Enabled := true;
  bbEdit.Enabled := true;
  bbDel.Enabled := true;
  if treeMain.FocusedNode = nil then
  begin
    bbSelect.Enabled := false;
    bbSub.Enabled := false;
    bbEdit.Enabled := false;
    bbDel.Enabled := false;
  end
  else
  begin
    if treeMain.FocusedNode.HasChildren then
      bbDel.Enabled := false;
  end;
end;

procedure TfrmBaseInfo.bbAddClick(Sender: TObject);
begin
  inherited;
  if ADOSetBase.FieldByName('TreeParent').IsNull then
    lParentID := -1
  else
    lParentID := ADOSetBase.FieldByName('TreeParent').AsInteger;
  ADOSetBase.Filter := '';
  ADOSetBase.Last;
  ADOSetBase.Insert;
  if BaseInfoEditShow(treeMain, sCbxStr, Caption, lMode) then
    SaveDataSet(ADOSetBase, false)
  else
  begin
    ADOSetBase.Cancel;
  end;
end;

procedure TfrmBaseInfo.bbEditClick(Sender: TObject);
begin
  inherited;
  if ADOSetBase.IsEmpty then
    exit;
  if ADOSetBase.FieldByName('TreeParent').IsNull then
    lParentID := -1
  else
    lParentID := ADOSetBase.FieldByName('TreeParent').AsInteger;
  ADOSetBase.Edit;
  if BaseInfoEditShow(treeMain, sCbxStr, Caption, lMode) then
    SaveDataSet(ADOSetBase, false)
  else
    ADOSetBase.Cancel;
end;

procedure TfrmBaseInfo.bbDelClick(Sender: TObject);
begin
  inherited;
  if ADOSetBase.IsEmpty then
    exit;
  if treeMain.FocusedNode.HasChildren then
  begin
    MsgBox('此节点是分类不能删除，请先删除分类里的数据。', '提示', MB_OK);
    Exit;
  end;
  if MsgBox('数据删除后不可恢复，确认要删除？', '提示', MB_OKCancel) = IDOK then
    ADOSetBase.Delete;
end;

procedure TfrmBaseInfo.bbSubClick(Sender: TObject);
begin
  inherited;
  lParentID := TdxDBTreeListNode(treeMain.FocusedNode).Id;
  ADOSetBase.Last;
  ADOSetBase.Insert;
  if BaseInfoEditShow(treeMain, sCbxStr, Caption, lMode) then
    SaveDataSet(ADOSetBase, false)
  else
    ADOSetBase.Cancel;
end;

procedure TfrmBaseInfo.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  inherited;
  if ADOSetBase.Active = true then
    ADOSetBase.Close;
end;

procedure TfrmBaseInfo.bbSelectClick(Sender: TObject);
begin
  inherited;
  if bbSelect.Visible = ivAlways then
  begin
    sReturn := treeMain.FocusedField.AsString;
    Close;
  end;
end;

procedure TfrmBaseInfo.treeMainGetImageIndex(Sender: TObject;
  Node: TdxTreeListNode; var Index: Integer);
const
  ImagesIndex: array[Boolean] of Integer = (16, 17);
begin
  inherited;
  if Node.HasChildren then
    Index := ImagesIndex[Node.Expanded]
  else
    Index := 16;
end;

procedure TfrmBaseInfo.treeMainGetSelectedIndex(Sender: TObject;
  Node: TdxTreeListNode; var Index: Integer);
const
  ImagesIndex: array[Boolean] of Integer = (16, 17);
begin
  inherited;
  if Node.HasChildren then
    Index := ImagesIndex[Node.Expanded]
  else
    Index := 16;
end;

procedure TfrmBaseInfo.treeMainChangeNodeEx(Sender: TObject);
begin
  inherited;
  ToolShow;
end;

procedure TfrmBaseInfo.treeMainKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  case KEY of
    VK_RETURN:
      begin
        if bbSelect.Visible = ivAlways then
        begin
          if bbSelect.Enabled then
            bbSelectClick(nil);
        end
        else
          bbEditClick(nil);
      end;
    VK_ESCAPE: bbExitClick(nil);
    VK_INSERT: bbAddClick(nil);
    VK_DELETE: bbDelClick(nil);
  end;
end;

procedure TfrmBaseInfo.treeMainDblClick(Sender: TObject);
begin
  inherited;
  if not treeMain.FocusedNode.HasChildren then
  begin
    if bbSelect.Visible = ivAlways then
      bbSelectClick(nil)
    else
      bbEditClick(nil);
  end;
end;

procedure TfrmBaseInfo.FormShow(Sender: TObject);
begin
  inherited;
  treeMain.SetFocus;
end;

procedure TfrmBaseInfo.ADOSetBaseInfoAfterInsert(DataSet: TDataSet);
begin
  inherited;
  DataSet.FieldByName('TreeParent').AsInteger := lParentID;
end;

procedure TfrmBaseInfo.bbRefreshClick(Sender: TObject);
begin
  inherited;
  ADOSetBaseInfo.Filter := '';
end;

procedure TfrmBaseInfo.bbFindClick(Sender: TObject);
begin
  inherited;
  FindPublic(treeMain, sPubFindText, lPubFindFiled);
end;

procedure TfrmBaseInfo.bbFilterClick(Sender: TObject);
begin
  inherited;
  FilterPublic(treeMain);
end;

end.