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

unit Dpi.Graphics;

interface

uses
  Classes, SysUtils, Math, Graphics, LCLType, GraphType, Types;

const
  clBlack = TColor($000000);
  clWhite = TColor($ffffff);

type
  TColor = Graphics.TColor;
  TPixelFormat = Graphics.TPixelFormat;
  TFontStyle = Graphics.TFontStyle;

  { TFont }

  TFont = class(TPersistent)
  private
    FNativeFont: Graphics.TFont;
    FNativeFontFree: Boolean;
    FOnChange: TNotifyEvent;
    FSize: Integer;
    FHeight: Integer;
    FPixelsPerInch: Integer;
    FColor: TColor;
    function GetCharSet: TFontCharSet;
    function GetColor: TColor;
    function GetHeight: Integer;
    function GetName: string;
    function GetPixelsPerInch: Integer;
    function GetSize: Integer;
    function GetStyle: TFontStyles;
    function IsNameStored: Boolean;
    procedure SetCharSet(AValue: TFontCharSet);
    procedure SetColor(AValue: TColor);
    procedure SetHeight(AValue: Integer);
    procedure SetName(AValue: string);
    procedure SetNativeFont(AValue: Graphics.TFont);
    procedure SetPixelsPerInch(AValue: Integer);
    procedure SetSize(AValue: Integer);
    procedure DoChange;
    procedure SetStyle(AValue: TFontStyles);
    procedure UpdateFont;
  protected
    function GetNativeFont: Graphics.TFont; virtual;
  public
    procedure ScreenChanged;
    property NativeFont: Graphics.TFont read FNativeFont write SetNativeFont;
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure GetTextSize(Text: string; var w, h: Integer);
    function GetTextHeight(Text: string): Integer;
    function GetTextWidth(Text: string): Integer;
  published
    property CharSet: TFontCharSet read GetCharSet write SetCharSet default DEFAULT_CHARSET;
    property Color: TColor read GetColor write SetColor;
    property Name: string read GetName write SetName stored IsNameStored;
    property Style: TFontStyles read GetStyle write SetStyle default [];
    property Size: Integer read GetSize write SetSize stored false;
    property PixelsPerInch: Integer read GetPixelsPerInch write SetPixelsPerInch;
    property Height: Integer read GetHeight write SetHeight default 0;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  { TPen }

  TPen = class
    FWidth: Integer;
    FNativePen: Graphics.TPen;
    FNativePenFree: Boolean;
  private
    function GetColor: TColor;
    function GetStyle: TPenStyle;
    function GetWidth: Integer;
    procedure SetColor(AValue: TColor);
    procedure SetNativePen(AValue: Graphics.TPen);
    procedure SetStyle(AValue: TPenStyle);
    procedure SetWidth(AValue: Integer);
  public
    constructor Create;
    destructor Destroy; override;
    function GetNativePen: Graphics.TPen;
    procedure Assign(Source: TPen);
    property NativePen: Graphics.TPen read FNativePen write SetNativePen;
  published
    property Color: TColor read GetColor write SetColor default clBlack;
    property Style : TPenStyle read GetStyle write SetStyle default psSolid;
    property Width: Integer read GetWidth write SetWidth default 1;
  end;

  TBrushStyle = Graphics.TBrushStyle;
  TPenStyle = Graphics.TPenStyle;

  { TBrush }

  TBrush = class
  private
    FNativeBrush: Graphics.TBrush;
    FNativeBrushFree: Boolean;
    function GetColor: TColor;
    function GetStyle: TBrushStyle;
    procedure SetColor(AValue: TColor);
    function GetNativeBrush: Graphics.TBrush;
    procedure SetNativeBrush(AValue: Graphics.TBrush);
    procedure SetStyle(AValue: TBrushStyle);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TBrush);
    property NativeBrush: Graphics.TBrush read FNativeBrush write SetNativeBrush;
  published
    property Color: TColor read GetColor write SetColor default clWhite;
    property Style: TBrushStyle read GetStyle write SetStyle default bsSolid;
  end;

  TGraphic = class;

  { TCanvas }

  TCanvas = class
  private
    FBrush: TBrush;
    FBrushFree: Boolean;
    FPen: TPen;
    FPenFree: Boolean;
    FFont: TFont;
    FFontFree: Boolean;
    FNativeCanvas: Graphics.TCanvas;
    FNativeCanvasFree: Boolean;
    function GetHandle: HDC;
    function GetPixel(X, Y: Integer): TColor;
    function GetTextStyle: TTextStyle;
    procedure SetBrush(AValue: TBrush);
    procedure SetFont(AValue: TFont);
    procedure SetHandle(AValue: HDC);
    procedure SetPen(AValue: TPen);
    procedure SetPixel(X, Y: Integer; AValue: TColor);
    procedure SetNativeCanvas(AValue: Graphics.TCanvas);
    procedure SetTextStyle(AValue: TTextStyle);
  protected
    procedure DoLine(X1, Y1, X2, Y2: Integer); virtual;
    procedure DoTextOut(X, Y: Integer; Text: string); virtual;
    procedure DoRectangle(const Bounds: TRect); virtual;
    procedure DoRectangleFill(const Bounds: TRect); virtual;
    procedure DoPolygon(const Points: array of TPoint); virtual;
    procedure CreateHandle; virtual;
    procedure DoEllipse(const Bounds: TRect); virtual;
    procedure DoMoveTo(X, Y: Integer); virtual;
    procedure DoLineTo(X, Y: Integer); virtual;
    procedure DoPolyline(const Points: array of TPoint); virtual;
    procedure DoPolyBezier(Points: PPoint; NumPts: Integer;
      Filled: Boolean = False; Continuous: Boolean = False); virtual;
    procedure SetHeight(AValue: Integer); virtual;
    procedure SetWidth(AValue: Integer); virtual;
    function GetWidth: Integer; virtual;
    function GetHeight: Integer; virtual;
    function GetNativeCanvas: Graphics.TCanvas; virtual;
  public
    property NativeCanvas: Graphics.TCanvas read FNativeCanvas write SetNativeCanvas;
    procedure RoundRect(const Rect: TRect; RX, RY: Integer); overload;
    procedure RoundRect(X1, Y1, X2, Y2: Integer; RX,RY: Integer); overload; virtual;
    procedure Polygon(const Points: array of TPoint; Winding: Boolean;
      StartIndex: Integer = 0; NumPts: Integer = -1); overload;
    procedure Polygon(Points: PPoint; NumPts: Integer; Winding: Boolean = False); virtual; overload;
    procedure Polygon(const Points: array of TPoint); overload;
    procedure PolyBezier(const Points: array of TPoint;
      Filled: Boolean = False; Continuous: boolean = True); overload;
    procedure PolyBezier(Points: PPoint; NumPts: Integer;
      Filled: Boolean = False; Continuous: Boolean = True); virtual; overload;
    procedure Polyline(const Points: array of TPoint); overload;
    procedure Polyline(Points: PPoint; NumPts: Integer); virtual; overload;
    procedure Ellipse(x1, y1, x2, y2: Integer); virtual; overload;
    procedure Ellipse(const ARect: TRect); virtual; overload;
