<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package grafikm;

use template;
use GD;

@ISA = qw ( template );

# Datasets:
##########
# In den Datasets steht ein Zeiger auf ein Array mit Zeigern auf die HASHES der Datasets.
# Jedes Datasethash besteht aus folgenden Teilen:
#	N		die N's nach dem die Prozente für diesen Dataset berechnet werden
#			in der Regel fuer alle Datasets dasselbe, aber halt nicht immer....
#	num		die Menge
#	txt		der Text dieses Sets
#	lfd		eine laufende Nummer der natürlichen Abfolge


# Textformatierung mit textformatv und textformath:
###################################################
# Diese Formatierungstexte dienen zur individuellen Beschriftung
# der Grafiken, wobei der textformatv (wie vorne) VOR der Grafik steht
# und der textformath (wie hinten) HINTER der Grafik steht
# Folgende ersetzungen werden vorgenommen:
#	&amp;N wird durch die gesamt Ns ersetzt
#	&amp;P durch die Prozentzahl (ohne %)
#	&amp;Z durch die eigentliche Zahl (num)
#	&amp;T durch den Text
#	&amp;L durch die laufende Nummer (lfd)
#
# bei N=200, num=70, text="Hallo" und der lfd=1 wird aus:
# "&amp;Z - &amp;T (&amp;N)" -&gt; "70 - Hallo (200)"  bzw. aus
# "Frage[&amp;L] - &amp;P%" -&gt; "Frage[1] - 35%"


# Daten die bei setdata uebergeben werden:
########################################
#	filename  der Dateiname
#	size      die Groesse der Grafik (normal ist 25)
#   maxdata   Maximale Anzahl der Datensaetze, alle darueber werden zum 
#			  letzten zusammengefasst
#	sumtext	  Text des letzten summendatensatzes s.o.
#	fontcolor   Farbe des Schriftentextes
#	transcolor  Farbe der Durchsichtigkeit
#	shadowcolor Farbe des Schattens
#	col		  Zeiger auf Array mit Farben
#	GRA		  Grafiktyp
#	textformatv/h	Formatierungsanweisung für die Grafikbeschriftung
#	nachkomma	Anzahl der Nachkommastellen
#	printN		Ob die "Gesamt n=..." ausgegeben wird
#	N			ein gemeinsames N bei Mehrfachantworten z.B.
#	sorttype	wie soll sortiert werden "txt" "lfd" "num"
#	schmuck		wie die Grafik "geschmueck" werden soll "3D" oder "schatten" oder ""
#






####################################################################
####         Konstuktor der Grafikklasse
####         Argumente  : Parentzeiger
####         Returnwert : Referenz auf das neue Grafikobjekt
####################################################################
sub init {
	my $that = shift;
	my $class = ref($that) || $that;
	my $self = template-&gt;init(@_);
	bless $self, $class;	
	$self-&gt;imgreset;
}


####################################################################
####         Setzt alle Eigenschaften auf Defaultwerte
####         Argumente  : Parentzeiger
####         Returnwert : Referenz auf das neue Grafikobjekt
####################################################################
sub imgreset {	
	my $self=shift;
	$self-&gt;{size}=25;				# Groesse der Grafik
	$self-&gt;{printN}=1;				# Ob die "Gesamt n=..." ausgegeben wird
	$self-&gt;{fontcolor}="000000";	# Schriftfarbe
	$self-&gt;{transcolor}="010001";	# Transparentfarbe
	$self-&gt;{shadowcolor}="#999999";	# Farbe des Schattens
	$self-&gt;{sumtext}="Sonstiges";	# Text fuer die Sammlung der Datensaetze &gt; {maxdata}
	$self-&gt;{maxdata}=120;			# Maximale Anzahl der Datensaetze
	$self-&gt;{N}=0;					# Der gemeinsame N, wird in der Regel aus der summe der num gebildet
	$self-&gt;{schmuck}= 1;			# Verzierung.....  (3D)
	$self-&gt;rmdata;				# Zeiger auf Datensaetze
	$self-&gt;{textformatv}="Nr.&amp;L (&amp;Z)";	# Text Vorne
	$self-&gt;{textformath}="&amp;T - &amp;P%";		# Text hinten
	$self-&gt;{sorttype}="lfd";				# Art der Sortierung
	$self-&gt;{nachkomma}=0;
	$self-&gt;{filename}="";
	$self-&gt;{GRA}="BA";						#Im Zweifelsfall ein Balken 
	#$self-&gt;{col}=["0099cc","ff9900"];
	$self-&gt;{col}=["0099cc","ff9900","ffff99","00cc66","3333cc","ff6666","aaddaa","66ccff","ff99ff","999999"]; # Array der Standardfarben
	return $self;
}

####################################################################
####         Erstellt das Image
####         Argumente  : -
####         Returnwert : -
####################################################################
sub createimg {
	my $self=shift;
	my $GRA=$self-&gt;{GRA};
	$self-&gt;maxdata;
	$self-&gt;formnum;
	$self-&gt;datasort;
	$self-&gt;textcreate;
	$self-&gt;$GRA();
	$self-&gt;save;
	return;
}

####################################################################
####         nimmt einen Dateinamen fuer das Bild entgegen
####         Argumente  : Dateiname
####         Returnwert : -
####################################################################
sub setfilename {
	my $self = shift;
	#$_=shift;
	my $name= shift;
	unless (/\.gif$/) {$self-&gt;log(2,"Datei endet nicht mit '.gif' ($name)");}
	#unless (/\.gif$/) {$self-&gt;log(2,"Datei endet nicht mit '.gif' ($_)");}
	#$self-&gt;{filename}=$_;
	$self-&gt;{filename}=$name;
}

####################################################################
####         Loescht die Datensaetze
####         Argumente  : -
####         Returnwert : -
####################################################################
sub rmdata {
	my $self=shift;
	if (defined $self-&gt;{img}) {
		foreach $index (@{$self-&gt;{datasets}}) {			#Alle Farben "deallocaten"
			$self-&gt;{img}-&gt;colorDeallocate($data-&gt;{colorn});
			$self-&gt;{img}-&gt;colorDeallocate($data-&gt;{colord});
			$self-&gt;{img}-&gt;colorDeallocate($data-&gt;{colorh});
			$self-&gt;log(4,"Colors Allocated after deleting: ".$self-&gt;{img}-&gt;colorsTotal);
		}
	}
	$self-&gt;{datasets}=[];	# und Datensätze löschen
	$self-&gt;{datadirty}=0;
}

