selectdepotfrm.pas

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

unit SelectDepotFrm;

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
  PDepotData = ^TDepotData;
  TDepotData = record
    DepotID   : Integer;
    DepotNo   : WideString;
    DepotName : WideString;
    LinkMan   : WideString;
    Tel       : WideString;
    Addr      : WideString;
    RankDepot : Boolean;
    StockUsable:Boolean;
    ReMark    : WideString;
  end;
  TFrmSelectDepot = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    DComm: TDCOMConnection;
    CdsSelectDepot: TckClientDataSet;
    DsSelectDepot: TDataSource;
    Label1: TLabel;
    edValue: TRzEdit;
    RzBitBtn2: TRzBitBtn;
    ImageList1: TImageList;
    RzBitBtn1: TRzBitBtn;
    vtDepots: TVirtualStringTree;
    CdsTemp: TckClientDataSet;
    CdsSelectDepotDepotID: TAutoIncField;
    CdsSelectDepotDepotNo: TStringField;
    CdsSelectDepotDepotName: TStringField;
    CdsSelectDepotLinkMan: TStringField;
    CdsSelectDepotTel: TStringField;
    CdsSelectDepotAddr: TStringField;
    CdsSelectDepotRankDepot: TBooleanField;
    CdsSelectDepotStockUsable: TBooleanField;
    CdsSelectDepotRemark: TStringField;
    ckViewHLine: TRzCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure RzBitBtn1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure vtDepotsGetNodeDataSize(Sender: TBaseVirtualTree;
      var NodeDataSize: Integer);
    procedure vtDepotsGetText(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: WideString);
    procedure RzBitBtn2Click(Sender: TObject);
    procedure ckViewHLineClick(Sender: TObject);
    procedure vtDepotsBeforeItemErase(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 vtDepotsDblClick(Sender: TObject);
    procedure vtDepotsKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure vtDepotsCollapsing(Sender: TBaseVirtualTree;
      Node: PVirtualNode; var Allowed: Boolean);
  private
    IFmMain:iMainForm;
    sDepotNoFmt: String;
    SvrDepot:TDispatchConnection;
    Procedure ShowDepot;
    function GetLevel(sFormat,sCode:String):Integer;
    procedure AssignNodeData(NodeData: PDepotData; DataSet: TDataSet);
  public
    AllowSelect: ShortInt;//0:允许选择虚拟或实物仓；-1:仅允许选虚拟分级仓；1:仅允许选实物仓
    SltNodeData: PDepotData;
  end;

var
  FrmSelectDepot: TFrmSelectDepot;

Function SelectDepot(var iDepotID:Integer; iSelectType: ShortInt=1): Boolean; overload;
Function SelectDepot(var iDepotID:Integer; var DepotNo, DepotName: String;
                     iSelectType: ShortInt=1):Boolean; overload;

implementation

{$R *.dfm}

Function SelectDepot(var iDepotID:Integer; iSelectType: ShortInt): Boolean; overload;
var str1, str2: String;
begin
  result := SelectDepot(iDepotID,Str1,Str2,iSelectType);
end;

//iSelectType: 0:允许选择虚拟或实物仓；-1:仅允许选虚拟分级仓；1:仅允许选实物仓
Function SelectDepot(Var iDepotID:Integer; var DepotNo, DepotName: String;
  iSelectType: ShortInt) :Boolean;
Begin
  Result := false;
  with TFrmSelectDepot.Create(nil) do begin
    if not(CdsSelectDepot.Active) then
      CdsSelectDepot.Open;
    AllowSelect := iSelectType;
    if ShowModal=mrOk then begin
      iDepotID := SltNodeData^.DepotID;
      DepotNo := SltNodeData^.DepotNo;
      DepotName:= SltNodeData^.DepotName;
      Result := true;
    end;
  End;
End;

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

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

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

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

function TFrmSelectDepot.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 TFrmSelectDepot.AssignNodeData(NodeData: PDepotData;
  DataSet: TDataSet);
begin
  with DataSet do begin
    NodeData^.DepotID     := FieldByName('DepotID').AsInteger;
    NodeData^.DepotNo     := FieldByName('DepotNo').AsString;
    NodeData^.DepotName   := FieldByName('DepotName').AsString;
    NodeData^.LinkMan     := FieldByName('LinkMan').AsString;
    NodeData^.Tel         := FieldByName('Tel').AsString;
    NodeData^.Addr        := FieldByName('Addr').AsString;
    NodeData^.RankDepot   := FieldByName('RankDepot').AsBoolean;
    NodeData^.StockUsable := FieldByName('StockUsable').AsBoolean;
    NodeData^.ReMark      := FieldByName('Remark').AsString;
  end;
end;

procedure TFrmSelectDepot.FormShow(Sender: TObject);
begin
  ShowDepot;
end;

procedure TFrmSelectDepot.vtDepotsGetNodeDataSize(
  Sender: TBaseVirtualTree; var NodeDataSize: Integer);
begin
  NodeDataSize := Sizeof(TDepotData);
end;

procedure TFrmSelectDepot.vtDepotsGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: WideString);
var Data: PDepotData;
begin
  CellText := '';
  Data := Sender.GetNodeData(Node);
  case Column of
    0://DepartNo
      CellText := Data^.DepotNo;
    1://DepartName
      CellText := Data^.DepotName;
    2://LinkMan
      CellText := Data^.LinkMan;
    3://Tel
      CellText := Data^.Tel;
    4://Addr
      CellText := Data^.Addr;
    5://RankStock
      Begin
        If Data^.RankDepot Then
          CellText := '是'
        Else
          CellText := '否';
      End;
    6://StockUsable
      Begin
        If Data^.StockUsable Then
          CellText := '能'
        Else
          CellText := '否';
      End;
    7://Remark
      CellTExt := '备注';
  end;
