1 {
2 Copyright (C) Alexey Torgashin, uvviewsoft.com
3 License: MPL 2.0 or LGPL
4 }
5 unit ATCanvasPrimitives;
6 
7 {$ifdef fpc}
8   {$mode objfpc}{$H+}
9 {$else}
10   {$define invert_pixels}
11 {$endif}
12 
13 interface
14 
15 uses
16   Classes, SysUtils, Graphics,
17   Types,
18   Math;
19 
20 procedure BitmapResize(b: TBitmap; W, H: integer);
21 procedure BitmapResizeBySteps(b: TBitmap; W, H: integer);
22 
23 procedure CanvasInvertRect(C: TCanvas; const R: TRect; AColor: TColor);
24 
25 procedure CanvasLine(C: TCanvas; P1, P2: TPoint; AColor: TColor); inline;
26 procedure CanvasLine_DottedVertAlt(C: TCanvas; Color: TColor; X1, Y1, Y2: integer); inline;
27 procedure CanvasLine_Dotted(C: TCanvas; Color: TColor; X1, Y1, X2, Y2: integer);
28 procedure CanvasLine_WavyHorz(C: TCanvas; Color: TColor; X1, Y1, X2, Y2: integer; AtDown: boolean);
29 procedure CanvasLine_RoundedEdge(C: TCanvas; Color: TColor; X1, Y1, X2, Y2: integer; AtDown: boolean);
30 
31 procedure CanvasPaintTriangleUp(C: TCanvas; AColor: TColor; ACoord: TPoint; ASize: integer); inline;
32 procedure CanvasPaintTriangleDown(C: TCanvas; AColor: TColor; ACoord: TPoint; ASize: integer); inline;
33 procedure CanvasPaintTriangleRight(C: TCanvas; AColor: TColor; ACoord: TPoint; ASize: integer); inline;
34 procedure CanvasPaintTriangleLeft(C: TCanvas; AColor: TColor; ACoord: TPoint; ASize: integer); inline;
35 
36 type
37   TATCanvasCornerKind = (
38     acckLeftTop,
39     acckRightTop,
40     acckLeftBottom,
41     acckRightBottom
42     );
43   TATCanvasCornerKinds = set of TATCanvasCornerKind;
44 
45 procedure CanvasPaintRoundedCorners(C: TCanvas; const R: TRect;
46   Kinds: TATCanvasCornerKinds; ColorBackground, ColorBorder, ColorForeground: TColor);
47 
48 procedure CanvasArrowHorz(C: TCanvas;
49   const ARect: TRect;
50   AColorFont: TColor;
51   AArrowLen: integer;
52   AToRight: boolean;
53   APointerScale: integer);
54 
55 procedure CanvasArrowDown(C: TCanvas;
56   const ARect: TRect;
57   AColorFont: TColor;
58   ALengthScale: integer;
59   APointerScale: integer);
60 
61 procedure CanvasArrowWrapped(C: TCanvas;
62   const ARect: TRect;
63   AColorFont: TColor;
64   ALengthScale: integer;
65   AWidthScale: integer;
66   APointerScale: integer);
67 
68 procedure CanvasPaintPlusMinus(C: TCanvas;
69   AColorBorder, AColorBG: TColor;
70   ACenter: TPoint;
71   ASize: integer;
72   APlus: boolean);
73 
74 procedure CanvasPaintCircleMark(C: TCanvas;
75   const R: TRect;
76   AColor: TColor;
77   AIndentLeft, AIndentRight: integer);
78 
79 procedure CanvasPaintXMark(C: TCanvas;
80   const R: TRect;
81   AColor: TColor;
82   AIndentLeft, AIndentRight, ALineWidth: integer);
83 
84 procedure CanvasPaintRoundMark(C: TCanvas;
85   const R: TRect;
86   AColor: TColor;
87   AIndentLeft, AIndentRight, ALineWidth: integer);
88 
89 type
90   TATCollapseStringMode = (
91     acsmNone,
92     acsmLeft,
93     acsmMiddle,
94     acsmRight
95     );
96 
CanvasCollapseStringByDotsnull97 function CanvasCollapseStringByDots(C: TCanvas;
98   const Text: string;
99   Mode: TATCollapseStringMode;
100   Width: integer;
101   DotsString: string=''): string;
102 
ColorBlendnull103 function ColorBlend(c1, c2: Longint; A: Longint): Longint;
ColorBlendHalfnull104 function ColorBlendHalf(c1, c2: Longint): Longint;
105 
106 
107 implementation
108 
109 var
110   _Pen: TPen = nil;
111 
112 
113 procedure CanvasLine(C: TCanvas; P1, P2: TPoint; AColor: TColor);
114 begin
115   C.Pen.Color:= ColorToRGB(AColor);
116   {$ifdef FPC}
117   C.Line(P1, P2);
118   {$else}
119   C.MoveTo(P1.x, P1.y);
120   C.LineTo(P2.x, P2.y);
121   {$endif}
122 end;
123 
124 procedure _CalcMarkRect(const R: TRect; AIndentLeft, AIndentRight: integer;
125   out X1, Y1, X2, Y2: integer); inline;
126 var
127   W: integer;
128 begin
129   W:= R.Right-R.Left-AIndentLeft-AIndentRight;
130   X1:= R.Left+AIndentLeft;
131   X2:= X1 + W;
132   Y1:= (R.Top+R.Bottom) div 2 - W div 2;
133   Y2:= Y1 + W;
134 end;
135 
136 procedure CanvasPaintCircleMark(C: TCanvas; const R: TRect; AColor: TColor;
137   AIndentLeft, AIndentRight: integer);
138 var
139   X1, Y1, X2, Y2: integer;
140   NColor: TColor;
141 begin
142   _CalcMarkRect(R, AIndentLeft, AIndentRight, X1, Y1, X2, Y2);
143 
144   NColor:= ColorToRGB(AColor);
145   C.Pen.Color:= NColor;
146   C.Brush.Color:= NColor;
147 
148   C.Ellipse(Rect(X1, Y1, X2+2, Y2+2));
149 end;
150 
151 procedure CanvasPaintXMark(C: TCanvas; const R: TRect; AColor: TColor;
152   AIndentLeft, AIndentRight, ALineWidth: integer);
153 var
154   X1, Y1, X2, Y2: integer;
155   NColor: TColor;
156 begin
157   if ALineWidth<1 then
158     ALineWidth:= 1;
159 
160   _CalcMarkRect(R, AIndentLeft, AIndentRight, X1, Y1, X2, Y2);
161 
162   NColor:= ColorToRGB(AColor);
163   C.Pen.Color:= NColor;
164   C.Brush.Color:= NColor;
165 
166   C.Polygon([
167     Point(X1, Y1+ALineWidth),
168     Point(X1, Y1),
169     Point(X1+ALineWidth, Y1),
170     Point(X2, Y2-ALineWidth),
171     Point(X2, Y2),
172     Point(X2-ALineWidth, Y2)
173     ]);
174   C.Polygon([
175     Point(X2-ALineWidth, Y1),
176     Point(X2, Y1),
177     Point(X2, Y1+ALineWidth),
178     Point(X1+ALineWidth, Y2),
179     Point(X1, Y2),
180     Point(X1, Y2-ALineWidth)
181     ]);
182 end;
183 
184 procedure CanvasPaintRoundMark(C: TCanvas; const R: TRect; AColor: TColor;
185   AIndentLeft, AIndentRight, ALineWidth: integer);
186 var
187   X1, Y1, X2, Y2: integer;
188   NColor: TColor;
189   R2: TRect;
190 begin
191   _CalcMarkRect(R, AIndentLeft, AIndentRight, X1, Y1, X2, Y2);
192 
193   NColor:= ColorToRGB(AColor);
194   C.Brush.Color:= NColor;
195   R2:= Rect(X1, Y1, X2, Y2);
196   C.FillRect(R2);
197 end;
198 
199 {$ifdef invert_pixels}
200 procedure CanvasInvertRect(C: TCanvas; const R: TRect; AColor: TColor);
201 var
202   i, j: integer;
203 begin
204   for j:= R.Top to R.Bottom-1 do
205     for i:= R.Left to R.Right-1 do
206       C.Pixels[i, j]:= C.Pixels[i, j] xor (not AColor and $ffffff);
207 end;
208 {$else}
209 procedure CanvasInvertRect(C: TCanvas; const R: TRect; AColor: TColor);
210 var
211   X: integer;
212   AM: TAntialiasingMode;
213 begin
214   AM:= C.AntialiasingMode;
215   _Pen.Assign(C.Pen);
216 
217   X:= (R.Left+R.Right) div 2;
218   C.Pen.Mode:= {$ifdef darwin} pmNot {$else} pmNotXor {$endif};
219   C.Pen.Style:= psSolid;
220   C.Pen.Color:= AColor;
221   C.AntialiasingMode:= amOff;
222   {$ifdef FPC}
223   C.Pen.EndCap:= pecFlat;
224   {$endif}
225   C.Pen.Width:= R.Width;
226 
227   C.MoveTo(X, R.Top);
228   C.LineTo(X, R.Bottom);
229 
230   C.Pen.Assign(_Pen);
231   C.AntialiasingMode:= AM;
232   C.Rectangle(0, 0, 0, 0); //apply pen
233 end;
234 {$endif}
235 
236 procedure CanvasLine_Dotted(C: TCanvas; Color: TColor; X1, Y1, X2, Y2: integer);
237 var
238   i: integer;
239   vis: boolean;
240 begin
241   vis:= false;
242   if Y1=Y2 then
243   begin
244     for i:= X1 to X2 do
245     begin
246       vis:= not vis;
247       if vis then
248         C.Pixels[i, Y2]:= Color;
249     end;
250   end
251   else
252   begin
253     for i:= Y1 to Y2 do
254     begin
255       vis:= not vis;
256       if vis then
257         C.Pixels[X1, i]:= Color;
258     end;
259   end;
260 end;
261 
262 procedure CanvasLine_DottedVertAlt(C: TCanvas; Color: TColor; X1, Y1, Y2: integer); inline;
263 var
264   j: integer;
265 begin
266   for j:= Y1 to Y2 do
267     if Odd(j) then
268       C.Pixels[X1, j]:= Color;
269 end;
270 
271 procedure CanvasPaintTriangleUp(C: TCanvas; AColor: TColor; ACoord: TPoint; ASize: integer); inline;
272 begin
273   C.Brush.Color:= AColor;
274   C.Pen.Color:= AColor;
275   C.Polygon([
276     Point(ACoord.X - ASize*2, ACoord.Y + ASize),
277     Point(ACoord.X + ASize*2, ACoord.Y + ASize),
278     Point(ACoord.X, ACoord.Y - ASize)
279     ]);
280 end;
281 
282 procedure CanvasPaintTriangleDown(C: TCanvas; AColor: TColor; ACoord: TPoint; ASize: integer); inline;
283 begin
284   C.Brush.Color:= AColor;
285   C.Pen.Color:= AColor;
286   C.Polygon([
287     Point(ACoord.X - ASize*2, ACoord.Y - ASize),
288     Point(ACoord.X + ASize*2, ACoord.Y - ASize),
289     Point(ACoord.X, ACoord.Y + ASize)
290     ]);
291 end;
292 
293 procedure CanvasPaintTriangleRight(C: TCanvas; AColor: TColor; ACoord: TPoint; ASize: integer); inline;
294 begin
295   C.Brush.Color:= AColor;
296   C.Pen.Color:= AColor;
297   C.Polygon([
298     Point(ACoord.X - ASize, ACoord.Y - ASize*2),
299     Point(ACoord.X + ASize, ACoord.Y),
300     Point(ACoord.X - ASize, ACoord.Y + ASize*2)
301     ]);
302 end;
303 
304 procedure CanvasPaintTriangleLeft(C: TCanvas; AColor: TColor; ACoord: TPoint; ASize: integer);
305 begin
306   C.Brush.Color:= AColor;
307   C.Pen.Color:= AColor;
308   C.Polygon([
309     Point(ACoord.X + ASize, ACoord.Y - ASize*2),
310     Point(ACoord.X - ASize, ACoord.Y),
311     Point(ACoord.X + ASize, ACoord.Y + ASize*2)
312     ]);
313 end;
314 
315 procedure CanvasArrowHorz(C: TCanvas;
316   const ARect: TRect;
317   AColorFont: TColor;
318   AArrowLen: integer;
319   AToRight: boolean;
320   APointerScale: integer);
321 const
322   cIndent = 1; //offset left/rt
323 var
324   XLeft, XRight, X1, X2, Y, Dx: integer;
325 begin
326   XLeft:= ARect.Left+cIndent;
327   XRight:= ARect.Right-cIndent;
328 
329   if AArrowLen=0 then
330   begin;
331     X1:= XLeft;
332     X2:= XRight;
333   end
334   else
335   begin
336     X1:= XLeft;
337     X2:= Min(XRight, X1+AArrowLen);
338   end;
339 
340   Y:= (ARect.Top+ARect.Bottom) div 2;
341   Dx:= ARect.Height * APointerScale div 100;
342   C.Pen.Color:= AColorFont;
343 
344   C.MoveTo(X1, Y);
345   C.LineTo(X2, Y);
346   if AToRight then
347   begin
348     C.MoveTo(X2, Y);
349     C.LineTo(X2-Dx, Y-Dx);
350     C.MoveTo(X2, Y);
351     C.LineTo(X2-Dx, Y+Dx);
352   end
353   else
354   begin
355     C.MoveTo(X1, Y);
356     C.LineTo(X1+Dx, Y-Dx);
357     C.MoveTo(X1, Y);
358     C.LineTo(X1+Dx, Y+Dx);
359   end;
360 end;
361 
362 procedure CanvasArrowDown(C: TCanvas;
363   const ARect: TRect;
364   AColorFont: TColor;
365   ALengthScale: integer;
366   APointerScale: integer);
367 var
368   Len, X, Y1, Y2, Dx: integer;
369 begin
370   X:= (ARect.Left+ARect.Right) div 2;
371   Len:= ARect.Height * ALengthScale div 100;
372   Dx:= ARect.Height * APointerScale div 100;
373   C.Pen.Color:= AColorFont;
374 
375   Y1:= (ARect.Bottom+ARect.Top-Len) div 2;
376   Y2:= Y1+Len;
377 
378   C.MoveTo(X, Y1);
379   C.LineTo(X, Y2);
380   C.MoveTo(X, Y2);
381   C.LineTo(X-Dx, Y2-Dx);
382   C.MoveTo(X, Y2);
383   C.LineTo(X+Dx, Y2-Dx);
384 end;
385 
386 procedure CanvasArrowWrapped(C: TCanvas;
387   const ARect: TRect;
388   AColorFont: TColor;
389   ALengthScale: integer;
390   AWidthScale: integer;
391   APointerScale: integer);
392 var
393   Len, W, X1, X2, Y1, Y2, Dx: integer;
394 begin
395   Len:= ARect.Height * ALengthScale div 100;
396   W:= ARect.Width * AWidthScale div 100;
397   Dx:= ARect.Height * APointerScale div 100;
398   C.Pen.Color:= AColorFont;
399 
400   X1:= (ARect.Left+ARect.Right-W) div 2;
401   X2:= X1+W;
402   Y1:= (ARect.Bottom+ARect.Top-Len) div 2;
403   Y2:= Y1+Len-1;
404 
405   //C.MoveTo(X1, Y1);
406   //C.LineTo(X2, Y1);
407   C.MoveTo(X2, Y1);
408   C.LineTo(X2, Y2+1);
409   C.MoveTo(X1, Y2);
410   C.LineTo(X2, Y2);
411 
412   C.MoveTo(X1, Y2);
413   C.LineTo(X1+Dx, Y2-Dx);
414   C.MoveTo(X1, Y2);
415   C.LineTo(X1+Dx, Y2+Dx);
416 end;
417 
418 
419 procedure CanvasPaintPlusMinus(C: TCanvas; AColorBorder, AColorBG: TColor;
420   ACenter: TPoint; ASize: integer; APlus: boolean); inline;
421 begin
422   C.Brush.Color:= AColorBG;
423   C.Pen.Color:= AColorBorder;
424   C.Rectangle(ACenter.X-ASize, ACenter.Y-ASize, ACenter.X+ASize+1, ACenter.Y+ASize+1);
425   C.MoveTo(ACenter.X-ASize+2, ACenter.Y);
426   C.LineTo(ACenter.X+ASize-1, ACenter.Y);
427   if APlus then
428   begin
429     C.MoveTo(ACenter.X, ACenter.Y-ASize+2);
430     C.LineTo(ACenter.X, ACenter.Y+ASize-1);
431   end;
432 end;
433 
434 procedure CanvasLine_WavyHorz(C: TCanvas; Color: TColor; X1, Y1, X2, Y2: integer; AtDown: boolean);
435 const
436   cWavePeriod = 2;
437   cWaveInc: array[0..cWavePeriod-1] of integer = (0, 2);
438 var
439   Points: array of TPoint;
440   PointCount, PointIndex: integer;
441   X, Y, NSign: integer;
442 begin
443   //some initial len of array, not accurate
444   PointCount:= (X2-X1+1) div 2;
445   if PointCount<3 then exit;
446   SetLength(Points, PointCount);
447 
448   if AtDown then NSign:= -1 else NSign:= 1;
449   PointIndex:= 0;
450 
451   for X:= X1 to X2 do
452     if not Odd(X) then
453     begin
454       Y:= Y2 + NSign * cWaveInc[(X-X1) div 2 mod cWavePeriod];
455       if PointIndex>High(Points) then
456         SetLength(Points, Length(Points)+1);
457       Points[PointIndex]:= Point(X, Y);
458       Inc(PointIndex);
459     end;
460 
461   C.Pen.Color:= Color;
462   C.Polyline(Points);
463   SetLength(Points, 0);
464 end;
465 
466 procedure CanvasLine_RoundedEdge(C: TCanvas; Color: TColor; X1, Y1, X2, Y2: integer; AtDown: boolean);
467 var
468   Points: array[0..3] of TPoint;
469 begin
470   C.Pen.Color:= Color;
471   if Y1=Y2 then
472   begin
473     //paint polyline, 4 points, horz line and 2 edges
474     Points[1]:= Point(X1+2, Y1);
475     Points[2]:= Point(X2-2, Y2);
476     if AtDown then
477     begin
478       Points[0]:= Point(X1, Y1-2);
479       Points[3]:= Point(X2+1, Y2-3);
480     end
481     else
482     begin
483       Points[0]:= Point(X1, Y1+2);
484       Points[3]:= Point(X2+1, Y2+3);
485     end;
486     C.Polyline(Points);
487   end
488   else
489   begin
490     C.MoveTo(X1, Y1+2);
491     C.LineTo(X2, Y2-1);
492     //don't draw pixels, other lines did it
493   end;
494 end;
495 
496 
497 function CanvasCollapseStringByDots(C: TCanvas;
498   const Text: string;
499   Mode: TATCollapseStringMode;
500   Width: integer;
501   DotsString: string=''): string;
502 const
503   cMinLen = 3;
504 var
505   S, STemp: UnicodeString; //UnicodeString to do steps by 1 widechar
506   N, i: integer;
507 begin
508   if (Mode=acsmNone) or
509     (C.TextWidth(Text)<=Width) then
510   begin
511     Result:= Text;
512     exit
513   end;
514 
515   if DotsString='' then
516     DotsString:= {$ifdef fpc}UTF8Encode{$endif}(#$2026);
517 
518   S:= Text;
519   STemp:= S;
520 
521   case Mode of
522     acsmLeft:
523       begin
524         repeat
525           Delete(STemp, 1, 1);
526           S:= DotsString+STemp;
527         until (Length(S)<=cMinLen) or (C.TextWidth(S)<=Width);
528       end;
529 
530     acsmMiddle:
531       begin
532         for i:= 2 to $FFFF do
533         begin
534           N:= (Length(STemp)+1) div 2 - i div 2;
535           S:= Copy(STemp, 1, N)+DotsString+Copy(STemp, N+i, MaxInt);
536           if (Length(S)<=cMinLen) or (C.TextWidth(S)<=Width) then Break;
537         end;
538       end;
539 
540     acsmRight:
541       begin
542         repeat
543           SetLength(STemp, Length(STemp)-1);
544           S:= STemp+DotsString;
545         until (Length(S)<=cMinLen) or (C.TextWidth(S)<=Width);
546       end;
547   end;
548 
549   Result:= S;
550 end;
551 
552 
553 procedure BitmapResize(b: TBitmap; W, H: integer);
554 begin
555   {$ifdef fpc}
556   b.SetSize(W, H);
557   b.FreeImage; //recommended, otherwise black bitmap on big size
558   {$else}
559   b.Width:= W;
560   b.Height:= H;
561   {$endif}
562 end;
563 
564 procedure BitmapResizeBySteps(b: TBitmap; W, H: integer);
565 const
566   StepW = 60;
567   StepH = 40;
568 var
569   SizeX, SizeY: integer;
570 begin
571   SizeX:= (W div StepW + 1)*StepW;
572   SizeY:= (H div StepH + 1)*StepH;
573   if (SizeX>b.Width) or
574     (SizeY>b.Height) then
575     BitmapResize(b, SizeX, SizeY);
576 end;
577 
578 
579 function ColorBlend(c1, c2: Longint; A: Longint): Longint;
580 //blend level: 0..255
581 var
582   r, g, b, v1, v2: byte;
583 begin
584   v1:= Byte(c1);
585   v2:= Byte(c2);
586   r:= A * (v1 - v2) shr 8 + v2;
587   v1:= Byte(c1 shr 8);
588   v2:= Byte(c2 shr 8);
589   g:= A * (v1 - v2) shr 8 + v2;
590   v1:= Byte(c1 shr 16);
591   v2:= Byte(c2 shr 16);
592   b:= A * (v1 - v2) shr 8 + v2;
593   Result := (b shl 16) + (g shl 8) + r;
594 end;
595 
596 function ColorBlendHalf(c1, c2: Longint): Longint;
597 var
598   r, g, b, v1, v2: byte;
599 begin
600   v1:= Byte(c1);
601   v2:= Byte(c2);
602   r:= (v1+v2) shr 1;
603   v1:= Byte(c1 shr 8);
604   v2:= Byte(c2 shr 8);
605   g:= (v1+v2) shr 1;
606   v1:= Byte(c1 shr 16);
607   v2:= Byte(c2 shr 16);
608   b:= (v1+v2) shr 1;
609   Result := (b shl 16) + (g shl 8) + r;
610 end;
611 
612 
613 procedure CanvasPaintRoundedCorners(C: TCanvas; const R: TRect;
614   Kinds: TATCanvasCornerKinds; ColorBackground, ColorBorder,
615   ColorForeground: TColor);
616 var
617   ColorMixEmpty, ColorMixBg: TColor;
618 begin
619   ColorMixEmpty:= ColorBlendHalf(ColorBorder, ColorBackground);
620   ColorMixBg:= ColorBlendHalf(ColorBorder, ColorForeground);
621 
622   if acckLeftTop in Kinds then
623   begin
624     C.Pixels[R.Left, R.Top]:= ColorBackground;
625     //
626     C.Pixels[R.Left+1, R.Top]:= ColorMixEmpty;
627     C.Pixels[R.Left, R.Top+1]:= ColorMixEmpty;
628     //
629     C.Pixels[R.Left+1, R.Top+1]:= ColorBorder;
630     //
631     C.Pixels[R.Left+2, R.Top+1]:= ColorMixBg;
632     C.Pixels[R.Left+1, R.Top+2]:= ColorMixBg;
633   end;
634 
635   if acckRightTop in Kinds then
636   begin
637     C.Pixels[R.Right-1, R.Top]:= ColorBackground;
638     //
639     C.Pixels[R.Right-2, R.Top]:= ColorMixEmpty;
640     C.Pixels[R.Right-1, R.Top+1]:= ColorMixEmpty;
641     //
642     C.Pixels[R.Right-2, R.Top+1]:= ColorBorder;
643     //
644     C.Pixels[R.Right-3, R.Top+1]:= ColorMixBg;
645     C.Pixels[R.Right-2, R.Top+2]:= ColorMixBg;
646   end;
647 
648   if acckLeftBottom in Kinds then
649   begin
650     C.Pixels[R.Left, R.Bottom-1]:= ColorBackground;
651     //
652     C.Pixels[R.Left+1, R.Bottom-1]:= ColorMixEmpty;
653     C.Pixels[R.Left, R.Bottom-2]:= ColorMixEmpty;
654     //
655     C.Pixels[R.Left+1, R.Bottom-2]:= ColorBorder;
656     //
657     C.Pixels[R.Left+2, R.Bottom-2]:= ColorMixBg;
658     C.Pixels[R.Left+1, R.Bottom-3]:= ColorMixBg;
659   end;
660 
661   if acckRightBottom in Kinds then
662   begin
663     C.Pixels[R.Right-1, R.Bottom-1]:= ColorBackground;
664     //
665     C.Pixels[R.Right-2, R.Bottom-1]:= ColorMixEmpty;
666     C.Pixels[R.Right-1, R.Bottom-2]:= ColorMixEmpty;
667     //
668     C.Pixels[R.Right-2, R.Bottom-2]:= ColorBorder;
669     //
670     C.Pixels[R.Right-3, R.Bottom-2]:= ColorMixBg;
671     C.Pixels[R.Right-2, R.Bottom-3]:= ColorMixBg;
672   end;
673 end;
674 
675 
676 initialization
677   _Pen:= TPen.Create;
678 
679 finalization
680   if Assigned(_Pen) then
681     FreeAndNil(_Pen);
682 
683 end.
684 
685