Sychrone Listboxen

[tomkupitz]

Hallo,

zwei LB sollen synchron gescrollt werden. Im Tool http://www.screensoft.de/txtc.zip ist zu sehen wenn in der Vorschau (Mitte) gescrollt wird und beide LB nachgezogen werden sollen hängt die 2. LB etwas hinterher. Warum?

Code:

procedure TMainForm.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  TopLine:=...

    //

  SendMessage(ListBox1.Handle, WM_VSCROLL, MakeLong(LOWORD(SB_THUMBPOSITION), TopLine), 0);
  Application.ProcessMessages;
  SendMessage(ListBox2.Handle, WM_VSCROLL, MakeLong(LOWORD(SB_THUMBPOSITION), TopLine), 0);
end;

Danke und beste Grüße

[Uwe Raabe]

Na ja, das ist doch offensichtlich. Zwischen den beiden SendMessage-Aufrufen für ListBox1 und ListBox2 sorgt das Application.ProcessMessages für ein Refresh der ListBox1 bevor ListBox2 überhaupt den Befehl zum Scrollen bekommen hat.

[tomkupitz]

Wenn ich Application.ProcessMessages rausmache dann hängt LB1.

[Uwe Raabe]

Ohne konkretes Beispiel-Projekt kann ich auch nur spekulieren: Ändere mal die beiden SendMessage-Aufrufe in PostMessage.

[Delphi.Narium]

Bei mir kann ich keinerlei Verzögerung bei der Synchronisation in Deinem Programm feststellen.

[hoika]

Hallo,
ich würde das

Application.ProcessMessages;

einfach als letzten Befehl aufrufen und nicht zwischen den beiden ListBox-Befehlen.

[Delphi.Narium]

Zitat:

Zitat von hoika (Beitrag 1489694)

Hallo,
ich würde das

Application.ProcessMessages;

einfach als letzten Befehl aufrufen und nicht zwischen den beiden ListBox-Befehlen.

Post #3?

[tomkupitz]

Application.ProcessMessages; zuletzt: In dem Fall hängt LB1 etwas hinterher. Ich glaube ich muss damit erstmal leben:?.

[KodeZwerg]

Bevor ich ein Send-/Post-/Message anwenden würde, probiere ich zuerst ob das Control ein Perform beherrscht.
Bevor ich ein Application.ProcessMessages aufrufe, probiere ich ob es ein Begin-/End-/Update beherrscht.

Ungetestet meine Theorie:

Zitat:

Zitat von tomkupitz (Beitrag 1489669)

Code:

procedure TMainForm.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  TopLine:=...

    //

  Listbox1.BeginUpdate;
  Listbox2.BeginUpdate;
  Listbox1.Perform(WM_VSCROLL, MakeLong(LOWORD(SB_THUMBPOSITION), TopLine);
  Listbox2.Perform(WM_VSCROLL, MakeLong(LOWORD(SB_THUMBPOSITION), TopLine);
  Listbox1.EndUpdate;
  Liatbox2.EndUpdate;
end;

Sag ob es funktioniert und ob es was gebracht hat.

[tomkupitz]

Keine Änderung...

[stahli]

Für RichEdits habe ich es folgendermaßen umgesetzt:
(https://youtu.be/qH-kT2I5q6g)

Das kannst Du so natürlich nicht 1:1 übernehmen (da ich von einem anderen Datenbestand ausgehe und Listboxen vielleicht nicht genau so funktionieren) aber evtl. hilft es als Ideenpool...
(Die Panels sind ausgestanzt und bilden die Rahmen um die aktuellen Zeilen links und rechts.)

Delphi-Quellcode:

  case (ControlledSite) of
    csLeft:
      begin
        TLO := RichEdit1O.Perform(EM_GETFIRSTVISIBLELINE, 0, 0);
        ALO := RichEdit1O.ActiveLineNo;

        PanelLeftFrame.Top := (((ALO - TLO) * 14) + 4);
        lTag := (TLO);

        if Assigned(BlocksCtrl) then
        begin
          D := MaxInt;
          for I := 0 to BlocksCtrl.LineNumberListRight.Count - 1 do
          begin
            D_ := Abs(ALO - (BlocksCtrl.LineNumberListRight[I].LineNumber));
            if (D_ < D) then
            begin
              ALR := I;
              D := D_;
              if (D = 0) then
              begin
                TLR := RichEdit1R.Perform(EM_GETFIRSTVISIBLELINE, 0, 0);

                TLC := (I - (ALO - TLO));
                if (TLC < 0) then
                begin
                  TLC := 0;
                end;
                RichEdit1R.Perform(EM_LINESCROLL, 0, TLC - TLR);
                TLR := RichEdit1R.Perform(EM_GETFIRSTVISIBLELINE, 0, 0);
                rTag := TLR;

                PanelRightFrame.Top := (((ALR - TLR) * 14) + 4);
                PanelRightFrame.Visible := True;

                if (RichEdit1R.CaretPos.Y <> ALR) then
                  RichEdit1R.CaretPos := TPoint.Create(0, ALR);

                Break;
              end;
            end;
          end;

          if (D <> 0) then
          begin
            PanelRightFrame.Visible := False;
            rTag := -1;
          end;

          if (ALO <= BlocksCtrl.LineNumberListLeft.Count - 1) then
            BlocksCtrl.currentBlockNumber := BlocksCtrl.LineNumberListLeft[ALO].BlockNumber;
        end;
      end;
...

[tomkupitz]

Lösung:

Code:

    TopLine:=...

    Application.ProcessMessages;

    SendMessage(ListBox1.Handle, WM_VSCROLL, MakeLong(LOWORD(SB_THUMBPOSITION), TopLine), 0);
    SendMessage(ListBox2.Handle, WM_VSCROLL, MakeLong(LOWORD(SB_THUMBPOSITION), TopLine), 0);

    Application.ProcessMessages;

:thumb:

[tomkupitz]

Jetzt auch im Tool sichtbar: http://www.screensoft.de/txtc.zip