Просто «салют». Программа писалась в прошлом веке :), на TMT Паскале, но не смотря на это эффект своей красоты не потерял.

Не работает по Windows NT/2000/XP, так как эти операционные системы блокируют
включение видеорежимов VESA.

Скачать в архиве (ZIP;22Kb)

salutss.pas

1. program BLUR;
2.  
3. uses Crt,mVBE;
4.  
5. Type TSalut=Record
6. X:Real;
7. Y:Real;
8. NX:Word;
9. NY:Word;
10. End;
11.  
12. var Scr :Array[0..256000] of Byte; {Виртуальный видео-буффер}
13. F :File;
14. RSize :DWord;
15. Salut :Array[1..10,1..40] of TSalut;
16. SalDown :Array[1..10] of Real;
17. SalColor :Array[1..10] of DWord;
18. SalTimer :Array[1..10] of Word;
19. X :DWord;
20. Exit :Boolean;
21. Mode :Word;
22.  
23. Procedure PrintBuf; {Копирование виртуального видео-буфера в реальный}
24. var I,S:Word;
25. Begin
26. asm
27. cld
28. lea esi,Scr;
29. mov edi,[VBE_VideoMem]
30. mov ecx,64000
31. repe movsd
32. end;
33. End;
34.  
35. Procedure Blur; {Сам Блюр}
36. var I:DWord;
37. Begin
38. asm
39. lea edi,Scr
40. add edi,1280
41. mov ecx,253440
42. xor ebx,ebx
43. @1:
44. xor eax,eax
45. mov bl,[edi-4]
46. add eax,ebx
47. mov bl,[edi-1280]
48. add eax,ebx
49. mov bl,[edi+1280]
50. add eax,ebx
51. mov bl,[edi+4]
52. add eax,ebx
53.  
54. shr eax,2
55. mov [edi],al
56. inc edi
57. loop @1
58. end;
59. End;
60.  
61. Procedure Plot(X,Y,Color:DWord);
62. var Addr:DWord;
63. Begin
64. asm
65. lea ebx,Scr {ebx = адресс видео-буфера}
66. mov edi,[X] {edi = X}
67. cmp edi,1 {Проверка попадания в экран}
68. jna @NoPlot
69. cmp edi,318
70. ja @NoPlot
71. mov eax,[Y] {eax = Y}
72. cmp eax,1 {Проверка попадания в экран}
73. jna @NoPlot
74. cmp eax,198
75. ja @NoPlot
76. imul eax,eax,1280 {Вычисление видео-адресса - Base+X*3+Y*960}
77. shl edi,2
78. add edi,eax
79. mov eax,[Color] {И наконец выставление точки}
80. mov [edi+ebx],eax
81. @NoPlot:
82. end;
83. End;
84.  
85. Procedure InitSalutNum(Num:Word);
86. var X1,Y1,X,Y:Word;
87. Begin
88. SalDown[Num]:=0;
89. SalColor[Num]:=Random($FFFFFF);
90. SalTimer[Num]:=Random(7000);
91. X1:=Random(320);
92. Y1:=Random(200);
93. If Random(100)>95 then
94. Begin
95. SalColor[Num]:=$FFFF00;
96. For Y:=1 to 40 do
97. Begin
98. Salut[Num,Y].X:=X1;
99. Salut[Num,Y].Y:=Y1;
100. Salut[Num,Y].NX:=Random(255);
101. Salut[Num,Y].NX:=Random(255);
102. End;
103. End
104. else
105. Begin
106. For Y:=1 to 40 do
107. Begin
108. Salut[Num,Y].X:=X1;
109. Salut[Num,Y].Y:=Y1;
110. Salut[Num,Y].NX:=Random(100);
111. Salut[Num,Y].NY:=Random(100);
112. End;
113. End;
114. End;
115.  
116. Procedure InitSalut;
117. var X:Word;
118. Begin
119. RandomiZe;
120. For X:=1 to 10 do InitSalutNum(X);
121. End;
122.  
123. Procedure GetSalut;
124. var I,J,X,Y:Word;
125. Begin
126. For J:=1 to 10 do
127. For I:=1 to 40 do
128. Begin
129. SalDown[J]:=SalDown[J]+0.0002;
130. SalTimer[J]:=SalTimer[J]+1;
131. If SalTimer[J]>15000 then InitSalutNum(J);
132. Salut[J,I].X:=Salut[J,I].X+(Salut[J,I].NX/100)-0.5;
133. Salut[J,I].Y:=Salut[J,I].Y+(Salut[J,I].NY/100)-1+Sqrt(SalDown[J]);
134. Plot(round(Salut[J,I].X),round(Salut[J,I].Y),SalColor[J]);
135. Plot(round(Salut[J,I].X+1),round(Salut[J,I].Y),SalColor[J]);
136. End;
137. End;
138.  
139. {######################### Инициализация мыши ###############################}
140. Procedure InitMouse;
141. Begin
142. asm
143. mov ax,0
144. int 33h
145. mov ax,4
146. xor cx,cx
147. xor dx,dx
148. int 33h
149. end;
150. End;
151.  
152. {######################## Датчик движения мыши ##############################}
153. Function MouseMove:Boolean;
154. var Q:Word;
155. Begin
156. asm
157. mov ax,3
158. int 33h
159. or bx,cx
160. or bx,dx
161. mov [Q],bx
162. end;
163. If Q<>0 then MouseMove:=True else MouseMove:=False;
164. End;
165.  
166. Begin
167. {Инициалтзация 320x200x24}
168. mVESAInit;If VesaError<>0 then mVesaErrorMessage;
169. Mode:=mPutVesaMode(320,200,32);If Mode=0 then mVesaErrorMessage;
170. mSetVESAMode(Mode);If VesaError<>0 then mVesaErrorMessage;
171. mSetVMemory;If VesaError<>0 then mVesaErrorMessage;
172. For X:=1 to 256000 do Scr[X]:=0;
173. InitSalut;
174. InitMouse;
175. Repeat
176. PrintBuf;
177. GetSalut;
178. Blur;
179. Until KeyPressed or MouseMove;
180. mSetVGAMode;
181. WriteLn('¦ Coded by Mikhail Krivyy 1997');
182. WriteLn(' http://mikhail.krivyy.com/feedback/');
183. End.

Download this code: salutss.pas

mvbe.pas

1. unit mVBE;
2.  
3. interface
4.  
5. uses DPMILib;
6.  
7. (* VBE info block structure *)
8. type TVbeInfo = record
9. VbeSignature : DWord;
10. VbeVersion : Word;
11. OemStringPtr : DWord;
12. Capabilities : DWord;
13. VideoModePtr : DWord;
14. TotalMemory : Word;
15. OEMSoftwareRev : Word;
16. OEMVendorNamePtr : DWord;
17. OEMProductNamePtr : DWord;
18. OEMProductRevPtr : DWord;
19. Reserved : array [0..221] of Byte;
20. OEMData : array [0..255] of Byte;
21. end;
22.  
23. TVbeModeInfo = record
24. ModeAttributes : Word;
25. WinAAttributes : Byte;
26. WinBAttributes : Byte;
27. WinGranularity : Word;
28. WinSize : Word;
29. WinASegment : Word;
30. WinBSegment : Word;
31. WinFuncPtr : Pointer;
32. BytesPerScanLine : Word;
33. XResolution : Word;
34. YResolution : Word;
35. XCharSize : Byte;
36. YCharSize : Byte;
37. NumberOfPlanes : Byte;
38. BitsPerPixel : Byte;
39. NumberOfBanks : Byte;
40. MemoryModel : Byte;
41. BankSize : Byte;
42. NumberOfImagePages : Byte;
43. Reserved : Byte;
44. RedMaskSize : Byte;
45. RedFieldPosition : Byte;
46. GreenMaskSize : Byte;
47. GreenFieldPosition : Byte;
48. BlueMaskSize : Byte;
49. BlueFieldPosition : Byte;
50. RsvdMaskSize : Byte;
51. RsvdFieldPosition : Byte;
52. DirectColorModeInfo: Byte;
53. PhysBasePtr : DWord;
54. OffScreenMemOffset : DWord;
55. OffScreenMemSize : Word;
56. Reserved2 : Array [0..205] of Byte;
57. end;
58.  
59. var VesaError :Byte;
60. Regs :TRmRegs;
61. VESAInfo :TVBEInfo;
62. VESAModeInfo :TVBEModeInfo;
63. VideoMem,VBE_VideoMem :DWord;
64.  
65. Procedure mVESAInit;
66. Procedure mInitVESAMode(Mode:Word);
67. Procedure mSetVESAMode(Mode:Word);
68. Procedure mSetVGAMode;
69. Function mPutVESAMode(X,Y,BPP:Word):Word;
70. Procedure mVesaErrorMessage;
71. Procedure mSetVMemory;
72.  
73. implementation
74.  
75. { Инициализация VESA }
76. Procedure mVESAInit;
77. Begin
78. VesaError:=0;
79. ClearRmRegs(Regs);
80. Regs.AX:=$4F00;
81. Regs.ES:=Buf_16;
82. RealModeInt($10,Regs);
83. Move(Pointer(Buf_32)^,VESAInfo,256);
84. if (Regs.AX<>$004F) or (VESAInfo.VbeSignature<>$41534556) then VesaError=1;
85. End;
86.  
87. { Инициализация графического режима VESA }
88. Procedure mInitVESAMode(Mode:Word);
89. Begin
90. VesaError:=0;
91. ClearRmRegs(Regs);
92. Regs.ES:=Buf_16;
93. Regs.ax:=$4F01;
94. Regs.di:=$0000;
95. Regs.cx:=Mode;
96. RealModeInt($10,Regs);
97. Move(Pointer(Buf_32)^,VESAModeInfo,256);
98. if (Regs.AX<>$004F) or (VESAModeInfo.PhysBasePtr=0) then VESAError:=2;
99. End;
100.  
101. { Установка графического режима VESA }
102. Procedure mSetVESAMode(Mode:Word);
103. Begin
104. VesaError:=0;
105. ClearRmRegs(Regs);
106. Regs.AX:=$4F02;
107. Regs.BX:=Mode;
108. RealModeInt($10,Regs);
109. if (Regs.AX<>$004F) then VESAError:=3;
110. End;
111.  
112. { Установка стандартного режима EGA }
113. Procedure mSetVGAMode;
114. Begin
115. ClearRmRegs(Regs);
116. Regs.AX:=$0003;
117. RealModeInt($10,Regs);
118. End;
119.  
120. Function mPutVESAMode(X,Y,BPP:Word):Word;
121. var M:Word;
122. Begin
123. For M:=$4100 to $4200 do
124. Begin
125. mInitVESAMode(M);
126. If (VesaModeInfo.XResolution=X) and
127. (VesaModeInfo.YResolution=Y) and
128. (VesaModeInfo.BitsPerPixel=BPP) and
129. (VesaError=0) then mPutVESAMode:=M;
130. End;
131. End;
132.  
133. { Вывод сообщения об ошибке }
134. Procedure mVesaErrorMessage;
135. Begin
136. mSetVGAMode;
137. WriteLn('VesaError:',VesaError);
138. Halt(1);
139. End;
140.  
141. { Узнаем логический адресс }
142. Procedure mSetVMemory;
143. var Tmp1,Tmp2 :Word;
144. Begin
145. Vbe_VideoMem:=MapPhysicalToLinear(VESAModeInfo.PhysBasePtr,4096*1024);
146. If Vbe_VideoMem=0 then VESAError=4;
147. VideoMem:=Vbe_VideoMem;
148. End;
149. end.

Download this code: mvbe.pas