G2A Many GEOs
SHARE
TWEET

Niveau_en_gris

a guest Apr 10th, 2020 224 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. program ex;
  2. uses wincrt;
  3.  
  4. Type
  5. mat= array[1..10,1..6] of string;
  6.  
  7. Var
  8. ft:text;
  9. l,c:integer;
  10. m:mat;
  11.  
  12.  
  13. function hextodec(a:string):integer ;
  14. Var
  15. b,d,i:integer;
  16. Begin
  17. b :=1;
  18. d:=0;
  19. for i := Length(a) DownTo 1 Do
  20. Begin
  21. if a[i] in ['0'..'9'] Then
  22. Begin
  23. d := d + ((ord(a[i]) - 48)*b) ;
  24. b := b*16;
  25. end
  26. Else
  27. Begin
  28. d := d + ((ord(a[i]) - 55)*b);
  29. b := b*16;
  30. end;
  31. end;
  32. hextodec := d;
  33. end;
  34.  
  35. function dectohex(a:integer):string;
  36. Var
  37. ch:string;
  38. i,r:integer;
  39. Begin
  40. ch:='';
  41. i:=0;
  42. while a <> 0 Do
  43. Begin
  44. r := a mod 16;
  45. if r < 10 Then
  46. Begin
  47. ch := chr(ord(r)+48)+ch;
  48. end
  49. Else
  50. Begin
  51. ch := chr(ord(r)+55)+ch;
  52. end;
  53. a := a div 16;
  54. end;
  55. dectohex:=ch;
  56. end;
  57.  
  58. function conv(ch:string):string;
  59. Var
  60. r,v,b,y:integer;
  61. Begin
  62. r:=hextodec(copy(ch,1,2));
  63. v:=hextodec(copy(ch,3,2));
  64. b:=hextodec(copy(ch,5,2));
  65. y:=trunc(0.299*r + 0.587*v + 0.114*b);
  66. conv := dectohex(y);
  67. end;
  68.  
  69. procedure remplir(var ft:text;var m:mat;var l,c:integer);
  70. Var
  71. i,j,e:integer;
  72. ch:string;
  73. k:char;
  74. Begin
  75. reset(ft);
  76. readln(ft,k);
  77. val(k,l,e);
  78. readln(ft,k);
  79. val(k,c,e);
  80. for i := 1 to l Do
  81. Begin
  82. for j := 1 to c Do
  83. Begin
  84. readln(ft,ch);
  85. m[i,j]:=ch;
  86. end;
  87. end;
  88. close(ft);
  89. end;
  90.  
  91.  
  92. procedure transfert(var m:mat;l,c:integer);
  93. Var
  94. i,j:integer;
  95. x:string;
  96. begin
  97. for i := 1 to l Do
  98. Begin
  99. for j := 1 to c Do
  100. Begin
  101.  
  102. x := conv(m[i,j]);
  103. m[i,j]:=x;
  104. end;
  105. writeln;
  106. end;
  107. end;
  108.  
  109.  
  110. procedure afficher(m:mat;l,c:integer);
  111. Var
  112. i,j:integer;
  113. Begin
  114. for i := 1 to l Do
  115. Begin
  116. for j := 1 to c Do
  117. Begin
  118. write(m[i,j],'  ');
  119. end;
  120. writeln;
  121. end;
  122. end;
  123.  
  124. Begin
  125. assign(ft,'D:\image.txt');
  126. remplir(ft,m,l,c);
  127. afficher(m,l,c);
  128. transfert(m,l,c);
  129. afficher(m,l,c);
  130. end.
RAW Paste Data
Ledger Nano X - The secure hardware wallet
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Top