unit U_ActiveCurrency; interface uses Windows, U_LNG, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, cxLookAndFeelPainters, StdCtrls, cxButtons, cxControls, cxContainer, cxEdit, cxTextEdit, cxMaskEdit, cxDropDownEdit, cxMRUEdit, cxButtonEdit, U_Common, U_BaseCommon, Unit_DM_scs, siComp, siLngLnk, U_BaseConstants, cxGraphics, cxLookAndFeels, Menus; type TF_ActiveCurrency = class(TForm) GroupBox1: TGroupBox; Label3: TLabel; Label4: TLabel; Button_OK: TcxButton; Button_Cancel: TcxButton; ComboBox_Curr1: TcxComboBox; ComboBox_Curr2: TcxComboBox; Button_Curr1: TcxButton; Button_Curr2: TcxButton; lng_Forms: TsiLangLinked; procedure Button_OKClick(Sender: TObject); procedure Button_CancelClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure FormHide(Sender: TObject); procedure Button_Curr1Click(Sender: TObject); procedure Button_Curr2Click(Sender: TObject); procedure ComboBox_Curr1PropertiesChange(Sender: TObject); procedure ComboBox_Curr2PropertiesChange(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private declarations } GForm: TForm; GCanChangeCombo: Boolean; public { Public declarations } GChangeMCurrency: Boolean; GChangeSCurrency: Boolean; //OldRatio : Double; GNewRatio : Double; GCurrMRatio: Double; GNewMRatio: Double; procedure OpenCurrencyForm(AComboBoxChange, AComboBoxNotChange: TcxComboBox; var AChangeCurr, ANotChangeCurr: TCurrency; var AChangeFlag: Boolean); procedure ChangeComboBox(var AComboChange: TcxComboBox; AID_NotChangeCurrency: Integer; var AChangeCurr: TCurrency; var AChangeFlag: Boolean); function CheckSameCurrencies(AID_CurrChanged, AID_CurrNotChanged: Integer; ANameChanged: String): Boolean; Constructor Create(AOwner: TComponent; AForm: TForm); Destructor Destroy; override; end; {var F_ActiveCurrency: TF_ActiveCurrency; } implementation Uses {Unit_DM_scs,} DB, U_CaseForm, U_MAIN, U_SCSComponent; var //MCurr: TCurrency; //SCurr: TCurrency; Curr1, FirstCurr: TCurrency; Curr2: TCurrency; {$R *.dfm} // ##### Показать форму ##### procedure TF_ActiveCurrency.FormShow(Sender: TObject); //Var NameCurrency: String; //IndexP1 : Integer; //IndexP2 : Integer; begin GChangeMCurrency := false; GChangeSCurrency := false; with F_NormBase.DM.DataSet_CURRENCY do begin First; while not Eof do begin if FN('Main').AsInteger = 1 then begin Curr1 := GetCurrencyFromDataSet(F_NormBase.DM.DataSet_CURRENCY); FirstCurr := Curr1; end; if FN('Main').AsInteger = 2 then begin Curr2 := GetCurrencyFromDataSet(F_NormBase.DM.DataSet_CURRENCY); end; Next; end; end; GCanChangeCombo := false; FillComboBox(ComboBox_Curr1, F_NormBase, false, tnCurrency, fnID, fnName, '', Curr1.ID); GCanChangeCombo := true; FillComboBox(ComboBox_Curr2, F_NormBase, false, tnCurrency, fnID, fnName, '', Curr2.ID); end; // ##### Конвертация цен с начальных валют на измененные ##### procedure TF_ActiveCurrency.Button_OKClick(Sender: TObject); //var ID_Component: Integer; //OldTick: Cardinal; //CurrTick: Cardinal; procedure RefreshPriceFields(AFormBase: TForm; ATableName: String; APriceFields: TStringList); var IDList: TList; i, j: Integer; CurrID: Integer; PriceValue: Double; begin try try with TF_Main(AFormBase).DM do begin {IDList := TList.Create; SetSQLToQuery(scsQSelect, ' select id from '+ATableName+' '); IntFieldToList(IDList, scsQSelect, fnID); for i := 0 to IDList.Count - 1 do begin CurrID := Integer(IDList.Items[i]^); SQLBuilder(scsQSelect, qtSelect, ATableName, 'id = '''+IntToStr(CurrID)+'''', APriceFields, true); SQLBuilder(scsQOperat, qtUpdate, ATableName, 'id = '''+IntToStr(CurrID)+'''', APriceFields, false); for j := 0 to APriceFields.Count - 1 do begin PriceValue := 0; PriceValue := scsQSelect.GetFNAsFloat(APriceFields.Strings[j]); PriceValue := PriceValue * (FirstCurr.Ratio / Curr1.Ratio); PriceValue := RoundIBD(PriceValue, 7); scsQOperat.SetParamAsFloat(APriceFields.Strings[j], PriceValue); end; scsQOperat.ExecQuery; end; } IDList := TList.Create; SetSQLToQuery(scsQSelect, ' select id from '+ATableName+' '); IntFieldToList(IDList, scsQSelect, fnID); for i := 0 to APriceFields.Count - 1 do begin scsQSelect.Close; scsQSelect.SQL.Clear; scsQSelect.SQL.Add(' select '+APriceFields.Strings[i]+' from '+ATableName+ ' where id = :id '); scsQOperat.Close; scsQOperat.SQL.Clear; scsQOperat.SQL.Add(' update '+ATableName+' set '+ APriceFields.Strings[i]+' = :PriceValue '+ ' where id = :id '); for j := 0 to IDList.Count - 1 do begin CurrID := Integer(IDList.Items[j]^); scsQSelect.Close; scsQSelect.SetParamAsInteger('id', CurrID); scsQSelect.ExecQuery; PriceValue := 0; PriceValue := scsQSelect.GetFNAsFloat(APriceFields.Strings[i]); //PriceValue := PriceValue * (FirstCurr.Ratio / Curr1.Ratio); //PriceValue := RoundIBD(PriceValue, 7); //PriceValue := GetPriceAfterChangeRatio(PriceValue, FirstCurr, Curr1); scsQOperat.Close; scsQOperat.SetParamAsFloat('PriceValue', PriceValue); scsQOperat.SetParamAsInteger('id', CurrID); scsQOperat.ExecQuery; end; end; end; except on E: Exception do AddExceptionToLog('TF_ActiveCurrency.RefreshPriceFields: '+E.Message); end; finally FreeList(IDList); end; end; procedure RefreshPrices(AGDBMode: TDBKind); var ComponForm: TF_Main; //ID_Compon: Integer; ComponPriceFields: TStringList; NormsPriceFields: TStringList; NormResoureRelPriceFields: TStringList; ResourcesPriceFields: TStringList; begin try try ComponForm := nil; case AGDBMode of bkNormBase: ComponForm := F_NormBase; bkProjectManager: ComponForm := F_ProjMan; end; with ComponForm do begin ComponPriceFields := TStringList.Create; ComponPriceFields.Add('Price'); ComponPriceFields.Add('Price_Calc'); RefreshPriceFields(TForm(ComponForm), 'component', ComponPriceFields); NormsPriceFields := TStringList.Create; NormsPriceFields.Add('Cost'); NormsPriceFields.Add('Total_Cost'); RefreshPriceFields(TForm(ComponForm), 'norms', NormsPriceFields); NormResoureRelPriceFields := TStringList.Create; NormResoureRelPriceFields.Add('Cost'); RefreshPriceFields(TForm(ComponForm), 'norm_resource_rel', NormResoureRelPriceFields); ResourcesPriceFields := TStringList.Create; ResourcesPriceFields.Add('Price'); ResourcesPriceFields.Add(fnAdditionalPrice); RefreshPriceFields(TForm(ComponForm), 'resources', ResourcesPriceFields); if ComponForm.GDBMode = bkNormBase then begin RefreshPriceFields(TForm(ComponForm), 'nb_norm_resource_rel', NormResoureRelPriceFields); RefreshPriceFields(TForm(ComponForm), 'nb_resources', ResourcesPriceFields); end; end; except on E: Exception do AddExceptionToLog('RefreshPrices'+ E.Message); end; finally FreeAndNil(ComponPriceFields); FreeAndNil(NormsPriceFields); FreeAndNil(NormResoureRelPriceFields); FreeAndNil(ResourcesPriceFields); end; end; procedure RefreshFromat(AGDBMode: TDBKind); var ComponForm: TF_Main; //ID_Compon: Integer; begin ComponForm := nil; case AGDBMode of bkNormBase: ComponForm := F_NormBase; bkProjectManager: ComponForm := F_ProjMan; end; with ComponForm do begin //LoadCurrencyFormat; SetCurrencyBriefToControls; Tree_Catalog.OnChange(Tree_Catalog, Tree_Catalog.Selected); //ShowPrice; end; end; begin with F_NormBase.DM do begin Screen.Cursor := crHourGlass; DataSet_CURRENCY.DisableControls; BeginProgress; try //OldTick := GetTickCount; if GChangeMCurrency then begin RefreshPrices(bkNormBase); RefreshPrices(bkProjectManager); //*** Опредиление новых значений валют DataSet_CURRENCY.First; while Not DataSet_CURRENCY.Eof do begin DataSet_CURRENCY.Edit; DataSet_CURRENCY.FN('Ratio').AsFloat := DataSet_CURRENCY.FN('Ratio').AsFloat / Curr1.Ratio; DataSet_CURRENCY.Post; DataSet_CURRENCY.Next; end; end; //*** Переопределить где главная и базовая валюта if (GChangeMCurrency) or (GChangeSCurrency) then begin DataSet_CURRENCY.First; while Not DataSet_CURRENCY.Eof do begin if (GChangeMCurrency) and (DataSet_CURRENCY.FN('Main').AsInteger = 1) then WriteToDataSet(DataSet_Currency, 'Main',0); if (GChangeSCurrency) and (DataSet_CURRENCY.FN('Main').AsInteger = 2) then WriteToDataSet(DataSet_Currency, 'Main',0); DataSet_CURRENCY.Next; end; DataSet_CURRENCY.First; while Not DataSet_CURRENCY.Eof do begin if (GChangeMCurrency) and (DataSet_CURRENCY.FN('ID').AsInteger = Curr1.ID) then begin WriteToDataSet(DataSet_Currency, 'Main',1); Curr1.Ratio := DataSet_CURRENCY.FN('Ratio').AsFloat; end; if (DataSet_CURRENCY.FN('ID').AsInteger = Curr2.ID) then begin Curr2.Ratio := DataSet_CURRENCY.FN('Ratio').AsFloat; if (GChangeSCurrency) then WriteToDataSet(DataSet_Currency, 'Main',2); end; DataSet_CURRENCY.Next; end; end; TF_Main(GForm).GCurrencyM := Curr1; TF_Main(GForm).GCurrencyS := Curr2; RefreshFromat(bkNormBase); //RefreshFromat(bkProjectManager); //CurrTick := GetTickCount - OldTick; //CurrTick := GetTickCount - OldTick; finally EndProgress; Screen.Cursor := crDefault; DataSet_CURRENCY.EnableControls; end; end; end; procedure TF_ActiveCurrency.Button_CancelClick(Sender: TObject); begin //Close; end; // ##### Проверить "не используются ли одинаковые валюты?" ##### function TF_ActiveCurrency.CheckSameCurrencies(AID_CurrChanged, AID_CurrNotChanged: Integer; ANameChanged: String): Boolean; begin Result := false; if AID_CurrChanged = AID_CurrNotChanged then begin Result := true; MessageModal(cCurrency+' "'+ ANameChanged + '" '+cNowUse+'.', cImpossibleSelectCurrency, MB_OK or MB_ICONINFORMATION); end; end; // ##### Открыть форму с валютами ##### procedure TF_ActiveCurrency.OpenCurrencyForm(AComboBoxChange, AComboBoxNotChange: TcxComboBox; var AChangeCurr, ANotChangeCurr: TCurrency; var AChangeFlag: Boolean); var ID_Curr : Integer; IDNew: Integer; Accept: Boolean; begin Accept := false; //SearchRecord(F_NormBase.DM.DataSet_Currency, 'ID', AChangeCurr.ID); ID_Curr := F_NormBase.DM.DataSet_Currency.FN('ID').AsInteger; F_NormBase.F_CaseForm.GIDNotDel := ANotChangeCurr.ID; F_NormBase.F_CaseForm.GIDToLocate := ANotChangeCurr.ID; //F_NormBase.F_CaseForm.GViewKind := vkCurrency; GCanChangeCombo := false; //if F_NormBase.F_CaseForm.ShowModal = mrOK then if F_NormBase.F_CaseForm.Execute(vkCurrency, fmEdit) then begin IDNew := F_NormBase.DM.DataSet_CURRENCY.FN('ID').AsInteger; if Not CheckSameCurrencies(IDNew, ANotChangeCurr.ID, F_NormBase.DM.DataSet_CURRENCY.FN('Name').AsString) then begin AChangeCurr := GetCurrencyFromDataSet(F_NormBase.DM.DataSet_CURRENCY); FillComboBox(AComboBoxChange, F_NormBase, false, tnCurrency, fnID, '', fnName); AChangeFlag := true; Accept := true; end; end; FillComboBox(AComboBoxNotChange, F_NormBase, false, tnCurrency, fnID, fnName, '', ANotChangeCurr.ID); if Accept = false then FillComboBox(AComboBoxChange, F_NormBase, false, tnCurrency, fnID, fnName, '', ID_Curr); GCanChangeCombo := true; end; // ##### Выбор другой валюты из комбо-списка ##### procedure TF_ActiveCurrency.ChangeComboBox(var AComboChange: TcxComboBox; AID_NotChangeCurrency: Integer; var AChangeCurr: TCurrency; var AChangeFlag: Boolean); var i, CCount: integer; ID_ChangeCurr: integer; NewID: Integer; NameChangeCurr: String; begin if Not GCanChangeCombo then Exit; ID_ChangeCurr := GetIDFromComboBox(AComboChange); NameChangeCurr := AComboChange.Text; if Not CheckSameCurrencies(ID_ChangeCurr, AID_NotChangeCurrency, NameChangeCurr) then begin NewID := GetIDFromComboBox(AComboChange); SearchRecord(F_NormBase.DM.DataSet_Currency, 'ID', NewID); AChangeCurr := GetCurrencyFromDataSet(F_NormBase.DM.DataSet_CURRENCY); //F_NormBase.DM.GetCurrency; AChangeFlag := true; end else begin CCount := AComboChange.Properties.Items.Count; for i := 0 to CCount - 1 do if (AComboChange.Properties.Items.Objects[i] as TIDGuidObject).ID = AChangeCurr.ID then begin AComboChange.ItemIndex := i; break; end; end; end; procedure TF_ActiveCurrency.FormHide(Sender: TObject); begin // ##### При Следующем вsзове, Отображать эту форму в средине Главной ##### //Position := poMainFormCenter; end; constructor TF_ActiveCurrency.Create(AOwner: TComponent; AForm: TForm); begin GForm := AForm; inherited Create(AOwner); end; destructor TF_ActiveCurrency.Destroy; begin inherited; end; // ##### Изменить базовую валюту из формы влют ##### procedure TF_ActiveCurrency.Button_Curr1Click(Sender: TObject); begin OpenCurrencyForm(ComboBox_Curr1, ComboBox_Curr2, Curr1, Curr2, GChangeMCurrency); end; // ##### Изменить вторую валюту из формы влют ##### procedure TF_ActiveCurrency.Button_Curr2Click(Sender: TObject); begin OpenCurrencyForm(ComboBox_Curr2, ComboBox_Curr1, Curr2, Curr1, GChangeSCurrency); end; // ##### Изменить базовую валюту из комбо-списка влют ##### procedure TF_ActiveCurrency.ComboBox_Curr1PropertiesChange( Sender: TObject); begin ChangeComboBox(ComboBox_Curr1, GetIDFromComboBox(ComboBox_Curr2), Curr1, GChangeMCurrency); end; // ##### Изменить вторую валюту из комбо-списка влют ##### procedure TF_ActiveCurrency.ComboBox_Curr2PropertiesChange( Sender: TObject); begin ChangeComboBox(ComboBox_Curr2, GetIDFromComboBox(ComboBox_Curr1), Curr2, GChangeSCurrency); end; procedure TF_ActiveCurrency.FormDestroy(Sender: TObject); begin ClearComboBox(ComboBox_Curr1); ClearComboBox(ComboBox_Curr2); end; end.