jvtooledit.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: JvToolEdit.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
Copyright (c) 2001,2002 SGB Software
All Rights Reserved.

Contributers:
  Rob den Braasem [rbraasem att xs4all dott nl]
  Polaris Software
  rblaurindo
  Andreas Hausladen

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:
  (rb) Move button related functionality from TJvCustomComboEdit to TJvEditButton
-----------------------------------------------------------------------------}
// $Id: JvToolEdit.pas,v 1.171 2005/03/06 23:04:10 remkobonte Exp $

unit JvToolEdit;

{$I jvcl.inc}
{$I crossplatform.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$IFDEF MSWINDOWS}
  Windows, Messages,
  {$ENDIF MSWINDOWS}
  {$IFDEF VCL}
  ShlObj,
  {$ENDIF VCL}
  SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus,
  Buttons, FileCtrl, Mask, ImgList, ActnList, ExtDlgs,
  {$IFDEF VisualCLX}
  Qt, QComboEdits, JvQExComboEdits, QWindows,
  {$ENDIF VisualCLX}
  JvExControls, JvSpeedButton, JvTypes, JvExMask, JvExForms, JvButton;

const
  scAltDown = scAlt + VK_DOWN;
  DefEditBtnWidth = 21;

  CM_POPUPCLOSEUP = CM_BASE + $0300; // arbitrary value

{$IFNDEF COMPILER7_UP}
// Autocomplete stuff for Delphi 5 and 6. (missing in ShlObj)
type
  IAutoComplete = interface(IUnknown)
    ['{00bb2762-6a77-11d0-a535-00c04fd7d062}']
    function Init(hwndEdit: HWND; punkACL: IUnknown;
      pwszRegKeyPath: LPCWSTR; pwszQuickComplete: LPCWSTR): HRESULT; stdcall;
    function Enable(fEnable: BOOL): HRESULT; stdcall;
  end;

const
  { IAutoComplete2 options }
  ACO_NONE = 0;
  ACO_AUTOSUGGEST = $1;
  ACO_AUTOAPPEND = $2;
  ACO_SEARCH = $4;
  ACO_FILTERPREFIXES = $8;
  ACO_USETAB = $10;
  ACO_UPDOWNKEYDROPSLIST = $20;
  ACO_RTLREADING = $40;

type
  IAutoComplete2 = interface(IAutoComplete)
    ['{EAC04BC0-3791-11d2-BB95-0060977B464C}']
    function SetOptions(dwFlag: DWORD): HRESULT; stdcall;
    function GetOptions(var dwFlag: DWORD): HRESULT; stdcall;
  end;

{$ENDIF !COMPILER7_UP}

