acedrop.pas

suite component ace report

  begin
    if Page.VarList <> nil then
    begin
      for Spot := 0 to Page.VarList.Count - 1 do
      begin

        if Not (TSctvar(Page.varlist.Items[Spot]).Id = vidAutoDataVar) And
           Not TSctvar(Page.varlist.items[Spot]).AutoVar And
               (TSctvar(Page.varlist.items[Spot]) is TSctdbVar) Then
        begin
          DBVar := TSctVar(Page.VarList.Items[Spot]);
          AceVariableList.Items.AddObject(DBVar.Name,DBVar);
        end;
      end;
    end;
  end;
end;
{$endif}

procedure TAceDropLabels.FillSystem;
var
  Spot: Integer;
  SystemVar: 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 = vidDateTimeVar) or
           (TSctVar(Page.Varlist.Items[Spot]).id = vidPageVar) then
        begin
          SystemVar := TSctVar(Page.VarList.Items[Spot]);
          AceVariableList.Items.AddObject(SystemVar.Name,SystemVar);
        end;
      end;
    end;
  end;
end;

{$ifdef AceBDE}
procedure TAceDropLabels.FillAutoDB;
var
  DSName: String;
  Spot: Integer;
  DS: TDataSource;
  DBVar: TSctDBVar;
begin
  if Page <> nil then
  begin
    if Page.VarList <> nil then
    begin
      if VariableSelection.ItemIndex <> -1 then
      begin
        DSName :=  VariableSelection.Items[VariableSelection.ItemIndex];
        Spot := Page.FullDSNames.IndexOf(DSName);
        if Spot <> -1 then
        begin
          DS := Page.FullDSList[Spot];

          for Spot := 0 to Page.VarList.Count - 1 do
          begin
            if TSctvar(Page.varlist.Items[Spot]).Id = vidAutoDataVar then
            begin
              DBVar := TSctDBVar(Page.VarList.Items[Spot]);
              if DBVar.DataSource = DS then
              begin
                AceVariableList.Items.AddObject(DBVar.DataField, DBVar);
              end;
            end;
          end;
        end;
      end;
    end;
  end;
end;
{$endif}

function TAceDropLabels.GetTextBand: TSctBand;
var
  Spot: Integer;
begin
  Result := nil;
  if TextBand.ItemIndex > 0 then
  begin
    if Page <> nil then
    begin
      if Page.Bands <> nil then
      begin
        Spot := 0;
        while (Result = nil) and (Spot < Page.Bands.Count) do
        begin
          if TSctBand(Page.Bands.Items[Spot]).Name = TextBand.Items[TextBand.ItemIndex] then
          begin
            Result := Page.Bands.Items[Spot];
          end;
          Inc(Spot);
        end;
      end;
    end;
  end;
end;

function TAceDropLabels.CreateVarLabel(V: TSctVar; bd: TSctBand): TSctLabel;
var
{$ifdef AceBDE}
  MyField: TMyField;
  TotalDB: Boolean;
{$endif}
  dtype: TSctDataTypes;
begin
{$ifdef AceBDE}
  TotalDB := False;
  if v is TSctTotalVar then
    if TSctTotalVar(v).Variable is TSctDBVar then TotalDB := True;

  if TotalDB or (v is TSctDbVar)then
  begin
    if TotalDB then
      MyField := TMyField.Create(TSctDBVar(TSctTotalVar(V).Variable).DataField,
             TSctDbVar(TSctTotalVar(V).Variable).DataSource.DataSet)
    else
      MyField := TMyField.Create(TSctDbVar(V).DataField, TSctDbVar(V).DataSource.DataSet);

    dtype := MyField.GetDataType;
    Result := CreateLabel(V, dtype);
    SctAutoSetComponentName(Result, Result.ClassName, True);
    Result.Parent := bd;

    MyField.FormatFieldLabel(Result);
    FormatLabelHW(Result, V, MyField);
    if MyField <> nil then MyField.Free;
  end else
  begin
{$endif}
    dtype := v.DataType;
    Result := CreateLabel(V, dtype);
    SctAutoSetComponentName(Result, Result.ClassName, True);
    Result.Parent := bd;

    FormatVarLabel(Result, V, dtype);
    FormatLabelHW(Result, v, nil);
{$ifdef AceBDE}
  end;
{$endif}
end;