####################################################################
####         Speichert alle Datensätze in der DB
####         Argumente  : -
####         Returnwert : -
####################################################################
sub store {
	my $self=shift;
	$self-&gt;sqldo("lock tables bar write");
	$self-&gt;{id} = $self-&gt;sqlselect("select max(id) from bar") +1;
	my $alias="T".$self-&gt;{id};
	foreach (@{$self-&gt;{datasets}}) {
		$_-&gt;{wher}=~s/ (\w)/ $alias\.$1/g;
		$_-&gt;{wher}=~s/"/\"/g;
		my $sql="insert into bar (id,pid,plfd,lfd,num,N,tabl,wher,x1,x2,x3,x4,y1,y2,y3,y4,descr) values ".
		"('".$self-&gt;{id}."','".$self-&gt;{pid}."','".$self-&gt;{plfd}."','".$_-&gt;{lfd}."','".$_-&gt;{num}."','".$_-&gt;{N}."','".
		$_-&gt;{tabl}." $alias',\"".$alias.".".$_-&gt;{wher}."\",'" .
		join ("','", @{$_-&gt;{X}} ) ."','". join ("','", @{$_-&gt;{Y}} ) ."','".$_-&gt;{descr}."')"; 
		$self-&gt;sqldo($sql);
	}
	$self-&gt;sqldo("unlock tables");
	return;
}

####################################################################
####         laedt alle Datensätze aus der DB oder einen bestimmten
####         Argumente  : -
####         Returnwert : -
####################################################################
sub load {
	my ($self, $id, $plfd) = @_;
	my $sql="select id,lfd,pid,plfd,num,N,tabl,wher,x1,x2,x3,x4,y1,y2,y3,y4,descr from bar where id='$id'";
	my (@data, $target);
	my $sth=$self-&gt;sqlprepare($sql);
	while (my $set = $sth-&gt;fetchrow_hashref) {
		push @data, $set;
		for (1...4) {
			$set-&gt;{X}[$_-1] = $set-&gt;{"x$_"};
			$set-&gt;{Y}[$_-1] = $set-&gt;{"y$_"};
			$self-&gt;log(4,"--".$_."------".$set-&gt;{"x$_"});
		}
		if ($plfd==$set-&gt;{lfd} &amp;&amp; defined $plfd) {return $set;}   # wenn nur einer geladen werden soll
	}
	$self-&gt;{datasets}=\@data;
	return; 
}

####################################################################
####         Loescht den Datensatz mit der lfd
####         Argumente  : lfd
####         Returnwert : -
####################################################################
sub rmdatalfd {
	my ($self, $lfd) = @_;
	my @new=();
	foreach $data ( @{$self-&gt;{datasets}} )  {
		if ($data-&gt;{lfd} != $lfd) {push @new, $data;}
	}
	$self-&gt;{datasets}=\@new;
	$self-&gt;{datadirty}=1;
}

####################################################################
####         Datenuebernahme
####         Argumente  : Parentzeiger
####         Returnwert : Referenz auf das neue Grafikobjekt
####################################################################
sub setdata {
	my ($self,$hp) = @_;
	my %hash=%$hp;
	$self-&gt;log(4,"Entering grafik: setdata");
	if (defined $hash{GRA}) {$self-&gt;setgrafiktyp($hash{GRA});}
	if (defined $hash{filename}) {$self-&gt;setfilename($hash{filename});}
	if (defined $hash{size}) {$self-&gt;{size}=$hash{size};}
	if (defined $hash{fontcolor}) {$self-&gt;{fontcolor}=$hash{fontcolor};}
	if (defined $hash{shadowcolor}) {$self-&gt;{shadowcolor}=$hash{shadowcolor};}
	if (defined $hash{transcolor}) {$self-&gt;{transcolor}=$hash{transcolor};}
	if (defined $hash{sumtext}) {$self-&gt;{sumtext}=$hash{sumtext};}
	if (defined $hash{maxdata}) {$self-&gt;{maxdata}=$hash{maxdata}; $self-&gt;{datadirty}=1;}
	if (defined $hash{textformatv}) {$self-&gt;{textformatv}=$hash{textformatv};$self-&gt;log(4,"textformatv=$self-&gt;{textformatv}");}
	if (defined $hash{textformath}) {$self-&gt;{textformath}=$hash{textformath};$self-&gt;log(4,"textformath=$self-&gt;{textformath}");}
	if (defined $hash{nachkomma}) {$self-&gt;{nachkomma}=$hash{nachkomma};$self-&gt;log(4,"nachkomma=$self-&gt;{nachkomma}");}
	if (defined $hash{printN}) {$self-&gt;{printN}=$hash{printN};$self-&gt;log(4,"printN=$self-&gt;{printN}");}
	if (defined $hash{col}) {$self-&gt;{col}=$hash{col};}
	if (defined $hash{N}) {$self-&gt;{N}=$hash{N}; $self-&gt;{datadirty}=1;}
	if (defined $hash{sorttype}) {$self-&gt;{sorttype}=$hash{sorttype};}
	if (defined $hash{pid}) {$self-&gt;{pid}=$hash{pid}+0;}
	if (defined $hash{plfd}) {$self-&gt;{plfd}=$hash{plfd}+0;}
	if (defined $hash{schmuck}) {$self-&gt;{schmuck}=$hash{schmuck};}
	return;

}

####################################################################
####         Datenuebernahme eines neuen Datensets
####         Argumente  : Zeiger auf datasethash
####         Returnwert : -
####################################################################
sub setgrafiktyp {
	my ($self, $GRA)=@_;
	my @GR=qw/BA PI VL SK/;
	my $G; my $OK=0;
	$self-&gt;{GRA}=$GRA;
	$self-&gt;log(4,"GRA=".$self-&gt;{GRA});
	foreach (@GR) {$OK=1 if /$self-&gt;{GRA}/ ;}
	unless ($OK) {$self-&gt;{GRA}=$GR[0];}
}

