{ A very basic "lo-fi" molecule renderer accepting MDL V2000 molfiles as input.
  It provides just enough outline for you to recognize the molecule.
  Written to see how little molfile parsing one can get away with and still
  render a molecule in a somewhat useful way.

(C) 2008 Jan Holst Jensen, jan@biochemfusion.com.

This pascal source code unit (MolRenderer.pas) is released under a BSD-style
license:

* Copyright (C) 2008, Biochemfusion (http://www.biochemfusion.com)
* All rights reserved.
*
* Redistribution and use for any purpose in source and binary forms, with or
* without modification, are permitted, subject to the following restrictions:
*
* 1. The origin of this software must not be misrepresented; you must not
*    claim that you wrote the original software. If you use this software
*    in a product, an acknowledgment in the product documentation would be
*    appreciated but is not required.
* 2. Altered source versions must be plainly marked as such, and must not be
*    misrepresented as being the original software.
* 3. This notice may not be removed or altered from any source distribution. 
*
* THIS SOFTWARE IS PROVIDED BY Biochemfusion ``AS IS'' AND ANY
* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
* DISCLAIMED. IN NO EVENT SHALL Biochemfusion BE LIABLE FOR ANY
* DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
* (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
* LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
* ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
* SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

}
unit MolRenderer;

interface

uses
  Windows, Classes, Graphics;

type
  TMolRenderer = class
  protected
    fMolfile: TStringList;
    fAtomCount: Integer;
    fBondCount: Integer;
    fMinX: Double;
    fMinY: Double;
    fMaxX: Double;
    fMaxY: Double;
    procedure CalcBoundingBox;
  public
    constructor Create;
    destructor  Destroy; override;

    procedure LoadMolfile(AMolfile: TStrings); overload;
    procedure LoadMolfile(AMolfile: String); overload;
    procedure PaintOnCanvas(C: TCanvas; R: TRect);
  end;

implementation

uses
  SysUtils, Math;

function RobustStrToFloat(const AStr: String): Double;
begin
  if DecimalSeparator <> '.' then
    Result := StrToFloat(StringReplace(AStr, '.', DecimalSeparator, []))
  else
    Result := StrToFloat(AStr);
end;

function AtomX(const Line: String): Double;
begin
  Result := RobustStrToFloat(copy(Line, 1, 10));
end;

function AtomY(const Line: String): Double;
begin
  Result := RobustStrToFloat(copy(Line, 11, 10));
end;

function AtomSymbol(const Line: String): String;
begin
  Result := Trim(copy(Line, 32, 3));
end;

function BondFrom(const Line: String): Integer;
begin
  Result := StrToInt(copy(Line, 1, 3));
end;

function Bond_To_(const Line: String): Integer;
begin
  Result := StrToInt(copy(Line, 4, 3));
end;

{ TMolRenderer }

constructor TMolRenderer.Create;
begin
  fMolfile := TStringList.Create;
end;

destructor TMolRenderer.Destroy;
begin
  fMolfile.Free;
  inherited;
end;

procedure TMolRenderer.CalcBoundingBox;
const
  MAX_DOUBLE = 1E300;
  ASSUMED_BOND_LENGTH = 0.8;
var
  i: Integer;
  Line: String;
  x: Double;
  y: Double;
begin
  fMinX :=  MAX_DOUBLE;
  fMaxX := -MAX_DOUBLE;
  fMinY :=  MAX_DOUBLE;
  fMaxY := -MAX_DOUBLE;
  for i := 4 to fAtomCount + 3 do begin
    Line := fMolfile[i];
    x := AtomX(Line);
    y := AtomY(Line);
    fMinX := Min(x, fMinX);
    fMaxX := Max(x, fMaxX);
    fMinY := Min(y, fMinY);
    fMaxY := Max(y, fMaxY);
  end;
  { Make margin for outer-most atoms to display within bounding box.
    This requires that the assumed default bond length matches the
    rendered font size within reasonable limits. }
  fMinX := fMinX - ASSUMED_BOND_LENGTH / 2;
  fMaxX := fMaxX + ASSUMED_BOND_LENGTH / 2;
  fMinY := fMinY - ASSUMED_BOND_LENGTH / 2;
  fMaxY := fMaxY + ASSUMED_BOND_LENGTH / 2;
end;

procedure TMolRenderer.LoadMolfile(AMolfile: TStrings);
var
  Line: String;
begin
  Line := AMolfile[3];
  if copy(Line, 35, 5) <> 'V2000' then
    raise Exception.Create('Can only handle V2000 files.');

  fMolfile.Assign(AMolfile);

  fAtomCount := StrToInt(copy(Line, 1, 3));
  fBondCount := StrToInt(copy(Line, 4, 3));

  CalcBoundingBox;
end;

procedure TMolRenderer.LoadMolfile(AMolfile: String);
var
  SL: TStringList;
begin
  SL := TStringList.Create;
  try
    SL.Text := AMolfile;
    LoadMolfile(SL);
  finally
    SL.Free;
  end;
end;

procedure TMolRenderer.PaintOnCanvas(C: TCanvas; R: TRect);
var
  Scaling: Double;
  AtomUseCount: array of Integer;

  procedure DrawBonds;
  var
    i: Integer;
    Line: String;
    FromNo: Integer;
    ToNo: Integer;
    x1: Integer;
    y1: Integer;
    x2: Integer;
    y2: Integer;
  begin
    SetLength(AtomUseCount, fAtomCount);
    for i := 0 to fAtomCount - 1 do
      AtomUseCount[i] := 0;

    for i := 4 + fAtomCount to fAtomCount + fBondCount + 3 do begin
      Line := fMolfile[i];
      FromNo := BondFrom(Line);
      ToNo   := Bond_To_(Line);
      { Update atom use/ref-count so we can detect terminal atoms (use-count = 1). }
      AtomUseCount[FromNo - 1] := AtomUseCount[FromNo - 1] + 1;
      AtomUseCount[ToNo   - 1] := AtomUseCount[ToNo   - 1] + 1;

      x1 := round((AtomX( fMolfile[ FromNo + 3 ] ) - fMinX) * Scaling) + R.Left;
      y1 := round((fMaxY - AtomY( fMolfile[ FromNo + 3 ] )) * Scaling) + R.Top;
      x2 := round((AtomX( fMolfile[ ToNo   + 3 ] ) - fMinX) * Scaling) + R.Left;
      y2 := round((fMaxY - AtomY( fMolfile[ ToNo   + 3 ] )) * Scaling) + R.Top;
      C.MoveTo(x1, y1);
      C.LineTo(x2, y2);
    end;
  end;

  procedure DrawAtoms;
  var
    i: Integer;
    Line: String;
    Symbol: String;
    x: Integer;
    y: Integer;
  begin
    for i := 4 to fAtomCount + 3 do begin
      Line := fMolfile[i];
      Symbol := AtomSymbol(Line);
      if (Symbol = 'C') and (AtomUseCount[i - 4] <> 1) then
        Continue;

      x := round((AtomX(Line) - fMinX) * Scaling);
      y := round((fMaxY - AtomY(Line)) * Scaling);
      x := x - C.TextWidth(Symbol) div 2 + R.Left;
      y := y - C.TextHeight(Symbol) div 2 + R.Top;
      C.TextOut(x, y, Symbol);
    end;
  end;

var
  XScaling: Double;
  YScaling: Double;
begin
  XScaling := (R.Right - R.Left) / (fMaxX - fMinX);
  YScaling := (R.Bottom - R.Top) / (fMaxY - fMinY);

  Scaling := Min(XScaling, YScaling);

  DrawBonds;
  DrawAtoms;
end;

end.