.#depotberthsfm.pas.1.22

来自「群星医药系统源码」· 22 代码 · 共 798 行 · 第 1/2 页

unit DepotBerthsFm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, DBClient, MConnect, Grids, DBGridEh, DbUtilsEh, EhLibCDS, DBCtrls, RzButton,
  RzBorder, ExtCtrls,xBaseFrm,iMainFrm, xEhLibCtl, StdCtrls, Mask, RzEdit,
  RzSpnEdt, TFlatPanelUnit, RzPanel, RzSplit, VirtualTrees, ActnList, Menus,
  ToolWin, ComCtrls, ActiveX, ModuleAction, ImgList, ckDBClient,
  Dbfuncs,ShowProGress, TFlatSpeedButtonUnit, RzStatus, ADODB;

type
  PDepotData = ^TDepotData;
  TDepotData = record
    DepotID:    WideString;
    DepotNo:    WideString;
    DepotName:  WideString;
    SIZE:       WideString;
    LINKMAN:    WideString;
    TEL:        WideString;
    FAX:        WideString;
    AREA:       WideString;
    ADDR:       WideString;
    RankDepot:  Boolean;
    Remark:     WideString;
  end;
  TFmDepotBerths = class(TxBaseForm)
    ActionList1: TActionList;
    ActRefresh: TModlAction;
    ActRebuild: TModlAction;
    ActNew: TModlAction;
    ActModify: TModlAction;
    ActDelete: TModlAction;
    ActFind: TModlAction;
    ActNew1: TModlAction;
    ActModify1: TModlAction;
    ActDelete1: TModlAction;
    ActFind1: TModlAction;
    ActRefresh1: TModlAction;
    CdsDepots: TckClientDataSet;
    DsDepots: TDataSource;
    DsDepotBerths: TDataSource;
    ComConn: TDCOMConnection;
    CdsDepotBerths: TckClientDataSet;
    CdsDepotBerthsDepotID: TIntegerField;
    CdsDepotBerthsBerthNo: TStringField;
    CdsDepotBerthsLength: TBCDField;
    CdsDepotBerthsWidth: TBCDField;
    CdsDepotBerthsHeight: TBCDField;
    CdsDepotBerthsLengthUnit: TStringField;
    CdsDepotBerthsHoldWeight: TBCDField;
    CdsDepotBerthsWeightUnit: TStringField;
    CdsDepotBerthsLocation: TStringField;
    CdsDepotBerthsCheckDesc: TStringField;
    CdsDepotBerthsStockUsable: TBooleanField;
    CdsDepotBerthsLastCheckDate: TDateTimeField;
    CdsDepotBerthsRemark: TStringField;
    cdssetting: TckClientDataSet;
    cdssettingAutoUniteStk: TBooleanField;
    cdssettingKindNoFormat: TStringField;
    cdssettingDepartNoFormat: TStringField;
    cdssettingDepotNoFormat: TStringField;
    cdssettingFlag: TIntegerField;
    CdsDepotsDepotID: TAutoIncField;
    CdsDepotsDepotNo: TStringField;
    CdsDepotsDepotName: TStringField;
    CdsDepotsDefBerthNo: TStringField;
    CdsDepotsSize: TBCDField;
    CdsDepotsLinkMan: TStringField;
    CdsDepotsTEL: TStringField;
    CdsDepotsFAX: TStringField;
    CdsDepotsAREA: TStringField;
    CdsDepotsADDR: TStringField;
    CdsDepotsRankDepot: TBooleanField;
    CdsDepotsStockUsable: TBooleanField;
    CdsDepotsRemark: TStringField;
    CdsDepotsDataUsable: TBooleanField;
    CdsDepotsCreater: TStringField;
    CdsDepotsCreatTime: TDateTimeField;
    CdsDepotsMender: TStringField;
    CdsDepotsUpdateTime: TDateTimeField;
    CdsDepotsGrup: TIntegerField;
    CdsDepotsDepotBerths: TDataSetField;
    RzPanel3: TRzPanel;
    RzSizePanel2: TRzSizePanel;
    dbgBerths: TxDBGridEh;
    RzPanel5: TRzPanel;
    RzBitBtn9: TRzBitBtn;
    BtnDelete: TRzBitBtn;
    BtnChange: TRzBitBtn;
    vtDepots: TVirtualStringTree;
    RzPanel4: TRzPanel;
    RzBitBtn3: TRzBitBtn;
    RzBitBtn10: TRzBitBtn;
    RzBitBtn1: TRzBitBtn;
    RzBitBtn6: TRzBitBtn;
    RzBitBtn7: TRzBitBtn;
    RzBitBtn5: TRzBitBtn;
    ptBkPanel: TFlatPanel;
    ptCaption: TRzMarqueeStatus;
    FlatPanel2: TPanel;
    BtnWhatIs: TFlatSpeedButton;
    BtnHelp: TFlatSpeedButton;
    FlatPanel3: TPanel;
    BtnPopMenu: TFlatSpeedButton;
    CdsDepotsStoreWhole: TBooleanField;
    procedure BitBtn2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure vtDepotsGetNodeDataSize(Sender: TBaseVirtualTree;
      var NodeDataSize: Integer);
    procedure vtDepotsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: WideString);
    procedure vtDepotsBeforeItemErase(Sender: TBaseVirtualTree;
      TargetCanvas: TCanvas; Node: PVirtualNode; ItemRect: TRect;
      var ItemColor: TColor; var EraseAction: TItemEraseAction);
    procedure RzBitBtn10Click(Sender: TObject);
    procedure RzBitBtn5Click(Sender: TObject);
    procedure vtDepotsDblClick(Sender: TObject);
    procedure CdsDepotsReconcileError(DataSet: TCustomClientDataSet;
      E: EReconcileError; UpdateKind: TUpdateKind;
      var Action: TReconcileAction);
    procedure ActDeleteExecute(Sender: TObject);
    procedure ActRefreshExecute(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure CdsDepotBerthsAfterScroll(DataSet: TDataSet);
    procedure ActModifyExecute(Sender: TObject);
    procedure ActNewExecute(Sender: TObject);
    procedure ActNew1Execute(Sender: TObject);
    procedure ActModify1Execute(Sender: TObject);
    procedure ActDelete1Execute(Sender: TObject);
    function myGetAveCharSize(Canvas: TCanvas): TPoint;
    function myinputbox(const ACaption, APrompt: string;
  var InValue: Integer;Const MaxLen:integer): String;
    procedure vtDepotsCollapsing(Sender: TBaseVirtualTree;
      Node: PVirtualNode; var Allowed: Boolean);
    procedure vtDepotsChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
  private
    SvrCommon,SvrDepotBerths: TDispatchConnection;
    IFmMain:IMainForm;
    iClientID :integer;
    CdsFieldProPerty:TckClientDataSet;
    function GetLevel(sFormat,sCode:String):Integer;
    procedure newfresh;
    procedure AssignNodeData(Data: PDepotData; DataSet: TDataSet);
  protected
    sKindNoFmt: String;
  public
    { Public declarations }
  end;

const
  sRootText = '<所有仓库>';
  sFieldProPerty='select * from SysFieldProperty '+
  'where TableName=''DepotBerths''';
  sqStr = 'select DepotID,DepotNo, DepotName,  SIZE, LINKMAN, TEL, FAX, AREA, '+
          ' ADDR, RankDepot, '+
          ' REMARK, Creater, CreatTime, Mender, UpdateTime '+
          ' from Depots ';
  soStr = ' Order By DepotNO ';


var
  FmDepotBerths: TFmDepotBerths;
  vOwnerData:OleVariant;
  bTrueEof:Boolean;

implementation

uses DepotEdFrm, DepotBerthsEdFm,RepSelectFrm, ceGlobal;

{$R *.dfm}


procedure TFmDepotBerths.BitBtn2Click(Sender: TObject);
begin
  Close;
end;

procedure TFmDepotBerths.FormCreate(Sender: TObject);
begin
  CdsFieldProPerty := TckClientDataSet.Create(self);
  SetGressHint('正在登录到仓库货品服务器...');
  IFmMain:=Application.MainForm as IMainForm;
  SvrDepotBerths:=IFmMain.GetConnection(Handle,'','CkDepotBerthSvr.DepotBerths');
  SetGressHint('正在连接到公用信息服务器...');
  SvrCommon:=iFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  SetGressHint('读取用户操作权限...');
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  iClientID:=IFmMain.IFmMainEx.ClientID;
  CdsDepots.RemoteServer:=SvrDepotBerths;
  cdssetting.RemoteServer :=SvrDepotBerths;
  CdsFieldProPerty.ProviderName:='DspTemp';
  CdsFieldProPerty.RemoteServer:=SvrCommon;
  dbgBerths.SetAutoSort('');
end;

procedure TFmDepotBerths.AssignNodeData(Data: PDepotData;
  DataSet: TDataSet);
begin
  with DataSet do begin
    if FieldByName('DepotID').AsString <> '' then
      Data^.DepotID   := vartostr(FieldByName('DepotID').AsVariant);
    Data^.DepotNo   := FieldByName('DepotNo').AsString;
    Data^.DepotName := FieldByName('DepotName').AsString;
    Data^.SIZE      := vartostr(FieldByName('SIZE').AsVariant);
    Data^.LINKMAN   := FieldByName('LINKMAN').AsString;
    Data^.TEL       := FieldByName('TEL').AsString;
    Data^.FAX       := FieldByName('FAX').AsString;
    Data^.AREA      := FieldByName('AREA').AsString;
    Data^.ADDR      := FieldByName('ADDR').AsString;
    Data^.RankDepot := FieldByName('RankDepot').AsBoolean;
    Data^.Remark    := FieldByName('Remark').AsString;
  end;
end;

function TFmDepotBerths.GetLevel(sFormat,sCode:String):Integer;
var i,Level,iLen:Integer;
begin
  Level:=-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 TFmDepotBerths.newfresh;
var sKindNo:String;
    h, Level:Integer;
    NodeData: PDepotData;
    vNodes:Array of PVirtualNode; //保存各级节点
    Node: PVirtualNode;
begin
  sKindNoFmt:='';
  CdsSetting.Open;
  sKindNoFmt := cdssettingDepotNoFormat.AsString;
  if sKindNoFmt='' then begin
    MessageBox(Handle,'请先设置类别编码格式！', '消息', MB_ICONINFORMATION+MB_OK);
    Exit;
  end;
  h := Length(sKindNoFmt);
  SetLength(vNodes, h+1);
  Screen.Cursor:=crHourGlass;
  vtDepots.Clear;
  Level:=0;

  vtDepots.RootNodeCount := 1;
  Node := vtDepots.GetFirst;
  NodeData := vtDepots.GetNodeData(Node);
  NodeData^.DepotNo := '';
  NodeData^.DepotName := sRootText;

  vNodes[Level] := Node;

  With CdsDepots do begin
    try
      IndexFieldNames := 'DepotNo';
      if Active then
        Refresh
      else
        Open;
      First;
      While Not Eof do begin
        sKindNo := Trim(FieldByName('DepotNo').AsString);
        Level:=GetLevel(sKindNoFmt, sKindNo);

        if Level>0 then begin
          Node := vtDepots.AddChild(vNodes[Level-1]);
          NodeData := vtDepots.GetNodeData(Node);
          AssignNodeData(NodeData, CdsDepots);
          vNodes[Level] := Node;
        end;
        Next;
      end;
    finally
      Screen.Cursor:=crDefault;
    end;
  end;
  vtDepots.Expanded[vNodes[0]] := true;
  vtDepots.Selected[vNodes[0]] := True;
end;

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

procedure TFmDepotBerths.vtDepotsGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: WideString);
var
  NodeData: PDepotData;
