Recent

Author Topic: Repair the colors of a Dos program ported to ptcGraph unit  (Read 4282 times)

Roland57

  • Sr. Member
  • ****
  • Posts: 421
    • msegui.net
Re: Repair the colors of a Dos program ported to ptcGraph unit
« Reply #15 on: October 27, 2020, 12:49:50 pm »
I changed the graphic mode to 16 colors. Now you really have the feeling of a Dos program.  :)
« Last Edit: October 27, 2020, 12:51:22 pm by Roland57 »
My projects are on Gitlab and on Codeberg.

Fred vS

  • Hero Member
  • *****
  • Posts: 3158
    • StrumPract is the musicians best friend
Re: Repair the colors of a Dos program ported to ptcGraph unit
« Reply #16 on: October 27, 2020, 02:55:15 pm »
Quote
There remains ony one small memory leak: I don't find where it comes from.

Imho, it comes from engine88.pas

You may try this:

Code: Pascal  [Select][+][-]
  1. program nero5_test;
  2. uses
  3.   cthreads,
  4.   engine88;
  5.  
  6. begin
  7. end.

Compile it with this:

Code: Bash  [Select][+][-]
  1. $ fpc -ghl nero5_test.pas

I get that:

Quote
fred@fiens $ ./nero5_test

Heap dump by heaptrc unit of nero5_test
1260 memory blocks allocated : 115031/117752
1259 memory blocks freed     : 114983/117704
1 unfreed memory blocks : 48
True heap size : 229376
True free heap : 229120
Should be : 229136
Call trace for block $00007FD7F1068F00 size 48

But I did not investigate where is the guilty.

Fre;D
« Last Edit: October 27, 2020, 03:20:01 pm by Fred vS »
I use Lazarus 2.2.0 32/64 and FPC 3.2.2 32/64 on Debian 11 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt.

https://github.com/fredvs
https://gitlab.com/fredvs
https://codeberg.org/fredvs

Fred vS

  • Hero Member
  • *****
  • Posts: 3158
    • StrumPract is the musicians best friend
Re: Repair the colors of a Dos program ported to ptcGraph unit
« Reply #17 on: October 27, 2020, 03:13:39 pm »
Hum, in engine88.pas, in uses section there is:

Code: Pascal  [Select][+][-]
  1. uses
  2.   sysutils, ptccrt, ptcgraph;

Now doing this:

Code: Pascal  [Select][+][-]
  1. program nero5_test;
  2.  
  3. uses
  4.  cthreads,
  5.  ptccrt;
  6.  
  7. begin
  8. end.
  9.  

Compile it with:

Code: Bash  [Select][+][-]
  1. $ fpc -ghl nero5_test.pas

Gives the same result:

Quote
fred@fiens ~/roland> /home/fred/roland/nero5_test
Heap dump by heaptrc unit of /home/fred/roland/nero5_test
1260 memory blocks allocated : 115031/117752
1259 memory blocks freed     : 114983/117704
1 unfreed memory blocks : 48
True heap size : 229376
True free heap : 229120
Should be : 229136
Call trace for block $00007F008E667F00 size 48

Conclusion:

I fear that the memory leak is in ptccrt

Fre;D
I use Lazarus 2.2.0 32/64 and FPC 3.2.2 32/64 on Debian 11 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt.

https://github.com/fredvs
https://gitlab.com/fredvs
https://codeberg.org/fredvs

Fred vS

  • Hero Member
  • *****
  • Posts: 3158
    • StrumPract is the musicians best friend
Re: Repair the colors of a Dos program ported to ptcGraph unit
« Reply #18 on: October 27, 2020, 03:44:19 pm »
It is me again!

Continuing the battle:

In ptccrt.pp in uses section there is:

Code: Pascal  [Select][+][-]
  1. uses
  2.   ptcgraph, ptc, ptcwrapper, ...


And doing this:

   
Code: Pascal  [Select][+][-]
  1. program nero5_test;
  2.      
  3.     uses
  4.      cthreads,
  5.      ptcgraph;
  6.  
  7.   begin
  8.   end.
  9.  

Gives:   

