
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@44 8e941d3f-bd1b-0410-a28a-d453659cc2b4
187 lines
6.0 KiB
ObjectPascal
187 lines
6.0 KiB
ObjectPascal
{*********************************************************}
|
|
{* OVCUSER.PAS 4.06 *}
|
|
{*********************************************************}
|
|
|
|
{* ***** BEGIN LICENSE BLOCK ***** *}
|
|
{* Version: MPL 1.1 *}
|
|
{* *}
|
|
{* The contents of this file are subject to the Mozilla Public License *}
|
|
{* Version 1.1 (the "License"); you may not use this file except in *}
|
|
{* compliance with the License. You may obtain a copy of the License at *}
|
|
{* http://www.mozilla.org/MPL/ *}
|
|
{* *}
|
|
{* Software distributed under the License is distributed on an "AS IS" basis, *}
|
|
{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
|
|
{* for the specific language governing rights and limitations under the *}
|
|
{* License. *}
|
|
{* *}
|
|
{* The Original Code is TurboPower Orpheus *}
|
|
{* *}
|
|
{* The Initial Developer of the Original Code is TurboPower Software *}
|
|
{* *}
|
|
{* Portions created by TurboPower Software Inc. are Copyright (C)1995-2002 *}
|
|
{* TurboPower Software Inc. All Rights Reserved. *}
|
|
{* *}
|
|
{* Contributor(s): *}
|
|
{* *}
|
|
{* ***** END LICENSE BLOCK ***** *}
|
|
|
|
{$I OVC.INC}
|
|
|
|
{$B-} {Complete Boolean Evaluation}
|
|
{$I+} {Input/Output-Checking}
|
|
{$P+} {Open Parameters}
|
|
{$T-} {Typed @ Operator}
|
|
{.W-} {Windows Stack Frame}
|
|
{$X+} {Extended Syntax}
|
|
|
|
unit ovcuser;
|
|
{-User data class}
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils,
|
|
OvcData;
|
|
|
|
type
|
|
{class for implementing user-defined mask and substitution characters}
|
|
TOvcUserData = class(TObject)
|
|
{.Z+}
|
|
protected {private}
|
|
FUserCharSets : TUserCharSets;
|
|
FForceCase : TForceCase;
|
|
FSubstChars : TSubstChars;
|
|
|
|
{property methods}
|
|
function GetForceCase(Index : TForceCaseRange) : TCaseChange;
|
|
{-get the case changing behavior of the specified user mask character}
|
|
function GetSubstChar(Index : TSubstCharRange) : AnsiChar;
|
|
{-get the meaning of the specified substitution character}
|
|
function GetUserCharSet(Index : TUserSetRange) : TCharSet;
|
|
{-get the specified user-defined character set}
|
|
procedure SetForceCase(Index : TForceCaseRange; CC : TCaseChange);
|
|
{-set the case changing behavior of the specified user mask character}
|
|
procedure SetSubstChar(Index : TSubstCharRange; SC : AnsiChar);
|
|
{-set the meaning of the specified substitution character}
|
|
procedure SetUserCharSet(Index : TUserSetRange; const US : TCharSet);
|
|
{-set the specified user-defined character set}
|
|
|
|
public
|
|
constructor Create;
|
|
{.Z+}
|
|
|
|
property ForceCase[Index : TForceCaseRange] : TCaseChange
|
|
read GetForceCase
|
|
write SetForceCase;
|
|
|
|
property SubstChars[Index : TSubstCharRange] : AnsiChar
|
|
read GetSubstChar
|
|
write SetSubstChar;
|
|
|
|
property UserCharSet[Index : TUserSetRange] : TCharSet
|
|
read GetUserCharSet
|
|
write SetUserCharSet;
|
|
end;
|
|
|
|
var
|
|
{global default user data object}
|
|
OvcUserData : TOvcUserData;
|
|
|
|
|
|
implementation
|
|
|
|
|
|
{*** TOvcUserData ***}
|
|
|
|
const
|
|
DefUserCharSets : TUserCharSets = (
|
|
{User1} [#1..#255], {User2} [#1..#255], {User3} [#1..#255],
|
|
{User4} [#1..#255], {User5} [#1..#255], {User6} [#1..#255],
|
|
{User7} [#1..#255], {User8} [#1..#255] );
|
|
|
|
DefForceCase : TForceCase = (
|
|
mcNoChange, mcNoChange, mcNoChange, mcNoChange,
|
|
mcNoChange, mcNoChange, mcNoChange, mcNoChange);
|
|
|
|
DefSubstChars : TSubstChars = (
|
|
Subst1, Subst2, Subst3, Subst4, Subst5, Subst6, Subst7, Subst8);
|
|
|
|
constructor TOvcUserData.Create;
|
|
begin
|
|
inherited Create;
|
|
|
|
FUserCharSets := DefUserCharSets;
|
|
FForceCase := DefForceCase;
|
|
FSubstChars := DefSubstChars;
|
|
end;
|
|
|
|
function TOvcUserData.GetForceCase(Index : TForceCaseRange) : TCaseChange;
|
|
{-get the case changing behavior of the specified user mask character}
|
|
begin
|
|
case Index of
|
|
pmUser1..pmUser8 : Result := FForceCase[Index];
|
|
else
|
|
Result := mcNoChange;
|
|
end;
|
|
end;
|
|
|
|
function TOvcUserData.GetSubstChar(Index : TSubstCharRange) : AnsiChar;
|
|
{-get the meaning of the specified substitution character}
|
|
begin
|
|
case Index of
|
|
Subst1..Subst8 : Result := FSubstChars[Index];
|
|
else
|
|
Result := #0;
|
|
end;
|
|
end;
|
|
|
|
function TOvcUserData.GetUserCharSet(Index : TUserSetRange) : TCharSet;
|
|
{-get the specified user-defined character set}
|
|
begin
|
|
case Index of
|
|
pmUser1..pmUser8 : Result := FUserCharSets[Index];
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcUserData.SetForceCase(Index : TForceCaseRange; CC : TCaseChange);
|
|
{-set the case changing behavior of the specified user mask character}
|
|
begin
|
|
case Index of
|
|
pmUser1..pmUser8 : FForceCase[Index] := CC;
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcUserData.SetSubstChar(Index : TSubstCharRange; SC : AnsiChar);
|
|
{-set the meaning of the specified substitution character}
|
|
begin
|
|
case Index of
|
|
Subst1..Subst8 : FSubstChars[Index] := SC;
|
|
end;
|
|
end;
|
|
|
|
procedure TOvcUserData.SetUserCharSet(Index : TUserSetRange; const US : TCharSet);
|
|
{-set the specified user-defined character set}
|
|
begin
|
|
case Index of
|
|
pmUser1..pmUser8 : FUserCharSets[Index] := US-[#0];
|
|
end;
|
|
end;
|
|
|
|
|
|
{*** exit procedure ***}
|
|
|
|
procedure DestroyGlobalUserData; far;
|
|
begin
|
|
OvcUserData.Free
|
|
end;
|
|
|
|
|
|
initialization
|
|
{create instance of default user data class}
|
|
OvcUserData := TOvcUserData.Create;
|
|
|
|
finalization
|
|
DestroyGlobalUserData;
|
|
end.
|