TListBox.MeasureItem i Delphi6

oog du har sat  typen til ownerdrawvariable ?

Jens B

Er det ikke fordi du har valgt et CLX app, prøv evt. at lave det om til VCL app, der er nok en bug. TWidgetControl er vist nok CLX

Det kan du lige stole på - MeasureItem bliver også afviklet.

egeskov>> Send lige dit project til Jens@Borrisholt.com så kigger jeg lige på det ----

Jens B

Jens B>> Det kan jeg desværre ikke, jeg har ingen mail her hvor jeg sidder.

Martin>> Hvordan kontrolere jeg om det er en CLX-app - Det skulle det ikke være.

Har du prøvet at refere direkte til din ListBox1.Objects[Index] istedet, det kunne jo nok også løse dit problem, og med mindre du skal bruge din event på flere listboxe, er det jo lige så godt

Det kan du se hvis du kigger i uses, hvis der står Q foran nogle af unit\'sne så er det en CLX\' app. Man prøv lige mit andet foreslag

martinlind >> Jeg har hørt at folk der pjækker fra eksperten-eventet ikke har taleret :-))))

JEns B

Martin>>Ja, jeg referere direkte, og jeg bruger ingen units med Q foran

egeskov det ER en clx Application du har ....

Jeg har lige laver en lille dims der viser hvilke fonte du har i dit system  :

procedure TForm1.FormCreate(Sender: TObject);
begin
  ListBox1.Items.Assign(Screen.Fonts);
  ListBox1.Style := lbOwnerDrawVariable;
end;

procedure TForm1.ListBox1DrawItem(Sender: TObject; Index: Integer;  Rect: TRect; State: TOwnerDrawState; var Handled: Boolean);
begin
  with ListBox1.Canvas do
  begin
    FillRect(Rect);
    Font.Name := ListBox1.Items[Index];
    Font.Size := 0;    // use font\'s preferred size
    TextOut(Rect.Left+1, Rect.Top+1, ListBox1.Items[Index]);
  end;
end;

