procedure TCmdForm.ScrollMemo(ScrollRTF:TRichMemo; BarType:string; BarTgt:longint);
var BarPos: LongInt; // ** WORKS **
// Example: ScrollMemo(PageMemo, 'VRT', 12452);
// Example: ScrollMemo(PageMemo, 'VRT', VrtBarPos);
begin
if upcase(BarType)='VRT' then // vertical
begin
BarPos:= GetScrollPos(ScrollRTF.handle,SB_VERT);
if BarPos>BarTgt then // if in view this scrolls document to previous position
Begin // if not in view it scrolls document to previous cursor
while (BarTgt<GetScrollPos(ScrollRTF.handle,SB_VERT)) do
begin
ScrollRTF.VertScrollBar.Position:=
ScrollRTF.VertScrollBar.Position - 1;
end;
end else
Begin
while (BarTgt>GetScrollPos(ScrollRTF.handle,SB_VERT)) do
begin
ScrollRTF.VertScrollBar.Position:=
ScrollRTF.VertScrollBar.Position + 1;
end;
end; // end of else
end; // end VERTICAL BarType
if upcase(BarType)='HRZ' then // horizontal
begin
BarPos:= GetScrollPos(ScrollRTF.handle,SB_HORZ);
if BarPos>BarTgt then // scrolls document to last cursor position
Begin // as per its previous screen view
while (BarTgt<GetScrollPos(ScrollRTF.handle,SB_HORZ)) do
begin
ScrollRTF.HorzScrollBar.Position:=
ScrollRTF.HorzScrollBar.Position - 1;
end;
end else
Begin
while (BarTgt>GetScrollPos(ScrollRTF.handle,SB_HORZ)) do
begin
ScrollRTF.HorzScrollBar.Position:=
ScrollRTF.HorzScrollBar.Position + 1;
end;
end; // end of else
end; // end of HORIZONTAL BarType
end; // end proc
procedure GotoLine(FindRTF:TRichMemo; FindLine:integer); // ** WORKS **
var Index: integer; // EXAMPLE: GotoLine(ScanRTF,TopLin);
begin
Index:= SendMessage(FindRTF.Handle,EM_LINEINDEX,FindLine,0); // first character
FindRTF.SelStart:= Index; // EM_SCROLLCARET
FindRTF.SelLength:= 0; // EM_SETSEL
// Notepad uses EM_LINEINDEX (then EM_SETSEL and EM_SCROLLCARET)
end;
// Get first & last visible lines of a RichMemo screen; Author: Thomas Stutz
function TCmdForm.GetRTF_FirstLine(TempMemo:TRichmemo): Integer; // ** WORKS **
begin
Result:= SendMessage(TempMemo.handle,EM_GETFIRSTVISIBLELINE, 0, 0);
end;
// Get last visible line of RichMemo screen; Author: Thomas Stutz
function TCmdForm.GetRTF_LastLine(TempMemo:TRichmemo): Integer; // ** WORKS **
const
EM_EXLINEFROMCHAR = WM_USER + 54;
var
r: TRect;
i: Integer;
begin
SendMessage(TempMemo.handle, EM_GETRECT, 0, Longint(@r));
r.Left:= r.Left + 1;
r.Top:= r.Bottom - 2;
i:= SendMessage(TempMemo.handle, EM_CHARFROMPOS, 0, Integer(@r.topleft));
Result:= SendMessage(TempMemo.handle, EM_EXLINEFROMCHAR, 0, i); // ** GOOD **
end;
procedure TCmdForm.PageMemoWheel(Sender: TObject; // ** GOOD **
Shift: TShiftState;
WheelDelta: Integer;
MousePos: TPoint;
var Handled: Boolean
);
var WheelRTF: TRichMemo;
MemoSet: boolean;
LineHgt, FullHgt, MaxHgt, DefHgt: integer;
Ndx1, Ndx2, Ndx3: integer;
Pos1, Pos2, Pos3: TPoint;
HgtUP, HgtDN, CtrHgt: integer;
StorePos, StoreRun: integer;
begin
Handled:= false;
MemoSet:= false;
WheelRoll:= 'XX'; // global variable
if WheelDelta>0 then WheelRoll:= 'UP';
if WheelDelta<0 then WheelRoll:= 'DN';
// assign active editor to WheelRTF
if (PageMemoOn) and (not PagePassive) then // global editor flags
begin
WheelRTF:= PageMemo;
MemoSet:= true;
end;
if SearchBoxOn then // global editor flag
begin
WheelRTF:= SearchBox;
MemoSet:= true;
end;
if ReplaceBoxOn then // global editor flag
begin
WheelRTF:= ReplaceBox;
MemoSet:= true;
end;
if MemoSet then
begin
try
{
// line functions ** not needed ** GetLin,BtmLn,LN,LI,LL: integer;
GetLin:= SendMessage(WheelRTF.Handle,EM_LINEFROMCHAR,WheelRTF.SelStart,0); // Line Data
BtmLin:= GetRTF_LastLine(WheelRTF); // last visible line
LN:= SendMessage(WheelRTF.Handle,EM_LINEFROMCHAR,WheelRTF.SelStart,0); // get Line-Number
LI:= SendMessage(WheelRTF.Handle,EM_LINEINDEX,LN,0); // get Line-Postion at Line start
LL:= SendMessage(WheelRTF.handle,EM_LINELENGTH,LI,0); // get Line-Length from Character Index
}
// get first visible screen line
TopLin:= SendMessage(WheelRTF.handle,EM_GETFIRSTVISIBLELINE,0,0);
// get indexes of lines above & below TopLin
if (TopLin-1)<0
then Ndx1:= 0
else Ndx1:= SendMessage(WheelRTF.Handle,EM_LINEINDEX,TopLin-1,0);
Ndx2:= SendMessage(WheelRTF.Handle,EM_LINEINDEX,TopLin,0);
if (TopLin+1) > (WheelRTF.Lines.Count) // TopLin+1 > total lines
then Ndx3:= TopLin
else Ndx3:= SendMessage(WheelRTF.Handle,EM_LINEINDEX,TopLin+1,0);
// get coordinate of index
WheelRTF.Perform(EM_POSFROMCHAR,WPARAM(@Pos1),Ndx1);
WheelRTF.Perform(EM_POSFROMCHAR,WPARAM(@Pos2),Ndx2);
WheelRTF.Perform(EM_POSFROMCHAR,WPARAM(@Pos3),Ndx3);
// get height of line
HgtUP:= Pos2.y - Pos1.y;
HgtDN:= Pos3.y - Pos2.y;
// ZoomStat is a "global double" to unify zoom for multiple tab frames.
ZoomStat:= WheelRTF.ZoomFactor;
MaxHgt:= round(36 * 1.628 * ZoomStat); // height * padding * Zoom
DefHgt:= round(12 * 1.628 * ZoomStat); // height * padding * Zoom
CtrHgt:= round(1 * 1.628 * ZoomStat); // height * padding * Zoom
case WheelRoll of
'UP': begin // ** TEXT ROLLS DOWN ** NEW LINE APPEARS AT TOP
LineHgt:= HgtUP;
if LineHgt>MaxHgt then LineHgt:= DefHgt;
if (ssCtrl in Shift) then LineHgt:= CtrHgt; // Ctrl key pressed
WheelRTF.VertScrollBar.Position:=
WheelRTF.VertScrollBar.Position - LineHgt;
Handled:= true;
end;
'DN': begin // ** TEXT ROLLS UP ** NEW LINE APPEARS AT BOTTOM
LineHgt:= HgtDN;
if LineHgt>MaxHgt then LineHgt:= DefHgt;
if (ssCtrl in Shift) then LineHgt:= CtrHgt; // Ctrl key pressed
WheelRTF.VertScrollBar.Position:=
WheelRTF.VertScrollBar.Position + LineHgt;
Handled:= true;
end;
'XX': begin
Handled:= true;
end;
end; // end-of-case
finally
end; // end try
end; // end MemoSet
end; // end PageMemoWheel
Recent
