.#depotberthsfm.pas.1.22

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

end;

procedure TFmDepotBerths.ActRefreshExecute(Sender: TObject);
Begin
  CdsDepots.Active:=False;
  cdsDepots.IndexFieldNames := 'DepotNO';
  CdsDepots.Active:=True;
  NewFresh;
End;

procedure TFmDepotBerths.FormShow(Sender: TObject);
var sTableNames :String;
begin
  SetGressHint('初始化本地环境...');
  ptBkPanel.Color := TitlePanelColor;
  ptCaption.FillColor := TitlePanelColor;
  SetGridEhColor([dbgBerths]);
  dbgBerths.SetAutoSort('');
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TDepots.Xml');
  sTableNames:='DepotBerths';
  SetFieldProperty(CdsFieldProPerty,CdsDepotBerths,sTableNames);
  SetGressHint('读取历史单据...');
  CdsDepots.Open;
  newfresh;
  BtnChange.Enabled := False;
  BtnDelete.Enabled := False;
  FreeGressForm;
end;

procedure TFmDepotBerths.CdsDepotBerthsAfterScroll(DataSet: TDataSet);
begin
  if CdsDepotBerths.IsEmpty then
  begin
    BtnChange.Enabled := False;
    BtnDelete.Enabled := False;
  end else Begin
    BtnChange.Enabled := True;
    BtnDelete.Enabled := True;
  end;
end;

procedure TFmDepotBerths.ActModifyExecute(Sender: TObject);
var Node: PVirtualNode;
    NodeData: pDepotData;
    i, k, Level: Integer;
    sPKindNo, sKindNo, str: String;
    oldstr,newstr:String;
begin
  Level := 0;
  oldstr:='';
  newstr:='';
  Node := vtDepots.GetFirstSelected;
  if (Node<>nil) then
    Level := vtDepots.GetNodeLevel(Node);
  if Level=0 then begin
     MessageBox(handle,'请先选择一个可修改的条目！', '提示', MB_OK);
     Exit;
  end;

  str := Copy(sKindNoFmt, Level, 1);
  k := StrToInt(str);
  NodeData := vtDepots.GetNodeData(Node);
  if not cdsdepots.Locate('DepotNo', NodeData^.DepotNo, []) then begin
    MessageBox(handle,'无法对数据修改，请刷新数据！', '提示', MB_OK);
    Exit;
  end;
  i := Length(NodeData^.DepotNo);
  sPKindNo:= Copy(NodeData^.DepotNo, 1, i-k);
  sKindNo := Copy(NodeData^.DepotNo, i-k+1, k);

  oldstr:=spkindno+skindno;

  with TFmDepotEd.Create(Self) do begin
    EdRoot.Text := sPkindNo;
    EdDepotNo.Text := skindno;

    edDepotNo.Enabled := False;
    ckRankDepot.Enabled := CdsDepotBerths.IsEmpty and (vtDepots.ChildCount[Node]=0);

    if ShowModal=mrOk then begin
      str := '';
      for i:=0 to k-1 do
        str := str+'0';

      sKindNo := sPKindNo+FormatFloat(str, EdDepotNO.IntValue);

      if ModalResult=mrok then
        begin
         if length(trim(EdDepotNo.text))<EdDepotNo.MaxLength then
           begin
              EdDepotNo.Text:=trim(EdDepotNo.Text);
             for i:=1 to EdDepotNo.MaxLength-length(trim(EdDepotNo.Text)) do
               begin
                 EdDepotNo.Text:='0'+EdDepotNo.Text;
               end;
           end;
          newstr:=Edroot.text+EdDepotNo.Text;
          cdsdepots.Edit;
          CdsDepotsDepotNo.Value := NewStr;
        end;
      IF cdsDepots.ApplyUpdates(0)>0 then begin
        MessageBox(handle,'数据更新失败！', '提示', MB_OK);
        cdsdepots.CancelUpdates;
      end else begin
        AssignNodeData(NodeData, cdsdepots);
      end;
    end;
  end;
end;

procedure TFmDepotBerths.ActNewExecute(Sender: TObject);
var Node, PNode :PVirtualNode;
    NodeData:pDepotData ;
    i, k, Level: Integer;
    str, sPKindNo: String;
    NextNode :PVirtualNode;
    CurData :pDepotData ;
    OldLen :Integer;
    OldTxt :Integer;
    sDepotNo: string;
