acedrop.pas

suite component ace report

unit AceDrop;

{ ----------------------------------------------------------------
  Ace Reporter
  Copyright 1995-1998 SCT Associates, Inc.
  Written by Kevin Maher, Steve Tyrakowski
  ---------------------------------------------------------------- }

interface
{$I ace.inc}

uses
  {$IFDEF WIN32}
    windows,dsgnintf,
  {$ELSE}
    winprocs,wintypes,
  {$ENDIF}
  Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, sctrep, ExtCtrls, sctctrl, sctvar, sctdata, Menus
{$ifdef AceBDE}
  ,db, Buttons
{$endif}
 ;
type
{TSctDropStyle}
  TSctDropStyle = (dropVertDiffBand, dropVertLeft, dropVertAbove
                  ,dropHorzDiffBand, dropHorzLeft, dropHorzAbove );

  TAceDropLabels = class(TForm)
    AceVariableList: TListBox;
    ToolPanel: TPanel;
    Panel1: TPanel;
    sbLeft: TSpeedButton;
    sbTop: TSpeedButton;
    TextBand: TComboBox;
    Panel2: TPanel;
    sbHoriz: TSpeedButton;
    sbHorizdiv: TSpeedButton;
    sbVert: TSpeedButton;
    VariableSelection: TComboBox;
    UndoPanel: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure VariableSelectionChange(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Stayontop1Click(Sender: TObject);
    procedure Hide1Click(Sender: TObject);
    procedure AceVariableListClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);

  private
    { Private declarations }
    SelectedList: TStringList;
    TextLabelList, VarLabelList, TextDivList, VarDivList: TList;
    TextLabelBand, VarLabelBand: TSctBand;
    DropHorz, TextAbove, Dividers: Boolean;
    xDrop, yDrop: Integer;

    procedure FillAll;
    procedure FillExpr;
    procedure FillTotal;
{$ifdef AceBDE}
    procedure FillDB;
    procedure FillAutoDB;
{$endif}
    procedure FillSystem;
    function GetTextBand: TSctBand;
    function CreateLabel(MyVar:TSctVar; dtype: TSctDataTypes): TSctLabel;
    function CreateVarLabel(V: TSctVar; bd: TSctBand): TSctLabel;

    procedure FormatVarLabel(l: TSctLabel; v: TSctVar; dtype: TSctDataTypes);
    procedure FormatTextLabel(l: TSctVarLabel; v: TSctVar);
    procedure FormatLabelHW(l: TSctLabel; v: TSctVar; f: TObject);
    procedure CreateLabels;
    function ArrangeLabels: Boolean;
    procedure CreateDividers;
    procedure ShrinkLabels;
    function CheckWidth: Boolean;
    procedure ArrangeHorzNoText(Wrap: Boolean);
    procedure ArrangeHorzTextBand(Wrap: Boolean);
    procedure ArrangeHorzTextAbove(Wrap: Boolean);
    procedure ArrangeHorzTextLeft(Wrap: Boolean);

    procedure ArrangeVertNoText;
    procedure ArrangeVertTextBand;
    procedure ArrangeVertTextAbove;
    procedure ArrangeVertTextLeft;

    procedure AdjustBandHeight;
    procedure DeleteRest(LabelList: TList; Spot: Integer);
    {$ifdef WIN32}
    procedure SelectComponents;
    {$endif}
  protected
  public
    { Public declarations }
    Page: TSctGroupPage;
    SList: TListBox;
    Style: TSctDropStyle;
    WrapLine: Boolean;

{$ifdef WIN32}
{$ifdef VCL120PLUS}
    PageDesigner: IFormDesigner;
{$else}
    PageDesigner: TFormDesigner;
{$endif}
{$endif}

    procedure FillComboBoxes;
    procedure DropLabels(bd: TSctBand; x,y: Integer);
  end;


var
  AceDropLabels: TAceDropLabels;

implementation

{$R *.DFM}

uses sctutil, typinfo, AceFAsk
    {$ifdef WIN32}, Pageman{$endif}
    {$ifdef AceBDE}
       {$ifndef VCL130PLUS}, dbtables {$endif}
    {$endif}
;

{$ifdef AceBDE}

type
  TMyField = class(TObject)
  public
    Field: TField;
    DeleteField: Boolean;
    FieldName: String;
    FieldDef: TFieldDef;
    DataSet: TDataSet;
    constructor Create(MyFieldName: String; MyDataSet: TDataSet);
    destructor Destroy; override;
    procedure MakeField;
    function GetField: TField;
    function GetDataType: TSctDataTypes;
    procedure FormatFieldLabel(l: TSctLabel);
  end;

constructor TMyField.Create(MyFieldName: String; MyDataSet: TDataSet);
begin
  Field := nil;
  FieldDef := nil;
  DeleteField := False;
  FieldName := MyFieldName;
  DataSet := MyDataSet;
  MakeField;