Code: Pascal  [Select][+][-]
  1. fred@fiens ./nero5_test
  2. Heap dump by heaptrc unit of nero5_test
  3. 1259 memory blocks allocated : 111191/113912
  4. 1258 memory blocks freed     : 111143/113864
  5. 1 unfreed memory blocks : 48
  6. True heap size : 229376
  7. True free heap : 229120
  8. Should be : 229136
  9. Call trace for block $00007F0409FDDF00 size 48

Re-conclusion, the memory leak is in ptcgraph.pp

(and not in ptc.pp, ptcwrapper.pp that are in uses section of ptcgraph.pp)

There is something missing in Finalization section of ptcgraph.pp.

For the sport, I let you find where.

Fre;D



« Last Edit: October 27, 2020, 03:54:16 pm by Fred vS »
I use Lazarus 2.2.0 32/64 and FPC 3.2.2 32/64 on Debian 11 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt.

https://github.com/fredvs
https://gitlab.com/fredvs
https://codeberg.org/fredvs

Roland57

  • Sr. Member
  • ****
  • Posts: 421
    • msegui.net
Re: Repair the colors of a Dos program ported to ptcGraph unit
« Reply #19 on: October 27, 2020, 06:26:19 pm »
Thank your for your search Fred. So we should add this?

Code: Pascal  [Select][+][-]
  1. // ptcgraph.pp
  2. finalization
  3.   PTCFormat8.Destroy;
  4.   PTCFormat15.Destroy;
  5.   PTCFormat16.Destroy;

I would like to test, but I don't know what is the procedure to test a modification in FPC units.
My projects are on Gitlab and on Codeberg.

Fred vS

  • Hero Member
  • *****
  • Posts: 3158
    • StrumPract is the musicians best friend
Re: Repair the colors of a Dos program ported to ptcGraph unit
« Reply #20 on: October 27, 2020, 06:42:34 pm »
Thank your for your search Fred. So we should add this?

Code: Pascal  [Select][+][-]
  1. // ptcgraph.pp
  2. finalization
  3.   PTCFormat8.Destroy;
  4.   PTCFormat15.Destroy;
  5.   PTCFormat16.Destroy;

Hello Roland.

I did try this already but sadly it does not compile, even using .free;

Quote
ptcgraph.pp(3467,15) Error: (5038) identifier idents no member "Destroy"

I did a fast investigation but without luck, this memory leak is well hidden.


Quote
I would like to test, but I don't know what is the procedure to test a modification in FPC units.

I do a easy way, to be sure to not touch at the original source.

So, copy in the root directory of project all files that are in:
 
