tntjvexextctrls.pas

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

  private
 {$IFDEF WithHintEditor}
  private
    FHintEditor: TUnicodeLinesEditor;
    function GetHintEditor: TUnicodeLinesEditor;
    procedure SetHintEditor(const Value: TUnicodeLinesEditor);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property HintEditor: TUnicodeLinesEditor read GetHintEditor write SetHintEditor stored False;
 {$ENDIF}
  end;

  TTntJvExRadioGroup = class(TTntJvExRadioGroup0)
 {$IFDEF WithHintEditor}
  private
    FHintEditor: TUnicodeLinesEditor;
    function GetHintEditor: TUnicodeLinesEditor;
    procedure SetHintEditor(const Value: TUnicodeLinesEditor);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property HintEditor: TUnicodeLinesEditor read GetHintEditor write SetHintEditor stored False;
 {$ENDIF}
  end;


// SplitterMouseDownFix fixes a bug in the VCL that causes the splitter to no
// more work with the control in the left/top of it when the control has a size
// of 0. This is actually a TWinControl.AlignControl bug.
procedure SplitterMouseDownFix(Splitter: TSplitter);

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvExExtCtrls.pas,v $';
    Revision: '$Revision: 1.64 $';
    Date: '$Date: 2005/10/12 21:26:16 $';
    LogPath: 'JVCL'run'
  );
{$ENDIF UNITVERSIONING}

implementation

constructor TTntJvExShape0.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FHintColor := clDefault;
end;

function TTntJvExShape0.BaseWndProc(Msg: Integer; WParam: Integer = 0; LParam: Longint = 0): Integer;
var
  Mesg: TMessage;
begin
  Mesg := CreateWMMessage(Msg, WParam, LParam);
  inherited WndProc(Mesg);
  Result := Mesg.Result;
end;

function TTntJvExShape0.BaseWndProc(Msg: Integer; WParam: Integer; LParam: TControl): Integer;
var
  Mesg: TMessage;
begin
  Mesg := CreateWMMessage(Msg, WParam, LParam);
  inherited WndProc(Mesg);
  Result := Mesg.Result;
end;

function TTntJvExShape0.BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): Integer;
var
  Mesg: TStructPtrMessage;
begin
  Mesg := TStructPtrMessage.Create(Msg, WParam, LParam);
  try
    inherited WndProc(Mesg.Msg);
  finally
    Result := Mesg.Msg.Result;
    Mesg.Free;
  end;
end;

procedure TTntJvExShape0.VisibleChanged;
begin
  BaseWndProc(CM_VISIBLECHANGED);
end;

procedure TTntJvExShape0.EnabledChanged;
begin
  BaseWndProc(CM_ENABLEDCHANGED);
end;

procedure TTntJvExShape0.TextChanged;
begin
  BaseWndProc(CM_TEXTCHANGED);
end;

procedure TTntJvExShape0.FontChanged;
begin
  BaseWndProc(CM_FONTCHANGED);
end;

procedure TTntJvExShape0.ColorChanged;
begin
  BaseWndProc(CM_COLORCHANGED);
end;

procedure TTntJvExShape0.ParentFontChanged;
begin
  BaseWndProc(CM_PARENTFONTCHANGED);
end;

procedure TTntJvExShape0.ParentColorChanged;
begin
  BaseWndProc(CM_PARENTCOLORCHANGED);
  if Assigned(OnParentColorChange) then
    OnParentColorChange(Self);
end;

procedure TTntJvExShape0.ParentShowHintChanged;
begin
  BaseWndProc(CM_PARENTSHOWHINTCHANGED);
end;

function TTntJvExShape0.WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean;
begin
  Result := BaseWndProc(CM_DIALOGCHAR, Word(Key), ShiftStateToKeyData(Shift)) <> 0;
end;

function TTntJvExShape0.HitTest(X, Y: Integer): Boolean;
begin
  Result := BaseWndProc(CM_HITTEST, 0, SmallPointToLong(PointToSmallPoint(Point(X, Y)))) <> 0;
end;

function TTntJvExShape0.HintShow(var HintInfo: THintInfo): Boolean;
begin
  GetHintColor(HintInfo, Self, FHintColor);
  Result := BaseWndProcEx(CM_HINTSHOW, 0, HintInfo) <> 0;
