TMemo MouseWheel Scrolling With Caret

[RAW]

Can anybody explain how to scroll in a TMemo with moving caret using the MouseWheel?

Normally I use this:

Code: Pascal  [Select][+][-]

1. // MOUSE WHEEL ================================================================
2. Procedure TwndGUI.memoMouseWheelDown(Sender  : TObject; Shift: TShiftState;
3.                                      MousePos: TPoint; Var Handled: Boolean);
4.   Var
5.    i: Integer;
6.  Begin
7.   If Not (ssCTRL In Shift)
8.   Then
9.    Begin
10.     For i:= 1 To 3
11.     Do SendMessage(memo.Handle, WM_VSCROLL, SB_LINEDOWN, 0);
12.    End
13.   Else SendMessage(memo.Handle, WM_VSCROLL, SB_PAGEDOWN, 0);
14.  End;
15.  
16.  
17. Procedure TwndGUI.memoMouseWheelUp(Sender  : TObject; Shift: TShiftState;
18.                                    MousePos: TPoint; Var Handled: Boolean);
19.   Var
20.    i: Integer;
21.  Begin
22.   If Not (ssCTRL In Shift)
23.   Then
24.    Begin
25.     For i:= 1 To 3
26.     Do SendMessage(memo.Handle, WM_VSCROLL, SB_LINEUP, 0);
27.    End
28.   Else SendMessage(memo.Handle, WM_VSCROLL, SB_PAGEUP, 0);
29.  End;          
30.  

I don't get the EM_SCROLLCARET-Thing to work...

[ASerge]

Can anybody explain how to scroll in a TMemo with moving caret using the MouseWheel?

First. Wheel event do before change, you need scroll after change, so, do some PostMessage or use Timer. For example, use Timer with Interval = 10 and Enabled = False. When wheel scroll, set Timer.Enabled := True;
Second. Detect memo limit:

Code: Pascal  [Select][+][-]

1. procedure GetMemoLimit(Memo: TMemo; out FirstLineIndex, LastLineIndex: Integer);
2. var
3.   R: TRect;
4.   H: THANDLE;
5. begin
6.   H := Memo.Handle;
7.   FirstLineIndex := SendMessage(H, EM_GETFIRSTVISIBLELINE, 0, 0);
8.   SendMessage(H, EM_GETRECT, 0, LPARAM(@R));
9.   LastLineIndex := HIWORD(SendMessage(H, EM_CHARFROMPOS, 0, MAKELPARAM(R.Left + 1, R.Bottom - 2)));
10. end;

Third. Do process in timer event:

Code: Pascal  [Select][+][-]

1. var
2.   FirstLineIndex, LastLineIndex: Integer;
3.   P: TPoint;
4. begin
5.   Timer1.Enabled := False;
6.   GetMemoLimit(Memo1, FirstLineIndex, LastLineIndex);
7.   P := Memo1.CaretPos;
8.   if P.y < FirstLineIndex then
9.   begin
10.     P.y := FirstLineIndex;
11.     Memo1.CaretPos := P;
12.   end
13.   else
14.     if P.y > LastLineIndex then
15.     begin
16.       P.y := LastLineIndex;
17.       Memo1.CaretPos := P;
18.     end;
19. end;

[RAW]

@ASerge
Works like a charm... Thank you very much. 

EDIT:
This works best for me: Keeps the caret at the exact position where it was... No timer needed... 

Code: Pascal  [Select][+][-]

1. Procedure TForm1.FormMouseWheel
2. (Sender: TObject;SH: TShiftState;Delta: Integer;Pos: TPoint;Var HN: Boolean);
3. Var
4.  i,x,y,iD: Integer;
5.  Function CaretPos(M: TMemo;Out ix,iy: Integer): Integer;
6.  Begin
7.    iy:= SendMessage(Memo1.Handle,EM_LINEFROMCHAR,M.SelStart,0);
8.    ix:= M.SelStart-SendMessage(Memo1.Handle,EM_LINEINDEX,iy,0);
9.    Result:= iy-SendMessage(Memo1.Handle,EM_GETFIRSTVISIBLELINE,0,0)
10.  End;
11. Begin
12.   iD:= CaretPos(Memo1,x,y);
13.   If Not (ssCTRL In SH) // Scroll Line
14.   Then
15.    Begin
16.      For i:= 1 To Mouse.WheelScrollLines
17.      Do
18.       Begin
19.        Try
20.          If Delta > 0
21.          Then SendMessage(Memo1.Handle,WM_VSCROLL,SB_LINEUP,0)
22.          Else SendMessage(Memo1.Handle,WM_VSCROLL,SB_LINEDOWN,0);
23.        Finally
24.          SendMessage(Memo1.Handle,WM_VSCROLL,SB_ENDSCROLL,0);
25.        End;
26.       End;
27.    End;
28.   If (ssCTRL In SH) // Scroll Page
29.   Then
30.    Begin
31.      For i:= 1 To Mouse.WheelScrollLines
32.      Do
33.       Begin
34.         Try
35.           If Delta > 0
36.           Then SendMessage(Memo1.Handle,WM_VSCROLL,SB_PAGEUP,0)
37.           Else SendMessage(Memo1.Handle,WM_VSCROLL,SB_PAGEDOWN,0);
38.         Finally
39.           SendMessage(Memo1.Handle,WM_VSCROLL,SB_ENDSCROLL,0);
40.         End;
41.       End;
42.    End;
43.   Memo1.CaretPos:= Point(x,SendMessage(Memo1.Handle,EM_GETFIRSTVISIBLELINE,0,0)+iD);
44. End;

This is the easiest way, one line solution, if the exact caret position isn't needed... (always the first line).

Code: Pascal  [Select][+][-]

1. Procedure TForm1.FormMouseWheel
2. (Sender: TObject;SH: TShiftState;Delta: Integer;Pos: TPoint;Var HN: Boolean);
3. Var
4.  i: Integer;
5. Begin
6.   If Not (ssCTRL In SH) // Scroll Line
7.   Then
8.    Begin
9.      For i:= 1 To Mouse.WheelScrollLines
10.      Do
11.       Begin
12.        Try
13.          If Delta > 0
14.          Then SendMessage(Memo1.Handle,WM_VSCROLL,SB_LINEUP,0)
15.          Else SendMessage(Memo1.Handle,WM_VSCROLL,SB_LINEDOWN,0);
16.        Finally
17.          SendMessage(Memo1.Handle,WM_VSCROLL,SB_ENDSCROLL,0);
18.        End;
19.       End;
20.    End;
21.   If (ssCTRL In SH) // Scroll Page
22.   Then
23.    Begin
24.      For i:= 1 To Mouse.WheelScrollLines
25.      Do
26.       Begin
27.         Try
28.           If Delta > 0
29.           Then SendMessage(Memo1.Handle,WM_VSCROLL,SB_PAGEUP,0)
30.           Else SendMessage(Memo1.Handle,WM_VSCROLL,SB_PAGEDOWN,0);
31.         Finally
32.           SendMessage(Memo1.Handle,WM_VSCROLL,SB_ENDSCROLL,0);
33.         End;
34.       End;
35.    End;
36.   Memo1.CaretPos:= Point(0,SendMessage(Memo1.Handle,EM_GETFIRSTVISIBLELINE,0,0));
37. End;