//    procedure StretchDraw(const DestRect: TRect; SrcGraphic: Graphics.TGraphic); virtual; overload;
    procedure StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic); virtual; overload;
    procedure Pie(EllipseX1, EllipseY1, EllipseX2, EllipseY2,
      StartX, StartY, EndX, EndY: Integer); virtual;
    procedure FrameRect(Rect: TRect);
    procedure Rectangle(X1, Y1, X2, Y2: Integer); overload;
    procedure Rectangle(const ARect: TRect); overload;
    function TextWidth(const Text: string): Integer;
    function TextHeight(const Text: string): Integer;
    function TextExtent(const Text: string): TSize; virtual;
    procedure TextOut(X, Y: Integer; const Text: string); virtual;
    procedure TextRect(ARect: TRect; X, Y: Integer; Text: string); overload;
    procedure TextRect(ARect: TRect; X, Y: integer; const Text: string;
      const Style: TTextStyle); overload;
    procedure MoveTo(X, Y: Integer);
    procedure LineTo(X, Y: Integer);
    procedure Line(const p1, p2: TPoint);
    procedure FillRect(const ARect: TRect); virtual; overload;
    procedure FillRect(X1, Y1, X2, Y2: Integer); overload;
    procedure Draw(X, Y: Integer; Source: TGraphic);
    procedure CopyRect(Dest: TRect; SrcCanvas: TCanvas; Source: TRect);
    constructor Create;
    destructor Destroy; override;
    property Handle: HDC read GetHandle write SetHandle;
    property Pixels[X, Y: Integer]: TColor read GetPixel write SetPixel;
    property Width: Integer read GetWidth;
    property Height: Integer read GetHeight;
    property TextStyle: TTextStyle read GetTextStyle write SetTextStyle;
  published
    property Brush: TBrush read FBrush write SetBrush;
    property Pen: TPen read FPen write SetPen;
    property Font: TFont read FFont write SetFont;
  end;

   { TGraphic }

  TGraphic = class(TPersistent)
  protected
    FDpi: Integer;
    function GetNativeGraphic: Graphics.TGraphic; virtual;
    function GetWidth: Integer; virtual; abstract;
    function GetHeight: Integer; virtual; abstract;
    procedure SetWidth(Value: Integer); virtual; abstract;
    procedure SetHeight(Value: Integer); virtual; abstract;
    procedure ScreenChanged; virtual;
    procedure SetDpi(AValue: Integer); virtual;
    function GetDpi: Integer; virtual;
  public
    NativeGraphicClass: TGraphicClass;
    constructor Create; virtual;
    procedure LoadFromFile(const Filename: string); virtual;
    procedure SaveToFile(const Filename: string); virtual;
    property Width: Integer read GetWidth write SetWidth;
    property Height: Integer read GetHeight write SetHeight;
    property Dpi: Integer read GetDpi write SetDpi;
  end;

  { TRasterImage }

  TRasterImage = class(TGraphic)
  private
    FCanvas: TCanvas;
    function GetCanvas: TCanvas;
    function GetRawImage: TRawImage;
  protected
    function GetHeight: Integer; override;
    function GetWidth: Integer; override;
    function GetPixelFormat: TPixelFormat; virtual; abstract;
    procedure SetWidth(Value: Integer); override;
    procedure SetHeight(Value: Integer); override;
    procedure SetSize(AWidth, AHeight: Integer); virtual; abstract;
    procedure SetPixelFormat(AValue: TPixelFormat); virtual; abstract;
    function GetNativeGraphic: Graphics.TGraphic; override;
    function GetNativeRasterImage: Graphics.TRasterImage; virtual;
    procedure SetNativeRasterImage(CustomBitmap: Graphics.TRasterImage); virtual; abstract;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure BeginUpdate(ACanvasOnly: Boolean = False);
    procedure EndUpdate(AStreamIsValid: Boolean = False);
    property Canvas: TCanvas read GetCanvas;
    property RawImage: TRawImage read GetRawImage;
    property PixelFormat: TPixelFormat read GetPixelFormat write SetPixelFormat;
  end;

  { TCustomBitmap }

  TCustomBitmap = class(TRasterImage)
  private
    FWidth: Integer;
    FHeight: Integer;
  protected
    function GetHeight: Integer; override;
    function GetWidth: Integer; override;
    function GetPixelFormat: TPixelFormat; override;
    procedure SetPixelFormat(AValue: TPixelFormat); override;
    function GetNativeCustomBitmap: Graphics.TCustomBitmap; virtual;
    function GetNativeRasterImage: Graphics.TRasterImage; override;
    procedure SetNativeRasterImage(RasterImage: Graphics.TRasterImage); override;
    procedure SetNativeCustomBitmap(CustomBitmap: Graphics.TCustomBitmap); virtual; abstract;
    procedure ScreenChanged; override;
  public
    procedure Assign(Source: TPersistent); override;
    procedure SetSize(AWidth, AHeight: Integer); override;
  end;

  { TBitmap }

  TBitmap = class(TCustomBitmap)
  private
    function GetScanLine(Row: Integer): Pointer;
    function GetTransparent: Boolean;
    function GetTransparentColor: TColor;
    procedure SetTransparent(AValue: Boolean);
    procedure SetTransparentColor(AValue: TColor);
  protected
    function GetNativeBitmap: Graphics.TBitmap; virtual;
    function GetNativeCustomBitmap: Graphics.TCustomBitmap; override;
    procedure SetNativeBitmap(ANativeBitmap: Graphics.TBitmap); virtual;
    procedure SetNativeCustomBitmap(CustomBitmap: Graphics.TCustomBitmap); override;
  public
    NativeBitmap: Graphics.TBitmap;
    constructor Create; override;
    destructor Destroy; override;
    property ScanLine[Row: Integer]: Pointer read GetScanLine;
  published
    property TransparentColor: TColor read GetTransparentColor
                                      write SetTransparentColor default clDefault;
    property Transparent: Boolean read GetTransparent write SetTransparent default False;
  end;

  { TJpegImage }

  TJpegImage = class(TCustomBitmap)
  protected
    function GetNativeCustomBitmap: Graphics.TCustomBitmap; override;
    function GetNativeJpeg: Graphics.TJPEGImage; virtual;
    procedure SetNativeCustomBitmap(CustomBitmap: Graphics.TCustomBitmap); override;
    procedure SetNativeJpeg(Jpeg: Graphics.TJPEGImage); virtual;
  public
    NativeJpeg: Graphics.TJPEGImage;
    constructor Create; override;
    destructor Destroy; override;
  end;

  { TPortableNetworkGraphic }

  TPortableNetworkGraphic = class(TCustomBitmap)
  protected
    function GetNativeCustomBitmap: Graphics.TCustomBitmap; override;
    function GetNativePng: Graphics.TPortableNetworkGraphic; virtual;
    procedure SetNativeCustomBitmap(CustomBitmap: Graphics.TCustomBitmap); override;
    procedure SetNativePng(Png: Graphics.TPortableNetworkGraphic); virtual;
  public
    NativePng: Graphics.TPortableNetworkGraphic;
    constructor Create; override;
    destructor Destroy; override;
  end;

  { TPicture }

  TPicture = class(TPersistent)
  private
    FBitmap: TBitmap;
    procedure SetBitmap(AValue: TBitmap);
  published
    procedure LoadFromFile(FileName: string);
    property Bitmap: TBitmap read FBitmap write SetBitmap;
  end;

  { TScreenInfo }

  TScreenInfo = record
  private
    FDpi: Integer;
    procedure SetDpi(AValue: Integer);
  public
    ToNative: Double;
    FromNative: Double;
    LookupToNative: array[-10000..10000] of Integer; // Should be sufficient for 8K screens
    LookupFromNative: array[-10000..10000] of Integer; // Should be sufficient for 8K screens
    property Dpi: Integer read FDpi write SetDpi;
  end;

