selectdepartfrm.pas

来自「医药连锁经营管理系统源码」· PAS 代码 · 共 358 行

unit SelectDepartFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, TFlatSpeedButtonUnit, ExtCtrls, RzStatus, TFlatPanelUnit,
  ActnList, ModuleAction, DB, DBClient, ckDBClient, MConnect, Grids,
  DBGridEh, DbUtilsEh, EhLibCDS, xEhLibCtl, StdCtrls, RzCmboBx, Mask, RzEdit, RzButton, ImgList,
  iMainFrm, DBCtrls, RzDBNav, RzPanel, VirtualTrees, RzRadChk;

type
  PDepartData = ^TDepartData;
  TDepartData = record
    DepartID  : Integer;
    DepartNo  : WideString;
    DepartName: WideString;
    IsCompany:  Boolean;
    Tel       : WideString;
    Fax       : WideString;
    Principal : WideString;
  end;
  TFrmSelectDepart = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    DComm: TDCOMConnection;
    CdsSelectDepart: TckClientDataSet;
    DsSelectDepart: TDataSource;
    Label1: TLabel;
    edValue: TRzEdit;
    RzBitBtn2: TRzBitBtn;
    ImageList1: TImageList;
    RzBitBtn1: TRzBitBtn;
    CdsSelectDepartDepartID: TAutoIncField;
    CdsSelectDepartDepartNo: TStringField;
    CdsSelectDepartDepartName: TStringField;
    CdsSelectDepartTel: TStringField;
    CdsSelectDepartFax: TStringField;
    CdsSelectDepartPrincipal: TStringField;
    vtDeparts: TVirtualStringTree;
    CdsTemp: TckClientDataSet;
    ckViewHLine: TRzCheckBox;
    CdsSelectDepartIsCompany: TBooleanField;
    procedure FormCreate(Sender: TObject);
    procedure RzBitBtn1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure vtDepartsGetNodeDataSize(Sender: TBaseVirtualTree;
      var NodeDataSize: Integer);
    procedure vtDepartsGetText(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: WideString);
    procedure RzBitBtn2Click(Sender: TObject);
    procedure ckViewHLineClick(Sender: TObject);
    procedure vtDepartsBeforeItemErase(Sender: TBaseVirtualTree;
      TargetCanvas: TCanvas; Node: PVirtualNode; ItemRect: TRect;
      var ItemColor: TColor; var EraseAction: TItemEraseAction);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edValueChange(Sender: TObject);
    procedure edValueKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure vtDepartsDblClick(Sender: TObject);
    procedure vtDepartsKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    IFmMain:iMainForm;
    sDepartNoFmt: String;
    SvrDepart:TDispatchConnection;
    Procedure ShowDepart;
    function GetLevel(sFormat,sCode:String):Integer;
    procedure AssignNodeData(NodeData: PDepartData; DataSet: TDataSet);
  public
    AllowSelect: ShortInt;//0:允许选择公司或部门；-1:仅允许选公司；1:仅允许选部门
    SltNodeData: PDepartData;
  end;

var
  FrmSelectDepart: TFrmSelectDepart;

Function SelectDepart(var iDepartID:Integer; iSelectType: ShortInt=0): Boolean; overload;
Function SelectDepart(var iDepartID:Integer; var DepartNo, DepartName: String;
                      iSelectType: ShortInt=0):Boolean; overload;


implementation

{$R *.dfm}
Function SelectDepart(var iDepartID:Integer; iSelectType: ShortInt): Boolean;
var str1, str2: String;
begin
  result := SelectDepart(iDepartID,Str1,Str2, iSelectType);
end;


Function SelectDepart(var iDepartID:Integer; var DepartNo, DepartName: String;
  iSelectType: ShortInt):Boolean;
Begin
  Result := false;
  with TFrmSelectDepart.Create(nil) do begin
    if not(CdsSelectDepart.Active) then
      CdsSelectDepart.Open;
    AllowSelect:= iSelectType;
    if ShowModal=mrOk then begin
      iDepartID  := SltNodeData^.DepartID;
      DepartNo   := SltNodeData^.DepartNo;
      DepartName := SltNodeData^.DepartName;
      Result := true;
    End;
  End;
