⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 aceoview.pas

📁 suite component ace report
💻 PAS
📖 第 1 页 / 共 2 页
字号:
         LabelVar.AsString := 'Not assigned'
       else
         LabelVar.AsString := TSctCheckLabel(BandLabel).Variable.Name;
       LabelInfo.AsString := GetEnumName(TypeInfo(TSctCheckStyle)
          ,Ord(TSctCheckLabel(BandLabel).CheckStyle)){$ifndef WIN32}^{$endif};
       SctTextLabel24.Caption := 'Check:';
       SctTextLabel24.Font.Color := clMaroon;
     end;

   if BandLabel is TSctVarLabel then
     begin
       Labels.Stretch := True;

       if TSctVarLabel(BandLabel).Variable <> nil then
       begin
         LabelVar.AsString := TSctVarLabel(BandLabel).Variable.Name;
         SctTextLabel10.Caption := 'Variable:';
         SctTextLabel10.Font.Color := clBlue;
       end else
       begin
         LabelVar.AsString := '';
         SctTextLabel10.Caption := 'Variable:';
         SctTextLabel10.Font.Color := clBlue;
       end;

       if TSctVarLabel(BandLabel).Lines <> nil then
       begin
         if TSctVarLabel(BandLabel).Lines.Count > 0 then
         begin
           LinesVar.AsString := TSctVarLabel(BandLabel).Lines[0];
         end else LinesVar.AsString := '';
       end else LinesVar.AsString := '';


       Caption.AsString := TSctVarLabel(BandLabel).Caption;

     end;

   if BandLabel is TSctTextLabel then
     begin
       Labels.Stretch := False;
       Caption.AsString := TSctTextLabel(BandLabel).Caption;

       if TSctTextLabel(BandLabel).Lines <> nil then
       begin
         if TSctTextLabel(BandLabel).Lines.Count <> 0 then
         begin
           LinesVar.AsString := TSctTextLabel(BandLabel).Lines[0]
         end else LinesVar.AsString := '';
       end else LinesVar.AsString := '';
     end;

   if BandLabel is TSctTotalVarLabel then with TSctTotalVarLabel(BandLabel) do
     begin
       if TotalVariable <> nil then
         begin
            LabelVar.AsString := TotalVariable.Name;
         end else
         begin
            LabelVar.AsString := 'Undefined';
         end;
       LabelInfo.AsString := GetEnumName(TypeInfo(TSctTotalType),Ord(TotalType)){$ifndef WIN32}^{$endif};
       SctTextLabel24.Caption := 'TotalVar:';
       SctTextLabel24.Font.Color := clRed;
       if AutoLevel then LabelInfo2.AsString := 'AutoLevel'
         else LabelInfo2.AsString := Level.Name;
     end;

   if BandLabel is TSctVarLabel then filld(TSctVarLabel(BandLabel).DataFormat);
   if BandLabel is TSctTotalVarLabel then filld(TSctFormat(TSctTotalVarLabel(BandLabel).DataFormat));

   if  (BandLabel is TSctVarLabel)
      or (BandLabel is TSctTextLabel)
      or (BandLabel is TSctTotalVarLabel) then with TSctTextLabel(BandLabel) do
     begin
       LabelFont.AsString := TSctTextLabel(BandLabel).Font.Name;
       LabelBorder.AsString := GetEnumName(TypeInfo(TSctBorderType),
       Ord(TSctTextLabel(BandLabel).BorderType)){$ifndef WIN32}^{$endif};
     end;


end;


procedure TAceOverview.SetupPrintWhen(Band: TSctBand; var Result: Boolean);
begin
  Result := svarPage.AsInteger = 1;
end;

procedure TAceOverview.varlabel11LabelPrintWhen(lb: TSctLabel;
  var Result: Boolean);
begin
  Result := Band is TSctSubDataBand;
end;

