UNIT uMain;
INTERFACE
USES
Windows,
Messages,
SysUtils,
// Variants,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
Tlhelp32,
StdCtrls,
ShellAPI,
ExtCtrls;
TYPE
TListbox =
CLASS(StdCtrls.TListbox)
PRIVATE
PROCEDURE wmEraseBkGnd(
VAR Msg: TWMEraseBkGnd);
MESSAGE WM_ERASEBKGND;
END;
TForm1 =
CLASS(TForm)
ListBox1: TListBox;
Button1: TButton;
PROCEDURE FormCreate(Sender: TObject);
PROCEDURE ListBox1DrawItem(Control: TWinControl;
Index: Integer;
Rect: TRect; State: TOwnerDrawState);
PROCEDURE Button1Click(Sender: TObject);
PRIVATE
{ Private declarations }
PUBLIC
{ Public declarations }
END;
VAR
Form1 : TForm1;
CONST
// ListBox Spalten zeichnen
LB_RowWidth :
ARRAY[0..1]
OF integer = (0, 50);
// ListBox (ungerade/gerade) Spalten Farben
LB_arrColors :
ARRAY[Boolean]
OF TColor = ($CCCCCC, $99FFFF);
IMPLEMENTATION
{$R *.dfm}
PROCEDURE TListbox.wmEraseBkGnd(
VAR Msg: TWMEraseBkGnd);
VAR
cv : TCanvas;
h, max : Integer;
r, rc : TRect;
b : Boolean;
BEGIN
Msg.Result := 1;
h := Perform(LB_GETITEMHEIGHT, 0, 0);
IF h = LB_ERR
THEN h := ItemHeight;
cv := TCanvas.Create;
TRY
cv.Handle := Msg.DC;
r := Rect(0, 0, ClientWidth, h);
b := Odd(TopIndex)
AND (TopIndex >= 0);
max := ClientHeight;
cv.Brush.Style := bsSolid;
WHILE r.Top < max
DO
BEGIN
cv.Brush.Color := LB_arrColors[b];
b :=
NOT b;
cv.FillRect(r);
{ Zeichenbereich für erste Spalte }
rc.Left := r.Left + LB_RowWidth[0] + 2;
rc.Right := r.Left + LB_RowWidth[1] - 2;
rc.Top := r.Top;
rc.Bottom := r.Bottom;
{ Trennlinie zwischen Spalten zeichnen }
Canvas.MoveTo(rc.Right, rc.Top);
Canvas.LineTo(rc.Right, rc.Bottom);
OffsetRect(r, 0, h);
END;
FINALLY
cv.Handle := 0;
cv.Free;
END;
END;
PROCEDURE TForm1.FormCreate(Sender: TObject);
BEGIN
SetWindowPos(Form1.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE
OR SWP_NOSIZE);
END;
PROCEDURE TForm1.ListBox1DrawItem(Control: TWinControl;
Index: Integer;
Rect: TRect; State: TOwnerDrawState);
VAR
strVal, strAll :
STRING;
pos1, RowWidth : integer;
rc : TRect;
BEGIN
WITH Control
AS TListbox
DO
BEGIN
Canvas.Brush.Style := bsSolid;
Canvas.FillRect(Rect);
{ Die einzelnen Spalten müssen durch ';' getrennt sein }
strAll := Items[
Index];
RowWidth := Width;
{ Zeichenbereich für erste Spalte }
rc.Left := Rect.Left + LB_RowWidth[0] + 2;
rc.Right := Rect.Left + LB_RowWidth[1] - 2;
rc.Top := Rect.Top;
rc.Bottom := Rect.Bottom;
{ Text für erste Spalte ausfiltern }
pos1 := Pos('
;', strAll);
strVal := Copy(strAll, 1, pos1 - 1);
// Spalten färben
IF NOT (odSelected
IN State)
THEN
BEGIN
Canvas.Brush.Color := LB_arrColors[Odd(
Index)];
Canvas.Brush.Style := bsSolid;
END;
WITH Control
AS TListbox
DO
BEGIN
Canvas.FillRect(Rect);
Canvas.Brush.Style := bsClear;
{ Text ausgeben }
Canvas.TextRect(rc, rc.Left, rc.Top, strVal);
{ Trennlinie zwischen Spalten zeichnen }
Canvas.MoveTo(rc.Right, rc.Top);
Canvas.LineTo(rc.Right, rc.Bottom);
{ Zeichenbereich für zweite Spalte }
rc.Left := Rect.Left + LB_RowWidth[1] + 2;
rc.Right := Rect.Left + RowWidth - 2;
{ Text für zweite Spalte ausfiltern }
strAll := Copy(strAll, pos1 + 1, Length(strAll) - pos1);
pos1 := Pos('
;', strAll);
IF pos1 > 0
THEN
strVal := Copy(strAll, 1, pos1 - 1)
ELSE
strVal := strAll;
{ Text ausgeben }
Canvas.TextRect(rc, rc.Left, rc.Top, strVal);
{ Trennlinie zwischen Spalten zeichnen }
Canvas.MoveTo(rc.Right, rc.Top);
Canvas.LineTo(rc.Right, rc.Bottom);
END;
END;
END;
PROCEDURE TForm1.Button1Click(Sender: TObject);
BEGIN
SendMessage(ListBox1.Handle,
// This is the Handle of the ListBox to add the scroll bar to
LB_SetHorizontalExtent,
// The message to add the scroll bar
5000,
// The width in pixels that you wish to be scrollable
longint(0));
// not used
END;
END.