具有不同字体的列表框

在一个 LISTBOX 中显示所见所得字体 这个方法设置Combobox同样有效

ComboboxFont

具有不同字体的列表框

    

 

 

 

 

unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  ListBox1.Style:=lbOwnerDrawFixed;
  Listbox1.Items:=Screen.Fonts;

  ComboBox1.Style:=csOwnerDrawFixed;
  ComboBox1.Items:=Screen.Fonts;
end;

    
//------------------------------------------------------------------------------
//ListBox

procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer;
  var Height: Integer);
var
   h : integer ;
begin
     with Control as TListBox do
     begin
        Canvas.Font.Name := Items[Index] ;
        h := Canvas.TextHeight(Items[Index]) ;
     end ;
     Height := h ;
end ;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
     with Control as TListBox do
     begin
        Canvas.Font.Name := Items[Index] ;
        Canvas.FillRect(Rect) ;
        Canvas.TextOut(Rect.Left, Rect.Top, Items[Index]) ;
     end ;
end ;

//------------------------------------------------------------------------------
//Combobox
procedure TForm1.ComboBox1MeasureItem(Control: TWinControl; Index: Integer;
  var Height: Integer);
var
   h : integer ;
begin
     with Control as TComboBox do
     begin
        Canvas.Font.Name := Items[Index] ;
        h := Canvas.TextHeight(Items[Index]) ;
     end ;
     Height := h ;
end ;


procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
     with Control as TComboBox do
     begin
        Canvas.Font.Name := Items[Index] ;
        Canvas.FillRect(Rect) ;
        Canvas.TextOut(Rect.Left, Rect.Top, Items[Index]) ;
     end ;
end ;
//------------------------------------------------------------------------------






end.

来自为知笔记(Wiz)Time=2013-06-19 11:52:16

附件列表