procedure TAceOverview.GetPageSetupVars(PS:TSctPageSetup);
begin
  MarginLeft.AsFloat := PS.LeftMargin;
  MarginRight.AsFloat := PS.RightMargin;
  MarginTop.AsFloat := PS.TopMargin;
  MarginBottom.AsFloat := PS.BottomMargin;
  PaperSource.AsString := GetEnumName(TypeInfo(TSctPaperSource),Ord(PS.Source)){$ifndef WIN32}^{$endif};
  PaperSize.AsString := GetEnumName(TypeInfo(TSctPaperSize),Ord(PS.Size)){$ifndef WIN32}^{$endif};
  PrintDest.AsString := GetEnumName(TypeInfo(TSctDestination),Ord(PS.Destination)){$ifndef WIN32}^{$endif};
  PrintDuplex.AsString := GetEnumName(TypeInfo(TSctPaperDuplex),Ord(PS.Duplex)){$ifndef WIN32}^{$endif};
  PrintCopies.AsInteger := PS.Copies;
  PaperHeight.AsFloat := PS.Height;
  PaperWidth.AsFloat := PS.Width;
  PrintQuality.AsString := GetEnumName(TypeInfo(TSctPrintQuality),Ord(PS.PrintQuality)){$ifndef WIN32}^{$endif};
  PrintTextComp.AsBoolean := PS.TextDriverCompatibility;
  PrintUnits.AsString := GetEnumName(TypeInfo(TSctUnits),Ord(PS.Units)){$ifndef WIN32}^{$endif};
  PrintTTOption.AsString := GetEnumName(TypeInfo(TSctTrueTypeOption),Ord(PS.TrueTypeOption)){$ifndef WIN32}^{$endif} {};
  PrintAdjMargins.AsBoolean := PS.AdjustMargin;
  PrintCollated.AsBoolean := PS.CollatedCopies;
  PrintColor.AsBoolean := PS.Color;
  PrintDirect.AsBoolean := PS.DirectPrinter;
  PrintOrientation.AsString := GetEnumName(TypeInfo(TSctPaperOrientation),Ord(PS.Orientation)){$ifndef WIN32}^{$endif};
  PrintFormName.AsString := PS.FormName;
  PrintRangeStart.AsInteger := PS.RangeStart;
  PrintRangeEnd.AsInteger := PS.RangeEnd;
  PreviewFormStyle.AsString := GetEnumName(TypeInfo(TSctFormStyle),Ord(PS.PreviewSettings.FormStyle)){$ifndef WIN32}^{$endif};
  PreviewModal.AsString :=
         GetEnumName(TypeInfo(TSctModalPreview),Ord(PS.PreviewSettings.ModalPreview)){$ifndef WIN32}^{$endif};
  PreviewOwner.AsString :=
         GetEnumName(TypeInfo(TSctPreviewOwner),Ord(PS.PreviewSettings.PreviewOwner)){$ifndef WIN32}^{$endif};
  PreviewState.AsString := GetEnumName(TypeInfo(TWindowState),Ord(PS.PreviewSettings.WindowState)){$ifndef WIN32}^{$endif};
  PreviewZoom.AsString := GetEnumName(TypeInfo(TAceZoom),Ord(PS.PreviewSettings.Zoom)){$ifndef WIN32}^{$endif};
end;

procedure TAceOverview.LabelsAfterPrint(Band: TSctBand);
begin
  if Band.Color = clWhite then Band.Color := clSilver
  else Band.Color := clWhite;
end;

procedure TAceOverview.DetailBandAfterPrint(Band: TSctBand);
begin
  Labels.Color := clWhite;
end;



