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

« back to all changes in this revision

Viewing changes to lcl/interfaces/carbon/carboncanvas.pp

  • 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:
1
 
{ $Id: carboncanvas.pp 28699 2010-12-12 20:05:49Z dmitry $
2
 
                  -----------------------------------------
 
1
{                 -----------------------------------------
3
2
                  carboncanvas.pp  -  Carbon device context
4
3
                  -----------------------------------------
5
4
 
57
56
 
58
57
    ROP2: Integer;
59
58
    PenPos: TPoint;
 
59
 
 
60
    WindowOfs: TPoint;
 
61
    ViewportOfs: TPoint;
 
62
 
 
63
    isClipped: Boolean;
 
64
    ClipShape: HIShapeRef;
60
65
  end;
61
66
  
62
67
  TCarbonBitmapContext = class;
83
88
    
84
89
    FSavedDCList: TFPObjectList;
85
90
    FTextFractional: Boolean;
86
 
    fViewPortOfs: TPoint;
87
 
    fWindowOfs: TPoint;
 
91
    FViewPortOfs,
 
92
    FWindowOfs: TPoint;
88
93
 
89
94
    isClipped : Boolean;
90
95
 
101
106
    function SaveDCData: TCarbonDCData; virtual;
102
107
    procedure RestoreDCData(const AData: TCarbonDCData); virtual;
103
108
    procedure ExcludeClipRect(Left, Top, Right, Bottom: Integer);
 
109
    procedure ApplyTransform(Trans: CGAffineTransform);
 
110
    procedure ClearClipping;
104
111
  public
105
112
    constructor Create;
106
113
    destructor Destroy; override;
127
134
    procedure Frame3D(var ARect: TRect; const FrameWidth: integer; const Style: TBevelCut);
128
135
    function GetClipRect: TRect;
129
136
    function GetLineLastPixelPos(PrevPos, NewPos: TPoint): TPoint;
130
 
    function GetPixel(X, Y: Integer): TGraphicsColor; virtual;
 
137
    function GetPixel({%H-}X, {%H-}Y: Integer): TGraphicsColor; virtual;
131
138
    function GetTextExtentPoint(Str: PChar; Count: Integer; var Size: TSize): Boolean;
132
139
    function GetTextMetrics(var TM: TTextMetric): Boolean;
133
140
    procedure InvertRectangle(X1, Y1, X2, Y2: Integer);
139
146
    procedure SetPixel(X, Y: Integer; AColor: TGraphicsColor);
140
147
    function StretchDraw(X, Y, Width, Height: Integer; SrcDC: TCarbonBitmapContext;
141
148
      XSrc, YSrc, SrcWidth, SrcHeight: Integer; Msk: TCarbonBitmap; XMsk,
142
 
      YMsk: Integer; Rop: DWORD): Boolean;
 
149
      YMsk: Integer; {%H-}Rop: DWORD): Boolean;
143
150
    function SetClipRegion(AClipRegion: TCarbonRegion; Mode: Integer): Integer;
144
151
    function CopyClipRegion(ADstRegion: TCarbonRegion): Integer;
145
152
 
146
153
    procedure UpdateContextOfs(const AWindowOfs, AViewOfs: TPoint);
147
154
    procedure SetWindowOfs(const AWindowOfs: TPoint);
148
155
    procedure SetViewPortOfs(const AViewOfs: TPoint);
 
156
    function GetLogicalOffset: TPoint; override;
149
157
  public
150
158
    property Size: TPoint read GetSize;
151
159
 
165
173
    property PenPos: TPoint read FPenPos write FPenPos;
166
174
    
167
175
    property TextFractional: Boolean read FTextFractional write FTextFractional;
168
 
    property WindowOfs: TPoint read fWindowOfs write SetWindowOfs;
169
 
    property ViewPortOfs: TPoint read fViewPortOfs write SetViewPortOfs;
 
176
    property WindowOfs: TPoint read FWindowOfs write SetWindowOfs;
 
177
    property ViewPortOfs: TPoint read FViewPortOfs write SetViewPortOfs;
170
178
  end;
171
179
 
172
180
  { TCarbonScreenContext }
257
265
 ------------------------------------------------------------------------------}
258
266
procedure TCarbonDeviceContext.SetBkColor(AValue: TColor);
259
267
begin
260
 
  AValue := ColorToRGB(AValue);
 