End;

procedure TFrmSelectDepart.FormCreate(Sender: TObject);
begin
  IFmMain := (Application.MainForm as IMainForm);
  SvrDepart := IFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  CdsSelectDepart.RemoteServer := SvrDepart;
  cdsTemp.RemoteServer := SvrDepart;
end;

procedure TFrmSelectDepart.RzBitBtn1Click(Sender: TObject);
begin
  Close;
end;

procedure TFrmSelectDepart.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TFrmSelectDepart.ShowDepart;
var sDepartNo: String;
    h, Level:Integer;    //h为部门编号级数,Level为级数的位数;
    NodeData: PDepartData;
    vNodes:Array of PVirtualNode; //保存各级节点
    Node: PVirtualNode;
begin
  if sDepartNoFmt='' then Begin   //获取部门编号格式
    with cdsTemp do Begin
      Close;
      CommandText := 'SELECT DepartNoFormat FROM SysSetting ';
      Open;
      sDepartNoFmt := Fields[0].AsString;
    end;
    h := Length(sDepartNoFmt);
    SetLength(vNodes, h+1);
    Screen.Cursor:=crHourGlass;
  End;
  vtDeparts.Clear;
  //以下是增加第一项
  Level:=0;
  vtDeparts.RootNodeCount := 1;
  Node := vtDeparts.GetFirst;
  NodeData := vtDeparts.GetNodeData(Node);
  NodeData^.DepartNo := '所有部门(公司)资料';
  vNodes[Level] := Node;
  //以上是增加第一项
  With CdsSelectDepart do begin
    try
      IndexFieldNames := 'DepartNo';
      if Active then
        Refresh
      else
        Open;
      First;
      While Not Eof do begin
        sDepartNo := Trim(FieldByName('DepartNo').AsString);
        Level:=GetLevel(sDepartNoFmt, sDepartNo); //返回当前部门编号的级数;
        //以下是增加子项;用上一级节点为父节点添加子节点
        if Level>0 then begin
          Node := vtDeparts.AddChild(vNodes[Level-1]);
          NodeData := vtDeparts.GetNodeData(Node);
          AssignNodeData(NodeData, cdsSelectDepart);
          vNodes[Level] := Node;
        end;
        //以上是增加子项
        Next;
      end;
    finally
      Screen.Cursor:=crDefault;
    end;
  end;
  vtDeparts.FullExpand;
//  vtDeparts.Expanded[vNodes[0]] := true;//将首节点展开
end;

function TFrmSelectDepart.GetLevel(sFormat, sCode: String): Integer;
var i,Level,iLen:Integer;
begin
  Level:=-1;//如果代码不符合标准，则返回-1
  iLen:=0;
  if (sFormat<>'')and(sCode<>'')then
    for i:=1 to Length(sFormat) do begin
      iLen := iLen+StrToInt(sFormat[i]);
      if Length(sCode)=iLen then begin
        Level:=i;
        Break;
      end;
    end;
  Result:=Level;
end;

procedure TFrmSelectDepart.AssignNodeData(NodeData: PDepartData;
  DataSet: TDataSet);
begin
  with DataSet do begin
    NodeData^.DepartID    := FieldByName('DepartID').AsInteger;
    NodeData^.DepartNo    := FieldByName('DepartNo').AsString;
    NodeData^.DepartName  := FieldByName('DepartName').AsString;
    NodeData^.IsCompany   := FieldByName('IsCompany').AsBoolean;
    NodeData^.Fax         := FieldByName('Fax').AsString;
    NodeData^.Tel         := FieldByName('Tel').AsString;
    NodeData^.Principal   := FieldByName('Principal').AsString;
  end;
end;

procedure TFrmSelectDepart.FormShow(Sender: TObject);
begin
  ShowDepart;
end;