####################################################################
####         Datenuebernahme eines neuen Datensets
####         Argumente  : Zeiger auf datasethash
####         Returnwert : -
####################################################################
sub newdataset {
	my ($self, $data) = @_;
	my %mydata=%{$data};			# Lokale Kopie der Daten
	$mydata{lfd}+=0;
	$mydata{N}+=0;
	$mydata{num}+=0;
	for (0..3) {$mydata{X}[$_]=0; $mydata{Y}[$_]=0; }
	push (@{$self-&gt;{datasets}},\%mydata);	# Hinzufuegen
	$self-&gt;{datadirty}=1;			# Datensaetze als "dreckig" markieren
}

####################################################################
####         Schreibt ins Logfile
####         Argumente  : Emergency-NR und Logtext
####         Returnwert : -
####################################################################
sub log {
	my ($self, $emer, $TEXT) = @_;
	$self-&gt;printlog($emer, "[GRAFIK:$self-&gt;{GRA}] $TEXT");
	return;
}

####################################################################
####         Sortiert die Datasets
####         Argumente  : -
####         Returnwert : -
####################################################################
sub datasort {
	my $self=shift;
	my $way=$self-&gt;{sorttype};
	my $c;
	$self-&gt;log(4,"Entering grafik: datasort, Sorttype=$way");
	my @lw = qw/num txt lfd proz N/;
	foreach(@lw) {  $c++ if /$way/;} 
	unless ($c) {return 0;}
	$self-&gt;log(4,"Inlistcounter=$c");
	########## Die Einzelnen Sortierungen
	sub num {$b-&gt;{num} &lt;=&gt; $a-&gt;{num};}
	sub txt {lc($a-&gt;{txt}) cmp lc($b-&gt;{txt});}
	sub lfd {$a-&gt;{lfd} &lt;=&gt; $b-&gt;{lfd};}
	sub proz {$b-&gt;{proz} &lt;=&gt; $a-&gt;{proz};}
	sub N   {$a-&gt;{N}   &lt;=&gt; $b-&gt;{N};}
	##############
	my @L = sort $way @{$self-&gt;{datasets}};
	$self-&gt;{datasets}=\@L;
	return 1;
}

####################################################################
####         Formatiert die Beschreibungstexte und 
####         speichert den laengsten unter $self-&gt;{laengstes}
####         Argumente  : -
####         Returnwert : -
####################################################################
sub textcreate {
	my $self=shift;
	$self-&gt;log(4,"Entering grafik: textcreate");
	my ($laengstes, $laengstesv, $laengstesh, $data, $tring, $V, $H);
	foreach $data ( @{$self-&gt;{datasets}} )  {
      $V=$self-&gt;_textform($self-&gt;{textformatv},$data);
      $H=$self-&gt;_textform($self-&gt;{textformath},$data);
	  if ($laengstes &lt; length($V.$H)) { $laengstes = length($V.$H);  }
  	  if ($laengstesv &lt; length($V)) { $laengstesv = length($V);  }
  	  if ($laengstesh &lt; length($H)) { $laengstesh = length($H);  }
	  $data-&gt;{textv}=$V;
	  $data-&gt;{texth}=$H;
	  $self-&gt;log(4,$data-&gt;{textv}." - ".$data-&gt;{texth});	
	} 
	$self-&gt;{laengstes}=$laengstes*6;   # Zeichenbreite multiplizieren
	$self-&gt;{laengstesv}=$laengstesv*6;  
	$self-&gt;{laengstesh}=$laengstesh*6;  
}

####################################################################
####         Formatiert den übergebenen Formatstring 
####         Argumente  : -
####         Returnwert : -
####################################################################
sub _textform {
	my ($self,$tring,$data) = @_;
	my $txt= $data-&gt;{txt};
	$txt=~ s/&lt;[^&gt;]*&gt;//g; # den Text von HTML befreien
	$self-&gt;log(4,"Entering grafik: _textform");
	$tring=~s/&amp;N/$data-&gt;{pN}/g;    # Die Ns ersetzen
	$tring=~s/&amp;T/$txt/g;	       # Den Text einsetzen
	$tring=~s/&amp;P/$data-&gt;{proz}/g;  # Die Prozente einsetzen (ohne %-Zeichen)
	$tring=~s/&amp;Z/$data-&gt;{pnum}/g;  # Die Anzahl einsetzen    
	$tring=~s/&amp;L/$data-&gt;{plfd}/g;  # Die laufende Nummer einsetzen    
	return $tring;
}      

####################################################################
####         Fasst alles &gt; maxdata zusammen
####         Argumente  : -
####         Returnwert : -
####################################################################
sub maxdata {
  my $self=shift;
  $self-&gt;log(4,"Entering grafik: maxdata" );
  $self-&gt;datasort("num");
  my $anz = @{$self-&gt;{datasets}}; # Anzahl der Datensaetze 
  my $max=$self-&gt;{maxdata}-1;
  $self-&gt;log(4,"Anzahl=$anz, Max=$max" );
  if ( ($max+1) &lt; $anz) {
    for ($x=$max+1 ; $x&lt;$anz ; $x++) {
       $self-&gt;{datasets}-&gt;[$max]-&gt;{num}+=$self-&gt;{datasets}-&gt;[$x]-&gt;{num};
       $self-&gt;{datasets}-&gt;[$max]-&gt;{N}+=$self-&gt;{datasets}-&gt;[$x]-&gt;{N};
    }
    $self-&gt;{datasets}-&gt;[$max]-&gt;{txt}=$self-&gt;{sumtext};
    $self-&gt;{datasets}-&gt;[$max]-&gt;{N}/=($anz-$max);
	splice @{$self-&gt;{datasets}}, $self-&gt;{maxdata};
  }
}

