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.