Modified TEdit?
lazarus / 31-LCL

----------------------------------------------------------------------
Rave · 2014-08-17 20:01

Can anyone make version of TEdit that can show any text character as
"text cursor"/caret/whatever it's called instead of standard bar (|)?

----------------------------------------------------------------------
howardpc · 2014-08-17 20:58

The FPC RTL provides CreateCaret(), ShowCaret(), DestroyCaret() which
you can use with (say) Edit1.Handle and parameters for a bitmap you
supply. The normal caret is 2 pixels wide for most platforms, so your
bitmap version will look rather strange.

----------------------------------------------------------------------
Rave · 2014-08-18 10:58

Is it platform-independent? I plan on porting it to all platforms
supported by Lazarus so it can't be platform-specific.  Also which
unit "CreateCaret" is in?

----------------------------------------------------------------------
typo · 2014-08-18 12:07

http://lazarus-ccr.sourceforge.net/docs/lcl/lclintf/createcaret.html

----------------------------------------------------------------------
Rave · 2014-08-18 15:56

OK. I've got it to work a bit and I've got somewhat nice, dos-like
underscore, but now curious thing happen: When I move mouse outside
edit, caret moves back to top (had to move it bit downwards) and turns
into um... overscore (is that even a word). Here's my code:

Code: [Select]procedure TStoryProcessor.cmdMouseDown(Sender: TObject;
Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var  point:TPoint;
begin
  //set caret
  CreateCaret(cmd.Handle,0,16,2);
  GetCaretPos(point);
  SetCaretPos(point.x,point.y+20);
  ShowCaret(cmd.Handle);

end; 
I've even tried to put it into OnMouseLeave of edit, but to no result.

----------------------------------------------------------------------
typo · 2014-08-18 16:22

Because you have set 16,2 as the caret dimensions. Try:

Code: [Select]CreateCaret(cmd.Handle,0, 2, 16);

----------------------------------------------------------------------
Rave · 2014-08-18 20:15

Except this will make vertical bar (|) which I don't want. I want DOS-
like underscore.

----------------------------------------------------------------------
rvk · 2014-08-18 21:24

I'm just wondering why you are using the OnMouseDown?
That event isn't triggered if i use tab to go to the control.

Either way, i noticed that the cursor is reset quite frequently. You
could try doing this in OnEnter and OnChange. That way you catch a lot
more cursor-resets.

I think you need to do it in OnChange, OnKeyDown, OnEnter and on
OnClick.

Another way to go would be to create a bitmap for your caret which
doesn't need to be repositioned.

----------------------------------------------------------------------
taazz · 2014-08-18 21:48

1) make sure that the SetCaretPos takes the coordinates in pixels
http://msdn.microsoft.com/en-
us/library/windows/desktop/ms648405%28v=vs.85%29.aspx
2) Better use the GetCaretPos before creating your custom caret and
what ever it returns use it on the setcaretpos
3) read up on using custom carets http://msdn.microsoft.com/en-
us/library/windows/desktop/ms646968%28v=vs.85%29.aspx most of the info
should be directly usable in lcl.

----------------------------------------------------------------------
Rave · 2014-08-19 05:19

Tried your suggestion but caret is still being reset upwards if mouse
cursor is outside TEdit.

And so:
1) Already it is, seeing that I first get caret post and just add some
pixels so caret will be move downwards.
2) Tried that, no effect
3) Did that, didn't help.

QuoteAnother way to go would be to create a bitmap for your caret
which doesn't need to be repositioned.Thanks, rvk - actually using
bitmap was first idea, unfortunately it resulted in blank (invisible)
caret.

//edit: Here is my current code (refactored into separate procedure as
I was calling it in multiple places) that uses bitmaps and thus
results in invisible caret:
Code: [Select]procedure TStoryProcessor.caretset;
var
  point: TPoint;
  Bitmap:TBitmap;
begin
  Bitmap:=TBitmap.Create;
  bitmap.Width:=16;
  Bitmap.Height:=20;
  bitmap.Clear;
  bitmap.Canvas.Pen.Color:=RGB(0,0,0);
  Bitmap.Canvas.Brush.Color:=RGB(0,0,0);
  bitmap.Canvas.FillRect(0,16,15,19);
  CreateCaret(cmd.Handle, Bitmap.Handle, 16, 2);
  GetCaretPos(point);
  SetCaretPos(point.x, point.y+20);
  ShowCaret(cmd.Handle);
  Bitmap.Free;
end;

----------------------------------------------------------------------
rvk · 2014-08-19 11:55

This gives me a blinking underscore cursor (of 8 pixels wide) for
Edit1.
Set it in OnEnter (not OnMouseDown) so it is set when you enter it
(even when tabbing to it).

According to the documentation you also need to destroy the caret when
loosing focus (en creating it again when gaining focus) but i didn't
do this here and it worked fine.