268
  AValue := TColor(ColorToRGB(AValue));
261
269
  FBkColor := AValue;
262
270
  FBkBrush.SetColor(AValue, BkMode = OPAQUE);
263
271
end;
397
405
 ------------------------------------------------------------------------------}
398
406
procedure TCarbonDeviceContext.SetTextColor(AValue: TColor);
399
407
begin
400
 
  AValue := ColorToRGB(AValue);
 
408
  AValue := TColor(ColorToRGB(AValue));
401
409
  FTextColor := AValue;
402
410
  TextBrush.SetColor(AValue, True);
403
411
end;
497
505
 ------------------------------------------------------------------------------}
498
506
function TCarbonDeviceContext.SaveDC: Integer;
499
507
begin
500
 
  if isClipped then
501
 
    CGContextRestoreGState(CGContext); // clip rect is on top of the state stack!
 
508
  ClearClipping;
502
509
 
503
510
  Result := 0;
504
511
  if CGContext = nil then
516
523
    DebugLn('TCarbonDeviceContext.SaveDC Result: ', DbgS(Result));
517
524
  {$ENDIF}
518
525
  
519
 
  if isClipped then 
 
526
  if isClipped then
520
527
  begin
521
528
    CGContextSaveGState(CGContext);
522
529
    FClipRegion.Apply(Self);
532
539
 ------------------------------------------------------------------------------}
533
540
function TCarbonDeviceContext.RestoreDC(ASavedDC: Integer): Boolean;
534
541
begin
535
 
  if isClipped then CGContextRestoreGState(CGContext);
536
 
  
 
542
  ClearClipping;
 
543
 
537
544
  Result := False;
538
545
  if (FSavedDCList = nil) or (ASavedDC <= 0) or (ASavedDC > FSavedDCList.Count) then
539
546
  begin
565
572
  {$ENDIF}
566
573
  
567
574
  if FSavedDCList.Count = 0 then FreeAndNil(FSavedDCList);
568
 
  
569
 
  
570
 
  if isClipped then 
 
575
 
 
576
 
 
577
  if isClipped then
571
578
  begin
572
 
    // should clip be restored?
573
 
    isClipped:=false;
574
 
    FClipRegion.Shape := HIShapeCreateEmpty;
 
579
    CGContextSaveGState(CGContext);
 
580
    FClipRegion.Apply(Self);
575
581
  end;
576
582
end;
577
583
 
597
603
 
598
604
  Result.ROP2 := FROP2;
599
605
  Result.PenPos := FPenPos;
 
606
 
 
607
  Result.WindowOfs := FWindowOfs;
 
608
  Result.ViewportOfs := FViewportOfs;
 
609
 
 
610
  Result.isClipped := isClipped;
 
611
  Result.ClipShape := FClipRegion.GetShapeCopy;
600
612
end;
601
613
 
