Ver Mensaje Individual
  #4  
Antiguo 29-06-2007
Avatar de roman
roman roman is offline
Moderador
 
Registrado: may 2003
Ubicación: Ciudad de México
Posts: 20.269
Reputación: 10
roman Es un diamante en brutoroman Es un diamante en brutoroman Es un diamante en bruto
Para mostrar el cursor como un bloque se usa la función CreateCaret para especificar el tamaño, y ShowCaret para mostrar el nuevo cursor.

Lo malo es que el cursor tendría que crearse cada vez que se entra al control, para lo cual tenemos el evento OnEnter. Sin embargo, éste ocurre mientras la VCL está procesando el mensaje WM_SETFOCUS, y para cuando termina de hacerlo (despúes del OnEnter), el cursor vuelve a su forma original.

Entonces debemos manejar nosotros mismos dicho mensaje para asegurarnos de crear el cursor después de que el sistema termine de procesar WM_SETFOCUS. Para ello puede crearse un control derivado de TMemo, o bien, si es para un sólo memo, reemplazando al vuelo su manejador de mensajes:

Código Delphi [-]
TForm1 = class(TForm)
  Memo1: TMemo;
  procedure FormCreate(Sender: TObject);
  procedure Memo1Exit(Sender: TObject);

private
  OldMemoWndProc: TWndProc;
  procedure MemoWndProc(var Msg: TMessage);
end;

implementation

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Guardamos una referencia al método original
  OldMemoWndProc := Memo1.WindowProc;

  // Reemplazamos el manejador de mensajes de Memo1 por el nuestro
  Memo1.WindowProc := MemoWndProc;
end;

procedure TForm1.Memo1Exit(Sender: TObject);
begin
  // Destruimos el cursor al salir del control
  DestroyCaret();
end;

{
  Manejador de mensajes para Memo1
}
procedure TForm1.MemoWndProc(var Msg: TMessage);
var
  DC: HDC;
  TM: TextMetric;

begin
  // Llamamos al manejador original
  OldMemoWndProc(Msg);

  // Si es el mensaje WM_SETFOCUS, crear el cursor
  if Msg.Msg = WM_SETFOCUS then
  begin
    DC := GetDC(Handle);
    GetTextMetrics(DC, TM);
    ReleaseDC(Handle, DC);

    CreateCaret(Memo1.Handle, 0, TM.tmAveCharWidth, TM.tmHeight);
    ShowCaret(Memo1.Handle);
  end;
end;

end.

// Saludos

Última edición por roman fecha: 29-06-2007 a las 17:40:09.
Responder Con Cita