end;
destructor TMyField.Destroy;
begin
  if DeleteField then
  begin
    if Field <> nil then Field.Free;
  end;
  inherited Destroy;
end;
procedure TMyField.MakeField;
  function GetFD: TFieldDef;
  begin
    try
      Result := DataSet.FieldDefs.Find(FieldName);
    except
      Result := nil;
    end;
  end;
begin
  if DataSet <> nil then
  begin
    DataSet.FieldDefs.Update;
    FieldDef := GetFD;
    if FieldDef <> nil then
    begin
      Field := GetField;
      if Field = nil then
      begin
        Field := FieldDef.CreateField(DataSet);
        DeleteField := True;
      end;
    end;
  end;
end;
function TMyField.GetField: TField;
var
  Spot: Integer;
begin
  Result := nil;
  if (FieldName <> '') And (DataSet <> nil) then
  begin
    Spot := 0;
    while Spot < DataSet.FieldCount do
    begin
      if DataSet.Fields[Spot].FieldName = FieldName then
      begin
        Result := DataSet.Fields[Spot];
        Spot := DataSet.FieldCount;
      end;
      Inc(Spot);
    end;
  end;
end;

function TMyField.GetDataType: TSctDataTypes;
var
  dt: TFieldType;
begin
  Result := dtypeUnknown;
  if FieldDef <> nil then
  begin
    dt := FieldDef.DataType;
    case dt of
      ftString: result := dtypeString;
      ftInteger, ftSmallInt, ftWord: result := dtypeInteger;
      ftFloat,ftCurrency,ftBCD: result := dtypeFloat;
      ftDateTime, ftDate, ftTime: result := dtypeDateTime;
      ftBoolean: result := dtypeBoolean;
      ftBlob: result := dtypeBlob;
      ftMemo: result := dtypeMemo;
      ftGraphic: result := dtypeGraphic;
      {$ifdef WIN32}
      ftFmtMemo, ftParadoxOle, ftDBaseOle, ftTypedBinary: result := dtypeBlob;
      ftAutoInc: result := dtypeInteger;
      {$endif}
    end;
  end;
end;

procedure TMyField.FormatFieldLabel(l: TSctLabel);
var
  vl: TSctVarLabel;
  f: TField;
  ftype: TFieldType;
begin
  F := Field;
  if F <> nil then
  begin
    if l is TSctVarLabel then
    begin
      vl := TSctVarLabel(l);
      if f is TStringField then
      begin
        vl.DataFormat.DisplayFormat :=  TStringField(f).EditMask;
      end else if (f is TIntegerField) or (f is TSmallIntField) or (f is TWordField) then
      begin
        vl.DataFormat.DisplayFormat :=  TIntegerField(f).DisplayFormat;
      end else if (f is TFloatField) then
      begin
        vl.DataFormat.DisplayFormat :=  TFloatField(f).DisplayFormat;
        vl.DataFormat.Width := TFloatField(f).Precision;
        if TFloatField(f).Currency then
        begin
          vl.DataFormat.FloatFormat := ffCurrency;
          vl.DataFormat.UseCurrencyDecimals := True;
        end else
        begin
          vl.DataFormat.FloatFormat := ffNUmber;
          vl.DataFormat.Digits := 2;
        end;
      end else if (f is TCurrencyField) then
      begin
        vl.DataFormat.DisplayFormat :=  TCurrencyField(f).DisplayFormat;
        vl.DataFormat.Width := TCurrencyField(f).Precision;
        vl.DataFormat.FloatFormat := ffCurrency;
        vl.DataFormat.UseCurrencyDecimals := True;
      end else if (f is TBooleanField) then
      begin
      end else if (f is TDateTimeField) or (f is TDateField) or (f is TTimeField) then
      begin
        vl.DataFormat.DisplayFormat :=  TDateTimeField(f).DisplayFormat;
      end else if (f is TMemoField) then
      begin
        vl.WrapText := True;
        vl.Stretch := True;
      end else if (f is TGraphicField) then
      begin
      end;

      case f.Alignment of
      taLeftJustify: l.AlignHorizontal := laLeft;
      taCenter: l.AlignHorizontal := laCenter;
      taRightJustify: l.AlignHorizontal := laRight;
      end;
    end;
  end else
  begin
    if (FieldDef <> nil) And (l is TSctVarLabel) then
    begin
      vl := TSctVarLabel(l);
      ftype := FieldDef.DataType;
      case ftype of
        ftInteger, ftSmallInt, ftWord:
        begin
          l.AlignHorizontal := laRight;
        end;
        ftFloat,ftCurrency,ftBCD:
        begin
          l.AlignHorizontal := laRight;
          if ftype = ftCurrency then
          begin
            vl.DataFormat.FloatFormat := ffCurrency;
            vl.DataFormat.UseCurrencyDecimals := True;
          end else
          begin
            vl.DataFormat.FloatFormat := ffNUmber;
            vl.DataFormat.Digits := 2;
          end;
        end;
        ftDateTime: vl.DataFormat.DisplayFormat := 'ddddtttt';
        ftDate: vl.DataFormat.DisplayFormat := 'dddd';
        ftTime: vl.DataFormat.DisplayFormat := 'tttt';
        ftMemo:
        begin
          vl.WrapText := True;
          vl.Stretch := True;
        end;
      end;
    end;
  end;
