1 unit gline2;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils, Graphics, GraphType,LCLType, IntfGraphics, FPimage;
9
10
11 const obsimax=2048;
12 obvymax=obsimax shr 1;
13
14 const obsi:longint=400;
15 obvy:longint=200;
16
17 var
18 obsi2,obvy2:extended;
19
20 type Tplac=array[0..obsimax*obvymax-1] of byte;
21
22 var sintab:array[0..1023] of extended;
23 costab:array[0..1023] of extended;
24
25 sqtab1:array[-1000 .. 0] of byte;
26 sqtab2:array[0 .. 1000] of byte;
27 asintab:array[-10010..10010] of longint;
28
29
30
31 type
32 t_coord = record
33 longitude, latitude, radius: extended; (* lambda, beta, R *)
34 rektaszension, declination: extended; (* alpha, delta *)
35 parallax: extended;
36 elevation, azimuth: extended; (* h, A *)
37 end;
38
39 const body_popis_max=30;
40 type Tcarobod=record
41 typ:byte; // 0 - nic;1 cara, 2 bod ctverecek , 3 bod krizek
42 x1,y1,x2,y2:extended;
43 popis:string[body_popis_max];
44 barva:Tcolor;
45 vel_bodu:longint;
46 end;
47 const body_max=128;
48 var star_time_u:extended;
49
50 type
51 Tgrayline=object
52 constructor init(naz_sou:string);
53 destructor done;
54 procedure VypocitejSunClock(cas:Tdatetime);
55 procedure kresli(r:Trect;can:Tcanvas); {vykresli v pozadovanych rozmerech}
56 procedure kresli1(x1,y1:longint;can:Tcanvas); {vykresli 1:1, zadavan je "jen" levy horni roh}
57
58 procedure jachcucaru(en:boolean;x1,y1,x2,y2:extended);
59
60 procedure body_add(typ:byte;x1,y1,x2,y2:extended;popis:string;barva:tcolor;vel_bodu:longint);
61 procedure body_smaz;
62
63 private
64 nrd:boolean; // potrebuje prekreslit (probehl novy vypocet)
65
66 chcipni:boolean;
67 ziju:boolean;
68 poslednicas:Tdatetime;
69
70 q:Tplac;
71 declin:longint;
72 sideclin,codeclin:extended;
73 harr:array[0..obsimax] of longint;
74 rold:Trect;
75
76 carax1,carax2,caray1,caray2:extended;
77 caraen:boolean;
78
79 obrp:TLazIntfImage; // predloha... 1-z disku
80 obrA,obrT:TLazIntfImage; // obra - zde vse kreslit
81
82 obmap: TBitmap;
83 body:array[0..body_max] of Tcarobod;
84 body_poc:longint;
85
calc_horizontalxnull86 function calc_horizontalx(var coord:t_coord; date:TDateTime; z:longint;latitude: extended):longint;
87 end;
88 Pgrayline=^Tgrayline;
89
90
91 implementation
92
93
94 uses ah_math,vsop;
95
96 { Tfgline }
97
98 const
99 julian_offset: extended = 0;
100 AU=149597869; (* astronomical unit in km *)
101 mean_lunation=29.530589; (* Mean length of a month *)
102 tropic_year=365.242190; (* Tropic year length *)
103 earth_radius=6378.15; (* Radius of the earth *)
104
105
106
107
108
109
put_in_360null110 function put_in_360(x:extended):extended;
111 begin
112 result:=x-round(x/360)*360;
113 while result<0 do result:=result+360;
114 end;
115
julian_datenull116 function julian_date(date:TDateTime):extended;
117 begin
118 julian_date:=julian_offset+date
119 end;
120
121 procedure calc_epsilon_phi(date:TDateTime; var delta_phi,epsilon:extended);
122 (*$ifndef low_accuracy *)
123 const
124 (*@/// arg_mul:array[0..30,0..4] of shortint = (..); *)
125 arg_mul:array[0..30,0..4] of shortint = (
126 ( 0, 0, 0, 0, 1),
127 (-2, 0, 0, 2, 2),
128 ( 0, 0, 0, 2, 2),
129 ( 0, 0, 0, 0, 2),
130 ( 0, 1, 0, 0, 0),
131 ( 0, 0, 1, 0, 0),
132 (-2, 1, 0, 2, 2),
133 ( 0, 0, 0, 2, 1),
134 ( 0, 0, 1, 2, 2),
135 (-2,-1, 0, 2, 2),
136 (-2, 0, 1, 0, 0),
137 (-2, 0, 0, 2, 1),
138 ( 0, 0,-1, 2, 2),
139 ( 2, 0, 0, 0, 0),
140 ( 0, 0, 1, 0, 1),
141 ( 2, 0,-1, 2, 2),
142 ( 0, 0,-1, 0, 1),
143 ( 0, 0, 1, 2, 1),
144 (-2, 0, 2, 0, 0),
145 ( 0, 0,-2, 2, 1),
146 ( 2, 0, 0, 2, 2),
147 ( 0, 0, 2, 2, 2),
148 ( 0, 0, 2, 0, 0),
149 (-2, 0, 1, 2, 2),
150 ( 0, 0, 0, 2, 0),
151 (-2, 0, 0, 2, 0),
152 ( 0, 0,-1, 2, 1),
153 ( 0, 2, 0, 0, 0),
154 ( 2, 0,-1, 0, 1),
155 (-2, 2, 0, 2, 2),
156 ( 0, 1, 0, 0, 1)
157 );
158 (*@\\\*)
159 (*@/// arg_phi:array[0..30,0..1] of longint = (); *)
160 arg_phi:array[0..30,0..1] of longint = (
161 (-171996,-1742),
162 ( -13187, -16),
163 ( -2274, -2),
164 ( 2062, 2),
165 ( 1426, -34),
166 ( 712, 1),
167 ( -517, 12),
168 ( -386, -4),
169 ( -301, 0),
170 ( 217, -5),
171 ( -158, 0),
172 ( 129, 1),
173 ( 123, 0),
174 ( 63, 0),
175 ( 63, 1),
176 ( -59, 0),
177 ( -58, -1),
178 ( -51, 0),
179 ( 48, 0),
180 ( 46, 0),
181 ( -38, 0),
182 ( -31, 0),
183 ( 29, 0),
184 ( 29, 0),
185 ( 26, 0),
186 ( -22, 0),
187 ( 21, 0),
188 ( 17, -1),
189 ( 16, 0),
190 ( -16, 1),
191 ( -15, 0)
192 );
193 (*@\\\*)
194 (*@/// arg_eps:array[0..30,0..1] of longint = (); *)
195 arg_eps:array[0..30,0..1] of longint = (
196 ( 92025, 89),
197 ( 5736, -31),
198 ( 977, -5),
199 ( -895, 5),
200 ( 54, -1),
201 ( -7, 0),
202 ( 224, -6),
203 ( 200, 0),
204 ( 129, -1),
205 ( -95, 3),
206 ( 0, 0),
207 ( -70, 0),
208 ( -53, 0),
209 ( 0, 0),
210 ( -33, 0),
211 ( 26, 0),
212 ( 32, 0),
213 ( 27, 0),
214 ( 0, 0),
215 ( -24, 0),
216 ( 16, 0),
217 ( 13, 0),
218 ( 0, 0),
219 ( -12, 0),
220 ( 0, 0),
221 ( 0, 0),
222 ( -10, 0),
223 ( 0, 0),
224 ( -8, 0),
225 ( 7, 0),
226 ( 9, 0)
227 );
228 (*@\\\*)
229 (*$endif *)
230 var
231 t,omega: extended;
232 (*$ifdef low_accuracy *)
233 l,ls: extended;
234 (*$else *)
235 d,m,ms,f,s: extended;
236 i: longint;
237 (*$endif *)
238 epsilon_0,delta_epsilon: extended;
239 begin
240 t:=(julian_date(date)-2451545.0)/36525;
241
242 (* longitude of rising knot *)
243 omega:=put_in_360(125.04452+(-1934.136261+(0.0020708+1/450000*t)*t)*t);
244
245 (*$ifdef low_accuracy *)
246 (*@/// delta_phi and delta_epsilon - low accuracy *)
247 (* mean longitude of sun (l) and moon (ls) *)
248 l:=280.4665+36000.7698*t;
249 ls:=218.3165+481267.8813*t;
250
251 (* correction due to nutation *)
252 delta_epsilon:=9.20*cos_d(omega)+0.57*cos_d(2*l)+0.10*cos_d(2*ls)-0.09*cos_d(2*omega);
253
254 (* longitude correction due to nutation *)
255 delta_phi:=(-17.20*sin_d(omega)-1.32*sin_d(2*l)-0.23*sin_d(2*ls)+0.21*sin_d(2*omega))/3600;
256 (*@\\\*)
257 (*$else *)
258 (*@/// delta_phi and delta_epsilon - higher accuracy *)
259 (* mean elongation of moon to sun *)
260 d:=put_in_360(297.85036+(445267.111480+(-0.0019142+t/189474)*t)*t);
261
262 (* mean anomaly of the sun *)
263 m:=put_in_360(357.52772+(35999.050340+(-0.0001603-t/300000)*t)*t);
264
265 (* mean anomly of the moon *)
266 ms:=put_in_360(134.96298+(477198.867398+(0.0086972+t/56250)*t)*t);
267
268 (* argument of the latitude of the moon *)
269 f:=put_in_360(93.27191+(483202.017538+(-0.0036825+t/327270)*t)*t);
270
271 delta_phi:=0;
272 delta_epsilon:=0;
273
274 for i:=0 to 30 do begin
275 s:= arg_mul[i,0]*d
276 +arg_mul[i,1]*m
277 +arg_mul[i,2]*ms
278 +arg_mul[i,3]*f
279 +arg_mul[i,4]*omega;
280 delta_phi:=delta_phi+(arg_phi[i,0]+arg_phi[i,1]*t*0.1)*sin_d(s);
281 delta_epsilon:=delta_epsilon+(arg_eps[i,0]+arg_eps[i,1]*t*0.1)*cos_d(s);
282 end;
283
284 delta_phi:=delta_phi*0.0001/3600;
285 delta_epsilon:=delta_epsilon*0.0001/3600;
286 (*@\\\*)
287 (*$endif *)
288
289 (* angle of ecliptic *)
290 epsilon_0:=84381.448+(-46.8150+(-0.00059+0.001813*t)*t)*t;
291
292 epsilon:=(epsilon_0+delta_epsilon)/3600;
293 end;
294
295
delphi_datenull296 function delphi_date(juldat:extended):TDateTime;
297 begin
298 delphi_date:=juldat-julian_offset;
299 end;
300
301 (*@/// function star_time(date:TDateTime):extended; // degrees *)
star_timenull302 function star_time(date:TDateTime):extended;
303 var
304 jd, t: extended;
305 delta_phi, epsilon: extended;
306 begin
307 jd:=julian_date(date);
308 t:=(jd-2451545.0)/36525;
309 epsilon:=0; delta_phi:=0;
310 calc_epsilon_phi(date,delta_phi,epsilon);
311 result:=put_in_360(280.46061837+360.98564736629*(jd-2451545.0)+
312 t*t*(0.000387933-t/38710000)+
313 delta_phi*cos_d(epsilon) );
314 end;
315
316
317 procedure calc_geocentric(var coord:t_coord; date:TDateTime);
318 var
319 epsilon: extended;
320 delta_phi: extended;
321 alpha,delta: extended;
322 begin
323 calc_epsilon_phi(date,delta_phi,epsilon);
324 coord.longitude:=put_in_360(coord.longitude+delta_phi);
325
326 (* geocentric coordinates *)
327 { alpha:=arctan2_d(cos_d(epsilon)*sin_d(o),cos_d(o)); }
328 { delta:=arcsin_d(sin_d(epsilon)*sin_d(o)); }
329 alpha:=arctan2_d( sin_d(coord.longitude)*cos_d(epsilon)
330 -tan_d(coord.latitude)*sin_d(epsilon)
331 ,cos_d(coord.longitude));
332 delta:=arcsin_d( sin_d(coord.latitude)*cos_d(epsilon)
333 +cos_d(coord.latitude)*sin_d(epsilon)*sin_d(coord.longitude));
334
335 coord.rektaszension:=alpha;
336 coord.declination:=delta;
337 end;
338
339 procedure calc_coord(date: TDateTime; obj_class: TCVSOP; var l,b,r: extended);
340 var
341 obj: TVSOP;
342 begin
343 obj:=NIL;
344 try
345 obj:=obj_class.Create;
346 obj.date:=date;
347 r:=obj.radius;
348 l:=obj.longitude;
349 b:=obj.latitude;
350 obj.DynamicToFK5(l,b);
351 finally
352 obj.free;
353 end;
354 l:=put_in_360(rad2deg(l)); (* rad -> degree *)
355 b:=rad2deg(b);
356 end;
357
358
359 procedure earth_coord(date:TdateTime; var l,b,r: extended);
360 begin
361 calc_coord(date,TVSOPEarth,l,b,r);
362 end;
363
364
sun_coordinatenull365 function sun_coordinate(date:TDateTime):t_coord;
366 var
367 l,b,r: extended;
368 lambda,t: extended;
369 begin
370 earth_coord(date,l,b,r);
371 (* convert earth coordinate to sun coordinate *)
372 l:=l+180;
373 b:=-b;
374 (* conversion to FK5 *)
375 t:=(julian_date(date)-2451545.0)/365250.0*10;
376 lambda:=l+(-1.397-0.00031*t)*t;
377 l:=l-0.09033/3600;
378 b:=b+0.03916/3600*(cos_d(lambda)-sin_d(lambda));
379 (* aberration *)
380 l:=l-20.4898/3600/r;
381 (* correction of nutation - is done inside calc_geocentric *)
382 { calc_epsilon_phi(date,delta_phi,epsilon); }
383 { l:=l+delta_phi; }
384 (* fill result and convert to geocentric *)
385 result.longitude:=put_in_360(l);
386 result.latitude:=b;
387 result.radius:=r*AU;
388 calc_geocentric(result,date);
389 end;
390
391
392
393
calc_horizontalxnull394 function Tgrayline.calc_horizontalx(var coord:t_coord; date:TDateTime; z:longint;latitude: extended):longint;
395 var
396 h: longint;
397 la:longint;
398
399 begin
400
401
402 h:=harr[z];
403 (*
404 coord.azimuth:=0;{arctan2_d(sin_d(h),
405 cos_d(h)*sin_d(latitude)-
406 tan_d(coord.declination)*cos_d(latitude) );{}
407 *)
408
409 //la:=round(latitude*512) div 180 and 1023;
410
411 //workaround because of bug in fpc 3.0.0 and above
412 la:=round(latitude*512) div 180;
413 while(la<0) do la:=la+1024;
414 while(la>1023) do la:=la-1024;
415
416 calc_horizontalx:= asintab[round((sintab[la]*sideclin+costab[la]*codeclin*costab[h])*999)];
417
418 end;
419
420
421
422
423
424 constructor Tgrayline.init(naz_sou:string);
425 var e,z:longint;
426 a:extended;
427 co : Integer;
428 //xptr:^byte;
429
430 ImgFormatDescription: TRawImageDescription;
431 obrtmp:TLazIntfImage;
432 begin
433 chcipni:=false;
434 caraen:=false;
435
436
437
438 obrtmp:=TLazIntfImage.Create(0,0);
439 obrtmp.LoadFromFile(naz_sou);
440
441 obsi:=obrtmp.Width;
442 obvy:=obrtmp.Height;
443
444 obrtmp.free;
445
446 obmap:=TBitmap.Create;
447
448
449 // obrp1:=
450 obrp:=TLazIntfImage.Create(0,0);
451 ImgFormatDescription.Init_BPP32_B8G8R8_BIO_TTB(obsi,obvy);
452 obrp.DataDescription:=ImgFormatDescription;
453 obrp.LoadFromFile(naz_sou);
454
455
456 obra:=TLazIntfImage.Create(0,0);
457 ImgFormatDescription.Init_BPP32_B8G8R8_BIO_TTB(obsi,obvy);
458 obrA.DataDescription:=ImgFormatDescription;
459
460 obrA.CopyPixels(obrP);
461 //xptr:=obrA.GetDataLineStart(0);
462
463
464 obmap.Width:=obrp.Width;
465 obmap.Height:=obrp.Height;
466
467 obrT:=obmap.CreateIntfImage;
468 // convert the content from the very specific to the current format
469 obrT.CopyPixels(obrA);
470 obmap.LoadFromIntfImage(obrT);
471
472
473 obsi2:=360/obsi;
474 obvy2:=180/obvy;
475
476
477 if obsi>obsimax then begin chcipni:=true;end;
478 if obvy>obvymax then begin chcipni:=true;end;
479
480 for z:=0 to 1023 do
481 begin
482 a:=sin(z*pi/512);
483 sintab[z]:=a;
484 //costab[(z-256) and 1023]:=a;
485 //workaround because of bug in fpc 3.0.0 and above
486 co:=z-256;if co<0 then co:=co+1024;
487 costab[co]:=a
488 end;
489
490 { fillchar(sqtab1[-901],100,20);}
491
492 for z:=0 to 901 do
493 begin
494 e:=-round(sqrt(z)*2.84604989415154)+100+10;
495 if e<2 then sqtab1[-z]:=2 else sqtab1[-z]:=e;
496 end;
497
498 fillchar(sqtab2[50],855,199);
499 for z:=0 to 50 do
500 sqtab2[z]:= round(sqrt(sqrt(z))*56.2341325190)+100;
501
502 //for c:=0 to 100 do
503 for z:=0 to 10010 do
504 begin
505 asintab[z]:=round(arcsin(z/1000)*1800/pi);
506 asintab[-z]:=-asintab[z];
507 end;
508
509 body_poc:=0;
510
511 poslednicas:=now-1000000;
512 nrd:=false;
513 end;
514
515 destructor Tgrayline.done;
516 begin
517 obra.Free;
518 obrp.Free;
519 obrt.Free;
520 obmap.Free;
521
522 end;
523
524 procedure tgrayline.VypocitejSunClock(cas:Tdatetime);
525 const ko=10;
526 var z,c:longint;
527 ce:extended;
528 datum : TDateTime;
529 datum2:extended;
530 pos1: T_Coord;
531 vere,vere1:longint;
532
vr1null533 function vr1(z,x:longint):longint;
534 begin
535 vr1:=calc_horizontalx(pos1,datum,z,(x-obvy shr 1)*obvy2);
536 // if vr1>100 then vr1:=200;
537 // if vr1<80 then vr1:=80;
538 // vr1:=random(1000)-500;
539 end;
540
541
542 procedure put(x1,y1:longint;b:byte);
543 begin
544 q[x1+y1*obsi]:=b;
545 end;
546
getnull547 function get(x1,y1:longint):byte;
548 var e2:longint;
549 //e,
550 o,g:longint;
551 begin
552 o:=x1+y1*obsi;
553 if q[o]=0 then
554 begin
555 e2 :=vr1(x1,y1);
556 ///if e2<0 then e:=-1 else e:=1;
557 if e2=0 then g:=100
558 else
559 if e2<0 then
560 g:=sqtab1[e2]
561 else
562 g:=sqtab2[e2];
563 if g>199 then g:=199;
564 if g<=0 then g:=1;
565 q[o]:=g and 254;
566 get:=g and 254;
567 end
568 else get:=q[o];
569 end;
570
571
572 procedure prolez(x1,y1,x2,y2,u:longint);
573 var c,v,z,x:longint;
574 px,py:longint;
575
576 begin
577 if chcipni then exit;
578 if u<0 then exit;
579 //if u>7 then Application.ProcessMessages;
580 v:=get(x1,y1);
581 if (v=get(x1,y2)) and (v=get(x2,y1)) and (v=get(x2,y1)) and (u<3) then
582
583 for x:=y1 to y2 do
584 begin
585 c:=x*obsi+x1;
586 for z:=x1 to x2 do
587 begin
588 {put(z,x,v);}
589 q[c]:=v;
590 inc(c);
591 end
592 end
593 else
594 begin
595 if x2-x1>2 then px:=(x2+x1) div 2
596 else if x2-x1=2 then px:=x1+1 else px:=x1;
597 if y2-y1>2 then py:=(y2+y1) div 2
598 else if y2-y1=2 then py:=y1+1 else py:=y1;
599
600 { py:=(y2+y1) div 2;}
601 if (x2-x1>2) and (y2-y1>2) then
602 begin
603 prolez(x1,y1,px,py,u-1);
604 prolez(x1,py+1,px,y2,u-1);
605 prolez(px+1,y1,x2,py,u-1);
606 prolez(px+1,py+1,x2,y2,u-1);
607 end
608 else
609 if y2-y1>2 then
610 begin
611 prolez(x1,y1,x2,py,u-1);
612 prolez(x1,py+1,x2,y2,u-1);
613 end
614 else
615 if x2-x1>2 then
616 begin
617 prolez(x1,y1,px,y2,u-1);
618 prolez(px+1,y1,x2,y2,u-1);
619 end
620 else
621 begin
622 for z:=x1 to x2 do
623 for x:=y1 to y2 do get(z,x);
624 end;
625 end;
626
627 end;
628
629
630 procedure prolez1(x1,y1,x2,y2,u:longint);
631 //var z,x,c:integer;
632 //dx,dy:longint;
633 begin
634 //dx:=x2-x1;
635 // for z:=0 to dx
636 end;
637 begin
638 if chcipni then exit;
639 if round(poslednicas*24*60)=round(cas*24*60) then exit;
640 poslednicas:=cas;
641 // datum := now+strtofloat(edit1.Text)/24-3.5/24;
642 datum := cas -3.5/24;
643 { for c:=0 to 23 do}
644 c:=0;
645 ce:=(datum-trunc(datum))*24+c;
646 datum2:=(datum-trunc(datum)+ce/24)*360;
647 begin
648 fillchar(q,obvy*obsi,0);
649 pos1:=sun_coordinate(trunc(datum));
650 //declin:=round(pos1.declination*512) div 180 and 1023;
651 //workaround because of bug in fpc 3.0.0 and above
652 declin:=round(pos1.declination*512) div 180;
653 while(declin<0) do declin:=declin+1024;
654 while(declin>1023) do declin:=declin-1024;
655
656 sideclin:=sintab[declin];
657 codeclin:=costab[declin];
658 star_time_u:=star_time(datum);
659 ziju:=true;
660 for z:=0 to obsi-1 do
661 begin
662 //harr[z]:=(round(star_time_u-pos1.rektaszension-(datum2+z*obsi2)) shl 9 div 180) and 1023;
663 //workaround because of bug in fpc 3.0.0 and above
664 harr[z]:=(round(star_time_u-pos1.rektaszension-(datum2+z*obsi2)) *512 div 180);
665 while(harr[z]<0) do harr[z]:=harr[z]+1024;
666 while(harr[z]>1023) do harr[z]:=harr[z]-1024
667 end;
668 //(round(star_time_u-coord.rektaszension-(datum2+z*obsi2)) shl 9 div 180) and 1023;
669
670 vere:=0;
671 vere1:=obsi;
672 while vere1>2 do
673 begin
674 vere1:=vere1 shr 1;
675 inc(vere);
676 end;
677 prolez(0,0,obsi-1,obvy-1,vere);
678 ziju:=false;
679 end; { for c ?}
680 nrd:=true;
681 end;
682
683
684 procedure Tgrayline.kresli(r:Trect;can:Tcanvas);
685 var z,x,c:longint;
686 ze,zez,ze2,zez2,ze2s,zez2s:extended;
687
688 var
689
690 xptr:^byte;
691
692
693 procedure cmarniu(x1,y1,x2,y2:longint);
694 begin
695 can.pen.color:=clblack;
696 can.pen.Width:=5;
697 can.moveto(x1,y1);
698 can.lineto(x2,y2);
699 can.pen.color:=clyellow;
700 can.pen.Width:=2;
701 can.moveto(x1,y1);
702 can.lineto(x2,y2);
703 end;
704
705 procedure cmarni(x1,y1,x2,y2:extended;roh:boolean);
706 var dx,dy,ax,ay:extended;
707 begin
708 if (abs(x1-x2)>180) and (roh) then
709 begin
710 can.pen.Style:=psdash;
711 cmarni(x1+360,y1,x2,y2,false);
712 cmarni(x1,y1,x2-360,y2,false);
713 can.pen.Style:=pssolid;
714 cmarni(x1,y1,x2,y2,false);
715 end
716 else
717 begin
718 dx:=r.right-r.left+1;
719 dy:=r.bottom-r.top+1;
720
721 ax:=(r.left+r.right)/2;
722 ay:=(r.top+r.bottom)/2;
723
724 cmarniu(round(ax+round(x1*dx/360)),round(ay+round(y1*dy/180)),
725 round(ax+round(x2*dx/360)),round(ay+round(y2*dy/180)));
726 end;
727 end;
728
729 procedure bod_cmarniu(x1,y1,x2,y2:longint;b:Tcarobod);
730 var vb:longint;
731 begin
732 vb:=b.vel_bodu;
733 if b.typ=3 then
734 begin
735 can.pen.color:=clblack;
736 can.pen.Width:=5;
737 can.moveto(x1-vb,y1-vb);
738 can.lineto(x1+vb,y1+vb);
739 can.moveto(x1-vb,y1+vb);
740 can.lineto(x1+vb,y1-vb);
741 can.pen.color:=b.barva;
742 can.pen.Width:=2;
743 can.moveto(x1-vb,y1-vb);
744 can.lineto(x1+vb,y1+vb);
745 can.moveto(x1-vb,y1+vb);
746 can.lineto(x1+vb,y1-vb);
747 end;
748 if b.typ=2 then
749 begin
750 can.pen.color:=clblack;
751 can.pen.Width:=5;
752 can.moveto(x1-vb,y1-vb);
753 can.lineto(x1-vb,y1+vb);
754 can.lineto(x1+vb,y1+vb);
755 can.lineto(x1+vb,y1-vb);
756 can.lineto(x1-vb,y1-vb);
757 can.pen.color:=b.barva;
758 can.pen.Width:=2;
759 can.moveto(x1-vb,y1-vb);
760 can.lineto(x1-vb,y1+vb);
761 can.lineto(x1+vb,y1+vb);
762 can.lineto(x1+vb,y1-vb);
763 can.lineto(x1-vb,y1-vb);
764 end;
765 if b.typ=1 then
766 begin
767 can.pen.color:=clblack;
768 can.pen.Width:=5;
769 can.moveto(x1,y1);
770 can.lineto(x2,y2);
771 can.pen.color:=b.barva;
772 can.pen.Width:=2;
773 can.moveto(x1,y1);
774 can.lineto(x2,y2);
775 end;
776 end;
777
778
779
780 procedure bod_cmarni(b:Tcarobod);
781 var dx,dy,ax,ay:extended;
782 begin
783 dx:=r.right-r.left+1;
784 dy:=r.bottom-r.top+1;
785
786 ax:=(r.left+r.right)/2;
787 ay:=(r.top+r.bottom)/2;
788
789 bod_cmarniu(round(ax+round(b.x1*dx/360)),round(ay+round(b.y1*dy/180)),
790 round(ax+round(b.x2*dx/360)),round(ay+round(b.y2*dy/180)),b);
791 end;
792
793
794 begin
795 if chcipni then exit;
796
797 if ((r.left-r.right<>rold.left-rold.right) or (r.top-r.bottom<>rold.top-rold.bottom))
798 and (r.right-r.left+1>obsi) then nrd:=true;
799
800 if nrd then
801 begin
802
803 obrA.CopyPixels(obrP);
804
805 //ze2:=0.79; //zad�n� jak bude tmav� obr�zek - R a G
806 //zez2:=0.90; //zad�n� jak bude tmav� obr�zek - modry kanal
807
808 ze2 := 1.7;
809 zez2 := 1.0;
810
811 if ze2<=0 then ze2:=0.0000001;
812 if zez2<=0 then zez2:=0.0000001;
813 ze2s:=100/ze2*2-200;
814 zez2s:=100/zez2*2-200;
815 for x:=0 to obvy-1 do
816 begin
817 c:=(obvy-1-x)*obsi;
818 xptr:=obrA.GetDataLineStart(x);
819 for z:=0 to obsi-1 do
820 begin
821 if q[c]<100 then
822 begin
823 // ze:=((q[c]-ze2s)+100+(100-ze2s))/200;
824 // zez:=((q[c]-zez2s)+100+(100-zez2s))/200;
825 ze:= (q[c]-ze2s)/200;
826 zez:=(q[c]-zez2s)/200;
827 if ze<=0 then ze:=0;
828
829 xptr^:=round(longint(xptr^)*(zez));
830 inc(xptr);
831 xptr^:=round(longint(xptr^)*ze);
832 inc(xptr);
833 xptr^:=round(longint(xptr^)*ze);
834 inc(xptr);
835 //xptr^:=round(longint(xptr^)*ze); // alfa
836 inc(xptr);
837 {
838 ba:=imcache.colors[z,x];
839 ba.red:=round(longint(ba.red)*ze);
840 ba.green:=round(longint(ba.green)*ze);
841 ba.blue:=round(longint(ba.blue)*(zez));
842 imcache.colors[z,x]:=ba;
843 }
844 end
845 else inc(xptr,4);
846 inc(c);
847 end;
848 end;
849 obrT.CopyPixels(obrA);
850 obmap.LoadFromIntfImage(obrT);
851
852 end;
853 // r.right:=r.left;
854 if r.left=r.right then
855 begin
856 r.Right:=r.left+obsi-1;
857 r.bottom:=r.top+obvy-1;
858 Can.Draw(r.left,r.top,obmap);
859 end
860 else
861 Can.StretchDraw(r,obmap);
862
863 if caraen then
864 begin
865 cmarni(carax1,caray1,carax2,caray2,true);
866 // can.Font.Color:=clyellow;
867 // can.TextOut(10,10,inttostr(round(carax1))+':'+inttostr(round(caray1)));
868 // can.TextOut(10,20,inttostr(round(carax2))+':'+inttostr(round(caray2)));
869 end;
870 for z:=0 to body_poc-1 do
871 begin
872 bod_cmarni(body[z]);
873 end;
874 nrd:=false;
875 end;
876
877 procedure Tgrayline.kresli1(x1,y1:longint;can:Tcanvas);
878 var r:Trect;
879 begin
880 if chcipni then exit;
881 r.left:=x1;
882 r.right:=x1;
883 r.top:=y1;
884 r.bottom:=y1;
885 kresli(r,can);
886 end;
887
888 procedure Tgrayline.jachcucaru(en:boolean;x1,y1,x2,y2:extended);
889 begin
890 if chcipni then exit;
891 caraen:=en;
892 if (abs(y1)>90) or (abs(y2)>90) then
893 begin
894 caraen:=false;exit;
895 end;
896 while x1>180 do x1:=x1-360;
897 while x1<-180 do x1:=x1+360;
898 while x2>180 do x2:=x2-360;
899 while x2<-180 do x2:=x2+360;
900
901 if x1>x2 then
902 begin
903 carax1:=x2;
904 carax2:=x1;
905 caray1:=y2;
906 caray2:=y1;
907 end
908 else
909 begin
910 carax1:=x1;
911 carax2:=x2;
912 caray1:=y1;
913 caray2:=y2;
914 end;
915 end;
916
917 procedure Tgrayline.body_add(typ:byte;x1,y1,x2,y2:extended;popis:string;barva:tcolor;vel_bodu:longint);
918 begin
919 if chcipni then exit;
920 if body_poc<body_max-1 then
921 begin
922 body[body_poc].typ:=typ;
923 body[body_poc].x1:=x1;
924 body[body_poc].y1:=y1;
925 body[body_poc].x2:=x2;
926 body[body_poc].y2:=y2;
927 body[body_poc].popis:=copy(popis,1,body_popis_max);
928 body[body_poc].barva:=barva;
929 body[body_poc].vel_bodu:=vel_bodu;
930 inc(body_poc);
931 end;
932 end;
933
934 procedure Tgrayline.body_smaz;
935 begin
936 body_poc:=0;
937 end;
938
939 end.
940