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