| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342 | 
							- unit BGLSelectFrm;
 
- interface
 
- uses
 
-   BGLDm,
 
-   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 
-   Dialogs, StdCtrls, ZjGridDBA, ZJGrid, ExtCtrls, ZJCells;
 
- const
 
-   sBGInfo = '当前变更清单:%s 变更数量:%s';
 
- type
 
-   TBGLSelectForm = class(TForm)
 
-     lblBGInfo: TLabel;
 
-     lblBGLTitel: TLabel;
 
-     pnlBGLBar: TPanel;
 
-     zgBGL: TZJGrid;
 
-     btnOk: TButton;
 
-     btnCancel: TButton;
 
-     cbIncludeZeroQuantity: TCheckBox;
 
-     procedure zgBGLCellCanEdit(Sender: TObject; const ACoord: TPoint;
 
-       var Allow: Boolean);
 
-     procedure btnOkClick(Sender: TObject);
 
-     procedure zgBGLCellGetColor(Sender: TObject; ACoord: TPoint;
 
-       var AColor: TColor);
 
-     procedure zgBGLCellTextChanging(Sender: TObject; const ACoord: TPoint;
 
-       var NewValue: String; var Accept: Boolean);
 
-     procedure zgBGLCellValueChanged(Sender: TObject);
 
-     procedure cbIncludeZeroQuantityClick(Sender: TObject);
 
-   private
 
-     FOrgBGL: TBGLSelectInfo;
 
-     FProjectData: TObject;
 
-     FBGLData: TBGLData;
 
-     FGclCode: string;
 
-     FBGNum: Double;
 
-     FHasBGNum: Boolean;
 
-     function GetTotalBGNum: Double;
 
-     procedure InitBGList;
 
-     function GetIncludeZeroQuantity: Boolean;
 
-   public
 
-     procedure Init(AOrgBGL: TBGLSelectInfo; ProjectData: TObject; ABGNum: Double);
 
-     procedure LoadCurBGL(ACurBGL: TBGLSelectInfo);
 
-     property HasBGNum: Boolean read FHasBGNum write FHasBGNum;
 
-     property IncludeZeroQuantity: Boolean read GetIncludeZeroQuantity;
 
-   end;
 
- function SelectBGL(AOrgBGL, ACurBGL: TBGLSelectInfo; AProjectData: TObject): Boolean;
 
- function SelectBGLAndBGNum(AOrgBGL, ACurBGL: TBGLSelectInfo; AProjectData: TObject): Boolean;
 
- implementation
 
- uses
 
-   Math, ProjectData, sdIDTree, UtilMethods, ZhAPI;
 
- {$R *.dfm}
 
- function SelectBGL(AOrgBGL, ACurBGL: TBGLSelectInfo; AProjectData: TObject): Boolean;
 
- var
 
-   FBGLSelectForm: TBGLSelectForm;
 
- begin
 
-   FBGLSelectForm := TBGLSelectForm.Create(nil);
 
-   try
 
-     FBGLSelectForm.HasBGNum := True;
 
-     FBGLSelectForm.Init(AOrgBGL, AProjectData, ACurBGL.TotalNum);
 
-     if FBGLSelectForm.ShowModal = mrOk then
 
-     begin
 
-       Result := True;
 
-       FBGLSelectForm.LoadCurBGL(ACurBGL);
 
-     end
 
-     else
 
-       Result := False;
 
-   finally
 
-     FBGLSelectForm.Free;
 
-   end;
 
- end;
 
- function SelectBGLAndBGNum(AOrgBGL, ACurBGL: TBGLSelectInfo; AProjectData: TObject): Boolean;
 
- var
 
-   FBGLSelectForm: TBGLSelectForm;
 
- begin
 
-   FBGLSelectForm := TBGLSelectForm.Create(nil);
 
-   try
 
-     FBGLSelectForm.HasBGNum := False;
 
-     FBGLSelectForm.Init(AOrgBGL, AProjectData, ACurBGL.TotalNum);
 
