自己做的一个长篇文字转GIF图片的dll组件，请高手帮忙解决一下图片高度问题

Question

由于文字大小、字体、换行，会导致图片高度动态变化。
现在的代码里高度一直不能准确。
代码如下。
使用了AAFONT GIFimage 控件unit main;{$WARN SYMBOL_PLATFORM OFF}interfaceuses
  ComObj, ActiveX, AspTlb, dximg_TLB, Windows,StdVcl,SysUtils, Variants,Classes,
  ExtCtrls, Graphics,AAFont, AACtrls,GIFImage;type
  Tdxasoimg = class(TASPObject, Idxasoimg)
  protected
    procedure OnEndPage; safecall;
    procedure OnStartPage(const AScriptingContext: IUnknown); safecall;
    function togif(const txt, fname, fsize, fcolor, bgcolor: WideString;
      imgwidth: Integer): OleVariant; safecall;  end;implementationuses ComServ;
procedure Tdxasoimg.OnEndPage;
begin
  inherited OnEndPage;
end;procedure Tdxasoimg.OnStartPage(const AScriptingContext: IUnknown);
begin
  inherited OnStartPage(AScriptingContext);
end;//自动换行
function GetWrapText(const Line, BreakStr: string; BreakChars:
  TSysCharSet; MaxCol: Integer): string;
const
  QuoteChars = ['''', '"'];
var
  Col, Pos: Integer;
  LinePos, LineLen: Integer;
  BreakLen, BreakPos: Integer;
  QuoteChar, CurChar: Char;
  ExistingBreak: Boolean;
  DoubleCharBreak: Boolean;
begin
  if MaxCol < 2 then MaxCol := 2;
  Col := 1;
  Pos := 1;
  LinePos := 1;
  BreakPos := 0;
  QuoteChar := ' ';
  ExistingBreak := False;
  DoubleCharBreak := False;
  LineLen := Length(Line);
  BreakLen := Length(BreakStr);
  Result := '';
  while Pos <= LineLen do
  begin
    CurChar := Line[Pos];
    if CurChar in LeadBytes then
    begin
      if Col >= MaxCol - 1 then
      begin
        DoubleCharBreak := True;
        BreakPos := Pos - 1;
      end;
      Inc(Pos);
      Inc(Col);
    end
    else if CurChar = BreakStr[1] then
    begin
      if QuoteChar = ' ' then
      begin
        ExistingBreak := CompareText(BreakStr, Copy(Line, Pos, BreakLen)) = 0;
        if ExistingBreak then
        begin
          Inc(Pos, BreakLen - 1);
          BreakPos := Pos;
        end;
      end
    end
    else if CurChar in BreakChars then
    begin
      if QuoteChar = ' ' then
        BreakPos := Pos
    end
    else if CurChar in QuoteChars then
      if CurChar = QuoteChar then
        QuoteChar := ' '
      else if QuoteChar = ' ' then
        QuoteChar := CurChar;
    Inc(Pos);
    Inc(Col);
    if (not (QuoteChar in QuoteChars) and (ExistingBreak or
      ((Col > MaxCol) and (BreakPos > LinePos)))) or DoubleCharBreak then
    begin
      Col := Pos - BreakPos;
      Result := Result + Copy(Line, LinePos, BreakPos - LinePos + 1);
      if not (CurChar in QuoteChars) then
        while (Pos <= LineLen) and (Line[Pos] in BreakChars + [#13, #10]) do
          Inc(Pos);
      if not ExistingBreak and (Pos < LineLen) then
        Result := Result + BreakStr;
      Inc(BreakPos);
      LinePos := BreakPos;
      ExistingBreak := False;
      DoubleCharBreak := False;
    end;
  end;
  Result := Result + Copy(Line, LinePos, MaxInt);
end;

Answer 1

//文字自动换行
procedure WrapText(const S: string; Strs: TStrings;
  Col: Integer);
begin
  if not Assigned(Strs) then
    Strs := TStringList.Create;
  Strs.Clear;
  Strs.Text := GetWrapText(S, #13#10, ['.', ',', '?', '!', ' ', ';', ':',
    #9, '-'], Col);
end;function Tdxasoimg.togif(const txt, fname, fsize, fcolor,
  bgcolor: WideString; imgwidth: Integer): OleVariant;
var
  tmpStream: TMemoryStream;
  ImgData: array of byte;
  imglen: Integer;
  Bitmap:Tbitmap;
  AAtext: TAAText;
  MyGif:TGIFImage;
  AAfont:taafont;
  i, j: Integer;
  DispLines: TStrings;
  WrapLines: TStrings;
  CurrText: widestring;
  y: Integer;
  TextWidth: Integer;
  MaxCol: Integer;
  begin
  MyGif:=TGIFImage.Create;
  Bitmap:=Tbitmap.Create ;
  AAtext:= TAAtext.Create(nil);
  aatext.Font.Color :=strtoint(fcolor);
  aatext.Font.Size :=strtoint(fsize);
  aatext.Font.Name :=fname;
  aatext.Font.Charset:= GB2312_CHARSET;
  aatext.Canvas.Brush.Style := bsclear;
  aatext.Text.WordWrap:=true;
  aatext.width:=imgwidth;
  aatext.Text.Lines.Clear;
  aatext.Text.Lines.Append(txt);
  Bitmap.Width:=aatext.Width;  //计算高度
  DispLines := nil;
  WrapLines := nil;
  try
    DispLines := TStringList.Create; //临时文本
    WrapLines := TStringList.Create;
    aafont:=taafont.Create(nil);
    aafont.Canvas:=bitmap.Canvas;
    with aatext do
    begin
      DispLines.AddStrings(text.Lines);      y := 0;
      for i := 0 to DispLines.Count - 1 do
      begin
        CurrText := DispLines[i]; //当前处理字符串
        TextWidth := aafont.TextWidth(CurrText);
        if Text.WordWrap and (TextWidth > aatext.ClientWidth) then //自动换行
        begin
          MaxCol := (aatext.ClientWidth - 2 * Border) * Length(CurrText) div TextWidth;
          while aafont.TextWidth(Copy(CurrText, 1, MaxCol)) > aatext.ClientWidth do
            Dec(MaxCol);
          WrapText(CurrText, WrapLines, MaxCol);
        end else if CurrText <> '' then
          WrapLines.Text := CurrText
        else
          WrapLines.Text := ' ';
        y:=Y+WrapLines.Count;
      end;
    end;
  finally
    AAfont.Free;
    DispLines.Free;
    WrapLines.Free;
  end;
  bitmap.Height:=Round(y*ABS(AATEXT.Font.Height * AATEXT.Font.PixelsPerInch / 72));
  //计算高度
  AAtext.DrawCanvas(Bitmap.Canvas);
  AAtext.Free;
  mygif.Assign(bitmap);
  Bitmap.Free;
  tmpStream := TMemoryStream.Create;
  mygif.Transparent:=true;
  mygif.SaveToStream(tmpStream);
  mygif.Free;  tmpStream.Position := 0;
  imglen := tmpStream.Size;
  SetLength(ImgData, imglen);
  tmpStream.Read(ImgData[0], imglen);
  tmpStream.Free;
  Response.Set_Expires(0);
  Response.Buffer := True;
  Response.Clear;
  Response.ContentType := 'image/gif';
  Result := ImgData;
end;initialization
  TAutoObjectFactory.Create(ComServer, Tdxasoimg, Class_dxasoimg,
    ciMultiInstance, tmApartment);
end.