tntjvexcontrols.pas

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

    property About: TAboutInfo read FAbout write FAbout stored False;
  end;

  TJvExHintWindow0 = class(THintWindow, 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;
  end;

  TJvExPubGraphicControl0 = class(TJvExGraphicControl0)
  published
    property BiDiMode;
    property DragCursor;
    property DragKind;
    property DragMode;
    property ParentBiDiMode;
    property OnEndDock;
    property OnStartDock;
  end;

{-------------------Tnt Basic controls--------------------}

type
  TTntJvExControl = class (TJvExControl0)
  private
   {$IFDEF WithHintEditor}
    FHintEditor: TUnicodeLinesEditor;
   {$ENDIF}
    procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
    function  GetHint: WideString;
    procedure SetHint(const Value: WideString);
   {$IFDEF WithHintEditor}
    function  GetHintEditor: TUnicodeLinesEditor;
    procedure SetHintEditor(const Value: TUnicodeLinesEditor);
   {$ENDIF}
    function  IsCaptionStored: Boolean;
    function  IsHintStored: Boolean;
    function  GetText: TWideCaption;
  protected
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    procedure DefineProperties(Filer: TFiler); override;
    function  GetActionLinkClass: TControlActionLinkClass; override;
    procedure SetText(const Value: TWideCaption); virtual;
    property Caption: TWideCaption read GetText write SetText stored IsCaptionStored;
  public
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Hint: WideString read GetHint write SetHint stored IsHintStored;
   {$IFDEF WithHintEditor}
    property HintEditor: TUnicodeLinesEditor read GetHintEditor write SetHintEditor stored False;
   {$ENDIF}
  end;

  TTntJvExWinControl = class (TJvExWinControl0)
  private
   {$IFDEF WithHintEditor}
    FHintEditor: TUnicodeLinesEditor;
   {$ENDIF}
    procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
    function  GetHint: WideString;
    procedure SetHint(const Value: WideString);
   {$IFDEF WithHintEditor}
    function  GetHintEditor: TUnicodeLinesEditor;
    procedure SetHintEditor(const Value: TUnicodeLinesEditor);
   {$ENDIF}
    function  IsCaptionStored: Boolean;
    function  IsHintStored: Boolean;
    function  GetText: TWideCaption;
  protected
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure DefineProperties(Filer: TFiler); override;
    function  GetActionLinkClass: TControlActionLinkClass; override;
    procedure SetText(const Value: TWideCaption); virtual;
    property Caption: TWideCaption read GetText write SetText stored IsCaptionStored;
  public
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Hint: WideString read GetHint write SetHint stored IsHintStored;
   {$IFDEF WithHintEditor}
    property HintEditor: TUnicodeLinesEditor read GetHintEditor write SetHintEditor stored False;
   {$ENDIF}
  end;

  TTntJvExCustomControl = class (TJvExCustomControl0)
  private
   {$IFDEF WithHintEditor}
    FHintEditor: TUnicodeLinesEditor;
   {$ENDIF}
    procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
    function  GetHint: WideString;
    procedure SetHint(const Value: WideString);
   {$IFDEF WithHintEditor}
    function  GetHintEditor: TUnicodeLinesEditor;
    procedure SetHintEditor(const Value: TUnicodeLinesEditor);
   {$ENDIF}
    function  IsCaptionStored: Boolean;
    function  IsHintStored: Boolean;
    function  GetText: TWideCaption;
  protected
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure DefineProperties(Filer: TFiler); override;
    function  GetActionLinkClass: TControlActionLinkClass; override;
    procedure SetText(const Value: TWideCaption); virtual;
    property Caption: TWideCaption read GetText write SetText stored IsCaptionStored;
  public
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Hint: WideString read GetHint write SetHint stored IsHintStored;
   {$IFDEF WithHintEditor}
    property HintEditor: TUnicodeLinesEditor read GetHintEditor write SetHintEditor stored False;
   {$ENDIF}
  end;

  TTntJvExGraphicControl = class (TJvExGraphicControl0)
  private
   {$IFDEF WithHintEditor}
    FHintEditor: TUnicodeLinesEditor;
   {$ENDIF}
    procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
    function  GetHint: WideString;
    procedure SetHint(const Value: WideString);
   {$IFDEF WithHintEditor}
    function  GetHintEditor: TUnicodeLinesEditor;
    procedure SetHintEditor(const Value: TUnicodeLinesEditor);
   {$ENDIF}
    function  IsCaptionStored: Boolean;
    function  IsHintStored: Boolean;
    function  GetText: TWideCaption;
  protected
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    procedure DefineProperties(Filer: TFiler); override;
    function  GetActionLinkClass: TControlActionLinkClass; override;
    procedure SetText(const Value: TWideCaption); virtual;
    property Caption: TWideCaption read GetText write SetText stored IsCaptionStored;
  public
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Hint: WideString read GetHint write SetHint stored IsHintStored;
   {$IFDEF WithHintEditor}
    property HintEditor: TUnicodeLinesEditor read GetHintEditor write SetHintEditor stored False;
   {$ENDIF}
  end;

  TTntJvExGraphicControlCE = class (TTntJvExGraphicControl)
  private
    FCaptionEditor: TUnicodeLinesEditor;
    function GetCaptionEditor: TUnicodeLinesEditor;
    procedure SetCaptionEditor(const Value: TUnicodeLinesEditor);
  protected
    property CaptionEditor: TUnicodeLinesEditor read GetCaptionEditor write SetCaptionEditor stored False;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvExControls.pas,v $';
    Revision: '$Revision: 1.91 $';
    Date: '$Date: 2006/01/24 17:31:03 $';
    LogPath: 'JVCL'run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  TypInfo, TntActnList;

(***
var
  InternalFocusedColor: TColor = TColor($00733800);
  InternalUnfocusedColor: TColor = clGray;

procedure SetDotNetFrameColors(FocusedColor, UnfocusedColor: TColor);
begin
  InternalFocusedColor := FocusedColor;
  InternalUnfocusedColor := UnfocusedColor;
end;

procedure DrawDotNetControl(Control: TWinControl; AColor: TColor; InControl: Boolean);
var
  DC: HDC;
  R: TRect;
  Canvas: TCanvas;
begin
  DC := GetWindowDC(Control.Handle);
  try
    GetWindowRect(Control.Handle, R);
    OffsetRect(R, -R.Left, -R.Top);
    Canvas := TCanvas.Create;
    with Canvas do
    try
      Handle := DC;
      Brush.Color := InternalUnfocusedColor;
      if Control.Focused or InControl then
        Brush.Color := InternalFocusedColor;
      FrameRect(R);
      InflateRect(R, -1, -1);
      if not (Control.Focused or InControl) then
        Brush.Color := AColor;
      FrameRect(R);
    finally
      Free;
    end;
  finally
    ReleaseDC(Control.Handle, DC);
  end;
end;

procedure HandleDotNetHighlighting(Control: TWinControl; const Msg: TMessage;
  MouseOver: Boolean; Color: TColor);
var
  Rgn, SubRgn: HRGN;
begin
  if not (csDesigning in Control.ComponentState) then
    case Msg.Msg of
      CM_MOUSEENTER, CM_MOUSELEAVE, WM_KILLFOCUS, WM_SETFOCUS, WM_NCPAINT:
        begin
          DrawDotNetControl(Control, Color, MouseOver);
          if Msg.Msg = CM_MOUSELEAVE then
          begin
            Rgn := CreateRectRgn(0, 0, Control.Width - 1, Control.Height - 1);
            SubRgn := CreateRectRgn(2, 2, Control.Width - 3, Control.Height - 3);
            try
              CombineRgn(Rgn, Rgn, SubRgn, RGN_DIFF);
              InvalidateRgn(Control.Handle, Rgn, False); // redraw 3D border
            finally
              DeleteObject(SubRgn);
              DeleteObject(Rgn);
            end;
          end;
        end;
    end;
end;

function CreateWMMessage(Msg: Integer; WParam: Integer; LParam: Longint): TMessage;
begin
  {$IFNDEF CLR}
  Result.Msg := Msg;
  Result.WParam := WParam;
  Result.LParam := LParam;
  {$ELSE}
  Result := TMessage.Create(Msg, WParam, LParam);
  {$ENDIF CLR}
  Result.Result := 0;
end;

function CreateWMMessage(Msg: Integer; WParam: Integer; LParam: TControl): TMessage;
begin
  {$IFNDEF CLR}
  Result := CreateWMMessage(Msg, WParam, Integer(LParam));
  {$ELSE}
  Result := CreateWMMessage(Msg, WParam, 0);
  {$ENDIF !CLR}
end;

{ TStructPtrMessage }
constructor TStructPtrMessage.Create(Msg: Integer; WParam: Integer; var LParam);
begin
  inherited Create;
  {$IFNDEF CLR}
  Self.Msg.Msg := Msg;
  Self.Msg.WParam := WParam;
  Self.Msg.LParam := Longint(@LParam);
  {$ELSE}
  FBuf := Marshal.AllocHGlobal(Marshal.SizeOf(TObject(LParam)));
  FLParam := &Object(LParam);
  Marshal.StructureToPtr(FLParam, FBuf, False);
  Self.Msg := TMessage.Create(Msg, WParam, Longint(FBuf));
  {$ENDIF !CLR}
  Self.Msg.Result := 0;
end;

{$IFDEF CLR}
destructor TStructPtrMessage.Destroy;
begin
  FLParam := Marshal.PtrToStructure(FBuf, TypeOf(FLParam));
  Marshal.DestroyStructure(FBuf, TypeOf(FLParam));
  inherited Destroy;
end;
{$ENDIF CLR}

function SmallPointToLong(const Pt: TSmallPoint): Longint;
begin
  {$IFDEF CLR}
  Result := Int32(Pt.X) shl 16 or Pt.Y;
  {$ELSE}
  Result := Longint(Pt);
  {$ENDIF CLR}
end;

function ShiftStateToKeyData(Shift: TShiftState): Longint;
const
  AltMask = $20000000;
  CtrlMask = $10000000;
  ShiftMask = $08000000;
begin
  Result := 0;
  if ssAlt in Shift then
    Result := Result or AltMask;
  if ssCtrl in Shift then
    Result := Result or CtrlMask;
  if ssShift in Shift then
    Result := Result or ShiftMask;
end;

function GetFocusedControl(AControl: TControl): TWinControl;
var
  Form: TCustomForm;
begin
  Result := nil;
  Form := GetParentForm(AControl);
  if Assigned(Form) then
    {$IFDEF VCL}
    Result := Form.ActiveControl;
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    Result := Form.FocusedControl;
    {$ENDIF VisualCLX}
end;

function DlgcToDlgCodes(Value: Longint): TDlgCodes;
begin
  Result := [];
  if (Value and DLGC_WANTARROWS) <> 0 then
    Include(Result, dcWantArrows);
  if (Value and DLGC_WANTTAB) <> 0 then
    Include(Result, dcWantTab);
  if (Value and DLGC_WANTALLKEYS) <> 0 then
    Include(Result, dcWantAllKeys);
  if (Value and DLGC_WANTCHARS) <> 0 then
    Include(Result, dcWantChars);
  if (Value and DLGC_BUTTON) <> 0 then
    Include(Result, dcButton);
  if (Value and DLGC_HASSETSEL) <> 0 then
    Include(Result, dcHasSetSel);
end;

function DlgCodesToDlgc(Value: TDlgCodes): Longint;
begin