Code: Pascal  [Select][+][-]
  1. /fpc/src/packages/graph/src/ptcgraph/*.*

and in:

Code: Pascal  [Select][+][-]
  1. /fpc/src/packages/graph/src/inc/*.*

And tune those files then compile.
I use Lazarus 2.2.0 32/64 and FPC 3.2.2 32/64 on Debian 11 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt.

https://github.com/fredvs
https://gitlab.com/fredvs
https://codeberg.org/fredvs

Fred vS

  • Hero Member
  • *****
  • Posts: 3158
    • StrumPract is the musicians best friend
Re: Repair the colors of a Dos program ported to ptcGraph unit
« Reply #21 on: October 27, 2020, 07:00:12 pm »
[EDIT] Removed previous attachment, there was some file missing.

Hello Roland.

Here your project in attachment with all the needed files.

Fre;D
I use Lazarus 2.2.0 32/64 and FPC 3.2.2 32/64 on Debian 11 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt.

https://github.com/fredvs
https://gitlab.com/fredvs
https://codeberg.org/fredvs

Roland57

  • Sr. Member
  • ****
  • Posts: 421
    • msegui.net
Re: Repair the colors of a Dos program ported to ptcGraph unit
« Reply #22 on: October 27, 2020, 07:28:44 pm »
Thank you Fred.
My projects are on Gitlab and on Codeberg.

Fred vS

  • Hero Member
  • *****
  • Posts: 3158
    • StrumPract is the musicians best friend
Re: Repair the colors of a Dos program ported to ptcGraph unit
« Reply #23 on: October 27, 2020, 08:26:03 pm »
Thank you Fred.

With pleasure (if we find the guilty).

Something smells not good, in ptcgraph.pp and TPTCWrapperThread:

Using this to test the unit:

Code: Pascal  [Select][+][-]
  1. program nero5_test;
  2. uses
  3.  cthreads,
  4.  ptcgraph;
  5.  
  6. begin
  7. end.


And in ptcgraph.pp, If you use that code (removing all other lines in initialization and finalization):

Code: Pascal  [Select][+][-]
  1. ...
  2. initialization
  3.   PTCWrapperObject := TPTCWrapperThread.Create;
  4.  
  5. finalization
  6.   PTCWrapperObject.Terminate;
  7.   PTCWrapperObject.WaitFor;
  8.   PTCWrapperObject.Free;
  9. end.

The memory leak is still there.

So, imho, there is something not freed in PTCWrapperObject.

Fre;D
« Last Edit: October 27, 2020, 08:55:27 pm by Fred vS »
I use Lazarus 2.2.0 32/64 and FPC 3.2.2 32/64 on Debian 11 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt.

https://github.com/fredvs
https://gitlab.com/fredvs
https://codeberg.org/fredvs

Fred vS

  • Hero Member
  • *****
  • Posts: 3158
    • StrumPract is the musicians best friend
Re: Repair the colors of a Dos program ported to ptcGraph unit
« Reply #24 on: October 27, 2020, 08:46:33 pm »
Hello Roland!

I get it!

The terrorist was inside fpc/src/packages/ptc/src/ptcwrapper/ptcwrapper.pp

Here the code:

Code: Pascal  [Select][+][-]
  1. constructor TPTCWrapperThread.Create;
  2. begin
  3.   FOpen := False;
  4.   FNeedsUpdate := False;
  5.  
  6.   FOpenRequest.Processed := True;
  7.   FCloseRequest.Processed := True;
  8.   FOptionRequest.Processed := True;
  9.   FGetModesRequest.Processed := True;
  10.   FMoveMouseToRequest.Processed := True;
  11.  
  12.   FSurfaceCriticalSection := TCriticalSection.Create; // HUH DONT FORGET IT
  13.  
  14.   inherited Create(False);
  15. end;
  16.  
  17. ....
  18.  
  19. destructor TPTCWrapperThread.Destroy;
  20. begin
  21.   FSurfaceCriticalSection.free; // THIS WAS MISSING
  22.   inherited;
  23. end;
  24.  

Doing this, no more memory leak.

Quote
       You have played FREEWARE program NERO 5.
                   Feel free to give it to your friends too!
                          Send your feedback to:
                             <huikari@mit.jyu.fi>
                                       OR
 Jari Huikari, Jenkkakuja 1 B 34, 40520  JKL, FINLAND, EUROPE

Heap dump by heaptrc unit of /home/fred/roland/nero5
3066 memory blocks allocated : 627850/630696
3066 memory blocks freed     : 627850/630696
0 unfreed memory blocks : 0
True heap size : 196608
True free heap : 196608

Included fixed ptcwrapper.pp, just add it in your root directory project.

Fre.D
« Last Edit: October 27, 2020, 08:53:05 pm by Fred vS »
I use Lazarus 2.2.0 32/64 and FPC 3.2.2 32/64 on Debian 11 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt.

https://github.com/fredvs
https://gitlab.com/fredvs
https://codeberg.org/fredvs

circular

  • Hero Member
  • *****
  • Posts: 4195
    • Personal webpage
Re: Repair the colors of a Dos program ported to ptcGraph unit
« Reply #25 on: October 27, 2020, 08:59:27 pm »
Good job Fred  :)
Conscience is the debugger of the mind

Thaddy

  • Hero Member
  • *****
  • Posts: 14204
  • Probably until I exterminate Putin.
Re: Repair the colors of a Dos program ported to ptcGraph unit
« Reply #26 on: October 27, 2020, 09:06:37 pm »

at least 16777216 values are errors in the test.....
Specialize a type, not a var.

Roland57

  • Sr. Member
  • ****
  • Posts: 421
    • msegui.net
Re: Repair the colors of a Dos program ported to ptcGraph unit
« Reply #27 on: October 27, 2020, 09:14:39 pm »
Congratulations inspector Fred! Excellent job.

at least 16777216 values are errors in the test.....

Sorry, I don't understand.  :-\
My projects are on Gitlab and on Codeberg.

BobDog

  • Sr. Member
  • ****
  • Posts: 394
Re: Repair the colors of a Dos program ported to ptcGraph unit
« Reply #28 on: October 27, 2020, 09:27:00 pm »

Hi Roland.
For a bit of an experiment converting 32 bit colours to 16 bit (256) colours.
I set up the converting array from freebasic.
Code: Pascal  [Select][+][-]
  1.   program To256;
  2.  uses
  3.  Windows;
  4.  
  5.      type
  6. colour =packed record
  7. case integer of
  8. 0:(r,g,b:byte);
  9. 1:(c:longword);
  10. end;
  11.  
  12.   function SetDCBrushColor(p:hdc;colour:COLORREF): COLORREF; stdcall external 'gdi32.dll' name 'SetDCBrushColor';
  13.   function SetDCPenColor(p:hdc;colour:COLORREF): COLORREF; stdcall external 'gdi32.dll' name 'SetDCPenColor';
  14.   function closest(v:colour):longword;forward;
  15.  
  16.    type
  17.  circle=object
  18.  x:integer;
  19.  y:integer ;
  20.  r:integer;
  21.  c:colour;
  22.  procedure draw(h:hdc);
  23.  procedure draw256(h:hdc);
  24.  end;
  25.  
  26.  procedure circle.draw(h:hdc) ;
  27.  begin
  28.   SetDCBrushColor(h,c.c);
  29.   SetDCPenColor(h,c.c);
  30.  ellipse(h,trunc(x-r)+50,trunc(y-r),trunc(x+r)+50,trunc(y+r));
  31.  end;
  32.  
  33.   procedure circle.draw256(h:hdc) ;
  34.  begin
  35.   SetDCBrushColor(h,closest(c));
  36.   SetDCPenColor(h,closest(c));
  37.  ellipse(h,trunc(x-r+400),trunc(y-r),trunc(x+r+400),trunc(y+r));
  38.  end;
  39.  // constants
  40.     const
  41.     DC_BRUSH=18;
  42.     const
  43.     DC_PEN=19;
  44.  
  45.     const clr:array[0..255] of colour=(
  46. (r:0;g:0;b:0),
  47. (r:0;g:170;b:0),
  48. (r:0;g:0;b:170),
  49. (r:0;g:170;b:170),
  50. (r:170;g:0;b:0),
  51. (r:170;g:170;b:0),
  52. (r:170;g:0;b:85),
  53. (r:170;g:170;b:170),
  54. (r:85;g:85;b:85),
  55. (r:85;g:255;b:85),
  56. (r:85;g:85;b:255),
  57. (r:85;g:255;b:255),
  58. (r:255;g:85;b:85),
  59. (r:255;g:255;b:85),
  60. (r:255;g:85;b:255),
  61. (r:255;g:255;b:255),
  62. (r:0;g:0;b:0),
  63. (r:20;g:20;b:20),
  64. (r:32;g:32;b:32),
  65. (r:44;g:44;b:44),
  66. (r:56;g:56;b:56),
  67. (r:68;g:68;b:68),
  68. (r:80;g:80;b:80),
  69. (r:97;g:97;b:97),
  70. (r:113;g:113;b:113),
  71. (r:129;g:129;b:129),
  72. (r:145;g:145;b:145),
  73. (r:161;g:161;b:161),
  74. (r:182;g:182;b:182),
  75. (r:202;g:202;b:202),
  76. (r:226;g:226;b:226),
  77. (r:255;g:255;b:255),
  78. (r:0;g:255;b:0),
  79. (r:64;g:255;b:0),
  80. (r:125;g:255;b:0),
  81. (r:190;g:255;b:0),
  82. (r:255;g:255;b:0),
  83. (r:255;g:190;b:0),
  84. (r:255;g:125;b:0),
  85. (r:255;g:64;b:0),
  86. (r:255;g:0;b:0),
  87. (r:255;g:0;b:64),
  88. (r:255;g:0;b:125),
  89. (r:255;g:0;b:190),
  90. (r:255;g:0;b:255),
  91. (r:190;g:0;b:255),
  92. (r:125;g:0;b:255),
  93. (r:64;g:0;b:255),
  94. (r:0;g:0;b:255),
  95. (r:0;g:64;b:255),
  96. (r:0;g:125;b:255),
  97. (r:0;g:190;b:255),
  98. (r:0;g:255;b:255),
  99. (r:0;g:255;b:190),
  100. (r:0;g:255;b:125),
  101. (r:0;g:255;b:64),
  102. (r:125;g:255;b:125),
  103. (r:157;g:255;b:125),
  104. (r:190;g:255;b:125),
  105. (r:222;g:255;b:125),
  106. (r:255;g:255;b:125),
  107. (r:255;g:222;b:125),
  108. (r:255;g:190;b:125),
  109. (r:255;g:157;b:125),
  110. (r:255;g:125;b:125),
  111. (r:255;g:125;b:157),
  112. (r:255;g:125;b:190),
  113. (r:255;g:125;b:222),
  114. (r:255;g:125;b:255),
  115. (r:222;g:125;b:255),
  116. (r:190;g:125;b:255),
  117. (r:157;g:125;b:255),
  118. (r:125;g:125;b:255),
  119. (r:125;g:157;b:255),
  120. (r:125;g:190;b:255),
  121. (r:125;g:222;b:255),
  122. (r:125;g:255;b:255),
  123. (r:125;g:255;b:222),
  124. (r:125;g:255;b:190),
  125. (r:125;g:255;b:157),
  126. (r:182;g:255;b:182),
  127. (r:198;g:255;b:182),
  128. (r:218;g:255;b:182),
  129. (r:234;g:255;b:182),
  130. (r:255;g:255;b:182),
  131. (r:255;g:234;b:182),
  132. (r:255;g:218;b:182),
  133. (r:255;g:198;b:182),
  134. (r:255;g:182;b:182),
  135. (r:255;g:182;b:198),
  136. (r:255;g:182;b:218),
  137. (r:255;g:182;b:234),
  138. (r:255;g:182;b:255),
  139. (r:234;g:182;b:255),
  140. (r:218;g:182;b:255),
  141. (r:198;g:182;b:255),
  142. (r:182;g:182;b:255),
  143. (r:182;g:198;b:255),
  144. (r:182;g:218;b:255),
  145. (r:182;g:234;b:255),
  146. (r:182;g:255;b:255),
  147. (r:182;g:255;b:234),
  148. (r:182;g:255;b:218),
  149. (r:182;g:255;b:198),
  150. (r:0;g:113;b:0),
  151. (r:28;g:113;b:0),
  152. (r:56;g:113;b:0),
  153. (r:85;g:113;b:0),
  154. (r:113;g:113;b:0),
  155. (r:113;g:85;b:0),
  156. (r:113;g:56;b:0),
  157. (r:113;g:28;b:0),
  158. (r:113;g:0;b:0),
  159. (r:113;g:0;b:28),
  160. (r:113;g:0;b:56),
  161. (r:113;g:0;b:85),
  162. (r:113;g:0;b:113),
  163. (r:85;g:0;b:113),
  164. (r:56;g:0;b:113),
  165. (r:28;g:0;b:113),
  166. (r:0;g:0;b:113),
  167. (r:0;g:28;b:113),
  168. (r:0;g:56;b:113),
  169. (r:0;g:85;b:113),
  170. (r:0;g:113;b:113),
  171. (r:0;g:113;b:85),
  172. (r:0;g:113;b:56),
  173. (r:0;g:113;b:28),
  174. (r:56;g:113;b:56),
  175. (r:68;g:113;b:56),
  176. (r:85;g:113;b:56),
  177. (r:97;g:113;b:56),
  178. (r:113;g:113;b:56),
  179. (r:113;g:97;b:56),
  180. (r:113;g:85;b:56),
  181. (r:113;g:68;b:56),
  182. (r:113;g:56;b:56),
  183. (r:113;g:56;b:68),
  184. (r:113;g:56;b:85),
  185. (r:113;g:56;b:97),
  186. (r:113;g:56;b:113),
  187. (r:97;g:56;b:113),
  188. (r:85;g:56;b:113),
  189. (r:68;g:56;b:113),
  190. (r:56;g:56;b:113),
  191. (r:56;g:68;b:113),
  192. (r:56;g:85;b:113),
  193. (r:56;g:97;b:113),
  194. (r:56;g:113;b:113),
  195. (r:56;g:113;b:97),
  196. (r:56;g:113;b:85),
  197. (r:56;g:113;b:68),
  198. (r:80;g:113;b:80),
  199. (r:89;g:113;b:80),
  200. (r:97;g:113;b:80),
  201. (r:105;g:113;b:80),
  202. (r:113;g:113;b:80),
  203. (r:113;g:105;b:80),
  204. (r:113;g:97;b:80),
  205. (r:113;g:89;b:80),
  206. (r:113;g:80;b:80),
  207. (r:113;g:80;b:89),
  208. (r:113;g:80;b:97),
  209. (r:113;g:80;b:105),
  210. (r:113;g:80;b:113),
  211. (r:105;g:80;b:113),
  212. (r:97;g:80;b:113),
  213. (r:89;g:80;b:113),
  214. (r:80;g:80;b:113),
  215. (r:80;g:89;b:113),
  216. (r:80;g:97;b:113),
  217. (r:80;g:105;b:113),
  218. (r:80;g:113;b:113),
  219. (r:80;g:113;b:105),
  220. (r:80;g:113;b:97),
  221. (r:80;g:113;b:89),
  222. (r:0;g:64;b:0),
  223. (r:16;g:64;b:0),
  224. (r:32;g:64;b:0),
  225. (r:48;g:64;b:0),
  226. (r:64;g:64;b:0),
  227. (r:64;g:48;b:0),
  228. (r:64;g:32;b:0),
  229. (r:64;g:16;b:0),
  230. (r:64;g:0;b:0),
  231. (r:64;g:0;b:16),
  232. (r:64;g:0;b:32),
  233. (r:64;g:0;b:48),
  234. (r:64;g:0;b:64),
  235. (r:48;g:0;b:64),
  236. (r:32;g:0;b:64),
  237. (r:16;g:0;b:64),
  238. (r:0;g:0;b:64),
  239. (r:0;g:16;b:64),
  240. (r:0;g:32;b:64),
  241. (r:0;g:48;b:64),
  242. (r:0;g:64;b:64),
  243. (r:0;g:64;b:48),
  244. (r:0;g:64;b:32),
  245. (r:0;g:64;b:16),
  246. (r:32;g:64;b:32),
  247. (r:40;g:64;b:32),
  248. (r:48;g:64;b:32),
  249. (r:56;g:64;b:32),
  250. (r:64;g:64;b:32),
  251. (r:64;g:56;b:32),
  252. (r:64;g:48;b:32),
  253. (r:64;g:40;b:32),
  254. (r:64;g:32;b:32),
  255. (r:64;g:32;b:40),
  256. (r:64;g:32;b:48),
  257. (r:64;g:32;b:56),
  258. (r:64;g:32;b:64),
  259. (r:56;g:32;b:64),
  260. (r:48;g:32;b:64),
  261. (r:40;g:32;b:64),
  262. (r:32;g:32;b:64),
  263. (r:32;g:40;b:64),
  264. (r:32;g:48;b:64),
  265. (r:32;g:56;b:64),
  266. (r:32;g:64;b:64),
  267. (r:32;g:64;b:56),
  268. (r:32;g:64;b:48),
  269. (r:32;g:64;b:40),
  270. (r:44;g:64;b:44),
  271. (r:48;g:64;b:44),
  272. (r:52;g:64;b:44),
  273. (r:60;g:64;b:44),
  274. (r:64;g:64;b:44),
  275. (r:64;g:60;b:44),
  276. (r:64;g:52;b:44),
  277. (r:64;g:48;b:44),
  278. (r:64;g:44;b:44),
  279. (r:64;g:44;b:48),
  280. (r:64;g:44;b:52),
  281. (r:64;g:44;b:60),
  282. (r:64;g:44;b:64),
  283. (r:60;g:44;b:64),
  284. (r:52;g:44;b:64),
  285. (r:48;g:44;b:64),
  286. (r:44;g:44;b:64),
  287. (r:44;g:48;b:64),
  288. (r:44;g:52;b:64),
  289. (r:44;g:60;b:64),
  290. (r:44;g:64;b:64),
  291. (r:44;g:64;b:60),
  292. (r:44;g:64;b:52),
  293. (r:44;g:64;b:48),
  294. (r:0;g:0;b:0),
  295. (r:0;g:0;b:0),
  296. (r:0;g:0;b:0),
  297. (r:0;g:0;b:0),
  298. (r:0;g:0;b:0),
  299. (r:0;g:0;b:0),
  300. (r:0;g:0;b:0),
  301. (r:0;g:0;b:0));
  302.  
  303.  
  304. function closest(v:colour):longword;
  305. function dist(cc:colour;pv:colour):single ;
  306. var s:single;
  307. begin
  308. s:= (cc.r-pv.r)*(cc.r-pv.r) +(cc.g-pv.g)*(cc.g-pv.g)+(cc.b-pv.b)*(cc.b-pv.b) ;
  309. exit(s);
  310. end;
  311. var
  312. res:longword;
  313. n:longword;
  314. dt :single =1e20;
  315. distance:single=0;
  316.     begin
  317.     res:=0;
  318.     for n :=0 to 255 do
  319.     begin
  320.         distance:=dist(clr[n],v);
  321.         if (dt > distance) then // catch the smallest
  322.          begin
  323.            dt := distance;res:=clr[n].c;
  324.          end;
  325.     end;
  326.     exit(res)
  327. end;
  328.  
  329. function rgb(r:byte;g:byte;b:byte):longword;
  330. var return:colour;
  331. begin
  332. return.r:=r;return.g:=g;return.b:=b;
  333.  exit(return.c);
  334. end;
  335.  
  336. procedure hidecursor();
  337.  var
  338.     consoleHandle:handle;
  339.      info:CONSOLE_CURSOR_INFO ;
  340.      begin
  341.      consolehandle := GetStdHandle(STD_OUTPUT_HANDLE);
  342.      info.dwSize := 100;
  343.      info.bVisible := FALSE ;
  344.      SetConsoleCursorInfo(consoleHandle, @info);
  345.      End;
  346.  
  347. procedure setupcircles(var a:array of circle) ;
  348. var i:integer;
  349. begin
  350. for i:=1 to length(a) do
  351. begin
  352. a[i].x:=5+random(300);
  353. a[i].y:=50+random(500);
  354. a[i].r:=3+random(10);
  355. a[i].c.c:=rgb(random(255),random(255),random(255));
  356. end;
  357. end;
  358.  
  359. var
  360. p:hwnd;
  361. h:hdc;
  362. circles:array[1..5000] of circle;
  363. i:integer;
  364.  
  365. begin
  366.     p := GetConsoleWindow();
  367.     setwindowpos(p, HWND_TOPMOST, 100, 100, 800, 600, SWP_SHOWWINDOW);
  368.     hidecursor();
  369.     h:=GetDC(p);
  370.     setupcircles(circles);
  371.     SelectObject(h,GetStockObject(DC_BRUSH));
  372.     SelectObject(h,GetStockObject(DC_PEN));
  373.     write('         32 bit');
  374.     writeln('                                           256 colours');
  375.     for i:=1 to length(circles) do circles[i].draw(h);
  376.     for i:=1 to length(circles) do circles[i].draw256(h);
  377. readln;
  378. end.  

I don't suppose it is any good to you, just ignore it, it is a mess around for fun.
I might try it out on a bitmap.

Roland57

  • Sr. Member
  • ****
  • Posts: 421
    • msegui.net
Re: Repair the colors of a Dos program ported to ptcGraph unit
« Reply #29 on: October 27, 2020, 10:35:00 pm »
Hi Roland.
For a bit of an experiment converting 32 bit colours to 16 bit (256) colours.
I set up the converting array from freebasic.

Hi. Thank you for your code. I cannot try it at once (because I am on Linux) but I keep it.
My projects are on Gitlab and on Codeberg.

 

TinyPortal © 2005-2018