viewdbworklogfrm.~pas

来自「群星医药系统源码」· ~PAS 代码 · 共 412 行

unit ViewDBWorkLogFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, VirtualTrees, ExtCtrls, Grids, DBGridEh, DbUtilsEh, EhLibCDS, xEhLibCtl, RzSplit,
  RzButton, StdCtrls, RzCmboBx, Mask, RzEdit, RzPanel, ComCtrls, RzDTP,
  RzRadChk, ActnList, ImgList, DB, DBClient, MConnect, SConnect, ckDBClient,
  xBaseFrm, IMainFrm, SelectEmpFrm, RzBtnEdt, ceGlobal;

type
  PWorkLogData = ^TWorkLogData;
  TWorkLogData = record
    WorkDate:   TDateTime;
    UserID:     WideString;
    UserName:   WideString;
    WorkType:   String[1];
    WorkTable:  WideString;
    TableDescribe: WideString;
    KeyFields:     WideString;
    KeyFieldValues:WideString;
    WorkRecNo:     Integer;
    Remark:      wideString;
  end;

  TFmViewDBWorkLog = class(TxBaseForm)
    plTop: TRzPanel;
    RzBitBtn1: TRzBitBtn;
    plClient: TRzPanel;
    plDetail: TRzSizePanel;
    Label5: TLabel;
    xDBGridEh1: TxDBGridEh;
    Panel1: TPanel;
    vtWorkLog: TVirtualStringTree;
    ImageList1: TImageList;
    ActionList1: TActionList;
    ActExit: TAction;
    ActFirst: TAction;
    ActPrior: TAction;
    ActNext: TAction;
    ActLast: TAction;
    ActRefersh: TAction;
    ActQuery: TAction;
    plCtrl: TRzPanel;
    RzBitBtn2: TRzBitBtn;
    RzBitBtn3: TRzBitBtn;
    RzBitBtn4: TRzBitBtn;
    RzBitBtn5: TRzBitBtn;
    RzBitBtn6: TRzBitBtn;
    BtnMoreRec: TRzBitBtn;
    ActMore: TAction;
    ActViewDetail: TAction;
    RzGroupBox1: TRzGroupBox;
    cbWorkType: TRzComboBox;
    cbWorkTable: TRzComboBox;
    edKeyValues: TRzEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label7: TLabel;
    DTCtrl1: TRzDateTimePicker;
    DTCtrl2: TRzDateTimePicker;
    Label8: TLabel;
    BtnViewDetail: TRzBitBtn;
    Label9: TLabel;
    cdsWorkLog: TckClientDataSet;
    DataSource1: TDataSource;
    cdsWorkDetail: TckClientDataSet;
    edGetRecCount: TRzNumericEdit;
    ckAutoViewDetail: TRzCheckBox;
    Label6: TLabel;
    cdsLogObjects: TckClientDataSet;
    edUserID: TRzButtonEdit;
    procedure plCtrlResize(Sender: TObject);
    procedure ActExitExecute(Sender: TObject);
    procedure ActQueryExecute(Sender: TObject);
    procedure ActFirstExecute(Sender: TObject);
    procedure ActPriorExecute(Sender: TObject);
    procedure ActNextExecute(Sender: TObject);
    procedure ActLastExecute(Sender: TObject);
    procedure ActMoreExecute(Sender: TObject);
    procedure ActViewDetailExecute(Sender: TObject);
    procedure vtWorkLogGetNodeDataSize(Sender: TBaseVirtualTree;
      var NodeDataSize: Integer);
    procedure vtWorkLogGetText(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: WideString);
    procedure vtWorkLogBeforeItemErase(Sender: TBaseVirtualTree;
      TargetCanvas: TCanvas; Node: PVirtualNode; ItemRect: TRect;
      var ItemColor: TColor; var EraseAction: TItemEraseAction);
    procedure vtWorkLogExpanding(Sender: TBaseVirtualTree;
      Node: PVirtualNode; var Allowed: Boolean);
    procedure vtWorkLogChange(Sender: TBaseVirtualTree;
      Node: PVirtualNode);
    procedure vtWorkLogDblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure edUserIDButtonClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    IFmMain: IMainForm;
    LastRecNo, CurrRecNo: Integer;
    sqWhere: String;
    procedure BuildNodeByDataSet(DataSet: TDataSet; pNode: PVirtualNode);
    procedure AssignNodeData(Data: PWorklogData; DataSet: TDataSet);
    procedure ViewDetail;
    function SeparateTableName(S: string): string;
  protected
    SvrSysManage: TDispatchConnection;
  public
    { Public declarations }
  end;

