tntjvtooledit.pas

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

{$ENDIF VisualCLX}

function LoadDefaultBitmap(Bmp: TBitmap; Item: Integer): Boolean;

function IsInWordArray(Value: Word; const A: array of Word): Boolean;
***)

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvToolEdit.pas,v $';
    Revision: '$Revision: 1.187 $';
    Date: '$Date: 2006/01/12 16:35:09 $';
    LogPath: 'JVCL'run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  {$IFDEF HAS_UNIT_RTLCONSTS}
  RTLConsts,
  {$ENDIF HAS_UNIT_RTLCONSTS}
  Math, Consts,
  {$IFDEF COMPILER6_UP}
  MaskUtils,
  {$ENDIF COMPILER6_UP}
  {$IFDEF VCL}
  MultiMon,
  {$IFNDEF CLR}
  JvBrowseFolder,
  {$ENDIF !CLR}
  {$ENDIF VCL}
  TntJvPickDate, JvJCLUtils, JvJVCLUtils,
  JvThemes, JvResources, JvConsts,
  TntControls, TntSystem, TntSysUtils, TntExtDlgs, TntJvJCLUtils, TntWideStrUtils;

{$R *.res}

type
  {$IFDEF CLR}
  TCustomEditAccessProtected = class(TCustomEdit)
  public
    property Ctl3D;
    property BorderStyle;
  end;
  {$ELSE}

  {$HINTS OFF}
  TCustomMaskEditAccessPrivate = class(TCustomEdit)
  private
    // Do not remove these fields, although they are not used.
    {$IFDEF COMPILER6_UP}
    FEditMask: TEditMask;
    {$ELSE}
    FEditMask: WideString;
    {$ENDIF COMPILER6_UP}
    FMaskBlank: Char;
    FMaxChars: Integer;
    FMaskSave: Boolean;
    FMaskState: TMaskedState;
    FCaretPos: Integer;
    FBtnDownX: Integer;
    FOldValue: WideString;
    FSettingCursor: Boolean;
  end;
  {$HINTS ON}

  TCustomEditAccessProtected = class(TCustomEdit);
  {$ENDIF CLR}
  TCustomFormAccessProtected = class(TCustomForm);
  TWinControlAccessProtected = class(TWinControl);

const
  sDirBmp = 'TntJvDirectoryEditGLYPH';    { Directory editor button glyph }
  sFileBmp = 'TntJvFilenameEditGLYPH';    { Filename editor button glyph }
  sDateBmp = 'TntJvCustomDateEditGLYPH';  { Date editor button glyph }

  {$IFDEF JVCLThemesEnabled}
  // (rb) should/can these be put in a separate resource file?
  sDirXPBmp = 'TntJvDirectoryEditXPGLYPH';
  sFileXPBmp = 'TntJvFilenameEditXPGLYPH';
  {$ENDIF JVCLThemesEnabled}

{$IFDEF VCL}

const
  ACLO_NONE            = 0;   // don't enumerate anything
  ACLO_CURRENTDIR      = 1;   // enumerate current directory
  ACLO_MYCOMPUTER      = 2;   // enumerate MyComputer
  ACLO_DESKTOP         = 4;   // enumerate Desktop Folder
  ACLO_FAVORITES       = 8;   // enumerate Favorites Folder
  ACLO_FILESYSONLY     = 16;  // enumerate only the file system
  ACLO_FILESYSDIRS     = 32;  // enumerate only the file system dirs, UNC shares, and UNC servers.

  //IID_IAutoCompList: TGUID = (D1:$00BB2760; D2:$6A77; D3:$11D0; D4:($A5, $35, $00, $C0, $4F, $D7, $D0, $62));
  //IID_IObjMgr: TGUID = (D1:$00BB2761; D2:$6A77; D3:$11D0; D4:($A5, $35, $00, $C0, $4F, $D7, $D0, $62));
  //IID_IACList: TGUID = (D1:$77A130B0; D2:$94FD; D3:$11D0; D4:($A5, $44, $00, $C0, $4F, $D7, $d0, $62));
  //IID_IACList2: TGUID = (D1:$470141a0; D2:$5186; D3:$11d2; D4:($bb, $b6, $00, $60, $97, $7b, $46, $4c));
  //IID_ICurrentWorkingDirectory: TGUID = (D1:$91956d21; D2:$9276; D3:$11d1; D4:($92, $1a, $00, $60, $97, $df, $5b, $d4));  // {91956D21-9276-11d1-921A-006097DF5BD));

  {$IFDEF CLR}
  CLSID_AutoComplete = '{00BB2763-6A77-11D0-A535-00C04FD7D062}';
  CLSID_ACLMulti     = '{00BB2765-6A77-11D0-A535-00C04FD7D062}';
  CLSID_ACLHistory   = '{00BB2764-6A77-11D0-A535-00C04FD7D062}';
  CLSID_ACLMRU       = '{6756A641-DE71-11D0-831B-00AA005B4383}';
  CLSID_ACListISF    = '{03C036F1-A186-11D0-824A-00AA005B4383}';
  {$ELSE}
  CLSID_AutoComplete: TGUID = (D1:$00BB2763; D2:$6A77; D3:$11D0; D4:($A5, $35, $00, $C0, $4F, $D7, $D0, $62));
  CLSID_ACLHistory: TGUID = (D1:$00BB2764; D2:$6A77; D3:$11D0; D4:($A5, $35, $00, $C0, $4F, $D7, $D0, $62));
  CLSID_ACListISF: TGUID = (D1:$03C036F1; D2:$A186; D3:$11D0; D4:($82, $4A, $00, $AA, $00, $5B, $43, $83));
  CLSID_ACLMRU: TGUID = (D1:$6756a641; D2:$de71; D3:$11d0; D4:($83, $1b, $0, $aa, $0, $5b, $43, $83));
  CLSID_ACLMulti: TGUID = (D1:$00BB2765; D2:$6A77; D3:$11D0; D4:($A5, $35, $00, $C0, $4F, $D7, $D0, $62));
  {$ENDIF CLR}

  //#if (_WIN32_IE >= 0x0600)
  //CLSID_ACLCustomMRU: TGUID = (D1:$6935db93; D2:$21e8; D3:$4ccc; D4:($be, $b9, $9f, $e3, $c7, $7a, $29, $7a));
  //#endif

