tntjvedit.pas

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

    UpdateGroup;
  end;
end;

procedure TTntJvCustomEdit.DoEmptyValueEnter;
begin
  if (csDesigning in ComponentState) or not FIsLoaded or (EmptyValue = '') then
    Exit;
  if EmptyValue <> '' then
  begin
    if (inherited Text) = EmptyValue then
    begin
      inherited Text := '';
      FIsEmptyValue := False;
      if not (csDesigning in ComponentState) then
        Font.Color := FOldFontColor;
    end;
  end
  else
  if not (csDesigning in ComponentState) then
    Font.Color := FOldFontColor;
end;

procedure TTntJvCustomEdit.DoEmptyValueExit;
begin
  if (csDesigning in ComponentState) or not FIsLoaded or (EmptyValue = '') then
    Exit;
  if EmptyValue <> '' then
  begin
    if Text = '' then
    begin
      Text := EmptyValue;
      FIsEmptyValue := True;
      if not (csDesigning in ComponentState) then
      begin
        FOldFontColor := Font.Color;
        Font.Color := FEmptyFontColor;
      end;
    end;
  end
  else
  if not (csDesigning in ComponentState) then
    Font.Color := FOldFontColor;
end;

procedure TTntJvCustomEdit.DoEnter;
begin
  inherited DoEnter;
  DoEmptyValueEnter;
end;

procedure TTntJvCustomEdit.DoExit;
begin
  inherited DoExit;
  DoEmptyValueExit;
end;

procedure TTntJvCustomEdit.FocusKilled(NextWnd: THandle);
begin
  FCaret.DestroyCaret;
  inherited FocusKilled(NextWnd);
end;

function TTntJvCustomEdit.DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean;
var
  R: TRect;
begin
  if Enabled then
    Result := inherited DoEraseBackground(Canvas, Param)
  else
  begin
    Canvas.Brush.Color := FDisabledColor;
    Canvas.Brush.Style := bsSolid;
    R := ClientRect;
    Canvas.FillRect(R);
    Result := True;
    {$IFDEF VisualCLX}
    // paint Border
    if BorderStyle = bsSingle then
      QGraphics.DrawEdge(Canvas, R, esLowered, esLowered, ebRect);
    {$ENDIF VisualCLX}
  end;
end;

procedure TTntJvCustomEdit.FocusSet(PrevWnd: THandle);
begin
  inherited FocusSet(PrevWnd);
  FCaret.CreateCaret;
end;

procedure TTntJvCustomEdit.WMUndo(var Msg: TMessage);
begin
  if not ReadOnly then
    inherited;
end;

procedure TTntJvCustomEdit.EnabledChanged;
begin
  inherited EnabledChanged;
  Invalidate;
end;

function TTntJvCustomEdit.GetFlat: Boolean;
begin
  {$IFDEF VCL}
  Result := not Ctl3D;
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  Result := FFlat;
  {$ENDIF VisualClx}
end;

function TTntJvCustomEdit.GetPasswordChar: WideChar;
begin
  {$IFDEF VCL}
  if HandleAllocated then
    Result := WideChar(SendMessage(Handle, EM_GETPASSWORDCHAR, 0, 0))
  else
    Result := TntCustomEdit_GetPasswordChar(Self, FPasswordChar);
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  Result := FPasswordChar;
  {$ENDIF VisualCLX}
end;

function TTntJvCustomEdit.GetPopupMenu: TPopupMenu;
begin
  Result := inherited GetPopupMenu;
  {$IFDEF VCL}
  // user has not assigned his own popup menu, so use fixed default
  if (Result = nil) and UseFixedPopup then
    Result := FixedDefaultEditPopUp(Self);
  {$ENDIF VCL}
end;

// (ahuser) ProtectPassword has no function under CLX
function TTntJvCustomEdit.GetText: WideString;
var
  Tmp: Boolean;
begin
  Tmp := ProtectPassword;
  try
    ProtectPassword := False;
    {$IFDEF VCL}
    Result := TntControl_GetText(Self);
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    Result := inherited GetText;
    {$ENDIF VisualCLX}
  finally
    ProtectPassword := Tmp;
  end;

  if (Result = EmptyValue) and (EmptyValue <> '') then
    Result := '';
end;

{$IFDEF JVCLThemesEnabled}
function TTntJvCustomEdit.GetThemedFontHandle: HFONT;
var
  AFont: TLogFont;
begin
  GetObject(GetStockObject(DEFAULT_GUI_FONT), SizeOf(AFont), @AFont);
  AFont.lfHeight := Self.Font.Height;
  Result := CreateFontIndirect(AFont);
end;
{$ENDIF JVCLThemesEnabled}

