tntjvcombobox.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvCombobox.PAS, released on 2001-02-28.

The Initial Developer of the Original Code is Sébastien Buysse [sbuysse att buypin dott com]
Portions created by Sébastien Buysse are Copyright (C) 2001 Sébastien Buysse.
All Rights Reserved.

Contributor(s): Michael Beck [mbeck att bigfoot dott com].

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvCombobox.pas,v 1.70 2005/12/25 16:38:10 ahuser Exp $

unit TntJvCombobox;

{$I jvcl.inc}
{$I vclonly.inc}

interface

{$I HintEditor.inc}

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Messages, Classes, TntClasses, Graphics, TntGraphics, Controls, TntControls, Forms, StdCtrls, TntStdCtrls, TntStdCtrls2, Menus, TntMenus,
  TntJvCheckListBox, TntJvExStdCtrls, JvCombobox,
  {$IFDEF CLR}
  Types,
  {$ENDIF !CLR}
  {$IFDEF COMPILER5}
  JvAutoComplete,
  {$ENDIF COMPILER5}
  JvJVCLUtils, JvDataProvider, TntJvMaxPixel, JvToolEdit, TntJvToolEdit, TntWideStrUtils,
  JvExControls, TntVer, TntClasses2;

type
{ NOTE: I didn't use a JvCombobox modification for create TntJvCombobox,
  an error success, that I don't find a solution on TTntJvCustomComboBox.Create:
  PI := GetPropInfo(TTntJvComboBox, 'Items');
  PStringsAddr := Pointer(Integer(PI.GetProc) and $00FFFFFF + Integer(Self));
  Items.Free;
  PStringsAddr^ := TJvComboBoxStrings.Create; <-- error }

  TTntJvCustomComboBox0 = class(TTntCustomComboBox, IJvExControl)
  private
    FAbout: TAboutInfo;
    FHintColor: TColor;
    FMouseOver: Boolean;
    {$IFDEF VCL}
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    {$ENDIF VCL}
    FOnParentColorChanged: TNotifyEvent;
    function BaseWndProc(Msg: Integer; WParam: Integer = 0; LParam: Longint = 0): Integer; overload;
    function BaseWndProc(Msg: Integer; WParam: Integer; LParam: TControl): Integer; overload;
    function BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): Integer;
  protected
    procedure WndProc(var Msg: TMessage); override;
    {$IFNDEF CLR}
    procedure FocusChanged(AControl: TWinControl); dynamic;
    {$ENDIF !CLR}
    procedure VisibleChanged; reintroduce; dynamic;
    procedure EnabledChanged; reintroduce; dynamic;
    procedure TextChanged; reintroduce; virtual;
    procedure ColorChanged; reintroduce; dynamic;
    procedure FontChanged; reintroduce; dynamic;
    procedure ParentFontChanged; reintroduce; dynamic;
    procedure ParentColorChanged; reintroduce; dynamic;
    procedure ParentShowHintChanged; reintroduce; dynamic;
    function WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean; reintroduce; virtual;
    function HintShow(var HintInfo: THintInfo): Boolean; reintroduce; dynamic;
    function HitTest(X, Y: Integer): Boolean; reintroduce; virtual;
    procedure MouseEnter(AControl: TControl); reintroduce; dynamic;
    procedure MouseLeave(AControl: TControl); reintroduce; dynamic;
    {$IFDEF COMPILER5}
    {$IFNDEF HASAUTOSIZE}
    procedure CMSetAutoSize(var Msg: TMessage); message CM_SETAUTOSIZE;
    procedure SetAutoSize(Value: Boolean); virtual;
    {$ENDIF !HASAUTOSIZE}
    {$ENDIF COMPILER5}
    property MouseOver: Boolean read FMouseOver write FMouseOver;
    property HintColor: TColor read FHintColor write FHintColor default clDefault;
    {$IFDEF VCL}
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    {$ENDIF VCL}
    property OnParentColorChange: TNotifyEvent read FOnParentColorChanged write FOnParentColorChanged;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property About: TAboutInfo read FAbout write FAbout stored False;
  private
    FDotNetHighlighting: Boolean;
  protected
    procedure BoundsChanged; reintroduce; virtual;
    procedure CursorChanged; reintroduce; dynamic;
    procedure ShowingChanged; reintroduce; dynamic;
    procedure ShowHintChanged; reintroduce; dynamic;
    {$IFNDEF CLR}
    procedure ControlsListChanging(Control: TControl; Inserting: Boolean); reintroduce; dynamic;
    procedure ControlsListChanged(Control: TControl; Inserting: Boolean); reintroduce; dynamic;
    {$ENDIF !CLR}
    procedure GetDlgCode(var Code: TDlgCodes); virtual;
    procedure FocusSet(PrevWnd: THandle); virtual;
    procedure FocusKilled(NextWnd: THandle); virtual;
    function DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean; virtual;
  {$IFDEF JVCLThemesEnabledD56}
  private
    function GetParentBackground: Boolean;
  protected
    procedure SetParentBackground(Value: Boolean); virtual;
    property ParentBackground: Boolean read GetParentBackground write SetParentBackground;
  {$ENDIF JVCLThemesEnabledD56}
  published
    property DotNetHighlighting: Boolean read FDotNetHighlighting write FDotNetHighlighting default False;
  {Next Lines from JvCombobox, but it doesn't nothing
  private
    FReadOnly: Boolean; // ain
    procedure SetReadOnly(const Value: Boolean); // ain
  protected
    property ReadOnly: Boolean read FReadOnly write SetReadOnly default False; // ain
  }
  end;

  TTntJvCustomComboBox = class(TTntJvCustomComboBox0)
 {$IFDEF WithHintEditor}
  private
    FHintEditor: TUnicodeLinesEditor;
    function GetHintEditor: TUnicodeLinesEditor;
    procedure SetHintEditor(const Value: TUnicodeLinesEditor);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property HintEditor: TUnicodeLinesEditor read GetHintEditor write SetHintEditor stored False;
 {$ENDIF}
  end;

  TTntJvComboBox = class(TTntJvCustomComboBox)
  {any properties it didn't created:}
  published
    property HintColor;
    //property MaxPixel;
    property AutoComplete default True;
    {$IFDEF COMPILER6_UP}
    property AutoDropDown default False;
    {$ENDIF COMPILER6_UP}
    property BevelEdges;
    property BevelInner;
    property BevelKind default bkNone;
    property BevelOuter;
    property Style; {Must be published before Items}
    property Anchors;
    property BiDiMode;
    property CharCase;
    property Color;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property DropDownCount;
    property Enabled;
    //property EmptyValue;
    //property EmptyFontColor;
    property Font;
    property ImeMode;
    property ImeName;
    property ItemHeight;
    property ItemIndex default -1;
    property MaxLength;
    //property MeasureStyle;
    property ParentBiDiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    {$IFNDEF CLR}
    //property Provider;
    {$ENDIF !CLR}
    property PopupMenu;
    //property ReadOnly; // ain
    property ShowHint;
    property Sorted;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;
    property OnChange;
    property OnClick;
    property OnCloseUp;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnDropDown;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem;
    property OnSelect;
    property OnStartDock;
    property OnStartDrag;
    property Items; { Must be published after OnMeasureItem }
    property OnMouseEnter;
    property OnMouseLeave;
    property OnParentColorChange;
  end;

  //TJvCHBQuoteStyle = (qsNone, qsSingle, qsDouble);

  TTntJvCustomCheckedComboBox = class(TTntJvCustomComboEdit)
  private
    FCapSelAll: WideString;
    FCapDeselAll: WideString;
    FItems: TTntStrings;
    FListBox: TTntJvCheckListBox;
    FSelectAll: TTntMenuItem;
    FDeselectAll: TTntMenuItem;
    FNoFocusColor: TColor;
    FSorted: Boolean;
    FQuoteStyle: TJvCHBQuoteStyle; // added 2000/04/08
    FCheckedCount: Integer;
    FColumns: Integer;
    FDropDownLines: Integer;
    FDelimiter: WideChar;
    procedure SetItems(AItems: TTntStrings);
    procedure ToggleOnOff(Sender: TObject);
    procedure KeyListBox(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure ContextListBox(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
    procedure ItemsChange(Sender: TObject);
    procedure SetSorted(Value: Boolean);
    procedure AdjustHeight;
    procedure SetNoFocusColor(Value: TColor);
    procedure SetColumns(Value: Integer);
    procedure SetChecked(Index: Integer; Checked: Boolean);
    procedure SetDropDownLines(Value: Integer);
    function GetChecked(Index: Integer): Boolean;
    function GetItemEnabled(Index: Integer): Boolean;
    procedure SetItemEnabled(Index: Integer; const Value: Boolean);
    function GetState(Index: Integer): TCheckBoxState;
    procedure SetState(Index: Integer; const Value: TCheckBoxState);
    procedure SetDelimiter(const Value: WideChar);
    function IsStoredCapDeselAll: Boolean;
    function IsStoredCapSelAll: Boolean;
  protected
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure AdjustSize; override;
    procedure CreatePopup; override;
    procedure Change; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Clear; override;
    procedure SetUnCheckedAll(Sender: TObject);
    procedure SetCheckedAll(Sender: TObject);
    function IsChecked(Index: Integer): Boolean;
    function GetText: WideString;
    property Checked[Index: Integer]: Boolean read GetChecked write SetChecked;
    property CheckedCount: Integer read FCheckedCount;
    property ItemEnabled[Index: Integer]: Boolean read GetItemEnabled write SetItemEnabled; //dejoy added
    property State[Index: Integer]: TCheckBoxState read GetState write SetState;

    property Items: TTntStrings read FItems write SetItems;
    property CapSelectAll: WideString read FCapSelAll write FCapSelAll stored IsStoredCapSelAll;
    property CapDeSelectAll: WideString read FCapDeselAll write FCapDeselAll stored IsStoredCapDeselAll;
    property NoFocusColor: TColor read FNoFocusColor write SetNoFocusColor;
    property Sorted: Boolean read FSorted write SetSorted default False;
    property QuoteStyle: TJvCHBQuoteStyle read FQuoteStyle write FQuoteStyle default qsNone; // added 2000/04/08
    property Columns: Integer read FColumns write SetColumns default 0;
    property DropDownLines: Integer read FDropDownLines write SetDropDownLines default 6;
    property Delimiter: WideChar read FDelimiter write SetDelimiter default ',';
  end;

  TTntJvCheckedComboBox = class(TTntJvCustomCheckedComboBox)
  published
    property Items;
    property CapSelectAll;
    property CapDeSelectAll;
    property NoFocusColor;
    property Sorted;
    property QuoteStyle;
    property Columns;
    property DropDownLines;
    property Delimiter;

    property Ctl3D;
    property Cursor;
    property Enabled;
    property Font;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property ShowHint;
    property ImeMode;
    property ImeName;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnChange;
    property OnClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDrag;
    property OnEnter;
    property OnExit;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvCombobox.pas,v $';
    Revision: '$Revision: 1.70 $';
    Date: '$Date: 2005/12/25 16:38:10 $';
    LogPath: 'JVCL'run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  SysUtils, Consts, TypInfo, Buttons,
  {$IFDEF HAS_UNIT_RTLCONSTS}
  RTLConsts,
  {$ENDIF HAS_UNIT_RTLCONSTS}
  {$IFDEF HAS_UNIT_VARIANTS}
  Variants,
  {$ENDIF HAS_UNIT_VARIANTS}
  JvDataProviderIntf, TntJvItemsSearchs, JvThemes, JvConsts, JvResources, JvTypes, TntSysUtils;

const
  MaxSelLength = 256;
  MinDropLines = 2;
  MaxDropLines = 50;

type
  PTntStrings = ^TStrings;  //error?????????

  TJvPrivForm = class(TTntJvPopupWindow)
  protected
    function GetValue: Variant; override;
    procedure SetValue(const Value: Variant); override;
  end;


//=== Local procedures =======================================================

// examines if string (part) exist in string (source)
// where source is in format part1[,part2]

function PartExist(const Part, Source: WideString; Delimiter: WideChar): Boolean;
var
  M: Integer;
  Temp1, Temp2: WideString;
begin
  Temp1 := Copy(Source, 1, MaxSelLength);
  Result := Part = Temp1;
  while not Result do
  begin
    M := Pos(Delimiter, Temp1);
    if M > 0 then
      Temp2 := Copy(Temp1, 1, M - 1)
    else
      Temp2 := Temp1;
    Result := Part = Temp2;
    if Result or (M = 0) then
      Break;
    Delete(Temp1, 1, M);
  end;
end;

// removes a string (part) from another string (source)
// when source is in format part1[,part2]

function RemovePart(const Part, Source: WideString; Delimiter: WideChar): WideString;
var
  Len, P: Integer;
  S1, S2: WideString;
begin
  Result := Source;
  S1 := Delimiter + Part + Delimiter;
  S2 := Delimiter + Source + Delimiter;
  P := Pos(S1, S2);
  if P > 0 then
  begin
    Len := Length(Part);
    if P = 1 then
      Result := Copy(Source, P + Len + 1, MaxSelLength)
    else
    begin
      Result := Copy(S2, 2, P - 1) + Copy(S2, P + Len + 2, MaxSelLength);
      SetLength(Result, Length(Result) - 1);
    end;
  end;
end;

function Add(const Sub: WideString; var Str: WideString; Delimiter: WideChar): Boolean;
begin
  Result := False;
  if Length(Str) + Length(Sub) + 1 >= MaxSelLength then
    {$IFDEF CLR}
    raise EJVCLException.Create(RsENoMoreLength);
    {$ELSE}