Скопировать рисунок с экрана в файл - Pascal

Узнай цену своей работы

Формулировка задачи:

помогите скопиравать рисунук с паскаля

Решение задачи: «Скопировать рисунок с экрана в файл»

textual
Листинг программы
unit savebmp;
interface
const
n=59;
h640x16:array [1..n] of word=(
$4d42,$5876,$0002,$0000,$0000,$0076,$0000,$0028,$0000,$0280,$0000,$01e0,
$0000,$0001,$0004,$0000,$0000,$0000,$0000,$0f36,$0000,$0f36,$0000,$0010,
$0000,$0010,$0000,$0000,$0000,$00c0,$0000,$c000,$0000,$c0c0,$0000,$0000,
$00c0,$00c0,$00c0,$c000,$00c0,$c0c0,$00c0,$8080,$0080,$00ff,$0000,$ff00,
$0000,$ffff,$0000,$0000,$00ff,$00ff,$00ff,$ff00,$00ff,$ffff,$00ff);
procedure savebmp640x480x16(s:string);
implementation
uses graph;
var a:array [1..30720] of byte;
    q:word;
    f:file;
    x,y,t,z:integer;
procedure savebmp640x480x16;
begin
if pos('.',s)=0 then s:=s+'.bmp';
assign(f,s); rewrite(f,1);
blockwrite(f,h640x16,n shl 1);
for t:=0 to 4 do begin
    z:=479-96*t; q:=0;
    for y:=z downto z-95 do
        for x:=0 to 319 do begin
            z:=x shl 1; inc(q);
            a[q]:=getpixel(z,y) shl 4 or getpixel(succ(z),y);
        end;
    blockwrite(f,a,sizeof(a));
    end;
close(f);
end;
end.

Оцени полезность:

5   голосов , оценка 3.6 из 5
Похожие ответы