⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 getglyphoutlineu.pas

📁 DelphiWin32核心API参考光盘内容.是学习书籍中的源码,便于学习.
💻 PAS
字号:
unit GetGlyphOutlineU;

{Special thanks to Marco Cocco for his valuable insight into making this
 example work.
 
 Note:  See Marco Cocco's excellent True Type Font to Vector conversion
        utility on the CD for an example of using GetGlyphOutline to retrieve
        font information in its native format.}

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    SpeedButton9: TSpeedButton;
    SpeedButton10: TSpeedButton;
    SpeedButton11: TSpeedButton;
    SpeedButton12: TSpeedButton;
    SpeedButton13: TSpeedButton;
    SpeedButton14: TSpeedButton;
    SpeedButton15: TSpeedButton;
    SpeedButton16: TSpeedButton;
    SpeedButton17: TSpeedButton;
    SpeedButton18: TSpeedButton;
    SpeedButton19: TSpeedButton;
    SpeedButton20: TSpeedButton;
    SpeedButton25: TSpeedButton;
    SpeedButton26: TSpeedButton;
    SpeedButton27: TSpeedButton;
    SpeedButton28: TSpeedButton;
    SpeedButton29: TSpeedButton;
    SpeedButton30: TSpeedButton;
    ScrollBar1: TScrollBar;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure ScrollBar1Change(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  SelectedChar: Byte;  // holds the selected character
  Angle: Integer;      // holds the rotation angle

implementation

{$R *.DFM}

function MakeFixed(Value: Double): TFixed;
var
  TheValue: longint;  // intermediate storage variable
begin
  {convert the indicated number into a TFixed record}
  TheValue := Trunc(Value*65536);
  Result := TFixed(Longint(TheValue));
end;

procedure DrawGlyph;
var
  BitmapSize: Longint;                // holds the required size of the bitmap
  BitmapBits: Pointer;                // a pointer to the bitmap
  BitmapInfo: Windows.TBitmap;        // Windows bitmap information
  GlyphBitmap: HBITMAP;               // a handle to the final bitmap
  GlyphMetrics: TGlyphMetrics;        // holds glyph metric information
  Matrix: TMat2;                      // holds the rotation matrix
begin
  {initialize the rotation matrix. note that all angle values
   must be converted to radians}
  Matrix.eM11 := MakeFixed(Cos(Angle*(PI/180)));
  Matrix.eM12 := MakeFixed(Sin(Angle*(PI/180)));
  Matrix.eM21 := MakeFixed(-Sin(Angle*(PI/180)));
  Matrix.eM22 := MakeFixed(Cos(Angle*(PI/180)));

  {retrieve the required size of the bitmap}
  BitmapSize := GetGlyphOutline(Form1.Canvas.Handle, SelectedChar, GGO_BITMAP,
                                GlyphMetrics, 0, NIL, Matrix);

  {allocate enough memory to hold the bitmap}
  GetMem(BitmapBits, BitmapSize);

  {retrieve the glyph bitmap}
  GetGlyphOutline(Form1.Canvas.Handle, SelectedChar, GGO_BITMAP, GlyphMetrics,
                  BitmapSize, BitmapBits, Matrix);

  {initialize the bitmap information structure to create
   an actual Windows bitmap}
  with BitmapInfo do
  begin
    bmType := 0;
    bmWidth := (GlyphMetrics.gmBlackBoxX+31) and not 31;
    bmHeight := GlyphMetrics.gmBlackBoxY;
    bmWidthBytes := bmWidth shr 3;
    bmPlanes := 1;
    bmBitsPixel := 1;
    bmBits := BitmapBits;
  end;

  {create the Windows bitmap}
  GlyphBitmap := CreateBitmapIndirect(BitmapInfo);

  {assign the final bitmap to the image for display}
  Form1.Image1.Picture.Bitmap.Handle := GlyphBitmap;
  Form1.Image1.Picture.Bitmap.Width := GlyphMetrics.gmBlackBoxX;

  {free the allocated bitmap memory}
  FreeMem(BitmapBits, BitmapSize);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  {create the image's bitmap and initialize variables}
  Image1.Picture.Bitmap := TBitmap.Create;
  SelectedChar := Ord('A');
  Angle := 0;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  {draw the bitmap upon activation}
  DrawGlyph;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  {select the indicated character and draw its bitmap}
  SelectedChar := Ord(PChar(TSpeedButton(Sender).Caption)[0]);
  DrawGlyph;
end;

procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
  {change the rotation angle and update the screen}
  Angle := ScrollBar1.Position;
  Label2.Caption := IntToStr(Angle);
  DrawGlyph;
end;



end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -