freepascal.compiler/rtl/dos/ppi/colors.ppi

{
    $Id$
    This file is part of the Free Pascal run time library.
    Copyright (c) 1993,97 by the Free Pascal development team.

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    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.

 **********************************************************************}
{ COLORS.PPI }

{ GetBkColor , SetBkColor , GetColor , SetColor , GetMaxColor }

function Convert(Color:longint):longint;
var c,r,g,b:longint;
begin
  if BytesPerPixel = 1 then
    begin
       if (Color and $FF000000)=0 then
       begin
         C:=Color and $FF;
         Convert:=(C shl 24) + (C shl 16) + (C shl 8) + C;
       end else
       begin
         SetRGBPalette(((Color and $FF000000) shr 24),
                       ((Color and $00FF0000) shr 16),
                       ((Color and $0000FF00) shr 8),
                        (Color and $000000FF));
         C:=(Color and $FF000000);
         Convert:=(C shr 24) + (C shr 16) + (C shr 8) + C;
       end;
    end else
    begin
       R:=(Color and $00FF0000) shr (24-VESAInfo.rm_size);
       G:=(Color and $0000FF00) shr (16-VESAInfo.gm_size);
       B:=(Color and $000000FF) shr (8-VESAInfo.bm_size);
       C:=(R shl VESAInfo.rf_pos) or (G shl VESAInfo.gf_pos) or
          (B shl VESAInfo.bf_pos);
       Convert:=(C shl 16) or C;
    end;
end;

function GetColor : longint;
begin
  _graphresult:=grOk;
  if not isgraphmode then
    begin
      _graphresult:=grNoInitGraph;
      exit;
    end;
  getcolor:=aktcolor;
end;

{ ----------------------------------------------------------------------- }

procedure SetColor(color : Longint);
begin
  _graphresult:=grOk;
  if not isgraphmode then
    begin
    _graphresult:=grNoInitGraph;
  exit;
  end;
  aktcolor:=convert(Color);
end;

{ ----------------------------------------------------------------------- }

function GetBkColor : longint;
begin
  _graphresult:=grOk;
  if not isgraphmode then
    begin
      _graphresult:=grNoInitGraph;
      exit;
    end;
  getbkcolor:=aktbackcolor;
end;

procedure SetBkColor(Color : longint);
begin
  _graphresult:=grOk;
  if not isgraphmode then
    begin
      _graphresult:=grNoInitGraph;
      exit;
    end;
  aktbackcolor:=convert(Color);
end;
  
function  GetMaxColor : longint;
begin
  _graphresult:=grOk;
  if not isgraphmode then
    begin
      _graphresult:=grNoInitGraph;;
      exit;
    end;
  getmaxcolor:=(1 shl VESAInfo.BitsPerPixel)-1;
end;

{
  $Log$
  Revision 1.1  1998-03-25 11:18:42  root
  Initial revision

  Revision 1.3  1998/01/26 11:57:43  michael
  + Added log at the end


  
  Working file: rtl/dos/ppi/colors.ppi
  description:
  ----------------------------
  revision 1.2
  date: 1997/12/01 12:21:28;  author: michael;  state: Exp;  lines: +13 -0
  + added copyright reference in header.
  ----------------------------
  revision 1.1
  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;
  Initial revision
  ----------------------------
  revision 1.1.1.1
  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;  lines: +0 -0
  FPC RTL CVS start
  =============================================================================
}