tabsformu.pas

jvcl driver development envionment

{******************************************************************

                       JEDI-VCL Demo

 Copyright (C) 2002 Project JEDI

 Original author:

 Contributor(s):

 You may retrieve the latest version of this file at the JEDI-JVCL
 home page, located at http://jvcl.sourceforge.net

 The contents of this file are used with permission, subject to
 the Mozilla Public License Version 1.1 (the "License"); you may
 not use this file except in compliance with the License. You may
 obtain a copy of the License at
 http://www.mozilla.org/MPL/MPL-1_1Final.html

 Software distributed under the License is distributed on an
 "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 implied. See the License for the specific language governing
 rights and limitations under the License.

******************************************************************}

unit TabsFormU;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  StdCtrls, ExtCtrls, ActnList, JvMaskEdit, JvSpin, JvRichEdit,
  Contnrs;

type
  TMeasurementUnit = (mtInches, mtCentimeters, mtMillimeters, mtPoints, mtPicas);

  TTabsForm = class(TForm)
    StaticText4: TStaticText;
    StaticText5: TStaticText;
    edtTabStopPosition: TEdit;
    lsbTabStopPositions: TListBox;
    pnlLeader: TPanel;
    pnlAlignment: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    StaticText1: TStaticText;
    StaticText3: TStaticText;
    ActionList1: TActionList;
    actSet: TAction;
    actClear: TAction;
    actClearAll: TAction;
    actOK: TAction;
    actCancel: TAction;
    Bevel3: TBevel;
    Bevel2: TBevel;
    Bevel1: TBevel;
    rbtAlignment1: TRadioButton;
    rbtAlignment2: TRadioButton;
    rbtAlignment5: TRadioButton;
    rbtAlignment3: TRadioButton;
    rbtAlignment4: TRadioButton;
    rbtLeader1: TRadioButton;
    rbtLeader2: TRadioButton;
    rbtLeader3: TRadioButton;
    rbtLeader4: TRadioButton;
    cmbMeasurementUnits: TComboBox;
    rbtLeader5: TRadioButton;
    procedure actSetExecute(Sender: TObject);
    procedure actClearExecute(Sender: TObject);
    procedure actClearAllExecute(Sender: TObject);
    procedure actOKExecute(Sender: TObject);
    procedure actCancelExecute(Sender: TObject);
    procedure edtTabStopPositionKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure lsbTabStopPositionsEnter(Sender: TObject);
    procedure lsbTabStopPositionsClick(Sender: TObject);
    procedure cmbMeasurementUnitsChange(Sender: TObject);
    procedure AlignmentClick(Sender: TObject);
    procedure IsTabStopFilled(Sender: TObject);
    procedure lsbTabStopPositionsDrawItem(Control: TWinControl;
      Index: Integer; Rect: TRect; State: TOwnerDrawState);
  private
    FTabs: TObjectList;
    FLeaderObjs: array [TJvTabLeader] of TRadioButton;
    FAlignmentObjs: array [TJvTabAlignment] of TRadioButton;
    procedure SetTabAlignment(const Value: TJvTabAlignment);
    procedure SetTabLeader(const Value: TJvTabLeader);
    function GetTabAlignment: TJvTabAlignment;
    function GetTabLeader: TJvTabLeader;
  private
    FMeasurementUnit: TMeasurementUnit;
    procedure Init;
  protected
    function FindTab(const APosition: Integer; var Index: Integer): Boolean;
    procedure ClearAllTabStops;
    procedure ClearTabStop;
    procedure FillMeasurementUnits(Strings: TStrings);
    procedure GetTabs(Paragraph: TJvParaAttributes);
    procedure GotoTab(const Index: Integer);
    procedure SelectTab(const Index: Integer);
    procedure SetTabs(Paragraph: TJvParaAttributes);
    procedure SetTabStop;
    procedure UpdateMeasurementUnits;
    procedure UpdateLeader;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property TabAlignment: TJvTabAlignment read GetTabAlignment write SetTabAlignment;
    property TabLeader: TJvTabLeader read GetTabLeader write SetTabLeader;
  end;

function FormatTabs(Paragraph: TJvParaAttributes): Boolean;

implementation

uses
  Math;

{$R *.dfm}

function TryStrToFloat(const S:string; Var Value:Extended):boolean;
begin
  try
    Result := true;
    Value := StrToFloat(S);
  except
    Result := false;
  end;
end;

type
  TTabObj = class(TObject)
  private
    FPosition: Longint;
    FAlignment: TJvTabAlignment;
    FLeader: TJvTabLeader;
  public
    constructor Create(const APosition: Longint; const AAlignment: TJvTabAlignment;
      const ALeader: TJvTabLeader);
    { Tab position in points }
    property Position: Longint read FPosition write FPosition;
    property Alignment: TJvTabAlignment read FAlignment write FAlignment;
    property Leader: TJvTabLeader read FLeader write fLeader;
  end;