const
  cWorkTypes = 'IUDAR';
  cTypeDescr: Array[0..5] of string=('', '新增记录', '修改数据', '删除记录', '审核过帐', '取消过帐');
  sqFields = ' FDate, UserID, UserName, WorkType, TableDescribe, KeyFields, KeyFieldValues, Remark, WorkRecNo, '
            +'case when exists(select 1 from DBWorkLog l where l.hostrecno=w.workrecno) then 1 else 0 end HasChild '
            +'from DBWorkLog W ';

var
  FmViewDBWorkLog: TFmViewDBWorkLog;

implementation

{$R *.dfm}

procedure TFmViewDBWorkLog.FormCreate(Sender: TObject);
var iMaxDropWidth,w: integer;
begin
  DTCtrl1.Date := Date;
  DTCtrl2.Date := Date;
  IFmMain := Application.MainForm as IMainForm;
  SvrSysManage := IFmMain.GetConnection(Handle, '', 'ckSysManager.ModuleSetting');
  cdsWorklog.RemoteServer := SvrSysManage;
  cdsWorkDetail.RemoteServer := SvrSysManage;
  with cdsLogObjects do begin
    RemoteServer := SvrSysManage;
    Open;
    iMaxDropWidth :=0;
    cbWorkTable.Add('');
    while not Eof do begin
      if Eof then break;
      with cbWorkTable do begin
        Items.Add(Fields[0].AsString);
        w := Canvas.TextWidth(Fields[0].AsString);
        if w >iMaxDropWidth then iMaxDropWidth := w;
      end;
      Next;
    end;
    if iMaxDropWidth > 0 then cbWorkTable.DropDownWidth := iMaxDropWidth+20;
    Close;
  end;
end;

procedure TFmViewDBWorkLog.FormShow(Sender: TObject);
begin
//  plTop.Color := TitlePanelColor ;
  Color := FormBackColor ;
  vtWorkLog.Header.Background := GridFixColor;
  xDBGridEh1.FixedColor := GridFixColor;
end;

procedure TFmViewDBWorkLog.vtWorkLogBeforeItemErase(
  Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode;
  ItemRect: TRect; var ItemColor: TColor;
  var EraseAction: TItemEraseAction);
begin
//同一级的各节点间用颜色背景分隔
  if Odd(Node.Index) then begin
    ItemColor := $FFEEEE;
    EraseAction := eaColor;
  end;
end;

procedure TFmViewDBWorkLog.plCtrlResize(Sender: TObject);
var i, j: Integer;
begin
  j := BtnMoreRec.Left+BtnMoreRec.Width+4;
  i := plCtrl.Width-BtnViewDetail.Width-4;
  if i<j then i:=j;
  BtnViewDetail.Left := i;
end;

procedure TFmViewDBWorkLog.ActExitExecute(Sender: TObject);
begin
  Close;
end;

