1 (edited by savage 2014-09-27 06:57:08)

Topic: [Решено] Script - вычисление курса по дате

День добрый.
Собственно, вопрос:
1. Есть таблицы: справочник валют, база курсов ( дата, валюта, курс к рублю), таблица учета платежей ( дата платежа, сумма платежа, валюта платежа, сумма платежа в евро)
2. На форме ввода инфо о платеже ( frmAddPay) пользователь заполняет поля: дата, сумма платежа, валюта платежа ( комбобокс).
3. При сохранении инфо в таблицу учета платежей должно автоматом считаться валюта платежа в евро. Три возможных сценария:
1. Валюта платежа - евро (EUR): Сумма платежа равна сумме в евро,
2. Валюта платежа - бел рубль (BRB): сумма платежа в евро считается сл образом: в таблице "база курсов" ищем на дату платежа курс евро к рублю. Затем делим сумму платежа на курс евро и округляем до 2 знаков после запятой
3. Валюта платежа - любая, кроме 2 выше обозначенных (например, USD, RUB): в таблице "база курсов" ищем на дату платежа курс валюты платежа и курс евро. Затем умножаем сумму платежа на курс валюты платежа и делим на курс евро и округляем до 2 знаков после запятой.

собственно, все. Как это реализовать?


с уважением,
savage

2 (edited by savage 2014-09-24 21:00:09)

Re: [Решено] Script - вычисление курса по дате

DriveSoft, попробовал реализовать все это через скрипт:

procedure frmAddPay_bPayOk_OnClick (Sender: string; var Cancel: boolean);
var
   val: string;
   val1: string;
   valEUR: string;
   idEUR: string;