procedure TAceDropLabels.CreateLabels;
var
  MyVar: TSctVar;
  Lab: TSctLabel;
  Spot: Integer;
begin
  VarLabelList.Clear;
  TextLabelList.Clear;
  VarDivList.Clear;
  TextDivList.Clear;


  for Spot := 0 to SelectedList.Count - 1 do
  begin
    MyVar := TSctVar(AceVariableList.Items.Objects[StrToInt(SelectedList[Spot])]);
    if TextLabelBand <> nil then
    begin
      Lab := TSctVarLabel.Create(Page.Owner);
      SctAutoSetComponentName(Lab, Lab.ClassName, True);
      Lab.Parent := TextLabelBand;
      FormatTextLabel(Lab as TSctVarLabel, MyVar);
      TextLabelList.Add(Lab);
    end;

    Lab := CreateVarLabel(MyVar, VarLabelBand);
    VarLabelList.Add(Lab);
  end;

end;

procedure TAceDropLabels.CreateDividers;
var
  Spot: Integer;
  Divider: TSctVerticalDivider;
  L: TSctLabel;
begin
  if DropHorz And Dividers then
  begin
    { Do not put one to the left of the first one }
    for Spot := 1 to VarLabelList.Count - 1 do
    begin
      L := VarLabelList.Items[Spot];

      Divider := TSctVerticalDivider.Create(Page.Owner);
      Divider.Parent := VarLabelBand;
      SctAutoSetComponentName(Divider, Divider.ClassName, True);
      VarDivList.Add(Divider);

      Divider.Left := L.Left - 4;

      if TextLabelBand <> nil then
      begin
        if TextLabelBand <> VarLabelBand then
        begin
          Divider := TSctVerticalDivider.Create(Page.Owner);
          Divider.Parent := TextLabelBand;
          SctAutoSetComponentName(Divider, Divider.ClassName, True);
          TextDivList.Add(Divider);
        end else
        begin
          L := TextLabelList.Items[Spot];
        end;
        Divider.Left := L.Left - 4;
      end;

    end;
  end;

end;

procedure TAceDropLabels.DropLabels(bd: TSctBand; x,y: Integer);
var
  Wrapped: Boolean;
begin
  if AceVariableList.SelCount > 0 then
  begin
    {$ifdef WIN32}
    PageDesigner := TSctPageManager(Page.PageManager).PageDesigner;
    {$endif}
    VarLabelBand := bd;
    TextLabelBand := GetTextBand;
    DropHorz := sbHoriz.Down or sbHorizDiv.Down;
    TextAbove := sbTop.Down;
    Dividers := sbHorizDiv.Down;
    xDrop := x;
    yDrop := y;

    CreateLabels;
    Wrapped := ArrangeLabels;
    if Not Wrapped then CreateDividers;
    {$ifdef WIN32}
    SelectComponents;
    {$endif}
  end;
end;

{$ifdef WIN32}

{$ifdef VER110}
  {$define ACE_NO_INTF}
{$endif}
{$ifdef VER100}
  {$define ACE_NO_INTF}
{$endif}
{$ifdef VER90}
  {$define ACE_NO_INTF}
{$endif}
{$ifdef VER93}
  {$define ACE_NO_INTF}
{$endif}
{$ifndef ACE_NO_INTF}
  {$define ACE_INTF}
{$endif}

{$ifdef ACE_INTF}
procedure TAceDropLabels.SelectComponents;
var
  ds: IDesignerSelections;
  Spot: Integer;
