page top

package k2;

;# -----------------------------------------------------------------------------
;# K2/LIB::PERL LIBRARY++                                                     .
;#                                                                             .
;#       TAG Library                                                           .
;#                                                                             .
;#                             All Right Reserved, CopyRight (C) 2008 by Dr.K  .
;# -----------------------------------------------------------------------------


;#//////////////////////////////////////////////////////////////////////////////
;# Perl Package Module Import
;#//////////////////////////////////////////////////////////////////////////////
 #use strict;
 use Switch;
 #require 'K2_UTY.pl';
;#//////////////////////////////////////////////////////////////////////////////


;#//////////////////////////////////////////////////////////////////////////////
;# Prototype
;#//////////////////////////////////////////////////////////////////////////////
;# <TAG>自動生成関数 x 13
;# FONTH($lh)
;# INDENT($id)
;# LIST($ul, @dt)
;# RUBY($rb, $rt)
;# SUB($s)
;# FONT1($fn, $fc, $fs)
;# FONT($fs, $fc, $bg, $fn, $cs)
;# IMG($fl, $bd, $wd, $ht, $al)
;# EMBED($fl, $rp, $bd, $wd, $ht)
;# DIV($al, $mg, $pd, $wd, $px, $ps, $cl, $bc, $cs)
;# MARQUEE($s, $dr, ($ht,) $bh, $bg)
;# FILTER($ef, $v1, $v2, $v3, $v4)
;# TABLE($sw, $lc, $tt, $ft, @ft, @dt)

;# フォーム送信関数 x 8
;# InpGroup($txt, $aln, $sty)
;# InpForm($cgi, $tgt, $sty)
;# InpMemo($nam, $col, $row, $txt, $fep, $rsw, $sty)
;# InpText($typ, $nam, $siz, $max, $txt, $fep, $sty)
;# InpCheck($typ, $nam, $val, $chk, $ptr, $sty)
;# InpButton($typ, $val, $siz, $ptr, $sty)
;# InpImage($nam, $alt, $img, $ptr, $sty)
;# InpSelect($typ, $nam, $siz, $ptr, $sty, @dat)

;# Total = 17
;#//////////////////////////////////////////////////////////////////////////////


;#//////////////////////////////////////////////////////////////////////////////
;# <TAG>自動生成関数
;#//////////////////////////////////////////////////////////////////////////////


# <line-Hhight>改行スペース(終了タグあり)
# ($lh) = 150(50%の改行スペースになる)
sub FONTH{
	my ($lh) = @_;
	if($lh eq ''){
		return('</FONT>');
	}else{
		return('<FONT style="'."line-height: $lh%".'">');
	}
}

# 段落(終了タグあり)
# ($id) = 段落の文字数
sub INDENT{
	my ($id) = @_;
	if(@_[0] eq ''){
		return('</DIV>');
	}else{
		return('<DIV style="text-indent: 0em; padding-left: '.$id.'em">');
	}
}

# <UL><OL>リスト(終了タグなし)
# ($ul) = (d or 1) (c or 2) (s or 3) (1, a, A, i, I)
# (@dt) = @(表示データ)
sub LIST{
	my ($ul, @dt) = @_;
	my($tag, @lst);

	unless($ul){
		$tag = 'UL';
		$ul = 'disc';
	}else{
		if(PosStr($ul, '1 a A i I') > 0){
			$tag = 'OL';
		}else{
			$tag = 'UL';
			$ul = lc($ul);
			$ul = 'disc'  if(PosStr($ul, '1d'));
			$ul = 'circle'if(PosStr($ul, '2c'));
			$ul = 'square'if(PosStr($ul, '3s'));
		}
	}

	push(@lst, "<$tag type='$ul'>");
	foreach(@dt){
		push(@lst, "\t<LI>$_</LI>");
	}
	push(@lst, "</$tag>");

	return(@lst);
}

#<RUBY>ルビ(終了タグなし)
# ($rb) = 対象文字、$rt＝ルビ(等幅フォント)
sub RUBY{
	my ($rb, $rt) = @_;
	my $ret = "<RUBY><RB>$rb<RP>(<RT>$rt<RP>)</RUBY>";
	return($ret);
}

