~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to components/lazreport/source/lr_desgn.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
13
13
interface
14
14
 
15
15
{$I lr_vers.inc}
16
 
 
17
16
{.$Define ExtOI} // External Custom Object inspector (Christian)
18
17
{.$Define StdOI} // External Standard Object inspector (Jesus)
19
18
{$define sbod}  // status bar owner draw
22
21
  Forms, Controls, Graphics, Dialogs,ComCtrls,
23
22
  ExtCtrls, Buttons, StdCtrls,Menus,
24
23
 
25
 
  LCLType,LCLIntf,LCLProc,GraphType,Printers,
 
24
  LCLType,LCLIntf,LCLProc,GraphType,Printers, ActnList,
26
25
 
27
26
  ObjectInspector, PropEdits,TypInfo,
28
27
  
52
51
  TfrReportUnits = (ruPixels, ruMM, ruInches);
53
52
  TfrShapeMode = (smFrame, smAll);
54
53
 
55
 
  TfrUndoAction = (acInsert, acDelete, acEdit, acZOrder);
 
54
  TfrUndoAction = (acInsert, acDelete, acEdit, acZOrder, acDuplication);
56
55
  PfrUndoObj = ^TfrUndoObj;
57
56
  TfrUndoObj = record
58
57
    Next: PfrUndoObj;
93
92
    View2  : TfrView;
94
93
  end;
95
94
 
 
95
  TViewAction = procedure(View: TFrView; Data:PtrInt) of object;
 
96
 
96
97
  { TfrObjectInspector }
97
98
  TfrObjectInspector = Class({$IFDEF EXTOI}TForm{$ELSE}TPanel{$ENDIF})
98
99
  private
107
108
 
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,
112
 
                  Y: Integer);
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,
 
113
                  {%H-}Y: Integer);
 
114
    procedure HeaderMUp(Sender: TOBject; {%H-}Button: TMouseButton;
 
115
                   {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
115
116
    {$ENDIF}
116
117
  protected
117
118
    procedure CMVisibleChanged(var TheMessage: TLMessage); message CM_VISIBLECHANGED;
146
147
    FDesigner: TfrDesignerForm;
147
148
    
148
149
    fOldFocusRect : TRect;
149
 
    fForm         : TfrDialogForm;
150
 
    
 
150
 
151
151
    procedure NormalizeRect(var r: TRect);
152
152
    procedure NormalizeCoord(t: TfrView);
153
153
    function FindNearestEdge(var x, y: Integer): Boolean;
163
163
    procedure DrawDialog;
164
164
 
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);
171
171
  protected
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;
174
175
  public
175
176
    constructor Create(AOwner: TComponent); override;
176
177
 
182
183
  { TfrDesignerForm }
183
184
 
184
185
  TfrDesignerForm = class(TfrReportDesigner)
 
186
    acDuplicate: TAction;
 
187
    acToggleFrames: TAction;
 
188
    actList: TActionList;
185
189
    frSpeedButton1: TSpeedButton;
186
190
    frSpeedButton2: TSpeedButton;
187
191
    frSpeedButton3: TSpeedButton;
354
358
    N43: TMenuItem;
355
359
    N44: TMenuItem;
356
360
    StB1: TSpeedButton;
 
361
    procedure acDuplicateExecute(Sender: TObject);
 
362
    procedure acToggleFramesExecute(Sender: TObject);
357
363
    procedure C2GetItems(Sender: TObject);
358
364
    procedure FormCreate(Sender: TObject);
359
365
    procedure FormDestroy(Sender: TObject);
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
423
 
      );
 
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);
455
460
    {$ELSE}
456
461
    ObjInsp  : TfrObjectInspector;
457
462
    {$ENDIF}
 
463
    procedure DuplicateSelection;
458
464
    procedure ObjInspSelect(Obj:TObject);
459
465
    procedure ObjInspRefresh;
460
466
 
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;
521
527
    {$ifdef sbod}
522
528
    procedure DrawStatusPanel(const ACanvas:TCanvas; const rect:  TRect);
523
529
    procedure StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
524
530
      const Rect: TRect);
525
531
    {$endif}
 
532
    procedure DefineExtraPopupSelected(popup: TPopupMenu);
 
533
    procedure SelectSameClassClick(Sender: TObject);
 
534
    procedure SelectSameClass(View: TfrView);
 
535
  private
 
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;
526
544
  public
527
545
    constructor Create(aOwner : TComponent); override;
528
546
    destructor Destroy; override;
537
555
    procedure ShowMemoEditor;
538
556
    procedure ShowEditor;
539
557
    procedure RedrawPage; override;
540
 
    procedure OnModify(sender: TObject);
 
558
    procedure OnModify({%H-}sender: TObject);
541
559
    function PointsToUnits(x: Integer): Double;  override;
542
560
    function UnitsToPoints(x: Double): Integer;  override;
543
561
    procedure MoveObjects(dx, dy: Integer; aResize: Boolean);
609
627
  GridBitmap         : TBitmap;     // for drawing grid in design time
610
628
  ColorLocked        : Boolean;     // true to avoid unwished color change
611
629
 
612
 
 
613
630
{----------------------------------------------------------------------------}
614
631
procedure AddRgn(var HR: HRGN; T: TfrView);
615
632
var
683
700
  //do nothing to avoid flicker
684
701
end;
685
702
 
 
703
procedure TfrDesignerPage.DoContextPopup(MousePos: TPoint; var Handled: Boolean
 
704
  );
 
705
begin
 
706
  Handled := true;
 
707
end;
 
708
 
686
709
procedure TfrDesignerPage.NormalizeCoord(t: TfrView);
687
710
begin
688
711
  if t.dx < 0 then
1037
1060
    Exit;
1038
1061
  end;
1039
1062
 
 
1063
  {$IFDEF DebugLR}
 
1064
  DebugLnEnter('TfrDesignerPage.Draw INIT N=%d AClipRgn=%d',[N,AClipRgn]);
 
1065
  {$ENDIF}
 
1066
 
1040
1067
  if AClipRgn = 0 then
1041
1068
  begin
1042
1069
    with Canvas.ClipRect do
1043
1070
      AClipRgn := CreateRectRgn(Left, Top, Right, Bottom);
1044
1071
  end;
1045
1072
 
1046
 
 
1047
 
  {$IFDEF DebugLR}
1048
 
  DebugLn('------------- Begin Draw() -------------');
1049
 
  {$ENDIF}
1050
 
 
1051
1073
  R:=CreateRectRgn(0, 0, Width, Height);
1052
1074
  for i:=Objects.Count-1 downto 0 do
1053
1075
  begin
1088
1110
    SelectClipRgn(Canvas.Handle, R);
1089
1111
  end;
1090
1112
 
1091
 
  {$IFDEF DebugLR}
1092
 
  DebugLn('------------- End Draw() -------------');
1093
 
  {$ENDIF}
1094
 
 
1095
1113
  CombineRgn(R, R, AClipRgn, RGN_AND);
1096
1114
 
1097
1115
  DrawBackground;
1098
1116
 
1099
1117
  DeleteObject(R);
1100
1118
  DeleteObject(AClipRgn);
 
1119
  if AClipRgn=ClipRgn then
 
1120
    ClipRgn := 0;
 
1121
 
1101
1122
  SelectClipRgn(Canvas.Handle, 0);
1102
1123
 
1103
1124
  if not Down then
1104
1125
    DrawPage(dmSelection);
1105
1126
 
 
1127
  {$IFDEF DebugLR}
 
1128
  DebugLnExit('TfrDesignerPage.Draw DONE');
 
1129
  {$ENDIF}
1106
1130
end;
1107
1131
 
1108
1132
procedure TfrDesignerPage.DrawPage(DrawMode: TfrDesignerDrawMode);
1216
1240
  p: TPoint;
1217
1241
begin
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)]);
1221
1245
  {$ENDIF}
1222
 
  if DFlag then
1223
 
  begin
1224
 
    DFlag := False;
1225
 
    Exit;
 
1246
 
 
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
 
1250
    {$IFDEF DebugLR}
 
1251
    DebugLnExit('TfrDesignerPage.MDown DONE: doubleclick expected');
 
1252
    {$ENDIF}
 
1253
    exit;
1226
1254
  end;
1227
 
  
 
1255
 
1228
1256
  if (Button = mbRight) and Down and RFlag then
1229
1257
    DrawFocusRect(OldRect);
1230
1258
  
1249
1277
      RightBottom := -1;
1250
1278
      MRFlag := False;
1251
1279
      FirstSelected := nil;
 
1280
      {$IFDEF DebugLR}
 
1281
      DebugLnExit('TfrDesignerPage.MDown DONE: Ctrl+Left o cursor=crCross');
 
1282
      {$ENDIF}
1252
1283
      Exit;
1253
1284
    end
1254
1285
    else if Cursor = crPencil then
1272
1303
            FirstSelected := nil;
1273
1304
            LastX := x;
1274
1305
            LastY := y;
 
1306
            {$IFDEF DebugLR}
 
1307
            DebugLnExit('TfrDesignerPage.MDown DONE: Left + cursor=crPencil');
 
1308
            {$ENDIF}
1275
1309
            Exit;
1276
1310
         end;
1277
1311
  end;
1328
1362
      begin
1329
1363
        RFlag := True;
1330
1364
        OldRect := Rect(x, y, x, y);
 
1365
        {$IFDEF DebugLR}
 
1366
        DebugLnExit('TfrDesignerPage.MDown DONE: Deselection o no selection');
 
1367
        {$ENDIF}
1331
1368
        Exit;
1332
1369
      end;
1333
1370
    end;
1334
1371
    
1335
1372
    GetMultipleSelected;
1336
 
    if not DontChange then
 
1373
    if not DontChange then begin
1337
1374
       FDesigner.SelectionChanged;
 
1375
       FDesigner.ResetDuplicateCount;
 
1376
    end;
1338
1377
  end;
1339
1378
  
1340
1379
  if SelNum = 0 then
1353
1392
  begin
1354
1393
    DrawPage(dmSelection);
1355
1394
    Down := False;
1356
 
    GetCursorPos(p);
 
1395
    GetCursorPos(p{%H-});
1357
1396
    //FDesigner.Popup1Popup(nil);
1358
1397
    
1359
1398
    FDesigner.Popup1.PopUp(p.X,p.Y);
1366
1405
           DrawPage(dmShape);
1367
1406
           
1368
1407
  {$IFDEF DebugLR}