type
  TFileExt = type string;

  TCloseUpEvent = procedure(Sender: TObject; Accept: Boolean) of object;
  TPopupAlign = (epaRight, epaLeft);

  {$IFDEF VisualCLX}
  TJvPopupWindow = class(TJvExCustomForm)
  {$ENDIF VisualCLX}
  {$IFDEF VCL}
  TJvPopupWindow = class(TJvExCustomControl)
  {$ENDIF VCL}
  private
    FEditor: TWinControl;
    FCloseUp: TCloseUpEvent;
    {$IFDEF VCL}
    procedure WMMouseActivate(var Msg: TMessage); message WM_MOUSEACTIVATE;
    procedure WMActivate(var Msg: TWMActivate); message WM_ACTIVATE;
    {$ENDIF VCL}
  protected
    FActiveControl: TWinControl;
    FIsFocusable: Boolean;
    {$IFDEF VCL}
    procedure CreateParams(var Params: TCreateParams); override;
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    procedure SetParent(const Value: TWidgetControl); override;
    function WidgetFlags: Integer; override;
    {$ENDIF VisualCLX}
    function GetValue: Variant; virtual; abstract;
    procedure SetValue(const Value: Variant); virtual; abstract;
    procedure InvalidateEditor;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure CloseUp(Accept: Boolean); virtual;
  public
    constructor Create(AOwner: TComponent); override;
    function GetPopupText: string; virtual;
    procedure Hide;
    procedure Show(Origin: TPoint); virtual; // Polaris
    { Determines the ctrl that receives the keyboard input if the dropdown
      window is showing, but the combo edit still has focus }
    property ActiveControl: TWinControl read FActiveControl;
    { Determines whether the popup window may be activated }
    property IsFocusable: Boolean read FIsFocusable;
    property OnCloseUp: TCloseUpEvent read FCloseUp write FCloseUp;
  end;

  TJvEditButton = class(TJvImageSpeedButton)
  private
    FNoAction: Boolean;
    {$IFDEF VCL}
    procedure WMContextMenu(var Msg: TWMContextMenu); message WM_CONTEXTMENU;
    {$ENDIF VCL}
    function GetGlyph: TBitmap;
    function GetNumGlyphs: TJvNumGlyphs;
    function GetUseGlyph: Boolean;
    procedure SetGlyph(const Value: TBitmap);
    procedure SetNumGlyphs(Value: TJvNumGlyphs);
  protected
    {$IFDEF JVCLThemesEnabled}
    FDrawThemedDropDownBtn: Boolean;
    {$ENDIF JVCLThemesEnabled}
    FStandard: Boolean; // Polaris
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure PaintImage(Canvas: TCanvas; ARect: TRect; const Offset: TPoint;
      AState: TJvButtonState; DrawMark: Boolean); override;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Click; override;

    property UseGlyph: Boolean read GetUseGlyph;// write FDrawGlyph;
    property Glyph: TBitmap read GetGlyph write SetGlyph;
    property NumGlyphs: TJvNumGlyphs read GetNumGlyphs write SetNumGlyphs;
  end;

  TGlyphKind = (gkCustom, gkDefault, gkDropDown, gkEllipsis);
  TJvImageKind = (ikCustom, ikDefault, ikDropDown, ikEllipsis);

  TJvCustomComboEdit = class;

  TJvCustomComboEditActionLink = class(TWinControlActionLink)
  protected
    function IsCaptionLinked: Boolean; override;
    function IsHintLinked: Boolean; override;
    function IsImageIndexLinked: Boolean; override;
    function IsOnExecuteLinked: Boolean; override;
    function IsShortCutLinked: Boolean; override;
    procedure SetHint(const Value: THintString); override;
    procedure SetImageIndex(Value: Integer); override;
    procedure SetOnExecute(Value: TNotifyEvent); override;
    procedure SetShortCut(Value: TShortCut); override;
  end;

  TJvCustomComboEditActionLinkClass = class of TJvCustomComboEditActionLink;

  {$IFDEF VCL}
  TJvAutoCompleteOption = (acoAutoSuggest, acoAutoAppend, acoSearch,
    acoFilterPrefixes, acoUseTab, acoUpDownKeyDropsList, acoRTLReading);
  TJvAutoCompleteOptions = set of TJvAutoCompleteOption;
  TJvAutoCompleteFileOption = (acfFileSystem, acfFileSysDirs, acfURLHistory, acfURLMRU);
  TJvAutoCompleteFileOptions = set of TJvAutoCompleteFileOption;
  {$ENDIF VCL}

  {$IFDEF VCL}
  TJvCustomComboEdit = class(TJvExCustomMaskEdit)
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  TJvCustomComboEdit = class(TJvExCustomComboMaskEdit)
  {$ENDIF VisualCLX}
  private
    FOnButtonClick: TNotifyEvent;
    FOnPopupShown: TNotifyEvent;
    FOnPopupHidden: TNotifyEvent;
    FClickKey: TShortCut;
    FReadOnly: Boolean;
    FDirectInput: Boolean;
    FAlwaysEnableButton: Boolean;
    FAlwaysShowPopup: Boolean;
    FPopupAlign: TPopupAlign;
    FGroupIndex: Integer; // RDB
    FDisabledColor: TColor; // RDB
    FDisabledTextColor: TColor; // RDB
    FOnKeyDown: TKeyEvent; // RDB
    FImages: TCustomImageList;
    FImageIndex: TImageIndex;
    FImageKind: TJvImageKind;
    FNumGlyphs: Integer;
    FStreamedButtonWidth: Integer;
    FStreamedFixedWidth: Boolean;
    FOnEnabledChanged: TNotifyEvent;
    { We hide the button by setting its width to 0, thus we have to store the
      width the button should have when shown again in FSavedButtonWidth: }
    FSavedButtonWidth: Integer;
    {$IFDEF VCL}
    FAlignment: TAlignment;
    FAutoCompleteIntf: IAutoComplete;
    FAutoCompleteItems: TStrings;
    FAutoCompleteOptions: TJvAutoCompleteOptions;
    FAutoCompleteSource: IUnknown;
    procedure SetAutoCompleteItems(Strings: TStrings);
    procedure SetAutoCompleteOptions(const Value: TJvAutoCompleteOptions);
    procedure SetAlignment(Value: TAlignment);
    function GetFlat: Boolean;
    procedure ReadCtl3D(Reader: TReader);
    procedure SetFlat(const Value: Boolean);
    function IsFlatStored: Boolean;
    {$ENDIF VCL}
    function BtnWidthStored: Boolean;
    function GetButtonFlat: Boolean;
    function GetButtonHint: string;
    function GetButtonWidth: Integer;
    function GetDirectInput: Boolean;
    function GetGlyph: TBitmap;
    function GetGlyphKind: TGlyphKind;
    function GetMinHeight: Integer;
    function GetNumGlyphs: TNumGlyphs;
    function GetPopupVisible: Boolean;
    function GetShowButton: Boolean;
    function GetTextHeight: Integer;
    function IsImageIndexStored: Boolean;
    function IsCustomGlyph: Boolean;
    procedure EditButtonClick(Sender: TObject);
    procedure ReadGlyphKind(Reader: TReader);
    procedure RecreateGlyph;
    procedure SetButtonFlat(const Value: Boolean);
    procedure SetButtonHint(const Value: string);
    procedure SetButtonWidth(Value: Integer);
    procedure SetGlyph(Value: TBitmap);
    procedure SetGlyphKind(Value: TGlyphKind);
    procedure SetImageIndex(const Value: TImageIndex);
    procedure SetImageKind(const Value: TJvImageKind);
    procedure SetImages(const Value: TCustomImageList);
    procedure SetNumGlyphs(const Value: TNumGlyphs);
    procedure SetShowButton(const Value: Boolean);
    {$IFDEF COMPILER6_UP}
    procedure UpdateBtnBounds(var NewLeft, NewTop, NewWidth, NewHeight: Integer);
    {$ENDIF COMPILER6_UP}
    { (rb) renamed from UpdateEdit }
    procedure UpdateGroup; // RDB
    {$IFDEF VCL}
    procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
    procedure CMBiDiModeChanged(var Msg: TMessage); message CM_BIDIMODECHANGED;
    procedure CMCancelMode(var Msg: TCMCancelMode); message CM_CANCELMODE;
    procedure CMCtl3DChanged(var Msg: TMessage); message CM_CTL3DCHANGED;
    procedure CNCtlColor(var Msg: TMessage); message CN_CTLCOLOREDIT;
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT; // RDB
    procedure CMPopupCloseup(var Msg: TMessage); message CM_POPUPCLOSEUP;
    {$IFDEF JVCLThemesEnabled}
    procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
    procedure WMNCCalcSize(var Msg: TWMNCCalcSize); message WM_NCCALCSIZE;
    {$ENDIF JVCLThemesEnabled}
    procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
    {$ENDIF VCL}
  protected
    FButton: TJvEditButton; // Polaris
    FBtnControl: TWinControl;
    FPopupVisible: Boolean; // Polaris
    FFocused: Boolean; // Polaris
    FPopup: TWinControl;
    {$IFDEF COMPILER6_UP}
    {$IFDEF VCL}
    procedure CustomAlignPosition(Control: TControl; var NewLeft, NewTop, NewWidth,
      NewHeight: Integer; var AlignRect: TRect; AlignInfo: TAlignInfo); override;
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    procedure CustomAlignPosition(Control: TControl; var NewLeft,
      NewTop, NewWidth, NewHeight: Integer; var AlignRect: TRect); override;
    {$ENDIF VisualCLX}
    {$ENDIF COMPILER6_UP}
    {$IFDEF VCL}
    procedure WndProc(var Msg: TMessage); override;
    {$ENDIF VCL}
    procedure WMClear(var Msg: TMessage); message WM_CLEAR;
    procedure WMCut(var Msg: TMessage); message WM_CUT;
    procedure WMPaste(var Msg: TMessage); message WM_PASTE;
    procedure AdjustSize; override;
    procedure FocusKilled(NextWnd: HWND); override;
    procedure FocusSet(PrevWnd: HWND); override;
    procedure EnabledChanged; override;
    procedure FontChanged; override;
    procedure DoEnter; override;
    procedure DoCtl3DChanged; virtual;
    function DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean; override;
    { Repositions the child controls; checkbox }
    procedure UpdateControls; virtual;
    { Updates the margins of the edit box }
    procedure UpdateMargins; dynamic;
    { Returns the margins of the edit box }
    procedure GetInternalMargins(var ALeft, ARight: Integer); virtual;
    procedure CreatePopup; virtual;
    procedure HidePopup; virtual; // (ahuser): WARNING: Do not release or free the component in HidePopup -> else AV in MouseUp
    procedure ShowPopup(Origin: TPoint); virtual;
    {$IFDEF VisualCLX}
    procedure DoFlatChanged; override;
    procedure Paint; override;
    {$ENDIF VisualCLX}
    function AcceptPopup(var Value: Variant): Boolean; virtual;
    function EditCanModify: Boolean; override;
    function GetActionLinkClass: TControlActionLinkClass; override;
    function GetPopupValue: Variant; virtual;
    function GetReadOnly: Boolean; virtual;
    function GetSettingCursor: Boolean;
    procedure AcceptValue(const Value: Variant); virtual;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    procedure AdjustHeight;
    procedure ButtonClick; dynamic;
    procedure Change; override;
    procedure CreateWnd; override;
    {$IFDEF VCL}
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateAutoComplete; virtual;
    procedure UpdateAutoComplete; virtual;
    function GetAutoCompleteSource: IUnknown; virtual;
    {$ENDIF VCL}
    procedure DefineProperties(Filer: TFiler); override;
    procedure DoChange; virtual; //virtual Polaris
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure Loaded; override;
    procedure LocalKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); // RDB
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure PopupChange; virtual;
    procedure PopupCloseUp(Sender: TObject; Accept: Boolean); virtual; //virtual Polaris
    procedure AsyncPopupCloseUp(Accept: Boolean); virtual;
    procedure PopupDropDown(DisableEdit: Boolean); virtual;
    procedure SetClipboardCommands(const Value: TJvClipboardCommands); override; // RDB
    procedure SetDirectInput(Value: Boolean); // Polaris
    procedure SetDisabledColor(const Value: TColor); virtual; // RDB
    procedure SetDisabledTextColor(const Value: TColor); virtual; // RDB
    procedure SetGroupIndex(const Value: Integer); // RDB
    procedure SetPopupValue(const Value: Variant); virtual;
    procedure SetReadOnly(Value: Boolean); virtual;
    procedure SetShowCaret; // Polaris
    procedure UpdatePopupVisible;
    {$IFDEF VCL}
    property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    property Alignment;
    {$ENDIF VisualCLX}
    property AlwaysEnableButton: Boolean read FAlwaysEnableButton write FAlwaysEnableButton default False;
    property AlwaysShowPopup: Boolean read FAlwaysShowPopup write FAlwaysShowPopup default False;
    {$IFDEF VCL}
    property AutoCompleteItems: TStrings read FAutoCompleteItems write SetAutoCompleteItems;
    property AutoCompleteOptions: TJvAutoCompleteOptions read FAutoCompleteOptions write SetAutoCompleteOptions default [];
    {$ENDIF VCL}
    property Button: TJvEditButton read FButton;
    property ButtonFlat: Boolean read GetButtonFlat write SetButtonFlat default False;
    property ButtonHint: string read GetButtonHint write SetButtonHint;
    property ButtonWidth: Integer read GetButtonWidth write SetButtonWidth stored BtnWidthStored;
    property ClickKey: TShortCut read FClickKey write FClickKey default scAltDown;
    property DirectInput: Boolean read GetDirectInput write SetDirectInput default True;
    property DisabledColor: TColor read FDisabledColor write SetDisabledColor default clWindow; // RDB
    property DisabledTextColor: TColor read FDisabledTextColor write SetDisabledTextColor default clGrayText; // RDB
    {$IFDEF VCL}
    property Flat: Boolean read GetFlat write SetFlat {$IFDEF VisualCLX}default False;{$ENDIF VisualCLX}{$IFDEF VCL}stored IsFlatStored;{$ENDIF VCL}
    {$ENDIF VCL}
    property Glyph: TBitmap read GetGlyph write SetGlyph stored IsCustomGlyph;
    property GroupIndex: Integer read FGroupIndex write SetGroupIndex default -1;
    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex stored IsImageIndexStored default -1;