end;

procedure TFrmSelectDepot.RzBitBtn2Click(Sender: TObject);
var Node: PVirtualNode;
begin
  Node := vtDepots.GetFirstSelected;
  if (Node=nil)or(Node=vtDepots.GetFirst) then
    Exit;
  SltNodeData := vtDepots.GetNodeData(Node);
  if AllowSelect<>0 then begin
    if AllowSelect<0 then begin
      if not SltNodeData^.RankDepot then begin
        Application.MessageBox('请选择一个虚拟分级仓库，然后按[选定]按钮。', '消息', MB_ICONINFORMATION);
        Exit;
      end;
    end else begin
      if SltNodeData^.RankDepot then begin
        Application.MessageBox('请选择一个实物仓库，然后按[选定]按钮。', '消息', MB_ICONINFORMATION);
        Exit;
      end;
    end;
  end;
  ModalResult:=MrOK;
end;

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

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

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

procedure TFrmSelectDepot.edValueKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var vNode: PVirtualNode;
begin
  with vtDepots do begin
    vNode :=GetFirstSelected;
    if vNode = nil then vNode := GetFirst;
    if vNode = nil then exit;
    if Key=VK_UP then
    begin
      vNode :=GetPrevious(vNode);
      if vNode <> nil then Selected[vNode] := true;
      Key :=0;
    end
    else if Key=VK_DOWN then
    begin
      vNode := GetNext(vNode);
      if vNode <> nil then Selected[vNode] := true;
      Key :=0;
    end
    else if Key=VK_LEFT then
    begin
      if vtDepots.Expanded[vNode] then
      begin
        vtDepots.Expanded[vNode] := false;
        Key := 0;
      end;
    end
    else if Key=VK_RIGHT then
    begin
      if (not vtDepots.Expanded[vNode])and(vtDepots.ChildCount[vNode]>0) then
      begin
        vtDepots.Expanded[vNode] := true;
        Key := 0;
      end;
    end
  end;
end;

procedure TFrmSelectDepot.vtDepotsDblClick(Sender: TObject);
begin
  RzBitBtn2Click(RzBitBtn2);
end;

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

procedure TFrmSelectDepot.vtDepotsCollapsing(Sender: TBaseVirtualTree;
  Node: PVirtualNode; var Allowed: Boolean);
begin
  Allowed := vtDepots.GetNodeLevel(Node)>0;
end;

End.