1369
 
  DebugLn('TfrDesignerPage.MDown END');
 
1408
  DebugLnExit('TfrDesignerPage.MDown DONE');
1370
1409
  {$ENDIF}
1371
1410
end;
1372
1411
 
1415
1454
  end;
1416
1455
 
1417
1456
begin
 
1457
  {$IFDEF DebugLR}
 
1458
  DebugLnEnter('TfrDesignerPage.MUp INIT Button=%d Cursor=%d RFlag=%s',
 
1459
    [ord(Button),Cursor,dbgs(RFlag)]);
 
1460
  {$ENDIF}
1418
1461
  if Button <> mbLeft then
1419
1462
  begin
1420
1463
    {$IFDEF DebugLR}
1421
 
    DebugLn('MUp "Button <> mbLeft" cursor=',IntToStr(Cursor),' RFlag=',BoolToStr(RFlag));
 
1464
    DebugLnExit('TfrDesignerPage.MUp DONE: Button<>mbLeft');
1422
1465
    {$ENDIF}
1423
1466
    Exit;
1424
 
  {$IFDEF DebugLR}
1425
 
  end
1426
 
  else DebugLn('MUp "Button = mbLeft" cursor=',IntToStr(Cursor),' RFlag=',BoolToStr(RFlag));
1427
 
  {$ELSE}
1428
1467
  end;
1429
 
  {$ENDIF}
1430
1468
 
 
1469
  {$IFDEF LCLQt}Invalidate;{$endif}
1431
1470
  {$IFDEF LCLCarbon}Invalidate;{$endif}
1432
1471
  Down := False;
1433
1472
  if FDesigner.ShapeMode = smFrame then
1437
1476
  if Cursor = crCross then
1438
1477
  begin
1439
1478
    {$IFDEF DebugLR}
1440
 
    DebugLn('inserting a new object');
 
1479
    DebugLnEnter('Inserting a New Object INIT');
1441
1480
    {$ENDIF}
1442
1481
    Mode := mdSelect;
1443
1482
    DrawFocusRect(OldRect);
1461
1500
              begin
1462
1501
                if GetUnusedBand <> btNone then
1463
1502
                  CreateSection
1464
 
                else
 
1503
                else begin
 
1504
                  {$IFDEF DebugLR}
 
1505
                  DebugLnExit('Inserting a new object DONE: GetUnusedBand=btNone');
 
1506
                  DebugLnExit('TfrDesignerPage.MUp DONE: Inserting..');
 
1507
                  {$ENDIF}
1465
1508
                  Exit;
 
1509
                end;
1466
1510
              end
1467
1511
              else if Tag = gtSubReport then
1468
1512
                       CreateSubReport
1553
1597
        if EditAfterInsert then
1554
1598
          ShowEditor;
1555
1599
      end;
 
1600
 
 
1601
      {$IFDEF DebugLR}
 
1602
      DebugLn('Object inserted end');
 
1603
      {$ENDIF}
1556
1604
    end;
 
1605
 
1557
1606
    if not ObjRepeat then
1558
1607
      FDesigner.OB1.Down := True
1559
1608
    else
1560
1609
      DrawFocusRect(OldRect);
1561
1610
 
1562
1611
    {$IFDEF DebugLR}
1563
 
    DebugLn('Object inserted end');
 
1612
    DebugLnExit('Inserting a New Object DONE');
 
1613
    DebugLnExit('TfrDesignerPage.MUp DONE: Inserting ...');
1564
1614
    {$ENDIF}
1565
1615
    Exit;
1566
1616
  end;
1589
1639
    DrawSelection(t);
1590
1640
    FDesigner.SelectionChanged;
1591
1641
    FDesigner.AddUndoAction(acInsert);
 
1642
    {$IFDEF DebugLR}
 
1643
    DebugLnExit('TfrDesignerPage.MUp DONE: Line Drawing');
 
1644
    {$ENDIF}
1592
1645
    Exit;
1593
1646
  end;
1594
1647
 
1618
1671
    FDesigner.SelectionChanged;
1619
1672
    DrawPage(dmSelection);
1620
1673
    {$IFDEF DebugLR}
1621
 
    DebugLn('calculating which objects contains in frame (if user select it with mouse+Ctrl key)');
 
1674
    DebugLnExit('TfrDesignerPage.MUp DONE: objects contained in frame');
1622
1675
    {$ENDIF}
1623
1676
    Exit;
1624
1677
  end;
1639
1692
    GetMultipleSelected;
1640
1693
    Draw(TopSelected, ClipRgn);
1641
1694
    {$IFDEF DebugLR}
1642
 
    DebugLn('splitting');
 
1695
    DebugLnExit('TfrDesignerPage.MUp DONE: Splitting');
1643
1696
    {$ENDIF}
1644
1697
    Exit;
1645
1698
  end;
1649
1702
  begin
1650
1703
    Draw(TopSelected, ClipRgn);
1651
1704
    {$IFDEF DebugLR}
1652
 
    DebugLn('resizing several objects');
 
1705
    DebugLnExit('TfrDesignerPage.MUp DONE: resizing several objects');
1653
1706
    {$ENDIF}
1654
1707
    Exit;
1655
1708
  end;
1685
1738
 
1686
1739
  Moved := False;
1687
1740
  CT := ctNone;
 