end;

procedure TTntJvExShape0.MouseEnter(AControl: TControl);
begin
  FMouseOver := True;
  {$IFDEF VCL}
  if Assigned(FOnMouseEnter) then
    FOnMouseEnter(Self);
  {$ENDIF VCL}
  BaseWndProc(CM_MOUSEENTER, 0, AControl);
end;

procedure TTntJvExShape0.MouseLeave(AControl: TControl);
begin
  FMouseOver := False;
  BaseWndProc(CM_MOUSELEAVE, 0, AControl);
  {$IFDEF VCL}
  if Assigned(FOnMouseLeave) then
    FOnMouseLeave(Self);
  {$ENDIF VCL}
end;

{$IFNDEF CLR}
procedure TTntJvExShape0.FocusChanged(AControl: TWinControl);
begin
  BaseWndProc(CM_FOCUSCHANGED, 0, AControl);
end;
{$ENDIF !CLR}

{$IFDEF COMPILER5}
{$IFNDEF HASAUTOSIZE}

procedure TTntJvExShape0.CMSetAutoSize(var Msg: TMessage);
begin
  SetAutoSize(Msg.WParam <> 0);
end;

procedure TTntJvExShape0.SetAutoSize(Value: Boolean);
begin
  TOpenControl_SetAutoSize(Self, Value);
end;

{$ENDIF !HASAUTOSIZE}
{$ENDIF COMPILER5}

procedure TTntJvExShape0.WndProc(var Msg: TMessage);
{$IFDEF CLR}
var
  AHintInfo: THintInfo;
{$ENDIF CLR}
begin
  if not DispatchIsDesignMsg(Self, Msg) then
  case Msg.Msg of
    CM_DENYSUBCLASSING:
      {$IFNDEF CLR}
      Msg.Result := Ord(GetInterfaceEntry(IJvDenySubClassing) <> nil);
      {$ELSE}
      Msg.Result := Integer(Supports(Self, IJvDenySubClassing));
      {$ENDIF !CLR}
    CM_DIALOGCHAR:
      with TCMDialogChar{$IFDEF CLR}.Create{$ENDIF}(Msg) do
        Result := Ord(WantKey(CharCode, KeyDataToShiftState(KeyData), WideChar(CharCode)));
    CM_HINTSHOW:
      {$IFNDEF CLR}
      with TCMHintShow(Msg) do
        Result := Integer(HintShow(HintInfo^));
      {$ELSE}
      with TCMHintShow.Create(Msg) do
      begin
        AHintInfo := HintInfo;
        Result := Integer(HintShow(AHintInfo));
        HintInfo := AHintInfo;
      end;
      {$ENDIF !CLR}
    CM_HITTEST:
      with TCMHitTest{$IFDEF CLR}.Create{$ENDIF}(Msg) do
        Result := Integer(HitTest(XPos, YPos));
    CM_MOUSEENTER:
      MouseEnter({$IFDEF CLR}nil{$ELSE}TControl(Msg.LParam){$ENDIF});
    CM_MOUSELEAVE:
      MouseLeave({$IFDEF CLR}nil{$ELSE}TControl(Msg.LParam){$ENDIF});
    CM_VISIBLECHANGED:
      VisibleChanged;
    CM_ENABLEDCHANGED:
      EnabledChanged;
    CM_TEXTCHANGED:
      TextChanged;
    CM_FONTCHANGED:
      FontChanged;
    CM_COLORCHANGED:
      ColorChanged;
    {$IFNDEF CLR}
    CM_FOCUSCHANGED:
      FocusChanged(TWinControl(Msg.LParam));
    {$ENDIF !CLR}
    CM_PARENTFONTCHANGED:
      ParentFontChanged;
    CM_PARENTCOLORCHANGED:
      ParentColorChanged;
    CM_PARENTSHOWHINTCHANGED:
      ParentShowHintChanged;
  else
    inherited WndProc(Msg);
  end;
end;

//============================================================================

constructor TTntJvExPaintBox0.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FHintColor := clDefault;
end;

function TTntJvExPaintBox0.BaseWndProc(Msg: Integer; WParam: Integer = 0; LParam: Longint = 0): Integer;
var
  Mesg: TMessage;
