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

📄 pageman.pas

📁 suite component ace report
💻 PAS
📖 第 1 页 / 共 4 页
字号:
unit PageMan;

{ ----------------------------------------------------------------
  Ace Reporter
  Copyright 1995-1998 SCT Associates, Inc.
  Written by Kevin Maher, Steve Tyrakowski
  ---------------------------------------------------------------- }

interface
{$I ace.inc}

uses

     Classes, Graphics, Forms, Controls, StdCtrls, Buttons, ExtCtrls,
     messages, sctrep, Grids,  Menus,
   {$IFDEF WIN32}  windows {$ELSE}  wintypes, winprocs  {$ENDIF}
   {$IFDEF AceDesignTime}, dsgnintf {$ENDIF}
   {$ifdef AceBDE}  
     ,db {$ifndef VCL130PLUS} , dbtables   {$endif}
   {$endif}  
   ;

type
  TSctPageManager = class(TForm)
    BandPanel: TPanel;
    GroupPanel: TPanel;
    Panel5: TPanel;
    grouplist: TListBox;
    GroupListPopup: TPopupMenu;
    GroupDelete: TMenuItem;
    GroupAdd: TMenuItem;
    MoveUp: TMenuItem;
    MoveDown: TMenuItem;
    Panel1: TPanel;
    GroupLabel: TLabel;
    VariableLabel: TLabel;
    EventLabel: TLabel;
    BandListPopup: TPopupMenu;
    MoveUp1: TMenuItem;
    MoveDown1: TMenuItem;
    BandList: TListBox;
    AddSubBand1: TMenuItem;
    AddDataBand1: TMenuItem;
    AddHeadFoot1: TMenuItem;
    AddOverlay1: TMenuItem;
    Delete1: TMenuItem;
    DataHeader1: TMenuItem;
    DataFooter1: TMenuItem;
    PrintFirst1: TMenuItem;
    PrintLast1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    Panel2: TPanel;
    Label1: TLabel;
    dslabel: TLabel;
    Above1: TMenuItem;
    Below1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure grouplistClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure addbandClick(Sender: TObject);
    procedure subdataaddClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure addheadfootbandClick(Sender: TObject);
    procedure AddOverLayClick(Sender: TObject);
    procedure GroupAddClick(Sender: TObject);
    procedure GroupDeleteClick(Sender: TObject);
    procedure MoveUpClick(Sender: TObject);
    procedure MoveDownClick(Sender: TObject);
    procedure GroupListPopupPopup(Sender: TObject);
    procedure grouplistDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure MoveUp1Click(Sender: TObject);
    procedure BandListClick(Sender: TObject);
    procedure BandListDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure BandListDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure BandListDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure BandListPopupPopup(Sender: TObject);
  private
    { Private declarations }
    FPage: TComponent;
    FGroupPosList: TList;
{$ifdef VCL120PLUS}
    FPageDesigner: IFormDesigner;
{$else}
    FPageDesigner: TFormDesigner;
{$endif}

{    ComponentSelection: TAceComponentSelection;}
    DataControl: TForm;
    InDataControl, InUpdateLists, InUpdateOutline: Boolean;
    procedure UpdateForm(var Message: TSctUpdateForm); message Sct_UpdateForm;
    procedure SelectGroupPage(var Message: TSctSelectGroupPage); message Sct_SelectGroupPage;
{    procedure RunComponentSelection(var Message: TSctComponentSelection); message Sct_ComponentSelection;}
    procedure DoDataControl(var Message: TSctDataControl); message Sct_DataControl;
    procedure DataUpdateVars(var Message: TSctDataUpdateVars); message Sct_DataUpdateVars;
    procedure VarChanged(var Message: TSctVarChanged); message Sct_VarChanged;

    procedure RunOverReport(var Message: TSctOverviewReport); message Sct_OverviewReport;
    procedure RunDiagReport(var Message: TSctDiagReport); message Sct_DiagReport;

    procedure RefreshVars;
    function ValidMove(BandFrom, BandTo: TSctBand): Boolean;
{$ifdef AceBDE}
    procedure SetDataLists(var Message: TSctSetDataLists); message Sct_SetDataLists;
    function IsSameLevel(ds: TDataSource; bd: TSctBand): Boolean;
{$endif}

    function GroupIndex: Integer;
    function BandIndex: Integer;
  public
    { Public declarations }
    property Page: TComponent read FPage write FPage;
    property GroupPosList: TList read FGroupPosList write FGroupPosList;
    
{$ifdef VCL120PLUS}
    property PageDesigner: IFormDesigner read FPageDesigner write FPageDesigner;
{$else}
    property PageDesigner: TFormDesigner read FPageDesigner write FPageDesigner;
{$endif}

    procedure DeleteSubDataBandsOf(bd: TSctBand);
    procedure DeleteSubBandsOf(bd: TSctBand);

    procedure UpdateLists;
    procedure UpdateOutline;
{    procedure AddSubBands(Band: TSctBand; Pop: TSctBand);
    procedure AddOutlineBand(band: TSctBand; Pop: TSctBand);}
    procedure SubdataDelete(bd: TObject);
    procedure SubbandDelete(bd: TObject);
    procedure OverlayDelete(bd: TObject);

    procedure DataHFDelete( bd: TObject );
    procedure DeleteHFBandsOf(bd: TObject);