####################################################################
####         Initialisiert das Bild
####         Argumente  : -
####         Returnwert : -
####################################################################
sub _init_img {
	my ($self,$width,$height) = @_;
	$self-&gt;log(4,"Entering grafik: init_img");
	$self-&gt;{img} = GD::Image-&gt;new($width, $height);
	$self-&gt;{fontcol} = $self-&gt;{img}-&gt;colorAllocate($self-&gt;_hex2dec($self-&gt;{fontcolor})); #schwarz normalerweise
	$self-&gt;{transcol} = $self-&gt;{img}-&gt;colorAllocate($self-&gt;_hex2dec($self-&gt;{transcolor}));  #transparent
	$self-&gt;{shadowcol} = $self-&gt;{img}-&gt;colorAllocate($self-&gt;_hex2dec($self-&gt;{shadowcolor})); #Schattenfarbe
	$self-&gt;{img}-&gt;transparent($self-&gt;{transcol});
	$self-&gt;{img}-&gt;fill(2,2,$self-&gt;{transcol});
	return $self-&gt;{img};
}


####################################################################
####         Wandelt einen Hexstring "#ffee33" oder "ff88aa" in ein 
####		 Array von 3 Dezimalwerten
####         Argumente  : Hexstring
####         Returnwert : Dezimalarray
####################################################################
sub _hex2dec {
	my ($self,$hex) = @_;
	$hex=~/^\#?(\w\w)(\w\w)(\w\w)/; # Aufteilen 
	@ret= ( hex($1),hex($2),hex($3) ); # und in Hex umwandeln
	$self-&gt;log(4,"Hex2Dec: ".$hex."=".join (",",@ret));
	return @ret; 
}

####################################################################
####         Bearbeitet die Zahlen
####         Argumente  : Hexstring
####         Returnwert : Dezimalarray
####################################################################
sub formnum {
	my $self=shift;
	$self-&gt;log(4,"Entering grafik: formnum");
	if ($self-&gt;{datadirty}==0) {$self-&gt;log(4,"Formnum: Nothing to do :-)");return;}
	my ($gnum, $gN, $data, $mnum,$mN,$mlfd, $llfd, $lN, $lnum, $nach);
	foreach $data ( @{$self-&gt;{datasets}} )  {
		if ($mnum &lt; $data-&gt;{num}) {$mnum=$data-&gt;{num};}    # Die Maximas der einzelnen Zahlen num
		if ($mN &lt; $data-&gt;{N}) {$mN=$data-&gt;{N};}				# N
		if ($mlfd &lt; $data-&gt;{lfd}) {$mlfd=$data-&gt;{lfd};}		# und lfd ermitteln
		$gnum+=$data-&gt;{num};	# Die Summe ueber num
		$gN+=$data-&gt;{N};		# Die Summe ueber N
		if ($data-&gt;{num}=~/\./) {$knum=3;}
		if ($data-&gt;{lfd}=~/\./) {$klfd=3;}
		if ($data-&gt;{N}=~/\./) {$kN=3;}
	
	}
	if ($self-&gt;{N} == 0) {$self-&gt;{N}=$gnum;}    # wurde ein gemeinsames N vorgegeben ?
	if ($gN ==0) {	 # Alle bekommen ein gemeinsames N wenn die Summe der N=0
		foreach $data ( @{$self-&gt;{datasets}} )  {$data-&gt;{N}=$self-&gt;{N};}
		$mN=$self-&gt;{N};
	}
	if ($self-&gt;{nachkomma}&gt;0) {$nach=$self-&gt;{nachkomma}+1;}   # Wenn Nachkomma, dann mit .
	$lnum=length(int($mnum))+$nach;
	$lN=length(int($mlfd))+$nach;
	$llfd=length(int($mlfd));
	if ($nach&gt;0) {$nach--;}
	foreach $data ( @{$self-&gt;{datasets}} )  {
		if ($data-&gt;{num} &gt; $data-&gt;{N}) {$data-&gt;{num} = $data-&gt;{N}*1.11;	}   # WENN alles viel zu groß ist !
		if ($data-&gt;{N} != 0) { $data-&gt;{proz} = sprintf ("%5.1f",100*$data-&gt;{num}/$data-&gt;{N}); }
		else { $data-&gt;{proz}="-----"; }          # Division by zero
		$data-&gt;{pnum}=sprintf "%$lnum.${nach}f",$data-&gt;{num};
		$data-&gt;{pN}=sprintf "%$lN.${nach}f",$data-&gt;{N};
		$data-&gt;{plfd}=sprintf "%${llfd}.0f",$data-&gt;{lfd};
		$self-&gt;log(4,"num='".$data-&gt;{pnum}."' N='".$data-&gt;{pN}."' lfd='".$data-&gt;{plfd}."' Prozent='".$data-&gt;{proz}."'" );
	}
	$self-&gt;{datadirty}=1;
}


####################################################################
####         Setzt die Farben entsprechend den Vorgaben
####         Argumente  : -
####         Returnwert : -
####################################################################
sub _setcolors {
	my $self=shift;
	my ($data, @Cols);
	$self-&gt;log(4,"Entering grafik: setcolors");
	my @Cols = @{$self-&gt;{col}};
	$colors=@Cols;
	$self-&gt;log(4,"Available Colors: @Cols");
	foreach $data (@{$self-&gt;{datasets}}) {
		$col=$data-&gt;{color};						# Entweder eigene Farbe
		if ($col eq "") {$col=shift @Cols; push @Cols, $col;$self-&gt;log(4,"Rotate Colortable");} # oder aus rotierter Farbenliste
		( $data-&gt;{colorn}, $data-&gt;{colord}, $data-&gt;{colorh} )=
		$self-&gt;_colorblend($col);
	}
}	
sub _colorblend {
	my ($self,$col)=@_;
	my $x=64; my @ret=();
	my ($r,$g,$b,$rh,$gh,$bh,$rd,$gd,$bd);
	($r,$g,$b)=$self-&gt;_hex2dec($col);
	$rd=$r-$x;$gd=$g-$x;$bd=$b-$x;
	$rh=$r+$x;$gh=$g+$x;$bh=$b+$x;
	if ($rd&lt;0) {$rd=0;}
	if ($gd&lt;0) {$gd=0;}
	if ($bd&lt;0) {$bd=0;}
	if ($rh&gt;255) {$rh=255;}
	if ($gh&gt;255) {$gh=255;}
	if ($bh&gt;255) {$bh=255;}
	my $in=$self-&gt;{img}-&gt;colorExact($r,$g,$b);
	my $id=$self-&gt;{img}-&gt;colorExact($rd,$gd,$bd);
	my $ih=$self-&gt;{img}-&gt;colorExact($rh,$gh,$bh);
	if ($in==-1) {$in=$self-&gt;{img}-&gt;colorAllocate($r,$g,$b);}
	if ($id==-1) {$id=$self-&gt;{img}-&gt;colorAllocate($rd,$gd,$bd);}
	if ($ih==-1) {$ih=$self-&gt;{img}-&gt;colorAllocate($rh,$gh,$bh);}
	$self-&gt;log(4,"Colors Allocated: ".$self-&gt;{img}-&gt;colorsTotal);
	return ($in,$id,$ih);	
}

