22
21
Forms, Controls, Graphics, Dialogs,ComCtrls,
23
22
ExtCtrls, Buttons, StdCtrls,Menus,
25
LCLType,LCLIntf,LCLProc,GraphType,Printers,
24
LCLType,LCLIntf,LCLProc,GraphType,Printers, ActnList,
27
26
ObjectInspector, PropEdits,TypInfo,
52
51
TfrReportUnits = (ruPixels, ruMM, ruInches);
53
52
TfrShapeMode = (smFrame, smAll);
55
TfrUndoAction = (acInsert, acDelete, acEdit, acZOrder);
54
TfrUndoAction = (acInsert, acDelete, acEdit, acZOrder, acDuplication);
56
55
PfrUndoObj = ^TfrUndoObj;
57
56
TfrUndoObj = record
108
109
procedure BtnClick(Sender : TObject);
109
110
procedure HeaderMDown(Sender: TOBject; Button: TMouseButton;
110
Shift: TShiftState; X, Y: Integer);
111
procedure HeaderMMove(Sender: TObject; Shift: TShiftState; X,
113
procedure HeaderMUp(Sender: TOBject; Button: TMouseButton;
114
Shift: TShiftState; X, Y: Integer);
111
{%H-}Shift: TShiftState; X, Y: Integer);
112
procedure HeaderMMove(Sender: TObject; {%H-}Shift: TShiftState; {%H-}X,
114
procedure HeaderMUp(Sender: TOBject; {%H-}Button: TMouseButton;
115
{%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
117
118
procedure CMVisibleChanged(var TheMessage: TLMessage); message CM_VISIBLECHANGED;
163
163
procedure DrawDialog;
165
165
procedure MDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
166
procedure MUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
166
procedure MUp(Sender: TObject; Button: TMouseButton; {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
167
167
procedure MMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
168
procedure CMMouseLeave(var Message: TLMessage); message CM_MOUSELEAVE;
168
procedure CMMouseLeave(var {%H-}Message: TLMessage); message CM_MOUSELEAVE;
169
169
procedure DClick(Sender: TObject);
170
170
procedure MoveResize(Kx,Ky:Integer; UseFrames,AResize: boolean);
172
172
procedure Paint; override;
173
procedure WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND;
173
procedure WMEraseBkgnd(var {%H-}Message: TLMEraseBkgnd); message LM_ERASEBKGND;
174
procedure DoContextPopup(MousePos: TPoint; var Handled: Boolean); override;
175
176
constructor Create(AOwner: TComponent); override;
365
371
procedure ZB2Click(Sender: TObject);
366
372
procedure PgB1Click(Sender: TObject);
367
373
procedure PgB2Click(Sender: TObject);
368
procedure OB2MouseDown(Sender: TObject; Button: TMouseButton;
369
Shift: TShiftState; X, Y: Integer);
374
procedure OB2MouseDown(Sender: TObject; {%H-}Button: TMouseButton;
375
Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
370
376
procedure OB1Click(Sender: TObject);
371
377
procedure CutBClick(Sender: TObject);
372
378
procedure CopyBClick(Sender: TObject);
384
390
procedure FormShow(Sender: TObject);
385
391
procedure FormHide(Sender: TObject);
386
392
procedure N8Click(Sender: TObject);
387
procedure C2DrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
388
State: TOwnerDrawState);
393
procedure C2DrawItem({%H-}Control: TWinControl; Index: Integer; Rect: TRect;
394
{%H-}State: TOwnerDrawState);
389
395
procedure HlB1Click(Sender: TObject);
390
396
procedure FileBtn4Click(Sender: TObject);
391
397
procedure N42Click(Sender: TObject);
414
420
procedure SB1Click(Sender: TObject);
415
421
procedure SB2Click(Sender: TObject);
416
422
procedure HelpBtnClick(Sender: TObject);
417
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
418
Shift: TShiftState; X, Y: Integer);
423
procedure FormMouseDown(Sender: TObject; {%H-}Button: TMouseButton;
424
{%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
419
425
procedure N22Click(Sender: TObject);
420
426
procedure Tab1MouseDown(Sender: TObject; Button: TMouseButton;
421
Shift: TShiftState; X, Y: Integer);
422
procedure frDesignerFormClose(Sender: TObject; var CloseAction: TCloseAction
427
{%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
428
procedure frDesignerFormClose(Sender: TObject; var {%H-}CloseAction: TCloseAction);
424
429
procedure frDesignerFormCloseQuery(Sender: TObject; var CanClose: boolean);
425
430
procedure frSpeedButton1Click(Sender: TObject);
426
431
procedure StB1Click(Sender: TObject);
516
522
procedure GetDefaultSize(var dx, dy: Integer);
517
523
function SelStatus: TfrSelectionStatus;
518
524
procedure UpdScrollbars;
519
procedure InsertFieldsFormCloseQuery(Sender: TObject; var CanClose: boolean);
525
procedure InsertFieldsFormCloseQuery(Sender: TObject; var {%H-}CanClose: boolean);
520
526
procedure InsertDbFields;
522
528
procedure DrawStatusPanel(const ACanvas:TCanvas; const rect: TRect);
523
529
procedure StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
524
530
const Rect: TRect);
532
procedure DefineExtraPopupSelected(popup: TPopupMenu);
533
procedure SelectSameClassClick(Sender: TObject);
534
procedure SelectSameClass(View: TfrView);
536
FDuplicateCount: Integer;
537
FDupDeltaX,FDupDeltaY: Integer;
538
FDuplicateList: TFpList;
539
procedure ViewsAction(Views: TFpList; TheAction:TViewAction; Data: PtrInt;
540
OnlySel:boolean=true; WithUndoAction:boolean=true; WithRedraw:boolean=true);
541
procedure ToggleFrames(View: TfrView; Data: PtrInt);
542
procedure DuplicateView(View: TfrView; Data: PtrInt);
543
procedure ResetDuplicateCount;
527
545
constructor Create(aOwner : TComponent); override;
528
546
destructor Destroy; override;
1064
DebugLnEnter('TfrDesignerPage.Draw INIT N=%d AClipRgn=%d',[N,AClipRgn]);
1040
1067
if AClipRgn = 0 then
1042
1069
with Canvas.ClipRect do
1043
1070
AClipRgn := CreateRectRgn(Left, Top, Right, Bottom);
1048
DebugLn('------------- Begin Draw() -------------');
1051
1073
R:=CreateRectRgn(0, 0, Width, Height);
1052
1074
for i:=Objects.Count-1 downto 0 do
1088
1110
SelectClipRgn(Canvas.Handle, R);
1092
DebugLn('------------- End Draw() -------------');
1095
1113
CombineRgn(R, R, AClipRgn, RGN_AND);
1097
1115
DrawBackground;
1099
1117
DeleteObject(R);
1100
1118
DeleteObject(AClipRgn);
1119
if AClipRgn=ClipRgn then
1101
1122
SelectClipRgn(Canvas.Handle, 0);
1103
1124
if not Down then
1104
1125
DrawPage(dmSelection);
1128
DebugLnExit('TfrDesignerPage.Draw DONE');
1108
1132
procedure TfrDesignerPage.DrawPage(DrawMode: TfrDesignerDrawMode);
1218
1242
{$IFDEF DebugLR}
1219
DebugLn('TfrDesignerPage.MDown(X=',dbgs(x),',Y=',dbgs(y),' INIT');
1220
DebugLn(' Down=', dbgs(Down),' FFlag=', dbgs(RFlag));
1243
DebugLnEnter('TfrDesignerPage.MDown(X=%d,Y=%d) INIT',[x,y]);
1244
DebugLn('Down=%s RFlag=%s',[dbgs(Down),dbgs(RFlag)]);
1247
// In Lazarus there is no mousedown after doubleclick so
1248
// just ignore mousedown when doubleclick is coming.
1249
if ssDouble in Shift then begin
1251
DebugLnExit('TfrDesignerPage.MDown DONE: doubleclick expected');
1228
1256
if (Button = mbRight) and Down and RFlag then
1229
1257
DrawFocusRect(OldRect);
1458
DebugLnEnter('TfrDesignerPage.MUp INIT Button=%d Cursor=%d RFlag=%s',
1459
[ord(Button),Cursor,dbgs(RFlag)]);
1418
1461
if Button <> mbLeft then
1420
1463
{$IFDEF DebugLR}
1421
DebugLn('MUp "Button <> mbLeft" cursor=',IntToStr(Cursor),' RFlag=',BoolToStr(RFlag));
1464
DebugLnExit('TfrDesignerPage.MUp DONE: Button<>mbLeft');
1426
else DebugLn('MUp "Button = mbLeft" cursor=',IntToStr(Cursor),' RFlag=',BoolToStr(RFlag));
1469
{$IFDEF LCLQt}Invalidate;{$endif}
1431
1470
{$IFDEF LCLCarbon}Invalidate;{$endif}
1433
1472
if FDesigner.ShapeMode = smFrame then
3519
3620
DrawStatusPanel(StatusBar.Canvas, Rect);
3623
procedure TfrDesignerForm.DefineExtraPopupSelected(popup: TPopupMenu);
3627
m := TMenuItem.Create(Popup);
3631
m := TMenuItem.Create(Popup);
3632
m.Caption := sFRDesignerFormSelectSameClass;
3633
m.OnClick := @SelectSameClassClick;
3634
m.Tag := PtrInt(Objects[TopSelected]);
3638
procedure TfrDesignerForm.SelectSameClassClick(Sender: TObject);
3642
if Sender is TMenuItem then
3644
View := TfrView(TMenuItem(Sender).Tag);
3645
if Objects.IndexOf(View)>=0 then
3647
PageView.DrawPage(dmSelection);
3648
SelectSameClass(View);
3649
PageView.GetMultipleSelected;
3650
PageView.DrawPage(dmSelection);
3656
procedure TfrDesignerForm.SelectSameClass(View: TfrView);
3662
for i := 0 to Objects.Count - 1 do
3664
v := TfrView(Objects[i]);
3665
if v.ClassName=View.ClassName then
3673
// if AList is specified always process the list being objects selected or not
3674
// if AList is not specified, all objects are processed but check Selected state
3675
procedure TfrDesignerForm.ViewsAction(Views: TFpList; TheAction: TViewAction;
3676
Data: PtrInt; OnlySel:boolean=true; WithUndoAction:boolean=true;
3677
WithRedraw:boolean=true);
3682
if not assigned(TheAction) then
3690
for i:=List.Count-1 downto 0 do begin
3691
if (Views=nil) and OnlySel and not TfrView(List[i]).Selected then
3699
if WithUndoAction then
3700
AddUndoAction(acEdit);
3702
if WithRedraw then begin
3703
PageView.DrawPage(dmSelection);
3707
for i:=List.Count-1 downto 0 do begin
3708
if (Views=nil) and OnlySel and not TfrView(List[i]).Selected then
3710
TheAction(TfrView(List[i]), Data);
3714
PageView.Draw(TopSelected, ClipRgn);
3717
// data=0 remove all borders
3718
// data=1 set all borders
3719
// data=-1 toggle all borders
3720
procedure TfrDesignerForm.ToggleFrames(View: TfrView; Data: PtrInt);
3722
if (Data=0) or ((Data=-1) and (View.Frames<>[])) then
3725
if (Data=1) or ((Data=-1) and (View.Frames=[])) then
3726
View.Frames := [frbLeft, frbTop, frbRight, frbBottom];
3729
LastFrames := View.Frames;
3732
procedure TfrDesignerForm.DuplicateView(View: TfrView; Data: PtrInt);
3736
// check if view is unique instance band kind and if there is already one
3737
if (View is TfrBandView) and
3738
not (TfrBandView(View).BandType in [btMasterHeader..btSubDetailFooter,
3739
btGroupHeader, btGroupFooter])
3740
and frCheckBand(TfrBandView(View).BandType)
3744
t := frCreateObject(View.Typ, View.ClassName);
3745
TfrView(t).Assign(View);
3746
t.y := t.y + FDuplicateCount * FDupDeltaY;
3747
t.x := t.x + FDuplicateCount * FDupDeltaX;
3748
t.Selected := false;
3750
if CurReport.FindObject(t.Name) <> nil then
3756
procedure TfrDesignerForm.ResetDuplicateCount;
3758
FDuplicateCount := 0;
3759
FreeThenNil(FDuplicateList);
4253
procedure TfrDesignerForm.DuplicateSelection;
4261
if not DelEnabled then
4264
OldCount := Objects.Count;
4268
if FDuplicateList=nil then
4270
FDuplicateList := TFpList.Create;
4271
for i:=0 to OldCount-1 do
4272
if TfrView(Objects[i]).Selected then
4273
FDuplicateList.Add(Objects[i]);
4276
if (FDuplicateList.Count=0) then
4278
ResetDuplicateCount;
4282
Inc(FDuplicateCount);
4284
if FDuplicateCount=1 then
4287
// find reference rect in screen coords
4290
p := OldRect.TopLeft;
4291
q := OldRect.BottomRight;
4294
t := TfrView(Objects[TopSelected]);
4295
p := Point(t.x, t.y);
4296
q := point(t.x+t.dx, t.y+t.dy);
4298
p := PageView.ControlToScreen(p);
4299
q := PageView.ControlToScreen(q);
4301
// find duplicates delta based on current mouse cursor position
4302
FDupDeltaX := (q.x-p.x);
4303
FDupDeltaY := (q.y-p.y);
4304
with Mouse.CursorPos do
4307
FDupDeltaX := -FDupDeltaX
4313
FDupDeltaY := -FDupDeltaY
4320
ViewsAction(FDuplicateList, @DuplicateView, 0, false, false, false);
4322
if OldCount<>Objects.Count then
4325
PageView.GetMultipleSelected;
4327
AddUndoAction(acDuplication);
4329
Dec(FDuplicateCount);
4013
4332
procedure TfrDesignerForm.ObjInspRefresh;
4426
4745
procedure TfrDesignerForm.AddUndoAction(a: TfrUndoAction);
4431
4750
p: PfrUndoRec1;
4752
procedure AddCurrent;
4754
GetMem(p, SizeOf(TfrUndoRec1));
4433
4761
ClearRedoBuffer;
4435
4763
List := TFpList.Create;
4436
for i := 0 to Objects.Count - 1 do
4765
// last FDuplicateList.Count objectes were duplicated
4766
if a=acDuplication then
4767
j := Objects.Count - FDuplicateList.Count
4771
for i := j to Objects.Count - 1 do
4438
4773
t := TfrView(Objects[i]);
4439
if t.Selected or (a = acZOrder) then
4441
GetMem(p, SizeOf(TfrUndoRec1));
4775
acDuplication, acZOrder:
4783
if a=acDuplication then
4447
4786
AddAction(@FUndoBuffer, a, List);
5910
6252
{$IFDEF DebugLR}
5911
DebugLn('frSetGlyph(',colortostring(acolor),',',sb.name,',',IntToStr(n),')');
5912
DebugLn('ColorLocked=', dbgs(ColorLocked),' sb.tag=', dbgs(sb.tag));
6253
DebugLn('frSetGlyph(%s,%s,%d)',[colortostring(acolor),sb.Name,n]);
6254
DebugLn('ColorLocked=%s sb.tag=%s',[dbgs(ColorLocked),dbgs(sb.tag)]);