-     if FBGLSelectForm.ShowModal = mrOk then
 
-     begin
 
-       Result := True;
 
-       FBGLSelectForm.LoadCurBGL(ACurBGL);
 
-     end
 
-     else
 
-       Result := False;
 
-   finally
 
-     FBGLSelectForm.Free;
 
-   end;
 
- end;
 
- { TBGLSelectForm }
 
- procedure TBGLSelectForm.Init(AOrgBGL: TBGLSelectInfo;
 
-   ProjectData: TObject; ABGNum: Double);
 
- begin
 
-   ClientHeight := 281;
 
-   ClientWidth := 475;
 
-   FProjectData := ProjectData;
 
-   with TProjectData(FProjectData).BillsMeasureData.BillsMeasureTree do
 
-     FGclCode := Selected.Rec.ValueByName('B_Code').AsString;
 
-   FBGLData := TProjectData(FProjectData).BGLData;
 
-   FOrgBGL := AOrgBGL;
 
-   FBGNum := ABGNum;
 
-   lblBGInfo.Caption := Format(sBGInfo, [FGclCode, FloatToStr(FBGNum)]);
 
-   InitBGList;
 
- end;
 
- procedure TBGLSelectForm.InitBGList;
 
-   procedure InitBGListHead;
 
-   begin
 
-     zgBGL.ColCount := 6;
 
-     zgBGL.CellClass.Cols[1] := TZjCheckBoxCell;
 
-     zgBGL.Cells[1, 0].Text := '选择';
 
-     zgBGL.ColWidths[1] := 35;
 
-     zgBGL.Cells[2, 0].Text := '变更令号';
 
-     zgBGL.ColWidths[2] := 90;
 
-     zgBGL.Cells[3, 0].Text := '名称';
 
-     zgBGL.ColWidths[3] := 150;
 
-     zgBGL.Cells[4, 0].Text := '可变更数量';
 
-     zgBGL.ColWidths[4] := 80;
 
-     zgBGL.Cells[5, 0].Text := '变更数量';
 
-     zgBGL.ColWidths[5] := 60;
 
-     zgBGL.RowCount := 1;
 
-   end;
 
-   function GetOrgQuantity(const ABGLCode: string): Double;
 
-   var
 
-     I: Integer;
 
-   begin
 
-     Result := 0;
 
-     for I := 0 to FOrgBGL.Count - 1 do
 
-     begin
 
-       if SameText(FOrgBGL.Codes[I], ABGLCode) then
 
-       begin
 
-         Result := StrToFloatDef(FOrgBGL.Nums[I], 0);
 
-         Break;
 
-       end;
 
-     end;
 
-   end;
 
-   procedure AddBGL;
 
-   var
 
-     fValidQuantity: Double;
 
-   begin
 
-     with FBGLData do
 
-     begin
 
-       fValidQuantity := QuantityRoundTo(
 
-           cdsBGBillsQuantity.AsFloat - cdsBGBillsUsedQuantity.AsFloat
 
-           + GetOrgQuantity(cdsBGLCode.AsString));
 
-       if not IncludeZeroQuantity and (fValidQuantity = 0) then Exit;
 
-       zgBGL.RowCount := zgBGL.RowCount + 1;
 
-       zgBGL.Cells[2, zgBGL.RowCount -1].Text := cdsBGLCode.AsString;
 
-       zgBGL.Cells[3, zgBGL.RowCount -1].Text := cdsBGLName.AsString;
 
-       zgBGL.Cells[4, zgBGL.RowCount -1].Text := FloatToStr(fValidQuantity);
 
-       zgBGL.Rows[zgBGL.RowCount -1].Data := Pointer(cdsBGBillsID.AsInteger);
 
-     end;
 
-   end;
 
- begin
 
-   InitBGListHead;
 
-   FBGLData.cdsBGL.First;
 
-   while not FBGLData.cdsBGL.Eof do
 
-   begin
 
-     FBGLData.cdsBGBills.Filter := 'BGID = ' + IntToStr(FBGLData.cdsBGLID.AsInteger);
 
