iwtmscalculatinglabel.pas

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

{***************************************************************************}
{ TMS IntraWeb Component Pack Pro                                           }
{ for Delphi & C++Builder                                                   }
{ version 2.2                                                               }
{                                                                           }
{ written by TMS Software                                                   }
{            copyright ?2002 - 2004                                        }
{            Email : [e-mail]                                   }
{            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 IWTMSCalculatingLabel;

interface

{$I TMSDEFS.INC}

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

type

  TFormulaControlItem = class(TCollectionItem)
  private
    FToken: string;
    {$IFDEF TMSIW6}
    FControl: TIWCustomControl;
    {$ELSE}
    FControl: TIWControl;
    {$ENDIF}
  published
    {$IFDEF TMSIW6}
    property Control: TIWCustomControl read FControl write FControl;
    {$ELSE}
    property Control: TIWControl read FControl write FControl;
    {$ENDIF}
    property Token: string read FToken write FToken;
  end;

  TFormulaControls = class(TCollection)
  private
    function GetItem(Index: Integer): TFormulaControlItem;
    procedure SetItem(Index: Integer; const Value: TFormulaControlItem);
  public
    constructor Create;
    function Add: TFormulaControlItem;
    function Insert(Index: Integer): TFormulaControlItem;
    property Items[Index: Integer]: TFormulaControlItem read GetItem write SetItem; default;
  end;

  TTIWCalculatingLabel = class(TIWCustomEdit)
  private
    FText: String;
    FFormulaControls: TFormulaControls;
    FFormula: String;
   protected
    procedure SetValue(const value:string); override;
  public
    {$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 Text: String read FText write FText;
    property Formula: String read FFormula write FFormula;
    property FormulaControls: TFormulaControls read FFormulaControls write FFormulaControls;
  end;



implementation

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

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;


{ TTIWCalculatingLabel }

constructor TTIWCalculatingLabel.Create(AOwner: TComponent);
begin
  inherited;

  {$IFDEF TMSIW6}
  SetRenderSize(True);
  {$ELSE}
  FRenderSize := True;
  {$ENDIF}
  FNeedsFormTag := True;
  {$IFDEF TMSIW6}
  {TODO}
  {$ELSE}
  FSupportedScriptEvents := 'OnChange,OnSelect';
  FSupportsInput := true;
  FSupportsSubmit := true;
  {$ENDIF}

  BGColor := clWhite;

  Text := '';

  Font.FontName := 'Arial';
  Font.Size := 12;
  FFormulaControls := TFormulaControls.Create;

end;

destructor TTIWCalculatingLabel.Destroy;
begin
  FFormulaControls.Free;
  inherited;
end;



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

    Canvas.Font.Assign(Self.Font);
    Canvas.Brush.Color := BGColor;
    Canvas.Pen.Color := 1;
    Canvas.Pen.Width := 1;
    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;


procedure TTIWCalculatingLabel.SetValue(const value:string);
var
  s:string;
  //i: Integer;
begin
  inherited SetValue(value);

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

  s := '';

end;


{$IFDEF TMSIW6}
function TTIWCalculatingLabel.RenderHTML(AContext: TIWBaseComponentContext): TIWHTMLTag;
{$ELSE}
function TTIWCalculatingLabel.RenderHTML: TIWHTMLTag;
{$ENDIF}
var
  htmlres: string;
  i: Integer;
  ctN, ctCN, ctTN: string;


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

  end;

begin

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

     htmlres :=
     MakeScript(HTMLName)
      +' function '+HTMLName+'showresult(){'#13
 			+'	var formula = "'+Formula+'";'#13;

      for i:=1 to FormulaControls.Count do
      begin
        ctN := FormulaControls.Items[i - 1].Control.HTMLName;
        ctTN := FormulaControls.Items[i - 1].Token;

        htmlres := htmlres +'	formula = formula.replace("'+ctTN+'","'+ctN+'");'#13
      end;

      for i:=1 to FormulaControls.Count do
      begin
        ctCN := FormulaControls.Items[i - 1].Control.ClassName;
        ctN := FormulaControls.Items[i - 1].Control.HTMLName;

        htmlres := htmlres
        +' var '+ctN+' = "";'#13;

        if (ctCN = 'TIWEdit') then
    	    htmlres := htmlres +'	'+ctN+' = FindElem("'+ctN+'").value;'#13
//    		  htmlres := htmlres +'	'+ctN+' = document.getElementById("'+ctN+'").value;'#13
//    		  htmlres := htmlres +'	'+ctN+' = document.forms[0].'+UpperCase(ctN)+'.value;'#13
//    		  htmlres := htmlres +'	'+ctN+' = document.'+UpperCase(ctN)+'.value;'#13
        else if (ctCN = 'TTIWAdvEdit') then
        begin
//    		  htmlres := htmlres +'	 '+ctN+' = document.getElementById("'+ctN+'").firstChild.value;'#13
    		  htmlres := htmlres +'	 '+ctN+' = FindElem("'+ctN+'").value;'#13
        end
//    		  htmlres := htmlres +'	'+ctN+' = document.forms[0].'+UpperCase(ctN)+'.value;'#13
//    		  htmlres := htmlres +'	'+ctN+' = document.'+UpperCase(ctN)+'.value;'#13
        else if ((ctCN = 'TIWListbox') or (ctCN = 'TIWComboBox')) then
        begin
          htmlres := htmlres
//           +'   if (document.getElementById("'+ctN+'").options[document.getElementById("'+ctN+'").selectedIndex].value != -1)'#13
//    		   +'	   '+ctN+' = document.getElementById("'+ctN+'").options[document.getElementById("'+ctN+'").selectedIndex].text;'#13#13
//           +'   if (document.forms[0].'+UpperCase(ctN)+'.options[document.forms[0].'+UpperCase(ctN)+'.selectedIndex].value != -1)'#13
//    		   +'	   '+ctN+' = document.forms[0].'+UpperCase(ctN)+'.options[document.forms[0].'+UpperCase(ctN)+'.selectedIndex].text;'#13#13
           +'   if (FindElem("'+ctN+'").options[FindElem("'+ctN+'").selectedIndex].value != -1)'#13
    		   +'	   '+ctN+' = FindElem("'+ctN+'").options[FindElem("'+ctN+'").selectedIndex].text;'#13#13

        end;

        htmlres := htmlres
		  	  +' if (('+ctN+' == null) || ('+ctN+' == ""))'#13
			    +'		'+ctN+' = 0;'#13
			    +#13'	formula = formula.replace("'+ctN+'",'+ctN+');'#13#13#13;
      end;


      htmlres := htmlres
      +'	result = eval(formula);'#13
			+''#13
			+'	document.getElementById("'+HTMLName+'Result").innerHTML = result;'#13
			+'}'#13
      + '</Script>';


      htmlres := htmlres
       + '<span id="'+HTMLName+'Result" style="font-family:'+Font.FontName
       +';font-size:'+IntToStr(Font.Size)+';" class="'+Font.FontVariant+'">' + Text + '</span>'#13
       +' <script>'#13
       +' function calculate'+HTMLName+'(){'#13
			 +' '+HTMLName+'showresult();'#13;

      for i:=1 to FormulaControls.Count do
      begin
        ctCN := FormulaControls.Items[i - 1].Control.ClassName;
        ctN := FormulaControls.Items[i - 1].Control.HTMLName;

       //htmlres := htmlres +'  document.forms[0].'+UpperCase(ctN)+'.onchange = '+HTMLName+'showresult;'#13;
       //htmlres := htmlres +'  document.getElementById('+UpperCase(ctN)+').onchange = '+HTMLName+'showresult;'#13;
       htmlres := htmlres +'  FindElem("'+ctN+'").onchange = '+HTMLName+'showresult;'#13;

       end;

       htmlres := htmlres
       +'}'#13
       +' </script> '#13
       + '';

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





{ TFormulaControls }

function TFormulaControls.Add: TFormulaControlItem;
begin
  Result := TFormulaControlItem(inherited Add);
end;

constructor TFormulaControls.Create;
begin
  inherited Create(TFormulaControlItem);
end;

function TFormulaControls.GetItem(Index: Integer): TFormulaControlItem;
begin
  Result := TFormulaControlItem(inherited Items[Index]);
end;

function TFormulaControls.Insert(Index: Integer): TFormulaControlItem;
begin
  Result := TFormulaControlItem(inherited Insert(Index));
end;

procedure TFormulaControls.SetItem(Index: Integer;
  const Value: TFormulaControlItem);
begin
  inherited Items[Index] := Value;
end;

end.