# (終了タグなし)
# 下付き文字(H20 -> H\_2O)
# 上付き文字(x2 + y2 -> x\~2 + y\~2)
sub SUB{
	my ($s) = @_;
	my ($p, $a, $b);
	do{
		$p = PosStrW('\_', $s);
		if($p){
			$a = LeftStrW($s, $p - 1).'<SUB>';
			$b = MidStrW($s, $p + 2, 1).'</SUB>';
			$s = $a.$b.RightStrW($s, LengthW($s) - $p - 2);
		}
	}while($p);
	do{
		$p = PosStrW('\~', $s);
		if($p){
			$a = LeftStrW($s, $p - 1).'<SUP>';
			$b = MidStrW($s, $p + 2, 1).'</SUP>';
			$s = $a.$b.RightStrW($s, LengthW($s) - $p - 2);
		}
	}while($p);
	return($s);
}

# <SPAN>インライン要素(終了タグあり)
# ($fn) = フォント名(g, gp, m, mp)
# ($fs) = フォントサイズ(pix)
# ($fc) = フォントカラー
# ($bg) = バックカラー
# ($cs) = スタイルシート
sub FONT{
	my ($fs, $fc, $bg, $fn, $cs) = @_;

	if($fn.$fs.$fc.$bg.$cs eq ''){
		return('</SPAN>');
	}else{
		if($fn){
			$fn = fixFont($fn);
			$fn = "font-family: $fn; "
		}
		$fs = "font-size: $fs; "       if($fs);
		$fc = "color: $fc; "           if($fc);
		$bg = "background-color: $bg; "if($bg);
		$cs = ' '.$cs                  if($cs);

		my $css = '<SPAN style="'.Trim($fn.$fs.$fc.$bg.$cs).'">';
		return($css);
	}
}

# <FONT>フォント(終了タグあり)
# ($fn) = フォント名(g, gp, m, mp)
# ($fc) = フォントカラー
# ($fs) = フォントサイズ(1 - 7)(+1, +2)
sub FONT1{
	my ($fn, $fc, $fs) = @_;

	if($fn eq ''){
		return('</FONT>');
	}else{
		$fn = fixFont($fn);
		my $fnt = "<FONT face='$fn' size=$fs color='$fc'>";
		return($fnt);
	}
}

# <IMG>イメージ(終了タグなし)
# ($fl) = パス
# ($bd) = ボーダー(pix)
# ($wd) = 横サイズ(pix)
# ($ht) = 縦サイズ(pix)
# ($al) = 画像説明(alt)
sub IMG{
    my ($fl, $bd, $wd, $ht, $al, $cs) = @_;

    ($wd, $ht) = ImgSize($fl) if($wd eq '?');

    $bd = '0' unless($bd);
    $al = 'alt="'.$al.'" '    if($al);
    $wd = 'width="'.$wd.'" '  if($wd);
    $ht = 'height="'.$ht.'" ' if($ht);
    my $img = '<IMG src="'.$fl.'" '.$al.$wd.$ht.'border="'.$bd.'">';

    return($img);
}

# <EMBED>動画、音楽(終了タグなし)
# ($ph) = パス
# ($rp) = 繰り返し回数
# ($bd) = ボーダー(pix)
# ($wd) = 横サイズ(pix)
# ($ht) = 縦サイズ(pix)
sub EMBED{
    my ($fl, $rp, $bd, $wd, $ht) = @_;

    $bd = '0' unless($bd);
    $wd = 'width="'.$wd.'" ' if($wd);
    $ht = 'height="'.$ht.'" ' if($ht);
    $rp = 'loop = "true" repeat="'.$rp.'" ' if($rp);

    my $ct = 'control="smallconsole" ';
    my $emb = '<EMBED src="'.$fl.'" autostart="true" '.$ct.$rp.$wd.$ht.'border="'.$bd.'">';
    $emb .= '<NOEMBED>プラグインで来ませんでした！！</NOEMBED>';

    return($emb);
}

#<MARQUEE>マーキー(終了タグなし)
# ($s, $dr, ($ht,) $bh, $bg)
# ($s)  = 対象文字列
# ($dr) = (1:右へ、2:左へ、3:上へ、4:下へ)
# ($ht) = (dr=[3, 4] -> スクロールする高さ)
# ($bh) = (1:端で停止、2:スクロール、3:往復)
# ($bg) = バックグラウンドカラー(default = white)
sub MARQUEE{
	my ($s, $dr, $d1, $d2, $d3) = @_;
	my ($bh, $ht, $bg, $m1, $m2, $ret);

	$dr = MinMax($dr, 1, 4);
	if($dr eq '3' || $dr eq '4'){
		$ht = $d1;
		$bh = $d2;
		$bg = $d3;
	}else{
		$bh = $d1;
		$bg = $d2;
	}

	switch($dr){
		case 1 {$m1 = 'direction="right" '}
		case 2 {$m1 = 'direction="left" '}
		case 3 {$m1 = 'direction="up" '}
		case 4 {$m1 = 'direction="down" '}
	}

	switch(MinMax($bh, 1, 3)){
		case 1 {$m2 = 'behavior="scroll" '}
		case 2 {$m2 = 'behavior="alternate" '}
		case 3 {$m2 = 'behavior="slide" '}
	}

	$ht = 'height="'.$ht.'" ' if($ht);
	$bg = 'bgcolor="'.$bg.'"' if($bg);
	$ret = "<MARQUEE $m1$m2$ht$bg>$s</MARQUEE>";

	return($ret);
}

