Delphi_Chart/Controller.Chart.Default.pas at master · AlexandreBXavier/Delphi_Chart · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
unit Controller.Chart.Default;

interface

uses Controller.Interfaces, System.Classes, System.SysUtils, Vcl.OleCtrls, Vcl.Forms, ActiveX, SHDocVw;

type
     TControllerChartDefault = class(TInterfacedObject, iControllerChartDefault)
     private
          FValues: TStrings;
          FChartTitle: String;
          FChartSubTitle: String;
          //
          function GetChart(aTypeChart: String; aWidth, aHeight: Integer): String;
          procedure LoadStream(WebBrowser: TWebBrowser; Stream: TStream);
     public
          constructor Create;
          destructor Destroy; Override;
          class function New: iControllerChartDefault;
          function SetCharTitle(aValue: String): iControllerChartDefault;
          function SetCharSubTitle(aValue: String): iControllerChartDefault;
          function AddTitle(aDescription, aValue: String): iControllerChartDefault;
          function AddValue(aDescription, aValue: String): iControllerChartDefault;
          procedure ShowChartDonut(aWebBrowser: TWebBrowser);
          procedure ShowChartPie(aWebBrowser: TWebBrowser);
     end;

implementation

{ TControllerChartDefault }

constructor TControllerChartDefault.Create;
begin
     FValues := TStringList.Create;
end;

destructor TControllerChartDefault.Destroy;
begin
     FValues.Free;
     //
     inherited;
end;

class function TControllerChartDefault.New: iControllerChartDefault;
begin
     Result := Self.Create;
end;

function TControllerChartDefault.SetCharSubTitle(aValue: String): iControllerChartDefault;
begin
     Result := Self;
     //
     FChartSubTitle := aValue;
end;

function TControllerChartDefault.SetCharTitle(aValue: String): iControllerChartDefault;
begin
     Result := Self;
     //
     FChartTitle := aValue;
end;

procedure TControllerChartDefault.ShowChartDonut(aWebBrowser: TWebBrowser);
var
     LocalStream: TStringStream;
begin
     try
          LocalStream := TStringStream.Create(GetChart('donutchart', aWebBrowser.Width, aWebBrowser.Height));
          //
          LoadStream(aWebBrowser, LocalStream);
     finally
          LocalStream.Free;
     end;
end;

procedure TControllerChartDefault.ShowChartPie(aWebBrowser: TWebBrowser);
var
     LocalStream: TStringStream;
begin
     try
          LocalStream := TStringStream.Create(GetChart('piechart', aWebBrowser.Width, aWebBrowser.Height));
          //
          LoadStream(aWebBrowser, LocalStream);
     finally
          LocalStream.Free;
     end;
end;

function TControllerChartDefault.AddTitle(aDescription, aValue: String): iControllerChartDefault;
begin
     Result := Self;
     //
     FValues.Insert(0, '[' + QuotedStr(aDescription) + ', ' + QuotedStr(aValue) + ']');
end;

function TControllerChartDefault.AddValue(aDescription, aValue: String): iControllerChartDefault;
begin
     Result := Self;
     //
     FValues.Add('[' + QuotedStr(aDescription) + ', ' + aValue + ']');
end;

function TControllerChartDefault.GetChart(aTypeChart:String; aWidth, aHeight: Integer): String;
var
     aChart: TStrings;
     aLine: Integer;
begin
     // Use: https://developers.google.com/chart/interactive/docs/gallery
     try
          aChart := TStringList.Create;
          aChart.Add('<html>');
          aChart.Add('<meta http-equiv="X-UA-Compatible" content="IE=edge" />');
          aChart.Add('  <head>');
          aChart.Add('    <script type="text/javascript" src="https://www.gstatic.com/charts/loader.js"></script>');
          aChart.Add('    <script type="text/javascript">');
          aChart.Add('      google.charts.load(' + QuotedStr('current') + ', {' + QuotedStr('packages') + ':[' + QuotedStr('corechart') + ']});');
          aChart.Add('      google.charts.setOnLoadCallback(drawChart);');
          aChart.Add('      function drawChart() {');
          aChart.Add('        var data = google.visualization.arrayToDataTable([');
          //
          for aLine := 0 to FValues.Count-1 do
          begin
               if (aLine = FValues.Count-1) then
                    aChart.Add(FValues.Strings[aLine])
               else aChart.Add(FValues.Strings[aLine] + ', ');
          end;
          //
          aChart.Add('        ]);');
          aChart.Add('        var options = {');
          aChart.Add('          title: ' + QuotedStr(FChartTitle) + ' - [' + aTypeChart + '],');
          aChart.Add('          subtitle: ' + QuotedStr(FChartSubTitle) + ',');
          //
          if (aTypeChart = 'donutchart') then aChart.Add('          pieHole: 0.4,');
          //
          aChart.Add('        };');
          aChart.Add('        var chart = new google.visualization.PieChart(document.getElementById(' + QuotedStr(aTypeChart) + '));');
          aChart.Add('        chart.draw(data, options);');
          aChart.Add('      }');
          aChart.Add('    </script>');
          aChart.Add('  </head>');
          aChart.Add('  <body>');
          aChart.Add('    <div id="' + aTypeChart + '" style="width: ' + IntToStr(aWidth-60) + 'px; height: ' + IntToStr(aHeight-60) + 'px;"></div>');
          aChart.Add('  </body>');
          aChart.Add('</html>');
     finally
          Result := aChart.Text;
          //
          aChart.Free;
     end;
end;

procedure TControllerChartDefault.LoadStream(WebBrowser: TWebBrowser; Stream: TStream);
var
     PersistStreamInit: IPersistStreamInit;
     StreamAdapter: IStream;
     MemoryStream: TMemoryStream;
begin
     { Load empty HTML document into Webbrowser to make "Document" a valid HTML document }
     WebBrowser.Navigate('about:blank');
     { wait until finished loading }
     repeat
          Application.ProcessMessages;
          Sleep(0);
     until WebBrowser.ReadyState = READYSTATE_COMPLETE;
     { Get IPersistStreamInit - Interface }
     if WebBrowser.Document.QueryInterface(IPersistStreamInit, PersistStreamInit) = S_OK then
     begin
          { Clear document }
          if PersistStreamInit.InitNew = S_OK then
          begin
               { Make local copy of the contents of Stream if you want to use Stream directly,
                 you have to consider, that StreamAdapter will destroy it automatically }
               MemoryStream := TMemoryStream.Create;
               try
                    MemoryStream.CopyFrom(Stream, 0);
                    MemoryStream.Position := 0;
               except
                    MemoryStream.Free;
                    raise;
               end;
               { Use Stream-Adapter to get IStream Interface to our stream }
               StreamAdapter := TStreamAdapter.Create(MemoryStream, soOwned);
               { Load data from Stream into WebBrowser }
               PersistStreamInit.Load(StreamAdapter);
          end;
     end;
end;

end.