Here is the source code to DepthLib.p:
{--------------------------------------------------------------------------------}
{ Library routines for getting and setting the color depth for monitors. }
{ All of the code originated from Kenneth Worley's Monitor Tricks 1.51 in C++. }
{ Changed to C by Mark Womack. }
{ Changed to Pascal by Bill Catambay, catambay@aol.com. }
{ }
{ Pascal version 1.0 - 7/24/96 }
{ }
{ NOTE: Mark informed me, after my conversion, that Ingemar had done a Pascal }
{ conversion more than a week before. He sent me a copy and both our versions }
{ are very similar, differences mainly in style and in Think Pascal support. }
{--------------------------------------------------------------------------------}
Unit DepthLib;
Interface
Uses
Palettes;
Const
kMillionsColors = 32;
kThousandsColors = 16;
k256Colors = 8;
k16Colors = 4;
k4Colors = 2;
k2Colors = 1;
kGrayMode = 0;
kColorMode = 1;
Function MaxScreenDepth(theGDevice: GDHandle): integer;
Function SupportsDepth(theGDevice: GDHandle; aDepth: integer): boolean;
Function GetScreenDepth(theGDevice: GDHandle): integer;
Procedure SetScreenDepth(theGDevice: GDHandle; newDepth: integer);
Function SupportsMode(theGDevice: GDHandle; aMode: integer): Boolean;
Function GetScreenMode(theGDevice: GDHandle): integer;
Procedure SetScreenMode(theGDevice: GDHandle; newMode: integer);
Procedure SetScreenModeDepth(theGDevice: GDHandle; newDepth, newMode: integer);
Implementation
{----------------------------------------------------------}
{ MaxScreenDepth returns the maximum bit depth that the }
{ monitor is capable of (i.e. 8 for 256 colors). }
{----------------------------------------------------------}
Function MaxScreenDepth(theGDevice: GDHandle): integer;
Var
x: integer;
hasThisDepth: integer;
begin
hasThisDepth := 1;
for x := 1 to 16 do
if HasDepth(theGDevice, x * 2, gdDevType, 1) <> 0 then
hasThisDepth := x * 2
else
leave;
MaxScreenDepth := x;
end;
{----------------------------------------------------------}
{ Returns true if the monitor supports the given depth }
{----------------------------------------------------------}
Function SupportsDepth(theGDevice: GDHandle; aDepth: integer): boolean;
Var
savedDevice: GDHandle;
begin
savedDevice := GetGDevice;
SetGDevice(theGDevice);
SupportsDepth := HasDepth(theGDevice, aDepth, BSL(1, gdDevType),
GetScreenMode(theGDevice)) <> 0;
SetGDevice(savedDevice);
end;
{---------------------------------------------------------------}
{ GetScreenDepth returns the current bit depth of this monitor. }
{---------------------------------------------------------------}
Function GetScreenDepth(theGDevice: GDHandle): integer;
begin
GetScreenDepth := theGDevice^^.gdPMap^^.pixelSize;
end;
{----------------------------------------------------------}
{ SetScreenDepth changes the bit depth of the screen (the }
{ number of colors that it can display at once). }
{----------------------------------------------------------}
Procedure SetScreenDepth(theGDevice: GDHandle; newDepth: integer);
Var
savedDevice: GDHandle;
err: OSerr;
begin
savedDevice := GetGDevice;
SetGDevice(theGDevice);
if newDepth <> GetScreenDepth(theGDevice) then
if 0 <> HasDepth(theGDevice, newDepth, BSL(1, gdDevType),
GetScreenMode(theGDevice)) then
err := SetDepth(theGDevice, newDepth, BSL(1, gdDevType),
GetScreenMode(theGDevice));
SetGDevice(savedDevice);
end;
{----------------------------------------------------------}
{ Returns true if the monitor supports the given mode }
{----------------------------------------------------------}
Function SupportsMode(theGDevice: GDHandle; aMode: integer): Boolean;
Var
savedDevice: GDHandle;
begin
savedDevice := GetGDevice;
SetGDevice(theGDevice);
SupportsMode := 0 <> HasDepth(theGDevice, GetScreenDepth(theGDevice),
BSL(1, gdDevType), aMode);
SetGDevice(savedDevice);
end;
{----------------------------------------------------------}
{ GetScreenMode returns one if the monitor is displaying }
{ colors, zero if it's displaying in grays. }
{----------------------------------------------------------}
Function GetScreenMode(theGDevice: GDHandle): integer;
begin
if TestDeviceAttribute(theGDevice, gdDevType) then
GetScreenMode := 1 { Colors }
else
GetScreenMode := 0; { Grays }
end;
{----------------------------------------------------------}
{ SetScreenMode sets this monitor to color if 1 is sent, }
{ or grays if zero is sent. }
{----------------------------------------------------------}
Procedure SetScreenMode(theGDevice: GDHandle; newMode: integer);
Var
savedDevice: GDHandle;
err: OSerr;
begin
savedDevice := GetGDevice;
SetGDevice(theGDevice);
if newMode <> GetScreenMode(theGDevice) then
if 0 <> HasDepth(theGDevice, GetScreenDepth(theGDevice),
BSL(1, gdDevType), newMode) then
err := SetDepth(theGDevice, GetScreenDepth(theGDevice),
BSL(1, gdDevType), newMode);
SetGDevice(savedDevice);
end;
{----------------------------------------------------------}
{ SetScreenModeDepth sets the monitor to the color mode }
{ and depth specified. }
{----------------------------------------------------------}
Procedure SetScreenModeDepth(theGDevice: GDHandle; newDepth, newMode: integer);
Var
savedDevice: GDHandle;
err: OSerr;
begin
savedDevice := GetGDevice;
SetGDevice(theGDevice);
if (newDepth <> GetScreenDepth(theGDevice)) or
(newMode <> GetScreenMode(theGDevice)) then
if 0 <> HasDepth(theGDevice, newDepth, BSL(1, gdDevType), newMode) then
err := SetDepth(theGDevice, newDepth, BSL(1, gdDevType), newMode);
SetGDevice(savedDevice);
end;
End.