base1info.pas

中小企业管理系统------ ERP系统原代码

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, KsSkinForms,
  KsSkinPanels, dxExEdtr, dxEdLib, dxEditor, StdCtrls, dxDBGrid, se_controls;

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.



//此源码由程序太平洋收集整理发布,任何人都可自由转载,但需保留本站信息
//╭⌒╮┅~ ¤　欢迎光临程序太平洋╭⌒╮
//╭⌒╭⌒╮╭⌒╮～╭⌒╮  ︶  ,︶︶
//,︶︶︶︶,''︶~~ ,''~︶︶　 ,''
//╔　╱◥███◣═╬╬╬╬╬╬╬╬╬╗
//╬ ︱田︱田 田 ︱　　　　　　　　　 ╬
//╬　　　　　　　http://www.5ivb.net ╬
//╬　 ╭○╮●　                   　╬
//╬　　/■\/■\　　                  ╬
//╬　　 <|　||　   有希望,就有成功！ ╬
//╬　　　　　　　　　　　　　　　　　╬
//╚╬╬╬╬╬╬╬╬╬╬╗  ╔╬╬╬╬╝
//
//说明：
//专业提供VB、．NET、Delphi、ASP、PB源码下载
//包括:程序源码,控件,商业源码,系统方案，开发工具，书籍教程，技术文档