# <FILTER>フィルター(終了タグあり)
# 対象 = (文字、画像)
# ($ef) = 種類(1 - 13)
# ($v?) = 要素(1 - 4)
sub FILTER{
	my ($ef, $v1, $v2, $v3, $v4) = @_;

	if($ef eq ''){
		return('</SPAN>');
	}else{
		my (@ff, $tg);
		@ff = (
			# 1.発光効果($v1=効果度合,$v2=影の色)
			'glow(strength='.$v1.',color='.$v2.')' ,
			# 2.影の効果($v1=表示位置,$v2=影の色)
			'dropshadow(offx='.$v1.',offy='.$v1.',color='.$v2.')' ,
			# 3.立体効果($v1=表示方向,$v2=影の色)
			'shadow(direction='.$v1.',color='.$v2.')' ,

			# 4.滲み効果($v1=ぼかし方向, $v2=ぼかし強度)
			'blur(add=0,direction='.$v1.',strength='.$v2.')' ,
			# 5.波の効果($v1=繰り返し回数, $v2=開始位置, $v3=うねり強度, $v4=明るさの強度)
			'wave(add=0,freq='.$v1.',phase='.$v2.',strength='.$v3.',lightstrength='.$v4.')' ,

			# 6.半透明化($v1=透明の度合)
			'Alpha(opacity='.$v1.')' ,
			# 7.透明効果($v1=透明にしたい色)
			'Chroma(color='.$v1.')' ,
			# 8.マスク作成($v1=透明部の塗り潰し色)
			'Mask(color='.$v1.')' ,

			# 9.¸ÞÚ°½¹°Ù(引数無し)
			'Gray()' ,
			# 10.Ｘ線効果(引数無し)
			'Xray()' ,

			# 11.左右反転(引数無し)
			'FlipH()' ,
			# 12.上下反転(引数無し)
			'Flipv()' ,
			# 13.色の反転(引数無し)
			'Invert()'
		);

		$ef = MinMax($ef, 1, 13) - 1;
		$tg = '<SPAN style="width:100%; filter: '.$ff[$ef].';">';
		return($tg);
	}
}

# <DIV>ブロック要素(終了タグあり)
#
# 親コンテナ
# 引数が '$al' のみの場合
# $al = Align('0,L', '1,C', '2,R', '3,J')
#
# 子コンテナ
# ($mg) = margin(pix)
# ($pd) = padding(pix)
# ($wd) = width(pix or %)
# ($px) = borderLine(pix)
# ($ps) = borderStyle(0-2)
# ($cl) = borderColor
# ($bc) = backgroundColor
# ($cs) = スタイルシート
sub DIV{
	my ($al, $mg, $pd, $wd, $px, $ps, $cl, $bc, $cs) = @_;

	if($al eq ''){
		return('</DIV>');
	}else{
		my $align = 'center';
		my $s = lc(LeftStr($al, 1));
		$align = 'left'    if(PosStr($al, '0l'));
		$align = 'center'  if(PosStr($al, '1c'));
		$align = 'right'   if(PosStr($al, '2r'));
		$align = 'justify' if(PosStr($al, '3j'));
		$al = $align;

		unless($mg.$pd.$wd.$px.$cl.$bc.$cs){
			return("<DIV align='$al'>");
		}else{
			$wd = 'width:'.$wd.'; '    if($wd ne '');
			$mg = 'margin:'.$mg.'px; ' if($mg ne '');
			$pd = 'padding:'.$pd.'px; 'if($pd ne '');

			if($px ne '' && $cl ne ''){
				$px = 'border:'.$px.'px ';
				if($cl ne ''){
					my @bs = ('solid', 'dotted', 'dashed');
					$ps = MinMax($ps, 0, 2);
					$px .= $bs[$ps].' '.$cl.'; ';
                }
			}else{
				$px = '';
				$cl = '';
			}

			if($bc ne ''){
				$bc = "background-color:$bc";
			}

			$cs = ' '.$cs if($cs);
			my $div = TrimR($mg.$pd.$wd.$px.$bc.$cs);
			if($div){
				$div = "<DIV align='".$al."'".' style="'.$div.'">';
			}else{
				$div = "<DIV align='".$al."'>";
			}
			return($div);
		}
	}
}