-     FBGLData.cdsBGBills.Filtered := True;
 
-     try
 
-       FBGLData.cdsBGBills.First;
 
-       while not FBGLData.cdsBGBills.Eof do
 
-       begin
 
-         if SameText(FBGLData.cdsBGBillsB_Code.AsString, FOrgBGL.B_Code) and
 
-            SameText(FBGLData.cdsBGBillsName.AsString, FOrgBGL.Name) and
 
-            SameText(FBGLData.cdsBGBillsUnits.AsString, FOrgBGL.Units) and
 
-            (PriceRoundTo(FBGLData.cdsBGBillsPrice.AsFloat - FOrgBGL.Price) = 0) then
 
-           AddBGL;
 
-         FBGLData.cdsBGBills.Next;
 
-       end;
 
-     finally
 
-       FBGLData.cdsBGBills.Filtered := False;
 
-     end;
 
-     FBGLData.cdsBGL.Next;
 
-   end;
 
- end;
 
- procedure TBGLSelectForm.LoadCurBGL(ACurBGL: TBGLSelectInfo);
 
- var
 
-   iRowIndex: Integer;
 
- begin
 
-   ACurBGL.TotalNum := GetTotalBGNum;
 
-   for iRowIndex := 0 to zgBGL.RowCount - 1 do
 
-     if zgBGL.Cells[2, iRowIndex].Text <> '' then
 
-     begin
 
-       if SameText(zgBGL.Cells[1, iRowIndex].Text, 'True') then
 
-       begin
 
-         ACurBGL.Codes.Add(zgBGL.Cells[2, iRowIndex].Text);
 
-         ACurBGL.Nums.Add(zgBGL.Cells[5, iRowIndex].Text);
 
-       end;
 
-     end;
 
- end;
 
- procedure TBGLSelectForm.zgBGLCellCanEdit(Sender: TObject;
 
-   const ACoord: TPoint; var Allow: Boolean);
 
- begin
 
-   Allow := (ACoord.X = 1) or
 
-     ((ACoord.X = 5) and SameText(zgBGL.Cells[1, ACoord.Y].Text, 'True'));
 
- end;
 
- procedure TBGLSelectForm.btnOkClick(Sender: TObject);
 
-   function CheckSelect: Boolean;
 
-   var
 
-     iRowIndex: Integer;
 
-   begin
 
-     Result := False;
 
-     for iRowIndex := 0 to zgBGL.RowCount - 1 do
 
-       if zgBGL.Cells[2, iRowIndex].Text <> '' then
 
-         if SameText(zgBGL.Cells[1, iRowIndex].Text, 'True') then
 
-         begin
 
-           Result := True;
 
-           Break;
 
-         end;
 
-   end;
 
- begin
 
-   if not CheckSelect then
 
-     ErrorMessage('请选择变更令!')
 
-   else if (FBGNum <> GetTotalBGNum) then
 
-     ErrorMessage('所选变更令的变更数量合计必须等于清单的变更数量')
 
-   else
 
-     ModalResult := mrOk;
 
- end;
 
- function TBGLSelectForm.GetTotalBGNum: Double;
 
- var
 
-   iRowIndex: Integer;
 
- begin
 
-   Result := 0;
 
-   for iRowIndex := 0 to zgBGL.RowCount - 1 do
 
-     if zgBGL.Cells[2, iRowIndex].Text <> '' then
 
-       if SameText(zgBGL.Cells[1, iRowIndex].Text, 'True') then
 
-         Result := Result + StrToFloatDef(zgBGL.Cells[5, iRowIndex].Text, 0);
 
- end;
 
- procedure TBGLSelectForm.zgBGLCellGetColor(Sender: TObject; ACoord: TPoint;
 
-   var AColor: TColor);
 
- var
 
-   fValidValue, fValue: Double;
 
- begin
 
-   if ACoord.X = 5 then
 
-   begin
 