begin
  pNode := vtDepots.GetFirstSelected;

  if pNode=nil then begin
    MessageBox(handle,'请先选择'+sRootText+'或其它条目，然后新增！', '提示', MB_OK);
    exit;
  end;
  NodeData := vtDepots.GetNodeData(pNode);
  sPKindNo := NodeData^.DepotNo;
  if (vtDepots.GetNodeLevel(pNode)>0) and not NodeData.RankDepot then
  Begin
    MessageBox(handle,'不能给实物仓库增加下级仓库！',nil,MB_ICONHAND);
    Exit;
  end;
  Level := vtDepots.GetNodeLevel(pNode);
  if Level>=Length(sKindNoFmt) then begin
    MessageBox(handle,'分级已达到最低级，不能作增加操作！', nil,MB_ICONHAND);
    Exit;
  end;
  str := Copy(sKindNoFmt, Level+1, 1);
  k := StrToInt(str);
  Node := vtDepots.GetLastChild(pNode);
  if Node=nil then
    i := 0
  else begin
    NodeData := vtDepots.GetNodeData(Node);
    str := Copy(NodeData^.DepotNo, Length(sPKindNo)+1, k);
    i := StrToInt(str);
  end;

  pNode := vtDepots.GetFirstSelected;
  Nodedata:=vtDepots.GetNodeData(pnode);
  CdsDePots.Append;
  With TfmDepotEd.Create(Self) Do
   begin
    if nodedata^.DepotNo=sRootText then
      EdRoot.Text:=''
    else
      EdRoot.text:= Nodedata.DepotNo;
    EdDepotNo.IntValue := I+1;
    EdDepotNo.MaxLength := k;
  	if ShowModal=mrOk then begin
      if ModalResult=mrok then
      begin
        for i:=1 to  EddepotNo.MaxLength-length(EddepotNo.Text) do
        begin
          EddepotNo.Text:='0'+EddepotNo.Text;
        end;
        OldLen := EddepotNo.MaxLength;
        NextNode := vtDepots.GetFirst;
        While NextNode<>Nil do
        begin
          CurData := vtDepots.GetNodeData(NextNode);
          vtDepots.Selected[NextNode] := True;
          NextNode := vtDepots.GetNext(NextNode);
          if Curdata^.DepotNo=(EdRoot.Text+EdDepotNo.Text) then
          begin
            if MessageBox(handle,'此编号已经存在,不修改将会无效，你确定要修改吗？','提示',MB_ICONQUESTION+MB_YESNO)=IDNO THEN Exit;
            OldTxt := StrtoInt(edDepotNo.Text);
            EdDepotNo.Text := myInputBox('重新输入仓库编号','新的仓库编号是： ',OldTxt,OldLen);
            NextNode := vtDepots.GetFirst;
          end;
        end;
        CdsDepotsDepotNo.Value := EdRoot.Text+EdDepotNo.Text;
        if CdsDepots.ApplyUpdates(0)>0 then
        begin
          MessageBox(handle,'数据更新失败！', nil,MB_ICONHAND);
          cdsdepots.CancelUpdates;
          Exit;
        end;
        sDepotNo := CdsDepots.FieldByName('DepotNo').AsString;
        cdsDepots.Refresh;
        if not CdsDepots.Locate('DepotNo',sDepotNo,[]) then
        begin
          MessageBox(Handle,'不能定位记录!刚提交的数据可能被其他用户改变.',nil,MB_ICONHAND);
          exit;
        end;
        Node := vtDepots.AddChild(PNode); //在选择的节点下建立节点
        NodeData := vtDepots.GetNodeData(Node); //得到指针地址
        AssignNodeData(NodeData, cdsdepots); //指针赋值

        vtDepots.Expanded[pNode] := true;
        vtDepots.Selected[Node] := true;
      end;
    end;
  end;
end;

procedure TFmDepotBerths.ActNew1Execute(Sender: TObject);
Var
  B1:Boolean;
  Node:PVirtualNode;
  NodeData:PDepotData;
  iDepotID:Integer;
begin
  Node:=vtDepots.GetFirstSelected;
  If Node=Nil Then Exit;
  Node:=vtDepots.FocusedNode;
  NodeData:=vtDepots.GetNodeData(Node);
  If NodeData=Nil Then Exit;
  if NodeData^.DepotNo=sRootText Then Exit;
  if NodeData^.RankDepot then
  Begin
    MessageBox(handle,'虚拟仓下不能建立货位!',nil,MB_ICONHAND);
    Exit;
  End;

  iDepotID:=strtoint(NodeData^.DepotID);
  With TFmDepotBerthsEd.Create(self) Do begin
    B1 := false;
    CdsDepotBerths.Append;
    CdsDepotBerthsDepotID.Value := iDepotID;
    cdsDepotBerthsStockUsable.Value := true;
  	while not b1 do begin
      edDepotNo.Text:=NodeData^.DepotNo;
    	b1 := ShowModal=mrOk;
      if not b1 then
      Begin
        CdsDepotBerths.CancelUpdates;
       	Break;
      End Else
        CdsDepotBerths.ApplyUpdates(0);
    End;
    Free;
  End;