####################################################################
####         Speichert das image als .gif 
####         Argumente  : Dateiname
####         Returnwert : -
####################################################################
sub save {
	my ($self,$filename)=@_;
	$self-&gt;log(4,"Entering grafik: save");
	if ($filename eq "") {$filename=$self-&gt;{filename};}
	if ($filename eq "") {$self-&gt;log(2,"No Filename !"); return}
	open FILE, "&gt;$filename" || $self-&gt;log(2, "Konnte Datei: '$filename' nicht oeffnen");
	binmode FILE;
	print FILE $self-&gt;{img}-&gt;gif;
	close FILE;
	$self-&gt;store;
}



####################################################################
####         Ueberprueft, in welchem Polygon der Punkt liegt
####         Argumente  : Dateiname
####         Returnwert : das dataset, wenn Treffer
####################################################################
sub polygonhit {
	my ($self,$x,$y)=@_;
	my $target;
	$self-&gt;log(4,"Entering grafik: polygonhit x=$x y=$y");
	foreach $data (@{$self-&gt;{datasets}}) {
		$target=$self-&gt;_isinpoly($x,$y,$data);
		if (defined $target) {$self-&gt;log(4,"Dataset lfd:".$target-&gt;{lfd}." TREFFER"); last;}
	}
	return $target;
}


####################################################################
####         Ueberprueft, ob ein Punkt im Polygon liegt, oder nicht
####         Argumente  : x/y und \dataset
####         Returnwert : das dataset, wenn Treffer
####################################################################
sub _isinpoly {
	my ($self,$x,$y,$data)=@_;
	my ($er,$erg)=(0,0);
	$self-&gt;log(4,"Entering grafik: isinpoly");
	$data-&gt;{X}[4] = $data-&gt;{X}[0]; # Linie 3 -0 auf 3 -4
	$data-&gt;{Y}[4] = $data-&gt;{Y}[0];

	for ($z=0; $z&lt;4; $z++) {
		$x1=$data-&gt;{X}[$z];   $y1=$data-&gt;{Y}[$z];	# Alle Linien
		$x2=$data-&gt;{X}[$z+1]; $y2=$data-&gt;{Y}[$z+1]; # auf Kreuzung mit 
		$er=_crossing($x,$y,$x1,$y1,$x2,$y2);		# Strahl von Punkt pruefen
		$self-&gt;log(4,"Datalfd:".$data-&gt;{lfd}." x1=$x1 y1=$y1 x2=$x2 y2=$y2 erg=$er");
		$erg+=$er;
	}
	if ($erg==1 || $erg==3) {return $data;}
	else {return;}	

	sub _crossing {						# ob linie x1/y1 - x2/y2 sich schneidet 
		my ($x,$y,$x1,$y1,$x2,$y2)=@_;  # mit linie 0/y - x/y
		if ( ($x1&gt;$x) &amp;&amp; ($x2&gt;$x) ) {return 0;}  # Linie zu weit rechts
		if ( ($y1&gt;$y) &amp;&amp; ($y2&gt;$y) ) {return 0;}  # Linie zu weit unten
		if ( ($y1&lt;$y) &amp;&amp; ($y2&lt;$y) ) {return 0;}  # Linie zu weit oben 
		if ( ($x1&lt;$x) &amp;&amp; ($x2&lt;$x) ) {return 1;}  # Linie  kreuzt sich !
		if ( $y1==$y2) {return 1;}				 # Liegen aufeinander	
		$steig=($x2-$x1)/($y2-$y1);				 # Steigung berechnen	
		$self-&gt;log(4,"Steigung=$steig x=".($x1+($y-$y1)*$steig));
		if ( ($x1+($y-$y1)*$steig)&lt;=$x )  {return 1;}			 # Kreuzung !
		else {return 0;}
	}

}


####################################################################
####         gibt die sachen zurück Tabelle und where
####         Argumente  : x/y und \dataset
####         Returnwert : das dataset, wenn Treffer
####################################################################
sub tablwher {
	my ($self, $target)=@_;
	my (@table, @where, @descr);
    while (defined $target) {
		$self-&gt;log(4,++$x." Table='".$target-&gt;{tabl}."'");
		$self-&gt;log(4,$x." Where='".$target-&gt;{wher}."'");
		push @table, $target-&gt;{tabl};
		push @where, split / / , $target-&gt;{wher};
		unshift @descr, $target-&gt;{descr};
		if ($target-&gt;{pid}) {
			$target=$self-&gt;load($target-&gt;{pid}, $target-&gt;{plfd});
		}
		else {$target= undef;}
	};
	return (\@table, \@where, \@descr);
}


####################################################################
####         Zeichnet den Kuchen
####         Argumente  : -
####         Returnwert : -
####################################################################
sub PI {
	my $self=shift;
	$self-&gt;log(4,"Entering grafik: PI");
	my $rad=$self-&gt;{size} * 4.1;      # Radius des Kreises	
	my $scha=$rad*0.15;				# Radius des Schattens
	my $Zx=1.05*$rad+$self-&gt;{laengstes}+24; # KreisZentrum x 
	my $Zy=1.05*$rad+20;		# und y
	if ($self-&gt;{N} == 0) {return;}  # DIV by zero praevention
	my $winkel=0;					# Startwinkel
	
	my $img=$self-&gt;_init_img($Zx*2,$Zy*2+16);
	$self-&gt;_setcolors($img);
		
	# Schatten......
	$self-&gt;log(4,"Z(x)=$Zx, Z(y)=$Zy, Radius=$rad, Faktor=$Faktor");
	if ($self-&gt;{schmuck} == 2) { # Schatten
		$img-&gt;arc($Zx+$scha,$Zy+$scha,2*$rad,2*$rad,0,360,$self-&gt;{shadowcol} );
		$img-&gt;fill($Zx,$Zy,$self-&gt;{shadowcol});
		$img-&gt;arc($Zx,$Zy,2*$rad,2*$rad,0,360,$self-&gt;{transcol});
		$img-&gt;fill($Zx,$Zy,$self-&gt;{transcol});
		$img-&gt;fill($Zx-$rad+1,$Zy,$self-&gt;{transcol});
	}
	foreach $data ( @{$self-&gt;{datasets}} ) {
		$winkel=$self-&gt;_pie($img, $data, $winkel, $rad, $Zx, $Zy);
		#$self-&gt;save;
		#read STDIN, $aaa, 1
	}

	if ($self-&gt;{printN} &gt; 0) {
		$img-&gt;string(gdSmallFont,1,2*$Zy,"Gesamt: n=".$self-&gt;{N},$self-&gt;{fontcol});
	}
return;
}

