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
11 unit TADrawUtils;
12
13 {$H+}
14
15 interface
16
17 uses
18 SysUtils, Classes, FPCanvas, FPImage, Types, TAChartUtils;
19
20 type
21 // Same types as in Graphics unit, but without dependency.
22 TChartAntialiasingMode = (amDontCare, amOn, amOff);
23
24 type
25 ISimpleTextOut = interface
HtmlTextExtentnull26 function HtmlTextExtent(const AText: String): TPoint;
27 procedure HtmlTextOut(AX, AY: Integer; const AText: String);
28 procedure SimpleTextOut(AX, AY: Integer; const AText: String);
SimpleTextExtentnull29 function SimpleTextExtent(const AText: String): TPoint;
GetFontAnglenull30 function GetFontAngle: Double;
31 end;
32
33 { TChartTextOut }
34
35 TChartTextOut = class
36 strict private
37 FAlignment: TAlignment;
38 FPos: TPoint;
39 FSimpleTextOut: ISimpleTextOut;
40 FText1: String;
41 FText2: TStrings;
42 FTextFormat: TChartTextFormat;
43 FWidth: Integer;
44
45 procedure DoTextOutList;
46 procedure DoTextOutString;
47 public
48 constructor Create(ASimpleTextOut: ISimpleTextOut);
49 public
Alignmentnull50 function Alignment(AAlignment: TAlignment): TChartTextOut;
51 procedure Done;
Posnull52 function Pos(AX, AY: Integer): TChartTextOut;
Posnull53 function Pos(const APos: TPoint): TChartTextOut;
Textnull54 function Text(const AText: String): TChartTextOut;
Textnull55 function Text(AText: TStrings): TChartTextOut;
TextFormatnull56 function TextFormat(AFormat: TChartTextFormat): TChartTextOut;
Widthnull57 function Width(AWidth: Integer): TChartTextOut;
58 end;
59
60 TChartColorToFPColorFunc = function (AColor: TChartColor): TFPColor;
61 TGetFontOrientationFunc = function (AFont: TFPCustomFont): Integer;
62
63 TChartTransparency = 0..255;
64
65 TScaleItem = (scaleFont, scalePen);
66 TScaleItems = set of TScaleItem;
67
68 IChartDrawer = interface
69 ['{6D8E5591-6788-4D2D-9FE6-596D5157C3C3}']
70 procedure AddToFontOrientation(ADelta: Integer);
71 procedure ClippingStart(const AClipRect: TRect);
72 procedure ClippingStart;
73 procedure ClippingStop;
74 procedure DrawingBegin(const ABoundingBox: TRect);
75 procedure DrawingEnd;
76 procedure DrawLineDepth(AX1, AY1, AX2, AY2, ADepth: Integer);
77 procedure DrawLineDepth(const AP1, AP2: TPoint; ADepth: Integer);
78 procedure Ellipse(AX1, AY1, AX2, AY2: Integer);
79 procedure FillRect(AX1, AY1, AX2, AY2: Integer);
GetBrushColornull80 function GetBrushColor: TChartColor;
GetFontAnglenull81 function GetFontAngle: Double; // in radians
GetFontColornull82 function GetFontColor: TFPColor;
GetFontNamenull83 function GetFontName: String;
GetFontSizenull84 function GetFontSize: Integer;
GetFontStylenull85 function GetFontStyle: TChartFontStyles;
GetPenColornull86 function GetPenColor: TChartColor;
87 procedure SetDoChartColorToFPColorFunc(AValue: TChartColorToFPColorFunc);
88 procedure Line(AX1, AY1, AX2, AY2: Integer);
89 procedure Line(const AP1, AP2: TPoint);
90 procedure LineTo(AX, AY: Integer);
91 procedure LineTo(const AP: TPoint);
92 procedure MoveTo(AX, AY: Integer);
93 procedure MoveTo(const AP: TPoint);
94 procedure Polygon(
95 const APoints: array of TPoint; AStartIndex, ANumPts: Integer);
96 procedure Polyline(
97 const APoints: array of TPoint; AStartIndex, ANumPts: Integer);
98 procedure PrepareSimplePen(AColor: TChartColor);
99 procedure PutImage(AX, AY: Integer; AImage: TFPCustomImage);
100 procedure PutPixel(AX, AY: Integer; AColor: TChartColor);
101 procedure RadialPie(
102 AX1, AY1, AX2, AY2: Integer;
103 AStartAngle16Deg, AAngleLength16Deg: Integer);
104 procedure Rectangle(const ARect: TRect);
105 procedure Rectangle(AX1, AY1, AX2, AY2: Integer);
106 procedure ResetFont;
Scalenull107 function Scale(ADistance: Integer): Integer;
108 procedure SetAntialiasingMode(AValue: TChartAntialiasingMode);
109 procedure SetBrush(ABrush: TFPCustomBrush);
110 procedure SetBrushColor(AColor: TChartColor);
111 procedure SetBrushParams(AStyle: TFPBrushStyle; AColor: TChartColor);
112 procedure SetFont(AValue: TFPCustomFont);
113 procedure SetGetFontOrientationFunc(AValue: TGetFontOrientationFunc);
114 procedure SetMonochromeColor(AColor: TChartColor);
115 procedure SetPen(APen: TFPCustomPen);
116 procedure SetPenColor(AColor: TChartColor);
117 procedure SetPenParams(AStyle: TFPPenStyle; AColor: TChartColor; AWidth: Integer = 1);
118 procedure SetPenWidth(AWidth: Integer);
GetRightToLeftnull119 function GetRightToLeft: Boolean;
120 procedure SetRightToLeft(AValue: Boolean);
121 procedure SetTransparency(ATransparency: TChartTransparency);
122 procedure SetXor(AXor: Boolean);
TextExtentnull123 function TextExtent(const AText: String;
124 ATextFormat: TChartTextFormat = tfNormal): TPoint;
TextExtentnull125 function TextExtent(AText: TStrings;
126 ATextFormat: TChartTextFormat = tfNormal): TPoint;
TextOutnull127 function TextOut: TChartTextOut;
128
129 property Brush: TFPCustomBrush write SetBrush;
130 property BrushColor: TChartColor read GetBrushColor write SetBrushColor;
131 property Font: TFPCustomFont write SetFont;
132 property Pen: TFPCustomPen write SetPen;
133 property DoChartColorToFPColor: TChartColorToFPColorFunc
134 write SetDoChartColorToFPColorFunc;
135 property DoGetFontOrientation: TGetFontOrientationFunc
136 write SetGetFontOrientationFunc;
137 end;
138
139 { TBasicDrawer }
140
141 TBasicDrawer = class(TInterfacedObject, ISimpleTextOut)
142 strict protected
143 FChartColorToFPColorFunc: TChartColorToFPColorFunc;
144 FGetFontOrientationFunc: TGetFontOrientationFunc;
145 FMonochromeColor: TChartColor;
146 FRightToLeft: Boolean;
147 FTransparency: TChartTransparency;
148 FXor: Boolean;
149 FScaleItems: TScaleItems;
ColorOrMononull150 function ColorOrMono(AColor: TChartColor): TChartColor; inline;
FPColorOrMononull151 function FPColorOrMono(const AColor: TFPColor): TFPColor; inline;
GetFontAnglenull152 // function GetFontAngle: Double; virtual; abstract;
153 function SimpleTextExtent(const AText: String): TPoint; virtual; abstract;
154 procedure SimpleTextOut(AX, AY: Integer; const AText: String); virtual; abstract;
HtmlTextExtentnull155 function HtmlTextExtent(const AText: String): TPoint;
156 procedure HtmlTextOut(AX, AY: Integer; const AText: String);
157 public
158 constructor Create;
159 procedure DrawingBegin(const ABoundingBox: TRect); virtual;
160 procedure DrawingEnd; virtual;
161 procedure DrawLineDepth(AX1, AY1, AX2, AY2, ADepth: Integer);
162 procedure DrawLineDepth(const AP1, AP2: TPoint; ADepth: Integer);
GetFontAnglenull163 function GetFontAngle: Double; virtual; abstract;
GetFontColornull164 function GetFontColor: TFPColor; virtual; abstract;
GetFontNamenull165 function GetFontName: String; virtual; abstract;
GetFontSizenull166 function GetFontSize: Integer; virtual; abstract;
GetFontStylenull167 function GetFontStyle: TChartFontStyles; virtual; abstract;
GetRightToLeftnull168 function GetRightToLeft: Boolean;
169 procedure LineTo(AX, AY: Integer); virtual; abstract; overload;
170 procedure LineTo(const AP: TPoint); overload;
171 procedure MoveTo(AX, AY: Integer); virtual; abstract; overload;
172 procedure MoveTo(const AP: TPoint); overload;
173 procedure Polygon(
174 const APoints: array of TPoint; AStartIndex, ANumPts: Integer); virtual; abstract;
175 procedure PutImage(AX, AY: Integer; AImage: TFPCustomImage); virtual;
176 procedure PutPixel(AX, AY: Integer; AColor: TChartColor); virtual;
Scalenull177 function Scale(ADistance: Integer): Integer; virtual;
178 procedure SetAntialiasingMode(AValue: TChartAntialiasingMode);
179 procedure SetDoChartColorToFPColorFunc(AValue: TChartColorToFPColorFunc);
180 procedure SetGetFontOrientationFunc(AValue: TGetFontOrientationFunc);
181 procedure SetMonochromeColor(AColor: TChartColor);
182 procedure SetRightToLeft(AValue: Boolean);
183 procedure SetTransparency(ATransparency: TChartTransparency);
184 procedure SetXor(AXor: Boolean);
TextExtentnull185 function TextExtent(const AText: String; ATextFormat: TChartTextFormat = tfNormal): TPoint; overload;
TextExtentnull186 function TextExtent(AText: TStrings; ATextFormat: TChartTextFormat = tfNormal): TPoint; overload;
TextOutnull187 function TextOut: TChartTextOut;
188 end;
189
ChartColorToFPColornull190 function ChartColorToFPColor(AChartColor: TChartColor): TFPColor;
FPColorToChartColornull191 function FPColorToChartColor(AFPColor: TFPColor): TChartColor;
ColorDefnull192 function ColorDef(AColor, ADefaultColor: TChartColor): TChartColor; inline;
193
Wordwrapnull194 function Wordwrap(const AText: String; ADrawer: IChartDrawer;
195 AMaxWidth: Integer; ATextFormat: TChartTextFormat): String;
196
197
198 implementation
199
200 uses
201 StrUtils, Math, fasthtmlparser, htmlutil, TAGeometry, TAHtml;
202
203 const
204 LINE_INTERVAL = 2;
205
206 SUBSUP_DIVISOR = 100;
207 SUBSUP_SIZE_MULTIPLIER = 70; //75;
208 SUB_OFFSET_MULTIPLIER = 70; //80;
209 SUP_OFFSET_MULTIPLIER = -5;
210
211 type
212 THTMLAnalyzer = class
213 private
214 FSubscript: Integer;
215 FSuperscript: Integer;
216 FFontStack: TFPList;
217 FDrawer: IChartDrawer;
218 FSize: TPoint;
219 FPos: TPoint;
220 FRotPos: TPoint;
221 FCurrentFont: TFPCustomFont;
222 FSavedFont: TFPCustomFont;
223 FFontAngle: Double;
224 protected
225 procedure ClearFontStack;
226 procedure HTMLTagFound(NoCaseTag, ActualTag: String);
227 procedure HTMLTextFound_Size(AText: String);
228 procedure HTMLTextFound_Out(AText: String);
229 procedure Init;
230 procedure PopFont;
231 procedure PushFont;
232 public
233 constructor Create(ADrawer: IChartDrawer);
234 destructor Destroy; override;
TextExtentnull235 function TextExtent(const AText: String): TPoint;
236 procedure TextOut(AX, AY: Integer; const AText: String);
237 end;
238
239 { THTMLAnalyzer }
240
241 constructor THTMLAnalyzer.Create(ADrawer: IChartDrawer);
242 begin
243 FDrawer := ADrawer;
244 FSavedFont := TFPCustomFont.Create;
245 FFontStack := TFPList.Create;
246 end;
247
248 destructor THTMLAnalyzer.Destroy;
249 var
250 j: Integer;
251 begin
252 for j:=0 to FFontStack.Count-1 do TFPCustomFont(FFontStack[j]).Free;
253 FFontStack.Free;
254 FCurrentFont.Free;
255 FSavedFont.Free;
256 inherited;
257 end;
258
259 procedure THTMLAnalyzer.ClearFontStack;
260 var
261 j: Integer;
262 begin
263 for j:=0 to FFontStack.Count-1 do TFPCustomFont(FFontStack[j]).Free;
264 FFontStack.Clear;
265 end;
266
267 procedure THTMLAnalyzer.HTMLTagFound(NoCaseTag, ActualTag: String);
268 var
269 val: String;
270 begin
271 Unused(ActualTag);
272
273 if NoCaseTag[2] = '/' then
274 case NoCaseTag of
275 '</B>',
276 '</STRONG>',
277 '</I>',
278 '</EM>',
279 '</U>',
280 '</S>',
281 '</FONT>':
282 PopFont;
283 '</SUB>':
284 dec(FSubscript);
285 '</SUP>':
286 dec(FSuperscript);
287 end
288 else begin
289 case NoCaseTag of
290 '<B>', '<STRONG>':
291 begin
292 PushFont;
293 FCurrentFont.Bold := true;
294 end;
295 '<I>', '<EM>':
296 begin
297 PushFont;
298 FCurrentFont.Italic := true;
299 end;
300 '<U>':
301 begin
302 PushFont;
303 FCurrentFont.Underline := true;
304 end;
305 '<S>':
306 begin
307 PushFont;
308 FCurrentFont.StrikeThrough := true;
309 end;
310 '<SUB>':
311 begin // Don't push the font to the stack
312 inc(FSubscript);
313 end;
314 '<SUP>':
315 begin // Don't push the font to the stack
316 inc(FSuperscript);
317 end;
318 else
319 if (pos('<FONT ', NoCaseTag) = 1) or (NoCaseTag = '<FONT>') then begin
320 PushFont;
321 val := GetVal(NoCaseTag, 'NAME');
322 if val <> '' then
323 FCurrentFont.Name := val;
324 {$IFDEF HTML_FONT_SIZE}
325 val := GetVal(NoCaseTag, 'SIZE');
326 if val <> '' then
327 FCurrentFont.Size := HTMLToFontSize(val);
328 {$ENDIF}
329 val := GetVal(NoCaseTag, 'COLOR');
330 if val <> '' then
331 FCurrentFont.FPColor := HTMLToFPColor(val);
332 end else
333 exit;
334 end;
335 end;
336 end;
337
338 procedure THTMLAnalyzer.HTMLTextFound_Out(AText: String);
339 var
340 oldFontSize: Integer;
341 offs: Integer;
342 s: string;
343 P: TPoint;
344 w, h: Integer;
345 begin
346 s := ReplaceHTMLEntities(AText);
347
348 if (FSubScript > 0) or (FSuperScript > 0) then
349 begin
350 oldFontSize := FCurrentFont.Size;
351 FCurrentFont.Size := (FCurrentFont.Size * SUBSUP_SIZE_MULTIPLIER) div SUBSUP_DIVISOR;
352 FDrawer.SetFont(FCurrentFont);
353 h := FDrawer.TextExtent('Tg', tfNormal).Y; // tfNormal is correct
354 w := FDrawer.TextExtent(s, tfNormal).X;
355 if FSubScript > 0 then
356 offs := (h * SUB_OFFSET_MULTIPLIER) div SUBSUP_DIVISOR
357 else
358 offs := (h * SUP_OFFSET_MULTIPLIER) div SUBSUP_DIVISOR; // this is negative
359 P := Point(FPos.X, FPos.Y+offs) - FRotPos;
360 p := RotatePoint(P, -FFontAngle) + FRotPos;
361 FDrawer.TextOut.TextFormat(tfNormal).Pos(P).Text(s).Done;
362 FCurrentFont.Size := oldFontSize;
363 end else
364 begin
365 FDrawer.SetFont(FCurrentFont);
366 w := FDrawer.TextExtent(s, tfNormal).X; // tfNormal is correct
367 p := RotatePoint(FPos - FRotPos, -FFontAngle) + FRotPos;
368 FDrawer.TextOut.TextFormat(tfNormal).Pos(P).Text(s).Done;
369 end;
370 inc(FPos.X, w);
371 end;
372
373 procedure THTMLAnalyzer.HTMLTextFound_Size(AText: String);
374 var
375 ext: TPoint;
376 oldFontSize: Integer;
377 s: String;
378 offs: Integer;
379 begin
380 s := ReplaceHTMLEntities(AText);
381 if (FSubScript > 0) or (FSuperscript > 0) then
382 begin
383 oldFontSize := FCurrentFont.Size;
384 FCurrentFont.Size := FCurrentFont.Size * SUBSUP_SIZE_MULTIPLIER div SUBSUP_DIVISOR;
385 FDrawer.SetFont(FCurrentFont);
386 ext := FDrawer.TextExtent(s, tfNormal); // tfNormal is correct
387 FCurrentFont.Size := oldFontSize;
388 if FSubScript > 0 then
389 begin
390 offs := (ext.y * SUB_OFFSET_MULTIPLIER) div SUBSUP_DIVISOR;
391 if ext.y + offs > FSize.Y then ext.Y := ext.y + offs;
392 end else
393 begin
394 offs := (ext.y * SUP_OFFSET_MULTIPLIER) div SUBSUP_DIVISOR; // this is negative
395 if ext.y - offs > FSize.Y then ext.Y := ext.y - offs; // offs is negative
396 end;
397 end else
398 begin
399 FDrawer.SetFont(FCurrentFont);
400 ext := FDrawer.TextExtent(s, tfNormal); // tfNormal is correct
401 end;
402 FSize.X := FSize.X + ext.X;
403 FSize.Y := Max(FSize.Y, ext.Y);
404 end;
405
406 procedure THTMLAnalyzer.Init;
407 begin
408 FFontAngle := FDrawer.GetFontAngle;
409
410 FSavedFont.Name := FDrawer.GetFontName;
411 FSavedFont.Size := FDrawer.GetFontSize;
412 FSavedFont.FPColor := FDrawer.GetFontColor;
413 FSavedFont.Bold := cfsBold in FDrawer.GetFontStyle;
414 FSavedFont.Italic := cfsItalic in FDrawer.GetFontStyle;
415 FSavedFont.Underline := cfsUnderline in FDrawer.GetFontStyle;
416 FSavedFont.StrikeThrough := cfsStrikeOut in FDrawer.GetFontStyle;
417 FSavedFont.Orientation := RadToOrient(FFontAngle);
418
419 FCurrentFont := FSavedFont.CopyFont;
420 FCurrentFont.Orientation := FSavedFont.Orientation;
421 ClearFontStack;
422
423 FSubscript := 0;
424 FSuperscript := 0;
425 end;
426
427 procedure THTMLAnalyzer.PopFont;
428 begin
429 FCurrentFont.Free;
430 FCurrentFont := TFPCustomFont(FFontStack[FFontStack.Count-1]);
431 FFontStack.Delete(FFontStack.Count-1);
432 end;
433
434 procedure THTMLAnalyzer.PushFont;
435 var
436 fnt: TFPCustomFont;
437 begin
438 fnt := FCurrentFont.CopyFont;
439 fnt.Orientation := FCurrentFont.Orientation;
440 FFontStack.Add(fnt);
441 end;
442
THTMLAnalyzer.TextExtentnull443 function THTMLAnalyzer.TextExtent(const AText: String): TPoint;
444 var
445 parser: THTMLParser;
446 begin
447 Init;
448 FSize := Point(0, 0);
449 parser := THTMLParser.Create('<p>' + AText + '</p>');
450 try
451 parser.OnFoundTag := @HTMLTagFound;
452 parser.OnFoundText := @HTMLTextFound_Size;
453 parser.Exec;
454 Result := FSize;
455 finally
456 parser.Free;
457 FDrawer.SetFont(FSavedFont);
458 end;
459 end;
460
461 procedure THTMLAnalyzer.TextOut(AX, AY: Integer; const AText: String);
462 var
463 parser: THTMLParser;
464 begin
465 Init;
466 FRotPos := Point(AX, AY);
467 FPos := Point(AX, AY);
468 parser := THTMLParser.Create('<p>' + AText + '</p>');
469 try
470 parser.OnFoundTag := @HTMLTagFound;
471 parser.OnFoundText := @HTMLTextFound_Out;
472 parser.Exec;
473 finally
474 parser.Free;
475 FDrawer.SetFont(FSavedFont);
476 end;
477 end;
478
479
480 { Utilities }
481
ChartColorToFPColornull482 function ChartColorToFPColor(AChartColor: TChartColor): TFPColor;
483 begin
484 with Result do begin
485 red := AChartColor and $FF;
486 red += red shl 8;
487 green := (AChartColor and $FF00);
488 green += green shr 8;
489 blue := (AChartColor and $FF0000) shr 8;
490 blue += blue shr 8;
491 alpha := alphaOpaque;
492 end;
493 end;
494
DummyGetFontOrientationFuncnull495 function DummyGetFontOrientationFunc(AFont: TFPCustomFont): Integer;
496 begin
497 Unused(AFont);
498 Result := 0;
499 end;
500
FPColorToChartColornull501 function FPColorToChartColor(AFPColor: TFPColor): TChartColor;
502 begin
503 Result :=
504 ((AFPColor.red shr 8) and $FF) or
505 (AFPColor.green and $FF00) or
506 ((AFPColor.blue shl 8) and $FF0000);
507 end;
508
ColorDefnull509 function ColorDef(AColor, ADefaultColor: TChartColor): TChartColor;
510 begin
511 Result := IfThen(AColor = clTAColor, ADefaultColor, AColor);
512 end;
513
514 { TChartTextOut }
515
TChartTextOut.Alignmentnull516 function TChartTextOut.Alignment(AAlignment: TAlignment): TChartTextOut;
517 begin
518 FAlignment := AAlignment;
519 Result := Self;
520 end;
521
522 constructor TChartTextOut.Create(ASimpleTextOut: ISimpleTextOut);
523 begin
524 FSimpleTextOut := ASimpleTextOut;
525 FAlignment := taLeftJustify;
526 end;
527
528 procedure TChartTextOut.Done;
529 begin
530 if FText2 = nil then
531 DoTextOutString
532 else
533 DoTextOutList;
534 Free;
535 end;
536
537 procedure TChartTextOut.DoTextOutList;
538 var
539 i: Integer;
540 a: Double;
541 lineExtent, p: TPoint;
542 begin
543 a := -FSimpleTextOut.GetFontAngle;
544 for i := 0 to FText2.Count - 1 do begin
545 case FTextFormat of
546 tfNormal: lineExtent := FSimpleTextOut.SimpleTextExtent(FText2[i]);
547 tfHtml : lineExtent := FSimpleTextOut.HtmlTextExtent(FText2[i]);
548 end;
549 p := FPos;
550 case FAlignment of
551 taCenter: p += RotatePointX((FWidth - lineExtent.X) div 2, a);
552 taRightJustify: p += RotatePointX(FWidth - lineExtent.X, a);
553 taLeftJustify: ;
554 end;
555 case FTextFormat of
556 tfNormal: FSimpleTextOut.SimpleTextOut(p.X, p.Y, FText2[i]);
557 tfHtml : FSimpleTextOut.HtmlTextOut(p.X, p.Y, FText2[i]);
558 end;
559 FPos += RotatePoint(Point(0, lineExtent.Y + LINE_INTERVAL), a);
560 end;
561 end;
562
563 procedure TChartTextOut.DoTextOutString;
564 begin
565 if System.Pos(LineEnding, FText1) = 0 then begin
566 case FTextFormat of
567 tfNormal: FSimpleTextOut.SimpleTextOut(FPos.X, FPos.Y, FText1);
568 tfHtml : FSimpleTextOut.HtmlTextOut(FPos.X, FPos.Y, FText1);
569 end;
570 exit;
571 end;
572 FText2 := TStringList.Create;
573 try
574 FText2.Text := FText1;
575 DoTextOutList;
576 finally
577 FText2.Free;
578 end;
579 end;
580
Posnull581 function TChartTextOut.Pos(AX, AY: Integer): TChartTextOut;
582 begin
583 FPos := Point(AX, AY);
584 Result := Self;
585 end;
586
Posnull587 function TChartTextOut.Pos(const APos: TPoint): TChartTextOut;
588 begin
589 FPos := APos;
590 Result := Self;
591 end;
592
TChartTextOut.Textnull593 function TChartTextOut.Text(const AText: String): TChartTextOut;
594 begin
595 FText1 := AText;
596 Result := Self;
597 end;
598
TChartTextOut.Textnull599 function TChartTextOut.Text(AText: TStrings): TChartTextOut;
600 begin
601 FText2 := AText;
602 Result := Self;
603 end;
604
TChartTextOut.TextFormatnull605 function TChartTextOut.TextFormat(AFormat: TChartTextFormat): TChartTextOut;
606 begin
607 FTextFormat := AFormat;
608 Result := Self;
609 end;
610
TChartTextOut.Widthnull611 function TChartTextOut.Width(AWidth: Integer): TChartTextOut;
612 begin
613 FWidth := AWidth;
614 Result := Self;
615 end;
616
617 { TBasicDrawer }
618
TBasicDrawer.ColorOrMononull619 function TBasicDrawer.ColorOrMono(AColor: TChartColor): TChartColor;
620 begin
621 Result := ColorDef(FMonochromeColor, AColor);
622 end;
623
624 constructor TBasicDrawer.Create;
625 begin
626 FChartColorToFPColorFunc := @ChartColorToFPColor;
627 FGetFontOrientationFunc := @DummyGetFontOrientationFunc;
628 FMonochromeColor := clTAColor;
629 end;
630
631 procedure TBasicDrawer.DrawingBegin(const ABoundingBox: TRect);
632 begin
633 Unused(ABoundingBox);
634 end;
635
636 procedure TBasicDrawer.DrawingEnd;
637 begin
638 // Empty
639 end;
640
641 procedure TBasicDrawer.DrawLineDepth(AX1, AY1, AX2, AY2, ADepth: Integer);
642 begin
643 DrawLineDepth(Point(AX1, AY1), Point(AX2, AY2), ADepth);
644 end;
645
646 procedure TBasicDrawer.DrawLineDepth(const AP1, AP2: TPoint; ADepth: Integer);
647 var
648 d: TPoint;
649 begin
650 d := Point(ADepth, -ADepth);
651 Polygon([AP1, AP1 + d, AP2 + d, AP2], 0, 4);
652 end;
653
FPColorOrMononull654 function TBasicDrawer.FPColorOrMono(const AColor: TFPColor): TFPColor;
655 begin
656 if FMonochromeColor = clTAColor then
657 Result := AColor
658 else
659 Result := FChartColorToFPColorFunc(FMonochromeColor);
660 end;
661
TBasicDrawer.GetRightToLeftnull662 function TBasicDrawer.GetRightToLeft: Boolean;
663 begin
664 Result := FRightToLeft;
665 end;
666
HtmlTextExtentnull667 function TBasicDrawer.HtmlTextExtent(const AText: String): TPoint;
668 var
669 IDrawer: IChartDrawer;
670 begin
671 IDrawer := Self as IChartDrawer;
672 // GetInterface('IChartDrawer', IDrawer);
673 with THtmlAnalyzer.Create(IDrawer) do
674 try
675 Result := TextExtent(AText);
676 finally
677 Free;
678 end;
679 end;
680
681 procedure TBasicDrawer.HtmlTextOut(AX, AY: Integer; const AText: String);
682 var
683 IDrawer: IChartDrawer;
684 begin
685 IDrawer := Self as IChartDrawer;
686 // GetInterface('IChartDrawer', IDrawer);
687 with THtmlAnalyzer.Create(IDrawer) do
688 try
689 TextOut(AX, AY, AText);
690 finally
691 Free;
692 end;
693 end;
694
695 procedure TBasicDrawer.LineTo(const AP: TPoint);
696 begin
697 LineTo(AP.X, AP.Y)
698 end;
699
700 procedure TBasicDrawer.MoveTo(const AP: TPoint);
701 begin
702 MoveTo(AP.X, AP.Y)
703 end;
704
705 procedure TBasicDrawer.PutImage(AX, AY: Integer; AImage: TFPCustomImage);
706 begin
707 Unused(AX, AY);
708 Unused(AImage);
709 end;
710
711 procedure TBasicDrawer.PutPixel(AX, AY: Integer; AColor: TChartColor);
712 begin
713 Unused(AX, AY);
714 Unused(AColor);
715 end;
716
Scalenull717 function TBasicDrawer.Scale(ADistance: Integer): Integer;
718 begin
719 Result := ADistance;
720 end;
721
722 procedure TBasicDrawer.SetAntialiasingMode(AValue: TChartAntialiasingMode);
723 begin
724 Unused(AValue);
725 end;
726
727 procedure TBasicDrawer.SetDoChartColorToFPColorFunc(
728 AValue: TChartColorToFPColorFunc);
729 begin
730 FChartColorToFPColorFunc := AValue;
731 end;
732
733 procedure TBasicDrawer.SetGetFontOrientationFunc(
734 AValue: TGetFontOrientationFunc);
735 begin
736 FGetFontOrientationFunc := AValue;
737 end;
738
739 procedure TBasicDrawer.SetMonochromeColor(AColor: TChartColor);
740 begin
741 FMonochromeColor := AColor;
742 end;
743
744 procedure TBasicDrawer.SetRightToLeft(AValue: Boolean);
745 begin
746 FRightToLeft := AValue;
747 end;
748
749 procedure TBasicDrawer.SetTransparency(ATransparency: TChartTransparency);
750 begin
751 FTransparency := ATransparency;
752 end;
753
754 procedure TBasicDrawer.SetXor(AXor: Boolean);
755 begin
756 FXor := AXor;
757 end;
758
TBasicDrawer.TextExtentnull759 function TBasicDrawer.TextExtent(const AText: String;
760 ATextFormat: TChartTextFormat = tfNormal): TPoint;
761 var
762 sl: TStrings;
763 begin
764 if Pos(LineEnding, AText) = 0 then
765 case ATextFormat of
766 tfNormal: exit(SimpleTextExtent(AText));
767 tfHTML : exit(HtmlTextExtent(AText));
768 end;
769
770 sl := TStringList.Create;
771 try
772 sl.Text := AText;
773 Result := TextExtent(sl, ATextFormat);
774 finally
775 sl.Free;
776 end;
777 end;
778
TBasicDrawer.TextExtentnull779 function TBasicDrawer.TextExtent(AText: TStrings;
780 ATextFormat: TChartTextFormat = tfNormal): TPoint;
781 var
782 i: Integer;
783 begin
784 Result := Size(0, -LINE_INTERVAL);
785 case ATextFormat of
786 tfNormal:
787 for i := 0 to AText.Count - 1 do
788 with SimpleTextExtent(AText[i]) do begin
789 Result.X := Max(Result.X, X);
790 Result.Y += Y + LINE_INTERVAL;
791 end;
792 tfHtml:
793 for i := 0 to AText.Count - 1 do
794 with HtmlTextExtent(AText[i]) do begin
795 Result.X := Max(Result.X, X);
796 Result.Y += Y + LINE_INTERVAL;
797 end;
798 end;
799 end;
800
TextOutnull801 function TBasicDrawer.TextOut: TChartTextOut;
802 begin
803 Result := TChartTextOut.Create(Self);
804 end;
805
806 // Inserts LineEndings into the provided string AText such that its width
807 // does not exceed the given width.
WordWrapnull808 function WordWrap(const AText: String; ADrawer: IChartDrawer;
809 AMaxWidth: Integer; ATextFormat: TChartTextFormat): string;
810 var
811 L: TStrings;
812 words: TStrings;
813 line: String;
814 s: String;
815 w, ws, wspace: Integer;
816 i: Integer;
817 begin
818 Result := '';
819
820 if ATextFormat = tfNormal then
821 begin
822 wspace := ADrawer.TextExtent(' ').X;
823 L := TStringList.Create;
824 words := TStringList.Create;
825 try
826 L.Text := AText;
827 for i := 0 to L.Count-1 do
828 begin
829 Split(L[i], words, ' ');
830 line := '';
831 w := 0;
832 for s in words do
833 begin
834 ws := ADrawer.TextExtent(s).X;
835 if w + wspace + ws <= AMaxWidth then
836 begin
837 line := IfThen(line='', s, line + ' ' + s);
838 w := w + wspace + ws;
839 end else
840 begin
841 if line = '' then
842 begin
843 Result := IfThen(Result='', s, Result + LineEnding + s);
844 line := '';
845 w := 0;
846 end else
847 begin
848 Result := IfThen(Result='', line, Result + LineEnding + line);
849 line := s;
850 w := ws;
851 end;
852 end;
853 end;
854 if line <> '' then
855 Result := IfThen(Result='', line, Result + LineEnding + line);
856 if i <> L.Count-1 then
857 Result := Result + LineEnding;
858 end;
859 finally
860 words.Free;
861 L.Free;
862 end;
863 end else
864 // ToDo: Implement wordwrap for html format
865 Result := AText;
866 end;
867
868 end.
869
870