CCONTR.PAS 24 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877
  1. Unit CContr;
  2. INTERFACE
  3. Uses Win2K2,Graph,CoolKey;
  4. Function InitCommonControls:INT16;
  5. IMPLEMENTATION
  6. Type
  7. PButSet = ^TButtonSettings;
  8. TButtonSettings = record
  9. bPressed, bEnabled, bVisible,bInside : boolean;
  10. Handle : HWND;
  11. ID : UINT16;
  12. Next : PButSet;
  13. end;
  14. const
  15. AllButtons : PButSet = nil;
  16. Function ButtonProc(ahWnd:HWND;aMsg,wParam,lParam:UINT32):UINT32;far;
  17. var
  18. c1,c2:UINT8;
  19. nB,c : PButSet;
  20. ps : LPPAINTSTRUCT;
  21. Txt : String[100];
  22. box : RECT;
  23. begin
  24. case aMsg of
  25. WM_CREATE:
  26. begin
  27. if AllButtons = nil then
  28. begin
  29. New(AllButtons);
  30. AllButtons^.Next := nil;
  31. end;
  32. New(nB);
  33. with nB^ do
  34. begin
  35. bPressed := false;bEnabled := true; bVisible := true;
  36. bInside := false;
  37. ID := 0;
  38. Handle := ahWnd;
  39. Next := nil;
  40. end;
  41. c := AllButtons; while c^.next <> nil do c := c^.Next;
  42. c^.Next := nB;
  43. PostMessage(ahWnd,WM_PAINT,0,0);
  44. end;
  45. WM_DESTROY:
  46. begin
  47. if AllButtons^.Next <> nil then
  48. begin
  49. c := AllButtons;
  50. while c^.next^.Handle <> ahWnd do c := c^.next;
  51. nB := c^.next;c^.next := nB^.Next;
  52. Dispose(nB);
  53. end
  54. else
  55. begin
  56. Dispose(AllButtons);
  57. AllButtons := nil;
  58. end;
  59. PostQuitMessage(ahWnd);
  60. end;
  61. WM_GETVISIBLE:
  62. begin
  63. if AllButtons = nil then exit;
  64. c:=AllButtons^.next; while c^.Handle <> aHwnd do c := c^.next;
  65. ButtonProc := UINT32(C^.bVisible);
  66. end;
  67. WM_SETVISIBLE:
  68. begin
  69. if AllButtons = nil then exit;
  70. c:=AllButtons^.next; while c^.Handle <> aHwnd do c := c^.next;
  71. C^.bVisible := boolean(wParam);
  72. PostMessage(ahWnd,WM_PAINT,0,0);
  73. end;
  74. WM_LBUTTONDOWN:
  75. begin
  76. c := AllButtons^.Next;
  77. while c^.Handle <> ahWnd do c := c^.next;
  78. with c^ do
  79. begin
  80. if bEnabled and bVisible then
  81. begin
  82. bPressed := true;
  83. PostMessage(ahWnd,WM_PAINT,0,0);
  84. PostMessage(GetParent(ahWnd),WM_COMMAND,ID,1);
  85. end;
  86. end;
  87. end;
  88. CB_SETID:
  89. begin
  90. c := AllButtons^.Next;
  91. while c^.Handle <> ahWnd do c := c^.next;
  92. with c^ do ID := wParam;
  93. end;
  94. CB_GETID:
  95. begin
  96. c := AllButtons^.Next;
  97. while c^.Handle <> ahWnd do c := c^.next;
  98. with c^ do ButtonProc := ID;
  99. end;
  100. WM_LBUTTONUP:
  101. begin
  102. c := AllButtons^.Next;
  103. while c^.Handle <> ahWnd do c := c^.next;
  104. with c^ do
  105. begin
  106. if bEnabled and bVisible and bPressed and bInside then
  107. begin
  108. PostMessage(GetParent(ahWnd),WM_COMMAND,ID,0);
  109. PostMessage(ahWnd,WM_PAINT,0,0);
  110. bPressed := false;
  111. end;
  112. end;
  113. end;
  114. WM_MOUSEIN:
  115. begin
  116. c := AllButtons^.Next;
  117. while c^.Handle <> ahWnd do c := c^.next;
  118. with c^ do
  119. begin
  120. bInside := true;
  121. PostMessage(ahWnd,WM_PAINT,0,0);
  122. end;
  123. end;
  124. WM_MOUSEOUT:
  125. begin
  126. c := AllButtons^.Next;
  127. while c^.Handle <> ahWnd do c := c^.next;
  128. with c^ do
  129. begin
  130. bInside := false;
  131. PostMessage(ahWnd,WM_PAINT,0,0);
  132. end;
  133. end;
  134. WM_KEYDOWN:
  135. begin
  136. c := AllButtons^.Next;
  137. while c^.Handle <> ahWnd do c := c^.next;
  138. with c^ do
  139. begin
  140. if (wParam = ord(SC_ENTER)) and bEnabled and bVisible then
  141. PostMessage(GetParent(ahWnd),WM_COMMAND,ID,1);
  142. end;
  143. end;
  144. WM_KEYUP:
  145. begin
  146. c := AllButtons^.Next;
  147. while c^.Handle <> ahWnd do c := c^.next;
  148. with c^ do
  149. begin
  150. if (wParam = ord(SC_ENTER)) and bEnabled and bVisible then
  151. PostMessage(GetParent(ahWnd),WM_COMMAND,ID,0);
  152. end;
  153. end;
  154. WM_PAINT:
  155. begin
  156. c := AllButtons^.Next;
  157. if c = nil then exit;
  158. while c^.Handle <> ahWnd do c := c^.next;
  159. with c^ do
  160. begin
  161. ps := BeginPaint(ahWnd);
  162. wSetBGColor(ps,GlobalPalette.ThreeDColor1);
  163. wSetStyle(ps,SolidFill);
  164. wSetColor(ps,GlobalPalette.WindowFontColor);
  165. wSetFontJustify(ps,CenterText,CenterText);
  166. GetClientRect(ahWnd,@box);
  167. GetWindowText(ahWnd,@Txt,100);
  168. wBar(ps,0,0,box.b.x,box.b.y);
  169. if bVisible then
  170. begin
  171. if bInside then
  172. begin
  173. if bPressed then
  174. begin
  175. c1:=Black;
  176. c2:=White;
  177. wTextOut(ps,(Box.B.X shr 1)+1,(Box.B.Y shr 1)+1, @Txt);
  178. end
  179. else
  180. begin
  181. c2:=Black;
  182. c1:=White;
  183. wTextOut(ps,(Box.B.X shr 1),(Box.B.Y shr 1), @Txt);
  184. end;
  185. wSetColor(ps,c1);
  186. wLine(ps,0,0,Box.B.X-1,0);
  187. wLine(ps,0,0,0,Box.B.Y-1);
  188. wSetColor(ps,c2);
  189. wLine(ps,0,Box.B.Y,Box.B.X-1,Box.B.Y);
  190. wLine(ps,Box.B.X,0,Box.B.X,Box.B.Y);
  191. end
  192. else
  193. wTextOut(ps,Box.B.X shr 1,Box.B.Y shr 1, @Txt);
  194. end;
  195. EndPaint(ps);
  196. end;
  197. end;
  198. end;
  199. end;
  200. type
  201. PCheckSet = ^TCheckSet;
  202. TCheckSet = record
  203. bChecked, bEnabled, bVisible : boolean;
  204. ID : UINT32;
  205. Handle : HWND;
  206. Next : PCheckSet;
  207. end;
  208. const
  209. AllChecks : PCheckSet = nil;
  210. Function CheckProc(ahWnd:HWND;aMsg,wParam,lParam:UINT32):UINT32;far;
  211. var
  212. nB,c : PCheckSet;
  213. ps : LPPAINTSTRUCT;
  214. Txt : String;
  215. box : RECT;
  216. begin
  217. case aMsg of
  218. WM_CREATE:
  219. begin
  220. if AllChecks = nil then
  221. begin
  222. New(AllChecks);
  223. AllChecks^.Next := nil;
  224. end;
  225. New(nB);
  226. with nB^ do
  227. begin
  228. bChecked := false;bEnabled := true; bVisible := true;
  229. Handle := ahWnd;
  230. ID := UINT32(ahWnd);
  231. Next := nil;
  232. end;
  233. c := AllChecks; while c^.next <> nil do c := c^.Next;
  234. c^.Next := nB;
  235. PostMessage(ahWnd,WM_PAINT,0,0);
  236. end;
  237. WM_DESTROY:
  238. begin
  239. if AllChecks^.Next <> nil then
  240. begin
  241. c := AllChecks;
  242. while c^.next^.Handle <> ahWnd do c := c^.next;
  243. nB := c^.next;c^.next := nB^.Next;
  244. Dispose(nB);
  245. end
  246. else
  247. begin
  248. Dispose(AllChecks);
  249. AllChecks := nil;
  250. end;
  251. PostQuitMessage(ahWnd);
  252. end;
  253. CB_SETID:
  254. begin
  255. c := AllChecks^.Next;
  256. while c^.Handle <> ahWnd do c := c^.next;
  257. with c^ do ID := wParam;
  258. end;
  259. CB_GETID:
  260. begin
  261. c := AllChecks^.Next;
  262. while c^.Handle <> ahWnd do c := c^.next;
  263. with c^ do CheckProc := ID;
  264. end;
  265. WM_GETVISIBLE:
  266. begin
  267. if AllChecks = nil then exit;
  268. c:=AllChecks^.next; while c^.Handle <> aHwnd do c := c^.next;
  269. CheckProc := UINT32(C^.bVisible);
  270. end;
  271. WM_SETVISIBLE:
  272. begin
  273. if AllChecks = nil then exit;
  274. c:=AllChecks^.next; while c^.Handle <> aHwnd do c := c^.next;
  275. C^.bVisible := boolean(wParam);
  276. PostMessage(ahWnd,WM_PAINT,0,0);
  277. end;
  278. WM_LBUTTONDOWN:
  279. begin
  280. c := AllChecks^.Next; while c^.Handle <> ahWnd do c := c^.next;
  281. with c^ do
  282. begin
  283. if bEnabled and bVisible then
  284. begin
  285. PostMessage(GetParent(ahWnd),WM_COMMAND,ID,1);
  286. end;
  287. end;
  288. end;
  289. WM_LBUTTONUP:
  290. begin
  291. c := AllChecks^.Next; while c^.Handle <> ahWnd do c := c^.next;
  292. with c^ do if bEnabled and bVisible then
  293. begin
  294. bChecked := not bChecked;
  295. PostMessage(ahWnd,WM_PAINT,0,0);
  296. PostMessage(GetParent(ahWnd),WM_COMMAND,ID,0);
  297. end;
  298. end;
  299. WM_KEYDOWN:
  300. begin
  301. c := AllChecks^.Next; while c^.Handle <> ahWnd do c := c^.next;
  302. with c^ do
  303. begin
  304. if (wParam = ord(SC_SPACE)) and bEnabled and bVisible then
  305. begin
  306. bChecked := not bChecked;
  307. PostMessage(ahWnd,WM_PAINT,0,0);
  308. end;
  309. end;
  310. end;
  311. CB_GETCHECK:
  312. begin
  313. c := AllChecks^.Next; while c^.Handle <> ahWnd do c := c^.next;
  314. with c^ do CheckProc := UINT32(bChecked);
  315. end;
  316. CB_SETCHECK:
  317. begin
  318. c := AllChecks^.Next; while c^.Handle <> ahWnd do c := c^.next;
  319. with c^ do bChecked := boolean(wParam);
  320. PostMessage(ahWnd,WM_PAINT,0,0);
  321. end;
  322. WM_PAINT:
  323. begin
  324. if AllChecks = nil then exit;
  325. c := AllChecks^.Next;
  326. if c = nil then exit;
  327. while c^.Handle <> ahWnd do c := c^.next;
  328. with c^ do
  329. begin
  330. ps := BeginPaint(ahWnd);
  331. wSetBGColor(ps,GlobalPalette.ThreeDColor1);
  332. wSetStyle(ps,SolidFill);
  333. GetClientRect(ahWnd,@box);
  334. wBar(ps,0,0,box.b.x,box.b.y);
  335. if bVisible then
  336. begin
  337. wSetColor(ps,GlobalPalette.ThreeDColor2);
  338. wRectangle(ps,1,1,box.b.y-2,box.b.y-2);
  339. wSetColor(ps,Black);
  340. if bChecked then
  341. begin
  342. wLine(ps,2,2,(box.b.y-2) shr 1, box.b.y-3);
  343. wLine(ps,(box.b.y-2) shr 1,box.b.y-3,box.b.y-3,2);
  344. end;
  345. wSetColor(ps,GlobalPalette.WindowFontColor);
  346. wSetFontJustify(ps,LeftText,CenterText);
  347. GetWindowText(ahWnd,@Txt,255);
  348. wTextOut(ps,box.b.y+1,box.b.y shr 1,@Txt);
  349. end;
  350. EndPaint(ps);
  351. end;
  352. end;
  353. end;
  354. end;
  355. Type
  356. PEditSet = ^TEditSettings;
  357. TEditSettings = record
  358. bEnabled, bVisible : boolean;
  359. CurPos,fVis,MaxLen : INT16;
  360. Handle : HWND;
  361. Next : PEditSet;
  362. end;
  363. const
  364. AllEdits : PEditSet = nil;
  365. Function EditProc(ahWnd:HWND;aMsg,wParam,lParam:UINT32):UINT32;far;
  366. var
  367. x : INT16;
  368. c1 : UINT8;
  369. ps : LPPAINTSTRUCT;
  370. nE,c : PEditSet;
  371. Txt : String;
  372. cc : char;
  373. box : RECT;
  374. begin
  375. case aMsg of
  376. WM_CREATE:
  377. begin
  378. if AllEdits = nil then
  379. begin
  380. New(AllEdits);
  381. AllEdits^.Next := nil;
  382. end;
  383. New(nE);
  384. with nE^ do
  385. begin
  386. bEnabled := true; bVisible := true;
  387. CurPos := 0;fVis := 0;
  388. MaxLen := Round(PWindow(lParam)^.Pos.B.X / TextWidth('H'));
  389. Handle := ahWnd;
  390. Next := nil;
  391. end;
  392. c := AllEdits; while c^.next <> nil do c:=c^.next; c^.Next := nE;
  393. PostMessage(ahWnd,WM_PAINT,0,0);
  394. end;
  395. WM_DESTROY:
  396. begin
  397. if AllEdits^.Next <> nil then
  398. begin
  399. c := AllEdits;
  400. while c^.next^.Handle <> ahWnd do c := c^.next;
  401. nE := c^.next;c^.next := nE^.Next;
  402. Dispose(nE);
  403. end
  404. else
  405. begin
  406. Dispose(AllEdits);
  407. AllEdits := nil;
  408. end;
  409. PostQuitMessage(ahWnd);
  410. end;
  411. WM_GETVISIBLE:
  412. begin
  413. if AllEdits = nil then exit;
  414. c:=AllEdits^.next; while c^.Handle <> aHwnd do c := c^.next;
  415. EditProc := UINT32(C^.bVisible);
  416. end;
  417. WM_SETVISIBLE:
  418. begin
  419. if AllEdits = nil then exit;
  420. c:=AllEdits^.next; while c^.Handle <> aHwnd do c := c^.next;
  421. C^.bVisible := boolean(wParam);
  422. PostMessage(ahWnd,WM_PAINT,0,0);
  423. end;
  424. WM_LOSTFOCUS:
  425. PostMessage(aHWnd,WM_PAINT,0,0);
  426. WM_LBUTTONDOWN:
  427. begin
  428. c := AllEdits^.next; while c^.handle <> aHWnd do c := c^.next;
  429. with c^ do
  430. begin
  431. if bEnabled and bVisible then
  432. begin
  433. GetWindowText(ahWnd,@Txt,255);
  434. x := lParam AND $FFFF;
  435. if x > 5 then
  436. begin
  437. CurPos := fVis + round((1.0*x-5) / TextWidth('H'));
  438. if CurPos > Length(Txt) then CurPos := Length(Txt);
  439. PostMessage(ahWnd,WM_PAINT,0,0);
  440. end;
  441. end;
  442. end;
  443. end;
  444. WM_KEYDOWN:
  445. begin
  446. c := AllEdits^.next; while c^.handle <> aHWnd do c := c^.next;
  447. with c^ do
  448. begin
  449. if bEnabled and bVisible then
  450. begin
  451. GetWindowText(ahWnd,@Txt,255);
  452. if ((wParam = ord(SC_LEFT)) or ((wParam = ord (SC_PAD_HOME)) AND ifNum))
  453. AND (CurPos > 0) then
  454. begin
  455. Dec(CurPos);
  456. if CurPos < fVis then fVis := CurPos;
  457. end
  458. else
  459. if ((wParam = ord(SC_RIGHT)) or ((wParam = ord (SC_PAD_RIGHT)) AND ifNum))
  460. AND (CurPos <> Length(Txt)) and (Length(Txt) <> 0) then
  461. begin
  462. if CurPos <> Length(Txt) then inc(CurPos);
  463. if (CurPos-fVis) >= MaxLen then inc(fVis);
  464. end
  465. else
  466. if (wParam = ord(SC_HOME)) or ((wParam = ord (SC_PAD_HOME)) AND ifNum) then
  467. begin
  468. CurPos := 0;
  469. fVis := 0;
  470. end
  471. else
  472. if (wParam = ord(SC_END)) or ((wParam = ord (SC_PAD_END)) AND ifNum) then
  473. begin
  474. CurPos := Length(Txt);
  475. if (CurPos-fVis) >= MaxLen then fVis := CurPos-MaxLen+1;
  476. end
  477. else
  478. if (wParam = ord(SC_DELETE)) or ((wParam = ord (SC_PAD_DEL)) AND ifNum) then
  479. begin
  480. Delete(Txt,CurPos+1,1);
  481. SetWindowText(ahWnd,@Txt);
  482. end
  483. else
  484. if wParam = ord(SC_BACKSPACE) then
  485. begin
  486. if CurPos > 0 then
  487. begin
  488. Delete(Txt,Curpos,1);
  489. Dec(Curpos);
  490. if CurPos < fVis then fVis := CurPos;
  491. SetWindowText(ahWnd,@Txt);
  492. end;
  493. end
  494. else
  495. if PrintChar(wParam AND $FF) then
  496. begin
  497. Insert(Char(lParam AND $FF),Txt,CurPos+1);
  498. {if CurPos = Length(Txt)-1 then}
  499. Inc(CurPos);
  500. if (CurPos-fVis) >= MaxLen then inc(fVis);
  501. SetWindowText(ahWnd,@Txt);
  502. end;
  503. PostMessage(ahWnd,WM_PAINT,0,0);
  504. end;
  505. end;
  506. end;
  507. WM_PAINT:
  508. begin
  509. c := AllEdits^.next;
  510. if C = nil then exit;
  511. while c^.handle <> aHWnd do c := c^.next;
  512. with c^ do
  513. begin
  514. ps := BeginPaint(ahWnd);
  515. wSetBGColor(ps,GlobalPalette.WindowBGColor);
  516. wSetStyle(ps,SolidFill);
  517. GetClientRect(ahWnd,@box);
  518. wBar(ps,0,0,box.b.x,box.b.y);
  519. if bVisible then
  520. begin
  521. wSetBGColor(ps,GlobalPalette.ThreeDColor1);
  522. wBar(ps,1,1,box.b.x-1,box.b.y-1);
  523. GetWindowText(ahWnd,@Txt,255);
  524. Txt := Copy(Txt,fVis+1,MaxLen);
  525. wSetFontJustify(ps,LeftText,CenterText);
  526. wSetColor(ps,GlobalPalette.WindowFontColor);
  527. wTextOut(ps,5,Box.B.Y shr 1, @Txt);
  528. if IsKeyActive(ahWnd) then
  529. wLine(ps,4+(CurPos-fVis)*TextWidth('H'),
  530. (Box.B.Y shr 1) - (TextHeight('H') shr 1) - 1,
  531. 4+(CurPos-fVis)*TextWidth('H'),
  532. (Box.B.Y shr 1) + (TextHeight('H') shr 1) + 1);
  533. end;
  534. EndPaint(ps);
  535. end;
  536. end;
  537. end;
  538. end;
  539. Function LabelProc(ahWnd:HWND;aMsg,wParam,lParam:UINT32):UINT32;far;
  540. var
  541. ps : LPPAINTSTRUCT;
  542. Txt : String;
  543. box : RECT;
  544. begin
  545. case aMsg of
  546. WM_PAINT:
  547. begin
  548. ps := BeginPaint(ahWnd);
  549. GetClientRect(ahWnd,@box);
  550. wSetStyle(ps,SolidFill);
  551. wSetBGColor(ps,GlobalPalette.ThreeDColor1);
  552. wBar(ps,1,1,box.b.x-1,box.b.y-1);
  553. GetWindowText(ahWnd,@Txt,255);
  554. wSetFontJustify(ps,LeftText,CenterText);
  555. wSetColor(ps,GlobalPalette.WindowFontColor);
  556. Txt := Copy(Txt,1,round((Box.B.X-5) / TextWidth('H')));
  557. wTextOut(ps,3,Box.B.Y shr 1, @Txt);
  558. EndPaint(ps);
  559. end;
  560. else LabelProc:=DefWindowProc(aHwnd,aMsg,wParam,lParam);
  561. end;
  562. end;
  563. Type
  564. PPointList = ^TPointList;
  565. TPointList = record
  566. X,Y : real;
  567. Next : PPointList;
  568. end;
  569. TPlotData = record
  570. Color : UINT8;
  571. Render : boolean;
  572. MaxX,MinX,MaxY,MinY : real;
  573. Points : PPointList;
  574. end;
  575. TPlotDataArr = array [0..10] of TPlotData;
  576. PPlotDataArr = ^TPlotDataArr;
  577. PPlotSet = ^XYPlotSettings;
  578. XYPlotSettings = record
  579. Handle : HWND;
  580. bVisible : boolean;
  581. BgColor : UINT8;
  582. XYCnt : UINT8;
  583. Plots : PPlotDataArr;
  584. Next : PPlotSet;
  585. end;
  586. const
  587. AllPlots : PPlotSet = nil;
  588. Procedure InitPlot(var aP:TPlotData;aColor:UINT8);
  589. begin
  590. with aP do begin
  591. MaxX:=0;MinX:=0;MaxY:=0;MinY:=0;Color:=aColor;
  592. Render := true;
  593. New(Points);
  594. Points^.X:=0;
  595. Points^.Y:=0;
  596. Points^.Next:=nil;
  597. end;
  598. end;
  599. Function XYPlotProc(ahWnd:HWND;aMsg,wParam,lParam:UINT32):UINT32;far;
  600. var
  601. i : UINT16;
  602. px,py: int16;
  603. SX,SY: real;
  604. ps : LPPAINTSTRUCT;
  605. nB,c : PPlotSet;
  606. nP : PPlotDataArr;
  607. cp,cc: PPointList;
  608. box : RECT;
  609. begin
  610. case aMsg of
  611. WM_CREATE:
  612. begin
  613. if AllPlots = nil then
  614. begin
  615. New(AllPlots);
  616. AllPlots^.next := nil;
  617. end;
  618. New(nB);
  619. with nB^ do
  620. begin
  621. Handle := ahWnd; bVisible := true;
  622. BGColor := Black; XYCnt := 1;
  623. Plots := Alloc(Sizeof(TPlotData));
  624. InitPlot(Plots^[0],Red);
  625. end;
  626. c := AllPlots;
  627. while c^.next <> nil do c:=c^.next;
  628. c^.Next := nB;
  629. end;
  630. WM_DESTROY:
  631. begin
  632. if AllPlots^.next <> nil then
  633. begin
  634. c:=AllPlots; while c^.next^.handle <> aHWND do c := c^.next;
  635. nB := c^.next;
  636. c^.next := nB^.next;
  637. with nB^ do
  638. begin
  639. for i := 0 to XYCnt-1 do with Plots^[i] do
  640. while Points <> nil do
  641. begin
  642. cP := Points^.next;
  643. Dispose(Points);
  644. Points := cP;
  645. end;
  646. FreeMem(Plots,SizeoF(TPlotData)*XYCnt);
  647. end;
  648. Dispose(nB);
  649. end
  650. else
  651. begin
  652. Dispose(AllPlots);
  653. AllPlots:=nil;
  654. end;
  655. PostQuitMessage(ahWnd);
  656. end;
  657. XP_SETPLOTCOUNT:
  658. begin
  659. if AllPlots = nil then exit;
  660. c:=AllPlots^.next; while c^.Handle <> aHwnd do c := c^.next;
  661. with c^ do
  662. begin
  663. if wParam < XYCnt then exit;
  664. GetMem(nP,Sizeof(TPlotData)*wParam);
  665. FillChar(np^,Sizeof(TPlotData)*wParam,0);
  666. Move(Plots^,nP^,Sizeof(TPlotData)*XYCnt);
  667. FreeMem(Plots,Sizeof(TPlotData)*XYCnt);
  668. Plots := nP;
  669. for i := XYCnt to wParam-1 do InitPlot(Plots^[i],i+1-XYCnt);
  670. XYCnt := wParam;
  671. end;
  672. end;
  673. XP_GETPLOTCOUNT:
  674. begin
  675. if AllPlots = nil then exit;
  676. c:=AllPlots^.next; while c^.Handle <> aHwnd do c := c^.next;
  677. with c^ do XYPlotProc := XYCnt;
  678. end;
  679. XP_SETCOLOR:
  680. begin
  681. if AllPlots = nil then exit;
  682. c:=AllPlots^.next; while c^.Handle <> aHwnd do c := c^.next;
  683. with c^ do if wParam < XYCnt then Plots^[wParam].Color := lParam;
  684. end;
  685. XP_GETCOLOR:
  686. begin
  687. if AllPlots = nil then exit;
  688. c:=AllPlots^.next; while c^.Handle <> aHwnd do c := c^.next;
  689. with c^ do if wParam < XYCnt then XYPlotProc := Plots^[wParam].Color;
  690. end;
  691. XP_SETXRANGE:
  692. begin
  693. if AllPlots = nil then exit;
  694. if lParam = 0 then exit;
  695. c:=AllPlots^.next; while c^.Handle <> aHwnd do c := c^.next;
  696. with c^ do if wParam < XYCnt then with Plots^[wParam] do
  697. begin
  698. MinX := PRPoint(lParam)^.X;
  699. MaxX := PRPoint(lParam)^.Y;
  700. end;
  701. end;
  702. XP_GETXRANGE:
  703. begin
  704. if AllPlots = nil then exit;
  705. if lParam = 0 then exit;
  706. c:=AllPlots^.next; while c^.Handle <> aHwnd do c := c^.next;
  707. with c^ do if wParam < XYCnt then with Plots^[wParam] do
  708. begin
  709. PRPoint(lParam)^.X := MinX;
  710. PRPoint(lParam)^.Y := MaxX;
  711. end;
  712. end;
  713. XP_SETYRANGE:
  714. begin
  715. if AllPlots = nil then exit;
  716. if lParam = 0 then exit;
  717. c:=AllPlots^.next; while c^.Handle <> aHwnd do c := c^.next;
  718. with c^ do if wParam < XYCnt then with Plots^[wParam] do
  719. begin
  720. MinY := PRPoint(lParam)^.X;
  721. MaxY := PRPoint(lParam)^.Y;
  722. end;
  723. end;
  724. WM_SETVISIBLE:
  725. begin
  726. if AllPlots = nil then exit;
  727. c:=AllPlots^.next; while c^.Handle <> aHwnd do c := c^.next;
  728. with c^ do if wParam < XYCnt then with Plots^[wParam] do
  729. begin
  730. Render := boolean(lParam);
  731. PostMessage(ahwnd,WM_PAINT,0,0);
  732. end;
  733. end;
  734. WM_GETVISIBLE:
  735. begin
  736. if AllPlots = nil then exit;
  737. c:=AllPlots^.next; while c^.Handle <> aHwnd do c := c^.next;
  738. with c^ do if wParam < XYCnt then with Plots^[wParam] do
  739. XYPlotProc := UINT32(Render);
  740. end;
  741. XP_GETYRANGE:
  742. begin
  743. if AllPlots = nil then exit;
  744. if lParam = 0 then exit;
  745. c:=AllPlots^.next; while c^.Handle <> aHwnd do c := c^.next;
  746. with c^ do if wParam < XYCnt then with Plots^[wParam] do
  747. begin
  748. PRPoint(lParam)^.X := MinY;
  749. PRPoint(lParam)^.Y := MaxY;
  750. end;
  751. end;
  752. XP_ADDPOINT:
  753. begin
  754. if AllPlots = nil then exit;
  755. if lParam = 0 then exit;
  756. c:=AllPlots^.next; while c^.Handle <> aHwnd do c := c^.next;
  757. if wParam < c^.XYCnt then with c^.Plots^[wParam] do
  758. begin
  759. New(cP);
  760. with cP^ do
  761. begin
  762. X:=PRPoint(lParam)^.X;
  763. Y:=PRPoint(lParam)^.Y;
  764. next := nil;
  765. end;
  766. if cp^.X < MinX then MinX:=cp^.X;
  767. if cp^.X > MaxX then MaxX:=cp^.X;
  768. if cp^.Y < MinY then MinY:=cp^.Y;
  769. if cp^.Y > MaxY then MaxY:=cp^.Y;
  770. cc := Points;
  771. while (cc^.next <> nil) and (cc^.next^.x < cP^.X) do cc := cc^.next;
  772. cP^.Next := cc^.next;
  773. cc^.next := cP;
  774. {PostMessage(aHWnd,WM_PAINT,0,0);}
  775. end;
  776. end;
  777. XP_DELPOINT:
  778. begin
  779. if AllPlots = nil then exit;
  780. if lParam = 0 then exit;
  781. c:=AllPlots^.next; while c^.Handle <> aHwnd do c := c^.next;
  782. if wParam < c^.XYCnt then with c^.Plots^[wParam] do
  783. begin
  784. cc := Points;
  785. while (cc^.next<>nil) and not ( (cc^.Next^.x = PRPoint(lParam)^.X) AND
  786. (cc^.Next^.Y = PRPoint(lParam)^.Y)) do
  787. cc := cc^.next;
  788. if cc^.next <> nil then
  789. begin
  790. cP := cc^.next;
  791. cc^.next:=cp^.next;
  792. Dispose(cP);
  793. PostMessage(aHWnd,WM_PAINT,0,0);
  794. end;
  795. end;
  796. end;
  797. XP_DELALLPOINTS:
  798. begin
  799. if AllPlots = nil then exit;
  800. c:=AllPlots^.next; while c^.Handle <> aHwnd do c := c^.next;
  801. if wParam < c^.XYCnt then with c^.Plots^[wParam] do
  802. while Points^.next <> nil do
  803. begin
  804. cP := Points^.next^.next;
  805. Dispose(Points^.next);
  806. Points^.next := cP;
  807. end;
  808. end;
  809. WM_PAINT:
  810. begin
  811. if AllPlots = nil then exit;
  812. c:=AllPlots^.next; while c^.Handle <> aHwnd do c := c^.next;
  813. with c^ do if bVisible then
  814. begin
  815. ps := BeginPaint(ahWnd);
  816. GetClientRect(ahWnd,@box);
  817. wSetStyle(ps,SolidFill);
  818. wSetBGColor(ps,BGColor);
  819. wBar(ps,0,0,box.b.x,box.b.y);
  820. for i := 0 to XYCnt-1 do if (Plots^[i].Points^.next <> nil) AND
  821. Plots^[i].Render then
  822. with Plots^[i] do
  823. begin
  824. SX := MaxX-MinX; SY := MaxY-MinY;
  825. wSetColor(ps,Color);
  826. {wSetBGColor(ps,Color);}
  827. px := round(Box.B.X*(Points^.Next^.X-MinX)/SX);
  828. py := round(Box.B.Y*(1-(Points^.Next^.Y-MinY)/SY));
  829. {wFillCircle(ps,px,py,2);}
  830. wMoveToEx(ps,px,py,nil);
  831. cc := Points^.next^.next;
  832. while cc<>nil do
  833. begin
  834. px := round(Box.B.X*(cc^.X-MinX)/SX);
  835. py := round(Box.B.Y*(1-(cc^.Y-MinY)/SY));
  836. {wFillCircle(ps,px,py,2);}
  837. wLineTo(ps,px,py);
  838. cc := cc^.next;
  839. end;
  840. end;
  841. EndPaint(ps);
  842. end;
  843. end;
  844. end;
  845. end;
  846. Function InitCommonControls:INT16;
  847. begin
  848. RegisterClass('BUTTON',ButtonProc);
  849. RegisterClass('EDIT',EditProc);
  850. RegisterClass('LABEL',LabelProc);
  851. RegisterClass('XYPLOT',XYPlotProc);
  852. RegisterClass('CHECKBOX',CheckProc);
  853. end;
  854. END.