var
  ScreenInfo: TScreenInfo;


implementation

uses
  Dpi.Common, NativePixelPointer;

{ TCustomBitmap }

function TCustomBitmap.GetHeight: Integer;
begin
  Result := FHeight;
end;

function TCustomBitmap.GetWidth: Integer;
begin
  Result := FWidth;
end;

function TCustomBitmap.GetPixelFormat: TPixelFormat;
begin
  Result := GetNativeCustomBitmap.PixelFormat;
end;

procedure TCustomBitmap.SetPixelFormat(AValue: TPixelFormat);
begin
  GetNativeCustomBitmap.PixelFormat := AValue;
end;

function TCustomBitmap.GetNativeCustomBitmap: Graphics.TCustomBitmap;
begin
  Result := nil;
end;

function TCustomBitmap.GetNativeRasterImage: Graphics.TRasterImage;
begin
  Result := GetNativeCustomBitmap;
end;

procedure TCustomBitmap.SetNativeRasterImage(RasterImage: Graphics.TRasterImage
  );
begin
  SetNativeCustomBitmap(Graphics.TCustomBitmap(RasterImage));
end;

procedure TCustomBitmap.ScreenChanged;
var
  Bitmap: Graphics.TCustomBitmap;
  NewWidth: Integer;
  NewHeight: Integer;
begin
  NewWidth := ScaleToNative(Width);
  NewHeight := ScaleToNative(Height);
  if Assigned(GetNativeCustomBitmap) and ((NewWidth <> GetNativeCustomBitmap.Width) or
  (NewHeight <> GetNativeCustomBitmap.Height)) then begin
    // Rescale bitmap to new size
    if NativeGraphicClass = Graphics.TBitmap then
      Bitmap := Graphics.TBitmap.Create
    else if NativeGraphicClass = Graphics.TPortableNetworkGraphic then
      Bitmap := Graphics.TPortableNetworkGraphic.Create
    else if NativeGraphicClass = Graphics.TJPEGImage then
      Bitmap := Graphics.TJPEGImage.Create
    else raise Exception.Create('Unsupported image class');
    Bitmap.SetSize(NewWidth, NewHeight);
    Bitmap.PixelFormat := GetNativeCustomBitmap.PixelFormat;
    Bitmap.Canvas.StretchDraw(Bounds(0, 0, NewWidth, NewHeight), GetNativeCustomBitmap);
    GetNativeCustomBitmap.Free;
    SetNativeCustomBitmap(Bitmap);
    Canvas.NativeCanvas := GetNativeCustomBitmap.Canvas;
  end;