type
{$IFDEF CLR}
  TAutoCompleteSource = class(TInterfacedObject, IEnumString)
  private
    FComboEdit: TTntJvCustomComboEdit;
    FCurrentIndex: Integer;
  protected
    { IEnumString }
    function Next(celt: Longint; rgelt: array of string; out pceltFetched: Longint): HResult;
    function Skip(celt: Longint): HResult;
    function Reset: HResult;
    function Clone(out enm: IEnumString): HResult;
  public
    constructor Create(AComboEdit: TTntJvCustomComboEdit; const StartIndex: Integer); virtual;
  end;
{$ELSE}
  TAutoCompleteSource = class(TInterfacedObject, IEnumString)
  private
    FComboEdit: TTntJvCustomComboEdit;
    FCurrentIndex: Integer;
  protected
    { IEnumString }
    function Next(celt: Longint; out elt; pceltFetched: PLongint): HRESULT; stdcall;
    function Skip(celt: Longint): HRESULT; stdcall;
    function Reset: HRESULT; stdcall;
    function Clone(out enm: IEnumString): HRESULT; stdcall;
  public
    constructor Create(AComboEdit: TTntJvCustomComboEdit; const StartIndex: Integer); virtual;
  end;
{$ENDIF CLR}

  {$IFDEF CLR}
  [ComImport, InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)]
  {$ENDIF CLR}
  IACList = interface(IUnknown)
    ['{77A130B0-94FD-11D0-A544-00C04FD7d062}']
    {$IFDEF CLR}[PreserveSig]{$ENDIF CLR}
    function Expand(pszExpand: string): HRESULT; {$IFNDEF CLR}stdcall;{$ENDIF}
  end;

  {$IFDEF CLR}
  [ComImport, InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)]
  {$ENDIF CLR}
  IACList2 = interface(IACList)
    ['{470141a0-5186-11d2-bbb6-0060977b464c}']
    {$IFDEF CLR}[PreserveSig]{$ENDIF CLR}
    function SetOptions(dwFlag: DWORD): HRESULT; {$IFNDEF CLR}stdcall;{$ENDIF}
    {$IFDEF CLR}[PreserveSig]{$ENDIF CLR}
    function GetOptions(var pdwFlag: DWORD): HRESULT; {$IFNDEF CLR}stdcall;{$ENDIF}
  end;

  {$IFDEF CLR}
  [ComImport, InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIUnknown)]
  {$ENDIF CLR}
  IObjMgr = interface(IUnknown)
    ['{00BB2761-6A77-11D0-a535-00c04fd7d062}']
    {$IFDEF CLR}[PreserveSig]{$ENDIF CLR}
    function Append(punk: IUnknown): HRESULT; {$IFNDEF CLR}stdcall;{$ENDIF}
    {$IFDEF CLR}[PreserveSig]{$ENDIF CLR}
    function Remove(punk: IUnknown): HRESULT; {$IFNDEF CLR}stdcall;{$ENDIF}
  end;

