iwtmschecklist.pas

TMS IntraWEb增强控件TMSIntraWeb_v2.3.2.1_D2007.rar

end;

{ TTIWCheckListBox }

constructor TTIWCheckListBox.Create(AOwner: TComponent);
begin
  inherited;
  FBorderWidth := 1;
  FBorderColor := clBlack;
  {$IFDEF TMSIW6}
  SetRenderSize(True);
  {$ELSE}
  FRenderSize := True;
  {$ENDIF}
  FNeedsFormTag := True;
  {$IFDEF TMSIW6}
  {TODO}
  {$ELSE}
  FSupportedScriptEvents := 'OnChange,OnSelect';
  FSupportsInput := true;
  FSupportsSubmit := true;
  {$ENDIF}

  FList := TStringList.Create;
  FSelected := TList.Create;
  FBGColor := clWhite;
  FBGColorTo := clNone;
  Text := '';

  FCheckAllBox := false;
  FCheckAllHelp := htNone;
  FCheckAllText := 'Check All';
  FUnCheckAllText := 'UnCheck All';

  Font.FontName := 'Arial';
  Font.Size := 10;
end;

destructor TTIWCheckListBox.Destroy;
begin
  FList.Free;
  FSelected.Free;
  inherited;
end;

procedure TTIWCheckListBox.SetSelected(i: Integer; value: boolean);
begin
  while (i >= FSelected.Count) do
    FSelected.Add(TObject(false));

  FSelected.Items[i] := TObject(value);
end;

function TTIWCheckListBox.GetSelected(i: Integer): boolean;
begin
  if (i < FSelected.Count) then
    Result := boolean(FSelected.Items[i])
  else
    Result := False;
end;

{$IFDEF TMSIW6}
procedure TTIWCheckListBox.IWPaint;
{$ELSE}
procedure TTIWCheckListBox.Paint;
{$ENDIF}
var
  R: TRect;
begin
    Canvas.Font.Assign(Self.Font);
    Canvas.Brush.Color := clWhite;
    Canvas.Pen.Color := BorderColor;
    Canvas.Pen.Width := BorderWidth;
    Draw3DCtrl(Canvas,0, 0, Width - 1, Height - 1);
    R := Rect(2, 2, Width - 2, Height - 2);


  InflateRect(R,-1,-1);
  {$IFNDEF LINUX}
  SetBKMode(Canvas.Handle,TRANSPARENT);
DrawText(Canvas.Handle,PChar(Text),Length(Text),R,DT_LEFT);

  {$ENDIF}
end;


function TTIWCheckListBox.HTMLClr(color: TColor):string;
begin
  Result := ColorToRGBString(color);
end;

procedure TTIWCheckListBox.SetValue(const value:string);
var
  s:string;
  i: Integer;
begin
  inherited SetValue(value);
  FSelected.Clear;

  s := ', ' + value + ',';

  for  i := 1 to FList.Count do
  begin
    if pos(', '+ flist.Strings[i - 1]+',',s) > 0 then
      Selected[i - 1] := true;
  end;
end;

