• API
• FAQ
• Tools
• Archive
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);
77. val(k,l,e);
79. val(k,c,e);
80. for i := 1 to l Do
81. Begin
82. for j := 1 to c Do
83. Begin
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
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.
Top