end;

procedure TFmDepotBerths.ActModify1Execute(Sender: TObject);
Var
  B1:Boolean;
begin
  if  Not(BtnDelete.Enabled) Then Exit;
  With TFmDepotBerthsEd.Create(self) Do begin
    B1 := false;
    CdsDepotBerths.Edit;
  	while not b1 do begin
     	b1 := ShowModal=mrOk;
      if not b1 then
      Begin
        CdsDepotBerths.CancelUpdates;
       	Break;
      End Else
        CdsDepotBerths.ApplyUpdates(0);
    End;
    Free;
  End;
end;

procedure TFmDepotBerths.ActDelete1Execute(Sender: TObject);
begin
  If CdsDepotBerths.IsEmpty Then Exit;
  if Application.MessageBox('确实要删除此仓库货位资料吗？','提示',4+32)=6 Then
  Begin
    CdsDepotBerths.Delete;
    CdsDepotBerths.ApplyUpdates(0);
  End;
end;

function TFmDepotBerths.myGetAveCharSize(Canvas: TCanvas): TPoint;
var
  I: Integer;
  Buffer: array[0..51] of Char;
begin
  for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
  for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
  GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
  Result.X := Result.X div 52;
end;

function TFmDepotBerths.myinputbox(const ACaption, APrompt: string;
  var InValue: Integer;Const MaxLen:integer): String;
var
  Form: TForm;
  Prompt: TLabel;
  Edit: TRzNumericEdit;
  DialogUnits: TPoint;
  ButtonTop, ButtonWidth, ButtonHeight: Integer;
  Len :Integer;
begin
  Result := '';
  Form := TForm.Create(Application);
  with Form do
    try
      Canvas.Font := Font;
      DialogUnits := myGetAveCharSize(Canvas);
      BorderStyle := bsDialog;
      Caption := ACaption;
      ClientWidth := MulDiv(180, DialogUnits.X, 4);
      Position := poScreenCenter;
      Prompt := TLabel.Create(Form);
      with Prompt do
      begin
        Alignment := taLeftJustify;
        Parent := Form;
        Caption := APrompt;
        Left := MulDiv(8, DialogUnits.X, 4);
        Top := MulDiv(8, DialogUnits.Y, 8);
        Constraints.MaxWidth := MulDiv(164, DialogUnits.X, 4);
        WordWrap := False;
      end;
      Edit := TRzNumericEdit.Create(Form);
      with Edit do
      begin
        Parent := Form;
        Left := Prompt.Left;
        Top := Prompt.Top + Prompt.Height + 5;
        Width := MulDiv(164, DialogUnits.X, 4);
        MaxLength := MaxLen;
        Value := InValue;
        SelectAll;
      end;
      ButtonTop := Edit.Top + Edit.Height + 15;
      ButtonWidth := MulDiv(50, DialogUnits.X, 4);
      ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := '确定(&O)';
        ModalResult := mrOk;
        Default := True;
        SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
          ButtonHeight);
      end;
      with TButton.Create(Form) do
      begin
        Parent := Form;
        Caption := '取消(&C)';
        ModalResult := mrCancel;
        Cancel := True;
        SetBounds(MulDiv(92, DialogUnits.X, 4), Edit.Top + Edit.Height + 15,
          ButtonWidth, ButtonHeight);
        Form.ClientHeight := Top + Height + 13;
      end;
      if ShowModal = mrOk then
      begin
        if Edit.Text='' then Edit.Text := IntToStr(Invalue);
        if length(Edit.Text)<MaxLen then
        begin
          For Len:= 1 to (MaxLen-Length(Edit.Text)) do
          begin
            Edit.Text := '0'+Edit.Text;
          end;
        end;
        InValue := Edit.IntValue;
        Result := Edit.Text;
       end;
    finally
      Form.Free;
    end;
end;

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

procedure TFmDepotBerths.vtDepotsChange(Sender: TBaseVirtualTree;
  Node: PVirtualNode);
Var
  NodeData:PDepotData;
  sDepotNo: string;
begin
  If Node=Nil Then Exit;
  if cdsDepots.State in dsEditModes then Exit;
  NodeData:=vtDepots.GetNodeData(Node);
  If NodeData=Nil Then Exit;
  sDepotNo :=NodeData^.DepotNo;
  if sDepotNo = '' then exit;
  CdsDepots.Locate('DepotNo',sDepotNo,[]);
end;

initialization
 RegisterClass(TFmDepotBerths);
finalization
 UnRegisterClass(TFmDepotBerths);

end.