path: root/gfx/gfxbase.pas

{
    fpGUI  -  Free Pascal GUI Library

    GFXBase  -  Abstract declarations to be implemented on each platform

    Copyright (C) 2000 - 2007 See the file AUTHORS.txt, included in this
    distribution, for details of the copyright.

    See the file COPYING.modifiedLGPL, included in this distribution,
    for details about redistributing fpGUI.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}
unit GfxBase;

{$IFDEF Debug}
  {$ASSERTIONS On}
{$ENDIF}

{$ifdef fpc}
  {$mode objfpc}{$H+}
{$endif}

interface

uses
  SysUtils,
  Classes;

{$INCLUDE keys.inc}

resourcestring
  // Exception message strings, to be used by target implementations
  SUnsupportedPixelFormat = 'Pixel format (%d bits/pixel) is not supported';
  SIncompatibleCanvasForBlitting = 'Cannot blit from %s to %s';

type

  TSize = record
    cx, cy: Integer;
  end;


  { We use a special 3x3 matrix for transformations of coordinates. As the
    only allowed transformations are translations and scalations, we need a
    matrix with the following content ([x,y] is a variable):
        [0,0]   0   [2,0]
          0   [1,1] [2,1]
          0     0     1
    [0,0]: X scalation
    [2,0]: X translation
    [1,1]: Y scalation
    [2,1]: Y translation
    NOTE: This may change in the future! Don't assume anything about the
	  structure of TGfxMatrix! TGfxCanvas only allows you to read and
	  write the current transformation matrix so that the matrix can
	  easily be saved and restored.
  }

  TGfxMatrix = record
    _00, _20, _11, _21: Integer;
  end;

const
  GfxIdentityMatrix: TGfxMatrix = (_00: 1; _20: 0; _11: 1; _21: 0);

type

  TColor = type LongWord;

  PGfxColor = ^TGfxColor;
  TGfxColor = packed record
    Red, Green, Blue, Alpha: Byte;
  end;

  PGfxPixel = ^TGfxPixel;
  TGfxPixel = LongWord;


  TGfxImageType = (
    ftInvalid,
    ftMono,		// Monochrome
    ftPal4,		// 4 bpp using palette
    ftPal4A,		// 4 bpp using palette with alpha values > 0
    ftPal8,		// 8 bpp using palette
    ftPal8A,		// 8 bpp using palette with alpha values > 0
    ftRGB16,		// 15/16 bpp RGB
    ftRGBA16,		// 16 bpp RGBA
    ftRGB24,		// 24 bpp RGB
    ftRGB32,		// 32 bpp RGB
    ftRGBA32);	        // 32 bpp RGBA


  TGfxPixelFormat = record
    FormatType: TGfxImageType;
    RedMask: TGfxPixel;
    GreenMask: TGfxPixel;
    BlueMask: TGfxPixel;
    AlphaMask: TGfxPixel;
  end;


const

  FormatTypeBPPTable: array[TGfxImageType] of Integer =
    (0, 1, 4, 4, 8, 8, 16, 16, 24, 32, 32);
    
  { Predefined desktop colors }

  colTransparent: TGfxColor    = (Red: $00; Green: $00; Blue: $00; Alpha: $ff);
  colBlack: TGfxColor          = (Red: $00; Green: $00; Blue: $00; Alpha: $00);
  colBlue: TGfxColor	       = (Red: $00; Green: $00; Blue: $ff; Alpha: $00);
  colGreen: TGfxColor	       = (Red: $00; Green: $ff; Blue: $00; Alpha: $00);
  colCyan: TGfxColor	       = (Red: $00; Green: $ff; Blue: $ff; Alpha: $00);
  colRed: TGfxColor	       = (Red: $ff; Green: $00; Blue: $00; Alpha: $00);
  colMagenta: TGfxColor	       = (Red: $ff; Green: $00; Blue: $ff; Alpha: $00);
  colYellow: TGfxColor	       = (Red: $ff; Green: $ff; Blue: $00; Alpha: $00);
  colWhite: TGfxColor          = (Red: $ff; Green: $ff; Blue: $ff; Alpha: $00);
  colGray: TGfxColor	       = (Red: $80; Green: $80; Blue: $80; Alpha: $00);
  colLtGray: TGfxColor	       = (Red: $c0; Green: $c0; Blue: $c0; Alpha: $00);
  colDkBlue: TGfxColor         = (Red: $00; Green: $00; Blue: $80; Alpha: $00);
  colDkGreen: TGfxColor	       = (Red: $00; Green: $80; Blue: $00; Alpha: $00);
  colDkCyan: TGfxColor	       = (Red: $00; Green: $80; Blue: $80; Alpha: $00);
  colDkRed: TGfxColor	       = (Red: $80; Green: $00; Blue: $00; Alpha: $00);
  colDkMagenta: TGfxColor      = (Red: $80; Green: $00; Blue: $80; Alpha: $00);
  colDkYellow: TGfxColor       = (Red: $80; Green: $80; Blue: $00; Alpha: $00);

  { Predefined web colors }

  webBlack: TGfxColor	       = (Red: $00; Green: $00; Blue: $00; Alpha: $00);
  webMaroon: TGfxColor	       = (Red: $80; Green: $00; Blue: $00; Alpha: $00);
  webGreen: TGfxColor          = (Red: $00; Green: $80; Blue: $00; Alpha: $00);
  webOlive: TGfxColor          = (Red: $80; Green: $80; Blue: $00; Alpha: $00);
  webNavy: TGfxColor	       = (Red: $00; Green: $00; Blue: $80; Alpha: $00);
  webPurple: TGfxColor	       = (Red: $80; Green: $00; Blue: $80; Alpha: $00);
  webTeal: TGfxColor	       = (Red: $00; Green: $80; Blue: $80; Alpha: $00);
  webGray: TGfxColor           = (Red: $80; Green: $80; Blue: $80; Alpha: $00);
  webSilver: TGfxColor	       = (Red: $c0; Green: $c0; Blue: $c0; Alpha: $00);
  webRed: TGfxColor            = (Red: $ff; Green: $00; Blue: $00; Alpha: $00);
  webLime: TGfxColor	       = (Red: $00; Green: $ff; Blue: $00; Alpha: $00);
  webYellow: TGfxColor 	       = (Red: $ff; Green: $ff; Blue: $00; Alpha: $00);
  webBlue: TGfxColor           = (Red: $00; Green: $00; Blue: $ff; Alpha: $00);
  webFuchsia: TGfxColor	       = (Red: $ff; Green: $00; Blue: $ff; Alpha: $00);
  webAqua: TGfxColor	       = (Red: $00; Green: $ff; Blue: $ff; Alpha: $00);
  webWhite: TGfxColor          = (Red: $ff; Green: $ff; Blue: $ff; Alpha: $00);


  // Some predefined pixel formats:

  PixelFormatMono: TGfxPixelFormat = (
    FormatType: ftMono;
    RedMask:	0;
    GreenMask:	0;
    BlueMask:	0;
    AlphaMask:	0);

  PixelFormatPal4: TGfxPixelFormat = (
    FormatType: ftPal4;
    RedMask:	0;
    GreenMask:	0;
    BlueMask:	0;
    AlphaMask:	0);

  PixelFormatPal4A: TGfxPixelFormat = (
    FormatType: ftPal4A;
    RedMask:	0;
    GreenMask:	0;
    BlueMask:	0;
    AlphaMask:	0);

  PixelFormatPal8: TGfxPixelFormat = (
    FormatType: ftPal8;
    RedMask:	0;
    GreenMask:	0;
    BlueMask:	0;
    AlphaMask:	0);

  PixelFormatPal8A: TGfxPixelFormat = (
    FormatType: ftPal8A;
    RedMask:	0;
    GreenMask:	0;
    BlueMask:	0;
    AlphaMask:	0);

  { Windows requires this particular order for RGB images }

  { 5-6-5 storage }
  PixelFormatRGB16: TGfxPixelFormat = (
    FormatType:	ftRGB16;
    RedMask:	$F800;
    GreenMask:	$07E0;
    BlueMask:	$001F;
    AlphaMask:	0);

  PixelFormatRGB24: TGfxPixelFormat = (
    FormatType:	ftRGB24;
    RedMask:	$ff0000;
    GreenMask:	$00ff00;
    BlueMask:	$0000ff;
    AlphaMask:	0);

  PixelFormatRGB32: TGfxPixelFormat = (
    FormatType:	ftRGB32;
    RedMask:	$ff0000;
    GreenMask:	$00ff00;
    BlueMask:	$0000ff;
    AlphaMask:	0);

  PixelFormatRGBA32: TGfxPixelFormat = (
    FormatType: ftRGB32;
    RedMask:	$00ff0000;
    GreenMask:	$0000ff00;
    BlueMask:	$000000ff;
    AlphaMask:	$ff000000);