procedure TFmViewDBWorkLog.ActQueryExecute(Sender: TObject);
var sw: String;
begin
 	sw := ' WHERE FDATE>='''+FormatDateTime('yyyy-mm-dd', DTCtrl1.Date)
  		 +''' AND FDATE<'''+FormatDateTime('yyyy-mm-dd', DTCtrl2.Date+1)+'''';
  if edUserID.Text<>'' then
    sw := sw+' AND UserID='''+edUserID.Text+'''';
  if cbWorkType.ItemIndex>0 then
    sw := sw+' AND WorkType='''+cWorkTypes[cbWorkType.ItemIndex]+'''';
  if cbWorkTable.Text <> '' then
    sw := sw+' AND WorkTable=''' + SeparateTableName(cbWorkTable.Text)+'''';
  if edKeyValues.Text<>'' then
    sw := sw+' AND KeyFieldValues='''+edKeyValues.Text+'''';
  sqWhere := sw;
  LastRecNo := 0;
  ActMore.Enabled := true;
  ActMore.Execute;
end;

procedure TFmViewDBWorkLog.ActFirstExecute(Sender: TObject);
begin
  if vtWorkLog.RootNodeCount=0 then Exit;
  vtWorklog.Selected[vtWorklog.GetFirst] := true;
end;

procedure TFmViewDBWorkLog.ActPriorExecute(Sender: TObject);
var Node: PVirtualNode;
begin
  Node := vtWorklog.GetFirstSelected;
  if Node=nil then Exit;
  Node := vtWorklog.GetPreviousSibling(Node);
  if Node<>nil then
    vtWorklog.Selected[Node] := true;
end;

procedure TFmViewDBWorkLog.ActNextExecute(Sender: TObject);
var Node: PVirtualNode;
begin
  Node := vtWorklog.GetFirstSelected;
  if Node=nil then Exit;
  Node := vtWorklog.GetNextSibling(Node);
  if Node<>nil then
    vtWorklog.Selected[Node] := true;
end;

procedure TFmViewDBWorkLog.ActLastExecute(Sender: TObject);
begin
  if vtWorkLog.RootNodeCount=0 then Exit;
  vtWorklog.Selected[vtWorklog.GetLast] := true;
end;

procedure TFmViewDBWorkLog.ActMoreExecute(Sender: TObject);
var str: String;
    i, j: Integer;
begin
  str := ' AND HostRecNo=0';
  if LastRecNo=0 then
    vtWorkLog.Clear
  else
    str := str+' AND WorkRecNo>'+IntToStr(LastRecNo);
  i := edGetRecCount.IntValue;
  str := 'select top '+IntToStr(i)+sqFields+sqWhere+str+' order by WorkRecNo';
  with cdsWorkLog do begin
    Close;
    CommandText := str;
    Open;
    j := RecordCount;
    if j>0 then begin
      Last;
      LastRecNo := FieldByName('WorkRecNo').AsInteger;
    end;
    ActMore.Enabled := j=i;
  end;
  BuildNodeByDataSet(cdsWorkLog, vtWorklog.RootNode);
end;

procedure TFmViewDBWorkLog.ActViewDetailExecute(Sender: TObject);
begin
  if plDetail.HotSpotClosed then
    plDetail.RestoreHotSpot
  else
    plDetail.CloseHotSpot;
end;

procedure TFmViewDBWorkLog.vtWorkLogGetNodeDataSize(
  Sender: TBaseVirtualTree; var NodeDataSize: Integer);
begin
  NodeDataSize := SizeOf(TWorkLogData);
end;

procedure TFmViewDBWorkLog.BuildNodeByDataSet(DataSet: TDataSet;
  pNode: PVirtualNode);
var vNode: PVirtualNode;
    NodeData: PWorklogData;
begin
  with DataSet do begin
    First;
    While not Eof do begin
      vNode := vtWorklog.AddChild(pNode);
      NodeData := vtWorklog.GetNodeData(vNode);
      AssignNodeData(NodeData, DataSet);
      vtWorkLog.HasChildren[vNode] := DataSet.FieldByName('HasChild').Value;
      Next;
    end;
  end;
end;

procedure TFmViewDBWorkLog.AssignNodeData(Data: PWorklogData;
  DataSet: TDataSet);
begin
  with DataSet do begin
    Data^.WorkDate  := FieldByName('FDate').Value;
    Data^.UserID    := FieldByName('UserID').Value;
    Data^.UserName  := FieldByName('UserName').Value;
    Data^.WorkType  := FieldByName('WorkType').AsString;
    Data^.WorkTable := '';//FieldByName('WorkTable').Value;
    Data^.TableDescribe := FieldByName('TableDescribe').Value;
    Data^.KeyFields     := FieldByName('KeyFields').Value;
    Data^.KeyFieldValues:= FieldByName('KeyFieldValues').Value;
    Data^.WorkRecNo     := FieldByName('WorkRecNo').Value;
    Data^.Remark        := FieldByName('Remark').AsString;
  end;
end;

procedure TFmViewDBWorkLog.vtWorkLogGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: WideString);
var NodeData: PWorklogData;
    i: integer;
begin
  CellText := '';
  NodeData := Sender.GetNodeData(Node);
  case Column of
    0://FDate
      if Node.Parent=vtWorklog.RootNode then
        CellText := DateTimeToStr(NodeData^.WorkDate);
    1: //UserID
      CellText := NodeData^.UserID;
    2: begin//WorkType
      i := AnsiPos(NodeData^.WorkType, cWorktypes);
      if i>0 then
        CellText := cTypeDescr[i]
      else
        CellText := '';
    end;
    3: //WorkTable
      CellText := NodeData^.TableDescribe;
    4: //KeyFields
      CellText := NodeData^.KeyFields;
    5: //KeyFieldValues
      CellText := NodeData^.KeyFieldValues;
    6: //remark
      CellText := NodeData^.Remark;
  end;
end;

procedure TFmViewDBWorkLog.vtWorkLogExpanding(Sender: TBaseVirtualTree;
  Node: PVirtualNode; var Allowed: Boolean);
var NodeData: PWorklogData;
    str: String;
begin
  if Sender.ChildCount[Node]>0 then Exit;
  NodeData := Sender.GetNodeData(Node);
  str := 'select '+sqFields+' where HostRecNo='+IntToStr(NodeData^.WorkRecNo);
  with cdsWorkLog do begin
    Close;
    CommandText := str;
    Open;
    Allowed := not IsEmpty;
  end;
  if Allowed then
    BuildNodeByDataSet(cdsWorkLog, Node);
end;

procedure TFmViewDBWorkLog.vtWorkLogChange(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
var NodeData: PWorklogData;
begin
  if Node=nil then Exit;
  NodeData := Sender.GetNodeData(Node);
  CurrRecNo:= NodeData.WorkRecNo;
  if ckAutoViewDetail.Checked then
    ViewDetail;
end;

procedure TFmViewDBWorkLog.vtWorkLogDblClick(Sender: TObject);
begin
  if vtWorkLog.GetFirstSelected<>nil then
    ViewDetail;
end;

procedure TFmViewDBWorkLog.ViewDetail;
begin
  with cdsWorkDetail do begin
    if Tag=CurrRecNo then Exit;
    close;
    CommandText := 'select FieldName, OldValue, NewValue from DBWorkDetail where WorkRecNo='+IntToStr(CurrRecNo);
    Open;
    Tag := CurrRecNo;
  end;
end;

procedure TFmViewDBWorkLog.edUserIDButtonClick(Sender: TObject);
var EmpNo: string;
begin
  if SelectEmp(EmpNo) then edUserID.Text := EmpNo;
end;

function TFmViewDBWorkLog.SeparateTableName(S: string): string;
begin
  Result := S;
  if Pos('(',Result)>0 then Delete(Result,Pos('(',Result),Length(S));
end;

initialization
  RegisterClass(TFmViewDBWorkLog);

finalization
  UnRegisterClass(TFmViewDBWorkLog);

end.