1741
  {$IFDEF DebugLR}
 
1742
  DebugLnExit('TfrDesignerPage.MUp DONE');
 
1743
  {$ENDIF}
1688
1744
end;
1689
1745
 
1690
1746
procedure TfrDesignerPage.MMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
1715
1771
  end;
1716
1772
begin
1717
1773
  {$IFDEF DebugLR}
1718
 
  DebugLn('TfrDesignerPage.MMove(X=',dbgs(x),',Y=',dbgs(y),'  INIT');
 
1774
  DebugLnEnter('TfrDesignerPage.MMove(X=%d,Y=%d)  INIT',[x,y]);
1719
1775
  {$ENDIF}
1720
1776
  Moved := True;
1721
1777
  w := 2;
1722
1778
 
1723
 
  {$ifdef LCLCarbon}if Down then Invalidate;{$endif}
1724
 
 
1725
1779
  if FirstChange and Down and not RFlag then
1726
1780
  begin
1727
1781
    kx := x - LastX;
1762
1816
  end;
1763
1817
 
1764
1818
  {$IFDEF DebugLR}
1765
 
  if mode=mdInsert then
1766
 
    DebugLn('  Mode=mdInsert Down=', dbgs(down))
1767
 
  else
1768
 
    DebugLn('  Mode=mdSelect Down=', dbgs(down));
 
1819
  DebugLn('Mode Insert=%s Down=%s',[dbgs(Mode=mdInsert),dbgs(Down)]);
1769
1820
  {$ENDIF}
1770
1821
 
1771
1822
  if (Mode = mdInsert) and not Down then
1777
1828
    ShowSizes := True;
1778
1829
    FDesigner.UpdateStatus;
1779
1830
    ShowSizes := False;
 
1831
    {$IFDEF DebugLR}
 
1832
    DebugLnExit('TfrDesignerPage.MMove DONE: Mode Insert and not Down');
 
1833
    {$ENDIF}
1780
1834
    Exit;
1781
1835
  end;
1782
1836
 
1809
1863
    if Cursor = crCross then
1810
1864
      FDesigner.UpdateStatus;
1811
1865
    ShowSizes := False;
 
1866
    {$IFDEF DebugLR}
 
1867
    DebugLnExit('TfrDesignerPage.MMove DONE: DOWN and RFLag (sel alot of objs)');
 
1868
    {$ENDIF}
1812
1869
    Exit;
1813
1870
  end;
1814
1871
  
1817
1874
  begin
1818
1875
    kx := x - LastX;
1819
1876
    ky := y - LastY;
1820
 
    if FDesigner.GridAlign and not GridCheck then Exit;
 
1877
    if FDesigner.GridAlign and not GridCheck then begin
 
1878
      {$IFDEF DebugLR}
 
1879
      DebugLnExit('TfrDesignerPage.MMove DONE: not gridcheck and gridalign');
 
1880
      {$ENDIF}
 
1881
      Exit;
 
1882
    end;
1821
1883
    DrawRectLine(OldRect);
1822
1884
    OldRect := Rect(OldRect.Left, OldRect.Top, OldRect.Right + kx, OldRect.Bottom + ky);
1823
1885
    DrawRectLine(OldRect);
1824
1886
    Inc(LastX, kx);
1825
1887
    Inc(LastY, ky);
 
1888
    {$IFDEF DebugLR}
 
1889
    DebugLnExit('TfrDesignerPage.MMove DONE: Line drawing');
 
1890
    {$ENDIF}
1826
1891
    Exit;
1827
1892
  end;
1828
1893
 
1880
1945
  begin
1881
1946
    kx := x - LastX;
1882
1947
    ky := 0;
1883
 
    if FDesigner.GridAlign and not GridCheck then Exit;
 
1948
    if FDesigner.GridAlign and not GridCheck then begin
 
1949
      {$IFDEF DebugLR}
 
1950
      DebugLnExit('TfrDesignerPage.MMove DONE: Splitting not grid check');
 
1951
      {$ENDIF}
 
1952
      Exit;
 
1953
    end;
1884
1954
    with SplitInfo do
1885
1955
    begin
1886
1956
      DrawHSplitter(SplRect);
1888
1958
      DrawHSplitter(SplRect);
1889
1959
    end;
1890
1960
    Inc(LastX, kx);
 
1961
    {$IFDEF DebugLR}
 
1962
    DebugLnExit('TfrDesignerPage.MMove DONE: Splitting');
 
1963
    {$ENDIF}
1891
1964
    Exit;
1892
1965
  end;
1893
1966
  
1896
1969
  begin
1897
1970
    kx := x - LastX;
1898
1971
    ky := y - LastY;
1899
 
    if FDesigner.GridAlign and not GridCheck then Exit;
 
1972
    if FDesigner.GridAlign and not GridCheck then begin
 
1973
      {$IFDEF DebugLR}
 
1974
      DebugLnExit('TfrDesignerPage.MMove DONE: sizing seveal, not gridcheck');
 
1975
      {$ENDIF}
 
1976
      Exit;
 
1977
    end;
1900
1978
 
1901
1979
    if FDesigner.ShapeMode = smFrame then
1902
1980
      DrawPage(dmShape)
1941
2019
    Inc(LastX, kx);
1942
2020
    Inc(LastY, ky);
