// Declaration: createfontindirect (const P1: tlogfont {font structure}): hfont; {new font pointer returned} // tlogfont is the redefinition of the taglogfonta structure: taglogfonta = packed record lfheight: longint; {font height} lfwidth: longint; {average font width} lfescapement: longint; {angle, in 1/10 degrees} lforientation: longint; {baseline angle} lfweight: longint; {bold, value: 0-1000} lfitalic: byte; {italic} lfunderline: byte; {underline} lfstrikeout: byte; {strikethrough} lfcharset: byte; {Character Set} lfoutprecision: byte; {output precision} lfclipprecision: byte; {cropping precision} lfquality: byte; {output quality} lfpitchandfamily: byte; {spacing and Word Family} lffacename: array [0 .. lf_facesize-1] of ansichar; {name} end;
// Example 1: Procedure tform1.formmouseup (Sender: tobject; button: tmousebutton; shift: tshiftstate; X, Y: integer); var fontinfo: tlogfont; {declare font structure} fh1, fh2: hfont; {declare font handle} const STR = 'delphi blog'; begin {define font features} fontinfo. lfheight: = 0; {value 0. The system automatically gives a value} fontinfo. lfwidth: = 0; {value 0, the system automatically gives a value} fontinfo. lfescapement: = 0; {No angle} fontinfo. lfweight: = 500; {medium bold} fontinfo. lfitalic: = 0; {non-italic} fontinfo. lfunderline: = 0; {No underline} fontinfo. lfstrikeout: = 0; {No strikethrough} fontinfo. lffacename: = ' '; fh1: = createfontindirect (fontinfo); fh2: = SelectObject (canvas. handle, fh1); {use createfontindirect to create a logical font; Use SelectObject to select a device; and return the font handle} textout (canvas. handle, X, Y, STR, length (STR); deleteobject (fh1); deleteobject (fh2); end;
//:
// Example 2: flattened procedure tform1.formmouseup (Sender: tobject; button: tmousebutton; shift: tshiftstate; X, Y: integer); var fontinfo: tlogfont; fh1, fh2: hfont; const STR = 'delphi blog'; begin fontinfo. lfheight: = 0; fontinfo. lfwidth: = 12; {only modified here} fontinfo. lfescapement: = 0; fontinfo. lfweight: = 500; fontinfo. lfitalic: = 0; fontinfo. lfunderline: = 0; fontinfo. lfstrikeout: = 0; fontinfo. lffacename: = ' '; fh1: = createfontindirect (fontinfo); fh2: = SelectObject (canvas. handle, fh1); textout (canvas. handle, X, Y, STR, length (STR); deleteobject (fh1); deleteobject (fh2); end;
//:
// Example 3: long procedure tform1.formmouseup (Sender: tobject; button: tmousebutton; shift: tshiftstate; X, Y: integer); var fontinfo: tlogfont; fh1, fh2: hfont; const STR = 'delphi blog'; begin fontinfo. lfheight: = 32; {modified here} fontinfo. lfwidth: = 12; fontinfo. lfescapement: = 0; fontinfo. lfweight: = 500; fontinfo. lfitalic: = 0; fontinfo. lfunderline: = 0; fontinfo. lfstrikeout: = 0; fontinfo. lffacename: = ' '; fh1: = createfontindirect (fontinfo); fh2: = SelectObject (canvas. handle, fh1); textout (canvas. handle, X, Y, STR, length (STR); deleteobject (fh1); deleteobject (fh2); end;
//:
// Example 4: Rotate procedure tform1.formmouseup (Sender: tobject; button: tmousebutton; shift: tshiftstate; X, Y: integer); var fontinfo: tlogfont; fh1, fh2: hfont; const STR = 'delphi blog'; begin fontinfo. lfheight: = 0; fontinfo. lfwidth: = 0; fontinfo. lfescapement: = 450; {modified here} fontinfo. lfweight: = 500; fontinfo. lfitalic: = 0; fontinfo. lfunderline: = 0; fontinfo. lfstrikeout: = 0; fontinfo. lffacename: = ' '; fh1: = createfontindirect (fontinfo); fh2: = SelectObject (canvas. handle, fh1); textout (canvas. handle, X, Y, STR, length (STR); deleteobject (fh1); deleteobject (fh2); end;
//:
// Example of an utilization angle: Procedure tform1.formpaint (Sender: tobject); var fontinfo: tlogfont; fh1, fh2: hfont; x, y, I: integer; const STR = 'delphi blog'; begin fontinfo. lfheight: = 0; fontinfo. lfwidth: = 0; fontinfo. lfescapement: = 0; fontinfo. lfweight: = 1000; fontinfo. lfitalic: = 0; fontinfo. lfunderline: = 0; fontinfo. lfstrikeout: = 0; fontinfo. lffacename: = ' '; X: = clientwidth Div 2; Y: = clientheight Div 2; setbkmode (canvas. handle, transparent); I: = 0; while I //: