[Delphi] simulace ScrollBaru v TListView

C++, C#, Visual Basic, Delphi, Perl a ostatní

Moderátor: Moderátoři Živě.cz

Odeslat příspěvekod dyžon 14. 6. 2018 09:52

zdravím,
jsem tu opět s problémem, který pro Vás nebude moc zajímavý,
přesto bych Vás chtěl poprosit o pomoc s jeho vyřešením.
snažím se vytvořit vlastní scrollbar k ListViewu
v příkladu jsem použil TShape, ale ve finále tam bude buď TImage, nebo TPaintBox s bitmapou.
skládá se z táhla - shapeTahlo a osy: shapeOsa
napsal jsem si code, který by podle mě teoreticky měl fungovat, v praxi je to ale bohužel jinak.
shrnu to:
spočítám délku osy v px, po které se bude táhlo pohybovat,
vydělím počtem položek, které je potřeba odscrolovat a zjistím tak koeficient posunu.
podle něj a vzdálenosti táhla od nulové pozice dostanu kolikátá položka by se měla zobrazit.
kromě pár drobných problémů se zastavením táhla a podobně, je hned jeden problém s dopočítáním položky.
dolů to zhruba funguje, nahoru už je problém s položkama, které jsou nahoře viditelné.
přikládám celou unitu, jak jsem na to šel.
věřím, že existuje lepší způsob, třeba pomocí nějakých zpráv, ale nejsem v tom zběhlej.
prosím pomozte.
Kód: Vybrat vše
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.ComCtrls, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    ShapeOsa: TShape;
    ShapeTahlo: TShape;
    Memo1: TMemo;
    Label1: TLabel;
    procedure ShapeTahloMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ShapeTahloMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ShapeTahloMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    pohybTahlem: Boolean;
    staraPoziceTahla: TPoint;
    vrsekTahla, spodekTahla: Integer;
    polozekKeScrolovani: Integer;

    koeficientPosunu: Single;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
type
  TMoveCracker = class(TControl);

procedure TForm1.FormCreate(Sender: TObject);
var i: Integer; aItem: TListItem;
begin
  for i := 0 to 325 do begin
    aItem:= ListView1.Items.Add;
    aItem.Caption:= 'polozka' + IntToSTr(i);
    aItem.SubItems.Add(IntToStr(i));
  end;
  vrsekTahla:= ShapeOsa.Top;
  spodekTahla:= (ShapeOsa.Top + ShapeOsa.Height) - ShapeTahlo.Height;
  polozekKeScrolovani:= (ListView1.Items.Count - 1) - ListView1.VisibleRowCount;
  koeficientPosunu:= (spodekTahla - vrsekTahla) / polozekKeScrolovani;
  Memo1.Lines.Add('pixelu ke scrolovani: ' + IntToStr(spodekTahla - vrsekTahla));
  Memo1.Lines.Add('polozek ke scrolovani: ' + IntToStr(polozekKeScrolovani));
  Memo1.Lines.Add('koeficient: ' + FloatToStr(koeficientPosunu));
end;

procedure TForm1.ShapeTahloMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if(sender is TShape) then begin
    pohybTahlem:= True;
    TMoveCracker(Sender).MouseCapture := True;
    Screen.Cursor:= crHandPoint;
    GetCursorPos(staraPoziceTahla);
  end;
end;

procedure TForm1.ShapeTahloMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var novaPoziceTahla: TPoint; posun: integer; aItem: Integer;
begin
  if pohybTahlem then
  begin
    with ShapeTahlo do begin
// =============================================================================                //  tohle
      GetCursorPos(novaPoziceTahla); posun:= 0;                                                 //  řeší
        if ( Top - staraPoziceTahla.Y + novaPoziceTahla.Y ) < vrsekTahla then Top:= vrsekTahla  //  jen
          else posun:= 1;                                                                       //  limit
        if ( Top - staraPoziceTahla.Y + novaPoziceTahla.Y ) > spodekTahla then                  //  tahla
          Top := spodekTahla                                                                    //  nahoře
            else                                                                                //  a
          posun:= 1;                                                                            //  dole.
// =============================================================================
        if posun = 1 then  Top := Top - staraPoziceTahla.Y + novaPoziceTahla.Y;
        staraPoziceTahla := novaPoziceTahla;
    end;
  end;
  aItem:= Round((ShapeTahlo.Top - vrsekTahla) / koeficientPosunu);
//  ListView1.Selected := ListView1.Items[StrToInt(Edit1.Text)];
  ListView1.Items[aItem].MakeVisible(True);
  Label1.Caption:= IntToStr(aItem + ListView1.VisibleRowCount);
end;

procedure TForm1.ShapeTahloMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if pohybTahlem then
  begin
    Screen.Cursor := crDefault;
    TMoveCracker(Sender).MouseCapture := False;
    pohybTahlem := False;
  end;
end;

end.

ještě přikládám rar s celým zkušebním programem.
AMD FX-6300; Gigabyte 970A-DS3P; DDR3 8192MBytes; AMD Radeon HD 6700 Series
dyžon
Junior
Uživatelský avatar

