jvcombobox.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
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閎astien Buysse [sbuysse att buypin dott com]
Portions created by S閎astien Buysse are Copyright (C) 2001 S閎astien 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.63 2005/02/17 10:20:02 marquardt Exp $

unit JvCombobox;

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

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Messages, Classes, Graphics, Controls, Forms, StdCtrls, Menus,
  JvCheckListBox, JvExStdCtrls, 
  {$IFDEF COMPILER5}
  JvAutoComplete,
  {$ENDIF COMPILER5}
  JvJVCLUtils, JvDataProvider, JvMaxPixel, JvToolEdit;

type
  TJvCustomComboBox = class;

  {$IFDEF COMPILER5}
  TCustomComboBoxStrings = TStrings;
  {$ENDIF COMPILER5}

  { This class will be used for the Items property of the combo box.

    If a provider is active at the combo box, this list will keep the strings stored in an internal
    list.

    Whenever an item is added to the list the provider will be deactivated and the list will be
    handled by the combo box as usual. }
  TJvComboBoxStrings = class(TCustomComboBoxStrings)
  private
    {$IFDEF COMPILER5}
    FComboBox: TJvCustomComboBox;
    {$ENDIF COMPILER5}
    FInternalList: TStringList;
    FUseInternal: Boolean;
    FUpdating: Boolean;
    FDestroyCnt: Integer;
    function GetInternalList: TStrings;
  protected
    function Get(Index: Integer): string; override;
    function GetCount: Integer; override;
    function GetObject(Index: Integer): TObject; override;
    procedure PutObject(Index: Integer; AObject: TObject); override;
    procedure SetUpdateState(Updating: Boolean); override;
    procedure SetWndDestroying(Destroying: Boolean);
    function GetComboBox: TJvCustomComboBox;
    procedure SetComboBox(Value: TJvCustomComboBox);
    property ComboBox: TJvCustomComboBox read GetComboBox write SetComboBox;
    property InternalList: TStrings read GetInternalList;
    property UseInternal: Boolean read FUseInternal write FUseInternal;
    property Updating: Boolean read FUpdating;
    property DestroyCount: Integer read FDestroyCnt;
  public
    constructor Create;
    destructor Destroy; override;
    function Add(const S: string): Integer; override;
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    function IndexOf(const S: string): Integer; override;
    procedure Insert(Index: Integer; const S: string); override;
    procedure MakeListInternal; virtual;
    procedure ActivateInternal; virtual;
  end;

  TJvComboBoxStringsClass = class of TJvComboBoxStrings;

  TJvComboBoxMeasureStyle = (cmsStandard, cmsAfterCreate, cmsBeforeDraw);

  TJvCustomComboBox = class(TJvExCustomComboBox)
  private
    {$IFDEF COMPILER5}
    FAutoComplete: Boolean;
    FAutoCompleteCode: TJvComboBoxAutoComplete;
    FAutoDropDown: Boolean;
    FIsDropping: Boolean;
    FOnSelect: TNotifyEvent;
    FOnCloseUp: TNotifyEvent;
    {$ENDIF COMPILER5}
    FKey: Word;
    FSearching: Boolean;
    FMaxPixel: TJvMaxPixel;
    FReadOnly: Boolean; // ain
    FConsumerSvc: TJvDataConsumer;
    FProviderIsActive: Boolean;
    FProviderToggle: Boolean;
    FIsFixedHeight: Boolean;
    FMeasureStyle: TJvComboBoxMeasureStyle;
    FLastSetItemHeight: Integer;
    FEmptyValue: string;
    FIsEmptyValue: Boolean;
    FEmptyFontColor: TColor;
    FOldFontColor: TColor;
    procedure SetEmptyValue(const Value: string);
    procedure MaxPixelChanged(Sender: TObject);
    procedure SetReadOnly(const Value: Boolean); // ain
    procedure CNCommand(var Msg: TWMCommand); message CN_COMMAND;
    procedure CNMeasureItem(var Msg: TWMMeasureItem); message CN_MEASUREITEM;
    procedure WMInitDialog(var Msg: TWMInitDialog); message WM_INITDIALOG;
    procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN; // ain
    procedure WMLButtonDblClk(var Msg: TWMLButtonDblClk); message WM_LBUTTONDBLCLK; // ain
  protected
    function GetText: TCaption; virtual;
    procedure SetText(const Value: TCaption); virtual;
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure DoEmptyValueEnter; virtual;
    procedure DoEmptyValueExit; virtual;
    procedure CreateWnd; override; // ain
    {$IFDEF COMPILER6_UP}
    function GetItemsClass: TCustomComboBoxStringsClass; override;
    {$ENDIF COMPILER6_UP}
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    {$IFDEF COMPILER5}
    procedure DoChange(Sender: TObject);
    procedure DoDropDown(Sender: TObject);
    procedure DoValueChange(Sender: TObject);
    procedure KeyPress(var Key: Char); override;  // SPM - Ported backward from D7
    {$ENDIF COMPILER5}
    procedure SetItemHeight(Value: Integer); {$IFDEF COMPILER6_UP} override; {$ENDIF}
    function GetMeasureStyle: TJvComboBoxMeasureStyle;
    procedure SetMeasureStyle(Value: TJvComboBoxMeasureStyle);
    procedure PerformMeasure;
    procedure PerformMeasureItem(Index: Integer; var Height: Integer); virtual;
    procedure DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
    procedure MeasureItem(Index: Integer; var Height: Integer); override;
    {$IFDEF COMPILER5}
    procedure CloseUp; dynamic;
    procedure Select; dynamic;
    {$ENDIF COMPILER5}
    procedure SetConsumerService(Value: TJvDataConsumer);
    procedure ConsumerServiceChanged(Sender: TJvDataConsumer; Reason: TJvDataConsumerChangeReason);
    procedure ConsumerSubServiceCreated(Sender: TJvDataConsumer; SubSvc: TJvDataConsumerAggregatedObject);
    function IsProviderSelected: Boolean;
    procedure DeselectProvider;
    procedure UpdateItemCount;
    function HandleFindString(StartIndex: Integer; Value: string; ExactMatch: Boolean): Integer;
    procedure Loaded; override;
    property Provider: TJvDataConsumer read FConsumerSvc write SetConsumerService;
    {$IFDEF COMPILER5}
    property IsDropping: Boolean read FIsDropping write FIsDropping;
    property ItemHeight write SetItemHeight;
    {$ENDIF COMPILER5}
    property IsFixedHeight: Boolean read FIsFixedHeight;
    property MeasureStyle: TJvComboBoxMeasureStyle read GetMeasureStyle write SetMeasureStyle
      default cmsStandard;
    {$IFDEF COMPILER5}
    property OnSelect: TNotifyEvent read FOnSelect write FOnSelect;
    property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp;
    property AutoComplete: Boolean read FAutoComplete write FAutoComplete default True;
    property AutoDropDown: Boolean read FAutoDropDown write FAutoDropDown default False;
    {$ENDIF COMPILER5}
    property MaxPixel: TJvMaxPixel read FMaxPixel write FMaxPixel;
    property ReadOnly: Boolean read FReadOnly write SetReadOnly default False; // ain
    property Text: TCaption read GetText write SetText;
    property EmptyValue: string read FEmptyValue write SetEmptyValue;
    property EmptyFontColor: TColor read FEmptyFontColor write FEmptyFontColor default clGrayText;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DestroyWnd; override;
    procedure WndProc(var Msg: TMessage); override; // ain
    function GetItemCount: Integer; {$IFDEF COMPILER6_UP} override; {$ELSE} virtual; {$ENDIF}
    function GetItemText(Index: Integer): string; virtual;
    function SearchExactString(Value: string; CaseSensitive: Boolean = True): Integer;
    function SearchPrefix(Value: string; CaseSensitive: Boolean = True): Integer;
    function SearchSubString(Value: string; CaseSensitive: Boolean = True): Integer;
    function DeleteExactString(Value: string; All: Boolean; CaseSensitive: Boolean = True): Integer;
  end;

  TJvComboBox = class(TJvCustomComboBox)
  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;
    property Provider;
    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);

  TJvCustomCheckedComboBox = class(TJvCustomComboEdit)
  private
    FCapSelAll: string;
    FCapDeselAll: string;
    FItems: TStrings;
    FListBox: TJvCheckListBox;
    FSelectAll: TMenuItem;
    FDeselectAll: TMenuItem;
    FNoFocusColor: TColor;
    FSorted: Boolean;
    FQuoteStyle: TJvCHBQuoteStyle; // added 2000/04/08
    FCheckedCount: Integer;
    FColumns: Integer;
    FDropDownLines: Integer;
    FDelimiter: Char;
    procedure SetItems(AItems: TStrings);
    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: Char);
    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: string;
    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: TStrings read FItems write SetItems;
    property CapSelectAll: string read FCapSelAll write FCapSelAll stored IsStoredCapSelAll;
    property CapDeSelectAll: string 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: Char read FDelimiter write SetDelimiter default ',';
  end;

  TJvCheckedComboBox = class(TJvCustomCheckedComboBox)
  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.63 $';
    Date: '$Date: 2005/02/17 10:20:02 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  SysUtils, Consts, TypInfo, Buttons,
  {$IFDEF HAS_UNIT_RTLCONSTS}
  RTLConsts,
  {$ENDIF HAS_UNIT_RTLCONSTS}
  JvDataProviderIntf, JvItemsSearchs, JvThemes, JvConsts, JvResources, JvTypes;

type
  PStrings = ^TStrings;

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

const
  MAXSELLENGTH = 256;
  MINDROPLINES = 6;
  MAXDROPLINES = 10;

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

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

function PartExist(const Part, Source: string; Delimiter: Char): Boolean;
var
  M: Integer;
  Temp1, Temp2: string;
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: string; Delimiter: Char): string;
var
  Len, P: Integer;
  S1, S2: string;
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: string; var Str: string; Delimiter: Char): Boolean;
begin
  Result := False;
  if Length(Str) + Length(Sub) + 1 >= MAXSELLENGTH then
    raise EJVCLException.CreateRes(@RsENoMoreLength);
  if Str = '' then
  begin
    Str := Sub;
    Result := True;
  end
  else
  if not PartExist(Sub, Str, Delimiter) then
  begin
    Str := Str + Delimiter + Sub;
    Result := True;
  end;
end;

function Remove(const Sub: string; var Str: string; Delimiter: Char): Boolean;
var
  Temp: string;
begin
  Result := False;
  if Str <> '' then
  begin
    Temp := RemovePart(Sub, Str, Delimiter);
    if Temp <> Str then