# Ein Kuchenstück malen !
sub _pie {
  my $PI = 3.1415927;	# Wurzel aus 2
  my ($self, $img, $data, $start, $rad, $Zx, $Zy) = @_;
  my $scha=$rad*0.15;
  $end=$start+360*$data-&gt;{num}/$self-&gt;{N};		#  Endwinkel
  $ret=$end; my $S=1;
  if ($self-&gt;{schmuck} == 1) {$S=0.4;} #3D
  if ($end == $start) {return $end; }	# In diesem Fall müssen wir nix zeichnen
  my ($p1x, $p1y, $p2x,$p2y,$p3x,$p3y,$p4x,$p4y,$bo1,$bo2,$bo3, $pfx,$pfy);	
  $self-&gt;log(4,"Text=$text, A=$start, B=$end");
  $img-&gt;arc($Zx,$Zy,2*$rad,2*$rad*$S,$start,$end+1,$self-&gt;{fontcol});   #Teil-Kreis malen
  $bo1=((90-$start)*2*$PI)/360 ;						 #Radius1 im Bogenmass
  $bo2=((90-$end)*2*$PI)/360 ;							 #Radius2 im Bogenmaß
  $bo3=($bo1+$bo2)/2;									 #Halber Radius , fuer Punkt mitten im Pie
  if ($bo2 &gt; $bo1) {$bo3+=$PI;}
  $p1x=$rad*sin($bo1)+$Zx;
  $p1y=$rad*cos($bo1)*$S+$Zy;
  $p2x=$rad*sin($bo2)+$Zx;
  $p2y=$rad*cos($bo2)*$S+$Zy;
  $p3x=$rad*sin($bo3)/2+$Zx;					# Mitten im Pie fuer Fuellen
  $p3y=$rad*cos($bo3)/2*$S+$Zy;
  $p4x=$rad*sin($bo3)*1.05+$Zx;					# Textkoordinaten
  $p4y=$rad*cos($bo3)*1.05*$S+$Zy;
  $self-&gt;log(4,"p1x=$p1x, p1y=$p1y, p2x=$p2x, p2y=$p2y, bo1=$bo1, bo2=$bo2");
  $img-&gt;line($Zx,$Zy,$p1x,$p1y,$self-&gt;{fontcol});
  $img-&gt;line($Zx,$Zy,$p2x,$p2y,$self-&gt;{fontcol});
  $img-&gt;fill($p3x,$p3y,$data-&gt;{colorn});
  $data-&gt;{X}[0]=$p1x; $data-&gt;{Y}[0]=$p1y; $data-&gt;{X}[1]=$p4x; $data-&gt;{Y}[1]=$p4y;	# Umspannendes Polygon
  $data-&gt;{X}[2]=$p2x; $data-&gt;{Y}[2]=$p2y; $data-&gt;{X}[3]=$Zx; $data-&gt;{Y}[3]=$Zy;
  if ( ($self-&gt;{schmuck} == 1) &amp;&amp; ($start&lt;180) ) { #3D
   	if ($end&gt;180) {
	  $end=180;
	  $bo2=((90-$end)*2*$PI)/360 ;						 #Radius2 im Bogenmaß
          $p2x=$rad*sin($bo2)+$Zx;
          $p2y=$rad*cos($bo2)*$S+$Zy;
  	}
	$self-&gt;log(4,"3D:p1x=$p1x, p1y=$p1y, p2x=$p2x, p2y=$p2y, bo1=$bo1, bo2=$bo2");
      if ($p1x-3&gt;$p2x){  					# Nur zeichnen, wenns was zu fuellen gibt	
	$img-&gt;line($p1x,$p1y,$p1x,$p1y+$scha,$self-&gt;{fontcol});   #Die Verbindungslinien
	$img-&gt;line($p2x,$p2y,$p2x,$p2y+$scha,$self-&gt;{fontcol});		
	$img-&gt;arc($Zx,$Zy+$scha,2*$rad,2*$rad*$S,$start,$end+1,$self-&gt;{fontcol});   #Teil-schatten Kreis malen
	$img-&gt;fill($p1x-1,$p1y+$scha/2,$data-&gt;{colord});  # "Tiefe" Fuellen
      }
	$self-&gt;log(4,$p1x." - ".$p2x);
   	if ($p4y&gt;$Zy){$p4y+=$scha;}	# Schrift nach unten setzen
  }	
  if ($p4x &lt; $Zx) {$p4x-=length($data-&gt;{textv}.$data-&gt;{texth})*6;}
  $img-&gt;string(gdSmallFont,$p4x,$p4y-6,$data-&gt;{textv}.$data-&gt;{texth},$self-&gt;{fontcol});
  return $ret;
}


