TComboBox wordwrap

[hoika]

Hallo,

der untenstehende Code funktioniert leider nicht richtig.
wenn Text wirklich umgebrochen werden soll, bei einfachem 1,2,3 klappt es.

Ich bin schon in den Quellen der TComboBox, kommt aber nicht weiter ;(

Ich denke, es hat irgendwas mit dem OnDrawItem zu tun.
Das MeasureItem liefert mir eigentlich die korrekten Höhen.

Kann hier jemand helfen?

Danke


Heiko

Delphi-Quellcode:

// http://www.programmersforum.ru/showthread.php?t=135902
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    ComboBox1: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure ComboBox1MeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
  private
    { Private-Deklarationen }

  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


procedure TForm1.ComboBox1MeasureItem(Control: TWinControl; Index: Integer;
  var Height: Integer);
var
  StrVal, StrTmp :string;
  I,L,ChL :Integer;
  Cb :TComboBox;
  R :TRect;
begin
 if Index >= 0 then
 begin
  Cb := (Control as TComboBox);
   // v1
//  with Cb do
//  begin
//   StrVal := Items.Strings[index];
//   DrawText(Canvas.Handle,
//            PAnsiChar(StrVal),
//            Length(StrVal),
//            R,
//            DT_LEFT or DT_TOP or DT_EXTERNALLEADING or
//            Dt_NoPrefix or DT_WORDBREAK or DT_CALCRECT
//           );
//  end;
//  Height := R.Bottom - R.Top;
  // v2
  with Cb do
  begin
    StrVal := Items.Strings[Index];
    ChL := Canvas.TextWidth('W');
    L := ClientWidth - 16 - 2;
    If Canvas.TextWidth(StrVal) <= L Then Exit;
    StrTmp := WrapText(StrVal, L div ChL);
    I := 1;
    while Pos(#$D#$A, StrTmp) > 0 do
    begin
     Inc(I);
     strTmp := Copy(strTmp, Pos(#13#10, strTmp) + 2, Length(strTmp));
    end;
  end;
  Height := I * Cb.ItemHeight + I*2;

  Height :=150;
 end;
end;

procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  R :TRect;
begin
 With (Control as TComboBox) do
 begin
  if odSelected in State then
   Canvas.Brush.color := clMoneyGreen
  else
   Canvas.Brush.color := clWindow;
  Canvas.FillRect(Rect);
  R := Rect;
  R.Left := R.Left + 16 + 2;
  SetBKMode(Canvas.Handle, TRANSPARENT);
  DrawText(Canvas.Handle,
           PAnsiChar(Items.Strings[index]),
           Length(Items.Strings[index]),
           R,
           DT_LEFT or DT_TOP or DT_EXTERNALLEADING or
           Dt_NoPrefix or DT_WORDBREAK
          );
 end;

end;

procedure TForm1.FormCreate(Sender: TObject);
var
  S :string;
begin
  //
 ComboBox1.Anchors := ComboBox1.Anchors + [akRight];
 ComboBox1.ItemHeight := 16;
 ComboBox1.DropDownCount := 20;
 ComboBox1.Style := csOwnerDrawVariable;

 // klappt nicht
 ComboBox1.Items.Add('Das ist ein langer langer Text');
 ComboBox1.Items.Add('Das ist ein langer langer Text');

 // klappt
 //ComboBox1.Items.Add('1');
 //ComboBox1.Items.Add('2');
 //ComboBox1.Items.Add('3');
end;

end.

[hoika]

Hallo,

bin jetzt weiter, die mit v1 ausgeklammerte Funktion DrawText wird falsch aufgerufen (Rect nicht initialisiert),
die v2 macht Murks.


Heiko