tabbedtextoutu.pas

来自「delphi win32api编程」· PAS 代码 · 共 92 行

unit TabbedTextOutU;

interface

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

type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure PaintBox1Paint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

{Whoops!  Delphi incorrectly imports this function, so we must reimport it
 manually to obtain the full functionality of this function}
function TabbedTextOut(hDC: HDC; X, Y: Integer; lpString: PChar; nCount, nTabPositions: Integer;
  lpnTabStopPositions: Pointer; nTabOrigin: Integer): Longint; stdcall;

{Whoops!  Delphi incorrectly imports this function, so we must reimport it
 manually to obtain the full functionality of this function}
function GetTabbedTextExtent(hDC: HDC; lpString: PChar;
  nCount, nTabPositions: Integer; lpnTabStopPositions: Pointer): DWORD; stdcall;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{reimport the function}
function GetTabbedTextExtent; external user32 name 'GetTabbedTextExtentA';

{reimport the function}
function TabbedTextOut; external user32 name 'TabbedTextOutA';

procedure TForm1.PaintBox1Paint(Sender: TObject);
const
  {define some static arrays of strings}
  NameCol:  array[0..8] of string = ('Name', 'John', 'David', 'Larry', 'Phil',
                                     'Kenneth', 'Rod', 'Ovais', 'Mike');
  IDCol:    array[0..8] of string = ('ID Number', '100', '101', '102', '103',
                                     '104', '105', '106', '107');
  ScoreCol: array[0..8] of string = ('Score', '9,000,000', '8,345,678',
                                     '7,325,876', '8,324,689', '5,234,761',
                                     '5,243,864', '8,358,534', '6,538,324');
var
  TabStops: array[0..2] of Integer;  // holds the tab stops
  FontSize: TSize;                   // holds the font size
  Count: Integer;                    // a general loop control variable
begin
  {define our tab stops}
  TabStops[0] := 10;
  TabStops[1] := PaintBox1.Width div 2;
  TabStops[2] := -PaintBox1.Width;        // a right aligned tab stop

  {retrieve the height of a string}
  GetTextExtentPoint32(PaintBox1.Canvas.Handle, 'ABC', Length('ABC'), FontSize);

  with PaintBox1.Canvas do
  begin
    {erase the last image}
    Brush.Color := clWhite;
    FillRect(ClipRect);

    {output the above string arrays, using tab stops to format the
     strings like a table}
    for Count := 0 to 8 do
      TabbedTextOut(Handle, 0, FontSize.cy*Count,
                    PChar(NameCol[Count]+#9+IDCol[Count]+#9+ScoreCol[Count]),
                    Length(NameCol[Count]+#9+IDCol[Count]+#9+ScoreCol[Count]),
                    3, @TabStops, 0);
  end;

  {retrieve the length of a string containing tabs, in pixels.  this value
   should equal the width of the paintbox.}
  Label3.Caption := IntToStr(LoWord(GetTabbedTextExtent(PaintBox1.Canvas.Handle,
                                  PChar(NameCol[0]+#9+IDCol[0]+#9+ScoreCol[0]),
                                  Length(NameCol[0]+#9+IDCol[0]+#9+ScoreCol[0]),
                                  3, @TabStops)));
end;

end.