base1info.pas

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

unit Base1Info;

interface

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

type
  TfrmBase1Info = class(TfrmListForm)
    treeMain: TdxDBTreeList;
    dsBaseInfo: TDataSource;
    ADOSetBaseInfo: TADODataSet;
    procedure bbEditClick(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 bbRefreshClick(Sender: TObject);
    procedure bbFindClick(Sender: TObject);
    procedure bbFilterClick(Sender: TObject);
    procedure bbSetColClick(Sender: TObject);
  private
    { Private declarations }
    sReturn: string;
    sSql, sField, sFieldCn, sCaption, sUniqueTab, sEditCol: string;
    lMode, lSelect: Integer;
    ADOSetBase: TADODataSet;
    procedure ToolShow;
    procedure LoadGrid;
    procedure MainShow;
    procedure LoadData;
  public
    { Public declarations }
    lParentID: Integer;
  end;

function Base1InfoShow(s1Sql, s1Field, s1FieldCn, s1UniqueTab, s1EditCol, s1Caption: string; l1Mode, l1Select: Integer): string;
//(SQL语句,数据库字段,表头字段,可编辑列,标题,过滤,唯一标识,是否有选择键)
implementation

{$R *.DFM}

function Base1InfoShow(s1Sql, s1Field, s1FieldCn, s1UniqueTab, s1EditCol, s1Caption: string; l1Mode, l1Select: Integer): string;
var
  frmBase1Info: TfrmBase1Info;
begin
  frmBase1Info := TfrmBase1Info.Create(Application);
  with frmBase1Info do
  begin
    sSql := s1Sql;
    lMode := l1Mode;
    sField := s1Field;
    sUniqueTab := s1UniqueTab;
    sEditCol := s1EditCol;
    sFieldCn := s1FieldCn;
    sCaption := s1Caption;
    lSelect := l1Select;
    sReturn := '';
    MainShow;
    Result := sReturn;
    Free;
  end;
end;

procedure TfrmBase1Info.MainShow;
begin
  if (sSql = '') or (sField = '') or (sFieldCn = '') then Exit;
  LoadGrid;
  LoadData;
  ToolShow;
  ShowModal;
  SetColWidth(Caption, TdxDBGrid(treeMain));
end;

procedure TfrmBase1Info.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, '');
  SetCol(Caption, TdxDBGrid(treeMain), 1);
end;

procedure TfrmBase1Info.LoadData;
begin
  ADOSetBase := ADOSetBaseInfo;
  OpenDataSet(ADOSetBase, sSql);
  if sUniqueTab <> '' then
  begin
    ADOSetBaseInfo.Recordset.Properties.Item['unique table'].Value := sUniqueTab;
  end;
end;

procedure TfrmBase1Info.ToolShow;
begin
  bbSelect.Enabled := true;
  bbEdit.Enabled := true;
  if treeMain.FocusedNode = nil then
  begin
    bbSelect.Enabled := false;
    bbEdit.Enabled := false;
  end;
end;

procedure TfrmBase1Info.bbEditClick(Sender: TObject);
begin
  inherited;
  if ADOSetBase.IsEmpty then Exit;
  ADOSetBase.Edit;
  if Base1InfoEditShow(treeMain, sEditCol, Caption, lMode) then
    SaveDataSet(ADOSetBase, True)
  else ADOSetBase.Cancel;
end;

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

procedure TfrmBase1Info.bbSelectClick(Sender: TObject);
begin
  inherited;
  if bbSelect.Visible = ivAlways then
  begin
    sReturn := ADOSetBaseInfo.FieldByName('Order').AsString;
    Close;
  end;
end;

procedure TfrmBase1Info.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 TfrmBase1Info.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 TfrmBase1Info.treeMainChangeNodeEx(Sender: TObject);
begin
  inherited;
  ToolShow;
end;

procedure TfrmBase1Info.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);
  end;
end;

procedure TfrmBase1Info.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 TfrmBase1Info.FormShow(Sender: TObject);
begin
  inherited;
  treeMain.SetFocus;
end;

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

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

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

procedure TfrmBase1Info.bbSetColClick(Sender: TObject);
begin
  inherited;
  SetCol(Caption, TdxDBGrid(treeMain), 0);
end;

end.