# <TABLE>配列からテーブルを生成(終了タグなし)
# 引数($sw, $vl, $lc, $tt, $ft, @ft, @dt)
#
# $sw:: TABLEタイプ(
#       0=Flat罫線なし
#       1=Flat罫線あり
#       2=３Ｄ罫線凹
#       3=３Ｄ罫線凸
#       4=FLAT横罫線
#       5=FLAT縦罫線
#    )
# $lc:: 罫線ラインの色
# $tt:: タイトル
# $th:: フッタ('フッタ' or 'フッタ:color or 'フッタ:color:align')
# @dt:: テーブルデータ(基本的にセルのフォントデータが優先される)
#
# -- テーブルデータ --
# @dt = (
#     -- ヘッダー(無くても良い) --
#     0: [cells0, cells1, cells2],
#     -- セルデータ --
#     1: [cells0, cells1, cells2],
#                    :
#     ?: [cells0, cells1, cells2]
#     );
#
# -- フォーマットデータ(無くても良い) --
# -- 無い場合(セル幅=文字幅、セルカラー=白、Align=Center、Valign=Center)
# @ft = (
#     -- フォーマット開始(順番は決まっている) --
#     0: ['/'],
#     -- セルの幅(pixel)、'null' で文字幅 --
#     1: [width0, width1, width2],
#     -- セルのAlign('L,l,0=left', 'c,1=center', 'r,2=right') --
#     2: [align0, align1, align2],
#     -- セルカラー(#rrggbb) --
#     3: [color0, color1, color2],
#     -- なくても良いが、あればLine Colorを優先 --
#     -- ロウカラー (Line:color) (Line=? -> OtherLine)(Line=x -> OddLine) --
#     4: ['0:cl'. '2:cl', '?:cl', 'x:cl'],
#     -- セルフォントカラー(#rrggbb) --
#     5: [color0, color1, color2],
#     -- なくても良いが、あればLine Colorを優先 --
#     -- ロウフォントカラー (４と同じ) --
#     6: ['0:cl'. '2:cl', '?:cl', 'x:cl'],
#     -- セルのValign('t,0=top', 'c,1=center', 'b,2=bottom') --
#     7: ['0:valign0'. '2:valign2', '?:valign Etc'],
#     -- フォーマット終了 --
#     8: ['/']
#     );
#
# ex1)
# @ret = TABLE(1, 'gray', '', @dt)  : 取りあえずこれで使える(Default Format)
#
# -- テーブルフォーマット --
#
# ※テーブルフォーマットは１〜７種類あり、順番は決まっているが
#   必要なければ何処でも終了できる、また空欄でデフォルト設定になる
#
# my @f = (['/'],    : 開始マーク(必須)
#          ['', ''], : 1.Cell Width     : 規定値(文字幅)  : pix
#          ['', ''], : 2.Cell Align     : 規定値(Center)  : 1|L, 2|C, 3|R
#          ['', ''], : 3.Col BgColor    : 規定値(White)   : #RRGGBB, blue
#          ['', ''], : 4.Row BgColor    : 規定値(White)   : #RRGGBB, blue
#          ['', ''], : 5.Col FontColor  : 規定値(Black)   : #RRGGBB, blue
#          ['', ''], : 6.Row FontColor  : 規定値(Black)   : 1|T, 2|C, 3|B
#          ['', ''], : 7.Col Valign     : 規定値(Top)
#          ['/']);   : 終了マーク(必須)
#
# ex2)
# my @f = (['/'],
#          ['', '', ''],
#          ['', '', ''],
#          ['green', 'blue', 'red'], : cell[0]=green, cell[1]=blue, cell[2]=red
#          ['/']);
#
# my @f = (['/'],
#          ['', '', ''],
#          ['', '', ''],
#          ['', '', ''],
#          ['0:blue', '?:white']    : Row[0]の色を'blue'に指定、その他は'white'
#          ['white', 'blue', 'red'], : cell[0]=white, cell[1]=blue, cell[0]=red
#          ['0:blue', '?:white'],   : Row[0]の色を'blue'に指定、その他は'white'
#          ['/']);
#
# my @f = (['/'],
#          [100, 200, 300],    : cell[0]=100pix, cell[1]=200pix, cell[2]=100pix
#          ['L', 'C', 'R'],       : cell[0]=left, cell[1]=center, cell[2]=right
#          ['#eeeeff', '#eeffee', '#ffeeee'],
#          ['/']);
#
# my @f = (['/'],
#          [100, 200, 300],
#          ['0', '1', '2'],
#          ['#eeeeff', '#eeffee', '#ffeeee'],      :         ←┐
#          ['0:blue', '1:yellow', '?:white'],      : ←この行が└より優先される
#          ['white', 'blue', 'red'],               :         ←┐
#          ['0:blue', '2:red', '?:white'],         : ←この行が└より優先される
#          ['0:T', '1:C', '?:B'],: 0行目が上寄せ, 1行目が真ん中, その他が下寄せ
#          ['/']);
#
# @ret = TABLE(1, 'gray', 'タイトル', @ft, @dt);
#
sub TABLE{
	my ($sw, $lc, $tt, $ft, @dt) = @_;
	my ($cs, $bd, $mw, $tb, $d3, @tb, @wd, @cl, @fc, @al, %hc, %hf, %hv);

	# Init Table Type
	$sw = MinMax($sw, 0, 5);
	switch($sw){
		case 0 {$cs = 0; $bd = 0}
		case 1 {$cs = 1; $bd = 0}
		case 2 {$cs = 1; $bd = 1}
		case 3 {
			$cs = 1; $bd = 0;
			$d3 = 'style="border-width: 1px 1px; border-style: solid; ';
			$d3 .= 'border-color: #9999CC #333366 #333366 #9999CC;" '
		}
		case 4 {
			$cs = 1; $bd = 0;
			$d3 = 'style="border-style: solid; border-width: 1px 0px;" ';
			$tb = 'style="border-collapse: collapse; border-style: solid;';
			$tb .= ' border-width: 1px; border-color: '.$lc.';" ';
		}
		case 5 {
			$cs = 1; $bd = 0;
			$d3 = 'style="border-style: solid; border-width: 0px 1px;" ';
			$tb = 'style="border-collapse: collapse; border-style: solid;';
			$tb .= ' border-width: 1px; border-color: '.$lc.';" ';
		}
	}
	unless($tb){
		$tb = "cellspacing=$cs cellpadding=3 border=$bd bgcolor=$lc";
	}

	# is Exists Table Format ?
	if($dt[0][0] eq '/'){
		DeleteOf(\@dt, 0, 1);

		#1 is Exists Cell Width ?
		unless($dt[0][0] eq '/'){
			@wd = @{$dt[0]};
			for(my $j = 0; $j < @wd; $j++){
				$mw += $wd[$j];
			}
			DeleteOf(\@dt, 0, 1);
		}

		#2 is Exists Cell Align ?
		unless($dt[0][0] eq '/'){
			@al = @{$dt[0]};
			for(my $i = 0; $i < @al; $i++){
				my $v = LeftStr(lc(@al[$i]), 1);
				my $s = 'center';
				$s = 'left'  if(PosStr($v, '0l'));
				$s = 'center'if(PosStr($v, '1c'));
				$s = 'right' if(PosStr($v, '2r'));
				@al[$i] = $s;
			}
			DeleteOf(\@dt, 0, 1);
		}

		#3 is Exists Cell Color ?
		unless($dt[0][0] eq '/'){
			@cl = @{$dt[0]};
			for(my $i = 0; $i < @cl; $i++){
				@cl[$i] = 'white' unless(@cl[$i]);
			}
			DeleteOf(\@dt, 0, 1);
		}

		#4 is Exists Line Color ?
		unless($dt[0][0] eq '/'){
			my @wk = @{$dt[0]};
			for(my $i = 0; $i < @wk; $i++){
				my @r = CutOff(':', $wk[$i]);
				$hc{$r[0]} = $r[1];
			}
			DeleteOf(\@dt, 0, 1);
		}

		#5 is Exists Cell FontColor ?
		unless($dt[0][0] eq '/'){
			@fc = @{$dt[0]};
			for(my $i = 0; $i < @fc; $i++){
				@fc[$i] = 'black' unless(@fc[$i]);
			}
			DeleteOf(\@dt, 0, 1);
		}

		#6 is Exists Line FontColor ?
		unless($dt[0][0] eq '/'){
			my @wk = @{$dt[0]};
			for(my $i = 0; $i < @wk; $i++){
				my @r = CutOff(':', $wk[$i]);
				$hf{$r[0]} = $r[1];
			}
            DeleteOf(\@dt, 0, 1);
		}

		#7 is Exists valign ?
		unless($dt[0][0] eq '/'){
			my @wk = @{$dt[0]};
			for(my $i = 0; $i < @wk; $i++){
				my @r = CutOff(':', $wk[$i]);
				my $v = LeftStr(lc(@r[1]), 1);
				my $s = 'center';
				$s = 'top'    if(PosStr($v, '0t'));
				$s = 'center' if(PosStr($v, '1c'));
				$s = 'bottom' if(PosStr($v, '2b'));
				$hv{$r[0]} = $s;
			}
			DeleteOf(\@dt, 0, 1);
		}

		# Omit by EndMark
		for(my $i = 0; $i < @dt; $i++){
			if($dt[$i][0] eq '/'){
				DeleteOf(\@dt, 0, $i + 1);
				last;
			}
		}
	}else{
		# Default Format
		for(my $i = 0; $i < @dt; $i++){
			push(@cl, 'white');
			push(@al, 'center');
		}
	}

	# <TABLE>
	push(@tb, "<TABLE $tb>");
		my ($s, $wf, $hf, $ln, $mx, $cc, $fc, $al, $vl, $td);
		push(@tb, "\t<CAPTION>$tt</CAPTION>")if($tt);

		# Inspection<TABLE><THEAD>
		for(my $i = 0; $i < @dt; $i++){
			$ln = @{$dt[$i]};
			$mx = $ln if($ln > $mx);
			if($i == 0){
				# Inspection<THEAD>
				for(my $j = 0; $j < @{$dt[$i]}; $j++){
					$s .= $dt[$i][$j];
				}
			}
		}
		$hf = ($s) ? 1 : 0;
		DeleteOf(\@dt, 0, 1) unless($hf);

		# <THEAD>
		if($hf){
			push(@tb, "\t<THEAD>");
				$ln = @{$dt[0]};
				$wf = 1 if($ln > 1);

				if(exists($hv{0})){
					$vl = $hv{0};
				}else{
					$vl = 'center';
				}
				push(@tb, "\t\t<TR valign='$vl'>");
					for(my $j = 0; $j < $ln; $j++){
						$s = Return2br($dt[0][$j]);

						if(exists($hc{0})){
							$cc = $hc{0};
						}else{
							$cc = ($cl[$j]) ? $cl[$j] : 'white';
						}

						if(exists($hf{0})){
							$fc = $hf{0};
						}else{
							$fc = ($fc[$j]) ? $fc[$j] : 'black';
						}

						$td = $d3."bgcolor=$cc ";
						if($ln == 1){
							$td .=  "colspan=$mx align=center width=$mw";
						}else{
							$td .=  "align=$al[$j] width=$wd[$j]";
						}

						if($fc && index($s, '<FONT') < 0){
							$s = "<FONT color=$fc>$s</FONT>";
						}
						push(@tb, "\t\t\t<TH $td>$s</TH>");
					}
				push(@tb, "\t\t</TR>");
			push(@tb, "\t</THEAD>");
		}

		# <TFOOT>
		if($ft){
			$cc = '#EEEEEE';
			my @wk = CutOff(':', $ft);
			$ft = $wk[0]if($wk[0] ne '');
			$cc = $wk[1]if($wk[1] ne '');
			$al = $wk[2]if($wk[2] ne '');
			if($al){
				$al = LeftStr(lc($al), 1);
				$al = 'left'  if(PosStr($al, '0l'));
				$al = 'center'if(PosStr($al, '1c'));
				$al = 'right' if(PosStr($al, '2r'));
			}
			$al = 'right' unless($al);
			push(@tb, "\t<TFOOT>");
				push(@tb, "\t\t<TR valign='center'>");
					$td = $d3."align='$al' colspan=$mx bgcolor=$cc";
					push(@tb, "\t\t\t<TD $td>$ft</TD>");
				push(@tb, "\t\t</TR>");
			push(@tb, "\t</TFOOT>");
		}

		# <TBODY>
		push(@tb, "\t<TBODY>");
			for(my $i = $hf; $i < @dt; $i++){
				if(exists($hv{$i})){
					$vl = $hv{$i};
				}elsif(exists($hv{'?'})){
					$vl = $hv{'?'};
				}else{
					$vl = 'center';
				}
				push(@tb, "\t\t<TR valign='$vl'>");
					$ln = @{$dt[$i]};
					for(my $j = 0; $j < $mx; $j++){
						$s = Return2br($dt[$i][$j]);
						my $fg = ($i - $hf) % 2;

						if(exists $hc{$i}){
							$cc = $hc{$i};
						}else{
							if($fg && exists($hc{'%'})){
								$cc = $hc{'%'};
							}elsif(exists($hc{'?'})){
								$cc = $hc{'?'};
							}else{
								$cc = ($cl[$j]) ? $cl[$j] : 'white';
							}
						}

						if(exists $hf{$i}){
							$fc = $hf{$i};
						}else{
							if($fg && exists($hc{'%'})){
								$fc = $hf{'%'};
							}elsif(exists($hc{'?'})){
								$fc = $hf{'?'};
							}else{
								$fc = ($fc[$j]) ? $fc[$j] : 'black';
							}
						}

						$td = $d3."bgcolor=$cc align=$al[$j] ";
						if($ln == 1){
							last if($j > 0);
							$td .=  "colspan=$mx width=$mw";
						}else{
							$td .= "width=$wd[$j]"unless($wf);
						}

						if($fc && index($s, '<FONT') < 0){
							$s = "<FONT color=$fc>$s</FONT>";
						}
						push(@tb, "\t\t\t<TD $td>$s</TD>");
					}
				push(@tb, "\t\t</TR>");
			}
		push(@tb, "\t</TBODY>");

	push(@tb, "</TABLE>");

	return(@tb);
}