begin
  CellText := '';
  NodeData := Sender.GetNodeData(Node);
  case Column of
    0:CellText := NodeData^.DepotNo+'['+NodeData^.DepotName+']';
    1:CellText := NodeData^.Size;
    2:CellText := NodeData^.LinkMan;
    3:CellText := NodeData^.Tel;
    4:CellText := NodeData^.Fax;
    5:CellText := NodeData^.Area;
    6:CellText := NodeData^.Addr;
    7:CellText := NodeData^.Remark;
  end;
end;


procedure TFmDepotBerths.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 TFmDepotBerths.RzBitBtn10Click(Sender: TObject);
begin
  SelRepPrint(self.Name, [CdsDepots,CdsDepotBerths], '仓库信息;仓库信息明细');
end;

procedure TFmDepotBerths.RzBitBtn5Click(Sender: TObject);
begin
  close;
end;

procedure TFmDepotBerths.vtDepotsDblClick(Sender: TObject);
var pNode: PVirtualNode;
begin
  pNode := vtDepots.GetFirstSelected;
  if (pNode=nil) or vtDepots.HasChildren[pNode] then Exit;
  ActModify.Execute;
end;

procedure TFmDepotBerths.CdsDepotsReconcileError(
  DataSet: TCustomClientDataSet; E: EReconcileError;
  UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
//  MessageBox(handle,pchar(E.message),'提示',MB_OK);
  Action := raAbort;
end;

procedure TFmDepotBerths.ActDeleteExecute(Sender: TObject);
var Node: PVirtualNode;
    NodeData: PDepotData;
    iID: String;
begin
  If CdsDepots.IsEmpty Then Exit;
  Node := vtDepots.GetFirstSelected;
//  Node := vtDepots.FocusedNode;

  if (Node=nil) then
  begin
    Messagebox(handle,'请选择条目后进行...','提示',MB_OK);
    Exit;
  end;

  if vtDepots.GetNodeLevel(Node)=0 Then begin
    MessageBox(handle,'你不能对'+sRootText+'进行删除操作...','提示',MB_OK);
    exit;
  end;

  if Node.ChildCount>0 then
  begin
    Messagebox(handle,'你不能对包含下级仓库的条目进行删除操作！','提示',MB_OK);
    exit;
  end;

  if Application.MessageBox('确实要删除此仓库资料吗？','提示',4+32)=6 Then
  Begin
    Node := vtDepots.FocusedNode;
    NodeData := vtDepots.GetNodeData(Node);
    iID := NodeData^.DepotNo;
    if not cdsDepots.Locate('DepotNO', iID, []) then begin
      Application.MessageBox('找不到指定的记录，请刷新后再试一次！', '消息', MB_ICONINFORMATION);
      Exit;
    end;
    If Not(CdsDepotBerths.IsEmpty) Then Begin
      Application.MessageBox('此仓库下已有货位数据，将先将货位数据删除!','提示',64);
      Exit;
    End;
    cdsDepots.Delete;
    if cdsDepots.ApplyUpdates(0)>0 then begin
      Application.MessageBox('数据更新失败！', '消息', MB_ICONINFORMATION);
      Exit;
    end else begin
      vtDepots.DeleteNode(Node);
    end;
  End;