source: trunk/Packages/DpiControls/Dpi.Graphics.pas

Last change on this file was 568, checked in by chronos, 2 months ago
  • Fixed: Custom draw ListBox items to keep consistent style on Linux.
  • Fixed: Last game name index error if no saved games.
File size: 36.4 KB
Line 
1unit Dpi.Graphics;
2
3interface
4
5uses
6 Classes, SysUtils, Math, Graphics, LCLType, GraphType, Types;
7
8const
9 clBlack = TColor($000000);
10 clWhite = TColor($ffffff);
11
12type
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
360var
361 ScreenInfo: TScreenInfo;
362
363
364implementation
365
366uses
367 Dpi.Common, NativePixelPointer;
368
369{ TCustomBitmap }
370
371function TCustomBitmap.GetHeight: Integer;
372begin
373 Result := FHeight;
374end;
375
376function TCustomBitmap.GetWidth: Integer;
377begin
378 Result := FWidth;
379end;
380
381function TCustomBitmap.GetPixelFormat: TPixelFormat;
382begin
383 Result := GetNativeCustomBitmap.PixelFormat;
384end;
385
386procedure TCustomBitmap.SetPixelFormat(AValue: TPixelFormat);
387begin
388 GetNativeCustomBitmap.PixelFormat := AValue;
389end;
390
391function TCustomBitmap.GetNativeCustomBitmap: Graphics.TCustomBitmap;
392begin
393 Result := nil;
394end;
395
396function TCustomBitmap.GetNativeRasterImage: Graphics.TRasterImage;
397begin
398 Result := GetNativeCustomBitmap;
399end;
400
401procedure TCustomBitmap.SetNativeRasterImage(RasterImage: Graphics.TRasterImage
402 );
403begin
404 SetNativeCustomBitmap(Graphics.TCustomBitmap(RasterImage));
405end;
406
407procedure TCustomBitmap.ScreenChanged;
408var
409 Bitmap: Graphics.TCustomBitmap;
410 NewWidth: Integer;
411 NewHeight: Integer;
412begin
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;
432end;
433
434procedure TCustomBitmap.Assign(Source: TPersistent);
435begin
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;
441end;
442
443procedure TCustomBitmap.SetSize(AWidth, AHeight: Integer);
444begin
445 FWidth := AWidth;
446 FHeight := AHeight;
447 GetNativeCustomBitmap.SetSize(ScaleToNative(AWidth), ScaleToNative(AHeight));
448end;
449
450{ TFont }
451
452procedure TFont.SetSize(AValue: Integer);
453begin
454 if FSize = AValue then Exit;
455 FSize := AValue;
456 FHeight := -MulDiv(FSize, FPixelsPerInch, 72);
457 UpdateFont;
458 DoChange;
459end;
460
461procedure TFont.DoChange;
462begin
463 if Assigned(FOnChange) then FOnChange(Self);
464end;
465
466procedure TFont.SetStyle(AValue: TFontStyles);
467begin
468 GetNativeFont.Style := AValue;
469end;
470
471procedure TFont.UpdateFont;
472begin
473 if Assigned(GetNativeFont) then begin
474 GetNativeFont.PixelsPerInch := FPixelsPerInch;
475 GetNativeFont.Size := FSize;
476 end;
477end;
478
479procedure TFont.ScreenChanged;
480begin
481 DoChange;
482end;
483
484function TFont.GetNativeFont: Graphics.TFont;
485begin
486 Result := NativeFont;
487end;
488
489procedure TFont.SetPixelsPerInch(AValue: Integer);
490begin
491 FPixelsPerInch := PixelsPerInch;
492 FHeight := -MulDiv(FSize, FPixelsPerInch, 72);
493 UpdateFont;
494end;
495
496function TFont.GetName: string;
497begin
498 Result := GetNativeFont.Name;
499end;
500
501function TFont.GetColor: TColor;
502begin
503 Result := FColor;
504end;
505
506function TFont.GetCharSet: TFontCharSet;
507begin
508 Result := GetNativeFont.CharSet;
509end;
510
511function TFont.GetHeight: Integer;
512begin
513 Result := GetNativeFont.Height;
514end;
515
516function TFont.GetPixelsPerInch: Integer;
517begin
518 Result := FPixelsPerInch;
519end;
520
521function TFont.GetSize: Integer;
522begin
523 Result := FSize;
524end;
525
526function TFont.GetStyle: TFontStyles;
527begin
528 Result := GetNativeFont.Style;
529end;
530
531function TFont.IsNameStored: Boolean;
532begin
533 Result := GetNativeFont.Name <> 'default';
534end;
535
536procedure TFont.SetCharSet(AValue: TFontCharSet);
537begin
538 GetNativeFont.CharSet := AValue;
539end;
540
541procedure TFont.SetColor(AValue: TColor);
542begin
543 if FColor = AValue then Exit;
544 FColor := AValue;
545 GetNativeFont.Color := AValue;
546end;
547
548procedure TFont.SetHeight(AValue: Integer);
549begin
550 FHeight := AValue;
551 FSize := MulDiv(-FHeight, 72, FPixelsPerInch);
552 UpdateFont;
553end;
554
555procedure TFont.SetName(AValue: string);
556begin
557 GetNativeFont.Name := AValue;
558end;
559
560procedure TFont.SetNativeFont(AValue: Graphics.TFont);
561begin
562 if FNativeFont = AValue then Exit;
563 if FNativeFontFree then FreeAndNil(FNativeFont);
564 FNativeFontFree := False;
565 FNativeFont := AValue;
566end;
567
568constructor TFont.Create;
569begin
570 FNativeFont := Graphics.TFont.Create;
571 FNativeFontFree := True;
572 FPixelsPerInch := ScreenInfo.Dpi;
573 Size := 8;
574 Color := clDefault;
575end;
576
577destructor TFont.Destroy;
578begin
579 if FNativeFontFree then
580 FreeAndNil(FNativeFont);
581 inherited;
582end;
583
584procedure TFont.Assign(Source: TPersistent);
585begin
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;
594end;
595
596procedure TFont.GetTextSize(Text: string; var w, h: Integer);
597begin
598 W := GetTextWidth(Text);
599 H := GetTextHeight(Text);
600end;
601
602function TFont.GetTextHeight(Text: string): Integer;
603begin
604 Result := ScaleFromNative(GetNativeFont.GetTextHeight(Text));
605end;
606
607function TFont.GetTextWidth(Text: string): Integer;
608begin
609 Result := ScaleFromNative(GetNativeFont.GetTextWidth(Text));
610end;
611
612{ TRasterImage }
613
614function TRasterImage.GetCanvas: TCanvas;
615begin
616 Result := FCanvas;
617end;
618
619function TRasterImage.GetRawImage: TRawImage;
620begin
621 Result := GetNativeRasterImage.RawImage;
622end;
623
624function TRasterImage.GetHeight: Integer;
625begin
626 Result := ScaleFromNative(GetNativeRasterImage.Height);
627end;
628
629function TRasterImage.GetWidth: Integer;
630begin
631 Result := ScaleFromNative(GetNativeRasterImage.Width);
632end;
633
634procedure TRasterImage.SetWidth(Value: Integer);
635begin
636 SetSize(Value, Height);
637end;
638
639procedure TRasterImage.SetHeight(Value: Integer);
640begin
641 SetSize(Width, Value);
642end;
643
644function TRasterImage.GetNativeRasterImage: Graphics.TRasterImage;
645begin
646 Result := nil;
647end;
648
649constructor TRasterImage.Create;
650begin
651 inherited;
652 FCanvas := TCanvas.Create;
653 FCanvas.NativeCanvas := GetNativeRasterImage.Canvas;
654end;
655
656destructor TRasterImage.Destroy;
657begin
658 FreeAndNil(FCanvas);
659 inherited;
660end;
661
662procedure TRasterImage.BeginUpdate(ACanvasOnly: Boolean);
663begin
664 GetNativeRasterImage.BeginUpdate(ACanvasOnly);
665end;
666
667procedure TRasterImage.EndUpdate(AStreamIsValid: Boolean);
668begin
669 GetNativeRasterImage.EndUpdate(AStreamIsValid);
670end;
671
672function TRasterImage.GetNativeGraphic: Graphics.TGraphic;
673begin
674 Result := GetNativeRasterImage;
675end;
676
677{ TGraphic }
678
679function TGraphic.GetNativeGraphic: Graphics.TGraphic;
680begin
681 Result := nil;
682end;
683
684procedure TGraphic.ScreenChanged;
685begin
686end;
687
688procedure TGraphic.SetDpi(AValue: Integer);
689begin
690 FDpi := AValue;
691 ScreenChanged;
692end;
693
694function TGraphic.GetDpi: Integer;
695begin
696 Result := FDpi;
697end;
698
699constructor TGraphic.Create;
700begin
701 Dpi := ScreenInfo.Dpi;
702end;
703
704procedure StretchDrawBitmap(Src: Graphics.TRasterImage; Dst: Graphics.TCustomBitmap);
705var
706 SrcPtr: TPixelPointer;
707 DstPtr: TPixelPointer;
708 XX, YY: Integer;
709 DstPixelX, DstPixelY: Integer;
710 DstPixelWidth, DstPixelHeight: Integer;
711begin
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;
732end;
733
734procedure TGraphic.LoadFromFile(const Filename: string);
735var
736 Bitmap: Graphics.TGraphic;
737begin
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;
756end;
757
758procedure TGraphic.SaveToFile(const Filename: string);
759var
760 Bitmap: Graphics.TGraphic;
761begin
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;
776end;
777
778{ TBitmap }
779
780function TBitmap.GetScanLine(Row: Integer): Pointer;
781begin
782 Result := GetNativeBitmap.ScanLine[Row];
783end;
784
785function TBitmap.GetTransparent: Boolean;
786begin
787 Result := GetNativeBitmap.Transparent;
788end;
789
790function TBitmap.GetTransparentColor: TColor;
791begin
792 Result := GetNativeBitmap.TransparentColor;
793end;
794
795procedure TBitmap.SetTransparent(AValue: Boolean);
796begin
797 GetNativeBitmap.Transparent := AValue;
798end;
799
800procedure TBitmap.SetTransparentColor(AValue: TColor);
801begin
802 GetNativeBitmap.TransparentColor := AValue;
803end;
804
805function TBitmap.GetNativeBitmap: Graphics.TBitmap;
806begin
807 Result := NativeBitmap;
808end;
809
810function TBitmap.GetNativeCustomBitmap: Graphics.TCustomBitmap;
811begin
812 Result := GetNativeBitmap;
813end;
814
815procedure TBitmap.SetNativeBitmap(ANativeBitmap: Graphics.TBitmap);
816begin
817 NativeBitmap := ANativeBitmap;
818end;
819
820procedure TBitmap.SetNativeCustomBitmap(CustomBitmap: Graphics.TCustomBitmap);
821begin
822 SetNativeBitmap(Graphics.TBitmap(CustomBitmap));
823end;
824
825constructor TBitmap.Create;
826begin
827 NativeGraphicClass := Graphics.TBitmap;
828 NativeBitmap := Graphics.TBitmap.Create;
829 inherited;
830end;
831
832destructor TBitmap.Destroy;
833begin
834 FreeAndNil(FCanvas);
835 FreeAndNil(NativeBitmap);
836 inherited;
837end;
838
839{ TPen }
840
841function TPen.GetColor: TColor;
842begin
843 Result := GetNativePen.Color;
844end;
845
846function TPen.GetStyle: TPenStyle;
847begin
848 Result := GetNativePen.Style;
849end;
850
851function TPen.GetWidth: Integer;
852begin
853 Result := FWidth;
854end;
855
856procedure TPen.SetColor(AValue: TColor);
857begin
858 GetNativePen.Color := AValue;
859end;
860
861procedure TPen.SetNativePen(AValue: Graphics.TPen);
862begin
863 if FNativePen = AValue then Exit;
864 if FNativePenFree then FreeAndNil(FNativePen);
865 FNativePenFree := False;
866 FNativePen := AValue;
867 SetWidth(FWidth);
868end;
869
870procedure TPen.SetStyle(AValue: TPenStyle);
871begin
872 GetNativePen.Style := AValue;
873end;
874
875procedure TPen.SetWidth(AValue: Integer);
876begin
877 GetNativePen.Width := ScaleToNative(AValue);
878 FWidth := AValue;
879end;
880
881constructor TPen.Create;
882begin
883 FNativePen := Graphics.TPen.Create;
884 FNativePenFree := True;
885 FWidth := 1;
886end;
887
888destructor TPen.Destroy;
889begin
890 if FNativePenFree then
891 FreeAndNil(FNativePen);
892 inherited;
893end;
894
895function TPen.GetNativePen: Graphics.TPen;
896begin
897 Result := FNativePen;
898end;
899
900procedure TPen.Assign(Source: TPen);
901begin
902 FWidth := Source.FWidth;
903 GetNativePen.Assign(Source.GetNativePen);
904end;
905
906{ TBrush }
907
908function TBrush.GetColor: TColor;
909begin
910 Result := GetNativeBrush.Color;
911end;
912
913function TBrush.GetStyle: TBrushStyle;
914begin
915 Result := GetNativeBrush.Style;
916end;
917
918procedure TBrush.SetColor(AValue: TColor);
919begin
920 GetNativeBrush.Color := AValue;
921end;
922
923function TBrush.GetNativeBrush: Graphics.TBrush;
924begin
925 Result := FNativeBrush;
926end;
927
928procedure TBrush.SetNativeBrush(AValue: Graphics.TBrush);
929begin
930 if FNativeBrush = AValue then Exit;
931 if FNativeBrushFree then FreeAndNil(FNativeBrush);
932 FNativeBrushFree := False;
933 FNativeBrush := AValue;
934end;
935
936procedure TBrush.SetStyle(AValue: TBrushStyle);
937begin
938 GetNativeBrush.Style := AValue;
939end;
940
941constructor TBrush.Create;
942begin
943 FNativeBrush := Graphics.TBrush.Create;
944 FNativeBrushFree := True;
945end;
946
947destructor TBrush.Destroy;
948begin
949 if FNativeBrushFree then FreeAndNil(FNativeBrush);
950 inherited;
951end;
952
953procedure TBrush.Assign(Source: TBrush);
954begin
955 GetNativeBrush.Assign(Source.GetNativeBrush);
956end;
957
958{ TCanvas }
959
960function TCanvas.GetHandle: HDC;
961begin
962 Result := GetNativeCanvas.Handle;
963end;
964
965function TCanvas.GetHeight: Integer;
966begin
967 Result := ScaleFromNative(GetNativeCanvas.Height);
968end;
969
970function TCanvas.GetPixel(X, Y: Integer): TColor;
971begin
972 Result := GetNativeCanvas.Pixels[ScaleToNative(X), ScaleToNative(Y)];
973end;
974
975function TCanvas.GetTextStyle: TTextStyle;
976begin
977 Result := GetNativeCanvas.TextStyle;
978end;
979
980function TCanvas.GetWidth: Integer;
981begin
982 Result := ScaleFromNative(GetNativeCanvas.Width);
983end;
984
985procedure TCanvas.SetBrush(AValue: TBrush);
986begin
987 if FBrush = AValue then Exit;
988 if FBrushFree then FreeAndNil(FBrush);
989 FBrushFree := False;
990 FBrush := AValue;
991end;
992
993procedure TCanvas.SetFont(AValue: TFont);
994begin
995 if FFont = AValue then Exit;
996 if FFontFree then FreeAndNil(FFont);
997 FFontFree := False;
998 FFont := AValue;
999end;
1000
1001procedure TCanvas.SetHandle(AValue: HDC);
1002begin
1003 GetNativeCanvas.Handle := AValue;
1004end;
1005
1006procedure TCanvas.SetHeight(AValue: Integer);
1007begin
1008 GetNativeCanvas.Height;
1009end;
1010
1011procedure TCanvas.SetWidth(AValue: Integer);
1012begin
1013
1014end;
1015
1016procedure TCanvas.SetPen(AValue: TPen);
1017begin
1018 if FPen = AValue then Exit;
1019 if FPenFree then FreeAndNil(FPen);
1020 FPenFree := False;
1021 FPen := AValue;
1022end;
1023
1024procedure TCanvas.SetPixel(X, Y: Integer; AValue: TColor);
1025var
1026 BrushStyle: TBrushStyle;
1027 BrushColor: TColor;
1028begin
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;
1038end;
1039
1040procedure TCanvas.SetNativeCanvas(AValue: Graphics.TCanvas);
1041begin
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;
1051end;
1052
1053procedure TCanvas.SetTextStyle(AValue: TTextStyle);
1054begin
1055 GetNativeCanvas.TextStyle := AValue;
1056end;
1057
1058procedure TCanvas.DoLine(X1, Y1, X2, Y2: Integer);
1059begin
1060 raise ENotImplemented.Create(SNotImplemented);
1061end;
1062
1063procedure TCanvas.DoTextOut(X, Y: Integer; Text: string);
1064begin
1065 raise ENotImplemented.Create(SNotImplemented);
1066end;
1067
1068procedure TCanvas.DoRectangle(const Bounds: TRect);
1069begin
1070 raise ENotImplemented.Create(SNotImplemented);
1071end;
1072
1073procedure TCanvas.DoRectangleFill(const Bounds: TRect);
1074begin
1075 raise ENotImplemented.Create(SNotImplemented);
1076end;
1077
1078procedure TCanvas.DoPolygon(const Points: array of TPoint);
1079begin
1080 raise ENotImplemented.Create(SNotImplemented);
1081end;
1082
1083procedure TCanvas.CreateHandle;
1084begin
1085 raise ENotImplemented.Create(SNotImplemented);
1086end;
1087
1088procedure TCanvas.DoEllipse(const Bounds: TRect);
1089begin
1090 raise ENotImplemented.Create(SNotImplemented);
1091end;
1092
1093procedure TCanvas.DoMoveTo(X, Y: Integer);
1094begin
1095 raise ENotImplemented.Create(SNotImplemented);
1096end;
1097
1098procedure TCanvas.DoLineTo(X, Y: Integer);
1099begin
1100 raise ENotImplemented.Create(SNotImplemented);
1101end;
1102
1103procedure TCanvas.DoPolyline(const Points: array of TPoint);
1104begin
1105 raise ENotImplemented.Create(SNotImplemented);
1106end;
1107
1108procedure TCanvas.DoPolyBezier(Points: PPoint; NumPts: Integer;
1109 Filled: Boolean; Continuous: Boolean);
1110begin
1111 raise ENotImplemented.Create(SNotImplemented);
1112end;
1113
1114function TCanvas.GetNativeCanvas: Graphics.TCanvas;
1115begin
1116 Result := NativeCanvas;
1117end;
1118
1119procedure TCanvas.RoundRect(const Rect: TRect; RX, RY: Integer);
1120begin
1121 GetNativeCanvas.RoundRect(Rect, RX, RY);
1122end;
1123
1124procedure TCanvas.RoundRect(X1, Y1, X2, Y2: Integer; RX, RY: Integer);
1125begin
1126 GetNativeCanvas.RoundRect(X1, Y1, X2, Y2, RX, RY);
1127end;
1128
1129procedure TCanvas.Polygon(const Points: array of TPoint; Winding: Boolean;
1130 StartIndex: Integer; NumPts: Integer);
1131begin
1132 GetNativeCanvas.Polygon(Points, Winding, StartIndex, NumPts);
1133end;
1134
1135procedure TCanvas.Polygon(Points: PPoint; NumPts: Integer; Winding: Boolean);
1136begin
1137 GetNativeCanvas.Polygon(Points, NumPts, Winding);
1138end;
1139
1140procedure TCanvas.Polygon(const Points: array of TPoint);
1141begin
1142 GetNativeCanvas.Polygon(Points);
1143end;
1144
1145procedure TCanvas.PolyBezier(const Points: array of TPoint; Filled: Boolean;
1146 Continuous: boolean);
1147begin
1148 GetNativeCanvas.Polyline(Points);
1149end;
1150
1151procedure TCanvas.PolyBezier(Points: PPoint; NumPts: Integer;
1152 Filled: Boolean; Continuous: Boolean);
1153begin
1154 GetNativeCanvas.PolyBezier(Points, NumPts, Filled, Continuous);
1155end;
1156
1157procedure TCanvas.Polyline(const Points: array of TPoint);
1158begin
1159 GetNativeCanvas.Polyline(Points);
1160end;
1161
1162procedure TCanvas.Polyline(Points: PPoint; NumPts: Integer);
1163begin
1164 GetNativeCanvas.Polyline(Points, NumPts);
1165end;
1166
1167procedure TCanvas.Ellipse(x1, y1, x2, y2: Integer);
1168begin
1169 GetNativeCanvas.Ellipse(X1, Y1, X2, Y2);
1170end;
1171
1172procedure TCanvas.Ellipse(const ARect: TRect);
1173begin
1174 Ellipse(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
1175end;
1176
1177{procedure TCanvas.StretchDraw(const DestRect: TRect; SrcGraphic: Graphics.TGraphic);
1178begin
1179 GetNativeCanvas.StretchDraw(DestRect, SrcGraphic);
1180end;
1181}
1182procedure TCanvas.Pie(EllipseX1, EllipseY1, EllipseX2, EllipseY2, StartX,
1183 StartY, EndX, EndY: Integer);
1184begin
1185 GetNativeCanvas.Pie(EllipseX1, EllipseY1, EllipseX2, EllipseY2, StartX, StartY,
1186 EndX, EndY);
1187end;
1188
1189procedure TCanvas.StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic
1190 );
1191begin
1192 GetNativeCanvas.StretchDraw(ScaleRectToNative(DestRect), SrcGraphic.GetNativeGraphic);
1193end;
1194
1195procedure TCanvas.FrameRect(Rect: TRect);
1196begin
1197 GetNativeCanvas.FrameRect(ScaleRectToNative(Rect));
1198end;
1199
1200procedure TCanvas.Rectangle(X1, Y1, X2, Y2: Integer);
1201begin
1202 GetNativeCanvas.Rectangle(ScaleToNative(X1), ScaleToNative(Y1), ScaleToNative(X2), ScaleToNative(Y2));
1203end;
1204
1205procedure TCanvas.Rectangle(const ARect: TRect);
1206begin
1207 Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
1208end;
1209
1210function TCanvas.TextWidth(const Text: string): Integer;
1211begin
1212 Result := ScaleFromNative(GetNativeCanvas.TextWidth(Text));
1213end;
1214
1215function TCanvas.TextHeight(const Text: string): Integer;
1216begin
1217 Result := ScaleFromNative(GetNativeCanvas.TextHeight(Text));
1218end;
1219
1220function TCanvas.TextExtent(const Text: string): TSize;
1221begin
1222 Result := ScaleSizeFromNative(GetNativeCanvas.TextExtent(Text));
1223end;
1224
1225procedure TCanvas.TextOut(X, Y: Integer; const Text: string);
1226begin
1227 GetNativeCanvas.TextOut(ScaleToNative(X), ScaleToNative(Y), Text);
1228end;
1229
1230procedure TCanvas.TextRect(ARect: TRect; X, Y: Integer; Text: string);
1231begin
1232 GetNativeCanvas.TextRect(ScaleRectToNative(ARect), ScaleToNative(X),
1233 ScaleToNative(Y), Text);
1234end;
1235
1236procedure TCanvas.TextRect(ARect: TRect; X, Y: integer; const Text: string;
1237 const Style: TTextStyle);
1238begin
1239 GetNativeCanvas.TextRect(ScaleRectToNative(ARect), ScaleToNative(X),
1240 ScaleToNative(Y), Text, TextStyle);
1241end;
1242
1243procedure TCanvas.MoveTo(X, Y: Integer);
1244begin
1245 GetNativeCanvas.MoveTo(ScaleToNative(X), ScaleToNative(Y));
1246end;
1247
1248procedure TCanvas.LineTo(X, Y: Integer);
1249begin
1250 GetNativeCanvas.LineTo(ScaleToNative(X), ScaleToNative(Y));
1251end;
1252
1253procedure TCanvas.Line(const p1, p2: TPoint);
1254begin
1255 GetNativeCanvas.Line(P1, P2);
1256end;
1257
1258procedure TCanvas.FillRect(const ARect: TRect);
1259begin
1260 GetNativeCanvas.FillRect(ScaleRectToNative(ARect));
1261end;
1262
1263procedure TCanvas.FillRect(X1, Y1, X2, Y2: Integer);
1264begin
1265 GetNativeCanvas.FillRect(ScaleToNative(X1), ScaleToNative(Y1), ScaleToNative(X2), ScaleToNative(Y2));
1266end;
1267
1268procedure TCanvas.Draw(X, Y: Integer; Source: TGraphic);
1269begin
1270 GetNativeCanvas.Draw(ScaleToNative(X), ScaleToNative(Y), Source.GetNativeGraphic);
1271end;
1272
1273procedure TCanvas.CopyRect(Dest: TRect; SrcCanvas: TCanvas;
1274 Source: TRect);
1275begin
1276 GetNativeCanvas.CopyRect(Dest, SrcCanvas.NativeCanvas, ScaleRectToNative(Source));
1277end;
1278
1279constructor TCanvas.Create;
1280begin
1281 FNativeCanvas := nil;
1282 FFont := TFont.Create;
1283 FFontFree := True;
1284 FPen := TPen.Create;
1285 FPenFree := True;
1286 FBrush := TBrush.Create;
1287 FBrushFree := True;
1288end;
1289
1290destructor TCanvas.Destroy;
1291begin
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;
1297end;
1298
1299{ TJpegImage }
1300
1301function TJpegImage.GetNativeCustomBitmap: Graphics.TCustomBitmap;
1302begin
1303 Result := GetNativeJpeg;
1304end;
1305
1306function TJpegImage.GetNativeJpeg: Graphics.TJPEGImage;
1307begin
1308 Result := NativeJpeg;
1309end;
1310
1311procedure TJpegImage.SetNativeCustomBitmap(CustomBitmap: Graphics.TCustomBitmap
1312 );
1313begin
1314 SetNativeJpeg(Graphics.TJpegImage(CustomBitmap));
1315end;
1316
1317procedure TJpegImage.SetNativeJpeg(Jpeg: Graphics.TJPEGImage);
1318begin
1319 NativeJpeg := Jpeg;
1320end;
1321
1322constructor TJpegImage.Create;
1323begin
1324 NativeJpeg := Graphics.TJPEGImage.Create;
1325 NativeGraphicClass := Graphics.TJPEGImage;
1326 inherited;
1327end;
1328
1329destructor TJpegImage.Destroy;
1330begin
1331 FreeAndNil(NativeJpeg);
1332 inherited;
1333end;
1334
1335{ TPicture }
1336
1337procedure TPicture.SetBitmap(AValue: TBitmap);
1338begin
1339 if FBitmap = AValue then Exit;
1340 FBitmap := AValue;
1341end;
1342
1343procedure TPicture.LoadFromFile(FileName: string);
1344begin
1345end;
1346
1347{ TScreenInfo }
1348
1349procedure TScreenInfo.SetDpi(AValue: Integer);
1350var
1351 I: Integer;
1352begin
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);
1361end;
1362
1363{ TPortableNetworkGraphic }
1364
1365function TPortableNetworkGraphic.GetNativeCustomBitmap: Graphics.TCustomBitmap;
1366begin
1367 Result := GetNativePng;
1368end;
1369
1370function TPortableNetworkGraphic.GetNativePng: Graphics.TPortableNetworkGraphic;
1371begin
1372 Result := NativePng;
1373end;
1374
1375procedure TPortableNetworkGraphic.SetNativeCustomBitmap(
1376 CustomBitmap: Graphics.TCustomBitmap);
1377begin
1378 SetNativePng(Graphics.TPortableNetworkGraphic(CustomBitmap));
1379end;
1380
1381procedure TPortableNetworkGraphic.SetNativePng(
1382 Png: Graphics.TPortableNetworkGraphic);
1383begin
1384 NativePng := Png;
1385end;
1386
1387constructor TPortableNetworkGraphic.Create;
1388begin
1389 NativePng := Graphics.TPortableNetworkGraphic.Create;
1390 NativeGraphicClass := Graphics.TPortableNetworkGraphic;
1391 inherited;
1392end;
1393
1394destructor TPortableNetworkGraphic.Destroy;
1395begin
1396 Canvas.NativeCanvas := nil;
1397 FreeAndNil(NativePng);
1398 inherited;
1399end;
1400
1401end.
1402
Note: See TracBrowser for help on using the repository browser.