报表处理组件 BY DELPHI

Question

一个可以书写任意文本的Procedure，包括旋转字体。TTextAlign = (taLeft,taRight,taHorzCenter,
              taTop,taBottom,taVertCenter);
TTextAligns = set of TTextAlign;
TTextControl = (tcNormal,tcWordBreak,tcSelfAdapt,tcCalcRect);
TTextDirection = tdVertChinese..90;{Angles of text}procedure WriteText(ACanvas: TCanvas;var ARect: TRect;AText: string; Aligns: TTextAligns;
                    Control: TTextControl;Direction: TTextDirection{; BeErase: Boolean = TRUE});
var S: String;
    TempStr: WideString;
    ColorRef: TColorRef;
    DitheredFlag: Boolean;
    LogicFont: TLogFont;
    Scaler: Extended;
    I,J,X,Y: Integer;
    Interval,MaxExtent:Integer;
    TextMetric: TTextMetric;
    TempExtent: TSize;
    TempRect: TRect;    procedure SetLogicFont(W: Integer = 0;H: Integer = 0);
    begin
      with LogicFont,ACanvas.Font do
      begin
        if H = 0 then lfHeight := Height
        else lfHeight := H;
        lfWidth  := W;
        lfEscapement := 10*Direction;
        lfOrientation := 10*Direction;
        lfWeight := FW_NORMAL;//FW_BOLD;
        lfItalic := BYTE(fsItalic in Style);
        lfUnderline := BYTE(fsUnderline in Style);
        lfStrikeOut := BYTE(fsStrikeOut in Style);
        lfCharSet := Charset;
        lfOutPrecision := OUT_TT_PRECIS;
        lfClipPrecision := CLIP_DEFAULT_PRECIS;
        lfQuality := DEFAULT_QUALITY;        lfPitchAndFamily := DEFAULT_PITCH or FF_DONTCARE;
        StrCopy(lfFaceName,PChar(Name));
      end;
      ACanvas.Font.Handle := Windows.CreateFontIndirect(LogicFont);
   end;  procedure DrawDitheredText(BeginX,BeginY: Integer; TheText: String);
  begin
    DrawBitmap.Canvas.Lock; {Must have it !!}
    try
      with DrawBitmap do
      begin
        //Windows.ExtTextOut(Handle,0,0,ETO_OPAQUE,@TempRect, Nil,0,Nil);
        Windows.ExtTextOut(Canvas.Handle, BeginX - ARect.Left , BeginY - ARect.Top,
          {ETO_OPAQUE or }ETO_CLIPPED, @TempRect, PChar(TheText), Length(TheText),Nil);
        ACanvas.CopyRect(ARect,Canvas,TempRect);
      end;
    finally
      DrawBitmap.Canvas.Unlock;
    end;
  end;begin
  {if BeErase then
    if ACanvas.Brush.Style <> bsSolid then
    begin
      ACanvas.Pen.Style := psClear;
      ACanvas.Rectangle(ARect);
      ACanvas.Pen.Style := psSolid;
    end else ACanvas.FillRect(ARect);
    //Windows.ExtTextOut(ACanvas.Handle,0,0,ETO_OPAQUE,@ARect, Nil,0,Nil);
  }
  if AText = ''  then Exit;  ColorRef := ColorToRGB(ACanvas.Brush.Color);
  DitheredFlag := //(ACanvas = Printer.Canvas) or
    (Windows.GetNearestColor(ACanvas.Handle, ColorRef) <> ColorRef);  if DitheredFlag then
  begin
    with DrawBitmap,ARect do { Use offscreen bitmap to eliminate flicker and }
    begin                     { brush origin tics in painting / scrolling.    }
      Width := Max(Width, Right - Left);
      Height := Max(Height, Bottom - Top);
      Canvas.Font := ACanvas.Font;
      Canvas.Brush := ACanvas.Brush;
      Canvas.Brush.Style := bsSolid;
      TempRect := Rect(0, 0, Right - Left, Bottom - Top);
      Windows.ExtTextOut(Canvas.Handle,0,0,{ETO_OPAQUE or }ETO_CLIPPED,@TempRect, Nil,0,Nil)
    end;
  end;  {Prepare parameters for below process}
  case Direction  of
    tdVertChinese:
    begin
      {More special,use the equivalent width font}
      ACanvas.Font.Pitch := fpFixed;
      Scaler := 1;
      MaxExtent := ARect.Bottom - ARect.Top ;
    end;
    0:{Horizontal}
    begin
      Scaler := 1;
      MaxExtent := ARect.Right - ARect.Left ;
    end;
    1..45:
    begin
      SetLogicFont;
      Scaler :=  Cos(Direction * Pi / 180);
      MaxExtent := Floor((ARect.Right - ARect.Left)/Scaler);
    end;
    46..90:
    begin
      SetLogicFont;
      Scaler  := Sin(Direction * Pi / 180);
      MaxExtent := Floor((ARect.Bottom - ARect.Top)/ Scaler);
    end;
    -90..-46:
    begin
      SetLogicFont;
      Scaler  := Sin(-Direction * Pi / 180);
      MaxExtent := Floor((ARect.Bottom - ARect.Top)/ Scaler);
    end;
    -45..-1:
    begin
      SetLogicFont;
      Scaler :=  Cos(-Direction * Pi / 180);
      MaxExtent := Floor((ARect.Right - ARect.Left)/Scaler);
    end;
  end;  {Get control text}
  case Control of
    tcWordBreak:
    begin
      J := 0;
      X := 0;
      TempStr := WideString(AText);
      for I := 1 to Length(WideString(AText)) do
      begin
        S := WideString(AText)[I];
        if (S = #13) or (S = #10) then
         J := 0
        else begin
          Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(S), Length(S), TempExtent);
          //TempExtent := ACanvas.TextExtent(S);
          if Direction = tdVertChinese then
          begin
            Inc(J,TempExtent.CY);
            if J > MaxExtent then
            begin
              J := TempExtent.CY;
              Insert(#13#10,TempStr,I+X); {Soft return}
              Inc(X,2);
            end;
          end else
          begin
            Inc(J,TempExtent.CX);
            if J > MaxExtent then
            begin
              J := TempExtent.CX;
              Insert(#13#10,TempStr,I+X); {Soft return}
              Inc(X,2);
            end;
          end;
        end;
      end;
      Texts.Text := TempStr;
    end;
    tcSelfAdapt:
    begin
      Texts.Text := AText;
      if Direction = tdVertChinese then
      begin
        //J := 0;
        //X := Length(WideString(Texts[0]));
        //TempStr := WideString(Texts[0]);
        TempStr := '';
        for I := 0 to Texts.Count - 1 do
        begin
          if Length(TempStr) < Length(WideString(Texts[I])) then
            TempStr := WideString(Texts[I]);
          //if X < Length(WideString(Texts[I])) then
          //begin
          //  X := Length(WideString(Texts[I]));
          //  J := I;
          //end;
        end;
        //TempStr := WideString(Texts[J]);
        if Length(TempStr) <> 0 then
        begin
          J := Floor(MaxExtent / Length(TempStr));
          for I := ACanvas.Font.Size-1 downto 5 do
          begin
            Windows.GetTextMetrics(ACanvas.Handle,TextMetric);
            if TextMetric.tmHeight < J then Break
            else ACanvas.Font.Size := I;
          end;
//          if -ACanvas.Font.Height > J then
//          SetLogicFont(0,0);
//          else
        end;
      end else begin
        J := 0;
        S := '';
        for I := 0 to Texts.Count - 1 do
        begin
          Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);
          if J < TempExtent.CX then
          begin
            S := Texts[I];
            J := TempExtent.CX;
          end;
        end;        {for I := ACanvas.Font.Size-1 downto 5 do
        begin
          Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(S), Length(S), TempExtent);
          if TempExtent.CX < MaxExtent then Break
          else ACanvas.Font.Size := I;
        end;}
        Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(S), Length(S), TempExtent);
        if TempExtent.CX > MaxExtent then
        for I := -ACanvas.Font.Height downto 1 do
        begin
          Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(S), Length(S), TempExtent);
          if TempExtent.CX < MaxExtent then Break
          else SetLogicFont(I,0);
        end;      end;
    end;
    tcCalcRect:
    begin
      Texts.Text := AText;
      case Direction  of
        tdVertChinese:
        begin
          TempStr := WideString(Texts[0]);
          for I := 1 to Texts.Count - 1 do
          begin
            if Length(TempStr) < Length(WideString(Texts[I])) then
              TempStr := WideString(Texts[I]);
          end;
          Windows.GetTextMetrics(ACanvas.Handle,TextMetric);
          ARect.Bottom :=  ARect.Top + Length(TempStr) * TextMetric.tmHeight;
        end;
        0:{Horizontal}
        begin
          J := 0;
          for I := 0 to Texts.Count - 1 do
          begin
            Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);
            if J < TempExtent.CX then J := TempExtent.CX;
          end;
          ARect.Right := ARect.Left + J;
        end;
        1..45,-45..-1:
        begin
          J := 0;
          for I := 0 to Texts.Count - 1 do
          begin
            Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);
            if J < TempExtent.CX then J := TempExtent.CX;
          end;
          ARect.Right := ARect.Left + Ceil(J*Scaler);
        end;
        46..90,-90..-46:
        begin
          J := 0;
          for I := 0 to Texts.Count - 1 do
          begin
            Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);
            if J < TempExtent.CX then J := TempExtent.CX;
          end;
          ARect.Bottom := ARect.Top + Ceil(J*Scaler);
        end;
      end;
    end;
    else Texts.Text := AText;
  end;  {Initialize the origin point}
  case Direction of
    tdVertChinese:
    begin
      Windows.GetTextMetrics(ACanvas.Handle,TextMetric);
      Interval := TextMetric.tmMaxCharWidth + Windows.GetTextCharacterExtra(ACanvas.Handle);
      J := Interval * Texts.Count;      if taLeft in Aligns then
        X := ARect.Left + J - Interval
      else if taHorzCenter in Aligns then
        X := (ARect.Right + ARect.Left + J) shr 1 - Interval
      else {if taRight in Aligns}
        X := ARect.Right - Interval;      Y := ARect.Top + 2;
    end;
    0:{Horizontal}
    begin
      Windows.GetTextMetrics(ACanvas.Handle,TextMetric);
      Interval := TextMetric.tmHeight;// + TextMetric.tmExternalLeading;      J := Interval * Texts.Count;      X := ARect.Left + 2;      if taBottom in Aligns then
        Y := ARect.Bottom - J
      else if taVertCenter in Aligns then
        Y := (ARect.Bottom + ARect.Top - J) shr 1
      else {if taTop in Aligns then}
        Y := ARect.Top + 2;    end;
    1..45:
    begin
      Windows.GetTextMetrics(ACanvas.Handle,TextMetric);
      Interval := Ceil((TextMetric.tmHeight {+ TextMetric.tmExternalLeading})/Scaler);
      J := Interval * Texts.Count;      X := ARect.Left + 2;      if taBottom in Aligns then
        Y := ARect.Bottom - J
      else if taVertCenter in Aligns then
        Y := (ARect.Bottom + ARect.Top - J) shr 1
      else {if taTop in Aligns then}
        Y := ARect.Top + 2;    end;
    46..90:
    begin
      Windows.GetTextMetrics(ACanvas.Handle,TextMetric);
      Interval := Ceil((TextMetric.tmHeight {+ TextMetric.tmExternalLeading})/Scaler);
      J := Interval * Texts.Count;      if taRight in Aligns then
        X := ARect.Right - J
      else if taHorzCenter in Aligns then
        X := (ARect.Right + ARect.Left - J) shr 1
      else {if taLeft in Aligns}
        X := ARect.Left + 2;      Y := ARect.Bottom - 2;    end;
    -90..-46:
    begin
      Windows.GetTextMetrics(ACanvas.Handle,TextMetric);
      Interval := Ceil((TextMetric.tmHeight{ + TextMetric.tmExternalLeading})/Scaler);
      J := Interval * Texts.Count;      if taLeft in Aligns then
        X := ARect.Left + J
      else if taHorzCenter in Aligns then
        X := (ARect.Right + ARect.Left + J) shr 1
      else {if taRight in Aligns}
        X := ARect.Right - 2;      Y := ARect.Top + 2;
    end;
    -45..-1:
    begin
      Windows.GetTextMetrics(ACanvas.Handle,TextMetric);
      Interval := Ceil((TextMetric.tmHeight{ + TextMetric.tmExternalLeading})/Scaler);
      J := Interval * Texts.Count;      X := ARect.Left + 2;      if taBottom in Aligns then
        Y := ARect.Bottom - J
      else if taVertCenter in Aligns then
        Y := (ARect.Bottom + ARect.Top - J) shr 1
      else {if taTop in Aligns then}
        Y := ARect.Top + 2;    end;
  end;  //OldBrushStyle := ACanvas.Brush.Style;
  //ACanvas.Brush.Style := bsClear;
  for I := 0 to Texts.Count - 1 do
  begin
    case Direction of
      tdVertChinese:
      begin
        J := Length(WideString(Texts[I])) * (TextMetric.tmHeight{ + TextMetric.tmExternalLeading});        if taBottom in Aligns then
          Y := ARect.Bottom - J
        else if taVertCenter in Aligns then
          Y := (ARect.Bottom + ARect.Top - J) shr 1
        else {if taTop in Aligns then}
          Y := ARect.Top + 2;        TempExtent.CX := X;
        TempExtent.CY := Y;
        for J := 1 to  Length(WideString(Texts[I])) do
        begin
          S := WideString(Texts[I])[J];
          if DitheredFlag then
            DrawDitheredText(TempExtent.CX,TempExtent.CY,S)
          else begin
            //Windows.ExtTextOut(ACanvas.Handle,0,0,ETO_OPAQUE,@ARect, Nil,0,Nil);
            Windows.ExtTextOut(ACanvas.Handle, TempExtent.CX, TempExtent.CY,{ETO_OPAQUE or} ETO_CLIPPED,
              @ARect, PChar(S), Length(S),Nil);
          end;
          Inc(TempExtent.CY ,TextMetric.tmHeight{ + TextMetric.tmExternalLeading});
        end;
        Dec(X,Interval);
      end;
      0:{Horizontal}
      begin
        Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);
        if taRight in Aligns then
          X := ARect.Right - TempExtent.CX
        else if taHorzCenter in Aligns then
          X := (ARect.Right + ARect.Left - TempExtent.CX) shr 1
        else {if taLeft in Aligns then}
          X := ARect.Left + 2;        if DitheredFlag then
          DrawDitheredText(X,Y,Texts[I])
        else begin
          //Windows.ExtTextOut(ACanvas.Handle,0,0,ETO_OPAQUE,@ARect, Nil,0,Nil);
          Windows.ExtTextOut(ACanvas.Handle, X, Y,{ETO_OPAQUE or} ETO_CLIPPED,
            @ARect, PChar(Texts[I]), Length(Texts[I]),Nil);
        end;
        Inc(Y,Interval);
      end;      1..45:
      begin
        Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);
        J := Ceil(TempExtent.CX*Scaler);
        if taRight in Aligns then
        begin
          TempExtent.CX := ARect.Right - J;
          TempExtent.CY := Y + Ceil((X- TempExtent.CX)* Tan(Direction * Pi / 180));
        end else if taHorzCenter in Aligns then
        begin
          TempExtent.CX := (ARect.Right + ARect.Left - J) shr 1;
          TempExtent.CY := Y + Ceil((X - TempExtent.CX )* Tan(Direction * Pi / 180));
        end else {if taLeft in Aligns then}
        begin
          TempExtent.CX := ARect.Left + 2;
          TempExtent.CY := Y;
        end;
        if DitheredFlag then
          DrawDitheredText(TempExtent.CX,TempExtent.CY,Texts[I])
        else begin
          //Windows.ExtTextOut(ACanvas.Handle,0,0,ETO_OPAQUE,@ARect, Nil,0,Nil);
          Windows.ExtTextOut(ACanvas.Handle, TempExtent.CX, TempExtent.CY,{ETO_OPAQUE or} ETO_CLIPPED,
            @ARect, PChar(Texts[I]), Length(Texts[I]),Nil);
        end;
        Inc(Y,Interval);
      end;      46..90:
      begin
        Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);
        J := Ceil(TempExtent.CX*Scaler);        if taTop in Aligns then
        begin
          TempExtent.CY := ARect.Top + J;
          TempExtent.CX := X + Ceil((Y - TempExtent.CY)/ Tan(Direction * Pi / 180));
        end else if taVertCenter in Aligns then
        begin
          TempExtent.CY := (ARect.Bottom + ARect.Top + J) shr 1;
          TempExtent.CX := X + Ceil((Y - TempExtent.CY)/ Tan(Direction * Pi / 180));
        end else {if taLeft in Aligns then}
        begin
          TempExtent.CY := ARect.Top + 2;
          TempExtent.CX := X;
        end;        if DitheredFlag then
          DrawDitheredText(TempExtent.CX,TempExtent.CY,Texts[I])
        else begin
          //Windows.ExtTextOut(ACanvas.Handle,0,0,ETO_OPAQUE,@ARect, Nil,0,Nil);
          Windows.ExtTextOut(ACanvas.Handle, TempExtent.CX, TempExtent.CY,{ETO_OPAQUE or} ETO_CLIPPED,
            @ARect, PChar(Texts[I]), Length(Texts[I]),Nil);
        end;
        Inc(X,Interval);
      end;      -90..-46:
      begin
        Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);
        J := Ceil(TempExtent.CX*Scaler);        if taBottom in Aligns then
        begin
          TempExtent.CY := ARect.Bottom - J;
          TempExtent.CX := X + Ceil((TempExtent.CY - Y)/ Tan(-Direction * Pi / 180));
        end else if taVertCenter in Aligns then
        begin
          TempExtent.CY := (ARect.Bottom + ARect.Top - J) shr 1;
          TempExtent.CX := X + Ceil((TempExtent.CY - Y)/ Tan(-Direction * Pi / 180));
        end else {if taLeft in Aligns then}
        begin
          TempExtent.CY := ARect.Top + 2;
          TempExtent.CX := X;
        end;        if DitheredFlag then
          DrawDitheredText(TempExtent.CX,TempExtent.CY,Texts[I])
        else begin
          //Windows.ExtTextOut(ACanvas.Handle,0,0,ETO_OPAQUE,@ARect, Nil,0,Nil);
          Windows.ExtTextOut(ACanvas.Handle, TempExtent.CX, TempExtent.CY,{ETO_OPAQUE or} ETO_CLIPPED,
            @ARect, PChar(Texts[I]), Length(Texts[I]),Nil);
        end;
        Dec(X,Interval);
      end;      -45..-1:
      begin
        Windows.GetTextExtentPoint32(ACanvas.Handle, PChar(Texts[I]), Length(Texts[I]), TempExtent);
        J := Ceil(TempExtent.CX*Scaler);        if taRight in Aligns then
        begin
          TempExtent.CX := ARect.Right - J;
          TempExtent.CY := Y + Ceil((TempExtent.CX - X ) * Tan(-Direction * Pi / 180));
        end else if taHorzCenter in Aligns then
        begin
          TempExtent.CX := (ARect.Right + ARect.Left - J) shr 1;
          TempExtent.CY := Y + Ceil((TempExtent.CX - X ) * Tan(-Direction * Pi / 180));
        end else {if taLeft in Aligns then}
        begin
          TempExtent.CX := ARect.Left + 2;
          TempExtent.CY := Y;
        end;
        if DitheredFlag then
          DrawDitheredText(TempExtent.CX,TempExtent.CY,Texts[I])
        else begin
          //Windows.ExtTextOut(ACanvas.Handle,0,0,ETO_OPAQUE,@ARect, Nil,0,Nil);
          Windows.ExtTextOut(ACanvas.Handle, TempExtent.CX, TempExtent.CY,{ETO_OPAQUE or} ETO_CLIPPED,
            @ARect, PChar(Texts[I]), Length(Texts[I]),Nil);
        end;
        Inc(Y,Interval);
      end;
    end;
  end;
//  ACanvas.Brush.Style := OldBrushStyle;
end;