end;

procedure TCustomBitmap.Assign(Source: TPersistent);
begin
  if Source is TCustomBitmap then begin
    GetNativeCustomBitmap.Assign(TCustomBitmap(Source).GetNativeCustomBitmap);
    FWidth := TCustomBitmap(Source).FWidth;
    FHeight := TCustomBitmap(Source).FHeight
  end else inherited;
end;

procedure TCustomBitmap.SetSize(AWidth, AHeight: Integer);
begin
  FWidth := AWidth;
  FHeight := AHeight;
  GetNativeCustomBitmap.SetSize(ScaleToNative(AWidth), ScaleToNative(AHeight));
end;

{ TFont }

procedure TFont.SetSize(AValue: Integer);
begin
  if FSize = AValue then Exit;
  FSize := AValue;
  FHeight := -MulDiv(FSize, FPixelsPerInch, 72);
  UpdateFont;
  DoChange;
end;

procedure TFont.DoChange;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TFont.SetStyle(AValue: TFontStyles);
begin
  GetNativeFont.Style := AValue;
end;

procedure TFont.UpdateFont;
begin
  if Assigned(GetNativeFont) then begin
    GetNativeFont.PixelsPerInch := FPixelsPerInch;
    GetNativeFont.Size := FSize;
  end;
end;

procedure TFont.ScreenChanged;
begin
  DoChange;
end;

function TFont.GetNativeFont: Graphics.TFont;
begin
  Result := NativeFont;
end;

procedure TFont.SetPixelsPerInch(AValue: Integer);
begin
  FPixelsPerInch := PixelsPerInch;
  FHeight := -MulDiv(FSize, FPixelsPerInch, 72);
  UpdateFont;
end;

function TFont.GetName: string;
begin
  Result := GetNativeFont.Name;
end;

function TFont.GetColor: TColor;
begin
  Result := FColor;
end;

function TFont.GetCharSet: TFontCharSet;
begin
  Result := GetNativeFont.CharSet;
end;

function TFont.GetHeight: Integer;
begin
  Result := GetNativeFont.Height;
end;

function TFont.GetPixelsPerInch: Integer;
begin
  Result := FPixelsPerInch;
end;

function TFont.GetSize: Integer;
begin
  Result := FSize;
end;

function TFont.GetStyle: TFontStyles;
begin
  Result := GetNativeFont.Style;
end;

function TFont.IsNameStored: Boolean;
begin
  Result := GetNativeFont.Name <> 'default';
end;

procedure TFont.SetCharSet(AValue: TFontCharSet);
begin
  GetNativeFont.CharSet := AValue;
end;

procedure TFont.SetColor(AValue: TColor);
begin
  if FColor = AValue then Exit;
  FColor := AValue;
  GetNativeFont.Color := AValue;
end;

procedure TFont.SetHeight(AValue: Integer);
begin
  FHeight := AValue;
  FSize := MulDiv(-FHeight, 72, FPixelsPerInch);
  UpdateFont;
end;

procedure TFont.SetName(AValue: string);
begin
  GetNativeFont.Name := AValue;
end;

procedure TFont.SetNativeFont(AValue: Graphics.TFont);
begin
  if FNativeFont = AValue then Exit;
  if FNativeFontFree then FreeAndNil(FNativeFont);
  FNativeFontFree := False;
  FNativeFont := AValue;
end;

constructor TFont.Create;
begin
  FNativeFont := Graphics.TFont.Create;
  FNativeFontFree := True;
  FPixelsPerInch := ScreenInfo.Dpi;
  Size := 8;
  Color := clDefault;
end;

destructor TFont.Destroy;
begin
  if FNativeFontFree then
    FreeAndNil(FNativeFont);
  inherited;
end;

procedure TFont.Assign(Source: TPersistent);
begin
  if Source is TFont then begin
    GetNativeFont.Assign((Source as TFont).GetNativeFont);
    Size := (Source as TFont).Size;
    Height := (Source as TFont).Height;
    PixelsPerInch := (Source as TFont).PixelsPerInch;
    FOnChange := (Source as TFont).FOnChange;
    Color := (Source as TFont).Color;
  end;
end;

procedure TFont.GetTextSize(Text: string; var w, h: Integer);
begin
  W := GetTextWidth(Text);
  H := GetTextHeight(Text);
end;

function TFont.GetTextHeight(Text: string): Integer;
begin
  Result := ScaleFromNative(GetNativeFont.GetTextHeight(Text));
end;

function TFont.GetTextWidth(Text: string): Integer;
begin
  Result := ScaleFromNative(GetNativeFont.GetTextWidth(Text));
end;

{ TRasterImage }

function TRasterImage.GetCanvas: TCanvas;
begin
  Result := FCanvas;
end;

function TRasterImage.GetRawImage: TRawImage;
begin
  Result := GetNativeRasterImage.RawImage;
end;

function TRasterImage.GetHeight: Integer;
begin
  Result := ScaleFromNative(GetNativeRasterImage.Height);
end;

function TRasterImage.GetWidth: Integer;
begin
  Result := ScaleFromNative(GetNativeRasterImage.Width);
end;

procedure TRasterImage.SetWidth(Value: Integer);
begin
  SetSize(Value, Height);
end;

procedure TRasterImage.SetHeight(Value: Integer);
begin
  SetSize(Width, Value);
end;

function TRasterImage.GetNativeRasterImage: Graphics.TRasterImage;
begin
  Result := nil;
end;

