5 characters = Set of Char;
\r
7 function Capitalize(str: String): String;
\r
8 function Upper(str: String): String;
\r
9 function Lower(str: String): String;
\r
10 function iCASE(str: String): String;
\r
11 function RotStrL(str1,str2: String; shift: Byte): String;
\r
12 function RotStrR(str1,str2: String; shift: Byte): String;
\r
13 function ExpStrL(str: String; size: Byte; chr: Char): String;
\r
14 function ExpStrR(str: String; size: Byte; chr: Char): String;
\r
15 function DietStr(str: String; size: Byte): String;
\r
16 function CutStr(str: String): String;
\r
17 function FlipStr(str: String): String;
\r
18 function FilterStr(str: String; chr0,chr1: Char): String;
\r
19 function FilterStr2(str: String; chr0: characters; chr1: Char): String;
\r
20 function Num2str(num: Longint; base: Byte): String;
\r
21 function Str2num(str: String; base: Byte): Longint;
\r
24 tINPUT_STR_SETTING = Record
\r
27 append_enabled: Boolean;
\r
30 word_characters: characters;
\r
31 terminate_keys: array[1..50] of Word
\r
34 tINPUT_STR_ENVIRONMENT = Record
\r
39 is_setting: tINPUT_STR_SETTING =
\r
41 replace_enabled: TRUE;
\r
42 append_enabled: TRUE;
\r
43 character_set: [#$20..#$0ff];
\r
44 valid_chars: [#$20..#$0ff];
\r
45 word_characters: ['A'..'Z','a'..'z','0'..'9','_'];
\r
46 terminate_keys: ($011b,$1c0d,$0000,$0000,$0000,
\r
47 $0000,$0000,$0000,$0000,$0000,
\r
48 $0000,$0000,$0000,$0000,$0000,
\r
49 $0000,$0000,$0000,$0000,$0000,
\r
50 $0000,$0000,$0000,$0000,$0000,
\r
51 $0000,$0000,$0000,$0000,$0000,
\r
52 $0000,$0000,$0000,$0000,$0000,
\r
53 $0000,$0000,$0000,$0000,$0000,
\r
54 $0000,$0000,$0000,$0000,$0000,
\r
55 $0000,$0000,$0000,$0000,$0000));
\r
57 is_environment: tINPUT_STR_ENVIRONMENT;
\r
59 function InputStr(s: String; x,y,ln,ln1: Byte; atr1,atr2: Byte): String;
\r
60 function SameName(str1,str2: String): Boolean;
\r
61 function PathOnly(path: String): String;
\r
62 function NameOnly(path: String): String;
\r
63 function BaseNameOnly(path: String): String;
\r
64 function ExtOnly(path: String): String;
\r
71 function Capitalize(str: String): String; assembler;
\r
113 function Upper(str: String): String; assembler;
\r
137 function Lower(str: String): String; assembler;
\r
161 function iCase(str: String): String; assembler;
\r
196 function RotStrL(str1,str2: String; shift: Byte): String;
\r
198 RotStrL := Copy(str1,shift+1,Length(str1)-shift)+
\r
199 Copy(str2,1,shift);
\r
202 function RotStrR(str1,str2: String; shift: Byte): String;
\r
204 RotStrR := Copy(str2,Length(str2)-shift+1,shift)+
\r
205 Copy(str1,1,Length(str1)-shift);
\r
208 function ExpStrL(str: String; size: Byte; chr: Char): String; assembler;
\r
234 function ExpStrR(str: String; size: Byte; chr: Char): String; assembler;
\r
260 function DietStr(str: String; size: Byte): String;
\r
262 If (Length(str) <= size) then
\r
269 Delete(str,size DIV 2,1)
\r
270 until (Length(str)+3 = size);
\r
272 Insert('...',str,size DIV 2);
\r
276 function CutStr(str: String): String;
\r
278 While (str[0] <> #0) and (str[1] in [#00,#32]) do Delete(str,1,1);
\r
279 While (str[0] <> #0) and (str[Length(str)] in [#00,#32]) do Delete(str,Length(str),1);
\r
283 function FlipStr(str: String): String; assembler;
\r
304 function FilterStr(str: String; chr0,chr1: Char): String; assembler;
\r
327 _treat_char: array[$80..$a5] of Char =
\r
328 'CueaaaaceeeiiiAAE_AooouuyOU_____aiounN';
\r
330 function FilterStr2(str: String; chr0: characters; chr1: Char): String;
\r
336 For temp := 1 to Length(str) do
\r
337 If NOT (str[temp] in chr0) then
\r
338 If (str[temp] >= #$80) and (str[temp] <= #$a5) then
\r
339 str[temp] := _treat_char[BYTE(str[temp])]
\r
340 else If (str[temp] = #0) then str[temp] := ' '
\r
341 else str[temp] := chr1;
\r
345 function Num2str(num: Longint; base: Byte): String; assembler;
\r
348 hexa: array[0..PRED(16)+32] of Char = '0123456789ABCDEF'+
\r
349 #0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0;
\r
367 mov dl,byte ptr [hexa+esi]
\r
368 mov byte ptr [hexa+edi+16],dl
\r
377 @@2: mov al,byte ptr [hexa+esi+16]
\r
382 @@3: mov edi,@result
\r
389 digits: array[0..35] of Char = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
\r
391 function Digit2index(digit: Char): Byte;
\r
397 digit := UpCase(digit);
\r
399 While (index > 0) and (digit <> digits[index]) do Dec(index);
\r
400 Digit2index := Index;
\r
403 function position_value(position,base: Byte): Longint;
\r
411 For index := 2 to position do value := value*base;
\r
412 position_value := value;
\r
415 function Str2num(str: String; base: Byte): Longint;
\r
423 For index := 1 to Length(str) do
\r
424 Inc(value,Digit2index(str[index])*
\r
425 position_value(Length(str)-index+1,base));
\r
429 function InputStr(s: String; x,y,ln,ln1: Byte; atr1,atr2: Byte): String;
\r
432 appn,for1st,qflg,ins: Boolean;
\r
433 cloc,xloc,xint,mx,attr: Byte;
\r
438 function LookupKey(key: Word; var table; size: Byte): Boolean; assembler;
\r
455 function more(value1,value2: Byte): Byte; assembler;
\r
466 If (is_environment.locate_pos > ln1) then
\r
467 is_environment.locate_pos := ln1;
\r
468 If (is_environment.locate_pos > Length(s)+1) then
\r
469 is_environment.locate_pos := Length(s);
\r
471 cloc := is_environment.locate_pos;
\r
472 xloc := is_environment.locate_pos;
\r
475 ins := is_setting.insert_mode;
\r
476 appn := NOT is_setting.append_enabled;
\r
480 If ins then ThinCursor else WideCursor;
\r
482 If (BYTE(s1[0]) > ln1) then s1[0] := CHR(ln1);
\r
484 ShowStr(Ptr(v_seg,v_ofs)^,xint,y,ExpStrR('',ln1,' '),atr1);
\r
485 ShowStr(Ptr(v_seg,v_ofs)^,xint,y,s1,atr2);
\r
490 If (xloc = 1) then s1 := Copy(s,cloc,ln1)
\r
491 else s1 := Copy(s,cloc-xloc+1,ln1);
\r
493 If NOT appn then attr := atr2
\r
496 If appn and for1st then
\r
498 ShowStr(Ptr(v_seg,v_ofs)^,xint,y,ExpStrR(s1,ln1,' '),atr1);
\r
503 ShowStr(Ptr(v_seg,v_ofs)^,xint,y,ExpStrR(s1,ln1,' '),atr1);
\r
506 If (cloc-xloc > 0) and (Length(s) > 0) then
\r
507 ShowStr(Ptr(v_seg,v_ofs)^,xint,y,'
\11',(attr AND $0f0)+$0f)
\r
508 else If (cloc-xloc = 0) and (Length(s) <> 0) then
\r
509 ShowStr(Ptr(v_seg,v_ofs)^,xint,y,s[1],attr)
\r
511 ShowStr(Ptr(v_seg,v_ofs)^,xint,y,' ',atr1);
\r
514 If (cloc-xloc+ln1 < Length(s)) then
\r
515 ShowStr(Ptr(v_seg,v_ofs)^,xint+ln1-1,y,'
\10',(attr AND $0f0)+$0f)
\r
516 else If (cloc-xloc+ln1 = Length(s)) then
\r
517 ShowStr(Ptr(v_seg,v_ofs)^,xint+ln1-1,y,s[Length(s)],attr)
\r
519 ShowStr(Ptr(v_seg,v_ofs)^,xint+ln1-1,y,' ',atr1);
\r
522 asm xor ah,ah; int 16h; mov key,ax end;
\r
523 If LookupKey(key,is_setting.terminate_keys,50) then qflg := TRUE;
\r
528 $19: begin appn := TRUE; s := ''; cloc := 1; xloc := 1; end;
\r
532 While (s[cloc] in is_setting.word_characters) and
\r
533 (cloc <= Length(s)) do Delete(s,cloc,1);
\r
535 While NOT (s[cloc] in is_setting.word_characters) and
\r
536 (cloc <= Length(s)) do Delete(s,cloc,1);
\r
541 While (s[cloc-1] in is_setting.word_characters) and
\r
544 Dec(cloc); Delete(s,cloc,1);
\r
545 If (xloc > 1) then Dec(xloc);
\r
548 While NOT (s[cloc-1] in is_setting.word_characters) and
\r
551 Dec(cloc); Delete(s,cloc,1);
\r
552 If (xloc > 1) then Dec(xloc);
\r
556 $11: begin appn := TRUE; Delete(s,cloc,Length(s)); end;
\r
562 If (xloc > 1) then Dec(xloc);
\r
563 Dec(cloc); Delete(s,cloc,1);
\r
568 If (HI(key) in [$73,$74,$4b,$4d,$52,$47,$4f]) then
\r
573 While (s[cloc] in is_setting.word_characters) and
\r
577 If (xloc > 1) then Dec(xloc);
\r
580 While NOT (s[cloc] in is_setting.word_characters) and
\r
584 If (xloc > 1) then Dec(xloc);
\r
589 While (s[cloc] in is_setting.word_characters) and
\r
590 (cloc < Length(s)) do
\r
593 If (xloc < ln1) then Inc(xloc);
\r
596 While NOT (s[cloc] in is_setting.word_characters) and
\r
597 (cloc < Length(s)) do
\r
600 If (xloc < ln1) then Inc(xloc);
\r
605 If (cloc > 1) then Dec(cloc);
\r
606 If (xloc > 1) then Dec(xloc);
\r
610 If (cloc < Length(s)) or ((cloc = Length(s)) and
\r
611 ((Length(s) < more(ln,ln1)))) then
\r
613 If (xloc < ln1) and (xloc <= Length(s)) then Inc(xloc);
\r
618 If (cloc <= Length(s)) then Delete(s,cloc,1);
\r
621 $52: If is_setting.replace_enabled then
\r
624 If ins then ThinCursor else WideCursor;
\r
627 $47: begin cloc := 1; xloc := 1; end;
\r
630 If (Length(s) < more(ln,ln1)) then cloc := Succ(Length(s))
\r
631 else cloc := Length(s);
\r
632 If (cloc < ln1) then xloc := cloc else xloc := ln1;
\r
637 else If NOT (LO(key) in [$09,$19,$0d,$14,$0b,$7f]) and
\r
638 (CHR(LO(key)) in characters(is_setting.character_set)) then
\r
640 If NOT appn then begin s := ''; cloc := 1; xloc := 1; end;
\r
642 If ins and (Length(s) < ln) then
\r
644 Insert(CHR(LO(key)),s,cloc);
\r
645 s := FilterStr2(s,is_setting.valid_chars,'_');
\r
646 If (cloc < ln) then Inc(cloc);
\r
647 If (xloc < ln) and (xloc < ln1) then Inc(xloc)
\r
650 If (Length(s) < ln) or NOT ins then
\r
652 If (cloc > Length(s)) and (Length(s) < ln) then
\r
655 s[cloc] := CHR(LO(key));
\r
656 s := FilterStr2(s,is_setting.valid_chars,'_');
\r
657 If (cloc < ln) then Inc(cloc);
\r
658 If (xloc < ln) and (xloc < ln1) then Inc(xloc);
\r
665 If (cloc = 0) then is_environment.locate_pos := 1
\r
666 else is_environment.locate_pos := cloc;
\r
667 is_environment.keystroke := key;
\r
671 function SameName(str1,str2: String): Boolean; assembler;
\r
714 cmp word ptr [esi],']?'
\r
716 mov ah,byte ptr [edi]
\r
718 cmp byte ptr [esi],'!'
\r
732 cmp byte ptr [esi],'-'
\r
798 function PathOnly(path: String): String;
\r
800 FSplit(path,dir,name,ext);
\r
804 function NameOnly(path: String): String;
\r
806 FSplit(path,dir,name,ext);
\r
807 NameOnly := name+ext;
\r
810 function BaseNameOnly(path: String): String;
\r
812 FSplit(path,dir,name,ext);
\r
813 BaseNameOnly := name;
\r
816 function ExtOnly(path: String): String;
\r
818 FSplit(path,dir,name,ext);
\r
824 is_environment.locate_pos := 1;
\r