function TTntJvCustomEdit.IsEmpty: Boolean;
begin
  Result := (Length(Text) = 0);
end;

{$IFDEF VCL}
function TTntJvCustomEdit.IsFlatStored: Boolean;
begin
  { Same as IsCtl3DStored }
  Result := not ParentCtl3D;
end;
{$ENDIF VCL}

function TTntJvCustomEdit.IsPasswordCharStored: Boolean;
begin
  Result := (PasswordChar <> #0) {$IFDEF JVCLThemesEnabled} and not ThemedPassword {$ENDIF};
end;

procedure TTntJvCustomEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  UpdateGroup;
  inherited KeyDown(Key, Shift);
end;

procedure TTntJvCustomEdit.Loaded;
begin
  inherited Loaded;
  { (rb) I think that csLoading flag can be used instead of FIsLoaded.
         FIsLoaded is set a bit later to true than csLoading but that
         does not matter AFAICS
  }
  FIsLoaded := True;
  FOldFontColor := Font.Color;
  SelStart := FStreamedSelStart;
  SelLength := FStreamedSelLength;
end;

procedure TTntJvCustomEdit.MaxPixelChanged(Sender: TObject);
var
  St: WideString;
begin
  St := Text;
  FMaxPixel.Test(St, Font);
  if St <> Text then
  begin
    Text := St;
    SelStart := Min(SelStart, Length(Text));
  end;
end;

procedure TTntJvCustomEdit.MouseEnter(AControl: TControl);
var
  I, J: Integer;
begin
  if csDesigning in ComponentState then
    Exit;
  if not MouseOver then
  begin
    if FHotTrack then
    begin
      I := SelStart;
      J := SelLength;
      Flat := False;
      SelStart := I;
      SelLength := J;
    end;
//    UpdateAutoHint;
    inherited MouseEnter(AControl);
  end;
end;

procedure TTntJvCustomEdit.MouseLeave(AControl: TControl);
var
  I, J: Integer;
begin
  if MouseOver then
  begin
    if FHotTrack then
    begin
      I := SelStart;
      J := SelLength;
      Flat := True;
      SelStart := I;
      SelLength := J;
    end;
    inherited MouseLeave(AControl);
  end;
end;

{$IFDEF VisualCLX}
procedure TTntJvCustomEdit.Paint;
var
  S: TCaption;
begin
  if csDestroying in ComponentState then
    Exit;
  if Enabled then
    inherited Paint
  else
  begin
    if PasswordChar = #0 then
      S := Text
    else
      S := StringOfChar(PasswordChar, Length(Text));
    if not PaintEdit(Self, S, FAlignment, False, {0,} FDisabledTextColor,
      Focused, Flat, Canvas) then
      inherited Paint;
  end;
end;
{$ENDIF VisualCLX}

procedure TTntJvCustomEdit.SetAlignment(Value: TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    {$IFDEF VCL}
    RecreateWnd;
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    inherited Alignment := FAlignment;
    Invalidate;
    {$ENDIF VisualCLX}
  end;
end;

procedure TTntJvCustomEdit.SetCaret(const Value: TJvCaret);
begin
  FCaret.Assign(Value);
end;

procedure TTntJvCustomEdit.SetClipboardCommands(const Value: TJvClipboardCommands);
begin
  if ClipboardCommands <> Value then
  begin
    inherited SetClipboardCommands(Value);
    ReadOnly := ClipboardCommands <= [caCopy];
  end;
end;

procedure TTntJvCustomEdit.SetDisabledColor(const Value: TColor);
begin
  if FDisabledColor <> Value then
  begin
    FDisabledColor := Value;
    if not Enabled then
      Invalidate;
  end;
end;

procedure TTntJvCustomEdit.SetDisabledTextColor(const Value: TColor);
begin
  if FDisabledTextColor <> Value then
  begin
    FDisabledTextColor := Value;
    if not Enabled then
      Invalidate;
  end;
end;

procedure TTntJvCustomEdit.SetEmptyValue(const Value: WideString);
begin
  FEmptyValue := Value;
  if HandleAllocated then
    if Focused then
      DoEmptyValueEnter
    else
      DoEmptyValueExit;
end;

procedure TTntJvCustomEdit.SetFlat(Value: Boolean);
begin
  {$IFDEF VCL}
  Ctl3D := not Value;
  {$ENDIF VCL}
  {$IFDEF VisualCLX}
  if Value <> FFlat then
  begin
    FFlat := Value;
    if FFlat then
      BorderStyle := bsNone
    else
      BorderStyle := bsSingle;
    Invalidate;
  end;
  {$ENDIF VisualCLX}
end;

procedure TTntJvCustomEdit.SetGroupIndex(Value: Integer);
begin
  if Value <> FGroupIndex then
  begin
    FGroupIndex := Value;
    UpdateGroup;
  end;
end;

procedure TTntJvCustomEdit.SetHotTrack(const Value: Boolean);
begin
  FHotTrack := Value;
  Flat := FHotTrack;
end;

procedure TTntJvCustomEdit.SetPasswordChar(const Value: WideChar);
var
  Tmp: Boolean;
begin
  Tmp := ProtectPassword;
  try
    ProtectPassword := False;
    {$IFDEF VCL}
    {
    if HandleAllocated then
      FPasswordChar := WideChar(SendMessage(Handle, EM_GETPASSWORDCHAR, 0, 0))
    else
    }
    TntCustomEdit_SetPasswordChar(Self, FPasswordChar, Value);
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    FPasswordChar := Value;
    Invalidate;
    {$ENDIF VisualCLX}
  finally
    ProtectPassword := Tmp;
  end;
end;

procedure TTntJvCustomEdit.SetSelLength(const Value: Integer);
begin
  if csReading in ComponentState then
    FStreamedSelLength := Value
  else
    inherited SetSelLength(Value);
end;

procedure TTntJvCustomEdit.SetSelStart(const Value: Integer);
begin
  if csReading in ComponentState then
    FStreamedSelStart := Value
  else
    inherited SetSelStart(Value);
end;

{$IFDEF VCL}

// (ahuser) ProtectPassword has no function under CLX

procedure TTntJvCustomEdit.SetText(const Value: WideString);
begin
  if (csLoading in ComponentState) or not FIsLoaded then
  begin
    TntControl_SetText(Self, Value);
    Exit;
  end;
  FIsEmptyValue := (Value = '') and (EmptyValue <> '');
  if not FIsEmptyValue then
  begin
    Font.Color := FOldFontColor;
    TntControl_SetText(Self, Value);
  end
  else
  begin
    Font.Color := FEmptyFontColor;
    TntControl_SetText(Self, EmptyValue);
  end;
end;

{$ENDIF VCL}

{$IFDEF JVCLThemesEnabled}

procedure TTntJvCustomEdit.SetThemedPassword(const Value: Boolean);
begin
  if FThemedPassword <> Value then
  begin
    FThemedPassword := Value;
    if not FThemedPassword then
      FreeAndNil(FThemedFont);
    PasswordChar := #0;
    RecreateWnd;
  end;
end;

{$ENDIF JVCLThemesEnabled}

procedure TTntJvCustomEdit.UpdateGroup;
var
  I: Integer;
begin
  if (FGroupIndex <> -1) and (Owner <> nil) then
    for I := 0 to Owner.ComponentCount - 1 do
      if (Owner.Components[I] is TTntJvCustomEdit) and (Owner.Components[I] <> Self) and
        (TTntJvCustomEdit(Owner.Components[I]).GroupIndex = Self.GroupIndex) then
        TTntJvCustomEdit(Owner.Components[I]).Clear;
end;

{$IFDEF VCL}
procedure TTntJvCustomEdit.WMPaint(var Msg: TWMPaint);
var
  Canvas: TControlCanvas;
  S: WideString;
begin
  if csDestroying in ComponentState then
    Exit;
  { PaintEdit does not work well when the edit is themed (and ThemedPassword=true),
    as a workaround check if the disabled colors are set to the default so
    the edit can paint itself (We must check both colors, although only
    DisabledTextColor is passed on to PaintEdit; PaintEdit triggers a
    DoEraseBackground call) }
  if Enabled or ((DisabledTextColor = clGrayText) and (DisabledColor = clWindow)) then
    inherited
  else
  begin
    if PasswordChar = #0 then
      S := Text
    else
      S := MakeStr(PasswordChar, Length(Text));
    Canvas := nil;
    try
      if not PaintEditW(Self, S, FAlignment, False, {0,} FDisabledTextColor,
        Focused, Canvas, Msg) then
        inherited;
    finally
      Canvas.Free;
    end;
  end;
end;
{$ENDIF VCL}

{$IFDEF JVCLThemesEnabled}
procedure TTntJvCustomEdit.WMSetFont(var Msg: TWMSetFont);
begin
  if ThemedPassword then
  begin
    // Retrieves MS Shell Dlg.
    // Other way is to use Screen.IconFont
    if FThemedFont = nil then
      FThemedFont := TFont.Create;
    FThemedFont.Handle := GetThemedFontHandle;
    Msg.Font := FThemedFont.Handle;
  end;
  inherited;
end;
{$ENDIF JVCLThemesEnabled}

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

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.