iwtmschecklist.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 IWTMSCheckList;

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, SysUtils, IWCompButton, IWFont,
  IWCompEdit, IWCompLabel, IWCompCheckbox, IWExtCtrls, IWHTMLTag, IWCompListbox,
  IWTMSBase
  {$IFDEF TMSIW6}
  , IWRenderContext, IWColor
  {$ENDIF}
  ;

type

  TTIWGradientDirection = (gdHorizontal, gdVertical);
  TTIWHelpTypes = (htNone, htLabel, htHint);

  TTIWCheckList = class(TIWCustomEdit)
  private
    FBorderWidth: Integer;
    FColor: TColor;
    FPopUpColor: TColor;
    FPopUpColorTo: TColor;
    FPopUpColorGradientDirection: TTIWGradientDirection;
    FPopUpHeight: Integer;
    FPopUpWidth: Integer;
    FBorderColor: TColor;
    FFlat: Boolean;
    FAlignment: TAlignment;
    FFocusColor: TColor;
    FSelectAll: Boolean;
    FAdvanceOnReturn: Boolean;
    FSubmitOnReturn: Boolean;
    FList: TStringList;
    FSelected: TList;
    FCheckAllBox: bool;
    FCheckAllHelp: TTIWHelpTypes;
    FCheckAllText: string;
    FUnCheckAllText: string;    
    FDropDownFont: TIWFont;
    procedure SetBorderColor(const Value: TColor);
    procedure SetBorderWidth(const Value: Integer);
    procedure SetColor(const Value: TColor);
    procedure SetFlat(const Value: Boolean);
    procedure SetAlignment(const Value: TAlignment);
    procedure SetList(const Value: TStringList);
    function GetSelected(i: integer): boolean;
    procedure SetSelected(i: Integer; value: boolean);
    procedure SetDropDownFont(const Value: TIWFont);
  protected
    function HTMLClr(color: TColor): string;
    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;
    property Selected[i: Integer]: boolean read GetSelected write SetSelected;
    property Text;
  published
    property AdvanceOnReturn: Boolean read FAdvanceOnReturn write FAdvanceOnReturn;
    property Alignment: TAlignment read FAlignment write SetAlignment;
    property BorderColor: TColor read FBorderColor write SetBorderColor;
    property BorderWidth: Integer read FBorderWidth write SetBorderWidth;
    property Color: TColor read FColor write SetColor;
    property DropDownFont: TIWFont read FDropDownFont write SetDropDownFont;
    property PopUpColor: TColor read FPopUpColor write FPopUpColor;
    property PopUpColorTo: TColor read FPopUpColorTo write FPopUpColorTo;
    property PopUpColorGradientDirection: TTIWGradientDirection read FPopUpColorGradientDirection write FPopUpColorGradientDirection;
    property PopUpHeight: Integer read FPopUpHeight write FPopUpHeight;
    property PopUpWidth: Integer read FPopUpWidth write FPopUpWidth;
    property FocusColor: TColor read FFocusColor write FFocusColor;
    property Flat: Boolean read FFlat write SetFlat;
    property Items: TStringList read FList write SetList;
    property SelectAll: Boolean read FSelectAll write FSelectAll;
    property SubmitOnReturn: Boolean read FSubmitOnReturn write FSubmitOnReturn;
    property CheckAllBox: bool read FCheckAllBox write FCheckAllBox;
    property CheckAllHelp: TTIWHelpTypes read FCheckAllHelp write FCheckAllHelp;
    property CheckAllText: string read FCheckAllText write FCheckAllText;
    property UnCheckAllText: string read FUnCheckAllText write FUnCheckAllText;    
  end;


  TTIWCheckListBox = class(TIWCustomEdit)
  private
    FBorderWidth: Integer;
    FBGColorTo: TColor;
    FBGColorGradientDirection: TTIWGradientDirection;
    FBorderColor: TColor;
    FList: TStringList;
    FSelected: TList;
    FCheckAllBox: bool;
    FCheckAllHelp: TTIWHelpTypes;
    FCheckAllText: string;
    FUnCheckAllText: string;
    
    procedure SetBorderColor(const Value: TColor);
    procedure SetBorderWidth(const Value: Integer);
    procedure SetList(const Value: TStringList);
    function GetSelected(i: integer): boolean;
    procedure SetSelected(i: Integer; value: boolean);
  protected
    function HTMLClr(color: TColor): string;
    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;
    property Selected[i: Integer]: boolean read GetSelected write SetSelected;
    property Text;
  published
    property BorderColor: TColor read FBorderColor write SetBorderColor;
    property BorderWidth: Integer read FBorderWidth write SetBorderWidth;
    property BGColorTo: TColor read FBGColorTo write FBGColorTo;
    property BGColorGradientDirection: TTIWGradientDirection read FBGColorGradientDirection write FBGColorGradientDirection;
    property Items: TStringList read FList write SetList;
    property CheckAllBox: bool read FCheckAllBox write FCheckAllBox;
    property CheckAllHelp: TTIWHelpTypes read FCheckAllHelp write FCheckAllHelp;
    property CheckAllText: string read FCheckAllText write FCheckAllText;
    property UnCheckAllText: string read FUnCheckAllText write FUnCheckAllText;    
  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;






{ TTIWCheckList }

constructor TTIWCheckList.Create(AOwner: TComponent);
begin
  inherited;
  FBorderWidth := 1;
  FBorderColor := clBlack;
  FColor := clWhite;
  FFocusColor := clWhite;
  {$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;
  FPopUpColor := clWhite;
  FPopupColorTo := clNone;
  Text := '';

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

  Font.FontName := 'Arial';
  Font.Size := 10;
  FDropDownFont := TIWFont.Create;
end;

destructor TTIWCheckList.Destroy;
begin
  FList.Free;
  FSelected.Free;
  FDropDownFont.Free;
  inherited;
end;

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

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

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

{$IFDEF TMSIW6}
procedure TTIWCheckList.IWPaint;
{$ELSE}
procedure TTIWCheckList.Paint;
{$ENDIF}
var
  R: TRect;
begin
  if not FFlat then
  begin
    Canvas.Font.Assign(Self.Font);
    Canvas.Brush.Color := Color;
    Canvas.Pen.Color := BorderColor;
    Canvas.Pen.Width := BorderWidth;
    Draw3DCtrl(Canvas,0, 0, Width - 18, Height - 1);
    R := Rect(2, 2, Width - 2, Height - 2);
  end
  else
  begin
    Canvas.Font.Assign(Self.Font);
    Canvas.Brush.Color := Color;
    Canvas.Pen.Color := BorderColor;
    Canvas.Pen.Width := BorderWidth;
    R := Rect(2, 2, Width - 19, Height - 2);
    Canvas.Rectangle(R);
  end;

  R := rect(width-18,2,width,20);
  {$IFNDEF LINUX}
  DrawFrameControl(Canvas.Handle,r,DFC_SCROLL,DFCS_SCROLLDOWN);
  {$ENDIF}

  R := Rect(2, 2, Width - 20, Height - 2);

  InflateRect(R,-1,-1);
  {$IFNDEF LINUX}
  SetBKMode(Canvas.Handle,TRANSPARENT);
  case Alignment of
  taLeftJustify: DrawText(Canvas.Handle,PChar(Text),Length(Text),R,DT_LEFT);
  taRightJustify: DrawText(Canvas.Handle,PChar(Text),Length(Text),R,DT_RIGHT);
  taCenter: DrawText(Canvas.Handle,PChar(Text),Length(Text),R,DT_CENTER);
  end;
  {$ENDIF}
end;


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

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

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