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

📄 pageman.pas

📁 suite component ace report
💻 PAS
📖 第 1 页 / 共 4 页
字号:
      DeleteSubBandsOf(group.header);
      DeleteSubDataBandsOf(group.header);
      DeleteSubBandsOf(group.footer);
      DeleteSubDataBandsOf(group.footer);

      Group.Parent := nil;

      Grouplist.Items.Delete(Pos);
      FGroupPosList.Delete(Pos);
      Group.safeDelete; { this will delete the header and footer }

      { pack leveling }
      For Pos := 0 to (FGroupPosList.Count - 1) Do
        TSctGroup(FGroupPosList.Items[Pos]).level := (Pos + 1);

      TSctGrouppage(Page).ArrangeBands;
      TSctGrouppage(Page).OrderBands;

      PageDesigner.Modified;

      UpdateOutLine;
      GroupListClick(self);
    end;
  end;
end;

procedure TSctPageManager.MoveUpClick(Sender: TObject);
var
  Group: TSctGroup;
begin
  if GroupIndex <> -1 then
  begin
    Group := GroupPosList.Items[ GroupIndex ];
    Group.Level := Group.Level - 2;
    TSctGroupPage(Page).orderbands;
    TSctGroupPage(Page).arrangebands;
    UpdateLists;
    PageDesigner.Modified;
  end;
end;

procedure TSctPageManager.MoveDownClick(Sender: TObject);
var
  group: TSctGroup;
begin
  if GroupIndex <> -1 then
  begin
    group := groupposlist.items[ GroupIndex ];
    group.Level := group.Level + 2;

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

procedure TSctPageManager.GroupListPopupPopup(Sender: TObject);
begin
  GroupAdd.Enabled := True;
  GroupDelete.Enabled := (GroupIndex <> -1) And (GroupList.Items.Count > 0);
  MoveUp.Enabled := (GroupIndex > 0) And (GroupList.Items.Count > 1);
  MoveDown.Enabled := (GroupIndex <> -1) And (GroupList.Items.Count > 1)
                       And (GroupIndex < (GroupList.Items.Count - 1));
end;

procedure TSctPageManager.grouplistDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  r1, r2, r3: TRect;
  VarName, EventName, Text: String;
  Group: TSctGroup;
begin
  Group := TSctGroup(GroupPosList.Items[ Index ]);

  VarName := '';
  if Group.Variable <> nil then VarName := Group.Variable.Name;
  EventName := AceGetMethodValue(Group, 'OnCheckBroken', PageDesigner);

  if (EventName = '') And (VarName = '') then
  begin
    EventName := 'Fill in OnCheckBroken event.';
    VarName := 'Fill in Variable';
  end;
  if EventName = '' then EventName := 'Not assigned.';
  if VarName = '' then VarName := 'Not assigned.';


    Rect.Left := Rect.Left + 4;
    r1 := Rect;
    r2 := Rect;
    r3 := Rect;

    r1.Right := r1.Left + Round(Control.Width * 0.30);
    r2.Left := r1.Right+1;
    r2.Right := r2.Left + Round((r2.Right - r2.Left) * 0.40);
    r3.Left := r2.Right + 1;

    GroupLabel.Left := r1.Left;
    VariableLabel.Left := r2.Left;
    EventLabel.Left := r3.Left;

    with (Control as TListBox).Canvas do
    begin
      FillRect(Rect);
      Text := Group.Name;
      TextRect(r1, r1.Left+2, r1.Top+1, Text);
      TextRect(r2, r2.Left+2, r2.Top+1, VarName);
      TextRect(r3, r3.Left+2, r3.Top+1, Eventname);
    end;

end;

{$ifdef VCL120PLUS}
function AceGetMethodValue(Instance: TPersistent; MethodName: String; Designer: IDesigner): String;
{$else}
function AceGetMethodValue(Instance: TPersistent; MethodName: String; Designer: TDesigner): String;
{$endif}
var
  I, Count: Integer;
  PropInfo: PPropInfo;
  PropList: PPropList;
  Value: TMethod;
