unit GvForm;

{ Graphics Vision Formula Display,
  Copr. 1996 Matthias K"oppe
}

interface

uses {$ifdef Windows} WinTypes, {$endif} Objects, Winres, GVViews, GvDialog, GvWinDlg;

type
  PFormLabel = ^TFormLabel;
  TFormLabel = object(TWinLabel)
    procedure Draw; virtual;
  end;

procedure OutForm(var R: TRect; const Text: string);
function BracedSubstring(const Text: string; var start: Integer): string;

{ GvWinDlg and Stream support
}

procedure InitFormLabel(Data: PControlData; Info: PDialogInfo);

procedure RegisterGvForm;

const
  classStatic: TClassRec = (
    ClassId:  cl_Static;
    Init:   @InitFormLabel);

  RFormLabel: TStreamRec = (
    ObjType: 230;
    VmtLink: Ofs(TypeOf(TFormLabel)^);
    Load:    @TFormLabel.Load;
    Store:   @TFormLabel.Store);

implementation

{$ifdef Windows}
uses Strings, WinGr;
{$else}
uses Strings, MetaGr, MyFonts;
{$endif}

procedure TFormLabel.Draw;
var P: TPoint;
    Col1, Col2: Byte;
    S: String;
    R: TRect;
Begin
  If Light then Begin
    SetFillStyle (SolidFill,GetColor (6));
    Col1:=GetColor (2); Col2:=GetColor (4);
  End
  Else Begin
    SetFillStyle (SolidFill,GetColor (5));
    Col1:=GetColor (1); Col2:=GetColor (3);
  End;
  Bar (0, 0, Size.X-1, Size.Y-1);
  P.X:=0; P.Y:=0;
  SetTextParams(GetStandardFont, 0, Col1 + Col2 shl 8, true);
  SetTextJustify(CenterText, CenterText);
  GetText(S);
  GetExtent(R);
  OutForm(R, S);
End;

{ 컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴컴
}

function BracedSubstring(const Text: string; var start: Integer): string;
var
  i, Level: Integer;
begin
  i := start;
  If Text[i] = '{'
  then begin
    Level := 0;
    repeat
      case Text[i] of
	'{': Inc(Level);
	'}': Dec(Level);
      end;
      Inc(i);
    until (Level = 0) or (i > Length(Text));
    BracedSubstring := Copy(Text, start + 1, i - start - 2);
    start := i
  end
  else begin
    BracedSubstring := Text[i];
    start := i + 1
  end
end;

procedure OutForm(var R: TRect; const Text: string);
var
  i: Integer;
  CurX, CurY: Integer;
  maxY, minY: Integer;
  Horiz, Vert: Integer;
  Metric: TTextMetric;

	procedure minmax;
	begin
	  If CurY + Metric.tmAscent > maxY
	  then maxY := CurY + Metric.tmAscent;
	  If CurY - Metric.tmDescent < minY
	  then minY := CurY - Metric.tmDescent;
	end;

	procedure Parse(const Text: string; Draw: Boolean);
	var
	  i, j, k, First: Integer;
	  saveFont: Integer;
	  c: Char;

		procedure Flush;
		var
		  s: string;
		begin
		  If i > First
		  then begin
		    minmax;
		    s := Copy(Text, First, i - First);
		    If Draw
		    then OutTextXY(CurX, CurY, s);
		    Inc(CurX, TextWidth(s))
		  end
		end;

	begin
	  i := 1;
	  First := 1;
	  saveFont := sFont;
	  repeat
	    c := Text[i];
	    case c of
	      '_':
		begin
		  Flush;
		  Inc(i);
		  Inc(CurY, Metric.tmAscent div 3); {minmax;}
		  Parse(BracedSubstring(Text, i), Draw);
		  Dec(CurY, Metric.tmAscent div 3);
		  First := i
		end;
	      '^':
		begin
		  Flush;
		  Inc(i);
		  Dec(CurY, (Metric.tmAscent * 2) div 3); {minmax;}
		  Parse(BracedSubstring(Text, i), Draw);
		  Inc(CurY, (Metric.tmAscent * 2) div 3);
		  First := i
		end;
	      '#':
		begin
		  Flush;
		  Inc(i);
		  Val(BracedSubString(Text, i), j, k);
		  If k = 0
		  then SetTextParams(j, sCharspace, sColor, true);
		  GetTextMetrics(Metric);
		  minmax;
		  First := i
		end;
	      else
		Inc(i);
	    end;
	  until i > Length(Text);
	  Flush;
	  SetTextParams(saveFont, sCharspace, sColor, true);
	  GetTextMetrics(Metric);
	end;

begin
  Horiz := sHoriz;
  Vert := sVert;
  SetTextJustify(LeftText, BaseLine);
  GetTextMetrics(Metric);
  CurX := 0; CurY := 0; maxY := 0; minY := 0; minmax;
  Parse(Text, false);
  case Horiz of
    LeftText:
      CurX := R.A.X;
    CenterText:
      CurX := (R.B.X + R.A.X - CurX) div 2;
    RightText:
      CurX := R.B.X - CurX;
  end;
  case Vert of
    TopText:
      CurY := R.A.Y + maxY - Metric.tmAscent;
    BottomText:
      CurY := R.B.Y + minY + Metric.tmDescent;
    CenterText:
      CurY := (R.B.Y + R.A.Y) div 2 + maxY + minY;
  end;
  Parse(Text, true);
  SetTextJustify(Horiz, Vert)
end;

procedure InitFormLabel(Data: PControlData; Info: PDialogInfo);
var
  P: PGView;
  R: TRect;
  Buf: array[0..255] of Char;
  Markers: Boolean;
Begin
  If Data^.lStyle and $7F = ss_LeftNoWordWrap
  then begin
    { Create a TFormLabel object if static style is "LeftNoWordWrap"
    }
    GetControlRect(R, Data, Info);
    with Data^, Info^ do Begin
      Group := Group or (lStyle and ws_Group <> 0);
      If szText = nil then Buf[0] := #0 else StrLCopy(Buf, szText, 256);
      Markers := (lStyle and ss_NoPrefix = 0) and ConvertMarkers(Buf, 256);
      P := New(PFormLabel, Init(R, StrPas(Buf), nil));
      InsertLink(Info, @LinkLabel, P);
      P^.HelpCtx := wId;
      InsertControl(Dialog, P);
    End;
  end
  else
    { Create a standard Windows static
    }
    InitStatic(Data, Info);
End;

procedure RegisterGvForm;
begin
  RegisterClass(classStatic);
  RegisterType(RFormLabel)
end;

end.
