1 | unit Dpi.Graphics;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Classes, SysUtils, Math, Graphics, LCLType, GraphType, Types;
|
---|
7 |
|
---|
8 | const
|
---|
9 | clBlack = TColor($000000);
|
---|
10 | clWhite = TColor($ffffff);
|
---|
11 |
|
---|
12 | type
|
---|
13 | TColor = Graphics.TColor;
|
---|
14 | TPixelFormat = Graphics.TPixelFormat;
|
---|
15 | TFontStyle = Graphics.TFontStyle;
|
---|
16 |
|
---|
17 | { TFont }
|
---|
18 |
|
---|
19 | TFont = class(TPersistent)
|
---|
20 | private
|
---|
21 | FNativeFont: Graphics.TFont;
|
---|
22 | FNativeFontFree: Boolean;
|
---|
23 | FOnChange: TNotifyEvent;
|
---|
24 | FSize: Integer;
|
---|
25 | FHeight: Integer;
|
---|
26 | FPixelsPerInch: Integer;
|
---|
27 | FColor: TColor;
|
---|
28 | function GetCharSet: TFontCharSet;
|
---|
29 | function GetColor: TColor;
|
---|
30 | function GetHeight: Integer;
|
---|
31 | function GetName: string;
|
---|
32 | function GetPixelsPerInch: Integer;
|
---|
33 | function GetSize: Integer;
|
---|
34 | function GetStyle: TFontStyles;
|
---|
35 | function IsNameStored: Boolean;
|
---|
36 | procedure SetCharSet(AValue: TFontCharSet);
|
---|
37 | procedure SetColor(AValue: TColor);
|
---|
38 | procedure SetHeight(AValue: Integer);
|
---|
39 | procedure SetName(AValue: string);
|
---|
40 | procedure SetNativeFont(AValue: Graphics.TFont);
|
---|
41 | procedure SetPixelsPerInch(AValue: Integer);
|
---|
42 | procedure SetSize(AValue: Integer);
|
---|
43 | procedure DoChange;
|
---|
44 | procedure SetStyle(AValue: TFontStyles);
|
---|
45 | procedure UpdateFont;
|
---|
46 | protected
|
---|
47 | function GetNativeFont: Graphics.TFont; virtual;
|
---|
48 | public
|
---|
49 | procedure ScreenChanged;
|
---|
50 | property NativeFont: Graphics.TFont read FNativeFont write SetNativeFont;
|
---|
51 | constructor Create;
|
---|
52 | destructor Destroy; override;
|
---|
53 | procedure Assign(Source: TPersistent); override;
|
---|
54 | procedure GetTextSize(Text: string; var w, h: Integer);
|
---|
55 | function GetTextHeight(Text: string): Integer;
|
---|
56 | function GetTextWidth(Text: string): Integer;
|
---|
57 | published
|
---|
58 | property CharSet: TFontCharSet read GetCharSet write SetCharSet default DEFAULT_CHARSET;
|
---|
59 | property Color: TColor read GetColor write SetColor;
|
---|
60 | property Name: string read GetName write SetName stored IsNameStored;
|
---|
61 | property Style: TFontStyles read GetStyle write SetStyle default [];
|
---|
62 | property Size: Integer read GetSize write SetSize stored false;
|
---|
63 | property PixelsPerInch: Integer read GetPixelsPerInch write SetPixelsPerInch;
|
---|
64 | property Height: Integer read GetHeight write SetHeight default 0;
|
---|
65 | property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
---|
66 | end;
|
---|
67 |
|
---|
68 | { TPen }
|
---|
69 |
|
---|
70 | TPen = class
|
---|
71 | FWidth: Integer;
|
---|
72 | FNativePen: Graphics.TPen;
|
---|
73 | FNativePenFree: Boolean;
|
---|
74 | private
|
---|
75 | function GetColor: TColor;
|
---|
76 | function GetStyle: TPenStyle;
|
---|
77 | function GetWidth: Integer;
|
---|
78 | procedure SetColor(AValue: TColor);
|
---|
79 | procedure SetNativePen(AValue: Graphics.TPen);
|
---|
80 | procedure SetStyle(AValue: TPenStyle);
|
---|
81 | procedure SetWidth(AValue: Integer);
|
---|
82 | public
|
---|
83 | constructor Create;
|
---|
84 | destructor Destroy; override;
|
---|
85 | function GetNativePen: Graphics.TPen;
|
---|
86 | procedure Assign(Source: TPen);
|
---|
87 | property NativePen: Graphics.TPen read FNativePen write SetNativePen;
|
---|
88 | published
|
---|
89 | property Color: TColor read GetColor write SetColor default clBlack;
|
---|
90 | property Style : TPenStyle read GetStyle write SetStyle default psSolid;
|
---|
91 | property Width: Integer read GetWidth write SetWidth default 1;
|
---|
92 | end;
|
---|
93 |
|
---|
94 | TBrushStyle = Graphics.TBrushStyle;
|
---|
95 | TPenStyle = Graphics.TPenStyle;
|
---|
96 |
|
---|
97 | { TBrush }
|
---|
98 |
|
---|
99 | TBrush = class
|
---|
100 | private
|
---|
101 | FNativeBrush: Graphics.TBrush;
|
---|
102 | FNativeBrushFree: Boolean;
|
---|
103 | function GetColor: TColor;
|
---|
104 | function GetStyle: TBrushStyle;
|
---|
105 | procedure SetColor(AValue: TColor);
|
---|
106 | function GetNativeBrush: Graphics.TBrush;
|
---|
107 | procedure SetNativeBrush(AValue: Graphics.TBrush);
|
---|
108 | procedure SetStyle(AValue: TBrushStyle);
|
---|
109 | public
|
---|
110 | constructor Create;
|
---|
111 | destructor Destroy; override;
|
---|
112 | procedure Assign(Source: TBrush);
|
---|
113 | property NativeBrush: Graphics.TBrush read FNativeBrush write SetNativeBrush;
|
---|
114 | published
|
---|
115 | property Color: TColor read GetColor write SetColor default clWhite;
|
---|
116 | property Style: TBrushStyle read GetStyle write SetStyle default bsSolid;
|
---|
117 | end;
|
---|
118 |
|
---|
119 | TGraphic = class;
|
---|
120 |
|
---|
121 | { TCanvas }
|
---|
122 |
|
---|
123 | TCanvas = class
|
---|
124 | private
|
---|
125 | FBrush: TBrush;
|
---|
126 | FBrushFree: Boolean;
|
---|
127 | FPen: TPen;
|
---|
128 | FPenFree: Boolean;
|
---|
129 | FFont: TFont;
|
---|
130 | FFontFree: Boolean;
|
---|
131 | FNativeCanvas: Graphics.TCanvas;
|
---|
132 | FNativeCanvasFree: Boolean;
|
---|
133 | function GetHandle: HDC;
|
---|
134 | function GetPixel(X, Y: Integer): TColor;
|
---|
135 | function GetTextStyle: TTextStyle;
|
---|
136 | procedure SetBrush(AValue: TBrush);
|
---|
137 | procedure SetFont(AValue: TFont);
|
---|
138 | procedure SetHandle(AValue: HDC);
|
---|
139 | procedure SetPen(AValue: TPen);
|
---|
140 | procedure SetPixel(X, Y: Integer; AValue: TColor);
|
---|
141 | procedure SetNativeCanvas(AValue: Graphics.TCanvas);
|
---|
142 | procedure SetTextStyle(AValue: TTextStyle);
|
---|
143 | protected
|
---|
144 | procedure DoLine(X1, Y1, X2, Y2: Integer); virtual;
|
---|
145 | procedure DoTextOut(X, Y: Integer; Text: string); virtual;
|
---|
146 | procedure DoRectangle(const Bounds: TRect); virtual;
|
---|
147 | procedure DoRectangleFill(const Bounds: TRect); virtual;
|
---|
148 | procedure DoPolygon(const Points: array of TPoint); virtual;
|
---|
149 | procedure CreateHandle; virtual;
|
---|
150 | procedure DoEllipse(const Bounds: TRect); virtual;
|
---|
151 | procedure DoMoveTo(X, Y: Integer); virtual;
|
---|
152 | procedure DoLineTo(X, Y: Integer); virtual;
|
---|
153 | procedure DoPolyline(const Points: array of TPoint); virtual;
|
---|
154 | procedure DoPolyBezier(Points: PPoint; NumPts: Integer;
|
---|
155 | Filled: Boolean = False; Continuous: Boolean = False); virtual;
|
---|
156 | procedure SetHeight(AValue: Integer); virtual;
|
---|
157 | procedure SetWidth(AValue: Integer); virtual;
|
---|
158 | function GetWidth: Integer; virtual;
|
---|
159 | function GetHeight: Integer; virtual;
|
---|
160 | function GetNativeCanvas: Graphics.TCanvas; virtual;
|
---|
161 | public
|
---|
162 | property NativeCanvas: Graphics.TCanvas read FNativeCanvas write SetNativeCanvas;
|
---|
163 | procedure RoundRect(const Rect: TRect; RX, RY: Integer); overload;
|
---|
164 | procedure RoundRect(X1, Y1, X2, Y2: Integer; RX,RY: Integer); overload; virtual;
|
---|
165 | procedure Polygon(const Points: array of TPoint; Winding: Boolean;
|
---|
166 | StartIndex: Integer = 0; NumPts: Integer = -1); overload;
|
---|
167 | procedure Polygon(Points: PPoint; NumPts: Integer; Winding: Boolean = False); virtual; overload;
|
---|
168 | procedure Polygon(const Points: array of TPoint); overload;
|
---|
169 | procedure PolyBezier(const Points: array of TPoint;
|
---|
170 | Filled: Boolean = False; Continuous: boolean = True); overload;
|
---|
171 | procedure PolyBezier(Points: PPoint; NumPts: Integer;
|
---|
172 | Filled: Boolean = False; Continuous: Boolean = True); virtual; overload;
|
---|
173 | procedure Polyline(const Points: array of TPoint); overload;
|
---|
174 | procedure Polyline(Points: PPoint; NumPts: Integer); virtual; overload;
|
---|
175 | procedure Ellipse(x1, y1, x2, y2: Integer); virtual; overload;
|
---|
176 | procedure Ellipse(const ARect: TRect); virtual; overload;
|
---|
177 | // procedure StretchDraw(const DestRect: TRect; SrcGraphic: Graphics.TGraphic); virtual; overload;
|
---|
178 | procedure StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic); virtual; overload;
|
---|
179 | procedure Pie(EllipseX1, EllipseY1, EllipseX2, EllipseY2,
|
---|
180 | StartX, StartY, EndX, EndY: Integer); virtual;
|
---|
181 | procedure FrameRect(Rect: TRect);
|
---|
182 | procedure Rectangle(X1, Y1, X2, Y2: Integer); overload;
|
---|
183 | procedure Rectangle(const ARect: TRect); overload;
|
---|
184 | function TextWidth(const Text: string): Integer;
|
---|
185 | function TextHeight(const Text: string): Integer;
|
---|
186 | function TextExtent(const Text: string): TSize; virtual;
|
---|
187 | procedure TextOut(X, Y: Integer; const Text: string); virtual;
|
---|
188 | procedure TextRect(ARect: TRect; X, Y: Integer; Text: string); overload;
|
---|
189 | procedure TextRect(ARect: TRect; X, Y: integer; const Text: string;
|
---|
190 | const Style: TTextStyle); overload;
|
---|
191 | procedure MoveTo(X, Y: Integer);
|
---|
192 | procedure LineTo(X, Y: Integer);
|
---|
193 | procedure Line(const p1, p2: TPoint);
|
---|
194 | procedure FillRect(const ARect: TRect); virtual; overload;
|
---|
195 | procedure FillRect(X1, Y1, X2, Y2: Integer); overload;
|
---|
196 | procedure Draw(X, Y: Integer; Source: TGraphic);
|
---|
197 | procedure CopyRect(Dest: TRect; SrcCanvas: TCanvas; Source: TRect);
|
---|
198 | constructor Create;
|
---|
199 | destructor Destroy; override;
|
---|
200 | property Handle: HDC read GetHandle write SetHandle;
|
---|
201 | property Pixels[X, Y: Integer]: TColor read GetPixel write SetPixel;
|
---|
202 | property Width: Integer read GetWidth;
|
---|
203 | property Height: Integer read GetHeight;
|
---|
204 | property TextStyle: TTextStyle read GetTextStyle write SetTextStyle;
|
---|
205 | published
|
---|
206 | property Brush: TBrush read FBrush write SetBrush;
|
---|
207 | property Pen: TPen read FPen write SetPen;
|
---|
208 | property Font: TFont read FFont write SetFont;
|
---|
209 | end;
|
---|
210 |
|
---|
211 | { TGraphic }
|
---|
212 |
|
---|
213 | TGraphic = class(TPersistent)
|
---|
214 | protected
|
---|
215 | FDpi: Integer;
|
---|
216 | function GetNativeGraphic: Graphics.TGraphic; virtual;
|
---|
217 | function GetWidth: Integer; virtual; abstract;
|
---|
218 | function GetHeight: Integer; virtual; abstract;
|
---|
219 | procedure SetWidth(Value: Integer); virtual; abstract;
|
---|
220 | procedure SetHeight(Value: Integer); virtual; abstract;
|
---|
221 | procedure ScreenChanged; virtual;
|
---|
222 | procedure SetDpi(AValue: Integer); virtual;
|
---|
223 | function GetDpi: Integer; virtual;
|
---|
224 | public
|
---|
225 | NativeGraphicClass: TGraphicClass;
|
---|
226 | constructor Create; virtual;
|
---|
227 | procedure LoadFromFile(const Filename: string); virtual;
|
---|
228 | procedure SaveToFile(const Filename: string); virtual;
|
---|
229 | property Width: Integer read GetWidth write SetWidth;
|
---|
230 | property Height: Integer read GetHeight write SetHeight;
|
---|
231 | property Dpi: Integer read GetDpi write SetDpi;
|
---|
232 | end;
|
---|
233 |
|
---|
234 | { TRasterImage }
|
---|
235 |
|
---|
236 | TRasterImage = class(TGraphic)
|
---|
237 | private
|
---|
238 | FCanvas: TCanvas;
|
---|
239 | function GetCanvas: TCanvas;
|
---|
240 | function GetRawImage: TRawImage;
|
---|
241 | protected
|
---|
242 | function GetHeight: Integer; override;
|
---|
243 | function GetWidth: Integer; override;
|
---|
244 | function GetPixelFormat: TPixelFormat; virtual; abstract;
|
---|
245 | procedure SetWidth(Value: Integer); override;
|
---|
246 | procedure SetHeight(Value: Integer); override;
|
---|
247 | procedure SetSize(AWidth, AHeight: Integer); virtual; abstract;
|
---|
248 | procedure SetPixelFormat(AValue: TPixelFormat); virtual; abstract;
|
---|
249 | function GetNativeGraphic: Graphics.TGraphic; override;
|
---|
250 | function GetNativeRasterImage: Graphics.TRasterImage; virtual;
|
---|
251 | procedure SetNativeRasterImage(CustomBitmap: Graphics.TRasterImage); virtual; abstract;
|
---|
252 | public
|
---|
253 | constructor Create; override;
|
---|
254 | destructor Destroy; override;
|
---|
255 | procedure BeginUpdate(ACanvasOnly: Boolean = False);
|
---|
256 | procedure EndUpdate(AStreamIsValid: Boolean = False);
|
---|
257 | property Canvas: TCanvas read GetCanvas;
|
---|
258 | property RawImage: TRawImage read GetRawImage;
|
---|
259 | property PixelFormat: TPixelFormat read GetPixelFormat write SetPixelFormat;
|
---|
260 | end;
|
---|
261 |
|
---|
262 | { TCustomBitmap }
|
---|
263 |
|
---|
264 | TCustomBitmap = class(TRasterImage)
|
---|
265 | private
|
---|
266 | FWidth: Integer;
|
---|
267 | FHeight: Integer;
|
---|
268 | protected
|
---|
269 | function GetHeight: Integer; override;
|
---|
270 | function GetWidth: Integer; override;
|
---|
271 | function GetPixelFormat: TPixelFormat; override;
|
---|
272 | procedure SetPixelFormat(AValue: TPixelFormat); override;
|
---|
273 | function GetNativeCustomBitmap: Graphics.TCustomBitmap; virtual;
|
---|
274 | function GetNativeRasterImage: Graphics.TRasterImage; override;
|
---|
275 | procedure SetNativeRasterImage(RasterImage: Graphics.TRasterImage); override;
|
---|
276 | procedure SetNativeCustomBitmap(CustomBitmap: Graphics.TCustomBitmap); virtual; abstract;
|
---|
277 | procedure ScreenChanged; override;
|
---|
278 | public
|
---|
279 | procedure Assign(Source: TPersistent); override;
|
---|
280 | procedure SetSize(AWidth, AHeight: Integer); override;
|
---|
281 | end;
|
---|
282 |
|
---|
283 | { TBitmap }
|
---|
284 |
|
---|
285 | TBitmap = class(TCustomBitmap)
|
---|
286 | private
|
---|
287 | function GetScanLine(Row: Integer): Pointer;
|
---|
288 | function GetTransparent: Boolean;
|
---|
289 | function GetTransparentColor: TColor;
|
---|
290 | procedure SetTransparent(AValue: Boolean);
|
---|
291 | procedure SetTransparentColor(AValue: TColor);
|
---|
292 | protected
|
---|
293 | function GetNativeBitmap: Graphics.TBitmap; virtual;
|
---|
294 | function GetNativeCustomBitmap: Graphics.TCustomBitmap; override;
|
---|
295 | procedure SetNativeBitmap(ANativeBitmap: Graphics.TBitmap); virtual;
|
---|
296 | procedure SetNativeCustomBitmap(CustomBitmap: Graphics.TCustomBitmap); override;
|
---|
297 | public
|
---|
298 | NativeBitmap: Graphics.TBitmap;
|
---|
299 | constructor Create; override;
|
---|
300 | destructor Destroy; override;
|
---|
301 | property ScanLine[Row: Integer]: Pointer read GetScanLine;
|
---|
302 | published
|
---|
303 | property TransparentColor: TColor read GetTransparentColor
|
---|
304 | write SetTransparentColor default clDefault;
|
---|
305 | property Transparent: Boolean read GetTransparent write SetTransparent default False;
|
---|
306 | end;
|
---|
307 |
|
---|
308 | { TJpegImage }
|
---|
309 |
|
---|
310 | TJpegImage = class(TCustomBitmap)
|
---|
311 | protected
|
---|
312 | function GetNativeCustomBitmap: Graphics.TCustomBitmap; override;
|
---|
313 | function GetNativeJpeg: Graphics.TJPEGImage; virtual;
|
---|
314 | procedure SetNativeCustomBitmap(CustomBitmap: Graphics.TCustomBitmap); override;
|
---|
315 | procedure SetNativeJpeg(Jpeg: Graphics.TJPEGImage); virtual;
|
---|
316 | public
|
---|
317 | NativeJpeg: Graphics.TJPEGImage;
|
---|
318 | constructor Create; override;
|
---|
319 | destructor Destroy; override;
|
---|
320 | end;
|
---|
321 |
|
---|
322 | { TPortableNetworkGraphic }
|
---|
323 |
|
---|
324 | TPortableNetworkGraphic = class(TCustomBitmap)
|
---|
325 | protected
|
---|
326 | function GetNativeCustomBitmap: Graphics.TCustomBitmap; override;
|
---|
327 | function GetNativePng: Graphics.TPortableNetworkGraphic; virtual;
|
---|
328 | procedure SetNativeCustomBitmap(CustomBitmap: Graphics.TCustomBitmap); override;
|
---|
329 | procedure SetNativePng(Png: Graphics.TPortableNetworkGraphic); virtual;
|
---|
330 | public
|
---|
331 | NativePng: Graphics.TPortableNetworkGraphic;
|
---|
332 | constructor Create; override;
|
---|
333 | destructor Destroy; override;
|
---|
334 | end;
|
---|
335 |
|
---|
336 | { TPicture }
|
---|
337 |
|
---|
338 | TPicture = class(TPersistent)
|
---|
339 | private
|
---|
340 | FBitmap: TBitmap;
|
---|
341 | procedure SetBitmap(AValue: TBitmap);
|
---|
342 | published
|
---|
343 | procedure LoadFromFile(FileName: string);
|
---|
344 | property Bitmap: TBitmap read FBitmap write SetBitmap;
|
---|
345 | end;
|
---|
346 |
|
---|
347 | { TScreenInfo }
|
---|
348 |
|
---|
349 | TScreenInfo = record
|
---|
350 | private
|
---|
351 | FDpi: Integer;
|
---|
352 | procedure SetDpi(AValue: Integer);
|
---|
353 | public
|
---|
354 | ToNative: Double;
|
---|
355 | FromNative: Double;
|
---|
356 | Lookup: array[-10000..10000] of Integer; // Should be sufficient for 8K screens
|
---|
357 | property Dpi: Integer read FDpi write SetDpi;
|
---|
358 | end;
|
---|
359 |
|
---|
360 | var
|
---|
361 | ScreenInfo: TScreenInfo;
|
---|
362 |
|
---|
363 |
|
---|
364 | implementation
|
---|
365 |
|
---|
366 | uses
|
---|
367 | Dpi.Common, NativePixelPointer;
|
---|
368 |
|
---|
369 | { TCustomBitmap }
|
---|
370 |
|
---|
371 | function TCustomBitmap.GetHeight: Integer;
|
---|
372 | begin
|
---|
373 | Result := FHeight;
|
---|
374 | end;
|
---|
375 |
|
---|
376 | function TCustomBitmap.GetWidth: Integer;
|
---|
377 | begin
|
---|
378 | Result := FWidth;
|
---|
379 | end;
|
---|
380 |
|
---|
381 | function TCustomBitmap.GetPixelFormat: TPixelFormat;
|
---|
382 | begin
|
---|
383 | Result := GetNativeCustomBitmap.PixelFormat;
|
---|
384 | end;
|
---|
385 |
|
---|
386 | procedure TCustomBitmap.SetPixelFormat(AValue: TPixelFormat);
|
---|
387 | begin
|
---|
388 | GetNativeCustomBitmap.PixelFormat := AValue;
|
---|
389 | end;
|
---|
390 |
|
---|
391 | function TCustomBitmap.GetNativeCustomBitmap: Graphics.TCustomBitmap;
|
---|
392 | begin
|
---|
393 | Result := nil;
|
---|
394 | end;
|
---|
395 |
|
---|
396 | function TCustomBitmap.GetNativeRasterImage: Graphics.TRasterImage;
|
---|
397 | begin
|
---|
398 | Result := GetNativeCustomBitmap;
|
---|
399 | end;
|
---|
400 |
|
---|
401 | procedure TCustomBitmap.SetNativeRasterImage(RasterImage: Graphics.TRasterImage
|
---|
402 | );
|
---|
403 | begin
|
---|
404 | SetNativeCustomBitmap(Graphics.TCustomBitmap(RasterImage));
|
---|
405 | end;
|
---|
406 |
|
---|
407 | procedure TCustomBitmap.ScreenChanged;
|
---|
408 | var
|
---|
409 | Bitmap: Graphics.TCustomBitmap;
|
---|
410 | NewWidth: Integer;
|
---|
411 | NewHeight: Integer;
|
---|
412 | begin
|
---|
413 | NewWidth := ScaleToNative(Width);
|
---|
414 | NewHeight := ScaleToNative(Height);
|
---|
415 | if Assigned(GetNativeCustomBitmap) and ((NewWidth <> GetNativeCustomBitmap.Width) or
|
---|
416 | (NewHeight <> GetNativeCustomBitmap.Height)) then begin
|
---|
417 | // Rescale bitmap to new size
|
---|
418 | if NativeGraphicClass = Graphics.TBitmap then
|
---|
419 | Bitmap := Graphics.TBitmap.Create
|
---|
420 | else if NativeGraphicClass = Graphics.TPortableNetworkGraphic then
|
---|
421 | Bitmap := Graphics.TPortableNetworkGraphic.Create
|
---|
422 | else if NativeGraphicClass = Graphics.TJPEGImage then
|
---|
423 | Bitmap := Graphics.TJPEGImage.Create
|
---|
424 | else raise Exception.Create('Unsupported image class');
|
---|
425 | Bitmap.SetSize(NewWidth, NewHeight);
|
---|
426 | Bitmap.PixelFormat := GetNativeCustomBitmap.PixelFormat;
|
---|
427 | Bitmap.Canvas.StretchDraw(Bounds(0, 0, NewWidth, NewHeight), GetNativeCustomBitmap);
|
---|
428 | GetNativeCustomBitmap.Free;
|
---|
429 | SetNativeCustomBitmap(Bitmap);
|
---|
430 | Canvas.NativeCanvas := GetNativeCustomBitmap.Canvas;
|
---|
431 | end;
|
---|
432 | end;
|
---|
433 |
|
---|
434 | procedure TCustomBitmap.Assign(Source: TPersistent);
|
---|
435 | begin
|
---|
436 | if Source is TCustomBitmap then begin
|
---|
437 | GetNativeCustomBitmap.Assign(TCustomBitmap(Source).GetNativeCustomBitmap);
|
---|
438 | FWidth := TCustomBitmap(Source).FWidth;
|
---|
439 | FHeight := TCustomBitmap(Source).FHeight
|
---|
440 | end else inherited;
|
---|
441 | end;
|
---|
442 |
|
---|
443 | procedure TCustomBitmap.SetSize(AWidth, AHeight: Integer);
|
---|
444 | begin
|
---|
445 | FWidth := AWidth;
|
---|
446 | FHeight := AHeight;
|
---|
447 | GetNativeCustomBitmap.SetSize(ScaleToNative(AWidth), ScaleToNative(AHeight));
|
---|
448 | end;
|
---|
449 |
|
---|
450 | { TFont }
|
---|
451 |
|
---|
452 | procedure TFont.SetSize(AValue: Integer);
|
---|
453 | begin
|
---|
454 | if FSize = AValue then Exit;
|
---|
455 | FSize := AValue;
|
---|
456 | FHeight := -MulDiv(FSize, FPixelsPerInch, 72);
|
---|
457 | UpdateFont;
|
---|
458 | DoChange;
|
---|
459 | end;
|
---|
460 |
|
---|
461 | procedure TFont.DoChange;
|
---|
462 | begin
|
---|
463 | if Assigned(FOnChange) then FOnChange(Self);
|
---|
464 | end;
|
---|
465 |
|
---|
466 | procedure TFont.SetStyle(AValue: TFontStyles);
|
---|
467 | begin
|
---|
468 | GetNativeFont.Style := AValue;
|
---|
469 | end;
|
---|
470 |
|
---|
471 | procedure TFont.UpdateFont;
|
---|
472 | begin
|
---|
473 | if Assigned(GetNativeFont) then begin
|
---|
474 | GetNativeFont.PixelsPerInch := FPixelsPerInch;
|
---|
475 | GetNativeFont.Size := FSize;
|
---|
476 | end;
|
---|
477 | end;
|
---|
478 |
|
---|
479 | procedure TFont.ScreenChanged;
|
---|
480 | begin
|
---|
481 | DoChange;
|
---|
482 | end;
|
---|
483 |
|
---|
484 | function TFont.GetNativeFont: Graphics.TFont;
|
---|
485 | begin
|
---|
486 | Result := NativeFont;
|
---|
487 | end;
|
---|
488 |
|
---|
489 | procedure TFont.SetPixelsPerInch(AValue: Integer);
|
---|
490 | begin
|
---|
491 | FPixelsPerInch := PixelsPerInch;
|
---|
492 | FHeight := -MulDiv(FSize, FPixelsPerInch, 72);
|
---|
493 | UpdateFont;
|
---|
494 | end;
|
---|
495 |
|
---|
496 | function TFont.GetName: string;
|
---|
497 | begin
|
---|
498 | Result := GetNativeFont.Name;
|
---|
499 | end;
|
---|
500 |
|
---|
501 | function TFont.GetColor: TColor;
|
---|
502 | begin
|
---|
503 | Result := FColor;
|
---|
504 | end;
|
---|
505 |
|
---|
506 | function TFont.GetCharSet: TFontCharSet;
|
---|
507 | begin
|
---|
508 | Result := GetNativeFont.CharSet;
|
---|
509 | end;
|
---|
510 |
|
---|
511 | function TFont.GetHeight: Integer;
|
---|
512 | begin
|
---|
513 | Result := GetNativeFont.Height;
|
---|
514 | end;
|
---|
515 |
|
---|
516 | function TFont.GetPixelsPerInch: Integer;
|
---|
517 | begin
|
---|
518 | Result := FPixelsPerInch;
|
---|
519 | end;
|
---|
520 |
|
---|
521 | function TFont.GetSize: Integer;
|
---|
522 | begin
|
---|
523 | Result := FSize;
|
---|
524 | end;
|
---|
525 |
|
---|
526 | function TFont.GetStyle: TFontStyles;
|
---|
527 | begin
|
---|
528 | Result := GetNativeFont.Style;
|
---|
529 | end;
|
---|
530 |
|
---|
531 | function TFont.IsNameStored: Boolean;
|
---|
532 | begin
|
---|
533 | Result := GetNativeFont.Name <> 'default';
|
---|
534 | end;
|
---|
535 |
|
---|
536 | procedure TFont.SetCharSet(AValue: TFontCharSet);
|
---|
537 | begin
|
---|
538 | GetNativeFont.CharSet := AValue;
|
---|
539 | end;
|
---|
540 |
|
---|
541 | procedure TFont.SetColor(AValue: TColor);
|
---|
542 | begin
|
---|
543 | if FColor = AValue then Exit;
|
---|
544 | FColor := AValue;
|
---|
545 | GetNativeFont.Color := AValue;
|
---|
546 | end;
|
---|
547 |
|
---|
548 | procedure TFont.SetHeight(AValue: Integer);
|
---|
549 | begin
|
---|
550 | FHeight := AValue;
|
---|
551 | FSize := MulDiv(-FHeight, 72, FPixelsPerInch);
|
---|
552 | UpdateFont;
|
---|
553 | end;
|
---|
554 |
|
---|
555 | procedure TFont.SetName(AValue: string);
|
---|
556 | begin
|
---|
557 | GetNativeFont.Name := AValue;
|
---|
558 | end;
|
---|
559 |
|
---|
560 | procedure TFont.SetNativeFont(AValue: Graphics.TFont);
|
---|
561 | begin
|
---|
562 | if FNativeFont = AValue then Exit;
|
---|
563 | if FNativeFontFree then FreeAndNil(FNativeFont);
|
---|
564 | FNativeFontFree := False;
|
---|
565 | FNativeFont := AValue;
|
---|
566 | end;
|
---|
567 |
|
---|
568 | constructor TFont.Create;
|
---|
569 | begin
|
---|
570 | FNativeFont := Graphics.TFont.Create;
|
---|
571 | FNativeFontFree := True;
|
---|
572 | FPixelsPerInch := ScreenInfo.Dpi;
|
---|
573 | Size := 8;
|
---|
574 | Color := clDefault;
|
---|
575 | end;
|
---|
576 |
|
---|
577 | destructor TFont.Destroy;
|
---|
578 | begin
|
---|
579 | if FNativeFontFree then
|
---|
580 | FreeAndNil(FNativeFont);
|
---|
581 | inherited;
|
---|
582 | end;
|
---|
583 |
|
---|
584 | procedure TFont.Assign(Source: TPersistent);
|
---|
585 | begin
|
---|
586 | if Source is TFont then begin
|
---|
587 | GetNativeFont.Assign((Source as TFont).GetNativeFont);
|
---|
588 | Size := (Source as TFont).Size;
|
---|
589 | Height := (Source as TFont).Height;
|
---|
590 | PixelsPerInch := (Source as TFont).PixelsPerInch;
|
---|
591 | FOnChange := (Source as TFont).FOnChange;
|
---|
592 | Color := (Source as TFont).Color;
|
---|
593 | end;
|
---|
594 | end;
|
---|
595 |
|
---|
596 | procedure TFont.GetTextSize(Text: string; var w, h: Integer);
|
---|
597 | begin
|
---|
598 | W := GetTextWidth(Text);
|
---|
599 | H := GetTextHeight(Text);
|
---|
600 | end;
|
---|
601 |
|
---|
602 | function TFont.GetTextHeight(Text: string): Integer;
|
---|
603 | begin
|
---|
604 | Result := ScaleFromNative(GetNativeFont.GetTextHeight(Text));
|
---|
605 | end;
|
---|
606 |
|
---|
607 | function TFont.GetTextWidth(Text: string): Integer;
|
---|
608 | begin
|
---|
609 | Result := ScaleFromNative(GetNativeFont.GetTextWidth(Text));
|
---|
610 | end;
|
---|
611 |
|
---|
612 | { TRasterImage }
|
---|
613 |
|
---|
614 | function TRasterImage.GetCanvas: TCanvas;
|
---|
615 | begin
|
---|
616 | Result := FCanvas;
|
---|
617 | end;
|
---|
618 |
|
---|
619 | function TRasterImage.GetRawImage: TRawImage;
|
---|
620 | begin
|
---|
621 | Result := GetNativeRasterImage.RawImage;
|
---|
622 | end;
|
---|
623 |
|
---|
624 | function TRasterImage.GetHeight: Integer;
|
---|
625 | begin
|
---|
626 | Result := ScaleFromNative(GetNativeRasterImage.Height);
|
---|
627 | end;
|
---|
628 |
|
---|
629 | function TRasterImage.GetWidth: Integer;
|
---|
630 | begin
|
---|
631 | Result := ScaleFromNative(GetNativeRasterImage.Width);
|
---|
632 | end;
|
---|
633 |
|
---|
634 | procedure TRasterImage.SetWidth(Value: Integer);
|
---|
635 | begin
|
---|
636 | SetSize(Value, Height);
|
---|
637 | end;
|
---|
638 |
|
---|
639 | procedure TRasterImage.SetHeight(Value: Integer);
|
---|
640 | begin
|
---|
641 | SetSize(Width, Value);
|
---|
642 | end;
|
---|
643 |
|
---|
644 | function TRasterImage.GetNativeRasterImage: Graphics.TRasterImage;
|
---|
645 | begin
|
---|
646 | Result := nil;
|
---|
647 | end;
|
---|
648 |
|
---|
649 | constructor TRasterImage.Create;
|
---|
650 | begin
|
---|
651 | inherited;
|
---|
652 | FCanvas := TCanvas.Create;
|
---|
653 | FCanvas.NativeCanvas := GetNativeRasterImage.Canvas;
|
---|
654 | end;
|
---|
655 |
|
---|
656 | destructor TRasterImage.Destroy;
|
---|
657 | begin
|
---|
658 | FreeAndNil(FCanvas);
|
---|
659 | inherited;
|
---|
660 | end;
|
---|
661 |
|
---|
662 | procedure TRasterImage.BeginUpdate(ACanvasOnly: Boolean);
|
---|
663 | begin
|
---|
664 | GetNativeRasterImage.BeginUpdate(ACanvasOnly);
|
---|
665 | end;
|
---|
666 |
|
---|
667 | procedure TRasterImage.EndUpdate(AStreamIsValid: Boolean);
|
---|
668 | begin
|
---|
669 | GetNativeRasterImage.EndUpdate(AStreamIsValid);
|
---|
670 | end;
|
---|
671 |
|
---|
672 | function TRasterImage.GetNativeGraphic: Graphics.TGraphic;
|
---|
673 | begin
|
---|
674 | Result := GetNativeRasterImage;
|
---|
675 | end;
|
---|
676 |
|
---|
677 | { TGraphic }
|
---|
678 |
|
---|
679 | function TGraphic.GetNativeGraphic: Graphics.TGraphic;
|
---|
680 | begin
|
---|
681 | Result := nil;
|
---|
682 | end;
|
---|
683 |
|
---|
684 | procedure TGraphic.ScreenChanged;
|
---|
685 | begin
|
---|
686 | end;
|
---|
687 |
|
---|
688 | procedure TGraphic.SetDpi(AValue: Integer);
|
---|
689 | begin
|
---|
690 | FDpi := AValue;
|
---|
691 | ScreenChanged;
|
---|
692 | end;
|
---|
693 |
|
---|
694 | function TGraphic.GetDpi: Integer;
|
---|
695 | begin
|
---|
696 | Result := FDpi;
|
---|
697 | end;
|
---|
698 |
|
---|
699 | constructor TGraphic.Create;
|
---|
700 | begin
|
---|
701 | Dpi := ScreenInfo.Dpi;
|
---|
702 | end;
|
---|
703 |
|
---|
704 | procedure StretchDrawBitmap(Src: Graphics.TRasterImage; Dst: Graphics.TCustomBitmap);
|
---|
705 | var
|
---|
706 | SrcPtr: TPixelPointer;
|
---|
707 | DstPtr: TPixelPointer;
|
---|
708 | XX, YY: Integer;
|
---|
709 | DstPixelX, DstPixelY: Integer;
|
---|
710 | DstPixelWidth, DstPixelHeight: Integer;
|
---|
711 | begin
|
---|
712 | Dst.BeginUpdate;
|
---|
713 | SrcPtr := TPixelPointer.Create(Src, 0, 0);
|
---|
714 | DstPtr := TPixelPointer.Create(Dst, 0, 0);
|
---|
715 | for YY := 0 to Src.Height - 1 do begin
|
---|
716 | DstPixelHeight := ScaleToNative(YY + 1) - ScaleToNative(YY);
|
---|
717 | for DstPixelY := 0 to DstPixelHeight - 1 do begin
|
---|
718 | for XX := 0 to Src.Width - 1 do begin
|
---|
719 | DstPixelWidth := ScaleToNative(XX + 1) - ScaleToNative(XX);
|
---|
720 | for DstPixelX := 0 to DstPixelWidth - 1 do begin
|
---|
721 | DstPtr.PixelRGB := SrcPtr.PixelRGB;
|
---|
722 | DstPtr.NextPixel;
|
---|
723 | end;
|
---|
724 | SrcPtr.NextPixel;
|
---|
725 | end;
|
---|
726 | DstPtr.NextLine;
|
---|
727 | SrcPtr.SetX(0);
|
---|
728 | end;
|
---|
729 | SrcPtr.NextLine;
|
---|
730 | end;
|
---|
731 | Dst.EndUpdate;
|
---|
732 | end;
|
---|
733 |
|
---|
734 | procedure TGraphic.LoadFromFile(const Filename: string);
|
---|
735 | var
|
---|
736 | Bitmap: Graphics.TGraphic;
|
---|
737 | begin
|
---|
738 | Bitmap := NativeGraphicClass.Create;
|
---|
739 | try
|
---|
740 | Bitmap.LoadFromFile(FileName);
|
---|
741 | if Self is TRasterImage then begin
|
---|
742 | TRasterImage(Self).SetSize(Bitmap.Width, Bitmap.Height);
|
---|
743 | end else begin
|
---|
744 | Width := Bitmap.Width;
|
---|
745 | Height := Bitmap.Height;
|
---|
746 | end;
|
---|
747 | if Self is TCustomBitmap then begin
|
---|
748 | StretchDrawBitmap(Graphics.TRasterImage(Bitmap),
|
---|
749 | Graphics.TCustomBitmap(GetNativeGraphic));
|
---|
750 | //Graphics.TBitmap(GetNativeGraphic).Canvas.StretchDraw(Bounds(0, 0,
|
---|
751 | //Graphics.TBitmap(GetNativeGraphic).Width, TBitmap(GetNativeGraphic).Height), Bitmap);
|
---|
752 | end else raise Exception.Create('Unsupported class ' + Self.ClassName);
|
---|
753 | finally
|
---|
754 | FreeAndNil(Bitmap);
|
---|
755 | end;
|
---|
756 | end;
|
---|
757 |
|
---|
758 | procedure TGraphic.SaveToFile(const Filename: string);
|
---|
759 | var
|
---|
760 | Bitmap: Graphics.TGraphic;
|
---|
761 | begin
|
---|
762 | Bitmap := NativeGraphicClass.Create;
|
---|
763 | try
|
---|
764 | Bitmap.Width := Width;
|
---|
765 | Bitmap.Height := Height;
|
---|
766 | if Self is TBitmap then begin
|
---|
767 | if Bitmap is Graphics.TRasterImage then
|
---|
768 | (Bitmap as Graphics.TRasterImage).Canvas.StretchDraw(Bounds(0, 0, Bitmap.Width,
|
---|
769 | Bitmap.Height), Graphics.TBitmap(GetNativeGraphic))
|
---|
770 | else raise Exception.Create('Expected TRasterImage but got ' + Bitmap.ClassName);
|
---|
771 | end else raise Exception.Create('Unsupported class ' + Self.ClassName);
|
---|
772 | Bitmap.SaveToFile(FileName);
|
---|
773 | finally
|
---|
774 | FreeAndNil(Bitmap);
|
---|
775 | end;
|
---|
776 | end;
|
---|
777 |
|
---|
778 | { TBitmap }
|
---|
779 |
|
---|
780 | function TBitmap.GetScanLine(Row: Integer): Pointer;
|
---|
781 | begin
|
---|
782 | Result := GetNativeBitmap.ScanLine[Row];
|
---|
783 | end;
|
---|
784 |
|
---|
785 | function TBitmap.GetTransparent: Boolean;
|
---|
786 | begin
|
---|
787 | Result := GetNativeBitmap.Transparent;
|
---|
788 | end;
|
---|
789 |
|
---|
790 | function TBitmap.GetTransparentColor: TColor;
|
---|
791 | begin
|
---|
792 | Result := GetNativeBitmap.TransparentColor;
|
---|
793 | end;
|
---|
794 |
|
---|
795 | procedure TBitmap.SetTransparent(AValue: Boolean);
|
---|
796 | begin
|
---|
797 | GetNativeBitmap.Transparent := AValue;
|
---|
798 | end;
|
---|
799 |
|
---|
800 | procedure TBitmap.SetTransparentColor(AValue: TColor);
|
---|
801 | begin
|
---|
802 | GetNativeBitmap.TransparentColor := AValue;
|
---|
803 | end;
|
---|
804 |
|
---|
805 | function TBitmap.GetNativeBitmap: Graphics.TBitmap;
|
---|
806 | begin
|
---|
807 | Result := NativeBitmap;
|
---|
808 | end;
|
---|
809 |
|
---|
810 | function TBitmap.GetNativeCustomBitmap: Graphics.TCustomBitmap;
|
---|
811 | begin
|
---|
812 | Result := GetNativeBitmap;
|
---|
813 | end;
|
---|
814 |
|
---|
815 | procedure TBitmap.SetNativeBitmap(ANativeBitmap: Graphics.TBitmap);
|
---|
816 | begin
|
---|
817 | NativeBitmap := ANativeBitmap;
|
---|
818 | end;
|
---|
819 |
|
---|
820 | procedure TBitmap.SetNativeCustomBitmap(CustomBitmap: Graphics.TCustomBitmap);
|
---|
821 | begin
|
---|
822 | SetNativeBitmap(Graphics.TBitmap(CustomBitmap));
|
---|
823 | end;
|
---|
824 |
|
---|
825 | constructor TBitmap.Create;
|
---|
826 | begin
|
---|
827 | NativeGraphicClass := Graphics.TBitmap;
|
---|
828 | NativeBitmap := Graphics.TBitmap.Create;
|
---|
829 | inherited;
|
---|
830 | end;
|
---|
831 |
|
---|
832 | destructor TBitmap.Destroy;
|
---|
833 | begin
|
---|
834 | FreeAndNil(FCanvas);
|
---|
835 | FreeAndNil(NativeBitmap);
|
---|
836 | inherited;
|
---|
837 | end;
|
---|
838 |
|
---|
839 | { TPen }
|
---|
840 |
|
---|
841 | function TPen.GetColor: TColor;
|
---|
842 | begin
|
---|
843 | Result := GetNativePen.Color;
|
---|
844 | end;
|
---|
845 |
|
---|
846 | function TPen.GetStyle: TPenStyle;
|
---|
847 | begin
|
---|
848 | Result := GetNativePen.Style;
|
---|
849 | end;
|
---|
850 |
|
---|
851 | function TPen.GetWidth: Integer;
|
---|
852 | begin
|
---|
853 | Result := FWidth;
|
---|
854 | end;
|
---|
855 |
|
---|
856 | procedure TPen.SetColor(AValue: TColor);
|
---|
857 | begin
|
---|
858 | GetNativePen.Color := AValue;
|
---|
859 | end;
|
---|
860 |
|
---|
861 | procedure TPen.SetNativePen(AValue: Graphics.TPen);
|
---|
862 | begin
|
---|
863 | if FNativePen = AValue then Exit;
|
---|
864 | if FNativePenFree then FreeAndNil(FNativePen);
|
---|
865 | FNativePenFree := False;
|
---|
866 | FNativePen := AValue;
|
---|
867 | SetWidth(FWidth);
|
---|
868 | end;
|
---|
869 |
|
---|
870 | procedure TPen.SetStyle(AValue: TPenStyle);
|
---|
871 | begin
|
---|
872 | GetNativePen.Style := AValue;
|
---|
873 | end;
|
---|
874 |
|
---|
875 | procedure TPen.SetWidth(AValue: Integer);
|
---|
876 | begin
|
---|
877 | GetNativePen.Width := ScaleToNative(AValue);
|
---|
878 | FWidth := AValue;
|
---|
879 | end;
|
---|
880 |
|
---|
881 | constructor TPen.Create;
|
---|
882 | begin
|
---|
883 | FNativePen := Graphics.TPen.Create;
|
---|
884 | FNativePenFree := True;
|
---|
885 | FWidth := 1;
|
---|
886 | end;
|
---|
887 |
|
---|
888 | destructor TPen.Destroy;
|
---|
889 | begin
|
---|
890 | if FNativePenFree then
|
---|
891 | FreeAndNil(FNativePen);
|
---|
892 | inherited;
|
---|
893 | end;
|
---|
894 |
|
---|
895 | function TPen.GetNativePen: Graphics.TPen;
|
---|
896 | begin
|
---|
897 | Result := FNativePen;
|
---|
898 | end;
|
---|
899 |
|
---|
900 | procedure TPen.Assign(Source: TPen);
|
---|
901 | begin
|
---|
902 | FWidth := Source.FWidth;
|
---|
903 | GetNativePen.Assign(Source.GetNativePen);
|
---|
904 | end;
|
---|
905 |
|
---|
906 | { TBrush }
|
---|
907 |
|
---|
908 | function TBrush.GetColor: TColor;
|
---|
909 | begin
|
---|
910 | Result := GetNativeBrush.Color;
|
---|
911 | end;
|
---|
912 |
|
---|
913 | function TBrush.GetStyle: TBrushStyle;
|
---|
914 | begin
|
---|
915 | Result := GetNativeBrush.Style;
|
---|
916 | end;
|
---|
917 |
|
---|
918 | procedure TBrush.SetColor(AValue: TColor);
|
---|
919 | begin
|
---|
920 | GetNativeBrush.Color := AValue;
|
---|
921 | end;
|
---|
922 |
|
---|
923 | function TBrush.GetNativeBrush: Graphics.TBrush;
|
---|
924 | begin
|
---|
925 | Result := FNativeBrush;
|
---|
926 | end;
|
---|
927 |
|
---|
928 | procedure TBrush.SetNativeBrush(AValue: Graphics.TBrush);
|
---|
929 | begin
|
---|
930 | if FNativeBrush = AValue then Exit;
|
---|
931 | if FNativeBrushFree then FreeAndNil(FNativeBrush);
|
---|
932 | FNativeBrushFree := False;
|
---|
933 | FNativeBrush := AValue;
|
---|
934 | end;
|
---|
935 |
|
---|
936 | procedure TBrush.SetStyle(AValue: TBrushStyle);
|
---|
937 | begin
|
---|
938 | GetNativeBrush.Style := AValue;
|
---|
939 | end;
|
---|
940 |
|
---|
941 | constructor TBrush.Create;
|
---|
942 | begin
|
---|
943 | FNativeBrush := Graphics.TBrush.Create;
|
---|
944 | FNativeBrushFree := True;
|
---|
945 | end;
|
---|
946 |
|
---|
947 | destructor TBrush.Destroy;
|
---|
948 | begin
|
---|
949 | if FNativeBrushFree then FreeAndNil(FNativeBrush);
|
---|
950 | inherited;
|
---|
951 | end;
|
---|
952 |
|
---|
953 | procedure TBrush.Assign(Source: TBrush);
|
---|
954 | begin
|
---|
955 | GetNativeBrush.Assign(Source.GetNativeBrush);
|
---|
956 | end;
|
---|
957 |
|
---|
958 | { TCanvas }
|
---|
959 |
|
---|
960 | function TCanvas.GetHandle: HDC;
|
---|
961 | begin
|
---|
962 | Result := GetNativeCanvas.Handle;
|
---|
963 | end;
|
---|
964 |
|
---|
965 | function TCanvas.GetHeight: Integer;
|
---|
966 | begin
|
---|
967 | Result := ScaleFromNative(GetNativeCanvas.Height);
|
---|
968 | end;
|
---|
969 |
|
---|
970 | function TCanvas.GetPixel(X, Y: Integer): TColor;
|
---|
971 | begin
|
---|
972 | Result := GetNativeCanvas.Pixels[ScaleToNative(X), ScaleToNative(Y)];
|
---|
973 | end;
|
---|
974 |
|
---|
975 | function TCanvas.GetTextStyle: TTextStyle;
|
---|
976 | begin
|
---|
977 | Result := GetNativeCanvas.TextStyle;
|
---|
978 | end;
|
---|
979 |
|
---|
980 | function TCanvas.GetWidth: Integer;
|
---|
981 | begin
|
---|
982 | Result := ScaleFromNative(GetNativeCanvas.Width);
|
---|
983 | end;
|
---|
984 |
|
---|
985 | procedure TCanvas.SetBrush(AValue: TBrush);
|
---|
986 | begin
|
---|
987 | if FBrush = AValue then Exit;
|
---|
988 | if FBrushFree then FreeAndNil(FBrush);
|
---|
989 | FBrushFree := False;
|
---|
990 | FBrush := AValue;
|
---|
991 | end;
|
---|
992 |
|
---|
993 | procedure TCanvas.SetFont(AValue: TFont);
|
---|
994 | begin
|
---|
995 | if FFont = AValue then Exit;
|
---|
996 | if FFontFree then FreeAndNil(FFont);
|
---|
997 | FFontFree := False;
|
---|
998 | FFont := AValue;
|
---|
999 | end;
|
---|
1000 |
|
---|
1001 | procedure TCanvas.SetHandle(AValue: HDC);
|
---|
1002 | begin
|
---|
1003 | GetNativeCanvas.Handle := AValue;
|
---|
1004 | end;
|
---|
1005 |
|
---|
1006 | procedure TCanvas.SetHeight(AValue: Integer);
|
---|
1007 | begin
|
---|
1008 | GetNativeCanvas.Height;
|
---|
1009 | end;
|
---|
1010 |
|
---|
1011 | procedure TCanvas.SetWidth(AValue: Integer);
|
---|
1012 | begin
|
---|
1013 |
|
---|
1014 | end;
|
---|
1015 |
|
---|
1016 | procedure TCanvas.SetPen(AValue: TPen);
|
---|
1017 | begin
|
---|
1018 | if FPen = AValue then Exit;
|
---|
1019 | if FPenFree then FreeAndNil(FPen);
|
---|
1020 | FPenFree := False;
|
---|
1021 | FPen := AValue;
|
---|
1022 | end;
|
---|
1023 |
|
---|
1024 | procedure TCanvas.SetPixel(X, Y: Integer; AValue: TColor);
|
---|
1025 | var
|
---|
1026 | BrushStyle: TBrushStyle;
|
---|
1027 | BrushColor: TColor;
|
---|
1028 | begin
|
---|
1029 | { BrushStyle := GetNativeCanvas.Brush.Style;
|
---|
1030 | BrushColor := GetNativeCanvas.Brush.Color;
|
---|
1031 | GetNativeCanvas.Brush.Color := AValue;
|
---|
1032 | GetNativeCanvas.Brush.Style := bsClear;
|
---|
1033 | GetNativeCanvas.FillRect(ScaleToNative(X), ScaleToNative(Y), ScaleToNative(X + 1) - 1, ScaleToNative(Y + 1) - 1);
|
---|
1034 | GetNativeCanvas.Brush.Style := BrushStyle;
|
---|
1035 | GetNativeCanvas.Brush.Color := BrushColor;
|
---|
1036 | }
|
---|
1037 | GetNativeCanvas.Pixels[ScaleToNative(X), ScaleToNative(Y)] := AValue;
|
---|
1038 | end;
|
---|
1039 |
|
---|
1040 | procedure TCanvas.SetNativeCanvas(AValue: Graphics.TCanvas);
|
---|
1041 | begin
|
---|
1042 | if FNativeCanvas = AValue then Exit;
|
---|
1043 | if FNativeCanvasFree then FreeAndNil(FNativeCanvas);
|
---|
1044 | FNativeCanvasFree := False;
|
---|
1045 | FNativeCanvas := AValue;
|
---|
1046 | if Assigned(FNativeCanvas) then begin
|
---|
1047 | FFont.NativeFont := FNativeCanvas.Font;
|
---|
1048 | FBrush.NativeBrush := FNativeCanvas.Brush;
|
---|
1049 | FPen.NativePen := FNativeCanvas.Pen;
|
---|
1050 | end;
|
---|
1051 | end;
|
---|
1052 |
|
---|
1053 | procedure TCanvas.SetTextStyle(AValue: TTextStyle);
|
---|
1054 | begin
|
---|
1055 | GetNativeCanvas.TextStyle := AValue;
|
---|
1056 | end;
|
---|
1057 |
|
---|
1058 | procedure TCanvas.DoLine(X1, Y1, X2, Y2: Integer);
|
---|
1059 | begin
|
---|
1060 | raise ENotImplemented.Create(SNotImplemented);
|
---|
1061 | end;
|
---|
1062 |
|
---|
1063 | procedure TCanvas.DoTextOut(X, Y: Integer; Text: string);
|
---|
1064 | begin
|
---|
1065 | raise ENotImplemented.Create(SNotImplemented);
|
---|
1066 | end;
|
---|
1067 |
|
---|
1068 | procedure TCanvas.DoRectangle(const Bounds: TRect);
|
---|
1069 | begin
|
---|
1070 | raise ENotImplemented.Create(SNotImplemented);
|
---|
1071 | end;
|
---|
1072 |
|
---|
1073 | procedure TCanvas.DoRectangleFill(const Bounds: TRect);
|
---|
1074 | begin
|
---|
1075 | raise ENotImplemented.Create(SNotImplemented);
|
---|
1076 | end;
|
---|
1077 |
|
---|
1078 | procedure TCanvas.DoPolygon(const Points: array of TPoint);
|
---|
1079 | begin
|
---|
1080 | raise ENotImplemented.Create(SNotImplemented);
|
---|
1081 | end;
|
---|
1082 |
|
---|
1083 | procedure TCanvas.CreateHandle;
|
---|
1084 | begin
|
---|
1085 | raise ENotImplemented.Create(SNotImplemented);
|
---|
1086 | end;
|
---|
1087 |
|
---|
1088 | procedure TCanvas.DoEllipse(const Bounds: TRect);
|
---|
1089 | begin
|
---|
1090 | raise ENotImplemented.Create(SNotImplemented);
|
---|
1091 | end;
|
---|
1092 |
|
---|
1093 | procedure TCanvas.DoMoveTo(X, Y: Integer);
|
---|
1094 | begin
|
---|
1095 | raise ENotImplemented.Create(SNotImplemented);
|
---|
1096 | end;
|
---|
1097 |
|
---|
1098 | procedure TCanvas.DoLineTo(X, Y: Integer);
|
---|
1099 | begin
|
---|
1100 | raise ENotImplemented.Create(SNotImplemented);
|
---|
1101 | end;
|
---|
1102 |
|
---|
1103 | procedure TCanvas.DoPolyline(const Points: array of TPoint);
|
---|
1104 | begin
|
---|
1105 | raise ENotImplemented.Create(SNotImplemented);
|
---|
1106 | end;
|
---|
1107 |
|
---|
1108 | procedure TCanvas.DoPolyBezier(Points: PPoint; NumPts: Integer;
|
---|
1109 | Filled: Boolean; Continuous: Boolean);
|
---|
1110 | begin
|
---|
1111 | raise ENotImplemented.Create(SNotImplemented);
|
---|
1112 | end;
|
---|
1113 |
|
---|
1114 | function TCanvas.GetNativeCanvas: Graphics.TCanvas;
|
---|
1115 | begin
|
---|
1116 | Result := NativeCanvas;
|
---|
1117 | end;
|
---|
1118 |
|
---|
1119 | procedure TCanvas.RoundRect(const Rect: TRect; RX, RY: Integer);
|
---|
1120 | begin
|
---|
1121 | GetNativeCanvas.RoundRect(Rect, RX, RY);
|
---|
1122 | end;
|
---|
1123 |
|
---|
1124 | procedure TCanvas.RoundRect(X1, Y1, X2, Y2: Integer; RX, RY: Integer);
|
---|
1125 | begin
|
---|
1126 | GetNativeCanvas.RoundRect(X1, Y1, X2, Y2, RX, RY);
|
---|
1127 | end;
|
---|
1128 |
|
---|
1129 | procedure TCanvas.Polygon(const Points: array of TPoint; Winding: Boolean;
|
---|
1130 | StartIndex: Integer; NumPts: Integer);
|
---|
1131 | begin
|
---|
1132 | GetNativeCanvas.Polygon(Points, Winding, StartIndex, NumPts);
|
---|
1133 | end;
|
---|
1134 |
|
---|
1135 | procedure TCanvas.Polygon(Points: PPoint; NumPts: Integer; Winding: Boolean);
|
---|
1136 | begin
|
---|
1137 | GetNativeCanvas.Polygon(Points, NumPts, Winding);
|
---|
1138 | end;
|
---|
1139 |
|
---|
1140 | procedure TCanvas.Polygon(const Points: array of TPoint);
|
---|
1141 | begin
|
---|
1142 | GetNativeCanvas.Polygon(Points);
|
---|
1143 | end;
|
---|
1144 |
|
---|
1145 | procedure TCanvas.PolyBezier(const Points: array of TPoint; Filled: Boolean;
|
---|
1146 | Continuous: boolean);
|
---|
1147 | begin
|
---|
1148 | GetNativeCanvas.Polyline(Points);
|
---|
1149 | end;
|
---|
1150 |
|
---|
1151 | procedure TCanvas.PolyBezier(Points: PPoint; NumPts: Integer;
|
---|
1152 | Filled: Boolean; Continuous: Boolean);
|
---|
1153 | begin
|
---|
1154 | GetNativeCanvas.PolyBezier(Points, NumPts, Filled, Continuous);
|
---|
1155 | end;
|
---|
1156 |
|
---|
1157 | procedure TCanvas.Polyline(const Points: array of TPoint);
|
---|
1158 | begin
|
---|
1159 | GetNativeCanvas.Polyline(Points);
|
---|
1160 | end;
|
---|
1161 |
|
---|
1162 | procedure TCanvas.Polyline(Points: PPoint; NumPts: Integer);
|
---|
1163 | begin
|
---|
1164 | GetNativeCanvas.Polyline(Points, NumPts);
|
---|
1165 | end;
|
---|
1166 |
|
---|
1167 | procedure TCanvas.Ellipse(x1, y1, x2, y2: Integer);
|
---|
1168 | begin
|
---|
1169 | GetNativeCanvas.Ellipse(X1, Y1, X2, Y2);
|
---|
1170 | end;
|
---|
1171 |
|
---|
1172 | procedure TCanvas.Ellipse(const ARect: TRect);
|
---|
1173 | begin
|
---|
1174 | Ellipse(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
|
---|
1175 | end;
|
---|
1176 |
|
---|
1177 | {procedure TCanvas.StretchDraw(const DestRect: TRect; SrcGraphic: Graphics.TGraphic);
|
---|
1178 | begin
|
---|
1179 | GetNativeCanvas.StretchDraw(DestRect, SrcGraphic);
|
---|
1180 | end;
|
---|
1181 | }
|
---|
1182 | procedure TCanvas.Pie(EllipseX1, EllipseY1, EllipseX2, EllipseY2, StartX,
|
---|
1183 | StartY, EndX, EndY: Integer);
|
---|
1184 | begin
|
---|
1185 | GetNativeCanvas.Pie(EllipseX1, EllipseY1, EllipseX2, EllipseY2, StartX, StartY,
|
---|
1186 | EndX, EndY);
|
---|
1187 | end;
|
---|
1188 |
|
---|
1189 | procedure TCanvas.StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic
|
---|
1190 | );
|
---|
1191 | begin
|
---|
1192 | GetNativeCanvas.StretchDraw(ScaleRectToNative(DestRect), SrcGraphic.GetNativeGraphic);
|
---|
1193 | end;
|
---|
1194 |
|
---|
1195 | procedure TCanvas.FrameRect(Rect: TRect);
|
---|
1196 | begin
|
---|
1197 | GetNativeCanvas.FrameRect(ScaleRectToNative(Rect));
|
---|
1198 | end;
|
---|
1199 |
|
---|
1200 | procedure TCanvas.Rectangle(X1, Y1, X2, Y2: Integer);
|
---|
1201 | begin
|
---|
1202 | GetNativeCanvas.Rectangle(ScaleToNative(X1), ScaleToNative(Y1), ScaleToNative(X2), ScaleToNative(Y2));
|
---|
1203 | end;
|
---|
1204 |
|
---|
1205 | procedure TCanvas.Rectangle(const ARect: TRect);
|
---|
1206 | begin
|
---|
1207 | Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
|
---|
1208 | end;
|
---|
1209 |
|
---|
1210 | function TCanvas.TextWidth(const Text: string): Integer;
|
---|
1211 | begin
|
---|
1212 | Result := ScaleFromNative(GetNativeCanvas.TextWidth(Text));
|
---|
1213 | end;
|
---|
1214 |
|
---|
1215 | function TCanvas.TextHeight(const Text: string): Integer;
|
---|
1216 | begin
|
---|
1217 | Result := ScaleFromNative(GetNativeCanvas.TextHeight(Text));
|
---|
1218 | end;
|
---|
1219 |
|
---|
1220 | function TCanvas.TextExtent(const Text: string): TSize;
|
---|
1221 | begin
|
---|
1222 | Result := ScaleSizeFromNative(GetNativeCanvas.TextExtent(Text));
|
---|
1223 | end;
|
---|
1224 |
|
---|
1225 | procedure TCanvas.TextOut(X, Y: Integer; const Text: string);
|
---|
1226 | begin
|
---|
1227 | GetNativeCanvas.TextOut(ScaleToNative(X), ScaleToNative(Y), Text);
|
---|
1228 | end;
|
---|
1229 |
|
---|
1230 | procedure TCanvas.TextRect(ARect: TRect; X, Y: Integer; Text: string);
|
---|
1231 | begin
|
---|
1232 | GetNativeCanvas.TextRect(ScaleRectToNative(ARect), ScaleToNative(X),
|
---|
1233 | ScaleToNative(Y), Text);
|
---|
1234 | end;
|
---|
1235 |
|
---|
1236 | procedure TCanvas.TextRect(ARect: TRect; X, Y: integer; const Text: string;
|
---|
1237 | const Style: TTextStyle);
|
---|
1238 | begin
|
---|
1239 | GetNativeCanvas.TextRect(ScaleRectToNative(ARect), ScaleToNative(X),
|
---|
1240 | ScaleToNative(Y), Text, TextStyle);
|
---|
1241 | end;
|
---|
1242 |
|
---|
1243 | procedure TCanvas.MoveTo(X, Y: Integer);
|
---|
1244 | begin
|
---|
1245 | GetNativeCanvas.MoveTo(ScaleToNative(X), ScaleToNative(Y));
|
---|
1246 | end;
|
---|
1247 |
|
---|
1248 | procedure TCanvas.LineTo(X, Y: Integer);
|
---|
1249 | begin
|
---|
1250 | GetNativeCanvas.LineTo(ScaleToNative(X), ScaleToNative(Y));
|
---|
1251 | end;
|
---|
1252 |
|
---|
1253 | procedure TCanvas.Line(const p1, p2: TPoint);
|
---|
1254 | begin
|
---|
1255 | GetNativeCanvas.Line(P1, P2);
|
---|
1256 | end;
|
---|
1257 |
|
---|
1258 | procedure TCanvas.FillRect(const ARect: TRect);
|
---|
1259 | begin
|
---|
1260 | GetNativeCanvas.FillRect(ScaleRectToNative(ARect));
|
---|
1261 | end;
|
---|
1262 |
|
---|
1263 | procedure TCanvas.FillRect(X1, Y1, X2, Y2: Integer);
|
---|
1264 | begin
|
---|
1265 | GetNativeCanvas.FillRect(ScaleToNative(X1), ScaleToNative(Y1), ScaleToNative(X2), ScaleToNative(Y2));
|
---|
1266 | end;
|
---|
1267 |
|
---|
1268 | procedure TCanvas.Draw(X, Y: Integer; Source: TGraphic);
|
---|
1269 | begin
|
---|
1270 | GetNativeCanvas.Draw(ScaleToNative(X), ScaleToNative(Y), Source.GetNativeGraphic);
|
---|
1271 | end;
|
---|
1272 |
|
---|
1273 | procedure TCanvas.CopyRect(Dest: TRect; SrcCanvas: TCanvas;
|
---|
1274 | Source: TRect);
|
---|
1275 | begin
|
---|
1276 | GetNativeCanvas.CopyRect(Dest, SrcCanvas.NativeCanvas, ScaleRectToNative(Source));
|
---|
1277 | end;
|
---|
1278 |
|
---|
1279 | constructor TCanvas.Create;
|
---|
1280 | begin
|
---|
1281 | FNativeCanvas := nil;
|
---|
1282 | FFont := TFont.Create;
|
---|
1283 | FFontFree := True;
|
---|
1284 | FPen := TPen.Create;
|
---|
1285 | FPenFree := True;
|
---|
1286 | FBrush := TBrush.Create;
|
---|
1287 | FBrushFree := True;
|
---|
1288 | end;
|
---|
1289 |
|
---|
1290 | destructor TCanvas.Destroy;
|
---|
1291 | begin
|
---|
1292 | if FFontFree then FreeAndNil(FFont);
|
---|
1293 | if FBrushFree then FreeAndNil(FBrush);
|
---|
1294 | if FPenFree then FreeAndNil(FPen);
|
---|
1295 | if FNativeCanvasFree then FreeAndNil(FNativeCanvasFree);
|
---|
1296 | inherited;
|
---|
1297 | end;
|
---|
1298 |
|
---|
1299 | { TJpegImage }
|
---|
1300 |
|
---|
1301 | function TJpegImage.GetNativeCustomBitmap: Graphics.TCustomBitmap;
|
---|
1302 | begin
|
---|
1303 | Result := GetNativeJpeg;
|
---|
1304 | end;
|
---|
1305 |
|
---|
1306 | function TJpegImage.GetNativeJpeg: Graphics.TJPEGImage;
|
---|
1307 | begin
|
---|
1308 | Result := NativeJpeg;
|
---|
1309 | end;
|
---|
1310 |
|
---|
1311 | procedure TJpegImage.SetNativeCustomBitmap(CustomBitmap: Graphics.TCustomBitmap
|
---|
1312 | );
|
---|
1313 | begin
|
---|
1314 | SetNativeJpeg(Graphics.TJpegImage(CustomBitmap));
|
---|
1315 | end;
|
---|
1316 |
|
---|
1317 | procedure TJpegImage.SetNativeJpeg(Jpeg: Graphics.TJPEGImage);
|
---|
1318 | begin
|
---|
1319 | NativeJpeg := Jpeg;
|
---|
1320 | end;
|
---|
1321 |
|
---|
1322 | constructor TJpegImage.Create;
|
---|
1323 | begin
|
---|
1324 | NativeJpeg := Graphics.TJPEGImage.Create;
|
---|
1325 | NativeGraphicClass := Graphics.TJPEGImage;
|
---|
1326 | inherited;
|
---|
1327 | end;
|
---|
1328 |
|
---|
1329 | destructor TJpegImage.Destroy;
|
---|
1330 | begin
|
---|
1331 | FreeAndNil(NativeJpeg);
|
---|
1332 | inherited;
|
---|
1333 | end;
|
---|
1334 |
|
---|
1335 | { TPicture }
|
---|
1336 |
|
---|
1337 | procedure TPicture.SetBitmap(AValue: TBitmap);
|
---|
1338 | begin
|
---|
1339 | if FBitmap = AValue then Exit;
|
---|
1340 | FBitmap := AValue;
|
---|
1341 | end;
|
---|
1342 |
|
---|
1343 | procedure TPicture.LoadFromFile(FileName: string);
|
---|
1344 | begin
|
---|
1345 | end;
|
---|
1346 |
|
---|
1347 | { TScreenInfo }
|
---|
1348 |
|
---|
1349 | procedure TScreenInfo.SetDpi(AValue: Integer);
|
---|
1350 | var
|
---|
1351 | I: Integer;
|
---|
1352 | begin
|
---|
1353 | if FDpi = AValue then Exit;
|
---|
1354 | FDpi := AValue;
|
---|
1355 | ToNative := ScreenInfo.Dpi / 96;
|
---|
1356 |
|
---|
1357 | // Precalculate scaling coefficients
|
---|
1358 | FromNative := 96 / ScreenInfo.Dpi;
|
---|
1359 | for I := Low(Lookup) to High(Lookup) do
|
---|
1360 | Lookup[I] := Ceil(I * ToNative);
|
---|
1361 | end;
|
---|
1362 |
|
---|
1363 | { TPortableNetworkGraphic }
|
---|
1364 |
|
---|
1365 | function TPortableNetworkGraphic.GetNativeCustomBitmap: Graphics.TCustomBitmap;
|
---|
1366 | begin
|
---|
1367 | Result := GetNativePng;
|
---|
1368 | end;
|
---|
1369 |
|
---|
1370 | function TPortableNetworkGraphic.GetNativePng: Graphics.TPortableNetworkGraphic;
|
---|
1371 | begin
|
---|
1372 | Result := NativePng;
|
---|
1373 | end;
|
---|
1374 |
|
---|
1375 | procedure TPortableNetworkGraphic.SetNativeCustomBitmap(
|
---|
1376 | CustomBitmap: Graphics.TCustomBitmap);
|
---|
1377 | begin
|
---|
1378 | SetNativePng(Graphics.TPortableNetworkGraphic(CustomBitmap));
|
---|
1379 | end;
|
---|
1380 |
|
---|
1381 | procedure TPortableNetworkGraphic.SetNativePng(
|
---|
1382 | Png: Graphics.TPortableNetworkGraphic);
|
---|
1383 | begin
|
---|
1384 | NativePng := Png;
|
---|
1385 | end;
|
---|
1386 |
|
---|
1387 | constructor TPortableNetworkGraphic.Create;
|
---|
1388 | begin
|
---|
1389 | NativePng := Graphics.TPortableNetworkGraphic.Create;
|
---|
1390 | NativeGraphicClass := Graphics.TPortableNetworkGraphic;
|
---|
1391 | inherited;
|
---|
1392 | end;
|
---|
1393 |
|
---|
1394 | destructor TPortableNetworkGraphic.Destroy;
|
---|
1395 | begin
|
---|
1396 | Canvas.NativeCanvas := nil;
|
---|
1397 | FreeAndNil(NativePng);
|
---|
1398 | inherited;
|
---|
1399 | end;
|
---|
1400 |
|
---|
1401 | end.
|
---|
1402 |
|
---|