procedure TFrmSelectDepart.vtDepartsGetNodeDataSize(
  Sender: TBaseVirtualTree; var NodeDataSize: Integer);
begin
  NodeDataSize := Sizeof(TDepartData);
end;

procedure TFrmSelectDepart.vtDepartsGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: WideString);
var Data: PDepartData;
begin
  CellText := '';
  Data := Sender.GetNodeData(Node);
  case Column of
    0://DepartNo
      CellText := Data^.DepartNo;
    1://DepartName
      CellText := Data^.DepartName;
    2://Tel
      CellText := Data^.Tel;
    3://Fax
      CellText := Data^.Fax;
    4://Principal
      CellText := Data^.Principal;
  end;
end;

procedure TFrmSelectDepart.RzBitBtn2Click(Sender: TObject);
var Node: PVirtualNode;
begin
  Node := vtDeparts.GetFirstSelected;
  if (Node=nil)or(Node=vtDeparts.GetFirst) then
    Exit;
  SltNodeData := vtDeparts.GetNodeData(Node);
  if AllowSelect<>0 then begin
    if AllowSelect<0 then begin
      if not SltNodeData^.IsCompany then begin
        Application.MessageBox('你选择的是部门记录，请选择一公司记录后再执行此操作！', '消息', MB_ICONINFORMATION);
        Exit;
      end;
    end else begin
      if SltNodeData^.IsCompany then begin
        Application.MessageBox('你选择的是公司记录，请选择一部门记录后再执行此操作！', '消息', MB_ICONINFORMATION);
        Exit;
      end;
    end;
  end;
  ModalResult:=MrOK;
end;

procedure TFrmSelectDepart.ckViewHLineClick(Sender: TObject);
begin
  if ckViewHLine.Checked then
    vtDeparts.TreeOptions.PaintOptions := vtDeparts.TreeOptions.PaintOptions+[toShowHorzGridLines]
  else
    vtDeparts.TreeOptions.PaintOptions := vtDeparts.TreeOptions.PaintOptions-[toShowHorzGridLines];
end;

procedure TFrmSelectDepart.vtDepartsBeforeItemErase(
  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 TFrmSelectDepart.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=27 then close;
end;

procedure TFrmSelectDepart.edValueChange(Sender: TObject);
Var Str : String;
    Node, pNode: PVirtualNode ;
    Data: PDepartData;
begin
  Str := Trim(edValue.Text);
  If Str<>'' Then Begin
    Node := vtDeparts.GetFirst;
    while Node<>nil do begin
      Data := vtDeparts.GetNodeData(Node);
      if (Data^.DepartNo=str)or(AnsiPos(str, Data^.DepartName)=1) then begin
        pNode := Node.Parent;
        while vtDeparts.GetNodeLevel(pNode)>0 do begin
          vtDeparts.Expanded[pNode] := true;
          pNode := pNode.Parent;
        end;
        vtDeparts.Selected[Node] := true;
        Break;
      end;
      Node:=vtDeparts.GetNext(Node);
    End;
  End;
end;

procedure TFrmSelectDepart.edValueKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var vNode: PVirtualNode;
begin
  vNode :=vtDeparts.GetFirstSelected;
  if vNode = nil then vNode := vtDeparts.GetFirst;
  if vNode = nil then exit;
  
  if Key=VK_UP then begin
    vNode :=vtDeparts.GetPrevious(vNode);
    if vNode <> nil then vtDeparts.Selected[vNode] := true;
    Key :=0;
  end;
  if Key=VK_DOWN then begin
    vNode := vtDeparts.GetNext(vNode);
    if vNode <> nil then vtDeparts.Selected[vNode] := true;
    Key :=0;
  end;
end;

procedure TFrmSelectDepart.vtDepartsDblClick(Sender: TObject);
begin
  RzBitBtn2Click(RzBitBtn2);
end;

procedure TFrmSelectDepart.vtDepartsKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=13 then begin
    edValue.SetFocus ;
    key :=0;
  end;
end;

End.