;#==============================================================================
;# フォームデータ送信関数
;# InpGroup(), InpMemo() は単独でも使用可
;# 後は、データ送信以外ではあまり意味がない
;#==============================================================================


# CSS_FEP内部関数
# ($fep) = 0:IME使用不可・英数字入力モード
#          1:IMEオフ・英数字入力モード
#          2:IMEオン・日本語入力モード
# ($css) = 追加のスタイルシートがあれば追加
sub fep_{
	my ($fep, $css) = @_;
	my $ret = '';
	if($fep ne ''){
		my @fp = ('disabled', 'inactive', 'active');
		$css = ($css) ? "; $css" : '';
		$fep = MinMax($fep, 0, 2);
		$ret = ' style="ime-mode: '.$fp[$fep].$css.'"';
	}else{
		$ret = ($css) ? ' style="'.$css.'"' : '';
	}
	return($ret);
}

#                    #
# 送信以外にも使える #
#                    #

# グループタグ(終了タグあり)
# ($txt) =タイトル
# ($sty) = スタイルシート
sub InpGroup{
	my ($txt, $aln, $sty) = @_;
	if($txt.$aln eq ''){
		return('</FIELDSET>');
	}else{
		my @al = ('left', 'center', 'right');
		$aln = MinMax($aln, 0, 2);
		$aln = $al[$aln];#if($aln eq '');
		$sty = fep_(0, $sty);
		return("<FIELDSET$sty><LEGEND align='$aln'>$txt</LEGEND>");
	}
}