{$IFDEF TMSIW6}
function TTIWCheckListBox.RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag;
{$ELSE}
function TTIWCheckListBox.RenderHTML: TIWHTMLTag;
{$ENDIF}
var
  htmlres: string;
  i: Integer;
  gradient, fontstyle: string;
  _sChkAll, _sUnChkAll, _hsChkAll, _hsUnChkAll, caScript, caLabeltext, caHinttext, scrollh: string;
  allchecked: string;
  redscroll: integer;


   function MakeAlign(AAlignment: TAlignment):string;
   begin
     Result := '';
     case AAlignment of
     taRightJustify: Result := ' style=text-align:right;';
     taCenter: Result := ' style=text-align:center;';
     end;
   end;

   function MakeScript(Name:string): string;
   begin
     Result :=
        '<Script Language="JavaScript">'#13

        + 'function '+HTMLName+'UpdateList(){'#13
        + '	var editor = document.getElementById("'+HTMLName+'ED");'#13
        + '	editor.value = "";'#13
        + '  for (i=0;i<'+IntToStr(FList.Count)+';i++){'#13
        + '	  boxid = "'+HTMLName+'box" + i;'#13
        + '	  if (document.getElementById(boxid).checked)'#13
        + '	   editor.value += document.getElementById(boxid).value + ", ";'#13
        + '  }'#13
        + '	editor.value = editor.value.substr(0,editor.value.length-2);'#13
        + '}'#13
         + '</Script>';
  end;

  function StripCRLF(s:string): string;
  begin
    while pos(#13,s) > 0 do
      delete(s,pos(#13,s),1);
    while pos(#10,s) > 0 do
      delete(s,pos(#10,s),1);
    Result := s;
  end;


begin

  allchecked := 'true';
  if FSelected.Count < Items.Count then
    allchecked := 'false';

	_sChkAll := '';
	_sUnChkAll := '';
	_hsChkAll := '';
	_hsUnChkAll := '';
  scrollh := IntToStr(Height);

	if ((CheckAllBox) and (CheckAllHelp = htLabel)) then
	begin
    _sChkAll := CheckAllText;
  	_sUnChkAll := UnCheckAllText;
 	end;

	if ((CheckAllBox) and (CheckAllHelp = htHint)) then
	begin
		_hsChkAll := CheckAllText;
		_hsUnChkAll := UnCheckAllText;
	end;

  		caScript := '<Script Language="JavaScript">'#13
				+ ' var '+HTMLName+'allchecked = '+allchecked+'; '#13
				+ ' function '+HTMLName+'UpdateList(){'#13
				+ '	var editor = document.getElementById("'+HTMLName+'ED");'#13
				+ '	editor.value = "";'#13
				+ '  for (i=0;i<'+IntToStr(Items.Count)+';i++){'#13
				+ '	  boxid = "'+HTMLName+'box" + i;'#13
				+ '	  if (document.getElementById(boxid).checked)'#13
				+ '	   editor.value += document.getElementById(boxid).value + ", ";'#13
				+ '  }'#13
				+ '	editor.value = editor.value.substr(0,editor.value.length-2);'#13
				+ '} '#13#13
				+ 'function '+HTMLName+'CheckAll(){'#13
				+ ' if ('+HTMLName+'allchecked){ '#13
				+ '   for (var i=0;i<'+IntToStr(Items.Count)+';i++){ '#13
				+ '	    boxid = "'+HTMLName+'box" + i;'#13
				+ '      document.getElementById(boxid).checked = false;  }'#13
				+ '   '+HTMLName+'allchecked = false; '#13
				+ '   document.getElementById("'+HTMLName+'labeltext").innerHTML = "'+_sChkAll+'"; '#13
				+ '   document.getElementById("'+HTMLName+'boxCA").title = "'+_hsChkAll+'"; '#13
				+ '   } else { '#13
				+ '   for (var i=0;i<'+IntToStr(Items.Count)+';i++){ '#13
				+ '	    boxid = "'+HTMLName+'box" + i;'#13
				+ '      document.getElementById(boxid).checked = true; }'#13
				+ '   document.getElementById("'+HTMLName+'labeltext").innerHTML = "'+_sUnChkAll+'"; '#13
				+ '   document.getElementById("'+HTMLName+'boxCA").title = "'+_hsUnChkAll+'"; '#13
				+ '   '+HTMLName+'allchecked = true; '#13
				+ '   } '#13
				+ ' '+HTMLName+'UpdateList(); '#13
				+ '} '#13
  			+ '</Script>'#13;

  if (BGColor <> clNone) and (BGColorTo <> clNone) then
    gradient := ' background:'+HTMLClr(FBGColor)+';FILTER: progid:DXImageTransform.Microsoft.Gradient(GradientType=' +
        IntToStr(1 - Integer(BGColorGradientDirection)) + ', StartColorStr='#39
        + HTMLClr(BGColor) + #39', EndColorStr='#39 + HTMLClr(BGColorTo) + #39');'
  else
    gradient := ' background:'+HTMLClr(FBGColor)+';';

     if (Font.FontVariant = '') then
     begin
       {$IFDEF TMSIW6}
       fontstyle := ' ' + Font.FontToStringStyle(AContext.WebApplication.Browser) + ';';
       {$ELSE}
       fontstyle := ' ' + Font.FontToStringStyle(WebApplication.Browser) + ';';
       {$ENDIF}
     end;

  htmlres :=  caScript + MakeScript(HTMLName);

		if ( (CheckAllBox) and (Items.Count > 0)) then
		begin
			redscroll := Height - 20;
			scrollh := IntToStr(redscroll);
		  caLabeltext := '';
			caHinttext := '';
			if (allchecked = 'false') then
			begin
				if (CheckAllHelp = htLabel) then
					caLabeltext := CheckAllText
				else if (CheckAllHelp = htHint) then
					caHinttext := CheckAllText;
			end
			else
			begin
				if (CheckAllHelp = htLabel) then
					caLabeltext := UnCheckAllText
				else if (CheckAllHelp = htHint) then
					caHinttext := UnCheckAllText;
			end;

    	htmlres := htmlres
      + '<div>'
			+ '<input type="checkbox" id="'+HTMLName+'boxCA" value="checkall" title="'+caHinttext+'"';

			if (allchecked = 'true') then
        htmlres := htmlres + ' checked ';

			htmlres := htmlres +
      '  onClick="'+HTMLName+'CheckAll();" > <span id="'+HTMLName+'labeltext">'+caLabeltext+' </span><br>'
			+ '</div>';
		end;

  htmlres := htmlres
     + '<style>.testmystyle {font-family:"Verdana";font-size:15pt}</style>'#13
     + '    <input type=hidden name="' + HTMLName +'"' + ' class="'+font.FontVariant+'" id="' + HTMLName +'ED"'
     + ' value="' + Text + '"'
     + '>'#13
     + '<div  class="'+font.FontVariant+'" id="'+HTMLName
     +'checklist" style="visibility:visible; position:absolute; '+gradient
     + 'border-color:'+HTMLClr(BorderColor)+';border-width:'+IntToStr(BorderWidth)+';border-style:solid;padding:2px;'
     + ' width:'+IntToStr(Width)+'px;'
     + ' height:'+IntToStr(Height)+'px;overflow:auto;'
     + fontstyle
     + '">';

    for i := 0 to Flist.Count-1 do
    begin
      htmlres := htmlres + '<input type="checkbox" id="'+HTMLName+'box'+IntToStr(i)+'" value="'
        + FList.Strings[i] + '"'
        + IIF(Selected[i],'CHECKED','')+ ' onClick="'+HTMLName+'UpdateList();"> '+ FList.Strings[i] + '<br>'#13;
    end;

      htmlres := htmlres
     + '</div>';



    {$IFDEF TMSIW6}
    TIWComponent40Context(AContext).AddToInitProc(HTMLName+'UpdateList();');
    {$ELSE}
    TIWAppForm(Form).AddToInitProc(HTMLName+'UpdateList();');
    {$ENDIF}



  Result := TIWHTMLTag.CreateTag('DIV');
  Result.Contents.AddText(htmlres);
end;


procedure TTIWCheckListBox.SetBorderColor(const Value: TColor);
begin
  FBorderColor := Value;
  Invalidate;
end;

procedure TTIWCheckListBox.SetBorderWidth(const Value: Integer);
begin
  FBorderWidth := Value;
  Invalidate;
end;


procedure TTIWCheckListBox.SetList(const Value: TStringList);
begin
  FList.Assign(Value);

end;



end.