type

  EGfxError = class(Exception);

  EGfxUnsupportedPixelFormat = class(EGfxError)
    constructor Create(const APixelFormat: TGfxPixelFormat);
  end;


  TFCustomBitmap = class;
  TFCustomApplication = class;
  TFCustomWindow = class;

  TFWindowOption = (
    woWindow, woBorderless, woPopup, woToolWindow, woChildWindow,
    woX11SkipWMHints, woModal);
  TFWindowOptions = set of TFWindowOption;

  TFCursor = (crDefault, crNone, crArrow, crCross, crIBeam, crSize, crSizeNS,
    crSizeWE, cpUpArrow, crHourGlass, crNoDrop, crHelp);

  TMouseButton = (mbLeft, mbRight, mbMiddle);

  { TFEvent }
  
  TFEventType = (etCreate, etCanClose, etClose, etFocusIn, etFocusOut,
   etHide, etKeyPressed, etKeyReleased, etKeyChar,
   etMouseEnter, etMouseLeave, etMousePressed, etMouseReleased,
   etMouseMove, etMouseWheel, etPaint, etMove, etResize, etShow);

  TFEvent = record
    EventType: TFEventType;
    { Key fields }
    Key: Word;
    KeyChar: Char;
    { Mouse fields }
    MousePos: TPoint;
    MouseButton: TMouseButton;
    WheelDelta: Single;
  end;

  { TFCustomFont }

  TGfxFontClass = (fcSerif, fcSansSerif, fcTypewriter, fcDingbats);

  TFCustomFont = class
  protected
    FHandle: Cardinal;
  public
    class function GetDefaultFontName(const AFontClass: TGfxFontClass): String; virtual;
    property    Handle: Cardinal read FHandle;
  end;


  { TGfxPalette }

  TGfxPalette = class
  private
    FRefCount: LongInt;
    FEntryCount: Integer;
    FEntries: PGfxColor;
    function    GetEntry(AIndex: Integer): TGfxColor;
  public
    constructor Create(AEntryCount: Integer; AEntries: PGfxColor);
    destructor  Destroy; override;
    procedure   AddRef;
    procedure   Release;
    property    EntryCount: Integer read FEntryCount;
    property    Entries[AIndex: Integer]: TGfxColor read GetEntry;
  end;


  { TFCustomCanvas }

  TGfxLineStyle = (lsSolid, lsDot);

  TFCustomCanvas = class(TObject)
  private
    FMatrix: TGfxMatrix;
  protected
    FWidth: Integer;
    FHeight: Integer;
    FHandle: Cardinal;
    FPixelFormat: TGfxPixelFormat;
    FColor: TGfxColor;
    function    DoExcludeClipRect(const ARect: TRect): Boolean; virtual; abstract;
    function    DoIntersectClipRect(const ARect: TRect): Boolean; virtual; abstract;
    function    DoUnionClipRect(const ARect: TRect): Boolean; virtual; abstract;
    function    DoGetClipRect: TRect; virtual; abstract;
    procedure   DoDrawArc(const ARect: TRect; StartAngle, EndAngle: Single); virtual; abstract;
    procedure   DoDrawCircle(const ARect: TRect); virtual; abstract;
    procedure   DoDrawLine(const AFrom, ATo: TPoint); virtual; abstract;
    procedure   DoDrawRect(const ARect: TRect); virtual;
    procedure   DoDrawPoint(const APoint: TPoint); virtual; abstract;
    procedure   DoFillRect(const ARect: TRect); virtual; abstract;
    procedure   DoFillTriangle(const P1, P2, P3: TPoint); virtual; abstract;
    procedure   DoTextOut(const APosition: TPoint; const AText: String); virtual; abstract;
    procedure   DoCopyRect(ASource: TFCustomCanvas; const ASourceRect: TRect; const ADestPos: TPoint); virtual; abstract;
    procedure   DoMaskedCopyRect(ASource, AMask: TFCustomCanvas; const ASourceRect: TRect; const AMaskPos, ADestPos: TPoint); virtual; abstract;
    procedure   DoDrawImageRect(AImage: TFCustomBitmap; ASourceRect: TRect; const ADestPos: TPoint); virtual; abstract;
  public
    constructor Create; virtual;
    procedure   SetHandle(AHandle: PtrUInt); virtual; abstract;
    // Transformations
    function    Transform(APoint: TPoint): TPoint;
    function    Transform(ARect: TRect): TRect;
    function    ReverseTransform(APoint: TPoint): TPoint;
    function    ReverseTransform(ARect: TRect): TRect;
    procedure   AppendTranslation(ADelta: TPoint);

    // Graphics state
    procedure   SaveState; virtual; abstract;
    procedure   RestoreState; virtual; abstract;
    procedure   EmptyClipRect; virtual;
    procedure   DoSetColor(AColor: TGfxPixel); virtual; abstract;
    procedure   SetColor(AColor: TGfxColor); virtual;
    procedure   SetFont(AFont: TFCustomFont); virtual; abstract;
    procedure   SetLineStyle(ALineStyle: TGfxLineStyle); virtual; abstract;
    function    ExcludeClipRect(const ARect: TRect): Boolean;
    function    IntersectClipRect(const ARect: TRect): Boolean;
    function    UnionClipRect(const ARect: TRect): Boolean;
    function    GetClipRect: TRect;
    function    MapColor(const AColor: TGfxColor): TGfxPixel; virtual; abstract;
    function    GetColor: TGfxColor;

    // Drawing functions
    procedure   DrawArc(const ARect: TRect; StartAngle, EndAngle: Single);
    procedure   DrawCircle(const ARect: TRect);
    procedure   DrawLine(const AFrom, ATo: TPoint); overload;
    procedure   DrawLine(const X1, Y1, X2, Y2: Integer); overload;
    procedure   DrawPolyLine(const Coords: array of TPoint); virtual;
    procedure   DrawRect(const ARect: TRect);
    procedure   DrawPoint(const APoint: TPoint);
    procedure   FillRect(const ARect: TRect);
    procedure   FillTriangle(const P1, P2, P3: TPoint);

    // Fonts
    function    FontCellHeight: Integer; virtual; abstract;
    function    TextExtent(const AText: String): TSize; virtual;
    function    TextWidth(const AText: String): Integer; virtual;
    procedure   TextOut(const APosition: TPoint; const AText: String);
//    procedure TextRect(Rect: TRect; X, Y: Integer; const Text: WideString; TextFlags: Integer = 0);
    
    // Bit block transfers
    procedure   Copy(ASource: TFCustomCanvas; const ADestPos: TPoint); virtual;
    procedure   CopyRect(ASource: TFCustomCanvas; const ASourceRect: TRect; const ADestPos: TPoint);
    procedure   MaskedCopy(ASource, AMask: TFCustomCanvas; const ADestPos: TPoint);
{!!!:    procedure MaskedCopyRect(ASource, AMask: TGfxCanvas; const ASourceRect: TRect;
      const ADestPos: TPoint); virtual;}
    procedure   MaskedCopyRect(ASource, AMask: TFCustomCanvas; const ASourceRect: TRect; const AMaskPos, ADestPos: TPoint);

    // Image drawing
    procedure   DrawImage(AImage: TFCustomBitmap; const ADestPos: TPoint);
    procedure   DrawImageRect(AImage: TFCustomBitmap; ASourceRect: TRect; const ADestPos: TPoint);

    // Properties
    property    Width: Integer read FWidth;
    property    Height: Integer read FHeight;
    property    PixelFormat: TGfxPixelFormat read FPixelFormat;
    property    Matrix: TGfxMatrix read FMatrix write FMatrix;
    property    Handle: Cardinal read FHandle;
  end;

  { TFCustomBitmap }

  TFCustomBitmap = class(TObject)
  private
    FWidth, FHeight: Integer;
    FPixelFormat: TGfxPixelFormat;
    FPalette: TGfxPalette;
    procedure   SetPalette(APalette: TGfxPalette);
  protected
    FHandle: Cardinal;
    FStride: LongWord;
    FData: Pointer;
  public
    constructor Create(AWidth, AHeight: Integer; APixelFormat: TGfxPixelFormat); virtual;
    destructor  Destroy; override;
    procedure   Lock(out AData: Pointer; out AStride: LongWord); virtual; abstract;
    procedure   Unlock; virtual; abstract;
    procedure   SetPixelsFromData(AData: Pointer; AStride: LongWord);
    property    Width: Integer read FWidth;
    property    Height: Integer read FHeight;
    property    PixelFormat: TGfxPixelFormat read FPixelFormat;
    property    Palette: TGfxPalette read FPalette write SetPalette;
    property    Handle: Cardinal read FHandle;
    property    Data: Pointer read FData;
    property    Stride: LongWord read FStride;
  end;

  { TFCustomScreen }

  TFCustomScreen = class(TObject)
  protected
    procedure   SetMousePos(const NewPos: TPoint); virtual; abstract;
    function    GetMousePos: TPoint; virtual; abstract;
  public
    constructor Create; virtual;
    function    CreateBitmapCanvas(AWidth, AHeight: Integer): TFCustomCanvas; virtual; abstract;
    function    CreateMonoBitmapCanvas(AWidth, AHeight: Integer): TFCustomCanvas; virtual; abstract;
    property    MousePos: TPoint read GetMousePos write SetMousePos;
  end;

  { TFCustomApplication }

  TFCustomApplication = class(TComponent)
  private
    FOnIdle: TNotifyEvent;
    FQuitWhenLastWindowCloses: Boolean;
  protected
    FDisplayName: String;
    DoBreakRun: Boolean;
    FTitle: String;
    procedure   SetTitle(const ATitle: String);
  public
    Forms: TList;
    { Default methods }
    constructor Create; virtual; overload;
    destructor  Destroy; override;
    procedure   AddWindow(AWindow: TFCustomWindow); virtual;
    procedure   RemoveWindow(AWindow: TFCustomWindow); virtual;
    procedure   Initialize(ADisplayName: String = ''); virtual; abstract;
    procedure   Run; virtual;
    procedure   Quit; virtual; abstract;
    { Properties }
    property    OnIdle: TNotifyEvent read FOnIdle write FOnIdle;
    property    QuitWhenLastWindowCloses: Boolean read FQuitWhenLastWindowCloses write FQuitWhenLastWindowCloses;
    property    Title: String read FTitle write SetTitle;
  end;


  { TFCustomWindow }

  // Lifetime handling
  TGfxCanCloseEvent = function(Sender: TObject): Boolean of object;
  // Keyboard
  TGfxKeyEvent = procedure(Sender: TObject; AKey: Word; AShift: TShiftState) of object;
  TGfxKeyCharEvent = procedure(Sender: TObject; AKeyChar: Char) of object;
  // Mouse
  TGfxMouseButtonEvent = procedure(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint) of object;
  TGfxMouseMoveEvent = procedure(Sender: TObject; AShift: TShiftState; const AMousePos: TPoint) of object;
  TGfxMouseWheelEvent = procedure(Sender: TObject; AShift: TShiftState; AWheelDelta: Single; const AMousePos: TPoint) of object;
  // Painting
  TGfxPaintEvent = procedure(Sender: TObject; const ARect: TRect) of object;


  TFCustomWindow = class(TObject)
  private
    FCursor: TFCursor;
    FOnCreate: TNotifyEvent;
    FOnCanClose: TGfxCanCloseEvent;
    FOnClose: TNotifyEvent;
    FOnFocusIn: TNotifyEvent;
    FOnFocusOut: TNotifyEvent;
    FOnHide: TNotifyEvent;
    FOnKeyPressed: TGfxKeyEvent;
    FOnKeyReleased: TGfxKeyEvent;
    FOnKeyChar: TGfxKeyCharEvent;
    FOnMouseEnter: TGfxMouseMoveEvent;
    FOnMouseLeave: TNotifyEvent;
    FOnMousePressed: TGfxMouseButtonEvent;
    FOnMouseReleased: TGfxMouseButtonEvent;
    FOnMouseMove: TGfxMouseMoveEvent;
    FOnMouseWheel: TGfxMouseWheelEvent;
    FOnPaint: TNotifyEvent;
    FOnMove: TNotifyEvent;
    FOnResize: TNotifyEvent;
    FOnShow: TNotifyEvent;
    FVisible: Boolean;
    { Property setting methods mapped to other methods }
    procedure SetClientHeight(const AValue: Integer);
    procedure SetClientWidth(const AValue: Integer);
    procedure SetCursor(ACursor: TFCursor);
    procedure SetHeight(AHeight: Integer);
    procedure SetLeft(const AValue: Integer);
    procedure SetTop(const AValue: Integer);
    procedure SetVisible(const AValue: Boolean);
    procedure SetWidth(AWidth: Integer);
    procedure SetWindowOptions(const AValue: TFWindowOptions);
  protected
    { Fields related to properties }
    FParent: TFCustomWindow;
    FCanvas: TFCustomCanvas;
    FLeft: Integer;
    FTop: Integer;
    FWidth: Integer;
    FHeight: Integer;
    FClientWidth: Integer;
    FClientHeight: Integer;
    FWindowOptions: TFWindowOptions;
    FMinSize, FMaxSize: TSize;
    FFocusable: Boolean;

    { Fields of the child windows list }
    FChildWindows: TList;
    FFocusedWindow: TFCustomWindow;

    { Internal resource allocation methods }
    procedure DoSetCursor; virtual; abstract;
    procedure DoSetWindowOptions; virtual; abstract;
    function  GetHandle: PtrUInt; virtual; abstract;
    procedure CreateWindow; virtual; abstract;

    { Event processing methods }
    procedure EvCreate; virtual; abstract;
    procedure EvFocusIn; virtual; abstract;
    procedure EvFocusOut; virtual; abstract;
    procedure EvHide; virtual; abstract;
    procedure EvKeyPressed(AKey: Word); virtual; abstract;
    procedure EvKeyReleased(AKey: Word); virtual; abstract;
    procedure EvKeyChar(AKeyChar: Char); virtual; abstract;
    procedure EvMouseEnter(const AMousePos: TPoint); virtual; abstract;
    procedure EvMouseLeave; virtual; abstract;
    procedure EvMousePressed(AButton: TMouseButton; const AMousePos: TPoint); virtual; abstract;
    procedure EvMouseReleased(AButton: TMouseButton; const AMousePos: TPoint); virtual; abstract;
    procedure EvMouseMove(const AMousePos: TPoint); virtual; abstract;
    procedure EvMouseWheel(AWheelDelta: Single; const AMousePos: TPoint); virtual; abstract;
    procedure EvPaint; virtual; abstract;
    procedure EvMove; virtual; abstract;
    procedure EvResize; virtual; abstract;
    procedure EvShow; virtual; abstract;
  public
    { Constructors / Destructors }
    constructor Create(AParent: TFCustomWindow; AWindowOptions: TFWindowOptions); virtual;
    destructor  Destroy; override;
    { Widget controling methods }
    function  CanClose: Boolean; virtual;
    function  GetTitle: String; virtual;
    procedure SetTitle(const ATitle: String); virtual;
    procedure SetPosition(const APosition: TPoint); virtual; abstract;
    procedure SetSize(const ASize: TSize); virtual; abstract;
    procedure SetMinMaxSize(const AMinSize, AMaxSize: TSize); virtual; abstract;
    procedure SetClientSize(const ASize: TSize); virtual; abstract;
    procedure SetMinMaxClientSize(const AMinSize, AMaxSize: TSize); virtual; abstract;
    procedure Show; virtual; abstract;
    procedure Hide; virtual; abstract;
    procedure Invalidate; virtual; abstract;
    procedure CaptureMouse; virtual; abstract;
    procedure ReleaseMouse; virtual; abstract;
    { Event processing methods }
    procedure ProcessEvent(AEvent: TFEvent);
    { Methods of the child windows list }
    function  FindTopParentWindow: TFCustomWindow;

    { Properties }
    property WindowOptions: TFWindowOptions read FWindowOptions write SetWindowOptions;
    property Canvas: TFCustomCanvas read FCanvas;
    property Handle: PtrUInt read GetHandle;
    property ChildWindows: TList read FChildWindows;
    { Window state }
    property ClientWidth: Integer read FClientWidth write SetClientWidth;
    property ClientHeight: Integer read FClientHeight write SetClientHeight;
    property Cursor: TFCursor read FCursor write SetCursor;
    property Left: Integer read FLeft write SetLeft;
    property Top: Integer read FTop write SetTop;
    property Width: Integer read FWidth write SetWidth;
    property Height: Integer read FHeight write SetHeight;
    property Title: String read GetTitle write SetTitle;
    property Parent: TFCustomWindow read FParent;
    property Visible: Boolean read FVisible write SetVisible;
    property Focusable: Boolean read FFocusable write FFocusable;
    { Event handlers }
    property OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
    property OnCanClose: TGfxCanCloseEvent read FOnCanClose write FOnCanClose;
    property OnClose: TNotifyEvent read FOnClose write FOnClose;
    property OnFocusIn: TNotifyEvent read FOnFocusIn write FOnFocusIn;
    property OnFocusOut: TNotifyEvent read FOnFocusOut write FOnFocusOut;
    property OnHide: TNotifyEvent read FOnHide write FOnHide;
    property OnKeyPressed: TGfxKeyEvent read FOnKeyPressed write FOnKeyPressed;
    property OnKeyReleased: TGfxKeyEvent read FOnKeyReleased write FOnKeyReleased;
    property OnKeyChar: TGfxKeyCharEvent read FOnKeyChar write FOnKeyChar;
    property OnMouseEnter: TGfxMouseMoveEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    property OnMousePressed: TGfxMouseButtonEvent read FOnMousePressed write FOnMousePressed;
    property OnMouseReleased: TGfxMouseButtonEvent read FOnMouseReleased write FOnMouseReleased;
    property OnMouseMove: TGfxMouseMoveEvent read FOnMouseMove write FOnMouseMove;
    property OnMouseWheel: TGfxMouseWheelEvent read FOnMouseWheel write FOnMouseWheel;
    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
    property OnMove: TNotifyEvent read FOnMove write FOnMove;
    property OnResize: TNotifyEvent read FOnResize write FOnResize;
    property OnShow: TNotifyEvent read FOnShow write FOnShow;
  end;

// Some helpers:

// Sizes, points etc.
function Size(AWidth, AHeight: Integer): TSize;
function Size(ARect: TRect): TSize;
function PtInRect(const ARect: TRect; const APoint: TPoint): Boolean;

{$ifdef fpc}
operator = (const ASize1, ASize2: TSize) b: Boolean;
operator + (const APoint1, APoint2: TPoint) p: TPoint;
operator + (const APoint: TPoint; ASize: TSize) p: TPoint;
operator + (const ASize: TSize; APoint: TPoint) s: TSize;
operator + (const ASize1, ASize2: TSize) s: TSize;
operator + (const APoint: TPoint; i: Integer) p: TPoint;
operator + (const ASize: TSize; i: Integer) s: TSize;
operator - (const APoint1, APoint2: TPoint) p: TPoint;
operator - (const APoint: TPoint; i: Integer) p: TPoint;
operator - (const ASize: TSize; const APoint: TPoint) s: TSize;
operator - (const ASize: TSize; i: Integer) s: TSize;

// Colors
operator = (const AColor1, AColor2: TGfxColor) b: Boolean;
{$endif}
function GetAvgColor(const AColor1, AColor2: TGfxColor): TGfxColor;
function GetGfxColor(const ARed, AGreen, ABlue, AAlpha: Byte): TGfxColor;
function GfxColorToTColor(const AColor: TGfxColor): TColor;


// Keyboard
function KeycodeToText(Key: Word; ShiftState: TShiftState): String;

implementation

uses
  CommandLineParams
  ;


{ Exceptions }

constructor EGfxUnsupportedPixelFormat.Create(const
  APixelFormat: TGfxPixelFormat);
begin
  inherited CreateFmt(SUnsupportedPixelFormat,
    [FormatTypeBPPTable[APixelFormat.FormatType]]);
end;

{ TFCustomFont }

class function TFCustomFont.GetDefaultFontName(const AFontClass: TGfxFontClass): String;
const
  FontNames: array[TGfxFontClass] of String = (
    'times', 'helvetica', 'courier', 'dingbats');
begin
  Result := FontNames[AFontClass];
end;

{ TGfxPalette }

destructor TGfxPalette.Destroy;
begin
  if Assigned(FEntries) then
    FreeMem(FEntries);
  inherited Destroy;
end;

procedure TGfxPalette.AddRef;
begin
  Inc(FRefCount);
end;

procedure TGfxPalette.Release;
begin
  if FRefCount <= 0 then
    Free
  else
    Dec(FRefCount);
end;

constructor TGfxPalette.Create(AEntryCount: Integer; AEntries: PGfxColor);
begin
  inherited Create;
  FEntryCount := AEntryCount;
  GetMem(FEntries, EntryCount * SizeOf(TGfxColor));
  if Assigned(AEntries) then
    Move(AEntries^, FEntries^, EntryCount * SizeOf(TGfxColor));
end;

function TGfxPalette.GetEntry(AIndex: Integer): TGfxColor;
begin
  if (AIndex >= 0) and (AIndex < EntryCount) then
    Result := FEntries[AIndex]
  else
    Result := colBlack;
end;


{ TFCustomCanvas }

constructor TFCustomCanvas.Create;
begin
  inherited Create;
  Matrix        := GfxIdentityMatrix;
  FColor        := colBlack;
end;

function TFCustomCanvas.Transform(APoint: TPoint): TPoint;
begin
  Result.x      := Matrix._00 * APoint.x + Matrix._20;
  Result.y      := Matrix._11 * APoint.y + Matrix._21;
end;

function TFCustomCanvas.Transform(ARect: TRect): TRect;
begin
  Result.Left   := Matrix._00 * ARect.Left + Matrix._20;
  Result.Top    := Matrix._11 * ARect.Top + Matrix._21;
  Result.Right  := Matrix._00 * ARect.Right + Matrix._20;
  Result.Bottom := Matrix._11 * ARect.Bottom + Matrix._21;
end;

function TFCustomCanvas.ReverseTransform(APoint: TPoint): TPoint;
begin
  Result.x      := (APoint.x - Matrix._20) div Matrix._00;
  Result.y      := (APoint.y - Matrix._21) div Matrix._11;
end;

function TFCustomCanvas.ReverseTransform(ARect: TRect): TRect;
begin
  Result.Left   := (ARect.Left - Matrix._20) div Matrix._00;
  Result.Top    := (ARect.Top - Matrix._21) div Matrix._11;
  Result.Right  := (ARect.Right - Matrix._20) div Matrix._00;
  Result.Bottom := (ARect.Bottom - Matrix._21) div Matrix._11;
end;

procedure TFCustomCanvas.AppendTranslation(ADelta: TPoint);
begin
  // Append a translation to the existing transformation matrix
  Inc(FMatrix._20, FMatrix._00 * ADelta.x);
  Inc(FMatrix._21, FMatrix._11 * ADelta.y);
end;

procedure TFCustomCanvas.EmptyClipRect;
begin
  IntersectClipRect(Rect(0, 0, 0, 0));
end;

function TFCustomCanvas.ExcludeClipRect(const ARect: TRect): Boolean;
var
  Rect: TRect;
begin
  Rect := Transform(ARect);
  if (Rect.Right > Rect.Left) and (Rect.Bottom > Rect.Top) then
    Result := DoExcludeClipRect(Rect)
  else
    Result := False;
end;

function TFCustomCanvas.IntersectClipRect(const ARect: TRect): Boolean;
var
  Rect: TRect;
begin
  Rect := Transform(ARect);
  if (Rect.Right > Rect.Left) and (Rect.Bottom > Rect.Top) then
    Result := DoIntersectClipRect(Rect)
  else
    Result := False;
end;

function TFCustomCanvas.UnionClipRect(const ARect: TRect): Boolean;
var
  Rect: TRect;
begin
  Rect := Transform(ARect);
  if (Rect.Right > Rect.Left) and (Rect.Bottom > Rect.Top) then
    Result := DoUnionClipRect(Rect)
  else
    with GetClipRect do
      Result := (Right > Left) and (Bottom > Top);
end;

function TFCustomCanvas.GetClipRect: TRect;
begin
  Result := ReverseTransform(DoGetClipRect);
end;

function TFCustomCanvas.GetColor: TGfxColor;
begin
  result := FColor;
end;

procedure TFCustomCanvas.SetColor(AColor: TGfxColor);
begin
  FColor := AColor;
  DoSetColor(MapColor(AColor));
end;

procedure TFCustomCanvas.DrawArc(const ARect: TRect; StartAngle, EndAngle: Single);
begin
  DoDrawArc(Transform(ARect), StartAngle, EndAngle);
end;

procedure TFCustomCanvas.DrawCircle(const ARect: TRect);
begin
  DoDrawCircle(Transform(ARect));
end;

procedure TFCustomCanvas.DrawLine(const AFrom, ATo: TPoint);
begin
  DoDrawLine(Transform(AFrom), Transform(ATo));
end;

procedure TFCustomCanvas.DrawLine(const X1, Y1, X2, Y2: Integer);
begin
  DrawLine(Point(X1, Y1), Point(X2, Y2));
end;

procedure TFCustomCanvas.DrawPolyLine(const Coords: array of TPoint);
var
  i: Integer;
begin
  for i := Low(Coords) to High(Coords) do
    DrawLine(Coords[i], Coords[i + 1]);
end;

procedure TFCustomCanvas.DoDrawRect(const ARect: TRect);
begin
{  DrawPolyLine(
    [ARect.TopLeft,
     Point(ARect.Right - 1, ARect.Top),
     Point(ARect.Right - 1, ARect.Bottom - 1),
     Point(ARect.Left, ARect.Bottom - 1),
     ARect.TopLeft]);}
  DoDrawLine(ARect.TopLeft, Point(ARect.Right - 1, ARect.Top));
  DoDrawLine(Point(ARect.Right - 1, ARect.Top), Point(ARect.Right - 1, ARect.Bottom - 1));
  DoDrawLine(Point(ARect.Right - 1, ARect.Bottom - 1), Point(ARect.Left, ARect.Bottom - 1));
  DoDrawLine(Point(ARect.Left, ARect.Bottom - 1), ARect.TopLeft);
end;

procedure TFCustomCanvas.DrawRect(const ARect: TRect);
var
  r: TRect;
begin
  r := Transform(ARect);
  if (r.Right > r.Left) and (r.Bottom > r.Top) then
    DoDrawRect(r);
end;

procedure TFCustomCanvas.DrawPoint(const APoint: TPoint);
begin
  DoDrawPoint(Transform(APoint));
end;

procedure TFCustomCanvas.FillRect(const ARect: TRect);
var
  r: TRect;
begin
  r := Transform(ARect);
  if (r.Right > r.Left) and (r.Bottom > r.Top) then
    DoFillRect(r);
end;

procedure TFCustomCanvas.FillTriangle(const P1, P2, P3: TPoint);
begin
  DoFillTriangle(P1, P2, P3);
end;

function TFCustomCanvas.TextExtent(const AText: String): TSize;
begin
  Result.cx := TextWidth(AText);
  Result.cy := FontCellHeight;
end;

function TFCustomCanvas.TextWidth(const AText: String): Integer;
begin
  Result := TextExtent(AText).cx;
end;

procedure TFCustomCanvas.TextOut(const APosition: TPoint; const AText: String);
begin
  DoTextOut(Transform(APosition), AText);
end;

procedure TFCustomCanvas.Copy(ASource: TFCustomCanvas; const ADestPos: TPoint);
begin
  ASSERT(Assigned(ASource));
  CopyRect(ASource, Rect(0, 0, ASource.Width, ASource.Height), ADestPos);
end;

procedure TFCustomCanvas.CopyRect(ASource: TFCustomCanvas; const ASourceRect: TRect;
  const ADestPos: TPoint);
var
  SourceRect: TRect;
begin
  SourceRect := ASource.Transform(ASourceRect);
  with SourceRect do
    if (Left >= Right) or (Top >= Bottom) then
      exit;

  DoCopyRect(ASource, SourceRect, Transform(ADestPos));
end;

procedure TFCustomCanvas.MaskedCopy(ASource, AMask: TFCustomCanvas;
  const ADestPos: TPoint);
begin
  MaskedCopyRect(ASource, AMask, Rect(0, 0, ASource.Width, ASource.Height),
    Point(0, 0), ADestPos);
end;

procedure TFCustomCanvas.MaskedCopyRect(ASource, AMask: TFCustomCanvas;
  const ASourceRect: TRect; const AMaskPos, ADestPos: TPoint);
begin
  DoMaskedCopyRect(ASource, AMask, ASource.Transform(ASourceRect),
    AMask.Transform(AMaskPos), Transform(ADestPos));
end;

procedure TFCustomCanvas.DrawImage(AImage: TFCustomBitmap; const ADestPos: TPoint);
begin
  DrawImageRect(AImage, Rect(0, 0, AImage.Width, AImage.Height), ADestPos);
end;

procedure TFCustomCanvas.DrawImageRect(AImage: TFCustomBitmap; ASourceRect: TRect;
  const ADestPos: TPoint);
var
  SourceRect: TRect;
begin
  SourceRect := ASourceRect;
{  if SourceRect.Right > Width then
    SourceRect.Right := Width;
  if SourceRect.Bottom > Height then
    SourceRect.Bottom := Height;}

  if (SourceRect.Right > SourceRect.Left) and
    (SourceRect.Bottom > SourceRect.Top) then
    DoDrawImageRect(AImage, SourceRect, Transform(ADestPos));
end;

{ TFCustomBitmap }

destructor TFCustomBitmap.Destroy;
begin
  if Assigned(Palette) then
    Palette.Release;
  inherited Destroy;
end;

procedure TFCustomBitmap.SetPixelsFromData(AData: Pointer; AStride: LongWord);
var
  DestData: Pointer;
  DestStride, BytesPerScanline: LongWord;
  y: Integer;
begin
  DestStride  := 0;   // to remove compiler warning
  DestData    := nil;
  if Height <= 0 then
    exit;

  Lock(DestData, DestStride);
  try
    if DestStride = AStride then
      Move(AData^, DestData^, AStride * Height)
    else
    begin
      if DestStride > AStride then
        BytesPerScanline := AStride
      else
        BytesPerScanline := DestStride;

      y := 0;
      while True do
      begin
        Move(AData^, DestData^, BytesPerScanline);
	      Inc(y);
      	if y = Height then
      	  break;
      	Inc(AData, AStride);
      	Inc(DestData, DestStride);
      end;
    end;
  finally
    Unlock;
  end;
end;

constructor TFCustomBitmap.Create(AWidth, AHeight: Integer;
  APixelFormat: TGfxPixelFormat);
begin
  FWidth := AWidth;
  FHeight := AHeight;
  FPixelFormat := APixelFormat;
end;

procedure TFCustomBitmap.SetPalette(APalette: TGfxPalette);
begin
  if APalette <> Palette then
  begin
    if Assigned(Palette) then
      Palette.Release;

    FPalette := APalette;

    if Assigned(Palette) then
      Palette.AddRef;
  end;
end;

{ TFCustomScreen }

constructor TFCustomScreen.Create;
begin
  inherited Create;
  
end;

{ TFCustomWindow }

function TFCustomWindow.CanClose: Boolean;
begin
  if Assigned(OnCanClose) then
    Result := OnCanClose(Self)
  else
    Result := True;
end;

function TFCustomWindow.GetTitle: String;
begin

end;

procedure TFCustomWindow.SetTitle(const ATitle: String);
begin

end;

procedure TFCustomWindow.ProcessEvent(AEvent: TFEvent);
begin
  case AEvent.EventType of
   etCreate:        EvCreate();
   etCanClose:      Exit;
   etClose:         Exit;
   etFocusIn:       EvFocusIn();
   etFocusOut:      EvFocusOut();
   etHide:          EvHide();
   etKeyPressed:    EvKeyPressed(AEvent.Key);
   etKeyReleased:   EvKeyReleased(AEvent.Key);
   etKeyChar:       EvKeyChar(AEvent.KeyChar);
   etMouseEnter:    EvMouseEnter(AEvent.MousePos);
   etMouseLeave:    EvMouseLeave();
   etMousePressed:  EvMousePressed(AEvent.MouseButton, AEvent.MousePos);
   etMouseReleased: EvMouseReleased(AEvent.MouseButton, AEvent.MousePos);
   etMouseMove:     EvMouseMove(AEvent.MousePos);
   etMouseWheel:    EvMouseWheel(AEvent.WheelDelta, AEvent.MousePos);
   etPaint:         EvPaint();
   etMove:          EvMove();
   etResize:        EvResize();
   etShow:          EvShow();
  end;
end;

constructor TFCustomWindow.Create(AParent: TFCustomWindow;
        AWindowOptions: TFWindowOptions);
begin
  inherited Create;

  FWindowOptions := AWindowOptions;
  FParent := AParent;

  FChildWindows := TList.Create;
  
  if AParent <> nil then AParent.ChildWindows.Add(Self);
end;

destructor TFCustomWindow.Destroy;
begin
  FChildWindows.Free;

  inherited Destroy;
end;

procedure TFCustomWindow.SetWidth(AWidth: Integer);
begin
  SetSize(Size(AWidth, Height));
end;

procedure TFCustomWindow.SetLeft(const AValue: Integer);
begin
  SetPosition(Point(AValue, FTop));
end;

procedure TFCustomWindow.SetClientHeight(const AValue: Integer);
begin
  SetClientSize(Size(Width, AValue));
end;

procedure TFCustomWindow.SetClientWidth(const AValue: Integer);
begin
  SetClientSize(Size(AValue, Height));
end;

procedure TFCustomWindow.SetTop(const AValue: Integer);
begin
  SetPosition(Point(FLeft, AValue));
end;

procedure TFCustomWindow.SetVisible(const AValue: Boolean);
begin
  if FVisible = AValue then exit;
  
  if AValue then Show
  else Hide;
end;

procedure TFCustomWindow.SetHeight(AHeight: Integer);
begin
  SetSize(Size(Width, AHeight));
end;

procedure TFCustomWindow.SetCursor(ACursor: TFCursor);
begin
  if ACursor <> Cursor then
  begin
    FCursor := ACursor;
    DoSetCursor;
  end;
end;

procedure TFCustomWindow.SetWindowOptions(const AValue: TFWindowOptions);
begin
  if FWindowOptions = AValue then exit;
  FWindowOptions := AValue;
  DoSetWindowOptions;
end;

{ Finds the top window througth recursion }
function TFCustomWindow.FindTopParentWindow: TFCustomWindow;
begin
  if Assigned(Parent) then Result := Parent.FindTopParentWindow
  else Result := Self;
end;

{ Global functions }

{ Sizes, points etc. }

function Size(AWidth, AHeight: Integer): TSize;
begin
  Result.cx := AWidth;
  Result.cy := AHeight;
end;

function Size(ARect: TRect): TSize;
begin
  Result.cx := ARect.Right - ARect.Left;
  Result.cy := ARect.Bottom - ARect.Top;
end;

function PtInRect(const ARect: TRect; const APoint: TPoint): Boolean;
begin
  with ARect, APoint do
    Result := (x >= Left) and (y >= Top) and (x < Right) and (y < Bottom);
end;

{ Only Free Pascal supports operator overloading at the moment }

{$ifdef fpc}

operator = (const ASize1, ASize2: TSize) b: Boolean;
begin
  b := (ASize1.cx = ASize2.cx) and (ASize1.cy = ASize2.cy);
end;

operator + (const APoint1, APoint2: TPoint) p: TPoint;
begin
  p.x := APoint1.x + APoint2.x;
  p.y := APoint1.y + APoint2.y;
end;

operator + (const APoint: TPoint; ASize: TSize) p: TPoint;
begin
  p.x := APoint.x + ASize.cx;
  p.y := APoint.y + ASize.cy;
end;

operator + (const ASize: TSize; APoint: TPoint) s: TSize;
begin
  s.cx := ASize.cx + APoint.x;
  s.cy := ASize.cy + APoint.y;
end;

operator + (const ASize1, ASize2: TSize) s: TSize;
begin
  s.cx := ASize1.cx + ASize2.cx;
  s.cy := ASize1.cy + ASize2.cy;
end;

operator + (const APoint: TPoint; i: Integer) p: TPoint;
begin
  p.x := APoint.x + i;
  p.y := APoint.y + i;
end;

operator + (const ASize: TSize; i: Integer) s: TSize;
begin
  s.cx := ASize.cx + i;
  s.cy := ASize.cy + i;
end;

operator - (const APoint1, APoint2: TPoint) p: TPoint;
begin
  p.x := APoint1.x - APoint2.x;
  p.y := APoint1.y - APoint2.y;
end;

operator - (const APoint: TPoint; i: Integer) p: TPoint;
begin
  p.x := APoint.x - i;
  p.y := APoint.y - i;
end;

operator - (const ASize: TSize; const APoint: TPoint) s: TSize;
begin
  s.cx := ASize.cx - APoint.x;
  s.cy := ASize.cy - APoint.y;
end;

operator - (const ASize: TSize; i: Integer) s: TSize;
begin
  s.cx := ASize.cx - i;
  s.cy := ASize.cy - i;
end;


{ Color functions }

operator = (const AColor1, AColor2: TGfxColor) b: Boolean;
begin
  b := (AColor1.Red = AColor2.Red) and (AColor1.Green = AColor2.Green) and
    (AColor1.Blue = AColor2.Blue) and (AColor1.Alpha = AColor2.Alpha);
end;
{$endif}

function GetAvgColor(const AColor1, AColor2: TGfxColor): TGfxColor;
begin
  Result.Red := AColor1.Red + (AColor2.Red - AColor1.Red) div 2;
  Result.Green := AColor1.Green + (AColor2.Green - AColor1.Green) div 2;
  Result.Blue := AColor1.Blue + (AColor2.Blue - AColor1.Blue) div 2;
  Result.Alpha := AColor1.Alpha + (AColor2.Alpha - AColor1.Alpha) div 2;
end;

function GetGfxColor(const ARed, AGreen, ABlue, AAlpha: Byte): TGfxColor;
begin
  Result.Alpha := AAlpha;
  Result.Red := ARed;
  Result.Green := AGreen;
  Result.Blue := ABlue;
end;

function GfxColorToTColor(const AColor: TGfxColor): TColor;
begin
  Result := AColor.Red or (AColor.Green shl 8) or (AColor.Blue shl 16);
end;


{ Keyboard functions }

function KeycodeToText(Key: Word; ShiftState: TShiftState): String;

  function GetASCIIText: String;
  var
    c: Char;
  begin
    result := '';
    c := Chr(Key and $ff);
    case c of
      #13:  Result := Result + 'Enter';
      #127: Result := Result + 'Del';
      '+':  Result := Result + 'Plus'
      else
        Result := Result + c;
    end;
  end;

var
  s: String;
begin
  SetLength(Result, 0);

  if ssShift in ShiftState then
    Result := 'Shift+';
  if ssCtrl in ShiftState then
    Result := 'Ctrl+';
  if ssAlt in ShiftState then
    Result := 'Alt+';

  if (Key > Ord(' ')) and (Key < 255) then
  begin
    Result := Result + GetASCIIText;
    exit;
  end;

  case Key of
    keyNul:           s := 'Null';
    keyBackSpace:     s := 'Backspace';
    keyTab:           s := 'Tab';
    keyLinefeed:      s := 'Linefeed';
    keyReturn:        s := 'Enter';
    keyEscape:        s := 'Esc';
    Ord(' '):         s := 'Space';
    keyDelete:        s := 'Del';
    keyVoid:          s := 'Void';
    keyBreak:         s := 'Break';
    keyScrollForw:    s := 'ScrollForw';
    keyScrollBack:    s := 'ScrollBack';
    keyBoot:          s := 'Boot';
    keyCompose:       s := 'Compose';
    keySAK:           s := 'SAK';
    keyUndo:          s := 'Undo';
    keyRedo:          s := 'Redo';
    keyMenu:          s := 'Menu';
    keyCancel:        s := 'Cancel';
    keyPrintScreen:   s := 'PrtScr';
    keyExecute:       s := 'Exec';
    keyFind:          s := 'Find';
    keyBegin:         s := 'Begin';
    keyClear:         s := 'Clear';
    keyInsert:        s := 'Ins';
    keySelect:        s := 'Select';
    keyMacro:         s := 'Macro';
    keyHelp:          s := 'Help';
    keyDo:            s := 'Do';
    keyPause:         s := 'Pause';
    keySysRq:         s := 'SysRq';
    keyModeSwitch:    s := 'ModeSw';
    keyUp:            s := 'Up';
    keyDown:          s := 'Down';
    keyLeft:          s := 'Left';
    keyRight:         s := 'Right';
    keyPrior:         s := 'PgUp';
    keyNext:          s := 'PgDown';
    keyHome:          s := 'Home';
    keyEnd:           s := 'End';
    keyF0..keyF64:    s := 'F' + IntToStr(Key - keyF0);
    keyP0..keyP9:     s := 'KP' + Chr(Key - keyP0 + Ord('0'));
    keyPA..keyPF:     s := 'KP' + Chr(Key - keyPA + Ord('A'));
    keyPPlus, keyPMinus, keyPSlash, keyPStar, keyPEqual, keyPSeparator,
      keyPDecimal, keyPParenLeft, keyPParenRight, keyPSpace, keyPEnter,
      keyPTab:        s := 'KP' + GetASCIIText;
    keyPPlusMinus:    s := 'KPPlusMinus';
    keyPBegin:        s := 'KPBegin';
    keyPF1..keyPF9:   s := 'KPF' + IntToStr(Key - keyPF1);
    keyShiftL:        s := 'ShiftL';
    keyShiftR:        s := 'ShiftR';
    keyCtrlL:         s := 'CtrlL';
    keyCtrlR:         s := 'CtrlR';
    keyAltL:          s := 'AltL';
    keyAltR:          s := 'AltR';
    keyMetaL:         s := 'MetaL';
    keyMetaR:         s := 'MetaR';
    keySuperL:        s := 'SuperL';
    keySuperR:        s := 'SuperR';
    keyHyperL:        s := 'HyperL';
    keyHyperR:        s := 'HyperR';
    keyAltGr:         s := 'AltGr';
    keyCaps:          s := 'Caps';
    keyNum:           s := 'Num';
    keyScroll:        s := 'Scroll';
    keyShiftLock:     s := 'ShiftLock';
    keyCtrlLock:      s := 'CtrlLock';
    keyAltLock:       s := 'AltLock';
    keyMetaLock:      s := 'MetaLock';
    keySuperLock:     s := 'SuperLock';
    keyHyperLock:     s := 'HyperLock';
    keyAltGrLock:     s := 'AltGrLock';
    keyCapsLock:      s := 'CapsLock';
    keyNumLock:       s := 'NumLock';
    keyScrollLock:    s := 'ScrollLock';
    keyDeadRing:      s := 'DeadRing';
    keyDeadCaron:     s := 'DeadCaron';
    keyDeadOgonek:    s := 'DeadOgonek';
    keyDeadIota:      s := 'DeadIota';
    keyDeadDoubleAcute:     s := 'DeadDoubleAcute';
    keyDeadBreve:           s := 'DeadBreve';
    keyDeadAboveDot:        s := 'DeadAboveDot';
    keyDeadBelowDot:        s := 'DeadBelowDot';
    keyDeadVoicedSound:     s := 'DeadVoicedSound';
    keyDeadSemiVoicedSound: s := 'DeadSemiVoicedSound';
    keyDeadAcute:           s := 'DeadAcute';
    keyDeadCedilla:         s := 'DeadCedilla';
    keyDeadCircumflex:      s := 'DeadCircumflex';
    keyDeadDiaeresis:       s := 'DeadDiaeresis';
    keyDeadGrave:           s := 'DeadGrave';
    keyDeadTilde:           s := 'DeadTilde';
    keyDeadMacron:          s := 'DeadMacron';

    keyEcuSign:       s := 'Ecu';
    keyColonSign:     s := 'Colon';
    keyCruzeiroSign:  s := 'Cruzeiro';
    keyFFrancSign:    s := 'FFranc';
    keyLiraSign:      s := 'Lira';
    keyMillSign:      s := 'Mill';
    keyNairaSign:     s := 'Naira';
    keyPesetaSign:    s := 'Peseta';
    keyRupeeSign:     s := 'Rupee';
    keyWonSign:       s := 'Won';
    keyNewSheqelSign: s := 'NewShequel';
    keyDongSign:      s := 'Dong';
    keyEuroSign:      s := 'Euro';
  else
    s := '#' + IntToHex(Key, 4);
  end;
  Result := Result + s;
end;

{ TFCustomApplication }

procedure TFCustomApplication.SetTitle(const ATitle: String);
begin
  if ATitle <> FTitle then FTitle := ATitle;
end;

constructor TFCustomApplication.Create;
begin
  inherited Create(nil);
  
  if gCommandLineParams.IsParam('display') then
    FDisplayName := gCommandLineParams.GetParam('display')
  else
    FDisplayName := '';
    
  Forms := TList.Create;
  
  FQuitWhenLastWindowCloses := True;
end;

destructor TFCustomApplication.Destroy;
begin
  Forms.Free;
  inherited Destroy;
end;

procedure TFCustomApplication.AddWindow(AWindow: TFCustomWindow);
begin
{$IFDEF VerboseFPGUI}
  WriteLn('[TFCustomApplication.AddWindow] Window Title: ', AWindow.Title);
{$ENDIF}

  if Forms.IndexOf(AWindow) = -1 then
    Forms.Add(AWindow);
end;

procedure TFCustomApplication.RemoveWindow(AWindow: TFCustomWindow);
begin
{$IFDEF VerboseFPGUI}
  WriteLn('[TFCustomApplication.RemoveWindow] Window Title: ', AWindow.Title);
{$ENDIF}

  if (Assigned(Forms) and Assigned(AWindow)) then Forms.Remove(AWindow);
end;

procedure TFCustomApplication.Run;
begin
  DoBreakRun := False;

  if gCommandLineParams.IsParam('?') or gCommandLineParams.IsParam('help') then
  begin
    writeln(' ');
    writeln(' The following parameters are supported by fpGUI applications.');
    writeln(' ');
    writeln(' -?               Shows this help');
    writeln(' -display         fpGUI/X11 only: sets the display to use');
    writeln(' -style           Overrides the default (auto detected) GUI style');
    writeln(' ');
    DoBreakRun := True;
  end;
end;

{procedure TFCustomApplication.CreateForm(AForm: TFCustomForm);
var
  form: PForm;
  Filename: String;
  TextStream, BinStream: TStream;
begin
  form := @Reference;
  form^ := TFCustomForm(InstanceClass.Create(Self));

  Filename := LowerCase(Copy(InstanceClass.ClassName, 2, 255)) + '.frm';

  TextStream := TFileStream.Create(Filename, fmOpenRead);
  BinStream := TMemoryStream.Create;
  ObjectTextToBinary(TextStream, BinStream);
  TextStream.Free;

  BinStream.Position := 0;
  BinStream.ReadComponent(Form^);
  BinStream.Free;

  Form^.Show;
end;}

end.