# テキストエリア(終了タグなし)
# ($nam) = name属性(部品に名前を付ける)
# ($col) = 横幅(pix)
# ($row) = 縦幅(行数)
# ($txt) = 初期値(文字)
# ($fep) = 0:IME使用不可・英数字入力モード
#          1:IMEオフ・英数字入力モード
#          2:IMEオン・日本語入力モード
# ($rsw) = 読取専用(文字)
# ($sty) = スタイルシート
sub InpMemo{
	my ($nam, $col, $row, $txt, $fep, $rsw, $sty) = @_;

	return('')unless($nam && $col && $row);
	$sty = fep_($fep, $sty);
	$rsw = ($rsw) ? ' readonly' : '';
	my $ret = "<TEXTAREA name=$nam cols=$col rows=$row wrap='soft'$rsw$sty>$txt</TEXTAREA>";

	return($ret);
}

#                #
# 送信のみに使う #
#                #

# 送信タグ(終了タグあり)
# ($cgi) = 送信するCGIファイル
# ($tgt) = (_self, _top, _parent, _blank, フレーム名)
# ($sty) = スタイルシート
sub InpForm{
	my ($cgi, $tgt, $sty) = @_;
	my $ret;
	if($cgi.$sty eq ''){
		$ret = '</FORM>';
	}else{
		$tgt = ($tgt eq '') ? '_self' : '';
		$sty = ($sty) ? ' style="'.$sty.'"' : '';
		$ret = "<FORM action='$cgi' target='$tgt' method='POST'$sty>";
	}
	return($ret);
}

