tntjvmemo.pas

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

  inherited Change;
end;

procedure TTntJvCustomMemo0.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  if Transparent then
    Params.ExStyle := Params.ExStyle or WS_EX_TRANSPARENT
  else
    Params.ExStyle := Params.ExStyle and not WS_EX_TRANSPARENT;
end;

function TTntJvCustomMemo0.CharOfLine(iLine: Integer): Integer;
begin
  Result := Perform(EM_LINEINDEX, iLine, 0);
end;

function TTntJvCustomMemo0.GetCurrentLine: Integer;
begin
  Result := Perform(EM_LINEFROMCHAR, -1, 0);
end;

procedure TTntJvCustomMemo0.KeyPress(var Key: Char);
begin
  { only process if maxlines is set }
  if MaxLines > 0 then
    if Lines.Count >= MaxLines then
    begin
      { take steps to halt the overflow }

      { no returns - that would make another line }
      if CharIsReturn(Key) then
        Key := #0;

      { no text at the end except for delete & backspace }
      if (CurrentLine >= MaxLines) and not (Key = AnsiBackSpace) then
        Key := #0;
    end;

  inherited KeyPress(Key);
end;

procedure TTntJvCustomMemo0.LineScroll(X, Y: Integer);
begin
  Perform(EM_LINESCROLL, X, Y);
end;

procedure TTntJvCustomMemo0.SetCurrentLine(NewLine: Integer);
var
  Delta: Integer;
begin
  { truncate the range }
  if NewLine >= Lines.Count then
    NewLine := Lines.Count - 1;
  if NewLine < 0 then
    NewLine := 0;

  Delta := NewLine - CurrentLine;
  { e.g want to be at line 10, currently on line 8, delta = 2
   on want to be on line 5, currently line 15, delta = -10 }
  if Delta <> 0 then
  begin
    { scroll into view }
    LineScroll(0, Delta);
    { move caret }
    SelStart := CharOfLine(NewLine);
  end;
end;

procedure TTntJvCustomMemo0.SetTransparent(Value: Boolean);
begin
  if Value <> FTransparent then
  begin
    FTransparent := Value;
    RecreateWnd;
    Invalidate;
  end;
end;

procedure TTntJvCustomMemo0.CaretChange(Sender: TObject);
begin
  FCaret.CreateCaret;
end;

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

procedure TTntJvCustomMemo0.FocusSet(PrevWnd: THandle);
begin
  inherited FocusSet(PrevWnd);
  FCaret.CreateCaret;
  if FHideCaret then
    Windows.HideCaret(Handle);
end;

procedure TTntJvCustomMemo0.SetMaxLines(const Value: Integer);
begin
  if FMaxLines <> Value then
  begin
    if FMaxLines = 0 then
      // save original content
      FOrigLines.Assign(Lines);
    FMaxLines := Value;
    if FMaxLines = 0 then
      // restore original content
      Lines.Assign(FOrigLines);
    Change;
  end;
end;

procedure TTntJvCustomMemo0.SetLines(const Value: TTntStrings);
begin
  inherited SetLines(Value);
  if MaxLines > 0 then
    // save original content
    FOrigLines.Assign(Value);
  Change;
end;

procedure TTntJvCustomMemo0.SetHideCaret(const Value: Boolean);
begin
  if FHideCaret <> Value then
    FHideCaret := Value;
end;

procedure TTntJvCustomMemo0.FocusKilled(NextWnd: THandle);
begin
  if FHideCaret then
    ShowCaret(Handle);
  FCaret.DestroyCaret;
  inherited FocusKilled(NextWnd);
end;

procedure TTntJvCustomMemo0.WndProc(var Msg: TMessage);

  procedure Scroll(Msg, ScrollCode: Integer);
  begin
    Perform(Msg, ScrollCode, 0);
    Perform(Msg, SB_ENDSCROLL, 0);
  end;

begin
  if FHideCaret and not (csDesigning in ComponentState) then
  begin
    case Msg.Msg of
      WM_LBUTTONDOWN, WM_LBUTTONUP, WM_MOUSEMOVE,
      WM_LBUTTONDBLCLK, WM_CHAR, WM_KEYUP:
        begin
          Msg.Result := 0;
          if Msg.Msg = WM_LBUTTONDOWN then
            if not Focused then
              SetFocus;
          Exit;
        end;
      WM_KEYDOWN:
        begin
          case Msg.WParam of
            VK_DOWN:
              Scroll(WM_VSCROLL, SB_LINEDOWN);
            VK_UP:
              Scroll(WM_VSCROLL, SB_LINEUP);
            VK_LEFT:
              Scroll(WM_HSCROLL, SB_LINELEFT);
            VK_RIGHT:
              Scroll(WM_HSCROLL, SB_LINERIGHT);
            VK_NEXT:
              Scroll(WM_VSCROLL, SB_PAGEDOWN);
            VK_PRIOR:
              Scroll(WM_VSCROLL, SB_PAGEUP);
            VK_HOME:
              Scroll(WM_VSCROLL, SB_TOP);
            VK_END:
              Scroll(WM_VSCROLL, SB_BOTTOM);
          end;
          Msg.Result := 0;
          Exit;
        end;
    end;
  end;
  inherited WndProc(Msg);
end;

procedure TTntJvCustomMemo0.WMPaint(var Msg: TWMPaint);
var
  DC: HDC;
begin
  DC := GetDC(Handle);
  if Transparent then
    SetBkMode(DC, Windows.TRANSPARENT)
  else
    SetBkMode(DC, Windows.OPAQUE);
  ReleaseDC(Handle, DC);
  inherited;
end;

function TTntJvCustomMemo0.DoEraseBackground(Canvas: TCanvas; Param: Integer): Boolean;
begin
  if not Transparent then
    Result := inherited DoEraseBackground(Canvas, Param)
  else
    Result := False;
end;

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

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

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

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

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

{ TTntJvCustomMemo }

constructor TTntJvCustomMemo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAlignment := taLeftJustify;
end;

procedure TTntJvCustomMemo.CreateParams(var Params: TCreateParams);
const
  {$IFDEF JVCLThemesEnabled}
  //Passwords: array [Boolean] of DWORD = (0, ES_PASSWORD);
  {$ENDIF JVCLThemesEnabled}
  Styles: array [TAlignment] of DWORD = (ES_LEFT, ES_RIGHT, ES_CENTER);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or Styles[FAlignment];
  {$IFDEF JVCLThemesEnabled}
  //Params.Style := Params.Style or Passwords[ThemedPassword];
  {$ENDIF JVCLThemesEnabled}
  if (FAlignment <> taLeftJustify) and (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
    (Win32MajorVersion = 4) and (Win32MinorVersion = 0) then
    Params.Style := Params.Style or ES_MULTILINE; // needed for Win95
end;

procedure TTntJvCustomMemo.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;

end.