jvtooledit.pas

East make Tray Icon in delphi

  IACList2 = interface(IACList)
    ['{470141a0-5186-11d2-bbb6-0060977b464c}']
    function SetOptions(dwFlag: DWORD): HRESULT; stdcall;
    function GetOptions(var pdwFlag: DWORD): HRESULT; stdcall;
  end;

  IObjMgr = interface(IUnknown)
    ['{00BB2761-6A77-11D0-a535-00c04fd7d062}']
    function Append(punk: IUnknown): HRESULT; stdcall;
    function Remove(punk: IUnknown): HRESULT; stdcall;
  end;

  TAutoCompleteSource = class(TInterfacedObject, IEnumString)
  private
    FComboEdit: TJvCustomComboEdit;
    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: TJvCustomComboEdit; const StartIndex: Integer); virtual;
  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: string): string;
var
  Params: string;
begin
  if FileExists(FileName) then
    Result := FileName
  else
  if DirectoryExists(FileName) then
    Result := IncludeTrailingPathDelimiter(FileName)
  else
    SplitCommandLine(FileName, Result, Params);
end;

function ExtFilename(const FileName: string): string;
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
    Canvas.TextRect(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;
      Canvas.TextRect(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
    Canvas.TextRect(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 DateFormatChanged;
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 TJvCustomDateEdit then
          TJvCustomDateEdit(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
    if (Editor as IComboEditHelper).GetFlat then
      I := 1
    else
      I := 2;
  end
  else
    I := 2;
  {if GetWindowLong(ed.Handle, GWL_STYLE) and ES_MULTILINE = 0 then
    Result.X := (SendMessage(ed.Handle, EM_GETMARGINS, 0, 0) and $0000FFFF) + I
  else}
    Result.X := I;
  Result.Y := I;
end;
{$ENDIF VisualCLX}

{$IFDEF VCL}
function EditorTextMargins(Editor: TCustomEdit): TPoint;
var
  DC: HDC;
  I: Integer;
  SaveFont: HFONT;
  SysMetrics, Metrics: TTextMetric;
  ed: TCustomEditAccessProtected;
begin
  ed := TCustomEditAccessProtected(Editor);
  if NewStyleControls then
  begin
    if ed.BorderStyle = bsNone then
      I := 0
    else
    if ed.Ctl3D then
      I := 1
    else
      I := 2;
    if GetWindowLong(ed.Handle, GWL_STYLE) and ES_MULTILINE = 0 then
      Result.X := (SendMessage(ed.Handle, EM_GETMARGINS, 0, 0) and $0000FFFF) + I
    else
      Result.X := I;
    Result.Y := I;
  end
  else
  begin
    if ed.BorderStyle = bsNone then
      I := 0
    else
    begin
      DC := GetDC(HWND_DESKTOP);
      GetTextMetrics(DC, SysMetrics);
      SaveFont := SelectObject(DC, ed.Font.Handle);
      GetTextMetrics(DC, Metrics);
      SelectObject(DC, SaveFont);
      ReleaseDC(HWND_DESKTOP, DC);
      I := SysMetrics.tmHeight;
      if I > Metrics.tmHeight then
        I := Metrics.tmHeight;
      I := I div 4;
    end;
    Result.X := I;
    Result.Y := I;
  end;
end;
{$ENDIF VCL}

function IsInWordArray(Value: Word; const A: array of Word): Boolean;
var
  I: Integer;
begin
  Result := True;
  for I := 0 to High(A) do
    if A[I] = Value then
      Exit;
  Result := False;
end;

function LoadDefaultBitmap(Bmp: TBitmap; Item: Integer): Boolean;
begin
  {$IFDEF VCL}
  Bmp.Handle := LoadBitmap(0, PChar(Item));
  Result := Bmp.Handle <> 0;
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  Result := True;
  case Item of
    OBM_COMBO:
      begin
        Bmp.Width := QStyle_sliderLength(Application.Style.Handle);
        Bmp.Height := Bmp.Width;
        Bmp.Canvas.Start;
        DrawFrameControl(Bmp.Canvas.Handle, Rect(0, 0, Bmp.Width, Bmp.Height),
          DFC_SCROLL, DFCS_SCROLLDOWN);
        Bmp.Canvas.Stop;
      end;
  else
    Bmp.Width := 0;
    Bmp.Height := 0;
    Result := False;
  end;
  {$ENDIF VisualCLX}
end;

{$IFDEF VCL}

function PaintComboEdit(Editor: TJvCustomComboEdit; const AText: string;
  AAlignment: TAlignment; StandardPaint: Boolean;
  var ACanvas: TControlCanvas; var Msg: TWMPaint): Boolean;
begin
  if not (csDestroying in Editor.ComponentState) then
  begin
    Result := PaintEdit(Editor, AText, AAlignment, Editor.PopupVisible,
      Editor.FDisabledTextColor, StandardPaint, ACanvas, Msg);
  end
  else
    Result := True;
end;

{$ENDIF VCL}

{$IFDEF VisualCLX}

function PaintComboEdit(Editor: TJvCustomComboEdit; const AText: string;
  AAlignment: TAlignment; StandardPaint: Boolean; Flat: Boolean;
  ACanvas: TCanvas): Boolean;
begin
  if not (csDestroying in Editor.ComponentState) then
  begin
    Result := PaintEdit(Editor, AText, AAlignment, Editor.PopupVisible,
      Editor.FDisabledTextColor, StandardPaint, Flat, ACanvas);
  end
  else
    Result := True;
end;

{$ENDIF VisualCLX}

{$IFDEF VCL}

function PaintEdit(Editor: TCustomEdit; const AText: string;
  AAlignment: TAlignment; PopupVisible: Boolean; 
  DisabledTextColor: TColor; StandardPaint: Boolean;
  var ACanvas: TControlCanvas; var Msg: TWMPaint): Boolean;
const
  AlignStyle: array [Boolean, TAlignment] of DWORD =
    ((WS_EX_LEFT, WS_EX_RIGHT, WS_EX_LEFT),
    (WS_EX_RIGHT, WS_EX_LEFT, WS_EX_LEFT));
var
  LTextWidth, X: Integer;
  EditRect: TRect;
  DC: HDC;
  PS: TPaintStruct;
  S: string;
  ExStyle: DWORD;
  ed: TCustomEditAccessProtected;
begin
  Result := True;
  if csDestroying in Editor.ComponentState then
    Exit;
  ed := TCustomEditAccessProtected(Editor);
  if ed.UseRightToLeftAlignment then
    ChangeBiDiModeAlignment(AAlignment);
  if StandardPaint and not (csPaintCopy in ed.ControlState) then
  begin
    if SysLocale.MiddleEast and ed.HandleAllocated and (ed.IsRightToLeft) then
    begin { This keeps the right aligned text, right aligned }
      ExStyle := DWORD(GetWindowLong(ed.Handle, GWL_EXSTYLE)) and (not WS_EX_RIGHT) and
        (not WS_EX_RTLREADING) and (not WS_EX_LEFTSCROLLBAR);
      if ed.UseRightToLeftReading then
        ExStyle := ExStyle or WS_EX_RTLREADING;
      if ed.UseRightToLeftScrollBar then
        ExStyle := ExStyle or WS_EX_LEFTSCROLLBAR;
      ExStyle := ExStyle or
        AlignStyle[ed.UseRightToLeftAlignment, AAlignment];