ScroolListBox

ScroolListbox, C# ile yazılmış olan KListControl çevirdim. Gerçi WM 6 dan sonra gestures geliyor ve Listbox gibi bileşenlerde destekleniyor fakat daha eski cihazlarda ve daha özelleştirebilir uygulamalar için kullanabilirsiniz.

Önizleme

Yukarıda görüldüğü gibi parmakla aşağı yukarı kaydırıp çift tıklama ile seçim yapabilirsiniz.

Kaynak Kodu
[code lang=”Delphi”]
unit ScroolListbox;

interface

uses
Windows, KOL;

type

{ TScroolListbox }
TBasimbilgisi = procedure(Sender: TObject; id: integer) of object;

TScroolListbox = class(TObject)
private
FOnBasim: TBasimbilgisi;
FSecimYaziRengi: Tcolor;
mousebasili: boolean;
ScroolListbox: PControl;
m_updating: boolean;
m_selectedIndex: tpoint;
m_velocity: tpoint;
m_mouseDown: Tpoint;
m_mousePrev: tpoint;
m_timerCount: integer;
m_offset: Tpoint;
m_timer: Ttimer;

FListe: PKOLStrList;
FItemHeight: integer;
FMaxVelocity: integer;
FItemWidth: integer;
FCizgiRengi: tcolor;
FSecimZeminRengi: TColor;
ilkbasis: dword;
function MaxXOffset: integer;
function MaxYOffset: integer;

procedure m_timer_Tick(Sender: PObj);
procedure SetItemHeight(const Value: integer);
procedure SetMaxVelocity(const Value: integer);
procedure SetItemWidth(const Value: integer);
procedure ClipVelocity;
procedure ClipScrollPosition;
function FindIndex(x, y: integer): tpoint;
function ItemBounds(x, y: integer): trect;
procedure SetSecimYaziRengi(const AValue: Tcolor);
procedure Temizle;
procedure CizgiCiz(t: Trect);
procedure Render(b: TRect; yazi: kolstring; index: integer);
procedure SetCizgiRengi(const Value: tcolor);
procedure SetSecimZeminRengi(const Value: TColor);
protected

{ Protected declarations }
m_backBufferBitmap: pBitmap;

procedure CleanupBackBuffer;
procedure CreateBackBuffer;
procedure REset;
procedure Resize(Sender: pobj);
procedure SMouseDown(Sender: PControl; var Mouse: TMouseEventData);
procedure SMouseMove(Sender: PControl; var Mouse: TMouseEventData);
procedure SMouseUp(Sender: PControl; var Mouse: TMouseEventData);
procedure SMouseDbl(Sender: PControl; var Mouse: TMouseEventData);
procedure FontDegisti(Sender: PGraphicTool);
procedure Paint(Sender: PControl; DC: HDC);

public
constructor Create(parent: PControl; x, y, w, h: integer; t: TControlAlign = caNone);
overload;
destructor Destroy; override;
function getScrollBox: PControl;
procedure SetListe(const Value: TStrList);
function SlectItem: integer;
function Liste: PKOLStrList;

published
property ItemHeight: integer Read FItemHeight Write SetItemHeight default 25;
property ItemWidth: integer Read FItemWidth Write SetItemWidth default 240;
property MaxVelocity: integer Read FMaxVelocity Write SetMaxVelocity default 15;
property CizgiRengi: tcolor Read FCizgiRengi Write SetCizgiRengi default clSilver;
property SecimZeminRengi: TColor Read FSecimZeminRengi Write SetSecimZeminRengi default clSkyBlue;
property SecimYaziRengi: Tcolor Read FSecimYaziRengi Write SetSecimYaziRengi default clWhite;
property OnBasim: TBasimbilgisi Read FOnBasim Write FOnBasim;

end;

implementation

{ TScroolListbox }

procedure TScroolListbox.CleanupBackBuffer;
begin

if m_backBufferBitmap <> nil then
begin
m_backBufferBitmap.Free;
m_backBufferBitmap := nil;

end;
end;

