Revision 99a4c7b9
Von Stephan Köhler vor mehr als 18 Jahren hinzugefügt
| SL/Form.pm | ||
|---|---|---|
| 610 | 610 |
|
| 611 | 611 |
return @columns; |
| 612 | 612 |
} |
| 613 |
|
|
| 613 |
# |
|
| 614 | 614 |
sub format_amount {
|
| 615 | 615 |
$main::lxdebug->enter_sub(2); |
| 616 | 616 |
|
| 617 | 617 |
my ($self, $myconfig, $amount, $places, $dash) = @_; |
| 618 |
my $neg = ($amount =~ s/-//); |
|
| 618 | 619 |
|
| 619 |
#Workaround for $format_amount calls without $places |
|
| 620 |
if (!defined $places) {
|
|
| 621 |
(my $dec) = ($amount =~ /\.(\d+)/); |
|
| 622 |
$places = length $dec; |
|
| 623 |
} |
|
| 620 |
$amount = $self->round_amount($amount, $places) if ($places =~ /\d/); |
|
| 624 | 621 |
|
| 625 |
if ($places =~ /\d/) {
|
|
| 626 |
$amount = $self->round_amount($amount, $places); |
|
| 627 |
} |
|
| 622 |
my @d = map { s/\d//g; reverse split // } my $tmp = $myconfig->{numberformat}; # get delim chars
|
|
| 623 |
my @p = split /\./, $amount ; # split amount at decimal point |
|
| 628 | 624 |
|
| 629 |
# is the amount negative |
|
| 630 |
my $negative = ($amount < 0); |
|
| 631 |
my $fillup = ""; |
|
| 632 |
|
|
| 633 |
if ($amount != 0) {
|
|
| 634 |
if ($myconfig->{numberformat} && ($myconfig->{numberformat} ne '1000.00'))
|
|
| 635 |
{
|
|
| 636 |
my ($whole, $dec) = split /\./, "$amount"; |
|
| 637 |
$whole =~ s/-//; |
|
| 638 |
$amount = join '', reverse split //, $whole; |
|
| 639 |
$fillup = "0" x ($places - length($dec)); |
|
| 640 |
|
|
| 641 |
if ($myconfig->{numberformat} eq '1,000.00') {
|
|
| 642 |
$amount =~ s/\d{3,}?/$&,/g;
|
|
| 643 |
$amount =~ s/,$//; |
|
| 644 |
$amount = join '', reverse split //, $amount; |
|
| 645 |
$amount .= "\.$dec" . $fillup if ($places ne '' && $places * 1 != 0); |
|
| 646 |
} |
|
| 647 |
|
|
| 648 |
if ($myconfig->{numberformat} eq '1.000,00') {
|
|
| 649 |
$amount =~ s/\d{3,}?/$&./g;
|
|
| 650 |
$amount =~ s/\.$//; |
|
| 651 |
$amount = join '', reverse split //, $amount; |
|
| 652 |
$amount .= ",$dec" . $fillup if ($places ne '' && $places * 1 != 0); |
|
| 653 |
} |
|
| 654 |
|
|
| 655 |
if ($myconfig->{numberformat} eq '1000,00') {
|
|
| 656 |
$amount = "$whole"; |
|
| 657 |
$amount .= ",$dec" . $fillup if ($places ne '' && $places * 1 != 0); |
|
| 658 |
} |
|
| 659 |
|
|
| 660 |
if ($dash =~ /-/) {
|
|
| 661 |
$amount = ($negative) ? "($amount)" : "$amount"; |
|
| 662 |
} elsif ($dash =~ /DRCR/) {
|
|
| 663 |
$amount = ($negative) ? "$amount DR" : "$amount CR"; |
|
| 664 |
} else {
|
|
| 665 |
$amount = ($negative) ? "-$amount" : "$amount"; |
|
| 666 |
} |
|
| 667 |
} |
|
| 668 |
} else {
|
|
| 669 |
if ($dash eq "0" && $places) {
|
|
| 670 |
if ($myconfig->{numberformat} eq '1.000,00') {
|
|
| 671 |
$amount = "0" . "," . "0" x $places; |
|
| 672 |
} else {
|
|
| 673 |
$amount = "0" . "." . "0" x $places; |
|
| 674 |
} |
|
| 675 |
} else {
|
|
| 676 |
$amount = ($dash ne "") ? "$dash" : "0"; |
|
| 677 |
} |
|
| 678 |
} |
|
| 625 |
$p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1]; # add 1,000 delimiters |
|
| 679 | 626 |
|
| 627 |
$amount = $p[0]; |
|
| 628 |
$amount .= $d[0].$p[1].(0 x ($places - length $p[1])) if ($places || $p[1] ne ''); |
|
| 629 |
|
|
| 630 |
$amount = ($neg) ? "($amount)" : "$amount" if $dash =~ ?-?; |
|
| 631 |
$amount = ($neg) ? "$amount DR" : "$amount CR" if $dash =~ ?DRCR?; |
|
| 632 |
$amount = ($neg) ? "-$amount" : "$amount" if $dash =~ ??; |
|
| 633 |
reset; |
|
| 634 |
|
|
| 680 | 635 |
$main::lxdebug->leave_sub(2); |
| 681 |
|
|
| 682 | 636 |
return $amount; |
| 683 | 637 |
} |
| 684 |
|
|
| 638 |
# |
|
| 685 | 639 |
sub parse_amount {
|
| 686 | 640 |
$main::lxdebug->enter_sub(2); |
| 687 | 641 |
|
Auch abrufbar als: Unified diff
Bugfix 356, bei Zahlenformat 1000.00 wurden nachfolgende Nullen abgeschnitten
format_amount erneuert. Thx an Sven.