Download
0: { --Content--
1: MouseUDeltaX, MouseUDeltaY:word;
2: MouseU.GetBotton:word; function
3: MouseU.GetMove; procedure
4: MouseU.SetRange(x,y:word); procedure
5: MouseU.Getx: word; function
6: MouseU.Gety: word; function
7: MouseU.Show; function
8: MouseU.Hide; function
9: MouseU.Mute; function
10: Halmaz=set of char;
11: KeyboardUKeyASCII, KeyboardUKeyScan:byte;
12: KeyboardU.GetKey:word; function
13: KeyboardU.ReadKey:word; function
14: KeyboardU.WaitKey:word; function
15: KeyboardU.ReadStr(x,y,max,attrib:byte;elem:Halmaz;var txt:string):boolean; function
16: VideoUResX:word;
17: VideoURGBRed, VideoURGBGreen, VideoURGBBlue:byte;
18: VideoU.InitVGA(mode:word); function
19: VideoU.PutPixelVGA256(x,y:word;c:byte);procedure
20: VideoU.LineVGA(x,y,x1,y1:word;color:byte); procedure
21: VideoU.Writexy(x,y:word;color:byte;text:string); procedure
22: VideoU.InitSVGA(mode:word):word; function
23: VideoU.PutPixelSVGA256(x,y:word;c:byte); procedure
24: VideoU.LineSVGA256(x1,y1,x2,y2:word;c:byte); procedure
25: VideoU.PutPixelSVGA16M(x,y:word;cR,cG,cB:byte); procedure
26: VideoU.PutPixelSVGA64K(x,y:word;cR,cG,cB:word); procedure
27: VideoU.SetPage(p:word); procedure
28: VideoU.VerticalBlnk; procedure
29: VideoU.SetPalCol(palet:word; r,g,b:byte); procedure
30: VideoU.GetPalCol(palet:word); procedure
31: VideoU.SetCursorPos(colum,row:byte); procedure
32: VideoU.GetCursorX:byte; function
33: VideoU.GetCursorY:byte; function
34: GetCharTable(tbln:byte;var vector:pointer); procedure
35: 16M color SVGA mode: $10f: ResX:=320;ResY:=200;
36: 64K color SVGA mode: $10e: ResX:=320;ResY:=200;
37: 256 color SVGA modes: $101: ResX:=640;ResY:=480;
38: $103: ResX:=800;ResY:=600;
39: $105: ResX:=1024;ResY:=768;
40: 256 color VGA mode: $13: ResX:=320;ResY:=200;
41: 16 color text mode: $3: ResX:=80;ResY:=25;
42: XMSMoveStruct = record TransferLength:longint; SrcHandle:word; SrcOffset:longint; DestHandle:word; DestOffset:longint end;
43: XMSU.Driverloaded:boolean; function
44: XMSU.MemAvail(Var total, largest : Word):boolean; function
45: XMSU.AllocMem(var handle:word;KBSize:word):boolean; function
46: XMSU.FreeMem(handle:Word):boolean; function
47: XMSU.TransferMem(var XMSMoveRec:XMSMoveStruct):boolean; function
48: XMSU.MoveDataTo(SourceAddr: Pointer; NumBytes: LongInt; Handle: Word; XMSOffset: LongInt): Boolean; function
49: XMSU.GetDataFrom(Handle: Word; XMSOffset: LongInt; NumBytes: LongInt; DestinationAddr: Pointer): Boolean; function
50: ExtraU.XMove(var source, dest; size: word); procedure
51: ExtraU.StoreW(segm,ofs,v,c:word); procedure
52: ExtraU.StoreWv2(var destbuff; count,wdata:word); procedure
53: MathU.power(num:extended;pow:integer) : extended; function
54: MathU.dec2hex(dec:real;digitn:byte):string; function
55: OtherU.GetTime:word; function
56: OtherU.GetIntVec(intno:byte;var vector:pointer); procedure
57: OtherU.SetIntVec(intno : byte; vector : pointer); procedure
58: OtherU.InitWait; procedure
59: OtherU.Waiting(msx:integer); procedure
60: {}
61: unit myunit;
62: {$A+,B-,D+,E+,F-,G+,I+,L+,N+,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
63: {$M 16384,0,655360}
64: interface
65:
66: type TypeMouseUtilities=object
67: function GetBotton:word;
68: procedure GetMove;
69: procedure SetRange(x,y:word);
70: function Getx: word;{h2sger.pas}
71: function Gety: word;
72: procedure Show;
73: procedure Hide;
74: procedure Mute;
75: end;
76: Halmaz=set of char;
77: TypeKeyboardUtilities=object
78: function GetKey:word;
79: function ReadKey:word;
80: function WaitKey:word;
81: function ReadStr(x,y,max,attrib:byte;elem:Halmaz;var txt:string):boolean;
82: end;
83: TypeVideoUtilities=object
84: procedure InitVGA(mode:word);
85: procedure PutPixelVGA256(x,y:word;c:byte);
86: procedure LineVGA(x,y,x1,y1:word;color:byte);
87: procedure Writexy(x,y:word;color:byte;text:string); {adatb3}
88: function InitSVGA(mode:word):word;
89: procedure PutPixelSVGA256(x,y:word;c:byte);
90: procedure LineSVGA256(x1,y1,x2,y2:word;c:byte);
91: procedure PutPixelSVGA16M(x,y:word;cB,cG,cR:byte);
92: procedure PutPixelSVGA64K(x,y:word;cR,cG,cB:word);
93: procedure PutPixelSVGA32bit(x,y:word;cR,cG,cB:word);
94: procedure SetPage(p:word);
95: procedure VerticalBlnk;
96: procedure SetPalCol(palet:word; r,g,b:byte);
97: procedure GetPalCol(palet:word);
98: procedure SetCursorPos(colum,row:byte); {h2sger.pas}
99: function GetCursorX:byte;
100: function GetCursorY:byte;
101: procedure GetCharTable(tbln:byte;var vector:pointer);
102: end;
103: XMSMoveStruct = record
104: TransferLength:longint;
105: SrcHandle:word;
106: SrcOffset:longint;
107: DestHandle:word;
108: DestOffset:longint
109: end;
110: TypeXMSUtilities=object
111: function Driverloaded:boolean;
112: function MemAvail(Var total, largest : Word):boolean;
113: function AllocMem(var handle:word;KBSize:word):boolean;
114: function FreeMem(handle:Word):boolean;
115: function TransferMem(var XMSMoveRec:XMSMoveStruct):boolean;
116: function MoveDataTo(SourceAddr: Pointer; NumBytes: LongInt;
117: Handle: Word; XMSOffset: LongInt): Boolean;
118: function GetDataFrom(Handle: Word; XMSOffset: LongInt;
119: NumBytes: LongInt; DestinationAddr: Pointer): Boolean;
120: end;
121: TypeExtraUtilities=object
122: procedure XMove(var source, dest; size: word);
123: { procedure LoadDw(m:pointer;v:longint);
124: procedure StoreDw(m:pointer;v:longint;c:word);}
125: procedure StoreW(segm,ofs,v,c:word);
126: procedure StoreWv2(var destbuff; count,wdata:word);
127: end;
128: { TypeLargeExamplesUtilities=object
129: procedure LoadPCX256toXMS;
130: end;{}
131: TypeMathUtilities=object
132: function power(num:extended;pow:integer) : extended; {compute6.pas}
133: { function bin2dec(bin:real):real;
134: function dec2bin(dec:longint):string;
135: function hex2dec(hex:string):real;}
136: function dec2hex(dec:real;digitn:byte):string;
137: { function oct2dec(oct:real):real;
138: function dec2oct(deci:longint):string;
139: {FPU units; PCX_Math.pas ,FPUJxx.pas}
140: end;
141: TypeOtherUtilities=object
142: function GetTime(var hour,min:byte):word;
143: function GetDate(var Year,Month,Day:word):byte;
144: { procedure SetTime;}
145: procedure GetIntVec(intno:byte;var vector:pointer); {mytetnew.pas}
146: procedure SetIntVec(intno : byte; vector : pointer);
147: function GetExePath:string;
148: procedure Waiting(msx:integer);
149: procedure InitWait;
150: end;{}
151:
152:
153: var MouseU:TypeMouseUtilities;
154: KeyboardU:TypeKeyboardUtilities;
155: VideoU:TypeVideoUtilities;
156: XMSU:TypeXMSUtilities;
157: ExtraU:TypeExtraUtilities;
158: MathU:TypeMathUtilities;
159: OtherU:TypeOtherUtilities;
160: { LargeExamplesU:TypeLargeExamplesUtilities;}
161: const EngABCC:set of char=['a'..'z','A'..'Z'];
162: HunExtC:set of char=['‚',' ','¡','¢','£','–','?','“','”'];
163: IntNumC:set of char=['0'..'9'];
164: OthExtC:set of char=[' '..'/',':'..'@','['..'`','%'..'^','{'..'~'];
165: var MouseUDeltaY,MouseUDeltaX:word;
166: KeyboardUKeyASCII,KeyboardUKeyScan:byte;
167: VideoUResX:word;
168: VideoURGBBlue,VideoURGBGreen,VideoURGBRed:byte;
169:
170: implementation
171:
172: const Hexadecimalcharacters:array[0..15] of char=('0','1','2','3','4','5','6','7','8','9','a','b','c','d','e','f');
173: var XMSDriverAddr :pointer;
174: wcounter:longint;
175:
176: procedure TypeMouseUtilities.SetRange(x,y:word); assembler;
177: asm mov ax,7; xor cx,cx; mov dx,x; int 33h; mov ax,8; mov dx,y; int 33h
178: end;
179: procedure TypeMouseUtilities.GetMove; assembler;
180: asm mov ax,0bh; int 33h; mov MouseUDeltaX,cx; mov MouseUDeltaY,dx
181: end;
182: function TypeMouseUtilities.GetBotton:word; assembler;
183: asm mov ax,3; int 33h; mov ax,bx
184: end;
185: function TypeMouseUtilities.Getx: word; assembler;
186: asm mov ax,3; int 33h; mov ax,cx; mov bl,8; div bl
187: end;
188: function TypeMouseUtilities.Gety: word; assembler;
189: asm mov ax,3; int 33h; mov ax,dx; mov bl,8; div bl
190: end;
191: procedure TypeMouseUtilities.Show; assembler;
192: asm mov ax,1; int 33h
193: end;
194: procedure TypeMouseUtilities.Hide; assembler;
195: asm mov ax,2; int 33h
196: end;
197: procedure TypeMouseUtilities.Mute; assembler;
198: asm @back: mov ax,3; int 33h; cmp bx,0; jnz @back
199: end;
200:
201: function TypeKeyboardUtilities.GetKey:word; assembler;
202: asm mov ah,1; int 16h; mov ax,0; je @no; int 16h; @no:
203: end;
204: function TypeKeyboardUtilities.ReadKey:word; assembler;
205: asm mov ah,1; int 16h; mov ax,0; je @no; int 16h;
206: @no: mov KeyboardUKeyASCII,al; mov KeyboardUKeyScan,ah
207: end;
208: function TypeKeyboardUtilities.WaitKey:word; assembler;
209: asm xor ax,ax; int 16h
210: end;
211: function TypeKeyboardUtilities.ReadStr(x,y,max,attrib:byte;elem:Halmaz;var txt:string):boolean;
212: var posins:byte; rdkey:word; cr:char;
213: begin
214: VideoU.SetCursorPos(x,y);
215: if txt[0]>chr(max) then txt[0]:=chr(max);
216: posins:=0;
217: repeat
218: ExtraU.StoreW($b800,160*y+x shl 1,attrib*256,max);
219: VideoU.WriteXY(x,y,attrib,txt);
220: VideoU.SetCursorPos(x+posins,y);
221: rdkey:=KeyboardU.waitkey;
222: cr:=chr(lo(rdkey));
223: if (cr in elem) and (byte(txt[0])<max) then begin
224: inc(posins);
225: insert(cr,txt,posins);
226: end;
227: if (rdkey=$5300) and (posins<byte(txt[0])) then delete(txt,posins+1,1);
228: if (rdkey=$0e08) and (posins>0) then begin
229: delete(txt,posins,1);
230: dec(posins);
231: end;
232: if rdkey=$011b then ReadStr:=false;
233: if rdkey=$1c0d then ReadStr:=true;
234: if (rdkey=$4b00) and (posins>0) then dec(posins);
235: if (rdkey=$4d00) and (posins<byte(txt[0])) then inc(posins);
236: until (rdkey=$1c0d) or (rdkey=$011b);
237: end;
238:
239: procedure TypeVideoUtilities.InitVGA(mode:word); assembler;
240: asm mov ax,mode; int 10h
241: end;
242: procedure TypeVideoUtilities.PutPixelVGA256(x,y:word;c:byte); assembler;
243: asm mov ax,$a000; mov es,ax; mov ax,y; shl ax,6; mov di,ax; shl ax,2;
244: add di,ax; add di,x; mov al,c; mov es:[di],al
245: end;
246: procedure TypeVideoUtilities.LineVGA(x,y,x1,y1:word;color:byte); assembler;
247: var xtav,ytav,xdir,ydir:word;
248: asm mov dx,0ffffh; mov ax,0a000h; mov es,ax; mov ax,x; mov bx,x1
249: sub ax,bx; jnc @negxdir; neg ax; neg dx
250: @negxdir: mov xtav,ax; mov xdir,dx; mov dx,0ffffh; mov ax,y; mov bx,y1
251: sub ax,bx; jnc @negydir; neg ax; neg dx
252: @negydir: mov ytav,ax; mov ydir,dx; cmp ax,xtav; jc @vizsintes
253: @fuggoleges: mov ax,x; mov bx,y; mov cx,ytav; mov dx,cx; shr dx,1; inc cx
254: @_0: push ax; push bx
255: shl bx,6; mov di,bx; shl bx,2; add di,bx; add di,ax; mov al,color; stosb
256: pop bx; pop ax
257: add bx,ydir; add dx,xtav; cmp dx,ytav; jc @_1; sub dx,ytav; add ax,xdir
258: @_1: loop @_0; jmp @vege
259: @vizsintes: mov ax,y; mov bx,x; mov cx,xtav; mov dx,cx; shr dx,1; inc cx
260: @_2: push ax
261: shl ax,6; mov di,ax; shl ax,2; add di,ax; add di,bx; mov al,color; stosb
262: pop ax
263: add bx,xdir; add dx,ytav; cmp dx,xtav; jc @_3; sub dx,xtav; add ax,ydir
264: @_3: loop @_2
265: @vege:
266: end;
267: function TypeVideoUtilities.InitSVGA(mode:word):word; assembler;
268: asm mov ax,4f02h; mov bx,mode; int 10h
269: end;{al=4f ha tamogatott a funkcio, ah=statusz (00 - vegrehajtva, 01 - sikertelen vegrehajtas }
270: procedure TypeVideoUtilities.PutPixelSVGA256(x,y:word;c:byte); assembler;
271: asm push dx; push bx; mov ax,y; mov bx,VideoUResX; mul bx
272: add ax,x; jnc @ide; inc dx
273: @ide: mov di,ax; mov ax,4f05h; xor bx,bx; int 10h
274: mov ax,0a000h; mov es,ax; mov al,c; stosb; pop bx; pop dx
275: end;
276: procedure TypeVideoUtilities.LineSVGA256(x1,y1,x2,y2:word;c:byte);assembler;
277: var xtav,ytav,xdir,ydir:word;
278: asm mov dx,0ffffh; mov ax,0a000h; mov es,ax; mov ax,x1; mov bx,x2
279: sub ax,bx; jnc @negxdir; neg ax; neg dx
280: @negxdir: mov xtav,ax; mov xdir,dx; mov dx,0ffffh; mov ax,y1; mov bx,y2
281: sub ax,bx; jnc @negydir; neg ax; neg dx
282: @negydir: mov ytav,ax; mov ydir,dx; cmp ax,xtav; jc @vizsintes
283: @fuggoleges: or byte ptr cs:[@incdecf],00001000b; cmp xdir,1; jnz @i0; and byte ptr cs:[@incdecf],11110111b
284: @i0: or byte ptr cs:[@addsubf],00101000b; cmp ydir,1; jnz @i2; and byte ptr cs:[@addsubf],11010111b
285: @i2: mov cx,ytav; mov bx,cx; shr bx,1; inc cx; push bx
286: mov ax,y1; mov bx,VideoUResX; mul bx; add ax,x1; jnc @ide1; inc dx
287: @ide1: mov di,ax; mov ax,4f05h; xor bx,bx; int 10h; pop bx; mov al,c
288: @_0: mov es:[di],al
289: @addsubf: sub di,VideoUResX
290: jnc @05; add dx,ydir; push bx; mov ax,4f05h; xor bx,bx; int 10h; mov al,c; pop bx;
291: @05: add bx,xtav; cmp bx,ytav; jc @_1; sub bx,ytav;
292: @incdecf: dec di
293: jno @_1; add dx,xdir; push bx; mov ax,4f05h; xor bx,bx; int 10h; mov al,c; pop bx;
294: @_1: loop @_0; jmp @vege
295: @vizsintes: or byte ptr cs:[@addsubv],00101000b; cmp ydir,1; jnz @i1; and byte ptr cs:[@addsubv],11010111b
296: @i1: or byte ptr cs:[@incdecv],00001000b; cmp xdir,1; jnz @i3; and byte ptr cs:[@incdecv],11110111b
297: @i3:mov cx,xtav; mov bx,cx; shr bx,1; inc cx; push bx
298: mov ax,y1; mov bx,VideoUResX; mul bx; add ax,x1; jnc @ide2; inc dx
299: @ide2: mov di,ax; mov ax,4f05h; xor bx,bx; int 10h; pop bx; mov al,c
300: @_2: mov es:[di],al
301: @incdecv: dec di
302: jno @15; add dx,xdir; push bx; mov ax,4f05h; xor bx,bx; int 10h; mov al,c; pop bx;
303: @15: add bx,ytav; cmp bx,xtav; jc @_3; sub bx,xtav;
304: @addsubv: sub di,VideoUResX
305: jnc @_3; add dx,ydir; push bx; mov ax,4f05h; xor bx,bx; int 10h; mov al,c; pop bx;{}
306: @_3: loop @_2
307: @vege:
308: end;
309: procedure TypeVideoUtilities.PutPixelSVGA16M(x,y:word;cB,cG,cR:byte); assembler;
310: asm push dx; push bx; mov ax,y; mov bx,3; mul bx; mov bx,VideoUResX; mul bx
311: mov di,ax; mov ax,x; add ax,x; add ax,x; add di,ax; adc dx,0
312: { add ax,x; adc dx,0; add ax,x; adc dx,0; add ax,x; adc dx,0; mov di,ax}
313: mov ax,4f05h; xor bx,bx; int 10h; mov ax,0a000h; mov es,ax
314: mov al,cR; mov es:[di],al; add di,1; jnc @i1; inc dx; mov ax,4f05h; xor bx,bx; int 10h
315: @i1: mov al,cG; mov es:[di],al; add di,1; jnc @i2; inc dx; mov ax,4f05h; xor bx,bx; int 10h
316: @i2: mov al,cB; mov es:[di],al; pop bx; pop dx
317: end;{}
318:
319: procedure TypeVideoUtilities.PutPixelSVGA64K(x,y:word;cR,cG,cB:word); assembler;
320: asm push dx; push bx; mov ax,y; shl ax,1; mov bx,VideoUResX; mul bx
321: mov di,ax; mov ax,x; add ax,x; add di,ax; adc dx,0
322: { add ax,x; adc dx,0; add ax,x; adc dx,0; add ax,x; adc dx,0; mov di,ax}
323: mov ax,4f05h; xor bx,bx; int 10h; mov ax,0a000h; mov es,ax
324: mov ax,cR; shl ax,11; mov bx,cG; and bx,63; shl bx,5; or ax,bx
325: mov bx,cB; and bx,31; or ax,bx; mov es:[di],ax
326: @end:pop bx; pop dx
327: end;{}
328: procedure TypeVideoUtilities.PutPixelSVGA32bit(x,y:word;cR,cG,cB:word); assembler;
329: asm mov ax,y; shl ax,2; mov bx,VideoUResX; mul bx
330: mov di,ax; mov ax,x; shl ax,2; add di,ax; adc dx,0
331: { add ax,x; adc dx,0; add ax,x; adc dx,0; add ax,x; adc dx,0; mov di,ax}
332: mov ax,4f05h; xor bx,bx; int 10h; mov ax,0a000h; mov es,ax
333: mov ax,cR; db 66h; shl ax,8; or ax,cG;
334: db 66h; shl ax,8; or ax,cB;
335: { mov bx,cG; db 66h;
336: and bx,63; shl bx,5; or ax,bx
337: mov bx,cB; and bx,31; or ax,bx; } db 66h; mov es:[di],ax
338: @end:
339: end;
340:
341: procedure TypeVideoUtilities.SetPage(p:word); assembler;
342: asm mov dx,p; mov ax,4f05h; xor bx,bx; int 10h
343: end;
344: procedure TypeVideoUtilities.VerticalBlnk; assembler;
345: asm mov dx,03dah
346: @vb0: in al,dx; and al,00001000b; jnz @vb0
347: @vb1: in al,dx; and al,00001000b; jz @vb1
348: end;
349: procedure TypeVideoUtilities.writexy(x,y:word;color:byte;text:string); assembler;
350: asm
351: {$IFDEF DPMI} mov ax,SegB800
352: {$ELSE} mov ax,0b800h;
353: {$ENDIF}
354: mov es,ax; mov ax,y; shl ax,5; mov di,ax; shl ax,2
355: add di,ax; mov ax,x; shl ax,1; add di,ax; mov ah,color; mov dx,ds
356: lds si,text; cld; lodsb; or al,al; jz @end; xor ch,ch; mov cl,al
357: @ide: lodsb; stosw; loop @ide; mov ds,dx
358: @end:
359: end;
360: procedure TypeVideoUtilities.SetPalCol(palet:word; r,g,b:byte);assembler;
361: asm mov dx,3c8h; mov ax,palet; out dx,al; inc dx
362: mov al,r; out dx,al; mov al,g; out dx,al; mov al,b; out dx,al
363: end;
364: procedure TypeVideoUtilities.GetPalCol(palet:word);assembler; {RGBRed, RGBGrean, RGBBlue general variables needed}
365: asm mov dx,3c7h; mov ax,palet; out dx,al; mov dx,3c9h;
366: in al,dx; mov VideoURGBRed,al; in al,dx; mov VideoURGBGreen,al; in al,dx; mov VideoURGBBlue,al
367: end;
368: procedure TypeVideoUtilities.SetCursorPos(colum,row:byte); assembler;
369: asm mov dl,colum; mov dh,row; xor bh,bh; mov ah,2; int 10h
370: end;
371: function TypeVideoUtilities.GetCursorX:byte; assembler;
372: asm xor ax,ax; mov es,ax; mov di,0450h; mov al,byte ptr es:[di]
373: end;
374: function TypeVideoUtilities.GetCursorY:byte; assembler;
375: asm xor ax,ax; mov es,ax; mov di,0450h; mov al,byte ptr es:[di+1]
376: end;
377: procedure TypeVideoUtilities.GetCharTable(tbln:byte;var vector:pointer);assembler;
378: asm push bp; mov ax,1130h; xor bl,bl; mov bh,tbln; int 10h; mov ax,bp; pop bp
379: mov bx,es; les di,vector; stosw; mov ax,bx; stosw
380: end;
381: {--------------------------------------------------------------------------}
382: function TypeXMSUtilities.DriverLoaded:boolean; assembler;
383: asm mov ax,4300h; int 2fh; cmp al,80h; mov al,0; jnz @Exit; mov ax,4310h; int 2fh
384: mov word ptr [XMSDriverAddr],BX; mov word ptr [XMSDriverAddr+2],ES; mov al,1
385: @Exit:
386: end;
387: function TypeXMSUtilities.MemAvail(Var total, largest : Word):boolean; Assembler;
388: asm mov ah,8; call XMSDriverAddr; les di,total; mov es:[di],dx
389: les di,largest; mov es:[di],ax; xor al,al; or bl,bl; jnz @x0; inc ax
390: @x0:
391: end;
392: function TypeXMSUtilities.AllocMem(var handle:word;KBSize:word):boolean; Assembler;
393: asm mov dx,KBSize; mov ah,9; call XMSDriverAddr; les di,handle; mov es:[di],dx
394: end;
395: function TypeXMSUtilities.FreeMem(handle:Word):boolean; Assembler;
396: asm mov dx,handle; mov ah,0ah; call XMSDriverAddr
397: end;
398: function TypeXMSUtilities.TransferMem(var XMSMoveRec:XMSMoveStruct):boolean; assembler;
399: asm push ds; push ds; pop es; lds si,XMSMoveRec; mov ah,bh
400: call es:XMSDriverAddr; pop ds
401: end;
402: function TypeXMSUtilities.MoveDataTo(SourceAddr: Pointer; NumBytes: LongInt;
403: Handle: Word; XMSOffset: LongInt): Boolean;
404: var XMSMoveRec:XMSMoveStruct;
405: begin
406: With XMSMoveRec do begin
407: TransferLength:=NumBytes;
408: SrcHandle:=0;
409: SrcOffset:=longint(SourceAddr);
410: DestHandle:=Handle;
411: DestOffset:=XMSOffset;
412: end;
413: MoveDataTo:=TransferMem(XMSMoveRec);
414: end;
415: function TypeXMSUtilities.GetDataFrom(Handle: Word; XMSOffset: LongInt;
416: NumBytes: LongInt; DestinationAddr: Pointer): Boolean;
417: var XMSMoveRec:XMSMoveStruct;
418: begin
419: With XMSMoveRec do begin
420: TransferLength:=NumBytes;
421: SrcHandle:=Handle;
422: SrcOffset:=XMSOffset;
423: DestHandle:=0;
424: DestOffset:=longint(DestinationAddr);
425: end;
426: GetDataFrom:=TransferMem(XMSMoveRec);
427: end;
428:
429: procedure TypeExtraUtilities.XMove(var source, dest; size: word); assembler;
430: asm push ds; push es; lds si,source; les di,dest; mov cx,size
431: cld; cmp si,di; jae @@1; add si,cx; add di,cx; dec si; dec di; std
432: @@1: shr cx,1; jnc @word1; movsb
433: @word1:
434: {$IFDEF USE386} shr cx,1; jnc @word2; movsw;
435: @word2: db 0f3h, 066h, 0a5h { rep movsd }
436: {$ELSE} rep movsw
437: {$ENDIF} pop es; pop ds
438: end;
439: procedure TypeExtraUtilities.StoreW(segm,ofs,v,c:word); assembler;
440: asm pushf; mov cx,c; mov ax,segm; mov es,ax; mov ax,ofs; mov di,ax;
441: mov ax,v; cld; rep stosw; popf
442: end;
443: procedure TypeExtraUtilities.StoreWv2(var destbuff; count,wdata:word); assembler;
444: asm pushf; les di,destbuff; mov cx,count; mov ax,wdata; cld; rep stosw; popf
445: end;
446:
447: function TypeMathUtilities.Power(num:extended;pow:integer) : extended;
448: var n:word; nu:extended;label nom;
449: begin
450: nu:=1; n:=abs(pow);
451: while n>0 do begin{ if (n and 1)=1 then nu:=nu*num;}
452: asm shr n,1; jnc nom; end;
453: nu:=nu*num;
454: nom:num:=sqr(num);
455: end;
456: if pow<0 then power:=1/nu else power:=nu;
457: end;
458: function TypeMathUtilities.dec2hex(dec:real;digitn:byte):string;
459: var tlgi:longint; xxfc,tby:byte; thexn:string[8];
460: begin
461: tlgi:=round(dec); thexn:='';
462: for xxfc:=1 to digitn do begin
463: tby:=tlgi and $f;
464: tlgi:=tlgi shr 4;
465: thexn:=Hexadecimalcharacters[tby]+thexn;
466: end;
467: dec2hex:=thexn;
468: end;
469:
470: function TypeOtherUtilities.GetTime(var hour,min:byte):word; assembler;
471: asm mov ah,2ch; int 21h; mov al,dh; mov bl,100; mul bl; xor dh,dh; add ax,dx
472: xchg ax,cx; les di, min; stosb; mov al,ah; les di,hour; stosb; xchg ax,cx
473: end;
474: procedure TypeOtherUtilities.GetIntVec(intno:byte;var vector:pointer);assembler;
475: { asm xor ax,ax; mov es,ax; mov al,intno; shl ax,2; mov di,ax; mov ax,es:[di]
476: mov bx,es:[di+2]; les di,vector; stosw; mov ax,bx; stosw
477: end;}
478: asm
479: MOV AL,IntNo
480: MOV AH,35H
481: INT 21H
482: MOV AX,ES
483: LES DI,Vector
484: CLD
485: XCHG AX,BX
486: STOSW
487: XCHG AX,BX
488: STOSW
489: end;
490: procedure TypeOtherUtilities.SetIntVec(intno : byte; vector : pointer);assembler;
491: { asm xor ax,ax; mov es,ax; mov al,intno; shl ax,2; mov di,ax; mov dx,ds
492: mov si,sp; add si,4; mov ax,ss; mov ds,ax; db 066h,0a5h; mov ds,dx
493: end;}
494: {asm
495: mov dx,ds
496:
497: xor ax,ax
498: mov es,ax
499: mov al,intno
500: shl ax,2
501: mov di,ax
502:
503: cld
504: mov bx,sp
505: mov ax,word ptr ss:[bx+4]
506: stosw
507: mov ax,word ptr ss:[bx+6]
508: stosw
509: end; }
510: asm PUSH DS
511: LDS DX,Vector
512: MOV AL,IntNo
513: MOV AH,25H
514: INT 21H
515: POP DS
516: end;
517: function TypeOtherUtilities.GetDate(var Year,Month,Day:word):byte; assembler;
518: asm mov ah,2ah; int 21h; les di,Year; xchg ax,cx; stosw; xor ah,ah;
519: les di,Month; mov al,dh; stosw; les di,Day; mov al,dl; stosw; xchg ax,cx
520: end;
521: function TypeOtherUtilities.GetExePath:string;
522: var exepath:string; epindex:integer;
523: begin
524: exepath:=paramstr(0);
525: epindex:=byte(exepath[0]);
526: while (exepath[epindex]<>'\') and (epindex>0) do dec(epindex);
527: exepath[0]:=char(epindex);
528: GetExePath:=exepath;
529: end;
530: procedure TypeOtherUtilities.InitWait;
531: var tsc:byte;
532: begin
533: wcounter:=0;
534: tsc:=mem[$40:$6c];
535: repeat until tsc<>mem[$40:$6c];
536: tsc:=mem[$40:$6c];
537: repeat inc(wcounter); until tsc<>mem[$40:$6c];
538: wcounter:=wcounter div 550;
539: end;
540: procedure TypeOtherUtilities.Waiting(msx:integer);
541: var wc:longint; fct:integer;
542: begin
543: for fct:=1 to msx do begin
544: wc:=0;
545: repeat inc(wc); {asm wait; nop; wait; nop; end;} until wcounter<wc;
546: end;
547: end;
548:
549: end.of program and file or record
550: if begin far interrupt procedure object while
551: repeat near assembler function until else
552: then uses const string with label type array
553: for to do asm Istvan Szikra :)