0

Как сделать синхронную прокрутку трех memo. То есть кручу Scrollbars и информация в трех Memo синхронно прокручивается.

4
  • 1
    у мемо нет какого-нить метода scrollTo что ли?
    – teran
    Commented 14 дек. 2018 в 13:14
  • @teran, Это в свойствах или это отдельная процедура ?
    – Денис
    Commented 14 дек. 2018 в 13:22
  • 1
    Речь идет только о вертикальной прокрутке? Commented 14 дек. 2018 в 14:37
  • @Dima, Да речь идет о вертикальной прокрутке..
    – Денис
    Commented 14 дек. 2018 в 14:46

1 ответ 1

1

Ответ обновлен!
Упрощен код метода Synchronize; добавлен тип TSyncType.

Это реализовать весьма несложно. Как мне показалось, наилучшим решением будет создать новый компонент (наследуясь от уже существующего - TMemo) и немного его улучшить.
Такой подход требует определенных трудозатрат:

  1. Создание юнита для компонента.
  2. Создание *.dcr-файла для компонента (в нем будет его иконка для палитры компонентов в IDE).
  3. Собственно, инсталляция компонента в IDE.

С другой стороны, Вы получаете на выходе "полуфабрикат", который можно безболезненно модифицировать, распространять и не бояться, что какой-то костыль важный код потеряется по дороге. Тем не менее, в дальнейшем будет приведен только код, касающийся компонента. Создание пакета и его инсталляция - за рамками данного вопроса.

Вся работа базируется на перехвате сообщения WM_HSCROLL/WM_VSCROLL. Мы узнаём как именно пользователь выполнил прокрутку данных (за ползунок или кнопками управления полосой прокрутки) и вызываем кастомное событие типа TNotifyEvent. В режиме design-time необходимо выполнить настройку этого события, используя публичную процедуру новоиспеченного компонента Synchronize для синхронизации прокрутки основного компонента и подчиненных (определяются пользователем).

Впрочем, хватит вступления, перейдем непосредственно к коду.

Объявление класса:

  // Тип прокрутки (горизонтальный, вертикальный)      
  TSyncType = (stHorz, stVert);

  TMemoEx = class(TMemo)
  private
    FOnScrollHorz: TNotifyEvent;
    FOnScrollVert: TNotifyEvent;
    FCurrentWord: Word;

  protected
    procedure WMHSCROLL(var Message: TMessage); message WM_HSCROLL;
    procedure WMVSCROLL(var Message: TMessage); message WM_VSCROLL;
    procedure WMCOMMAND(var Message: TWMCOMMAND); message CN_COMMAND;
    function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; 
                          MousePos: TPoint): Boolean; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;

  public
    procedure Synchronize(AMemo: TMemo; ASyncType: TSyncType);

  published
    property OnScrollHorz : TNotifyEvent read FOnScrollHorz write FOnScrollHorz;
    property OnScrollVert : TNotifyEvent read FOnScrollVert write FOnScrollVert;
  end;

Реализация класса:

procedure TMemoEx.WMHSCROLL(var Message: TMessage);
begin
  Inherited;

  FCurrentWord := LOWORD(Message.WParam);
  if Assigned(FOnScrollHorz) then
    FOnScrollHorz(Self);
end;

procedure TMemoEx.WMVSCROLL(var Message: TMessage);
begin
  Inherited;

  FCurrentWord := LOWORD(Message.WParam);
  if Assigned(FOnScrollVert) then
    FOnScrollVert(Self);
end;

procedure TMemoEx.CNCOMMAND(var Message: TWMCOMMAND);
begin
  Inherited;

  if Message.NotifyCode = EN_HSCROLL then
    begin
      if Assigned(FOnScrollHorz) then
        FOnScrollHorz(Self);
    end
  else
  if Message.NotifyCode = EN_VSCROLL then
    begin
      if Assigned(FOnScrollVert) then
        FOnScrollVert(Self);
    end;
end;

function TMemoEx.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; 
                              MousePos: TPoint): Boolean;
begin
  Result := Inherited DoMouseWheel(Shift, WheelDelta, MousePos);

  if HandleAllocated then
    begin
      if WheelDelta < 0 then
        FCurrentWord := SB_LINEDOWN
      else
        FCurrentWord := SB_LINEUP;
    end;
end;

procedure TMemoEx.KeyDown(var Key: Word; Shift: TShiftState);
begin
  Inherited KeyDown(Key, Shift);

  if Key = VK_HOME then
    FCurrentWord := SB_TOP
  else
  if Key = VK_END then
    FCurrentWord := SB_BOTTOM
  else
  if (Key = VK_DOWN) or (Key = VK_RIGHT) then
    FCurrentWord := SB_LINEDOWN
  else
  if (Key = VK_UP) or (Key = VK_LEFT) then
    FCurrentWord := SB_LINEUP;
end;

procedure TMemoEx.Synchronize(AMemo: TMemo; ASyncType: TSyncType);
var
  ScrollInfo: TScrollInfo;
  LongWParam: DWord;
  Msg: DWord;
  Bar: Integer;
begin
  if FCurrentWord = SB_ENDSCROLL then
    Exit;

  if HandleAllocated and Assigned(AMemo) and AMemo.HandleAllocated then
    begin
      if ASyncType = stHorz then
        begin
          Msg := WM_HSCROLL;
          Bar := SB_HORZ;
        end
      else
        begin
          Msg := WM_VSCROLL;
          Bar := SB_VERT;
        end;

      if (FCurrentWord = SB_THUMBPOSITION) or (FCurrentWord = SB_THUMBTRACK) then
        begin
          ScrollInfo.cbSize := SizeOf(ScrollInfo);
          ScrollInfo.fMask := SIF_ALL;
          GetScrollInfo(Handle, Bar, ScrollInfo);
          LongWParam := MakeWParam(FCurrentWord, ScrollInfo.nPos);
        end
      else
        LongWParam := MakeWParam(FCurrentWord, 0);

      SendMessage(AMemo.Handle, Msg, LongWParam, 0);
    end;
end;

Полезная информация:

  1. WM_HSCROLL message
  2. WM_VSCROLL message
  3. MAKEWPARAM macro
  4. EN_HSCROLL notification code
  5. EN_VSCROLL notification code
  6. Тип события TNotifyEvent
0

Ваш ответ

Нажимая «Отправить ответ», вы соглашаетесь с условиями пользования и подтверждаете, что прочитали политику конфиденциальности.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.