####################################################################
####         Zeichnet die Balken
####         Argumente  : -
####         Returnwert : -
####################################################################
sub BA {
	my $self=shift;
	my $bar=$self-&gt;{size} * 9.23;      # Breite des Balkens krumme Werte provozieren
	my $barhi=$bar/16;			  # Balkenhoehe;
	my $anzahl=@{$self-&gt;{datasets}};
	my ($Y, $X) = ($barhi*2,1);
	my $img = $self-&gt;_init_img($bar+$X+$self-&gt;{laengstes}+6, 2*$barhi*($anzahl+1)+$barhi/2+16);
	$self-&gt;_setcolors;
	$self-&gt;log(4,"X=".($bar+$X+$self-&gt;{laengstes}+6)."  Y=".(2*$barhi*($anzahl+1)+$barhi/2+16) );
	foreach $data ( @{$self-&gt;{datasets}} ) {
		if ($data-&gt;{N} == 0) {next;}  # Division by Zero praevention
		($X,$Y)=$self-&gt;_bar($img, $data, $X, $Y, $bar, $barhi );
	}
	if ($self-&gt;{printN} &gt; 0) {
		$img-&gt;string(gdSmallFont,$X,$Y,"Gesamt: n=".$self-&gt;{N},$self-&gt;{fontcol});
	}

}


sub _bar {
  my ($self,$img, $data, $x, $y, $size, $height) = @_;
  if ($data-&gt;{N} == 0) {return ($x,$y);	}  # Division by Zero praevention
  my $lang=$size*$data-&gt;{num}/$data-&gt;{N};	# Effektive Laenge des Balkens abhaengig von den Daten
  my $half=$height/2;						# Halbe Hoehe fuer die 3D ansicht
  my $Dx=$x+$self-&gt;{laengstesv}+4;			# Abstand des Balkens von Links
  my $p1x=$Dx; my $p1y=$y; my $p2x=$Dx+$lang; my $p2y=$y;
  my $p3x=$p2x+$half; my $p3y=$p2y-$half;
  my $p4x=$Dx; my $p4y=$y-$height; my $p5x=$Dx+$lang; my $p5y=$y-$height;
  my $p6x=$p4x+$half; my $p6y=$p4y-$half; my $p7x=$p5x+$half; my $p7y=$p5y-$half;
  my $ptx=$p3x+4; my $pty=$p2y-12; my $ptyv=$p1y-12; # Textkoord.
  my $pf1x=$p1x+1; my $pf1y=$p1y-1; my $pf2x=$p6x; my $pf2y=$p6y+1; my $pf3x=$p3x-1; my $pf3y=$p3y;  # Fuellkoordinaten
  my $ps1x=$p1x+$half; my $ps1y=$p1y+$half; my $ps2x=$p5x+$half; my $ps2y=$p5y+$half;
  if ($self-&gt;{schmuck} == 2) { # Schatten
	  $img-&gt;rectangle($ps1x,$ps1y,$ps2x,$ps2y,$self-&gt;{shadowcol});		    # Rechteck
	  if ($ps1x+2&lt;$ps2x) {$img-&gt;fill($ps2x-1,$ps2y+1,$self-&gt;{shadowcol});}
  
  }
  $self-&gt;log(4, "P1X : $p1x $p1y $p2x $p2y $p3x $p3y");
  $img-&gt;rectangle($p1x,$p1y,$p5x,$p5y,$self-&gt;{fontcol});		    # Rechteck
  if ($p5x-2&gt;$pf1x) {  $img-&gt;fillToBorder($pf1x,$pf1y,$self-&gt;{fontcol},$data-&gt;{colorn});	}
  
  $data-&gt;{X}[0]=$p1x; $data-&gt;{Y}[0]=$p1y; $data-&gt;{X}[1]=$p2x; $data-&gt;{Y}[1]=$p2y;  # Umspannendes Polygon
  $data-&gt;{X}[2]=$p5x; $data-&gt;{Y}[2]=$p5y; $data-&gt;{X}[3]=$p4x; $data-&gt;{Y}[3]=$p4y;
  if ($self-&gt;{schmuck} == 1) { #3D
    $img-&gt;line($p4x,$p4y,$p6x,$p6y,$self-&gt;{fontcol});           # Schräg ob. li.
    $img-&gt;line($p5x,$p5y,$p7x,$p7y,$self-&gt;{fontcol});           # Schräg ob. re.
    $img-&gt;line($p2x,$p2y,$p3x,$p3y,$self-&gt;{fontcol});           # Schräg un. re.
    $img-&gt;line($p6x,$p6y,$p7x,$p7y,$self-&gt;{fontcol});           # grade ob.
    $img-&gt;line($p7x,$p7y,$p3x,$p3y,$self-&gt;{fontcol});           # senkr. re.
    if ($p7x-2&gt;$pf2x) { $img-&gt;fill($pf2x,$pf2y,$data-&gt;{colorh});}
    $img-&gt;fill($pf3x,$pf3y,$data-&gt;{colord});
	$pty=$p3y-12;												# Texth etwas hoeher bei 3D
	$data-&gt;{X}[2]=$p7x; $data-&gt;{Y}[2]=$p7y; $data-&gt;{X}[3]=$p6x; $data-&gt;{Y}[3]=$p6y;  # Polygon aendern
  }
  $img-&gt;string(gdSmallFont,$ptx,$pty,$data-&gt;{texth},$self-&gt;{fontcol});
  $img-&gt;string(gdSmallFont,$x,$ptyv,$data-&gt;{textv},$self-&gt;{fontcol});
  return ($x,$y+$height*2);					
}


####################################################################
####         Zeichnet die Skala
####         Argumente  : -
####         Returnwert : -
####################################################################
sub SK {
	my $self=shift;
	$self-&gt;{N}=int($self-&gt;{N});
	my $xsize=$self-&gt;{size}*0.95;       # Breite der Teilskala
	my $ysize=$xsize;			   # Hoehe der Teilskala
	my $anzahl=@{$self-&gt;{datasets}};
	my ($Y, $X) = ($ysize+4, 1);
	if ($self-&gt;{schmuck} == 1) {   # 3D
		$ysize/=2;
		$X=$xsize*$anzahl+1;
	}
	
	my $img = $self-&gt;_init_img($X+$self-&gt;{N}*$xsize+$self-&gt;{laengstes}+6, ($anzahl+1)*$ysize+16);
	$self-&gt;_setcolors;
	foreach $data ( @{$self-&gt;{datasets}} ) {
		#$self-&gt;save;
		#read STDIN, $aaa,1;
		($X,$Y)=$self-&gt;_skala($img, $data, $X, $Y, $xsize, $ysize );
	}
	if ($self-&gt;{printN} &gt; 0) {
		$img-&gt;string(gdSmallFont,$X,$Y,"Gesamt: n=".$self-&gt;{N},$self-&gt;{fontcol});
	}

}
  
