Proportionalschrift in Listbox

[eddy]

Hallo Hansa,

anbei ein Beispiel für die mehrspaltige Ausgabe. Ist zwar auf zwei gekürzt, kann aber beliebig erweitert werden.

Code:

{ lbxOrt.Style muß auf lbOwnerDrawFixed gesetzt sein für eigene Auswahlliste
  Ergebnis: 2-spaltige Tabelle (mehr ist möglich
  Nachteil: der Sprung auf den bereits eingegebenen Ort erfolgt nicht }
procedure TFKasse.lbxOrtDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  strVal, strAll : string;
  pos1, pos2 : integer;
  rc : TRect;
  arrWidth : array[0..3] of integer;
begin
  lbxOrt.Canvas.Brush.Style := bsSolid;
  lbxOrt.Canvas.FillRect(Rect);
  { Die einzelnen Spalten müssen durch ';' getrennt sein }
  strAll := lbxOrt.Items[Index];
  arrWidth[0] := 0;
  arrWidth[1] := 120;
  arrWidth[2] := lbxOrt.Width;

  { Zeichenbereich für erste Spalte }
  rc.Left := Rect.Left + arrWidth[0] + 2;
  rc.Right := Rect.Left + arrWidth[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);
  { Text ausgeben }
  lbxOrt.Canvas.TextRect(rc, rc.Left, rc.Top, strVal);
  { Trennlinie zwischen Spalten zeichnen }
  lbxOrt.Canvas.MoveTo(rc.Right, rc.Top);
  lbxOrt.Canvas.LineTo(rc.Right, rc.Bottom);
  { Zeichenbereich für zweite Spalte }
  rc.Left := Rect.Left + arrWidth[1] + 2;
  rc.Right := Rect.Left + arrWidth[2] - 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 }
  lbxOrt.Canvas.TextRect(rc, rc.Left, rc.Top, strVal);
  { Trennlinie zwischen Spalten zeichnen }
  lbxOrt.Canvas.MoveTo(rc.Right, rc.Top);
  lbxOrt.Canvas.LineTo(rc.Right, rc.Bottom);
end;

Im Anhang noch ein Bild, wie's aussieht.

mfg
eddy