begin

       val1:= SQLExecute('SELECT sum FROM CurrancyEx WHERE (date = ''' + FormatDateTime('yyyy-MM-DD 00:00:00.000', frmAddPay.DateTimePicker1.DateTime) + ''') AND (id_Currancy =' + IntToStr(frmAddPay.ComboBox1.dbItemID) + ');');// получение курса валюты платежа на заданную дату из таблицы CurrancyEx
       idEUR := IntToStr(SQLExecute('SELECT count(id) FROM Currancy WHERE (cur_name = "EUR");'));// получение id EUR из таблицы Currancy
       valEUR := SQLExecute('SELECT sum FROM CurrancyEx WHERE (date = ''' + FormatDateTime('yyyy-MM-DD 00:00:00.000', frmAddPay.DateTimePicker1.DateTime) + ''') AND (id_Currancy = ' + idEUR +');');  //получение курса EUR на заданную дату из таблицы CurrancyEx
       // делаем SQL запрос, для проверки, есть ли такая валюта на такую дату в базе
       val := SQLExecute('SELECT count(id) FROM CurrancyEx WHERE (date = ''' + FormatDateTime('yyyy-MM-DD 00:00:00.000', frmAddPay.DateTimePicker1.DateTime) + ''') AND (id_Currancy =' + IntToStr(frmAddPay.ComboBox1.dbItemID) + ');');
       if val <> '0' then    // если результат не равен нулю, значит такая валюта на такую дату в базе есть
           begin

              if frmAddPay.ComboBox1.Text='EUR'  then
               begin
                  SQLExecute('INSERT INTO Payments (sum_euro) VALUES ('{Edit1}');');
               end;

               if frmAddPay.ComboBox1.Text='BRB'  then
               begin
                  SQLExecute('INSERT INTO Payments (sum_euro)   VALUES ('{Edit1}'/valEUR);');

               end else  SQLExecute('INSERT INTO Payments (sum_euro)   VALUES ('{Edit1}'*val1/valEUR);');

           end else MessageDlg('В базе нет курса на данную дату.', mtError, mbOk, 0);

end;

1. При проверке синтаксиса ругается на ошибку в написании '{Edit1}', где Edit1 - поле ввода суммы платежа
2. Не знаю, как прописать формулу "умножить и делить (* /)
3. Не знаю, как ввести округление расчетных сумм в евро до 2 знаков после запятой

с уважением,

savage

Re: [Решено] Script - вычисление курса по дате

1. Такую запись компонентов как {Edit1} можно использовать только в кнопках с действием SQL запрос либо Отчет, в скриптах, обращаться к компоненту, например чтобы получить его текст, нужно так: Form1.Edit1.Text


2. Можно воспользоваться функцией
FormatFloat('0.##', 25.5466);
в результате будет строка 25.55

Dmitry.

4 (edited by savage 2014-09-24 21:24:13)

Re: [Решено] Script - вычисление курса по дате

попробовал изменить на такое написание одного расчета в евро:

if frmAddPay.ComboBox1.Text='EUR'  then
               begin
                 SQLExecute('INSERT INTO Payments (sum_euro) VALUES (''' +frmAddPay.Edit1.Text + ''');');
               end;

выдает ошибку при отработке: см. приаттаченный файл

Post's attachments

Attachment icon Screen-2014-09-25_00-20.png 163.7 kb, 359 downloads since 2014-09-24 

Re: [Решено] Script - вычисление курса по дате

При создании таблицы бд Payments, вы указали поле id_Company как обязательное для заполнения, но в SQL запросе не заполняете его, поэтому и ошибка.

Dmitry.

6 (edited by savage 2014-09-25 08:31:24)

Re: [Решено] Script - вычисление курса по дате

DriveSoft, убрал признак обязательности, немного изменил код. Результат - заполненная форма вообще отказывается закрываться с сохранением (через кнопку ОК)
Код:

procedure frmAddPay_bPayOk_OnClick (Sender: string; var Cancel: boolean);
var
   val: string;
   valEUR: string;
   idEUR: string;
begin
       idEUR := IntToStr(SQLExecute('SELECT count(id) FROM Currancy WHERE (cur_name = "EUR");'));// получение id EUR из таблицы Currancy
       valEUR := IntToStr(SQLExecute('SELECT sum FROM CurrancyEx WHERE (date = ''' + FormatDateTime('yyyy-MM-DD 00:00:00.000', frmAddPay.DateTimePicker1.DateTime) + ''') AND (id_Currancy = ' + idEUR +');'));  //получение курса EUR на заданную дату из таблицы CurrancyEx

       // делаем SQL запрос, для проверки, есть ли такая валюта на такую дату в базе
        val:= IntToStr(SQLExecute('SELECT sum FROM CurrancyEx WHERE (date = ''' + FormatDateTime('yyyy-MM-DD 00:00:00.000', frmAddPay.DateTimePicker1.DateTime) + ''') AND (id_Currancy =' + IntToStr(frmAddPay.ComboBox1.dbItemID) + ');'));// получение курса валюты платежа на заданную дату из таблицы CurrancyEx
          if val <> '0' then    // если результат не равен нулю, значит такая валюта на такую дату в базе есть

           begin
               if frmAddPay.ComboBox1.Text='EUR'  then
                 begin
                   SQLExecute('INSERT INTO Payments (sum_euro) VALUES (''' +frmAddPay.Edit1.Text + ''');');

                 end;

              

           end else
                    ShowMessage('В базе нет курса на данную дату.'); // ваше сообщение
                    Cancel := True; // отменяем действие кнопки

end;

Тестировал уже на новой версии
PS на всякий прикладываю свой проект

Post's attachments

Attachment icon MyMarketingDep.zip 336.69 kb, 510 downloads since 2014-09-25 

Re: [Решено] Script - вычисление курса по дате

Была ошибка в скрипте, вы убрали нужные begin и end в условии, когда курс не найден.

procedure frmAddPay_bPayOk_OnClick (Sender: string; var Cancel: boolean);
var
   val: string;
   valEUR: string;
   idEUR: string;
begin
       idEUR := IntToStr(SQLExecute('SELECT count(id) FROM Currancy WHERE (cur_name = "EUR");'));// получение id EUR из таблицы Currancy
       valEUR := IntToStr(SQLExecute('SELECT sum FROM CurrancyEx WHERE (date = ''' + FormatDateTime('yyyy-MM-DD 00:00:00.000', frmAddPay.DateTimePicker1.DateTime) + ''') AND (id_Currancy = ' + idEUR +');'));  //получение курса EUR на заданную дату из таблицы CurrancyEx

       // делаем SQL запрос, для проверки, есть ли такая валюта на такую дату в базе
        val:= IntToStr(SQLExecute('SELECT sum FROM CurrancyEx WHERE (date = ''' + FormatDateTime('yyyy-MM-DD 00:00:00.000', frmAddPay.DateTimePicker1.DateTime) + ''') AND (id_Currancy =' + IntToStr(frmAddPay.ComboBox1.dbItemID) + ');'));// получение курса валюты платежа на заданную дату из таблицы CurrancyEx
          if val <> '0' then    // если результат не равен нулю, значит такая валюта на такую дату в базе есть

           begin
               if frmAddPay.ComboBox1.Text='EUR'  then
                 begin
                   SQLExecute('INSERT INTO Payments (sum_euro) VALUES (''' +frmAddPay.Edit1.Text + ''');');

                 end;

              // if frmAddPay.ComboBox1.Text='BRB'  then
              // begin
              //   SQLExecute('INSERT INTO Payments (sum_euro)   VALUES ("frmAddPay.Edit1.Text");');

             //  end else SQLExecute('INSERT INTO Payments (sum_euro)   VALUES (''' +frmAddPay.Edit1.Text + ''');');

           end else
           begin
                    ShowMessage('В базе нет курса на данную дату.'); // ваше сообщение
                    Cancel := True; // отменяем действие кнопки
           end;
end;
Dmitry.

8 (edited by savage 2014-09-25 09:52:46)

Re: [Решено] Script - вычисление курса по дате

DriveSoft, вы правы.
Есть еще 2 вопроса:
1. сохранение frmAddPay.Edit1.Text происходит в другую запись. я так понимаю, что по нажатию кнопки происходит сохранение в 1 запись той информации, которая была введена в поля формы ввода и во 2-ую - непосредственно данных (frmAddPay.Edit1.Text), сохраняемых через скрипт. Как сделать так, чтобы они (действие "сохранить" и скрипт) отрабатывали в одну и туже запись? Не хотелось бы делать сохранение всей формы через скрипт...
2. вопрос по умножению и делению остался открытым.  Правильным ли будет скрипт:

SQLExecute('INSERT INTO Payments (sum_euro)   VALUES ((''' +frmAddPay.Edit1.Text + ''')/("'+ valEUR+ '"));');

Re: [Решено] Script - вычисление курса по дате

Думаю будет лучше сделать скрытый компонент TextBox, в котором будет содержаться результат вычислений скрипта для поля sum_euro, чтобы это значение можно было записать в базу без использования SQL.


вычисление будет примерно таким
frmAddPay.edSumEuro.Text := FloatToStr( StrToFloat(frmAddPay.Edit1.Text ) / StrToFloat(valEUR) );


перед этим вычислением, не плохо бы проверить, являются ли все значения корректными числами, с помощью функции ValidFloat(cFlt: String): Boolean
а то пользователь может ввести и буквы туда.



p.s.

       idEUR := IntToStr(SQLExecute('SELECT count(id) FROM Currancy WHERE (cur_name = "EUR");'));// получение id EUR из таблицы Currancy
       valEUR := IntToStr(SQLExecute('SELECT sum FROM CurrancyEx WHERE (date = ''' + FormatDateTime('yyyy-MM-DD 00:00:00.000', frmAddPay.DateTimePicker1.DateTime) + ''') AND (id_Currancy = ' + idEUR +');'));  //получение курса EUR на заданную дату из таблицы CurrancyEx

здесь лучше убрать IntToStr, т.к. SQLExecute возвращает особый тип результата, Variant, который и так автоматически преобразуется в текст

Dmitry.

10 (edited by savage 2014-10-04 08:44:17)

Re: [Решено] Script - вычисление курса по дате

почему -то не отрабатывает именно деление. Вот исправленный код:

procedure frmAddPay_bPayOk_OnClick (Sender: string; var Cancel: boolean);
var
   val: string;
   valEUR: string;
   idEUR: string;
begin
       idEUR := SQLExecute('SELECT (id) FROM Currancy WHERE (cur_name = "EUR");');// получение id EUR из таблицы Currancy
       valEUR := SQLExecute('SELECT sum FROM CurrancyEx WHERE (date = ''' + FormatDateTime('yyyy-MM-DD 00:00:00.000', frmAddPay.DateTimePicker1.DateTime) + ''') AND (id_Currancy = ' + idEUR +');');  //получение курса EUR на заданную дату из таблицы CurrancyEx

       // делаем SQL запрос, для проверки, есть ли такая валюта на такую дату в базе
        val:= SQLExecute('SELECT sum FROM CurrancyEx WHERE (date = ''' + FormatDateTime('yyyy-MM-DD 00:00:00.000', frmAddPay.DateTimePicker1.DateTime) + ''') AND (id_Currancy =' + IntToStr(frmAddPay.ComboBox1.dbItemID) + ');');// получение курса валюты платежа на заданную дату из таблицы CurrancyEx
          if val <> '0' then    // если результат не равен нулю, значит такая валюта на такую дату в базе есть

           begin
               if frmAddPay.ComboBox1.Text='EUR'  then
                 begin
                   frmAddPay.edSumEuro.Text := FloatToStr( StrToFloat(frmAddPay.Edit1.Text) );
                 end;

               if frmAddPay.ComboBox1.Text='BRB'  then
                 begin
                   frmAddPay.edSumEuro.Text := FloatToStr( StrToFloat(frmAddPay.Edit1.Text) / StrToFloat(valEUR) );
                 end;

               if (frmAddPay.ComboBox1.Text='USD') OR (frmAddPay.ComboBox1.Text='RUB')  then
                 begin
                   frmAddPay.edSumEuro.Text := FloatToStr( StrToFloat(frmAddPay.Edit1.Text )*  StrToFloat(val) / StrToFloat(valEUR) );
                 end;

           end else
               begin
                    ShowMessage('В базе нет курса на данную дату.'); // ваше сообщение
                    Cancel := True; // отменяем действие кнопки
               end;
end;

Там, где идет умножение - отрабатывает штатно, где деление - ничего не происходит

Re: [Решено] Script - вычисление курса по дате

Проверил, у меня этот код работает для всех валют, если есть курс на указанную дату.
Может быть вы забыли компонент frmAddPay.edSumEuro внести в список сохраняемых в настройках кнопки Сохранить?

Dmitry.

Re: [Решено] Script - вычисление курса по дате

DriveSoft, проверил.  Не забыл.

13 (edited by savage 2014-09-25 15:43:49)

Re: [Решено] Script - вычисление курса по дате

хм, заработало только после удаления sqlite.db.

Все работает!

Остался только 1 вопрос - округление до 2-х знаков после запятой.
Посмотрел в сторону RoundTo - нет такой функции, FloatToStrF - аналогично...

Re: [Решено] Script - вычисление курса по дате

можно  так

Form1.Label1.Caption := FormatFloat('0.00', 0.654354);
Dmitry.

15 (edited by savage 2014-10-06 23:58:47)

Re: [Решено] Script - вычисление курса по дате

DriveSoft, благодарю!

итоговый код:

procedure frmAddPay_bPayOk_OnClick (Sender: string; var Cancel: boolean);
var
   val: string;
   valEUR: string;
   idEUR: string;
begin
       idEUR := SQLExecute('SELECT (id) FROM Currancy WHERE (cur_name = "EUR");');// получение id EUR из таблицы Currancy
       valEUR := SQLExecute('SELECT sum FROM CurrancyEx WHERE (date = ''' + FormatDateTime('yyyy-MM-DD 00:00:00.000', frmAddPay.DateTimePicker1.DateTime) + ''') AND (id_Currancy = ' + idEUR +');');  //получение курса EUR на заданную дату из таблицы CurrancyEx

       // делаем SQL запрос, для проверки, есть ли такая валюта на такую дату в базе
        val:= SQLExecute('SELECT sum FROM CurrancyEx WHERE (date = ''' + FormatDateTime('yyyy-MM-DD 00:00:00.000', frmAddPay.DateTimePicker1.DateTime) + ''') AND (id_Currancy =' + IntToStr(frmAddPay.ComboBox1.dbItemID) + ');');// получение курса валюты платежа на заданную дату из таблицы CurrancyEx
          if val <> '' then    // если результат не равен нулю, значит такая валюта на такую дату в базе есть

           begin
               if frmAddPay.ComboBox1.Text='EUR'  then
                 begin
                   frmAddPay.edSumEuro.Text := FloatToStr(StrToFloat(frmAddPay.Edit1.Text));
                 end;

               if frmAddPay.ComboBox1.Text='BRB'  then
                 begin
                   frmAddPay.edSumEuro.Text := FormatFloat('0.00',(StrToFloat(frmAddPay.Edit1.Text)/StrToFloat(valEUR)));

                end else  frmAddPay.edSumEuro.Text := FormatFloat('0.00',(StrToFloat(frmAddPay.Edit1.Text)*StrToFloat(val)/StrToFloat(valEUR)));

           end else
               begin
                    ShowMessage('В базе нет курса на данную дату.'); // ваше сообщение
                    Cancel := True; // отменяем действие кнопки
               end;
end;

Re: [Решено] Script - вычисление курса по дате

Модифицированный код, при условии, что BRB  - национальная валюта (все остальные считаются по отношению к ней. следовательно, курс BRB заносить в базу не надо), EUR - валюта конечного (управленческого) учета

//сохранение инфо о платеже в базу с автоматическим пересчетом суммы платежа в евро
procedure frmAddPay_bPayOk_OnClick (Sender: string; var Cancel: boolean);
var
   val: string;
   valEUR: string;
   idEUR: string;
begin
       // получение id EUR из таблицы Currancy
       idEUR := SQLExecute('SELECT (id) FROM Currancy WHERE (cur_name = "EUR");');
       //получение курса EUR на заданную дату из таблицы CurrancyEx
       valEUR := SQLExecute('SELECT sum FROM CurrancyEx WHERE (date = ''' + FormatDateTime('yyyy-MM-DD 00:00:00.000', frmAddPay.DateTimePicker1.DateTime) + ''') AND (id_Currancy = ' + idEUR +');');
       // получение курса валюты платежа на заданную дату из таблицы CurrancyEx
       val:= SQLExecute('SELECT sum FROM CurrancyEx WHERE (date = ''' + FormatDateTime('yyyy-MM-DD 00:00:00.000', frmAddPay.DateTimePicker1.DateTime) + ''') AND (id_Currancy =' + IntToStr(frmAddPay.ComboBox1.dbItemID) + ');');

          if (frmAddPay.ComboBox1.Text='EUR')  then
            begin
              frmAddPay.edSumEuro.Text := FloatToStr(StrToFloat(frmAddPay.Edit1.Text));
            end else

          if (frmAddPay.ComboBox1.Text='BRB')  AND ( valEUR <> '') then
            begin
               frmAddPay.edSumEuro.Text := FormatFloat('0.00',(StrToFloat(frmAddPay.Edit1.Text)/StrToFloat(valEUR)));
            end else

              if val <> '' then    // если результат не равен нулю, значит такая валюта на такую дату в базе есть
                 begin
                    frmAddPay.edSumEuro.Text := FormatFloat('0.00',(StrToFloat(frmAddPay.Edit1.Text)*StrToFloat(val)/StrToFloat(valEUR)));
                 end else

         begin
              ShowMessage('В базе нет курса на данную дату.'); // ваше сообщение
              Cancel := True; // отменяем действие кнопки
         end;
end;