iwmulticolumncombobox.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 IWMultiColumnComboBox;

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, IWForm,
  IWCompEdit, IWCompLabel, IWCompCheckbox, IWExtCtrls, IWHTMLTag, IWCompListbox,
  IWTMSBase
  {$IFDEF TMSIW51}
  , IWColor
  {$ENDIF}
  {$IFDEF TMSIW6}
  , IWRenderContext
  {$ENDIF}
  {$IFDEF TMSIW7}
  , IWBaseHTMLControl
  {$ENDIF}
  ;

type

  TTIWGradientDirection = (gdHorizontal, gdVertical);

  TTIWMultiColumnComboBox = class;

  TTIWColumnTitles = class(TPersistent)
  private
    FBackColor: TIWColor;
    FTitles: TStrings;
    FVisible: boolean;
    FFont: TIWFont;
    procedure SetBackColor(const Value: TIWColor);
    procedure SetTitles(const Value: TStrings);
    procedure SetFont(const Value: TIWFont);
    procedure SetVisible(const Value: boolean);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property BackColor: TIWColor read FBackColor write SetBackColor;
    property Titles: TStrings read FTitles write SetTitles;
    property Visible: boolean read FVisible write SetVisible;
    property Font: TIWFont read FFont write SetFont;
  end;

  TTComboRow = class(TCollectionItem)
  private
    FVisible: Boolean;
    FRowData: TStringList;
    procedure SetRowData(const Value: TStringList);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
  published
    property RowData : TStringList read FRowData write SetRowData;
  end;

  TTComboRows = class(TCollection)
  private
    FOwner: TTIWMultiColumnComboBox;
    function GetItem(Index: Integer): TTComboRow;
    procedure SetItem(Index: Integer; const Value: TTComboRow);
  public
    constructor Create(AOwner: TTIWMultiColumnComboBox);
    function Add: TTComboRow;
    function Insert(Index: Integer): TTComboRow;
    property Items[Index: Integer]: TTComboRow read GetItem write SetItem; default;
    property IWColumnComboBox: TTIWMultiColumnComboBox read FOwner;
  end;


  TTIWMultiColumnComboBox = 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;
    FText: string;
    FColCount: Integer;
    FComboRows: TTComboRows;
    FSelectionColor: TColor;
    FSelectionTextColor: TColor;
    FCaseSensitiveLookUp: Boolean;
    FShowGridBorder: Boolean;
    FPopUpFont: TIWFont;
    FColumnTitles: TTIWColumnTitles;

    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 SetColcount(const Value: integer);
    function GetSelected(i: integer): boolean;
    procedure SetSelected(i: Integer; value: boolean);

    procedure SetColumnTitles(const Value: TTIWColumnTitles);
    procedure SetPopUpFont(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;
    function AddRow(a: string): string;
  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 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 default 0;
    property PopUpWidth: Integer read FPopUpWidth write FPopUpWidth default 0;
    property FocusColor: TColor read FFocusColor write FFocusColor;
    property Flat: Boolean read FFlat write SetFlat;
    property SelectAll: Boolean read FSelectAll write FSelectAll;
    property SubmitOnReturn: Boolean read FSubmitOnReturn write FSubmitOnReturn;
    property Text: string read FText write FText;
    property ColCount: integer read FColCount write SetColCount;
    property SelectionColor: TColor read FSelectionColor write FSelectionColor;
    property SelectionTextColor: TColor read FSelectionTextColor write FSelectionTextColor;
    property Items: TTComboRows read FComboRows write FComboRows;
    property CaseSensitiveLookUp: Boolean read FCaseSensitiveLookUp write FCaseSensitiveLookUp default false;
    property ShowGridBorder: Boolean read FShowGridBorder write FShowGridBorder default false;
    property PopUpFont: TIWFont read FPopUpFont write SetPopUpFont;
    property ColumnTitles: TTIWColumnTitles read FColumnTitles write SetColumnTitles;
  end;

procedure Register;

implementation

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

procedure Register;
begin
  RegisterComponents('TMS', [TTIWMultiColumnComboBox]);
end;

//------------------------------------------------------------------------------
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;

//------------------------------------------------------------------------------
//-----------------------------{ TTComboRow }-----------------------------------
//------------------------------------------------------------------------------
constructor TTComboRow.Create(Collection: TCollection);
begin
  inherited;
  FVisible:= true;
  FRowData:= TStringList.Create;
  //DisplayName:= FCaption;
end;

//------------------------------------------------------------------------------
procedure TTComboRow.SetRowData(const Value: TStringList);
begin
  FRowData.Assign(Value);
end;

//------------------------------------------------------------------------------
destructor TTComboRow.Destroy;
begin
  FRowData.Free;
  inherited;
end;

//------------------------------------------------------------------------------
//-----------------------------{ TTComboRows }----------------------------------
//------------------------------------------------------------------------------
constructor TTComboRows.Create(AOwner: TTIWMultiColumnComboBox);
begin
  inherited Create(TTComboRow);
  FOwner := AOwner;
end;

//------------------------------------------------------------------------------
function TTComboRows.GetItem(Index: Integer): TTComboRow;
begin
  Result := TTComboRow(inherited Items[Index]);
end;

//------------------------------------------------------------------------------
function TTComboRows.Add: TTComboRow;
begin
  Result := TTComboRow(inherited Add);
end;

//------------------------------------------------------------------------------
function TTComboRows.Insert(Index: Integer): TTComboRow;
begin
  Result := TTComboRow(inherited Insert(Index));
end;


//------------------------------------------------------------------------------
procedure TTComboRows.SetItem(Index: Integer; const Value: TTComboRow);
begin
  inherited Items[Index] := Value;
end;


//------------------------------------------------------------------------------
//--------------------------{ TTIWMultiColumnComboBox }-------------------------
//------------------------------------------------------------------------------
constructor TTIWMultiColumnComboBox.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;
  FPopUpColorGradientDirection := gdHorizontal;
  Text := '';

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

  FComboRows:= TTComboRows.Create(self);
  FSelectionColor:= clNavy;
  FSelectionTextColor:= clWhite;
 // FGridBorderColor:= clSilver;
  FCaseSensitiveLookUp:= false;
  FShowGridBorder:= false;
  FPopUpFont:= TIWFont.Create;
  FPopUpHeight:= 0;
  FPopUpWidth:= 0;

  FColumnTitles := TTIWColumnTitles.Create;
end;

//------------------------------------------------------------------------------
destructor TTIWMultiColumnComboBox.Destroy;
begin
  FComboRows.Free;
  FPopUpFont.Free;

  FList.Free;
  FSelected.Free;

  FColumnTitles.Free;
  inherited;
end;

//------------------------------------------------------------------------------
procedure TTIWMultiColumnComboBox.SetPopUpFont(const Value: TIWFont);
begin
  FPopUpFont:= Value;
end;

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

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

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

//------------------------------------------------------------------------------
function TTIWMultiColumnComboBox.AddRow(a: string): string;
var
  su: string;
  ttr: TTComboRow;
begin
  ttr := FComboRows.Add;

  while (pos(';',a) > 0) do
  begin
    su := copy(a,1,pos(';',a) - 1);
    ttr.RowData.Add(su);
    delete(a,1,pos(';',a));
  end;
  ttr.RowData.Add(a)
end;

//------------------------------------------------------------------------------