acedrop.pas

suite component ace report

    else P.x := P.x + 10 + L.Width;
    Inc(Spot);
  end;
end;

procedure TAceDropLabels.ArrangeHorzTextAbove(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
    T := TSctLabel(TextLabelList[Spot]);
    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+ T.Height + L.Height + 2) > MaxHeight then
      MaxHeight := P.y + T.Height + L.Height + 2;

    T.Left := P.x;
    T.Top := P.y;
    L.Left := P.x;
    L.Top := P.y + T.Height + 2;

    if T.Width > L.Width then P.x := P.x + 10 + T.Width
    else P.x := P.x + 10 + L.Width;
    Inc(Spot);
  end;
end;

procedure TAceDropLabels.ArrangeHorzTextLeft(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
    T := TSctLabel(TextLabelList[Spot]);
    L := TSctLabel(VarLabelList[Spot]);

    T.AlignHorizontal := laRight;
    L.AlignHorizontal := laLeft;

    if Wrap And (P.x > xDrop) then
    begin
      if (P.x + L.Width + T.Width + 2) > 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;

    T.Left := P.x;
    T.Top := P.y;
    L.Left := T.Left + T.Width + 2;
    L.Top := P.y;

    P.x := L.Left + L.Width + 10;
    Inc(Spot);
  end;
end;

procedure TAceDropLabels.ArrangeVertNoText;
var
  P: TPoint;
  Spot: Integer;
  L: TSctLabel;
begin
  P.x := xDrop;
  P.y := yDrop;

  Spot := 0;
  while (Spot < VarLabelList.Count) do
  begin
    L := TSctLabel(VarLabelList[Spot]);
    L.Left := P.x;
    L.Top := P.y;
    P.y := L.Top + L.Height + 5;
    Inc(Spot);
  end;
end;

procedure TAceDropLabels.ArrangeVertTextBand;
var
  P: TPoint;
  Spot: Integer;
  L, T: TSctLabel;
begin
  P.x := xDrop;
  P.y := yDrop;

  Spot := 0;
  while (Spot < VarLabelList.Count) do
  begin
    L := TSctLabel(VarLabelList[Spot]);
    T := TSctLabel(TextLabelList[Spot]);
    L.Left := P.x;
    L.Top := P.y;
    T.Left := P.x;
    T.Top := P.y;
    P.y := L.Top + L.Height + 5;
    Inc(Spot);
  end;
end;

procedure TAceDropLabels.ArrangeVertTextAbove;
var
  P: TPoint;
  Spot: Integer;
  L, T: TSctLabel;
begin
  P.x := xDrop;
  P.y := yDrop;

  Spot := 0;
  while (Spot < VarLabelList.Count) do
  begin
    L := TSctLabel(VarLabelList[Spot]);
    T := TSctLabel(TextLabelList[Spot]);
    T.Left := P.x;
    T.Top := P.y;
    L.Left := P.x;
    L.Top := T.Top + T.Height + 2;
    P.y := L.Top + L.Height + 5;
    Inc(Spot);
  end;
end;

procedure TAceDropLabels.ArrangeVertTextLeft;
var
  P: TPoint;
  Spot: Integer;
  L, T: TSctLabel;
begin
  P.x := xDrop;
  P.y := yDrop;

  Spot := 0;
  while (Spot < VarLabelList.Count) do
  begin
    L := TSctLabel(VarLabelList[Spot]);
    T := TSctLabel(TextLabelList[Spot]);
    T.AlignHorizontal := laRight;
    L.AlignHorizontal := laLeft;

    L.Left := P.x;
    L.Top := P.y;

    T.Left := P.x - 3 - T.Width;
    T.Top := P.y;

    P.y := L.Top + L.Height + 5;
    Inc(Spot);
  end;
end;

procedure TAceDropLabels.AdjustBandHeight;
var
  Spot: Integer;
  L: TSctLabel;
  H: Integer;
begin
  if TextLabelBand <> nil then
  begin
    H := TextLabelBand.Height;
    for Spot := 0 to TextLabelList.Count - 1 do
    begin
      L := TSctLabel(TextLabelList.Items[Spot]);
      if (L.Top + L.Height) > H then H := L.Top + L.Height;
    end;
    if H > TextLabelBand.Height then TextLabelBand.Height := H;
  end;

  H := VarLabelBand.Height;
  for Spot := 0 to VarLabelList.Count - 1 do
  begin
    L := TSctLabel(VarLabelList.Items[Spot]);
    if (L.Top + L.Height) > H then H := L.Top + L.Height;
  end;
  if H > VarLabelBand.Height then VarLabelBand.Height := H;
end;

procedure TAceDropLabels.DeleteRest(LabelList: TList; Spot: Integer);
var
  L: TSctLabel;
begin
  while Spot < LabelList.Count do
  begin
    L := LabelList.Items[Spot];
    if L <> nil then
    begin
      L.Parent := nil;
      L.Free;
      LabelList.Items[Spot] := nil;
    end;
    Inc(Spot);
  end;
  LabelList.Pack;
end;

function TAceDropLabels.ArrangeLabels: Boolean;
begin

  Result := False;
  if DropHorz then
  begin
    if TextLabelBand = nil then ArrangeHorzNoText(False)
    else if TextLabelBand <> VarLabelBand then ArrangeHorzTextBand(False)
    else if (TextLabelBand = VarLabelBand) And TextAbove then ArrangeHorzTextAbove(False)
    else if (TextLabelBand = VarLabelBand) And Not TextAbove then ArrangeHorzTextLeft(False);
  end else { Drop Vertical }
  begin
    if TextLabelBand = nil then ArrangeVertNoText
    else if TextLabelBand <> VarLabelBand then ArrangeVertTextBand
    else if (TextLabelBand = VarLabelBand) And TextAbove then ArrangeVertTextAbove
    else if (TextLabelBand = VarLabelBand) And Not TextAbove then ArrangeVertTextLeft;
  end;
  if DropHorz then Result := CheckWidth; { Result := Wrapped Text? }
  AdjustBandHeight;

end;

function TAceDropLabels.CreateLabel(MyVar:TSctVar; dtype: TSctDataTypes): TSctLabel;
begin
  if MyVar is TSctTotalVar then
  begin
    Result := TSctTotalVarLabel.Create(Page.Owner);
    TSctTotalVarLabel(Result).TotalVariable := TSctTotalVar(MyVar);
  end else
  begin
    if ((dtype = dtypeGraphic) or (dtype = dtypeBlob)) then
    begin
      Result := TSctImageLabel.Create(Page.Owner);
      TSctImageLabel(Result).Variable := MyVar;
    end else if dtype = dtypeBoolean then
    begin
      Result := TSctCheckLabel.Create(Page.Owner);
      TSctCheckLabel(Result).Variable := MyVar;
      Result.BorderType := btSingle;
    end else
    begin
      Result := TSctVarLabel.Create(Page.Owner);
      TSctVarLabel(Result).Variable := MyVar;
    end;
  end;
end;


procedure TAceDropLabels.FormatTextLabel(l: TSctVarLabel; v: TSctVar);
var
{$ifdef AceBDE}
  MyField: TMyField;
{$endif}
  Font: TFont;
begin
{$ifdef AceBDE}
  if v is TSctDbVar then
  begin
    MyField := TMyField.Create(TSctDbVar(V).DataField, TSctDbVar(V).DataSource.DataSet);
    if MyField.Field <> nil then
      l.Caption := MyField.Field.DisplayLabel;

    if l.Caption = '' then l.Caption := TSctDbVar(v).DataField;

    if MyField <> nil then MyField.Free;
  end;
{$endif}

  l.Font := TSctBand(l.Parent).Font;
  Font := TSctBand(l.Parent).Font;
  l.Height := Abs(Font.Height) + 6;

  if l.Caption = '' then l.Caption := V.Name;

  l.Width := l.Canvas.TextWidth(TSctVarLabel(l).Caption) + 15;

end;

procedure TAceDropLabels.FormatVarLabel(l: TSctLabel; v: TSctVar; dtype: TSctDataTypes);
begin
  if v is TSctTotalVar then
  begin
    TSctTotalVarLabel(l).DataFormat.FloatFormat := ffNumber;
    TSctTotalVarLabel(l).DataFormat.Digits := 2;
  end else
  begin
    case dtype of
      dtypeFloat:
        begin
          TSctVarLabel(l).DataFormat.FloatFormat := ffNumber;
          TSctVarLabel(l).DataFormat.Digits := 2;
          l.AlignHorizontal := laRight;
        end;
      dtypeInteger:
        begin
          TSctVarLabel(l).DataFormat.FloatFormat := ffNumber;
          l.AlignHorizontal := laRight;
        end;
      dtypeDateTime: TSctVarLabel(l).DataFormat.DisplayFormat := 'ddddd';
      dtypeMemo:
        begin
          TSctVarLabel(l).WrapText := True;
          TSctVarLabel(l).Stretch := True;
        end;
    end;
  end;
end;

procedure TAceDropLabels.FormatLabelHW(l: TSctLabel; v: TSctVar; f: TObject);
var
  font: TFont;
  Ave, w: Integer;
  Done: Boolean;
begin
  font := TSctBand(l.Parent).Font;
  l.Height := Abs(font.height) + 6;
  Ave := l.Canvas.TextWidth('X');
  Done := False;
  if (l is TSctVarLabel) then
  begin
    if TSctVarLabel(l).WrapText then
    begin
      l.Width := PixelsPerInch * 2;
{      l.Height := PixelsPerInch;}
      Done := True;
    end;
  end;
  if l is TSctImageLabel then
  begin
    l.Width := PixelsPerInch;
    l.Height := PixelsPerInch;
    Done := True;
  end;
  if l is TSctCheckLabel then
  begin
    l.Height := 12;
    l.Width := 12;
    Done := True;
  end;

{$ifdef AceBDE}
  if (f <> nil) And Not Done then
  begin
    if TMyField(f).Field <> nil then
    begin
      l.Width := Ave * TMyField(f).Field.DisplayWidth;
      Done := True;
    end;
  end;
{$endif}
  if (l is TSctVarLabel) And Not Done then
  begin
    case v.DataType of
    dtypeString, dtypeInteger, dtypeFloat, dtypeBoolean:
      begin
        w := Canvas.TextWidth(TSctVarLabel(l).DataNow);
        if w > l.Width then l.Width := w;
      end;
    end;
  end else if Not Done then l.Width := PixelsPerInch;

end;


procedure TAceDropLabels.Button1Click(Sender: TObject);
begin
  Close;
end;

procedure TAceDropLabels.Stayontop1Click(Sender: TObject);
begin
  if TMenuItem(Sender).Checked then FormStyle := fsNormal
  else FormStyle := fsStayOnTop;
  TMenuItem(Sender).Checked := Not TMenuItem(Sender).Checked;
end;

procedure TAceDropLabels.Hide1Click(Sender: TObject);
begin
  Close;
end;

procedure TAceDropLabels.AceVariableListClick(Sender: TObject);
var
  Spot: Integer;
  TextSpot: String;
begin
  if AceVariableList.SelCount = 0 then SelectedList.Clear
  else
  begin
    for Spot := 0 to AceVariableList.Items.Count - 1 do
    begin
      TextSpot := IntToStr(Spot);
      if AceVariableList.Selected[Spot] then
      begin
        if SelectedList.IndexOf(TextSpot) = -1 then SelectedList.Add(TextSpot);
      end else
      begin
        if SelectedList.IndexOf(TextSpot) <> -1 then
          SelectedList.Delete(SelectedList.IndexOf(TextSpot));
      end;
    end;
    Spot := 0;
    while Spot < SelectedList.Count do
    begin
      if StrToInt(SelectedList[Spot]) >= AceVariableList.Items.Count then
        SelectedList.Delete(Spot)
      else Inc(Spot);
    end;
  end;
end;

procedure TAceDropLabels.FormDestroy(Sender: TObject);
begin
  if SelectedList <> nil then SelectedList.Free;
  TextLabelList.Free;
  VarLabelList.Free;
  TextDivList.Free;
  VarDivList.Free;
end;



procedure TAceDropLabels.SpeedButton2Click(Sender: TObject);
begin
  if AceVariableList.Columns < 10 then
    AceVariableList.Columns := AceVariableList.Columns + 1;
end;

procedure TAceDropLabels.SpeedButton3Click(Sender: TObject);
begin
  if AceVariableList.Columns > 2 then
  begin
    AceVariableList.Columns := AceVariableList.Columns - 1 ;
    Hint := 'Decreasing the number of columns by one.';
    {//SpeedButton3.OnHint;}
  end;
end;

procedure TAceDropLabels.SpeedButton1Click(Sender: TObject);

  procedure DeleteLabelList(List: TList);
  var
    Spot: Integer;
    L: TSctLabel;
  begin
    for Spot := 0 to List.Count - 1 do
    begin
      L := List.Items[Spot];
      if Page.Labels.IndexOf(L) <> -1 then
      begin
        L.Parent := nil;
        L.Free;
        List.Items[Spot] := nil;
      end;
    end;
    List.Clear;
  end;

begin
  if Page.Labels <> nil then
  begin
    DeleteLabelList(VarLabelList);
    DeleteLabelList(TextLabelList);
    DeleteLabelList(VarDivList);
    DeleteLabelList(TextDivList);
  end;
end;

end.