constructor TRasterImage.Create;
begin
  inherited;
  FCanvas := TCanvas.Create;
  FCanvas.NativeCanvas := GetNativeRasterImage.Canvas;
end;

destructor TRasterImage.Destroy;
begin
  FreeAndNil(FCanvas);
  inherited;
end;

procedure TRasterImage.BeginUpdate(ACanvasOnly: Boolean);
begin
  GetNativeRasterImage.BeginUpdate(ACanvasOnly);
end;

procedure TRasterImage.EndUpdate(AStreamIsValid: Boolean);
begin
  GetNativeRasterImage.EndUpdate(AStreamIsValid);
end;

function TRasterImage.GetNativeGraphic: Graphics.TGraphic;
begin
  Result := GetNativeRasterImage;
end;

{ TGraphic }

function TGraphic.GetNativeGraphic: Graphics.TGraphic;
begin
  Result := nil;
end;

procedure TGraphic.ScreenChanged;
begin
end;

procedure TGraphic.SetDpi(AValue: Integer);
begin
  FDpi := AValue;
  ScreenChanged;
end;

function TGraphic.GetDpi: Integer;
begin
  Result := FDpi;
end;

constructor TGraphic.Create;
begin
  Dpi := ScreenInfo.Dpi;
end;

procedure StretchDrawBitmap(Src: Graphics.TRasterImage; Dst: Graphics.TCustomBitmap);
var
  SrcPtr: TPixelPointer;
  DstPtr: TPixelPointer;
  XX, YY: Integer;
  DstPixelX, DstPixelY: Integer;
  DstPixelWidth, DstPixelHeight: Integer;
begin
  Dst.BeginUpdate;
  SrcPtr := TPixelPointer.Create(Src, 0, 0);
  DstPtr := TPixelPointer.Create(Dst, 0, 0);
  for YY := 0 to Src.Height - 1 do begin
    DstPixelHeight := ScaleToNative(YY + 1) - ScaleToNative(YY);
    for DstPixelY := 0 to DstPixelHeight - 1 do begin
      for XX := 0 to Src.Width - 1 do begin
        DstPixelWidth := ScaleToNative(XX + 1) - ScaleToNative(XX);
        for DstPixelX := 0 to DstPixelWidth - 1 do begin
          DstPtr.PixelRGB := SrcPtr.PixelRGB;
          DstPtr.NextPixel;
        end;
        SrcPtr.NextPixel;
      end;
      DstPtr.NextLine;
      SrcPtr.SetX(0);
    end;
    SrcPtr.NextLine;
  end;
  Dst.EndUpdate;
end;

procedure TGraphic.LoadFromFile(const Filename: string);
var
  Bitmap: Graphics.TGraphic;
begin
  Bitmap := NativeGraphicClass.Create;
  try
    Bitmap.LoadFromFile(FileName);
    if Self is TRasterImage then begin
      TRasterImage(Self).SetSize(Bitmap.Width, Bitmap.Height);
    end else begin
      Width := Bitmap.Width;
      Height := Bitmap.Height;
    end;
    if Self is TCustomBitmap then begin
      StretchDrawBitmap(Graphics.TRasterImage(Bitmap),
        Graphics.TCustomBitmap(GetNativeGraphic));
      //Graphics.TBitmap(GetNativeGraphic).Canvas.StretchDraw(Bounds(0, 0,
      //Graphics.TBitmap(GetNativeGraphic).Width, TBitmap(GetNativeGraphic).Height), Bitmap);
    end else raise Exception.Create('Unsupported class ' + Self.ClassName);
  finally
    FreeAndNil(Bitmap);
  end;
end;

procedure TGraphic.SaveToFile(const Filename: string);
var
  Bitmap: Graphics.TGraphic;
begin
  Bitmap := NativeGraphicClass.Create;
  try
    Bitmap.Width := Width;
    Bitmap.Height := Height;
    if Self is TBitmap then begin
      if Bitmap is Graphics.TRasterImage then
        (Bitmap as Graphics.TRasterImage).Canvas.StretchDraw(Bounds(0, 0, Bitmap.Width,
        Bitmap.Height), Graphics.TBitmap(GetNativeGraphic))
        else raise Exception.Create('Expected TRasterImage but got ' + Bitmap.ClassName);
    end else raise Exception.Create('Unsupported class ' + Self.ClassName);
    Bitmap.SaveToFile(FileName);
  finally
    FreeAndNil(Bitmap);
  end;
end;

{ TBitmap }

function TBitmap.GetScanLine(Row: Integer): Pointer;
begin
  Result := GetNativeBitmap.ScanLine[Row];
end;

function TBitmap.GetTransparent: Boolean;
begin
  Result := GetNativeBitmap.Transparent;
end;

function TBitmap.GetTransparentColor: TColor;
begin
  Result := GetNativeBitmap.TransparentColor;
end;

procedure TBitmap.SetTransparent(AValue: Boolean);
begin
  GetNativeBitmap.Transparent := AValue;
end;

procedure TBitmap.SetTransparentColor(AValue: TColor);
begin
  GetNativeBitmap.TransparentColor := AValue;
end;

function TBitmap.GetNativeBitmap: Graphics.TBitmap;
begin
  Result := NativeBitmap;
end;

function TBitmap.GetNativeCustomBitmap: Graphics.TCustomBitmap;
begin
  Result := GetNativeBitmap;
end;

procedure TBitmap.SetNativeBitmap(ANativeBitmap: Graphics.TBitmap);
begin
  NativeBitmap := ANativeBitmap;
end;

procedure TBitmap.SetNativeCustomBitmap(CustomBitmap: Graphics.TCustomBitmap);
begin
  SetNativeBitmap(Graphics.TBitmap(CustomBitmap));
end;