602
614
{------------------------------------------------------------------------------
624
636
      AData.CurrentBrush.Select;
625
637
  end;
626
638
  FCurrentBrush := AData.CurrentBrush;
 
639
  FCurrentBrush.Apply(Self);
627
640
  
628
641
  if (FCurrentPen <> AData.CurrentPen) then
629
642
  begin
633
646
      AData.CurrentPen.Select;
634
647
  end;
635
648
  FCurrentPen := AData.CurrentPen;
 
649
  FCurrentPen.Apply(Self);
636
650
  
637
651
  if (FCurrentRegion <> AData.CurrentRegion) then
638
652
  begin
652
666
 
653
667
  FROP2 := AData.ROP2;
654
668
  FPenPos := AData.PenPos;
 
669
 
 
670
  FWindowOfs := AData.WindowOfs;
 
671
  FViewportOfs := AData.ViewportOfs;
 
672
 
 
673
  isClipped := AData.isClipped;
 
674
  FClipRegion.Shape := AData.ClipShape;
655
675
end;
656
676
 
657
677
{------------------------------------------------------------------------------
790
810
begin
791
811
  // LCL thinks that focus cannot be drawn outside focus rects, but carbon do that
792
812
  // => correct rect
793
 
  OSError(GetThemeMetric(kThemeMetricFocusRectOutset, AOutSet),
 
813
  OSError(GetThemeMetric(kThemeMetricFocusRectOutset, AOutSet{%H-}),
794
814
    Self, 'DrawFocusRect', 'GetThemeMetric');
795
815
  InflateRect(ARect, -AOutSet, -AOutSet);
796
816
  OSError(
888
908
  end;
889
909
end;
890
910
 
 
911
procedure TCarbonDeviceContext.ApplyTransform(Trans: CGAffineTransform);
 
912
var
 
913
  T2: CGAffineTransform;
 
914
begin
 
915
  T2 := CGContextGetCTM(CGContext);
 
916
  // restore old CTM since CTM may changed after the clipping
 
917
  if CGAffineTransformEqualToTransform(Trans, T2) = 0 then
 
918
    CGContextTranslateCTM(CGContext, Trans.a * Trans.tx - T2.a * T2.tx,
 
919
       Trans.d * Trans.ty - T2.d * T2.ty);
 
920
end;
 
921
 
891
922
{------------------------------------------------------------------------------
892
923
  Method:  TCarbonDeviceContext.ExtTextOut
893
924
  Params:  X       - X-coordinate of reference point
911
942
  //DebugLn('TCarbonDeviceContext.ExtTextOut ' + DbgS(X) + ', ' + DbgS(Y) + ' R: ' + DbgS(Rect^) +
912
943
  //  ' S: ' + Str + ' C: ' + DbgS(Count));
913
944
 
914
 
  if Rect <> nil then
 
945
  if Assigned(Rect) then
915
946
  begin
916
947
    // fill background
917
948
    if (Options and ETO_OPAQUE) > 0 then
929
960
    if CurrentFont.LineRotation = 0 then // TODO: fill rotated text background
930
961
    begin
931
962
      // fill drawed text background
932
 
      if (Rect = nil) and ((Options and ETO_OPAQUE) > 0) then
 
963
      if BkMode = OPAQUE then
933
964
      begin
934
965
        BrushSolid := BkBrush.Solid; // must ignore BkMode
935
966
        BkBrush.Solid := True;
1495
1526
 
1496
1527
 
1497
1528
  UseLayer:=Assigned(MskImage)
1498
 
            or (CGImageGetWidth(Image)<>SrcWidth)
1499
 
            or (CGImageGetHeight(Image)<>SrcHeight);
 
1529
            or (CGImageGetWidth(Image){%H-}<>SrcWidth)
 
1530
            or (CGImageGetHeight(Image){%H-}<>SrcHeight);
1500
1531
 
1501
1532
  try
1502
1533
    if not UseLayer then
1512
1543
      Layer := CGLayerCreateWithContext(SrcDC.CGContext, LayRect.size, nil);
1513
1544
 
1514
1545
      // the sub-image is out of edges
1515
 
      if (CGImageGetWidth(Image)<>SrcWidth) or (CGImageGetHeight(Image)<>SrcHeight) then
 
1546
      if (CGImageGetWidth(Image){%H-}<>SrcWidth) or (CGImageGetHeight(Image){%H-}<>SrcHeight) then
1516
1547
      begin
1517
1548
        with ImgRect do
1518
1549
          if XSrc<0 then origin.x:=SrcWidth-CGImageGetWidth(Image) else origin.x:=0;
1553
1584
  //  X, Y]));
1554
1585
end;
1555
1586
 
 
1587
procedure TCarbonDeviceContext.ClearClipping;
 
1588
var
 
1589
  Trans: CGAffineTransform;
 
1590
begin
 
1591
  if isClipped  then
 
1592
  begin
 
1593
    Trans := CGContextGetCTM(CGContext);
 
1594
    CGContextRestoreGState(CGContext);
 
1595
    ApplyTransform(Trans);
 
1596
  end;
 
1597
end;
 
1598
 
1556
1599
function TCarbonDeviceContext.SetClipRegion(AClipRegion: TCarbonRegion; Mode: Integer): Integer;
1557
1600
begin
1558
 
  if isClipped  then
1559
 
  begin
1560
 
    isClipped := false;
1561
 
    CGContextRestoreGState(CGContext);
1562
 
  end;
1563
 
  
 
1601
  ClearClipping;
 
1602
  isClipped := False;
 
1603
 
1564
1604
  if not Assigned(AClipRegion) then
1565
 
  begin
1566
 
    HIShapeSetEmpty(FClipRegion.Shape);
1567
 
    Result := LCLType.NullRegion;
1568
 
  end
 
1605
    HIShapeSetEmpty(FClipRegion.Shape)
1569
1606
  else
1570
1607
  begin
1571
1608
    CGContextSaveGState(CGContext);
1572
1609
    FClipRegion.CombineWith(AClipRegion, Mode);
1573
1610
    FClipRegion.Apply(Self);
1574
1611
    isClipped := true;
1575
 
    Result := LCLType.ComplexRegion;
1576
1612
  end;
 
1613
  Result := FClipRegion.GetType;
1577
1614
end;
1578
1615
 
1579
1616
function TCarbonDeviceContext.CopyClipRegion(ADstRegion: TCarbonRegion): Integer;
1583
1620
    else Result := LCLType.Error;
1584
1621
end;
1585
1622
 
1586
 
procedure GetWindowViewTranslate(const AWindowOfs, AViewOfs: TPoint; var dx, dy: Integer); inline;
 
1623
procedure GetWindowViewTranslate(const AWindowOfs, AViewOfs: TPoint; out dx, dy: Integer); inline;
1587
1624
begin
1588
 
  dx:=AViewOfs.x-AWindowOfs.x;
1589
 
  dy:=AViewOfs.y-AWindowOfs.y;
 
1625
  dx := AViewOfs.x - AWindowOfs.x;
 
1626
  dy := AViewOfs.y - AWindowOfs.y;
1590
1627
end;
1591
1628
 
1592
1629
function isSamePoint(const p1, p2: TPoint): Boolean;
1599
1636
  dx, dy: Integer;
1600
1637
begin
1601
1638
  if isSamePoint(AWindowOfs, fWindowOfs) and isSamePoint(AViewOfs, fViewPortOfs) then Exit;
1602
 
  GetWindowViewTranslate(fWindowOfs, fViewPortOfs, dx, dy);
 
1639
  GetWindowViewTranslate(FWindowOfs, FViewPortOfs, dx{%H-}, dy{%H-});
1603
1640
  CGContextTranslateCTM(CGContext, -dx, -dy);
1604
1641
 
1605
 
  fWindowOfs:=AWindowOfs;
1606
 
  fViewPortOfs:=AViewOfs;
1607
 
  GetWindowViewTranslate(fWindowOfs, fViewPortOfs, dx, dy);
 
1642
  FWindowOfs := AWindowOfs;
 
1643
  FViewPortOfs := AViewOfs;
 
1644
  GetWindowViewTranslate(FWindowOfs, FViewPortOfs, dx, dy);
1608
1645
  CGContextTranslateCTM(CGContext, dx, dy);
1609
1646
end;
1610
1647
 
1618
1655
  UpdateContextOfs(WindowOfs, AViewOfs);
1619
1656
end;
1620
1657
 
 
1658
function TCarbonDeviceContext.GetLogicalOffset: TPoint;
 
1659
begin
 
1660
  GetWindowViewTranslate(WindowOfs, ViewportOfs, Result.X, Result.Y);
 
1661
end;
 
1662
 
1621
1663
{ TCarbonScreenContext }
1622
1664
 
1623
1665
{------------------------------------------------------------------------------
1651
1693
var
1652
1694
  R: TRect;
1653
1695
begin
1654
 
  FOwner.GetClientRect(R);
 
1696
  FOwner.GetClientRect(R{%H-});
1655
1697
  Result.X := (R.Right - R.Left);
1656
1698
  Result.Y := (R.Bottom - R.Top);
1657
1699
end;
1774
1816
    Info := FBitmap.Info;
1775
1817
    // convert kCGImageAlphaFirst -> kCGImageAlphaNoneSkipFirst
1776
1818
    if (Info and kCGImageAlphaFirst > 0) then
1777
 
      Info := (Info and (not kCGImageAlphaFirst)) or kCGImageAlphaNoneSkipFirst;
 
1819
      Info := (Info and (not kCGImageAlphaFirst)) or kCGImageAlphaPremultipliedFirst;
1778
1820
    
1779
1821
    CGContext := CGBitmapContextCreate(FBitmap.Data, FBitmap.Width, FBitmap.Height,
1780
1822
                   FBitmap.BitsPerComponent, FBitmap.BytesPerRow, FBitmap.ColorSpace,