Blinkende Cursor aus Memo-Feld entfernen

[Jens Schumann]

Hallo Adminstrator,
ich weiss jetzt nicht ob es hier richtig ist einen Beitrag zur Code-Library zu posten. (Feedback wäre nicht schlecht)

Es geht um folgendes Thema :
Code-Library -> Library: VCL-Komponenten
Blinkende Cursor aus Memo-Feld entfernen
Link

Hier habe ich eine mit D6 getestete Lösung, wie beim einem ReadOnly Memo
der Cursor verschwindet und man trotzdem noch markieren und kopieren kann

Lösung:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, Menus;

type
  TForm1 = class(TForm)
    Memo11: TMemo;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
    FWndProc  : TWndMethod;
    procedure MemoWndProc(var Msg: TMessage);
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.MemoWndProc(var Msg: TMessage);
begin
  if Msg.Msg = WM_SETFOCUS then
  begin
    HideCaret(Memo11.Handle); // Cursor verstecken
    Msg.Result := 0;
  end else 
    FWndProc(Msg); // alte Fensterproceure aufrufen
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  FWndProc := Memo11.WindowProc; // alte Fensterproceure merken
  Memo11.WindowProc := MemoWndProc; // Fensterproceure auf eigene Fensterprocedure umbiegen
end;


end.

Achtung: ReadOnly muss auf True stehen un HideSelection auf False

[edit=Matze]Code formatiert. Mfg, Matze[/edit]
[edit=flomei]Link zum Ursprungsthema eingefügt. Mfg, flomei[/edit]

[toms]

Hier noch eine andere Möglichkeit, das Caret zu verstecken. Dabei läßt sich, im Gegensatz zur oben gezeigten Methode, Text weiterhin markieren.

Delphi-Quellcode:

unit MyRichEdit;

interface

uses
  SysUtils, Classes, Controls, StdCtrls, ComCtrls, Messages;

type
  TMyRichEdit = class(TRichEdit)
  private
    FShowCaret: Boolean;
    procedure SetShowCaret(const Value: boolean);
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LButtonDown;
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KeyDown;
    procedure HideTheCaret;
  protected
  public
    constructor Create(AOwner: TComponent); override;
  published
    property ShowCaret: Boolean read FShowCaret write SetShowCaret;
  end;

procedure Register;

implementation

uses Windows;

procedure Register;
begin
  RegisterComponents('Samples', [TMyRichEdit]);
end;

{ TMyRichEdit }

procedure TMyRichEdit.HideTheCaret;
begin
  if not FShowCaret then
    CreateCaret(Handle, 0, 0, 0);
end;

constructor TMyRichEdit.Create(AOwner: TComponent);
begin
  inherited;
  FShowCaret := False;
end;

procedure TMyRichEdit.SetShowCaret(const Value: boolean);
begin
  FShowCaret := Value;
end;

procedure TMyRichEdit.WMKeyDown(var Message: TWMKeyDown);
begin
  inherited;
  if Assigned(Parent) then
    HideTheCaret;
end;

procedure TMyRichEdit.WMLButtonDown(var Message: TWMLButtonDown);
begin
  inherited;
  if Assigned(Parent) then
    HideTheCaret;
end;

procedure TMyRichEdit.WMPaint(var Message: TWMPaint);
begin
  inherited;
  if Assigned(Parent) then
    HideTheCaret;
end;