-     fValidValue := StrToFloatDef(zgBGL.Cells[4, ACoord.Y].Text, 0);
 
-     fValue := StrToFloatDef(zgBGL.Cells[5, ACoord.Y].Text, 0);
 
-     if ((fValidValue > 0) and (fValue > fValidValue)) or
 
-         ((fValidValue < 0) and (fValue < fValidValue)) then
 
-       AColor := clRed;
 
-   end;
 
- end;
 
- procedure TBGLSelectForm.zgBGLCellTextChanging(Sender: TObject;
 
-   const ACoord: TPoint; var NewValue: String; var Accept: Boolean);
 
-   procedure AutoGetBGNum(ARowIndex: Integer);
 
-   var
 
-     fAvailableNum: Double;
 
-   begin
 
-     if HasBGNum then
 
-       fAvailableNum := FBGNum - GetTotalBGNum
 
-     else
 
-       fAvailableNum := StrToFloatDef(zgBGL.Cells[4, ARowIndex].Text, 0);
 
-     // 当变更数量为负数时, 例如-60,但计算得到可变更数量为-80,此时应取两值中较大的-60
 
-     if FBGNum < 0 then
 
-       zgBGL.Cells[5, ARowIndex].Text := FloatToStr(
 
-         Max(fAvailableNum, StrToFloatDef(zgBGL.Cells[4, ARowIndex].Text, 0)))
 
-     else
 
-       zgBGL.Cells[5, ARowIndex].Text := FloatToStr(
 
-         Min(fAvailableNum, StrToFloatDef(zgBGL.Cells[4, ARowIndex].Text, 0)));
 
-   end;
 
- begin
 
-   if ACoord.X = 1 then
 
-     if NewValue = 'True' then
 
-       AutoGetBGNum(ACoord.Y)
 
-     else
 
-       zgBGL.Cells[5, ACoord.Y].Text := '';
 
- end;
 
- procedure TBGLSelectForm.zgBGLCellValueChanged(Sender: TObject);
 
-   procedure RefreshBGNum;
 
-   begin
 
-     FBGNum := GetTotalBGNum;
 
-     lblBGInfo.Caption := Format(sBGInfo, [FGclCode, FloatToStr(FBGNum)]);
 
-   end;
 
- var
 
-   fCur, fValid: Double;
 
- begin
 
-   if zgBGL.CurCol = 5 then
 
-   begin
 
-     zgBGL.OnCellValueChanged := nil;
 
-     if zgBGL.Cells[5, zgBGL.CurRow].Text <> '' then
 
-     begin
 
-       fCur := QuantityRoundTo(StrToFloatDef(zgBGL.Cells[5, zgBGL.CurRow].Text, 0));
 
-       fValid := StrToFloatDef(zgBGL.Cells[4, zgBGL.CurRow].Text, 0);
 
-       if ((fValid >= 0) and (QuantityRoundTo(fValid - fCur) >= 0)) or
 
-          ((fValid < 0) and (QuantityRoundTo(fCur - fValid) >= 0)) then
 
-         zgBGL.Cells[5, zgBGL.CurRow].Text := FloatToStr(fCur)
 
-       else
 
-       begin
 
-         ErrorMessage('当前输入的变更数量大于可变更数量,请重新输入!');
 
-         zgBGL.Cells[5, zgBGL.CurRow].Text := '';
 
-       end;
 
-     end;
 
-     zgBGL.OnCellValueChanged := zgBGLCellValueChanged;
 
-   end;
 
-   if not HasBGNum and ((zgBGL.CurCol = 1) or (zgBGL.CurCol = 5)) then
 
-     RefreshBGNum;
 
- end;
 
- procedure TBGLSelectForm.cbIncludeZeroQuantityClick(Sender: TObject);
 
- begin
 
-   InitBGList;
 
- end;
 
- function TBGLSelectForm.GetIncludeZeroQuantity: Boolean;
 
- begin
 
-   Result := cbIncludeZeroQuantity.Checked;
 
- end;
 
- end.
 
 
  |