📄 pageman.pas
字号:
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 + -