constructor TBitmap.Create;
begin
  NativeGraphicClass := Graphics.TBitmap;
  NativeBitmap := Graphics.TBitmap.Create;
  inherited;
end;

destructor TBitmap.Destroy;
begin
  FreeAndNil(FCanvas);
  FreeAndNil(NativeBitmap);
  inherited;
end;

{ TPen }

function TPen.GetColor: TColor;
begin
  Result := GetNativePen.Color;
end;

function TPen.GetStyle: TPenStyle;
begin
  Result := GetNativePen.Style;
end;

function TPen.GetWidth: Integer;
begin
  Result := FWidth;
end;

procedure TPen.SetColor(AValue: TColor);
begin
  GetNativePen.Color := AValue;
end;

procedure TPen.SetNativePen(AValue: Graphics.TPen);
begin
  if FNativePen = AValue then Exit;
  if FNativePenFree then FreeAndNil(FNativePen);
  FNativePenFree := False;
  FNativePen := AValue;
  SetWidth(FWidth);
end;

procedure TPen.SetStyle(AValue: TPenStyle);
begin
  GetNativePen.Style := AValue;
end;

procedure TPen.SetWidth(AValue: Integer);
begin
  GetNativePen.Width := ScaleToNative(AValue);
  FWidth := AValue;
end;

constructor TPen.Create;
begin
  FNativePen := Graphics.TPen.Create;
  FNativePenFree := True;
  FWidth := 1;
end;

destructor TPen.Destroy;
begin
  if FNativePenFree then
    FreeAndNil(FNativePen);
  inherited;
end;

function TPen.GetNativePen: Graphics.TPen;
begin
  Result := FNativePen;
end;

procedure TPen.Assign(Source: TPen);
begin
  FWidth := Source.FWidth;
  GetNativePen.Assign(Source.GetNativePen);
end;

{ TBrush }

function TBrush.GetColor: TColor;
begin
  Result := GetNativeBrush.Color;
end;

function TBrush.GetStyle: TBrushStyle;
begin
  Result := GetNativeBrush.Style;
end;

procedure TBrush.SetColor(AValue: TColor);
begin
  GetNativeBrush.Color := AValue;
end;

function TBrush.GetNativeBrush: Graphics.TBrush;
begin
  Result := FNativeBrush;
end;

procedure TBrush.SetNativeBrush(AValue: Graphics.TBrush);
begin
  if FNativeBrush = AValue then Exit;
  if FNativeBrushFree then FreeAndNil(FNativeBrush);
  FNativeBrushFree := False;
  FNativeBrush := AValue;
end;

procedure TBrush.SetStyle(AValue: TBrushStyle);
begin
  GetNativeBrush.Style := AValue;
end;

constructor TBrush.Create;
begin
  FNativeBrush := Graphics.TBrush.Create;
  FNativeBrushFree := True;
end;

destructor TBrush.Destroy;
begin
  if FNativeBrushFree then FreeAndNil(FNativeBrush);
  inherited;
end;

procedure TBrush.Assign(Source: TBrush);
begin
  GetNativeBrush.Assign(Source.GetNativeBrush);
end;

{ TCanvas }

function TCanvas.GetHandle: HDC;
begin
  Result := GetNativeCanvas.Handle;
end;

function TCanvas.GetHeight: Integer;
begin
  Result := ScaleFromNative(GetNativeCanvas.Height);
end;

function TCanvas.GetPixel(X, Y: Integer): TColor;
begin
  Result := GetNativeCanvas.Pixels[ScaleToNative(X), ScaleToNative(Y)];
end;

function TCanvas.GetTextStyle: TTextStyle;
begin
  Result := GetNativeCanvas.TextStyle;
end;

function TCanvas.GetWidth: Integer;
begin
  Result := ScaleFromNative(GetNativeCanvas.Width);
end;

procedure TCanvas.SetBrush(AValue: TBrush);
begin
  if FBrush = AValue then Exit;
  if FBrushFree then FreeAndNil(FBrush);
  FBrushFree := False;
  FBrush := AValue;
end;

procedure TCanvas.SetFont(AValue: TFont);
begin
  if FFont = AValue then Exit;
  if FFontFree then FreeAndNil(FFont);
  FFontFree := False;
  FFont := AValue;
end;

procedure TCanvas.SetHandle(AValue: HDC);
begin
  GetNativeCanvas.Handle := AValue;
end;

procedure TCanvas.SetHeight(AValue: Integer);
begin
  GetNativeCanvas.Height;
end;

procedure TCanvas.SetWidth(AValue: Integer);
begin

end;

procedure TCanvas.SetPen(AValue: TPen);
begin
  if FPen = AValue then Exit;
  if FPenFree then FreeAndNil(FPen);
  FPenFree := False;
  FPen := AValue;
end;

procedure TCanvas.SetPixel(X, Y: Integer; AValue: TColor);
var
  BrushStyle: TBrushStyle;
  BrushColor: TColor;
begin
 { BrushStyle := GetNativeCanvas.Brush.Style;
  BrushColor := GetNativeCanvas.Brush.Color;
  GetNativeCanvas.Brush.Color := AValue;
  GetNativeCanvas.Brush.Style := bsClear;
  GetNativeCanvas.FillRect(ScaleToNative(X), ScaleToNative(Y), ScaleToNative(X + 1) - 1, ScaleToNative(Y + 1) - 1);
  GetNativeCanvas.Brush.Style := BrushStyle;
  GetNativeCanvas.Brush.Color := BrushColor;
  }
  GetNativeCanvas.Pixels[ScaleToNative(X), ScaleToNative(Y)] := AValue;
end;