begin
  ds := CreateSelectionList;
  for Spot := 0 to VarLabelList.Count - 1 do
  begin
    ds.Add(MakeIPersistent(VarLabelList.Items[Spot]));
  end;
  for Spot := 0 to VarDivList.Count - 1 do
  begin
    ds.Add(MakeIPersistent(VarDivList.Items[Spot]));
  end;
  if TextLabelBand = VarLabelBand then
  begin
    for Spot := 0 to TextLabelList.Count - 1 do
    begin
      ds.Add(MakeIPersistent(TextLabelList.Items[Spot]));
    end;
    for Spot := 0 to TextDivList.Count - 1 do
    begin
      ds.Add(MakeIPersistent(TextDivList.Items[Spot]));
    end;
  end;
  PageDesigner.SetSelections(ds);
end;
{$endif}

{$ifdef ACE_NO_INTF}
procedure TAceDropLabels.SelectComponents;
var
  ds: TComponentList;
  Spot: Integer;
begin
  ds := TComponentList.Create;
  for Spot := 0 to VarLabelList.Count - 1 do  ds.Add(VarLabelList.Items[Spot]);
  for Spot := 0 to VarDivList.Count - 1 do  ds.Add(VarDivList.Items[Spot]);
  if TextLabelBand = VarLabelBand then
  begin
    for Spot := 0 to TextLabelList.Count - 1 do ds.Add(TextLabelList.Items[Spot]);
    for Spot := 0 to TextDivList.Count - 1 do ds.Add(TextDivList.Items[Spot]);
  end;
  PageDesigner.SetSelections(ds);
  ds.Free;
end;
{$endif}

{$undef ACE_NO_INTF}
{$undef ACE_INTF}

{$endif}


procedure TAceDropLabels.ShrinkLabels;
var
  P: TPoint;
  SWidth, TrimAmt, Trim, TotalWidth, Spot: Integer;
  TrimPercent: Single;
  L,T: TSctLabel;
begin
  TotalWidth := 0;
  { See how much needs to be trimmed and total width}
  for Spot := 0 to VarLabelList.Count - 1 do
  begin
    L := TSctLabel(VarLabelList[Spot]);
    if Not (L is TSctCheckLabel) then
      TotalWidth := TotalWidth + L.Width;
  end;
  L := TSctLabel(VarLabelList[VarLabelList.Count - 1]);
  Trim := (L.Left + L.Width) - Page.PageWidth;
  TrimPercent := 1 - (Trim/TotalWidth);

  if (TrimPercent < 0.25) then TrimPercent := 0;
  if (TrimPercent > 1.0) then TrimPercent := 1.0;

  P.x := xDrop;
  TrimAmt := 0;
  for Spot := 0 to VarLabelList.Count - 1 do
  begin
    L := VarLabelList.Items[Spot];

    if TextLabelBand = nil then
    begin
      L.Left := P.x;
      SWidth := L.Width;
      TrimAmt := TrimAmt + (L.Width - Trunc(L.Width * TrimPercent));
      L.Width := L.Width - TrimAmt;
      { Set a minimum width of 1/2 inch }
      if L.Width < (PixelsPerInch div 2) then L.Width := (PixelsPerInch div 2);
      P.x := P.x + 10 + L.Width;
      TrimAmt := TrimAmt - (SWidth - L.Width);
    end else
    begin
      T := TextLabelList.Items[Spot];

      if (TextLabelBand = VarLabelBand) And (Not TextAbove) then
      begin
        T.Left := P.x;
        P.x := P.x + T.Width + 2;
      end else
      begin
        T.Left := P.x;
      end;
      L.Left := P.x;
      SWidth := L.Width;
      TrimAmt := TrimAmt + (L.Width - Trunc(L.Width * TrimPercent));
      L.Width := L.Width - TrimAmt;
      { Set a minimum width of 1/2 inch }
      if L.Width < (PixelsPerInch div 2) then L.Width := (PixelsPerInch div 2);
      P.x := P.x + 10 + L.Width;
      TrimAmt := TrimAmt - (SWidth - L.Width);
    end;
  end;