procedure TAceOverview.DrawBand(AceCanvas: TAceCanvas; Rect: TRect);
var
  SaveColor: TColor;
  bd: TSctBand;
  r1: TRect;
  BandsLevel: Integer;
  BandPos: Integer;
  MyText: String;

  function GetGroupHeadFoot(bd: TSctBand): TSctGroup;
  var
    GroupSpot: Integer;
    Group: TSctGroup;
  begin
    Result := nil;
    if GP.Groups <> nil then
    begin
      for GroupSpot := 0 to GP.Groups.Count -1 do
      begin
        Group := GP.Groups.Items[GroupSpot];
        if (bd = Group.Header) or (bd = Group.Footer) then Result := Group;
      end;
    end;
  end;

  function GetBandLevel(bd: TSctBand): Integer;
  var
    Done: Boolean;
    Curr: TSctBand;
    Group: TSctGroup;
  begin
    Result := 0;
    Done := False;
    Curr := bd;
    while Not Done do
    begin
      if Curr is TSctSubBand then
      begin
        Curr := TSctSubBand(Curr).Band;
        Inc(Result);
      end else if Curr is TSctSubDataBand then
      begin
        Curr := TSctSubDataBand(Curr).Band;
        Inc(Result);
      end else if (Curr is TSctDataHeadBand) or (Curr is TSctDataFootBand) then
      begin
        Curr := TSctDataHeadBand(Curr).Band;
        Inc(Result);
      end else if (Curr is TSctOverlayBand) then
      begin
        Done := True;
      end else if (Curr = GP.Detail) then
      begin
        Inc(Result);
        Done := True;
        if GP.Groups <> nil then
        begin
          Result := Result + GP.Groups.Count;
        end;
      end else
      begin
        Group := GetGroupHeadFoot(Curr);
        if Group <> nil then
        begin
          Result := Result + Group.Level + 1;
        end;
        Done := True;
      end;
    end;
  end;
  function IsFirst(bd: TSctBand): Boolean;
  var
    atband: TSctBand;
    Spot: Integer;
  begin
    Result := False;
    Spot := 0;
    while Spot < GP.Bands.Count do
    begin
      atBand := TSctBand(GP.Bands.Items[Spot]);
      if (atBand <> nil) And (bd <> nil) then
      begin
        if (atBand.Band = bd.Band) or (atBand = bd.Band) then
        begin
          if atBand = bd then Result := True;
          Spot := GP.Bands.Count;
        end;
      end;
      Inc(Spot);
    end;
  end;
  function IsLast(bd: TSctBand): Boolean;
  var
    atband: TSctBand;
    Spot: Integer;
  begin
    Result := False;
    Spot := GP.Bands.Count;
    while Spot > 0 do
    begin
      Dec(Spot);
      atBand := TSctBand(GP.Bands.Items[Spot]);
      if (atBand <> nil) And (bd <> nil) then
      begin
        if ((atBand.Band = bd.Band) or (atBand = bd.Band)) And (atBand.Band <> nil) then
        begin
          if (atBand = bd) then Result := True;
          Spot := 0;
        end;
      end;
    end;
  end;

  procedure DrawLine(r: TRect);
  var
    half, mid, l, rt, t, b: Integer;
    GoLine, first, last: Boolean;
    MyLevel: Integer;
    Curr: TSctBand;
    Group: TSctGroup;
  begin
    if bd <> nil then
    begin
      half := (r.Bottom - r.Top) div 2;
      mid := r.bottom-half;
      l := r.Left-5;
      rt := r.Left-1;
      t := r.Top-1;
      b := r.Bottom+1;
      with AceCanvas do
      begin
        if (bd.Band <> nil) or (GP.Detail = bd)
          or (GetGroupHeadFoot(bd) <> nil) then
        begin
          First := IsFirst(bd) or (GP.Detail = bd);
          Last := IsLast(bd) or (GP.Detail = bd);

          Group := GetGroupHeadFoot(bd);
          if Group <> nil then
          begin
            if bd = Group.Footer then Last := True
            else First := True;
          end;
          MoveTo(l,mid);
          LineTo(rt,mid);

          if bd is TSctSubBand then
          begin
            if Last And TSctSubBand(bd).Above then Last := False;
          end;
          if Not (First And Last) then
          begin
            if First or Not Last then
            begin
              MoveTo(l,mid);
              LineTo(l,b);
            end;
            if Last or Not First then
            begin
              MoveTo(l,mid);
              LineTo(l,t);
            end;
          end;
          MyLevel := BandsLevel;
          Curr := bd.Band;
          if (Curr = nil) then
          begin
            if (bd = GP.Detail) then Curr := bd
            else if (GetGroupHeadFoot(bd) <> nil) then Curr := bd;
          end;
          BandPos := GP.Bands.IndexOf(bd);
          while MyLevel >= 2 do
          begin
            if (Curr <> nil) then
            begin
              if (BandPos < GP.Bands.IndexOf(Curr)) then
              begin
                GoLine := Not IsLast(Curr);
                if (Curr.Band <> nil) then
                begin
                  GoLine := GP.Bands.IndexOf(Curr.Band) <
                            GP.Bands.IndexOf(Curr);
                end;
                if GoLine then
                begin
                  Group := GetGroupHeadFoot(Curr);
                  if Group <> nil then
                  begin
                    if Group.Footer <> Curr then
                      if (GetBandLevel(Curr)+1) = MyLevel then GoLine := False;
                  end;
                end;
              end else
              begin
                GoLine := Not IsLast(Curr);
                if Not GoLine And (Curr.Band <> nil) then
                begin
                  GoLine := GP.Bands.IndexOf(Curr.Band) >
                             GP.Bands.IndexOf(Curr);
                end;
                if GoLine then
                begin
                  Group := GetGroupHeadFoot(Curr);
                  if Group <> nil then
                  begin
                    if Group.Header <> Curr then
                      if (GetBandLevel(Curr)+1) = MyLevel then GoLine := False;
                  end;
                end;  
              end;

              if GoLine And Not ((GP.Detail = Curr)
                   And (bd <> GP.Detail)) then
              begin
                MoveTo(Rect.Left + (10*MyLevel)-15, t);
                LineTo(Rect.Left + (10*MyLevel)-15, b);
              end;
              if Curr.Band <> nil then Curr := Curr.Band
              else if (Curr = GP.Detail) then
              begin
                if GP.Groups <> nil then
                begin
                   if GP.Groups.Count > 0 then
                   begin
                     Curr := TSctGroup(GP.Groups.Items[
                                 GP.Groups.Count -1]).Footer;
                   end;
                end else Curr := nil;
              end else if GetGroupHeadFoot(Curr) <> nil then
              begin
                Group := GetGroupHeadFoot(Curr);
                if Group.Level > 0 then
                begin
                  if Curr = Group.Header then
                    Curr := TSctGroup(GP.Groups.Items[Group.Level - 1]).Header
                  else
                    Curr := TSctGroup(GP.Groups.Items[Group.Level - 1]).Footer;
                end else Curr := nil;
              end else Curr := nil;
            end;
            Dec(MyLevel);
          end;
        end;
      end;
    end;
  end;
