← Back to branch summary

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

« back to all changes in this revision

Viewing changes to lcl/include/canvas.inc

  • 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
http://bugs.debian.org/708695
[ 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:
lcl/include/canvas.inc
71
71
  LogicalRect: TRect;
72
72
begin
73
73
  inherited SetClipRect(ARect);
74
 
  {$ifndef ver2_2}
75
74
  if inherited GetClipping then
76
75
  begin
77
 
  {$endif}
78
76
    // ARect is in logical coords. CreateRectRGN accepts device coords.
79
77
    // So we need to translate them
80
78
    LogicalRect := ARect;
83
81
      RGN := CreateRectRGN(Left, Top, Right, Bottom);
84
82
    SelectClipRGN(Handle, RGN);
85
83
    DeleteObject(RGN);
86
 
  {$ifndef ver2_2}
87
84
  end;
88
 
  {$endif}
89
85
end;
90
86
 
91
87
function TCanvas.GetClipping: Boolean;
97
93
 
98
94
procedure TCanvas.SetClipping(const AValue: boolean);
99
95
begin
100
 
  {$ifndef ver2_2}
101
96
  inherited SetClipping(AValue);
102
 
  {$endif}
103
97
  if AValue then
104
98
    SetClipRect(inherited GetClipRect)
105
99
  else
196
190
  Include(FState, csBrushValid);
197
191
  // do not use color for hatched brushes. windows cannot draw hatches when SetBkColor is called
198
192
  if ([Brush.Style] * HatchBrushes) = [] then
199
 
    SetBkColor(FHandle, Brush.GetColor);
 
193
    SetBkColor(FHandle, TColorRef(Brush.GetColor));
200
194
  if Brush.Style = bsSolid then
201
195
    SetBkMode(FHandle, OPAQUE)
202
196
  else
262
256
  if (OldHandle <> HFONT(Font.Reference.Handle)) and (FSavedFontHandle = 0) then
263
257
    FSavedFontHandle := OldHandle;
264
258
  Include(FState, csFontValid);
265
 
  SetTextColor(FHandle, Font.GetColor);
 
259
  SetTextColor(FHandle, TColorRef(Font.GetColor));
266
260
end;
267
261
 
268
262
{------------------------------------------------------------------------------
695
689
end;
696
690
 
697
691
{------------------------------------------------------------------------------
 
692
  Method:   TCanvas.BrushCopy
 
693
  Params:   ADestRect, ABitmap, ASourceRect, ATransparentColor
 
694
  Returns:  Nothing
 
695
 
 
696
  Makes a stretch draw operation while substituting a color of the source bitmap
 
697
  with the color of the brush of the canvas
 
698
 ------------------------------------------------------------------------------}
 
699
procedure TCanvas.BrushCopy(ADestRect: TRect; ABitmap: TBitmap; ASourceRect: TRect;
 
700
  ATransparentColor: TColor);
 
701
var
 
702
  lIntfImage: TLazIntfImage;
 
703
  lTransparentColor, lBrushColor, lPixelColor: TFPColor;
 
704
  lPaintedBitmap: TBitmap;
 
705
  x, y: Integer;
 
706
  lDestWidth, lDestHeight, lSrcWidth, lSrcHeight: Integer;
 
707
begin
 
708
  // Preparation of data
 
709
  lDestWidth := ADestRect.Right - ADestRect.Left;
 
710
  lDestHeight := ADestRect.Bottom - ADestRect.Top;
 
711
  lSrcWidth := ASourceRect.Right - ASourceRect.Left;
 
712
  lSrcHeight := ASourceRect.Bottom - ASourceRect.Top;
 
713
  lTransparentColor := TColorToFPColor(ColorToRGB(ATransparentColor));
 
714
  lBrushColor := TColorToFPColor(ColorToRGB(Brush.Color));
 
715
 
 
716
  lPaintedBitmap := TBitmap.Create;
 
717
  lIntfImage := TLazIntfImage.Create(0, 0);
 
718
  try
 
719
    // First copy the source rectangle to another bitmap
 
720
    // So that we don't have to iterate in pixels which wont be used changing the color
 
721
    lPaintedBitmap.Width := lSrcWidth;
 
722
    lPaintedBitmap.Height := lSrcHeight;
 
723
    lPaintedBitmap.Canvas.Draw(-ASourceRect.Left, -ASourceRect.Top, ABitmap);
 
724
 
 
725
    // Next copy the bitmap to a intfimage to be able to make the color change
 
726
    lIntfImage.LoadFromBitmap(lPaintedBitmap.Handle, 0);
 
727
    for x := 0 to lSrcWidth-1 do
 
728
      for y := 0 to lSrcHeight-1 do
 
729
      begin
 
730
        lPixelColor := lIntfImage.Colors[x, y];
 
731
        if (lPixelColor.red = lTransparentColor.red) and
 
732
           (lPixelColor.green = lTransparentColor.green) and
 
733
           (lPixelColor.blue = lTransparentColor.blue) then
 
734
           lIntfImage.Colors[x, y] := lBrushColor;
 
735
      end;
 
736
 
 
737
    // Now obtain a bitmap with the new image
 
738
    lPaintedBitmap.LoadFromIntfImage(lIntfImage);
 
739
 
 
740
    // And stretch draw it
 
741
    Self.StretchDraw(ADestRect, lPaintedBitmap);
 
742
  finally
 
743
    lIntfImage.Free;
 
744
    lPaintedBitmap.Free;
 
745
  end;
 
746
end;
 
747
 
 
748
{------------------------------------------------------------------------------
698
749
  Method:   TCanvas.RadialPie
699
750
  Params:   x1, y1, x2, y2, StartAngle16Deg, EndAngle16Deg: Integer
700
751
  Returns:  Nothing
971
1022
end;
972
1023
 
973
1024
{------------------------------------------------------------------------------
 
1025
  Method:   TCanvas.Frame3D
 
1026
  Params:   Rect
 
1027
  Returns:  the inflated rectangle (the inner rectangle without the frame)
 
1028
 
 
1029
 ------------------------------------------------------------------------------}
 
1030
procedure TCanvas.Frame3D(var ARect: TRect; TopColor, BottomColor: TColor;
 
1031
  const FrameWidth: integer);
 
1032
var
 
1033
  W, ii : Integer;
 
1034
begin
 
1035
  if ARect.Bottom-ARect.Top > ARect.Right-ARect.Left
 
1036
  then
 
1037
    W := ARect.Right-ARect.Left+1
 
1038
  else
 
1039
    W := ARect.Bottom-ARect.Top+1;
 
1040
 
 
1041
  if FrameWidth > W then
 
1042
    W := W-1
 
1043
  else
 
1044
    W := FrameWidth;
 
1045
 
 
1046
  for ii := 1 to W do
 
1047
  begin
 
1048
    Pen.Color := TopColor;
 
1049
    MoveTo(ARect.Left,    ARect.Bottom-1);
 
1050
    LineTo(ARect.Left,    ARect.Top);
 
1051
    LineTo(ARect.Right-1, ARect.Top);
 
1052
    Pen.Color := BottomColor;
 
1053
    LineTo(ARect.Right-1, ARect.Bottom-1);
 
1054
    LineTo(ARect.Left,    ARect.Bottom-1);
 
1055
 
 
1056
    Inc(ARect.Left);
 
1057
    Inc(ARect.Top);
 
1058
    Dec(ARect.Right);
 
1059
    Dec(ARect.Bottom);
 
1060
  end;
 
1061
end;
 
1062
 
 
1063
{------------------------------------------------------------------------------
974
1064
  procedure TCanvas.Frame(const ARect: TRect);
975
1065
 
976
1066
  Drawing the border of a rectangle with the current pen
977
1067
 ------------------------------------------------------------------------------}
978
1068
procedure TCanvas.Frame(const ARect: TRect);
 
1069
var
 
1070
  OldBrushStyle: TFPBrushStyle;
979
1071
begin
980
1072
  Changing;
981
1073
  RequiredState([csHandleValid, csPenValid]);
982
 
  LCLIntf.Frame(FHandle, ARect);
 
1074
  OldBrushStyle := Brush.Style;
 
1075
  Brush.Style := bsClear;
 
1076
  Rectangle(ARect);
 
1077
  Brush.Style := OldBrushStyle;
983
1078
  Changed;
984
1079
end;
985
1080
 
1132
1227
    tlCenter : Options := Options or DT_VCENTER;
1133
1228
    tlBottom : Options := Options or DT_BOTTOM;
1134
1229
  end;
1135
 
  if Style.WordBreak then
 
1230
  if Style.EndEllipsis then
 
1231
    Options := Options or DT_END_ELLIPSIS;
 
1232
  if Style.WordBreak then begin
1136
1233
    Options := Options or DT_WORDBREAK;
 
1234
    if Style.EndEllipsis then
 
1235
      Options := Options and not DT_END_ELLIPSIS;
 
1236
  end;
1137
1237
 
1138
1238
  if Style.SingleLine then
1139
1239
    Options := Options or DT_SINGLELINE;
1200
1300
    SetBkMode(DC, TRANSPARENT);
1201
1301
 
1202
1302
  if Style.SystemFont then
1203
 
    SetTextColor(DC, Font.GetColor);
 
1303
    SetTextColor(DC, TColorRef(Font.GetColor));
1204
1304
 
1205
1305
  //debugln('TCanvas.TextRect DRAW Text="',Text,'" ',dbgs(fRect));
1206
1306
  DrawText(DC, pChar(Text), Length(Text), fRect, Options);
1645
1745
end;
1646
1746
 
1647
1747
{------------------------------------------------------------------------------
 
1748
  Function: TCanvas.TextFitInfo
 
1749
  Params:   Text: The text in consideration
 
1750
            MaxWidth: The size, the major input
 
1751
  Returns:  The number of characters which will fit into MaxWidth
 
1752
 
 
1753
  Returns how many characters will fit in a specified width
 
1754
 ------------------------------------------------------------------------------}
 
1755
function TCanvas.TextFitInfo(const Text: string; MaxWidth: Integer): Integer;
 
1756
var
 
1757
  lSize: TSize;
 
1758
begin
 
1759
  LCLIntf.GetTextExtentExPoint(Self.Handle, PChar(Text), Length(Text),
 
1760
    MaxWidth, @Result, nil, lSize);
 
1761
end;
 
1762
 
 
1763
{------------------------------------------------------------------------------
1648
1764
  Function: TCanvas.TextHeight
1649
1765
  Params:   Text: The text to measure
1650
1766
  Returns:  A handle to the GUI object