tntjvexmask.pas

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

procedure TJvExMaskEdit0.CursorChanged;
begin
  BaseWndProc(CM_CURSORCHANGED);
end;

procedure TJvExMaskEdit0.ShowingChanged;
begin
  BaseWndProc(CM_SHOWINGCHANGED);
end;

procedure TJvExMaskEdit0.ShowHintChanged;
begin
  BaseWndProc(CM_SHOWHINTCHANGED);
end;

{$IFNDEF CLR}
{ VCL sends CM_CONTROLLISTCHANGE and CM_CONTROLCHANGE in a different order than
  the CLX methods are used. So we must correct it by evaluating "Inserting". }
procedure TJvExMaskEdit0.ControlsListChanging(Control: TControl; Inserting: Boolean);
begin
  if Inserting then
    BaseWndProc(CM_CONTROLLISTCHANGE, Integer(Control), Integer(Inserting))
  else
    BaseWndProc(CM_CONTROLCHANGE, Integer(Control), Integer(Inserting));
end;

procedure TJvExMaskEdit0.ControlsListChanged(Control: TControl; Inserting: Boolean);
begin
  if not Inserting then
    BaseWndProc(CM_CONTROLLISTCHANGE, Integer(Control), Integer(Inserting))
  else
    BaseWndProc(CM_CONTROLCHANGE, Integer(Control), Integer(Inserting));
end;
{$ENDIF !CLR}

procedure TJvExMaskEdit0.GetDlgCode(var Code: TDlgCodes);
begin
end;

procedure TJvExMaskEdit0.FocusSet(PrevWnd: THandle);
begin
  BaseWndProc(WM_SETFOCUS, Integer(PrevWnd), 0);
end;

procedure TJvExMaskEdit0.FocusKilled(NextWnd: THandle);
begin
  BaseWndProc(WM_KILLFOCUS, Integer(NextWnd), 0);
end;

function TJvExMaskEdit0.DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean;
begin
  Result := BaseWndProc(WM_ERASEBKGND, Canvas.Handle, Param) <> 0;
end;

{$IFDEF JVCLThemesEnabledD56}
function TJvExMaskEdit0.GetParentBackground: Boolean;
begin
  Result := JvThemes.GetParentBackground(Self);
end;

procedure TJvExMaskEdit0.SetParentBackground(Value: Boolean);
begin
  JvThemes.SetParentBackground(Self, Value);
end;
{$ENDIF JVCLThemesEnabledD56}

procedure TJvExMaskEdit0.SetClipboardCommands(const Value: TJvClipboardCommands);
begin
  FClipboardCommands := Value;
end;

procedure TJvExMaskEdit0.WndProc(var Msg: TMessage);
var
  IdSaveDC: Integer;
  DlgCodes: TDlgCodes;
  Canvas: TCanvas;
  {$IFDEF CLR}
  AHintInfo: THintInfo;
  {$ENDIF CLR}
begin
  if not DispatchIsDesignMsg(Self, Msg) then
  begin
    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;
    CM_CURSORCHANGED:
      CursorChanged;
    CM_SHOWINGCHANGED:
      ShowingChanged;
    CM_SHOWHINTCHANGED:
      ShowHintChanged;
    {$IFNDEF CLR}
    CM_CONTROLLISTCHANGE:
      if Msg.LParam <> 0 then
        ControlsListChanging(TControl(Msg.WParam), True)
      else
        ControlsListChanged(TControl(Msg.WParam), False);
    CM_CONTROLCHANGE:
      if Msg.LParam = 0 then
        ControlsListChanging(TControl(Msg.WParam), False)
      else
        ControlsListChanged(TControl(Msg.WParam), True);
    {$ENDIF !CLR}
    WM_SETFOCUS:
      FocusSet(THandle(Msg.WParam));
    WM_KILLFOCUS:
      FocusKilled(THandle(Msg.WParam));
    WM_SIZE:
      begin
        inherited WndProc(Msg);
        BoundsChanged;
      end;
    WM_ERASEBKGND:
      begin
        IdSaveDC := SaveDC(HDC(Msg.WParam)); // protect DC against Stock-Objects from Canvas
        Canvas := TCanvas.Create;
        try
          Canvas.Handle := HDC(Msg.WParam);
          Msg.Result := Ord(DoEraseBackground(Canvas, Msg.LParam));
        finally
          Canvas.Handle := 0;
          Canvas.Free;
          RestoreDC(HDC(Msg.WParam), IdSaveDC);
        end;
      end;
    WM_PRINTCLIENT, WM_PRINT: // VCL bug fix
      begin
        IdSaveDC := SaveDC(HDC(Msg.WParam)); // protect DC against changes
        try
          inherited WndProc(Msg);
        finally
          RestoreDC(HDC(Msg.WParam), IdSaveDC);
        end;
      end;
    WM_GETDLGCODE:
      begin
        inherited WndProc(Msg);
        DlgCodes := [dcNative] + DlgcToDlgCodes(Msg.Result);
        GetDlgCode(DlgCodes);
        if not (dcNative in DlgCodes) then
          Msg.Result := DlgCodesToDlgc(DlgCodes);
      end;
    WM_CLEAR:
      if caClear in ClipboardCommands then
        inherited WndProc(Msg)
      else
        Msg.Result := 1;
    WM_UNDO, EM_UNDO:
      if caUndo in ClipboardCommands then
        inherited WndProc(Msg)
      else
        Msg.Result := 1;
    WM_COPY:
      if caCopy in ClipboardCommands then
        inherited WndProc(Msg)
      else
        Msg.Result := 1;
    WM_CUT:
      if caCut in ClipboardCommands then
        inherited WndProc(Msg)
      else
        Msg.Result := 1;
    WM_PASTE:
      if caPaste in ClipboardCommands then
        inherited WndProc(Msg)
      else
        Msg.Result := 1;
    else
      inherited WndProc(Msg);
    end;
    if DotNetHighlighting then
      HandleDotNetHighlighting(Self, Msg, MouseOver, Color);
  end;