1943
2021
    FDesigner.UpdateStatus;
 
2022
    {$IFDEF DebugLR}
 
2023
    DebugLnExit('TfrDesignerPage.MMove DONE: Sizing several objects');
 
2024
    {$ENDIF}
1944
2025
    Exit;
1945
2026
  end;
1946
2027
  
1949
2030
  begin
1950
2031
    kx := x - LastX;
1951
2032
    ky := y - LastY;
1952
 
    if FDesigner.GridAlign and not GridCheck then Exit;
 
2033
    if FDesigner.GridAlign and not GridCheck then begin
 
2034
      {$IFDEF DebugLR}
 
2035
      DebugLnExit('TfrDesignerPage.MMove DONE: moving');
 
2036
      {$ENDIF}
 
2037
      Exit;
 
2038
    end;
1953
2039
    if FirstBandMove and (SelNum = 1) and ((kx <> 0) or (ky <> 0)) and
1954
2040
      not (ssAlt in Shift) then
1955
2041
    begin
1994
2080
  begin
1995
2081
    kx := x - LastX;
1996
2082
    ky := y - LastY;
1997
 
    if FDesigner.GridAlign and not GridCheck then Exit;
 
2083
    if FDesigner.GridAlign and not GridCheck then begin
 
2084
      {$IFDEF DebugLR}
 
2085
      DebugLnExit('TfrDesignerPage.MMove DONE: resizing');
 
2086
      {$ENDIF}
 
2087
      Exit;
 
2088
    end;
1998
2089
    
1999
2090
    t := TfrView(Objects[TopSelected]);
2000
2091
    if FDesigner.ShapeMode = smFrame then
2093
2184
    Inc(LastY, ky);
2094
2185
  end;
2095
2186
  {$IFDEF DebugLR}
2096
 
  DebugLn('TfrDesignerPage.MMove END');
 
2187
  DebugLnExit('TfrDesignerPage.MMove END');
2097
2188
  {$ENDIF}
2098
2189
end;
2099
2190
 
2100
2191
procedure TfrDesignerPage.DClick(Sender: TObject);
2101
2192
begin
 
2193
  {$IFDEF DebugLR}
 
2194
  DebugLnEnter('TfrDesignerPage.DClick INIT DFlag=%s',[dbgs(DFlag)]);
 
2195
  {$ENDIF}
2102
2196
  Down := False;
2103
2197
  if SelNum = 0 then
2104
2198
  begin
2109
2203
  begin
2110
2204
    DFlag := True;
2111
2205
    FDesigner.ShowEditor;
2112
 
  end
2113
 
  else Exit;
 
2206
  end;
 
2207
  {$IFDEF DebugLR}
 
2208
  DebugLnExit('TfrDesignerPage.DClick DONE DFlag=%s',[dbgs(DFlag)]);
 
2209
  {$ENDIF}
2114
2210
end;
2115
2211
 
2116
2212
procedure TfrDesignerPage.MoveResize(Kx, Ky: Integer; UseFrames,AResize: boolean);
2155
2251
    DeleteObject(hr1);
2156
2252
    Draw(10000, hr);
2157
2253
  end;
 
2254
  {$IFDEF LCLQt}Invalidate;{$endif}
 
2255
  {$IFDEF LCLCarbon}Invalidate;{$endif}
2158
2256
end;
2159
2257
 
2160
2258
procedure TfrDesignerPage.CMMouseLeave(var Message: TLMessage);
2187
2285
 
2188
2286
function EnumFontsProc(
2189
2287
  var LogFont: TEnumLogFontEx;
2190
 
  var Metric: TNewTextMetricEx;
 
2288
  var {%H-}Metric: TNewTextMetricEx;
2191
2289
  FontType: Longint;
2192
 
  Data: LParam):LongInt; stdcall;
 
2290
  {%H-}Data: LParam):LongInt; stdcall;
2193
2291
var
2194
2292
  S: String;
2195
2293
begin
2283
2381
  for i := 0 to frAddInsCount - 1 do
2284
2382
  with frAddIns[i] do
2285
2383
  begin
 
2384
    if Assigned(frAddIns[i].InitializeProc) then
 
2385
      frAddIns[i].InitializeProc;
2286
2386
    RegisterObject(ButtonBMP, ButtonHint, Integer(gtAddIn) + i);
2287
2387
  end;
2288
2388
 
2453
2553
  end;
2454
2554
end;
2455
2555
 
 
2556
procedure TfrDesignerForm.acDuplicateExecute(Sender: TObject);
 
2557
begin
 
2558
  DuplicateSelection;
 
2559
end;
 
2560
 
 
2561
procedure TfrDesignerForm.acToggleFramesExecute(Sender: TObject);
 
2562
begin
 
2563
  if DelEnabled then
 
2564
    ViewsAction(nil, @ToggleFrames, -1);
 
2565
end;
 
2566
 
2456
2567
procedure TfrDesignerForm.FormShow(Sender: TObject);
2457
2568
begin
2458
2569
  Screen.Cursors[crPencil] := LoadCursorFromLazarusREsource('FR_PENCIL');
2983
3094
    DoClick(E1);
2984
3095
    Key := 0;
2985
3096
  end;
2986
 
  if (Chr(Key) = 'F') and (ssCtrl in Shift) and DelEnabled then
2987
 
  begin
