drawtextexu.pas

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

unit DrawTextExU;

interface

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

type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Panel1: TPanel;
    Panel2: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure Panel2MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure PaintBox1Paint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

{the large string to be drawn}
const
  TheString = 'This function draws the specified string of text onto the '+
              'device context specified by the DC parameter. The text is '+
              'drawn within the specified rectangle, and is formatted '+
              'according to the formatting flags identified by the dwDTFormat '+
              'parameter and the additional formatting options identified by '+
              'the DTParams parameter. The device context''s selected font, '+
              'text color, background color, and background mode are used '+
              'when drawing the text. Unless otherwise specified by a '+
              'specific formatting flag, the text is assumed to have multiple '+
              'lines, and will be clipped by the boundaries of the specified '+
              'rectangle.';


var
  Form1: TForm1;
  ResizingMargins: Boolean;    // indicates if margins are being resized

implementation

{$R *.DFM}

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
  BoundingRect: TRect;            // the text formatting bounding rectangle
  DrawingParams: TDrawTextParams; // additional text formatting options
begin
  with PaintBox1.Canvas do
  begin
    {erase the last image}
    Brush.Color := clWhite;
    FillRect(ClipRect);

    {the text formatting rectangle is the size of the paintbox}
    BoundingRect := ClipRect;

    with DrawingParams do
    begin
      {set the size of the optional formatting parameters structure}
      cbSize := SizeOf(TDrawTextParams);

      {initialize the tab length and margins to those specified
       by the panels}
      iTabLength := 0;
      iLeftMargin := (Panel1.Left-PaintBox1.Left);
      iRightMargin := 200-Panel2.Width;
    end;

    {draw the text, with margins}
    DrawTextEx(PaintBox1.Canvas.Handle, TheString, Length(TheString),
               BoundingRect, DT_WORDBREAK, @DrawingParams);
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  {we are not initially resizing margins}
  ResizingMargins := FALSE;
end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  {the user is dragging a panel and resizing margins}
  ResizingMargins := TRUE;
end;

procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  {margins have been resized, so update the screen}
  ResizingMargins := FALSE;
  PaintBox1.Refresh;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  {resize the panel if the user has started to resize margins}
  if ResizingMargins then
  begin
    Panel1.Left  := Panel1.Left+X;
    Panel1.Width := Panel2.Left - Panel1.Left;
  end;

  {confine the panel to a maximum size}
  if Panel1.Left<PaintBox1.Left then
  begin
    Panel1.Left  := PaintBox1.Left;
    Panel1.Width := 200;
  end;
end;

procedure TForm1.Panel2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  {resize the panel if the user has started to resize margins}
  if ResizingMargins then
    Panel2.Width := X;

  {confine the panel to a maximum size}
  if Panel2.Width>200 then
    Panel2.Width := 200;
end;

end.