constructor TScroolListbox.Create(parent: PControl; x, y, w, h: integer;
t: TControlAlign = caNone); overload;
begin
ScroolListbox := NewPaintbox(parent);
ilkbasis := 0;
ScroolListbox.Border := 0;
mousebasili := False;
{$ifdef Win32}
FListe := NewStrList;
{$ELSE}
FListe := NewWStrList;
{$endif}
CreateBackBuffer;
FItemHeight := 50;
FMaxVelocity := 15;
FItemWidth := 240;
m_updating := False;
m_selectedIndex.x := -1;
m_selectedIndex.y := -1;
m_velocity.x := 0;
m_velocity.y := 0;
m_mouseDown.x := -1;
m_mouseDown.y := -1;
m_mousePrev.x := -1;
m_mousePrev.y := -1;
m_timer := NewTimer(10)^;
m_timer.Interval := 10;
m_timer.Enabled := False;
m_timer.OnTimer := m_timer_Tick;
FCizgiRengi := clSilver;
FSecimZeminRengi := clSkyBlue;
FSecimYaziRengi := clWhite;
m_timerCount := 0;
ScroolListbox.Width := w;
ScroolListbox.Height := h;
ScroolListbox.Top := y;
ScroolListbox.Color := clWhite;
ScroolListbox.Left := x;
ScroolListbox.OnPaint := Paint;
ScroolListbox.OnResize := Resize;
ScroolListbox.OnMouseDown := SMouseDown;
ScroolListbox.OnMouseUp := SMouseUp;
ScroolListbox.OnMouseMove := SMouseMove;
ScroolListbox.OnMouseDblClk := SMouseDbl;
ScroolListbox.Font.OnChange := FontDegisti;
ScroolListbox.Align := t;

ScroolListbox.Show;
end;

procedure TScroolListbox.CreateBackBuffer;
begin
CleanupBackBuffer;
//ShowMessage(Int2Str(ScroolListbox.Width));
m_backBufferBitmap := NewBitmap(ScroolListbox.Width, ScroolListbox.Height);
m_backBufferBitmap.Canvas.font.Assign(ScroolListbox.font);

end;

destructor TScroolListbox.Destroy;
begin
FListe.Free;
m_timer.Enabled := False;
m_timer.Free;
CleanupBackBuffer;
ScroolListbox.Free;
inherited;
end;

function TScroolListbox.getScrollBox: PControl;
begin
Result := ScroolListbox;
end;

procedure TScroolListbox.SMouseDown(Sender: PControl; var Mouse: TMouseEventData);
begin
{$IFDEF Wince}
// çift tıklama WinCe de malesef cevap vermiyor. Bunun için eklendi.
if (ilkbasis = 0) or ((Gettickcount – ilkbasis) > 300) or
((Gettickcount – ilkbasis) < 100) then
ilkbasis := Gettickcount
else
begin
ilkbasis := 0;
if Assigned(OnBasim) then
onbasim(Self, m_selectedIndex.y);
exit;
end;
{$endif}

SetFocus(ScroolListbox.Handle);
SetCapture(ScroolListbox.Handle);
m_mouseDown.X := Mouse.Y;
m_mouseDown.Y := Mouse.Y;
m_mousePrev := m_mouseDown;
mousebasili := True;
end;

procedure TScroolListbox.ClipVelocity;
begin
m_velocity.X := Min(m_velocity.X, FMaxVelocity);
m_velocity.X := Max(m_velocity.X, -FMaxVelocity);

m_velocity.Y := Min(m_velocity.Y, FMaxVelocity);
m_velocity.Y := Max(m_velocity.Y, -FMaxVelocity);
end;

procedure TScroolListbox.ClipScrollPosition;
begin
if (m_offset.X < 0) then begin m_offset.X := 0; m_velocity.X := 0; end else if (m_offset.X > MaxXOffset) then
begin
m_offset.X := MaxXOffset;
m_velocity.X := 0;
end;

if (m_offset.Y < 0) then begin m_offset.Y := 0; m_velocity.Y := 0; end else if (m_offset.Y > MaxYOffset) then
begin
m_offset.Y := MaxYOffset;
m_velocity.Y := 0;
end;

end;

function TScroolListbox.FindIndex(x, y: integer): tpoint;
begin
Result.X := 0;
Result.Y := 0;
Result.Y := ((y + m_offset.Y – 0) div (FItemHeight));

end;

procedure TScroolListbox.SMouseMove(Sender: PControl; var Mouse: TMouseEventData);
var
currPos: TPoint;
distanceX, distanceY: integer;
begin

inherited;
if mousebasili then
begin

currPos.X := Mouse.X;
currPos.Y := Mouse.Y;
distanceX := m_mousePrev.X – currPos.X;
distanceY := m_mousePrev.Y – currPos.Y;
m_velocity.X := distanceX div 2;
m_velocity.Y := distanceY div 2;
ClipVelocity;

m_offset.X := m_offset.X + distanceX;
m_offset.Y := m_offset.Y + distanceY;
ClipScrollPosition;

m_mousePrev := currPos;

ScroolListbox.Invalidate;

end;

end;

procedure TScroolListbox.m_timer_Tick(Sender: pObj);
begin

