| 1 |
unit graphsys; |
| 2 |
{$IFDEF FPC} |
| 3 |
{$MODE DELPHI}{$H+} |
| 4 |
{$ENDIF} |
| 5 |
(***************************************) |
| 6 |
(* Copyright (C) 2009, SHIRAISHI Kazuo *) |
| 7 |
(***************************************) |
| 8 |
|
| 9 |
|
| 10 |
interface |
| 11 |
uses Types,ExtCtrls,Graphics, |
| 12 |
base,MyUtils; |
| 13 |
|
| 14 |
type |
| 15 |
GraphModeType=(ScreenBitMapMode,SizeMetaFileMode,PrtMetaFileMode,PrtDirectMode); |
| 16 |
var |
| 17 |
NextGraphMode:GraphmodeTYpe=ScreenBitmapMode; |
| 18 |
var |
| 19 |
AlignTop:boolean=false; |
| 20 |
AdditionalMargin:integer=0; |
| 21 |
MymmWidth:integer=10000; |
| 22 |
MymmHeight:integer=10000; |
| 23 |
|
| 24 |
|
| 25 |
type |
| 26 |
tjHorizontal=(tjLEFT,tjCENTER,tjRIGHT); |
| 27 |
tjVirtical=(tjTOP,tjCAP,tjHALF,tjBASE,tjBOTTOM); |
| 28 |
const |
| 29 |
Hjustification:array[tjHorizontal]of string[6]=('LEFT','CENTER','RIGHT'); |
| 30 |
Vjustification:array[tjVirtical]of string[6]=('TOP','CAP','HALF','BASE','BOTTOM'); |
| 31 |
|
| 32 |
|
| 33 |
const |
| 34 |
TextHeightMulti=1.25; |
| 35 |
|
| 36 |
const |
| 37 |
maxcolor=255; |
| 38 |
var |
| 39 |
axescolor0:integer=15; |
| 40 |
axescolor:integer=15; |
| 41 |
|
| 42 |
{**********} |
| 43 |
{TMyPalette} |
| 44 |
{**********} |
| 45 |
|
| 46 |
const |
| 47 |
White=$00FFFFFF; |
| 48 |
Black=$00000000; |
| 49 |
Blue= $00FF0000; |
| 50 |
Green=$0000FF00; |
| 51 |
Red =$000000FF; |
| 52 |
Cyan =Blue+Green; |
| 53 |
Yellow=Green+Red; |
| 54 |
Magenta=Red+Blue; |
| 55 |
|
| 56 |
type |
| 57 |
TMyPalette=class |
| 58 |
private |
| 59 |
PrivatePaletteNumber :integer ; {0���2} |
| 60 |
function getPal(c:integer):TColor; |
| 61 |
procedure setPal(c:integer; cl:TColor); |
| 62 |
procedure InitMyPalette(n:integer); |
| 63 |
public |
| 64 |
pal: array[0..maxcolor]of TColor; |
| 65 |
PaletteDisabled:boolean; |
| 66 |
function ColorIndex(color:TColor):integer; |
| 67 |
property palette[c:integer]:TColor read getPal write setPal ; default; |
| 68 |
property PaletteNumber :integer read privatePaletteNumber write InitMyPalette; |
| 69 |
end; |
| 70 |
|
| 71 |
TMyPalette16=array[0..15]of TColor; |
| 72 |
|
| 73 |
const |
| 74 |
MyPalette0:TMyPalette16=(White,Black,Blue,Green,Red,Cyan,Yellow,Magenta, |
| 75 |
clGray,clNavy,clGreen,clTeal,clMaroon,clOlive,clPurple,clSilver); |
| 76 |
|
| 77 |
MyPalette1:TMyPalette16=(Black,Blue,Green,Cyan,Red,Magenta,Yellow,White, |
| 78 |
clGray,clNavy,clGreen,clTeal,clMaroon,clPurple,clOlive,clSilver); |
| 79 |
|
| 80 |
MyPalette2:TMyPalette16=(Black,Blue,Red,Magenta,Green,Cyan,Yellow,White, |
| 81 |
clGray,clNavy,clPurple,clMaroon,clGreen,clTeal,clOlive,clSilver); |
| 82 |
var |
| 83 |
MyPalette:TMyPalette; |
| 84 |
|
| 85 |
type |
| 86 |
TAreaStyle=(asHollow, asSolid, asHatch); |
| 87 |
|
| 88 |
{***********} |
| 89 |
{ TGraphSys } |
| 90 |
{***********} |
| 91 |
|
| 92 |
type |
| 93 |
TBeamMode=(bmRigorous, bmImmortal); |
| 94 |
const |
| 95 |
s_Rigorous='RIGOROUS'; |
| 96 |
s_Immortal='IMMORTAL'; |
| 97 |
type |
| 98 |
TLineBuff=Array[0..247]of TPoint; |
| 99 |
PLineBuff=^TLineBuff; |
| 100 |
|
| 101 |
type |
| 102 |
TGraphSys=Class |
| 103 |
|
| 104 |
beam0:boolean; |
| 105 |
latex,latey:longint; |
| 106 |
BeamMode:TBeamMode; |
| 107 |
clip:boolean; |
| 108 |
Hjustify:tjHorizontal; |
| 109 |
Vjustify:tjVirtical; |
| 110 |
PenStyle:TPenStyle; |
| 111 |
|
| 112 |
left,right,bottom,top:extended; |
| 113 |
VPleft,VPright,VPbottom,VPtop:extended; |
| 114 |
DWleft,DWright,DWbottom,DWtop:extended; |
| 115 |
DVleft,DVright,DVbottom,DVtop:integer; |
| 116 |
DevRect:TRect; |
| 117 |
ClipRect:TRect; |
| 118 |
MyRgn:LongINT ; |
| 119 |
|
| 120 |
linecolor,pointcolor,areacolor,textcolor:integer; |
| 121 |
pointstyle:integer; |
| 122 |
textangle:integer; {���} |
| 123 |
linewidth:integer; |
| 124 |
|
| 125 |
AreaStyleIndex:byte; |
| 126 |
AreaStyle:TAreaStyle; |
| 127 |
|
| 128 |
constructor create; |
| 129 |
destructor destroy; override; |
| 130 |
function virtualX(vx:integer):extended; |
| 131 |
function VirtualY(vy:integer):extended; |
| 132 |
function deviceX(x:extended):longint; |
| 133 |
function deviceY(y:extended):longint; |
| 134 |
function ConvToDeviceX(x:extended; var i:integer):boolean; |
| 135 |
function ConvToDeviceY(y:extended; var j:integer):boolean; |
| 136 |
function GWidth:extended; |
| 137 |
function GHeight:extended; |
| 138 |
function GetTextHeight:extended; |
| 139 |
procedure setupClipRect; virtual; abstract; |
| 140 |
procedure SetTextHeight(const x:extended);virtual; |
| 141 |
procedure askDeviceSize(var w,h:extended; var s:string); |
| 142 |
procedure clear; virtual; |
| 143 |
procedure SetUpCoordinateSubSystem; |
| 144 |
|
| 145 |
procedure InitGraphic; |
| 146 |
procedure InitCoordinate; |
| 147 |
procedure SetWindow(l,r,b,t:extended); |
| 148 |
procedure SetViewport(l,r,b,t:extended); |
| 149 |
procedure SetDeviceWindow(l,r,b,t:extended); |
| 150 |
function SetDeviceViewport(l,r,b,t:extended):boolean; |
| 151 |
procedure SetClip(c:boolean); |
| 152 |
procedure plotto(x,y: extended); |
| 153 |
procedure putmark(x,y:extended); |
| 154 |
procedure PutText(const n,m:Extended; const s:string); |
| 155 |
procedure GraphText(const n,m:Extended; const s:string); |
| 156 |
procedure PlotText(const n,m:Extended; const s:string); |
| 157 |
procedure PlotLetters(const n,m:Extended; const s:string); |
| 158 |
|
| 159 |
procedure finish; virtual;abstract; |
| 160 |
procedure SetBitmapSize(w,h:integer);virtual; |
| 161 |
procedure OpenFile(FileName: string);virtual; |
| 162 |
procedure saveBMPFile(FileName: string);virtual; |
| 163 |
procedure SaveFileFormat(FileName: string; pf:TPixelFormat); virtual; |
| 164 |
procedure SaveJpegFile(FileName:string; p:integer);virtual; |
| 165 |
procedure SaveGifFile(FileName:string);virtual; |
| 166 |
procedure SaveEMFFile(FileName:string);virtual; |
| 167 |
procedure putpixel(a,b:longint); virtual; |
| 168 |
procedure line(a1,b1,a2,b2:integer; c:integer; ps:TPenStyle; w:integer); virtual; |
| 169 |
procedure putmark0(a,b:integer); |
| 170 |
procedure setlinecolor(c:integer); virtual; |
| 171 |
procedure settextcolor(c:integer); virtual; |
| 172 |
procedure SetPenStyle(ps:TPenStyle); virtual; |
| 173 |
procedure setlinewidth(c:integer); virtual; |
| 174 |
procedure SetTextFont(const name:AnsiString; size:integer); virtual; |
| 175 |
procedure getpoint(var a,b:integer);virtual; |
| 176 |
procedure MoveMouse(a,b:integer);virtual; |
| 177 |
procedure MousePol(var a,b:integer; var l,r:boolean); virtual; |
| 178 |
procedure TextOut(x,y:integer; const s:ansistring; angle:integer); |
| 179 |
procedure TextOutSub(x,y:integer; const s:ansistring; angle:integer); virtual; |
| 180 |
procedure SetRasterMode(b:TPenMode);virtual; |
| 181 |
procedure setHiddenDrawMode(b:boolean);virtual; |
| 182 |
|
| 183 |
function ColorIndexOf(a,b:integer):integer;virtual; |
| 184 |
function setcolormode(s:ansistring):boolean; |
| 185 |
function AskColorMode:Ansistring; |
| 186 |
function textwidth(const s:ansistring):integer; |
| 187 |
function textheight(const s:ansistring):integer; |
| 188 |
procedure AskDeviceViewport(var l,r,b,t:extended); |
| 189 |
|
| 190 |
procedure MSPaint( x,y:integer; ac, bc:integer); virtual; |
| 191 |
procedure MSCircle(x1,y1,x2,y2:integer; lc,ac:integer; f:boolean); virtual; |
| 192 |
procedure MSMoveTo(a,b:integer);virtual; |
| 193 |
procedure MSLineTo(a,b:integer);virtual; |
| 194 |
procedure MSScreen(c:integer);virtual; |
| 195 |
procedure putColor(a,b:longint; c:integer); virtual; |
| 196 |
|
| 197 |
procedure Flood(x,y:integer); virtual; |
| 198 |
procedure FloodFill(x,y:integer); virtual; |
| 199 |
procedure Polygon(const Points:array of TPoint); virtual; |
| 200 |
procedure Polyline(const Points:array of TPoint); virtual; |
| 201 |
procedure ColorPolyGon(const Points:array of TPoint; c:integer{���������});virtual; |
| 202 |
procedure PolyBezier(const Points:array of TPoint); virtual; |
| 203 |
|
| 204 |
procedure SetAreaStyle(s:TAreaStyle); |
| 205 |
procedure SetAreaStyleIndex(i:integer); |
| 206 |
|
| 207 |
function SetBeamMode(s:AnsiString):boolean; |
| 208 |
function AskBeamMode:AnsiString; |
| 209 |
|
| 210 |
function xdirection(const x0,y0:extended):integer; |
| 211 |
procedure SetBeam(t:boolean); |
| 212 |
property beam:boolean read beam0 write SetBeam; |
| 213 |
procedure segment(x1,y1,x2,y2:integer); virtual; |
| 214 |
procedure ThinRepaint; virtual; |
| 215 |
|
| 216 |
private |
| 217 |
Canvas1:TCanvas; |
| 218 |
HMulti,HShift,VMulti,VShift:extended; |
| 219 |
DevHeight,DevWidth:longint; |
| 220 |
LineBuff:PLineBuff; |
| 221 |
LineBuffCount:integer; |
| 222 |
TextHeightChanged:boolean; |
| 223 |
|
| 224 |
procedure start; virtual;abstract; |
| 225 |
procedure InitCoordSub; virtual; |
| 226 |
procedure SetDefaultCoordinate; |
| 227 |
procedure makeClipRect; |
| 228 |
procedure ColorPolyGonSub(Canvas:TCanvas; const Points:array of TPoint; c:integer{���������}); |
| 229 |
procedure PolyGonSub(Canvas:TCanvas; const Points:array of TPoint); |
| 230 |
procedure PolyLineSub(Canvas:TCanvas; const Points:array of TPoint); |
| 231 |
procedure BezierSub(Canvas:TCanvas; const Points:array of TPoint); |
| 232 |
procedure SegmentWinSub(Canvas:TCanvas; x1,y1,x2,y2:integer); |
| 233 |
procedure SegmentWin(Canvas:TCanvas; x1,y1,x2,y2:integer); |
| 234 |
procedure SegmentForward(Canvas:TCanvas; x1,y1,x2,y2:integer); |
| 235 |
procedure StyledLine(x2,y2:integer); |
| 236 |
procedure LineBuffFlush; |
| 237 |
procedure ClearScreen;virtual; |
| 238 |
function PixelsPerMeter:extended;virtual;abstract; |
| 239 |
procedure ProjectiveText(const n,m:Extended; const s:string; PlotStm:boolean); |
| 240 |
end; |
| 241 |
|
| 242 |
type |
| 243 |
|
| 244 |
TScreenBMPGraphSys=class(TGraphSys) |
| 245 |
Bitmap1:TBitmap; |
| 246 |
PaintBox1:TPaintBox; |
| 247 |
procedure setup; |
| 248 |
procedure setupClipRect;override; |
| 249 |
procedure finish; override; |
| 250 |
|
| 251 |
procedure OpenFile(FileName: string);override; |
| 252 |
procedure saveBMPFile(FileName: string);override; |
| 253 |
procedure SaveFileFormat(FileName: string; pf:TPixelFormat);override; |
| 254 |
procedure SaveJpegFile(FileName:string; p:integer);override; |
| 255 |
procedure SaveGifFile(FileName:string);override; |
| 256 |
procedure clear; override; |
| 257 |
procedure putpixel(a,b:longint); override; |
| 258 |
procedure line(a1,b1,a2,b2:integer; c:integer; ps:TPenStyle; w:integer); override; |
| 259 |
procedure setlinecolor(c:integer); override; |
| 260 |
procedure settextcolor(c:integer); override; |
| 261 |
procedure SetPenStyle(ps:TPenStyle); override; |
| 262 |
procedure setlinewidth(c:integer); override; |
| 263 |
procedure SetTextHeight(const x:extended);override; |
| 264 |
procedure SetTextFont(const name:AnsiString; size:integer); override; |
| 265 |
procedure TextOutSub(x,y:integer; const s:ansistring; angle:integer); override; |
| 266 |
procedure getpoint(var a,b:integer);override; |
| 267 |
//function ColorIndexOf(a,b:integer):integer;override; |
| 268 |
procedure MoveMouse(a,b:integer);override; |
| 269 |
procedure MousePol(var a,b:integer; var l,r:boolean); override; |
| 270 |
procedure SetRasterMode(b:TPenMode);override; |
| 271 |
procedure setHiddenDrawMode(b:boolean);override; |
| 272 |
procedure SetBitmapSize(w,h:integer);override; |
| 273 |
procedure MSPaint( x,y:integer; ac, bc:integer); override; |
| 274 |
procedure MSCircle(x1,y1,x2,y2:integer; lc,ac:integer; f:boolean); override; |
| 275 |
procedure MSMoveTo(a,b:integer);override; |
| 276 |
procedure MSLineTo(a,b:integer);override; |
| 277 |
procedure MSScreen(c:integer);override; |
| 278 |
procedure putColor(a,b:longint; c:integer); override; |
| 279 |
|
| 280 |
procedure Flood( x,y:integer); override; |
| 281 |
procedure FloodFill( x,y:integer); override; |
| 282 |
procedure Polygon(const Points:array of TPoint); override; |
| 283 |
procedure Polyline(const Points:array of TPoint); override; |
| 284 |
procedure PolyBezier(const Points:array of TPoint); override; |
| 285 |
procedure ColorPolyGon(const Points:array of TPoint; c:integer{���������});override; |
| 286 |
procedure ThinRepaint; override; |
| 287 |
private |
| 288 |
procedure start; override; |
| 289 |
procedure InitCoordSub; override; |
| 290 |
procedure segment(x1,y1,x2,y2:integer);override; |
| 291 |
function PixelsPerMeter:extended;override; |
| 292 |
end; |
| 293 |
|
| 294 |
TMetaPrtGraphSys=class(TGraphSys) |
| 295 |
procedure setupClipRect;override; |
| 296 |
private |
| 297 |
procedure InitCoordSub; override; |
| 298 |
procedure SetDefaultMargin; |
| 299 |
function PixelsPerMeter:extended;override; |
| 300 |
end; |
| 301 |
|
| 302 |
|
| 303 |
|
| 304 |
TPrtDirectGraphSys=class(TMetaPrtGraphSys) |
| 305 |
constructor create; |
| 306 |
procedure clear; override; |
| 307 |
procedure start; override; |
| 308 |
procedure finish; override; |
| 309 |
private |
| 310 |
procedure ClearScreen;override; |
| 311 |
end; |
| 312 |
|
| 313 |
var |
| 314 |
ScreenBMPGraphSys:TScreenBMPGraphSys; |
| 315 |
PrtDirectGraphSys:TPrtDirectGraphSys; |
| 316 |
MyGraphSys : TGraphSys; |
| 317 |
|
| 318 |
{*************} |
| 319 |
{miscellaneous} |
| 320 |
{*************} |
| 321 |
|
| 322 |
var restrict: function(n:longint):integer; |
| 323 |
|
| 324 |
var |
| 325 |
NotXorMode:boolean = false; |
| 326 |
HiddenDrawMode:boolean = false; |
| 327 |
iBKmode:integer = TRANSPARENT; |
| 328 |
|
| 329 |
var |
| 330 |
ForwardPlot:boolean = true; |
| 331 |
GeometricPenOnly:boolean = false; |
| 332 |
TextProblemCoordinate:boolean = false; |
| 333 |
var |
| 334 |
invalidCoordinate:boolean=false; |
| 335 |
|
| 336 |
procedure initGraphics; |
| 337 |
|
| 338 |
|
| 339 |
|
| 340 |
implementation |
| 341 |
|
| 342 |
uses Classes, SysUtils, Forms, Math, |
| 343 |
{$IFDEF FPC} |
| 344 |
Interfaces, LCLIntf, LCLType, LCLProc, GraphType, GraphUtil, |
| 345 |
{$ELSE} |
| 346 |
Windows, |
| 347 |
{$ENDIF} |
| 348 |
Printers, printdlg, |
| 349 |
affine,float,paintfrm,locatefrm; |
| 350 |
|
| 351 |
{**********} |
| 352 |
{TMyPalette} |
| 353 |
{**********} |
| 354 |
|
| 355 |
|
| 356 |
function TMyPalette.getPal(c:integer):TColor; |
| 357 |
begin |
| 358 |
if PaletteDisabled then |
| 359 |
result:=c |
| 360 |
else |
| 361 |
result:=pal[c and 255] or $2000000 |
| 362 |
end; |
| 363 |
|
| 364 |
procedure TMyPalette.setPal(c:integer; cl:TColor); |
| 365 |
begin |
| 366 |
pal[c and 255]:=cl and $ffffff; |
| 367 |
end; |
| 368 |
|
| 369 |
function TMyPalette.ColorIndex(color:TColor):integer; |
| 370 |
var |
| 371 |
i:integer; |
| 372 |
begin |
| 373 |
if color=-1 then |
| 374 |
result:=-1 |
| 375 |
else |
| 376 |
begin |
| 377 |
color:=color and $ffffff; |
| 378 |
if PaletteDisabled then |
| 379 |
result:=color |
| 380 |
else |
| 381 |
begin |
| 382 |
result:=-1; |
| 383 |
i:=0; |
| 384 |
while i<=maxcolor do |
| 385 |
if Pal[i]=color then |
| 386 |
begin |
| 387 |
result:=i; |
| 388 |
break |
| 389 |
end |
| 390 |
else |
| 391 |
inc(i); |
| 392 |
end; |
| 393 |
end; |
| 394 |
end; |
| 395 |
|
| 396 |
procedure TMyPalette.InitMyPalette(n:integer); |
| 397 |
var |
| 398 |
i,j,k:integer; |
| 399 |
r,g,b:byte; |
| 400 |
P:^TMyPalette16; |
| 401 |
begin |
| 402 |
PaletteDisabled:=false; |
| 403 |
|
| 404 |
for j:=0 to 63 do |
| 405 |
begin |
| 406 |
r:=255-( ( (j and 1)*2 + ((j shr 3) and 1))*85); |
| 407 |
g:=255-( (((j shr 1)and 1)*2 + ((j shr 4) and 1))*85); |
| 408 |
b:=255-( (((j shr 2)and 1)*2 + ((j shr 5) and 1))*85); |
| 409 |
Palette[j]:=RGB(r,g,b); |
| 410 |
Palette[j+64]:=RGB(r xor 128,g xor 128 ,b xor 128); |
| 411 |
Palette[j+128]:=RGB(r xor 192,g xor 192 ,b xor 192); |
| 412 |
Palette[j+192]:=RGB(r xor 140,g xor 140 ,b xor 143); |
| 413 |
end; |
| 414 |
|
| 415 |
P:=@MyPalette0; |
| 416 |
case n of |
| 417 |
0: ; |
| 418 |
1:P:=@MyPalette1; |
| 419 |
2:P:=@MyPalette2; |
| 420 |
end; |
| 421 |
|
| 422 |
for i:=0 to 15 do |
| 423 |
begin |
| 424 |
k:=self.ColorIndex(P^[i]); |
| 425 |
for j:=k downto i+1 do |
| 426 |
Palette[j]:=Palette[j-1]; |
| 427 |
Palette[i]:=P^[i]; |
| 428 |
end; |
| 429 |
|
| 430 |
(* |
| 431 |
for i:=16 to 255 do |
| 432 |
begin |
| 433 |
Palette[i]:=(i mod 7)*42 + (i mod 6)*51 *256 + (i mod 5)*63 * 65536; |
| 434 |
//Palette[i]:=(i mod 7)*42 + (i mod 4)*85 *256 + (i mod 3)*127 * 65536; |
| 435 |
end; |
| 436 |
*) |
| 437 |
|
| 438 |
|
| 439 |
end; |
| 440 |
|
| 441 |
{*********} |
| 442 |
{TGraphSys} |
| 443 |
{*********} |
| 444 |
|
| 445 |
constructor TGraphSys.create; |
| 446 |
begin |
| 447 |
|
| 448 |
left:=0; |
| 449 |
right:=1; |
| 450 |
bottom:=0; |
| 451 |
top:=1; |
| 452 |
|
| 453 |
VPleft:=0; |
| 454 |
VPright:=1; |
| 455 |
VPbottom:=0; |
| 456 |
VPtop:=1; |
| 457 |
|
| 458 |
DWleft:=0; |
| 459 |
DWright:=1; |
| 460 |
DWbottom:=0; |
| 461 |
DWtop:=1; |
| 462 |
|
| 463 |
clip:=true; |
| 464 |
|
| 465 |
Hjustify:=tjLEFT; |
| 466 |
Vjustify:=tjBOTTOM; |
| 467 |
|
| 468 |
end; |
| 469 |
|
| 470 |
|
| 471 |
procedure TScreenBMPGraphSys.setup; |
| 472 |
// PaintForm.FormCreate���������������������set up��������������������� |
| 473 |
begin |
| 474 |
Canvas1:=PaintForm.Bitmap1.Canvas; |
| 475 |
Bitmap1:=PaintForm.Bitmap1; |
| 476 |
PaintBox1:=PaintForm.PaintBox1; |
| 477 |
end; |
| 478 |
|
| 479 |
constructor TPrtDirectGraphSys.create; |
| 480 |
begin |
| 481 |
inherited create; |
| 482 |
//Canvas1:=printer.Canvas; |
| 483 |
end; |
| 484 |
|
| 485 |
|
| 486 |
destructor TGraphSys.destroy; |
| 487 |
begin |
| 488 |
inherited destroy |
| 489 |
end; |
| 490 |
|
| 491 |
procedure TScreenBMPGraphSys.start; |
| 492 |
begin |
| 493 |
TextHeightChanged:=false; |
| 494 |
end; |
| 495 |
|
| 496 |
procedure SetFont(y,x:TFont); |
| 497 |
begin |
| 498 |
y.Charset:=x.Charset; |
| 499 |
y.Color:=x.Color; |
| 500 |
y.Name:=x.Name; |
| 501 |
y.Style:=x.Style; |
| 502 |
y.Size:=x.Size; |
| 503 |
end; |
| 504 |
|
| 505 |
|
| 506 |
procedure TPrtDirectGraphSys.start; |
| 507 |
begin |
| 508 |
TextHeightChanged:=false; |
| 509 |
|
| 510 |
MyPalette.PaletteNumber:=0; |
| 511 |
{todo 1 printer} |
| 512 |
|
| 513 |
with TPrintDialog1.create(paintform) do |
| 514 |
begin |
| 515 |
cancelButton.Visible:=false; |
| 516 |
ShowModal; |
| 517 |
free; |
| 518 |
end; |
| 519 |
|
| 520 |
printer.BeginDoc; |
| 521 |
Canvas1:=printer.Canvas; |
| 522 |
Canvas1.Font.PixelsPerInch:=Printer.XDPI; |
| 523 |
|
| 524 |
end; |
| 525 |
|
| 526 |
|
| 527 |
procedure TGraphSys.ThinRepaint; |
| 528 |
begin |
| 529 |
end; |
| 530 |
|
| 531 |
var Now0:double =0.0; |
| 532 |
{$IFDEF TimerDraw} |
| 533 |
procedure TScreenBMPGraphSys.ThinRepaint; |
| 534 |
{$MAXFPUREGISTERS 4} |
| 535 |
var |
| 536 |
Now1:double; |
| 537 |
begin |
| 538 |
if hiddendrawmode then exit; |
| 539 |
Now1:=Now; |
| 540 |
If Now1-Now0 >1.0/(24*60*60)/25 then |
| 541 |
begin |
| 542 |
Set8087cw($133F); |
| 543 |
PaintBox1.repaint; |
| 544 |
Application.processMessages; |
| 545 |
Set8087CW(controlword); |
| 546 |
Now0:=Now1; |
| 547 |
end; |
| 548 |
end; |
| 549 |
{$ELSE} |
| 550 |
procedure TScreenBMPGraphSys.ThinRepaint; |
| 551 |
{$MAXFPUREGISTERS 4} |
| 552 |
var |
| 553 |
Now1:double; |
| 554 |
begin |
| 555 |
if hiddendrawmode then exit; |
| 556 |
Now1:=Now; |
| 557 |
If Now1-Now0 >1.0/(24*60*60)/4 then |
| 558 |
begin |
| 559 |
Application.processMessages; |
| 560 |
Now0:=Now1; |
| 561 |
end; |
| 562 |
end; |
| 563 |
{$ENDIF} |
| 564 |
|
| 565 |
|
| 566 |
|
| 567 |
procedure TScreenBMPGraphSys.finish; |
| 568 |
begin |
| 569 |
{$IFDEF TimerDraw} |
| 570 |
Set8087cw($133F); |
| 571 |
PaintBox1.repaint; |
| 572 |
Set8087CW(controlword); |
| 573 |
{$ENDIF} |
| 574 |
|
| 575 |
LineBuffFlush; |
| 576 |
SelectClipRgn(Canvas1.Handle,0); |
| 577 |
SelectClipRgn(PaintBox1.Canvas.Handle,0); |
| 578 |
DeleteObject(MyRgn); |
| 579 |
MyRgn:=0; |
| 580 |
HiddenDrawMode:=false; |
| 581 |
PaintForm.Repaint; |
| 582 |
end; |
| 583 |
|
| 584 |
procedure TPrtDirectGraphSys.finish; |
| 585 |
begin |
| 586 |
LineBuffFlush; |
| 587 |
{todo 1 printer} |
| 588 |
|
| 589 |
with printer do |
| 590 |
if printing then |
| 591 |
begin |
| 592 |
SelectClipRgn(Canvas1.Handle,0); |
| 593 |
DeleteObject(MyRgn); |
| 594 |
MyRgn:=0; |
| 595 |
EndDoc; |
| 596 |
end; |
| 597 |
|
| 598 |
end; |
| 599 |
|
| 600 |
|
| 601 |
|
| 602 |
procedure TScreenBMPGraphSys.Clear; |
| 603 |
begin |
| 604 |
LineBuffFlush; |
| 605 |
SelectClipRgn(Canvas1.Handle,0); |
| 606 |
SelectClipRgn(PaintBox1.Canvas.Handle,0); |
| 607 |
PaintForm.Clear; |
| 608 |
SelectClipRgn(Canvas1.Handle,MyRgn); |
| 609 |
SelectClipRgn(PaintBox1.Canvas.Handle,MyRgn); |
| 610 |
end; |
| 611 |
|
| 612 |
|
| 613 |
|
| 614 |
procedure TGraphSys.clear; |
| 615 |
var |
| 616 |
NewRect:TRect; |
| 617 |
svBrushColor:TColor; |
| 618 |
begin |
| 619 |
LineBuffFlush; |
| 620 |
SelectClipRgn(Canvas1.Handle,0); |
| 621 |
NewRect:=Rect(0,0,DevWidth+1,DevHeight+1); |
| 622 |
with Canvas1 do |
| 623 |
begin |
| 624 |
svBrushColor:=Brush.Color; |
| 625 |
Brush.color:=Mypalette.pal[0] ; |
| 626 |
FillRect(NewRect); |
| 627 |
Brush.Color:=svBrushColor; |
| 628 |
end; |
| 629 |
SelectClipRgn(Canvas1.Handle,MyRgn); |
| 630 |
end; |
| 631 |
|
| 632 |
procedure TPrtDirectGraphSys.Clear; |
| 633 |
begin |
| 634 |
LineBuffFlush; |
| 635 |
{todo 1 printer} |
| 636 |
printer.NewPage; |
| 637 |
end; |
| 638 |
|
| 639 |
procedure TGraphSys.initGraphic; |
| 640 |
begin |
| 641 |
MyPalette.PaletteDisabled:=false; |
| 642 |
|
| 643 |
start; |
| 644 |
|
| 645 |
linecolor:=1; |
| 646 |
pointcolor:=1; |
| 647 |
areacolor:=1; |
| 648 |
textcolor:=1; |
| 649 |
penstyle:=psSolid; |
| 650 |
pointstyle:=3; |
| 651 |
linewidth:=1; |
| 652 |
TextAngle:=0; |
| 653 |
axescolor:=axescolor0; |
| 654 |
Hjustify:=tjLEFT; |
| 655 |
Vjustify:=tjBOTTOM; |
| 656 |
clip:=true; |
| 657 |
BeamMode:=bmRigorous; |
| 658 |
HiddenDrawMode:=false; |
| 659 |
iBKmode:= TRANSPARENT; |
| 660 |
AreaStyle:=asSolid; |
| 661 |
AreaStyleIndex:=1; |
| 662 |
|
| 663 |
InitCoordinate ; |
| 664 |
|
| 665 |
setlinecolor(linecolor); |
| 666 |
settextcolor(textcolor); |
| 667 |
setpenstyle(penstyle); |
| 668 |
setlinewidth(linewidth); |
| 669 |
setRasterMode(pmCopy); |
| 670 |
|
| 671 |
|
| 672 |
end; |
| 673 |
|
| 674 |
procedure TGraphSys.InitCoordinate; |
| 675 |
begin |
| 676 |
VPleft:=0; VPright:=1; VPbottom:=0; VPtop:=1; |
| 677 |
DWleft:=0; DWright:=1; DWbottom:=0; DWtop:=1; |
| 678 |
InitCoordSub; |
| 679 |
|
| 680 |
if permitMicrosoft then |
| 681 |
SetWindow(0,GWidth,GHeight,0) |
| 682 |
else |
| 683 |
SetWindow(0,1,0,1) |
| 684 |
end; |
| 685 |
|
| 686 |
procedure TGraphSys.SetWindow(l,r,b,t:extended); |
| 687 |
begin |
| 688 |
beam:=false; |
| 689 |
invalidCoordinate:=true; |
| 690 |
left:=l; |
| 691 |
right:=r; |
| 692 |
bottom:=b; |
| 693 |
top:=t; |
| 694 |
SetUpCoordinateSubSystem; |
| 695 |
invalidCoordinate:=false; |
| 696 |
end; |
| 697 |
|
| 698 |
procedure TGraphSys.SetViewport(l,r,b,t:extended); |
| 699 |
begin |
| 700 |
beam:=false; |
| 701 |
invalidCoordinate:=true; |
| 702 |
VPleft:=l; |
| 703 |
VPright:=r; |
| 704 |
VPbottom:=b; |
| 705 |
VPtop:=t; |
| 706 |
setupCliprect; |
| 707 |
SetUpCoordinateSubSystem; |
| 708 |
invalidCoordinate:=false; |
| 709 |
end; |
| 710 |
|
| 711 |
procedure TGraphSys.SetDeviceWindow(l,r,b,t:extended); |
| 712 |
begin |
| 713 |
beam:=false; |
| 714 |
invalidCoordinate:=true; |
| 715 |
DWleft:=l; |
| 716 |
DWright:=r; |
| 717 |
DWbottom:=b; |
| 718 |
DWtop:=t; |
| 719 |
setupCliprect; |
| 720 |
SetUpCoordinateSubSystem; |
| 721 |
invalidCoordinate:=false; |
| 722 |
clearScreen; |
| 723 |
end; |
| 724 |
|
| 725 |
|
| 726 |
procedure TGraphSys.InitCoordSub; |
| 727 |
begin |
| 728 |
end; |
| 729 |
|
| 730 |
procedure TScreenBMPGraphSys.InitCoordSub; |
| 731 |
begin |
| 732 |
//inherited InitCoordSub; |
| 733 |
DevWidth:=PaintForm.BitMap1.width-1; |
| 734 |
DevHeight:=PaintForm.BitMap1.height-1; |
| 735 |
|
| 736 |
DVleft:=0; |
| 737 |
DVright:=DevWidth; |
| 738 |
DVbottom:=0; |
| 739 |
DVtop:=DevHeight; |
| 740 |
|
| 741 |
SetDefaultCoordinate; |
| 742 |
setUpClipRect; |
| 743 |
end; |
| 744 |
|
| 745 |
procedure TMetaPrtGraphSys.InitCoordSub; |
| 746 |
begin |
| 747 |
//inherited initCoordsub; |
| 748 |
|
| 749 |
{ToDo 1 Printer} |
| 750 |
|
| 751 |
DevWidth:=printer.PageWidth-1-2; |
| 752 |
DevHeight:=printer.PageHeight-1-2; |
| 753 |
|
| 754 |
DVleft:=0; |
| 755 |
DVright:=DevWidth; |
| 756 |
DVbottom:=0; |
| 757 |
DVtop:=DevHeight; |
| 758 |
|
| 759 |
setDefaultMargin; |
| 760 |
setUpClipRect; |
| 761 |
end; |
| 762 |
|
| 763 |
|
| 764 |
|
| 765 |
procedure TGraphSys.SetDefaultCoordinate; |
| 766 |
begin |
| 767 |
|
| 768 |
DwLeft:=0; |
| 769 |
DwRight:=1; |
| 770 |
DwBottom:=0; |
| 771 |
DwTop:=1; |
| 772 |
if DvRight>=DvTop then |
| 773 |
DwTop:=DvTop/DvRight |
| 774 |
else |
| 775 |
DwRight:=DvRight/DvTop; |
| 776 |
|
| 777 |
VpLeft:=DwLeft; |
| 778 |
VpRight:=DwRight; |
| 779 |
VpBottom:=DwBottom; |
| 780 |
VpTop:=DwTop; |
| 781 |
end; |
| 782 |
|
| 783 |
|
| 784 |
function intersection(rect1,rect2:TRect):TRect; |
| 785 |
begin |
| 786 |
result:=rect2; |
| 787 |
if rect1.left>result.left then result.left:=rect1.left; |
| 788 |
if rect1.right<result.right then result.right:=rect1.right; |
| 789 |
if rect1.top>result.top then result.top:=rect1.top; |
| 790 |
if rect1.bottom<result.bottom then result.bottom:=rect1.bottom; |
| 791 |
end; |
| 792 |
|
| 793 |
procedure TGraphSys.makeClipRect; |
| 794 |
var |
| 795 |
rect2:TRect; |
| 796 |
begin |
| 797 |
{DevRect ������������������������������������������} |
| 798 |
with DevRect do |
| 799 |
begin |
| 800 |
if (bottom-top)/(right-left)>(DWtop-DWbottom)/(DWright-DWleft) then |
| 801 |
top:=bottom-round((right-left)*(DWtop-DWbottom)/(DWright-DWleft)) |
| 802 |
else if (bottom-top)/(right-left)<(DWtop-DWbottom)/(DWright-DWleft) then |
| 803 |
right:=left+round((bottom-top)*(DWright-DWleft)/(DWtop-DWbottom)) |
| 804 |
end; |
| 805 |
|
| 806 |
{ClipRect���������} |
| 807 |
ClipRect:=DevRect; |
| 808 |
rect2:=ClipRect; |
| 809 |
if clip then |
| 810 |
with ClipRect do |
| 811 |
begin |
| 812 |
Rect2.left:= left + floor((right- left)*(VPleft -DWleft)/(DWright-DWleft)); |
| 813 |
Rect2.right:= left + ceil((right- left)*(VPright-DWleft)/(DWright-DWleft)); |
| 814 |
Rect2.top:= bottom+floor((top-bottom)*(VPtop -DWbottom)/(DWtop-DWbottom)); |
| 815 |
Rect2.bottom:=bottom +ceil((top-bottom)*(VPBottom-DWbottom)/(DWtop-DWbottom)); |
| 816 |
end; |
| 817 |
ClipRect:=intersection(Cliprect,rect2); |
| 818 |
end; |
| 819 |
|
| 820 |
|
| 821 |
|
| 822 |
procedure TScreenBMPGraphSys.setupClipRect; |
| 823 |
begin |
| 824 |
DevRect.left:=DVleft; |
| 825 |
DevRect.right:=DVright; |
| 826 |
DevRect.top:=DevHeight-DVTop; |
| 827 |
DevRect.bottom:=DevHeight-DVBottom; |
| 828 |
|
| 829 |
makeClipRect; |
| 830 |
|
| 831 |
if MyRgn<>0 then |
| 832 |
begin |
| 833 |
SelectClipRgn(Canvas1.Handle,0); |
| 834 |
SelectClipRgn(PaintBox1.Canvas.Handle,0); |
| 835 |
DeleteObject(MyRgn); |
| 836 |
end; |
| 837 |
|
| 838 |
if (ClipRect.left=0) and (ClipRect.Right=DevWidth) |
| 839 |
and (ClipRect.Top=0) and (ClipRect.Bottom=DevHeight)then |
| 840 |
MyRgn:=0 |
| 841 |
else |
| 842 |
MyRgn := CreateRectRgn(ClipRect.left, ClipRect.top, ClipRect.right+1, ClipRect.bottom+1) ; |
| 843 |
|
| 844 |
SelectClipRgn(Canvas1.Handle,MyRgn); |
| 845 |
SelectClipRgn(PaintBox1.Canvas.Handle,MyRgn); |
| 846 |
end; |
| 847 |
|
| 848 |
|
| 849 |
|
| 850 |
procedure TMetaPrtGraphSys.setupClipRect; |
| 851 |
begin |
| 852 |
|
| 853 |
DevRect.left:=DVleft + 1; |
| 854 |
DevRect.right:=DVright + 1; |
| 855 |
DevRect.top:=DevHeight-DVTop + 1; |
| 856 |
DevRect.bottom:=DevHeight-DVBottom + 1; |
| 857 |
|
| 858 |
makeClipRect; |
| 859 |
|
| 860 |
if MyRgn<>0 then |
| 861 |
begin |
| 862 |
SelectClipRgn(Canvas1.Handle,0); |
| 863 |
DeleteObject(MyRgn); |
| 864 |
end; |
| 865 |
MyRgn := CreateRectRgn(ClipRect.left -1 ,ClipRect.top -1 , ClipRect.right +2 , ClipRect.bottom +2 ); |
| 866 |
|
| 867 |
SelectClipRgn(Canvas1.Handle,MyRgn); |
| 868 |
end; |
| 869 |
|
| 870 |
|
| 871 |
procedure TMetaPrtGraphSys.setDefaultMargin; |
| 872 |
var |
| 873 |
dvL,dvR,dvB,dvT,a,h,w:extended; |
| 874 |
begin |
| 875 |
a:=AdditionalMargin/1000; |
| 876 |
AskDeviceViewport(dvL,dvR,dvB,dvT); |
| 877 |
dvL:=dvL+a; |
| 878 |
dvR:=dvR-a; |
| 879 |
dvB:=dvB+a; |
| 880 |
dvT:=dvT-a; |
| 881 |
if AlignTop then |
| 882 |
begin |
| 883 |
h:=dvT-dvB; |
| 884 |
w:=dvR-dvL; |
| 885 |
if h>w then |
| 886 |
dvB:=dvT-w; |
| 887 |
end; |
| 888 |
setDeviceViewPort(dvL,dvR,dvB,dvT); |
| 889 |
|
| 890 |
end; |
| 891 |
|
| 892 |
function TGraphSys.deviceX(x:extended):longint; |
| 893 |
var |
| 894 |
z:extended; |
| 895 |
begin |
| 896 |
z:=(x-left)*HMulti+HShift; |
| 897 |
try |
| 898 |
result:=LongIntRound(z); |
| 899 |
except |
| 900 |
{$IFNDEF Windows} asm finit end; set8087cw(controlword); {$ENDIF} |
| 901 |
if z>0 then |
| 902 |
result:=maxint |
| 903 |
else |
| 904 |
result:=minint |
| 905 |
end; |
| 906 |
end; |
| 907 |
|
| 908 |
function TGraphSys.deviceY(y:extended):longint; |
| 909 |
var |
| 910 |
z:extended; |
| 911 |
begin |
| 912 |
z:=(y-bottom)*VMulti+VShift; |
| 913 |
try |
| 914 |
result:=LongIntRound(z); |
| 915 |
except |
| 916 |
{$IFNDEF Windows} asm finit end; set8087cw(controlword); {$ENDIF} |
| 917 |
if z>0 then |
| 918 |
result:=maxint |
| 919 |
else |
| 920 |
result:=minint |
| 921 |
end; |
| 922 |
end; |
| 923 |
|
| 924 |
function TGraphSys.ConvToDeviceX(x:extended; var i:integer):boolean; |
| 925 |
var |
| 926 |
z:extended; |
| 927 |
begin |
| 928 |
z:=(x-left)*HMulti+HShift; |
| 929 |
try |
| 930 |
i:={$IFDEF ver100}system.round{$ELSE}LongIntRound{$ENDIF}(z); |
| 931 |
result:=true; |
| 932 |
except |
| 933 |
{$IFNDEF Windows} asm finit end; set8087cw(controlword); {$ENDIF} |
| 934 |
result:=false; |
| 935 |
i:=minint |
| 936 |
end; |
| 937 |
end; |
| 938 |
|
| 939 |
function TGraphSys.ConvToDeviceY(y:extended; var j:integer):boolean; |
| 940 |
var |
| 941 |
z:extended; |
| 942 |
begin |
| 943 |
z:=(y-bottom)*VMulti+VShift; |
| 944 |
try |
| 945 |
j:={$IFDEF ver100}system.round{$ELSE}LongIntRound{$ENDIF}(z); |
| 946 |
result:=true; |
| 947 |
except |
| 948 |
{$IFNDEF Windows} asm finit end; set8087cw(controlword); {$ENDIF} |
| 949 |
result:=false; |
| 950 |
j:=minint |
| 951 |
end; |
| 952 |
end; |
| 953 |
|
| 954 |
|
| 955 |
procedure TGraphSys.SetUpCoordinateSubSystem; |
| 956 |
begin |
| 957 |
try |
| 958 |
HMulti:=(DevRect.right- DevRect.left)/(DWright-DWleft)*(VPright-VPleft)/(right-left); |
| 959 |
HShift:=DevRect.left + (VPleft-DWleft)*(DevRect.right- DevRect.left)/(DWright-DWleft); |
| 960 |
VMUlti:=(DevRect.top- DevRect.bottom)/(DWtop-DWbottom)*(VPtop-VPbottom)/(top-bottom); |
| 961 |
VShift:=DevRect.bottom + (VPbottom-DWbottom)*(DevRect.top- DevRect.bottom)/(DWtop-DWbottom); |
| 962 |
except |
| 963 |
{$IFNDEF Windows} asm finit end; set8087cw(controlword); {$ENDIF} |
| 964 |
setexception(SystemErr); |
| 965 |
end; |
| 966 |
end; |
| 967 |
|
| 968 |
function TGraphSys.virtualX(vx:integer):extended; |
| 969 |
begin |
| 970 |
virtualX:=(vx-HShift)/HMulti + left; |
| 971 |
end; |
| 972 |
|
| 973 |
function TGraphSys.VirtualY(vy:integer):extended; |
| 974 |
begin |
| 975 |
virtualY:=(vy-VShift)/VMulti + bottom; |
| 976 |
end; |
| 977 |
|
| 978 |
|
| 979 |
|
| 980 |
function TGraphSys.GWidth:extended; |
| 981 |
begin |
| 982 |
result:=DevRect.right-DevRect.Left; |
| 983 |
end; |
| 984 |
|
| 985 |
function TGraphSys.GHeight:extended; |
| 986 |
begin |
| 987 |
result:=DevRect.bottom-DevRect.top; |
| 988 |
end; |
| 989 |
|
| 990 |
|
| 991 |
procedure TGraphSys.ColorPolyGonSub(Canvas:TCanvas; const Points:array of TPoint; c:integer); |
| 992 |
var |
| 993 |
svBrushColor:TColor; |
| 994 |
svPenColor:TColor; |
| 995 |
svBrushStyle:TBrushStyle; |
| 996 |
begin |
| 997 |
if MyRgn<>0 then SelectClipRgn(Canvas.Handle,MyRgn); |
| 998 |
|
| 999 |
with Canvas do |
| 1000 |
begin |
| 1001 |
svBrushColor:=Brush.Color; |
| 1002 |
svPenColor:=Pen.Color; |
| 1003 |
svBrushStyle:=Brush.Style; |
| 1004 |
|
| 1005 |
Brush.Color:=MyPalette[c] ; |
| 1006 |
Pen.Color:=MyPalette[c] ; |
| 1007 |
pen.width:=1; //2008.1.29 |
| 1008 |
case AreaStyle of |
| 1009 |
asSolid: Brush.Style:=bsSolid; |
| 1010 |
asHollow:Brush.Style:=bsClear; |
| 1011 |
asHatch: Brush.Style:=TBrushStyle( AreaStyleIndex + 1); |
| 1012 |
end; |
| 1013 |
SetBkColor(Canvas1.Handle,MyPalette.pal[0] ); |
| 1014 |
|
| 1015 |
Polygon(Points); |
| 1016 |
|
| 1017 |
Brush.Color:=svBrushColor; |
| 1018 |
Pen.Color:=svPenColor; |
| 1019 |
Pen.Width:=LineWidth; //2008.1.29 |
| 1020 |
Brush.Style:=svBrushStyle; |
| 1021 |
end; |
| 1022 |
end; |
| 1023 |
|
| 1024 |
|
| 1025 |
|
| 1026 |
procedure TGraphSys.PolyGonSub(Canvas:TCanvas; const Points:array of TPoint); |
| 1027 |
begin |
| 1028 |
ColorPolyGonSub(Canvas,Points,areacolor) |
| 1029 |
end; |
| 1030 |
|
| 1031 |
|
| 1032 |
|
| 1033 |
|
| 1034 |
procedure TGraphSys.ColorPolyGon(const Points:array of TPoint; c:integer{���������}); |
| 1035 |
begin |
| 1036 |
ColorPolyGonSub(Canvas1,Points,c); |
| 1037 |
end; |
| 1038 |
|
| 1039 |
procedure TScreenBMPGraphSys.ColorPolyGon(const Points:array of TPoint; c:integer{���������}); |
| 1040 |
begin |
| 1041 |
ColorPolyGonSub(Canvas1,Points,c); |
| 1042 |
if not HiddenDrawMode then |
| 1043 |
ColorPolyGonSub(PaintBox1.Canvas,Points,c); |
| 1044 |
end; |
| 1045 |
|
| 1046 |
procedure TGraphSys.Polygon(const Points:array of TPoint); |
| 1047 |
begin |
| 1048 |
PolyGonSub(Canvas1,Points); |
| 1049 |
end; |
| 1050 |
|
| 1051 |
procedure TScreenBMPGraphSys.Polygon(const Points:array of TPoint); |
| 1052 |
begin |
| 1053 |
PolyGonSub(Canvas1,Points); |
| 1054 |
if not HiddenDrawMode then |
| 1055 |
PolyGonSub(PaintBox1.Canvas,Points); |
| 1056 |
end; |
| 1057 |
|
| 1058 |
|
| 1059 |
procedure TGraphSys.PolyLineSub(Canvas:TCanvas; const Points:array of TPoint); |
| 1060 |
begin |
| 1061 |
if MyRgn<>0 then SelectClipRgn(Canvas.Handle,MyRgn); |
| 1062 |
with Canvas do |
| 1063 |
PolyLine(Points); |
| 1064 |
end; |
| 1065 |
|
| 1066 |
|
| 1067 |
|
| 1068 |
procedure TGraphSys.Polyline(const Points:array of TPoint); |
| 1069 |
begin |
| 1070 |
if MyRgn<>0 then SelectClipRgn(Canvas1.Handle,MyRgn); |
| 1071 |
Canvas1.Polyline(Points); |
| 1072 |
end; |
| 1073 |
|
| 1074 |
procedure TScreenBMPGraphSys.Polyline(const Points:array of TPoint); |
| 1075 |
begin |
| 1076 |
if MyRgn<>0 then SelectClipRgn(Canvas1.Handle,MyRgn); |
| 1077 |
Canvas1.Polyline(Points); |
| 1078 |
if not HiddenDrawMode then |
| 1079 |
begin |
| 1080 |
if MyRgn<>0 then SelectClipRgn(PaintBox1.Canvas.Handle,MyRgn); |
| 1081 |
Paintbox1.Canvas.Polyline(Points); |
| 1082 |
end; |
| 1083 |
end; |
| 1084 |
|
| 1085 |
|
| 1086 |
procedure TGraphSys.SetTextHeight(const x:extended); |
| 1087 |
var |
| 1088 |
i:integer; |
| 1089 |
begin |
| 1090 |
try |
| 1091 |
{$IFDEF ver100} |
| 1092 |
i:=System.Round(abs(VMulti*x*TextHeightMulti)); |
| 1093 |
{$ELSE} |
| 1094 |
i:=LongIntRound(abs(VMulti*x*TextHeightMulti)); |
| 1095 |
{$ENDIF} |
| 1096 |
if i<=0 then i:=1; //2007.5.18��� |
| 1097 |
Canvas1.Font.height:=-i; |
| 1098 |
TextHeightChanged:=true; |
| 1099 |
|
| 1100 |
except |
| 1101 |
{$IFNDEF Windows} asm finit end; set8087cw(controlword); {$ENDIF} |
| 1102 |
end; |
| 1103 |
end; |
| 1104 |
|
| 1105 |
|
| 1106 |
|
| 1107 |
procedure TScreenBMPGraphSys.SetTextHeight(const x:extended); |
| 1108 |
begin |
| 1109 |
inherited SetTextHeight(x); |
| 1110 |
PaintBox1.Canvas.Font.height:=Canvas1.Font.height; |
| 1111 |
end; |
| 1112 |
|
| 1113 |
|
| 1114 |
function TGraphSys.GetTextHeight:extended; |
| 1115 |
begin |
| 1116 |
result:=abs(-Canvas1.Font.Height)/TextHeightMulti/abs(VMulti) |
| 1117 |
end; |
| 1118 |
|
| 1119 |
|
| 1120 |
procedure TGraphSys.SetTextFont(const name:AnsiString; size:integer); |
| 1121 |
begin |
| 1122 |
if name<>'' then |
| 1123 |
begin |
| 1124 |
Canvas1.Font.Charset:=DEFAULT_CHARSET; |
| 1125 |
Canvas1.Font.name:=name; |
| 1126 |
end; |
| 1127 |
if size>0 then |
| 1128 |
begin |
| 1129 |
Canvas1.Font.size:=size; |
| 1130 |
TextHeightChanged:=true; |
| 1131 |
end; |
| 1132 |
end; |
| 1133 |
|
| 1134 |
procedure TScreenBMPGraphSys.SetTextFont(const name:AnsiString; size:integer); |
| 1135 |
begin |
| 1136 |
inherited SetTextFont(name,size); |
| 1137 |
PaintBox1.Canvas.Font.Assign(Canvas1.Font) |
| 1138 |
end; |
| 1139 |
|
| 1140 |
|
| 1141 |
procedure SetPixel(canvas:TCanvas; a,b:integer; c:TColor); |
| 1142 |
begin |
| 1143 |
canvas.Pixels[a,b]:=c; |
| 1144 |
end; |
| 1145 |
|
| 1146 |
procedure TGraphSys.putpixel(a,b:longint); |
| 1147 |
var |
| 1148 |
c:TColor; |
| 1149 |
begin |
| 1150 |
if MyRgn<>0 then SelectClipRgn(Canvas1.Handle,MyRgn); |
| 1151 |
|
| 1152 |
c:=MyPalette[pointcolor] ; |
| 1153 |
With Canvas1 do |
| 1154 |
setPixel(Canvas1,a,b,c); |
| 1155 |
end; |
| 1156 |
|
| 1157 |
procedure TScreenBMPGraphSys.putpixel(a,b:longint); |
| 1158 |
var |
| 1159 |
c:TColor; |
| 1160 |
begin |
| 1161 |
if MyRgn<>0 then SelectClipRgn(Canvas1.Handle,MyRgn); |
| 1162 |
c:=MyPalette[pointcolor] ; |
| 1163 |
setPixel(Canvas1,a,b,c); |
| 1164 |
|
| 1165 |
if not HiddenDrawMode then |
| 1166 |
begin |
| 1167 |
if MyRgn<>0 then SelectClipRgn(PaintBox1.Canvas.Handle,MyRgn); |
| 1168 |
with PaintBox1 do |
| 1169 |
setPixel(Canvas,a,b,c); |
| 1170 |
end |
| 1171 |
end; |
| 1172 |
|
| 1173 |
|
| 1174 |
procedure TGraphSys.putColor(a,b:longint; c:integer); |
| 1175 |
var |
| 1176 |
c1:TColor; |
| 1177 |
begin |
| 1178 |
c1:=MyPalette[c] ; |
| 1179 |
SetPixel(Canvas1,a,b,c1); |
| 1180 |
end; |
| 1181 |
|
| 1182 |
procedure TScreenBMPGraphSys.putColor(a,b:longint; c:integer); //PSET������������ |
| 1183 |
var |
| 1184 |
c1:TColor; |
| 1185 |
begin |
| 1186 |
c1:=MyPalette[c] ; |
| 1187 |
SetPixel(Canvas1,a,b,c1); |
| 1188 |
if not HiddenDrawMode then |
| 1189 |
with PaintBox1 do |
| 1190 |
SetPixel(Canvas,a,b,c1); |
| 1191 |
end; |
| 1192 |
|
| 1193 |
(* |
| 1194 |
procedure TextOutRotate(Canvas: TCanvas; x, y: Integer; const s: AnsiString; a:integer); |
| 1195 |
begin |
| 1196 |
Canvas.Start; |
| 1197 |
QPainter_SetBackGroundColor(Canvas.handle, QColor(MyPalette.pal[0]) ); |
| 1198 |
QPainter_SetBackGroundMode(Canvas.handle,iBkMode); |
| 1199 |
QPainter_translate(Canvas.Handle,X,Y); |
| 1200 |
QPainter_rotate(Canvas.Handle,-a); |
| 1201 |
Canvas.TextOut(0,0,s); |
| 1202 |
QPainter_rotate(Canvas.Handle,a); |
| 1203 |
QPainter_translate(Canvas.Handle,-X,-Y); |
| 1204 |
Canvas.Stop; |
| 1205 |
end; |
| 1206 |
*) |
| 1207 |
|
| 1208 |
(* |
| 1209 |
procedure TextOutRotate(Canvas: TCanvas; x, y: Integer; const s: AnsiString; a:integer); |
| 1210 |
begin |
| 1211 |
SetBkMode(CanVas.Handle, iBkMode); |
| 1212 |
Canvas.TextOut(x,y,s) //��������������������������� |
| 1213 |
end; |
| 1214 |
*) |
| 1215 |
|
| 1216 |
procedure TextOutRotate(Canvas: TCanvas; x, y: Integer; const s: AnsiString; a:integer); |
| 1217 |
var |
| 1218 |
lfText: TLOGFONT; |
| 1219 |
hfNew, hfOld: HFONT; |
| 1220 |
begin |
| 1221 |
{$IFDEF Windows} |
| 1222 |
GetObject(Canvas.Font.Handle, sizeof(TLOGFONT), @lfText); |
| 1223 |
{$ELSE} // bug or unfinished? |
| 1224 |
with lfText do |
| 1225 |
begin |
| 1226 |
lfHeight:=Canvas.Font.Height; |
| 1227 |
lfWidth:=0; |
| 1228 |
lfEscapement := a * 10; // ������ |
| 1229 |
lfOrientation := lfEscapement; |
| 1230 |
lfWeight:=0; |
| 1231 |
lfItalic:=0; |
| 1232 |
lfUnderline:=0; |
| 1233 |
lfStrikeOut:=0; |
| 1234 |
lfCharSet:=OEM_CHARSET; |
| 1235 |
lfOutPrecision:=OUT_DEFAULT_PRECIS; |
| 1236 |
lfClipPrecision:=CLIP_DEFAULT_PRECIS; |
| 1237 |
lfQuality:=DEFAULT_QUALITY; |
| 1238 |
lfPitchAndFamily:=DEFAULT_PITCH or FF_DONTCARE; |
| 1239 |
lfFaceName:=Canvas.Font.Name; |
| 1240 |
end; |
| 1241 |
{$ENDIF} |
| 1242 |
|
| 1243 |
try |
| 1244 |
hfNew := CreateFontIndirect(lfText); //This may cause divide by zero error. |
| 1245 |
try |
| 1246 |
hfOld := SelectObject(Canvas.Handle, hfNew); |
| 1247 |
Canvas.TextOut(x, y, s); |
| 1248 |
finally |
| 1249 |
SelectObject(Canvas.Handle, hfOld); |
| 1250 |
DeleteObject(hfNew); |
| 1251 |
end; |
| 1252 |
except |
| 1253 |
Canvas.TextOut(x, y, s); |
| 1254 |
end; |
| 1255 |
end; |
| 1256 |
|
| 1257 |
|
| 1258 |
procedure TGraphSys.textoutSub(x,y:integer; const s:ansistring; angle:integer); |
| 1259 |
begin |
| 1260 |
settextcolor(textcolor); |
| 1261 |
SetBkColor(Canvas1.Handle,MyPalette.pal[0] ); |
| 1262 |
SetBkMode(Canvas1.Handle,iBkMode); |
| 1263 |
textOutRotate(Canvas1,x,y,s,Angle); |
| 1264 |
end; |
| 1265 |
|
| 1266 |
|
| 1267 |
procedure TScreenBMPGraphSys.TextOutSub(x,y:integer; const s:ansistring; angle:integer); |
| 1268 |
begin |
| 1269 |
if MyRgn<>0 then SelectClipRgn(Canvas1.Handle,MyRgn); |
| 1270 |
inherited TextOutSub(x,y,s,angle); |
| 1271 |
if not HiddenDrawMode then |
| 1272 |
begin |
| 1273 |
if MyRgn<>0 then SelectClipRgn(PaintBox1.Canvas.Handle,MyRgn); |
| 1274 |
PaintBox1.canvas.Font.assign(Canvas1.Font); //������������������������������������������ |
| 1275 |
SetBkColor(PaintBox1.Canvas.Handle,MyPalette.pal[0]); |
| 1276 |
SetBkMode(PaintBox1.canvas.Handle,iBkMode); |
| 1277 |
TextOutRotate(PaintBox1.Canvas,x,y,s,Angle); |
| 1278 |
end; |
| 1279 |
end; |
| 1280 |
|
| 1281 |
procedure TGraphSys.setlinecolor(c:integer); |
| 1282 |
var |
| 1283 |
col:TColor; |
| 1284 |
begin |
| 1285 |
LineBuffFlush; |
| 1286 |
linecolor:=c; |
| 1287 |
col:=MyPalette[c] ; |
| 1288 |
Canvas1.pen.color:=col; |
| 1289 |
end; |
| 1290 |
|
| 1291 |
procedure TScreenBMPGraphSys.setlinecolor(c:integer); |
| 1292 |
begin |
| 1293 |
inherited setlinecolor(c); |
| 1294 |
PaintBox1.canvas.pen.color:=MyPalette[c]; |
| 1295 |
end; |
| 1296 |
|
| 1297 |
procedure TGraphSys.settextcolor(c:integer); |
| 1298 |
begin |
| 1299 |
textcolor:=c; |
| 1300 |
Canvas1.Font.Color:=MyPalette[textcolor] ; |
| 1301 |
end; |
| 1302 |
|
| 1303 |
procedure TScreenBMPGraphSys.settextcolor(c:integer); |
| 1304 |
begin |
| 1305 |
inherited settextcolor(c); |
| 1306 |
PaintBox1.canvas.Font.Color:=MyPalette[textcolor] ; |
| 1307 |
end; |
| 1308 |
|
| 1309 |
procedure TGraphSys.SetPenStyle(ps:TPenStyle); |
| 1310 |
begin |
| 1311 |
LineBuffFlush; |
| 1312 |
PenStyle:=ps; |
| 1313 |
Canvas1.pen.style:=ps; |
| 1314 |
end; |
| 1315 |
|
| 1316 |
procedure TScreenBMPGraphSys.SetPenStyle(ps:TPenStyle); |
| 1317 |
begin |
| 1318 |
inherited SetPenStyle(ps); |
| 1319 |
paintbox1.canvas.pen.style:=ps; |
| 1320 |
end; |
| 1321 |
|
| 1322 |
procedure TGraphSys.setlinewidth(c:integer); |
| 1323 |
begin |
| 1324 |
LineBuffFlush; |
| 1325 |
Canvas1.pen.width:=c; |
| 1326 |
LineWidth:=c; |
| 1327 |
end; |
| 1328 |
|
| 1329 |
procedure TScreenBMPGraphSys.setlinewidth(c:integer); |
| 1330 |
begin |
| 1331 |
inherited setlinewidth(c); |
| 1332 |
paintbox1.canvas.pen.width:=c; |
| 1333 |
end; |
| 1334 |
|
| 1335 |
procedure TGraphSys.SetRasterMode(b:TPenMode); |
| 1336 |
begin |
| 1337 |
Canvas1.Pen.Mode:=b; |
| 1338 |
end; |
| 1339 |
|
| 1340 |
procedure TScreenBMPGraphSys.SetRasterMode(b:TPenMode); |
| 1341 |
begin |
| 1342 |
Canvas1.Pen.Mode:=b; |
| 1343 |
PaintBox1.Canvas.Pen.Mode:=b; |
| 1344 |
end; |
| 1345 |
|
| 1346 |
procedure TGraphSys.setHiddenDrawMode(b:boolean); |
| 1347 |
begin |
| 1348 |
//HiddenDrawMode:=b ; |
| 1349 |
//if b then setexception(9102); |
| 1350 |
end; |
| 1351 |
|
| 1352 |
procedure TScreenBMPGraphSys.setHiddenDrawMode(b:boolean); |
| 1353 |
begin |
| 1354 |
HiddenDrawMode:=b ; |
| 1355 |
if not b then |
| 1356 |
{$IFDEF TimerDraw} |
| 1357 |
//ThinRepaint; |
| 1358 |
begin |
| 1359 |
Set8087cw($133F); |
| 1360 |
PaintBox1.repaint; |
| 1361 |
Application.processMessages; |
| 1362 |
Set8087CW(controlword); |
| 1363 |
end; |
| 1364 |
{$ELSE} |
| 1365 |
begin |
| 1366 |
SelectClipRgn(PaintBox1.Canvas.Handle,0); |
| 1367 |
PaintBox1.Canvas.Draw(0,0,BitMap1); |
| 1368 |
SelectClipRgn(PaintBox1.Canvas.Handle,MyRgn); |
| 1369 |
end; |
| 1370 |
{$ENDIF} |
| 1371 |
|
| 1372 |
end; |
| 1373 |
|
| 1374 |
var |
| 1375 |
ShrinkRange: procedure(var lx,ly,vx,vy:longint); |
| 1376 |
|
| 1377 |
procedure ShrinkRange9x(var lx,ly,vx,vy:longint); |
| 1378 |
var |
| 1379 |
x,x1,x2,y,y1,y2: double; |
| 1380 |
begin |
| 1381 |
x1:=lx;y1:=ly;x2:=vx;y2:=vy; |
| 1382 |
if abs(x2-x1)>=16364 then |
| 1383 |
begin |
| 1384 |
if x2<x1 then |
| 1385 |
begin |
| 1386 |
x:=x1; x1:=x2; x2:=x; y:=y1; y1:=y2; y2:=y; |
| 1387 |
end; |
| 1388 |
if (x1<-8192) then |
| 1389 |
begin |
| 1390 |
x:=-8192;y:=round((y2-y1)/(x2-x1)*(x-x1)+y1); |
| 1391 |
x1:=x;y1:=y |
| 1392 |
end; |
| 1393 |
if (x2>8192) then |
| 1394 |
begin |
| 1395 |
x:=8192;y:=round((y2-y1)/(x2-x1)*(x-x2)+y2); |
| 1396 |
x2:=x;y2:=y |
| 1397 |
end; |
| 1398 |
end; |
| 1399 |
if abs(y2-y1)>=16364 then |
| 1400 |
begin |
| 1401 |
if y2<y1 then |
| 1402 |
begin |
| 1403 |
x:=x1; x1:=x2; x2:=x; y:=y1; y1:=y2; y2:=y; |
| 1404 |
end; |
| 1405 |
if (y1<-8192) then |
| 1406 |
begin |
| 1407 |
y:=-8192;x:=round((x2-x1)/(y2-y1)*(y-y1)+x1); |
| 1408 |
y1:=y;x1:=x |
| 1409 |
end; |
| 1410 |
if (y2>8192) then |
| 1411 |
begin |
| 1412 |
y:=8192;x:=round((x2-x1)/(y2-y1)*(y-y2)+x2); |
| 1413 |
y2:=y;x2:=x |
| 1414 |
end; |
| 1415 |
end; |
| 1416 |
lx:=round(x1); |
| 1417 |
ly:=round(y1); |
| 1418 |
vx:=round(x2); |
| 1419 |
vy:=round(y2); |
| 1420 |
end; |
| 1421 |
|
| 1422 |
procedure ShrinkRangeNT(var lx,ly,vx,vy:longint); |
| 1423 |
var |
| 1424 |
x,x1,x2,y,y1,y2: double; |
| 1425 |
begin |
| 1426 |
x1:=lx;y1:=ly;x2:=vx;y2:=vy; |
| 1427 |
if abs(x2-x1)>=67108864 then |
| 1428 |
begin |
| 1429 |
if x2<x1 then |
| 1430 |
begin |
| 1431 |
x:=x1; x1:=x2; x2:=x; y:=y1; y1:=y2; y2:=y; |
| 1432 |
end; |
| 1433 |
if (x1<-67108864) then |
| 1434 |
begin |
| 1435 |
x:=-67108864;y:=round((y2-y1)/(x2-x1)*(x-x1)+y1); |
| 1436 |
x1:=x;y1:=y |
| 1437 |
end; |
| 1438 |
if (x2>67108864) then |
| 1439 |
begin |
| 1440 |
x:=67108864;y:=round((y2-y1)/(x2-x1)*(x-x2)+y2); |
| 1441 |
x2:=x;y2:=y |
| 1442 |
end; |
| 1443 |
end; |
| 1444 |
if abs(y2-y1)>=67108864 then |
| 1445 |
begin |
| 1446 |
if y2<y1 then |
| 1447 |
begin |
| 1448 |
x:=x1; x1:=x2; x2:=x; y:=y1; y1:=y2; y2:=y; |
| 1449 |
end; |
| 1450 |
if (y1<-67108864) then |
| 1451 |
begin |
| 1452 |
y:=-67108864;x:=round((x2-x1)/(y2-y1)*(y-y1)+x1); |
| 1453 |
y1:=y;x1:=x |
| 1454 |
end; |
| 1455 |
if (y2>67108864) then |
| 1456 |
begin |
| 1457 |
y:=67108864;x:=round((x2-x1)/(y2-y1)*(y-y2)+x2); |
| 1458 |
y2:=y;x2:=x |
| 1459 |
end; |
| 1460 |
end; |
| 1461 |
lx:=round(x1); |
| 1462 |
ly:=round(y1); |
| 1463 |
vx:=round(x2); |
| 1464 |
vy:=round(y2); |
| 1465 |
end; |
| 1466 |
|
| 1467 |
|
| 1468 |
type |
| 1469 |
longrec=record |
| 1470 |
low:word; |
| 1471 |
high:smallint; |
| 1472 |
end; |
| 1473 |
|
| 1474 |
function iabs(n:longint):longint; |
| 1475 |
begin |
| 1476 |
if n>=0 then |
| 1477 |
iabs:=n |
| 1478 |
else |
| 1479 |
iabs:=-n; |
| 1480 |
end; |
| 1481 |
procedure TGraphSys.SegmentWinSub(Canvas:TCanvas; x1,y1,x2,y2:integer); |
| 1482 |
var |
| 1483 |
P:array[0..1]of TPoint; |
| 1484 |
begin |
| 1485 |
P[0].X:=x2; |
| 1486 |
P[0].Y:=y2; |
| 1487 |
P[1].X:=x1; |
| 1488 |
P[1].Y:=y1; |
| 1489 |
PolyLinesub(Canvas, P); |
| 1490 |
end; |
| 1491 |
|
| 1492 |
procedure TGraphSys.SegmentWin(Canvas:TCanvas; x1,y1,x2,y2:integer); |
| 1493 |
// ������������������������������������ |
| 1494 |
begin |
| 1495 |
if PenStyle<>psSolid then SetBkMode(Canvas.Handle,TRANSPARENT); |
| 1496 |
if (x1=x2) and (y1=y2) then |
| 1497 |
SetPixel(Canvas,x1,y1,Canvas.pen.color) |
| 1498 |
else |
| 1499 |
begin |
| 1500 |
if ( ((longrec(x1).high+1) shr 1) |
| 1501 |
or ((longrec(y1).high+1) shr 1) |
| 1502 |
or ((longrec(x2).high+1) shr 1) |
| 1503 |
or ((longrec(y2).high+1) shr 1) =0) |
| 1504 |
and (iabs(x2-x1)<16384) and (iabs(y2-y1)<16384) then |
| 1505 |
else |
| 1506 |
ShrinkRange(x1,y1,x2,y2); |
| 1507 |
if (PenStyle=psSolid) |
| 1508 |
or not GeometricPenOnly |
| 1509 |
and ((linewidth=1) and (SetBkMode(Canvas.Handle,TRANSPARENT)<>0)) |
| 1510 |
then |
| 1511 |
begin |
| 1512 |
Canvas.MoveTo(restrict(x2),restrict(y2)); |
| 1513 |
Canvas.LineTo(restrict(x1),restrict(y1)) |
| 1514 |
end |
| 1515 |
else |
| 1516 |
SegmentWinSub(Canvas,x1,y1,x2,y2) |
| 1517 |
end; |
| 1518 |
end; |
| 1519 |
|
| 1520 |
procedure TGraphSys.segment(x1,y1,x2,y2:integer); |
| 1521 |
begin |
| 1522 |
if ForwardPLot then |
| 1523 |
SegmentForward(Canvas1,x1,y1,x2,y2) |
| 1524 |
else |
| 1525 |
SegmentWin(Canvas1,x1,y1,x2,y2) |
| 1526 |
end; |
| 1527 |
|
| 1528 |
procedure TScreenBMPGraphSys.segment(x1,y1,x2,y2:integer); |
| 1529 |
begin |
| 1530 |
if MyRgn<>0 then SelectClipRgn(Canvas1.Handle,MyRgn); |
| 1531 |
SegmentWin(Canvas1,x1,y1,x2,y2); |
| 1532 |
if not HiddenDrawMode then |
| 1533 |
begin |
| 1534 |
if MyRgn<>0 then SelectClipRgn(PaintBox1.Canvas.Handle,MyRgn); |
| 1535 |
SegmentWin(PaintBox1.Canvas, x1,y1,x2,y2) |
| 1536 |
end; |
| 1537 |
end; |
| 1538 |
|
| 1539 |
|
| 1540 |
procedure TGraphSys.SegmentForward(Canvas:TCanvas; x1,y1,x2,y2:integer); |
| 1541 |
// ������������������������������������ |
| 1542 |
begin |
| 1543 |
if MyRgn<>0 then SelectClipRgn(Canvas1.Handle,MyRgn); |
| 1544 |
if not beam then //if (x1=x2) and (y1=y2) then |
| 1545 |
begin |
| 1546 |
Canvas.MoveTo(restrict(x2),restrict(y2)); |
| 1547 |
SetPixel(Canvas,x2,y2,Canvas.pen.color); |
| 1548 |
end |
| 1549 |
else if PenStyle<>psSolid then |
| 1550 |
SegmentWinSub(Canvas,x2,y2,x1,y1) |
| 1551 |
else |
| 1552 |
begin |
| 1553 |
Canvas.LineTo(restrict(x2),restrict(y2)) |
| 1554 |
end; |
| 1555 |
end; |
| 1556 |
|
| 1557 |
|
| 1558 |
|
| 1559 |
procedure TGraphSys.plotto(x,y: extended); |
| 1560 |
var |
| 1561 |
x1,x2,y1,y2:integer; |
| 1562 |
begin |
| 1563 |
x2:=deviceX(x); |
| 1564 |
y2:=deviceY(y); |
| 1565 |
if PenStyle=psSolid then |
| 1566 |
begin |
| 1567 |
if beam then |
| 1568 |
begin |
| 1569 |
x1:=latex; |
| 1570 |
y1:=latey |
| 1571 |
end |
| 1572 |
else |
| 1573 |
begin |
| 1574 |
x1:=x2; |
| 1575 |
y1:=y2 |
| 1576 |
end; |
| 1577 |
segment(x1,y1,x2,y2); |
| 1578 |
end |
| 1579 |
else |
| 1580 |
begin |
| 1581 |
if beam and (LineBuffCount=0) then |
| 1582 |
StyledLine(latex,latey); |
| 1583 |
StyledLine(x2,y2); |
| 1584 |
end; |
| 1585 |
latex:=x2; |
| 1586 |
latey:=y2; |
| 1587 |
beam:=true; |
| 1588 |
end; |
| 1589 |
|
| 1590 |
procedure TGraphSys.StyledLine(x2,y2:integer); |
| 1591 |
begin |
| 1592 |
if LineBuff=nil then New(LineBuff); |
| 1593 |
if LineBuffCount>High(TLineBuff) then LineBuffFlush; |
| 1594 |
with LineBuff^[LineBuffCount] do |
| 1595 |
begin x:=x2; y:=y2 end; |
| 1596 |
inc(LineBuffCount); |
| 1597 |
end; |
| 1598 |
|
| 1599 |
procedure TGraphSys.LineBuffFlush; |
| 1600 |
begin |
| 1601 |
if LineBuffCount>0 then |
| 1602 |
begin |
| 1603 |
PolyLine(Slice(LineBuff^, LineBuffCount)); |
| 1604 |
LineBuffCount:=0 |
| 1605 |
end; |
| 1606 |
end; |
| 1607 |
|
| 1608 |
procedure TGraphSys.setBeam(t:boolean); |
| 1609 |
begin |
| 1610 |
if t=false then |
| 1611 |
LineBuffFlush; |
| 1612 |
beam0:=t; |
| 1613 |
end; |
| 1614 |
|
| 1615 |
|
| 1616 |
procedure LineSub(Canvas:TCanvas; a1,b1,a2,b2:integer; cl:TColor; ps:TPenStyle; w:integer); |
| 1617 |
var |
| 1618 |
svPenColor:TColor; |
| 1619 |
svPenStyle:TPenstyle; |
| 1620 |
svWidth:integer; |
| 1621 |
svBrushColor:TColor; |
| 1622 |
begin |
| 1623 |
with Canvas do |
| 1624 |
begin |
| 1625 |
svPenColor:=Pen.Color; |
| 1626 |
svPenStyle:=Pen.Style; |
| 1627 |
svWidth:=Pen.Width; |
| 1628 |
svBrushColor:=Brush.Color; |
| 1629 |
Pen.Color:=cl; |
| 1630 |
Pen.Style:=ps; |
| 1631 |
Pen.Width:=w; |
| 1632 |
Brush.Color:=MyPalette.pal[0]; |
| 1633 |
moveto(a1,b1); |
| 1634 |
lineto(a2,b2); |
| 1635 |
SetPixel(Canvas,a2,b2,cl); |
| 1636 |
Pen.Color:=svPenColor; |
| 1637 |
Pen.Style:=svPenStyle; |
| 1638 |
Pen.Width:=svWidth; |
| 1639 |
end; |
| 1640 |
end; |
| 1641 |
|
| 1642 |
procedure TGraphSys.line(a1,b1,a2,b2:integer; c:integer; ps:TPenStyle; w:integer); |
| 1643 |
var |
| 1644 |
cl:TColor; |
| 1645 |
begin |
| 1646 |
cl:=MyPalette[c] ; |
| 1647 |
LineSub(CanVas1,a1,b1,a2,b2,cl,ps,w) |
| 1648 |
end; |
| 1649 |
|
| 1650 |
procedure TScreenBMPGraphSys.line(a1,b1,a2,b2:integer; c:integer; ps:TPenStyle; w:integer); |
| 1651 |
var |
| 1652 |
cl:TColor; |
| 1653 |
begin |
| 1654 |
if MyRgn<>0 then SelectClipRgn(Canvas1.Handle,MyRgn); |
| 1655 |
cl:=MyPalette[c] ; |
| 1656 |
LineSub(CanVas1,a1,b1,a2,b2,cl,ps,w); |
| 1657 |
if not HiddenDrawMode then |
| 1658 |
begin |
| 1659 |
if MyRgn<>0 then SelectClipRgn(PaintBox1.Canvas.Handle,MyRgn); |
| 1660 |
LineSub(PaintBox1.CanVas,a1,b1,a2,b2,cl,ps,w); |
| 1661 |
end; |
| 1662 |
|
| 1663 |
end; |
| 1664 |
|
| 1665 |
|
| 1666 |
procedure TGraphSys.putmark0(a,b:integer); |
| 1667 |
procedure put(dx,dy:integer); |
| 1668 |
begin |
| 1669 |
putPixel(a+dx,b+dy) |
| 1670 |
end; |
| 1671 |
begin |
| 1672 |
case pointstyle of |
| 1673 |
1: {���} |
| 1674 |
put(0,0); |
| 1675 |
2: {+} |
| 1676 |
begin |
| 1677 |
put(0,0); |
| 1678 |
put(0,1); |
| 1679 |
put(0,2); |
| 1680 |
put(0,-1); |
| 1681 |
put(0 , -2); |
| 1682 |
put( -1,0 ); |
| 1683 |
put( +1,0 ); |
| 1684 |
put( -2,0 ); |
| 1685 |
put( +2,0 ); |
| 1686 |
end; |
| 1687 |
3: {*} |
| 1688 |
begin |
| 1689 |
put(0 ,0 ) ; |
| 1690 |
put(0 , +1); |
| 1691 |
put(0 , +2); |
| 1692 |
put(0 , -1); |
| 1693 |
put(0 , -2); |
| 1694 |
put( -1, 0); |
| 1695 |
put( +1, 0); |
| 1696 |
put( -2, +1); |
| 1697 |
put( -2, -1); |
| 1698 |
put( +2, +1); |
| 1699 |
put( +2, -1); |
| 1700 |
end; |
| 1701 |
4: {o} |
| 1702 |
begin |
| 1703 |
put( +2, -1); |
| 1704 |
put( +2, 0 ); |
| 1705 |
put( +2, +1); |
| 1706 |
put( -2, -1); |
| 1707 |
put( -2, 0 ); |
| 1708 |
put( -2, +1); |
| 1709 |
put( -1, +2); |
| 1710 |
put( 0 , +2); |
| 1711 |
put( +1, +2); |
| 1712 |
put( -1, -2); |
| 1713 |
put( 0 , -2); |
| 1714 |
put( +1, -2); |
| 1715 |
end; |
| 1716 |
5: {x} |
| 1717 |
begin |
| 1718 |
put( 0, 0) ; |
| 1719 |
put( -1, +1); |
| 1720 |
put( -2, +2); |
| 1721 |
put( -1, -1); |
| 1722 |
put( -2, -2); |
| 1723 |
put( +1, +1); |
| 1724 |
put( +2, +2); |
| 1725 |
put( +1, -1); |
| 1726 |
put( +2, -2); |
| 1727 |
end; |
| 1728 |
6: {���} |
| 1729 |
begin |
| 1730 |
put( +1, +1); |
| 1731 |
put( +1, 0); |
| 1732 |
put( +1, -1); |
| 1733 |
put( 0, +1); |
| 1734 |
put( 0, 0); |
| 1735 |
put( 0, -1); |
| 1736 |
put( -1, +1); |
| 1737 |
put( -1, 0); |
| 1738 |
put( -1, -1); |
| 1739 |
end; |
| 1740 |
7: {���} |
| 1741 |
begin |
| 1742 |
put( +2, +1); |
| 1743 |
put( +2, 0); |
| 1744 |
put( +2, -1); |
| 1745 |
put( +1, +2); |
| 1746 |
put( +1, +1); |
| 1747 |
put( +1, 0); |
| 1748 |
put( +1, -1); |
| 1749 |
put( +1, -2); |
| 1750 |
put( 0, +2); |
| 1751 |
put( 0, +1); |
| 1752 |
put( 0, 0); |
| 1753 |
put( 0, -1); |
| 1754 |
put( 0, -2); |
| 1755 |
put( -1, +2); |
| 1756 |
put( -1, +1); |
| 1757 |
put( -1, 0); |
| 1758 |
put( -1, -1); |
| 1759 |
put( -1, -2); |
| 1760 |
put( -2, +1); |
| 1761 |
put( -2, 0); |
| 1762 |
put( -2, -1); |
| 1763 |
end; |
| 1764 |
end; |
| 1765 |
end; |
| 1766 |
|
| 1767 |
|
| 1768 |
procedure TGraphSys.putMark(x,y:extended); |
| 1769 |
var |
| 1770 |
i,j:integer; |
| 1771 |
begin |
| 1772 |
//PutMark0(restrict(deviceX(x)),restrict(deviceY(y))); |
| 1773 |
if ConvToDeviceX(x,i) and ConvToDeviceY(y,j) then //2009.6.22 |
| 1774 |
PutMark0(i,j) |
| 1775 |
end; |
| 1776 |
|
| 1777 |
type |
| 1778 |
PPointlist=^pointlist; |
| 1779 |
pointlist=record |
| 1780 |
size :integer; |
| 1781 |
count:integer; |
| 1782 |
list:array[0..8190] of integer; |
| 1783 |
end; |
| 1784 |
|
| 1785 |
function newlist(n:integer):PPointlist; |
| 1786 |
begin |
| 1787 |
GetMem(Pointer(result),sizeof(integer)*(2+n)); |
| 1788 |
result^.size:=n; |
| 1789 |
result^.count:=0; |
| 1790 |
end; |
| 1791 |
|
| 1792 |
procedure disposelist(p:PPointlist); |
| 1793 |
begin |
| 1794 |
if p<>nil then FreeMem(pointer(p),sizeof(integer)*(2+p^.size)) |
| 1795 |
end; |
| 1796 |
|
| 1797 |
procedure insertlist(p:PPointList;n:integer); |
| 1798 |
var |
| 1799 |
i,k:integer; |
| 1800 |
begin |
| 1801 |
with p^ do |
| 1802 |
begin |
| 1803 |
k:=0; |
| 1804 |
while (k<count) and (list[k]<n) do inc(k); |
| 1805 |
for i:=count-1 downto k do list[i+1]:=list[i]; |
| 1806 |
list[k]:=n; |
| 1807 |
inc(count); |
| 1808 |
end; |
| 1809 |
end; |
| 1810 |
|
| 1811 |
procedure TGraphSys.GetPoint(var a,b:integer); |
| 1812 |
begin |
| 1813 |
Setexception(11140); |
| 1814 |
end; |
| 1815 |
|
| 1816 |
procedure TGraphSys.MoveMouse(a,b:integer); |
| 1817 |
begin |
| 1818 |
end; |
| 1819 |
|
| 1820 |
procedure TGraphSys.MousePol(var a,b:integer; var l,r:boolean); |
| 1821 |
begin |
| 1822 |
Setexception(11140); |
| 1823 |
end; |
| 1824 |
|
| 1825 |
procedure TScreenBMPGraphSys.GetPoint(var a,b:integer); |
| 1826 |
begin |
| 1827 |
PaintForm.GetPoint(a,b) |
| 1828 |
end; |
| 1829 |
|
| 1830 |
procedure TScreenBMPGraphSys.MoveMouse(a,b:integer); |
| 1831 |
begin |
| 1832 |
PaintForm.MoveMouse(a,b) |
| 1833 |
end; |
| 1834 |
|
| 1835 |
procedure TScreenBMPGraphSys.MousePol(var a,b:integer; var l,r:boolean); |
| 1836 |
begin |
| 1837 |
PaintForm.MousePol(a,b,l,r) |
| 1838 |
end; |
| 1839 |
|
| 1840 |
function TGraphSys.ColorIndexOf(a,b:integer):integer; |
| 1841 |
begin |
| 1842 |
ColorIndexOf:=MyPalette.ColorIndex(Canvas1.Pixels[a,b]); |
| 1843 |
end; |
| 1844 |
|
| 1845 |
type TColorRec=packed record |
| 1846 |
red,green,blue, spare:byte |
| 1847 |
end; |
| 1848 |
|
| 1849 |
|
| 1850 |
type TBMPRec=packed record |
| 1851 |
blue,green,red, spare:byte |
| 1852 |
end; |
| 1853 |
|
| 1854 |
|
| 1855 |
(* |
| 1856 |
function TScreenBMPGraphSys.ColorIndexOf(a,b:integer):integer; |
| 1857 |
var |
| 1858 |
PBMPrec:^TBMPRec; |
| 1859 |
BMPRec:TBMPRec; |
| 1860 |
Color:TColor; |
| 1861 |
begin |
| 1862 |
PBMPrec:=BitMap1.ScanLine[b] ; |
| 1863 |
inc(Cardinal(PBMPrec), 4*a); |
| 1864 |
BMPRec:=PBMPrec^; |
| 1865 |
TColorRec(Color).red:=BMPrec.red; |
| 1866 |
TColorRec(Color).green:=BMPrec.green; |
| 1867 |
TColorRec(Color).blue:=BMPrec.blue; |
| 1868 |
ColorIndexOf:=MyPalette.ColorIndex(color and $FFFFFF); |
| 1869 |
end; |
| 1870 |
*) |
| 1871 |
|
| 1872 |
function TGraphSys.setcolormode(s:ansistring):boolean; |
| 1873 |
begin |
| 1874 |
result:=true; |
| 1875 |
s:=AnsiUpperCase(s); |
| 1876 |
if s='NATIVE' then |
| 1877 |
if MyPalette.PaletteDisabled=false then |
| 1878 |
begin |
| 1879 |
MyPalette.PaletteDisabled:=true; |
| 1880 |
PointColor:=MyPalette.pal[PointColor] and $ffffff; |
| 1881 |
SetLineColor(MyPalette.pal[lineColor] and $ffffff); |
| 1882 |
AreaColor:=MyPalette.pal[AreaColor] and $ffffff; |
| 1883 |
SetTextColor(MyPalette.pal[textColor] and $ffffff); |
| 1884 |
axescolor:=MyPalette.pal[15] and $ffffff; |
| 1885 |
end |
| 1886 |
else |
| 1887 |
else if s='REGULAR' then |
| 1888 |
if MyPalette.PaletteDisabled=true then |
| 1889 |
begin |
| 1890 |
MyPalette.PaletteDisabled:=false; |
| 1891 |
PointColor:=1; |
| 1892 |
SetLineColor(1); |
| 1893 |
AreaColor:=1; |
| 1894 |
SetTextColor(1); |
| 1895 |
axescolor:=axescolor0 |
| 1896 |
end |
| 1897 |
else |
| 1898 |
else |
| 1899 |
result:=false; |
| 1900 |
end; |
| 1901 |
|
| 1902 |
function TGraphSys.AskColorMode:Ansistring; |
| 1903 |
begin |
| 1904 |
if MyPalette.PaletteDisabled then |
| 1905 |
Result:='NATIVE' |
| 1906 |
else |
| 1907 |
Result:='REGULAR' |
| 1908 |
end; |
| 1909 |
|
| 1910 |
procedure TGraphSys.OpenFile(FileName: string); |
| 1911 |
begin |
| 1912 |
setexception(9102) |
| 1913 |
end; |
| 1914 |
|
| 1915 |
procedure TScreenBMPGraphSys.OpenFile(FileName: string); |
| 1916 |
begin |
| 1917 |
PaintForm.OpenFile(FileName) |
| 1918 |
end; |
| 1919 |
|
| 1920 |
procedure TScreenBMPGraphSys.saveBMPFile(FileName: string); |
| 1921 |
begin |
| 1922 |
PaintForm.saveFile(FileName) |
| 1923 |
end; |
| 1924 |
|
| 1925 |
procedure TScreenBMPGraphSys.SaveFileFormat(FileName: string; pf:TPixelFormat); |
| 1926 |
begin |
| 1927 |
PaintForm.SaveFileFormat(FileName, pf) |
| 1928 |
end; |
| 1929 |
|
| 1930 |
procedure TScreenBMPGraphSys.SaveJpegFile(FileName:string; p:integer); |
| 1931 |
begin |
| 1932 |
PaintForm.SaveJpegFile(FileName, p) |
| 1933 |
end; |
| 1934 |
|
| 1935 |
procedure TScreenBMPGraphSys.SaveGifFile(FileName:string); |
| 1936 |
begin |
| 1937 |
PaintForm.SaveGifFile(FileName) |
| 1938 |
end; |
| 1939 |
|
| 1940 |
|
| 1941 |
|
| 1942 |
|
| 1943 |
|
| 1944 |
procedure TGraphSys.saveBMPFile(FileName: string); |
| 1945 |
begin |
| 1946 |
setexception(9102) |
| 1947 |
end; |
| 1948 |
|
| 1949 |
procedure TGraphSys.SaveFileFormat(FileName: string; pf:TPixelFormat); |
| 1950 |
begin |
| 1951 |
setexception(9102) |
| 1952 |
end; |
| 1953 |
|
| 1954 |
procedure TGraphSys.SaveJpegFile(FileName:string; p:integer); |
| 1955 |
begin |
| 1956 |
setexception(9102) |
| 1957 |
end; |
| 1958 |
|
| 1959 |
procedure TGraphSys.SaveGifFile(FileName:string); |
| 1960 |
begin |
| 1961 |
setexception(9102) |
| 1962 |
end; |
| 1963 |
|
| 1964 |
procedure TGraphSys.SaveEMFFile(FileName:string); |
| 1965 |
begin |
| 1966 |
setexception(9102) |
| 1967 |
end; |
| 1968 |
|
| 1969 |
procedure TGraphSys.SetBitmapSize(w,h:integer); |
| 1970 |
begin |
| 1971 |
setexception(9102) |
| 1972 |
end; |
| 1973 |
|
| 1974 |
procedure TScreenBMPGraphSys.SetBitmapSize(w,h:integer); |
| 1975 |
begin |
| 1976 |
PaintForm.SetBitmapSize(w,h) ; |
| 1977 |
end; |
| 1978 |
|
| 1979 |
|
| 1980 |
procedure rotate(var x,y:integer; a:integer); |
| 1981 |
var |
| 1982 |
xx,yy,c,s:single; |
| 1983 |
begin |
| 1984 |
c:=cos(a*PI/180); |
| 1985 |
s:=sin(a*Pi/180); |
| 1986 |
xx:=x*c + y*s; |
| 1987 |
yy:=y*c - x*s; |
| 1988 |
x:=System.Round(xx); |
| 1989 |
y:=System.Round(yy); |
| 1990 |
end; |
| 1991 |
|
| 1992 |
procedure TGraphSys.TextOut(x,y:integer; const s:ansistring; angle:integer); |
| 1993 |
var |
| 1994 |
dx,dy:integer; |
| 1995 |
begin |
| 1996 |
case Hjustify of |
| 1997 |
tjLEFT: dx:=1; |
| 1998 |
tjCENTER:dx:=-(textwidth(s) div 2); |
| 1999 |
tjRIGHT: dx:=-textwidth(s); |
| 2000 |
end; |
| 2001 |
case Vjustify of |
| 2002 |
tjTOP: dy:=1; |
| 2003 |
tjCAP: dy:=-(textheight(s) div 8); |
| 2004 |
tjHALF: dy:=-(textheight(s) div 2); |
| 2005 |
tjBASE: dy:=-(textheight(s)*7 div 8); |
| 2006 |
tjBOTTOM:dy:=-textheight(s); |
| 2007 |
end; |
| 2008 |
Rotate(dx,dy,angle); |
| 2009 |
x:=x+dx; |
| 2010 |
y:=y+dy; |
| 2011 |
TextOutSub(x,y,s,angle); |
| 2012 |
end; |
| 2013 |
|
| 2014 |
procedure TGraphSys.PutText(const n,m:Extended; const s:string); |
| 2015 |
var |
| 2016 |
x,y:integer; |
| 2017 |
begin |
| 2018 |
//x:=restrict(deviceX(n)); |
| 2019 |
//y:=restrict(deviceY(m)); |
| 2020 |
if ConvToDeviceX(n,x) and ConvToDeviceY(m,y) then //2009.6.22 |
| 2021 |
TextOut(x,y,s,textangle); |
| 2022 |
end; |
| 2023 |
|
| 2024 |
function YMulti(const x0,y0:extended):double; |
| 2025 |
var |
| 2026 |
x,y,r,dx,dy:extended; |
| 2027 |
begin |
| 2028 |
if CurrentTransForm=nil then |
| 2029 |
result:=1 |
| 2030 |
else |
| 2031 |
with CurrentTransform do |
| 2032 |
begin |
| 2033 |
x := x0*xx + y0*xy + xo; |
| 2034 |
y := x0*yx + y0*yy + yo; |
| 2035 |
r := x0*ox + y0*oy + oo; |
| 2036 |
dx:=xy/r - x*oy/r/r; // x���y0������������������������ |
| 2037 |
dy:=yy/r - y*oy/r/r; // y���y0��������������������������� |
| 2038 |
result:=Sqrt(sqr(dx)+sqr(dy)) |
| 2039 |
end; |
| 2040 |
end; |
| 2041 |
|
| 2042 |
function TGraphSys.xdirection(const x0, y0:extended):integer; |
| 2043 |
var |
| 2044 |
x,y,r,dx,dy:extended; |
| 2045 |
begin |
| 2046 |
if CurrentTransform=nil then |
| 2047 |
result:=0 |
| 2048 |
else |
| 2049 |
try |
| 2050 |
with CurrentTransform do |
| 2051 |
begin |
| 2052 |
x := x0*xx + y0*xy + xo; |
| 2053 |
y := x0*yx + y0*yy + yo; |
| 2054 |
r := x0*ox + y0*oy + oo; |
| 2055 |
dx:=xx/r - x*ox/r/r; // x���x0������������������������ |
| 2056 |
dy:=yx/r - y*ox/r/r; // y���x0��������������������������� |
| 2057 |
result:=System.Round(ArcTan2(dy*(-VMulti), dx*HMulti)*180/pi) |
| 2058 |
end |
| 2059 |
except |
| 2060 |
{$IFNDEF Windows} asm finit end; set8087cw(controlword); {$ENDIF} |
| 2061 |
result:=0 |
| 2062 |
end; |
| 2063 |
end; |
| 2064 |
|
| 2065 |
procedure TGraphSys.GraphText(const n,m:Extended; const s:string); |
| 2066 |
begin |
| 2067 |
if TextProblemCoordinate then |
| 2068 |
ProjectiveText(n,m,s,false) |
| 2069 |
else |
| 2070 |
PutText(n,m,s) |
| 2071 |
end; |
| 2072 |
|
| 2073 |
procedure TGraphSys.PlotText(const n,m:Extended; const s:string); |
| 2074 |
begin |
| 2075 |
if (CurrentTransForm<>nil) |
| 2076 |
and not (currentTransform.IsSimilarPositive and (ABS(1+VMulti/HMulti)<1e-2)) |
| 2077 |
or TextProblemCoordinate then |
| 2078 |
ProjectiveText(n,m,s,true) |
| 2079 |
else |
| 2080 |
PlotLetters(n,m,s) |
| 2081 |
end; |
| 2082 |
|
| 2083 |
procedure TGraphSys.PlotLetters(const n,m:Extended; const s:string); |
| 2084 |
var |
| 2085 |
x,y:integer; |
| 2086 |
svTextHeight:extended; |
| 2087 |
begin |
| 2088 |
svTextHeight:=gettextheight; |
| 2089 |
if TextHeightChanged then |
| 2090 |
setTextHeight(svTextHeight*ymulti(n,m)); |
| 2091 |
//x:=restrict(deviceX(n)); |
| 2092 |
//y:=restrict(deviceY(m)); |
| 2093 |
if ConvToDeviceX(n,x) and ConvToDeviceY(m,y) then //2009.6.22 |
| 2094 |
TextOut(x,y,s,(textangle + XDirection(n,m)) mod 360); |
| 2095 |
if TextHeightChanged then |
| 2096 |
SettextHeight(svTextHeight); |
| 2097 |
end; |
| 2098 |
|
| 2099 |
|
| 2100 |
procedure TGraphSys.ProjectiveText(const n,m:Extended; const s:string; PlotStm:boolean); |
| 2101 |
var |
| 2102 |
a,b,i,j:integer; |
| 2103 |
a0,b0,a1,b1,a2,b2,a3,b3,aMin,aMax,bMin,bMax:integer; |
| 2104 |
color,bkcolor,color0,color1:TColor; |
| 2105 |
//color00,color01,color02,color10,color11,color12:byte; |
| 2106 |
dx,dy:integer; |
| 2107 |
TextHeightWhole:extended; |
| 2108 |
x0,y0,x,y:extended; |
| 2109 |
rt0,rt1:double; |
| 2110 |
px,py,r:double; |
| 2111 |
pxmax,pymax:integer; |
| 2112 |
svDrawMode:boolean; |
| 2113 |
bmp2:TBitMap; |
| 2114 |
NewRect:tRect; |
| 2115 |
|
| 2116 |
procedure FontToDevice(i,j:integer; var a,b:integer); |
| 2117 |
var |
| 2118 |
x1,y1:integer; |
| 2119 |
x,y,x2,y2:extended; |
| 2120 |
begin |
| 2121 |
x1:=i-dx; |
| 2122 |
y1:=j-dy; |
| 2123 |
x2:= x1*rt0+y1*rt1; |
| 2124 |
y2:=-x1*rt1+y1*rt0; |
| 2125 |
y:=y0-y2/bmp2.Height*TextHeightWhole; |
| 2126 |
x:=x0+x2/bmp2.Height*TextHeightWhole; |
| 2127 |
if PlotStm then currentTransform.transform(x,y); |
| 2128 |
a:=DeviceX(x); |
| 2129 |
b:=DeviceY(y); |
| 2130 |
end; |
| 2131 |
label Label1; |
| 2132 |
begin |
| 2133 |
//���������������������������textheight ������������ |
| 2134 |
with Canvas1.Font do |
| 2135 |
if Height=0 then //bug? |
| 2136 |
size:=9; |
| 2137 |
if TextProblemCoordinate and not TextHeightChanged then |
| 2138 |
TextHeightWhole:=0.01 *TextHeightMulti |
| 2139 |
else |
| 2140 |
TextHeightWhole:=GetTextHeight * TextHeightMulti; |
| 2141 |
if TextHeightWhole=0 then Exit; |
| 2142 |
|
| 2143 |
svDrawMode:=HiddenDrawMode; |
| 2144 |
SetHiddenDrawMode(true); |
| 2145 |
|
| 2146 |
rt0:=cos(Pi*TextAngle/180); |
| 2147 |
rt1:=sin(Pi*TextAngle/180); |
| 2148 |
|
| 2149 |
x0:=n; |
| 2150 |
y0:=m; |
| 2151 |
currenttransform.invtransform(x0,y0); |
| 2152 |
// x0, y0��������������������������������������������������������������� |
| 2153 |
|
| 2154 |
bmp2:=TBitmap.Create; |
| 2155 |
try |
| 2156 |
with bmp2 do |
| 2157 |
begin |
| 2158 |
{$IFDEF windows} |
| 2159 |
pixelFormat:=pf1bit; |
| 2160 |
Monochrome:=true; |
| 2161 |
case Length(s) of |
| 2162 |
1.. 15:Height:=2048; |
| 2163 |
16.. 31:Height:=1024; |
| 2164 |
32.. 63:Height:= 512; |
| 2165 |
64..127:Height:= 256; |
| 2166 |
128..255:Height:= 128; |
| 2167 |
else Height:= 64; |
| 2168 |
end; |
| 2169 |
{$ELSE} |
| 2170 |
pixelFormat:=pf16bit; |
| 2171 |
case Length(s) of |
| 2172 |
1.. 15:Height:= 512; |
| 2173 |
16.. 31:Height:= 256; |
| 2174 |
32.. 63:Height:= 128; |
| 2175 |
64..127:Height:= 64; |
| 2176 |
128..255:Height:= 32; |
| 2177 |
else Height:= 16; |
| 2178 |
end; |
| 2179 |
{$ENDIF} |
| 2180 |
|
| 2181 |
Canvas.Font.Assign(Canvas1.Font); |
| 2182 |
|
| 2183 |
{$IFNDEF Linux} |
| 2184 |
Canvas.Font.Height:=Height; |
| 2185 |
Width:=Canvas.TextWidth(s); |
| 2186 |
{$ELSE} |
| 2187 |
Canvas.Font.Height:=(Height div 16)*9; |
| 2188 |
Width:=(Canvas.TextWidth(s) div 8)*9; |
| 2189 |
{$ENDIF} |
| 2190 |
|
| 2191 |
NewRect:=Rect(0,0,width,Height); |
| 2192 |
with Canvas do |
| 2193 |
begin |
| 2194 |
Brush.color:=clWhite; |
| 2195 |
FillRect(NewRect); |
| 2196 |
end; |
| 2197 |
bkcolor:=Canvas.Pixels[0,0]; |
| 2198 |
|
| 2199 |
Canvas.Font.Color:=clBlack; |
| 2200 |
//Canvas.Font.Style:=[fsBold]; |
| 2201 |
Canvas.TextOut(0,0,s); |
| 2202 |
case Hjustify of |
| 2203 |
tjLEFT: dx:=0; |
| 2204 |
tjCENTER:dx:=width div 2; |
| 2205 |
tjRIGHT: dx:=width; |
| 2206 |
end; |
| 2207 |
case Vjustify of |
| 2208 |
tjTOP: dy:=0; |
| 2209 |
tjCAP: dy:=(height div 8); |
| 2210 |
tjHALF: dy:=(height div 2); |
| 2211 |
tjBASE: dy:=(height * 7) div 8; |
| 2212 |
tjBOTTOM:dy:= height -1; |
| 2213 |
end; |
| 2214 |
end; |
| 2215 |
|
| 2216 |
Label1: |
| 2217 |
FontToDevice(0,0,a0,b0); |
| 2218 |
FontToDevice(bmp2.width-1,0,a1,b1); |
| 2219 |
FontToDevice(bmp2.width-1,bmp2.Height-1,a2,b2); |
| 2220 |
FontToDevice(0,bmp2.Height-1,a3,b3); |
| 2221 |
Amin:=min(min(a0,a1),min(a2,a3)); |
| 2222 |
Amax:=max(max(a0,a1),max(a2,a3)); |
| 2223 |
Bmin:=min(min(b0,b1),min(b2,b3)); |
| 2224 |
Bmax:=max(max(b0,b1),max(b2,b3)); |
| 2225 |
{ |
| 2226 |
// ������������������������������������ |
| 2227 |
if (AMax-AMin)+(BMax-Bmin)<length(s)+2 then |
| 2228 |
begin |
| 2229 |
TextHeightWhole:=TextHeightWhole*1.25; |
| 2230 |
Goto Label1; |
| 2231 |
end; |
| 2232 |
} |
| 2233 |
FontToDevice(bmp2.width div 2,bmp2.Height div 2,a0,b0); |
| 2234 |
if (a0<AMin) or (a0>AMax) or (b0<BMin) or (b0>bmax) then |
| 2235 |
begin |
| 2236 |
AMin:=0; AMax:=DevWidth-1; |
| 2237 |
BMin:=0; BMax:=DevHeight-1; |
| 2238 |
end; |
| 2239 |
|
| 2240 |
// ������ |
| 2241 |
color1:=Canvas1.Font.color; |
| 2242 |
color0:=Mypalette.pal[0]; //��������� |
| 2243 |
r:=bmp2.Height/TextHeightWhole; |
| 2244 |
pxmax:=bmp2.Width-1; |
| 2245 |
pymax:=bmp2.Height-1; |
| 2246 |
|
| 2247 |
for b:=max(BMin,ClipRect.top) to Min(Bmax,Cliprect.Bottom) do |
| 2248 |
for a:=max(Amin,ClipRect.Left) to Min(AMax,Cliprect.Right) do |
| 2249 |
try |
| 2250 |
x:=virtualX(a); |
| 2251 |
y:=virtualY(b); |
| 2252 |
if not PlotStm or currenttransform.invtransform(x,y) then |
| 2253 |
begin |
| 2254 |
// ������������������x,y������������������������������ |
| 2255 |
// x,y������������������������������������������������ |
| 2256 |
py:=(y0-y)*r ; |
| 2257 |
px:=(x-x0)*r ; |
| 2258 |
i:=System.Round(px*rt0 - py*rt1 + dx); |
| 2259 |
j:=System.Round(px*rt1 + py*rt0 + dy); |
| 2260 |
if (0<=j) and (j<=pymax) and (0<=i) and (i<=pxmax) then |
| 2261 |
begin |
| 2262 |
color:=bmp2.Canvas.Pixels[i,j]; |
| 2263 |
if (color<>bkColor) then |
| 2264 |
Canvas1.Pixels[a,b]:=color1 |
| 2265 |
else if iBkMode=OPAQUE then |
| 2266 |
Canvas1.Pixels[a,b]:=color0 |
| 2267 |
end; |
| 2268 |
end; |
| 2269 |
except |
| 2270 |
on EMathError do |
| 2271 |
begin |
| 2272 |
{$IFNDEF Windows} asm finit end; set8087cw(controlword); {$ENDIF} |
| 2273 |
end ; |
| 2274 |
on EInvalidOp do |
| 2275 |
begin |
| 2276 |
{$IFNDEF Windows} asm finit end; set8087cw(controlword); {$ENDIF} |
| 2277 |
end; |
| 2278 |
end; |
| 2279 |
finally |
| 2280 |
bmp2.Free; |
| 2281 |
MyGraphSys.setHiddenDrawMode(SvDrawMode); |
| 2282 |
end; |
| 2283 |
end; |
| 2284 |
|
| 2285 |
|
| 2286 |
|
| 2287 |
|
| 2288 |
|
| 2289 |
|
| 2290 |
function restrict9x(n:longint):integer; |
| 2291 |
begin |
| 2292 |
if n>16383 then |
| 2293 |
result:=16383 |
| 2294 |
else if n<-16384 then |
| 2295 |
result:=-16384 |
| 2296 |
else |
| 2297 |
result:=n |
| 2298 |
end; |
| 2299 |
|
| 2300 |
function restrictNT(n:longint):integer; |
| 2301 |
begin |
| 2302 |
result:=n |
| 2303 |
end; |
| 2304 |
|
| 2305 |
function TGraphSys.textwidth(const s:ansistring):integer; |
| 2306 |
begin |
| 2307 |
textwidth:=Canvas1.textwidth(s) |
| 2308 |
end; |
| 2309 |
|
| 2310 |
function TGraphSys.textheight(const s:ansistring):integer; |
| 2311 |
begin |
| 2312 |
textheight:=Canvas1.textheight(s) |
| 2313 |
end; |
| 2314 |
|
| 2315 |
function TScreenBMPGraphSys.PixelsPerMeter:extended; |
| 2316 |
begin |
| 2317 |
result:=Screen.PixelsPerInch*10000/254; |
| 2318 |
end; |
| 2319 |
|
| 2320 |
function TMetaPrtGraphSys.PixelsPerMeter:extended; |
| 2321 |
begin |
| 2322 |
{ TODO 1 : ��������� } |
| 2323 |
// result:=Canvas1.Font.PixelsPerInch; |
| 2324 |
result:=printer.XDPI*10000/254; |
| 2325 |
end; |
| 2326 |
|
| 2327 |
|
| 2328 |
|
| 2329 |
function TGraphSys.SetDeviceViewport(l,r,b,t:extended):boolean; |
| 2330 |
var |
| 2331 |
ppm:extended; |
| 2332 |
l0,r0,b0,t0:integer; |
| 2333 |
begin |
| 2334 |
ppm:=PixelsPerMeter; |
| 2335 |
l0:=system.round(l*ppm); |
| 2336 |
r0:=system.round(r*ppm); |
| 2337 |
b0:=system.round(b*ppm); |
| 2338 |
t0:=system.round(t*ppm); |
| 2339 |
if (l0<r0) and (b0<t0) |
| 2340 |
and (l0>=0) and (r0<=DevWidth) |
| 2341 |
and (b0>=0) and (t0<=DevHeight) then |
| 2342 |
begin |
| 2343 |
DVleft:=l0; |
| 2344 |
DVright:=r0; |
| 2345 |
DVbottom:=b0; |
| 2346 |
DVtop:=t0; |
| 2347 |
setupClipRect; |
| 2348 |
setupCoordinatesubsystem; |
| 2349 |
clearScreen; |
| 2350 |
result:=true; |
| 2351 |
end |
| 2352 |
else |
| 2353 |
result:=false |
| 2354 |
end; |
| 2355 |
|
| 2356 |
|
| 2357 |
|
| 2358 |
procedure TGraphSys.askDeviceSize(var w,h:extended; var s:string); |
| 2359 |
var |
| 2360 |
ppm:extended; |
| 2361 |
begin |
| 2362 |
ppm:=PixelsPerMeter; |
| 2363 |
w:=DevWidth/ppm; |
| 2364 |
h:=DevHeight/ppm; |
| 2365 |
s:='METERS'; |
| 2366 |
end; |
| 2367 |
|
| 2368 |
|
| 2369 |
|
| 2370 |
procedure TGraphSys.AskDeviceViewport(var l,r,b,t:extended); |
| 2371 |
var |
| 2372 |
ppm:extended; |
| 2373 |
begin |
| 2374 |
ppm:=PixelsPerMeter; |
| 2375 |
l:=DVleft/ppm; |
| 2376 |
r:=DVright/ppm; |
| 2377 |
b:=DVbottom/ppm; |
| 2378 |
t:=DVtop/ppm; |
| 2379 |
end; |
| 2380 |
|
| 2381 |
procedure TGraphSys.SetClip(c:boolean); |
| 2382 |
begin |
| 2383 |
clip:=c; |
| 2384 |
setupClipRect; |
| 2385 |
end; |
| 2386 |
|
| 2387 |
procedure TGraphSys.ClearScreen; |
| 2388 |
begin |
| 2389 |
clear; |
| 2390 |
end; |
| 2391 |
|
| 2392 |
procedure TPrtDirectGraphSys.ClearScreen; |
| 2393 |
begin |
| 2394 |
end; |
| 2395 |
|
| 2396 |
|
| 2397 |
procedure TGraphSys.BezierSub(Canvas:TCanvas; const Points:array of TPoint); |
| 2398 |
begin |
| 2399 |
with Canvas do |
| 2400 |
PolyBezier(Points); |
| 2401 |
end; |
| 2402 |
|
| 2403 |
procedure TGraphSys.PolyBezier( const Points:array of TPoint); |
| 2404 |
begin |
| 2405 |
BezierSub(Canvas1,Points); |
| 2406 |
end; |
| 2407 |
|
| 2408 |
procedure TScreenBMPGraphSys.PolyBezier( const Points:array of TPoint); |
| 2409 |
begin |
| 2410 |
Inherited PolyBezier(Points); |
| 2411 |
if not HiddenDrawMode then |
| 2412 |
BezierSub(PaintBox1.Canvas,Points); |
| 2413 |
end; |
| 2414 |
|
| 2415 |
procedure TGraphSys.SetAreaStyle(s:TAreaStyle); |
| 2416 |
begin |
| 2417 |
AreaStyle:=s; |
| 2418 |
end; |
| 2419 |
|
| 2420 |
procedure TGraphSys.SetAreaStyleIndex(i:integer); |
| 2421 |
begin |
| 2422 |
AreaStyleIndex:=i |
| 2423 |
end; |
| 2424 |
|
| 2425 |
|
| 2426 |
function TGraphSys.SetBeamMode(s:AnsiString):boolean; |
| 2427 |
begin |
| 2428 |
result:=true; |
| 2429 |
s:=AnsiUpperCase(s); |
| 2430 |
if s=s_Rigorous then |
| 2431 |
BeamMode:=bmRigorous |
| 2432 |
else if s=s_Immortal then |
| 2433 |
BeamMode:=bmImmortal |
| 2434 |
else |
| 2435 |
result:=false; |
| 2436 |
end; |
| 2437 |
|
| 2438 |
function TGraphSys.AskBeamMode:AnsiString; |
| 2439 |
begin |
| 2440 |
case BeamMode of |
| 2441 |
bmRigorous: result:=s_Rigorous; |
| 2442 |
else result:=s_Immortal; |
| 2443 |
end; |
| 2444 |
|
| 2445 |
end; |
| 2446 |
|
| 2447 |
{************} |
| 2448 |
{FLOOD, PAINT} |
| 2449 |
{************} |
| 2450 |
|
| 2451 |
procedure TGraphSys.Flood(x,y:integer); |
| 2452 |
var |
| 2453 |
svBrushColor:TColor; |
| 2454 |
begin |
| 2455 |
with Canvas1 do |
| 2456 |
begin |
| 2457 |
svBrushColor:=Brush.Color; |
| 2458 |
Brush.Color:=MyPalette[areacolor] ; |
| 2459 |
GraphUtil.FloodFill(Canvas1,x,y,pixels[x,y],fsSurface); |
| 2460 |
Brush.Color:=svBrushColor; |
| 2461 |
end; |
| 2462 |
end; |
| 2463 |
|
| 2464 |
|
| 2465 |
procedure TGraphSys.FloodFill( x,y:integer); |
| 2466 |
var |
| 2467 |
svBrushColor:TColor; |
| 2468 |
begin |
| 2469 |
with Canvas1 do |
| 2470 |
begin |
| 2471 |
svBrushColor:=Brush.Color; |
| 2472 |
Brush.Color:=MyPalette[areacolor] ; |
| 2473 |
FloodFill(x,y,MyPalette[linecolor] ,fsBorder); |
| 2474 |
Brush.Color:=svBrushColor; |
| 2475 |
end; |
| 2476 |
end; |
| 2477 |
|
| 2478 |
procedure TScreenBMPGraphSys.Flood( x,y:integer); |
| 2479 |
begin |
| 2480 |
if MyRgn<>0 then SelectClipRgn(Canvas1.Handle,MyRgn); |
| 2481 |
inherited Flood(x,y); |
| 2482 |
if not HiddenDrawMode then |
| 2483 |
PaintBox1.repaint; |
| 2484 |
end; |
| 2485 |
|
| 2486 |
procedure TScreenBMPGraphSys.FloodFill( x,y:integer); |
| 2487 |
begin |
| 2488 |
if MyRgn<>0 then SelectClipRgn(Canvas1.Handle,MyRgn); |
| 2489 |
inherited FloodFill(x,y); |
| 2490 |
if not HiddenDrawMode then |
| 2491 |
PaintBox1.repaint; |
| 2492 |
end; |
| 2493 |
|
| 2494 |
|
| 2495 |
{***************} |
| 2496 |
{Microsoft BASIC} |
| 2497 |
{***************} |
| 2498 |
|
| 2499 |
procedure TGraphSys.MSScreen(c:integer); |
| 2500 |
begin |
| 2501 |
setexception(9102) |
| 2502 |
end; |
| 2503 |
|
| 2504 |
procedure TScreenBMPGraphSys.MSScreen(c:integer); |
| 2505 |
begin |
| 2506 |
case c of |
| 2507 |
2,3,87: |
| 2508 |
PaintForm.setBitMapSize(640,400); |
| 2509 |
11,12: |
| 2510 |
PaintForm.setBitMapSize(640,480); |
| 2511 |
end; |
| 2512 |
|
| 2513 |
if c in [3,12,87] then |
| 2514 |
begin |
| 2515 |
case c of |
| 2516 |
3 :MyPalette.PaletteNumber:=2; |
| 2517 |
12,87:MyPalette.PaletteNumber:=1; |
| 2518 |
end; |
| 2519 |
PaintForm.clear; |
| 2520 |
linecolor:=7; |
| 2521 |
setlinecolor(7); |
| 2522 |
end; |
| 2523 |
end; |
| 2524 |
procedure TGraphSys.MSMoveTo(a,b:integer); |
| 2525 |
begin |
| 2526 |
Canvas1.Moveto(a,b); |
| 2527 |
end; |
| 2528 |
|
| 2529 |
procedure TScreenBMPGraphSys.MSMoveTo(a,b:integer); |
| 2530 |
begin |
| 2531 |
Canvas1.Moveto(a,b); |
| 2532 |
if not HiddenDrawMode then |
| 2533 |
PaintBox1.Canvas.Moveto(a,b); |
| 2534 |
end; |
| 2535 |
|
| 2536 |
procedure TGraphSys.MSLineTo(a,b:integer); |
| 2537 |
begin |
| 2538 |
Canvas1.lineto(a,b); |
| 2539 |
end; |
| 2540 |
|
| 2541 |
procedure TScreenBMPGraphSys.MSLineTo(a,b:integer); |
| 2542 |
begin |
| 2543 |
Canvas1.lineto(a,b); |
| 2544 |
if not HiddenDrawMode then |
| 2545 |
PaintBox1.Canvas.lineto(a,b); |
| 2546 |
end; |
| 2547 |
|
| 2548 |
|
| 2549 |
procedure TGraphSys.MSPaint( x,y:integer; ac, bc:integer); |
| 2550 |
var |
| 2551 |
svBrushColor:TColor; |
| 2552 |
BorderColor:TColor; |
| 2553 |
begin |
| 2554 |
svBrushColor:=Canvas1.Brush.Color; |
| 2555 |
Canvas1.Brush.Color:=MyPalette[ac] ; |
| 2556 |
BorderColor:=MyPalette[bc] ; |
| 2557 |
//Canvas1.FloodFill(x,y,BorderColor,fsBorder); //��������� |
| 2558 |
Canvas1.Brush.Color:=svBrushColor; |
| 2559 |
Canvas1.MoveTo(x,y); |
| 2560 |
end; |
| 2561 |
|
| 2562 |
procedure TScreenBMPGraphSys.MSPaint( x,y:integer; ac, bc:integer); |
| 2563 |
begin |
| 2564 |
inherited MSPaint(x,y,ac,bc); |
| 2565 |
if not HiddenDrawMode then |
| 2566 |
PaintBox1.Repaint; |
| 2567 |
end; |
| 2568 |
|
| 2569 |
procedure MSCircleSub(Canvas:TCanvas; |
| 2570 |
x1,y1,x2,y2:integer; lc,ac:integer; f:boolean); |
| 2571 |
|
| 2572 |
var |
| 2573 |
svBrushColor,svPenColor:TColor; |
| 2574 |
svBrushStyle:TBrushStyle; |
| 2575 |
begin |
| 2576 |
with Canvas do |
| 2577 |
begin |
| 2578 |
svPenColor:=Pen.Color; |
| 2579 |
svBrushColor:=Brush.Color; |
| 2580 |
Pen.Color:=MyPalette[lc] ; |
| 2581 |
Brush.Color:=MyPalette[ac] ; |
| 2582 |
svBrushStyle:=Brush.Style; |
| 2583 |
if F then |
| 2584 |
Brush.Style:=BSSolid |
| 2585 |
else |
| 2586 |
Brush.Style:=BSClear; |
| 2587 |
Ellipse(x1,y1,x2,y2); |
| 2588 |
Pen.Color:=svPenColor; |
| 2589 |
Brush.Color:=svBrushColor; |
| 2590 |
Brush.Style:=svBrushStyle; |
| 2591 |
end; |
| 2592 |
end; |
| 2593 |
|
| 2594 |
procedure TGraphSys.MSCircle(x1,y1,x2,y2:integer; lc,ac:integer; F:boolean); |
| 2595 |
begin |
| 2596 |
MSCircleSub(Canvas1,x1,y1,x2,y2,lc,ac,F); |
| 2597 |
end; |
| 2598 |
|
| 2599 |
procedure TScreenBMPGraphSys.MSCircle(x1,y1,x2,y2:integer; lc,ac:integer; F:boolean); |
| 2600 |
begin |
| 2601 |
MSCircleSub(Canvas1,x1,y1,x2,y2,lc,ac,F); |
| 2602 |
if not HiddenDrawMode then |
| 2603 |
MSCircleSub(PaintBox1.Canvas,x1,y1,x2,y2,lc,ac,F); |
| 2604 |
end; |
| 2605 |
|
| 2606 |
|
| 2607 |
{************} |
| 2608 |
{InitGraphics} |
| 2609 |
{************} |
| 2610 |
|
| 2611 |
procedure initGraphics; |
| 2612 |
begin |
| 2613 |
case NextGraphMode of |
| 2614 |
ScreenBitmapMode: |
| 2615 |
MyGraphSys:=ScreenBMPGraphSys; |
| 2616 |
PrtDirectMode: |
| 2617 |
begin |
| 2618 |
MyGraphSys:=PrtDirectGraphSys ; |
| 2619 |
end; |
| 2620 |
end; |
| 2621 |
MyGraphSys.initGraphic; |
| 2622 |
LocateForm.InitValue; |
| 2623 |
end; |
| 2624 |
|
| 2625 |
initialization |
| 2626 |
|
| 2627 |
MyPalette:=TMyPalette.create; |
| 2628 |
MyPalette.PaletteNumber:=0; |
| 2629 |
|
| 2630 |
ScreenBMPGraphSys:=TScreenBMPGraphSys.create; |
| 2631 |
MyGraphSys:=ScreenBMPGraphSys; |
| 2632 |
PrtDirectGraphSys:=TPrtDirectGraphSys.create; |
| 2633 |
|
| 2634 |
//if longint(Windows.GetVersion)>=0 then |
| 2635 |
if false then // 32������������������������true������������ |
| 2636 |
begin |
| 2637 |
restrict:=restrictNT; |
| 2638 |
ShrinkRange:=ShrinkRangeNT; |
| 2639 |
end |
| 2640 |
else |
| 2641 |
begin |
| 2642 |
restrict:=restrict9x; |
| 2643 |
ShrinkRange:=ShrinkRange9x; |
| 2644 |
end; |
| 2645 |
|
| 2646 |
|
| 2647 |
|
| 2648 |
finalization |
| 2649 |
|
| 2650 |
ScreenBMPGraphSys.Free; |
| 2651 |
PrtDirectGraphSys.free; |
| 2652 |
MyPalette.Free; |
| 2653 |
end. |
Parent Directory
Revision Log