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.