procedure TForm1.ListBox1MeasureItem(Control: TWidgetControl; Index: Integer; var Height: Integer);
begin
  with (Control as TListBox).Canvas do
  begin
    Font.Name := (Control as TListBox).Items[Index];
    Font.Size := 0;                // use font\'s preferred size
    Height := TextHeight(\'Wg\') + 2; // measure ascenders and descenders
  end;
end;


prøv at se om du kan få noget ud af den ...

JEsn B

JB >> *GGG*

Borris>> I dit eks. bruger du jo ikke ListBox1.Items.Objects til noget?
Hvordan konkludere du at det er en CLX-app?

Fordi du har en TWidgetControl, det er en CLX klasse.

Det fungere i CLX men ikke i VCL - Der kommer vel snart en update?

Man har da lov at håbe *S*

egeskov>>

JEg ved ikke hvad dit problem er ... Det her virker find BÅDE som VCL OG CLX :

type
  TStirngObject = class
  private
    FString : String;
  public
    constructor Create(aString : String);
    property _String : String read FString;
  end;

{ TStirngObject }

constructor TStirngObject.Create(aString: String);
begin
  inherited Create;
  FString := aString;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
  i : Integer;
begin
  for i:= 0 to Screen.Fonts.Count -1 do
  begin
    Listbox1.Items.Add(Screen.Fonts[i]);
    ListBox1.Items.Objects[i] := TStirngObject.Create(Screen.Fonts[i]);
  end;
end;

procedure TForm1.ListBox1DrawItem(Sender: TObject; Index: Integer;  Rect: TRect; State: TOwnerDrawState; var Handled: Boolean);
var
  StirngObject : TStirngObject;
begin
  with ListBox1.Canvas do
  begin
    FillRect(Rect);
    Font.Name := ListBox1.Items[Index];
    Font.Size := 0;    // use font\'s preferred size
    TextOut(Rect.Left+1, Rect.Top+1, ListBox1.Items[Index]);
    StirngObject :=  TStirngObject(ListBox1.Items.Objects[Index]);
    Caption := StirngObject._String;
  end;
end;

procedure TForm1.ListBox1MeasureItem(Control: TWidgetControl; Index: Integer; var Height: Integer);
begin
  with (Control as TListBox).Canvas do
  begin
    Font.Name := (Control as TListBox).Items[Index];
    Font.Size := 0;                // use font\'s preferred size
    Height := TextHeight(\'Wg\') + 2; // measure ascenders and descenders
  end;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  FontLabel.Caption := ListBox1.Items[ListBox1.ItemIndex];
  FontLabel.Font.Name := ListBox1.Items[ListBox1.ItemIndex];
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  i : Integer;
  StirngObject : TStirngObject;
begin
  for i:= 0 to ListBox1.Items.Count -1 do
  begin
    StirngObject := TStirngObject(ListBox1.Items.Objects[i]);
    StirngObject.Free;
  end;
end;

Jens B

Jens >> Nu bruger du jo også CLX:
procedure ListBox1MeasureItem(Control: <STRONG>TWidgetControl<STRONG>; Index: Integer; var Height: Integer);

Jeg kan ikke få det til at fungere med VCL?

det her virker fint hos mig :

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    FontLabel: TLabel;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;  Rect: TRect; State: TOwnerDrawState);
    procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TStirngObject = class
  private
    FString : String;
  public
    constructor Create(aString : String);
    property _String : String read FString;
  end;

{ TStirngObject }

constructor TStirngObject.Create(aString: String);
begin
  inherited Create;
  FString := aString;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
  i : Integer;
begin
  for i:= 0 to Screen.Fonts.Count -1 do
  begin
    Listbox1.Items.Add(Screen.Fonts[i]);
    ListBox1.Items.Objects[i] := TStirngObject.Create(Screen.Fonts[i]);
  end;
end;


procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;  Rect: TRect; State: TOwnerDrawState);
var
  StirngObject : TStirngObject;
begin
  with ListBox1.Canvas do
  begin
    FillRect(Rect);
    Font.Name := ListBox1.Items[Index];
    Font.Size := 0;    // use font\'s preferred size
    TextOut(Rect.Left+1, Rect.Top+1, ListBox1.Items[Index]);
    StirngObject :=  TStirngObject(ListBox1.Items.Objects[Index]);
    Caption := StirngObject._String;
  end;
end;

procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
begin
  with (Control as TListBox).Canvas do
  begin
    Font.Name := (Control as TListBox).Items[Index];
    Font.Size := 0;                // use font\'s preferred size
    Height := TextHeight(\'Wg\') + 2; // measure ascenders and descenders
  end;
end;

end.


Jens B

Jens >>
Du tilgår ikke ListBox\'ens objekter fra Measure-rutinen. Jeg har ændret det i din kode, jeg får en accessviolation når jeg prøver at tilgå objekterne. Se om du kan få den her til at fungere?

procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer; var Height: Integer);
var s    : string;
begin
  with (Control as TListBox).Canvas do
  begin
    Font.Name := (Control as TListBox).Items[Index];
    Font.Size := 0;                // use font\'s preferred size

    s:=TStirngObject(TListBox(Control).Items.Objects[Index])._String;

    Height := TextHeight(s) + 2; // measure ascenders and descenders
  end;
end;

- Anders

Anders >> Efter nogle forsøg er jeg kommer rundt til at det ikke lan lade sig gøre at til gå Items der hvor du gerne vil. roblemet er den måde en ListBox fungerer på. Den tilføjer først strenge så måler den størellsen af sine Items. Så der efter tilføjer den data ...

Hvis du vil gøre det du havde gang i skal du lave et lille hack. Duy opretter en ekstern liste af objecter som du så initialicer INDEN du tilføjer dine strenge .. Så henter du blor dine objects der.

Jens B