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

📄 pageman.pas

📁 suite component ace report
💻 PAS
📖 第 1 页 / 共 4 页
字号:
      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 := BandList.ItemHeight div 2;
      mid := r.bottom-half;
      l := r.Left-5;
      rt := r.Left-1;
      t := r.Top-1;
      b := r.Bottom+1;
      with BandList.Canvas do
      begin
        if (bd.Band <> nil) or (TSctGroupPage(FPage).Detail = bd)
          or (GetGroupHeadFoot(bd) <> nil) then
        begin
          First := IsFirst(bd) or (TSctGroupPage(FPage).Detail = bd);
          Last := IsLast(bd) or (TSctGroupPage(FPage).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 = TSctGroupPage(FPage).Detail) then Curr := bd
            else if (GetGroupHeadFoot(bd) <> nil) then Curr := bd;
          end;
          BandPos := BandList.Items.IndexOfObject(bd);
          while MyLevel >= 0 do
          begin
            if (Curr <> nil) then
            begin
              if (BandPos < BandList.Items.IndexOfObject(Curr)) then
              begin
                GoLine := Not IsLast(Curr);
                if (Curr.Band <> nil) then
                begin
                  GoLine := BandList.Items.IndexOfObject(Curr.Band) <
                            BandList.Items.IndexOfObject(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 := BandList.Items.IndexOfObject(Curr.Band) >
                             BandList.Items.IndexOfObject(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 ((TSctGroupPage(FPage).Detail = Curr)
                   And (bd <> TSctGroupPage(FPage).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 = TSctGroupPage(FPage).Detail) then
              begin
                if TSctGroupPage(FPage).Groups <> nil then
                begin
                   if TSctGroupPage(FPage).Groups.Count > 0 then
                   begin
                     Curr := TSctGroup(TSctGroupPage(FPage).Groups.Items[
                                 TSctGroupPage(FPage).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(TSctGroupPage(FPage).Groups.Items[Group.Level - 1]).Header
                  else
                    Curr := TSctGroup(TSctGroupPage(FPage).Groups.Items[Group.Level - 1]).Footer;
                end else Curr := nil;
              end else Curr := nil;
            end;
            Dec(MyLevel);
          end;
        end;
      end;
    end;
  end;
begin
  if Not InUpdateLists then
  begin
    with (Control as TListBox).Canvas do
    begin
      bd := TSctBand(BandList.Items.Objects[Index]);
      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;

      if (odSelected in State) then Brush.Color := SaveColor
      else Font.Color := SaveColor;

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


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

      DrawLine(r1);

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

      MyText := '';
      SameLevel := True;
      if bd is TSctSubDataBand then
      begin
  {$ifdef AceBDE}
        if TSctSubDataBand(bd).DataSource = nil then
          MyText := 'Fill in DataSource.'
        else
        begin
          MyText := TSctSubDataBand(bd).DataSource.Name;
          if Not IsSameLevel(TSctSubDataBand(bd).DataSource, bd) then
          begin
            MyText := MyText + ' (UpdateLevels do not match)';
            SameLevel := False;
          end;
        end;
  {$endif}
      end else if TSctGroupPage(FPage).Detail = bd then
      begin
  {$ifdef AceBDE}
        if TSctGroupPage(Page).DataSource = nil then
          MyText := 'Fill in DataSource'
        else
        begin
          MyText := TSctGroupPage(FPage).DataSource.Name;
          if Not IsSameLevel(TSctGroupPage(FPage).DataSource, bd) then
          begin
            MyText := MyText + ' (UpdateLevels do not match)';
            SameLevel := False;
          end;
        end;
  {$endif}
      end;
      if MyText <> '' then
      begin
        r1 := Rect;
        r1.Left := r1.Right - Round((r1.Right-r1.Left)*0.40);
        if Not SameLevel then
        begin
          if (odSelected in State) then Brush.Color := clRed
          else Font.Color := clRed;
          Text := '* ' + Text;
        end;


        TextRect(r1,r1.Left,r1.Top+1,MyText);

        if Not SameLevel then
        begin
          if (odSelected in State) then Brush.Color := SaveColor
          else Font.Color := SaveColor;
        end;

        DSLabel.Left := r1.Left;
      end;
      if bd is TSctOverlayBand then
      begin
        r1 := Rect;
        r1.Left := r1.Right - Round((r1.Right-r1.Left)*0.40);
        if TSctOverlayBand(bd).First then MyText := 'PrintFirst at Offset: '
        else MyText := 'PrintLast at Offset: ';
        MyText := MyText + IntToStr(TSctOverlayBand(bd).TopOffset);
        TextRect(r1,r1.Left,r1.Top+1,MyText);
      end;

  {    TextRect(r2, r2.Left+2, r2.Top+1, VarName);
      TextRect(r3, r3.Left+2, r3.Top+1, Eventname);}

    end;
  end;
end;

procedure TSctPageManager.BandListDragDrop(Sender, Source: TObject; X,
  Y: Integer);
var
  BandFrom, BandTo: TSctBand;
  Position: Integer;
begin
  if BandIndex <> -1 then
  begin
    BandFrom := TSctBand(BandList.Items.Objects[BandIndex]);
    Position := BandList.ItemAtPos(Point(x,y), True);
    if Position <> -1 then
    begin
      BandTo := TSctBand(BandList.Items.Objects[Position]);
      if ValidMove(BandFrom, BandTo) then
      begin
        BandFrom.Band := BandTo;
        BandFrom.Order := -1;
        if BandFrom is TSctSubBand then
        begin
          BandFrom.UpdateLevel := BandTo.UpdateLevel;
        end;

        TSctGroupPage(Page).orderbands;
        TSctGroupPage(Page).arrangebands;
        UpdateLists;
        PageDesigner.Modified;
      end;
    end;
  end;
end;

function TSctPageManager.ValidMove(BandFrom, BandTo: TSctBand): Boolean;
  function IsParent: Boolean;
  var
    Curr: TSctBand;
  begin
    Result := False;
    Curr := BandTo.Band;
    while (Curr <> nil) And Not Result do
    begin
      if Curr = BandFrom then Result := True
      else Curr := Curr.Band;
    end;
  end;
begin
  Result := False;
  if (BandFrom <> nil) And (BandTo <> nil) then
  begin
    if BandFrom.ClassType = TSctBand then
    begin
      { Main band can't be moved }
    end else if (BandTo is TSctOverlayBand) then
    begin
      { Overlays can't be moved or moved to}
    end else if (BandFrom is TSctOverlayBand) then
    begin
      { Overlays can't be moved or moved to}
    end else if (BandFrom is TSctDataHeadBand)  then
    begin
      { Data Headers and footer can't be moved }
    end else if (BandFrom is TSctSubBand) And (BandTo is TSctSubBand) then
    begin
      { sub band can't be moved to another subband }
    end else if (BandTo = TSctGroupPage(Page).PageFoot) And
      (BandFrom.ClassType <> TSctSubBand) then
    begin
      { only subbands can be place on the page footer }
    end else if BandTo = BandFrom then
    begin
      { Can't move a band to itself }
    end else if IsParent then
    begin
      { Can't move a parent band to a child band }
    end else
    begin
      Result := True;
    end;
  end;
end;

procedure TSctPageManager.BandListDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
var
  BandFrom, BandTo: TSctBand;
  Position: Integer;
begin
  Accept := (Source = Sender) And (Source = BandList);
  if Accept then
  begin
    if BandIndex <> -1 then
    begin
      BandFrom := TSctBand(BandList.Items.Objects[BandIndex]);
      Position := BandList.ItemAtPos(Point(x,y), True);
      if Position <> -1 then
      begin
        BandTo := TSctBand(BandList.Items.Objects[Position]);
        Accept := ValidMove(BandFrom, BandTo)
      end;
    end;
  end;
end;

procedure TSctPageManager.BandListPopupPopup(Sender: TObject);
var
  MoveGood, SubGood, DataGood, HeadFootGood, DeleteGood : Boolean;
  Head, Foot: Boolean;
  bd: TSctBand;
  pg: TSctGroupPage;
  Spot: Integer;
  MenuItem: TMenuItem;
begin
  MoveGood := False;
  SubGood := False;
  DataGood := False;
  HeadFootGood := False;
  DeleteGood := False;
  Head := False;
  Foot := False;

  pg := TSctGroupPage(FPage);
  if BandIndex <> -1 then
  begin
    bd := TSctBand(BandList.Items.Objects[BandIndex]);
    if (bd is TSctSubBand) or (bd is TSctSubDataBand) or (bd is TSctOverlayBand) then
      MoveGood := True;


    if (bd is TSctSubDataBand) Then
    begin
      SubGood := True;
      DataGood := True;
      HeadFootGood := True;
      DeleteGood := True;
      Head := True;
      Foot := True;

      { see if this band already has both a header and footer }
      if pg.DataHFBands <> nil then
      begin
        for Spot := 0 to pg.DataHFBands.Count - 1 do
        begin
          if TSctDataHeadBand(pg.DataHFBands.Items[Spot]).Band = bd Then
          begin
            if TSctBand(pg.DataHFBands.Items[Spot]) is TSctDataFootBand Then Foot := False
            else Head := False;
          end;
        end;
      end;


    end else if bd is TSctSubBand Then
    begin
      DataGood := bd.band <> TSctGroupPage(Page).PageFoot;
      DeleteGood := True;
    end else if bd is TSctDataHeadBand Then
    begin
      SubGood := True;
      DataGood := True;
      DeleteGood := True;
    end else if bd is TSctOverLayBand Then
    begin
      DeleteGood := True;
    end else
    begin
      SubGood := True;
      DataGood := bd <> TSctGroupPage(Page).PageFoot;
    end;
  end;

  while AddDataBand1.Count > 0 do
  begin
    AddDataBand1.Delete(0);
  end;
  if DataGood then
  begin
    MenuItem := TMenuItem.Create(FPage.Owner);
    MenuItem.Caption := 'No DataSource';
    MenuItem.OnClick := subdataaddClick;
    AddDataBand1.Add(MenuItem);

{$ifdef AceBDE}
    if pg.DataSourceList <> nil then
    begin
      for Spot := 0 to pg.DataSourceList.Count - 1 do
      begin
        MenuItem := TMenuItem.Create(FPage.Owner);
        if TSctDataSourceGuide(pg.DataSourceList.Items[Spot]).DataSource <> nil then
          MenuItem.Caption := TSctDataSourceGuide(pg.DataSourceList.Items[Spot]).DataSource.Name;

        MenuItem.OnClick := subdataaddClick;
        MenuItem.Tag := Spot + 1;
        AddDataBand1.Add(MenuItem);
      end;
    end;
{$endif}
  end;


  MoveUp1.Enabled := MoveGood;
  MoveDown1.Enabled := MoveGood;
  AddSubBand1.Enabled := SubGood;
  AddDataBand1.Enabled := DataGood;
  AddHeadFoot1.Enabled := HeadFootGood;
  AddOverlay1.Enabled := True;
  Delete1.Enabled := DeleteGood;
  DataHeader1.Enabled := Head;
  DataFooter1.Enabled := Foot;
end;

function TSctPageManager.GroupIndex: Integer;
begin
{$ifdef VCL120PLUS}
  if GroupList.MultiSelect then
    Result := SendMessage(GroupList.Handle, LB_GETCARETINDEX, 0, 0)
  else
    Result := SendMessage(GroupList.Handle, LB_GETCURSEL, 0, 0);
{$else}
  Result := GroupList.ItemIndex;
{$endif}
end;

function TSctPageManager.BandIndex: Integer;
begin
{$ifdef VCL120PLUS}
  if BandList.MultiSelect then
    Result := SendMessage(BandList.Handle, LB_GETCARETINDEX, 0, 0)
  else
    Result := SendMessage(BandList.Handle, LB_GETCURSEL, 0, 0);
{$else}
  Result := BandList.ItemIndex;
{$endif}
end;

end.

⌨️ 快捷键说明

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