(I'll leave expanding the cursor to 16 wide up to you  )

Code: [Select]procedure DoCaret(Edit1: TEdit);
const
  Underscore: array[0..19] of Word =
     ($00, $00, $00, $00, $00, $00, $00, $00, $00, $00,
      $00, $00, $00, $00, $FF, $FF, $00, $00, $00, $00);
var
  Bm: HBITMAP;
begin
  Bm := CreateBitmap(8, 20, 1, 1, @Underscore);
  CreateCaret(edit1.Handle, Bm, 0, 0);
  ShowCaret(edit1.Handle);
end;

procedure TForm1.Edit1Enter(Sender: TObject);
begin
  DoCaret(TEdit(Sender));
end;

----------------------------------------------------------------------
Rave · 2014-08-19 14:07

Don't understand bitmap's format (array), therefore some explanation
would be appreciated.

----------------------------------------------------------------------
rvk · 2014-08-19 15:06

Quote from: Rave on August 19, 2014, 04:07:12 pmDon't understand
bitmap's format (array), therefore some explanation would be
appreciated.
Looking at CreateCaret you need to use CreateBitmap, CreateDIBitmap,
or LoadBitmap function to create the bitmap.
Looking at CreateBitmap it says:
QuoteA pointer to an array of color data used to set the colors in a
rectangle of pixels. Each scan line in the rectangle must be word
aligned (scan lines that are not word aligned must be padded with
zeros).So the array must be word aligned. (That's where the normal
bitmap probably goes wrong.)
We use 1 for the cPlanes and 1 for the cBitsPerPel. So even for 8
pixels (1 byte) we still need a Word to have Word aligned.

For 4 pixels wide we would only need $0F. But $FF doesn't hurt because
only nWidth bits is taken from the $FF.
When you want bigger lines you need to expand the $FF. For example for
16pixel scanlines we need $FFFF.
We're still within the Word-range so we can just change the $FF in
$FFFF.
Code: [Select]procedure DoCaret(Edit1: TEdit);
const
  Underscore: array[0..19] of Word =
     ($0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
$0000,
      $0000, $0000, $0000, $0000, $FFFF, $FFFF, $0000, $0000, $0000,
$0000);
var
  Bm: HBITMAP;
begin
  Bm := CreateBitmap(16, 20, 1, 1, @Underscore);
  CreateCaret(edit1.Handle, Bm, 0, 0);
  ShowCaret(edit1.Handle);
end;

procedure TForm1.Edit1Enter(Sender: TObject);
begin
  DoCaret(TEdit(Sender));
end;

You could change 16 to 12 (or 8 ) without problems because, again,
CreateBitmap only takes the nWidth bits.
If you want something bigger than 16 you'll need to add a word besides
every scanline but it still needs to be a word.
For 24 pixels wide you would need "$FFFF, $00FF" per scanline but
"$FFFF, $FFFF" would also do because only the first 24 bit would be
taken.

Personally i find 16 pixels wide a bit too large. 8 pixels gives a
more proportionally better caret compared to the font in the TEdit.

(color-carets would be a whole different story. This was just for 1bit
plane)

I hope i explained it correctly and clear.

----------------------------------------------------------------------
howardpc · 2014-08-19 16:39

Quote from: rvk on August 19, 2014, 01:55:15 pmAccording to the
documentation you also need to destroy the caret when loosing focus
(en creating it again when gaining focus) but i didn't do this here
and it worked fine.

Thanks for delving into this and providing such a clear, well-
explained example.
If you don't call DestroyCaret() it does not cause any memory leak in
your Lazarus program, but I think it will cause a (minuscule) loss of
internal OS resources.

----------------------------------------------------------------------
rvk · 2014-08-19 17:27

Quote from: howardpc on August 19, 2014, 06:39:32 pm... but I think it
will cause a (minuscule) loss of internal OS resources.
I was just wondering about that. The documentation says that with
CreateCaret the previous caret will be destroyed. So DestroyCaret
would not do too much (although it is better practice to destroy the
caret on loosing focus).

But what about the CreateBitmap? If the TEdit re-gains a lot of focus
each time the bitmap is re-created. This could result in a lot more
memory loss than anticipated. At least i don't think DestroyCaret
would release the bitmap, would it?

But for the Create- and DestroyCaret... we should be doing this in the
WM_SETFOCUS and WM_KILLFOCUS. Like the example below.
I re-use the created bitmap each time the TEdit re-gains control so
the maximum memory loss here is the amount of the bitmap times the
number of TEdits.

We could also do a DeleteObject in WM_KILLFOCUS but then the bitmap
needs to be recreated each time the TEdit re-gains focus (maybe not a
bad thing though). I commented those instructions out.

At least this way does conform to the documentation about destroying
the caret when loosing focus.

Code: [Select]unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
StdCtrls,
  ExtCtrls, Windows;

type
  TEdit = class(StdCtrls.TEdit)
  protected
    NewCaretBitmap: HBITMAP;
    procedure WMSetFocus(var Message: TWMSetFocus); message
WM_SETFOCUS;
    procedure WMKillFocus(var Message: TWMKillFocus); message
WM_KILLFOCUS;
  end;

  { TForm1 }

  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

const
  Underscore: array[0..19] of word =
    ($0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000, $0000,
$0000,
    $0000, $0000, $0000, $0000, $FFFF, $FFFF, $0000, $0000, $0000,
$0000);

procedure TEdit.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  if NewCaretBitmap = 0 then
    NewCaretBitmap := CreateBitmap(8, 20, 1, 1, @Underscore);
  CreateCaret(Self.Handle, NewCaretBitmap, 0, 0);
  ShowCaret(Self.Handle);
end;

procedure TEdit.WMKillFocus(var Message: TWMKillFocus);
begin
  inherited;
  DestroyCaret;

  // should we do this?
  //DeleteObject(NewCaretBitmap);
  //NewCaretBitmap := 0;

end;

end.

----------------------------------------------------------------------
Rave · 2014-08-21 06:45

Well, considering current amount of RAM in people's computers and size
of the bitmap which is likely few bytes (considering it is 1bit),
memory leak, if any will be unnoticeable. So I'd say it's premature
optimization.

----------------------------------------------------------------------
rvk · 2014-08-21 07:19

Well... I consider any memory loss, however small, a waste, if it can
be fixed and optimized easily.

But.... maybe that's just me

----------------------------------------------------------------------
Rave · 2014-08-23 15:34

Well, in any case, it's solved now. Locking thread.