selectinfo.pas

医药连锁经营管理系统源码

unit selectinfo;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, VirtualTrees, ActnList, ModuleAction, DB, DBClient, MConnect,
  ImgList, ExtCtrls, RzButton, RzBorder,xBaseFrm,iMainFrm;

type
  pNodeData=^tdptinfo;
  tdptinfo=record
    DepartNo:widestring;
    DepartName:widestring;
  end;
  TFrmSecInfo = class(TXbaseForm)
    Panel1: TPanel;
    Panel2: TPanel;
    cdssetting: TClientDataSet;
    cdsdepart: TClientDataSet;
    dcomcn: TDCOMConnection;
    ActionList1: TActionList;
    fresh: TModlAction;
    addditem: TModlAction;
    editem: TModlAction;
    delitem: TModlAction;
    finditem: TModlAction;
    pntitem: TModlAction;
    closewnd: TModlAction;
    vstree: TVirtualStringTree;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure vstreeBeforeItemErase(Sender: TBaseVirtualTree;
      TargetCanvas: TCanvas; Node: PVirtualNode; ItemRect: TRect;
      var ItemColor: TColor; var EraseAction: TItemEraseAction);
    procedure vstreeGetNodeDataSize(Sender: TBaseVirtualTree;
      var NodeDataSize: Integer);
    procedure vstreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: WideString);
    procedure newfresh;
    procedure vstreeDblClick(Sender: TObject);
    function GetLevel(sFormat,sCode:String):Integer;
    procedure AssignNodeData(NodeData: pNodeData; DataSet: TDataSet);
  private
    { Private declarations }
  public
    SvrDepotInfo: TDispatchConnection;
    class function ClassDo(iType: Byte;Value: Variant): Variant;
  end;

var
  FrmSecInfo: TFrmSecInfo;

implementation

{$R *.dfm}
procedure TFrmSecInfo.AssignNodeData(NodeData: pNodeData; DataSet: TDataSet);
begin
  with DataSet do begin
    nodedata^.departno   := FieldByName('departno').AsString;
    NodeData^.departname := FieldByName('departname').AsString;
  end;
end;


function TFrmSecInfo.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;


class function TFrmSecInfo.ClassDo(iType: Byte;Value: Variant): Variant;
var Node: PVirtualNode;
    NodeData:pNodeData;
begin
  With TfrmSecInfo.Create(Application) do
  begin
    if ShowModal=mrok then
     begin
      Node := vstree.GetFirstSelected;
      if Node=nil then
      Exit;
      NodeData := vstree.GetNodeData(Node);
      Result:=VarArrayOf([NodeData^.DepartNo,NodeData^.DepartName]);
     end;
  end;
end;

procedure TFrmSecInfo.newfresh;
var sKindNo:String;
    h, Level:Integer;
    NodeData: pNodeData;
    vNodes:Array of PVirtualNode; //保存各级节点
    SKindNoFmt:string;
    Node: PVirtualNode;
begin
  sKindNoFmt:='';
  if sKindNoFmt='' then  with cdssetting do begin
    Close;
    CommandText := 'SELECT * FROM SysSetting';
    Open;
    sKindNoFmt := cdssetting.fieldbyname('departnoformat').AsString;
  end;
  if sKindNoFmt='' then begin
    Application.MessageBox('请先设置类别编码格式！', '消息', MB_ICONINFORMATION);
    Exit;
  end;
  h := Length(sKindNoFmt);
  SetLength(vNodes, h+1);
  Screen.Cursor:=crHourGlass;
  vstree.Clear;
  Level:=0;

  //以下是增加第一项
  vstree.RootNodeCount := 1;
  Node := vstree.GetFirst;
  NodeData := vstree.GetNodeData(Node);
  NodeData^.DepartNo:= 'Root';

  vNodes[Level] := Node;
  //以上是增加第一项
  With cdsdepart do begin
    try
      IndexFieldNames := 'departno';
      if Active then
        Refresh
      else
        Open;
      First;
      While Not Eof do begin
        sKindNo := Trim(FieldByName('departno').AsString);
        Level:=GetLevel(sKindNoFmt, sKindNo);
        //返回代码的级数
        //以下是增加子项
        //以下用上一级节点为父节点添加子节点
        if Level>0 then begin//确保代码符合标准
          Node := vstree.AddChild(vNodes[Level-1]);
          NodeData := vstree.GetNodeData(Node);
          AssignNodeData(NodeData, cdsdepart);
          vNodes[Level] := Node;
        end;
        //以上是增加子项
        Next;
      end;
    finally
      Screen.Cursor:=crDefault;
    end;
  end;
  vstree.Expanded[vNodes[0]] := true;//将首节点展开
end;

procedure TFrmSecInfo.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Inherited;
  Action:=CaFree;
end;

procedure TFrmSecInfo.FormCreate(Sender: TObject);
begin
  SvrDepotInfo:=(Application.MainForm as IMainForm).GetConnection(Handle, '', 'dptinfosvr.svrdepart');
  cdsdepart.RemoteServer := SvrDepotInfo;
  cdssetting.RemoteServer := SvrDepotInfo;
end;

procedure TFrmSecInfo.FormShow(Sender: TObject);
begin
  inherited;
  newfresh;
end;

procedure TFrmSecInfo.vstreeBeforeItemErase(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 TFrmSecInfo.vstreeGetNodeDataSize(Sender: TBaseVirtualTree;
  var NodeDataSize: Integer);
begin
   nodedatasize:=sizeof(tdptinfo);
end;

procedure TFrmSecInfo.vstreeGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: WideString);
var
   data:pnodedata;
begin
  CellText := '';
  Data := Sender.GetNodeData(Node);
  case Column of
    0:cellText := Data^.DepartNo;
    1:cellText := Data^.DepartName;
  end;
end;

procedure TFrmSecInfo.vstreeDblClick(Sender: TObject);
begin
  ModalResult:=mrOK;
end;

initialization
  RegisterClass(TFrmSecInfo);
Finalization
  UnRegisterClass(TFrmSecInfo);

end.