Odeslat příspěvekod Just_jo 15. 6. 2018 19:23

Co takhle na to jít trochu jinak?
Tady to nastavuje určitý item do středu komponenty
https://stackoverflow.com/questions/29628308/how-to-make-the-listview-to-show-a-specific-item-in-the-center
Just_jo
Junior
Uživatelský avatar

Odeslat příspěvekod dyžon 21. 6. 2018 08:06

konečně jsem se k tomu zase dostal ....
výsledný code vypadá takhle:
Kód: Vybrat vše
unit Unit1;

interface

uses
  Winapi.Windows, System.SysUtils, System.Classes,
  Vcl.Controls, Vcl.Forms, Vcl.ExtCtrls, Vcl.ComCtrls, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    ShapeOsa: TShape;
    ShapeTahlo: TShape;
    Memo1: TMemo;
    Label1: TLabel;
    procedure ShapeTahloMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ShapeTahloMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ShapeTahloMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormCreate(Sender: TObject);
  private
    pohybTahlem: Boolean;
    staraPoziceTahla: TPoint;
    vrsekTahla, spodekTahla,  polozekKeScrolovani: Integer;
    koeficientPosunu: Single;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
type
  TMoveCracker = class(TControl);

procedure TForm1.FormCreate(Sender: TObject);
var i: Integer; aItem: TListItem;
begin
  for i := 0 to 625 do begin
    aItem:= ListView1.Items.Add;
    aItem.Caption:= 'polozka' + IntToSTr(i);
    aItem.SubItems.Add(IntToStr(i));
  end;
  vrsekTahla:= ShapeOsa.Top;
  spodekTahla:= (ShapeOsa.Top + ShapeOsa.Height) - ShapeTahlo.Height;
  polozekKeScrolovani:= (ListView1.Items.Count - 1) - ListView1.VisibleRowCount;
  koeficientPosunu:= (spodekTahla - vrsekTahla) / polozekKeScrolovani;
  Memo1.Lines.Add('pixelu ke scrolovani: ' + IntToStr(spodekTahla - vrsekTahla));
  Memo1.Lines.Add('polozek ke scrolovani: ' + IntToStr(polozekKeScrolovani));
  Memo1.Lines.Add('koeficient: ' + FloatToStr(koeficientPosunu));
end;

procedure TForm1.ShapeTahloMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if(sender is TShape) then begin
    pohybTahlem:= True;
    TMoveCracker(Sender).MouseCapture := True;
    Screen.Cursor:= crHandPoint;
    GetCursorPos(staraPoziceTahla);
  end;
end;

procedure TForm1.ShapeTahloMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var novaPoziceTahla: TPoint; posun: integer; aItem: Integer; R: TRect; li: TListItem;
begin
  if pohybTahlem then
  begin
    with ShapeTahlo do begin
// =============================================================================               
      GetCursorPos(novaPoziceTahla); posun:= 0;                                                 
        if ( Top - staraPoziceTahla.Y + novaPoziceTahla.Y ) < vrsekTahla then Top:= vrsekTahla 
          else posun:= 1;                                                                     
        if ( Top - staraPoziceTahla.Y + novaPoziceTahla.Y ) > spodekTahla then                 
          Top := spodekTahla                                                                   
            else                                                                             
          posun:= 1;                                                                           
// =============================================================================
        if posun = 1 then  Top := Top - staraPoziceTahla.Y + novaPoziceTahla.Y;
        staraPoziceTahla := novaPoziceTahla;
    end;
  end;
  aItem:= Round((ShapeTahlo.Top - vrsekTahla) / koeficientPosunu);
  if aItem > (ListView1.Items.Count - 1 - (ListView1.VisibleRowCount div 2)) then
      aItem:= (ListView1.Items.Count - 1 - (ListView1.VisibleRowCount div 2));
  if aItem < 0 then aItem:= 0;
  try
    li:= ListView1.Items[aitem + (ListView1.VisibleRowCount div 2)];
    R:= li.DisplayRect(drBounds);
    ListView1.Scroll(0, R.Top - ListView1.ClientHeight div 2);
  except
    aItem:= (ListView1.Items.Count - 1 - (ListView1.VisibleRowCount div 2));
    li:= ListView1.Items[aitem + (ListView1.VisibleRowCount div 2)];
    R:= li.DisplayRect(drBounds);
    ListView1.Scroll(0, R.Top - ListView1.ClientHeight div 2);
  end;
  Label1.Caption:= IntToStr(aItem);
end;

procedure TForm1.ShapeTahloMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if pohybTahlem then
  begin
    Screen.Cursor := crDefault;
    TMoveCracker(Sender).MouseCapture := False;
    pohybTahlem := False;
  end;
end;

end.

Just_jo díky ...
AMD FX-6300; Gigabyte 970A-DS3P; DDR3 8192MBytes; AMD Radeon HD 6700 Series
dyžon
Junior
Uživatelský avatar


Kdo je online

Uživatelé procházející toto fórum: Žádní registrovaní uživatelé a 0 návštevníků