end;

{$endif}





procedure TAceDropLabels.FormCreate(Sender: TObject);
begin
  Page := nil;
  { Just making this public }
  SList := AceVariableList;
  SelectedList := TStringList.Create;
  ClientWidth := UndoPanel.Left + UndoPanel.Width + 3;

  Top := 0;
  Left := (Screen.Width - Width) div 2;
  TextLabelList := TList.Create;
  VarLabelList := TList.Create;
  TextDivList := TList.create;
  VarDivList := TList.Create;
end;

procedure TAceDropLabels.FillComboBoxes;
var
  Spot: Integer;
{$ifdef AceBDE}
  DSG: TSctDataSourceGuide;
  Pos: Integer;
{$endif}
  ItemIndex: Integer;
begin
  ItemIndex := VariableSelection.ItemIndex;
  VariableSelection.Items.Clear;
  VariableSelection.Items.Add('All');
  VariableSelection.Items.Add('Expression');
  VariableSelection.Items.Add('Total');
  VariableSelection.Items.Add('System');
{$ifdef AceBDE}
  VariableSelection.Items.Add('Manual DB');
  if Page <> nil then
  begin
    if Page.DataSourceList <> nil then
    begin
      for Spot := 0 to Page.DataSourceList.Count - 1 do
      begin
        DSG := Page.DataSourceList.Items[Spot];
        Pos := Page.FullDSList.IndexOf(DSG.DataSource);
        if Pos <> -1 then
        begin
          VariableSelection.Items.Add(Page.FullDSNames[Pos]);
        end;
      end;
    end;
  end;
  {$endif}

  if (ItemIndex = -1) or (ItemIndex >= VariableSelection.Items.Count) then
    VariableSelection.ItemIndex := 0
  else VariableSelection.ItemIndex := ItemIndex;

  VariableSelectionChange(nil);

  ItemIndex := TextBand.ItemIndex;
  TextBand.Items.Clear;
  TextBand.Items.Add('No Text Label');
  if Page <> nil then
  begin
    if Page.Bands <> nil then
    begin
      for Spot := 0 to Page.Bands.Count - 1 do
      begin
        TextBand.Items.Add(TSctBand(Page.Bands.Items[Spot]).Name);
      end;
    end;
  end;
  if (ItemIndex = -1) or (ItemIndex >= TextBand.Items.Count) then
    TextBand.ItemIndex := 0
  else TextBand.ItemIndex := ItemIndex;

end;

procedure TAceDropLabels.VariableSelectionChange(Sender: TObject);
begin
  AceVariableList.Clear;
  case VariableSelection.ItemIndex of
    0: FillAll;
    1: FillExpr;
    2: FillTotal;
    3: FillSystem;
{$ifdef AceBDE}
    4: FillDB;
  else FillAutoDB;
{$endif}
  end;
  AceVariableList.Height := 13 + 13 * AceVariableList.Items.Count div AceVariableList.Columns;
end;

procedure TAceDropLabels.FillAll;
var
  Spot: Integer;
  MyVar: TSctVar;
begin
  if Page <> nil then
  begin
    if Page.VarList <> nil then
    begin
      for Spot := 0 to Page.VarList.Count - 1 do
      begin
        MyVar := TSctVar(Page.VarList.Items[Spot]);
        AceVariableList.Items.AddObject(MyVar.Name,MyVar);
      end;
    end;
  end;
end;

procedure TAceDropLabels.FillExpr;
var
  Spot: Integer;
  ExprVar: TSctVar;
begin
  if Page <> nil then
  begin
    if Page.VarList <> nil then
    begin
      for Spot := 0 to Page.VarList.Count - 1 do
      begin
        if TSctVar(Page.Varlist.Items[Spot]).id = vidExprVar then
        begin
          ExprVar := TSctVar(Page.VarList.Items[Spot]);
          AceVariableList.Items.AddObject(ExprVar.Name,ExprVar);
        end;
      end;
    end;
  end;
end;

procedure TAceDropLabels.FillTotal;
var
  Spot: Integer;
  TotalVar: TSctTotalVar;
begin
  if Page <> nil then
  begin
    if Page.TotalVars <> nil then
    begin
      for Spot := 0 to Page.TotalVars.Count - 1 do
      begin
        TotalVar := TSctTotalVar(Page.TotalVars.Items[Spot]);
        AceVariableList.Items.AddObject(TotalVar.Name,TotalVar);
      end;
    end;
  end;
end;


{$ifdef AceBDE}
procedure TAceDropLabels.FillDB;
var
  Spot: Integer;
  DBVar: TSctVar;
begin
  if Page <> nil then