begin
  Result := '';
  Count := GetTypeData(Instance.ClassInfo)^.PropCount;
  if Count > 0 then
  begin
    GetMem(PropList, Count * SizeOf(Pointer));
    try
      GetPropInfos(Instance.ClassInfo, PropList);
      for I := 0 to Count - 1 do
      begin
        PropInfo := PropList^[I];
        if PPropInfo(PropInfo)^.Name = MethodName then
        begin
          Value := GetMethodProp(Instance, PropInfo);
{$ifdef VCL120PLUS}
          Result := IFormDesigner(Designer).GetMethodName(Value);
{$else}
          Result := TFormDesigner(Designer).GetMethodName(Value);
{$endif}
        end;
      end;
    finally
      FreeMem(PropList, Count * SizeOf(Pointer));
    end;
  end;
end;

{$ifdef VCL120PLUS}
procedure AceRevertToAncestor(Instance: TPersistent; Designer: IDesigner);
{$else}
procedure AceRevertToAncestor(Instance: TPersistent; Designer: TDesigner);
{$endif}
var
  I, Count: Integer;
  PropInfo: PPropInfo;
  PropList: PPropList;
begin
{$ifdef WIN32}

  Count := GetTypeData(Instance.ClassInfo)^.PropCount;
  if Count > 0 then
  begin
    GetMem(PropList, Count * SizeOf(Pointer));
    try
      GetPropInfos(Instance.ClassInfo, PropList);
      for I := 0 to Count - 1 do
      begin
        PropInfo := PropList^[I];
{$ifdef VCL120PLUS}
        IFormDesigner(Designer).Revert(Instance, PropInfo);
{$else}
        TFormDesigner(Designer).Revert(Instance, PropInfo);
{$endif}
      end;
    finally
      FreeMem(PropList, Count * SizeOf(Pointer));
    end;
  end;

{$endif}
end;




procedure TSctPageManager.MoveUp1Click(Sender: TObject);
var
  bd, Band: TSctBand;
  Spot, SaveOrder: Integer;
  Moved, MoveUp: Boolean;
  sband: TSctSubBand;
  dband: TSctSubDataBand;
  oband: TSctOverlayBand;
  Bands: TList;
  Position: Integer;
begin
  Moved := False;
  if BandIndex <> -1 then
  begin
    Bands := TList.Create;

    Spot := BandIndex;
    bd := TSctBand(BandList.Items.Objects[Spot]);
    MoveUp := TWinControl(Sender).Tag = 0;

    if (bd is TSctSubBand) then
    begin
      sband := TSctSubBand(bd);
      { get list of bands with same parent band }
      for Position := 0 to BandList.Items.Count - 1 do
      begin
        Band := TSctBand(BandList.Items.Objects[Position]);
        if (Band is TSctSubBand) And (Band <> sband) then
        begin
          if (Band.Band = sband.Band) And (TSctSubBand(Band).Above = sband.Above) then
          begin
            Bands.Add(Band);
          end;
        end;
      end;
      SaveOrder := sband.Order;
      if MoveUp then
      begin
        sband.SetOrderDirect(sband.Order-1);
        if Not sband.Above And (sband.Order < 0) then
        begin
          sband.Above := True;
          sband.SetOrderDirect(999); { 999 should be greater than amount of bands }
        end;
      end else
      begin
        sband.SetOrderDirect(sband.Order+1);
        if sband.Above And (sband.Order > Bands.Count) then
        begin
          sband.Above := False;
          sband.SetOrderDirect(-1);
        end;
      end;
      for Position := 0 to Bands.Count - 1 do
      begin
        if TSctSubBand(Bands.Items[Position]).Order = sband.Order then
          TSctSubBand(Bands.Items[Position]).SetOrderDirect(SaveOrder);
      end;
      Moved := True;
    end else if bd is TSctSubDataBand then
    begin
      dband := TSctSubDataBand(bd);
      { get list of bands with same parent band }
      for Position := 0 to BandList.Items.Count - 1 do
      begin
        Band := TSctBand(BandList.Items.Objects[Position]);
        if (Band is TSctSubDataBand) And (Band <> dband) then
          if (Band.Band = dband.Band) then Bands.Add(Band);
      end;
      SaveOrder := dband.Order;
      if MoveUp then dband.SetOrderDirect(dband.Order-1)
      else dband.SetOrderDirect(dband.Order+1);
      for Position := 0 to Bands.Count - 1 do
      begin
        if TSctSubDataBand(Bands.Items[Position]).Order = dband.Order then
          TSctSubDataBand(Bands.Items[Position]).SetOrderDirect(SaveOrder);
      end;
      Moved := True;
    end else if bd is TSctOverlayBand then
    begin
      oband := TSctOverlayBand(bd);
      { get list of bands with same parent band }
      for Position := 0 to BandList.Items.Count - 1 do
      begin
        Band := TSctBand(BandList.Items.Objects[Position]);
        if (Band is TSctOverlayBand) And (Band <> oband) then
          if (Band.Band = oband.Band) And (TSctOverlayBand(Band).First = oband.First)
            then Bands.Add(Band);
      end;
      SaveOrder := oband.Order;
      if MoveUp then
      begin
        oband.SetOrderDirect(oband.Order-1);
        if Not oband.First And (oband.Order < 0) then
        begin
          oband.First := True;
          oband.SetOrderDirect(999); { 999 should be greater than amount of bands }
        end;
      end else
      begin
        oband.SetOrderDirect(oband.Order+1);
        if oband.First And (oband.Order > Bands.Count) then
        begin
          oband.First := False;
          oband.SetOrderDirect(-1);
        end;
      end;


      for Position := 0 to Bands.Count - 1 do
      begin
        if TSctBand(Bands.Items[Position]).Order = oband.Order then
          TSctBand(Bands.Items[Position]).SetOrderDirect(SaveOrder);
      end;
      Moved := True;
    end;

    if Moved then
    begin
      TSctGroupPage(Page).orderbands;
      TSctGroupPage(Page).arrangebands;
      UpdateLists;
      PageDesigner.Modified;
    end;

    Bands.Free;
  end;

