← Back to branch summary

~ubuntu-branches/ubuntu/vivid/lazarus/vivid

« back to all changes in this revision

Viewing changes to components/tachart/tabgrautils.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Paul Gevers
  • Date: 2014-02-22 10:25:57 UTC
  • mfrom: (1.1.11)
  • Revision ID: package-import@ubuntu.com-20140222102557-ors9d31r84nz31jq
Tags: 1.2~rc2+dfsg-1
http://bugs.debian.org/724776
[ Abou Al Montacir ]
* New upstream pre-release.
  + Moved ideintf to components directory.
  + Added new package cairocanvas.
* Remove usage of depreciated parameters form of find. (Closes: Bug#724776)
* Bumped standard version to 3.9.5.
* Clean the way handling make files generation and removal.

[ Paul Gevers ]
* Remove nearly obsolete bzip compression for binary packages
  (See https://lists.debian.org/debian-devel/2014/01/msg00542.html)
* Update d/copyright for newly added dir in examples and components
* Update Vcs-* fields with new packaging location
* Update d/watch file to properly (Debian way) change upstreams versions
* Prevent 46MB of package size by sym linking duplicate files
* Patches
  - refresh to remove fuzz
  - add more Lintian found spelling errors
  - new patch to add shbang to two scripts in lazarus-src
* Drop lcl-# from Provides list of lcl-units-#
* Make lazarus-ide-qt4-# an arch all until it really contains stuff
* Make all metapackages arch all as the usecase for arch any doesn't
  seem to warrant the addition archive hit
* Fix permissions of non-scripts in lazarus-src-#

Show diffs side-by-side

added added

removed removed

Lines of Context:
components/tachart/tabgrautils.pas
 
1
{
 
2
 *****************************************************************************
 
3
  See the file COPYING.modifiedLGPL.txt, included in this distribution,
 
4
  for details about the license.
 
5
 *****************************************************************************
 
6
 
 
7
  Authors: Alexander Klenin
 
8
 
 
9
}
 
10
unit TABGRAUtils;
 
11
 
 
12
interface
 
13
 
 
14
{$H+}
 
15
 
 
16
uses
 
17
  BGRABitmap, BGRABitmapTypes, BGRAGradients, Graphics, Types,
 
18
  TASeries;
 
19
 
 
20
function CreateChocolateBar(
 
21
  AColor: TBGRAPixel; ALightPos: TPoint; ARect: TRect; ABorder: Integer;
 
22
  ARoundedCorners: Boolean; AOptions: TRectangleMapOptions): TBGRABitmap;
 
23
procedure DrawChocolateBar(
 
24
  ASeries: TBarSeries; ACanvas: TCanvas; ARect: TRect; APointIndex: Integer;
 
25
  ARounded: boolean);
 
26
function CreatePhong3DBar(
 
27
  AColor: TBGRAPixel; ALightPos: TPoint; var ARect: TRect;
 
28
  ADepth: Integer): TBGRABitmap;
 
29
procedure DrawPhong3DBar(
 
30
  ASeries: TBarSeries; ACanvas: TCanvas; ARect: TRect; APointIndex: Integer);
 
31
 
 
32
implementation
 
33
 
 
34
uses
 
35
  TAChartUtils, TADrawUtils, TAGeometry;
 
36
 
 
37
function BarColor(ASeries: TBarSeries; APointIndex: Integer): TBGRAPixel;
 
38
begin
 
39
  with ASeries do
 
40
    Result := ColorToBGRA(ColorToRGB(
 
41
      ColorDef(Source[APointIndex]^.Color, BarBrush.Color)), 255 - Transparency);
 
42
end;
 
43
 
 
44
function CreateChocolateBar(
 
45
  AColor: TBGRAPixel; ALightPos: TPoint; ARect: TRect; ABorder: Integer;
 
46
  ARoundedCorners: Boolean; AOptions: TRectangleMapOptions): TBGRABitmap;
 
47
var
 
48
  phong: TPhongShading;
 
49
  t: TPoint;
 
50
begin
 
51
  t := MaxPoint(ARect.BottomRight - ARect.TopLeft, Point(0, 0));
 
52
  Result := TBGRABitmap.Create(t.X, t.Y);
 
53
  if (t.X = 0) and (t.Y = 0) then exit;
 
54
  if ABorder < 0 then ABorder := 0;
 
55
  phong := TPhongShading.Create;
 
56
  try
 
57
    phong.AmbientFactor := 0.5;
 
58
    phong.LightPosition := ALightPos - ARect.TopLeft;
 
59
    phong.DrawRectangle(
 
60
      Result, BoundsSize(0, 0, t), ABorder, ABorder,
 
61
      AColor, ARoundedCorners, AOptions);
 
62
  finally
 
63
    phong.Free;
 
64
  end;
 
65
end;
 
66
 
 
67
procedure DrawChocolateBar(
 
68
  ASeries: TBarSeries; ACanvas: TCanvas; ARect: TRect;
 
69
  APointIndex: Integer; ARounded: boolean);
 
70
var
 
71
  bar: TBGRABitmap;
 
72
  border: Integer;
 
73
begin
 
74
  border := (ARect.Right - ARect.Left) div 8;
 
75
  ARect.Top += -border div 2 + 1;
 
76
  ARect.Bottom += border div 2 + 1;
 
77
  bar := CreateChocolateBar(
 
78
    BarColor(ASeries, APointIndex),
 
79
    Point(ASeries.ParentChart.ClientWidth div 2, 0),
 
80
    ARect, border, ARounded, []);
 
81
  try
 
82
    with ARect.TopLeft do
 
83
      bar.Draw(ACanvas, X, Y, false);
 
84
  finally
 
85
    bar.Free;
 
86
  end;
 
87
end;
 
88
 
 
89
function CreatePhong3DBar(
 
90
  AColor: TBGRAPixel; ALightPos: TPoint; var ARect: TRect;
 
91
  ADepth: Integer): TBGRABitmap;
 
92
var
 
93
  phong: TPhongShading;
 
94
  i: Integer;
 
95
  map: TBGRABitmap;
 
96
  h: TBGRAPixel;
 
97
  t: TPoint;
 
98
begin
 
99
  t := MaxPoint(ARect.BottomRight - ARect.TopLeft, Point(0, 0));
 
100
  map := TBGRABitmap.Create(t.X + ADepth,t.Y + ADepth);
 
101
  try
 
102
    map.FillRect(0, ADepth, t.X, t.Y + ADepth, BGRAWhite, dmSet);
 
103
    for i := 1 to ADepth do begin
 
104
      h := MapHeightToBGRA((ADepth - i) / ADepth, 255);
 
105
      map.SetHorizLine(i, ADepth - i, t.X - 1 + i - 1, h);
 
106
      map.SetVertLine(t.X - 1 + i, ADepth - i, t.Y + ADepth - 1 - i, h);
 
107
    end;
 
108
    Result := TBGRABitmap.Create(t.X + ADepth, t.Y + ADepth);
 
109
    ARect.Top -= ADepth;
 
110
    ARect.Right += ADepth;
 
111
    if (Result.width = 0) or (Result.Height = 0) then exit;
 
112
    phong := TPhongShading.Create;
 
113
    try
 
114
      phong.AmbientFactor := 0.5;
 
115
      phong.LightPosition := ALightPos - ARect.TopLeft;
 
116
      phong.Draw(Result, map, ADepth, 0, 0, AColor);
 
117
    finally
 
118
      phong.Free;
 
119
    end;
 
120
  finally
 
121
    map.Free;
 
122
  end;
 
123
end;
 
124
 
 
125
procedure DrawPhong3DBar(
 
126
  ASeries: TBarSeries; ACanvas: TCanvas; ARect: TRect; APointIndex: Integer);
 
127
 
 
128
  procedure DrawContour(var ABar: TBGRABitmap; var ADrawnRect: TRect);
 
129
  var
 
130
    size: TPoint;
 
131
    temp: TBGRABitmap;
 
132
    marginValue, depth: integer;
 
133
    margin: TPoint;
 
134
  begin
 
135
    margin := point(0, 0);
 
136
    if ASeries.BarPen.Style = psClear then exit;
 
137
    size := ARect.BottomRight - ARect.TopLeft;
 
138
    if ASeries.BarPen.Width > 1 then begin
 
139
      marginValue := (ASeries.BarPen.Width + 1) div 2;
 
140
      margin := Point(marginValue, marginValue);
 
141
      temp := TBGRABitmap.Create(
 
142
        ABar.Width + 2 * margin.X, ABar.Height + 2 * margin.Y);
 
143
      temp.PutImage(margin.X, margin.Y, ABar, dmSet);
 
144
      BGRAReplace(ABar, temp);
 
145
      ADrawnRect.TopLeft -= margin;
 
146
      ADrawnRect.BottomRight += margin;
 
147
    end;
 
148
    depth := ASeries.Depth;
 
149
    with ABar.CanvasBGRA do begin
 
150
      Pen.Assign(ASeries.BarPen);
 
151
      Brush.Style := bsClear;
 
152
      Polygon([
 
153
         Point(margin.x + 0, margin.y + depth),
 
154
         Point(margin.x + depth, margin.y + 0),
 
155
         Point(margin.x + size.x - 1 + depth, margin.y + 0),
 
156
         Point(margin.x + size.x - 1 + depth, margin.y + size.y - 1),
 
157
         Point(margin.x + size.x - 1, margin.y + size.y - 1 + depth),
 
158
         Point(margin.x + 0, margin.y + size.y - 1 + depth)
 
159
      ]);
 
160
    end;
 
161
  end;
 
162
 
 
163
var
 
164
  bar: TBGRABitmap;
 
165
begin
 
166
  bar := CreatePhong3DBar(
 
167
    BarColor(ASeries, APointIndex),
 
168
    Point(ASeries.ParentChart.ClientWidth div 2, 0), ARect, ASeries.Depth);
 
169
  try
 
170
    DrawContour(bar, ARect);
 
171
    with ARect.TopLeft do
 
172
      bar.Draw(ACanvas, X, Y, false);
 
173
  finally
 
174
    bar.Free;
 
175
  end;
 
176
end;
 
177
 
 
178
end.