{$ifdef WIN32}
{$ifdef AceBDE}
    procedure AddDataLists(const S: String);
{$endif}
{$endif}
  end;

{$ifdef VCL120PLUS}
procedure ComponentSelect(fd: IFormDesigner; comp: TComponent);
function AceGetMethodValue(Instance: TPersistent; MethodName: String; Designer: IDesigner): String;
procedure AceRevertToAncestor(Instance: TPersistent; Designer: IDesigner);
{$else}
procedure ComponentSelect(fd: TFormDesigner; comp: TComponent);
function AceGetMethodValue(Instance: TPersistent; MethodName: String; Designer: TDesigner): String;
procedure AceRevertToAncestor(Instance: TPersistent; Designer: TDesigner);
{$endif}



var
  SctPageManager: TSctPageManager;

implementation

uses sysutils, dialogs, sctvar, sctctrl, sctutil
     , typinfo, sctvopt, Aceutil, aceoview, acediag
  {$ifndef WIN32}
   , libmain
  {$endif}
   ;


{$R *.DFM}


{$ifdef VCL120PLUS}
procedure ComponentSelect(fd: IFormDesigner; comp: TComponent);
{$else}
procedure ComponentSelect(fd: TFormDesigner; comp: TComponent);
{$endif}
begin
{$ifdef WIN32}
  fd.SelectComponent(comp);
{$else}
  if fd is TWindowDesigner Then TWindowDesigner(fd).LibForm.SetSelection(comp.name);
{$endif}
end;

procedure TSctPageManager.FormCreate(Sender: TObject);
begin

  FGroupPosList := TList.Create;
{  ComponentSelection := nil;}
  DataControl := nil;
  InDataControl := False;
  InUpdateLists := False;
  InUpdateOutline := False;

{  ClientHeight := GroupPanel.Top + GroupPanel.Height + 10;
  GroupPanel.Height := ClientHeight - (CloseButton.Top + CloseButton.Height + 10);}
end;

procedure TSctPageManager.FormDestroy(Sender: TObject);
begin
  if FGroupPosList <> nil Then FGroupPosList.Free;
{  if ComponentSelection <> nil then ComponentSelection.Free;}
  if DataControl <> nil then
  begin
    DataControl.Free;
    DataControl := nil;
  end;
end;

procedure TSctPageManager.Button2Click(Sender: TObject);
begin
  Close;
end;

procedure TSctPageManager.grouplistClick(Sender: TObject);
var
  oGroup: TSctGroup;
begin
  if (GroupIndex <> -1) Then
  begin
    oGroup := TSctGroup(GroupPosList.Items[ GroupIndex ]);
    ComponentSelect(PageDesigner, oGroup);
  end;
end;

procedure TSctPageManager.FormShow(Sender: TObject);
begin
  UpdateLists;
end;

procedure TSctPageManager.UpdateForm(var Message: TSctUpdateForm);
begin
  UpdateLists;
  RefreshVars;
end;

procedure TSctPageManager.SelectGroupPage(var Message: TSctSelectGroupPage);
begin
  ComponentSelect(PageDesigner, Page);
end;
{
procedure TSctPageManager.RunComponentSelection(var Message: TSctComponentSelection);
begin
  if ComponentSelection = nil then
  begin
    ComponentSelection := TAceComponentSelection.Create(Application);
    ComponentSelection.Page := TSctGroupPage(Page);
    ComponentSelection.PageDesigner := PageDesigner;
  end;
  ComponentSelection.Show;
end;
}
procedure TSctPageManager.RunOverReport(var Message: TSctOverviewReport);
begin
  with TAceOverview.Create(Application) do
  begin
    Report := TSctReport(TSctPage(Self.Page).Parent);
    GP := TSctGroupPage(Self.Page);
    try
      SctReport1.Run;
    finally
      Free;
    end;
  end;
end;
procedure TSctPageManager.RunDiagReport(var Message: TSctDiagReport);
begin
  with TAceDiagForm.Create(Application) do
  begin
    PageDesigner := Self.PageDesigner;
    try
      Diagproc(TSctReport(TSctPage(Self.Page).Parent));
    finally
      Free;
    end;
  end;
end;

procedure TSctPageManager.VarChanged(var Message: TSctVarChanged);
begin
  if DataControl <> nil then
  begin
    TSctDSVariableOptions(DataControl).ObjectChanged;
  end;
end;

procedure TSctPageManager.RefreshVars;
begin
  if DataControl <> nil then
    PostMessage(DataControl.Handle, Ace_RefreshVarLists, 0, 0);
end;


