mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-30 02:03:15 +02:00
+ added unit uinplong - unicode version of inplong
git-svn-id: branches/unicodekvm@48849 -
This commit is contained in:
parent
af19d2a982
commit
52a29e0ba7
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -5047,6 +5047,7 @@ packages/fv/src/udialogs.pas svneol=native#text/plain
|
|||||||
packages/fv/src/udrivers.pas svneol=native#text/plain
|
packages/fv/src/udrivers.pas svneol=native#text/plain
|
||||||
packages/fv/src/ufvcommon.pas svneol=native#text/plain
|
packages/fv/src/ufvcommon.pas svneol=native#text/plain
|
||||||
packages/fv/src/uhistlist.pas svneol=native#text/plain
|
packages/fv/src/uhistlist.pas svneol=native#text/plain
|
||||||
|
packages/fv/src/uinplong.pas svneol=native#text/plain
|
||||||
packages/fv/src/umenus.pas svneol=native#text/plain
|
packages/fv/src/umenus.pas svneol=native#text/plain
|
||||||
packages/fv/src/umsgbox.pas svneol=native#text/plain
|
packages/fv/src/umsgbox.pas svneol=native#text/plain
|
||||||
packages/fv/src/unixsmsg.inc svneol=native#text/plain
|
packages/fv/src/unixsmsg.inc svneol=native#text/plain
|
||||||
|
@ -3,7 +3,7 @@ program testuapp;
|
|||||||
{$codepage UTF8}
|
{$codepage UTF8}
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Objects, UDrivers, UViews, UMenus, UDialogs, UApp, UMsgBox, SysUtils;
|
Objects, UDrivers, UViews, UMenus, UDialogs, UApp, UMsgBox, UInpLong, SysUtils;
|
||||||
|
|
||||||
const
|
const
|
||||||
cmOrderNew = 200;
|
cmOrderNew = 200;
|
||||||
|
@ -219,6 +219,19 @@ begin
|
|||||||
AddUnit('views');
|
AddUnit('views');
|
||||||
AddUnit('dialogs');
|
AddUnit('dialogs');
|
||||||
AddUnit('msgbox');
|
AddUnit('msgbox');
|
||||||
|
AddUnit('fvcommon');
|
||||||
|
AddUnit('fvconsts');
|
||||||
|
end;
|
||||||
|
T:=P.Targets.AddUnit('uinplong.pas');
|
||||||
|
with T.Dependencies do
|
||||||
|
begin
|
||||||
|
AddInclude('inplong.inc');
|
||||||
|
AddInclude('platform.inc');
|
||||||
|
AddUnit('udrivers');
|
||||||
|
AddUnit('uviews');
|
||||||
|
AddUnit('udialogs');
|
||||||
|
AddUnit('umsgbox');
|
||||||
|
AddUnit('ufvcommon');
|
||||||
AddUnit('fvconsts');
|
AddUnit('fvconsts');
|
||||||
end;
|
end;
|
||||||
T:=P.Targets.AddUnit('memory.pas');
|
T:=P.Targets.AddUnit('memory.pas');
|
||||||
|
@ -1,4 +1,8 @@
|
|||||||
|
{$ifdef FV_UNICODE}
|
||||||
|
Unit UInpLong;
|
||||||
|
{$else FV_UNICODE}
|
||||||
Unit InpLong;
|
Unit InpLong;
|
||||||
|
{$endif FV_UNICODE}
|
||||||
|
|
||||||
(*--
|
(*--
|
||||||
TInputLong is a derivitave of TInputline designed to accept LongInt
|
TInputLong is a derivitave of TInputline designed to accept LongInt
|
||||||
@ -76,7 +80,13 @@ Valid returns False.
|
|||||||
{$endif}
|
{$endif}
|
||||||
|
|
||||||
Interface
|
Interface
|
||||||
uses objects, drivers, views, dialogs, msgbox, fvconsts;
|
uses objects,
|
||||||
|
{$ifdef FV_UNICODE}
|
||||||
|
udrivers, uviews, udialogs, umsgbox, ufvcommon,
|
||||||
|
{$else FV_UNICODE}
|
||||||
|
drivers, views, dialogs, msgbox, fvcommon,
|
||||||
|
{$endif FV_UNICODE}
|
||||||
|
fvconsts;
|
||||||
|
|
||||||
{flags for TInputLong constructor}
|
{flags for TInputLong constructor}
|
||||||
const
|
const
|
||||||
@ -119,7 +129,7 @@ ULim := UpperLim;
|
|||||||
LLim := LowerLim;
|
LLim := LowerLim;
|
||||||
if Flgs and ilDisplayHex <> 0 then Flgs := Flgs or ilHex;
|
if Flgs and ilDisplayHex <> 0 then Flgs := Flgs or ilHex;
|
||||||
ILOptions := Flgs;
|
ILOptions := Flgs;
|
||||||
if ILOptions and ilBlankEqZero <> 0 then Data^ := '0';
|
if ILOptions and ilBlankEqZero <> 0 then Data Sw_PString_Deref := '0';
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{-------------------TInputLong.Load}
|
{-------------------TInputLong.Load}
|
||||||
@ -150,28 +160,32 @@ end;
|
|||||||
PROCEDURE TInputLong.GetData(var Rec);
|
PROCEDURE TInputLong.GetData(var Rec);
|
||||||
var code : SmallInt;
|
var code : SmallInt;
|
||||||
begin
|
begin
|
||||||
Val(Data^, LongInt(Rec), code);
|
Val(Data Sw_PString_Deref, LongInt(Rec), code);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
FUNCTION Hex2(B : Byte) : String;
|
FUNCTION Hex2(B : Byte) : Sw_String;
|
||||||
Const
|
Const
|
||||||
HexArray : array[0..15] of char = '0123456789ABCDEF';
|
HexArray : array[0..15] of char = '0123456789ABCDEF';
|
||||||
begin
|
begin
|
||||||
Hex2[0] := #2;
|
SetLength(Hex2, 2);
|
||||||
Hex2[1] := HexArray[B shr 4];
|
Hex2[1] := HexArray[B shr 4];
|
||||||
Hex2[2] := HexArray[B and $F];
|
Hex2[2] := HexArray[B and $F];
|
||||||
end;
|
end;
|
||||||
|
|
||||||
FUNCTION Hex4(W : Word) : String;
|
FUNCTION Hex4(W : Word) : Sw_String;
|
||||||
begin Hex4 := Hex2(Hi(W))+Hex2(Lo(W)); end;
|
begin Hex4 := Hex2(Hi(W))+Hex2(Lo(W)); end;
|
||||||
|
|
||||||
FUNCTION Hex8(L : LongInt) : String;
|
FUNCTION Hex8(L : LongInt) : Sw_String;
|
||||||
begin Hex8 := Hex4(LongRec(L).Hi)+Hex4(LongRec(L).Lo); end;
|
begin Hex8 := Hex4(LongRec(L).Hi)+Hex4(LongRec(L).Lo); end;
|
||||||
|
|
||||||
function FormHexStr(L : LongInt) : String;
|
function FormHexStr(L : LongInt) : Sw_String;
|
||||||
var
|
var
|
||||||
Minus : boolean;
|
Minus : boolean;
|
||||||
|
{$ifdef FV_UNICODE}
|
||||||
|
S : Sw_String;
|
||||||
|
{$else FV_UNICODE}
|
||||||
S : string[20];
|
S : string[20];
|
||||||
|
{$endif FV_UNICODE}
|
||||||
begin
|
begin
|
||||||
Minus := L < 0;
|
Minus := L < 0;
|
||||||
if Minus then L := -L;
|
if Minus then L := -L;
|
||||||
@ -186,7 +200,7 @@ end;
|
|||||||
PROCEDURE TInputLong.SetData(var Rec);
|
PROCEDURE TInputLong.SetData(var Rec);
|
||||||
var
|
var
|
||||||
L : LongInt;
|
L : LongInt;
|
||||||
S : string;
|
S : Sw_String;
|
||||||
begin
|
begin
|
||||||
L := LongInt(Rec);
|
L := LongInt(Rec);
|
||||||
if L > ULim then L := ULim
|
if L > ULim then L := ULim
|
||||||
@ -195,8 +209,8 @@ if ILOptions and ilDisplayHex <> 0 then
|
|||||||
S := FormHexStr(L)
|
S := FormHexStr(L)
|
||||||
else
|
else
|
||||||
Str(L : -1, S);
|
Str(L : -1, S);
|
||||||
if Length(S) > MaxLen then S[0] := chr(MaxLen);
|
if Length(S) > MaxLen then SetLength(S, MaxLen);
|
||||||
Data^ := S;
|
Data Sw_PString_Deref := S;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{-------------------TInputLong.RangeCheck}
|
{-------------------TInputLong.RangeCheck}
|
||||||
@ -205,18 +219,22 @@ var
|
|||||||
L : LongInt;
|
L : LongInt;
|
||||||
code : SmallInt;
|
code : SmallInt;
|
||||||
begin
|
begin
|
||||||
if (Data^ = '') and (ILOptions and ilBlankEqZero <> 0) then
|
if (Data Sw_PString_Deref = '') and (ILOptions and ilBlankEqZero <> 0) then
|
||||||
Data^ := '0';
|
Data Sw_PString_Deref := '0';
|
||||||
Val(Data^, L, code);
|
Val(Data Sw_PString_Deref, L, code);
|
||||||
RangeCheck := (Code = 0) and (L >= LLim) and (L <= ULim);
|
RangeCheck := (Code = 0) and (L >= LLim) and (L <= ULim);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{-------------------TInputLong.Error}
|
{-------------------TInputLong.Error}
|
||||||
PROCEDURE TInputLong.Error;
|
PROCEDURE TInputLong.Error;
|
||||||
var
|
var
|
||||||
|
{$ifdef FV_UNICODE}
|
||||||
|
SU, SL : Sw_String;
|
||||||
|
{$else FV_UNICODE}
|
||||||
SU, SL : string[40];
|
SU, SL : string[40];
|
||||||
|
{$endif FV_UNICODE}
|
||||||
PMyLabel : PLabel;
|
PMyLabel : PLabel;
|
||||||
Labl : string;
|
Labl : Sw_String;
|
||||||
I : SmallInt;
|
I : SmallInt;
|
||||||
|
|
||||||
function FindIt(P : PView) : boolean;{$ifdef PPC_BP}far;{$endif}
|
function FindIt(P : PView) : boolean;{$ifdef PPC_BP}far;{$endif}
|
||||||
@ -274,7 +292,7 @@ if (Event.What = evKeyDown) then
|
|||||||
'-' : if (LLim >= 0) or (CurPos <> 0) then
|
'-' : if (LLim >= 0) or (CurPos <> 0) then
|
||||||
ClearEvent(Event);
|
ClearEvent(Event);
|
||||||
'$' : if ILOptions and ilHex = 0 then ClearEvent(Event);
|
'$' : if ILOptions and ilHex = 0 then ClearEvent(Event);
|
||||||
'A'..'F' : if Pos('$', Data^) = 0 then ClearEvent(Event);
|
'A'..'F' : if Pos('$', Data Sw_PString_Deref) = 0 then ClearEvent(Event);
|
||||||
|
|
||||||
else ClearEvent(Event);
|
else ClearEvent(Event);
|
||||||
end;
|
end;
|
||||||
|
2
packages/fv/src/uinplong.pas
Normal file
2
packages/fv/src/uinplong.pas
Normal file
@ -0,0 +1,2 @@
|
|||||||
|
{$DEFINE FV_UNICODE}
|
||||||
|
{$I inplong.inc}
|
Loading…
Reference in New Issue
Block a user