/Gedemin/Transaction/gdv_frmAcctLedger_unit.pas
Pascal | 1681 lines | 1455 code | 181 blank | 45 comment | 190 complexity | dbd6b546477c0f947ab433419ac6a040 MD5 | raw file
1unit gdv_frmAcctLedger_unit; 2 3interface 4 5uses 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 7 gdv_frmAcctBaseForm_unit, Db, IBCustomDataSet, flt_sqlFilter, 8 gd_ReportMenu, Menus, gd_MacrosMenu, ActnList, gdv_frAcctCompany_unit, 9 gdv_frAcctAnalytics_unit, gdv_frAcctSum_unit, gdv_frAcctQuantity_unit, 10 StdCtrls, Grids, DBGrids, gsDBGrid, gsIBGrid, Mask, xDateEdits, Buttons, 11 ExtCtrls, TB2Item, TB2Dock, TB2Toolbar, gdv_frAcctAnalyticsGroup_unit, 12 gd_ClassList, IBSQL, at_classes, gdcBaseInterface, Storages, gsStorage_CompPath, 13 AcctStrings, AcctUtils, gd_security, Contnrs, IBDataBase, gdv_AcctConfig_unit, 14 gsIBLookupComboBox, gdv_frAcctBaseAnalyticGroup, gdvParamPanel, gdcConstants, 15 gd_createable_form, gdv_frAcctTreeAnalytic_unit, gdv_frAcctTreeAnalyticLine_unit, 16 gdvAcctBase, gdvAcctLedger, gsPeriodEdit; 17 18type 19 Tgdv_ValueList = class; 20 21 Tgdv_SaldoValue = class 22 private 23 FSaldoName: string; 24 FSaldoValue: Currency; 25 procedure SetSaldoName(const Value: string); 26 procedure SetSaldoValue(const Value: Currency); 27 public 28 property SaldoName: string read FSaldoName write SetSaldoName; 29 property SaldoValue: Currency read FSaldoValue write SetSaldoValue; 30 end; 31 32 Tgdv_SaldoValues = class(TObjectList) 33 private 34 function GetSaldoList(Index: Integer): Tgdv_SaldoValue; 35 public 36 constructor Create; 37 function IndexOf(FieldName: string): Integer; 38 function AddSaldoValue(SaldoName: string; SaldoValue: Currency): Integer; 39 property SaldoList[Index: Integer]: Tgdv_SaldoValue read GetSaldoList; default; 40 end; 41 42 Tgdv_Value = class 43 private 44 FValues: Tgdv_ValueList; 45 FValue: string; 46 FSaldoValues: Tgdv_SaldoValues; 47 function GetValues: Tgdv_ValueList; 48 procedure SetValue(const Value: string); 49 function GetSaldoValues: Tgdv_SaldoValues; 50 51 public 52 destructor Destroy; override; 53 54 property Value: string read FValue write SetValue; 55 property Values: Tgdv_ValueList read GetValues; 56 property SaldoValues: Tgdv_SaldoValues read GetSaldoValues; 57 end; 58 59 Tgdv_ValueList = class 60 private 61 FValues: TStringList; 62 function GetItems(Index: Integer): Tgdv_Value; 63 public 64 destructor Destroy; override; 65 procedure Clear; 66 function IndexOf(Value: string): Integer; 67 function Add(Value: string): Tgdv_Value; 68 function Add2(Value: string): Integer; 69 70 property Items[Index: Integer]: Tgdv_Value read GetItems; default; 71 end; 72 73 Tgdv_frmAcctLedger = class(Tgdv_frmAcctBaseForm) 74 cbShowDebit: TCheckBox; 75 cbShowCredit: TCheckBox; 76 cbShowCorrSubAccount: TCheckBox; 77 frAcctAnalyticsGroup: TfrAcctAnalyticsGroup; 78 cbEnchancedSaldo: TCheckBox; 79 cbSumNull: TCheckBox; 80 frAcctTreeAnalytic: Tgdv_frAcctTreeAnalytic; 81 ibdsMain: TgdvAcctLedger; 82 procedure actSaveConfigUpdate(Sender: TObject); 83 procedure FormDestroy(Sender: TObject); 84 procedure actRunUpdate(Sender: TObject); 85 procedure FormCreate(Sender: TObject); 86 procedure ibdsMainAfterOpen(DataSet: TDataSet); 87 procedure ibdsMainCalcAggregates(DataSet: TDataSet; 88 var Accept: Boolean); 89 procedure actSaveGridSettingUpdate(Sender: TObject); 90 procedure actClearGridSettingUpdate(Sender: TObject); 91 92 private 93 FEntryDateIsFirst: Boolean; 94 FEntryDateInFields: Boolean; 95 96 FSortFieldIndex: Integer; 97 FSaldoValueList: Tgdv_ValueList; 98 99 FTotals: TgdvLedgerTotals; 100 101 FNeedUpdateControls: boolean; 102 procedure OnAnalyticGroupSelect(Sender: TObject); 103 104 procedure UpdateEntryDateIsFirst; 105 protected 106 function GetGdvObject: TgdvAcctBase; override; 107 procedure SetParams; override; 108 109 function GetSaldoBeginSQL: string; 110 procedure FillBeginSaldoStructire; 111 procedure CalcBeginSaldo; 112 113 procedure InitColumns; override; 114 procedure UpdateControls; override; 115 procedure DoBeforeBuildReport; override; 116 117 procedure DoLoadConfig(const Config: TBaseAcctConfig);override; 118 procedure DoSaveConfig(Config: TBaseAcctConfig);override; 119 procedure DoAfterBuildReport; override; 120 class function ConfigClassName: string; override; 121 procedure Go_to(NewWindow: Boolean = false); override; 122 function CanGo_to: boolean; override; 123 function CompareParams(WithDate: Boolean = True): boolean; override; 124 public 125 { Public declarations } 126 procedure BuildAcctReport; override; 127 128 procedure LoadSettings; override; 129 procedure SaveSettings; override; 130 end; 131 132var 133 gdv_frmAcctLedger: Tgdv_frmAcctLedger; 134 135implementation 136 137uses 138 gdv_frmAcctAccCard_Unit, IBHeader 139 {must be placed after Windows unit!} 140 {$IFDEF LOCALIZATION} 141 , gd_localization_stub 142 {$ENDIF} 143 , gd_KeyAssoc; 144 145{$R *.DFM} 146{ Tgdv_frmAcctLedger } 147 148procedure Tgdv_frmAcctLedger.FormCreate(Sender: TObject); 149begin 150 FTotals := TgdvLedgerTotals.Create; 151 TgdvAcctLedger(gdvObject).Totals := FTotals; 152 153 FNeedUpdateControls:= False; 154 inherited; 155 FNeedUpdateControls:= True; 156 UpdateControls; 157 frAcctAnalyticsGroup.OnSelect := OnAnalyticGroupSelect; 158 OnAnalyticGroupSelect(frAcctAnalyticsGroup); 159end; 160 161procedure Tgdv_frmAcctLedger.DoBeforeBuildReport; 162var 163 I, Index: Integer; 164 FieldName: string; 165begin 166 inherited; 167 168 FTotals.Clear; 169 170 UpdateEntryDateIsFirst; 171 172 FSortFieldIndex := - 1; 173 //???? ???? ?????? ?????????, ?? ????? ?? ?????????? ? ????????? ?????? ?? 174 //???????????? 175 if FEntryDateInFields then 176 begin 177 for I := 0 to BaseAcctFieldCount - 1 do 178 begin 179 if not (I in [baNCU_Debit_Index, baNCU_Credit_Index, baCurr_Debit_Index, 180 baCurr_Credit_Index]) then 181 begin 182 FieldName := BaseAcctFieldList[I].FieldName; 183 Index := FFieldInfos.IndexByFieldName(FieldName); 184 if Index >= - 1 then 185 begin 186 FFieldInfos[Index].Total := False; 187 end; 188 end; 189 end; 190 end; 191 192end; 193 194procedure Tgdv_frmAcctLedger.LoadSettings; 195{@UNFOLD MACRO INH_CRFORM_PARAMS(VAR)} 196{M}VAR 197{M} Params, LResult: Variant; 198{M} tmpStrings: TStackStrings; 199{END MACRO} 200var 201 ComponentPath: string; 202begin 203 {@UNFOLD MACRO INH_CRFORM_WITHOUTPARAMS('TGDV_FRMACCTLEDGER', 'LOADSETTINGS', KEYLOADSETTINGS)} 204 {M} try 205 {M} if Assigned(gdcMethodControl) and Assigned(ClassMethodAssoc) then 206 {M} begin 207 {M} SetFirstMethodAssoc('TGDV_FRMACCTLEDGER', KEYLOADSETTINGS); 208 {M} tmpStrings := TStackStrings(ClassMethodAssoc.IntByKey[KEYLOADSETTINGS]); 209 {M} if (tmpStrings = nil) or (tmpStrings.IndexOf('TGDV_FRMACCTLEDGER') = -1) then 210 {M} begin 211 {M} Params := VarArrayOf([GetGdcInterface(Self)]); 212 {M} if gdcMethodControl.ExecuteMethodNew(ClassMethodAssoc, Self, 'TGDV_FRMACCTLEDGER', 213 {M} 'LOADSETTINGS', KEYLOADSETTINGS, Params, LResult) then exit; 214 {M} end else 215 {M} if tmpStrings.LastClass.gdClassName <> 'TGDV_FRMACCTLEDGER' then 216 {M} begin 217 {M} Inherited; 218 {M} Exit; 219 {M} end; 220 {M} end; 221 {END MACRO} 222 223 inherited; 224 225 if UserStorage <> nil then 226 begin 227 ComponentPath := BuildComponentPath(Self); 228 frAcctAnalyticsGroup.ppMain.Unwraped := UserStorage.ReadBoolean(ComponentPath, 'AnalyticGroupUnwraped', True); 229 frAcctTreeAnalytic.ppMain.Unwraped := UserStorage.ReadBoolean(ComponentPath, 'TreeAnalyticUnwraped', True); 230// Panel2.Height := UserStorage.ReadInteger(BuildComponentPath(Self), 'PanelHeight', 159); 231 end; 232 {@UNFOLD MACRO INH_CRFORM_FINALLY('TGDV_FRMACCTLEDGER', 'LOADSETTINGS', KEYLOADSETTINGS)} 233 {M}finally 234 {M} if Assigned(gdcMethodControl) and Assigned(ClassMethodAssoc) then 235 {M} ClearMacrosStack('TGDV_FRMACCTLEDGER', 'LOADSETTINGS', KEYLOADSETTINGS); 236 {M}end; 237 {END MACRO} 238end; 239 240procedure Tgdv_frmAcctLedger.SaveSettings; 241{@UNFOLD MACRO INH_CRFORM_PARAMS(VAR)} 242{M}VAR 243{M} Params, LResult: Variant; 244{M} tmpStrings: TStackStrings; 245{END MACRO} 246var 247 ComponentPath: string; 248begin 249 {@UNFOLD MACRO INH_CRFORM_WITHOUTPARAMS('TGDV_FRMACCTLEDGER', 'SAVESETTINGS', KEYSAVESETTINGS)} 250 {M} try 251 {M} if Assigned(gdcMethodControl) and Assigned(ClassMethodAssoc) then 252 {M} begin 253 {M} SetFirstMethodAssoc('TGDV_FRMACCTLEDGER', KEYSAVESETTINGS); 254 {M} tmpStrings := TStackStrings(ClassMethodAssoc.IntByKey[KEYSAVESETTINGS]); 255 {M} if (tmpStrings = nil) or (tmpStrings.IndexOf('TGDV_FRMACCTLEDGER') = -1) then 256 {M} begin 257 {M} Params := VarArrayOf([GetGdcInterface(Self)]); 258 {M} if gdcMethodControl.ExecuteMethodNew(ClassMethodAssoc, Self, 'TGDV_FRMACCTLEDGER', 259 {M} 'SAVESETTINGS', KEYSAVESETTINGS, Params, LResult) then exit; 260 {M} end else 261 {M} if tmpStrings.LastClass.gdClassName <> 'TGDV_FRMACCTLEDGER' then 262 {M} begin 263 {M} Inherited; 264 {M} Exit; 265 {M} end; 266 {M} end; 267 {END MACRO} 268 269 inherited; 270 if UserStorage <> nil then 271 begin 272 ComponentPath := BuildComponentPath(Self); 273 UserStorage.WriteBoolean(ComponentPath, 'AnalyticGroupUnwraped', frAcctAnalyticsGroup.ppMain.Unwraped); 274 UserStorage.WriteBoolean(ComponentPath, 'TreeAnalyticUnwraped', frAcctTreeAnalytic.ppMain.Unwraped); 275 276// UserStorage.WriteInteger(BuildComponentPath(Self), 'PanelHeight', Panel2.Height); 277 end; 278 279 {@UNFOLD MACRO INH_CRFORM_FINALLY('TGDV_FRMACCTLEDGER', 'SAVESETTINGS', KEYSAVESETTINGS)} 280 {M}finally 281 {M} if Assigned(gdcMethodControl) and Assigned(ClassMethodAssoc) then 282 {M} ClearMacrosStack('TGDV_FRMACCTLEDGER', 'SAVESETTINGS', KEYSAVESETTINGS); 283 {M}end; 284 {END MACRO} 285end; 286 287procedure Tgdv_frmAcctLedger.UpdateControls; 288begin 289 if not FNeedUpdateControls then Exit; 290 inherited; 291 frAcctAnalyticsGroup.UpdateAnalyticsList(FAccountIDs); 292end; 293 294procedure Tgdv_frmAcctLedger.DoLoadConfig(const Config: TBaseAcctConfig); 295var 296 C: TAccLedgerConfig; 297begin 298 inherited; 299 if Config is TAccLedgerConfig then 300 begin 301 C := Config as TAccLedgerConfig; 302 cbShowDebit.Checked := C.ShowDebit; 303 cbShowCredit.Checked := C.ShowCredit; 304 cbShowCorrSubAccount.Checked := C.ShowCorrSubAccounts; 305 C.AnalyticsGroup.Position := 0; 306 frAcctAnalyticsGroup.UpdateAnalyticsList(FAccountIDs); 307 frAcctAnalyticsGroup.LoadFromStream(C.AnalyticsGroup); 308 frAcctAnalyticsGroup.AnalyticListFields := C.AnalyticListField; 309 cbSumNull.Checked := C.SumNull; 310 cbEnchancedSaldo.Checked := C.EnchancedSaldo; 311 frAcctTreeAnalytic.TreeAnalitic := C.TreeAnalytic; 312 end; 313end; 314 315procedure Tgdv_frmAcctLedger.DoSaveConfig(Config: TBaseAcctConfig); 316var 317 C: TAccLedgerConfig; 318begin 319 inherited; 320 if Config is TAccLedgerConfig then 321 begin 322 C := Config as TAccLedgerConfig; 323 C.ShowDebit := cbShowDebit.Checked; 324 C.ShowCredit := cbShowCredit.Checked; 325 C.ShowCorrSubAccounts := cbShowCorrSubAccount.Checked; 326 C.AnalyticsGroup.Size := 0; 327 frAcctAnalyticsGroup.SaveToStream(C.AnalyticsGroup); 328 C.AnalyticListField := frAcctAnalyticsGroup.AnalyticListFields; 329 C.SumNull := cbSumNull.Checked; 330 C.EnchancedSaldo := cbEnchancedSaldo.Checked; 331 C.TreeAnalytic := frAcctTreeAnalytic.TreeAnalitic; 332 end; 333end; 334 335procedure Tgdv_frmAcctLedger.DoAfterBuildReport; 336begin 337 if cbShowDebit.Checked or cbShowCredit.Checked then 338 begin 339 InitColumns; 340 ibgrMain.ResizeColumns; 341 ibgrMain.Columns.EndUpdate; 342 end else 343 inherited; 344end; 345 346class function Tgdv_frmAcctLedger.ConfigClassName: string; 347begin 348 Result := 'TAccLedgerConfig' 349end; 350 351procedure Tgdv_frmAcctLedger.InitColumns; 352var 353 I, J: Integer; 354 FI: TgdvFieldInfo; 355 DisplayFields: string; 356 FIndex, DIndex: Integer; 357 C: TgsColumn; 358 P: Integer; 359begin 360 inherited; 361 362 if (FFieldInfos <> nil) and (ibgrMain.Conditions.Count > 0) then 363 begin 364 for I := 0 to ibgrMain.Conditions.Count - 1 do 365 begin 366 C := FindColumn(UpperCase(ibgrMain.Conditions[I].FieldName)); 367 if (C <> nil) and (C.Field <> nil) then 368 begin 369 FIndex := C.Field.Index; 370 371 DisplayFields := ibgrMain.Conditions[I].DisplayFields; 372 for J := 0 to FFieldInfos.Count - 1 do 373 begin 374 FI := FFieldInfos[J]; 375 if FI.Condition then 376 begin 377 P := Pos(FI.FieldName + ';', DisplayFields); 378 if P > 0 then 379 Delete(DisplayFields, P, Length(FI.FieldName + ';')); 380 C := FindColumn(FI.FieldName); 381 if (C <> nil) and (C.Field <> nil) then 382 begin 383 DIndex := C.Field.Index; 384 if DIndex >= FIndex then 385 begin 386 if (DisplayFields > '') and (DisplayFields[Length(DisplayFields)] <> ';') then 387 DisplayFields := DisplayFields + ';'; 388 DisplayFields := DisplayFields + FI.FieldName + ';'; 389 end; 390 end; 391 end; 392 end; 393 ibgrMain.Conditions[I].DisplayFields := DisplayFields; 394 end; 395 end; 396 end; 397end; 398 399procedure Tgdv_frmAcctLedger.Go_to(NewWindow: Boolean = false); 400var 401 F: TField; 402 C: TAccCardConfig; 403 FI: TgdvFieldInfo; 404 A: String; 405 I, iTmp: Integer; 406 wY, wQ, wM, wBY, wBM, wBD, wEY, wEM, wED, wQBM, WQEM: word; 407 FieldName, sDName, sMName, sQName, sYName, sTmp: string; 408 Form: TCreateableForm; 409 dtBegin, dtEnd: TDateTime; 410 411 function GetMonthLastDay(const AMonth, AYear: word): word; 412 begin 413 Result:= 28; 414 case AMonth of 415 1, 3, 5, 7, 8, 10, 12: 416 Result:= 31; 417 4, 6, 9, 11: 418 Result:= 30; 419 2: 420 if IsLeapYear(AYear) then 421 Result:= 29 422 else 423 Result:= 28; 424 end; 425 end; 426 427 procedure GetQuarterMonths(const AQuarter: word; var ABegin, AEnd: word); 428 begin 429 case AQuarter of 430 1:begin 431 ABegin:= 1; 432 AEnd:= 3; 433 end; 434 2:begin 435 ABegin:= 4; 436 AEnd:= 6; 437 end; 438 3:begin 439 ABegin:= 7; 440 AEnd:= 9; 441 end; 442 4:begin 443 ABegin:= 10; 444 AEnd:= 12; 445 end; 446 end; 447 end; 448 449begin 450 Form := gd_createable_form.FindForm(Tgdv_frmAcctAccCard); 451 452 F := ibgrMain.SelectedField; 453 if F <> nil then 454 begin 455 C := TAccCardConfig.Create; 456 try 457 DoSaveConfig(C); 458 // ???????????????? - ???? ??????????? ? Tgdv_frmAcctBaseForm.DoSaveConfig 459 //C.CompanyKey := frAcctCompany.iblCompany.CurrentKeyInt; 460 //C.AllHoldingCompanies := frAcctCompany.cbAllCompanies.Checked; 461 C.IncCorrSubAccounts := False; 462 C.CorrAccounts := ''; 463 464 FI := FFieldInfos.FindInfo(F.FieldName); 465 if (FI <> nil) and (FI is TgdvLedgerFieldInfo) then 466 begin 467 C.CorrAccounts := GetAlias(TgdvLedgerFieldInfo(FI).AccountKey); 468 C.AccountPart := TgdvLedgerFieldInfo(FI).AccountPart; 469 end; 470 471 iTmp:= 0; 472 A := ''; 473 sDName:= ''; sMName:= ''; sQName:= ''; sYName:= ''; 474 for I := 0 to frAcctAnalyticsGroup.Selected.Count - 1 do 475 begin 476 if frAcctAnalyticsGroup.Selected[I].FieldName = ENTRYDATE then begin 477 iTmp:= 1; 478 sDName:= 'NAME' + IntToStr(I); 479 end 480 else if frAcctAnalyticsGroup.Selected[I].FieldName = MONTH then begin 481 iTmp:= iTmp + 2; 482 sMName:= 'NAME' + IntToStr(I); 483 end 484 else if frAcctAnalyticsGroup.Selected[I].FieldName = 'QUARTER' then begin 485 iTmp:= iTmp + 4; 486 sQName:= 'NAME' + IntToStr(I); 487 end 488 else if frAcctAnalyticsGroup.Selected[I].FieldName = 'YEAR' then begin 489 iTmp:= iTmp + 8; 490 sYName:= 'NAME' + IntToStr(I); 491 end; 492 493 if (frAcctAnalyticsGroup.Selected[I].Field <> nil) and 494 (frAcctAnalyticsGroup.Selected[I].FieldName <> ENTRYDATE) then 495 begin 496 FieldName := Format('c%d', [I]); 497 F := gdvObject.FindField(FieldName); 498 if (F <> nil) and not F.IsNull then 499 begin 500 if A > '' then A := A + #13#10; 501 502 A := A + frAcctAnalyticsGroup.Selected[I].FieldName + '=' + Trim(F.AsString); 503 end; 504 end; 505 end; 506 507 dtBegin:= DateBegin; 508 dtEnd:= DateEnd; 509 case iTmp of 510 1, 3, 5, 7, 9, 11, 13, 15:begin // EntryDate ? ?? ????? ??? ??? 511 sTmp:= gdvObject.FieldByName(sDName).AsString; 512 dtBegin:= EncodeDate(StrToInt(Copy(sTmp, 1, 4)), StrToInt(Copy(sTmp, 6, 2)), StrToInt(Copy(sTmp, 9, 2))); 513 dtEnd:= dtBegin; 514 end; 515 2, 6:begin // ?????? ????? 516 wM:= StrToInt(gdvObject.FieldByName(sMName).AsString); 517 DecodeDate(dtBegin, wBY, wBM, wBD); 518 DecodeDate(dtEnd, wEY, wEM, wED); 519 if wBY = wEY then begin 520 if wBM = wM then 521 dtBegin:= EncodeDate(wBY, wM, wBD) 522 else 523 dtBegin:= EncodeDate(wBY, wM, 1); 524 if wEM = wM then 525 dtEnd:= EncodeDate(wBY, wM, wED) 526 else 527 dtEnd:= EncodeDate(wBY, wM, GetMonthLastDay(wM, wBY)); 528 end 529 else if (wEY - wBY = 1) and (wBM > wEM) then begin 530 if wM >= wBM then begin 531 if wM = wBM then 532 dtBegin:= EncodeDate(wBY, wM, wBD) 533 else 534 dtBegin:= EncodeDate(wBY, wM, 1); 535 dtEnd:= EncodeDate(wBY, wM, GetMonthLastDay(wM, wBY)) 536 end 537 else begin 538 dtBegin:= EncodeDate(wEY, wM, 1); 539 if wM = wEM then 540 dtEnd:= EncodeDate(wEY, wM, wED) 541 else 542 dtEnd:= EncodeDate(wEY, wM, GetMonthLastDay(wM, wEY)); 543 end; 544 end 545 else if (wEY - wBY = 2) and (wM > wEM) and (wM < wBM) then begin 546 dtBegin:= EncodeDate(wBY + 1, wM, 1); 547 dtEnd:= EncodeDate(wBY + 1, wM, GetMonthLastDay(wM, wBY + 1)); 548 end; 549 end; 550 4:begin // ?????? ??????? 551 wQ:= StrToInt(gdvObject.FieldByName(sQName).AsString); 552 DecodeDate(dtBegin, wBY, wBM, wBD); 553 DecodeDate(dtEnd, wEY, wEM, wED); 554 GetQuarterMonths(wQ, wQBM, wQEM); 555 if wBY = wEY then begin 556 if (wQBM <= wBM) and (wQEM >= wEM) then begin 557 dtBegin:= EncodeDate(wBY, wBM, wBD); 558 dtEnd:= EncodeDate(wBY, wEM, wED); 559 end 560 else if (wQBM <= wBM) and (wQEM >= wBM) then begin 561 dtBegin:= EncodeDate(wBY, wBM, wBD); 562 dtEnd:= EncodeDate(wBY, wQEM, GetMonthLastDay(wQEM, wBY)); 563 end 564 else if (wQBM <= wEM) and (wQEM >= wEM) then begin 565 dtBegin:= EncodeDate(wBY, wQBM, 1); 566 dtEnd:= EncodeDate(wBY, wEM, wED); 567 end 568 else begin 569 dtBegin:= EncodeDate(wBY, wQBM, 1); 570 dtEnd:= EncodeDate(wBY, wQEM, GetMonthLastDay(wQEM, wBY)); 571 end; 572 end 573 else if (wEY - wBY = 1) and (wBM > wEM) then begin 574 if (wQBM <= wBM) and (wQEM >= wBM) then begin 575 dtBegin:= EncodeDate(wBY, wBM, wBD); 576 dtEnd:= EncodeDate(wBY, wQEM, GetMonthLastDay(wQEM, wBY)); 577 end 578 else if (wQBM <= wEM) and (wQEM >= wEM) then begin 579 dtBegin:= EncodeDate(wEY, wQBM, 1); 580 dtEnd:= EncodeDate(wEY, wEM, wED); 581 end 582 else begin 583 if wBM < wQBM then begin 584 dtBegin:= EncodeDate(wBY, wQBM, 1); 585 dtEnd:= EncodeDate(wBY, wQEM, GetMonthLastDay(wQEM, wBY)); 586 end 587 else begin 588 dtBegin:= EncodeDate(wEY, wQBM, 1); 589 dtEnd:= EncodeDate(wEY, wQEM, GetMonthLastDay(wQEM, wEY)); 590 end; 591 end; 592 end 593 else if (wEY - wBY = 2) and (wQBM > wEM) and (wQEM < wBM) then begin 594 dtBegin:= EncodeDate(wBY + 1, wQBM, 1); 595 dtEnd:= EncodeDate(wBY + 1, wQEM, GetMonthLastDay(wQEM, wBY + 1)); 596 end; 597 end; 598 8:begin // ?????? ??? 599 wY:= StrToInt(gdvObject.FieldByName(sYName).AsString); 600 DecodeDate(dtBegin, wBY, wBM, wBD); 601 DecodeDate(dtEnd, wEY, wEM, wED); 602 if wY = wBY then 603 dtBegin:= EncodeDate(wY, wBM, wBD) 604 else 605 dtBegin:= EncodeDate(wY, 1, 1); 606 if wY = wEY then 607 dtEnd:= EncodeDate(wY, wEM, wED) 608 else 609 dtEnd:= EncodeDate(wY, 12, 31); 610 end; 611 10, 14:begin // ????? ? ??? 612 wY:= StrToInt(gdvObject.FieldByName(sYName).AsString); 613 wM:= StrToInt(gdvObject.FieldByName(sMName).AsString); 614 DecodeDate(dtBegin, wBY, wBM, wBD); 615 DecodeDate(dtEnd, wEY, wEM, wED); 616 if (wBY = wY) and (wBM = wM) then 617 dtBegin:= EncodeDate(wY, wM, wBD) 618 else 619 dtBegin:= EncodeDate(wY, wM, 1); 620 if (wEY = wY) and (wEM = wM) then 621 dtEnd:= EncodeDate(wY, wM, wED) 622 else 623 dtEnd:= EncodeDate(wY, wM, GetMonthLastDay(wM, wY)); 624 end; 625 12:begin // ??? ? ??????? 626 wQ:= StrToInt(gdvObject.FieldByName(sQName).AsString); 627 wY:= StrToInt(gdvObject.FieldByName(sYName).AsString); 628 DecodeDate(dtBegin, wBY, wBM, wBD); 629 DecodeDate(dtEnd, wEY, wEM, wED); 630 GetQuarterMonths(wQ, wQBM, wQEM); 631 if (wEY = wBY) and (wQBM <= wBM) and (wQEM >= wEM) then begin 632 dtBegin:= EncodeDate(wY, wBM, wBD); 633 dtEnd:= EncodeDate(wY, wEM, wED); 634 end 635 else if (wY = wBY) and (wQBM <= wBM) and (wQEM >= wBM) then begin 636 dtBegin:= EncodeDate(wY, wBM, wBD); 637 dtEnd:= EncodeDate(wY, wQEM, GetMonthLastDay(wQEM, wY)); 638 end 639 else if (wY = wEY) and (wQBM <= wEM) and (wQEM >= wEM) then begin 640 dtBegin:= EncodeDate(wY, wQBM, 1); 641 dtEnd:= EncodeDate(wY, wEM, wED); 642 end 643 else begin 644 dtBegin:= EncodeDate(wY, wQBM, 1); 645 dtEnd:= EncodeDate(wY, wQEM, GetMonthLastDay(wQEM, wY)); 646 end; 647 end; 648 end; 649 650 // ??????? ??????????? ?? ?????????? ?? "??????????? ?? ??????????" 651 if A > '' then 652 begin 653 if C.Analytics > '' then 654 C.Analytics := C.Analytics + #13#10 + A 655 else 656 C.Analytics := A; 657 end; 658 659 if not NewWindow or (Form = nil) then 660 begin 661 with Tgdv_frmAcctAccCard(Tgdv_frmAcctAccCard.CreateAndAssign(Application)) do 662 begin 663 DateBegin := dtBegin; 664 DateEnd := dtEnd; 665 666 Show; 667 Execute(C); 668 end; 669 end else 670 begin 671 with Tgdv_frmAcctAccCard(Tgdv_frmAcctAccCard.Create(Application)) do 672 begin 673 DateBegin := dtBegin; 674 DateEnd := dtEnd; 675 676 Show; 677 Execute(C); 678 end; 679 end; 680 finally 681 C.Free; 682 end; 683 end; 684end; 685 686procedure Tgdv_frmAcctLedger.BuildAcctReport; 687begin 688 if (frAcctAnalyticsGroup.Selected.Count = 0) and not gdvObject.MakeEmpty then 689 begin 690 MessageBox(0, 691 PChar(MSG_INPUTANGROUPANALYTIC), 692 '????????', 693 MB_OK or MB_ICONEXCLAMATION or MB_TASKMODAL); 694 if not actShowParamPanel.Checked then 695 actShowParamPanel.Execute; 696 end 697 else 698 inherited; 699end; 700 701function Tgdv_frmAcctLedger.GetSaldoBeginSQL: string; 702var 703 I: Integer; 704 DebitCreditSQL: string; 705 F: TatRelationField; 706 SelectClause, FromClause, FromClause1, GroupClause, OrderClause: string; 707 IDSelect, NameSelect, WhereClause, QuantityGroup: String; 708 Alias, Name: string; 709 CurrId, HavingClause: string; 710 NcuDecDig, CurrDecDig: String; 711 AnalyticFilter: string; 712 K: Integer; 713 ValueAlias, QuantityAlias: String; 714 Strings: TgdvCorrFieldInfoList; 715 SortName, SortSelect: string; 716 VKeyAlias: string; 717 NcuBegin, CurrBegin: string; 718begin 719 Result := ''; 720 Strings := TgdvCorrFieldInfoList.Create; 721 try 722 DebitCreditSQL := ''; 723 FromClause := ''; 724 FromClause1 := ''; 725 GroupClause := ''; 726 OrderClause := ''; 727 IDSelect := ''; 728 NameSelect := ''; 729 WhereClause := ''; 730 731 frAcctAnalytics.Alias := 'e'; 732 AnalyticFilter := frAcctAnalytics.Condition; 733 if AnalyticFilter > '' then 734 AnalyticFilter := ' AND '#13#10 + AnalyticFilter + #13#10; 735 736 if frAcctSum.InCurr and (frAcctSum.CurrKey > 0) then 737 CurrId := Format(' AND e.currkey = %d'#13#10, [frAcctSum.CurrKey]) 738 else 739 CurrId := ''; 740 741 NcuDecDig := Format('NUMERIC(15, %d)', [frAcctSum.NcuDecDigits]); 742 CurrDecDig := Format('NUMERIC(15, %d)', [frAcctSum.CurrDecDigits]); 743 744 SelectClause := ''; 745 for I := 0 to frAcctAnalyticsGroup.Selected.Count - 1 do 746 begin 747 F := frAcctAnalyticsGroup.Selected[I].Field; 748 749 if (F = nil) or (F.FieldName = ENTRYDATE) then Break; 750 Alias := Format('c%d', [I]); 751 Name := Format('NAME%d', [I]); 752 SortName := Format('s%d', [I]); 753 754 //GetDebitSumSelectClause; 755 //GetCreditSumSelectClause; 756 757 if IDSelect > '' then IDSelect := IDSelect + ', '#13#10; 758 759 if F <> nil then 760 begin 761 if F.ReferencesField <> nil then 762 IDSelect := IDSelect + Format(' SUBSTRING(%s.%s from 1 for 180) AS %s', [Alias, 763 F.ReferencesField.FieldName, Alias]) 764 else 765 begin 766 IDSelect := IDSelect + Format(' SUBSTRING(e.%s from 1 for 180) AS %s', [F.FieldName, Alias]); 767 end; 768 end else 769 begin 770 IDSelect := IDSelect + Format(' SUBSTRING(g_d_getdateparam(e.entrydate, %s) from 1 for 180)AS %s', 771 [frAcctAnalyticsGroup.Selected[I].Additional, Alias]) 772 end; 773 774 if NameSelect > '' then NameSelect := NameSelect + ', '#13#10; 775 776 if F <> nil then 777 begin 778 if F.ReferencesField <> nil then 779 begin 780 if F.Field.RefListFieldName = '' then 781 NameSelect := NameSelect + Format(' SUBSTRING(%s.%s from 1 for 180) AS %s', [Alias, 782 F.References.ListField.FieldName, Name]) 783 else 784 NameSelect := NameSelect + Format(' SUBSTRING(%s.%s from 1 for 180) AS %s', [Alias, 785 F.Field.RefListFieldName, Name]); 786 end else 787 begin 788 NameSelect := NameSelect + Format(' SUBSTRING(e.%s from 1 for 180) AS %s', 789 [F.FieldName, Name]); 790 end; 791 end else 792 begin 793 NameSelect := NameSelect + Format(' SUBSTRING(g_d_getdateparam(e.entrydate, %s) from 1 for 180)AS %s', 794 [frAcctAnalyticsGroup.Selected[I].Additional, Name]) 795 end; 796 797 if SortSelect > '' then SortSelect := SortSelect + ', '#13#10; 798 799 if F <> nil then 800 begin 801 if F.ReferencesField <> nil then 802 begin 803 if F.Field.RefListFieldName = '' then 804 SortSelect := SortSelect + Format(' SUBSTRING(%s.%s from 1 for 180) AS %s', [Alias, 805 F.References.ListField.FieldName, SortName]) 806 else 807 SortSelect := SortSelect + Format(' SUBSTRING(%s.%s from 1 for 180) AS %s', [Alias, 808 F.Field.RefListFieldName, SortName]) 809 end else 810 begin 811 SortSelect := SortSelect + Format(' SUBSTRING(e.%s from 1 for 180) AS %s', 812 [F.FieldName, SortName]); 813 end 814 end else 815 begin 816 SortSelect := SortSelect + Format(' SUBSTRING(g_d_getdateparam(e.entrydate, %s) from 1 for 180)AS %s', 817 [frAcctAnalyticsGroup.Selected[I].Additional, SortName]) 818 end; 819 820 SelectClause := SortSelect + ', '#13#10 + IDSelect + ', '#13#10 + NameSelect; 821 822 if (F <> nil) and (F.ReferencesField <> nil) then 823 begin 824 FromClause := FromClause + Format(' LEFT JOIN %s %s ON %s.%s = e.%s'#13#10, 825 [F.References.RelationName, Alias, Alias, F.ReferencesField.FieldName, 826 F.FieldName]); 827 end; 828 829 if GroupClause > '' then GroupClause := GroupClause + ', '; 830 831 if F <> nil then 832 begin 833 if F.ReferencesField <> nil then 834 begin 835 if F.Field.RefListFieldName = '' then 836 GroupClause := GroupClause + Format('%s.%s, %s.%s', [Alias, 837 F.References.ListField.FieldName, Alias, F.ReferencesField.FieldName]) 838 else 839 GroupClause := GroupClause + Format('%s.%s, %s.%s', [Alias, 840 F.Field.RefListFieldName, Alias, F.ReferencesField.FieldName]); 841 end else 842 begin 843 GroupClause := GroupClause + Format('e.%s', [F.FieldName]) 844 end; 845 end else 846 begin 847 GroupClause := GroupClause + Format('g_d_getdateparam(e.entrydate, %s)', 848 [frAcctAnalyticsGroup.Selected[I].Additional]) 849 end; 850 //**** 851 if OrderClause > '' then OrderClause := OrderClause + ', '; 852 853 if F <> nil then 854 begin 855 if F.ReferencesField <> nil then 856 begin 857 if F.Field.RefListFieldName = '' then 858 OrderClause := OrderClause + Format('%s.%s, %s.%s', [Alias, 859 F.References.ListField.FieldName, Alias, F.ReferencesField.FieldName]) 860 else 861 OrderClause := OrderClause + Format('%s.%s, %s.%s', [Alias, 862 F.Field.RefListFieldName, Alias, F.ReferencesField.FieldName]) 863 end else 864 begin 865 OrderClause := OrderClause + Format('e.%s', [F.FieldName]) 866 end; 867 end else 868 begin 869 OrderClause := OrderClause + Format('g_d_getdateparam(e.entrydate, %s)', 870 [frAcctAnalyticsGroup.Selected[I].Additional]) 871 end; 872 //**** 873 QuantityGroup := ''; 874 if FValueList.Count > 0 then 875 begin 876 for K := 0 to FValueList.Count - 1 do 877 begin 878 VKeyAlias := gdvObject.GetKeyAlias(FValueList.Names[K]); 879 ValueAlias := 'v_' + gdvObject.GetKeyAlias(FValueList.Names[K]); 880 QuantityAlias := 'q_' + gdvObject.GetKeyAlias(FValueList.Names[K]); 881 882 if not FEntryDateIsFirst then 883 begin 884 SelectClause := SelectClause + ','#13#10 + 885 Format(' SUM(IIF(e.accountpart = ''D'', %s.quantity, 0)) - '#13#10 + 886 ' SUM(IIF(e.accountpart = ''C'', %s.quantity, 0)) AS Q_B_S_%s'#13#10, 887 [QuantityAlias, QuantityAlias, VKeyAlias]); 888 if I = 0 then 889 begin 890 FromClause := FromClause + #13#10 + 891 Format(' LEFT JOIN ac_quantity %s ON %s.entrykey = e.id AND '#13#10 + 892 ' %s.valuekey = %s ', [QuantityAlias, QuantityAlias, 893 QuantityAlias, FValueList.Names[K]]); 894 end; 895 end; 896 end; 897 end; 898 end; 899 900 if not FEntryDateIsFirst then 901 begin 902 NcuBegin := 903 Format(' CAST(SUM(e.debitncu - e.creditncu) / %d AS %s) AS NCU_BEGIN_SALDO '#13#10, 904 [frAcctSum.NcuScale, NcuDecDig]); 905 if frAcctSum.InCurr then 906 begin 907 CurrBegin := 908 Format(' CAST(SUM(e.debitcurr - e.creditcurr) / %d AS %s) AS CURR_BEGIN_SALDO '#13#10, 909 [frAcctSum.CurrScale, CurrDecDig]); 910 end else 911 begin 912 CurrBegin := 913 Format(' CAST(0 AS %s) AS CURR_BEGIN_SALDO '#13#10, [CurrDecDig]); 914 end; 915 916 HavingClause := {GetHavingClause}''; 917 if HavingClause > '' then HavingClause := HavingClause + ' OR '#13#10 ; 918 HavingClause := HavingClause + ' SUM(e.debitncu - e.creditncu) <> 0 '#13#10 ; 919 920 if frAcctSum.InCurr then 921 begin 922 HavingClause := HavingClause + 923 ' OR SUM(e.debitcurr) <> 0 OR SUM(e.creditcurr) <> 0 '; 924 end; 925 926 HavingClause := 'HAVING ' + HavingClause; 927 928 DebitCreditSQL := Format(cBeginSaldoSQLTemplate, [SelectClause, NcuBegin, 929 CurrBegin, FromClause, Format('e.accountkey IN(%s) AND ', [IDList(FAccountIDs)]), frAcctCompany.CompanyList, 930 CurrId, gdvObject.InternalMovementClause + AnalyticFilter, GroupClause, HavingClause]); 931 end; 932 933 DebitCreditSQL := DebitCreditSQL + #13#10'ORDER BY ' + OrderClause; 934 935 Result := DebitCreditSQL; 936 finally 937 Strings.Free; 938 end; 939end; 940 941procedure Tgdv_frmAcctLedger.FillBeginSaldoStructire; 942var 943 SQL: TIBSQL; 944 Name: string; 945 Index: Integer; 946 I, J: Integer; 947 F: TatRelationField; 948 V: Tgdv_Value; 949 VKeyAlias: string; 950begin 951 if FEntryDateInFields and not FEntryDateIsFirst then 952 begin 953 if FSaldoValueList = nil then 954 FSaldoValueList := Tgdv_ValueList.Create 955 else 956 FSaldoValueList.Clear; 957 958 SQL := TIBSQL.Create(nil); 959 try 960 SQL.Transaction := gdcBaseManager.ReadTransaction; 961 SQL.SQL.Text := GetSaldoBeginSQL; 962 SQL.ParamByName('begindate').AsDateTime := Self.DateBegin; 963 SQL.ExecQuery; 964 while not SQL.Eof do 965 begin 966 V := nil; 967 for I := 0 to frAcctAnalyticsGroup.Selected.Count - 1 do 968 begin 969 F := frAcctAnalyticsGroup.Selected[I].Field; 970 971 if (F = nil) or (F.FieldName = ENTRYDATE) then Break; 972 Name := Format('c%d', [I]); 973 974 if V = nil then 975 begin 976 Index := FSaldoValueList.IndexOf(SQL.FieldByName(Name).AsString); 977 if Index = - 1 then 978 begin 979 Index := FSaldoValueList.Add2(SQL.FieldByName(Name).AsString); 980 end; 981 V := FSaldoValueList.Items[Index]; 982 end else 983 begin 984 Index := V.Values.IndexOf(SQL.FieldByName(Name).AsString); 985 if Index = - 1 then 986 begin 987 Index := V.Values.Add2(SQL.FieldByName(Name).AsString); 988 end; 989 990 V := V.Values.Items[Index]; 991 end; 992 end; 993 994 if V <> nil then 995 begin 996 V.SaldoValues.AddSaldoValue('NCU_BEGIN_SALDO', 997 SQL.FieldByName('NCU_BEGIN_SALDO').AsCurrency); 998 V.SaldoValues.AddSaldoValue('CURR_BEGIN_SALDO', 999 SQL.FieldByName('CURR_BEGIN_SALDO').AsCurrency); 1000 for J := 0 to FValueList.Count - 1 do 1001 begin 1002 VKeyAlias := gdvObject.GetKeyAlias(FValueList.Names[J]); 1003 Name := Format('Q_B_S_%s', [VKeyAlias]); 1004 V.SaldoValues.AddSaldoValue(Name, SQL.FieldByName(Name).AsCurrency); 1005 end; 1006 end; 1007 1008 SQL.Next; 1009 end; 1010 finally 1011 SQL.Free; 1012 end; 1013 end; 1014end; 1015 1016procedure Tgdv_frmAcctLedger.CalcBeginSaldo; 1017var 1018 I, J: Integer; 1019 V: Tgdv_Value; 1020 F: TatRelationField; 1021 Name, VKeyAlias: string; 1022 Index: Integer; 1023 C: Currency; 1024 Values, OldValues: TStringList; 1025 B: Boolean; 1026 SV: Tgdv_SaldoValues; 1027 1028 procedure SetSaldo(SV: Tgdv_SaldoValues); 1029 var 1030 Index, J: Integer; 1031 C: Currency; 1032 begin 1033 Index := SV.IndexOf('NCU_BEGIN_SALDO'); 1034 if Index > - 1 then 1035 begin 1036 C := SV[Index].SaldoValue; 1037 if C > 0 then 1038 begin 1039 gdvObject.FieldByName('NCU_BEGIN_DEBIT').AsCurrency := C; 1040 gdvObject.FieldByName('NCU_BEGIN_CREDIT').AsCurrency := 0; 1041 end else 1042 begin 1043 gdvObject.FieldByName('NCU_BEGIN_DEBIT').AsCurrency := 0; 1044 gdvObject.FieldByName('NCU_BEGIN_CREDIT').AsCurrency := - C; 1045 end; 1046 end; 1047 1048 Index := SV.IndexOf('CURR_BEGIN_SALDO'); 1049 if Index > - 1 then 1050 begin 1051 C := SV[Index].SaldoValue; 1052 if C > 0 then 1053 begin 1054 gdvObject.FieldByName('CURR_BEGIN_DEBIT').AsCurrency := C; 1055 gdvObject.FieldByName('CURR_BEGIN_CREDIT').AsCurrency := 0; 1056 end else 1057 begin 1058 gdvObject.FieldByName('CURR_BEGIN_DEBIT').AsCurrency := 0; 1059 gdvObject.FieldByName('CURR_BEGIN_CREDIT').AsCurrency := - C; 1060 end; 1061 end; 1062 1063 for J := 0 to FValueList.Count - 1 do 1064 begin 1065 VKeyAlias := gdvObject.GetKeyAlias(FValueList.Names[J]); 1066 Name := Format('Q_B_S_%s', [VKeyAlias]); 1067 Index := SV.IndexOf(Name); 1068 1069 if Index > - 1 then 1070 begin 1071 C := SV[Index].SaldoValue; 1072 if C > 0 then 1073 begin 1074 gdvObject.FieldByName(Format('Q_B_D_%s', [VKeyAlias])).AsCurrency := C; 1075 gdvObject.FieldByName(Format('Q_B_C_%s', [VKeyAlias])).AsCurrency := 0; 1076 end else 1077 begin 1078 gdvObject.FieldByName(Format('Q_B_D_%s', [VKeyAlias])).AsCurrency := 0; 1079 gdvObject.FieldByName(Format('Q_B_C_%s', [VKeyAlias])).AsCurrency := - C; 1080 end; 1081 end; 1082 end; 1083 end; 1084 1085 function Changed: boolean; 1086 var 1087 J: Integer; 1088 begin 1089 Result := False; 1090 //????????? ?????????? ?? ???????? ???????? 1091 for J := 0 to FTotals.Count - 1 do 1092 begin 1093 F := FTotals[J].atRelationField; 1094 if (F = nil) or (F.FieldName = ENTRYDATE) then Break; 1095 1096 Result := FTotals[J].Field.AsString <> Values[J]; 1097 end; 1098 end; 1099 1100 function Get_gdvValue: Tgdv_Value; 1101 var 1102 I, Index: Integer; 1103 Name: string; 1104 begin 1105 Result := nil; 1106 for I := 0 to FTotals.Count - 1 do 1107 begin 1108 F := FTotals[I].atRelationField; 1109 1110 if (F = nil) or (F.FieldName = ENTRYDATE) then Break; 1111 Name := Format('c%d', [I]); 1112 1113 if Result = nil then 1114 begin 1115 Index := FSaldoValueList.IndexOf(gdvObject.FieldByName(Name).AsString); 1116 if Index = - 1 then 1117 begin 1118 Result := nil; 1119 Break; 1120 end; 1121 Result := FSaldoValueList.Items[Index]; 1122 end else 1123 begin 1124 Index := Result.Values.IndexOf(gdvObject.FieldByName(Name).AsString); 1125 if Index = - 1 then 1126 begin 1127 Result := nil; 1128 Break; 1129 end; 1130 1131 Result := Result.Values.Items[Index]; 1132 end; 1133 end; 1134 end; 1135 1136begin 1137 gdvObject.DisableControls; 1138 try 1139 gdvObject.First; 1140 Values := TStringList.Create; 1141 OldValues := TStringList.Create; 1142 try 1143 for I := 0 to FTotals.Count - 1 do 1144 begin 1145 F := FTotals[I].atRelationField; 1146 if (F = nil) or (F.FieldName = ENTRYDATE) then Break; 1147 1148 Values.Add('####2@##!@#@#$#$'{FTotals[I].Field.AsString}); 1149 end; 1150 1151 SV := Tgdv_SaldoValues.Create; 1152 try 1153 SV.AddSaldoValue('NCU_BEGIN_SALDO', 0); 1154 SV.AddSaldoValue('CURR_BEGIN_SALDO', 0); 1155 for J := 0 to FValueList.Count - 1 do 1156 begin 1157 VKeyAlias := gdvObject.GetKeyAlias(FValueList.Names[J]); 1158 Name := Format('Q_B_S_%s', [VKeyAlias]); 1159 SV.AddSaldoValue(Name, 0); 1160 end; 1161 1162 while not gdvObject.Eof do 1163 begin 1164 gdvObject.Edit; 1165 //????????? ?????????? ?? ???????? ???????? 1166 B := Changed; 1167 1168 if B then 1169 begin 1170 //?????????? ????? ???????? ????????? 1171 for J := 0 to FTotals.Count - 1 do 1172 begin 1173 F := FTotals[J].atRelationField; 1174 1175 if (F = nil) or (F.FieldName = ENTRYDATE) then Break; 1176 1177 Values[J] := FTotals[J].Field.AsString; 1178 end; 1179 1180 V := Get_gdvValue; 1181 1182 if V <> nil then 1183 begin 1184 //??????????? ???????? ?????????? ?????? 1185 SetSaldo(V.SaldoValues); 1186 end else 1187 begin 1188 gdvObject.FieldByName('NCU_BEGIN_DEBIT').AsCurrency := 0; 1189 gdvObject.FieldByName('NCU_BEGIN_CREDIT').AsCurrency := 0; 1190 gdvObject.FieldByName('CURR_BEGIN_DEBIT').AsCurrency := 0; 1191 gdvObject.FieldByName('CURR_BEGIN_CREDIT').AsCurrency := 0; 1192 for J := 0 to FValueList.Count - 1 do 1193 begin 1194 VKeyAlias := gdvObject.GetKeyAlias(FValueList.Names[J]); 1195 1196 gdvObject.FieldByName(Format('Q_B_D_%s', [VKeyAlias])).AsCurrency := 0; 1197 gdvObject.FieldByName(Format('Q_B_C_%s', [VKeyAlias])).AsCurrency := 0; 1198 end; 1199 end; 1200 end else 1201 begin 1202 SetSaldo(SV); 1203 end; 1204 1205 //????????? ???????? ?????? 1206 C := gdvObject.FieldByName('NCU_BEGIN_DEBIT').AsCurrency - 1207 gdvObject.FieldByName('NCU_BEGIN_CREDIT').AsCurrency + 1208 gdvObject.FieldByName('NCU_DEBIT').AsCurrency - 1209 gdvObject.FieldByName('NCU_CREDIT').AsCurrency; 1210 1211 if C > 0 then 1212 begin 1213 gdvObject.FieldByName('NCU_END_DEBIT').AsCurrency := C; 1214 gdvObject.FieldByName('NCU_END_CREDIT').AsCurrency := 0; 1215 end else 1216 begin 1217 gdvObject.FieldByName('NCU_END_DEBIT').AsCurrency := 0; 1218 gdvObject.FieldByName('NCU_END_CREDIT').AsCurrency := - C; 1219 end; 1220 1221 Index := SV.IndexOf('NCU_BEGIN_SALDO'); 1222 SV[Index].SaldoValue := C; 1223 1224 C := gdvObject.FieldByName('CURR_BEGIN_DEBIT').AsCurrency - 1225 gdvObject.FieldByName('CURR_BEGIN_CREDIT').AsCurrency + 1226 gdvObject.FieldByName('CURR_DEBIT').AsCurrency - 1227 gdvObject.FieldByName('CURR_CREDIT').AsCurrency; 1228 1229 if C > 0 then 1230 begin 1231 gdvObject.FieldByName('CURR_END_DEBIT').AsCurrency := C; 1232 gdvObject.FieldByName('CURR_END_CREDIT').AsCurrency := 0; 1233 end else 1234 begin 1235 gdvObject.FieldByName('CURR_END_DEBIT').AsCurrency := 0; 1236 gdvObject.FieldByName('CURR_END_CREDIT').AsCurrency := - C; 1237 end; 1238 1239 Index := SV.IndexOf('CURR_BEGIN_SALDO'); 1240 SV[Index].SaldoValue := C; 1241 1242 for J := 0 to FValueList.Count - 1 do 1243 begin 1244 VKeyAlias := gdvObject.GetKeyAlias(FValueList.Names[J]); 1245 1246 C := gdvObject.FieldByName(Format('Q_B_D_%s', [VKeyAlias])).AsCurrency - 1247 gdvObject.FieldByName(Format('Q_B_C_%s', [VKeyAlias])).AsCurrency + 1248 gdvObject.FieldByName(Format('Q_D_%s', [VKeyAlias])).AsCurrency - 1249 gdvObject.FieldByName(Format('Q_C_%s', [VKeyAlias])).AsCurrency; 1250 1251 if C > 0 then 1252 begin 1253 gdvObject.FieldByName(Format('Q_E_D_%s', [VKeyAlias])).AsCurrency := C; 1254 gdvObject.FieldByName(Format('Q_E_C_%s', [VKeyAlias])).AsCurrency := 0; 1255 end else 1256 begin 1257 gdvObject.FieldByName(Format('Q_E_D_%s', [VKeyAlias])).AsCurrency := 0; 1258 gdvObject.FieldByName(Format('Q_E_C_%s', [VKeyAlias])).AsCurrency := - C; 1259 end; 1260 Index := SV.IndexOf(Format('Q_B_S_%s', [VKeyAlias])); 1261 SV[Index].SaldoValue := C; 1262 end; 1263 gdvObject.Post; 1264 gdvObject.Next; 1265 end; 1266 finally 1267 SV.Free; 1268 end; 1269 finally 1270 Values.Free; 1271 OldValues.Free; 1272 end; 1273 finally 1274 gdvObject.EnableControls; 1275 end; 1276end; 1277 1278procedure Tgdv_frmAcctLedger.OnAnalyticGroupSelect(Sender: TObject); 1279begin 1280 frAcctTreeAnalytic.UpdateAnalyticsList(frAcctAnalyticsGroup.Selected); 1281end; 1282 1283function Tgdv_frmAcctLedger.CanGo_to: boolean; 1284const 1285 cTotal = '?????:'; 1286var 1287 i: integer; 1288begin 1289 if gdvObject.Active then 1290 begin 1291 Result:= True; 1292 for i := 0 to ibgrMain.Columns.Count - 1 do 1293 if Assigned(gdvObject.FindField(ibgrMain.Columns[i].FieldName)) 1294 and (gdvObject.FieldByName(ibgrMain.Columns[i].FieldName).AsString = cTotal) then 1295 begin 1296 Result:= False; 1297 Exit; 1298 end; 1299 end 1300 else 1301 Result := False; 1302end; 1303 1304function Tgdv_frmAcctLedger.CompareParams(WithDate: Boolean = True): Boolean; 1305var 1306 Stream: TMemoryStream; 1307begin 1308 Result := inherited CompareParams(WithDate) 1309 and ((FConfig as TAccLedgerConfig).ShowDebit = cbShowDebit.Checked) 1310 and ((FConfig as TAccLedgerConfig).ShowCredit = cbShowCredit.Checked) 1311 and ((FConfig as TAccLedgerConfig).ShowCorrSubAccounts = cbShowCorrSubAccount.Checked) 1312 and ((FConfig as TAccLedgerConfig).AnalyticListField = frAcctAnalyticsGroup.AnalyticListFields) 1313 and ((FConfig as TAccLedgerConfig).SumNull = cbSumNull.Checked) 1314 and ((FConfig as TAccLedgerConfig).EnchancedSaldo = cbEnchancedSaldo.Checked) 1315 and ((FConfig as TAccLedgerConfig).TreeAnalytic = frAcctTreeAnalytic.TreeAnalitic); 1316 1317 if Result then 1318 begin 1319 Stream := TMemoryStream.Create; 1320 try 1321 Stream.Size := 0; 1322 frAcctAnalyticsGroup.SaveToStream(Stream); 1323 Result := ((FConfig as TAccLedgerConfig).AnalyticsGroup.Size = Stream.Size) 1324 and (CompareMem(((FConfig as TAccLedgerConfig).AnalyticsGroup as TMemoryStream).Memory, Stream.Memory, Stream.Size)); 1325 finally 1326 FreeAndNil(Stream); 1327 end; 1328 end; 1329end; 1330 1331procedure Tgdv_frmAcctLedger.actSaveConfigUpdate(Sender: TObject); 1332begin 1333 TAction(Sender).Enabled := frAcctAnalyticsGroup.Selected.Count > 0; 1334end; 1335 1336procedure Tgdv_frmAcctLedger.FormDestroy(Sender: TObject); 1337begin 1338 inherited; 1339 FTotals.Free; 1340 FSaldoValueList.Free; 1341end; 1342 1343procedure Tgdv_frmAcctLedger.actRunUpdate(Sender: TObject); 1344begin 1345 inherited; 1346 UpdateEntryDateIsFirst; 1347 1348 cbEnchancedSaldo.Enabled := not FEntryDateIsFirst; 1349end; 1350 1351procedure Tgdv_frmAcctLedger.UpdateEntryDateIsFirst; 1352var 1353 I: Integer; 1354begin 1355 FEntryDateIsFirst := False; 1356 FEntryDateInFields := False; 1357 for I := 0 to frAcctAnalyticsGroup.Selected.Count - 1 do 1358 begin 1359 FEntryDateInFields := (frAcctAnalyticsGroup.Selected[I].FieldName = ENTRYDATE) or 1360 (not Assigned(frAcctAnalyticsGroup.Selected[I].Field)); 1361 if FEntryDateInFields then 1362 begin 1363 FEntryDateIsFirst := I = 0; 1364 Break; 1365 end; 1366 end; 1367end; 1368 1369procedure Tgdv_frmAcctLedger.SetParams; 1370var 1371 I: Integer; 1372begin 1373 inherited; 1374 1375 if not gdvObject.MakeEmpty then 1376 begin 1377 for I := 0 to frAcctAnalyticsGroup.Selected.Count - 1 do 1378 TgdvAcctLedger(gdvObject).AddGroupBy(frAcctAnalyticsGroup.Selected[I]); 1379 1380 for I := 0 to frAcctTreeAnalytic.Count - 1 do 1381 TgdvAcctLedger(gdvObject).AddAnalyticLevel(frAcctTreeAnalytic.Lines[I].Field.FieldName, frAcctTreeAnalytic.Lines[I].Levels.Text); 1382 1383 TgdvAcctLedger(gdvObject).ShowDebit := cbShowDebit.Checked; 1384 TgdvAcctLedger(gdvObject).ShowCredit := cbShowCredit.Checked; 1385 TgdvAcctLedger(gdvObject).ShowCorrSubAccounts := cbShowCorrSubAccount.Checked; 1386 TgdvAcctLedger(gdvObject).EnchancedSaldo := cbEnchancedSaldo.Checked; 1387 TgdvAcctLedger(gdvObject).SumNull := cbSumNull.Checked; 1388 end; 1389end; 1390 1391function Tgdv_frmAcctLedger.GetGdvObject: TgdvAcctBase; 1392begin 1393 Result := ibdsMain; 1394end; 1395 1396{ Tgdv_ValueList } 1397 1398function Tgdv_ValueList.Add(Value: string): Tgdv_Value; 1399begin 1400 Result := Tgdv_Value.Create; 1401 Result.Value := Value; 1402 if FValues = nil then 1403 FValues := TStringList.Create; 1404 1405 FValues.AddObject(Value, Result); 1406end; 1407 1408function Tgdv_ValueList.Add2(Value: string): Integer; 1409var 1410 V: Tgdv_Value; 1411begin 1412 V := Tgdv_Value.Create; 1413 V.Value := Value; 1414 if FValues = nil then 1415 FValues := TStringList.Create; 1416 1417 Result := FValues.AddObject(Value, V); 1418end; 1419 1420procedure Tgdv_ValueList.Clear; 1421var 1422 I: Integer; 1423begin 1424 if FValues <> nil then 1425 begin 1426 for I := 0 to FValues.Count - 1 do 1427 begin 1428 Tgdv_Value(FValues.Objects[I]).Free; 1429 FValues.Objects[I] := nil; 1430 end; 1431 FValues.Clear; 1432 end; 1433end; 1434 1435destructor Tgdv_ValueList.Destroy; 1436begin 1437 Clear; 1438 1439 inherited; 1440end; 1441 1442function Tgdv_ValueList.GetItems(Index: Integer): Tgdv_Value; 1443begin 1444 if FValues = nil then 1445 FValues := TStringList.Create; 1446 1447 Result := Tgdv_Value(FValues.Objects[Index]); 1448end; 1449 1450function Tgdv_ValueList.IndexOf(Value: string): Integer; 1451begin 1452 Result := -1 ; 1453 if FValues <> nil then 1454 begin 1455 FValues.Sorted := True; 1456 Result := FValues.IndexOf(Value); 1457 end; 1458end; 1459 1460{ Tgdv_Value } 1461 1462destructor Tgdv_Value.Destroy; 1463begin 1464 FValues.Free; 1465 FSaldoValues.Free; 1466 1467 inherited; 1468end; 1469 1470function Tgdv_Value.GetSaldoValues: Tgdv_SaldoValues; 1471begin 1472 if FSaldoValues = nil then 1473 FSaldoValues := Tgdv_SaldoValues.Create; 1474 Result := FSaldoValues; 1475end; 1476 1477function Tgdv_Value.GetValues: Tgdv_ValueList; 1478begin 1479 if FValues = nil then 1480 FValues := Tgdv_ValueList.Create; 1481 Result := FValues; 1482end; 1483 1484procedure Tgdv_Value.SetValue(const Value: string); 1485begin 1486 FValue := Value; 1487end; 1488 1489{ Tgdv_FieldValue } 1490 1491procedure Tgdv_SaldoValue.SetSaldoName(const Value: string); 1492begin 1493 FSaldoName := Value; 1494end; 1495 1496procedure Tgdv_SaldoValue.SetSaldoValue(const Value: Currency); 1497begin 1498 FSaldoValue := Value; 1499end; 1500 1501{ Tgdv_FieldValues } 1502 1503function Tgdv_SaldoValues.AddSaldoValue(SaldoName: string; 1504 SaldoValue: Currency): integer; 1505var 1506 V: Tgdv_SaldoValue; 1507begin 1508 V := Tgdv_SaldoValue.Create; 1509 V.SaldoName := SaldoName; 1510 V.SaldoValue := SaldoValue; 1511 Result := Add(V); 1512end; 1513 1514constructor Tgdv_SaldoValues.Create; 1515begin 1516 OwnsObjects := True; 1517end; 1518 1519function Tgdv_SaldoValues.GetSaldoList(Index: Integer): Tgdv_SaldoValue; 1520begin 1521 Result := Tgdv_SaldoValue(inherited Items[Index]) 1522end; 1523 1524function Tgdv_SaldoValues.IndexOf(FieldName: string): Integer; 1525var 1526 I: Integer; 1527begin 1528 Result := -1; 1529 for I := 0 to Count - 1 do 1530 begin 1531 if SaldoList[I].SaldoName = FieldName then 1532 begin 1533 Result := I; 1534 Exit; 1535 end; 1536 end; 1537end; 1538 1539procedure Tgdv_frmAcctLedger.ibdsMainAfterOpen(DataSet: TDataSet); 1540var 1541 Values, OldValues: TStringList; 1542 I, J, K: Integer; 1543 Insert: Boolean; 1544 //?????? ???????????? ????????? 1545 Count: Integer; 1546const 1547 cTotal = '?????:'; // ???? ???????? ?????, ?? ???? ???????? ? CanGo_to 1548begin 1549 inherited; 1550 if not FMakeEmpty then 1551 begin 1552 1553 gdvObject.DisableControls; 1554 try 1555 for I := 0 to gdvObject.Fields.Count - 1 do 1556 gdvObject.Fields[I].Required := False; 1557 1558 Values := TStringList.Create; 1559 OldValues := TStringList.Create; 1560 try 1561 //?????????????? ???? 1562 FTotals.InitField(gdvObject); 1563 //?????????????? ?????? ???????? 1564 for I := 0 to FTotals.Count - 1 do 1565 begin 1566 Values.Add(FTotals[I].Field.AsString); 1567 end; 1568 1569 if (not gdvObject.UseEntryBalance) and FEntryDateInFields and not FEntryDateIsFirst then 1570 begin 1571 FillBeginSaldoStructire; 1572 CalcBeginSaldo; 1573 end; 1574 1575 Count := 0; 1576 gdvObject.First; 1577 while not gdvObject.Eof do 1578 begin 1579 //????????? ?????????? ?? ???????? ???????? 1580 for I := 0 to FTotals.Count - 1 do 1581 begin 1582 Insert := FTotals[i].Field.AsString <> Values[I]; 1583 if Insert then 1584 begin 1585 //????????? ?????? ???????? 1586 OldValues.Assign(Values); 1587 1588 //?????????? ????? ???????? ????????? 1589 for J := 0 to FTotals.Count - 1 do 1590 begin 1591 Values[J] := FTotals[J].Field.AsString; 1592 end; 1593 1594 for J := FTotals.Count - 2 downto I do 1595 begin 1596 if (cbSumNull.Checked or (OldValues[J] > '')) and FTotals[J].Total then 1597 begin 1598 gdvObject.Insert; 1599 FTotals[J].ValueField.AsString := cTotal; 1600 FTotals[J].SetValues; 1601 1602 for K := 0 to I do 1603 begin 1604 FTotals[K].Field.AsString := OldValues[K]; 1605 end; 1606 gdvObject.FieldByName('sortfield').AsInteger := J + 2; 1607 gdvObject.Post; 1608 gdvObject.Next; 1609 end; 1610 FTotals[J].DropValues; 1611 end; 1612 1613 Break; 1614 end; 1615 end; 1616 1617 1618 FTotals.Calc; 1619 1620 gdvObject.Next; 1621 Inc(Count); 1622 end; 1623 if Count > 1 then 1624 begin 1625 for J := FTotals.Count - 2 downto 0 do 1626 begin 1627 if (cbSumNull.Checked or (OldValues[J] > '')) and FTotals[J].Total then 1628 begin 1629 gdvObject.Append; 1630 FTotals[J].ValueField.AsString := cTotal; 1631 FTotals[J].SetValues; 1632 1633 gdvObject.Post; 1634 gdvObject.Next; 1635 end; 1636 FTotals[J].DropValues; 1637 end; 1638 end; 1639 finally 1640 Values.Free; 1641 OldValues.Free; 1642 end; 1643 finally 1644 gdvObject.First; 1645 gdvObject.EnableControls; 1646 end; 1647 end; 1648end; 1649 1650procedure Tgdv_frmAcctLedger.ibdsMainCalcAggregates(DataSet: TDataSet; 1651 var Accept: Boolean); 1652var 1653 F: TField; 1654begin 1655 inherited; 1656 if FSortFieldIndex = - 1 then 1657 begin 1658 F := gdvObject.FindField('sortfield'); 1659 if F <> nil then 1660 FSortFieldIndex := F.Index; 1661 end; 1662 1663 Accept := (FSortFieldIndex > -1) and (gdvObject.Fields[FSortFieldIndex].AsInteger = 1); 1664end; 1665 1666procedure Tgdv_frmAcctLedger.actSaveGridSettingUpdate(Sender: TObject); 1667begin 1668 TAction(Sender).Enabled := (iblConfiguratior.CurrentKey > '') and (not cbShowDebit.Checked) and (not cbShowCredit.Checked); 1669 FSaveGridSetting := (iblConfiguratior.CurrentKey > '') and (not cbShowDebit.Checked) and (not cbShowCredit.Checked); 1670end; 1671 1672procedure Tgdv_frmAcctLedger.actClearGridSettingUpdate(Sender: TObject); 1673begin 1674 TAction(Sender).Enabled := iblConfiguratior.CurrentKey > ''; 1675end; 1676 1677initialization 1678 RegisterFrmClass(Tgdv_frmAcctLedger); 1679finalization 1680 UnRegisterFrmClass(Tgdv_frmAcctLedger); 1681end.