# 入力欄(終了タグなし)
# ($typ) = 1:type=text, 2:type=password
# ($nam) = name属性(部品に名前を付ける)
# ($siz) = size属性(横幅の設定)
# ($max) = 入力制限の最大文字数
# ($txt) = デフォルト入力の文字
# ($fep) = 0:IME使用不可・英数字入力モード
#          1:IMEオフ・英数字入力モード
#          2:IMEオン・日本語入力モード
# ($sty) = スタイルシート
sub InpText{
	my ($typ, $nam, $siz, $max, $txt, $fep, $sty) = @_;
	return('')unless($typ && $nam && $siz);

	my @tp = ('text', 'password');
	$typ = MinMax($typ, 1, 2) - 1;
	$txt = ($txt) ? " value='$txt'" : " value=''";

	$sty = fep_($fep, $sty);
	$siz = ($siz) ? "size='$siz'" : '';
	$max = ($max) ? " maxlength='$max'" : '';
	my $ret = "<INPUT type='$tp[$typ]' name='$nam' $siz$max$txt$sty>";
	return($ret);
}

# チェック + Hidden(終了タグなし)
# ($typ) = 0:type=radio, 1:type=checkbox, 2:type=hidden
# ($nam) = name属性(部品に名前を付ける)
# ($val) = value属性(初期値の設定)
# ($chk) = チェックＯＮ
# ($ptr) = HandPointer
# ($sty) = スタイルシート
sub InpCheck{
	my ($typ, $nam, $val, $chk, $ptr, $sty) = @_;
	return('')unless($nam && $val);

	$typ = MinMax($typ, 0, 2);
	my @tp = ('radio', 'checkbox', 'hidden');
	if($typ < 2){
		$chk = ($chk) ? ' checked' : '';
		$sty .= ($ptr) ? ' cursor: pointer' : '';
	}
	$sty = fep_(0, Trim($sty));
	my $ret = "<INPUT type='$tp[$typ]' name='$nam' value='$val'$chk$sty>";
	return($ret);
}