sub _skala {
	  my ($self, $img, $data, $x, $y, $xsize, $ysize) = @_;
	  my $Dx=$self-&gt;{laengstesv}+4+$x;
	  my $yo=$y-$ysize/2; my $yu=$yo+$ysize;
	  my $xo=$Dx; my $xu=$Dx;
	  my $ry=$y+$ysize; my $rx=$x;			# Returnwerte
	  if ($self-&gt;{schmuck} == 1) {$xo+=$xsize/2; $xu=$xo-$xsize; $rx=$x-$xsize}  #3D
	  $img-&gt;line($Dx-2,$y,$Dx+($data-&gt;{N}-1)*$xsize+2,$y,$data-&gt;{fontcol});           # Waagerechte Linie...
	  if ($self-&gt;{schmuck} == 2) { # Schatten
		$img-&gt;line($Dx-2+9,$y+9,$Dx+($data-&gt;{N}-1)*$xsize+2+9,$y+5,$data-&gt;{shadowcol});           # Waagerechter Schatten
	  }
	  for ($n=0; $n&lt;$data-&gt;{N}; $n++) {											  # Senkrechte Linien		
		$img-&gt;line($xo+$xsize*$n,$yo,$xu+$xsize*$n,$yu,$self-&gt;{fontcol});	  
	    if ($self-&gt;{schmuck} == 2) {# Schatten
			$img-&gt;line($xo+$xsize*$n+9,$yo+9,$xu+$xsize*$n+9,$yu+9,$self-&gt;{shadowcol});	  
		}
	  }
	  $img-&gt;arc($Dx+($data-&gt;{num}-1)*$xsize,$y,$xsize/2,$ysize/2,0,360,$data-&gt;{colorn});   #Zielkreis malen	
	  $img-&gt;fillToBorder($Dx+($data-&gt;{num}-1)*$xsize,$y,$data-&gt;{colorn},$data-&gt;{colorn});  # und ausfüllen	
	  $img-&gt;string(gdSmallFont,$x,$y-6,$data-&gt;{textv},$self-&gt;{fontcol});
	  $img-&gt;string(gdSmallFont,$Dx+($data-&gt;{N}-1)*$xsize+4,$y-6,$data-&gt;{texth},$self-&gt;{fontcol});
	  $data-&gt;{X}[0]=$xo; $data-&gt;{Y}[0]=$yo; $data-&gt;{X}[1]=$xo+$xsize*($data-&gt;{N}-1); $data-&gt;{Y}[1]=$yo;  # Umspannendes Polygon
	  $data-&gt;{X}[2]=$xu+$xsize*($data-&gt;{N}-1); $data-&gt;{Y}[2]=$yu; $data-&gt;{X}[3]=$xu; $data-&gt;{Y}[3]=$yu;

	  #$img-&gt;line($x,$y,$rx,$ry,$self-&gt;{fontcol});	   	
	  return ($rx, $ry);
	  
}	


####################################################################
####         Zeichnet den Verlauf
####         Argumente  : -
####         Returnwert : -
####################################################################
sub VL {
	my $self=shift;
	my $ysize=$self-&gt;{size}*1.02;     # Breite der Teilskala
	my $xsize=$ysize;   # Hoehe der Teilskala
	my $anzahl=@{$self-&gt;{datasets}};
	my ($Y, $X) = ($ysize+4, 1);
	$ysize/=2;
	#if ($self-&gt;{schmuck} eq "3D") {
	#	$ysize/=2;
	#	$X=$xsize*$anzahl+1;
	#}
	my ($ox,$oy)=(0,0);
	my $img = $self-&gt;_init_img($X+10*$xsize+$self-&gt;{laengstes}+6, ($anzahl+1)*$ysize+16);
	$self-&gt;_setcolors;
	foreach $data ( @{$self-&gt;{datasets}} ) {
		($X,$Y,$ox,$oy)= $self-&gt;_verlauf($img,$data,$X,$Y,$ox,$oy,$xsize,$ysize);	
	}
	if ($self-&gt;{printN} &gt; 0) {
		$img-&gt;string(gdSmallFont,$X,$Y,"Gesamt: n=".$self-&gt;{N},$self-&gt;{fontcol});
	}
}

sub _verlauf{
	  my ($self, $img, $data, $x, $y, $oldx, $oldy, $xsize, $ysize) = @_;
	  my $Dx=$self-&gt;{laengstesv}+4+$x;
	  my $xh=$xsize*$data-&gt;{proz}/10+$Dx;
	  $img-&gt;line($Dx, $y, $xh, $y, $data-&gt;{colord});
	  if ($oldx!=0 &amp;&amp; $oldy!=0) {  $img-&gt;line($xh,$y,$oldx,$oldy,$self-&gt;{fontcol}); }
      $img-&gt;arc($xh, $y, $xsize/3,$xsize/3,0,360,$data-&gt;{colorn});	# Kringel
  	  $img-&gt;fillToBorder($xh, $y, $data-&gt;{colorn},$data-&gt;{colorn});  # und ausfüllen	
	  $img-&gt;string(gdSmallFont,$x,$y-6,$data-&gt;{textv},$self-&gt;{fontcol});
	  $img-&gt;string(gdSmallFont,$xh+$xsize/5+3,$y-6,$data-&gt;{texth},$self-&gt;{fontcol});
	  $self-&gt;log(4,"X=$x, Y=$y, OldX=$oldx, OldY=$oldy, Dx=$Dx, xh=$xh");
	  $data-&gt;{X}[0]=$Dx; $data-&gt;{Y}[0]=$y-$ysize/2; $data-&gt;{X}[1]=$xh; $data-&gt;{Y}[1]=$y-$ysize/2;  # Umspannendes Polygon
	  $data-&gt;{X}[2]=$xh; $data-&gt;{Y}[2]=$y+$ysize/2; $data-&gt;{X}[3]=$Dx; $data-&gt;{Y}[3]=$y+$ysize/2;
	  $oldx=$xh;
      $oldy=$y;
	  $y+=$ysize;
	  return $x,$y,$oldx,$oldy;	
 }
</pre></body></html>