Your Borland'Pascal is to great, but is old.
I am my Romanian country, neighbour via Ukraine, (I hope you know where Ukraine is on the map of www),please, Our team of programmers, develop this solution(they work 6months in early 2005 years).
BPW.for windows, is more deep and more-good solution.
Try the version of BPW, BP for windows, graph.ver.win16.tpw
BP.dos.version , I known VESA memory contain bit8-pixels of FONT.
I known adress VGA:A0000, your read the pwords& directly from Bios-memory.
In older/s EGA, CGA, TADI, please leave all , you must VESA,VGA..
Anyway VESAmode 3.0 version is fast of graph for MsDos.(min4 * speed of VGA).
Var
instFont : array[0..NrMaxFonts-1] of TFontString;
For win2000, winxp, or win7 , your answer , -> You search ??? procedure GraphDefaults;
var palette: PaletteType;
pattern: FillPatternType;
begin
if palExist then
begin
GetDefaultPalette(palette);
SetAllPalette(palette);
end else SetAbsoluteColors;
with lineSettings do begin
linestyle:=SolidLn;
pattern:=0;
thickness:=NormWidth;
end;
SetColor(White); SetBkColor(Black);
FillChar(pattern,8,$FF);
SetFillPattern(pattern,White);
SetFillStyle(SolidFill,White);
SetTextStyle(DefaultFont,HorizDir,16); ???
SetTextJustify(LeftText,TopText);
SetUserCharSize(0,0,0,0);
SetViewPort(0,0,maxX,maxY,ClipOff);
SetWri]"]>Blockedde(CopyMode or Transparent);
SetAspectRatio(10000,10000);
floodMode:=BorderFlood;
end;
{$INCLUDE switches.inc}
interface
uses windows {$IFDEF DELPHI},messages {$ENDIF};
{$DEFINE 256_COLOR_NAMES} //<- switch for defining 256 color names
{$DEFINE INIT_OPENGL} //<- switch for OpenGL driver initialization
**** HERE is our Graph.TurboPascal with Opengl ****
{$DEFINE HIDE_CONSOLE} //<- switch for hiding the parent console (if any)
Type longword=Cardinal;
{unit version}
const WinGraphVer = '1.0';
{error codes}
const grOk = smallint( 0);
grNoInitGraph = smallint(- 1);
grInvalidDriver = smallint(- 2);
grInvalidMode = smallint(- 3);
grNotWindow = smallint(- 4);
grInvalidFont = smallint(- 5);
grInvalidFontNum = smallint(- 6);
grInvalidParam = smallint(- 7);
grNoPalette = smallint(- 8);
grNoOpenGL = smallint(- 9);
grError = smallint(-10);
{graphics drivers}
const Detect = smallint(0);
D1bit = smallint(1);
D4bit = smallint(2);
D8bit = smallint(3);
NoPalette = smallint(9);
HercMono = D1bit;
VGA = D4bit;
SVGA = D8bit;
{graphics modes}
const m320x200 = smallint( 1);
m640x200 = smallint( 2);
m640x350 = smallint( 3);
m640x480 = smallint( 4);
m720x350 = smallint( 5);
m800x600 = smallint( 6);
m1024x768 = smallint( 7);
m1280x1024 = smallint( 8);
mDefault = smallint(10);
mMaximized = smallint(11);
mFullScr = smallint(12);
mCustom = smallint(13);
HercMonoHi = m720x350;
VGALo = m640x200;
VGAMed = m640x350;
VGAHi = m640x480;
{update constants}
const UpdateOff = word(0);
UpdateOn = word(1);
UpdateNow = word(2);
{OpenGL drawing modes}
const DirectOn = true;
DirectOff = false;
{initialization exported routines}
procedure ClearDevice;
procedure CloseGraph;
function CloseGraphRequest: boolean;
procedure DetectGraph(out driver,mode:smallint);
function GetDriverName: shortstring;
function GetGraphMode: smallint;
function GetMaxMode: smallint;
function GetModeName(mode:smallint): shortstring;
procedure GetModeRange(driver:smallint; out width,height:smallint);
procedure GraphDefaults;
function GraphEnabled: boolean;
function GraphErrorMsg(errorcode:smallint): shortstring;
function GraphResult: smallint;
procedure InitGraph(var driver,mode:smallint; const title:shortstring);
function OpenGLEnabled: boolean;
procedure RestoreCrtMode;
procedure SetGraphMode(mode:smallint);
procedure SetOpenGLMode(direct:boolean);
procedure SetWindowSize(width,height:word);
procedure UpdateGraph(bit:word);
type ViewPortType = record
x1,y1,x2,y2: smallint;
clip : boolean;
end;
AnimatType = record
bitHnd,maskHnd,bkgHnd: Cardinal;
end;
{clipping constants}
const ClipOn = true;
ClipOff = false;
{raster operation constants}
const CopyPut = word( 0);
XorPut = word( 1);
OrPut = word( 2);
AndPut = word( 3);
NotPut = word( 4);
NotOrPut = word( 5);
InvBitOrPut = word( 6);
InvScrAndPut = word( 7);
TransPut = word( 8);
MaskPut = word( 9);
BkgPut = word(10);
NormalPut = CopyPut;
{drawing modes on screen}
const CopyMode = smallint( 0);
XorMode = smallint( 1);
OrMode = smallint( 2);
AndMode = smallint( 3);
NotMode = smallint( 4);
NotScrMode = smallint( 5);
NotXorMode = smallint( 6);
NotOrMode = smallint( 7);
NotAndMode = smallint( 8);
InvColAndMode = smallint( 9);
InvColOrMode = smallint(10);
InvScrAndMode = smallint(11);
InvScrOrMode = smallint(12);
BlackMode = smallint(13);
Whi]"]>Blockedde = smallint(14);
EmptyMode = smallint(15);
Transparent = smallint(00);
Opaque = smallint(16);
{screen management exported routines}
procedure ClearViewPort;
procedure FreeAnim(var anim:AnimatType);
procedure GetAnim(x1,y1,x2,y2:smallint; color:longword; out anim:AnimatType);
procedure GetAspectRatio(out xasp,yasp:word);
procedure GetImage(x1,y1,x2,y2:smallint; out bitmap);
function GetMaxX: smallint;
function GetMaxY: smallint;
procedure GetViewSettings(out viewport:ViewPortType);
function GetX: smallint;
function GetY: smallint;
function ImageSize(x1,y1,x2,y2:smallint): longint;
procedure PutAnim(x1,y1:smallint; var anim:AnimatType; bit:word);
procedure PutImage(x1,y1:smallint; var bitmap; bit:word);
procedure SetActivePage(page:word);
procedure SetAspectRatio(xasp,yasp:word);
procedure SetViewPort(x1,y1,x2,y2:smallint; clip:boolean);
procedure SetVisualPage(page:word);
procedure SetWri]"]>Blockedde(wri]"]>Blockedde:smallint);
You search CTR+F== ***HERE
and today opengl.dll is very-very-power of graph(E.g. opengl with 5GB memory ATI or nvidia), even with 1GB-DDR+on+GPU.
function InstallUserFont(const fontname:shortstring): smallint;
var i : smallint;
famName: pchar;
begin
Result:=-1;
grResult:=grOK;
if not(grEnabled) then begin
grResult:=grNoInitGraph;
Exit;
end;
famName:=pchar(ansistring(fontname));
EnterCriticalSection(protect_devices);
globalTemp:=0;
EnumFontFamilies(grWindow,famName,@EnumFontFamProc,0);
if (globalTemp = 1) then
for i:=0 to NrMaxFonts-1 do if (instFont[i] = '') then
begin
instFont[i]:=fontname+#0;
Result:=i;
Break;
end;
LeaveCriticalSection(protect_devices);
if (Result = -1) then grResult:=grInvalidFont;
end;
procedure SetTextStyle(font,direction,charsize:word);
var loByte,hiByte: byte;
nrfont : byte;
fontname : TFontString;
lplf : LOGFONT;
old : HFONT;
begin
grResult:=grOK;
if not(grEnabled) then begin
grResult:=grNoInitGraph;
Exit;
end;
loByte:=Lo(font); hiByte:=Hi(font);
nrfont:=loByte mod $10;
if (nrfont in [0..NrMaxFonts-1]) then fontname:=instFont[nrfont]
else fontname:='';
if (fontname <> '') then
begin
textSettings.font:=font;
textSettings.direction:=direction;
textSettings.charsize:=charsize;
if (charsize <= 5) then charsize:=charsize*MinCharSize;
with lplf do
begin
lfHeight:=charsize;
lfWidth:=0;
lfEscapement:=10*direction;
lfOrientation:=10*direction;
lfWeight:=(FW_BOLD-FW_NORMAL)*(loByte div $10)+FW_NORMAL;
lfItalic:=hiByte div $10;
lfUnderline:=hiByte mod $10;
lfStrikeOut:=0;
lfCharSet:=DEFAULT_CHARSET;
lfOutPrecision:=OUT_DEFAULT_PRECIS;
lfClipPrecision:=CLIP_DEFAULT_PRECIS;
lfQuality:=DEFAULT_QUALITY;
lfPitchAndFamily:=DEFAULT_PITCH or FF_DONTCARE;
{$IFDEF FPC}
lfFaceName:=fontname;
{$ELSE}
Move(fontname[1],lfFaceName[0],Length(fontname));
{$ENDIF}
end;
EnterCriticalSection(protect_devices);
grFont:=CreateFontIndirect(lplf);
old:=SelectObject(grWindow,grFont); SelectObject(grMemory,grFont);
if (old <> old_Font) then DeleteObject(old);
LeaveCriticalSection(protect_devices);
end else grResult:=grInvalidFontNum;
end;
procedure InstallDefaultFonts;
const NrDefFonts = 4; //the following fonts exist on any system
DefaultFont: array[0..NrDefFonts-1] of TFontString =???
('Courier New','MS Sans Serif','Times New Roman','Arial');
var i: longint;
begin
for i:=0 to NrMaxFonts-1 do instFont[i]:='';
for i:=0 to NrDefFonts-1 do begin
InstallUserFont(DefaultFont[i]);
if (grResult <> grOK) then Break;
end;
end;
Recent