type
  { TDateHook is used to only have 1 hook per application for monitoring
    date changes;

    We can't use WM_WININICHANGE or CM_WININICHANGE in the controls
    itself, because it comes too early. (The Application object does the
    changing on receiving WM_WININICHANGE; The Application object receives it
    later than the forms, controls etc.
  }

  TDateHook = class(TObject)
  private
    FCount: Integer;
    FHooked: Boolean;
    FWinIniChangeReceived: Boolean;
  protected
    function FormatSettingsChange(var Msg: TMessage): Boolean;
    procedure Hook;
    procedure UnHook;
  public
    procedure Add;
    procedure Delete;
  end;

var
  GDateHook: TDateHook = nil;

{$ENDIF VCL}

var
  GDateImageIndex: TImageIndex = -1;
  GDefaultComboEditImagesList: TImageList = nil;
  GDirImageIndex: TImageIndex = -1;
  GFileImageIndex: TImageIndex = -1;
  {$IFDEF JVCLThemesEnabled}
  GDirImageIndexXP: TImageIndex = -1;
  GFileImageIndexXP: TImageIndex = -1;
  {$ENDIF JVCLThemesEnabled}

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

{$IFDEF VCL}

function FindMonitor(Handle: HMONITOR): TMonitor;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Screen.MonitorCount - 1 do
    if Screen.Monitors[I].Handle = Handle then
    begin
      Result := Screen.Monitors[I];
      Break;
    end;
end;

function DateHook: TDateHook;
begin
  if GDateHook = nil then
    GDateHook := TDateHook.Create;
  Result := GDateHook;
end;

{$ENDIF VCL}

function ClipFilename(const FileName: WideString; const Clip: Boolean): WideString;
var
  Params: WideString;
begin
  if WideFileExists(FileName) then
    Result := FileName
  else
  if WideDirectoryExists(FileName) then
    Result := IncludeTrailingPathDelimiter(FileName)
  else
  if Clip then
    SplitCommandLineW(FileName, Result, Params)
  else
    Result := FileName;
end;

function ExtFilename(const FileName: WideString): WideString;
begin
  if (Pos(' ', FileName) > 0) and (FileName[1] <> '"') then
    Result := Format('"%s"', [FileName])
  else
    Result := FileName;
end;

function NvlDate(DateValue, DefaultValue: TDateTime): TDateTime;
begin
  if DateValue = NullDate then
    Result := DefaultValue
  else
    Result := DateValue;
end;

{$IFDEF VisualCLX}

procedure DrawSelectedText(Canvas: TCanvas; const R: TRect; X, Y: Integer;
  const Text: WideString; SelStart, SelLength: Integer;
  HighlightColor, HighlightTextColor: TColor);
var
  W, H, Width: Integer;
  S: WideString;
  SelectionRect: TRect;
  Brush: TBrushRecall;
  PenMode: TPenMode;
  FontColor: TColor;
begin
  W := R.Right - R.Left;
  H := R.Bottom - R.Top;
  if (W <= 0) or (H <= 0) then
    Exit;

  S := Copy(Text, 1, SelStart);
  if S <> '' then
  begin
    WideCanvasTextRect(Canvas, R, X, Y, S);
    Inc(X, Canvas.TextWidth(S));
  end;

  S := Copy(Text, SelStart + 1, SelLength);
  if S <> '' then
  begin
    Width := Canvas.TextWidth(S);
    Brush := TBrushRecall.Create(Canvas.Brush);
    PenMode := Canvas.Pen.Mode;
    try
      SelectionRect := Rect(Max(X, R.Left), R.Top,
        Min(X + Width, R.Right), R.Bottom);
      Canvas.Pen.Mode := pmCopy;
      Canvas.Brush.Color := HighlightColor;
      Canvas.FillRect(SelectionRect);
      FontColor := Canvas.Font.Color;
      Canvas.Font.Color := HighlightTextColor;
      WideCanvasTextRect(Canvas, R, X, Y, S);
      Canvas.Font.Color := FontColor;
    finally
      Canvas.Pen.Mode := PenMode;
      Brush.Free;
    end;
    Inc(X, Width);
  end;

  S := Copy(Text, SelStart + SelLength + 1, MaxInt);
  if S <> '' then
    WideCanvasTextRect(Canvas, R, X, Y, S);
end;

{$ENDIF VisualCLX}

function ParentFormVisible(AControl: TControl): Boolean;
var
  Form: TCustomForm;
begin
  Form := GetParentForm(AControl);
  Result := Assigned(Form) and Form.Visible;
end;

//=== Global procedures ======================================================

procedure DateFormatChangedW;
var
  I: Integer;

  procedure IterateControls(AControl: TWinControl);
  var
    I: Integer;
  begin
    with AControl do
      for I := 0 to ControlCount - 1 do
      begin
        if Controls[I] is TTntJvCustomDateEdit then
          TTntJvCustomDateEdit(Controls[I]).UpdateMask
        else
        if Controls[I] is TWinControl then
          IterateControls(TWinControl(Controls[I]));
      end;
  end;

begin
  if Screen <> nil then
    for I := 0 to Screen.FormCount - 1 do
      IterateControls(Screen.Forms[I]);
end;

{$IFDEF VisualCLX}
function EditorTextMargins(Editor: TCustomEdit): TPoint;
var
  I: Integer;
  ed: TCustomEditAccessProtected;
begin
  ed := TCustomEditAccessProtected(Editor);
  if ed.BorderStyle = bsNone then
    I := 0
  else
  if Supports(Editor, IComboEditHelper) then
  begin