if (ScroolListbox.handle <> GetCapture) and (m_velocity.Y <> 0) or
(m_velocity.X <> 0) then
begin
ilkbasis := 0;
m_offset.X := m_offset.X + m_velocity.X;
m_offset.Y := m_offset.Y + m_velocity.Y;
ClipScrollPosition;
Inc(m_timerCount);

if (((m_timerCount) mod 10) = 0) then
begin
if (m_velocity.Y < 0) then begin m_velocity.Y := m_velocity.Y + 1; end else if (m_velocity.Y > 0) then
begin
m_velocity.Y := m_velocity.Y – 1;
end;
if (m_velocity.X < 0) then begin m_velocity.X := m_velocity.X + 1; end else if (m_velocity.X > 0) then
begin
m_velocity.X := m_velocity.X – 1;
end;
end;
if (m_velocity.Y = 0) and (m_velocity.X = 0) then
begin
m_timer.Enabled := False;

end;
ScroolListbox.Invalidate;
end;

end;

procedure TScroolListbox.REset;
begin
if not m_updating then
begin
m_timer.Enabled := False;
m_selectedIndex.x := -1;
m_selectedIndex.y := -1;

ReleaseCapture;
m_velocity.X := 0;
m_velocity.Y := 0;
m_offset.X := 0;
m_offset.Y := 0;
ilkbasis := 0;

end;
end;

procedure TScroolListbox.Resize(Sender: pobj);
begin
CreateBackBuffer;
FItemWidth := ScroolListbox.Width;
REset;
end;

procedure TScroolListbox.SetItemHeight(const Value: integer);
begin
FItemHeight := Value;
REset;
end;

procedure TScroolListbox.SetItemWidth(const Value: integer);
begin
FItemWidth := Value;
REset;
end;

procedure TScroolListbox.SetListe(const Value: TStrList);
begin

FListe.Assign(@Value);

end;

function TScroolListbox.SlectItem: integer;
begin
Result := m_selectedIndex.y;
end;

function TScroolListbox.Liste: PKOLStrList;
begin
Result := FListe;
end;

procedure TScroolListbox.SetMaxVelocity(const Value: integer);
begin
FMaxVelocity := Value;
end;

function TScroolListbox.MaxXOffset: integer;
begin
Result := Max(((FListe.Count * FItemWidth)) – ScroolListbox.Width, 0);
end;

function TScroolListbox.MaxYOffset: integer;
begin
Result := Max(((FListe.Count * FItemHeight)) – ScroolListbox.Height, 0);
end;

procedure TScroolListbox.SMouseUp(Sender: PControl; var Mouse: TMouseEventData);
var
sameX, samey: boolean;
selectedIndex: tpoint;
begin
inherited;

sameX := Abs(Mouse.X – m_mouseDown.X) < FItemWidth;
sameY := Abs(Mouse.Y – m_mouseDown.Y) < FItemHeight;
if samey then
begin
selectedIndex := FindIndex(mouse.x, mouse.y);
if selectedIndex.y <> m_selectedIndex.y then
begin
m_selectedIndex := selectedIndex;
end;
m_velocity.X := 0;
m_velocity.y := 0;
end
else
begin
m_timer.Enabled := True;
end;
m_mouseDown.y := -1;
//MouseCapture := False;
mousebasili := False;
ReleaseCapture;
ScroolListbox.Invalidate;

end;

procedure TScroolListbox.SMouseDbl(Sender: PControl; var Mouse: TMouseEventData);
begin
if Assigned(OnBasim) then
onbasim(Self, m_selectedIndex.y);
end;

procedure TScroolListbox.FontDegisti(Sender: PGraphicTool);
begin
if m_backBufferBitmap <> nil then
m_backBufferBitmap.canvas.font.Assign(Sender);
inherited;

end;

function TScroolListbox.ItemBounds(x, y: integer): trect;
var
itemX, itemY: integer;
begin
itemX := (FItemWidth * x);
itemY := (FItemHeight * y);
SetRect(Result, 0, itemY, FItemWidth, FItemHeight + itemY);

end;

procedure TScroolListbox.SetSecimYaziRengi(const AValue: Tcolor);
begin
if FSecimYaziRengi = AValue then
exit;
FSecimYaziRengi := AValue;
ScroolListbox.Invalidate;
end;

procedure TScroolListbox.Render(b: TRect; yazi: KOLString; index: integer);
var
textBounds: TRect;
begin
textBounds := b;
if index = m_selectedIndex.Y then
begin
textBounds.Top := textBounds.Top + 1;
m_backBufferBitmap.Canvas.pen.Penstyle := psClear;
m_backBufferBitmap.Canvas.Brush.Color := FSecimZeminRengi;
m_backBufferBitmap.Canvas.Rectangle(textBounds.Left, textBounds.Top,
textBounds.Right, textBounds.Bottom);
m_backBufferBitmap.Canvas.Brush.BrushStyle := bsClear;
m_backBufferBitmap.Canvas.Pen.PenStyle := psSolid;
m_backBufferBitmap.canvas.font.color := FSecimYaziRengi;
end
else
m_backBufferBitmap.canvas.font.color := ScroolListbox.Font.Color;

