ListBox'ta Scrooll'u kontrol altında tutmak

[sabanakman]

Birden fazla CheckListBox nesnem var ve içleri bir hayli dolu. Bunların birbirine paralel davranması gerekiyor (kaydırma çubuklarının pozisyonları). Mesela kullanıcı birisinin kaydırma çubuğundan kaydırınca diğer CheckListBox bileşenleriminde aynı pozisyona kaymasını istiyorum. Borland VCL'den bunu sağlayacak kodları yazmadığı içinde altından kalkamadım.

..CheckListBox ile listbox neredeyse birebir aynı olduğu için başlıkta ListBox belirttim..

[fatihtolgaata]

Bir nesnenin scroll'u ile oynadığında windows'a o nesne ile ilgili scroll mesajlarını gönderirsin. Windows da bu mesajları aldığında scroll'u indirir, kaldırır, vs.. Aynı mesajı mouse yerine sen programatik olarak da yollayabilirisin. Aynı şekilde mesaj yakalama yolu ile scroll mesajlarını da öğrenebilirsin. Tabi bunun için en sağlam yol, scroll mesajlarını yakalayan ListBox'dan türeyen bir component yapman lazım ya da uğraşmak istemiyorsan şöyle bir şey aklıma geliyor. Tabi başka yöntemler de olabilir:

Kod: Tümünü seç

//foruma ApplicationEvents ekle sonra onun OnMessage olayına şunu yaz:

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
var
  ScrollPos: Integer;
begin
  if (Msg.hwnd = ListBox2.Handle) then
  begin
    ScrollPos := GetScrollPos(ListBox2.Handle, SB_VERT);
    SetScrollPos(ListBox1.Handle, SB_VERT, ScrollPos, True);
  end;
end;

Bu dikey kaymalar için çalışır. Yataydakiler için SB_HORZ kullanabilirsin. Ama mesaj yakalama ile yapacaksan:

Kod: Tümünü seç

  procedure WMVerticalScroll(var Msg: TWMVscroll); message WM_VSCROLL;

gibi bir şey olacak. Bu fonksiyondan tanımladığın bir event çağrılabilir. kolay gele..

[sabanakman]

message WM_VSCROLL; hedefi 12'den vuran bir cevaptı. Çok teşekkür ederim.

[sabanakman]

Çözüm:
Aslında bu scroll nesnelerinden, ApplicatonEvents nesnesini tetiklenmiyor. VCL'den yapamama sebeplerinden birisi de bu. Mesele bayağı derinmiş, az önce SetScrollPos ile Scroll'u kaydırınca birden heyecana kapıldım ama içeriğinde çubukla beraber kaymadığını görünce dünyam başıma yıkılsa da çözmek çok zor olmadı . Bende TListBox üzerine kendi bileşenimi geliştirdim.

Kod: Tümünü seç

type
  TmyScrollEvent=procedure (Sender:TObject;Message:TWMScroll) of object;

  TmyListBox=class(TListBox)
  private
    FVerticalScrollEvent:TmyScrollEvent;
  protected
    procedure WMVScroll(var Message:TWMVScroll);message WM_VSCROLL;
    procedure DoVerticalScroll(Message:TWMVScroll);
  published
    property VerticalScrollEvent:TmyScrollEvent read VerticalScrollEvent write VerticalScrollEvent;
  end;

şeklinde tanımladım ve kodları da

Kod: Tümünü seç

procedure TmyListBox.WMVScroll(var Message:TWMVScroll);
begin
  inherited;
  DoVerticalScroll(Message);
end;

procedure TmyListBox.DoVerticalScroll(Message:TWMVScroll);
begin
  if Assigned(VerticalScrollEvent) then VerticalScrollEvent(Self,Message);
end;

biçiminde yazdım. Artık yatay kaydırmayı algılayabileceğim VerticalScrollEvent isminde bir olayım var. Bunu da aşağıdaki gibi yazınca istediğim olay gerçekleşti:

Kod: Tümünü seç

procedure TForm1.myListBox1VerticalScrollEvent(Sender:TObject; Message:TWMVScroll);
var 
  i:Integer;
  Yed:TmyScrollEvent;
  Msg:TMessage absolute Message;{<-Message ile Msg aynı adreste bulunan iki farklı değişkendir. Biri değişince diğeri etkilenir.}
begin
  if Sender is TmyListBox then begin
    for i:=0 to ComponentCount-1 do
    if (Sender<>Components[i]) and (Components[i] is TmyListBox) then
    with TmyListBox(Components[i]) do begin
      Yed:=VerticalScrollEvent;
      VerticalScrollEvent:=nil;
      Perform(WM_VSCROLL,Msg.WParam,Msg.LParam);{scroll ayarlar}
      VerticalScrollEvent:=Yed;
    end;
  end;
end;

yukarıda bulunan kodla form üzerinde tüm TmyListBox bileşenlerinin Scroll pozisyonları aynı konumda tutulur. VerticalScrollEvent:=nil; şeklinde çalışmamın sebebi ise birbirlerinin pozisyonunu değiştirirken program sonsuz bir döngüye girmesini engellemekti. Kolay gelsin.