具有不同字体的列表框

在一个 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

附件列表