end;

procedure TJvExMaskEdit0.DoBeepOnError;
begin
  if FBeepOnError then
    SysUtils.Beep;
end;

procedure TJvExMaskEdit0.SetBeepOnError(Value: Boolean);
begin
  FBeepOnError := Value;
end;

{--------------------------------------}

procedure TTntJvExCustomMaskEdit.CreateWindowHandle(const Params: TCreateParams);
begin
  TntCustomEdit_CreateWindowHandle(Self, Params);
end;

procedure TTntJvExCustomMaskEdit.DefineProperties(Filer: TFiler);
begin
  inherited;
  TntPersistent_AfterInherited_DefineProperties(Filer, Self);
end;

function TTntJvExCustomMaskEdit.GetSelStart: Integer;
begin
  Result := TntCustomEdit_GetSelStart(Self);
end;

procedure TTntJvExCustomMaskEdit.SetSelStart(const Value: Integer);
begin
  TntCustomEdit_SetSelStart(Self, Value);
end;

function TTntJvExCustomMaskEdit.GetSelLength: Integer;
begin
  Result := TntCustomEdit_GetSelLength(Self);
end;

procedure TTntJvExCustomMaskEdit.SetSelLength(const Value: Integer);
begin
  TntCustomEdit_SetSelLength(Self, Value);
end;

function TTntJvExCustomMaskEdit.GetSelText: WideString;
begin
  Result := TntCustomEdit_GetSelText(Self);
end;

procedure TTntJvExCustomMaskEdit.SetSelText(const Value: WideString);
begin
  TntCustomEdit_SetSelText(Self, Value);
end;

function TTntJvExCustomMaskEdit.GetText: WideString;
begin
  Result := TntControl_GetText(Self);
end;

procedure TTntJvExCustomMaskEdit.SetText(const Value: WideString);
begin
  TntControl_SetText(Self, Value);
end;

function TTntJvExCustomMaskEdit.IsHintStored: Boolean;
begin
  Result := TntControl_IsHintStored(Self);
end;

function TTntJvExCustomMaskEdit.GetHint: WideString;
begin
  Result := TntControl_GetHint(Self)
end;

procedure TTntJvExCustomMaskEdit.SetHint(const Value: WideString);
begin
  TntControl_SetHint(Self, Value);
end;

{$IFDEF WithHintEditor}
function TTntJvExCustomMaskEdit.GetHintEditor: TUnicodeLinesEditor;
begin
  Result := FHintEditor;
  FHintEditor.SetText (Hint);
end;

procedure TTntJvExCustomMaskEdit.SetHintEditor(
  const Value: TUnicodeLinesEditor);
begin
  FHintEditor.Assign (Value);
  Hint := FHintEditor.GetText;
end;
{$ENDIF}

procedure TTntJvExCustomMaskEdit.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
  TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
  inherited;
end;

function TTntJvExCustomMaskEdit.GetActionLinkClass: TControlActionLinkClass;
begin
  Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
end;

procedure TTntJvExCustomMaskEdit.KeyPressTnt(var Key: WideChar); {JMN}
begin
  if Assigned(FOnTntKeyPress) then FOnTntKeyPress(Self, Key);
end;

function TTntJvExCustomMaskEdit.DoKeyPressTnt(var Message: TWMKey): Boolean; {JMN}
var
  Ch: WideChar;
  W: Word;
begin
  Result := True;
  if not (csNoStdEvents in ControlStyle) then
    with Message do
    begin
      if  Unused = 0
      then  Ch := WideChar (CharCode)
      else  Ch := WideChar (Unused);
      KeyPressTnt(Ch);
      W := Word(Ch);
      if  W > 255  then  begin
        CharCode := 255;
        Unused := W;
      end
      else  begin
        CharCode := W;
        Unused := 0;
      end;
      if Char(CharCode) = #0 then Exit;
    end;
  Result := False;
end;

procedure TTntJvExCustomMaskEdit.WMChar(var Message: TWMChar); {JMN}
begin
  if  not (Assigned(FOnTntKeyPress)) and not (Assigned(OnKeyPress))  then  begin
    if  not DoKeyPress(Message)  then  inherited;
  end
  else if
    (Assigned(FOnTntKeyPress) and (not DoKeyPressTnt(Message))) or
     (Assigned(OnKeyPress) and (not DoKeyPress(Message))) then inherited;
end;

{-PUBLIC-----------}

constructor TTntJvExCustomMaskEdit.Create(AOwner: TComponent);
begin
  inherited;
 {$IFDEF WithHintEditor}
  if  csDesigning in ComponentState
  then  FHintEditor := TUnicodeLinesEditor.Create;
 {$ENDIF}
end;

destructor TTntJvExCustomMaskEdit.Destroy;
begin
 {$IFDEF WithHintEditor}
  if  csDesigning in ComponentState
  then  FHintEditor.Free;
 {$ENDIF}
  inherited;
end;

{--------------------------------------}

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

{$UNDEF CONSTRUCTOR_CODE} // undefine at file end

end.