Revision e5e6947b
Von Moritz Bunkus vor fast 18 Jahren hinzugefügt
SL/Form.pm | ||
---|---|---|
630 | 630 |
|
631 | 631 |
return @columns; |
632 | 632 |
} |
633 |
|
|
633 |
# |
|
634 | 634 |
sub format_amount { |
635 | 635 |
$main::lxdebug->enter_sub(2); |
636 | 636 |
|
637 | 637 |
my ($self, $myconfig, $amount, $places, $dash) = @_; |
638 |
my $neg = ($amount =~ s/-//); |
|
638 | 639 |
|
639 |
#Workaround for $format_amount calls without $places |
|
640 |
if (!defined $places) { |
|
641 |
(my $dec) = ($amount =~ /\.(\d+)/); |
|
642 |
$places = length $dec; |
|
643 |
} |
|
640 |
$amount = $self->round_amount($amount, $places) if ($places =~ /\d/); |
|
644 | 641 |
|
645 |
if ($places =~ /\d/) { |
|
646 |
$amount = $self->round_amount($amount, $places); |
|
647 |
} |
|
642 |
my @d = map { s/\d//g; reverse split // } my $tmp = $myconfig->{numberformat}; # get delim chars |
|
643 |
my @p = split /\./, $amount ; # split amount at decimal point |
|
648 | 644 |
|
649 |
# is the amount negative |
|
650 |
my $negative = ($amount < 0); |
|
651 |
my $fillup = ""; |
|
652 |
|
|
653 |
if ($amount != 0) { |
|
654 |
if ($myconfig->{numberformat} && ($myconfig->{numberformat} ne '1000.00')) |
|
655 |
{ |
|
656 |
my ($whole, $dec) = split /\./, "$amount"; |
|
657 |
$whole =~ s/-//; |
|
658 |
$amount = join '', reverse split //, $whole; |
|
659 |
$fillup = "0" x ($places - length($dec)); |
|
660 |
|
|
661 |
if ($myconfig->{numberformat} eq '1,000.00') { |
|
662 |
$amount =~ s/\d{3,}?/$&,/g; |
|
663 |
$amount =~ s/,$//; |
|
664 |
$amount = join '', reverse split //, $amount; |
|
665 |
$amount .= "\.$dec" . $fillup if ($places ne '' && $places * 1 != 0); |
|
666 |
} |
|
667 |
|
|
668 |
if ($myconfig->{numberformat} eq '1.000,00') { |
|
669 |
$amount =~ s/\d{3,}?/$&./g; |
|
670 |
$amount =~ s/\.$//; |
|
671 |
$amount = join '', reverse split //, $amount; |
|
672 |
$amount .= ",$dec" . $fillup if ($places ne '' && $places * 1 != 0); |
|
673 |
} |
|
674 |
|
|
675 |
if ($myconfig->{numberformat} eq '1000,00') { |
|
676 |
$amount = "$whole"; |
|
677 |
$amount .= ",$dec" . $fillup if ($places ne '' && $places * 1 != 0); |
|
678 |
} |
|
679 |
|
|
680 |
if ($dash =~ /-/) { |
|
681 |
$amount = ($negative) ? "($amount)" : "$amount"; |
|
682 |
} elsif ($dash =~ /DRCR/) { |
|
683 |
$amount = ($negative) ? "$amount DR" : "$amount CR"; |
|
684 |
} else { |
|
685 |
$amount = ($negative) ? "-$amount" : "$amount"; |
|
686 |
} |
|
687 |
} |
|
688 |
} else { |
|
689 |
if ($dash eq "0" && $places) { |
|
690 |
if ($myconfig->{numberformat} eq '1.000,00') { |
|
691 |
$amount = "0" . "," . "0" x $places; |
|
692 |
} else { |
|
693 |
$amount = "0" . "." . "0" x $places; |
|
694 |
} |
|
695 |
} else { |
|
696 |
$amount = ($dash ne "") ? "$dash" : "0"; |
|
697 |
} |
|
698 |
} |
|
645 |
$p[0] =~ s/\B(?=(...)*$)/$d[1]/g if $d[1]; # add 1,000 delimiters |
|
699 | 646 |
|
647 |
$amount = $p[0]; |
|
648 |
$amount .= $d[0].$p[1].(0 x ($places - length $p[1])) if ($places || $p[1] ne ''); |
|
649 |
|
|
650 |
$amount = ($neg) ? "($amount)" : "$amount" if $dash =~ ?-?; |
|
651 |
$amount = ($neg) ? "$amount DR" : "$amount CR" if $dash =~ ?DRCR?; |
|
652 |
$amount = ($neg) ? "-$amount" : "$amount" if $dash =~ ??; |
|
653 |
reset; |
|
654 |
|
|
700 | 655 |
$main::lxdebug->leave_sub(2); |
701 |
|
|
702 | 656 |
return $amount; |
703 | 657 |
} |
704 |
|
|
658 |
# |
|
705 | 659 |
sub parse_amount { |
706 | 660 |
$main::lxdebug->enter_sub(2); |
707 | 661 |
|
Auch abrufbar als: Unified diff
Recommit von r1125 von skoehler: Bugfix 356, bei Zahlenformat 1000.00 wurden nachfolgende Nullen abgeschnitten format_amount erneuert. Thx an Sven.