2988
 
    FrB5.Click;
2989
 
    Key := 0;
2990
 
  end;
2991
 
  if (Chr(Key) = 'D') and (ssCtrl in Shift) and DelEnabled then
2992
 
  begin
2993
 
    FrB6.Click;
2994
 
    Key := 0;
2995
 
  end;
2996
3097
  if (Chr(Key) = 'G') and (ssCtrl in Shift) then
2997
3098
  begin
2998
3099
    ShowGrid := not ShowGrid;
3519
3620
    DrawStatusPanel(StatusBar.Canvas, Rect);
3520
3621
end;
3521
3622
 
 
3623
procedure TfrDesignerForm.DefineExtraPopupSelected(popup: TPopupMenu);
 
3624
var
 
3625
  m: TMenuItem;
 
3626
begin
 
3627
  m := TMenuItem.Create(Popup);
 
3628
  m.Caption := '-';
 
3629
  Popup.Items.Add(m);
 
3630
 
 
3631
  m := TMenuItem.Create(Popup);
 
3632
  m.Caption := sFRDesignerFormSelectSameClass;
 
3633
  m.OnClick := @SelectSameClassClick;
 
3634
  m.Tag := PtrInt(Objects[TopSelected]);
 
3635
  Popup.Items.Add(m);
 
3636
end;
 
3637
 
 
3638
procedure TfrDesignerForm.SelectSameClassClick(Sender: TObject);
 
3639
var
 
3640
  View: TfrView;
 
3641
begin
 
3642
  if Sender is TMenuItem then
 
3643
  begin
 
3644
    View := TfrView(TMenuItem(Sender).Tag);
 
3645
    if Objects.IndexOf(View)>=0 then
 
3646
    begin
 
3647
      PageView.DrawPage(dmSelection);
 
3648
      SelectSameClass(View);
 
3649
      PageView.GetMultipleSelected;
 
3650
      PageView.DrawPage(dmSelection);
 
3651
      SelectionChanged;
 
3652
    end;
 
3653
  end;
 
3654
end;
 
3655
 
 
3656
procedure TfrDesignerForm.SelectSameClass(View: TfrView);
 
3657
var
 
3658
  i: Integer;
 
3659
  v: TfrView;
 
3660
begin
 
3661
  SelNum := 0;
 
3662
  for i := 0 to Objects.Count - 1 do
 
3663
  begin
 
3664
    v := TfrView(Objects[i]);
 
3665
    if v.ClassName=View.ClassName then
 
3666
    begin
 
3667
      v.Selected := True;
 
3668
      Inc(SelNum);
 
3669
    end;
 
3670
  end;
 
3671
end;
 
3672
 
 
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);
 
3678
var
 
3679
  i, n: Integer;
 
3680
  List: TFpList;
 
3681
begin
 
3682
  if not assigned(TheAction) then
 
3683
    exit;
 
3684
 
 
3685
 List := Views;
 
3686
  if List=nil then
 
3687
   List := Objects;
 
3688
 
 
3689
  n := 0;
 
3690
  for i:=List.Count-1 downto 0 do begin
 
3691
    if (Views=nil) and OnlySel and not TfrView(List[i]).Selected then
 
3692
      continue;
 
3693
    inc(n);
 
3694
  end;
 
3695
 
 
3696
  if n=0 then
 
3697
    exit;
 
3698
 
 
3699
  if WithUndoAction then
 
3700
    AddUndoAction(acEdit);
 
3701
 
 
3702
  if WithRedraw then begin
 
3703
    PageView.DrawPage(dmSelection);
 
3704
    GetRegion;
 
3705
  end;
 
3706
 
 
3707
  for i:=List.Count-1 downto 0 do begin
 
3708
    if (Views=nil) and OnlySel and not TfrView(List[i]).Selected then
 
3709
      continue;
 
3710
    TheAction(TfrView(List[i]), Data);
 
3711
  end;
 
3712
 
 
3713
  if WithRedraw then
 
3714
    PageView.Draw(TopSelected, ClipRgn);
 
3715
end;
 
3716
 
 
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);
 
3721
begin
 
3722
  if (Data=0) or ((Data=-1) and (View.Frames<>[])) then
 
3723
    View.Frames := []
 
3724
  else
 
3725
  if (Data=1) or ((Data=-1) and (View.Frames=[])) then
 
3726
    View.Frames := [frbLeft, frbTop, frbRight, frbBottom];
 
3727
 
 
3728
  if SelNum=1 then
 
3729
    LastFrames := View.Frames;
 
3730
end;
 
3731
 
 
3732
procedure TfrDesignerForm.DuplicateView(View: TfrView; Data: PtrInt);
 
3733
var
 
3734
  t: TfrView;
 
3735
begin
 
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)
 
3741
  then
 
3742
    exit;
 
3743
 
 
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;
 
3749
 
 
3750
  if CurReport.FindObject(t.Name) <> nil then
 
3751
    t.CreateUniqueName;
 
3752
 
 
3753
  Objects.Add(t);
 
3754
end;
 
3755
 
 
3756
procedure TfrDesignerForm.ResetDuplicateCount;
 
3757
begin
 
3758
  FDuplicateCount := 0;
 
3759
  FreeThenNil(FDuplicateList);
 
3760
end;
 
3761
 
3522
3762
{$endif}
3523
3763
 