begin
  Mesg := CreateWMMessage(Msg, WParam, LParam);
  inherited WndProc(Mesg);
  Result := Mesg.Result;
end;

function TTntJvExPaintBox0.BaseWndProc(Msg: Integer; WParam: Integer; LParam: TControl): Integer;
var
  Mesg: TMessage;
begin
  Mesg := CreateWMMessage(Msg, WParam, LParam);
  inherited WndProc(Mesg);
  Result := Mesg.Result;
end;

function TTntJvExPaintBox0.BaseWndProcEx(Msg: Integer; WParam: Integer; var LParam): Integer;
var
  Mesg: TStructPtrMessage;
begin
  Mesg := TStructPtrMessage.Create(Msg, WParam, LParam);
  try
    inherited WndProc(Mesg.Msg);
  finally
    Result := Mesg.Msg.Result;
    Mesg.Free;
  end;
end;

procedure TTntJvExPaintBox0.VisibleChanged;
begin
  BaseWndProc(CM_VISIBLECHANGED);
end;

procedure TTntJvExPaintBox0.EnabledChanged;
begin
  BaseWndProc(CM_ENABLEDCHANGED);
end;

procedure TTntJvExPaintBox0.TextChanged;
begin
  BaseWndProc(CM_TEXTCHANGED);
end;

procedure TTntJvExPaintBox0.FontChanged;
begin
  BaseWndProc(CM_FONTCHANGED);
end;

procedure TTntJvExPaintBox0.ColorChanged;
begin
  BaseWndProc(CM_COLORCHANGED);
end;

procedure TTntJvExPaintBox0.ParentFontChanged;
begin
  BaseWndProc(CM_PARENTFONTCHANGED);
end;

procedure TTntJvExPaintBox0.ParentColorChanged;
begin
  BaseWndProc(CM_PARENTCOLORCHANGED);
  if Assigned(OnParentColorChange) then
    OnParentColorChange(Self);
end;

procedure TTntJvExPaintBox0.ParentShowHintChanged;
begin
  BaseWndProc(CM_PARENTSHOWHINTCHANGED);
end;

function TTntJvExPaintBox0.WantKey(Key: Integer; Shift: TShiftState; const KeyText: WideString): Boolean;
begin
  Result := BaseWndProc(CM_DIALOGCHAR, Word(Key), ShiftStateToKeyData(Shift)) <> 0;
end;

function TTntJvExPaintBox0.HitTest(X, Y: Integer): Boolean;
begin
  Result := BaseWndProc(CM_HITTEST, 0, SmallPointToLong(PointToSmallPoint(Point(X, Y)))) <> 0;
end;

function TTntJvExPaintBox0.HintShow(var HintInfo: THintInfo): Boolean;
begin
  GetHintColor(HintInfo, Self, FHintColor);
  Result := BaseWndProcEx(CM_HINTSHOW, 0, HintInfo) <> 0;
end;

procedure TTntJvExPaintBox0.MouseEnter(AControl: TControl);
begin
  FMouseOver := True;
  {$IFDEF VCL}
  if Assigned(FOnMouseEnter) then
    FOnMouseEnter(Self);
  {$ENDIF VCL}
  BaseWndProc(CM_MOUSEENTER, 0, AControl);
end;

procedure TTntJvExPaintBox0.MouseLeave(AControl: TControl);
begin
  FMouseOver := False;
  BaseWndProc(CM_MOUSELEAVE, 0, AControl);
  {$IFDEF VCL}
  if Assigned(FOnMouseLeave) then
    FOnMouseLeave(Self);
  {$ENDIF VCL}
end;

{$IFNDEF CLR}
procedure TTntJvExPaintBox0.FocusChanged(AControl: TWinControl);
begin
  BaseWndProc(CM_FOCUSCHANGED, 0, AControl);
end;
{$ENDIF !CLR}

{$IFDEF COMPILER5}
{$IFNDEF HASAUTOSIZE}

procedure TTntJvExPaintBox0.CMSetAutoSize(var Msg: TMessage);
begin
  SetAutoSize(Msg.WParam <> 0);
end;

procedure TTntJvExPaintBox0.SetAutoSize(Value: Boolean);
begin
  TOpenControl_SetAutoSize(Self, Value);
end;