getoutlinetextmetricsu.pas

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

unit GetOutlineTextMetricsU;

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;
    Label16: TLabel;
    Label17: TLabel;
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{note: the form must have a True Type font set as its selected font before.
 this example will work properly}

procedure TForm1.FormActivate(Sender: TObject);
var
  FontInfo: POutlineTextMetric;       // a pointer to the text metric info
  FaceName: array[0..255] of char;    // holds the font face name
  TheSize: LongInt;                   // holds the required buffer size
begin
  {retrieve and display the selected font's face name}
  GetTextFace(Form1.Canvas.Handle, 256, FaceName);
  Label2.Caption := FaceName;

  {retrieve the required buffer size}
  TheSize := GetOutlineTextMetrics(Form1.Canvas.Handle, 0, nil);

  {allocate the buffer}
  GetMem(FontInfo, TheSize);

  {set the size member}
  FontInfo^.otmSize := TheSize;

  {retrieve the True Type font attributes}
  GetOutlineTextMetrics(Form1.Canvas.Handle, TheSize,
                        FontInfo);

  {clear the list box and begin displaying the physical font attributes}
  ListBox1.Items.Clear;
  with FontInfo^.otmTextMetrics, 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}
    Add('Digitized Aspect X: '+IntToStr(tmDigitizedAspectX));
    Add('Digitized Aspect Y: '+IntToStr(tmDigitizedAspectY));

    {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;

  {display True Type specific information}
  with FontInfo^, ListBox1.Items do
  begin
    Add('');
    Add('');
    Add('True Type specific information');
    Add('--------------------------------');
    Add('');
    Add('Panose Information: ');

    {display the Panose family type}
    case otmPanoseNumber.bFamilyType of
      PAN_ANY:                 Add('     Family Type: Any');
      PAN_NO_FIT:              Add('     Family Type: No fit');
      PAN_FAMILY_TEXT_DISPLAY: Add('     Family Type: Text and display');
      PAN_FAMILY_SCRIPT:       Add('     Family Type: Script');
      PAN_FAMILY_DECORATIVE:   Add('     Family Type: Decorative');
      PAN_FAMILY_PICTORIAL:    Add('     Family Type: Pictorial');
    end;

    {display the Panose serif style}
    case otmPanoseNumber.bSerifStyle of
      PAN_ANY:                      Add('     Serif Style: Any');
      PAN_NO_FIT:                   Add('     Serif Style: No fit');
      PAN_SERIF_COVE:               Add('     Serif Style: Cove');
      PAN_SERIF_OBTUSE_COVE:        Add('     Serif Style: Obtuse cove');
      PAN_SERIF_SQUARE_COVE:        Add('     Serif Style: Square cove');
      PAN_SERIF_OBTUSE_SQUARE_COVE: Add('     Serif Style: Obtuse square cove');
      PAN_SERIF_SQUARE:             Add('     Serif Style: Square');
      PAN_SERIF_THIN:               Add('     Serif Style: Thin');
      PAN_SERIF_BONE:               Add('     Serif Style: Bone');
      PAN_SERIF_EXAGGERATED:        Add('     Serif Style: Exaggerated');
      PAN_SERIF_TRIANGLE:           Add('     Serif Style: Triangle');
      PAN_SERIF_NORMAL_SANS:        Add('     Serif Style: Normal sans serif');
      PAN_SERIF_OBTUSE_SANS:        Add('     Serif Style: Obtuse sans serif');
      PAN_SERIF_PERP_SANS:          Add('     Serif Style: Perp sans serif');
      PAN_SERIF_FLARED:             Add('     Serif Style: Flared');
      PAN_SERIF_ROUNDED:            Add('     Serif Style: Rounded');
    end;

    {display the Panose weight}
    case otmPanoseNumber.bWeight of
      PAN_ANY:               Add('     Weight: Any');
      PAN_NO_FIT:            Add('     Weight: No fit');
      PAN_WEIGHT_VERY_LIGHT: Add('     Weight: Very light');
      PAN_WEIGHT_LIGHT:      Add('     Weight: Light');
      PAN_WEIGHT_THIN:       Add('     Weight: Thin');
      PAN_WEIGHT_BOOK:       Add('     Weight: Book');
      PAN_WEIGHT_MEDIUM:     Add('     Weight: Medium');
      PAN_WEIGHT_DEMI:       Add('     Weight: Demi');
      PAN_WEIGHT_BOLD:       Add('     Weight: Bold');