# ボタン(終了タグなし)
# ($typ) = 1:type=file, 2:type=submit, 3:type=reset
# ($val) = valu属性(初期値の設定)
# ($siz) = size属性(横幅の設定)
# ($ptr) = HandPointer
# ($sty) = スタイルシート
sub InpButton{
	my ($typ, $val, $siz, $ptr, $sty) = @_;
	return('')unless($typ && $val && $siz);

	my $ret;
	$typ = MinMax($typ, 1, 3) - 1;
	my @tp = ('file', 'submit', 'reset');
	$sty .= ($ptr) ? ' cursor: pointer' : '';
	$sty = fep_(0, Trim($sty));
	if ($typ <= 2){
		$ret = "<INPUT type='$tp[$typ]' value='$val'$ptr$sty>";
	}else{
		$ret = "<INPUT type='$tp[$typ]' name='$val' size='$siz'$sty>";
	}
	return($ret);
}

# 画像ボタン(終了タグなし)
# ($nam) = name属性(部品に名前を付ける)
# ($alt) = alt属性(代替テキスト指定)
# ($img) = src属性(表示する画像)
# ($ptr) = HandPointer
# ($sty) = スタイルシート
sub InpImage{
	my ($nam, $alt, $img, $ptr, $sty) = @_;
	return('')unless($img && $nam && $alt);
	$sty .= ($ptr) ? ' cursor: pointer' : '';
	$sty = fep_(0, Trim($sty));
	my $ret = "<INPUT type='image' name='$nam' src='$img' alt='$alt'$sty>";
	return($ret);
}

# セレクト(終了タグなし)
# ($typ) = 1:multiple
# ($nam) = name属性(部品に名前を付ける)
# ($siz) = size属性(0:ComboBox, else:ListBox)
# ($ptr) = HandPointer
# ($sty) = スタイルシート
# (@dat) = @(['value', 'text', 'selected'])
sub InpSelect{
	my ($typ, $nam, $siz, $ptr, $sty, @dat) = @_;
	return('')unless($nam);

	my @ret;
	$typ = ($typ) ? ' multiple' : '';
	$siz = ($siz ne '') ? " size='$siz'" : '';
	$sty .= ($ptr) ? ' cursor: pointer' : '';
	$sty = fep_(0, $sty);
	push(@ret, "<SELECT name='$nam'$siz$typ$sty>");
	for(my $i = 0; $i < @dat; $i++){
		my $sel = ($dat[$i][2]) ? ' selected' : '';
		push(@ret, "<OPTION value='$dat[$i][0]'$sel>$dat[$i][1]</OPTION>");
	}
	push(@ret, '</SELECT>');
	return(@ret);
}

## K2/LIB::PERL LIBRARY++ ------------------------------------------------------
1;                                                      ## Presented by Dr.k2 ##
## EOF -------------------------------------------------------------------------