20070107 release of Orpheus - initial commit to SVN.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@44 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/orpheus/ovcuser.pas

@@ -0,0 +1,186 @@
+{*********************************************************}
+{*                   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.