3524
3764
{$HINTS ON}
3604
3844
  t: TfrView;
3605
3845
begin
3606
3846
  {$IFDEF DebugLR}
3607
 
  debugLn('TfrDesignerForm.SelectionChanged INIT, SelNum=',dbgs(SelNum));
 
3847
  debugLnEnter('TfrDesignerForm.SelectionChanged INIT, SelNum=%d',[SelNum]);
3608
3848
  {$ENDIF}
3609
3849
  Busy := True;
3610
3850
  ColorSelector.Hide;
3617
3857
    with t do
3618
3858
    begin
3619
3859
      {$IFDEF DebugLR}
3620
 
      DebugLn('selectionchanged 1');
 
3860
      DebugLn('Not a band');
3621
3861
      {$ENDIF}
3622
3862
      FrB1.Down := (frbTop in Frames);
3623
3863
      FrB2.Down := (frbLeft in Frames);
3656
3896
  else if SelNum > 1 then
3657
3897
  begin
3658
3898
    {$IFDEF DebugLR}
3659
 
    DebugLn('selectionchanged 2');
 
3899
    DebugLn('Multiple selection');
3660
3900
    {$ENDIF}
3661
3901
 
3662
3902
    BUp(FrB1);
3681
3921
  ShowContent;
3682
3922
  ActiveControl := nil;
3683
3923
  {$IFDEF DebugLR}
3684
 
  debugLn('TfrDesignerForm.SelectionChanged END, SelNum=',dbgs(SelNum));
 
3924
  debugLnExit('TfrDesignerForm.SelectionChanged END, SelNum=%d',[SelNum]);
3685
3925
  {$ENDIF}
3686
3926
end;
3687
3927
 
4010
4250
  {$ENDIF}
4011
4251
end;
4012
4252
 
 
4253
procedure TfrDesignerForm.DuplicateSelection;
 
4254
var
 
4255
  t: TfrView;
 
4256
  q: TPoint;
 
4257
  p: TPoint;
 
4258
  i: Integer;
 
4259
  OldCount: Integer;
 
4260
begin
 
4261
  if not DelEnabled then
 
4262
    exit;
 
4263
 
 
4264
  OldCount := Objects.Count;
 
4265
  if OldCount=0 then
 
4266
    exit;
 
4267
 
 
4268
  if FDuplicateList=nil then
 
4269
  begin
 
4270
    FDuplicateList := TFpList.Create;
 
4271
    for i:=0 to OldCount-1 do
 
4272
      if TfrView(Objects[i]).Selected then
 
4273
        FDuplicateList.Add(Objects[i]);
 
4274
  end;
 
4275
 
 
4276
  if (FDuplicateList.Count=0) then
 
4277
  begin
 
4278
    ResetDuplicateCount;
 
4279
    exit;
 
4280
  end;
 
4281
 
 
4282
  Inc(FDuplicateCount);
 
4283
 
 
4284
  if FDuplicateCount=1 then
 
4285
  begin
 
4286
 
 
4287
    // find reference rect in screen coords
 
4288
    if SelNum>1 then
 
4289
    begin
 
4290
      p := OldRect.TopLeft;
 
4291
      q := OldRect.BottomRight;
 
4292
    end else
 
4293
    begin
 
4294
      t := TfrView(Objects[TopSelected]);
 
4295
      p := Point(t.x, t.y);
 
4296
      q := point(t.x+t.dx, t.y+t.dy);
 
4297
    end;
 
4298
    p := PageView.ControlToScreen(p);
 
4299
    q := PageView.ControlToScreen(q);
 
4300
 
 
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
 
4305
    begin
 
4306
      if x < p.x then
 
4307
        FDupDeltaX := -FDupDeltaX
 
4308
      else
 
4309
      if x < q.x then
 
4310
        FDupDeltaX := 0;
 
4311
 
 
4312
      if y < p.y then
 
4313
        FDupDeltaY := -FDupDeltaY
 
4314
      else
 
4315
      if y < q.y then
 
4316
        FDupDeltaY := 0;
 
4317
    end;
 
4318
  end;
 
4319
 
 
4320
  ViewsAction(FDuplicateList, @DuplicateView, 0, false, false, false);
 
4321
 
 
4322
  if OldCount<>Objects.Count then
 
4323
  begin
 
4324
    SendBandsToDown;
 
4325
    PageView.GetMultipleSelected;
 
4326
    RedrawPage;
 
4327
    AddUndoAction(acDuplication);
 
4328
  end else
 
4329
    Dec(FDuplicateCount);
 
4330
end;
 
4331
 
4013
4332
procedure TfrDesignerForm.ObjInspRefresh;
4014
4333
begin
4015
4334
  {$IFDEF STDOI}
4425
4744
 
4426
4745
procedure TfrDesignerForm.AddUndoAction(a: TfrUndoAction);
4427
4746
var
4428
 
  i: Integer;
 
4747
  i,j: Integer;
4429
4748
  t: TfrView;
4430
4749
  List: TFpList;
4431
4750
  p: PfrUndoRec1;
 
4751
 
 
4752
  procedure AddCurrent;
 
4753
  begin
 
4754
    GetMem(p, SizeOf(TfrUndoRec1));
 
4755
    p^.ObjPtr := t;
 
4756
    p^.Int := i;
 