const
  CInitialMeasurementUnit = mtCentimeters;

  CPointsPerInch = 72;
  CPointsPerMM = 2.83464567;
  CPointsPerPica = 12;

  CMeasurementUnitStr: array [TMeasurementUnit] of string =
    ('in', 'cm', 'mm', 'pt', 'pi');
  CMeasurementUnitLongStr: array [TMeasurementUnit] of string =
    ('Inches', 'Centimeters', 'Millimeters', 'Points', 'Picas');

function MeasurementUnitToPoints(const Value: Extended; const AMeasurementUnit: TMeasurementUnit): Integer;
begin
  case AMeasurementUnit of
    mtInches: Result := Round(Value * CPointsPerInch);
    mtCentimeters: Result := Round(Value * CPointsPerMM * 10);
    mtMillimeters: Result := Round(Value * CPointsPerMM);
    mtPoints: Result := Round(Value);
    mtPicas: Result := Round(Value * CPointsPerPica);
  else
    raise Exception.Create('Invalid measurement unit');
  end;
end;

function PointsToMeasurementUnit(const Value: Integer; const AMeasurementUnit: TMeasurementUnit): Extended;
begin
  case AMeasurementUnit of
    mtInches: Result := Value / CPointsPerInch;
    mtCentimeters: Result := (Value / CPointsPerMM) / 10;
    mtMillimeters: Result := Value / CPointsPerMM;
    mtPoints: Result := Value;
    mtPicas: Result := Value / CPointsPerPica;
  else
    raise Exception.Create('Invalid measurement unit');
  end;
end;

function StrToMeasurementUnit(const S: string; var MeasurementUnit: TMeasurementUnit): Boolean;
var
  LMeasurementUnit: TMeasurementUnit;
begin
  for LMeasurementUnit := Low(TMeasurementUnit) to High(TMeasurementUnit) do
    if SameText(S, CMeasurementUnitStr[LMeasurementUnit]) then
    begin
      Result := True;
      MeasurementUnit := LMeasurementUnit;
      Exit;
    end;
  Result := False;
end;

function TextToPosition(S: string; const Default: TMeasurementUnit): Integer;
var
  MeasurementUnit: TMeasurementUnit;
  ValueStr: string;
  Value: Extended;
begin
  S := Trim(S);
  if StrToMeasurementUnit(Copy(S, Length(S) - 1, 2), MeasurementUnit) then
    ValueStr := Trim(Copy(S, 1, Length(S) - 2))
  else
  begin
    ValueStr := S;
    MeasurementUnit := Default;
  end;
  if TryStrToFloat(ValueStr, Value) then
    Result := MeasurementUnitToPoints(Value, MeasurementUnit)
  else
    raise Exception.Create('This is not a valid tab stop.');
end;

function DigitsNeeded(Value: Extended): Integer;
const
  CMaxDigits = 2;
  CEpsilons: array [0..CMaxDigits - 1] of Extended = (0.05, 0.005);
var
  Diff: Extended;
begin
  Result := 0;
  while Result < CMaxDigits do
  begin
    Diff := Value - Round(Value);
    if Diff < 0 then
      Diff := -Diff;
    if Diff < CEpsilons[CMaxDigits - Result - 1] then
      Exit;
    Value := Value * 10;
    Inc(Result);
  end;
end;

function PositionToText(const APosition: Integer; const MeasurementUnit: TMeasurementUnit): string;
var
  Value: Extended;
begin
  Value := PointsToMeasurementUnit(APosition, MeasurementUnit);
  Result := Format('%.*f %s', [DigitsNeeded(Value), Value,
    CMeasurementUnitStr[MeasurementUnit]]);
end;

function FormatTabs(Paragraph: TJvParaAttributes): Boolean;
begin
  with TTabsForm.Create(Application) do
  try
    SetTabs(Paragraph);
    Result := ShowModal = mrOk;
    if Result then
      GetTabs(Paragraph);
  finally
    Free;
  end;
end;

//=== TTabObj ================================================================

constructor TTabObj.Create(const APosition: Integer;
  const AAlignment: TJvTabAlignment; const ALeader: TJvTabLeader);
begin
  inherited Create;
  FPosition := APosition;
  FAlignment := AAlignment;
  FLeader := ALeader;
end;

//=== TTabsForm ==============================================================

procedure TTabsForm.actCancelExecute(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

procedure TTabsForm.actClearAllExecute(Sender: TObject);
begin
  ClearAllTabStops;
end;

procedure TTabsForm.actClearExecute(Sender: TObject);
begin
  ClearTabStop;
end;

procedure TTabsForm.actOKExecute(Sender: TObject);
begin
  ModalResult := mrOk;
end;

procedure TTabsForm.actSetExecute(Sender: TObject);
begin
  SetTabStop;
end;

procedure TTabsForm.AlignmentClick(Sender: TObject);
begin
  UpdateLeader;
end;

procedure TTabsForm.ClearAllTabStops;
begin
  FTabs.Clear;
  lsbTabStopPositions.Items.Clear;
//  lsbTabStopPositions.Count := FTabs.Count;
  GotoTab(-1);
end;

procedure TTabsForm.ClearTabStop;