procedure TCanvas.SetNativeCanvas(AValue: Graphics.TCanvas);
begin
  if FNativeCanvas = AValue then Exit;
  if FNativeCanvasFree then FreeAndNil(FNativeCanvas);
  FNativeCanvasFree := False;
  FNativeCanvas := AValue;
  if Assigned(FNativeCanvas) then begin
    FFont.NativeFont := FNativeCanvas.Font;
    FBrush.NativeBrush := FNativeCanvas.Brush;
    FPen.NativePen := FNativeCanvas.Pen;
  end;
end;

procedure TCanvas.SetTextStyle(AValue: TTextStyle);
begin
  GetNativeCanvas.TextStyle := AValue;
end;

procedure TCanvas.DoLine(X1, Y1, X2, Y2: Integer);
begin
  raise ENotImplemented.Create(SNotImplemented);
end;

procedure TCanvas.DoTextOut(X, Y: Integer; Text: string);
begin
  raise ENotImplemented.Create(SNotImplemented);
end;

procedure TCanvas.DoRectangle(const Bounds: TRect);
begin
  raise ENotImplemented.Create(SNotImplemented);
end;

procedure TCanvas.DoRectangleFill(const Bounds: TRect);
begin
  raise ENotImplemented.Create(SNotImplemented);
end;

procedure TCanvas.DoPolygon(const Points: array of TPoint);
begin
  raise ENotImplemented.Create(SNotImplemented);
end;

procedure TCanvas.CreateHandle;
begin
  raise ENotImplemented.Create(SNotImplemented);
end;

procedure TCanvas.DoEllipse(const Bounds: TRect);
begin
  raise ENotImplemented.Create(SNotImplemented);
end;

procedure TCanvas.DoMoveTo(X, Y: Integer);
begin
  raise ENotImplemented.Create(SNotImplemented);
end;

procedure TCanvas.DoLineTo(X, Y: Integer);
begin
  raise ENotImplemented.Create(SNotImplemented);
end;

procedure TCanvas.DoPolyline(const Points: array of TPoint);
begin
  raise ENotImplemented.Create(SNotImplemented);
end;

procedure TCanvas.DoPolyBezier(Points: PPoint; NumPts: Integer;
  Filled: Boolean; Continuous: Boolean);
begin
  raise ENotImplemented.Create(SNotImplemented);
end;

function TCanvas.GetNativeCanvas: Graphics.TCanvas;
begin
  Result := NativeCanvas;
end;

procedure TCanvas.RoundRect(const Rect: TRect; RX, RY: Integer);
begin
  GetNativeCanvas.RoundRect(Rect, RX, RY);
end;

procedure TCanvas.RoundRect(X1, Y1, X2, Y2: Integer; RX, RY: Integer);
begin
  GetNativeCanvas.RoundRect(X1, Y1, X2, Y2, RX, RY);
end;

procedure TCanvas.Polygon(const Points: array of TPoint; Winding: Boolean;
  StartIndex: Integer; NumPts: Integer);
begin
  GetNativeCanvas.Polygon(Points, Winding, StartIndex, NumPts);
end;

procedure TCanvas.Polygon(Points: PPoint; NumPts: Integer; Winding: Boolean);
begin
  GetNativeCanvas.Polygon(Points, NumPts, Winding);
end;

procedure TCanvas.Polygon(const Points: array of TPoint);
begin
  GetNativeCanvas.Polygon(Points);
end;

procedure TCanvas.PolyBezier(const Points: array of TPoint; Filled: Boolean;
  Continuous: boolean);
begin
  GetNativeCanvas.Polyline(Points);
end;

procedure TCanvas.PolyBezier(Points: PPoint; NumPts: Integer;
  Filled: Boolean; Continuous: Boolean);
begin
  GetNativeCanvas.PolyBezier(Points, NumPts, Filled, Continuous);
end;

procedure TCanvas.Polyline(const Points: array of TPoint);
begin
  GetNativeCanvas.Polyline(Points);
end;

procedure TCanvas.Polyline(Points: PPoint; NumPts: Integer);
begin
  GetNativeCanvas.Polyline(Points, NumPts);
end;

procedure TCanvas.Ellipse(x1, y1, x2, y2: Integer);
begin
  GetNativeCanvas.Ellipse(X1, Y1, X2, Y2);
end;