end;


procedure TSctPageManager.BandListClick(Sender: TObject);
var
  bd: TSctBand;
begin
  if BandIndex <> -1 then
  begin
    bd := TSctBand(BandList.Items.Objects[ BandIndex ]);
    ComponentSelect(PageDesigner, bd);
  end;
  { make sure no group is selected }
  GroupList.ItemIndex := -1;
end;

{$ifdef AceBDE}
function TSctPageManager.IsSameLevel(ds: TDataSource; bd: TSctBand): Boolean;
var
  pg: TSctGroupPage;
  dsg: TSctDataSourceGuide;
  Spot: Integer;
begin
  Result := False;
  if (ds <> nil) And (bd <> nil) then
  begin
    pg := TSctGroupPage(FPage);
    Spot := 0;
    if pg.DataSourceList <> nil then
    begin
      while Spot < pg.DataSourceList.Count do
      begin
        dsg := pg.DataSourceList.Items[Spot];
        if (dsg <> nil) then
        begin
          if dsg.DataSource = ds then
          begin
            if dsg.UpdateLevel = bd.UpdateLevel then Result := True;
            Spot := pg.DataSourceList.Count;
          end;
        end;
        Inc(Spot);
      end;
    end;
  end;
end;
{$endif}

procedure TSctPageManager.BandListDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  SameLevel: Boolean;
  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 TSctGroupPage(FPage).Groups <> nil then
    begin
      for GroupSpot := 0 to TSctGroupPage(FPage).Groups.Count -1 do
      begin
        Group := TSctGroupPage(FPage).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 = TSctGroupPage(FPage).Detail) then
      begin
        Inc(Result);
        Done := True;
        if TSctGroupPage(FPage).Groups <> nil then
        begin
          Result := Result + TSctGroupPage(FPage).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 < BandList.Items.Count do
    begin
      atBand := TSctBand(BandList.Items.Objects[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 := BandList.Items.Count;
        end;
      end;
      Inc(Spot);
    end;
  end;
  function IsLast(bd: TSctBand): Boolean;
  var
    atband: TSctBand;
    Spot: Integer;
  begin
    Result := False;
    Spot := BandList.Items.Count;
    while Spot > 0 do
    begin
      Dec(Spot);
      atBand := TSctBand(BandList.Items.Objects[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;

⌨️ 快捷键说明

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