Forum > RichMemo

Faster Attribute Collection

<< < (3/3)

rick2691:
I have resolved the problem, and greatly simplified it as well. It works extremely very well, and as with the former, it leaves the caret position alone. Plus it is very fast.


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---// Get first & last visible lines of a RichMemo screen; Author: Thomas Stutzfunction TCmdForm.GetRTF_FirstLine(TempMemo:TRichmemo): Integer; // ** WORKS **begin  Result:= SendMessage(TempMemo.handle,EM_GETFIRSTVISIBLELINE, 0, 0);end;  procedure TCmdForm.PageMemoWheel(Sender: TObject;      // ** GOOD **                                 Shift: TShiftState;                                 WheelDelta: Integer;                                 MousePos: TPoint;                                 var Handled: Boolean                                 );var WheelRTF: TRichMemo;    MemoSet: boolean;    LineHgt: integer;    Ndx1, Ndx2, Ndx3: integer;    Pos1, Pos2, Pos3: TPoint;    HgtUP, HgtDN: 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       WheelRTF.Lines.BeginUpdate;  // suspend screen update          // first visible line of screen         TopLin:= GetRTF_FirstLine(WheelRTF);          // first character of line ** FIX FOR TOPLIN=0 & TOPLIN ONLY **         Ndx1:= SendMessage(WheelRTF.Handle,EM_LINEINDEX,TopLin-1,0);         Ndx2:= SendMessage(WheelRTF.Handle,EM_LINEINDEX,TopLin,0);         Ndx3:= SendMessage(WheelRTF.Handle,EM_LINEINDEX,TopLin+1,0);          // coordinate of line         WheelRTF.Perform(EM_POSFROMCHAR,WPARAM(@Pos1),Ndx1);         WheelRTF.Perform(EM_POSFROMCHAR,WPARAM(@Pos2),Ndx2);         WheelRTF.Perform(EM_POSFROMCHAR,WPARAM(@Pos3),Ndx3);          // height of line         HgtUP:= Pos2.y - Pos1.y;         HgtDN:= Pos3.y - Pos2.y;          case WheelRoll of         'UP': begin   // ** TEXT ROLLS DOWN ** NEW LINE APPEARS AT TOP               LineHgt:= HgtUP;               if LineHgt>100 then LineHgt:= 20; // ** MUST REFINE **               WheelRTF.VertScrollBar.Position:=                        WheelRTF.VertScrollBar.Position - LineHgt;               Handled:= true;               end;         'DN': begin   // ** TEXT ROLLS UP ** NEW LINE APPEARS AT BOTTOM               LineHgt:= HgtDN;               if LineHgt>100 then LineHgt:= 20; // ** MUST REFINE **               WheelRTF.VertScrollBar.Position:=                        WheelRTF.VertScrollBar.Position + LineHgt;               Handled:= true;               end;         'XX': begin               Handled:= true;               end;         end; // end-of-case      finally     WheelRTF.Lines.EndUpdate;  // restore screen update     end; // end try     end; // end MemoSetend; // end PageMemoWheel     
Perhaps someone can help me with its last issue. In the section of the "case WheelRoll of", I change the LineHgt to 20, if LineHgt is greater 100. Doing so is an assumption that a taller image might be that large or larger, and exceed the screen view. Which is a problem if you want look at everything in the image. So I have reduced the scroll factor to move it up slowly.

I would prefer to sense the image as an object, and then modify the LineHgt factor in a more intelligent way. Unfortunately, I am not studied enough to code that process.

Can anyone show me a cleaner way to get that done?

rick2691:
This is a tweak to make image scrolling smoother. It is a decent work around, but I would still like to either identify that the top scroll line contains text or an image. Knowing either of them would allow us to manipulate the scroll factor with precision.


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure TCmdForm.PageMemoWheel(Sender: TObject;                                      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: 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       {       GetLin:= SendMessage(ScanRTF.Handle,EM_LINEFROMCHAR,WheelRTF.SelStart,0); // Line Data       BtmLin:= GetRTF_LastLine(WheelRTF); // last visible line       }        // get first visible line on screen       TopLin:= SendMessage(WheelRTF.handle,EM_GETFIRSTVISIBLELINE, 0, 0);        // get index of line       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;        MaxHgt:= round(36 * 1.628 * ZoomStat); // height * padding * Zoom // 72       DefHgt:= round(12 * 1.628 * ZoomStat); // height * padding * Zoom // 10        case WheelRoll of       'UP': begin   // ** TEXT ROLLS DOWN ** NEW LINE APPEARS AT TOP             LineHgt:= HgtUP;             if LineHgt>MaxHgt then LineHgt:= DefHgt; // ** MUST REFINE **             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; // ** MUST REFINE **             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 MemoSetend; // end PageMemoWheel 

rick2691:
I have enhanced the scrolling for PageMemoWheel, which is a stand alone scroller. It now allows you to hold down the control key while turning the wheel. Doing so makes it scroll very slowly.

I have also added some additional scroll functions that are useful, but not needed for PageMemoWheel.

At this point, I don't think I need to identify the page content. It is doing what I need.


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure TCmdForm.ScrollMemo(ScrollRTF:TRichMemo; BarType:string; BarTgt:longint);var BarPos: LongInt;                                      // ** WORKS **// Example: ScrollMemo(PageMemo, 'VRT', 12452);// Example: ScrollMemo(PageMemo, 'VRT', VrtBarPos);beginif 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 BarTypeend; // 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 Stutzfunction 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 Stutzfunction 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 MemoSetend; // end PageMemoWheel  

Navigation

[0] Message Index

[*] Previous page

Go to full version