{***************************************************************************}
{ TMS IntraWeb Component Pack Pro                                           }
{ for Delphi & C++Builder                                                   }
{                                                                           }
{ written by TMS Software                                                   }
{            copyright © 2002 - 2007                                        }
{            Email : info@tmssoftware.com                                   }
{            Web : http://www.tmssoftware.com                               }
{                                                                           }
{ The source code is given as is. The author is not responsible             }
{ for any possible damage done due to the use of this code.                 }
{ The component can be freely used in any application. The complete         }
{ source code remains property of the author and may not be distributed,    }
{ published, given or sold in any form as such. No parts of the source      }
{ code can be included in any other component or application without        }
{ written authorization of the author.                                      }
{***************************************************************************}

unit IWTMSTextAreaLimiter;

interface                               

{$I TMSDEFS.INC}

uses
  {$IFDEF LINUX}
  QControls, QGraphics, QIWPicCntnr, QForms,
  {$ELSE}
  Windows, Graphics, Controls, IWPicCntnr, Forms,
  {$ENDIF}
  {$IFDEF DELPHI6_LVL}
  Types, StrUtils,
  {$ENDIF}
  Classes,
  IWControl, IWTypes, SysUtils, IWCompButton,
  IWCompEdit, IWCompLabel, IWCompCheckbox, IWExtCtrls, IWHTMLTag, IWCompListbox,
  IWTMSBase
  {$IFDEF TMSIW6}
  , IWRenderContext, IWColor
  {$ENDIF}
  ;

type

  TTIWLabelPosition = (lpTopLeft, lpTopRight, lpBottomLeft, lpBottomRight);

  TTIWTextAreaLimiter = class(TIWCustomEdit)
  private
    FBorderWidth: Integer;
    FCharacterLimit: Integer;
    FLabelText: String;
    FLabelPosition: TTIWLabelPosition;
    FColor: TColor;
    FBorderColor: TColor;
    FAdvanceOnReturn: Boolean;
    FSubmitOnReturn: Boolean;
    procedure SetBorderColor(const Value: TColor);
    procedure SetBorderWidth(const Value: Integer);
    procedure SetColor(const Value: TColor);
  protected
    function HTMLClr(color: TColor): string;
    {$IFDEF TMSIW72_NEW}
    function get_ShouldRenderTabOrder: Boolean; override;
    {$ENDIF}
  public
    {$IFDEF TMSIW72}
    function get_HasTabOrder: boolean; override;
    {$ENDIF}
    {$IFDEF TMSIW6}
    procedure IWPaint; override;
    function RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag; override;
    {$ELSE}
    procedure Paint; override;
    function RenderHTML: TIWHTMLTag; override;
    {$ENDIF}
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property AdvanceOnReturn: Boolean read FAdvanceOnReturn write FAdvanceOnReturn;
    property BorderColor: TColor read FBorderColor write SetBorderColor;
    property BorderWidth: Integer read FBorderWidth write SetBorderWidth;
    property CharacterLimit: Integer read FCharacterLimit write FCharacterLimit;
    property Color: TColor read FColor write SetColor;
    property LabelText: String read FLabelText write FLabelText;
    property LabelPosition: TTIWLabelPosition read FLabelPosition write FLabelPosition;
    property SubmitOnReturn: Boolean read FSubmitOnReturn write FSubmitOnReturn;
    property Text;
  end;



implementation

uses
  {$IFDEF LINUX}
  QImgList,
  {$ELSE}
  ImgList, ShellAPI, CommCtrl,
  {$ENDIF}
  IWApplication, IWServerControllerBase,
  SWStrings, SWSystem, IWAppForm;

procedure Draw3DCtrl(FCanvas: TCanvas; Left,Top,Right,Bottom: Integer);
begin
  with FCanvas do
  begin
    Pen.Color := clBlack;
    MoveTo(Left,Bottom);
    LineTo(Left,Top);
    LineTo(Right,Top);

    Pen.Color := clSilver;
    LineTo(Right,Bottom);
    LineTo(Left,Bottom);

    Pen.Color := clGray;
    LineTo(Left + 1,Bottom);
    LineTo(Left + 1,Top + 1);
    LineTo(Right - 1,Top + 1);
    Pen.Color := Brush.Color;
    Rectangle(Left+1,Top+1,Right-1,Bottom-1);
  end;
end;


{ TTIWTextAreaLimiter }

constructor TTIWTextAreaLimiter.Create(AOwner: TComponent);
begin
  inherited;
  FBorderWidth := 1;
  FBorderColor := clBlack;
  FColor := clWhite;
  {$IFDEF TMSIW6}
  SetRenderSize(True);
  {$ELSE}
  FRenderSize := True;
  {$ENDIF}
  FNeedsFormTag := True;

  {$IFDEF TMSIW6}
  {TODO}
  {$ELSE}
  FSupportedScriptEvents := 'OnChange,OnSelect';
  //FSupportsInput := true;
  //FSupportsSubmit := true;
  {$ENDIF}

  Text := '';

  Font.FontName := 'Arial';
  Font.Size := 12;

  CharacterLimit := 300;
  LabelText := '';
  LabelPosition := lpTopLeft;
end;

destructor TTIWTextAreaLimiter.Destroy;
begin
  inherited;
end;



{$IFDEF TMSIW6}
procedure TTIWTextAreaLimiter.IWPaint;
{$ELSE}
procedure TTIWTextAreaLimiter.Paint;
{$ENDIF}
var
  R: TRect;
begin

    Canvas.Font.Assign(Self.Font);
    Canvas.Brush.Color := Color;
    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 TTIWTextAreaLimiter.HTMLClr(color: TColor):string;
begin
  Result := ColorToRGBString(color);
end;

{$IFDEF TMSIW72}
function TTIWTextAreaLimiter.get_HasTabOrder: Boolean;
begin
  {$IFDEF TMSIW72_NEW}
  Result := true;
  {$ELSE}
  Result := false;
  {$ENDIF}
end;
{$ENDIF}

{$IFDEF TMSIW72_NEW}
function TTIWTextAreaLimiter.get_ShouldRenderTabOrder: boolean;
begin
  Result := false;
end;
{$ENDIF}



{$IFDEF TMSIW6}
function TTIWTextAreaLimiter.RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag;
{$ELSE}
function TTIWTextAreaLimiter.RenderHTML: TIWHTMLTag;
{$ENDIF}
var
  htmlres: string;
  myLabel, labelVal, labelAlign: string;
  tabidx: string;
  focusColorStr : string;
  blurColorStr : string;

  function MakeScript(Name:string): string;
  begin
    Result :=
      '<Script Language="JavaScript">'#13 +
			'function '+HTMLName+'textCounter(field, maxlimit) { '#13 +
			'  if (field.value.length > maxlimit){ '#13 +
			'    field.value = field.value.substring(0, maxlimit); '#13 +
			'  }else  {'#13 +
      '   var  countfield = document.getElementById("'+HTMLName+'remLen"); ' +
			'    countfield.value = parseInt(maxlimit) - parseInt(field.value.length); '#13;

 			//if ( AnsiContainsStr(LabelText,'(%0)') ) then
      if ( Pos('(%0)',LabelText) > 0 ) then
        Result := Result + 'document.getElementById("'+HTMLName+'availchars").innerHTML = countfield.value; '#13;

    	//if ( AnsiContainsStr(LabelText,'(%2)') ) then
      if ( Pos('(%2)',LabelText) > 0 ) then
        Result := Result + 'document.getElementById("'+HTMLName+'usedchars").innerHTML = maxlimit - countfield.value; '#13;

      Result := Result
        + ' }'
        + '}'
        + '</Script>';
  end;

begin
  tabidx := '';
  {$IFDEF TMSIW72_NEW}
  if (TabOrder >= 0) then
    tabidx := ' tabindex="'+IntToStr(TabOrder+1)+'" ';
  {$ENDIF}

 	myLabel := LabelText;

	myLabel := StringReplace(myLabel, '(%0)','<span id="'+HTMLName+'availchars">'
		+ IntToStr(CharacterLimit) + '</span>', [rfReplaceAll, rfIgnoreCase]);
	myLabel := StringReplace(myLabel, '(%1)','<span id="'+HTMLName+'maxchars">'
		+ IntToStr(CharacterLimit) + '</span>', [rfReplaceAll, rfIgnoreCase]);
	myLabel := StringReplace(myLabel, '(%2)','<span id="'+HTMLName+'usedchars">'
		+ IntToStr(CharacterLimit) + '</span>', [rfReplaceAll, rfIgnoreCase]);

  htmlres := MakeScript(HTMLName)
     + '<input readonly type=hidden id='+HTMLName+'remLen size=3 maxlength=3 value="'	+ IntToStr(CharacterLimit) +'">';

  labelAlign := 'left';
  if ( (LabelPosition = lpBottomRight) or (LabelPosition = lpTopRight) ) then
    labelAlign := 'right';


  LabelVal := '<span style="width:'+IntToStr(width)+';text-align:'
 		+ LabelAlign+';">'
   	+ myLabel + '</span>';

  if ( (LabelPosition = lpTopLeft) or (LabelPosition = lpTopRight) ) then
    htmlres := htmlres + LabelVal + '<br>';

   {$IFDEF TMSIW9}
   if FocusColor = clNone then
    begin
      focusColorStr := '';
      blurColorStr := '';
    end
    else
    begin
      focusColorStr := 'this.style.backgroundColor='''+HTMLClr(FocusColor)+''';';

      if BGColor = clNone then
        blurColorStr := 'this.style.backgroundColor=''#FFFFFF'';'
      else
        blurColorStr := 'this.style.backgroundColor='''+HTMLClr(BGColor)+''';';
    end;
    {$ENDIF}

    if Editable then
    begin

  htmlres := htmlres
		+ '<textarea' + tabidx+' id="'+HTMLName+'id" name="' + HTMLName + '" style="font:'+IntToStr(font.Size)+'pt '
    + font.FontName+';color:' + ColorToRGBString(font.Color) + ';width:'+inttostr(width)+'px;height:'+inttostr(height)+'px;"'
    + ' onKeyDown="'+HTMLName+'textCounter(this, '+IntToStr(CharacterLimit)+');" onKeyUp="'
    + HTMLName+'textCounter(this,'+IntToStr(CharacterLimit)+');"';

    {$IFDEF TMSIW9}
    if FocusColor <> clNone then
      htmlres := htmlres + ' onFocus="' + focusColorStr + '"; onBlur="' + blurColorStr + '"';
    {$ENDIF}

  if ReadOnly then
    htmlres := htmlres + ' readonly ';

  htmlres := htmlres
    +'>' + Text + '</textarea>';
    end
    else
    begin
      htmlres := htmlres + '<span style="font:'+IntToStr(font.Size)+' '
        + font.FontName+';">' + Text + '</span>'
    end;

  if ( (LabelPosition = lpBottomLeft) or (LabelPosition = lpBottomRight) ) then
    htmlres := htmlres + LabelVal + '<br>';

  htmlres := htmlres
    + #13 + '<script> '
		+ HTMLName+'textCounter(document.getElementById("'
		+ HTMLName+'id"),'+IntToStr(CharacterLimit)+') '
		+ '</script>'+ #13;

{
    if SupportsInput and Required then
    begin
      {$IFDEF TMSIW6}
 {     TIWComponent40Context(AContext).AddValidation('GSubmitter.' + HTMLName + '.value.length==0'
       , FriendlyName + ' is a required field.');
      {$ELSE}
  {    TIWAppForm(Owner).AddValidation('GSubmitter.' + HTMLName + '.value.length==0'
       , FriendlyName + ' is a required field.');
      {$ENDIF}
   { end;
    }
  Result := TIWHTMLTag.CreateTag('DIV');
  Result.Contents.AddText(htmlres);
end;



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

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

procedure TTIWTextAreaLimiter.SetColor(const Value: TColor);
begin
  FColor := Value;
  Invalidate;
end;




end.
