From 8094316fc54909c4d290fb885572b62fb710266c Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sun, 25 Jun 2017 15:56:27 +0000 Subject: [PATCH] chemtext: Initial commit git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5958 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/chemtext/demo/chemdemo/chem.lpi | 81 ++++ components/chemtext/demo/chemdemo/chem.lpr | 17 + .../chemtext/demo/chemdemo/testchem.lfm | 139 ++++++ .../chemtext/demo/chemdemo/testchem.pas | 44 ++ components/chemtext/demo/runtime/project1.lpi | 80 ++++ components/chemtext/demo/runtime/project1.lpr | 21 + components/chemtext/demo/runtime/unit1.lfm | 169 +++++++ components/chemtext/demo/runtime/unit1.pas | 124 ++++++ components/chemtext/laz_chemtext.lpk | 40 ++ components/chemtext/laz_chemtext.pas | 22 + components/chemtext/source/chemtext.pas | 420 ++++++++++++++++++ components/chemtext/source/chemtext.res | Bin 0 -> 2771 bytes 12 files changed, 1157 insertions(+) create mode 100644 components/chemtext/demo/chemdemo/chem.lpi create mode 100644 components/chemtext/demo/chemdemo/chem.lpr create mode 100644 components/chemtext/demo/chemdemo/testchem.lfm create mode 100644 components/chemtext/demo/chemdemo/testchem.pas create mode 100644 components/chemtext/demo/runtime/project1.lpi create mode 100644 components/chemtext/demo/runtime/project1.lpr create mode 100644 components/chemtext/demo/runtime/unit1.lfm create mode 100644 components/chemtext/demo/runtime/unit1.pas create mode 100644 components/chemtext/laz_chemtext.lpk create mode 100644 components/chemtext/laz_chemtext.pas create mode 100644 components/chemtext/source/chemtext.pas create mode 100644 components/chemtext/source/chemtext.res diff --git a/components/chemtext/demo/chemdemo/chem.lpi b/components/chemtext/demo/chemdemo/chem.lpi new file mode 100644 index 000000000..31d6b7886 --- /dev/null +++ b/components/chemtext/demo/chemdemo/chem.lpi @@ -0,0 +1,81 @@ + + + + + + + + + + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <Icon Value="0"/> + </General> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <RequiredPackages Count="2"> + <Item1> + <PackageName Value="laz_chemtext"/> + </Item1> + <Item2> + <PackageName Value="LCL"/> + </Item2> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="chem.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="testchem.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="chem"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Debugging> + <UseExternalDbgSyms Value="True"/> + </Debugging> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/components/chemtext/demo/chemdemo/chem.lpr b/components/chemtext/demo/chemdemo/chem.lpr new file mode 100644 index 000000000..5e4929075 --- /dev/null +++ b/components/chemtext/demo/chemdemo/chem.lpr @@ -0,0 +1,17 @@ +program chem; + +{$mode objfpc}{$H+} + +uses + Interfaces, // this includes the LCL widgetset + Forms, testchem; + +{$R *.RES} + +begin + RequireDerivedFormResource := True; + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/components/chemtext/demo/chemdemo/testchem.lfm b/components/chemtext/demo/chemdemo/testchem.lfm new file mode 100644 index 000000000..c879d568f --- /dev/null +++ b/components/chemtext/demo/chemdemo/testchem.lfm @@ -0,0 +1,139 @@ +object Form1: TForm1 + Left = 200 + Height = 280 + Top = 108 + Width = 399 + Caption = 'ChemLabel Demo' + ClientHeight = 280 + ClientWidth = 399 + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + Position = poScreenCenter + LCLVersion = '1.9.0.0' + object Panel1: TPanel + Left = 16 + Height = 137 + Top = 8 + Width = 361 + BevelOuter = bvNone + BorderStyle = bsSingle + ClientHeight = 133 + ClientWidth = 357 + Color = clWhite + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Arial' + ParentColor = False + ParentFont = False + TabOrder = 1 + object ChemLabel1: TChemLabel + AnchorSideLeft.Control = Spacer + AnchorSideLeft.Side = asrBottom + Left = 187 + Height = 23 + Top = 40 + Width = 60 + Caption = 'C3H7OH' + ParentColor = False + end + object ChemLabel2: TChemLabel + AnchorSideLeft.Control = Spacer + AnchorSideLeft.Side = asrBottom + Left = 187 + Height = 23 + Top = 68 + Width = 121 + Arrow = caUTF8Single + Caption = '2H2 + O2 -> H2O' + ParentColor = False + end + object ChemLabel3: TChemLabel + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + Left = 110 + Height = 19 + Top = 8 + Width = 136 + Caption = 'Using ChemLabel' + Font.Color = clNavy + Font.Height = -16 + Font.Name = 'Arial' + Font.Style = [fsBold] + ParentColor = False + ParentFont = False + end + object ChemLabel5: TChemLabel + AnchorSideLeft.Control = Spacer + AnchorSideLeft.Side = asrBottom + Left = 187 + Height = 23 + Top = 96 + Width = 141 + Arrow = caUTF8Single + Caption = 'H2+ + H2 --> H3+ + H' + ParentColor = False + end + object Spacer: TBevel + AnchorSideLeft.Control = Panel1 + AnchorSideLeft.Side = asrCenter + Left = 170 + Height = 136 + Top = 0 + Width = 17 + Shape = bsSpacer + end + object Label1: TLabel + AnchorSideRight.Control = Spacer + Left = 103 + Height = 18 + Top = 40 + Width = 67 + Anchors = [akTop, akRight] + Caption = 'Propanol:' + ParentColor = False + end + object Label2: TLabel + AnchorSideRight.Control = Spacer + Left = 40 + Height = 18 + Top = 68 + Width = 130 + Anchors = [akTop, akRight] + Caption = 'Chemical reaction:' + ParentColor = False + end + object Label3: TLabel + AnchorSideRight.Control = Spacer + Left = 19 + Height = 18 + Top = 96 + Width = 151 + Anchors = [akTop, akRight] + Caption = 'Ion-molecule reaction:' + ParentColor = False + end + end + object Edit1: TEdit + Left = 32 + Height = 26 + Top = 168 + Width = 329 + OnChange = Edit1Change + TabOrder = 0 + Text = '(CH3)3COH' + end + object ChemLabel4: TChemLabel + Left = 32 + Height = 36 + Top = 208 + Width = 131 + Arrow = caUTF8Single + Caption = '(CH3)3COH' + Font.Color = clWindowText + Font.Height = -27 + Font.Name = 'Times New Roman' + ParentColor = False + ParentFont = False + end +end diff --git a/components/chemtext/demo/chemdemo/testchem.pas b/components/chemtext/demo/chemdemo/testchem.pas new file mode 100644 index 000000000..e41400552 --- /dev/null +++ b/components/chemtext/demo/chemdemo/testchem.pas @@ -0,0 +1,44 @@ +unit testchem; + +interface + +uses + SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ExtCtrls, chemtext; + +type + + { TForm1 } + + TForm1 = class(TForm) + Spacer: TBevel; + ChemLabel1: TChemLabel; + ChemLabel2: TChemLabel; + ChemLabel3: TChemLabel; + ChemLabel5: TChemLabel; + Edit1: TEdit; + ChemLabel4: TChemLabel; + Label1: TLabel; + Label2: TLabel; + Label3: TLabel; + Panel1: TPanel; + procedure Edit1Change(Sender: TObject); + private + + public + + end; + +var + Form1: TForm1; + +implementation + +{$R *.lfm} + +procedure TForm1.Edit1Change(Sender: TObject); +begin + ChemLabel4.Caption := Edit1.Text; +end; + +end. diff --git a/components/chemtext/demo/runtime/project1.lpi b/components/chemtext/demo/runtime/project1.lpi new file mode 100644 index 000000000..e1627a4a0 --- /dev/null +++ b/components/chemtext/demo/runtime/project1.lpi @@ -0,0 +1,80 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <ProjectOptions> + <Version Value="10"/> + <PathDelim Value="\"/> + <General> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="project1"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <Icon Value="0"/> + </General> + <BuildModes Count="1"> + <Item1 Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + </local> + </RunParams> + <RequiredPackages Count="2"> + <Item1> + <PackageName Value="laz_chemtext"/> + </Item1> + <Item2> + <PackageName Value="LCL"/> + </Item2> + </RequiredPackages> + <Units Count="2"> + <Unit0> + <Filename Value="project1.lpr"/> + <IsPartOfProject Value="True"/> + </Unit0> + <Unit1> + <Filename Value="unit1.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + <UnitName Value="Unit1"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="project1"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="..\source"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions Count="3"> + <Item1> + <Name Value="EAbort"/> + </Item1> + <Item2> + <Name Value="ECodetoolError"/> + </Item2> + <Item3> + <Name Value="EFOpenError"/> + </Item3> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/components/chemtext/demo/runtime/project1.lpr b/components/chemtext/demo/runtime/project1.lpr new file mode 100644 index 000000000..ced6d8255 --- /dev/null +++ b/components/chemtext/demo/runtime/project1.lpr @@ -0,0 +1,21 @@ +program project1; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, Unit1 + { you can add units after this }; + +{$R *.res} + +begin + RequireDerivedFormResource := True; + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/components/chemtext/demo/runtime/unit1.lfm b/components/chemtext/demo/runtime/unit1.lfm new file mode 100644 index 000000000..116994320 --- /dev/null +++ b/components/chemtext/demo/runtime/unit1.lfm @@ -0,0 +1,169 @@ +object Form1: TForm1 + Left = 280 + Height = 418 + Top = 130 + Width = 435 + Caption = 'Form1' + ClientHeight = 418 + ClientWidth = 435 + OnCreate = FormCreate + LCLVersion = '1.9.0.0' + object RadioGroup1: TRadioGroup + Left = 13 + Height = 330 + Top = 74 + Width = 195 + Anchors = [akTop, akLeft, akBottom] + AutoFill = True + Caption = 'Formula' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 310 + ClientWidth = 191 + ItemIndex = 0 + Items.Strings = ( + 'H' + 'H+' + '2H+' + 'O--' + 'H2O' + 'C3H7OH' + '(CH3)3COH' + '2H+ + O--' + 'H + Cl -> HCl' + 'H + Cl --> HCl' + '2 H+ + O-- <-> H2O' + '2 H+ + O-- <--> H2O' + 'H2O <- 2H + O' + 'H2O <-- 2H + O' + ) + OnClick = RadioGroup1Click + TabOrder = 0 + end + object CbDefaultFontSize: TCheckBox + Left = 335 + Height = 19 + Top = 354 + Width = 83 + Caption = 'Default font' + Checked = True + OnChange = CbDefaultFontSizeChange + State = cbChecked + TabOrder = 1 + end + object RadioGroup2: TRadioGroup + Left = 224 + Height = 142 + Top = 74 + Width = 185 + AutoFill = True + Caption = 'Arrow' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 122 + ClientWidth = 181 + ItemIndex = 0 + Items.Strings = ( + 'ASCII single' + 'ASCII double' + 'UTF8 ' + 'UTF8 single' + 'UTF8 double' + 'UTF8 half' + ) + OnClick = RadioGroup2Click + TabOrder = 2 + end + object RadioGroup3: TRadioGroup + Left = 224 + Height = 43 + Top = 232 + Width = 185 + AutoFill = True + Caption = 'Alignment' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 3 + ClientHeight = 23 + ClientWidth = 181 + Columns = 3 + ItemIndex = 0 + Items.Strings = ( + 'left' + 'center' + 'right' + ) + OnClick = RadioGroup3Click + TabOrder = 3 + end + object CheckBox2: TCheckBox + Left = 335 + Height = 19 + Top = 330 + Width = 65 + Caption = 'Autosize' + OnChange = CheckBox2Change + TabOrder = 4 + end + object RadioGroup4: TRadioGroup + Left = 224 + Height = 88 + Top = 298 + Width = 97 + AutoFill = True + Caption = 'Layout' + ChildSizing.LeftRightSpacing = 6 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 68 + ClientWidth = 93 + ItemIndex = 0 + Items.Strings = ( + 'tlTop' + 'tlCenter' + 'tlBottom' + ) + OnClick = RadioGroup4Click + TabOrder = 5 + end + object CheckBox3: TCheckBox + Left = 335 + Height = 19 + Top = 306 + Width = 62 + Caption = 'Enabled' + Checked = True + OnChange = CheckBox3Change + State = cbChecked + TabOrder = 6 + end + object SpinEdit1: TSpinEdit + Left = 352 + Height = 23 + Top = 381 + Width = 50 + Alignment = taRightJustify + OnChange = SpinEdit1Change + TabOrder = 7 + Value = 20 + Visible = False + end +end diff --git a/components/chemtext/demo/runtime/unit1.pas b/components/chemtext/demo/runtime/unit1.pas new file mode 100644 index 000000000..7282ead0d --- /dev/null +++ b/components/chemtext/demo/runtime/unit1.pas @@ -0,0 +1,124 @@ +unit Unit1; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, + ExtCtrls, Spin, ChemText; + +type + + { TForm1 } + + TForm1 = class(TForm) + CbDefaultFontSize: TCheckBox; + CheckBox2: TCheckBox; + CheckBox3: TCheckBox; + RadioGroup1: TRadioGroup; + RadioGroup2: TRadioGroup; + RadioGroup3: TRadioGroup; + RadioGroup4: TRadioGroup; + SpinEdit1: TSpinEdit; + procedure CbDefaultFontSizeChange(Sender: TObject); + procedure CheckBox2Change(Sender: TObject); + procedure CheckBox3Change(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure RadioGroup1Click(Sender: TObject); + procedure RadioGroup2Click(Sender: TObject); + procedure RadioGroup3Click(Sender: TObject); + procedure RadioGroup4Click(Sender: TObject); + procedure SpinEdit1Change(Sender: TObject); + private + ChemLabel: TChemLabel; + + public + + end; + +var + Form1: TForm1; + +implementation + +{$R *.lfm} + +{ TForm1 } + +procedure TForm1.CbDefaultFontSizeChange(Sender: TObject); +begin + if CbDefaultFontSize.Checked then + Chemlabel.Font.Size := 0 + else + ChemLabel.Font.Size := SpinEdit1.Value; + SpinEdit1.Visible := not CbDefaultFontSize.Checked; +end; + +procedure TForm1.CheckBox2Change(Sender: TObject); +begin + ChemLabel.AutoSize := Checkbox2.Checked; + if not ChemLabel.AutoSize then begin + ChemLabel.Width := Width - 2*ChemLabel.Left; + ChemLabel.Height := Radiogroup1.Top - 8 - 8; + end; +end; + +procedure TForm1.CheckBox3Change(Sender: TObject); +begin + ChemLabel.Enabled := Checkbox3.Checked; +end; + +procedure TForm1.FormCreate(Sender: TObject); +begin + ChemLabel := TChemLabel.Create(self); + ChemLabel.Parent := self; + ChemLabel.Left := 8; + ChemLabel.Top := 8; + ChemLabel.AutoSize := false; + Chemlabel.Height := 50; + ChemLabel.Width := ClientWidth - 2*Chemlabel.Left; +// ChemLabel.Anchors := [akLeft, akRight, akTop]; + ChemLabel.Color := clWindow; + + RadioGroup1Click(nil); + RadioGroup2Click(nil); +end; + +procedure TForm1.RadioGroup1Click(Sender: TObject); +begin + Chemlabel.Caption := RadioGroup1.Items[Radiogroup1.ItemIndex]; +end; + +procedure TForm1.RadioGroup2Click(Sender: TObject); +begin + ChemLabel.Arrow := TChemArrow(RadioGroup2.ItemIndex); +end; + +procedure TForm1.RadioGroup3Click(Sender: TObject); +begin + case Radiogroup3.ItemIndex of + 0: ChemLabel.Alignment := taLeftJustify; + 1: ChemLabel.Alignment := taCenter; + 2: Chemlabel.Alignment := taRightJustify; + end; +end; + +procedure TForm1.RadioGroup4Click(Sender: TObject); +begin + case Radiogroup4.ItemIndex of + 0: ChemLabel.Layout := tlTop; + 1: Chemlabel.Layout := tlCenter; + 2: Chemlabel.Layout := tlBottom; + end; +end; + +procedure TForm1.SpinEdit1Change(Sender: TObject); +begin + if not CbDefaultFontSize.Checked then + Chemlabel.Font.Size := SpinEdit1.Value; + ChemLabel.Invalidate; +end; + +end. + diff --git a/components/chemtext/laz_chemtext.lpk b/components/chemtext/laz_chemtext.lpk new file mode 100644 index 000000000..e33f91bce --- /dev/null +++ b/components/chemtext/laz_chemtext.lpk @@ -0,0 +1,40 @@ +<?xml version="1.0" encoding="UTF-8"?> +<CONFIG> + <Package Version="4"> + <PathDelim Value="\"/> + <Name Value="laz_chemtext"/> + <Type Value="RunAndDesignTime"/> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <SearchPaths> + <OtherUnitFiles Value="source"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\"/> + </SearchPaths> + </CompilerOptions> + <Description Value="A label showing chemical formulas with sub- and superscripts and reaction arrows."/> + <License Value="LGPL with linking exception (like Lazarus)"/> + <Version Minor="1"/> + <Files Count="1"> + <Item1> + <Filename Value="source\chemtext.pas"/> + <HasRegisterProc Value="True"/> + <UnitName Value="chemtext"/> + </Item1> + </Files> + <RequiredPkgs Count="2"> + <Item1> + <PackageName Value="LCL"/> + </Item1> + <Item2> + <PackageName Value="FCL"/> + </Item2> + </RequiredPkgs> + <UsageOptions> + <UnitPath Value="$(PkgOutDir)"/> + </UsageOptions> + <PublishOptions> + <Version Value="2"/> + </PublishOptions> + </Package> +</CONFIG> diff --git a/components/chemtext/laz_chemtext.pas b/components/chemtext/laz_chemtext.pas new file mode 100644 index 000000000..605011ee1 --- /dev/null +++ b/components/chemtext/laz_chemtext.pas @@ -0,0 +1,22 @@ +{ This file was automatically created by Lazarus. Do not edit! + This source is only used to compile and install the package. + } + +unit laz_chemtext; + +{$warn 5023 off : no warning about unused units} +interface + +uses + chemtext, LazarusPackageIntf; + +implementation + +procedure Register; +begin + RegisterUnit('chemtext', @chemtext.Register); +end; + +initialization + RegisterPackage('laz_chemtext', @Register); +end. diff --git a/components/chemtext/source/chemtext.pas b/components/chemtext/source/chemtext.pas new file mode 100644 index 000000000..8b38a5ba8 --- /dev/null +++ b/components/chemtext/source/chemtext.pas @@ -0,0 +1,420 @@ +(******************************************************************************* + + chemtext.pas + + Motivated by chemtxt written by Patrick Spanel (Patrik.Spanel@jh-inst.cas.cz) + Download his version from + http://torry.net/vcl/science/packs/ChemText12.zip + or + http://delphi.icm.edu.pl/ftp/d10free/chemtxt.zip + + Adapted to Lazarus and extended by Werner Pamler + + License: + LGPL with linking exception (like Lazarus) + See the file COPYING.modifiedLGPL.txt, included in the Lazarus distribution, + for details about the license. + +*******************************************************************************) + +unit chemtext; + +interface + +uses + LclIntf, LCLType, Types, SysUtils, Classes, Graphics, StdCtrls; + +type + TChemArrow = ( + caASCIISingle, caASCIIDouble, caUTF8, caUTF8Single, caUTF8Double, caUTF8Half + ); + + TChemLabel = class(TCustomLabel) + private + FArrow: TChemArrow; + procedure SetArrow(const AValue: TChemArrow); + protected + procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer; + {%H-}WithThemeSpace: Boolean); override; + procedure CalculateSize(out NeededWidth, NeededHeight: Integer); + procedure DoMeasureTextPosition(var TextTop: integer; + var TextLeft: integer); override; + public + constructor Create(AOwner: TComponent); override; + procedure Paint; override; + published + property Arrow: TChemArrow read FArrow write SetArrow default caASCIISingle; + + property Align; + property Alignment; + property Anchors; + property AutoSize; +// property BidiMode; + property BorderSpacing; + property Caption; + property Color; + property Constraints; + property DragCursor; + property DragKind; + property DragMode; + property Enabled; + property FocusControl; + property Font; + property Layout; +// property ParentBidiMode; + property ParentColor; + property ParentFont; + property ParentShowHint; + property PopupMenu; +// property ShowAccelChar; + property ShowHint; + property Transparent; + property Visible; +// property WordWrap; + property OnChangeBounds; + property OnClick; + property OnContextPopup; + property OnDblClick; + property OnDragDrop; + property OnDragOver; + property OnEndDrag; + property OnMouseDown; + property OnMouseEnter; + property OnMouseLeave; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseWheelDown; + property OnMouseWheelUp; + property OnResize; + property OnStartDrag; +// property OptimalFill; + end; + + +{ The following rotuines can be used in an event handler, for example in + OnDrawDataCell of DBGrid: + + procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; + const Rect: TRect; Field: TField; State: + TGridDrawState); + begin + if Assigned(Field) then + ChemTextOut((Sender as TDBGrid).Canvas, Rect, Rect.Left, + Rect.Top, Field.DisplayText); + end; +} + +function ChemTextOut(ACanvas: TCanvas; X, Y: integer; + const AText:String; Arrow: TChemArrow = caAsciiSingle; Measure: Boolean = false): TSize; + +function ChemTextHeight(ACanvas: TCanvas; const AText: String; + Arrow: TChemArrow = caAsciiSingle): Integer; + +function ChemTextWidth(ACanvas: TCanvas; const AText: String; + Arrow: TChemArrow = caAsciiSingle): Integer; + +function ChemTextExtent(ACanvas: TCanvas; const AText: String; + Arrow: TChemArrow = caAsciiSingle): TSize; + +procedure Register; + + +implementation + +{$R chemtext.res} + +uses + Themes, Math; + +type + TArrowDir = (adLeft, adRight, adBoth); + +const + SUBFONT_SIZE_MULTIPLIER = 75; + SUBFONT_OFFSET_MULTIPLIER = 50; + SUBFONT_DIVISOR = 100; + ARROW_LINE: array[boolean] of char = ('-', '='); + +function ChemTextHeight(ACanvas: TCanvas; const AText: String; + Arrow: TChemArrow = caAsciiSingle): Integer; +var + ex: TSize; +begin + ex := ChemTextExtent(ACanvas, AText, Arrow); + Result := ex.CY; +end; + +function ChemTextWidth(ACanvas: TCanvas; const AText: String; + Arrow: TChemArrow = caAsciiSingle): Integer; +var + ex: TSize; +begin + ex := ChemTextExtent(ACanvas, AText, Arrow); + Result := ex.CX; +end; + +function ChemTextExtent(ACanvas: TCanvas; const AText: String; + Arrow: TChemArrow = caAsciiSingle): TSize; +begin + Result := ChemTextOut(ACanvas, 0, 0, AText, Arrow, true); +end; + +function ChemTextOut(ACanvas: TCanvas; X, Y:integer; const AText: String; + Arrow: TChemArrow = caAsciiSingle; Measure: Boolean = false): TSize; +var + lTextHeight: Integer; + + procedure DrawSub(var x: Integer; y: Integer; const s: String); + var + h: Integer; + yoff: Integer; + begin + h := ACanvas.Font.Height; + try + ACanvas.Font.Height := MulDiv(h, SUBFONT_SIZE_MULTIPLIER, SUBFONT_DIVISOR); + yoff := abs(MulDiv(h, SUBFONT_OFFSET_MULTIPLIER, SUBFONT_DIVISOR)); + if not Measure then + ACanvas.TextOut(x, y + yoff, s); + x := x + ACanvas.TextWidth(s); + lTextHeight := Max(lTextHeight, yoff + ACanvas.TextHeight('0')); + finally + ACanvas.Font.Height := h; + end; + end; + + procedure DrawSup(var x: Integer; y: Integer; const s: String); + var + h: Integer; + begin + h := ACanvas.Font.Height; + try + ACanvas.Font.Height := MulDiv(h, SUBFONT_SIZE_MULTIPLIER, SUBFONT_DIVISOR); + if not Measure then + ACanvas.TextOut(x, y - 1, s); + inc(x, ACanvas.TextWidth(s)); + finally + ACanvas.Font.Height := h; + end; + end; + + procedure DrawNormal(var x: Integer; y: Integer; const s: String); + begin + if not Measure then + ACanvas.TextOut(x, y, s); + inc(x, ACanvas.TextWidth(s)); + end; + + procedure DrawArrow(var x: Integer; y: Integer; ADir: TArrowDir; + ALen: Integer); + const + ARROWS: array[TChemArrow, TArrowDir] of string = ( + ('<%s', '%s>', '<%s>'), // caAsciiSingle + ('<%s', '%s>', '<%s>'), // caAsciiDouble + (#$E2#$86#$90, #$E2#$86#$92, #$E2#$87#$8C), // caUTF8 ← → ⇌ + (#$E2#$86#$90, #$E2#$86#$92, #$E2#$86#$94), // caUTF8Single ← → ↔ + (#$E2#$87#$90, #$E2#$87#$92, #$E2#$87#$94), // caUTF8Double ⇐ ⇒ ⇔ ⇔ + (#$E2#$86#$BD, #$E2#$87#$80, #$E2#$87#$8C) // caUTF8Half ↽ ↼ ⇌ + ); + var + i: Integer; + s: String; + begin + if Arrow in [caASCIISingle, caASCIIDouble] then + begin + SetLength(s, ALen); + for i:=1 to ALen do s[i] := ARROW_LINE[Arrow=caAsciiDouble]; + s := Format(ARROWS[Arrow, ADir], [s]); + end else + s := ARROWS[Arrow, ADir]; + + if not Measure then + ACanvas.TextOut(x, y, s); + inc(x, ACanvas.TextWidth(s)); + end; + +var + x0: Integer; + i, j: integer; + s: string; + subNos: boolean; // "subscript numbers" +begin + Result := Size(0, 0); + if AText = '' then + exit; + + with ACanvas do begin + if Font.Size = 0 then + Font.Size := GetFontData(Font.Reference.Handle).Height; + + lTextHeight := TextHeight('Tg'); + + x0 := X; + subNos := false; + i := 1; + while i <= Length(AText) do begin + case AText[i] of + '0'..'9': + begin + s := AText[i]; + j := i+1; + while (j <= Length(AText)) and (AText[j] in ['0'..'9']) do + inc(j); + s := Copy(AText, i, j-i); + if subNos then + DrawSub(X, Y, s) + else + DrawNormal(X, Y, s); + i := j-1; + subNos := false; + end; + + '<': + begin + j := i+1; + while (j <= Length(AText)) and (AText[j] in ['-', '=']) do + inc(j); + if (AText[j] = '>') then + DrawArrow(X, Y, adBoth, j-i-1) + else begin + DrawArrow(X, Y, adLeft, j-i-1); + dec(j); + end; + i := j; + subNos := false; + end; + + '+': + begin + if (i > 1) and (AText[i-1] in ['A'..'Z','a'..'z','0'..'9','+',')']) then + DrawSup(X, Y, '+') + else + DrawNormal(X, Y, '+'); + subNos := false; + end; + + '-': + begin + j := i+1; + while (j <= Length(AText)) and (AText[j] = '-') do inc(j); + if (j <= Length(AText)) and (AText[j] = '>') then // Arrow + begin + DrawArrow(X, y, adRight, j-i); + i := j; + end else // superscript - + DrawSup(X, Y, '-'); + subNos := false; + end; + + else + begin + j := i+1; + while (j <= Length(AText)) and not (AText[j] in ['0'..'9', '+', '-', '<']) do + inc(j); + s := Copy(AText, i, j-i); + DrawNormal(X, Y, s); + i := j-1; + subNos := AText[i] in ['A'..'Z', 'a'..'z', ')']; + // In these cases a subsequent number will be subscripted. + end; + end; + inc(i); + end; + end; + + Result.CX := X - x0; + Result.CY := lTextHeight; +end; + + +{ TChemText } + +constructor TChemLabel.Create(AOwner: TComponent); +begin + inherited; +end; + +procedure TChemLabel.CalculatePreferredSize( + var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); +begin + CalculateSize(PreferredWidth, PreferredHeight); +end; + +procedure TChemlabel.CalculateSize(out NeededWidth, NeededHeight: Integer); +var + ex: TSize; +begin + Canvas.Font := Font; + ex := ChemTextExtent(Canvas, Caption, FArrow); + NeededWidth := ex.CX; + NeededHeight := ex.CY; +end; + +procedure TChemLabel.DoMeasureTextPosition(var TextTop: integer; + var TextLeft: integer); +var + lTextHeight: integer; + lTextWidth: integer; +begin + TextLeft := 0; + TextTop := 0; + if (Alignment <> taLeftJustify) or (Layout <> tlTop) then begin + CalculateSize(lTextWidth, lTextHeight); + case Alignment of + taCenter : TextLeft := (Width - lTextWidth) div 2; + taRightJustify : TextLeft := Width - lTextWidth; + end; + case Layout of + tlCenter : TextTop := (Height - lTextHeight) div 2; + tlBottom : TextTop := Height - lTextHeight; + end; + end; +end; + +procedure TChemLabel.Paint; +var + textTop: Integer = 0; + textLeft: Integer = 0; + oldFontColor: TColor; + labelText: String; +begin + if not Transparent then + begin + Canvas.Brush.Color := Self.Color; + Canvas.Brush.Style := bsSolid; + Canvas.FillRect(ClientRect); + end; + Canvas.Brush.Style := bsClear; + Canvas.Font := Font; + + labelText := Caption; + DoMeasureTextPosition(textTop, textLeft); + + oldFontColor := Font.Color; + if not IsEnabled then + if ThemeServices.ThemesEnabled then + Canvas.Font.Color := clGrayText + else + begin + Canvas.Font.Color := clBtnHighlight; + ChemTextOut(Canvas, textLeft + 1, textTop + 1, labelText, FArrow); + Canvas.Font.Color := clBtnShadow; + end; + ChemTextOut(Canvas, textLeft, textTop, labelText, FArrow); + Canvas.Font.Color := oldFontColor; +end; + +procedure TChemLabel.SetArrow(const AValue: TChemArrow); +begin + if AValue = FArrow then + exit; + FArrow := AValue; + Invalidate; +end; + +procedure Register; +begin + RegisterComponents('Misc', [TChemlabel]); +end; + +end. diff --git a/components/chemtext/source/chemtext.res b/components/chemtext/source/chemtext.res new file mode 100644 index 0000000000000000000000000000000000000000..bc120271711982d3a6ffd27784cae551f4cd327a GIT binary patch literal 2771 zcmb7^c{mhWAIHxyp+UwL*=8)+LyLVZF_W=OmV~lLvW`g;*;PoAEnAmdVnm@VQ;aO3 zjD2YnvLuO&bu8iXj^6jV@ALlgKKI`9Jil{(zwh(=oqx{va{vGU$%x(Ee+MJ|pJl@Y zzzK%3y9)!>zz|>o2H=1hI0+0Gnc1JcaQL4oxNULTh!Z9RV<?=)ShN-66x<6o7REjv zq_e>|ST2|vp@9+OKBJg?bw7r(pMX7g1ps#5y?}t<a`t9eiN-h#>jaA+zas1N`$4Z5 zlBk!p9nsL=&+j6h$S46Y47lh@yy%V$@*;X7jf`;??n)O~0f119(I>63ZM3v{pL>>k zZz6kf%O7|w37*f82l%(oL-!Y1aQnWOo&U)tlA0*Wq(m9SVT8!<aSrhoa3}^hgH&5( zX1&VGy&o$oQV^_{Xc!*T;gfyBCt~u-0n~c#$_RV-COsa&?p<ZJ%hfEYNiO`uG=G~O zC3lto)8+dTEwjfWy?=Tvof(;Y9#R>0(KWO79S=c+quBr(YE6I!D=$wO)#h^M1Um3> z7`v{n(%vGR-p3<wlmx1#x*hG4{&y63^_0|jzRwBTH0N7N`q)kH9npT(wT5j@`t3=@ zH=`YI7OvJ&^v%M<{)C%+QDZ{%D3G^W!0#S#PDQSNJW}KdO4-;!{VT_l(yjzOmANN< zaWBF(Si@KbHPb%(MYU$)g9x`(6l;-MlL^8gRmaI*?a`N_zL&fJ?L$uV?<>BGfC@ec zs~l5w1O2^g)x&BQ0amKc!Oyc&IbG)C?}u|SMN)q7iOTn0>K<6X`(3E1<MS09cfz5N zg~AuHp<Z7c1<7rrUHpw@q3zk1>CL`cG@5<WoNIyF<ww~XK_?y(J>28_=2h{yF8>+j zArxk{sFh%qvqhg!rwEcvcx>$N?me$D<}|w8z~u%2cxC`l4CViM(HR^Csz7CL=-2uS zPf9VGq<(pF0%T<|ihu0MBh1AMH|{eg|E?#Q2KGE@*Fv)~^-Zu8)S2#aCYsbs8lbIP zn~(cxt@;*UkmR|2x3yWa`utt=06fWh_K<J2bQPSPo!vJ&y05L-#RMavh>h7NFK+PO zM{8H-pq3jot>{4tcIV!9dw2cxj^=t;QYeH=40UaBk(~`-(sA+T=vjf|{1xgs*0PF? zVtGlz;z|;l2XE-VOnWy+!8`hR&J?&ew2z$g5iIsZT?lJnb5%?2VjgErVRnJFcPI7+ z!;5_f|1gL0+jNcLDmRsvjz*VoTA#4FWNmTsXSy78U0S*@u5jSMR^Z|^mvVr^j|^;0 zdi9jP>lFDm7<V^Fc4H}LuG>9AZct5%AD(^u&^WEA-QGOfXvj+)%a=-IJHz5)6l+j4 z@cXyHp|Mr~h8R6*-n^)+*K(pJ<wd%k5b4%Vm4jO$RWeStb1Sq`h~`qj?`iFYVqyr6 z;DCkj-fCM!gjPxZAzt+InJ|$DT0!WfT8}pAvI@zI)R4D=5SP>ES`>d?6LEnQ7f0Xe z$?Wk{H-9=8O&9rU2I4duE&u_m*ubbr2(PGq@8(pp$cOzotitxLWp%M%W9`<G3jnfG z^D^FbA%T2pyK$j+j3_sp9GWWPJ#YKTXx8+g)QEjJ9{whQDef%j;G`H>+3>R&280C8 z*AV(MVjqZJ6A09eILjz&p$A?&@{L>dTWkh+(&N4$@YH=#!>gTQrdl~^XR2Jg-a8zB z{8o>+EtC53<UuKNY<SA}@*^+q6OG%;Dk(B`3Wxh`&yPm0QD<fI^s2dyZCDp_I2O#` zzPD^qn$$Br#x+3BaM4J!(~2B@4mEu&{*`?#El<tZnbP>^hR)Rapg_}S?gADC&bf$i zOkU+>?N@HeLyi64#-1wsnRkX3E6WZAsG3Xv5Qm=gn)p1P`k{K{X1G$Q2Te+Y+FWj) znYE*7-A@;4%^Fp+*|XS&^P(s#7U4LoP@S=d+<#fsgZ>q(#~7skZC3XhRerH*%k=XW zqxi?HD#13zymlCqf0tF}f<0C}M`?DBo+4-Yb{e#`y(%k8_|Hdrid(arY~{U~o4;u{ zOTm&MWKtiDq$h;)NLj<ce{k_v#3`qLewP++0=H)`OBH-vH@rFCg7>!He)R%2!)3r5 zUDS;y2F)+!4-+qW*PZKjm+WC>4^>|8%2~+0(hxcibi+0lCt7ZCA#``DT&9pbdh+R$ zzF#aysn0UV>V|b!H`GizLsHFo0ua;~I2%&ZAeW~sX^><vcDr6Qrm@O)b)+7Ps>kF{ zRa==Q+wH65*N3BzQ*D^c6-Xi7vExtkuX)f)CE$sVg21d{>WkCjmh%=()2<3D%cV&8 z^MPLYY?)Bi1F686$&y40kLQm$e~FsmqjG&rpWJ*t>lPXLw>zUgDh5_?J`7@a(Z<Gw zG?rDV6Rt|DyoEBII>SoEr1u!kk!#)Op83oe1DWA6qKRd=ag*#7PtL6MQV1bWi90Xf zMqAxkw`0v=dRr<{2C)T`*m4;7xsfI@p3yOL9c5QCT1Y=z)h8S7-4vF8!=MJQiX3NZ zL+8`oRE6CPA_5;cz4&++h_5KLVca&XRE5`txbNFGva!7pJ?5$8TjJp+AW+u>OT?A1 zczYf8{_c1Rm}$9xujK;NkuHzZgq}aj{c6VVC&W^$T;(S@^~IQuW;SsRebBzO*2>bU zx~OxVbgx{NOcsKGY{$Cf6{#4BB|1!gRrK~*DFL`IRL~|?i0vvV7l8OM8p^ps_X0_M zv}THmG7Y%da;j5Z45MFf;uKs2vP)=pEZ&GmS)0(HDuY>ib&(H)m$Z=!FTbU1N?jn? zdLKcUIqcA6s=OMqIvkX)>&sj(E2nE}t1WMxOp3QNgTz9<nnosyd3XJeC{6C20*kb^ z>>aqv*6QngHMtfl%k&W;b>ZJu*iLY8&uT^yXBJHxMI3DDQcR!FM3N+lk~HF&BHv=W zJDu9k%&kzx@zsYcmo-N{T;SYgcU;DIFpxH-HG#}dXecMwTcS@rMnu$rLE(V*@59GG zoW4bQ>w|6WJdoorr1#=uy+^Uk2LV|JCkcrRwoMG-6dGn5p&^+J;jU1c=|B7lJy-SE zw!`a8!Th^=i#PkhNw(^~2>Hyo)zBp+E{R2H%%OU4V+y~*|1@VkTEBQ}VtPNy3ctEO zmD(SqQ}1l%Gy775keR%YuCQQNa*g71O7F?`)}4@|TP`2<X39J;Fw4G)Nbi;Zpkcnj SUcPQ3>39cDVsQQE=kqV6Y<*Gy literal 0 HcmV?d00001