src/flexui/fui_gfx.pas

   1 (* coded by Ketmar // Invisible Vector <ketmar@ketmar.no-ip.org>
   2  * Understanding is not required. Only obedience.
   3  *
   4  * This program is free software: you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation, version 3 of the License ONLY.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program. If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$INCLUDE ../shared/a_modes.inc}
  17 {$DEFINE FUI_TEXT_ICONS}
  18 unit fui_gfx;
  19
  20 interface
  21
  22   uses fui_common;
  23
  24   type
  25     TGxContext = class abstract
  26       public
  27         type
  28           TMarkIcon = (Checkbox, Radiobox);
  29           TWinIcon = (Close);
  30
  31       public
  32         procedure line (x1, y1, x2, y2: Integer); virtual; abstract;
  33         procedure hline (x, y, len: Integer); virtual; abstract;
  34         procedure vline (x, y, len: Integer); virtual; abstract;
  35         procedure rect (x, y, w, h: Integer); virtual; abstract;
  36         procedure fillRect (x, y, w, h: Integer); virtual; abstract;
  37         procedure darkenRect (x, y, w, h: Integer; a: Integer);  virtual; abstract;
  38
  39         function charWidth (const ch: AnsiChar): Integer; virtual; abstract;
  40         function charHeight (const ch: AnsiChar): Integer; virtual; abstract;
  41         function textWidth (const s: AnsiString): Integer; virtual; abstract;
  42         function textHeight (const s: AnsiString): Integer; virtual; abstract;
  43         function drawChar (x, y: Integer; const ch: AnsiChar): Integer; virtual; abstract; // returns char width
  44         function drawText (x, y: Integer; const s: AnsiString): Integer; virtual; abstract; // returns text width
  45
  46         function iconMarkWidth (ic: TMarkIcon): Integer; virtual; abstract;
  47         function iconMarkHeight (ic: TMarkIcon): Integer; virtual; abstract;
  48         procedure drawIconMark (ic: TMarkIcon; x, y: Integer; marked: Boolean); virtual; abstract;
  49
  50         function iconWinWidth (ic: TWinIcon): Integer; virtual; abstract;
  51         function iconWinHeight (ic: TWinIcon): Integer; virtual; abstract;
  52         procedure drawIconWin (ic: TWinIcon; x, y: Integer; pressed: Boolean); virtual; abstract;
  53
  54         procedure resetClip (); virtual; abstract;
  55
  56 //        function setOffset (constref aofs: TGxOfs): TGxOfs; virtual; abstract; // returns previous offset
  57 //        function setClip (constref aclip: TGxRect): TGxRect; virtual; abstract; // returns previous clip
  58
  59         function combineClip (constref aclip: TGxRect): TGxRect; virtual; abstract; // returns previous clip
  60
  61         // vertical scrollbar
  62         procedure drawVSBar (x, y, wdt, hgt: Integer; cur, min, max: Integer; constref clrfull, clrempty: TGxRGBA); virtual; abstract;
  63         // horizontal scrollbar
  64         procedure drawHSBar (x, y, wdt, hgt: Integer; cur, min, max: Integer; constref clrfull, clrempty: TGxRGBA); virtual; abstract;
  65
  66         class function sbarFilled (wh: Integer; cur, min, max: Integer): Integer;
  67         class function sbarPos (cxy: Integer; xy, wh: Integer; min, max: Integer): Integer;
  68
  69       protected
  70         function  getColor (): TGxRGBA; virtual; abstract;
  71         procedure setColor (const clr: TGxRGBA); virtual; abstract;
  72
  73         function getFont (): AnsiString; virtual; abstract;
  74         procedure setFont (const aname: AnsiString); virtual; abstract;
  75
  76         function  getClipRect (): TGxRect; virtual; abstract;
  77         procedure setClipRect (const aclip: TGxRect); virtual; abstract;
  78
  79         procedure onActivate (); virtual; abstract;
  80         procedure onDeactivate (); virtual; abstract;
  81
  82       private
  83         mActive: Boolean;
  84
  85       public
  86         property active: Boolean read mActive;
  87         property color: TGxRGBA read getColor write setColor;
  88         property font: AnsiString read getFont write setFont;
  89         property clip: TGxRect read getClipRect write setClipRect; // clipping is unaffected by offset
  90     end;
  91
  92   // set active context; `ctx` can be `nil`
  93   function gxCreateContext (): TGxContext;
  94   procedure gxSetContext (ctx: TGxContext; ascale: Single=1.0);
  95   procedure gxGfxLoadFont (const fontname: AnsiString; const fontFile: AnsiString; proportional: Boolean=false);
  96
  97   var (* installed by implementation *)
  98     gxPreSetContextCallback: procedure = nil;
  99     gxCreateContextCallback: function (): TGxContext = nil;
 100     gxFuiGfxLoadFontCallback: procedure (const fontname: AnsiString; const fontFile: AnsiString; proportional: Boolean) = nil;
 101
 102 implementation
 103
 104   uses SysUtils;
 105
 106   var
 107     curCtx: TGxContext = nil;
 108
 109   function gxCreateContext (): TGxContext;
 110   begin
 111     result := nil;
 112     if Assigned(gxCreateContextCallback) then
 113       result := gxCreateContextCallback();
 114   end;
 115
 116   procedure gxSetContext (ctx: TGxContext; ascale: Single=1.0);
 117   begin
 118     if Assigned(gxPreSetContextCallback) then
 119       gxPreSetContextCallback;
 120     if curCtx <> nil then
 121     begin
 122       curCtx.onDeactivate();
 123       curCtx.mActive := false;
 124     end;
 125     curCtx := ctx;
 126     if ctx <> nil then
 127     begin
 128       ctx.mActive := true;
 129       ctx.onActivate();
 130     end;
 131   end;
 132
 133   procedure gxGfxLoadFont (const fontname: AnsiString; const fontFile: AnsiString; proportional: Boolean=false);
 134   begin
 135     if Assigned(gxFuiGfxLoadFontCallback) then
 136       gxFuiGfxLoadFontCallback(fontname, fontFile, proportional)
 137     else
 138       raise Exception.Create('FlexUI: hook not installed: font named '''+fontname+''' can not be loaded')
 139   end;
 140
 141   class function TGxContext.sbarFilled (wh: Integer; cur, min, max: Integer): Integer;
 142   begin
 143          if (wh < 1) then result := 0
 144     else if (min > max) then result := 0
 145     else if (min = max) then result := wh
 146     else
 147     begin
 148       if (cur < min) then cur := min else if (cur > max) then cur := max;
 149       result := wh*(cur-min) div (max-min);
 150     end;
 151   end;
 152
 153   class function TGxContext.sbarPos (cxy: Integer; xy, wh: Integer; min, max: Integer): Integer;
 154   begin
 155     if (wh < 1) then begin result := 0; exit; end;
 156     if (min > max) then begin result := 0; exit; end;
 157     if (min = max) then begin result := max; exit; end;
 158     if (cxy < xy) then begin result := min; exit; end;
 159     if (cxy >= xy+wh) then begin result := max; exit; end;
 160     result := min+((max-min)*(cxy-xy) div wh);
 161     assert((result >= min) and (result <= max));
 162   end;
 163
 164 end.