diff options
Diffstat (limited to 'gfx/gfxbase.pas')
| -rw-r--r-- | gfx/gfxbase.pas | 1283 |
1 files changed, 1283 insertions, 0 deletions
diff --git a/gfx/gfxbase.pas b/gfx/gfxbase.pas new file mode 100644 index 00000000..dd1f305e --- /dev/null +++ b/gfx/gfxbase.pas @@ -0,0 +1,1283 @@ +{ + fpGUI - Free Pascal GUI Library + + GFXBase - Abstract declarations to be implemented on each platform + + Copyright (C) 2000 - 2006 See the file AUTHORS, 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 + + PGfxColor = ^TGfxColor; + TGfxColor = packed record + Red, Green, Blue, Alpha: Word; + end; + + PGfxPixel = ^TGfxPixel; + TGfxPixel = LongWord; + + + TGfxFormatType = ( + 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 + case FormatType: TGfxFormatType of + ftRGB16, ftRGBA16, ftRGB24, ftRGB32, ftRGBA32: ( + RedMask: TGfxPixel; + GreenMask: TGfxPixel; + BlueMask: TGfxPixel; + AlphaMask: TGfxPixel); // only used for RGBA types + end; + + +const + + FormatTypeBPPTable: array[TGfxFormatType] of Integer = + (0, 1, 4, 4, 8, 8, 16, 16, 24, 32, 32); + + { Predefined colors } + + colTransparent: TGfxColor = (Red: $0000; Green: $0000; Blue: $0000; Alpha: $ffff); + colBlack: TGfxColor = (Red: $0000; Green: $0000; Blue: $0000; Alpha: $0000); + colBlue: TGfxColor = (Red: $0000; Green: $0000; Blue: $ffff; Alpha: $0000); + colGreen: TGfxColor = (Red: $0000; Green: $ffff; Blue: $0000; Alpha: $0000); + colCyan: TGfxColor = (Red: $0000; Green: $ffff; Blue: $ffff; Alpha: $0000); + colRed: TGfxColor = (Red: $ffff; Green: $0000; Blue: $0000; Alpha: $0000); + colMagenta: TGfxColor = (Red: $ffff; Green: $0000; Blue: $ffff; Alpha: $0000); + colYellow: TGfxColor = (Red: $ffff; Green: $ffff; Blue: $0000; Alpha: $0000); + colWhite: TGfxColor = (Red: $ffff; Green: $ffff; Blue: $ffff; Alpha: $0000); + colGray: TGfxColor = (Red: $8000; Green: $8000; Blue: $8000; Alpha: $0000); + colLtGray: TGfxColor = (Red: $c000; Green: $c000; Blue: $c000; Alpha: $0000); + colDkBlue: TGfxColor = (Red: $0000; Green: $0000; Blue: $8000; Alpha: $0000); + colDkGreen: TGfxColor = (Red: $0000; Green: $8000; Blue: $0000; Alpha: $0000); + colDkCyan: TGfxColor = (Red: $0000; Green: $8000; Blue: $8000; Alpha: $0000); + colDkRed: TGfxColor = (Red: $8000; Green: $0000; Blue: $0000; Alpha: $0000); + colDkMagenta: TGfxColor = (Red: $8000; Green: $0000; Blue: $8000; Alpha: $0000); + colDkYellow: TGfxColor = (Red: $8000; Green: $8000; Blue: $0000; Alpha: $0000); + + webBlack: TGfxColor = (Red: $0000; Green: $0000; Blue: $0000; Alpha: $0000); + webMaroon: TGfxColor = (Red: $8000; Green: $0000; Blue: $0000; Alpha: $0000); + webGreen: TGfxColor = (Red: $0000; Green: $8000; Blue: $0000; Alpha: $0000); + webOlive: TGfxColor = (Red: $8000; Green: $8000; Blue: $0000; Alpha: $0000); + webNavy: TGfxColor = (Red: $0000; Green: $0000; Blue: $8000; Alpha: $0000); + webPurple: TGfxColor = (Red: $8000; Green: $0000; Blue: $8000; Alpha: $0000); + webTeal: TGfxColor = (Red: $0000; Green: $8000; Blue: $8000; Alpha: $0000); + webGray: TGfxColor = (Red: $8000; Green: $8000; Blue: $8000; Alpha: $0000); + webSilver: TGfxColor = (Red: $c000; Green: $c000; Blue: $c000; Alpha: $0000); + webRed: TGfxColor = (Red: $ffff; Green: $0000; Blue: $0000; Alpha: $0000); + webLime: TGfxColor = (Red: $0000; Green: $ffff; Blue: $0000; Alpha: $0000); + webYellow: TGfxColor = (Red: $ffff; Green: $ffff; Blue: $0000; Alpha: $0000); + webBlue: TGfxColor = (Red: $0000; Green: $0000; Blue: $ffff; Alpha: $0000); + webFuchsia: TGfxColor = (Red: $ffff; Green: $0000; Blue: $ffff; Alpha: $0000); + webAqua: TGfxColor = (Red: $0000; Green: $ffff; Blue: $ffff; Alpha: $0000); + webWhite: TGfxColor = (Red: $ffff; Green: $ffff; Blue: $ffff; Alpha: $0000); + + + // 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); + + PixelFormatRGB24: TGfxPixelFormat = ( + FormatType: ftRGB24; + RedMask: $0000ff; + GreenMask: $00ff00; + BlueMask: $ff0000; + AlphaMask: 0); + + PixelFormatBGR24: TGfxPixelFormat = ( + FormatType: ftRGB24; + RedMask: $ff0000; + GreenMask: $00ff00; + BlueMask: $0000ff; + AlphaMask: 0); + + PixelFormatRGB32: TGfxPixelFormat = ( + FormatType: ftRGB32; + RedMask: $0000ff; + GreenMask: $00ff00; + BlueMask: $ff0000; + AlphaMask: 0); + + PixelFormatRGBA32: TGfxPixelFormat = ( + FormatType: ftRGB32; + RedMask: $000000ff; + GreenMask: $0000ff00; + BlueMask: $00ff0000; + AlphaMask: $ff000000); + + PixelFormatARGB32: TGfxPixelFormat = ( + FormatType: ftRGB32; + RedMask: $0000ff00; + GreenMask: $00ff0000; + BlueMask: $ff000000; + AlphaMask: $000000ff); + + PixelFormatBGR32: TGfxPixelFormat = ( + FormatType: ftRGB32; + RedMask: $ff0000; + GreenMask: $00ff00; + BlueMask: $0000ff; + AlphaMask: 0); + + PixelFormatBGRA32: TGfxPixelFormat = ( + FormatType: ftRGB32; + RedMask: $00ff0000; + GreenMask: $0000ff00; + BlueMask: $000000ff; + AlphaMask: $ff000000); + + PixelFormatABGR32: TGfxPixelFormat = ( + FormatType: ftRGB32; + RedMask: $ff000000; + GreenMask: $00ff0000; + BlueMask: $0000ff00; + AlphaMask: $000000ff); + +type + + EGfxError = class(Exception); + + EGfxUnsupportedPixelFormat = class(EGfxError) + constructor Create(const APixelFormat: TGfxPixelFormat); + end; + + + TFCustomImage = class; + TFCustomApplication = class; + TFCustomWindow = class; + + TGfxWindowOption = ( + woWindow, woBorderless, woPopup, woToolWindow, woChildWindow, + woX11SkipWMHints); + TGfxWindowOptions = set of TGfxWindowOption; + + TGfxCursor = (crDefault, crNone, crArrow, crCross, crIBeam, crSize, crSizeNS, + crSizeWE, cpUpArrow, crHourGlass, crNoDrop, crHelp); + + + { 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; + FPixelFormat: TGfxPixelFormat; + 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 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: TFCustomImage; ASourceRect: TRect; const ADestPos: TPoint); virtual; abstract; + public + constructor Create; + // 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 SetColor_(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; + + // Drawing functions + procedure DrawArc(const ARect: TRect; StartAngle, EndAngle: Single); + procedure DrawCircle(const ARect: TRect); + procedure DrawLine(const AFrom, ATo: TPoint); + procedure DrawPolyLine(const Coords: array of TPoint); virtual; + procedure DrawRect(const ARect: TRect); + procedure DrawPoint(const APoint: TPoint); + procedure FillRect(const ARect: TRect); + + // 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); + + // 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: TFCustomImage; const ADestPos: TPoint); + procedure DrawImageRect(AImage: TFCustomImage; 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; + end; + + + TFCustomImage = class(TObject) + private + FWidth, FHeight: Integer; + FPixelFormat: TGfxPixelFormat; + FPalette: TGfxPalette; + procedure SetPalette(APalette: TGfxPalette); + protected + public + constructor Create(AWidth, AHeight: Integer; APixelFormat: TGfxPixelFormat); virtual; + destructor Destroy; override; + procedure Lock(var AData: Pointer; var AStride: LongWord); virtual; abstract; + procedure Unlock; virtual; + 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; + end; + + { TFCustomScreen } + + TFCustomScreen = class(TObject) + public + constructor Create; virtual; + end; + + { TFCustomApplication } + + TFCustomApplication = class(TComponent) + private + FOnIdle: TNotifyEvent; + FQuitWhenLastWindowCloses: Boolean; + public + Forms: TList; + public + { Default methods } + constructor Create; virtual; + destructor Destroy; override; + procedure AddWindow(AWindow: TFCustomWindow); virtual; abstract; + procedure Initialize(ADisplayName: String = ''); virtual; abstract; + procedure Run; virtual; abstract; + procedure Quit; virtual; abstract; + { Properties } + property OnIdle: TNotifyEvent read FOnIdle write FOnIdle; + property QuitWhenLastWindowCloses: Boolean read FQuitWhenLastWindowCloses write FQuitWhenLastWindowCloses; + 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 + TMouseButton = (mbLeft, mbRight, mbMiddle); + 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 + private + FCursor: TGfxCursor; + 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: TGfxPaintEvent; + FOnMove: TNotifyEvent; + FOnResize: TNotifyEvent; + FOnShow: TNotifyEvent; + procedure SetWidth(AWidth: Integer); + procedure SetHeight(AHeight: Integer); + procedure SetCursor(ACursor: TGfxCursor); + procedure SetWindowOptions(const AValue: TGfxWindowOptions); virtual; + protected + FHandle: Cardinal; + FCanvas: TFCustomCanvas; + FLeft: Integer; + FTop: Integer; + FWidth: Integer; + FHeight: Integer; + FClientWidth: Integer; + FClientHeight: Integer; + FWindowOptions: TGfxWindowOptions; + function GetTitle: String; virtual; + procedure SetTitle(const ATitle: String); virtual; + procedure DoSetCursor; virtual; abstract; + public + function CanClose: Boolean; virtual; + procedure SetPosition(const APosition: TPoint); virtual; + procedure SetSize(const ASize: TSize); virtual; + procedure SetMinMaxSize(const AMinSize, AMaxSize: TSize); virtual; + procedure SetFixedSize(const ASize: TSize); + procedure SetClientSize(const ASize: TSize); virtual; + procedure SetMinMaxClientSize(const AMinSize, AMaxSize: TSize); virtual; + procedure SetFixedClientSize(const ASize: TSize); + procedure Show; virtual; abstract; + procedure Invalidate(const ARect: TRect); virtual; abstract; + procedure PaintInvalidRegion; virtual; abstract; + procedure CaptureMouse; virtual; abstract; + procedure ReleaseMouse; virtual; abstract; + + property WindowOptions: TGfxWindowOptions read FWindowOptions write SetWindowOptions; + property Canvas: TFCustomCanvas read FCanvas; + property Handle: Cardinal read FHandle; + // Window state + property Left: Integer read FLeft; + property Top: Integer read FTop; + property Width: Integer read FWidth write SetWidth; + property Height: Integer read FHeight write SetHeight; + property ClientWidth: Integer read FClientWidth; + property ClientHeight: Integer read FClientHeight; + property Cursor: TGfxCursor read FCursor write SetCursor; + property Title: String read GetTitle write SetTitle; + // 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: TGfxPaintEvent 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; + +// Keyboard +function KeycodeToText(Key: Word; ShiftState: TShiftState): String; + + +implementation + +uses + GFXInterface; { Just to get FPC to compile the TGfxCanvas descendants } + + +{ 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; +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; + +procedure TFCustomCanvas.SetColor(AColor: TGfxColor); +begin + SetColor_(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.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; + +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: TFCustomImage; const ADestPos: TPoint); +begin + DrawImageRect(AImage, Rect(0, 0, AImage.Width, AImage.Height), ADestPos); +end; + +procedure TFCustomCanvas.DrawImageRect(AImage: TFCustomImage; 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, ASourceRect, Transform(ADestPos)); +end; + +{ TFCustomImage } + +destructor TFCustomImage.Destroy; +begin + if Assigned(Palette) then + Palette.Release; + inherited Destroy; +end; + +procedure TFCustomImage.Unlock; +begin + // Default implementation: Do nothing... +end; + +procedure TFCustomImage.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 TFCustomImage.Create(AWidth, AHeight: Integer; + APixelFormat: TGfxPixelFormat); +begin + FWidth := AWidth; + FHeight := AHeight; + FPixelFormat := APixelFormat; +end; + +procedure TFCustomImage.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; + +procedure TFCustomWindow.SetPosition(const APosition: TPoint); +begin + // Empty +end; + +procedure TFCustomWindow.SetSize(const ASize: TSize); +begin + // Empty +end; + +procedure TFCustomWindow.SetMinMaxSize(const AMinSize, AMaxSize: TSize); +begin + // Empty +end; + +procedure TFCustomWindow.SetFixedSize(const ASize: TSize); +begin + SetMinMaxSize(ASize, ASize); + SetSize(ASize); +end; + +procedure TFCustomWindow.SetClientSize(const ASize: TSize); +begin + // Empty +end; + +procedure TFCustomWindow.SetMinMaxClientSize(const AMinSize, AMaxSize: TSize); +begin + // Empty +end; + +procedure TFCustomWindow.SetFixedClientSize(const ASize: TSize); +begin + SetMinMaxClientSize(ASize, ASize); + SetClientSize(ASize); +end; + +function TFCustomWindow.GetTitle: String; +begin + SetLength(Result, 0); +end; + +procedure TFCustomWindow.SetTitle(const ATitle: String); +begin + // Empty +end; + +procedure TFCustomWindow.SetWidth(AWidth: Integer); +begin + SetSize(Size(AWidth, Height)); +end; + +procedure TFCustomWindow.SetHeight(AHeight: Integer); +begin + SetSize(Size(Width, AHeight)); +end; + +procedure TFCustomWindow.SetCursor(ACursor: TGfxCursor); +begin + if ACursor <> Cursor then + begin + FCursor := ACursor; + DoSetCursor; + end; +end; + +procedure TFCustomWindow.SetWindowOptions(const AValue: TGfxWindowOptions); +begin + if FWindowOptions=AValue then exit; + FWindowOptions:=AValue; +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; + +{$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; + +// 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 } + +constructor TFCustomApplication.Create; +begin + inherited Create(nil); + + Forms := TList.Create; + + FQuitWhenLastWindowCloses := True; +end; + +destructor TFCustomApplication.Destroy; +begin + Forms.Free; + + inherited Destroy; +end; + +end. + |