SetBkMode(m_backBufferBitmap.Canvas.Handle, TRANSPARENT);
textBounds := b;
InflateRect(textBounds, -2, -1);
m_backBufferBitmap.canvas.DrawText(yazi, textBounds, DT_LEFT or
DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);

end;

procedure TScroolListbox.CizgiCiz(t: Trect);
begin
m_backBufferBitmap.Canvas.Pen.Color := FCizgiRengi;

m_backBufferBitmap.Canvas.MoveTo(t.Left, t.Top);
m_backBufferBitmap.Canvas.LineTo(t.Right, t.Top);

m_backBufferBitmap.Canvas.MoveTo(t.Left, t.Bottom);
m_backBufferBitmap.Canvas.LineTo(t.Right, t.Bottom);
m_backBufferBitmap.Canvas.Pen.Color := clBlack;

end;

procedure TScroolListbox.Temizle;
var
al: TRect;
begin

SetBkMode(m_backBufferBitmap.Canvas.Handle, OPAQUE);
GetClipBox(m_backBufferBitmap.Canvas.Handle, al);
m_backBufferBitmap.Canvas.Brush.Color := ScroolListbox.Color;
m_backBufferBitmap.Canvas.Pen.Color := FCizgiRengi;
m_backBufferBitmap.Canvas.Brush.BrushStyle := bsSolid;
FillRect(m_backBufferBitmap.Canvas.Handle, al, m_backBufferBitmap.Canvas.Brush.Handle);

end;

procedure TScroolListbox.Paint(Sender: PControl; DC: HDC);
var
startIndex, endindex: integer;
itemRect: TRect;
i: integer;
begin

if m_backBufferBitmap <> nil then
begin
Temizle;

startIndex := FindIndex(0, 0).Y – 1;
if startIndex < 0 then startIndex := 0; endindex := FindIndex(0, ScroolListbox.Height).Y + 1; if endindex > FListe.Count then
endindex := FListe.Count;
for i := startIndex to endindex – 1 do
begin
itemRect := ItemBounds(0, i);
OffsetRect(itemRect, 0, -m_offset.Y);

if (itemRect.Bottom < ScroolListbox.Height + FItemHeight + 10) or (itemRect.Top > -FItemHeight) then
begin
CizgiCiz(itemRect);
Render(itemRect, FListe.Items[i], i);
end;
end;
BitBlt(Sender.Canvas.Handle, 0, 0, ScroolListbox.Width, ScroolListbox.Height,
m_backBufferBitmap.Canvas.Handle, 0, 0, SRCCOPY);

end;
end;

procedure TScroolListbox.SetCizgiRengi(const Value: tcolor);
begin
if FCizgiRengi <> Value then
begin
FCizgiRengi := Value;
ScroolListbox.Invalidate;
end;
end;

procedure TScroolListbox.SetSecimZeminRengi(const Value: TColor);
begin
if FSecimZeminRengi <> Value then
begin
FSecimZeminRengi := Value;
ScroolListbox.Invalidate;
end;
end;

end.

[/code]

Birazda kullanmadan bahsedelim.
[code lang=”Delphi”]
procedure TForm1.Olustur;
var
i :integer;
begin
ScroolListbox:=TScroolListbox.Create(Form,0,0,0,0,caClient);
ScroolListbox.getScrollBox.Font.FontName:=’Arial’;
ScroolListbox.getScrollBox.Font.FontHeight:=15;
ScroolListbox.CizgiRengi:=clLtGray;
ScroolListbox.OnBasim:=DoubleClick;

for i:=0 to 100 do
ScroolListbox.Liste.Add(‘Deneme: ‘+int2str(i));
end;
[/code]

Yukarıdaki komut bloğu gibi oluşturabilirsiniz.
Çift tıklama olayı aşağıdaki gibi tanımladım. Burada listenin id sini geri döndürüyor.
TBasimbilgisi = procedure(Sender: TObject; id: integer) of object;
procedure DoubleClick(sender :TObject;idx :integer); bunun gibi bir prosedür ile atama yapabilirsiniz.

İlgili Dosyalar
scroolbox demo

Bir cevap yazın

E-posta hesabınız yayımlanmayacak. Gerekli alanlar * ile işaretlenmişlerdir