begin
  r1 := Rect;
  with AceCanvas do
  begin
    bd := TSctBand(GP.Bands.Items[Spot]);
    if GetGroupHeadFoot(bd) <> nil then SaveColor := clGreen
    else if bd.ClassType = TSctBand then SaveColor := clBlue
    else if bd is TSctSubDataBand then SaveColor := clMaroon
    else if bd is TSctDataHeadBand then SaveColor := clGreen
    else SaveColor := clBlack;

    Font.Color := SaveColor;
    Font.Size := 12;
    Font.Style := [fsBold,fsItalic];

    BandsLevel := GetBandLevel(bd);
    r1.Left := r1.Left + (10 * BandsLevel);
    FillRect(Rect);


    Pen.Width := 1;
    Pen.Color := clBlack;

    DrawLine(r1);

    MyText := bd.BandName;
    SetTextAlign(TA_LEFT+TA_TOP);
    TextRect(r1, r1.Left+2, r1.Top+1, MyText);

  end;  

end;


procedure TAceOverview.BandListDataStart(Sender: TObject);
begin
  TSctSubDataBand(Sender).DataIsFinished := False;
  Spot := 0;
end;

procedure TAceOverview.BandListDataSkip(Sender: TObject);
begin
  Inc(Spot);
  if Spot >= GP.Bands.Count then TSctSubDataBand(Sender).DataIsFinished := True;
end;

procedure TAceOverview.SctCustomLabel1Draw(lb: TSctLabel;
  AceCanvas: TObject; Rect: TRect);
begin
  DrawBand(TAceCanvas(AceCanvas), Rect);
end;

procedure TAceOverview.Sctvarlabel26BeforePrint(lb: TSctLabel);
begin
  TSctVarLabel(lb).Caption := IntToStr(Spot); 
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -