1 {***********************************}
2 { }
3 { ATBinHex Component }
4 { Copyright (C) Alexey Torgashin }
5 { http://uvviewsoft.com }
6 { }
7 {***********************************}
8 unit ATBinHex_CanvasProc;
9
10 {$mode delphi}
11
12 interface
13
14 uses
15 Classes, SysUtils, Graphics, Types,
16 atbinhex_stringproc;
17
18 procedure CanvasTextOut(C: TCanvas; PosX, PosY: integer; const S: UnicodeString; ATabSize: integer; ACharSize: TPoint);
CanvasTextSpacesnull19 function CanvasTextSpaces(const S: atString; ATabSize: integer): integer;
CanvasTextWidthnull20 function CanvasTextWidth(C: TCanvas; const S: atString; ATabSize: integer; ACharSize: TPoint): integer;
21 procedure CanvasInvertRect(C: TCanvas; const R: TRect; AColor: TColor);
22
23
24 implementation
25
26 uses
27 {$ifdef windows}
28 Windows,
29 {$endif}
30 LCLIntf;
31
CanvasTextSpacesnull32 function CanvasTextSpaces(const S: atString; ATabSize: integer): integer;
33 var
34 List: array of integer;
35 begin
36 Result:= 0;
37 if S='' then Exit;
38 SetLength(List, Length(S));
39 SCalcCharOffsets(S, List, ATabSize);
40 Result:= List[High(List)];
41 end;
42
CanvasTextWidthnull43 function CanvasTextWidth(C: TCanvas; const S: atString; ATabSize: integer; ACharSize: TPoint): integer;
44 begin
45 Result:= CanvasTextSpaces(S, ATabSize)*ACharSize.X;
46 end;
47
StringNeedsDxOffsetsnull48 function StringNeedsDxOffsets(const S: UnicodeString): boolean;
49 var
50 i: integer;
51 begin
52 for i:= 1 to Length(S) do
53 if Ord(S[i])>$FF then
54 exit(true);
55 Result:= false;
56 end;
57
58 procedure CanvasTextOut(C: TCanvas; PosX, PosY: integer;
59 const S: UnicodeString; ATabSize: integer; ACharSize: TPoint);
60 var
61 {
62 ListReal: array of integer;
63 ListInt: array of Longint;
64 Dx: array of Longint;
65 }
66 DxPtr: pointer;
67 Buf: string;
68 i: integer;
69 begin
70 if S='' then Exit;
71
72 DxPtr:= nil;
73
74 {
75 if not StringNeedsDxOffsets(S) then
76 DxPtr:= nil
77 else
78 begin
79 SetLength(ListReal, Length(S));
80 SetLength(ListInt, Length(S));
81 SetLength(Dx, Length(S));
82
83 SCalcCharOffsets(S, ListReal, ATabSize);
84
85 for i:= 0 to High(ListReal) do
86 ListInt[i]:= ListReal[i]*ACharSize.X div 100;
87
88 for i:= 0 to High(ListReal) do
89 if i=0 then
90 Dx[i]:= ListInt[i]
91 else
92 Dx[i]:= ListInt[i]-ListInt[i-1];
93
94 DxPtr:= @Dx[0];
95 end;
96 }
97
98 {$ifdef windows}
99 Windows.ExtTextOutW(C.Handle, PosX, PosY, 0, nil, PWideChar(S), Length(S), DxPtr);
100 {$else}
101 Buf:= UTF8Encode(S);
102 ExtTextOut(C.Handle, PosX, PosY, 0, nil, PChar(Buf), Length(Buf), DxPtr);
103 {$endif}
104 end;
105
106 (*
107 var
108 _bmp: Graphics.TBitmap = nil;
109 const
110 cInvertMaxX = 40;
111 cInvertMaxY = 80;
112
113 procedure CanvasInvertRect_Universal(C: TCanvas; const R: TRect);
114 var
115 sizeX, sizeY: integer;
116 i, j: integer;
117 Rbmp: TRect;
118 begin
119 if not Assigned(_bmp) then
120 begin
121 _bmp:= Graphics.TBitmap.Create;
122 _bmp.PixelFormat:= pf24bit;
123 _bmp.SetSize(cInvertMaxX, cInvertMaxY);
124 end;
125
126 sizeX:= R.Right-R.Left;
127 sizeY:= R.Bottom-R.Top;
128 Rbmp:= Classes.Rect(0, 0, sizeX, sizeY);
129
130 _bmp.Canvas.CopyRect(Rbmp, C, R);
131
132 for j:= 0 to sizeY-1 do
133 for i:= 0 to sizeX-1 do
134 with _bmp.Canvas do
135 Pixels[i, j]:= Pixels[i, j] xor $FFFFFF;
136
137 C.CopyRect(R, _bmp.Canvas, Rbmp);
138 end;
139 *)
140
141 {$ifdef windows}
142 procedure CanvasInvertRect(C: TCanvas; const R: TRect; AColor: TColor);
143 begin
144 Windows.InvertRect(C.Handle, R);
145 end;
146 {$else}
147
148 var
149 _Pen: TPen = nil;
150
151 procedure CanvasInvertRect(C: TCanvas; const R: TRect; AColor: TColor);
152 var
153 X: integer;
154 AM: TAntialiasingMode;
155 begin
156 if not Assigned(_Pen) then
157 _Pen:= TPen.Create;
158
159 AM:= C.AntialiasingMode;
160 _Pen.Assign(C.Pen);
161
162 X:= (R.Left+R.Right) div 2;
163 C.Pen.Mode:= pmNotXor;
164 C.Pen.Style:= psSolid;
165 C.Pen.Color:= AColor;
166 C.AntialiasingMode:= amOff;
167 C.Pen.EndCap:= pecFlat;
168 C.Pen.Width:= R.Right-R.Left;
169
170 C.MoveTo(X, R.Top);
171 C.LineTo(X, R.Bottom);
172
173 C.Pen.Assign(_Pen);
174 C.AntialiasingMode:= AM;
175 C.Rectangle(0, 0, 0, 0); //apply pen
176 end;
177
178 finalization
179 if Assigned(_Pen) then
180 FreeAndNil(_Pen);
181
182 {$endif}
183
184 end.
185
186