gettextmetricsu.pas

DelphiWin32核心API参考光盘内容.是学习书籍中的源码,便于学习.

unit GetTextMetricsU;

interface

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

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Label1: TLabel;
    Bevel1: TBevel;
    Label2: TLabel;
    Image1: TImage;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormActivate(Sender: TObject);
var
  FontInfo: TTextMetric;            // holds the font metric information
  FaceName: array[0..255] of char;  // holds the font name
begin
  {retrieve the name of the currently selected font and display it}
  GetTextFace(Form1.Canvas.Handle, 256, FaceName);
  Label2.Caption := FaceName;

  {retrieve the physical attributes for the selected font}
  GetTextMetrics(Form1.Canvas.Handle, FontInfo);

  {clear the list box and begin displaying the physical font attributes}
  ListBox1.Items.Clear;
  with FontInfo, ListBox1.Items do
  begin
    {display the various font measurements}
    Label15.Caption := IntToStr(tmHeight);
    Label14.Caption := IntToStr(tmAscent);
    Label13.Caption := IntToStr(tmDescent);
    Label12.Caption := IntToStr(tmInternalLeading);
    Label11.Caption := IntToStr(tmExternalLeading);

    {display the average and maximum character width}
    Add('Average Char Width: '+IntToStr(tmAveCharWidth));
    Add('Max Char Width: '+IntToStr(tmMaxCharWidth));

    {display the boldness setting}
    case tmWeight of
      FW_DONTCARE:   Add('Weight: Don''t care');
      FW_THIN:       Add('Weight: Thin');
      FW_EXTRALIGHT: Add('Weight: Extra light');
      FW_LIGHT:      Add('Weight: Light');
      FW_NORMAL:     Add('Weight: Normal');
      FW_MEDIUM:     Add('Weight: Medium');
      FW_SEMIBOLD:   Add('Weight: Semibold');
      FW_BOLD:       Add('Weight: Bold');
      FW_EXTRABOLD:  Add('Weight: Extra bold');
      FW_HEAVY:      Add('Weight: Heavy');
    end;

    {display the overhang measurement}
    Add('Overhang: '+IntToStr(tmOverhang));

    {display the horizontal and vertical aspect.
     note: there is a bug in the GetTextMetrics function that causes these
     two values to be swapped.  the AspectX value is returned in the AspectY
     member, and vice versa}
    Add('Digitized Aspect X: '+IntToStr(tmDigitizedAspectY));
    Add('Digitized Aspect Y: '+IntToStr(tmDigitizedAspectX));

    {display the important font characters}
    Add('First Character: '+Char(tmFirstChar));
    Add('Last Char: '+Char(tmLastChar));
    Add('Default Char: '+Char(tmDefaultChar));
    Add('Break Char: '+Char(tmBreakChar));

    {indicate italic, underlined, or strikeout attributes}
    CheckBox1.Checked := (tmItalic>0);
    CheckBox2.Checked := (tmUnderlined>0);
    CheckBox3.Checked := (tmStruckOut>0);

    {display the font pitch}
    Add('Pitch: ');
    if ((tmPitchAndFamily and $0F) and TMPF_FIXED_PITCH)= TMPF_FIXED_PITCH then
      Add('     Fixed pitch');
    if ((tmPitchAndFamily and $0F) and TMPF_VECTOR) = TMPF_VECTOR then
      Add('     Vector');
    if ((tmPitchAndFamily and $0F) and TMPF_TRUETYPE) = TMPF_TRUETYPE then
      Add('     True Type');
    if ((tmPitchAndFamily and $0F) and TMPF_DEVICE) = TMPF_DEVICE then
      Add('     Device');
    if (tmPitchAndFamily and $0F) = 0 then
      Add('     Monospaced bitmap font');

    {display the font family}
    case (tmPitchAndFamily and $F0) of
      FF_DECORATIVE: Add('Family: Decorative');
      FF_DONTCARE:   Add('Family: Don''t care');
      FF_MODERN:     Add('Family: Modern');
      FF_ROMAN:      Add('Family: Roman');
      FF_SCRIPT:     Add('Family: Script');
      FF_SWISS:      Add('Family: Swiss');
    end;

    {display the character set}
    case tmCharSet of
      ANSI_CHARSET:        Add('Character set: ANSI');
      DEFAULT_CHARSET:     Add('Character set: Default');
      SYMBOL_CHARSET:      Add('Character set: Symbol');
      SHIFTJIS_CHARSET:    Add('Character set: ShiftJis');
      GB2312_CHARSET:      Add('Character set: GB2312');
      HANGEUL_CHARSET:     Add('Character set: Hangeul');
      CHINESEBIG5_CHARSET: Add('Character set: Chinese Big5');
      OEM_CHARSET:         Add('Character set: OEM');
    else
      Add('Windows 95 only character set');
    end;
  end;
end;
















end.