Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 14.01.2009, 16:28   #1
Akashi
Новичок
Джуниор
 
Регистрация: 12.01.2009
Сообщений: 1
По умолчанию Галерея изображений в паскале

Ребята,помогите! Нужно создать программу наподобие галереи бмп файлов. Ну у нас дано 2 бмп файла и надо чтобы в паскале один файл менялся на другой. Пока написал модуль для риада бмп и прогу чтобы оно выводило бмп на экран. А вот со сменой проблемы =\. Помогите новичку,очень прошу. В архиве сам модуль и прога. Очень расчитываю на вашу помощь. Заранее спасибо.
Вложения
Тип файла: rar bmp.rar (2.4 Кб, 13 просмотров)
Akashi вне форума Ответить с цитированием
Старый 14.01.2009, 21:07   #2
noobster
 
Регистрация: 12.01.2009
Сообщений: 3
По умолчанию

У меня таже самая проблема. Только вот есть программа вывода бмп намного лучше и без модуля. Там выводит любые бмп и цвета не искажает. Только вот надо сделать чтобы одна картинка изменилась на другую.
Вот программа. Надо сделать чтобы одна картинка изменилась на другую.
Код:
uses
 crt,dos;
var Sp1,Sp2,Sp3,Sp4:pointer; temp:word;
procedure InitGraph; assembler;                                 {perehod v graphicheskiy rezhim (320x200x256)}
asm
 mov ax,13h
 int 10h
end;
procedure SetPal(Color,R,G,B:Byte);                             {ustanovka palitry}
Begin
 Port[$3C8] := Color;
 Port[$3C9] := R shr 2;
 Port[$3C9] := G shr 2;
 Port[$3C9] := B shr 2;
End;
procedure Putpixel2(X, Y: Word; Color: byte); assembler;        {ustanovka tochki (asm)}
asm
  mov  ax, $A000
  mov  es, ax
  mov  bx, 320
  mov  ax, Y
  mul  bx
  add  ax, X
  mov  di, ax
  mov  al, Color
  mov  es:[di], al
end;
procedure PutPixel(x,y:integer;color:byte);                     {ustanovka tochki (pas)}
begin
 fillchar(ptr(SegA000,y*320+x)^,1,color);
{ mem[SegA000:y*320+x]:=color;}
end;
function Clock:longint;                                         {tekushee vremya}
begin
 clock:=MemL[Seg0040:$6c];
end;
procedure LoadBMP(filename:string);                              {vyvod *.bmp na monitor}
var xh,xl,yh,yl:byte; u,v,x,y:word;
    pcxer:file of byte; color,r,g,b,pix,tmp:byte;
    k:word;
begin
 assign(pcxer,filename);
 reset(pcxer);
 seek(pcxer,18); read(pcxer,xl);
 seek(pcxer,19); read(pcxer,xh);
 seek(pcxer,22); read(pcxer,yl);
 seek(pcxer,23); read(pcxer,yh);
 x:=xh*256+xl-1; y:=yh*256+yl-1;
 seek(pcxer,54);
 for color:=0 to 255 do
  begin
   read(pcxer,b,g,r,tmp);
   setpal(color,r,g,b);
  end;
 pix:=1;
 seek(pcxer,1078);
 for v:=y downto 0 do
  for u:=0 to x do
   begin
    read(pcxer,tmp);
    if tmp <> 0 then
    putpixel2(u*pix,v*pix,tmp);
   end;
 close(pcxer);
end;
procedure CloseGraph; assembler;                                  {perechod v tekstoviy rezhim}
asm
 mov ax,3h
 int 10h
end;
var w,e:word; c1,c2:longint;
begin                                                             {osnovnaya programmma}
 initgraph;
 c1:=clock;
 LoadBMP('1.bmp');
 c2:=clock;
 readkey;
 closegraph;
 writeln(c2-c1);						  {vremya raboty programmy}
end.
noobster вне форума Ответить с цитированием
Старый 14.01.2009, 21:43   #3
noobster
 
Регистрация: 12.01.2009
Сообщений: 3
По умолчанию

Я понимаю,чтотут никто никому не должен. Но действительно нада это программа. Точнее доделать её. Подскажите как заменить картинку на другую.
noobster вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Фильтрация изображений varvara16 Мультимедиа в Delphi 2 16.12.2007 10:20
просмотр изображений gulfiyush Общие вопросы Delphi 9 10.12.2007 04:47