chemtxt.pas

C++编写的曲线拟合例子

unit Chemtxt;


interface
uses  WinTypes,SysUtils,Classes,Graphics;

procedure ChemTextOut(Canvas:TCanvas; const aRect:TRect; X, Y:integer; text:String);

implementation

function Rect(l,t,r,b:Integer):TRect;inline;
begin
 Result.Left:=l;
 Result.Top:=t;
 Result.Right:=r;
 Result.Bottom:=b;
end;


procedure ChemTextOut(Canvas:TCanvas; const aRect:TRect; X, Y:integer; text:String);
var i,xx:integer;
    s:string[16];
    subNos:boolean;
    DefFont:TFont;
begin
 Canvas.FillRect(aRect);
 DefFont:=TFont.Create;
 DefFont.Assign(Canvas.Font);
 with Canvas do begin
  xx:=X;
  subNos:=false;
  i:=1;
  while i<=length(text) do begin
   s:=text[i];
   if s[1] in ['A'..'Z','a'..'z',')'] then subNos:=true;
   if s[1] in ['.',' ',',', ';','('] then subNos:=false;
   if (s[1] in ['0'..'9'])
    then
     begin
      while (text[i+1] in ['0'..'9']) and (i<length(text)) do begin
        s:=s+text[i+1];
        inc(i);
      end;
      Canvas.Font:=DefFont;
      if SubNos then
      begin
        Canvas.Font.Height:=Canvas.Font.Height*8 div 10;
        TextRect(Rect(xx,aRect.Top,xx+TextWidth(s),aRect.Bottom),xx, Y+abs(8*Canvas.Font.Height-10*DefFont.Height) div 10, s);
        inc(xx,TextWidth(s));
      end
      else
      begin
        Canvas.Font:=DefFont;
        TextRect(Rect(xx,aRect.Top,xx+TextWidth(s),aRect.Bottom),xx, Y, s);
        inc(xx,TextWidth(s));
      end;
     end
   else
   if (s[1] in ['+','-']) and (i>1) and (text[i-1] in ['A'..'Z','a'..'z','0'..'9','+','-',')'])
    then
     begin
      Canvas.Font:=DefFont;
      Canvas.Font.Height:=Canvas.Font.Height*8 div 10;
      TextRect(Rect(xx,aRect.Top,xx+TextWidth(s),aRect.Bottom),xx, Y-1, s);
      inc(xx,TextWidth(s));
     end
   else
     begin
      if (text[i] in ['A'..'Z','a'..'z']) then
      while (text[i+1] in ['A'..'Z','a'..'z']) and (i<length(text)) do begin
        s:=s+text[i+1];
        inc(i);
      end;
      Canvas.Font:=DefFont;
      TextRect(Rect(xx,aRect.Top,xx+TextWidth(s),aRect.Bottom),xx, Y, s);
      inc(xx,TextWidth(s));
     end;
   inc(i);
  end;
 end;
 DefFont.Free;
end;


end.