4757
    List.Add(p);
 
4758
  end;
 
4759
 
4432
4760
begin
4433
4761
  ClearRedoBuffer;
4434
4762
 
4435
4763
  List := TFpList.Create;
4436
 
  for i := 0 to Objects.Count - 1 do
 
4764
 
 
4765
  // last FDuplicateList.Count objectes were duplicated
 
4766
  if a=acDuplication then
 
4767
    j := Objects.Count - FDuplicateList.Count
 
4768
  else
 
4769
    j := 0;
 
4770
 
 
4771
  for i := j to Objects.Count - 1 do
4437
4772
  begin
4438
4773
    t := TfrView(Objects[i]);
4439
 
    if t.Selected or (a = acZOrder) then
4440
 
    begin
4441
 
      GetMem(p, SizeOf(TfrUndoRec1));
4442
 
      p^.ObjPtr := t;
4443
 
      p^.Int := i;
4444
 
      List.Add(p);
 
4774
    case a of
 
4775
      acDuplication, acZOrder:
 
4776
        AddCurrent;
 
4777
      else
 
4778
        if t.Selected then
 
4779
          AddCurrent;
4445
4780
    end;
4446
4781
  end;
 
4782
 
 
4783
  if a=acDuplication then
 
4784
    a := acInsert;
 
4785
 
4447
4786
  AddAction(@FUndoBuffer, a, List);
4448
4787
  List.Free;
4449
4788
end;
4963
5302
      ruInches: RB8.Checked := True;
4964
5303
    end;
4965
5304
    
4966
 
    CB3.Checked := not GrayedButtons;
 
5305
    //CB3.Checked := not GrayedButtons;
4967
5306
    CB4.Checked := EditAfterInsert;
4968
5307
    CB5.Checked := ShowBandTitles;
4969
5308
 
4987
5326
        Units := ruMM
4988
5327
      else
4989
5328
        Units := ruInches;
4990
 
      GrayedButtons := not CB3.Checked;
 
5329
      //GrayedButtons := not CB3.Checked;
4991
5330
      EditAfterInsert := CB4.Checked;
4992
5331
      ShowBandTitles := CB5.Checked;
4993
5332
      RedrawPage;
5048
5387
 
5049
5388
  while Popup1.Items.Count > 7 do
5050
5389
    Popup1.Items.Delete(7);
5051
 
    
 
5390
 
5052
5391
  if SelNum = 1 then
5053
 
    TfrView(Objects[TopSelected]).DefinePopupMenu(Popup1)
 
5392
  begin
 
5393
    DefineExtraPopupSelected(Popup1);
 
5394
    TfrView(Objects[TopSelected]).DefinePopupMenu(Popup1);
 
5395
  end
5054
5396
  else
5055
5397
    if SelNum > 1 then
5056
5398
    begin
5146
5488
var
5147
5489
  p: TPoint;
5148
5490
begin
5149
 
  GetCursorPos(p);
 
5491
  GetCursorPos(p{%H-});
5150
5492
  
5151
5493
  if Button = mbRight then
5152
5494
    Popup2.PopUp(p.X,p.Y);
5283
5625
  GridAlign := True;
5284
5626
  ShowGrid := False; //True;
5285
5627
  Units := TfrReportUnits(0);
5286
 
  GrayedButtons := True; //False;
 
5628
  //GrayedButtons := True; //False;
5287
5629
  EditAfterInsert := True;
5288
5630
  ShapeMode := TfrShapeMode(1);
5289
5631
 
5524
5866
end;
5525
5867
 
5526
5868
procedure TfrDesignerForm.WndProc(var Message: TLMessage);
5527
 
var
5528
 
  MenuItem: TMenuItem;
5529
 
  CCanvas: TCanvas;
 
5869
//var
 
5870
  //MenuItem: TMenuItem;
 
5871
  //CCanvas: TCanvas;
5530
5872
 
5531
5873
  function FindItem(ItemId: Integer): TMenuItem;
5532
5874
  begin
5908
6250
  i : Integer;
5909
6251
begin
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)]);
5913
6255
  {$ENDIF}
5914
6256
  B:=sb.Glyph;
5915
6257
  b.Width := 32;
5948
6290
  begin
5949
6291
    t := TfrView(Objects[i]);
5950
6292
    {$IFDEF DebugLR}
5951
 
    DebugLn('frSetGlyph: TopSelected=', t.Name);
 
6293
    DebugLn('frSetGlyph: TopSelected=%s', [t.Name]);
5952
6294
    {$ENDIF}
5953
6295
 
5954
6296
    Case Sb.Tag of
6294
6636
    Select(Objects);
6295
6637
  end;
6296
6638
  {$IFDEF DebugLR}
6297
 
  debugLn('TfrObjectInspector.CMVisibleChanged: ', BooLTOStr(Visible));
 
6639
  debugLn('TfrObjectInspector.CMVisibleChanged: %s', [dbgs(Visible)]);
6298
6640
  {$ENDIF}
6299
6641
end;
6300
6642
 
6442
6784
var
6443
6785
  i      : Integer;
6444
6786
  NewSel : TPersistentSelectionList;
6445
 
  frDsg: TfrDesignerForm;
6446
6787
begin
6447
6788
  if Objects.Count <> fcboxObjList.Items.Count then
6448
6789
  begin