procedure TSctPageManager.DoDataControl(var Message: TSctDataControl);
begin
  if Not InDataControl then
  begin
    InDataControl := True;
    TSctGroupPage(Page).UpdateVarList;
    if DataControl = nil then
    begin
      DataControl := TForm(TSctDSVariableOptions.Create(Application));
      TSctDSVariableOptions(DataControl).PageManager := self;
    end;

    if DataControl <> nil then
    begin
      if TSctDSVariableOptions(DataControl).UpdateVars then DataControl.Show;
    end;

    InDataControl := False;
  end;
end;

procedure TSctPageManager.DataUpdateVars(var Message: TSctDataUpdateVars);
begin
  if Not InDataControl then
  begin
    InDataControl := True;
    if DataControl = nil then
    begin
      DataControl := TForm(TSctDSVariableOptions.Create(Application));
      TSctDSVariableOptions(DataControl).PageManager := self;
    end;
    if DataControl <> nil then TSctDSVariableOptions(DataControl).UpdateVars;
    InDataControl := False;
  end;
end;

{$ifdef AceBDE}
procedure TSctPageManager.SetDataLists(var Message: TSctSetDataLists);
{$ifndef WIN32}
var
  pos: Integer;
{$endif}
begin
  {$ifdef WIN32}
  PageDesigner.GetComponentNames(GetTypeData(TDataSource.ClassInfo), AddDataLists);
  {$else}
  with Page.Owner do
  begin
    for pos := 0 to ComponentCount - 1 do
    begin
      if Components[pos] is TDataSource then
      begin
        TSctGroupPage(page).FullDSNames.Add(Components[pos].name);
        TSctGroupPage(page).FullDSList.Add(Components[pos]);
      end;
    end;
  end;
  {$endif}
end;

{$ifdef WIN32}
procedure TSctPageManager.AddDataLists(const S: String);
var
  comp: TComponent;
  list: TList;
begin
  Comp := PageDesigner.GetComponent(S);
  if Comp is TDataSource then
  begin
    list := TSctGroupPage(Page).FullDSList;
    if list.IndexOf(Comp) = -1 then
    begin
      { This is to avoid duplication of datasources from ancestor forms
        that seem to be used along with inherited from }

      if Not AceIsAncestor(Comp) And PageDesigner.IsComponentLinkAble(Comp) And
        PageDesigner.Form.InheritsFrom(Comp.Owner.ClassType) And
        (PageDesigner.Form.ClassType <> Comp.Owner.ClassType )then
      begin
        { do nothing here }
      end else
      begin
        TSctGroupPage(Page).FullDSNames.Add(S);
        TSctGroupPage(Page).FullDSList.Add(Comp);
      end;
    end;
  end;
end;
{$endif}
{$endif}

procedure TSctPageManager.UpdateLists;
var
  pg: TSctPage;
  Pos: Integer;
begin
  if Not InUpdateLists then
  begin
    try
      InUpdateLists := True;
      pg := TSctPage(page);

      grouplist.Items.Clear;
      FgroupPosList.Clear;
      if page is TSctGrouppage Then
      begin
        if TSctGroupPage(page).groups <> nil then
        begin
          For Pos := 0 to TSctGrouppage(page).groups.Count - 1 Do
          begin
            grouplist.Items.Add( TSctGroup(TSctGrouppage(page).groups.Items[Pos]).Name);
            FGroupPosList.Add(TSctGrouppage(page).groups.Items[Pos]);
          end;
        end;
      end;

      Caption := 'Band Manager for ' + pg.name;

      updateoutline;
    finally
      InUpdateLists := False;
    end;
  end;
end;

procedure TSctPageManager.UpdateOutline;
var
  pos: Integer;
  pg: TSctGrouppage;
  bd: TSctBand;
begin
  if Not InUpdateOutline then
  begin
    try

      InUpdateOutline := True;
      BandList.Clear;
      pg := TSctGroupPage(page);

      if pg.Bands <> nil then
      begin
        for pos := 0 to pg.Bands.Count - 1 do
        begin
          bd := pg.Bands.items[pos];
          BandList.Items.AddObject(bd.BandName, bd);
        end;
      end;
    finally
      InUpdateOutline := False;
    end;
  end;

end;

procedure TSctPageManager.addbandClick(Sender: TObject);
var
  SubBand: TSctSubBand;
  bd: TSctBand;
  Spot: Integer;
begin
  if AceBandCheck(TSctGroupPage(Page), True, True) then
  begin
    if BandIndex <> -1 Then
    begin
      bd := TSctBand(BandList.Items.Objects[BandIndex]);
      SubBand := nil;
      try
        SubBand := TSctSubBand.Create(Page.Owner);
        if SctAutoSetComponentName(SubBand, bd.Name + 'Sub', False) then
        begin
          Subband.Parent := TSctGroupPage(Page);
          Subband.Band := bd;
          Subband.height := 20;
          Subband.Top := 0;
          Subband.width := 200;
          Subband.bandname := SubBand.Name;
          Subband.UpdateLevel := bd.UpdateLevel;
          Subband.Above := Sender = Above1;

⌨️ 快捷键说明

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