procedure TCanvas.Ellipse(const ARect: TRect);
begin
  Ellipse(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
end;

{procedure TCanvas.StretchDraw(const DestRect: TRect; SrcGraphic: Graphics.TGraphic);
begin
  GetNativeCanvas.StretchDraw(DestRect, SrcGraphic);
end;
}
procedure TCanvas.Pie(EllipseX1, EllipseY1, EllipseX2, EllipseY2, StartX,
  StartY, EndX, EndY: Integer);
begin
  GetNativeCanvas.Pie(EllipseX1, EllipseY1, EllipseX2, EllipseY2, StartX, StartY,
    EndX, EndY);
end;

procedure TCanvas.StretchDraw(const DestRect: TRect; SrcGraphic: TGraphic
  );
begin
  GetNativeCanvas.StretchDraw(ScaleRectToNative(DestRect), SrcGraphic.GetNativeGraphic);
end;

procedure TCanvas.FrameRect(Rect: TRect);
begin
  GetNativeCanvas.FrameRect(ScaleRectToNative(Rect));
end;

procedure TCanvas.Rectangle(X1, Y1, X2, Y2: Integer);
begin
  GetNativeCanvas.Rectangle(ScaleToNative(X1), ScaleToNative(Y1), ScaleToNative(X2), ScaleToNative(Y2));
end;

procedure TCanvas.Rectangle(const ARect: TRect);
begin
  Rectangle(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
end;

function TCanvas.TextWidth(const Text: string): Integer;
begin
  Result := ScaleFromNative(GetNativeCanvas.TextWidth(Text));
end;

function TCanvas.TextHeight(const Text: string): Integer;
begin
  Result := ScaleFromNative(GetNativeCanvas.TextHeight(Text));
end;

function TCanvas.TextExtent(const Text: string): TSize;
begin
  Result := ScaleSizeFromNative(GetNativeCanvas.TextExtent(Text));
end;

procedure TCanvas.TextOut(X, Y: Integer; const Text: string);
begin
  GetNativeCanvas.TextOut(ScaleToNative(X), ScaleToNative(Y), Text);
end;

procedure TCanvas.TextRect(ARect: TRect; X, Y: Integer; Text: string);
begin
  GetNativeCanvas.TextRect(ScaleRectToNative(ARect), ScaleToNative(X),
    ScaleToNative(Y), Text);
end;

procedure TCanvas.TextRect(ARect: TRect; X, Y: integer; const Text: string;
  const Style: TTextStyle);
begin
  GetNativeCanvas.TextRect(ScaleRectToNative(ARect), ScaleToNative(X),
    ScaleToNative(Y), Text, TextStyle);
end;

procedure TCanvas.MoveTo(X, Y: Integer);
begin
  GetNativeCanvas.MoveTo(ScaleToNative(X), ScaleToNative(Y));
end;

procedure TCanvas.LineTo(X, Y: Integer);
begin
  GetNativeCanvas.LineTo(ScaleToNative(X), ScaleToNative(Y));
end;

procedure TCanvas.Line(const p1, p2: TPoint);
begin
  GetNativeCanvas.Line(P1, P2);
end;

procedure TCanvas.FillRect(const ARect: TRect);
begin
  GetNativeCanvas.FillRect(ScaleRectToNative(ARect));
end;

procedure TCanvas.FillRect(X1, Y1, X2, Y2: Integer);
begin
  GetNativeCanvas.FillRect(ScaleToNative(X1), ScaleToNative(Y1), ScaleToNative(X2), ScaleToNative(Y2));
end;

procedure TCanvas.Draw(X, Y: Integer; Source: TGraphic);
begin
  GetNativeCanvas.Draw(ScaleToNative(X), ScaleToNative(Y), Source.GetNativeGraphic);
end;

procedure TCanvas.CopyRect(Dest: TRect; SrcCanvas: TCanvas;
  Source: TRect);
begin
  GetNativeCanvas.CopyRect(Dest, SrcCanvas.NativeCanvas, ScaleRectToNative(Source));
end;

constructor TCanvas.Create;
begin
  FNativeCanvas := nil;
  FFont := TFont.Create;
  FFontFree := True;
  FPen := TPen.Create;
  FPenFree := True;
  FBrush := TBrush.Create;
  FBrushFree := True;
end;

destructor TCanvas.Destroy;
begin
  if FFontFree then FreeAndNil(FFont);
  if FBrushFree then FreeAndNil(FBrush);
  if FPenFree then FreeAndNil(FPen);
  if FNativeCanvasFree then FreeAndNil(FNativeCanvasFree);
  inherited;
end;

{ TJpegImage }

function TJpegImage.GetNativeCustomBitmap: Graphics.TCustomBitmap;
begin
  Result := GetNativeJpeg;
end;

function TJpegImage.GetNativeJpeg: Graphics.TJPEGImage;
begin
  Result := NativeJpeg;
end;

procedure TJpegImage.SetNativeCustomBitmap(CustomBitmap: Graphics.TCustomBitmap
  );
begin
  SetNativeJpeg(Graphics.TJpegImage(CustomBitmap));
end;

procedure TJpegImage.SetNativeJpeg(Jpeg: Graphics.TJPEGImage);
begin
  NativeJpeg := Jpeg;
end;

constructor TJpegImage.Create;
begin
  NativeJpeg := Graphics.TJPEGImage.Create;
  NativeGraphicClass := Graphics.TJPEGImage;
  inherited;
end;

destructor TJpegImage.Destroy;
begin
  FreeAndNil(NativeJpeg);
  inherited;
end;

{ TPicture }

procedure TPicture.SetBitmap(AValue: TBitmap);
begin
  if FBitmap = AValue then Exit;
  FBitmap := AValue;
end;

procedure TPicture.LoadFromFile(FileName: string);
begin
end;

{ TScreenInfo }

procedure TScreenInfo.SetDpi(AValue: Integer);
var
  I: Integer;
begin
  if FDpi = AValue then Exit;
  FDpi := AValue;

  // Precalculate scaling coefficients
  ToNative := ScreenInfo.Dpi / 96;
  for I := Low(LookupToNative) to High(LookupToNative) do
    LookupToNative[I] := Ceil(I * ToNative);
  FromNative := 96 / ScreenInfo.Dpi;
  for I := Low(LookupFromNative) to High(LookupFromNative) do
    LookupFromNative[I] := Floor(I * FromNative);
end;

{ TPortableNetworkGraphic }

function TPortableNetworkGraphic.GetNativeCustomBitmap: Graphics.TCustomBitmap;
begin
  Result := GetNativePng;
end;

function TPortableNetworkGraphic.GetNativePng: Graphics.TPortableNetworkGraphic;
begin
  Result := NativePng;
end;

procedure TPortableNetworkGraphic.SetNativeCustomBitmap(
  CustomBitmap: Graphics.TCustomBitmap);
begin
  SetNativePng(Graphics.TPortableNetworkGraphic(CustomBitmap));
end;

procedure TPortableNetworkGraphic.SetNativePng(
  Png: Graphics.TPortableNetworkGraphic);
begin
  NativePng := Png;
end;

constructor TPortableNetworkGraphic.Create;
begin
  NativePng := Graphics.TPortableNetworkGraphic.Create;
  NativeGraphicClass := Graphics.TPortableNetworkGraphic;
  inherited;
end;

destructor TPortableNetworkGraphic.Destroy;
begin
  Canvas.NativeCanvas := nil;
  FreeAndNil(NativePng);
  inherited;
end;

end.