end;

{ This function returns True if labels were wrapped }
function TAceDropLabels.CheckWidth: Boolean;
var
  Ask: TAceFastAskForm;
  L: TSctLabel;
  Spot: Integer;
begin
  Result := False;
  { Don't do anything for a single label }
  if VarLabelList.Count > 1 then
  begin
    { Check the position of the right most label }
    L := TSctLabel(VarLabelList[VarLabelList.Count - 1]);
    if (L.Left + L.Width) > Page.PageWidth then
    begin
      Ask := TAceFastAskForm.Create(Application);
      Ask.ShowModal;
      if Ask.Canceled then
      begin
        DeleteRest(VarLabelList, 0);
        DeleteRest(TextLabelList, 0);
      end else if Ask.Wrap.Checked then
      begin
        Result := True;
        if TextLabelBand = nil then ArrangeHorzNoText(True)
        else if TextLabelBand <> VarLabelBand then ArrangeHorzTextBand(True)
        else if (TextLabelBand = VarLabelBand) And TextAbove then ArrangeHorzTextAbove(True)
        else if (TextLabelBand = VarLabelBand) And Not TextAbove then ArrangeHorzTextLeft(True);
      end else if Ask.Shrink.Checked then
      begin
        ShrinkLabels;
      end else if Ask.Delete.Checked then
      begin
        Spot := VarLabelList.Count - 1;
        while Spot >= 0 do
        begin
          L := TSctLabel(VarLabelList[Spot]);
          if (L.Left + L.Width) <= Page.PageWidth then break;
          Dec(Spot);
        end;
        Inc(Spot);
        DeleteRest(VarLabelList, Spot);
        DeleteRest(TextLabelList, Spot);
      end else { ignore.checked }
      begin
        { do nothing }
      end;
      Ask.Free;
    end;
  end;

end;

procedure TAceDropLabels.ArrangeHorzNoText(Wrap: Boolean);
var
  P: TPoint;
  Spot, MaxHeight: Integer;
  L: TSctLabel;
begin
  P.x := xDrop;
  P.y := yDrop;

  Spot := 0;
  MaxHeight := 0;
  while (Spot < VarLabelList.Count) do
  begin
    L := TSctLabel(VarLabelList[Spot]);
    if Wrap And (P.x > xDrop) then
    begin
      if (P.x + L.Width) > Page.PageWidth then
      begin
        P.x := xDrop;
        P.y := MaxHeight + 5;
      end;
    end;
    if (P.y+L.Height) > MaxHeight then MaxHeight := P.y + L.Height;
    L.Left := P.x;
    L.Top := P.y;
    P.x := P.x + 10 + L.Width;
    Inc(Spot);
  end;
end;

procedure TAceDropLabels.ArrangeHorzTextBand(Wrap: Boolean);
var
  P: TPoint;
  Spot, MaxHeight: Integer;
  L, T: TSctLabel;
begin
  P.x := xDrop;
  P.y := yDrop;

  Spot := 0;
  MaxHeight := 0;
  while (Spot < VarLabelList.Count) do
  begin
    L := TSctLabel(VarLabelList[Spot]);
    T := TSctLabel(TextLabelList[Spot]);
    if Wrap And (P.x > xDrop) then
    begin
      if (P.x + L.Width) > Page.PageWidth then
      begin
        P.x := xDrop;
        P.y := MaxHeight + 5;
      end;
    end;
    if (P.y+L.Height) > MaxHeight then MaxHeight := P.y + L.Height;
    L.Left := P.x;
    L.Top := P.y;
    T.Left := P.x;
    T.Top := P.y;
    if T.Width > L.Width then P.x := P.x + 10 + T.Width