-
- This means that parentheses have maximum precedence, followed
- by square brackets, followed by the closure operators,
- followed by concatenation, finally followed by alternation.}
-
-unit o32rxngn;
- {Orpheus Regex Engine}
-
-interface
-
-uses
- Classes, SysUtils, O32IntDeq, O32IntLst;
-
-type
- PO32CharSet = ^TO32CharSet;
- TO32CharSet = set of char;
-
- TO32NFAMatchType = ( {types of matching performed...}
- mtNone, {..no match (an epsilon no-cost move)}
- mtAnyChar, {..any character}
- mtChar, {..a particular character}
- mtClass, {..a character class}
- mtNegClass, {..a negated character class}
- mtTerminal, {..the final state--no matching}
- mtUnused); {..an unused state--no matching}
-
- TO32RegexError = ( {error codes for invalid regex strings}
- recNone, {..no error}
- recSuddenEnd, {..unexpected end of string}
- recMetaChar, {..read metacharacter, but needed normal char}
- recNoCloseParen, {..expected close paren, but not there}
- recExtraChars); {..extra characters at the end of the Regex string}
-
- TO32UpcaseChar = function (aCh : char) : char;
-
- {- Regex Engine Class}
- TO32RegexEngine = class
- protected {private}
- FAnchorEnd : boolean;
- FAnchorStart : boolean;
- FErrorCode : TO32RegexError;
- FIgnoreCase : boolean;
- FPosn : PAnsiChar;
- FRegexStr : string;
- FStartState : integer;
- FTable : TList;
- FUpcase : TO32UpcaseChar;
- FLogging : Boolean;
- Log : System.Text;
- FLogFile : string;
-
- procedure SetLogFile(const Value: String);
-
- procedure rcSetIgnoreCase(aValue : boolean);
- procedure rcSetRegexStr(const aRegexStr : string);
- procedure rcSetUpcase(aValue : TO32UpcaseChar);
- procedure rcSetLogging(const aValue : Boolean);
-
- procedure rcClear;
- procedure rcLevel1Optimize;
- procedure rcLevel2Optimize;
- function rcMatchSubString(const S : string;
- StartPosn : integer) : boolean;
- function rcAddState(aMatchType : TO32NFAMatchType;
- aChar : char;
- aCharClass : PO32CharSet;
- aNextState1: integer;
- aNextState2: integer) : integer;
- function rcSetState(aState : integer;
- aNextState1: integer;
- aNextState2: integer) : integer;
-
- function rcParseAnchorExpr : integer;
- function rcParseAtom : integer;
- function rcParseCCChar : char;
- function rcParseChar : integer;
- function rcParseCharClass(aClass : PO32CharSet) : boolean;
- function rcParseCharRange(aClass : PO32CharSet) : boolean;
- function rcParseExpr : integer;
- function rcParseFactor : integer;
- function rcParseTerm : integer;
-
- procedure rcWalkNoCostTree(aList : TO32IntList;
- aState : integer);
- procedure rcDumpTable;
-
- public
- constructor Create(const aRegexStr : string);
- destructor Destroy; override;
-
- function Parse(var aErrorPos : integer;
- var aErrorCode: TO32RegexError) : boolean;
- function MatchString(const S : string) : integer;
-
- property IgnoreCase : boolean
- read FIgnoreCase write rcSetIgnoreCase;
- property RegexString : string
- read FRegexStr write rcSetRegexStr;
- property Upcase : TO32UpcaseChar
- read FUpcase write rcSetUpcase;
- property Logging : Boolean
- read FLogging write rcSetLogging;
- property LogFile : String read FLogFile write SetLogFile;
- end;
-
-implementation
-
-const
- MetaCharacters: set of char =
- ['?', '*', '+', '-', '.', '|', '(', ')', '[', ']', '^', '$'];
-
- {handy constants}
- UnusedState = -1;
- NewFinalState = -2;
- CreateNewState = -3;
- ErrorState = -4;
- MustScan = -5;
-
-type
- PO32NFAState = ^TO32NFAState;
- TO32NFAState = record
- sdNextState1: integer;
- sdNextState2: integer;
- sdNextList : TO32IntList;
- sdClass : PO32CharSet;
- sdMatchType : TO32NFAMatchType;
- sdChar : char;
- end;
-
-{===TO32RegexEngine=================================================}
-constructor TO32RegexEngine.Create(const aRegexStr : string);
-begin
- inherited Create;
- FRegexStr := aRegexStr;
- FIgnoreCase := true;
- FUpcase := System.Upcase;
- FTable := TList.Create;
- FTable.Capacity := 64;
- FLogging := false;
-end;
-{--------}
-destructor TO32RegexEngine.Destroy;
-begin
- if (FTable <> nil) then begin
- rcClear;
- FTable.Free;
- end;
- inherited Destroy;
-end;
-{--------}
-procedure TO32RegexEngine.rcSetLogging(const aValue : Boolean);
-begin
- FLogging := aValue;
-end;
-{--------}
-procedure TO32RegexEngine.SetLogFile(const Value: String);
-begin
- FLogFile := Value;
-end;
-{--------}
-function TO32RegexEngine.MatchString(const S : string) : integer;
-var
- i : integer;
- ErrorPos : integer;
- ErrorCode : TO32RegexError;
-begin
- {if the regex string hasn't been parsed yet, do so}
- if (FTable.Count = 0) then begin
- if not Parse(ErrorPos, ErrorCode) then begin
- raise Exception.Create(
- Format('The regex was invalid at position %d', [ErrorPos]));
- end;
- end;
- {now try and see if the string matches (empty strings don't)}
- Result := 0;
- if (S <> '') then
- {if the regex specified a start anchor, then we only need to check
- the string starting at the first position}
- if FAnchorStart then begin
- if rcMatchSubString(S, 1) then
- Result := 1;
- end
- {otherwise we try and match the string at every position and
- return at the first success}
- else begin
- for i := 1 to length(S) do
- if rcMatchSubString(S, i) then begin
- Result := i;
- Break;
- end;
- end;
-end;
-{--------}
-function TO32RegexEngine.Parse(var aErrorPos : integer;
- var aErrorCode: TO32RegexError)
- : boolean;
- procedure WriteError(aErrorPos : integer;
- aErrorCode: TO32RegexError);
- begin
- writeln(Log, '***parse error found at ', aErrorPos);
- case aErrorCode of
- recNone : writeln(Log, '-->no error');
- recSuddenEnd : writeln(Log, '-->unexpected end of regex');
- recMetaChar : writeln(Log, '-->found metacharacter in wrong place');
- recNoCloseParen : writeln(Log, '-->missing close paren');
- recExtraChars : writeln(Log, '-->extra chars after valid regex');
- end;
- writeln(Log, '"', FRegexStr, '"');
- writeln(Log, '^':succ(aErrorPos));
- end;
-begin
- result := false;
- if FLogging then begin
- if FLogFile = '' then FLogFile := 'Parse.log';
- System.Assign(Log, FLogFile);
- System.Rewrite(Log);
- end;
-
- try
- if FLogging then writeln(Log, 'Parsing regex: "', FRegexStr, '"');
-
- {clear the current transition table}
- rcClear;
- {empty regex strings are not allowed}
- if (FRegexStr = '') then begin
- aErrorPos := 1;
- aErrorCode := recSuddenEnd;
-
- if FLogging then WriteError(aErrorPos, aErrorCode);
- Exit;
- end;
- {parse the regex string}
- FPosn := PAnsiChar(FRegexStr);
- FStartState := rcParseAnchorExpr;
-
- {if an error occurred or we're not at the end of the regex string,
- clear the transition table, return false and the error position}
- if (FStartState = ErrorState) or (FPosn^ <> #0) then begin
- if (FStartState <> ErrorState) and (FPosn^ <> #0) then
- FErrorCode := recExtraChars;
- rcClear;
- aErrorPos := succ(FPosn - PAnsiChar(FRegexStr));
- aErrorCode := FErrorCode;
-
- if FLogging then WriteError(aErrorPos, aErrorCode);
- end
- {otherwise add a terminal state, optimize, return true}
- else begin
- rcAddState(mtTerminal, #0, nil, UnusedState, UnusedState);
- rcLevel1Optimize;
- rcLevel2Optimize;
- Result := true;
- aErrorPos := 0;
- aErrorCode := recNone;
-
- if FLogging then rcDumpTable;
- end;
- finally
- if FLogging then System.Close(Log);
- end;
-end;
-{--------}
-function TO32RegexEngine.rcAddState(aMatchType : TO32NFAMatchType;
- aChar : char;
- aCharClass : PO32CharSet;
- aNextState1: integer;
- aNextState2: integer) : integer;
-var
- StateData : PO32NFAState;
-begin
- {create the new state record}
- StateData := AllocMem(sizeof(TO32NFAState));
- {set up the fields in the state record}
- if (aNextState1 = NewFinalState) then
- StateData^.sdNextState1 := succ(FTable.Count)
- else
- StateData^.sdNextState1 := aNextState1;
- StateData^.sdNextState2 := aNextState2;
- StateData^.sdMatchType := aMatchType;
- if (aMatchType = mtChar) then
- StateData^.sdChar := aChar
- else if (aMatchType = mtClass) or (aMatchType = mtNegClass) then
- StateData^.sdClass := aCharClass;
- {add the new state}
- Result := FTable.Count;
- FTable.Add(StateData);
-end;
-{--------}
-procedure TO32RegexEngine.rcClear;
-var
- i : integer;
- StateData : PO32NFAState;
-begin
- {free all items in the state transition table}
- for i := 0 to pred(FTable.Count) do begin
- StateData := PO32NFAState(FTable.List^[i]);
- if (StateData <> nil) then begin
- with StateData^ do begin
- if (sdMatchType = mtClass) or
- (sdMatchType = mtNegClass) then
- if (sdClass <> nil) then
- FreeMem(StateData^.sdClass);
- sdNextList.Free;
- end;
- Dispose(StateData);
- end;
- end;
- {clear the state transition table}
- FTable.Clear;
- FTable.Capacity := 64;
- FAnchorStart := false;
- FAnchorEnd := false;
-end;
-{--------}
-procedure TO32RegexEngine.rcDumpTable;
-var
- i, j : integer;
-begin
- writeln(Log);
- if (FTable.Count = 0) then
- writeln(Log, 'No transition table to dump!')
- else begin
- writeln(Log, 'Transition table dump for "', FRegexStr, '"');
- if FAnchorStart then
- writeln(Log, 'anchored at start of string');
- if FAnchorEnd then
- writeln(Log, 'anchored at end of string');
- writeln(Log, 'start state: ', FStartState:3);
- for i := 0 to pred(FTable.Count) do begin
- write(Log, i:3);
- with PO32NFAState(FTable[i])^ do begin
- case sdMatchType of
- mtNone : write(Log, ' no match');
- mtAnyChar : write(Log, ' any char');
- mtChar : write(Log, ' char:', sdChar);
- mtClass : write(Log, ' class');
- mtNegClass: write(Log, ' neg class');
- mtTerminal: write(Log, '*******END');
- mtUnused : write(Log, ' --');
- else
- write(Log, ' **error**');
- end;
- if (sdNextList <> nil) then begin
- write(Log, ' next:');
- for j := 0 to pred(sdNextList.Count) do
- write(Log, ' ', sdNextList[j]);
- end
- else begin
- if (sdMatchType <> mtTerminal) and
- (sdMatchType <> mtUnused) then begin
- write(Log, ' next1: ', sdNextState1:3);
- if (sdNextState2 <> UnusedState) then
- write(Log, ' next2: ', sdNextState2:3);
- end;
- end;
- end;
- writeln(Log);
- end;
- end;
-end;
-{--------}
-procedure TO32RegexEngine.rcLevel1Optimize;
-var
- i : integer;
- Walker : PO32NFAState;
-begin
- {level 1 optimization removes all states that have only a single
- no-cost move to another state}
-
- {cycle through all the state records, except for the last one}
- for i := 0 to (FTable.Count - 2) do begin
- {get this state}
- with PO32NFAState(FTable.List^[i])^ do begin
- {walk the chain pointed to by the first next state, unlinking
- the states that are simple single no-cost moves}
- Walker := PO32NFAState(FTable.List^[sdNextState1]);
- while (Walker^.sdMatchType = mtNone) and
- (Walker^.sdNextState2 = UnusedState) do begin
- sdNextState1 := Walker^.sdNextState1;
- Walker := PO32NFAState(FTable.List^[sdNextState1]);
- end;
- {walk the chain pointed to by the first next state, unlinking
- the states that are simple single no-cost moves}
- if (sdNextState2 <> UnusedState) then begin
- Walker := PO32NFAState(FTable.List^[sdNextState2]);
- while (Walker^.sdMatchType = mtNone) and
- (Walker^.sdNextState2 = UnusedState) do begin
- sdNextState2 := Walker^.sdNextState1;
- Walker := PO32NFAState(FTable.List^[sdNextState2]);
- end;
- end;
- end;
- end;
-end;
-{--------}
-procedure TO32RegexEngine.rcLevel2Optimize;
-var
- i : integer;
-begin
- {level 2 optimization removes all no-cost moves, except for those
- from the start state, if that is a no-cost move state}
-
- {cycle through all the state records, except for the last one}
- for i := 0 to (FTable.Count - 2) do begin
- {get this state}
- with PO32NFAState(FTable.List^[i])^ do begin
- {if it's not a no-cost move state or it's the start state...}
- if (sdMatchType <> mtNone) or (i = FStartState) then begin
- {create the state list}
- sdNextList := TO32IntList.Create;
- {walk the chain pointed to by the first next state, adding
- the non-no-cost states to the list}
- rcWalkNoCostTree(sdNextList, sdNextState1);
- {if this is the start state, and it's a no-cost move state
- walk the chain pointed to by the second next state, adding
- the non-no-cost states to the list}
- if (sdMatchType = mtNone) then
- rcWalkNoCostTree(sdNextList, sdNextState2);
- end;
- end;
- end;
-
- {cycle through all the state records, except for the last one,
- marking unused ones--not strictly necessary but good for debugging}
- for i := 0 to (FTable.Count - 2) do begin
- if (i <> FStartState) then
- with PO32NFAState(FTable.List^[i])^ do begin
- if (sdMatchType = mtNone) then
- sdMatchType := mtUnused;
- end;
- end;
-end;
-{--------}
-function TO32RegexEngine.rcMatchSubString(const S : string;
- StartPosn : integer)
- : boolean;
-var
- i : integer;
- Ch : char;
- State : integer;
- Deque : TO32IntDeque;
- StrInx : integer;
-begin
- {assume we fail to match}
- Result := false;
- {create the deque}
- Deque := TO32IntDeque.Create(64);
- try
- {enqueue the special value to start scanning}
- Deque.Enqueue(MustScan);
- {enqueue the first state}
- Deque.Enqueue(FStartState);
- {prepare the string index}
- StrInx := StartPosn - 1;
- Ch := #0; //just to fool the engine
- {loop until the deque is empty or we run out of string}
- while (StrInx <= length(S)) and not Deque.IsEmpty do begin
- {pop the top state from the deque}
- State := Deque.Pop;
- {process the "must scan" state first}
- if (State = MustScan) then begin
- {if the deque is empty at this point, we might as well give up
- since there are no states left to process new characters}
- if not Deque.IsEmpty then begin
- {if we haven't run out of string, get the character, and
- enqueue the "must scan" state again}
- inc(StrInx);
- if (StrInx <= length(S)) then begin
- if IgnoreCase then
- Ch := Upcase(S[StrInx])
- else
- Ch := S[StrInx];
- Deque.Enqueue(MustScan);
- end;
- end;
- end
- {otherwise, process the state}
- else with PO32NFAState(FTable.List^[State])^ do begin
- case sdMatchType of
- mtNone :
- begin
- if (State <> FStartState) then
- Assert(false, 'no-cost states shouldn''t be seen');
- for i := 0 to pred(sdNextList.Count) do
- Deque.Push(sdNextList[i]);
- end;
- mtAnyChar :
- begin
- {for a match of any character, enqueue the next states}
- for i := 0 to pred(sdNextList.Count) do
- Deque.Enqueue(sdNextList[i]);
- end;
- mtChar :
- begin
- {for a match of a character, enqueue the next states}
- if (Ch = sdChar) then
- for i := 0 to pred(sdNextList.Count) do
- Deque.Enqueue(sdNextList[i]);
- end;
- mtClass :
- begin
- {for a match within a class, enqueue the next states}
- if (Ch in sdClass^) then
- for i := 0 to pred(sdNextList.Count) do
- Deque.Enqueue(sdNextList[i]);
- end;
- mtNegClass :
- begin
- {for a match not within a class, enqueue the next states}
- if not (Ch in sdClass^) then
- for i := 0 to pred(sdNextList.Count) do
- Deque.Enqueue(sdNextList[i]);
- end;
- mtTerminal :
- begin
- {for a terminal state, the string successfully matched
- if the regex had no end anchor, or we're at the end
- of the string}
- if (not FAnchorEnd) or (StrInx > length(S)) then begin
- Result := true;
- Exit;
- end;
- end;
- mtUnused :
- begin
- Assert(false, 'unused state ' + IntToStr(State)
- + ' shouldn''t be seen');
- end;
- end;
- end;
- end;
- {if we reach this point we've either exhausted the deque or we've
- run out of string; if the former, the substring did not match
- since there are no more states. If the latter, we need to check
- the states left on the deque to see if one is the terminating
- state; if so the string matched the regular expression defined by
- the transition table}
- while not Deque.IsEmpty do begin
- State := Deque.Pop;
- with PO32NFAState(FTable.List^[State])^ do begin
- case sdMatchType of
- mtTerminal :
- begin
- {for a terminal state, the string successfully matched
- if the regex had no end anchor, or we're at the end
- of the string}
- if (not FAnchorEnd) or (StrInx > length(S)) then begin
- Result := true;
- Exit;
- end;
- end;
- end;{case}
- end;
- end;
- finally
- Deque.Free;
- end;
-end;
-{--------}
-function TO32RegexEngine.rcParseAnchorExpr : integer;
-begin
- {check for an initial '^'}
- if (FPosn^ = '^') then begin
- FAnchorStart := true;
- inc(FPosn);
-
- if FLogging then writeln(Log, 'parsed start anchor');
-
- end;
-
- {parse an expression}
- Result := rcParseExpr;
-
- {if we were successful, check for the final '$'}
- if (Result <> ErrorState) then begin
- if (FPosn^ = '$') then begin
- FAnchorEnd := true;
- inc(FPosn);
-
- if FLogging then writeln(Log, 'parsed end anchor');
- end;
- end;
-end;
-{--------}
-function TO32RegexEngine.rcParseAtom : integer;
-var
- MatchType : TO32NFAMatchType;
- CharClass : PO32CharSet;
-begin
- case FPosn^ of
- '(' :
- begin
- {move past the open parenthesis}
- inc(FPosn);
-
- if FLogging then writeln(Log, 'parsed open paren');
-
- {parse a complete regex between the parentheses}
- Result := rcParseExpr;
- if (Result = ErrorState) then
- Exit;
- {if the current character is not a close parenthesis,
- there's an error}
- if (FPosn^ <> ')') then begin
- FErrorCode := recNoCloseParen;
- Result := ErrorState;
- Exit;
- end;
- {move past the close parenthesis}
- inc(FPosn);
-
- if FLogging then writeln(Log, 'parsed close paren');
- end;
- '[' :
- begin
- {move past the open square bracket}
- inc(FPosn);
-
- if Logging then
- writeln(Log, 'parsed open square bracket (start of class)');
-
- {if the first character in the class is a '^' then the
- class if negated, otherwise it's a normal one}
- if (FPosn^ = '^') then begin
- inc(FPosn);
- MatchType := mtNegClass;
-
- if FLogging then writeln(Log, 'it is a negated class');
- end
- else begin
- MatchType := mtClass;
-
- if FLogging then writeln(Log, 'it is a normal class');
- end;
- {allocate the class character set and parse the character
- class; this will return either with an error, or when the
- closing square bracket is encountered}
- New(CharClass);
- CharClass^ := [];
- if not rcParseCharClass(CharClass) then begin
- Dispose(CharClass);
- Result := ErrorState;
- Exit;
- end;
- {move past the closing square bracket}
- Assert(FPosn^ = ']',
- 'the rcParseCharClass terminated without finding a "]"');
- inc(FPosn);
-
- if Logging then
- writeln(Log, 'parsed close square bracket (end of class)');
-
- {add a new state for the character class}
- Result := rcAddState(MatchType, #0, CharClass,
- NewFinalState, UnusedState);
- end;
- '.' :
- begin
- {move past the period metacharacter}
- inc(FPosn);
-
- if FLogging then writeln(Log, 'parsed anychar operator "."');
-
- {add a new state for the 'any character' token}
- Result := rcAddState(mtAnyChar, #0, nil,
- NewFinalState, UnusedState);
- end;
- else
- {otherwise parse a single character}
- Result := rcParseChar;
- end;{case}
-end;
-{--------}
-function TO32RegexEngine.rcParseCCChar : char;
-begin
- {if we hit the end of the string, it's an error}
- if (FPosn^ = #0) then begin
- FErrorCode := recSuddenEnd;
- Result := #0;
- Exit;
- end;
- {if the current char is a metacharacter (at least in terms of a
- character class), it's an error}
- if FPosn^ in [']', '-'] then begin
- FErrorCode := recMetaChar;
- Result := #0;
- Exit;
- end;
- {otherwise return the character and advance past it}
- if (FPosn^ = '\') then
- {..it's an escaped character: get the next character instead}
- inc(FPosn);
- Result := FPosn^;
- inc(FPosn);
-
- if FLogging then writeln(Log, 'parsed charclass char: "', Result, '"');
-
-end;
-{--------}
-function TO32RegexEngine.rcParseChar : integer;
-var
- Ch : char;
-begin
- {if we hit the end of the string, it's an error}
- if (FPosn^ = #0) then begin
- Result := ErrorState;
- FErrorCode := recSuddenEnd;
- Exit;
- end;
- {if the current char is one of the metacharacters, it's an error}
- if FPosn^ in MetaCharacters then begin
- Result := ErrorState;
- FErrorCode := recMetaChar;
- Exit;
- end;
- {otherwise add a state for the character}
- {..if it's an escaped character: get the next character instead}
- if (FPosn^ = '\') then
- inc(FPosn);
- if IgnoreCase then
- Ch := Upcase(FPosn^)
- else
- Ch := FPosn^;
- Result := rcAddState(mtChar, Ch, nil, NewFinalState, UnusedState);
- inc(FPosn);
-
- if FLogging then writeln(Log, 'parsed char: "', Ch, '"');
-end;
-{--------}
-function TO32RegexEngine.rcParseCharClass(aClass : PO32CharSet) : boolean;
-begin
- {assume we can't parse a character class properly}
- Result := false;
- {parse a character range; if we can't there was an error and the
- caller will take care of it}
- if not rcParseCharRange(aClass) then
- Exit;
- {if the current character was not the right bracket, parse another
- character class (note: we're removing the tail recursion here)}
- while (FPosn^ <> ']') do begin
- if not rcParseCharRange(aClass) then
- Exit;
- end;
- {if we reach here we were successful}
- Result := true;
-end;
-{--------}
-function TO32RegexEngine.rcParseCharRange(aClass : PO32CharSet) : boolean;
-var
- StartChar : char;
- EndChar : char;
- Ch : char;
-begin
- {assume we can't parse a character range properly}
- Result := false;
- {parse a single character; if it's null there was an error}
- StartChar := rcParseCCChar;
- if (StartChar = #0) then
- Exit;
- {if the current character is not a dash, the range consisted of a
- single character}
- if (FPosn^ <> '-') then begin
- if IgnoreCase then
- Include(aClass^, Upcase(StartChar))
- else
- Include(aClass^, StartChar)
- end
- {otherwise it's a real range, so get the character at the end of the
- range; if that's null, there was an error}
- else begin
-
- if FLogging then writeln(Log, '-range to-');
-
- inc(FPosn); {move past the '-'}
- EndChar := rcParseCCChar;
- if (EndChar = #0) then
- Exit;
- {build the range as a character set}
- if (StartChar > EndChar) then begin
- Ch := StartChar;
- StartChar := EndChar;
- EndChar := Ch;
- end;
- for Ch := StartChar to EndChar do begin
- Include(aClass^, Ch);
- if IgnoreCase then
- Include(aClass^, Upcase(Ch));
- end;
- end;
- {if we reach here we were successful}
- Result := true;
-end;
-{--------}
-function TO32RegexEngine.rcParseExpr : integer;
-var
- StartState1 : integer;
- StartState2 : integer;
- EndState1 : integer;
- OverallStartState : integer;
-begin
- {assume the worst}
- Result := ErrorState;
- {parse an initial term}
- StartState1 := rcParseTerm;
- if (StartState1 = ErrorState) then
- Exit;
- {if the current character is *not* a pipe character, no alternation
- is present so return the start state of the initial term as our
- start state}
- if (FPosn^ <> '|') then
- Result := StartState1
- {otherwise, we need to parse another expr and join the two together
- in the transition table}
- else begin
-
- if FLogging then writeln(Log, 'OR (alternation)');
-
- {advance past the pipe}
- inc(FPosn);
- {the initial term's end state does not exist yet (although there
- is a state in the term that points to it), so create it}
- EndState1 := rcAddState(mtNone, #0, nil, UnusedState, UnusedState);
- {for the OR construction we need a new initial state: it will
- point to the initial term and the second just-about-to-be-parsed
- expr}
- OverallStartState := rcAddState(mtNone, #0, nil,
- UnusedState, UnusedState);
- {parse another expr}
- StartState2 := rcParseExpr;
- if (StartState2 = ErrorState) then
- Exit;
- {alter the state state for the overall expr so that the second
- link points to the start of the second expr}
- Result := rcSetState(OverallStartState, StartState1, StartState2);
- {now set the end state for the initial term to point to the final
- end state for the second expr and the overall expr}
- rcSetState(EndState1, FTable.Count, UnusedState);
- end;
-end;
-{--------}
-function TO32RegexEngine.rcParseFactor : integer;
-var
- StartStateAtom : integer;
- EndStateAtom : integer;
-begin
- {assume the worst}
- Result := ErrorState;
- {first parse an atom}
- StartStateAtom := rcParseAtom;
- if (StartStateAtom = ErrorState) then
- Exit;
- {check for a closure operator}
- case FPosn^ of
- '?' : begin
- if FLogging then writeln(Log, 'zero or one closure');
-
- {move past the ? operator}
- inc(FPosn);
- {the atom's end state doesn't exist yet, so create one}
- EndStateAtom := rcAddState(mtNone, #0, nil,
- UnusedState, UnusedState);
- {create a new start state for the overall regex}
- Result := rcAddState(mtNone, #0, nil,
- StartStateAtom, EndStateAtom);
- {make sure the new end state points to the next unused
- state}
- rcSetState(EndStateAtom, FTable.Count, UnusedState);
- end;
- '*' : begin
- if FLogging then writeln(Log, 'zero or more closure');
-
- {move past the * operator}
- inc(FPosn);
- {the atom's end state doesn't exist yet, so create one;
- it'll be the start of the overall regex subexpression}
- Result := rcAddState(mtNone, #0, nil,
- NewFinalState, StartStateAtom);
- end;
- '+' : begin
- if FLogging then writeln(Log, 'one or more closure');
-
- {move past the + operator}
- inc(FPosn);
- {the atom's end state doesn't exist yet, so create one}
- rcAddState(mtNone, #0, nil, NewFinalState, StartStateAtom);
- {the start of the overall regex subexpression will be the
- atom's start state}
- Result := StartStateAtom;
- end;
- else
- Result := StartStateAtom;
- end;{case}
-end;
-{--------}
-function TO32RegexEngine.rcParseTerm : integer;
-var
- StartState2 : integer;
- EndState1 : integer;
-begin
- {parse an initial factor, the state number returned will also be our
- return state number}
- Result := rcParseFactor;
- if (Result = ErrorState) then
- Exit;
- {Note: we have to "break the grammar" here. We've parsed a regular
- subexpression and we're possibly following on with another
- regular subexpression. There's no nice operator to key off
- for concatenation: we just have to know that for
- concatenating two subexpressions, the current character will
- be
- - an open parenthesis
- - an open square bracket
- - an any char operator
- - a character that's not a metacharacter
- i.e., the three possibilities for the start of an "atom" in
- our grammar}
- if (FPosn^ = '(') or
- (FPosn^ = '[') or
- (FPosn^ = '.') or
- ((FPosn^ <> #0) and not (FPosn^ in MetaCharacters)) then begin
- if FLogging then writeln(Log, 'concatenation');
-
- {the initial factor's end state does not exist yet (although there
- is a state in the term that points to it), so create it}
- EndState1 := rcAddState(mtNone, #0, nil, UnusedState, UnusedState);
- {parse another term}
- StartState2 := rcParseTerm;
- if (StartState2 = ErrorState) then begin
- Result := ErrorState;
- Exit;
- end;
- {join the first factor to the second term}
- rcSetState(EndState1, StartState2, UnusedState);
- end;
-end;
-{--------}
-procedure TO32RegexEngine.rcSetIgnoreCase(aValue : boolean);
-begin
- if (aValue <> FIgnoreCase) then begin
- rcClear;
- FIgnoreCase := aValue;
- end;
-end;
-{--------}
-procedure TO32RegexEngine.rcSetRegexStr(const aRegexStr : string);
-begin
- if (aRegexStr <> FRegexStr) then begin
- rcClear;
- FRegexStr := aRegexStr;
- end;
-end;
-{--------}
-function TO32RegexEngine.rcSetState(aState : integer;
- aNextState1: integer;
- aNextState2: integer) : integer;
-var
- StateData : PO32NFAState;
-begin
- Assert((0 <= aState) and (aState < FTable.Count),
- 'trying to change an invalid state');
-
- {get the state record and change the transition information}
- StateData := PO32NFAState(FTable.List^[aState]);
- StateData^.sdNextState1 := aNextState1;
- StateData^.sdNextState2 := aNextState2;
- Result := aState;
-end;
-{--------}
-procedure TO32RegexEngine.rcSetUpcase(aValue : TO32UpcaseChar);
-begin
- if not Assigned(aValue) then
- FUpcase := System.Upcase
- else
- FUpcase := aValue;
-end;
-{--------}
-procedure TO32RegexEngine.rcWalkNoCostTree(aList : TO32IntList;
- aState : integer);
-begin
- {look at this state's record...}
- with PO32NFAState(FTable.List^[aState])^ do begin
- {if it's a no-cost state, recursively walk the
- first, then the second chain}
- if (sdMatchType = mtNone) then begin
- rcWalkNoCostTree(aList, sdNextState1);
- rcWalkNoCostTree(aList, sdNextState2);
- end
- {otherwise, add it to the list}
- else
- aList.Add(aState);
- end;
-end;
-{----}
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/62/62ed3a66bfc1268c472014948acb4b118a4be15a.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/62/62ed3a66bfc1268c472014948acb4b118a4be15a.svn-base
deleted file mode 100644
index b5aee615..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/62/62ed3a66bfc1268c472014948acb4b118a4be15a.svn-base
+++ /dev/null
@@ -1,108 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/66/6654a4bac9c4abd73c22e2cdcf0b76e91ede9209.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/66/6654a4bac9c4abd73c22e2cdcf0b76e91ede9209.svn-base
deleted file mode 100644
index 2c6a0569..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/66/6654a4bac9c4abd73c22e2cdcf0b76e91ede9209.svn-base
+++ /dev/null
@@ -1,6411 +0,0 @@
-{*********************************************************}
-{* OVCTABLE.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 ***** *}
-
-(*Changes)
-
- 10/20/01- Hdc changed to TOvcHdc for BCB Compatibility
-*)
-
-{$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 ovctable;
- {Orpheus table definitions}
-
-interface
-
-uses
- SysUtils, Classes,
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Graphics, Controls, Forms, StdCtrls,
- Menus, Dialogs, OvcMisc, OvcData, OvcConst, OvcBase, OvcCmd, OvcTCmmn,
- OvcTCAry, OvcTSelL, OvcTCell, OvcTCHdr, OvcTGPns,
- OvcTbClr, OvcTbRws, OvcTbCls, OvcDrag;
-
-type
- TOvcCustomTable = class(TOvcTableAncestor)
- {-The custom class for tables}
- protected {private}
- {property fields - even size}
- FActiveCol : TColNum; {column of active cell}
- FActiveRow : TRowNum; {row of active cell}
- FBlockColBegin : TColNum; {start column for settings}
- FBlockColEnd : TColNum; {end column for settings}
- FBlockRowBegin : TRowNum; {start row for settings}
- FBlockRowEnd : TRowNum; {end row for settings}
- FCells : TOvcTableCells; {independent cells}
- FColors : TOvcTableColors; {table cell colors}
- FCols : TOvcTableColumns; {table column definitions}
- FGridPenSet : TOvcGridPenSet; {set of grid pens}
- FLeftCol : TColNum; {leftmost column}
- FLockedCols : TColNum; {number of locked columns}
- FLockedRows : TRowNum; {number of locked rows}
- FLockedRowsCell : TOvcBaseTableCell; {cell for column headings}
- FRows : TOvcTableRows; {table row definitions}
- FSelAnchorCol : TColNum; {selection: anchor column}
- FSelAnchorRow : TRowNum; {selection: anchor row}
- FTopRow : TRowNum; {topmost row}
- FColorUnused : TColor; {color of unused area}
- FOldRowColBehavior: Boolean;
-
- {property fields - odd size}
- FAccess : TOvcTblAccess; {default access mode for the table}
- FAdjust : TOvcTblAdjust; {default adjustment for the table}
- FBorderStyle : TBorderStyle; {border type around table}
- FOptions : TOvcTblOptionSet; {set of table options}
- FScrollBars : TScrollStyle; {scroll bar presence}
- Filler : byte;
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
-
- {property event fields}
- FActiveCellChanged : TCellNotifyEvent; {active cell changed event}
- FActiveCellMoving : TCellMoveNotifyEvent; {active cell moving event}
- FBeginEdit : TCellBeginEditNotifyEvent;{active cell about to be edited}
- FClipboardCopy : TNotifyEvent; {copy to clipboard requested}
- FClipboardCut : TNotifyEvent; {cut to clipboard requested}
- FClipboardPaste : TNotifyEvent; {paste from clipboard requested}
- FColumnsChanged : TColChangeNotifyEvent; {column insert/delete/exchange}
- FDoneEdit : TCellNotifyEvent; {active cell has been edited}
- FEndEdit : TCellEndEditNotifyEvent;{active cell about to be stopped being edited}
- FEnteringColumn : TColNotifyEvent; {entering column event}
- FEnteringRow : TRowNotifyEvent; {entering row event}
- FGetCellData : TCellDataNotifyEvent; {get cell data event}
- FGetCellAttributes : TCellAttrNotifyEvent; {get cell attributes event}
- FLeavingColumn : TColNotifyEvent; {leaving column event}
- FLeavingRow : TRowNotifyEvent; {leaving row event}
- FLockedCellClick : TCellNotifyEvent; {locked cell clicked event}
- FPaintUnusedArea : TNotifyEvent; {unused bit needs painting event}
- FRowsChanged : TRowChangeNotifyEvent; {row insert/delete/exchange}
- FSizeCellEditor : TSizeCellEditorNotifyEvent;{sizing of cell editor}
- FTopLeftCellChanged : TCellNotifyEvent; {top left cell change event}
- FTopLeftCellChanging: TCellChangeNotifyEvent; {top left cell moving event}
- FUserCommand : TUserCommandEvent; {user command event}
- FOnResizeColumn : TColResizeEvent;
- FOnResizeRow : TRowResizeEvent;
-
- {other fields - even size}
- tbColNums : POvcTblDisplayArray; {displayed column numbers}
- tbRowNums : POvcTblDisplayArray; {displayed row numbers}
- tbRowsOnLastPage : TRowNum; {number of complete rows on last page}
- tbLastTopRow : TRowNum; {the last row number that can be top}
- tbColsOnLastPage : TColNum; {num of complete columns on rightmost page}
- tbLastLeftCol : TColNum; {the last column number that can be leftmost}
- tbLockCount : integer; {the lock display count}
- tbCmdTable : PString; {the command table name for the grid}
- tbState : TOvcTblStates; {the state of the table}
- tbSizeOffset : integer; {the offset of the sizing line}
- tbSizeIndex : integer; {the index of the sized row/col}
- tbMoveIndex : integer; {the index of the column being moved}
- tbMoveIndexTo : integer; {the index of the column being targeted by move}
- tbLastEntRow : TRowNum; {last row that was entered}
- tbLastEntCol : TColNum; {last column that was entered}
- tbActCell : TOvcBaseTableCell; {the active cell object}
- tbInvCells : TOvcCellArray; {cells that need repainting}
- tbSelList : TOvcSelectionList; {list of selected cells}
- tbCellAttrFont : TFont; {cached font for painting cells}
- tbColMoveCursor : HCursor; {cursor for column moves}
- tbRowMoveCursor : HCursor; {cursor for row moves}
- tbHSBarPosCount : integer; {number of positions for horz scrollbar}
- tbDrag : TOvcDragShow;
-
- {other fields - odd size}
- tbHasHSBar : boolean; {true if horiz scroll bar present}
- tbHasVSBar : boolean; {true if vert scroll bar present}
- tbUpdateSBs : boolean; {true if the scroll bars must be updated}
- tbIsSelecting : boolean; {is in mouse selection mode}
- tbIsDeselecting : boolean; {is in mouse deselection mode}
- tbIsKeySelecting : boolean; {is in key selection mode}
- tbMustUpdate : boolean; {scrolling has left an invalid region}
- tbMustFinishLoading : boolean; {finish loading data in CreateWnd}
- ProcessingVScrollMessage: Boolean;{Internal flag}
-
- protected
- {property read routines}
- function GetAllowRedraw : boolean;
- function GetColCount : TColNum;
- function GetColOffset(ColNum : TColNum) : integer;
- function GetRowLimit : TRowNum;
- function GetRowOffset(RowNum : TRowNum) : integer;
-
- {property write routines}
- procedure SetAccess(A : TOvcTblAccess);
- procedure SetActiveCol(ColNum : TColNum);
- procedure SetActiveRow(RowNum : TRowNum);
- procedure SetAdjust(A : TOvcTblAdjust);
- procedure SetAllowRedraw(AR : boolean);
- procedure SetBorderStyle(const BS : TBorderStyle);
- procedure SetBlockAccess(A : TOvcTblAccess);
- procedure SetBlockAdjust(A : TOvcTblAdjust);
- procedure SetBlockCell(C : TOvcBaseTableCell);
- procedure SetBlockColBegin(ColNum : TColNum);
- procedure SetBlockColEnd(ColNum : TColNum);
- procedure SetBlockColor(C : TColor);
- procedure SetBlockFont(F : TFont);
- procedure SetBlockRowBegin(RowNum : TRowNum);
- procedure SetBlockRowEnd(RowNum : TRowNum);
- procedure SetColors(C : TOvcTableColors);
- procedure SetColCount(CC : integer);
- procedure SetCols(CS : TOvcTableColumns);
- procedure SetLeftCol(ColNum : TColNum);
- procedure SetLockedCols(ColNum : TColNum);
- procedure SetLockedRows(RowNum : TRowNum);
- procedure SetLockedRowsCell(C : TOvcBaseTableCell);
- procedure SetOptions(O : TOvcTblOptionSet);
- procedure SetPaintUnusedArea(PUA : TNotifyEvent);
- procedure SetRowLimit(RowNum : TRowNum);
- procedure SetRows(RS : TOvcTableRows);
- procedure SetScrollBars(const SB : TScrollStyle);
- procedure SetTopRow(RowNum : TRowNum);
- procedure SetColorUnused(CU : TColor);
-
- {overridden Delphi VCL methods}
- procedure ChangeScale(M, D : integer); override;
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
-
- {general methods}
- function tbCalcActiveCellRect(var ACR : TRect) : boolean;
- function tbCalcCellsFromRect(const UR : TRect; var GR : TRect) : integer;
- procedure tbCalcColData(var CD : POvcTblDisplayArray; NewLeftCol : TColNum);
- procedure tbCalcColsOnLastPage;
- procedure tbCalcHSBarPosCount;
- function tbCalcRequiresVSBar : boolean;
- procedure tbCalcRowData(var RD : POvcTblDisplayArray; NewTopRow : TRowNum);
- procedure tbCalcRowsOnLastPage;
-
- procedure tbDrawActiveCell;
- procedure tbDrawCells(RowInxStart, RowInxEnd : integer;
- ColInxStart, ColInxEnd : integer);
- procedure tbDrawInvalidCells(InvCells : TOvcCellArray);
- procedure tbDrawMoveLine;
- procedure tbDrawRow(RowInx : integer; ColInxStart, ColInxEnd : integer);
- procedure tbDrawSizeLine;
- procedure tbDrawUnusedBit;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
- function tbEditCellHasFocus(FocusHandle : TOvcHWnd{HWND}) : boolean;
-
- procedure tbEnsureColumnIsVisible(ColNum : TColNum);
- procedure tbEnsureRowIsVisible(RowNum : TRowNum);
-
- function tbFindCell(RowNum : TRowNum;
- ColNum : TColNum) : TOvcBaseTableCell;
- function tbFindColInx(ColNum : TColNum) : integer;
- function tbFindRowInx(RowNum : TRowNum) : integer;
-
- function tbIsOnGridLine(MouseX, MouseY : integer;
- var VerticalGrid : boolean) : boolean;
- function tbIsInMoveArea(MouseX, MouseY : integer;
- var IsColMove : boolean) : boolean;
- procedure tbSetActiveCellWithSel(RowNum : TRowNum;
- ColNum : TColNum);
- procedure tbSetActiveCellPrim(RowNum : TRowNum; ColNum : TColNum);
-
- {selection methods}
- procedure tbDeselectAll(CA : TOvcCellArray);
- function tbDeselectAllIterator(RowNum1 : TRowNum; ColNum1 : TColNum;
- RowNum2 : TRowNum; ColNum2 : TColNum;
- ExtraData : pointer) : boolean;
- procedure tbSelectCol(ColNum : TColNum);
- procedure tbSelectRow(RowNum : TRowNum);
- procedure tbSelectTable;
- procedure tbSetAnchorCell(RowNum : TRowNum; ColNum : TColNum;
- Action : TOvcTblSelectionType);
- procedure tbUpdateSelection(RowNum : TRowNum; ColNum : TColNum;
- Action : TOvcTblSelectionType);
-
- {notification procedures}
- procedure DoActiveCellChanged(RowNum : TRowNum; ColNum : TColNum);
- virtual;
- procedure DoActiveCellMoving(Command : word; var RowNum : TRowNum;
- var ColNum : TColNum); virtual;
- procedure DoBeginEdit(RowNum : TRowNum; ColNum : TColNum;
- var AllowIt : boolean); virtual;
- procedure DoClipboardCopy; virtual;
- procedure DoClipboardCut; virtual;
- procedure DoClipboardPaste; virtual;
- procedure DoColumnsChanged(ColNum1, ColNum2 : TColNum;
- Action : TOvcTblActions); virtual;
- procedure DoDoneEdit(RowNum : TRowNum; ColNum : TColNum); virtual;
- procedure DoEndEdit(Cell : TOvcBaseTableCell;
- RowNum : TRowNum; ColNum : TColNum;
- var AllowIt : boolean); virtual;
- procedure DoEnteringColumn(ColNum : TColNum); virtual;
- procedure DoEnteringRow(RowNum : TRowNum); virtual;
- procedure DoGetCellAttributes(RowNum : TRowNum; ColNum : TColNum;
- var CellAttr : TOvcCellAttributes); virtual;
- procedure DoGetCellData(RowNum : TRowNum; ColNum : TColNum;
- var Data : pointer;
- Purpose : TOvcCellDataPurpose); virtual;
- procedure DoLeavingColumn(ColNum : TColNum); virtual;
- procedure DoLeavingRow(RowNum : TRowNum); virtual;
- procedure DoLockedCellClick(RowNum : TRowNum; ColNum : TColNum); virtual;
- procedure DoOnMouseWheel(Shift : TShiftState; Delta, XPos, YPos : SmallInt);
- override;
- procedure DoPaintUnusedArea; virtual;
- procedure DoRowsChanged(RowNum1, RowNum2 : TRowNum;
- Action : TOvcTblActions); virtual;
- procedure DoSizeCellEditor(RowNum : TRowNum;
- ColNum : TColNum;
- var CellRect : TRect;
- var CellStyle: TOvcTblEditorStyle); virtual;
- procedure DoTopLeftCellChanged(RowNum : TRowNum; ColNum : TColNum); virtual;
- procedure DoTopLeftCellChanging(var RowNum : TRowNum;
- var ColNum : TColNum); virtual;
- procedure DoUserCommand(Cmd : word); virtual;
-
- {row/col data retrieval}
- function tbIsColHidden(ColNum : TColNum) : boolean;
- function tbIsRowHidden(RowNum : TRowNum) : boolean;
- procedure tbQueryColData(ColNum : TColNum;
- var W : integer;
- var A : TOvcTblAccess;
- var H : boolean);
- procedure tbQueryRowData(RowNum : TRowNum;
- var Ht: integer;
- var H : boolean);
-
- {invalidation}
- procedure tbInvalidateColHdgPrim(ColNum : TColNum; InvCells : TOvcCellArray);
- procedure tbInvalidateRowHdgPrim(RowNum : TRowNum; InvCells : TOvcCellArray);
-
- {scrollbar stuff}
- procedure tbSetScrollPos(SB : TOvcScrollBar);
- procedure tbSetScrollRange(SB : TOvcScrollBar);
-
- {active cell movement}
- procedure tbMoveActCellBotOfPage;
- procedure tbMoveActCellBotRight;
- procedure tbMoveActCellDown;
- procedure tbMoveActCellFirstCol;
- procedure tbMoveActCellFirstRow;
- procedure tbMoveActCellLastCol;
- procedure tbMoveActCellLastRow;
- procedure tbMoveActCellLeft;
- procedure tbMoveActCellPageDown;
- procedure tbMoveActCellPageLeft;
- procedure tbMoveActCellPageRight;
- procedure tbMoveActCellPageUp;
- procedure tbMoveActCellRight;
- procedure tbMoveActCellTopLeft;
- procedure tbMoveActCellTopOfPage;
- procedure tbMoveActCellUp;
-
- {scrollbar scrolling routine}
- procedure tbScrollBarDown;
- procedure tbScrollBarLeft;
- procedure tbScrollBarPageDown;
- procedure tbScrollBarPageLeft;
- procedure tbScrollBarPageRight;
- procedure tbScrollBarPageUp;
- procedure tbScrollBarRight;
- procedure tbScrollBarUp;
-
- {table scrolling routines}
- procedure tbScrollTableLeft(NewLeftCol : TColNum);
- procedure tbScrollTableRight(NewLeftCol : TColNum);
- procedure tbScrollTableUp(NewTopRow : TRowNum);
- procedure tbScrollTableDown(NewTopRow : TRowNum);
-
- {notifications}
- procedure tbCellChanged(Sender : TObject); override;
- procedure tbColChanged(Sender : TObject; ColNum1, ColNum2 : TColNum;
- Action : TOvcTblActions);
- procedure tbGridPenChanged(Sender : TObject);
- procedure tbRowChanged(Sender : TObject; RowNum1, RowNum2 : TRowNum;
- Action : TOvcTblActions);
- procedure tbColorsChanged(Sender : TObject);
-
- {streaming routines}
- procedure DefineProperties(Filer : TFiler); override;
- procedure tbFinishLoadingDefaultCells;
- procedure tbReadColData(Reader : TReader);
- procedure tbReadRowData(Reader : TReader);
- procedure tbWriteColData(Writer : TWriter);
- procedure tbWriteRowData(Writer : TWriter);
-
- {Cell-Table interaction messages}
- procedure ctimLoadDefaultCells(var Msg : TMessage); message ctim_LoadDefaultCells;
- procedure ctimQueryOptions(var Msg : TMessage); message ctim_QueryOptions;
- procedure ctimQueryColor(var Msg : TMessage); message ctim_QueryColor;
- procedure ctimQueryFont(var Msg : TMessage); message ctim_QueryFont;
- procedure ctimQueryLockedCols(var Msg : TMessage); message ctim_QueryLockedCols;
- procedure ctimQueryLockedRows(var Msg : TMessage); message ctim_QueryLockedRows;
- procedure ctimQueryActiveCol(var Msg : TMessage); message ctim_QueryActiveCol;
- procedure ctimQueryActiveRow(var Msg : TMessage); message ctim_QueryActiveRow;
- procedure ctimRemoveCell(var Msg : TMessage); message ctim_RemoveCell;
- procedure ctimStartEdit(var Msg : TMessage); message ctim_StartEdit;
- procedure ctimStartEditMouse(var Msg : TWMMouse); message ctim_StartEditMouse;
- procedure ctimStartEditKey(var Msg : TWMKey); message ctim_StartEditKey;
-
- {Delphi component messages}
- procedure CMColorChanged(var Msg : TMessage); message CM_COLORCHANGED;
-{$IFNDEF LCL}
- procedure CMCtl3DChanged(var Msg : TMessage); message CM_CTL3DCHANGED;
-{$ENDIF}
- procedure CMDesignHitTest(var Msg : TCMDesignHitTest); message CM_DESIGNHITTEST;
- procedure CMFontChanged(var Msg : TMessage); message CM_FONTCHANGED;
-
- {Windows messages}
- procedure WMCancelMode(var Msg : TMessage); message WM_CANCELMODE;
- procedure WMEraseBkGnd(var Msg : TWMEraseBkGnd); message WM_ERASEBKGND;
- procedure WMGetDlgCode(var Msg : TMessage); message WM_GETDLGCODE;
- procedure WMHScroll(var Msg : TWMScroll); message WM_HSCROLL;
- procedure WMKeyDown(var Msg : TWMKey); message WM_KEYDOWN;
- procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS;
- procedure WMLButtonDblClk(var Msg : TWMMouse); message WM_LBUTTONDBLCLK;
- procedure WMLButtonDown(var Msg : TWMMouse); message WM_LBUTTONDOWN;
- procedure WMLButtonUp(var Msg : TWMMouse); message WM_LBUTTONUP;
- procedure WMMouseMove(var Msg : TWMMouse); message WM_MOUSEMOVE;
- procedure WMNCHitTest(var Msg : TMessage); message WM_NCHITTEST;
- procedure WMSetCursor(var Msg : TWMSetCursor); message WM_SETCURSOR;
- procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
- procedure WMVScroll(var Msg : TWMScroll); message WM_VSCROLL;
-
- {unpublishable or should not be published properties}
- property AllowRedraw : boolean
- read GetAllowRedraw write SetAllowRedraw
- stored false;
-
- property BlockAccess : TOvcTblAccess
- write SetBlockAccess;
-
- property BlockAdjust : TOvcTblAdjust
- write SetBlockAdjust;
-
- property BlockColBegin : TColNum
- read FBlockColBegin write SetBlockColBegin;
-
- property BlockColEnd : TColNum
- read FBlockColEnd write SetBlockColEnd;
-
- property BlockColor : TColor
- write SetBlockColor;
-
- property BlockCell : TOvcBaseTableCell
- write SetBlockCell;
-
- property BlockFont : TFont
- write SetBlockFont;
-
- property BlockRowBegin : TRowNum
- read FBlockRowBegin write SetBlockRowBegin;
-
- property BlockRowEnd : TRowNum
- read FBlockRowEnd write SetBlockRowEnd;
-
- property ColOffset [ColNum : TColNum] : integer
- read GetColOffset;
-
- property RowOffset [RowNum : TRowNum] : integer
- read GetRowOffset;
-
- property TableState : TOvcTblStates
- read tbState;
-
- {publishable properties}
- property Access : TOvcTblAccess
- read FAccess write SetAccess;
-
- property ActiveCol : TColNum
- read FActiveCol write SetActiveCol;
-
- property ActiveRow : TRowNum
- read FActiveRow write SetActiveRow;
-
- property Adjust : TOvcTblAdjust
- read FAdjust write SetAdjust;
-
- property BorderStyle : TBorderStyle
- read FBorderStyle write SetBorderStyle;
-
- property ColCount : TColNum
- read GetColCount write SetColCount;
-
- property Colors : TOvcTableColors
- read FColors write SetColors;
-
- property ColorUnused : TColor
- read FColorUnused write SetColorUnused;
-
- property Columns : TOvcTableColumns
- read FCols write SetCols;
-
- property GridPenSet : TOvcGridPenSet
- read FGridPenSet write FGridPenSet;
-
- property LeftCol : TColNum
- read FLeftCol write SetLeftCol;
-
- property LockedCols : TColNum
- read FLockedCols write SetLockedCols;
-
- property LockedRows : TRowNum
- read FLockedRows write SetLockedRows;
-
- property LockedRowsCell : TOvcBaseTableCell
- read FLockedRowsCell write SetLockedRowsCell;
-
- property OldRowColBehavior : Boolean
- read FOldRowColBehavior write FOldRowColBehavior;
-
- property Options : TOvcTblOptionSet
- read FOptions write SetOptions;
-
- property RowLimit : TRowNum
- read GetRowLimit write SetRowLimit;
-
- property Rows : TOvcTableRows
- read FRows write SetRows;
-
- property ScrollBars : TScrollStyle
- read FScrollBars write SetScrollBars;
-
- property TopRow : TRowNum
- read FTopRow write SetTopRow;
-
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D default True;
-{$ENDIF}
-
- {New events}
- property OnActiveCellChanged : TCellNotifyEvent
- read FActiveCellChanged write FActiveCellChanged;
-
- property OnActiveCellMoving : TCellMoveNotifyEvent
- read FActiveCellMoving write FActiveCellMoving;
-
- property OnBeginEdit : TCellBeginEditNotifyEvent
- read FBeginEdit write FBeginEdit;
-
- property OnClipboardCopy : TNotifyEvent
- read FClipboardCopy write FClipboardCopy;
-
- property OnClipboardCut : TNotifyEvent
- read FClipboardCut write FClipboardCut;
-
- property OnClipboardPaste : TNotifyEvent
- read FClipboardPaste write FClipboardPaste;
-
- property OnColumnsChanged : TColChangeNotifyEvent
- read FColumnsChanged write FColumnsChanged;
-
- property OnDoneEdit : TCellNotifyEvent
- read FDoneEdit write FDoneEdit;
-
- property OnEndEdit : TCellEndEditNotifyEvent
- read FEndEdit write FEndEdit;
-
- property OnEnteringColumn : TColNotifyEvent
- read FEnteringColumn write FEnteringColumn;
-
- property OnEnteringRow : TRowNotifyEvent
- read FEnteringRow write FEnteringRow;
-
- property OnGetCellData : TCellDataNotifyEvent
- read FGetCellData write FGetCellData;
-
- property OnGetCellAttributes : TCellAttrNotifyEvent
- read FGetCellAttributes write FGetCellAttributes;
-
- property OnLeavingColumn : TColNotifyEvent
- read FLeavingColumn write FLeavingColumn;
-
- property OnLeavingRow : TRowNotifyEvent
- read FLeavingRow write FLeavingRow;
-
- property OnLockedCellClick : TCellNotifyEvent
- read FLockedCellClick write FLockedCellClick;
-
- property OnPaintUnusedArea : TNotifyEvent
- read FPaintUnusedArea write SetPaintUnusedArea;
-
- property OnResizeColumn : TColResizeEvent
- read FOnResizeColumn write FOnResizeColumn;
-
- property OnResizeRow : TRowResizeEvent
- read FOnResizeRow write FOnResizeRow;
-
- property OnRowsChanged : TRowChangeNotifyEvent
- read FRowsChanged write FRowsChanged;
-
- property OnSizeCellEditor : TSizeCellEditorNotifyEvent
- read FSizeCellEditor write FSizeCellEditor;
-
- property OnTopLeftCellChanged : TCellNotifyEvent
- read FTopLeftCellChanged write FTopLeftCellChanged;
-
- property OnTopLeftCellChanging : TCellChangeNotifyEvent
- read FTopLeftCellChanging write FTopLeftCellChanging;
-
- property OnUserCommand : TUserCommandEvent
- read FUserCommand write FUserCommand;
-
- public
- {overridden methods}
- constructor Create(AOwner : TComponent); override;
- destructor Destroy; override;
- procedure CreateParams(var Params : TCreateParams); override;
- procedure CreateWnd; override;
- procedure Loaded; override;
- procedure Paint; override;
-{$IFNDEF LCL}
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
-{$ELSE}
- procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
-{$ENDIF}
-
- {new public methods}
- function CalcRowColFromXY(X, Y : integer;
- var RowNum : TRowNum;
- var ColNum : TColNum) : TOvcTblRegion;
- function FilterKey(var Msg : TWMKey) : TOvcTblKeyNeeds; override;
- procedure GetDisplayedColNums(var NA : TOvcTableNumberArray);
- procedure GetDisplayedRowNums(var NA : TOvcTableNumberArray);
- procedure ResolveCellAttributes(RowNum : TRowNum; ColNum : TColNum;
- var CellAttr : TOvcCellAttributes); override;
-
- {methods for setting cells, faster than setting row/col properties}
- procedure SetActiveCell(RowNum : TRowNum; ColNum : TColNum);
- procedure SetTopLeftCell(RowNum : TRowNum; ColNum : TColNum);
-
- {methods for calculating next/prev row/col numbers for main area}
- function IncCol(ColNum : TColNum; Direction : integer) : TColNum;
- function IncRow(RowNum : TRowNum; Direction : integer) : TRowNum;
-
- {methods for invalidating cells to force a redraw}
- procedure InvalidateCell(RowNum : TRowNum; ColNum : TColNum);
- procedure InvalidateColumn(ColNum : TColNum);
- procedure InvalidateRow(RowNum : TRowNum);
- procedure InvalidateTable;
- procedure InvalidateCellsInRect(const R : TRect);
- procedure InvalidateColumnHeading(ColNum : TColNum);
- procedure InvalidateRowHeading(RowNum : TRowNum);
- procedure InvalidateTableNotLockedCols;
- procedure InvalidateTableNotLockedRows;
-
- {selection methods}
- function HaveSelection : boolean;
- function InSelection(RowNum : TRowNum; ColNum : TColNum) : boolean;
- procedure IterateSelections(SI : TSelectionIterator; ExtraData : pointer);
-
- {editing state method}
- function InEditingState : boolean;
- function SaveEditedData : boolean;
- function StartEditingState : boolean;
- function StopEditingState(SaveValue : boolean) : boolean;
-
- {scrollbar scrolling routine}
- procedure ProcessScrollBarClick(ScrollBar : TOvcScrollBar;
- ScrollCode : TScrollCode); virtual;
-
- {active cell movement routine}
- procedure MoveActiveCell(Command : word); virtual;
-
- {public property}
- property Cells : TOvcTableCells
- read FCells;
-
-
- end;
-
- TOvcTable = class(TOvcCustomTable)
- public
- property AllowRedraw;
- property BlockAccess;
- property BlockAdjust;
- property BlockColBegin;
- property BlockColEnd;
- property BlockColor;
- property BlockCell;
- property BlockFont;
- property BlockRowBegin;
- property BlockRowEnd;
- property Canvas;
- property ColOffset;
- property RowOffset;
- property TableState;
- published
- {Properties}
- property LockedRows default 1;
- property TopRow default 1;
- property ActiveRow default 1;
- property RowLimit default 10;
-
- property LockedCols default 1;
- property LeftCol default 1;
- property ActiveCol default 1;
-
- property OldRowColBehavior default false;
-
- {$IFDEF VERSION4}
- property Anchors;
- property Constraints;
- property DragKind;
- {$ENDIF}
- property Access default otxNormal;
- property Adjust default otaCenterLeft;
- property Align;
- property BorderStyle default bsSingle;
- property ColCount stored False;
- property Color default tbDefTableColor;
- property ColorUnused default clWindow;
- property Colors;
- property Columns;
- property Controller;
- property Ctl3D;
- property DragCursor;
- property DragMode;
- property Enabled;
- property Font;
- property GridPenSet;
- property LockedRowsCell;
- property Options default [];
- property ParentColor default False;
-{$IFNDEF LCL}
- property ParentCtl3D;
-{$ENDIF}
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property Rows;
- property ScrollBars default ssBoth;
- property ShowHint;
- property TabOrder;
- property TabStop default True;
- property Visible;
-
- {Events}
- property OnActiveCellChanged;
- property OnActiveCellMoving;
- property OnBeginEdit;
- property OnClipboardCopy;
- property OnClipboardCut;
- property OnClipboardPaste;
- property OnColumnsChanged;
- property OnDblClick;
- property OnDoneEdit;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEndEdit;
- property OnEnter;
- property OnEnteringColumn;
- property OnEnteringRow;
- property OnExit;
- property OnGetCellData;
- property OnGetCellAttributes;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnLeavingColumn;
- property OnLeavingRow;
- property OnLockedCellClick;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnMouseWheel;
- property OnPaintUnusedArea;
- property OnResizeColumn;
- property OnResizeRow;
- property OnRowsChanged;
- property OnSizeCellEditor;
- property OnTopLeftCellChanged;
- property OnTopLeftCellChanging;
- property OnUserCommand;
- end;
-
-implementation
-{===== Local Routines ================================================}
-
-function NewString(const S: string): PString;
-begin
- New(Result);
- Result^ := S;
-end;
-
-procedure DisposeString(P: PString);
-begin
- if (P <> nil)
- and (P^ <> '') then
- Dispose(P);
-end;
-
-
-{===== TOvcTable creation and destruction ============================}
-
-constructor TOvcCustomTable.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
-
- ProcessingVScrollMessage := false;
-
- tbState := [otsNormal];
-
- if NewStyleControls then
- ControlStyle := ControlStyle + [csOpaque, csCaptureMouse, csDoubleClicks]
- else
- ControlStyle := ControlStyle + [csOpaque, csCaptureMouse, csDoubleClicks, csFramed];
-
- Height := tbDefHeight;
- Width := tbDefWidth;
- FColorUnused := clWindow;
-
- ParentColor := false;
- Color := tbDefTableColor;
- TabStop := true;
-
-
- FGridPenSet := TOvcGridPenSet.Create;
- FGridPenSet.OnCfgChanged := tbGridPenChanged;
-
- FColors := TOvcTableColors.Create;
- FColors.OnCfgChanged := tbColorsChanged;
-
- FCols := TOvcTableColumns.Create(Self, tbDefColCount, TOvcTableColumn);
- FCols.OnColumnChanged := tbColChanged;
- FCols.Table := Self;
-
- FCells := TOvcTableCells.Create(Self);
- FCells.OnCfgChanged := tbCellChanged;
- FCells.Table := Self;
- tbInvCells := TOvcCellArray.Create;
-
- FRows := TOvcTableRows.Create;
- RowLimit := tbDefRowCount;
- FRows.OnCfgChanged := tbRowChanged;
-
- FBorderStyle := tbDefBorderStyle;
- FScrollBars := tbDefScrollBars;
- FAccess := tbDefAccess;
- FAdjust := tbDefAdjust;
- tbCellAttrFont := TFont.Create;
-
- FActiveCol := tbDefLockedCols;
- FLockedCols := tbDefLockedCols;
- FLeftCol := tbDefLockedCols;
- FSelAnchorCol := tbDefLockedCols;
-
- FActiveRow := tbDefLockedRows;
- FLockedRows := tbDefLockedRows;
- FTopRow := tbDefLockedRows;
- FSelAnchorRow := tbDefLockedRows;
-
-{$IFDEF LCL}
- FCtl3D := True;
-{$ENDIF}
-
-{$IFNDEF LCL}
- tbColMoveCursor := LoadBaseCursor('ORCOLUMNMOVECURSOR');
- tbRowMoveCursor := LoadBaseCursor('ORROWMOVECURSOR');
-{$ELSE}
- {$IFDEF MSWINDOWS} //Has never worked, plus crashes Carbon, so leave out for now.
- tbColMoveCursor := LoadCursorFromLazarusResource('ORCOLUMNMOVECURSOR');
- tbRowMoveCursor := LoadCursorFromLazarusResource('ORROWMOVECURSOR');
- {$ENDIF}
-{$ENDIF}
-
- tbSelList := TOvcSelectionList.Create(tbDefRowCount, tbDefColCount);
-
- tbLastEntRow := -1;
- tbLastEntCol := -1;
-
- tbCmdTable := NewString(GetOrphStr(SCGridTableName));
-
- AssignDisplayArray(tbColNums, succ(tbDefColCount));
- AssignDisplayArray(tbRowNums, succ(tbDefRowCount));
-
- if csDesigning in ComponentState then
- tbState := tbState + [otsDesigning]
- else
- tbState := tbState + [otsUnfocused];
-
- tbMustFinishLoading := true;
- end;
-{--------}
-
-destructor TOvcCustomTable.Destroy;
- begin
- if not (csDestroying in ComponentState) then
- Destroying;
- FCols.Free;
- FCells.Free;
- FRows.Free;
- tbInvCells.Free;
- tbSelList.Free;
- tbCellAttrFont.Free;
- if Assigned(tbColNums) then
- AssignDisplayArray(tbColNums, 0);
- if Assigned(tbRowNums) then
- AssignDisplayArray(tbRowNums, 0);
- DisposeString(tbCmdTable);
- GridPenSet.Free;
- FColors.Free;
-
- inherited Destroy;
- end;
-{--------}
-
-procedure TOvcCustomTable.CreateParams(var Params: TCreateParams);
- begin
- inherited CreateParams(Params);
-
- with Params do
- Style := LongInt(Style) or OvcData.ScrollBarStyles[FScrollBars]
- or OvcData.BorderStyles[FBorderStyle];
-
- if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then begin
- Params.Style := Params.Style and not WS_BORDER;
- Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
- end;
-
-{$IFDEF LCL}
- inherited SetBorderStyle(FBorderStyle);
-{$ENDIF}
- end;
-{--------}
-
-procedure TOvcCustomTable.CreateWnd;
- begin
- inherited CreateWnd;
- {post a message to ourselves to finish loading the cells}
- {--the reason for this is that cell components _may_ be }
- { on a data module: we must wait until all data modules}
- { have been created, otherwise we may not pick up some }
- { cell references (Delphi 2 does not guarantee any }
- { particular order for form/data module creation). }
-
- PostMessage(Handle, ctim_LoadDefaultCells, 0, 0);
-
- tbLockCount := 0;
-
- tbHasHSBar := false;
- tbHasVSBar := false;
- if (FScrollBars = ssBoth) or (FScrollBars = ssHorizontal) then
- tbHasHSBar := true;
- if (FScrollBars = ssBoth) or (FScrollBars = ssVertical) then
- tbHasVSBar := true;
-
- tbCalcColData(tbColNums, LeftCol);
- tbCalcRowData(tbRowNums, TopRow);
- {make sure the column/row properties are valid}
- LeftCol := LeftCol;
- TopRow := TopRow;
- ActiveCol := ActiveCol;
- ActiveRow := ActiveRow;
- FSelAnchorCol := ActiveCol;
- FSelAnchorRow := ActiveRow;
-
- {Set up the scrollbars}
- tbSetScrollRange(otsbHorizontal);
- tbSetScrollPos(otsbHorizontal);
- tbSetScrollRange(otsbVertical);
- tbSetScrollPos(otsbVertical);
-
- {Must trigger the active cell and topleft cell change events}
- DoTopLeftCellChanged(TopRow, LeftCol);
- DoActiveCellChanged(ActiveRow, ActiveCol);
-
- if not (otsDesigning in tbState) and (otoAlwaysEditing in Options) then
- PostMessage(Handle, ctim_StartEdit, 0, 0);
- end;
-{--------}
-
-procedure TOvcCustomTable.Loaded;
- begin
- inherited Loaded;
- end;
-
-{==TOvcTable property streaming routines=============================}
-
-procedure TOvcCustomTable.DefineProperties(Filer : TFiler);
- begin
- inherited DefineProperties(Filer);
- with Filer do
- begin
- DefineProperty('RowData', tbReadRowData, tbWriteRowData, true);
- DefineProperty('ColData', tbReadColData, tbWriteColData, true);
- end;
- end;
-{--------}
-
-procedure TOvcCustomTable.tbFinishLoadingDefaultCells;
- var
- i : integer;
- begin
- FCols.tcStopLoading;
- {if our cell list is empty refresh it now}
- if (taCellList.Count = 0) then
- begin
- if Assigned(FLockedRowsCell) then
- tbIncludeCell(FLockedRowsCell);
- for i := 0 to pred(FCols.Count) do
- tbIncludeCell(FCols.DefaultCell[i]);
- {we don't have to do the Cells matrix: no design time support}
- end;
- end;
-{--------}
-
-procedure TOvcCustomTable.tbReadColData(Reader : TReader);
- var
- ColObj : TOvcTableColumn;
- Fixups : TStringList;
- begin
- AllowRedraw := false;
- with Reader do
- begin
- ReadListBegin;
- FCols.Clear;
- Fixups := FCols.tcStartLoading;
- while not EndOfList do
- begin
- ColObj := TOvcTableColumn.Create(Self);
- ColObj.Width := Readinteger;
- ColObj.Hidden := ReadBoolean;
- if ReadBoolean then
- Fixups.AddObject(ReadString, ColObj);
- FCols.Append(ColObj);
- end;
- ReadListEnd;
- end;
- AllowRedraw := true;
- end;
-{--------}
-
-procedure TOvcCustomTable.tbReadRowData(Reader : TReader);
- var
- RowNum : TRowNum;
- RS : TRowStyle;
- begin
- with Reader do
- begin
- ReadListBegin;
- FRows.Clear;
- FRows.DefaultHeight := Readinteger;
- while not EndOfList do
- begin
- RowNum := Readinteger;
- RS.Hidden := ReadBoolean;
- RS.Height := Readinteger;
- FRows[RowNum] := RS;
- end;
- ReadListEnd;
- end;
- end;
-{--------}
-
-procedure TOvcCustomTable.tbWriteColData(Writer : TWriter);
- var
- ColNum : TColNum;
- S : string;
- begin
- if tbMustFinishLoading then begin
- tbFinishLoadingCellList;
- tbFinishLoadingDefaultCells;
- tbMustFinishLoading := false;
- end;
-
- with Writer do
- begin
- WriteListBegin;
- for ColNum := 0 to pred(ColCount) do
- with FCols[ColNum] do
- begin
- WriteInteger(Width);
- WriteBoolean(Hidden);
- if (DefaultCell <> nil) then
- begin
- WriteBoolean(true);
- S := DefaultCell.Owner.Name;
- if (S <> '') then
- S := S + '.' + DefaultCell.Name
- else
- S := DefaultCell.Name;
- WriteString(S);
- end
- else
- WriteBoolean(false);
- end;
- WriteListEnd;
- end;
- end;
-{--------}
-
-procedure TOvcCustomTable.tbWriteRowData(Writer : TWriter);
- var
- RowNum : TRowNum;
- RS : TRowStyle;
- begin
- with Writer do
- begin
- WriteListBegin;
- Writeinteger(FRows.DefaultHeight);
- for RowNum := 0 to pred(FRows.Limit) do
- if FRows.RowIsSpecial[RowNum] then
- begin
- Writeinteger(RowNum);
- RS := FRows[RowNum];
- WriteBoolean(RS.Hidden);
- Writeinteger(RS.Height);
- end;
- WriteListEnd;
- end;
- end;
-{====================================================================}
-
-
-{==TOvcTable property read routines==================================}
-function TOvcCustomTable.GetAllowRedraw : boolean;
- begin
- Result := (tbLockCount = 0);
- end;
-{--------}
-function TOvcCustomTable.GetColCount : TColNum;
- begin
- Result := FCols.Count;
- end;
-{--------}
-function TOvcCustomTable.GetColOffset(ColNum : TColNum) : integer;
- var
- ColInx : integer;
- begin
- ColInx := tbFindColInx(ColNum);
- if (ColInx <> -1) then
- Result := tbColNums^.Ay[ColInx].Offset
- else
- Result := -1;
- end;
-{--------}
-function TOvcCustomTable.GetRowLimit : TRowNum;
- begin
- Result := FRows.Limit;
- end;
-{--------}
-function TOvcCustomTable.GetRowOffset(RowNum : TRowNum) : integer;
- var
- RowInx : integer;
- begin
- RowInx := tbFindRowInx(RowNum);
- if (RowInx <> -1) then
- Result := tbRowNums^.Ay[RowInx].Offset
- else
- Result := -1;
- end;
-{--------}
-procedure TOvcCustomTable.ResolveCellAttributes(RowNum : TRowNum; ColNum : TColNum;
- var CellAttr : TOvcCellAttributes);
- var
- TempAccess : TOvcTblAccess;
- TempAdjust : TOvcTblAdjust;
- TempColor : TColor;
- TempFontColor : TColor;
- TempSparseAttr: TOvcSparseAttr;
- begin
- FCells.ResolveFullAttr(RowNum, ColNum, TempSparseAttr);
- with CellAttr do
- begin
- {calculate the access rights}
- TempAccess := TempSparseAttr.scaAccess;
- if (TempAccess = otxDefault) then
- begin
- TempAccess := caAccess;
- if (TempAccess = otxDefault) then
- TempAccess := Access;
- end;
- caAccess := TempAccess;
- {calculate the adjustment}
- TempAdjust := TempSparseAttr.scaAdjust;
- if (TempAdjust = otaDefault) then
- begin
- TempAdjust := caAdjust;
- if (TempAdjust = otaDefault) then
- TempAdjust := Adjust;
- end;
- caAdjust := TempAdjust;
- {calculate the font}
- if Assigned(TempSparseAttr.scaFont) then
- caFont.Assign(TempSparseAttr.scaFont);
- {calculate the colors}
- if (RowNum = ActiveRow) and (ColNum = ActiveCol) then
- if (otsFocused in tbState) then
- if InEditingState or
- ((otoAlwaysEditing in Options) and (caAccess = otxNormal)) then
- begin
- TempColor := Colors.Editing;
- TempFontColor := Colors.EditingText
- end
- else
- begin
- TempColor := Colors.ActiveFocused;
- TempFontColor := Colors.ActiveFocusedText;
- end
- else
- begin
- TempColor := Colors.ActiveUnfocused;
- TempFontColor := Colors.ActiveUnfocusedText;
- end
- else
- begin
- if (RowNum = ActiveRow) and (otoBrowseRow in FOptions) then
- if (otsFocused in tbState) then
- begin
- TempColor := Colors.ActiveFocused;
- TempFontColor := Colors.ActiveFocusedText;
- end
- else
- begin
- TempColor := Colors.ActiveUnfocused;
- TempFontColor := Colors.ActiveUnfocusedText;
- end
- else if InSelection(RowNum, ColNum) then
- begin
- TempColor := Colors.Selected;
- TempFontColor := Colors.SelectedText;
- end
- else
- begin
- TempColor := TempSparseAttr.scaColor;
- if Assigned(TempSparseAttr.scaFont) then
- TempFontColor := TempSparseAttr.scaFont.Color
- else if (RowNum < LockedRows) or (ColNum < LockedCols) then
- TempFontColor := Colors.LockedText
- else
- TempFontColor := caFontColor;
- if (TempColor = clOvcTableDefault) then
- if (RowNum < LockedRows) or (ColNum < LockedCols) then
- TempColor := Colors.Locked
- else
- TempColor := caColor;
- end;
- end;
- caColor := TempColor;
- caFontColor := TempFontColor;
- end;
- DoGetCellAttributes(RowNum, ColNum, CellAttr);
- end;
-{====================================================================}
-
-
-{==TOvcTable property write routines=================================}
-procedure TOvcCustomTable.SetAccess(A : TOvcTblAccess);
- var
- TempAccess : TOvcTblAccess;
- begin
- if (A = otxDefault) then
- TempAccess := tbDefAccess
- else TempAccess := A;
- if (TempAccess <> FAccess) then
- begin
- AllowRedraw := false;
- try
- if (TempAccess = otxInvisible) or (FAccess = otxInvisible) then
- InvalidateTable;
- FAccess := TempAccess;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetActiveCell(RowNum : TRowNum; ColNum : TColNum);
- begin
- DoActiveCellMoving(ccNone, RowNum, ColNum);
- tbSetActiveCellWithSel(RowNum, ColNum);
- end;
-{--------}
-procedure TOvcCustomTable.tbSetActiveCellWithSel(RowNum : TRowNum;
- ColNum : TColNum);
- begin
- if tbIsKeySelecting then
- tbUpdateSelection(RowNum, ColNum, tstDeselectAll)
- else
- tbSetAnchorCell(RowNum, ColNum, tstDeselectAll);
- tbSetActiveCellPrim(RowNum, ColNum);
- end;
-{--------}
-
-procedure TOvcCustomTable.tbSetActiveCellPrim(RowNum : TRowNum; ColNum : TColNum);
- var
- TempInvCells : TOvcCellArray;
- begin
- {verify the row/column numbers to be visible}
- RowNum := IncRow(RowNum, 0);
- ColNum := IncCol(ColNum, 0);
- {if nothing to do, get out}
- if (RowNum = FActiveRow) and (ColNum = FActiveCol) then
- Exit;
- {if can't do anything visually, just set the internal fields and
- then exit}
- if (not HandleAllocated) or
- (tbRowNums^.Count = 0) or (tbColNums^.Count = 0) then
- begin
- FActiveRow := RowNum;
- FActiveCol := ColNum;
- Exit;
- end;
- {set the new active cell}
- TempInvCells := nil;
- AllowRedraw := false;
- try
- TempInvCells := TOvcCellArray.Create;
- if (RowNum <> FActiveRow) then
- begin
- tbInvalidateRowHdgPrim(FActiveRow, TempInvCells);
- InvalidateRowHeading(RowNum);
- DoLeavingRow(FActiveRow);
- end;
- if (ColNum <> FActiveCol) then
- begin
- tbInvalidateColHdgPrim(FActiveCol, TempInvCells);
- InvalidateColumnHeading(ColNum);
- DoLeavingColumn(FActiveCol);
- end;
- tbInvCells.DeleteCell(ActiveRow, ActiveCol);
- TempInvCells.AddCell(ActiveRow, ActiveCol);
-
- if not OldRowColBehavior then
- if FActiveRow <> RowNum then
- DoEnteringRow(RowNum);
-
- FActiveRow := RowNum;
-
- if not OldRowColBehavior then
- if FActiveCol <> ColNum then
- DoEnteringColumn(ColNum);
-
- FActiveCol := ColNum;
- tbDrawInvalidCells(TempInvCells);
- tbEnsureRowIsVisible(RowNum);
- tbEnsureColumnIsVisible(ColNum);
- if not (otsDesigning in tbState) and (otoAlwaysEditing in Options) then
- PostMessage(Handle, ctim_StartEdit, 0, 0)
- else
- InvalidateCell(ActiveRow, ActiveCol);
- finally
- AllowRedraw := true;
- TempInvCells.Free;
- end;{try..finally}
- tbSetScrollPos(otsbHorizontal);
- tbSetScrollPos(otsbVertical);
- DoActiveCellChanged(RowNum, ColNum);
- end;
-{--------}
-procedure TOvcCustomTable.SetActiveCol(ColNum : TColNum);
- begin
- SetActiveCell(FActiveRow, ColNum);
- end;
-{--------}
-procedure TOvcCustomTable.SetActiveRow(RowNum : TRowNum);
- begin
- SetActiveCell(RowNum, FActiveCol);
- end;
-{--------}
-procedure TOvcCustomTable.SetAdjust(A : TOvcTblAdjust);
- var
- TempAdjust : TOvcTblAdjust;
- begin
- if (A = otaDefault) then
- TempAdjust := tbDefAdjust
- else TempAdjust := A;
- if (TempAdjust <> FAdjust) then
- begin
- AllowRedraw := false;
- try
- InvalidateTable;
- FAdjust := TempAdjust;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetAllowRedraw(AR : boolean);
- var
- CellRect : TRect;
- MustFocus: boolean;
- R : TRect;
- CellStyle: TOvcTblEditorStyle;
- begin
- if AR {AllowRedraw is true} then
- begin
- dec(tbLockCount);
- if (tbLockCount <= 0) then
- begin
- {Setting the tbLockCount explicitly to zero is to catch
- programmers who call AllowRedraw := true once to often}
- tbLockCount := 0;
- {Update the scroll bars}
- if tbUpdateSBs then
- begin
- tbUpdateSBs := false;
- tbSetScrollPos(otsbHorizontal);
- tbSetScrollPos(otsbVertical);
- end;
- {if in row selection mode invalidate it}
- if (otoBrowseRow in Options) then
- InvalidateRow(ActiveRow);
- {draw the invalid and active cells if we have a handle}
- if HandleAllocated then
- begin
- {redraw invalid cells}
- if not tbInvCells.Empty then
- tbDrawInvalidCells(tbInvCells);
- if (otsHiddenEdit in tbState) then
- begin
- if tbCalcActiveCellRect(CellRect) then
- begin
- {note: cell style is ignored here}
- CellStyle := tesNormal;
- DoSizeCellEditor(ActiveRow, ActiveCol, CellRect, CellStyle);
- MustFocus := Focused;
- tbActCell.EditMove(CellRect);
- tbState := tbState - [otsHiddenEdit] + [otsEditing];
- if MustFocus then
-{$IFNDEF LCL}
- Windows.SetFocus(tbActCell.EditHandle);
-{$ELSE}
- LclIntf.SetFocus(tbActCell.EditHandle);
-{$ENDIF}
- end
- end
- else
- tbDrawActiveCell;
- end;
- end;
- end
- else
- begin
- inc(tbLockCount);
- if (tbLockCount = 1) and (HandleAllocated) then
- begin
- if (otoBrowseRow in Options) then
- InvalidateRow(ActiveRow);
- if (otsEditing in tbState) then
- begin
-{$IFNDEF LCL}
- MustFocus := tbEditCellHasFocus(Windows.GetFocus);
-{$ELSE}
- MustFocus := tbEditCellHasFocus(LclIntf.GetFocus);
-{$ENDIF}
- GetWindowRect(tbActCell.EditHandle, R);
- R.TopLeft := ScreenToClient(R.TopLeft);
- R.BottomRight := ScreenToClient(R.BottomRight);
- InvalidateCellsInRect(R);
- tbActCell.EditHide;
- tbState := tbState - [otsEditing] + [otsHiddenEdit];
- if MustFocus then
- SetFocus;
- end
- else if not (otoBrowseRow in Options) then
- InvalidateCell(ActiveRow, ActiveCol);
- end;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetBorderStyle(const BS : TBorderStyle);
- begin
- if (BS <> BorderStyle) then
- begin
- FBorderStyle := BS;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetBlockAccess(A : TOvcTblAccess);
- var
- R : TRowNum;
- C : TColNum;
- begin
- for R := BlockRowBegin to BlockRowEnd do
- for C := BlockColBegin to BlockColEnd do
- FCells.Access[R, C] := A;
- end;
-{--------}
-procedure TOvcCustomTable.SetBlockAdjust(A : TOvcTblAdjust);
- var
- R : TRowNum;
- C : TColNum;
- begin
- for R := BlockRowBegin to BlockRowEnd do
- for C := BlockColBegin to BlockColEnd do
- FCells.Adjust[R, C] := A;
- end;
-{--------}
-procedure TOvcCustomTable.SetBlockCell(C : TOvcBaseTableCell);
- var
- Rn : TRowNum;
- Cn : TColNum;
- begin
- for Rn := BlockRowBegin to BlockRowEnd do
- for Cn := BlockColBegin to BlockColEnd do
- FCells.Cell[Rn, Cn] := C;
- end;
-{--------}
-procedure TOvcCustomTable.SetBlockColBegin(ColNum : TColNum);
- begin
- if (ColNum <> FBlockColBegin) then
- if (0 <= ColNum) and (ColNum < ColCount) then
- begin
- FBlockColBegin := ColNum;
- if (FBlockColEnd < FBlockColBegin) then
- FBlockColEnd := ColNum;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetBlockColEnd(ColNum : TColNum);
- begin
- if (ColNum <> FBlockColEnd) then
- if (0 <= ColNum) and (ColNum < ColCount) then
- begin
- FBlockColEnd := ColNum;
- if (FBlockColEnd < FBlockColBegin) then
- FBlockColBegin := ColNum;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetBlockColor(C : TColor);
- var
- Rn : TRowNum;
- Cn : TColNum;
- begin
- for Rn := BlockRowBegin to BlockRowEnd do
- for Cn := BlockColBegin to BlockColEnd do
- FCells.Color[Rn, Cn] := C;
- end;
-{--------}
-procedure TOvcCustomTable.SetBlockFont(F : TFont);
- var
- R : TRowNum;
- C : TColNum;
- begin
- for R := BlockRowBegin to BlockRowEnd do
- for C := BlockColBegin to BlockColEnd do
- FCells.Font[R, C] := F;
- end;
-{--------}
-procedure TOvcCustomTable.SetBlockRowBegin(RowNum : TRowNum);
- begin
- if (RowNum <> FBlockRowBegin) then
- if (0 <= RowNum) and (RowNum < RowLimit) then
- begin
- FBlockRowBegin := RowNum;
- if (FBlockRowEnd < FBlockRowBegin) then
- FBlockRowEnd := RowNum;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetBlockRowEnd(RowNum : TRowNum);
- begin
- if (RowNum <> FBlockRowEnd) then
- if (0 <= RowNum) and (RowNum < RowLimit) then
- begin
- FBlockRowEnd := RowNum;
- if (FBlockRowEnd < FBlockRowBegin) then
- FBlockRowBegin := RowNum;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetColors(C : TOvcTableColors);
- begin
- FColors.Assign(C);
- end;
-{--------}
-procedure TOvcCustomTable.SetColorUnused(CU : TColor);
- begin
- if (CU <> ColorUnused) then
- begin
- AllowRedraw := false;
- FColorUnused := CU;
- tbInvCells.AddUnusedBit;
- AllowRedraw := true;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetColCount(CC : integer);
- begin
- if (CC <> ColCount) and (CC > LockedCols) then
- begin
- AllowRedraw := false;
- try
- Columns.Count := CC;
- tbSelList.SetColCount(CC);
- tbSetScrollRange(otsbHorizontal);
- if (CC <= ActiveCol) then
- ActiveCol := pred(CC);
- if (CC <= LeftCol) then
- LeftCol := pred(CC);
- if (CC <= FSelAnchorCol) then
- FSelAnchorCol := pred(CC);
- if (CC <= BlockColBegin) then
- BlockColBegin := pred(CC);
- if (CC <= BlockColEnd) then
- BlockColEnd := pred(CC);
- tbSetScrollPos(otsbHorizontal);
-
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetCols(CS : TOvcTableColumns);
- begin
- AllowRedraw := false;
- try
- FCols.Free;
- FCols := CS;
- FCols.Table := Self;
- FCols.OnColumnChanged := tbColChanged;
- tbColChanged(FCols, 0, 0, taGeneral);
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-procedure TOvcCustomTable.SetLeftCol(ColNum : TColNum);
- begin
- SetTopLeftCell(TopRow, ColNum);
- end;
-{--------}
-procedure TOvcCustomTable.SetLockedCols(ColNum : TColNum);
- begin
- if not HandleAllocated then
- FLockedCols := ColNum
- else
- if (ColNum <> FLockedCols) then
- if (0 <= ColNum) and (ColNum < ColCount) then
- begin
- AllowRedraw := false;
- try
- FLockedCols := ColNum;
- if LeftCol < ColNum then
- LeftCol := LeftCol; {this does do something!}
- if (ActiveCol < ColNum) then
- ActiveCol := LeftCol; {this does do something!}
- tbCalcColData(tbColNums, LeftCol);
- InvalidateTable;
- finally
- AllowRedraw := true;
- end;{try..finally}
- tbSetScrollRange(otsbHorizontal);
- tbSetScrollPos(otsbHorizontal);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetLockedRows(RowNum : TRowNum);
- begin
- if not HandleAllocated then
- FLockedRows := RowNum
- else
- if (RowNum <> FLockedRows) then
- if (0 <= RowNum) then
- begin
- AllowRedraw := false;
- try
- FLockedRows := RowNum;
- if (TopRow < RowNum) then
- TopRow := TopRow; {this does do something!}
- if (ActiveRow < RowNum) then
- ActiveRow := ActiveRow; {this does do something!}
- tbCalcRowData(tbRowNums, TopRow);
- InvalidateTable;
- finally
- AllowRedraw := true;
- end;{try..finally}
- tbSetScrollRange(otsbVertical);
- tbSetScrollPos(otsbVertical);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetLockedRowsCell(C : TOvcBaseTableCell);
- var
- DoIt : boolean;
- begin
- DoIt := false;
- if (C <> FLockedRowsCell) then
- if Assigned(C) then
- begin
- if (C.References = 0) or
- ((C.References > 0) and (C.Table = Self)) then
- DoIt := true;
- end
- else
- DoIt := true;
-
- if DoIt then
- begin
- if Assigned(FLockedRowsCell) then
- FLockedRowsCell.DecRefs;
- FLockedRowsCell := C;
- if Assigned(FLockedRowsCell) then
- begin
- if (FLockedRowsCell.References = 0) then
- FLockedRowsCell.Table := Self;
- FLockedRowsCell.IncRefs;
- end;
- tbCellChanged(Self);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetOptions(O : TOvcTblOptionSet);
- begin
- AllowRedraw := false;
- try
- FOptions := O;
- if HaveSelection then
- begin
- tbIsSelecting := false;
- tbIsDeselecting := false;
- tbSetAnchorCell(ActiveRow, ActiveCol, tstDeselectAll);
- end;
- {patch up the options set to exclude meaningless combinations}
- if (otoBrowseRow in FOptions) then
- begin
- FOptions := FOptions +
- [otoNoSelection, otoNoRowResizing{, otoNoColResizing}] -
- [otoMouseDragSelect, otoRowSelection, otoColSelection];
- end;
- if (otoAlwaysEditing in FOptions) then
- begin
- FOptions := FOptions +
- [otoNoSelection, otoNoRowResizing, otoNoColResizing] -
- [otoMouseDragSelect, otoRowSelection, otoColSelection];
- end
- else if (otoNoSelection in FOptions) then
- begin
- FOptions := FOptions -
- [otoMouseDragSelect, otoRowSelection, otoColSelection];
- end;
- if (otoRowSelection in FOptions) then
- FOptions := FOptions - [otoAllowRowMoves];
- if (otoColSelection in FOptions) then
- FOptions := FOptions - [otoAllowColMoves];
- InvalidateTable;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-procedure TOvcCustomTable.SetPaintUnusedArea(PUA : TNotifyEvent);
- begin
- AllowRedraw := false;
- FPaintUnusedArea := PUA;
- tbInvCells.AddUnusedBit;
- AllowRedraw := true;
- end;
-{--------}
-procedure TOvcCustomTable.SetRowLimit(RowNum : TRowNum);
- begin
- if (RowNum <> FRows.Limit) and (RowNum > LockedRows) then
- begin
- AllowRedraw := false;
- try
- FRows.Limit := RowNum;
- tbSelList.SetRowCount(RowLimit);
- tbSetScrollRange(otsbVertical);
- if (RowNum <= ActiveRow) then
- ActiveRow := pred(RowNum);
- if (RowNum <= TopRow) then
- TopRow := pred(RowNum);
- if (RowNum <= FSelAnchorRow) then
- FSelAnchorRow := pred(RowNum);
- if (RowNum <= BlockRowBegin) then
- BlockRowBegin := pred(RowNum);
- if (RowNum <= BlockRowEnd) then
- BlockRowEnd := pred(RowNum);
- tbSetScrollPos(otsbVertical);
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetRows(RS : TOvcTableRows);
- begin
- AllowRedraw := false;
- try
- FRows.Free;
- FRows := RS;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-procedure TOvcCustomTable.SetScrollBars(const SB : TScrollStyle);
- begin
- if (SB <> ScrollBars) then
- begin
- FScrollBars := SB;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetTopRow(RowNum : TRowNum);
- begin
- SetTopLeftCell(RowNum, LeftCol);
- end;
-{--------}
-procedure TOvcCustomTable.SetTopLeftCell(RowNum : TRowNum; ColNum : TColNum);
- begin
- {ensure that the new top left cell minimises the unused space}
- if (ColNum > tbLastLeftCol) then
- ColNum := tbLastLeftCol;
- if (RowNum > tbLastTopRow) then
- RowNum := tbLastTopRow;
- {ensure that RowNum and C are not hidden}
- RowNum := IncRow(RowNum, 0);
- ColNum := IncCol(ColNum, 0);
- DoTopLeftCellChanging(RowNum, ColNum);
- {change the topmost row and leftmost column if required}
- if not HandleAllocated then
- begin
- FTopRow := RowNum;
- FLeftCol := ColNum;
- end
- else
- if (RowNum <> FTopRow) or (ColNum <> FLeftCol) then
- begin
- AllowRedraw := false;
- {note: the tbScrollTableXxx routines set FTopRow and FLeftCol}
- try
- if (RowNum > FTopRow) then
- tbScrollTableUp(RowNum)
- else if (RowNum < FTopRow) then
- tbScrollTableDown(RowNum);
- if (ColNum > FLeftCol) then
- tbScrollTableLeft(ColNum)
- else if (ColNum < FLeftCol) then
- tbScrollTableRight(ColNum);
- finally
- AllowRedraw := true;
- end;{try..finally}
- tbSetScrollPos(otsbVertical);
- tbSetScrollPos(otsbHorizontal);
- DoTopLeftCellChanged(RowNum, ColNum);
- end;
- end;
-{====================================================================}
-
-
-{==TOvcTable Scroller routines=======================================}
-procedure TOvcCustomTable.tbSetScrollPos(SB : TOvcScrollBar);
- var
- ColNum : TColNum;
- ColCnt : TColNum;
- Divisor : LongInt;
-{$IFNDEF MSWINDOWS}
- SI : TScrollInfo;
-{$ENDIF}
- begin
- if (SB = otsbVertical) then
- begin
- if tbHasVSBar then
- if HandleAllocated and (tbLockCount = 0) then
- begin
-{$IFDEF MSWINDOWS}
- if (tbLastTopRow < 16*1024) then
- SetScrollPos(Handle, SB_VERT, TopRow, true)
- else
- begin
- if (tbLastTopRow > (16 * 1024)) then
- Divisor := RowLimit div $400
- else
- Divisor := RowLimit div $40;
- SetScrollPos(Handle, SB_VERT,
- TopRow div Divisor,
- True);
- end
-{$ELSE}
- SI.fMask := SIF_POS;
- SI.nPos := TopRow;
- SI.nTrackPos := SI.nPos;
- SetScrollInfo(Handle, SB_Vert, SI, True);
-{$ENDIF}
- end
- else
- tbUpdateSBs := true;
- end
- else {SB = otsbHorizontal}
- begin
- if tbHasHSBar then
- if HandleAllocated and (tbLockCount = 0) then
- begin
- ColCnt := 0;
- for ColNum := LockedCols to pred(LeftCol) do
- if not tbIsColHidden(ColNum) then
- inc(ColCnt);
-{$IFDEF MSWINDOWS}
- SetScrollPos(Handle, SB_HORZ, ColCnt, true)
-{$ELSE}
- SI.fMask := SIF_POS;
- SI.nPos := ColCnt;
- SI.nTrackPos := SI.nPos;
- SetScrollInfo(Handle, SB_Horz, SI, True);
-{$ENDIF}
- end
- else
- tbUpdateSBs := true;
- end;
- end;
-{--------}
-
-procedure TOvcCustomTable.tbSetScrollRange(SB : TOvcScrollBar);
- var
- Divisor : LongInt;
-{$IFNDEF MSWINDOWS}
- SI : TScrollInfo;
-{$ENDIF}
- begin
- if (SB = otsbVertical) then
- begin
- if HandleAllocated then
- tbCalcRowsOnLastPage;
- if tbHasVSBar and HandleAllocated then
- begin
-{$IFDEF MSWINDOWS}
-// tbCalcRowsOnLastPage;
- if (tbLastTopRow < 16*1024) then
- if tbCalcRequiresVSBar then
- SetScrollRange(Handle, SB_Vert, LockedRows, tbLastTopRow, false)
- else
- SetScrollRange(Handle, SB_Vert, LockedRows, LockedRows, false)
- else begin
- if (tbLastTopRow > (16*1024)) then
- Divisor := Succ(tbLastTopRow div $400)
- else
- Divisor := Succ(tbLastTopRow div $40);
- SetScrollRange(Handle, SB_Vert,
- LockedRows,
- tbLastTopRow div Divisor,
- False)
- end;
-{$ELSE}
- SI.fMask := SIF_RANGE or SIF_PAGE;
- SI.nMin := LockedRows;
- SI.nMax := Pred(RowLimit);
- SI.nPage := (ClientHeight div Rows[LockedRows].Height) - LockedRows;
- if SI.nPage < 1 then
- SI.nPage := 1;
- SetScrollInfo(Handle, SB_Vert, SI, True);
-{$ENDIF}
- end
- end
- else {SB = otsbHorizontal}
- begin
- tbCalcColsOnLastPage;
- if tbHasHSBar and HandleAllocated then
- begin
-{$IFDEF MSWINDOWS}
- tbCalcHSBarPosCount;
- SetScrollRange(Handle, SB_HORZ, 0, pred(tbHSBarPosCount), false);
-{$ELSE}
- SI.fMask := SIF_RANGE or SIF_PAGE;
- SI.nMin := 0;
- SI.nMax := Pred(ColCount) - LockedCols;
- SI.nPage := ColCount div 3;
- if SI.nPage < 1 then
- SI.nPage := 1;
- SetScrollInfo(Handle, SB_Horz, SI, True);
-{$ENDIF}
- end;
- end;
- end;
-{====================================================================}
-
-
-{==TOvcTable editing routines========================================}
-function TOvcCustomTable.FilterKey(var Msg : TWMKey) : TOvcTblKeyNeeds;
- var
- Cmd : word;
- begin
- Result := otkDontCare;
- Cmd := Controller.EntryCommands.TranslateUsing([tbCmdTable^], TMessage(Msg));
- {first the hard coded keys}
- case Msg.CharCode of
- VK_RETURN :
- if (otoEnterToArrow in Options) then
- Result := otkMustHave;
- VK_TAB :
- if (otoTabToArrow in Options) then
- Result := otkMustHave;
- VK_ESCAPE :
- Result := otkMustHave;
- end;{case}
- {now the translated commands}
- case Cmd of
- ccTableEdit :
- Result := otkMustHave;
- ccBotOfPage, ccBotRightCell, ccDown, ccEnd, ccFirstPage, ccHome,
- ccLastPage, ccLeft, ccNextPage, ccPageLeft, ccPageRight, ccPrevPage,
- ccRight, ccTopLeftCell, ccTopOfPage, ccUp, ccWordLeft, ccWordRight :
- Result := otkWouldLike;
- end;{case}
- end;
-{--------}
-function TOvcCustomTable.SaveEditedData : boolean;
- var
- Data : pointer;
- begin
- Result := true;
- if InEditingState then
- begin
- Result := false;
- if not tbActCell.CanSaveEditedData(true) then
- Exit;
- Result := true;
- DoEnteringColumn(ActiveCol);
- DoEnteringRow(ActiveRow);
- DoGetCellData(ActiveRow, ActiveCol, Data, cdpForSave);
- tbActCell.SaveEditedData(Data);
- end;
- end;
-{--------}
-function TOvcCustomTable.StartEditingState : boolean;
- var
- CellRect : TRect;
- Data : pointer;
- CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- begin
- Result := true;
- if InEditingState then
- Exit;
- DoBeginEdit(ActiveRow, ActiveCol, Result);
- if not Result then
- Exit;
- Result := false;
- AllowRedraw := false;
- try
- tbEnsureRowIsVisible(ActiveRow);
- tbEnsureColumnIsVisible(ActiveCol);
- tbActCell := tbFindCell(ActiveRow, ActiveCol);
- if Assigned(tbActCell) then
- begin
- FillChar(CellAttr, sizeof(CellAttr), 0);
- CellAttr.caFont := tbCellAttrFont;
- CellAttr.caFont.Assign(Font);
- tbActCell.ResolveAttributes(ActiveRow, ActiveCol, CellAttr);
- if (CellAttr.caAccess = otxNormal) then
- begin
- if not tbCalcActiveCellRect(CellRect) then
- {we're in big trouble, lads};
- CellStyle := tesNormal;
- DoSizeCellEditor(ActiveRow, ActiveCol, CellRect, CellStyle);
- DoEnteringColumn(ActiveCol);
- DoEnteringRow(ActiveRow);
- DoGetCellData(ActiveRow, ActiveCol, Data, cdpForEdit);
- tbState := tbState - [otsNormal] + [otsHiddenEdit];
- CellAttr.caColor := Colors.Editing;
- CellAttr.caFontColor := Colors.EditingText;
- tbActCell.StartEditing(ActiveRow, ActiveCol, CellRect, CellAttr, CellStyle, Data);
- Result := (tbActCell.EditHandle <> 0);
- if not Result then
- begin
- tbState := tbState + [otsNormal] - [otsHiddenEdit];
- tbActCell := nil;
- end;
- end
- else
- tbActCell := nil;
- end;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-function TOvcCustomTable.StopEditingState(SaveValue : boolean) : boolean;
- var
- Data : pointer;
- MustFocus : boolean;
-
- R : TRect;
-
- begin
- Result := true;
- if not InEditingState then
- Exit;
- Result := false;
- if not tbActCell.CanSaveEditedData(SaveValue) then
- Exit;
- DoEndEdit(tbActCell, ActiveRow, ActiveCol, Result);
- if not Result then
- Exit;
- Result := true;
- GetWindowRect(tbActCell.EditHandle, R);
- AllowRedraw := false;
- try
-{$IFNDEF LCL}
- MustFocus := tbEditCellHasFocus(Windows.GetFocus);
-{$ELSE}
- MustFocus := tbEditCellHasFocus(LclIntf.GetFocus);
-{$ENDIF}
- if not MustFocus then
- MustFocus := Focused;
- DoEnteringColumn(ActiveCol);
- DoEnteringRow(ActiveRow);
- DoGetCellData(ActiveRow, ActiveCol, Data, cdpForSave);
-
- R.TopLeft := ScreenToClient(R.TopLeft);
- R.BottomRight := ScreenToClient(R.BottomRight);
- InvalidateCellsInRect(R);
-
- tbActCell.StopEditing(SaveValue, Data);
- tbActCell := nil;
- try
- DoDoneEdit(ActiveRow, ActiveCol);
- finally
- if not (otoAlwaysEditing in Options) then
- InvalidateCell(ActiveRow, ActiveCol);
- tbState := tbState - [otsEditing, otsHiddenEdit] + [otsNormal];
- if MustFocus then
- SetFocus
- else
- tbState := tbState - [otsFocused] + [otsUnfocused];
- end;{try..finally}
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{====================================================================}
-
-
-{==TOvcTable selection methods=======================================}
-procedure TOvcCustomTable.tbDeselectAll(CA : TOvcCellArray);
- begin
- with tbSelList do
- begin
- Iterate(tbDeselectAllIterator, pointer(CA));
- DeselectAll;
- end;
- end;
-{--------}
-function TOvcCustomTable.tbDeselectAllIterator(RowNum1 : TRowNum; ColNum1 : TColNum;
- RowNum2 : TRowNum; ColNum2 : TColNum;
- ExtraData : pointer) : boolean;
- var
- RowNum : TRowNum;
- ColNum : TColNum;
- RowInx : integer;
- CA : TOvcCellArray absolute ExtraData;
- begin
- {optimisations: 1. generally ColNum1 = ColNum2
- 2. take it from the viewpoint of what rows are visible
- rather than what rows are selected}
- Result := true;
- for ColNum := ColNum1 to ColNum2 do
- if (tbFindColInx(ColNum) <> -1) then
- with tbRowNums^ do
- for RowInx := 0 to pred(Count) do
- begin
- RowNum := Ay[RowInx].Number;
- if (RowNum1 <= RowNum) and (RowNum <= RowNum2) then
- CA.AddCell(RowNum, ColNum);
- end;
- end;
-{--------}
-function TOvcCustomTable.HaveSelection : boolean;
- begin
- Result := tbSelList.HaveSelection;
- end;
-{--------}
-function TOvcCustomTable.InSelection(RowNum : TRowNum; ColNum : TColNum) : boolean;
- begin
- if HaveSelection then
- Result := tbSelList.IsCellSelected(RowNum, ColNum)
- else
- Result := false;
- end;
-{--------}
-procedure TOvcCustomTable.IterateSelections(SI : TSelectionIterator; ExtraData : pointer);
- begin
- with tbSelList do
- Iterate(SI, ExtraData);
- end;
-{--------}
-procedure TOvcCustomTable.tbSelectCol(ColNum : TColNum);
- var
- RowInx : integer;
- ColInx : integer;
- begin
- tbSelList.SelectCellRange(LockedRows, ColNum, pred(RowLimit), ColNum);
- ColInx := tbFindColInx(ColNum);
- if (ColInx <> -1) then
- with tbRowNums^ do
- for RowInx := 0 to pred(Count) do
- tbInvCells.AddCell(Ay[RowInx].Number, ColNum);
- end;
-{--------}
-procedure TOvcCustomTable.tbSelectRow(RowNum : TRowNum);
- var
- RowInx : integer;
- ColInx : integer;
- begin
- tbSelList.SelectCellRange(RowNum, LockedCols, RowNum, pred(ColCount));
- RowInx := tbFindRowInx(RowNum);
- if (RowInx <> -1) then
- with tbColNums^ do
- for ColInx := 0 to pred(Count) do
- tbInvCells.AddCell(RowNum, Ay[ColInx].Number);
- end;
-{--------}
-procedure TOvcCustomTable.tbSelectTable;
- begin
- tbSelList.SelectAll;
- InvalidateTable;
- end;
-{--------}
-procedure TOvcCustomTable.tbSetAnchorCell(RowNum : TRowNum; ColNum : TColNum;
- Action : TOvcTblSelectionType);
- begin
- {deselect the current selection(s) if required}
- if (Action = tstDeselectAll) then
- tbDeselectAll(tbInvCells);
- {set the anchor point to a sensible value}
- if (ColNum < LockedCols) then
- FSelAnchorCol := LockedCols
- else if (ColNum >= ColCount) then
- FSelAnchorCol := pred(ColCount)
- else
- FSelAnchorCol := ColNum;
- if (RowNum < LockedRows) then
- FSelAnchorRow := LockedRows
- else if (RowNum >= RowLimit) then
- FSelAnchorRow := pred(RowLimit)
- else
- FSelAnchorRow := RowNum;
- {tell the selection list object}
- tbSelList.SetRangeAnchor(RowNum, ColNum, Action);
- {try and work out whether we are selecting or deselecting}
- tbIsSelecting := false;
- tbIsDeselecting := false;
- if (Action = tstAdditional) then
- begin
- if InSelection(RowNum, ColNum) then
- tbIsDeselecting := true
- else
- tbIsSelecting := true;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbUpdateSelection(RowNum : TRowNum; ColNum : TColNum;
- Action : TOvcTblSelectionType);
- var
- R : TRowNum;
- C : TColNum;
- OldSelRow1 : TRowNum;
- OldSelRow2 : TRowNum;
- OldSelCol1 : TColNum;
- OldSelCol2 : TColNum;
- NewSelRow1 : TRowNum;
- NewSelRow2 : TRowNum;
- NewSelCol1 : TColNum;
- NewSelCol2 : TColNum;
- RowInx : integer;
- ColInx : integer;
- NewInvCells: TOvcCellArray;
- DeselCells : TOvcCellArray;
- begin
- NewInvCells := nil;
- DeselCells := nil;
- try
- {create temporary cell arrays: one for new invalid cells,
- one for any deselected cells}
- NewInvCells := TOvcCellArray.Create;
- DeselCells := TOvcCellArray.Create;
- {deselect currently selected cells if required}
- if (Action = tstDeselectAll) then
- tbDeselectAll(DeselCells);
- {calculate the old and new selections (the parameters RowNum,
- ColNum form the address of the new active cell)}
- OldSelRow1 := MinL(ActiveRow, FSelAnchorRow);
- OldSelRow2 := MaxL(ActiveRow, FSelAnchorRow);
- NewSelRow1 := MinL(RowNum, FSelAnchorRow);
- NewSelRow2 := MaxL(RowNum, FSelAnchorRow);
- if (otoBrowseRow in Options) then
- begin
- OldSelCol1 := LockedCols;
- OldSelCol2 := pred(ColCount);
- NewSelCol1 := LockedCols;
- NewSelCol2 := pred(ColCount);
- end
- else
- begin
- OldSelCol1 := MinI(ActiveCol, FSelAnchorCol);
- OldSelCol2 := MaxI(ActiveCol, FSelAnchorCol);
- NewSelCol1 := MinI(ColNum, FSelAnchorCol);
- NewSelCol2 := MaxI(ColNum, FSelAnchorCol);
- end;
- {extend the range in the selection list}
- tbSelList.ExtendRange(RowNum, ColNum, tbIsSelecting or tbIsKeySelecting);
- {for the old selection, remove the cells from the deselected cell
- array (if they are there) and add them to the new selected cell
- array}
- for RowInx := 0 to pred(tbRowNums^.Count) do
- begin
- R := tbRowNums^.Ay[RowInx].Number;
- if (OldSelRow1 <= R) and (R <= OldSelRow2) then
- for ColInx := 0 to pred(tbColNums^.Count) do
- begin
- C := tbColNums^.Ay[ColInx].Number;
- if (OldSelCol1 <= C) and (C <= OldSelCol2) then
- begin
- DeselCells.DeleteCell(R, C);
- NewInvCells.AddCell(R, C);
- end;
- end;
- end;
- {for the new selection, for each cell remove it from the new selected
- cell array; if it wasn't there add it to the same array}
- for RowInx := 0 to pred(tbRowNums^.Count) do
- begin
- R := tbRowNums^.Ay[RowInx].Number;
- if (NewSelRow1 <= R) and (R <= NewSelRow2) then
- for ColInx := 0 to pred(tbColNums^.Count) do
- begin
- C := tbColNums^.Ay[ColInx].Number;
- if (NewSelCol1 <= C) and (C <= NewSelCol2) then
- if not NewInvCells.DeleteCell(R, C) then
- NewInvCells.AddCell(R, C);
- end;
- end;
- {add the current active cell to the new selected cell array}
- NewInvCells.AddCell(ActiveRow, ActiveCol);
- {merge the cells from the temporary arrays into the main invalid
- cell array}
- tbInvCells.Merge(NewInvCells);
- tbInvCells.Merge(DeselCells);
- finally
- NewInvCells.Free;
- DeselCells.Free
- end;{try..finally}
- end;
-{====================================================================}
-
-
-{==TOvcTable notification methods====================================}
-procedure TOvcCustomTable.tbCellChanged(Sender : TObject);
- begin
- {don't bother if we're being loaded or destroyed}
- if ((ComponentState * [csLoading, csDestroying]) <> []) then
- Exit;
- {if we have a handle repaint the table}
- if HandleAllocated then
- begin
- AllowRedraw := false;
- try
- InvalidateTable;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbColChanged(Sender : TObject; ColNum1, ColNum2 : TColNum;
- Action : TOvcTblActions);
- var
- CC : TColNum;
- DoIt : boolean;
- begin
- {don't bother if we're being loaded or destroyed}
- if ((ComponentState * [csLoading, csDestroying]) <> []) then
- Exit;
- {similarly don't bother if we have no handle}
- if not HandleAllocated then begin
- tbSelList.SetColCount(ColCount);
- Exit;
- end;
- {make sure there's no flicker}
- AllowRedraw := false;
- try
- {decide whether there's anything to do to the visible display}
- DoIt := false;
- with tbColNums^ do
-{$IFDEF LCL} //Apparent TurboPower bug revealed when checks on
- if Count > 0 then
-{$ENDIF}
- case Action of
- taGeneral : DoIt := true;
- taSingle : begin
- DoIt := (Ay[0].Number <= ColNum1) and
- (ColNum1 <= Ay[pred(Count)].Number);
- {check for unhiding a column after all others}
- if not DoIt then
- DoIt := (ColNum1 > Ay[pred(Count)].Number) and
- (ClientWidth > Ay[Count].Offset);
- DoColumnsChanged(ColNum1, -1, taSingle);
- end;
- taAll : DoIt := true;
- taInsert : begin
- DoIt := (Ay[0].Number <= ColNum1) and
- (ColNum1 <= Ay[pred(Count)].Number);
- {check for appending a column}
- if not DoIt then
- DoIt := (ColNum1 > Ay[pred(Count)].Number) and
- (ClientWidth > Ay[Count].Offset);
- FCells.InsertCol(ColNum1);
- DoColumnsChanged(ColNum1, -1, taInsert);
- end;
- taDelete : begin
- DoIt := (Ay[0].Number <= ColNum1) and
- (ColNum1 <= Ay[pred(Count)].Number);
- FCells.DeleteCol(ColNum1);
- DoColumnsChanged(ColNum1, -1, taDelete);
- end;
- taExchange: begin
- DoIt := (Ay[0].Number <= ColNum1) and
- (ColNum1 <= Ay[pred(Count)].Number);
- if not DoIt then
- DoIt := (Ay[0].Number <= ColNum2) and
- (ColNum2 <= Ay[pred(Count)].Number);
- FCells.ExchangeCols(ColNum1, ColNum2);
- DoColumnsChanged(ColNum1, ColNum2, taExchange);
- end;
- end;{case}
- {if nothing to do to the visible columns, then do it!}
- if not DoIt then
- begin
- {must still reset the horizontal scroll bar even so}
- tbSelList.SetColCount(ColCount);
- tbSetScrollRange(otsbHorizontal);
- tbSetScrollPos(otsbHorizontal);
- Exit;
- end;
- {redisplay the table}
- tbCalcColData(tbColNums, LeftCol);
- InvalidateTable;
- {the column could have changed because it was hidden or deleted...
- ...must make sure that LeftCol and ActiveCol haven't
- been hidden as well.}
- if (Action = taSingle) or (Action = taDelete) then
- begin
- if (ColNum1 = LeftCol) then
- LeftCol := LeftCol; {this does do something!}
- if (ColNum1 = ActiveCol) then
- ActiveCol := ActiveCol; {this does do something!}
- end;
- {reset the block column values}
- CC := ColCount;
- if (CC <= BlockColBegin) then
- BlockColBegin := pred(CC);
- if (CC <= BlockColEnd) then
- BlockColEnd := pred(CC);
- tbSelList.SetColCount(ColCount);
- tbSetScrollRange(otsbHorizontal);
- tbSetScrollPos(otsbHorizontal);
- if (LeftCol > tbLastLeftCol) then
- LeftCol := tbLastLeftCol;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-procedure TOvcCustomTable.tbColorsChanged(Sender : TObject);
- begin
- {don't bother if we're being loaded or destroyed}
- if ((ComponentState * [csLoading, csDestroying]) <> []) then
- Exit;
- {if we have a handle repaint the table}
- if HandleAllocated then
- begin
- AllowRedraw := false;
- try
- InvalidateTable;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbGridPenChanged(Sender : TObject);
- begin
- {don't bother if we're being loaded or destroyed}
- if ((ComponentState * [csLoading, csDestroying]) <> []) then
- Exit;
- {if we have a handle repaint the table}
- if HandleAllocated then
- begin
- AllowRedraw := false;
- try
- InvalidateTable;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbRowChanged(Sender : TObject; RowNum1, RowNum2 : TRowNum;
- Action : TOvcTblActions);
- var
- RL : TRowNum;
- DoIt : boolean;
- begin
- {don't bother if we're being loaded or destroyed}
- if ((ComponentState * [csLoading, csDestroying]) <> []) then
- Exit;
- {similarly don't bother if we have no handle}
- if not HandleAllocated then begin
- tbSelList.SetRowCount(RowLimit);
- Exit;
- end;
- {make sure there's no flicker}
- AllowRedraw := false;
- try
- {decide whether there's anything to do to the visible display}
- DoIt := false;
- with tbRowNums^ do
- case Action of
- taGeneral : DoIt := true;
- taSingle : begin
- DoIt := (Ay[0].Number <= RowNum1) and
- (RowNum1 <= Ay[pred(Count)].Number);
- {check for unhiding a row after all others}
- if not DoIt then
- DoIt := (RowNum1 > Ay[pred(Count)].Number) and
- (ClientHeight > Ay[Count].Offset);
- DoRowsChanged(RowNum1, -1, taSingle);
- end;
- taAll : DoIt := true;
- taInsert : begin
- DoIt := (Ay[0].Number <= RowNum1) and
- (RowNum1 <= Ay[pred(Count)].Number);
- {check for appending a row}
- if not DoIt then
- DoIt := (RowNum1 > Ay[pred(Count)].Number) and
- (ClientHeight > Ay[Count].Offset);
- FCells.InsertRow(RowNum1);
- DoRowsChanged(RowNum1, -1, taInsert);
- end;
- taDelete : begin
- DoIt := (Ay[0].Number <= RowNum1) and
- (RowNum1 <= Ay[pred(Count)].Number);
- FCells.DeleteRow(RowNum1);
- DoRowsChanged(RowNum1, -1, taDelete);
- end;
- taExchange: begin
- DoIt := (Ay[0].Number <= RowNum1) and
- (RowNum1 <= Ay[pred(Count)].Number);
- if not DoIt then
- DoIt := (Ay[0].Number <= RowNum2) and
- (RowNum2 <= Ay[pred(Count)].Number);
- FCells.ExchangeRows(RowNum1, RowNum2);
- DoRowsChanged(RowNum1, RowNum2, taExchange);
- end;
- end;{case}
- {if nothing to do to the visible rows, then do it!}
- if not DoIt then
- begin
- {must still reset the vertical scroll bar even so}
- tbSelList.SetRowCount(RowLimit);
- tbSetScrollRange(otsbVertical);
- tbSetScrollPos(otsbVertical);
- Exit;
- end;
- {redisplay the table}
- tbCalcRowData(tbRowNums, TopRow);
- InvalidateTable;
- {the row could have changed because it was hidden or deleted...
- ...must make sure that TopRow and ActiveRow haven't
- been hidden as well.}
- if (Action = taSingle) or (Action = taDelete) then
- begin
- if (RowNum1 = TopRow) then
- TopRow := TopRow; {this does do something!}
- if (RowNum1 = ActiveRow) then
- ActiveRow := ActiveRow; {this does do something!}
- end;
- {reset the block row values}
- RL := RowLimit;
- if (RL <= BlockRowBegin) then
- BlockRowBegin := pred(RL);
- if (RL <= BlockRowEnd) then
- BlockRowEnd := pred(RL);
- tbSelList.SetRowCount(RowLimit);
- tbSetScrollRange(otsbVertical);
- tbSetScrollPos(otsbVertical);
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{====================================================================}
-
-
-{==TOvcTable invalidate cell methods=================================}
-procedure TOvcCustomTable.InvalidateCell(RowNum : TRowNum; ColNum : TColNum);
- var
- CInx : integer;
- RInx : integer;
- begin
- RInx := tbFindRowInx(RowNum);
- if (RInx <> -1) then
- begin
- CInx := tbFindColInx(ColNum);
- if (CInx <> -1) then
- tbInvCells.AddCell(RowNum, ColNum);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.InvalidateCellsInRect(const R : TRect);
- var
- GR : TRect;
- WhatToPaint : integer;
- RowInx : integer;
- ColInx : integer;
- begin
- WhatToPaint := tbCalcCellsFromRect(R, GR);
-
- if (WhatToPaint <> 2) then
- for RowInx := GR.Top to GR.Bottom do
- for ColInx := GR.Left to GR.Right do
- InvalidateCell(tbRowNums^.Ay[RowInx].Number, tbColNums^.Ay[ColInx].Number);
-
- if (WhatToPaint <> 0) then
- tbInvCells.AddUnusedBit;
- end;
-{--------}
-procedure TOvcCustomTable.InvalidateColumn(ColNum : TColNum);
- var
- RowInx : integer;
- ColInx : integer;
- begin
- ColInx := tbFindColInx(ColNum);
- if (ColInx <> -1) then
- with tbRowNums^ do
- for RowInx := 0 to pred(Count) do
- tbInvCells.AddCell(Ay[RowInx].Number, ColNum);
- end;
-{--------}
-procedure TOvcCustomTable.tbInvalidateColHdgPrim(ColNum : TColNum; InvCells : TOvcCellArray);
- var
- RowInx : integer;
- ColInx : integer;
- begin
- ColInx := tbFindColInx(ColNum);
- if (ColInx <> -1) then
- with tbRowNums^ do
- for RowInx := 0 to pred(LockedRows) do
- InvCells.AddCell(Ay[RowInx].Number, ColNum);
- end;
-{--------}
-procedure TOvcCustomTable.InvalidateColumnHeading(ColNum : TColNum);
- begin
- tbInvalidateColHdgPrim(ColNum, tbInvCells);
- end;
-{--------}
-procedure TOvcCustomTable.InvalidateRow(RowNum : TRowNum);
- var
- RowInx : integer;
- ColInx : integer;
- begin
- RowInx := tbFindRowInx(RowNum);
- if (RowInx <> -1) then
- with tbColNums^ do
- for ColInx := 0 to pred(Count) do
- tbInvCells.AddCell(RowNum, Ay[ColInx].Number);
- end;
-{--------}
-procedure TOvcCustomTable.tbInvalidateRowHdgPrim(RowNum : TRowNum; InvCells : TOvcCellArray);
- var
- RowInx : integer;
- ColInx : integer;
- begin
- RowInx := tbFindRowInx(RowNum);
- if (RowInx <> -1) then
- with tbColNums^ do
- for ColInx := 0 to pred(LockedCols) do
- InvCells.AddCell(RowNum, Ay[ColInx].Number);
- end;
-{--------}
-procedure TOvcCustomTable.InvalidateRowHeading(RowNum : TRowNum);
- begin
- tbInvalidateRowHdgPrim(RowNum, tbInvCells);
- end;
-{--------}
-procedure TOvcCustomTable.InvalidateTable;
- var
- RowInx : integer;
- ColInx : integer;
- PredColNumsCount : integer;
- PredRowNumsCount : integer;
- begin
-{$IFDEF LCL} //Apparent TurboPower bug revealed when checks on
- if (tbColNums^.Count > 0) and (tbRowNums^.Count > 0) then
- begin
-{$ENDIF}
- PredColNumsCount := pred(tbColNums^.Count);
- PredRowNumsCount := pred(tbRowNums^.Count);
- for RowInx := 0 to PredRowNumsCount do
- for ColInx := 0 to PredColNumsCount do
- tbInvCells.AddCell(tbRowNums^.Ay[RowInx].Number,
- tbColNums^.Ay[ColInx].Number);
-{$IFDEF LCL}
- end;
-{$ENDIF}
- tbInvCells.AddUnusedBit;
- end;
-{--------}
-procedure TOvcCustomTable.InvalidateTableNotLockedCols;
- var
- RowInx : integer;
- ColInx : integer;
- StartColInx : integer;
- PredColNumsCount : integer;
- PredRowNumsCount : integer;
- begin
- StartColInx := 0;
- PredColNumsCount := pred(tbColNums^.Count);
- PredRowNumsCount := pred(tbRowNums^.Count);
- while (StartColInx <= PredColNumsCount) and
- (tbColNums^.Ay[StartColInx].Number < LockedCols) do
- inc(StartColInx);
- for RowInx := 0 to PredRowNumsCount do
- for ColInx := StartColInx to PredColNumsCount do
- tbInvCells.AddCell(tbRowNums^.Ay[RowInx].Number,
- tbColNums^.Ay[ColInx].Number);
- tbInvCells.AddUnusedBit;
- end;
-{--------}
-procedure TOvcCustomTable.InvalidateTableNotLockedRows;
- var
- RowInx : integer;
- ColInx : integer;
- StartRowInx : integer;
- PredColNumsCount : integer;
- PredRowNumsCount : integer;
- begin
- StartRowInx := 0;
- PredColNumsCount := pred(tbColNums^.Count);
- PredRowNumsCount := pred(tbRowNums^.Count);
- while (StartRowInx <= PredRowNumsCount) and
- (tbRowNums^.Ay[StartRowInx].Number < LockedRows) do
- inc(StartRowInx);
- for RowInx := StartRowInx to PredRowNumsCount do
- for ColInx := 0 to PredColNumsCount do
- tbInvCells.AddCell(tbRowNums^.Ay[RowInx].Number,
- tbColNums^.Ay[ColInx].Number);
- tbInvCells.AddUnusedBit;
- end;
-{====================================================================}
-
-
-{==TOvcTable miscellaneous===========================================}
-function TOvcCustomTable.tbCalcActiveCellRect(var ACR : TRect) : boolean;
- var
- RInx : integer;
- CInx : integer;
- begin
- Result := false;
- RInx := tbFindRowInx(ActiveRow);
- if (RInx = -1) then
- Exit;
- CInx := tbFindColInx(ActiveCol);
- if (CInx = -1) then
- Exit;
-
- Result := true;
- with ACR do
- begin
- Top := tbRowNums^.Ay[RInx].Offset;
- Bottom := tbRowNums^.Ay[succ(RInx)].Offset;
- Left := tbColNums^.Ay[CInx].Offset;
- Right := tbColNums^.Ay[succ(CInx)].Offset;
- end;
- with GridPenSet.NormalGrid do
- case Effect of
- geVertical : dec(ACR.Right);
- geHorizontal : dec(ACR.Bottom);
- geBoth : begin
- dec(ACR.Right);
- dec(ACR.Bottom);
- end;
- ge3D : InflateRect(ACR, -1, -1);
- end;{case}
- end;
-{--------}
-function TOvcCustomTable.tbCalcCellsFromRect(const UR : TRect; var GR : TRect) : integer;
- {-Converts a paint rect into a 'grid' rect. A grid rect is a rectangle of
- cells, defined by their display indexes rather than their row/column
- numbers.
- The function result is a definition of the type of rectangle produced:
- 0--top left and bottom right corners of the original rect are
- exclusively within the table;
- 1--top left of the rect is in the displayed table, the bottom right is
- in the 'unused' bit (the bit between the displayed cells and the
- client area;
- 2--the original rectangle is exclusively in the 'unused bit'.
- }
- var
- Row : TRowNum;
- Col : TColNum;
- Region : TOvcTblRegion;
- begin
- Result := 0;
- Region := CalcRowColFromXY(UR.Left, UR.Top, Row, Col);
- if (Region = otrInUnused) then
- begin
- Result := 2;
- FillChar(GR, sizeof(GR), $FF); {set 'em all to -1}
- Exit;
- end;
- GR.Left := tbFindColInx(Col);
- GR.Top := tbFindRowInx(Row);
- Region := CalcRowColFromXY(UR.Right, UR.Bottom, Row, Col);
- if (Region = otrInUnused) or (Region = otrOutside) then
- Result := 1;
- if (Col = CRCFXY_ColToRight) then
- GR.Right := pred(tbColNums^.Count)
- else
- GR.Right := tbFindColInx(Col);
- if (Row = CRCFXY_RowBelow) then
- GR.Bottom := pred(tbRowNums^.Count)
- else
- GR.Bottom := tbFindRowInx(Row);
- end;
-{--------}
-procedure TOvcCustomTable.tbCalcColData(var CD : POvcTblDisplayArray;
- NewLeftCol : TColNum);
- var
- X : integer;
- Width : integer;
- Access : TOvcTblAccess;
- Hidden : boolean;
- ColNum : TColNum;
- FullWidth : integer;
- PredColCount : TColNum;
- PredLocked : TColNum;
- begin
- {initialise}
- X := 0;
- ColNum := -1;
- CD^.Count := 0;
- FullWidth := ClientWidth; {save expense of function call in loop}
- PredColCount := pred(ColCount); {save expense of function call in loop}
- PredLocked := pred(LockedCols); {save expense of function call in loop}
-
- {deal with the locked columns first}
- if (LockedCols <> 0) then
- while (X < FullWidth) and (ColNum < PredLocked) do
- begin
- inc(ColNum);
- tbQueryColData(ColNum, Width, Access, Hidden);
- if not Hidden then
- begin
- with CD^ do
- begin
- with Ay[Count] do
- begin
- Number := ColNum;
- Offset := X;
- end;
- inc(Count);
- if (Count >= AllocNm) then
- AssignDisplayArray(CD, AllocNm+16);
- end;
- inc(X, Width);
- end;
- end;
-
- {now deal with the rightmost columns}
- ColNum := pred(NewLeftCol);
- while (X < FullWidth) and (ColNum < PredColCount) do
- begin
- inc(ColNum);
- tbQueryColData(ColNum, Width, Access, Hidden);
- if not Hidden then
- begin
- with CD^ do
- begin
- with Ay[Count] do
- begin
- Number := ColNum;
- Offset := X;
- end;
- inc(Count);
- if (Count >= AllocNm) then
- AssignDisplayArray(CD, AllocNm+16);
- end;
- inc(X, Width);
- end;
- end;
-
- {use the next spare element for storing the offset for the grid}
- with CD^ do
- Ay[Count].Offset := X;
- end;
-{--------}
-function TOvcCustomTable.CalcRowColFromXY(X, Y : integer;
- var RowNum : TRowNum;
- var ColNum : TColNum) : TOvcTblRegion;
- var
- ColInx : integer;
- RowInx : integer;
- CW : integer;
- CH : integer;
- TW : integer;
- TH : integer;
- begin
- RowNum := CRCFXY_RowBelow;
- ColNum := CRCFXY_ColToRight;
- CW := ClientWidth;
- CH := ClientHeight;
-
- {calculate the table width and height}
- with tbColNums^ do
- TW := MinI(CW, Ay[Count].Offset);
- with tbRowNums^ do
- TH := MinI(CH, Ay[Count].Offset);
-
- {make a first pass at calculating the region}
- if (X < 0) or (Y < 0) or (X >= CW) or (Y >= CH) then
- Result := otrOutside {definitely}
- else
- Result := otrInMain; {possibly, could also be one of the other two}
-
- {calculate row first}
- with tbRowNums^ do
- if (0 <= Y) and (Y < TH) then
- begin
- RowInx := 0;
- while (Ay[RowInx].Offset <= Y) do
- inc(RowInx);
- RowNum := Ay[pred(RowInx)].Number;
- end;
-
- {now calculate column}
- with tbColNums^ do
- if (0 <= X) and (X < TW) then
- begin
- ColInx := 0;
- while (Ay[ColInx].Offset <= X) do
- inc(ColInx);
- ColNum := Ay[pred(ColInx)].Number;
- end;
-
- {now patch up the region}
- if (Result = otrInMain) then
- if (RowNum = CRCFXY_RowBelow) or (ColNum = CRCFXY_ColToRight) then
- Result := otrInUnused
- else if (RowNum < LockedRows) or (ColNum < LockedCols) then
- Result := otrInLocked;
-
- {now patch up the row and column numbers}
- if (Result = otrOutside) or (Result = otrInUnused) then
- begin
- if (RowNum = CRCFXY_RowBelow) and (Y < 0) then
- RowNum := CRCFXY_RowAbove;
- if (ColNum = CRCFXY_ColToRight) and (X < 0) then
- ColNum := CRCFXY_ColToLeft;
- end;
- end;
-{--------}
-{$IFDEF SuppressWarnings}
-{$Warnings OFF}
-{$ENDIF}
-procedure TOvcCustomTable.tbCalcColsOnLastPage;
- var
- CD : POvcTblDisplayArray;
- OldLeftCol : TColNum;
- NewLeftCol : TColNum;
- StillGoing : boolean;
- begin
- OldLeftCol := 0;
- if (ColCount <= LockedCols) then
- begin
- tbColsOnLastPage := 0;
- Exit;
- end;
-
- CD := nil;
- AssignDisplayArray(CD, tbColNums^.AllocNm);
-
- try
- NewLeftCol := IncCol(pred(ColCount), 0);
- tbCalcColData(CD, NewLeftCol);
- if (CD^.Ay[CD^.Count].Offset > ClientWidth) then
- begin
- tbLastLeftCol := NewLeftCol;
- tbColsOnLastPage := 1;
- Exit;
- end;
-
- StillGoing := true;
- while StillGoing do
- begin
- OldLeftCol := NewLeftCol;
- NewLeftCol := IncCol(NewLeftCol, -1);
- if (NewLeftCol = OldLeftCol) then
- StillGoing := false
- else
- begin
- tbCalcColData(CD, NewLeftCol);
- StillGoing := (CD^.Ay[CD^.Count].Offset < ClientWidth);
- end;
- end;
- tbColsOnLastPage := ColCount - NewLeftCol;
- tbLastLeftCol := OldLeftCol;
- if tbLastLeftCol < LeftCol then
- LeftCol := tbLastLeftCol;
- finally
- AssignDisplayArray(CD, 0);
- end;{try..finally}
- end;
-{$IFDEF SuppressWarnings}
-{$Warnings ON}
-{$ENDIF}
-{--------}
-procedure TOvcCustomTable.tbCalcRowData(var RD : POvcTblDisplayArray;
- NewTopRow : TRowNum);
- var
- Y : integer;
- Height : integer;
- Hidden : boolean;
- RowNum : TRowNum;
- FullHeight : integer;
- PredRowLimit : TRowNum;
- PredLocked : TRowNum;
- begin
- {initialise}
- Y := 0;
- RowNum := -1;
- RD^.Count := 0;
- FullHeight := ClientHeight; {save expense of function call in loop}
- PredRowLimit := pred(RowLimit); {save expense of function call in loop}
- PredLocked := pred(LockedRows); {save expense of function call in loop}
-
- {deal with the locked rows first}
- if (LockedRows <> 0) then
- while (Y < FullHeight) and (RowNum < PredLocked) do
- begin
- inc(RowNum);
- tbQueryRowData(RowNum, Height, Hidden);
- if not Hidden then
- begin
- with RD^ do
- begin
- with Ay[Count] do
- begin
- Number := RowNum;
- Offset := Y;
- end;
- inc(Count);
- if (Count >= AllocNm) then
- AssignDisplayArray(RD, AllocNm+16);
- end;
- inc(Y, Height);
- end;
- end;
-
- {now deal with the rows underneath the fixed rows}
- RowNum := pred(NewTopRow);
- while (Y < FullHeight) and (RowNum < PredRowLimit) do
- begin
- inc(RowNum);
- tbQueryRowData(RowNum, Height, Hidden);
- if not Hidden then
- begin
- with RD^ do
- begin
- with Ay[Count] do
- begin
- Number := RowNum;
- Offset := Y;
- end;
- inc(Count);
- if (Count >= AllocNm) then
- AssignDisplayArray(RD, AllocNm+16);
- end;
- inc(Y, Height);
- end;
- end;
-
- {use the next spare element for storing the offset for the grid}
- with RD^ do
- Ay[Count].Offset := Y;
- end;
-{--------}
-{$IFDEF SuppressWarnings}
-{$Warnings OFF}
-{$ENDIF}
-procedure TOvcCustomTable.tbCalcRowsOnLastPage;
- var
- RD : POvcTblDisplayArray;
- OldTopRow : TRowNum;
- NewTopRow : TRowNum;
- StillGoing : boolean;
- begin
- OldTopRow := 0;
- if (RowLimit <= LockedRows) then
- begin
- tbRowsOnLastPage := 0;
- Exit;
- end;
-
- RD := nil;
- AssignDisplayArray(RD, tbRowNums^.AllocNm);
-
- try
- NewTopRow := IncRow(pred(RowLimit), 0);
- tbCalcRowData(RD, NewTopRow);
- if (RD^.Ay[RD^.Count].Offset >= ClientHeight) then
- begin
- tbLastTopRow := NewTopRow;
- tbRowsOnLastPage := 1;
- Exit;
- end;
-
- StillGoing := true;
- while StillGoing do
- begin
- OldTopRow := NewTopRow;
- NewTopRow := IncRow(OldTopRow, -1);
- if (NewTopRow = OldTopRow) then
- StillGoing := false
- else
- begin
- tbCalcRowData(RD, NewTopRow);
- StillGoing := (RD^.Ay[RD^.Count].Offset < ClientHeight);
- end;
- end;
- tbRowsOnLastPage := RowLimit - OldTopRow;
- tbLastTopRow := OldTopRow;
- if tbLastTopRow < TopRow then
- TopRow := tbLastTopRow;
- finally
- AssignDisplayArray(RD, 0);
- end;{try..finally}
- end;
-{$IFDEF SuppressWarnings}
-{$Warnings ON}
-{$ENDIF}
-{--------}
-procedure TOvcCustomTable.tbCalcHSBarPosCount;
- var
- Col : TColNum;
- begin
- tbHSBarPosCount := 0;
- for Col := LockedCols to tbLastLeftCol do
- if not tbIsColHidden(Col) then
- inc(tbHSBarPosCount);
- end;
-{--------}
-function TOvcCustomTable.tbCalcRequiresVSBar : boolean;
- var
- Row : TRowNum;
- begin
- {a fast check for possible hidden rows: if there are none and the
- last page's top row is not equal to the number of locked rows
- then obviously a vertical scrollbar is required.}
- if (LockedRows < tbLastTopRow) and
- (Rows.Count = 0) then
- begin
- Result := true;
- Exit;
- end;
- {otherwise check to see whether all rows between the locked rows
- and the last page's top row are hidden: if so no vertical scroll
- bar is required.}
- Result := false;
- for Row := LockedRows to pred(tbLastTopRow) do
- if not Rows.Hidden[Row] then
- begin
- Result := true;
- Exit;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.ChangeScale(M, D : integer);
- var
- i : TColNum;
- begin
- inherited ChangeScale(M, D);
- if (M <> D) then
- begin
- Rows.rwScaleHeights(M, D);
- for i := 0 to pred(ColCount) do
- with Columns[i] do
- Width := MulDiv(Width, M, D);
- end;
- end;
-{--------}
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
-function TOvcCustomTable.tbEditCellHasFocus(
- FocusHandle : TOvcHWnd{HWND}) : boolean;
- var
- ChildHandle : HWND;
- begin
- Result := false;
- if not InEditingState then
- Exit;
- if (tbActCell.EditHandle = 0) then
- Exit;
- Result := true;
- if (FocusHandle = tbActCell.EditHandle) then
- Exit;
- ChildHandle := GetWindow(tbActCell.EditHandle, GW_CHILD);
- while (ChildHandle <> 0) do
- begin
- if (FocusHandle = ChildHandle) then
- Exit;
- ChildHandle := GetWindow(ChildHandle, GW_CHILD);
- end;
- Result := false;
- end;
-{--------}
-procedure TOvcCustomTable.tbEnsureColumnIsVisible(ColNum : TColNum);
- var
- ColInx : integer;
- CW : integer;
- FarRight : integer;
- LeftInx : integer;
- LColOfs : integer;
- LColWd : integer;
- begin
- {get the index for the column}
- ColInx := tbFindColInx(ColNum);
- if (ColInx = -1) then
- begin
- {the column is not even visible}
- {make this column the left column}
- LeftCol := ColNum;
- end
- else
- begin
- CW := ClientWidth;
- with tbColNums^ do
- FarRight := Ay[succ(ColInx)].Offset;
- if (FarRight > CW) then
- begin
- {the column is partially visible}
-
- {pretend that we're scrolling the table left
- column by column, until either
- (1) the column we want is fully visible, or
- (2) the column we want is the leftmost column
- then set the leftmost column}
- LeftInx := tbFindColInx(LeftCol);
- LColOfs := tbColNums^.Ay[LeftInx].Offset;
- LColWd := tbColNums^.Ay[succ(LeftInx)].Offset - LColOfs;
- dec(FarRight, LColWd);
- inc(LColOfs, LColWd);
- inc(LeftInx);
- while (LeftInx < ColInx) and (FarRight > CW) do
- begin
- LColWd := tbColNums^.Ay[succ(LeftInx)].Offset - LColOfs;
- dec(FarRight, LColWd);
- inc(LColOfs, LColWd);
- inc(LeftInx);
- end;
- if (LeftInx < tbColNums^.Count) then
- LeftCol := tbColNums^.Ay[LeftInx].Number;
- end;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbEnsureRowIsVisible(RowNum : TRowNum);
- var
- RowInx : integer;
- CH : integer;
- FarBottom: integer;
- TopInx : integer;
- TpRowOfs : integer;
- TpRowHt : integer;
- begin
- RowInx := tbFindRowInx(RowNum);
- if (RowInx = -1) then
- begin
- {the row is not even visible}
- {make this row the top row}
- TopRow := RowNum;
- end
- else
- begin
- CH := ClientHeight;
- with tbRowNums^ do
- FarBottom := Ay[succ(RowInx)].Offset;
- if (FarBottom > CH) then
- begin
- {the row is partially visible}
-
- {pretend that we're scrolling the table up
- row by row, until either
- (1) the row we want is fully visible, or
- (2) the row we want is the topmost row
- then set the topmost row}
- TopInx := tbFindRowInx(TopRow);
- TpRowOfs := tbRowNums^.Ay[TopInx].Offset;
- TpRowHt := tbRowNums^.Ay[succ(TopInx)].Offset - TpRowOfs;
- dec(FarBottom, TpRowHt);
- inc(TpRowOfs, TpRowHt);
- inc(TopInx);
- while (TopInx < RowInx) and (FarBottom > CH) do
- begin
- TpRowHt := tbRowNums^.Ay[succ(TopInx)].Offset - TpRowOfs;
- dec(FarBottom, TpRowHt);
- inc(TpRowOfs, TpRowHt);
- inc(TopInx);
- end;
- if (TopInx < tbRowNums^.Count) then
- TopRow := tbRowNums^.Ay[TopInx].Number;
- end;
- end;
- end;
-{--------}
-function TOvcCustomTable.tbFindCell(RowNum : TRowNum;
- ColNum : TColNum) : TOvcBaseTableCell;
- begin
- Result := FCells[RowNum, ColNum];
- if not Assigned(Result) then
- if (RowNum < LockedRows) then
- Result := FLockedRowsCell
- else
- Result := FCols[ColNum].DefaultCell;
- end;
-{--------}
-function TOvcCustomTable.tbFindColInx(ColNum : TColNum) : integer;
- var
- L, M, R : integer;
- CurNumber : TColNum;
- begin
- Result := -1;
- with tbColNums^ do
- begin
- if (Count = 0) then
- Exit;
- L := 0;
- R := pred(Count);
- repeat
- M := (L + R) div 2;
- CurNumber := Ay[M].Number;
- if (ColNum = CurNumber) then
- begin
- Result := M;
- Exit;
- end
- else if (ColNum < CurNumber) then
- R := pred(M)
- else
- L := succ(M);
- until (L > R);
- end;
- end;
-{--------}
-function TOvcCustomTable.tbFindRowInx(RowNum : TRowNum) : integer;
- var
- L, M, R : integer;
- CurNumber : TRowNum;
- begin
- Result := -1;
- with tbRowNums^ do
- begin
- if (Count = 0) then
- Exit;
- L := 0;
- R := pred(Count);
- repeat
- M := (L + R) div 2;
- CurNumber := Ay[M].Number;
- if (RowNum = CurNumber) then
- begin
- Result := M;
- Exit;
- end
- else if (RowNum < CurNumber) then
- R := pred(M)
- else
- L := succ(M);
- until (L > R);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.GetDisplayedColNums(var NA : TOvcTableNumberArray);
- var
- i : integer;
- WorkCount : integer;
- begin
- WorkCount := MinL(NA.NumElements, tbColNums^.Count);
- for i := 0 to pred(WorkCount) do
- NA.Number[i] := tbColNums^.Ay[i].Number;
- NA.Count := tbColNums^.Count
- end;
-{--------}
-procedure TOvcCustomTable.GetDisplayedRowNums(var NA : TOvcTableNumberArray);
- var
- i : integer;
- WorkCount : integer;
- begin
- WorkCount := MinL(NA.NumElements, tbRowNums^.Count);
- for i := 0 to pred(WorkCount) do
- NA.Number[i] := tbRowNums^.Ay[i].Number;
- NA.Count := tbRowNums^.Count
- end;
-{--------}
-function TOvcCustomTable.IncCol(ColNum : TColNum; Direction : integer) : TColNum;
- {-Return a valid unhidden column number. If Direction is:
- -ve : start at C and find the previous unhidden column number, if there
- is none previous to this one, return C.
- +ve : start at R and find the next unhidden column number, if there is
- none after this one, return C
- 0 : verify that C is unhidden, if not find the next unhidden column
- number, if none after this one, find the previous one. If still
- none, return C.}
- var
- CL, CC : TColNum;
- begin
- {save the values of properties in local variables}
- CL := LockedCols;
- CC := ColCount;
- {adjust ColNum to be in range}
- if (ColNum < CL) or (ColNum >= CC) then
- ColNum := CL;
- {first direction=0, ie to see whether the column is visible}
- Result := ColNum;
- if (Direction = 0) then {check not hidden}
- if not tbIsColHidden(Result) then
- Exit;
- {now direction>=0, ie to increment the column number}
- if (Direction >= 0) then {go forwards}
- begin
- inc(Result);
- while Result < CC do
- begin
- if not tbIsColHidden(Result) then
- Exit;
- inc(Result);
- end;
- Result := ColNum;
- end;
- {now direction<=0, ie to decrement the column number}
- if (Direction <= 0) then {go backwards}
- begin
- dec(Result);
- while (Result >= CL) do
- begin
- if not tbIsColHidden(Result) then
- Exit;
- dec(Result);
- end;
- Result := ColNum;
- end;
- end;
-{--------}
-function TOvcCustomTable.IncRow(RowNum : TRowNum; Direction : integer) : TRowNum;
- {-Return a valid unhidden row number. If Direction is:
- -ve : start at R and find the previous unhidden row number, if there
- is none previous to this one, return R.
- +ve : start at R and find the next unhidden row number, if there is
- none after this one, return R
- 0 : verify that R is unhidden, if not find the next unhidden row
- number, if none after this one, find the previous one. If still
- none, return R.}
- var
- RL, RC : TRowNum;
- begin
- {save the values of properties in local variables}
- RL := LockedRows;
- RC := RowLimit;
- {adjust RowNum to be in range}
- if (RowNum < RL) or (RowNum >= RC) then
- RowNum := RL;
- {first direction=0, ie to see whether the column is visible}
- Result := RowNum;
- if (Direction = 0) then {check not hidden}
- if not tbIsRowHidden(Result) then
- Exit;
- {now direction>=0, ie to increment the column number}
- if (Direction >= 0) then {go forwards}
- begin
- inc(Result);
- while (Result < RC) do
- begin
- if not tbIsRowHidden(Result) then
- Exit;
- inc(Result);
- end;
- Result := RowNum;
- end;
- {now direction<=0, ie to decrement the column number}
- if (Direction <= 0) then {go backwards}
- begin
- dec(Result);
- while (Result >= RL) do
- begin
- if not tbIsRowHidden(Result) then
- Exit;
- dec(Result);
- end;
- Result := RowNum;
- end;
- end;
-{--------}
-function TOvcCustomTable.InEditingState : boolean;
- begin
- Result := (tbState * [otsEditing, otsHiddenEdit]) <> [];
- end;
-{--------}
-function TOvcCustomTable.tbIsColHidden(ColNum : TColNum) : boolean;
- begin
- if (ColNum < 0) or (ColNum >= FCols.Count) then
- Result := True
- else
- Result := FCols[ColNum].Hidden;
- end;
-{--------}
-function TOvcCustomTable.tbIsOnGridLine(MouseX, MouseY : integer;
- var VerticalGrid : boolean) : boolean;
- var
- GridLine : integer;
- Inx : integer;
- LockedColsOffset : integer;
- LockedRowsOffset : integer;
- begin
- Result := false;
- {calc the offsets of the column and row}
- LockedColsOffset := -1;
- Inx := 0;
- with tbColNums^ do
- while (Inx < Count) do
- begin
- if (Ay[Inx].Number >= LockedCols) then
- Break;
- inc(Inx);
- LockedColsOffset := Ay[Inx].Offset;
- end;
- LockedRowsOffset := -1;
- Inx := 0;
- with tbRowNums^ do
- while (Inx < Count) do
- begin
- if (Ay[Inx].Number >= LockedRows) then
- Break;
- inc(Inx);
- LockedRowsOffset := Ay[Inx].Offset;
- end;
- {do the obvious test: cursor is not within the locked area}
- if (MouseX >= LockedColsOffset) and (MouseY >= LockedRowsOffset) then
- Exit;
- {check rows first}
- if (MouseX < LockedColsOffset) then
- begin
- Inx := 0;
- with tbRowNums^ do
- while (Inx < Count) do
- begin
- inc(Inx);
- GridLine := Ay[Inx].Offset;
- if (GridLine-2 <= MouseY) and (MouseY <= GridLine+2) then
- begin
- VerticalGrid := false;
- Result := true;
- tbSizeIndex := pred(Inx);
- Exit;
- end;
- end;
- end;
- {check columns next}
- if (MouseY < LockedRowsOffset) then
- begin
- Inx := 0;
- with tbColNums^ do
- while (Inx < Count) do
- begin
- inc(Inx);
- GridLine := Ay[Inx].Offset;
- if (GridLine-2 <= MouseX) and (MouseX <= GridLine+2) then
- begin
- VerticalGrid := true;
- Result := true;
- tbSizeIndex := pred(Inx);
- Exit;
- end;
- end;
- end;
- end;
-{--------}
-function TOvcCustomTable.tbIsInMoveArea(MouseX, MouseY : integer;
- var IsColMove : boolean) : boolean;
- var
- Inx : integer;
- LockedColsOffset : integer;
- LockedRowsOffset : integer;
- begin
- Result := false;
- IsColMove := false;
- {calc the offsets of the column and row}
- LockedColsOffset := -1;
- Inx := 0;
- with tbColNums^ do
- while (Inx < Count) do
- begin
- if (Ay[Inx].Number >= LockedCols) then
- Break;
- inc(Inx);
- LockedColsOffset := Ay[Inx].Offset;
- end;
- LockedRowsOffset := -1;
- Inx := 0;
- with tbRowNums^ do
- while (Inx < Count) do
- begin
- if (Ay[Inx].Number >= LockedRows) then
- Break;
- inc(Inx);
- LockedRowsOffset := Ay[Inx].Offset;
- end;
- {do the obvious test: cursor is not within the locked area}
- if (MouseX >= LockedColsOffset) and (MouseY >= LockedRowsOffset) then
- Exit;
- {the cursor is within the column move area if it's in a locked cell
- above the main area of the table; otherwise the cursor is within the
- row move area if it's in a locked cell to the left of the main area
- of the table}
- Result := (MouseX >= LockedColsOffset) and (MouseY < LockedRowsOffset) and
- (MouseX < tbColNums^.Ay[tbColNums^.Count].Offset);
- if Result then
- IsColMove := true
- else
- Result := (MouseX < LockedColsOffset) and (MouseY >= LockedRowsOffset) and
- (MouseY < tbRowNums^.Ay[tbRowNums^.Count].Offset);
- end;
-{--------}
-function TOvcCustomTable.tbIsRowHidden(RowNum : TRowNum) : boolean;
- begin
- Result := Rows[RowNum].Hidden;
- end;
-{--------}
-procedure TOvcCustomTable.Notification(AComponent: TComponent; Operation: TOperation);
- begin
- inherited Notification(AComponent, Operation);
- if (AComponent is TOvcBaseTableCell) and (Operation = opRemove) then
- begin
- AllowRedraw := false;
- try
- if (FLockedRowsCell = TOvcBaseTableCell(AComponent)) then
- begin
- FLockedRowsCell.DecRefs;
- FLockedRowsCell := nil;
- tbCellChanged(Self);
- end;
- if Assigned(FCols) then
- FCols.tcNotifyCellDeletion(TOvcBaseTableCell(AComponent));
- if Assigned(FCells) then
- FCells.tcNotifyCellDeletion(TOvcBaseTableCell(AComponent));
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbQueryColData(ColNum : TColNum;
- var W : integer;
- var A : TOvcTblAccess;
- var H : boolean);
- var
- ColData : TOvcTableColumn;
- begin
- ColData := FCols[ColNum];
- if Assigned(ColData) then with ColData do
- begin
- W := Width;
- if (DefaultCell <> nil) then
- A := DefaultCell.Access
- else
- A := otxReadOnly;
- H := Hidden;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbQueryRowData(RowNum : TRowNum;
- var Ht: integer;
- var H : boolean);
- var
- RowData : TRowStyle;
- begin
- RowData := FRows[RowNum];
- with RowData do
- begin
- Ht:= Height;
- H := Hidden;
- end;
- end;
-{--------}
-{$IFNDEF LCL}
-procedure TOvcCustomTable.SetBounds(ALeft, ATop, AWidth, AHeight: integer);
-{$ELSE}
-procedure TOvcCustomTable.DoSetBounds(ALeft, ATop, AWidth, AHeight: integer);
-{$ENDIF}
-// LCL port: Behavior of SetBounds changed in 0.9.29, so using DoSetBounds.
-// http://wiki.lazarus.freepascal.org/Lazarus_0.9.30_release_notes#overriding_TControl.SetBounds
-// Calls to TOvcTable.SetBounds will just be handled by ancestor.
- var
- WidthChanged : boolean;
- HeightChanged : boolean;
- begin
- if (not HandleAllocated) then
- begin
-{$IFNDEF LCL}
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-{$ELSE}
- inherited DoSetBounds(ALeft, ATop, AWidth, AHeight);
-{$ENDIF}
- Exit;
- end;
-
- WidthChanged := (Width <> AWidth);
- HeightChanged := (Height <> AHeight);
-
- if WidthChanged or HeightChanged then
- begin
- AllowRedraw := false;
- try
-{$IFNDEF LCL}
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-{$ELSE}
- inherited DoSetBounds(ALeft, ATop, AWidth, AHeight);
-{$ENDIF}
- if WidthChanged then
- tbCalcColData(tbColNums, LeftCol);
- if HeightChanged then
- tbCalcRowData(tbRowNums, TopRow);
- tbSetScrollRange(otsbVertical);
- tbSetScrollRange(otsbHorizontal);
- if (TopRow > tbLastTopRow) then
- TopRow := tbLastTopRow;
- if (LeftCol > tbLastLeftCol) then
- LeftCol := tbLastLeftCol;
- InvalidateTable;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end
- else
-{$IFNDEF LCL}
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-{$ELSE}
- inherited DoSetBounds(ALeft, ATop, AWidth, AHeight);
-{$ENDIF}
- end;
-{====================================================================}
-
-
-{==TOvcTable active cell movement====================================}
-procedure TOvcCustomTable.tbMoveActCellBotOfPage;
- var
- RowInx : integer;
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- with tbRowNums^ do
- if (Ay[Count].Offset <= ClientHeight) then
- NewActiveRow := IncRow(Ay[pred(Count)].Number, 0)
- else
- begin
- RowInx := pred(Count);
- if (RowInx > 0) then
- dec(RowInx);
- if (Ay[RowInx].Number < LockedRows) then
- NewActiveRow := IncRow(TopRow, 0)
- else
- NewActiveRow := IncRow(Ay[RowInx].Number, 0);
- end;
- NewActiveCol := ActiveCol;
- DoActiveCellMoving(ccBotOfPage, NewActiveRow, NewActiveCol);
- if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellBotRight;
- var
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- NewActiveRow := IncRow(pred(RowLimit), 0);
- NewActiveCol := IncCol(pred(ColCount), 0);
- DoActiveCellMoving(ccBotRightCell, NewActiveRow, NewActiveCol);
- if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellDown;
- var
- NewTopRow : TRowNum;
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- i : integer;
- begin
- NewTopRow := TopRow;
- NewActiveRow := IncRow(ActiveRow, 1);
- NewActiveCol := ActiveCol;
- DoActiveCellMoving(ccDown, NewActiveRow, NewActiveCol);
- if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then
- begin
- {we need to take care of a special case: if the current active
- cell is *exactly* on the last row of the page, we need to
- artificially move the top row down by one, before setting the
- active cell, otherwise the top row is forced to the active cell
- later on--a bit disconcerting.}
- with tbRowNums^ do
- if (Ay[Count].Offset = ClientHeight) and
- (ActiveRow = Ay[pred(Count)].Number) and
- (NewActiveRow > ActiveRow) then
- begin
- for i := 1 to NewActiveRow-ActiveRow do
- NewTopRow := IncRow(TopRow, 1);
- if (NewTopRow < NewActiveRow) then
- begin
- AllowRedraw := False;
- try
- TopRow := NewTopRow;
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- finally
- AllowRedraw := True;
- end;{try..finally}
- end
- else
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end
- else
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellFirstCol;
- var
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- NewActiveCol := IncCol(LockedCols, 0);
- NewActiveRow := ActiveRow;
- DoActiveCellMoving(ccHome, NewActiveRow, NewActiveCol);
- if (ActiveCol <> NewActiveCol) or (ActiveRow <> NewActiveRow) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellFirstRow;
- var
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- NewActiveRow := IncRow(LockedRows, 0);
- NewActiveCol := ActiveCol;
- DoActiveCellMoving(ccFirstPage, NewActiveRow, NewActiveCol);
- if (ActiveRow <> NewActiveRow) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellLastCol;
- var
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- NewActiveCol := IncCol(pred(ColCount), 0);
- NewActiveRow := ActiveRow;
- DoActiveCellMoving(ccEnd, NewActiveRow, NewActiveCol);
- if (ActiveCol <> NewActiveCol) or (ActiveRow <> NewActiveRow) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellLastRow;
- var
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
-// Apparent TurboPower bug: not initializing NewActiveCol.
-// But not sure what it should be set to.
- NewActiveRow := IncRow(pred(RowLimit), 0);
- if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then
- begin
- NewActiveCol := ActiveCol;
- DoActiveCellMoving(ccLastPage, NewActiveRow, NewActiveCol);
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellLeft;
- var
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- NewActiveCol := IncCol(ActiveCol, -1);
- NewActiveRow := ActiveRow;
- DoActiveCellMoving(ccLeft, NewActiveRow, NewActiveCol);
- if (ActiveCol <> NewActiveCol) or (ActiveRow <> NewActiveRow) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellPageDown;
- var
- NewTopRow,
- CurRow, LastRow : TRowNum;
- CurInx, LastInx : integer;
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- CurRow := ActiveRow;
- CurInx := tbFindRowInx(CurRow);
- with tbRowNums^ do
- begin
- LastInx := pred(Count);
- LastRow := Ay[LastInx].Number;
- end;
- if (CurRow = LastRow) then
- NewTopRow := IncRow(LastRow, 1)
- else
- NewTopRow := LastRow;
-
- AllowRedraw := false;
- try
- TopRow := NewTopRow;
-
- if (CurInx = -1) then
- NewActiveRow := IncRow(TopRow, 0)
- else if (CurInx < tbRowNums^.Count) then
- NewActiveRow := IncRow(tbRowNums^.Ay[CurInx].Number, 0)
- else
- NewActiveRow := IncRow(tbRowNums^.Ay[pred(tbRowNums^.Count)].Number, 0);
- NewActiveCol := ActiveCol;
- DoActiveCellMoving(ccNextPage, NewActiveRow, NewActiveCol);
- if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellPageLeft;
- var
- Walker,
- CurLeftCol : TRowNum;
- CurInx : integer;
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- CurLeftCol := LeftCol;
- if (ActiveCol = LeftCol) then
- begin
- Walker := IncCol(CurLeftCol, -1);
- if (Walker = CurLeftCol) then
- Exit;
- end;
- CurInx := tbFindColInx(ActiveCol);
- AllowRedraw := false;
- try
- tbScrollBarPageLeft;
- if (CurInx = -1) or (CurLeftCol = LeftCol) then
- NewActiveCol := IncCol(LeftCol, 0)
- else if (CurInx < tbColNums^.Count) then
- NewActiveCol := IncCol(tbColNums^.Ay[CurInx].Number, 0)
- else
- NewActiveCol := IncCol(tbColNums^.Ay[pred(tbColNums^.Count)].Number, 0);
- NewActiveRow := ActiveRow;
- DoActiveCellMoving(ccPageLeft, NewActiveRow, NewActiveCol);
- if (ActiveCol <> NewActiveCol) or (ActiveRow <> NewActiveRow) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellPageRight;
- var
- NewLeftCol,
- CurCol, LastCol : TColNum;
- CurInx, LastInx : integer;
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- CurCol := ActiveCol;
- CurInx := tbFindColInx(CurCol);
- with tbColNums^ do
- begin
- LastInx := pred(Count);
- LastCol := Ay[LastInx].Number;
- end;
- if (CurCol = LastCol) then
- NewLeftCol := IncCol(LastCol, 1)
- else
- NewLeftCol := LastCol;
-
- AllowRedraw := false;
- try
- LeftCol := NewLeftCol;
-
- if (CurInx = -1) then
- NewActiveCol := IncCol(LeftCol, 0)
- else if (CurInx < tbColNums^.Count) then
- NewActiveCol := IncCol(tbColNums^.Ay[CurInx].Number, 0)
- else
- NewActiveCol := IncCol(tbColNums^.Ay[pred(tbColNums^.Count)].Number, 0);
- NewActiveRow := ActiveRow;
- DoActiveCellMoving(ccPageRight, NewActiveRow, NewActiveCol);
- if (ActiveCol <> NewActiveCol) or (ActiveRow <> NewActiveRow) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellPageUp;
- var
- Walker,
- CurTopRow : TRowNum;
- CurInx : integer;
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- CurTopRow := TopRow;
- if (ActiveRow = TopRow) then
- begin
- Walker := IncRow(CurTopRow, -1);
- if (Walker = CurTopRow) then
- Exit;
- end;
- CurInx := tbFindRowInx(ActiveRow);
- AllowRedraw := false;
- try
- tbScrollBarPageUp;
- if (CurInx = -1) or (CurTopRow = TopRow) then
- NewActiveRow := IncRow(TopRow, 0)
- else if (CurInx < tbRowNums^.Count) then
- NewActiveRow := IncRow(tbRowNums^.Ay[CurInx].Number, 0)
- else
- NewActiveRow := IncRow(tbRowNums^.Ay[pred(tbRowNums^.Count)].Number, 0);
- NewActiveCol := ActiveCol;
- DoActiveCellMoving(ccPrevPage, NewActiveRow, NewActiveCol);
- if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellRight;
- var
- NewActiveRow : TRowNum;
- NewLeftCol,
- NewActiveCol : TColNum;
- i : integer;
- begin
- NewLeftCol := LeftCol;
- NewActiveCol := IncCol(ActiveCol, 1);
- NewActiveRow := ActiveRow;
- DoActiveCellMoving(ccRight, NewActiveRow, NewActiveCol);
- if (ActiveCol <> NewActiveCol) or (ActiveRow <> NewActiveRow) then
- begin
- {we need to take care of a special case: if the current active
- cell is *exactly* on the last column of the page, we need to
- artificially move the leftmost column across by one, before
- setting the active cell, otherwise the leftmost column is
- forced to the active cell later on--a bit disconcerting.}
- with tbColNums^ do
- if (NewActiveCol > ActiveCol) and
- (ActiveCol = Ay[pred(Count)].Number) and
- (Ay[Count].Offset = ClientWidth) then
- begin
- for i := 1 to NewActiveCol-ActiveCol do
- NewLeftCol := IncCol(LeftCol, 1);
- if (NewLeftCol < NewActiveCol) then
- begin
- AllowRedraw := False;
- try
- LeftCol := NewLeftCol;
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- finally
- AllowRedraw := True;
- end;{try..finally}
- end
- else
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol)
- end
- else
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellTopLeft;
- var
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- NewActiveRow := IncRow(LockedRows, 0);
- NewActiveCol := IncCol(LockedCols, 0);
- DoActiveCellMoving(ccTopLeftCell, NewActiveRow, NewActiveCol);
- if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellTopOfPage;
- var
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- NewActiveRow := IncRow(TopRow, 0);
- NewActiveCol := ActiveCol;
- DoActiveCellMoving(ccTopOfPage, NewActiveRow, NewActiveCol);
- if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellUp;
- var
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- NewActiveRow := IncRow(ActiveRow, -1);
- NewActiveCol := ActiveCol;
- DoActiveCellMoving(ccUp, NewActiveRow, NewActiveCol);
- if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.MoveActiveCell(Command : word);
- begin
- if (otoNoSelection in Options) then
- tbIsKeySelecting := false;
-
- case Command of
- {NOTE: this case statement has been optimised, the ccXxx
- constants are in ASCENDING order of value not name--it's
- lucky that the former implies the latter.}
- ccBotOfPage : tbMoveActCellBotOfPage;
- ccBotRightCell : tbMoveActCellBotRight;
- ccDown : tbMoveActCellDown;
- ccEnd : tbMoveActCellLastCol;
- ccFirstPage : tbMoveActCellFirstRow;
- ccHome : tbMoveActCellFirstCol;
- ccLastPage : tbMoveActCellLastRow;
- ccLeft : tbMoveActCellLeft;
- ccNextPage : tbMoveActCellPageDown;
- ccPageLeft : tbMoveActCellPageLeft;
- ccPageRight : tbMoveActCellPageRight;
- ccPrevPage : tbMoveActCellPageUp;
- ccRight : tbMoveActCellRight;
- ccTopLeftCell : tbMoveActCellTopLeft;
- ccTopOfPage : tbMoveActCellTopOfPage;
- ccUp : tbMoveActCellUp;
- end;{case}
- end;
-{====================================================================}
-
-
-{==TOvcTable scrollbar event handlers================================}
-procedure TOvcCustomTable.ProcessScrollBarClick(ScrollBar : TOvcScrollBar;
- ScrollCode : TScrollCode);
- var
- Form : TCustomForm;
- begin
- {check to see whether the cell being edited is valid;
- no scrolling allowed if it isn't (tough).}
- if InEditingState then
- begin
- if not tbActCell.CanSaveEditedData(true) then
- Exit;
- end;
- {perform the scroll}
- if (ScrollBar = otsbVertical) then
- case ScrollCode of
- scLineUp : tbScrollBarUp;
- scLineDown : tbScrollBarDown;
- scPageUp : tbScrollBarPageUp;
- scPageDown : tbScrollBarPageDown;
- end{case}
- else {it's otsbHorizontal}
- case ScrollCode of
- scLineUp : tbScrollBarLeft;
- scLineDown : tbScrollBarRight;
- scPageUp : tbScrollBarPageLeft;
- scPageDown : tbScrollBarPageRight;
- end;{case}
- if (otsDesigning in tbState) then
- begin
- Form := TCustomForm(GetParentForm(Self));
- if (Form <> nil) and (Form.Designer <> nil) then
- Form.Designer.Modified;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbScrollBarDown;
- begin
- TopRow := IncRow(TopRow, 1);
- end;
-{--------}
-procedure TOvcCustomTable.tbScrollBarPageDown;
- var
- LastInx : integer;
- LastRow : TRowNum;
- begin
- with tbRowNums^ do
- begin
- LastInx := pred(Count);
- LastRow := Ay[LastInx].Number;
- end;
- if (TopRow <> LastRow) then
- TopRow := LastRow
- else
- TopRow := IncRow(TopRow, 1);
- end;
-{--------}
-procedure TOvcCustomTable.tbScrollBarPageUp;
- var
- CurTopRow : TRowNum;
- Walker : TRowNum;
- CH : integer;
- OurRowNums: POvcTblDisplayArray;
- NewTopRow : TRowNum;
- begin
- {-Scroll the table so that the current top row appears at
- the bottom of the table window (if possible).}
- CurTopRow := TopRow;
- Walker := IncRow(CurTopRow, -1);
- if (Walker = CurTopRow) then
- Exit;
-
- OurRowNums := nil;
- AssignDisplayArray(OurRowNums, tbRowNums^.AllocNm);
- try
- CH := ClientHeight;
- NewTopRow := Walker;
- tbCalcRowData(OurRowNums, NewTopRow);
- while (OurRowNums^.Ay[OurRowNums^.Count].Offset < CH) or
- (OurRowNums^.Ay[pred(OurRowNums^.Count)].Number > CurTopRow) do
- begin
- Walker := IncRow(NewTopRow, -1);
- if (Walker = NewTopRow) then
- Break;
- NewTopRow := Walker;
- tbCalcRowData(OurRowNums, NewTopRow);
- end;
- finally
- AssignDisplayArray(OurRowNums, 0);
- end;{try..finally}
- TopRow := NewTopRow;
- end;
-{--------}
-procedure TOvcCustomTable.tbScrollBarUp;
- begin
- TopRow := IncRow(TopRow, -1);
- end;
-{--------}
-procedure TOvcCustomTable.tbScrollBarLeft;
- begin
- LeftCol := IncCol(LeftCol, -1);
- end;
-{--------}
-procedure TOvcCustomTable.tbScrollBarPageLeft;
- var
- CurLeftCol : TColNum;
- Walker : TColNum;
- CW : integer;
- OurColNums : POvcTblDisplayArray;
- NewLeftCol : TColNum;
- begin
- CurLeftCol := LeftCol;
- Walker := IncCol(CurLeftCol, -1);
- if (Walker = CurLeftCol) then
- Exit;
-
- OurColNums := nil;
- AssignDisplayArray(OurColNums, tbColNums^.AllocNm);
- try
- CW := ClientWidth;
- NewLeftCol := Walker;
- tbCalcColData(OurColNums, NewLeftCol);
- while (OurColNums^.Ay[OurColNums^.Count].Offset < CW) or
- (OurColNums^.Ay[pred(OurColNums^.Count)].Number > CurLeftCol) do
- begin
- Walker := IncCol(NewLeftCol, -1);
- if (Walker = NewLeftCol) then
- Break;
- NewLeftCol := Walker;
- tbCalcColData(OurColNums, NewLeftCol);
- end;
- finally
- AssignDisplayArray(OurColNums, 0);
- end;{try..finally}
- LeftCol := NewLeftCol;
- end;
-{--------}
-procedure TOvcCustomTable.tbScrollBarPageRight;
- var
- LastInx : integer;
- LastCol : TColNum;
- begin
- with tbColNums^ do
- begin
- LastInx := pred(Count);
- LastCol := Ay[LastInx].Number;
- end;
- if (LeftCol <> LastCol) then
- LeftCol := LastCol
- else
- LeftCol := IncCol(LeftCol, 1);
- end;
-{--------}
-procedure TOvcCustomTable.tbScrollBarRight;
- begin
- LeftCol := IncCol(LeftCol, 1);
- end;
-{====================================================================}
-
-
-{==TOvcTable table scrolling routines================================}
-procedure TOvcCustomTable.tbScrollTableLeft(NewLeftCol : TColNum);
- var
- NewColInx : integer;
- NewCLOfs : integer;
- OldColRight : TColNum;
- OldColInx : integer;
- OldCLOfs : integer;
- ColNum : TColNum;
- R : TRect;
- CW : integer;
- begin
- {the window is scrolled left, ie the new leftmost column
- is to the right of the current leftmost column}
- AllowRedraw := false;
- try
- NewColInx := tbFindColInx(NewLeftCol);
- CW := ClientWidth;
- if (NewColInx = -1) or
- (tbColNums^.Ay[succ(NewColInx)].Offset > CW) then
- begin
- {the new leftmost column is not (fully) visible}
- FLeftCol := NewLeftCol;
- tbCalcColData(tbColNums, LeftCol);
- InvalidateTableNotLockedCols;
- end
- else
- begin
- {the new leftmost column is fully visible}
- OldColInx := tbFindColInx(FLeftCol);
- with tbColNums^ do
- begin
- OldColRight := Ay[pred(Count)].Number;
- if (Ay[Count].Offset < CW) then
- begin
- inc(OldColRight);
- tbInvCells.AddUnusedBit;
- end;
- NewCLOfs := Ay[NewColInx].Offset;
- OldCLOfs := Ay[OldColInx].Offset;
- end;
- R := Rect(OldCLOfs, 0, CW, ClientHeight);
- ScrollWindow(Handle,
- (OldCLOfs-NewCLOfs), 0,
- @R, @R);
- FLeftCol := NewLeftCol;
- tbCalcColData(tbColNums, LeftCol);
-{$IFDEF MSWINDOWS}
- if (OldColRight <= tbColNums^.Ay[pred(tbColNums^.Count)].Number) then
- begin
- tbInvCells.AddUnusedBit;
- for ColNum := OldColRight to tbColNums^.Ay[pred(tbColNums^.Count)].Number do
- InvalidateColumn(ColNum);
- end;
-{$ELSE} //With GTK, ScrollWindow (above) does nothing, so redraw all columns
- InvalidateTableNotLockedCols;
-{$ENDIF}
- R.Left := OldCLOfs + (CW - NewCLOfs);
- ValidateRect(Handle, @R);
- tbMustUpdate := true;
- UpdateWindow(Handle);
- end;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-procedure TOvcCustomTable.tbScrollTableRight(NewLeftCol : TColNum);
- var
- OldLeftCol: TColNum;
- OldColInx : integer;
- OldCLOfs : integer;
- OrigOfs : integer;
- ColNum : TColNum;
- R : TRect;
- begin
- {the window is scrolled right, ie the new leftmost column
- is to the left of the current leftmost column}
- AllowRedraw := false;
- try
- OldLeftCol := FLeftCol;
- OldColInx := tbFindColInx(OldLeftCol);
- OrigOfs := tbColNums^.Ay[OldColInx].Offset;
- FLeftCol := NewLeftCol;
- tbCalcColData(tbColNums, LeftCol);
- OldColInx := tbFindColInx(OldLeftCol);
- if (OldColInx = -1) then
- begin
- {the old leftmost column is no longer visible}
- InvalidateTableNotLockedCols;
- end
- else
- begin
- {the old leftmost column is (partially) visible}
- OldCLOfs := tbColNums^.Ay[OldColInx].Offset;
- R := Rect(OrigOfs, 0, ClientWidth, ClientHeight);
- ScrollWindow(Handle,
- (OldClOfs-OrigOfs), 0,
- @R, @R);
-{$IFDEF MSWINDOWS}
- for ColNum := FLeftCol to pred(OldLeftCol) do
- InvalidateColumn(ColNum);
-{$ELSE} //With GTK, ScrollWindow (above) does nothing, so redraw all columns
- InvalidateTableNotLockedCols;
-{$ENDIF}
- R.Right := OldCLOfs;
- ValidateRect(Handle, @R);
- tbMustUpdate := true;
- UpdateWindow(Handle);
- end;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-procedure TOvcCustomTable.tbScrollTableUp(NewTopRow : TRowNum);
- var
- NewRowInx : integer;
- NewRTOfs : integer;
- OldRowBottom : TRowNum;
- OldRowInx : integer;
- OldRTOfs : integer;
- RowNum : TRowNum;
- R : TRect;
- CH : integer;
- begin
- {the window is scrolled up, ie the new topmost row
- is underneath the current topmost row}
- AllowRedraw := false;
- try
- NewRowInx := tbFindRowInx(NewTopRow);
- CH := ClientHeight;
- if (NewRowInx = -1) or
- (tbRowNums^.Ay[succ(NewRowInx)].Offset > CH) then
- begin
- {the new topmost row is not (fully) visible}
- FTopRow := NewTopRow;
- tbCalcRowData(tbRowNums, TopRow);
- InvalidateTableNotLockedRows;
- end
- else
- begin
- {the new topmost row is fully visible}
- OldRowInx := tbFindRowInx(FTopRow);
- with tbRowNums^ do
- begin
- OldRowBottom := Ay[pred(Count)].Number;
- if (Ay[Count].Offset < CH) then
- begin
- inc(OldRowBottom);
- tbInvCells.AddUnusedBit;
- end;
- NewRTOfs := Ay[NewRowInx].Offset;
- OldRTOfs := Ay[OldRowInx].Offset;
- end;
- R := Rect(0, OldRTOfs, ClientWidth, CH);
- ScrollWindow(Handle,
- 0, (OldRTOfs-NewRTOfs),
- @R, @R);
- FTopRow := NewTopRow;
- tbCalcRowData(tbRowNums, TopRow);
-{$IFDEF MSWINDOWS}
- if (OldRowBottom <= tbRowNums^.Ay[pred(tbRowNums^.Count)].Number) then
- begin
- tbInvCells.AddUnusedBit;
- for RowNum := OldRowBottom to tbRowNums^.Ay[pred(tbRowNums^.Count)].Number do
- InvalidateRow(RowNum);
- end;
-{$ELSE} //With GTK, ScrollWindow (above) does nothing, so redraw all rows
- InvalidateTableNotLockedRows;
-{$ENDIF}
- R.Top := OldRTOfs + (CH - NewRTOfs);
- ValidateRect(Handle, @R);
- tbMustUpdate := true;
- UpdateWindow(Handle);
- end;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-procedure TOvcCustomTable.tbScrollTableDown(NewTopRow : TRowNum);
- var
- OldTopRow : TRowNum;
- OldRowInx : integer;
- OldRTOfs : integer;
- OrigOfs : integer;
- RowNum : TRowNum;
- R : TRect;
- begin
- {the window is scrolled down, ie the new topmost row
- is above the current topmost row}
- AllowRedraw := false;
- try
- OldTopRow := FTopRow;
- OldRowInx := tbFindRowInx(OldTopRow);
- OrigOfs := tbRowNums^.Ay[OldRowInx].Offset;
- FTopRow := NewTopRow;
- tbCalcRowData(tbRowNums, TopRow);
- OldRowInx := tbFindRowInx(OldTopRow);
- if (OldRowInx = -1) then
- begin
- {the old topmost row is no longer visible}
- InvalidateTableNotLockedRows;
- end
- else
- begin
- {the old topmost row is (partially) visible}
- OldRTOfs := tbRowNums^.Ay[OldRowInx].Offset;
- R := Rect(0, OrigOfs, ClientWidth, ClientHeight);
- ScrollWindow(Handle,
- 0, (OldRTOfs-OrigOfs),
- @R, @R);
-{$IFDEF MSWINDOWS}
- for RowNum := FTopRow to pred(OldTopRow) do
- InvalidateRow(RowNum);
-{$ELSE} //With GTK, ScrollWindow (above) does nothing, so redraw all rows
- InvalidateTableNotLockedRows;
-{$ENDIF}
- R.Bottom := OldRTOfs;
- ValidateRect(Handle, @R);
- tbMustUpdate := true;
- UpdateWindow(Handle);
- end;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{====================================================================}
-
-
-{==TOvcTable drawing routines========================================}
-procedure TOvcCustomTable.tbDrawActiveCell;
- var
- RowOfs : integer;
- ColOfs : integer;
- RowInx : integer;
- ColInx : integer;
- Ht : integer;
- Wd : integer;
- ActRowOfs : integer;
- ActRowBottom : integer;
- ActColOfs : integer;
- ActColRight : integer;
- GridPen : TOvcGridPen;
- BrushColor : TColor;
- DrawItFocused: boolean;
- begin
- ActRowOfs := 0;
- ActRowBottom := 0;
- ActColOfs := 0;
- ActColRight := 0;
-
- {Find the cell's row on the screen, exit if not present}
- RowInx := tbFindRowInx(ActiveRow);
- if (RowInx = -1) then Exit;
-
- {Find the cell's column on the screen, exit if not present}
- ColInx := tbFindColInx(ActiveCol);
- if (ColInx = -1) then Exit;
-
- {If we are in editing mode, display the editing control for the
- cell, otherwise, draw the focus box around the cell contents}
- if InEditingState then
- begin
-{$IFDEF MSWINDOWS}
- UpdateWindow(tbActCell.EditHandle); //Not implemented on Gtk/Qt and recurses w/ Carbon
-{$ENDIF}
- end
- else
- begin
- {draw the box round the cell}
- with Canvas do
- begin
- {get the correct grid pen}
- if (otsFocused in tbState) then
- begin
- GridPen := GridPenSet.CellWhenFocused;
- DrawItFocused := true;
- end
- else
- begin
- GridPen := GridPenSet.CellWhenUnfocused;
- DrawItFocused := false;
- end;
- if GridPen.Effect = geNone then
- Exit;
-
- RowOfs := tbRowNums^.Ay[RowInx].Offset;
- Ht := tbRowNums^.Ay[succ(RowInx)].Offset - RowOfs;
- ColOfs := tbColNums^.Ay[ColInx].Offset;
- Wd := tbColNums^.Ay[succ(ColInx)].Offset - ColOfs;
-
- {calculate where to draw the vertical/horizontal lines}
- case GridPenSet.NormalGrid.Effect of
- geNone : begin
- ActRowOfs := RowOfs;
- ActRowBottom := RowOfs+Ht-1;
- ActColOfs := ColOfs;
- ActColRight := ColOfs+Wd-1
- end;
- geVertical : begin
- ActRowOfs := RowOfs;
- ActRowBottom := RowOfs+Ht-1;
- ActColOfs := ColOfs;
- ActColRight := ColOfs+Wd-2;
- end;
- geHorizontal: begin
- ActRowOfs := RowOfs;
- ActRowBottom := RowOfs+Ht-2;
- ActColOfs := ColOfs;
- ActColRight := ColOfs+Wd-1;
- end;
- geBoth : begin
- ActRowOfs := RowOfs;
- ActRowBottom := RowOfs+Ht-2;
- ActColOfs := ColOfs;
- ActColRight := ColOfs+Wd-2;
- end;
- ge3D : begin
- ActRowOfs := RowOfs+1;
- ActRowBottom := RowOfs+Ht-2;
- ActColOfs := ColOfs+1;
- ActColRight := ColOfs+Wd-2;
- end;
- end;{case}
-
- {get the correct background color for the pen}
- if DrawItFocused then
-{$IFNDEF LCL}
- BrushColor := Colors.ActiveFocused
- else BrushColor := Colors.ActiveUnfocused;
-{$ELSE}
- BrushColor := Self.Colors.ActiveFocused
- else BrushColor := Self.Colors.ActiveUnfocused;
-{$ENDIF}
- Brush.Color := Color;
-
-{$IFNDEF LCL}
- Windows.SetBkColor(Handle, ColorToRGB(BrushColor));
-{$ELSE}
- LclIntf.SetBkColor(Handle, ColorToRGB(BrushColor));
-{$ENDIF}
-
- {set up the pen}
- with Pen do
- begin
- Width := 1;
- Style := GridPen.Style;
- Color := GridPen.NormalColor;
- end;
-
- {right line}
- if GridPen.Effect in [geVertical, geBoth, ge3D] then
- begin
- MoveTo(ActColRight, ActRowOfs);
- LineTo(ActColRight, ActRowBottom+1);
- end;
- {bottom line}
- if GridPen.Effect in [geHorizontal, geBoth, ge3D] then
- begin
- MoveTo(ActColOfs, ActRowBottom);
- LineTo(ActColRight+1, ActRowBottom);
- end;
-
- {if in 3D, must change colors}
- if (GridPen.Effect = ge3D) then
- Pen.Color := GridPen.SecondColor;
-
- {left line}
- if GridPen.Effect in [geVertical, geBoth, ge3D] then
- begin
- MoveTo(ActColOfs, ActRowOfs);
- LineTo(ActColOfs, ActRowBottom+1);
- end;
- {top line}
- if GridPen.Effect in [geHorizontal, geBoth, ge3D] then
- begin
- MoveTo(ActColOfs, ActRowOfs);
- LineTo(ActColRight+1, ActRowOfs);
- end;
- end;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbDrawCells(RowInxStart, RowInxEnd : integer;
- ColInxStart, ColInxEnd : integer);
- var
- RowInx : integer;
- begin
- {Delphi bug fix - refresh the canvas handle to force brush to be recreated}
- Canvas.Refresh;
- {draw cells that need it}
-
- if (RowInxStart < 0) or (RowInxEnd < 0) or
- (ColInxStart < 0) or (ColInxEnd < 0) then
- Exit;
-
- with tbRowNums^ do
- for RowInx := RowInxStart to RowInxEnd do
- tbDrawRow(RowInx, ColInxStart, ColInxEnd);
- end;
-{--------}
-procedure TOvcCustomTable.tbDrawInvalidCells(InvCells : TOvcCellArray);
- var
- RowInx : integer;
- ColInx : integer;
- EndColInx : integer;
- CellInx : integer;
- NextCellInx: integer;
- OldRowNum : TRowNum;
- CellAddr : TOvcCellAddress;
- NewCellAddr: TOvcCellAddress;
- EndCol : TColNum;
- ContinueTrying : boolean;
- begin
- if (InvCells.Count > 0) then
- begin
- {Delphi bug fix - refresh the canvas handle to force brush to be recreated}
- Canvas.Refresh;
- {set up for while loop}
- OldRowNum := -1;
- CellInx := 0;
- while (CellInx < InvCells.Count) do
- begin
- InvCells.GetCellAddr(CellInx, CellAddr);
- RowInx := tbFindRowInx(CellAddr.Row);
- if (RowInx <> -1) then
- begin
- ColInx := tbFindColInx(CellAddr.Col);
- if (ColInx <> -1) then
- begin
- {have we switched rows?}
- if (OldRowNum <> CellAddr.Row) then
- OldRowNum := CellAddr.Row;
- {try and get a block of columns}
- EndCol := CellAddr.Col;
- NextCellInx := succ(CellInx);
- ContinueTrying := true;
- while ContinueTrying do
- begin
- if (NextCellInx >= InvCells.Count) then
- ContinueTrying := false
- else
- begin
- InvCells.GetCellAddr(NextCellInx, NewCellAddr);
- if (OldRowNum = NewCellAddr.Row) and
- (NewCellAddr.Col = succ(EndCol)) then
- begin
- EndCol := NewCellAddr.Col;
- inc(NextCellInx);
- end
- else
- ContinueTrying := false;
- end
- end;
- if (EndCol <> CellAddr.Col) then
- begin
- EndColInx := tbFindColInx(EndCol);
- CellInx := pred(NextCellInx);
- {just in case (hidden cols perhaps?)}
- while (EndColInx = -1) do
- begin
- dec(EndCol);
- EndColInx := tbFindColInx(EndCol);
- end
- end
- else
- EndColInx := ColInx;
- tbDrawRow(RowInx, ColInx, EndColInx);
- end;
- end;
- inc(CellInx);
- end;
- end;
- if InvCells.MustDoUnusedBit then
- DoPaintUnusedArea;
- InvCells.Clear;
- end;
-{--------}
-procedure TOvcCustomTable.tbDrawMoveLine;
- var
- OldPen : TPen;
- MoveOffset : integer;
- begin
- if tbDrag <> nil then
- tbDrag.HideDragImage;
- if (otsMoving in tbState) then
- with Canvas do
- begin
- OldPen := TPen.Create;
- try
- OldPen.Assign(Pen);
- try
- Pen.Mode := pmXor;
- Pen.Style := psSolid;
- Pen.Color := clWhite;
- Pen.Width := 3;
- if (otsDoingCol in tbState) then
- begin
- if (tbMoveIndex < tbMoveIndexTo) then
- MoveOffset := tbColNums^.Ay[succ(tbMoveIndexTo)].Offset
- else
- MoveOffset := tbColNums^.Ay[tbMoveIndexTo].Offset;
- MoveTo(MoveOffset, 0);
- LineTo(MoveOffset, ClientHeight);
- end
- else {doing row}
- begin
- if (tbMoveIndex < tbMoveIndexTo) then
- MoveOffset := tbRowNums^.Ay[succ(tbMoveIndexTo)].Offset
- else
- MoveOffset := tbRowNums^.Ay[tbMoveIndexTo].Offset;
- MoveTo(0, MoveOffset);
- LineTo(ClientWidth, MoveOffset);
- end
- finally
- Canvas.Pen := OldPen;
- end;{try..finally}
- finally
- OldPen.Free;
- end;{try..finally}
- end;
- if tbDrag <> nil then
- tbDrag.ShowDragImage;
- end;
-{--------}
-procedure TOvcCustomTable.tbDrawRow(RowInx : integer; ColInxStart, ColInxEnd : integer);
- var
- RowOfs : integer;
- RowHt : integer;
- RowNum : TRowNum;
- ColInx : integer;
- ColNum : TColNum;
- ColOfs : integer;
- ColWd : integer;
- Cell : TOvcBaseTableCell;
- Data : pointer;
- GridPen : TOvcGridPen;
- BrushColor: TColor;
- CellAttr : TOvcCellAttributes;
- DestRect : TRect;
- RowIsLocked : boolean;
- ColIsLocked : boolean;
- IsActiveRow : boolean;
- begin
- {calculate data about the row, tell the user we're entering the row}
- with tbRowNums^ do
- begin
- RowNum := Ay[RowInx].Number;
- RowOfs := Ay[RowInx].Offset;
- RowHt := Ay[succ(RowInx)].Offset - RowOfs;
- end;
- IsActiveRow := ActiveRow = RowNum;
- RowIsLocked := RowNum < LockedRows;
- { Don't fire the OnEnteringRow when we are painting, unless }
- { OldRowColBehavior is true }
- if OldRowColBehavior then
- DoEnteringRow(RowNum);
-
- {set up the cell attribute record}
- FillChar(CellAttr, sizeof(CellAttr), 0);
- CellAttr.caFont := tbCellAttrFont;
-
- {for all required cells}
- for ColInx := ColInxEnd downto ColInxStart do
- begin
- {calculate data about the column, tell the user we're entering the column}
- with tbColNums^ do
- begin
- ColNum := Ay[ColInx].Number;
- ColOfs := Ay[ColInx].Offset;
- ColWd := Ay[succ(ColInx)].Offset - ColOfs;
- end;
- ColIsLocked := (ColNum < LockedCols);
- { Don't fire the OnEnteringCol when we are painting, unless }
- { OldRowColBehavior is true }
- if OldRowColBehavior then
- DoEnteringColumn(ColNum);
-
- {get the gridpen for the cell}
- if (RowIsLocked or ColIsLocked) then
- GridPen := GridPenSet.LockedGrid
- else
- GridPen := GridPenSet.NormalGrid;
-
- {calculate row height/column width available to the cell}
- DestRect := Rect(ColOfs, RowOfs, ColOfs+ColWd, RowOfs+RowHt);
- case GridPen.Effect of
- geVertical : dec(DestRect.Right);
- geHorizontal: dec(DestRect.Bottom);
- geBoth : begin
- dec(DestRect.Right);
- dec(DestRect.Bottom);
- end;
- ge3D : InflateRect(DestRect, -1, -1);
- end;{case}
-
- {don't do painting for the cell being edited}
- Cell := nil;
- if not (IsActiveRow and (ColNum = ActiveCol) and
- (InEditingState)) then
- begin
- {get the cell}
- Cell := tbFindCell(RowNum, ColNum);
- if Assigned(Cell) then begin
- {paint it}
- DoGetCellData(RowNum, ColNum, Data, cdpForPaint);
- CellAttr.caFont.Assign(Font);
- Cell.ResolveAttributes(RowNum, ColNum, CellAttr);
- Cell.Paint(Canvas, DestRect,
- RowNum, ColNum,
- CellAttr,
- Data);
- end;
- end;
-
- {if no cell found or it's the active cell in editing mode
- clear the rectangle}
- if not Assigned(Cell) or
- (IsActiveRow and (ColNum = ActiveCol) and InEditingState) then
- begin
- with CellAttr do
- begin
- caAccess := otxDefault;
- caAdjust := otaDefault;
- caColor := Color;
- caFont.Assign(Font);
- caFontColor := Font.Color;
- end;
- ResolveCellAttributes(RowNum, ColNum, CellAttr);
- Canvas.Brush.Color := CellAttr.caColor;
- Canvas.FillRect(DestRect);
- end;
-
- {Check to see if there is a grid to display}
- if (GridPen.Effect <> geNone) then
- with Canvas do
- begin
- {Get ready to draw the cell's grid}
- BrushColor := Color;
- Brush.Color := BrushColor;
- Pen.Style := GridPen.Style;
- Pen.Width := 1;
-
-{$IFNDEF LCL}
- Windows.SetBkColor(Handle, ColorToRGB(BrushColor));
-{$ELSE}
- LclIntf.SetBkColor(Handle, ColorToRGB(BrushColor));
-{$ENDIF}
-
- {draw the top and left lines, only if required of course}
- if (GridPen.Effect = ge3D) then
- begin
- {set the pen color for the top & left}
- Pen.Color := GridPen.SecondColor;
- {draw the lines}
- MoveTo(ColOfs, pred(RowOfs+RowHt));
- LineTo(ColOfs, RowOfs);
- LineTo(ColOfs+ColWd, RowOfs);
- end;
-
- {set the pen color for the bottom & right}
- Pen.Color := GridPen.NormalColor;
-
- {draw right line}
- if (GridPen.Effect <> geHorizontal) then
- begin
- MoveTo(ColOfs+ColWd-1, RowOfs);
- LineTo(ColOfs+ColWd-1, RowOfs+RowHt);
- end;
-
- {draw bottom line}
- if (GridPen.Effect <> geVertical) then
- begin
- MoveTo(ColOfs, pred(RowOfs+RowHt));
- LineTo(ColOfs+ColWd, pred(RowOfs+RowHt));
- end;
- end;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbDrawSizeLine;
- var
- OldPen : TPen;
- begin
- if (otsSizing in tbState) then
- with Canvas do
- begin
- OldPen := TPen.Create;
- try
- OldPen.Assign(Pen);
- Pen.Color := clBlack;
- Pen.Mode := pmXor;
- Pen.Style := psDot;
- Pen.Width := 1;
- if (otsDoingRow in tbState) then
- begin
- MoveTo(0, tbSizeOffset);
- LineTo(ClientWidth, tbSizeOffset);
- end
- else
- begin
- MoveTo(tbSizeOffset, 0);
- LineTo(tbSizeOffset, ClientHeight);
- end;
- finally
- Canvas.Pen := OldPen;
- OldPen.Free;
- end;{try..finally}
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbDrawUnusedBit;
- var
- R : TRect;
- CR : TRect;
- ChangedBrush : boolean;
- begin
- ChangedBrush := false;
-{$IFNDEF LCL}
- Windows.GetClientRect(Handle, CR);
-{$ELSE}
- LclIntf.GetClientRect(Handle, CR);
-{$ENDIF}
- with R, tbColNums^ do
- begin
- Left := Ay[Count].Offset;
- Right := CR.Right;
- Top := 0;
- Bottom := CR.Bottom;
- end;
- if (R.Left < R.Right) then
- with Canvas do
- begin
- Brush.Color := ColorUnused;
- FillRect(R);
- ChangedBrush := true;
- end;
-
- with R, tbRowNums^ do
- begin
- Right := Left;
- Left := 0;
- Top := Ay[Count].Offset;
- end;
- if (R.Top < R.Bottom) then
- with Canvas do
- begin
- if not ChangedBrush then
- Brush.Color := ColorUnused;
- FillRect(R);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.Paint;
- var
- UR, GR : TRect;
- WhatToPaint : integer;
- RowInx : integer;
- ColInx : integer;
- begin
- {don't do anything if the table is locked from drawing and
- there is no scrolling going on (tbMustUpdate is *only* set in
- the tbScrollTableXxx methods to force an update).}
- if (tbLockCount > 0) and (not tbMustUpdate) then
- begin
- Exit;
- end;
-
- if tbDrag <> nil then
- tbDrag.HideDragImage;
-
-{$IFNDEF LCL}
- Windows.GetClipBox(Canvas.Handle, UR);
-{$ELSE}
- LclIntf.GetClipBox(Canvas.Handle, @UR);
-{$ENDIF}
- WhatToPaint := tbCalcCellsFromRect(UR, GR);
-
- if (WhatToPaint = 0) and
- (otsEditing in tbState) and
- ((GR.Top = ActiveRow) and (GR.Bottom = ActiveRow) and
- (GR.Left = ActiveCol) and (GR.Right = ActiveCol)) then
- Exit;
-
- {if we are actually processing a WM_PAINT message, then paint the
- invalid cells, etc}
- if (tbLockCount = 0) then
- begin
- if (WhatToPaint <> 2) then
- tbDrawCells(GR.Top, GR.Bottom, GR.Left, GR.Right);
-
- if (WhatToPaint <> 0) then
- DoPaintUnusedArea;
-
- tbDrawActiveCell;
- end
- {otherwise we are in the middle of a scroll operation, so just invalidate
- the cells that need it}
- else {tbLockCount > 0, ie tbMustUpdate is true}
- begin
- if (WhatToPaint <> 2) then
- for RowInx := GR.Top to GR.Bottom do
- for ColInx := GR.Left to GR.Right do
- InvalidateCell(tbRowNums^.Ay[RowInx].Number, tbColNums^.Ay[ColInx].Number);
- if (WhatToPaint <> 0) then
- tbInvCells.AddUnusedBit;
- tbMustUpdate := false;
- end;
-
- if tbDrag <> nil then
- tbDrag.ShowDragImage;
-
- end;
-{====================================================================}
-
-
-{==TOvcTable event handlers==========================================}
-procedure TOvcCustomTable.DoActiveCellChanged(RowNum : TRowNum; ColNum : TColNum);
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FActiveCellChanged) then
- FActiveCellChanged(Self, RowNum, ColNum);
- end;
-{--------}
-procedure TOvcCustomTable.DoActiveCellMoving(Command : word;
- var RowNum : TRowNum;
- var ColNum : TColNum);
- begin
- if ((ComponentState * [csLoading, csDestroying]) <> []) then
- Exit;
- if Assigned(FActiveCellMoving) then
- FActiveCellMoving(Self, Command, RowNum, ColNum);
- if InEditingState and ((RowNum <> ActiveRow) or (ColNum <> ActiveCol)) then
- if not StopEditingState(true) then
- begin
- RowNum := ActiveRow;
- ColNum := ActiveCol;
- Exit;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.DoBeginEdit(RowNum : TRowNum; ColNum : TColNum;
- var AllowIt : boolean);
- begin
- if ((ComponentState * [csLoading, csDestroying]) <> []) then
- AllowIt := false
- else
- begin
- AllowIt := true;
- if Assigned(FBeginEdit) then
- FBeginEdit(Self, RowNum, ColNum, AllowIt);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.DoClipboardCopy;
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FClipboardCopy) then
- FClipboardCopy(Self);
- end;
-{--------}
-procedure TOvcCustomTable.DoClipboardCut;
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FClipboardCut) then
- FClipboardCut(Self);
- end;
-{--------}
-procedure TOvcCustomTable.DoClipboardPaste;
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FClipboardPaste) then
- FClipboardPaste(Self);
- end;
-{--------}
-procedure TOvcCustomTable.DoColumnsChanged(ColNum1, ColNum2 : TColNum;
- Action : TOvcTblActions);
- var
- i : integer;
- begin
- for i := 0 to pred(taCellList.Count) do
- if (TOvcTableCellAncestor(taCellList[i]) is TOvcTCColHead) then
- TOvcTCColHead(taCellList[i]).chColumnsChanged(ColNum1, ColNum2, Action);
-
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FColumnsChanged) then
- FColumnsChanged(Self, ColNum1, ColNum2, Action);
- end;
-{--------}
-procedure TOvcCustomTable.DoDoneEdit(RowNum : TRowNum; ColNum : TColNum);
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FDoneEdit) then
- FDoneEdit(Self, RowNum, ColNum);
- end;
-{--------}
-procedure TOvcCustomTable.DoEndEdit(Cell : TOvcBaseTableCell;
- RowNum : TRowNum; ColNum : TColNum;
- var AllowIt : boolean);
- begin
- if ((ComponentState * [csLoading, csDestroying]) <> []) then
- AllowIt := false
- else
- begin
- AllowIt := true;
- if Assigned(FEndEdit) then
- FEndEdit(Self, Cell, RowNum, ColNum, AllowIt);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.DoEnteringColumn(ColNum : TColNum);
- begin
- if (ColNum <> tbLastEntCol) then
- begin
- tbLastEntCol := ColNum;
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FEnteringColumn) then
- FEnteringColumn(Self, ColNum);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.DoEnteringRow(RowNum : TRowNum);
- begin
- if (RowNum <> tbLastEntRow) then
- begin
- tbLastEntRow := RowNum;
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FEnteringRow) then
- FEnteringRow(Self, RowNum);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.DoGetCellAttributes(RowNum : TRowNum; ColNum : TColNum;
- var CellAttr : TOvcCellAttributes);
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FGetCellAttributes) then
- FGetCellAttributes(Self, RowNum, ColNum, CellAttr);
- end;
-{--------}
-procedure TOvcCustomTable.DoGetCellData(RowNum : TRowNum; ColNum : TColNum;
- var Data : pointer;
- Purpose : TOvcCellDataPurpose);
- begin
- Data := nil;
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- HandleAllocated and
- Assigned(FGetCellData) then
- FGetCellData(Self, RowNum, ColNum, Data, Purpose);
- end;
-{--------}
-procedure TOvcCustomTable.DoLeavingColumn(ColNum : TColNum);
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FLeavingColumn) then
- FLeavingColumn(Self, ColNum);
- end;
-{--------}
-procedure TOvcCustomTable.DoLeavingRow(RowNum : TRowNum);
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FLeavingRow) then
- FLeavingRow(Self, RowNum);
- end;
-{--------}
-procedure TOvcCustomTable.DoLockedCellClick(RowNum : TRowNum; ColNum : TColNum);
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FLockedCellClick) then
- FLockedCellClick(Self, RowNum, ColNum);
- end;
-{--------}
-
-procedure TOvcCustomTable.DoOnMouseWheel(Shift : TShiftState; Delta, XPos, YPos : SmallInt);
-begin
- inherited DoOnMouseWheel(Shift, Delta, XPos, YPos);
-
- if (ssCtrl in Shift) then begin
- if (Delta > 0) then
- tbMoveActCellPageUp
- else
- tbMoveActCellPageDown;
- end else begin
- if Delta < 0 then
- MoveActiveCell(ccDown)
- else
- MoveActiveCell(ccUp);
- end;
-end;
-
-procedure TOvcCustomTable.DoPaintUnusedArea;
- begin
- if ((ComponentState * [csLoading, csDestroying]) <> []) then
- Exit;
- if Assigned(FPaintUnusedArea) then
- FPaintUnusedArea(Self)
- else
- tbDrawUnusedBit;
- end;
-{--------}
-procedure TOvcCustomTable.DoRowsChanged(RowNum1, RowNum2 : TRowNum;
- Action : TOvcTblActions);
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FRowsChanged) then
- FRowsChanged(Self, RowNum1, RowNum2, Action);
- end;
-{--------}
-procedure TOvcCustomTable.DoSizeCellEditor(RowNum : TRowNum;
- ColNum : TColNum;
- var CellRect : TRect;
- var CellStyle: TOvcTblEditorStyle);
- begin
- if Assigned(FSizeCellEditor) then
- FSizeCellEditor(Self, RowNum, ColNum, CellRect, CellStyle);
- end;
-{--------}
-procedure TOvcCustomTable.DoTopLeftCellChanged(RowNum : TRowNum; ColNum : TColNum);
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FTopLeftCellChanged) then
- FTopLeftCellChanged(Self, RowNum, ColNum);
- end;
-{--------}
-procedure TOvcCustomTable.DoTopLeftCellChanging(var RowNum : TRowNum;
- var ColNum : TColNum);
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FTopLeftCellChanging) then
- FTopLeftCellChanging(Self, RowNum, ColNum);
- end;
-{--------}
-procedure TOvcCustomTable.DoUserCommand(Cmd : word);
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FUserCommand) then
- FUserCommand(Self, Cmd);
- end;
-{====================================================================}
-
-
-{==TOvcTable Windows Message handlers================================}
-procedure TOvcCustomTable.CMColorChanged(var Msg : TMessage);
- begin
- inherited;
- AllowRedraw := false;
- tbNotifyCellsOfTableChange;
- AllowRedraw := true;
- end;
-{--------}
-{$IFNDEF LCL}
-procedure TOvcCustomTable.CMCtl3DChanged(var Msg : TMessage);
- begin
- if (csLoading in ComponentState) or not HandleAllocated then
- Exit;
-
- if NewStyleControls and (FBorderStyle = bsSingle) then
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
-
- inherited;
- end;
-{$ENDIF}
-{--------}
-procedure TOvcCustomTable.CMDesignHitTest(var Msg : TCMDesignHitTest);
- var
- IsVert : boolean;
- IsColMove : boolean;
- OnGridLine : boolean;
- begin
- Msg.Result := 1;
- if (otsDesigning in tbState) then
- begin
- if ((tbState * [otsSizing, otsMoving]) <> []) then
- Exit;
- Msg.Result := 0;
- OnGridLine := tbIsOnGridLine(Msg.Pos.X, Msg.Pos.Y, IsVert);
- if OnGridLine then
- Msg.Result := 1
- else
- Msg.Result := longint(tbIsInMoveArea(Msg.Pos.X, Msg.Pos.Y, IsColMove));
- end;
- end;
-{--------}
-procedure TOvcCustomTable.CMFontChanged(var Msg : TMessage);
- begin
- inherited;
- AllowRedraw := false;
- tbNotifyCellsOfTableChange;
- AllowRedraw := true;
- end;
-{--------}
-procedure TOvcCustomTable.ctimQueryOptions(var Msg : TMessage);
- begin
-{$IFNDEF LCL}
- Msg.Result := longint(word(FOptions));
-{$ELSE}
-// Msg.Result := longint(FOptions); //this used to compile - not sure what changed in Laz 1.6
- Msg.Result := longint(word(FOptions));
-{$ENDIF}
- end;
-{--------}
-procedure TOvcCustomTable.ctimQueryColor(var Msg : TMessage);
- begin
- Msg.Result := longint(Color);
- end;
-{--------}
-procedure TOvcCustomTable.ctimQueryFont(var Msg : TMessage);
- begin
- Msg.Result := LRESULT(Font); //64
- end;
-{--------}
-procedure TOvcCustomTable.ctimQueryLockedCols(var Msg : TMessage);
- begin
- Msg.Result := longint(LockedCols);
- end;
-{--------}
-procedure TOvcCustomTable.ctimQueryLockedRows(var Msg : TMessage);
- begin
- Msg.Result := longint(LockedRows);
- end;
-{--------}
-procedure TOvcCustomTable.ctimQueryActiveCol(var Msg : TMessage);
- begin
- Msg.Result := longint(ActiveCol);
- end;
-{--------}
-procedure TOvcCustomTable.ctimQueryActiveRow(var Msg : TMessage);
- begin
- Msg.Result := longint(ActiveRow);
- end;
-{--------}
-procedure TOvcCustomTable.ctimRemoveCell(var Msg : TMessage);
- begin
- Notification(TComponent(Msg.LParam), opRemove);
- Msg.Result := 0;
- end;
-{--------}
-procedure TOvcCustomTable.ctimStartEdit(var Msg : TMessage);
- begin
- if not StartEditingState then
- begin
- AllowRedraw := false;
- InvalidateCell(ActiveRow, ActiveCol);
- AllowRedraw := true;
- end;
- Msg.Result := 1;
- end;
-{--------}
-procedure TOvcCustomTable.ctimStartEditMouse(var Msg : TWMMouse);
- begin
- if Assigned(tbActCell) and InEditingState then
- if tbActCell.AcceptActivationClick then
- begin
-{$IFNDEF LCL}
- Windows.SetFocus(tbActCell.EditHandle);
-{$ELSE}
- LclIntf.SetFocus(tbActCell.EditHandle);
-{$ENDIF}
- PostMessage(tbActCell.EditHandle,
- WM_LBUTTONDOWN,
- Msg.Keys, longint(Msg.Pos))
- end;
- Msg.Result := 1;
- end;
-{--------}
-procedure TOvcCustomTable.ctimStartEditKey(var Msg : TWMKey);
- begin
- if Assigned(tbActCell) and InEditingState then
- begin
-{$IFNDEF LCL}
- Windows.SetFocus(tbActCell.EditHandle);
-{$ELSE}
- LclIntf.SetFocus(tbActCell.EditHandle);
-{$ENDIF}
- PostMessage(tbActCell.EditHandle, WM_KEYDOWN, Msg.CharCode, Msg.KeyData);
- end;
- Msg.Result := 1;
- end;
-{--------}
-procedure TOvcCustomTable.ctimLoadDefaultCells(var Msg : TMessage);
- begin
- AllowRedraw := false;
- tbFinishLoadingCellList;
- tbFinishLoadingDefaultCells;
- Msg.Result := 0;
- tbMustFinishLoading := false;
- AllowRedraw := true;
- end;
-{--------}
-procedure TOvcCustomTable.WMCancelMode(var Msg : TMessage);
- begin
- inherited;
- tbIsKeySelecting := false;
- if (otsMouseSelect in tbState) then
- tbState := tbState - [otsMouseSelect] + [otsNormal];
- end;
-{--------}
-procedure TOvcCustomTable.WMEraseBkGnd(var Msg : TWMEraseBkGnd);
- begin
- Msg.Result := 1; {no erasing of the background, we'll do it all}
- end;
-{--------}
-procedure TOvcCustomTable.WMGetDlgCode(var Msg : TMessage);
- begin
- Msg.Result := DLGC_WANTCHARS or DLGC_WANTARROWS;
- if (otoTabToArrow in Options) then
- Msg.Result := Msg.Result or DLGC_WANTTAB;
- end;
-{--------}
-procedure TOvcCustomTable.WMHScroll(var Msg : TWMScroll);
- {------}
- procedure ProcessThumb;
- var
- i : integer;
- NewLeftCol : TColNum;
- begin
- NewLeftCol := LockedCols;
- for i := 0 to pred(Msg.Pos) do
- NewLeftCol := IncCol(NewLeftCol, 1);
- if (NewLeftCol <> LeftCol) then
- LeftCol := NewLeftCol;
- end;
- {------}
- begin
- {ignore SB_ENDSCROLL and SB_THUMBTRACK messages (the latter
- if required to by the Options property): this'll possibly
- avoid multiple validations}
- if (Msg.ScrollCode = SB_ENDSCROLL) or
- ((Msg.ScrollCode = SB_THUMBTRACK) and
- (not (otoThumbTrack in Options))) then
- begin
- inherited;
- Exit;
- end;
- {if not focused then do so; if being designed update the
- table view}
- if (otsUnfocused in tbState) then
-{$IFDEF MSWINDOWS} //Apparently can't focus scroll bar with GTK?
- SetFocus
-{$ENDIF}
- else if (otsDesigning in tbState) then
- Update;
- {check to see whether the cell being edited is valid;
- no scrolling allowed if it isn't (tough).}
- if InEditingState then
- begin
- if not tbActCell.CanSaveEditedData(true) then
- Exit;
- end;
- {process the scrollbar message}
- case Msg.ScrollCode of
- SB_LINELEFT : ProcessScrollBarClick(otsbHorizontal, scLineUp);
- SB_LINERIGHT : ProcessScrollBarClick(otsbHorizontal, scLineDown);
- SB_PAGELEFT : ProcessScrollBarClick(otsbHorizontal, scPageUp);
- SB_PAGERIGHT : ProcessScrollBarClick(otsbHorizontal, scPageDown);
- SB_THUMBPOSITION : ProcessThumb;
- SB_THUMBTRACK : if (otoThumbTrack in Options) then ProcessThumb;
- else
- inherited;
- Exit;
- end;
- Msg.Result := 0;
- end;
-{--------}
-procedure TOvcCustomTable.WMKeyDown(var Msg : TWMKey);
- var
- Cmd : word;
- ShiftFlags : byte;
- begin
- inherited;
-
- {If Tab key is being converted to arrow key, do it}
- if (otoTabToArrow in Options) and (Msg.CharCode = VK_TAB) then
- begin
- {get shift value}
- ShiftFlags := GetShiftFlags;
- {convert Tab combination to command}
- if (ShiftFlags = 0) then
- Cmd := ccRight
- else if (ShiftFlags = ss_Shift) then
- Cmd := ccLeft
- else
- Cmd := ccNone;
- end
- {If Enter key is being converted to right arrow, do it.}
- else if (otoEnterToArrow in Options) and (Msg.CharCode = VK_RETURN) then
- begin
- {get shift value}
- ShiftFlags := GetShiftFlags;
- {convert Enter combination to command}
- if (ShiftFlags = 0) then
- Cmd := ccRight
- else
- Cmd := ccNone;
- end
- {Otherwise just translate into a command}
- else
- Cmd := Controller.EntryCommands.TranslateUsing([tbCmdTable^], TMessage(Msg));
-
- if InEditingState then
- begin
- if (not (otoAlwaysEditing in Options)) and
- ((Cmd = ccTableEdit) or (Msg.CharCode = VK_ESCAPE)) then
- begin
- if not StopEditingState(Msg.CharCode <> VK_ESCAPE) then
- begin
- inherited;
- Exit;
- end;
- end
- end
- else {not editing}
- if (Cmd = ccTableEdit) or
- ((Cmd > ccLastCmd) and (Cmd < ccUserFirst) and
- ((Msg.CharCode = VK_SPACE) or
- ((VK_0 <= Msg.CharCode) and (Msg.CharCode <= VK_DIVIDE)) or
- (Msg.CharCode >= $BA))) then
- begin
- PostMessage(Handle, ctim_StartEdit, 0, 0);
- if (Cmd <> ccTableEdit) then
- PostMessage(Handle, ctim_StartEditKey, Msg.CharCode, Msg.KeyData);
- end;
-
- tbIsKeySelecting := false;
- case Cmd of
- ccBotOfPage, ccBotRightCell,
- ccDown, ccEnd,
- ccFirstPage, ccHome,
- ccLastPage, ccLeft,
- ccNextPage, ccPageLeft,
- ccPageRight, ccPrevPage,
- ccRight, ccTopLeftCell,
- ccTopOfPage, ccUp : MoveActiveCell(Cmd);
- ccExtendDown : begin tbIsKeySelecting := true; MoveActiveCell(ccDown); end;
- ccExtendEnd : begin tbIsKeySelecting := true; MoveActiveCell(ccEnd); end;
- ccExtendHome : begin tbIsKeySelecting := true; MoveActiveCell(ccHome); end;
- ccExtendLeft : begin tbIsKeySelecting := true; MoveActiveCell(ccLeft); end;
- ccExtendPgDn : begin tbIsKeySelecting := true; MoveActiveCell(ccNextPage); end;
- ccExtendPgUp : begin tbIsKeySelecting := true; MoveActiveCell(ccPrevPage); end;
- ccExtendRight : begin tbIsKeySelecting := true; MoveActiveCell(ccRight); end;
- ccExtendUp : begin tbIsKeySelecting := true; MoveActiveCell(ccUp); end;
- ccExtBotOfPage : begin tbIsKeySelecting := true; MoveActiveCell(ccBotOfPage); end;
- ccExtFirstPage : begin tbIsKeySelecting := true; MoveActiveCell(ccFirstPage); end;
- ccExtLastPage : begin tbIsKeySelecting := true; MoveActiveCell(ccLastPage); end;
- ccExtTopOfPage : begin tbIsKeySelecting := true; MoveActiveCell(ccTopOfPage); end;
- ccExtWordLeft : begin tbIsKeySelecting := true; MoveActiveCell(ccWordLeft); end;
- ccExtWordRight : begin tbIsKeySelecting := true; MoveActiveCell(ccWordRight); end;
- ccCopy : DoClipboardCopy;
- ccCut : DoClipboardCut;
- ccPaste : DoClipboardPaste;
- else
- if (Cmd >= ccUserFirst) then
- DoUserCommand(Cmd);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.WMKillFocus(var Msg : TWMKillFocus);
- begin
- inherited;
-
- if (otsEditing in tbState) then
- begin
- Exit;
- end;
-
- AllowRedraw := false;
- try
- InvalidateCell(ActiveRow, ActiveCol);
- tbState := tbState - [otsFocused] + [otsUnfocused];
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-procedure TOvcCustomTable.WMLButtonDblClk(var Msg : TWMMouse);
- var
- Row : TRowNum;
- Col : TColNum;
- Region : TOvcTblRegion;
- begin
- inherited;
- if not (otsDesigning in tbState) then
- begin
- Region := CalcRowColFromXY(Msg.XPos, Msg.YPos, Row, Col);
- if Region = (otrInMain) then
- begin
- PostMessage(Handle, ctim_StartEdit, Msg.Keys, longint(Msg.Pos));
- PostMessage(Handle, ctim_StartEditMouse, Msg.Keys, longint(Msg.Pos));
- end;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.WMLButtonDown(var Msg : TWMMouse);
- var
- Row : TRowNum;
- Col : TColNum;
- Action : TOvcTblSelectionType;
- Region : TOvcTblRegion;
- R : TRect;
- P : TPoint;
- ShiftKeyDown : boolean;
- CtrlKeyDown : boolean;
- AllowDrag : boolean;
- WasUnfocused : boolean;
- begin
- inherited;
-
- {are we currently unfocused? if so focus the table}
- WasUnfocused := false;
- if (otsUnfocused in tbState) then
- begin
- WasUnfocused := true;
- AllowRedraw := false;
- try
- {note: by the time SetFocus returns WMSetFocus will have been called}
- SetFocus;
- {..to get round an MDI bug..}
- if not Focused then
-{$IFNDEF LCL}
- Windows.SetFocus(Handle);
-{$ELSE}
- LclIntf.SetFocus(Handle);
-{$ENDIF}
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-
- {are we currently showing a sizing cursor? if so the user wants to
- resize a column/row}
- if (otsShowSize in tbState) then
- begin
- tbState := tbState - [otsShowSize] + [otsSizing];
- if (otsDoingRow in tbState) then
- begin
- if (Msg.YPos >= tbRowNums^.Ay[tbSizeIndex].Offset+6) then
- tbSizeOffset := Msg.YPos;
- tbDrawSizeLine;
- end
- else {we're sizing a column}
- begin
- if (Msg.XPos >= tbColNums^.Ay[tbSizeIndex].Offset+6) then
- tbSizeOffset := Msg.XPos;
- tbDrawSizeLine;
- end;
- Exit;
- end;
-
- {are we currently showing a row/col move cursor? if so the user wants
- to move that row/col}
- if (otsShowMove in tbState) then
- begin
- tbState := tbState - [otsShowMove] + [otsMoving];
- {work out the row/column we're in}
- CalcRowColFromXY(Msg.XPos, Msg.YPos, Row, Col);
- if (otsDoingCol in tbState) then begin
- tbMoveIndex := tbFindColInx(Col);
- R.Left := ColOffset[Col];
- R.Right := MinI(ClientWidth, R.Left + Columns[Col].Width);
- R.Top := RowOffset[0];
- R.Bottom := RowOffset[1];
- end else begin{doing row}
- tbMoveIndex := tbFindRowInx(Row);
- R.Top := RowOffset[Row];
- R.Bottom := RowOffset[Row + 1];
- R.Bottom := MinI(ClientHeight, R.Top + Rows[Row].Height);
- R.Left := ColOffset[0];
- R.Right := ColOffset[1];
- end;
-
- R.TopLeft := ClientToScreen(R.TopLeft);
- R.BottomRight := ClientToScreen(R.BottomRight);
-
- P := ClientToScreen(Point(Msg.XPos, Msg.YPos));
-
- tbDrag := TOvcDragShow.Create(P.x, P.y, R, clBtnFace);
-
- tbMoveIndexTo := tbMoveIndex;
- tbDrawMoveLine;
- Exit;
- end;
-
- {are we focused and do we allow selections? if so be prepared to start or
- extend the current selection (note that AlwaysEditing will be false)}
- if (otsFocused in tbState) and (not (otoNoSelection in Options)) then
- begin
- {if we are editing a cell then stop editing it now (if possible)}
- if InEditingState then
- begin
-{$IFNDEF LCL}
- Windows.SetFocus(tbActCell.EditHandle);
-{$ELSE}
- LclIntf.SetFocus(tbActCell.EditHandle);
-{$ENDIF}
- end;
- {get the state of the shift & ctrl keys}
- ShiftKeyDown := (Msg.Keys and MK_SHIFT) <> 0;
- CtrlKeyDown := (Msg.Keys and MK_CONTROL) <> 0;
- {calculate where the mouse button was pressed}
- Region := CalcRowColFromXY(Msg.XPos, Msg.YPos, Row, Col);
- case Region of
- otrInMain :
- {the mouse was clicked in the main area}
- begin
- AllowRedraw := false;
- try
- AllowDrag := true;
- {confirm the new active cell}
- DoActiveCellMoving(ccMouse, Row, Col);
- {if neither shift nor control are down, or control is
- down on its own, we have to reset the anchor point}
- if (not ShiftKeyDown) then
- begin
- if CtrlKeyDown then
- Action := tstAdditional
- else
- begin
- Action := tstDeselectAll;
- {if the active cell hasn't changed (ie the user
- clicked on the active cell, must start editing}
- if (ActiveRow = Row) and (ActiveCol = Col) and
- not WasUnfocused then
- begin
- PostMessage(Handle, ctim_StartEdit, 0, 0);
- PostMessage(Handle, ctim_StartEditMouse,
- Msg.Keys, longint(Msg.Pos));
- AllowDrag := false;
- end;
- end;
- tbSetAnchorCell(Row, Col, Action);
- end
- {if the shift key is down then the user is either extending
- the last selection only (control is up) or the last
- selection in addition to the other selections (control is
- down); extend the selection}
- else {shift key is down}
- begin
- if CtrlKeyDown then
- Action := tstAdditional
- else
- begin
- Action := tstDeselectAll;
- tbIsSelecting := true;
- end;
- tbUpdateSelection(Row, Col, Action);
- end;
- {now set the active cell}
- tbSetActiveCellPrim(Row, Col);
- finally
- AllowRedraw := true;
- end;{try..finally}
- {until we get a mouse up message we are selecting with
- the mouse (if we're allowed to, that is)}
- if (otoMouseDragSelect in Options) and AllowDrag then
- tbState := tbState - [otsNormal] + [otsMouseSelect];
- end;
- otrInLocked :
- begin
- {the mouse was clicked on a locked cell}
- if InEditingState then
- if not StopEditingState(true) then
- Exit;
- AllowRedraw := false;
- try
- if (otoRowSelection in Options) and (Row >= LockedRows) then
- tbSelectRow(Row);
- if (otoColSelection in Options) and (Col >= LockedCols) then
- tbSelectCol(Col);
- if (otoRowSelection in Options) and (otoColSelection in Options) and
- (Row < LockedRows) and (Col < LockedCols) then
- tbSelectTable;
- finally
- AllowRedraw := true;
- end;{try..finally}
- if (otsNormal in tbState) then
- DoLockedCellClick(Row, Col);
- end;
- otrInUnused :
- begin
- {clicking in the unused area deselects all selections}
- if InEditingState then
- if not StopEditingState(true) then
- Exit;
-
- {move to new location}
- if (Row = CRCFXY_RowBelow) then
- Row := IncRow(pred(RowLimit), 0);
- if (Col = CRCFXY_ColToRight) then
- Col := IncCol(pred(ColCount), 0);
-
- {if row or col should changed, notify and doit}
- if (Col <> ActiveCol) or (Row <> ActiveRow) then begin
- DoActiveCellMoving(ccNone, Row, Col);
- tbSetAnchorCell(Row, Col, tstDeselectAll);
- tbSetActiveCellPrim(Row, Col);
- end;
- end;
- end;{case}
- Exit;
- end;
-
- {are we focused? (and selections are not allowed)}
- if (otsFocused in tbState) then
- if ((tbState * [otsNormal, otsEditing, otsHiddenEdit]) <> []) then
- begin
- Region := CalcRowColFromXY(Msg.XPos, Msg.YPos, Row, Col);
- case Region of
- otrInMain :
- begin
- if InEditingState then
-{$IFNDEF LCL}
- Windows.SetFocus(tbActCell.EditHandle);
-{$ELSE}
- LclIntf.SetFocus(tbActCell.EditHandle);
-{$ENDIF}
- AllowRedraw := false;
- try
- DoActiveCellMoving(ccMouse, Row, Col);
- if not (otoAlwaysEditing in Options) then
- if (ActiveRow = Row) and (ActiveCol = Col) and
- not WasUnfocused then
- begin
- PostMessage(Handle, ctim_StartEdit, 0, 0);
- PostMessage(Handle, ctim_StartEditMouse,
- Msg.Keys, longint(Msg.Pos));
- end;
- tbSetActiveCellPrim(Row, Col);
- finally
- AllowRedraw := true;
- end;{try..finally}
- PostMessage(Handle, ctim_StartEditMouse,
- Msg.Keys, longint(Msg.Pos));
- end;
- otrInLocked :
- if (otsNormal in tbState) then
- DoLockedCellClick(Row, Col);
- end;{case}
- Exit;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.WMLButtonUp(var Msg : TWMMouse);
- var
- Form : TForm;
- ColNum : TColNum;
- ColFrom : TColNum;
- ColTo : TColNum;
- RowNum : TRowNum;
- RowFrom : TRowNum;
- RowTo : TRowNum;
- DoingCol: boolean;
- begin
- inherited;
-
- if tbDrag <> nil then begin
- tbDrag.Free;
- tbDrag := nil;
- end;
-
- if (otsMouseSelect in tbState) then
- begin
- {tbIsSelecting := false;}
- tbState := tbState - [otsMouseSelect] + [otsNormal];
- Exit;
- end;
-
- if (otsSizing in tbState) then
- begin
- tbDrawSizeLine;
- AllowRedraw := false;
- try
- if (otsDoingRow in tbState) then
- begin
- if (tbSizeOffset < tbRowNums^.Ay[tbSizeIndex].Offset+6) then
- tbSizeOffset := tbRowNums^.Ay[tbSizeIndex].Offset+6;
- FRows.Height[tbRowNums^.Ay[tbSizeIndex].Number] :=
- tbSizeOffset - tbRowNums^.Ay[tbSizeIndex].Offset;
- if Assigned(OnResizeRow) then
- OnResizeRow(Self, tbRowNums^.Ay[tbSizeIndex].Number,
- FRows.Height[tbRowNums^.Ay[tbSizeIndex].Number]);
- end
- else
- begin
- if (tbSizeOffset < tbColNums^.Ay[tbSizeIndex].Offset+6) then
- tbSizeOffset := tbColNums^.Ay[tbSizeIndex].Offset+6;
- FCols[tbColNums^.Ay[tbSizeIndex].Number].Width :=
- tbSizeOffset - tbColNums^.Ay[tbSizeIndex].Offset;
- if Assigned(OnResizeColumn) then
- OnResizeColumn(Self, tbColNums^.Ay[tbSizeIndex].Number,
- FCols[tbColNums^.Ay[tbSizeIndex].Number].Width);
- end;
-// Apparent TurboPower bug: otsDoingRow appears twice in set. Probably second
-// otsDoingRow should be otsDoingCol (see otsMoving code below).
-// tbState := tbState - [otsSizing, otsDoingRow, otsDoingRow] + [otsNormal];
- tbState := tbState - [otsSizing, otsDoingRow, otsDoingCol] + [otsNormal]; //Fixed
- if (otsDesigning in tbState) then
- begin
- Form := TForm(GetParentForm(Self));
- if (Form <> nil) and (Form.Designer <> nil) then
- Form.Designer.Modified;
- end;
- InvalidateTable;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-
- if (otsMoving in tbState) then
- begin
- tbDrawMoveLine;
- DoingCol := otsDoingCol in tbState;
- tbState := tbState - [otsMoving, otsDoingRow, otsDoingCol] + [otsNormal];
- if (tbMoveIndex <> tbMoveIndexTo) then
- begin
- AllowRedraw := false;
- try
- if DoingCol then
- begin
- ColFrom := tbColNums^.Ay[tbMoveIndex].Number;
- ColTo := tbColNums^.Ay[tbMoveIndexTo].Number;
- if (ColTo > ColFrom) then
- for ColNum := ColFrom to pred(ColTo) do
- Columns.Exchange(ColNum, succ(ColNum))
- else
- for ColNum := pred(ColFrom) downto ColTo do
- Columns.Exchange(ColNum, succ(ColNum));
- if ActiveCol = ColFrom then
- ActiveCol := ColTo
- else if (ColTo > ColFrom) then begin
- if (ColFrom < ActiveCol) and (ActiveCol <= ColTo) then
- ActiveCol := IncCol(ActiveCol, -1);
- end
- else begin
- if (ColTo <= ActiveCol) and (ActiveCol < ColFrom) then
- ActiveCol := IncCol(ActiveCol, +1);
- end;
- end
- else {doing rows}
- begin
- RowFrom := tbRowNums^.Ay[tbMoveIndex].Number;
- RowTo := tbRowNums^.Ay[tbMoveIndexTo].Number;
- if (RowTo > RowFrom) then
- for RowNum := RowFrom to pred(RowTo) do
- Rows.Exchange(RowNum, succ(RowNum))
- else
- for RowNum := pred(RowFrom) downto RowTo do
- Rows.Exchange(RowNum, succ(RowNum));
- if ActiveRow = RowFrom then
- ActiveRow := RowTo
- else if (RowTo > RowFrom) then begin
- if (RowFrom < ActiveRow) and (ActiveRow <= RowTo) then
- ActiveRow := IncRow(ActiveRow, -1);
- end
- else begin
- if (RowTo <= ActiveRow) and (ActiveRow < RowFrom) then
- ActiveRow := IncRow(ActiveRow, +1);
- end;
- end;
- finally
- AllowRedraw := true;
- end;{try..finally}
- if (otsDesigning in tbState) then
- begin
- Form := TForm(GetParentForm(Self));
- if (Form <> nil) and (Form.Designer <> nil) then
- Form.Designer.Modified;
- end;
- end;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.WMMouseMove(var Msg : TWMMouse);
- var
- Row : TRowNum;
- Col : TColNum;
- NewMoveIndexTo : integer;
- Region : TOvcTblRegion;
- Action : TOvcTblSelectionType;
- P : TPoint;
- begin
- inherited;
-
- if tbDrag <> nil then begin
- P := ClientToScreen(Point(Msg.XPos, Msg.YPos));
- tbDrag.DragMove(P.x, P.y);
- end;
-
- if (otsMouseSelect in tbState) then
- begin
- Region := CalcRowColFromXY(Msg.XPos, Msg.YPos, Row, Col);
- if (Region = otrOutside) or (Region = otrInUnused) then
- begin
- if (Row = CRCFXY_RowAbove) then
- Row := IncRow(ActiveRow, -1)
- else if (Row = CRCFXY_RowBelow) then
- with tbRowNums^ do
- Row := MinL(pred(RowLimit), succ(Ay[pred(Count)].Number));
- if (Col = CRCFXY_ColToLeft) then
- Col := IncCol(ActiveCol, -1)
- else if (Col = CRCFXY_ColToRight) then
- with tbColNums^ do
- Col := MinI(pred(ColCount), succ(Ay[pred(Count)].Number));
- end
- else if (Region = otrInLocked) then
- begin
- if (Row < LockedRows) then
- Row := IncRow(ActiveRow, -1);
- if (Col < LockedCols) then
- Col := IncCol(ActiveCol, -1);
- end;
- DoActiveCellMoving(ccMouse, Row, Col);
- if (Row = ActiveRow) and (Col = ActiveCol) then
- Exit; {there's nothing to do, just moved within cell}
- if ((Msg.Keys and MK_CONTROL) <> 0) then
- Action := tstAdditional
- else
- begin
- Action := tstDeselectAll;
- tbIsSelecting := true;
- end;
- AllowRedraw := false;
- try
- tbUpdateSelection(Row, Col, Action);
- tbSetActiveCellPrim(Row, Col);
- finally
- AllowRedraw := true;
- end;{try..finally}
- Exit;
- end;
-
- if (otsSizing in tbState) then
- begin
- tbDrawSizeLine;
- if (otsDoingRow in tbState) then
- begin
- if (Msg.YPos >= tbRowNums^.Ay[tbSizeIndex].Offset+6) then
- tbSizeOffset := Msg.YPos;
- end
- else
- begin
- if (Msg.XPos >= tbColNums^.Ay[tbSizeIndex].Offset+6) then
- tbSizeOffset := Msg.XPos;
- end;
- tbDrawSizeLine;
- Exit;
- end;
-
- if (otsMoving in tbState) then
- begin
- CalcRowColFromXY(Msg.XPos, Msg.YPos, Row, Col);
- if (otsDoingCol in tbState) then
- begin
- if (Col >= LockedCols) then
- begin
- NewMoveIndexTo := tbFindColInx(Col);
- if (NewMoveIndexTo <> tbMoveIndexTo) then
- begin
- tbDrawMoveLine;
- tbMoveIndexTo := NewMoveIndexTo;
- tbDrawMoveLine;
- end;
- end;
- end
- else {we're moving rows}
- begin
- if (Row >= LockedRows) then
- begin
- NewMoveIndexTo := tbFindRowInx(Row);
- if (NewMoveIndexTo <> tbMoveIndexTo) then
- begin
- tbDrawMoveLine;
- tbMoveIndexTo := NewMoveIndexTo;
- tbDrawMoveLine;
- end;
- end;
- end;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.WMNCHitTest(var Msg : TMessage);
- begin
- if (otsDesigning in tbState) then
- DefaultHandler(Msg)
- else
- inherited;
- end;
-{--------}
-procedure TOvcCustomTable.WMSetCursor(var Msg : TWMSetCursor);
- var
- CurMousePos : TPoint;
- NewCursor : HCursor;
- IsVert : boolean;
- IsColMove : boolean;
- OnGridLine : boolean;
- InMoveArea : boolean;
- begin
- {ignore non client hit tests, let our ancestor deal with it}
- if (Msg.HitTest <> HTCLIENT) then
- begin
- inherited;
- if ((tbState * [otsShowSize, otsShowMove]) <> []) then
- tbState := tbState - [otsShowSize, otsShowMove, otsDoingRow, otsDoingCol]
- + [otsNormal];
- Exit;
- end;
-
- {if the table is unfocused or we are editing, let our ancestor deal with it}
- if (otsUnfocused in tbState) or InEditingState then
- begin
- inherited;
- Exit;
- end;
-
- {get the mouse cursor position in terms of the table client area}
- GetCursorPos(CurMousePos);
- CurMousePos := ScreenToClient(CurMousePos);
- {work out whether the cursor is over a grid line or on the column
- move area; take into account whether such definitions are allowed}
- OnGridLine := tbIsOnGridLine(CurMousePos.X, CurMousePos.Y, IsVert);
- if OnGridLine then
- if IsVert then
- OnGridLine := (not (otoNoColResizing in Options)) or
- (otsDesigning in tbState)
- else
- OnGridLine := (not (otoNoRowResizing in Options)) or
- (otsDesigning in tbState);
- InMoveArea := false;
- if (not OnGridLine) and
- ((otoAllowColMoves in Options) or (otoAllowRowMoves in Options) or
- (otsDesigning in tbState)) then
- begin
- InMoveArea := tbIsInMoveArea(CurMousePos.X, CurMousePos.Y, IsColMove);
- if InMoveArea then
- if IsColMove then
- InMoveArea := otoAllowColMoves in Options
- else
- InMoveArea := otoAllowRowMoves in Options;
- end;
- {now set the cursor}
- if InMoveArea then
- begin
- if IsColMove then
- begin
- NewCursor := tbColMoveCursor;
- tbState := tbState - [otsNormal, otsShowSize, otsDoingRow]
- + [otsShowMove, otsDoingCol];
- end
- else {row move}
- begin
- NewCursor := tbRowMoveCursor;
- tbState := tbState - [otsNormal, otsShowSize, otsDoingCol]
- + [otsShowMove, otsDoingRow];
- end;
- end
- else if OnGridLine then
- if IsVert then
- begin
- NewCursor := Screen.Cursors[crHSplit];
- tbState := tbState - [otsNormal, otsShowMove, otsDoingRow]
- + [otsShowSize, otsDoingCol];
- end
- else
- begin
- NewCursor := Screen.Cursors[crVSplit];
- tbState := tbState - [otsNormal, otsShowMove, otsDoingCol]
- + [otsShowSize, otsDoingRow];
- end
- else
- begin
- NewCursor := Screen.Cursors[Cursor];
- tbState := tbState - [otsShowMove, otsShowSize, otsDoingRow, otsDoingCol]
- + [otsNormal];
- end;
-{$IFNDEF LCL}
- SetCursor(NewCursor);
-{$ELSE}
- LclIntf.SetCursor(NewCursor); {Don't call control's SetCursor!}
-{$ENDIF}
-
- Msg.Result := 1;
- end;
-{--------}
-procedure TOvcCustomTable.WMSetFocus(var Msg : TWMSetFocus);
- begin
- inherited;
-
- if (otsEditing in tbState) then
- begin
- if tbEditCellHasFocus(Msg.FocusedWnd) then
- GetParentForm(Self).Perform(WM_NEXTDLGCTL, 1, 0)
- else
-{$IFNDEF LCL}
- Windows.SetFocus(tbActCell.EditHandle);
-{$ELSE}
- LclIntf.SetFocus(tbActCell.EditHandle);
-{$ENDIF}
- Exit;
- end;
-
- if (otsFocused in tbState) then
- Exit;
-
- AllowRedraw := false;
- try
- InvalidateCell(ActiveRow, ActiveCol);
- tbState := tbState - [otsUnfocused] + [otsFocused];
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-
-procedure TOvcCustomTable.WMVScroll(var Msg : TWMScroll);
-
- procedure ProcessThumb;
- var
- Divisor : LongInt;
- begin
- if (Msg.Pos <> TopRow) then
- begin
- if RowLimit < (16*1024) then
- TopRow := Msg.Pos
- else if Msg.Pos = LockedRows then
- TopRow := LockedRows
- else begin
- if (RowLimit > (16*1024)) then
- Divisor := Succ(RowLimit div $400)
- else
- Divisor := Succ(RowLimit div $40);
- if (Msg.Pos = RowLimit div Divisor) then
- TopRow := pred(RowLimit)
- else
- TopRow := Msg.Pos * Divisor;
- end;
- end;
- end;
-
-begin
- if ProcessingVScrollMessage then
- Exit;
- ProcessingVScrollMessage := true;
- try
- {ignore SB_ENDSCROLL and SB_THUMBTRACK messages (the latter
- if required to by the Options property): this'll possibly
- avoid multiple validations}
- if (Msg.ScrollCode = SB_ENDSCROLL) or
- ((Msg.ScrollCode = SB_THUMBTRACK) and
- (not (otoThumbTrack in Options))) then
- begin
- inherited;
- Exit;
- end;
- {if we're not focused then do so; if we're being designed
- update the table view}
- if (otsUnFocused in tbState) then
-{$IFDEF MSWINDOWS}
- SetFocus //Apparently can't focus scroll bar with GTK?
-{$ENDIF}
- else if (otsDesigning in tbState) then
- Update;
- {check to see whether the cell being edited is valid;
- no scrolling allowed if it isn't (tough).}
- if InEditingState then
- begin
- if not tbActCell.CanSaveEditedData(true) then
- Exit;
- end;
- {process the scrollbar message}
- case Msg.ScrollCode of
- SB_LINEUP : ProcessScrollBarClick(otsbVertical, scLineUp);
- SB_LINEDOWN : ProcessScrollBarClick(otsbVertical, scLineDown);
- SB_PAGEUP : ProcessScrollBarClick(otsbVertical, scPageUp);
- SB_PAGEDOWN : ProcessScrollBarClick(otsbVertical, scPageDown);
- SB_THUMBPOSITION : ProcessThumb;
- SB_THUMBTRACK : if (otoThumbTrack in Options) then ProcessThumb;
- else
- inherited;
- Exit;
- end;
- Msg.Result := 0;
- finally
- ProcessingVScrollMessage := false;
- end;
-end;
-{====================================================================}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/66/66ef732ca2f39d8a81e305ab410bc0f66ebdcd43.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/66/66ef732ca2f39d8a81e305ab410bc0f66ebdcd43.svn-base
deleted file mode 100644
index 57ac782f..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/66/66ef732ca2f39d8a81e305ab410bc0f66ebdcd43.svn-base
+++ /dev/null
@@ -1,21 +0,0 @@
-program Project1;
-
-uses
-{$IFDEF LCL}
- Interfaces,
- {$IFDEF UNIX}
- clocale,
- {$ENDIF}
-{$ENDIF}
- Forms,
- Unit1 in 'Unit1.pas' {Form1};
-
-{$IFDEF MSWINDOWS}
-{$R *.res}
-{$ENDIF}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/67/6783c0ee851e6d137610cd43ba0e2fab798c6d27.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/67/6783c0ee851e6d137610cd43ba0e2fab798c6d27.svn-base
deleted file mode 100644
index 85396d64..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/67/6783c0ee851e6d137610cd43ba0e2fab798c6d27.svn-base
+++ /dev/null
@@ -1,51 +0,0 @@
-object frmSaveScheme: TfrmSaveScheme
- Left = 347
- Top = 298
- BorderStyle = bsDialog
- Caption = 'Save Style'
- ClientHeight = 85
- Height = 85
- ClientWidth = 348
- Width = 348
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- OnCreate = FormCreate
- PixelsPerInch = 96
- object Label1: TLabel
- Left = 4
- Top = 8
- Width = 85
- Height = 13
- Caption = 'Save this style as:'
- end
- object SchemeNameEd: TEdit
- Left = 4
- Top = 24
- Width = 341
- Height = 21
- MaxLength = 255
- TabOrder = 0
- end
- object OkBtn: TButton
- Left = 192
- Top = 56
- Width = 75
- Height = 25
- Caption = 'OK'
- Default = True
- ModalResult = 1
- TabOrder = 1
- end
- object CancelBtn: TButton
- Left = 272
- Top = 56
- Width = 75
- Height = 25
- Cancel = True
- Caption = 'Cancel'
- ModalResult = 2
- TabOrder = 2
- end
-end
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/67/67d351b6134edda67a758831df11f68e0e485e50.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/67/67d351b6134edda67a758831df11f68e0e485e50.svn-base
deleted file mode 100644
index 6db3f7bd..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/67/67d351b6134edda67a758831df11f68e0e485e50.svn-base
+++ /dev/null
@@ -1,812 +0,0 @@
-{*********************************************************}
-{* OVCTCMMN.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 ovctcmmn;
- {-Orpheus table: common unit}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- SysUtils, Graphics, Forms, StdCtrls, Classes, Controls,
- OvcBase, OvcData, OvcExcpt;
-
-{---Enumeration types}
-type
- TOvcTblAdjust = ( {data adjustment in cell}
- otaDefault, {the default for the next higher class}
- otaTopLeft, {top left hand corner}
- otaTopCenter, {top, centered horizontally}
- otaTopRight, {top right hand corner}
- otaCenterLeft, {left hand side, centered vertically}
- otaCenter, {centered vertically and horizontally}
- otaCenterRight, {right hand side, centered vertically}
- otaBottomLeft, {bottom left hand corner}
- otaBottomCenter, {bottom, centered horizontally}
- otaBottomRight); {bottom right hand corner}
-
- TOvcTblAccess = ( {cell access types}
- otxDefault, {the default for the next higher class}
- otxNormal, {read & write}
- otxReadOnly, {read only, no write}
- otxInvisible); {no read or write, ie invisible}
-
- TOvcTblState = ( {grid states}
- {..Major}
- otsFocused, { focused, or cell being edited}
- otsUnfocused, { unfocused}
- otsDesigning, { being designed}
- {..Minor}
- otsNormal, { normal}
- otsEditing, { cell being edited}
- otsHiddenEdit, { ditto, however currently hidden}
- otsMouseSelect, { mouse is selecting}
- otsShowSize, { row/col sizing cursor shown}
- otsSizing, { row/col being resized}
- otsShowMove, { row/col move cursor shown}
- otsMoving, { row/col is being moved}
- {..Qualifiers}
- otsDoingRow, { moving/sizing a row}
- otsDoingCol, { moving/sizing a column}
-
- otsANOther);
- TOvcTblStates = set of TOvcTblState;
-
- TOvcTblKeyNeeds = ( {grid's requirements for keystrokes}
- otkDontCare, {grid does not need key}
- otkWouldLike, {grid would like key, but cell can take it}
- otkMustHave); {grid must have key}
-
- TOvcTblRegion = ( {table regions}
- otrInMain, {..main table area}
- otrInLocked, {..locked row or col area}
- otrInUnused, {..unused bit}
- otrOutside); {..outside table client area}
-
- TOvcTblOption = ( {table options}
- otoBrowseRow, {Highlight row when browsing}
- otoNoRowResizing, {No run-time row resizing allowed}
- otoNoColResizing, {No run-time column resizing allowed}
- otoTabToArrow, {Tab moves cell to right, ShiftTab left}
- otoEnterToArrow, {Enter stops editing and moves cell right}
- otoAlwaysEditing, {Edit mode is always active}
- otoNoSelection, {No run-time selection allowed}
- otoMouseDragSelect, {dragging with mouse selects}
- otoRowSelection, {clicking on row header selects entire row}
- otoColSelection, {clicking on column header selects entire column}
- otoThumbTrack, {Scrollbar thumb-tracking}
- otoAllowColMoves, {Enable column moves}
- otoAllowRowMoves); {Enable row moves}
- TOvcTblOptionSet = set of TOvcTblOption;
-
- TOvcScrollBar = ( {scroll bar identifiers}
- otsbVertical, {..the vertical one}
- otsbHorizontal); {..the horizontal one}
-
- TOvcTblActions = ( {configuration actions on rows/columns}
- taGeneral, {..general}
- taSingle, {..changing a single row/column}
- taAll, {..changing all rows/columns}
- taInsert, {..inserting a row/column}
- taDelete, {..deleting a row/column}
- taExchange); {..exchanging two rows/columns}
-
- TOvcCellDataPurpose = ( {OnGetCellData data request purpose}
- cdpForPaint, {..for painting}
- cdpForEdit, {..for editing}
- cdpForSave); {..for saving an edited data}
-
- TOvcTextStyle = ( {text painting styles}
- tsFlat, {..flat}
- tsRaised, {..raised look}
- tsLowered); {..lowered look}
-
- TOvcTblSelectionType = ( {Internal selection type}
- tstDeselectAll, {..deselect all selections}
- tstAdditional); {..additional selection/deselection}
-
- TOvcTblEditorStyle = ( {Table's cell editor style}
- tesNormal, {..normal (ie nothing special)}
- tesBorder, {..with border}
- tes3D); {..3D look}
-
-{---Row/Column number (index) types}
-type
- TRowNum = longint; {actually 0..2 billion}
- TColNum = integer; {actually 0..16K}
-
-{---record types for cells---}
-type
- PCellBitMapInfo = ^TCellBitMapInfo;
- TCellBitMapInfo = packed record
- BM : TBitMap; {bitmap object to display}
- Count : integer; {number of glyphs}
- ActiveCount : integer; {number of active glyphs}
- Index : integer; {index of glyph to display}
- end;
-
- PCellComboBoxInfo = ^TCellComboBoxInfo;
- TCellComboBoxInfo = packed record
- Index : integer; {index into Items list}
- {$IFDEF CBuilder}
- case integer of
- 0 : (St : array[0..255] of char);
- 1 : (RTItems : TStrings;
- RTSt : array[0..255] of char);
- {$ELSE}
- case integer of
- 0 : (St : ShortString); {string value if Index = -1}
- 1 : (RTItems : TStrings; {run-time items list}
- RTSt : ShortString); {run-time string value if Index = -1}
- {$ENDIF}
- end;
-
- TOvcCellAttributes = packed record {display attributes for a cell}
- caAccess : TOvcTblAccess; {..access rights}
- caAdjust : TOvcTblAdjust; {..data adjustment}
- caColor : TColor; {..background color}
- caFont : TFont; {..text font}
- caFontColor : TColor; {..text color}
- caFontHiColor : TColor; {..text highlight color}
- caTextStyle : TOvcTextStyle; {..text style}
- end;
-
-
-{---Table cell ancestor---}
- TOvcTableCellAncestor = class(TComponent)
- protected {private}
- {.Z+}
- FOnCfgChanged : TNotifyEvent;
- {.Z-}
- protected
- {.Z+}
- procedure tcChangeScale(M, D : integer); dynamic;
- procedure tcDoCfgChanged;
- {.Z-}
- public {protected}
- {.Z+}
- procedure tcResetTableValues; virtual; abstract;
- property OnCfgChanged : TNotifyEvent
- write FOnCfgChanged;
- {.Z-}
- public
- end;
-
-{---Table ancestor---}
-
- TOvcTableAncestor = class(TO32CustomControl)
- protected {private}
- FController : TOvcController;
- taCellList : TList;
- taLoadList : TStringList;
-
- function ControllerAssigned : Boolean;
- procedure SetController(Value : TOvcController); virtual;
-
- protected
- procedure CreateWnd;
- override;
- procedure Notification(AComponent : TComponent; Operation : TOperation);
- override;
-
- {streaming routines}
- procedure ChangeScale(M, D : integer); override;
- procedure DefineProperties(Filer : TFiler); override;
- procedure Loaded; override;
-
- procedure tbFinishLoadingCellList;
- procedure tbReadCellData(Reader : TReader);
- procedure tbWriteCellData(Writer : TWriter);
-
- procedure tbCellChanged(Sender : TObject); virtual; abstract;
-
- public {protected}
- {internal use only methods}
- procedure tbExcludeCell(Cell : TOvcTableCellAncestor);
- procedure tbIncludeCell(Cell : TOvcTableCellAncestor);
- procedure tbNotifyCellsOfTableChange;
-
- public
- constructor Create(AOwner : TComponent); override;
- destructor Destroy; override;
-
- property Controller : TOvcController
- read FController
- write SetController;
-
- function FilterKey(var Msg : TWMKey) : TOvcTblKeyNeeds; virtual; abstract;
- procedure ResolveCellAttributes(RowNum : TRowNum; ColNum : TColNum;
- var CellAttr : TOvcCellAttributes); virtual; abstract;
- end;
-
-type
- POvcSparseAttr = ^TOvcSparseAttr;
-{attributes for cells in sparse matrix--INTERNAL USE}
- TOvcSparseAttr = packed record
- scaAccess : TOvcTblAccess;
- scaAdjust : TOvcTblAdjust;
- scaColor : TColor;
- scaFont : TFont;
- scaCell : TOvcTableCellAncestor;
- end;
-
- POvcTableNumberArray = ^TOvcTableNumberArray;
-{structure passed to GetDisplayedRow(Col)Numbers}
- TOvcTableNumberArray = packed record
- NumElements : longint; {..number of elements in Number array}
- Count : longint; {..return count of used elements in Number array}
- Number : array [0..29] of longint; {..Number array}
- end;
-
-{---Row style type}
-type
- PRowStyle = ^TRowStyle;
- TRowStyle = packed record
- Height : Integer; {-1 means default}
- Hidden : boolean;
- end;
-
-{---Short string type (length-byte string)}
-type
- POvcShortString = ^ShortString; {pointer to shortstring}
-
-{---Exception classes}
-type
- EOrpheusTable = class(Exception);
-
-{---Notification events}
-type
- TRowNotifyEvent = procedure (Sender : TObject; RowNum : TRowNum) of object;
- TColNotifyEvent = procedure (Sender : TObject; ColNum : TColNum) of object;
- TColResizeEvent = procedure ( Sender: TObject; ColNum : TColNum;
- NewWidth: Integer) of object;
- TRowResizeEvent = procedure ( Sender: TObject; RowNum : TRowNum;
- NewHeight: Integer) of object;
- TCellNotifyEvent = procedure (Sender : TObject;
- RowNum : TRowNum; ColNum : TColNum) of object;
- TCellDataNotifyEvent = procedure (Sender : TObject;
- RowNum : TRowNum; ColNum : TColNum;
- var Data : pointer;
- Purpose : TOvcCellDataPurpose) of object;
- TCellAttrNotifyEvent = procedure (Sender : TObject;
- RowNum : TRowNum; ColNum : TColNum;
- var CellAttr : TOvcCellAttributes) of object;
- TCellPaintNotifyEvent = procedure (Sender : TObject;
- TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer;
- var DoneIt : boolean) of object;
- TCellBeginEditNotifyEvent = procedure (Sender : TObject;
- RowNum : TRowNum; ColNum : TColNum;
- var AllowIt : boolean) of object;
- TCellEndEditNotifyEvent = procedure (Sender : TObject;
- Cell : TOvcTableCellAncestor;
- RowNum : TRowNum; ColNum : TColNum;
- var AllowIt : boolean) of object;
- TCellMoveNotifyEvent = procedure (Sender : TObject; Command : word;
- var RowNum : TRowNum;
- var ColNum : TColNum) of object;
- TCellChangeNotifyEvent = procedure (Sender : TObject;
- var RowNum : TRowNum;
- var ColNum : TColNum) of object;
- TRowChangeNotifyEvent = procedure (Sender : TObject; RowNum1, RowNum2 : TRowNum;
- Action : TOvcTblActions) of object;
- TColChangeNotifyEvent = procedure (Sender : TObject; ColNum1, ColNum2 : TColNum;
- Action : TOvcTblActions) of object;
- TSizeCellEditorNotifyEvent = procedure (Sender : TObject;
- RowNum : TRowNum;
- ColNum : TColNum;
- var CellRect : TRect;
- var CellStyle: TOvcTblEditorStyle) of object;
- TSelectionIterator = function(RowNum1 : TRowNum; ColNum1 : TColNum;
- RowNum2 : TRowNum; ColNum2 : TColNum;
- ExtraData : pointer) : boolean of object;
-
-
-{---Cell-Table interaction messages---}
-const
- ctim_Base = WM_USER + $4545;
- ctim_QueryOptions = ctim_Base;
- ctim_QueryColor = ctim_Base + 1;
- ctim_QueryFont = ctim_Base + 2;
- ctim_QueryLockedCols = ctim_Base + 3;
- ctim_QueryLockedRows = ctim_Base + 4;
- ctim_QueryActiveCol = ctim_Base + 5;
- ctim_QueryActiveRow = ctim_Base + 6;
-
- ctim_RemoveCell = ctim_Base + 10;
- ctim_StartEdit = ctim_Base + 11;
- ctim_StartEditMouse = ctim_Base + 12;
- ctim_StartEditKey = ctim_Base + 13;
-
- ctim_SetFocus = ctim_Base + 14;
- ctim_KillFocus = ctim_Base + 15;
-
- ctim_LoadDefaultCells = ctim_Base + 20;
-
-{---Property defaults}
-const
- tbDefAccess = otxNormal;
- tbDefAdjust = otaCenterLeft;
- tbDefBorderStyle = bsSingle;
- tbDefColCount = 10;
- tbDefColWidth = 150;
- tbDefGridColor = clBlack;
- tbDefHeight = 100;
- tbDefLockedCols = 1;
- tbDefLockedRows = 1;
- tbDefMargin = 4;
- tbDefRowCount = 10;
- tbDefRowHeight = 30;
- tbDefScrollBars = ssBoth;
- tbDefTableColor = clBtnFace;
- tbDefWidth = 300;
-
-{---Default color for cells (to force them to table color)}
-const
- clOvcTableDefault = $2FFFFFF;
-
-{---Handy extra constants for table's CalcRowColFromXY method}
-const
- CRCFXY_RowAbove = -2; {Y is above all table cells}
- CRCFXY_RowBelow = -1; {Y is below all table cells}
- CRCFXY_ColToLeft = -2; {X is to left of all table cells}
- CRCFXY_ColToRight = -1; {X is to right of all table cells}
-
-{---Handy extra constants for TRowNum variables, Row Heights}
-const
- RowLimitChanged = -2;
- UseDefHt = -1;
-
-type {internal use only}
- TOvcTblDisplayItem = packed record
- Number : longint;
- Offset : Integer;
- end;
- POvcTblDisplayArray = ^TOvcTblDisplayArray;
- TOvcTblDisplayArray = packed record
- AllocNm : word;
- Count : word;
- Ay : array [0..127] of TOvcTblDisplayItem; {127 is arbitrary}
- end;
-
-{--Utility routines}
-function MinI(X, Y : Integer) : Integer;
- {Return the minimum of two integers}
-function MaxI(X, Y : Integer) : Integer;
- {Return the maximum of two integers}
-function MaxL(A, B : longint) : longint;
-function MinL(A, B : longint) : longint;
-
-function MakeRowStyle(AHeight : Integer; AHidden : boolean) : TRowStyle;
- {-Make a row style variable from a height and hidden flag.}
-
-procedure TableError(const Msg : string);
- {-Raise an exception with supplied string}
-procedure TableErrorRes(StringCode : word);
- {-Raise an exception with supplied string resource code}
-
-procedure AssignDisplayArray(var A : POvcTblDisplayArray; Num : word);
- {-Table internal: (re)assign a display array}
-
-implementation
-
-{===Standard routines================================================}
-{$IFDEF NoAsm}
-function MinI(X, Y : Integer) : Integer;
-begin
- if X < Y then
- Result := X
- else
- Result := Y;
-end;
-
-function MaxI(X, Y : Integer) : Integer;
-begin
- if X >= Y then
- Result := X
- else
- Result := Y;
-end;
-
-{$ELSE}
-function MinI(X, Y : Integer) : Integer;
- {Return the minimum of two integers}
-asm
- cmp eax, edx
- jle @@Exit
- mov eax, edx
-@@Exit:
-end;
-{--------}
-function MaxI(X, Y : Integer) : Integer;
- {Return the maximum of two integers}
-asm
- cmp eax, edx
- jge @@Exit
- mov eax, edx
-@@Exit:
-end;
-{$ENDIF}
-{--------}
-procedure TableError(const Msg : string);
- begin
- raise EOrpheusTable.Create(Msg);
- end;
-{--------}
-procedure TableErrorRes(StringCode : word);
- begin
- raise EOrpheusTable.Create(GetOrphStr(StringCode));
- end;
-{--------}
-function MaxL(A, B : longint) : longint;
- begin
- if (A < B) then Result := B else Result := A;
- end;
-{--------}
-function MinL(A, B : longint) : longint;
- begin
- if (A < B) then Result := A else Result := B;
- end;
-{--------}
-procedure AssignDisplayArray(var A : POvcTblDisplayArray; Num : word);
- var
- NewA : POvcTblDisplayArray;
- NumToXfer : word;
- begin
- NewA := nil;
- if (Num > 0) then
- begin
- GetMem(NewA, Num*sizeof(TOvcTblDisplayItem)+2*sizeof(word));
- {$IFOPT D+}
- FillChar(NewA^, Num*sizeof(TOvcTblDisplayItem)+2*sizeof(word), $CC);
- {$ENDIF}
- if Assigned(A) then
- begin
- NumToXfer := MinL(Num, A^.Count);
- if (NumToXfer > 0) then
- Move(A^.Ay, NewA^.Ay, NumToXFer*sizeof(TOvcTblDisplayItem));
- end
- else
- NumToXfer := 0;
- with NewA^ do
- begin
- AllocNm := Num;
- Count := NumToXfer;
- end;
- end;
- if Assigned(A) then
- FreeMem(A, A^.AllocNm*sizeof(TOvcTblDisplayItem)+2*sizeof(word));
- A := NewA;
- end;
-{--------}
-function MakeRowStyle(AHeight : Integer; AHidden : boolean) : TRowStyle;
- begin
- with Result do
- begin
- Height := AHeight;
- Hidden := AHidden;
- end;
- end;
-{====================================================================}
-
-
-{===TOvcTableCellAncestor============================================}
-procedure TOvcTableCellAncestor.tcChangeScale(M, D : integer);
- begin
- {do nothing at this level in the cell component hierarchy}
- end;
-{--------}
-procedure TOvcTableCellAncestor.tcDoCfgChanged;
- begin
- if Assigned(FOnCfgChanged) then
- FOnCfgChanged(Self);
- end;
-{====================================================================}
-
-
-{===TOvcTableAncestor================================================}
-constructor TOvcTableAncestor.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
- taCellList := TList.Create;
- end;
-{--------}
-destructor TOvcTableAncestor.Destroy;
- begin
- taLoadList.Free;
- taCellList.Free;
- inherited Destroy;
- end;
-{--------}
-
-function TOvcTableAncestor.ControllerAssigned : Boolean;
-begin
- Result := Assigned(FController);
-end;
-
-procedure TOvcTableAncestor.CreateWnd;
-var
- OurForm : TWinControl;
-
-begin
- OurForm := GetImmediateParentForm(Self);
-
- {do this only when the component is first dropped on the form, not during loading}
- if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
- ResolveController(OurForm, FController);
-
- if not Assigned(FController) and not (csLoading in ComponentState) then begin
- {try to find a controller on this form that we can use}
- FController := FindController(OurForm);
-
- {if not found and we are not designing, use default controller}
- if not Assigned(FController) and not (csDesigning in ComponentState) then
- FController := DefaultController;
- end;
-
- inherited CreateWnd;
-end;
-
-procedure TOvcTableAncestor.Notification(AComponent : TComponent; Operation : TOperation);
-begin
- inherited Notification(AComponent, Operation);
-
- if Operation = opRemove then begin
- if (AComponent = FController) then
- FController := nil;
- end else if (Operation = opInsert) and (FController = nil) and
- (AComponent is TOvcController) then
- FController := TOvcController(AComponent);
-end;
-
-procedure TOvcTableAncestor.SetController(Value : TOvcController);
-begin
- FController := Value;
- if Value <> nil then
- Value.FreeNotification(Self);
-end;
-
-procedure TOvcTableAncestor.ChangeScale(M, D : integer);
- var
- i : integer;
- begin
- inherited ChangeScale(M, D);
- if (M <> D) then
- for i := 0 to pred(taCellList.Count) do
- TOvcTableCellAncestor(taCellList[i]).tcChangeScale(M, D);
- end;
-{--------}
-procedure TOvcTableAncestor.DefineProperties(Filer : TFiler);
- begin
- inherited DefineProperties(Filer);
- Filer.DefineProperty('CellData', tbReadCellData, tbWriteCellData, true);
- end;
-{--------}
-procedure TOvcTableAncestor.tbExcludeCell(Cell : TOvcTableCellAncestor);
- begin
- taCellList.Remove(pointer(Cell));
- end;
-{--------}
-procedure TOvcTableAncestor.tbFinishLoadingCellList;
- {Local methods}
- function GetImmediateParentForm(Control : TControl) : TWinControl;
- var
- ParentCtrl : TControl;
- begin
- ParentCtrl := Control.Parent;
- {$IFDEF VERSION5}
- while Assigned(ParentCtrl) and
- (not ((ParentCtrl is TCustomForm) or
- (ParentCtrl is TCustomFrame))) do
- ParentCtrl := ParentCtrl.Parent;
- Result := TWinControl(ParentCtrl);
- {$ELSE}
- while Assigned(ParentCtrl) and (not (ParentCtrl is TCustomForm)) do
- ParentCtrl := ParentCtrl.Parent;
- Result := TForm(ParentCtrl);
- {$ENDIF}
- end;
-
- {------}
-
- function FormNamesEqual(const CmptFormName, FormName : string) : boolean;
- var
- PosUL : integer;
- begin
- Result := true;
- if (FormName = '') or (CmptFormName = FormName) then
- Exit;
- PosUL := length(FormName);
- while (PosUL > 0) and (FormName[PosUL] <> '_') do
- dec(PosUL);
- if (PosUL > 0) then
- if (CmptFormName = Copy(FormName, 1, pred(PosUL))) then
- Exit;
- Result := false;
- end;
- {------}
-
- function GetFormName(const S, FormName : string) : string;
- var
- PosDot : integer;
- begin
- PosDot := Pos('.', S);
- if (PosDot <> 0) then
- Result := Copy(S, 1, pred(PosDot))
- else
- Result := FormName;
- end;
- {------}
-
- function GetComponentName(const S : string) : string;
- var
- PosDot : integer;
- begin
- PosDot := Pos('.', S);
- if (PosDot <> 0) then
- Result := Copy(S, succ(PosDot), length(S))
- else
- Result := S;
- end;
- {------}
-var
- i : integer;
- Form : TWinControl;
- Compnt : TComponent;
- DM : integer;
- DataMod: TDataModule;
- DMCount: integer;
-begin
- if Assigned(taLoadList) then
- begin
- {fixup the cell component list: the cells now exist}
- try
- Form := GetImmediateParentForm(Self);
- for i := pred(taLoadList.Count) downto 0 do
- if FormNamesEqual(GetFormName(taLoadList[i], Form.Name),
- Form.Name) then
- begin
- Compnt := Form.FindComponent(GetComponentName(taLoadList[i]));
- if Assigned(Compnt) and (Compnt is TOvcTableCellAncestor) then
- begin
- tbIncludeCell(TOvcTableCellAncestor(Compnt));
- taLoadList.Delete(i);
- end;
- end;
- {fixup references to cell components on any data modules}
- if (taLoadList.Count <> 0) then
- begin
- DM := 0;
-//{$IFNDEF LCL}
- DMCount := Screen.DataModuleCount;
-//{$ELSE}
-// DMCount := 0;
-//{$ENDIF}
- while (taLoadList.Count > 0) and (DM < DMCount) do
- begin
-//{$IFNDEF LCL}
- DataMod := Screen.DataModules[DM];
-//{$ENDIF}
- for i := pred(taLoadList.Count) downto 0 do
- if (GetFormName(taLoadList[i], Form.Name) = DataMod.Name) then
- begin
- Compnt := DataMod.FindComponent(GetComponentName(taLoadList[i]));
- if Assigned(Compnt) and (Compnt is TOvcTableCellAncestor) then
- begin
- tbIncludeCell(TOvcTableCellAncestor(Compnt));
- taLoadList.Delete(i);
- end;
- end;
- inc(DM);
- end;
- end;
- finally
- taLoadList.Free;
- taLoadList := nil;
- end;
- end;
-end;
-{--------}
-procedure TOvcTableAncestor.tbIncludeCell(Cell : TOvcTableCellAncestor);
- begin
- if Assigned(Cell) then
- with taCellList do
- if (IndexOf(pointer(Cell)) = -1) then
- begin
- Add(pointer(Cell));
- Cell.OnCfgChanged := tbCellChanged;
- end;
- end;
-{--------}
-procedure TOvcTableAncestor.Loaded;
- begin
- inherited Loaded;
- end;
-{--------}
-procedure TOvcTableAncestor.tbNotifyCellsOfTableChange;
- var
- i : integer;
- begin
- if Assigned(taCellList) then
- for i := 0 to pred(taCellList.Count) do
- TOvcTableCellAncestor(taCellList[i]).tcResetTableValues;
- end;
-{--------}
-procedure TOvcTableAncestor.tbReadCellData(Reader : TReader);
- begin
- if Assigned(taLoadList) then
- taLoadList.Clear
- else
- taLoadList := TStringList.Create;
- with Reader do
- begin
- ReadListBegin;
- while not EndOfList do
- taLoadList.Add(ReadString);
- ReadListEnd;
- end;
- end;
-{--------}
-procedure TOvcTableAncestor.tbWriteCellData(Writer : TWriter);
- var
- i : integer;
- Cell : TOvcTableCellAncestor;
- S : string;
- begin
- with Writer do
- begin
- WriteListBegin;
- for i := 0 to pred(taCellList.Count) do
- begin
- Cell := TOvcTableCellAncestor(taCellList[i]);
- S := Cell.Owner.Name;
- if (S <> '') then
- S := S + '.' + Cell.Name
- else
- S := Cell.Name;
- WriteString(S);
- end;
- WriteListEnd;
- end;
- end;
-{====================================================================}
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/68/684ec902f47f6ea3318a73dd534e97d34b6f68a6.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/68/684ec902f47f6ea3318a73dd534e97d34b6f68a6.svn-base
deleted file mode 100644
index a32b87ca..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/68/684ec902f47f6ea3318a73dd534e97d34b6f68a6.svn-base
+++ /dev/null
@@ -1,966 +0,0 @@
-{*********************************************************}
-{* OVCTCCBX.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}
-
-{$IFDEF VERSION6}
- {$IFNDEF LCL}
- {$WARN SYMBOL_DEPRECATED OFF}
- {$ENDIF}
-{$ENDIF}
-
-unit ovctccbx;
- {-Orpheus Table Cell - combo box type}
-
-interface
-
-uses
- SysUtils, Classes,
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Graphics, Controls, Forms, StdCtrls,
- OvcMisc, OvcTCmmn, OvcTCell, OvcTCStr;
-
-type
- TOvcTCComboBoxState = (otlbsUp, otlbsDown);
-
-type
- TOvcTCComboBoxEdit = class(TCustomComboBox)
- protected {private}
- {.Z+}
- FCell : TOvcBaseTableCell;
-
- EditField : HWnd;
- PrevEditWndProc : pointer;
- NewEditWndProc : pointer;
- {.Z-}
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
-
- protected
- {.Z+}
- procedure EditWindowProc(var Msg : TMessage);
- function FilterWMKEYDOWN(var Msg : TWMKey) : boolean;
-
- procedure CMRelease(var Message: TMessage); message CM_RELEASE;
-
- procedure WMChar(var Msg : TWMKey); message WM_CHAR;
- procedure WMGetDlgCode(var Msg : TMessage); message WM_GETDLGCODE;
- procedure WMKeyDown(var Msg : TWMKey); message WM_KEYDOWN;
- procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS;
- procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
- {.Z-}
-
- public
- constructor Create(AOwner : TComponent); override;
- destructor Destroy; override;
- procedure CreateWnd; override;
-
- property CellOwner : TOvcBaseTableCell
- read FCell write FCell;
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D;
-{$ENDIF}
- end;
-
- TOvcTCCustomComboBox = class(TOvcTCBaseString)
- protected {private}
- {.Z+}
- {property fields - even size}
- FDropDownCount : Integer;
- FEdit : TOvcTCComboBoxEdit;
- FItems : TStrings;
- FMaxLength : Word;
-
- {property fields - odd size}
- FStyle : TComboBoxStyle;
- FAutoAdvanceChar : Boolean;
- FAutoAdvanceLeftRight : Boolean;
- FHideButton : Boolean;
- FSaveStringValue : boolean;
- FSorted : Boolean;
- FShowArrow : Boolean;
- FUseRunTimeItems : Boolean;
-
- {events}
- FOnChange : TNotifyEvent;
- FOnDropDown : TNotifyEvent;
- FOnDrawItem : TDrawItemEvent;
- FOnMeasureItem : TMeasureItemEvent;
- {.Z-}
-
- protected
- {.Z+}
- function GetCellEditor : TControl; override;
-
- procedure SetShowArrow(Value : Boolean);
- procedure SetItems(I : TStrings);
- procedure SetSorted(S : boolean);
-
- procedure DrawArrow(Canvas : TCanvas;
- const CellRect : TRect;
- const CellAttr : TOvcCellAttributes);
- procedure DrawButton(Canvas : TCanvas;
- const CellRect : TRect);
-
- procedure tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer); override;
- {.Z-}
-
- {properties}
- property AutoAdvanceChar : boolean
- read FAutoAdvanceChar write FAutoAdvanceChar;
- property AutoAdvanceLeftRight : boolean
- read FAutoAdvanceLeftRight write FAutoAdvanceLeftRight;
- property DropDownCount : Integer
- read FDropDownCount write FDropDownCount;
- property HideButton : Boolean
- read FHideButton write FHideButton;
- property Items : TStrings
- read FItems write SetItems;
- property MaxLength : word
- read FMaxLength write FMaxLength;
- property SaveStringValue : boolean
- read FSaveStringValue write FSaveStringValue;
- property Sorted : boolean
- read FSorted write SetSorted;
- property ShowArrow : Boolean
- read FShowArrow write SetShowArrow;
- property Style : TComboBoxStyle
- read FStyle write FStyle;
- property UseRunTimeItems : boolean
- read FUseRunTimeItems write FUseRunTimeItems;
-
- {events}
- property OnChange : TNotifyEvent
- read FOnChange write FOnChange;
- property OnDropDown: TNotifyEvent
- read FOnDropDown write FOnDropDown;
- property OnDrawItem: TDrawItemEvent
- read FOnDrawItem write FOnDrawItem;
- property OnMeasureItem: TMeasureItemEvent
- read FOnMeasureItem write FOnMeasureItem;
-
- public
- constructor Create(AOwner : TComponent); override;
- destructor Destroy; override;
- function CreateEditControl : TOvcTCComboBoxEdit; virtual;
-
- function EditHandle : THandle; override;
- procedure EditHide; override;
- procedure EditMove(CellRect : TRect); override;
-
- procedure SaveEditedData(Data : pointer); override;
- procedure StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer); override;
- procedure StopEditing(SaveValue : boolean;
- Data : pointer); override;
- end;
-
- TOvcTCComboBox = class(TOvcTCCustomComboBox)
- published
- property AcceptActivationClick default True;
- property Access default otxDefault;
- property Adjust default otaDefault;
- property AutoAdvanceChar default False;
- property AutoAdvanceLeftRight default False;
- property Color;
- property DropDownCount default 8;
- property Font;
- property HideButton default False;
- property Hint;
- property Items;
- property ShowHint default False;
- property Margin default 4;
- property MaxLength default 0;
- property SaveStringValue default False;
- property ShowArrow default False;
- property Sorted default False;
- property Style default csDropDown;
- property Table;
- property TableColor default True;
- property TableFont default True;
- property TextHiColor default clBtnHighlight;
- property TextStyle default tsFlat;
- property UseRunTimeItems default False;
-
- {events inherited from custom ancestor}
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnDrawItem;
- property OnDropDown;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMeasureItem;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnOwnerDraw;
- end;
-
-
-var
- OvcComboBoxBitmap : TBitmap;
- OvcComboBoxButtonWidth : Integer;
-
-implementation
-
-const
- ComboBoxHeight = 24;
-
-var
- ComboBoxResourceCount : longint = 0;
-
-// Workaround for lack of MakeObjectInstance in LCL for making
-// WindowProc callback function from object method.
-// Note: Not using: function appears to work with Win32, but
-// crash when object destroyed. Doesn't work with GTK.
-{$IFDEF LCL}
-function LclEditWindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM) : LRESULT; stdcall;
-var
- CbEdit : TWinControl;
- AMsg : TMessage;
-begin
- CbEdit := FindOwnerControl(hWnd);
- AMsg.Msg := Msg;
- AMsg.WParam := wParam;
- AMsg.LParam := lParam;
- TOvcTCComboBoxEdit(CbEdit).EditWindowProc(AMsg);
-// Result := AMsg.Result;
-end;
-{$ENDIF}
-
-{===TOvcTCComboBoxEdit================================================}
-constructor TOvcTCComboBoxEdit.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
-{$IFNDEF LCL}
- NewEditWndProc := MakeObjectInstance(EditWindowProc);
-{$ELSE}
-// NewEditWndProc := @LclEditWindowProc;
-{$ENDIF}
- end;
-{--------}
-destructor TOvcTCComboBoxEdit.Destroy;
- begin
- if (Style = csDropDown) or (Style = csSimple) then
- SetWindowLong(EditField, GWL_WNDPROC, longint(PrevEditWndProc));
-{$IFNDEF LCL}
- FreeObjectInstance(NewEditWndProc);
-{$ENDIF}
- inherited Destroy;
- end;
-{--------}
-procedure TOvcTCComboBoxEdit.CreateWnd;
- begin
- inherited CreateWnd;
-
- if (Style = csDropDown) or (Style = csSimple) then
- begin
- EditField := GetWindow(Handle, GW_CHILD);
- if (Style = csSimple) then
- EditField := GetWindow(EditField, GW_HWNDNEXT);
- PrevEditWndProc := pointer(GetWindowLong(EditField, GWL_WNDPROC));
-{$IFNDEF LCL}
- SetWindowLong(EditField, GWL_WNDPROC, longint(NewEditWndProc));
-{$ENDIF}
- end;
- end;
-{--------}
-procedure TOvcTCComboBoxEdit.EditWindowProc(var Msg : TMessage);
- var
- GridUsedIt : boolean;
- KeyMsg : TWMKey absolute Msg;
- begin
- GridUsedIt := false;
- if (Msg.Msg = WM_KEYDOWN) then
- GridUsedIt := FilterWMKEYDOWN(KeyMsg)
- else if (Msg.Msg = WM_CHAR) then
- if (KeyMsg.CharCode = 9) or
- (KeyMsg.CharCode = 13) or
- (KeyMsg.CharCode = 27) then
- GridUsedIt := true;
- if not GridUsedIt then
- with Msg do
- Result := CallWindowProc(PrevEditWndProc, EditField, Msg, wParam, lParam);
- end;
-{--------}
-function TOvcTCComboBoxEdit.FilterWMKEYDOWN(var Msg : TWMKey) : boolean;
- procedure GetSelection(var S, E : word);
- type
- LH = packed record L, H : word; end;
- var
- GetSel : longint;
- begin
- GetSel := SendMessage(EditField, EM_GETSEL, 0, 0);
- S := LH(GetSel).L;
- E := LH(GetSel).H;
- end;
- var
- GridReply : TOvcTblKeyNeeds;
- SStart, SEnd : word;
- GridUsedIt : boolean;
- PassIton : boolean;
- begin
- GridUsedIt := false;
- GridReply := otkDontCare;
- if (CellOwner <> nil) then
- GridReply := CellOwner.FilterTableKey(Msg);
- case GridReply of
- otkMustHave :
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- otkWouldLike :
- begin
- PassItOn := false;
- case Msg.CharCode of
- VK_LEFT :
- begin
- case Style of
- csDropDown, csSimple :
- if TOvcTCCustomComboBox(CellOwner).AutoAdvanceLeftRight then
- begin
- GetSelection(SStart, SEnd);
- if (SStart = SEnd) and (SStart = 0) then
- PassItOn := true;
- end;
- else
- PassItOn := true;
- end;{case}
- end;
- VK_RIGHT :
- begin
- case Style of
- csDropDown, csSimple :
- if TOvcTCCustomComboBox(CellOwner).AutoAdvanceLeftRight then
- begin
- GetSelection(SStart, SEnd);
- if ((SStart = SEnd) or (SStart = 0)) and
- (SEnd = GetTextLen) then
- PassItOn := true;
- end;
- else
- PassItOn := true;
- end;{case}
- end;
- end;{case}
- if PassItOn then
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;
- end;{case}
- Result := GridUsedIt;
- end;
-{--------}
-
-
- procedure TOvcTCComboBoxEdit.CMRelease(var Message: TMessage);
- begin
- Free;
- end;
-
- procedure TOvcTCComboBoxEdit.WMChar(var Msg : TWMKey);
- var
- CurText : string;
- begin
- inherited;
- if TOvcTCCustomComboBox(CellOwner).AutoAdvanceChar then
- begin
- CurText := Text;
- if (length(CurText) >= MaxLength) then
- begin
- FillChar(Msg, sizeof(Msg), 0);
- with Msg do
- begin
- Msg := WM_KEYDOWN;
- CharCode := VK_RIGHT;
- end;
- CellOwner.SendKeyToTable(Msg);
- end;
- end;
- end;
-{--------}
-procedure TOvcTCComboBoxEdit.WMGetDlgCode(var Msg : TMessage);
- begin
- inherited;
- if CellOwner.TableWantsTab then
- Msg.Result := Msg.Result or DLGC_WANTTAB;
- end;
-{--------}
-procedure TOvcTCComboBoxEdit.WMKeyDown(var Msg : TWMKey);
- var
- GridUsedIt : boolean;
- begin
- if (Style <> csDropDown) and (Style <> csSimple) then
- begin
- GridUsedIt := FilterWMKEYDOWN(Msg);
- if not GridUsedIt then
- inherited;
- end
- else
- inherited;
- end;
-{--------}
-procedure TOvcTCComboBoxEdit.WMKillFocus(var Msg : TWMKillFocus);
- begin
- inherited;
- {ComboBox posts cbn_killfocus message to table}
- end;
-{--------}
-procedure TOvcTCComboBoxEdit.WMSetFocus(var Msg : TWMSetFocus);
- begin
- inherited;
- CellOwner.PostMessageToTable(ctim_SetFocus, Msg.FocusedWnd, 0);
- end;
-{====================================================================}
-
-
-{===TOvcTCCustomComboBox=============================================}
-constructor TOvcTCCustomComboBox.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
- FItems := TStringList.Create;
- FDropDownCount := 8;
- if (ComboBoxResourceCount = 0) then
- begin
- OvcComboBoxBitmap := TBitMap.Create;
-{$IFNDEF LCL}
- OvcComboBoxBitmap.Handle := LoadBaseBitMap('ORTCCOMBOARROW');
-{$ELSE}
- OvcComboBoxBitmap.LoadFromLazarusResource('ORTCCOMBOARROW');
-{$ENDIF}
- OvcComboBoxButtonWidth := OvcComboBoxBitmap.Width + 11;
- end;
- inc(ComboBoxResourceCount);
- FAcceptActivationClick := true;
- FShowArrow := False;
- FHideButton := False;
- end;
-{--------}
-destructor TOvcTCCustomComboBox.Destroy;
- begin
- FItems.Free;
- dec(ComboBoxResourceCount);
- if (ComboBoxResourceCount = 0) then
- OvcComboBoxBitmap.Free;
- inherited Destroy;
- end;
-{--------}
-function TOvcTCCustomComboBox.CreateEditControl : TOvcTCComboBoxEdit;
- begin
- Result := TOvcTCComboBoxEdit.Create(FTable);
- end;
-{--------}
-procedure TOvcTCCustomComboBox.DrawArrow(Canvas : TCanvas;
- const CellRect : TRect;
- const CellAttr : TOvcCellAttributes);
- var
- ArrowDim : Integer;
- X, Y : Integer;
- LeftPoint, RightPoint, BottomPoint : TPoint;
-{$IFNDEF LCL}
- Width : integer;
- Height : integer;
-{$ELSE} //LCL TCanvas has Width and Height properties
- AWidth : integer;
- AHeight : integer;
-{$ENDIF}
- R : TRect;
- begin
- R := CellRect;
- R.Left := R.Right - OvcComboBoxButtonWidth;
-{$IFNDEF LCL}
- Width := R.Right - R.Left;
- Height := R.Bottom - R.Top;
-{$ELSE}
- AWidth := R.Right - R.Left;
- AHeight := R.Bottom - R.Top;
-{$ENDIF}
- with Canvas do
- begin
- Brush.Color := CellAttr.caColor;
- FillRect(R);
- Pen.Color := CellAttr.caFont.Color;
- Brush.Color := Pen.Color;
-{$IFNDEF LCL}
- ArrowDim := MinI(Width, Height) div 3;
- X := R.Left + (Width - ArrowDim) div 2;
- Y := R.Top + (Height - ArrowDim) div 2;
-{$ELSE}
- ArrowDim := MinI(AWidth, AHeight) div 3;
- X := R.Left + (AWidth - ArrowDim) div 2;
- Y := R.Top + (AHeight - ArrowDim) div 2;
-{$ENDIF}
- LeftPoint := Point(X, Y);
- RightPoint := Point(X+ArrowDim, Y);
- BottomPoint := Point(X+(ArrowDim div 2), Y+ArrowDim);
- Polygon([LeftPoint, RightPoint, BottomPoint]);
- end;
- end;
-{--------}
-procedure TOvcTCCustomComboBox.DrawButton(Canvas : TCanvas;
- const CellRect : TRect);
- var
- EffCellWidth : Integer;
- Wd, Ht : Integer;
- TopPixel : Integer;
- BotPixel : Integer;
- LeftPixel : Integer;
- RightPixel : Integer;
- SrcRect : TRect;
- DestRect : TRect;
- begin
- {Calculate the effective cell width (the cell width less the size
- of the button)}
- EffCellWidth := CellRect.Right - CellRect.Left - OvcComboBoxButtonWidth;
-
- {Calculate the black border's rectangle}
- LeftPixel := CellRect.Left + EffCellWidth;
- RightPixel := CellRect.Right - 1;
- TopPixel := CellRect.Top + 1;
- BotPixel := CellRect.Bottom - 1;
-
- {Paint the button}
- with Canvas do
- begin
- {FIRST: paint the black border around the button}
- Pen.Color := clBlack;
- Pen.Width := 1;
- Brush.Color := clBtnFace;
- {Note: Rectangle excludes the Right and bottom pixels}
- Rectangle(LeftPixel, TopPixel, RightPixel, BotPixel);
- {SECOND: paint the highlight border on left/top sides}
- {decrement drawing area}
- inc(TopPixel);
- dec(BotPixel);
- inc(LeftPixel);
- dec(RightPixel);
- {Note: PolyLine excludes the end points of a line segment,
- but since the end points are generally used as the
- starting point of the next we must adjust for it.}
- Pen.Color := clBtnHighlight;
- PolyLine([Point(RightPixel-1, TopPixel),
- Point(LeftPixel, TopPixel),
- Point(LeftPixel, BotPixel)]);
- {THIRD: paint the highlight border on bottom/right sides}
- Pen.Color := clBtnShadow;
- PolyLine([Point(LeftPixel, BotPixel-1),
- Point(RightPixel-1, BotPixel-1),
- Point(RightPixel-1, TopPixel-1)]);
- inc(TopPixel);
- dec(BotPixel);
- inc(LeftPixel);
- dec(RightPixel);
- PolyLine([Point(LeftPixel, BotPixel-1),
- Point(RightPixel-1, BotPixel-1),
- Point(RightPixel-1, TopPixel-1)]);
- {THIRD: paint the arrow bitmap}
- Wd := OvcComboBoxBitmap.Width;
- Ht := OvcComboBoxBitmap.Height;
- SrcRect := Rect(0, 0, Wd, Ht);
- with DestRect do
- begin
- Left := CellRect.Left + EffCellWidth + 5;
- Top := CellRect.Top +
- ((CellRect.Bottom - CellRect.Top - Ht) div 2);
- Right := Left + Wd;
- Bottom := Top + Ht;
- end;
-//{$IFNDEF LCL}
- BrushCopy(DestRect, OvcComboBoxBitmap, SrcRect, clSilver);
-//{$ELSE}
-// BrushCopy(Canvas, DestRect, OvcComboBoxBitmap, SrcRect, clSilver);
-//{$ENDIF}
- end;
- end;
-{--------}
-function TOvcTCCustomComboBox.EditHandle : THandle;
- begin
- if Assigned(FEdit) then
- Result := FEdit.Handle
- else
- Result := 0;
- end;
-{--------}
-procedure TOvcTCCustomComboBox.EditHide;
- begin
- if Assigned(FEdit) then
- with FEdit do
- begin
- SetWindowPos(FEdit.Handle, HWND_TOP,
- 0, 0, 0, 0,
- SWP_HIDEWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- end;
- end;
-{--------}
-procedure TOvcTCCustomComboBox.EditMove(CellRect : TRect);
- var
- EditHandle : HWND;
- NewTop : Integer;
- begin
- if Assigned(FEdit) then
- begin
- EditHandle := FEdit.Handle;
- with CellRect do
- begin
- NewTop := Top;
- if FEdit.Ctl3D then
- InflateRect(CellRect, -1, -1);
- SetWindowPos(EditHandle, HWND_TOP,
- Left, NewTop, Right-Left, ComboBoxHeight,
- SWP_SHOWWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- end;
- InvalidateRect(EditHandle, nil, false);
- UpdateWindow(EditHandle);
- end;
- end;
-
-function TOvcTCCustomComboBox.GetCellEditor : TControl;
-begin
- Result := FEdit;
-end;
-
-procedure TOvcTCCustomComboBox.tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer);
-var
- ItemRec : PCellComboBoxInfo absolute Data;
- ActiveRow : TRowNum;
- ActiveCol : TColNum;
- R : TRect;
- S : ShortString;
- OurItems : TStrings;
-begin
- {Note: Data is a pointer to an integer, or to an integer and a
- shortstring. The first is used for drop down ListBoxes
- (only) and the latter with simple and drop down combo boxes}
-
- {If the cell is invisible let the ancestor to all the work}
- if (CellAttr.caAccess = otxInvisible) then begin
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, nil);
- Exit;
- end;
-
- {If we have valid data, get the string to display from the stringlist
- or from the Data pointer. }
- S := '';
- if (Data <> nil) then begin
- if UseRunTimeItems then
- OurItems := ItemRec^.RTItems
- else
- OurItems := Items;
- if (0 <= ItemRec^.Index) and (ItemRec^.Index < OurItems.Count) then
- S := OurItems[ItemRec^.Index]
- else if (Style = csDropDown) or (Style = csSimple) then begin
- if UseRunTimeItems then
- {$IFDEF CBuilder}
- S := StrPas(ItemRec^.RTSt)
- {$ELSE}
- S := ItemRec^.RTSt
- {$ENDIF}
- else
- {$IFDEF CBuilder}
- S := StrPas(ItemRec^.St);
- {$ELSE}
- S := ItemRec^.St;
- {$ENDIF}
- end;
- end
- {Otherwise, mock up a string in design mode.}
- else if (csDesigning in ComponentState) and (Items.Count > 0) then
- S := Items[RowNum mod Items.Count];
-
- ActiveRow := tcRetrieveTableActiveRow;
- ActiveCol := tcRetrieveTableActiveCol;
- {Calculate the effective cell width (the cell width less the size of the button)}
- R := CellRect;
- dec(R.Right, OvcComboBoxButtonWidth);
- if (ActiveRow = RowNum) and (ActiveCol = ColNum) then begin
- if FHideButton then begin
- {let ancestor paint the text}
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, @S);
- end else begin
- {Paint the string in the restricted rectangle}
- inherited tcPaint(TableCanvas, R, RowNum, ColNum, CellAttr, @S);
- {Paint the button on the right side}
- DrawButton(TableCanvas, CellRect);
- end;
- end else if FShowArrow then begin
- {paint the string in the restricted rectangle}
- inherited tcPaint(TableCanvas, R, RowNum, ColNum, CellAttr, @S);
- {Paint the arrow on the right side}
- DrawArrow(TableCanvas, CellRect, CellAttr);
- end else
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, @S);
-
-(*
- {Are we just displaying a button on the active cell?}
- if not FHideButton then begin
- {If we are not the active cell, let the ancestor do the painting (we only
- paint a button when the cell is the active one)}
- if (ActiveRow <> RowNum) or (ActiveCol <> ColNum) then begin
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, @S);
- Exit;
- end;
- {Calculate the effective cell width (the cell width less the size
- of the button)}
- R := CellRect;
- dec(R.Right, OvcComboBoxButtonWidth);
- {Paint the string in this restricted rectangle}
- inherited tcPaint(TableCanvas, R, RowNum, ColNum, CellAttr, @S);
- {Paint the button on the right side}
- DrawButton(TableCanvas, CellRect);
- end else if FShowArrow then begin
- {Calculate the effective cell width (the cell width less the size
- of the button)}
- R := CellRect;
- dec(R.Right, OvcComboBoxButtonWidth);
- {Paint the string in this restricted rectangle}
- inherited tcPaint(TableCanvas, R, RowNum, ColNum, CellAttr, @S);
- {Paint the arrow on the right side}
- DrawArrow(TableCanvas, CellRect, CellAttr);
- end else
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, @S);
-*)
-end;
-
-procedure TOvcTCCustomComboBox.SaveEditedData(Data : pointer);
- var
- ItemRec : PCellComboBoxInfo absolute Data;
- begin
- if Assigned(Data) then
- begin
- ItemRec^.Index := FEdit.ItemIndex;
- if (Style = csDropDown) or (Style = csSimple) or SaveStringValue then
- begin
- if (ItemRec^.Index = -1) then
- if UseRunTimeItems then
- {$IFDEF CBuilder}
- StrPCopy(ItemRec^.RTSt, Copy(FEdit.Text, 1, MaxLength))
- {$ELSE}
- ItemRec^.RTSt := Copy(FEdit.Text, 1, MaxLength)
- {$ENDIF}
- else
- {$IFDEF CBuilder}
- StrPCopy(ItemRec^.St, Copy(FEdit.Text, 1, MaxLength))
- {$ELSE}
- ItemRec^.St := Copy(FEdit.Text, 1, MaxLength)
- {$ENDIF}
- else
- if UseRunTimeItems then
- {$IFDEF CBuilder}
- StrPCopy(ItemRec^.RTSt, Copy(ItemRec^.RTItems[ItemRec^.Index], 1, MaxLength))
- {$ELSE}
- ItemRec^.RTSt := Copy(ItemRec^.RTItems[ItemRec^.Index], 1, MaxLength)
- {$ENDIF}
- else
- {$IFDEF CBuilder}
- StrPCopy(ItemRec^.St, Copy(Items[ItemRec^.Index], 1, MaxLength));
- {$ELSE}
- ItemRec^.St := Copy(Items[ItemRec^.Index], 1, MaxLength);
- {$ENDIF}
- end;
- end;
- end;
-{--------}
-procedure TOvcTCCustomComboBox.SetItems(I : TStrings);
- begin
- FItems.Assign(I);
- if Sorted then
- TStringList(FItems).Sorted := true;
- tcDoCfgChanged;
- end;
-
-procedure TOvcTCCustomComboBox.SetShowArrow(Value : Boolean);
-begin
- if (Value <> FShowArrow) then begin
- FShowArrow := Value;
- tcDoCfgChanged;
- end;
-end;
-
-procedure TOvcTCCustomComboBox.SetSorted(S : boolean);
- begin
- if (S <> Sorted) then
- begin
- FSorted := S;
- if Sorted then
- TStringList(Items).Sorted := True;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTCCustomComboBox.StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer);
- var
- ItemRec : PCellComboBoxInfo absolute Data;
- begin
- FEdit := CreateEditControl;
- with FEdit do
- begin
- Color := CellAttr.caColor;
- Ctl3D := false;
- case CellStyle of
- tes3D : Ctl3D := true;
- end;{case}
- Left := CellRect.Left;
- Top := CellRect.Top;
- Width := CellRect.Right - CellRect.Left;
- Font := CellAttr.caFont;
- Font.Color := CellAttr.caFontColor;
- MaxLength := Self.MaxLength;
- Hint := Self.Hint;
- ShowHint := Self.ShowHint;
- Visible := true;
- CellOwner := Self;
- TabStop := false;
- Parent := FTable;
- DropDownCount := Self.DropDownCount;
- Sorted := Self.Sorted;
- Style := Self.Style;
- if UseRunTimeItems then
- Items := ItemRec^.RTItems
- else
- Items := Self.Items;
- if Data = nil then
- ItemIndex := -1
- else
- begin
- ItemIndex := ItemRec^.Index;
- if (ItemIndex = -1) and
- ((Style = csDropDown) or (Style = csSimple)) then
- if UseRunTimeItems then
- {$IFDEF CBuilder}
- Text := StrPas(ItemRec^.RTSt)
- {$ELSE}
- Text := ItemRec^.RTSt
- {$ENDIF}
- else
- {$IFDEF CBuilder}
- Text := StrPas(ItemRec^.St)
- {$ELSE}
- Text := ItemRec^.St;
- {$ENDIF}
- end;
-
- OnChange := Self.OnChange;
- OnClick := Self.OnClick;
- OnDblClick := Self.OnDblClick;
- OnDragDrop := Self.OnDragDrop;
- OnDragOver := Self.OnDragOver;
- OnDrawItem := Self.OnDrawItem;
- OnDropDown := Self.OnDropDown;
- OnEndDrag := Self.OnEndDrag;
- OnEnter := Self.OnEnter;
- OnExit := Self.OnExit;
- OnKeyDown := Self.OnKeyDown;
- OnKeyPress := Self.OnKeyPress;
- OnKeyUp := Self.OnKeyUp;
- OnMeasureItem := Self.OnMeasureItem;
- OnMouseDown := Self.OnMouseDown;
- OnMouseMove := Self.OnMouseMove;
- OnMouseUp := Self.OnMouseUp;
- end;
- end;
-{--------}
-procedure TOvcTCCustomComboBox.StopEditing(SaveValue : boolean;
- Data : pointer);
- var
- ItemRec : PCellComboBoxInfo absolute Data;
- begin
- if SaveValue and Assigned(Data) then
- begin
- ItemRec^.Index := FEdit.ItemIndex;
- if (Style = csDropDown) or (Style = csSimple) or SaveStringValue then
- begin
- if (ItemRec^.Index = -1) then
- if UseRunTimeItems then
- {$IFDEF CBuilder}
- StrPCopy(ItemRec^.RTSt, Copy(FEdit.Text, 1, MaxLength))
- {$ELSE}
- ItemRec^.RTSt := Copy(FEdit.Text, 1, MaxLength)
- {$ENDIF}
- else
- {$IFDEF CBuilder}
- StrPCopy(ItemRec^.St, Copy(FEdit.Text, 1, MaxLength))
- {$ELSE}
- ItemRec^.St := Copy(FEdit.Text, 1, MaxLength)
- {$ENDIF}
- else
- if UseRunTimeItems then
- {$IFDEF CBuilder}
- StrPCopy(ItemRec^.RTSt, Copy(ItemRec^.RTItems[ItemRec^.Index], 1, MaxLength))
- {$ELSE}
- ItemRec^.RTSt := Copy(ItemRec^.RTItems[ItemRec^.Index], 1, MaxLength)
- {$ENDIF}
- else
- {$IFDEF CBuilder}
- StrPCopy(ItemRec^.St, Copy(Items[ItemRec^.Index], 1, MaxLength));
- {$ELSE}
- ItemRec^.St := Copy(Items[ItemRec^.Index], 1, MaxLength);
- {$ENDIF}
- end;
- end;
- PostMessage(FEdit.Handle, CM_RELEASE, 0, 0);
- {FEdit.Free;}
- FEdit := nil;
- end;
-{====================================================================}
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/69/69f9d736e263707f2c7334f2c5a5952814106814.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/69/69f9d736e263707f2c7334f2c5a5952814106814.svn-base
deleted file mode 100644
index aff91f18..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/69/69f9d736e263707f2c7334f2c5a5952814106814.svn-base
+++ /dev/null
@@ -1,68 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, ovcbase, ovcvlb, StdCtrls;
-
-type
- TForm1 = class(TForm)
- OvcVirtualListBox1: TOvcVirtualListBox;
- Label1: TLabel;
- procedure FormCreate(Sender: TObject);
- procedure OvcVirtualListBox1GetItem(Sender: TObject; Index: Integer;
- var ItemString: String);
- procedure OvcVirtualListBox1DblClick(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.dfm}
-{$ELSE}
-{$R *.lfm}
-{$ENDIF}
-
-procedure TForm1.FormCreate(Sender: TObject);
-var
- TabStops : array[0..1] of Integer;
-begin
- TabStops[0] := 150;
- TabStops[1] := 300;
- OvcVirtualListBox1.SetTabStops(TabStops);
-
- OvcVirtualListBox1.Header := 'Name column'#9'Address column'#9'City column';
-
- if OvcVirtualListBox1.IntegralHeight then
- OvcVirtualListBox1.ClientHeight :=
- (OvcVirtualListBox1.ClientHeight div OvcVirtualListBox1.RowHeight) *
- OvcVirtualListBox1.RowHeight;
- {Since RowHeight might have changed based on font used by current
- platform, make sure height still integral.}
-end;
-
-procedure TForm1.OvcVirtualListBox1GetItem(Sender: TObject; Index: Integer;
- var ItemString: String);
-begin
- ItemString := 'Item ' + IntToStr(Index) + ' name'#9 +
- 'Item ' + IntToStr(Index) + ' address'#9 +
- 'Item ' + IntToStr(Index) + ' city';
-end;
-
-procedure TForm1.OvcVirtualListBox1DblClick(Sender: TObject);
-begin
- Label1.Caption :=
- 'You double-clicked item ' + IntToStr(OvcVirtualListBox1.ItemIndex);
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/6a/6a22f82efc43956a4bd02c30c0ca9501d3e08ca1.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/6a/6a22f82efc43956a4bd02c30c0ca9501d3e08ca1.svn-base
deleted file mode 100644
index 8f104d26..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/6a/6a22f82efc43956a4bd02c30c0ca9501d3e08ca1.svn-base
+++ /dev/null
@@ -1,110 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/6a/6a2b1bc007d7692960b08be4f378647cc20a4a08.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/6a/6a2b1bc007d7692960b08be4f378647cc20a4a08.svn-base
deleted file mode 100644
index 48716a27..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/6a/6a2b1bc007d7692960b08be4f378647cc20a4a08.svn-base
+++ /dev/null
@@ -1,71 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 435
- Height = 293
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- PixelsPerInch = 96
- object OvcRotatedLabel1: TOvcRotatedLabel
- Left = 56
- Top = 32
- Width = 153
- Height = 25
- AutoSize = False
- Caption = 'Not rotated'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -13
- Font.Style = []
- ShadowedText = False
- end
- object OvcRotatedLabel2: TOvcRotatedLabel
- Left = 56
- Top = 80
- Width = 153
- Height = 57
- AutoSize = False
- Caption = 'Rotated 15 degrees'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -13
- Font.Style = []
- FontAngle = 15
- OriginY = 30
- ShadowedText = False
- end
- object OvcRotatedLabel3: TOvcRotatedLabel
- Left = 56
- Top = 160
- Width = 153
- Height = 57
- AutoSize = False
- Caption = 'Rotated -15 degrees'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -13
- Font.Style = []
- FontAngle = -15
- OriginX = 5
- ShadowedText = False
- end
- object OvcRotatedLabel4: TOvcRotatedLabel
- Left = 264
- Top = 32
- Width = 65
- Height = 185
- AutoSize = False
- Caption = 'Rotated 90 degrees'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -13
- Font.Style = []
- FontAngle = 90
- OriginY = 175
- ShadowedText = False
- end
-end
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/6a/6ab06ea9a874c7b6215470789490fd9ee1cce7e6.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/6a/6ab06ea9a874c7b6215470789490fd9ee1cce7e6.svn-base
deleted file mode 100644
index 39225bf7..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/pristine/6a/6ab06ea9a874c7b6215470789490fd9ee1cce7e6.svn-base and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/6a/6abf3eb21d6b376b3fb2ac8881f552a20614063c.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/6a/6abf3eb21d6b376b3fb2ac8881f552a20614063c.svn-base
deleted file mode 100644
index c562b53c..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/6a/6abf3eb21d6b376b3fb2ac8881f552a20614063c.svn-base
+++ /dev/null
@@ -1,16 +0,0 @@
-LazarusResources.Add('TForm1','FORMDATA',[
- 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#192#0#3'Top'#2'r'#5'Width'#3'"'#2#6'Heigh'
- +'t'#3#147#1#7'Caption'#6#5'Form1'#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7
- +#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245
- +#10'Font.Style'#11#0#8'OnCreate'#7#10'FormCreate'#13'PixelsPerInch'#2'`'#0#6
- +'TLabel'#6'Label1'#4'Left'#2'('#3'Top'#3'0'#1#5'Width'#3#217#1#6'Height'#2'!'
- +#8'AutoSize'#8#7'Caption'#6#28'Double-click an item in list'#5'Color'#7#14'c'
- +'lBtnHighlight'#11'ParentColor'#8#0#0#18'TOvcVirtualListBox'#18'OvcVirtualLi'
- +'stBox1'#4'Left'#2'('#3'Top'#2'('#5'Width'#3#217#1#6'Height'#3#238#0#6'Heade'
- +'r'#6#16'Header goes here'#21'HeaderColor.BackColor'#7#9'clBtnFace'#21'Heade'
- +'rColor.TextColor'#7#9'clBtnText'#22'ProtectColor.BackColor'#7#5'clRed'#22'P'
- +'rotectColor.TextColor'#7#7'clWhite'#9'RowHeight'#2#13#21'SelectColor.BackCo'
- +'lor'#7#11'clHighlight'#21'SelectColor.TextColor'#7#15'clHighlightText'#10'S'
- +'howHeader'#9#11'UseTabStops'#9#9'OnGetItem'#7#25'OvcVirtualListBox1GetItem'
- +#8'TabOrder'#2#0#10'OnDblClick'#7#26'OvcVirtualListBox1DblClick'#0#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/6c/6ca6a1f7d681e7c3d030602606b3dff170579507.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/6c/6ca6a1f7d681e7c3d030602606b3dff170579507.svn-base
deleted file mode 100644
index 324afd19..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/pristine/6c/6ca6a1f7d681e7c3d030602606b3dff170579507.svn-base and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/6c/6cf1b2cfb033a611261d59afd2bde0fa47151ec4.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/6c/6cf1b2cfb033a611261d59afd2bde0fa47151ec4.svn-base
deleted file mode 100644
index a72911da..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/6c/6cf1b2cfb033a611261d59afd2bde0fa47151ec4.svn-base
+++ /dev/null
@@ -1,10 +0,0 @@
-LazarusResources.Add('TForm1','FORMDATA',[
- 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#192#0#3'Top'#2'r'#5'Width'#3#159#1#6'Heig'
- +'ht'#3'!'#1#7'Caption'#6#5'Form1'#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7
- +#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245
- +#10'Font.Style'#11#0#13'PixelsPerInch'#2'`'#0#11'TOvcSpinner'#11'OvcSpinner1'
- +#4'Left'#3#144#0#3'Top'#2'X'#5'Width'#2'1'#6'Height'#2'A'#10'AutoRepeat'#9#5
- +'Delta'#5#0#0#0#0#0#0#0#128#255'?'#14'FocusedControl'#7#5'Edit1'#0#0#5'TEdit'
- +#5'Edit1'#4'Left'#3#208#0#3'Top'#2'p'#5'Width'#2'9'#6'Height'#2#21#8'TabOrde'
- +'r'#2#1#4'Text'#6#1'0'#0#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/6f/6f47665a8462a6f3b6aa5fa4f08b8d6799516654.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/6f/6f47665a8462a6f3b6aa5fa4f08b8d6799516654.svn-base
deleted file mode 100644
index fc9c9739..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/6f/6f47665a8462a6f3b6aa5fa4f08b8d6799516654.svn-base
+++ /dev/null
@@ -1,108 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/6f/6f792a528fc84a2db6559e31539f0df9168a21d9.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/6f/6f792a528fc84a2db6559e31539f0df9168a21d9.svn-base
deleted file mode 100644
index c8f91c17..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/6f/6f792a528fc84a2db6559e31539f0df9168a21d9.svn-base
+++ /dev/null
@@ -1,31 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls, ovcurl;
-
-type
- TForm1 = class(TForm)
- OvcURL1: TOvcURL;
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.dfm}
-{$ELSE}
-{$R *.lfm}
-{$ENDIF}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/6f/6fa642595859055840c54c408258a8e8f01b7fd1.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/6f/6fa642595859055840c54c408258a8e8f01b7fd1.svn-base
deleted file mode 100644
index 87a270b9..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/pristine/6f/6fa642595859055840c54c408258a8e8f01b7fd1.svn-base and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/70/70316067c95009c23069a2ae3046deb86f7e197d.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/70/70316067c95009c23069a2ae3046deb86f7e197d.svn-base
deleted file mode 100644
index 7143b039..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/70/70316067c95009c23069a2ae3046deb86f7e197d.svn-base
+++ /dev/null
@@ -1,16 +0,0 @@
-#!/bin/sh
-lazdir=~/lazarus
-if ! [ -e $lazdir ]
-then
- lazdir=/usr/local/share/lazarus
-fi
-$lazdir/lazbuild -d --ws=carbon tests/TestFlexEdit/project1.lpi
-$lazdir/lazbuild -d --ws=carbon tests/TestLabel/project1.lpi
-$lazdir/lazbuild -d --ws=carbon tests/TestRLbl/project1.lpi
-$lazdir/lazbuild -d --ws=carbon tests/TestSimpField/project1.lpi
-$lazdir/lazbuild -d --ws=carbon tests/TestSpinner/project1.lpi
-$lazdir/lazbuild -d --ws=carbon tests/TestTable/project1.lpi
-$lazdir/lazbuild -d --ws=carbon tests/TestTblEdits/project1.lpi
-$lazdir/lazbuild -d --ws=carbon tests/TestURL/project1.lpi
-$lazdir/lazbuild -d --ws=carbon tests/TestVLB/project1.lpi
-$lazdir/lazbuild -d --ws=carbon tests/TestCalendar/project1.lpi
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/73/7330a6c9611b5fedaa42091dd8628c4759633bbd.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/73/7330a6c9611b5fedaa42091dd8628c4759633bbd.svn-base
deleted file mode 100644
index 9ce395d2..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/73/7330a6c9611b5fedaa42091dd8628c4759633bbd.svn-base
+++ /dev/null
@@ -1,2048 +0,0 @@
-{*********************************************************}
-{* OVCSF.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 ovcsf;
- {-Simple field visual component}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Classes, Controls, Graphics, SysUtils,
- OvcBase, OvcColor, OvcCaret, OvcConst, OvcData, OvcEF, OvcExcpt,
- OvcIntl, OvcMisc, OvcStr;
-
-type
- {simple field type names}
- TSimpleDataType = (
- sftString, sftChar, sftBoolean, sftYesNo,
- sftLongInt, sftWord, sftInteger, sftByte, sftShortInt,
- sftReal, sftExtended, sftDouble, sftSingle, sftComp);
-
-type
- TOvcCustomSimpleField = class(TOvcBaseEntryField)
- {.Z+}
- protected {private}
- {property instance variables}
- FSimpleDataType : TSimpleDataType; {data type for this field}
- FPictureMask : AnsiChar; {picture mask name}
-
- function sfGetDataType(Value : TSimpleDataType) : Byte;
- {-return a Byte value representing the type of this field}
- procedure sfResetFieldProperties(FT : TSimpleDataType);
- {-reset field properties}
- procedure sfSetDefaultRanges;
- {-set default range values based on the field type}
-
- protected
- procedure CreateWnd;
- override;
-
- procedure efEdit(var Msg : TMessage; Cmd : Word);
- override;
- {-process the specified editing command}
- function efGetDisplayString(Dest : PAnsiChar; Size : Word) : PAnsiChar;
- override;
- {-return the display string in Dest and a pointer as the result}
- procedure efIncDecValue(Wrap : Boolean; Delta : Double);
- override;
- {-increment field by Delta}
- function efTransfer(DataPtr : Pointer; TransferFlag : Word) : Word;
- override;
- {-transfer data to/from the entry fields}
-
- {virtual property methods}
- procedure sfSetDataType(Value : TSimpleDataType);
- virtual;
- {-set the data type for this field}
- procedure sfSetPictureMask(Value: AnsiChar);
- virtual;
- {-set the picture mask}
-
- public
- procedure Assign(Source : TPersistent);
- override;
- constructor Create(AOwner: TComponent);
- override;
-
- function efValidateField : Word;
- override;
- {-validate contents of field; result is error code or 0}
- {.Z-}
-
- {public properties}
- property DataType : TSimpleDataType
- read FSimpleDataType
- write sfSetDataType;
-
- property PictureMask : AnsiChar
- read FPictureMask
- write sfSetPictureMask;
-
- end;
-
- TOvcSimpleField = class(TOvcCustomSimpleField)
- published
- {inherited properties}
- property DataType; {needs to loaded before most other properties}
- {$IFDEF VERSION4}
- property Anchors;
- property Constraints;
- property DragKind;
- {$ENDIF}
- property AutoSize;
- property BorderStyle;
- property CaretIns;
- property CaretOvr;
- property Color;
- property ControlCharColor;
- property Controller;
- property Ctl3D;
- property Borders;
- property DecimalPlaces;
- property DragCursor;
- property DragMode;
- property EFColors;
- property Enabled;
- property Font;
- property LabelInfo;
- property MaxLength;
- property Options;
- property PadChar;
- property ParentColor;
-{$IFNDEF LCL}
- property ParentCtl3D;
-{$ENDIF}
- property ParentFont;
- property ParentShowHint;
- property PasswordChar;
- property PictureMask;
- property PopupMenu;
- property RangeHi stored False;
- property RangeLo stored False;
- property ShowHint;
- property TabOrder;
- property TabStop default True;
- property Tag;
- property TextMargin;
- property Uninitialized;
- property Visible;
- property ZeroDisplay;
- property ZeroDisplayValue;
-
- {inherited events}
- property AfterEnter;
- property AfterExit;
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnError;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDrag;
- property OnMouseWheel;
- property OnUserCommand;
- property OnUserValidation;
- end;
-
-implementation
-
-{*** TOvcCustomSimpleField ***}
-
-procedure TOvcCustomSimpleField.Assign(Source : TPersistent);
-var
- SF : TOvcCustomSimpleField absolute Source;
-begin
- if (Source <> nil) and (Source is TOvcCustomSimpleField) then begin
- DataType := SF.DataType;
- AutoSize := SF.AutoSize;
- BorderStyle := SF.BorderStyle;
- Color := SF.Color;
- ControlCharColor := SF.ControlCharColor;
- DecimalPlaces := SF.DecimalPlaces;
- EFColors.Error.Assign(SF.EFColors.Error);
- EFColors.Highlight.Assign(SF.EFColors.Highlight);
- MaxLength := SF.MaxLength;
- Options := SF.Options;
- PadChar := SF.PadChar;
- PasswordChar := SF.PasswordChar;
- PictureMask := SF.PictureMask;
- RangeHi := SF.RangeHi;
- RangeLo := SF.RangeLo;
- TextMargin := SF.TextMargin;
- Uninitialized := SF.Uninitialized;
- ZeroDisplay := SF.ZeroDisplay;
- ZeroDisplayValue := SF.ZeroDisplayValue;
- end else
- inherited Assign(Source);
-end;
-
-constructor TOvcCustomSimpleField.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
-
- FSimpleDataType := sftString;
- FPictureMask := pmAnyChar;
-
- efFieldClass := fcSimple;
- efDataType := sfGetDataType(FSimpleDataType);
- efPicture[0] := pmAnyChar;
- efPicture[1] := #0;
-end;
-
-procedure TOvcCustomSimpleField.CreateWnd;
-var
- P : array[0..MaxEditLen+1] of Byte;
-begin
- {save field data}
- if efSaveData then
- efTransfer(@P, otf_GetData);
-
- inherited CreateWnd;
-
- sfSetDefaultRanges;
- efSetInitialValue;
-
- {if we saved the field data, restore it}
- if efSaveData then
- efTransfer(@P, otf_SetData);
-
- {set save data flag}
- efSaveData := True;
-end;
-
-procedure TOvcCustomSimpleField.efEdit(var Msg : TMessage; Cmd : Word);
- {-process the specified editing command}
-
- procedure EditSimple(var Msg : TMessage; Cmd : Word);
- {-process the specified editing command for String and PChar fields}
- label
- ExitPoint;
- var
- SaveHPos : Word;
- DelEnd : Word;
- Len : Word;
- Ch : AnsiChar;
- PrevCh : AnsiChar;
- MF : ShortInt;
- HaveSel : Boolean;
- SelExtended : Boolean;
-
- function CharIsOK : Boolean;
- {-return true if Ch can be added to the string}
- var
- PrevCh : AnsiChar;
- begin
- if efIsNumericType then
- if Ch = IntlSupport.DecimalChar then
- Ch := pmDecimalPt
- else if Ch = pmDecimalPt then
- Ch := #0;
- if (Ch < ' ') and not (sefLiteral in sefOptions) then begin
- CharIsOK := False;
- Exit;
- end;
- if efHPos = 0 then
- PrevCh := ' '
- else
- PrevCh := efEditSt[efHPos-1];
- CharIsOK := efCharOK(efPicture[0], Ch, PrevCh, True);
- if efIsNumericType and (Ch = pmDecimalPt) then
- Ch := IntlSupport.DecimalChar;
- end;
-
- function CheckAutoAdvance(SP : Integer) : Boolean;
- {-see if we need to auto-advance to next/previous field}
- begin
- CheckAutoAdvance := False;
- if (SP < 0) and
- (efoAutoAdvanceLeftRight in Controller.EntryOptions) then begin
- efMoveFocusToPrevField;
- CheckAutoAdvance := True;
- end else if (SP >= MaxLength) then
- if (Cmd = ccChar) and
- (efoAutoAdvanceChar in Controller.EntryOptions) then begin
- efMoveFocusToNextField;
- CheckAutoAdvance := True;
- end else if (Cmd <> ccChar) and
- (efoAutoAdvanceLeftRight in Controller.EntryOptions) then begin
- efMoveFocusToNextField;
- CheckAutoAdvance := True;
- end;
- end;
-
- procedure FixSelValues;
- var
- I : Integer;
- begin
- if efSelStart > efSelEnd then begin
- I := efSelStart;
- efSelStart := efSelEnd;
- efSelEnd := I;
- end;
- end;
-
- procedure UpdateSel;
- begin
- if efSelStart = SaveHPos then
- efSelStart := efHPos
- else
- efSelEnd := efHPos;
- FixSelValues;
- end;
-
- procedure WordLeftPrim;
- begin
- Dec(efHPos);
- while (efHPos >= 0) and ((efHPos >= Len) or (efEditSt[efHPos] = ' ')) do
- Dec(efHPos);
- while (efHPos >= 0) and (efEditSt[efHPos] <> ' ') do
- Dec(efHPos);
- Inc(efHPos);
- end;
-
- procedure WordRightPrim;
- begin
- if efEditSt[efHPos] <> ' ' then
- Inc(efHPos);
- while (efHPos < Len) and (efEditSt[efHPos] <> ' ') do
- Inc(efHPos);
- while (efHPos < Len) and (efEditSt[efHPos] = ' ') do
- Inc(efHPos);
- end;
-
- procedure DeleteSel;
- begin
- StrStDeletePrim(efEditSt, efSelStart, efSelEnd-efSelStart);
- Len := StrLen(efEditSt);
- efHPos := efSelStart;
- efSelEnd := efHPos;
- MF := 10;
- end;
-
- procedure PastePrim(P : PAnsiChar);
- var
- Ch : AnsiChar;
- IsNum : Boolean;
- begin
- if HaveSel then
- DeleteSel;
- IsNum := efIsNumericType;
- while P^ <> #0 do begin
- Ch := P^;
- if IsNum then
- if Ch = IntlSupport.DecimalChar then
- Ch := pmDecimalPt
- else if (Ch = pmDecimalPt) or (Ch = ' ') then
- Ch := #0;
- if efCharOK(efPicture[0], Ch, #255, True) then begin
- if (Len = MaxLength) and (efHPos < Len) and
- (efoInsertPushes in Controller.EntryOptions) then begin
- Dec(Len);
- efEditSt[Len] := #0;
- end;
- if (Len < MaxLength) then begin
- if efIsNumericType and (Ch = pmDecimalPt) then
- Ch := IntlSupport.DecimalChar;
- StrChInsertPrim(efEditSt, Ch, efHPos);
- Inc(efHPos);
- Inc(Len);
- end;
- MF := 10;
- end;
- Inc(P);
- end;
- end;
-
- begin
- HaveSel := efSelStart <> efSelEnd;
- MF := Ord(HaveSel);
- SaveHPos := efHPos;
- SelExtended := False;
-
- case Cmd of
- ccAccept : {};
- ccCtrlChar : Include(sefOptions, sefLiteral);
- else
- if Cmd <> ccChar then
- Exclude(sefOptions, sefLiteral);
- end;
-
- Len := StrLen(efEditSt);
- Exclude(sefOptions, sefCharOK);
-
- case Cmd of
- ccChar :
- begin
- Ch := AnsiChar(Lo(Msg.wParam));
- if (sefAcceptChar in sefOptions) and CharIsOk then begin
- Exclude(sefOptions, sefAcceptChar);
- Exclude(sefOptions, sefLiteral);
- if HaveSel then begin
- DeleteSel;
- if efHPos = 0 then
- PrevCh := ' '
- else
- PrevCh := efEditSt[efHPos-1];
- efCharOK(efPicture[0], Ch, PrevCh, True);
- end;
- if (sefInsert in sefOptions) then begin
- if (Len = MaxLength) and (efHPos < Len) and
- (efoInsertPushes in Controller.EntryOptions) then begin
- Dec(Len);
- efEditSt[Len] := #0;
- end;
- if (Len < MaxLength) then begin
- StrChInsertPrim(efEditSt, Ch, efHPos);
- Inc(efHPos);
- CheckAutoAdvance(efHPos);
- end else if not CheckAutoAdvance(efHPos) then
- efConditionalBeep;
- end else if (efHPos+1) <= MaxLength then begin
- efEditSt[efHPos] := Ch;
- if efHPos >= Len then
- efEditSt[efHPos+1] := #0;
- Inc(efHPos);
- CheckAutoAdvance(efHPos);
- end else begin
- if not CheckAutoAdvance(efHPos) then
- efConditionalBeep;
- Dec(MF, 10);
- end;
- Inc(MF, 10);
- end else begin
- Exclude(sefOptions, sefLiteral);
- if sefAcceptChar in sefOptions then
- efConditionalBeep
- else
- goto ExitPoint;
- end;
- end;
- ccMouse :
- if Len > 0 then begin
- efHPos := efGetMousePos(SmallInt(Msg.lParamLo));
- {drag highlight initially if shift key is being pressed}
- if (GetKeyState(vk_Shift) < 0) then begin
- SelExtended := True;
- if HaveSel then begin
- if efHPos > efSelStart then
- efSelEnd := efHPos
- else
- efSelStart := efHPos;
- end else begin
- efSelStart := SaveHPos;
- efSelEnd := efHPos;
- end;
- FixSelValues;
- end else begin
- SetSelection(efHPos, efHPos);
- efPositionCaret(False);
- end;
- end;
- ccMouseMove :
- if Len > 0 then begin
- efHPos := efGetMousePos(SmallInt(Msg.lParamLo));
- UpdateSel;
- end;
- ccDblClk :
- if Len > 0 then begin
- efHPos := efGetMousePos(SmallInt(Msg.lParamLo));
- WordLeftPrim;
- SaveHPos := efHPos;
- efSelStart := SaveHPos;
- efSelEnd := SaveHPos;
- WordRightPrim;
- UpdateSel;
- end;
-{$IFDEF LCL} //LCL form not seeing tab (?), so handle tab command here}
- ccTab : efMoveFocusToNextField;
-{$ENDIF}
- ccLeft :
- if efHPos > 0 then
- Dec(efHPos)
- else
- CheckAutoAdvance(-1);
- ccRight :
- if efHPos < Len then
- Inc(efHPos)
- else
- CheckAutoAdvance(MaxLength);
- ccUp :
- if (efoAutoAdvanceUpDown in Controller.EntryOptions) then
- efMoveFocusToPrevField
- else if (efoArrowIncDec in Options) and not (efoReadOnly in Options) then
- IncreaseValue(True, 1)
- else if efHPos > 0 then
- Dec(efHPos)
- else
- CheckAutoAdvance(-1);
- ccDown :
- if (efoAutoAdvanceUpDown in Controller.EntryOptions) then
- efMoveFocusToNextField
- else if (efoArrowIncDec in Options) and not (efoReadOnly in Options) then
- DecreaseValue(True, 1)
- else if efHPos < Len then
- Inc(efHPos)
- else
- CheckAutoAdvance(MaxLength);
- ccWordLeft :
- if efHPos > 0 then
- WordLeftPrim
- else
- CheckAutoAdvance(-1);
- ccWordRight :
- if efHPos < Len then
- WordRightPrim
- else
- CheckAutoAdvance(MaxLength);
- ccHome :
- efHPos := 0;
- ccEnd :
- efHPos := Len;
- ccExtendLeft :
- if efHPos > 0 then begin
- Dec(efHPos);
- UpdateSel;
- end else
- MF := -1;
- ccExtendRight :
- if efHPos < Len then begin
- Inc(efHPos);
- UpdateSel;
- end else
- MF := -1;
- ccExtendHome :
- begin
- efHPos := 0;
- UpdateSel;
- end;
- ccExtendEnd :
- begin
- efHPos := Len;
- UpdateSel;
- end;
- ccExtWordLeft :
- if efHPos > 0 then begin
- WordLeftPrim;
- UpdateSel;
- end else
- MF := -1;
- ccExtWordRight :
- if efHPos < Len then begin
- WordRightPrim;
- UpdateSel;
- end else
- MF := -1;
- ccCut :
- if HaveSel then
- DeleteSel;
- ccCopy : efCopyPrim;
- ccPaste :
- {for some reason, a paste action within the IDE}
- {gets passed to the control. filter it out}
- if not (csDesigning in ComponentState) then
- PastePrim(PAnsiChar(Msg.lParam));
- ccBack :
- if HaveSel then
- DeleteSel
- else if efHPos > 0 then begin
- Dec(efHPos);
- StrStDeletePrim(efEditSt, efHPos, 1);
- MF := 10;
- end;
- ccDel :
- if HaveSel then
- DeleteSel
- else if efHPos < Len then begin
- StrStDeletePrim(efEditSt, efHPos, 1);
- MF := 10;
- end;
- ccDelWord :
- if HaveSel then
- DeleteSel
- else if efHPos < Len then begin
- {start deleting at the caret}
- DelEnd := efHPos;
-
- {delete all of the current word, if any}
- if efEditSt[efHPos] <> ' ' then
- while (efEditSt[DelEnd] <> ' ') and (DelEnd < Len) do
- Inc(DelEnd);
-
- {delete any spaces prior to the next word, if any}
- while (efEditSt[DelEnd] = ' ') and (DelEnd < Len) do
- Inc(DelEnd);
-
- StrStDeletePrim(efEditSt, efHPos, DelEnd-efHPos);
- MF := 10;
- end;
- ccDelLine :
- if Len > 0 then begin
- efEditSt[0] := #0;
- efHPos := 0;
- MF := 10;
- end;
- ccDelEol :
- if efHPos < Len then begin
- efEditSt[efHPos] := #0;
- MF := 10;
- end;
- ccDelBol :
- if Len > 0 then begin
- StrStDeletePrim(efEditSt, 0, efHPos);
- efHPos := 0;
- MF := 10;
- end;
- ccIns :
- begin
- if sefInsert in sefOptions then
- Exclude(sefOptions, sefInsert)
- else
- Include(sefOptions, sefInsert);
- efCaret.InsertMode := (sefInsert in sefOptions);
- end;
- ccRestore : Restore;
- ccAccept :
- begin
- Include(sefOptions, sefCharOK);
- Include(sefOptions, sefAcceptChar);
- Exit;
- end;
- ccDec :
- DecreaseValue(True, 1);
- ccInc :
- IncreaseValue(True, 1);
- ccCtrlChar, ccSuppress, ccPartial :
- goto ExitPoint;
- else
- Include(sefOptions, sefCharOK);
- goto ExitPoint;
- end;
- Exclude(sefOptions, sefAcceptChar);
-
- case Cmd of
- ccRestore, ccMouseMove, ccDblClk,
- ccExtendLeft, ccExtendRight,
- ccExtendHome, ccExtendEnd,
- ccExtWordLeft, ccExtWordRight :
- Inc(MF);
- ccMouse :
- if SelExtended then
- Inc(MF);
- ccCut, ccCopy, ccPaste : {};
- else
- efSelStart := efHPos;
- efSelEnd := efHPos;
- end;
-
- ExitPoint:
- if efPositionCaret(True) then
- Inc(MF);
- if MF >= 10 then
- efFieldModified;
- if MF > 0 then
- Invalidate;
- end;
-
- procedure EditChar(var Msg : TMessage; Cmd : Word);
- {-process the specified editing command for Char fields}
- label
- ExitPoint;
- var
- MF : Byte;
- Ch : AnsiChar;
-
- function CharIsOK : Boolean;
- {-return true if Ch can be added to the string}
- begin
- if (Ch < ' ') and not (sefLiteral in sefOptions) then
- CharIsOK := False
- else
- CharIsOK := efCharOK(efPicture[0], Ch, ' ', True);
- end;
-
- function CheckAutoAdvance(SP : Integer) : Boolean;
- {-see if we need to auto-advance to next/previous field}
- begin
- CheckAutoAdvance := False;
- if (SP < 0) and
- (efoAutoAdvanceLeftRight in Controller.EntryOptions) then begin
- efMoveFocusToPrevField;
- Result := True;
- end else if (SP > 0) then
- if (Cmd = ccChar) and
- (efoAutoAdvanceChar in Controller.EntryOptions) then begin
- efMoveFocusToNextField;
- Result := True;
- end else if (Cmd <> ccChar) and
- (efoAutoAdvanceLeftRight in Controller.EntryOptions) then begin
- efMoveFocusToNextField;
- Result := True;
- end;
- end;
-
- procedure PastePrim(P : PAnsiChar);
- begin
- while P^ <> #0 do begin
- Ch := P^;
- if efCharOK(efPicture[0], Ch, #255, True) then begin
- efEditSt[0] := Ch;
- MF := 10;
- Exit;
- end;
- Inc(P);
- end;
- end;
-
- begin
- MF := Ord(efSelStart <> efSelEnd);
- case Cmd of
- ccAccept : ;
- ccCtrlChar :
- Include(sefOptions, sefLiteral);
- else
- efHPos := 0;
- if Cmd <> ccChar then
- Exclude(sefOptions, sefLiteral);
- end;
-
- Exclude(sefOptions, sefCharOK);
- case Cmd of
- ccChar :
- begin
- Ch := AnsiChar(Lo(Msg.wParam));
- if sefAcceptChar in sefOptions then
- if CharIsOk then begin
- efEditSt[0] := Ch;
- efEditSt[1] := #0;
- CheckAutoAdvance(1);
- MF := 10;
- end else
- efConditionalBeep;
- {end;}
- sefOptions := sefOptions - [sefAcceptChar, sefLiteral];
- end;
- ccLeft, ccWordLeft :
- CheckAutoAdvance(-1);
- ccRight, ccWordRight :
- CheckAutoAdvance(MaxLength);
- ccUp :
- if (efoAutoAdvanceUpDown in Controller.EntryOptions) then
- efMoveFocusToPrevField
- else
- CheckAutoAdvance(-1);
- ccDown :
- if (efoAutoAdvanceUpDown in Controller.EntryOptions) then
- efMoveFocusToNextField
- else
- CheckAutoAdvance(MaxLength);
- ccRestore :
- Restore;
- ccExtendRight, ccExtendEnd, ccExtWordRight :
- efSelEnd := 1;
- ccMouseMove :
- if efGetMousePos(SmallInt(Msg.lParamLo)) > 0 then
- efSelEnd := 1
- else
- efSelEnd := 0;
- ccDblClk :
- efSelEnd := 1;
- ccCopy : efCopyPrim;
- ccPaste :
- {for some reason, a paste action within the IDE}
- {gets passed to the control. filter it out}
- if not (csDesigning in ComponentState) then
- PastePrim(PAnsiChar(Msg.lParam));
- ccAccept :
- begin
- sefOptions := sefOptions + [sefCharOK, sefAcceptChar];
- Exit;
- end;
- ccMouse, ccExtendLeft, ccExtendHome, ccExtWordLeft : ;
- ccDec :
- DecreaseValue(True, 1);
- ccInc :
- IncreaseValue(True, 1);
- ccCtrlChar, ccSuppress, ccPartial :
- goto ExitPoint;
- else
- Include(sefOptions, sefCharOK);
- goto ExitPoint;
- end;
- Exclude(sefOptions, sefAcceptChar);
-
- case Cmd of
- ccRestore, ccMouseMove, ccDblClk, ccExtendRight,
- ccExtendEnd, ccExtWordRight :
- Inc(MF);
- else
- efSelStart := 0;
- efSelEnd := 0;
- end;
-
- ExitPoint:
- if efPositionCaret(True) then
- Inc(MF);
- if MF >= 10 then
- efFieldModified;
- if MF > 0 then
- Invalidate;
- end;
-
-begin {edit}
- case FSimpleDataType of
- sftString,
- sftLongInt, sftWord, sftInteger, sftByte, sftShortInt,
- sftReal, sftExtended, sftDouble, sftSingle, sftComp :
- EditSimple(Msg, Cmd);
- sftChar, sftBoolean, sftYesNo :
- EditChar(Msg, Cmd);
- end;
-end;
-
-function TOvcCustomSimpleField.efGetDisplayString(Dest : PAnsiChar; Size : Word) : PAnsiChar;
- {-return the display string in Dest and a pointer as the result}
-var
- Len : Word;
-begin
- Result := inherited efGetDisplayString(Dest, Size);
-
- Len := StrLen(Dest);
- if Len = 0 then
- Exit;
-
- if Uninitialized and not (sefHaveFocus in sefOptions) then begin
- FillChar(Dest[0], Len, ' ');
- Exit;
- end;
-
- if (efoPasswordMode in Options) then
- FillChar(Dest[0], Len, PasswordChar);
-
- if PadChar <> ' ' then begin
- FillChar(Dest[Len], MaxLength-Len, PadChar);
- Dest[MaxLength] := #0;
- end;
-end;
-
-procedure TOvcCustomSimpleField.efIncDecValue(Wrap : Boolean; Delta : Double);
- {-increment field by Delta}
-var
- S : TEditString;
-
- procedure IncDecValueChar;
- {-increment Char field by Delta}
- var
- C, CC, CL, CH, MC : AnsiChar;
- OK : Boolean;
- begin
- {get valid range}
- CL := efRangeLo.rtChar;
- CH := efRangeHi.rtChar;
- if CL = CH then begin
- CL := #1;
- CH := #255;
- end;
-
- {get current character}
- C := efEditSt[0];
-
- {get mask character}
- MC := efPicture[0];
-
- {exit if we're at the range limit and not allowed to wrap}
- if (Delta < 0) and (C = CL) then begin
- if not Wrap then
- Exit;
- end else if (Delta > 0) and (C = CH) then
- if not Wrap then
- Exit;
-
- {find the next/prev allowable character}
- OK := False;
- repeat
- repeat
- if Delta = 1 then
- Inc(C)
- else
- Dec(C);
- CC := C;
- efFixCase(MC, CC, ' ');
- until efCharOK(MC, C, ' ', False) and (C = CC);
-
- {check result to see if it's in valid range}
- if (C >= CL) and (C <= CH) then
- OK := True
- else if Wrap then
- OK := False
- else
- Exit;
- until OK;
-
- efTransfer(@C, otf_SetData);
- efPerformRepaint(True);
- end;
-
- procedure IncDecValueBoolean;
- var
- Ch : AnsiChar;
- B : Boolean;
- begin
- Ch := UpCaseChar(efEditSt[0]);
- if Ch = IntlSupport.TrueChar then
- Ch := IntlSupport.FalseChar
- else
- Ch := IntlSupport.TrueChar;
- B := Ch = IntlSupport.TrueChar;
-
- efTransfer(@B, otf_SetData);
- efPerformRepaint(True);
- end;
-
- procedure IncDecValueYesNo;
- var
- Ch : AnsiChar;
- B : Boolean;
- begin
- Ch := UpCaseChar(efEditSt[0]);
- if Ch = IntlSupport.YesChar then
- Ch := IntlSupport.NoChar
- else
- Ch := IntlSupport.YesChar;
- B := Ch = IntlSupport.YesChar;
-
- efTransfer(@B, otf_SetData);
- efPerformRepaint(True);
- end;
-
- procedure IncDecValueLongInt;
- var
- L : LongInt;
- begin
- if efStr2Long(efEditSt, L) then begin
- if (Delta < 0) and (L <= efRangeLo.rtLong) then
- if Wrap then
- L := efRangeHi.rtLong
- else Exit
- else if (Delta > 0) and (L >= efRangeHi.rtLong) then
- if Wrap then
- L := efRangeLo.rtLong
- else Exit
- else
- Inc(L, Trunc(Delta));
-
- {insure valid value}
- if L < efRangeLo.rtLong then
- L := efRangeLo.rtLong;
- if L > efRangeHi.rtLong then
- L := efRangeHi.rtLong;
-
- efTransfer(@L, otf_SetData);
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueReal;
- var
- Re : Real;
- Code : Integer;
- begin
- {convert efEditSt to a real}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Re, Code);
-{$ELSE}
- Val(String(S), Re, Code);
-{$ENDIF}
- if Code = 0 then begin
- if (Delta < 0) and (Re <= efRangeLo.rtReal) then
- if Wrap then
- Re := efRangeHi.rtReal
- else Exit
- else if (Delta > 0) and (Re >= efRangeHi.rtReal) then
- if Wrap then
- Re := efRangeLo.rtReal
- else Exit
- else
- Re := Re + Delta;
-
- {insure valid value}
- if Re < efRangeLo.rtReal then
- Re := efRangeLo.rtReal;
- if Re > efRangeHi.rtReal then
- Re := efRangeHi.rtReal;
-
- efTransfer(@Re, otf_SetData);
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueExtended;
- var
- Ex : Extended;
- Code : Integer;
- begin
- {convert efEditSt to an real}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Ex, Code);
-{$ELSE}
- Val(String(S), Ex, Code);
-{$ENDIF}
- if Code = 0 then begin
- if (Delta < 0) and (Ex <= efRangeLo.rtExt) then
- if Wrap then
- Ex := efRangeHi.rtExt
- else Exit
- else if (Delta > 0) and (Ex >= efRangeHi.rtExt) then
- if Wrap then
- Ex := efRangeLo.rtExt
- else Exit
- else
- Ex := Ex + Delta;
-
- {insure valid value}
- if Ex < efRangeLo.rtExt then
- Ex := efRangeLo.rtExt;
- if Ex > efRangeHi.rtExt then
- Ex := efRangeHi.rtExt;
-
- efTransfer(@Ex, otf_SetData);
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueDouble;
- var
- Db : Double;
- Code : Integer;
- begin
- {convert efEditSt to an real}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Db, Code);
-{$ELSE}
- Val(String(S), Db, Code);
-{$ENDIF}
- if Code = 0 then begin
- if (Delta < 0) and (Db <= efRangeLo.rtExt) then
- if Wrap then
- Db := efRangeHi.rtExt
- else Exit
- else if (Delta > 0) and (Db >= efRangeHi.rtExt) then
- if Wrap then
- Db := efRangeLo.rtExt
- else Exit
- else
- Db := Db + Delta;
-
- {insure valid value}
- if Db < efRangeLo.rtExt then
- Db := efRangeLo.rtExt;
- if Db > efRangeHi.rtExt then
- Db := efRangeHi.rtExt;
-
- efTransfer(@Db, otf_SetData);
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueSingle;
- var
- Si : Single;
- Code : Integer;
- begin
- {convert efEditSt to an real}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Si, Code);
-{$ELSE}
- Val(String(S), Si, Code);
-{$ENDIF}
- if Code = 0 then begin
- if (Delta < 0) and (Si <= efRangeLo.rtExt) then
- if Wrap then
- Si := efRangeHi.rtExt
- else Exit
- else if (Delta > 0) and (Si >= efRangeHi.rtExt) then
- if Wrap then
- Si := efRangeLo.rtExt
- else Exit
- else
- Si := Si + Delta;
-
- {insure valid value}
- if Si < efRangeLo.rtExt then
- Si := efRangeLo.rtExt;
- if Si > efRangeHi.rtExt then
- Si := efRangeHi.rtExt;
-
- efTransfer(@Si, otf_SetData);
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueComp;
- var
-{$IFNDEF FPC}
- Co : Comp;
-{$ELSE}
- {$IFDEF CPU86}
- Co : Comp;
- {$ELSE}
- Co : Double;
- {$ENDIF}
-{$ENDIF}
- Code : Integer;
- begin
- {convert efEditSt to an real}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Co, Code);
-{$ELSE}
- Val(String(S), Co, Code);
-{$ENDIF}
- if Code = 0 then begin
- if (Delta < 0) and (Co <= efRangeLo.rtExt) then
- if Wrap then
- Co := efRangeHi.rtExt
- else Exit
- else if (Delta > 0) and (Co >= efRangeHi.rtExt) then
- if Wrap then
- Co := efRangeLo.rtExt
- else Exit
- else
- Co := Co + Delta;
-
- {insure valid value}
- if Co < efRangeLo.rtExt then
- Co := efRangeLo.rtExt;
- if Co > efRangeHi.rtExt then
- Co := efRangeHi.rtExt;
-
- efTransfer(@Co, otf_SetData);
- efPerformRepaint(True);
- end;
- end;
-
-begin
- if not (sefHaveFocus in sefOptions) then
- Exit;
- case FSimpleDataType of
- sftString : {not supported for this field type};
- sftChar : IncDecValueChar;
- sftBoolean : IncDecValueBoolean;
- sftYesNo : IncDecValueYesNo;
- sftLongInt,
- sftWord,
- sftInteger,
- sftByte,
- sftShortInt : IncDecValueLongInt;
- sftReal : IncDecValueReal;
- sftExtended : IncDecValueExtended;
- sftDouble : IncDecValueDouble;
- sftSingle : IncDecValueSingle;
- sftComp : IncDecValueComp;
- else
- raise EOvcException.Create(GetOrphStr(SCInvalidParamValue));
- end;
- efPositionCaret(False);
-end;
-
-function TOvcCustomSimpleField.efTransfer(DataPtr : Pointer; TransferFlag : Word) : Word;
- {-transfer data to/from the entry fields}
-var
- S : TEditString;
-
- procedure TransferString;
- var
- I : Integer;
- begin
- if TransferFlag = otf_GetData then
- ShortString(DataPtr^) := StrPas(efEditSt)
- else begin
- if ShortString(DataPtr^) = '' then
- efEditSt[0] := #0
- else begin
- StrPLCopy(efEditSt, ShortString(DataPtr^), MaxLength);
- for I := 0 to Integer(StrLen(efEditSt))-1 do
- efFixCase(efNthMaskChar(I), efEditSt[I], #255);
- end;
- end;
- end;
-
- procedure TransferChar;
- begin
- if TransferFlag = otf_GetData then
- AnsiChar(DataPtr^) := efEditSt[0]
- else begin
- efEditSt[0] := AnsiChar(DataPtr^);
- efEditSt[1] := #0;
- end;
- end;
-
- procedure TransferBoolean;
- begin
- if TransferFlag = otf_GetData then
- Boolean(DataPtr^) := (UpCaseChar(efEditSt[0]) = IntlSupport.TrueChar)
- else begin
- if Boolean(DataPtr^) then
- efEditSt[0] := IntlSupport.TrueChar
- else
- efEditSt[0] := IntlSupport.FalseChar;
- efEditSt[1] := #0;
- end;
- end;
-
- procedure TransferYesNo;
- begin
- if TransferFlag = otf_GetData then
- Boolean(DataPtr^) := (UpCaseChar(efEditSt[0]) = IntlSupport.YesChar)
- else begin
- if Boolean(DataPtr^) then
- efEditSt[0] := IntlSupport.YesChar
- else
- efEditSt[0] := IntlSupport.NoChar;
- efEditSt[1] := #0;
- end;
- end;
-
- procedure TransferLongInt;
- begin
- if TransferFlag = otf_GetData then begin
- if not efStr2Long(efEditSt, LongInt(DataPtr^)) then
- LongInt(DataPtr^) := 0;
- end else
- efLong2Str(efEditSt, LongInt(DataPtr^));
- end;
-
- procedure TransferWord;
- var
- L : LongInt;
- begin
- if TransferFlag = otf_GetData then begin
- if efStr2Long(efEditSt, L) then
- Word(DataPtr^) := Word(L)
- else
- Word(DataPtr^) := 0;
- end else
- efLong2Str(efEditSt, Word(DataPtr^));
- end;
-
- procedure TransferInteger;
- var
- L : LongInt;
- begin
- if TransferFlag = otf_GetData then begin
- if efStr2Long(efEditSt, L) then
- SmallInt(DataPtr^) := SmallInt(L)
- else
- SmallInt(DataPtr^) := 0;
- end else
- efLong2Str(efEditSt, SmallInt(DataPtr^));
- end;
-
- procedure TransferByte;
- var
- L : LongInt;
- begin
- if TransferFlag = otf_GetData then begin
- if efStr2Long(efEditSt, L) then
- Byte(DataPtr^) := Byte(L)
- else
- Byte(DataPtr^) := 0;
- end else
- efLong2Str(efEditSt, Byte(DataPtr^));
- end;
-
- procedure TransferShortInt;
- var
- L : LongInt;
- begin
- if TransferFlag = otf_GetData then begin
- if efStr2Long(efEditSt, L) then
- ShortInt(DataPtr^) := ShortInt(L)
- else
- ShortInt(DataPtr^) := 0;
- end else
- efLong2Str(efEditSt, ShortInt(DataPtr^));
- end;
-
- procedure TransferReal;
- label
- UseExp;
- var
- Code : Integer;
- I : Cardinal;
- R : Real;
- begin
- if TransferFlag = otf_GetData then begin
- StrCopy(S, efEditSt);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(PAnsiChar(@S[0]), R, Code);
-{$ELSE}
- Val(String(PAnsiChar(@S[0])), R, Code);
-{$ENDIF}
- if Code <> 0 then
- R := 0;
- Real(DataPtr^) := R;
- end else begin
- {try to use regular notation}
- R := Real(DataPtr^);
- if StrScan(efPicture, pmScientific) <> nil then
- goto UseExp;
- Str(R:0:DecimalPlaces, S);
-
- {trim trailing 0's if appropriate}
- if StrScan(S, pmDecimalPt) <> nil then
- TrimTrailingZerosPChar(S);
-
- {does it fit?}
- if StrLen(S) > MaxLength then begin
- {won't fit--use scientific notation}
- UseExp:
- if (DecimalPlaces <> 0) and (9+DecimalPlaces < MaxLength) then
- Str(R:9+DecimalPlaces, S)
- else
- Str(R:MaxLength, S);
- TrimAllSpacesPChar(S);
- TrimEmbeddedZerosPChar(S);
- end;
-
- {convert decimal point}
- if StrChPos(S, pmDecimalPt, I) then
- S[I] := IntlSupport.DecimalChar;
-
- StrLCopy(efEditSt, S, MaxLength);
- end;
- end;
-
- procedure TransferExtended;
- label
- UseExp;
- var
- Code : Integer;
- I : Cardinal;
- E : Extended;
- begin
- if TransferFlag = otf_GetData then begin
- StrCopy(S, efEditSt);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, E, Code);
-{$ELSE}
- Val(String(S), E, Code);
-{$ENDIF}
- if Code <> 0 then
- E := 0;
- Extended(DataPtr^) := E;
- end else begin
- {try to use regular notation}
- E := Extended(DataPtr^);
- if StrScan(efPicture, pmScientific) <> nil then
- goto UseExp;
- Str(E:0:DecimalPlaces, S);
-
- {trim trailing 0's if appropriate}
- if StrScan(S, pmDecimalPt) <> nil then
- TrimTrailingZerosPChar(S);
-
- {does it fit?}
- if StrLen(S) > MaxLength then begin
- {won't fit--use scientific notation}
- UseExp:
- if (DecimalPlaces <> 0) and (9+DecimalPlaces < MaxLength) then
- Str(E:9+DecimalPlaces, S)
- else
- Str(E:MaxLength, S);
- TrimAllSpacesPChar(S);
- TrimEmbeddedZerosPChar(S);
- end;
-
- {convert decimal point}
- if StrChPos(S, pmDecimalPt, I) then
- S[I] := IntlSupport.DecimalChar;
-
- StrLCopy(efEditSt, S, MaxLength);
- end;
- end;
-
- procedure TransferDouble;
- label
- UseExp;
- var
- Code : Integer;
- I : Cardinal;
- D : Double;
- begin
- if TransferFlag = otf_GetData then begin
- StrCopy(S, efEditSt);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(PAnsiChar(@S[0]), D, Code);
-{$ELSE}
- Val(String(PAnsiChar(@S[0])), D, Code);
-{$ENDIF}
- if Code <> 0 then
- D := 0;
- Double(DataPtr^) := D;
- end else begin
- {try to use regular notation}
- D := Double(DataPtr^);
- if StrScan(efPicture, pmScientific) <> nil then
- goto UseExp;
- Str(D:0:DecimalPlaces, S);
-
- {trim trailing 0's if appropriate}
- if StrScan(S, pmDecimalPt) <> nil then
- TrimTrailingZerosPChar(S);
-
- {does it fit?}
- if StrLen(S) > MaxLength then begin
- {won't fit--use scientific notation}
- UseExp:
- if (DecimalPlaces <> 0) and (9+DecimalPlaces < MaxLength) then
- Str(D:9+DecimalPlaces, S)
- else
- Str(D:MaxLength, S);
- TrimAllSpacesPChar(S);
- TrimEmbeddedZerosPChar(S);
- end;
-
- {convert decimal point}
- if StrChPos(S, pmDecimalPt, I) then
- S[I] := IntlSupport.DecimalChar;
-
- StrLCopy(efEditSt, S, MaxLength);
- end;
- end;
-
- procedure TransferSingle;
- label
- UseExp;
- var
- Code : Integer;
- I : Cardinal;
- G : Single;
- begin
- if TransferFlag = otf_GetData then begin
- StrCopy(S, efEditSt);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, G, Code);
-{$ELSE}
- Val(String(S), G, Code);
-{$ENDIF}
- if Code <> 0 then
- G := 0;
- Single(DataPtr^) := G;
- end else begin
- {try to use regular notation}
- G := Single(DataPtr^);
- if StrScan(efPicture, pmScientific) <> nil then
- goto UseExp;
- Str(G:0:DecimalPlaces, S);
-
- {trim trailing 0's if appropriate}
- if StrScan(S, pmDecimalPt) <> nil then
- TrimTrailingZerosPChar(S);
-
- {does it fit?}
- if StrLen(S) > MaxLength then begin
- {won't fit--use scientific notation}
- UseExp:
- if (DecimalPlaces <> 0) and (9+DecimalPlaces < MaxLength) then
- Str(G:9+DecimalPlaces, S)
- else
- Str(G:MaxLength, S);
- TrimAllSpacesPChar(S);
- TrimEmbeddedZerosPChar(S);
- end;
-
- {convert decimal point}
- if StrChPos(S, pmDecimalPt, I) then
- S[I] := IntlSupport.DecimalChar;
-
- StrLCopy(efEditSt, S, MaxLength);
- end;
- end;
-
- procedure TransferComp;
- {-transfer data to or from Comp fields}
- label
- UseExp;
- var
- Code : Integer;
-{$IFNDEF FPC}
- C : Comp;
-{$ELSE}
- {$IFDEF CPU86}
- C : Comp;
- {$ELSE}
- C : Double;
- {$ENDIF}
-{$ENDIF}
- begin
- if TransferFlag = otf_GetData then begin
- StrCopy(S, efEditSt);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(PAnsiChar(@S[0]), C, Code);
-{$ELSE}
- Val(String(PAnsiChar(@S[0])), C, Code);
-{$ENDIF}
- if Code <> 0 then
- C := 0;
-{$IFNDEF FPC}
- Comp(DataPtr^) := C;
-{$ELSE}
- {$IFDEF CPU86}
- Comp(DataPtr^) := C;
- {$ELSE}
- Double(DataPtr^) := C;
- {$ENDIF}
-{$ENDIF}
- end else begin
- {try to use regular notation}
-{$IFNDEF FPC}
- C := Comp(DataPtr^);
-{$ELSE}
- {$IFDEF CPU86}
- C := Comp(DataPtr^);
- {$ELSE}
- C := Double(DataPtr^);
- {$ENDIF}
-{$ENDIF}
- if StrScan(efPicture, pmScientific) <> nil then
- goto UseExp;
- Str(C:0:DecimalPlaces, S);
-
- {trim trailing 0's if appropriate}
- if StrScan(S, pmDecimalPt) <> nil then
- TrimTrailingZerosPChar(S);
-
- {does it fit?}
- if StrLen(S) > MaxLength then begin
- {won't fit--use scientific notation}
- UseExp:
- Str(C:MaxLength, S);
- TrimAllSpacesPChar(S);
- TrimEmbeddedZerosPChar(S);
- end;
- StrLCopy(efEditSt, S, MaxLength);
- end;
- end;
-
-begin {transfer}
- if DataPtr = nil then begin
- Result := 0;
- Exit;
- end;
-
- case FSimpleDataType of
- sftString : TransferString;
- sftChar : TransferChar;
- sftBoolean : TransferBoolean;
- sftYesNo : TransferYesNo;
- sftLongInt : TransferLongInt;
- sftWord : TransferWord;
- sftInteger : TransferInteger;
- sftByte : TransferByte;
- sftShortInt : TransferShortInt;
- sftReal : TransferReal;
- sftExtended : TransferExtended;
- sftDouble : TransferDouble;
- sftSingle : TransferSingle;
- sftComp : TransferComp;
- else
- raise EOvcException.Create(GetOrphStr(SCInvalidParamValue));
- end;
-
- Result := inherited efTransfer(DataPtr, TransferFlag);
-end;
-
-function TOvcCustomSimpleField.efValidateField : Word;
- {-validate contents of field; result is error code or 0}
-var
- S : TEditString;
-
- procedure ValidateString;
- var
- L : Word;
- begin
- if sefGettingValue in sefOptions then
- Exit;
-
- if efoTrimBlanks in Options then
- if sefHaveFocus in sefOptions then begin
- L := StrLen(efEditSt);
- TrimAllSpacesPChar(efEditSt);
- if StrLen(efEditSt) <> L then
- Invalidate;
- end;
- end;
-
- procedure ValidateChar;
- begin
- if (efRangeLo.rtChar <> efRangeHi.rtChar) and
- ((efEditSt[0] < efRangeLo.rtChar) or (efEditSt[0] > efRangeHi.rtChar)) then
- Result := oeRangeError;
- end;
-
- procedure ValidateBoolean;
- begin
- if (UpCaseChar(efEditSt[0]) <> IntlSupport.TrueChar) and
- (UpCaseChar(efEditSt[0]) <> IntlSupport.FalseChar) then
- Result := oeRangeError;
- end;
-
- procedure ValidateYesNo;
- begin
- if (UpCaseChar(efEditSt[0]) <> IntlSupport.YesChar) and
- (UpCaseChar(efEditSt[0]) <> IntlSupport.NoChar) then
- Result := oeRangeError;
- end;
-
- procedure ValidateLongInt;
- var
- L : LongInt;
- begin
- if not efStr2Long(efEditSt, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- efTransfer(@L, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateWord;
- var
- L : LongInt;
- begin
- if not efStr2Long(efEditSt, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- efTransfer(@L, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateInteger;
- var
- L : LongInt;
- I : Integer;
- begin
- if not efStr2Long(efEditSt, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- I := L;
- efTransfer(@I, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateByte;
- var
- L : LongInt;
- B : Byte;
- begin
- if not efStr2Long(efEditSt, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- B := L;
- efTransfer(@B, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateShortInt;
- var
- L : LongInt;
- Si : ShortInt;
- begin
- if not efStr2Long(efEditSt, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- Si := L;
- efTransfer(@Si, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateReal;
- var
- R : Real;
- Code : Integer;
- begin
- {convert efEditSt to a real}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, R, Code);
-{$ELSE}
- Val(String(S), R, Code);
-{$ENDIF}
-
- {format OK?}
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (R < efRangeLo.rtReal) or (R > efRangeHi.rtReal) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- efTransfer(@R, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateExtended;
- var
- E : Extended;
- Code : Integer;
- begin
- {convert efEditSt to an extended}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, E, Code);
-{$ELSE}
- Val(String(S), E, Code);
-{$ENDIF}
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (E < efRangeLo.rtExt) or (E > efRangeHi.rtExt) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- efTransfer(@E, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateDouble;
- var
- E : Extended;
- D : Double;
- Code : Integer;
- begin
- {convert efEditSt to an extended}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, E, Code);
-{$ELSE}
- Val(String(S), E, Code);
-{$ENDIF}
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (E < efRangeLo.rtExt) or (E > efRangeHi.rtExt) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- D := E;
- efTransfer(@D, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateSingle;
- var
- E : Extended;
- Si : Single;
- Code : Integer;
- begin
- {convert efEditSt to an extended}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, E, Code);
-{$ELSE}
- Val(String(S), E, Code);
-{$ENDIF}
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (E < efRangeLo.rtExt) or (E > efRangeHi.rtExt) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- Si := E;
- efTransfer(@Si, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateComp;
- var
- E : Extended;
-{$IFNDEF FPC}
- C : Comp;
-{$ELSE}
- {$IFDEF CPU86}
- C : Comp;
- {$ELSE}
- C : Double;
- {$ENDIF}
-{$ENDIF}
- Code : Integer;
- begin
- {convert efEditSt to an extended}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, C, Code);
-{$ELSE}
- Val(String(S), C, Code);
-{$ENDIF}
- E := C;
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (E < efRangeLo.rtExt) or (E > efRangeHi.rtExt) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- efTransfer(@C, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
-begin
- Result := 0;
- case FSimpleDataType of
- sftString : ValidateString;
- sftChar : ValidateChar;
- sftBoolean : ValidateBoolean;
- sftYesNo : ValidateYesNo;
- sftLongInt : ValidateLongInt;
- sftWord : ValidateWord;
- sftInteger : ValidateInteger;
- sftByte : ValidateByte;
- sftShortInt : ValidateShortInt;
- sftReal : ValidateReal;
- sftExtended : ValidateExtended;
- sftDouble : ValidateDouble;
- sftSingle : ValidateSingle;
- sftComp : ValidateComp;
- end;
-
- if not (sefUserValidating in sefOptions) then begin
- {user may retrieve data from field. flag that we are doing}
- {user validation to avoid calling this routine recursively}
- Include(sefOptions, sefUserValidating);
- DoOnUserValidation(Result);
- Exclude(sefOptions, sefUserValidating);
- end;
-end;
-
-procedure TOvcCustomSimpleField.sfSetDataType(Value : TSimpleDataType);
- {-set the data type for this field}
-begin
- if FSimpleDataType <> Value then begin
- FSimpleDataType := Value;
- efDataType := sfGetDataType(FSimpleDataType);
- Options := Options + [efoCaretToEnd];
- efSetDefaultRange(efDataType);
-
- {set defaults for this field type}
- sfResetFieldProperties(FSimpleDataType);
- if HandleAllocated then begin
- {don't save data through create window}
- efSaveData := False;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
- end;
-end;
-
-procedure TOvcCustomSimpleField.sfSetPictureMask(Value: AnsiChar);
- {-set the picture mask}
-var
- Buf : array[0..1] of AnsiChar;
-begin
- if FPictureMask <> Value then begin
- if Value in SimplePictureChars then begin
- FPictureMask := Value;
- if csDesigning in ComponentState then begin
- efPicture[0] := Value;
- efPicture[1] := #0;
- Repaint;
- end else begin
- Buf[0] := Value;
- Buf[1] := #0;
- efChangeMask(Buf);
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
- end else
- raise EInvalidPictureMask.Create(Value);
- end;
-end;
-
-function TOvcCustomSimpleField.sfGetDataType(Value : TSimpleDataType) : Byte;
- {-return a Byte value representing the type of this field}
-begin
- case Value of
- sftString : Result := fidSimpleString;
- sftChar : Result := fidSimpleChar;
- sftBoolean : Result := fidSimpleBoolean;
- sftYesNo : Result := fidSimpleYesNo;
- sftLongInt : Result := fidSimpleLongInt;
- sftWord : Result := fidSimpleWord;
- sftInteger : Result := fidSimpleInteger;
- sftByte : Result := fidSimpleByte;
- sftShortInt : Result := fidSimpleShortInt;
- sftReal : Result := fidSimpleReal;
- sftExtended : Result := fidSimpleExtended;
- sftDouble : Result := fidSimpleDouble;
- sftSingle : Result := fidSimpleSingle;
- sftComp : Result := fidSimpleComp;
- else
- raise EOvcException.Create(GetOrphStr(SCInvalidParamValue));
- end;
-end;
-
-procedure TOvcCustomSimpleField.sfResetFieldProperties(FT : TSimpleDataType);
- {-reset field properties based on current setings}
-
- procedure Update(Len: Word; Mask: AnsiChar);
- begin
- MaxLength := Len;
- FPictureMask := Mask;
- efPicture[0] := Mask;
- efPicture[1] := #0;
- DecimalPlaces := 0;
- end;
-
-begin
- case FT of
- sftString : Update(15, pmAnyChar);
- sftBoolean : Update(1, pmTrueFalse);
- sftYesNo : Update(1, pmYesNo);
- sftChar : Update(1, pmAnyChar);
- sftLongInt : Update(11, pmWhole);
- sftWord : Update(5, pmPositive);
- sftInteger : Update(6, pmWhole);
- sftByte : Update(3, pmPositive);
- sftShortInt : Update(4, pmWhole);
- sftReal : Update(14, pmDecimal);
- sftExtended : Update(14, pmDecimal);
- sftDouble : Update(14, pmDecimal);
- sftSingle : Update(14, pmDecimal);
- sftComp : Update(14, pmWhole);
- else
- raise EOvcException.Create(GetOrphStr(SCInvalidParamValue));
- end;
-end;
-
-procedure TOvcCustomSimpleField.sfSetDefaultRanges;
- {-set default range values based on the field type}
-begin
- case FSimpleDataType of
- sftChar, sftBoolean, sftYesNo :
- if efRangeLo.rtChar = efRangeHi.rtChar then
- efSetDefaultRange(efDataType);
- sftLongInt, sftWord, sftInteger, sftByte, sftShortInt :
- if efRangeLo.rtLong = efRangeHi.rtLong then
- efSetDefaultRange(efDataType);
- sftReal :
- if efRangeLo.rtReal = efRangeHi.rtReal then
- efSetDefaultRange(efDataType);
- sftExtended, sftDouble, sftSingle, sftComp :
- if efRangeLo.rtExt = efRangeHi.rtExt then
- efSetDefaultRange(efDataType);
- else
- efSetDefaultRange(efDataType);
- end;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/73/73816cb7c445c65a5f8cbfcf9ed547fb669db049.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/73/73816cb7c445c65a5f8cbfcf9ed547fb669db049.svn-base
deleted file mode 100644
index bbae5243..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/73/73816cb7c445c65a5f8cbfcf9ed547fb669db049.svn-base
+++ /dev/null
@@ -1,315 +0,0 @@
-{*********************************************************}
-{* OVCTBPE1.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 ovctbpe1;
- {-Property editor for the table component}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- Classes, Graphics, Controls,
- {$IFNDEF LCL} {$IFDEF VERSION6} DesignIntf, DesignEditors, {$ELSE} DsgnIntf, {$ENDIF} {$ELSE} PropEdits, {$ENDIF}
- SysUtils, Forms, Dialogs, StdCtrls, OvcBase, OvcEf, OvcPb, OvcNf,
- Buttons, ExtCtrls, OvcTCmmn, OvcTable, OvcTbRws, OvcSf, OvcSc;
-
-type
- TOvcfrmRowEditor = class(TForm)
- ctlHidden: TCheckBox;
- ctlUseDefHeight: TRadioButton;
- ctlUseCustHeight: TRadioButton;
- DoneButton: TBitBtn;
- Panel1: TPanel;
- SpeedButton1: TSpeedButton;
- SpeedButton2: TSpeedButton;
- SpeedButton3: TSpeedButton;
- SpeedButton4: TSpeedButton;
- SpeedButton5: TSpeedButton;
- SpeedButton6: TSpeedButton;
- Label1: TLabel;
- GroupBox1: TGroupBox;
- GroupBox2: TGroupBox;
- Label2: TLabel;
- Label3: TLabel;
- Reset: TBitBtn;
- ctlHeight: TOvcSimpleField;
- ctlDefaultHeight: TOvcSimpleField;
- ctlRowLimit: TOvcSimpleField;
- ctlRowNumber: TOvcSimpleField;
- ApplyButton: TBitBtn;
- DefaultController: TOvcController;
- OvcSpinner1: TOvcSpinner;
- OvcSpinner2: TOvcSpinner;
- OvcSpinner3: TOvcSpinner;
- OvcSpinner4: TOvcSpinner;
- procedure ctlUseDefHeightClick(Sender: TObject);
- procedure ctlUseCustHeightClick(Sender: TObject);
- procedure SpeedButton1Click(Sender: TObject);
- procedure SpeedButton2Click(Sender: TObject);
- procedure SpeedButton3Click(Sender: TObject);
- procedure SpeedButton4Click(Sender: TObject);
- procedure SpeedButton5Click(Sender: TObject);
- procedure SpeedButton6Click(Sender: TObject);
- procedure ctlRowNumberExit(Sender: TObject);
- procedure FormShow(Sender: TObject);
- procedure ResetClick(Sender: TObject);
- procedure ApplyButtonClick(Sender: TObject);
- procedure DoneButtonClick(Sender: TObject);
- procedure ctlRowNumberChange(Sender: TObject);
- private
- { Private declarations }
- FRows : TOvcTableRows;
- FRowNum : TRowNum;
- CurDefHt : boolean;
-
- protected
- procedure RefreshRowData;
- procedure SetRowNum(R : TRowNum);
-
- public
- { Public declarations }
- procedure SetRows(RS : TOvcTableRows);
-
- property Rows : TOvcTableRows
- read FRows
- write SetRows;
-
- property RowNum : TRowNum
- read FRowNum
- write SetRowNum;
-
- end;
-
- {-A table row property editor}
- TOvcTableRowProperty = class(TClassProperty)
- public
- procedure Edit; override;
- function GetAttributes: TPropertyAttributes; override;
- end;
-
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.DFM}
-{$ENDIF}
-
-
-
-{===TOvcTableRowProperty=============================================}
-procedure TOvcTableRowProperty.Edit;
- var
- RowEditor : TOvcfrmRowEditor;
- begin
- RowEditor := TOvcfrmRowEditor.Create(Application);
- try
- RowEditor.SetRows(TOvcTableRows(GetOrdValue));
- RowEditor.ShowModal;
-{$IFNDEF LCL}
- Designer.Modified;
-{$ELSE}
- Modified;
-{$ENDIF}
- finally
- RowEditor.Free;
- end;{try..finally}
- end;
-{--------}
-function TOvcTableRowProperty.GetAttributes: TPropertyAttributes;
- begin
- Result := [paMultiSelect, paDialog, paReadOnly];
- end;
-{====================================================================}
-
-
-{===TRowEditor=======================================================}
-procedure TOvcfrmRowEditor.ApplyButtonClick(Sender: TObject);
- var
- RS : TRowStyle;
- begin
- FRows.Limit := ctlRowLimit.AsInteger;
- if FRowNum >= FRows.Limit then
- RowNum := pred(FRows.Limit);
- FRows.DefaultHeight := ctlDefaultHeight.AsInteger;
- with RS do
- begin
- if ctlUseDefHeight.Checked then
- Height := ctlDefaultHeight.AsInteger
- else
- begin
- Height := ctlHeight.AsInteger;
- if (Height = FRows.DefaultHeight) then
- ctlUseDefHeight.Checked := true;
- end;
- Hidden := ctlHidden.Checked;
- FRows[RowNum] := RS;
- end;
- end;
-{--------}
-procedure TOvcfrmRowEditor.ctlRowNumberExit(Sender: TObject);
- begin
- RowNum := ctlRowNumber.AsInteger;
- end;
-{--------}
-procedure TOvcfrmRowEditor.ctlUseCustHeightClick(Sender: TObject);
- begin
- CurDefHt := false;
- ctlHeight.Enabled := true;
- end;
-{--------}
-procedure TOvcfrmRowEditor.ctlUseDefHeightClick(Sender: TObject);
- begin
- CurDefHt := true;
- ctlHeight.AsInteger := FRows.DefaultHeight;
- ctlHeight.Enabled := false;
- end;
-{--------}
-procedure TOvcfrmRowEditor.FormShow(Sender: TObject);
- begin
- ctlDefaultHeight.AsInteger := FRows.DefaultHeight;
- ctlRowLimit.AsInteger := FRows.Limit;
- RefreshRowData;
- end;
-{--------}
-procedure TOvcfrmRowEditor.RefreshRowData;
- begin
- CurDefHt := FRows.Height[RowNum] = FRows.DefaultHeight;
-
- ctlRowNumber.RangeHi := IntToStr(pred(FRows.Limit));
-
- ctlHidden.Checked := FRows.Hidden[RowNum];
- ctlHeight.AsInteger := FRows.Height[RowNum];
- if CurDefHt then
- begin
- ctlUseDefHeight.Checked := true;
- ctlHeight.Enabled := false;
- end
- else
- begin
- ctlUseCustHeight.Checked := true;
- ctlHeight.Enabled := true;
- end;
-
- ctlRowLimit.AsInteger := FRows.Limit;
- end;
-{--------}
-procedure TOvcfrmRowEditor.ResetClick(Sender: TObject);
- begin
- FRows.Clear;
- ctlDefaultHeight.AsInteger := FRows.DefaultHeight;
- RefreshRowData;
- end;
-{--------}
-procedure TOvcfrmRowEditor.SetRowNum(R : TRowNum);
- begin
- if (FRowNum <> R) then
- begin
- FRowNum := R;
- ctlRowNumber.AsInteger := R;
- RefreshRowData;
- end;
- end;
-{--------}
-procedure TOvcfrmRowEditor.SetRows(RS : TOvcTableRows);
- begin
- if Assigned(FRows) then
- FRows.Free;
- FRows := RS;
- FRowNum := 0;
- CurDefHt := FRows.Height[RowNum] = FRows.DefaultHeight;
- end;
-{--------}
-procedure TOvcfrmRowEditor.SpeedButton1Click(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- if (RowNum > 0) then
- RowNum := RowNum - 1;
- end;
-{--------}
-procedure TOvcfrmRowEditor.SpeedButton2Click(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- if (RowNum < pred(FRows.Limit)) then
- RowNum := RowNum + 1;
- end;
-{--------}
-procedure TOvcfrmRowEditor.SpeedButton3Click(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- RowNum := 0;
- end;
-{--------}
-procedure TOvcfrmRowEditor.SpeedButton4Click(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- RowNum := pred(FRows.Limit);
- end;
-{--------}
-procedure TOvcfrmRowEditor.SpeedButton5Click(Sender: TObject);
- var
- RS : TRowStyle;
- begin
- RS.Hidden := false;
- RS.Height := FRows.DefaultHeight;
- FRows.Insert(FRowNum, RS);
- RefreshRowData;
- end;
-{--------}
-procedure TOvcfrmRowEditor.SpeedButton6Click(Sender: TObject);
- begin
- FRows.Delete(FRowNum);
- RefreshRowData;
- end;
-{====================================================================}
-
-procedure TOvcfrmRowEditor.DoneButtonClick(Sender: TObject);
-begin
- ApplyButtonClick(Self);
-end;
-
-procedure TOvcfrmRowEditor.ctlRowNumberChange(Sender: TObject);
-begin
- ApplyButtonClick(Self);
- RowNum := ctlRowNumber.AsInteger;
-end;
-
-initialization
-{$IFDEF LCL}
-{$I ovctbpe1.lrs} {Include form's resource file}
-{$ENDIF}
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/74/74b23b19be9341ac5a3f9aad56655602b1f40df1.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/74/74b23b19be9341ac5a3f9aad56655602b1f40df1.svn-base
deleted file mode 100644
index b5ca663f..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/74/74b23b19be9341ac5a3f9aad56655602b1f40df1.svn-base
+++ /dev/null
@@ -1,312 +0,0 @@
-{*********************************************************}
-{* O32VPOOL.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 o32vpool;
- {O32ValidatorPool component classes}
-
-interface
-
-uses
- OvcBase, Classes, Graphics, stdctrls, O32Vldtr, o32ovldr, {$IFNDEF LCL} o32pvldr, {$ENDIF} o32rxvld;
-
-type
- TO32ValidatorPool = class;
-
- TVPoolNotifyEvent =
- procedure (Sender: TObject; ValidatorItem: Integer) of object;
-
-
- { - TO32ValidatorItem - }
- TO32ValidatorItem = class(TO32CollectionItem)
- protected {private}
- FValidator : TO32BaseValidator;
- FValidationEvent : String;
- FValidatorClass : TValidatorClass;
- FValidatorType : String;
- FBeepOnError : Boolean;
- FMask : String;
-
- {Component for which this item will validate}
- FComponent : TCustomEdit;
- FComponentColor : TColor;
- FErrorColor : TColor;
- {Event for which this object will execute a validation}
- FEvent : TValidationEvent;
-
- procedure DoValidation(Sender: TObject);
- procedure SetComponent(Value: TCustomEdit);
- procedure SetValidatorType(const Value: String);
- procedure AssignValidator;
- procedure SetEvent(Event: TValidationEvent);
- procedure AssignEvent;
- function ValidatorPool: TO32ValidatorPool;
- public
- constructor Create(Collection: TCollection); override;
- property Validator: TO32BaseValidator
- read FValidator write FValidator;
- property ValidatorClass: TValidatorClass read FValidatorClass
- write FValidatorClass;
- published
- property BeepOnError: Boolean
- read FBeepOnError write FBeepOnError;
- property Name;
- property ErrorColor: TCOlor
- read FErrorColor write FErrorColor;
- property Component: TCustomEdit
- read FComponent write SetComponent;
- property Mask: String
- read FMask write FMask;
- property ValidationEvent: TValidationEvent
- read FEvent write SetEvent;
- property ValidatorType : string
- read FValidatorType write SetValidatorType stored true;
- end;
-
- TO32Validators = class(TO32Collection)
- protected {private}
- FValidatorPool : TO32ValidatorPool;
- function GetItem(Index: Integer): TO32ValidatorItem;
- public
- constructor Create(AOwner : TPersistent;
- ItemClass : TCollectionItemClass); override;
- function AddItem(ValidatorClass: TValidatorClass): TCollectionItem;
- procedure Delete(Index: Integer);
- procedure DeleteByName(const Name: String);
- function GetValidatorByName(const Name: String): TO32BaseValidator;
- property ValidatorPool: TO32ValidatorPool
- read FValidatorPool;
- property Items[index: Integer]: TO32ValidatorItem
- read GetItem;
- end;
-
- { - TO32ValidatorPool - }
- TO32ValidatorPool = class(TO32Component)
- protected {private}
- FValidators: TO32Validators;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- published
- property Name;
- property Validators: TO32Validators
- read FValidators
- write FValidators;
- end;
-
-implementation
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, MyMisc, {$ENDIF} SysUtils, Controls, Dialogs;
-
-{===== TO32ValidatorPool =============================================}
-
-constructor TO32ValidatorPool.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
- FValidators := TO32Validators.Create(self, TO32ValidatorItem);
-end;
-{=====}
-
-destructor TO32ValidatorPool.Destroy;
-begin
- FValidators.Free;
- inherited Destroy;
-end;
-
-
-{===== TO32Validators ================================================}
-constructor TO32Validators.Create(AOwner : TPersistent;
- ItemClass : TCollectionItemClass);
-begin
- inherited;
- FValidatorPool := TO32ValidatorPool(AOwner);
-end;
-{=====}
-
-function TO32Validators.GetValidatorByName(const Name: String): TO32BaseValidator;
-var
- i: Integer;
-begin
- for i := 0 to Count - 1 do begin
- if TO32ValidatorItem(Items[i]).Name = Name then begin
- result := TO32ValidatorItem(Items[i]).Validator;
- exit;
- end;
- end;
- result := nil;
-end;
-{=====}
-
-function TO32Validators.AddItem(ValidatorClass: TValidatorClass):
- TCollectionItem;
-var
- NewItem: TO32ValidatorItem;
-begin
- NewItem := TO32ValidatorItem(inherited Add);
- NewItem.ValidatorClass := ValidatorClass;
- NewItem.Validator := ValidatorClass.Create(FValidatorPool);
- result := NewItem;
-end;
-{=====}
-
-procedure TO32Validators.Delete(Index: Integer);
-begin
- TO32ValidatorItem(Items[Index]).Validator.Free;
- {$IFDEF VERSION5}
- inherited Delete(Index);
- {$ENDIF}
-end;
-{=====}
-
-procedure TO32Validators.DeleteByName(const Name: String);
-var
- i: Integer;
-begin
- for i := 0 to Count - 1 do begin
- if TO32ValidatorItem(Items[i]).Name = Name then begin
- TO32ValidatorItem(Items[i]).Validator.Free;
- {$IFDEF VERSION5}
- inherited Delete(i);
- {$ENDIF}
- exit;
- end;
- end;
-end;
-{=====}
-
-function TO32Validators.GetItem(Index : LongInt) : TO32ValidatorItem;
-begin
- result := TO32ValidatorItem(inherited GetItem(Index));
-end;
-
-{===== TO32ValidatorItem =============================================}
-type
- TProtectedCustomEdit = class(TCustomEdit);
- TProtectedWinControl = class(TWinControl);
-
-constructor TO32ValidatorItem.Create(Collection: TCollection);
-begin
- inherited;
- SetName('ValidatorItem' + IntToStr(Collection.Count));
- FErrorColor := clRed;
- FBeepOnError := true;
-end;
-{=====}
-
-procedure TO32ValidatorItem.DoValidation(Sender: TObject);
-begin
- if not (csDesigning in ValidatorPool.ComponentState)
- and (FValidator <> nil) then begin
- { set the validator's values }
- FValidator.Mask := FMask;
- FValidator.Input := FComponent.Text;
- { execute validation }
- if not FValidator.IsValid then begin
- { beep or not }
- if BeepOnError then MessageBeep(0);
- TProtectedCustomEdit(FComponent).Color := FErrorColor;
- FComponent.SetFocus;
- end
- else
- if (FComponent is TCustomEdit) then
- TProtectedCustomEdit(FComponent).Color := FComponentColor;
- end;
-end;
-
-procedure TO32ValidatorItem.SetComponent(Value: TCustomEdit);
-begin
- if (Value is TCustomEdit) and (FComponent <> Value) then begin
- FComponent := Value;
- FComponentColor := TProtectedCustomEdit(FComponent).Color;
- AssignEvent;
- end;
-end;
-{=====}
-
-procedure TO32ValidatorItem.SetEvent(Event: TValidationEvent);
-begin
- FEvent := Event;
- AssignEvent;
-end;
-{=====}
-
-procedure TO32ValidatorItem.AssignEvent;
-begin
- if (FComponent <> nil) then
- case FEvent of
- veOnChange:
- TProtectedCustomEdit(FComponent).OnChange := DoValidation;
- veOnEnter :
- TProtectedCustomEdit(FComponent).OnEnter := DoValidation;
- veOnExit :
- TProtectedCustomEdit(FComponent).OnExit := DoValidation;
- end;
-end;
-{=====}
-
-procedure TO32ValidatorItem.SetValidatorType(const Value: string);
-begin
- if FValidatorType <> Value then begin
- FValidatorType := Value;
- AssignValidator;
- end;
-end;
-{=====}
-
-procedure TO32ValidatorItem.AssignValidator;
-begin
- if (FValidatorType = 'None') or (FValidatorType = '')then
- FValidatorClass := nil
- else try
- FValidatorClass := TValidatorClass(FindClass(FValidatorType));
- except
- FValidatorClass := nil;
- end;
-
- if FValidatorClass <> nil then
- FValidator
- := FValidatorClass.Create((Collection as TO32Validators).FValidatorPool);
-end;
-{=====}
-
-function TO32ValidatorItem.ValidatorPool: TO32ValidatorPool;
-begin
- Result := TO32Validators(Collection).FValidatorPool;
-end;
-{=====}
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/75/7502b05083ed3fa2d1f3bd493059424f40af8d1a.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/75/7502b05083ed3fa2d1f3bd493059424f40af8d1a.svn-base
deleted file mode 100644
index bd55dc21..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/75/7502b05083ed3fa2d1f3bd493059424f40af8d1a.svn-base
+++ /dev/null
@@ -1,22 +0,0 @@
-program Project1;
-
-uses
-{$IFDEF LCL}
- Interfaces,
-{$ENDIF}
- Forms,
- Unit1 in 'Unit1.pas' {Form1};
-
-{$IFDEF MSWINDOWS}
-{$R *.res} {Include program's icon resource file}
-{$ENDIF}
-
-{$IFNDEF FPC} //With FPC, assume .exe can find .manifest file at runtime
-{$R manifest.res} {Include program's manifest in .exe for XP theme support}
-{$ENDIF}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/75/750abe324e536363ff5d484af94a197ebc656cee.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/75/750abe324e536363ff5d484af94a197ebc656cee.svn-base
deleted file mode 100644
index 14aa2d7e..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/75/750abe324e536363ff5d484af94a197ebc656cee.svn-base
+++ /dev/null
@@ -1,511 +0,0 @@
-{*********************************************************}
-{* OVCTBRWS.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 ovctbrws;
- {-Orpheus Table Rows array}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, LclType, {$ENDIF}
- SysUtils, Classes, OvcConst, OvcTCmmn, OvcSpAry;
-
-type
- TOvcTableRows = class(TPersistent)
- {-Sparse array for rows}
- protected {private}
- {property fields}
- FActiveCount : TRowNum;
- FList : TOvcSparseArray;
- FDefHeight : integer;
- FLimit : TRowNum;
- {property event fields}
- FOnCfgChanged : TRowChangeNotifyEvent;
-
- protected
- {property read access}
- function GetRow(RowNum : TRowNum) : TRowStyle;
- function GetRowHeight(RowNum : TRowNum) : integer;
- function GetRowHidden(RowNum : TRowNum) : boolean;
- function GetRowIsSpecial(RowNum : TRowNum) : boolean;
- {property write access}
- procedure SetDefHeight(H : integer);
- procedure SetRow(RowNum : TRowNum; const RS : TRowStyle);
- procedure SetRowHeight(RowNum : TRowNum; H : integer);
- procedure SetRowHidden(RowNum : TRowNum; H : boolean);
- procedure SetLimit(RowNum : TRowNum);
-
- {general}
- procedure trDoCfgChanged(RowNum1, RowNum2 : TRowNum; Action : TOvcTblActions);
-
- public {protected}
- procedure rwScaleHeights(M, D : integer);
-
- property OnCfgChanged : TRowChangeNotifyEvent
- write FOnCfgChanged;
-
- public
- constructor Create;
- {-Create an array of row styles}
- destructor Destroy; override;
- {-Destroy an array of row styles}
-
- procedure Append(const RS : TRowStyle);
- {-Add row to end of current list, increment Limit}
- procedure Clear;
- {-Delete all row styles (reset all rows to the defaults)}
- procedure Delete(RowNum : TRowNum);
- {-Delete a row, move rows below it up one, decrement Limit}
- procedure Exchange(const RowNum1, RowNum2 : TRowNum);
- {-Exchange two rows}
- procedure Insert(const RowNum : TRowNum;
- const RS : TRowStyle);
- {-Insert a row, move rows below it down one, increment Limit}
- procedure Reset(const RowNum : TRowNum);
- {-Reset a row to the defaults}
-
- property List [RowNum : TRowNum] : TRowStyle
- {-Array of row styles}
- read GetRow write SetRow;
- default;
-
- {properties}
- property Count : TRowNum
- {-The current number of rows with explicit attributes}
- read FActiveCount;
-
- property DefaultHeight : integer
- {-The default row height}
- read FDefHeight write SetDefHeight;
-
- property Height [RowNum : TRowNum] : integer
- {-Array of row heights}
- read GetRowHeight write SetRowHeight;
-
- property Hidden [RowNum : TRowNum] : boolean
- {-Array of row hidden flags}
- read GetRowHidden write SetRowHidden;
-
- property RowIsSpecial [RowNum : TRowNum] : boolean
- read GetRowIsSpecial;
-
- property Limit : TRowNum
- {-Maximum number of rows}
- read FLimit write SetLimit;
- end;
-
-
-implementation
-
-
-{===Extra RowStyle routines==========================================}
-function NewRowStyle(AHeight : integer; AHidden : boolean) : PRowStyle;
- {-Allocate a row style on the heap}
- begin
- Result := New(PRowStyle);
- with Result^ do
- begin
- Height := AHeight;
- Hidden := AHidden;
- end;
- end;
-{--------}
-function DelRow(Index : longint; Item : pointer; ExtraData : pointer) : boolean; far;
- {-Iterator to delete a row style from the sparse list}
- var
- R : PRowStyle absolute Item;
- begin
- Dispose(R);
- Result := true;
- end;
-{--------------------------------------------------------------------}
-
-{Note: the row numbers passed to this class have a minimum limit of
- zero, and an upper limit that consists of two parts. Firstly
- the real upper limit is the value of Limit: if a row number
- is greater than this an out-of-bounds exception is generated.
- Secondly the upper limit for rows with explicit styles is
- MaxSparseArrayItems, since that is the limit for the under-
- lying sparse array. Generally exceeding this limit causes the
- action to be ignored, no exception is generated.}
-
-
-{===TOvcTableRows==========================================================}
-constructor TOvcTableRows.Create;
- begin
- FList := TOvcSparseArray.Create;
- FDefHeight := tbDefRowHeight;
- FLimit := tbDefRowCount;
- end;
-{--------}
-destructor TOvcTableRows.Destroy;
- begin
- if Assigned(FList) then
- begin
- Clear;
- FList.Free;
- end;
- end;
-{--------}
-procedure TOvcTableRows.Append(const RS : TRowStyle);
- begin
- Insert(Limit, RS);
- end;
-{--------}
-procedure TOvcTableRows.Clear;
- var
- DummyPtr : pointer;
- begin
- DummyPtr := nil;
- FList.ForAll(DelRow, false, DummyPtr);
- FList.Clear;
- FActiveCount := 0;
- trDoCfgChanged(0, 0, taAll);
- end;
-{--------}
-procedure TOvcTableRows.Delete(RowNum : TRowNum);
- var
- RS : PRowStyle;
- begin
- if (RowNum < 0) or (RowNum >= Limit) then
- TableErrorRes(SCTableRowOutOfBounds);
- if (RowNum < OvcSpAry.MaxSparseArrayItems) then
- begin
- RS := PRowStyle(FList[RowNum]);
- if Assigned(RS) then
- begin
- Dispose(RS);
- dec(FActiveCount);
- end;
- FList.Delete(RowNum);
- Limit := Limit - 1;
- trDoCfgChanged(RowNum, 0, taDelete);
- end;
- end;
-{--------}
-procedure TOvcTableRows.trDoCfgChanged(RowNum1, RowNum2 : TRowNum; Action : TOvcTblActions);
- {-On a change, call the notify event handler}
- begin
- if Assigned(FOnCfgChanged) then
- FOnCfgChanged(Self, RowNum1, RowNum2, Action);
- end;
-{--------}
-procedure TOvcTableRows.Exchange(const RowNum1, RowNum2 : TRowNum);
- begin
- if (RowNum1 < 0) or (RowNum1 >= Limit) then
- TableErrorRes(SCTableRowOutOfBounds);
- if (RowNum2 < 0) or (RowNum2 >= Limit) then
- TableErrorRes(SCTableRowOutOfBounds);
- if (RowNum1 <> RowNum2) and
- (RowNum1 < OvcSpAry.MaxSparseArrayItems) and
- (RowNum2 < OvcSpAry.MaxSparseArrayItems) then
- begin
- FList.Exchange(RowNum1, RowNum2);
- trDoCfgChanged(RowNum1, RowNum2, taExchange);
- end;
- end;
-{--------}
-function TOvcTableRows.GetRow(RowNum : TRowNum) : TRowStyle;
- var
- PRS : PRowStyle;
- begin
- if (RowNum < 0) or (RowNum >= Limit) then
- TableErrorRes(SCTableRowOutOfBounds);
- if (FActiveCount > 0) and (RowNum < OvcSpAry.MaxSparseArrayItems) then
- PRS := PRowStyle(FList[RowNum])
- else
- PRS := nil;
- if Assigned(PRS) then
- begin
- Result := PRS^;
- if (Result.Height = UseDefHt) then
- Result.Height := DefaultHeight;
- end
- else
- with Result do
- begin
- Height := DefaultHeight;
- Hidden := false;
- end;
- end;
-{--------}
-function TOvcTableRows.GetRowHeight(RowNum : TRowNum) : integer;
- var
- PRS : PRowStyle;
- begin
- if (RowNum < 0) or (RowNum >= Limit) then
- TableErrorRes(SCTableRowOutOfBounds);
- Result := DefaultHeight;
- if (FActiveCount > 0) and (RowNum < OvcSpAry.MaxSparseArrayItems) then
- begin
- PRS := PRowStyle(FList[RowNum]);
- if Assigned(PRS) then
- begin
- Result := PRS^.Height;
- if (Result = UseDefHt) then
- Result := DefaultHeight;
- end;
- end;
- end;
-{--------}
-function TOvcTableRows.GetRowHidden(RowNum : TRowNum) : boolean;
- var
- PRS : PRowStyle;
- begin
- if (RowNum < 0) or (RowNum >= Limit) then
- TableErrorRes(SCTableRowOutOfBounds);
- Result := false;
- if (FActiveCount > 0) and (RowNum < OvcSpAry.MaxSparseArrayItems) then
- begin
- PRS := PRowStyle(FList[RowNum]);
- if Assigned(PRS) then
- Result := PRS^.Hidden;
- end;
- end;
-{--------}
-function TOvcTableRows.GetRowIsSpecial(RowNum : TRowNum) : boolean;
- var
- PRS : PRowStyle;
- begin
- if (RowNum < 0) or (RowNum >= Limit) then
- TableErrorRes(SCTableRowOutOfBounds);
- if (FActiveCount > 0) and (RowNum < OvcSpAry.MaxSparseArrayItems) then
- begin
- PRS := PRowStyle(FList[RowNum]);
- Result := Assigned(PRS);
- end
- else
- Result := false;
- end;
-{--------}
-procedure TOvcTableRows.Insert(const RowNum : TRowNum;
- const RS : TRowStyle);
- var
- Height : integer;
- begin
- {note: you can insert a style at row number Limit}
- if (RowNum < 0) or (RowNum > Limit) then
- TableErrorRes(SCTableRowOutOfBounds);
- if (RowNum >= OvcSpAry.MaxSparseArrayItems) then
- TableErrorRes(SCTableMaxRows);
- Height := RS.Height;
- if (Height < 1) or (Height = DefaultHeight) then
- Height := UseDefHt;
- if (RS.Hidden = false) and (Height = UseDefHt) then
- FList.Insert(RowNum, nil)
- else
- begin
- FList.Insert(RowNum, NewRowStyle(Height, RS.Hidden));
- inc(FActiveCount);
- end;
- Limit := Limit + 1;
- trDoCfgChanged(RowNum, 0, taInsert);
- end;
-{--------}
-procedure TOvcTableRows.Reset(const RowNum : TRowNum);
- var
- PRS : PRowStyle;
- begin
- if (RowNum < 0) or (RowNum >= Limit) then
- TableErrorRes(SCTableRowOutOfBounds);
- if (FActiveCount > 0) and (RowNum < OvcSpAry.MaxSparseArrayItems) then
- begin
- PRS := PRowStyle(FList[RowNum]);
- if Assigned(PRS) then
- begin
- Dispose(PRS);
- FList[RowNum] := nil;
- dec(FActiveCount);
- trDoCfgChanged(RowNum, 0, taSingle);
- end;
- end;
- end;
-{--------}
-type
- PScaleExtraData = ^TScaleExtraData;
- TScaleExtraData = packed record
- M, D : integer;
- end;
- {------}
-function ScaleHeight(Index : longint; Item : pointer;
- ExtraData : pointer) : boolean; far;
- var
- RS : PRowStyle absolute Item;
- ED : PScaleExtraData absolute ExtraData;
- begin
- Result := true;
- with RS^ do
- if (Height <> UseDefHt) then
- Height := MulDiv(Height, ED^.M, ED^.D);
- end;
- {------}
-procedure TOvcTableRows.rwScaleHeights(M, D : integer);
- var
- ExtraData : TScaleExtraData;
- begin
- FDefHeight := MulDiv(FDefHeight, M, D);
- if (FActiveCount > 0) then
- begin
- ExtraData.M := M;
- ExtraData.D := D;
- FList.ForAll(ScaleHeight, false, @ExtraData);
- end;
- end;
-{--------}
-procedure TOvcTableRows.SetDefHeight(H : integer);
- begin
- if (H <> FDefHeight) and (H >= 1) then
- begin
- FDefHeight := H;
- trDoCfgChanged(0, 0, taAll);
- end;
- end;
-{--------}
-procedure TOvcTableRows.SetLimit(RowNum : TRowNum);
- begin
- if RowNum < 1 then
- RowNum := 1;
- if (RowNum <> FLimit) then
- begin
- FLimit := RowNum;
- trDoCfgChanged(RowLimitChanged, 0, taGeneral);
- end;
- end;
-{--------}
-procedure TOvcTableRows.SetRow(RowNum : TRowNum; const RS : TRowStyle);
- var
- PRS : PRowStyle;
- Height : integer;
- begin
- if (RowNum < 0) or (RowNum >= Limit) then
- TableErrorRes(SCTableRowOutOfBounds);
- if (RowNum < OvcSpAry.MaxSparseArrayItems) then
- begin
- Height := RS.Height;
- if (Height < 1) or (Height = DefaultHeight) then
- Height := UseDefHt;
- if (RS.Hidden = false) and (Height = UseDefHt) then
- Reset(RowNum)
- else
- begin
- PRS := PRowStyle(FList[RowNum]);
- if Assigned(PRS) then
- PRS^ := RS
- else
- begin
- FList[RowNum] := NewRowStyle(Height, RS.Hidden);
- inc(FActiveCount);
- end;
- trDoCfgChanged(RowNum, 0, taSingle);
- end;
- end;
- end;
-{--------}
-procedure TOvcTableRows.SetRowHeight(RowNum : TRowNum; H : integer);
- var
- PRS : PRowStyle;
- begin
- if (RowNum < 0) or (RowNum >= Limit) then
- TableErrorRes(SCTableRowOutOfBounds);
- if (RowNum < OvcSpAry.MaxSparseArrayItems) then
- begin
- if (H < 1) or (H = DefaultHeight) then
- H := UseDefHt;
- PRS := PRowStyle(FList[RowNum]);
- if Assigned(PRS) then
- begin
- if (H <> PRS^.Height) then
- begin
- if (H = UseDefHt) then
- if not PRS^.Hidden then
- begin
- Dispose(PRS);
- FList[RowNum] := nil;
- dec(FActiveCount);
- end
- else
- PRS^.Height := UseDefHt
- else
- PRS^.Height := H;
- trDoCfgChanged(RowNum, 0, taSingle);
- end;
- end
- else if (H <> UseDefHt) then {only create new style if not default}
- begin
- FList[RowNum] := NewRowStyle(H, false);
- inc(FActiveCount);
- trDoCfgChanged(RowNum, 0, taSingle);
- end;
- end;
- end;
-{--------}
-procedure TOvcTableRows.SetRowHidden(RowNum : TRowNum; H : boolean);
- var
- PRS : PRowStyle;
- begin
- if (RowNum < 0) or (RowNum >= Limit) then
- TableErrorRes(SCTableRowOutOfBounds);
- if (RowNum < OvcSpAry.MaxSparseArrayItems) then
- begin
- PRS := PRowStyle(FList[RowNum]);
- if Assigned(PRS) then
- begin
- if (H <> PRS^.Hidden) then
- begin
- if (not H) and (PRS^.Height = UseDefHt) then
- begin
- Dispose(PRS);
- FList[RowNum] := nil;
- dec(FActiveCount);
- end
- else
- PRS^.Hidden := H;
- trDoCfgChanged(RowNum, 0, taSingle);
- end;
- end
- else if H then {only create new style if hidden}
- begin
- FList[RowNum] := NewRowStyle(UseDefHt, H);
- inc(FActiveCount);
- trDoCfgChanged(RowNum, 0, taSingle);
- end;
- end;
- end;
-{====================================================================}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/75/755d88c2d2eddd02d16ec65470bd431fb4c8de40.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/75/755d88c2d2eddd02d16ec65470bd431fb4c8de40.svn-base
deleted file mode 100644
index 28fffcee..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/75/755d88c2d2eddd02d16ec65470bd431fb4c8de40.svn-base
+++ /dev/null
@@ -1,195 +0,0 @@
-{*********************************************************}
-{* O32INTLST.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 ***** *}
-
-//{$APPTYPE GUI}
-//{$A+,B-,C+,D+,E-,F-,G+,H+,I+,J+,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}
-//{$MINSTACKSIZE $00004000}
-//{$MAXSTACKSIZE $00100000}
-//{$IMAGEBASE $00400000}
-
-{The following is a modified version of stack code, which was originally written
- for Algorithms Alfresco. It is copyright(c)2001 by Julian M. Bucknall and is
- used here with permission.}
-
-{$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 o32intlst;
- {Integer List class for Orpheus.}
-
-interface
-
-uses
- Classes;
-
-type
- TO32IntList = class
- protected {private}
- FAllowDups : boolean;
- FCount : integer;
- FIsSorted : boolean;
- FList : TList;
- function ilGetCapacity : integer;
- function ilGetItem(aInx : integer) : integer;
- procedure ilSetCapacity(aValue : integer);
- procedure ilSetCount(aValue : integer);
- procedure ilSetIsSorted(aValue : boolean);
- procedure ilSetItem(aInx : integer; aValue : integer);
- procedure ilSort;
- public
- constructor Create;
- destructor Destroy; override;
- function Add(aItem : integer) : integer;
- procedure Clear;
- procedure Insert(aInx : Integer; aItem : Pointer);
- property AllowDups : boolean
- read FAllowDups write FAllowDups;
- property Capacity : integer
- read ilGetCapacity write ilSetCapacity;
- property Count : integer
- read FCount write ilSetCount;
- property IsSorted : boolean
- read FIsSorted write ilSetIsSorted;
- property Items[aInx : integer] : integer
- read ilGetItem write ilSetItem; default;
- end;
-
-implementation
-
-uses
- SysUtils;
-
-{===== TO32IntList ===================================================}
-constructor TO32IntList.Create;
-begin
- inherited Create;
- FList := TList.Create;
- FIsSorted := true;
- FAllowDups := false;
-end;
-{--------}
-destructor TO32IntList.Destroy;
-begin
- FList.Free;
- inherited Destroy;
-end;
-{--------}
-function TO32IntList.Add(aItem : integer) : integer;
-var
- L, R, M : integer;
-begin
- if (not IsSorted) or (Count = 0) then
- Result := FList.Add(pointer(aItem))
- else begin
- Result := -1;
- L := 0;
- R := pred(Count);
- while (L <= R) do begin
- M := (L + R) div 2;
- if (integer(FList.List^[M]) = aItem) then begin
- if AllowDups then begin
- FList.Insert(M, pointer(aItem));
- Result := M;
- end;
- Exit;
- end;
- if (integer(FList.List^[M]) < aItem) then
- L := M + 1
- else
- R := M - 1;
- end;
- FList.Insert(L, pointer(aItem));
- Result := L;
- end;
- inc(FCount);
-end;
-{--------}
-procedure TO32IntList.Clear;
-begin
- FList.Clear;
- FCount := 0;
- FIsSorted := true;
-end;
-{--------}
-function TO32IntList.ilGetCapacity : integer;
-begin
- Result := FList.Capacity;
-end;
-{--------}
-function TO32IntList.ilGetItem(aInx : integer) : integer;
-begin
- Assert((0 <= aInx) and (aInx < Count), 'Index out of bounds');
- Result := integer(FList.List^[aInx]);
-end;
-{--------}
-procedure TO32IntList.ilSetCapacity(aValue : integer);
-begin
- FList.Capacity := aValue;
-end;
-{--------}
-procedure TO32IntList.ilSetCount(aValue : integer);
-begin
- FList.Count := aValue;
- FCount := FList.Count;
-end;
-{--------}
-procedure TO32IntList.ilSetIsSorted(aValue : boolean);
-begin
- if (aValue <> FIsSorted) then begin
- FIsSOrted := aValue;
- if FIsSorted then
- ilSort;
- end;
-end;
-{--------}
-procedure TO32IntList.ilSetItem(aInx : integer; aValue : integer);
-begin
- Assert((0 <= aInx) and (aInx < Count), 'Index out of bounds');
- FList.List^[aInx] := pointer(aValue);
-end;
-{--------}
-procedure TO32IntList.ilSort;
-begin
- Assert(false, 'TO32IntList.ilSort has not been implemented yet');
-end;
-{--------}
-procedure TO32IntList.Insert(aInx : Integer; aItem : Pointer);
-begin
- FIsSorted := false;
- FList.Insert(aInx, pointer(aItem));
- inc(FCount);
-end;
-{===== TO32IntList - end =============================================}
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/75/75998b55ec364bb61be08f888c7e697e15151892.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/75/75998b55ec364bb61be08f888c7e697e15151892.svn-base
deleted file mode 100644
index 52b12161..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/75/75998b55ec364bb61be08f888c7e697e15151892.svn-base
+++ /dev/null
@@ -1,698 +0,0 @@
-{*********************************************************}
-{* OVCSPARY.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 ovcspary;
- {-Orpheus - sparse array implementation}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, {$ENDIF}
- SysUtils, OvcExcpt, OvcConst, OvcData;
-
-const
- MaxSparseArrayItems = 320000; {maximum items in a sparse array}
-
-type
- TSparseArrayFunc = function (Index : longint; Item : pointer;
- ExtraData : pointer) : boolean;
- {-Sparse array's iterator type. Should return true to continue iterating,
- false otherwise.}
-
- {The sparse array class}
- TOvcSparseArray = class
- protected {private}
- FCount : longint; {Fake count of the items}
- FArray : pointer; {Sparse array}
-
- ChunkCount : word; {Number of chunks}
- ChunkArraySize : word; {Size of FArray}
-
- procedure RecalcCount;
-
- protected
- function GetActiveCount : longint;
- function GetItem(Index : longint) : pointer;
- procedure PutItem(Index : longint; Item : pointer);
-
- public
- constructor Create;
- destructor Destroy; override;
-
- function Add(Item : pointer) : longint;
- {-Add Item to end of array}
- procedure Clear;
- {-Clear array}
- procedure Delete(Index : longint);
- {-Delete item at Index, all items below move up one}
- procedure Exchange(Index1, Index2 : longint);
- {-Swap the items at Index1 and Index2}
- function First : pointer;
- {-Return First item}
- function ForAll(Action : TSparseArrayFunc;
- Backwards : boolean;
- ExtraData : pointer) : longint;
- {-Iterate through all active items, maybe backwards}
- function IndexOf(Item : pointer) : longint;
- {-Get the index of Item}
- procedure Insert(Index : longint; Item : pointer);
- {-Insert Item at Index, it and all items below move down one}
- function Last : pointer;
- {-Return Last item}
- procedure Squeeze;
- {-Pack the sparse array}
-
- property Count : longint
- {-Logical count of the number of items (=IndexOf(Last)+1)}
- read FCount;
- property ActiveCount : longint
- {-Count of non-nil items}
- read GetActiveCount;
- property Items[Index : longint] : pointer
- {-Items array}
- read GetItem write PutItem;
- default;
- end;
-
-
-implementation
-
-
-{Notes: the sparse array is implemented as an array of chunks, each
- chunk contains 32 items (2^5). The array of chunks consists
- of a set of elements, each with chunk index and a pointer to
- the chunk. To find the item for a given index you do two
- things: calculate the chunk index (divide by 32) and the
- index into the chunk (the remainder once divided by 32).
- For example: where is item 100? 100 = 3*32 + 4, so you try
- and find chunk index 3 in the chunk array (the array is sorted
- by chunk index, hence you do a binary search), and if found
- return the 5th element (zero based arrays). If not found then
- the item does not exist.
- Thus setting item 10000 in a sparse array will allocate only
- one chunk, the 9999 previous items are all assumed nil.
- The sparse array can only accomodate pointers. An unused item
- will be nil. A nil pointer will indicate an unused item. Hence
- you cannot really use a sparse array for longints say, unless
- you can guarantee that all your values will be non-nil.
-
- Sizing stuff: maximum number of pointers that can be stored is
- just less than 350,000. For various reasons the maximum index
- that is allowed for the sparse array is 319,999 meaning that a
- sparse array could hold up to 320,000 pointers. To increase this
- you could hold 64 or 128 pointers per chunk instead.
- The minimum heap the sparse array will take is 896 bytes.
-
- Sparse arrays cannot really be used for keeping sorted items:
- obviously all the items will appear at the start of the array,
- there can be no holes.
-}
-
-const
- ShiftValue = 5;
- ChunkElements = 1 shl ShiftValue; {Number of elements in a chunk: 32}
- ChunkMask = pred(ChunkElements); {Mask used for the item in a chunk: $1F}
-
-type
- PChunk = ^TChunk; {Definition of a chunk}
- TChunk = array [0..pred(ChunkElements)] of pointer;
-
- TChunkArrayElement = packed record {Definition of a chunk array element}
- ChunkIndex : word; {..index of the chunk}
- Chunk : PChunk; {..the chunk itself}
- end;
-
-const
- DefChunkArrayElements = 4; {Initial size of the chunk array}
- MaxChunkArrayElements = ($10000 div sizeof(TChunkArrayElement)) - 1;
- {Absolute maximum of chunk array elements}
-
-type
- PChunkArray = ^TChunkArray; {Definition of a chunk array}
- TChunkArray = array [0..pred(MaxChunkArrayElements)] of TChunkArrayElement;
-
-{===Helper routines==================================================}
-procedure RaiseException(ClassType : integer);
- begin
- case ClassType of
- 1 : raise ESAEAtMaxSize.Create(GetOrphStr(SCSAEAtMaxSize));
- 2 : raise ESAEOutOfBounds.Create(GetOrphStr(SCSAEOutOfBounds));
- else
- raise ESparseArrayError.Create(GetOrphStr(SCSAEGeneral));
- end;{case}
- end;
-{--------}
-function GrowChunkArray(A : PChunkArray; var CurSize : word) : PChunkArray;
- {-Grow the chunk array, return the new size and the new pointer}
- var
- NewSize : longint;
- NewSizeAdj : word;
- begin
- NewSize := longint(CurSize) +
- (DefChunkArrayElements * sizeof(TChunkArrayElement));
- NewSizeAdj := MaxChunkArrayElements * sizeof(TChunkArrayElement);
- if (NewSize < NewSizeAdj) then
- NewSizeAdj := NewSize;
- GetMem(Result, NewSizeAdj);
- {$IFOPT D+}
- FillChar(Result^, NewSizeAdj, $CC);
- {$ENDIF}
- if (CurSize <> 0) then
- begin
- Move(A^, Result^, CurSize);
- FreeMem(A, CurSize);
- end;
- CurSize := NewSizeAdj;
- end;
-{--------}
-function GetChunk(A : PChunkArray;
- CI : word; NumChunks : word) : integer;
- {-Find a chunk array element given the chunk index CI and the number of
- chunks. Return the index into the chunk array, or -1 if not found.}
- var
- L, R : integer;
- MsInx : word;
- begin
- L := 0;
- R := pred(NumChunks);
- repeat
- Result := (L + R) div 2;
- MsInx := A^[Result].ChunkIndex;
- if (CI = MsInx) then
- Exit
- else if (CI < MsInx) then
- R := pred(Result)
- else
- L := succ(Result);
- until (L > R);
- Result := -1;
- end;
-{--------}
-function EnsureChunk(var A : PChunkArray; CI : word;
- var NumChunks, Size : word;
- DontCreate : boolean) : integer;
- {-Makes sure that chunk CI is available for use. If it does not yet
- exist and DontCreate is false, creates a new chunk, inserts it into
- the chunk array (possibly growing the array). Return the index of
- the chunk in the array.}
- var
- NumElements : word;
- L, R, M : integer;
- MsInx : word;
- begin
- L := 0;
- if (NumChunks > 0) then
- begin
- R := pred(NumChunks);
- repeat
- M := (L + R) div 2;
- MsInx := A^[M].ChunkIndex;
- if (CI = MsInx) then
- begin
- Result := M;
- Exit;
- end
- else if (CI < MsInx) then
- R := pred(M)
- else
- L := succ(M);
- until (L > R);
- end;
-
- if DontCreate then
- begin
- Result := -1;
- Exit;
- end;
-
- Result := L;
-
- NumElements := Size div sizeof(TChunkArrayElement);
- if (NumChunks = NumElements) then
- A := GrowChunkArray(A, Size);
-
- if (Result < NumChunks) then
- Move(A^[Result], A^[succ(Result)],
- (NumChunks - Result) * sizeof(TChunkArrayElement));
-
- with A^[Result] do
- begin
- ChunkIndex := CI;
- Chunk := New(PChunk);
- FillChar(Chunk^, sizeof(TChunk), 0);
- end;
-
- inc(NumChunks);
- end;
-{--------}
-function ChunkIsBlank(A : PChunkArray; ArrayInx : word) : boolean;
- {-Return true if the chunk has no items (all pointers are nil).}
- const
- ChunkSizeInWords = sizeof(TChunk) div 2;
- ChunkSizeInDWords = sizeof(TChunk) div 4;
- var
- Chunk : PChunk;
-{$IFDEF NoAsm}
- ItemNum : Integer;
-{$ENDIF}
- begin
- Chunk := A^[ArrayInx].Chunk;
-{$IFDEF NoAsm}
- for ItemNum := 0 to Pred(ChunkElements) do
- begin
- if Chunk^[ItemNum] <> nil then
- begin
- Result := False;
- Exit;
- end;
- end;
- Result := True;
-{$ELSE}
- asm
- push edi
-{$IFDEF VERSION6} { Delphi 6 codegen bug }
- push ecx
-{$ENDIF}
- lea eax, Chunk
- mov edi, [eax]
- xor eax, eax
- mov edx, eax
- mov ecx, ChunkSizeInDWords
- repe scasd
- jne @@Exit
- inc edx
- @@Exit:
-{$IFDEF VERSION6} { Delphi 6 codegen bug }
- pop ecx
-{$ENDIF}
- mov @Result, dl
- pop edi
- end;
-{$ENDIF}
- end;
-{--------}
-procedure DeleteChunk(A : PChunkArray; ArrayInx : word; var NumChunks : word);
- {-Delete a chunk, moving chunks below up one.}
- begin
- Dispose(A^[ArrayInx].Chunk);
- if ArrayInx < pred(NumChunks) then
- Move(A^[succ(ArrayInx)], A^[ArrayInx],
- (NumChunks - ArrayInx) * sizeof(TChunkArrayElement));
- dec(NumChunks);
- {$IFOPT D+}
- FillChar(A^[NumChunks], sizeof(TChunkArrayElement), $CC);
- {$ENDIF}
- end;
-
-{===TOvcSparseArray ForAll routines=====================================}
-function CountActiveElements(Index : longint;
- Item : pointer;
- ExtraData : pointer) : boolean; far;
- var
- ED : ^longint absolute ExtraData;
- begin
- Result := True;
- inc(ED^);
- end;
-{=====}
-
-function Find1stOrLastElement(Index : longint;
- Item : pointer;
- ExtraData : pointer) : boolean; far;
- var
- ED : ^pointer absolute ExtraData;
- begin
- Find1stOrLastElement := false;
- ED^ := Item;
- end;
-{=====}
-
-function FindSpecificElement(Index : longint;
- Item : pointer;
- ExtraData : pointer) : boolean; far;
- begin
- {continue looking if this Item is NOT the one we want}
- FindSpecificElement := Item <> ExtraData;
- end;
-{=====}
-
-constructor TOvcSparseArray.Create;
- begin
- FArray := GrowChunkArray(FArray, ChunkArraySize);
- end;
-{=====}
-
-destructor TOvcSparseArray.Destroy;
- begin
- if Assigned(FArray) then
- begin
- Clear;
- FreeMem(FArray, ChunkArraySize);
- end;
- end;
-{=====}
-
-procedure TOvcSparseArray.RecalcCount;
- var
- Dummy : pointer;
- begin
- FCount := succ(ForAll(Find1stOrLastElement, true, @Dummy));
- end;
-{--------}
-procedure TOvcSparseArray.Squeeze;
- var
- ArrayInx : word;
- begin
- ArrayInx := 0;
- while ArrayInx <> ChunkCount do
- if ChunkIsBlank(FArray, ArrayInx) then
- DeleteChunk(FArray, ArrayInx, ChunkCount)
- else
- inc(ArrayInx);
- end;
-{=======================================================================}
-
-
-{===TOvcSparseArray property access=====================================}
-function TOvcSparseArray.GetActiveCount : longint;
- begin
- Result := 0;
- ForAll(CountActiveElements, true, @Result);
- end;
-{--------}
-function TOvcSparseArray.GetItem(Index : longint) : pointer;
- var
- ChunkIndex : word;
- ChunkNum : integer;
- begin
- if (Index < 0) or (Index >= MaxSparseArrayItems) then
- begin
- RaiseException(2);
- end;
-
- Result := nil;
- if (ChunkCount > 0) then
- begin
- ChunkIndex := Index shr ShiftValue;
- ChunkNum := GetChunk(FArray, ChunkIndex, ChunkCount);
- if (ChunkNum <> -1) then
- Result := PChunkArray(FArray)^[ChunkNum].Chunk^[Index and ChunkMask];
- end;
- end;
-{--------}
-procedure TOvcSparseArray.PutItem(Index : longint; Item : pointer);
- var
- ChunkIndex : word;
- ChunkNum : integer;
- begin
- if (Index < 0) or (Index >= MaxSparseArrayItems) then
- begin
- RaiseException(2);
- end;
-
- ChunkIndex := Index shr ShiftValue;
- ChunkNum := EnsureChunk(PChunkArray(FArray),
- ChunkIndex, ChunkCount, ChunkArraySize,
- (Item = nil));
-
- if (ChunkNum <> -1) then
- begin
- PChunkArray(FArray)^[ChunkNum].Chunk^[Index and ChunkMask] := Item;
- if (Item = nil) then
- Squeeze;
- RecalcCount;
- end;
- end;
-{====================================================================}
-
-
-{===TOvcSparseArray item maintenance====================================}
-function TOvcSparseArray.Add(Item : pointer) : longint;
- begin
- if (FCount = MaxSparseArrayItems) then
- RaiseException(1);
-
- Result := FCount;
- PutItem(Result, Item);
- end;
-{--------}
-procedure TOvcSparseArray.Clear;
- var
- i : integer;
- begin
- if (ChunkCount > 0) then
- begin
- for i := 0 to pred(ChunkCount) do
- Dispose(PChunkArray(FArray)^[i].Chunk);
- {$IFOPT D+}
- FillChar(FArray^, ChunkArraySize, $CC);
- {$ENDIF}
- end;
- ChunkCount := 0;
- FCount := 0;
- end;
-{--------}
-procedure TOvcSparseArray.Delete(Index : longint);
- const
- LastPos = pred(ChunkElements);
- var
- MajorInx : word;
- ChunkNum, Dummy : integer;
- StartPos : word;
- OurChunk : PChunk;
- Transferred : boolean;
- begin
- if (Index < 0) or (Index >= MaxSparseArrayItems) then
- begin
- RaiseException(2);
- end;
-
- if (Index >= FCount) then
- Exit;
-
- MajorInx := Index shr ShiftValue;
- ChunkNum := EnsureChunk(PChunkArray(FArray),
- MajorInx, ChunkCount, ChunkArraySize,
- false);
-
- StartPos := Index and ChunkMask;
- OurChunk := PChunkArray(FArray)^[ChunkNum].Chunk;
- if (StartPos <> LastPos) then
- Move(OurChunk^[succ(StartPos)], OurChunk^[StartPos],
- (LastPos-StartPos)*sizeof(Pointer));
-
- inc(ChunkNum);
- while (ChunkNum <> ChunkCount) do
- begin
- with PChunkArray(FArray)^[ChunkNum] do
- begin
- if (ChunkIndex = MajorInx+1) then
- begin
- Transferred := true;
- OurChunk^[LastPos] := Chunk^[0];
- end
- else
- begin
- Transferred := false;
- OurChunk^[LastPos] := nil;
- end;
- MajorInx := ChunkIndex;
- OurChunk := Chunk;
- end;
- if (OurChunk^[0] <> nil) and (not Transferred) then
- begin
- Dummy := EnsureChunk(PChunkArray(FArray),
- MajorInx-1, ChunkCount, ChunkArraySize,
- true);
- PChunkArray(FArray)^[Dummy].Chunk^[LastPos] :=
- OurChunk^[0];
- end;
- Move(OurChunk^[1], OurChunk^[0], LastPos*sizeof(Pointer));
- inc(ChunkNum);
- end;
-
- OurChunk^[LastPos] := nil;
- Squeeze;
- RecalcCount;
- end;
-{--------}
-procedure TOvcSparseArray.Exchange(Index1, Index2 : longint);
- var
- Item1, Item2 : pointer;
- begin
- if (Index1 = Index2) then
- Exit;
-
- if (Index1 < 0) or (Index1 >= MaxSparseArrayItems) then
- begin
- RaiseException(2);
- end;
- if (Index2 < 0) or (Index2 >= MaxSparseArrayItems) then
- begin
- RaiseException(2);
- end;
-
- Item1 := GetItem(Index1);
- Item2 := GetItem(Index2);
- PutItem(Index2, Item1);
- PutItem(Index1, Item2);
- end;
-{--------}
-function TOvcSparseArray.First : pointer;
- begin
- Result := nil;
- ForAll(Find1stOrLastElement, false, @Result);
- end;
-{--------}
-function TOvcSparseArray.ForAll(Action : TSparseArrayFunc;
- Backwards : boolean;
- ExtraData : pointer) : longint;
- var
- MajorInx : word;
- MinorInx : word;
- MajorStub : longint;
- label
- ExitLoopsReverse, ExitLoopsForwards;
- begin
- if (ChunkCount = 0) then
- Result := -1
- else if Backwards then
- begin
- for MajorInx := pred(ChunkCount) downto 0 do
- with PChunkArray(FArray)^[MajorInx] do
- begin
- MajorStub := longint(ChunkIndex) shl ShiftValue;
- for MinorInx := pred(ChunkElements) downto 0 do
- if (Chunk^[MinorInx] <> nil) then
- begin
- Result := MajorStub + MinorInx;
- if not Action(Result,
- Chunk^[MinorInx],
- ExtraData) then
- Goto ExitLoopsReverse;
- end;
- end;
- Result := -1;
- ExitLoopsReverse:
- end
- else
- begin
- for MajorInx := 0 to pred(ChunkCount) do
- with PChunkArray(FArray)^[MajorInx] do
- begin
- MajorStub := longint(ChunkIndex) shl ShiftValue;
- for MinorInx := 0 to pred(ChunkElements) do
- if (Chunk^[MinorInx] <> nil) then
- begin
- Result := MajorStub + MinorInx;
- if not Action(Result,
- Chunk^[MinorInx],
- ExtraData) then
- Goto ExitLoopsForwards;
- end;
- end;
- Result := -1;
- ExitLoopsForwards:
- end;
- end;
-{--------}
-function TOvcSparseArray.IndexOf(Item : pointer) : longint;
- begin
- Result := ForAll(FindSpecificElement, true, Item);
- end;
-{--------}
-procedure TOvcSparseArray.Insert(Index : longint; Item : pointer);
- const
- LastPos = pred(ChunkElements);
- var
- MajorInx : word;
- ChunkNum : integer;
- CarryItem, NewCarryItem : pointer;
- StartPos : word;
- begin
- if (Index < 0) or (Index >= MaxSparseArrayItems) then
- begin
- RaiseException(2);
- end;
-
- if (FCount = MaxSparseArrayItems) then
- RaiseException(1);
-
- if (Index >= FCount) then
- begin
- PutItem(Index, Item);
- Exit;
- end;
-
- MajorInx := Index shr ShiftValue;
- ChunkNum := EnsureChunk(PChunkArray(FArray),
- MajorInx, ChunkCount, ChunkArraySize,
- false);
-
- CarryItem := Item;
- StartPos := Index and ChunkMask;
- repeat
- with PChunkArray(FArray)^[ChunkNum] do
- begin
- MajorInx := ChunkIndex;
- NewCarryItem := Chunk^[LastPos];
- if (StartPos <> LastPos) then
- Move(Chunk^[StartPos], Chunk^[succ(StartPos)],
- (LastPos-StartPos)*sizeof(Pointer));
- Chunk^[StartPos] := CarryItem;
- CarryItem := NewCarryItem;
- StartPos := 0;
- end;
- inc(ChunkNum);
- if (CarryItem <> nil) then
- if (ChunkNum = ChunkCount) or
- (PChunkArray(FArray)^[ChunkNum].ChunkIndex <> MajorInx+1) then
- ChunkNum := EnsureChunk(PChunkArray(FArray),
- MajorInx+1, ChunkCount, ChunkArraySize,
- false);
- until (ChunkNum = ChunkCount);
- inc(FCount);
- end;
-{--------}
-function TOvcSparseArray.Last : pointer;
- begin
- Result := nil;
- ForAll(Find1stOrLastElement, true, @Result);
- end;
-{====================================================================}
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/75/75f86e66490dae5cb2fe8a6b04027e76afd4672c.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/75/75f86e66490dae5cb2fe8a6b04027e76afd4672c.svn-base
deleted file mode 100644
index 93620a86..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/75/75f86e66490dae5cb2fe8a6b04027e76afd4672c.svn-base
+++ /dev/null
@@ -1,49 +0,0 @@
-LazarusResources.Add('TForm1','FORMDATA',[
- 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#192#0#3'Top'#2'r'#5'Width'#3#0#3#6'Height'
- +#3#190#1#7'Caption'#6#5'Form1'#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7#15
- +'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245#10
- +'Font.Style'#11#0#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11'FormDestroy'
- +#13'PixelsPerInch'#2'`'#0#9'TOvcTable'#9'OvcTable1'#4'Left'#2#16#3'Top'#2#16
- +#5'Width'#3#225#2#6'Height'#3#153#1#7'Anchors'#11#6'akLeft'#5'akTop'#7'akRig'
- +'ht'#8'akBottom'#0#5'Color'#7#8'clWindow'#10'Controller'#7#14'OvcController1'
- +'!GridPenSet.NormalGrid.NormalColor'#7#11'clBtnShadow'#27'GridPenSet.NormalG'
- +'rid.Style'#7#5'psDot'#28'GridPenSet.NormalGrid.Effect'#7#6'geBoth!GridPenSe'
- +'t.LockedGrid.NormalColor'#7#11'clBtnShadow'#27'GridPenSet.LockedGrid.Style'
- +#7#7'psSolid'#28'GridPenSet.LockedGrid.Effect'#7#4'ge3D&GridPenSet.CellWhenF'
- +'ocused.NormalColor'#7#7'clBlack GridPenSet.CellWhenFocused.Style'#7#7'psSol'
- +'id!GridPenSet.CellWhenFocused.Effect'#7#6'geBoth(GridPenSet.CellWhenUnfocus'
- +'ed.NormalColor'#7#7'clBlack"GridPenSet.CellWhenUnfocused.Style'#7#6'psDash#'
- +'GridPenSet.CellWhenUnfocused.Effect'#7#6'geBoth'#14'LockedRowsCell'#7#13'Ov'
- +'cTCColHead1'#7'Options'#11#16'otoNoRowResizing'#16'otoNoColResizing'#13'oto'
- +'TabToArrow'#15'otoEnterToArrow'#16'otoAlwaysEditing'#14'otoNoSelection'#13
- +'otoThumbTrack'#0#8'TabOrder'#2#0#13'OnGetCellData'#7#20'OvcTable1GetCellDat'
- +'a'#8'CellData'#1#6#19'Form1.OvcTCColHead1'#6#20'Form1.O32TCFlexEdit1'#6#23
- +'Form1.OvcTCSimpleField1'#6#19'Form1.OvcTCRowHead1'#6#18'Form1.OvcTCString1'
- +#0#7'RowData'#1#2'#'#0#7'ColData'#1#2'n'#8#9#6#19'Form1.OvcTCRowHead1'#3#150
- +#0#8#9#6#18'Form1.OvcTCString1'#3#150#0#8#9#6#23'Form1.OvcTCSimpleField1'#3
- +#150#0#8#9#6#20'Form1.O32TCFlexEdit1'#0#0#0#13'TOvcTCColHead'#13'OvcTCColHea'
- +'d1'#16'Headings.Strings'#1#6#13'TOvcTCRowHead'#6#12'TOvcTCString'#6#17'TOvc'
- +'TCSimpleField'#6#14'TO32TCFlexEdit'#6#0#0#11'ShowLetters'#8#6'Adjust'#7#9'o'
- +'taCenter'#5'Table'#7#9'OvcTable1'#4'Left'#2'0'#0#0#13'TOvcTCRowHead'#13'Ovc'
- +'TCRowHead1'#6'Adjust'#7#9'otaCenter'#5'Table'#7#9'OvcTable1'#4'Left'#2'P'#0
- +#0#12'TOvcTCString'#12'OvcTCString1'#20'AutoAdvanceLeftRight'#9#5'Table'#7#9
- +'OvcTable1'#4'Left'#3#144#0#0#0#14'TOvcController'#14'OvcController1'#23'Ent'
- +'ryCommands.TableList'#1#6#7'Default'#9#1#0#6#8'WordStar'#8#1#0#6#4'Grid'#8#1
- +#0#0#5'Epoch'#3#208#7#4'Left'#2#16#0#0#17'TOvcTCSimpleField'#17'OvcTCSimpleF'
- +'ield1'#14'CaretOvr.Shape'#7#7'csBlock'#27'EFColors.Disabled.BackColor'#7#8
- +'clWindow'#27'EFColors.Disabled.TextColor'#7#10'clGrayText'#24'EFColors.Erro'
- +'r.BackColor'#7#5'clRed'#24'EFColors.Error.TextColor'#7#7'clBlack'#28'EFColo'
- +'rs.Highlight.BackColor'#7#11'clHighlight'#28'EFColors.Highlight.TextColor'#7
- +#15'clHighlightText'#5'Table'#7#9'OvcTable1'#7'OnError'#7#22'OvcTCSimpleFiel'
- +'d1Error'#16'OnUserValidation'#7#31'OvcTCSimpleField1UserValidation'#4'Left'
- +#3'('#1#9'RangeHigh'#10#10#0#0#0#0#0#0#0#0#0#0#0#0#0#8'RangeLow'#10#10#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#14'TO32TCFlexEdit'#14'O32TCFlexEdit1'#20'EditorBord'
- +'ers.Active'#8#23'EditorBorders.FlatColor'#7#7'clBlack'#25'EditorBorders.Bor'
- +'derStyle'#7#10'bstyRaised'#23'EditorOptions.Alignment'#7#13'taLeftJustify'
- +#19'EditorOptions.Color'#7#8'clWindow'#20'EditorOptions.Cursor'#7#9'crDefaul'
- +'t'#22'EditorOptions.MaxLines'#2#3#26'EditorOptions.PasswordChar'#6#1#0#22'E'
- +'ditorOptions.ReadOnly'#8#24'EditorOptions.ShowButton'#8#5'Table'#7#9'OvcTab'
- +'le1'#22'Validation.BeepOnError'#9#24'Validation.InputRequired'#8#24'Validat'
- +'ion.ValidatorType'#6#4'None'#25'Validation.ValidationType'#7#6'vtUser'#16'O'
- +'nUserValidation'#7#28'O32TCFlexEdit1UserValidation'#4'Left'#3#192#1#0#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/76/769672b9f50f8d59bad4478365bb94dbc1b0dd54.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/76/769672b9f50f8d59bad4478365bb94dbc1b0dd54.svn-base
deleted file mode 100644
index bdf5e64a..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/76/769672b9f50f8d59bad4478365bb94dbc1b0dd54.svn-base
+++ /dev/null
@@ -1,1006 +0,0 @@
-{*********************************************************}
-{* OVCPB.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 ovcpb;
- {-Base picture field class, Picture and Numeric fields are derived from this}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Classes, Graphics, SysUtils, OvcConst,
- OvcData, OvcEF, OvcStr;
-
-type
- TOvcPictureBase = class(TOvcBaseEntryField)
- {.Z+}
- protected {private}
- pfSemiLits : Byte; {# of semi-literals in field}
- pfPicFlags : TPictureFlags; {picture flags array}
- pfSelPos : Integer; {current position of selection highlight}
-
- {windows message methods}
- procedure WMSetFocus(var Msg : TWMSetFocus);
- message WM_SETFOCUS;
- procedure WMKillFocus(var Msg : TWMKillFocus);
- message WM_KILLFOCUS;
-
- protected
- procedure CreateWnd;
- override;
-
- function efCanClose(DoValidation : Boolean) : Boolean;
- override;
- {-return True if window can be closed}
- procedure efCaretToEnd;
- override;
- {-move the caret to the end of the field}
- procedure efCaretToStart;
- override;
- {-move the caret to the beginning of the field}
- procedure efChangeMask(Mask : PAnsiChar);
- override;
- {-change the picture mask}
- function efEditBegin : Word;
- override;
- {-return offset of first editable position in field}
- function efEditEnd : Word;
- {-return offset of last editable position in field}
- function efFieldIsEmpty : Boolean;
- override;
- {-return True if the field is empty}
- function efGetDisplayString(Dest : PAnsiChar; Size : Word) : PAnsiChar;
- override;
- {-return the display string in Dest and a pointer as the result}
- procedure efRemoveBadOptions;
- override;
- {-remove inappropriate options for this field and data type}
- procedure efSetCaretPos(Value : Integer);
- override;
- {-set position of caret within the field}
-
- function pbCalcLength : Word;
- {-calculate length of efEditSt}
- procedure pbCalcWidthAndPlaces(var Width, Places : Word);
- {-calculate width and decimal places for a numeric field}
- procedure pbFixDecimalPoint(P : PAnsiChar);
- {-fix decimal points for real numbers before merging}
- procedure pbFixNumber(DotPos, StBgn, StEnd : Integer; FirstHalf, SecondHalf : Boolean);
- {-fix the first and/or second half of a numeric field}
- function pbIsLiteral(N : Word) : Boolean;
- {-return True if N'th mask character is a literal. N is 0-based}
- procedure pbInitPictureFlags;
- {-initialize picture mask flags}
- function pbIsNumber : Boolean;
- {-return True if field is treated as numeric by MergePicture}
- function pbIsSemiLiteral(N : Word) : Boolean;
- {-return True if N'th mask character is a semi-literal. N is 0-based}
- procedure pbMergePicture(const Dest, Src : PAnsiChar);
- {-merge Src with efPicture and return result in Dest}
- procedure pbOptimizeInitPictureFlags;
- {-see if we can optimize InitPictureFlags}
- procedure pbRemoveSemiLits;
- virtual;
- {-remove semi-literal mask characters from the edit string}
- procedure pbRestoreSemiLits;
- {-restore semi-literal mask characters in the edit string}
- procedure pbStripLiterals(Dest, Src : PAnsiChar);
- {-strip literal mask characters from source and put result in Dest}
- procedure pbStripPicture(const Dest, Src : PAnsiChar);
- {-strip the mask characters from Src and put result in Dest}
-
- public
- {interfaced for internal use only--to allow validation}
- {helper routines access to the picture flags array}
- procedure pbGetPictureFlags(var Flags : TPictureFlags);
- {-return an array of the fields picture flags}
- function GetStrippedEditString : string;
- override;
- {-return edit string stripped of literals and semi-literals}
- procedure MergeWithPicture(const S : string);
- override;
- {-combines S with the picture mask and updates the edit string}
- function ValidateContents(ReportError : Boolean) : Word;
- override;
- {.Z-}
- end;
-
-
-implementation
-
-
-{*** TOvcPictureBase ***}
-
-procedure TOvcPictureBase.CreateWnd;
-begin
- pbInitPictureFlags;
-
- inherited CreateWnd;
-
- {set flags for Real fields and clear DecimalPlaces if decimal point is in mask}
- case efDataType mod fcpDivisor of
- fsubReal, fsubExtended, fsubDouble, fsubSingle, fsubComp :
- begin
- Include(sefOptions, sefRealVar);
- if StrScan(efPicture, pmDecimalPt) <> nil then
- DecimalPlaces := 0;
- end;
- end;
-end;
-
-procedure TOvcPictureBase.pbGetPictureFlags(var Flags : TPictureFlags);
- {-return an array of the fields picture flags}
-begin
- Flags := pfPicFlags;
-end;
-
-function TOvcPictureBase.pbIsLiteral(N : Word) : Boolean;
- {-return True if N'th mask character is a literal. N is 0-based}
-begin
- Result := pfPicFlags[N] = pflagLiteral;
-end;
-
-function TOvcPictureBase.pbIsSemiLiteral(N : Word) : Boolean;
- {-return True if N'th mask character is a semi-literal. N is 0-based}
-begin
- Result := pfPicFlags[N] = pflagSemiLit;
-end;
-
-procedure TOvcPictureBase.pbFixNumber(DotPos, StBgn, StEnd : Integer; FirstHalf, SecondHalf : Boolean);
- {-fix the first and/or second half of a numeric field}
-var
- I, J, K : Integer;
- SaveHP : Word;
-
- function StartOfSubField : Word;
- begin
- Result := efHPos;
- while (Result > StBgn) and not pbIsLiteral(Result - 1) do
- Dec(Result);
- end;
-
- function EndOfSubField : Word;
- begin
- Result := efHPos;
- while (Result < StEnd) and not pbIsLiteral(Result + 1) do
- Inc(Result);
- end;
-
-begin
- SaveHP := efHPos;
-
- if FirstHalf then begin
- {bring numbers to left of decimal flush right}
- if DotPos = -1 then
- efHPos := StEnd
- else
- efHPos := DotPos-1;
- K := EndOfSubField;
- J := StartOfSubField;
- I := J;
- while efEditSt[I] = ' ' do
- Inc(I);
- while I <= K do begin
- if efEditSt[I] = ' ' then begin
- StrStDeletePrim(efEditSt, I, 1);
- StrChInsertPrim(efEditSt, ' ', J);
- end;
- Inc(I);
- end;
-
- {make sure it isn't all blanks to left of decimal}
- if efEditSt[K] = ' ' then
- efEditSt[K] := '0';
- end;
-
- if (DotPos <> -1) and SecondHalf then begin
- efHPos := DotPos+1;
-
- {bring numbers to right of decimal flush left}
- J := EndOfSubField;
- if efHPos <= J then begin
- K := J;
- J := StartOfSubField;
- I := K;
- while efEditSt[I] = ' ' do begin
- efEditSt[I] := '0';
- Dec(I);
- end;
- while I >= J do begin
- if efEditSt[I] = ' ' then begin
- StrStDeletePrim(efEditSt, I, 1);
- StrChInsertPrim(efEditSt, '0', K);
- end;
- Dec(I);
- end;
- end;
- end;
-
- efHPos := SaveHP;
-end;
-
-procedure TOvcPictureBase.pbStripLiterals(Dest, Src : PAnsiChar);
- {-strip literal mask characters from source and put result in Dest}
-var
- I : Word;
-begin
- for I := 0 to MaxLength-1 do begin
- if not pbIsLiteral(I) then begin
- Dest^ := Src^;
- Inc(Dest);
- end;
- Inc(Src);
- end;
- Dest^ := #0;
-end;
-
-procedure TOvcPictureBase.pbFixDecimalPoint(P : PAnsiChar);
- {-fix decimal points for real numbers before merging}
-var
- PT : PAnsiChar;
-begin
- PT := StrScan(P, pmDecimalPt);
- if PT <> nil then
- PT^ := IntlSupport.DecimalChar;
-end;
-
-procedure TOvcPictureBase.pbRestoreSemiLits;
- {-restore semi-literal mask characters in the edit string}
-var
- P : PChar;
-begin
- if not (sefFixSemiLits in sefOptions) then
- Exit;
-
- Exclude(sefOptions, sefFixSemiLits);
- pbStripPicture(efEditSt, efEditSt);
- P := StrScan(efEditSt, IntlSupport.DecimalChar);
- if P <> nil then
- P^ := pmDecimalPt;
- pbMergePicture(efEditSt, efEditSt);
- Invalidate;
-end;
-
-procedure TOvcPictureBase.pbInitPictureFlags;
-var
- I : Word;
-begin
- if sefNoLiterals in sefOptions then begin
- FillChar(pfPicFlags, MaxLength, pflagFormat);
- pfPicFlags[MaxLength] := pflagLiteral;
- end else begin
- FillChar(pfPicFlags, MaxLength+1, pflagLiteral);
- for I := 0 to MaxLength-1 do
- if efNthMaskChar(I) in PictureChars then
- pfPicFlags[I] := pflagFormat
- else
- case efNthMaskChar(I) of
- pmFloatDollar, pmComma :
- pfPicFlags[I] := pflagSemiLit;
- end;
- end;
-end;
-
-function TOvcPictureBase.pbIsNumber : Boolean;
- {-return True if field is treated as numeric by MergePicture}
-begin
- Result :=
- (pfSemiLits <> 0) or
- (sefNumeric in sefOptions) or
- (sefHexadecimal in sefOptions) or
- (sefOctal in sefOptions) or
- (sefBinary in sefOptions) or
- (StrScan(efPicture, pmDecimalPt) <> nil) or
- (StrScan(efPicture, pmCurrencyLt) <> nil) or
- (StrScan(efPicture, pmCurrencyRt) <> nil);
-end;
-
-function TOvcPictureBase.pbCalcLength : Word;
- {-calculate length of efEditSt}
-var
- I : Integer;
-begin
- I := efEditEnd;
- while (I >= 0) and ((efEditSt[I] = ' ') or pbIsLiteral(I)) do
- Dec(I);
- Result := I + 1;
-end;
-
-function TOvcPictureBase.efGetDisplayString(Dest : PAnsiChar; Size : Word) : PAnsiChar;
- {-return the display string in Dest}
-var
- I : Integer;
-begin
- Result := inherited efGetDisplayString(Dest, Size);
-
- if Uninitialized and not (sefHaveFocus in sefOptions) then begin
- FillChar(Dest[0], MaxLength, ' ');
- Dest[MaxLength] := #0;
- Exit;
- end;
-
- if (efoPasswordMode in Options) or (PadChar <> ' ') then begin
- I := MaxLength-1;
- while I >= 0 do begin
- while (I >= 0) and pbIsLiteral(I) do
- Dec(I);
-
- if efFieldClass <> fcNumeric then
- while (I >= 0) and (not pbIsLiteral(I)) and (Dest[I] = ' ') do begin
- Dest[I] := PadChar;
- Dec(I);
- end;
-
- while (I >= 0) and (not pbIsLiteral(I)) and (Dest[I] <> ' ') do begin
- if (efoPasswordMode in Options) then
- Dest[I] := PasswordChar;
- Dec(I);
- end;
-
- if efFieldClass = fcNumeric then
- while (I >= 0) and (not pbIsLiteral(I)) and (Dest[I] = ' ') do begin
- Dest[I] := PadChar;
- Dec(I);
- end;
- end;
- end;
-end;
-
-function TOvcPictureBase.efFieldIsEmpty : Boolean;
- {-return True if the field is empty}
-var
- I : Word;
-begin
- I := 0;
- Result := True;
- while (I+1 <= MaxLength) and Result do
- if (not pbIsLiteral(I)) and (efEditSt[I] <> ' ') then
- Result := False
- else
- Inc(I);
-end;
-
-procedure TOvcPictureBase.efRemoveBadOptions;
- {-remove inappropriate options for this field and data type}
-begin
- if csLoading in ComponentState then
- Exit;
-
- case efDataType of
- fidPictureString :
- if not (sefNoLiterals in sefOptions) then begin
- Exclude( FOptions, efoRightJustify );
- Exclude( FOptions, efoTrimBlanks );
- end;
- else
- inherited efRemoveBadOptions;
- end;
-end;
-
-procedure TOvcPictureBase.efSetCaretPos(Value : Integer);
- {-set position of caret within the field}
-begin
- if not (sefHaveFocus in sefOptions) then
- Exit;
-
- if Value < efEditBegin then
- efHPos := efEditBegin
- else if Value > efEditEnd then
- efHPos := efEditEnd + 1
- else begin
- while pbIsLiteral(Value) do
- Dec(Value);
- efHPos := Value;
- end;
- efPositionCaret(True);
-end;
-
-procedure TOvcPictureBase.efCaretToStart;
- {-move the caret to the beginning of the field}
-begin
- efHPos := efEditBegin;
- efHOffset := 0;
-end;
-
-procedure TOvcPictureBase.efCaretToEnd;
- {-move the caret to the end of the field}
-var
- StEnd : Word;
-begin
- efHPos := pbCalcLength;
- StEnd := efEditEnd;
- while (efHPos < StEnd) and pbIsLiteral(efHPos) do
- Inc(efHPos);
-end;
-
-function TOvcPictureBase.efEditBegin : Word;
- {-return offset of first editable position in field}
-var
- I : Word;
-begin
- I := 0;
- while (I < MaxLength-1) and (pfPicFlags[I] = pflagLiteral) do
- Inc(I);
- Result := I + pfSemiLits;
-end;
-
-function TOvcPictureBase.efEditEnd : Word;
- {-return offset of last editable position in field}
-begin
- Result := MaxLength - 1;
- while (Result > 0) and (pfPicFlags[Result] = pflagLiteral) do
- Dec(Result);
-end;
-
-procedure TOvcPictureBase.efChangeMask(Mask : PAnsiChar);
- {-change the picture mask}
-var
- I : Cardinal;
- Buf : array[0..MaxEditLen] of Char;
-begin
- {save current value}
- pbStripPicture(Buf, efEditSt);
-
- inherited efChangeMask(Mask);
-
- {disallow 'p' and 'g' in picture fields}
- if efFieldClass <> fcNumeric then begin
- if StrChPos(efPicture, pmNegParens, I) then
- StrChDeletePrim(efPicture, I);
- if StrChPos(efPicture, pmNegHere, I) then
- StrChDeletePrim(efPicture, I);
- end;
-
- efPicLen := StrLen(efPicture);
- if (MaxLength < efPicLen) or
- ((MaxLength <> efPicLen) and (efFieldClass = fcNumeric)) then begin
- if not (csLoading in ComponentState) then
- MaxLength := efPicLen;
- end;
-
- {clear the edit string}
- FillChar(efEditSt, MaxEditLen, #0);
-
- {see if we can optimize InitPictureFlags}
- pbOptimizeInitPictureFlags;
-
- {restore value}
- pbMergePicture(efEditSt, Buf);
-end;
-
-function TOvcPictureBase.GetStrippedEditString : string;
- {-return edit string stripped of literals and semi-literals}
-var
- Buf : TEditString;
-begin
- {get copy of edit string and limit to MaxEditLen}
- StrLCopy(Buf, efEditSt, MaxEditLen);
-
- {strip the copy of the edit string}
- pbStripPicture(Buf, Buf);
- Result := StrPas(Buf);
-end;
-
-procedure TOvcPictureBase.MergeWithPicture(const S : string);
- {-combines S with the picture mask and updates the edit string}
-var
- Buf : TEditString;
-begin
- HandleNeeded;
- StrPCopy(Buf, S);
- pbMergePicture(efEditSt, Buf);
-end;
-
-function TOvcPictureBase.efCanClose(DoValidation : Boolean) : Boolean;
- {-return True if window can be closed}
-var
- DotPos : Cardinal;
-begin
- if efFieldClass = fcPicture then
- if ((sefModified in sefOptions) and (sefHaveFocus in sefOptions)) then
- if StrChPos(efPicture, pmDecimalPt, DotPos) then
- pbFixNumber(DotPos, efEditBegin, efEditEnd, True, True);
- Result := inherited efCanClose(DoValidation);
-end;
-
-procedure TOvcPictureBase.pbRemoveSemiLits;
- {-remove semi-literal mask characters from the edit string}
-var
- I : Cardinal;
- B : Word;
- E : Word;
- P : Word;
- D : Word;
- Buf : array[0..255] of Char;
-begin
- if pfSemiLits = 0 then begin
- if (sefHexadecimal in sefOptions) or (sefOctal in sefOptions) or
- (sefBinary in sefOptions) then
- Include(sefOptions, sefFixSemiLits);
- Exit;
- end;
-
- Include(sefOptions, sefFixSemiLits);
-
- B := efEditBegin;
- E := efEditEnd;
- P := B - pfSemiLits;
-
- if StrScan(efPicture, pmFloatDollar) <> nil then begin
- StrPCopy(Buf, IntlSupport.CurrencyLtStr);
- if StrStPos(efEditSt, Buf, I) then begin
- D := StrLen(Buf);
- StrStDeletePrim(efEditSt, I, D);
- StrInsertChars(efEditSt, ' ', P, D);
- Inc(P, D);
- end;
- end;
-
- if StrScan(efPicture, pmComma) <> nil then
- for I := P{B} to E do
- if (efEditSt[I] = IntlSupport.CommaChar) then begin
- StrStDeletePrim(efEditSt, I, 1);
- StrChInsertPrim(efEditSt, ' ', P);
- Inc(P);
- end;
-end;
-
-procedure TOvcPictureBase.pbCalcWidthAndPlaces(var Width, Places : Word);
- {-calculate width and decimal places for a numeric field}
-var
- I : Word;
- DotPos : Cardinal;
-begin
- pbInitPictureFlags;
-
- {find position of period and calculate decimal places}
- if not StrChPos(efPicture, pmDecimalPt, DotPos) then
- Places := DecimalPlaces
- else begin
- Places := 0;
- I := DotPos+1;
- while (pfPicFlags[I] = pflagFormat) do begin
- Inc(Places);
- Inc(I);
- end;
- end;
-
- {calculate width}
- I := 0;
- Width := 0;
- while pbIsLiteral(I) or pbIsSemiLiteral(I) do
- Inc(I);
- while (pfPicFlags[I] = pflagFormat) or (efNthMaskChar(I) = pmComma) do begin
- Inc(Width, Ord(pfPicFlags[I] = pflagFormat));
- Inc(I);
- end;
-
- {add decimal places and period}
- if (DotPos <> $FFFF) and (Places <> 0) then
- Inc(Width, Places + 1);
-end;
-
-procedure TOvcPictureBase.pbOptimizeInitPictureFlags;
- {-see if we can optimize InitPictureFlags}
-var
- I : Word;
-begin
- pfSemiLits := 0;
- Exclude(sefOptions, sefNoLiterals);
- pbInitPictureFlags;
- Include(sefOptions, sefNoLiterals);
- for I := 0 to MaxLength-1 do
- case pfPicFlags[I] of
- pflagLiteral :
- Exclude(sefOptions, sefNoLiterals);
- pflagSemiLit :
- begin
- Inc(pfSemiLits);
- Exclude(sefOptions, sefNoLiterals);
- end;
- end;
-
- {if we have literals, turn off TrimBlanks and RightJustify}
- if not (sefNoLiterals in sefOptions) then begin
- Exclude( FOptions, efoTrimBlanks );
- Exclude( FOptions, efoRightJustify );
- end;
-end;
-
-procedure TOvcPictureBase.pbMergePicture(const Dest, Src : PAnsiChar);
- {-merge Src with efPicture and return result in Dest}
-var
- SrcLen : Integer;
- DestLen : Integer;
- DotPosP : Cardinal;
- DotPosS : Cardinal;
- FloatPos : Integer;
- FP : Cardinal;
- I : Cardinal;
- J, K, N : Integer;
- PicChar : AnsiChar;
- NeedFloat : Boolean;
- CurLeftMax : Byte;
- CurLeftLen : Byte;
- IsNum : Boolean;
- NeedMinus : Boolean;
- FoundP : Boolean;
- FoundS : Boolean;
- CopyOfSrc : TEditString;
- Buf : array[0..255] of Char;
-
- procedure HandleOtherCases;
- begin
- if NeedFloat then begin
- Dec(CurLeftLen);
- Dest[I] := IntlSupport.CurrencyLtStr[CurLeftLen+1];
- NeedFloat := CurLeftLen <> 0;
- end else if NeedMinus then begin
- Dest[I] := '-';
- NeedMinus := False;
- end else if (sefHexadecimal in sefOptions) or (sefOctal in sefOptions) or
- (sefBinary in sefOptions) then
- Dest[I] := '0'
- else
- Dest[I] := ' ';
- end;
-
-begin
- {get initial size of Src}
- SrcLen := StrLen(Src);
-
- if SrcLen = 0 then
- CopyOfSrc[0] := #0
- else
- StrCopy(CopyOfSrc, Src);
-
- {copy picture mask into Dest}
- StrCopy(Dest, efPicture);
-
- {mask may be artificially short -- extend with last character of mask}
- if MaxLength > efPicLen then begin
- FillChar(Dest[efPicLen], MaxLength-efPicLen, Dest[efPicLen-1]);
- Dest[MaxLength] := #0;
- end;
- DestLen := MaxLength;
-
- {get position of decimal point}
- FoundP := StrChPos(efPicture, pmDecimalPt, DotPosP);
-
- {is it a numeric string?}
- IsNum := pbIsNumber;
-
- {take care of currency strings}
- if StrChPos(efPicture, pmCurrencyLt, I) then begin
- K := I;
- while (K+1 < DestLen) and (efNthMaskChar(K+1) = pmCurrencyLt) do
- Inc(K);
- StrPCopy(Buf, IntlSupport.CurrencyLtStr);
- J := StrLen(Buf);
- for N := K downto I do
- if J > 0 then begin
- Dec(J);
- Dest[N] := Buf[J];
- end else
- Dest[N] := ' ';
- end;
-
- if StrChPos(efPicture, pmCurrencyRt, I) then begin
- J := 0;
- StrPCopy(Buf, IntlSupport.CurrencyRtStr);
- K := StrLen(Buf);
- while (LongInt(I+1) <= DestLen) and (efNthMaskChar(I) = pmCurrencyRt) do begin
- if J < K then begin
- Dest[I] := Buf[J];
- Inc(J);
- end else
- Dest[I] := ' ';
- Inc(I);
- end;
- end;
-
- if IsNum then begin
- {we need to fill in the FloatDollar positions too, if any}
- if StrChPos(efPicture, pmFloatDollar, FP) then begin
- FloatPos := FP;
- CurLeftLen := Length(IntlSupport.CurrencyLtStr);
- CurLeftMax := 1;
- while efNthMaskChar(FloatPos+1) = pmFloatDollar do begin
- Inc(FloatPos);
- Inc(CurLeftMax);
- end;
- if CurLeftMax < CurLeftLen then
- CurLeftLen := CurLeftMax;
- end else begin
- CurLeftLen := 0;
- FloatPos := -1;
- end;
-
- {trim leading and trailing blanks}
- TrimAllSpacesPChar(CopyOfSrc);
-
- {check for a minus sign}
- NeedMinus := (CopyOfSrc[0] = '-');
- if NeedMinus then
- StrStDeletePrim(CopyOfSrc, 0, 1);
-
- {it's a numeric field--align the decimal points}
- FoundS := StrChPos(CopyOfSrc, pmDecimalPt, DotPosS);
-
- {see if we need a floating dollar sign}
- SrcLen := StrLen(CopyOfSrc);
- NeedFloat := (SrcLen <> 0) and (CurLeftLen <> 0);
-
- {if there's no tail, pretend there's a dot beyond the end of CopyOfSrc}
- if not FoundS then
- K := SrcLen
- else
- K := DotPosS;
-
- {copy the tail of the string}
- if not FoundP then
- I := DestLen
- else
- I := DotPosP+1;
- J := K+1;
- while (J+1 <= SrcLen) and (LongInt(I+1) <= DestLen) and not pbIsLiteral(I) do begin
- Dest[I] := CopyOfSrc[J];
- Inc(I);
- Inc(J);
- end;
-
- {pad to end with 0's}
- while (LongInt(I+1) <= DestLen) and not pbIsLiteral(I) do begin
- Dest[I] := '0';
- Inc(I);
- end;
-
- {handle trailing substitution characters}
- while (LongInt(I+1) <= DestLen) and pbIsLiteral(I) do begin
- PicChar := efNthMaskChar(I);
- case PicChar of
- Subst1..Subst8 : Dest[I] := UserData.SubstChars[PicChar];
- end;
- Inc(I);
- end;
-
- {merge the head of the string}
- if not FoundP then
- J := DestLen-1
- else
- J := DotPosP;
-
- if FoundS then
- SrcLen := DotPosS;
-
- for I := J downto 0 do begin
- PicChar := efNthMaskChar(I);
- case pfPicFlags[I] of
- pflagFormat,
- pflagSemiLit :
- if PicChar = pmComma then begin
- if (SrcLen <> 0) then begin
- if IntlSupport.CommaChar <> #0 then
- Dest[I] := IntlSupport.CommaChar
- else
- StrStDeletePrim(Dest, I, 1);
- end else
- HandleOtherCases;
- end else if (SrcLen > 0) and (Integer(I) > FloatPos) then begin
- Dec(SrcLen);
- Dest[I] := CopyOfSrc[SrcLen];
- end else
- HandleOtherCases;
- pflagLiteral :
- case PicChar of
- Subst1..Subst8 :
- Dest[I] := UserData.SubstChars[PicChar];
- pmDecimalPt :
- Dest[I] := IntlSupport.DecimalChar;
- end;
- end;
- end;
-
- {put in a 0 before the dot if necessary}
- if FoundP and (Dest[DotPosP-1] = ' ') then
- Dest[DotPosP-1] := '0';
- end else begin
- {deal with problem w/ reals w/ variable # of places}
- if (sefRealVar in sefOptions) and (SrcLen > DestLen) then
- if StrScan(CopyOfSrc, pmDecimalPt) <> nil then begin
- TrimTrailingZerosPChar(CopyOfSrc);
- SrcLen := StrLen(CopyOfSrc);
- end;
-
- if efoRightJustify in Options then begin
- {fill in the characters from CopyOfSrc}
- J := SrcLen-1;
- for I := DestLen-1 downto 0 do begin
- PicChar := efNthMaskChar(I);
- case pfPicFlags[I] of
- pflagLiteral :
- case PicChar of
- Subst1..Subst8 :
- Dest[I] := UserData.SubstChars[PicChar];
- end;
- else
- if (J = -1) then
- Dest[I] := ' '
- else begin
- Dest[I] := CopyOfSrc[J];
- efFixCase(PicChar, AnsiChar(Dest[I]), #255);
- Dec(J);
- end;
- end;
- end;
- end else begin
- {fill in the characters from CopyOfSrc}
- J := 0;
- for I := 0 to DestLen-1 do begin
- PicChar := efNthMaskChar(I);
- case pfPicFlags[I] of
- pflagLiteral :
- case PicChar of
- Subst1..Subst8 :
- Dest[I] := UserData.SubstChars[PicChar];
- end;
- else
- if (J <= SrcLen-1) then begin
- Dest[I] := CopyOfSrc[J];
- efFixCase(PicChar, AnsiChar(Dest[I]), #255);
- Inc(J);
- end else
- Dest[I] := ' ';
- end;
- end;
- end;
-
- if sefRealVar in sefOptions then
- pbFixDecimalPoint(Dest);
- end;
-
- Dest[DestLen] := #0;
-end;
-
-procedure TOvcPictureBase.pbStripPicture(const Dest, Src : PAnsiChar);
- {-strip the mask characters from Src and put result in Dest}
-var
- SLen : Byte;
- Found : Boolean;
- P : PAnsiChar;
- DotPos : Cardinal;
- I : Integer;
- CLT : array[0..5] of AnsiChar;
-begin
- {this won't work if string isn't the same length as the picture mask}
- if StrLen(Src) <> MaxLength then begin
- if Pointer(Dest) <> Pointer(Src) then
- StrCopy(Dest, Src);
- Exit;
- end;
-
- {check for fixed decimal point}
- Found := StrChPos(efPicture, pmDecimalPt, DotPos);
-
- {copy all non-literals from Src into Dest. Note: it's OK if Dest *is* Src}
- SLen := 0;
- for I := 0 to MaxLength-1 do
- if (Found and (I = LongInt(DotPos))) or not pbIsLiteral(I) then begin
- Inc(SLen);
- Dest[SLen-1] := Src[I];
- end;
- Dest[SLen] := #0;
-
- {remove floating dollar sign}
- P := StrScan(efPicture, pmFloatDollar);
- if P <> nil then begin
- I := 1;
-
- {find end of currency mask}
- while P[1] = pmFloatDollar do begin
- Inc(I);
- Inc(P);
- end;
- StrPCopy(CLT, IntlSupport.CurrencyLtStr);
- CLT[I] := #0;
- P := StrPos(Dest, CLT);
- if P <> nil then
- StrStDeletePrim(P, 0, I);
- end;
-
- {remove commas}
- if (StrScan(efPicture, pmComma) <> nil) and
- (IntlSupport.CommaChar <> #0) then
- repeat
- P := StrScan(Dest, IntlSupport.CommaChar);
- if P <> nil then
- StrStDeletePrim(P, 0, 1);
- until (P = nil);
-
- {fix up decimal point}
- if Found then begin
- P := StrScan(Dest, IntlSupport.DecimalChar);
- if P <> nil then
- P^ := pmDecimalPt;
- end;
-end;
-
-function TOvcPictureBase.ValidateContents(ReportError : Boolean) : Word;
-var
- DotPos : Cardinal;
-begin
- if efFieldClass = fcPicture then
- if sefModified in sefOptions then begin
- if StrChPos(efPicture, pmDecimalPt, DotPos) then
- pbFixNumber(DotPos, efEditBegin, efEditEnd, True, True);
- end;
-
- Result := inherited ValidateContents(ReportError);
-end;
-
-procedure TOvcPictureBase.WMSetFocus(var Msg : TWMSetFocus);
-var
- B : Boolean;
-begin
- pbInitPictureFlags;
- B := sefRetainPos in sefOptions;
- inherited;
- if not B then
- pfSelPos := efSelEnd;
-end;
-
-procedure TOvcPictureBase.WMKillFocus(var Msg : TWMKillFocus);
-var
- DotPos : Cardinal;
-begin
- if efFieldClass = fcPicture then
- if sefModified in sefOptions then begin
- if StrChPos(efPicture, pmDecimalPt, DotPos) then
- pbFixNumber(DotPos, efEditBegin, efEditEnd, True, True);
- end;
-
- inherited;
-
- {are we giving up the focus?}
- if not (sefRetainPos in sefOptions) then begin
- {restore semi-literal characters}
- pbRestoreSemiLits;
- end;
-end;
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/78/784610217dd57ea83efaab5ff346543e4d7717e2.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/78/784610217dd57ea83efaab5ff346543e4d7717e2.svn-base
deleted file mode 100644
index fb386ba4..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/pristine/78/784610217dd57ea83efaab5ff346543e4d7717e2.svn-base and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/78/785a52724a1f769d27a3276ef219d178ec68225a.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/78/785a52724a1f769d27a3276ef219d178ec68225a.svn-base
deleted file mode 100644
index 78e86da7..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/78/785a52724a1f769d27a3276ef219d178ec68225a.svn-base
+++ /dev/null
@@ -1,109 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/78/78cf84f68e0a1d5208cc7ac4e073e539b5adb41b.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/78/78cf84f68e0a1d5208cc7ac4e073e539b5adb41b.svn-base
deleted file mode 100644
index 3aea97ff..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/78/78cf84f68e0a1d5208cc7ac4e073e539b5adb41b.svn-base
+++ /dev/null
@@ -1,716 +0,0 @@
-{*********************************************************}
-{* OVCTCFLX.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 o32tcflx;
- {Orpheus Table Cell version of the FlexEdit}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, Types, LclType, MyMisc, {$ENDIF}
- SysUtils, Graphics, Classes, Controls, Forms, StdCtrls,
- Menus, OvcTCmmn, OvcTCell,
- OvcTCStr, O32FlxEd, O32bordr, OvcEf, OvcCmd, O32VlOp1, O32Vldtr;
-
-type
-
- { Event for the TCFlexEdit User Validation }
- TTCFEUserValidationEvent =
- procedure(Sender : TObject; Value: string;
- var ValidEntry : Boolean) of object;
-
-
- {Class for storing the validation properties. These properties will be
- loaded dynamically when the editor is created.}
- TO32TCValidatorOptions = class(TPersistent)
- protected {private}
- FValidationType : TValidationType;
- FValidatorType : String;
- FValidatorClass : TValidatorClass;
- FMask : String;
- FLastValid : Boolean;
- FLastErrorCode : Word;
- FBeepOnError : Boolean;
- FInputRequired : Boolean;
-
- procedure SetValidatorType(const VType: String);
- procedure AssignValidator;
- public
- constructor Create; dynamic;
- property LastValid: Boolean
- read FLastValid write FLastValid;
- property LastErrorCode: Word
- read FLastErrorCode write FLastErrorCode;
-
- { - Moved from published}
- property ValidatorClass: TValidatorClass
- read FValidatorClass write FValidatorClass stored true;
- published
- property BeepOnError: Boolean
- read FBeepOnError write FBeepOnError stored true;
- property InputRequired: Boolean
- read FInputRequired write FInputRequired stored true;
- property ValidatorType : string
- read FValidatorType write SetValidatorType stored true;
- property ValidationType: TValidationType
- read FValidationType write FValidationType stored true;
- property Mask: String
- read FMask write FMask stored true;
- end;
-
-
- TO32TCFlexEditEditor = class(TO32CustomFlexEdit)
- protected {private}
- FCell : TOvcBaseTableCell;
- procedure WMChar(var Msg : TWMKey); message WM_CHAR;
-{$IFNDEF LCL}
- procedure WMGetDlgCode(var Msg : TMessage); message WM_GETDLGCODE;
-{$ELSE}
- procedure WMGetDlgCode(var Msg : TWMGetDlgCode); message WM_GETDLGCODE;
-{$ENDIF}
- procedure WMKeyDown(var Msg : TWMKey); message WM_KEYDOWN;
- procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS;
- procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
-
- function ValidateSelf: Boolean; override;
-
-// TurboPower bug? CellOwner property wasn't published.
- published //Added
- property CellOwner : TOvcBaseTableCell read FCell write FCell; //Moved to here
- end;
-
- TO32TCBorderProperties = class(TPersistent)
- protected {private}
- FActive : Boolean;
- FFlatColor : TColor;
- FBorderStyle : TO32BorderStyle;
- public
- constructor Create; virtual;
- published
- property Active: Boolean read FActive write FActive;
- property FlatColor: TColor read FFlatColor write FFlatColor;
- property BorderStyle: TO32BorderStyle read FBorderStyle write FBorderStyle;
- end;
-
- TO32TCEditorProperties = class(TPersistent)
- protected
- FAlignment : TAlignment;
- FBorders : TO32Borders;
- FButtonGlyph : TBitmap;
- FColor : TColor;
- FCursor : TCursor;
- FMaxLines : Integer;
- FShowButton : Boolean;
- FPasswordChar : Char;
- FReadOnly : Boolean;
- procedure SetButtonGlyph(Value :TBitmap);
- function GetButtonGlyph :TBitmap;
- public
- constructor Create; virtual;
- destructor Destroy; override;
-
- property Borders: TO32Borders read FBorders write FBorders;
-
- published
- {$IFDEF VERSION4}
- property Alignment: TAlignment read FAlignment write FAlignment;
- {$ENDIF}
- property ButtonGlyph: TBitmap
- read GetButtonGlyph write SetButtonGlyph;
-
- property Color: TColor Read FColor write FColor;
- property Cursor: TCursor read FCursor write FCursor;
- property MaxLines: Integer read FMaxLines write FMaxLines;
- property PasswordChar: Char read FPasswordChar write FPasswordChar;
- property ReadOnly: Boolean Read FReadOnly write FReadOnly;
- property ShowButton: Boolean read FShowButton write FShowButton;
- end;
-
- TO32TCCustomFlexEdit = class(TOvcTCBaseString)
- protected {private}
- FBorderProps : TO32TCBorderProperties;
- FEdit : TO32TCFlexEditEditor;
- FEditorOptions : TO32TCEditorProperties;
- FMaxLength : word;
- FValidation : TO32TCValidatorOptions;
- FWantReturns : Boolean;
- FWantTabs : Boolean;
- FWordWrap : Boolean;
-
- FOnError : TValidationErrorEvent;
- FOnUserCommand : TUserCommandEvent;
- FOnUserValidation : TTCFEUserValidationEvent;
-
- FOnButtonClick : TO32feButtonClickEvent;
-
- protected
- function GetCellEditor : TControl; override;
- function GetModified : boolean;
-
- property MaxLength : word
- read FMaxLength write FMaxLength stored true;
- property WantReturns : boolean
- read FWantReturns write FWantReturns stored true;
- property WantTabs : boolean
- read FWantTabs write FWantTabs stored true;
- property WordWrap: Boolean
- read FWordWrap write FWordWrap stored true;
- property EditorBorders: TO32TCBorderProperties
- read FBorderProps write FBorderProps;
- property OnButtonClick: TO32feButtonClickEvent
- read FOnButtonClick write FOnButtonClick;
- property Validation: TO32TCValidatorOptions
- read FValidation write FValidation;
- public
- constructor Create(AOwner : TComponent); override;
- destructor Destroy; override;
- function CreateEditControl(AOwner : TComponent) : TO32TCFlexEditEditor; virtual;
- function EditHandle : THandle; override;
- procedure EditHide; override;
- procedure EditMove(CellRect : TRect); override;
-
- function CanSaveEditedData(SaveValue : boolean) : boolean; override;
- procedure SaveEditedData(Data : pointer); override;
- function ValidateEntry: Boolean;
- procedure StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer); override;
- procedure StopEditing(SaveValue : boolean;
- Data : pointer); override;
- property Modified : boolean
- read GetModified;
- property EditorOptions: TO32TCEditorProperties
- read FEditorOptions write FEditorOptions;
- property OnUserValidation: TTCFEUserValidationEvent
- read FOnUserValidation write FOnUserValidation;
- end;
-
- TO32TCFlexEdit = class(TO32TCCustomFlexEdit)
- published
- {properties inherited from custom ancestor}
- property Access default otxDefault;
- property Adjust default otaDefault;
- property EditorBorders;
- property Color;
- property EditorOptions;
- property Font;
- property Hint;
- property Margin default 4;
- property MaxLength default 255;
- property ShowHint default False;
- property Table;
- property TableColor default True;
- property TableFont default True;
- property TextHiColor default clBtnHighlight;
- property TextStyle default tsFlat;
- property Validation;
- property WantReturns default False;
- property WantTabs default False;
- property WordWrap default False;
- {events inherited from custom ancestor}
- property OnButtonClick;
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnOwnerDraw;
- property OnUserValidation;
- end;
-
-implementation
-
-{===== TO32TCValidatorOptions ========================================}
-
-constructor TO32TCValidatorOptions.Create;
-begin
- inherited Create;
- FValidationType := vtNone;
- FValidatorType := 'None';
- FValidatorClass := nil;
- FMask := '';
- FLastValid := false;
- FLastErrorCode := 0;
- FBeepOnError := true;
- FInputRequired := false;
-end;
-
-procedure TO32TCValidatorOptions.AssignValidator;
-begin
- if (FValidatorType = 'None') or (FValidatorType = '')then
- FValidatorClass := nil
- else try
- FValidatorClass := TValidatorClass(FindClass(FValidatorType));
- except
- FValidatorClass := nil;
- end;
-end;
-{=====}
-
-procedure TO32TCValidatorOptions.SetValidatorType(const VType: String);
-begin
- if FValidatorType <> VType then begin
- FValidatorType := VType;
- AssignValidator;
- end;
-end;
-
-
-{===== TO32TCFlexEditEditor ==========================================}
-
-procedure TO32TCFlexEditEditor.WMChar(var Msg : TWMKey);
-begin
- if (not CellOwner.TableWantsTab) or (Msg.CharCode <> 9) then
- inherited;
-end;
-{=====}
-
-{$IFNDEF LCL}
-procedure TO32TCFlexEditEditor.WMGetDlgCode(var Msg : TMessage);
-{$ELSE}
-procedure TO32TCFlexEditEditor.WMGetDlgCode(var Msg : TWMGetDlgCode);
-{$ENDIF}
-begin
- inherited;
- if CellOwner.TableWantsTab then
- Msg.Result := Msg.Result or DLGC_WANTTAB;
-end;
-{=====}
-
-procedure TO32TCFlexEditEditor.WMKeyDown(var Msg : TWMKey);
- {Local Method}
- procedure GetSelection(var S, E : word);
- type
- LH = packed record L, H : word; end;
- var
- GetSel : longint;
- begin
- GetSel := SendMessage(Handle, EM_GETSEL, 0, 0);
- S := LH(GetSel).L;
- E := LH(GetSel).H;
- end;
-var
- GridReply : TOvcTblKeyNeeds;
- GridUsedIt : boolean;
- SStart, SEnd : word;
-begin
- GridUsedIt := false;
- GridReply := otkDontCare;
- if (CellOwner <> nil) then
- GridReply := CellOwner.FilterTableKey(Msg);
- case GridReply of
- otkMustHave :
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- otkWouldLike :
- case Msg.CharCode of
- VK_RETURN :
- if not WantReturns then
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- VK_LEFT :
- begin
- GetSelection(SStart, SEnd);
- if (SStart = SEnd) and (SStart = 0) then
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;
- VK_RIGHT :
- begin
- GetSelection(SStart, SEnd);
- if ((SStart = SEnd) or (SStart = 0)) and (SEnd = GetTextLen) then
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;
- VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT : //TurboPower bug? left out this case
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;
- end;{case}
-
- if not GridUsedIt then
- inherited;
-end;
-{=====}
-
-procedure TO32TCFlexEditEditor.WMKillFocus(var Msg : TWMKillFocus);
-begin
-{$IFNDEF LCL}
- inherited;
-{$ELSE}
- inherited WMKillFocus(Msg);
-{$ENDIF}
-
- CellOwner.PostMessageToTable(ctim_KillFocus, Msg.FocusedWnd, 0);
-end;
-{=====}
-
-procedure TO32TCFlexEditEditor.WMSetFocus(var Msg : TWMSetFocus);
-begin
-{$IFNDEF LCL}
- inherited;
-{$ELSE}
- inherited WMSetFocus(Msg);
-{$ENDIF}
- CellOwner.PostMessageToTable(ctim_SetFocus, Msg.FocusedWnd, 0);
-end;
-{=====}
-
-function TO32TCFlexEditEditor.ValidateSelf;
-begin
- result := inherited ValidateSelf;
-end;
-
-{===== TO32TCBorderProperties ========================================}
-constructor TO32TCBorderProperties.Create;
-begin
- inherited;
- FActive := False;
- FFlatColor := clBlack;
- FBorderStyle := bstyRaised;
-end;
-
-{===== TO32TCEditorProperties ========================================}
-constructor TO32TCEditorProperties.Create;
-begin
- inherited Create;
- FAlignment := taLeftJustify;
- FButtonGlyph := TBitmap.Create;
- FColor := clWindow;
- FCursor := crDefault;
- FMaxLines := 3;
- FShowButton := false;
-// TurboPower bug: No default efoPasswordMode=False like TOvcTCSimpleField,
-// so '*' means TO32TCFlexEdit would be in password mode by default.
-// FPasswordChar := '*';
- FPasswordChar := #0; //Fixed
- FReadOnly := false;
-end;
-{=====}
-
-destructor TO32TCEditorProperties.Destroy;
-begin
- FButtonGlyph.Free;
- inherited Destroy;
-end;
-{=====}
-
-{ - begin}
-procedure TO32TCEditorProperties.SetButtonGlyph(Value :TBitmap);
-begin
- FButtonGlyph.Assign(Value);
-end;
-{=====}
-
-function TO32TCEditorProperties.GetButtonGlyph :TBitmap;
-begin
- Result := FButtonGlyph;
-end;
-{=====}
-{ - end}
-
-{===== TO32TCCustomFlexEdit ==========================================}
-constructor TO32TCCustomFlexEdit.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
- UseASCIIZStrings := true;
- UseWordWrap := true;
- FEditorOptions := TO32TCEditorProperties.Create;
- FBorderProps := TO32TCBorderProperties.Create;
- FValidation := TO32TCValidatorOptions.Create;
- MaxLength := 255;
-end;
-{=====}
-
-destructor TO32TCCustomFlexEdit.Destroy;
-begin
- FEditorOptions.Free;
- FBorderProps.Free;
- FValidation.Free;
- inherited;
-end;
-{=====}
-
-function TO32TCCustomFlexEdit.GetCellEditor : TControl;
-begin
- Result := FEdit;
- FEditorOptions.Free;
-end;
-{=====}
-
-function TO32TCCustomFlexEdit.GetModified : boolean;
-begin
- if Assigned(FEdit) then
- Result := FEdit.Modified
- else
- Result := false;
-end ;
-{=====}
-
-function TO32TCCustomFlexEdit.CreateEditControl(AOwner : TComponent):
- TO32TCFlexEditEditor;
-begin
- Result := TO32TCFlexEditEditor.Create(AOwner);
-end;
-{=====}
-
-function TO32TCCustomFlexEdit.EditHandle : THandle;
-begin
- if Assigned(FEdit) then
- Result := FEdit.Handle
- else
- Result := 0;
-end;
-{=====}
-
-procedure TO32TCCustomFlexEdit.EditHide;
-begin
- if Assigned(FEdit) then
-// with FEdit do
- SetWindowPos(FEdit.Handle, HWND_TOP, 0, 0, 0, 0, SWP_HIDEWINDOW
- or SWP_NOREDRAW or SWP_NOZORDER);
-end;
-{=====}
-
-procedure TO32TCCustomFlexEdit.EditMove(CellRect : TRect);
-begin
- if Assigned(FEdit) then
- begin
- with CellRect do
- SetWindowPos(FEdit.Handle, HWND_TOP,
- Left, Top, Right-Left, Bottom-Top,
- SWP_SHOWWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- InvalidateRect(FEdit.Handle, nil, false);
- UpdateWindow(FEdit.Handle);
- end;
-end;
-{=====}
-
-function TO32TCCustomFlexEdit.CanSaveEditedData(SaveValue : boolean) : boolean;
-begin
- Result := true;
- if Validation.InputRequired and (FEdit.Text = '') then begin
- result := false;
- FEdit.Restore;
- end
-
- else if (Validation.FValidationType <> vtNone) then
- if Assigned(FEdit) then
- if SaveValue then
- Result := ValidateEntry
- else begin
- FEdit.Restore;
-// result := false; //TurboPower bug? Inconsistent with
- //TOvcTCBaseEntryField.CanSaveEditedData and
- //p.928 of Orpheus.pdf. Prevents TOvcTable's
- //StopEditingState from completing if SaveValue=False.
- end;
-end;
-{=====}
-
-function TO32TCCustomFlexEdit.ValidateEntry: Boolean;
-begin
- if Assigned(FOnUserValidation) then begin
- FOnUserValidation(FEdit, FEdit.Text, result);
-
-// if Validation.BeepOnError then MessageBeep(0); <== TurboPower bug? not checking result
- if (not result) and Validation.BeepOnError then MessageBeep(0); //Fixed
-
-// Another TurboPower omission? Since OnError not published the way
-// OnUserValidation is, no way to display error if validation fails
-// (and displaying error in OnUserValidation handler causes problems).
-// Next two lines added to remedy this. In OnUserValidation handler,
-// you can set TO32TCFlexEditEditor(Sender).OnValidationError to have
-// your error method called here. Note that you can also call
-// TO32TCFlexEditEditor(Sender).Validation.SetLastErrorCode in your
-// OnUserValidation handler to set the error passed in ErrorCode to
-// your OnValidationError method.
- if (not result) and Assigned(FEdit.FOnValidationError) then
- FEdit.FOnValidationError(FEdit, FEdit.Validation.LastErrorCode, 'Invalid input');
-
- exit;
- end;
-
- result := FEdit.ValidateSelf;
- Validation.LastValid := FEdit.Validation.LastValid;
- Validation.LastErrorCode := FEdit.Validation.LastErrorCode;
-end;
-
-procedure TO32TCCustomFlexEdit.SaveEditedData(Data : pointer);
-begin
- {Abstract method does nothing.
- It is stubbed out so that BCB doesn't think this as an abstract class}
-end;
-{=====}
-
-procedure TO32TCCustomFlexEdit.StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer);
-{var
- Str: String;}
-begin
- FEdit := TO32TCFlexEditEditor.Create(FTable);
-
- FEdit.Validation.EnableHooking := false;
- FEdit.Validation.InputRequired := Validation.InputRequired;
- FEdit.Validation.ValidationType := Validation.ValidationType;
- FEdit.Validation.ValidatorType := Validation.ValidatorType;
- FEdit.Validation.ValidatorClass := Validation.ValidatorClass;
- FEdit.Validation.Mask := Validation.Mask;
- FEdit.Validation.BeepOnError := Validation.BeepOnError;
- FEdit.Validation.InputRequired := Validation.InputRequired;
- FEdit.Validation.ValidationEvent := veOnExit;
-
-
- FEdit.ShowButton := FEditorOptions.ShowButton;
- if FEdit.ShowButton then begin
- FEdit.ButtonGlyph := FEditorOptions.ButtonGlyph;
- if Assigned(OnButtonClick) then
- FEdit.OnButtonClick := OnButtonClick;
- end;
-
- with FEdit do begin
- Parent := FTable;
-
- Borders.Active := FBorderProps.FActive;
-
- if Borders.Active then begin
- Borders.BorderStyle := FBorderProps.FBorderStyle;
- Borders.FlatColor := FBorderProps.FFlatColor;
- BorderStyle := bsSingle;
- Ctl3D := true;
- end else begin
- BorderStyle := bsNone;
- Ctl3D := false;
- case CellStyle of
- tesBorder : BorderStyle := bsSingle;
- tes3D : Ctl3D := true;
- end;{case}
- end;
-
- Color := FEditorOptions.Color;
- Font := CellAttr.caFont;
- Font.Color := CellAttr.caFontColor;
- MaxLength := Self.MaxLength;
- WantReturns := Self.WantReturns;
- WantTabs := Self.WantTabs;
- WordWrap := Self.WordWrap;
- EditLines.MaxLines := FEditorOptions.MaxLines;
- EditLines.DefaultLines := 1;
- EditLines.FocusedLines := 3;
- EditLines.MouseOverLines := 3;
- Cursor := FEditorOptions.Cursor;
- PasswordChar := FEditorOptions.PasswordChar;
- ReadOnly := FEditorOptions.ReadOnly;
- Left := CellRect.Left;
- Top := CellRect.Top;
- Width := CellRect.Right - CellRect.Left;
- Height := CellRect.Bottom - CellRect.Top;
- Visible := true;
- TabStop := false;
- CellOwner := Self;
- Hint := Self.Hint;
- ShowHint := Self.ShowHint;
- Tag := Self.Tag; //TurboPower omission? Might be useful to know this too.
-
- {Str := PAnsiChar(Data);} {!!!}
- if (Data = nil) then
- SetTextBuf('')
- else begin
- SetTextBuf(PAnsiChar(Data));
- end;
-
- OnChange := Self.OnChange;
- OnClick := Self.OnClick;
- OnDblClick := Self.OnDblClick;
- OnDragDrop := Self.OnDragDrop;
- OnDragOver := Self.OnDragOver;
- OnEndDrag := Self.OnEndDrag;
- OnEnter := Self.OnEnter;
- OnExit := Self.OnExit;
- OnKeyDown := Self.OnKeyDown;
- OnKeyPress := Self.OnKeyPress;
- OnKeyUp := Self.OnKeyUp;
- OnMouseDown := Self.OnMouseDown;
- OnMouseMove := Self.OnMouseMove;
- OnMouseUp := Self.OnMouseUp;
- end;
-end;
-{=====}
-
-procedure TO32TCCustomFlexEdit.StopEditing(SaveValue : boolean;
- Data : pointer);
-{var
- Str: String;}
-begin
- try
- if SaveValue and Assigned(Data) then begin
- FEdit.GetTextBuf(PAnsiChar(Data), MaxLength);
- {Str := PAnsiChar(Data);} {!!!}
- end;
- finally
- FEdit.Free;
- FEdit := nil;
- end;
-end;
-{=====}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/7a/7abe609049543e0588556a23e5da7b53e4275a21.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/7a/7abe609049543e0588556a23e5da7b53e4275a21.svn-base
deleted file mode 100644
index 66e53f24..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/7a/7abe609049543e0588556a23e5da7b53e4275a21.svn-base
+++ /dev/null
@@ -1,289 +0,0 @@
-object OvcfrmColEditor: TOvcfrmColEditor
- Left = 353
- Top = 207
- BorderIcons = [biSystemMenu]
- BorderStyle = bsDialog
- Caption = 'Columns Editor'
- ClientHeight = 190
- Height = 190
- ClientWidth = 386
- Width = 386
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- Position = poScreenCenter
- OnShow = FormShow
- PixelsPerInch = 96
- object Panel1: TPanel
- Left = 0
- Top = 0
- Width = 386
- Height = 41
- Align = alTop
- Alignment = taLeftJustify
- BevelInner = bvLowered
- TabOrder = 0
- object SpeedButton1: TSpeedButton
- Left = 8
- Top = 8
- Width = 25
- Height = 25
- Hint = 'Previous column'
- Glyph.Data = {
- 76010000424D7601000000000000760000002800000020000000100000000100
- 0400000000000001000000000000000000001000000010000000000000000000
- 80000080000000808000800000008000800080800000C0C0C000808080000000
- FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB0000
- BBBBBBBBBBBB777BBBBBBBBBBBB00CC0BBBBBBBBBBB7777BBBBBBBBBBB00CCC0
- BBBBBBBBBB77777BBBBBBBBBB00CCCC0BBBBBBBBB777777BBBBBBBBB00CCCCC0
- BBBBBBBB7777777BBBBBBBBF0CCCCCC0BBBBBBB77777777BBBBBBBBF0CCCCCC0
- BBBBBBB77777777BBBBBBBBBFCCCCCC0BBBBBBBB7777777BBBBBBBBBBFCCCCC0
- BBBBBBBBB777777BBBBBBBBBBBFCCCC0BBBBBBBBBB77777BBBBBBBBBBBBFCCC0
- BBBBBBBBBBB7777BBBBBBBBBBBBBFFFFBBBBBBBBBBBB777BBBBBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
- NumGlyphs = 2
- ParentShowHint = False
- ShowHint = True
- OnClick = SpeedButton1Click
- end
- object SpeedButton2: TSpeedButton
- Left = 32
- Top = 8
- Width = 25
- Height = 25
- Hint = 'Next column'
- Glyph.Data = {
- 76010000424D7601000000000000760000002800000020000000100000000100
- 0400000000000001000000000000000000001000000010000000000000000000
- 80000080000000808000800000008000800080800000C0C0C000808080000000
- FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBF000BBBBB
- BBBBBBBFFFFBBBBBBBBBBBBF0000BBBBBBBBBBBFFFFFBBBBBBBBBBBFCCC00BBB
- BBBBBBBFFFFFFBBBBBBBBBBFCCCC00BBBBBBBBBFFFFFFFBBBBBBBBBFCCCCC00B
- BBBBBBBFFFFFFFFBBBBBBBBFCCCCCC00BBBBBBBFFFFFFFFFBBBBBBBFCCCCCC0F
- BBBBBBBFFFFFFFFFBBBBBBBFCCCCCCFBBBBBBBBFFFFFFFFBBBBBBBBFCCCCCFBB
- BBBBBBBFFFFFFFBBBBBBBBBFCCCCFBBBBBBBBBBFFFFFFBBBBBBBBBBFCCCFBBBB
- BBBBBBBFFFFFBBBBBBBBBBBFFFFBBBBBBBBBBBBFFFFBBBBBBBBBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
- NumGlyphs = 2
- ParentShowHint = False
- ShowHint = True
- OnClick = SpeedButton2Click
- end
- object SpeedButton3: TSpeedButton
- Left = 72
- Top = 8
- Width = 25
- Height = 25
- Hint = 'First column'
- Glyph.Data = {
- 76010000424D7601000000000000760000002800000020000000100000000100
- 0400000000000001000000000000000000001000000010000000000000000000
- 80000080000000808000800000008000800080800000C0C0C000808080000000
- FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB00BBBBBB00
- BBBBBBFFBBBBBBFFBBBBBB00BBBBB000BBBBBBFFBBBBBFFFBBBBBB00BBBB00C0
- BBBBBBFFBBBBFFFFBBBBBB00BBB00CC0BBBBBBFFBBBFFFFFBBBBBB00BB00CCC0
- BBBBBBFFBBFFFFFFBBBBBB00B00CCCC0BBBBBBFFBFFFFFFFBBBBBB00BFCCCCC0
- BBBBBBFFBFFFFFFFBBBBBB00BBFCCCC0BBBBBBFFBBFFFFFFBBBBBB00BBBFCCC0
- BBBBBBFFBBBFFFFFBBBBBB00BBBBFCC0BBBBBBFFBBBBFFFFBBBBBB00BBBBBFC0
- BBBBBBFFBBBBBFFFBBBBBB00BBBBBBFFBBBBBBFFBBBBBBFFBBBBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
- NumGlyphs = 2
- ParentShowHint = False
- ShowHint = True
- OnClick = SpeedButton3Click
- end
- object SpeedButton4: TSpeedButton
- Left = 96
- Top = 8
- Width = 25
- Height = 25
- Hint = 'Last column'
- Glyph.Data = {
- 76010000424D7601000000000000760000002800000020000000100000000100
- 0400000000000001000000000000000000001000000010000000000000000000
- 80000080000000808000800000008000800080800000C0C0C000808080000000
- FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB00BBBBBB
- 00BBBBBB77BBBBBB77BBBBBB000BBBBB00BBBBBB777BBBBB77BBBBBB0C00BBBB
- 00BBBBBB7777BBBB77BBBBBB0CC00BBB00BBBBBB77777BBB77BBBBBB0CCC00BB
- 00BBBBBB777777BB77BBBBBB0CCCC00B00BBBBBB7777777B77BBBBBB0CCCCCFB
- 00BBBBBB7777777B77BBBBBB0CCCCFBB00BBBBBB777777BB77BBBBBB0CCCFBBB
- 00BBBBBB77777BBB77BBBBBB0CCFBBBB00BBBBBB7777BBBB77BBBBBB0CFBBBBB
- 00BBBBBB777BBBBB77BBBBBBFFBBBBBB00BBBBBB77BBBBBB77BBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
- NumGlyphs = 2
- ParentShowHint = False
- ShowHint = True
- OnClick = SpeedButton4Click
- end
- object SpeedButton5: TSpeedButton
- Left = 136
- Top = 8
- Width = 25
- Height = 25
- Hint = 'Insert column'
- Glyph.Data = {
- 76010000424D7601000000000000760000002800000020000000100000000100
- 0400000000000001000000000000000000001000000010000000000000000000
- 80000080000000808000800000008000800080800000C0C0C000808080000000
- FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBF000BBBBBBBBBBBBF777BBBBBBBBBBBBFCC0BB
- BBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BBBBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BB
- BBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BBBBBBBBBBBBFBB7BBBBBBB000000CC000
- 000BB777777BB777777BBFCCCCCCCCCCCC0BBFBBBBBBBBBBBB7BBFCCCCCCCCCC
- CC0BBFBBBBBBBBBBBB7BBFFFFFFCC0FFFFFBBFFFFFFBB7FFFFFBBBBBBBFCC0BB
- BBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BBBBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BB
- BBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BBBBBBBBBBBBFBB7BBBBBBBBBBBBFFF0BB
- BBBBBBBBBBFFF7BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
- NumGlyphs = 2
- ParentShowHint = False
- ShowHint = True
- OnClick = SpeedButton5Click
- end
- object SpeedButton6: TSpeedButton
- Left = 160
- Top = 8
- Width = 25
- Height = 25
- Hint = 'Delete column'
- Glyph.Data = {
- 76010000424D7601000000000000760000002800000020000000100000000100
- 0400000000000001000000000000000000001000000010000000000000000000
- 80000080000000808000800000008000800080800000C0C0C000808080000000
- FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB00000000000
- 000BB77777777777777BBFCCCCCCCCCCCC0BBFBBBBBBBBBBBB7BBFCCCCCCCCCC
- CC0BBFBBBBBBBBBBBB7BBFFFFFFFFFFFFFFBBFFFFFFFFFFFFFFBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
- NumGlyphs = 2
- ParentShowHint = False
- ShowHint = True
- OnClick = SpeedButton6Click
- end
- object Label1: TLabel
- Left = 200
- Top = 12
- Width = 105
- Height = 16
- AutoSize = False
- Caption = 'Column &number'
- end
- object OvcSpinner2: TOvcSpinner
- Left = 361
- Top = 11
- Width = 16
- Height = 21
- AutoRepeat = True
- Delta = 1.000000000000000000
- FocusedControl = ctlColNumber
- end
- object ctlColNumber: TEdit
- Left = 312
- Top = 11
- Width = 49
- Height = 21
- MaxLength = 5
- TabOrder = 0
- OnChange = ctlColNumberChange
- OnExit = ctlColNumberExit
- end
- end
- object GroupBox1: TGroupBox
- Left = 8
- Top = 48
- Width = 273
- Height = 137
- Caption = 'Column details'
- TabOrder = 1
- object Label2: TLabel
- Left = 8
- Top = 4
- Width = 75
- Height = 16
- AutoSize = False
- Caption = 'De&fault Cell'
- FocusControl = ctlDefaultCell
- end
- object Label3: TLabel
- Left = 8
- Top = 92
- Width = 75
- Height = 16
- AutoSize = False
- Caption = '&Width'
- end
- object Label4: TLabel
- Left = 8
- Top = 56
- Width = 34
- Height = 13
- Caption = '&Hidden'
- FocusControl = ctlHidden
- end
- object ctlDefaultCell: TComboBox
- Left = 8
- Top = 24
- Width = 257
- Height = 21
- Style = csDropDownList
- DropDownCount = 16
- ItemHeight = 13
- TabOrder = 0
- end
- object ctlHidden: TCheckBox
- Left = 96
- Top = 56
- Width = 17
- Height = 17
- TabOrder = 1
- end
- object OvcSpinner1: TOvcSpinner
- Left = 145
- Top = 90
- Width = 16
- Height = 21
- AutoRepeat = True
- Delta = 1.000000000000000000
- FocusedControl = ctlWidth
- end
- object ctlWidth: TEdit
- Left = 96
- Top = 90
- Width = 49
- Height = 21
- MaxLength = 5
- TabOrder = 2
- end
- end
- object DoneButton: TBitBtn
- Left = 304
- Top = 160
- Width = 75
- Height = 25
- Caption = '&Done'
- ModalResult = 1
- TabOrder = 3
- OnClick = DoneButtonClick
- NumGlyphs = 2
- end
- object ApplyButton: TBitBtn
- Left = 304
- Top = 56
- Width = 75
- Height = 25
- Caption = '&Apply'
- Default = True
- TabOrder = 2
- OnClick = ApplyButtonClick
- NumGlyphs = 2
- end
-end
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/7c/7c0bb5adf0ee0e64909c47efbcbc911da0d365fb.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/7c/7c0bb5adf0ee0e64909c47efbcbc911da0d365fb.svn-base
deleted file mode 100644
index 643454de..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/pristine/7c/7c0bb5adf0ee0e64909c47efbcbc911da0d365fb.svn-base and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/7c/7c1f1e6f4538e5afadcf5854c4b519a35c93c3b2.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/7c/7c1f1e6f4538e5afadcf5854c4b519a35c93c3b2.svn-base
deleted file mode 100644
index 40cff001..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/7c/7c1f1e6f4538e5afadcf5854c4b519a35c93c3b2.svn-base
+++ /dev/null
@@ -1,324 +0,0 @@
-{*********************************************************}
-{* OVCTCARY.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 ovctcary;
- {-Orpheus Table - Cell Array class}
-
-interface
-
-{Note: this class exists for the *sole* purpose of providing a sorted
- list of cell addresses that need repainting. It has no other
- possible application. It also stores a flag that states that
- the unused bit of the table window needs painting}
-
-uses
- SysUtils, Classes, OvcTCmmn;
-
-type
- TOvcCellAddress = packed record
- Row : TRowNum;
- Col : TColNum;
- end;
-
- TOvcCellArray = class
- protected {private}
- {.Z+}
- FArray : pointer;
- FLimit : Integer;
- FCount : Integer;
-
- DoUnusedBit : boolean;
- {.Z-}
-
- protected
- {.Z+}
- function GetEmpty : boolean;
- {.Z-}
-
- public
- destructor Destroy; override;
-
- procedure AddCell(RowNum : TRowNum; ColNum : TColNum);
- procedure AddUnusedBit;
- procedure Clear;
- function DeleteCell(RowNum : TRowNum; ColNum : TColNum) : boolean;
- procedure GetCellAddr(Inx : Integer; var CellAddr : TOvcCellAddress);
- procedure Merge(CA : TOvcCellArray);
- function MustDoUnusedBit : boolean;
-
- property Count : Integer
- read FCount;
-
- property Empty : boolean
- read GetEmpty;
- end;
-
-implementation
-
-
-type
- POvcCellArrayPrim = ^TOvcCellArrayPrim;
- TOvcCellArrayPrim = array [0..9999] of TOvcCellAddress;
-
-
-{===TOvcCellArray====================================================}
-destructor TOvcCellArray.Destroy;
- begin
- if Assigned(FArray) then
- FreeMem(FArray, sizeof(TOvcCellAddress) * FLimit);
- end;
-{--------}
-procedure TOvcCellArray.AddCell(RowNum : TRowNum; ColNum : TColNum);
- var
- NewLimit : Integer;
- L, R, M : Integer;
- NewArray : pointer;
- MCell : TOvcCellAddress;
- begin
- {grow array if required}
- if (FCount = FLimit) then
- begin
- NewLimit := FLimit + 128;
- GetMem(NewArray, sizeof(TOvcCellAddress) * NewLimit);
- if Assigned(FArray) then
- begin
- Move(FArray^, NewArray^, sizeof(TOvcCellAddress) * FLimit);
- FreeMem(FArray, sizeof(TOvcCellAddress) * FLimit);
- end;
- FLimit := NewLimit;
- FArray := NewArray;
- end;
- {do special case, er, specially}
- if (FCount = 0) then
- begin
- with POvcCellArrayPrim(FArray)^[0] do
- begin
- Row := RowNum;
- Col := ColNum;
- end;
- FCount := 1;
- Exit;
- end;
- {binary search through array, insert in order}
- L := 0;
- R := pred(FCount);
- repeat
- M := (L + R) div 2;
- MCell := POvcCellArrayPrim(FArray)^[M];
- if (RowNum = MCell.Row) then
- if (ColNum = MCell.Col) then
- Exit {nothing to do-already present}
- else if (ColNum < MCell.Col) then
- R := M - 1
- else
- L := M + 1
- else if (RowNum < MCell.Row) then
- R := M - 1
- else
- L := M + 1;
- until (L > R);
- {insert at L}
- if (L < FCount) then
- Move(POvcCellArrayPrim(FArray)^[L],
- POvcCellArrayPrim(FArray)^[L+1],
- sizeof(TOvcCellAddress)*(FCount-L));
- with POvcCellArrayPrim(FArray)^[L] do
- begin
- Row := RowNum;
- Col := ColNum;
- end;
- inc(FCount);
- end;
-{--------}
-procedure TOvcCellArray.AddUnusedBit;
- begin
- DoUnusedBit := true;
- end;
-{--------}
-procedure TOvcCellArray.Clear;
- begin
- FCount := 0;
- DoUnusedBit := false;
- end;
-{--------}
-function TOvcCellArray.DeleteCell(RowNum : TRowNum; ColNum : TColNum) : boolean;
- var
- L, R, M : Integer;
- MCell : TOvcCellAddress;
- begin
- Result := false;
- {do special case, er, specially}
- if (FCount = 0) then
- Exit;
- {binary search through array}
- L := 0;
- R := pred(FCount);
- repeat
- M := (L + R) div 2;
- MCell := POvcCellArrayPrim(FArray)^[M];
- if (RowNum = MCell.Row) then
- if (ColNum = MCell.Col) then
- begin
- {got it}
- dec(FCount);
- if (FCount > M) then
- Move(POvcCellArrayPrim(FArray)^[M+1],
- POvcCellArrayPrim(FArray)^[M],
- sizeof(TOvcCellAddress)*(FCount-M));
- Result := true;
- Exit;
- end
- else if (ColNum < MCell.Col) then
- R := M - 1
- else
- L := M + 1
- else if (RowNum < MCell.Row) then
- R := M - 1
- else
- L := M + 1;
- until (L > R);
- end;
-{--------}
-procedure TOvcCellArray.GetCellAddr(Inx : Integer; var CellAddr : TOvcCellAddress);
- begin
- if (0 <= Inx) and (Inx < FCount) then
- CellAddr := POvcCellArrayPrim(FArray)^[Inx]
- else
- FillChar(CellAddr, sizeof(CellAddr), 0);
- end;
-{--------}
-function TOvcCellArray.GetEmpty : boolean;
- begin
- Result := (Count = 0) and (not DoUnusedBit);
- end;
-{--------}
-procedure TOvcCellArray.Merge(CA : TOvcCellArray);
- var
- NewA : POvcCellArrayPrim;
- InxMerge : integer;
- InxSelf : integer;
- InxCA : integer;
- CellSelf : TOvcCellAddress;
- CellCA : TOvcCellAddress;
- NewLimit : integer;
- MergeNum : integer;
- i : integer;
- begin
- {if both cell arrays are empty, there's nothing to do}
- if (Count = 0) and (CA.Count = 0) then
- Exit;
- {make a new array at least as large as both arrays put together}
- NewLimit := ((Count + CA.Count) + 127) and $7FFFFF80;
- GetMem(NewA, sizeof(TOvcCellAddress) * NewLimit);
- {prepare for the loop}
- InxMerge := 0;
- InxSelf := 0;
- InxCA := 0;
- if (Count > 0) then
- CellSelf := POvcCellArrayPrim(FArray)^[0];
- if (CA.Count > 0) then
- CellCA := POvcCellArrayPrim(CA.FArray)^[0];
- {loop until one (or both) of the arrays is exhausted}
- while (InxSelf < Count) and (InxCA < CA.Count) do
- begin
- if (CellSelf.Row < CellCA.Row) then
- MergeNum := 1
- else if (CellSelf.Row > CellCA.Row) then
- MergeNum := 2
- else {CellSelf.Row = CellCA.Row}
- if (CellSelf.Col < CellCA.Col) then
- MergeNum := 1
- else if (CellSelf.Col > CellCA.Col) then
- MergeNum := 2
- else {both rows & cols equal}
- MergeNum := 0;
- case MergeNum of
- 0 : begin {equal}
- NewA^[InxMerge] := CellSelf;
- inc(InxMerge);
- inc(InxSelf);
- if (InxSelf < Count) then
- CellSelf := POvcCellArrayPrim(FArray)^[InxSelf];
- inc(InxCA);
- if (InxCA < CA.Count) then
- CellCA := POvcCellArrayPrim(CA.FArray)^[InxCA];
- end;
- 1 : begin
- NewA^[InxMerge] := CellSelf;
- inc(InxMerge);
- inc(InxSelf);
- if (InxSelf < Count) then
- CellSelf := POvcCellArrayPrim(FArray)^[InxSelf];
- end;
- 2 : begin
- NewA^[InxMerge] := CellCA;
- inc(InxMerge);
- inc(InxCA);
- if (InxCA < CA.Count) then
- CellCA := POvcCellArrayPrim(CA.FArray)^[InxCA];
- end;
- end;{case}
- end;
- {after this loop one (or both) of the input merge streams has been
- exhausted; copy the remaining elements from the other}
- if (InxSelf = Count) then {self array exhausted}
- for i := InxCA to pred(CA.Count) do
- begin
- NewA^[InxMerge] := POvcCellArrayPrim(CA.FArray)^[i];
- inc(InxMerge);
- end
- else if (InxCA = CA.Count) then {CA array exhausted}
- for i := InxSelf to pred(Count) do
- begin
- NewA^[InxMerge] := POvcCellArrayPrim(FArray)^[i];
- inc(InxMerge);
- end;
- {all merged, replace the current array with the merged array}
- FreeMem(FArray, sizeof(TOvcCellAddress) * FLimit);
- FArray := NewA;
- FLimit := NewLimit;
- FCount := InxMerge;
- end;
-{--------}
-function TOvcCellArray.MustDoUnusedBit : boolean;
- begin
- Result := DoUnusedBit;
- end;
-{====================================================================}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/7c/7cbcc9c5bbd49f577aefabf54e568341b0a9b883.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/7c/7cbcc9c5bbd49f577aefabf54e568341b0a9b883.svn-base
deleted file mode 100644
index 67a4e63e..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/pristine/7c/7cbcc9c5bbd49f577aefabf54e568341b0a9b883.svn-base and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/7c/7cf1e0baddfcd49311958a7bb0e2384a8da753c9.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/7c/7cf1e0baddfcd49311958a7bb0e2384a8da753c9.svn-base
deleted file mode 100644
index 7f115490..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/7c/7cf1e0baddfcd49311958a7bb0e2384a8da753c9.svn-base
+++ /dev/null
@@ -1,730 +0,0 @@
-{*********************************************************}
-{* OVCTCEDT.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 ovctcedt;
- {-Orpheus Table Cell - Windows edit Control type}
-
-interface
-
-uses
- SysUtils, Classes,
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Controls, Forms, StdCtrls,
- OvcTCmmn, OvcTCell, OvcTCStr,
- Graphics; { - for default color definition}
-
-type
- TOvcTCStringEdit = class(TEdit)
- protected {private}
- FCell : TOvcBaseTableCell;
-
- protected
- procedure WMChar(var Msg : TWMKey); message WM_CHAR;
- procedure WMGetDlgCode(var Msg : TMessage); message WM_GETDLGCODE;
- procedure WMKeyDown(var Msg : TWMKey); message WM_KEYDOWN;
- procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS;
- procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
-
- property CellOwner : TOvcBaseTableCell
- read FCell write FCell;
- end;
-
- TOvcTCCustomString = class(TOvcTCBaseString)
- protected {private}
- FEdit : TOvcTCStringEdit;
- FMaxLength : word;
- FAutoAdvanceChar : boolean;
- FAutoAdvanceLeftRight : boolean;
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
-
- protected
- function GetCellEditor : TControl; override;
- function GetModified : boolean;
-
- property AutoAdvanceChar : boolean
- read FAutoAdvanceChar write FAutoAdvanceChar;
-
- property AutoAdvanceLeftRight : boolean
- read FAutoAdvanceLeftRight write FAutoAdvanceLeftRight;
-
- property MaxLength : word
- read FMaxLength write FMaxLength;
-
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D;
-{$ENDIF}
- public
- function CreateEditControl(AOwner : TComponent) : TOvcTCStringEdit; virtual;
-
- function EditHandle : THandle; override;
- procedure EditHide; override;
- procedure EditMove(CellRect : TRect); override;
-
- procedure SaveEditedData(Data : pointer); override;
- procedure StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer); override;
- procedure StopEditing(SaveValue : boolean;
- Data : pointer); override;
-
- property Modified : boolean
- read GetModified;
- end;
-
- TOvcTCString = class(TOvcTCCustomString)
- published
- {properties inherited from custom ancestor}
- property Access default otxDefault;
- property Adjust default otaDefault;
- property AutoAdvanceChar default False;
- property AutoAdvanceLeftRight default False;
- property Color;
- property Font;
- property Hint;
- property Margin default 4;
- property MaxLength default 0;
- property ShowHint default False;
- property Table;
- property TableColor default True;
- property TableFont default True;
- property TextHiColor default clBtnHighlight;
- property TextStyle default tsFlat;
- property UseWordWrap default False;
- property UseASCIIZStrings default False;
-
- {events inherited from custom ancestor}
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnOwnerDraw;
- public
- constructor Create(AOwner : TComponent); override;
- end;
-
-type
- TOvcTCMemoEdit = class(TMemo)
- protected {private}
- FCell : TOvcBaseTableCell;
-
- protected
- procedure WMChar(var Msg : TWMKey); message WM_CHAR;
- procedure WMGetDlgCode(var Msg : TMessage); message WM_GETDLGCODE;
- procedure WMKeyDown(var Msg : TWMKey); message WM_KEYDOWN;
- procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS;
- procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
-
- property CellOwner : TOvcBaseTableCell
- read FCell write FCell;
- end;
-
- TOvcTCCustomMemo = class(TOvcTCBaseString)
- protected {private}
- FEdit : TOvcTCMemoEdit;
- FMaxLength : word;
- FWantReturns : boolean;
- FWantTabs : boolean;
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
-
- protected
- function GetCellEditor : TControl; override;
- function GetModified : boolean;
-
- property MaxLength : word
- read FMaxLength write FMaxLength;
-
- property WantReturns : boolean
- read FWantReturns write FWantReturns;
-
- property WantTabs : boolean
- read FWantTabs write FWantTabs;
-
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D;
-{$ENDIF}
- public
- constructor Create(AOwner : TComponent); override;
- function CreateEditControl(AOwner : TComponent) : TOvcTCMemoEdit; virtual;
-
- function EditHandle : THandle; override;
- procedure EditHide; override;
- procedure EditMove(CellRect : TRect); override;
- procedure SaveEditedData(Data : pointer); override;
- procedure StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer); override;
- procedure StopEditing(SaveValue : boolean;
- Data : pointer); override;
-
- property Modified : boolean
- read GetModified;
- end;
-
- TOvcTCMemo = class(TOvcTCCustomMemo)
- published
- {properties inherited from custom ancestor}
- property Access default otxDefault;
- property Adjust default otaDefault;
- property Color;
- property Font;
- property Hint;
- property Margin default 4;
- property MaxLength default 0;
- property ShowHint default False;
- property Table;
- property TableColor default True;
- property TableFont default True;
- property TextHiColor default clBtnHighlight;
- property TextStyle default tsFlat;
- property WantReturns default False;
- property WantTabs default False;
-
- {events inherited from custom ancestor}
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnOwnerDraw;
- end;
-
-implementation
-
-{===TOvcTCCustomString===============================================}
-function TOvcTCCustomString.CreateEditControl(AOwner : TComponent) : TOvcTCStringEdit;
- begin
- Result := TOvcTCStringEdit.Create(AOwner);
- end;
-{--------}
-function TOvcTCCustomString.EditHandle : THandle;
- begin
- if Assigned(FEdit) then
- Result := FEdit.Handle
- else
- Result := 0;
- end;
-{--------}
-procedure TOvcTCCustomString.EditHide;
- begin
- if Assigned(FEdit) then
- with FEdit do
- begin
- SetWindowPos(FEdit.Handle, HWND_TOP,
- 0, 0, 0, 0,
- SWP_HIDEWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- end;
- end;
-{--------}
-procedure TOvcTCCustomString.EditMove(CellRect : TRect);
- var
- EditHandle : HWND;
- begin
- if Assigned(FEdit) then
- begin
- EditHandle := FEdit.Handle;
- with CellRect do
- SetWindowPos(EditHandle, HWND_TOP,
- Left, Top, Right-Left, Bottom-Top,
- SWP_SHOWWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- InvalidateRect(EditHandle, nil, false);
- UpdateWindow(EditHandle);
- end;
- end;
-{--------}
-function TOvcTCCustomString.GetCellEditor : TControl;
- begin
- Result := FEdit;
- end;
-{--------}
-function TOvcTCCustomString.GetModified : boolean;
- begin
- if Assigned(FEdit) then
- Result := FEdit.Modified
- else Result := false;
- end ;
-{--------}
-procedure TOvcTCCustomString.SaveEditedData(Data : pointer);
- begin
- if Assigned(Data) then
- if UseASCIIZStrings then
- FEdit.GetTextBuf(PAnsiChar(Data), MaxLength)
- else
- POvcShortString(Data)^ := Copy(FEdit.Text, 1, MaxLength);
- end;
-{--------}
-procedure TOvcTCCustomString.StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer);
- begin
- FEdit := CreateEditControl(FTable);
- with FEdit do
- begin
- if UseASCIIZStrings then
- begin
- if (Data = nil) then
- SetTextBuf('')
- else
- SetTextBuf(PAnsiChar(Data));
- end
- else
- begin
- if (Data = nil) then
- Text := ''
- else
- Text := POvcShortString(Data)^;
- end;
- Color := CellAttr.caColor;
- Font := CellAttr.caFont;
- Font.Color := CellAttr.caFontColor;
- Left := CellRect.Left;
- Top := CellRect.Top;
- Width := CellRect.Right - CellRect.Left;
- Height := CellRect.Bottom - CellRect.Top;
- TabStop := false;
- CellOwner := Self;
- MaxLength := Self.MaxLength;
- Hint := Self.Hint;
- ShowHint := Self.ShowHint;
- Parent := FTable;
- BorderStyle := bsNone;
- Ctl3D := false;
- case CellStyle of
- tesBorder : BorderStyle := bsSingle;
- tes3D : Ctl3D := true;
- end;{case}
-
- OnChange := Self.OnChange;
- OnClick := Self.OnClick;
- OnDblClick := Self.OnDblClick;
- OnDragDrop := Self.OnDragDrop;
- OnDragOver := Self.OnDragOver;
- OnEndDrag := Self.OnEndDrag;
- OnEnter := Self.OnEnter;
- OnExit := Self.OnExit;
- OnKeyDown := Self.OnKeyDown;
- OnKeyPress := Self.OnKeyPress;
- OnKeyUp := Self.OnKeyUp;
- OnMouseDown := Self.OnMouseDown;
- OnMouseMove := Self.OnMouseMove;
- OnMouseUp := Self.OnMouseUp;
- end;
- end;
-{--------}
-procedure TOvcTCCustomString.StopEditing(SaveValue : boolean;
- Data : pointer);
-
- begin
- try
- if SaveValue and Assigned(Data) then
- if UseASCIIZStrings then
- FEdit.GetTextBuf(PAnsiChar(Data), MaxLength+1)
- else
- POvcShortString(Data)^ := Copy(FEdit.Text, 1, MaxLength);
- finally
- FEdit.Free;
- FEdit := nil;
- end;
- end;
-{====================================================================}
-
-
-{===TOvcTCStringEdit===============================================}
-procedure TOvcTCStringEdit.WMChar(var Msg : TWMKey);
- var
- CurText : string;
- begin
- if (Msg.CharCode <> 13) and {Enter}
- (Msg.CharCode <> 9) and {Tab}
- (Msg.CharCode <> 27) then {Escape}
- inherited;
- if TOvcTCCustomString(CellOwner).AutoAdvanceChar then
- begin
- CurText := Text;
- if (length(CurText) >= MaxLength) then
- begin
- FillChar(Msg, sizeof(Msg), 0);
- with Msg do
- begin
- Msg := WM_KEYDOWN;
- CharCode := VK_RIGHT;
- end;
- CellOwner.SendKeyToTable(Msg);
- end;
- end;
- end;
-{--------}
-procedure TOvcTCStringEdit.WMGetDlgCode(var Msg : TMessage);
- begin
- inherited;
- if CellOwner.TableWantsTab then
- Msg.Result := Msg.Result or DLGC_WANTTAB;
- if CellOwner.TableWantsEnter then
- Msg.Result := Msg.Result or DLGC_WANTALLKEYS;
- end;
-{--------}
-procedure TOvcTCStringEdit.WMKeyDown(var Msg : TWMKey);
- procedure GetSelection(var S, E : word);
- type
- LH = packed record L, H : word; end;
- var
- GetSel : longint;
- begin
- GetSel := SendMessage(Handle, EM_GETSEL, 0, 0);
- S := LH(GetSel).L;
- E := LH(GetSel).H;
- end;
- var
- GridReply : TOvcTblKeyNeeds;
- GridUsedIt : boolean;
- SStart, SEnd : word;
- begin
- GridUsedIt := false;
- GridReply := otkDontCare;
- if (CellOwner <> nil) then
- GridReply := CellOwner.FilterTableKey(Msg);
- case GridReply of
- otkMustHave :
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- otkWouldLike :
- case Msg.CharCode of
- VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN :
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- VK_LEFT :
- if TOvcTCCustomString(CellOwner).AutoAdvanceLeftRight then
- begin
- GetSelection(SStart, SEnd);
- if (SStart = SEnd) and (SStart = 0) then
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;
- VK_RIGHT :
- if TOvcTCCustomString(CellOwner).AutoAdvanceLeftRight then
- begin
- GetSelection(SStart, SEnd);
- if ((SStart = SEnd) or (SStart = 0)) and (SEnd = GetTextLen) then
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;
- end;
- end;{case}
-
- if not GridUsedIt then
- inherited;
- end;
-{--------}
-procedure TOvcTCStringEdit.WMKillFocus(var Msg : TWMKillFocus);
- begin
- inherited;
- CellOwner.PostMessageToTable(ctim_KillFocus, Msg.FocusedWnd, 0);
- end;
-{--------}
-procedure TOvcTCStringEdit.WMSetFocus(var Msg : TWMSetFocus);
- begin
- inherited;
- CellOwner.PostMessageToTable(ctim_SetFocus, Msg.FocusedWnd, 0);
- end;
-{====================================================================}
-
-
-
-
-{===TOvcTCCustomMemo=================================================}
-constructor TOvcTCCustomMemo.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
- UseASCIIZStrings := true;
- UseWordWrap := true;
- end;
-{--------}
-function TOvcTCCustomMemo.CreateEditControl(AOwner : TComponent) : TOvcTCMemoEdit;
- begin
- Result := TOvcTCMemoEdit.Create(AOwner);
- end;
-{--------}
-function TOvcTCCustomMemo.EditHandle : THandle;
- begin
- if Assigned(FEdit) then
- Result := FEdit.Handle
- else
- Result := 0;
- end;
-{--------}
-procedure TOvcTCCustomMemo.EditHide;
- begin
- if Assigned(FEdit) then
- with FEdit do
- begin
- SetWindowPos(FEdit.Handle, HWND_TOP,
- 0, 0, 0, 0,
- SWP_HIDEWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- end;
- end;
-{--------}
-procedure TOvcTCCustomMemo.EditMove(CellRect : TRect);
- begin
- if Assigned(FEdit) then
- begin
- with CellRect do
- SetWindowPos(FEdit.Handle, HWND_TOP,
- Left, Top, Right-Left, Bottom-Top,
- SWP_SHOWWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- InvalidateRect(FEdit.Handle, nil, false);
- UpdateWindow(FEdit.Handle);
- end;
- end;
-{--------}
-function TOvcTCCustomMemo.GetCellEditor : TControl;
- begin
- Result := FEdit;
- end;
-{--------}
-function TOvcTCCustomMemo.GetModified : boolean;
- begin
- if Assigned(FEdit) then
- Result := FEdit.Modified
- else Result := false;
- end ;
-{--------}
-procedure TOvcTCCustomMemo.StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer);
- begin
- FEdit := CreateEditControl(FTable);
- with FEdit do
- begin
- if (Data = nil) then
- SetTextBuf('')
- else
- SetTextBuf(PAnsiChar(Data));
- Color := CellAttr.caColor;
- Font := CellAttr.caFont;
- Font.Color := CellAttr.caFontColor;
- MaxLength := Self.MaxLength;
- WantReturns := Self.WantReturns;
- WantTabs := Self.WantTabs;
- Left := CellRect.Left;
- Top := CellRect.Top;
- Width := CellRect.Right - CellRect.Left;
- Height := CellRect.Bottom - CellRect.Top;
- Visible := true;
- TabStop := false;
- CellOwner := Self;
- Hint := Self.Hint;
- ShowHint := Self.ShowHint;
- Parent := FTable;
- BorderStyle := bsNone;
- Ctl3D := false;
- case CellStyle of
- tesBorder : BorderStyle := bsSingle;
- tes3D : Ctl3D := true;
- end;{case}
-
- OnChange := Self.OnChange;
- OnClick := Self.OnClick;
- OnDblClick := Self.OnDblClick;
- OnDragDrop := Self.OnDragDrop;
- OnDragOver := Self.OnDragOver;
- OnEndDrag := Self.OnEndDrag;
- OnEnter := Self.OnEnter;
- OnExit := Self.OnExit;
- OnKeyDown := Self.OnKeyDown;
- OnKeyPress := Self.OnKeyPress;
- OnKeyUp := Self.OnKeyUp;
- OnMouseDown := Self.OnMouseDown;
- OnMouseMove := Self.OnMouseMove;
- OnMouseUp := Self.OnMouseUp;
- end;
- end;
-{--------}
-procedure TOvcTCCustomMemo.StopEditing(SaveValue : boolean;
- Data : pointer);
- begin
- try
- if SaveValue and Assigned(Data) then
- FEdit.GetTextBuf(PAnsiChar(Data), MaxLength);
- finally
- FEdit.Free;
- FEdit := nil;
- end;
- end;
-
-procedure TOvcTCCustomMemo.SaveEditedData(Data : pointer);
-begin
- {stub out abstract method so BCB doesn't see this as an abstract class}
-end;
-
-{====================================================================}
-
-
-{===TOvcTCMemoEdit===============================================}
-procedure TOvcTCMemoEdit.WMChar(var Msg : TWMKey);
- begin
- if (not CellOwner.TableWantsTab) or
- (Msg.CharCode <> 9) then
- inherited;
- end;
-{--------}
-procedure TOvcTCMemoEdit.WMGetDlgCode(var Msg : TMessage);
- begin
- inherited;
- if CellOwner.TableWantsTab then
- Msg.Result := Msg.Result or DLGC_WANTTAB;
- end;
-{--------}
-procedure TOvcTCMemoEdit.WMKeyDown(var Msg : TWMKey);
- procedure GetSelection(var S, E : word);
- type
- LH = packed record L, H : word; end;
- var
- GetSel : longint;
- begin
- GetSel := SendMessage(Handle, EM_GETSEL, 0, 0);
- S := LH(GetSel).L;
- E := LH(GetSel).H;
- end;
- var
- GridReply : TOvcTblKeyNeeds;
- GridUsedIt : boolean;
- SStart, SEnd : word;
- begin
- GridUsedIt := false;
- GridReply := otkDontCare;
- if (CellOwner <> nil) then
- GridReply := CellOwner.FilterTableKey(Msg);
- case GridReply of
- otkMustHave :
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- otkWouldLike :
- case Msg.CharCode of
- VK_RETURN :
-{$IFNDEF LCL}
- if not WantReturns then
-{$ENDIF}
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- VK_LEFT :
- begin
- GetSelection(SStart, SEnd);
- if (SStart = SEnd) and (SStart = 0) then
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;
- VK_RIGHT :
- begin
- GetSelection(SStart, SEnd);
- if ((SStart = SEnd) or (SStart = 0)) and (SEnd = GetTextLen) then
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;
- end;
- end;{case}
-
- if not GridUsedIt then
- inherited;
- end;
-{--------}
-procedure TOvcTCMemoEdit.WMKillFocus(var Msg : TWMKillFocus);
- begin
- inherited;
- CellOwner.PostMessageToTable(ctim_KillFocus, Msg.FocusedWnd, 0);
- end;
-{--------}
-procedure TOvcTCMemoEdit.WMSetFocus(var Msg : TWMSetFocus);
- begin
- inherited;
- CellOwner.PostMessageToTable(ctim_SetFocus, Msg.FocusedWnd, 0);
- end;
-{====================================================================}
-
-{===TOvcTCString===============================================}
-constructor TOvcTCString.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
- end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/7d/7d3e1bbab93d51abcc2d5296c6a3857820048d00.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/7d/7d3e1bbab93d51abcc2d5296c6a3857820048d00.svn-base
deleted file mode 100644
index faecae9e..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/7d/7d3e1bbab93d51abcc2d5296c6a3857820048d00.svn-base
+++ /dev/null
@@ -1,11 +0,0 @@
-LazarusResources.Add('TForm1','FORMDATA',[
- 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#192#0#3'Top'#2'r'#5'Width'#3#247#1#6'Heig'
- +'ht'#3'H'#1#7'Caption'#6#5'Form1'#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7
- +#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245
- +#10'Font.Style'#11#0#13'PixelsPerInch'#2'`'#0#7'TOvcURL'#7'OvcURL1'#4'Left'#2
- +'`'#3'Top'#2'8'#5'Width'#3#138#0#6'Height'#2#13#4'Hint'#6'!http://www.lazaru'
- +'s.freepascal.org'#7'Caption'#6#28'URL link to Lazarus Web site'#3'URL'#6'!h'
- +'ttp://www.lazarus.freepascal.org'#12'Font.Charset'#7#15'DEFAULT_CHARSET'#10
- +'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245#10'Font.Style'#11#11'f'
- +'sUnderline'#0#10'ParentFont'#8#14'ParentShowHint'#8#8'ShowHint'#9#0#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/7d/7d87df413616c2c6b5c381ee380be5d55497595f.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/7d/7d87df413616c2c6b5c381ee380be5d55497595f.svn-base
deleted file mode 100644
index fc6dc345..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/7d/7d87df413616c2c6b5c381ee380be5d55497595f.svn-base
+++ /dev/null
@@ -1,12 +0,0 @@
-#!/bin/sh
-
-lazbuild -d tests/TestFlexEdit/project1.lpi
-lazbuild -d tests/TestLabel/project1.lpi
-lazbuild -d tests/TestRLbl/project1.lpi
-lazbuild -d tests/TestSimpField/project1.lpi
-lazbuild -d tests/TestSpinner/project1.lpi
-lazbuild -d tests/TestTable/project1.lpi
-lazbuild -d tests/TestTblEdits/project1.lpi
-lazbuild -d tests/TestURL/project1.lpi
-lazbuild -d tests/TestVLB/project1.lpi
-lazbuild -d tests/TestCalendar/project1.lpi
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/7e/7e8277deaf545644cad659dc2f2534e48074fa76.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/7e/7e8277deaf545644cad659dc2f2534e48074fa76.svn-base
deleted file mode 100644
index aac4d262..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/7e/7e8277deaf545644cad659dc2f2534e48074fa76.svn-base
+++ /dev/null
@@ -1,110 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/7f/7f17538451b51984d2af2cd19dbfe8789a9f5459.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/7f/7f17538451b51984d2af2cd19dbfe8789a9f5459.svn-base
deleted file mode 100644
index f40622ab..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/7f/7f17538451b51984d2af2cd19dbfe8789a9f5459.svn-base
+++ /dev/null
@@ -1,385 +0,0 @@
-{*********************************************************}
-{* O32EDITF.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}
-{$J+} {Writable constants}
-
-unit o32editf;
- {-base FlexEdit field class w/ attached label}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, Types, LclType, MyMisc, {$ENDIF}
- Buttons, Classes, Controls, ExtCtrls, Forms, Graphics, Menus,
- StdCtrls, SysUtils, OvcBase, OvcConst, OvcData, OvcVer,
- OvcMisc;
-
-type
- {base class for non-OvcController dependent edit fields...}
- TO32CustomEdit = class(TCustomEdit)
- protected {private}
- {property variables}
- FLabelInfo : TOvcLabelInfo;
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
- {property methods}
- function GetAbout : string;
- function GetAttachedLabel : TOvcAttachedLabel;
- procedure SetAbout(const Value : string);
- {internal methods}
- procedure LabelChange(Sender : TObject);
- procedure LabelAttach(Sender : TObject; Value : Boolean);
- procedure PositionLabel;
- {VCL message methods}
- procedure CMVisibleChanged(var Msg : TMessage); message CM_VISIBLECHANGED;
- procedure OrAssignLabel(var Msg : TMessage); message OM_ASSIGNLABEL;
- procedure OrPositionLabel(var Msg : TMessage); message OM_POSITIONLABEL;
- procedure OrRecordLabelPosition(var Msg : TMessage);
- message OM_RECORDLABELPOSITION;
- protected
- {descendants can set the value of this variable after calling inherited }
- {create to set the default location and point-of-reference (POR) for the}
- {attached label. if dlpTopLeft, the default location and POR will be at }
- {the top left of the control. if dlpBottomLeft, the default location and}
- {POR will be at the bottom left}
- DefaultLabelPosition : TOvcLabelPosition;
- procedure CreateWnd; override;
- procedure Notification(AComponent : TComponent; Operation: TOperation);
- override;
- property About : string read GetAbout write SetAbout stored False;
- property LabelInfo : TOvcLabelInfo read FLabelInfo write FLabelInfo;
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D;
-{$ENDIF}
- public
- constructor Create(AOwner : TComponent); override;
- destructor Destroy; override;
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
- property AttachedLabel : TOvcAttachedLabel read GetAttachedLabel;
- end;
-
- TO32Edit = class(TO32CustomEdit)
- published
- {properties}
- {$IFDEF VERSION4}
- property Anchors;
-{$IFNDEF LCL}
- property BiDiMode;
- property ParentBiDiMode;
-{$ENDIF}
- property Constraints;
- property DragKind;
- {$ENDIF}
- property About;
-{$IFNDEF LCL}
- property AutoSelect; // Added recently to LCL, but leave out for now
-{$ENDIF}
- property AutoSize;
- property BorderStyle;
- property CharCase;
- property Color;
- property Ctl3D;
- property Cursor;
- property DragCursor;
- property DragMode;
- property Enabled;
- property Font;
-{$IFNDEF LCL}
- property HideSelection;
- property ImeMode;
- property ImeName;
-{$ENDIF}
- property LabelInfo;
- property MaxLength;
-{$IFNDEF LCL}
- property OEMConvert;
-{$ENDIF}
- property ParentColor;
-{$IFNDEF LCL}
- property ParentCtl3D;
-{$ENDIF}
- property ParentFont;
- property ParentShowHint;
- property PasswordChar;
- property PopupMenu;
- property ReadOnly;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property Text;
- property Visible;
- {events}
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- {$IFDEF VERSION4}
- property OnEndDock;
- property OnStartDock;
- {$ENDIF}
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDrag;
- end;
-
-implementation
-
-{===== TO32CustomEdit ==============================================}
-procedure TO32CustomEdit.CMVisibleChanged(var Msg : TMessage);
-begin
- inherited;
-
- if csLoading in ComponentState then
- Exit;
-
- if LabelInfo.Visible then
- AttachedLabel.Visible := Visible;
-end;
-{=====}
-
-constructor TO32CustomEdit.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- ControlStyle := ControlStyle - [csSetCaption];
-
- {set default position and reference point}
- DefaultLabelPosition := lpTopLeft;
-
- FLabelInfo := TOvcLabelInfo.Create;
- FLabelInfo.OnChange := LabelChange;
- FLabelInfo.OnAttach := LabelAttach;
-end;
-{=====}
-
-procedure TO32CustomEdit.CreateWnd;
-// OurForm : TWinControl;
-begin
-// OurForm := GetImmediateParentForm(Self);
- inherited CreateWnd;
-end;
-{=====}
-
-destructor TO32CustomEdit.Destroy;
-begin
- {detatch and destroy label, if any}
- FLabelInfo.Visible := False;
-
- {destroy label info}
- FLabelInfo.Free;
- FLabelInfo := nil;
-
- inherited Destroy;
-end;
-{=====}
-
-function TO32CustomEdit.GetAttachedLabel : TOvcAttachedLabel;
-begin
- if not FLabelInfo.Visible then
- raise Exception.Create(GetOrphStr(SCLabelNotAttached));
-
- Result := FLabelInfo.ALabel;
-end;
-{=====}
-
-function TO32CustomEdit.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-{=====}
-
-procedure TO32CustomEdit.LabelAttach(Sender : TObject; Value : Boolean);
-var
-{$IFDEF VERSION5}
- PF : TWinControl;
-{$ELSE}
- PF : TForm;
-{$ENDIF}
- S :string;
-begin
- if csLoading in ComponentState then
- Exit;
-
-{$IFDEF VERSION5}
- PF := GetImmediateParentForm(Self);
-{$ELSE}
- PF := TForm(GetParentForm(Self));
-{$ENDIF}
- if Value then begin
- if Assigned(PF) then begin
- FLabelInfo.ALabel.Free;
- FLabelInfo.ALabel := TOvcAttachedLabel.CreateEx(PF, Self);
- FLabelInfo.ALabel.Parent := Parent;
-
- S := GenerateComponentName(PF, Name + 'Label');
- FLabelInfo.ALabel.Name := S;
- FLabelInfo.ALabel.Caption := S;
-
- FLabelInfo.SetOffsets(0, 0);
- PositionLabel;
- FLabelInfo.ALabel.BringToFront;
- {turn off auto size}
- TLabel(FLabelInfo.ALabel).AutoSize := False;
- end;
- end else begin
- if Assigned(PF) then begin
- FLabelInfo.ALabel.Free;
- FLabelInfo.ALabel := nil;
- end;
- end;
-end;
-{=====}
-
-procedure TO32CustomEdit.LabelChange(Sender : TObject);
-begin
- if not (csLoading in ComponentState) then
- PositionLabel;
-end;
-{=====}
-
-procedure TO32CustomEdit.Notification(AComponent : TComponent; Operation: TOperation);
-var
-{$IFDEF VERSION5}
- PF : TWinControl;
-{$ELSE}
- PF : TForm;
-{$ENDIF}
-begin
- inherited Notification(AComponent, Operation);
-
- if Operation = opRemove then
- if Assigned(FLabelInfo) and (AComponent = FLabelInfo.ALabel) then begin
- {$IFDEF VERSION5}
- PF := GetImmediateParentForm(Self);
- {$ELSE}
- PF := TForm(GetParentForm(Self));
- {$ENDIF}
- if Assigned(PF) and not (csDestroying in PF.ComponentState) then begin
- FLabelInfo.FVisible := False;
- FLabelInfo.ALabel := nil;
- end
- end;
-end;
-{=====}
-
-procedure TO32CustomEdit.OrAssignLabel(var Msg : TMessage);
-begin
- FLabelInfo.ALabel := TOvcAttachedLabel(Msg.lParam);
-end;
-{=====}
-
-procedure TO32CustomEdit.OrPositionLabel(var Msg : TMessage);
-const
- DX : Integer = 0;
- DY : Integer = 0;
-begin
- if FLabelInfo.Visible and Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) and
- not (csLoading in ComponentState) then begin
- if DefaultLabelPosition = lpTopLeft then begin
- DX := FLabelInfo.ALabel.Left - Left;
- DY := FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top;
- end else begin
- DX := FLabelInfo.ALabel.Left - Left;
- DY := FLabelInfo.ALabel.Top - Top - Height;
- end;
- if (DX <> FLabelInfo.OffsetX) or (DY <> FLabelInfo.OffsetY) then
- PositionLabel;
- end;
-end;
-{=====}
-
-procedure TO32CustomEdit.OrRecordLabelPosition(var Msg : TMessage);
-begin
- if Assigned(FLabelInfo.ALabel) and (FLabelInfo.ALabel.Parent <> nil) then begin
- {if the label was cut and then pasted, this will complete the reattachment}
- FLabelInfo.FVisible := True;
-
- if DefaultLabelPosition = lpTopLeft then
- FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
- FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top)
- else
- FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
- FLabelInfo.ALabel.Top - Top - Height);
- end;
-end;
-{=====}
-
-procedure TO32CustomEdit.PositionLabel;
-begin
- if FLabelInfo.Visible and Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) and
- not (csLoading in ComponentState) then begin
-
- if DefaultLabelPosition = lpTopLeft then begin
- FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
- FLabelInfo.OffsetY - FLabelInfo.ALabel.Height + Top,
- FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
- end else begin
- FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
- FLabelInfo.OffsetY + Top + Height,
- FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
- end;
- end;
-end;
-{=====}
-
-procedure TO32CustomEdit.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
-begin
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-
- if not HandleAllocated then
- Exit;
-
- if HandleAllocated then
- PostMessage(Handle, OM_POSITIONLABEL, 0, 0);
-end;
-{=====}
-
-procedure TO32CustomEdit.SetAbout(const Value : string);
-begin
-end;
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/7f/7f434f3106235ed066daa9e769d9f428821fb025.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/7f/7f434f3106235ed066daa9e769d9f428821fb025.svn-base
deleted file mode 100644
index 7904ff5b..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/7f/7f434f3106235ed066daa9e769d9f428821fb025.svn-base
+++ /dev/null
@@ -1,147 +0,0 @@
-{*********************************************************}
-{* OVCTCICO.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 ovctcico;
- {-Orpheus Table Cell - Icon type}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, {$ENDIF}
- SysUtils, Messages, Graphics, Classes, OvcTCmmn, OvcTCell;
-
-type
- TOvcTCCustomIcon = class(TOvcBaseTableCell)
- protected
- {.Z+}
- procedure tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer); override;
- {.Z-}
- public
- {.Z+}
- procedure ResolveAttributes(RowNum : TRowNum; ColNum : TColNum;
- var CellAttr : TOvcCellAttributes); override;
- {.Z-}
- end;
-
- TOvcTCIcon = class(TOvcTCCustomIcon)
- published
- {properties inherited from custom ancestor}
- property AcceptActivationClick default False;
- property Access default otxDefault;
- property Adjust default otaDefault;
- property Color;
- property Margin default 4;
- property Table;
- property TableColor default True;
- property OnOwnerDraw;
- end;
-
-
-implementation
-
-
-{===TOvcTCBaseBitMap=================================================}
-procedure TOvcTCCustomIcon.tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer);
- var
- Icon : TIcon absolute Data;
- Wd, Ht : integer;
- CellWidth : integer;
- CellHeight : integer;
- Left, Top : integer;
- CellAdj : TOvcTblAdjust;
- begin
- {blank out the cell (also sets the brush color)}
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, Data);
- {nothing else to do if the data is nil or the cell in invisible}
- if (Data = nil) or
- (CellAttr.caAccess = otxInvisible) then
- Exit;
- {make a note of the adjustment, calc the cell width and height}
- CellAdj := CellAttr.caAdjust;
- CellWidth := CellRect.Right - CellRect.Left;
- CellHeight := CellRect.Bottom - CellRect.Top;
- {get the width/height of the icon}
- with Icon do
- begin
- Wd := Width;
- Ht := Height;
- end;
- {calculate the destination position}
- case CellAdj of
- otaTopLeft, otaCenterLeft, otaBottomLeft :
- Left := Margin;
- otaTopRight, otaCenterRight, otaBottomRight :
- Left := (CellWidth - Wd - Margin);
- else
- Left := (CellWidth - Wd) div 2;
- end;{case}
- inc(Left, CellRect.Left);
- case CellAdj of
- otaTopLeft, otaTopCenter, otaTopRight :
- Top := Margin;
- otaBottomLeft, otaBottomCenter, otaBottomRight :
- Top := (CellHeight - Ht - Margin);
- else
- Top := (CellHeight - Ht) div 2;
- end;{case}
- inc(Top, CellRect.Top);
-
- TableCanvas.Draw(Left, Top, Icon);
- end;
-{--------}
-procedure TOvcTCCustomIcon.ResolveAttributes(RowNum : TRowNum; ColNum : TColNum;
- var CellAttr : TOvcCellAttributes);
- begin
- inherited ResolveAttributes(RowNum, ColNum, CellAttr);
- case CellAttr.caAccess of
- otxDefault, otxNormal : CellAttr.caAccess := otxReadOnly;
- end;{case}
- end;
-{====================================================================}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/80/80e32f40d783dc8767e5777011120c46b9493e01.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/80/80e32f40d783dc8767e5777011120c46b9493e01.svn-base
deleted file mode 100644
index 49fe50ec..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/80/80e32f40d783dc8767e5777011120c46b9493e01.svn-base
+++ /dev/null
@@ -1,155 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
- ovcbase, ovctcbmp, ovctccbx, ovctcgly, ovctcbox, ovctcedt,
- ovctchdr, ovctcmmn, ovctcell, ovctcstr, ovctable;
-
-const
- MaxDataRecs = 20;
- MaxStrLen = 100;
- MaxMemoLen = 1000;
- cnStr = 1; {Column numbers for controls}
- cnMemo = 2;
- cnCheckbox = 3;
- cnCombo = 4;
- cnBitmap = 5;
-
-type
- TDataRec = record
- Str : string[MaxStrLen];
- Memo : array[0..MaxMemoLen] of Char;
- Check : TCheckBoxState;
- ComboIndex : Integer;
- Bitmap : TBitmap;
- end;
-
- TDataArray = array[1..MaxDataRecs] of TDataRec;
-
- TForm1 = class(TForm)
- OvcTable1: TOvcTable;
- OvcController1: TOvcController;
- OvcTCColHead1: TOvcTCColHead;
- OvcTCRowHead1: TOvcTCRowHead;
- OvcTCString1: TOvcTCString;
- OvcTCMemo1: TOvcTCMemo;
- OvcTCCheckBox1: TOvcTCCheckBox;
- OvcTCComboBox1: TOvcTCComboBox;
- OvcTCBitMap1: TOvcTCBitMap;
- procedure FormCreate(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure OvcTable1GetCellData(Sender: TObject; RowNum,
- ColNum: Integer; var Data: Pointer; Purpose: TOvcCellDataPurpose);
- procedure OvcTCComboBox1Change(Sender: TObject);
- private
- BmpPath : string; {Path to Orpheus .bmp files}
- DataArray : TDataArray; {A place to store data entered in table}
- public
- end;
-
-var
- Form1: TForm1;
-
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.dfm} {Link Delphi form file}
-{$ENDIF}
-
-procedure TForm1.FormCreate(Sender: TObject);
- {Initialize the main form.
- Do anything that needs to be done before the form
- can be displayed.}
-var
- SearchResult : Integer;
- SearchRec : TSearchRec;
-begin
- OvcTable1.RowLimit := MaxDataRecs + OvcTable1.LockedRows;
-
- OvcTCString1.MaxLength := MaxStrLen; {Be sure to set this here or in form}
- OvcTCMemo1.MaxLength := MaxMemoLen;
-
- {Populate cell combo box with names of Orpheus control bitmap files.
- Assumes bitmap files are two levels up from program with Windows and GTK
- or five levels up with OS X app bundle folder.}
- BmpPath := ExtractFilePath(ParamStr(0)) + '..' + PathDelim + '..' + PathDelim;
- if FindFirst(BmpPath + 'TO*.bmp', 0, SearchRec) <> 0 then
- begin
- BmpPath := '..' + PathDelim + '..' + PathDelim;
- if FindFirst(BmpPath + 'TO*.bmp', 0, SearchRec) <> 0 then
- BmpPath := ExtractFilePath(ParamStr(0)) + '..' + PathDelim + '..' +
- PathDelim + '..' + PathDelim + '..' + PathDelim + '..' + PathDelim;
- end;
- OvcTCComboBox1.Items.Add(' (None)'); {So we can "unselect"}
- try
- SearchResult := FindFirst(BmpPath + 'TO*.bmp', 0, SearchRec);
- while SearchResult = 0 do {Do until no more matching files found}
- begin
- OvcTCComboBox1.Items.Add(SearchRec.Name);
- SearchResult := FindNext(SearchRec);
- end;
- finally
- FindClose(SearchRec);
- end;
-end; {TForm1.FormCreate}
-
-
-procedure TForm1.FormDestroy(Sender: TObject);
-var
- RecNum : Integer;
-begin
- for RecNum := 1 to MaxDataRecs do {Free any TBitmap's created}
- DataArray[RecNum].Bitmap.Free;
-end; {TForm1.FormDestroy}
-
-
-procedure TForm1.OvcTable1GetCellData(Sender: TObject; RowNum,
- ColNum: Integer; var Data: Pointer; Purpose: TOvcCellDataPurpose);
- {This event handler is called when the table needs data to display
- or edit in a cell or a place to save a cell's edited data.}
-begin
- Data := nil;
- if (RowNum < OvcTable1.LockedRows) or (RowNum > OvcTable1.RowLimit) then
- Exit;
-
- case ColNum of
- cnStr : Data := @DataArray[RowNum].Str;
- cnMemo : Data := @DataArray[RowNum].Memo;
- cnCheckbox : Data := @DataArray[RowNum].Check;
- cnCombo : Data := @DataArray[RowNum].ComboIndex;
- cnBitmap : Data := pointer(DataArray[RowNum].Bitmap);
- end;
-end; {TForm1.OvcTable1GetCellData}
-
-
-procedure TForm1.OvcTCComboBox1Change(Sender: TObject);
- {This event handler is called whenever combo box selection
- changes.
- Note: TOvcTCComboBox is not descended from TCustomComboBox, but
- its editing control (Sender) is, so okay to typecast it in order
- to reference ItemIndex.}
-begin
- DataArray[OvcTable1.ActiveRow].Bitmap.Free;
- DataArray[OvcTable1.ActiveRow].Bitmap := nil;
- if TCustomComboBox(Sender).ItemIndex > 0 then {Bitmap file selected?}
- begin
- DataArray[OvcTable1.ActiveRow].Bitmap := TBitmap.Create;
- DataArray[OvcTable1.ActiveRow].Bitmap.LoadFromFile(
- BmpPath + OvcTCComboBox1.Items[TCustomComboBox(Sender).ItemIndex]);
- end;
- OvcTable1.AllowRedraw := False;
- OvcTable1.InvalidateCell(OvcTable1.ActiveRow, cnBitmap); {Force display of bitmap}
- OvcTable1.AllowRedraw := True;
-end; {TForm1.OvcTCComboBox1Change}
-
-
-initialization
-{$IFDEF LCL}
-{$I unit1.lrs} {Include form's Lazarus resource file}
-{$ENDIF}
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/81/8139ffd5c4c904007929ef5d0fce4d3cf198afa5.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/81/8139ffd5c4c904007929ef5d0fce4d3cf198afa5.svn-base
deleted file mode 100644
index 76d7a317..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/pristine/81/8139ffd5c4c904007929ef5d0fce4d3cf198afa5.svn-base and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/83/83003899cf4e9d8f9c6f42a0c4c411480007fb84.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/83/83003899cf4e9d8f9c6f42a0c4c411480007fb84.svn-base
deleted file mode 100644
index ef1e67ea..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/83/83003899cf4e9d8f9c6f42a0c4c411480007fb84.svn-base
+++ /dev/null
@@ -1,1016 +0,0 @@
-{*********************************************************}
-{* mymisc.pas *}
-{*********************************************************}
-
-{* ***** 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 Orpheus for Lazarus Additional Units. *}
-{* *}
-{* The Initial Developer of the Original Code is Phil Hess. *}
-{* *}
-{* Portions created by Phil Hess are Copyright (C) 2006 Phil Hess. *}
-{* All Rights Reserved. *}
-{* *}
-{* Contributor(s): *}
-{* *}
-{* ***** END LICENSE BLOCK ***** *}
-
-unit MyMisc;
-
-{
- This unit provides types, constants, and functions that fill
- in some gaps in the Lazarus LCL for compiling the ported
- Orpheus controls.
-
- Declarations that have been commented out in the interface
- section are no longer needed. It is expected that over time
- more of these can be eliminated as the LCL evolves.
-
- Several of these functions are only used by Orpheus units
- that have not yet been ported to Lazarus. For now, these
- functions are just stubs on non-Windows platforms, as
- indicated in the function comments.
-}
-
-{$I ovc.inc}
-
-interface
-
-uses
- {$IFDEF MSWINDOWS} Windows, {$ELSE} Types, {$ENDIF}
- LclIntf, LMessages, LclType, InterfaceBase,
- {$IFDEF LINUX} FileUtil, {$ENDIF}
- GraphType, Graphics, Controls, SysUtils;
-
-type
- TButtonStyle = (bsAutoDetect, bsWin31, bsNew);
-
- TWMMouse = TLMMouse;
- TWMKeyDown = TLMKeyDown;
- TWMNCHitTest = TLMNCHitTest;
- TWMSetText = TLMSetText;
- TCMDesignHitTest = TWMMouse;
- TWMChar = TLMChar;
- TWMClear = TLMNoParams;
- TWMCopy = TLMNoParams;
- TWMCut = TLMNoParams;
- TWMLButtonDblClk = TLMLButtonDblClk;
- TWMLButtonDown = TLMLButtonDown;
- TWMLButtonUp = TLMLButtonUp;
- TWMRButtonDown = TLMRButtonDown;
- TWMSysKeyDown = TLMSysKeyDown;
- TWMMouseActivate = packed record
- Msg: Cardinal;
- TopLevel: HWND;
- HitTestCode: Word;
- MouseMsg: Word;
- Result: Longint;
- end;
- TWMMouseMove = TLMMouseMove;
- TWMPaste = TLMNoParams;
- TMessage = TLMessage;
- TWMEraseBkgnd = TLMEraseBkgnd;
- TWMGetText = TLMGetText;
- TWMGetTextLength = TLMGetTextLength;
- TWMKillFocus = TLMKillFocus;
- TWMSetCursor = packed record
- Msg: Cardinal;
- CursorWnd: HWND;
- HitTest: Word;
- MouseMsg: Word;
- Result: Longint;
- end;
- TWMSetFocus = TLMSetFocus;
- TWMGetDlgCode = TLMNoParams;
- TWMSize = TLMSize;
- TWMSetFont = packed record
- Msg: Cardinal;
- Font: HFONT;
- Redraw: WordBool;
- Unused: Word;
- Result: Longint;
- end;
- TWMCommand = TLMCommand;
- TWMDrawItem = TLMDrawItems;
- LPDWORD = PDWORD;
- TFNWndEnumProc = TFarProc;
- TNonClientMetrics = packed record
- cbSize: UINT;
- iBorderWidth: Integer;
- iScrollWidth: Integer;
- iScrollHeight: Integer;
- iCaptionWidth: Integer;
- iCaptionHeight: Integer;
- lfCaptionFont: TLogFontA;
- iSmCaptionWidth: Integer;
- iSmCaptionHeight: Integer;
- lfSmCaptionFont: TLogFontA;
- iMenuWidth: Integer;
- iMenuHeight: Integer;
- lfMenuFont: TLogFontA;
- lfStatusFont: TLogFontA;
- lfMessageFont: TLogFontA;
- end;
- TWMKey = TLMKey;
- TWMScroll = TLMScroll;
- TWMNoParams = TLMNoParams;
- TWMPaint = TLMPaint;
- TWMNCPaint = packed record
- Msg: Cardinal;
- RGN: HRGN;
- Unused: Longint;
- Result: Longint;
- end;
- TWMHScroll = TLMHScroll;
- TWMVScroll = TLMVScroll;
-
-const
- WM_WININICHANGE = CM_WININICHANGE;
- WM_CANCELMODE = LM_CANCELMODE;
- WM_ERASEBKGND = LM_ERASEBKGND;
- WM_GETTEXTLENGTH = LM_GETTEXTLENGTH;
- WM_KEYDOWN = LM_KEYDOWN;
- WM_KILLFOCUS = LM_KILLFOCUS;
- WM_LBUTTONDOWN = LM_LBUTTONDOWN;
- WM_LBUTTONUP = LM_LBUTTONUP;
- WM_MOUSEMOVE = LM_MOUSEMOVE;
- WM_NCHITTEST = LM_NCHITTEST;
- WM_SETCURSOR = LM_SETCURSOR;
- WM_SETTEXT = $000C;
- WM_GETTEXT = $000D;
- WM_SETFOCUS = LM_SETFOCUS;
- WM_CHAR = LM_CHAR;
- WM_CLEAR = LM_CLEAR;
- WM_COPY = LM_COPY;
- WM_CUT = LM_CUT;
- WM_PASTE = LM_PASTE;
-// With Lazarus versions prior to March 2008, LM_CLEAR, etc. are not defined,
-// so comment previous 4 lines and uncomment next 4 lines.
-{
- WM_CLEAR = LM_CLEARSEL;
- WM_COPY = LM_COPYTOCLIP;
- WM_CUT = LM_CUTTOCLIP;
- WM_PASTE = LM_PASTEFROMCLIP;
-}
- WM_GETDLGCODE = LM_GETDLGCODE;
- WM_SIZE = LM_SIZE;
- WM_SETFONT = LM_SETFONT;
- WM_SYSKEYDOWN = LM_SYSKEYDOWN;
- WM_RBUTTONUP = LM_RBUTTONUP;
- WM_MOUSEACTIVATE = $0021;
- WM_LBUTTONDBLCLK = LM_LBUTTONDBLCLK;
- WM_SETREDRAW = $000B;
- WM_NEXTDLGCTL = $0028;
- WM_MOUSEWHEEL = LM_MOUSEWHEEL;
- WM_PAINT = LM_PAINT;
- WM_VSCROLL = LM_VSCROLL;
- WM_HSCROLL = LM_HSCROLL;
- WM_NCPAINT = LM_NCPAINT;
- WM_MEASUREITEM = LM_MEASUREITEM;
-
- EM_GETMODIFY = $00B8;
- EM_SETMODIFY = $00B9;
- EM_GETSEL = $00B0;
- EM_SETSEL = $00B1;
- EM_GETLINECOUNT = $00BA;
- EM_LINELENGTH = $00C1;
- EM_LINEINDEX = $00BB;
- EM_GETLINE = $00C4;
- EM_REPLACESEL = $00C2;
-
- CS_SAVEBITS = $800;
- CS_DBLCLKS = 8;
- SPI_GETWORKAREA = 48;
- SPI_GETNONCLIENTMETRICS = 41;
- DLGC_STATIC = $100;
- GW_HWNDLAST = 1;
- GW_HWNDNEXT = 2;
- GW_HWNDPREV = 3;
- GW_CHILD = 5;
- DT_EXPANDTABS = $40;
- DT_END_ELLIPSIS = $8000;
- DT_MODIFYSTRING = $10000;
- GHND = 66;
- TMPF_TRUETYPE = 4;
- SWP_HIDEWINDOW = $80;
- SWP_SHOWWINDOW = $40;
- RDW_INVALIDATE = 1;
- RDW_UPDATENOW = $100;
- RDW_FRAME = $400;
- LANG_JAPANESE = $11;
- ES_PASSWORD = $20;
- ES_LEFT = 0;
- ES_RIGHT = 2;
- ES_CENTER = 1;
- ES_AUTOHSCROLL = $80;
- ES_MULTILINE = 4;
- ODS_COMBOBOXEDIT = $1000;
- CB_FINDSTRING = $014C;
- CB_SETITEMHEIGHT = $0153;
- CB_FINDSTRINGEXACT = $0158;
- CB_SETDROPPEDWIDTH = 352;
- CBS_DROPDOWN = 2;
- CBS_DROPDOWNLIST = 3;
- CBS_OWNERDRAWVARIABLE = $20;
- CBS_AUTOHSCROLL = $40;
- CBS_HASSTRINGS = $200;
- WHEEL_DELTA = 120;
- LB_GETCARETINDEX = $019F;
- LB_GETCOUNT = $018B;
- LB_GETCURSEL = $0188;
- LB_GETITEMHEIGHT = $01A1;
- LB_GETITEMRECT = $0198;
- LB_GETSEL = $0187;
- LB_GETTOPINDEX = $018E;
- LB_RESETCONTENT = $0184;
- LB_SELITEMRANGE = $019B;
- LB_SETCURSEL = $0186;
- LB_SETSEL = $0185;
- LB_SETTABSTOPS = $0192;
- LB_SETTOPINDEX = $0197;
- LB_ERR = -1;
- MA_ACTIVATE = 1;
- MA_NOACTIVATEANDEAT = 4;
-
-
- {These belong in LclIntf unit}
-function IsCharAlpha(c : Char) : Boolean;
-function DefWindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
-function GetProfileInt(lpAppName, lpKeyName: PChar; nDefault: Integer): UINT;
-function GetProfileString(lpAppName, lpKeyName, lpDefault: PChar;
- lpReturnedString: PChar; nSize: DWORD): DWORD;
-function GetTickCount : DWORD;
-//function SetTimer(hWnd: HWND; nIDEvent, uElapse: UINT;
-// lpTimerFunc: TFNTimerProc): UINT;
-//function KillTimer(hWnd: HWND; uIDEvent: UINT): BOOL;
-function GetCaretBlinkTime: UINT;
-function SetCaretBlinkTime(uMSeconds: UINT): BOOL;
-//function DestroyCaret: BOOL;
-function MessageBeep(uType: UINT): BOOL;
-function SystemParametersInfo(uiAction, uiParam: UINT;
- pvParam: Pointer; fWinIni: UINT): BOOL;
-{$IFNDEF MSWINDOWS}
-function GetSystemMetrics(nIndex: Integer): Integer;
-{$ENDIF}
-function MoveWindow(hWnd: HWND; X, Y, nWidth, nHeight: Integer; bRepaint: BOOL): BOOL;
-function SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND;
- X, Y, cx, cy: Integer; uFlags: UINT): BOOL;
-function UpdateWindow(hWnd: HWND): BOOL;
-function ValidateRect(hWnd: HWND; lpRect: PRect): BOOL;
-function InvalidateRect(hWnd: HWND; lpRect: PRect; bErase: BOOL): BOOL;
-function InvalidateRgn(hWnd: HWND; hRgn: HRGN; bErase: BOOL): BOOL;
-function GetRgnBox(RGN : HRGN; lpRect : PRect) : Longint;
-function PtInRegion(RGN: HRGN; X, Y: Integer) : Boolean;
-function SetWindowText(hWnd: HWND; lpString: PChar): BOOL;
-function GetBkColor(hDC: HDC): COLORREF;
-function GetBkMode(hDC: HDC): Integer;
-function GetWindow(hWnd: HWND; uCmd: UINT): HWND;
-function GetNextWindow(hWnd: HWND; uCmd: UINT): HWND;
-function RedrawWindow(hWnd: HWND; lprcUpdate: PRect; hrgnUpdate: HRGN; flags: UINT): BOOL;
-function GetWindowDC(hWnd: HWND): HDC;
-function ScrollDC(DC: HDC; DX, DY: Integer; var Scroll, Clip: TRect; Rgn: HRGN;
- Update: PRect): BOOL;
-function SetScrollRange(hWnd: HWND; nBar, nMinPos, nMaxPos: Integer; bRedraw: BOOL): BOOL;
-function GetTabbedTextExtent(hDC: HDC; lpString: PChar;
- nCount, nTabPositions: Integer;
- var lpnTabStopPositions): DWORD;
-function TabbedTextOut(hDC: HDC; X, Y: Integer; lpString: PChar;
- nCount, nTabPositions: Integer;
- var lpnTabStopPositions; nTabOrigin: Integer): Longint;
-function SetTextAlign(DC: HDC; Flags: UINT): UINT;
-function GetMapMode(DC: HDC): Integer;
-function SetMapMode(DC: HDC; p2: Integer): Integer;
-//function LoadBitmap(hInstance: HINST; lpBitmapName: PAnsiChar): HBITMAP;
-//function LoadCursor(hInstance: HINST; lpCursorName: PAnsiChar): HCURSOR;
-function EnumThreadWindows(dwThreadId: DWORD; lpfn: TFNWndEnumProc; lParam: LPARAM): BOOL;
-procedure OutputDebugString(lpOutputString: PChar);
-function SetViewportOrgEx(DC: HDC; X, Y: Integer; Point: PPoint): BOOL;
-function GlobalAlloc(uFlags: UINT; dwBytes: DWORD): HGLOBAL;
-function GlobalLock(hMem: HGLOBAL): Pointer;
-function GlobalUnlock(hMem: HGLOBAL): BOOL;
-//function DestroyCursor(hCursor: HICON): BOOL;
-//{$IFDEF MSWINDOWS} //Not needed with GTK and Qt (but doesn't hurt); Win32 and Carbon need it.
-function PostMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL;
-function SendMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
-//{$ENDIF}
-procedure RecreateWnd(const AWinControl:TWinControl);
-
- {These belong in Classes unit}
-//function MakeObjectInstance(Method: TWndMethod): Pointer;
-//procedure FreeObjectInstance(ObjectInstance: Pointer);
-//function AllocateHWnd(Method: TWndMethod): HWND;
-//procedure DeallocateHWnd(Wnd: HWND);
-
- {This belongs in System unit}
-//function FindClassHInstance(ClassType: TClass): LongWord;
-
- {This belongs in ExtCtrls unit}
-procedure Frame3D(Canvas: TCanvas; var Rect: TRect;
- TopColor, BottomColor: TColor; Width: Integer);
-
-// {This should be a TCanvas method} <--it is now, but still needed for TBitMap.BrushCopy.
-procedure BrushCopy(DestCanvas: TCanvas; const Dest: TRect; Bitmap: TBitmap;
- const Source: TRect; Color: TColor);
-
- {This belongs in Buttons unit}
-function DrawButtonFace(Canvas: TCanvas; const Client: TRect;
- BevelWidth: Integer; Style: TButtonStyle;
- IsRounded, IsDown, IsFocused: Boolean): TRect;
-
- {Additional routines}
-{$IFDEF LINUX}
-function GetBrowserPath : string;
-{$ENDIF}
-
-
-implementation
-
- {These functions belong in LclIntf unit}
-
-function IsCharAlpha(c : Char) : Boolean;
-// Doesn't handle upper-ANSI chars, but then LCL IsCharAlphaNumeric
-// function doesn't either.
-begin
- Result := ((Ord(c) >= 65) and (Ord(c) <= 90)) or
- ((Ord(c) >= 97) and (Ord(c) <= 122));
-end;
-
-function DefWindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
-// DefWindowProc is a Win API function for handling any window message
-// that the application doesn't handle.
-// Can't find equivalent in LCL.
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.DefWindowProc(hWnd, Msg, wParam, lParam);
-{$ELSE}
- Result := 0;
-{$ENDIF}
-end;
-
-function GetProfileInt(lpAppName, lpKeyName: PChar; nDefault: Integer): UINT;
-// Return the integer value for the key name in the lpAppName section
-// of the WIN.INI file, which on Win32 maps to the corresponding
-// section of the Windows registry.
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GetProfileInt(lpAppName, lpKeyName, nDefault);
-{$ELSE} //Just return default for now.
- Result := nDefault;
-{$ENDIF}
-end;
-
-function GetProfileString(lpAppName, lpKeyName, lpDefault: PChar;
- lpReturnedString: PChar; nSize: DWORD): DWORD;
-// Return the string value for the key name in the lpAppName section
-// of the WIN.INI file, which on Win32 maps to the corresponding
-// section of the Windows registry.
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GetProfileString(lpAppName, lpKeyName, lpDefault,
- lpReturnedString, nSize);
-{$ELSE} //Just return default for now.
- StrLCopy(lpReturnedString, lpDefault, Pred(nSize));
-{$ENDIF}
-end;
-
-function GetTickCount : DWORD;
- {On Windows, this is number of milliseconds since Windows was
- started. On non-Windows platforms, LCL returns number of
- milliseconds since Dec. 30, 1899, wrapped by size of DWORD.
- This value can overflow LongInt variable when checks turned on,
- so "wrap" value here so it fits within LongInt.
- Also, since same thing could happen with Windows that has been
- running for at least approx. 25 days, override it too.}
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GetTickCount mod High(LongInt);
-{$ELSE}
- Result := LclIntf.GetTickCount mod High(LongInt);
-{$ENDIF}
-end;
-
-function SetTimer(hWnd: HWND; nIDEvent, uElapse: UINT;
- lpTimerFunc: TFNTimerProc): UINT;
-begin
-{$IFDEF MSWINDOWS}
- Result := {Windows.}SetTimer(hWnd, nIDEvent, uElapse, lpTimerFunc);
-{$ENDIF}
-end;
-
-function KillTimer(hWnd: HWND; uIDEvent: UINT): BOOL;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.KillTimer(hWnd, UIDEvent);
-{$ENDIF}
-end;
-
-function GetCaretBlinkTime: UINT;
-// This function and SetCaretBlinkTime are only used in OvcCaret unit's
-// TOvcSingleCaret.SetLinked, which is used to write Linked property.
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GetCaretBlinkTime;
-{$ELSE}
- Result := 530; //Default on Win XP, so use as reasonable value
-{$ENDIF}
-end;
-
-function SetCaretBlinkTime(uMSeconds: UINT): BOOL;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.SetCaretBlinkTime(uMSeconds);
-{$ENDIF}
-end;
-
-function DestroyCaret: BOOL;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.DestroyCaret;
-{$ENDIF}
-end;
-
-function MessageBeep(uType: UINT): BOOL;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.MessageBeep(uType);
-{$ELSE}
- Beep; //Most calls pass 0 as uType (MB_OK), which is system default sound}
-{$ENDIF}
-end;
-
-function SystemParametersInfo(uiAction, uiParam: UINT;
- pvParam: Pointer; fWinIni: UINT): BOOL;
-// Only used in:
-// OvcMisc: PathEllipsis, which is only used in ovcmru (not yet ported).
-// OvcEdClc: TOvcCustomNumberEdit.PopupOpen.
-// OvcEdCal: TOvcCustomDateEdit.PopupOpen.
-// OvcEdSld (not yet ported).
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.SystemParametersInfo(uiAction, uiParam, pvParam,
- fWinIni);
-{$ENDIF}
-end;
-
-{$IFNDEF MSWINDOWS}
-function GetSystemMetrics(nIndex: Integer): Integer;
-// SM_CYBORDER, etc. not implemented yet in GTK widgetset.
-begin
- if nIndex = SM_SWAPBUTTON then
- Result := 0 {Not implemented on GTK, so assume buttons not swapped}
- else
- begin
- if nIndex = SM_CYBORDER then
-// nIndex := SM_CYEDGE; //Substitute for now so returned value is valid.
- begin //Neither implemented, so catch here to eliminate TODO messages.
- Result := 0; //0 was being returned before.
- Exit;
- end;
- Result := LclIntf.GetSystemMetrics(nIndex);
- end;
-end;
-{$ENDIF}
-
-function MoveWindow(hWnd: HWND; X, Y, nWidth, nHeight: Integer; bRepaint: BOOL): BOOL;
-// Only used in:
-// OvcEdClc: TOvcCustomNumberEdit.PopupOpen.
-// OvcEdCal: TOvcCustomDateEdit.PopupOpen.
-// OvcEdSld (not yet ported).
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.MoveWindow(hWnd, X, Y, nWidth, nHeight, bRepaint);
-{$ENDIF}
-end;
-
-function SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND;
- X, Y, cx, cy: Integer; uFlags: UINT): BOOL;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.SetWindowPos(hWnd, hWndInsertAfter, X, Y, cx, cy, uFlags);
-{$ELSE} //Doesn't do much with GTK, but call it anyway.
- Result := LclIntf.SetWindowPos(hWnd, hWndInsertAfter, X, Y, cx, cy, uFlags);
- if (uFlags and SWP_HIDEWINDOW) <> 0 then
- FindControl(hWnd).Visible := False
- else if (uFlags and SWP_SHOWWINDOW) <> 0 then
- FindControl(hWnd).Visible := True;
-{$ENDIF}
-end;
-
-function UpdateWindow(hWnd: HWND): BOOL;
- {For some reason, implementing this function in win32 widgetset
- on 27-May-2008 broke TOvcTable when a manifest is used.
- Since TOvcTable worked when this function was not implemented,
- just intercept and ignore call for now.}
-begin
- Result := True;
-end;
-
-function ValidateRect(hWnd: HWND; lpRect: PRect): BOOL;
-// Since LCL InvalidateRect redraws window, shouldn't need this function,
-// so leave it as stub for now.
-begin
-{$IFDEF MSWINDOWS}
-// Result := Windows.ValidateRect(hWnd, lpRect);
-{$ENDIF}
- Result := True;
-end;
-
-function InvalidateRect(hWnd: HWND; lpRect: PRect; bErase: BOOL): BOOL;
- {InvalidateRect crashes if lpRect is nil with some versions of LCL.}
-begin
-{$IFDEF MSWINDOWS}
- if Assigned(lpRect) then
- Result := LclIntf.InvalidateRect(hWnd, lpRect, bErase)
- else
- Result := Windows.InvalidateRect(hWnd, lpRect, bErase);
-{$ELSE}
- if Assigned(lpRect) then
- Result := LclIntf.InvalidateRect(hWnd, lpRect, bErase)
- else
- Result := True;
- //For now just ignore if nil since no alternative as with Windows.
-{$ENDIF}
-end;
-
-function InvalidateRgn(hWnd: HWND; hRgn: HRGN; bErase: BOOL): BOOL;
-{$IFDEF MSWINDOWS}
-begin
- Result := Windows.InvalidateRgn(hWnd, hRgn, bErase);
-{$ELSE}
-var
- ARect : TRect;
-begin
- GetRgnBox(hRgn, @ARect);
- Result := InvalidateRect(hWnd, @ARect, bErase);
-{$ENDIF}
-end;
-
-function GetRgnBox(RGN : HRGN; lpRect : PRect) : Longint;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GetRgnBox(RGN, lpRect);
-{$ELSE}
- Result := LclIntf.GetRgnBox(RGN, lpRect);
-{$ENDIF}
-end;
-
-function PtInRegion(RGN: HRGN; X, Y: Integer) : Boolean;
-{$IFDEF MSWINDOWS}
-begin
- Result := Windows.PtInRegion(RGN, X, Y);
-{$ELSE}
-var
- ARect : TRect;
- APt : TPoint;
-begin
- GetRgnBox(RGN, @ARect);
- APt.X := X;
- APt.Y := Y;
- Result := LclIntf.PtInRect(ARect, APt);
-{$ENDIF}
-end;
-
-function SetWindowText(hWnd: HWND; lpString: PChar): BOOL;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.SetWindowText(hWnd, lpString);
-{$ELSE}
-// Use FindControl, then assign to control's Text property?
-{$ENDIF}
-end;
-
-function GetBkColor(hDC: HDC): COLORREF;
-// Only used in:
-// OvcEF: TOvcBaseEntryField.efPaintPrim.
-// OvcLkOut (not yet ported).
-// O32LkOut (not yet ported).
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GetBkColor(hDC);
-{$ELSE} // Since SetBkColor returns previous color, use it to get color.
- Result := SetBkColor(hDC, 0); //Set background color to black.
- SetBkColor(hDC, Result); //Restore background color
-{$ENDIF}
-end;
-
-function GetBkMode(hDC: HDC): Integer;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GetBkMode(hDC);
-{$ELSE}
- Result := TRANSPARENT; //For now
-// Result := SetBkMode(hDC, TRANSPARENT); //Use when widgetsets support it
-// SetBkMode(hDC, Result);
-{$ENDIF}
-end;
-
-function GetWindow(hWnd: HWND; uCmd: UINT): HWND;
-{$IFDEF MSWINDOWS}
-begin
- Result := Windows.GetWindow(hWnd, uCmd);
-{$ELSE}
-var
- AWinControl : TWinControl;
-begin
- Result := 0;
- AWinControl := FindControl(hWnd);
- if AWinControl <> nil then
- begin
- case uCmd of
- GW_HWNDNEXT :
- begin
-// FindNextControl is declared in protected section, so can't use it.
-// AWinControl := AWinControl.FindNextControl(AWinControl, True, False, False);
-// if AWinControl <> nil then
-// Result := AWinControl.Handle;
- end;
- GW_CHILD :
- begin
- if AWinControl.ControlCount > 0 then
- Result := TWinControl(AWinControl.Controls[0]).Handle;
- end;
- GW_HWNDLAST :
- begin
- if AWinControl.Parent <> nil then
- Result := TWinControl(AWinControl.Parent.Controls[Pred(AWinControl.Parent.ControlCount)]).Handle;
- end;
- end;
- end;
-{$ENDIF}
-end;
-
-function GetNextWindow(hWnd: HWND; uCmd: UINT): HWND;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GetNextWindow(hWnd, uCmd);
-{$ELSE}
- Result := GetWindow(hWnd, uCmd);
-{$ENDIF}
-end;
-
-function RedrawWindow(hWnd: HWND; lprcUpdate: PRect; hrgnUpdate: HRGN; flags: UINT): BOOL;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.RedrawWindow(hWnd, lprcUpdate, hrgnUpdate, flags);
-{$ELSE}
-{$ENDIF}
-end;
-
-function GetWindowDC(hWnd: HWND): HDC;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GetWindowDC(hWnd);
-{$ELSE}
-{$ENDIF}
-end;
-
-function ScrollDC(DC: HDC; DX, DY: Integer; var Scroll, Clip: TRect; Rgn: HRGN;
- Update: PRect): BOOL;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.ScrollDC(DC, DX, DY, Scroll, Clip, Rgn, Update);
-{$ELSE}
-{$ENDIF}
-end;
-
-function SetScrollRange(hWnd: HWND; nBar, nMinPos, nMaxPos: Integer; bRedraw: BOOL): BOOL;
-{$IFDEF MSWINDOWS}
-begin
- Result := Windows.SetScrollRange(hWnd, nBar, nMinPos, nMaxPos, bRedraw);
-end;
-{$ELSE} //GTK needs more information, so use SetScrollInfo
-var
- ScrInfo : TScrollInfo;
-begin
- ScrInfo.fMask := SIF_RANGE or SIF_UPDATEPOLICY;
- ScrInfo.nTrackPos := SB_POLICY_CONTINUOUS;
- ScrInfo.nMin := nMinPos;
- ScrInfo.nMax := nMaxPos;
- LclIntf.SetScrollInfo(hWnd, nBar, ScrInfo, True);
- Result := True;
-end;
-{$ENDIF}
-
-function GetTabbedTextExtent(hDC: HDC; lpString: PChar;
- nCount, nTabPositions: Integer;
- var lpnTabStopPositions): DWORD;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GetTabbedTextExtent(hDC, lpString, nCount, nTabPositions,
- lpnTabStopPositions);
-{$ELSE}
- Result := 0; //Not implemented yet (see comment below).
-{$ENDIF}
-end;
-
-function TabbedTextOut(hDC: HDC; X, Y: Integer; lpString: PChar;
- nCount, nTabPositions: Integer;
- var lpnTabStopPositions; nTabOrigin: Integer): Longint;
-{$IFDEF MSWINDOWS}
-begin
- Result := Windows.TabbedTextOut(hDC, X, Y, lpString, nCount, nTabPositions,
- lpnTabStopPositions, nTabOrigin);
-{$ELSE}
-// TODO: Not yet implemented since not needed by Orpheus:
-// -Special case where nTabPositions is 0 and lpnTabStopPositions is nil.
-// -Special case where nTabPositions is 1 and >1 tab in string.
-// -Return value (height and width of string).
-// -Use of nTabOrigin. This is used in OvcVLB as a negative offset
-// with horizontal scrolling, but value passed is determined by
-// GetTabbedTextExtent, which is not yet implemented (above). Shouldn't
-// be needed if virtual list box doesn't have horizontal scrollbar.
-type
- TTabArray = array[1..1000] of Integer; {Assume no more than this many tabs}
-var
- OutX : Integer;
- TabCnt : Integer;
- StartPos : Integer;
- CharPos : Integer;
- OutCnt : Integer;
- TextSize : TSize;
-begin
- OutX := X;
- TabCnt := 0;
- StartPos := 0;
- for CharPos := 0 to Pred(nCount) do
- begin
- if (lpString[CharPos] = #9) or (CharPos = Pred(nCount)) then {Output text?}
- begin
- OutCnt := CharPos - StartPos;
- if CharPos = Pred(nCount) then {Include last char?}
- Inc(OutCnt);
- if (TabCnt > 0) and (TTabArray(lpnTabStopPositions)[TabCnt] < 0) then
- begin {Negative tab position means following text is right-aligned to it}
- GetTextExtentPoint(hDC, lpString+StartPos, OutCnt, TextSize);
- OutX := X + Abs(TTabArray(lpnTabStopPositions)[TabCnt]) - TextSize.cx;
- end;
- LclIntf.TextOut(hDC, OutX, Y, lpString+StartPos, OutCnt);
- StartPos := Succ(CharPos);
- if (lpString[CharPos] = #9) and (TabCnt < nTabPositions) then
- begin
- Inc(TabCnt);
- OutX := X + TTabArray(lpnTabStopPositions)[TabCnt];
- end;
- end;
- end;
- Result := 0; //Just return this for now.
-{$ENDIF}
-end;
-
-function SetTextAlign(DC: HDC; Flags: UINT): UINT;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.SetTextAlign(DC, Flags);
-{$ELSE}
-{$ENDIF}
-end;
-
-function GetMapMode(DC: HDC): Integer;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GetMapMode(DC);
-{$ELSE}
-{$ENDIF}
-end;
-
-function SetMapMode(DC: HDC; p2: Integer): Integer;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.SetMapMode(DC, p2);
-{$ELSE}
-{$ENDIF}
-end;
-
-function LoadBitmap(hInstance: HINST; lpBitmapName: PAnsiChar): HBITMAP;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.LoadBitmap(hInstance, lpBitmapName);
-{$ENDIF}
-end;
-
-function LoadCursor(hInstance: HINST; lpCursorName: PAnsiChar): HCURSOR;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.LoadCursor(hInstance, lpCursorName);
-{$ENDIF}
-end;
-
-function EnumThreadWindows(dwThreadId: DWORD; lpfn: TFNWndEnumProc; lParam: LPARAM): BOOL;
-// Only used in OvcMisc IsForegroundTask function, which is only
-// used in OvcSpeed (not yet ported).
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.EnumThreadWindows(dwThreadId, lpfn, lParam);
-{$ENDIF}
-end;
-
-procedure OutputDebugString(lpOutputString: PChar);
-begin
-{$IFDEF MSWINDOWS}
- Windows.OutputDebugString(lpOutputString);
-{$ENDIF}
-end;
-
-function SetViewportOrgEx(DC: HDC; X, Y: Integer; Point: PPoint): BOOL;
-// Only used in OvcMisc CopyParentImage procedure, which is only
-// used by TOvcCustomSpeedButton.Paint in OvcSpeed (not yet ported).
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.SetViewportOrgEx(DC, X, Y, Point);
-{$ENDIF}
-end;
-
-function GlobalAlloc(uFlags: UINT; dwBytes: DWORD): HGLOBAL;
-// GlobalAlloc, GlobalLock, and GlobalUnlock are only used in:
-// OvcEF: TOvcBaseEntryField.efCopyPrim and TOvcBaseEntryField.WMPaste.
-// OvcEdit (not yet ported).
-// OvcViewr (not yet ported).
-// Replace code in those units with calls to standard Clipboard methods?
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GlobalAlloc(uFlags, dwBytes);
-{$ELSE}
- Result := THandle(GetMem(dwBytes));
-{$ENDIF}
-end;
-
-function GlobalLock(hMem: HGLOBAL): Pointer;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GlobalLock(hMem);
-{$ELSE}
- Result := PAnsiChar(hMem);
-{$ENDIF}
-end;
-
-function GlobalUnlock(hMem: HGLOBAL): BOOL;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GlobalUnlock(hMem);
-{$ELSE}
- FreeMem(Pointer(hMem));
- Result := True;
-{$ENDIF}
-end;
-
-function DestroyCursor(hCursor: HICON): BOOL;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.DestroyCursor(hCursor);
-{$ENDIF}
-end;
-
-
-function PostMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL;
- {Use control's Perform method to force it to respond to posted message.
- This doesn't work: Result := LclIntf.PostMessage(hWnd, Msg, wParam, lParam); }
-var
- AWinControl : TWinControl;
-begin
- Assert(hWnd <> 0, 'Window handle not assigned on entry to PostMessage');
- AWinControl := FindOwnerControl(hWnd);
-// Assert(AWinControl <> nil,
-// 'Owner control not found in PostMessage ($' + IntToHex(Msg, 4) + ') ');
- if AWinControl <> nil then
- AWinControl.Perform(Msg, wParam, lParam);
- Result := True;
-end;
-
-function SendMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
- {Use control's Perform method to force it to respond to sent message.
- This doesn't work: Result := LclIntf.SendMessage(hWnd, Msg, wParam, lParam); }
-var
- AWinControl : TWinControl;
-begin
- Assert(hWnd <> 0, 'Window handle not assigned on entry to SendMessage');
- AWinControl := FindOwnerControl(hWnd);
-// Assert(AWinControl <> nil,
-// 'Owner control not found in SendMessage ($' + IntToHex(Msg, 4) + ') ');
- if AWinControl <> nil then
- Result := AWinControl.Perform(Msg, wParam, lParam);
-end;
-
-procedure RecreateWnd(const AWinControl:TWinControl);
-// Calls to Controls.RecreateWnd shouldn't be needed with GTK widgetset,
-// so just ignore them.
-begin
-{$IFDEF MSWINDOWS}
- Controls.RecreateWnd(AWinControl);
-{$ENDIF}
-end;
-
-
- {These belong in Classes unit}
-function MakeObjectInstance(Method: TWndMethod): Pointer;
-begin
-end;
-
-procedure FreeObjectInstance(ObjectInstance: Pointer);
-begin
-end;
-
-function AllocateHWnd(Method: TWndMethod): HWND;
-begin
-end;
-
-procedure DeallocateHWnd(Wnd: HWND);
-begin
-end;
-
-
- {This belongs in System unit}
-function FindClassHInstance(ClassType: TClass): LongWord;
-begin
-(*
- Result := System.MainInstance;
-*)
- Result := System.HInstance;
-end;
-
-
- {This belongs in ExtCtrls unit}
-procedure Frame3D(Canvas: TCanvas; var Rect: TRect;
- TopColor, BottomColor: TColor; Width: Integer);
-begin
- Canvas.Frame3D(Rect, Width, bvLowered);
- {Need a way of determining whether to pass bvNone, bvLowered,
- bvRaised, or bvSpace based on TopColor and BottomColor.
- See Delphi help for Frame3D.}
-end;
-
-
- {This should be a TCanvas method}
-procedure BrushCopy(DestCanvas: TCanvas; const Dest: TRect; Bitmap: TBitmap;
- const Source: TRect; Color: TColor);
-begin
- StretchBlt(DestCanvas.Handle, Dest.Left, Dest.Top,
- Dest.Right - Dest.Left, Dest.Bottom - Dest.Top,
- Bitmap.Canvas.Handle, Source.Left, Source.Top,
- Source.Right - Source.Left, Source.Bottom - Source.Top, SrcCopy);
-end;
-
-
- {This belongs in Buttons unit}
-function DrawButtonFace(Canvas: TCanvas; const Client: TRect;
- BevelWidth: Integer; Style: TButtonStyle;
- IsRounded, IsDown, IsFocused: Boolean): TRect;
- {Draw a push button.
- Style, IsRounded and IsFocused params appear to be left over
- from Win 3.1, so ignore them.}
-var
- ARect : TRect;
-begin
- ARect := Client;
- {The way LCL TCustomSpeedButton draws a button}
- if IsDown then
- begin
- if WidgetSet.LCLPlatform <> lpCarbon then
- Canvas.Frame3D(ARect, BevelWidth, bvLowered)
- else //bvLowered currently not supported on Carbon.
- Canvas.Frame3D(ARect, BevelWidth, bvRaised)
- end
- else
- Canvas.Frame3D(ARect, BevelWidth, bvRaised);
- Result := Client; //Should reduce dimensions by edges and bevels.
-end;
-
-
- {Additional routines}
-{$IFDEF LINUX}
-function SearchForBrowser(const BrowserFileName : string) : string;
- {Search path for specified browser file name, returning
- its expanded file name that includes path to it.}
-begin
- Result :=
- SearchFileInPath(BrowserFileName, '', GetEnvironmentVariable('PATH'),
- PathSeparator, [sffDontSearchInBasePath]);
-end;
-
-function GetBrowserPath : string;
- {Return path to first browser found.}
-begin
- Result := SearchForBrowser('firefox');
- if Result = '' then
- Result := SearchForBrowser('konqueror'); {KDE browser}
- if Result = '' then
- Result := SearchForBrowser('epiphany'); {GNOME browser}
- if Result = '' then
- Result := SearchForBrowser('mozilla');
- if Result = '' then
- Result := SearchForBrowser('opera');
-end;
-{$ENDIF}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/85/85f26174cb1fadd82dacba13e1686cbb9b0357cf.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/85/85f26174cb1fadd82dacba13e1686cbb9b0357cf.svn-base
deleted file mode 100644
index e61514ee..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/85/85f26174cb1fadd82dacba13e1686cbb9b0357cf.svn-base
+++ /dev/null
@@ -1,272 +0,0 @@
-{*********************************************************}
-{* OVCDRAG.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 ovcdrag;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, LclType, MyMisc, {$ENDIF}
- Classes, Graphics;
-
-type
- TOvcDragShow = class(TObject)
- {.Z+}
- protected
- dStretchBltMode : Integer;
- dMemDC,dSMemDC,
- dDstDC,dSaveDC : hDC;
- dSaveBmp, dMemBmp,
- dSMemBmp : hBITMAP;
- dcrText, dcrBack : TColorRef;
- dRect : TRect;
- dSize : TPoint;
- dSystemPalette16 : hPalette;
- dOldPal : hPalette;
- Bitmap,dMask : TBitmap;
- DeltaX, DeltaY : Integer;
- dDragging,
- dHaveOriginal : Boolean;
-
- procedure ilDragDraw;
- procedure ilRestoreOriginal;
- procedure ilSaveOriginal;
-
- public
- constructor Create(X, Y : Integer; SourceRect : TRect; TransColor : TColor);
- destructor Destroy;
- override;
- procedure DragMove(X, Y : Integer);
- procedure HideDragImage;
- procedure ShowDragImage;
- {.Z+}
- end;
-
-
-implementation
-
-
-{*** TOvcDragShow ***}
-
-constructor TOvcDragShow.Create(X, Y : Integer; SourceRect : TRect; TransColor : TColor);
-var
- dMaskDC : HDC;
- SrcDC : HDC;
-begin
- dHaveOriginal := False;
- dDstDC := GetDC(0);
- DeltaX := X - SourceRect.Left;
- DeltaY := Y - SourceRect.Top;
- dec(X, DeltaX);
- dec(Y, DeltaY);
- dRect.Left := X;
- dRect.Top := Y;
- Bitmap := nil;
- dMask := nil;
- try
- Bitmap := TBitmap.Create;
- Bitmap.Width := SourceRect.Right - SourceRect.Left + 1;
- Bitmap.Height := SourceRect.Bottom - SourceRect.Top + 1;
-
- dMask := TBitmap.Create;
- dMask.Width := SourceRect.Right - SourceRect.Left + 1;
- dMask.Height := SourceRect.Bottom - SourceRect.Top + 1;
-
- BitBlt(Bitmap.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height, dDstDC, SourceRect.Left,
- SourceRect.Top, SRCCOPY);
-{$IFNDEF LCL}
- dMask.Canvas.BrushCopy(Rect(0, 0, dMask.Width - 1, dMask.Height - 1), Bitmap,
- Rect(0, 0, dMask.Width - 1, dMask.Height - 1), TransColor);
-{$ELSE}
- BrushCopy(dMask.Canvas, Rect(0, 0, dMask.Width - 1, dMask.Height - 1), Bitmap,
- Rect(0, 0, dMask.Width - 1, dMask.Height - 1), TransColor);
-{$ENDIF}
-
- dMemDC := CreateCompatibleDC(0);
- dSaveDC := CreateCompatibleDC(0);
- dDragging := True;
- dStretchBltMode := SetStretchBltMode(dDstDC, BLACKONWHITE);
- dSize.X := Bitmap.Width;
- dSize.Y := Bitmap.Height;
- dRect.Right := dRect.Left + dSize.X - 1;
- dRect.Bottom := dRect.Top + dSize.Y - 1;
- SrcDC := Bitmap.Canvas.Handle;
- dMaskDC := dMask.Canvas.Handle;
- dSMemDC := CreateCompatibleDC(dMaskDC);
- dMemBmp := CreateCompatibleBitmap(SrcDC, dSize.X, dSize.Y);
- SelectObject(dMemDC, dMemBmp);
- dSMemBmp := CreateCompatibleBitmap(dMaskDC, dSize.X, dSize.Y);
- SelectObject(dSMemDC, dSMemBmp);
- dSaveBmp := CreateCompatibleBitmap(SrcDC, dSize.X, dSize.Y);
- SelectObject(dSaveDC, dSaveBmp);
- dSystemPalette16 := GetStockObject(DEFAULT_PALETTE);
- dOldPal := SelectPalette(SrcDC, dSystemPalette16, False);
- SelectPalette(SrcDC, dOldPal, False);
- if dOldPal <> 0 then begin
- SelectPalette(dMemDC, dOldPal, True);
- SelectPalette(dSaveDC, dOldPal, True);
- end else begin
- SelectPalette(dMemDC, dSystemPalette16, True);
- SelectPalette(dSaveDC, dSystemPalette16, True);
- end;
- RealizePalette(dMemDC);
- RealizePalette(dSaveDC);
-
- BitBlt(dSMemDC, 0, 0, dSize.X, dSize.Y, dMaskDC, 0, 0, SrcCopy);
- BitBlt(dMemDC, 0, 0, dSize.X, dSize.Y, dMaskDC, 0, 0, SrcCopy);
- BitBlt(dMemDC, 0, 0, dSize.X, dSize.Y, SrcDC, 0, 0, SrcErase);
- dcrText := SetTextColor(dDstDC, $0);
- dcrBack := SetBkColor(dDstDC, $FFFFFF);
- ilSaveOriginal;
- ilDragDraw;
- except
- Bitmap.Free;
- dMask.Free;
- raise;
- end;
-end;
-
-destructor TOvcDragShow.Destroy;
-begin
- ilRestoreOriginal;
- SetTextColor(dDstDC, dcrText);
- SetBkColor(dDstDC, dcrBack);
- DeleteObject(dMemBmp);
- DeleteObject(dSaveBmp);
- DeleteObject(dSMemBmp);
- DeleteDC(dMemDC);
- DeleteDC(dSMemDC);
- DeleteDC(dSaveDC);
- SetStretchBltMode(dDstDC, dStretchBltMode);
- ReleaseDC(0,dDstDC);
- dDragging := False;
- Bitmap.Free;
- dMask.Free;
- inherited Destroy;
-end;
-
-procedure TOvcDragShow.DragMove(X, Y: Integer);
-var
- NewRect, Union : TRect;
- UnionSize : TPoint;
- WorkDC : hDC;
- WorkBM : hBitmap;
-begin
- if not dDragging then exit;
- dec(X, DeltaX);
- dec(Y, DeltaY);
- {if we didn't move, get out}
- if (X = dRect.Left) and (Y = dRect.Top) then exit;
- {let's see where we're going}
- NewRect := Rect(X, Y, X + dSize.X - 1, Y + dSize.Y - 1);
- {if drag image not currently shown, just update next draw position and exit}
- if not dHaveOriginal then begin
- dRect := NewRect;
- exit;
- end;
- {do the old and new positions overlap?}
- if ord(IntersectRect(Union, dRect, NewRect)) <> 0 then begin
- {rect old and new combined:}
- UnionRect(Union, NewRect, dRect);
- {size of union:}
- UnionSize.X := Union.Right - Union.Left + 1;
- UnionSize.Y := Union.Bottom - Union.Top + 1;
- {create combination buffer}
- WorkDC := CreateCompatibleDC(0);
- WorkBM := CreateCompatibleBitmap(dDstDC, UnionSize.X, UnionSize.Y);
- SelectObject(WorkDC, WorkBM);
- if dOldPal <> 0 then
- SelectPalette(WorkDC, dOldPal, True)
- else
- SelectPalette(WorkDC, dSystemPalette16, True);
- RealizePalette(WorkDC);
- {copy screen section (including old image) to local buffer}
- BitBlt(WorkDC, 0, 0, UnionSize.X, UnionSize.Y, dDstDC, Union.Left, Union.Top, SRCCOPY);
- {"repair" by restoring background for old image}
- BitBlt(WorkDC, dRect.Left - Union.Left, dRect.Top - Union.Top,
- dSize.X, dSize.Y, dSaveDC, 0, 0, SRCCOPY);
- {save background so we can do the same next time}
- BitBlt(dSaveDC, 0, 0, dSize.X, dSize.Y, WorkDC, NewRect.Left - Union.Left, NewRect.Top - Union.Top, SrcCopy);
- {write image at new position into local buffer}
- BitBlt(WorkDC, NewRect.Left - Union.Left, NewRect.Top - Union.Top, dSize.X, dSize.Y, dSMemDC, 0, 0, SrcAnd);
- BitBlt(WorkDC, NewRect.Left - Union.Left, NewRect.Top - Union.Top, dSize.X, dSize.Y, dMemDC, 0, 0, SrcInvert);
- {copy combined image to screen}
- BitBlt(dDstDC, Union.Left, Union.Top, UnionSize.X, UnionSize.Y, WorkDC, 0, 0, SRCCOPY);
- dRect := NewRect;
- DeleteDC(WorkDC);
- DeleteObject(WorkBM);
- end else begin
- {images dont overlap, so we might as well do the draw in two steps}
- ilRestoreOriginal;
- dRect := NewRect;
- ilSaveOriginal;
- ilDragDraw;
- end;
-end;
-
-procedure TOvcDragShow.HideDragImage;
-begin
- ilRestoreOriginal;
-end;
-
-procedure TOvcDragShow.ilDragDraw;
-begin
- BitBlt(dDstDC, dRect.Left, dRect.Top, dSize.X, dSize.Y, dSMemDC, 0, 0, SrcAnd);
- BitBlt(dDstDC, dRect.Left, dRect.Top, dSize.X, dSize.Y, dMemDC, 0, 0, SrcInvert);
-end;
-
-procedure TOvcDragShow.ilRestoreOriginal;
-begin
- if not dHaveOriginal then exit;
- BitBlt(dDstDC, dRect.Left, dRect.Top, dSize.X, dSize.Y, dSaveDC, 0, 0, SrcCopy);
- dHaveOriginal := False;
-end;
-
-procedure TOvcDragShow.ilSaveOriginal;
-begin
- BitBlt(dSaveDC, 0, 0, dSize.X, dSize.Y, dDstDC, dRect.Left, dRect.Top, SrcCopy);
- dHaveOriginal := True;
-end;
-
-procedure TOvcDragShow.ShowDragImage;
-begin
- ilSaveOriginal;
- ilDragDraw;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/87/87238950c5576cb6d1ab8c7d007eb04b249c7d31.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/87/87238950c5576cb6d1ab8c7d007eb04b249c7d31.svn-base
deleted file mode 100644
index c42c0abe..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/87/87238950c5576cb6d1ab8c7d007eb04b249c7d31.svn-base
+++ /dev/null
@@ -1,310 +0,0 @@
-{*********************************************************}
-{* OVCURL.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 ***** *}
-
-(*Changes)
-
- 01/23/02 - Added UnderlineURL property.
-*)
-
-
-{$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 ovcurl;
- {-URL label}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Classes, Controls, Dialogs, ExtCtrls, Graphics, Menus,
- {$IFDEF MSWINDOWS} ShellAPI, {$ELSE} Unix, {$ENDIF}
- StdCtrls, SysUtils, OvcVer;
-
-type
- TOvcURL = class(TCustomLabel)
- protected {private}
- FCaption : string;
- FHighlightColor : TColor;
- FURL : string;
- FUseVisitedColor : Boolean;
- FVisitedColor : TColor;
-
- {internal variables}
- urlTimer : TTimer;
- urlFontColor : TColor;
-
- {property methods}
- function GetAbout : string;
- function GetUnderlineURL: Boolean;
- procedure SetAbout(const Value : string);
- procedure SetCaption(const Value : string);
- procedure SetHighlightColor(const Value : TColor);
- procedure SetUnderlineURL(Value: Boolean);
- procedure SetURL(const Value : string);
- procedure SetVisitedColor(const Value : TColor);
-
- {internal methods}
- procedure TimerEvent(Sender : TObject);
-
- procedure Loaded; override;
-
- protected
- procedure MouseMove(Shift : TShiftState; X, Y : Integer);
- override;
-
- public
- procedure Click;
- override;
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
-
- published
- property About : string
- read GetAbout write SetAbout stored False;
- property Caption : string
- read FCaption write SetCaption;
- property HighlightColor : TColor
- read FHighlightColor write SetHighlightColor
- default clRed;
- property UnderlineURL: Boolean
- read GetUnderlineURL write SetUnderlineURL
- stored False;
- property URL : string
- read FURL write SetURL;
- property UseVisitedColor : Boolean
- read FUseVisitedColor write FUseVisitedColor
- default False;
- property VisitedColor : TColor
- read FVisitedColor write SetVisitedColor
- stored FUseVisitedColor
- default clBlack;
-
- {$IFDEF VERSION4}
- property Anchors;
- property Constraints;
- property DragKind;
- {$ENDIF}
- property Align;
- property Alignment;
- property AutoSize;
- property Color;
- property Cursor default crHandPoint;
- property DragCursor;
- property DragMode;
- property Enabled;
- property FocusControl;
- property Font;
- property ParentColor;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ShowAccelChar;
- property ShowHint;
- property Transparent default False;
- property Layout;
- property Visible;
- property WordWrap;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDrag;
- end;
-
-
-implementation
-
-const
- BadColor = $02000000;
-
-{*** TOvcURL ***}
-procedure TOvcURL.Loaded;
-begin
- inherited Loaded;
-
-// Font.Style := Font.Style + [fsUnderline];
- urlFontColor := BadColor;
-end;
-
-procedure TOvcURL.Click;
-{$IFDEF MSWINDOWS}
-var
- Buf : array[0..1023] of Char;
-begin
- if URL > '' then begin
- StrPLCopy(Buf, URL, SizeOf(Buf)-1);
- if ShellExecute(0, 'open', Buf, '', '', SW_SHOWNORMAL) <= 32 then
- MessageBeep(0);
- end;
-{$ELSE}
-begin
- if URL > '' then begin
- {$IFDEF DARWIN}
- if fpSystem('Open ' + URL) = 127 then
- MessageBeep(0);
- {$ELSE}
- if (GetBrowserPath = '') or
- (fpSystem(GetBrowserPath + ' ' + URL) = 127) then
- MessageBeep(0);
- {$ENDIF}
- end;
-{$ENDIF}
-
- inherited Click;
-
- {change color to visited color if enabled}
- if FUseVisitedColor then
- urlFontColor := FVisitedColor;
-end;
-
-constructor TOvcURL.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
- FHighlightColor := clRed;
- Cursor := crHandPoint;
- Font.Style := Font.Style + [fsUnderline];
-end;
-
-destructor TOvcURL.Destroy;
-begin
- if Assigned(urlTimer) then begin
- urlTimer.Free;
- urlTimer := nil;
- end;
-
- inherited Destroy;
-end;
-
-function TOvcURL.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-
-function TOvcURL.GetUnderlineURL: Boolean;
-begin
- result := fsUnderline in Font.Style;
-end;
-
-procedure TOvcURL.MouseMove(Shift : TShiftState; X, Y : Integer);
-begin
- inherited MouseMove(Shift, X, Y);
-
- if PtInRect(ClientRect, Point(X, Y)) then begin
- if not Assigned(urlTimer) then begin
- {save current font color}
- if urlFontColor = BadColor then
- urlFontColor := Font.Color;
- Font.Color := FHighlightColor;
- urlTimer := TTimer.Create(Self);
- urlTimer.Interval := 100;
- urlTimer.OnTimer := TimerEvent;
- urlTimer.Enabled := True;
- end;
- end;
-end;
-
-procedure TOvcURL.SetAbout(const Value : string);
-begin
-end;
-
-procedure TOvcURL.SetCaption(const Value : string);
-begin
- FCaption := Value;
- if FCaption > '' then
- inherited Caption := FCaption
- else
- inherited Caption := URL;
-end;
-
-procedure TOvcURL.SetHighlightColor(const Value: TColor);
-begin
- if Value = clNone then
- FHighlightColor := Font.Color
- else
- FHighlightColor := Value;
-
- {reset stored color}
- urlFontColor := BadColor;
-end;
-
-{ - added}
-procedure TOvcURL.SetUnderlineURL(Value: Boolean);
-begin
- if Value then
- Font.Style := Font.Style + [fsUnderline]
- else
- Font.Style := Font.Style - [fsUnderline];
-end;
-
-procedure TOvcURL.SetURL(const Value : string);
-begin
- FURL := Value;
- if FCaption = '' then
- inherited Caption := URL;
-end;
-
-procedure TOvcURL.SetVisitedColor(const Value : TColor);
-begin
- if Value = clNone then
- FVisitedColor := Font.Color
- else
- FVisitedColor := Value;
-
- {reset stored color}
- urlFontColor := BadColor;
-end;
-
-procedure TOvcURL.TimerEvent(Sender : TObject);
-var
- Pt : TPoint;
-begin
- GetCursorPos(Pt);
- Pt := ScreentoClient(Pt);
- if not PtInRect(ClientRect, Pt) then begin
- urlTimer.Free;
- urlTimer := nil;
- Font.Color := urlFontColor;
- Repaint;
- end;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/87/87cd33a51b853bc4dea4803fcc1d03bcf48e9237.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/87/87cd33a51b853bc4dea4803fcc1d03bcf48e9237.svn-base
deleted file mode 100644
index b50f83df..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/87/87cd33a51b853bc4dea4803fcc1d03bcf48e9237.svn-base
+++ /dev/null
@@ -1,608 +0,0 @@
-{*********************************************************}
-{* OVCTBCLS.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 ovctbcls;
- {-Table column, column array classes}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, LclType, {$ENDIF}
- SysUtils, Graphics, Classes, Controls, Forms,
- OvcConst, OvcTCmmn, OvcTCell;
-
-type
- TOvcTableColumnClass = class of TOvcTableColumn;
- TOvcTableColumn = class(TPersistent)
- protected {private}
- {property fields-even size}
- FDefCell : TOvcBaseTableCell;
- FNumber : TColNum;
- FOnColumnChanged : TColChangeNotifyEvent;
- FTable : TOvcTableAncestor;
- FWidth : Integer;
- {property fields-odd size}
- FHidden : boolean;
- Filler : byte;
-
- protected
- {property access}
- procedure SetDefCell(BTC : TOvcBaseTableCell);
- procedure SetHidden(H : boolean);
- procedure SetWidth(W : Integer);
-
- {miscellaneous}
- procedure tcDoColumnChanged;
- procedure tcNotifyCellDeletion(Cell : TOvcBaseTableCell);
-
- public {protected}
- {internal only usage}
- property Number : TColNum
- read FNumber write FNumber;
- property OnColumnChanged : TColChangeNotifyEvent
- write FOnColumnChanged;
-
- public
- procedure Assign(Source : TPersistent); override;
- constructor Create(ATable : TOvcTableAncestor); virtual;
- destructor Destroy; override;
-
- {properties}
- property Table : TOvcTableAncestor
- read FTable;
-
- published
- {properties for streaming}
- property DefaultCell: TOvcBaseTableCell
- read FDefCell write SetDefCell;
-
- property Hidden : boolean
- read FHidden write SetHidden;
-
- property Width : Integer
- read FWidth write SetWidth;
- end;
-
- TOvcTableColumns = class(TPersistent)
- protected {private}
- {property fields}
- FList : TList;
- FOnColumnChanged: TColChangeNotifyEvent;
- FFixups : TStringList;
- FTable : TOvcTableAncestor;
-
- {other fields}
- tcColumnClass : TOvcTableColumnClass;
-
- protected
- {property access}
- function GetCol(ColNum : TColNum) : TOvcTableColumn;
- function GetCount : Integer;
- function GetDefaultCell(ColNum : TColNum) : TOvcBaseTableCell;
- function GetHidden(ColNum : TColNum) : boolean;
- function GetWidth(ColNum : TColNum) : Integer;
-
- procedure SetCol(ColNum : TColNum; C : TOvcTableColumn);
- procedure SetCount(C : Integer);
- procedure SetDefaultCell(ColNum : TColNum; C : TOvcBaseTableCell);
- procedure SetHidden(ColNum : TColNum; H : boolean);
- procedure SetWidth(ColNum : TColNum; W : Integer);
-
- {event access}
- procedure SetOnColumnChanged(OC : TColChangeNotifyEvent);
-
- {other}
- procedure tcDoColumnChanged(ColNum1, ColNum2 : TColNum;
- Action : TOvcTblActions);
-
- public
- {internal only usage}
- procedure tcNotifyCellDeletion(Cell : TOvcBaseTableCell);
- function tcStartLoading : TStringList;
- procedure tcStopLoading;
-
- property OnColumnChanged : TColChangeNotifyEvent
- write SetOnColumnChanged;
-
- public
- constructor Create(ATable : TOvcTableAncestor; ANumber : Integer;
- AColumnClass : TOvcTableColumnClass);
- destructor Destroy; override;
-
- procedure Append(C : TOvcTableColumn);
- procedure Clear;
- procedure Delete(ColNum : TColNum);
- procedure Exchange(ColNum1, ColNum2 : TColNum);
- procedure Insert(const ColNum : TColNum; C : TOvcTableColumn);
-
- property Count : Integer
- read GetCount write SetCount;
-
- property DefaultCell [ColNum : TColNum] : TOvcBaseTableCell
- read GetDefaultCell write SetDefaultCell;
-
- property Hidden [ColNum : TColNum] : boolean
- read GetHidden write SetHidden;
-
- property List [ColNum : TColNum] : TOvcTableColumn
- read GetCol write SetCol;
- default;
-
- property Table : TOvcTableAncestor
- read FTable write FTable;
-
- property Width [ColNum : TColNum] : Integer
- read GetWidth write SetWidth;
- end;
-
-implementation
-
-
-{===TOvcTableColumn=====================================================}
-constructor TOvcTableColumn.Create(ATable : TOvcTableAncestor);
- begin
- inherited Create;
- FWidth := tbDefColWidth;
- FDefCell := nil;
- FTable := ATable;
- end;
-{--------}
-destructor TOvcTableColumn.Destroy;
- begin
- DefaultCell := nil;
- inherited Destroy;
- end;
-{--------}
-procedure TOvcTableColumn.Assign(Source : TPersistent);
- var
- Src : TOvcTableColumn absolute Source;
- begin
- if not (Source is TOvcTableColumn) then
- Exit;
- FWidth := Src.Width;
- FHidden := Src.Hidden;
- DefaultCell := Src.DefaultCell;
- end;
-{--------}
-procedure TOvcTableColumn.tcDoColumnChanged;
- begin
- if Assigned(FOnColumnChanged) then
- FOnColumnChanged(Self, FNumber, 0, taSingle);
- end;
-{--------}
-procedure TOvcTableColumn.tcNotifyCellDeletion(Cell : TOvcBaseTableCell);
- begin
- if (Cell = FDefCell) then
- DefaultCell := nil;
- end;
-{--------}
-procedure TOvcTableColumn.SetDefCell(BTC : TOvcBaseTableCell);
- var
- DoIt : boolean;
- begin
- DoIt := false;
- if (BTC <> FDefCell) then
- if Assigned(BTC) then
- begin
- if (BTC.References = 0) or
- ((BTC.References > 0) and (BTC.Table = FTable)) then
- DoIt := true;
- end
- else
- DoIt := true;
-
- if DoIt then
- begin
- if Assigned(FDefCell) then
- FDefCell.DecRefs;
- FDefCell := BTC;
- if Assigned(FDefCell) then
- begin
- if (FDefCell.References = 0) then
- FDefCell.Table := FTable;
- FDefCell.IncRefs;
- end;
- tcDoColumnChanged;
- end;
- end;
-{--------}
-procedure TOvcTableColumn.SetHidden(H : boolean);
- begin
- if (H <> FHidden) then
- begin
- FHidden := H;
- tcDoColumnChanged;
- end;
- end;
-{--------}
-procedure TOvcTableColumn.SetWidth(W : Integer);
- begin
- if (W <> FWidth) then
- begin
- FWidth := W;
- tcDoColumnChanged;
- end;
- end;
-{====================================================================}
-
-
-
-{===TOvcTableColumns=======================================================}
-constructor TOvcTableColumns.Create(ATable : TOvcTableAncestor;
- ANumber : Integer;
- AColumnClass : TOvcTableColumnClass);
- var
- i : Integer;
- Col : TOvcTableColumn;
- begin
- inherited Create;
- FTable := ATable;
- FList := TList.Create;
- tcColumnClass := AColumnClass;
- for i := 0 to pred(ANumber) do
- begin
- Col := AColumnClass.Create(FTable);
- Col.Number := i;
- Append(Col);
- end;
- end;
-{--------}
-destructor TOvcTableColumns.Destroy;
- begin
- if Assigned(FList) then
- begin
- OnColumnChanged := nil;
- Clear;
- FList.Free;
- end;
- FFixups.Free;
- end;
-{--------}
-procedure TOvcTableColumns.Append(C : TOvcTableColumn);
- begin
- if (FList.Count = Classes.MaxListSize) then
- TableErrorRes(SCTableMaxColumns);
- if (C.Table <> FTable) or (not (C is tcColumnClass)) then
- Exit;
- C.Number := FList.Count;
- FList.Add(C);
- C.OnColumnChanged := FOnColumnChanged;
- tcDoColumnChanged(C.Number, 0, taInsert);
- end;
-{--------}
-procedure TOvcTableColumns.Clear;
- var
- i : Integer;
- begin
- for i := 0 to pred(FList.Count) do
- TOvcTableColumn(FList[i]).Free;
- FList.Clear;
- tcDoColumnChanged(0, 0, taAll);
- end;
-{--------}
-procedure TOvcTableColumns.Delete(ColNum : TColNum);
- var
- i : integer;
- begin
- if (0 <= ColNum) and (ColNum < FList.Count) then
- begin
- TOvcTableColumn(FList[ColNum]).Free;
- FList.Delete(ColNum);
- for i := 0 to pred(FList.Count) do
- TOvcTableColumn(FList[i]).Number := i;
- tcDoColumnChanged(ColNum, 0, taDelete);
- if Assigned(FFixups) then
- if (ColNum < FFixups.Count) then
- FFixups.Delete(ColNum);
- end;
- end;
-{--------}
-procedure TOvcTableColumns.Exchange(ColNum1, ColNum2 : TColNum);
- var
- Temp1, Temp2 : pointer;
- begin
- if (ColNum1 <> ColNum2) and
- (0 <= ColNum1) and (ColNum1 < FList.Count) and
- (0 <= ColNum2) and (ColNum2 < FList.Count) then
- begin
- Temp1 := FList[ColNum1];
- Temp2 := FList[ColNum2];
- TOvcTableColumn(Temp1).Number := ColNum2;
- TOvcTableColumn(Temp2).Number := ColNum1;
- FList[ColNum1] := Temp2;
- FList[ColNum2] := Temp1;
- tcDoColumnChanged(ColNum1, ColNum2, taExchange);
- end;
- end;
-{--------}
-function TOvcTableColumns.GetCol(ColNum : TColNum) : TOvcTableColumn;
- begin
- if (0 <= ColNum) and (ColNum < FList.Count) then
- Result := TOvcTableColumn(FList[ColNum])
- else
- Result := nil;
- end;
-{--------}
-function TOvcTableColumns.GetCount : Integer;
- begin
- Result := FList.Count;
- end;
-{--------}
-function TOvcTableColumns.GetDefaultCell(ColNum : TColNum) : TOvcBaseTableCell;
- begin
- Result := nil;
- if (0 <= ColNum) and (ColNum < FList.Count) then
- Result := TOvcTableColumn(FList[ColNum]).DefaultCell;
- end;
-{--------}
-function TOvcTableColumns.GetHidden(ColNum : TColNum) : boolean;
- begin
- Result := True;
- if (0 <= ColNum) and (ColNum < FList.Count) then
- Result := TOvcTableColumn(FList[ColNum]).Hidden;
- end;
-{--------}
-function TOvcTableColumns.GetWidth(ColNum : TColNum) : Integer;
- begin
- Result := 0;
- if (0 <= ColNum) and (ColNum < FList.Count) then
- Result := TOvcTableColumn(FList[ColNum]).Width;
- end;
-{--------}
-procedure TOvcTableColumns.Insert(const ColNum : TColNum;
- C : TOvcTableColumn);
- var
- i : integer;
- begin
- if (FList.Count = Classes.MaxListSize) then
- TableErrorRes(SCTableMaxColumns);
- if (C.Table <> FTable) or (not (C is tcColumnClass)) then
- Exit;
- if (0 <= ColNum) and (ColNum < FList.Count) then
- begin
- FList.Insert(ColNum, C);
- for i := 0 to pred(FList.Count) do
- TOvcTableColumn(FList[i]).Number := i;
- C.OnColumnChanged := FOnColumnChanged;
- tcDoColumnChanged(ColNum, 0, taInsert);
- if Assigned(FFixups) then begin
- FFixups.Insert(ColNum, 'unknown');
- FFixups.Objects[ColNum] := C;
- end;
- end;
- end;
-{--------}
-procedure TOvcTableColumns.tcDoColumnChanged(ColNum1, ColNum2 : TColNum;
- Action : TOvcTblActions);
- begin
- if Assigned(FOnColumnChanged) then
- FOnColumnChanged(Self, ColNum1, ColNum2, Action);
- end;
-{--------}
-procedure TOvcTableColumns.tcNotifyCellDeletion(Cell : TOvcBaseTableCell);
- var
- ColNum : TColNum;
- begin
- for ColNum := 0 to pred(FList.Count) do
- TOvcTableColumn(FList[ColNum]).tcNotifyCellDeletion(Cell);
- end;
-{--------}
-procedure TOvcTableColumns.SetCol(ColNum : TColNum; C : TOvcTableColumn);
- var
- PC : TOvcTableColumn;
- begin
- if (C.Table <> FTable) or (not (C is tcColumnClass)) then
- Exit;
- if (0 <= ColNum) and (ColNum < FList.Count) then
- begin
- PC := GetCol(ColNum);
- PC.Assign(C);
- end;
- end;
-{--------}
-procedure TOvcTableColumns.SetCount(C : Integer);
- var
- ColNum : TColNum;
- Col : TOvcTableColumn;
- begin
- if (C > 0) and (C <> Count) then
- if (C < Count) then
- begin
- {must destroy the end set of columns}
- for ColNum := pred(Count) downto C do
- Delete(ColNum);
- end
- else {C > Count}
- begin
- {must add some new columns on the end}
- for ColNum := Count to pred(C) do
- begin
- Col := tcColumnClass.Create(FTable);
- Col.Number := ColNum;
- Append(Col);
- end;
- end;
- end;
-{--------}
-procedure TOvcTableColumns.SetDefaultCell(ColNum : TColNum; C : TOvcBaseTableCell);
- begin
- if (0 <= ColNum) and (ColNum < FList.Count) then
- TOvcTableColumn(FList[ColNum]).DefaultCell := C;
- end;
-{--------}
-procedure TOvcTableColumns.SetHidden(ColNum : TColNum; H : boolean);
- begin
- if (0 <= ColNum) and (ColNum < FList.Count) then
- TOvcTableColumn(FList[ColNum]).Hidden := H;
- end;
-{--------}
-procedure TOvcTableColumns.SetOnColumnChanged(OC : TColChangeNotifyEvent);
- var
- i : Integer;
- begin
- FOnColumnChanged := OC;
- for i := 0 to pred(FList.Count) do
- TOvcTableColumn(FList[i]).OnColumnChanged := OC;
- end;
-{--------}
-procedure TOvcTableColumns.SetWidth(ColNum : TColNum; W : Integer);
- begin
- if (0 <= ColNum) and (ColNum < FList.Count) then
- TOvcTableColumn(FList[ColNum]).Width := W;
- end;
-{--------}
-function TOvcTableColumns.tcStartLoading : TStringList;
- begin
- if Assigned(FFixups) then
- FFixups.Clear
- else
- FFixups := TStringList.Create;
- Result := FFixups;
- end;
-{--------}
-procedure TOvcTableColumns.tcStopLoading;
- {------}
- function GetImmediateParentForm(Control : TControl) : TWinControl;
- var
- ParentCtrl : TControl;
- begin
- ParentCtrl := Control.Parent;
- while (Assigned(ParentCtrl)) and
- (not (ParentCtrl is TCustomForm))
- {$IFDEF VERSION5}
- and (not (ParentCtrl is TCustomFrame))
- {$ENDIF}
- do
- ParentCtrl := ParentCtrl.Parent;
- Result := TForm(ParentCtrl);
- end;
- {------}
- function GetFormName(const S, FormName : string) : string;
- var
- PosDot : integer;
- begin
- PosDot := Pos('.', S);
- if (PosDot <> 0) then
- Result := Copy(S, 1, pred(PosDot))
- else
- Result := FormName;
- end;
- {------}
- function FormNamesEqual(const CmptFormName, FormName : string) : boolean;
- var
- PosUL : integer;
- begin
- Result := true;
- if (FormName = '') or (CmptFormName = FormName) then
- Exit;
- PosUL := length(FormName);
- while (PosUL > 0) and (FormName[PosUL] <> '_') do
- dec(PosUL);
- if (PosUL > 0) then
- if (CmptFormName = Copy(FormName, 1, pred(PosUL))) then
- Exit;
- Result := false;
- end;
- {------}
- function GetComponentName(const S : string) : string;
- var
- PosDot : integer;
- begin
- PosDot := Pos('.', S);
- if (PosDot <> 0) then
- Result := Copy(S, succ(PosDot), length(S))
- else
- Result := S;
- end;
- {------}
- var
- i : integer;
- Form : TWinControl;
- Compnt : TComponent;
- DM : integer;
- DataMod: TDataModule;
- DMCount: integer;
- begin
- {if there's nothing to fix up, exit now}
- if not Assigned(FFixups) then
- Exit;
- {fixup references to cell components on the table's form}
- try
- Form := GetImmediateParentForm(FTable);
- for i := pred(FFixups.Count) downto 0 do
- if FormNamesEqual(GetFormName(FFixups[i], Form.Name),
- Form.Name) then
- begin
- Compnt := Form.FindComponent(GetComponentName(FFixups[i]));
- if Assigned(Compnt) and (Compnt is TOvcBaseTableCell) then
- begin
- TOvcTableColumn(FFixups.Objects[i]).DefaultCell := TOvcBaseTableCell(Compnt);
- FFixups.Delete(i);
- end;
- end;
- {fixup references to cell components on any data modules}
- if (FFixups.Count <> 0) then begin
- DM := 0;
-//{$IFNDEF LCL}
- DMCount := Screen.DataModuleCount;
-//{$ELSE}
-// DMCount := 0;
-//{$ENDIF}
- while (FFixups.Count > 0) and (DM < DMCount) do begin
-//{$IFNDEF LCL}
- DataMod := Screen.DataModules[DM];
-//{$ENDIF}
- for i := pred(FFixups.Count) downto 0 do
- if (GetFormName(FFixups[i], Form.Name) = DataMod.Name) then begin
- Compnt := DataMod.FindComponent(GetComponentName(FFixups[i]));
- if Assigned(Compnt) and (Compnt is TOvcBaseTableCell) then begin
- TOvcTableColumn(FFixups.Objects[i]).DefaultCell
- := TOvcBaseTableCell(Compnt);
- FFixups.Delete(i);
- end;
- end;
- inc(DM);
- end;
- end;
- finally
- FFixups.Free;
- FFixups := nil;
- end;
- end;
-{====================================================================}
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/87/87d62248bb85c2831675d1c1f9af07ba2b32452b.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/87/87d62248bb85c2831675d1c1f9af07ba2b32452b.svn-base
deleted file mode 100644
index a964abf6..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/87/87d62248bb85c2831675d1c1f9af07ba2b32452b.svn-base
+++ /dev/null
@@ -1,136 +0,0 @@
-[FileVersion]
-Version=7.0
-[Compiler]
-A=8
-B=0
-C=1
-D=1
-E=0
-F=0
-G=1
-H=1
-I=1
-J=0
-K=0
-L=1
-M=0
-N=1
-O=1
-P=1
-Q=1
-R=1
-S=0
-T=1
-U=0
-V=1
-W=0
-X=1
-Y=1
-Z=1
-ShowHints=1
-ShowWarnings=1
-UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-NamespacePrefix=
-SymbolDeprecated=1
-SymbolLibrary=1
-SymbolPlatform=1
-UnitLibrary=1
-UnitPlatform=1
-UnitDeprecated=1
-HResultCompat=1
-HidingMember=1
-HiddenVirtual=1
-Garbage=1
-BoundsError=1
-ZeroNilCompat=1
-StringConstTruncated=1
-ForLoopVarVarPar=1
-TypedConstVarPar=1
-AsgToTypedConst=1
-CaseLabelRange=1
-ForVariable=1
-ConstructingAbstract=1
-ComparisonFalse=1
-ComparisonTrue=1
-ComparingSignedUnsigned=1
-CombiningSignedUnsigned=1
-UnsupportedConstruct=1
-FileOpen=1
-FileOpenUnitSrc=1
-BadGlobalSymbol=1
-DuplicateConstructorDestructor=1
-InvalidDirective=1
-PackageNoLink=1
-PackageThreadVar=1
-ImplicitImport=1
-HPPEMITIgnored=1
-NoRetVal=1
-UseBeforeDef=1
-ForLoopVarUndef=1
-UnitNameMismatch=1
-NoCFGFileFound=1
-MessageDirective=1
-ImplicitVariants=1
-UnicodeToLocale=1
-LocaleToUnicode=1
-ImagebaseMultiple=1
-SuspiciousTypecast=1
-PrivatePropAccessor=1
-UnsafeType=0
-UnsafeCode=0
-UnsafeCast=0
-[Linker]
-MapFile=0
-OutputObjs=0
-ConsoleApp=1
-DebugInfo=0
-RemoteSymbols=0
-MinStackSize=16384
-MaxStackSize=1048576
-ImageBase=4194304
-ExeDescription=
-[Directories]
-OutputDir=
-UnitOutputDir=
-PackageDLLOutputDir=
-PackageDCPOutputDir=
-SearchPath=
-Packages=vcl;rtl;vclx;indy;vclie;xmlrtl;inetdbbde;inet;inetdbxpress;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;inetdb;bdertl;vcldbx;adortl;teeui;teedb;tee;ibxpress;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k
-Conditionals=
-DebugSourceDirs=
-UsePackages=0
-[Parameters]
-RunParams=
-HostApplication=
-Launcher=
-UseLauncher=0
-DebugCWD=
-[Language]
-ActiveLang=
-ProjectLang=
-RootDir=
-[Version Info]
-IncludeVerInfo=0
-AutoIncBuild=0
-MajorVer=1
-MinorVer=0
-Release=0
-Build=0
-Debug=0
-PreRelease=0
-Special=0
-Private=0
-DLL=0
-Locale=1033
-CodePage=1252
-[Version Info Keys]
-CompanyName=
-FileDescription=
-FileVersion=1.0.0.0
-InternalName=
-LegalCopyright=
-LegalTrademarks=
-OriginalFilename=
-ProductName=
-ProductVersion=1.0.0.0
-Comments=
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/8b/8b96687e925a49d69202580e57e39aeebcc0246f.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/8b/8b96687e925a49d69202580e57e39aeebcc0246f.svn-base
deleted file mode 100644
index 6c365f16..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/8b/8b96687e925a49d69202580e57e39aeebcc0246f.svn-base
+++ /dev/null
@@ -1,624 +0,0 @@
-{*********************************************************}
-{* OVCDATA.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 ovcdata;
- {-Miscellaneous type and constant declarations}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Controls, Forms, Graphics, StdCtrls, SysUtils, OvcConst, OvcDate, O32SR;
-
-const
- BorderStyles : array[TBorderStyle] of LongInt =
- (0, WS_BORDER);
- ScrollBarStyles : array [TScrollStyle] of LongInt =
- (0, WS_HSCROLL, WS_VSCROLL, WS_HSCROLL or WS_VSCROLL
-{$IFDEF LCL}
- ,WS_HSCROLL, WS_VSCROLL, WS_HSCROLL or WS_VSCROLL
-{$ENDIF}
- );
-
-{$IFNDEF VERSION4}
-type
- PDateTime = ^TDateTime;
-{$ENDIF}
-
-{some colors that are not defined by Delphi}
-const
- clCream = TColor($A6CAF0);
- clMoneyGreen = TColor($C0DCC0);
- clSkyBlue = TColor($FFFBF0);
-
-type
- TCharSet = set of AnsiChar; {a Pascal set of characters}
-
-type
- PPointer = ^Pointer;
-
-type
- {secondary field options--internal}
- TsefOption = (
- sefValPending, {field needs validation}
- sefInvalid, {field is invalid}
- sefNoHighlight, {Don't highlight field initially}
- sefIgnoreFocus, {We're ignoring the focus}
- sefValidating, {We're validating a field}
- sefModified, {Field recently modified}
- sefEverModified, {Field has been modified after last data transfer}
- sefFixSemiLits, {Semi-literals were stripped}
- sefHexadecimal, {Field's value is shown in hex}
- sefOctal, {Field's value is shown in octal}
- sefBinary, {Field's value is shown in binary}
- sefNumeric, {Edit from right to left--for numbers only}
- sefRealVar, {Field is of a real/8087 type}
- sefNoLiterals, {Picture mask has no literals}
- sefHaveFocus, {Control has the focus}
- sefRetainPos, {Retain caret position}
- sefErrorPending, {Error pending?}
- sefInsert, {Insert mode on}
- sefLiteral, {Next char is literal}
- sefAcceptChar, {Accept next character}
- sefCharOK, {OK to add a character}
- sefUpdating, {field is being updated}
- sefGettingValue, {field contents are being retrieved}
- sefUserValidating, {user validation in progress}
- sefNoUserValidate); {don't perform user validation}
-
- {Set of current secondary options for entry fields}
- TsefOptionSet = set of TsefOption;
-
-const
- {default secondary field options}
- sefDefOptions : TsefOptionSet = [sefCharOK, sefInsert];
-
-const
- DefPadChar = ' '; {Default character used to pad the end of a display string}
- MaxEditLen = 255; {Maximum length of edit string}
- MaxPicture = 255; {Maximum length of a picture mask}
-
-{*** Picture masks ***}
-const
- {the following characters are meaningful in Picture masks}
- pmAnyChar = 'X'; {allows any character}
- pmForceUpper = '!'; {allows any character, forces upper case}
- pmForceLower = 'L'; {allows any character, forces lower case}
- pmForceMixed = 'x'; {allows any character, forces mixed case}
- pmAlpha = 'a'; {allows alphas only}
- pmUpperAlpha = 'A'; {allows alphas only, forces upper case}
- pmLowerAlpha = 'l'; {allows alphas only, forces lower case}
- pmPositive = '9'; {allows numbers and spaces only}
- pmWhole = 'i'; {allows numbers, spaces, minus}
- pmDecimal = '#'; {allows numbers, spaces, minus, period}
- pmScientific = 'E'; {allows numbers, spaces, minus, period, 'e'}
- pmHexadecimal = 'K'; {allows 0-9, A-F, and space forces upper case}
- pmOctal = 'O'; {allows 0-7, space}
- pmBinary = 'b'; {allows 0-1, space}
- pmTrueFalse = 'B'; {allows T, t, F, f}
- pmYesNo = 'Y'; {allows Y, y, N, n}
-
- pmUser1 = '1'; {User-defined picture mask characters}
- pmUser2 = '2';
- pmUser3 = '3';
- pmUser4 = '4';
- pmUser5 = '5';
- pmUser6 = '6';
- pmUser7 = '7';
- pmUser8 = '8';
-
- Subst1 = #241; {User-defined substitution characters}
- Subst2 = #242;
- Subst3 = #243;
- Subst4 = #244;
- Subst5 = #245;
- Subst6 = #246;
- Subst7 = #247;
- Subst8 = #248;
-
-const
- {Other special characters allowed in Picture strings}
- pmDecimalPt = '.'; {insert decimal point}
- pmComma = ','; {character used to separate numbers}
- pmFloatDollar = '$'; {floating dollar sign}
- pmCurrencyLt = 'c'; {currency to left of the amount}
- pmCurrencyRt = 'C'; {currency to right of the amount}
- pmNegParens = 'p'; {indicates () should be used for negative #'s}
- pmNegHere = 'g'; {placeholder for minus sign}
- {NOTE: Comma and FloatDollar are allowed only in fields containing fixed
- decimal points and/or numeric fields. NegParens and NegHere should be used
- only in numeric fields.}
-
-const
- {the following characters are meaningful in date Picture masks}
- pmMonth = 'm'; {formatting character for a date string picture mask}
- pmMonthU = 'M'; {formatting character for a date string picture mask.
- Uppercase means pad with ' ' rather than '0'}
- pmDay = 'd'; {formatting character for a date string picture mask}
- pmDayU = 'D'; {formatting character for a date string picture mask.
- Uppercase means pad with ' ' rather then '0'}
- pmYear = 'y'; {formatting character for a date string picture mask}
- pmDateSlash = '/'; {formatting character for a date string picture mask}
-
- {'n'/'N' may be used in place of 'm'/'M' when the name of the month is
- desired instead of its number. E.g., 'dd/nnn/yyyy' -\> '01-Jan-1980'.
- 'dd/NNN/yyyy' -\> '01-JAN-1980' (if SlashChar = '-'). The abbreviation used
- is based on the width of the subfield (3 in the example) and the current
- contents of the MonthString array.}
- pmMonthName = 'n'; {formatting character for a date string picture mask}
- pmMonthNameU = 'N'; {formatting character for a date string picture mask.
- Uppercase causes the output to be in uppercase}
-
- {'w'/'W' may be used to include the day of the week in a date string. E.g.,
- 'www dd nnn yyyy' -\> 'Mon 01 Jan 1989'. The abbreviation used is based on
- the width of the subfield (3 in the example) and the current contents of the
- DayString array. Note that entry field will not allow the user to enter
- text into a subfield containing 'w' or 'W'. The day of the week will be
- supplied automatically when a valid date is entered.}
- pmWeekDay = 'w'; {formatting character for a date string picture mask}
- pmWeekDayU = 'W'; {formatting character for a date string picture mask.
- Uppercase causes the output to be in uppercase}
-
- pmLongDateSub1 = 'f'; {mask character used with Window's long date format}
- pmLongDateSub2 = 'g'; {mask character used with Window's long date format}
- pmLongDateSub3 = 'h'; {mask character used with Window's long date format}
-
-const
- {if uppercase letters are used, numbers are padded with ' ' rather than '0'}
- pmHour = 'h'; {formatting character for a time string picture mask}
- pmHourU = 'H'; {formatting character for a time string picture mask}
- pmMinute = 'm'; {formatting character for a time string picture mask}
- pmMinuteU = 'M'; {formatting character for a time string picture mask}
- pmSecond = 's'; {formatting character for a time string picture mask}
- pmSecondU = 'S'; {formatting character for a time string picture mask}
- {'hh:mm:ss tt' -\> '12:00:00 pm', 'hh:mmt' -\> '12:00p'}
- pmAmPm = 't'; {formatting character for a time string picture mask.
- This generates 'AM' or 'PM'}
- pmTimeColon = ':'; {formatting character for a time string picture mask}
-
-const
- PictureChars : TCharSet = [
- pmAnyChar, pmForceUpper, pmForceLower, pmForceMixed,
- pmAlpha, pmUpperAlpha, pmLowerAlpha,
- pmPositive, pmWhole, pmDecimal, pmScientific,
- pmHexadecimal, pmOctal, pmBinary,
- pmTrueFalse, pmYesNo,
- pmMonthName, pmMonthNameU, pmMonth,
- pmMonthU, pmDay, pmDayU, pmYear, pmHour, pmHourU, {$IFNDEF FPC} pmMinute,
- pmMinuteU, {$ENDIF} pmSecond, pmSecondU, pmAmPm, pmUser1..pmUser8];
-
-const
- {set of allowable picture characters for simple fields}
- SimplePictureChars : TCharSet = [
- pmAnyChar, pmForceUpper, pmForceLower, pmForceMixed,
- pmAlpha, pmUpperAlpha, pmLowerAlpha,
- pmPositive, pmWhole, pmDecimal, pmScientific,
- pmHexadecimal, pmOctal, pmBinary,
- pmTrueFalse, pmYesNo,
- pmUser1..pmUser8];
-
-type
- {types of case change operations associated with a picture mask character}
- TCaseChange = (mcNoChange, mcUpperCase, mcLowerCase, mcMixedCase);
-
-type
- TUserSetRange = pmUser1..pmUser8;
- TForceCaseRange = pmUser1..pmUser8;
- TSubstCharRange = Subst1..Subst8;
-
- TUserCharSets = array[TUserSetRange] of TCharSet;
- TForceCase = array[TForceCaseRange] of TCaseChange;
- TSubstChars = array[TSubstCharRange] of AnsiChar;
-
-const
- MaxDateLen = 40; {maximum length of date picture strings}
- MaxMonthName = 15; {maximum length for month names}
- MaxDayName = 15; {maximum length for day names}
-
-const
- otf_SizeData = 0; {These three constants are used in data transfers to}
- otf_GetData = 1; {specify the type of transfer operation being requested}
- otf_SetData = 2;
-
-type
- TEditString = array[0..MaxEditLen] of AnsiChar;
- TPictureMask = array[0..MaxPicture] of AnsiChar;
-
- {An array of flags that indicate the type of mask character at a given
- location in a picture mask}
- TPictureFlags = array[0..MaxEditLen+1] of Byte;
-
- {Each entry field maintains two data structures of this type, one to store
- the lower limit of a field's value, and another to store the upper limit}
- PRangeType = ^TRangeType;
- TRangeType = packed record
- case Byte of {size}
- 00 : (rtChar : AnsiChar); {01}
- 01 : (rtByte : Byte); {01}
- 02 : (rtSht : ShortInt); {01}
- 03 : (rtInt : SmallInt); {02}
- 04 : (rtWord : Word); {02}
- 05 : (rtLong : LongInt); {04}
- 06 : (rtSgl : Single); {04}
- 07 : (rtPtr : Pointer); {04}
- {$IFDEF CBuilder}
- 08 : (rtReal : Double); {06}
- {$ELSE}
- 08 : (rtReal : Real); {06}
- {$ENDIF CBuilder}
- 09 : (rtDbl : Double); {08}
- {$IFDEF CBuilder}
- 10 : (rtComp : Double); {08}
- {$ELSE}
- {$IFNDEF FPC} {Delphi}
- 10 : (rtComp : Comp); {08}
- {$ELSE} {FPC}
- {$IFDEF CPU86}
- 10 : (rtComp : Comp); {08}
- {$ELSE} {Comp is true integer with non-Intel}
- 10 : (rtComp : Double); {08}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF CBuilder}
- 11 : (rtExt : Extended); {10}
- 12 : (rtDate : LongInt); {04}
- 13 : (rtTime : LongInt); {04}
- 14 : (rt10 : array[1..10] of Byte); {10} {forces structure to size of 10 bytes}
- end;
-
-const
- BlankRange : TRangeType = (rt10 : (0, 0, 0, 0, 0, 0, 0, 0, 0, 0));
-
-{*** Date/Time declarations ***}
-type
- TOvcDate = TStDate;
- TOvcTime = TStTime;
- TDayType = TStDayType;
-
-type
- {states for data aware entry fields}
- TDbEntryFieldStates = (esFocused, esSelected, esReset);
- TDbEntryFieldState = set of TDbEntryFieldStates;
-
-type
- {Search option flags for editor and viewer}
- TSearchOptions = (
- soFind, {find (this option is assumed) }
- soBackward, {search backwards }
- soMatchCase, {don't ignore case when searching }
- soGlobal, {search globally }
- soReplace, {find and replace (editor only)}
- soReplaceAll, {find and replace all (editor only)}
- soWholeWord, {match on whole word only (editor only)}
- soSelText); {search in selected text (editor only)}
- TSearchOptionSet = set of TSearchOptions;
-
-const
- {maximum length of a search/replacement string}
- MaxSearchString = 255;
-
-type
- {types of tabs supported in the editor}
- TTabType = (ttReal, ttFixed, ttSmart);
-
- {entry field flag for display of number field with zero value}
- TZeroDisplay = (zdShow, zdHide, zdHideUntilModified);
-
-type
- {structrue of the commands stored in the command table}
- POvcCmdRec = ^TOvcCmdRec;
- TOvcCmdRec = packed record
- case Byte of
- 0 : (Key1 : Byte; {first keys' virtual key code}
- SS1 : Byte; {shift state of first key}
- Key2 : Byte; {second keys' virtual key code, if any}
- SS2 : Byte; {shift state of second key}
- Cmd : Word); {command to return for this entry}
- 1 : (Keys : LongInt); {used for sorting, searching, and storing}
- end;
-
-const
- {shift state flags for command processors}
- ss_None = $00; {no shift key is pressed}
- ss_Shift = $02; {the shift key is pressed}
- ss_Ctrl = $04; {the control key is pressed}
- ss_Alt = $08; {the alt key is pressed}
- ss_Wordstar = $80; {2nd key of a twokey wordstar command: ss_Ctrl or ss_None}
- {the second key of a two-key wordstar command is accepted if}
- {pressed by itself of with the ctrl key. case is ignored}
-
-const
- {virtual key constants not already defined}
- VK_NONE = 0;
- VK_ALT = VK_MENU;
- VK_A = Ord('A'); VK_B = Ord('B'); VK_C = Ord('C'); VK_D = Ord('D');
- VK_E = Ord('E'); VK_F = Ord('F'); VK_G = Ord('G'); VK_H = Ord('H');
- VK_I = Ord('I'); VK_J = Ord('J'); VK_K = Ord('K'); VK_L = Ord('L');
- VK_M = Ord('M'); VK_N = Ord('N'); VK_O = Ord('O'); VK_P = Ord('P');
- VK_Q = Ord('Q'); VK_R = Ord('R'); VK_S = Ord('S'); VK_T = Ord('T');
- VK_U = Ord('U'); VK_V = Ord('V'); VK_W = Ord('W'); VK_X = Ord('X');
- VK_Y = Ord('Y'); VK_Z = Ord('Z'); VK_0 = Ord('0'); VK_1 = Ord('1');
- VK_2 = Ord('2'); VK_3 = Ord('3'); VK_4 = Ord('4'); VK_5 = Ord('5');
- VK_6 = Ord('6'); VK_7 = Ord('7'); VK_8 = Ord('8'); VK_9 = Ord('9');
-
-var
- AlphaCharSet : TCharSet;
-
-const
- IntegerCharSet: TCharSet = ['0'..'9', ' '];
- RealCharSet : TCharSet = ['0'..'9', ' ', '-', '.'];
-
-const
- {Picture flag values for elements in a TPictureFlags array}
- pflagLiteral = 0; {Corresponding char in the mask is a literal}
- pflagFormat = 1; {Corresponding char in the mask is a formatting character}
- pflagSemiLit = 2; {Corresponding char in the mask is a semi-literal character}
-
-const
- {------------------- Windows messages -----------------------}
- {Not a message code. Value of the first of the message codes used}
- OM_FIRST = $7F00; {***}
-
- {entry field error}
- OM_REPORTERROR = OM_FIRST + 0;
- {messages for/from viewer/editor controls}
- OM_SETFOCUS = OM_FIRST + 1;
- {sent by an entry field to the controller to request return of the
- focus. lParam is pointer of the object to return the focus to}
- OM_SHOWSTATUS = OM_FIRST + 2;
- {sent by a viewer or editor control to itself when the caret moves, or
- when text is inserted or deleted. wParam is the current column (an
- effective column number), and lParam is the current line}
- OM_GETDATASIZE = OM_FIRST + 3;
- {sent to an entry field to obtain its data size}
- OM_RECREATEWND = OM_FIRST + 5;
- {sent to force a call to RecreateWnd}
- OM_PREEDIT = OM_FIRST + 6;
- {sent to preform pre-edit notification for entry fields}
- OM_POSTEDIT = OM_FIRST + 7;
- {sent to preform post-edit notification for entry fields}
- OM_AFTERENTER = OM_FIRST + 8;
- {sent to preform after-enter notification}
- OM_AFTEREXIT = OM_FIRST + 9;
- {sent to preform after-exit notification}
- OM_DELAYNOTIFY = OM_FIRST + 10;
- {sent to preform delayed notification}
- OM_POSITIONLABEL = OM_FIRST + 11;
- {sent to cause the label to be repositioned}
- OM_RECORDLABELPOSITION = OM_FIRST + 12;
- {sent to cause the current position of the label to be recorded}
- OM_ASSIGNLABEL = OM_FIRST + 13;
- {sent to assign a albel to a control}
- OM_FONTUPDATEPREVIEW = OM_FIRST + 14;
- {sent to postpone the font change of the preview control}
- OM_DESTROYHOOK = OM_FIRST + 15;
- {send to cause the window hook to be destroyed}
- OM_PROPCHANGE = OM_FIRST + 16;
- {sent by a collection to its property editor when a property is changed}
- OM_ISATTACHED = OM_FIRST + 17;
- {sent to other controls to see if they are attached. Used by attached
- button components and components that use an internal validator.
- Result is LongInt(Self) if true}
- OM_VALIDATE = OM_FIRST + 18;
- {Sent to the FlexEdit as a call for it to Validate Itself}
-
-{message crackers for the above Orpheus messages}
-
-type
- TOMReportError = packed record
- Msg : Cardinal;
- Error : Word;
- Unused : Word;
- lParam : LongInt;
- Result : LongInt;
- end;
-
- TOMSetFocus = packed record
- Msg : Cardinal;
- wParam : Integer;
- Control: TWinControl;
- Result : LongInt;
- end;
-
- TOMShowStatus = packed record
- Msg : Cardinal;
- Column : Integer;
- Line : LongInt;
- Result : LongInt;
- end;
-
-
-type
- TShowStatusEvent =
- procedure(Sender : TObject; LineNum : LongInt; ColNum : Integer)
- of object;
- {-event to notify of a viewer or editor caret position change}
-
- TTopLineChangedEvent =
- procedure(Sender : TObject; Line : LongInt)
- of object;
- {-event to notify when the top line changes for the editor or viewer}
-
-const
- {*** Error message codes ***}
- oeFirst = 256;
-
- oeRangeError = oeFirst + 0;
- {This error occurs when a user enters a value that is not within the
- accepted range of values for the field}
- oeInvalidNumber = oeFirst + 1;
- {This error is reported if the user enters a string that does not represent
- a number in a field that should contain a numeric value}
- oeRequiredField = oeFirst + 2;
- {This error occurs when the user leaves blank a field that is marked as
- required}
- oeInvalidDate = oeFirst + 3;
- {This error occurs when the user enters a value in a date field that does
- not represent a valid date}
- oeInvalidTime = oeFirst + 4;
- {This error occurs when the user enters a value in a time field that does
- not represent a valid time of day}
- oeBlanksInField = oeFirst + 5;
- {This error is reported only by the validation helper routines
- ValidateNoBlanks and ValidateSubfields. It indicates that a blank was left
- in a field or subfield in which no blanks are allowed}
- oePartialEntry = oeFirst + 6;
- {This error is reported only by the validation helper routines
- ValidateNotPartial and ValidateSubfields in OODEWCC. It indicates that a
- partial entry was given in a field or subfield in which the field/subfield
- must be either entirely empty or entirely full}
- oeOutOfMemory = oeFirst + 7;
- {This error is reported by a viewer or editor control when there is
- insufficient memory to perform the requested operation. A viewer control
- reports this error only when copying selected text to the clipboard}
- oeRegionSize = oeFirst + 8;
- {This error is reported by an editor control when the user asks to
- copy selected text to the clipboard, and the selected region exceeds
- 64K in size}
- oeTooManyParas = oeFirst + 9;
- {This error is reported by an editor control when the limit on the number
- of paragraphs is reached, and the requested operation would cause it to be
- exceeded}
- oeCannotJoin = oeFirst + 10;
- {This error is reported by an editor control when the user attempts to join
- two paragraphs that cannot be joined. Typically this occurs when joining
- the two paragraphs would cause the new paragraph to exceed its size limit}
- oeTooManyBytes = oeFirst + 11;
- {This error is reported by an editor control when the limit on the total
- number of bytes is reached, and the requested operation would cause it to
- be exceeded}
- oeParaTooLong = oeFirst + 12;
- {This error is reported by an editor control when the limit on the length
- of an individual paragraph is reached, and the requested operation would
- cause it to be exceeded}
- oeCustomError = 32768;
- {the first error code reserved for user applications. All }
- {error values less than this value are reserved for use by}
- {Orpheus}
-
-{*** Field class and type constant id's ***}
-
-const
- {Field class codes}
- fcSimple = 0;
- fcPicture = 1;
- fcNumeric = 2;
-
- {Field class divisor}
- fcpDivisor = $40;
-
- {Field class prefixes}
- fcpSimple = fcpDivisor*fcSimple;
- fcpPicture = fcpDivisor*fcPicture;
- fcpNumeric = fcpDivisor*fcNumeric;
-
- {Field type IDs for simple fields}
- fidSimpleString = fcpSimple+fsubString;
- fidSimpleChar = fcpSimple+fsubChar;
- fidSimpleBoolean = fcpSimple+fsubBoolean;
- fidSimpleYesNo = fcpSimple+fsubYesNo;
- fidSimpleLongInt = fcpSimple+fsubLongInt;
- fidSimpleWord = fcpSimple+fsubWord;
- fidSimpleInteger = fcpSimple+fsubInteger;
- fidSimpleByte = fcpSimple+fsubByte;
- fidSimpleShortInt = fcpSimple+fsubShortInt;
- fidSimpleReal = fcpSimple+fsubReal;
- fidSimpleExtended = fcpSimple+fsubExtended;
- fidSimpleDouble = fcpSimple+fsubDouble;
- fidSimpleSingle = fcpSimple+fsubSingle;
- fidSimpleComp = fcpSimple+fsubComp;
-
- {Field type IDs for picture fields}
- fidPictureString = fcpPicture+fsubString;
- fidPictureChar = fcpPicture+fsubChar;
- fidPictureBoolean = fcpPicture+fsubBoolean;
- fidPictureYesNo = fcpPicture+fsubYesNo;
- fidPictureLongInt = fcpPicture+fsubLongInt;
- fidPictureWord = fcpPicture+fsubWord;
- fidPictureInteger = fcpPicture+fsubInteger;
- fidPictureByte = fcpPicture+fsubByte;
- fidPictureShortInt = fcpPicture+fsubShortInt;
- fidPictureReal = fcpPicture+fsubReal;
- fidPictureExtended = fcpPicture+fsubExtended;
- fidPictureDouble = fcpPicture+fsubDouble;
- fidPictureSingle = fcpPicture+fsubSingle;
- fidPictureComp = fcpPicture+fsubComp;
- fidPictureDate = fcpPicture+fsubDate;
- fidPictureTime = fcpPicture+fsubTime;
-
- {Field type IDs for numeric fields}
- fidNumericLongInt = fcpNumeric+fsubLongInt;
- fidNumericWord = fcpNumeric+fsubWord;
- fidNumericInteger = fcpNumeric+fsubInteger;
- fidNumericByte = fcpNumeric+fsubByte;
- fidNumericShortInt = fcpNumeric+fsubShortInt;
- fidNumericReal = fcpNumeric+fsubReal;
- fidNumericExtended = fcpNumeric+fsubExtended;
- fidNumericDouble = fcpNumeric+fsubDouble;
- fidNumericSingle = fcpNumeric+fsubSingle;
- fidNumericComp = fcpNumeric+fsubComp;
-
-
-function GetOrphStr(Index : Word) : string;
- {-return a string from our RCDATA string resource}
-
-implementation
-
-function GetOrphStr(Index : Word) : string;
-begin
- Result := ResourceStrByNumber(Index);
- if Result = '' then
- Result := 'Unknown';
-end;
-
-
-procedure InitAlphaCharSet;
- {-Initialize AlphaOnlySet}
-var
- C : AnsiChar;
-begin
- AlphaCharSet := ['A'..'Z', 'a'..'z', ' ', '-', '.', ','];
- for C := #128 to #255 do
- {ask windows what other characters are considered alphas}
- if IsCharAlpha(C) then
- AlphaCharSet := AlphaCharSet + [C];
-end;
-
-initialization
- InitAlphaCharSet;
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/8d/8d1c847044271c4227ee16ec137faff60cbb5099.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/8d/8d1c847044271c4227ee16ec137faff60cbb5099.svn-base
deleted file mode 100644
index 0bd379aa..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/8d/8d1c847044271c4227ee16ec137faff60cbb5099.svn-base
+++ /dev/null
@@ -1,136 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 808
- Height = 446
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- Position = poScreenCenter
- OnCreate = FormCreate
- OnDestroy = FormDestroy
- PixelsPerInch = 96
- object OvcTable1: TOvcTable
- Left = 16
- Top = 16
- Width = 777
- Height = 409
- Anchors = [akLeft, akTop, akRight, akBottom]
- Color = clWindow
- Controller = OvcController1
- GridPenSet.NormalGrid.NormalColor = clBtnShadow
- GridPenSet.NormalGrid.Style = psDot
- GridPenSet.NormalGrid.Effect = geBoth
- GridPenSet.LockedGrid.NormalColor = clBtnShadow
- GridPenSet.LockedGrid.Style = psSolid
- GridPenSet.LockedGrid.Effect = ge3D
- GridPenSet.CellWhenFocused.NormalColor = clBlack
- GridPenSet.CellWhenFocused.Style = psSolid
- GridPenSet.CellWhenFocused.Effect = geBoth
- GridPenSet.CellWhenUnfocused.NormalColor = clBlack
- GridPenSet.CellWhenUnfocused.Style = psDash
- GridPenSet.CellWhenUnfocused.Effect = geBoth
- LockedRowsCell = OvcTCColHead1
- Options = [otoNoRowResizing, otoNoColResizing, otoTabToArrow, otoEnterToArrow, otoAlwaysEditing, otoNoSelection, otoThumbTrack]
- TabOrder = 0
- OnGetCellData = OvcTable1GetCellData
- CellData = (
- 'Form1.OvcTCColHead1'
- 'Form1.OvcTCRowHead1'
- 'Form1.OvcTCString1'
- 'Form1.OvcTCMemo1'
- 'Form1.OvcTCCheckBox1'
- 'Form1.OvcTCComboBox1'
- 'Form1.OvcTCBitMap1')
- RowData = (
- 35)
- ColData = (
- 120
- False
- True
- 'Form1.OvcTCRowHead1'
- 100
- False
- True
- 'Form1.OvcTCString1'
- 150
- False
- True
- 'Form1.OvcTCMemo1'
- 120
- False
- True
- 'Form1.OvcTCCheckBox1'
- 160
- False
- True
- 'Form1.OvcTCComboBox1'
- 100
- False
- True
- 'Form1.OvcTCBitMap1')
- end
- object OvcTCColHead1: TOvcTCColHead
- Headings.Strings = (
- 'TOvcTCRowHead'
- 'TOvcTCString'
- 'TOvcTCMemo'
- 'TOvcTCCheckBox'
- 'TOvcTCComboBox'
- 'TOvcTCBitmap')
- ShowLetters = False
- Adjust = otaCenter
- Table = OvcTable1
- Left = 48
- end
- object OvcTCRowHead1: TOvcTCRowHead
- Adjust = otaCenter
- Table = OvcTable1
- Left = 80
- end
- object OvcTCString1: TOvcTCString
- AutoAdvanceLeftRight = True
- Table = OvcTable1
- Left = 144
- end
- object OvcTCMemo1: TOvcTCMemo
- Table = OvcTable1
- Left = 264
- end
- object OvcTCCheckBox1: TOvcTCCheckBox
- Adjust = otaCenter
- CellGlyphs.IsDefault = True
- CellGlyphs.GlyphCount = 3
- CellGlyphs.ActiveGlyphCount = 2
- Table = OvcTable1
- Left = 384
- end
- object OvcTCComboBox1: TOvcTCComboBox
- Style = csDropDownList
- Table = OvcTable1
- OnChange = OvcTCComboBox1Change
- Left = 512
- end
- object OvcTCBitMap1: TOvcTCBitMap
- Adjust = otaTopCenter
- Table = OvcTable1
- Left = 624
- end
- object OvcController1: TOvcController
- EntryCommands.TableList = (
- 'Default'
- True
- ()
- 'WordStar'
- False
- ()
- 'Grid'
- False
- ())
- Epoch = 2000
- Left = 16
- end
-end
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/8e/8e71f012dae3343f73e8635c503c399927d8536f.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/8e/8e71f012dae3343f73e8635c503c399927d8536f.svn-base
deleted file mode 100644
index 67d92b14..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/8e/8e71f012dae3343f73e8635c503c399927d8536f.svn-base
+++ /dev/null
@@ -1,332 +0,0 @@
-{*********************************************************}
-{* OVCTBPE2.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 ovctbpe2;
- {-Property editor for the data-aware table component}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Classes, Graphics, Controls,
- {$IFNDEF LCL} {$IFDEF VERSION6} DesignIntf, DesignEditors, {$ELSE} DsgnIntf, {$ENDIF} {$ELSE} PropEdits, ComponentEditors, {$ENDIF}
- TypInfo, Forms, Dialogs, StdCtrls, OvcBase, OvcEf, OvcPb, OvcNf, Buttons,
- ExtCtrls, OvcTCmmn, OvcTCell, OvcTbCls, OvcTable, OvcSf, OvcSc;
-
-type
- TOvcfrmColEditor = class(TForm)
- ctlColNumber: TOvcSimpleField;
- ctlDefaultCell: TComboBox;
- ctlHidden: TCheckBox;
- ctlWidth: TOvcSimpleField;
- Panel1: TPanel;
- SpeedButton1: TSpeedButton;
- SpeedButton2: TSpeedButton;
- SpeedButton3: TSpeedButton;
- SpeedButton4: TSpeedButton;
- SpeedButton5: TSpeedButton;
- SpeedButton6: TSpeedButton;
- Label1: TLabel;
- Label2: TLabel;
- Label3: TLabel;
- Label4: TLabel;
- GroupBox1: TGroupBox;
- DoneButton: TBitBtn;
- ApplyButton: TBitBtn;
- DefaultController: TOvcController;
- OvcSpinner1: TOvcSpinner;
- OvcSpinner2: TOvcSpinner;
- procedure ctlColNumberExit(Sender: TObject);
- procedure ApplyButtonClick(Sender: TObject);
- procedure SpeedButton1Click(Sender: TObject);
- procedure SpeedButton2Click(Sender: TObject);
- procedure SpeedButton3Click(Sender: TObject);
- procedure SpeedButton4Click(Sender: TObject);
- procedure SpeedButton5Click(Sender: TObject);
- procedure SpeedButton6Click(Sender: TObject);
- procedure FormShow(Sender: TObject);
- procedure DoneButtonClick(Sender: TObject);
- procedure ctlColNumberChange(Sender: TObject);
- private
- { Private declarations }
- FCols : TOvcTableColumns;
- FColNum : TColNum;
- CurCellIndex : integer;
- Cells : TStringList;
-
- protected
- procedure GetCells;
- procedure RefreshColData;
- procedure SetColNum(C : TColNum);
-
- procedure AddCellComponentName(const S : string);
-
- public
- { Public declarations }
- Editor : TObject;
- procedure SetCols(CS : TOvcTableColumns);
-
- property Cols : TOvcTableColumns
- read FCols
- write SetCols;
-
- property ColNum : TColNum
- read FColNum
- write SetColNum;
-
- end;
-
- {-A table column property editor}
- TOvcTableColumnProperty = class(TClassProperty)
- public
- procedure Edit; override;
- function GetAttributes: TPropertyAttributes; override;
- end;
-
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.DFM}
-{$ENDIF}
-
-
-
-{===TOvcTableColumnProperty==========================================}
-procedure TOvcTableColumnProperty.Edit;
- var
- ColEditor : TOvcfrmColEditor;
- begin
- ColEditor := TOvcfrmColEditor.Create(Application);
- try
- ColEditor.Editor := Self;
- ColEditor.SetCols(TOvcTableColumns(GetOrdValue));
- ColEditor.ShowModal;
-{$IFNDEF LCL}
- Designer.Modified;
-{$ELSE}
- Modified;
-{$ENDIF}
- finally
- ColEditor.Free;
- end;{try..finally}
- end;
-{--------}
-function TOvcTableColumnProperty.GetAttributes: TPropertyAttributes;
- begin
- Result := [paMultiSelect, paDialog, paReadOnly];
- end;
-{====================================================================}
-
-
-{===TColEditor=======================================================}
-procedure TOvcfrmColEditor.AddCellComponentName(const S : string);
- begin
- Cells.Add(S);
- end;
-{--------}
-procedure TOvcfrmColEditor.ApplyButtonClick(Sender: TObject);
- begin
- with FCols[ColNum] do
- begin
- Hidden := ctlHidden.Checked;
- FCols[ColNum].Width := ctlWidth.AsInteger;
- if (ctlDefaultCell.ItemIndex <> CurCellIndex) then
- begin
- CurCellIndex := ctlDefaultCell.ItemIndex;
- FCols[FColNum].DefaultCell := TOvcBaseTableCell(Cells.Objects[CurCellIndex]);
- end;
- end;
- end;
-{--------}
-procedure TOvcfrmColEditor.ctlColNumberExit(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- ColNum := ctlColNumber.AsInteger;
- end;
-{--------}
-procedure TOvcfrmColEditor.DoneButtonClick(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- Cells.Free;
- end;
-{--------}
-procedure TOvcfrmColEditor.FormShow(Sender: TObject);
- begin
- if not Assigned(Cells) then
- begin
- Cells := TStringList.Create;
- GetCells;
- end;
- RefreshColData;
- end;
-{--------}
-procedure TOvcfrmColEditor.GetCells;
- var
- {$IFDEF VERSION4}
- {$IFDEF VERSION6}
-{$IFNDEF LCL}
- Designer : IDesigner;
-{$ENDIF}
- {$ELSE}
- Designer : IFormDesigner;
- {$ENDIF}
- {$ELSE}
- Designer : TFormDesigner;
- {$ENDIF}
- TI : PTypeInfo;
- Index: Integer;
- C : TComponent;
- Cell : TOvcBaseTableCell absolute C;
- begin
- Cells.Sorted := true;
- Cells.AddObject('(None)', nil);
- TI := TOvcBaseTableCell.ClassInfo;
-{$IFNDEF LCL}
- if (Editor is TClassProperty) then
- Designer := TClassProperty(Editor).Designer
- else {the editor is a TDefaultEditor}
- Designer := TDefaultEditor(Editor).Designer;
- Designer.GetComponentNames(GetTypeData(TI), AddCellComponentName);
- for Index := 1 to pred(Cells.Count) do
- Cells.Objects[Index] := Designer.GetComponent(Cells[Index]);
-{$ELSE}
- if (Editor is TClassProperty) then
- begin
- TClassProperty(Editor).PropertyHook.GetComponentNames(GetTypeData(TI), AddCellComponentName);
- for Index := 1 to pred(Cells.Count) do
- Cells.Objects[Index] := TClassProperty(Editor).PropertyHook.GetComponent(Cells[Index]);
- end
- else {the editor is a TDefaultComponentEditor}
- begin
- TDefaultComponentEditor(Editor).Designer.PropertyEditorHook.GetComponentNames(GetTypeData(TI), AddCellComponentName);
- for Index := 1 to pred(Cells.Count) do
- Cells.Objects[Index] := TDefaultComponentEditor(Editor).Designer.PropertyEditorHook.GetComponent(Cells[Index]);
- end;
-{$ENDIF}
- ctlDefaultCell.Items := Cells;
- end;
-{--------}
-procedure TOvcfrmColEditor.RefreshColData;
- begin
- CurCellIndex := Cells.IndexOfObject(FCols[ColNum].DefaultCell);
-
- ctlColNumber.RangeHi := IntToStr(pred(FCols.Count));
-
- ctlHidden.Checked := FCols[ColNum].Hidden;
- ctlWidth.AsInteger := FCols[ColNum].Width;
- ctlDefaultCell.ItemIndex := CurCellIndex;
- end;
-{--------}
-procedure TOvcfrmColEditor.SetColNum(C : TColNum);
- begin
- if (FColNum <> C) then
- begin
- FColNum := C;
- ctlColNumber.AsInteger := C;
- RefreshColData;
- end;
- end;
-{--------}
-procedure TOvcfrmColEditor.SetCols(CS : TOvcTableColumns);
- begin
- if Assigned(FCols) then
- FCols.Free;
- FCols := CS;
- FColNum := 0;
- end;
-{--------}
-procedure TOvcfrmColEditor.SpeedButton1Click(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- if (ColNum > 0) then
- ColNum := ColNum - 1;
- end;
-{--------}
-procedure TOvcfrmColEditor.SpeedButton2Click(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- if (ColNum < pred(FCols.Count)) then
- ColNum := ColNum + 1;
- end;
-{--------}
-procedure TOvcfrmColEditor.SpeedButton3Click(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- ColNum := 0;
- end;
-{--------}
-procedure TOvcfrmColEditor.SpeedButton4Click(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- ColNum := pred(FCols.Count);
- end;
-{--------}
-procedure TOvcfrmColEditor.SpeedButton5Click(Sender: TObject);
- var
- C : TOvcTableColumn;
- begin
- C := TOvcTableColumn.Create(FCols.Table);
- FCols.Insert(FColNum, C);
- RefreshColData;
- end;
-{--------}
-procedure TOvcfrmColEditor.SpeedButton6Click(Sender: TObject);
- begin
- if (FCols.Count > 1) then
- begin
- FCols.Delete(FColNum);
- if (FColNum = FCols.Count) then
- ColNum := pred(FColNum)
- else RefreshColData;
- end;
- end;
-{====================================================================}
-
-
-procedure TOvcfrmColEditor.ctlColNumberChange(Sender: TObject);
-begin
- ApplyButtonClick(Self);
- ColNum := ctlColNumber.AsInteger;
-end;
-
-initialization
-{$IFDEF LCL}
-{$I ovctbpe2.lrs} {Include form's resource file}
-{$ENDIF}
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/8f/8f123b85318498b7da9880ac38b00146e49c91be.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/8f/8f123b85318498b7da9880ac38b00146e49c91be.svn-base
deleted file mode 100644
index 10ff5a6c..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/8f/8f123b85318498b7da9880ac38b00146e49c91be.svn-base
+++ /dev/null
@@ -1,1494 +0,0 @@
-{*********************************************************}
-{* OVCCMD.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 ovccmd;
- {-Translates messages into commands}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, LclType, {$ENDIF}
- Classes, Forms, Menus, Messages, SysUtils, OvcConst, OvcData,
- OvcExcpt, OvcMisc;
-
-const
- {default primary command/key table}
- DefCommandTable : array[0..63] of TOvcCmdRec = (
- {Key #1 Shift state #1
- Key #2 Shift state #2 Command}
- (Key1:VK_LEFT; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccLeft),
- (Key1:VK_RIGHT; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccRight),
- (Key1:VK_LEFT; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccWordLeft),
- (Key1:VK_RIGHT; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccWordRight),
- (Key1:VK_HOME; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccHome),
- (Key1:VK_END; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccEnd),
- (Key1:VK_DELETE; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccDel),
- (Key1:VK_BACK; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccBack),
- (Key1:VK_BACK; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccBack),
- (Key1:VK_PRIOR; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccTopOfPage),
- (Key1:VK_NEXT; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccBotOfPage),
- (Key1:VK_INSERT; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccIns),
- (Key1:VK_Z; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccUndo),
- (Key1:VK_BACK; SS1:ss_Alt;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccRestore),
- (Key1:VK_UP; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccUp),
- (Key1:VK_DOWN; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccDown),
- (Key1:VK_RETURN; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccNewLine),
- (Key1:VK_LEFT; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendLeft),
- (Key1:VK_RIGHT; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendRight),
- (Key1:VK_HOME; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendHome),
- (Key1:VK_END; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendEnd),
- (Key1:VK_LEFT; SS1:ss_Shift+ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtWordLeft),
- (Key1:VK_RIGHT; SS1:ss_Shift+ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtWordRight),
- (Key1:VK_PRIOR; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendPgUp),
- (Key1:VK_NEXT; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendPgDn),
- (Key1:VK_UP; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendUp),
- (Key1:VK_DOWN; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendDown),
- (Key1:VK_HOME; SS1:ss_Shift+ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtFirstPage),
- (Key1:VK_END; SS1:ss_Shift+ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtLastPage),
- (Key1:VK_PRIOR; SS1:ss_Shift+ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtTopOfPage),
- (Key1:VK_NEXT; SS1:ss_Shift+ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtBotOfPage),
- (Key1:VK_DELETE; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccCut),
- (Key1:VK_X; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccCut),
- (Key1:VK_INSERT; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccCopy),
- (Key1:VK_C; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccCopy),
- (Key1:VK_INSERT; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccPaste),
- (Key1:VK_V; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccPaste),
- (Key1:VK_PRIOR; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccPrevPage),
- (Key1:VK_NEXT; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccNextPage),
- (Key1:VK_HOME; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccFirstPage),
- (Key1:VK_END; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccLastPage),
- (Key1:VK_TAB; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccTab),
- (Key1:VK_TAB; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccTab),
- (Key1:VK_Z; SS1:ss_Ctrl+ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccRedo),
- (Key1:VK_0; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccGotoMarker0),
- (Key1:VK_1; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccGotoMarker1),
- (Key1:VK_2; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccGotoMarker2),
- (Key1:VK_3; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccGotoMarker3),
- (Key1:VK_4; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccGotoMarker4),
- (Key1:VK_5; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccGotoMarker5),
- (Key1:VK_6; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccGotoMarker6),
- (Key1:VK_7; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccGotoMarker7),
- (Key1:VK_8; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccGotoMarker8),
- (Key1:VK_9; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccGotoMarker9),
- (Key1:VK_0; SS1:ss_Ctrl+ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccSetMarker0),
- (Key1:VK_1; SS1:ss_Ctrl+ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccSetMarker1),
- (Key1:VK_2; SS1:ss_Ctrl+ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccSetMarker2),
- (Key1:VK_3; SS1:ss_Ctrl+ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccSetMarker3),
- (Key1:VK_4; SS1:ss_Ctrl+ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccSetMarker4),
- (Key1:VK_5; SS1:ss_Ctrl+ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccSetMarker5),
- (Key1:VK_6; SS1:ss_Ctrl+ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccSetMarker6),
- (Key1:VK_7; SS1:ss_Ctrl+ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccSetMarker7),
- (Key1:VK_8; SS1:ss_Ctrl+ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccSetMarker8),
- (Key1:VK_9; SS1:ss_Ctrl+ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccSetMarker9));
-
- {default WordStar command-key table}
- DefWsMaxCommands = 40;
- DefWsCommandTable : array[0..DefWsMaxCommands-1] of TOvcCmdRec = (
- {Key #1 Shift state #1
- Key #2 Shift state #2 Command}
- (Key1:VK_S; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccLeft),
- (Key1:VK_D; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccRight),
- (Key1:VK_E; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccUp),
- (Key1:VK_X; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccDown),
- (Key1:VK_R; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccPrevPage),
- (Key1:VK_C; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccNextPage),
- (Key1:VK_W; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccScrollUp),
- (Key1:VK_Z; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccScrollDown),
- (Key1:VK_A; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccWordLeft),
- (Key1:VK_F; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccWordRight),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_S; SS2:ss_Wordstar; Cmd:ccHome),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_D; SS2:ss_Wordstar; Cmd:ccEnd),
- (Key1:VK_G; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccDel),
- (Key1:VK_H; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccBack),
- (Key1:VK_Y; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccDelLine),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_Y; SS2:ss_Wordstar; Cmd:ccDelEol),
- (Key1:VK_V; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccIns),
- (Key1:VK_T; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccDelWord),
- (Key1:VK_P; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccCtrlChar),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_L; SS2:ss_Wordstar; Cmd:ccRestore),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_0; SS2:ss_Wordstar; Cmd:ccGotoMarker0),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_1; SS2:ss_Wordstar; Cmd:ccGotoMarker1),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_2; SS2:ss_Wordstar; Cmd:ccGotoMarker2),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_3; SS2:ss_Wordstar; Cmd:ccGotoMarker3),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_4; SS2:ss_Wordstar; Cmd:ccGotoMarker4),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_5; SS2:ss_Wordstar; Cmd:ccGotoMarker5),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_6; SS2:ss_Wordstar; Cmd:ccGotoMarker6),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_7; SS2:ss_Wordstar; Cmd:ccGotoMarker7),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_8; SS2:ss_Wordstar; Cmd:ccGotoMarker8),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_9; SS2:ss_Wordstar; Cmd:ccGotoMarker9),
- (Key1:VK_K; SS1:ss_Ctrl;
- Key2:VK_0; SS2:ss_Wordstar; Cmd:ccSetMarker0),
- (Key1:VK_K; SS1:ss_Ctrl;
- Key2:VK_1; SS2:ss_Wordstar; Cmd:ccSetMarker1),
- (Key1:VK_K; SS1:ss_Ctrl;
- Key2:VK_2; SS2:ss_Wordstar; Cmd:ccSetMarker2),
- (Key1:VK_K; SS1:ss_Ctrl;
- Key2:VK_3; SS2:ss_Wordstar; Cmd:ccSetMarker3),
- (Key1:VK_K; SS1:ss_Ctrl;
- Key2:VK_4; SS2:ss_Wordstar; Cmd:ccSetMarker4),
- (Key1:VK_K; SS1:ss_Ctrl;
- Key2:VK_5; SS2:ss_Wordstar; Cmd:ccSetMarker5),
- (Key1:VK_K; SS1:ss_Ctrl;
- Key2:VK_6; SS2:ss_Wordstar; Cmd:ccSetMarker6),
- (Key1:VK_K; SS1:ss_Ctrl;
- Key2:VK_7; SS2:ss_Wordstar; Cmd:ccSetMarker7),
- (Key1:VK_K; SS1:ss_Ctrl;
- Key2:VK_8; SS2:ss_Wordstar; Cmd:ccSetMarker8),
- (Key1:VK_K; SS1:ss_Ctrl;
- Key2:VK_9; SS2:ss_Wordstar; Cmd:ccSetMarker9));
-
- {default Orpheus Table command/key table}
- DefGridMaxCommands = 38;
- DefGridCommandTable : array[0..DefGridMaxCommands-1] of TOvcCmdRec = (
- {Key #1 Shift state #1
- Key #2 Shift state #2 Command}
- (Key1:VK_LEFT; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccLeft),
- (Key1:VK_RIGHT; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccRight),
- (Key1:VK_LEFT; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccPageLeft),
- (Key1:VK_RIGHT; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccPageRight),
- (Key1:VK_HOME; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccHome),
- (Key1:VK_END; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccEnd),
- (Key1:VK_DELETE; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccDel),
- (Key1:VK_BACK; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccBack),
- (Key1:VK_NEXT; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccBotOfPage),
- (Key1:VK_PRIOR; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccTopOfPage),
- (Key1:VK_INSERT; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccIns),
- (Key1:VK_Z; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccRestore),
- (Key1:VK_UP; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccUp),
- (Key1:VK_DOWN; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccDown),
- (Key1:VK_LEFT; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendLeft),
- (Key1:VK_RIGHT; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendRight),
- (Key1:VK_HOME; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendHome),
- (Key1:VK_END; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendEnd),
- (Key1:VK_LEFT; SS1:ss_Shift+ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtWordLeft),
- (Key1:VK_RIGHT; SS1:ss_Shift+ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtWordRight),
- (Key1:VK_PRIOR; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendPgUp),
- (Key1:VK_NEXT; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendPgDn),
- (Key1:VK_UP; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendUp),
- (Key1:VK_DOWN; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendDown),
- (Key1:VK_HOME; SS1:ss_Shift+ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtFirstPage),
- (Key1:VK_END; SS1:ss_Shift+ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtLastPage),
- (Key1:VK_PRIOR; SS1:ss_Shift+ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtTopOfPage),
- (Key1:VK_NEXT; SS1:ss_Shift+ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtBotOfPage),
- (Key1:VK_X; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccCut),
- (Key1:VK_C; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccCopy),
- (Key1:VK_V; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccPaste),
- (Key1:VK_PRIOR; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccPrevPage),
- (Key1:VK_HOME; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccFirstPage),
- (Key1:VK_NEXT; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccNextPage),
- (Key1:VK_END; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccLastPage),
- (Key1:VK_UP; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccTopLeftCell),
- (Key1:VK_DOWN; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccBotRightCell),
- (Key1:VK_F2; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccTableEdit));
-
-type
- {command processor states}
- TOvcProcessorState = (stNone, stPartial, stLiteral);
-
- {user command notify event}
- TUserCommandEvent =
- procedure(Sender : TObject; Command : Word)
- of object;
-
- {forward class declarations}
- TOvcCommandProcessor = class;
-
- TOvcCommandTable = class(TPersistent)
- {.Z+}
- protected {private}
- FActive : Boolean; {true to use this command table}
- FCommandList : TList; {list of command/key mappings}
- FTableName : string; {the name of this command table}
-
- {property methods}
- function GetCmdRec(Index : Integer) : TOvcCmdRec;
- {-return the list item corresponding to "Index"}
- function GetCount : Integer;
- {-return the number of records in the list}
- procedure PutCmdRec(Index : Integer; const CmdRec : TOvcCmdRec);
- {-store a new command entry to the list at "Index" position}
-
- {internal methods}
- procedure ctDisposeCommandEntry(P : POvcCmdRec);
- {-dispose of a command entry record}
- function ctNewCommandEntry(const CmdRec : TOvcCmdRec): POvcCmdRec;
- {-allocate a new command entry record}
- procedure ctReadData(Reader : TReader);
- {-called to read the table from the stream}
- procedure ctWriteData(Writer : TWriter);
- {-called to store the table on the stream}
-
- protected
- procedure DefineProperties(Filer : TFiler);
- override;
-
- public
- constructor Create;
- destructor Destroy;
- override;
- {.Z-}
-
- function AddRec(const CmdRec : TOvcCmdRec) : Integer;
- {-add a record to the list}
- procedure Clear;
- {-delete all records from the list}
- procedure Delete(Index : Integer);
- {-delete a record from the list}
- procedure Exchange(Index1, Index2 : Integer);
- {-exchange list locations of the two specified records}
- function IndexOf(const CmdRec : TOvcCmdRec) : Integer;
- {-return the index of the specified record}
- procedure InsertRec(Index : Integer; const CmdRec : TOvcCmdRec);
- {-insert a record at the specified index}
- procedure LoadFromFile(const FileName : string);
- {-read command entries from a text file}
- procedure Move(CurIndex, NewIndex : Integer);
- {-move one record to anothers index location}
- procedure SaveToFile(const FileName: string);
- {-write command entries to a text file}
-
- property Commands[Index : Integer] : TOvcCmdRec
- read GetCmdRec write PutCmdRec; default;
- property Count : Integer
- read GetCount stored False;
- property IsActive : Boolean
- read FActive write FActive;
- property TableName : string
- read FTableName write FTableName;
- end;
-
- TOvcCommandProcessor = class(TPersistent)
- {.Z+}
- protected {private}
- {property variables}
- FTableList : TList; {list of command tables}
-
- {internal variables}
- cpState : TOvcProcessorState; {current state}
- cpSaveKey : Byte; {saved last key processed}
- cpSaveSS : Byte; {saved shift key state}
-
- {property methods}
- function GetCount: Integer;
- {-return the number of tables in the list}
- function GetTable(Index : Integer) : TOvcCommandTable;
- {-return the table referenced by "Index"}
- procedure SetTable(Index : Integer; CT : TOvcCommandTable);
- {-store a command table at position "Index"}
-
- {internal methods}
- function cpFillCommandRec(Key1, ShiftState1,
- Key2, ShiftState2 : Byte;
- Command : Word) : TOvcCmdRec;
- {-fill a command record}
- procedure cpReadData(Reader: TReader);
- {-called to read the command processor from the stream}
- function cpScanTable(CT : TOvcCommandTable; Key, SFlags : Byte) : Word;
- {-Scan the command table for a match}
- procedure cpWriteData(Writer: TWriter);
- {-called to store the command processor to the stream}
-
- protected
- procedure DefineProperties(Filer: TFiler);
- override;
-
- public
- constructor Create;
- destructor Destroy;
- override;
- {.Z-}
-
- procedure Add(CT : TOvcCommandTable);
- {-add a command table to the list of tables}
- procedure AddCommand(const TableName: string;
- Key1, ShiftState1,
- Key2, ShiftState2 : Byte;
- Command : Word);
- {-add a command and key sequence to the command table}
- procedure AddCommandRec(const TableName: string; const CmdRec : TOvcCmdRec);
- {-add a command record to the command table}
- procedure ChangeTableName(const OldName, NewName: string);
- {-change the name of a table}
- procedure Clear;
- {-delete all tables from the list}
- function CreateCommandTable(const TableName : string; Active : Boolean) : Integer;
- {-create a command table and add it to the table list}
- procedure Delete(Index : Integer);
- {-delete the "Index" table from the list of tables}
- procedure DeleteCommand(const TableName: string;
- Key1, ShiftState1,
- Key2, ShiftState2 : Byte);
- {-delete a command and key sequence from a command table}
- procedure DeleteCommandTable(const TableName : string);
- {-delete a command table and remove it from the table list}
- procedure Exchange(Index1, Index2 : Integer);
- {-exchange list locations of the two specified command tables}
- function GetCommandCount(const TableName : string) : Integer;
- {-return the number of commands in the command table}
- function GetCommandTable(const TableName : string) : TOvcCommandTable;
- {-return a pointer to the specified command table or nil}
- {.Z+}
- procedure GetState(var State : TOvcProcessorState; var Key, Shift : Byte);
- {-return the current status of the command processor}
- {.Z-}
- function GetCommandTableIndex(const TableName : string) : Integer;
- {-return index to the specified command table or -1 for failure}
- function LoadCommandTable(const FileName : string) : Integer; virtual;
- {-creates and then fills a command table from a text file}
- procedure ResetCommandProcessor;
- {-reset the command processor}
- procedure SaveCommandTable(const TableName, FileName : string); virtual;
- {-save a command table to a text file}
- procedure SetScanPriority(const Names : array of string);
- {-reorder the list of tables based on this array}
- {.Z+}
- procedure SetState(State : TOvcProcessorState; Key, Shift : Byte);
- {-set the state to the command processor}
- {.Z-}
- function Translate(var Msg : TMessage) : Word;
- {-translate a message into a command}
- function TranslateUsing(const Tables : array of string; var Msg : TMessage) : Word;
- {-translate a message into a command using the given tables}
- function TranslateKey(Key : Word; ShiftState : TShiftState) : Word;
- {-translate a key and shift-state into a command}
- function TranslateKeyUsing(const Tables : array of string; Key : Word; ShiftState : TShiftState) : Word;
- {-translate a key and shift-state into a command using the given tables}
-
- property Count: Integer
- read GetCount
- stored False;
-
- property Table[Index : Integer]: TOvcCommandTable
- read GetTable
- write SetTable;
- default;
- end;
-
-
-implementation
-
-
-{*** TOvcCommandTable ***}
-
-function TOvcCommandTable.AddRec(const CmdRec : TOvcCmdRec) : Integer;
-begin
- Result := GetCount;
- InsertRec(Result, CmdRec);
-end;
-
-procedure TOvcCommandTable.Clear;
-var
- I: Integer;
-begin
- {dispose of all command records in the list}
- for I := 0 to FCommandList.Count - 1 do
- ctDisposeCommandEntry(FCommandList[I]);
- {clear the list entries}
- FCommandList.Clear;
-end;
-
-constructor TOvcCommandTable.Create;
-begin
- inherited Create;
- FTableName := GetOrphStr(SCUnknownTable);
- FActive := True;
- FCommandList := TList.Create;
-end;
-
-procedure TOvcCommandTable.ctDisposeCommandEntry(P : POvcCmdRec);
-begin
- if Assigned(P) then
- FreeMem(P, SizeOf(TOvcCmdRec));
-end;
-
-function TOvcCommandTable.ctNewCommandEntry(const CmdRec : TOvcCmdRec): POvcCmdRec;
-begin
- GetMem(Result, SizeOf(TOvcCmdRec));
- Result^ := CmdRec;
-end;
-
-procedure TOvcCommandTable.ctReadData(Reader : TReader);
-var
- CmdRec : TOvcCmdRec;
-
- procedure ReadAndCompareTable(const CT : array of TOvcCmdRec);
- var
- I : Integer;
- Idx : Integer;
- begin
- {add all records initially}
- for I := 0 to High(CT) do
- AddRec(CT[I]);
-
- while not Reader.EndOfList do begin
- with CmdRec, Reader do begin
- Keys := ReadInteger;
- Cmd := ReadInteger;
- end;
- {if keys on stream are dups replace default with redefinition}
- Idx := IndexOf(CmdRec);
- if Idx > -1 then begin
- {if assigned to ccNone, remove instead of replace}
- if CmdRec.Cmd = ccNone then
- Delete(Idx)
- else
- Commands[Idx] := CmdRec
- end else
- AddRec(CmdRec);
- end;
- end;
-
-begin
- FTableName := Reader.ReadString;
- FActive := Reader.ReadBoolean;
- Reader.ReadListBegin;
- Clear;
-
- if CompareText(GetOrphStr(SCDefaultTableName), FTableName) = 0 then
- {if this is the "default" table, fill it with default commands}
- ReadAndCompareTable(DefCommandTable)
- else if CompareText(GetOrphStr(SCWordStarTableName), FTableName) = 0 then
- {if this is the "wordstar" table, fill it with default commands}
- ReadAndCompareTable(DefWsCommandTable)
- else if CompareText(GetOrphStr(SCGridTableName), FTableName) = 0 then
- {if this is the "grid" table, fill it with default commands}
- ReadAndCompareTable(DefGridCommandTable)
- else begin
- {otherwise, load complete command table from stream}
- while not Reader.EndOfList do begin
- with CmdRec, Reader do begin
- Keys := ReadInteger;
- Cmd := ReadInteger;
- end;
- AddRec(CmdRec);
- end;
- end;
-
- Reader.ReadListEnd;
-end;
-
-procedure TOvcCommandTable.ctWriteData(Writer : TWriter);
-var
- I : Integer;
- Cmdrec : TOvcCmdRec;
-
- procedure CompareAndWriteTable(const CT : array of TOvcCmdRec);
- var
- I, J : Integer;
- Idx : Integer;
- begin
- {find commands in the CT table but missing from this table}
- for I := 0 to High(CT) do begin
- Idx := IndexOf(CT[I]);
- if Idx = -1 then begin
- {not found, store and assign to ccNone}
- with CT[I], Writer do begin
- WriteInteger(Keys);
- WriteInteger(ccNone);
- end;
- end;
- end;
-
- {store all commands in new table if they are additions to the CT table}
- for I := 0 to Count - 1 do begin
- CmdRec := GetCmdRec(I);
- {search CT for a match}
- Idx := -1;
- for J := 0 to High(CT) do begin
- if (CmdRec.Keys = CT[J].Keys) and (CmdRec.Cmd = CT[J].Cmd) then begin
- Idx := J;
- Break;
- end;
- end;
- if Idx = -1 then begin
- {not found, store it}
- with CmdRec, Writer do begin
- WriteInteger(Keys);
- WriteInteger(Cmd);
- end;
- end;
- end;
- end;
-
-begin
- Writer.WriteString(FTableName);
- Writer.WriteBoolean(FActive);
- Writer.WriteListBegin;
-
- {if this is the default command table, don't store command if not changed}
- if CompareText(GetOrphStr(SCDefaultTableName), FTableName) = 0 then
- {if this is the "default" command table, don't store commands if not changed}
- CompareAndWriteTable(DefCommandTable)
- else if CompareText(GetOrphStr(SCWordStarTableName), FTableName) = 0 then
- {if this is the "wordstar" command table, don't store commands if not changed}
- CompareAndWriteTable(DefWsCommandTable)
- else if CompareText(GetOrphStr(SCGridTableName), FTableName) = 0 then
- {if this is the "grid" command table, don't store commands if not changed}
- CompareAndWriteTable(DefGridCommandTable)
- else begin
- {otherwise, save the complete table}
- for I := 0 to Count - 1 do begin
- CmdRec := GetCmdRec(I);
- with CmdRec, Writer do begin
- WriteInteger(Keys);
- WriteInteger(Cmd);
- end;
- end;
- end;
-
- Writer.WriteListEnd;
-end;
-
-procedure TOvcCommandTable.DefineProperties(Filer : TFiler);
-begin
- inherited DefineProperties(Filer);
- Filer.DefineProperty('CommandList', ctReadData, ctWriteData, Count > 0);
-end;
-
-procedure TOvcCommandTable.Delete(Index : Integer);
-begin
- ctDisposeCommandEntry(FCommandList[Index]);
- FCommandList.Delete(Index);
-end;
-
-destructor TOvcCommandTable.Destroy;
-begin
- Clear;
- FCommandList.Free;
- FCommandList := nil;
-
- inherited Destroy;
-end;
-
-procedure TOvcCommandTable.Exchange(Index1, Index2 : Integer);
-begin
- FCommandList.Exchange(Index1, Index2);
-end;
-
-function TOvcCommandTable.GetCmdRec(Index : Integer) : TOvcCmdRec;
-begin
- Result := POvcCmdRec(FCommandList[Index])^;
-end;
-
-function TOvcCommandTable.GetCount : Integer;
-begin
- Result := FCommandList.Count;
-end;
-
-function TOvcCommandTable.IndexOf(const CmdRec : TOvcCmdRec) : Integer;
-begin
- for Result := 0 to GetCount - 1 do
- if CmdRec.Keys = GetCmdRec(Result).Keys then
- Exit;
- Result := -1;
-end;
-
-procedure TOvcCommandTable.InsertRec(Index : Integer; const Cmdrec : TOvcCmdRec);
-begin
- FCommandList.Expand.Insert(Index, ctNewCommandEntry(CmdRec));
-end;
-
-procedure TOvcCommandTable.LoadFromFile(const FileName: string);
-var
- T : System.Text;
- CmdRec : TOvcCmdRec;
-begin
- Clear; {erase current contents of list}
- System.Assign(T, FileName);
- System.Reset(T);
- try {finally}
- ReadLn(T, FTableName); {get table name}
- while not Eof(T) do begin
- with CmdRec do ReadLn(T, Key1, SS1, Key2, SS2, Cmd);
- AddRec(CmdRec);
- end;
- finally
- System.Close(T);
- end;
-end;
-
-procedure TOvcCommandTable.Move(CurIndex, NewIndex : Integer);
-var
- CmdRec : TOvcCmdRec;
-begin
- if CurIndex <> NewIndex then begin
- CmdRec := GetCmdRec(CurIndex);
- Delete(CurIndex);
- InsertRec(NewIndex, CmdRec);
- end;
-end;
-
-procedure TOvcCommandTable.PutCmdRec(Index : Integer; const CmdRec : TOvcCmdRec);
-var
- P : POvcCmdRec;
-begin
- P := FCommandList[Index];
- try
- FCommandList[Index] := ctNewCommandEntry(CmdRec);
- finally
- ctDisposeCommandEntry(P);
- end;
-end;
-
-procedure TOvcCommandTable.SaveToFile(const FileName: string);
-var
- T : System.Text;
- I : Integer;
- CmdRec : TOvcCmdRec;
-begin
- System.Assign(T, FileName);
- System.Rewrite(T);
- try {finally}
- System.WriteLn(T, FTableName); {save the table name}
- for I := 0 to Count-1 do begin
- CmdRec := GetCmdRec(I);
- with CmdRec do
- System.WriteLn(T, Key1:4, SS1:4, Key2:4, SS2:4, Cmd:6);
- end;
- finally
- System.Close(T);
- end;
-end;
-
-
-{*** TCommandProcessor ***}
-
-procedure TOvcCommandProcessor.Add(CT : TOvcCommandTable);
- {-add a command table to the list of tables}
-var
- I : Integer;
- Base : string;
- Name : string;
-begin
- {make sure the table name is unique}
- I := 0;
-
- Base := CT.TableName;
-
- {remove trailing numbers from the name, forming the base name}
- while (Length(Base) > 1) and (Base[Length(Base)] in ['0'..'9']) do
- {$IFOPT H+}
- SetLength(Base, Length(Base)-1);
- {$ELSE}
- Dec(Byte(Base[0]));
- {$ENDIF}
-
- Name := Base;
-
- {keep appending numbers until we find a unique name}
- while GetCommandTable(Name) <> nil do begin
- Inc(I);
- Name := Base + Format('%d', [I]);
- end;
- if I > 0 then
- CT.TableName := Name;
-
- {add table to the list}
- FTableList.Add(CT);
-end;
-
-procedure TOvcCommandProcessor.AddCommand(const TableName: string;
- Key1, ShiftState1,
- Key2, ShiftState2 : Byte;
- Command : Word);
- {-add a command and key sequence to the command table}
-var
- CmdRec : TOvcCmdRec;
-begin
- {fill temp command record}
- CmdRec := cpFillCommandRec(Key1, ShiftState1, Key2, ShiftState2, Command);
- {add the command}
- AddCommandRec(TableName, CmdRec);
-end;
-
-procedure TOvcCommandProcessor.AddCommandRec(const TableName: string; const CmdRec : TOvcCmdRec);
- {-add a command record to the command table}
-var
- TmpTbl : TOvcCommandTable;
-begin
- {get the command table pointer}
- TmpTbl := GetCommandTable(TableName);
- if Assigned(TmpTbl) then begin
- {does this key sequence conflict with any others}
- if TmpTbl.IndexOf(CmdRec) = -1 then
- {add the new command-key sequence}
- TmpTbl.AddRec(CmdRec)
- else
- raise EDuplicateCommand.Create;
- end else
- raise ETableNotFound.Create;
-end;
-
-procedure TOvcCommandProcessor.ChangeTableName(const OldName, NewName: string);
- {-change the name of a table}
-var
- TmpTbl : TOvcCommandTable;
-begin
- TmpTbl := GetCommandTable(OldName);
- if Assigned(TmpTbl) then
- TmpTbl.TableName := NewName
- else
- raise ETableNotFound.Create;
-end;
-
-procedure TOvcCommandProcessor.Clear;
- {-delete all tables from the list}
-var
- I : Integer;
-begin
- {dispose of all command tables in the list}
- for I := 0 to Count - 1 do
- TOvcCommandTable(FTableList[I]).Free;
- {clear the list entries}
- FTableList.Clear;
-end;
-
-function TOvcCommandProcessor.cpFillCommandRec(Key1, ShiftState1,
- Key2, ShiftState2 : Byte;
- Command : Word) : TOvcCmdRec;
- {-fill a command record}
-begin
- Result.Key1 := Key1;
- Result.SS1 := ShiftState1;
- Result.Key2 := Key2;
- Result.SS2 := ShiftState2;
- Result.Cmd := Command;
-end;
-
-procedure TOvcCommandProcessor.cpReadData(Reader : TReader);
-var
- TmpTbl : TOvcCommandTable;
-begin
- {empty current table list}
- Clear;
- {read the start of list marker}
- Reader.ReadListBegin;
- while not Reader.EndOfList do begin
- {create a command table}
- TmpTbl := TOvcCommandTable.Create;
- {load commands into the table}
- TmpTbl.ctReadData(Reader);
- {add the new table to the table list}
- Add(TmpTbl);
- end;
- {read the end of list marker}
- Reader.ReadListEnd;
-end;
-
-function TOvcCommandProcessor.cpScanTable(CT : TOvcCommandTable; Key, SFlags : Byte) : Word;
- {-Scan the command table for a match}
-var
- J : Integer;
-begin
- {assume failed match}
- Result := ccNone;
-
- {scan the list of commands looking for a match}
- for J := 0 to CT.Count-1 do with CT[J] do begin
-
- {do we already have a partial command}
- if cpState = stPartial then begin
- {does first key/shift state match the saved key/shift state?}
- if (Key1 = cpSaveKey) and (SS1 = cpSaveSS) then
- {does the key match?}
- if (Key2 = Key) then
- {does the shift state match?}
- {or, is this the second key of a wordstar command}
- if (SS2 = SFlags) or ((SS2 = ss_Wordstar) and
- ((SFlags = ss_None) or (SFlags = ss_Ctrl))) then begin
- Result := Cmd; {return the command}
- {if the command is ccCtrlChar, next key is literal}
- if Cmd = ccCtrlChar then
- cpState := stLiteral
- else
- cpState := stNone;
- Exit;
- end;
- end else if (Key1 = Key) and (SS1 = SFlags) then begin
- {we have an initial key match}
- if Key2 = 0 then begin
- {no second key}
- Result := Cmd; {return the command}
- {if the command is ccCtrlChar, next key is literal}
- if Cmd = ccCtrlChar then
- cpState := stLiteral;
- Exit;
- end else begin
- {it's a partial command}
- Result := ccPartial;
- cpState := stPartial;
-
- {save the key and shift state}
- cpSaveKey := Key;
- cpSaveSS := SFlags;
- Exit;
- end;
- end;
-
- end;
-end;
-
-procedure TOvcCommandProcessor.cpWriteData(Writer: TWriter);
-var
- I : Integer;
-begin
- {write the start of list marker}
- Writer.WriteListBegin;
- {have each table write itself}
- for I := 0 to Count - 1 do
- TOvcCommandTable(FTableList[I]).ctWriteData(Writer);
- {write the end of list marker}
- Writer.WriteListEnd;
-end;
-
-constructor TOvcCommandProcessor.Create;
-var
- I : Integer;
- S : string;
-begin
- inherited Create;
-
- {create an empty command table list}
- FTableList := TList.Create;
-
- {create and fill the default command table}
- S := GetOrphStr(SCDefaultTableName);
- CreateCommandTable(S, True {active});
- for I := 0 to High(DefCommandTable) do
- AddCommandRec(S, DefCommandTable[I]);
-
- {create and fill the WordStar command table}
- S := GetOrphStr(SCWordStarTableName);
- CreateCommandTable(S, False {not active});
- for I := 0 to DefWsMaxCommands-1 do
- AddCommandRec(S, DefWsCommandTable[I]);
-
- {create and fill the table(grid) command table}
- S := GetOrphStr(SCGridTableName);
- CreateCommandTable(S, False {not active});
- for I := 0 to DefGridMaxCommands-1 do
- AddCommandRec(S, DefGridCommandTable[I]);
-
- ResetCommandProcessor;
-end;
-
-function TOvcCommandProcessor.CreateCommandTable(const TableName : string; Active : Boolean) : Integer;
- {-create a command table and add it to the table list}
-var
- TmpTbl : TOvcCommandTable;
-begin
- TmpTbl := TOvcCommandTable.Create;
- TmpTbl.TableName := TableName;
- TmpTbl.IsActive := Active;
- Add(TmpTbl);
- Result := FTableList.IndexOf(TmpTbl);
-end;
-
-procedure TOvcCommandProcessor.DefineProperties(Filer: TFiler);
-begin
- inherited DefineProperties(Filer);
- Filer.DefineProperty('TableList', cpReadData, cpWriteData, Count > 0);
-end;
-
-procedure TOvcCommandProcessor.Delete(Index : Integer);
- {-delete the "Index" table from the list of tables}
-begin
- if (Index >= 0) and (Index < Count) then begin
- {delete the command table}
- TOvcCommandTable(FTableList[Index]).Free;
- {remove it from the list}
- FTableList.Delete(Index);
- end else
- raise ETableNotFound.Create;
-end;
-
-procedure TOvcCommandProcessor.DeleteCommand(const TableName: string;
- Key1, ShiftState1,
- Key2, ShiftState2 : Byte);
-var
- I : Integer;
- CmdRec : TOvcCmdRec;
- TmpTbl : TOvcCommandTable;
-begin
- {get the command table pointer}
- TmpTbl := GetCommandTable(TableName);
- if Assigned(TmpTbl) then begin
- {fill temp command record}
- CmdRec := cpFillCommandRec(Key1, ShiftState1, Key2, ShiftState2, 0);
- {find index of entry}
- I := TmpTbl.IndexOf(CmdRec);
- {if found, delete it -- no error if not found}
- if I > -1 then
- TmpTbl.Delete(I);
- end else
- raise ETableNotFound.Create;
-end;
-
-procedure TOvcCommandProcessor.DeleteCommandTable(const TableName : string);
- {-delete a command table and remove from the table list}
-var
- I : Integer;
- TmpTbl : TOvcCommandTable;
-begin
- TmpTbl := GetCommandTable(TableName);;
- if Assigned(TmpTbl) then begin
- I := FTableList.IndexOf(TmpTbl);
- Delete(I);
- end else
- raise ETableNotFound.Create;
-end;
-
-destructor TOvcCommandProcessor.Destroy;
-begin
- if Assigned(FTableList) then begin
- Clear;
- FTableList.Free;
- end;
- inherited Destroy;
-end;
-
-procedure TOvcCommandProcessor.Exchange(Index1, Index2 : Integer);
- {-exchange list locations of the two specified command tables}
-begin
- FTableList.Exchange(Index1, Index2);
-end;
-
-function TOvcCommandProcessor.GetTable(Index : Integer) : TOvcCommandTable;
- {-return the table referenced by "Index"}
-begin
- Result := TOvcCommandTable(FTableList[Index]);
-end;
-
-function TOvcCommandProcessor.GetCommandCount(const TableName : string) : Integer;
- {-return the number of commands in the command table}
-var
- TmpTbl : TOvcCommandTable;
-begin
- {get the command table pointer}
- TmpTbl := GetCommandTable(TableName);
- if Assigned(TmpTbl) then
- Result := TmpTbl.Count
- else
- raise ETableNotFound.Create;
-end;
-
-function TOvcCommandProcessor.GetCommandTable(const TableName : string) : TOvcCommandTable;
- {-return a pointer to the specified command table or nil}
-var
- I : Integer;
-begin
- Result := nil;
- for I := 0 To Count-1 do
- if AnsiUpperCase(TOvcCommandTable(FTableList[I]).TableName)
- = AnsiUpperCase(TableName) then
- begin
- Result := FTableList[I];
- Break;
- end;
-end;
-
-function TOvcCommandProcessor.GetCommandTableIndex(const TableName : string) : Integer;
- {-return index to the specified command table or -1 for failure}
-var
- I : Integer;
-begin
- Result := -1;
- for I := 0 To Count-1 do
- if AnsiUpperCase(TOvcCommandTable(FTableList[I]).TableName)
- = AnsiUpperCase(TableName) then
- begin
- Result := I;
- Break;
- end;
-end;
-
-function TOvcCommandProcessor.GetCount : Integer;
- {-return the number of tables in the list}
-begin
- Result := FTableList.Count;
-end;
-
-procedure TOvcCommandProcessor.GetState(var State : TOvcProcessorState; var Key, Shift : Byte);
-begin
- State := cpState;
- Key := cpSaveKey;
- Shift := cpSaveSS;
-end;
-
-function TOvcCommandProcessor.LoadCommandTable(const FileName : string) : Integer;
- {-creates and then fills a command table from a text file}
-var
- TmpTbl : TOvcCommandTable;
-begin
- TmpTbl := TOvcCommandTable.Create;
- try
- TmpTbl.LoadFromFile(FileName);
- Add(TmpTbl);
- Result := FTableList.IndexOf(TmpTbl);
- except
- TmpTbl.Free;
- raise;
- end;
-end;
-
-procedure TOvcCommandProcessor.ResetCommandProcessor;
- {-reset the command processor}
-begin
- cpState := stNone;
- cpSaveKey := VK_NONE;
- cpSaveSS := 0;
-end;
-
-procedure TOvcCommandProcessor.SaveCommandTable(const TableName, FileName : string);
- {-save a command table to a text file}
-var
- TmpTbl : TOvcCommandTable;
-begin
- TmpTbl := GetCommandTable(TableName);
- if Assigned(TmpTbl) then
- TmpTbl.SaveToFile(FileName);
-end;
-
-procedure TOvcCommandProcessor.SetScanPriority(const Names : array of string);
- {-reorder the list of tables based on this array}
-var
- I : Integer;
- Idx : Integer;
- TmpTbl : TOvcCommandTable;
-begin
- for I := 0 to Pred(High(Names)) do begin
- TmpTbl := GetCommandTable(Names[I]);
- if Assigned(TmpTbl) then begin
- Idx := FTableList.IndexOf(TmpTbl);
- if (Idx > -1) and (Idx <> I) then
- Exchange(I, Idx);
- end;
- end;
-end;
-
-procedure TOvcCommandProcessor.SetTable(Index : Integer; CT : TOvcCommandTable);
- {-store a command table at position "Index"}
-var
- P : TOvcCommandTable;
-begin
- if (Index >= 0) and (Index < Count) then begin
- P := FTableList[Index];
- FTableList[Index] := CT;
- P.Free;
- end else
- raise ETableNotFound.Create;
-end;
-
-procedure TOvcCommandProcessor.SetState(State : TOvcProcessorState; Key, Shift : Byte);
-begin
- cpState := State;
- cpSaveKey := Key;
- cpSaveSS := Shift;
-end;
-
-function TOvcCommandProcessor.Translate(var Msg : TMessage) : Word;
- {-translate a message into a command}
-var
- Command : Word;
- I : Integer;
- K : Byte; {message key code}
- SS : Byte; {shift flags}
-begin
- {accept the key if no match found}
- Result := ccAccept;
-
- {check for shift state keys, note partial status and exit}
- K := Lo(Msg.wParam);
- case K of
- VK_SHIFT, {shift}
- VK_CONTROL, {ctrl}
- VK_ALT, {alt}
- VK_CAPITAL, {caps lock}
- VK_NUMLOCK, {num lock}
- VK_SCROLL : {scroll lock}
- begin
- {if we had a partial command before, we still do}
- if cpState = stPartial then
- Result := ccPartial;
- Exit;
- end;
- end;
-
- {exit if this key is to be interpreted literally}
- if cpState = stLiteral then begin
- cpState := stNone;
- Exit;
- end;
-
- {get the current shift flags}
- SS := GetShiftFlags;
-
- Command := ccNone;
- for I := 0 to Count-1 do
- if TOvcCommandTable(FTableList[I]).IsActive then begin
- Command := cpScanTable(FTableList[I], K, SS);
- if Command <> ccNone then
- Break;
- end;
-
- {if we found a match, return command and exit}
- if Command <> ccNone then begin
- Result := Command;
- Exit;
- end;
-
- {if we had a partial command, suppress this key}
- if cpState = stPartial then
- Result:= ccSuppress;
-
- cpState := stNone;
-end;
-
-function TOvcCommandProcessor.TranslateKey(Key : Word; ShiftState : TShiftState) : Word;
- {-translate a key and shift-state into a command}
-var
- Command : Word;
- I : Integer;
- SS : Byte; {shift flags}
-begin
- {accept the key if no match found}
- Result := ccAccept;
-
- {check for shift state keys, note partial status and exit}
- case Key of
- VK_SHIFT, {shift}
- VK_CONTROL, {ctrl}
- VK_ALT, {alt}
- VK_CAPITAL, {caps lock}
- VK_NUMLOCK, {num lock}
- VK_SCROLL : {scroll lock}
- begin
- {if we had a partial command before, we still do}
- if cpState = stPartial then
- Result := ccPartial;
- Exit;
- end;
- end;
-
- {exit if this key is to be interpreted literally}
- if cpState = stLiteral then begin
- cpState := stNone;
- Exit;
- end;
-
- {get the current shift flags}
- SS := (Ord(ssCtrl in ShiftState) * ss_Ctrl) +
- (Ord(ssShift in ShiftState) * ss_Shift) +
- (Ord(ssAlt in ShiftState) * ss_Alt);
-
- Command := ccNone;
- for I := 0 to Count-1 do
- if TOvcCommandTable(FTableList[I]).IsActive then begin
- Command := cpScanTable(FTableList[I], Key, SS);
- if Command <> ccNone then
- Break;
- end;
-
- {if we found a match, return command and exit}
- if Command <> ccNone then begin
- Result := Command;
- Exit;
- end;
-
- {if we had a partial command, suppress this key}
- if cpState = stPartial then
- Result:= ccSuppress;
-
- cpState := stNone;
-end;
-
-function TOvcCommandProcessor.TranslateUsing(const Tables : array of string; var Msg : TMessage) : Word;
- {-translate a message into a command using the given tables}
-var
- TmpTbl : TOvcCommandTable;
- Command : Word;
- I : Integer;
- K : Byte; {message key code}
- SS : Byte; {shift flags}
-begin
- {accept the key if no match found}
- Result := ccAccept;
-
- {check for shift state keys, note partial status and exit}
- K := Lo(Msg.wParam);
- case K of
- VK_SHIFT, {shift}
- VK_CONTROL, {ctrl}
- VK_ALT, {alt}
- VK_CAPITAL, {caps lock}
- VK_NUMLOCK, {num lock}
- VK_SCROLL : {scroll lock}
- begin
- {if we had a partial command before, we still do}
- if cpState = stPartial then
- Result := ccPartial;
- Exit;
- end;
- end;
-
- {get out if this key is to be interpreted literally}
- if cpState = stLiteral then begin
- cpState := stNone;
- Exit;
- end;
-
- {get the current shift flags}
- SS := GetShiftFlags;
-
- Command := ccNone;
- for I := 0 to High(Tables) do begin
- TmpTbl := GetCommandTable(Tables[I]);
- if Assigned(TmpTbl) then begin
- Command := cpScanTable(TmpTbl, K, SS);
- if Command <> ccNone then
- Break;
- end;
- end;
-
- {if we found a match, return command and exit}
- if Command <> ccNone then begin
- Result := Command;
- Exit;
- end;
-
- {if we had a partial command, suppress this key}
- if cpState = stPartial then
- Result:= ccSuppress;
-
- cpState := stNone;
-end;
-
-function TOvcCommandProcessor.TranslateKeyUsing(const Tables : array of string; Key : Word; ShiftState : TShiftState) : Word;
- {-translate a Key and shift-state into a command using the given tables}
-var
- TmpTbl : TOvcCommandTable;
- Command : Word;
- I : Integer;
- SS : Byte; {shift flags}
-begin
- {accept the key if no match found}
- Result := ccAccept;
-
- {check for shift state keys, note partial status and exit}
- case Key of
- VK_SHIFT, {shift}
- VK_CONTROL, {ctrl}
- VK_ALT, {alt}
- VK_CAPITAL, {caps lock}
- VK_NUMLOCK, {num lock}
- VK_SCROLL : {scroll lock}
- begin
- {if we had a partial command before, we still do}
- if cpState = stPartial then
- Result := ccPartial;
- Exit;
- end;
- end;
-
- {get out if this key is to be interpreted literally}
- if cpState = stLiteral then begin
- cpState := stNone;
- Exit;
- end;
-
- {get the shift flags}
- SS := (Ord(ssCtrl in ShiftState) * ss_Ctrl) +
- (Ord(ssShift in ShiftState) * ss_Shift) +
- (Ord(ssAlt in ShiftState) * ss_Alt);
-
- Command := ccNone;
- for I := 0 to High(Tables) do begin
- TmpTbl := GetCommandTable(Tables[I]);
- if Assigned(TmpTbl) then begin
- Command := cpScanTable(TmpTbl, Key, SS);
- if Command <> ccNone then
- Break;
- end;
- end;
-
- {if we found a match, return command and exit}
- if Command <> ccNone then begin
- Result := Command;
- Exit;
- end;
-
- {if we had a partial command, suppress this key}
- if cpState = stPartial then
- Result:= ccSuppress;
-
- cpState := stNone;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/91/91134bcdf617bc5d81a6d11b985caab6a219b44f.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/91/91134bcdf617bc5d81a6d11b985caab6a219b44f.svn-base
deleted file mode 100644
index 3fb43a46..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/91/91134bcdf617bc5d81a6d11b985caab6a219b44f.svn-base
+++ /dev/null
@@ -1,36 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, ovcbase, ovcrlbl;
-
-type
- TForm1 = class(TForm)
- OvcRotatedLabel1: TOvcRotatedLabel;
- OvcRotatedLabel2: TOvcRotatedLabel;
- OvcRotatedLabel3: TOvcRotatedLabel;
- OvcRotatedLabel4: TOvcRotatedLabel;
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.dfm}
-{$ENDIF}
-
-initialization
-{$IFDEF LCL}
-{$I Unit1.lrs} {Include form's resource file}
-{$ENDIF}
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/92/9281ac76eee8edaeaac05d973e756be3f333c6ef.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/92/9281ac76eee8edaeaac05d973e756be3f333c6ef.svn-base
deleted file mode 100644
index bd33a701..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/92/9281ac76eee8edaeaac05d973e756be3f333c6ef.svn-base
+++ /dev/null
@@ -1,604 +0,0 @@
-{*********************************************************}
-{* OVCCONST.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 ovcconst;
- {-Command and resource constants}
-
-interface
-
-const
- {value used to offset string resource id's}
- BaseOffset = 32768; {***}
-
-const
- {constants for exception messages}
- SCUnknownError = 30168;
- SCDuplicateCommand = 30169;
- SCTableNotFound = 30170;
- SCNotDoneYet = 30171;
- SCNoControllerAssigned = 30172;
- SCCantCreateCommandTable = 30173;
- SCCantDelete = 30174;
- SCInvalidKeySequence = 30175;
- SCNotWordStarCommands = 30176;
- SCNoCommandSelected = 30177;
- SCDuplicateKeySequence = 30178;
- SCRangeError = 30179;
- SCInvalidNumber = 30180;
- SCRequiredField = 30181;
- SCInvalidDate = 30182;
- SCInvalidTime = 30183;
- SCBlanksInField = 30184;
- SCPartialEntry = 30185;
- SCRegionTooLarge = 30186;
- SCOutOfMemoryForCopy = 30187;
- SCInvalidParamValue = 30188;
- SCNoTimersAvail = 30189;
- SCTooManyEvents = 30190;
- SCBadTriggerHandle = 30191;
- SCOnSelectNotAssigned = 30192;
- SCInvalidPageIndex = 30193;
- SCInvalidDataType = 30194;
- SCInvalidTabFont = 30195;
- SCInvalidLabelFont = 30196;
- SCOutOfMemory = 30197;
- SCTooManyParas = 30198;
- SCCannotJoin = 30199;
- SCTooManyBytes = 30200;
- SCParaTooLong = 30201;
- SCInvalidPictureMask = 30202;
- SCInvalidRange = 30203;
- SCInvalidRealRange = 30204;
- SCInvalidExtendedRange = 30205;
- SCInvalidDoubleRange = 30206;
- SCInvalidSingleRange = 30207;
- SCInvalidCompRange = 30208;
- SCInvalidDateRange = 30209;
- SCInvalidTimeRange = 30210;
- SCInvalidRangeValue = 30211;
- SCRangeNotSupported = 30212;
- SCInvalidLineOrParaIndex = 30213;
- SCNonFixedFont = 30214;
- SCInvalidFontParam = 30215;
- SCInvalidLineOrColumn = 30216;
- SCSAEGeneral = 30217;
- SCSAEAtMaxSize = 30218;
- SCSAEOutOfBounds = 30219;
- SCInvalidXMLFile = 30220;
- SCUnterminatedElement = 30221;
- SCBadColorConst = 30222;
- SCBadColorValue = 30223;
- SCInvalidFieldType = 30224;
- SCBadAlarmHandle = 30225;
- SCOnIsSelectedNotAssigned= 30226;
- SCInvalidDateForMask = 30227;
- SCNoTableAttached = 30228;
- SCViewerIOError = 30232;
- SCViewerFileNotFound = 30233;
- SCViewerPathNotFound = 30234;
- SCViewerTooManyOpenFiles = 30235;
- SCViewerFileAccessDenied = 30236;
- SCControlAttached = 30237;
- SCCantEdit = 30238;
- SCChildTableError = 30239;
- SCNoCollection = 30241;
- SCNotOvcDescendant = 30242;
- SCItemIncompatible = 30243;
- SCLabelNotAttached = 30244;
- SCClassNotSet = 30245;
- SCCollectionNotFound = 30246;
- SCDayConvertError = 30247;
- SCMonthConvertError = 30248;
- SCMonthNameConvertError = 30249;
- SCYearConvertError = 30250;
- SCDayRequired = 30251;
- SCMonthRequired = 30252;
- SCYearRequired = 30253;
- SCInvalidDay = 30254;
- SCInvalidMonth = 30255;
- SCInvalidMonthName = 30256;
- SCInvalidYear = 30257;
- SCTableRowOutOfBounds = 30258;
- SCTableMaxRows = 30259;
- SCTableMaxColumns = 30260;
- SCTableGeneral = 30261;
- SCTableToManyColumns = 30262;
- SCTableInvalidFieldIndex = 30263;
- SCTableHeaderNotAssigned = 30264;
- SCTableInvalidHeaderCell = 30265;
- SCGridTableName = 30266;
- {general constants for string table resource entries}
- SCNoneStr = 30268;
- SCccUser = 30269;
- SCccUserNum = 30270;
- SCDeleteTable = 30271;
- SCRenameTable = 30272;
- SCEnterTableName = 30273;
- SCNewTable = 30274;
- SCDefaultTableName = 30275;
- SCWordStarTableName = 30276;
- SCUnknownTable = 30277;
- SCDefaultEntryErrorText = 30278;
- SCGotItemWarning = 30279;
- SCSampleListItem = 30280;
- SCAlphaString = 30281;
- SCTallLowChars = 30282;
- SCDefault = 30283;
- SCDescending = 30285;
- SCDefaultIndex = 30286;
- SCRestoreMI = 30287;
- SCCutMI = 30288;
- SCCopyMI = 30289;
- SCPasteMI = 30290;
- SCDeleteMI = 30291;
- SCSelectAllMI = 30292;
- SCCalcBack = 30293;
- SCCalcMC = 30294;
- SCCalcMR = 30295;
- SCCalcMS = 30296;
- SCCalcMPlus = 30297;
- SCCalcMMinus = 30298;
- SCCalcCT = 30299;
- SCCalcCE = 30300;
- SCCalcC = 30301;
- SCCalcSqrt = 30302;
- SCCalNext = 30303;
- SCCalLast = 30304;
- SCCalFirst = 30305;
- SCCal1st = 30306;
- SCCalSecond = 30307;
- SCCal2nd = 30308;
- SCCalThird = 30309;
- SCCal3rd = 30310;
- SCCalFourth = 30311;
- SCCal4th = 30312;
- SCCalFinal = 30313;
- SCCalBOM = 30314;
- SCCalEnd = 30315;
- SCCalEOM = 30316;
- SCCalYesterday = 30317;
- SCCalToday = 30318;
- SCCalTomorrow = 30319;
- SCEditingSections = 30320;
- SCEditingItems = 30321;
- SCEditingFolders = 30322;
- SCEditingPages = 30323;
- SCEditingImages = 30324;
- SCSectionBaseName = 30325;
- SCItemBaseName = 30326;
- SCFolderBaseName = 30327;
- SCPageBaseName = 30328;
- SCImageBaseName = 30329;
- SCOwnerMustBeForm = 30330;
- SCTimeConvertError = 30331;
- SCCancelQuery = 30332;
- SCNoPagesAssigned = 30333;
- SCCalPrev = 30334;
- SCCalBegin = 30335;
- SCInvalidMinMaxValue = 30336;
- SCFormUseOnly = 30337;
-
- {misc constant values}
- SCYes = 30368;
- SCNo = 30369;
- SCTrue = 30370;
- SCFalse = 30371;
- SCHoursName = 30372;
- SCMinutesName = 30373;
- SCSecondsName = 30374;
- SCCloseCaption = 30375;
-
- {report view exceptions}
- SCViewFieldNotFound = 30376;
- SCCantResolveField = 30377;
- SCItemAlreadyExists = 30378;
- SCAlreadyInTempMode = 30379;
- SCItemNotFound = 30380;
- SCUpdatePending = 30381;
- SCOnCompareNotAssigned = 30382;
- SCOnFilterNotAssigned = 30383;
- SCGetAsFloatNotAssigned = 30384;
- SCNotInTempMode = 30385;
- SCItemNotInIndex = 30387;
- SCNoActiveView = 30388;
- SCItemIsNotGroup = 30389;
- SCNotMultiSelect = 30390;
- SCLineNoOutOfRange = 30391;
- SCUnknownView = 30392;
- SCOnKeySearchNotAssigned = 30393;
- SCOnEnumNotAssigned = 30394;
- SCOnEnumSelectedNA = 30395;
-
- {MRU list exceptions }
- SCNoMenuAssigned = 30400;
- SCNoAnchorAssigned = 30401;
- SCInvalidParameter = 30402;
- SCInvalidOperation = 30403;
-
- SCColorBlack = 30500;
- SCColorMaroon = 30501;
- SCColorGreen = 30502;
- SCColorOlive = 30503;
- SCColorNavy = 30504;
- SCColorPurple = 30505;
- SCColorTeal = 30506;
- SCColorGray = 30507;
- SCColorSilver = 30508;
- SCColorRed = 30509;
- SCColorLime = 30510;
- SCColorYellow = 30511;
- SCColorBlue = 30512;
- SCColorFuchsia = 30513;
- SCColorAqua = 30514;
- SCColorWhite = 30515;
- SCColorLightGray = 30516;
- SCColorMediumGray = 30517;
- SCColorDarkGray = 30518;
- SCColorMoneyGreen = 30519;
- SCColorSkyBlue = 30520;
- SCColorCream = 30521;
-
-const
- cHotKeyChar = '&'; {hotkey prefix character}
-
-const
- {offset for resource id's}
- CommandResOfs = BaseOffset + 1000; {***}
-
- {command codes - corresponding text offset by CommandOfs, stored in rc file}
- {*** must be contiguous ***}
- ccFirstCmd = 0; {first defined command}
- ccNone = 0; {no command or not a known command}
- ccBack = 1; {backspace one character}
- ccBotOfPage = 2; {move caret to end of last page}
- ccBotRightCell = 3; {move to the bottom right hand cell in a table}
- ccCompleteDate = 4; {use default date for current date sub field}
- ccCompleteTime = 5; {use default time for current time sub field}
- ccCopy = 6; {copy highlighted text to clipboard}
- ccCtrlChar = 7; {accept control character}
- ccCut = 8; {copy highlighted text to clipboard and delete it}
- ccDec = 9; {decrement the current entry field value}
- ccDel = 10; {delete current character}
- ccDelBol = 11; {delete from caret to beginning of line}
- ccDelEol = 12; {delete from caret to end of line}
- ccDelLine = 13; {delete entire line}
- ccDelWord = 14; {delete word to right of caret}
- ccDown = 15; {cursor down}
- ccEnd = 16; {caret to end of line}
- ccExtendDown = 17; {extend selection down one line}
- ccExtendEnd = 18; {extend highlight to end of field}
- ccExtendHome = 19; {extend highlight to start of field}
- ccExtendLeft = 20; {extend highlight left one character}
- ccExtendPgDn = 21; {extend selection down one page}
- ccExtendPgUp = 22; {extend selection up one page}
- ccExtendRight = 23; {extend highlight right one character}
- ccExtendUp = 24; {extend selection up one line}
- ccExtBotOfPage = 25; {extend selection to bottom of page}
- ccExtFirstPage = 26; {extend selection to first page}
- ccExtLastPage = 27; {extend selection to last page}
- ccExtTopOfPage = 28; {extend selection to top of page}
- ccExtWordLeft = 29; {extend highlight left one word}
- ccExtWordRight = 30; {extend highlight right one word}
- ccFirstPage = 31; {first page in table}
- ccGotoMarker0 = 32; {editor & viewer, go to a position marker}
- ccGotoMarker1 = 33; {editor & viewer, go to a position marker}
- ccGotoMarker2 = 34; {editor & viewer, go to a position marker}
- ccGotoMarker3 = 35; {editor & viewer, go to a position marker}
- ccGotoMarker4 = 36; {editor & viewer, go to a position marker}
- ccGotoMarker5 = 37; {editor & viewer, go to a position marker}
- ccGotoMarker6 = 38; {editor & viewer, go to a position marker}
- ccGotoMarker7 = 39; {editor & viewer, go to a position marker}
- ccGotoMarker8 = 40; {editor & viewer, go to a position marker}
- ccGotoMarker9 = 41; {editor & viewer, go to a position marker}
- ccHome = 42; {caret to beginning of line}
- ccInc = 43; {increment the current entry field value}
- ccIns = 44; {toggle insert mode}
- ccLastPage = 45; {last page in table}
- ccLeft = 46; {caret left by one character}
- ccNewLine = 47; {editor, create a new line}
- ccNextPage = 48; {next page in table}
- ccPageLeft = 49; {move left a page in the table}
- ccPageRight = 50; {move right a page in the table}
- ccPaste = 51; {paste text from clipboard}
- ccPrevPage = 52; {previous page in table}
- ccRedo = 53; {re-do the last undone operation}
- ccRestore = 54; {restore default and continue}
- ccRight = 55; {caret right by one character}
- ccScrollDown = 56; {editor, scroll page up one line}
- ccScrollUp = 57; {editor, scroll page down one line}
- ccSetMarker0 = 58; {editor & viewer, set a position marker}
- ccSetMarker1 = 59; {editor & viewer, set a position marker}
- ccSetMarker2 = 60; {editor & viewer, set a position marker}
- ccSetMarker3 = 61; {editor & viewer, set a position marker}
- ccSetMarker4 = 62; {editor & viewer, set a position marker}
- ccSetMarker5 = 63; {editor & viewer, set a position marker}
- ccSetMarker6 = 64; {editor & viewer, set a position marker}
- ccSetMarker7 = 65; {editor & viewer, set a position marker}
- ccSetMarker8 = 66; {editor & viewer, set a position marker}
- ccSetMarker9 = 67; {editor & viewer, set a position marker}
- ccTab = 68; {editor, for tab entry}
- ccTableEdit = 69; {enter/exit table edit mode}
- ccTopLeftCell = 70; {move to the top left cell in a table}
- ccTopOfPage = 71; {move caret to beginning of first page}
- ccUndo = 72; {undo last operation}
- ccUp = 73; {cursor up}
- ccWordLeft = 74; {caret left one word}
- ccWordRight = 75; {caret right one word}
-
- ccLastCmd = 75; {***} {last interfaced command}
-
- {internal}
- ccChar = 249; {regular character; generated internally}
- ccMouse = 250; {mouse selection; generated internally}
- ccMouseMove = 251; {mouse move; generated internally}
- ccAccept = 252; {accept next key; internal}
- ccDblClk = 253; {mouse double click; generated internally}
- ccSuppress = 254; {suppress next key; internal}
- ccPartial = 255; {partial command; internal}
-
- {user defined commands start here}
- ccUserFirst = 256;
- ccUser0 = ccUserFirst + 0;
- ccUser1 = ccUserFirst + 1;
- ccUser2 = ccUserFirst + 2;
- ccUser3 = ccUserFirst + 3;
- ccUser4 = ccUserFirst + 4;
- ccUser5 = ccUserFirst + 5;
- ccUser6 = ccUserFirst + 6;
- ccUser7 = ccUserFirst + 7;
- ccUser8 = ccUserFirst + 8;
- ccUser9 = ccUserFirst + 9;
- {... = ccUserFirst + 65535 - ccUserFirst}
-
-
-{data type base offset}
-const
- DataTypeOfs = BaseOffset + 1300; {***}
-
-{entry field data type sub codes}
-const
- fsubString = 0; {field subclass codes}
- fsubChar = 1;
- fsubBoolean = 2;
- fsubYesNo = 3;
- fsubLongInt = 4;
- fsubWord = 5;
- fsubInteger = 6;
- fsubByte = 7;
- fsubShortInt = 8;
- fsubReal = 9;
- fsubExtended = 10;
- fsubDouble = 11;
- fsubSingle = 12;
- fsubComp = 13;
- fsubDate = 14;
- fsubTime = 15;
-
-
-{constants for simple, picture, and numeric picture}
-{mask samples used in the property editors}
-const
- PictureMaskOfs = BaseOffset + 1700; {***}
-
- {simple field mask characters}
- stsmFirst = 34468;
- stsmLast = 34468 + 23;
-
- {numeric field picture masks}
- stnmFirst = 34493;
- stnmLast = 34493 + 17;
-
- {picture field picture masks}
- stpmFirst = 34518;
- stpmLast = 34518 + 23;
-
-const
-{String Resource Constants...}
-
-{Note: These should stay in numerical order. It's not as important here as it
- is in the O32SR.pas file's Lookup Array, but you should still keep it in
- mind when editing these values...}
-
- {String Resource Index Constants}
- IccNone = 33768;
- IccBack = 33769;
- IccBotOfPage = 33770;
- IccBotRightCell = 33771;
- IccCompleteDate = 33772;
- IccCompleteTime = 33773;
- IccCopy = 33774;
- IccCtrlChar = 33775;
- IccCut = 33776;
- IccDec = 33777;
- IccDel = 33778;
- IccDelBol = 33779;
- IccDelEol = 33780;
- IccDelLine = 33781;
- IccDelWord = 33782;
- IccDown = 33783;
- IccEnd = 33784;
- IccExtendDown = 33785;
- IccExtendEnd = 33786;
- IccExtendHome = 33787;
- IccExtendLeft = 33788;
- IccExtendPgDn = 33789;
- IccExtendPgUp = 33790;
- IccExtendRight = 33791;
- IccExtendUp = 33792;
- IccExtBotOfPage = 33793;
- IccExtFirstPage = 33794;
- IccExtLastPage = 33795;
- IccExtTopOfPage = 33796;
- IccExtWordLeft = 33797;
- IccExtWordRight = 33798;
- IccFirstPage = 33799;
- IccGotoMarker0 = 33800;
- IccGotoMarker1 = 33801;
- IccGotoMarker2 = 33802;
- IccGotoMarker3 = 33803;
- IccGotoMarker4 = 33804;
- IccGotoMarker5 = 33805;
- IccGotoMarker6 = 33806;
- IccGotoMarker7 = 33807;
- IccGotoMarker8 = 33808;
- IccGotoMarker9 = 33809;
- IccHome = 33810;
- IccInc = 33811;
- IccIns = 33812;
- IccLastPage = 33813;
- IccLeft = 33814;
- IccNewLine = 33815;
- IccNextPage = 33816;
- IccPageLeft = 33817;
- IccPageRight = 33818;
- IccPaste = 33819;
- IccPrevPage = 33820;
- IccRedo = 33821;
- IccRestore = 33822;
- IccRight = 33823;
- IccScrollDown = 33824;
- IccScrollUp = 33825;
- IccSetMarker0 = 33826;
- IccSetMarker1 = 33827;
- IccSetMarker2 = 33828;
- IccSetMarker3 = 33829;
- IccSetMarker4 = 33830;
- IccSetMarker5 = 33831;
- IccSetMarker6 = 33832;
- IccSetMarker7 = 33833;
- IccSetMarker8 = 33834;
- IccSetMarker9 = 33835;
- IccTab = 33836;
- IccTableEdit = 33837;
- IccTopLeftCell = 33838;
- IccTopOfPage = 33839;
- IccUndo = 33840;
- IccUp = 33841;
- IccWordLeft = 33842;
- IccWordRight = 33843;
-
- IString = 34068;
- IChar = 34069;
- IBoolean = 34070;
- IYesNo = 34071;
- ILongInt = 34072;
- IWord = 34073;
- ISmallInt = 34074;
- IByte = 34075;
- IShortInt = 34076;
- IReal = 34077;
- IExtended = 34078;
- IDouble = 34079;
- ISingle = 34080;
- IComp = 34081;
- IDate = 34082;
- ITime = 34083;
-
- {Character Masks}
- ICharMask1 = 34468;
- ICharMask2 = 34469;
- ICharMask3 = 34470;
- ICharMask4 = 34471;
- ICharMask5 = 34472;
- ICharMask6 = 34473;
- ICharMask7 = 34474;
- ICharMask8 = 34475;
- ICharMask9 = 34476;
- ICharMask10 = 34477;
- ICharMask11 = 34478;
- ICharMask12 = 34479;
- ICharMask13 = 34480;
- ICharMask14 = 34481;
- ICharMask15 = 34482;
- ICharMask16 = 34483;
- ICharMask17 = 34484;
- ICharMask18 = 34485;
- ICharMask19 = 34486;
- ICharMask20 = 34487;
- ICharMask21 = 34488;
- ICharMask22 = 34489;
- ICharMask23 = 34490;
- ICharMask24 = 34491;
-
- {Sample Field Masks }
- IFieldMask1 = 34493;
- IFieldMask2 = 34494;
- IFieldMask3 = 34495;
- IFieldMask4 = 34496;
- IFieldMask5 = 34497;
- IFieldMask6 = 34498;
- IFieldMask7 = 34499;
- IFieldMask8 = 34500;
- IFieldMask9 = 34501;
- IFieldMask10 = 34502;
- IFieldMask11 = 34503;
- IFieldMask12 = 34504;
- IFieldMask13 = 34505;
- IFieldMask14 = 34506;
- IFieldMask15 = 34507;
- IFieldMask16 = 34508;
- IFieldMask17 = 34509;
- IFieldMask18 = 34510;
-
- IFieldMask19 = 34518;
- IFieldMask20 = 34519;
- IFieldMask21 = 34520;
- IFieldMask22 = 34521;
- IFieldMask23 = 34522;
- IFieldMask24 = 34523;
- IFieldMask25 = 34524;
- IFieldMask26 = 34525;
- IFieldMask27 = 34526;
- IFieldMask28 = 34527;
- IFieldMask29 = 34528;
- IFieldMask30 = 34529;
- IFieldMask31 = 34530;
- IFieldMask32 = 34531;
- IFieldMask33 = 34532;
- IFieldMask34 = 34533;
- IFieldMask35 = 34534;
- IFieldMask36 = 34535;
- IFieldMask37 = 34536;
- IFieldMask38 = 34537;
- IFieldMask39 = 34538;
- IFieldMask40 = 34539;
- IFieldMask41 = 34540;
- IFieldMask42 = 34541;
-
-implementation
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/93/932fc33890e09d112b65137eb786c6f06e705015.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/93/932fc33890e09d112b65137eb786c6f06e705015.svn-base
deleted file mode 100644
index b5ab49f4..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/pristine/93/932fc33890e09d112b65137eb786c6f06e705015.svn-base and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/93/93fd8e0546efc8843913cf1e47803449e0174f8c.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/93/93fd8e0546efc8843913cf1e47803449e0174f8c.svn-base
deleted file mode 100644
index 6a1db435..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/93/93fd8e0546efc8843913cf1e47803449e0174f8c.svn-base
+++ /dev/null
@@ -1,1756 +0,0 @@
-LazarusResources.Add('TOVCCONTROLLER','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#0#0#0#128#128#0#0#0#0
- +#128#128#0#0#0#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#128#128#0#0#0#0#128#128#0#0
- +#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0
- +#0#0#0#255#0#0#255#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#0#0#0#0#0#0#128#128#0#0#0#0#128#128#0#0#0#0#0#0#0#128#128#0#128#128#0#128
- +#128#0#0#0#0#0#0#0#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#0#0#0
- +#0#0#0#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#0#0#0#0#0#0
- +#128#128#0#0#0#0#128#128#0#0#0#0#0#0#0#0#0#255#0#0#255#0#0#255#0#0#255#0#0
- +#255#0#0#0#0#0#0#0#0#0#0#0#255#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#0#0#0#0
- +#0#0#0#0#0#128#128#0#0#0#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#255#0#0#255#0
- +#0#255#0#0#255#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0
- +#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#128#128#0#128#128#0#0#0#0#0#0#0#0
- +#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#0#0#0#0#0#0#0#255#255#0#128#128#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0
- +#0#0#0#128#128#0#0#0#0#0#0#255#0#0#255#0#0#255#0#0#255#0#0#0#0#0#0#0#0#0#0#0
- +#0#128#128#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#255#0#0#255#0#0#255#0#0
- +#255#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0
- +#0#255#0#0#255#0#0#255#0#0#255#0#0#0#0#0#0#0#0#0#128#128#0#0#0#0#0#0#0#0#0#0
- +#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#0#0#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#0#0#255#0#0#255#0#0#255#0#0#255#0#0#0#0#0#0#0#0#0#128
- +#128#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#255#0#0#255#0
- +#0#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#255#0#0#255#0#0#255#0
- +#0#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0
- +#0#0#0#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0
- +#0#0#0#0#255#0#0#255#0#0#0#0#0#0#0#0#0#128#128#0#0#0#0#255#255#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#255#255#0#0#0#0#0#0#255#0#0#255#0#0#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#0#0#0#0#0#255#0#0#255#0#0#0#0#0#0#0#0#0#128#128#0
- +#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#255#0#0#255#0#0
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#255#0#0
- +#255#0#0#255#0#0#0#0#0#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#0
- +#0#0#0#0#0#255#255#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#0#0#255#0#0#255#0#0#0#0#0#0#0#0#0#128#128#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#255#255#255#0#0#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#255
- +#0#0#0#0#0#0#0#0#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#255#255#0#255#255#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#0#0#255#0#0#255#0#0#0#0#0#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#0#0#255#0#0#0#0#0#0#0#0#0#128#128#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#255#0#0#255#0#0#0#128#128#0#0#0#0#255#255#0#0#0#0#255
- +#255#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#255#0#0#0#0#0#0
- +#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#0#0#255#0#0#0#128#128
- +#0#128#128#0#255#255#0#0#0#0#255#255#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#0#0#255#0#0#0#0#0#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#255#0#0#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0#0#0#0#255#255#0
- +#128#128#0#255#255#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0
- +#255#0#0#0#0#0#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#255#0#0#255#0#0#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#255#0#0#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#255#0#0#255#0#0#255#0#0
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#0#0#255#0#0#255#0#0#255#0#0#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128
-]);
-LazarusResources.Add('TOVCTCSTRING','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0
- +#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0
- +#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0
- +#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255
- +#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0
- +#0#0#0#0#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255
- +#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0
- +#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255
- +#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255
- +#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#0#0
- +#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- ,#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255
- +#255#0#0#255#0#0#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0
-]);
-LazarusResources.Add('TOVCTCCOLHEAD','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0
- +#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#255#255#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0
- +#0#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255
- +#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#0#0#0#0#0#0#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255
- +#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255
- +#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255
- +#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#255#255#255#255
- +#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255
- +#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255
- +#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- ,#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255
- +#255#255#255#0#0#255#0#0#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0
-]);
-LazarusResources.Add('TOVCTCROWHEAD','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0
- +#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0
- +#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0
- +#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0
- +#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0
- +#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#0
- +#0#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#0#0#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0
- +#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255
- +#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255
- +#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0
- +#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255
- +#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255
- +#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#255#255
- +#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255
- +#255#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255
- +#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255
- ,#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255
- +#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0
-]);
-LazarusResources.Add('TOVCTCCOMBOBOX','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#0#0#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#0#0#192#192#192#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#192#192#192#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#0#0#192#192#192#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#192#192#192#0#0#0#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#192#192#192#192#192#192
- +#192#192#192#0#0#0#192#192#192#192#192#192#192#192#192#0#0#0#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#192#192#192
- +#192#192#192#0#0#0#0#0#0#0#0#0#192#192#192#192#192#192#0#0#0#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#192#192#192
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#192#192#192#0#0#0#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#192#192#192#192#192
- +#192#128#128#128#0#0#0#128#128#128#192#192#192#192#192#192#0#0#0#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#192
- +#192#192#192#192#192#128#128#128#0#0#0#128#128#128#192#192#192#192#192#192#0
- +#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#0#0#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#0#0#0#0
- +#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255
- +#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255
- +#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255
- +#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255
- +#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#0#0#255#0#0
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255
- ,#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#0#0
- +#255#0#0#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
-]);
-LazarusResources.Add('TOVCTCSIMPLEFIELD','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0
- +#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255
- +#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255
- +#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255
- +#0#0#0#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0#0
- +#0#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255
- +#255#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255
- +#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255
- +#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255
- +#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255
- +#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- ,#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255
- +#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0
-]);
-LazarusResources.Add('TOVCTCCHECKBOX','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#0#0#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#0#0#0#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#255#255#255#0#0#0#0#0#0
- +#255#255#255#0#0#0#0#0#0#255#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#255#255#255#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#255#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#0#0#255#255#255#255#255#255#0#0#0#192
- +#192#192#0#0#0#255#255#255#255#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#255#255#255#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#255#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#0#0#255#255#255#0#0#0#0#0#0#255#255#255
- +#0#0#0#0#0#0#255#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#0#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#0#0#255#0#0
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255
- +#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0
- +#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0
- +#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255
- +#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255
- +#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255
- +#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- ,#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255
- +#0#0#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#0#0#0#0#0#0
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
-]);
-LazarusResources.Add('TOVCTABLE','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#0#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#128
- +#0#128#128#0#128#128#0#128#128#0#0#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#0#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#0#128#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#0#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#0#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#0#128#0#128#128#0#128#128#0#128#128#0#0#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#0#128#0#0#128#0#128#128#0#0#128#0#0
- +#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#128
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#128#128
- +#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128
- +#128#128#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128
- +#128#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#128#128#128#128#128#128
- +#128#128#128#128#128#128#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0
- +#255#0#0#255#128#128#128#128#128#128#0#0#0#0#128#128#0#0#128#0#0#128#0#128
- +#128#0#0#128#0#0#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#0#255#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#0#255#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#0#255#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#0#255#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#128#128#128#128#128
- +#128#128#128#128#128#128#128#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255
- +#0#0#255#0#0#255#128#128#128#128#128#128#0#0#0#0#128#128#0#0#128#0#0#128#0
- +#128#128#0#0#128#0#0#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128
- +#128#0#128#128#128#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#128#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128
- +#128#0#128#128#0#128#128#128#128#128#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#128#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#0#0#0#0#128#128#0#0#128#0#0#128#0#128#128#0#0#128#0#0#128#0#128
- +#128#0#128#128#0#0#0#255#0#0#255#0#0#255#0#0#255#0#0#128#128#128#255#0#0#255
- +#0#0#255#0#0#255#0#0#255#0#0#255#0#0#128#128#128#255#0#0#255#0#0#0#0#0#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#0#0#255#0#0#255#0#0#255#0#0#255#0#0#128#128#128#255#0#0#255#0#0#255#0#0#255
- ,#0#0#255#0#0#255#0#0#128#128#128#255#0#0#255#0#0#0#0#0#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#128#128#0#0#128#0#0#128#0#128#128#0#0#128#0#0#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128
-]);
-LazarusResources.Add('TOVCURL','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128#0#0#0#0#0#0#0#0#0#0#0#0#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#0#0#0#192#192#192#255#255#255#192#192#192#255#255#255#0#0#0#255#255
- +#255#192#192#192#255#255#255#192#192#192#0#0#0#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#0#0#0#192#192#192#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#192#192#192#0#0#0#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#0#0#0#255#255#255#0#0#0#128#128#128#0#0
- +#0#192#192#192#192#192#192#192#192#192#0#0#0#128#128#128#0#0#0#255#255#255#0
- +#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#0#0#0#192#192
- +#192#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#192#192#192#0#0#0
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#0#0#0#128#0#0#0#0#0#192#192#192
- +#255#255#255#192#192#192#255#255#255#0#0#0#255#255#255#192#192#192#255#255
- +#255#192#192#192#0#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#0#0#0
- +#255#0#0#255#0#0#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#0#0#255#0#0
- +#255#0#0#255#0#0#0#128#0#0#128#0#0#128#0#0#128#0#255#0#0#128#0#0#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#255#0#0#255#0#0#255#0#0#255#0#0#0#128#0#0#128#0#0#128#0#0#128#0#128#128
- +#0#255#0#0#0#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#255#0#0#255#0#0#0#128#0#0#128#0#0#128#0#0#128#0#0#128#0
- +#0#128#0#255#0#0#255#0#0#0#0#0#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#255#0#0#0#128#0#0#128#0#0#128#0#0#128#0
- +#0#128#0#128#0#0#128#128#0#128#0#0#0#128#0#0#0#0#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#255#0#0#192#192#192#0
- +#128#0#0#128#0#128#0#0#0#128#0#0#128#0#255#0#0#0#128#0#0#128#0#0#0#0#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#255#0#0#255#255#255#192#192#192#255#0#0#255#0#0#255#0#0#255#0#0#0
- +#128#0#0#128#0#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#255#255#255#192#192#192#255#255
- ,#255#0#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#0#0#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#0#192#192#192#0#128#0#0#128#0#0#128#0#0
- +#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128
-]);
-LazarusResources.Add('TOVCSIMPLEFIELD','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#0#0#0#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#255
- +#255#255#255#255#255#255#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#0#0#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#0#0#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#0#0#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#0#0#255#255#255#0#0#0#0#128#128#0#128#128#0
- +#128#128#255#0#0#255#0#0#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#0#0#255#255#255#0#0#0#0#128#128#0#128#128#255
- +#0#0#255#0#0#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#0#0#255#255#255#0#0#0#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#0#0#255#255#255#0#0#0#0#128#128#0#128
- +#128#0#128#128#255#0#0#255#0#0#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#0#0#255#255#255#0#0#0#0#128#128#0#128
- +#128#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#0#0#255#255#255#0#0#0#0#128#128#0
- +#128#128#255#0#0#255#0#0#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#0#0#255#255#255#0#0#0#0#128#128#0
- +#128#128#0#128#128#255#0#0#255#0#0#255#0#0#255#0#0#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#0#0#255#255#255#0#0#0#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#255#255#255#0#0#0#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255#255#255
- +#255#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#0#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#0#0#0#0#0
- ,#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128
-]);
-LazarusResources.Add('TO32FLEXEDIT','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#128#128
- +#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128
- +#128#128#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#0#0#0#0#128#128#128#128#128#192#192#192#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#0#0#0#0#128
- +#128#128#128#128#192#192#192#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#0#0#0#0#128#128#128#128#128#192#192#192#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#255#255#255#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128#128#128#128#128#192
- +#192#192#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#255#255#255#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128#128#128#128
- +#128#192#192#192#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#255#255#255
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0
- +#0#0#128#128#128#128#128#192#192#192#0#255#255#0#255#255#0#0#0#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#0#0#0#0#128#128#128#128#128#192#192#192#0#255#255#0#255#255
- +#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255
- +#0#255#255#255#255#255#192#192#192#0#0#0#192#192#192#0#0#0#192#192#192#0#0#0
- +#0#0#0#0#128#128#128#128#128#192#192#192#0#255#255#0#255#255#0#0#0#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255
- +#0#255#255#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#0#0#0#0#128#128#128#128#128#192#192#192#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#255#255#255#255#255#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128#128#128#128#128#192#192
- +#192#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#255#255#0#255#255#255#255#255#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#0#0#0#0#128#128#128#128#128#192#192#192
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#255#255#255#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128
- +#128#128#128#128#192#192#192#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#0#0#128#128#128#128#128#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- ,#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128
-]);
-LazarusResources.Add('TO32TCFLEXEDIT','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#0#0#0#128#128#0#128
- +#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0
- +#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#0#0#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128
- +#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#0#0#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#0#0#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#0#0#0#128#128#0#128
- +#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#128#128#128#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#0#0#0#128#128#128#192#192#192#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#128#128#128#0#0#0#128#128#128#192#192#192
- +#0#255#255#0#255#255#128#0#0#128#0#0#128#0#0#0#255#255#0#255#255#0#255#255
- +#128#0#0#128#0#0#128#0#0#0#255#255#0#255#255#0#255#255#128#0#0#0#255#255#0
- +#255#255#0#255#255#128#0#0#0#255#255#128#128#128#0#0#0#128#128#128#192#192
- +#192#0#255#255#128#0#0#0#255#255#0#255#255#0#255#255#128#0#0#0#255#255#128#0
- +#0#0#255#255#0#255#255#0#255#255#128#0#0#0#255#255#0#255#255#128#0#0#0#255
- +#255#0#255#255#0#255#255#128#0#0#0#255#255#128#128#128#0#0#0#128#128#128#192
- +#192#192#0#255#255#128#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255
- +#128#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#128#0#0
- +#0#255#255#0#255#255#0#255#255#128#0#0#0#255#255#128#128#128#0#0#0#128#128
- +#128#192#192#192#0#255#255#128#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#0#255#255#0#255#255#128#0#0
- +#0#255#255#0#255#255#0#255#255#128#0#0#0#255#255#128#128#128#0#0#0#128#128
- +#128#192#192#192#0#255#255#128#0#0#0#255#255#0#255#255#0#255#255#128#0#0#0
- +#255#255#128#0#0#0#255#255#0#255#255#0#255#255#128#0#0#0#255#255#0#255#255
- +#128#0#0#0#255#255#0#255#255#0#255#255#128#0#0#0#255#255#128#128#128#0#0#0
- +#128#128#128#192#192#192#0#255#255#0#255#255#128#0#0#128#0#0#128#0#0#0#255
- +#255#0#255#255#0#255#255#128#0#0#128#0#0#128#0#0#0#255#255#0#255#255#0#255
- +#255#128#0#0#0#255#255#0#255#255#0#255#255#128#0#0#0#255#255#128#128#128#0#0
- +#0#128#128#128#192#192#192#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#128#0#0#0#255#255#0#255#255#0#255#255#128#0#0#0#255#255#128
- +#128#128#0#0#0#128#128#128#192#192#192#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#128#0#0#128#0#0#128#0#0#0#255#255#128#0#0#128#0#0#128#0#0#0#255#255
- ,#128#128#128#0#0#0#128#128#128#192#192#192#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#128#128#128#0#0#0#128#128#128#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#128
- +#128#128#0#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
-]);
-LazarusResources.Add('TOVCTCMEMO','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#255
- +#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#0
- +#0#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255
- +#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0
- +#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0
- +#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0
- +#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255
- +#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#255#255
- +#0#0#0#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0
- +#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255
- +#255#0#255#255#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0
- +#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255
- +#255#255#255#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255#255
- +#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255
- +#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255
- +#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255
- +#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0
- +#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255
- ,#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255
- +#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#0#0#0#0#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0
-]);
-LazarusResources.Add('TOVCTCBITMAP','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0
- +#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0
- +#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255
- +#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255
- +#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0
- +#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#0
- +#0#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#255#255#0#255#255#0
- +#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#0
- +#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#0#0#255#0#0
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255
- +#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0
- +#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0
- +#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255
- +#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255
- +#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255
- +#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- ,#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255
- +#0#0#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#0#0#0#0#0#0
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
-]);
-LazarusResources.Add('TOVCTCGLYPH','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#255#255
- +#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255
- +#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255
- +#255#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#0
- +#0#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0
- +#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0
- +#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0
- +#0#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0
- +#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255
- +#255#255#255#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255#255
- +#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255
- +#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255
- +#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255
- +#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0
- +#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255
- ,#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255
- +#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#0#0#0#0#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0
-]);
-LazarusResources.Add('TOVCTCICON','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0
- +#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0
- +#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0
- +#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255
- +#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#0#0#0#0#0#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#0#0#0#255#255#0#0#0#0#0#0#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0
- +#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0
- +#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0
- +#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255
- +#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0
- +#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#0#0#0#0
- +#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255
- +#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255
- +#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255
- +#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255
- +#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#0#0#255#0#0
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- ,#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#0#0
- +#255#0#0#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
-]);
-LazarusResources.Add('TOVCROTATEDLABEL','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#0#0#0#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#0#0#0#128
- +#128#128#0#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#0#0#0#128#128#128#128#128#128#128#128#128#0#0#0
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#0#0#0#128#128#128#128#128#128#128#128#128#0#0#0#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#0#0#0#128#128#128#128#128#128#0#0#0#128#128#128#128
- +#128#128#0#0#0#0#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#0#0#0#128#128
- +#128#128#128#128#128#128#128#0#0#0#0#0#0#128#128#128#128#128#128#128#128#128
- +#0#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#0#0#0#128#128#128#128#128#128#0#0#0#128
- +#128#128#128#128#128#128#128#128#0#0#0#0#0#0#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#0#0#0#0#0#0#128#128#128#128#128#128#128#128#128#0#0#0#128#128#128
- +#128#128#128#0#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#0#0#0#128#128#128#128#128#128#128#128#128#128#128#128#0
- +#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#0#0#0#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#0#0#0#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#0#0#0#0#0#0#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#0#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#0#0#0#128#128#128#128
- +#128#128#0#0#0#128#128#128#128#128#128#128#128#128#0#0#0#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- ,#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#0#0#0#128#128#128#128#128#128#128#128#128#128#128#128#0#0#0#0#0#0#0
- +#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
-]);
-LazarusResources.Add('TOVCSPINNER','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#128#128#128#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128
- +#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#255#255#255#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128#128#0#128#128#0
- +#128#128#0#128#128#255#255#255#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#255#255#255#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#255#255
- +#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#128#128#128#0#0#0#255#255#255#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128
- +#128#0#128#128#0#128#128#0#128#128#255#255#255#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#128#128#128#0#0#0
- +#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#0#0#0#0#128#128#0#128#128#0#128#128#0#128
- +#128#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#128#128#128#0#0#0#0#0#0#0#0#0#255#255#255#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128
- +#128#0#128#128#0#128#128#0#128#128#255#255#255#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#128#128#128#0#0#0#0#0#0#0#0#0
- +#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#255#255
- +#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#128#128#128
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128#128#0#128#128#0#128#128
- +#0#128#128#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#128#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128#128
- +#0#128#128#0#128#128#0#128#128#255#255#255#192#192#192#192#192#192#192#192
- +#192#192#192#192#128#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255
- +#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0
- +#128#128#0#128#128#0#128#128#0#128#128#255#255#255#192#192#192#192#192#192
- +#192#192#192#192#192#192#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#255#255#255#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128#128#0#128#128#0#128#128
- +#0#128#128#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#255#255#255#192
- +#192#192#192#192#192#192#192#192#192#192#192#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128#128
- +#0#128#128#0#128#128#0#128#128#255#255#255#192#192#192#192#192#192#192#192
- +#192#192#192#192#128#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255
- +#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0
- +#128#128#0#128#128#0#128#128#0#128#128#255#255#255#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#128#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#255#255#255#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#128#128#128#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#255#255#255#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#0#0#0#0#128#128#0#128#128#0#128#128#0#128
- +#128#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#128#128#128#0#0#0#0#0#0#0#0#0#255#255#255#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128
- +#128#0#128#128#0#128#128#0#128#128#255#255#255#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#128#128#128#0#0#0#0#0#0#0#0#0
- ,#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#255#255
- +#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#128#128#128#0#0#0#255#255#255#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128
- +#128#0#128#128#0#128#128#0#128#128#255#255#255#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#128#128#128#0#0#0
- +#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#0#0#0#0#128#128#0#128#128#0#128#128#0#128
- +#128#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#255#255#255#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#255#255#255#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128#128#0#128
- +#128#0#128#128#0#128#128#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#128#128#128#0#128#128#0#128#128
-]);
-LazarusResources.Add('TOVCLABEL','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0
- +#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#0#0#0#0#0#128#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#128#128#128#0#0#0#0#0#0#128#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#128#128#128#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#0#0#0#0#0#128#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#128#128#128#0#0#0#0#0#0#128#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#128#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#0#0#0#0#0#128#128#128#0#128#128#0#128#128#0#128#128#128#128
- +#128#0#0#0#0#0#0#128#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#128#128#128#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#0
- +#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#0#0#0#0#0#128#128#128#0#128#128#128#128#128#0#0#0
- +#0#0#0#128#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#128#128#128#0#0#0#0#0#0#0#128#128#0#0#0#0#0#0#0
- +#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#128#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- ,#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128
-]);
-LazarusResources.Add('TOVCVIRTUALLISTBOX','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#255
- +#255#255#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#255
- +#255#255#255#255#255#255#255#255#255#255#255#128#0#0#255#255#255#255#255#255
- +#255#255#255#0#0#0#128#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#0#0#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#128#0#0#128
- +#0#0#128#0#0#255#255#255#255#255#255#0#0#0#128#128#128#0#0#0#0#128#128#0#128
- +#128#0#128#128#0#0#0#255#255#255#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#128
- +#0#0#128#0#0#128#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#0#0#0#128#128#128#0#0#0#0#128#128#0
- +#128#128#0#128#128#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#0#0#0#128#128#128#0#0#0#0#128
- +#128#0#128#128#0#128#128#0#0#0#255#255#255#128#0#0#128#0#0#128#0#0#128#0#0
- +#128#0#0#128#0#0#128#0#0#128#0#0#255#255#255#255#255#255#255#255#255#128#128
- +#128#255#255#255#128#128#128#255#255#255#255#255#255#0#0#0#128#128#128#0#0#0
- +#0#128#128#0#128#128#0#128#128#0#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#128#128#128#255#255#255#128#128#128#255#255#255#128#128#128
- +#255#255#255#0#0#0#128#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#0#0#255
- +#255#255#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#255
- +#255#255#255#255#255#255#255#255#128#128#128#255#255#255#128#128#128#255#255
- +#255#255#255#255#0#0#0#128#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#0#0
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#128#128#128#255#255
- +#255#128#128#128#255#255#255#128#128#128#255#255#255#0#0#0#128#128#128#0#0#0
- +#0#128#128#0#128#128#0#128#128#0#0#0#255#255#255#128#0#0#128#0#0#128#0#0#128
- +#0#0#128#0#0#128#0#0#128#0#0#128#0#0#255#255#255#255#255#255#255#255#255#128
- +#128#128#255#255#255#128#128#128#255#255#255#255#255#255#0#0#0#128#128#128#0
- +#0#0#0#128#128#0#128#128#0#128#128#0#0#0#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#128#128#128#255#255#255#128#128#128#255#255#255#128#128
- +#128#255#255#255#0#0#0#128#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#0#0
- +#255#255#255#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0
- +#255#255#255#255#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#0#0#0#128
- +#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#0#0#0#128#128#128#0#0#0#0#128#128#0#128#128#0
- +#128#128#0#0#0#255#255#255#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0
- +#128#0#0#128#0#0#255#255#255#255#255#255#255#255#255#128#0#0#128#0#0#128#0#0
- +#255#255#255#255#255#255#0#0#0#128#128#128#0#0#0#0#128#128#0#128#128#0#128
- +#128#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#128#0#0#255#255#255#255#255#255#255#255#255#0#0#0#128#128
- +#128#0#0#0#0#128#128#0#128#128#0#128#128#0#0#0#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#0#128#128#128#0#0#0#0#128#128#0#128#128#0#128
- +#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128#0#0#0#0#128#128#0#128
- ,#128#0#128#128#0#128#128#0#0#0#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128
-]);
-LazarusResources.Add('TOVCCALENDAR','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#0#0#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#0#0#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#255#0#0#255#0#0
- +#255#0#0#255#0#0#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#255#0#0#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#255#0#0#255
- +#0#0#0#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#255
- +#0#0#255#0#0#255#0#0#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128
- +#0#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#255#0#0#255#0#0
- +#255#0#0#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0
- +#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#255#0#0#0#128#128#0
- +#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0
- +#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#255#0#0#0#128#128#0
- +#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0
- +#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128
- +#0#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#0#128
- +#128#255#0#0#255#0#0#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128
- +#0#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128
- +#128#0#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#255#0#0#0#128
- +#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128
- +#128#0#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#255#0#0#0#128
- +#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#255#0#0#255#0#0#0#128#128
- +#0#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#255#0#0#255#0#0
- +#255#0#0#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#255#0#0#255#0#0#255#0#0#255#0#0#0#128#128#0#128
- +#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#255#0#0#255#0
- +#0#255#0#0#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0#128#128
- +#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#255#0#0
- +#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0
- +#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128
- ,#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128
-]);
-LazarusResources.Add('TOVCDATEEDIT','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#0#255#0#0#255#0#0#255#0#0#255#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#128#128#128#128#128#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#255#255
- +#255#0#128#128#128#128#128#0#0#0#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255
- +#0#0#255#192#192#192#255#255#255#0#128#128#128#128#128#0#0#0#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255
- +#0#0#255#0#0#255#0#0#255#255#255#255#192#192#192#255#255#255#0#128#128#128
- +#128#128#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#192#192#192#192#192#192#192#192
- +#192#255#255#255#0#128#128#128#128#128#0#0#0#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#192#192#192#192
- +#192#192#192#192#192#192#192#192#255#255#255#0#128#128#128#128#128#0#0#0#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#255#255#255#0
- +#128#128#128#128#128#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#0#0#0
- +#255#255#255#0#0#0#0#0#0#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#255#255
- +#255#0#128#128#128#128#128#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#0
- +#0#0#255#255#255#0#0#0#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#255
- +#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#255#255#255#0#128#128#128#128#128#0#0#0#0#0#0#255#255#255#0#0#0#255#255
- +#255#0#0#0#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#0
- +#255#255#255#192#192#192#192#192#192#0#0#0#192#192#192#192#192#192#192#192
- +#192#255#255#255#0#128#128#128#128#128#0#0#0#0#0#0#0#0#0#255#255#255#0#0#0#0
- +#0#0#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#0#255#255#255#0#0#0
- +#192#192#192#0#0#0#0#0#0#0#0#0#192#192#192#192#192#192#255#255#255#0#128#128
- +#128#128#128#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255
- +#0#0#255#0#0#255#0#0#255#0#0#255#255#255#255#0#0#0#255#255#255#0#0#0#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#255#255#255
- +#0#128#128#128#128#128#0#0#0#255#255#255#255#255#255#255#255#255#0#0#255#0#0
- +#255#0#0#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#255#255#255#0#128#128#128#128#128#0#0#0#255#255#255#255#255
- +#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#255#255#255#0#128#128#128#128
- +#128#0#0#0#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#255#255#255#0#128#128#128#128#128#0#0#0#0#0#255#0#0#255#0#0#255#0#0#255#0#0
- +#255#0#0#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#255#255#255#0#128#128#128#128#128#0#0#255#0#0#255#0#0
- +#255#0#0#255#0#0#255#0#0#255#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- ,#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#0#128
- +#128#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#0#255#0#0#255#0#0#255#0#0#255#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#0#255#0#0#255#0#0#255#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128
-]);
-LazarusResources.Add('ORREDDOT','BMP',[
- 'BM>'#1#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#7#0#0#0#11#0#0#0#1#0#24#0#0#0#0#0#8#1#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#255#255#255#0#0#0#255#255#0#0#0#255#0#0#255#0#0#255#0#0#255#0#0#0#255#255
- +#255#0#0#0#255#255#0#0#0#255#0#0#255#0#0#255#0#0#255#0#0#0#255#255#255#0#0#0
- +#255#255#0#0#0#255#0#0#255#0#0#255#0#0#255#0#0#0#255#255#255#0#0#0#255#255#0
- +#0#0#255#0#0#255#0#0#255#0#0#255#0#0#0#255#255#255#0#0#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#255#255#255#0#0#0
-]);
-LazarusResources.Add('ORBLUEDOT','BMP',[
- 'BM>'#1#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#7#0#0#0#11#0#0#0#1#0#24#0#0#0#0#0#8#1#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#0#0#0#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#0#0#0#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#0#255
- +#255#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#0#0#0#255#255#0
- +#128#128#0#128#128#0#0#0#0#255#255#255#255#255#255#255#255#255#0#0#0#255#255
- +#0#128#128#0#128#128#0#0#0#0#255#255#255#255#255#255#255#255#255#0#0#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#255#255#255#255#255#255#255#255#255#0#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/95/950acb10820c0a19f38f4061ccbd55dff361d12d.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/95/950acb10820c0a19f38f4061ccbd55dff361d12d.svn-base
deleted file mode 100644
index cf5d9c51..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/pristine/95/950acb10820c0a19f38f4061ccbd55dff361d12d.svn-base and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/96/96ac72214d137fd18d887751746fbdf45af11b7f.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/96/96ac72214d137fd18d887751746fbdf45af11b7f.svn-base
deleted file mode 100644
index be6ba326..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/96/96ac72214d137fd18d887751746fbdf45af11b7f.svn-base
+++ /dev/null
@@ -1,469 +0,0 @@
-{*********************************************************}
-{* OVCTCGLY.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 ovctcgly;
- {-Orpheus Table Cell - Glyph type}
-
-interface
-
-uses
- SysUtils, Classes,
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Graphics, Controls,
- OvcTCmmn, OvcTCell, OvcTGRes, OvcTCBmp;
-
-type
- TOvcTCGlyphEdit = class(TCustomControl)
- protected {private}
- {.Z+}
- FValue : Integer;
- FCell : TOvcBaseTableCell;
- FRow : TRowNum;
- FCol : TColNum;
- FCellAttr : TOvcCellAttributes;
- {.Z-}
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
-
- protected
- {.Z+}
- procedure SetValue(V : integer);
-
- procedure WMGetDlgCode(var Msg : TMessage); message WM_GETDLGCODE;
- procedure WMKeyDown(var Msg : TWMKey); message WM_KEYDOWN;
- procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS;
- procedure WMLButtonDown(var Msg : TWMMouse); message WM_LBUTTONDOWN;
- procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
- {.Z-}
-
- public
- constructor Create(AOwner : TComponent); override;
- procedure Paint; override;
-
- property CellOwner : TOvcBaseTableCell
- read FCell write FCell;
- property Value : integer
- read FValue write SetValue;
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D;
-{$ENDIF}
- end;
-
- TOvcTCCustomGlyph = class(TOvcTCBaseBitMap)
- protected {private}
- {.Z+}
- FCellGlyphs : TOvcCellGlyphs;
- FEdit : TOvcTCGlyphEdit;
- {.Z-}
-
- protected
- {.Z+}
- function GetCellEditor : TControl; override;
- procedure SetCellGlyphs(CBG : TOvcCellGlyphs);
-
- procedure GlyphsHaveChanged(Sender : TObject);
-
- {painting}
- procedure tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer); override;
- {.Z-}
-
- {properties}
- property CellGlyphs : TOvcCellGlyphs
- read FCellGlyphs write SetCellGlyphs;
-
- public
- {create/destroy}
- constructor Create(AOwner : TComponent); override;
- destructor Destroy; override;
- function CreateEditControl : TOvcTCGlyphEdit; virtual;
-
- function CanAssignGlyphs(CBG : TOvcCellGlyphs) : boolean; virtual;
-
- function EditHandle : THandle; override;
- procedure EditHide; override;
- procedure EditMove(CellRect : TRect); override;
-
- procedure SaveEditedData(Data : pointer); override;
- procedure StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer); override;
- procedure StopEditing(SaveValue : boolean;
- Data : pointer); override;
-
- end;
-
- TOvcTCGlyph = class(TOvcTCCustomGlyph)
- published
- {properties inherited from custom ancestor}
- property AcceptActivationClick default True;
- property Access default otxDefault;
- property Adjust default otaDefault;
- property CellGlyphs;
- property Color;
- property Hint;
- property Margin default 4;
- property ShowHint default False;
- property Table;
- property TableColor default True;
-
- {events inherited from custom ancestor}
- property OnClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnOwnerDraw;
- end;
-
-implementation
-
-
-{===TOvcTCCustomGlyph creation/destruction===========================}
-constructor TOvcTCCustomGlyph.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
- FCellGlyphs := TOvcCellGlyphs.Create;
- FCellGlyphs.OnCfgChanged := GlyphsHaveChanged;
- FAcceptActivationClick := true;
- end;
-{--------}
-destructor TOvcTCCustomGlyph.Destroy;
- begin
- FCellGlyphs.Free;
- inherited Destroy;
- end;
-{--------}
-function TOvcTCCustomGlyph.CanAssignGlyphs(CBG : TOvcCellGlyphs) : boolean;
- begin
- Result := true;
- end;
-{--------}
-function TOvcTCCustomGlyph.CreateEditControl : TOvcTCGlyphEdit;
- begin
- Result := TOvcTCGlyphEdit.Create(FTable);
- end;
-{--------}
-function TOvcTCCustomGlyph.GetCellEditor : TControl;
- begin
- Result := FEdit;
- end;
-{--------}
-procedure TOvcTCCustomGlyph.GlyphsHaveChanged(Sender : TObject);
- begin
- tcDoCfgChanged;
- end;
-{--------}
-procedure TOvcTCCustomGlyph.SetCellGlyphs(CBG : TOvcCellGlyphs);
- begin
- if CanAssignGlyphs(CBG) then
- FCellGlyphs.Assign(CBG);
- end;
-{====================================================================}
-
-
-{===TOvcTCCustomGlyph painting================================}
-procedure TOvcTCCustomGlyph.tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer);
- var
- B : ^integer absolute Data;
- BitMapInfo : TCellBitMapInfo;
- begin
- {set up a bitmap info record}
- with BitMapInfo do
- begin
- BM := FCellGlyphs.BitMap;
- ActiveCount := FCellGlyphs.ActiveGlyphCount;
- Count := FCellGlyphs.GlyphCount;
- if (Data = nil) then
- begin
- if (csDesigning in ComponentState) then
- Index := (RowNum mod ActiveCount) {for testing purposes}
- else
- Index := -1
- end
- else
- Index := B^;
- if (Index >= ActiveCount) then
- Index := pred(ActiveCount);
- end;
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, @BitMapInfo);
- end;
-{====================================================================}
-
-
-{===TOvcTCCustomGlyph editing========================================}
-function TOvcTCCustomGlyph.EditHandle : THandle;
- begin
- if Assigned(FEdit) then
- Result := FEdit.Handle
- else
- Result := 0;
- end;
-{--------}
-procedure TOvcTCCustomGlyph.EditHide;
- begin
- if Assigned(FEdit) then
- with FEdit do
- begin
- SetWindowPos(FEdit.Handle, HWND_TOP,
- 0, 0, 0, 0,
- SWP_HIDEWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- end;
- end;
-{--------}
-procedure TOvcTCCustomGlyph.EditMove(CellRect : TRect);
- var
- EditHandle : HWND;
- begin
- if Assigned(FEdit) then
- begin
- EditHandle := FEdit.Handle;
- with CellRect do
- SetWindowPos(EditHandle, HWND_TOP,
- Left, Top, Right-Left, Bottom-Top,
- SWP_SHOWWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- InvalidateRect(EditHandle, nil, false);
- UpdateWindow(EditHandle);
- end;
- end;
-{--------}
-procedure TOvcTCCustomGlyph.SaveEditedData(Data : pointer);
- begin
- if Assigned(Data) then
- Integer(Data^) := FEdit.Value;
- end;
-{--------}
-procedure TOvcTCCustomGlyph.StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer);
- begin
- FEdit := CreateEditControl;
- with FEdit do
- begin
- CellOwner := Self;
- if Data = nil then
- Value := 0
- else
- Value := Integer(Data^);
- FRow := RowNum;
- FCol := ColNum;
- FCellAttr := CellAttr;
- Color := CellAttr.caColor;
- Ctl3D := false;
- case CellStyle of
- tes3D : Ctl3D := true;
- end;{case}
- Left := CellRect.Left;
- Top := CellRect.Top;
- Width := CellRect.Right - CellRect.Left;
- Height := CellRect.Bottom - CellRect.Top;
- Hint := Self.Hint;
- ShowHint := Self.ShowHint;
- Parent := FTable;
- Visible := true;
- TabStop := false;
-
- OnClick := Self.OnClick;
- OnDblClick := Self.OnDblClick;
- OnDragDrop := Self.OnDragDrop;
- OnDragOver := Self.OnDragOver;
- OnEndDrag := Self.OnEndDrag;
- OnEnter := Self.OnEnter;
- OnExit := Self.OnExit;
- OnKeyDown := Self.OnKeyDown;
- OnKeyPress := Self.OnKeyPress;
- OnKeyUp := Self.OnKeyUp;
- OnMouseDown := Self.OnMouseDown;
- OnMouseMove := Self.OnMouseMove;
- OnMouseUp := Self.OnMouseUp;
- end;
- end;
-{--------}
-procedure TOvcTCCustomGlyph.StopEditing(SaveValue : boolean;
- Data : pointer);
- begin
- if SaveValue and Assigned(Data) then
- Integer(Data^) := FEdit.Value;
- FEdit.Free;
- FEdit := nil;
- end;
-{====================================================================}
-
-
-{---TOvcTCGlyphEdit===========================================}
-constructor TOvcTCGlyphEdit.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
- ControlStyle := ControlStyle - [csDoubleClicks];
- end;
-{--------}
-procedure TOvcTCGlyphEdit.Paint;
- var
- R : TRect;
- begin
-{$IFNDEF LCL}
- Windows.GetClientRect(Handle, R);
-{$ELSE}
- LclIntf.GetClientRect(Handle, R);
-{$ENDIF}
- FCell.Paint(Canvas, R, FRow, FCol, FCellAttr, @FValue);
- end;
-{--------}
-procedure TOvcTCGlyphEdit.SetValue(V : integer);
- begin
- if (V <> FValue) then
- begin
- if (V < 0) then
- V := 0
- else if (V >= TOvcTCGlyph(CellOwner).CellGlyphs.ActiveGlyphCount) then
- V := TOvcTCGlyph(CellOwner).CellGlyphs.ActiveGlyphCount;
- FValue := V;
- if HandleAllocated then
- begin
- Invalidate;
- Update;
- end;
- end;
- end;
-{--------}
-procedure TOvcTCGlyphEdit.WMGetDlgCode(var Msg : TMessage);
- begin
- Msg.Result := DLGC_WANTARROWS;
- if CellOwner.TableWantsTab then
- Msg.Result := Msg.Result or DLGC_WANTTAB;
- if CellOwner.TableWantsEnter then
- Msg.Result := Msg.Result or DLGC_WANTALLKEYS;
- end;
-{--------}
-procedure TOvcTCGlyphEdit.WMKeyDown(var Msg : TWMKey);
- var
- GridReply : TOvcTblKeyNeeds;
- GridUsedIt : boolean;
- begin
- GridUsedIt := false;
- GridReply := otkDontCare;
- if (CellOwner <> nil) then
- GridReply := CellOwner.FilterTableKey(Msg);
- case GridReply of
- otkMustHave :
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- otkWouldLike :
- if Msg.CharCode <> VK_SPACE then
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;{case}
-
- if not GridUsedIt then
- begin
- inherited;
- if (Msg.CharCode = VK_SPACE) then
- begin
- inc(FValue);
- if (FValue >= TOvcTCGlyph(FCell).FCellGlyphs.ActiveGlyphCount) then
- FValue := 0;
- Invalidate;
- Update;
-
- if ((@TOvcTCGlyph(FCell).FOnClick) <> nil) then
- OnClick(Self);
- end
- else if (Msg.CharCode = VK_BACK) then
- begin
- dec(FValue);
- if (FValue < 0) then
- FValue := pred(TOvcTCGlyph(FCell).FCellGlyphs.ActiveGlyphCount);
- Invalidate;
- Update;
-
- if ((@TOvcTCGlyph(FCell).FOnClick) <> nil) then
- OnClick(Self);
- end;
- end;
- end;
-{--------}
-procedure TOvcTCGlyphEdit.WMLButtonDown(var Msg : TWMMouse);
- begin
- inc(FValue);
- if (FValue >= TOvcTCGlyph(FCell).FCellGlyphs.ActiveGlyphCount) then
- FValue := 0;
- Invalidate;
- Update;
-
- inherited;
- end;
-{--------}
-procedure TOvcTCGlyphEdit.WMKillFocus(var Msg : TWMKillFocus);
- begin
- inherited;
- CellOwner.PostMessageToTable(ctim_KillFocus, Msg.FocusedWnd, 0);
- end;
-{--------}
-procedure TOvcTCGlyphEdit.WMSetFocus(var Msg : TWMSetFocus);
- begin
- inherited;
- CellOwner.PostMessageToTable(ctim_SetFocus, Msg.FocusedWnd, 0);
- end;
-{====================================================================}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/97/97a862a273340fe27c88ef8039742f20fc66bdae.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/97/97a862a273340fe27c88ef8039742f20fc66bdae.svn-base
deleted file mode 100644
index acea5547..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/97/97a862a273340fe27c88ef8039742f20fc66bdae.svn-base
+++ /dev/null
@@ -1,175 +0,0 @@
-
-
-
-
- Delphi.Personality
- VCLApplication
- 1.0
- {88CE0102-AC1C-464D-AE40-EC184791C58A}
-
-
-
-
- project1.dpr
-
-
- 7.0
-
-
- 8
- 0
- 1
- 1
- 0
- 0
- 1
- 1
- 1
- 0
- 0
- 1
- 0
- 1
- 1
- 1
- 0
- 0
- 0
- 0
- 0
- 1
- 0
- 1
- 1
- 1
- True
- True
- WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-
- False
-
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- False
- False
- False
- True
- True
- True
- True
- True
- True
-
-
-
- 0
- 0
- False
- 1
- False
- False
- False
- 16384
- 1048576
- 4194304
-
-
-
-
-
-
-
-
-
-
-
- False
-
-
-
-
-
- False
-
-
- True
- False
-
-
-
- $00000000
-
-
-
- False
- False
- 1
- 0
- 0
- 0
- False
- False
- False
- False
- False
- 1033
- 1252
-
-
-
-
- 1.0.0.0
-
-
-
-
-
- 1.0.0.0
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/98/984275cbd57be3f8aeabba0d2194ca0a41d360a5.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/98/984275cbd57be3f8aeabba0d2194ca0a41d360a5.svn-base
deleted file mode 100644
index 3b41d2cf..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/98/984275cbd57be3f8aeabba0d2194ca0a41d360a5.svn-base
+++ /dev/null
@@ -1 +0,0 @@
-\tools\xdev\lazres ovcbase.lrs ORTCCOMBOARROW.bmp ORTCCHECKGLYPHS.bmp ORBTNCLC.bmp ORLEFTARROW.bmp ORLEFTARROWS.bmp ORRIGHTARROW.bmp ORRIGHTARROWS.bmp ORREVERT.bmp ORTODAY.bmp ORBTNCAL.bmp ORCOLUMNMOVECURSOR.cur ORROWMOVECURSOR.cur
\ No newline at end of file
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/99/993b9b3a5182201d80102063232de81d9c9485e5.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/99/993b9b3a5182201d80102063232de81d9c9485e5.svn-base
deleted file mode 100644
index d397374d..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/pristine/99/993b9b3a5182201d80102063232de81d9c9485e5.svn-base and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/9a/9a1512cf7f1d35a8a21a16e64f431095b7b67bd9.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/9a/9a1512cf7f1d35a8a21a16e64f431095b7b67bd9.svn-base
deleted file mode 100644
index 7e174316..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/9a/9a1512cf7f1d35a8a21a16e64f431095b7b67bd9.svn-base
+++ /dev/null
@@ -1,18 +0,0 @@
-program Project1;
-
-uses
-{$IFDEF LCL}
- Interfaces,
-{$ENDIF}
- Forms,
- Unit1 in 'unit1.pas' {Form1};
-
-{$IFDEF MSWINDOWS}
-{$R *.res}
-{$ENDIF}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/9b/9b5ab9b2ec3258b21369c9332c03c09ada2b574e.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/9b/9b5ab9b2ec3258b21369c9332c03c09ada2b574e.svn-base
deleted file mode 100644
index c7dcf87c..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/9b/9b5ab9b2ec3258b21369c9332c03c09ada2b574e.svn-base
+++ /dev/null
@@ -1,33 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, ovcbase, ovccal;
-
-type
- TForm1 = class(TForm)
- OvcCalendar1: TOvcCalendar;
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.dfm}
-{$ENDIF}
-
-initialization
-{$IFDEF LCL}
-{$I unit1.lrs} {Include form's resource file}
-{$ENDIF}
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/9c/9c02d1d594c60ef4af4b46ee2d7936cc9d7fd231.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/9c/9c02d1d594c60ef4af4b46ee2d7936cc9d7fd231.svn-base
deleted file mode 100644
index 356b743c..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/9c/9c02d1d594c60ef4af4b46ee2d7936cc9d7fd231.svn-base
+++ /dev/null
@@ -1,1116 +0,0 @@
-{*********************************************************}
-{* OVCMISC.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 ***** *}
-
-(*Changes)
-
- 10/20/01- Hdc changed to TOvcHdc for BCB Compatibility
- 10/20/01- HWnd changed to TOvcHWnd for BCB Compatibility
-*)
-
-{$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 ovcmisc;
- {-Miscellaneous functions and procedures}
-
-interface
-
-uses
- SysUtils, Classes,
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Buttons, Controls, ExtCtrls, Forms, Graphics,
- {$IFNDEF LCL} Consts, {$ELSE} LclStrConsts, {$ENDIF} OvcData;
-
-{ Hdc needs to be an Integer for BCB compatibility }
-{$IFDEF CBuilder}
-type
- TOvcHdc = Integer;
- TOvcHWND = Cardinal;
-{$ELSE}
-type
- TOvcHdc = HDC;
- TOvcHWND = HWND;
-{$ENDIF}
-
-{$IFNDEF LCL}
-function LoadBaseBitmap(lpBitmapName : PAnsiChar) : HBITMAP;
- {-load and return the handle to bitmap resource}
-function LoadBaseCursor(lpCursorName : PAnsiChar) : HCURSOR;
- {-load and return the handle to cursor resource}
-{$ENDIF}
-function CompStruct(const S1, S2; Size : Cardinal) : Integer;
- {-compare two fixed size structures}
-function DefaultEpoch : Integer;
- {-return the current century}
-function DrawButtonFrame(Canvas : TCanvas; const Client : TRect;
- IsDown, IsFlat : Boolean; Style : TButtonStyle) : TRect;
- {-produce a button similar to DrawFrameControl}
-procedure FixRealPrim(P : PAnsiChar; DC : AnsiChar);
- {-get a PChar string representing a real ready for Val()}
-function GetDisplayString(Canvas : TCanvas; const S : string;
- MinChars, MaxWidth : Integer) : string;
- {-given a string, a minimum number of chars to display, and a max width,
- find the string that can be displayed in that width - add ellipsis to
- the end if necessary and possible}
-function GetLeftButton: Byte;
- {-return the mapped left button}
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
-function GetNextDlgItem(Ctrl : TOvcHWnd{hWnd}) : hWnd;
-
- {-get handle of next control in the same form}
-procedure GetRGB(Clr : TColor; var IR, IG, IB : Byte);
- {-return component parts of the rgb value}
-function GetShiftFlags : Byte;
- {-get current shift flags, the high order bit is set if the key is down}
-function CreateRotatedFont(F : TFont; Angle : Integer) : hFont;
- {-create a rotated font based on the font object F}
-function GetTopTextMargin(Font : TFont; BorderStyle : TBorderStyle;
- Height : Integer; Ctl3D : Boolean) : Integer;
- {-return the pixel top margin size}
-function ExtractWord(N : Integer; const S : string; WordDelims : TCharSet) : string;
- {-return the Nth word from S}
-function IsForegroundTask : Boolean;
- {-returns true if this task is currently in the foreground}
-function TrimLeft(const S : string) : string;
- {-return a string with leading white space removed}
-function TrimRight(const S : string) : string;
- {-return a string with trailing white space removed}
-function QuotedStr(const S : string) : string;
- {-return a quoted string string with internal quotes escaped}
-function WordCount(const S : string; const WordDelims : TCharSet) : Integer;
- {-return the word count given a set of word delimiters}
-function WordPosition(const N : Integer; const S : string; const WordDelims : TCharSet) : Integer;
- {-return start position of N'th word in S}
-function PtrDiff(const P1, P2) : Word;
- {-return the difference between P1 and P2}
-procedure PtrInc(var P; Delta : Word);
- {-increase P by Delta}
-procedure PtrDec(var P; Delta : Word);
- {-decrease P by Delta}
-procedure FixTextBuffer(InBuf, OutBuf : PChar; OutSize : Integer);
- {-replace orphan linefeeds with cr/lf pairs}
-
-{ - Hdc changed to TOvcHdc for BCB Compatibility }
-procedure TransStretchBlt(DstDC: TOvcHdc{HDC}; DstX, DstY, DstW, DstH: Integer;
- SrcDC: TOvcHdc{HDC}; SrcX, SrcY, SrcW, SrcH: Integer;
- MaskDC: TOvcHdc{HDC};
- MaskX, MaskY : Integer);
-function MaxL(A, B : LongInt) : LongInt;
-function MinL(A, B : LongInt) : LongInt;
-function MinI(X, Y : Integer) : Integer;
- {-return the minimum of two integers}
-function MaxI(X, Y : Integer) : Integer;
- {-return the maximum of two integers}
-
-{function GenerateComponentName(PF : TCustomForm; const Root : string) : string;}
-function GenerateComponentName(PF : TWinControl; const Root : string) : string;
- {-return a component name unique for this form}
-function PartialCompare(const S1, S2 : string) : Boolean;
- {-compare minimum length of S1 and S2 strings}
-
-function PathEllipsis(const S : string; MaxWidth : Integer) : string;
-function CreateDisabledBitmap(FOriginal : TBitmap; OutlineColor : TColor) : TBitmap;
-procedure CopyParentImage(Control : TControl; Dest : TCanvas);
-procedure DrawTransparentBitmap(Dest : TCanvas; X, Y, W, H : Integer;
- Rect : TRect; Bitmap : TBitmap; TransparentColor : TColor);
-function WidthOf(const R : TRect) : Integer;
- {returnd R.Right - R.Left}
-function HeightOf(const R : TRect) : Integer;
- {returnd R.Bottom - R.Top}
-procedure DebugOutput(const S : string);
- {use OutputDebugString()}
-
-implementation
-
-uses
- OvcBase, OvcStr;
-
-{$IFNDEF LCL}
-function LoadBaseBitmap(lpBitmapName : PAnsiChar) : HBITMAP;
-begin
- Result := LoadBitmap(FindClassHInstance(TOvcCustomControlEx), lpBitmapName);
-end;
-
-function LoadBaseCursor(lpCursorName : PAnsiChar) : HCURSOR;
-begin
- Result := LoadCursor(FindClassHInstance(TOvcCustomControlEx), lpCursorName);
-end;
-{$ENDIF}
-
-{$IFDEF NoAsm}
-function CompStruct(const S1, S2; Size : Cardinal) : Integer;
-// Since CompStruct currently only used elsewhere to determine if
-// two structures are different, just use CompareMem and don't
-// worry about whether "greater than" or "less than".
-begin
- if CompareMem(@S1, @S2, Size) then {Structures identical?}
- Result := 0
- else {Structures not identical, so just return as though S1 > S2}
- Result := 1;
-end;
-
-{$ELSE}
-function CompStruct(const S1, S2; Size : Cardinal) : Integer; register;
- {-compare two fixed size structures}
-asm
- push esi
- push edi
-
- mov esi, eax {pointer to S1}
- mov edi, edx {pointer to S2}
-
- xor eax, eax {eax holds temporary result (Equal)}
-
- or ecx, ecx {size is already in ecx}
- jz @@CSDone {make sure size isn't zero}
-
- cld {go forward}
- repe cmpsb {compare until no match or ecx = 0}
-
- je @@CSDone {if equal, result is already in eax}
- inc eax {prepare for greater}
- ja @@CSDone {S1 greater? return +1}
- mov eax, -1 {else S1 less, return -1}
-
-@@CSDone:
-
- pop edi
- pop esi
-end;
-{$ENDIF}
-
-procedure FixRealPrim(P : PAnsiChar; DC : AnsiChar);
- {-Get a string representing a real ready for Val()}
-var
- DotPos : Cardinal;
- EPos : Cardinal;
- Len : Word;
- Found : Boolean;
- EFound : Boolean;
-begin
- TrimAllSpacesPChar(P);
-
- Len := StrLen(P);
- if Len > 0 then begin
- if P[Len-1] = DC then begin
- Dec(Len);
- P[Len] := #0;
- TrimAllSpacesPChar(P);
- end;
-
- {Val doesn't accept alternate decimal point chars}
- Found := StrChPos(P, DC, DotPos);
- {replace with '.'}
- if Found and (DotPos > 0) then
- P[DotPos] := '.'
- else
- Found := StrChPos(P, pmDecimalPt, DotPos);
-
- if Found then begin
- {check for 'nnnn.'}
- if LongInt(DotPos) = Len-1 then begin
- P[Len] := '0';
- Inc(Len);
- P[Len] := #0;
- end;
-
- {check for '.nnnn'}
- if DotPos = 0 then begin
- StrChInsertPrim(P, '0', 0);
- Inc(Len);
- Inc(DotPos);
- end;
-
- {check for '-.nnnn'}
- if (Len > 1) and (P^ = '-') and (DotPos = 1) then begin
- StrChInsertPrim(P, '0', 1);
- Inc(DotPos);
- end;
-
- end;
-
- {fix up numbers with exponents}
- EFound := StrChPos(P, 'E', EPos);
- if EFound and (EPos > 0) then begin
- if not Found then begin
- StrChInsertPrim(P, '.', EPos);
- DotPos := EPos;
- Inc(EPos);
- end;
- if EPos-DotPos < 12 then
- StrStInsertPrim(P, '00000', EPos);
- end;
-
- {remove blanks before and after '.' }
- if Found then begin
- while (DotPos > 0) and (P[DotPos-1] = ' ') do begin
- StrStDeletePrim(P, DotPos-1, 1);
- Dec(DotPos);
- end;
- while P[DotPos+1] = ' ' do
- StrStDeletePrim(P, DotPos+1, 1);
- end;
-
- end else begin
- {empty string = '0'}
- P[0] := '0';
- P[1] := #0;
- end;
-end;
-
-function GetLeftButton: Byte;
-const
- RLButton : array[Boolean] of Word = (VK_LBUTTON, VK_RBUTTON);
-begin
- Result := RLButton[GetSystemMetrics(SM_SWAPBUTTON) <> 0];
-end;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
-function GetNextDlgItem(Ctrl : TOvcHWnd{hWnd}) : hWnd;
- {-Get handle of next control in the same form}
-begin
- {asking for previous returns next}
- Result := GetNextWindow(Ctrl, GW_HWNDPREV);
- if Result = 0 then begin
- {asking for last returns first}
- Result := GetWindow(Ctrl, GW_HWNDLAST);
- if Result = 0 then
- Result := Ctrl;
- end;
-end;
-
-procedure GetRGB(Clr : TColor; var IR, IG, IB : Byte);
-begin
- if (Clr < 0) then begin
- Clr := Clr + MaxLongInt + 1;
- Clr := GetSysColor(Clr);
- end;
- IR := GetRValue(Clr);
- IG := GetGValue(Clr);
- IB := GetBValue(Clr);
-end;
-
-function GetShiftFlags : Byte;
- {-get current shift flags, the high order bit is set if the key is down}
-begin
- Result := (Ord(GetKeyState(VK_CONTROL) < 0) * ss_Ctrl) +
- (Ord(GetKeyState(VK_SHIFT ) < 0) * ss_Shift) +
- (Ord(GetKeyState(VK_ALT ) < 0) * ss_Alt);
-end;
-
-function CreateRotatedFont(F : TFont; Angle : Integer) : hFont;
- {-create a rotated font based on the font object F}
-var
- LF : TLogFont;
-begin
- FillChar(LF, SizeOf(LF), #0);
- with LF do begin
- lfHeight := F.Height;
- lfWidth := 0;
- lfEscapement := Angle*10;
- lfOrientation := 0;
- if fsBold in F.Style then
- lfWeight := FW_BOLD
- else
- lfWeight := FW_NORMAL;
- lfItalic := Byte(fsItalic in F.Style);
- lfUnderline := Byte(fsUnderline in F.Style);
- lfStrikeOut := Byte(fsStrikeOut in F.Style);
- lfCharSet := DEFAULT_CHARSET;
- StrPCopy(lfFaceName, F.Name);
- lfQuality := DEFAULT_QUALITY;
- {everything else as default}
- lfOutPrecision := OUT_DEFAULT_PRECIS;
- lfClipPrecision := CLIP_DEFAULT_PRECIS;
- case F.Pitch of
- fpVariable : lfPitchAndFamily := VARIABLE_PITCH;
- fpFixed : lfPitchAndFamily := FIXED_PITCH;
- else
- lfPitchAndFamily := DEFAULT_PITCH;
- end;
- end;
- Result := CreateFontIndirect(LF);
-end;
-
-function GetTopTextMargin(Font : TFont; BorderStyle : TBorderStyle;
- Height : Integer; Ctl3D : Boolean) : Integer;
- {-return the pixel top margin size}
-var
- I : Integer;
- DC : hDC;
- Metrics : TTextMetric;
- SaveFont : hFont;
- SysMetrics : TTextMetric;
-begin
- DC := GetDC(0);
- try
- GetTextMetrics(DC, SysMetrics);
- SaveFont := SelectObject(DC, Font.Handle);
- GetTextMetrics(DC, Metrics);
- SelectObject(DC, SaveFont);
- finally
- ReleaseDC(0, DC);
- end;
- I := SysMetrics.tmHeight;
- if I > Metrics.tmHeight then
- I := Metrics.tmHeight;
-
- if NewStyleControls then begin
- if BorderStyle = bsNone then begin
- Result := 0;
- if I >= Height-2 then
- Result := (Height-I-2) div 2 - Ord(Odd(Height-I));
- end else if Ctl3D then begin
- Result := 1;
- if I >= Height-4 then
- Result := (Height-I-4) div 2 - 1;
- end else begin
- Result := 1;
- if I >= Height-4 then
- Result := (Height-I-4) div 2 - Ord(Odd(Height-I));
- end;
- end else begin
- Result := (Height-Metrics.tmHeight-1) div 2;
- if I > Height-2 then begin
- Dec(Result, 2);
- if BorderStyle = bsNone then
- Inc(Result, 1);
- end;
- end;
-end;
-
-function PtrDiff(const P1, P2) : Word;
- {-return the difference between P1 and P2}
-begin
- {P1 and P2 are assumed to point within the same buffer}
- Result := PAnsiChar(P1) - PAnsiChar(P2);
-end;
-
-procedure PtrInc(var P; Delta : Word);
- {-increase P by Delta}
-begin
- Inc(PAnsiChar(P), Delta);
-end;
-
-procedure PtrDec(var P; Delta : Word);
- {-increase P by Delta}
-begin
- Dec(PAnsiChar(P), Delta);
-end;
-
-{$IFDEF NoAsm}
-function MinI(X, Y : Integer) : Integer;
-begin
- if X < Y then
- Result := X
- else
- Result := Y;
-end;
-
-function MaxI(X, Y : Integer) : Integer;
-begin
- if X >= Y then
- Result := X
- else
- Result := Y;
-end;
-
-{$ELSE}
-function MinI(X, Y : Integer) : Integer;
-asm
- cmp eax, edx
- jle @@Exit
- mov eax, edx
-@@Exit:
-end;
-
-function MaxI(X, Y : Integer) : Integer;
-asm
- cmp eax, edx
- jge @@Exit
- mov eax, edx
-@@Exit:
-end;
-{$ENDIF}
-
-function MaxL(A, B : LongInt) : LongInt;
-begin
- if (A < B) then
- Result := B
- else
- Result := A;
-end;
-
-function MinL(A, B : LongInt) : LongInt;
-begin
- if (A < B) then
- Result := A
- else
- Result := B;
-end;
-
-function TrimLeft(const S : string) : string;
-var
- I, L : Integer;
-begin
- L := Length(S);
- I := 1;
- while (I <= L) and (S[I] <= ' ') do
- Inc(I);
- Result := Copy(S, I, Length(S)-I+1);
-end;
-
-function TrimRight(const S : string) : string;
-var
- I : Integer;
-begin
- I := Length(S);
- while (I > 0) and (S[I] <= ' ') do
- Dec(I);
- Result := Copy(S, 1, I);
-end;
-
-function QuotedStr(const S: string): string;
-var
- I : Integer;
-begin
- Result := S;
- for I := Length(Result) downto 1 do
- if Result[I] = '''' then Insert('''', Result, I);
- Result := '''' + Result + '''';
-end;
-
-function WordCount(const S : string; const WordDelims : TCharSet) : Integer;
-var
- SLen, I : Integer;
-begin
- Result := 0;
- I := 1;
- SLen := Length(S);
- while I <= SLen do begin
- while (I <= SLen) and (S[I] in WordDelims) do
- Inc(I);
- if I <= SLen then
- Inc(Result);
- while (I <= SLen) and not(S[I] in WordDelims) do
- Inc(I);
- end;
-end;
-
-function ExtractWord(N : Integer; const S : string; WordDelims : TCharSet) : string;
-var
- I : Word;
- Len : Integer;
-begin
- Len := 0;
- I := WordPosition(N, S, WordDelims);
- if I <> 0 then
- { find the end of the current word }
- while (I <= Length(S)) and not(S[I] in WordDelims) do begin
- { add the I'th character to result }
- Inc(Len);
- SetLength(Result, Len);
- Result[Len] := S[I];
- Inc(I);
- end;
- SetLength(Result, Len);
-end;
-
-function WordPosition(const N : Integer; const S : string; const WordDelims : TCharSet) : Integer;
-var
- Count, I : Integer;
-begin
- Count := 0;
- I := 1;
- Result := 0;
- while (I <= Length(S)) and (Count <> N) do begin
- {skip over delimiters}
- while (I <= Length(S)) and (S[I] in WordDelims) do
- Inc(I);
- {if we're not beyond end of S, we're at the start of a word}
- if I <= Length(S) then
- Inc(Count);
- {if not finished, find the end of the current word}
- if Count <> N then
- while (I <= Length(S)) and not (S[I] in WordDelims) do
- Inc(I)
- else
- Result := I;
- end;
-end;
-
-function DrawButtonFrame(Canvas : TCanvas; const Client : TRect;
- IsDown, IsFlat : Boolean; Style : TButtonStyle) : TRect;
-var
- NewStyle : Boolean;
-begin
- Result := Client;
- NewStyle := (Style = bsNew) or (NewStyleControls and (Style = bsAutoDetect));
- if IsDown then begin
- if NewStyle then begin
- Frame3D(Canvas, Result, clWindowFrame, clBtnHighlight, 1);
- if not IsFlat then
- Frame3D(Canvas, Result, clBtnShadow, clBtnFace, 1);
- end else begin
- if IsFlat then
- Frame3D(Canvas, Result, clWindowFrame, clBtnHighlight, 1)
- else begin
- Frame3D(Canvas, Result, clWindowFrame, clWindowFrame, 1);
- Canvas.Pen.Color := clBtnShadow;
- Canvas.PolyLine([Point(Result.Left, Result.Bottom - 1),
- Point(Result.Left, Result.Top), Point(Result.Right, Result.Top)]);
- end;
- end;
- end else begin
- if NewStyle then begin
- if IsFlat then
- Frame3D(Canvas, Result, clBtnHighlight, clBtnShadow, 1)
- else begin
- Frame3D(Canvas, Result, clBtnHighlight, clWindowFrame, 1);
- Frame3D(Canvas, Result, clBtnFace, clBtnShadow, 1);
- end;
- end else begin
- if IsFlat then
- Frame3D(Canvas, Result, clBtnHighlight, clWindowFrame, 1)
- else begin
- Frame3D(Canvas, Result, clWindowFrame, clWindowFrame, 1);
- Frame3D(Canvas, Result, clBtnHighlight, clBtnShadow, 1);
- end;
- end;
- end;
- InflateRect(Result, -1, -1);
-end;
-
-function GetDisplayString(Canvas : TCanvas; const S : string;
- MinChars, MaxWidth : Integer) : string;
-var
- iDots, EllipsisWidth, Extent, Len, Width : Integer;
- ShowEllipsis : Boolean;
-begin
- {be sure that the Canvas Font is set before entering this routine}
- EllipsisWidth := Canvas.TextWidth('...');
- Len := Length(S);
- Result := S;
- Extent := Canvas.TextWidth(Result);
- ShowEllipsis := False;
- Width := MaxWidth;
- while (Extent > Width) do begin
- ShowEllipsis := True;
- Width := MaxWidth - EllipsisWidth;
- if Len > MinChars then begin
- Delete(Result, Len, 1);
- dec(Len);
- end else
- break;
- Extent := Canvas.TextWidth(Result);
- end;
- if ShowEllipsis then begin
- Result := Result + '...';
- inc(Len, 3);
- Extent := Canvas.TextWidth(Result);
- iDots := 3;
- while (iDots > 0) and (Extent > MaxWidth) do begin
- Delete(Result, Len, 1);
- Dec(Len);
- Extent := Canvas.TextWidth(Result);
- Dec(iDots);
- end;
- end;
-end;
-
-type
- PCheckTaskInfo = ^TCheckTaskInfo;
- TCheckTaskInfo = packed record
- FocusWnd: HWnd;
- Found: Boolean;
- end;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
-function CheckTaskWindow(Window: TOvcHWnd{HWnd};
- Data: PCheckTaskInfo): WordBool; stdcall; //64
-begin
- Result := True;
- if PCheckTaskInfo(Data)^.FocusWnd = Window then begin
- Result := False;
- PCheckTaskInfo(Data)^.Found := True;
- end;
-end;
-
-function IsForegroundTask : Boolean;
-var
- Info : TCheckTaskInfo;
-begin
- Info.FocusWnd := GetActiveWindow;
- Info.Found := False;
-{$IFNDEF DARWIN}
- EnumThreadWindows(GetCurrentThreadID, @CheckTaskWindow, LPARAM(@Info)); //64
-{$ELSE}
- EnumThreadWindows(LongWord(GetCurrentThreadID), @CheckTaskWindow, LPARAM(@Info)); //64
-{$ENDIF}
- Result := Info.Found;
-end;
-
-procedure FixTextBuffer(InBuf, OutBuf : PChar; OutSize : Integer);
-var
- I, P : Integer;
-begin
- P := 0;
- for I := 0 to StrLen(InBuf) do begin
- if (InBuf[I] = #10) and ((I = 0) or (InBuf[I-1] <> #13)) then begin
- OutBuf[P] := #13;
- Inc(P);
- end;
- OutBuf[P] := InBuf[I];
- {is outbuf full?}
- if P = OutSize-1 then begin
- {if so, terminate and exit}
- OutBuf[OutSize] := #0;
- Break;
- end;
- Inc(P);
- end;
-end;
-
-{ - Hdc changed to TOvcHdc for BCB Compatibility }
-procedure TransStretchBlt(DstDC: TOvcHdc{HDC}; DstX, DstY, DstW, DstH: Integer;
- SrcDC: TOvcHdc{HDC}; SrcX, SrcY, SrcW, SrcH: Integer;
- MaskDC: TOvcHdc{HDC};
- MaskX, MaskY : Integer);
-var
- MemDC : HDC;
- MemBmp : HBITMAP;
- Save : THandle;
- crText, crBack : TColorRef;
- SystemPalette16, SavePal : HPALETTE;
-begin
- SavePal := 0;
- MemDC := CreateCompatibleDC(0);
- try
- MemBmp := CreateCompatibleBitmap(SrcDC, SrcW, SrcH);
- Save := SelectObject(MemDC, MemBmp);
- SystemPalette16 := GetStockObject(DEFAULT_PALETTE);
- SavePal := SelectPalette(SrcDC, SystemPalette16, False);
- SelectPalette(SrcDC, SavePal, False);
- if SavePal <> 0 then
- SavePal := SelectPalette(MemDC, SavePal, True)
- else
- SavePal := SelectPalette(MemDC, SystemPalette16, True);
- RealizePalette(MemDC);
-
- StretchBlt(MemDC, 0, 0, SrcW, SrcH, MaskDC, MaskX, MaskY,
- SrcW, SrcH, SrcCopy);
- StretchBlt(MemDC, 0, 0, SrcW, SrcH, SrcDC, SrcX, SrcY, SrcW, SrcH,
- SrcErase);
- crText := SetTextColor(DstDC, $0);
- crBack := SetBkColor(DstDC, $FFFFFF);
- StretchBlt(DstDC, DstX, DstY, DstW, DstH, MaskDC, MaskX, MaskY,
- SrcW, SrcH, SrcAnd);
- StretchBlt(DstDC, DstX, DstY, DstW, DstH, MemDC, 0, 0,
- SrcW, SrcH, SrcInvert);
- SetTextColor(DstDC, crText);
- SetBkColor(DstDC, crBack);
- if Save <> 0 then
- SelectObject(MemDC, Save);
- DeleteObject(MemBmp);
- finally
- if SavePal <> 0 then
- SelectPalette(MemDC, SavePal, False);
- DeleteDC(MemDC);
- end;
-end;
-
-function DefaultEpoch : Integer;
-var
- ThisYear : Word;
- ThisMonth : Word;
- ThisDay : Word;
-begin
- DecodeDate(SysUtils.Date, ThisYear, ThisMonth, ThisDay);
- Result := (ThisYear div 100) * 100;
-end;
-
-{function GenerateComponentName(PF : TCustomForm; const Root : string) : string;}
-function GenerateComponentName(PF : TWinControl; const Root : string) : string;
-var
- I : Integer;
-begin
- if not IsValidIdent(Root) then
- raise EComponentError.CreateFmt('''''%s'''' is not a valid component name',
- [Root]);
- I := 0;
- repeat
- Inc(I);
- Result := Root + IntToStr(I);
- until (PF.FindComponent(Result) = nil);
-end;
-
-function PartialCompare(const S1, S2 : string) : Boolean;
-var
- L : Integer;
-begin
- {and empty string matches nothing}
- Result := False;
- L := MinI(Length(S1), Length(S2));
- if L > 0 then
- Result := AnsiUpperCase(Copy(S1, 1, L)) = AnsiUpperCase(Copy(S2, 1, L));
-end;
-
-function PathEllipsis(const S : string; MaxWidth : Integer) : string;
- { PathEllipsis function. Trims a path down to the }
- { specified number of pixels. For example, }
- { 'd:\program files\my stuff\some long document.txt' }
- { becomes 'd:\...\some long...' or a variation thereof }
- { depending on the value of MaxWidth. }
-var
- R : TRect;
- BM : TBitmap;
- NCM : TNonClientMetrics;
-begin
- if MaxWidth = 0 then begin
- Result := S;
- Exit;
- end;
- NCM.cbSize := SizeOf(NCM);
- SystemParametersInfo(
- SPI_GETNONCLIENTMETRICS, NCM.cbSize, @NCM, 0);
- BM := TBitmap.Create;
- try
- BM.Canvas.Font.Handle := CreateFontIndirect(NCM.lfMenuFont);
- if BM.Canvas.TextWidth(S) < MaxWidth then begin
- Result := S;
- Exit;
- end;
- Result := ExtractFilePath(S);
- Delete(Result, Length(Result), 1);
- while BM.Canvas.TextWidth(Result + '\...\' + ExtractFileName(S)) > MaxWidth do begin
- { Start trimming the path, working backwards }
- Result := ExtractFilePath(Result);
- Delete(Result, Length(Result), 1);
- { Only drive letter left so break out of loop. }
- if Length(Result) = 2 then
- Break;
- end;
- { Add the filename back onto the modified path. }
- Result := Result + '\...\' + ExtractFileName(S);
- { Still too long? }
- if BM.Canvas.TextWidth(Result) > MaxWidth then begin
- R := Rect(0, 0, MaxWidth, 0);
- DrawText(BM.Canvas.Handle, PChar(Result), -1,
- R, DT_SINGLELINE or DT_END_ELLIPSIS or DT_MODIFYSTRING or DT_CALCRECT);
- end;
- finally
- BM.Free;
- end;
-end;
-
-function CreateDisabledBitmap(FOriginal : TBitmap; OutlineColor : TColor) : TBitmap;
- {-create TBitmap object with disabled glyph}
-const
- ROP_DSPDxax = $00E20746;
-var
- MonoBmp : TBitmap;
- IRect : TRect;
-begin
- IRect := Rect(0, 0, FOriginal.Width, FOriginal.Height);
- Result := TBitmap.Create;
- try
- Result.Width := FOriginal.Width;
- Result.Height := FOriginal.Height;
- MonoBmp := TBitmap.Create;
- try
- with MonoBmp do begin
- Assign(FOriginal);
- HandleType := bmDDB;
- Canvas.Brush.Color := OutlineColor;
- if Monochrome then begin
- Canvas.Font.Color := clWhite;
- Monochrome := False;
- Canvas.Brush.Color := clWhite;
- end;
- Monochrome := True;
- end;
- with Result.Canvas do begin
- Brush.Color := clBtnFace;
- FillRect(IRect);
- Brush.Color := clBtnHighlight;
- SetTextColor(Handle, clBlack);
- SetBkColor(Handle, clWhite);
- BitBlt(Handle, 1, 1, WidthOf(IRect), HeightOf(IRect),
- MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
- Brush.Color := clBtnShadow;
- SetTextColor(Handle, clBlack);
- SetBkColor(Handle, clWhite);
- BitBlt(Handle, 0, 0, WidthOf(IRect), HeightOf(IRect),
- MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
- end;
- finally
- MonoBmp.Free;
- end;
- except
- Result.Free;
- raise;
- end;
-end;
-
-type
- TParentControl = class(TWinControl);
-
-procedure CopyParentImage(Control : TControl; Dest : TCanvas);
-var
- I : Integer;
- Count : Integer;
- X, Y : Integer;
- OldDC : Integer;
- DC : hDC;
- R : TRect;
- SelfR : TRect;
- CtlR : TRect;
-begin
- if Control.Parent = nil then
- Exit;
-
- Count := Control.Parent.ControlCount;
- DC := Dest.Handle;
- SelfR := Bounds(Control.Left, Control.Top, Control.Width, Control.Height);
- X := -Control.Left; Y := -Control.Top;
-
- {copy parent control image}
- OldDC := SaveDC(DC);
- SetViewportOrgEx(DC, X, Y, nil);
- IntersectClipRect(DC, 0, 0, Control.Parent.ClientWidth, Control.Parent.ClientHeight);
- TParentControl(Control.Parent).PaintWindow(DC);
- RestoreDC(DC, OldDC);
-
- {copy images of graphic controls}
- for I := 0 to Count - 1 do begin
- if (Control.Parent.Controls[I] <> nil) and
- not (Control.Parent.Controls[I] is TWinControl) then begin
- if Control.Parent.Controls[I] = Control then
- Break;
- with Control.Parent.Controls[I] do begin
- CtlR := Bounds(Left, Top, Width, Height);
- if Bool(IntersectRect(R, SelfR, CtlR)) and Visible then begin
- OldDC := SaveDC(DC);
- SetViewportOrgEx(DC, Left + X, Top + Y, nil);
- IntersectClipRect(DC, 0, 0, Width, Height);
- Perform(WM_PAINT, DC, 0);
- RestoreDC(DC, OldDC);
- end;
- end;
- end;
- end;
-end;
-
-{ - Hdc changed to TOvcHdc for BCB Compatibility }
-procedure DrawTransparentBitmapPrim(DC : TOvcHdc{HDC}; Bitmap : HBitmap;
- xStart, yStart, Width, Height : Integer; Rect : TRect;
- TransparentColor : TColorRef);
- {-draw transparent bitmap}
-var
-{$IFNDEF LCL}
- BM : Windows.TBitmap;
-{$ELSE}
- BM : LclType.tagBITMAP;
-{$ENDIF}
- cColor : TColorRef;
- bmAndBack : hBitmap;
- bmAndObject : hBitmap;
- bmAndMem : hBitmap;
- bmSave : hBitmap;
- bmBackOld : hBitmap;
- bmObjectOld : hBitmap;
- bmMemOld : hBitmap;
- bmSaveOld : hBitmap;
- hdcMem : hDC;
- hdcBack : hDC;
- hdcObject : hDC;
- hdcTemp : hDC;
- hdcSave : hDC;
- ptSize : TPoint;
- ptRealSize : TPoint;
- ptBitSize : TPoint;
- ptOrigin : TPoint;
-begin
- hdcTemp := CreateCompatibleDC(DC);
- SelectObject(hdcTemp, Bitmap);
- GetObject(Bitmap, SizeOf(BM), @BM);
- ptRealSize.x := MinL(Rect.Right - Rect.Left, BM.bmWidth - Rect.Left);
- ptRealSize.y := MinL(Rect.Bottom - Rect.Top, BM.bmHeight - Rect.Top);
- DPtoLP(hdcTemp, ptRealSize, 1);
- ptOrigin.x := Rect.Left;
- ptOrigin.y := Rect.Top;
-
- {convert from device to logical points}
- DPtoLP(hdcTemp, ptOrigin, 1);
- {get width of bitmap}
- ptBitSize.x := BM.bmWidth;
- {get height of bitmap}
- ptBitSize.y := BM.bmHeight;
- DPtoLP(hdcTemp, ptBitSize, 1);
-
- if (ptRealSize.x = 0) or (ptRealSize.y = 0) then begin
- ptSize := ptBitSize;
- ptRealSize := ptSize;
- end else
- ptSize := ptRealSize;
- if (Width = 0) or (Height = 0) then begin
- Width := ptSize.x;
- Height := ptSize.y;
- end;
-
- {create DCs to hold temporary data}
- hdcBack := CreateCompatibleDC(DC);
- hdcObject := CreateCompatibleDC(DC);
- hdcMem := CreateCompatibleDC(DC);
- hdcSave := CreateCompatibleDC(DC);
- {create a bitmap for each DC}
- {monochrome DC}
- bmAndBack := CreateBitmap(ptSize.x, ptSize.y, 1, 1, nil);
- bmAndObject := CreateBitmap(ptSize.x, ptSize.y, 1, 1, nil);
- bmAndMem := CreateCompatibleBitmap(DC, MaxL(ptSize.x, Width), MaxL(ptSize.y, Height));
- bmSave := CreateCompatibleBitmap(DC, ptBitSize.x, ptBitSize.y);
- {select a bitmap object to store pixel data}
- bmBackOld := SelectObject(hdcBack, bmAndBack);
- bmObjectOld := SelectObject(hdcObject, bmAndObject);
- bmMemOld := SelectObject(hdcMem, bmAndMem);
- bmSaveOld := SelectObject(hdcSave, bmSave);
-
- SetMapMode(hdcTemp, GetMapMode(DC));
-
- {save the bitmap sent here, it will be overwritten}
- BitBlt(hdcSave, 0, 0, ptBitSize.x, ptBitSize.y, hdcTemp, 0, 0, SRCCOPY);
-
- {set the background color of the source DC to the color,}
- {contained in the parts of the bitmap that should be transparent}
- cColor := SetBkColor(hdcTemp, TransparentColor);
-
- {create the object mask for the bitmap by performing a BitBlt()}
- {from the source bitmap to a monochrome bitmap}
- BitBlt(hdcObject, 0, 0, ptSize.x, ptSize.y, hdcTemp, ptOrigin.x, ptOrigin.y, SRCCOPY);
-
- {set the background color of the source DC back to the original color}
- SetBkColor(hdcTemp, cColor);
-
- {create the inverse of the object mask}
- BitBlt(hdcBack, 0, 0, ptSize.x, ptSize.y, hdcObject, 0, 0, NOTSRCCOPY);
-
- {copy the background of the main DC to the destination}
- BitBlt(hdcMem, 0, 0, Width, Height, DC, xStart, yStart, SRCCOPY);
-
- {mask out the places where the bitmap will be placed}
- StretchBlt(hdcMem, 0, 0, Width, Height, hdcObject, 0, 0, ptSize.x, ptSize.y, SRCAND);
-
- {mask out the transparent colored pixels on the bitmap}
- BitBlt(hdcTemp, ptOrigin.x, ptOrigin.y, ptSize.x, ptSize.y, hdcBack, 0, 0, SRCAND);
-
- {XOR the bitmap with the background on the destination DC}
- StretchBlt(hdcMem, 0, 0, Width, Height, hdcTemp, ptOrigin.x, ptOrigin.y, ptSize.x, ptSize.y, SRCPAINT);
-
- {copy the destination to the screen}
- BitBlt(DC, xStart, yStart, MaxL(ptRealSize.x, Width), MaxL(ptRealSize.y, Height), hdcMem, 0, 0, SRCCOPY);
-
- {place the original bitmap back into the bitmap sent}
- BitBlt(hdcTemp, 0, 0, ptBitSize.x, ptBitSize.y, hdcSave, 0, 0, SRCCOPY);
-
- {delete the memory bitmaps}
- DeleteObject(SelectObject(hdcBack, bmBackOld));
- DeleteObject(SelectObject(hdcObject, bmObjectOld));
- DeleteObject(SelectObject(hdcMem, bmMemOld));
- DeleteObject(SelectObject(hdcSave, bmSaveOld));
-
- {delete the memory DCs}
- DeleteDC(hdcMem);
- DeleteDC(hdcBack);
- DeleteDC(hdcObject);
- DeleteDC(hdcSave);
- DeleteDC(hdcTemp);
-end;
-
-procedure DrawTransparentBitmap(Dest : TCanvas; X, Y, W, H : Integer;
- Rect : TRect; Bitmap : TBitmap; TransparentColor : TColor);
-var
- MemImage : TBitmap;
- R : TRect;
-begin
- MemImage := TBitmap.Create;
- try
- R := Bounds(0, 0, Bitmap.Width, Bitmap.Height);
- if TransparentColor = clNone then begin
-
- if (WidthOf(Rect) <> 0) and (HeightOf(Rect) <> 0) then
- R := Rect;
- MemImage.Width := WidthOf(R);
- MemImage.Height := HeightOf(R);
- MemImage.Canvas.CopyRect(Bounds(0, 0, MemImage.Width, MemImage.Height),
- Bitmap.Canvas, R);
-
- if (W = 0) or (H = 0) then
- Dest.Draw(X, Y, MemImage)
- else
- Dest.StretchDraw(Bounds(X, Y, W, H), MemImage);
-
- end else begin
- MemImage.Width := WidthOf(R);
- MemImage.Height := HeightOf(R);
- MemImage.Canvas.CopyRect(R, Bitmap.Canvas, R);
- if TransparentColor = clDefault then
- TransparentColor := MemImage.Canvas.Pixels[0, MemImage.Height - 1];
- DrawTransparentBitmapPrim(Dest.Handle, MemImage.Handle, X, Y, W, H,
- Rect, ColorToRGB(TransparentColor and not $02000000));
- end;
- finally
- MemImage.Free;
- end;
-end;
-
-
-function WidthOf(const R : TRect) : Integer;
-begin
- Result := R.Right - R.Left;
-end;
-
-function HeightOf(const R : TRect) : Integer;
-begin
- Result := R.Bottom - R.Top;
-end;
-
-procedure DebugOutput(const S : string);
-begin
- OutputDebugString(PChar(S));
- OutputDebugString(#13#10);
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/9c/9c6a866bde8c8a75764a4f4e8ddf14dc18e0e3c0.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/9c/9c6a866bde8c8a75764a4f4e8ddf14dc18e0e3c0.svn-base
deleted file mode 100644
index 53b0ec6d..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/9c/9c6a866bde8c8a75764a4f4e8ddf14dc18e0e3c0.svn-base
+++ /dev/null
@@ -1,1383 +0,0 @@
-{*********************************************************}
-{* OVCTCELL.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 ovctcell;
- {-Cell ancestor class; cell matrix class}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- SysUtils, Graphics, Classes, Controls,
- OvcTCmmn, OvcSpAry, OvcVer;
-
-type
- TOvcBaseTableCell = class(TOvcTableCellAncestor)
- protected {private}
- {.Z+}
- {property fields - even size}
- FColor : TColor;
- FFont : TFont;
- FHint : string;
- FMargin : Integer;
- FReferences : longint;
- FTable : TOvcTableAncestor;
- FTextHiColor: TColor;
- {property fields - odd size}
- FAcceptActivationClick : boolean;
- FAccess : TOvcTblAccess;
- FAdjust : TOvcTblAdjust;
- FShowHint : boolean;
- FTableColor : boolean;
- FTableFont : boolean;
- FTextStyle : TOvcTextStyle;
- Filler : Byte;
- {property event fields}
- FOnClick : TNotifyEvent;
- FOnDblClick : TNotifyEvent;
- FOnDragDrop : TDragDropEvent;
- FOnDragOver : TDragOverEvent;
- FOnEndDrag : TEndDragEvent;
- FOnEnter : TNotifyEvent;
- FOnExit : TNotifyEvent;
- FOnKeyDown : TKeyEvent;
- FOnKeyPress : TKeyPressEvent;
- FOnKeyUp : TKeyEvent;
- FOnMouseDown : TMouseEvent;
- FOnMouseMove : TMouseMoveEvent;
- FOnMouseUp : TMouseEvent;
- FOnOwnerDraw : TCellPaintNotifyEvent;
- {.Z-}
-
- tcBadColorValue : boolean;
- tcBadFontValue : boolean;
- tcNoConfigChange : boolean;
-
- {property methods}
- function GetAbout : string;
- procedure SetAbout(const Value : string);
-
- protected
- {.Z+}
- {property access}
- function GetColor : TColor;
- function GetCellEditor : TControl; virtual;
- function GetFont : TFont;
-
- procedure SetAccess(A : TOvcTblAccess);
- procedure SetAdjust(A : TOvcTblAdjust);
- procedure SetColor(C : TColor);
- procedure SetFont(F : TFont);
- procedure SetHint(const H : string);
- procedure SetMargin(M : Integer);
- procedure SetTable(T : TOvcTableAncestor);
- procedure SetTableColor(B : boolean);
- procedure SetTableFont(B : boolean);
- procedure SetTextHiColor(THC : TColor);
- procedure SetTextStyle(TS : TOvcTextStyle);
-
- {property storage}
- function IsColorStored : boolean;
- function IsFontStored : boolean;
-
- {miscellaneous}
- procedure tcChangeScale(M, D : integer); override;
- procedure tcFontHasChanged(Sender : TObject);
- procedure tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer); virtual;
- procedure tcRetrieveTableColor;
- function tcRetrieveTableActiveCol : TColNum;
- function tcRetrieveTableActiveRow : TRowNum;
- procedure tcRetrieveTableFont;
- function tcRetrieveTableLockedCols : TColNum;
- function tcRetrieveTableLockedRows : TRowNum;
- {.Z-}
-
- {properties}
- property Color : TColor
- read GetColor write SetColor
- stored IsColorStored;
-
- property TextHiColor : TColor
- read FTextHiColor write SetTextHiColor;
-
- property Font : TFont
- read GetFont write SetFont
- stored IsFontStored;
-
- property Hint : string
- read FHint write SetHint;
-
- property Margin : Integer
- read FMargin write SetMargin;
-
- property ShowHint : boolean
- read FShowHint write FShowHint;
-
- property TableColor : boolean
- read FTableColor write SetTableColor;
-
- property TableFont : boolean
- read FTableFont write SetTableFont;
-
- property TextStyle : TOvcTextStyle
- read FTextStyle write SetTextStyle;
-
- {events}
- property OnClick : TNotifyEvent
- read FOnClick write FOnClick;
-
- property OnDblClick : TNotifyEvent
- read FOnDblClick write FOnDblClick;
-
- property OnDragDrop : TDragDropEvent
- read FOnDragDrop write FOnDragDrop;
-
- property OnDragOver : TDragOverEvent
- read FOnDragOver write FOnDragOver;
-
- property OnEndDrag : TEndDragEvent
- read FOnEndDrag write FOnEndDrag;
-
- property OnEnter : TNotifyEvent
- read FOnEnter write FOnEnter;
-
- property OnExit : TNotifyEvent
- read FOnExit write FOnExit;
-
- property OnKeyDown : TKeyEvent
- read FOnKeyDown write FOnKeyDown;
-
- property OnKeyPress : TKeyPressEvent
- read FOnKeyPress write FOnKeyPress;
-
- property OnKeyUp : TKeyEvent
- read FOnKeyUp write FOnKeyUp;
-
- property OnMouseDown : TMouseEvent
- read FOnMouseDown write FOnMouseDown;
-
- property OnMouseMove : TMouseMoveEvent
- read FOnMouseMove write FOnMouseMove;
-
- property OnMouseUp : TMouseEvent
- read FOnMouseUp write FOnMouseUp;
-
- property OnOwnerDraw : TCellPaintNotifyEvent
- read FOnOwnerDraw write FOnOwnerDraw;
-
- public {protected}
- {.Z+}
- {internal use only methods}
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- procedure tcResetTableValues; override;
-
- {methods to support third-party components in the data-aware table}
- function SpecialCellSupported(Field : TObject) : Boolean;
- virtual;
- function SpecialCellDataSize : Integer;
- virtual;
- procedure SpecialCellDataTransfer(Field : TObject; Data : Pointer; Purpose : TOvcCellDataPurpose);
- virtual;
- {.Z-}
-
- public
- constructor Create(AOwner : TComponent); override;
- destructor Destroy; override;
-
- {reference counting}
- procedure IncRefs;
- procedure DecRefs;
-
- {Edit cell base methods to override}
- function EditHandle : THandle; virtual;
- procedure EditHide; virtual;
- procedure EditMove(CellRect : TRect); virtual;
-
- {Editing base methods to override}
- function CanSaveEditedData(SaveValue : boolean) : boolean; virtual;
- function CanStopEditing(SaveValue : boolean) : boolean; {for Orpheus 1.0 compatibility}
- function FilterTableKey(var Msg : TWMKey) : TOvcTblKeyNeeds; virtual;
- {.Z+}
- procedure PostMessageToTable(Msg, wParam, lParam : longint);
- {.Z-}
- procedure SendKeyToTable(var Msg : TWMKey);
- procedure SaveEditedData(Data : pointer); virtual;
- procedure StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer); virtual;
- procedure StopEditing(SaveValue : boolean;
- Data : pointer); virtual;
- function TableWantsEnter : boolean;
- function TableWantsTab : boolean;
-
- {painting}
- {.Z+}
- function DoOwnerDraw(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer) : boolean; virtual;
- {.Z-}
- procedure Paint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer);
- procedure ResolveAttributes(RowNum : TRowNum; ColNum : TColNum;
- var CellAttr : TOvcCellAttributes); virtual;
-
- {properties}
- property AcceptActivationClick : boolean
- read FAcceptActivationClick write FAcceptActivationClick;
-
- property Access : TOvcTblAccess
- read FAccess write SetAccess;
-
- property Adjust : TOvcTblAdjust
- read FAdjust write SetAdjust;
-
- property CellEditor : TControl
- read GetCellEditor;
-
- property References : longint
- read FReferences;
-
- property Table : TOvcTableAncestor
- read FTable write SetTable;
-
- published
- property About : string
- read GetAbout write SetAbout stored False;
- end;
-
- TOvcTableCells = class
- protected {private}
- {.Z+}
- {property fields}
- FMatrix : TOvcSparseArray;
- FOnCfgChanged : TNotifyEvent;
- FTable : TOvcTableAncestor;
-
- {other fields}
- tcCellAttrCount : longint; {count of non-blank cells}
- {.Z-}
-
- protected
- {.Z+}
- function GetAccess(RowNum : TRowNum; ColNum : TColNum) : TOvcTblAccess;
- function GetAdjust(RowNum : TRowNum; ColNum : TColNum) : TOvcTblAdjust;
- function GetCell(RowNum : TRowNum; ColNum : TColNum) : TOvcBaseTableCell;
- function GetColor(RowNum : TRowNum; ColNum : TColNum) : TColor;
- function GetFont(RowNum : TRowNum; ColNum : TColNum) : TFont;
-
- procedure SetAccess(RowNum : TRowNum; ColNum : TColNum; A : TOvcTblAccess);
- procedure SetAdjust(RowNum : TRowNum; ColNum : TColNum; A : TOvcTblAdjust);
- procedure SetCell(RowNum : TRowNum; ColNum : TColNum; BTC : TOvcBaseTableCell);
- procedure SetColor(RowNum : TRowNum; ColNum : TColNum; C : TColor);
- procedure SetFont(RowNum : TRowNum; ColNum : TColNum; F : TFont);
- {.Z-}
-
- public {protected}
- {.Z+}
- {internal use only methods}
- procedure tcNotifyCellDeletion(Cell : TOvcBaseTableCell);
- procedure tcDoCfgChanged;
-
- property OnCfgChanged : TNotifyEvent
- write FOnCfgChanged;
- property Table : TOvcTableAncestor
- read FTable write FTable;
- {.Z-}
-
- public
- constructor Create(ATable : TOvcTableAncestor);
- destructor Destroy; override;
-
- procedure DeleteCol(ColNum : TColNum);
- procedure DeleteRow(RowNum : TRowNum);
- procedure ExchangeCols(ColNum1, ColNum2 : TColNum);
- procedure ExchangeRows(RowNum1, RowNum2 : TRowNum);
- procedure InsertCol(ColNum : TColNum);
- procedure InsertRow(RowNum : TRowNum);
-
- procedure ResetCell(RowNum : TRowNum; ColNum : TColNum);
- procedure ResolveFullAttr(RowNum : TRowNum; ColNum : TColNum;
- var SCA : TOvcSparseAttr);
-
- property Access [RowNum : TRowNum; ColNum : TColNum] : TOvcTblAccess
- read GetAccess write SetAccess;
-
- property Adjust [RowNum : TRowNum; ColNum : TColNum] : TOvcTblAdjust
- read GetAdjust write SetAdjust;
-
- property Cell [RowNum : TRowNum; ColNum : TColNum] : TOvcBaseTableCell
- read GetCell write SetCell;
- default;
-
- property Color [RowNum : TRowNum; ColNum : TColNum] : TColor
- read GetColor write SetColor;
-
- property Font [RowNum : TRowNum; ColNum : TColNum] : TFont
- read GetFont write SetFont;
- end;
-
-implementation
-
-{===TOvcCustomCell===================================================}
-constructor TOvcBaseTableCell.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
-
- FAccess := otxDefault;
- FAdjust := otaDefault;
- FColor := tbDefTableColor;
- FTextHiColor := clBtnHighlight;
- FFont := TFont.Create;
- FFont.OnChange := tcFontHasChanged;
- FTableColor := true;
- tcBadColorValue := true;
- FTableFont := true;
- tcBadFontValue := true;
- FMargin := tbDefMargin;
- end;
-{--------}
-destructor TOvcBaseTableCell.Destroy;
- begin
- Table := nil;
- FFont.Free;
- inherited Destroy;
- end;
-{--------}
-
-function TOvcBaseTableCell.EditHandle : THandle;
-begin
- {do nothing. just here to satisfy BCB}
- Result := 0;
-end;
-
-procedure TOvcBaseTableCell.EditHide;
-begin
- {do nothing. just here to satisfy BCB}
-end;
-
-procedure TOvcBaseTableCell.EditMove(CellRect : TRect);
-begin
- {do nothing. just here to satisfy BCB}
-end;
-
-function TOvcBaseTableCell.CanSaveEditedData(SaveValue : boolean) : boolean;
- begin
- Result := true;
- end;
-{--------}
-function TOvcBaseTableCell.CanStopEditing(SaveValue : boolean) : boolean;
- begin
- Result := CanSaveEditedData(SaveValue);
- end;
-{--------}
-procedure TOvcBaseTableCell.tcChangeScale(M, D : integer);
- begin
- if (M <> D) and (not TableFont) then
- FFont.Size := MulDiv(FFont.Size, M, D);
- end;
-{--------}
-procedure TOvcBaseTableCell.DecRefs;
- begin
-//try // LCL: On Carbon, get "EXC_BAD_ACCESS, Could not access memory" for
- // FReferences when free cell's column (for example, when quit app),
- // as though cell object's memory already freed, so trap and ignore.
- if (FReferences > 0) then
- begin
- dec(FReferences);
- if (FReferences = 0) then
- begin
- FTable.tbExcludeCell(Self);
- FTable := nil;
- FOnCfgChanged := nil;
- end;
- end;
-//except
-//end;
- end;
-{--------}
-function TOvcBaseTableCell.DoOwnerDraw(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer) : boolean;
- begin
- Result := false;
- if Assigned(FOnOwnerDraw) then
- FOnOwnerDraw(Self, TableCanvas, CellRect, RowNum, ColNum, CellAttr, Data, Result);
- end;
-{--------}
-function TOvcBaseTableCell.FilterTableKey(var Msg : TWMKey) : TOvcTblKeyNeeds;
- begin
- if not Assigned(FTable) then
- Result := otkDontCare
- else
- Result := FTable.FilterKey(Msg);
- end;
-{--------}
-procedure TOvcBaseTableCell.tcFontHasChanged(Sender : TObject);
- begin
- if not tcNoConfigChange then
- begin
- FTableFont := false;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-function TOvcBaseTableCell.GetColor : TColor;
- begin
- if TableColor and tcBadColorValue then
- tcRetrieveTableColor;
- Result := FColor;
- end;
-{--------}
-function TOvcBaseTableCell.GetCellEditor : TControl;
- begin
- Result := nil;
- end;
-{--------}
-function TOvcBaseTableCell.GetFont : TFont;
- begin
- if TableFont and tcBadFontValue then
- begin
- tcNoConfigChange := true;
- tcRetrieveTableFont;
- tcNoConfigChange := false;
- end;
- Result := FFont;
- end;
-{--------}
-procedure TOvcBaseTableCell.IncRefs;
- begin
- if (FReferences = 0) and Assigned(FTable) then
- FTable.tbIncludeCell(Self);
- inc(FReferences);
- end;
-{--------}
-function TOvcBaseTableCell.IsColorStored : boolean;
- begin
- Result := not TableColor;
- end;
-{--------}
-function TOvcBaseTableCell.IsFontStored : boolean;
- begin
- Result := not TableFont;
- end;
-{--------}
-procedure TOvcBaseTableCell.Notification(AComponent: TComponent; Operation: TOperation);
- begin
- inherited Notification(AComponent, Operation);
- if (AComponent is TOvcTableAncestor) and
- (Operation = opRemove) and
- (TOvcTableAncestor(AComponent) = FTable) then
- begin
- FTable := nil;
- FOnCfgChanged := nil;
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.Paint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer);
- begin
- if not DoOwnerDraw(TableCanvas, CellRect, RowNum, ColNum, CellAttr, Data) then
- tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, Data);
- end;
-{--------}
-procedure TOvcBaseTableCell.tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer);
- begin
- with TableCanvas do
- begin
- Brush.Color := CellAttr.caColor;
- FillRect(CellRect);
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.PostMessageToTable(Msg, wParam, lParam : longint);
- begin
- if Assigned(FTable) and FTable.HandleAllocated then
- PostMessage(FTable.Handle, Msg, wParam, lParam)
- end;
-{--------}
-procedure TOvcBaseTableCell.tcResetTableValues;
- begin
- if Assigned(FTable) then
- begin
- if TableFont then
- tcRetrieveTableFont;
- if TableColor then
- tcRetrieveTableColor;
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.ResolveAttributes(RowNum : TRowNum; ColNum : TColNum;
- var CellAttr : TOvcCellAttributes);
- begin
- with CellAttr do
- begin
- caAccess := Access;
- caAdjust := Adjust;
- caColor := Color;
- caFont.Assign(Font);
- caFontColor := Font.Color;
- caFontHiColor := TextHiColor;
- caTextStyle := TextStyle;
- end;
- if Assigned(FTable) then
- FTable.ResolveCellAttributes(RowNum, ColNum, CellAttr);
- with CellAttr do
- begin
- if (caAccess = otxDefault) then
- caAccess := tbDefAccess;
- if (caAdjust = otaDefault) then
- caAdjust := tbDefAdjust;
- if (caColor = clOvcTableDefault) then
- caColor := tbDefTableColor;
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.tcRetrieveTableColor;
- begin
- if Assigned(FTable) and FTable.HandleAllocated then
- begin
- FColor := SendMessage(FTable.Handle, ctim_QueryColor, 0, 0);
- tcBadColorValue := false;
- end
- else
- tcBadColorValue := true;
- end;
-{--------}
-function TOvcBaseTableCell.tcRetrieveTableActiveCol : TColNum;
- begin
- Result := 0;
- if Assigned(FTable) and FTable.HandleAllocated then
- Result := SendMessage(FTable.Handle, ctim_QueryActiveCol, 0, 0);
- end;
-{--------}
-function TOvcBaseTableCell.tcRetrieveTableActiveRow : TRowNum;
- begin
- Result := 0;
- if Assigned(FTable) and FTable.HandleAllocated then
- Result := SendMessage(FTable.Handle, ctim_QueryActiveRow, 0, 0);
- end;
-{--------}
-procedure TOvcBaseTableCell.tcRetrieveTableFont;
- var
- TblFont : TFont;
- begin
- if Assigned(FTable) and FTable.HandleAllocated then
- begin
- TblFont := TFont(SendMessage(FTable.Handle, ctim_QueryFont, 0, 0));
- if Assigned(TblFont) then
- FFont.Assign(TblFont);
- tcBadFontValue := false;
- FTableFont := true;
- end
- else
- tcBadFontValue := true;
- end;
-{--------}
-function TOvcBaseTableCell.tcRetrieveTableLockedCols : TColNum;
- begin
- Result := 0;
- if Assigned(FTable) and FTable.HandleAllocated then
- Result := SendMessage(FTable.Handle, ctim_QueryLockedCols, 0, 0);
- end;
-{--------}
-function TOvcBaseTableCell.tcRetrieveTableLockedRows : TRowNum;
- begin
- Result := 0;
- if Assigned(FTable) and FTable.HandleAllocated then
- Result := SendMessage(FTable.Handle, ctim_QueryLockedRows, 0, 0);
- end;
-{--------}
-procedure TOvcBaseTableCell.SendKeyToTable(var Msg : TWMKey);
- begin
- if Assigned(FTable) and FTable.HandleAllocated then
- PostMessage(FTable.Handle, WM_KEYDOWN, Msg.CharCode, Msg.KeyData);
- end;
-{--------}
-procedure TOvcBaseTableCell.SetAccess(A : TOvcTblAccess);
- begin
- if (A <> FAccess) then
- begin
- FAccess := A;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.SetAdjust(A : TOvcTblAdjust);
- begin
- if (A <> FAdjust) then
- begin
- FAdjust := A;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.SetColor(C : TColor);
- begin
- if (C <> FColor) then
- begin
- FColor := C;
- FTableColor := false;
- tcBadColorValue := false;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.SetFont(F : TFont);
- begin
- FFont.Assign(F);
- tcBadFontValue := false;
- FTableFont := false;
- tcDoCfgChanged;
- end;
-{--------}
-procedure TOvcBaseTableCell.SetHint(const H : string);
- begin
- FHint := H;
- end;
-{--------}
-procedure TOvcBaseTableCell.SetMargin(M : Integer);
- begin
- if (M >= 0) and (M <> FMargin) then
- begin
- FMargin := M;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.SetTable(T : TOvcTableAncestor);
- begin
- if (T <> FTable) then
- if (not Assigned(T)) or (T is TOvcTableAncestor) then
- begin
- if Assigned(FTable) and FTable.HandleAllocated then
- SendMessage(FTable.Handle, ctim_RemoveCell, 0, longint(Self));
- FTable := T;
- FOnCfgChanged := nil;
- FReferences := 0;
- tcResetTableValues;
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.SetTableColor(B : boolean);
- begin
- if (B <> FTableColor) then
- begin
- tcBadColorValue := false;
- FTableColor := B;
- if B then
- tcRetrieveTableColor;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.SetTableFont(B : boolean);
- begin
- if (B <> FTableFont) then
- begin
- tcBadFontValue := false;
- if B then
- tcRetrieveTableFont;
- FTableFont := B;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.SetTextHiColor(THC : TColor);
- begin
- if (THC <> FTextHiColor) then
- begin
- FTextHiColor := THC;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.SetTextStyle(TS : TOvcTextStyle);
- begin
- if (TS <> FTextStyle) then
- begin
- FTextStyle := TS;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.SaveEditedData(Data : pointer);
-begin
- {do nothing. just here to satisfy BCB}
-end;
-
-procedure TOvcBaseTableCell.StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer);
-begin
- {do nothing. just here to satisfy BCB}
-end;
-
-procedure TOvcBaseTableCell.StopEditing(SaveValue : boolean;
- Data : pointer);
-begin
- {do nothing. just here to satisfy BCB}
-end;
-
-function TOvcBaseTableCell.TableWantsEnter : boolean;
- var
- Typecast : record
- case boolean of
- false : (LI : longint);
- true : (TblOpts : TOvcTblOptionSet);
- end;
- begin
- Result := false;
- if Assigned(FTable) and FTable.HandleAllocated then
- begin
- Typecast.LI := SendMessage(FTable.Handle, ctim_QueryOptions, 0, 0);
- Result := otoEnterToArrow in Typecast.TblOpts;
- end;
- end;
-{--------}
-function TOvcBaseTableCell.TableWantsTab : boolean;
- var
- Typecast : record
- case boolean of
- false : (LI : longint);
- true : (TblOpts : TOvcTblOptionSet);
- end;
- begin
- Result := false;
- if Assigned(FTable) and FTable.HandleAllocated then
- begin
- Typecast.LI := SendMessage(FTable.Handle, ctim_QueryOptions, 0, 0);
- Result := otoTabToArrow in Typecast.TblOpts;
- end;
- end;
-
-function TOvcBaseTableCell.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-
-procedure TOvcBaseTableCell.SetAbout(const Value : string);
-begin
-end;
-
-{the following three methods should be implemented for descendant }
-{cell components to allow them to be used by the data-aware table.}
-
-function TOvcBaseTableCell.SpecialCellSupported(Field : TObject) : Boolean;
-begin
- {return true if Field is a supported cell type for the data-aware table}
- Result := False;
-end;
-
-function TOvcBaseTableCell.SpecialCellDataSize : Integer;
-begin
- {return the size of the buffer needed to save data for this field/cell type}
- Result := 0;
-end;
-
-procedure TOvcBaseTableCell.SpecialCellDataTransfer(
- Field : TObject; Data : Pointer; Purpose : TOvcCellDataPurpose);
-begin
- {handle transfer of data to/from Field/Pointer}
- {as indicated by the value of Purpose:}
- {cdpForPaint ..for painting}
- {cdpForEdit ..for editing}
- {cdpForSave ..for saving edited data}
-end;
-
-
-{====================================================================}
-
-
-{===CellAttribute helper routines====================================}
-function CellAttributeIsBlank(CA : POvcSparseAttr) : boolean;
- begin
- Result := true;
- if Assigned(CA) then with CA^ do
- Result := (scaAccess = otxDefault) and
- (scaAdjust = otaDefault) and
- (scaColor = clOvcTableDefault) and
- (scaFont = nil) and
- (scaCell = nil);
- end;
-{--------}
-procedure DisposeCellAttribute(CA : POvcSparseAttr);
- begin
- if Assigned(CA) then with CA^ do
- begin
- scaFont.Free;
- if Assigned(scaCell) then
- TOvcBaseTableCell(scaCell).DecRefs;
- Dispose(CA);
- end;
- end;
-{--------}
-function GetCellAttribute(SA : TOvcSparseArray; RowNum : TRowNum; ColNum : TColNum) : POvcSparseAttr;
- var
- WorkSA : TOvcSparseArray;
- begin
- Result := nil;
- WorkSA := SA[RowNum];
- if Assigned(WorkSA) then
- Result := POvcSparseAttr(WorkSA[ColNum]);
- end;
-{--------}
-procedure InitCellAttribute(var SCA : TOvcSparseAttr);
- begin
- with SCA do
- begin
- scaAccess := otxDefault;
- scaAdjust := otaDefault;
- scaColor := clOvcTableDefault;
- scaFont := nil;
- scaCell := nil;
- end;
- end;
-{--------}
-function NewCellAttribute : POvcSparseAttr;
- begin
- New(Result);
- InitCellAttribute(Result^);
- end;
-{--------}
-function PutCellAttribute(SA : TOvcSparseArray; RowNum : TRowNum; ColNum : TColNum) : POvcSparseAttr;
- var
- WorkSA : TOvcSparseArray;
- begin
- Result := NewCellAttribute;
- WorkSA := SA[RowNum];
- if not Assigned(WorkSA) then
- begin
- WorkSA := TOvcSparseArray.Create;
- SA[RowNum] := WorkSA;
- end;
- WorkSA[ColNum] := Result;
- end;
-{--------}
-procedure ResetCellAttribute(SA : TOvcSparseArray; RowNum : TRowNum; ColNum : TColNum);
- var
- WorkSA : TOvcSparseArray;
- begin
- WorkSA := SA[RowNum];
- if Assigned(WorkSA) then
- WorkSA[ColNum] := nil;
- end;
-{====================================================================}
-
-
-{===SparseArray iterators============================================}
-type
- PDelColRec = ^TDelColRec;
- TDelColRec = packed record
- dcrCellAttrCount : longint;
- dcrColNum : longint;
- end;
- PExchColRec = ^TExchColRec;
- TExchColRec = packed record
- ecrColNum1 : longint;
- ecrColNum2 : longint;
- end;
-{--------}
-function DelCellAttribute(Index : longint;
- Item : pointer;
- ExtraData : pointer) : boolean; far;
- var
- CA : POvcSparseAttr absolute Item;
- begin
- DisposeCellAttribute(CA);
- Result := true;
- end;
-{--------}
-function DelSparseArray(Index : longint;
- Item : pointer;
- ExtraData : pointer) : boolean; far;
- var
- SL : TOvcSparseArray absolute Item;
- begin
- SL.ForAll(DelCellAttribute, false, ExtraData);
- SL.Destroy;
- Result := true;
- end;
-{--------}
-function DelCellMinor(Index : longint;
- Item : pointer;
- ExtraData : pointer) : boolean; far;
- var
- CA : POvcSparseAttr absolute Item;
- Cell : TOvcBaseTableCell absolute ExtraData;
- begin
- if (CA^.scaCell = Cell) then
- begin
- Cell.DecRefs;
- CA^.scaCell := nil;
- end;
- Result := true;
- end;
-{--------}
-function DelCellMajor(Index : longint;
- Item : pointer;
- ExtraData : pointer) : boolean; far;
- var
- SL : TOvcSparseArray absolute Item;
- begin
- SL.ForAll(DelCellMinor, false, ExtraData);
- Result := true;
- end;
-{--------}
-function DelCol(Index : longint;
- Item : pointer;
- ExtraData : pointer) : boolean; far;
- var
- SL : TOvcSparseArray absolute Item;
- MyExtraData : PDelColRec absolute ExtraData;
- CA : POvcSparseAttr;
- begin
- CA := POvcSparseAttr(SL[MyExtraData^.dcrColNum]);
- if Assigned(CA) then
- begin
- dec(MyExtraData^.dcrCellAttrCount);
- DisposeCellAttribute(CA);
- end;
- SL.Delete(MyExtraData^.dcrColNum);
- Result := true;
- end;
-{--------}
-function ExchCols(Index : longint;
- Item : pointer;
- ExtraData : pointer) : boolean; far;
- var
- SL : TOvcSparseArray absolute Item;
- MyExtraData : PExchColRec absolute ExtraData;
- begin
- with MyExtraData^ do
- SL.Exchange(ecrColNum1, ecrColNum2);
- Result := true;
- end;
-{--------}
-function InsCol(Index : longint;
- Item : pointer;
- ExtraData : pointer) : boolean; far;
- var
- SL : TOvcSparseArray absolute Item;
- ColNum : longint absolute ExtraData;
- begin
- SL.Insert(ColNum, nil);
- Result := true;
- end;
-{====================================================================}
-
-
-{===TOvcTableCells===================================================}
-constructor TOvcTableCells.Create;
- begin
- inherited Create;
- FMatrix := TOvcSparseArray.Create;
- end;
-{--------}
-destructor TOvcTableCells.Destroy;
- var
- DummyPtr : pointer;
- begin
- DummyPtr := nil;
- FMatrix.ForAll(DelSparseArray, false, DummyPtr);
- FMatrix.Destroy;
- inherited Destroy;
- end;
-{--------}
-procedure TOvcTableCells.DeleteCol(ColNum : TColNum);
- var
- MyExtraData : TDelColRec;
- begin
- if (tcCellAttrCount > 0) then
- begin
- MyExtraData.dcrCellAttrCount := tcCellAttrCount;
- MyExtraData.dcrColNum := ColNum;
- FMatrix.ForAll(DelCol, false, @MyExtraData);
- tcCellAttrCount := MyExtraData.dcrCellAttrCount;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableCells.DeleteRow(RowNum : TRowNum);
- var
- WorkSA : TOvcSparseArray;
- begin
- if (tcCellAttrCount > 0) then
- begin
- WorkSA := FMatrix[RowNum];
- if Assigned(WorkSA) then
- begin
- dec(tcCellAttrCount, WorkSA.ActiveCount);
- WorkSA.ForAll(DelCellAttribute, false, nil);
- end;
- FMatrix.Delete(RowNum);
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableCells.ExchangeCols(ColNum1, ColNum2 : TColNum);
- var
- MyExtraData : TExchColRec;
- begin
- if (tcCellAttrCount > 0) then
- begin
- MyExtraData.ecrColNum1 := ColNum1;
- MyExtraData.ecrColNum2 := ColNum2;
- FMatrix.ForAll(ExchCols, false, @MyExtraData);
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableCells.ExchangeRows(RowNum1, RowNum2 : TRowNum);
- begin
- if (tcCellAttrCount > 0) then
- begin
- FMatrix.Exchange(RowNum1, RowNum2);
- tcDoCfgChanged;
- end;
- end;
-{--------}
-function TOvcTableCells.GetAccess(RowNum : TRowNum; ColNum : TColNum) : TOvcTblAccess;
- var
- CellAttr : POvcSparseAttr;
- begin
- Result := otxDefault;
- if (tcCellAttrCount > 0) then
- begin
- CellAttr := GetCellAttribute(FMatrix, RowNum, ColNum);
- if Assigned(CellAttr) then
- Result := CellAttr^.scaAccess;
- end;
- end;
-{--------}
-function TOvcTableCells.GetAdjust(RowNum : TRowNum; ColNum : TColNum) : TOvcTblAdjust;
- var
- CellAttr : POvcSparseAttr;
- begin
- Result := otaDefault;
- if (tcCellAttrCount > 0) then
- begin
- CellAttr := GetCellAttribute(FMatrix, RowNum, ColNum);
- if Assigned(CellAttr) then
- Result := CellAttr^.scaAdjust;
- end;
- end;
-{--------}
-function TOvcTableCells.GetCell(RowNum : TRowNum; ColNum : TColNum) : TOvcBaseTableCell;
- var
- CellAttr : POvcSparseAttr;
- begin
- Result := nil;
- if (tcCellAttrCount > 0) then
- begin
- CellAttr := GetCellAttribute(FMatrix, RowNum, ColNum);
- if Assigned(CellAttr) then
- Result := TOvcBaseTableCell(CellAttr^.scaCell);
- end;
- end;
-{--------}
-function TOvcTableCells.GetColor(RowNum : TRowNum; ColNum : TColNum) : TColor;
- var
- CellAttr : POvcSparseAttr;
- begin
- Result := clOvcTableDefault;
- if (tcCellAttrCount > 0) then
- begin
- CellAttr := GetCellAttribute(FMatrix, RowNum, ColNum);
- if Assigned(CellAttr) then
- Result := CellAttr^.scaColor;
- end;
- end;
-{--------}
-function TOvcTableCells.GetFont(RowNum : TRowNum; ColNum : TColNum) : TFont;
- var
- CellAttr : POvcSparseAttr;
- begin
- Result := nil;
- if (tcCellAttrCount > 0) then
- begin
- CellAttr := GetCellAttribute(FMatrix, RowNum, ColNum);
- if Assigned(CellAttr) then
- Result := CellAttr^.scaFont;
- end;
- end;
-{--------}
-procedure TOvcTableCells.InsertCol(ColNum : TColNum);
- var
- LI : longint;
- begin
- if (tcCellAttrCount > 0) then
- begin
- LI := ColNum;
- FMatrix.ForAll(InsCol, false, pointer(LI));
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableCells.InsertRow(RowNum : TRowNum);
- begin
- if (tcCellAttrCount > 0) then
- begin
- FMatrix.Insert(RowNum, nil);
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableCells.tcNotifyCellDeletion(Cell : TOvcBaseTableCell);
- begin
- if (tcCellAttrCount > 0) then
- FMatrix.ForAll(DelCellMajor, false, Cell);
- end;
-{--------}
-procedure TOvcTableCells.ResolveFullAttr(RowNum : TRowNum; ColNum : TColNum;
- var SCA : TOvcSparseAttr);
- var
- CellAttr : POvcSparseAttr;
- begin
- if (tcCellAttrCount = 0) then
- InitCellAttribute(SCA)
- else
- begin
- CellAttr := GetCellAttribute(FMatrix, RowNum, ColNum);
- if Assigned(CellAttr) then
- SCA := CellAttr^
- else
- InitCellAttribute(SCA);
- end;
- end;
-{--------}
-procedure TOvcTableCells.tcDoCfgChanged;
- begin
- if Assigned(FOnCfgChanged) then FOnCfgChanged(Self);
- end;
-{--------}
-procedure TOvcTableCells.ResetCell(RowNum : TRowNum; ColNum : TColNum);
- var
- CellAttr : POvcSparseAttr;
- begin
- if (tcCellAttrCount > 0) then
- begin
- CellAttr := GetCellAttribute(FMatrix, RowNum, ColNum);
- if Assigned(CellAttr) then
- begin
- DisposeCellAttribute(CellAttr);
- ResetCellAttribute(FMatrix, RowNum, ColNum);
- dec(tcCellAttrCount);
- tcDoCfgChanged;
- end;
- end;
- end;
-{--------}
-procedure TOvcTableCells.SetAccess(RowNum : TRowNum; ColNum : TColNum; A : TOvcTblAccess);
- var
- CellAttr : POvcSparseAttr;
- begin
- if (tcCellAttrCount = 0) then
- CellAttr := nil
- else
- CellAttr := GetCellAttribute(FMatrix, RowNum, ColNum);
- if not Assigned(CellAttr) then
- begin
- CellAttr := PutCellAttribute(FMatrix, RowNum, ColNum);
- inc(tcCellAttrCount);
- end;
- CellAttr^.scaAccess := A;
- if CellAttributeIsBlank(CellAttr) then
- begin
- DisposeCellAttribute(CellAttr);
- ResetCellAttribute(FMatrix, RowNum, ColNum);
- dec(tcCellAttrCount);
- end;
- tcDoCfgChanged;
- end;
-{--------}
-procedure TOvcTableCells.SetAdjust(RowNum : TRowNum; ColNum : TColNum; A : TOvcTblAdjust);
- var
- CellAttr : POvcSparseAttr;
- begin
- if (tcCellAttrCount = 0) then
- CellAttr := nil
- else
- CellAttr := GetCellAttribute(FMatrix, RowNum, ColNum);
- if not Assigned(CellAttr) then
- begin
- CellAttr := PutCellAttribute(FMatrix, RowNum, ColNum);
- inc(tcCellAttrCount);
- end;
- CellAttr^.scaAdjust := A;
- if CellAttributeIsBlank(CellAttr) then
- begin
- DisposeCellAttribute(CellAttr);
- ResetCellAttribute(FMatrix, RowNum, ColNum);
- dec(tcCellAttrCount);
- end;
- tcDoCfgChanged;
- end;
-{--------}
-procedure TOvcTableCells.SetCell(RowNum : TRowNum; ColNum : TColNum; BTC : TOvcBaseTableCell);
- var
- CellAttr : POvcSparseAttr;
- DoIt : boolean;
- begin
- DoIt := false;
- if Assigned(BTC) then
- begin
- if (BTC.References = 0) or
- ((BTC.References > 0) and (BTC.Table = FTable)) then
- DoIt := true;
- end
- else
- DoIt := true;
-
- if DoIt then
- begin
- if (tcCellAttrCount = 0) then
- CellAttr := nil
- else
- CellAttr := GetCellAttribute(FMatrix, RowNum, ColNum);
- if not Assigned(CellAttr) then
- begin
- CellAttr := PutCellAttribute(FMatrix, RowNum, ColNum);
- inc(tcCellAttrCount);
- end;
- if Assigned(CellAttr^.scaCell) then
- TOvcBaseTableCell(CellAttr^.scaCell).DecRefs;
- if Assigned(BTC) then
- begin
- if (BTC.References = 0) then
- BTC.Table := FTable;
- BTC.IncRefs;
- end;
- CellAttr^.scaCell := BTC;
- if CellAttributeIsBlank(CellAttr) then
- begin
- DisposeCellAttribute(CellAttr);
- ResetCellAttribute(FMatrix, RowNum, ColNum);
- dec(tcCellAttrCount);
- end;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableCells.SetColor(RowNum : TRowNum; ColNum : TColNum; C : TColor);
- var
- CellAttr : POvcSparseAttr;
- begin
- if (tcCellAttrCount = 0) then
- CellAttr := nil
- else
- CellAttr := GetCellAttribute(FMatrix, RowNum, ColNum);
- if not Assigned(CellAttr) then
- begin
- CellAttr := PutCellAttribute(FMatrix, RowNum, ColNum);
- inc(tcCellAttrCount);
- end;
- CellAttr^.scaColor := C;
- if CellAttributeIsBlank(CellAttr) then
- begin
- DisposeCellAttribute(CellAttr);
- ResetCellAttribute(FMatrix, RowNum, ColNum);
- dec(tcCellAttrCount);
- end;
- tcDoCfgChanged;
- end;
-{--------}
-procedure TOvcTableCells.SetFont(RowNum : TRowNum; ColNum : TColNum; F : TFont);
- var
- CellAttr : POvcSparseAttr;
- begin
- if (tcCellAttrCount = 0) then
- CellAttr := nil
- else
- CellAttr := GetCellAttribute(FMatrix, RowNum, ColNum);
- if not Assigned(CellAttr) then
- begin
- CellAttr := PutCellAttribute(FMatrix, RowNum, ColNum);
- inc(tcCellAttrCount);
- end;
- with CellAttr^ do
- begin
- if not Assigned(F) then
- begin
- scaFont.Free;
- scaFont := nil;
- end
- else
- begin
- if not Assigned(scaFont) then
- scaFont := TFont.Create;
- scaFont.Assign(F);
- end;
- end;
- if CellAttributeIsBlank(CellAttr) then
- begin
- DisposeCellAttribute(CellAttr);
- ResetCellAttribute(FMatrix, RowNum, ColNum);
- dec(tcCellAttrCount);
- end;
- tcDoCfgChanged;
- end;
-{====================================================================}
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/a0/a0b4055814de2db7a71ac5fb168448d458c7c300.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/a0/a0b4055814de2db7a71ac5fb168448d458c7c300.svn-base
deleted file mode 100644
index 5506803c..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/a0/a0b4055814de2db7a71ac5fb168448d458c7c300.svn-base
+++ /dev/null
@@ -1,77 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 415
- Height = 289
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- PixelsPerInch = 96
- object Label1: TLabel
- Left = 16
- Top = 24
- Width = 385
- Height = 33
- Alignment = taCenter
- AutoSize = False
- Caption = 'Enter a positive integer, then move to next control to validate.'
- WordWrap = True
- end
- object Label2: TLabel
- Left = 16
- Top = 104
- Width = 385
- Height = 33
- Alignment = taCenter
- AutoSize = False
- Caption =
- 'Enter a positive real number, then move to next control to valid' +
- 'ate.'
- WordWrap = True
- end
- object OvcSimpleField1: TOvcSimpleField
- Left = 168
- Top = 56
- Width = 81
- Height = 21
- Cursor = crIBeam
- DataType = sftString
- CaretOvr.Shape = csBlock
- ControlCharColor = clRed
- DecimalPlaces = 0
- EFColors.Disabled.BackColor = clWindow
- EFColors.Disabled.TextColor = clGrayText
- EFColors.Error.BackColor = clRed
- EFColors.Error.TextColor = clBlack
- EFColors.Highlight.BackColor = clHighlight
- EFColors.Highlight.TextColor = clHighlightText
- PictureMask = 'X'
- TabOrder = 0
- OnError = OvcSimpleFieldError
- OnUserValidation = OvcSimpleField1UserValidation
- end
- object OvcSimpleField2: TOvcSimpleField
- Left = 168
- Top = 136
- Width = 81
- Height = 21
- Cursor = crIBeam
- DataType = sftString
- CaretOvr.Shape = csBlock
- ControlCharColor = clRed
- DecimalPlaces = 0
- EFColors.Disabled.BackColor = clWindow
- EFColors.Disabled.TextColor = clGrayText
- EFColors.Error.BackColor = clRed
- EFColors.Error.TextColor = clBlack
- EFColors.Highlight.BackColor = clHighlight
- EFColors.Highlight.TextColor = clHighlightText
- PictureMask = 'X'
- TabOrder = 1
- OnError = OvcSimpleFieldError
- OnUserValidation = OvcSimpleField2UserValidation
- end
-end
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/a3/a395f85c58690cf87fe83dbd8716bf873297dceb.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/a3/a395f85c58690cf87fe83dbd8716bf873297dceb.svn-base
deleted file mode 100644
index cd79d3f9..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/a3/a395f85c58690cf87fe83dbd8716bf873297dceb.svn-base
+++ /dev/null
@@ -1,78 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 443
- Height = 327
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'MS Sans Serif'
- Font.Style = []
- OldCreateOrder = False
- PixelsPerInch = 96
- TextHeight = 13
- object OvcRotatedLabel1: TOvcRotatedLabel
- Left = 56
- Top = 32
- Width = 153
- Height = 25
- AutoSize = False
- Caption = 'Not rotated'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -13
- Font.Name = 'Arial'
- Font.Style = []
- ShadowedText = False
- end
- object OvcRotatedLabel2: TOvcRotatedLabel
- Left = 56
- Top = 80
- Width = 153
- Height = 57
- AutoSize = False
- Caption = 'Rotated 15 degrees'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -13
- Font.Name = 'Arial'
- Font.Style = []
- FontAngle = 15
- OriginY = 30
- ShadowedText = False
- end
- object OvcRotatedLabel3: TOvcRotatedLabel
- Left = 56
- Top = 160
- Width = 153
- Height = 57
- AutoSize = False
- Caption = 'Rotated -15 degrees'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -13
- Font.Name = 'Arial'
- Font.Style = []
- FontAngle = -15
- OriginX = 5
- ShadowedText = False
- end
- object OvcRotatedLabel4: TOvcRotatedLabel
- Left = 264
- Top = 32
- Width = 65
- Height = 185
- AutoSize = False
- Caption = 'Rotated 90 degrees'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -13
- Font.Name = 'Arial'
- Font.Style = []
- FontAngle = 90
- OriginY = 175
- ShadowedText = False
- end
-end
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/a4/a4230c27393eca4ac5410c57be399ed706d0cc57.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/a4/a4230c27393eca4ac5410c57be399ed706d0cc57.svn-base
deleted file mode 100644
index a95dc727..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/a4/a4230c27393eca4ac5410c57be399ed706d0cc57.svn-base
+++ /dev/null
@@ -1,43 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 378
- Height = 306
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- PixelsPerInch = 96
- object OvcLabel1: TOvcLabel
- Left = 64
- Top = 32
- Width = 257
- Height = 49
- Caption = 'Fancy Raised Label'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clGray
- Font.Height = -26
- Font.Style = []
- ParentColor = False
- end
- object OvcLabel2: TOvcLabel
- Left = 64
- Top = 112
- Width = 257
- Height = 49
- Appearance = apSunken
- Caption = 'Fancy Sunken Label'
- Color = clBtnFace
- ColorScheme = csCustom
- CustomSettings.HighlightDirection = sdDownRight
- CustomSettings.ShadowDirection = sdUpLeft
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clGray
- Font.Height = -26
- Font.Style = []
- ParentColor = False
- end
-end
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/a4/a4a7e13dfaa36c980d3f74d32ab684f636669279.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/a4/a4a7e13dfaa36c980d3f74d32ab684f636669279.svn-base
deleted file mode 100644
index 42e167f2..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/a4/a4a7e13dfaa36c980d3f74d32ab684f636669279.svn-base
+++ /dev/null
@@ -1,450 +0,0 @@
-{*********************************************************}
-{* O32BORDR.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 o32bordr;
- {New Style Border control for Orpheus 4 components.}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, MyMisc, {$ENDIF}
- Classes, Controls, Graphics;
-
-type
- TO32BorderStyle = (bstyNone, bstyRaised, bstyLowered, bstyFlat, bstyChannel,
- bstyRidge);
-
-const
- THiliteColor: array[TO32BorderStyle] of TColor = (clWindow, clBtnHighlight,
- clBtnShadow, clWindowFrame, clBtnShadow, clBtnHighlight);
-
- TBaseColor: array[TO32BorderStyle] of TColor = (clWindow, clBtnShadow,
- clBtnHighlight, clWindowFrame, clBtnHighlight, clBtnShadow);
-
-type
- TO32BorderSide = (bsidLeft, bsidRight, bsidTop, bsidBottom);
-
- TSides = (left, right, top, bottom);
-
- TO32Borders = class;
-
- TO32BorderSet = class(TPersistent)
- protected {private}
- FOwner : TPersistent;
- FLeft : Boolean;
- FTop : Boolean;
- FRight : Boolean;
- FBottom : Boolean;
- procedure SetLeft(Value: Boolean);
- procedure SetRight(Value: Boolean);
- procedure SetBottom(Value: Boolean);
- procedure SetTop(Value: Boolean);
- public
- constructor Create(AOwner: TPersistent);
- published
- property ShowLeft : Boolean read FLeft write SetLeft
- default True;
- property ShowRight : Boolean read FRight write SetRight
- default True;
- property ShowTop : Boolean read FTop write SetTop
- default True;
- property ShowBottom : Boolean read FBottom write SetBottom
- default True;
- end;
-
- TO32Borders = class(TPersistent)
- protected {private}
- Creating : Boolean;
- FControl : TWinControl;
- FBorderSet : TO32BorderSet;
- FActive : Boolean;
- FFlatColor : TColor;
- FBorderWidth : Integer;
- FBorderStyle : TO32BorderStyle;
- procedure SetActive (Value : Boolean);
- procedure SetBorderStyle (Value : TO32BorderStyle);
- procedure SetFlatColor (Value : TColor);
-
- procedure Draw3dBox(Canvas: TCanvas; Rct: TRect; Hilite,
- Base: TColor; DrawAllSides: Boolean);
- procedure DrawFlatBorder(Canvas: TControlCanvas; Rct: TRect;
- Color: TColor{; DrawAllSides: Boolean}); {!!!}
- procedure DrawBevel(Canvas: TControlCanvas; Rct: TRect; HiliteColor,
- BaseColor: TColor);
- procedure Draw3dBorders(Canvas: TControlCanvas; Rct: TRect);
- procedure EraseBorder(Canvas: TControlCanvas; Rct: TRect;
- Color: TColor; AllSides: Boolean);
- procedure DrawSingleSolidBorder(Canvas: TControlCanvas; Rct: TRect;
- Color: TColor; Side: TSides; Width: Integer);
- public
- constructor Create(Control: TWinControl);
- destructor Destroy; override;
- procedure Changed;
- procedure BordersChanged;
- property Control: TWinControl read FControl;
- procedure DrawBorders(var Canvas: TControlCanvas; Color: TColor);
- procedure RedrawControl;
- published
- property Active : Boolean read FActive write SetActive
- default False;
- property BorderSet : TO32BorderSet
- read FBorderSet write FBorderSet;
- property BorderStyle: TO32BorderStyle read FBorderStyle write SetBorderStyle
- default bstyRidge;
- property FlatColor: TColor read FFlatColor write SetFlatColor
- default clLime;
- end;
-
-implementation
-
-{===== TO32BorderSet =================================================}
-constructor TO32BorderSet.Create(AOwner: TPersistent);
-begin
- inherited Create;
- FOwner := AOwner;
-end;
-{=====}
-
-procedure TO32BorderSet.SetLeft(Value: Boolean);
-begin
- if Value <> FLeft then begin
- FLeft := Value;
- TO32Borders(FOwner).BordersChanged;
- end;
-end;
-{=====}
-
-procedure TO32BorderSet.SetRight(Value: Boolean);
-begin
- if Value <> FRight then begin
- FRight := Value;
- TO32Borders(FOwner).BordersChanged;
- end;
-end;
-{=====}
-
-procedure TO32BorderSet.SetBottom(Value: Boolean);
-begin
- if Value <> FBottom then begin
- FBottom := Value;
- TO32Borders(FOwner).BordersChanged;
- end;
-end;
-{=====}
-
-procedure TO32BorderSet.SetTop(Value: Boolean);
-begin
- if Value <> FTop then begin
- FTop := Value;
- TO32Borders(FOwner).BordersChanged;
- end;
-end;
-
-{===== TO32BorderSet - End =====}
-
-
-{===== TO32Borders =================================================}
-constructor TO32Borders.Create(Control: TWinControl);
-begin
- Creating := True;
- inherited Create;
- FControl := Control;
- FBorderSet := TO32BorderSet.Create(self);
- FActive := false;
- FBorderWidth := 2;
- FBorderStyle := bstyRidge;
- FFlatColor := clLime;
- FBorderSet.ShowBottom := true;
- FBorderSet.ShowLeft := true;
- FBorderSet.ShowRight := true;
- FBorderSet.ShowTop := true;
- Creating := False;
-end;
-{=====}
-
-destructor TO32Borders.Destroy;
-begin
- FBorderSet.Free;
- inherited Destroy;
-end;
-{=====}
-
-procedure TO32Borders.SetActive(Value: Boolean);
-begin
- if FActive <> Value then begin
- FActive := Value;
- Changed;
- end;
-end;
-{=====}
-
-procedure TO32Borders.SetBorderStyle(Value: TO32BorderStyle);
-begin
- if Value <> FBorderStyle then begin
- FBorderStyle := Value;
- Changed;
- end;
-end;
-{=====}
-
-procedure TO32Borders.SetFlatColor(Value: TColor);
-begin
- if Value <> FFlatColor then begin
- FFlatColor := Value;
- if FBorderStyle = bstyFlat then
- Changed;
- end;
-end;
-{=====}
-
-procedure TO32Borders.DrawBorders(var Canvas: TControlCanvas; Color: TColor);
-var
- Rct : TRect;
-begin
- if not FActive then exit;
-
- Rct := Rect(0, 0, FControl.Width, FControl.Height);
-
- {Erase the existing border.}
- EraseBorder(Canvas, Rct, Color, true);
-
- {If the border style is bstyNone then don't do anything else.}
- if FBorderStyle = bstyNone then exit;
-
- {otherwise, draw the border.}
- if FBorderStyle = bstyFlat then
- DrawFlatBorder(Canvas, Rct, FFlatColor{, false})
- else Draw3dBorders(Canvas, Rct);
-end;
-{=====}
-
-procedure TO32Borders.Draw3dBorders(Canvas: TControlCanvas; Rct: TRect);
-var
- Hilite, Base: TColor;
- R: TRect;
-begin
- Hilite := THiliteColor[FBorderStyle];
- Base := TBaseColor[FBorderStyle];
-
- if FBorderStyle in [bstyLowered, bstyRaised ] then
- DrawBevel(Canvas, Rct, Hilite, Base)
-
- else with FBorderSet do begin
- R := Rct;
- {Patch the border edges}
-
- if ShowRight then
- Canvas.Pixels[R.Right - 1, R.Top] := Base;
- if ShowTop and not ShowRight then
- Canvas.Pixels[R.Right - 1, R.Top] := Hilite;
- if ShowBottom then
- Canvas.Pixels[R.Left, R.Bottom - 1] := Base;
- if ShowLeft and not ShowBottom then
- Canvas.Pixels[R.Left, R.Bottom - 1] := Hilite;
- if ShowTop and not ShowLeft then
- Canvas.Pixels[R.Left, R.Top + 1] := Base;
- if not ShowTop and ShowLeft then
- Canvas.Pixels[R.Left + 1, R.Top] := Base;
- if ShowBottom and not ShowRight then
- Canvas.Pixels[R.Right - 1, R.Bottom - 2] := Hilite;
- if not ShowBottom and ShowRight then
- Canvas.Pixels[R.Right - 2, R.Bottom - 1] := Hilite;
-
- Inc( R.Left );
- Inc( R.Top );
- Draw3dBox(Canvas, R, Base, Base, false);
- OffsetRect(R, -1, -1);
- Draw3dBox(Canvas, R, Hilite, Hilite, false);
-
-{ - dead code}
-// if ShowLeft then Inc(Rct.Left, 2);
-// if ShowTop then Inc(Rct.Top, 2);
-// if ShowRight then Dec(Rct.Right, 2);
-// if ShowBottom then Dec(Rct.Bottom, 2);
- end;
-end;
-{=====}
-
-procedure TO32Borders.DrawSingleSolidBorder(Canvas: TControlCanvas; Rct: TRect;
- Color: TColor; Side: TSides; Width: Integer);
-var
- i: Integer;
-begin
- with Canvas, FBorderSet do begin
- Pen.Width := 1;
- Pen.Color := Color;
-
- if Side = left then
- for i := 0 to Width do begin
- MoveTo(Rct.Left - 1, Rct.Top);
- LineTo(Rct.Left - 1, Rct.Bottom);
- Inc(Rct.Left);
- end
- else if Side = right then
- for i := 0 to Width do begin
- MoveTo(Rct.Right , Rct.Top);
- LineTo(Rct.Right , Rct.Bottom);
- Dec(Rct.Right);
- end
- else if Side = top then
- for i := 0 to Width do begin
- MoveTo(Rct.Left, Rct.Top - 1);
- LineTo(Rct.Right, Rct.Top - 1);
- Inc(Rct.Top);
- end
- else if Side = bottom then
- for i := 0 to Width do begin
- MoveTo(Rct.Left, Rct.Bottom);
- LineTo(Rct.Right, Rct.Bottom);
- Dec(Rct.Bottom);
- end;
- end;
-end;
-{=====}
-
-procedure TO32Borders.Draw3dBox(Canvas: TCanvas; Rct: TRect; Hilite,
- Base: TColor; DrawAllSides: Boolean);
-begin
- with Canvas, Rct, FBorderSet do begin
- Pen.Width := 1;
- Pen.Color := Hilite;
- if ShowLeft or DrawAllSides then begin
- MoveTo( Left, Top );
- LineTo( Left, Bottom );
- end;
-
- if ShowTop or DrawAllSides then begin
- MoveTo( Left, Top );
- LineTo( Right, Top );
- end;
-
- Pen.Color := Base;
- if ShowRight or DrawAllSides then begin
- MoveTo( Right - 1, Top );
- LineTo( Right - 1, Bottom );
- end;
-
- if ShowBottom or DrawAllSides then begin
- MoveTo( Left, Bottom - 1 );
- LineTo( Right, Bottom - 1 );
- end;
- end;
-end;
-{=====}
-
-procedure TO32Borders.DrawBevel(Canvas: TControlCanvas; Rct: TRect; HiliteColor,
- BaseColor: TColor);
-var
- I: Integer;
-begin
- Canvas.Pen.Width := 1;
- for I := 1 to FBorderWidth do
- begin
- Draw3dBox(Canvas, Rct, HiliteColor, BaseColor, False);
- Inc(Rct.Left);
- Inc(Rct.Top);
- Dec(Rct.Right);
- Dec(Rct.Bottom);
- end;
-end;
-{=====}
-
-procedure TO32Borders.DrawFlatBorder(Canvas: TControlCanvas; Rct: TRect;
- Color: TColor{; DrawAllSides: Boolean});
-begin
- Canvas.Pen.Color := Color;
- with BorderSet do begin
- if ShowLeft then
- DrawSingleSolidBorder(Canvas, Rct, Color, left, FBorderWidth);
- if ShowRight then
- DrawSingleSolidBorder(Canvas, Rct, Color, right, FBorderWidth);
- if ShowTop then
- DrawSingleSolidBorder(Canvas, Rct, Color, top, FBorderWidth);
- if ShowBottom then
- DrawSingleSolidBorder(Canvas, Rct, Color, bottom, FBorderWidth);
- end;
-end;
-{=====}
-
-procedure TO32Borders.EraseBorder(Canvas: TControlCanvas; Rct: TRect;
- Color: TColor; AllSides: Boolean);
-var
- i: Integer;
-begin
- Canvas.Pen.Color := Color;
- with BorderSet do begin
- for i := 1 to FBorderWidth do begin
- Draw3dBox(Canvas, Rct, Color, Color, AllSides);
- Inc(Rct.Left);
- Inc(Rct.Top);
- Dec(Rct.Right);
- Dec(Rct.Bottom);
- end;
- end;
-end;
-{=====}
-
-procedure TO32Borders.BordersChanged;
-begin
- if FActive then Changed;
-end;
-{=====}
-
-procedure TO32Borders.RedrawControl;
-var
- Rct: TRect;
-begin
- if not Creating then begin
- Rct := FControl.ClientRect;
- RedrawWindow(FControl.Handle, @Rct, 0,
- rdw_Invalidate or rdw_UpdateNow or rdw_Frame );
- end;
-end;
-{=====}
-
-procedure TO32Borders.Changed;
-begin
- FControl.Invalidate;
- RedrawControl;
-end;
-
-{===== TO32Borders - End =====}
-
-end.
-
-
-
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/a4/a4d43ff0183caf31b22bbac889cc0e9d54b55543.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/a4/a4d43ff0183caf31b22bbac889cc0e9d54b55543.svn-base
deleted file mode 100644
index 8a2e82e5..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/a4/a4d43ff0183caf31b22bbac889cc0e9d54b55543.svn-base
+++ /dev/null
@@ -1,18 +0,0 @@
-program Project1;
-
-uses
-{$IFDEF LCL}
- Interfaces,
-{$ENDIF}
- Forms,
- Unit1 in 'Unit1.pas' {Form1};
-
-{$IFDEF MSWINDOWS}
-{$R *.res}
-{$ENDIF}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/a6/a6c8cf0eb25485c1c2bb15bba5e311ef06e0ac1f.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/a6/a6c8cf0eb25485c1c2bb15bba5e311ef06e0ac1f.svn-base
deleted file mode 100644
index 401319b0..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/a6/a6c8cf0eb25485c1c2bb15bba5e311ef06e0ac1f.svn-base
+++ /dev/null
@@ -1,65 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls, ovcbase, ovcdata, ovcef, ovcsf;
-
-type
- TForm1 = class(TForm)
- Label1: TLabel;
- OvcSimpleField1: TOvcSimpleField;
- Label2: TLabel;
- OvcSimpleField2: TOvcSimpleField;
- procedure OvcSimpleField1UserValidation(Sender: TObject;
- var ErrorCode: Word);
- procedure OvcSimpleFieldError(Sender: TObject; ErrorCode: Word;
- ErrorMsg: String);
- procedure OvcSimpleField2UserValidation(Sender: TObject;
- var ErrorCode: Word);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.dfm}
-{$ELSE}
-{$R *.lfm}
-{$ENDIF}
-
-
-procedure TForm1.OvcSimpleField1UserValidation(Sender: TObject;
- var ErrorCode: Word);
-begin
- ErrorCode := 0;
- if (TOvcSimpleField(Sender).Text <> '') and
- (StrToIntDef(TOvcSimpleField(Sender).Text, 0) <= 0) then
- ErrorCode := oeInvalidNumber;
-end;
-
-procedure TForm1.OvcSimpleFieldError(Sender: TObject; ErrorCode: Word;
- ErrorMsg: String);
-begin
- MessageDlg(ErrorMsg + #13#10 + 'Press Ctrl+Z to undo.', mtError, [mbOK], 0);
-end;
-
-procedure TForm1.OvcSimpleField2UserValidation(Sender: TObject;
- var ErrorCode: Word);
-begin
- ErrorCode := 0;
- if (TOvcSimpleField(Sender).Text <> '') and
- (StrToFloatDef(TOvcSimpleField(Sender).Text, 0) <= 0) then
- ErrorCode := oeInvalidNumber;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/ab/ab4a5e1b5cdc385d4480ae6c35329bfc60feb91f.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/ab/ab4a5e1b5cdc385d4480ae6c35329bfc60feb91f.svn-base
deleted file mode 100644
index c71592f5..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/ab/ab4a5e1b5cdc385d4480ae6c35329bfc60feb91f.svn-base
+++ /dev/null
@@ -1,84 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 423
- Height = 323
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'MS Sans Serif'
- Font.Style = []
- OldCreateOrder = False
- PixelsPerInch = 96
- TextHeight = 13
- object Label1: TLabel
- Left = 16
- Top = 16
- Width = 385
- Height = 41
- Alignment = taCenter
- AutoSize = False
- Caption =
- 'Enter a positive integer, then move to next control to validate ' +
- 'the number.'
- WordWrap = True
- end
- object Label2: TLabel
- Left = 16
- Top = 120
- Width = 385
- Height = 41
- Alignment = taCenter
- AutoSize = False
- Caption =
- 'Enter a positive real number, then move to next control to valid' +
- 'ate the number.'
- WordWrap = True
- end
- object O32FlexEdit1: TO32FlexEdit
- Left = 168
- Top = 56
- Width = 81
- Height = 21
- EfColors.Disabled.BackColor = clWindow
- EfColors.Disabled.TextColor = clGrayText
- EfColors.Error.BackColor = clRed
- EfColors.Error.TextColor = clBlack
- EfColors.Highlight.BackColor = clHighlight
- EfColors.Highlight.TextColor = clHighlightText
- TabOrder = 0
- Validation.BeepOnError = True
- Validation.SoftValidation = False
- Validation.ValidationEvent = veOnExit
- Validation.ValidatorType = 'None'
- Validation.ValidationType = vtUser
- Validation.InputRequired = False
- OnExit = O32FlexEditExit
- OnUserValidation = O32FlexEdit1UserValidation
- OnValidationError = O32FlexEditValidationError
- end
- object O32FlexEdit2: TO32FlexEdit
- Left = 168
- Top = 160
- Width = 81
- Height = 21
- EfColors.Disabled.BackColor = clWindow
- EfColors.Disabled.TextColor = clGrayText
- EfColors.Error.BackColor = clRed
- EfColors.Error.TextColor = clBlack
- EfColors.Highlight.BackColor = clHighlight
- EfColors.Highlight.TextColor = clHighlightText
- TabOrder = 1
- Validation.BeepOnError = True
- Validation.SoftValidation = False
- Validation.ValidationEvent = veOnExit
- Validation.ValidatorType = 'None'
- Validation.ValidationType = vtUser
- Validation.InputRequired = False
- OnExit = O32FlexEditExit
- OnUserValidation = O32FlexEdit2UserValidation
- OnValidationError = O32FlexEditValidationError
- end
-end
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/ac/acbe30ad96fc1e80df24d0b8e7c5a2aaf4d608bb.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/ac/acbe30ad96fc1e80df24d0b8e7c5a2aaf4d608bb.svn-base
deleted file mode 100644
index d5ada538..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/ac/acbe30ad96fc1e80df24d0b8e7c5a2aaf4d608bb.svn-base
+++ /dev/null
@@ -1,33 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 511
- Height = 362
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'MS Sans Serif'
- Font.Style = []
- OldCreateOrder = False
- PixelsPerInch = 96
- TextHeight = 13
- object OvcURL1: TOvcURL
- Left = 96
- Top = 56
- Width = 138
- Height = 13
- Hint = 'http://www.lazarus.freepascal.org'
- Caption = 'URL link to Lazarus Web site'
- URL = 'http://www.lazarus.freepascal.org'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'MS Sans Serif'
- Font.Style = [fsUnderline]
- ParentFont = False
- ParentShowHint = False
- ShowHint = True
- end
-end
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/ad/ad2486155facc4b8e071756c380fef240db1581e.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/ad/ad2486155facc4b8e071756c380fef240db1581e.svn-base
deleted file mode 100644
index a000362d..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/ad/ad2486155facc4b8e071756c380fef240db1581e.svn-base
+++ /dev/null
@@ -1,266 +0,0 @@
-{*********************************************************}
-{* OVCTBCLR.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 ovctbclr;
- {-Orpheus table colors}
-
-interface
-
-uses
- Graphics, Classes;
-
-type
- TOvcTableColors = class(TPersistent)
- protected {private}
- {.Z+}
- FLocked : TColor;
- FLockedText : TColor;
- FActiveFocused : TColor;
- FActiveFocusedText : TColor;
- FActiveUnfocused : TColor;
- FActiveUnfocusedText : TColor;
- FEditing : TColor;
- FEditingText : TColor;
- FSelected : TColor;
- FSelectedText : TColor;
-
- FOnCfgChanged : TNotifyEvent;
- {.Z-}
-
- protected
- {.Z+}
- procedure SetLocked(C : TColor);
- procedure SetLockedText(C : TColor);
- procedure SetActiveFocused(C : TColor);
- procedure SetActiveFocusedText(C : TColor);
- procedure SetActiveUnfocused(C : TColor);
- procedure SetActiveUnfocusedText(C : TColor);
- procedure SetEditing(C : TColor);
- procedure SetEditingText(C : TColor);
- procedure SetSelected(C : TColor);
- procedure SetSelectedText(C : TColor);
-
- procedure DoCfgChanged;
- {.Z-}
-
- public {protected}
- {.Z+}
- property OnCfgChanged : TNotifyEvent
- read FOnCfgChanged write FOnCfgChanged;
- {.Z-}
-
- public
- constructor Create;
- procedure Assign(Source : TPersistent); override;
-
- published
- {properties}
- property ActiveFocused : TColor
- read FActiveFocused write SetActiveFocused
- default clHighlight;
-
- property ActiveFocusedText : TColor
- read FActiveFocusedText write SetActiveFocusedText
- default clHighlightText;
-
- property ActiveUnfocused : TColor
- read FActiveUnfocused write SetActiveUnfocused
- default clHighlight;
-
- property ActiveUnfocusedText : TColor
- read FActiveUnfocusedText write SetActiveUnfocusedText
- default clHighlightText;
-
- property Locked : TColor
- read FLocked write SetLocked
- default clBtnFace;
-
- property LockedText : TColor
- read FLockedText write SetLockedText
- default clWindowText;
-
- property Editing : TColor
- read FEditing write SetEditing
- default clBtnFace;
-
- property EditingText : TColor
- read FEditingText write SetEditingText
- default clWindowText;
-
- property Selected : TColor
- read FSelected write SetSelected
- default clHighlight;
-
- property SelectedText : TColor
- read FSelectedText write SetSelectedText
- default clHighlightText;
- end;
-
-implementation
-
-
-{===TOvcTableColors==================================================}
-constructor TOvcTableColors.Create;
- begin
- FLocked := clBtnFace;
- FLockedText := clWindowText;
- FActiveFocused := clHighlight;
- FActiveFocusedText := clHighlightText;
- FActiveUnfocused := clHighlight;
- FActiveUnfocusedText := clHighlightText;
- FEditing := clBtnFace;
- FEditingText := clWindowText;
- FSelected := clHighlight;
- FSelectedText := clHighlightText;
- end;
-{--------}
-procedure TOvcTableColors.Assign(Source : TPersistent);
- begin
- if (Source is TOvcTableColors) then
- begin
- FLocked := TOvcTableColors(Source).Locked;
- FLockedText := TOvcTableColors(Source).LockedText;
- FActiveFocused := TOvcTableColors(Source).ActiveFocused;
- FActiveFocusedText := TOvcTableColors(Source).ActiveFocusedText;
- FActiveUnfocused := TOvcTableColors(Source).ActiveUnfocused;
- FActiveUnfocusedText := TOvcTableColors(Source).ActiveUnfocusedText;
- FEditing := TOvcTableColors(Source).Editing;
- FEditingText := TOvcTableColors(Source).EditingText;
- FSelected := TOvcTableColors(Source).Selected;
- FSelectedText := TOvcTableColors(Source).SelectedText;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableColors.DoCfgChanged;
- begin
- if Assigned(FOnCfgChanged) then
- FOnCfgChanged(Self);
- end;
-{--------}
-procedure TOvcTableColors.SetActiveFocused(C : TColor);
- begin
- if (C <> FActiveFocused) then
- begin
- FActiveFocused := C;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableColors.SetActiveFocusedText(C : TColor);
- begin
- if (C <> FActiveFocusedText) then
- begin
- FActiveFocusedText := C;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableColors.SetActiveUnfocused(C : TColor);
- begin
- if (C <> FActiveUnfocused) then
- begin
- FActiveUnfocused := C;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableColors.SetActiveUnfocusedText(C : TColor);
- begin
- if (C <> FActiveUnfocusedText) then
- begin
- FActiveUnfocusedText := C;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableColors.SetEditing(C : TColor);
- begin
- if (C <> FEditing) then
- begin
- FEditing := C;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableColors.SetEditingText(C : TColor);
- begin
- if (C <> FEditingText) then
- begin
- FEditingText := C;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableColors.SetLocked(C : TColor);
- begin
- if (C <> FLocked) then
- begin
- FLocked := C;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableColors.SetLockedText(C : TColor);
- begin
- if (C <> FLockedText) then
- begin
- FLockedText := C;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableColors.SetSelected(C : TColor);
- begin
- if (C <> FSelected) then
- begin
- FSelected := C;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableColors.SetSelectedText(C : TColor);
- begin
- if (C <> FSelectedText) then
- begin
- FSelectedText := C;
- DoCfgChanged;
- end;
- end;
-{====================================================================}
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/ad/ad68f4eda7d66caaca4e196df04b6dfe54526723.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/ad/ad68f4eda7d66caaca4e196df04b6dfe54526723.svn-base
deleted file mode 100644
index 054e81e7..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/pristine/ad/ad68f4eda7d66caaca4e196df04b6dfe54526723.svn-base and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/ad/ad819a81ce6c288be120dd68be60c26b865c8e33.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/ad/ad819a81ce6c288be120dd68be60c26b865c8e33.svn-base
deleted file mode 100644
index 45be3be1..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/ad/ad819a81ce6c288be120dd68be60c26b865c8e33.svn-base
+++ /dev/null
@@ -1,38 +0,0 @@
--$A8
--$B-
--$C+
--$D+
--$E-
--$F-
--$G+
--$H+
--$I+
--$J-
--$K-
--$L+
--$M-
--$N+
--$O+
--$P+
--$Q+
--$R+
--$S-
--$T+
--$U-
--$V+
--$W-
--$X+
--$YD
--$Z1
--cg
--AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
--H+
--W+
--M
--$M16384,1048576
--K$00400000
--LE"c:\delphi7\Projects\Bpl"
--LN"c:\delphi7\Projects\Bpl"
--w-UNSAFE_TYPE
--w-UNSAFE_CODE
--w-UNSAFE_CAST
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/ae/ae7fb6aecdbfed1c6e60121ec285f9fa5433733f.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/ae/ae7fb6aecdbfed1c6e60121ec285f9fa5433733f.svn-base
deleted file mode 100644
index 458a3630..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/ae/ae7fb6aecdbfed1c6e60121ec285f9fa5433733f.svn-base
+++ /dev/null
@@ -1,729 +0,0 @@
-{*********************************************************}
-{* OVCTCEDT.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 ovctcedt;
- {-Orpheus Table Cell - Windows edit Control type}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- SysUtils, Classes, Controls, Forms, StdCtrls,
- OvcTCmmn, OvcTCell, OvcTCStr,
- Graphics; { - for default color definition}
-
-type
- TOvcTCStringEdit = class(TEdit)
- protected {private}
- FCell : TOvcBaseTableCell;
-
- protected
- procedure WMChar(var Msg : TWMKey); message WM_CHAR;
- procedure WMGetDlgCode(var Msg : TMessage); message WM_GETDLGCODE;
- procedure WMKeyDown(var Msg : TWMKey); message WM_KEYDOWN;
- procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS;
- procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
-
- property CellOwner : TOvcBaseTableCell
- read FCell write FCell;
- end;
-
- TOvcTCCustomString = class(TOvcTCBaseString)
- protected {private}
- FEdit : TOvcTCStringEdit;
- FMaxLength : word;
- FAutoAdvanceChar : boolean;
- FAutoAdvanceLeftRight : boolean;
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
-
- protected
- function GetCellEditor : TControl; override;
- function GetModified : boolean;
-
- property AutoAdvanceChar : boolean
- read FAutoAdvanceChar write FAutoAdvanceChar;
-
- property AutoAdvanceLeftRight : boolean
- read FAutoAdvanceLeftRight write FAutoAdvanceLeftRight;
-
- property MaxLength : word
- read FMaxLength write FMaxLength;
-
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D;
-{$ENDIF}
- public
- function CreateEditControl(AOwner : TComponent) : TOvcTCStringEdit; virtual;
-
- function EditHandle : THandle; override;
- procedure EditHide; override;
- procedure EditMove(CellRect : TRect); override;
-
- procedure SaveEditedData(Data : pointer); override;
- procedure StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer); override;
- procedure StopEditing(SaveValue : boolean;
- Data : pointer); override;
-
- property Modified : boolean
- read GetModified;
- end;
-
- TOvcTCString = class(TOvcTCCustomString)
- published
- {properties inherited from custom ancestor}
- property Access default otxDefault;
- property Adjust default otaDefault;
- property AutoAdvanceChar default False;
- property AutoAdvanceLeftRight default False;
- property Color;
- property Font;
- property Hint;
- property Margin default 4;
- property MaxLength default 0;
- property ShowHint default False;
- property Table;
- property TableColor default True;
- property TableFont default True;
- property TextHiColor default clBtnHighlight;
- property TextStyle default tsFlat;
- property UseWordWrap default False;
- property UseASCIIZStrings default False;
-
- {events inherited from custom ancestor}
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnOwnerDraw;
- public
- constructor Create(AOwner : TComponent); override;
- end;
-
-type
- TOvcTCMemoEdit = class(TMemo)
- protected {private}
- FCell : TOvcBaseTableCell;
-
- protected
- procedure WMChar(var Msg : TWMKey); message WM_CHAR;
- procedure WMGetDlgCode(var Msg : TMessage); message WM_GETDLGCODE;
- procedure WMKeyDown(var Msg : TWMKey); message WM_KEYDOWN;
- procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS;
- procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
-
- property CellOwner : TOvcBaseTableCell
- read FCell write FCell;
- end;
-
- TOvcTCCustomMemo = class(TOvcTCBaseString)
- protected {private}
- FEdit : TOvcTCMemoEdit;
- FMaxLength : word;
- FWantReturns : boolean;
- FWantTabs : boolean;
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
-
- protected
- function GetCellEditor : TControl; override;
- function GetModified : boolean;
-
- property MaxLength : word
- read FMaxLength write FMaxLength;
-
- property WantReturns : boolean
- read FWantReturns write FWantReturns;
-
- property WantTabs : boolean
- read FWantTabs write FWantTabs;
-
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D;
-{$ENDIF}
- public
- constructor Create(AOwner : TComponent); override;
- function CreateEditControl(AOwner : TComponent) : TOvcTCMemoEdit; virtual;
-
- function EditHandle : THandle; override;
- procedure EditHide; override;
- procedure EditMove(CellRect : TRect); override;
- procedure SaveEditedData(Data : pointer); override;
- procedure StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer); override;
- procedure StopEditing(SaveValue : boolean;
- Data : pointer); override;
-
- property Modified : boolean
- read GetModified;
- end;
-
- TOvcTCMemo = class(TOvcTCCustomMemo)
- published
- {properties inherited from custom ancestor}
- property Access default otxDefault;
- property Adjust default otaDefault;
- property Color;
- property Font;
- property Hint;
- property Margin default 4;
- property MaxLength default 0;
- property ShowHint default False;
- property Table;
- property TableColor default True;
- property TableFont default True;
- property TextHiColor default clBtnHighlight;
- property TextStyle default tsFlat;
- property WantReturns default False;
- property WantTabs default False;
-
- {events inherited from custom ancestor}
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnOwnerDraw;
- end;
-
-implementation
-
-{===TOvcTCCustomString===============================================}
-function TOvcTCCustomString.CreateEditControl(AOwner : TComponent) : TOvcTCStringEdit;
- begin
- Result := TOvcTCStringEdit.Create(AOwner);
- end;
-{--------}
-function TOvcTCCustomString.EditHandle : THandle;
- begin
- if Assigned(FEdit) then
- Result := FEdit.Handle
- else
- Result := 0;
- end;
-{--------}
-procedure TOvcTCCustomString.EditHide;
- begin
- if Assigned(FEdit) then
- with FEdit do
- begin
- SetWindowPos(FEdit.Handle, HWND_TOP,
- 0, 0, 0, 0,
- SWP_HIDEWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- end;
- end;
-{--------}
-procedure TOvcTCCustomString.EditMove(CellRect : TRect);
- var
- EditHandle : HWND;
- begin
- if Assigned(FEdit) then
- begin
- EditHandle := FEdit.Handle;
- with CellRect do
- SetWindowPos(EditHandle, HWND_TOP,
- Left, Top, Right-Left, Bottom-Top,
- SWP_SHOWWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- InvalidateRect(EditHandle, nil, false);
- UpdateWindow(EditHandle);
- end;
- end;
-{--------}
-function TOvcTCCustomString.GetCellEditor : TControl;
- begin
- Result := FEdit;
- end;
-{--------}
-function TOvcTCCustomString.GetModified : boolean;
- begin
- if Assigned(FEdit) then
- Result := FEdit.Modified
- else Result := false;
- end ;
-{--------}
-procedure TOvcTCCustomString.SaveEditedData(Data : pointer);
- begin
- if Assigned(Data) then
- if UseASCIIZStrings then
- FEdit.GetTextBuf(PAnsiChar(Data), MaxLength)
- else
- POvcShortString(Data)^ := Copy(FEdit.Text, 1, MaxLength);
- end;
-{--------}
-procedure TOvcTCCustomString.StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer);
- begin
- FEdit := CreateEditControl(FTable);
- with FEdit do
- begin
- if UseASCIIZStrings then
- begin
- if (Data = nil) then
- SetTextBuf('')
- else
- SetTextBuf(PAnsiChar(Data));
- end
- else
- begin
- if (Data = nil) then
- Text := ''
- else
- Text := POvcShortString(Data)^;
- end;
- Color := CellAttr.caColor;
- Font := CellAttr.caFont;
- Font.Color := CellAttr.caFontColor;
- Left := CellRect.Left;
- Top := CellRect.Top;
- Width := CellRect.Right - CellRect.Left;
- Height := CellRect.Bottom - CellRect.Top;
- TabStop := false;
- CellOwner := Self;
- MaxLength := Self.MaxLength;
- Hint := Self.Hint;
- ShowHint := Self.ShowHint;
- Parent := FTable;
- BorderStyle := bsNone;
- Ctl3D := false;
- case CellStyle of
- tesBorder : BorderStyle := bsSingle;
- tes3D : Ctl3D := true;
- end;{case}
-
- OnChange := Self.OnChange;
- OnClick := Self.OnClick;
- OnDblClick := Self.OnDblClick;
- OnDragDrop := Self.OnDragDrop;
- OnDragOver := Self.OnDragOver;
- OnEndDrag := Self.OnEndDrag;
- OnEnter := Self.OnEnter;
- OnExit := Self.OnExit;
- OnKeyDown := Self.OnKeyDown;
- OnKeyPress := Self.OnKeyPress;
- OnKeyUp := Self.OnKeyUp;
- OnMouseDown := Self.OnMouseDown;
- OnMouseMove := Self.OnMouseMove;
- OnMouseUp := Self.OnMouseUp;
- end;
- end;
-{--------}
-procedure TOvcTCCustomString.StopEditing(SaveValue : boolean;
- Data : pointer);
-
- begin
- try
- if SaveValue and Assigned(Data) then
- if UseASCIIZStrings then
- FEdit.GetTextBuf(PAnsiChar(Data), MaxLength+1)
- else
- POvcShortString(Data)^ := Copy(FEdit.Text, 1, MaxLength);
- finally
- FEdit.Free;
- FEdit := nil;
- end;
- end;
-{====================================================================}
-
-
-{===TOvcTCStringEdit===============================================}
-procedure TOvcTCStringEdit.WMChar(var Msg : TWMKey);
- var
- CurText : string;
- begin
- if (Msg.CharCode <> 13) and {Enter}
- (Msg.CharCode <> 9) and {Tab}
- (Msg.CharCode <> 27) then {Escape}
- inherited;
- if TOvcTCCustomString(CellOwner).AutoAdvanceChar then
- begin
- CurText := Text;
- if (length(CurText) >= MaxLength) then
- begin
- FillChar(Msg, sizeof(Msg), 0);
- with Msg do
- begin
- Msg := WM_KEYDOWN;
- CharCode := VK_RIGHT;
- end;
- CellOwner.SendKeyToTable(Msg);
- end;
- end;
- end;
-{--------}
-procedure TOvcTCStringEdit.WMGetDlgCode(var Msg : TMessage);
- begin
- inherited;
- if CellOwner.TableWantsTab then
- Msg.Result := Msg.Result or DLGC_WANTTAB;
- if CellOwner.TableWantsEnter then
- Msg.Result := Msg.Result or DLGC_WANTALLKEYS;
- end;
-{--------}
-procedure TOvcTCStringEdit.WMKeyDown(var Msg : TWMKey);
- procedure GetSelection(var S, E : word);
- type
- LH = packed record L, H : word; end;
- var
- GetSel : longint;
- begin
- GetSel := SendMessage(Handle, EM_GETSEL, 0, 0);
- S := LH(GetSel).L;
- E := LH(GetSel).H;
- end;
- var
- GridReply : TOvcTblKeyNeeds;
- GridUsedIt : boolean;
- SStart, SEnd : word;
- begin
- GridUsedIt := false;
- GridReply := otkDontCare;
- if (CellOwner <> nil) then
- GridReply := CellOwner.FilterTableKey(Msg);
- case GridReply of
- otkMustHave :
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- otkWouldLike :
- case Msg.CharCode of
- VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN :
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- VK_LEFT :
- if TOvcTCCustomString(CellOwner).AutoAdvanceLeftRight then
- begin
- GetSelection(SStart, SEnd);
- if (SStart = SEnd) and (SStart = 0) then
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;
- VK_RIGHT :
- if TOvcTCCustomString(CellOwner).AutoAdvanceLeftRight then
- begin
- GetSelection(SStart, SEnd);
- if ((SStart = SEnd) or (SStart = 0)) and (SEnd = GetTextLen) then
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;
- end;
- end;{case}
-
- if not GridUsedIt then
- inherited;
- end;
-{--------}
-procedure TOvcTCStringEdit.WMKillFocus(var Msg : TWMKillFocus);
- begin
- inherited;
- CellOwner.PostMessageToTable(ctim_KillFocus, Msg.FocusedWnd, 0);
- end;
-{--------}
-procedure TOvcTCStringEdit.WMSetFocus(var Msg : TWMSetFocus);
- begin
- inherited;
- CellOwner.PostMessageToTable(ctim_SetFocus, Msg.FocusedWnd, 0);
- end;
-{====================================================================}
-
-
-
-
-{===TOvcTCCustomMemo=================================================}
-constructor TOvcTCCustomMemo.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
- UseASCIIZStrings := true;
- UseWordWrap := true;
- end;
-{--------}
-function TOvcTCCustomMemo.CreateEditControl(AOwner : TComponent) : TOvcTCMemoEdit;
- begin
- Result := TOvcTCMemoEdit.Create(AOwner);
- end;
-{--------}
-function TOvcTCCustomMemo.EditHandle : THandle;
- begin
- if Assigned(FEdit) then
- Result := FEdit.Handle
- else
- Result := 0;
- end;
-{--------}
-procedure TOvcTCCustomMemo.EditHide;
- begin
- if Assigned(FEdit) then
- with FEdit do
- begin
- SetWindowPos(FEdit.Handle, HWND_TOP,
- 0, 0, 0, 0,
- SWP_HIDEWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- end;
- end;
-{--------}
-procedure TOvcTCCustomMemo.EditMove(CellRect : TRect);
- begin
- if Assigned(FEdit) then
- begin
- with CellRect do
- SetWindowPos(FEdit.Handle, HWND_TOP,
- Left, Top, Right-Left, Bottom-Top,
- SWP_SHOWWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- InvalidateRect(FEdit.Handle, nil, false);
- UpdateWindow(FEdit.Handle);
- end;
- end;
-{--------}
-function TOvcTCCustomMemo.GetCellEditor : TControl;
- begin
- Result := FEdit;
- end;
-{--------}
-function TOvcTCCustomMemo.GetModified : boolean;
- begin
- if Assigned(FEdit) then
- Result := FEdit.Modified
- else Result := false;
- end ;
-{--------}
-procedure TOvcTCCustomMemo.StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer);
- begin
- FEdit := CreateEditControl(FTable);
- with FEdit do
- begin
- if (Data = nil) then
- SetTextBuf('')
- else
- SetTextBuf(PAnsiChar(Data));
- Color := CellAttr.caColor;
- Font := CellAttr.caFont;
- Font.Color := CellAttr.caFontColor;
- MaxLength := Self.MaxLength;
- WantReturns := Self.WantReturns;
- WantTabs := Self.WantTabs;
- Left := CellRect.Left;
- Top := CellRect.Top;
- Width := CellRect.Right - CellRect.Left;
- Height := CellRect.Bottom - CellRect.Top;
- Visible := true;
- TabStop := false;
- CellOwner := Self;
- Hint := Self.Hint;
- ShowHint := Self.ShowHint;
- Parent := FTable;
- BorderStyle := bsNone;
- Ctl3D := false;
- case CellStyle of
- tesBorder : BorderStyle := bsSingle;
- tes3D : Ctl3D := true;
- end;{case}
-
- OnChange := Self.OnChange;
- OnClick := Self.OnClick;
- OnDblClick := Self.OnDblClick;
- OnDragDrop := Self.OnDragDrop;
- OnDragOver := Self.OnDragOver;
- OnEndDrag := Self.OnEndDrag;
- OnEnter := Self.OnEnter;
- OnExit := Self.OnExit;
- OnKeyDown := Self.OnKeyDown;
- OnKeyPress := Self.OnKeyPress;
- OnKeyUp := Self.OnKeyUp;
- OnMouseDown := Self.OnMouseDown;
- OnMouseMove := Self.OnMouseMove;
- OnMouseUp := Self.OnMouseUp;
- end;
- end;
-{--------}
-procedure TOvcTCCustomMemo.StopEditing(SaveValue : boolean;
- Data : pointer);
- begin
- try
- if SaveValue and Assigned(Data) then
- FEdit.GetTextBuf(PAnsiChar(Data), MaxLength);
- finally
- FEdit.Free;
- FEdit := nil;
- end;
- end;
-
-procedure TOvcTCCustomMemo.SaveEditedData(Data : pointer);
-begin
- {stub out abstract method so BCB doesn't see this as an abstract class}
-end;
-
-{====================================================================}
-
-
-{===TOvcTCMemoEdit===============================================}
-procedure TOvcTCMemoEdit.WMChar(var Msg : TWMKey);
- begin
- if (not CellOwner.TableWantsTab) or
- (Msg.CharCode <> 9) then
- inherited;
- end;
-{--------}
-procedure TOvcTCMemoEdit.WMGetDlgCode(var Msg : TMessage);
- begin
- inherited;
- if CellOwner.TableWantsTab then
- Msg.Result := Msg.Result or DLGC_WANTTAB;
- end;
-{--------}
-procedure TOvcTCMemoEdit.WMKeyDown(var Msg : TWMKey);
- procedure GetSelection(var S, E : word);
- type
- LH = packed record L, H : word; end;
- var
- GetSel : longint;
- begin
- GetSel := SendMessage(Handle, EM_GETSEL, 0, 0);
- S := LH(GetSel).L;
- E := LH(GetSel).H;
- end;
- var
- GridReply : TOvcTblKeyNeeds;
- GridUsedIt : boolean;
- SStart, SEnd : word;
- begin
- GridUsedIt := false;
- GridReply := otkDontCare;
- if (CellOwner <> nil) then
- GridReply := CellOwner.FilterTableKey(Msg);
- case GridReply of
- otkMustHave :
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- otkWouldLike :
- case Msg.CharCode of
- VK_RETURN :
-{$IFNDEF LCL}
- if not WantReturns then
-{$ENDIF}
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- VK_LEFT :
- begin
- GetSelection(SStart, SEnd);
- if (SStart = SEnd) and (SStart = 0) then
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;
- VK_RIGHT :
- begin
- GetSelection(SStart, SEnd);
- if ((SStart = SEnd) or (SStart = 0)) and (SEnd = GetTextLen) then
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;
- end;
- end;{case}
-
- if not GridUsedIt then
- inherited;
- end;
-{--------}
-procedure TOvcTCMemoEdit.WMKillFocus(var Msg : TWMKillFocus);
- begin
- inherited;
- CellOwner.PostMessageToTable(ctim_KillFocus, Msg.FocusedWnd, 0);
- end;
-{--------}
-procedure TOvcTCMemoEdit.WMSetFocus(var Msg : TWMSetFocus);
- begin
- inherited;
- CellOwner.PostMessageToTable(ctim_SetFocus, Msg.FocusedWnd, 0);
- end;
-{====================================================================}
-
-{===TOvcTCString===============================================}
-constructor TOvcTCString.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
- end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/af/afcf9135063d4a2c7dd1a6006fe1bf3b1d130b2e.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/af/afcf9135063d4a2c7dd1a6006fe1bf3b1d130b2e.svn-base
deleted file mode 100644
index 15fd404d..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/af/afcf9135063d4a2c7dd1a6006fe1bf3b1d130b2e.svn-base
+++ /dev/null
@@ -1,141 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 776
- Height = 480
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'Arial'
- Font.Style = []
- OldCreateOrder = False
- OnCreate = FormCreate
- OnDestroy = FormDestroy
- DesignSize = (
- 768
- 446)
- PixelsPerInch = 96
- TextHeight = 14
- object OvcTable1: TOvcTable
- Left = 16
- Top = 16
- Width = 737
- Height = 409
- Anchors = [akLeft, akTop, akRight, akBottom]
- Color = clWindow
- Controller = OvcController1
- GridPenSet.NormalGrid.NormalColor = clBtnShadow
- GridPenSet.NormalGrid.Style = psDot
- GridPenSet.NormalGrid.Effect = geBoth
- GridPenSet.LockedGrid.NormalColor = clBtnShadow
- GridPenSet.LockedGrid.Style = psSolid
- GridPenSet.LockedGrid.Effect = ge3D
- GridPenSet.CellWhenFocused.NormalColor = clBlack
- GridPenSet.CellWhenFocused.Style = psSolid
- GridPenSet.CellWhenFocused.Effect = geBoth
- GridPenSet.CellWhenUnfocused.NormalColor = clBlack
- GridPenSet.CellWhenUnfocused.Style = psDash
- GridPenSet.CellWhenUnfocused.Effect = geBoth
- LockedRowsCell = OvcTCColHead1
- Options = [otoNoRowResizing, otoNoColResizing, otoTabToArrow, otoEnterToArrow, otoAlwaysEditing, otoNoSelection, otoThumbTrack]
- TabOrder = 0
- OnGetCellData = OvcTable1GetCellData
- CellData = (
- 'Form1.OvcTCColHead1'
- 'Form1.O32TCFlexEdit1'
- 'Form1.OvcTCSimpleField1'
- 'Form1.OvcTCRowHead1'
- 'Form1.OvcTCString1')
- RowData = (
- 35)
- ColData = (
- 110
- False
- True
- 'Form1.OvcTCRowHead1'
- 150
- False
- True
- 'Form1.OvcTCString1'
- 150
- False
- True
- 'Form1.OvcTCSimpleField1'
- 150
- False
- True
- 'Form1.O32TCFlexEdit1')
- end
- object OvcTCColHead1: TOvcTCColHead
- Headings.Strings = (
- 'TOvcTCRowHead'
- 'TOvcTCString'
- 'TOvcTCSimpleField'
- 'TO32TCFlexEdit'
- '')
- ShowLetters = False
- Adjust = otaCenter
- Table = OvcTable1
- Left = 48
- end
- object OvcTCRowHead1: TOvcTCRowHead
- Adjust = otaCenter
- Table = OvcTable1
- Left = 80
- end
- object OvcTCString1: TOvcTCString
- AutoAdvanceLeftRight = True
- Table = OvcTable1
- Left = 144
- end
- object OvcController1: TOvcController
- EntryCommands.TableList = (
- 'Default'
- True
- ()
- 'WordStar'
- False
- ()
- 'Grid'
- False
- ())
- Epoch = 2000
- Left = 16
- end
- object OvcTCSimpleField1: TOvcTCSimpleField
- CaretOvr.Shape = csBlock
- EFColors.Disabled.BackColor = clWindow
- EFColors.Disabled.TextColor = clGrayText
- EFColors.Error.BackColor = clRed
- EFColors.Error.TextColor = clBlack
- EFColors.Highlight.BackColor = clHighlight
- EFColors.Highlight.TextColor = clHighlightText
- Table = OvcTable1
- OnError = OvcTCSimpleField1Error
- OnUserValidation = OvcTCSimpleField1UserValidation
- Left = 296
- RangeHigh = {00000000000000000000}
- RangeLow = {00000000000000000000}
- end
- object O32TCFlexEdit1: TO32TCFlexEdit
- EditorBorders.Active = False
- EditorBorders.FlatColor = clBlack
- EditorBorders.BorderStyle = bstyRaised
- EditorOptions.Alignment = taLeftJustify
- EditorOptions.Color = clWindow
- EditorOptions.Cursor = crDefault
- EditorOptions.MaxLines = 3
- EditorOptions.PasswordChar = #0
- EditorOptions.ReadOnly = False
- EditorOptions.ShowButton = False
- Table = OvcTable1
- Validation.BeepOnError = True
- Validation.InputRequired = False
- Validation.ValidatorType = 'None'
- Validation.ValidationType = vtUser
- OnUserValidation = O32TCFlexEdit1UserValidation
- Left = 448
- end
-end
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/b0/b0f7c2d428c32f6ad4525a3917b202881949eae8.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/b0/b0f7c2d428c32f6ad4525a3917b202881949eae8.svn-base
deleted file mode 100644
index d975a084..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/b0/b0f7c2d428c32f6ad4525a3917b202881949eae8.svn-base
+++ /dev/null
@@ -1,77 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls, ovcdata, o32editf, o32flxed;
-
-type
- TForm1 = class(TForm)
- Label1: TLabel;
- O32FlexEdit1: TO32FlexEdit;
- Label2: TLabel;
- O32FlexEdit2: TO32FlexEdit;
- procedure O32FlexEdit1UserValidation(Sender: TObject;
- var ValidEntry: Boolean);
- procedure O32FlexEdit2UserValidation(Sender: TObject;
- var ValidEntry: Boolean);
- procedure O32FlexEditValidationError(Sender: TObject; ErrorCode: Word;
- ErrorMsg: String);
- procedure O32FlexEditExit(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.dfm}
-{$ELSE}
-{$R *.lfm}
-{$ENDIF}
-
-procedure TForm1.O32FlexEdit1UserValidation(Sender: TObject;
- var ValidEntry: Boolean);
-begin
- if TO32FlexEdit(Sender).Text = '' then
- ValidEntry := True
- else
- ValidEntry := StrToIntDef(TO32FlexEdit(Sender).Text, 0) > 0;
-end;
-
-procedure TForm1.O32FlexEdit2UserValidation(Sender: TObject;
- var ValidEntry: Boolean);
-begin
- if TO32FlexEdit(Sender).Text = '' then
- ValidEntry := True
- else
- ValidEntry := StrToFloatDef(TO32FlexEdit(Sender).Text, 0) > 0;
-end;
-
-procedure TForm1.O32FlexEditValidationError(Sender: TObject;
- ErrorCode: Word; ErrorMsg: String);
-begin
- MessageDlg(ErrorMsg + #13#10 + 'Press Ctrl+Z to undo.', mtError, [mbOK], 0);
-end;
-
-procedure TForm1.O32FlexEditExit(Sender: TObject);
-begin
-{$IFNDEF MSWINDOWS}
- {TO32FlexEdit OnUserValidation doesn't work, so validate here
- so user is notified if error, even though focus will change.}
-// SendMessage(TO32FlexEdit(Sender).Handle, OM_VALIDATE, 0, 0);
-// This workaround no longer works with LCL 0.9.28 -- error message dialog
-// just repeats. SendMessage/OM_VALIDATE cancels exit event?
-// PostMessage appears to work okay, though.
- PostMessage(TO32FlexEdit(Sender).Handle, OM_VALIDATE, 0, 0);
-{$ENDIF}
-end;
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/b2/b28a30d738f68ad18e2c15cbb57e3b6b3772780b.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/b2/b28a30d738f68ad18e2c15cbb57e3b6b3772780b.svn-base
deleted file mode 100644
index fed17048..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/b2/b28a30d738f68ad18e2c15cbb57e3b6b3772780b.svn-base
+++ /dev/null
@@ -1,1651 +0,0 @@
-{*********************************************************}
-{* OVCINTL.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 ovcintl;
- {-International date/time support class}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Registry, Classes, Forms, SysUtils, OvcConst, OvcData, OvcStr, OvcDate;
-
-type
- TCurrencySt = array[0..5] of AnsiChar;
-
- {.Z+}
- TIntlData = packed record
- {substitution strings for semi-literal mask characters}
- CurrencyLtStr : TCurrencySt; {corresponding string for 'c'}
- CurrencyRtStr : TCurrencySt; {corresponding string for 'C'}
- DecimalChar : AnsiChar; {character used for decimal point}
- CommaChar : AnsiChar; {character used for comma}
- {format specifiers for currency masks}
- CurrDigits : Byte; {number of dec places in currency}
- SlashChar : AnsiChar; {date seperator}
- {characters that represent boolean values}
- TrueChar : AnsiChar;
- FalseChar : AnsiChar;
- YesChar : AnsiChar;
- NoChar : AnsiChar;
- end;
- {.Z-}
-
-type
- TOvcIntlSup = class(TObject)
- {.Z+}
- protected {private}
- FAutoUpdate : Boolean; {true to reset settings when win.ini changes}
-
- {substitution strings for semi-literal mask characters}
- FCurrencyLtStr : TCurrencySt; {corresponding string for 'c'}
- FCurrencyRtStr : TCurrencySt; {corresponding string for 'C'}
- FDecimalChar : AnsiChar; {character used for decimal point}
-
- {general international settings}
- FCommaChar : AnsiChar; {character used for comma}
- FCurrencyDigits : Byte; {number of dec places in currency}
- FListChar : AnsiChar; {list serarater}
- FSlashChar : AnsiChar; {character used to separate dates}
-
- {characters that represent boolean values}
- FTrueChar : AnsiChar;
- FFalseChar : AnsiChar;
- FYesChar : AnsiChar;
- FNoChar : AnsiChar;
-
- {event variables}
- FOnWinIniChange : TNotifyEvent; {notify of win.ini changes}
-
- {internal working variables}
- intlHandle : hWnd; {our window handle}
- w1159 : array[0..5] of AnsiChar;
- w2359 : array[0..5] of AnsiChar;
- wColonChar : AnsiChar;
- wCountry : PAnsiChar;
- wCurrencyForm : Byte;
- wldSub1 : array[0..5] of AnsiChar;
- wldSub2 : array[0..5] of AnsiChar;
- wldSub3 : array[0..5] of AnsiChar;
- wLongDate : array[0..39] of AnsiChar;
- wNegCurrencyForm : Byte;
- wShortDate : array[0..29] of AnsiChar;
- wTLZero : Boolean;
- w12Hour : Boolean;
-
- {property methods}
- function GetCountry : string;
- function GetCurrencyLtStr : string;
- function GetCurrencyRtStr : string;
- procedure SetAutoUpdate(Value : Boolean);
- procedure SetCurrencyLtStr(const Value : string);
- procedure SetCurrencyRtStr(const Value : string);
-
- {internal methods}
- procedure isExtractFromPicture(Picture, S : PAnsiChar; Ch : AnsiChar;
- var I : Integer; Blank, Default : Integer);
- procedure isIntlWndProc(var Msg : TMessage);
- function isMaskCharCount(P : PAnsiChar; MC : AnsiChar) : Word;
- procedure isMergeIntoPicture(Picture : PAnsiChar; Ch : AnsiChar; I : Integer);
- procedure isMergePictureSt(Picture, P : PAnsiChar; MC : AnsiChar; SP : PAnsiChar);
- procedure isPackResult(Picture, S : PAnsiChar);
- procedure isSubstChar(Picture : PAnsiChar; OldCh, NewCh : AnsiChar);
- procedure isSubstCharSim(P : PAnsiChar; OC, NC : AnsiChar);
- function isTimeToTimeStringPrim(Dest, Picture : PAnsiChar; T : TStTime;
- Pack : Boolean; t1159, t2359 : PAnsiChar) : PAnsiChar;
-
- public
- constructor Create;
- destructor Destroy;
- override;
- {.Z-}
-
- function CurrentDateString(const Picture : string;
- Pack : Boolean) : string;
- {.Z+}
- function CurrentDatePChar(Dest : PAnsiChar; Picture : PAnsiChar;
- Pack : Boolean) : PAnsiChar;
- {-returns today's date as a string of the specified form}
- {.Z-}
-
- function CurrentTimeString(const Picture : string; Pack : Boolean) : string;
- {.Z+}
- function CurrentTimePChar(Dest : PAnsiChar; Picture : PAnsiChar; Pack : Boolean) : PAnsiChar;
- {-returns current time as a string of the specified form}
- {.Z-}
-
- function DateToDateString(const Picture : string; Julian : TStDate;
- Pack : Boolean) : string;
- {.Z+}
- function DateToDatePChar(Dest : PAnsiChar; Picture : PAnsiChar; Julian : TStDate;
- Pack : Boolean) : PAnsiChar;
- {.Z-}
- {-convert Julian to a string of the form indicated by Picture}
-
- function DateStringToDMY(const Picture, S : string; var Day, Month, Year : Integer;
- Epoch : Integer) : Boolean;
- {.Z+}
- function DatePCharToDMY(Picture, S : PAnsiChar; var Day, Month, Year : Integer;
- Epoch : Integer) : Boolean;
- {.Z-}
- {-extract day, month, and year from S, returning true if string is valid}
-
- function DateStringIsBlank(const Picture, S : string) : Boolean;
- {.Z+}
- function DatePCharIsBlank(Picture, S : PAnsiChar) : Boolean;
- {.Z-}
- {-return True if the month, day, and year in S are all blank}
-
- function DateStringToDate(const Picture, S : string; Epoch : Integer) : TStDate;
- {.Z+}
- function DatePCharToDate(Picture, S : PAnsiChar; Epoch : Integer) : TStDate;
- {.Z-}
- {-convert St, a string of the form indicated by Picture, to a julian date. Picture and St must be of equal lengths}
-
- function DayOfWeekToString(WeekDay : TDayType) : string;
- {.Z+}
- function DayOfWeekToPChar(Dest : PAnsiChar; WeekDay : TDayType) : PAnsiChar;
- {.Z-}
- {-return a string for the specified day of the week}
-
- function DMYtoDateString(const Picture : string;
- Day, Month, Year : Integer; Pack : Boolean; Epoch : Integer) : string;
- {.Z+}
- function DMYtoDatePChar(Dest : PAnsiChar; Picture : PAnsiChar;
- Day, Month, Year : Integer; Pack : Boolean; Epoch : Integer) : PAnsiChar;
- {.Z-}
- {-merge the month, day, and year into the picture}
-
- function InternationalCurrency(FormChar : AnsiChar; MaxDigits : Byte; Float,
- AddCommas, IsNumeric : Boolean) : string;
- {.Z+}
- function InternationalCurrencyPChar(Dest : PAnsiChar; FormChar : AnsiChar;
- MaxDigits : Byte; Float,
- AddCommas, IsNumeric : Boolean) : PAnsiChar;
- {.Z-}
- {-return a picture mask for a currency string, based on Windows' intl info}
-
- function InternationalDate(ForceCentury : Boolean) : string;
- {.Z+}
- function InternationalDatePChar(Dest : PAnsiChar; ForceCentury : Boolean) : PAnsiChar;
- {.Z-}
- {-return a picture mask for a short date string, based on Windows' international information}
-
- function InternationalLongDate(ShortNames : Boolean; ExcludeDOW : Boolean) : string;
- {.Z+}
- function InternationalLongDatePChar(Dest : PAnsiChar; ShortNames : Boolean; ExcludeDOW : Boolean) : PAnsiChar;
- {.Z-}
- {-return a picture mask for a date string, based on Windows' international information}
-
- function InternationalTime(ShowSeconds : Boolean) : string;
- {.Z+}
- function InternationalTimePChar(Dest : PAnsiChar; ShowSeconds : Boolean) : PAnsiChar;
- {.Z-}
- {-return a picture mask for a time string, based on Windows' international information}
-
- function MonthStringToMonth(const S : string; Width : Byte) : Byte;
- {.Z+}
- function MonthPCharToMonth(S : PAnsiChar; Width : Byte) : Byte;
- {.Z-}
- {-Convert the month name in S to a month (1..12)}
-
- function MonthToString(Month : Integer) : string;
- {.Z+}
- function MonthToPChar(Dest : PAnsiChar; Month : Integer) : PAnsiChar;
- {.Z-}
- {return month name as a string for Month}
-
- procedure ResetInternationalInfo;
- {-read string resources and update internal info to match Windows'}
-
- function TimeStringToHMS(const Picture, S : string; var Hour, Minute, Second : Integer) : Boolean;
- {.Z+}
- function TimePCharToHMS(Picture, S : PAnsiChar; var Hour, Minute, Second : Integer) : Boolean;
- {.Z-}
- {-extract Hours, Minutes, Seconds from St, returning true if string is valid}
-
- function TimeStringToTime(const Picture, S : string) : TStTime;
- {.Z+}
- function TimePCharToTime(Picture, S : PAnsiChar) : TStTime;
- {.Z-}
- {-convert S, a string of the form indicated by Picture, to a Time variable}
-
- function TimeToTimeString(const Picture : string; T : TStTime; Pack : Boolean) : string;
- {.Z+}
- function TimeToTimePChar(Dest : PAnsiChar; Picture : PAnsiChar; T : TStTime; Pack : Boolean) : PAnsiChar;
- {.Z-}
- {-convert T to a string of the form indicated by Picture}
-
- function TimeToAmPmString(const Picture : string; T : TStTime; Pack : Boolean) : string;
- {.Z+}
- function TimeToAmPmPChar(Dest : PAnsiChar; Picture : PAnsiChar; T : TStTime; Pack : Boolean) : PAnsiChar;
- {.Z-}
- {-convert T to a string of the form indicated by Picture. Times are always displayed in am/pm format.}
-
- property AutoUpdate : Boolean
- read FAutoUpdate write SetAutoUpdate;
- property CurrencyLtStr : string
- read GetCurrencyLtStr write SetCurrencyLtStr;
- property CurrencyRtStr : string
- read GetCurrencyRtStr write SetCurrencyRtStr;
- property DecimalChar : AnsiChar
- read FDecimalChar write FDecimalChar;
- property CommaChar : AnsiChar
- read FCommaChar write FCommaChar;
- property Country : string
- read GetCountry;
- property CurrencyDigits : Byte
- read FCurrencyDigits write FCurrencyDigits;
- property ListChar : AnsiChar
- read FListChar write FListChar;
- property SlashChar : AnsiChar
- read FSlashChar write FSlashChar;
- property TrueChar : AnsiChar
- read FTrueChar write FTrueChar;
- property FalseChar : AnsiChar
- read FFalseChar write FFalseChar;
- property YesChar : AnsiChar
- read FYesChar write FYesChar;
- property NoChar : AnsiChar
- read FNoChar write FNoChar;
- property OnWinIniChange : TNotifyEvent
- read FOnWinIniChange write FOnWinIniChange;
- end;
-
-const
- DefaultIntlData : TIntlData = (
- {substitution strings for semi-literal mask characters}
- CurrencyLtStr : '$'; {corresponding string for 'c'}
- CurrencyRtStr : ''; {corresponding string for 'C'}
- DecimalChar : '.'; {character used for decimal point}
- CommaChar : ','; {character used for comma}
- {format specifiers for currency masks}
- CurrDigits : 2; {number of dec places in currency}
- SlashChar : '/'; {date seperator}
- {characters that represent boolean values}
- TrueChar : 'T';
- FalseChar : 'F';
- YesChar : 'Y';
- NoChar : 'N');
-
-var
- {global default international support object}
- OvcIntlSup : TOvcIntlSup;
-
-implementation
-
-{*** Inline routines ***}
-
-{$IFDEF NoAsm}
-function GetMaxWord(A, B : Word) : Word;
-begin
- if A >= B then
- Result := A
- else
- Result := B;
-end;
-{$ELSE}
-function GetMaxWord(A, B : Word) : Word; register;
- {-Return the greater of A and B}
-asm
- and eax,0FFFFH {faster than movzx }
- and edx,0FFFFH {faster than movzx }
- cmp eax,edx {compare A and B }
- jae @@001 {done if ax is greater or equal }
- mov eax,edx {dx is larger, set result }
-@@001:
-end;
-{$ENDIF}
-
-{*** TOvcIntlSup ***}
-
-constructor TOvcIntlSup.Create;
-begin
- inherited Create;
-
- FAutoUpdate := False;
-
- {substitution strings for semi-literal mask characters}
- StrCopy(FCurrencyLtStr, DefaultIntlData.CurrencyLtStr);
- StrCopy(FCurrencyRtStr, DefaultIntlData.CurrencyRtStr);
- FDecimalChar := DefaultIntlData.DecimalChar;
- FCommaChar := DefaultIntlData.CommaChar;
-
- {format specifiers for currency masks}
- FCurrencyDigits := DefaultIntlData.CurrDigits;
- FSlashChar := DefaultIntlData.SlashChar;
-
- {characters that represent boolean values}
- FTrueChar := DefaultIntlData.TrueChar;
- FFalseChar := DefaultIntlData.FalseChar;
- FYesChar := DefaultIntlData.YesChar;
- FNoChar := DefaultIntlData.NoChar;
-
- {get windows international information}
- ResetInternationalInfo;
-end;
-
-function TOvcIntlSup.CurrentDateString(const Picture : string;
- Pack : Boolean) : string;
- {-returns today's date as a string of the specified form}
-begin
- Result := DateToDateString(Picture, CurrentDate, Pack);
-end;
-
-function TOvcIntlSup.CurrentDatePChar(Dest : PAnsiChar; Picture : PAnsiChar;
- Pack : Boolean) : PAnsiChar;
- {-returns today's date as a string of the specified form}
-begin
- Result := DateToDatePChar(Dest, Picture, CurrentDate, Pack);
-end;
-
-function TOvcIntlSup.CurrentTimeString(const Picture : string; Pack : Boolean) : string;
- {-returns current time as a string of the specified form}
-begin
- Result := TimeToTimeString(Picture, CurrentTime, Pack);
-end;
-
-function TOvcIntlSup.CurrentTimePChar(Dest : PAnsiChar; Picture : PAnsiChar; Pack : Boolean) : PAnsiChar;
- {-returns current time as a string of the specified form}
-begin
- Result := TimeToTimePChar(Dest, Picture, CurrentTime, Pack);
-end;
-
-function TOvcIntlSup.DateStringIsBlank(const Picture, S : string) : Boolean;
- {-return True if the month, day, and year in S are all blank}
-var
- Buf1 : array[0..255] of AnsiChar;
- Buf2 : array[0..255] of AnsiChar;
-begin
- StrPCopy(Buf1, Picture);
- StrPCopy(Buf2, S);
- Result := DatePCharIsBlank(Buf1, Buf2);
-end;
-
-function TOvcIntlSup.DatePCharIsBlank(Picture, S : PAnsiChar) : Boolean;
- {-return True if the month, day, and year in S are all blank}
-var
- M, D, Y : Integer;
-begin
- isExtractFromPicture(Picture, S, pmMonthName, M, -2, 0);
- if M = 0 then
- isExtractFromPicture(Picture, S, pmMonth, M, -2, -2);
- isExtractFromPicture(Picture, S, pmDay, D, -2, -2);
- isExtractFromPicture(Picture, S, pmYear, Y, -2, -2);
- Result := (M = -2) and (D = -2) and (Y = -2);
-end;
-
-function TOvcIntlSup.DateStringToDate(const Picture, S : string; Epoch : Integer) : TStDate;
- {-convert St, a string of the form indicated by Picture, to a julian date.
- Picture and St must be of equal lengths}
-var
- Buf1 : array[0..255] of AnsiChar;
- Buf2 : array[0..255] of AnsiChar;
-begin
- StrPCopy(Buf1, Picture);
- StrPCopy(Buf2, S);
- Result := DatePCharToDate(Buf1, Buf2, Epoch);
-end;
-
-function TOvcIntlSup.DatePCharToDate(Picture, S : PAnsiChar; Epoch : Integer) : TStDate;
- {-convert St, a string of the form indicated by Picture, to a julian date.
- Picture and St must be of equal lengths}
-var
- Month, Day, Year : Integer;
-begin
- {extract day, month, year from St}
- if DatePCharToDMY(Picture, S, Day, Month, Year, Epoch) then
- {convert to julian date}
- Result := DMYtoStDate(Day, Month, Year, Epoch)
- else
- Result := BadDate;
-end;
-
-function TOvcIntlSup.DateStringToDMY(const Picture, S : string; var Day, Month, Year : Integer;
- Epoch : Integer) : Boolean;
- {-extract day, month, and year from S, returning true if string is valid}
-var
- Buf1 : array[0..255] of AnsiChar;
- Buf2 : array[0..255] of AnsiChar;
-begin
- StrPCopy(Buf1, Picture);
- StrPCopy(Buf2, S);
- Result := DatePCharToDMY(Buf1, Buf2, Day, Month, Year, Epoch);
-end;
-
-function TOvcIntlSup.DatePCharToDMY(Picture, S : PAnsiChar; var Day, Month, Year : Integer;
- Epoch : Integer) : Boolean;
- {-extract day, month, and year from S, returning true if string is valid}
-begin
- Result := False;
- if StrLen(Picture) <> StrLen(S) then
- Exit;
-
- isExtractFromPicture(Picture, S, pmMonthName, Month, -1, 0);
- if Month = 0 then
- isExtractFromPicture(Picture, S, pmMonth, Month, -1, DefaultMonth);
- isExtractFromPicture(Picture, S, pmDay, Day, -1, 1);
- isExtractFromPicture(Picture, S, pmYear, Year, -1, DefaultYear);
- Result := ValidDate(Day, Month, Year, Epoch);
-end;
-
-function TOvcIntlSup.DateToDateString(const Picture : string;
- Julian : TStDate; Pack : Boolean) : string;
- {-convert Julian to a string of the form indicated by Picture}
-var
- Buf1 : array[0..255] of AnsiChar;
- Buf2 : array[0..255] of AnsiChar;
-begin
- StrPCopy(Buf1, Picture);
- Result := StrPas(DateToDatePChar(Buf2, Buf1, Julian, Pack));
-end;
-
-function TOvcIntlSup.DateToDatePChar(Dest : PAnsiChar; Picture : PAnsiChar;
- Julian : TStDate; Pack : Boolean) : PAnsiChar;
- {-convert Julian to a string of the form indicated by Picture}
-var
- Month, Day, Year : Integer;
-begin
- Move(Picture[0], Dest[0], StrLen(Picture)+1);
- if Julian = BadDate then begin
- {map picture characters to spaces}
- isSubstChar(Dest, pmMonth, ' ');
- isSubstChar(Dest, pmMonthName, ' ');
- isSubstChar(Dest, pmDay, ' ');
- isSubstChar(Dest, pmYear, ' ');
- isSubstChar(Dest, pmWeekDay, ' ');
- isMergePictureSt(Picture, Dest, pmLongDateSub1, wldSub1);
- isMergePictureSt(Picture, Dest, pmLongDateSub2, wldSub2);
- isMergePictureSt(Picture, Dest, pmLongDateSub3, wldSub3);
-
- {map slashes}
- isSubstChar(Dest, pmDateSlash, SlashChar);
-
- Result := Dest;
- end else begin
- {convert Julian to day/month/year}
- StDateToDMY(Julian, Day, Month, Year);
- {merge the month, day, and year into the picture}
- Result := DMYtoDatePChar(Dest, Picture, Day, Month, Year, Pack, 0);
- end;
-end;
-
-function TOvcIntlSup.DayOfWeekToString(WeekDay : TDayType) : string;
- {-return the day of the week specified by WeekDay as a string. Will
- honor the international names as specified in the INI file.}
-begin
- Result := LongDayNames[Ord(WeekDay)+1];
-end;
-
-function TOvcIntlSup.DayOfWeekToPChar(Dest : PAnsiChar; WeekDay : TDayType) : PAnsiChar;
- {-return the day of the week specified by WeekDay as a string in Dest. Will
- honor the international names as specified in the INI file.}
-begin
- Result := Dest;
- StrPCopy(Dest, LongDayNames[Ord(WeekDay)+1]);
-end;
-
-destructor TOvcIntlSup.Destroy;
-begin
-{$IFNDEF LCL}
- if intlHandle <> 0 then
- {$IFDEF VERSION6}
- Classes.DeallocateHWnd(intlHandle);
- {$ELSE}
- DeallocateHWnd(intlHandle);
- {$ENDIF}
-{$ENDIF}
- StrDispose(wCountry);
- inherited Destroy;
-end;
-
-function TOvcIntlSup.DMYtoDateString(const Picture : string; Day, Month,
- Year : Integer; Pack : Boolean; Epoch : Integer) : string;
- {-merge the month, day, and year into the picture}
-var
- Buf1 : array[0..255] of AnsiChar;
- Buf2 : array[0..255] of AnsiChar;
-begin
- StrPCopy(Buf1, Picture);
- Result := StrPas(DMYtoDatePChar(Buf2, Buf1, Day, Month, Year, Pack, Epoch));
-end;
-
-function TOvcIntlSup.DMYtoDatePChar(Dest : PAnsiChar; Picture : PAnsiChar; Day, Month,
- Year : Integer; Pack : Boolean; Epoch : Integer) : PAnsiChar;
- {-merge the month, day, and year into the picture}
-var
- DOW : Integer;
- EpochCent : Integer;
-begin
- Move(Picture[0], Dest[0], StrLen(Picture)+1);
-
- EpochCent := (Epoch div 100)*100;
- if Word(Year) < 100 then begin
- if Year < (Epoch mod 100) then
- Inc(Year, EpochCent + 100)
- else
- Inc(Year, EpochCent)
- end;
-
- DOW := Integer(DayOfWeekDMY(Day, Month, Year, Epoch));
- isMergeIntoPicture(Dest, pmMonth, Month);
- isMergeIntoPicture(Dest, pmDay, Day);
- isMergeIntoPicture(Dest, pmYear, Year);
- isMergeIntoPicture(Dest, pmMonthName, Month);
- isMergeIntoPicture(Dest, pmWeekDay, DOW);
-
- {map slashes}
- isSubstChar(Dest, pmDateSlash, SlashChar);
-
- isMergePictureSt(Picture, Dest, pmLongDateSub1, wldSub1);
- isMergePictureSt(Picture, Dest, pmLongDateSub2, wldSub2);
- isMergePictureSt(Picture, Dest, pmLongDateSub3, wldSub3);
-
- if Pack then
- isPackResult(Picture, Dest);
-
- Result := Dest;
-end;
-
-function TOvcIntlSup.GetCountry : string;
- {-return the country setting}
-begin
- Result := StrPas(wCountry);
-end;
-
-function TOvcIntlSup.GetCurrencyLtStr : string;
-begin
- Result := StrPas(FCurrencyLtStr);
-end;
-
-function TOvcIntlSup.GetCurrencyRtStr : string;
-begin
- Result := StrPas(FCurrencyRtStr);
-end;
-
-function TOvcIntlSup.InternationalCurrency(FormChar : AnsiChar; MaxDigits : Byte; Float,
- AddCommas, IsNumeric : Boolean) : string;
- {-Return a picture mask for a currency string, based on Windows' intl info}
-var
- Buf1 : array[0..255] of AnsiChar;
-begin
- Result := StrPas(InternationalCurrencyPChar(Buf1, FormChar, MaxDigits,
- Float, AddCommas, IsNumeric));
-end;
-
-function TOvcIntlSup.InternationalCurrencyPChar(Dest : PAnsiChar; FormChar : AnsiChar;
- MaxDigits : Byte; Float, AddCommas, IsNumeric : Boolean) : PAnsiChar;
- {-Return a picture mask for a currency string, based on Windows' intl info}
-const
- NP : array[0..1] of AnsiChar = pmNegParens+#0;
- NH : array[0..1] of AnsiChar = pmNegHere+#0;
-var
- CLSlen, DLen, I, J : Word;
- Tmp : array[0..10] of AnsiChar;
-begin
- Dest[0] := #0;
- Result := Dest;
-
- if (MaxDigits = 0) then
- Exit;
-
- {initialize Dest with the numeric part of the string to left of decimal point}
- I := Pred(MaxDigits) div 3 ;
- J := Word(MaxDigits)+(I*Ord(AddCommas));
- if J > 247 then
- DLen := 247
- else
- DLen := J;
- FillChar(Dest[0], DLen, FormChar);
- Dest[DLen] := #0;
-
- if AddCommas then begin
- {insert commas at appropriate points}
- J := 0;
- for I := DLen-1 downto 0 do
- if J < 3 then
- Inc(J)
- else begin
- Dest[I] := pmComma;
- J := 0;
- end;
- end;
-
- {add in the decimals}
- if CurrencyDigits > 0 then begin
- Dest[DLen] := pmDecimalPt;
- FillChar(Dest[DLen+1], CurrencyDigits, FormChar);
- Inc(DLen, CurrencyDigits+1);
- Dest[DLen] := #0;
- end;
-
- {do we need a minus before the currency symbol}
- if (wNegCurrencyForm = 6) then
- StrCat(Dest, NH);
-
- {see if we can do a floating currency symbol}
- if Float then
- Float := not Odd(wCurrencyForm);
-
- {plug in the picture characters for the currency symbol}
- CLSlen := StrLen(FCurrencyLtStr);
- if Float then
- StrStInsertPrim(Dest, CharStrPChar(Tmp, pmFloatDollar, CLSlen), 0)
- else if not Odd(wCurrencyForm) then
- StrStInsertPrim(Dest, CharStrPChar(Tmp, pmCurrencyLt, CLSlen), 0)
- else
- StrCat(Dest, CharStrPChar(Tmp, pmCurrencyRt, StrLen(FCurrencyRtStr)));
-
- {plug in special minus characters}
- if IsNumeric then
- case wNegCurrencyForm of
- 0, 4 :
- StrCat(Dest, NP);
- 3, 7, 10 :
- if Odd(wCurrencyForm) then
- StrCat(Dest, NH);
- end;
-end;
-
-function TOvcIntlSup.InternationalDate(ForceCentury : Boolean) : string;
- {-return a picture mask for a short date string, based on Windows' international information}
-var
- Buf : array[0..255] of AnsiChar;
-begin
- InternationalDatePChar(Buf, ForceCentury);
- Result := StrPas(Buf);
-end;
-
-function TOvcIntlSup.InternationalDatePChar(Dest : PAnsiChar;
- ForceCentury : Boolean) : PAnsiChar;
- {-return a picture mask for a date string, based on Windows' int'l info}
-
-
- procedure FixMask(MC : AnsiChar; DL : Integer);
- var
- I : Cardinal;
- J, AL : Word;
- MCT : AnsiChar;
- Found : Boolean;
- begin
- {find number of matching characters}
- MCT := MC;
-
- Found := StrChPos(Dest, MC, I);
- if not Found then begin
- MCT := UpCase(MC);
- Found := StrChPos(Dest, MCT, I);
- end;
- if not Found then
- Exit;
-
- {pad substring to desired length}
- AL := isMaskCharCount(Dest, MCT);
- if AL < DL then
- for J := 1 to DL-AL do
- StrChInsertPrim(Dest, MCT, I);
-
-
- if MC <> pmYear then
- {choose blank/zero padding}
- case AL of
- 1 : if MCT = MC then
- isSubstCharSim(Dest, MCT, UpCase(MCT));
- 2 : if MCT <> MC then
- isSubstCharSim(Dest, MCT, MC);
- end;
- end;
-
-begin
- {copy Windows mask into our var}
- StrCopy(Dest, wShortDate);
-
- {if single Day marker, make double}
- FixMask(pmDay, 2);
-
- {if single Month marker, make double}
- FixMask(pmMonth, 2);
-
- {force yyyy if desired}
- FixMask(pmYear, 2 shl Ord(ForceCentury));
-
- Result := Dest;
-end;
-
-function TOvcIntlSup.InternationalLongDate(ShortNames : Boolean; ExcludeDOW : Boolean) : string;
- {-return a picture mask for a date string, based on Windows' int'l info}
-var
- Buf : array[0..255] of AnsiChar;
-begin
- Result := StrPas(InternationalLongDatePChar(Buf, ShortNames, ExcludeDOW));
-end;
-
-function TOvcIntlSup.InternationalLongDatePChar(Dest : PAnsiChar; ShortNames : Boolean;
- ExcludeDOW : Boolean) : PAnsiChar;
- {-return a picture mask for a date string, based on Windows' int'l info}
-var
- I : Cardinal;
- WC : Word;
- Temp : array[0..80] of AnsiChar;
- Stop : Boolean;
-
- function LongestMonthName : Word;
- var
- I : Word;
- begin
- Result := 0;
- for I := 1 to 12 do
- Result := GetMaxWord(Result, Length(LongMonthNames[I]));
- end;
-
- function LongestDayName : Word;
- var
- D : TDayType;
- begin
- Result := 0;
- for D := Sunday to Saturday do
- Result := GetMaxWord(Result, Length(LongDayNames[Ord(D)+1]));
- end;
-
- procedure FixMask(MC : AnsiChar; DL : Integer);
- var
- I : Cardinal;
- J, AL : Word;
- MCT : AnsiChar;
- Found : Boolean;
- begin
- {find first matching mask character}
- MCT := MC;
- Found := StrChPos(Temp, MC, I);
- if not Found then begin
- MCT := UpCase(MC);
- Found := StrChPos(Temp, MCT, I);
- end;
- if not Found then
- Exit;
-
- {pad substring to desired length}
- AL := isMaskCharCount(Temp, MCT);
- if AL < DL then begin
- for J := 1 to DL-AL do
- StrChInsertPrim(Temp, MCT, I);
- end else if (AL > DL) then
- StrStDeletePrim(Temp, I, AL-DL);
-
- if MC <> pmYear then
- {choose blank/zero padding}
- case AL of
- 1 : if MCT = MC then
- isSubstCharSim(Temp, MCT, UpCase(MCT));
- 2 : if MCT <> MC then
- isSubstCharSim(Temp, MCT, MC);
- end;
- end;
-
-begin
- {copy Windows mask into temporary var}
- StrCopy(Temp, wLongDate);
-
- if ExcludeDOW then begin
- {remove day-of-week and any junk that follows}
- if StrChPos(Temp, pmWeekDay, I) then begin
- WC := 1;
- Stop := False;
- repeat
- case LoCaseChar(Temp[I+WC]) of
- #0, pmMonth, pmDay, pmYear, pmMonthName : Stop := True;
- else
- Inc(WC);
- end;
- until Stop;
- StrStDeletePrim(Temp, I, WC);
- end;
- end else if ShortNames then
- FixMask(pmWeekDay, 3)
- else if isMaskCharCount(Temp, pmWeekday) = 4 then
- FixMask(pmWeekDay, LongestDayName);
-
- {fix month names}
- if ShortNames then
- FixMask(pmMonthName, 3)
- else if isMaskCharCount(Temp, pmMonthName) = 4 then
- FixMask(pmMonthName, LongestMonthName);
-
- {if single Day marker, make double}
- FixMask(pmDay, 2);
-
- {if single Month marker, make double}
- FixMask(pmMonth, 2);
-
- {force yyyy}
- FixMask(pmYear, 4);
-
- {copy result into Dest}
- StrCopy(Dest, Temp);
- Result := Dest;
-end;
-
-function TOvcIntlSup.InternationalTime(ShowSeconds : Boolean) : string;
- {-return a picture mask for a time string, based on Windows' int'l info}
-var
- Buf : array[0..255] of AnsiChar;
-begin
- Result := StrPas(InternationalTimePChar(Buf, ShowSeconds));
-end;
-
-function TOvcIntlSup.InternationalTimePChar(Dest : PAnsiChar; ShowSeconds : Boolean) : PAnsiChar;
- {-return a picture mask for a time string, based on Windows' int'l info}
-var
- SL, ML : Word;
- S : array[0..20] of AnsiChar;
-begin
- {format the default string}
- StrCopy(S, 'hh:mm:ss');
- if not wTLZero then
- S[0] := pmHourU;
-
- {show seconds?}
- if not ShowSeconds then
- S[5] := #0;
-
- {handle international AM/PM markers}
- if w12Hour then begin
- ML := GetMaxWord(StrLen(@w1159), StrLen(@w2359));
- if (ML <> 0) then begin
- SL := StrLen(S);
- S[SL] := ' ';
- FillChar(S[SL+1], ML, pmAmPm);
- S[SL+ML+1] := #0;
- end;
- end;
-
- StrCopy(Dest, S);
- Result := Dest;
-end;
-
-procedure TOvcIntlSup.isIntlWndProc(var Msg : TMessage);
- {-window procedure to catch WM_WININICHANGE messages}
-begin
- with Msg do
- if AutoUpdate and (Msg = WM_WININICHANGE) then
- try
- if Assigned(FOnWinIniChange) then
- FOnWinIniChange(Self)
- else
- ResetInternationalInfo;
- except
- Application.HandleException(Self);
- end
- else
- Result := DefWindowProc(intlHandle, Msg, wParam, lParam);
-end;
-
-procedure TOvcIntlSup.isExtractFromPicture(Picture, S : PAnsiChar;
- Ch : AnsiChar; var I : Integer;
- Blank, Default : Integer);
- {-extract the value of the subfield specified by Ch from S and return in
- I. I will be set to -1 in case of an error, Blank if the subfield exists
- in Picture but is empty, Default if the subfield doesn't exist in
- Picture.}
-var
- PTmp : Array[0..20] of AnsiChar;
- J, K, W : Cardinal;
- Code : Integer;
- Found,
- UpFound : Boolean;
-begin
- {find the start of the subfield}
- I := Default;
- Found := StrChPos(Picture, Ch, J);
- Ch := UpCaseChar(Ch);
- UpFound := StrChPos(Picture, Ch, K);
-
- if not Found or (UpFound and (K < J)) then begin
- J := K;
- Found := UpFound;
- end;
- if not Found or (StrLen(S) <> StrLen(Picture)) then
- Exit;
-
- {extract the substring}
- PTmp[0] := #0;
- W := 0;
- K := 0;
- while (UpCaseChar(Picture[J]) = Ch) and (J < StrLen(Picture)) do begin
- if S[J] <> ' ' then begin
- PTmp[k] := S[J];
- Inc(K);
- PTmp[k] := #0;
- end;
- Inc(J);
- Inc(W);
- end;
-
- if StrLen(PTmp) = 0 then
- I := Blank
- else if Ch = pmMonthNameU then begin
- I := MonthPCharToMonth(PTmp, W);
- if I = 0 then
- I := -1;
- end else begin
- {convert to a value}
- Val(PTmp, I, Code);
- if Code <> 0 then
- I := -1;
- end;
-end;
-
-function TOvcIntlSup.isMaskCharCount(P : PAnsiChar; MC : AnsiChar) : Word;
- {-return the number of mask characters (MC) in P}
-var
- I : Cardinal;
-begin
- if StrChPos(P, MC, I) then begin
- Result := 1;
- while P[I+Result] = MC do
- Inc(Result);
- end else
- Result := 0;
-end;
-
-procedure TOvcIntlSup.isMergePictureSt(Picture, P : PAnsiChar; MC : AnsiChar; SP : PAnsiChar);
-var
- I, J : Cardinal;
-begin
- if not StrChPos(Picture, MC, I) then
- Exit;
- J := 0;
- while Picture[I] = MC do begin
- if SP[J] = #0 then
- P[I] := ' '
- else begin
- P[I] := SP[J];
- Inc(J);
- end;
- Inc(I);
- end;
-end;
-
-procedure TOvcIntlSup.isMergeIntoPicture(Picture : PAnsiChar; Ch : AnsiChar;
- I : Integer);
- {-merge I into location in Picture indicated by format character Ch}
-var
- Tmp : string[MaxDateLen];
- TLen : Byte absolute Tmp;
- J : Cardinal;
- K, L : Word;
- UCh, CPJ, CTI : AnsiChar;
- Done : Boolean;
-begin
- {find the start of the subfield}
- UCh := UpCaseChar(Ch);
- if not StrChPos(Picture, Ch, J) then
- if not StrChPos(Picture, UCh, J) then
- Exit;
-
- {find the end of the subfield}
- K := J;
- while (J < StrLen(Picture)) and (UpCaseChar(Picture[J]) = UCh) do
- Inc(J);
- Dec(J);
-
- if (UCh = pmWeekDayU) or (UCh = pmMonthNameU) then begin
- if UCh = pmWeekDayU then
- case I of
- Ord(Sunday)..Ord(Saturday) :
- Tmp := LongDayNames[I+1];
- else
- Tmp := '';
- end
- else
- case I of
- 1..12 :
- Tmp := LongMonthNames[I];
- else
- Tmp := '';
- end;
- K := Succ(J-K);
- if K > TLen then
- FillChar(Tmp[TLen+1], K-TLen, ' ');
- TLen := K;
- end else
- {convert I to a string}
- Str(I:MaxDateLen, Tmp);
-
- {now merge}
- L := TLen;
- Done := False;
- CPJ := Picture[J];
-
- while (UpCaseChar(CPJ) = UCh) and not Done do begin
- CTI := Tmp[L];
- if (UCh = pmMonthNameU) or (UCh = pmWeekDayU) then begin
- case CPJ of
- pmMonthNameU, pmWeekDayU :
- CTI := UpCaseChar(CTI);
- end;
- end
- {change spaces to 0's if desired}
- else if (CPJ >= 'a') and (CTI = ' ') then
- CTI := '0';
- Picture[J] := CTI;
- Done := (J = 0) or (L = 0);
- if not Done then begin
- Dec(J);
- Dec(L);
- end;
- CPJ := Picture[J];
- end;
-end;
-
-procedure TOvcIntlSup.isPackResult(Picture, S : PAnsiChar);
- {-remove unnecessary blanks from S}
-var
- Temp : array[0..80] of AnsiChar;
- I, J : Integer;
-begin
- FillChar(Temp, SizeOf(Temp), #0);
- I := 0;
- J := 0;
- while Picture[I] <> #0 do begin
- case Picture[I] of
- pmMonthU, pmDayU, pmMonthName, pmMonthNameU, pmWeekDay,
- pmWeekDayU, pmHourU, {pmMinU,} pmSecondU :
- if S[I] <> ' ' then begin
- Temp[J] := S[I];
- Inc(J);
- end;
- pmAmPm :
- if S[I] <> ' ' then begin
- Temp[J] := S[I];
- Inc(J);
- end
- else if (I > 0) and (Picture[I-1] = ' ') then begin
- Dec(J);
- Temp[J] := #0;
- end;
- else
- Temp[J] := S[I];
- Inc(J);
- end;
- Inc(I);
- end;
-
- StrCopy(S, Temp);
-end;
-
-procedure TOvcIntlSup.isSubstChar(Picture : PAnsiChar; OldCh, NewCh : AnsiChar);
- {-replace all instances of OldCh in Picture with NewCh}
-var
- I : Byte;
- UpCh : AnsiChar;
- Temp : Cardinal;
-begin
- UpCh := UpCaseChar(OldCh);
- if StrChPos(Picture, OldCh, Temp) or
- StrChPos(Picture, UpCh, Temp) then
- for I := 0 to StrLen(Picture)-1 do
- if UpCaseChar(Picture[I]) = UpCh then
- Picture[I] := NewCh;
-end;
-
-procedure TOvcIntlSup.isSubstCharSim(P : PAnsiChar; OC, NC : AnsiChar);
-begin
- while P^ <> #0 do begin
- if P^ = OC then
- P^ := NC;
- Inc(P);
- end;
-end;
-
-function TOvcIntlSup.isTimeToTimeStringPrim(Dest, Picture : PAnsiChar;
- T : TStTime; Pack : Boolean;
- t1159, t2359 : PAnsiChar) : PAnsiChar;
- {-convert T to a string of the form indicated by Picture}
-var
- I : Word;
- Hours : Byte;
- Minutes : Byte;
- Seconds : Byte;
- P : PAnsiChar;
- TPos : Cardinal;
- Found : Boolean;
-begin
- {merge the hours, minutes, and seconds into the picture}
- StTimeToHMS(T, Hours, Minutes, Seconds);
- StrCopy(Dest, Picture);
-
- P := nil;
-
- {check for TimeOnly}
- Found := StrChPos(Dest, pmAmPm, TPos);
- if Found then begin
- if (Hours >= 12) then
- P := t2359
- else
- P := t1159;
- if (t1159[0] <> #0) and (t2359[0] <> #0) then begin
- {adjust hours}
- case Hours of
- 0 : Hours := 12;
- 13..23 : Dec(Hours, 12);
- end;
- end;
- end;
-
- if T = BadTime then begin
- {map picture characters to spaces}
- isSubstChar(Dest, pmHour, ' ');
- isSubstChar(Dest, pmMinute, ' ');
- isSubstChar(Dest, pmSecond, ' ');
- end else begin
- {merge the numbers into the picture}
- isMergeIntoPicture(Dest, pmHour, Hours);
- isMergeIntoPicture(Dest, pmMinute, Minutes);
- isMergeIntoPicture(Dest, pmSecond, Seconds);
- end;
-
- {map colons}
- isSubstChar(Dest, pmTimeColon, wColonChar);
-
- {plug in AM/PM string if appropriate}
- if Found then begin
- if (t1159[0] = #0) and (t2359[0] = #0) then
- isSubstCharSim(@Dest[TPos], pmAmPm, ' ')
- else if (T = BadTime) and (t1159[0] = #0) then
- isSubstCharSim(@Dest[TPos], pmAmPm, ' ')
- else begin
- I := 0;
- while (Dest[TPos] = pmAmPm) and (P[I] <> #0) do begin
- Dest[TPos] := P[I];
- Inc(I);
- Inc(TPos);
- end;
- end;
- end;
-
- if Pack and (T <> BadTime) then
- isPackResult(Picture, Dest);
-
- Result := Dest;
-end;
-
-function TOvcIntlSup.MonthStringToMonth(const S : string; Width : Byte) : Byte;
- {-Convert the month name in MSt to a month (1..12)}
-var
- I : Word;
- Mt : string[MaxDateLen];
- MLen : Byte absolute Mt;
- St : string[MaxDateLen];
- SLen : Byte absolute St;
-begin
- Result := 0;
- Mt := AnsiUpperCase(S);
- if Width > MLen then
- FillChar(Mt[MLen+1], Width-MLen, ' ');
- MLen := Width;
-
- for I := 1 to 12 do begin
- St := AnsiUpperCase(LongMonthNames[I]);
- if Width > SLen then
- FillChar(St[SLen+1], Width-SLen, ' ');
- SLen := Width;
- if Mt = St then begin
- Result := I;
- Break;
- end;
- end;
-end;
-
-function TOvcIntlSup.MonthPCharToMonth(S : PAnsiChar; Width : Byte) : Byte;
- {-convert the month name in S to a month (1..12)}
-var
- I : Word;
- Mt : string[MaxDateLen];
- MLen : Byte absolute Mt;
- St : string[MaxDateLen];
- SLen : Byte absolute St;
-begin
- Result := 0;
- Mt := AnsiUpperCase(StrPas(S));
- if Width > MLen then
- FillChar(Mt[MLen+1], Width-MLen, ' ');
- MLen := Width;
-
- for I := 1 to 12 do begin
- St := AnsiUpperCase(LongMonthNames[I]);
- if Width > SLen then
- FillChar(St[SLen+1], Width-SLen, ' ');
- SLen := Width;
- if Mt = St then begin
- Result := I;
- Break;
- end;
- end;
-end;
-
-function TOvcIntlSup.MonthToString(Month : Integer) : string;
- {-return month name as a string for Month}
-begin
- if (Month >= 1) and (Month <= 12) then
- Result := LongMonthNames[Month]
- else
- Result := '';
-end;
-
-function TOvcIntlSup.MonthToPChar(Dest : PAnsiChar; Month : Integer) : PAnsiChar;
- {-return month name as a string for Month}
-begin
- Result := Dest;
- if (Month >= 1) and (Month <= 12) then
- StrPCopy(Dest, LongMonthNames[Month])
- else
- Dest[0] := #0;
-end;
-
-procedure TOvcIntlSup.ResetInternationalInfo;
- {-read Window's international information and string resources}
-var
- S : string;
- I : Cardinal;
- Buf : array[0..255] of AnsiChar;
- R : TRegistry;
-
- procedure GetIntlString(S, Def, Buf : PAnsiChar; Size : Word);
- begin
- GetProfileString('intl', S, Def, Buf, Size);
- end;
-
- function GetIntlChar(S, Def : PAnsiChar) : AnsiChar;
- var
- B : array[0..5] of AnsiChar;
- begin
- GetIntlString(S, Def, B, SizeOf(B));
- Result := B[0];
- if (Result = #0) then
- Result := Def[0];
- end;
-
- procedure ExtractSubString(SubChar : AnsiChar; Dest : PAnsiChar);
- var
- I, Temp : Cardinal;
- L : Word;
- begin
- FillChar(Dest^, SizeOf(wldSub1), 0);
- if not StrChPos(wLongDate, '''', I) then
- Exit;
-
- {delete the first quote}
- StrChDeletePrim(wLongDate, I);
-
- {assure that there is another quote}
- if not StrChPos(wLongDate, '''', Temp) then
- Exit;
-
- {copy substring into Dest, replace substring with SubChar}
- L := 0;
- while wLongDate[I] <> '''' do
- if L < SizeOf(wldSub1) then begin
- Dest[L] := wLongDate[I];
- Inc(L);
- wLongDate[I] := SubChar;
- Inc(I);
- end else
- StrChDeletePrim(wLongDate, I);
-
- {delete the second quote}
- StrChDeletePrim(wLongDate, I);
- end;
-
-begin
- FDecimalChar := GetIntlChar('sDecimal',
- @DefaultIntlData.DecimalChar);
- FCommaChar := GetIntlChar('sThousand',
- @DefaultIntlData.CommaChar);
- FCurrencyDigits := GetProfileInt('intl', 'iCurrDigits',
- DefaultIntlData.CurrDigits);
- if (FCommaChar = FDecimalChar) then begin
- FDecimalChar := DefaultIntlData.DecimalChar;
- FCommaChar := DefaultIntlData.CommaChar;
- end;
- wNegCurrencyForm := GetProfileInt('intl', 'iNegCurr', 0);
- FListChar := GetIntlChar('sList', ',');
-
- GetIntlString('sCountry', '', Buf, SizeOf(Buf));
- wCountry := StrNew(Buf);
-
- GetIntlString('sCurrency', DefaultIntlData.CurrencyLtStr,
- FCurrencyLtStr, SizeOf(FCurrencyLtStr));
- StrCopy(FCurrencyRtStr, FCurrencyLtStr);
-
- wCurrencyForm := GetProfileInt('intl', 'iCurrency', 0);
- case wCurrencyForm of
- 0 : {};
- 1 : {};
- 2 : StrCat(FCurrencyLtStr, ' ');
- 3 : StrChInsertPrim(FCurrencyRtStr, ' ', 0);
- end;
-
- wTLZero := GetProfileInt('intl', 'iTLZero', 0) <> 0;
- w12Hour := LongTimeFormat[Length(LongTimeFormat)] = 'M';
-
- wColonChar := GetIntlChar('sTTime', ':');
- FSlashChar := GetIntlChar('sDate', @DefaultIntlData.SlashChar);
- GetIntlString('s1159', 'AM', w1159, SizeOf(w1159));
- GetIntlString('s2359', 'PM', w2359, SizeOf(w2359));
-
- {get short date mask and fix it up}
-{$IFDEF MSWINDOWS}
- R := TRegistry.Create;
- try
- R.RootKey := HKEY_CURRENT_USER;
- if R.OpenKey('Control Panel\International', False) then begin
- try
- if R.ValueExists('sShortDate') then
- StrPCopy(wShortDate, R.ReadString('sShortDate'))
- else
- GetIntlString('sShortDate', 'MM/dd/yy',
- wShortDate, SizeOf(wShortDate));
- finally
- R.CloseKey;
- end;
- end else
- GetIntlString('sShortDate', 'MM/dd/yy',
- wShortDate, SizeOf(wShortDate));
- finally
- R.Free;
- end;
-{$ELSE}
- GetIntlString('sShortDate', 'MM/dd/yy',
- wShortDate, SizeOf(wShortDate));
-{$ENDIF}
-
- I := 0;
- while wShortDate[I] <> #0 do begin
- if wShortDate[I] = SlashChar then
- wShortDate[I] := '/';
- Inc(I);
- end;
-
- {get long date mask and fix it up}
- GetIntlString('sLongDate', 'dddd, MMMM dd, yyyy',
- wLongDate, SizeOf(wLongDate));
- ExtractSubString(pmLongDateSub1, wldSub1);
- ExtractSubString(pmLongDateSub2, wldSub2);
- ExtractSubString(pmLongDateSub3, wldSub3);
-
- {replace ddd/dddd with www/wwww}
- if StrStPos(wLongDate, 'ddd', I) then
- while wLongDate[I] = 'd' do begin
- wLongDate[I] := 'w';
- Inc(I);
- end;
-
- {replace MMM/MMMM with nnn/nnnn}
- if StrStPos(wShortDate, 'MMM', I) then
- while wShortDate[I] = 'M' do begin
- wShortDate[I] := 'n';
- Inc(I);
- end;
-
- {replace MMM/MMMM with nnn/nnnn}
- if StrStPos(wLongDate, 'MMM', I) then
- while wLongDate[I] = 'M' do begin
- wLongDate[I] := 'n';
- Inc(I);
- end;
-
- {deal with oddities concerning . and ,}
- I := 0;
- while wLongDate[I] <> #0 do begin
- case wLongDate[I] of
- '.', ',' :
- if wLongDate[I+1] <> ' ' then begin
- StrChInsertPrim(wLongDate, ' ', I+1);
- Inc(I);
- end;
- end;
- Inc(I);
- end;
-
- {get Y/N and T/F values}
- S := GetOrphStr(SCYes);
- if Length(S) = 1 then
- YesChar := S[1];
- S := GetOrphStr(SCNo);
- if Length(S) = 1 then
- NoChar := S[1];
- S := GetOrphStr(SCTrue);
- if Length(S) = 1 then
- TrueChar := S[1];
- S := GetOrphStr(SCFalse);
- if Length(S) = 1 then
- FalseChar := S[1];
-end;
-
-procedure TOvcIntlSup.SetAutoUpdate(Value : Boolean);
- {-set the AutoUpdate option}
-begin
- if Value <> FAutoUpdate then begin
- FAutoUpdate := Value;
-// AllocateHWnd not available in LCL to create non-visual window that
-// responds to messages sent to control. But not needed?
-{$IFNDEF LCL}
- if FAutoUpdate then
- {allocate our window handle}
- {$IFDEF VERSION6}
- intlHandle := Classes.AllocateHWnd(isIntlWndProc)
- {$ELSE}
- intlHandle := AllocateHWnd(isIntlWndProc)
- {$ENDIF}
- else begin
- {deallocate our window handle}
- if intlHandle <> 0 then
- {$IFDEF VERSION6}
- Classes.DeallocateHWnd(intlHandle);
- {$ELSE}
- DeallocateHWnd(intlHandle);
- {$ENDIF}
- intlHandle := 0;
- end;
-{$ENDIF}
- end;
-end;
-
-procedure TOvcIntlSup.SetCurrencyLtStr(const Value : string);
-begin
- StrPLCopy(FCurrencyLtStr, Value, SizeOf(FCurrencyLtStr)-1);
-end;
-
-procedure TOvcIntlSup.SetCurrencyRtStr(const Value : string);
-begin
- StrPLCopy(FCurrencyRtStr, Value, SizeOf(FCurrencyRtStr)-1);
-end;
-
-function TOvcIntlSup.TimeStringToHMS(const Picture, S : string;
- var Hour, Minute, Second : Integer) : Boolean;
- {-extract Hours, Minutes, Seconds from St, returning true if string is valid}
-var
- Buf1 : array[0..255] of AnsiChar;
- Buf2 : array[0..255] of AnsiChar;
-begin
- StrPCopy(Buf1, Picture);
- StrPCopy(Buf2, S);
- Result := TimePCharToHMS(Buf1, Buf2, Hour, Minute, Second);
-end;
-
-function TOvcIntlSup.TimePCharToHMS(Picture, S : PAnsiChar;
- var Hour, Minute, Second : Integer) : Boolean;
- {-extract Hours, Minutes, Seconds from St, returning true if string is valid}
-var
- I, J : Cardinal;
- Tmp,
- t1159,
- t2359 : array[0..20] of AnsiChar;
-begin
- Result := False;
- if StrLen(Picture) <> StrLen(S) then
- Exit;
-
- {extract hours, minutes, seconds from St}
- isExtractFromPicture(Picture, S, pmHour, Hour, -1, 0);
- isExtractFromPicture(Picture, S, pmMinute, Minute, -1, 0);
- isExtractFromPicture(Picture, S, pmSecond, Second, -1, 0);
- if (Hour = -1) or (Minute = -1) or (Second = -1) then begin
- Result := False;
- Exit;
- end;
-
- {check for TimeOnly}
- if StrChPos(Picture, pmAmPm, I) and (w1159[0] <> #0)
- and (w2359[0] <> #0) then begin
- Tmp[0] := #0;
- J := 0;
- while Picture[I] = pmAmPm do begin
- Tmp[J] := S[I];
- Inc(J);
- Inc(I);
- end;
- Tmp[J] := #0;
- TrimTrailPrimPChar(Tmp);
-
- StrCopy(t1159, w1159);
- t1159[J] := #0;
- StrCopy(t2359, w2359);
- t2359[J] := #0;
-
- if (Tmp[0] = #0) then
- Hour := -1
- else if StrIComp(Tmp, t2359) = 0 then begin
- if (Hour < 12) then
- Inc(Hour, 12)
- else if (Hour = 0) or (Hour > 12) then
- {force BadTime}
- Hour := -1;
- end else if StrIComp(Tmp, t1159) = 0 then begin
- if Hour = 12 then
- Hour := 0
- else if (Hour = 0) or (Hour > 12) then
- {force BadTime}
- Hour := -1;
- end else
- {force BadTime}
- Hour := -1;
- end;
-
- Result := ValidTime(Hour, Minute, Second);
-end;
-
-function TOvcIntlSup.TimeToAmPmString(const Picture : string; T : TStTime; Pack : Boolean) : string;
- {-convert T to a string of the form indicated by Picture. Times are always displayed in am/pm format.}
-var
- Buf1 : array[0..255] of AnsiChar;
- Buf2 : array[0..255] of AnsiChar;
-begin
- StrPCopy(Buf1, Picture);
- Result := StrPas(TimeToAmPmPChar(Buf2, Buf1, T, Pack));
-end;
-
-function TOvcIntlSup.TimeToAmPmPChar(Dest : PAnsiChar; Picture : PAnsiChar; T : TStTime; Pack : Boolean) : PAnsiChar;
- {-convert T to a string of the form indicated by Picture. Times are always displayed in am/pm format.}
-const
- t1159 = 'AM'#0;
- t2359 = 'PM'#0;
-var
- PLen : Byte;
- Temp : Cardinal;
-begin
- Move(Picture[0], Dest[0], StrLen(Picture)+1);
- if not StrChPos(Dest, pmAmPm, Temp) then begin
- PLen := StrLen(Dest);
- Dest[PLen] := pmAmPm;
- Dest[PLen+1] := #0;
- end;
- Result := isTimeToTimeStringPrim(Dest, Dest, T, Pack, t1159, t2359);
-end;
-
-function TOvcIntlSup.TimeStringToTime(const Picture, S : string) : TStTime;
- {-convert S, a string of the form indicated by Picture, to a Time variable}
-var
- Buf1 : array[0..255] of AnsiChar;
- Buf2 : array[0..255] of AnsiChar;
-begin
- StrPCopy(Buf1, Picture);
- StrPCopy(Buf2, S);
- Result := TimePCharToTime(Buf1, Buf2);
-end;
-
-function TOvcIntlSup.TimePCharToTime(Picture, S : PAnsiChar) : TStTime;
- {-convert S, a string of the form indicated by Picture, to a Time variable}
-var
- Hours, Minutes, Seconds : Integer;
-begin
- if TimePCharToHMS(Picture, S, Hours, Minutes, Seconds) then
- Result := HMStoStTime(Hours, Minutes, Seconds)
- else
- Result := BadTime;
-end;
-
-function TOvcIntlSup.TimeToTimeString(const Picture : string; T : TStTime; Pack : Boolean) : string;
- {-convert T to a string of the form indicated by Picture}
-var
- Buf1 : array[0..255] of AnsiChar;
- Buf2 : array[0..255] of AnsiChar;
-begin
- StrPCopy(Buf1, Picture);
- Result := StrPas(TimeToTimePChar(Buf2, Buf1, T, Pack));
-end;
-
-function TOvcIntlSup.TimeToTimePChar(Dest : PAnsiChar; Picture : PAnsiChar; T : TStTime; Pack : Boolean) : PAnsiChar;
- {-convert T to a string of the form indicated by Picture}
-begin
- Result := isTimeToTimeStringPrim(Dest, Picture, T, Pack, w1159, w2359);
-end;
-
-procedure DestroyGlobalIntlSup; far;
-begin
- OvcIntlSup.Free;
-end;
-
-
-initialization
- {create instance of default user data class}
- OvcIntlSup := TOvcIntlSup.Create;
-
-finalization
- DestroyGlobalIntlSup;
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/b2/b2c56ca01fed00cd2ed3677fc3e2716f10b707e5.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/b2/b2c56ca01fed00cd2ed3677fc3e2716f10b707e5.svn-base
deleted file mode 100644
index 6067cda7..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/b2/b2c56ca01fed00cd2ed3677fc3e2716f10b707e5.svn-base
+++ /dev/null
@@ -1,189 +0,0 @@
-{*********************************************************}
-{* OVC.INC *}
-{*********************************************************}
-
-{* ***** 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 ***** *}
-
-{Conditional defines that affect compilation}
-
-(*
-{$Q-} {Overflow Checking}
-{$R-} {Range-Checking}
-{$S-} {Stack-Overflow Checking}
-*)
-
-{$IFDEF OrphChecksOn}
- {$Q+,R+,S+}
-{$ELSE}
- {$IFDEF OrphChecksOff}
- {$Q-,R-,S-}
- {$ELSE}
- {$IFOPT Q+}
- {$Q+}
- {$ELSE}
- {$Q-}
- {$ENDIF}
-
- {$IFOPT R+}
- {$R+}
- {$ELSE}
- {$R-}
- {$ENDIF}
-
- {$IFOPT S+}
- {$S+}
- {$ELSE}
- {$S-}
- {$ENDIF}
- {$ENDIF}
-{$ENDIF}
-
-{$V-} {Var-String Checking}
-{$T-} {No type-checked pointers}
-{$X+} {Extended syntax}
-{$P-} {No open string parameters}
-{$B-} {Incomplete Boolean evaluation}
-{$J+} {Writable constants}
-{$H+} {Huge strings}
-
-{General define indicating use under C++ Builder}
-{$IFDEF VER93}
- {$DEFINE CBuilder}
-{$ENDIF}
-{$IFDEF VER110}
- {$DEFINE CBuilder}
- {$ObjExportAll On}
-{$ENDIF}
-{$IFDEF VER125}
- {$DEFINE CBuilder}
- {$ObjExportAll On}
-{$ENDIF}
-{$IFDEF VER130}
- {$IFDEF BCB}
- {$DEFINE CBuilder}
- {$ObjExportAll On}
- {$ENDIF}
-{$ENDIF}
-{$IFDEF VER140} {!!.04}
- {$IFDEF BCB} {!!.04}
- {$DEFINE CBuilder} {!!.04}
- {$ObjExportAll On} {!!.04}
- {$ENDIF} {!!.04}
-{$ENDIF} {!!.04}
-
-{$IFNDEF VER80} {Delphi 1.0}
- {$DEFINE VERSION2} {Delphi 2.0 and BCB 1 or higher}
-{$ENDIF}
-
-{$IFDEF VERSION2}
- {$IFNDEF VER90} {Delphi 2.0}
- {$IFNDEF VER93} {BCB 1.0}
- {$DEFINE VERSION3} {Delphi 3.0 or BCB 3.0}
- {$ENDIF}
- {$ENDIF}
-{$ENDIF}
-
-{$IFDEF VERSION3}
- {$IFNDEF VER100} {Delphi 3}
- {$IFNDEF VER110} {BCB 3}
- {$DEFINE VERSION4} {Delphi 4.0 or higher}
- {$ENDIF}
- {$ENDIF}
-{$ENDIF}
-
-{$IFDEF VERSION4}
- {$IFNDEF VER120} {Delphi 4}
- {$IFNDEF VER125} {BCB 4}
- {$DEFINE VERSION5} {Delphi 5.0 or higher}
- {$ENDIF}
- {$ENDIF}
-{$ENDIF}
-
-{$IFDEF VERSION5}
- {$IFNDEF VER130} {Delphi 5}
- {$IFNDEF VER135} {BCB 5}
- {$DEFINE VERSION6} {Delphi 6.0 or higher}
- {$ENDIF}
- {$ENDIF}
-{$ENDIF}
-
-{$IFDEF VERSION6}
- {$IFNDEF VER140} {Delphi 6}
- {$IFNDEF VER145} {BCB 6}
- {$DEFINE VERSION7} {Delphi 7.0 or higher}
- {$ENDIF}
- {$ENDIF}
-{$ENDIF}
-
-{$IFDEF VERSION2}
- {$IFNDEF VERSION3}
- {$DEFINE VERSION2ONLY}
- {$ENDIF}
-{$ENDIF}
-
-{$IFDEF VERSION3}
- {$IFNDEF VERSION4}
- {$DEFINE VERSION3ONLY}
- {$ENDIF}
-{$ENDIF}
-
-{$IFDEF Win32}
- {$A+} {Word Align Data}
-{$ELSE}
- {$A-} {Byte Align Data}
-{$ENDIF}
-
-{$IFDEF VERSION6}
- {$IFNDEF FPC}
- {$WARN SYMBOL_PLATFORM OFF}
- {$ENDIF}
- {$IFDEF VERSION7}
- {$B- Incomplete boolean evaluation}
- {$H+ Long string support}
- {$J+ Writeable typed constants}
- {$P- No open string parameters}
- {$T- No type-checked pointers}
- {$V- No var string checking}
- {$X+ Extended syntax}
- {$Z1 Enumerations are word sized}
- {$IFNDEF FPC}
- {$WARN UNIT_PLATFORM OFF}
- {$WARN UNSAFE_CODE OFF}
- {$WARN UNSAFE_TYPE OFF}
- {$WARN UNSAFE_CAST OFF}
- {$WARN UNIT_DEPRECATED OFF}
- {$ENDIF}
- {$ENDIF}
-{$ENDIF}
-{ This define turns off all platform warnings in Delphi 6. Delphi 6 }
-{ is cross-platform compatible with Kylix and all of Orpheus' Win32 }
-{ only stuff causes the compiler to throw a truckload of platform }
-{ warnings when rebuilding packages. }
-
-{.$DEFINE ZeroDateAsNull}
-{This define enables special handling for a zero date. If defined, }
-{assigning 0 to a date field is treated the same as assigning the }
-{constant "BadDate" (see manual) using the AsDateTime property. }
-{Otherwise, 0 is treated as a valid date. (32-bit only) }
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/b6/b67a3d27c83bfa1b8c152e93a4e980334dab3421.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/b6/b67a3d27c83bfa1b8c152e93a4e980334dab3421.svn-base
deleted file mode 100644
index f41359e9..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/b6/b67a3d27c83bfa1b8c152e93a4e980334dab3421.svn-base
+++ /dev/null
@@ -1,1323 +0,0 @@
-LazarusResources.Add('TOvcfrmAboutForm','FORMDATA',[
- 'TPF0'#16'TOvcfrmAboutForm'#15'OvcfrmAboutForm'#4'Left'#3#202#0#3'Top'#3#223#0
- +#11'BorderStyle'#7#8'bsDialog'#7'Caption'#6#13'About Orpheus'#12'ClientHeigh'
- +'t'#3'7'#1#6'Height'#3'7'#1#11'ClientWidth'#3#216#1#5'Width'#3#216#1#5'Color'
- +#7#9'clBtnFace'#12'Font.Charset'#7#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'c'
- +'lWindowText'#11'Font.Height'#2#245#10'Font.Style'#11#0#8'OnCreate'#7#10'For'
- +'mCreate'#13'PixelsPerInch'#2'`'#0#6'TBevel'#0#4'Left'#2#6#3'Top'#3#9#1#5'Wi'
- +'dth'#3#195#1#6'Height'#2#17#5'Shape'#7#9'bsTopLine'#0#0#6'TLabel'#0#4'Left'
- +#3#152#0#3'Top'#2#8#5'Width'#2';'#6'Height'#2#16#7'Caption'#6#7'Orpheus'#12
- +'Font.Charset'#7#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Fo'
- +'nt.Height'#2#243#10'Font.Style'#11#6'fsBold'#0#10'ParentFont'#8#0#0#6'TLabe'
- +'l'#0#4'Left'#2#7#3'Top'#3#17#1#5'Width'#3#232#0#6'Height'#2#13#7'Caption'#6
- +',Copyright '#169' 1995-2003 TurboPower Software Co'#0#0#6'TLabel'#0#4'Left'
- +#2#7#3'Top'#3'!'#1#5'Width'#2'V'#6'Height'#2#13#7'Caption'#6#20'All rights r'
- +'eserved.'#0#0#6'TLabel'#6'Label1'#4'Left'#3#151#0#3'Top'#2'('#5'Width'#3'"'
- +#1#6'Height'#2'1'#8'AutoSize'#8#7'Caption'#6#144'Orpheus was released under '
- +'the Mozilla 1.1 license in January, 2003. The project is hosted on SourceFo'
- +'rge at sourceforge.net/projects/tporpheus.'#8'WordWrap'#9#0#0#6'TLabel'#12
- +'VisitUsLabel'#4'Left'#3#153#0#3'Top'#2'l'#5'Width'#3#194#0#6'Height'#2#13#7
- +'Caption'#6'(Visit the Orpheus project on SourceForge'#0#0#6'TLabel'#12'lblT'
- +'urboLink'#4'Left'#3#161#0#3'Top'#2'|'#5'Width'#3#204#0#6'Height'#2#13#6'Cur'
- +'sor'#7#11'crHandPoint'#7'Caption'#6'*http://sourceforge.net/projects/tporph'
- +'eus/'#12'Font.Charset'#7#15'DEFAULT_CHARSET'#10'Font.Color'#7#6'clBlue'#11
- +'Font.Height'#2#245#10'Font.Style'#11#11'fsUnderline'#0#10'ParentFont'#8#7'O'
- +'nClick'#7#17'lblTurboLinkClick'#0#0#6'TBevel'#6'Bevel3'#4'Left'#3#152#0#3'T'
- +'op'#3#160#0#5'Width'#3'1'#1#6'Height'#2'`'#5'Shape'#7#7'bsFrame'#0#0#6'TLab'
- +'el'#22'GeneralNewsgroupsLabel'#4'Left'#3#160#0#3'Top'#3#168#0#5'Width'#2'q'
- +#6'Height'#2#13#7'Caption'#6#22'Orpheus support groups'#0#0#6'TLabel'#7'lblH'
- +'elp'#4'Left'#3#168#0#3'Top'#3#198#0#5'Width'#3#20#1#6'Height'#2#13#6'Cursor'
- +#7#11'crHandPoint'#7'Caption'#6'6http://sourceforge.net/forum/forum.php?foru'
- +'m_id=241874'#12'Font.Charset'#7#15'DEFAULT_CHARSET'#10'Font.Color'#7#6'clBl'
- +'ue'#11'Font.Height'#2#245#10'Font.Style'#11#11'fsUnderline'#0#10'ParentFont'
- +#8#7'OnClick'#7#12'lblHelpClick'#0#0#6'TLabel'#20'lblGeneralDiscussion'#4'Le'
- +'ft'#3#168#0#3'Top'#3#230#0#5'Width'#3#20#1#6'Height'#2#13#6'Cursor'#7#11'cr'
- +'HandPoint'#7'Caption'#6'6http://sourceforge.net/forum/forum.php?forum_id=24'
- +'1873'#12'Font.Charset'#7#15'DEFAULT_CHARSET'#10'Font.Color'#7#6'clBlue'#11
- +'Font.Height'#2#245#10'Font.Style'#11#11'fsUnderline'#0#10'ParentFont'#8#7'O'
- +'nClick'#7#25'lblGeneralDiscussionClick'#0#0#6'TLabel'#6'Label3'#4'Left'#3
- +#168#0#3'Top'#3#217#0#5'Width'#2'^'#6'Height'#2#13#7'Caption'#6#19'General D'
- +'iscussion:'#0#0#6'TLabel'#6'Label2'#4'Left'#3#168#0#3'Top'#3#186#0#5'Width'
- +#2#25#6'Height'#2#13#7'Caption'#6#5'Help:'#0#0#6'TPanel'#6'Panel1'#4'Left'#2
- +#6#3'Top'#2#6#5'Width'#3#139#0#6'Height'#3#251#0#10'BevelOuter'#7#9'bvLowere'
- +'d'#8'TabOrder'#2#0#0#6'TImage'#6'Image1'#4'Left'#2#1#3'Top'#2#1#5'Width'#3
- +#137#0#6'Height'#3#249#0#5'Align'#7#8'alClient'#12'Picture.Data'#10'n'#140#0
- +#0#7'TBitmapb'#140#0#0'BMb'#140#0#0#0#0#0#0'6'#4#0#0'('#0#0#0#137#0#0#0#249#0
- +#0#0#1#0#8#0#0#0#0#0','#136#0#0#0#0#0#0#0#0#0#0#0#1#0#0#0#1#0#0#0#0#0#0#0#0
- +#128#0#0#128#0#0#0#128#128#0#128#0#0#0#128#0#128#0#128#128#0#0#128#128#128#0
- +#192#220#192#0#240#202#166#0#170'?*'#0#255'?*'#0#0'_*'#0'U_*'#0#170'_*'#0#255
- +'_*'#0#0'*'#0'U*'#0#170'*'#0#255'*'#0#0#159'*'#0'U'#159'*'#0#170#159'*'#0
- +#255#159'*'#0#0#191'*'#0'U'#191'*'#0#170#191'*'#0#255#191'*'#0#0#223'*'#0'U'
- +#223'*'#0#170#223'*'#0#255#223'*'#0#0#255'*'#0'U'#255'*'#0#170#255'*'#0#255
- +#255'*'#0#0#0'U'#0'U'#0'U'#0#170#0'U'#0#255#0'U'#0#0#31'U'#0'U'#31'U'#0#170
- +#31'U'#0#255#31'U'#0#0'?U'#0'U?U'#0#170'?U'#0#255'?U'#0#0'_U'#0'U_U'#0#170'_'
- +'U'#0#255'_U'#0#0'U'#0'UU'#0#170'U'#0#255'U'#0#0#159'U'#0'U'#159'U'#0#170
- +#159'U'#0#255#159'U'#0#0#191'U'#0'U'#191'U'#0#170#191'U'#0#255#191'U'#0#0#223
- +'U'#0'U'#223'U'#0#170#223'U'#0#255#223'U'#0#0#255'U'#0'U'#255'U'#0#170#255'U'
- +#0#255#255'U'#0#0#0''#0'U'#0''#0#170#0''#0#255#0''#0#0#31''#0'U'#31''#0
- +#170#31''#0#255#31''#0#0'?'#0'U?'#0#170'?'#0#255'?'#0#0'_'#0'U_'#0
- +#170'_'#0#255'_'#0#0''#0'U'#0#170''#0#255''#0#0#159''#0'U'#159''
- +#0#170#159''#0#255#159''#0#0#191''#0'U'#191''#0#170#191''#0#255#191''#0
- +#0#223''#0'U'#223''#0#170#223''#0#255#223''#0#0#255''#0'U'#255''#0#170
- +#255''#0#255#255''#0#0#0#170#0'U'#0#170#0#170#0#170#0#255#0#170#0#0#31#170
- +#0'U'#31#170#0#170#31#170#0#255#31#170#0#0'?'#170#0'U?'#170#0#170'?'#170#0
- +#255'?'#170#0#0'_'#170#0'U_'#170#0#170'_'#170#0#255'_'#170#0#0''#170#0'U'
- +#170#0#170''#170#0#255''#170#0#0#159#170#0'U'#159#170#0#170#159#170#0#255
- ,#159#170#0#0#191#170#0'U'#191#170#0#170#191#170#0#255#191#170#0#0#223#170#0
- +'U'#223#170#0#170#223#170#0#255#223#170#0#0#255#170#0'U'#255#170#0#170#255
- +#170#0#255#255#170#0#0#0#212#0'U'#0#212#0#170#0#212#0#255#0#212#0#0#31#212#0
- +'U'#31#212#0#170#31#212#0#255#31#212#0#0'?'#212#0'U?'#212#0#170'?'#212#0#255
- +'?'#212#0#0'_'#212#0'U_'#212#0#170'_'#212#0#255'_'#212#0#0''#212#0'U'#212#0
- +#170''#212#0#255''#212#0#0#159#212#0'U'#159#212#0#170#159#212#0#255#159#212
- +#0#0#191#212#0'U'#191#212#0#170#191#212#0#255#191#212#0#0#223#212#0'U'#223
- +#212#0#170#223#212#0#255#223#212#0#0#255#212#0'U'#255#212#0#170#255#212#0#255
- +#255#212#0'U'#0#255#0#170#0#255#0#0#31#255#0'U'#31#255#0#170#31#255#0#255#31
- +#255#0#0'?'#255#0'U?'#255#0#170'?'#255#0#255'?'#255#0#0'_'#255#0'U_'#255#0
- +#170'_'#255#0#255'_'#255#0#0''#255#0'U'#255#0#170''#255#0#255''#255#0#0
- +#159#255#0'U'#159#255#0#170#159#255#0#255#159#255#0#0#191#255#0'U'#191#255#0
- +#170#191#255#0#255#191#255#0#0#223#255#0'U'#223#255#0#170#223#255#0#255#223
- +#255#0'U'#255#255#0#170#255#255#0#255#204#204#0#255#204#255#0#255#255'3'#0
- +#255#255'f'#0#255#255#153#0#255#255#204#0#0''#0#0'U'#0#0#170''#0#0#255''
- +#0#0#0#159#0#0'U'#159#0#0#170#159#0#0#255#159#0#0#0#191#0#0'U'#191#0#0#170
- +#191#0#0#255#191#0#0#0#223#0#0'U'#223#0#0#170#223#0#0#255#223#0#0'U'#255#0#0
- +#170#255#0#0#0#0'*'#0'U'#0'*'#0#170#0'*'#0#255#0'*'#0#0#31'*'#0'U'#31'*'#0
- +#170#31'*'#0#255#31'*'#0#0'?*'#0'U?*'#0#240#251#255#0#164#160#160#0#128#128
- +#128#0#0#0#255#0#0#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255
- +#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#247#0#0#0#0#0#0#245#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'U'#255
- +#240#0#0'-'#240#7#255#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'1'#245#255'1'#0'1'#255
- +'-'#8#175#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#245'-'#0#0'1'#255#240#246#246'-'#7#255#0#255#7
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#7#255#240#0#245#255'1'#247#255'-'#7#8#245#255#246#240
- +#247#246#245#245'Y'#241#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#246#255#7'-'#170#134'-'#255#240#134#7#7#246
- +#245'-'#255#7#240#255#255#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'-'#0#175#255#130#245#255#241#255#240#171
- +'1'#8#247#0#255'^'#240#255#8#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#247#0#8#255#236#8'1'#8'U'#8'-'
- +#255#236#175#130#240#255#255#7#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#247#255#247#0#8#134'U'#130#7#134
- +#134'1'#8#247#8#240#255#255#7#240#245'-'#0#0#0#0#0#0#0#0#0#0#7'-'#0#0#0#0#0
- +#245#130#175#8'1'#0#0#0'1'#7#0#0#0#240#247#245'-'#7#247#7'1'#0#0#0#0#0#0#7
- +#170#175#170#7#0#0#0#0'-'#247#0#0#0#0#0#0#0#0#0#7#170#175#8#7#0#0#0#0#0#0#0
- +'1'#241#0#0#0#0#0'1'#0#0#0#0#240#7#7#7#247#7#247#0'-'#7#0#0#0#240#247'-'#0#0
- +#0#0#0#0#0#0#0#0#240#245#0#0#240#245#255#170#0#212#8#8'1'#255#130#247#246#134
- +#241#255#7#0#245#170#255#255#245#0#0#0#0#0#0#0#0#0#255#130#0#0#0#0#7#255#255
- +#170#175#255#134#0#0#8#255#0#0#0#175#255#240#175#255#246#255#255#246#240#0#0
- +'1'#255#255#175#8#175#255#246'-'#0#0#7#255#0#0#0#0#0#0#0'-'#255#255#175#170
- ,#175#255#255'1'#0#0#0#0#0#8#7#0#0#0#0#0#255#245#0#0#0#245#255#255#255#255#255
- +#255#240#8#255#0#0#0#175#255#240#0#0#0#0#0#0#0#0#0#0#245#246#246#247#246'1'#0
- +#8#175#0#170#255#7#8'1'#134#209#245#246#7'1'#175#246#134'1'#240#245'U'#0#0#0
- +#0#0#0#0#0#255#247#0#0#0#240#255#130#0#0#0'1'#255'U'#0#170#255#0#0#247#246
- +#245#0#8#8#0#0#240#255#175#0'-'#246#8#240#0#0#0#240#175#246#245#0#7#255#0#0#0
- +#0#0#0'-'#255#8#240#0#0#0#240#8#246'1'#0#0#0#0#255#246#0#0#0#0'U'#255#7#0#0#0
- +#240#255'1'#0#0#0#0#0#134#246#0#0#7#255#245#0#0#0#0#0#0#0#0#0#0#0#0#7#134#255
- +#255#255#130#240'Z'#8#241#134'-'#0#0#0#0#246#255#134#134'U'#241'-'#7#246#255
- +#255#7#0#0#0#0#0#0#0#255#247#0#0#0'Z'#255#0#0#0#0#0#175#8#0#134#246#0#240#255
- +#247#0#0#175#170#0#0#0#7#255#0#255#175#0#0#0#0#0#0#0#246#246#0#7#255#0#0#0#0
- +#0#0#255#246#0#0#0#0#0#0#0#175#246#0#0#0#7#255#255#245#0#0#0#8#255#246#0#0#0
- +#245#255'1'#0#0#0#0#0#134#209#0#240#255#247#0#0#0#0#0#0#0#0#0#0#0#0#0#240'-'
- +#240#245'U'#134#209#8#246#246#0#0#0#0#0#0'-'#7'U'#247#8#255#255#246#175'1'
- +#240#0#0#0#0#0#0#0#0#255#247#0#0#0#170#255#0#0#0#0#0#247#255#0#134#175#0#209
- +#8#0#0#0#175#170#0#0#0#247#246#7#255#240#0#0#0#0#0#0#0#245#255'-1'#255#0#0#0
- +#0#0'1'#255#245#0#0#0#0#0#0#0#241#255'1'#0#0#255#134#175#247#0#0#241#255#247
- +#255'-'#0#0#240#255'1'#0#0#0#0#0#170#8#0#209#8#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#245#255#255#175#247'1-1'#247#247#0#0#0#0#0#0#0#8#255#130#7#240#241'11'#0#0#0
- +#0#0#0#0#0#0#0#246#247#0#0#0#134#246#0#0#0#0#0#7#255#0#130#255#8#255'1'#0#0#0
- +#175#8#0#240#7#255#7#247#255#0#0#0#0#0#0#0#0#0#255#7'1'#246#247#247'1'#0#0
- +#247#255#0#0#0#0#0#0#0#0#0#255#134#0'-'#255#240#7#255#0#0#247#255#0#209#8#0#0
- +#241#246'1'#0#0#0#0#0#134#209#8#255'1'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'1U'#7
- +#130#170#134#170#130'1'#0#0#0#0#0#0#0#7#130#134#134#134#247'11-'#0#0#0#0#0#0
- +#0#0#0#255#247#0#0#0#8#209#0#0#0#0#0#7#255#0#247#255#8#8#255#134#0#0#8#255
- +#255#255#255#7#0#8#209#0#0#0#0#0#0#0#0#0#255#247'1'#255#175#246#255#246#0#130
- +#246#0#0#0#0#0#0#0#0#0#175#170#0#8#255#0#0#255'1'#0#255#247#0#7#255#240#0#240
- +#255#175#134#170#212#134#0#130#255#8#8#255#170#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +'11'#245#245#7#134#255#134#0#0#0#0#0#0#0#134#7'1-'#7#130#246#255#255#245#0#0
- +#0#0#0#0#0#0#255#247#0#0#0#134#246#0#0#0#0#0#247#255#0#130#246#0#0#245#255#7
- +#0#8#170#0'-'#255'1'#0#130#255#0#0#0#0#0#0#0#0#0#255#7'1'#255#0#0#240#255#134
- +#7#255#0#0#0#0#0#0#0#0#0#255#247#0#255#7#0#0#175#8'-'#246#240#0#0#255#7#0#241
- +#255#175#170#8#8#170#0#130#209#0#0#245#255#7#0#0#0#0#0#0#0#0#0#0#0#240#241'1'
- +#246#255#246#246#170#7'1'#7'-'#0#0#0#0#0#0#255#246#8#209#134'1'#245#240'-'
- +#240#0#0#0#0#0#0#0#0#255#247#0#0#0#8#209#0#0#0#0#0#7#255#0#134#255#0#0#0#170
- +#171#0#175#8#0#0#7#255#0'1'#246#245#0#0#0#0#0#0#0'1'#255#240'1'#255#0#0#0'U'
- +#255#245#255'1'#0#0#0#0#0#0#0'-'#246#245'1'#255#240#0#0'1'#255#246#175#0#0#0
- +#8#255#0#240#255'1'#0#0#0#0#0#134#246#0#0#0#130#175#0#0#0#0#0#0#0#0#0#0#0#130
- +#255#246#175#7'-'#241#7#134#170#255#8#0#0#0#0'-'#8'-'#170#7#240#134#255#255
- +#255#8'1'#0#0#0#0#0#0#0#0#255#7#0#0#0#134#246#0#0#0#0#0#7#255#0#130#246#0#0#0
- +#8#8#0#8#170#0#0#7#255#0#0#246#246#0#0#0#0#0#0#0#255#175#0#7#255#0#0#0#7#255
- +#0#8#255#0#0#0#0#0#0#0#255#175#0#255#8#0#0#0#0#255#255'1'#0#0#0'-'#255#245#0
- +#255'1'#0#0#0#0#0#134#175#0#0#0#8#8#240'-'#245#0#0#0#0#0#0#0#0#0'1'#245#240
- +'1'#8#246#8'-'#247#8'-'#246#247'1'#134#7#255#8#245#175#130#0'Y'#255#247#246
- +#246#0#0#0#0#0#0#0#0#255#247#0#0#0#170#246#0#0#0#0#0#7#255#0#134#246#0#240#7
- +#255'1'#0#209#8#0#245#255#8#0#0#241#255#246#245#0#0#0'-'#255#255#240#0#7#255
- +#0#0'1'#255#170#0#240#255#255'-'#0#0#0'-'#246#255#240#245#246'1'#0#0#0#0#247
- +#255#0#0#0#0#0#255#134#236#255'1'#0#0#0#0#0#134#246#0#240#7#255#7'-'#247#7#0
- +#0#0#0#0#0#0#0#0#0'1'#255#246#134#241#0#247#175'-'#8#209#7#8#209'1'#134#247
- +#175#240#8#255#241#240#0#0#245#240#0#0#0#0#8#255#255#255#255#255#255'-'#134
- +#246#0#0#0#0#0#247#246#0#134#255#255#255#255#247#0#0#8#255#255#255#8#0#0#0#0
- +#240#175#246#255#255#255#255#8#240#0#0#7#255#255#255#255#8#0#0#0#240#8#255
- +#255#246#255#255#8#240#0#175#246#0#0#0#0#0'-'#247#0#0#0#0#0#7#255'1'#246#255
- +#255#255#255#255#240#130#246#255#255#255'^'#0'-'#7#7#0#0#0#0#0#0#0#0#0#0#0'1'
- +#241#240#247#255#255#240#171#7#8'-'#170#8#7#134'-'#130#246#0#134#255#7#0#0#0
- +#0#0#0#0#0'-11-111'#0#245'-'#0#0#0#0#0#241'1'#0#241'11-'#0#0#0#0#245'1-'#240
- +#0#0#0#0#0#0#0'-'#7#247#7#245#0#0#0#0#240'11-'#240#0#0#0#0#0#0#245#7#130#7
- +#245#0#0#0'1'#245#0#0#0#0#0#0#240#0#0#0#0#0#0'1'#245'-11111'#0#241'11-'#240#0
- +#0#0#245#0#0#0#0#0#0#0#0#0#0#0#0#0#0#7#255#246#240#8#8#240#175'1'#134#7#170#7
- +#8#0#255#175#0#130#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#175#246#0#130#246#0#8#130#7#130#245#246
- +#245#246#240#247#255#246#0'1'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- ,#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#245#255#255#240'Z'#255#241'1'#255'U'#134
- +#247'-'#255#245#175#247#240#7#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#7#240'1'#255#7#240#255#255
- +#245#255#7'1'#255#7'U'#255#240#0#240#255'1'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#7#255#240
- +#255'1U'#246#8#241#255'-'#0#0#245#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#246#134'-'#255'-'
- +#0'1'#255#240'1'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#245#246'1'#240#245#0#0#241#246
- +'1'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#245#0#0#0#0#0#0#247#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#13#244#244#244#13#13#12#245#244#244#244#13#13#13#13
- +#240#0#0#240#244#0#244#244#240#245#12#245#0#245#17#17#21#16#17#17#245#240#0
- +#240#240#244#0#240#13#12#13#245#244#245#17#12#0#240#241#0#240#240#0#0#245#245
- +#12#17#13#244#240#0#240#0#240#17#244#13#13#244#244#13#17#244#245#244#245#244
- +#13#17#12#245#240#245#240#0#240#244#240#0#241#240#240#244#240#13#12'-5'#244
- +#245#244','#244')'#244'5,,(UX,UTLLLytqpq'#148#187#152#187#152#187#149#186#187
- +#0#0#0#12#240#0#0#244#13#244#240#245#240#241#0#0#0#0#240#0#240#0#245#244#0
- +#245#244#0#241#244#0#240#12#17#13#13#240#240#244#0#240#0#240#245#0#0#240#245
- +#240#244#240#244#13#245#240#0#240#245#0#240#0#240#240#12#13#21#244#0#0#240#0
- +#0#240#245#240#0#0#240#245#240#240#0#244#244#240#0#240#13#17#244#244#244#0
- +#240#240#245#244#240#240#240#240#241#244'10'#244'5,'#244'-'#240',,,1,((0U,UT'
- +'(MLxLqp'#152#149#182#153#148#187#148#186#149#148#0#0#0#13#241#0#0#245#12#13
- +#0#244#240#244#0#0#240#0#0#240#0#0#240#240#241#244#245#244#244#240#245#244
- +#245#244#12#13#245#12#13#245#0#0#0#244#0#240#0#0#0#245#240#244#0#240#240#240
- +#0#240#240#240#0#244#13#240#0#245#240#0#0#0#240#0#0#244#0#240#0#240#244#0#0
- +#240#13#25#240#0#240#244#13#245#240#245#240#0#240#12#241#240#240#240#244#240
- +#244#13#13#244'5'#244'('#244'-'#244'),4-,(0UPXQLLLyLL'#149#186#153#152#148
- +#153#148#153#153#152#153#0#0#0#12#244#240#240#244#13#12#240#245#244#0#240#0#0
- +#240#0#0#240#0#244#245#244#240#0#245#0#245#13#240#244#245#12#17#12#13#12#244
- +#240#0#240#244#0#0#0#240#244#17#244#245#240#241#0#0#244#240#0#0#13#13#244#240
- +#0#0#236#0#240#240#0#0#240#17#240#0#0#240#245#0#240#244#17#17#244#241#244#17
- +#12#244#244#244#0#240#240#13#244#240#240#241#240#240#244'0014-'#244',,,,,1,('
- +'(UT,UTLLM|M'#148#148#149#152#149#152#152#153#148#152#149#152#0#0#0#17#245
- +#244#17#17#12#245#240#244#0#245#17#244#0#240#0#240#0#240#240#0#244#13#244#240
- +#244#244#0#244#245#12#13#240#13#12#21#17#12#245#240#240#245#244#13#17#13#240
- +#245#244#0#240#240#240#241#240#0#240#13#244#0#13#17#13#17#17#13#17#12#240#241
- +#13#244#244#0#240#244#240#245#17#16#17#17#240#244#17#17#244#245#244#240#0#241
- +#12#240#240#240#244',1011010,,,-,,Y,((TUPUTMLLyp'#152#153#152#153#152#153#153
- +#148#152#153#152#153#0#0#0#244#240#240#240#245#13#12#240#245#240#240#245#240
- +#0#0#240#0#0#240#245#245#240#244#0#240#241#240#240#240#244#13#12#240#244#13
- +#17#21#13#244#240#244#13#245#244#244#240#240#244#12#244#244#0#0#240#241#0#240
- +#13#17#240#244#12#12#245#12#13#244#13#244#240#240#244#245#0#240#245#240#244
- ,#21#21#16#13#244#13#12#13#244#244#245#240#240#240#13#244#244'110Y1X4U0U1,,,,'
- +'PY,P(UTPYPLLux'#153#148#153#148#152#153#148#152#153#149#186#149#152#0#0#0
- +#245#240#0#240#244#12#245#240#244#240#240#244#240#0#240#0#240#0#0#240#244#245
- +#244#241#244#244#240#245#240#245#12#13#245#244#12#13#17#245#12#245#240#240
- +#244#17#240#0#13#13#13#17#13#240#0#240#240#0#240#0#245#21#17#13#17#13#12#13
- +#17#13#0#240#0#245#12#245#240#244#16'5'#17#17#17#244#244#17#13#17#244#245#244
- +#240#240#240#12'-0X4Y4YYYYXTUTUP,,Y,)PTYP|ULLPy'#152#153#148#153#149#152#187
- +#152#152#153#152#153#152#0#0#0#244#240#240#0#13#17#244#241#244#241#244#245#0
- +#240#0#0#240#0#240#0#240#240#244#240#0#245#244#0#244#244#245#12#13#244#13#13
- +#12#240#245#240#240#244#245#244#13#12#244#240#0#245#240#240#0#240#244#0#240#0
- +#240#244#244#244#244#244#245#244#244#244#0#0#0#240#244#17#12#13#21#21#17#17
- +#17#245#240#12#12'1'#244#244#245#240#240#244'1055YYYXY'#3#3'YYXU'#3'UTUYPPPU'
- +'UPYtLqt'#156#149#152#153#152#152#153#148#153#152#148#153#152#153#0#0#0#244
- +#245#244#244#244#13#12#244#240#244#0#244#0#0#0#240#0#240#0#0#240#241#244#240
- +#244#244#0#244#240#13#244#13#12#17#21#12#244#245#12#12#13#244#0#0#13#12#245#0
- +#240#240#240#0#0#241#0#0#240#0#244#0#13#17#13#13#16#17#17#17#240#245#244#240
- +#0#241#244#13#240#245#12'9'#12#244#240#245#17#17#244#245#244#240#240'-05TYXY'
- +'XY'#3'YY}'#3'YTUTYY'#3'QPPU|P}xMLt'#153#152#187#152#148#153#186#153#152#153
- +#187#152#153#148#0#0#0#12#244#244#17#17#12#245#240#245#240#244#241#244#245
- +#240#0#240#0#240#241#244#240#245#0#241#244#241#240#241#244#244#13#12#17#17#0
- +#245#244#13#245#244#13#244#240#13#13#244#240#245#244#245#244#244#244#245#240
- +#240#0#245'4'#13#12#13#12#13#244#13#12#240#240#13#0#244#244#12#17#244#12#13
- +#16#245#240#244#13'0'#17#244'0'#245#240',14U5XY'#3']'#3'Y}'#3#3'Y|YT}TT]T'#3
- +'U|UP}Tppu'#152#153#152#152#153#152#153#152#153#148#152#152#153#152#0#0#0#245
- +#12'5'#21#17#244#244#240#244#241#240#244#244#13#240#240#240#241#244#13#244
- +#240#244#244#240#244#240#244#240#13#244#13#13#12#17#240#240#244#240#240#17
- +#244#245#244#12#244#245#0#240#244#244#241#0#240#244#240#240'1'#17#17#12#13#12
- +#13#17#12#17#13#0#240#244#244#13'95'#17'999'#17#12#13#240#12#21'9'#245#12#245
- +#244'001XYY'#3'YYY\Y}Y|Y|}TyxY}'#3'}'#3'}T}yPqt'#153#152#153#153#152#153#152
- +#153#186#153#153#186#149#152#0#0#0'0-'#12#245#12#245#17#13#240#244#240#245#0
- +#0#13#240#240#240#240#0#244#13#244#241#240#244#245#240#240#12#245#16#17'9'#21
- +#245#13#244#245#240#17#13#240#13#17#17#12#240#245#13#240#240#240#245#240#0
- +#245#17#16#13#13#12#13#13#244#13#12#245#240#244#241#240#244#17#12'5'#17#13
- +#244#13#244#17#12'995'#12'1'#244',15T5XYY'#3#128'}Y'#128'Y'#128'}|Y|}|}'#160
- +'xyx}xy|xttt'#187#152#152#152#153#186#152#152#153#152#152#153#152#153#0#0#0
- +#13#12#13#12#13#244#13#12#244#244#241#244#0#240#17#240#0#0#0#0#13#13#244#240
- +#240#245#244#240#244#245#244#17#16#13#17#244#240#240#244#0#245#21#244#244#13
- +#244#13#240#240#244#244#0#240#240#240#240#240#244#245#13#12#13#12#12#13#12#13
- +#12#244#13#12#0#240#13#244#13#12#244#240#244#240#13'599'#17','#13#244',1TYXY'
- +'Y'#3'Y]Y'#128'}'#128'}|}'#164#165#165#160#161#160#161#160#161#160#157'xyytu'
- +#153#152#153#152#153#152#153#153#153#152#152#187#148#153#152#0#0#0'01'#12#17
- +#244#244#241#240#245#240#244#244#240#0#244#240#0#240#240#0#240#240#244#245
- +#244#244#241#244#245#12#13#17#17#244#244#240#244#13#13#244#240#12#13#21'5'#12
- +#13#244#241#244#245#240#240#245#240#0#240#245#244#12#17#13#17#13'0'#17#17#13
- +#240#245#244#245#12#17#13#244#13#245#244'51'#12#240#16'55'#12'01014YY'#3'Y'
- +#129'Y||]}'#128'}'#165#164#165#198#164#198#165#164#165#160#160#161#160#161
- +#156#156'ytt'#153#152#153#152#153#152#152#186#153#153#152#153#152#148#0#0#0
- +'1459'#13#12#244#244#244#245#240#245#0#240#245#240#240#0#240#0#0#240#244#240
- +#240#244#244#240#244#13#16'9'#17#244#245#240#13#244#240#13'5'#244#12#13#244
- +#245#244#244#12#17#12#0#240#240#245#240#240#244#17#21#244#244#244#245#245#244
- +#12#245#240#244'50'#245#244#244#12#240'0=9'#17'5'#12'545'#13'001T1TXY'#3#3
- +#129'Y'#129'|}'#165#164#198#165#198#165#164#165#198#165#160#199#160#161#160
- +#161#161#156#156#157#156#152'u'#152#149#152#153#153#152#152#153#152#148#153
- +#153#0#0#0'05'#12#245#244#245#245#244#17#244#244#244#240#0#244#244#13#240#0
- +#240#240#240#245#244#245#245#244#245#244#13#17'9'#17'9'#244#240#244#245#0#244
- +#244#245#13'9'#17#12#13#13'9'#21#13#236#240#244#240#0#244#13#13#244'559'#12
- +#244#245#240#240#0#245#244#245#244#240#245'59'#17'5'#12',11'#17'5501101TYU'#3
- +'Y}'#3'}|'#129#164#164#199#164#199#164#198#199#199#164#164#199#164#161#164
- +#160#160#160#157#160#157#156#157#152#153't'#153#148#152#153#152#148#153#153
- +#152#148#0#0#0'15'#13#244#13#12#244#244#245#244#244#245#0#240#245#245#13#236
- +#240#240#0#240#244#244#240#12#244#244#244#13#244'1'#12'5'#13#240#13#244#236
- +#12#245#244#240#240#240#245#12#240#245#244#13#0#244#245#240#240#241#244#244
- +#12#17#12#13#244#245#12#13'1'#240#240#240#12#13'5'#12'995'#12'5'#13#244#244
- +'1450100UXUXY}'#3#129'|'#129#164#165#203#164#199#168#198#169#164#164#164#199
- ,#164#199#164#160#195#161#161#160#157#156#157#156#157#152#152#149#152#153#148
- +#153#152#153#152#148#153#0#0#0'05'#12'0'#17'4'#13#244#0#244#245#244#240#240
- +#244#240#244#0#0#240#240#240#245#244#245#244#13'5'#245#244#240#13#13#244#244
- +#244#244#245#244#245#244#12#245#12#0#240#13#0#240#240#244#240#240#244#241#240
- +#244#244#17'9955'#244#240#13'00'#240#244#244'-,01001010101,5010UTUXY'#3'}'#3
- +'}}'#164#199#164#198#203#164#202#165#198#203#198#199#164#198#164#199#165#160
- +#160#160#161#160#157#160#157#156#156'u'#152'q'#148#153#148#153#148#152#153
- +#148#0#0#0'5559999'#245#240#245#244#245#0#240#245#244#245#244#240#236#13'0'
- +#13#244#244'1'#244#244#12#13#244'0'#244'-,1,,-'#244#245#244'15'#240#240#12
- +#240#245#244#245#240#245#244#240#240#240#244'1'#244#245#240#245#244#244'9'#13
- +#245',,101001010101055410101TUTY'#3'}|'#165#165#164#203#164#202#199#202#164
- +#203#164#169#198#169#199#164#198#164#199#161#160#161#160#160#157#156#157#156
- +#153#152#153't'#148'u'#148#153#149#148#153#0#0#0'50'#13','#17'5'#240#240#240
- +#244#244#244#240#240#244#244#244'5'#245#240#12#13#240#244#245'9'#13#240'1001'
- +'100010,0,,'#13#244'0'#13#13#240#240#244#244#240#240#244#241#240#245'5'#13#12
- +#244#244#244'1'#240#241',,01010U1T1T10101451050UTUXY|}|}'#164#164#199#198#168
- +#199#168#199#202#203#198#202#199#198#164#199#164#199#164#164#194#161#160#157
- +#160#157#156#157#156#152'u'#148#153'q'#148'p'#148#153#148#0#0#0'010'#13'54'
- +#244#241#240#13#244'-'#240#240#13#244#245'0'#240#240#245#245'45'#12',,'#240
- +'1010401101010-,,1'#13#12#240#245#244'1'#240#244#245#240#240#244'50'#13'5450'
- +#244',0-10U0Y0T5T501T105Y\5]Y0TU'#3'y'#3'Y|'#165#164#199#202#169#198#203#198
- +#202#203#164#202#165#198#168#199#202#165#198#164#195#165#160#161#160#157#160
- +#157#156#157#157't'#152'qp'#152'q'#153#148#149#0#0#0'101015'#244#240#240#12
- +#245#12#240#240'1'#244#244#13#240#240'0'#244'5'#244'-'#244#245'005XYU5T01010'
- +'100-,,1'#240#244#245#12#240#245','#244#240#245#12#13'095950-,00U0YTYYXYTYT5'
- +'TY055'#3']\YUTUXy|}'#198#164#203#164#199#202#164#202#165#202#202#199#202#202
- +#199#164#198#165#198#165#164#160#165#160#161#160#157#156#157#156#156#153'qt'
- +#152'qppqp'#0#0#0'X1X105'#244#240#240'1'#12#245#240#240#12#245#244'1'#244#240
- +'101,'#244',,YXYY'#3'XYYYXU41T10010-'#240','#12'1'#240#244#245#244#244#244'1'
- +'10'#244'-,1,010UTY'#3'Y'#3'Y'#3'YYXUTUTUX]]]Y\YTU|Y|'#165#165#198#164#202
- +#164#203#203#202#202#165#202#168#199#168#202#199#168#198#165#198#165#194#160
- +#161#160#157#160#157#156#157#156#152'upqtqppq'#0#0#0'Y501T1,'#244#245'0'#244
- +'1'#240#244'-'#244',1'#240#244'105,,-XYY|YYY'#3#3'YYXUX10U10,0,'#244'-1'#240
- +#244','#241#244',001,01,01TUXU'#3'YY'#3'YY|'#3'YYXYTY'#3']a\]'#133'YT'#3'Ux}'
- +#160#198#165#198#199#202#198#168#202#203#202#202#199#202#203#198#168#199#164
- +#198#165#198#165#160#160#161#160#161#156'}'#156#157'xtutqtqpp'#0#0#0'YXY010,'
- +'54550'#240#244'5014'#244',51Y01T]]\]\]\YYY'#3'YYTUT1T01U,100,,1,,-19a]]40UT'
- +'UTYY'#3'Y|'#129'Y|]YY'#3'}TUTU]\]Y\YTUy|}'#164#165#198#169#202#169#202#203
- +#203#164#203#203#168#203#198#169#198#199#202#199#164#199#160#199#161#160#161
- +'x'#157#156#157'x'#157'tuppqppq'#0#0#0#3'YYXT10Y5050'#240'1541Y,,]4]00Y'#128
- +#129#129#129#129#129#129#128']|YY'#3'YYTU0U00Q055,100100]]05TUTU'#3'Y}'#3#129
- +'Y'#128'Y'#128'Y}'#3'|Y'#3'YX}T]]]'#3'YTUx'#3'}'#160#165#198#203#198#198#202
- +#165#202#202#203#202#202#203#164#202#199#202#164#199#164#198#165#164#160#160
- +#161#160#161'|'#157'x'#157'xutpuLqLp'#0#0#0']'#3'YU4U014]51(,0104-,Y5\]]'#129
- +#129#128#129#128#129#128#129#129#128']|'#3'Y'#3#3'YXUTU00U45,15,01X5Y1TUTUTY'
- +'|'#3'}|}'#129'|'#129'|'#129'}'#3'}Y|UXU|YYU'#3'QTUxy|'#165#164#164#203#164
- +#203#202#169#202#202#169#198#202#203#168#202#203#202#164#199#164#198#199#164
- +#165#160#161#156#161'x'#161'x'#157'xQtLupqL'#0#0#0#128'Y'#3'YUX1T1a41,1Y0U5,'
- +'TYTYa'#133#128#129#133#128#133#164#129#129#128#129#129#129#129#3'}YXU'#3'UX'
- +'UT,1Y,T1,105YXXUTUXY|}}|'#129#128#129#129#128#129'|'#129'}|}Y'#3'}|U'#3'Y'#3
- +#129#3'}XU|'#161#164#199#198#164#199#202#199#202#203#202#203#202#203#202#203
- +#198#164#199#202#164#199#164#164#161#160#161#160#161'x'#161'x'#157'xxtMtLPLL'
- +#0#0#0#129'YY'#3'TUT10,10,0011X,U\U]'#133#128#129#133#168#133#169#133#133#132
- +#129#129#128#129'|'#129'}'#3'}XUTUTUTY'#3',50,TYY\]'#133#129'TY|}}'#129#128
- +#129#128#165#165#164#165#165#164#165'|}||}|U|Y|Y}Y'#128#129'xy|'#161#198#164
- +#203#202#202#169#202#164#203#202#203#168#203#198#169#202#203#164#199#198#165
- +#199#164#161#160#161'|'#161'x'#157'xyyyTPMLML'#0#0#0#128'}'#3'YYTUT1XY1,1Y0T'
- +'YTU]'#3']'#133#133#128#168#169#169#168#168#164#165#164#164#165#160#165#161
- +'|}|}|UTUTTYY,UY,UX'#129']'#3'U'#3'}|}|'#129'|'#165#164#165#164#164#165#198
- +#164#165#164#165#164#161'}|}|y'#3'YTTT}|U|}'#164#199#202#164#168#199#202#202
- +#203#198#169#202#203#202#202#203#198#164#202#199#164#164#198#161#164#161#160
- +#161'x'#161'xyxx|YPPPLL'#0#0#0#129#128'}'#3'Y'#3'UTY]XY,TYYTYTTa}'#128#129
- +#129#169#169#168#169#169#165#164#165#165#165#164#165#164#164#161#160'}|}|UTU'
- +'U\YPXYQXY'#3']]TY|}|}|'#165#168#165#198#203#202#168#165#198#165#198#165#164
- ,#160#165#160'}|}|'#129'yxU'#3'}xy'#160#165#164#199#198#199#202#165#202#202
- +#203#202#202#198#169#198#164#203#199#164#164#199#164#165#164#161#160#161'|'
- +#161'x'#161'xyy'#3'UPYTYT'#0#0#0#128'}|}|UXUTYYTPUXYY'#3'yTy'#3#133#133#168
- +#169#168#165#164#198#164#169#198#202#164#169#198#165#165#164#165#160#161#160
- +'}|yTTYYPYXPYTY'#133#128#129#128'}|}'#164#165#202#199#202#169#198#169#199#198
- +#169#198#164#164#199#164#160#161#160#161'|}|TUx}}xy|'#161#198#164#165#198#164
- +#202#199#168#198#169#202#169#202#203#202#202#164#203#202#164#199#164#165#160
- +#165#160#161'|'#161'|y|xYTQX-T-'#0#0#0#165#161'|}|}xU'#3'YXYY'#3'U'#3#3'Y'#3
- +'UT}'#128#129#129#168#199#168#202#169#203#202#165#168#165#198#165#198#164#164
- +#165#164#161'|}|'#157'|U'#3'}TY'#3'U|Y'#3#133#133#129#133'|}'#164#165#202#202
- +#164#202#198#203#198#202#168#198#168#165#199#164#165#165#160#161'|'#161#160
- +'}}xy||y|}'#160#198#165#198#199#164#199#164#199#203#202#203#202#203#202#169
- +#198#203#168#199#165#198#165#198#164#161#160'}'#160'}xyxy'#3'UTYT(('#0#0#0
- +#164#164#161'|}|}xY'#3'Y'#3#133'Y'#3'Y}|Yxy|'#129#132#165#202#168#202#203#202
- +#168#203#202#203#202#203#168#198#169#199#164#165#164#161#160'}|'#161'x}\U'#3
- +'}TY'#3'}'#129#128'y'#128#129#160#199#202#203#202#203#168#203#202#169#202#199
- +#168#199#202#164#199#164#164#165#160#161#160'}'#160'|}|'#129'}xy|'#161#164
- +#165#164#164#199#164#198#168#202#203#202#203#168#203#202#169#202#199#164#202
- +#164#199#164#165#164#161#160#161#160'}|yxYT0U0,('#0#0#0#199#164#165#160'}x}x'
- +'}}'#3'YY|Y'#3'Y'#129'|}x}'#128#169#202#203#202#169#202#203#202#203#168#203
- +#202#168#199#168#198#164#199#164#161#164#161#160'}|'#161'|}X'#129'YX}|'#129
- +#132#129'x'#129#169#202#202#202#202#169#202#203#168#203#202#203#202#203#164
- +#199#168#165#198#199#164#161#164#161#160#161#161#160'}|'#129'xy|'#161#164#161
- +#164#161#164#165#202#203#202#169#202#202#203#202#203#202#169#202#203#198#169
- +#198#164#199#164#165#160'}|'#161'|}'#3'YYT1P-,'#0#0#0#164#165#164#161#160'}|'
- +'}'#160'x}'#3'TY|}|'#129#129'|}|'#165#202#203#202#203#203#202#169#203#202#203
- +#202#203#202#202#203#165#202#164#165#198#165#160#161#160#161'|'#161'xy'#3'}x'
- +'}|'#129#129#133'|'#161#198#203#168#203#202#203#202#202#203#202#202#169#202
- +#164#203#202#198#198#165#164#165#164#161#160#161#160#160#161#160#129'|y|y|'
- +#161#164#161#164#165#202#169#202#203#202#203#203#202#169#202#203#202#202#164
- +#203#164#198#165#164#164#165#160#165#160'}|}T]\]Y0,,'#0#0#0#199#164#199#164
- +#161'|}'#160'y}|}'#129#129'|'#129'|y'#128'}|'#165#202#203#168#203#202#206#203
- +#202#202#203#202#203#168#203#203#164#202#198#165#198#165#164#161#160#161'|'
- +#161#160#161'|}'#128'U'#128'}'#128#133#168#165#164#202#202#203#202#169#202
- +#203#202#203#202#169#202#202#203#202#164#203#165#164#199#164#164#161#160#161
- +#160#161#161#160#165'|}|}'#160#161#160#165#160#199#202#203#202#203#202#203
- +#202#203#202#202#203#202#169#203#198#168#199#168#199#165#164#165#160'}'#128
- +#161'}|]YY0101'#0#0#0#164#165#164#165#160#161#160'}'#160#156#161'|'#133'|}}|'
- +'y'#128#129#169#202#203#202#207#202#203#203#206#203#203#168#203#202#203#168
- +#202#203#202#165#198#164#199#164#161#160#160#161#160#161#160#161'|}x}|'#129
- +#169#133#165#202#203#202#203#202#203#202#203#169#202#203#202#203#203#168#199
- +#202#164#202#198#165#198#165#164#161#160#161#160#160#161#160#161#128#129#164
- +#165'|'#161#160#165#202#202#203#202#203#202#203#168#202#203#203#168#203#202
- +#168#203#169#198#165#168#198#165#164#165#160'}||}|Y0Y0]9'#0#0#0#198#165#198
- +#160#165#160#161'|}}'#160#161'|}|'#128#129#160'}'#160#169#202#203#202#203#203
- +#202#203#202#203#202#207#202#203#202#203#202#168#199#202#169#198#164#165#164
- +#165#160#161#160#161#160#160#161'|}|}'#128#169#164#165#202#168#203#202#203
- +#202#203#202#202#203#202#203#202#202#203#202#203#198#169#198#164#199#164#165
- +#164#161#160#161#160#161#160#160#165'|}|'#165#160#165#164#203#202#203#202#203
- +#168#203#203#203#202#203#202#203#203#202#198#202#169#198#165#164#165#164#165
- +#128#161#129'|}}XUX100'#0#0#0#168#198#165#164#165#160#160#161#160#160#161#160
- +#161'|'#129'}'#128#129#128#165#164#203#202#203#202#203#207#202#207#203#206
- +#203#203#202#203#202#203#202#203#164#198#165#198#164#199#160#161#160#161#160
- +#161#160#160#161'x'#129'}'#168#133#165#198#202#203#202#169#202#203#202#203
- +#203#202#203#202#203#202#169#202#168#203#198#164#199#165#164#198#161#160#161
- +#164#161#160#161#160#165#128#165#164#165#164#161#202#202#169#202#203#202#203
- +#202#203#202#203#202#203#202#168#203#168#203#198#203#168#199#164#165#164#165
- +#128#128'}'#128#128#129'\'#129#3'Y5'#0#0#0#198#165#198#165#160#161#161#160
- +#161#161#160#161#160#165#129#164#129#164#165#164#203#202#203#202#203#206#202
- +#203#203#202#203#203#202#203#168#203#168#199#168#198#169#198#165#199#164#161
- +#164#161#160#161#160#161#161#161'x'#165#128#169#165#164#198#203#202#203#202
- +#207#203#202#207#202#203#202#169#202#203#202#203#198#203#164#203#198#164#198
- +#165#160#165#160#161#160#165#160#195#160#129#160'}'#164#165#164#198#203#202
- +#203#203#202#203#207#202#203#168#203#168#203#203#202#203#198#169#168#198#165
- ,#164#164#165#128'}'#165#133#133#129#129']]]Y'#3#0#0#0#203#164#199#164#165#160
- +#160#161#160#160#161#160#161#160'|'#129#164#165#169#168#203#202#203#202#207
- +#203#203#207#202#207#203#206#203#202#203#202#203#202#198#203#198#164#198#164
- +#165#164#161#164#161#160#161#160#160#160'}'#128#161#168#165#164#169#202#203
- +#202#203#203#206#203#203#202#207#202#203#203#202#203#168#203#164#202#199#164
- +#199#165#160#165#160#165#160#161#160#165#160#161#160#129#164#165#164#199#202
- +#203#202#203#206#203#203#202#203#203#203#202#203#202#202#169#202#169#202#198
- +#169#168#165#165#164#129#132#133#132#133#132#133#128']\]Y'#0#0#0#198#165#198
- +#165#198#165#164#161#161#160#160#199#160#161#161#164#129#164#160#165#202#207
- +#202#207#202#207#202#203#207#202#203#203#202#203#202#203#202#169#202#168#199
- +#202#165#198#198#160#161#160#161#164#161#165#161#160#160#165#128#165#164#161
- +#202#202#203#203#202#202#203#206#203#203#202#203#202#203#202#203#202#202#203
- +#198#168#198#164#198#165#164#199#160#165#160#161#160#165#160#165#160#165#164
- +#161#164#169#202#203#202#203#202#207#203#202#206#203#203#202#203#203#202#203
- +#202#169#202#165#164#168#169#128#169#173#168#133#133#133#133#133#129']\]'#0#0
- +#0#169#198#164#198#165#160#161#160#160#161#160#161#160#160#160#165#164#165
- +#161#168#203#202#203#202#203#202#203#206#203#203#206#202#207#203#202#203#202
- +#202#203#199#168#199#198#165#164#199#164#164#160#161#194#160#160#199#160#165
- +#160#169#164#165#198#203#202#202#203#207#202#203#202#207#203#202#203#202#169
- +#202#203#202#198#169#198#165#198#165#198#160#164#161#160#195#164#160#199#160
- +#161#164#129#164#165#198#202#203#202#203#202#203#202#203#207#203#203#202#203
- +#168#203#202#203#168#202#203#168#203#165#164#169#172#133#133#169#132#133#132
- +#129'`'#129']]'#0#0#0#198#164#199#165#198#160#165#160#161#160#161#160#165#194
- +#165#169#164#165#168#198#203#206#203#207#203#207#207#203#203#206#203#203#203
- +#202#203#202#169#203#198#168#198#198#165#164#199#164#161#195#161#164#160#161
- +#195#160#161#164#129#168#169#194#202#203#202#203#203#202#203#203#206#203#202
- +#203#202#203#202#203#168#199#169#198#203#198#165#198#164#199#161#164#161#164
- +#160#165#160#194#165#164#165#164#195#164#203#202#207#203#207#202#207#203#202
- +#203#202#203#202#203#202#169#203#202#169#165#168#165#168#169#173#169#133#168
- +#133#133#133#133#133'a]\]'#0#0#0#202#199#164#198#164#199#160#165#160#161#164
- +#194#161#161#164#169#169#164#165#164#203#202#203#202#206#203#202#207#202#203
- +#207#202#202#169#202#203#202#202#202#199#202#165#198#198#164#195#164#164#160
- +#160#199#160#164#161#164#161#164#169#165#165#202#203#202#207#202#203#206#203
- +#203#203#202#203#202#203#202#203#202#202#202#202#165#202#164#199#165#160#198
- +#161#164#161#164#195#160#165#164#161#160#165#164#198#203#202#203#202#203#203
- +#202#203#207#202#203#207#169#202#203#203#168#203#168#202#169#168#169#168#169
- +#136#169#137#133#133#133#132#133'\'#133']]'#0#0#0#165#202#199#164#199#164#161
- +#164#195#164#161#164#194#164#161#160#173#164#165#203#202#207#203#203#203#206
- +#203#207#207#202#203#207#203#202#203#202#203#168#203#164#203#198#165#198#165
- +#164#195#165#194#165#160#199#160#194#165#164#161#168#164#194#168#203#202#203
- +#202#207#203#202#207#202#207#203#203#168#203#202#203#202#165#202#198#165#198
- +#164#198#165#160#198#161#198#161#164#195#160#165'|'#161#160#165#164#202#203
- +#202#203#206#203#207#202#203#203#202#203#203#203#168#202#203#168#203#168#203
- +#168#169#173#169#173#169#173#133#136#133#133'a'#133'a\]'#0#0#0#202#198#164
- +#199#164#199#164#194#164#165#194#165#161#198#160#165#168#169#164#164#203#202
- +#202#207#202#203#207#202#203#203#206#202#203#203#202#203#202#199#202#202#198
- +#165#198#165#198#165#160#164#165#161#198#160#165#199#160#161#164#169#199#165
- +#198#202#203#202#203#203#202#203#202#203#202#203#202#203#202#203#168#199#202
- +#199#168#198#165#198#165#198#165#164#160#165#198#161#164#198#160#161#160#165
- +#164#199#202#203#203#202#203#203#202#203#207#202#207#202#202#203#203#203#168
- +#203#168#203#169#168#173#173#169#173#133#137#169#133#133#133#133#132'a]]'#0#0
- +#0#199#164#199#164#164#199#160#165#161#194#165#160#198#164#199#164#165#165
- +#164#199#202#203#207#203#203#207#202#203#207#202#203#203#203#202#203#202#169
- +#202#169#198#165#202#164#198#165#198#164#199#160#198#160#165#198#160#164#165
- +#164#169#164#164#198#203#202#203#206#202#207#202#207#202#203#202#203#202#203
- +#202#203#202#165#202#198#165#198#199#164#199#164#195#164#199#160#164#198#165
- +#161#160#165#160#199#164#203#203#206#203#203#202#207#203#202#203#203#203#203
- +#203#202#168#203#168#203#169#202#169#173#169#173#173#133#173#133#133#137#132
- +#133'a'#129'`]'#0#0#0#202#199#168#199#198#164#199#160#198#164#161#199#164#195
- +#164#165#164#164#165#198#202#203#202#207#202#207#203#207#202#207#202#203#202
- +#203#202#203#202#198#202#199#202#198#165#199#198#164#199#160#199#160#165#194
- +#165#194#161#164#165#173#165#198#165#202#203#202#203#203#202#203#203#202#203
- +#202#202#203#202#169#198#202#202#165#198#198#165#164#198#165#164#198#161#164
- +#164#199#161#198#160'}'#160#165#164#198#202#203#203#203#206#203#202#203#207
- ,#202#169#202#203#168#203#203#168#203#168#169#168#169#173#173#137#169#173#133
- +#137#133#133#133#132'aa]]'#0#0#0#168#198#199#164#199#164#198#165#161#198#164
- +#194#165#164#198#169#169#165#164#165#203#202#203#202#203#202#203#202#203#203
- +#203#168#203#202#169#202#203#169#198#168#199#164#198#164#199#164#198#165#164
- +#199#164#199#164#199#160#165#164#168#169#164#198#203#202#203#202#203#202#202
- +#203#202#203#203#203#168#203#202#203#164#203#202#165#202#198#165#198#198#165
- +#165#198#165#198#164#199#164#165#160#161#160#165#165#168#202#202#203#203#203
- +#207#202#203#203#206#203#202#203#168#203#203#168#203#169#168#173#169#173#169
- +#137#169#137#133#137#133'a'#133#133'`]]'#0#0#0#199#198#168#199#164#199#164
- +#198#198#165#198#165#198#195#164#169#164#164#169#198#168#203#207#202#207#203
- +#206#203#207#202#203#202#203#202#203#202#202#198#203#198#198#203#165#198#164
- +#199#165#198#198#164#199#164#194#164#165#164#165#169#203#164#165#202#203#202
- +#203#202#203#203#202#169#202#202#202#203#202#203#202#203#198#164#202#165#198
- +#198#165#164#198#198#165#198#199#164#198#165#160#161#164#165#164#198#199#203
- +#203#202#202#203#202#203#202#203#203#203#203#202#203#169#202#169#168#169#169
- +#169#173#173#173#173#137#169#137#132#133#133#133'a]]]'#0#0#0#198#168#199#198
- +#199#164#199#164#165#164#199#164#199#164#165#203#164#165#165#164#203#203#202
- +#203#203#202#203#203#202#203#202#203#202#203#202#203#164#203#198#164#203#164
- +#198#164#199#164#198#164#165#199#198#164#199#165#160#165#164#203#173#165#198
- +#203#202#202#203#202#203#202#202#203#202#203#203#202#203#168#198#202#165#203
- +#198#199#198#169#198#199#198#165#164#199#164#165#165#164#165#198#165#164#165
- +#165#202#203#202#203#203#203#203#203#203#203#202#203#168#203#169#202#169#168
- +#203#169#168#173#173#169#137#133#133#137#133#133#133'aa\a\9'#0#0#0#202#199
- +#164#202#165#198#164#199#198#198#165#198#164#199#164#169#165#198#169#164#199
- +#202#203#203#202#203#203#202#203#203#203#168#203#202#169#202#203#164#203#198
- +#164#199#198#165#198#199#164#199#198#198#164#199#164#198#164#165#164#164#168
- +#199#164#164#203#203#202#203#202#203#203#202#203#202#202#169#202#198#169#199
- +#202#198#165#202#164#199#164#198#165#198#199#164#199#202#202#199#202#169#202
- +#199#164#202#165#202#165#203#202#203#202#203#202#203#169#202#203#203#202#169
- +#203#169#168#169#169#169#132#133#133#133#133']'#133#133#133#132#133'a]]]'#0#0
- +#0#165#202#199#198#199#164#203#164#199#164#198#165#198#168#203#168#199#168
- +#199#202#165#202#203#202#203#202#203#203#202#203#202#203#202#199#202#199#202
- +#198#168#203#198#168#199#198#164#199#198#164#199#164#199#164#199#164#203#202
- +#199#203#198#168#199#202#164#202#203#202#168#202#203#202#169#202#203#198#203
- +#202#198#202#165#202#203#198#203#198#199#164#199#168#203#202#203#169#202#169
- +#203#198#169#203#203#165#202#165#202#165#203#198#169#202#165#202#203#169#203
- +#168#203#168#169#169#173#169#137#169#133#137#133#133#132'a`]]aa`]9]'#0#0#0
- +#202#199#168#199#168#199#198#199#164#203#169#202#203#203#202#203#202#203#202
- +#169#198#199#168#199#202#169#202#198#203#198#203#202#202#203#168#202#165#202
- +#199#198#165#198#198#165#198#198#164#199#198#169#202#202#202#203#202#164#202
- +#168#199#202#198#165#202#199#164#202#199#199#198#198#198#203#198#202#202#165
- +#202#165#202#198#164#199#164#199#164#203#202#203#202#203#168#203#203#203#202
- +#169#203#198#169#202#165#203#164#165#164#169#198#165#168#165#164#169#168#165
- +#169#169#169#173#169#137#173#133#173#133#133#133#133#133']]\]]]]\9'#0#0#0#198
- +#169#198#199#198#164#199#164#203#203#202#203#203#202#203#203#203#169#203#199
- +#168#203#164#199#164#199#198#165#164#199#164#198#199#164#198#199#198#199#198
- +#165#198#198#165#198#199#164#199#198#168#202#203#202#203#168#203#203#202#199
- +#202#202#165#202#199#164#198#165#198#164#198#165#199#164#198#165#199#198#203
- +#198#198#169#199#202#199#164#199#202#203#203#169#203#203#203#203#203#169#203
- +#203#169#203#165#203#164#199#169#203#164#165#168#165#164#169#164#165#132#169
- +#169#173#173#173#169#169#137#133#133#133#132#133'a\]]9Y\]9Y'#0#0#0#203#198
- +#203#164#203#199#202#207#203#203#203#207#203#203#203#169#202#203#168#203#198
- +#169#199#202#165#198#165#198#199#164#198#161#198#198#165#198#164#199#164#198
- +#164#199#198#164#198#198#169#202#203#203#202#169#202#203#202#202#169#202#169
- +#198#203#164#202#165#203#164#199#198#165#198#164#198#165#198#164#198#164#199
- +#165#198#198#165#198#203#206#203#203#207#203#203#203#203#169#203#203#169#203
- +#203#169#203#169#203#169#164#165#165#169#165#169#165#129#169#129#169#173#173
- +#173#169#137#173#137#169#137#133#133#133'aaa]]\95Y85'#0#0#0#198#169#198#203
- +#164#203#203#203#207#207#203#203#203#169#203#203#203#203#203#169#203#199#168
- +#199#169#198#165#164#199#164#165#164#161#161#198#161#198#164#199#164#199#164
- +#199#198#165#202#202#203#202#203#202#203#202#203#203#202#203#202#203#202#168
- +#199#202#198#164#199#164#165#198#165#198#161#198#161#198#161#198#164#198#165
- +#198#199#168#203#203#207#203#203#207#203#207#203#203#203#203#203#169#203#203
- +#165#203#165#203#165#169#168#165#168#169#168#169#164#129#169#173#173#173#173
- ,#169#137#169#137#133#137#133#133#133#132']\9]'#3'9555'#0#0#0#164#199#164#199
- +#203#207#203#207#203#203#207#207#203#203#207#203#203#169#203#203#203#168#199
- +#169#198#165#198#165#164#199#198#161#164#160#161#164#161#198#160#199#164#198
- +#164#165#202#203#203#202#207#202#203#202#203#202#169#202#203#202#168#203#198
- +#202#165#165#202#164#199#198#164#198#165#164#165#164#161#164#165#194#165#198
- +#165#164#203#203#207#203#207#203#203#207#203#203#207#203#203#169#203#169#203
- +#169#203#169#165#169#165#165#169#165#165#169#169#129#133#173#173#173#173#169
- +#137#173#137#133#137#133#133#133'aaa]]995450'#0#0#0#199#198#199#203#207#203
- +#207#207#203#207#207#203#203#207#203#203#207#203#203#203#169#199#203#164#199
- +#164#165#198#165#198#165#164#160#161#164#160#165#160#165#164#195#164#199#202
- +#203#206#202#203#202#203#202#203#202#203#202#203#168#203#202#203#202#169#198
- +#202#198#165#198#164#165#199#164#199#160#161#164#161#160#165#164#165#198#203
- +#207#203#207#203#203#207#207#204#203#207#204#169#207#203#203#203#169#203#169
- +#165#169#169#165#169#165#165#169#165#169#169#173#173#173#133#173#173#137#173
- +#133#137#133#133#133'a'#132'a]\9\54555'#0#0#0#164#199#169#203#207#207#203#207
- +#204#207#203#207#207#203#207#169#203#203#169#203#203#169#203#165#165#198#165
- +#165#160#165#160#199#160#161#160#161#160#165#160#161#164#161#164#203#202#203
- +#207#202#203#206#203#207#202#203#203#202#203#202#203#164#203#198#168#199#165
- +#198#164#165#198#164#194#165#198#160#161#164#165#160#165#164#165#207#203#207
- +#203#207#208#203#203#207#208#203#207#203#203#170#203#170#203#170#169#169#165
- +#165#165#129#165#169#133#169#169#133#173#169#173#173#137#169#173#133#137#133
- +#133#133#133#133'aa]]595554'#13#0#0#0#165#165#203#207#203#207#207#207#207#203
- +#208#203#207#208#203#208#203#203#203#169#203#203#165#203#165#165#164#164#165
- +#164#165#160#165#160#161'|'#161#160#161#164#160#165#202#202#207#202#203#207
- +#203#203#206#203#203#206#203#203#202#203#202#203#202#165#202#164#198#165#199
- +#198#165#199#164#198#165#164#161#160#161#164#161#164#203#203#207#203#207#203
- +#207#207#207#203#207#208#203#208#203#207#203#203#169#203#203#170#169#169#169
- +#165#133#165#129#169#133#169#173#173#173#137#173#138#173#137#137#133#137'a'
- +#133'a'#133'`]]\554550'#0#0#0#165#203#207#207#207#203#208#203#207#208#207#207
- +#208#203#207#203#203#208#203#203#203#169#203#165#203#165#165#165#160#165#160
- +#165#164#161#160#161#160#161#160#161#165#164#203#207#202#203#207#202#207#202
- +#203#202#207#203#202#207#202#169#202#203#168#202#203#199#168#198#164#165#160
- +#164#165#164#198#165#160#165#164#165#164#165#203#207#203#207#203#207#203#208
- +#203#208#203#207#208#203#204#170#170#170#169#134#129#133#129#165#129#133#129
- +#129#133#165#133#173#138#173#133#173#134#173#137#133#137#133#133#133#133#133
- +'a]]995455'#12#13#0#0#0#165#207#207#203#208#207#207#207#208#207#203#208#203
- +#208#208#203#208#169#203#203#169#204#165#203#165#165#165#164#161#164#161#164
- +#161#164#161#164'|'#165#164#165#164#164#203#202#203#203#206#203#203#207#203
- +#207#203#202#203#202#203#203#202#203#202#199#164#164#198#165#165#198#164#199
- +#160#199#165#198#161'|'#161#164#165#203#207#203#207#207#203#208#208#207#208
- +#207#208#208#170#170#170#134#130#134#247#247#247#247#247']'#247#129#129#133
- +#129#133#133#169#173#137#174#137#173#137#133#137#133#137'a'#133'a`]a9\54550'
- +#17'1'#0#0#0#169#203#208#207#207#208#208#208#207#208#208#207#208#207#203#208
- +#203#204#207#170#203#169#203#165#165#165#165#165#160#165#164#161#164#161#164
- +#129#169#173#133#164#165#198#203#207#202#207#203#202#207#202#207#202#203#207
- +#203#202#203#202#203#168#203#168#203#198#165#198#164#164#165#164#165#164#194
- +#165#164#165'|'#129#165#169#203#207#203#208#207#207#203#208#207#208#170#170
- +#170#134#130#134#134#247#134#247#134#247'a'#247']'#247']]'#247#129#133#137
- +#174#137#133#173#137#133#137#133#137#133#133'a'#133'a`]]9555'#12#17'0'#12#0#0
- +#0#169#207#207#204#207#207#207#208#207#208#207#208#208#208#208#208#208#203
- +#204#203#204#169#203#169#165#165#165#165#165#161#160#165#160#165#160#169#133
- +#173#165#164#165#169#202#203#207#202#207#207#203#207#203#207#202#203#207#203
- +#202#169#202#203#202#199#164#203#164#165#198#165#160#161#164#165#164#199#164
- +#164#169#164#165#203#207#203#207#203#208#208#207#208#204#170#170#130#170#8
- +#134#134#134#134#247#247#247#247#247#247'^]'#7']]]'#247#137#137#174#137#137
- +#134#137#137#137#133#133#133#133'aaa]\954551'#17'1'#0#0#0#203#207#208#207#208
- +#208#208#208#208#208#208#208#208#204#170#170#170#170#170#170#165#166#169#166
- +#165#165#165#129#161#128#165#161#160#165#160#169#129#164#169#165#164#202#203
- +#206#203#203#203#202#203#206#203#202#203#207#202#168#203#203#202#203#164#203
- +#168#198#165#198#165#164#165#164#161#160#165#160#161#165#169#129#165#203#207
- +#207#208#207#207#207#208#174#170#8#170#8#134#134#130#134#130#130#134#134#247
- +'^^^]'#7'b]^]]'#133#138#133#137#133#137#137#133#133#137#133'aaa]]]95451'#16
- +'1'#12#13#0#0#0#207#208#203#207#208#207#208#208#208#208#208#170#170#170#170
- +#134#170#130#170#130#130#134#129#129#247#165#165#161#129#161#161#160#165#160
- ,#161#164'}}'#165#128#165#199#202#203#203#207#202#207#207#203#203#207#207#202
- +#203#203#203#202#202#169#202#203#198#165#198#165#164#165#164#161#164#165#164
- +#164#165#164#169#133#165#169#203#207#203#207#204#208#204#170#8#170#134#134
- +#134#134#134#9#134'b'#134'^^^^^'#7'b]'#7'a]]'#138#137#137#138#137#134#137#133
- +#137#133'aa'#133']a\99455'#16'1'#16'1'#12#0#0#0#204#207#208#208#208#208#208
- +#208#208#171#170#8#170#9#170#170#130#8#130#134#130#247#247#247#129#129#129
- +#129#129'}'#164#161'|'#161#160'}||'#129#160#164#202#203#207#202#203#207#202
- +#203#202#207#202#203#203#206#203#202#169#203#202#168#198#169#198#165#164#165
- +#164#161#164#161#164#161#165#160#165#137#169#165#203#208#207#208#208#207#174
- +#170#134#8#134#8#9#134#9#134'b^'#130'^^b^^^b'#7'^='#7'>]a'#134#137#133#137
- +#133#133#137#133'a'#133'aa`]]955'#17'4'#13#13'1'#12#13#0#0#0#203#208#207#208
- +#208#208#208#170#170#8#170#8#170#170#9#8#134#134#134#130#134#247#247#247#247
- +#7#7'}'#129'}}'#129#160#161#164#161'}|'#129#165#161#168#203#202#207#202#203
- +#207#203#207#203#207#202#203#203#202#203#202#203#203#203#164#198#169#198#165
- +#164'}'#164'}'#160#161#164#160#165#160#169#133#165#165#207#203#207#207#208
- +#170#8#8#134#8#134#134#134'b'#9#130#9'b^^^^^^^'#7':'#7']'#7'9a'#137#134#137
- +#133'e'#133'a'#133#133'aaa]9]945'#13'50'#16#13#13'0'#0#0#0#207#208#208#208
- +#208#208#171#170#8#8#171#8#9#8#134#134#9#130#134#130#134#247#247#247#7#129#7
- +#129#7'}'#129#161'}'#128#161'|}|'#129#128#161#198#203#203#203#203#203#202#203
- +#202#203#202#203#202#169#203#202#203#168#202#164#203#168#165#164#164#165#164
- +#161#160#165'|'#165#165#160#165#133#129#165#169#207#208#207#208#170#134#134
- +#134#8#134#9#134#9#134#130'bb^b^^^^:'#7':'#7'9:9'#7'9b'#137#133'b'#133#133
- +#133'aaaa]9\94550'#17#13'1'#13#12#13#0#0#0#204#208#208#208#208#170#8#8#8#9
- +#170#9#8#134#9#9#130#134'b'#9#247#247#247#247'^'#7#247']'#7#129'Y'#129'|'#161
- +#160#129#128#129#128'}'#160#165#202#203#202#169#202#203#202#203#203#203#202
- +#203#203#202#203#168#203#169#203#164#165#198#165#165#164'}'#164'}|'#161#160
- +#160#165'|'#133#133#133#165#207#203#208#170#134#8#8#8#9#134#134#9'b'#9'b'#9
- +'^b^^:^:'#7'::'#7':9'#7'95]a'#133#133#133'aaaaa\]]9555'#12#17#12'1'#12#12'05'
- +#0#0#0#204#208#208#204#171#8#9#8#9#8#9#134#9#9#130#134#9#9#247'^'#9'^^'#247
- +#247#7#7#7']'#7'Y}}'#129'|}]'#133#129#128#161#164#203#202#203#202#169#202#169
- +#202#169#202#169#202#169#203#168#203#198#202#164#203#164#165#164#128#161'|}|'
- +#165'|'#165#129#160#129#133#133#133#165#208#207#208#8#134#134#134#134#8#134#9
- +#134#134'b^b_^^^^:^:69:5:9995aaaaaaaa]9]8545'#12#17'1'#13#12#13#13#13#13#0#0
- +#0#170#208#208#8#134#9#134#9#134#9#9#9#134#9#9'b'#130#9#9#130'b'#130'b^^^'#7
- +#7#7']'#7']Y}}|}'#128#129'}|'#165#198#169#202#203#202#203#198#203#202#203#202
- +#199#202#203#202#169#169#169#164#168#164#165#165#160#129'|'#129'|}}|'#161#164
- +'}'#133#133#133#165#169#207#170#134#8#134#8#134#138'b'#134#9'b'#9'b^b^^:^^::'
- +':6:5656555aaaaaa]]]99555'#13'0'#13'0'#13#12#12'1'#12#0#0#0#170#208#170#9#134
- +#9#9#9#9#9#134#9#9'b'#9#9#9'bb'#9'^b^^^^]^]'#7']YY'#129'|}\Y'#129'|}'#160#165
- +#202#199#164#165#164#165#168#165#168#165#168#169#168#169#168#169#168#169#165
- +#165#128#128#129'|}|}|'#129'|'#129'}'#128#133#133#134#133#203#207#134#134#134
- +#138#134#138#134#134#134'bbbb^b^:^::6:565655'#17'5'#17'55]aa]]8]9945'#16#13
- +'0'#13#12#13#244#13'1'#12#13#0#0#0#170#204#134#9#9#134#9#134#9#134#9#9#134#9
- +#9'bb^'#9'^b_b^^^^'#7#7']'#7']YY}'#129'Y'#129#128']|}'#164#199#164#165#164
- +#165#164#165#164#165#164#169#168#169#169#169#168#169#133#128#128#129#129'}|}'
- +'}|}|}'#128'|'#129#133'a'#133#129#169#170#138#138#174#134#137#134#138#134#134
- +'a'#247'b^b^:^::6:6665'#18'5'#18'555'#17#13'49]]9]9455'#13'1'#13#12#13#245#12
- +#13#12#12#13#12#0#0#0#130#9#9#134#9#9#9#9#9#9'b'#9'c'#9'b'#9'c'#9'b_b^b^^^]^'
- +'9'#7']'#7'Y]Y]\Y]}'#128'}|'#165#164#165#164#165#164#165#164#165#168#133#169
- +#173#168#169#169#132#169#133#129#129#128#128']||Y|}'#128'}'#129']'#133#129'a'
- +']'#133#174#169#138#137#174#138#134#138#134#138'bba:]^^::::565'#18'6'#17'5'
- +#17#17#17#13#17#13#13#12'5594555'#12#13#12#244#13#12#12#13#12#13#245#12#245#0
- +#0#0'b^^'#9'b'#9#9'b'#9#9'cb'#9'bcbbcbbcb^bb^^^'#7#7'Y]YYY]]'#3']]Y|}|'#165
- +'|'#129'|'#129'}'#128#133#169#168#169#169#169#169#132#169#132#133#128#129#129
- +#129'}]'#129'|Y|}'#128'|]]]'#133'a'#169#138#173#174#134#137#138#137#138#133
- +'b'#134'bbb^9:6666'#18'6'#18'5'#17#18#13#17#13#13#17#13#13#13#13#13#12#13#17
- +'1'#12#12#13#12#13#13#244#13#244#13#244#12#13#244#12#0#0#0'^'#9#9'_'#9#9'b'#9
- +'cb'#9#9'c'#9'b'#9'cbcbbbb^b:b]b]b]]]Y'#3'Y]]\]}'#3'}|}|}|'#128#129#129#132
- +#133#169#132#173#133#169#133#133#133#133#128#129'\]'#128'Y|}'#129#3'}]a]a'
- +#133#169#137#174#137#138#173#138#134#138#134#138#133'ba^]::'#7'965'#17'6'#17
- +#17#14#13#13#13#13#13#13#13#13#13#12#13#12#13#12#13#12#13#13#12#245#12#12#13
- +#245#12#244#13#244#244#244#245#0#0#0'ccbb'#9'^'#9'cb'#9'bcbbccbcbbcbcbb'#134
- +#134#134#134#133#133'b'#133']]Y]]]]Y\}|}|}}'#128#129#129#132#133#168#169#173
- +#133#168#133#133#128#133#128#129']Y'#3'Y]]Y'#3'}]'#133'aa]'#137#138#174#133
- ,#174#173#138#137#138#133#138#133'bbba^9'#7'9:5'#17#14#13#13#14#13#13#13#13#13
- +#13#13#13#13#13#13#12#13#244#244#245#12#13#244#244#13#244#245#244#244#244#245
- +#244#245#244#13#244#0#0#0'^^ccccbc'#9'ccbcccbcbcbbbbb'#138#138#138#138#137
- +#138#133#133'a]]]\Y]\]]Y'#3'}}'#3'|}Y'#128#129#133#133#133#133#169#133#132
- +#133#133#129']\]\]Y'#3']'#3'Y'#3']a'#133'a'#133#173#173#137#173#137#138#137
- +#134#137#138#133'f'#133'aa'#7'9:9:556'#17#13#13#13#13#13#13#13#245#13#13#13
- +#13#244#13#245#244#245#244#245#244#245#244#245#244#245#244#245#244#245#244
- +#245#244#245#244#245#0#0#0'cb^bcbcbcbccbcbcbcbcbb'#138#8#138#138#133#138#133
- +#134#138'a'#133#133']]Y\Y]X9XY'#3'Y}Y'#3'Y]'#128#133#133#132#133#133#133#133
- +#133#132#133#129']]Y'#3']5'#3']'#3'Yaaaa'#133#137#174#137#138#173#134#137#137
- +#134#137'b'#133'bbb='#7'99595'#17#13#13#13#13#13#245#13#13#13#245#245#244#245
- +#245#244#245#244#245#244#244#244#244#244#244#244#244#244#244#244#244#244#244
- +#244#244#244#244#0#0#0'^_c_bcccbcbccbcbcbgbc'#138#138#138#174#138#138#138#138
- +#137#133#134'aa]]\5'#3'YY]Y'#3'UX'#3'XYX]]'#133#132#133#133#132#133#132'a'
- +#133']\]\]Y5X]Y]Yaaa'#133#137#173#137#169#137#134#137#138#138#137#134#137#133
- +'aaa9]955'#17'55'#13#13#13#13#245#13#245#245#245#245#244#245#245#244#245#244
- +#245#244#240#245#244#245#244#241#244#245#244#245#244#245#244#245#244#245#244
- +#245#0#0#0':c^b_bcbcccbbc>cbcbc'#138#8#8#8#138#138#138#134#137#134'b'#133'a'
- +#133']]]YYYXY4]YXUYYYX]'#128#133#133#133#133#133#133#133#128'a]]Y5Y4YY5\58a]'
- +#133#173#133#174#137#138#173#138#133#133#133'e'#133'aba]]955555'#13#13#13#13
- +#245#13#245#245#245#244#245#245#245#244#245#241#244#245#244#241#244#240#244
- +#240#244#244#244#0#244#240#244#244#244#244#244#244#244#0#0#0'_^?cb;bcb?bcccb'
- +'cbcbf'#8#8#138#138#138#170#138#138#134#137#137#134'aa]]]4Y45Y5Y4YY4YXY]]'
- +#133#132#133#132'a'#132'a]]\]X54Y54Y5]]aa'#137#137#137#137#173#137#133#137
- +#138#137#138#133'baaaa9955'#17'5'#17'5'#13#13#245#245#245#244#245#245#245#245
- +#244#241#245#244#244#241#240#244#240#240#245#240#244#245#0#245#244#244#245
- +#244#245#240#245#244#245#244#0#0#0':_^;bc;bcbc>cbcbgbc'#8#8#8#8#174#138#138
- +#138#137#138#134#137'a'#133'aa]9]5YXY45544U4Y4]\]'#133#133#133#133#133']\]Y]'
- +'Y554554Y8=aa'#133#173#133#137#134#137#137#134#137#133#133#137#133'aa]]99555'
- +#17#13#17#13#13#245#245#245#245#245#244#245#245#245#244#240#241#245#244#241
- +#240#245#0#240#245#0#244#240#240#241#240#240#240#244#244#240#244#244#244#0#0
- +#0';::c;^c>_?bcc>cbcbf'#8#8#8#138#138#174#138#138#138#134#137'b'#133'aaa]\5X'
- +'550Y54555055Y]]\a\]\]]]\54505145555]a'#137#137#137#137#137#133#138#137#133
- +#138#137'aaaaa]955'#17'4'#13'5'#12#13#245#244#245#244#245#240#245#245#0#245
- +#245#245#244#0#241#244#240#0#244#240#0#244#241#240#244#240#244#241#244#0#245
- +#244#241#244#245#0#0#0'::;^>c>_?bc>>cc>cf'#9#8#138#8#138#174#138#138#134#137
- +#137#134#137#134'aa]]9Y55455055501504]\]]]]]]9X5550554554549a'#137#133#133
- +#137#133#138#137#133#137#133'a'#133'aa]]9954'#17'1'#12#13#13#13#244#245#244
- +#245#245#245#245#240#245#245#0#244#0#245#244#245#0#244#241#0#244#240#0#244#0
- +#245#0#244#240#245#244#240#244#244#240#0#0#0':;:;;:_>^?:cc>bcbb'#8#8#8#174
- +#138#138#174#137#138#134#138#137'aaa]a]94545141945001155]]]\]5\Y545410110555'
- +'9=a'#133#137#137#133#137#137#133#137#133'e'#133'aaaa994'#17'5'#12#17#13#13
- +#12#13#245#245#245#244#241#244#0#245#244#0#245#240#245#0#240#244#0#0#240#244
- +#0#241#240#240#240#240#240#245#0#244#0#244#240#241#244#0#0#0'6:::;>;;>c>>_?b'
- +'?cf'#8#8#8#8#138#174#138#138#138#137#134#138#133#133'aa]\]5550514115'#13'00'
- +'014545545545511'#12'1'#12'1'#13'049aaa'#133#133#137#137#133#137#133'e'#133
- +'a'#133'aaa]]954'#17'1'#12#13#12#13#12#244#0#245#244#241#245#240#240#241#245
- +#0#245#0#245#0#245#240#240#0#245#240#0#0#241#0#244#0#240#240#245#240#241#244
- +#240#240#0#0#0#18':7::;:>;:_?>b?b>'#9#8#138#138#138#174#138#138#134#138#138
- +#133#137'baaa]994545101'#244#12'50'#13'1'#13'015554554550'#13'0'#13'0'#13#12
- +'0'#13'59a=a'#133#137#133#133#137#133#137#133#133#133'aaa]98555'#13#12#13#12
- +#13#12#245#245#245#244#241#244#240#245#241#244#0#245#0#244#0#244#244#244#0
- +#240#13#244#244#240#240#240#240#241#244#0#240#240#244#0#245#244#0#0#0#18'6'
- +#22':;:;;:?>:c?b>cb'#8#138#8#174#138#138#138#137#138#133#137'baaaa9]45510'#12
- +'10'#244#13'5'#16#245#12'0'#12'11001'#13'0110'#13'0'#13#244#13#12','#13#13'5'
- +#16'59aa'#133#133#137#133'a'#133'aaaaa]]995'#13#12#13#12#13#12#13#244#245#244
- +#244#0#245#0#245#0#244#0#245#0#245#0#244#244#241#240#241#0#244#245#21#244#0#0
- +#0#240#0#244#240#240#241#240#244#244#0#0#0#14#18'6'#18':;::;::?:>?b>'#138#8
- +#138#138#138#138#138#138#134#138'a'#138'aaaa]]955'#16'0'#13'1'#12#13#244#244
- +#17'1'#244#245#244#245#12#12#13'1'#13'0'#13'0'#13#12#13#244#12#245#12#245#13
- +#244#12'5599=a'#133#133'a'#133#133'a'#133'aaa]\995'#16'5'#13#12#13#244#13#244
- +#13#244#240#241#245#244#0#245#240#241#245#0#244#0#240#241#244#244#244#244#0
- +#244#244#17#12#244#244#241#240#240#0#245#0#244#240#245#244#0#0#0#14#18#18#18
- +'6'#18';::;;:?:>?>b'#8#138#138#138#138#134#137#138#134#137#134#133'aaaa]4551'
- ,#13'0'#13'0'#13#241#12#17#244#244#244#245#244#245#244#244#244#245#244#13#244
- +#244#245#244#245#244#245#244#244#244#13#16#17'4='#21'9=a`'#133'a'#133'aaaaa9'
- +']9455'#12#13#244#13#13#12#245#244#241#244#244#0#245#244#0#244#0#240#241#240
- +#241#240#244#0#245#0#240#240#13#245#13#13#245#244#244#0#240#240#0#240#0#244
- +#240#240#0#0#0#13#14#18#18#18':'#18':;:::::?:>b'#138#138#138#138#134#137#138
- +#134#137#134'eaaa]]8550'#13'0'#13'0'#13#12#244#244#13#12#13#244#244#244#240
- +#244#245#244#244#244#244#245#244#244#244#244#244#244#244#245#244#244#13'5'#13
- +#17'49=]a'#133'a`a`a]\]9455'#12#13#12#13#12#244#245#244#245#240#245#0#245#0
- +#240#241#0#245#0#244#0#240#240#241#244#240#244#245#240#13#244#0#13#244#240#13
- +#244#13#244#244#245#240#240#245#244#0#0#0#6#14#14#14#18#18'6'#22':'#22':;:::'
- +':>>'#138#138#134#138#137#138#134'e'#138'aaaaa]9554'#13#12#13#12#12#245#244
- +#240#13#17#17#17#244#240#245#244#245#240#244#245#244#245#244#244#245#240#245
- +#244#244#241#244#244#13#244'9'#12#244#245#17'99aaaaa]]9]9955'#12#13#12#245#12
- +#244#245#244#244#240#244#0#244#0#240#241#244#0#240#240#0#245#244#245#244#0
- +#245#240#0#244#244#240#0#0#0#0#21#17#12#17#17#12#240#245#244#240#0#0#0#245#13
- +#6#14#14#18#18#18'6'#18'::::::::b'#138#138#138#134#138#133#134#133#134'aaa]9'
- +'854'#13#13','#13#12#245#12#245#240#244#13#244#13#244#240#244#240#240#245#244
- +#244#244#240#245#240#244#244#240#245#240#244#245#16#17#13#13#16'9'#16'99==\]'
- +']]9]]9454'#13#13#12#13#244#244#245#244#245#0#245#0#245#0#245#240#240#0#244#0
- +#241#244#0#244#0#240#244#0#244#240#245#21#12#240#240#245#240#13#245#244#17#21
- +#244#0#240#0#244#0#0#0#13#245#245#13#6#14#18#18#18'6'#18#22':'#22'::'#22':^'
- +#137#134#137#134'e'#138'eaaaa9]955'#13'0'#13#13#12#245#244#244#12#17#12#13#13
- +#16#241#244#245#244#244#240#240#241#240#244#240#240#241#240#240#240#240#244
- +#13#17#244#12#17#17'='#21'99='#21'99\]\94551'#13#12#13#244#245#244#245#244
- +#244#0#244#240#244#0#244#0#240#241#0#241#240#240#240#245#240#244#241#244#240
- +#241#0#244#13#13#244#240#244#12#244#244#13#17#17#245#240#244#245#240#0#0#0
- +#245#245#219#245#10#6#14#14#18#18#18'6'#18#22'6'#22'::'#21'b'#138'b'#138#134
- +'a'#134'aaa]]9545'#12#13#12#12#245#244#244#13#13#17#245#12#13#13#240#244#244
- +#245#0#244#240#240#240#241#240#240#244#240#12#244#13#240#244#244#17#17#17#12
- +#13'5'#21'9'#21#17'5'#17'9955550'#13#12#245#244#245#244#244#244#0#245#240#241
- +#0#240#0#241#240#0#240#244#240#244#241#244#0#244#0#244#0#244#244#0#244#13#0#0
- +#0#13#17#13#244#13#244#12#240#0#241#0#244#0#0#0#245#245#245#245#219#245#6#14
- +#6#14#14#18#18#18'6'#18'6'#17'6:b'#137'aaaaaa=]8545'#13#12#13#244#245#244#244
- +#13#12#244#244#244#12#240#244#0#244#241#240#240#245#13#16#17#12#244#13#12#17
- +#17#13#21#12#13#13#13#12#13#244#13#21'9'#21'9'#16#17#16'9'#17'85'#12#12#13
- +#244#244#244#244#240#12#13#240#245#240#0#240#240#241#240#244#0#245#240#240
- +#241#0#244#0#240#245#240#241#240#241#0#240#241#12#0#0#0#244#245#244#240#244
- +#244#245#240#240#240#244#240#0#0#0#245#245#245#245#245#245#13#245#14#13#6#14
- +#14#17#14#17#18#18#17#17'9babaaa]]9955'#13#12#245#12#244#244#245#244#12#13
- +#245#13#245#13#244#13#241#244#244#244#0#244#17#17#12#13#17#12#13#12#13#244
- +#245#244#240#240#12#17#244#13#21#16#21'9'#21'9'#21#17#21#17'9'#17#21#17#12#17
- +#13#244#13#17#13#12#244#0#244#244#245#244#244#244#241#244#0#244#0#244#240#241
- +#240#244#0#244#0#244#240#240#240#244#245#244#244#244#245#0#13#244#13#244#245
- +#245#0#244#0#240#0#0#0#240#241#245#245#245#245#245#13#245#6#245#6#14#6#14#6
- +#13#6#17#17#13'9aaa]]]9950'#13#12#13#244#245#244#244#244#241#0#244#244#244
- +#244#245#244#244#240#0#245#240#241#240#16#13#244#12#17#17#13#17#17#12#13#244
- +#245#244#13#245#244#12#17#21'9'#21'9'#21'99='#17#21'=='#17#12#21#17#12#12#13
- +#13#245#240#240#0#244#0#245#240#244#244#241#244#240#241#240#240#244#0#245#240
- +#240#244#0#240#0#12#13#244#13#13#13#240#0#244#240#13#244#244#12#0#240#241#240
- +#0#0#0#241#244#245#0#245#245#245#245#245#245#13#13#13#245#219#13#13#13#13#13
- +#13#13#17'9]99954'#13#13#12#245#244#245#244#244#13#17#244#240#245#244#245#244
- +#12#240#245#240#240#244#240#0#244#245#17#21#13#12#13#12#13#16#13#13#240#240
- +#240#0#240#245#0#244#17#17#16#17#17#17#16#21#17#16#21#17#17#17#17#13#17#245
- +#244#244#240#0#244#241#240#240#244#244#245#240#244#0#244#240#240#241#0#244
- +#240#0#245#0#245#240#0#17#245#244#244#240#240#244#240#13#244#219#17#21#13#240
- +#0#240#0#0#0#0#240#245#0#245#245#240#245#245#245#245#245#245#245#13#13#13#245
- +#13#13#13#17#13#21'99954'#12#13#13#244#245#244#244#244#240#13#17#12#240#0#12
- +#245#244#244#245#244#244#0#245#240#0#240#240#17#16#17#12#13#12#13#12#13#13#12
- +#0#0#0#13#244#244#244#13#21#21#21#21#21#21#21'9'#21#17#17#16#17#21#21#244#240
- +#12#244#245#244#13#21#244#0#240#241#240#0#244#0#244#241#0#244#0#244#241#0#244
- +#240#240#240#0#13#12#240#244#13#13#12#13#13#244#240#13#12#17#12#0#240#240#240
- +#0#0#0#244#0#245#244#0#245#245#0#244#245#241#245#244#245#245#244#13#21#17#13
- +#17#17#21'9='#21'5'#17#13#244#244#244#244#244#245#12#17#240#240#219#240#240
- +#13#244#245#245#12#13#13#240#244#245#240#0#244#13#13#244#13#13#13#13#13#13#12
- ,#13#240#0#240#13#13#240#13#17#12#17#17#17#16#17#17#21#17#13#12#13#13#244#13
- +#245#0#13#13#244#12#17#245#244#244#0#240#240#245#240#241#240#240#240#241#244
- +#0#240#240#241#0#240#0#240#16#17#17#244#240#244#17#12#13#13#244#244#17#219
- +#245#0#0#240#0#0#0#0#241#240#0#241#244#0#245#245#240#245#244#245#245#244#245
- +#245#12#13#13#13#17#17'9'#21'9='#21'9'#17#17#244#13#21#12#245#12#17#244#240
- +#13#241#0#244#244#244#244#245#244#13#0#240#240#245#0#240#16#13#244#244#12#244
- +#12#244#12#13#13#244#244#244#12#245#240#244#17#17#16#21#17#17#21#17#21#16#13
- +#245#244#245#240#240#240#0#240#240#245#240#241#0#0#241#240#0#240#0#240#240#0
- +#244#0#240#240#241#0#240#240#240#0#240#13#17#21#13#0#245#240#0#0#244#17#245
- +#244#245#244#244#244#245#0#240#0#0#0#0#244#0#244#240#241#244#0#245#240#245
- +#240#245#244#244#244#13#17#13#244#13#17#21#17#21#17#21#21#17#12#13#12#21#17
- +#12#13#240#0#240#17#240#240#13#244#245#12#12#245#244#0#245#244#240#0#240#245
- +#17#21#17#13#13#13#13#17#12#13#0#0#0#245#240#240#0#240#17#13#17#16#17#17#16
- +#21#17#13#244#244#244#0#0#0#0#0#0#244#0#240#0#240#244#244#240#0#240#240#0#241
- +#0#240#240#0#244#240#240#0#0#240#13#12#17#13#12#13#12#244#245#240#244#17#244
- +#244#0#244#245#13#244#0#240#0#0#0#240#241#240#241#0#244#0#240#241#240#244#241
- +#244#241#245#17#219#13#12#244#13#16#17#13#12#13#17#12#13#21#21#17#17#17#13#16
- +#17#12#245#244#240#240#245#244#245#240#245#0#244#240#240#0#0#240#240#17#12
- +#245#244#244#244#244#244#244#245#244#240#244#13#244#244#245#12#17#16#17#16#17
- +#17#17#17#17#17#12#244#244#245#0#240#240#240#0#244#245#240#0#0#244#245#219#13
- +#244#0#0#240#240#240#240#0#240#0#0#0#240#245#218#13#244#219#12#21#17#240#0#13
- +#244#245#17#244#13#12#13#244#12#13#0#0#0#0#0#240#0#240#240#241#240#245#240
- +#244#241#244#240#240#244#12#245#240#244#17#17#21#13#17#244#17#244#13#13#12#17
- +#17#12#13#244#240#245#17#13#12#17#12#219#244#240#244#244#244#240#245#0#244
- +#241#240#0#245#12#245#244#13#17#17#13#17#17#17#17#17#13#12#245#244#244#17#21
- +#17#17#17#17#219#244#240#12#13#245#0#245#244#240#244#241#244#241#240#13#0#240
- +#0#0#244#240#244#245#240#244#240#0#0#0#240#0#241#244#240#244#13#245#12#244#13
- +#17#17#13#12#245#240#0#244#13#244#13#17#17#245#13#17#240#240#0#0#0#240#244#0
- +#240#240#0#0#0#0#0#0#240#17#17#17#17#240#0#245#245#12#13#16#17#21#21#244#12
- +#13#16#245#0#244#245#244#240#244#0#0#245#244#240#241#244#245#244#245#244#12#0
- +#0#240#240#0#240#13#16#13#12#244#13#244#244#244#12#245#244#245#0#244#245#0
- +#245#244#13#12#17#13#12#245#12#13#244#12#13#244#245#0#0#0#240#0#0#240#0#0#0
- +#240#245#244#245#244#17#17#0#244#240#245#0#240#16#21#13#244#244#244#245#240
- +#12#21#17#0#13#244#240#0#240#13#244#244#0#244#244#244#244#0#0#0#0#0#245#12
- +#241#0#240#240#244#245#244#244#245#244#245#244#245#17#244#0#244#244#245#244
- +#219#17#21#21#244#13#13#17#12#244#13#245#244#245#17#0#0#0#240#241#244#244#240
- +#0#244#13#245#0#240#240#0#0#240#244#17#17#17#13#12#13#17#17#17#244#0#244#240
- +#245#244#244#240#244#17#17#16#17#13#244#244#13#12#13#240#245#244#0#240#0#0#0
- +#240#0#0#240#0#244#13#244#244#245#244#244#0#244#245#12#0#240#245#13#13#244#13
- +#245#13#244#17#13#244#0#245#240#245#0#245#17#245#13#240#244#245#219#13#0#240
- +#0#0#0#0#240#244#240#0#244#13#17#244#240#245#244#0#13#244#0#0#0#13#244#13#12
- +#13#21#245#244#245#244#244#245#13#21#12#244#244#244#244#244#245#244#13#244
- +#244#13#13#244#245#240#244#0#240#245#0#240#241#17#244#244#245#244#13#244#244
- +#244#245#244#245#13#13#244#244#241#13#17#12#17#17#17#16#13#12#17#17#13#244
- +#244#0#0#0#240#0#240#0#0#240#0#0#245#244#240#245#244#244#245#0#245#244#13#240
- +#0#0#244#244#12#240#240#12#240#245#240#0#0#244#244#244#0#0#244#244#244#0#245
- +#244#241#240#0#240#0#0#0#12#17#13#244#17#13#218#245#244#13#244#245#244#244#13
- +#244#0#240#219#12#17#13#12#13#244#0#244#13#244#0#240#17#21#13#12#245#0#245
- +#244#0#240#240#0#244#13#240#244#0#245#0#240#0#240#0#244#13#245#244#13#12#13
- +#17#13#17#17#13#244#0#240#240#240#240#12#219#17#17#16#17#17#17#17#17#12#244
- +#244#245#240#0#240#0#240#0#240#0#0#0#0#244#245#244#244#244#17#12#0#244#244#17
- +#244#0#0#13#17#13#245#12#245#12#17#244#0#0#13#13#245#0#240#13#245#244#240#244
- +#244#244#244#0#240#0#0#0#245#12#245#244#13#244#245#244#245#244#245#244#13#244
- +#13#245#13#12#245#244#245#12#13#13#244#244#13#12#13#244#244#13#16#245#245#244
- +#12#245#244#13#244#245#13#244#245#244#245#240#244#240#0#244#0#240#0#12#16#13
- +#244#245#244#245#244#244#244#245#240#0#0#245#0#0#244#13#16#13#17#13#16#17#17
- +#21#13#245#0#240#240#0#0#0#0#0#0#240#0#240#0#0#240#0#241#240#13#245#0#245#244
- +#0#0#0#244#17#13#12#244#13#244#245#21#13#240#0#0#240#244#0#244#219#12#245#0
- +#245#244#17#13#0#240#0#0#0#240#0#245#12#13#13#13#244#240#0#0#240#245#0#244
- +#240#244#245#240#0#244#13#13#12#244#13#16#17#17#17#244#219#13#244#0#245#17#0
- +#244#13#240#244#240#244#240#244#240#244#245#0#240#245#0#0#240#13#13#17#12#244
- +#13#12#13#13#13#244#0#0#0#240#244#245#244#245#17#17#16#17#17#17#20#21#17#244
- +#240#245#0#0#240#0#240#0#240#0#240#0#0#240#240#13#12#244#0#0#0#17#13#0#0#0#13
- +#12#244#17#13#16#17#244#244#219#245#0#0#240#17#240#0#240#240#244#0#244#244
- ,#245#240#0#244#0#0#0#240#244#244#245#12#244#240#244#0#240#240#244#244#0#0#0
- +#245#244#240#244#245#13#12#12#13#17#219#17#21#17#12#13#13#244#240#244#244#0
- +#244#245#0#0#0#245#244#245#12#219#244#240#245#244#0#240#241#13#244#244#13#13
- +#13#12#13#240#0#240#240#241#0#244#245#244#245#0#244#12#13#13#12#13#13#17#12
- +#245#0#240#0#240#0#0#0#240#0#0#0#0#240#0#245#244#245#240#13#244#0#12#244#0#0
- +#240#245#12#13#17#12#13#17#12#17#12#240#0#0#245#17#0#0#240#245#13#12#219#245
- +#0#0#0#17#0#0#0#17#17#240#244#17#13#244#245#244#13#17#245#245#244#244#244#13
- +#13#0#245#244#244#245#245#12#12#244#245#244#16#245#244#12#245#240#245#13#0
- +#240#244#245#244#240#240#240#244#241#244#245#0#240#244#0#0#244#13#244#240#245
- +#12#244#245#12#244#0#240#0#12#13#240#240#0#240#244#17#13#17#16#17#16#17#16#13
- +#244#240#244#0#0#0#240#0#0#240#0#240#0#0#240#240#12#13#240#13#245#240#17#13#0
- +#0#240#17#17#12#219#13#12#219#17#17#17#12#0#0#240#13#240#244#219#244#244#245
- +#244#240#13#244#0#244#0#0#0#13#219#240#240#13#244#244#13#244#245#12#244#245
- +#244#245#240#244#240#240#240#245#244#244#17#17#13#244#244#13#17#16#17#13#244
- +#240#244#13#240#241#244#12#13#245#244#245#240#244#0#244#240#0#245#240#240#0
- +#244#17#21#13#13#13#13#13#13#13#244#0#241#244#240#0#0#245#244#13#12#17#17#17
- +#17#17#17#17#244#0#241#240#0#0#0#0#240#0#0#0#240#0#0#244#245#12#240#12#244#0
- +#13#244#0#0#240#12#245#244#13#244#13#12#245#244#13#245#0#0#240#17#240#240#13
- +#240#245#12#245#244#244#245#240#17#0#0#0#240#240#0#13#17#13#244#240#13#12#17
- +#13#12#13#244#0#0#0#244#244#244#245#244#244#17#17#244#245#244#21#13#13#12#240
- +#245#0#0#244#12#244#13#12#245#244#13#244#245#240#245#0#240#240#0#0#245#12#245
- +#244#244#244#244#244#12#244#13#244#0#0#0#245#240#0#244#240#240#12#17#16#17#16
- +#17#21#13#244#245#244#240#0#240#0#240#0#240#0#240#0#0#240#245#244#245#240#17
- +#245#0#13#245#0#240#0#0#240#240#244#240#240#245#0#244#0#240#0#0#244#13#0#240
- +#13#244#244#244#245#244#13#240#0#244#0#0#0#12#13#240#244#13#244#245#244#245
- +#244#245#244#245#12#245#0#0#240#13#13#13#12#245#240#13#12#245#244#244#13#244
- +#244#17#13#12#240#0#17#13#13#17#13#12#240#0#244#240#240#244#0#240#240#0#240
- +#244#13#244#244#17#17#17#17#17#17#21#13#0#244#240#244#0#0#244#13#13#17#17#17
- +#17#17#17#17#12#245#12#240#0#0#0#240#0#0#0#0#0#0#0#240#240#240#244#244#245
- +#244#244#244#240#0#0#0#240#245#12#245#244#245#244#244#13#240#0#0#0#240#13#240
- +#244#17#244#240#245#244#244#17#244#0#13#0#0#0#245#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#245#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#245#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#245#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#245#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- ,#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#241#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'$'
- +#236#236#236'$'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#241#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'H'#249#249#249#249
- +#249#236#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#236#249#249#249#249#249'H'#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#249#249#249#249#249'l'#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#144#249#249#249#249#249#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#241#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0'l'#249#249#249#249#249#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8
- +#255#255#7#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0'H'#249#249#249#249#249#236#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#255
- +#255#7#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#236#249#249#249#249#249'H'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#255#255#7#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#249
- +#249#249#249#249'l'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#170#255#246#7#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#144#249#249
- +#249#249#144#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#255#255#7#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'l'#249#249#249#249
- +#249#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#209#255#7#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'H'#249#249#249#249#249#236#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#255#255#7#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#236#249#249#249#249#249'H'#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0'-'#245#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#8#255#255#7#0#0#240#245#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#245#245#0#0#0#0#0#0#0#0#0#240#245#0#0#0#0#0
- ,#0#0#0#0#0'-'#245#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#249#249#249#249#249
- +'l'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#7#255#255
- +#255#255#246'1'#0#0#0#0#0#0#8#255#255#7#0#0#0#0#0#170#255#255'U'#240#255#255
- +#255#255#7#0#0#0#0#0#8#255#255#7#0#0#0#0#0#7#255#255#8#0#0#0#0#0#7#246#255
- +#255#255#255#255#130#0#0#0#0#7#255#255#255#255#247#0#245#246#255#134#7#246
- +#255#255#255#255#8'-'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#249#249#249#249#249#144
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#255#255#255
- +#246#255#255#255#247#0#0#0#0#0#8#255#255#7#0#0#0#0#0#8#255#255#7#255#255#255
- +#255#255#255#134#0#0#0#0#8#255#255#7#0#0#0#0#0#7#255#255#8#0#0#0#0#175#246
- +#255#255#246#246#246#246#255#0#0#0'1'#255#255#255#255#246#255#8'-'#255#255'U'
- +#255#255#255#246#246#246#255#255'1'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'l'#249#249
- +#249#249#249#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#175
- +#255#255#255#247#7#8#255#255#255#7#0#0#0#0#8#255#255#7#0#0#0#0#0#8#255#255
- +#255#255#134#7#130#255#255#255#7#0#0#0#8#255#255#7#0#0#0#0#0#7#255#255#8#0#0
- +#0#175#255#255#255#247'-'#245#245#7#8#0#0#0#246#255#255#255#247#7#246#255#255
- +#255#255'1'#7#255'Y'#245#245#247#255#255#246#245#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +'H'#249#249#249#249#249#236#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#0#0#0#0#0
- +#0#0#0#0#7#255#255#255#240#0#0#0'1'#255#255#255#0#0#0#0#170#255#246#7#0#0#0#0
- +#0#8#255#255#255#247#0#0#0#7#255#255#255#0#0#0#8#255#246#7#0#0#0#0#0#7#255
- +#209#8#0#0#7#255#255#255#240#0#0#0#0#0#0#0#0#245#255#255#255'1'#0#0#0#134#255
- +#255#246#7#0#0#0#0#236#236#7#255#255#130#236#236#236#236#236#236#236#236#236
- +#236#236#236#236#236'$'#249#249#249#249#249'H'#236#236#236#236#236#236#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#7#0#0#0#0#0#130#255#255
- +#247#0#0#0#8#255#255#7#0#0#0#0#0#170#255#255#255#0#0#0#0#0#246#255#255#7#0#0
- +#170#255#255#7#0#0#0#0#0#7#255#255#8#0#0#246#255#255#7#0#0#0#0#0#0#0#0#0#7
- +#255#255#246#0#0#0#0#0#255#255#255#7#0#0#0'H'#249#249#249#255#255#246#249#249
- +#249#249#249#249#249#249#249#249#249#249#249#249#249#249#249#249#249#249#249
- +#249#249#249#249#249#249'l'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'-'#255
- +#255#255#0#0#0#0#0#0#245#246#255#255#0#0#0#8#209#255#7#0#0#0#0#0#8#255#255
- +#134#0#0#0#0#0#7#255#255#134#0#0#8#255#255#7#0#0#0#0#0#7#246#255#8#0#240#255
- +#255#255#0#0#0#0#0#0#0#0#0#0#247#255#255#130#0#0#0#0#0#209#255#255#7#0#0#0
- +#236#249#249#249#255#255#255#249#249#249#249#249#249#249#249#249#249#249#249
- +#249#249#249#249#249#249#249#249#249#249#249#249#249#249#249#249#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#247#255#255#7#0#0#0#0#0#0#0#246#255#255'1'#0#0#8
- +#255#255#7#0#0#0#0#0#8#255#255#7#0#0#0#0#0#245#255#255#255#0#0#8#255#255#7#0
- +#0#0#0#0#7#255#255#170#0#7#255#255#8#0#0#0#0#0#0#0#0#0#0#8#255#255#7#0#0#0#0
- +#0#8#255#255#7#0#0#0#0'l'#249#182#255#255#255#249#249#249#249#249#249#249#249
- +#249#249#249#249#249#249#249#249#249#249#249#249#249#249#249#249#249#249#249
- +#249'H'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#246#255#255'1'#0#0#0#0#0#0#0
- +#130#255#255#247#0#0#8#255#246#7#0#0#0#0#0#170#255#246#7#0#0#0#0#0#0#255#255
- +#255#0#0#170#255#246#7#0#0#0#0#0#7#255#255#8#0#7#255#255#7#0#0#0#0#0#0#0#0#0
- +#0#8#255#246#7#0#0#0#0#0#170#255#246#7#0#0#0#0#0#1#204#255#255#170'$HHHHHHHH'
- +'HHHHHHl'#249#249#249#249#249#1'HHHHHH$'#0#0#0#0#0#0#0#0#0#0#240#0#0#0#0#0#0
- +#0#0#255#255#255#0#0#0#0#0#0#0#0#7#255#255#8#0#0#170#255#255#7#0#0#0#0#0#8
- +#255#255#7#0#0#0#0#0#0#255#255#246#245#0#8#255#255#7#0#0#0#0#0#7#255#255#134
- +#0#170#255#255'U'#0#0#0#0#0#0#0#0#0#0#170#255#255#7#0#0#0#0#0#8#255#255#7#0#0
- +#0#0#0#130#255#255#255'Q'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'$'#249#249#249#249
- +#249#236#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'('#0#0#0#0#0#0#0#245#246#255#255#0
- +#0#0#0#0#0#0#0#245#246#255#255#0#0#8#255#255#7#0#0#0#0#0#8#209#255#7#0#0#0#0
- +#0#0#255#255#255#245#0#8#255#255#7#0#0#0#0#0#7#246#255#8#0#8#255#255#247#241
- +#244#245#245#245#245#245'-'#245#0#8#255#255#7#0#0#0#0#0#8#209#255#7#0#0#0#245
- +#246#255#255#255#200#249'$'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#249#249#249#249#249
- +'H'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#0#0#0#0#0#0#0#245#255#246#175#0#0#0
- +#0#0#0#0#0#245#255#255#255#0#0#8#255#255#7#0#0#0#0#0#8#255#255#7#0#0#0#0#0#0
- +#255#255#246#245#0#170#255#255#7#0#0#0#0#0#7#255#255#170#0#8#255#255#255#255
- +#255#255#255#255#255#255#255#255#0#8#255#255#7#0#0#0#0#0#8#255#255#7#0#0'1'
- +#255#255#255#255#247#144#249#249'$'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#249#249#249
- +#249#249#144#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#7#255#255#170
- +#0#0#0#0#0#0#0#0#0#255#255#255#0#0#170#255#255#7#0#0#0#0#0#8#255#246#7#0#0#0
- +#0#0#0#255#255#255#245#0#8#255#246#7#0#0#0#0#0#7#255#255#8#0#130#255#255#255
- +#246#246#246#246#255#255#255#255#255#0#170#255#246#7#0#0#0#0#0#8#255#246#7#0
- +'1'#255#255#255#255#7#0#0#144#249#249'$'#0#0#0#0#0#0#0#0#0#0#0#0#0#144#249
- +#249#249#249#249#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#0#0#0#0#0#0#0#7#255
- +#255#8#0#0#0#0#0#0#0#0#0#255#255#255#245#0#8#255#255#7#0#0#0#0#0#170#255#255
- ,#7#0#0#0#0#0#0#255#255#255#0#0#8#255#255#7#0#0#0#0#0#7#255#255#170#0#7#255
- +#255#7#245#245#245#245#245#240#255#255#255#0#134#255#255#7#0#0#0#0#0#170#255
- +#255#7#0#255#255#255#8#240#0#0#0#0#144#249#249#236#0#0#0#0#0#0#0#0#0#0#0#0'H'
- +#249#249#249#249#249#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#7#246
- +#255#8#0#0#0#0#0#0#0#0#0#255#255#255#241#0#170#255#255#130#0#0#0#0#0#8#255
- +#255#7#0#0#0#0#0#245#246#255#246#0#0#170#255#255#7#0#0#0#0#0#7#255#255#8#0'1'
- +#255#255#247#0#0#0#0#0#0#255#255#175#0#8#255#255#7#0#0#0#0#0#8#255#255'U1'
- +#255#255#246#0#0#0#0#0#0#0#249#249#249#236#0#0#0#0#0#0#0#0#0#0#0'$'#249#249
- +#249#249#249#236#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#7#255#255
- +#170#0#0#0#0#0#0#0#0#0#255#255#255#244#0#8#255#255#255#0#0#0#0#0#8#255#255
- +#134#0#0#0#0#0#7#255#246#175#0#0#8#255#255#247#0#0#0#0#0#7#255#255#8#0#0#255
- +#255#8#0#0#0#0#0#240#255#255#8#0#170#255#255#7#0#0#0#0#0#8#255#255'1'#8#255
- +#255'1'#0#0#0#0#0#0#0#236#249#249#249#236#0#0#0#0#0#0#0#0#0#0#0#249#249#249
- +#249#249'H'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#7#255#255#8#0#0#0
- +#0#0#0#0#0#0#255#255#246#245#0#8#255#255#255#7#0#0#0#0#170#255#255#255#0#0#0
- +#0#0#8#255#255#7#0#0#8#255#255#246#0#0#0#0#0#8#255#255#7#0#0#8#255#255#0#0#0
- +#0#0#7#255#255#7#0#8#255#246#7#0#0#0#0#0#8#255#255'1'#134#255#246#241#0#0#0#0
- +#0#0#0#0#236#249#249#249#0#0#0#0#0#0#0#0#0#0#0#249#249#249#249#249'l'#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#7#255#255#8#0#0#0#0#0#0#0#0#0#255
- +#255#255#245#0#170#255#255#255#255#7#0#0#0#8#255#255#255#7#0#0#0'1'#255#255
- +#255#245#0#0#170#255#255#255#7#0#0#0#240#255#255#255'1'#0#0#7#255#255#247#0#0
- +#0#0#246#255#255#240#0#170#255#255#7#0#0#0#0#0#170#255#255'U'#7#255#255#7#0#0
- +#0#0#0#0#0#0#0#236#249#249#144#0#0#0#0#0#0#0#0#0#0#144#249#249#249#249#144#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#245#246#255#8#0#0#0#0#0#0#0#0
- +#245#246#255#255#0#0#8#255#255#7#255#255#255#8#241#134#255#255#255#255#7#241
- +'Y'#255#255#255#8#0#0#0#8#255#255#255#255#7#245'1'#255#255#255#255#0#0#0#0
- +#255#255#255#7#0#0#247#255#255#8#0#0#8#255#255#7#0#0#0#0#0#8#255#255'1'#0#255
- +#255#255'1'#0#0'1'#130#0#0#0#0#0#236#249#249#144#0#0#0#0#0#0#0#0#0'H'#249#249
- +#249#249#249#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#0#0#0#0#0#0#0#245#255#255
- +#255#0#0#0#0#0#0#0#0#245#255#255#255#0#0#8#255#255#0#255#255#255#255#244#170
- +#255#255#240#255#255#255#255#255#255#255#240#0#0#0#8#255#255#7#255#255#255
- +#255#255#255#255#7#0#0#0#0#240#246#255#255#255#255#255#255#255#241#0#0#8#255
- +#255#7#0#0#0#0#0#8#255#255#7#0#7#255#255#255#255#255#255#255#240#0#0#0#0#0'$'
- +#249#249#144#0#0#0#0#0#0#0#0'$'#249#249#249#249#249#236#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#0#0#0#0#0#0#0#0#7#255#255#246#0#0#246
- +#246#255#0#240#246#255#255#241#8#246#255#0'1'#255#255#255#255#255'-'#0#0#0#0
- +#170#255#255'1'#240#246#246#255#255#255#247#0#0#0#0#0#0#241#8#255#255#255#255
- +#255#240#0#0#0#8#246#255#7#0#0#0#0#0#8#246#255#7#0#0#7#255#255#255#255#246
- +#255'-'#0#0#0#0#0#0'$'#249#249'l'#0#0#0#0#0#0#0#0#249#249#249#249#249'H'#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#246#255#255'-'#0#0#0#0#0#0#0#247
- +#255#255#130#0#0'-'#245'-'#0#0#0'1'#7#240#245'-'#245#0#0#0'1'#7'1'#0#0#0#0#0
- +#0#8#255#255'U'#0#0#245#7#7#240#0#0#0#0#0#0#0#0#0#240#7#7'-'#0#0#0#0#0#245'-'
- +#245#240#0#0#0#0#0#245'-'#245#240#0#0#0#0'1'#7#7#245#0#0#0#0#0#0#0#0#0'$'#249
- +#249'l'#0#0#0#0#0#0#0#249#249#249#249#249'l'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#247#255#255#7#0#0#0#0#0#0#0#246#255#255#7#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#209#255#7#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0'$'#249#249'l'#0#0#0#0#0#0#144#249#249#249#249#144#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0'-'#255#255#246#0#0#0#0#0#0#0#255#255#255#240#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#255#255#7#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0'$'#249#249'H'#0#0#0#0#0'H'#249#249#249#249#249#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#246#255#246#245#0#0#0#0#0#247#255#255
- +#175#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#255#246#7#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#1#249#249'$'#0#0#0#0'$'#249#249#249#249#249
- +#236#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#0#0#0#0#0#0#0#0#0'1'#255#255#246#0#0#0#0
- +#245#246#255#246'1'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#170
- +#255#255#7#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#7'1-'#7'1'#130#0#209#0#0#0#0'l'#249#249'$'#0#0#0#0
- +#249#249#249#249#249'$'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#175
- +#246#255#246'1'#245'U'#255#255#255#175#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#8#255#255#7#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#7'-'#240#170#7#246#245#8#0#0#0
- ,#0#0'l'#249#249'$'#0#0#0#249#249#249#249#249#1#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#175#255#255#255#255#255#255#255#255#240#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#255#255#7#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#7#245
- +#0#8#175'1'#7#7#0#0#0#0#0#0'l'#249#249#236#0#0#144#249#249#249#249#144#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#247#255#255#255#255#255#8#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#255#255#7#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#7'-'#0#255#247#0#175#7#0#0#0#0#0#0#0'l'#249#249#236#0#1#249#249
- +#249#249#249#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'1'#7#7
- +#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#255#255
- +#7#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#247#175#8#7#8'-'#0#247#7#0#0#0#0#0#0#0#0#144#249#249#236'$'
- +#249#249#249#249#249#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#144#249#249#236#249
- +#249#249#249#249'$'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#144#249#144#249#249#249
- +#249#249'H'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#144#249#249#249#249#249#249
- +#144#0#0#0#0#0#0#0#0#0#0#0#0#0#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#144#249#249#249#249#249#249#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#249#249#249#249#249#249#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#236#249#249#249#249#249#236#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#236#249#249#249#249'H'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#236#249#249#249'l'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#236#249
- +#249#249#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- ,#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- ,#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#236#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#236#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#236#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#236#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#7'TButton'#5'btnOK'#4'Left'
- +#3'o'#1#3'Top'#3#21#1#5'Width'#2'X'#6'Height'#2#25#6'Cancel'#9#7'Caption'#6#2
- +'OK'#11'ModalResult'#2#2#8'TabOrder'#2#1#7'OnClick'#7#10'btnOKClick'#0#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/b6/b6ddf957e489ae664fcc4d46bb6b70588946588b.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/b6/b6ddf957e489ae664fcc4d46bb6b70588946588b.svn-base
deleted file mode 100644
index 779c273a..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/pristine/b6/b6ddf957e489ae664fcc4d46bb6b70588946588b.svn-base and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/b8/b8a157850d07bd00e519e11e32dc945b9ecfb1cd.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/b8/b8a157850d07bd00e519e11e32dc945b9ecfb1cd.svn-base
deleted file mode 100644
index 34d0442f..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/b8/b8a157850d07bd00e519e11e32dc945b9ecfb1cd.svn-base
+++ /dev/null
@@ -1,38 +0,0 @@
--$A8
--$B-
--$C+
--$D+
--$E-
--$F-
--$G+
--$H+
--$I+
--$J-
--$K-
--$L+
--$M-
--$N+
--$O+
--$P+
--$Q-
--$R-
--$S-
--$T-
--$U-
--$V+
--$W-
--$X+
--$YD
--$Z1
--cg
--AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
--H+
--W+
--M
--$M16384,1048576
--K$00400000
--LE"c:\delphi7\Projects\Bpl"
--LN"c:\delphi7\Projects\Bpl"
--w-UNSAFE_TYPE
--w-UNSAFE_CODE
--w-UNSAFE_CAST
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/b8/b8aa1b16c7c407a70a44a2cd2879867b28503ada.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/b8/b8aa1b16c7c407a70a44a2cd2879867b28503ada.svn-base
deleted file mode 100644
index 63dd1eda..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/pristine/b8/b8aa1b16c7c407a70a44a2cd2879867b28503ada.svn-base and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/bb/bb14de7678a7f7b0bb3d531dad36be86669434b5.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/bb/bb14de7678a7f7b0bb3d531dad36be86669434b5.svn-base
deleted file mode 100644
index 8131baf7..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/pristine/bb/bb14de7678a7f7b0bb3d531dad36be86669434b5.svn-base and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/bc/bc80ebc82c4971ce604e1de2ad3304055e6ee438.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/bc/bc80ebc82c4971ce604e1de2ad3304055e6ee438.svn-base
deleted file mode 100644
index 7ff0c4d0..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/bc/bc80ebc82c4971ce604e1de2ad3304055e6ee438.svn-base
+++ /dev/null
@@ -1,33 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 440
- Height = 336
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'MS Sans Serif'
- Font.Style = []
- OldCreateOrder = False
- PixelsPerInch = 96
- TextHeight = 13
- object OvcCalendar1: TOvcCalendar
- Left = 56
- Top = 40
- Width = 313
- Height = 209
- BorderStyle = bsNone
- Colors.ActiveDay = clRed
- Colors.ColorScheme = cscalCustom
- Colors.DayNames = clMaroon
- Colors.Days = clBlack
- Colors.InactiveDays = clGray
- Colors.MonthAndYear = clBlue
- Colors.Weekend = clRed
- DayNameWidth = 3
- Options = [cdoShortNames, cdoShowYear, cdoShowInactive, cdoShowRevert, cdoShowToday, cdoShowNavBtns]
- TabOrder = 0
- end
-end
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/bc/bcb57c867d55831dd4d87deafb4ccba9fa18bfbf.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/bc/bcb57c867d55831dd4d87deafb4ccba9fa18bfbf.svn-base
deleted file mode 100644
index 257f4f0f..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/bc/bcb57c867d55831dd4d87deafb4ccba9fa18bfbf.svn-base
+++ /dev/null
@@ -1,48 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 386
- Height = 340
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'MS Sans Serif'
- Font.Style = []
- OldCreateOrder = False
- PixelsPerInch = 96
- TextHeight = 13
- object OvcLabel1: TOvcLabel
- Left = 64
- Top = 32
- Width = 257
- Height = 49
- Caption = 'Fancy Raised Label'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clGray
- Font.Height = -26
- Font.Name = 'Times New Roman'
- Font.Style = []
- ParentColor = False
- end
- object OvcLabel2: TOvcLabel
- Left = 64
- Top = 112
- Width = 257
- Height = 49
- Appearance = apSunken
- Caption = 'Fancy Sunken Label'
- Color = clBtnFace
- ColorScheme = csCustom
- CustomSettings.HighlightDirection = sdDownRight
- CustomSettings.ShadowDirection = sdUpLeft
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clGray
- Font.Height = -26
- Font.Name = 'Times New Roman'
- Font.Style = []
- ParentColor = False
- end
-end
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/bd/bd0b4b536fc0a99a9c4650181d3c07114979ec33.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/bd/bd0b4b536fc0a99a9c4650181d3c07114979ec33.svn-base
deleted file mode 100644
index c84b904b..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/bd/bd0b4b536fc0a99a9c4650181d3c07114979ec33.svn-base
+++ /dev/null
@@ -1,1808 +0,0 @@
-{*********************************************************}
-{* OVCNF.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 ovcnf;
- {-Numeric field visual component}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Classes, Controls, Forms, Graphics, Menus, SysUtils,
- OvcBase, OvcCaret, OvcColor, OvcConst, OvcData, OvcEF, OvcExcpt,
- OvcMisc, OvcPB, OvcStr;
-
-type
- {numeric field types}
- TNumericDataType = (
- nftLongInt, nftWord, nftInteger, nftByte, nftShortInt, nftReal,
- nftExtended, nftDouble, nftSingle, nftComp);
-
-type
- TOvcCustomNumericField = class(TOvcPictureBase)
- {.Z+}
- protected {private}
- {property instance variables}
- FNumericDataType : TNumericDataType;
- FPictureMask : string;
-
- {private instance variables}
- nfMaxLen : Word; {maximum length of numeric string}
- nfMaxDigits : Word; {maximum # of digits to left of decimal}
- nfPlaces : Word; {# of decimal places}
- nfMinus : Boolean; {true if number is negative}
- nfTmp : TEditString; {temporary input string}
-
- function nfGetDataType(Value : TNumericDataType) : Byte;
- {-return a Byte value representing the data type of this field}
- procedure nfReloadTmp;
- {-reload Tmp from efEditSt, etc.}
- procedure nfResetFieldProperties(FT : TNumericDataType);
- {-reset field properties}
- procedure nfSetDefaultRanges;
- {-set default range values based on the field type}
- procedure nfSetMaxLength(Mask : PAnsiChar);
- {-determine and set MaxLength}
-
- procedure WMSetFocus(var Msg : TWMSetFocus);
- message WM_SETFOCUS;
- procedure WMKillFocus(var Msg : TWMKillFocus);
- message WM_KILLFOCUS;
-
- protected
- {VCL methods}
- procedure CreateParams(var Params : TCreateParams);
- override;
- procedure CreateWnd;
- override;
-
- procedure efCaretToEnd;
- override;
- {-move the caret to the end of the field}
- procedure efCaretToStart;
- override;
- {-move the caret to the beginning of the field}
- procedure efChangeMask(Mask : PAnsiChar);
- override;
- {-change the picture mask}
- procedure efEdit(var Msg : TMessage; Cmd : Word);
- override;
- {-process the specified editing command}
- function efGetDisplayString(Dest : PAnsiChar; Size : Word) : PAnsiChar;
- override;
- {-return the display string in Dest and a pointer as the result}
- procedure efIncDecValue(Wrap : Boolean; Delta : Double);
- override;
- {-increment field by Delta}
- function efTransfer(DataPtr : Pointer; TransferFlag : Word) : Word;
- override;
- {-transfer data to/from the entry fields}
- procedure pbRemoveSemiLits;
- override;
- {-remove semi-literal mask characters from the edit string}
-
- {virtual property methods}
- procedure efSetCaretPos(Value : Integer);
- override;
- {-set position of caret within the field}
- procedure nfSetDataType(Value : TNumericDataType);
- virtual;
- {-set the data type for this field}
- procedure nfSetPictureMask(const Value : string);
- virtual;
- {-set the picture mask}
-
- public
- procedure Assign(Source : TPersistent);
- override;
- constructor Create(AOwner: TComponent);
- override;
-
- function efValidateField : Word;
- override;
- {-validate contents of field; result is error code or 0}
- {.Z-}
-
- {public properties}
- property DataType : TNumericDataType
- read FNumericDataType
- write nfSetDataType;
-
- property PictureMask : string
- read FPictureMask
- write nfSetPictureMask;
- end;
-
- TOvcNumericField = class(TOvcCustomNumericField)
- published
- {inherited properties}
- property DataType; {needs to loaded before most other properties}
- {$IFDEF VERSION4}
- property Anchors;
- property Constraints;
- property DragKind;
- {$ENDIF}
- property AutoSize;
- property BorderStyle;
- property CaretIns;
- property CaretOvr;
- property Color;
- property Controller;
- property Ctl3D;
- property Borders;
- property DragCursor;
- property DragMode;
- property EFColors;
- property Enabled;
- property Font;
- property LabelInfo;
- property Options;
- property PadChar;
- property ParentColor;
- property ParentCtl3D;
- property ParentFont;
- property ParentShowHint;
- property PictureMask;
- property PopupMenu;
- property RangeHi stored False;
- property RangeLo stored False;
- property ShowHint;
- property TabOrder;
- property TabStop default True;
- property Tag;
- property TextMargin;
- property Uninitialized;
- property Visible;
- property ZeroDisplay;
- property ZeroDisplayValue;
-
- {inherited events}
- property AfterEnter;
- property AfterExit;
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnError;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnMouseWheel;
- property OnStartDrag;
- property OnUserCommand;
- property OnUserValidation;
- end;
-
-
-implementation
-
-
-{*** TOvcCustomNumericField ***}
-
-procedure TOvcCustomNumericField.Assign(Source : TPersistent);
-var
- NF : TOvcCustomNumericField absolute Source;
-begin
- if (Source <> nil) and (Source is TOvcCustomNumericField) then begin
- DataType := NF.DataType;
- AutoSize := NF.AutoSize;
- BorderStyle := NF.BorderStyle;
- Color := NF.Color;
- EFColors.Error.Assign(NF.EFColors.Error);
- EFColors.Highlight.Assign(NF.EFColors.Highlight);
- Options := NF.Options;
- PadChar := NF.PadChar;
- PictureMask := NF.PictureMask;
- RangeHi := NF.RangeHi;
- RangeLo := NF.RangeLo;
- TextMargin := NF.TextMargin;
- Uninitialized := NF.Uninitialized;
- ZeroDisplay := NF.ZeroDisplay;
- ZeroDisplayValue := NF.ZeroDisplayValue;
- end else
- inherited Assign(Source);
-end;
-
-constructor TOvcCustomNumericField.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
-
- FNumericDataType := nftLongInt;
- FPictureMask := 'iiiiiiiiiii';
- efFieldClass := fcNumeric;
- efDataType := nfGetDataType(FNumericDataType);
- efRangeHi.rtLong := High(LongInt);
- efRangeLo.rtLong := Low(LongInt);
-end;
-
-procedure TOvcCustomNumericField.CreateParams(var Params: TCreateParams);
-begin
- inherited CreateParams(Params);
-
- pfSelPos := 0;
-
- {get current picture string}
- StrPLCopy(efPicture, FPictureMask, MaxPicture);
-
- {set MaxLength based on picture mask}
- nfSetMaxLength(efPicture);
-
- FillChar(nfTmp, SizeOf(nfTmp), #0);
- pfSemiLits := 0;
- pbCalcWidthAndPlaces(nfMaxLen, nfPlaces);
-
- {adjust max length for decimal point if needed}
- nfMaxDigits := nfMaxLen;
- if nfPlaces <> 0 then
- Dec(nfMaxDigits, nfPlaces+1);
-end;
-
-procedure TOvcCustomNumericField.CreateWnd;
-var
- P : array[0..MaxEditLen+1] of Byte;
-begin
- {save field data}
- if efSaveData then
- efTransfer(@P, otf_GetData);
-
- inherited CreateWnd;
-
- {try to optimize InitPictureFlags}
- pbOptimizeInitPictureFlags;
-
- pfSemiLits := 0;
- nfSetDefaultRanges;
- efSetInitialValue;
-
- {if we saved the field data, restore it}
- if efSaveData then
- efTransfer(@P, otf_SetData);
-
- {set save data flag}
- efSaveData := True;
-end;
-
-procedure TOvcCustomNumericField.efCaretToEnd;
- {-move the caret to the end of the field}
-begin
- efHPos := efEditEnd + 1;
-end;
-
-procedure TOvcCustomNumericField.efCaretToStart;
- {-move the caret to the beginning of the field}
-begin
- efHPos := efEditEnd + 1;
-end;
-
-procedure TOvcCustomNumericField.efChangeMask(Mask : PAnsiChar);
- {-change the picture mask}
-begin
- inherited efChangeMask(Mask);
-
- pfSemiLits := 0;
- pbCalcWidthAndPlaces(nfMaxLen, nfPlaces);
-
- {set MaxLength based on picture mask}
- nfSetMaxLength(Mask);
- nfMaxDigits := nfMaxLen;
- if nfPlaces <> 0 then
- Dec(nfMaxDigits, nfPlaces+1);
-end;
-
-procedure TOvcCustomNumericField.efEdit(var Msg : TMessage; Cmd : Word);
- {-process the specified editing command}
-label
- ExitPoint;
-var
- MF : Byte;
- Ch : AnsiChar;
- HaveSel : Boolean;
- PicChar : AnsiChar;
- StLen : Word;
- StBgn : Word;
- StEnd : Word;
- DotPos : Cardinal;
- Found : Boolean;
-
- function MinusVal : Byte;
- begin
- if nfMinus then
- Result := 1
- else
- Result := 0;
- end;
-
- procedure ClearString;
- {-clear the string being edited}
- begin
- nfTmp[0] := #0;
- nfMinus := False;
- StLen := 0;
- end;
-
- function CharIsOK : Boolean;
- {-return true if Ch can be added to the string}
- begin
- Result := (Ch >= ' ');
- end;
-
- function CheckAutoAdvance(SP : Integer) : Boolean;
- {-see if we need to auto-advance to next/previous field}
- begin
- Result := False;
- if (SP < 0) and
- (efoAutoAdvanceLeftRight in Controller.EntryOptions) then begin
- efMoveFocusToPrevField;
- Result := True;
- end else if (SP > 0) then
- if (Cmd = ccChar) and
- (efoAutoAdvanceChar in Controller.EntryOptions) then begin
- efMoveFocusToNextField;
- Result := True;
- end else if (Cmd <> ccChar) and
- (efoAutoAdvanceLeftRight in Controller.EntryOptions) then begin
- efMoveFocusToNextField;
- Result := True;
- end;
- end;
-
- procedure DeleteChar;
- {-delete char at end of string}
- begin
- if (StLen = 0) then
- if not nfMinus then
- Exit
- else
- nfMinus := False
- else begin
- {remove the last character}
- nfTmp[StLen-1] := #0;
- Dec(StLen);
-
- {if all that's left is a 0, remove it}
- if (StLen = 1) and (nfTmp[0] = '0') then
- nfTmp[0] := #0;
- end;
- MF := 10;
- end;
-
- procedure DeleteSel;
- begin
- ClearString;
- efSelStart := 0;
- efSelEnd := 0;
- MF := 10;
- end;
-
- function InsertChar : Boolean;
- {-insert Ch}
- var
- tDotPos : Cardinal;
- tFound : Boolean;
-
- function DigitCount : Word;
- {-return number of digits to left of decimal place in St}
- begin
- if tFound then
- Result := tDotPos + MinusVal
- else
- Result := StLen + MinusVal;
- end;
-
- begin
- Result := False;
-
- {reject spaces}
- if (Ch = ' ') then
- Exit;
-
- {ok to add decimal point?}
- tFound := StrChPos(nfTmp, pmDecimalPt, tDotPos);
- if (Ch = pmDecimalPt) then
- if not Found or tFound then
- Exit;
-
- if (Ch = '-') then begin
- {minus sign treated as toggle}
- if nfMinus then
- nfMinus := False
- else begin
- nfMinus := (DigitCount < nfMaxDigits) and (StLen < nfMaxLen);
- if not nfMinus then
- Exit;
- end
- end else if (StLen+MinusVal < nfMaxLen) then begin
- {don't allow initial zeros}
- if (Ch = '0') and (StLen = 0) then begin
- Result := True;
- Exit;
- end;
-
- {check for too many digits to left of decimal point}
- if Found and (Ch <> pmDecimalPt) then
- if not tFound and (DigitCount >= nfMaxDigits) then
- Exit;
-
- {append the character}
- nfTmp[StLen] := Ch;
- Inc(StLen);
- nfTmp[StLen] := #0;
- end else if (nfMaxLen = 1) then
- if (Ch = pmDecimalPt) then
- Exit
- else
- {overwrite the character}
- nfTmp[0] := Ch
- else
- Exit;
-
- Result := True;
- end;
-
- procedure Adjust;
- {-adjust display string to show correct number of decimal places}
- var
- Delta : Integer;
- ActPlaces : Integer;
- DP : Cardinal;
- Len : Word;
- ExDec : TEditString;
- begin
- Len := StrLen(nfTmp);
- if not StrChPos(nfTmp, pmDecimalPt, DP) then
- Delta := nfPlaces+1
- else begin
- ActPlaces := Len-Succ(DP);
- Delta := nfPlaces-ActPlaces;
- end;
-
- if Delta = 0 then
- Exit;
-
- if Delta > 0 then begin
- StrStDeletePrim(efEditSt, StEnd-Pred(Delta), Delta);
- StrStInsertPrim(efEditSt, CharStrPChar(ExDec, ' ', Delta), StBgn);
- end else begin
- Delta := -Delta;
- StrStCopy(ExDec, nfTmp, DP+nfPlaces+1, Delta);
- StrStDeletePrim(efEditSt, StBgn, Delta);
- StrStInsertPrim(efEditSt, ExDec, StEnd-Pred(Delta));
- end;
- end;
-
- procedure UpdateEditSt;
- {-update efEditSt}
- begin
- StrCopy(efEditSt, nfTmp);
- case efEditSt[0] of
- #0 :
- begin
- {string is empty, put in a 0}
- efEditSt[0] := '0';
- efEditSt[1] := #0;
- end;
- '.' :
- StrChInsertPrim(efEditSt, '0', 0);
- end;
-
- {prepend the minus sign}
- if nfMinus then
- StrChInsertPrim(efEditSt, '-', 0);
-
- pbMergePicture(efEditSt, efEditSt);
- if Found then
- Adjust;
- end;
-
- procedure UpdateSel(Delta : Integer);
- begin
- if Delta <> 0 then begin
- efSelStart := 0;
- efSelEnd := MaxEditLen;
- end else begin
- efSelStart := 0;
- efSelEnd := 0;
- end;
- end;
-
- procedure PastePrim(P : PAnsiChar);
- begin
- if HaveSel then
- DeleteSel;
- while P^ <> #0 do begin
- Ch := P^;
- if (Ch = '(') then
- if StrScan(efPicture, pmNegParens) <> nil then
- if StrScan(P, ')') <> nil then
- Ch := '-';
- if (Ch <> '-') or not nfMinus then
- if (StLen+MinusVal <= nfMaxLen) then begin
- if Ch = IntlSupport.DecimalChar then
- Ch := pmDecimalPt
- else if Ch = pmDecimalPt then
- Ch := #0;
- if efCharOK(PicChar, Ch, #255, True) then
- if InsertChar then
- MF := 10
- end;
- Inc(P);
- end;
- end;
-
-begin {edit}
- HaveSel := efSelStart <> efSelEnd;
- MF := Ord(HaveSel);
-
- case Cmd of
- ccAccept : ;
- else
- if not (sefFixSemiLits in sefOptions) then
- pbRemoveSemiLits;
-
- Exclude(sefOptions, sefLiteral);
- end;
-
- StBgn := efEditBegin;
- StEnd := efEditEnd;
- StLen := StrLen(nfTmp);
- PicChar := efNthMaskChar(efHPos-1);
- Found := StrChPos(efPicture, pmDecimalPt, DotPos);
-
- Exclude(sefOptions, sefCharOK);
- case Cmd of
- ccChar :
- begin
- Ch := AnsiChar(Lo(Msg.wParam));
- if not (sefAcceptChar in sefOptions) then
- Exit
- else begin
- Exclude(sefOptions, sefAcceptChar);
- if HaveSel and CharIsOk then
- DeleteSel;
- if StLen+MinusVal <= nfMaxLen then begin
- if Ch = IntlSupport.DecimalChar then
- Ch := pmDecimalPt
- else if Ch = pmDecimalPt then
- Ch := #0;
- if not efCharOK(PicChar, Ch, #255, True) then
- efConditionalBeep
- else begin
- if InsertChar then begin
- if (Ch <> '-') and (StLen+MinusVal = nfMaxLen) then
- CheckAutoAdvance(1);
- MF := 10;
- end else
- efConditionalBeep;
- end;
- end else if not CheckAutoAdvance(1) then
- efConditionalBeep;
- end;
- end;
- ccLeft, ccWordLeft :
- CheckAutoAdvance(-1);
- ccRight, ccWordRight :
- CheckAutoAdvance(1);
- ccUp :
- if (efoAutoAdvanceUpDown in Controller.EntryOptions) then
- efMoveFocusToPrevField
- else if (efoArrowIncDec in Options) and
- not (efoReadOnly in Options) then
- IncreaseValue(True, 1)
- else
- CheckAutoAdvance(-1);
- ccDown :
- if (efoAutoAdvanceUpDown in Controller.EntryOptions) then
- efMoveFocusToNextField
- else if (efoArrowIncDec in Options) and not (efoReadOnly in Options) then
- DecreaseValue(True, 1)
- else
- CheckAutoAdvance(1);
- ccMouse :
- begin
- efSelStart := 0;
- efSelEnd := 0;
- end;
- ccDblClk :
- SetSelection(0, MaxEditLen);
- ccHome, ccEnd : {do nothing};
- ccBack, ccDel :
- if HaveSel then
- DeleteSel
- else
- DeleteChar;
- ccDelWord :
- if HaveSel then
- DeleteSel;
- ccExtendLeft :
- UpdateSel(-1);
- ccExtendRight :
- UpdateSel(+1);
- ccExtWordLeft, ccExtendHome :
- UpdateSel(-MaxEditLen);
- ccExtWordRight, ccExtendEnd :
- UpdateSel(+MaxEditLen);
- ccCut :
- if HaveSel then
- DeleteSel;
- ccCopy : efCopyPrim;
- ccPaste :
- {for some reason, a paste action within the IDE}
- {gets passed to the control. filter it out}
- if not (csDesigning in ComponentState) then
- PastePrim(PAnsiChar(Msg.lParam));
- ccDelLine :
- begin
- ClearString;
- MF := 10;
- end;
- ccIns :
- begin
- if sefInsert in sefOptions then
- Exclude(sefOptions, sefInsert)
- else
- Include(sefOptions, sefInsert);
- efCaret.InsertMode := (sefInsert in sefOptions);
- end;
- ccRestore :
- begin
- Restore;
- nfReloadTmp;
- end;
- ccAccept :
- begin
- Include(sefOptions, sefCharOK);
- Include(sefOptions, sefAcceptChar);
- Exit;
- end;
- ccCtrlChar : {};
- ccDec :
- DecreaseValue(True, 1);
- ccInc :
- IncreaseValue(True, 1);
- ccSuppress, ccPartial :
- goto ExitPoint;
- else
- Include(sefOptions, sefCharOK);
- end;
- Exclude(sefOptions, sefAcceptChar);
-
- case Cmd of
- ccMouse : {};
- ccRestore, ccDblClk,
- ccExtendLeft, ccExtendRight, ccExtendEnd,
- ccExtendHome, ccExtWordLeft, ccExtWordRight :
- Inc(MF);
- ccCut, ccCopy, ccPaste : {};
- else
- efSelStart := efHPos;
- efSelEnd := efHPos;
- end;
-
-
-ExitPoint:
- if MF >= 10 then begin
- UpdateEditSt;
- efFieldModified;
- end;
- if efPositionCaret(True) then
- Inc(MF);
- if MF > 0 then
- Invalidate;
-end;
-
-function TOvcCustomNumericField.efGetDisplayString(Dest : PAnsiChar; Size : Word) : PAnsiChar;
- {-return the display string in Dest and a pointer as the result}
-var
- I, J : Cardinal;
- Found : Boolean;
-begin
- Result := inherited efGetDisplayString(Dest, Size);
-
- if Uninitialized and not (sefHaveFocus in sefOptions) then
- Exit;
-
- Found := StrChPos(Dest, '-', I);
- if StrChPos(efPicture, pmNegParens, J) then
- if not Found then
- Dest[J] := ' '
- else begin
- Dest[I] := '(';
- Dest[J] := ')';
- end;
-
- if StrChPos(efPicture, pmNegHere, J) then
- if not Found then
- Dest[J] := ' '
- else begin
- Dest[J] := '-';
- J := efEditBegin;
- if J = I then
- Dest[I] := ' '
- else begin
- StrChDeletePrim(Dest, I);
- StrChInsertPrim(Dest, ' ', J);
- end;
- end;
-
- TrimAllSpacesPChar(Dest);
-end;
-
-procedure TOvcCustomNumericField.efIncDecValue(Wrap : Boolean; Delta : Double);
- {-increment field by Delta}
-var
- Code : Integer;
-
- procedure IncDecValueLongInt;
- var
- L : LongInt;
- S : TEditString;
- begin
- pbStripPicture(S, efEditSt);
-
- if efStr2Long(S, L) then begin
- if (Delta < 0) and (L <= efRangeLo.rtLong) then
- if Wrap then
- L := efRangeHi.rtLong
- else
- Exit
- else if (Delta > 0) and (L >= efRangeHi.rtLong) then
- if Wrap then
- L := efRangeLo.rtLong
- else
- Exit
- else
- Inc(L, Trunc(Delta));
-
- {insure valid value}
- if L < efRangeLo.rtLong then
- L := efRangeLo.rtLong;
- if L > efRangeHi.rtLong then
- L := efRangeHi.rtLong;
-
- efTransfer(@L, otf_SetData);
- nfReloadTmp;
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueReal;
- var
- Re : Real;
- S : TEditString;
- begin
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Re, Code);
-{$ELSE}
- Val(string(S), Re, Code);
-{$ENDIF}
-
- if Code = 0 then begin
- if (Delta < 0) and (Re <= efRangeLo.rtReal) then
- if Wrap then
- Re := efRangeHi.rtReal
- else
- Exit
- else if (Delta > 0) and (Re >= efRangeHi.rtReal) then
- if Wrap then
- Re := efRangeLo.rtReal
- else
- Exit
- else
- Re := Re + Delta;
-
- {insure valid value}
- if Re < efRangeLo.rtReal then
- Re := efRangeLo.rtReal;
- if Re > efRangeHi.rtReal then
- Re := efRangeHi.rtReal;
-
- efTransfer(@Re, otf_SetData);
- nfReloadTmp;
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueExtended;
- var
- Ex : Extended;
- S : TEditString;
- begin
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Ex, Code);
-{$ELSE}
- Val(string(S), Ex, Code);
-{$ENDIF}
-
- if Code = 0 then begin
- if (Delta < 0) and (Ex <= efRangeLo.rtExt) then
- if Wrap then
- Ex := efRangeHi.rtExt
- else
- Exit
- else if (Delta > 0) and (Ex >= efRangeHi.rtExt) then
- if Wrap then
- Ex := efRangeLo.rtExt
- else
- Exit
- else
- Ex := Ex + Delta;
-
- {insure valid value}
- if Ex < efRangeLo.rtExt then
- Ex := efRangeLo.rtExt;
- if Ex > efRangeHi.rtExt then
- Ex := efRangeHi.rtExt;
-
- efTransfer(@Ex, otf_SetData);
- nfReloadTmp;
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueDouble;
- var
- Db : Double;
- S : TEditString;
- begin
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Db, Code);
-{$ELSE}
- Val(string(S), Db, Code);
-{$ENDIF}
-
- if Code = 0 then begin
- if (Delta < 0) and (Db <= efRangeLo.rtExt) then
- if Wrap then
- Db := efRangeHi.rtExt
- else
- Exit
- else if (Delta > 0) and (Db >= efRangeHi.rtExt) then
- if Wrap then
- Db := efRangeLo.rtExt
- else
- Exit
- else
- Db := Db + Delta;
-
- {insure valid value}
- if Db < efRangeLo.rtExt then
- Db := efRangeLo.rtExt;
- if Db > efRangeHi.rtExt then
- Db := efRangeHi.rtExt;
-
- efTransfer(@Db, otf_SetData);
- nfReloadTmp;
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueSingle;
- var
- Si : Single;
- S : TEditString;
- begin
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Si, Code);
-{$ELSE}
- Val(string(S), Si, Code);
-{$ENDIF}
-
- if Code = 0 then begin
- if (Delta < 0) and (Si <= efRangeLo.rtExt) then
- if Wrap then
- Si := efRangeHi.rtExt
- else
- Exit
- else if (Delta > 0) and (Si >= efRangeHi.rtExt) then
- if Wrap then
- Si := efRangeLo.rtExt
- else
- Exit
- else
- Si := Si + Delta;
-
- {insure valid value}
- if Si < efRangeLo.rtExt then
- Si := efRangeLo.rtExt;
- if Si > efRangeHi.rtExt then
- Si := efRangeHi.rtExt;
-
- efTransfer(@Si, otf_SetData);
- nfReloadTmp;
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueComp;
- var
-{$IFNDEF FPC}
- Co : Comp;
-{$ELSE}
- {$IFDEF CPU86}
- Co : Comp;
- {$ELSE}
- Co : Double;
- {$ENDIF}
-{$ENDIF}
- S : TEditString;
- begin
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Co, Code);
-{$ELSE}
- Val(string(S), Co, Code);
-{$ENDIF}
-
- if Code = 0 then begin
- if (Delta < 0) and (Co <= efRangeLo.rtExt) then
- if Wrap then
- Co := efRangeHi.rtExt
- else
- Exit
- else if (Delta > 0) and (Co >= efRangeHi.rtExt) then
- if Wrap then
- Co := efRangeLo.rtExt
- else
- Exit
- else
- Co := Co + Delta;
-
- {insure valid value}
- if Co < efRangeLo.rtExt then
- Co := efRangeLo.rtExt;
- if Co > efRangeHi.rtExt then
- Co := efRangeHi.rtExt;
-
- efTransfer(@Co, otf_SetData);
- nfReloadTmp;
- efPerformRepaint(True);
- end;
- end;
-
-begin
- if not (sefHaveFocus in sefOptions) then
- Exit;
-
- case FNumericDataType of
- nftLongInt,
- nftWord,
- nftInteger,
- nftByte,
- nftShortInt : IncDecValueLongInt;
- nftReal : IncDecValueReal;
- nftExtended : IncDecValueExtended;
- nftDouble : IncDecValueDouble;
- nftSingle : IncDecValueSingle;
- nftComp : IncDecValueComp;
- end;
- efPositionCaret(False);
-end;
-
-procedure TOvcCustomNumericField.efSetCaretPos(Value : Integer);
- {-set position of caret within the field}
-begin
- {do nothing}
-end;
-
-function TOvcCustomNumericField.efTransfer(DataPtr : Pointer; TransferFlag : Word) : Word;
- {-transfer data to/from the entry fields}
-var
- E : Extended;
-
- procedure TransferLongInt;
- var
- S : TEditString;
- begin
- if TransferFlag = otf_GetData then begin
- pbStripPicture(S, efEditSt);
-
- if not efStr2Long(S, LongInt(DataPtr^)) then
- LongInt(DataPtr^) := 0;
- end else begin
- efLong2Str(S, LongInt(DataPtr^));
- pbMergePicture(efEditSt, S);
- end;
- end;
-
- procedure TransferWord;
- var
- L : LongInt;
- S : TEditString;
- begin
- if TransferFlag = otf_GetData then begin
- pbStripPicture(S, efEditSt);
-
- if efStr2Long(S, L) then
- Word(DataPtr^) := L
- else
- Word(DataPtr^) := 0;
- end else begin
- efLong2Str(S, Word(DataPtr^));
- pbMergePicture(efEditSt, S);
- end;
- end;
-
- procedure TransferInteger;
- var
- L : LongInt;
- S : TEditString;
- begin
- if TransferFlag = otf_GetData then begin
- pbStripPicture(S, efEditSt);
-
- if efStr2Long(S, L) then
- SmallInt(DataPtr^) := L
- else
- SmallInt(DataPtr^) := 0;
- end else begin
- efLong2Str(S, SmallInt(DataPtr^));
- pbMergePicture(efEditSt, S);
- end;
- end;
-
- procedure TransferByte;
- var
- L : LongInt;
- S : TEditString;
- begin
- if TransferFlag = otf_GetData then begin
- pbStripPicture(S, efEditSt);
-
- if efStr2Long(S, L) then
- Byte(DataPtr^) := L
- else
- Byte(DataPtr^) := 0;
- end else begin
- efLong2Str(S, Byte(DataPtr^));
- pbMergePicture(efEditSt, S);
- end;
- end;
-
- procedure TransferShortInt;
- var
- L : LongInt;
- S : TEditString;
- begin
- if TransferFlag = otf_GetData then begin
- pbStripPicture(S, efEditSt);
-
- if efStr2Long(S, L) then
- ShortInt(DataPtr^) := L
- else
- ShortInt(DataPtr^) := 0;
- end else begin
- efLong2Str(S, ShortInt(DataPtr^));
- pbMergePicture(efEditSt, S);
- end;
- end;
-
- procedure TransferReal;
- var
- Code : Integer;
- Places : Word;
- R : Real;
- S : TEditString;
- Width : Word;
- begin
- if TransferFlag = otf_GetData then begin
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, R, Code);
-{$ELSE}
- Val(string(S), R, Code);
-{$ENDIF}
-
- if Code <> 0 then
- R := 0;
- Real(DataPtr^) := R;
- end else begin
- pbCalcWidthAndPlaces(Width, Places);
- Str(Real(DataPtr^):Width:Places, S);
- if DecimalPlaces <> 0 then
- TrimTrailingZerosPChar(S)
- else
- TrimAllSpacesPChar(S);
- pbMergePicture(efEditSt, S);
- end;
- end;
-
- procedure TransferExtended;
- var
- Code : Integer;
- Places : Word;
- S : TEditString;
- Width : Word;
- begin
- if TransferFlag = otf_GetData then begin
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, E, Code);
-{$ELSE}
- Val(string(S), E, Code);
-{$ENDIF}
-
- if Code <> 0 then
- E := 0;
- Extended(DataPtr^) := E;
- end else begin
- pbCalcWidthAndPlaces(Width, Places);
- Str(Extended(DataPtr^):Width:Places, S);
- if DecimalPlaces <> 0 then
- TrimTrailingZerosPChar(S)
- else
- TrimAllSpacesPChar(S);
- pbMergePicture(efEditSt, S);
- end;
- end;
-
- procedure TransferDouble;
- var
- D : Double;
- Code : Integer;
- Places : Word;
- S : TEditString;
- Width : Word;
- begin
- if TransferFlag = otf_GetData then begin
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, D, Code);
-{$ELSE}
- Val(string(S), D, Code);
-{$ENDIF}
-
- if Code <> 0 then
- D := 0;
- Double(DataPtr^) := D;
- end else begin
- pbCalcWidthAndPlaces(Width, Places);
- Str(Double(DataPtr^):Width:Places, S);
- if DecimalPlaces <> 0 then
- TrimTrailingZerosPChar(S)
- else
- TrimAllSpacesPChar(S);
- pbMergePicture(efEditSt, S);
- end;
- end;
-
- procedure TransferSingle;
- var
- Code : Integer;
- G : Single;
- Places : Word;
- S : TEditString;
- Width : Word;
- begin
- if TransferFlag = otf_GetData then begin
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, G, Code);
-{$ELSE}
- Val(string(S), G, Code);
-{$ENDIF}
-
- if Code <> 0 then
- G := 0;
- Single(DataPtr^) := G;
- end else begin
- pbCalcWidthAndPlaces(Width, Places);
- Str(Single(DataPtr^):Width:Places, S);
- if DecimalPlaces <> 0 then
- TrimTrailingZerosPChar(S)
- else
- TrimAllSpacesPChar(S);
- pbMergePicture(efEditSt, S);
- end;
- end;
-
- procedure TransferComp;
- var
-{$IFNDEF FPC}
- C : Comp;
-{$ELSE}
- {$IFDEF CPU86}
- C : Comp;
- {$ELSE}
- C : Double;
- {$ENDIF}
-{$ENDIF}
- Code : Integer;
- Places : Word;
- S : TEditString;
- Width : Word;
- begin
- if TransferFlag = otf_GetData then begin
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, C, Code);
-{$ELSE}
- Val(string(S), C, Code);
-{$ENDIF}
-
- if Code <> 0 then
- C := 0;
-{$IFNDEF FPC}
- Comp(DataPtr^) := C;
-{$ELSE}
- {$IFDEF CPU86}
- Comp(DataPtr^) := C;
- {$ELSE}
- Double(DataPtr^) := C;
- {$ENDIF}
-{$ENDIF}
- end else begin
- pbCalcWidthAndPlaces(Width, Places);
-{$IFNDEF FPC}
- Str(Comp(DataPtr^):Width:Places, S);
-{$ELSE}
- {$IFDEF CPU86}
- Str(Comp(DataPtr^):Width:Places, S);
- {$ELSE}
- Str(Double(DataPtr^):Width:Places, S);
- {$ENDIF}
-{$ENDIF}
- if DecimalPlaces <> 0 then
- TrimTrailingZerosPChar(S)
- else
- TrimAllSpacesPChar(S);
- pbMergePicture(efEditSt, S);
- end;
- end;
-
-begin {transfer}
- if DataPtr = nil then begin
- Result := 0;
- Exit;
- end;
-
- case FNumericDataType of
- nftLongInt : TransferLongInt;
- nftWord : TransferWord;
- nftInteger : TransferInteger;
- nftByte : TransferByte;
- nftShortInt : TransferShortInt;
- nftReal : TransferReal;
- nftExtended : TransferExtended;
- nftDouble : TransferDouble;
- nftSingle : TransferSingle;
- nftComp : TransferComp;
- end;
- Result := inherited efTransfer(DataPtr, TransferFlag);
-end;
-
-function TOvcCustomNumericField.efValidateField : Word;
- {-validate contents of field; result is error code or 0}
-
- procedure ValidateLongInt;
- var
- L : LongInt;
- S : TEditString;
- begin
- pbStripPicture(S, efEditSt);
-
- if not efStr2Long(S, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- efTransfer(@L, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateWord;
- var
- L : LongInt;
- W : Word;
- S : TEditString;
- begin
- pbStripPicture(S, efEditSt);
-
- if not efStr2Long(S, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- W := L;
- efTransfer(@W, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateInteger;
- var
- L : LongInt;
- I : Integer;
- S : TEditString;
- begin
- pbStripPicture(S, efEditSt);
-
- if not efStr2Long(S, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- I := L;
- efTransfer(@I, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateByte;
- var
- L : LongInt;
- B : Byte;
- S : TEditString;
- begin
- pbStripPicture(S, efEditSt);
-
- if not efStr2Long(S, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- B := L;
- efTransfer(@B, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateShortInt;
- var
- L : LongInt;
- Si : Byte;
- S : TEditString;
- begin
- pbStripPicture(S, efEditSt);
-
- if not efStr2Long(S, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- Si := L;
- efTransfer(@Si, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateReal;
- var
- R : Real;
- Code : Integer;
- S : TEditString;
- begin
- {convert efEditSt to a real}
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, R, Code);
-{$ELSE}
- Val(string(S), R, Code);
-{$ENDIF}
-
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (R < efRangeLo.rtReal) or (R > efRangeHi.rtReal) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- efTransfer(@R, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateExtended;
- var
- E : Extended;
- Code : Integer;
- S : TEditString;
- begin
- {convert efEditSt to an extended}
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, E, Code);
-{$ELSE}
- Val(string(S), E, Code);
-{$ENDIF}
-
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (E < efRangeLo.rtExt) or (E > efRangeHi.rtExt) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- efTransfer(@E, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateDouble;
- var
- E : Extended;
- D : Double;
- Code : Integer;
- S : TEditString;
- begin
- {convert efEditSt to an extended}
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, E, Code);
-{$ELSE}
- Val(string(S), E, Code);
-{$ENDIF}
-
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (E < efRangeLo.rtExt) or (E > efRangeHi.rtExt) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- D := E;
- efTransfer(@D, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateSingle;
- var
- E : Extended;
- Si : Single;
- Code : Integer;
- S : TEditString;
- begin
- {convert efEditSt to an extended}
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, E, Code);
-{$ELSE}
- Val(string(S), E, Code);
-{$ENDIF}
-
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (E < efRangeLo.rtExt) or (E > efRangeHi.rtExt) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- Si := E;
- efTransfer(@Si, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateComp;
- var
- E : Extended;
-{$IFNDEF FPC}
- C : Comp;
-{$ELSE}
- {$IFDEF CPU86}
- C : Comp;
- {$ELSE}
- C : Double;
- {$ENDIF}
-{$ENDIF}
- Code : Integer;
- S : TEditString;
- begin
- {convert efEditSt to an comp}
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, C, Code);
-{$ELSE}
- Val(string(S), C, Code);
-{$ENDIF}
-
- E := C;
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (E < efRangeLo.rtExt) or (E > efRangeHi.rtExt) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- efTransfer(@C, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
-begin {validate}
- Result := 0;
- case FNumericDataType of
- nftLongInt : ValidateLongInt;
- nftWord : ValidateWord;
- nftInteger : ValidateInteger;
- nftByte : ValidateByte;
- nftShortInt : ValidateShortInt;
- nftReal : ValidateReal;
- nftExtended : ValidateExtended;
- nftDouble : ValidateDouble;
- nftSingle : ValidateSingle;
- nftComp : ValidateComp;
- end;
-
- if not (sefUserValidating in sefOptions) then begin
- {user may retrieve data from field. flag that we are doing}
- {user validation to avoid calling this routine recursively}
- Include(sefOptions, sefUserValidating);
- DoOnUserValidation(Result);
- Exclude(sefOptions, sefUserValidating);
- end;
-end;
-
-function TOvcCustomNumericField.nfGetDataType(Value: TNumericDataType) : Byte;
- {-return a Byte value representing the type of this field}
-begin
- case Value of
- nftLongInt : Result := fidNumericLongInt;
- nftWord : Result := fidNumericWord;
- nftInteger : Result := fidNumericInteger;
- nftByte : Result := fidNumericByte;
- nftShortInt : Result := fidNumericShortInt;
- nftReal : Result := fidNumericReal;
- nftExtended : Result := fidNumericExtended;
- nftDouble : Result := fidNumericDouble;
- nftSingle : Result := fidNumericSingle;
- nftComp : Result := fidNumericComp;
- else
- raise EOvcException.Create(GetOrphStr(SCInvalidParamValue));
- end;
-end;
-
-procedure TOvcCustomNumericField.nfReloadTmp;
- {-reload Tmp from efEditSt, etc.}
-begin
- {load nfTmp}
- pbStripPicture(nfTmp, efEditSt);
-
- TrimAllSpacesPChar(nfTmp);
-
- {remove the minus sign if there is one}
- nfMinus := (nfTmp[0] = '-');
- if nfMinus then
- StrChDeletePrim(nfTmp, 0);
-
- {want a blank string if it's a zero}
- if (nfTmp[0] = '0') and (nfTmp[1] = #0) then
- nfTmp[0] := #0;
-end;
-
-procedure TOvcCustomNumericField.nfResetFieldProperties(FT: TNumericDataType);
- {-reset field properties}
-begin
- DecimalPlaces := 0;
- case FT of
- nftLongInt : PictureMask := 'iiiiiiiiiii';
- nftWord : PictureMask := '99999';
- nftInteger : PictureMask := 'iiiiii';
- nftByte : PictureMask := '999';
- nftShortInt : PictureMask := 'iiii';
- nftReal : PictureMask := '##########';
- nftExtended : PictureMask := '##########';
- nftDouble : PictureMask := '##########';
- nftSingle : PictureMask := '##########';
- nftComp : PictureMask := 'iiiiiiiiii';
- else
- raise EOvcException.Create(GetOrphStr(SCInvalidParamValue));
- end;
-end;
-
-procedure TOvcCustomNumericField.nfSetDataType(Value: TNumericDataType);
- {-set the data type for this field}
-begin
- if FNumericDataType <> Value then begin
- FNumericDataType := Value;
- efDataType := nfGetDataType(FNumericDataType);
- efSetDefaultRange(efDataType);
-
- {set defaults for this field type}
- nfResetFieldProperties(FNumericDataType);
- if HandleAllocated then begin
- {don't save data through create window}
- efSaveData := False;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
- end;
-end;
-
-procedure TOvcCustomNumericField.nfSetDefaultRanges;
- {-set default range values based on the field type}
-begin
- case FNumericDataType of
- nftLongInt, nftWord, nftInteger, nftByte, nftShortInt :
- if efRangeLo.rtLong = efRangeHi.rtLong then
- efSetDefaultRange(efDataType);
- nftReal :
- if efRangeLo.rtReal = efRangeHi.rtReal then
- efSetDefaultRange(efDataType);
- nftExtended, nftDouble, nftSingle, nftComp :
- if efRangeLo.rtExt = efRangeHi.rtExt then
- efSetDefaultRange(efDataType);
- else
- efSetDefaultRange(efDataType);
- end;
-end;
-
-procedure TOvcCustomNumericField.nfSetMaxLength(Mask : PChar);
- {-determine and set MaxLength}
-var
- C : Cardinal;
-begin
- FMaxLength := StrLen(Mask);
-
- {decrease this if Mask has special characters that}
- {should not be considered part of the display string}
- if StrChPos(Mask, pmNegParens, C) then
- Dec(FMaxLength);
- if StrChPos(Mask, pmNegHere, C) then
- Dec(FMaxLength);
-end;
-
-procedure TOvcCustomNumericField.nfSetPictureMask(const Value: string);
- {-set the picture mask}
-var
- Buf : TPictureMask;
-begin
- if (FPictureMask <> Value) and (Value <> '') then begin
-
- {test for blatantly invalid masks}
- if csDesigning in ComponentState then begin
- {check for masks like "999.99" or "iii.ii" in fields editing floating data types}
- if (efDataType mod fcpDivisor) in [fsubReal, fsubExtended, fsubDouble, fsubSingle] then
- if (Pos(pmDecimalPt, Value) > 0) and
- ((Pos(pmPositive, Value) > 0) or (Pos(pmWhole, Value) > 0)) then
- raise EInvalidPictureMask.Create(Value);
- end;
-
- FPictureMask := Value;
- if csDesigning in ComponentState then begin
- StrPLCopy(efPicture, FPictureMask, MaxPicture);
- efPicLen := StrLen(efPicture);
- {set MaxLength based on picture mask}
- nfSetMaxLength(efPicture);
- pbOptimizeInitPictureFlags;
- efInitializeDataSize;
- Repaint;
- end else begin
- StrPLCopy(Buf, FPictureMask, MaxPicture);
- efChangeMask(Buf);
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
- end;
-end;
-
-procedure TOvcCustomNumericField.pbRemoveSemiLits;
- {-remove semi-literal mask characters from the edit string}
-begin
- if (sefHexadecimal in sefOptions) or (sefOctal in sefOptions) or
- (sefBinary in sefOptions) then
- Include(sefOptions, sefFixSemiLits)
- else
- Exclude(sefOptions, sefFixSemiLits);
-end;
-
-procedure TOvcCustomNumericField.WMKillFocus(var Msg : TWMKillFocus);
-begin
- inherited;
-
- {are we giving up the focus?}
- if not (sefRetainPos in sefOptions) then
- FillChar(nfTmp, SizeOf(nfTmp), #0);
-end;
-
-procedure TOvcCustomNumericField.WMSetFocus(var Msg : TWMSetFocus);
-begin
- inherited;
- nfReloadTmp;
- efResetCaret;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/bd/bdf646c5b34f74e9da791c52179786e5523d8d19.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/bd/bdf646c5b34f74e9da791c52179786e5523d8d19.svn-base
deleted file mode 100644
index 7b5eb1e0..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/bd/bdf646c5b34f74e9da791c52179786e5523d8d19.svn-base
+++ /dev/null
@@ -1,91 +0,0 @@
-LazarusResources.Add('TfrmOvcLabel','FORMDATA',[
- 'TPF0'#12'TfrmOvcLabel'#11'frmOvcLabel'#4'Left'#3'H'#1#3'Top'#3#198#0#11'Bord'
- +'erStyle'#7#8'bsDialog'#7'Caption'#6#13'Style Manager'#12'ClientHeight'#3#200
- +#1#6'Height'#3#200#1#11'ClientWidth'#3'A'#2#5'Width'#3'A'#2#12'Font.Charset'
- +#7#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2
- +#245#10'Font.Style'#11#0#8'OnCreate'#7#10'FormCreate'#13'PixelsPerInch'#2'`'
- +#0#6'TPanel'#6'Panel1'#4'Left'#2#0#3'Top'#2#0#5'Width'#3'A'#2#6'Height'#2'a'
- +#5'Align'#7#5'alTop'#12'Font.Charset'#7#15'DEFAULT_CHARSET'#10'Font.Color'#7
- +#12'clWindowText'#11'Font.Height'#2#245#10'Font.Style'#11#0#10'ParentFont'#8
- +#8'TabOrder'#2#0#0#9'TOvcLabel'#8'OvcLabel'#4'Left'#2#1#3'Top'#2#1#5'Width'#3
- +'?'#2#6'Height'#2'_'#5'Align'#7#8'alClient'#9'Alignment'#7#8'taCenter'#10'Ap'
- +'pearance'#7#8'apCustom'#7'Caption'#6#14'Orpheus Labels'#11'ColorScheme'#7#8
- +'csCustom'#12'Font.Charset'#7#15'DEFAULT_CHARSET'#10'Font.Color'#7#6'clGray'
- +#11'Font.Height'#2#229#10'Font.Style'#11#0#10'ParentFont'#8#0#0#0#7'TButton'
- +#7'Button1'#4'Left'#3#162#1#3'Top'#3#171#1#5'Width'#2'K'#6'Height'#2#25#7'Ca'
- +'ption'#6#2'OK'#7'Default'#9#11'ModalResult'#2#1#8'TabOrder'#2#4#0#0#7'TButt'
- +'on'#7'Button2'#4'Left'#3#244#1#3'Top'#3#171#1#5'Width'#2'K'#6'Height'#2#25#6
- +'Cancel'#9#7'Caption'#6#6'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2#5#0#0#6
- +'TPanel'#6'Panel2'#4'Left'#2#0#3'Top'#3'l'#1#5'Width'#3#137#1#6'Height'#2'['
- +#8'TabOrder'#2#3#0#6'TLabel'#6'Label1'#4'Left'#2#4#3'Top'#2#4#5'Width'#2'9'#6
- +'Height'#2#13#7'Caption'#6#11'Style Name:'#0#0#6'TLabel'#6'Label2'#4'Left'#3
- +#0#1#3'Top'#2#5#5'Width'#2'='#6'Height'#2#13#7'Caption'#6#11'Appearance:'#0#0
- +#6'TLabel'#6'Label3'#4'Left'#3#0#1#3'Top'#2'0'#5'Width'#2'E'#6'Height'#2#13#7
- +'Caption'#6#13'Color Scheme:'#0#0#9'TComboBox'#8'SchemeCb'#4'Left'#2#4#3'Top'
- +#2#20#5'Width'#3#233#0#6'Height'#2#21#5'Style'#7#14'csDropDownList'#10'ItemH'
- +'eight'#2#13#13'Items.Strings'#1#6#3'one'#6#3'two'#0#9'MaxLength'#3#255#0#6
- +'Sorted'#9#8'TabOrder'#2#0#8'OnChange'#7#14'SchemeCbChange'#0#0#7'TButton'#9
- +'SaveAsBtn'#4'Left'#2#4#3'Top'#2'7'#5'Width'#2'K'#6'Height'#2#25#7'Caption'#6
- +#11'Save &As...'#8'TabOrder'#2#1#7'OnClick'#7#14'SaveAsBtnClick'#0#0#7'TButt'
- +'on'#9'DeleteBtn'#4'Left'#3#161#0#3'Top'#2'7'#5'Width'#2'K'#6'Height'#2#25#7
- +'Caption'#6#7'&Delete'#8'TabOrder'#2#2#7'OnClick'#7#14'DeleteBtnClick'#0#0#9
- +'TComboBox'#12'AppearanceCb'#4'Left'#3#0#1#3'Top'#2#20#5'Width'#2'~'#6'Heigh'
- +'t'#2#21#10'ItemHeight'#2#13#8'TabOrder'#2#3#8'OnChange'#7#18'AppearanceCbCh'
- +'ange'#0#0#9'TComboBox'#13'ColorSchemeCb'#4'Left'#3#0#1#3'Top'#2'>'#5'Width'
- +#2'~'#6'Height'#2#21#10'ItemHeight'#2#13#8'TabOrder'#2#4#8'OnChange'#7#19'Co'
- +'lorSchemeCbChange'#0#0#0#6'TPanel'#6'Panel3'#4'Left'#2#0#3'Top'#2'a'#5'Widt'
- +'h'#3'A'#2#6'Height'#3#189#0#8'TabOrder'#2#1#0#6'TLabel'#6'Label4'#4'Left'#3
- +#152#0#3'Top'#2'S'#5'Width'#2'F'#6'Height'#2#13#7'Caption'#6#15'Gradient Col'
- +'or:'#0#0#6'TLabel'#6'Label5'#4'Left'#3'&'#1#3'Top'#2'S'#5'Width'#2'G'#6'Hei'
- +'ght'#2#13#7'Caption'#6#16'Highlight Color:'#0#0#6'TLabel'#6'Label6'#4'Left'
- +#3#181#1#3'Top'#2'S'#5'Width'#2'E'#6'Height'#2#13#7'Caption'#6#13'Shadow Col'
- +'or:'#0#0#6'TLabel'#21'HighlightDirectionLbl'#4'Left'#3'0'#1#3'Top'#3#128#0#5
- +'Width'#2'2'#6'Height'#2' '#8'AutoSize'#8#7'Caption'#6#20'Highlight Directio'
- +'n:'#8'WordWrap'#9#0#0#6'TLabel'#18'ShadowDirectionLbl'#4'Left'#3#191#1#3'To'
- +'p'#3#128#0#5'Width'#2'2'#6'Height'#2' '#8'AutoSize'#8#7'Caption'#6#17'Shado'
- +'w Direction:'#8'WordWrap'#9#0#0#6'TLabel'#6'Label7'#4'Left'#2#8#3'Top'#2'A'
- +#5'Width'#2'5'#6'Height'#2#13#7'Caption'#6#11'Text Color/'#0#0#6'TLabel'#6'L'
- +'abel8'#4'Left'#2#8#3'Top'#2'N'#5'Width'#2'V'#6'Height'#2#13#7'Caption'#6#18
- +'Gradient To Color:'#0#0#11'TRadioGroup'#10'GraduateRg'#4'Left'#3#150#0#3'To'
- +'p'#2#3#5'Width'#3#137#0#6'Height'#2'I'#7'Caption'#6#20'Text &Gradient Style'
- +#9'ItemIndex'#2#0#13'Items.Strings'#1#6#4'None'#6#10'Horizontal'#6#8'Vertica'
- +'l'#0#7'OnClick'#7#15'GraduateRgClick'#0#0#11'TRadioGroup'#8'ShadowRg'#4'Lef'
- +'t'#3#180#1#3'Top'#2#3#5'Width'#3#137#0#6'Height'#2'I'#7'Caption'#6#13'&Shad'
- +'ow Style'#9'ItemIndex'#2#0#13'Items.Strings'#1#6#5'Plain'#6#7'Extrude'#6#8
- +'Graduate'#0#7'OnClick'#7#13'ShadowRgClick'#0#0#11'TRadioGroup'#11'Highlight'
- +'Rg'#4'Left'#3'%'#1#3'Top'#2#3#5'Width'#3#137#0#6'Height'#2'I'#7'Caption'#6
- +#16'&Highlight Style'#9'ItemIndex'#2#0#13'Items.Strings'#1#6#5'Plain'#6#7'Ex'
- +'trude'#6#8'Graduate'#0#7'OnClick'#7#16'HighlightRgClick'#0#0#17'TOvcColorCo'
- +'mboBox'#12'FromColorCcb'#4'Left'#3#151#0#3'Top'#2'c'#5'Width'#3#137#0#6'Hei'
- +'ght'#2#22#10'ItemHeight'#2#12#13'SelectedColor'#7#7'clBlack'#8'TabOrder'#2#4
- +#4'Text'#6#5'Black'#8'OnChange'#7#18'FromColorCcbChange'#0#0#17'TOvcColorCom'
- +'boBox'#17'HighlightColorCcb'#4'Left'#3'%'#1#3'Top'#2'c'#5'Width'#3#137#0#6
- +'Height'#2#22#10'ItemHeight'#2#12#13'SelectedColor'#7#7'clBlack'#8'TabOrder'
- +#2#5#4'Text'#6#5'Black'#8'OnChange'#7#23'HighlightColorCcbChange'#0#0#17'TOv'
- +'cColorComboBox'#14'ShadowColorCcb'#4'Left'#3#180#1#3'Top'#2'c'#5'Width'#3
- ,#137#0#6'Height'#2#22#10'ItemHeight'#2#12#13'SelectedColor'#7#7'clBlack'#8'T'
- +'abOrder'#2#6#4'Text'#6#5'Black'#8'OnChange'#7#20'ShadowColorCcbChange'#0#0
- +#17'TOvcColorComboBox'#12'FontColorCcb'#4'Left'#2#7#3'Top'#2'c'#5'Width'#3
- +#137#0#6'Height'#2#22#10'ItemHeight'#2#12#13'SelectedColor'#7#7'clBlack'#8'T'
- +'abOrder'#2#0#4'Text'#6#5'Black'#8'OnChange'#7#18'FontColorCcbChange'#0#0#0#6
- +'TPanel'#6'Panel4'#4'Left'#2#0#3'Top'#3#30#1#5'Width'#3'A'#2#6'Height'#2'N'#8
- +'TabOrder'#2#2#0#6'TLabel'#6'Label9'#4'Left'#2#20#3'Top'#2#8#5'Width'#2'i'#6
- +'Height'#2#13#9'Alignment'#7#14'taRightJustify'#8'AutoSize'#8#7'Caption'#6#11
- +'Font Size: '#0#0#6'TLabel'#11'FontSizeLbl'#4'Left'#3#244#1#3'Top'#2#8#5'Wid'
- +'th'#2#6#6'Height'#2#13#7'Caption'#6#1'0'#0#0#6'TLabel'#17'HighlightDepthLbl'
- +#4'Left'#3#244#1#3'Top'#2' '#5'Width'#2#6#6'Height'#2#13#7'Caption'#6#1'0'#0
- +#0#6'TLabel'#14'ShadowDepthLbl'#4'Left'#3#244#1#3'Top'#2'8'#5'Width'#2#6#6'H'
- +'eight'#2#13#7'Caption'#6#1'0'#0#0#6'TLabel'#7'Label10'#4'Left'#2#20#3'Top'#2
- +' '#5'Width'#2'i'#6'Height'#2#13#9'Alignment'#7#14'taRightJustify'#8'AutoSiz'
- +'e'#8#7'Caption'#6#17'Highlight Depth: '#0#0#6'TLabel'#7'Label11'#4'Left'#2
- +#20#3'Top'#2'8'#5'Width'#2'i'#6'Height'#2#13#9'Alignment'#7#14'taRightJustif'
- +'y'#8'AutoSize'#8#7'Caption'#6#14'Shadow Depth: '#0#0#10'TScrollBar'#10'Font'
- +'SizeSb'#4'Left'#3#132#0#3'Top'#2#8#5'Width'#3'e'#1#6'Height'#2#14#8'TabOrde'
- +'r'#2#0#8'OnChange'#7#16'FontSizeSbChange'#0#0#10'TScrollBar'#13'ShadowDepth'
- +'Sb'#4'Left'#3#132#0#3'Top'#2'8'#5'Width'#3'e'#1#6'Height'#2#14#3'Max'#2'2'#8
- +'TabOrder'#2#2#8'OnChange'#7#19'ShadowDepthSbChange'#0#0#10'TScrollBar'#16'H'
- +'ighlightDepthSb'#4'Left'#3#132#0#3'Top'#2' '#5'Width'#3'e'#1#6'Height'#2#14
- +#3'Max'#2'2'#8'TabOrder'#2#1#8'OnChange'#7#22'HighlightDepthSbChange'#0#0#0
- +#14'TOvcController'#14'OvcController1'#23'EntryCommands.TableList'#1#6#7'Def'
- +'ault'#9#1#0#6#8'WordStar'#8#1#0#6#4'Grid'#8#1#0#0#5'Epoch'#3'l'#7#0#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/c5/c5006d74330095246a05845c95ff6ae209e2ed5d.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/c5/c5006d74330095246a05845c95ff6ae209e2ed5d.svn-base
deleted file mode 100644
index f2751735..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/c5/c5006d74330095246a05845c95ff6ae209e2ed5d.svn-base
+++ /dev/null
@@ -1 +0,0 @@
-1 24 project1.exe.manifest
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/c5/c508ddb16e2870ba4f608fe108fbcfc587e215f7.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/c5/c508ddb16e2870ba4f608fe108fbcfc587e215f7.svn-base
deleted file mode 100644
index 85f1c571..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/pristine/c5/c508ddb16e2870ba4f608fe108fbcfc587e215f7.svn-base and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/c5/c573db10c29f521942fe88fcf65ebb3805d1d28e.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/c5/c573db10c29f521942fe88fcf65ebb3805d1d28e.svn-base
deleted file mode 100644
index 8c4ade61..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/c5/c573db10c29f521942fe88fcf65ebb3805d1d28e.svn-base
+++ /dev/null
@@ -1,2048 +0,0 @@
-{*********************************************************}
-{* OVCSF.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 ovcsf;
- {-Simple field visual component}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Classes, Controls, Graphics, SysUtils,
- OvcBase, OvcColor, OvcCaret, OvcConst, OvcData, OvcEF, OvcExcpt,
- OvcIntl, OvcMisc, OvcStr;
-
-type
- {simple field type names}
- TSimpleDataType = (
- sftString, sftChar, sftBoolean, sftYesNo,
- sftLongInt, sftWord, sftInteger, sftByte, sftShortInt,
- sftReal, sftExtended, sftDouble, sftSingle, sftComp);
-
-type
- TOvcCustomSimpleField = class(TOvcBaseEntryField)
- {.Z+}
- protected {private}
- {property instance variables}
- FSimpleDataType : TSimpleDataType; {data type for this field}
- FPictureMask : AnsiChar; {picture mask name}
-
- function sfGetDataType(Value : TSimpleDataType) : Byte;
- {-return a Byte value representing the type of this field}
- procedure sfResetFieldProperties(FT : TSimpleDataType);
- {-reset field properties}
- procedure sfSetDefaultRanges;
- {-set default range values based on the field type}
-
- protected
- procedure CreateWnd;
- override;
-
- procedure efEdit(var Msg : TMessage; Cmd : Word);
- override;
- {-process the specified editing command}
- function efGetDisplayString(Dest : PAnsiChar; Size : Word) : PAnsiChar;
- override;
- {-return the display string in Dest and a pointer as the result}
- procedure efIncDecValue(Wrap : Boolean; Delta : Double);
- override;
- {-increment field by Delta}
- function efTransfer(DataPtr : Pointer; TransferFlag : Word) : Word;
- override;
- {-transfer data to/from the entry fields}
-
- {virtual property methods}
- procedure sfSetDataType(Value : TSimpleDataType);
- virtual;
- {-set the data type for this field}
- procedure sfSetPictureMask(Value: AnsiChar);
- virtual;
- {-set the picture mask}
-
- public
- procedure Assign(Source : TPersistent);
- override;
- constructor Create(AOwner: TComponent);
- override;
-
- function efValidateField : Word;
- override;
- {-validate contents of field; result is error code or 0}
- {.Z-}
-
- {public properties}
- property DataType : TSimpleDataType
- read FSimpleDataType
- write sfSetDataType;
-
- property PictureMask : AnsiChar
- read FPictureMask
- write sfSetPictureMask;
-
- end;
-
- TOvcSimpleField = class(TOvcCustomSimpleField)
- published
- {inherited properties}
- property DataType; {needs to loaded before most other properties}
- {$IFDEF VERSION4}
- property Anchors;
- property Constraints;
- property DragKind;
- {$ENDIF}
- property AutoSize;
- property BorderStyle;
- property CaretIns;
- property CaretOvr;
- property Color;
- property ControlCharColor;
- property Controller;
- property Ctl3D;
- property Borders;
- property DecimalPlaces;
- property DragCursor;
- property DragMode;
- property EFColors;
- property Enabled;
- property Font;
- property LabelInfo;
- property MaxLength;
- property Options;
- property PadChar;
- property ParentColor;
-{$IFNDEF LCL}
- property ParentCtl3D;
-{$ENDIF}
- property ParentFont;
- property ParentShowHint;
- property PasswordChar;
- property PictureMask;
- property PopupMenu;
- property RangeHi stored False;
- property RangeLo stored False;
- property ShowHint;
- property TabOrder;
- property TabStop default True;
- property Tag;
- property TextMargin;
- property Uninitialized;
- property Visible;
- property ZeroDisplay;
- property ZeroDisplayValue;
-
- {inherited events}
- property AfterEnter;
- property AfterExit;
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnError;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDrag;
- property OnMouseWheel;
- property OnUserCommand;
- property OnUserValidation;
- end;
-
-implementation
-
-{*** TOvcCustomSimpleField ***}
-
-procedure TOvcCustomSimpleField.Assign(Source : TPersistent);
-var
- SF : TOvcCustomSimpleField absolute Source;
-begin
- if (Source <> nil) and (Source is TOvcCustomSimpleField) then begin
- DataType := SF.DataType;
- AutoSize := SF.AutoSize;
- BorderStyle := SF.BorderStyle;
- Color := SF.Color;
- ControlCharColor := SF.ControlCharColor;
- DecimalPlaces := SF.DecimalPlaces;
- EFColors.Error.Assign(SF.EFColors.Error);
- EFColors.Highlight.Assign(SF.EFColors.Highlight);
- MaxLength := SF.MaxLength;
- Options := SF.Options;
- PadChar := SF.PadChar;
- PasswordChar := SF.PasswordChar;
- PictureMask := SF.PictureMask;
- RangeHi := SF.RangeHi;
- RangeLo := SF.RangeLo;
- TextMargin := SF.TextMargin;
- Uninitialized := SF.Uninitialized;
- ZeroDisplay := SF.ZeroDisplay;
- ZeroDisplayValue := SF.ZeroDisplayValue;
- end else
- inherited Assign(Source);
-end;
-
-constructor TOvcCustomSimpleField.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
-
- FSimpleDataType := sftString;
- FPictureMask := pmAnyChar;
-
- efFieldClass := fcSimple;
- efDataType := sfGetDataType(FSimpleDataType);
- efPicture[0] := pmAnyChar;
- efPicture[1] := #0;
-end;
-
-procedure TOvcCustomSimpleField.CreateWnd;
-var
- P : array[0..MaxEditLen+1] of Byte;
-begin
- {save field data}
- if efSaveData then
- efTransfer(@P, otf_GetData);
-
- inherited CreateWnd;
-
- sfSetDefaultRanges;
- efSetInitialValue;
-
- {if we saved the field data, restore it}
- if efSaveData then
- efTransfer(@P, otf_SetData);
-
- {set save data flag}
- efSaveData := True;
-end;
-
-procedure TOvcCustomSimpleField.efEdit(var Msg : TMessage; Cmd : Word);
- {-process the specified editing command}
-
- procedure EditSimple(var Msg : TMessage; Cmd : Word);
- {-process the specified editing command for String and PChar fields}
- label
- ExitPoint;
- var
- SaveHPos : Word;
- DelEnd : Word;
- Len : Word;
- Ch : AnsiChar;
- PrevCh : AnsiChar;
- MF : ShortInt;
- HaveSel : Boolean;
- SelExtended : Boolean;
-
- function CharIsOK : Boolean;
- {-return true if Ch can be added to the string}
- var
- PrevCh : AnsiChar;
- begin
- if efIsNumericType then
- if Ch = IntlSupport.DecimalChar then
- Ch := pmDecimalPt
- else if Ch = pmDecimalPt then
- Ch := #0;
- if (Ch < ' ') and not (sefLiteral in sefOptions) then begin
- CharIsOK := False;
- Exit;
- end;
- if efHPos = 0 then
- PrevCh := ' '
- else
- PrevCh := efEditSt[efHPos-1];
- CharIsOK := efCharOK(efPicture[0], Ch, PrevCh, True);
- if efIsNumericType and (Ch = pmDecimalPt) then
- Ch := IntlSupport.DecimalChar;
- end;
-
- function CheckAutoAdvance(SP : Integer) : Boolean;
- {-see if we need to auto-advance to next/previous field}
- begin
- CheckAutoAdvance := False;
- if (SP < 0) and
- (efoAutoAdvanceLeftRight in Controller.EntryOptions) then begin
- efMoveFocusToPrevField;
- CheckAutoAdvance := True;
- end else if (SP >= MaxLength) then
- if (Cmd = ccChar) and
- (efoAutoAdvanceChar in Controller.EntryOptions) then begin
- efMoveFocusToNextField;
- CheckAutoAdvance := True;
- end else if (Cmd <> ccChar) and
- (efoAutoAdvanceLeftRight in Controller.EntryOptions) then begin
- efMoveFocusToNextField;
- CheckAutoAdvance := True;
- end;
- end;
-
- procedure FixSelValues;
- var
- I : Integer;
- begin
- if efSelStart > efSelEnd then begin
- I := efSelStart;
- efSelStart := efSelEnd;
- efSelEnd := I;
- end;
- end;
-
- procedure UpdateSel;
- begin
- if efSelStart = SaveHPos then
- efSelStart := efHPos
- else
- efSelEnd := efHPos;
- FixSelValues;
- end;
-
- procedure WordLeftPrim;
- begin
- Dec(efHPos);
- while (efHPos >= 0) and ((efHPos >= Len) or (efEditSt[efHPos] = ' ')) do
- Dec(efHPos);
- while (efHPos >= 0) and (efEditSt[efHPos] <> ' ') do
- Dec(efHPos);
- Inc(efHPos);
- end;
-
- procedure WordRightPrim;
- begin
- if efEditSt[efHPos] <> ' ' then
- Inc(efHPos);
- while (efHPos < Len) and (efEditSt[efHPos] <> ' ') do
- Inc(efHPos);
- while (efHPos < Len) and (efEditSt[efHPos] = ' ') do
- Inc(efHPos);
- end;
-
- procedure DeleteSel;
- begin
- StrStDeletePrim(efEditSt, efSelStart, efSelEnd-efSelStart);
- Len := StrLen(efEditSt);
- efHPos := efSelStart;
- efSelEnd := efHPos;
- MF := 10;
- end;
-
- procedure PastePrim(P : PAnsiChar);
- var
- Ch : AnsiChar;
- IsNum : Boolean;
- begin
- if HaveSel then
- DeleteSel;
- IsNum := efIsNumericType;
- while P^ <> #0 do begin
- Ch := P^;
- if IsNum then
- if Ch = IntlSupport.DecimalChar then
- Ch := pmDecimalPt
- else if (Ch = pmDecimalPt) or (Ch = ' ') then
- Ch := #0;
- if efCharOK(efPicture[0], Ch, #255, True) then begin
- if (Len = MaxLength) and (efHPos < Len) and
- (efoInsertPushes in Controller.EntryOptions) then begin
- Dec(Len);
- efEditSt[Len] := #0;
- end;
- if (Len < MaxLength) then begin
- if efIsNumericType and (Ch = pmDecimalPt) then
- Ch := IntlSupport.DecimalChar;
- StrChInsertPrim(efEditSt, Ch, efHPos);
- Inc(efHPos);
- Inc(Len);
- end;
- MF := 10;
- end;
- Inc(P);
- end;
- end;
-
- begin
- HaveSel := efSelStart <> efSelEnd;
- MF := Ord(HaveSel);
- SaveHPos := efHPos;
- SelExtended := False;
-
- case Cmd of
- ccAccept : {};
- ccCtrlChar : Include(sefOptions, sefLiteral);
- else
- if Cmd <> ccChar then
- Exclude(sefOptions, sefLiteral);
- end;
-
- Len := StrLen(efEditSt);
- Exclude(sefOptions, sefCharOK);
-
- case Cmd of
- ccChar :
- begin
- Ch := AnsiChar(Lo(Msg.wParam));
- if (sefAcceptChar in sefOptions) and CharIsOk then begin
- Exclude(sefOptions, sefAcceptChar);
- Exclude(sefOptions, sefLiteral);
- if HaveSel then begin
- DeleteSel;
- if efHPos = 0 then
- PrevCh := ' '
- else
- PrevCh := efEditSt[efHPos-1];
- efCharOK(efPicture[0], Ch, PrevCh, True);
- end;
- if (sefInsert in sefOptions) then begin
- if (Len = MaxLength) and (efHPos < Len) and
- (efoInsertPushes in Controller.EntryOptions) then begin
- Dec(Len);
- efEditSt[Len] := #0;
- end;
- if (Len < MaxLength) then begin
- StrChInsertPrim(efEditSt, Ch, efHPos);
- Inc(efHPos);
- CheckAutoAdvance(efHPos);
- end else if not CheckAutoAdvance(efHPos) then
- efConditionalBeep;
- end else if (efHPos+1) <= MaxLength then begin
- efEditSt[efHPos] := Ch;
- if efHPos >= Len then
- efEditSt[efHPos+1] := #0;
- Inc(efHPos);
- CheckAutoAdvance(efHPos);
- end else begin
- if not CheckAutoAdvance(efHPos) then
- efConditionalBeep;
- Dec(MF, 10);
- end;
- Inc(MF, 10);
- end else begin
- Exclude(sefOptions, sefLiteral);
- if sefAcceptChar in sefOptions then
- efConditionalBeep
- else
- goto ExitPoint;
- end;
- end;
- ccMouse :
- if Len > 0 then begin
- efHPos := efGetMousePos(SmallInt(LoWord(Msg.LParam))); //64
- {drag highlight initially if shift key is being pressed}
- if (GetKeyState(vk_Shift) < 0) then begin
- SelExtended := True;
- if HaveSel then begin
- if efHPos > efSelStart then
- efSelEnd := efHPos
- else
- efSelStart := efHPos;
- end else begin
- efSelStart := SaveHPos;
- efSelEnd := efHPos;
- end;
- FixSelValues;
- end else begin
- SetSelection(efHPos, efHPos);
- efPositionCaret(False);
- end;
- end;
- ccMouseMove :
- if Len > 0 then begin
- efHPos := efGetMousePos(SmallInt(LoWord(Msg.LParam))); //64
- UpdateSel;
- end;
- ccDblClk :
- if Len > 0 then begin
- efHPos := efGetMousePos(SmallInt(LoWord(Msg.LParam))); //64
- WordLeftPrim;
- SaveHPos := efHPos;
- efSelStart := SaveHPos;
- efSelEnd := SaveHPos;
- WordRightPrim;
- UpdateSel;
- end;
-{$IFDEF LCL} //LCL form not seeing tab (?), so handle tab command here}
- ccTab : efMoveFocusToNextField;
-{$ENDIF}
- ccLeft :
- if efHPos > 0 then
- Dec(efHPos)
- else
- CheckAutoAdvance(-1);
- ccRight :
- if efHPos < Len then
- Inc(efHPos)
- else
- CheckAutoAdvance(MaxLength);
- ccUp :
- if (efoAutoAdvanceUpDown in Controller.EntryOptions) then
- efMoveFocusToPrevField
- else if (efoArrowIncDec in Options) and not (efoReadOnly in Options) then
- IncreaseValue(True, 1)
- else if efHPos > 0 then
- Dec(efHPos)
- else
- CheckAutoAdvance(-1);
- ccDown :
- if (efoAutoAdvanceUpDown in Controller.EntryOptions) then
- efMoveFocusToNextField
- else if (efoArrowIncDec in Options) and not (efoReadOnly in Options) then
- DecreaseValue(True, 1)
- else if efHPos < Len then
- Inc(efHPos)
- else
- CheckAutoAdvance(MaxLength);
- ccWordLeft :
- if efHPos > 0 then
- WordLeftPrim
- else
- CheckAutoAdvance(-1);
- ccWordRight :
- if efHPos < Len then
- WordRightPrim
- else
- CheckAutoAdvance(MaxLength);
- ccHome :
- efHPos := 0;
- ccEnd :
- efHPos := Len;
- ccExtendLeft :
- if efHPos > 0 then begin
- Dec(efHPos);
- UpdateSel;
- end else
- MF := -1;
- ccExtendRight :
- if efHPos < Len then begin
- Inc(efHPos);
- UpdateSel;
- end else
- MF := -1;
- ccExtendHome :
- begin
- efHPos := 0;
- UpdateSel;
- end;
- ccExtendEnd :
- begin
- efHPos := Len;
- UpdateSel;
- end;
- ccExtWordLeft :
- if efHPos > 0 then begin
- WordLeftPrim;
- UpdateSel;
- end else
- MF := -1;
- ccExtWordRight :
- if efHPos < Len then begin
- WordRightPrim;
- UpdateSel;
- end else
- MF := -1;
- ccCut :
- if HaveSel then
- DeleteSel;
- ccCopy : efCopyPrim;
- ccPaste :
- {for some reason, a paste action within the IDE}
- {gets passed to the control. filter it out}
- if not (csDesigning in ComponentState) then
- PastePrim(PAnsiChar(Msg.lParam));
- ccBack :
- if HaveSel then
- DeleteSel
- else if efHPos > 0 then begin
- Dec(efHPos);
- StrStDeletePrim(efEditSt, efHPos, 1);
- MF := 10;
- end;
- ccDel :
- if HaveSel then
- DeleteSel
- else if efHPos < Len then begin
- StrStDeletePrim(efEditSt, efHPos, 1);
- MF := 10;
- end;
- ccDelWord :
- if HaveSel then
- DeleteSel
- else if efHPos < Len then begin
- {start deleting at the caret}
- DelEnd := efHPos;
-
- {delete all of the current word, if any}
- if efEditSt[efHPos] <> ' ' then
- while (efEditSt[DelEnd] <> ' ') and (DelEnd < Len) do
- Inc(DelEnd);
-
- {delete any spaces prior to the next word, if any}
- while (efEditSt[DelEnd] = ' ') and (DelEnd < Len) do
- Inc(DelEnd);
-
- StrStDeletePrim(efEditSt, efHPos, DelEnd-efHPos);
- MF := 10;
- end;
- ccDelLine :
- if Len > 0 then begin
- efEditSt[0] := #0;
- efHPos := 0;
- MF := 10;
- end;
- ccDelEol :
- if efHPos < Len then begin
- efEditSt[efHPos] := #0;
- MF := 10;
- end;
- ccDelBol :
- if Len > 0 then begin
- StrStDeletePrim(efEditSt, 0, efHPos);
- efHPos := 0;
- MF := 10;
- end;
- ccIns :
- begin
- if sefInsert in sefOptions then
- Exclude(sefOptions, sefInsert)
- else
- Include(sefOptions, sefInsert);
- efCaret.InsertMode := (sefInsert in sefOptions);
- end;
- ccRestore : Restore;
- ccAccept :
- begin
- Include(sefOptions, sefCharOK);
- Include(sefOptions, sefAcceptChar);
- Exit;
- end;
- ccDec :
- DecreaseValue(True, 1);
- ccInc :
- IncreaseValue(True, 1);
- ccCtrlChar, ccSuppress, ccPartial :
- goto ExitPoint;
- else
- Include(sefOptions, sefCharOK);
- goto ExitPoint;
- end;
- Exclude(sefOptions, sefAcceptChar);
-
- case Cmd of
- ccRestore, ccMouseMove, ccDblClk,
- ccExtendLeft, ccExtendRight,
- ccExtendHome, ccExtendEnd,
- ccExtWordLeft, ccExtWordRight :
- Inc(MF);
- ccMouse :
- if SelExtended then
- Inc(MF);
- ccCut, ccCopy, ccPaste : {};
- else
- efSelStart := efHPos;
- efSelEnd := efHPos;
- end;
-
- ExitPoint:
- if efPositionCaret(True) then
- Inc(MF);
- if MF >= 10 then
- efFieldModified;
- if MF > 0 then
- Invalidate;
- end;
-
- procedure EditChar(var Msg : TMessage; Cmd : Word);
- {-process the specified editing command for Char fields}
- label
- ExitPoint;
- var
- MF : Byte;
- Ch : AnsiChar;
-
- function CharIsOK : Boolean;
- {-return true if Ch can be added to the string}
- begin
- if (Ch < ' ') and not (sefLiteral in sefOptions) then
- CharIsOK := False
- else
- CharIsOK := efCharOK(efPicture[0], Ch, ' ', True);
- end;
-
- function CheckAutoAdvance(SP : Integer) : Boolean;
- {-see if we need to auto-advance to next/previous field}
- begin
- CheckAutoAdvance := False;
- if (SP < 0) and
- (efoAutoAdvanceLeftRight in Controller.EntryOptions) then begin
- efMoveFocusToPrevField;
- Result := True;
- end else if (SP > 0) then
- if (Cmd = ccChar) and
- (efoAutoAdvanceChar in Controller.EntryOptions) then begin
- efMoveFocusToNextField;
- Result := True;
- end else if (Cmd <> ccChar) and
- (efoAutoAdvanceLeftRight in Controller.EntryOptions) then begin
- efMoveFocusToNextField;
- Result := True;
- end;
- end;
-
- procedure PastePrim(P : PAnsiChar);
- begin
- while P^ <> #0 do begin
- Ch := P^;
- if efCharOK(efPicture[0], Ch, #255, True) then begin
- efEditSt[0] := Ch;
- MF := 10;
- Exit;
- end;
- Inc(P);
- end;
- end;
-
- begin
- MF := Ord(efSelStart <> efSelEnd);
- case Cmd of
- ccAccept : ;
- ccCtrlChar :
- Include(sefOptions, sefLiteral);
- else
- efHPos := 0;
- if Cmd <> ccChar then
- Exclude(sefOptions, sefLiteral);
- end;
-
- Exclude(sefOptions, sefCharOK);
- case Cmd of
- ccChar :
- begin
- Ch := AnsiChar(Lo(Msg.wParam));
- if sefAcceptChar in sefOptions then
- if CharIsOk then begin
- efEditSt[0] := Ch;
- efEditSt[1] := #0;
- CheckAutoAdvance(1);
- MF := 10;
- end else
- efConditionalBeep;
- {end;}
- sefOptions := sefOptions - [sefAcceptChar, sefLiteral];
- end;
- ccLeft, ccWordLeft :
- CheckAutoAdvance(-1);
- ccRight, ccWordRight :
- CheckAutoAdvance(MaxLength);
- ccUp :
- if (efoAutoAdvanceUpDown in Controller.EntryOptions) then
- efMoveFocusToPrevField
- else
- CheckAutoAdvance(-1);
- ccDown :
- if (efoAutoAdvanceUpDown in Controller.EntryOptions) then
- efMoveFocusToNextField
- else
- CheckAutoAdvance(MaxLength);
- ccRestore :
- Restore;
- ccExtendRight, ccExtendEnd, ccExtWordRight :
- efSelEnd := 1;
- ccMouseMove :
- if efGetMousePos(SmallInt(LoWord(Msg.LParam))) > 0 then //64
- efSelEnd := 1
- else
- efSelEnd := 0;
- ccDblClk :
- efSelEnd := 1;
- ccCopy : efCopyPrim;
- ccPaste :
- {for some reason, a paste action within the IDE}
- {gets passed to the control. filter it out}
- if not (csDesigning in ComponentState) then
- PastePrim(PAnsiChar(Msg.lParam));
- ccAccept :
- begin
- sefOptions := sefOptions + [sefCharOK, sefAcceptChar];
- Exit;
- end;
- ccMouse, ccExtendLeft, ccExtendHome, ccExtWordLeft : ;
- ccDec :
- DecreaseValue(True, 1);
- ccInc :
- IncreaseValue(True, 1);
- ccCtrlChar, ccSuppress, ccPartial :
- goto ExitPoint;
- else
- Include(sefOptions, sefCharOK);
- goto ExitPoint;
- end;
- Exclude(sefOptions, sefAcceptChar);
-
- case Cmd of
- ccRestore, ccMouseMove, ccDblClk, ccExtendRight,
- ccExtendEnd, ccExtWordRight :
- Inc(MF);
- else
- efSelStart := 0;
- efSelEnd := 0;
- end;
-
- ExitPoint:
- if efPositionCaret(True) then
- Inc(MF);
- if MF >= 10 then
- efFieldModified;
- if MF > 0 then
- Invalidate;
- end;
-
-begin {edit}
- case FSimpleDataType of
- sftString,
- sftLongInt, sftWord, sftInteger, sftByte, sftShortInt,
- sftReal, sftExtended, sftDouble, sftSingle, sftComp :
- EditSimple(Msg, Cmd);
- sftChar, sftBoolean, sftYesNo :
- EditChar(Msg, Cmd);
- end;
-end;
-
-function TOvcCustomSimpleField.efGetDisplayString(Dest : PAnsiChar; Size : Word) : PAnsiChar;
- {-return the display string in Dest and a pointer as the result}
-var
- Len : Word;
-begin
- Result := inherited efGetDisplayString(Dest, Size);
-
- Len := StrLen(Dest);
- if Len = 0 then
- Exit;
-
- if Uninitialized and not (sefHaveFocus in sefOptions) then begin
- FillChar(Dest[0], Len, ' ');
- Exit;
- end;
-
- if (efoPasswordMode in Options) then
- FillChar(Dest[0], Len, PasswordChar);
-
- if PadChar <> ' ' then begin
- FillChar(Dest[Len], MaxLength-Len, PadChar);
- Dest[MaxLength] := #0;
- end;
-end;
-
-procedure TOvcCustomSimpleField.efIncDecValue(Wrap : Boolean; Delta : Double);
- {-increment field by Delta}
-var
- S : TEditString;
-
- procedure IncDecValueChar;
- {-increment Char field by Delta}
- var
- C, CC, CL, CH, MC : AnsiChar;
- OK : Boolean;
- begin
- {get valid range}
- CL := efRangeLo.rtChar;
- CH := efRangeHi.rtChar;
- if CL = CH then begin
- CL := #1;
- CH := #255;
- end;
-
- {get current character}
- C := efEditSt[0];
-
- {get mask character}
- MC := efPicture[0];
-
- {exit if we're at the range limit and not allowed to wrap}
- if (Delta < 0) and (C = CL) then begin
- if not Wrap then
- Exit;
- end else if (Delta > 0) and (C = CH) then
- if not Wrap then
- Exit;
-
- {find the next/prev allowable character}
- OK := False;
- repeat
- repeat
- if Delta = 1 then
- Inc(C)
- else
- Dec(C);
- CC := C;
- efFixCase(MC, CC, ' ');
- until efCharOK(MC, C, ' ', False) and (C = CC);
-
- {check result to see if it's in valid range}
- if (C >= CL) and (C <= CH) then
- OK := True
- else if Wrap then
- OK := False
- else
- Exit;
- until OK;
-
- efTransfer(@C, otf_SetData);
- efPerformRepaint(True);
- end;
-
- procedure IncDecValueBoolean;
- var
- Ch : AnsiChar;
- B : Boolean;
- begin
- Ch := UpCaseChar(efEditSt[0]);
- if Ch = IntlSupport.TrueChar then
- Ch := IntlSupport.FalseChar
- else
- Ch := IntlSupport.TrueChar;
- B := Ch = IntlSupport.TrueChar;
-
- efTransfer(@B, otf_SetData);
- efPerformRepaint(True);
- end;
-
- procedure IncDecValueYesNo;
- var
- Ch : AnsiChar;
- B : Boolean;
- begin
- Ch := UpCaseChar(efEditSt[0]);
- if Ch = IntlSupport.YesChar then
- Ch := IntlSupport.NoChar
- else
- Ch := IntlSupport.YesChar;
- B := Ch = IntlSupport.YesChar;
-
- efTransfer(@B, otf_SetData);
- efPerformRepaint(True);
- end;
-
- procedure IncDecValueLongInt;
- var
- L : LongInt;
- begin
- if efStr2Long(efEditSt, L) then begin
- if (Delta < 0) and (L <= efRangeLo.rtLong) then
- if Wrap then
- L := efRangeHi.rtLong
- else Exit
- else if (Delta > 0) and (L >= efRangeHi.rtLong) then
- if Wrap then
- L := efRangeLo.rtLong
- else Exit
- else
- Inc(L, Trunc(Delta));
-
- {insure valid value}
- if L < efRangeLo.rtLong then
- L := efRangeLo.rtLong;
- if L > efRangeHi.rtLong then
- L := efRangeHi.rtLong;
-
- efTransfer(@L, otf_SetData);
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueReal;
- var
- Re : Real;
- Code : Integer;
- begin
- {convert efEditSt to a real}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Re, Code);
-{$ELSE}
- Val(String(S), Re, Code);
-{$ENDIF}
- if Code = 0 then begin
- if (Delta < 0) and (Re <= efRangeLo.rtReal) then
- if Wrap then
- Re := efRangeHi.rtReal
- else Exit
- else if (Delta > 0) and (Re >= efRangeHi.rtReal) then
- if Wrap then
- Re := efRangeLo.rtReal
- else Exit
- else
- Re := Re + Delta;
-
- {insure valid value}
- if Re < efRangeLo.rtReal then
- Re := efRangeLo.rtReal;
- if Re > efRangeHi.rtReal then
- Re := efRangeHi.rtReal;
-
- efTransfer(@Re, otf_SetData);
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueExtended;
- var
- Ex : Extended;
- Code : Integer;
- begin
- {convert efEditSt to an real}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Ex, Code);
-{$ELSE}
- Val(String(S), Ex, Code);
-{$ENDIF}
- if Code = 0 then begin
- if (Delta < 0) and (Ex <= efRangeLo.rtExt) then
- if Wrap then
- Ex := efRangeHi.rtExt
- else Exit
- else if (Delta > 0) and (Ex >= efRangeHi.rtExt) then
- if Wrap then
- Ex := efRangeLo.rtExt
- else Exit
- else
- Ex := Ex + Delta;
-
- {insure valid value}
- if Ex < efRangeLo.rtExt then
- Ex := efRangeLo.rtExt;
- if Ex > efRangeHi.rtExt then
- Ex := efRangeHi.rtExt;
-
- efTransfer(@Ex, otf_SetData);
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueDouble;
- var
- Db : Double;
- Code : Integer;
- begin
- {convert efEditSt to an real}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Db, Code);
-{$ELSE}
- Val(String(S), Db, Code);
-{$ENDIF}
- if Code = 0 then begin
- if (Delta < 0) and (Db <= efRangeLo.rtExt) then
- if Wrap then
- Db := efRangeHi.rtExt
- else Exit
- else if (Delta > 0) and (Db >= efRangeHi.rtExt) then
- if Wrap then
- Db := efRangeLo.rtExt
- else Exit
- else
- Db := Db + Delta;
-
- {insure valid value}
- if Db < efRangeLo.rtExt then
- Db := efRangeLo.rtExt;
- if Db > efRangeHi.rtExt then
- Db := efRangeHi.rtExt;
-
- efTransfer(@Db, otf_SetData);
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueSingle;
- var
- Si : Single;
- Code : Integer;
- begin
- {convert efEditSt to an real}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Si, Code);
-{$ELSE}
- Val(String(S), Si, Code);
-{$ENDIF}
- if Code = 0 then begin
- if (Delta < 0) and (Si <= efRangeLo.rtExt) then
- if Wrap then
- Si := efRangeHi.rtExt
- else Exit
- else if (Delta > 0) and (Si >= efRangeHi.rtExt) then
- if Wrap then
- Si := efRangeLo.rtExt
- else Exit
- else
- Si := Si + Delta;
-
- {insure valid value}
- if Si < efRangeLo.rtExt then
- Si := efRangeLo.rtExt;
- if Si > efRangeHi.rtExt then
- Si := efRangeHi.rtExt;
-
- efTransfer(@Si, otf_SetData);
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueComp;
- var
-{$IFNDEF FPC}
- Co : Comp;
-{$ELSE}
- {$IFDEF CPU86}
- Co : Comp;
- {$ELSE}
- Co : Double;
- {$ENDIF}
-{$ENDIF}
- Code : Integer;
- begin
- {convert efEditSt to an real}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Co, Code);
-{$ELSE}
- Val(String(S), Co, Code);
-{$ENDIF}
- if Code = 0 then begin
- if (Delta < 0) and (Co <= efRangeLo.rtExt) then
- if Wrap then
- Co := efRangeHi.rtExt
- else Exit
- else if (Delta > 0) and (Co >= efRangeHi.rtExt) then
- if Wrap then
- Co := efRangeLo.rtExt
- else Exit
- else
- Co := Co + Delta;
-
- {insure valid value}
- if Co < efRangeLo.rtExt then
- Co := efRangeLo.rtExt;
- if Co > efRangeHi.rtExt then
- Co := efRangeHi.rtExt;
-
- efTransfer(@Co, otf_SetData);
- efPerformRepaint(True);
- end;
- end;
-
-begin
- if not (sefHaveFocus in sefOptions) then
- Exit;
- case FSimpleDataType of
- sftString : {not supported for this field type};
- sftChar : IncDecValueChar;
- sftBoolean : IncDecValueBoolean;
- sftYesNo : IncDecValueYesNo;
- sftLongInt,
- sftWord,
- sftInteger,
- sftByte,
- sftShortInt : IncDecValueLongInt;
- sftReal : IncDecValueReal;
- sftExtended : IncDecValueExtended;
- sftDouble : IncDecValueDouble;
- sftSingle : IncDecValueSingle;
- sftComp : IncDecValueComp;
- else
- raise EOvcException.Create(GetOrphStr(SCInvalidParamValue));
- end;
- efPositionCaret(False);
-end;
-
-function TOvcCustomSimpleField.efTransfer(DataPtr : Pointer; TransferFlag : Word) : Word;
- {-transfer data to/from the entry fields}
-var
- S : TEditString;
-
- procedure TransferString;
- var
- I : Integer;
- begin
- if TransferFlag = otf_GetData then
- ShortString(DataPtr^) := StrPas(efEditSt)
- else begin
- if ShortString(DataPtr^) = '' then
- efEditSt[0] := #0
- else begin
- StrPLCopy(efEditSt, ShortString(DataPtr^), MaxLength);
- for I := 0 to Integer(StrLen(efEditSt))-1 do
- efFixCase(efNthMaskChar(I), efEditSt[I], #255);
- end;
- end;
- end;
-
- procedure TransferChar;
- begin
- if TransferFlag = otf_GetData then
- AnsiChar(DataPtr^) := efEditSt[0]
- else begin
- efEditSt[0] := AnsiChar(DataPtr^);
- efEditSt[1] := #0;
- end;
- end;
-
- procedure TransferBoolean;
- begin
- if TransferFlag = otf_GetData then
- Boolean(DataPtr^) := (UpCaseChar(efEditSt[0]) = IntlSupport.TrueChar)
- else begin
- if Boolean(DataPtr^) then
- efEditSt[0] := IntlSupport.TrueChar
- else
- efEditSt[0] := IntlSupport.FalseChar;
- efEditSt[1] := #0;
- end;
- end;
-
- procedure TransferYesNo;
- begin
- if TransferFlag = otf_GetData then
- Boolean(DataPtr^) := (UpCaseChar(efEditSt[0]) = IntlSupport.YesChar)
- else begin
- if Boolean(DataPtr^) then
- efEditSt[0] := IntlSupport.YesChar
- else
- efEditSt[0] := IntlSupport.NoChar;
- efEditSt[1] := #0;
- end;
- end;
-
- procedure TransferLongInt;
- begin
- if TransferFlag = otf_GetData then begin
- if not efStr2Long(efEditSt, LongInt(DataPtr^)) then
- LongInt(DataPtr^) := 0;
- end else
- efLong2Str(efEditSt, LongInt(DataPtr^));
- end;
-
- procedure TransferWord;
- var
- L : LongInt;
- begin
- if TransferFlag = otf_GetData then begin
- if efStr2Long(efEditSt, L) then
- Word(DataPtr^) := Word(L)
- else
- Word(DataPtr^) := 0;
- end else
- efLong2Str(efEditSt, Word(DataPtr^));
- end;
-
- procedure TransferInteger;
- var
- L : LongInt;
- begin
- if TransferFlag = otf_GetData then begin
- if efStr2Long(efEditSt, L) then
- SmallInt(DataPtr^) := SmallInt(L)
- else
- SmallInt(DataPtr^) := 0;
- end else
- efLong2Str(efEditSt, SmallInt(DataPtr^));
- end;
-
- procedure TransferByte;
- var
- L : LongInt;
- begin
- if TransferFlag = otf_GetData then begin
- if efStr2Long(efEditSt, L) then
- Byte(DataPtr^) := Byte(L)
- else
- Byte(DataPtr^) := 0;
- end else
- efLong2Str(efEditSt, Byte(DataPtr^));
- end;
-
- procedure TransferShortInt;
- var
- L : LongInt;
- begin
- if TransferFlag = otf_GetData then begin
- if efStr2Long(efEditSt, L) then
- ShortInt(DataPtr^) := ShortInt(L)
- else
- ShortInt(DataPtr^) := 0;
- end else
- efLong2Str(efEditSt, ShortInt(DataPtr^));
- end;
-
- procedure TransferReal;
- label
- UseExp;
- var
- Code : Integer;
- I : Cardinal;
- R : Real;
- begin
- if TransferFlag = otf_GetData then begin
- StrCopy(S, efEditSt);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(PAnsiChar(@S[0]), R, Code);
-{$ELSE}
- Val(String(PAnsiChar(@S[0])), R, Code);
-{$ENDIF}
- if Code <> 0 then
- R := 0;
- Real(DataPtr^) := R;
- end else begin
- {try to use regular notation}
- R := Real(DataPtr^);
- if StrScan(efPicture, pmScientific) <> nil then
- goto UseExp;
- Str(R:0:DecimalPlaces, S);
-
- {trim trailing 0's if appropriate}
- if StrScan(S, pmDecimalPt) <> nil then
- TrimTrailingZerosPChar(S);
-
- {does it fit?}
- if StrLen(S) > MaxLength then begin
- {won't fit--use scientific notation}
- UseExp:
- if (DecimalPlaces <> 0) and (9+DecimalPlaces < MaxLength) then
- Str(R:9+DecimalPlaces, S)
- else
- Str(R:MaxLength, S);
- TrimAllSpacesPChar(S);
- TrimEmbeddedZerosPChar(S);
- end;
-
- {convert decimal point}
- if StrChPos(S, pmDecimalPt, I) then
- S[I] := IntlSupport.DecimalChar;
-
- StrLCopy(efEditSt, S, MaxLength);
- end;
- end;
-
- procedure TransferExtended;
- label
- UseExp;
- var
- Code : Integer;
- I : Cardinal;
- E : Extended;
- begin
- if TransferFlag = otf_GetData then begin
- StrCopy(S, efEditSt);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, E, Code);
-{$ELSE}
- Val(String(S), E, Code);
-{$ENDIF}
- if Code <> 0 then
- E := 0;
- Extended(DataPtr^) := E;
- end else begin
- {try to use regular notation}
- E := Extended(DataPtr^);
- if StrScan(efPicture, pmScientific) <> nil then
- goto UseExp;
- Str(E:0:DecimalPlaces, S);
-
- {trim trailing 0's if appropriate}
- if StrScan(S, pmDecimalPt) <> nil then
- TrimTrailingZerosPChar(S);
-
- {does it fit?}
- if StrLen(S) > MaxLength then begin
- {won't fit--use scientific notation}
- UseExp:
- if (DecimalPlaces <> 0) and (9+DecimalPlaces < MaxLength) then
- Str(E:9+DecimalPlaces, S)
- else
- Str(E:MaxLength, S);
- TrimAllSpacesPChar(S);
- TrimEmbeddedZerosPChar(S);
- end;
-
- {convert decimal point}
- if StrChPos(S, pmDecimalPt, I) then
- S[I] := IntlSupport.DecimalChar;
-
- StrLCopy(efEditSt, S, MaxLength);
- end;
- end;
-
- procedure TransferDouble;
- label
- UseExp;
- var
- Code : Integer;
- I : Cardinal;
- D : Double;
- begin
- if TransferFlag = otf_GetData then begin
- StrCopy(S, efEditSt);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(PAnsiChar(@S[0]), D, Code);
-{$ELSE}
- Val(String(PAnsiChar(@S[0])), D, Code);
-{$ENDIF}
- if Code <> 0 then
- D := 0;
- Double(DataPtr^) := D;
- end else begin
- {try to use regular notation}
- D := Double(DataPtr^);
- if StrScan(efPicture, pmScientific) <> nil then
- goto UseExp;
- Str(D:0:DecimalPlaces, S);
-
- {trim trailing 0's if appropriate}
- if StrScan(S, pmDecimalPt) <> nil then
- TrimTrailingZerosPChar(S);
-
- {does it fit?}
- if StrLen(S) > MaxLength then begin
- {won't fit--use scientific notation}
- UseExp:
- if (DecimalPlaces <> 0) and (9+DecimalPlaces < MaxLength) then
- Str(D:9+DecimalPlaces, S)
- else
- Str(D:MaxLength, S);
- TrimAllSpacesPChar(S);
- TrimEmbeddedZerosPChar(S);
- end;
-
- {convert decimal point}
- if StrChPos(S, pmDecimalPt, I) then
- S[I] := IntlSupport.DecimalChar;
-
- StrLCopy(efEditSt, S, MaxLength);
- end;
- end;
-
- procedure TransferSingle;
- label
- UseExp;
- var
- Code : Integer;
- I : Cardinal;
- G : Single;
- begin
- if TransferFlag = otf_GetData then begin
- StrCopy(S, efEditSt);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, G, Code);
-{$ELSE}
- Val(String(S), G, Code);
-{$ENDIF}
- if Code <> 0 then
- G := 0;
- Single(DataPtr^) := G;
- end else begin
- {try to use regular notation}
- G := Single(DataPtr^);
- if StrScan(efPicture, pmScientific) <> nil then
- goto UseExp;
- Str(G:0:DecimalPlaces, S);
-
- {trim trailing 0's if appropriate}
- if StrScan(S, pmDecimalPt) <> nil then
- TrimTrailingZerosPChar(S);
-
- {does it fit?}
- if StrLen(S) > MaxLength then begin
- {won't fit--use scientific notation}
- UseExp:
- if (DecimalPlaces <> 0) and (9+DecimalPlaces < MaxLength) then
- Str(G:9+DecimalPlaces, S)
- else
- Str(G:MaxLength, S);
- TrimAllSpacesPChar(S);
- TrimEmbeddedZerosPChar(S);
- end;
-
- {convert decimal point}
- if StrChPos(S, pmDecimalPt, I) then
- S[I] := IntlSupport.DecimalChar;
-
- StrLCopy(efEditSt, S, MaxLength);
- end;
- end;
-
- procedure TransferComp;
- {-transfer data to or from Comp fields}
- label
- UseExp;
- var
- Code : Integer;
-{$IFNDEF FPC}
- C : Comp;
-{$ELSE}
- {$IFDEF CPU86}
- C : Comp;
- {$ELSE}
- C : Double;
- {$ENDIF}
-{$ENDIF}
- begin
- if TransferFlag = otf_GetData then begin
- StrCopy(S, efEditSt);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(PAnsiChar(@S[0]), C, Code);
-{$ELSE}
- Val(String(PAnsiChar(@S[0])), C, Code);
-{$ENDIF}
- if Code <> 0 then
- C := 0;
-{$IFNDEF FPC}
- Comp(DataPtr^) := C;
-{$ELSE}
- {$IFDEF CPU86}
- Comp(DataPtr^) := C;
- {$ELSE}
- Double(DataPtr^) := C;
- {$ENDIF}
-{$ENDIF}
- end else begin
- {try to use regular notation}
-{$IFNDEF FPC}
- C := Comp(DataPtr^);
-{$ELSE}
- {$IFDEF CPU86}
- C := Comp(DataPtr^);
- {$ELSE}
- C := Double(DataPtr^);
- {$ENDIF}
-{$ENDIF}
- if StrScan(efPicture, pmScientific) <> nil then
- goto UseExp;
- Str(C:0:DecimalPlaces, S);
-
- {trim trailing 0's if appropriate}
- if StrScan(S, pmDecimalPt) <> nil then
- TrimTrailingZerosPChar(S);
-
- {does it fit?}
- if StrLen(S) > MaxLength then begin
- {won't fit--use scientific notation}
- UseExp:
- Str(C:MaxLength, S);
- TrimAllSpacesPChar(S);
- TrimEmbeddedZerosPChar(S);
- end;
- StrLCopy(efEditSt, S, MaxLength);
- end;
- end;
-
-begin {transfer}
- if DataPtr = nil then begin
- Result := 0;
- Exit;
- end;
-
- case FSimpleDataType of
- sftString : TransferString;
- sftChar : TransferChar;
- sftBoolean : TransferBoolean;
- sftYesNo : TransferYesNo;
- sftLongInt : TransferLongInt;
- sftWord : TransferWord;
- sftInteger : TransferInteger;
- sftByte : TransferByte;
- sftShortInt : TransferShortInt;
- sftReal : TransferReal;
- sftExtended : TransferExtended;
- sftDouble : TransferDouble;
- sftSingle : TransferSingle;
- sftComp : TransferComp;
- else
- raise EOvcException.Create(GetOrphStr(SCInvalidParamValue));
- end;
-
- Result := inherited efTransfer(DataPtr, TransferFlag);
-end;
-
-function TOvcCustomSimpleField.efValidateField : Word;
- {-validate contents of field; result is error code or 0}
-var
- S : TEditString;
-
- procedure ValidateString;
- var
- L : Word;
- begin
- if sefGettingValue in sefOptions then
- Exit;
-
- if efoTrimBlanks in Options then
- if sefHaveFocus in sefOptions then begin
- L := StrLen(efEditSt);
- TrimAllSpacesPChar(efEditSt);
- if StrLen(efEditSt) <> L then
- Invalidate;
- end;
- end;
-
- procedure ValidateChar;
- begin
- if (efRangeLo.rtChar <> efRangeHi.rtChar) and
- ((efEditSt[0] < efRangeLo.rtChar) or (efEditSt[0] > efRangeHi.rtChar)) then
- Result := oeRangeError;
- end;
-
- procedure ValidateBoolean;
- begin
- if (UpCaseChar(efEditSt[0]) <> IntlSupport.TrueChar) and
- (UpCaseChar(efEditSt[0]) <> IntlSupport.FalseChar) then
- Result := oeRangeError;
- end;
-
- procedure ValidateYesNo;
- begin
- if (UpCaseChar(efEditSt[0]) <> IntlSupport.YesChar) and
- (UpCaseChar(efEditSt[0]) <> IntlSupport.NoChar) then
- Result := oeRangeError;
- end;
-
- procedure ValidateLongInt;
- var
- L : LongInt;
- begin
- if not efStr2Long(efEditSt, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- efTransfer(@L, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateWord;
- var
- L : LongInt;
- begin
- if not efStr2Long(efEditSt, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- efTransfer(@L, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateInteger;
- var
- L : LongInt;
- I : Integer;
- begin
- if not efStr2Long(efEditSt, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- I := L;
- efTransfer(@I, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateByte;
- var
- L : LongInt;
- B : Byte;
- begin
- if not efStr2Long(efEditSt, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- B := L;
- efTransfer(@B, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateShortInt;
- var
- L : LongInt;
- Si : ShortInt;
- begin
- if not efStr2Long(efEditSt, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- Si := L;
- efTransfer(@Si, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateReal;
- var
- R : Real;
- Code : Integer;
- begin
- {convert efEditSt to a real}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, R, Code);
-{$ELSE}
- Val(String(S), R, Code);
-{$ENDIF}
-
- {format OK?}
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (R < efRangeLo.rtReal) or (R > efRangeHi.rtReal) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- efTransfer(@R, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateExtended;
- var
- E : Extended;
- Code : Integer;
- begin
- {convert efEditSt to an extended}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, E, Code);
-{$ELSE}
- Val(String(S), E, Code);
-{$ENDIF}
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (E < efRangeLo.rtExt) or (E > efRangeHi.rtExt) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- efTransfer(@E, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateDouble;
- var
- E : Extended;
- D : Double;
- Code : Integer;
- begin
- {convert efEditSt to an extended}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, E, Code);
-{$ELSE}
- Val(String(S), E, Code);
-{$ENDIF}
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (E < efRangeLo.rtExt) or (E > efRangeHi.rtExt) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- D := E;
- efTransfer(@D, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateSingle;
- var
- E : Extended;
- Si : Single;
- Code : Integer;
- begin
- {convert efEditSt to an extended}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, E, Code);
-{$ELSE}
- Val(String(S), E, Code);
-{$ENDIF}
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (E < efRangeLo.rtExt) or (E > efRangeHi.rtExt) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- Si := E;
- efTransfer(@Si, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateComp;
- var
- E : Extended;
-{$IFNDEF FPC}
- C : Comp;
-{$ELSE}
- {$IFDEF CPU86}
- C : Comp;
- {$ELSE}
- C : Double;
- {$ENDIF}
-{$ENDIF}
- Code : Integer;
- begin
- {convert efEditSt to an extended}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, C, Code);
-{$ELSE}
- Val(String(S), C, Code);
-{$ENDIF}
- E := C;
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (E < efRangeLo.rtExt) or (E > efRangeHi.rtExt) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- efTransfer(@C, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
-begin
- Result := 0;
- case FSimpleDataType of
- sftString : ValidateString;
- sftChar : ValidateChar;
- sftBoolean : ValidateBoolean;
- sftYesNo : ValidateYesNo;
- sftLongInt : ValidateLongInt;
- sftWord : ValidateWord;
- sftInteger : ValidateInteger;
- sftByte : ValidateByte;
- sftShortInt : ValidateShortInt;
- sftReal : ValidateReal;
- sftExtended : ValidateExtended;
- sftDouble : ValidateDouble;
- sftSingle : ValidateSingle;
- sftComp : ValidateComp;
- end;
-
- if not (sefUserValidating in sefOptions) then begin
- {user may retrieve data from field. flag that we are doing}
- {user validation to avoid calling this routine recursively}
- Include(sefOptions, sefUserValidating);
- DoOnUserValidation(Result);
- Exclude(sefOptions, sefUserValidating);
- end;
-end;
-
-procedure TOvcCustomSimpleField.sfSetDataType(Value : TSimpleDataType);
- {-set the data type for this field}
-begin
- if FSimpleDataType <> Value then begin
- FSimpleDataType := Value;
- efDataType := sfGetDataType(FSimpleDataType);
- Options := Options + [efoCaretToEnd];
- efSetDefaultRange(efDataType);
-
- {set defaults for this field type}
- sfResetFieldProperties(FSimpleDataType);
- if HandleAllocated then begin
- {don't save data through create window}
- efSaveData := False;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
- end;
-end;
-
-procedure TOvcCustomSimpleField.sfSetPictureMask(Value: AnsiChar);
- {-set the picture mask}
-var
- Buf : array[0..1] of AnsiChar;
-begin
- if FPictureMask <> Value then begin
- if Value in SimplePictureChars then begin
- FPictureMask := Value;
- if csDesigning in ComponentState then begin
- efPicture[0] := Value;
- efPicture[1] := #0;
- Repaint;
- end else begin
- Buf[0] := Value;
- Buf[1] := #0;
- efChangeMask(Buf);
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
- end else
- raise EInvalidPictureMask.Create(Value);
- end;
-end;
-
-function TOvcCustomSimpleField.sfGetDataType(Value : TSimpleDataType) : Byte;
- {-return a Byte value representing the type of this field}
-begin
- case Value of
- sftString : Result := fidSimpleString;
- sftChar : Result := fidSimpleChar;
- sftBoolean : Result := fidSimpleBoolean;
- sftYesNo : Result := fidSimpleYesNo;
- sftLongInt : Result := fidSimpleLongInt;
- sftWord : Result := fidSimpleWord;
- sftInteger : Result := fidSimpleInteger;
- sftByte : Result := fidSimpleByte;
- sftShortInt : Result := fidSimpleShortInt;
- sftReal : Result := fidSimpleReal;
- sftExtended : Result := fidSimpleExtended;
- sftDouble : Result := fidSimpleDouble;
- sftSingle : Result := fidSimpleSingle;
- sftComp : Result := fidSimpleComp;
- else
- raise EOvcException.Create(GetOrphStr(SCInvalidParamValue));
- end;
-end;
-
-procedure TOvcCustomSimpleField.sfResetFieldProperties(FT : TSimpleDataType);
- {-reset field properties based on current setings}
-
- procedure Update(Len: Word; Mask: AnsiChar);
- begin
- MaxLength := Len;
- FPictureMask := Mask;
- efPicture[0] := Mask;
- efPicture[1] := #0;
- DecimalPlaces := 0;
- end;
-
-begin
- case FT of
- sftString : Update(15, pmAnyChar);
- sftBoolean : Update(1, pmTrueFalse);
- sftYesNo : Update(1, pmYesNo);
- sftChar : Update(1, pmAnyChar);
- sftLongInt : Update(11, pmWhole);
- sftWord : Update(5, pmPositive);
- sftInteger : Update(6, pmWhole);
- sftByte : Update(3, pmPositive);
- sftShortInt : Update(4, pmWhole);
- sftReal : Update(14, pmDecimal);
- sftExtended : Update(14, pmDecimal);
- sftDouble : Update(14, pmDecimal);
- sftSingle : Update(14, pmDecimal);
- sftComp : Update(14, pmWhole);
- else
- raise EOvcException.Create(GetOrphStr(SCInvalidParamValue));
- end;
-end;
-
-procedure TOvcCustomSimpleField.sfSetDefaultRanges;
- {-set default range values based on the field type}
-begin
- case FSimpleDataType of
- sftChar, sftBoolean, sftYesNo :
- if efRangeLo.rtChar = efRangeHi.rtChar then
- efSetDefaultRange(efDataType);
- sftLongInt, sftWord, sftInteger, sftByte, sftShortInt :
- if efRangeLo.rtLong = efRangeHi.rtLong then
- efSetDefaultRange(efDataType);
- sftReal :
- if efRangeLo.rtReal = efRangeHi.rtReal then
- efSetDefaultRange(efDataType);
- sftExtended, sftDouble, sftSingle, sftComp :
- if efRangeLo.rtExt = efRangeHi.rtExt then
- efSetDefaultRange(efDataType);
- else
- efSetDefaultRange(efDataType);
- end;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/c6/c60190370fba57b26ea965395fc25cdc92bcf43c.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/c6/c60190370fba57b26ea965395fc25cdc92bcf43c.svn-base
deleted file mode 100644
index 6ca4fa8d..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/c6/c60190370fba57b26ea965395fc25cdc92bcf43c.svn-base
+++ /dev/null
@@ -1,43 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 546
- Height = 403
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- OnCreate = FormCreate
- PixelsPerInch = 96
- object Label1: TLabel
- Left = 40
- Top = 304
- Width = 473
- Height = 33
- AutoSize = False
- Caption = 'Double-click an item in list'
- Color = clBtnHighlight
- ParentColor = False
- end
- object OvcVirtualListBox1: TOvcVirtualListBox
- Left = 40
- Top = 40
- Width = 473
- Height = 238
- Header = 'Header goes here'
- HeaderColor.BackColor = clBtnFace
- HeaderColor.TextColor = clBtnText
- ProtectColor.BackColor = clRed
- ProtectColor.TextColor = clWhite
- RowHeight = 13
- SelectColor.BackColor = clHighlight
- SelectColor.TextColor = clHighlightText
- ShowHeader = True
- UseTabStops = True
- OnGetItem = OvcVirtualListBox1GetItem
- TabOrder = 0
- OnDblClick = OvcVirtualListBox1DblClick
- end
-end
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/c8/c88c1321026bf36879d2cef0176f957bfa5632f9.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/c8/c88c1321026bf36879d2cef0176f957bfa5632f9.svn-base
deleted file mode 100644
index 98a1f316..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/pristine/c8/c88c1321026bf36879d2cef0176f957bfa5632f9.svn-base and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/c8/c8f97ddbc3b8d4e94630ea3259a3edbb46da01bb.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/c8/c8f97ddbc3b8d4e94630ea3259a3edbb46da01bb.svn-base
deleted file mode 100644
index d6843db4..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/c8/c8f97ddbc3b8d4e94630ea3259a3edbb46da01bb.svn-base
+++ /dev/null
@@ -1,59 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/cc/cc10992809e568599dd530140e4d25301c1fdc7f.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/cc/cc10992809e568599dd530140e4d25301c1fdc7f.svn-base
deleted file mode 100644
index 5487257d..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/cc/cc10992809e568599dd530140e4d25301c1fdc7f.svn-base
+++ /dev/null
@@ -1,33 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls, ovcurl;
-
-type
- TForm1 = class(TForm)
- OvcURL1: TOvcURL;
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.dfm}
-{$ENDIF}
-
-initialization
-{$IFDEF LCL}
-{$I unit1.lrs} {Include form's resource file}
-{$ENDIF}
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/cd/cd802dab109c7c7ffa09dd6c81de359f2f1867a8.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/cd/cd802dab109c7c7ffa09dd6c81de359f2f1867a8.svn-base
deleted file mode 100644
index e3ce41f6..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/cd/cd802dab109c7c7ffa09dd6c81de359f2f1867a8.svn-base
+++ /dev/null
@@ -1,30 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 415
- Height = 289
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- PixelsPerInch = 96
- object OvcSpinner1: TOvcSpinner
- Left = 144
- Top = 88
- Width = 49
- Height = 65
- AutoRepeat = True
- Delta = 1.000000000000000000
- FocusedControl = Edit1
- end
- object Edit1: TEdit
- Left = 208
- Top = 112
- Width = 57
- Height = 21
- TabOrder = 1
- Text = '0'
- end
-end
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/cd/cde50bb2e3a1639cbf64484e86e35605f8c297f5.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/cd/cde50bb2e3a1639cbf64484e86e35605f8c297f5.svn-base
deleted file mode 100644
index 06007cc7..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/cd/cde50bb2e3a1639cbf64484e86e35605f8c297f5.svn-base
+++ /dev/null
@@ -1,468 +0,0 @@
-{*********************************************************}
-{* OVCTCGLY.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 ovctcgly;
- {-Orpheus Table Cell - Glyph type}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- SysUtils, Graphics, Classes, Controls,
- OvcTCmmn, OvcTCell, OvcTGRes, OvcTCBmp;
-
-type
- TOvcTCGlyphEdit = class(TCustomControl)
- protected {private}
- {.Z+}
- FValue : Integer;
- FCell : TOvcBaseTableCell;
- FRow : TRowNum;
- FCol : TColNum;
- FCellAttr : TOvcCellAttributes;
- {.Z-}
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
-
- protected
- {.Z+}
- procedure SetValue(V : integer);
-
- procedure WMGetDlgCode(var Msg : TMessage); message WM_GETDLGCODE;
- procedure WMKeyDown(var Msg : TWMKey); message WM_KEYDOWN;
- procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS;
- procedure WMLButtonDown(var Msg : TWMMouse); message WM_LBUTTONDOWN;
- procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
- {.Z-}
-
- public
- constructor Create(AOwner : TComponent); override;
- procedure Paint; override;
-
- property CellOwner : TOvcBaseTableCell
- read FCell write FCell;
- property Value : integer
- read FValue write SetValue;
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D;
-{$ENDIF}
- end;
-
- TOvcTCCustomGlyph = class(TOvcTCBaseBitMap)
- protected {private}
- {.Z+}
- FCellGlyphs : TOvcCellGlyphs;
- FEdit : TOvcTCGlyphEdit;
- {.Z-}
-
- protected
- {.Z+}
- function GetCellEditor : TControl; override;
- procedure SetCellGlyphs(CBG : TOvcCellGlyphs);
-
- procedure GlyphsHaveChanged(Sender : TObject);
-
- {painting}
- procedure tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer); override;
- {.Z-}
-
- {properties}
- property CellGlyphs : TOvcCellGlyphs
- read FCellGlyphs write SetCellGlyphs;
-
- public
- {create/destroy}
- constructor Create(AOwner : TComponent); override;
- destructor Destroy; override;
- function CreateEditControl : TOvcTCGlyphEdit; virtual;
-
- function CanAssignGlyphs(CBG : TOvcCellGlyphs) : boolean; virtual;
-
- function EditHandle : THandle; override;
- procedure EditHide; override;
- procedure EditMove(CellRect : TRect); override;
-
- procedure SaveEditedData(Data : pointer); override;
- procedure StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer); override;
- procedure StopEditing(SaveValue : boolean;
- Data : pointer); override;
-
- end;
-
- TOvcTCGlyph = class(TOvcTCCustomGlyph)
- published
- {properties inherited from custom ancestor}
- property AcceptActivationClick default True;
- property Access default otxDefault;
- property Adjust default otaDefault;
- property CellGlyphs;
- property Color;
- property Hint;
- property Margin default 4;
- property ShowHint default False;
- property Table;
- property TableColor default True;
-
- {events inherited from custom ancestor}
- property OnClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnOwnerDraw;
- end;
-
-implementation
-
-
-{===TOvcTCCustomGlyph creation/destruction===========================}
-constructor TOvcTCCustomGlyph.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
- FCellGlyphs := TOvcCellGlyphs.Create;
- FCellGlyphs.OnCfgChanged := GlyphsHaveChanged;
- FAcceptActivationClick := true;
- end;
-{--------}
-destructor TOvcTCCustomGlyph.Destroy;
- begin
- FCellGlyphs.Free;
- inherited Destroy;
- end;
-{--------}
-function TOvcTCCustomGlyph.CanAssignGlyphs(CBG : TOvcCellGlyphs) : boolean;
- begin
- Result := true;
- end;
-{--------}
-function TOvcTCCustomGlyph.CreateEditControl : TOvcTCGlyphEdit;
- begin
- Result := TOvcTCGlyphEdit.Create(FTable);
- end;
-{--------}
-function TOvcTCCustomGlyph.GetCellEditor : TControl;
- begin
- Result := FEdit;
- end;
-{--------}
-procedure TOvcTCCustomGlyph.GlyphsHaveChanged(Sender : TObject);
- begin
- tcDoCfgChanged;
- end;
-{--------}
-procedure TOvcTCCustomGlyph.SetCellGlyphs(CBG : TOvcCellGlyphs);
- begin
- if CanAssignGlyphs(CBG) then
- FCellGlyphs.Assign(CBG);
- end;
-{====================================================================}
-
-
-{===TOvcTCCustomGlyph painting================================}
-procedure TOvcTCCustomGlyph.tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer);
- var
- B : ^integer absolute Data;
- BitMapInfo : TCellBitMapInfo;
- begin
- {set up a bitmap info record}
- with BitMapInfo do
- begin
- BM := FCellGlyphs.BitMap;
- ActiveCount := FCellGlyphs.ActiveGlyphCount;
- Count := FCellGlyphs.GlyphCount;
- if (Data = nil) then
- begin
- if (csDesigning in ComponentState) then
- Index := (RowNum mod ActiveCount) {for testing purposes}
- else
- Index := -1
- end
- else
- Index := B^;
- if (Index >= ActiveCount) then
- Index := pred(ActiveCount);
- end;
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, @BitMapInfo);
- end;
-{====================================================================}
-
-
-{===TOvcTCCustomGlyph editing========================================}
-function TOvcTCCustomGlyph.EditHandle : THandle;
- begin
- if Assigned(FEdit) then
- Result := FEdit.Handle
- else
- Result := 0;
- end;
-{--------}
-procedure TOvcTCCustomGlyph.EditHide;
- begin
- if Assigned(FEdit) then
- with FEdit do
- begin
- SetWindowPos(FEdit.Handle, HWND_TOP,
- 0, 0, 0, 0,
- SWP_HIDEWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- end;
- end;
-{--------}
-procedure TOvcTCCustomGlyph.EditMove(CellRect : TRect);
- var
- EditHandle : HWND;
- begin
- if Assigned(FEdit) then
- begin
- EditHandle := FEdit.Handle;
- with CellRect do
- SetWindowPos(EditHandle, HWND_TOP,
- Left, Top, Right-Left, Bottom-Top,
- SWP_SHOWWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- InvalidateRect(EditHandle, nil, false);
- UpdateWindow(EditHandle);
- end;
- end;
-{--------}
-procedure TOvcTCCustomGlyph.SaveEditedData(Data : pointer);
- begin
- if Assigned(Data) then
- Integer(Data^) := FEdit.Value;
- end;
-{--------}
-procedure TOvcTCCustomGlyph.StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer);
- begin
- FEdit := CreateEditControl;
- with FEdit do
- begin
- CellOwner := Self;
- if Data = nil then
- Value := 0
- else
- Value := Integer(Data^);
- FRow := RowNum;
- FCol := ColNum;
- FCellAttr := CellAttr;
- Color := CellAttr.caColor;
- Ctl3D := false;
- case CellStyle of
- tes3D : Ctl3D := true;
- end;{case}
- Left := CellRect.Left;
- Top := CellRect.Top;
- Width := CellRect.Right - CellRect.Left;
- Height := CellRect.Bottom - CellRect.Top;
- Hint := Self.Hint;
- ShowHint := Self.ShowHint;
- Parent := FTable;
- Visible := true;
- TabStop := false;
-
- OnClick := Self.OnClick;
- OnDblClick := Self.OnDblClick;
- OnDragDrop := Self.OnDragDrop;
- OnDragOver := Self.OnDragOver;
- OnEndDrag := Self.OnEndDrag;
- OnEnter := Self.OnEnter;
- OnExit := Self.OnExit;
- OnKeyDown := Self.OnKeyDown;
- OnKeyPress := Self.OnKeyPress;
- OnKeyUp := Self.OnKeyUp;
- OnMouseDown := Self.OnMouseDown;
- OnMouseMove := Self.OnMouseMove;
- OnMouseUp := Self.OnMouseUp;
- end;
- end;
-{--------}
-procedure TOvcTCCustomGlyph.StopEditing(SaveValue : boolean;
- Data : pointer);
- begin
- if SaveValue and Assigned(Data) then
- Integer(Data^) := FEdit.Value;
- FEdit.Free;
- FEdit := nil;
- end;
-{====================================================================}
-
-
-{---TOvcTCGlyphEdit===========================================}
-constructor TOvcTCGlyphEdit.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
- ControlStyle := ControlStyle - [csDoubleClicks];
- end;
-{--------}
-procedure TOvcTCGlyphEdit.Paint;
- var
- R : TRect;
- begin
-{$IFNDEF LCL}
- Windows.GetClientRect(Handle, R);
-{$ELSE}
- LclIntf.GetClientRect(Handle, R);
-{$ENDIF}
- FCell.Paint(Canvas, R, FRow, FCol, FCellAttr, @FValue);
- end;
-{--------}
-procedure TOvcTCGlyphEdit.SetValue(V : integer);
- begin
- if (V <> FValue) then
- begin
- if (V < 0) then
- V := 0
- else if (V >= TOvcTCGlyph(CellOwner).CellGlyphs.ActiveGlyphCount) then
- V := TOvcTCGlyph(CellOwner).CellGlyphs.ActiveGlyphCount;
- FValue := V;
- if HandleAllocated then
- begin
- Invalidate;
- Update;
- end;
- end;
- end;
-{--------}
-procedure TOvcTCGlyphEdit.WMGetDlgCode(var Msg : TMessage);
- begin
- Msg.Result := DLGC_WANTARROWS;
- if CellOwner.TableWantsTab then
- Msg.Result := Msg.Result or DLGC_WANTTAB;
- if CellOwner.TableWantsEnter then
- Msg.Result := Msg.Result or DLGC_WANTALLKEYS;
- end;
-{--------}
-procedure TOvcTCGlyphEdit.WMKeyDown(var Msg : TWMKey);
- var
- GridReply : TOvcTblKeyNeeds;
- GridUsedIt : boolean;
- begin
- GridUsedIt := false;
- GridReply := otkDontCare;
- if (CellOwner <> nil) then
- GridReply := CellOwner.FilterTableKey(Msg);
- case GridReply of
- otkMustHave :
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- otkWouldLike :
- if Msg.CharCode <> VK_SPACE then
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;{case}
-
- if not GridUsedIt then
- begin
- inherited;
- if (Msg.CharCode = VK_SPACE) then
- begin
- inc(FValue);
- if (FValue >= TOvcTCGlyph(FCell).FCellGlyphs.ActiveGlyphCount) then
- FValue := 0;
- Invalidate;
- Update;
-
- if ((@TOvcTCGlyph(FCell).FOnClick) <> nil) then
- OnClick(Self);
- end
- else if (Msg.CharCode = VK_BACK) then
- begin
- dec(FValue);
- if (FValue < 0) then
- FValue := pred(TOvcTCGlyph(FCell).FCellGlyphs.ActiveGlyphCount);
- Invalidate;
- Update;
-
- if ((@TOvcTCGlyph(FCell).FOnClick) <> nil) then
- OnClick(Self);
- end;
- end;
- end;
-{--------}
-procedure TOvcTCGlyphEdit.WMLButtonDown(var Msg : TWMMouse);
- begin
- inc(FValue);
- if (FValue >= TOvcTCGlyph(FCell).FCellGlyphs.ActiveGlyphCount) then
- FValue := 0;
- Invalidate;
- Update;
-
- inherited;
- end;
-{--------}
-procedure TOvcTCGlyphEdit.WMKillFocus(var Msg : TWMKillFocus);
- begin
- inherited;
- CellOwner.PostMessageToTable(ctim_KillFocus, Msg.FocusedWnd, 0);
- end;
-{--------}
-procedure TOvcTCGlyphEdit.WMSetFocus(var Msg : TWMSetFocus);
- begin
- inherited;
- CellOwner.PostMessageToTable(ctim_SetFocus, Msg.FocusedWnd, 0);
- end;
-{====================================================================}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/ce/ce5fd72224480ac03375652ba4eaf749a4df2468.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/ce/ce5fd72224480ac03375652ba4eaf749a4df2468.svn-base
deleted file mode 100644
index 2c4e470a..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/ce/ce5fd72224480ac03375652ba4eaf749a4df2468.svn-base
+++ /dev/null
@@ -1,4766 +0,0 @@
-{*********************************************************}
-{* OVCEF.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 ovcef;
- {-Base entry field class}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, Types, LclType, MyMisc, {$ENDIF}
- Classes, ClipBrd, Controls, Forms, Graphics, Menus,
- SysUtils, {$IFDEF VERSION6} Variants, {$ENDIF}
- OvcBase, OvcCaret, OvcColor, OvcConst, OvcCmd, OvcData, OvcExcpt,
- OvcIntl, OvcMisc, OvcStr, OvcUser, OvcDate, OvcBordr;
-
-type
- {user validation event}
- TUserValidationEvent =
- procedure(Sender : TObject; var ErrorCode : Word)
- of object;
- TValidationErrorEvent =
- procedure(Sender : TObject; ErrorCode : Word; ErrorMsg : string)
- of object;
-
- {options available to specific fields}
- TOvcEntryFieldOption = (efoArrowIncDec, efoCaretToEnd, efoForceInsert,
- efoForceOvertype, efoInputRequired,
- efoPasswordMode, efoReadOnly, efoRightAlign,
- efoRightJustify, efoSoftValidation,
- efoStripLiterals, efoTrimBlanks);
-
- TOvcEntryFieldOptions = set of TOvcEntryFieldOption;
-
-const
- efDefOptions = [efoCaretToEnd, efoTrimBlanks];
-
-type
- {combined color class}
- TOvcEfColors = class(TPersistent)
- protected {private}
- FDisabled : TOvcColors; {colors for disabled fields}
- FError : TOvcColors; {colors for invalid fields}
- FHighlight : TOvcColors; {background and text highlight colors}
- public
- procedure Assign(Source : TPersistent); override;
- constructor Create; virtual;
- destructor Destroy; override;
- published
- property Disabled : TOvcColors read FDisabled write FDisabled;
- property Error : TOvcColors read FError write FError;
- property Highlight : TOvcColors read FHighlight write FHighlight;
- end;
-
- {abstract entry field class}
- TOvcBaseEntryField = class(TOvcCustomControlEx)
- {.Z+}
- protected {private}
- {property instance variables}
- FAutoSize : Boolean; {size control when font changes}
- FBorders : TOvcBorders; {simple line borders}
- FBorderStyle : TBorderStyle; {border around the edit field}
- FCtrlColor : TColor; {control character foreground color}
- FDecimalPlaces : Byte; {max decimal places, if no '.' in Picture}
- FEFColors : TOvcEfColors; {entry field colors}
- FEpoch : Integer; {combined epoch year and cenury}
- FIntlSup : TOvcIntlSup; {international support object}
- FLastError : Word; {result of last validation}
- FMaxLength : Word; {maximum length of string}
- FOptions : TOvcEntryFieldOptions;
- FPadChar : AnsiChar; {character used to pad end of string}
- FPasswordChar : AnsiChar; {character used in password mode}
- FTextMargin : Integer; {indent from left (right)}
- FUninitialized : Boolean; {the field isblanked out completely except when it has the focus}
- FUserData : TOvcUserData; {field mask and data object}
- FZeroDisplay : TZeroDisplay; {true to display an empty field}
- FZeroDisplayValue : Double; {value used by ZeroDisplay logic}
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
-
- {event variables}
- FOnChange : TNotifyEvent;
- FOnError : TValidationErrorEvent;
- FOnGetEpoch : TGetEpochEvent;
- FOnUserCommand : TUserCommandEvent;
- FOnUserValidation : TUserValidationEvent;
-
- {internal variables}
- efCaret : TOvcCaretPair; {our carets}
- efDataSize : Word; {size of data type being edited}
- efDataType : Byte; {code indicating field type}
- efEditSt : TEditString; {the edit string}
- efFieldClass : Byte; {fcSimple, fcPicture, or fcNumeric}
- efHOffset : Integer; {horizontal scrolling offset}
- efHPos : Integer; {current position in field (column)}
- efPicLen : Word; {length of picture mask}
- efPicture : TPictureMask; {picture mask}
- efRangeHi : TRangeType; {high range for the field}
- efRangeLo : TRangeType; {low range for the field}
- efRightAlignActive : Boolean; {true if right-align is in use}
- efSaveData : Boolean; {save data during create window}
- efSaveEdit : PAnsiChar; {saved copy of edit string}
- efSelStart : Integer; {start of highlighted selection}
- efSelEnd : Integer; {end of highlighted selection}
- efTopMargin : Integer; {margin above text}
- sefOptions : TsefOptionSet; {secondary field options}
-
- {property methods}
- function GetAsBoolean : Boolean;
- function GetAsCents : LongInt;
- function GetAsExtended : Extended;
- function GetAsFloat : Double;
- function GetAsInteger : Longint;
- function GetAsDateTime : TDateTime;
- function GetAsStDate : TStDate;
- function GetAsStTime : TStTime;
- function GetAsString : string;
- function GetAsVariant : Variant;
- function GetCurrentPos : Integer;
- function GetDataSize : Word;
- function GetDisplayString : string;
- function GetEditString : string;
- function GetEpoch : Integer;
- function GetEverModified : Boolean;
- function GetInsCaretType : TOvcCaret;
- function GetInsertMode : Boolean;
- function GetModified : Boolean;
- function GetOvrCaretType : TOvcCaret;
- function GetRangeHiStr : string;
- function GetRangeLoStr : string;
- function GetSelLength : Integer;
- function GetSelStart : Integer;
- function GetSelText : string;
- procedure SetAsBoolean(Value : Boolean);
- procedure SetAsCents(Value : LongInt);
- procedure SetAsDateTime(Value : TDateTime);
- procedure SetAsExtended(Value : Extended);
- procedure SetAsFloat(Value : Double);
- procedure SetAsInteger(Value : Longint);
- procedure SetAsStDate(Value : TStDate);
- procedure SetAsStTime(Value : TStTime);
- procedure SetAsVariant(Value : Variant);
- procedure SetAutoSize(Value : Boolean); {$IFDEF VERSION6}{$IFNDEF LCL} override;{$ENDIF}{$ENDIF}
- procedure SetBorderStyle(Value : TBorderStyle);
- procedure SetDecimalPlaces(Value : Byte);
- procedure SetEpoch(Value : Integer);
- procedure SetEverModified(Value : Boolean);
- procedure SetInsCaretType(const Value : TOvcCaret);
- procedure SetInsertMode(Value : Boolean);
- procedure SetIntlSupport(Value : TOvcIntlSup);
- procedure SetMaxLength(Value : Word);
- procedure SetModified(Value : Boolean);
- procedure SetOptions(Value : TOvcEntryFieldOptions);
- procedure SetOvrCaretType(const Value : TOvcCaret);
- procedure SetPadChar(Value : AnsiChar);
- procedure SetPasswordChar(Value : AnsiChar);
- procedure SetRangeLoStr(const Value : string);
- procedure SetRangeHiStr(const Value : string);
- procedure SetSelLength(Value : Integer);
- procedure SetSelStart(Value : Integer);
- procedure SetSelText(const Value : string);
- procedure SetTextMargin(Value : Integer);
- procedure SetUninitialized(Value : Boolean);
- procedure SetUserData(Value : TOvcUserData);
- procedure SetZeroDisplay(Value : TZeroDisplay);
- procedure SetZeroDisplayValue(Value : Double);
-
- {internal methods}
- procedure efBorderChanged(ABorder : TObject);
- procedure efCalcTopMargin;
- procedure efColorChanged(AColor : TObject);
- function efGetTextExtent(S : PChar; Len : Integer) : Word;
- procedure efInitializeDataSize;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
- function efIsSibling(HW : TOvcHWnd{hWnd}) : Boolean;
-
- procedure efMoveFocus(C : TWinControl);
- procedure efPaintBorders;
- procedure efPerformEdit(var Msg : TMessage; Cmd : Word);
- procedure efPerformPreEditNotify(C : TWinControl);
- procedure efPerformPostEditNotify(C : TWinControl);
- procedure efReadRangeHi(Stream : TStream);
- procedure efReadRangeLo(Stream : TStream);
- function efTransferPrim(DataPtr : Pointer; TransferFlag : Word) : Word;
- procedure efWriteRangeHi(Stream : TStream);
- procedure efWriteRangeLo(Stream : TStream);
-
-
-
- {VCL control methods}
-{$IFNDEF LCL}
- procedure CMCtl3DChanged(var Msg : TMessage);
- message CM_CTL3DCHANGED;
-{$ENDIF}
- procedure CMDialogChar(var Msg : TCMDialogChar);
- message CM_DIALOGCHAR;
- procedure CMEnabledChanged(var Msg : TMessage);
- message CM_ENABLEDCHANGED;
- procedure CMFontChanged(var Msg : TMessage);
- message CM_FONTCHANGED;
-
- {private message response methods}
- procedure OMGetDataSize(var Msg : TMessage);
- message OM_GETDATASIZE;
- procedure OMReportError(var Msg : TOMReportError);
- message OM_REPORTERROR;
-
- {windows message response methods}
- procedure WMChar(var Msg : TWMChar);
- message WM_CHAR;
- procedure WMClear(var Msg : TWMClear);
- message WM_CLEAR;
- procedure WMCopy(var Msg : TWMCopy);
- message WM_COPY;
- procedure WMCut(var Msg : TWMCut);
- message WM_CUT;
- procedure WMEraseBkGnd(var Msg : TWMEraseBkGnd);
- message WM_ERASEBKGND;
- procedure WMGetDlgCode(var Msg : TWMGetDlgCode);
- message WM_GETDLGCODE;
- procedure WMKeyDown(var Msg : TWMKeyDown);
- message WM_KEYDOWN;
- procedure WMKillFocus(var Msg : TWMKillFocus);
- message WM_KILLFOCUS;
- procedure WMLButtonDblClk(var Msg : TWMLButtonDblClk);
- message WM_LBUTTONDBLCLK;
- procedure WMLButtonDown(var Msg : TWMLButtonDown);
- message WM_LBUTTONDOWN;
- procedure WMMouseActivate(var Msg : TWMMouseActivate);
- message WM_MOUSEACTIVATE;
- procedure WMMouseMove(var Msg : TWMMouseMove);
- message WM_MOUSEMOVE;
- procedure WMPaste(var Msg : TWMPaste);
- message WM_PASTE;
- procedure WMRButtonUp(var Msg : TWMRButtonDown);
- message WM_RBUTTONUP;
- procedure WMSetFocus(var Msg : TWMSetFocus);
- message WM_SETFOCUS;
- procedure WMSetFont(var Msg : TWMSetFont);
- message WM_SETFONT;
- procedure WMSetText(var Msg : TWMSetText);
- message WM_SETTEXT;
- procedure WMSize(var Msg : TWMSize);
- message WM_SIZE;
- procedure WMSysKeyDown(var Msg : TWMSysKeyDown);
- message WM_SYSKEYDOWN;
-
- {edit control message methods}
- procedure EMGetModify(var Msg : TMessage);
- message EM_GETMODIFY;
- procedure EMGetSel(var Msg : TMessage);
- message EM_GETSEL;
- procedure EMSetModify(var Msg : TMessage);
- message EM_SETMODIFY;
- procedure EMSetSel(var Msg : TMessage);
- message EM_SETSEL;
-
- protected
- {VCL methods}
- procedure CreateParams(var Params : TCreateParams);
- override;
- procedure CreateWnd;
- override;
- procedure DefineProperties(Filer : TFiler);
- override;
- procedure Paint;
- override;
-
- {dynamic event wrappers}
- procedure DoOnChange;
- dynamic;
- {-perform notification of a change}
- procedure DoOnError(ErrorCode : Word; const ErrorMsg : string);
- dynamic;
- {-perform notification of an error}
- procedure DoOnUserCommand(Command : Word);
- dynamic;
- {-perform notification of a user command}
- procedure DoOnUserValidation(var ErrorCode : Word);
- dynamic;
- {-perform call to user validation event handler}
-
- procedure DoRestoreClick(Sender : TObject);
- dynamic;
- procedure DoCutClick(Sender : TObject);
- dynamic;
- procedure DoCopyClick(Sender : TObject);
- dynamic;
- procedure DoPasteClick(Sender : TObject);
- dynamic;
- procedure DoDeleteClick(Sender : TObject);
- dynamic;
- procedure DoSelectAllClick(Sender : TObject);
- dynamic;
-
- procedure efAdjustSize;
- dynamic;
- {-adjust the size of the control based on the current font}
- function efCanClose(DoValidation : Boolean) : Boolean;
- virtual;
- {-returns true if the field contents are valid}
- procedure efCaretToEnd;
- virtual;
- {-move the caret to the end of the field}
- procedure efCaretToStart;
- virtual;
- {-move the caret to the beginning of the field}
- procedure efChangeMask(Mask : PAnsiChar);
- dynamic;
- {-change the picture mask}
- function efCharOK(PicChar : AnsiChar; var Ch : AnsiChar;
- PrevCh : AnsiChar; Fix : Boolean) : Boolean;
- {-return True if Ch is in character set corresponding to PicChar}
- procedure efConditionalBeep;
- {-beep if pefBeepOnError option is active}
- procedure efCopyPrim;
- {-Primitive clipboard copy method}
- function efBinStr2Long(St : PAnsiChar; var L : LongInt) : Boolean;
- {-convert a binary string to a longint}
- function efCalcDataSize(St : PAnsiChar; MaxLen : Word) : Word;
- {-calculate data size of a string field with literal stripping option on}
- procedure efEdit(var Msg : TMessage; Cmd : Word);
- virtual; abstract;
- {-process the specified editing command}
- function efEditBegin : Word;
- virtual;
- {-return offset of first editable position in field}
- function efFieldIsEmpty : Boolean;
- virtual;
- {-return True if the field is empty}
- procedure efFieldModified;
- {-mark the field as modified; tell parent form it changed}
- procedure efFindCtrlChars(P : PAnsiChar; var ChCnt, CtCnt : Integer);
- {-find control caracters and return normal and control char counts}
- procedure efFixCase(PicChar : AnsiChar; var Ch : AnsiChar; PrevCh : AnsiChar);
- {-fix the case of Ch based on PicChar}
- function efGetDisplayString(Dest : PAnsiChar; Size : Word) : PAnsiChar;
- virtual;
- {-return the display string in Dest and a pointer as the result}
- function efGetMousePos(MPos : Integer) : Integer;
- {-get the position of a mouse click}
- procedure efGetSampleDisplayData(T : PAnsiChar);
- dynamic;
- {-return sample data for the current field type}
- procedure efIncDecValue(Wrap : Boolean; Delta : Double);
- dynamic; abstract;
- {-increment field by Delta}
- function efIsNumericType : Boolean;
- {-return True if field is of a numeric type}
- function efIsReadOnly : Boolean;
- virtual;
- {-return True if field is read-only}
- procedure efLong2Str(P : PAnsiChar; L : LongInt);
- {-convert a longint to a string}
- procedure efMapControlChars(Dest, Src : PAnsiChar);
- {-copy from Src to Dest, mapping control characters to alph in process}
- procedure efMoveFocusToNextField;
- dynamic;
- {-give next field the focus}
- procedure efMoveFocusToPrevField;
- dynamic;
- {-give previous field the focus}
- function efNthMaskChar(N : Word) : AnsiChar;
- {-return the N'th character in the picture mask. N is 0-based}
- function efOctStr2Long(St : PAnsiChar; var L : LongInt) : Boolean;
- {-convert an octal string to a longint}
-
-{ - Hdc changed to TOvcHdc for BCB Compatibility }
- procedure efPaintPrim(DC : TOvcHDC{Hdc}; ARect : TRect; Offset : Integer);
- {-primitive routine to draw the entry field control}
-
- procedure efPerformRepaint(Modified : Boolean);
- {-flag the field as modified and redraw it}
- function efPositionCaret(Adjust : Boolean) : Boolean;
- {-position the editing caret}
- function efRangeToStRange(const Value : TRangeType) : string;
- {-returns the range as a string}
- function efStRangeToRange(const Value : string; var R : TRangeType) : Boolean;
- {-converts a string range to a RangeType}
- procedure efRemoveBadOptions;
- virtual;
- {-remove inappropriate options for this field and data type}
- procedure efResetCaret;
- virtual;
- {-move the caret to the beginning or end of the field, as appropriate}
- procedure efSaveEditString;
- {-save a copy of the edit string}
- procedure efSetDefaultRange(FT : Byte);
- {-set the default range for the given field type}
- procedure efSetInitialValue;
- {-set the initial value of the field}
- function efStr2Long(P : PAnsiChar; var L : LongInt) : Boolean;
- {-convert a string to a longint}
- function efTransfer(DataPtr : Pointer; TransferFlag : Word) : Word;
- virtual;
- {-transfer data to/from the entry fields}
- function efValidateField : Word;
- virtual; abstract;
- {-validate contents of field; result is error code or 0}
-
- {virtual property methods}
- procedure efSetCaretPos(Value : Integer);
- virtual;
- {-set position of the caret within the field}
- procedure SetAsString(const Value : string);
- virtual;
- {-sets the field value to a String Value}
- procedure SetName(const Value : TComponentName);
- override;
- {-catch when component name is changed}
-
- public
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
- procedure SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
- override;
- {.Z-}
-
- procedure ClearContents;
- {-clear the contents of the entry field}
- procedure ClearSelection;
- {-erase the highlighted text}
- procedure CopyToClipboard;
- {-copies the highlighted text to the clipboard}
- procedure CutToClipboard;
- dynamic;
- {-performs a CopyToClipboard then deletes the highlighted text from the field}
- procedure DecreaseValue(Wrap : Boolean; Delta : Double);
- {-decrease the value of the field by Delta, wrapping if enabled}
- procedure Deselect;
- {-unhighlight any highlighted text}
- function FieldIsEmpty : Boolean;
- {-return True if the field is completely empty}
- function GetStrippedEditString : string;
- dynamic;
- {-return edit string stripped of literals and semi-literals}
- function GetValue(var Data) : Word;
- {-returns the current field value in Data. Result is 0 or error code}
- procedure IncreaseValue(Wrap : Boolean; Delta : Double);
- {-increase the value of the field by Delta, wrapping if enabled}
- function IsValid : Boolean;
- {-returns true if the field is not marked as invalid}
- procedure MergeWithPicture(const S : string);
- dynamic;
- {-combines S with the picture mask and updates the edit string}
- procedure MoveCaret(Delta : Integer);
- {-moves the caret to the right or left Value positions}
- procedure MoveCaretToEnd;
- {-move the caret to the end of the field}
- procedure MoveCaretToStart;
- {-move the caret to the beginning of the field}
- procedure PasteFromClipboard;
- dynamic;
- {-places the text content of the clipboard into the field}
- procedure ProcessCommand(Cmd, CharCode : Word);
- {-process the specified command}
- procedure ResetCaret;
- {-move the caret to the beginning or end of the field, as appropriate}
- procedure Restore;
- dynamic;
- {-restore the previous contents of the field}
- procedure SelectAll;
- {-selects the current edit text}
- procedure SetInitialValue;
- {-resets the field value to its initial value}
- procedure SetRangeHi(const Value : TRangeType);
- {-set the high range for this field}
- procedure SetRangeLo(const Value : TRangeType);
- {-set the low range for this field}
- procedure SetSelection(Start, Stop : Word);
- {-mark offsets Start..Stop as selected}
- procedure SetValue(const Data);
- {-changes the field's value to the value in Data}
- function ValidateContents(ReportError : Boolean) : Word;
- dynamic;
- {-performs field validation, returns error code, and conditionally reports error}
- function ValidateSelf : Boolean;
- {-performs field validation, returns true if no errors, and reports error}
-
- {public properties}
- property ParentColor default False;
- property AsBoolean : Boolean
- read GetAsBoolean write SetAsBoolean;
- property AsCents : LongInt
- read GetAsCents write SetAsCents;
- property AsDateTime : TDateTime
- read GetAsDateTime write SetAsDateTime;
- property AsExtended : Extended
- read GetAsExtended write SetAsExtended;
- property AsFloat : Double
- read GetAsFloat write SetAsFloat;
- property AsInteger : Longint
- read GetAsInteger write SetAsInteger;
- property AsOvcDate : TOvcDate
- read GetAsStDate write SetAsStDate;
- property AsOvcTime : TOvcTime
- read GetAsStTime write SetAsStTime;
- property AsString : string
- read GetAsString write SetAsString;
- property AsVariant : Variant
- read GetAsVariant write SetAsVariant;
- property AsStDate : TStDate
- read GetAsStDate write SetAsStDate;
- property AsStTime : TStTime
- read GetAsStTime write SetAsStTime;
- property Font;
- property Canvas;
- property Color;
- property CurrentPos : Integer
- read GetCurrentPos write efSetCaretPos;
- property DataSize : Word
- read GetDataSize;
- property DisplayString : string
- read GetDisplayString;
- property EditString : string
- read GetEditString;
- property Epoch : Integer
- read GetEpoch write SetEpoch;
- property EverModified : Boolean
- read GetEverModified write SetEverModified;
-
- {.Z+}
- property InsertMode : Boolean
- read GetInsertMode write SetInsertMode;
- {.Z-}
-
- property IntlSupport : TOvcIntlSup
- read FIntlSup write SetIntlSupport;
- property LastError : Word
- read FLastError;
- property Modified : Boolean
- read GetModified write SetModified;
- property SelectionLength : Integer
- read GetSelLength write SetSelLength;
- property SelectionStart : Integer
- read GetSelStart write SetSelStart;
- property SelectedText : string
- read GetSelText write SetSelText;
- property Text : string
- read GetAsString write SetAsString;
- property UserData : TOvcUserData
- read FUserData write SetUserData;
-
- {publishable properties}
- {revised}
- property AttachedLabel : TOvcAttachedLabel
- read GetAttachedLabel;
- property AutoSize : Boolean
- read FAutoSize write SetAutoSize default True;
- property Borders : TOvcBorders
- read FBorders write FBorders;
- property BorderStyle : TBorderStyle
- read FBorderStyle write SetBorderStyle default bsSingle;
- property CaretIns : TOvcCaret
- read GetInsCaretType write SetInsCaretType;
- property CaretOvr : TOvcCaret
- read GetOvrCaretType write SetOvrCaretType;
- property ControlCharColor : TColor
- read FCtrlColor write FCtrlColor;
- property DecimalPlaces : Byte
- read FDecimalPlaces write SetDecimalPlaces;
- property EFColors : TOvcEfColors
- read FEFColors write FEFColors;
- property MaxLength : Word
- read FMaxLength write SetMaxLength default 15;
- property Options : TOvcEntryFieldOptions
- read FOptions write SetOptions default efDefOptions;
- property PadChar : AnsiChar
- read FPadChar write SetPadChar default DefPadChar;
- property PasswordChar : AnsiChar
- read FPasswordChar write SetPasswordChar default '*';
- property RangeHi : string
- read GetRangeHiStr write SetRangeHiStr stored False;
- property RangeLo : string
- read GetRangeLoStr write SetRangeLoStr stored False;
- property TextMargin : Integer
- read FTextMargin write SetTextMargin default 2;
- property Uninitialized : Boolean
- read FUninitialized write SetUninitialized default False;
- property ZeroDisplay : TZeroDisplay
- read FZeroDisplay write SetZeroDisplay default zdShow;
- property ZeroDisplayValue : Double
- read FZeroDisplayValue write SetZeroDisplayValue;
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D default True;
-{$ENDIF}
-
- {events}
- property OnChange : TNotifyEvent
- read FOnChange write FOnChange;
- property OnError : TValidationErrorEvent
- read FOnError write FOnError;
- property OnGetEpoch : TGetEpochEvent
- read FOnGetEpoch write FOnGetEpoch;
- property OnUserCommand : TUserCommandEvent
- read FOnUserCommand write FOnUserCommand;
- property OnUserValidation : TUserValidationEvent
- read FOnUserValidation write FOnUserValidation;
- end;
-
-
-implementation
-
-{*** TOvcEfColors ***}
-
-procedure TOvcEfColors.Assign(Source : TPersistent);
-var
- C : TOvcEfColors absolute Source;
-begin
- if (Source <> nil) and (Source is TOvcEfColors) then begin
- FDisabled.Assign(C.Disabled);
- FError.Assign(C.Error);
- FHighlight.Assign(C.Highlight);
- end else
- inherited Assign(Source);
-end;
-
-constructor TOvcEfColors.Create;
-begin
- inherited Create;
-
- {create color objects and assign defaults}
- FDisabled := TOvcColors.Create(clGrayText, clWindow);
- FError := TOvcColors.Create(clBlack, clRed);
- FHighlight := TOvcColors.Create(clHighlightText, clHighlight);
-end;
-
-destructor TOvcEfColors.Destroy;
-begin
- {dispose of the color objects}
- FDisabled.Free;
- FError.Free;
- FHighlight.Free;
-
- inherited Destroy;
-end;
-
-
-{*** TOvcBaseEntryField ***}
-
-procedure TOvcBaseEntryField.ClearContents;
- {-erases the contents of the edit field}
-var
- RO : Boolean;
-begin
- if HandleAllocated then begin
- RO := efoReadOnly in Options; {store current read only state}
- Exclude(FOptions, efoReadOnly);
-
- {set the updating flag so OnChange doesn't get fired}
- Include(sefOptions, sefUpdating);
- SetWindowText(Handle, '');
- Exclude(sefOptions, sefUpdating);
- {restore previous state}
- if RO then
- Include(FOptions, efoReadOnly);
- end;
-end;
-
-procedure TOvcBaseEntryField.ClearSelection;
-begin
- if HandleAllocated then
- Perform(WM_CLEAR, 0, 0);
-end;
-
-{$IFNDEF LCL}
-procedure TOvcBaseEntryField.CMCtl3DChanged(var Msg : TMessage);
-begin
- if not HandleAllocated then
- Exit;
-
- if NewStyleControls and (FBorderStyle = bsSingle) then begin
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- if not (csLoading in ComponentState) then
- efAdjustSize;
- end;
-
- efCalcTopMargin;
-
- inherited;
-end;
-{$ENDIF}
-
-procedure TOvcBaseEntryField.CMDialogChar(var Msg : TCMDialogChar);
-begin
- {see if this is an Alt-Backspace key sequence (Alt flag is bit 29}
- if (Msg.CharCode = VK_BACK) and (HiWord(Msg.KeyData) and $2000 <> 0) then
- {don't pass it on as a dialog character since we use it as}
- {the restore command by default}
- Msg.Result := 1;
-
- inherited;
-end;
-
-procedure TOvcBaseEntryField.CMEnabledChanged(var Msg : TMessage);
-begin
- inherited;
-
- Repaint;
-end;
-
-procedure TOvcBaseEntryField.CMFontChanged(var Msg : TMessage);
-begin
- inherited;
-
- if (csLoading in ComponentState) then
- Exit;
-
- if not HandleAllocated then
- Exit;
-
- {efCalcTopMargin;}
- efAdjustSize; {adjust height based on font}
- efCalcTopMargin;
-
- if GetFocus = Handle then
- efPositionCaret(False); {adjust caret for new font}
-end;
-
-procedure TOvcBaseEntryField.CopyToClipboard;
- {-copies the selected text to the clipboard}
-begin
- if HandleAllocated then
- Perform(WM_COPY, 0, 0);
-end;
-
-constructor TOvcBaseEntryField.Create(AOwner : TComponent);
-const
- CStyle = [csClickEvents, csCaptureMouse, csOpaque];
-begin
- inherited Create(AOwner);
-
- if NewStyleControls then
- ControlStyle := ControlStyle + CStyle
- else
- ControlStyle := ControlStyle + CStyle + [csFramed];
-
-// TurboPower bug: forgot to enable XP theme support.
- ControlStyle := ControlStyle + [csNeedsBorderPaint]; //Added
-
- {create borders class and assign notifications}
- FBorders := TOvcBorders.Create;
-
- FBorders.LeftBorder.OnChange := efBorderChanged;
- FBorders.RightBorder.OnChange := efBorderChanged;
- FBorders.TopBorder.OnChange := efBorderChanged;
- FBorders.BottomBorder.OnChange := efBorderChanged;
-
-
- Cursor := crIBeam;
- Height := 25;
- ParentColor := False;
- Width := 130;
- TabStop := True;
-
- {defaults}
- FAutoSize := True;
- FBorderStyle := bsSingle;
- FCtrlColor := clRed;
- FDecimalPlaces := 0;
- FMaxLength := 15;
- FOptions := efDefOptions;
- FPadChar := DefPadChar;
- FPasswordChar := '*';
- FTextMargin := 2;
- FUninitialized := False;
- FZeroDisplay := zdShow;
- FZeroDisplayValue := 0;
-{$IFDEF LCL}
- FCtl3D := True;
- Color := clWindow;
-{$ENDIF}
-
- efRangeLo := BlankRange;
- efRangeHi := BlankRange;
-
- {default picture and field settings}
- efPicture[0] := 'X';
- efPicture[1] := #0;
- efPicLen := 1;
- efFieldClass := fcSimple;
- efDataType := fidSimpleString;
-
- {assign default user data object}
- FUserData := OvcUserData;
-
- {assign default international support object}
- FIntlSup := OvcIntlSup;
-
- {create the caret class}
- efCaret := TOvcCaretPair.Create(Self);
-
- {init edit and save edit strings}
- FillChar(efEditSt, MaxEditLen, #0);
- efSaveEdit := nil;
-
- {create colors class}
- FEFColors := TOvcEfColors.Create;
-
- {assign color change notification methods}
- FEFColors.FDisabled.OnColorChange := efColorChanged;
- FEFColors.FError.OnColorChange := efColorChanged;
- FEFColors.FHighlight.OnColorChange := efColorChanged;
-
- efCalcTopMargin;
-end;
-
-
-procedure TOvcBaseEntryField.CreateParams(var Params : TCreateParams);
-begin
- inherited CreateParams(Params);
-
- Params.Style := LongInt(Params.Style) or BorderStyles[FBorderStyle];
-
- if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then begin
- Params.Style := Params.Style and not WS_BORDER;
- Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
- end;
-
- {set picture length and check MaxLength}
- efPicLen := StrLen(efPicture);
- if FMaxLength = 0 then
- FMaxLength := efPicLen;
-
- {reset secondary options}
- sefOptions := sefDefOptions;
-
-{$IFDEF LCL}
- inherited SetBorderStyle(FBorderStyle);
-{$ENDIF}
-end;
-
-procedure TOvcBaseEntryField.CreateWnd;
-begin
- inherited CreateWnd;
-
- efHOffset := 0;
- efHPos := 0;
- efSelStart := 0;
- efSelEnd := 0;
-
- {set efDataSize for this field type}
- efInitializeDataSize;
-
- {if input is required then these fields must also be uninitialized}
- if efoInputRequired in Options then
- case efDataType mod fcpDivisor of
- fsubChar, fsubBoolean, fsubYesNo, fsubLongInt,
- fsubWord, fsubInteger, fsubByte, fsubShortInt,
- fsubReal, fsubExtended, fsubDouble, fsubSingle,
- fsubComp : Uninitialized := True;
- end;
-
- {is it a hex, binary, octal, and/or numeric field?}
- if StrScan(efPicture, pmHexadecimal) <> nil then
- Include(sefOptions, sefHexadecimal)
- else
- Exclude(sefOptions, sefHexadecimal);
-
- if StrScan(efPicture, pmBinary) <> nil then
- Include(sefOptions, sefBinary)
- else
- Exclude(sefOptions, sefBinary);
-
- if StrScan(efPicture, pmOctal) <> nil then
- Include(sefOptions, sefOctal)
- else
- Exclude(sefOptions, sefOctal);
-
- if efFieldClass = fcNumeric then
- Include(sefOptions, sefNumeric)
- else
- Exclude(sefOptions, sefNumeric);
-
- {assume no literals in mask}
- Include(sefOptions, sefNoLiterals);
-
- {reject bad options}
- efRemoveBadOptions;
-
- {set canvas font to selected font}
- Canvas.Font := Font;
-
- efAdjustSize; {adjust height based on font}
- efCalcTopMargin;
-
- efRightAlignActive := efoRightAlign in Options;
-end;
-
-procedure TOvcBaseEntryField.CutToClipboard;
- {-erases the selected text and places it in the clipboard}
-begin
- if HandleAllocated then
- Perform(WM_CUT, 0, 0);
-end;
-
-procedure TOvcBaseEntryField.DefineProperties(Filer : TFiler);
-var
- Save : Boolean;
-begin
- inherited DefineProperties(Filer);
-
- Save := not (efDataType mod fcpDivisor in [fsubString, fsubBoolean, fsubYesNo]);
-
- Filer.DefineBinaryProperty('RangeHigh', efReadRangeHi, efWriteRangeHi, Save);
- Filer.DefineBinaryProperty('RangeLow', efReadRangeLo, efWriteRangeLo, Save);
-end;
-
-procedure TOvcBaseEntryField.DecreaseValue(Wrap : Boolean; Delta : Double);
- {-decrease the value of the field by Delta, wrapping if enabled}
-begin
- SendMessage(Handle, WM_SETREDRAW, 0, 0);
- efIncDecValue(Wrap, -Delta);
- SetSelection(0, 0);
- SendMessage(Handle, WM_SETREDRAW, 1, 0);
- Refresh;
-end;
-
-procedure TOvcBaseEntryField.Deselect;
- {-unhighlight any highlighted text}
-begin
- SetSelection(0, 0);
-end;
-
-destructor TOvcBaseEntryField.Destroy;
-var
- PF : TCustomForm;
-begin
- if Focused then begin
- PF := GetParentForm(Self);
- PF.DefocusControl(Self, True);
- end;
-
- {dispose of the caret object}
- efCaret.Free;
-
- {dispose of the color object}
- FEFColors.Free;
-
- {dispose the borders object}
- FBorders.Free;
-
- {dispose of the saved edit string}
- if efSaveEdit <> nil then
- StrDispose(efSaveEdit);
-
- inherited Destroy;
-end;
-
-procedure TOvcBaseEntryField.DoOnChange;
- {-perform notification of a change}
-begin
- if Assigned(FOnChange) and not (sefUpdating in sefOptions) then
- FOnChange(Self);
-end;
-
-procedure TOvcBaseEntryField.DoOnError(ErrorCode : Word; const ErrorMsg : string);
-begin
- if Assigned(FOnError) then
- FOnError(Self, ErrorCode, ErrorMsg)
- else
- Controller.DoOnError(Self, ErrorCode, ErrorMsg);
-end;
-
-procedure TOvcBaseEntryField.DoOnUserCommand(Command : Word);
- {-perform notification of a user command}
-begin
- if Assigned(FOnUserCommand) then
- FOnUserCommand(Self, Command);
-end;
-
-procedure TOvcBaseEntryField.DoOnUserValidation(var ErrorCode : Word);
- {-perform call to user validation event handler}
-begin
- if Assigned(FOnUserValidation) then
- if not (sefNoUserValidate in sefOptions) then
- FOnUserValidation(Self, ErrorCode);
-end;
-
-procedure TOvcBaseEntryField.DoRestoreClick(Sender : TObject);
-begin
- Restore;
- efPositionCaret(True);
-end;
-
-procedure TOvcBaseEntryField.DoCutClick(Sender : TObject);
-begin
- CutToClipboard
-end;
-
-procedure TOvcBaseEntryField.DoCopyClick(Sender : TObject);
-begin
- CopyToClipboard;
-end;
-
-procedure TOvcBaseEntryField.DoPasteClick(Sender : TObject);
-begin
- PasteFromClipboard;
-end;
-
-procedure TOvcBaseEntryField.DoDeleteClick(Sender : TObject);
-begin
- ClearSelection;
-end;
-
-procedure TOvcBaseEntryField.DoSelectAllClick(Sender : TObject);
-begin
- SelectAll;
-end;
-
-procedure TOvcBaseEntryField.efAdjustSize;
- {-adjust the height of the control based on the current font}
-var
- DC : hDC;
- SaveFont : hFont;
- I : Integer;
- SysMetrics : TTextMetric;
- Metrics : TTextMetric;
-begin
- if not FAutoSize then
- Exit;
-
- DC := GetDC(0);
- try
- GetTextMetrics(DC, SysMetrics);
- SaveFont := SelectObject(DC, Font.Handle);
- GetTextMetrics(DC, Metrics);
- SelectObject(DC, SaveFont);
- finally
- ReleaseDC(0, DC);
- end;
-
- if NewStyleControls then begin
- if Ctl3D then
- I := 8
- else
- I := 6;
- I := GetSystemMetrics(SM_CYBORDER) * I;
- end else begin
- I := SysMetrics.tmHeight;
- if I > Metrics.tmHeight then
- I := Metrics.tmHeight;
- I := I div 4 + GetSystemMetrics(SM_CYBORDER) * 4;
- end;
-
- Height := Metrics.tmHeight + I;
-
- {SetBounds may have turn this off, turn it back on}
- if not FAutoSize then
- FAutoSize := True;
-end;
-
-function TOvcBaseEntryField.efBinStr2Long(St : PAnsiChar; var L : LongInt) : Boolean;
- {-convert a binary string to a longint}
-var
- BitNum : Word;
- Len : Word;
- LT : LongInt;
-begin
- Result := False;
- Len := StrLen(St);
- BitNum := 0;
- LT := 0;
- while Len > 0 do begin
- Dec(Len);
- case St[Len] of
- '0' : {OK};
- '1' : if BitNum > 31 then
- Exit
- else
- Inc(LT, LongInt(1) shl BitNum);
- else Exit;
- end;
- Inc(BitNum);
- end;
- L := LT;
- Result := True;
-end;
-
-function TOvcBaseEntryField.efCalcDataSize(St : PAnsiChar; MaxLen : Word) : Word;
- {-calculate data size of a string field with literal stripping option on}
-var
- I, L : Word;
-begin
- I := 0;
- L := StrLen(St);
- while St^ <> #0 do begin
- if (St^ in PictureChars) then
- Inc(I)
- else case St^ of
- pmFloatDollar, pmComma : Inc(I);
- end;
- Inc(St);
- end;
- Result := I+(MaxLen-L)+1;
-end;
-
-function TOvcBaseEntryField.efCanClose(DoValidation : Boolean) : Boolean;
-var
- SoftV : Boolean;
-begin
- Result := True;
-
- {don't do any of this if we're hidden or not enabled}
- if (not Visible) or (not Enabled) then
- Exit;
-
- HandleNeeded;
-
- {clear error flag}
- FLastError := 0;
-
- {check for empty/uninitialized required field}
- if (efoInputRequired in Options) and not efIsReadOnly then
- if efFieldIsEmpty or (Uninitialized and not (sefModified in sefOptions)) then
- FLastError := oeRequiredField;
-
- {ask the validation routine if there's an error}
- if FLastError = 0 then begin
- Include(sefOptions, sefValidating);
- FLastError := efValidateField;
- Exclude(sefOptions, sefValidating);
- end;
-
- if efHPos > LongInt(StrLen(efEditSt)) then
- efHPos := LongInt(StrLen(efEditSt));
-
- if FLastError = 0 then
- Exclude(sefOptions, sefInvalid)
- else begin
- if DoValidation and (efoSoftValidation in Options) then begin
- Include(sefOptions, sefInvalid);
- Result := True; {say we can close, error is in FLastError}
- Exit;
- end else begin
- if (efoSoftValidation in Options) then
- Include(sefOptions, sefInvalid);
-
- {set flag to indicate that an error is pending}
- Include(sefOptions, sefErrorPending);
-
- {keep the caret where it is if we have the focus}
- if sefHaveFocus in sefOptions then
- Include(sefOptions, sefRetainPos);
-
- {force soft validation on}
- SoftV := efoSoftValidation in Options;
- Include(FOptions, efoSoftValidation);
- try
- {ask the parent form to give us back the focus}
- efMoveFocus(Self);
-
- {report the error}
- if not Controller.ErrorPending then
- PostMessage(Handle, om_ReportError, FLastError, 0);
-
- {set controller's error pending flag}
- Controller.ErrorPending := True;
- finally
- {restore old options}
- if SoftV then
- Include(FOptions, efoSoftValidation)
- else
- Exclude(FOptions, efoSoftValidation);
- end;
- end;
- end;
-
- Result := FLastError = 0;
-end;
-
-procedure TOvcBaseEntryField.efCaretToEnd;
- {-move the caret to the end of the field}
-begin
- efHPos := StrLen(efEditSt);
-end;
-
-procedure TOvcBaseEntryField.efCaretToStart;
- {-move the caret to the beginning of the field}
-begin
- efHPos := 0;
- efHOffset := 0;
-end;
-
-procedure TOvcBaseEntryField.efChangeMask(Mask : PAnsiChar);
- {-change the picture mask}
-var
- Buf : array[0..MaxEditLen] of Byte;
-begin
- if (Mask <> nil) and (Mask^ <> #0) then begin
- if csLoading in ComponentState then begin
- {change the mask}
- StrLCopy(efPicture, Mask, MaxPicture);
- efPicLen := StrLen(efPicture);
- end else begin
- {save the current field value in tmp buffer}
- efTransfer(@Buf, otf_GetData);
-
- {change the mask}
- StrLCopy(efPicture, Mask, MaxPicture);
- efPicLen := StrLen(efPicture);
-
- {reset the field to its former value}
- efTransfer(@Buf, otf_SetData);
- end;
- end;
-end;
-
-function TOvcBaseEntryField.efCharOK(PicChar : AnsiChar; var Ch : AnsiChar;
- PrevCh : AnsiChar; Fix : Boolean) : Boolean;
- {-return True if Ch is in character set corresponding to PicChar}
-begin
- if Ch = #0 then begin
- Result := False;
- Exit;
- end;
-
- if Fix then
- efFixCase(PicChar, Ch, PrevCh);
-
- {assume it's OK}
- Result := True;
-
- case PicChar of
- pmAnyChar, pmForceUpper, pmForceLower, pmForceMixed :
- ;
- pmMonthName, pmMonthNameU, pmAlpha, pmUpperAlpha, pmLowerAlpha :
- Result := Ch in AlphaCharSet;
- pmDecimal :
- Result := Ch in RealCharSet;
- pmWhole :
- Result := (Ch = '-') or (Ch in IntegerCharSet);
- pmMonth, pmMonthU, pmDay, pmDayU, pmYear,
- pmHour, pmHourU, pmSecond, pmSecondU,
- pmPositive :
- Result := Ch in IntegerCharSet;
- pmHexadecimal :
- case Ch of
- 'A'..'F' : ;
- else
- Result := Ch in IntegerCharSet;
- end;
- pmOctal :
- case Ch of
- '0'..'7', ' ' : ;
- else
- Result := False;
- end;
- pmBinary :
- case Ch of
- '0', '1', ' ' : ;
- else
- Result := False;
- end;
- pmAmPm : {};
- pmTrueFalse :
- Result := (Ch = FIntlSup.TrueChar) or (Ch = FIntlSup.FalseChar);
- pmYesNo :
- Result := (Ch = FIntlSup.YesChar) or (Ch = FIntlSup.NoChar);
- pmScientific :
- case Ch of
- '+', 'E' : ;
- else
- Result := Ch in RealCharSet;
- end;
- pmUser1..pmUser8 :
- Result := Ch in UserData.UserCharSet[PicChar];
- end;
-end;
-
-procedure TOvcBaseEntryField.efConditionalBeep;
-begin
- if (efoBeepOnError in Controller.EntryOptions) then
- MessageBeep(0);
-end;
-
-procedure TOvcBaseEntryField.efCopyPrim;
-var
- Size : Word;
- H : THandle;
- GP : PAnsiChar;
- I : Word;
- T : TEditString;
-
-begin
- Size := efSelEnd-efSelStart;
- if Size > 0 then begin
- {allocate global memory block}
- H := GlobalAlloc(GHND, Size+1);
- if H = 0 then
- Exit;
-
- {copy selected text to global memory block}
- GP := GlobalLock(H);
- efGetDisplayString(T, MaxEditLen);
- StrStCopy(GP, T, efSelStart, Size);
-
- {remove control characters}
- for I := efSelStart to efSelEnd-1 do
- case efEditSt[I] of
- #1..#31 : GP[I-efSelStart] := efEditSt[I];
- end;
-
- GlobalUnlock(H);
-
- {give the handle to the clipboard}
-{$IFNDEF LCL}
- Clipboard.SetAsHandle(CF_TEXT, H);
-{$ENDIF}
- end;
-end;
-
-function TOvcBaseEntryField.efEditBegin : Word;
- {-return offset of first editable position in field}
-begin
- Result := 0;
-end;
-
-function TOvcBaseEntryField.efFieldIsEmpty : Boolean;
- {-return True if the field is empty}
-var
- P : PAnsiChar;
-begin
- P := efEditSt;
- while P^ = ' ' do
- Inc(P);
- Result := (P^ = #0);
-end;
-
-procedure TOvcBaseEntryField.efFieldModified;
- {-mark the field as modified; call notify event}
-begin
- Include(sefOptions, sefModified);
- Include(sefOptions, sefEverModified);
- DoOnChange;
-end;
-
-procedure TOvcBaseEntryField.efFindCtrlChars(P : PAnsiChar; var ChCnt, CtCnt : Integer);
- {-find control caracters and return normal and control char counts}
-const
- Space = ' ';
-var
- I : Integer;
-begin
- ChCnt := 0;
- CtCnt := 0;
- I := 0;
- {count "normal" characters}
- while (I < LongInt(StrLen(P))) and (P[I] >= Space) do begin
- Inc(ChCnt);
- Inc(I);
- end;
- {count "control" characters}
- while (I < LongInt(StrLen(P))) and (P[I] < Space) do begin
- Inc(CtCnt);
- Inc(I);
- end;
-end;
-
-procedure TOvcBaseEntryField.efFixCase(PicChar : AnsiChar; var Ch : AnsiChar; PrevCh : AnsiChar);
- {-fix the case of Ch based on PicChar}
-begin
- case PicChar of
- pmMonthNameU, pmForceUpper, pmUpperAlpha, pmTrueFalse,
- pmYesNo, pmScientific, pmHexadecimal :
- Ch := UpCaseChar(Ch);
- pmForceLower, pmLowerAlpha :
- Ch := LoCaseChar(Ch);
- pmForceMixed :
- case PrevCh of
- ' ', '-' :
- Ch := UpCaseChar(Ch);
- end;
- pmAmPm : ;
- pmUser1..pmUser8 :
- case UserData.ForceCase[PicChar] of
- mcUpperCase :
- Ch := UpCaseChar(Ch);
- mcLowerCase :
- Ch := LoCaseChar(Ch);
- mcMixedCase :
- case PrevCh of
- ' ', '-' :
- Ch := UpCaseChar(Ch);
- end;
- end;
- end;
-end;
-
-function TOvcBaseEntryField.efGetDisplayString(Dest : PAnsiChar; Size : Word) : PAnsiChar;
- {-return the display string in Dest and a pointer as the result}
-var
- Len : Word;
- Value : Double;
- Code : Integer;
- S : string;
-begin
- FillChar(Dest^, Size, #0);
- efMapControlChars(Dest, efEditSt);
-
- {see if zero values should be displayed}
- if efIsNumericType and not (sefHaveFocus in sefOptions) then begin
- if (ZeroDisplay = zdHide) or
- ((ZeroDisplay = zdHideUntilModified) and not EverModified) then begin
- S := Trim(GetStrippedEditString);
- Val(S, Value, Code);
- if (Value = ZeroDisplayValue) and (Code = 0) then begin
- Len := StrLen(Dest);
- if Len > 0 then
- FillChar(Dest^, Len, ' ');
- end;
- end;
- end;
-
- Result := Dest;
-end;
-
-function TOvcBaseEntryField.efGetMousePos(MPos : Integer) : Integer;
- {-get the position of a mouse click}
-var
- I : Integer;
- Len : Integer;
- Ex : Integer;
- Pos : Integer;
- S : PAnsiChar;
- Metrics : TTextMetric;
- TmpSt : TEditString;
- Done : Boolean;
- SLen : Integer;
- X : Integer;
- LMargin : Integer;
-begin
- LMargin := TextMargin;
- if (MPos < 0) and (efHOffset > 0) then begin
- GetTextMetrics(Canvas.Handle, Metrics);
- I := (Abs(MPos)+Metrics.tmAveCharWidth) div Metrics.tmAveCharWidth;
- Dec(efHOffset, I);
- if efHOffset < 0 then
- efHOffset := 0;
- end;
-
- {get a copy of the display string}
- efGetDisplayString(TmpSt, MaxEditLen);
- Len := StrLen(TmpSt);
-
- if efHOffset > Len then
- I := Len
- else
- I := efHOffset;
- S := @TmpSt[I];
-
- if efRightAlignActive then begin
- if (Assigned(FBorders)) then begin
- if (FBorders.RightBorder.Enabled) then
- LMargin := LMargin + FBorders.RightBorder.PenWidth;
- end;
- MPos := ClientWidth-LMargin-1-MPos;
-
- Pos := Len + 1;
- I := 0;
- end else begin
- if (Assigned(FBorders)) then begin
- if (FBorders.LeftBorder.Enabled) then
- LMargin := LMargin + FBorders.LeftBorder.PenWidth;
- end;
- MPos := MPos - LMargin+1;
- Pos := 0;
- end;
-
- repeat
- if efRightAlignActive then begin
- Dec(Pos);
- S := @TmpSt[Pos-1];
- SLen := Len - Pos + 1;
- end else begin
- Inc(Pos);
- SLen := Pos;
- end;
- Ex := efGetTextExtent(S, SLen);
- X := (efGetTextExtent(@S[SLen-1], 1) div 2);
- if efRightAlignActive then
- Done := (Ex+X > MPos) or (I+Pos < 1)
- else
- Done := (Ex-X > MPos) or (I+Pos > Len);
- until Done;
-
- Result := I+(Pos-1);
- if Result < 0 then
- Result := 0;
-
- if efRightAlignActive then begin
- if MPos < 1 then
- Result := I+Pos;
- end;
-end;
-
-procedure TOvcBaseEntryField.efGetSampleDisplayData(T : PAnsiChar);
- {-return sample data for the current field type}
-var
- Buf : TEditString;
- I : Integer;
-begin
- {return the picture mask for the sample display data}
- StrLCopy(Buf, efPicture, MaxLength);
- if efFieldClass = fcSimple then begin
- for I := 1 to MaxLength-1 do
- Buf[I] := Buf[I-1];
- Buf[MaxLength] := #0;
- end;
- StrLCopy(T, Buf, MaxLength);
-end;
-
-function TOvcBaseEntryField.efGetTextExtent(S : PChar; Len : Integer) : Word;
-var
- Size : TSize;
-begin
-// Apparent TurboPower bug: sometimes Len is 1 when string is blank.
-// Probably meaningless width returned in that case.
-// Could also return width of "x" if a non-zero width is assumed
-// by calling code.
- if Length(S) = 0 then
- begin
- Result := 0;
- Exit;
- end;
- GetTextExtentPoint32(Canvas.Handle, S, Len, Size);
- Result := Size.cX;
-end;
-
-
-
-procedure TOvcBaseEntryField.efBorderChanged(ABorder : TObject);
-begin
- if (FBorders.BottomBorder.Enabled) or
- (FBorders.LeftBorder.Enabled) or
- (FBorders.RightBorder.Enabled) or
- (FBorders.TopBorder.Enabled) then begin
- BorderStyle := bsNone;
- Ctl3D := False;
- end else begin
- BorderStyle := bsSingle;
- Ctl3D := True;
- end;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
-end;
-
-
-
-procedure TOvcBaseEntryField.efCalcTopMargin;
-begin
- if HandleAllocated then
- efTopMargin := GetTopTextMargin(Font, BorderStyle, Height, Ctl3D)
- else
- efTopMargin := 0;
-
- if (Assigned(FBorders)) then begin
- if (FBorders.TopBorder.Enabled) then
- efTopMargin := efTopMargin + FBorders.TopBorder.PenWidth;
- end;
-end;
-
-procedure TOvcBaseEntryField.efColorChanged(AColor : TObject);
-begin
- Repaint;
-end;
-
-procedure TOvcBaseEntryField.efInitializeDataSize;
-begin
- case efDataType mod fcpDivisor of
- fsubString :
- begin
- efDataSize := MaxLength+1;
- {handle special data size cases}
- if efDataType = fidPictureString then
- if (efoStripLiterals in Options) then
- efDataSize := efCalcDataSize(efPicture, MaxLength);
- end;
-
- fsubChar : efDataSize := SizeOf(AnsiChar);
- fsubBoolean : efDataSize := SizeOf(Boolean);
- fsubYesNo : efDataSize := SizeOf(Boolean);
- fsubLongInt : efDataSize := SizeOf(LongInt);
- fsubWord : efDataSize := SizeOf(Word);
- fsubInteger : efDataSize := SizeOf(SmallInt);
- fsubByte : efDataSize := SizeOf(Byte);
- fsubShortInt : efDataSize := SizeOf(ShortInt);
- fsubReal : efDataSize := SizeOf(Real);
- fsubExtended : efDataSize := SizeOf(Extended);
- fsubDouble : efDataSize := SizeOf(Double);
- fsubSingle : efDataSize := SizeOf(Single);
- fsubComp : efDataSize := SizeOf(Comp);
- fsubDate : efDataSize := SizeOf(TStDate);
- fsubTime : efDataSize := SizeOf(TStTime);
- else
- efDataSize := 0;
- end;
-end;
-
-function TOvcBaseEntryField.efIsNumericType : Boolean;
- {-return True if field is of a numeric type}
-begin
- case efDataType mod fcpDivisor of
- fsubLongInt, fsubWord, fsubInteger, fsubByte,
- fsubShortInt, fsubReal, fsubExtended, fsubDouble,
- fsubSingle, fsubComp :
- Result := True;
- else
- Result := False;
- end;
-end;
-
-function TOvcBaseEntryField.efIsReadOnly : Boolean;
- {-return True if field is read-only}
-begin
- Result := efoReadOnly in Options;
-end;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
-function TOvcBaseEntryField.efIsSibling(HW : TOvcHWnd{hWnd}) : Boolean;
- {-is the window HW one of our siblings}
-var
- C : TWinControl;
- H : hWnd;
-begin
- Result := False;
- if HW = 0 then
- Exit;
-
- C := FindControl(HW);
-
- {see if this window is a child of one of our siblings}
- if not Assigned(C) then begin
- H := GetParent(HW);
- if H > 0 then
- C := FindControl(H);
- end;
-
- if Assigned(C) then
- {$IFDEF VERSION5}
- if (GetImmediateParentForm(C) = GetImmediateParentForm(Self)) then
- {$ELSE}
- if GetParentForm(C) = GetParentForm(Self) then
- {$ENDIF}
- Result := True;
-end;
-
-procedure TOvcBaseEntryField.efLong2Str(P : PAnsiChar; L : LongInt);
- {-convert a longint to a string}
-var
- W : Word;
- S : array[0..32] of AnsiChar;
- St : string[32];
-begin
- W := efDataSize * 2;
- if sefHexadecimal in sefOptions then begin
- HexLPChar(S, L);
- if W < 8 then
- StrStDeletePrim(S, 0, 8-W);
- end else if sefOctal in sefOptions then begin
- OctalLPChar(S, L);
- if W < 8 then
- StrStDeletePrim(S, 0, 12-(W*2));
- end else if sefBinary in sefOptions then begin
- BinaryLPChar(S, L);
- if W < 8 then
- StrStDeletePrim(S, 0, 32-(W*4));
- end else if L = 0 then begin
- S[0] := '0';
- S[1] := #0;
- end else begin
- Str(L, St);
- StrPCopy(S, St);
- end;
- StrCopy(P, S);
-end;
-
-procedure TOvcBaseEntryField.efMapControlChars(Dest, Src : PAnsiChar);
- {-copy from Src to Dest, mapping control characters to alpha in process}
-var
- I : Integer;
-begin
- StrCopy(Dest, Src);
- if (StrLen(Dest) > 0) then begin
- for I := 0 to StrLen(Dest)-1 do
- if Dest[I] < ' ' then
- Dest[I] := AnsiChar(Byte(Dest[I])+64);
- end;
-end;
-
-procedure TOvcBaseEntryField.efMoveFocus(C : TWinControl);
- {-ask the controller to move the focus to the specified control}
-begin
-{$IFNDEF LCL}
- PostMessage(Controller.Handle, om_SetFocus, 0, LongInt(C));
-{$ELSE}
- Controller.PostMessage(Controller.Handle, om_SetFocus, 0, LongInt(C));
-{$ENDIF}
-end;
-
-procedure TOvcBaseEntryField.efMoveFocusToNextField;
- {-give next field the focus}
-var
- PF : TForm;
-begin
- PF := TForm(GetParentForm(Self));
- if not Assigned(PF) then
- Exit;
-
-{$IFNDEF LCL}
- PostMessage(PF.Handle, WM_NEXTDLGCTL, 0, 0);
-{$ELSE} //WM_NEXTDLGCTL message apparently not handled by LCL TForm
- Self.PerformTab(True);
-{$ENDIF}
-end;
-
-procedure TOvcBaseEntryField.efMoveFocusToPrevField;
- {-give previous field the focus}
-var
- PF : TForm;
-begin
- PF := TForm(GetParentForm(Self));
- if not Assigned(PF) then
- Exit;
-
-{$IFNDEF LCL}
- PostMessage(PF.Handle, WM_NEXTDLGCTL, 1, 0);
-{$ELSE} //WM_NEXTDLGCTL message apparently not handled by LCL TForm
- Self.PerformTab(False);
-{$ENDIF}
-end;
-
-function TOvcBaseEntryField.efNthMaskChar(N : Word) : AnsiChar;
- {-return the N'th character in the picture mask. N is 0-based}
-begin
- if N >= efPicLen then
- Result := efPicture[efPicLen-1]
- else
- Result := efPicture[N];
-end;
-
-function TOvcBaseEntryField.efOctStr2Long(St : PAnsiChar; var L : LongInt) : Boolean;
- {-convert an octal string to a longint}
-var
- I : Word;
-begin
- Result := True;
- L := 0;
- for I := 0 to StrLen(St)-1 do begin
- {are we going to loose any of the top 3 bits}
- if (L and $E0000000) <> 0 then
- Result := False;
- L := L shl 3;
- L := L or (Ord(St[I]) - Ord('0'));
- end;
-end;
-
-{ - Hdc changed to TOvcHdc for BCB Compatibility }
-procedure TOvcBaseEntryField.efPaintPrim(DC : TOvcHdc{Hdc};
- ARect : TRect; Offset : Integer);
- {-primitive routine to draw the entry field control}
-var
- X, Y : Integer;
- ChCnt : Integer;
- CtCnt : Integer;
- HStart : Integer;
- HEnd : Integer;
- OldBKMode : Integer;
- RTC, HTC : LongInt;
- RBC, HBC : LongInt;
- CtlClr : LongInt;
- SA, SD : PAnsiChar;
- T : TEditString;
- LMargin : Integer;
-// I : Integer;
-
- procedure Display(Count : Word; TC, BC : LongInt);
- begin
- if (Count <> 0) and (X < ARect.Right) then begin
- SetTextColor(DC, TC);
- SetBkColor(DC, BC);
- ExtTextOut(DC, X, Y, ETO_CLIPPED, @ARect, SD, Count, nil);
- end;
-
- if (Count <> 0) then begin
- {adjust X coordinate}
- Inc(X, efGetTextExtent(SD, Count));
-
- {advance string pointers}
- Inc(SD, Count);
- Inc(SA, Count);
-
- {adjust highlight indices}
- Dec(HStart, Count);
- if HStart < 0 then
- HStart := 0;
- Dec(HEnd, Count);
- if HEnd <= HStart then
- HEnd := 0;
- end;
- end;
-
- procedure DisplayPrim(Count : Word; TC, HC : LongInt);
- var
- SubCnt : Word;
- Buf : TEditString;
- begin
- if (Count > 0) and (efFieldClass = fcNumeric) then begin
- StrCopy(Buf, SD);
-
- {remove leading and trailing spaces}
- TrimAllSpacesPChar(Buf);
- SubCnt := StrLen(Buf);
- if HStart < HEnd then begin
- SetTextColor(DC, HTC);
- SetBkColor(DC, HBC)
- end else begin
- SetTextColor(DC, RTC);
- SetBkColor(DC, RBC);
- end;
-
- {set right alignment}
- SetTextAlign(DC, TA_RIGHT);
-
-
- {paint the text right aligned}
- ExtTextOut(DC, X, Y, ETO_CLIPPED, @ARect, Buf, SubCnt, nil);
- Exit;
- end;
-
- if (HStart = 0) and (HEnd > 0) then begin
- SubCnt := HEnd-HStart;
- if SubCnt > Count then
- SubCnt := Count;
-
- {highlighted chars}
- OldBKMode := SetBkMode(DC, OPAQUE);
- Display(SubCnt, HC, HBC);
- SetBkMode(DC, OldBkMode);
- end else begin
- if HStart > 0 then begin
- SubCnt := HStart;
- if SubCnt > Count then
- SubCnt := Count;
- end else
- SubCnt := Count;
- Display(SubCnt, TC, RBC);
- end;
-
- {do we need to recurse?}
- Dec(Count, SubCnt);
- if Count > 0 then
- DisplayPrim(Count, TC, HC);
- end;
-
-begin
- {select the font into our painting DC}
- SelectObject(DC, Font.Handle);
- SetBkColor(DC, Graphics.ColorToRGB(Color));
- SetTextColor(DC, Graphics.ColorToRGB(Font.Color));
-
- {display samples of appropriate data while designing}
- if csDesigning in ComponentState then begin
- efGetSampleDisplayData(T);
- SD := @T[0];
- end else begin
- {get the display version of the string}
- efGetDisplayString(T, MaxEditLen);
- SD := @T[Offset];
- end;
-
- {point to the starting point of the string}
- SA := @efEditSt[Offset];
-
- {determine highlighted portion of the string}
- if not (sefHaveFocus in sefOptions) then begin
- HStart := 0;
- HEnd := 0;
- end else begin
- HStart := efSelStart-Offset;
- HEnd := efSelEnd-Offset;
- if HStart < 0 then
- HStart := 0;
- if HEnd <= HStart then
- HEnd := 0;
- end;
-
- {get text colors to use}
- if IsValid then begin
- RTC := GetTextColor(DC);
- RBC := GetBkColor(DC);
- end else begin
- RTC := Graphics.ColorToRGB(FEFColors.Error.TextColor);
- RBC := Graphics.ColorToRGB(FEFColors.Error.BackColor);
- end;
-
- {fill in the background}
- if not Enabled then
- Canvas.Brush.Color := FEFColors.Disabled.BackColor
- else if IsValid then
- Canvas.Brush.Color := Color
- else
- Canvas.Brush.Color := FEFColors.Error.BackColor;
-
- OldBkMode := SetBkMode(DC, TRANSPARENT);
- FillRect(DC, ARect, Canvas.Brush.Handle);
- SetBkMode(DC, OldBkMode);
-
- if csDesigning in ComponentState then begin
- {no highlights if we're designing}
- HStart := 0;
- HEnd := 0;
- end else if not Enabled then begin
- {no highlights}
- HStart := 0;
- HEnd := 0;
- RTC := Graphics.ColorToRGB(FEFColors.Disabled.TextColor);
- RBC := Graphics.ColorToRGB(FEFColors.Disabled.BackColor);
- end;
-
- if csDesigning in ComponentState then begin
- ChCnt := StrLen(T);
- CtCnt := 0;
- end else
- {count characters (use actual string, SA, not display string, SD)}
- efFindCtrlChars(SA, ChCnt, CtCnt);
-
- LMargin := FTextMargin;
- if (efFieldClass = fcNumeric) then begin
- if (Assigned(FBorders)) then begin
- if (FBorders.RightBorder.Enabled) then
- LMargin := LMargin + FBorders.RightBorder.PenWidth;
- end;
- X := ClientWidth-LMargin-1;
-
- end else begin
- efRightAlignActive := efoRightAlign in Options;
- if efRightAlignActive then begin
- if (Assigned(FBorders)) then begin
- if (FBorders.RightBorder.Enabled) then
- LMargin := LMargin + FBorders.RightBorder.PenWidth;
- end;
- X := efGetTextExtent(SD, StrLen(SD));
- if X >= ClientWidth-LMargin-1 then begin
-(*
-!!.04 - This is a classic bad idea. It royally messes stuff up.
- {the display string doesn't fit in the client area, so strip all }
- {padding. }
- while SD[0] = PadChar do begin
- for I := 0 to Length(SD) - 1 do
- SD[i] := SD[i + 1];
- end;
- ChCnt := Length(SD);
- efRightAlignActive := False;
-*)
- X := LMargin-1;
- end else
- X := ClientWidth-X-LMargin-1;
- end else begin
- if (Assigned(FBorders)) then begin
- if (FBorders.LeftBorder.Enabled) then
- LMargin := LMargin + Borders.LeftBorder.PenWidth;
- end;
-(*
-!!.04 - This is a classic bad idea. It royally messes stuff up.
- {the display string doesn't fit in the client area, so strip any }
- {padding away so that the important stuff can show }
- X := efGetTextExtent(SD, StrLen(SD));
- if X >= ClientWidth-LMargin-1 then
- if efoTrimBlanks in Options then
- while SD[0] = PadChar do begin
- for I := 0 to Length(SD) - 1 do
- SD[i] := SD[i + 1];
- end;
- ChCnt := Length(SD);
-*)
- X := LMargin-1;
- end;
- end;
-
- Y := efTopMargin;
-
- {convert TColor values to RGB values}
- CtlClr := Graphics.ColorToRGB(FCtrlColor);
- HTC := Graphics.ColorToRGB(FEFColors.Highlight.TextColor);
- HBC := Graphics.ColorToRGB(FEFColors.Highlight.BackColor);
-
- {display loop}
- while (ChCnt or CtCnt) <> 0 do begin
- {display regular characters}
- if ChCnt > 0 then
- DisplayPrim(ChCnt, RTC, HTC);
-
- {display control characters}
- if CtCnt > 0 then
- DisplayPrim(CtCnt, CtlClr, CtlClr);
-
- {check for more characters}
- if CtCnt = 0 then
- ChCnt := 0
- else
- efFindCtrlChars(SA, ChCnt, CtCnt);
- end;
-end;
-
-procedure TOvcBaseEntryField.efPerformEdit(var Msg : TMessage; Cmd : Word);
- {-process the specified editing command if appropriate}
-begin
- HandleNeeded;
- if not HandleAllocated then
- Exit;
-
- {the null character implies that the this key should be}
- {ignored. the only way for the null character to get here}
- {is by changing a key after it has been entered , probably}
- {in a key preview event handler}
- if (Cmd = ccChar) and (AnsiChar(Lo(Msg.wParam)) = #0) then
- Exit;
-
- {filter out commands that are inappropriate in read-only mode}
- if efIsReadOnly then begin
- case Cmd of
- ccChar, ccCtrlChar, ccRestore, ccBack, ccDel, ccDelEol,
- ccDelBol, ccDelLine, ccDelWord, ccCut, ccPaste,
- ccInc, ccDec :
- begin
- efConditionalBeep;
- Exit;
- end;
- end;
- end;
-
- {do user command notification for user commands}
- if Cmd >= ccUserFirst then begin
- DoOnUserCommand(Cmd);
- Cmd := ccSuppress;
- end;
-
- {allow descendant classes to perform edit processing}
- efEdit(Msg, Cmd);
-end;
-
-procedure TOvcBaseEntryField.efPerformRepaint(Modified : Boolean);
- {-flag the field as modified and redraw it}
-begin
- if Modified then
- efFieldModified;
- Refresh;
-end;
-
-procedure TOvcBaseEntryField.efPerformPreEditNotify(C : TWinControl);
- {-pre-edit notification to parent form}
-begin
- Controller.DoOnPreEdit(Self, C);
-end;
-
-procedure TOvcBaseEntryField.efPerformPostEditNotify(C : TWinControl);
- {-post-edit notification to parent form}
-begin
- Controller.DoOnPostEdit(Self, C);
-end;
-
-function TOvcBaseEntryField.efPositionCaret(Adjust : Boolean) : Boolean;
- {-position the editing caret}
-var
- Delta : Word;
- S : PAnsiChar;
- OK : Boolean;
- Metrics : TTextMetric;
- CW : Integer;
- Pos : TPoint;
- T : TEditString;
- SLen : Integer;
- LMargin : Integer;
-begin
- Result := False;
- if not (sefHaveFocus in sefOptions) then
- Exit;
-
- if Adjust then begin
- {when a character is entered that erases the existing text,
- efHPos may be 1 greater than EditBegin because of the
- entered character}
- if ((efHPos = efEditBegin) or (efHPos = efEditBegin+1)) and
- (efHOffset <> 0) then begin
- efHOffset := 0;
- Result := True;
- end else if (efHPos < efHOffset) then begin
- efHOffset := efHPos;
- Result := True;
- end;
- end;
-
- efGetDisplayString(T, MaxEditLen);
-
- efRightAlignActive := efoRightAlign in Options;
- if efRightAlignActive then begin
- Delta := efGetTextExtent(T, StrLen(T));
- if Delta >= ClientWidth-FTextMargin-1 then begin
- {the display string doesn't fit in the client area, it is displayed left aligned}
- efRightAlignActive := False;
- end else begin
- efRightAlignActive := True;
- efHOffset := 0;
- end;
- end;
-
- repeat
- if not efRightAlignActive then begin
- S := @T[efHOffset];
- end else begin
- S := @T[efHPos];
- end;
-
- SLen := StrLen(S);
- if (efHPos = efHOffset) and not efRightAlignActive then
- Delta := 0
- else begin
- if not efRightAlignActive then
- Delta := efGetTextExtent(S, efHPos-efHOffset)
- else
- Delta := efGetTextExtent(S, SLen);
- end;
-
- OK := (Delta < ClientWidth-FTextMargin-1) or
- (sefNumeric in sefOptions) or not Adjust;
- if not OK then begin
- if efHOffset >= efHPos then
- OK := True
- else begin
- Inc(efHOffset);
- Result := True;
- end;
- end;
- until OK;
-
- {get metrics for current font}
- GetTextMetrics(Canvas.Handle, Metrics);
-
- {get character width}
- CW := efGetTextExtent(@T[efHPos], 1);
-
- {set caret cell height and width}
- efCaret.CellHeight := Metrics.tmHeight;
- efCaret.CellWidth := CW;
-
- {adjust caret position if using a wide cursor}
- if (efCaret.CaretType.Shape in [csBlock, csHalfBlock, csHorzLine]) or
- (efCaret.CaretType.CaretWidth > 4) then
- if efRightAlignActive then
- Dec(Delta)
- else
- Inc(Delta);
-
- {set caret position}
-
- LMargin := FTextMargin;
- if (efFieldClass = fcNumeric) then begin
- if (Assigned(FBorders)) then begin
- if (FBorders.RightBorder.Enabled) then
- LMargin := LMargin + FBorders.RightBorder.PenWidth;
- end;
- Pos.X := ClientWidth-LMargin-1;
- end else begin
- if efRightAlignActive then begin
- if (Assigned(FBorders)) then begin
- if (FBorders.RightBorder.Enabled) then
- LMargin := LMargin + FBorders.RightBorder.PenWidth;
- end;
- Pos.X := ClientWidth - Succ(Delta) - LMargin - 1;
- end else begin
- if (Assigned(FBorders)) then begin
- if (FBorders.LeftBorder.Enabled) then
- LMargin := LMargin + FBorders.LeftBorder.PenWidth;
- end;
- Pos.X := Succ(Delta) + LMargin - 3;
- end;
- end;
-
- Pos.Y := efTopMargin;
- if Pos.Y < 0 then
- Pos.Y := 0;
-
- efCaret.Position := Pos;
-end;
-
-function TOvcBaseEntryField.efRangeToStRange(const Value : TRangeType) : string;
- {-returns the range as a string}
-var
- D : Byte;
- Ex : Extended;
- Buf : TEditString;
- DateMask : string[MaxDateLen];
- TimeMask : string[MaxDateLen];
-
- function GetDecimalPlaces : Byte;
- var
- I : Cardinal;
- DotPos : Cardinal;
- begin
- if not StrChPos(efPicture, pmDecimalPt, DotPos) then
- Result := DecimalPlaces
- else begin
- Result := 0;
- for I := DotPos+1 to MaxLength-1 do
- if efNthMaskChar(I) in PictureChars then
- Inc(Result)
- else
- Break;
- end;
- end;
-
- function ExtendedToString(E : Extended; DP : Byte) : string;
- label
- UseScientificNotation;
- var
- I : Cardinal;
- S : TEditString;
- begin
- if StrScan(efPicture, pmScientific) <> nil then
- goto UseScientificNotation;
-
- {try to use regular notation}
- Str(E:0:DP, S);
-
- {trim trailing 0's if appropriate}
- if StrScan(S, pmDecimalPt) <> nil then
- TrimTrailingZerosPChar(S);
-
- {does it fit?}
- if StrLen(S) > MaxLength then begin
- {won't fit--use scientific notation}
- UseScientificNotation:
- if (DP > 0) and (9+DP < MaxLength) then
- Str(E:9+DP, S)
- else
- Str(E:MaxLength, S);
- TrimAllSpacesPChar(S);
- TrimEmbeddedZerosPChar(S);
- end;
-
- {convert decimal point}
- if StrChPos(S, pmDecimalPt, I) then
- S[I] := IntlSupport.DecimalChar;
- Result := StrPas(S);
- end;
-
-begin
- Result := '';
- D := GetDecimalPlaces;
- case efDataType mod fcpDivisor of
- fsubString : {};
- fsubBoolean, fsubYesNo : {};
- fsubChar :
- if Value.rtChar <= ' ' then begin
- Str(Ord(Value.rtChar), Result);
- Result := '#' + Result;
- end else
- Result := Value.rtChar;
- fsubLongInt, fsubInteger, fsubShortInt, fsubWord, fsubByte :
- begin
- efLong2Str(Buf, Value.rtLong);
- Result := StrPas(Buf);
- end;
- fsubReal :
- begin
- Ex := Value.rtReal;
- Result := ExtendedToString(Ex, D);
- end;
- fsubExtended, fsubDouble, fsubSingle, fsubComp :
- Result := ExtendedToString(Value.rtExt, D);
- fsubDate :
- begin
- DateMask := OvcIntlSup.InternationalDate(True);
- if Value.rtDate = BadDate then
- Result := ''
- else
- Result := OvcIntlSup.DateToDateString(DateMask, Value.rtDate, False);
- end;
- fsubTime :
- begin
- TimeMask := OvcIntlSup.InternationalTime(False);
- if Value.rtTime = BadTime then
- Result := ''
- else
- Result := OvcIntlSup.TimeToTimeString(TimeMask, Value.rtTime, False);
- end;
- end;
-end;
-
-procedure TOvcBaseEntryField.efRemoveBadOptions;
- {-remove inappropriate options for this field and data type}
-begin
- if csLoading in ComponentState then
- Exit;
-
- case efFieldClass of
- fcSimple :
- case efDataType mod fcpDivisor of
- fsubString :
- begin
- Exclude(FOptions, efoRightJustify);
- Exclude(FOptions, efoStripLiterals);
- end;
- fsubChar, fsubBoolean, fsubYesNo :
- begin
- Exclude(FOptions, efoCaretToEnd);
- Exclude(FOptions, efoForceInsert);
- Exclude(FOptions, efoTrimBlanks);
- Exclude(FOptions, efoRightJustify);
- Exclude(FOptions, efoStripLiterals);
- end;
- fsubLongInt, fsubWord, fsubInteger, fsubByte,
- fsubShortInt, fsubReal, fsubExtended, fsubDouble,
- fsubSingle, fsubComp :
- begin
- Exclude(FOptions, efoTrimBlanks);
- Exclude(FOptions, efoRightJustify);
- Exclude(FOptions, efoStripLiterals);
- end;
- end;
- fcPicture :
- case efDataType mod fcpDivisor of
- fsubString : {};
- fsubChar, fsubBoolean, fsubYesNo :
- begin
- Exclude(FOptions, efoCaretToEnd);
- Exclude(FOptions, efoForceInsert);
- Exclude(FOptions, efoTrimBlanks);
- Exclude(FOptions, efoRightJustify);
- Exclude(FOptions, efoStripLiterals);
- end;
- fsubLongInt, fsubWord, fsubInteger, fsubByte,
- fsubShortInt, fsubReal, fsubExtended, fsubDouble,
- fsubSingle, fsubComp :
- begin
- Exclude(FOptions, efoTrimBlanks);
- Exclude(FOptions, efoStripLiterals);
- end;
- fsubDate, fsubTime :
- begin
- Exclude(FOptions, efoTrimBlanks);
- Exclude(FOptions, efoRightJustify);
- Exclude(FOptions, efoStripLiterals);
- end;
- end;
- fcNumeric :
- begin
- Exclude(FOptions, efoCaretToEnd);
- Exclude(FOptions, efoForceInsert);
- Exclude(FOptions, efoTrimBlanks);
- Exclude(FOptions, efoRightJustify);
- Exclude(FOptions, efoStripLiterals);
- Exclude(FOptions, efoRightAlign);
- end;
- end;
-
- {if input is required then these fields must also be uninitialized}
- if (csDesigning in ComponentState) and (efoInputRequired in Options) then
- case efDataType mod fcpDivisor of
- fsubChar, fsubBoolean, fsubYesNo, fsubLongInt,
- fsubWord, fsubInteger, fsubByte, fsubShortInt,
- fsubReal, fsubExtended, fsubDouble, fsubSingle,
- fsubComp : FUninitialized := True;
- end;
-end;
-
-procedure TOvcBaseEntryField.efResetCaret;
- {-move the caret to the beginning or end of the field, as appropriate}
-begin
- if (efoCaretToEnd in FOptions) then
- efCaretToEnd
- else
- efCaretToStart;
-end;
-
-procedure TOvcBaseEntryField.efSaveEditString;
- {-save a copy of the edit string}
-begin
- if (efSaveEdit = nil) or (StrLen(efEditSt) <> StrLen(efSaveEdit)) then begin
- if efSaveEdit <> nil then
- StrDispose(efSaveEdit);
- efSaveEdit := StrNew(efEditSt);
- end else
- StrCopy(efSaveEdit, efEditSt);
-end;
-
-procedure TOvcBaseEntryField.efSetCaretPos(Value : Integer);
- {-set position of caret within the field}
-begin
- if not (sefHaveFocus in sefOptions) then
- Exit;
-
- if Value < 0 then
- efHPos := 0
- else if Value > LongInt(StrLen(efEditSt)) then
- efHPos := StrLen(efEditSt)+1
- else
- efHPos := Value;
- efPositionCaret(True);
-end;
-
-procedure TOvcBaseEntryField.efSetDefaultRange(FT : Byte);
- {-set the default range for the given field type FT}
-begin
- efRangeLo := BlankRange;
- efRangeHi := BlankRange;
- case FT mod fcpDivisor of
- fsubString : {};
- fsubBoolean, fsubYesNo : {};
- fsubChar :
- begin
- efRangeLo.rtChar := #32;
- efRangeHi.rtChar := #32;
- end;
- fsubLongInt :
- begin
- efRangeLo.rtLong := Low(LongInt); {80000000}
- efRangeHi.rtLong := High(LongInt); {7FFFFFFF}
- end;
- fsubWord :
- begin
- efRangeLo.rtLong := Low(Word); {0}
- efRangeHi.rtLong := High(Word); {65535}
- end;
- fsubInteger :
- begin
- efRangeLo.rtLong := Low(SmallInt); {-32768}
- efRangeHi.rtLong := High(SmallInt); {+32767}
- end;
- fsubByte :
- begin
- efRangeLo.rtLong := Low(Byte); {0}
- efRangeHi.rtLong := High(Byte); {255}
- end;
- fsubShortInt :
- begin
- efRangeLo.rtLong := Low(ShortInt); {-128}
- efRangeHi.rtLong := High(ShortInt); {127}
- end;
- fsubReal :
- begin
- efRangeLo.rtReal := -1.7e+38;
- efRangeHi.rtReal := +1.7e+38;
- end;
- fsubExtended :
- begin
-{$IFNDEF FPC}
- efRangeLo.rtExt := -1.1e+4932;
- efRangeHi.rtExt := +1.1e+4932;
-{$ELSE}
- {$IFDEF FPC_HAS_TYPE_EXTENDED}
- efRangeLo.rtExt := -1.1e+4932;
- efRangeHi.rtExt := +1.1e+4932;
- {$ELSE} {Extended same as Double on PPC}
- efRangeLo.rtExt := -1.7e+308;
- efRangeHi.rtExt := +1.7e+308;
- {$ENDIF}
-{$ENDIF}
- end;
- fsubDouble :
- begin
- efRangeLo.rtExt := -1.7e+308;
- efRangeHi.rtExt := +1.7e+308;
- end;
- fsubSingle :
- begin
- efRangeLo.rtExt := -3.4e+38;
- efRangeHi.rtExt := +3.4e+38;
- end;
- fsubComp :
- begin
- efRangeLo.rtExt := -9.2e+18;
- efRangeHi.rtExt := +9.2e+18;
- end;
- fsubDate :
- begin
- efRangeLo.rtDate := MinDate;
- efRangeHi.rtDate := MaxDate;
- end;
- fsubTime :
- begin
- efRangeLo.rtTime := MinTime;
- efRangeHi.rtTime := MaxTime;
- end;
- end;
-end;
-
-procedure TOvcBaseEntryField.efSetInitialValue;
- {-set the initial value of the field}
-var
- R : TRangeType;
- FST : Byte;
-begin
- if csDesigning in ComponentState then
- Exit;
-
- R := BlankRange;
- FST := efDataType mod fcpDivisor;
- case FST of
- fsubChar :
- if (' ' >= efRangeLo.rtChar) and (' ' <= efRangeHi.rtChar) then
- R.rtChar := ' '
- else
- R.rtChar := efRangeLo.rtChar;
- fsubLongInt, fsubWord, fsubInteger, fsubByte, fsubShortInt :
- if (0 < efRangeLo.rtLong) or (0 > efRangeHi.rtLong) then
- R.rtLong := efRangeLo.rtLong;
- fsubReal :
- if (0 < efRangeLo.rtReal) or (0 > efRangeHi.rtReal) then
- R.rtReal := efRangeLo.rtReal;
- fsubExtended, fsubDouble, fsubSingle, fsubComp :
- if (0 < efRangeLo.rtExt) or (0 > efRangeHi.rtExt) then
- case FST of
- fsubExtended : R.rtExt := efRangeLo.rtExt;
- fsubDouble : R.rtDbl := efRangeLo.rtExt;
- fsubSingle : R.rtSgl := efRangeLo.rtExt;
- fsubComp : R.rtComp := efRangeLo.rtExt;
- end;
- fsubDate : R.rtDate := BadDate;
- fsubTime : R.rtTime := BadTime;
- end;
- efTransfer(@R, otf_SetData);
-end;
-
-procedure TOvcBaseEntryField.SetName(const Value : TComponentName);
-begin
- inherited SetName(Value);
-
- Repaint;
-end;
-
-procedure TOvcBaseEntryField.SetSelection(Start, Stop : Word);
- {-mark offsets Start..Stop as selected}
-var
- Len : Word;
-begin
- if Start <= Stop then begin
- Len := StrLen(efEditSt);
-
- if Start > Len then
- Start := Len;
- if Stop > Len then
- Stop := Len;
-
- {all or nothing for numeric fields}
- if (efFieldClass = fcNumeric) then
- if (Start <> Stop) then begin
- Start := 0;
- Stop := MaxEditLen;
- end;
-
- efSelStart := Start;
- efSelEnd := Stop;
- end;
-end;
-
-function TOvcBaseEntryField.efStr2Long(P : PAnsiChar; var L : LongInt) : Boolean;
- {-convert a string to a long integer}
-var
- S : TEditString;
-begin
- Result := True;
- StrCopy(S, P);
- TrimAllSpacesPChar(S);
-
- {treat an empty string as 0}
- if StrLen(S) = 0 then begin
- L := 0;
- Exit;
- end;
-
- if sefBinary in sefOptions then
- Result := efBinStr2Long(S, L)
- else if sefOctal in sefOptions then
- Result := efOctStr2Long(S, L)
- else begin
- if (sefHexadecimal in sefOptions) and (S[0] <> #0) then
- if StrPos(S, '$') = nil then
- StrChInsertPrim(S, '$', 0);
-
- {check for special value the Val() doesn't handle correctly}
- if StrComp(S, '-2147483648') = 0 then
- L := LongInt($80000000)
- else
- Result := StrToLongPChar(S, L);
- end;
-end;
-
-function TOvcBaseEntryField.efStRangeToRange(const Value : string; var R : TRangeType) : Boolean;
- {-converts a string range to a RangeType}
-var
- I : Integer;
- Code : Integer;
- fSub : Byte;
- Buf : TEditString;
- DateMask : string[MaxDateLen];
- TimeMask : string[MaxDateLen];
-begin
- Code := 0; {assume success}
- R := BlankRange;
- fSub := efDataType mod fcpDivisor;
- case fSub of
- fsubString : {};
- fsubBoolean, fsubYesNo : {};
- fsubChar :
- if Value = '' then
- R.rtChar := #32
- else if Value[1] = '#' then begin
- Val(Copy(Value, 2, 3), I, Code);
- if Code = 0 then
- R.rtChar := Chr(I)
- else begin
- Code := 0;
- R.rtChar := #32;
- end;
- end else
- R.rtChar := Value[1];
- fsubLongInt, fsubWord, fsubInteger, fsubByte, fsubShortInt :
- begin
- StrPCopy(Buf, Value);
- if not efStr2Long(Buf, R.rtLong) then
- Code := 1
- else if (fSub = fsubWord) and
- ((R.rtLong < Low(Word)) or (R.rtLong > High(Word))) then
- Code := 1
- else if (fSub = fsubInteger) and
- ((R.rtLong < Low(SmallInt)) or (R.rtLong > High(SmallInt))) then
- Code := 1
- else if (fSub = fsubByte) and
- ((R.rtLong < Low(Byte)) or (R.rtLong > High(Byte))) then
- Code := 1
- else if (fSub = fsubShortInt) and
- ((R.rtLong < Low(ShortInt)) or (R.rtLong > High(ShortInt))) then
- Code := 1;
- end;
- fsubReal :
- if Value = '' then
- R.rtReal := 0
- else
- Val(Value, R.rtReal, Code);
- fsubExtended, fsubDouble, fsubSingle, fsubComp :
- begin
- if Value = '' then
- R.rtExt := 0
- else
- Val(Value, R.rtExt, Code);
- if (Code = 0) then begin
- if (fSub = fsubDouble) and ((R.rtExt < -1.7e+308) or (R.rtExt > +1.7e+308)) then
- Code := 1
- else if (fSub = fsubSingle) and ((R.rtExt < -3.4e+38) or (R.rtExt > +3.4e+38)) then
- Code := 1
- else if (fSub = fsubComp) and ((R.rtExt < -9.2e+18) or (R.rtExt > +9.2e+18)) then
- Code := 1;
- end;
- end;
- fsubDate :
- begin
- DateMask := OvcIntlSup.InternationalDate(True);
- if Length(Value) <> Length(DateMask) then
- R.rtDate := BadDate
- else
- R.rtDate := OvcIntlSup.DateStringToDate(DateMask, Value, GetEpoch);
- if R.rtDate = BadDate then
- Code := 1;
- end;
- fsubTime :
- begin
- TimeMask := OvcIntlSup.InternationalTime(False);
- if Length(Value) <> Length(TimeMask) then
- R.rtTime := BadTime
- else
- R.rtTime := OvcIntlSup.TimeStringToTime(TimeMask, Value);
- if R.rtTime = BadTime then
- Code := 1;
- end;
- end;
- Result := Code = 0;
-end;
-
-procedure TOvcBaseEntryField.efReadRangeHi(Stream : TStream);
- {-called to read the high range from the stream}
-begin
- Stream.Read(efRangeHi, SizeOf(TRangeType));
-end;
-
-procedure TOvcBaseEntryField.efReadRangeLo(Stream : TStream);
- {-called to read the low range from the stream}
-begin
- Stream.Read(efRangeLo, SizeOf(TRangeType));
-end;
-
-function TOvcBaseEntryField.efTransfer(DataPtr : Pointer; TransferFlag : Word) : Word;
- {-transfer data to or from the field}
-begin
- if (TransferFlag <> otf_SizeData) and not (csDesigning in ComponentState) then
- Result := efTransferPrim(DataPtr, TransferFlag)
- else
- Result := efDataSize;
- {descendant classes will do the actual transfering of data}
-end;
-
-function TOvcBaseEntryField.efTransferPrim(DataPtr : Pointer; TransferFlag : Word) : Word;
- {-reset for new data in field}
-begin
- Result := efDataSize;
- if TransferFlag = otf_SetData then begin
- if not (sefValidating in sefOptions) then begin
- Exclude(sefOptions, sefRetainPos);
- if sefHaveFocus in sefOptions then begin
- efResetCaret;
- efPositionCaret(True);
-
- {if we are doing a transfer due to a GetValue}
- {validation, don't reset selection}
- if not (sefGettingValue in sefOptions) then
- SetSelection(0, MaxEditLen);
- end else
- Exclude(sefOptions, sefInvalid);
-
- {clear modified flags}
- Exclude(sefOptions, sefModified);
- Exclude(sefOptions, sefEverModified);
-
- Invalidate;
- end;
- end;
-end;
-
-procedure TOvcBaseEntryField.efWriteRangeHi(Stream : TStream);
- {-called to store the high range on the stream}
-begin
- Stream.Write(efRangeHi, SizeOf(TRangeType));
-end;
-
-procedure TOvcBaseEntryField.efWriteRangeLo(Stream : TStream);
- {-called to store the low range on the stream}
-begin
- Stream.Write(efRangeLo, SizeOf(TRangeType));
-end;
-
-procedure TOvcBaseEntryField.EMGetModify(var Msg : TMessage);
-begin
- Msg.Result := 0;
- if sefModified in sefOptions then
- Msg.Result := 1;
-end;
-
-procedure TOvcBaseEntryField.EMGetSel(var Msg : TMessage);
-begin
- {Return this info in Msg as well as in Result}
- with Msg do begin
- if LPDWORD(wParam) <> nil then
- LPDWORD(wParam)^ := efSelStart;
- if LPDWORD(lParam) <> nil then
- LPDWORD(lParam)^ := efSelEnd;
- end;
- Msg.Result := MakeLong(efSelStart, efSelEnd);
-end;
-
-procedure TOvcBaseEntryField.EMSetModify(var Msg : TMessage);
-begin
- if Msg.wParam > 0 then begin
- Include(sefOptions, sefModified);
- Include(sefOptions, sefEverModified);
- end else
- Exclude(sefOptions, sefModified);
-end;
-
-procedure TOvcBaseEntryField.EMSetSel(var Msg : TMessage);
-begin
- with Msg do begin
- if lParamLo = $FFFF then
- SetSelection(0, 0)
- else if (lParamLo = 0) and (lParamHi = $FFFF) then
- SetSelection(0, MaxEditLen)
- else if lParamHi >= lParamLo then
- SetSelection(lParamLo, lParamHi);
- end;
- Invalidate;
-end;
-
-function TOvcBaseEntryField.GetAsBoolean : Boolean;
- {-returns the field value as a Boolean Value}
-begin
- Result := False;
- if (efDataType mod fcpDivisor) in [fsubBoolean, fsubYesNo] then
- FLastError := GetValue(Result)
- else
- raise EInvalidDataType.Create;
-end;
-
-function TOvcBaseEntryField.GetAsCents : LongInt;
- {-returns the field value as a LongInt Value representing pennies}
-const
- C = 100.0;
-var
- Re : Real;
- Db : Double;
- Si : Single;
- Ex : Extended;
-begin
- Result := 0;
- case (efDataType mod fcpDivisor) of
- fsubReal :
- begin
- FLastError := GetValue(Re);
- if FLastError = 0 then
- Result := Round(Re * C);
- end;
- fsubDouble :
- begin
- FLastError := GetValue(Db);
- if FLastError = 0 then
- Result := Round(Db * C);
- end;
- fsubSingle :
- begin
- FLastError := GetValue(Si);
- if FLastError = 0 then
- Result := Round(Si * C);
- end;
- fsubExtended :
- begin
- FLastError := GetValue(Ex);
- if FLastError = 0 then
- Result := Round(Ex * C);
- end;
- else
- raise EInvalidDataType.Create;
- end;
-end;
-
-function TOvcBaseEntryField.GetAsDateTime : TDateTime;
- {-returns the field value as a Delphi DateTime Value}
-var
- D : TStDate;
- T : TStTime;
-begin
- case (efDataType mod fcpDivisor) of
- fsubDate :
- begin
- FLastError := GetValue(D);
- if FLastError <> 0 then
- Result := 0
- else
- Result := StDateToDateTime(D);
- end;
- fsubTime :
- begin
- FLastError := GetValue(T);
- if FLastError <> 0 then
- Result := 0
- else
- Result := StTimeToDateTime(T);
- end;
- else
- raise EInvalidDataType.Create;
- end;
-end;
-
-function TOvcBaseEntryField.GetAsExtended : Extended;
- {-returns the field value as an Extended Value}
-var
- Ex : Extended;
- Co : Comp absolute Ex;
- Db : Double;
- Sg : Single absolute Db;
- Re : Real absolute Db;
- Li : Longint;
- Wo : Word absolute Li;
- It : SmallInt absolute Li;
- By : Byte absolute Li;
- Si : ShortInt absolute Li;
-begin
- Result := 0;
- case efDataType mod fcpDivisor of
- fsubExtended :
- begin
- FLastError := GetValue(Ex);
- if FLastError = 0 then
- Result := Ex;
- end;
- fsubComp :
- begin
- FLastError := GetValue(Co);
- if FLastError = 0 then
- Result := Co;
- end;
- fsubReal :
- begin
- FLastError := GetValue(Re);
- if FLastError = 0 then
- Result := Re;
- end;
- fsubDouble :
- begin
- FLastError := GetValue(Db);
- if FLastError = 0 then
- Result := Db;
- end;
- fsubSingle :
- begin
- FLastError := GetValue(Sg);
- if FLastError = 0 then
- Result := Sg;
- end;
- fsubLongInt :
- begin
- FLastError := GetValue(Li);
- if FLastError = 0 then
- Result := Li;
- end;
- fsubWord :
- begin
- FLastError := GetValue(Wo);
- if FLastError = 0 then
- Result := Wo;
- end;
- fsubInteger :
- begin
- FLastError := GetValue(It);
- if FLastError = 0 then
- Result := It;
- end;
- fsubByte :
- begin
- FLastError := GetValue(By);
- if FLastError = 0 then
- Result := By;
- end;
- fsubShortInt :
- begin
- FLastError := GetValue(Si);
- if FLastError = 0 then
- Result := Si;
- end;
- else
- raise EInvalidDataType.Create;
- end;
-end;
-
-function TOvcBaseEntryField.GetAsFloat : Double;
- {-returns the field value as a Double Value}
-var
- Db : Double;
- Sg : Single absolute Db;
- Re : Real absolute Db;
- Ex : Extended;
- Co : Comp absolute Ex;
- Li : LongInt;
- Wo : Word absolute Li;
- It : SmallInt absolute Li;
- By : Byte absolute Li;
- Si : ShortInt absolute Li;
-begin
- Result := 0;
- case efDataType mod fcpDivisor of
- fsubReal :
- begin
- FLastError := GetValue(Re);
- if FLastError = 0 then
- Result := Re;
- end;
- fsubDouble :
- begin
- FLastError := GetValue(Db);
- if FLastError = 0 then
- Result := Db;
- end;
- fsubSingle :
- begin
- FLastError := GetValue(Sg);
- if FLastError = 0 then
- Result := Sg;
- end;
- fsubExtended :
- begin
- FLastError := GetValue(Ex);
- if FLastError = 0 then
- Result := Ex;
- end;
- fsubComp :
- begin
- FLastError := GetValue(Co);
- if FLastError = 0 then
- Result := Co;
- end;
- fsubLongInt :
- begin
- FLastError := GetValue(Li);
- if FLastError = 0 then
- Result := Li;
- end;
- fsubWord :
- begin
- FLastError := GetValue(Wo);
- if FLastError = 0 then
- Result := Wo;
- end;
- fsubInteger :
- begin
- FLastError := GetValue(It);
- if FLastError = 0 then
- Result := It;
- end;
- fsubByte :
- begin
- FLastError := GetValue(By);
- if FLastError = 0 then
- Result := By;
- end;
- fsubShortInt :
- begin
- FLastError := GetValue(Si);
- if FLastError = 0 then
- Result := Si;
- end;
- else
- raise EInvalidDataType.Create;
- end;
-end;
-
-function TOvcBaseEntryField.GetAsInteger : Longint;
- {-returns the field value as a LongInt Value}
-var
- Li : Longint;
- Wo : Word absolute Li;
- It : SmallInt absolute Li;
- By : Byte absolute Li;
- Si : ShortInt absolute Li;
-begin
- Result := 0;
- case efDataType mod fcpDivisor of
- fsubLongInt :
- begin
- FLastError := GetValue(Li);
- if FLastError = 0 then
- Result := Li;
- end;
- fsubWord :
- begin
- FLastError := GetValue(Wo);
- if FLastError = 0 then
- Result := Wo;
- end;
- fsubInteger :
- begin
- FLastError := GetValue(It);
- if FLastError = 0 then
- Result := It;
- end;
- fsubByte :
- begin
- FLastError := GetValue(By);
- if FLastError = 0 then
- Result := By;
- end;
- fsubShortInt :
- begin
- FLastError := GetValue(Si);
- if FLastError = 0 then
- Result := Si;
- end;
- else
- raise EInvalidDataType.Create;
- end;
-end;
-
-function TOvcBaseEntryField.GetAsString : string;
- {-return the field value as a string value}
-var
- Buf : TEditString;
- S : string[MaxEditLen];
-begin
- Result := '';
- if (efDataType mod fcpDivisor) = fsubString then begin
- FLastError := GetValue(S);
- if FLastError = 0 then
- Result := S;
- end else begin
- StrCopy(Buf, efEditSt);
- if efoTrimBlanks in Options then
- TrimAllSpacesPChar(Buf);
- Result := StrPas(Buf);
- FLastError := 0;
- end;
-end;
-
-function TOvcBaseEntryField.GetAsVariant : Variant;
- {return the field value as a Variant value}
-begin
- case efDataType mod fcpDivisor of
- fsubBoolean : Result := GetAsBoolean;
- fsubYesNo : Result := GetAsBoolean;
- fsubLongInt : Result := GetAsInteger;
- fsubWord : Result := GetAsInteger;
- fsubInteger : Result := GetAsInteger;
- fsubByte : Result := GetAsInteger;
- fsubShortInt : Result := GetAsInteger;
- fsubReal : Result := GetAsFloat;
- fsubDouble : Result := GetAsFloat;
- fsubSingle : Result := GetAsFloat;
- fsubExtended : Result := GetAsExtended;
- fsubComp : Result := GetAsExtended;
- else
- Result := GetAsString;
- end;
-end;
-
-function TOvcBaseEntryField.GetAsStDate : TStDate;
- {-returns the field value as a Date Value}
-begin
- if (efDataType mod fcpDivisor) = fsubDate then begin
- FLastError := GetValue(Result);
- if FLastError <> 0 then
- Result := BadDate;
- end else
- raise EInvalidDataType.Create;
-end;
-
-function TOvcBaseEntryField.GetAsStTime : TStTime;
- {-returns the field value as a Time Value}
-begin
- if (efDataType mod fcpDivisor) = fsubTime then begin
- FLastError := GetValue(Result);
- if FLastError <> 0 then
- Result := BadTime;
- end else
- raise EInvalidDataType.Create;
-end;
-
-function TOvcBaseEntryField.GetCurrentPos : Integer;
- {-get position of the caret within the field}
-begin
- if sefHaveFocus in sefOptions then
- Result := efHPos
- else
- Result := -1;
-end;
-
-function TOvcBaseEntryField.GetDataSize : Word;
- {-return the size of the data for this field}
-begin
- if efDataSize = 0 then
- efInitializeDataSize;
- Result := efDataSize;
-end;
-
-function TOvcBaseEntryField.GetDisplayString : string;
- {-return the display string}
-var
- Buf : TEditString;
-begin
- efGetDisplayString(Buf, MaxEditLen);
- Result := StrPas(Buf);
-end;
-
-function TOvcBaseEntryField.GetEditString : string;
- {-return a string containing the edit text}
-var
- Buf : TEditString;
-begin
- StrLCopy(Buf, efEditSt, MaxEditLen);
- Result := StrPas(Buf);
-end;
-
-function TOvcBaseEntryField.GetEpoch : Integer;
-begin
- Result := FEpoch;
-
- {avoid writing controller's epoch value}
- if csWriting in ComponentState then
- Exit;
-
- if Assigned(FOnGetEpoch) then
- FOnGetEpoch(Self, Result);
- if (Result = 0) and ControllerAssigned then
- Result := Controller.Epoch;
-end;
-
-function TOvcBaseEntryField.GetEverModified : Boolean;
- {-return true if this field has ever been modified}
-begin
- Result := (sefEverModified in sefOptions) or (sefModified in sefOptions);
-end;
-
-function TOvcBaseEntryField.GetInsCaretType : TOvcCaret;
- {-return the current caret type}
-begin
- Result := efCaret.InsCaretType;
-end;
-
-function TOvcBaseEntryField.GetInsertMode : Boolean;
- {-return the controller's insert mode state}
-begin
- if ControllerAssigned then
- Result := Controller.InsertMode
- else
- Result := sefInsert in sefOptions;
-end;
-
-function TOvcBaseEntryField.GetModified : Boolean;
- {-return true if this field is modified}
-begin
- Result := sefModified in sefOptions;
-end;
-
-function TOvcBaseEntryField.GetOvrCaretType : TOvcCaret;
- {-return the current caret type}
-begin
- Result := efCaret.OvrCaretType;
-end;
-
-function TOvcBaseEntryField.GetRangeHiStr : string;
- {-get the high field range as string value}
-begin
- Result := efRangeToStRange(efRangeHi);
-end;
-
-function TOvcBaseEntryField.GetRangeLoStr : string;
- {-get the low field range as string value}
-begin
- Result := efRangeToStRange(efRangeLo);
-end;
-
-function TOvcBaseEntryField.GetSelLength : Integer;
- {-return the length of the currently selected text}
-begin
- Result := efSelEnd - efSelStart;
-end;
-
-function TOvcBaseEntryField.GetSelStart : Integer;
- {-return the starting position of the selection, if any}
-begin
- Result := efSelStart;
-end;
-
-function TOvcBaseEntryField.GetSelText : string;
- {-return the currently selected text}
-var
- Len : Integer;
-begin
- Result := '';
- Len := efSelEnd - efSelStart;
- if Len > 0 then begin
- {limit length to max edit length}
- if Len > MaxEditLen then
- Len := MaxEditLen;
- SetLength(Result, Len);
- StrLCopy(@Result[1], @efEditSt[efSelStart], Len);
- end;
-end;
-
-function TOvcBaseEntryField.FieldIsEmpty : Boolean;
- {-return True if the field is completely empty}
-begin
- HandleNeeded;
- Result := efFieldIsEmpty;
-end;
-
-function TOvcBaseEntryField.GetStrippedEditString : string;
- {-return edit string stripped of literals and semi-literals}
-begin
- Result := GetEditString;
-end;
-
-function TOvcBaseEntryField.GetValue(var Data) : Word;
- {-returns the current field value in Data. Result is 0 or error code}
-begin
- {flag to inform validate and transfer}
- {methods that we are retrieving a value}
- Include(sefOptions, sefGettingValue);
- try
- Result := efValidateField;
- if Result <> 0 then
- Exit;
-
- case efDataType mod fcpDivisor of
- fsubString : efTransfer(@ShortString(Data), otf_GetData);
- fsubChar : efTransfer(@AnsiChar(Data), otf_GetData);
- fsubBoolean : efTransfer(@Boolean(Data), otf_GetData);
- fsubYesNo : efTransfer(@Boolean(Data), otf_GetData);
- fsubLongInt : efTransfer(@LongInt(Data), otf_GetData);
- fsubWord : efTransfer(@Word(Data), otf_GetData);
- fsubInteger : efTransfer(@SmallInt(Data), otf_GetData);
- fsubByte : efTransfer(@Byte(Data), otf_GetData);
- fsubShortInt : efTransfer(@ShortInt(Data), otf_GetData);
- fsubReal : efTransfer(@Real(Data), otf_GetData);
- fsubExtended : efTransfer(@Extended(Data), otf_GetData);
- fsubDouble : efTransfer(@Double(Data), otf_GetData);
- fsubSingle : efTransfer(@Single(Data), otf_GetData);
- fsubComp : efTransfer(@Comp(Data), otf_GetData);
- fsubDate : efTransfer(@TStDate(Data), otf_GetData);
- fsubTime : efTransfer(@TStTime(Data), otf_GetData);
- else
- raise EOvcException.Create(GetOrphStr(SCInvalidParamValue));
- end;
- finally
- Exclude(sefOptions, sefGettingValue);
- end;
-end;
-
-procedure TOvcBaseEntryField.IncreaseValue(Wrap : Boolean; Delta : Double);
- {-increase the value of the field by Delta, wrapping if enabled}
-begin
- SendMessage(Handle, WM_SETREDRAW, 0, 0);
- efIncDecValue(Wrap, +Delta);
- SetSelection(0, 0);
- SendMessage(Handle, WM_SETREDRAW, 1, 0);
- Refresh;
-end;
-
-function TOvcBaseEntryField.IsValid : Boolean;
- {-returns true if the field is not marked as invalid}
-begin
- Result := not (sefInvalid in sefOptions);
-end;
-
-procedure TOvcBaseEntryField.MergeWithPicture(const S : string);
- {-combines S with the picture mask and updates the edit string}
-begin
- StrPLCopy(efEditSt, S, MaxLength);
-end;
-
-procedure TOvcBaseEntryField.MoveCaret(Delta : Integer);
- {-moves the caret to the right or left Value positions}
-var
- I : Integer;
- Msg : TMessage;
-begin
- if not (sefHaveFocus in sefOptions) then
- Exit;
-
- FillChar(Msg, SizeOf(Msg), 0);
- if Delta > 0 then begin
- for I := 1 to Delta do
- efPerformEdit(Msg, ccRight)
- end else if Delta < 0 then begin
- for I := 1 to Abs(Delta) do
- efPerformEdit(Msg, ccLeft)
- end;
-end;
-
-procedure TOvcBaseEntryField.MoveCaretToEnd;
- {-move the caret to the end of the field}
-begin
- efCaretToEnd;
-end;
-
-procedure TOvcBaseEntryField.MoveCaretToStart;
- {-move the caret to the beginning of the field}
-begin
- efCaretToStart;
-end;
-
-procedure TOvcBaseEntryField.OMGetDataSize(var Msg : TMessage);
- {-return the fields data size}
-begin
- Msg.Result := DataSize;
-end;
-
-procedure TOvcBaseEntryField.OMReportError(var Msg : TOMReportError);
- {-report the error}
-var
- P : string;
-begin
- if Msg.Error = 0 then
- Exit;
-
- case Msg.Error of
- oeRangeError : P := GetOrphStr(SCRangeError);
- oeInvalidNumber : P := GetOrphStr(SCInvalidNumber);
- oeRequiredField : P := GetOrphStr(SCRequiredField);
- oeInvalidDate : P := GetOrphStr(SCInvalidDate);
- oeInvalidTime : P := GetOrphStr(SCInvalidTime);
- oeBlanksInField : P := GetOrphStr(SCBlanksInField);
- oePartialEntry : P := GetOrphStr(SCPartialEntry);
- else
- if Msg.Error >= oeCustomError then
- P := Controller.ErrorText
- else
- P := GetOrphStr(SCDefaultEntryErrorText);
- end;
-
- {update the error text}
- if P <> Controller.ErrorText then
- Controller.ErrorText := P;
-
- {do error notification}
- DoOnError(Msg.Error, P);
-end;
-
-procedure TOvcBaseEntryField.Paint;
- {-draw the entry field control}
-var
- hCBM : hBitmap;
- MemDC : hDC;
- CR : TRect;
-begin
- inherited Paint;
-
- {get dimensions of client area}
- CR.Top := 0; CR.Left := 0;
- CR.Right := Width; CR.Bottom := Height;
-
- {create a compatible display context and bitmap}
- MemDC := CreateCompatibleDC(Canvas.Handle);
- hCBM := CreateCompatibleBitmap(Canvas.Handle, CR.Right, CR.Bottom);
- SelectObject(MemDC, hCBM);
- SetMapMode(MemDC, GetMapMode(Canvas.Handle));
-
- {set text alignment}
- SetTextAlign(MemDC, TA_LEFT or TA_TOP);
-
- {call our paint routine}
- efPaintPrim(MemDC, CR, efHOffset);
-
- {copy everything to the original display context}
- BitBlt(Canvas.Handle, 0, 0, CR.Right, CR.Bottom, MemDC, 0, 0, SrcCopy);
-
- efPaintBorders;
-
- {dispose of the bitmap and the extra display context}
- DeleteDC(MemDC);
- DeleteObject(hCBM);
-end;
-
-procedure TOvcBaseEntryField.efPaintBorders;
-var
- R : TRect;
- C : TCanvas;
-begin
- R.Left := 0;
- R.Top := 0;
- R.Right := Width;
- R.Bottom := Height;
-
- C := Canvas;
- if (FBorders.LeftBorder <> nil) then begin
- if (FBorders.LeftBorder.Enabled) then begin
- C.Pen.Color := FBorders.LeftBorder.PenColor;
- C.Pen.Width := FBorders.LeftBorder.PenWidth;
- C.Pen.Style := FBorders.LeftBorder.PenStyle;
-
- C.MoveTo(R.Left + (FBorders.LeftBorder.PenWidth div 2), R.Top);
- C.LineTo(R.Left + (FBorders.LeftBorder.PenWidth div 2), R.Bottom);
- end;
- end;
-
- if (FBorders.RightBorder <> nil) then begin
- if (FBorders.RightBorder.Enabled) then begin
- C.Pen.Color := FBorders.RightBorder.PenColor;
- C.Pen.Width := FBorders.RightBorder.PenWidth;
- C.Pen.Style := FBorders.RightBorder.PenStyle;
-
- if ((FBorders.RightBorder.PenWidth mod 2) = 0) then begin
- C.MoveTo(R.Right - (FBorders.RightBorder.PenWidth div 2), R.Top);
- C.LineTo(R.Right - (FBorders.RightBorder.PenWidth div 2), R.Bottom);
- end else begin
- C.MoveTo(R.Right - (FBorders.RightBorder.PenWidth div 2) - 1, R.Top);
- C.LineTo(R.Right - (FBorders.RightBorder.PenWidth div 2) - 1, R.Bottom);
- end;
- end;
- end;
-
- if (FBorders.TopBorder <> nil) then begin
- if (FBorders.TopBorder.Enabled) then begin
- C.Pen.Color := FBorders.TopBorder.PenColor;
- C.Pen.Width := FBorders.TopBorder.PenWidth;
- C.Pen.Style := FBorders.TopBorder.PenStyle;
-
- C.MoveTo(R.Left, R.Top + (FBorders.TopBorder.PenWidth div 2));
- C.LineTo(R.Right, R.Top + (FBorders.TopBorder.PenWidth div 2));
- end;
- end;
-
- if (FBorders.BottomBorder <> nil) then begin
- if (FBorders.BottomBorder.Enabled) then begin
- C.Pen.Color := FBorders.BottomBorder.PenColor;
- C.Pen.Width := FBorders.BottomBorder.PenWidth;
- C.Pen.Style := FBorders.BottomBorder.PenStyle;
-
- if ((FBorders.BottomBorder.PenWidth mod 2) = 0) then begin
- C.MoveTo(R.Left, R.Bottom - (FBorders.BottomBorder.PenWidth div 2));
- C.LineTo(R.Right, R.Bottom - (FBorders.BottomBorder.PenWidth div 2));
- end else begin
- C.MoveTo(R.Left, R.Bottom - (FBorders.BottomBorder.PenWidth div 2) - 1);
- C.LineTo(R.Right, R.Bottom - (FBorders.BottomBorder.PenWidth div 2) - 1);
- end;
- end;
- end;
-end;
-
-procedure TOvcBaseEntryField.PasteFromClipboard;
- {-pastes the contents of the clipboard in the edit field}
-begin
- if HandleAllocated then
- Perform(WM_PASTE, 0, 0);
-end;
-
-procedure TOvcBaseEntryField.ProcessCommand(Cmd, CharCode : Word);
- {-process the specified command}
-var
- Msg : TMessage;
-begin
- FillChar(Msg, SizeOf(Msg), #0);
- Msg.wParam := CharCode;
- efPerformEdit(Msg, Cmd);
-end;
-
-procedure TOvcBaseEntryField.ResetCaret;
- {-move the caret to the beginning or end of the field, as appropriate}
-begin
- efResetCaret;
-end;
-
-procedure TOvcBaseEntryField.Restore;
- {-restore the previous contents of the field}
-begin
- if efSaveEdit = nil then
- Exit;
-
- StrCopy(efEditSt, efSaveEdit);
- efResetCaret;
- SetSelection(0, MaxEditLen);
-
- {clear modified flag}
- Exclude(sefOptions, sefModified);
- Repaint;
- DoOnChange;
-end;
-
-procedure TOvcBaseEntryField.SelectAll;
- {-selects the entire contents of the edit field}
-begin
- if HandleAllocated then
- Perform(EM_SETSEL, 1, LongInt($FFFF0000));
-end;
-
-procedure TOvcBaseEntryField.SetAsBoolean(Value : Boolean);
- {-sets the field value to a Boolean Value}
-begin
- if (efDataType mod fcpDivisor) in [fsubBoolean, fsubYesNo] then
- SetValue(Value)
- else
- raise EInvalidDataType.Create;
-end;
-
-procedure TOvcBaseEntryField.SetAsCents(Value : LongInt);
- {-sets the field value given a LongInt Value representing pennies}
-const
- C = 100.0;
-var
- Re : Real;
- Db : Double;
- Si : Single;
- Ex : Extended;
-begin
- case efDataType mod fcpDivisor of
- fsubReal :
- begin
- Re := Value / C;
- SetValue(Re);
- end;
- fsubDouble :
- begin
- Db := Value / C;
- SetValue(Db);
- end;
- fsubSingle :
- begin
- Si := Value / C;
- SetValue(Si);
- end;
- fsubExtended :
- begin
- Ex := Value / C;
- SetValue(Ex);
- end;
- else
- raise EInvalidDataType.Create;
- end;
-end;
-
-procedure TOvcBaseEntryField.SetAsDateTime(Value : TDateTime);
- {-sets the field value to a Delphi DateTime value}
-var
- D : TStDate;
- T : TStTime;
- Day,
- Month,
- Year : Word;
- Hour,
- Min,
- Sec,
- MSec : Word;
-begin
- case (efDataType mod fcpDivisor) of
- fsubDate :
- begin
- {$IFDEF ZeroDateAsNull}
- if Value = 0 then
- Value := BadDate;
- {$ENDIF}
- DecodeDate(Value, Year, Month, Day);
- D := DMYToStDate(Day, Month, Year, GetEpoch);
- if D = DateTimeToStDate(BadDate) then
- D := BadDate;
- SetValue(D);
- end;
- fsubTime :
- begin
- DecodeTime(Value, Hour, Min, Sec, MSec);
- T := HMSToStTime(Hour, Min, Sec);
- if (T <> 0) and (T = DateTimeToStTime(BadTime)) then
- T := BadTime;
- SetValue(T);
- end;
- else
- raise EInvalidDataType.Create;
- end;
-end;
-
-procedure TOvcBaseEntryField.SetAsExtended(Value : Extended);
- {-sets the field value to an Extended Value}
-var
- Co : Comp;
-begin
- case efDataType mod fcpDivisor of
- fsubExtended :
- SetValue(Value);
- fsubComp :
- begin
- Co := Trunc(Value);
- SetValue(Co);
- end;
- else
- raise EInvalidDataType.Create;
- end;
-end;
-
-procedure TOvcBaseEntryField.SetAsFloat(Value : Double);
- {-sets the field value to a Double Value}
-var
- Sg : Single;
- Re : Real;
- Co : Comp;
- Ex : Extended;
-begin
- case efDataType mod fcpDivisor of
- fsubReal :
- begin
- Re := Value;
- SetValue(Re);
- end;
- fsubDouble :
- SetValue(Value);
- fsubSingle :
- begin
- Sg := Value;
- SetValue(Sg);
- end;
- fsubExtended :
- begin
- Ex := Value;
- SetValue(Ex);
- end;
- fsubComp :
- begin
- Co := Trunc(Value);
- SetValue(Co);
- end;
- else
- raise EInvalidDataType.Create;
- end;
-end;
-
-procedure TOvcBaseEntryField.SetAsInteger(Value : Longint);
- {-sets the field value to a LongInt Value}
-var
- Wo : Word;
- It : SmallInt absolute Wo;
- By : Byte absolute Wo;
- Si : ShortInt absolute Wo;
-begin
- case efDataType mod fcpDivisor of
- fsubLongInt :
- SetValue(Value);
- fsubWord :
- begin
- Wo := LOWORD(Value);
- SetValue(Wo);
- end;
- fsubInteger :
- begin
- It := SmallInt(LOWORD(Value));
- SetValue(It);
- end;
- fsubByte :
- begin
- By := Lo(LOWORD(Value));
- SetValue(By);
- end;
- fsubShortInt :
- begin
- Si := ShortInt(Lo(LOWORD(Value)));
- SetValue(Si);
- end;
- else
- raise EInvalidDataType.Create;
- end;
-end;
-
-procedure TOvcBaseEntryField.SetAsString(const Value : string);
- {-sets the field value to a String Value}
-var
- R : TRangeType;
- fSub : Byte;
- B : Boolean;
- Ch : AnsiChar;
- S : string[MaxEditLen];
-begin
- if sefUserValidating in sefOptions then
- Exit;
-
- fSub := (efDataType mod fcpDivisor);
- if fSub = fsubString then begin
- S := Value;
- SetValue(S)
- end else if fSub in [fsubBoolean, fsubYesNo] then begin
- B := False;
- if Length(Value) > 0 then begin
- Ch := UpCaseChar(Value[1]);
- B := (Ch = FIntlSup.TrueChar) or (Ch = FIntlSup.YesChar);
- end;
- SetValue(B);
- end else begin
- {use range conversion routines to process string assignment}
- if efStRangeToRange(Value, R) then begin
- case (efDataType mod fcpDivisor) of
- {assign result to proper sub-field in range type var}
- fsubWord : R.rtWord := R.rtLong;
- fsubInteger : R.rtInt := R.rtLong;
- fsubByte : R.rtByte := R.rtLong;
- fsubShortInt : R.rtSht := R.rtLong;
- fsubDouble : R.rtDbl := R.rtExt;
- fsubSingle : R.rtSgl := R.rtExt;
- fsubComp : R.rtComp := R.rtExt;
- end;
- SetValue(R);
- end else
- raise EEntryFieldError.Create(GetOrphStr(SCInvalidNumber));
- end;
-end;
-
-procedure TOvcBaseEntryField.SetAsVariant(Value : Variant);
- {-sets the field value to a Variant value}
-var
- fSub : Byte;
-begin
- {what data type is this field}
- fSub := efDataType mod fcpDivisor;
-
- case VarType(Value) of
- varSmallInt,
- varInteger :
- case fSub of
- fsubByte,
- fsubShortInt,
- fsubWord,
- fsubInteger,
- fsubLongInt : SetAsInteger(Value);
- else
- {try to convert it into a string}
- SetAsString(VarAsType(Value, varString));
- end;
- varSingle,
- varDouble,
- varCurrency :
- case fSub of
- fsubReal,
- fsubDouble,
- fsubSingle,
- fsubExtended,
- fsubComp : SetAsFloat(Value);
- else
- {try to convert it into a string}
- SetAsString(VarAsType(Value, varString));
- end;
- varDate :
- if fSub = fsubDate then
- SetAsDateTime(Value)
- else
- {try to convert it into a string}
- SetAsString(VarAsType(Value, varString));
- varBoolean :
- if fSub in [fsubBoolean, fsubYesNo] then
- SetAsBoolean(Value)
- else
- {try to convert it into a string}
- SetAsString(VarAsType(Value, varString));
- varString : SetAsString(Value);
- end;
-end;
-
-procedure TOvcBaseEntryField.SetAsStDate(Value : TStDate);
- {-sets the field value to a Date Value}
-begin
- if (efDataType mod fcpDivisor) = fsubDate then
- SetValue(Value)
- else
- raise EInvalidDataType.Create;
-end;
-
-procedure TOvcBaseEntryField.SetAsStTime(Value : TStTime);
- {-sets the field value to a Time Value}
-begin
- if efDataType mod fcpDivisor = fsubTime then
- SetValue(Value)
- else
- raise EInvalidDataType.Create;
-end;
-
-procedure TOvcBaseEntryField.SetAutoSize(Value : Boolean);
-begin
- if Value <> FAutoSize then begin
- FAutoSize := Value;
-
- if not (csLoading in ComponentState) then
- efAdjustSize; {adjust height based on font}
- end;
-end;
-
-procedure TOvcBaseEntryField.SetBorderStyle(Value : TBorderStyle);
-begin
- if FBorderStyle <> Value then begin
- FBorderStyle := Value;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
-end;
-
-procedure TOvcBaseEntryField.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
-begin
- if FAutoSize and (AHeight <> Height) and
- not (csLoading in ComponentState) then
- FAutoSize := False;
-
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-
- efCalcTopMargin;
-
- if HandleAllocated and (GetFocus = Handle) then
- efPositionCaret(False); {adjust caret for new size}
- Refresh;
-end;
-
-procedure TOvcBaseEntryField.SetDecimalPlaces(Value : Byte);
- {-set the number of decimal places for the edit field}
-begin
- if Value <> FDecimalPlaces then begin
- FDecimalPlaces := Value;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
-end;
-
-procedure TOvcBaseEntryField.SetEpoch(Value : Integer);
-begin
- if Value <> FEpoch then
- if (Value = 0) or ((Value >= MinYear) and (Value <= MaxYear)) then
- FEpoch := Value;
- if ControllerAssigned and (FEpoch = Controller.Epoch) then
- FEpoch := 0;
-end;
-
-procedure TOvcBaseEntryField.SetEverModified(Value : Boolean);
- {-set the EverModified flag}
-begin
- if Value then
- Include(sefOptions, sefEverModified)
- else begin
- Exclude(sefOptions, sefEverModified);
-
- {clear sefModified also}
- Exclude(sefOptions, sefModified);
- end;
-end;
-
-procedure TOvcBaseEntryField.SetInsCaretType(const Value : TOvcCaret);
- {-set the type of caret to use}
-begin
- if Value <> efCaret.InsCaretType then
- efCaret.InsCaretType := Value;
-end;
-
-procedure TOvcBaseEntryField.SetIntlSupport(Value : TOvcIntlSup);
- {-set the international support object this field will use}
-begin
- if Assigned(Value) then
- FIntlSup := Value
- else
- FIntlSup := OvcIntlSup;
-end;
-
-procedure TOvcBaseEntryField.SetMaxLength(Value : Word);
- {-set the maximum length of the edit field}
-begin
- if csLoading in ComponentState then
- FMaxLength := Value
- else if (FMaxLength <> Value) and
- (Value > 0) and
- (Value <= MaxEditLen) and
- (Value >= efPicLen) then begin
- FMaxLength := Value;
- if StrLen(efEditSt) > FMaxLength then
- efEditSt[FMaxLength] := #0;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
-end;
-
-procedure TOvcBaseEntryField.SetModified(Value : Boolean);
- {-set the modified flag}
-begin
- if Value then begin
- Include(sefOptions, sefModified);
-
- {set sefEverModified also}
- Include(sefOptions, sefEverModified);
- end else
- Exclude(sefOptions, sefModified);
-end;
-
-procedure TOvcBaseEntryField.SetOptions(Value : TOvcEntryFieldOptions);
- {-set the options flags}
-begin
- if Value <> Options then begin
- FOptions := Value;
- if (efoForceInsert in FOptions) then
- Exclude(FOptions, efoForceOvertype);
- if (efoForceOvertype in FOptions) then
- Exclude(FOptions, efoForceInsert);
- if (efoRightJustify in FOptions) then
- if efDataType mod fcpDivisor = fsubString then
- Include(FOptions, efoTrimBlanks);
- if (efoRightAlign in FOptions) then
- efPositionCaret(True);
- if not (efoTrimBlanks in FOptions) then begin
- {if this is a string picture field then turn off right justify}
- if efFieldClass = fcPicture then
- if efDataType mod fcpDivisor = fsubString then
- Exclude(FOptions, efoRightJustify);
- end;
- end;
- efRemoveBadOptions;
- Refresh;
-end;
-
-procedure TOvcBaseEntryField.SetOvrCaretType(const Value : TOvcCaret);
- {-set the type of caret to use}
-begin
- if Value <> efCaret.OvrCaretType then
- efCaret.OvrCaretType := Value;
-end;
-
-procedure TOvcBaseEntryField.SetPadChar(Value : AnsiChar);
- {-set the character used to pad the end of the edit string}
-begin
- if Value <> FPadChar then begin
- FPadChar := Value;
- Refresh;
- end;
-end;
-
-procedure TOvcBaseEntryField.SetPasswordChar(Value : AnsiChar);
- {-set the character used to mask password entry}
-begin
- if FPasswordChar <> Value then begin
- FPasswordChar := Value;
- if Value = #0 then
- Exclude(FOptions, efoPasswordMode);
- Refresh;
- end;
-end;
-
-procedure TOvcBaseEntryField.SetSelLength(Value : Integer);
- {-set the extent of the selected text}
-begin
- SetSelection(efSelStart, efSelStart + Value);
- Refresh;
-end;
-
-procedure TOvcBaseEntryField.SetInitialValue;
- {-resets the field value to its initial value}
-begin
- efSetInitialValue;
-end;
-
-procedure TOvcBaseEntryField.SetInsertMode(Value : Boolean);
- {-changes the field's insert mode}
-begin
- if Value <> (sefInsert in sefOptions) then begin
- if Value then
- Include(sefOptions, sefInsert)
- else
- Exclude(sefOptions, sefInsert);
- Controller.InsertMode := Value;
- efCaret.InsertMode := Value;
- end;
-end;
-
-procedure TOvcBaseEntryField.SetRangeHi(const Value : TRangeType);
- {-set the high range for this field}
-begin
- case efDataType mod fcpDivisor of
- fsubLongInt : efRangeHi.rtLong := Value.rtLong;
- fsubWord : efRangeHi.rtLong := Value.rtWord;
- fsubInteger : efRangeHi.rtLong := Value.rtInt;
- fsubByte : efRangeHi.rtLong := Value.rtByte;
- fsubShortInt : efRangeHi.rtLong := Value.rtSht;
- fsubExtended : efRangeHi.rtExt := Value.rtExt;
- fsubDouble : efRangeHi.rtExt := Value.rtDbl;
- fsubSingle : efRangeHi.rtExt := Value.rtSgl;
- fsubComp : efRangeHi.rtExt := Value.rtComp;
- else
- efRangeHi := Value;
- end;
- if (ValidateContents(true) > 0)
- and (Parent <> nil)
- and (Parent.Visible)
- and (Parent.Enabled) then
- SetFocus;
-end;
-
-procedure TOvcBaseEntryField.SetRangeHiStr(const Value : string);
- {-set the high field range from a string value}
-var
- R : TRangeType;
-begin
- R := efRangeHi;
- if not (csLoading in ComponentState) then
- if not efStRangeToRange(Value, R) then
- raise EInvalidRangeValue.Create(efDataType mod fcpDivisor);
- efRangeHi := R;
- if (ValidateContents(true) > 0)
- and (Parent <> nil)
- and (Parent.Visible)
- and (Parent.Enabled) then
- SetFocus;
-end;
-
-procedure TOvcBaseEntryField.SetRangeLo(const Value : TRangeType);
- {-set the low range for this field}
-begin
- case efDataType mod fcpDivisor of
- fsubLongInt : efRangeLo.rtLong := Value.rtLong;
- fsubWord : efRangeLo.rtLong := Value.rtWord;
- fsubInteger : efRangeLo.rtLong := Value.rtInt;
- fsubByte : efRangeLo.rtLong := Value.rtByte;
- fsubShortInt : efRangeLo.rtLong := Value.rtSht;
- fsubExtended : efRangeLo.rtExt := Value.rtExt;
- fsubDouble : efRangeLo.rtExt := Value.rtDbl;
- fsubSingle : efRangeLo.rtExt := Value.rtSgl;
- fsubComp : efRangeLo.rtExt := Value.rtComp;
- else
- efRangeLo := Value;
- end;
- if (ValidateContents(true) > 0)
- and (Parent <> nil)
- and (Parent.Visible)
- and (Parent.Enabled) then
- SetFocus;
-end;
-
-procedure TOvcBaseEntryField.SetRangeLoStr(const Value : string);
- {-set the low field range from a string value}
-var
- R : TRangeType;
-begin
- R := efRangeLo;
- if not (csLoading in ComponentState) then
- if not efStRangeToRange(Value, R) then
- raise EInvalidRangeValue.Create(efDataType mod fcpDivisor);
- efRangeLo := R;
- if (ValidateContents(true) > 0)
- and (Parent <> nil)
- and (Parent.Visible)
- and (Parent.Enabled) then
- SetFocus;
-end;
-
-procedure TOvcBaseEntryField.SetSelStart(Value : Integer);
- {-set the starting position of the selection}
-begin
- SetSelection(Value, Value);
- Refresh;
-end;
-
-procedure TOvcBaseEntryField.SetSelText(const Value : string);
- {-replace selected text with Value}
-var
- Msg : TMessage;
- Buf : array[0..MaxEditLen] of AnsiChar;
-begin
- StrPCopy(Buf, Value);
- Msg.lParam := LongInt(@Buf);
- efPerformEdit(Msg, ccPaste);
-end;
-
-procedure TOvcBaseEntryField.SetTextMargin(Value : Integer);
- {-set the text margin}
-begin
- if (Value <> FTextMargin) and (Value >= 2) then begin
- FTextMargin := Value;
- Refresh;
- end;
-end;
-
-procedure TOvcBaseEntryField.SetUninitialized(Value : Boolean);
- {-sets the Uninitialized option}
-begin
- if Value <> FUninitialized then begin
- FUninitialized := Value;
- efRemoveBadOptions;
- end;
-end;
-
-procedure TOvcBaseEntryField.SetUserData(Value : TOvcUserData);
- {-sets pointer to user-defined mask data object}
-begin
- if Assigned(Value) then
- FUserData := Value
- else
- FUserData := OvcUserData;
-end;
-
-procedure TOvcBaseEntryField.SetValue(const Data);
- {-changes the field value to the value in Data}
-begin
- if sefUserValidating in sefOptions then
- Exit;
-
- HandleNeeded;
-
- {set the updating flag so OnChange doesn't get fired}
- Include(sefOptions, sefUpdating);
- try
- case efDataType mod fcpDivisor of
- fsubString : efTransfer(@ShortString(Data), otf_SetData);
- fsubChar : efTransfer(@AnsiChar(Data), otf_SetData);
- fsubBoolean : efTransfer(@Boolean(Data), otf_SetData);
- fsubYesNo : efTransfer(@Boolean(Data), otf_SetData);
- fsubLongInt : efTransfer(@LongInt(Data), otf_SetData);
- fsubWord : efTransfer(@Word(Data), otf_SetData);
- fsubInteger : efTransfer(@SmallInt(Data), otf_SetData);
- fsubByte : efTransfer(@Byte(Data), otf_SetData);
- fsubShortInt : efTransfer(@ShortInt(Data), otf_SetData);
- fsubReal : efTransfer(@Real(Data), otf_SetData);
- fsubExtended : efTransfer(@Extended(Data), otf_SetData);
- fsubDouble : efTransfer(@Double(Data), otf_SetData);
- fsubSingle : efTransfer(@Single(Data), otf_SetData);
- fsubComp : efTransfer(@Comp(Data), otf_SetData);
- fsubDate : efTransfer(@TStDate(Data), otf_SetData);
- fsubTime : efTransfer(@TStTime(Data), otf_SetData);
- else
- raise EOvcException.Create(GetOrphStr(SCInvalidParamValue));
- end;
- finally
- Exclude(sefOptions, sefUpdating);
- end;
-end;
-
-procedure TOvcBaseEntryField.SetZeroDisplay(Value : TZeroDisplay);
- {-set flag that determines if zeros are hidden}
-begin
- if Value <> FZeroDisplay then begin
- FZeroDisplay := Value;
- Refresh;
- end;
-end;
-
-procedure TOvcBaseEntryField.SetZeroDisplayValue(Value : Double);
- {-set value used by ZeroDisplay logic}
-begin
- if Value <> FZeroDisplayValue then begin
- FZeroDisplayValue := Value;
- Refresh;
- end;
-end;
-
-function TOvcBaseEntryField.ValidateContents(ReportError : Boolean) : Word;
- {-performs field validation, returns error code, and conditionally reports error}
-var
- WasValid : Boolean;
-begin
-{ - If the parent is not enabled or visible then don't attempt to }
-{ validate the contents of the control. }
- if (not (Enabled and Visible)) or (Parent = nil)
- or (not (Parent.Enabled and Parent.Visible))
- then begin
- Result := 0;
- Exit;
- end;
-
- FLastError := 0;
-
- {record current valid state}
- WasValid := IsValid;
-
- {check for empty/uninitialized required field}
- if (efoInputRequired in Options) and not efIsReadOnly then
- if efFieldIsEmpty or (Uninitialized and not (sefModified in sefOptions)) then
- FLastError := oeRequiredField;
-
- {ask the validation routine if there's an error}
- if FLastError = 0 then begin
- Include(sefOptions, sefValidating);
- try
- FLastError := efValidateField;
- finally
- Exclude(sefOptions, sefValidating);
- end;
- end;
-
- if ReportError and (FLastError <> 0) then
- PostMessage(Handle, om_ReportError, FLastError, 0);
-
- {update invalid flag}
- if FLastError = 0 then
- Exclude(sefOptions, sefInvalid)
- else if efoSoftValidation in Options then
- Include(sefOptions, sefInvalid);
-
- {force field to repaint if valid state has changed}
- if WasValid <> IsValid then
- Invalidate;
-
- Result := FLastError;
-end;
-
-function TOvcBaseEntryField.ValidateSelf : Boolean;
- {-performs field validation, returns true if no errors, and reports error if not using SoftValidation}
-begin
- Result := ValidateContents(not (efoSoftValidation in Options)) = 0;
-end;
-
-procedure TOvcBaseEntryField.WMChar(var Msg : TWMChar);
-begin
- inherited;
-
- if sefCharOk in sefOptions then
- efPerformEdit(TMessage(Msg), ccChar);
-end;
-
-procedure TOvcBaseEntryField.WMClear(var Msg : TWMClear);
-begin
- efPerformEdit(TMessage(Msg), ccCut);
-end;
-
-procedure TOvcBaseEntryField.WMCopy(var Msg : TWMCopy);
-begin
- efPerformEdit(TMessage(Msg), ccCopy);
-end;
-
-procedure TOvcBaseEntryField.WMCut(var Msg : TWMCut);
-begin
- efCopyPrim;
- efPerformEdit(TMessage(Msg), ccCut);
-end;
-
-procedure TOvcBaseEntryField.WMEraseBkGnd(var Msg : TWMEraseBkGnd);
-begin
- Msg.Result := 1; {don't erase background}
-end;
-
-procedure TOvcBaseEntryField.WMGetDlgCode(var Msg : TWMGetDlgCode);
-begin
- inherited;
-
- if csDesigning in ComponentState then
- Msg.Result := DLGC_STATIC
- else
- Msg.Result := Msg.Result or DLGC_WANTCHARS or DLGC_WANTARROWS;
-end;
-
-procedure TOvcBaseEntryField.WMKeyDown(var Msg : TWMKeyDown);
-var
- Cmd : Word;
-begin
- inherited;
-
- if Msg.CharCode = 0 then
- Exit;
-
- {don't process shift key by itself}
- if Msg.CharCode = VK_SHIFT then
- Exit;
-
- {see if this command should be processed by us}
- Cmd := Controller.EntryCommands.Translate(TMessage(Msg));
-
- {convert undo to restore since ctrl-Z is mapped to ccUndo by default}
- {and cannot be mapped to more than one command in a command table}
- if Cmd = ccUndo then
- Cmd := ccRestore;
-
- if Cmd <> ccNone then begin
- if (Cmd <> ccIns) or
- not ((efoForceInsert in Options) or
- (efoForceOvertype in Options)) then begin
- case Cmd of
- ccCut : WMCut(TWMCut(Msg));
- ccCopy : WMCopy(TWMCopy(Msg));
- ccPaste : WMPaste(TWMPaste(Msg));
- else
- efPerformEdit(TMessage(Msg), Cmd);
- end;
- end;
- end;
-end;
-
-procedure TOvcBaseEntryField.WMKillFocus(var Msg : TWMKillFocus);
-var
- NewWindow : HWnd;
- SaveModified : Boolean;
-begin
- {where is the focus going?}
- NewWindow := Msg.FocusedWnd;
- if NewWindow = Handle then
- NewWindow := 0
- else if not efIsSibling(NewWindow) then
- NewWindow := 0;
-
- {retain caret position if focus is moving }
- {to a menu or a component not on this form}
- if (NewWindow = 0) then
- Include(sefOptions, sefRetainPos)
- else
- Exclude(sefOptions, sefRetainPos);
-
- {destroy caret}
- efCaret.Linked := False;
-
- {if the mouse if currently captured, release it}
- if MouseCapture then
- MouseCapture := False;
-
- {perform default processing}
- inherited;
-
- {set controller's insert mode flag for sibling fields' to access}
- if not ((efoForceInsert in Options) or
- (efoForceOvertype in Options)) then
- {are we in insert mode}
- Controller.InsertMode := sefInsert in sefOptions;
-
- {if no error is pending for this control...}
- if not (sefErrorPending in sefOptions) and
- not (sefIgnoreFocus in sefOptions) then begin
- Include(sefOptions, sefValPending);
-
- {and focus is going to a control...}
- if (NewWindow <> 0) then begin
- if sefModified in sefOptions then
- {clear the unitialized option}
- Uninitialized := False;
-
- {that isn't a Cancel, Restore, or Help button...}
- if not Controller.IsSpecialButton(Msg.FocusedWnd) then begin
- {then validate this field}
- efCanClose(True {validate});
- if sefErrorPending in sefOptions then
- Include(sefOptions, sefValPending)
- else
- Exclude(sefOptions, sefValPending);
- end else begin
- {just call validate field and ignore the error, if any}
- {this forces the field to redisplay using the proper format}
- SaveModified := Modified;
- efValidateField;
- Modified := SaveModified;
- end;
- end;
- end else begin
- {set the validation pending flag on if an error is pending}
- if sefErrorPending in sefOptions then
- Include(sefOptions, sefValPending)
- else
- Exclude(sefOptions, sefValPending);
- end;
-
- {we no longer have the focus}
- Exclude(sefOptions, sefHaveFocus);
-
- {if we're not coming back...}
- if (NewWindow <> 0) and not (sefRetainPos in sefOptions) and
- not (sefIgnoreFocus in sefOptions) then begin
- efPerformPostEditNotify(FindControl(Msg.FocusedWnd));
- end;
- Exclude(sefOptions, sefIgnoreFocus);
-
- {reset the caret position}
- if not (sefRetainPos in sefOptions) then
- efCaretToStart;
-
- {redraw the field}
- Refresh;
-end;
-
-procedure TOvcBaseEntryField.WMLButtonDblClk(var Msg : TWMLButtonDblClk);
-begin
- if sefHaveFocus in sefOptions then
- efPerformEdit(TMessage(Msg), ccDblClk);
-
- inherited;
-end;
-
-procedure TOvcBaseEntryField.WMLButtonDown(var Msg : TWMLButtonDown);
-begin
- inherited;
-
- if not (sefHaveFocus in sefOptions) then begin
- Include(sefOptions, sefNoHighlight);
- SetSelection(0, 0);
- if not Focused then
- SetFocus;
- end;
-
-// inherited;
-
- if sefHaveFocus in sefOptions then
- efPerformEdit(TMessage(Msg), ccMouse);
-end;
-
-procedure TOvcBaseEntryField.WMMouseActivate(var Msg : TWMMouseActivate);
-begin
- if csDesigning in ComponentState then
- Exit;
-
- inherited;
-end;
-
-procedure TOvcBaseEntryField.WMMouseMove(var Msg : TWMMouseMove);
-begin
- inherited;
-
- if MouseCapture then
- if {$IFNDEF LCL} GetAsyncKeyState(GetLeftButton) {$ELSE} GetKeyState(GetLeftButton) {$ENDIF} and $8000 <> 0 then
- efPerformEdit(TMessage(Msg), ccMouseMove);
-end;
-
-procedure TOvcBaseEntryField.WMPaste(var Msg : TWMPaste);
- {-paste text in the clipboard into the field}
-var
- H : THandle;
-begin
-{$IFNDEF LCL}
- H := Clipboard.GetAsHandle(CF_TEXT);
- if H <> 0 then begin
- TMessage(Msg).lParam := LongInt(GlobalLock(H));
- efPerformEdit(TMessage(Msg), ccPaste);
- GlobalUnlock(H);
- end;
-{$ENDIF}
-end;
-
-procedure TOvcBaseEntryField.WMRButtonUp(var Msg : TWMRButtonDown);
-var
- P : TPoint;
- M : TPopUpMenu;
- MI : TMenuItem;
-begin
- if not (sefHaveFocus in sefOptions) then
- if not Focused and CanFocus then
- SetFocus;
-
- inherited;
- if PopUpMenu = nil then begin
- M := TPopupMenu.Create(Self);
- try
- MI := TMenuItem.Create(M);
- MI.Caption := GetOrphStr(SCRestoreMI);
- MI.Enabled := Modified;
- MI.OnClick := DoRestoreClick;
- M.Items.Add(MI);
-
- MI := TMenuItem.Create(M);
- MI.Caption := '-';
- M.Items.Add(MI);
-
- MI := TMenuItem.Create(M);
- MI.Caption := GetOrphStr(SCCutMI);
- MI.Enabled := (SelectionLength > 0) and not efIsReadOnly;
- MI.OnClick := DoCutClick;
- M.Items.Add(MI);
-
- MI := TMenuItem.Create(M);
- MI.Caption := GetOrphStr(SCCopyMI);
- MI.Enabled := SelectionLength > 0;
- MI.OnClick := DoCopyClick;
- M.Items.Add(MI);
-
- MI := TMenuItem.Create(M);
- MI.Caption := GetOrphStr(SCPasteMI);
- MI.Enabled := not efIsReadOnly and Clipboard.HasFormat(CF_TEXT);
- MI.OnClick := DoPasteClick;
- M.Items.Add(MI);
-
- MI := TMenuItem.Create(M);
- MI.Caption := GetOrphStr(SCDeleteMI);
- MI.Enabled := (SelectionLength > 0) and not efIsReadOnly;
- MI.OnClick := DoDeleteClick;
- M.Items.Add(MI);
-
- MI := TMenuItem.Create(M);
- MI.Caption := '-';
- M.Items.Add(MI);
-
- MI := TMenuItem.Create(M);
- MI.Caption := GetOrphStr(SCSelectAllMI);
- MI.Enabled := LongInt(StrLen(efEditSt)) > SelectionLength;
- MI.OnClick := DoSelectAllClick;
- M.Items.Add(MI);
-
- P.X := Msg.XPos;
- P.Y := Msg.YPos;
- P := ClientToScreen(P);
- M.PopUp(P.X, P.Y);
-
- Application.ProcessMessages;
- finally
- M.Free;
- end;
- end;
-end;
-
-procedure TOvcBaseEntryField.WMSetFocus(var Msg : TWMSetFocus);
-var
- Highlight,
- Ignore,
- FixHOfs,
- ValPending : Boolean;
- PF : TForm;
- P : TPoint;
-begin
- if ((csLoading in ComponentState) or
- (csDesigning in ComponentState)) then
- Exit;
-
- {we have the focus}
- Include(sefOptions, sefHaveFocus);
-
- {reset command processor}
- Controller.EntryCommands.ResetCommandProcessor;
-
- {get validation state}
- ValPending := sefValPending in sefOptions;
-
- {calling Show forces the parent to do whatever is necessary to}
- {make sure that we are visible. In the case where the entry}
- {field is on a non-visible notebook page that has had its}
- {handle deallocated, this insures that the page is made visible}
- {and that the window handles have been created}
-
- {if focus is retruning because of an error condition}
- if ValPending then begin
-
- {tell the control that lost the focus to}
- {cancel any special modes it might be in}
- if Msg.FocusedWnd > 0 then begin
- SendMessage(Msg.FocusedWnd, WM_CANCELMODE, 0, 0);
- GetCursorPos(P);
- {send a fake mouse up message to force release of mouse capture}
- {this is necessary so that the TStringGrid exits highlight mode}
- SendMessage(Msg.FocusedWnd, WM_LBUTTONUP, 0, MakeLong(P.X, P.Y));
- end;
-
- Show;
- PF := TForm(GetParentForm(Self));
- if Assigned(PF) then
- PF.FocusControl(Self);
- end;
-
- {get the field's insert mode}
- if not ((efoForceInsert in Options) or
- (efoForceOvertype in Options)) then
- if Controller.InsertMode then
- Include(sefOptions, sefInsert)
- else
- Exclude(sefOptions, sefInsert);
-
- if sefRetainPos in sefOptions then begin
- Highlight := False;
- FixHOfs := False;
- Ignore := False;
- end else begin
- Ignore := Controller.ErrorPending and {not us} (FLastError = 0);
- if not Ignore then begin
- if not ValPending then
- Exclude(sefOptions, sefModified);
- efPerformPreEditNotify(FindControl(Msg.FocusedWnd));
- {save a copy of the current edit string}
- efSaveEditString;
- end;
-
- if sefNoHighlight in sefOptions then begin
- Highlight := False;
- FixHOfs := False;
- end else begin
- Highlight := (not Ignore);
- FixHOfs := True;
- efResetCaret;
- end;
- end;
-
- if Ignore and not (efoSoftValidation in Options) then
- Include(sefOptions, sefIgnoreFocus)
- else
- Exclude(sefOptions, sefIgnoreFocus);
-
- Exclude(sefOptions, sefErrorPending);
- Exclude(sefOptions, sefRetainPos);
- Exclude(sefOptions, sefNoHighlight);
- Exclude(sefOptions, sefValPending);
-
- {clear controller's error pending flag}
- if not Ignore then
- Controller.ErrorPending := False;
-
- inherited;
-
- if (efoForceInsert in Options) then
- Include(sefOptions, sefInsert)
- else if (efoForceOvertype in Options) then
- Exclude(sefOptions, sefInsert);
-
- efCaret.Linked := True;
- efCaret.Visible := True;
- efCaret.InsertMode := (sefInsert in sefOptions);
- efPositionCaret(FixHOfs);
-
- if Highlight and (efoAutoSelect in Controller.EntryOptions) then
- SetSelection(0, MaxEditLen);
-
- Refresh;
-end;
-
-procedure TOvcBaseEntryField.WMSetFont(var Msg : TWMSetFont);
-begin
- inherited;
-
- {inherited WMSetFont sets our font. Set it as our canvas font}
- Canvas.Font := Font;
-end;
-
-procedure TOvcBaseEntryField.WMSetText(var Msg : TWMSetText);
-begin
- if HandleAllocated then begin
- SetSelection(0, MaxEditLen);
- efPerformEdit(TMessage(Msg), ccPaste);
- end;
-end;
-
-procedure TOvcBaseEntryField.WMSize(var Msg : TWMSize);
-begin
- inherited;
-
- Refresh;
-end;
-
-procedure TOvcBaseEntryField.WMSysKeyDown(var Msg : TWMSysKeyDown);
-var
- Cmd : Word;
-begin
- inherited;
-
- {exit if this is a Tab key or an Alt key by itself}
- if (Msg.CharCode = VK_TAB) or (Msg.CharCode = VK_ALT) then
- Exit;
-
- {see if this command should be processed by us}
- Cmd := Controller.EntryCommands.TranslateKey(Msg.CharCode, [ssAlt]);
-
- {convert undo to restore since ctrl-Z is mapped to ccUndo by default}
- {and cannot be mapped to more than one command in a command table}
- if Cmd = ccUndo then
- Cmd := ccRestore;
-
- if Cmd <> ccNone then begin
- case Cmd of
- ccCut : WMCut(TWMCut(Msg));
- ccCopy : WMCopy(TWMCopy(Msg));
- ccPaste : WMPaste(TWMPaste(Msg));
- else
- efPerformEdit(TMessage(Msg), Cmd);
- end;
-
- {allow entering of characters using Alt-keypad numbers}
- case Msg.CharCode of
- vk_NumPad0, vk_NumPad1, vk_NumPad2, vk_NumPad3, vk_NumPad4,
- vk_NumPad5, vk_NumPad6, vk_NumPad7, vk_NumPad8, vk_NumPad9:
- begin
- Include(sefOptions, sefCharOk);
- Include(sefOptions, sefAcceptChar);
- end;
- end;
- end;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/cf/cf0474327297d663abdd070b6477b3fa238464ca.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/cf/cf0474327297d663abdd070b6477b3fa238464ca.svn-base
deleted file mode 100644
index 5e482e99..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/cf/cf0474327297d663abdd070b6477b3fa238464ca.svn-base
+++ /dev/null
@@ -1,146 +0,0 @@
-{*********************************************************}
-{* O32INTDEQ.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 ***** *}
-
-{The following is a modified version of deque code, which was originally written
- for Algorithms Alfresco. It is copyright(c)2001 by Julian M. Bucknall and is
- used here with permission.}
-
-{$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 o32intdeq;
- {A simple deque class for Orpheus}
-
-interface
-
-uses
- Classes;
-
-type
- TO32IntDeque = class
- protected {private}
- FList : TList;
- FHead : integer;
- FTail : integer;
- procedure idGrow;
- public
- constructor Create(aCapacity : integer);
- destructor Destroy; override;
- function IsEmpty : boolean;
- procedure Enqueue(aValue: integer);
- procedure Push(aValue: integer);
- function Pop: integer;
- end;
-
-implementation
-
-uses
- SysUtils;
-
-{=== TO32IntDeque ====================================================}
-constructor TO32IntDeque.Create(aCapacity : integer);
-begin
- inherited Create;
- FList := TList.Create;
- FList.Count := aCapacity;
- {let's help out the user of the deque by putting the head and tail
- pointers in the middle: it's probably more efficient}
- FHead := aCapacity div 2;
- FTail := FHead;
-end;
-{--------}
-destructor TO32IntDeque.Destroy;
-begin
- FList.Free;
- inherited Destroy;
-end;
-{--------}
-procedure TO32IntDeque.Enqueue(aValue : integer);
-begin
- FList.List^[FTail] := pointer(aValue);
- inc(FTail);
- if (FTail = FList.Count) then
- FTail := 0;
- if (FTail = FHead) then
- idGrow;
-end;
-{--------}
-procedure TO32IntDeque.idGrow;
-var
- OldCount : integer;
- i, j : integer;
-begin
- {grow the list by 50%}
- OldCount := FList.Count;
- FList.Count := (OldCount * 3) div 2;
- {expand the data into the increased space, maintaining the deque}
- if (FHead = 0) then
- FTail := OldCount
- else begin
- j := FList.Count;
- for i := pred(OldCount) downto FHead do begin
- dec(j);
- FList.List^[j] := FList.List^[i]
- end;
- FHead := j;
- end;
-end;
-{--------}
-function TO32IntDeque.IsEmpty : boolean;
-begin
- Result := FHead = FTail;
-end;
-{--------}
-procedure TO32IntDeque.Push(aValue : integer);
-begin
- if (FHead = 0) then
- FHead := FList.Count;
- dec(FHead);
- FList.List^[FHead] := pointer(aValue);
- if (FTail = FHead) then
- idGrow;
-end;
-{--------}
-function TO32IntDeque.Pop : integer;
-begin
- if FHead = FTail then
- raise Exception.Create('Integer deque is empty: cannot pop');
- Result := integer(FList.List^[FHead]);
- inc(FHead);
- if (FHead = FList.Count) then
- FHead := 0;
-end;
-{=== TO32IntDeque - end ==============================================}
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/cf/cf490af41a96efe66450b7cebac0fe176ef972a1.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/cf/cf490af41a96efe66450b7cebac0fe176ef972a1.svn-base
deleted file mode 100644
index 4c60b145..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/cf/cf490af41a96efe66450b7cebac0fe176ef972a1.svn-base
+++ /dev/null
@@ -1,186 +0,0 @@
-{*********************************************************}
-{* 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.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/d2/d2c26076d554c9dec7ce9fc740b6faf9b1b426c4.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/d2/d2c26076d554c9dec7ce9fc740b6faf9b1b426c4.svn-base
deleted file mode 100644
index c81c7c7d..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/d2/d2c26076d554c9dec7ce9fc740b6faf9b1b426c4.svn-base
+++ /dev/null
@@ -1,142 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 816
- Height = 480
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'Arial'
- Font.Style = []
- OldCreateOrder = False
- Position = poScreenCenter
- OnCreate = FormCreate
- OnDestroy = FormDestroy
- DesignSize = (
- 808
- 446)
- PixelsPerInch = 96
- TextHeight = 14
- object OvcTable1: TOvcTable
- Left = 16
- Top = 16
- Width = 777
- Height = 409
- Anchors = [akLeft, akTop, akRight, akBottom]
- Color = clWindow
- Controller = OvcController1
- GridPenSet.NormalGrid.NormalColor = clBtnShadow
- GridPenSet.NormalGrid.Style = psDot
- GridPenSet.NormalGrid.Effect = geBoth
- GridPenSet.LockedGrid.NormalColor = clBtnShadow
- GridPenSet.LockedGrid.Style = psSolid
- GridPenSet.LockedGrid.Effect = ge3D
- GridPenSet.CellWhenFocused.NormalColor = clBlack
- GridPenSet.CellWhenFocused.Style = psSolid
- GridPenSet.CellWhenFocused.Effect = geBoth
- GridPenSet.CellWhenUnfocused.NormalColor = clBlack
- GridPenSet.CellWhenUnfocused.Style = psDash
- GridPenSet.CellWhenUnfocused.Effect = geBoth
- LockedRowsCell = OvcTCColHead1
- Options = [otoNoRowResizing, otoNoColResizing, otoTabToArrow, otoEnterToArrow, otoAlwaysEditing, otoNoSelection, otoThumbTrack]
- TabOrder = 0
- OnGetCellData = OvcTable1GetCellData
- CellData = (
- 'Form1.OvcTCColHead1'
- 'Form1.OvcTCRowHead1'
- 'Form1.OvcTCString1'
- 'Form1.OvcTCMemo1'
- 'Form1.OvcTCCheckBox1'
- 'Form1.OvcTCComboBox1'
- 'Form1.OvcTCBitMap1')
- RowData = (
- 35)
- ColData = (
- 120
- False
- True
- 'Form1.OvcTCRowHead1'
- 100
- False
- True
- 'Form1.OvcTCString1'
- 150
- False
- True
- 'Form1.OvcTCMemo1'
- 120
- False
- True
- 'Form1.OvcTCCheckBox1'
- 160
- False
- True
- 'Form1.OvcTCComboBox1'
- 100
- False
- True
- 'Form1.OvcTCBitMap1')
- end
- object OvcTCColHead1: TOvcTCColHead
- Headings.Strings = (
- 'TOvcTCRowHead'
- 'TOvcTCString'
- 'TOvcTCMemo'
- 'TOvcTCCheckBox'
- 'TOvcTCComboBox'
- 'TOvcTCBitmap')
- ShowLetters = False
- Adjust = otaCenter
- Table = OvcTable1
- Left = 48
- end
- object OvcTCRowHead1: TOvcTCRowHead
- Adjust = otaCenter
- Table = OvcTable1
- Left = 80
- end
- object OvcTCString1: TOvcTCString
- AutoAdvanceLeftRight = True
- Table = OvcTable1
- Left = 144
- end
- object OvcTCMemo1: TOvcTCMemo
- Table = OvcTable1
- Left = 264
- end
- object OvcTCCheckBox1: TOvcTCCheckBox
- Adjust = otaCenter
- CellGlyphs.IsDefault = True
- CellGlyphs.GlyphCount = 3
- CellGlyphs.ActiveGlyphCount = 2
- Table = OvcTable1
- Left = 384
- end
- object OvcTCComboBox1: TOvcTCComboBox
- Style = csDropDownList
- Table = OvcTable1
- OnChange = OvcTCComboBox1Change
- Left = 512
- end
- object OvcTCBitMap1: TOvcTCBitMap
- Adjust = otaTopCenter
- Table = OvcTable1
- Left = 624
- end
- object OvcController1: TOvcController
- EntryCommands.TableList = (
- 'Default'
- True
- ()
- 'WordStar'
- False
- ()
- 'Grid'
- False
- ())
- Epoch = 2000
- Left = 16
- end
-end
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/d3/d35d40998fde79a29f9e850f9844031a94a222d3.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/d3/d35d40998fde79a29f9e850f9844031a94a222d3.svn-base
deleted file mode 100644
index 6826365b..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/d3/d35d40998fde79a29f9e850f9844031a94a222d3.svn-base
+++ /dev/null
@@ -1,197 +0,0 @@
-{*********************************************************}
-{* OVCABOT0.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 Ovcabot0;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, MyMisc, Buttons, {$ENDIF}
- SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
- {$IFNDEF LCL} {$IFDEF VERSION6} DesignIntf, DesignEditors, {$ELSE} DsgnIntf, {$ENDIF} {$ELSE} PropEdits, {$ENDIF}
- ExtCtrls, OvcVer, OvcURL, {$IFDEF MSWINDOWS} ShellAPI; {$ELSE} Unix; {$ENDIF}
-
-type
- TOvcfrmAboutForm = class(TForm)
- Panel1: TPanel;
- Image1: TImage;
- btnOK: TButton;
- Label1: TLabel;
- VisitUsLabel: TLabel;
- lblTurboLink: TLabel;
- Bevel3: TBevel;
- GeneralNewsgroupsLabel: TLabel;
- lblHelp: TLabel;
- lblGeneralDiscussion: TLabel;
- Label3: TLabel;
- Label2: TLabel;
- procedure btnOKClick(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure lblTurboLinkClick(Sender: TObject);
- procedure lblHelpClick(Sender: TObject);
- procedure lblGeneralDiscussionClick(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
- TOvcAboutProperty = class(TStringProperty)
- public
- function GetAttributes: TPropertyAttributes;
- override;
- procedure Edit;
- override;
- end;
-
-implementation
-{$IFNDEF LCL}
-{$R *.DFM}
-{$ENDIF}
-
-
-{*** TOrAboutProperty ***}
-
-function TOvcAboutProperty.GetAttributes: TPropertyAttributes;
-begin
- Result := [paDialog, paReadOnly];
-end;
-
-procedure TOvcAboutProperty.Edit;
-begin
- with TOvcfrmAboutForm.Create(Application) do begin
- try
- ShowModal;
- finally
- Free;
- end;
- end;
-end;
-
-{*** TEsAboutForm ***}
-
-procedure TOvcfrmAboutForm.btnOKClick(Sender: TObject);
-begin
- Close;
-end;
-
-procedure TOvcfrmAboutForm.FormCreate(Sender: TObject);
-begin
- Top := (Screen.Height - Height) div 3;
- Left := (Screen.Width - Width) div 2;
-
- lblTurboLink.Cursor := crHandPoint;
- lblHelp.Cursor := crHandPoint;
- lblGeneralDiscussion.Cursor := crHandPoint;
-
-{$IFDEF LCL}
- Image1.Transparent := False; //Default is True with Laz, False with Delphi
-{$ENDIF}
-end;
-
-procedure TOvcfrmAboutForm.lblTurboLinkClick(Sender: TObject);
-begin
-{$IFDEF MSWINDOWS}
- {$IFNDEF LCL}
- if ShellExecute(0, 'open', 'http://sourceforge.net/projects/tporpheus/',
- {$ELSE}
- if ShellExecute(0, 'open', PChar('http://sourceforge.net/projects/tporpheus/'),
- {$ENDIF}
- '', '', SW_SHOWNORMAL) <= 32
-{$ELSE}
- {$IFDEF DARWIN}
- if Shell('Open http://sourceforge.net/projects/tporpheus/') = 127
- {$ELSE}
- if (GetBrowserPath = '') or
- (Shell(GetBrowserPath + ' http://sourceforge.net/projects/tporpheus/') = 127)
- {$ENDIF}
-{$ENDIF}
- then
- ShowMessage('Error launching browser.');
-end;
-
-procedure TOvcfrmAboutForm.lblHelpClick(Sender: TObject);
-begin
-{$IFDEF MSWINDOWS}
- if ShellExecute(0, 'open',
- {$IFNDEF LCL}
- 'http://sourceforge.net/forum/forum.php?forum_id=241874', '', '',
- {$ELSE}
- PChar('http://sourceforge.net/forum/forum.php?forum_id=241874'), '', '',
- {$ENDIF}
- SW_SHOWNORMAL) <= 32
-{$ELSE}
- {$IFDEF DARWIN}
- if Shell('Open http://sourceforge.net/forum/forum.php?forum_id=241874') = 127
- {$ELSE}
- if (GetBrowserPath = '') or
- (Shell(GetBrowserPath + ' http://sourceforge.net/forum/forum.php?forum_id=241874') = 127)
- {$ENDIF}
-{$ENDIF}
- then
- ShowMessage('Error launching browser.');
-end;
-
-procedure TOvcfrmAboutForm.lblGeneralDiscussionClick(Sender: TObject);
-begin
-{$IFDEF MSWINDOWS}
- if ShellExecute(0, 'open',
- {$IFNDEF LCL}
- 'http://sourceforge.net/forum/forum.php?forum_id=241873', '', '',
- {$ELSE}
- PChar('http://sourceforge.net/forum/forum.php?forum_id=241873'), '', '',
- {$ENDIF}
- SW_SHOWNORMAL) <= 32
-{$ELSE}
- {$IFDEF DARWIN}
- if Shell('Open http://sourceforge.net/forum/forum.php?forum_id=241873') = 127
- {$ELSE}
- if (GetBrowserPath = '') or
- (Shell(GetBrowserPath + ' http://sourceforge.net/forum/forum.php?forum_id=241873') = 127)
- {$ENDIF}
-{$ENDIF}
- then
- ShowMessage('Error launching browser.');
-end;
-
-initialization
-{$IFDEF LCL}
-{$I Ovcabot0.lrs} {Include form's resource file}
-{$ENDIF}
-
-end.
-
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/d4/d4170e867060f94673bacf9f9a704bca0618df19.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/d4/d4170e867060f94673bacf9f9a704bca0618df19.svn-base
deleted file mode 100644
index 4ed8bcd6..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/d4/d4170e867060f94673bacf9f9a704bca0618df19.svn-base
+++ /dev/null
@@ -1,32 +0,0 @@
-LazarusResources.Add('TForm1','FORMDATA',[
- 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#192#0#3'Top'#2'r'#5'Width'#3#159#1#6'Heig'
- +'ht'#3'!'#1#7'Caption'#6#5'Form1'#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7
- +#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245
- +#10'Font.Style'#11#0#13'PixelsPerInch'#2'`'#0#6'TLabel'#6'Label1'#4'Left'#2
- +#16#3'Top'#2#16#5'Width'#3#129#1#6'Height'#2')'#9'Alignment'#7#8'taCenter'#8
- +'AutoSize'#8#7'Caption'#6'KEnter a positive integer, then move to next contr'
- +'ol to validate the number.'#8'WordWrap'#9#0#0#6'TLabel'#6'Label2'#4'Left'#2
- +#16#3'Top'#2'x'#5'Width'#3#129#1#6'Height'#2')'#9'Alignment'#7#8'taCenter'#8
- +'AutoSize'#8#7'Caption'#6'OEnter a positive real number, then move to next c'
- +'ontrol to validate the number.'#8'WordWrap'#9#0#0#12'TO32FlexEdit'#12'O32Fl'
- +'exEdit1'#4'Left'#3#168#0#3'Top'#2'8'#5'Width'#2'Q'#6'Height'#2#21#27'EfColo'
- +'rs.Disabled.BackColor'#7#8'clWindow'#27'EfColors.Disabled.TextColor'#7#10'c'
- +'lGrayText'#24'EfColors.Error.BackColor'#7#5'clRed'#24'EfColors.Error.TextCo'
- +'lor'#7#7'clBlack'#28'EfColors.Highlight.BackColor'#7#11'clHighlight'#28'EfC'
- +'olors.Highlight.TextColor'#7#15'clHighlightText'#8'TabOrder'#2#0#22'Validat'
- +'ion.BeepOnError'#9#25'Validation.SoftValidation'#8#26'Validation.Validation'
- +'Event'#7#8'veOnExit'#24'Validation.ValidatorType'#6#4'None'#25'Validation.V'
- +'alidationType'#7#6'vtUser'#24'Validation.InputRequired'#8#6'OnExit'#7#15'O3'
- +'2FlexEditExit'#16'OnUserValidation'#7#26'O32FlexEdit1UserValidation'#17'OnV'
- +'alidationError'#7#26'O32FlexEditValidationError'#0#0#12'TO32FlexEdit'#12'O3'
- +'2FlexEdit2'#4'Left'#3#168#0#3'Top'#3#160#0#5'Width'#2'Q'#6'Height'#2#21#27
- +'EfColors.Disabled.BackColor'#7#8'clWindow'#27'EfColors.Disabled.TextColor'#7
- +#10'clGrayText'#24'EfColors.Error.BackColor'#7#5'clRed'#24'EfColors.Error.Te'
- +'xtColor'#7#7'clBlack'#28'EfColors.Highlight.BackColor'#7#11'clHighlight'#28
- +'EfColors.Highlight.TextColor'#7#15'clHighlightText'#8'TabOrder'#2#1#22'Vali'
- +'dation.BeepOnError'#9#25'Validation.SoftValidation'#8#26'Validation.Validat'
- +'ionEvent'#7#8'veOnExit'#24'Validation.ValidatorType'#6#4'None'#25'Validatio'
- +'n.ValidationType'#7#6'vtUser'#24'Validation.InputRequired'#8#6'OnExit'#7#15
- +'O32FlexEditExit'#16'OnUserValidation'#7#26'O32FlexEdit2UserValidation'#17'O'
- +'nValidationError'#7#26'O32FlexEditValidationError'#0#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/d4/d45edda685b66b1f23819ea98518db797e145d86.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/d4/d45edda685b66b1f23819ea98518db797e145d86.svn-base
deleted file mode 100644
index 58aabe96..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/d4/d45edda685b66b1f23819ea98518db797e145d86.svn-base
+++ /dev/null
@@ -1,771 +0,0 @@
-
-
-
-
-
-
-Status of Orpheus Port
-
-
-
-
-
-
-
-Status of Orpheus Port
-
-
-
-Contents
-What's New
-Introduction
-Installation
-Platforms Tested
-Examples
-Porting Philosophy
-Usage Notes
-Limitations
-Status of Individual Controls
-To Do
-Other Resources
-
-
-What's New
-
-
-20090921 release (0.2.2):
-
- Lazarus 0.9.27 eliminated the Ctl3D property, breaking Orpheus, which uses
- Ctl3D in several controls. This release restores the Ctl3D property so
- Orpheus can again be compiled with Lazarus.
- The status table below has been updated for all widgetsets. In some cases
- Orpheus controls have improved with general improvements and bug fixes
- in the LCL and underlying widgetset code; in a few cases, however, Orpheus
- controls perform worse than they did previously, probably due to
- side-effects from LCL changes.
-
-
- 20081229 release (0.2.1):
-
- Adds TOvcCalendar.
- Updated results of testing for Lazarus 0.9.26. GTK2 widgetset now working better.
-
-
- 20080720 release (0.2.0):
-
- Recent change in the Lazarus LCL broke Orpheus TOvcTable on Windows. This release
- works around that change.
- Numerous bugs fixed and workarounds found. See To Do list.
- Batch/script files are now included for compiling all test apps at once.
-
-
- 20080316 release (0.1.9):
-
- Recent changes in the Lazarus LCL broke Orpheus compilation. This release
- can now be compiled.
-
- 20080301 release (0.1.8):
-
- Recent changes in the Lazarus LCL broke all Orpheus property editors and example
- programs. This release fixes those problems.
-
- 20070903 release (0.1.7):
-
- Recent changes in the Lazarus LCL broke Orpheus compilation. This release
- can now be compiled.
- Recent improvements in the Lazarus Qt widgetset add basic functionality
- for several Orpheus controls (see table below). However, GTK2 widgetset
- does not work as well as it used to.
-
- 20070704 release (0.1.6):
-
- 3 new example programs have been added for demonstrating TOvcSpinner,
- TOvcSimpleField, TOvcTCSimpleField and TO32TCSimpleField. Note that the
- TestSimpField and TestTblEdits examples are intended primarily for
- Windows at this time since TOvcSimpleField and TOvcTCSimpleField are not
- yet working on other widgetsets (see table below).
- Fix improves functionality of TO32TCFlexEdit validation.
-
- 20070630 release (0.1.5):
-
- Most of the Orpheus controls now work with the Lazarus Carbon widgetset.
-
- 20070425 release (0.1.4):
-
- Recent changes to Lazarus LCL broke compilation of Orpheus. This
- release can now be compiled with the latest LCL.
-
- 20070401 release (0.1.3):
-
- Improvements to TO32FlexEdit on Windows.
-
- 20070317 note:
-
- Recent improvements in the Lazarus Carbon widgetset add basic functionality
- for several Orpheus controls on OS X (see table below).
-
- 20070211 note:
-
- Recent improvements in Lazarus fix display of custom cursor when
- sizing and moving columns and rows at runtime in TOvcTable.
-
- 20070204 release (0.1.2):
-
- Workarounds found for recent Lazarus changes that broke TOvcTable Columns
- and Rows editors.
- Workaround found for recent FPC 2.1.1 change that broke compilation of ovcvlb.pas.
-
- 20070128 release (0.1.1):
-
- An example program that demos the TO32FlexEdit control has been added
- even though validation doesn't work with LCL (see "To Do" list below).
- If you have Delphi you can compile the example to see how validation
- is supposed to work.
- Recent changes in Lazarus on Windows appear to have broken both the
- Columns and Rows design-time property editors for the TOvcTable control.
- The property editors still work with OS X. Stay tuned...
- Custom cursors are now visible when resizing table columns at runtime on
- Windows. However, cursor also disappears sometimes. Stay tuned on
- this one too...
-
- 20070127 note:
-
- Recent improvements in the Lazarus Qt widgetset make a couple of Orpheus controls
- work better with Qt.
-
- 20070115 note:
-
- 20070114 note:
-
- Controls have now been tested with GTK2 widgetset (see table below).
-
- 20070107 release (0.1.0):
-
- TOvcVirtualListBox control added.
- Installation no longer registers TOvcSimpleField and TOvcTCSimpleField
- controls (see myovcreg.pas) on non-Windows platforms since these two controls
- don't work on other platforms and crash Lazarus IDE if added to a form on
- those platforms.
-
-
-
-
-Introduction
-
-These notes describe the status of the OrphPort Project, an attempt to
-port a subset of TurboPower's Orpheus controls to Lazarus
-and Free Pascal . At this time,
-several enhanced label controls and most of the table (grid) controls
-have been ported. Some of the controls
-work quite well on multiple platforms; others need more work or
-await better support by the Lazarus LCL or by specific widgetsets before
-they are fully functional. The table below gives the status of individual
-controls. You are encouraged to work on improving these controls
-(see To Do list ). Please send your bug reports, suggestions
-and patches to:
-
- MacPgmr (at) fastermac (dot) net
-
-Note: You can also post to the "Ported from Delphi/Kylix" section of the Lazarus
-forum if you want your bug reports and suggestions to be seen by the entire
-Lazarus community.
-
-The ported source code is here: http://web.fastermac.net/~MacPgmr/OrphPort/downloads
-
-You can now also obtain the Orpheus ported source using Subversion:
-
-svn co https://lazarus-ccr.svn.sourceforge.net/svnroot/lazarus-ccr/components/orpheus [local_dir]
-
-The original Orpheus 4.06 source code that this port was based on is here:
-
-http://sourceforge.net/projects/tporpheus
-(although you don't need this for Lazarus)
-
-TurboPower's 1,392-page Orpheus User's Manual is also available from the Source Forge site.
-
-Note that the ported source remains under the original MPL 1.1 license.
-
-
-Installation
-
-
-Unzip the ported source files into their own folder.
- Start Lazarus.
- Optionally, choose File | New | Application to make sure Lazarus doesn't
-mess up the currently open project.
- Choose Package | Open package file and select orpheus.lpk.
- Click Compile to make sure your version of Lazarus can compile the
-Orpheus units.
- Click Install and click Yes when prompted to rebuild the Lazarus IDE.
- After rebuilding is finished, restart Lazarus if it didn't restart
-automatically. The installed Orpheus controls will be on the Orpheus tab
-of the component palette.
-
-
-Important! If you don't have write access to the folder where Lazarus
-is installed, you may have problems rebuilding the Lazarus IDE with older
-versions of Lazarus. However, if you have a relatively new version of Lazarus,
-it will compile itself to the ~/.lazarus/bin folder if you don't have write
-access to the Lazarus install folder. After rebuilding, be sure to start
-~/.lazarus/bin/lazarus, not the installed Lazarus.
-
-
-Platforms Tested
-
-
-
-
-Platform
-OS Version
-Library Versions
-Widgetsets Tested
-Lazarus Version Tested
-
-
-
-Windows
-XP SP2
-
-win32
-0.9.28 RC with FPC 2.2.4
-
-
-
-OS X
-10.4.11 (Tiger) on PowerPC
-gtk: 1.2.0.9.1 gtk2: 2.14.7 qt: 4.5.2
-gtk, gtk2, carbon, qt
-0.9.28 RC with FPC 2.2.4
-
-
-
-OS X
-10.5.8 (Leopard) on Intel
-
-carbon
-0.9.28 RC with FPC 2.2.4
-
-
-
-Linux
---not tested--
-
-
-
-
-
-
-
-
-Examples
-
-The source for several small test applications is included which demonstrates
-most of the ported controls. Open each test app's .lpi file and compile it once
-Orpheus has been installed in Lazarus. Folders for the test apps are located
-in the tests folder in your Orpheus folder, as follows:
-
-TestTable - demos TOvcTable and various table cell controls (column
-headers, row labels, string, memo, check box, combo box, bitmap).
- TestURL - demos TOvcURL
- TestRLbl - demos TOvcRotatedLabel
- TestLabel - demos TOvcLabel
- TestVLB - demos TOvcVirtualListBox
- TestSpinner - demos TOvcSpinner
- TestFlexEdit - demos TO32FlexEdit validation
- TestSimpField - demos TOvcSimpleField validation (Windows only for now)
- TestTblEdits - demos TOvcTCString, TOvcTCSimpleField validation and TO32TCFlexEdit
-validation (Windows only for now)
- TestCalendar - demos TOvcCalendar
-
-
-To see the TOvcSpinner control in action, try out the table's Rows and Columns
-property editors with the TestTable app.
-
-Note: The TestTable app uses the included .bmp files to demo the
-TOvcTCBitMap control. These bitmap files are not needed to rebuild the Lazarus
-IDE since they're in the ovcreg.lrs resource file, but they are
-included for completeness.
-
-Tip: The necessary files for compiling the test apps with Delphi are
-also included (.dof, .dfm, .bdsproj). If you have Delphi you can compile
-the apps to see exactly how the Orpheus controls are supposed to look and
-behave. Note that with the free Turbo Delphi Explorer you can't install
-Orpheus (a limitation of the free version). However, you can still compile
-the test apps, as follows:
-
-Start Turbo Delphi Explorer and open the test app's .bdsproj file.
- Click Ignore All to proceed when Delphi encounters the unrecognized
-Orpheus controls.
- Choose File | Close and click Cancel to close the main form.
- Choose Project | Options and make sure the Search path in
-Directories/Conditionals points to your Orpheus folder.
- Choose Project | Compile to compile the test app.
-
-
-
-Porting Philosophy
-
-
-All changes to the original source code were made via conditional
-compiling (IFDEF's). Thus the ported source retains full Delphi compatibility.
-An added benefit is that you can see what the original code was, something
-that is often lost with ported code.
- A compatibility unit, MyMisc , was added to fill in gaps in the
-Lazarus LCL and provide other compatibility routines.
- Orpheus functions written in assembly were "Pascal-ized" so the ported code could
-be compiled on non-Intel platforms.
- For now, the Lazarus package (orpheus.lpk) compiles the source with range,
-overflow and stack checking turned on. This revealed several apparently harmless
-bugs in the TurboPower code, which have been fixed. To find these and other
-minor bugs, grep the source for "TurboPower bug".
- In general, no other significant changes or "improvements" were made to
-the source. An exception is the o32tcflx unit, where a few additions were
-made to correct apparent omissions or inconsistencies.
- A note on comments: Comments added to the ported source are generally
-marked with "//". However, the "o32" units (developed later than other units
-by TurboPower) already included some "//" comments. With these units, you can
-tell the added comments by their context (near IFDEF's, for example).
-
-
-
-Usage Notes
-
-
-When you first add an Orpheus control to a form, Lazarus will add
-the Orpheus unit to the uses section of your main source file (.lpr).
-This pulls in a great deal of code that you don't need. Delete the Orpheus unit
-from the uses section to reduce the size of your executable file.
-<==Fixed in 0.2.2 release.
-
The TOvcSimpleField and TOvcTCSimpleField controls originally did not work
-at all on non-Windows widgetsets, although they now have some functionality.
-For now, don't use these controls in cross-platform applications. Just opening
-a form that has a TOvcSimpleField or TOvcTCSimpleField control on it may crash
-non-Windows versions of Lazarus. Use the TO32FlexEdit and TO32TCFlexEdit
-controls in place of TOvcSimpleField and TOvcTCSimpleField controls in
-cross-platform applications.
-
To display the TOvcLabel's Style Manager property editor in the Lazarus
-IDE, right-click on the TOvcLabel control (Apple key+click on Mac). You can
-also change Style Manager properties via the CustomSettings in the
-Object Inspector. Also, with GTK, the default clNone Color displays a black
-background, so be sure to set ParentColor to True or select a different
-Color.
-
An added benefit of the Orpheus TOvcSpinner control is that it is
-available for Delphi too, unlike the LCL TSpinEdit, which has no equivalent
-in the Delphi VCL.
-
-
-
-Limitations
-
-
-The TO32FlexEdit and TO32TCFlexEdit controls include code for displaying
-an optional button within the text editing area. However, this TBitBtn-within-
-a-TEdit has not been supported by the LCL, so the code has been IFDEF'd out for
-now. Beginning with Lazarus 0.9.27, this code appears to work okay with the win32
-and carbon widgetsets. To enable the button code, see the comments above the
-ButtonOkay define in o32flxed.pas.
-
Widgetsets generally implement LCL controls by creating native controls
-that correspond to the LCL controls (text edit, check box, etc.). However,
-Orpheus builds its TOvcSimpleField control from TCustomControl, rather than
-descending from an existing edit control such as TCustomEdit. In general,
-TOvcSimpleField and TOvcTCSimpleField have not worked very well on non-Windows
-widgetsets.
-
The GTK widgetset does not support TOvcRotatedLabel, apparently
-because the GetTextMetrics function is not fully implemented on that
-widgetset.
-
The Carbon widgetset has a few minor limitations as of Lazarus 0.9.26 that
-affect some of the Orpheus controls. Setting the BorderStyle property does
-nothing with Carbon in custom controls such as TOvcVirtualListBox, TOvcCalendar
-and TOvcTable. Also, since the Carbon widgetset does not implement the bvLowered
-bevel style, changing the focus of a TOvcCalendar control does not change
-the look of the currently selected date as it should (the date remains bvRaised,
-which actually looks lowered with the Carbon widgetset).
-
Differences between Delphi VCL and Lazarus LCL affect some Orpheus controls.
-For example, VCL messages like CM_ENTER and CM_EXIT are not supported in the
-LCL. In a couple places, the ported code uses LM_SETFOCUS and LM_KILLFOCUS
-messages to obtain some functionality. Similarly, the lack of LCL support for the
-CM_CTL3DCHANGED message means that changing the Ctl3D property in Lazarus for
-controls such as TOvcCalendar may not update the control's design (reloading the
-form will show the correct design). Finally, some properties are True
-by default in Delphi but False in Lazarus, meaning forms converted from Delphi
-may not look quite the same for properties with default values until you
-explicitly set the properties in Lazarus or in your code.
-
-
-
-Status of Individual Controls
-
-
-
-
-Control
-VCL / LCL ancestor
-Description
-Issues / To-do
-win32
-gtk
-gtk2
-carbon
-qt
-
-
-
-TOvcRotatedLabel
-TGraphicControl
-Rotated text
-gtk widgetset doesn't support
-Working
-Not working
-Partial
-Working
-Working
-
-
-
-TOvcLabel
-TGraphicControl
-Fancy shading, color and highlighting
-Property editor still needs work
-Working
-Working
-Working
-Working
-Working
-
-
-
-TOvcURL
-TCustomLabel
-Looks and acts like HTML hyperlink
-
-Working
-Working
-Working
-Working
-Partial
-
-
-
-TOvcSpinner
-TCustomControl
-Can associate with a TEdit; 8 different styles
-
-Working
-Working
-Working
-Working
-Crashes
-
-
-
-TOvcVirtualListBox
-TCustomControl
-Header row, variable width tabs, huge number of rows
-
-Working
-Working
-Working
-Working
-Partial
-
-
-
-TOvcCalendar
-TCustomControl
-Calendar control
-
-Working
-Working
-Working
-Working
-Partial
-
-
-
-TOvcSimpleField
-TCustomControl
-Edit control with validation
-
-Working
-Partial
-Partial
-Partial
-Partial
-
-
-
-TO32FlexEdit
-TCustomEdit
-Edit control with validation
-gtk and qt used to work better
-Working
-Partial
-Working
-Working
-Partial
-
-
-
-TOvcTable
-TCustomControl
-Full-featured grid control
-See "To Do" list; 0.9.26 didn't crash
-Working
-Crashes
-Crashes
-Partial
-Freezes
-
-
-
-TOvcTCColHead
-TComponent
-Table column headings
-
-Working
-Working
-Working
-Working
-Working
-
-
-
-TOvcTCRowHead
-TComponent
-Table row headings
-
-Working
-Working
-Working
-Working
-Working
-
-
-
-TOvcTCString
-TComponent (edits with TEdit)
-Table cell for editing strings
-
-Working
-Working
-Working
-Working
-Partial
-
-
-
-TOvcTCSimpleField
-TComponent (edits with TOvcSimpleField)
-Table cell for editing strings, with validation
-
-Working
-Partial
-Partial
-Partial
-Partial
-
-
-
-TOvcTCMemo
-TComponent (edits with TMemo)
-Table cell for editing memo text
-
-Working
-Working
-Working
-Working
-Partial
-
-
-
-TOvcTCCheckBox
-TComponent (edits with TCustomControl)
-Table cell for check box
-
-Working
-Working
-Working
-Working
-Partial
-
-
-
-TOvcTCComboBox
-TComponent (edits with TComboBox)
-Table cell for combo box
-Dropdown problem w/o XP manifest
-Working
-Not working
-Not working
-Working
-Partial
-
-
-
-TOvcTCBitmap
-TComponent
-Table cell for displaying bitmap
-
-Working
-Working
-Working
-Not working
-Partial
-
-
-
-TOvcTCGlyph
-TComponent
-Table cell for cycling thru glyphs
-
-Working?
-Working?
-Working?
-?
-?
-
-
-
-TOvcTCIcon
-TComponent
-Table cell for displaying icon
-
-Working?
-Working?
-Working?
-?
-?
-
-
-
-TO32TCFlexEdit
-TComponent (edits with TO32FlexEdit)
-Table cell for editing strings, with validation
-
-Working
-Working
-Working
-Working
-Partial
-
-
-
-TOvcController
-TComponent
-Key-to-command translator
-Property editor uses TTabSet
-?
-?
-?
-?
-?
-
-
-
-
-
-Notes:
-(1) "Working" means control is basically functional. "Partial" means
-control compiles, installs in IDE and displays at run-time, but doesn't function
-correctly. "Not working" means control compiles and installs in IDE but
-doesn't display correctly. "Widgetset doesn't support" means the widgetset
-currently does not provide the support needed for the control.
-(2) TOvcSimpleField and TOvcTable require a TOvcController on form.
-However, TO32FlexEdit doesn't need TOvcController.
-
-
-To Do
-
-TOvcLabel
-
- Figure out why TOvcColorComboBox controls in Style Manager property editor
- don't work on Windows.
- Figure out why Color's default value (clNone) displays black
- background with GTK. Workaround for now is to set TOvcLabel's
- ParentColor to True in Object Inspector or select a different Color.
-
- TOvcVirtualListBox
-
- Fix scrolling problems on Windows (not repainted right) and other platforms
- (scrolls too many with each click of arrow). <==Fixed in 0.2.0 release.
- Figure out why double-click doesn't work on GTK. <==Fixed.
-
- TO32FlexEdit
-
- Figure out why, on Windows, presence of XP manifest prevents setting Text.
- <==Appears to be fixed with 20070401 Lazarus.
- Come up with workaround for LCL's lack of MakeObjectInstance for making
- callback function from method. Without this, control's validation is not
- performed. <==Workaround in 0.1.3 release fixes this on win32 widgetset.
- <==Partial workaround in 0.2.0 release for other widgetsets is to call
- SendMessage(TO32FlexEdit(Sender).Handle, OM_VALIDATE, 0, 0); in OnExit handler.
- See TestFlexEdit example.
- Can't tab out of control on Windows with win32 widgetset (tabbing works
- with qt widgetset on Windows though). <==Fixed in 0.1.3 release.
-
- TOvcTable
-
- Custom cursors not visible when sizing and moving columns and rows.
- Determine whether this is an LCL limitation. <==Recently fixed in
- Lazarus for Windows.
- Sizing and moving columns and rows doesn't work at all with GTK or Carbon.
- Determine whether this is a GTK/Carbon limitation.
- Table scroll bar "thumb" extends entire length of scrollbar with GTK.
- <==Fixed in 0.2.0 release.
- Figure out how to move edit cell to stay with its row when scrolling
- table (non-Windows only).
- Figure out why scrolling table with keyboard doesn't repaint table with Carbon.
- Possibly related to TestTable issue with Carbon where selecting a .bmp in the
- combo box cell doesn't display the bitmap in the next column until form is resized.
-
- TOvcTCComboBox
-
- Figure out why, on Windows, won't drop down without presence of
- XP manifest.
-
- TO32TCFlexEdit
-
- Need a way of setting OnValidationError handler (an apparent omission
- since TO32FlexEdit has it). <==Workaround in 0.2.0 release is to
- set TO32TCFlexEditEditor(Sender).OnValidationError in UserValidation handler.
-
- TOvcSimpleField and TOvcTCSimpleField
-
- Recent improvements in GTK and Carbon widgetsets mean these controls no
- longer crash programs when they're used. However, they don't yet work as edit
- controls. Determine whether this means more improvement in widgetsets is needed.
- (Use TO32FlexEdit and TO32TCFlexExit in the meantime.)
-
- TOvcTCBitMap
-
- This previously worked, but changes to Lazarus LCL now cause it to crash
- when cell gets focus (win32 only). <==Fixed in 0.2.0 release.
-
- TOvcController
-
- Rewrite ovccmdp0.pas property editor to use TTabControl instead of
- TTabSet (not part of LCL).
-
-
-
-
-Other Resources
-
-Status of Lazarus widgetsets:
-http://wiki.lazarus.freepascal.org/Roadmap
-
-OS X tips for Lazarus:
-http://wiki.lazarus.freepascal.org/OS_X_Programming_Tips
-
-
-
-Last updated: Sept. 21, 2009
-
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/d4/d471c3f047e55f643a31e8fb46b896d6e622d4bf.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/d4/d471c3f047e55f643a31e8fb46b896d6e622d4bf.svn-base
deleted file mode 100644
index 20f540dd..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/pristine/d4/d471c3f047e55f643a31e8fb46b896d6e622d4bf.svn-base and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/d5/d5452651fe661e91eb9a77097ec4c7ba579efacf.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/d5/d5452651fe661e91eb9a77097ec4c7ba579efacf.svn-base
deleted file mode 100644
index 59f4de7d..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/d5/d5452651fe661e91eb9a77097ec4c7ba579efacf.svn-base
+++ /dev/null
@@ -1,67 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls, ovcbase, ovcdata, ovcef, ovcsf;
-
-type
- TForm1 = class(TForm)
- Label1: TLabel;
- OvcSimpleField1: TOvcSimpleField;
- Label2: TLabel;
- OvcSimpleField2: TOvcSimpleField;
- procedure OvcSimpleField1UserValidation(Sender: TObject;
- var ErrorCode: Word);
- procedure OvcSimpleFieldError(Sender: TObject; ErrorCode: Word;
- ErrorMsg: String);
- procedure OvcSimpleField2UserValidation(Sender: TObject;
- var ErrorCode: Word);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.dfm}
-{$ENDIF}
-
-
-procedure TForm1.OvcSimpleField1UserValidation(Sender: TObject;
- var ErrorCode: Word);
-begin
- ErrorCode := 0;
- if (TOvcSimpleField(Sender).Text <> '') and
- (StrToIntDef(TOvcSimpleField(Sender).Text, 0) <= 0) then
- ErrorCode := oeInvalidNumber;
-end;
-
-procedure TForm1.OvcSimpleFieldError(Sender: TObject; ErrorCode: Word;
- ErrorMsg: String);
-begin
- MessageDlg(ErrorMsg + #13#10 + 'Press Ctrl+Z to undo.', mtError, [mbOK], 0);
-end;
-
-procedure TForm1.OvcSimpleField2UserValidation(Sender: TObject;
- var ErrorCode: Word);
-begin
- ErrorCode := 0;
- if (TOvcSimpleField(Sender).Text <> '') and
- (StrToFloatDef(TOvcSimpleField(Sender).Text, 0) <= 0) then
- ErrorCode := oeInvalidNumber;
-end;
-
-initialization
-{$IFDEF LCL}
-{$I unit1.lrs} {Include form's resource file}
-{$ENDIF}
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/d5/d546ab1fffa59061a30f7c1464bf9db7ebe5bb9d.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/d5/d546ab1fffa59061a30f7c1464bf9db7ebe5bb9d.svn-base
deleted file mode 100644
index a79b3793..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/d5/d546ab1fffa59061a30f7c1464bf9db7ebe5bb9d.svn-base
+++ /dev/null
@@ -1,2758 +0,0 @@
-{*********************************************************}
-{* OVCBASE.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}
-
-{$IFNDEF VERSION3}
-!! Error - not for Delphi versions 1 and 2 or C++ Builder version 1
-{$ENDIF}
-
-{$IFNDEF LCL}
-{$R OVCBASE.RES}
-{$ENDIF}
-
-unit ovcbase;
- {-Base unit for Orpheus visual components}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, MyMisc, {$ENDIF}
- Classes, Controls, Dialogs, Forms, StdCtrls, SysUtils,
- OvcCmd, OvcData, OvcMisc, OvcConst, OvcExcpt, {$IFNDEF LCL} OvcTimer, {$ENDIF} OvcDate;
-
-type
- TOvcLabelPosition = (lpTopLeft, lpBottomLeft); {attached label types}
-
- TOvcAttachEvent = procedure(Sender : TObject; Value : Boolean)
- of object;
-
- TOvcAttachedLabel = class(TLabel)
- protected {private}
- FControl : TWinControl;
-
- protected
- procedure SavePosition;
- procedure Loaded;
- override;
-
- public
- constructor Create(AOwner : TComponent);
- override;
- constructor CreateEx(AOwner : TComponent; AControl : TWinControl);
- virtual;
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
- override;
-
- published
- property Control : TWinControl
- read FControl write FControl;
- end;
-
- TO32ContainerList = class(TList)
- FOwner: TComponent;
- public
- constructor Create(AOwner: TComponent); virtual;
- destructor Destroy; override;
- end;
-
- TOvcLabelInfo = class(TPersistent)
- protected {private}
- {property variables}
- FOffsetX : Integer;
- FOffsetY : Integer;
-
- {event variables}
- FOnChange : TNotifyEvent;
- FOnAttach : TOvcAttachEvent;
-
- {internal methods}
- procedure DoOnAttach;
- procedure DoOnChange;
- function IsVisible : Boolean;
-
- {property methods}
- procedure SetOffsetX(Value : Integer);
- procedure SetOffsetY(Value : Integer);
- procedure SetVisible(Value : Boolean);
-
- public
- ALabel : TOvcAttachedLabel;
- FVisible : Boolean;
-
- property OnAttach : TOvcAttachEvent
- read FOnAttach write FOnAttach;
- property OnChange : TNotifyEvent
- read FOnChange write FOnChange;
-
- procedure SetOffsets(X, Y : Integer);
-
- published
- property OffsetX: Integer
- read FOffsetX write SetOffsetX stored IsVisible;
- property OffsetY: Integer
- read FOffsetY write SetOffsetY stored IsVisible;
- property Visible : Boolean
- read FVisible write SetVisible
- default False;
- end;
-
- {event method types}
- TMouseWheelEvent = procedure(Sender : TObject; Shift : TShiftState;
- Delta, XPos, YPos : Word) of object;
-
- TDataErrorEvent =
- procedure(Sender : TObject; ErrorCode : Word; const ErrorMsg : string)
- of object;
- TPostEditEvent =
- procedure(Sender : TObject; GainingControl : TWinControl)
- of object;
- TPreEditEvent =
- procedure(Sender : TObject; LosingControl : TWinControl)
- of object;
- TDelayNotifyEvent =
- procedure(Sender : TObject; NotifyCode : Word)
- of object;
- TIsSpecialControlEvent =
- procedure(Sender : TObject; Control : TWinControl;
- var Special : Boolean)
- of object;
- TGetEpochEvent =
- procedure (Sender : TObject; var Epoch : Integer)
- of object;
-
- {options which will be the same for all fields attached to the same controller}
- TOvcBaseEFOption = (
- efoAutoAdvanceChar,
- efoAutoAdvanceLeftRight,
- efoAutoAdvanceUpDown,
- efoAutoSelect,
- efoBeepOnError,
- efoInsertPushes);
- TOvcBaseEFOptions = set of TOvcBaseEFOption;
-
-type
- TOvcCollectionStreamer = class;
- TOvcCollection = class;
- TO32Collection = class;
-
- {implements the About property and collection streaming}
- TOvcComponent = class(TComponent)
- protected {private}
- FCollectionStreamer : TOvcCollectionStreamer;
- FInternal : Boolean; {flag to suppress name generation
- on collection items}
- function GetAbout : string;
- procedure SetAbout(const Value : string);
-
- protected
- {OrCollection streaming hooks:}
- procedure GetChildren(Proc: TGetChildProc; Root : TComponent); override;
- function GetChildOwner: TComponent; override;
- procedure Loaded; override;
-
- public
- constructor Create(AOwner: TComponent);
- override;
- destructor Destroy;
- override;
-
- property CollectionStreamer : TOvcCollectionStreamer
- read FCollectionStreamer
- write FCollectionStreamer;
- property Internal : Boolean read FInternal write FInternal;
- published
- {properties}
- property About : string
- read GetAbout
- write SetAbout
- stored False;
- end;
-
- {implements the About property}
- TO32Component = class(TComponent)
- protected {private}
- FInternal : Boolean; {flag to suppress name generation
- on collection items}
- function GetAbout : string;
- procedure SetAbout(const Value : string);
- public
- constructor Create(AOwner: TComponent); override;
- property Internal : Boolean read FInternal write FInternal;
- published
- {properties}
- property About : string read GetAbout write SetAbout stored False;
- end;
-
- TOvcController = class(TOvcComponent)
- protected {private}
- FBaseEFOptions : TOvcBaseEFOptions; {options common to all entry fields}
- FEntryCommands : TOvcCommandProcessor; {command processor}
- FEpoch : Integer; {combined epoch year and century}
- FErrorPending : Boolean; {an error is pending for an ef}
- FErrorText : string; {text of last error}
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
- FHandle : TOvcHWnd{hWnd}; {our window handle}
-
- FInsertMode : Boolean; {global insert mode flag}
-{$IFNDEF LCL} //Currently not implemented
- FTimerPool : TOvcTimerPool; {general timer pool}
-{$ENDIF}
-
- {events}
- FOnDelayNotify : TDelayNotifyEvent;
- FOnError : TDataErrorEvent;
- FOnGetEpoch : TGetEpochEvent;
- FOnIsSpecialControl : TIsSpecialControlEvent;
- FOnPostEdit : TPostEditEvent;
- FOnPreEdit : TPreEditEvent;
-{$IFNDEF LCL}
- FOnTimerTrigger : TTriggerEvent;
-{$ENDIF}
-
- {property methods}
- function GetEpoch : Integer;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
- function GetHandle : TOvcHWnd{hWnd};
- procedure SetEpoch(Value : Integer);
-
- {internal methods}
- procedure cWndProc(var Msg : TMessage);
- {-window procedure}
-
- public
- constructor Create(AOwner: TComponent);
- override;
- destructor Destroy;
- override;
-
- procedure DestroyHandle;
-
-{$IFDEF LCL}
- function PostMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL;
-{$ENDIF}
- {wrappers for event handlers}
- procedure DoOnPostEdit(Sender : TObject; GainingControl : TWinControl);
- {-call the method assigned to the OnPostEdit event}
- procedure DoOnPreEdit(Sender : TObject; LosingControl : TWinControl);
- {-call the method assigned to the OnPreEdit event}
- procedure DoOnTimerTrigger(Sender : TObject; Handle : Integer;
- Interval : Cardinal; ElapsedTime : LongInt);
-
- procedure DelayNotify(Sender : TObject; NotifyCode : Word);
- {-start the chain of events that will fire the OnDelayNotify event}
- procedure DoOnError(Sender : TObject; ErrorCode : Word; const ErrorMsg : string);
- {-call the method assigned to the OnError event}
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
- function IsSpecialButton(H : TOvcHWnd{hWnd}) : Boolean;
- dynamic;
- {-return true if H is btnCancel, btnHelp, or btnRestore}
- procedure MarkAsUninitialized(Uninitialized : Boolean);
- {-mark all entry fields on form as uninitialized}
- function ValidateEntryFields : TComponent;
- {-ask each entry field to validate its contents. Return nil
- if no error, else return pointer to field with error}
- function ValidateEntryFieldsEx(ReportError, ChangeFocus : Boolean) : TComponent;
- {-ask each entry field to validate its contents. Return nil
- if no error, else return pointer to field with error.
- Conditionally move focus and report error}
- function ValidateTheseEntryFields(const Fields : array of TComponent) : TComponent;
- {-ask the specified entry fields to validate their contents. Return nil
- if no error, else return pointer to field with error}
-
- property ErrorPending : Boolean
- read FErrorPending write FErrorPending;
- property ErrorText : string
- read FErrorText write FErrorText;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
- property Handle : TOvcHWnd{hWnd}
- read GetHandle;
- property InsertMode : Boolean
- read FInsertMode write FInsertMode;
-{$IFNDEF LCL}
- property TimerPool : TOvcTimerPool
- read FTimerPool;
-{$ENDIF}
-
- published
- {properties}
- property EntryCommands : TOvcCommandProcessor
- read FEntryCommands write FEntryCommands stored True;
- property EntryOptions : TOvcBaseEFOptions
- read FBaseEFOptions write FBaseEFOptions
- default [efoAutoSelect, efoBeepOnError, efoInsertPushes];
- property Epoch : Integer
- read GetEpoch write SetEpoch;
-
- {events}
- property OnError : TDataErrorEvent
- read FOnError write FOnError;
- property OnGetEpoch : TGetEpochEvent
- read FOnGetEpoch write FOnGetEpoch;
- property OnDelayNotify : TDelayNotifyEvent
- read FOnDelayNotify write FOnDelayNotify;
- property OnIsSpecialControl : TIsSpecialControlEvent
- read FOnIsSpecialControl write FOnIsSpecialControl;
- property OnPostEdit : TPostEditEvent
- read FOnPostEdit write FOnPostEdit;
- property OnPreEdit : TPreEditEvent
- read FOnPreEdit write FOnPreEdit;
-{$IFNDEF LCL}
- property OnTimerTrigger : TTriggerEvent
- read FOnTimerTrigger write FOnTimerTrigger;
-{$ENDIF}
- end;
-
- TOvcGraphicControl = class(TGraphicControl)
- protected {private}
- FCollectionStreamer : TOvcCollectionStreamer;
- {property methods}
- function GetAbout : string;
- procedure SetAbout(const Value : string);
- protected
- {Collection streaming hooks:}
- procedure GetChildren(Proc: TGetChildProc; Root : TComponent); override;
- function GetChildOwner: TComponent; override;
- procedure Loaded; override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- property CollectionStreamer : TOvcCollectionStreamer
- read FCollectionStreamer write FCollectionStreamer;
- published
- property About : string
- read GetAbout write SetAbout stored False;
- end;
-
- {Replacement for the TOvcCustomControl except with standard VCL streaming}
- TO32CustomControl = class(TCustomControl)
- protected {private}
- {property variables}
- FAfterEnter : TNotifyEvent;
- FAfterExit : TNotifyEvent;
- FOnMouseWheel : TMouseWheelEvent;
- FLabelInfo : TOvcLabelInfo;
- FInternal : Boolean; {flag to suppress name generation
- on collection items}
-
- {property methods}
- function GetAttachedLabel : TOvcAttachedLabel;
- function GetAbout : string;
- procedure SetAbout(const Value : string);
-
- {internal methods}
- procedure LabelAttach(Sender : TObject; Value : Boolean);
- procedure LabelChange(Sender : TObject);
- procedure PositionLabel;
-
- {private message methods}
- procedure OMAssignLabel(var Msg : TMessage);
- message OM_ASSIGNLABEL;
- procedure OMPositionLabel(var Msg : TMessage);
- message OM_POSITIONLABEL;
- procedure OMRecordLabelPosition(var Msg : TMessage);
- message OM_RECORDLABELPOSITION;
- procedure OMAfterEnter(var Msg : TMessage);
- message OM_AFTERENTER;
- procedure OMAfterExit(var Msg : TMessage);
- message OM_AFTEREXIT;
-
- {VCL message methods}
- procedure CMVisibleChanged(var Msg : TMessage);
- message CM_VISIBLECHANGED;
-
- {windows message methods}
- procedure WMKillFocus(var Msg : TWMKillFocus);
- message WM_KILLFOCUS;
- procedure WMMouseWheel(var Msg : TMessage);
- message WM_MOUSEWHEEL;
- procedure WMSetFocus(var Msg : TWMSetFocus);
- message WM_SETFOCUS;
-
- protected
- DefaultLabelPosition : TOvcLabelPosition;
-
- procedure DoOnMouseWheel(Shift : TShiftState;
- Delta, XPos, YPos : SmallInt);
- dynamic;
- procedure CreateWnd;
- override;
- procedure Notification(AComponent : TComponent; Operation : TOperation);
- override;
-
- property AfterEnter : TNotifyEvent
- read FAfterEnter write FAfterEnter;
- property AfterExit : TNotifyEvent
- read FAfterExit write FAfterExit;
- property OnMouseWheel : TMouseWheelEvent
- read FOnMouseWheel write FOnMouseWheel;
- property LabelInfo : TOvcLabelInfo
- read FLabelInfo write FLabelInfo;
-
- public
- property Internal : Boolean read FInternal write FInternal;
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
- override;
- property AttachedLabel : TOvcAttachedLabel
- read GetAttachedLabel;
-
- published
- property About : string
- read GetAbout write SetAbout stored False;
- end;
- {End - TO32CustomControl}
-
-
- TOvcCustomControl = class(TCustomControl)
- protected {private}
- {property variables}
- FAfterEnter : TNotifyEvent;
- FAfterExit : TNotifyEvent;
- FCollectionStreamer : TOvcCollectionStreamer;
- FOnMouseWheel : TMouseWheelEvent;
- FLabelInfo : TOvcLabelInfo;
- FInternal : Boolean; {flag to suppress name generation
- on collection items}
-
- {property methods}
- function GetAttachedLabel : TOvcAttachedLabel;
- function GetAbout : string;
- procedure SetAbout(const Value : string);
-
- {internal methods}
- procedure LabelAttach(Sender : TObject; Value : Boolean);
- procedure LabelChange(Sender : TObject);
- procedure PositionLabel;
-
- {private message methods}
- procedure OMAssignLabel(var Msg : TMessage);
- message OM_ASSIGNLABEL;
- procedure OMPositionLabel(var Msg : TMessage);
- message OM_POSITIONLABEL;
- procedure OMRecordLabelPosition(var Msg : TMessage);
- message OM_RECORDLABELPOSITION;
- procedure OMAfterEnter(var Msg : TMessage);
- message OM_AFTERENTER;
- procedure OMAfterExit(var Msg : TMessage);
- message OM_AFTEREXIT;
-
- {VCL message methods}
- procedure CMVisibleChanged(var Msg : TMessage);
- message CM_VISIBLECHANGED;
-
- {windows message methods}
- procedure WMKillFocus(var Msg : TWMKillFocus);
- message WM_KILLFOCUS;
- procedure WMMouseWheel(var Msg : TMessage);
- message WM_MOUSEWHEEL;
- procedure WMSetFocus(var Msg : TWMSetFocus);
- message WM_SETFOCUS;
-
- protected
- {descendants can set the value of this variable after calling inherited }
- {create to set the default location and point-of-reference (POR) for the}
- {attached label. if dlpTopLeft, the default location and POR will be at }
- {the top left of the control. if dlpBottomLeft, the default location and}
- {POR will be at the bottom left}
- DefaultLabelPosition : TOvcLabelPosition;
-
- procedure DoOnMouseWheel(Shift : TShiftState;
- Delta, XPos, YPos : SmallInt);
- dynamic;
- procedure CreateWnd;
- override;
- procedure Notification(AComponent : TComponent; Operation : TOperation);
- override;
-
- {Collection streaming hooks:}
- procedure GetChildren(Proc: TGetChildProc; Root : TComponent); override;
- function GetChildOwner: TComponent; override;
- procedure Loaded; override;
-
- property AfterEnter : TNotifyEvent
- read FAfterEnter write FAfterEnter;
- property AfterExit : TNotifyEvent
- read FAfterExit write FAfterExit;
- property OnMouseWheel : TMouseWheelEvent
- read FOnMouseWheel write FOnMouseWheel;
- property LabelInfo : TOvcLabelInfo
- read FLabelInfo write FLabelInfo;
-
- public
- property Internal : Boolean read FInternal write FInternal;
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
- override;
- property AttachedLabel : TOvcAttachedLabel
- read GetAttachedLabel;
- property CollectionStreamer : TOvcCollectionStreamer
- read FCollectionStreamer write FCollectionStreamer;
-
- published
- property About : string
- read GetAbout write SetAbout stored False;
- end;
-
- TOvcCollectible = class(TOvcComponent)
- protected {private}
- FCollection : TOvcCollection;
- InChanged : Boolean;
-
- function GetIndex : Integer;
- procedure SetCollection(Value : TOvcCollection);
- procedure SetIndex(Value : Integer); virtual;
-
- protected
- procedure Changed; dynamic;
- function GenerateName : string;
- dynamic;
- function GetBaseName : string;
- dynamic;
- function GetDisplayText : string;
- virtual;
- procedure SetName(const NewName : TComponentName);
- override;
-
- public
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
- property Collection : TOvcCollection
- read FCollection;
- property DisplayText : string
- read GetDisplayText;
- property Index : Integer
- read GetIndex
- write SetIndex;
-
- property Name;
- end;
-
- TO32CollectionItem = class(TCollectionItem)
- protected {private}
- FName: String;
- FDisplayText: String;
- function GetAbout: String;
- procedure SetAbout(const Value: String);
- procedure SetName(Value: String); virtual;
- public
- property DisplayText : string read FDisplayText write FDisplayText;
- property Name: String read FName write SetName;
- published
- property About : String read GetAbout write SetAbout;
- end;
-
-
- TOvcCollectibleControl = class(TOvcCustomControl)
- protected {private}
- FCollection : TOvcCollection;
- FInternal : Boolean; {flag to suppress name generation
- on collection items}
- InChanged : Boolean;
-
- function GetIndex : Integer;
- procedure SetCollection(Value : TOvcCollection);
- procedure SetIndex(Value : Integer);
-
- protected
- procedure Changed; dynamic;
- function GenerateName : string;
- dynamic;
- function GetBaseName : string;
- dynamic;
- function GetDisplayText : string;
- virtual;
- procedure SetName(const NewName : TComponentName);
- override;
-
- public
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
-
- property Internal : Boolean read FInternal write FInternal;
-
- property Collection : TOvcCollection
- read FCollection;
-
- property DisplayText : string
- read GetDisplayText;
-
- property Index : Integer
- read GetIndex
- write SetIndex;
-
- property Name;
- end;
-
- TOvcCollectibleClass = class of TComponent;
- TO32CollectibleClass = class of TPersistent;
-
- TOvcItemSelectedEvent =
- procedure(Sender : TObject; Index : Integer) of object;
- TOvcGetEditorCaption =
- procedure(var Caption : string) of object;
- TO32GetEditorCaption =
- procedure(var Caption : string) of object;
-
- TOvcCollection = class(TPersistent)
- protected {private}
- {property variables}
- FItemClass : TOvcCollectibleClass;
- FItemEditor : TForm;
- FItems : TList;
- FOwner : TComponent;
- FReadOnly : Boolean;
- FStored : Boolean;
- FStreamer : TOvcCollectionStreamer;
-
- {event variables}
- FOnChanged : TNotifyEvent;
- FOnItemSelected : TOvcItemSelectedEvent;
- FOnGetEditorCaption : TOvcGetEditorCaption;
-
- {Internal variables}
- InLoaded : Boolean;
- IsLoaded : Boolean;
- InChanged : Boolean;
-
- protected
- function GetCount : Integer;
- function GetItem(Index: Integer): TComponent;
- procedure SetItem(Index: Integer; Value: TComponent);
-
- procedure Changed;
- virtual;
- procedure Loaded;
-
- public
- constructor Create(AOwner : TComponent; ItemClass : TOvcCollectibleClass);
- destructor Destroy;
- override;
- property ItemEditor : TForm
- read FItemEditor write FItemEditor;
-
- function Add : TComponent;
- procedure Clear; virtual;
- procedure Delete(Index : Integer);
- procedure DoOnItemSelected(Index : Integer);
- function GetEditorCaption : string;
- function ItemByName(const Name : string) : TComponent;
- function Insert(Index : Integer) : TComponent;
- function ParentForm : TForm;
-
- property Count: Integer
- read GetCount;
- property ItemClass : TOvcCollectibleClass
- read FItemClass;
- property Item[Index: Integer] : TComponent
- read GetItem write SetItem; default;
- property OnGetEditorCaption : TOvcGetEditorCaption
- read FOnGetEditorCaption write FOnGetEditorCaption;
- property Owner : TComponent
- read FOwner;
- property ReadOnly : Boolean
- read FReadOnly write FReadOnly default False;
- property Stored : Boolean
- read FStored write FStored default True;
- property OnChanged : TNotifyEvent
- read FOnChanged write FOnChanged;
- property OnItemSelected : TOvcItemSelectedEvent
- read FOnItemSelected write FOnItemSelected;
- end;
-
- TO32Collection = class(TCollection)
- protected {private}
- {property variables}
- FItemEditor : TForm;
- FReadOnly : Boolean;
-
- FOwner: TPersistent;
-
- {event variables}
- FOnChanged : TNotifyEvent;
- FOnItemSelected : TOvcItemSelectedEvent;
- FOnGetEditorCaption : TO32GetEditorCaption;
-
- {Internal variables}
- InLoaded : Boolean;
- IsLoaded : Boolean;
- InChanged : Boolean;
-
- protected
- function GetCount : Integer;
- procedure Loaded;
- public
- constructor Create(AOwner : TPersistent;
- ItemClass : TCollectionItemClass); virtual;
- destructor Destroy; override;
- property ItemEditor : TForm read FItemEditor write FItemEditor;
-
- function Add : TO32CollectionItem; dynamic;
-
- {$IFNDEF VERSION4}
- function Insert(Index: Integer): TO32CollectionItem; dynamic;
- {$ENDIF}
-
- function GetItem(Index: Integer): TO32CollectionItem;
- function GetOwner: TPersistent; override;
- procedure SetItem(Index: Integer; Value: TO32CollectionItem);
- procedure DoOnItemSelected(Index : Integer);
- function GetEditorCaption : string;
- function ItemByName(const Name : string) : TO32CollectionItem;
- function ParentForm : TForm;
-
- property Count: Integer
- read GetCount;
- property Item[Index: Integer] : TO32CollectionItem
- read GetItem write SetItem; default;
- property OnGetEditorCaption : TO32GetEditorCaption
- read FOnGetEditorCaption write FOnGetEditorCaption;
- property ReadOnly : Boolean
- read FReadOnly write FReadOnly default False;
- property OnChanged : TNotifyEvent
- read FOnChanged write FOnChanged;
- property OnItemSelected : TOvcItemSelectedEvent
- read FOnItemSelected write FOnItemSelected;
- end;
-
- TOvcCollectionStreamer = class
- protected {private}
- FCollectionList : TList;
- FOwner : TComponent;
-
- protected
- procedure Loaded;
- procedure GetChildren(Proc: TGetChildProc; Root : TComponent);
-
- public
- constructor Create(AOwner : TComponent);
- destructor Destroy;
- override;
-
- procedure Clear;
- function CollectionFromType(Component : TComponent) : TOvcCollection;
-
- property Owner : TComponent
- read FOwner;
- end;
-
-
-type
- {base class for Orpheus components. Provides controller access}
- TOvcCustomControlEx = class(TOvcCustomControl)
- protected {private}
- FController : TOvcController;
-
- function ControllerAssigned : Boolean;
- function GetController: TOvcController;
- procedure SetController(Value : TOvcController); virtual;
-
- protected
- procedure CreateWnd;
- override;
- procedure Notification(AComponent : TComponent; Operation : TOperation);
- override;
-
- public
- property Controller : TOvcController
- read GetController
- write SetController;
- end;
-
-
-function FindController(Form : TWinControl) : TOvcController;
- {-search for an existing controller component}
-function GetImmediateParentForm(Control : TControl) : TWinControl;
- {-return first form found while searching Parent}
-procedure ResolveController(AForm : TWinControl; var AController : TOvcController);
- {-find or create a controller on this form}
-
-function DefaultController : TOvcController;
-
-implementation
-
-{.$DEFINE Logging}
-uses
- OvcVer,
- TypInfo,
- ExtCtrls,
-{$IFNDEF LCL}
- Consts,
-{$ELSE}
- LclStrConsts,
-{$ENDIF}
- OvcEF
- {$IFDEF Logging}
- ,LogAPI
- {$ENDIF}
- ;
-
-type
- TLocalEF = class(TOvcBaseEntryField);
-var
- FDefaultController : TOvcController = nil;
-
-{===== TO32ContainerList =============================================}
-
-constructor TO32ContainerList.Create(AOwner: TComponent);
-begin
- inherited Create;
- FOwner := TComponent(AOwner);
-end;
-{=====}
-
-destructor TO32ContainerList.Destroy;
-var
- I: Integer;
-begin
- for I := 0 to Count - 1 do
- TPanel(Items[I]).Free;
- inherited;
-end;
-
-
-{*** TOvcLabelInfo ***}
-
-procedure TOvcLabelInfo.DoOnAttach;
-begin
- if Assigned(FOnAttach) then
- FOnAttach(Self, FVisible);
-end;
-
-procedure TOvcLabelInfo.DoOnChange;
-begin
- if Assigned(FOnChange) then
- FOnChange(Self);
-end;
-
-function TOvcLabelInfo.IsVisible : Boolean;
-begin
- Result := FVisible;
-end;
-
-procedure TOvcLabelInfo.SetOffsets(X, Y : Integer);
-begin
- if (X <> FOffsetX) or (Y <> FOffsetY) then begin
- FOffsetX := X;
- FOffsetY := Y;
- DoOnChange;
- end;
-end;
-
-procedure TOvcLabelInfo.SetOffsetX(Value : Integer);
-begin
- if Value <> FOffsetX then begin
- FOffsetX := Value;
- DoOnChange;
- end;
-end;
-
-procedure TOvcLabelInfo.SetOffsetY(Value : Integer);
-begin
- if Value <> FOffsetY then begin
- FOffsetY := Value;
- DoOnChange;
- end;
-end;
-
-procedure TOvcLabelInfo.SetVisible(Value : Boolean);
-begin
- if Value <> FVisible then begin
- FVisible := Value;
- DoOnAttach;
- end;
-end;
-
-
-{*** TOvcAttachedLabel ***}
-
-constructor TOvcAttachedLabel.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- {set new defaults}
- AutoSize := True;
- ParentFont := True;
- Transparent := False;
-end;
-
-constructor TOvcAttachedLabel.CreateEx(AOwner : TComponent; AControl : TWinControl);
-begin
- FControl := AControl;
-
- Create(AOwner);
-
- {set attached control property}
- FocusControl := FControl;
-end;
-
-procedure TOvcAttachedLabel.Loaded;
-begin
- inherited Loaded;
-
- SavePosition;
-end;
-
-procedure TOvcAttachedLabel.SavePosition;
-var
- PF : TWinControl;
- I : Integer;
-begin
- if (csLoading in ComponentState) or (csDestroying in ComponentState) then
- Exit;
-
- {see if our associated control is on the form - save position}
- PF := GetImmediateParentForm(Self);
- if Assigned(PF) then begin
- for I := 0 to Pred(PF.ComponentCount) do begin
- if PF.Components[I] = FControl then begin
- SendMessage(FControl.Handle, OM_ASSIGNLABEL, 0, LPARAM(Self)); //64
- PostMessage(FControl.Handle, OM_RECORDLABELPOSITION, 0, 0);
- Break;
- end;
- end;
- end;
-end;
-
-procedure TOvcAttachedLabel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
-begin
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
- SavePosition;
-
- { The following line causes the IDE to mark the form dirty, requiring it }
- { to be saved. Not sure what this was supposed to do, but commenting it }
- { out seems to solve the problem. }
- {Application.ProcessMessages;}
-end;
-
-function FindController(Form : TWinControl) : TOvcController;
- {-search for an existing controller component}
-var
- I : Integer;
-begin
- Result := nil;
- for I := 0 to Form.ComponentCount-1 do begin
- if Form.Components[I] is TOvcController then begin
- Result := TOvcController(Form.Components[I]);
- Break;
- end;
- end;
-end;
-
-function GetImmediateParentForm(Control : TControl) : TWinControl;
- {return first form found while searching Parent}
-var
- ParentCtrl : TControl;
-begin
- ParentCtrl := Control.Parent;
-{$IFDEF VERSION5}
- while Assigned(ParentCtrl) and
- not ((ParentCtrl is TCustomForm) or
- (ParentCtrl is TCustomFrame)) do
-{$ELSE}
- while Assigned(ParentCtrl) and (not (ParentCtrl is TCustomForm)) do
-{$ENDIF}
- ParentCtrl := ParentCtrl.Parent;
- Result := TWinControl(ParentCtrl);
-end;
-
-procedure ResolveController(AForm : TWinControl; var AController : TOvcController);
- {-find or create a controller on this form}
-begin
- if not Assigned(AController) then begin
- {search for an existing controller. If not found,}
- {create the controller as a child of the form}
- {and assign it as our controller}
- AController := FindController(AForm);
- (*
- if not Assigned(AController) then begin
- AController := TOvcController.Create(AForm);
- try
- AController.Name := 'OvcController1';
- except
- AController.Free;
- AController := nil;
- raise;
- end;
- end;
- *)
- end;
-end;
-
-{*** TOvcComponent ***}
-
-constructor TOvcComponent.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
-end;
-
-destructor TOvcComponent.Destroy;
-begin
- FCollectionStreamer.Free;
- FCollectionStreamer := nil;
-
- inherited Destroy;
-end;
-
-function TOvcComponent.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-
-procedure TOvcComponent.SetAbout(const Value : string);
-begin
-end;
-
-
-{Logic for streaming collections of sub-components}
-
-function TOvcComponent.GetChildOwner: TComponent;
-begin
- if assigned(FCollectionStreamer) then
- Result := FCollectionStreamer.Owner
- else
- Result := inherited GetChildOwner;
-end;
-
-procedure TOvcComponent.GetChildren(Proc: TGetChildProc; Root : TComponent);
-begin
- if assigned(FCollectionStreamer) then
- CollectionStreamer.GetChildren(Proc, Root)
- else
- inherited GetChildren(Proc,Root);
-end;
-
-procedure TOvcComponent.Loaded;
-begin
- if assigned(FCollectionStreamer) then
- FCollectionStreamer.Loaded;
-
- inherited Loaded;
-end;
-
-{*** TO32Component ***}
-constructor TO32Component.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
-end;
-
-function TO32Component.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-
-procedure TO32Component.SetAbout(const Value : string);
-begin
-end;
-
-
-{*** TOvcCollectible ***}
-constructor TOvcCollectible.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- if (AOwner is TOvcComponent) then begin
- if TOvcComponent(AOwner).CollectionStreamer = nil then
- raise Exception.Create(GetOrphStr(SCNoCollection));
- SetCollection(TOvcComponent(AOwner).CollectionStreamer.CollectionFromType(Self));
- end else
- if (AOwner is TOvcCustomControl) then begin
- if TOvcCustomControl(AOwner).CollectionStreamer = nil then
- raise Exception.Create(GetOrphStr(SCNoCollection));
- SetCollection(TOvcCustomControl(AOwner).CollectionStreamer.CollectionFromType(Self));
- end else
- raise Exception.Create(GetOrphStr(SCNotOvcDescendant));
-
- if (csDesigning in ComponentState)
- and (AOwner <> nil) then
- if ((AOwner is TOvcComponent) and not TOvcComponent(AOwner).FInternal)
- or ((AOwner is TOvcCollectibleControl) and not TOvcCollectibleControl(AOwner).FInternal)
- or ((AOwner is TOvcCustomControl) and not TOvcCustomControl(AOwner).FInternal) then
-{$IFDEF VERSION5}
- if not (csLoading in AOwner.ComponentState) then
-{$ELSE}
- if not (csLoading in AOwner.ComponentState) then
-{$ENDIF}
- Name := GenerateName;
-end;
-
-destructor TOvcCollectible.Destroy;
-var
- OldCollection : TOvcCollection;
-begin
- OldCollection := Collection;
- SetCollection(nil);
- inherited Destroy;
- {mark dirty}
- if (csDesigning in ComponentState)
- and (OldCollection <> nil)
- and not (csDestroying in
- OldCollection.Owner.ComponentState) then begin
- OldCollection.Changed;
- end;
-end;
-
-function TOvcCollectible.GenerateName : string;
-var
- PF : TWinControl;
- I : Integer;
- S : string;
-
- function SearchSubComponents(C : TComponent; const S : string) : TComponent;
- var
- I : Integer;
- begin
- Result := C;
- if CompareText(S, Result.Name) = 0 then
- Exit;
- for I := 0 to C.ComponentCount-1 do begin
- Result := SearchSubComponents(C.Components[I], S);
- if Result <> nil then
- Exit;
- end;
- Result := nil;
- end;
-
- function FindComponentName(const S : string) : TComponent;
- begin
- Result := SearchSubComponents(PF, S);
- end;
-
-begin
- I := 1;
- S := GetBaseName;
- Result := Format('%s%d', [S, I]);
- PF := Collection.ParentForm;
- if not Assigned(PF) then
- Exit;
-
- while FindComponentName(Result) <> nil do begin
- Inc(I);
- Result := Format('%s%d', [S, I]);
- end;
-end;
-
-procedure TOvcCollectible.SetName(const NewName : TComponentName);
-begin
- inherited SetName(NewName);
- if not (csLoading in ComponentState) then
-{$IFDEF VERSION5}
- if (csInLine in ComponentState) then
- Changed;
-{$ENDIF}
- if (Collection <> nil)
- and (Collection.ItemEditor <> nil) then
- SendMessage(Collection.ItemEditor.Handle, OM_PROPCHANGE, 0, 0);
-end;
-
-function TOvcCollectible.GetBaseName : string;
-begin
- Result := 'CollectionItem';
-end;
-
-function TOvcCollectible.GetDisplayText : string;
-begin
- Result := ClassName;
-end;
-
-procedure TOvcCollectible.Changed;
-begin
- if InChanged then exit;
- InChanged := True;
- try
- {$IFDEF Logging}
- LogMsg('TOvcCollectible.Changed');
- LogBoolean('assigned(FCollection)', assigned(FCollection));
- LogBoolean('(csInline in ComponentState)', (csInline in ComponentState));
- LogBoolean('csAncestor in Owner.ComponentState', csAncestor in Owner.ComponentState);
- {$ENDIF}
- if assigned(FCollection) then
- {$IFDEF Version5}
- if not (csInline in ComponentState) then
- {$ENDIF}
- FCollection.Changed;
- finally
- InChanged := False;
- end;
-end;
-
-function TOvcCollectible.GetIndex : Integer;
-begin
- if assigned(FCollection) then
- Result := FCollection.FItems.IndexOf(Self)
- else
- Result := -1;
-end;
-
-procedure TOvcCollectible.SetIndex(Value : Integer);
-begin
- if Value <> Index then begin
- if assigned(FCollection) then begin
- FCollection.FItems.Remove(Self);
- FCollection.FItems.Insert(Value,Self);
- end;
- Changed;
- end;
-end;
-
-procedure TOvcCollectible.SetCollection(Value : TOvcCollection);
-begin
- if Collection <> Value then begin
- if Collection <> nil then
- Collection.FItems.Remove(Self);
- if Value <> nil then begin
- if not (Self is Value.ItemClass) then
- raise Exception.Create(GetOrphStr(SCItemIncompatible));
- Value.FItems.Add(Self);
- end;
- FCollection := Value;
- end;
-end;
-
-
-
-{===== TO32CollectionItem ============================================}
-
-function TO32CollectionItem.GetAbout: String;
-begin
- Result := OrVersionStr;
-end;
-
-procedure TO32CollectionItem.SetAbout(const Value: String);
-begin
-end;
-
-procedure TO32CollectionItem.SetName(Value: String);
-begin
- FName := Value;
-end;
-{=====}
-
-{*** TOvcCollectibleControl ***}
-constructor TOvcCollectibleControl.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- if (AOwner is TOvcComponent) then begin
- if TOvcComponent(AOwner).CollectionStreamer = nil then
- raise Exception.Create(GetOrphStr(SCNoCollection));
- SetCollection(TOvcComponent(AOwner).CollectionStreamer.CollectionFromType(Self));
- end else
- if (AOwner is TOvcCustomControl) then begin
- if TOvcCustomControl(AOwner).CollectionStreamer = nil then
- raise Exception.Create(GetOrphStr(SCNoCollection));
- SetCollection(TOvcCustomControl(AOwner).CollectionStreamer.CollectionFromType(Self));
- end else
- raise Exception.Create(GetOrphStr(SCNotOvcDescendant));
-
- if (csDesigning in ComponentState)
- and (AOwner <> nil) then
- if ((AOwner is TOvcComponent) and not TOvcComponent(AOwner).FInternal)
- or ((AOwner is TOvcCollectibleControl) and not TOvcCollectibleControl(AOwner).FInternal)
- or ((AOwner is TOvcCustomControl) and not TOvcCustomControl(AOwner).FInternal) then
- if not (csLoading in AOwner.ComponentState)
- {$IFDEF Version5}
- and not (csInLine in AOwner.ComponentState)
- {$ENDIF}
- then Name := GenerateName;
-end;
-
-destructor TOvcCollectibleControl.Destroy;
-var
- OldCollection : TOvcCollection;
-begin
- OldCollection := Collection;
- SetCollection(nil);
- inherited Destroy;
- {mark dirty}
- if (csDesigning in ComponentState)
- and (OldCollection <> nil)
- and not (csDestroying in
- OldCollection.Owner.ComponentState) then begin
- OldCollection.Changed;
- end;
-end;
-
-function TOvcCollectibleControl.GenerateName : string;
-var
- PF : TWinControl;
- I : Integer;
- S : string;
-
- function SearchSubComponents(C : TComponent; const S : string) : TComponent;
- var
- I : Integer;
- begin
- Result := C;
- if CompareText(S, Result.Name) = 0 then
- Exit;
- for I := 0 to C.ComponentCount-1 do begin
- Result := SearchSubComponents(C.Components[I], S);
- if Result <> nil then
- Exit;
- end;
- Result := nil;
- end;
-
- function FindComponentName(const S : string) : TComponent;
- begin
- Result := SearchSubComponents(PF, S);
- end;
-
-begin
- I := 1;
- S := GetBaseName;
- Result := Format('%s%d', [S, I]);
- PF := Collection.ParentForm;
- if not Assigned(PF) then
- Exit;
-
- while FindComponentName(Result) <> nil do begin
- Inc(I);
- Result := Format('%s%d', [S, I]);
- end;
-end;
-
-procedure TOvcCollectibleControl.SetName(const NewName : TComponentName);
-begin
- inherited SetName(NewName);
- if not (csLoading in ComponentState) then
- {$IFDEF Version5}
- if not (csInLine in ComponentState) then
- {$ENDIF}
- Changed;
-end;
-
-function TOvcCollectibleControl.GetBaseName : string;
-begin
- Result := 'CollectionItem';
-end;
-
-function TOvcCollectibleControl.GetDisplayText : string;
-begin
- Result := ClassName;
-end;
-
-procedure TOvcCollectibleControl.Changed;
-begin
- if InChanged then exit;
- InChanged := True;
- try
- if assigned(FCollection) then
- {$IFDEF Version5}
- if not (csInline in ComponentState) then
- {$ENDIF}
- FCollection.Changed;
- finally
- InChanged := False;
- end;
-end;
-
-function TOvcCollectibleControl.GetIndex : Integer;
-begin
- if Collection <> nil then
- Result := Collection.FItems.IndexOf(Self)
- else
- Result := -1;
-end;
-
-procedure TOvcCollectibleControl.SetIndex(Value : Integer);
-begin
- if Value <> Index then begin
- if Collection <> nil then begin
- Collection.FItems.Remove(Self);
- Collection.FItems.Insert(Value,Self);
- end;
- Changed;
- end;
-end;
-
-procedure TOvcCollectibleControl.SetCollection(Value : TOvcCollection);
-begin
- if Collection <> Value then begin
- if Collection <> nil then
- Collection.FItems.Remove(Self);
- if Value <> nil then begin
- if not (Self is Value.ItemClass) then
- raise Exception.Create(GetOrphStr(SCItemIncompatible));
- Value.FItems.Add(Self);
- end;
- FCollection := Value;
- end;
-end;
-
-{*** TOvcController ***}
-constructor TOvcController.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- {create the command processor}
- FEntryCommands := TOvcCommandProcessor.Create;
- FBaseEFOptions := [efoAutoSelect, efoBeepOnError, efoInsertPushes];
- FEpoch := DefaultEpoch;
- FErrorPending := False;
- FInsertMode := True;
-
-{$IFNDEF LCL}
- {create the general use timer pool}
- FTimerPool := TOvcTimerPool.Create(Self);
- FTimerPool.OnAllTriggers := DoOnTimerTrigger;
-{$ENDIF}
-end;
-
-procedure TOvcController.cWndProc(var Msg : TMessage);
- {-window procedure}
-var
- C : TWinControl;
-begin
- C := TWinControl(Msg.lParam);
- try
- with Msg do begin
- case Msg of
- OM_SETFOCUS :
- begin
- C.Show;
- if C.CanFocus then
- C.SetFocus;
- end;
- OM_PREEDIT :
- if Assigned(FOnPreEdit) then
- FOnPreEdit(TWinControl(lParam), FindControl(wParam));
- OM_POSTEDIT :
- if Assigned(FOnPostEdit) then
- FOnPostEdit(TWinControl(lParam), FindControl(wParam));
- OM_DELAYNOTIFY :
- if Assigned(FOnDelayNotify) then
- FOnDelayNotify(TObject(lParam), wParam);
- else
- Result := DefWindowProc(Handle, Msg, wParam, lParam);
- end;
- end;
- except
- Application.HandleException(Self);
- end;
-end;
-
-{$IFDEF LCL}
-function TOvcController.PostMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL;
-var
- AMsg : TMessage;
-begin
- if hWnd = Handle then
- begin
- AMsg.Msg := Msg;
- AMsg.WParam := wParam;
- AMsg.LParam := lParam;
- cWndProc(AMsg);
- end
- else
-{$IFDEF MSWINDOWS}
- Result := MyMisc.PostMessage(hWnd, Msg, wParam, lParam);
-{$ELSE}
- Result := LclIntf.PostMessage(hWnd, Msg, wParam, lParam);
-{$ENDIF}
-end;
-{$ENDIF}
-
-procedure TOvcController.DelayNotify(Sender : TObject; NotifyCode : Word);
-begin
- if Assigned(FOnDelayNotify) then
- PostMessage(Handle, OM_DELAYNOTIFY, NotifyCode, LPARAM(Sender)); //64
-end;
-
-destructor TOvcController.Destroy;
-begin
- {destroy the command processor}
- FEntryCommands.Free;
- FEntryCommands := nil;
-
-{$IFNDEF LCL}
- FTimerPool.Free;
- FTimerPool := nil;
-{$ENDIF}
-
- {destroy window handle, if created}
- DestroyHandle;
-
- inherited Destroy;
-end;
-
-procedure TOvcController.DestroyHandle;
-begin
-{$IFNDEF LCL}
- if FHandle <> 0 then
- {$IFDEF VERSION6}
- Classes.DeallocateHWnd(FHandle);
- {$ELSE}
- DeallocateHWnd(FHandle);
- {$ENDIF}
-{$ENDIF}
-
- FHandle := 0;
-end;
-
-procedure TOvcController.DoOnError(Sender : TObject; ErrorCode : Word;
- const ErrorMsg : string);
-begin
- if Assigned(FOnError) then
- FOnError(Sender, ErrorCode, ErrorMsg)
- else
- MessageDlg(ErrorMsg, mtError, [mbOK], 0);
-end;
-
-procedure TOvcController.DoOnPostEdit(Sender : TObject; GainingControl : TWinControl);
-var
- H : hWnd;
-begin
- if Assigned(GainingControl) then
- H := GainingControl.Handle
- else
- H := 0;
-
- PostMessage(Handle, OM_POSTEDIT, H, LPARAM(Sender)); //64
-end;
-
-procedure TOvcController.DoOnPreEdit(Sender : TObject; LosingControl : TWinControl);
-var
- H : hWnd;
-begin
- if Assigned(LosingControl) then
- H := LosingControl.Handle
- else
- H := 0;
-
- PostMessage(Handle, OM_PREEDIT, H, LPARAM(Sender)); //64
-end;
-
-procedure TOvcController.DoOnTimerTrigger(Sender : TObject; Handle : Integer;
- Interval : Cardinal; ElapsedTime : LongInt);
-begin
-{$IFNDEF LCL}
- if Assigned(FOnTimerTrigger) then
- FOnTimerTrigger(Sender, Handle, Interval, ElapsedTime);
-{$ENDIF}
-end;
-
-function TOvcController.GetEpoch : Integer;
-begin
- Result := FEpoch;
- if Assigned(FOnGetEpoch) then
- FOnGetEpoch(Self, Result);
-end;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
-function TOvcController.GetHandle : TOvcHWnd{hWnd};
-begin
-// AllocateHWnd not available in LCL to create non-visual window that
-// responds to messages sent to controller. But shouldn't be needed
-// with controller's PostMessage method that intercepts messages.
-{$IFNDEF LCL}
- if FHandle = 0 then
- {$IFDEF VERSION6}
- FHandle := Classes.AllocateHWnd(cWndProc);
- {$ELSE}
- FHandle := AllocateHWnd(cWndProc);
- {$ENDIF}
-{$ENDIF}
- Result := FHandle;
-end;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
-function TOvcController.IsSpecialButton(H : TOvcHWnd{hWnd}) : Boolean;
-begin
- Result := False;
- if Assigned(FOnIsSpecialControl) then
- FOnIsSpecialControl(Self, FindControl(H), Result);
-end;
-
-procedure TOvcController.MarkAsUninitialized(Uninitialized : Boolean);
- {-mark all entry fields on form as uninitialized}
-var
- I : Integer;
-
- procedure MarkField(C : TComponent);
- var
- J : Integer;
- begin
- {first, see if this component is an entry field}
- if C is TOvcBaseEntryField then
- TOvcBaseEntryField(C).Uninitialized := Uninitialized;
-
- {recurse through all child components}
- for J := 0 to C.ComponentCount-1 do
- MarkField(C.Components[J]);
- end;
-
-begin
-{$IFDEF VERSION5}
- if (Owner is TCustomForm) or (Owner is TCustomFrame) then
- with TWinControl(Owner) do
-{$ELSE}
- if Owner is TForm then
- with TForm(Owner) do
-{$ENDIF}
- for I := 0 to ComponentCount-1 do
- MarkField(Components[I]);
-end;
-
-procedure TOvcController.SetEpoch(Value : Integer);
-begin
- if Value <> FEpoch then
- if (Value >= MinYear) and (Value <= MaxYear) then
- FEpoch := Value;
-end;
-
-function TOvcController.ValidateEntryFields : TComponent;
-begin
- {if error, report it and send focus to field with error}
- Result := ValidateEntryFieldsEx(True, True);
-end;
-
-function TOvcController.ValidateEntryFieldsEx(ReportError, ChangeFocus : Boolean) : TComponent;
-var
- I : Integer;
-
- procedure ValidateEF(C : TComponent);
- var
- J : Integer;
- EF : TLocalEF absolute C;
- begin
- {see if this component is an entry field}
- if (C is TOvcBaseEntryField) then begin
-
- {don't validate invisible or disabled fields}
- if not EF.Visible or not EF.Enabled then
- Exit;
-
- {ask entry field to validate itself}
- if (EF.ValidateContents(False) <> 0) then begin
- {remember only the first invalid field found}
- if not Assigned(Result) then
- Result := EF;
-
- {tell the entry field to report the error}
- if ReportError and not ErrorPending then
- PostMessage(EF.Handle, OM_REPORTERROR, EF.LastError, 0);
-
- {ask the controller to give the focus back to this field}
- if ChangeFocus and not ErrorPending then begin
- PostMessage(Handle, OM_SETFOCUS, 0, LPARAM(EF)); //64
- ErrorPending := True;
- end;
-
- {exit if we are reporting the error or changing the focus}
- if (ReportError or ChangeFocus) then
- Exit;
- end;
- end;
-
- {recurse through all child components}
- for J := 0 to C.ComponentCount-1 do begin
- ValidateEf(C.Components[J]);
-
- {exit if we've already found an error and should stop}
- if Assigned(Result) and (ReportError or ChangeFocus) then
- Break;
- end;
- end;
-
-begin
- Result := nil;
-{$IFDEF VERSION5}
- if ((Owner is TCustomForm) or (Owner is TCustomFrame)) then
- with TWinControl(Owner) do
-{$ELSE}
- if Owner is TForm then
- with TForm(Owner) do
-{$ENDIF}
- for I := 0 to ComponentCount-1 do begin
- ValidateEf(Components[I]);
-
- {stop checking if reporting the error or changing focus}
- if Assigned(Result) and (ReportError or ChangeFocus) then
- Break ;
- end;
-end;
-
-function TOvcController.ValidateTheseEntryFields(const Fields : array of TComponent) : TComponent;
- {-ask the specified entry fields to validate their contents. Return nil
- if no error, else return pointer to field with error}
-var
- I : Integer;
- EF : TLocalEF;
-begin
- Result := nil;
-
- for I := Low(Fields) to High(Fields) do begin
- if Fields[I] is TOvcBaseEntryField then begin
- EF := TLocalEF(Fields[I]);
-
- {ask entry field to validate itself}
- if (EF.ValidateContents(False) <> 0) then begin
- Result := EF;
-
- {tell the entry field to report the error}
- if not ErrorPending then
- PostMessage(EF.Handle, OM_REPORTERROR, EF.LastError, 0);
-
- {ask the controller to give the focus back to this field}
- if not ErrorPending then begin
- PostMessage(Handle, OM_SETFOCUS, 0, LPARAM(EF)); //64
- ErrorPending := True;
- end;
-
- Exit;
- end;
-
- end;
- end;
-end;
-
-{*** TOvcGraphicControl ***}
-
-constructor TOvcGraphicControl.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
-end;
-
-destructor TOvcGraphicControl.Destroy;
-begin
- FCollectionStreamer.Free;
- FCollectionStreamer := nil;
- inherited Destroy;
-end;
-
-
-procedure TOvcGraphicControl.Loaded;
-begin
- if Assigned(FCollectionStreamer) then
- FCollectionStreamer.Loaded;
- inherited Loaded;
-end;
-
-{Logic for streaming collections of sub-components}
-
-function TOvcGraphicControl.GetChildOwner: TComponent;
-begin
- if Assigned(FCollectionStreamer) then
- Result := FCollectionStreamer.Owner
- else
- Result := inherited GetChildOwner;
-end;
-
-procedure TOvcGraphicControl.GetChildren(Proc: TGetChildProc; Root : TComponent);
-begin
- if Assigned(FCollectionStreamer) then
- CollectionStreamer.GetChildren(Proc, Root)
- else
- inherited GetChildren(Proc, Root);
-end;
-
-function TOvcGraphicControl.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-
-
-procedure TOvcGraphicControl.SetAbout(const Value : string);
-begin
-end;
-
-
-{*** TO32CustomControl ***}
-
-procedure TO32CustomControl.CMVisibleChanged(var Msg : TMessage);
-begin
- inherited;
-
- if csLoading in ComponentState then
- Exit;
-
- if LabelInfo.Visible then
- AttachedLabel.Visible := Visible;
-end;
-
-constructor TO32CustomControl.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- DefaultLabelPosition := lpTopLeft;
-
- FLabelInfo := TOvcLabelInfo.Create;
- FLabelInfo.OnChange := LabelChange;
- FLabelInfo.OnAttach := LabelAttach;
-end;
-
-procedure TO32CustomControl.CreateWnd;
-begin
- inherited CreateWnd;
-end;
-
-destructor TO32CustomControl.Destroy;
-begin
- FLabelInfo.Visible := False;
- FLabelInfo.Free;
- FLabelInfo := nil;
- inherited Destroy;
-end;
-
-procedure TO32CustomControl.DoOnMouseWheel(Shift : TShiftState;
- Delta, XPos, YPos : SmallInt);
-// Another TurboPower bug? Their TMouseWheelEvent expects Word
-// params, yet passing SmallInts here. Delta is negative when
-// scroll down, which will raise exception if a descendent class
-// with a TMouseWheelEvent handler has range checking turned on.
-// Note that their TMouseWheelEvent redefines LCL's.
-begin
- if Assigned(FOnMouseWheel) then
- FOnMouseWheel(Self, Shift, Delta, XPos, YPos);
-end;
-
-function TO32CustomControl.GetAttachedLabel : TOvcAttachedLabel;
-begin
- if not FLabelInfo.Visible then
- raise Exception.Create(GetOrphStr(SCLabelNotAttached));
-
- Result := FLabelInfo.ALabel;
-end;
-
-function TO32CustomControl.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-
-procedure TO32CustomControl.LabelAttach(Sender : TObject; Value : Boolean);
-var
-{$IFDEF VERSION5}
- PF : TWinControl;
-{$ELSE}
- PF : TForm;
-{$ENDIF}
- S : string;
-begin
- if (csLoading in ComponentState) then
- Exit;
-
-{$IFDEF VERSION5}
- PF := GetImmediateParentForm(Self);
-{$ELSE}
- PF := TForm(GetParentForm(Self));
-{$ENDIF}
- if Value then begin
- if Assigned(PF) then begin
- FLabelInfo.ALabel.Free;
- FLabelInfo.ALabel := TOvcAttachedLabel.CreateEx(PF, Self);
- FLabelInfo.ALabel.Parent := Parent;
-
- S := GenerateComponentName(PF, Name + 'Label');
- FLabelInfo.ALabel.Name := S;
- FLabelInfo.ALabel.Caption := S;
-
- FLabelInfo.SetOffsets(0, 0);
- PositionLabel;
- FLabelInfo.ALabel.BringToFront;
-
- {force auto size}
- FLabelInfo.ALabel.AutoSize := True;
- end;
- end else begin
- if Assigned(PF) then begin
- FLabelInfo.ALabel.Free;
- FLabelInfo.ALabel := nil;
- end;
- end;
-end;
-
-procedure TO32CustomControl.LabelChange(Sender : TObject);
-begin
- if not (csLoading in ComponentState) then
- PositionLabel;
-end;
-
-procedure TO32CustomControl.Notification(AComponent : TComponent; Operation : TOperation);
-var
-{$IFDEF VERSION5}
- PF : TWinControl;
-{$ELSE}
- PF : TForm;
-{$ENDIF}
-begin
- inherited Notification(AComponent, Operation);
-
- if Operation = opRemove then
- if Assigned(FLabelInfo) and (AComponent = FLabelInfo.ALabel) then begin
-{$IFDEF VERSION5}
- PF := GetImmediateParentForm(Self);
-{$ELSE}
- PF := TForm(GetParentForm(Self));
-{$ENDIF}
- if Assigned(PF) and not (csDestroying in PF.ComponentState) then begin
- FLabelInfo.FVisible := False;
- FLabelInfo.ALabel := nil;
- end;
- end;
-end;
-
-procedure TO32CustomControl.OMAfterEnter(var Msg : TMessage);
-begin
- if Assigned(FAfterEnter) then
- FAfterEnter(Self);
-end;
-
-procedure TO32CustomControl.OMAfterExit(var Msg : TMessage);
-begin
- if Assigned(FAfterExit) then
- FAfterExit(Self);
-end;
-
-procedure TO32CustomControl.OMAssignLabel(var Msg : TMessage);
-begin
- FLabelInfo.ALabel := TOvcAttachedLabel(Msg.lParam);
-end;
-
-procedure TO32CustomControl.OMPositionLabel(var Msg : TMessage);
-const
- DX : Integer = 0;
- DY : Integer = 0;
-begin
- if FLabelInfo.Visible and
- Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) and
- not (csLoading in ComponentState) then begin
- if DefaultLabelPosition = lpTopLeft then begin
- DX := FLabelInfo.ALabel.Left - Left;
- DY := FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top;
- end else begin
- DX := FLabelInfo.ALabel.Left - Left;
- DY := FLabelInfo.ALabel.Top - Top - Height;
- end;
- if (DX <> FLabelInfo.OffsetX) or (DY <> FLabelInfo.OffsetY) then
- PositionLabel;
- end;
-end;
-
-procedure TO32CustomControl.OMRecordLabelPosition(var Msg : TMessage);
-begin
- if Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) then begin
- {if the label was cut and then pasted, this will complete the re-attachment}
- FLabelInfo.FVisible := True;
-
- if DefaultLabelPosition = lpTopLeft then
- FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
- FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top)
- else
- FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
- FLabelInfo.ALabel.Top - Top - Height);
- end;
-end;
-
-procedure TO32CustomControl.PositionLabel;
-begin
- if FLabelInfo.Visible and Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) and
- not (csLoading in ComponentState) then begin
-
- if DefaultLabelPosition = lpTopLeft then begin
- FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
- FLabelInfo.OffsetY - FLabelInfo.ALabel.Height + Top,
- FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
- end else begin
- FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
- FLabelInfo.OffsetY + Top + Height,
- FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
- end;
- end;
-end;
-
-procedure TO32CustomControl.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
-begin
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-
- if HandleAllocated then
- PostMessage(Handle, OM_POSITIONLABEL, 0, 0);
-end;
-
-procedure TO32CustomControl.SetAbout(const Value : string);
-begin
-end;
-
-procedure TO32CustomControl.WMKillFocus(var Msg : TWMKillFocus);
-begin
- inherited;
-
- PostMessage(Handle, OM_AFTEREXIT, 0, 0);
-end;
-
-procedure TO32CustomControl.WMMouseWheel(var Msg : TMessage);
-// TurboPower bug: They should have used TWMMouseWheel instead of
-// TMessage. Delta is negative on scroll down, but extracting it
-// from wParam with HIWORD returns a Word, which causes an
-// exception when passed as SmallInt to DoOnMouseWheel when
-// range checking turned on. Fix is to cast delta as SmallInt.
-begin
- with Msg do
- DoOnMouseWheel(KeysToShiftState(LOWORD(wParam)) {fwKeys},
- SmallInt(HIWORD(wParam)) {zDelta}, //bug fix
- LOWORD(lParam) {xPos}, HIWORD(lParam) {yPos});
-end;
-
-procedure TO32CustomControl.WMSetFocus(var Msg : TWMSetFocus);
-begin
- inherited;
-
- PostMessage(Handle, OM_AFTERENTER, 0, 0);
-end;
-
-{*** End - TO32CustomCOntrol ***}
-
-
-{*** TOvcCustomControl ***}
-procedure TOvcCustomControl.CMVisibleChanged(var Msg : TMessage);
-begin
- inherited;
-
- if csLoading in ComponentState then
- Exit;
-
- if LabelInfo.Visible then
- AttachedLabel.Visible := Visible;
-end;
-
-constructor TOvcCustomControl.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- DefaultLabelPosition := lpTopLeft;
-
- FLabelInfo := TOvcLabelInfo.Create;
- FLabelInfo.OnChange := LabelChange;
- FLabelInfo.OnAttach := LabelAttach;
-end;
-
-procedure TOvcCustomControl.CreateWnd;
-begin
- inherited CreateWnd;
-end;
-
-destructor TOvcCustomControl.Destroy;
-begin
- FLabelInfo.Visible := False;
- FLabelInfo.Free;
- FLabelInfo := nil;
- FCollectionStreamer.Free;
- FCollectionStreamer := nil;
- inherited Destroy;
-end;
-
-procedure TOvcCustomControl.DoOnMouseWheel(Shift : TShiftState;
- Delta, XPos, YPos : SmallInt);
-begin
- if Assigned(FOnMouseWheel) then
- FOnMouseWheel(Self, Shift, Delta, XPos, YPos);
-end;
-
-function TOvcCustomControl.GetAttachedLabel : TOvcAttachedLabel;
-begin
- if not FLabelInfo.Visible then
- raise Exception.Create(GetOrphStr(SCLabelNotAttached));
-
- Result := FLabelInfo.ALabel;
-end;
-
-function TOvcCustomControl.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-
-procedure TOvcCustomControl.LabelAttach(Sender : TObject; Value : Boolean);
-var
-{$IFDEF VERSION5}
- PF : TWinControl;
-{$ELSE}
- PF : TForm;
-{$ENDIF}
- S : string;
-begin
- if (csLoading in ComponentState) then
- Exit;
-
-{$IFDEF VERSION5}
- PF := GetImmediateParentForm(Self);
-{$ELSE}
- PF := TForm(GetParentForm(Self));
-{$ENDIF}
- if Value then begin
- if Assigned(PF) then begin
- FLabelInfo.ALabel.Free;
- FLabelInfo.ALabel := TOvcAttachedLabel.CreateEx(PF, Self);
- FLabelInfo.ALabel.Parent := Parent;
-
- S := GenerateComponentName(PF, Name + 'Label');
- FLabelInfo.ALabel.Name := S;
- FLabelInfo.ALabel.Caption := S;
-
- FLabelInfo.SetOffsets(0, 0);
- PositionLabel;
- FLabelInfo.ALabel.BringToFront;
-
- {force auto size}
- FLabelInfo.ALabel.AutoSize := True;
- end;
- end else begin
- if Assigned(PF) then begin
- FLabelInfo.ALabel.Free;
- FLabelInfo.ALabel := nil;
- end;
- end;
-end;
-
-procedure TOvcCustomControl.LabelChange(Sender : TObject);
-begin
- if not (csLoading in ComponentState) then
- PositionLabel;
-end;
-
-procedure TOvcCustomControl.Notification(AComponent : TComponent; Operation : TOperation);
-var
-{$IFDEF VERSION5}
- PF : TWinControl;
-{$ELSE}
- PF : TForm;
-{$ENDIF}
-begin
- inherited Notification(AComponent, Operation);
-
- if Operation = opRemove then
- if Assigned(FLabelInfo) and (AComponent = FLabelInfo.ALabel) then begin
-{$IFDEF VERSION5}
- PF := GetImmediateParentForm(Self);
-{$ELSE}
- PF := TForm(GetParentForm(Self));
-{$ENDIF}
- if Assigned(PF) and not (csDestroying in PF.ComponentState) then begin
- FLabelInfo.FVisible := False;
- FLabelInfo.ALabel := nil;
- end;
- end;
-end;
-
-procedure TOvcCustomControl.OMAfterEnter(var Msg : TMessage);
-begin
- if Assigned(FAfterEnter) then
- FAfterEnter(Self);
-end;
-
-procedure TOvcCustomControl.OMAfterExit(var Msg : TMessage);
-begin
- if Assigned(FAfterExit) then
- FAfterExit(Self);
-end;
-
-procedure TOvcCustomControl.OMAssignLabel(var Msg : TMessage);
-begin
- FLabelInfo.ALabel := TOvcAttachedLabel(Msg.lParam);
-end;
-
-procedure TOvcCustomControl.OMPositionLabel(var Msg : TMessage);
-const
- DX : Integer = 0;
- DY : Integer = 0;
-begin
- if FLabelInfo.Visible and
- Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) and
- not (csLoading in ComponentState) then begin
- if DefaultLabelPosition = lpTopLeft then begin
- DX := FLabelInfo.ALabel.Left - Left;
- DY := FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top;
- end else begin
- DX := FLabelInfo.ALabel.Left - Left;
- DY := FLabelInfo.ALabel.Top - Top - Height;
- end;
- if (DX <> FLabelInfo.OffsetX) or (DY <> FLabelInfo.OffsetY) then
- PositionLabel;
- end;
-end;
-
-procedure TOvcCustomControl.OMRecordLabelPosition(var Msg : TMessage);
-begin
- if Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) then begin
- {if the label was cut and then pasted, this will complete the re-attachment}
- FLabelInfo.FVisible := True;
-
- if DefaultLabelPosition = lpTopLeft then
- FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
- FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top)
- else
- FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
- FLabelInfo.ALabel.Top - Top - Height);
- end;
-end;
-
-procedure TOvcCustomControl.PositionLabel;
-begin
- if FLabelInfo.Visible and Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) and
- not (csLoading in ComponentState) then begin
-
- if DefaultLabelPosition = lpTopLeft then begin
- FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
- FLabelInfo.OffsetY - FLabelInfo.ALabel.Height + Top,
- FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
- end else begin
- FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
- FLabelInfo.OffsetY + Top + Height,
- FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
- end;
- end;
-end;
-
-procedure TOvcCustomControl.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
-begin
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-
- if HandleAllocated then
- PostMessage(Handle, OM_POSITIONLABEL, 0, 0);
-end;
-
-procedure TOvcCustomControl.SetAbout(const Value : string);
-begin
-end;
-
-procedure TOvcCustomControl.WMKillFocus(var Msg : TWMKillFocus);
-begin
- inherited;
-
- PostMessage(Handle, OM_AFTEREXIT, 0, 0);
-end;
-
-procedure TOvcCustomControl.WMMouseWheel(var Msg : TMessage);
-// See TurboPower bug comments above.
-begin
- with Msg do
- DoOnMouseWheel(KeysToShiftState(LOWORD(wParam)) {fwKeys},
- SmallInt(HIWORD(wParam)) {zDelta}, //bug fix
- LOWORD(lParam) {xPos}, HIWORD(lParam) {yPos});
-end;
-
-procedure TOvcCustomControl.WMSetFocus(var Msg : TWMSetFocus);
-begin
- inherited;
-
- PostMessage(Handle, OM_AFTERENTER, 0, 0);
-end;
-
-
-{Logic for streaming collections of sub-components}
-
-function TOvcCustomControl.GetChildOwner: TComponent;
-begin
- if Assigned(FCollectionStreamer) then
- Result := FCollectionStreamer.Owner
- else
- Result := inherited GetChildOwner;
-end;
-
-procedure TOvcCustomControl.GetChildren(Proc: TGetChildProc; Root : TComponent);
-begin
- if Assigned(FCollectionStreamer) then
- CollectionStreamer.GetChildren(Proc, Root)
- else
- inherited GetChildren(Proc, Root);
-end;
-
-procedure TOvcCustomControl.Loaded;
-begin
- if Assigned(FCollectionStreamer) then
- FCollectionStreamer.Loaded;
- inherited Loaded;
-end;
-
-{*** TOvcCustomControlEx ***}
-
-function TOvcCustomControlEx.ControllerAssigned : Boolean;
-begin
- Result := Assigned(FController);
-end;
-
-procedure TOvcCustomControlEx.CreateWnd;
-var
- OurForm : TWinControl;
-
-begin
- OurForm := GetImmediateParentForm(Self);
-
- {do this only when the component is first dropped on the form, not during loading}
- if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
- ResolveController(OurForm, FController);
-
- if not Assigned(FController) and not (csLoading in ComponentState) then begin
- {try to find a controller on this form that we can use}
- FController := FindController(OurForm);
-
- {if not found and we are not designing, use default controller}
- if not Assigned(FController) and not (csDesigning in ComponentState) then
- FController := DefaultController;
- end;
-
- inherited CreateWnd;
-end;
-
-function TOvcCustomControlEx.GetController: TOvcController;
-begin
- if FController = nil then
- Result := DefaultController
- else
- Result := FController;
-end;
-
-procedure TOvcCustomControlEx.Notification(AComponent : TComponent; Operation : TOperation);
-begin
- inherited Notification(AComponent, Operation);
-
- if Operation = opRemove then begin
- if (AComponent = FController) then
- FController := nil;
- end else if (Operation = opInsert) and (FController = nil) and
- (AComponent is TOvcController) then
- FController := TOvcController(AComponent);
-end;
-
-procedure TOvcCustomControlEx.SetController(Value : TOvcController);
-begin
- if not (TObject(Value) is TOvcController) then
- Value := nil;
- FController := Value;
- if Value <> nil then
- Value.FreeNotification(Self);
-end;
-
-function TOvcCollection.Add : TComponent;
-begin
- if not Assigned(FItemClass) then
- raise Exception.Create(GetOrphStr(SCClassNotSet));
- Result := FItemClass.Create(Owner);
- Changed;
- if ItemEditor <> nil then
- SendMessage(ItemEditor.Handle, OM_PROPCHANGE, 0, 0);
-end;
-
-procedure TOvcCollection.Changed;
-var
- Parent : TForm;
-begin
- {$IFDEF Logging}
- LogMsg('TOvcCollection.Changed');
- LogBoolean('InChanged', InChanged);
- {$ENDIF}
- if InChanged then exit;
- InChanged := True;
- try
- Parent := ParentForm;
- if Parent <> nil then begin
- {$IFDEF Logging}
- LogString('Parent.ClassName', Parent.ClassName);
- LogBoolean('(csLoading in Parent.ComponentState)', (csLoading in Parent.ComponentState));
- {$ENDIF}
- if not (csLoading in Parent.ComponentState)
- and (csDesigning in Parent.ComponentState) then begin
- {$IFDEF Logging}
- LogBoolean('TForm(Parent).Designer <> nil', TForm(Parent).Designer <> nil);
- LogBoolean('InLoaded', InLoaded);
- LogBoolean('IsLoaded', IsLoaded);
- LogBoolean('(csAncestor in Owner.ComponentState)', (csAncestor in Owner.ComponentState));
- LogBoolean('Stored', Stored);
- {$ENDIF}
- {$IFDEF VERSION5}
- if (TForm(Parent).Designer <> nil)
- {$ELSE}
- if (Parent.Designer <> nil)
- {$ENDIF}
- and not InLoaded
- and IsLoaded
- and not (csAncestor in Owner.ComponentState)
- and Stored then
- {$IFDEF VERSION5}
- TForm(Parent).Designer.Modified;
- {$ELSE}
- Parent.Designer.Modified;
- {$ENDIF}
- if (ItemEditor <> nil)
- and not (csAncestor in Owner.ComponentState)
- then
- SendMessage(ItemEditor.Handle, OM_PROPCHANGE, 0, 0);
- end;
- if Assigned(FOnChanged) then
- FOnChanged(Self);
- end;
- finally
- InChanged := False;
- end;
-end;
-
-procedure TOvcCollection.Clear;
-{$IFDEF Version5}
-var
- i : Integer;
-{$ENDIF}
-begin
- {$IFDEF Version5}
- for i := Count - 1 downto 0 do
- if not (csAncestor in Item[i].ComponentState) then
- Item[i].Free;
- {$ELSE}
- while Count > 0 do
- Item[0].Free;
- {$ENDIF}
- if ItemEditor <> nil then
- SendMessage(ItemEditor.Handle, OM_PROPCHANGE, 0, 0);
-end;
-
-constructor TOvcCollection.Create(AOwner : TComponent;
- ItemClass : TOvcCollectibleClass);
-begin
- inherited Create;
- FStored := True;
- FItemClass := ItemClass;
- FItems := TList.Create;
- FOwner := AOwner;
-
- if (AOwner is TOvcComponent) then
- begin
- if TOvcComponent(AOwner).CollectionStreamer = nil then
- TOvcComponent(AOwner).CollectionStreamer := TOvcCollectionStreamer.Create(AOwner);
- FStreamer := TOvcComponent(AOwner).CollectionStreamer;
- FStreamer.FCollectionList.Add(Self);
- end
- else
- if (AOwner is TOvcCustomControl) then
- begin
- if TOvcCustomControl(AOwner).CollectionStreamer = nil then
- TOvcCustomControl(AOwner).CollectionStreamer := TOvcCollectionStreamer.Create(AOwner);
- FStreamer := TOvcCustomControl(AOwner).CollectionStreamer;
- FStreamer.FCollectionList.Add(Self);
- end
- else
- raise Exception.Create(GetOrphStr(SCNotOvcDescendant));
-end;
-
-procedure TOvcCollection.Delete(Index : Integer);
-begin
- if (Index > -1) and (Index < Count) then
- Item[Index].Free;
- Changed;
-end;
-
-destructor TOvcCollection.Destroy;
-begin
- ItemEditor.Free;
- if (Owner is TOvcComponent) then
- TOvcComponent(Owner).CollectionStreamer.FCollectionList.Remove(Self)
- else
- TOvcCustomControl(Owner).CollectionStreamer.FCollectionList.Remove(Self);
- Clear;
- FItems.Free;
- inherited Destroy;
-end;
-
-procedure TOvcCollection.DoOnItemSelected(Index : Integer);
-begin
- if Assigned(FOnItemSelected) then
- FOnItemSelected(Self, Index);
-end;
-
-function TOvcCollection.GetCount : Integer;
-begin
- Result := FItems.Count;
-end;
-
-function TOvcCollection.GetEditorCaption : string;
-begin
- Result := 'Editing ' + ClassName;
- if Assigned(FOnGetEditorCaption) then
- FOnGetEditorCaption(Result);
-end;
-
-function TOvcCollection.GetItem(Index : Integer) : TComponent;
-begin
- Result := TComponent(FItems[Index]);
-end;
-
-function TOvcCollection.Insert(Index : Integer) : TComponent;
-begin
- if (Index < 0) or (Index > Count) then
- Index := Count;
- Result := Add;
- if Result is TOvcCollectible then
- TOvcCollectible(Item[Count-1]).Index := Index
- else
- if Result is TOvcCollectibleControl then
- TOvcCollectibleControl(Item[Count-1]).Index := Index
- else
- Result := nil;
-end;
-
-function TOvcCollection.ItemByName(const Name : string) : TComponent;
-var
- i : Integer;
-begin
- for i := 0 to pred(Count) do
- if Item[i].Name = Name then begin
- Result := Item[i];
- exit;
- end;
- Result := nil;
-end;
-
-procedure TOvcCollection.Loaded;
-begin
- InLoaded := True;
- try
- Changed;
- finally
- InLoaded := False;
- end;
- IsLoaded := True;
-end;
-
-function TOvcCollection.ParentForm : TForm;
-var
- Temp : TObject;
-begin
- Temp := Owner;
- while (Temp <> nil) and not (Temp is TForm) do
- Temp := TComponent(Temp).Owner;
- Result := TForm(Temp);
-end;
-
-procedure TOvcCollection.SetItem(Index : Integer; Value : TComponent);
-begin
- TOvcCollectible(FItems[Index]).Assign(Value);
-end;
-
-procedure TOvcCollectionStreamer.Clear;
-var
- I : Integer;
-begin
- for I := 0 to pred(FCollectionList.Count) do
- TOvcCollection(FCollectionList[I]).Clear;
-end;
-
-
-{===== TO32Collection ================================================}
-
-constructor TO32Collection.Create(AOwner : TPersistent;
- ItemClass : TCollectionItemClass);
-begin
- FOwner := AOwner;
- Inherited Create(ItemClass);
-end;
-
-destructor TO32Collection.Destroy;
-begin
- ItemEditor.Free;
- Clear;
- inherited Destroy;
-end;
-
-procedure TO32Collection.DoOnItemSelected(Index : Integer);
-begin
- if Assigned(FOnItemSelected) then
- FOnItemSelected(Self, Index);
-end;
-
-function TO32Collection.GetCount : Integer;
-begin
- Result := inherited Count;
-end;
-
-function TO32Collection.GetEditorCaption : string;
-begin
- Result := 'Editing ' + ClassName;
- if Assigned(FOnGetEditorCaption) then
- FOnGetEditorCaption(Result);
-end;
-
-function TO32Collection.Add : TO32CollectionItem;
-begin
- Result := TO32CollectionItem(inherited Add);
- if ItemEditor <> nil then
- SendMessage(ItemEditor.Handle, OM_PROPCHANGE, 0, 0);
-end;
-
-{$IFNDEF VERSION4}
-function TO32Collection.Insert(Index: Integer): TO32CollectionItem;
-var
- I: Integer;
-begin
- result := Add;
- for I := Index to Count - 2 do
- Items[I].Index := I + 1;
- Items[Count - 1].Index := Index;
-end;
-{$ENDIF}
-
-function TO32Collection.GetItem(Index : Integer) : TO32CollectionItem;
-begin
- Result := TO32CollectionItem(inherited GetItem(Index));
-end;
-
-function TO32Collection.GetOwner: TPersistent;
-begin
- result := FOwner;
-end;
-
-procedure TO32Collection.SetItem(Index : Integer; Value : TO32CollectionItem);
-begin
- inherited SetItem(Index, Value);
-end;
-
-function TO32Collection.ItemByName(const Name : string) : TO32CollectionItem;
-var
- i : Integer;
-begin
- for i := 0 to pred(Count) do
- if Item[i].Name = Name then begin
- Result := Item[i];
- exit;
- end;
- Result := nil;
-end;
-
-procedure TO32Collection.Loaded;
-begin
- InLoaded := True;
- try
- Changed;
- finally
- InLoaded := False;
- end;
- IsLoaded := True;
-end;
-
-function TO32Collection.ParentForm : TForm;
-var
- Temp : TObject;
-begin
- Temp := GetOwner;
- while (Temp <> nil) and not (Temp is TForm) do
- Temp := TComponent(Temp).Owner;
- Result := TForm(Temp);
-end;
-
-{End - TO32Collection }
-
-{===== TOvcCollectionStreamer ========================================}
-function TOvcCollectionStreamer.CollectionFromType(Component : TComponent) : TOvcCollection;
-var
- I : Integer;
-begin
- for I := 0 to pred(FCollectionList.Count) do
- if Component is TOvcCollection(FCollectionList[I]).ItemClass then begin
- Result := TOvcCollection(FCollectionList[I]);
- exit;
- end;
- raise Exception.Create(GetOrphStr(SCCollectionNotFound));
-end;
-
-constructor TOvcCollectionStreamer.Create(AOwner : TComponent);
-begin
- inherited Create;
-
- FOwner := AOwner;
- FCollectionList := TList.Create;
-end;
-
-destructor TOvcCollectionStreamer.Destroy;
-begin
- FCollectionList.Free;
- FCollectionList := nil;
-
- inherited Destroy;
-end;
-
-procedure TOvcCollectionStreamer.GetChildren(Proc: TGetChildProc; Root : TComponent);
-var
- I,J: Integer;
-begin
- for I := 0 to pred(FCollectionList.Count) do
- with TOvcCollection(FCollectionList[I]) do
- if Stored then
- for J := 0 to Count - 1 do
- Proc(Item[J]);
-end;
-
-procedure TOvcCollectionStreamer.Loaded;
-var
- I : Integer;
-begin
- for I := 0 to pred(FCollectionList.Count) do
- TOvcCollection(FCollectionList[I]).Loaded;
-end;
-
-function DefaultController : TOvcController;
-begin
- if FDefaultController = nil then
- FDefaultController := TOvcController.Create(nil);
- Result := FDefaultController;
-end;
-
-initialization
- {register the attached label class}
- if Classes.GetClass(TOvcAttachedLabel.ClassName) = nil then
- Classes.RegisterClass(TOvcAttachedLabel);
-{$IFDEF LCL}
- {$I ovcbase.lrs}
-{$ENDIF}
-finalization
- FDefaultController.Free;
- FDefaultController := nil;
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/d5/d5d5815426f3ded1dbb35b7e7c08c92517016c31.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/d5/d5d5815426f3ded1dbb35b7e7c08c92517016c31.svn-base
deleted file mode 100644
index 0f024016..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/pristine/d5/d5d5815426f3ded1dbb35b7e7c08c92517016c31.svn-base and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/d8/d8713e806733fd77fa2708792eb5566bd594a319.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/d8/d8713e806733fd77fa2708792eb5566bd594a319.svn-base
deleted file mode 100644
index 5ef1ff77..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/d8/d8713e806733fd77fa2708792eb5566bd594a319.svn-base
+++ /dev/null
@@ -1,200 +0,0 @@
-{*********************************************************}
-{* OVCCOLOR.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 ovccolor;
- {-Color selection class}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, {$ENDIF} Classes, Graphics;
-
-type
- TOvcColors = class(TPersistent)
- {.Z+}
- protected {private}
- {property variables}
- FBackColor : TColor; {background color}
- FTextColor : TColor; {text or font color}
- FUseDefault : Boolean; {true to use defaults}
-
- {event variables}
- FOnColorChange : TNotifyEvent;
-
- {internal variables}
- cDefBackColor : TColor; {default background}
- cDefTextColor : TColor; {default text color}
-
- {property methods}
- procedure SetBackColor(Value: TColor);
- {-set the color used for the background}
- procedure SetTextColor(Value: TColor);
- {-set the color used for the foreground}
- procedure SetUseDefault(Value: Boolean);
- {-set the flag to reset colors to parent default values}
-
- procedure ReadUseDefault(Reader : TReader);
- {-read the UseDefault property. for backward compatibility only}
-
- protected
- procedure DefineProperties(Filer : TFiler);
- override;
-
- procedure DoOnColorChange;
- {-notify onwing object that a color has changed}
- dynamic;
-
- procedure ResetToDefaultColors;
- {-assign default color values}
- dynamic;
-
- public
- procedure Assign(Source : TPersistent);
- override;
- constructor Create(FG, BG : TColor);
- virtual;
- {.Z-}
-
- property OnColorChange : TNotifyEvent
- read FOnColorChange
- write FOnColorChange;
-
- published
- property BackColor : TColor
- read FBackColor
- write SetBackColor;
-
- property TextColor : TColor
- read FTextColor
- write SetTextColor;
-
- property UseDefault : Boolean
- read FUseDefault
- write SetUseDefault
- stored False;
- end;
-
-
-implementation
-
-
-{*** TOvcColors ***}
-
-procedure TOvcColors.Assign(Source : TPersistent);
-var
- C : TOvcColors absolute Source;
-begin
- if (Source <> nil) and (Source is TOvcColors) then begin
- BackColor := C.BackColor;
- TextColor := C.TextColor;
- end else
- inherited Assign(Source);
-end;
-
-constructor TOvcColors.Create(FG, BG : TColor);
-begin
- inherited Create;
-
- cDefBackColor := BG;
- cDefTextColor := FG;
- FUseDefault := True;
-
- {initialize to these colors}
- ResetToDefaultColors;
-end;
-
-procedure TOvcColors.DefineProperties(Filer : TFiler);
-begin
- inherited DefineProperties(Filer);
- {define a UseDefault property for compatibility with eariler versions}
- Filer.DefineProperty('UseDefault', ReadUseDefault, nil, False);
-end;
-
-procedure TOvcColors.DoOnColorChange;
- {-notify onwing object that a color has changed}
-begin
- if Assigned(FOnColorChange) then
- FOnColorChange(Self);
-end;
-
-procedure TOvcColors.ReadUseDefault(Reader : TReader);
-begin
- {read property and discard it}
- Reader.ReadBoolean;
-end;
-
-procedure TOvcColors.ResetToDefaultColors;
- {-obtain default color values}
-begin
- FBackColor := cDefBackColor;
- FTextColor := cDefTextColor;
-end;
-
-procedure TOvcColors.SetBackColor(Value: TColor);
- {-set the color used for the background}
-begin
- if Value <> FBackColor then begin
- if Value <> cDefBackColor then
- FUseDefault := False;
- FBackColor := Value;
- DoOnColorChange;
- end;
-end;
-
-procedure TOvcColors.SetTextColor(Value: TColor);
- {-set the color used for the foreground}
-begin
- if Value <> FTextColor then begin
- if Value <> cDefTextColor then
- FUseDefault := False;
- FTextColor := Value;
- DoOnColorChange;
- end;
-end;
-
-procedure TOvcColors.SetUseDefault(Value: Boolean);
- {-set the flag to reset colors to parent default values}
-begin
- FUseDefault := Value;
- if FUseDefault then begin
- ResetToDefaultColors; {assign default values}
- DoOnColorChange;
- end;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/d8/d8d9cba5626682b71ed0a152643d41617dc47208.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/d8/d8d9cba5626682b71ed0a152643d41617dc47208.svn-base
deleted file mode 100644
index 6960f850..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/d8/d8d9cba5626682b71ed0a152643d41617dc47208.svn-base
+++ /dev/null
@@ -1,70 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, ovcbase, ovcvlb, StdCtrls;
-
-type
- TForm1 = class(TForm)
- OvcVirtualListBox1: TOvcVirtualListBox;
- Label1: TLabel;
- procedure FormCreate(Sender: TObject);
- procedure OvcVirtualListBox1GetItem(Sender: TObject; Index: Integer;
- var ItemString: String);
- procedure OvcVirtualListBox1DblClick(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.dfm}
-{$ENDIF}
-
-procedure TForm1.FormCreate(Sender: TObject);
-var
- TabStops : array[0..1] of Integer;
-begin
- TabStops[0] := 150;
- TabStops[1] := 300;
- OvcVirtualListBox1.SetTabStops(TabStops);
-
- OvcVirtualListBox1.Header := 'Name column'#9'Address column'#9'City column';
-
- if OvcVirtualListBox1.IntegralHeight then
- OvcVirtualListBox1.ClientHeight :=
- (OvcVirtualListBox1.ClientHeight div OvcVirtualListBox1.RowHeight) *
- OvcVirtualListBox1.RowHeight;
- {Since RowHeight might have changed based on font used by current
- platform, make sure height still integral.}
-end;
-
-procedure TForm1.OvcVirtualListBox1GetItem(Sender: TObject; Index: Integer;
- var ItemString: String);
-begin
- ItemString := 'Item ' + IntToStr(Index) + ' name'#9 +
- 'Item ' + IntToStr(Index) + ' address'#9 +
- 'Item ' + IntToStr(Index) + ' city';
-end;
-
-procedure TForm1.OvcVirtualListBox1DblClick(Sender: TObject);
-begin
- Label1.Caption :=
- 'You double-clicked item ' + IntToStr(OvcVirtualListBox1.ItemIndex);
-end;
-
-initialization
-{$IFDEF LCL}
-{$I unit1.lrs} {Include form's resource file}
-{$ENDIF}
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/d8/d8ef53d78e7ec9f66c3b4670cb1b8df12956527a.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/d8/d8ef53d78e7ec9f66c3b4670cb1b8df12956527a.svn-base
deleted file mode 100644
index d8c80390..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/d8/d8ef53d78e7ec9f66c3b4670cb1b8df12956527a.svn-base
+++ /dev/null
@@ -1,319 +0,0 @@
-{*********************************************************}
-{* O32PVLDR.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} {-Defines}
-
-unit o32pvldr;
- {Paradox Mask Validator}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, MyMisc, {$ENDIF} O32Vldtr, Classes;
-
-const
- ParadoxMaskCount = 8;
- ParadoxMaskLength = 25;
-
- {Sample Paradox Masks}
- ParadoxMaskLookup : array [1..ParadoxMaskCount] of string =
- ('!\(999\)000-0000;1;_ Phone (415)555-1212',
- '!99999;1;_ Extension 15450',
- '000\-00\-0000;1;_ Social Security 555-55-5555',
- '00000;1;_ Short Zip Code 90504',
- '00000\-9999;1;_ Long Zip Code 90504-0000',
- '!99/99/00;1;_ Date 06/27/01',
- '!90:00:00>LL;1;_ Long Time 09:05:15PM',
- '!90:00;1;_ Short Time 13:45');
-
-type
-{class - TO32ParadoxValidator}
- TO32ParadoxValidator = class(TO32BaseValidator)
- protected {private}
- FMaskBlank: Char;
-
- procedure SetInput(const Value: string); override;
- procedure SetMask(const Value: string); override;
- function GetValid: Boolean; override;
- function GetSampleMasks: TStringList; override;
- function Validate(const Value: string; var Pos: Integer): Boolean;
- function DoValidateChar(NewChar: Char;
- MaskOffset: Integer): Boolean;
- function ValidateChar(NewChar: Char;
- Offset: Integer): Boolean;
- function FindLiteralChar(MaskOffset: Integer; InChar: Char): Integer;
- public
- constructor Create(AOwner: TComponent); override;
- function IsValid: Boolean; override;
- property Valid;
- property Input;
- published
- {Properties}
- property Mask;
- {Events}
- property BeforeValidation;
- property AfterValidation;
- property OnValidationError;
- end;
-
-implementation
-
-uses
- {$IFNDEF LCL} Mask, {$IFDEF VERSION6} MaskUtils, {$ENDIF} {$ELSE} MaskEdit, {$ENDIF}
- SysUtils, O32VlReg;
-
-// In the original Orpheus, TurboPower had just copied the following
-// functions from the VCL Mask unit in order to use them with Delphi 5
-// and earlier: MaskGetCharType, MaskOffsetToOffset, OffsetToMaskOffset,
-// MaskIntlLiteralToChar, and MaskGetCurrentDirectives.
-// With Delphi 6, these functions are now in MaskUtils unit and in the
-// interfaces section. However, these functions and the constants they
-// reference are not currently available with the LCL, so for now the
-// Paradox validator is not available for LCL.
-
-
-{===== TO32ParadoxValidator ==========================================}
-
-constructor TO32ParadoxValidator.Create(AOwner: TComponent);
-begin
- inherited;
- FMaskBlank := DefaultBlank;
-end;
-{=====}
-
-function TO32ParadoxValidator.GetValid: Boolean;
-begin
- result := IsValid;
-end;
-{=====}
-
-function TO32ParadoxValidator.GetSampleMasks: TStringList;
-var
- I : Integer;
-begin
- { Set the length of the mask portion of the string }
- FSampleMaskLength := ParadoxMaskLength;
-
- FSampleMasks.Clear;
-
- { Load the string list }
- for I := 1 to ParadoxMaskCount do
- FSampleMasks.Add(ParadoxMaskLookup[I]);
- result := FSampleMasks;
-end;
-{=====}
-
-function TO32ParadoxValidator.IsValid: Boolean;
-var
- ErrorPos: Integer;
-begin
- DoBeforeValidation;
-
- {assume the worst}
- FValid := false;
-
- {Set up validation and execute it against the input}
- FValid := Validate(FInput, ErrorPos);
-
- DoAfterValidation;
-
- if not FValid then begin
- DoOnError(self, 'Validation Error Encountered at string position '
- + IntToStr(ErrorPos));
- end;
-
- result := FValid;
-end;
-{=====}
-
-procedure TO32ParadoxValidator.SetInput(const Value: string);
-begin
- if FInput <> Value then
- FInput := Value;
-end;
-{=====}
-
-procedure TO32ParadoxValidator.SetMask(const Value: string);
-begin
- if FMask <> Value then
- FMask := Value;
-end;
-{=====}
-
-function TO32ParadoxValidator.Validate(const Value: string; var Pos: Integer): Boolean;
-var
- I : Integer;
-begin
- result := true;
- Pos := 0;
- for I := 1 to Length(Value) do begin
- if not ValidateChar(Value[I], I) then begin
- result := false;
- Pos := I;
- Exit;
- end;
- end;
-end;
-{=====}
-
-function TO32ParadoxValidator.ValidateChar(NewChar: Char;
- Offset: Integer): Boolean;
-var
- MaskOffset: Integer;
-begin
- Result := True;
- if FMask <> '' then
- begin
- Result := False;
- MaskOffset := OffsetToMaskOffset(FMask, Offset);
- if MaskOffset >= 0 then
- begin
- Result := DoValidateChar(NewChar, MaskOffset);
- end;
- end;
-end;
-{=====}
-
-function TO32ParadoxValidator.FindLiteralChar(MaskOffset: Integer;
- InChar: Char): Integer;
-var
- CType: TMaskCharType;
- LitChar: Char;
-begin
- Result := -1;
- while MaskOffset < Length(Mask) do
- begin
- Inc(MaskOffset);
- CType := MaskGetCharType(Mask, MaskOffset);
- if CType in [mcLiteral, mcIntlLiteral] then
- begin
- LitChar := Mask[MaskOffset];
- if CType = mcIntlLiteral then
- LitChar := MaskIntlLiteralToChar(LitChar);
- if LitChar = InChar then
- Result := MaskOffset;
- Exit;
- end;
- end;
-end;
-{=====}
-
-function TO32ParadoxValidator.DoValidateChar(NewChar: Char;
- MaskOffset: Integer): Boolean;
-var
- Dir: TMaskDirectives;
- Str: string;
- CType: TMaskCharType;
-
- function IsKatakana(const Chr: Byte): Boolean;
- begin
- Result := (SysLocale.PriLangID = LANG_JAPANESE) and (Chr in [$A1..$DF]);
- end;
-
- function TestChar(NewChar: Char): Boolean;
- var
- Offset: Integer;
- begin
- Offset := MaskOffsetToOffset(FMask, MaskOffset);
- Result := not ((MaskOffset < Length(FMask)) and
- (UpCase(FMask[MaskOffset]) = UpCase(Mask[MaskOffset+1]))) or
- (ByteType(FMask, Offset) = mbTrailByte) or
- (ByteType(FMask, Offset+1) = mbLeadByte);
- end;
-
-begin
- Result := True;
- CType := MaskGetCharType(FMask, MaskOffset);
- if not (CType in [mcLiteral, mcIntlLiteral]) then begin
- Dir := MaskGetCurrentDirectives(FMask, MaskOffset);
- case FMask[MaskOffset] of
- mMskNumeric, mMskNumericOpt:
- begin
- if not ((NewChar >= '0') and (NewChar <= '9')) then
- Result := False;
- end;
- mMskNumSymOpt:
- begin
- if not (((NewChar >= '0') and (NewChar <= '9')) or
- (NewChar = ' ') or(NewChar = '+') or(NewChar = '-')) then
- Result := False;
- end;
- mMskAscii, mMskAsciiOpt:
- begin
- if (NewChar in LeadBytes) and TestChar(NewChar) then
- begin
- Result := False;
- Exit;
- end;
- if IsCharAlpha(NewChar) then
- begin
- Str := ' ';
- Str[1] := NewChar;
- if (mdUpperCase in Dir) then
- Str := AnsiUpperCase(Str)
- else if mdLowerCase in Dir then
- Str := AnsiLowerCase(Str);
- end;
- end;
- mMskAlpha, mMskAlphaOpt, mMskAlphaNum, mMskAlphaNumOpt:
- begin
- if (NewChar in LeadBytes) then
- begin
- if TestChar(NewChar) then
- Result := False;
- Exit;
- end;
- Str := ' ';
- Str[1] := NewChar;
- if IsKatakana(Byte(NewChar)) then
- Exit;
- if not IsCharAlpha(NewChar) then
- begin
- Result := False;
- if ((FMask[MaskOffset] = mMskAlphaNum) or
- (FMask[MaskOffset] = mMskAlphaNumOpt)) and
- (IsCharAlphaNumeric(NewChar)) then
- Result := True;
- end
- else if mdUpperCase in Dir then
- Str := AnsiUpperCase(Str)
- else if mdLowerCase in Dir then
- Str := AnsiLowerCase(Str);
- end;
- end;
- end;
-end;
-
-initialization
- RegisterValidator(TO32ParadoxValidator);
-
-finalization
- UnRegisterValidator(TO32ParadoxValidator);
-
-end.
-
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/db/db5e42160bef014bf4cff34e28eed277593916be.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/db/db5e42160bef014bf4cff34e28eed277593916be.svn-base
deleted file mode 100644
index 43c0c3c7..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/db/db5e42160bef014bf4cff34e28eed277593916be.svn-base
+++ /dev/null
@@ -1,21 +0,0 @@
-{ This file was automatically created by Lazarus. Do not edit!
-This source is only used to compile and install the package.
- }
-
-unit Orpheus;
-
-interface
-
-uses
- MyOvcReg, LazarusPackageIntf;
-
-implementation
-
-procedure Register;
-begin
- RegisterUnit('MyOvcReg', @MyOvcReg.Register);
-end;
-
-initialization
- RegisterPackage('Orpheus', @Register);
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/dd/dd1a64450ebca03615c9a688f05ca1bc92d69ed1.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/dd/dd1a64450ebca03615c9a688f05ca1bc92d69ed1.svn-base
deleted file mode 100644
index bea33cf0..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/dd/dd1a64450ebca03615c9a688f05ca1bc92d69ed1.svn-base
+++ /dev/null
@@ -1,42 +0,0 @@
-LazarusResources.Add('TForm1','FORMDATA',[
- 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#192#0#3'Top'#2'r'#5'Width'#3'('#3#6'Heigh'
- +'t'#3#190#1#7'Caption'#6#5'Form1'#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7
- +#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245
- +#10'Font.Style'#11#0#8'Position'#7#14'poScreenCenter'#8'OnCreate'#7#10'FormC'
- +'reate'#9'OnDestroy'#7#11'FormDestroy'#13'PixelsPerInch'#2'`'#0#9'TOvcTable'
- +#9'OvcTable1'#4'Left'#2#16#3'Top'#2#16#5'Width'#3#9#3#6'Height'#3#153#1#7'An'
- +'chors'#11#6'akLeft'#5'akTop'#7'akRight'#8'akBottom'#0#5'Color'#7#8'clWindow'
- +#10'Controller'#7#14'OvcController1!GridPenSet.NormalGrid.NormalColor'#7#11
- +'clBtnShadow'#27'GridPenSet.NormalGrid.Style'#7#5'psDot'#28'GridPenSet.Norma'
- +'lGrid.Effect'#7#6'geBoth!GridPenSet.LockedGrid.NormalColor'#7#11'clBtnShado'
- +'w'#27'GridPenSet.LockedGrid.Style'#7#7'psSolid'#28'GridPenSet.LockedGrid.Ef'
- +'fect'#7#4'ge3D&GridPenSet.CellWhenFocused.NormalColor'#7#7'clBlack GridPenS'
- +'et.CellWhenFocused.Style'#7#7'psSolid!GridPenSet.CellWhenFocused.Effect'#7#6
- +'geBoth(GridPenSet.CellWhenUnfocused.NormalColor'#7#7'clBlack"GridPenSet.Cel'
- +'lWhenUnfocused.Style'#7#6'psDash#GridPenSet.CellWhenUnfocused.Effect'#7#6'g'
- +'eBoth'#14'LockedRowsCell'#7#13'OvcTCColHead1'#7'Options'#11#16'otoNoRowResi'
- +'zing'#16'otoNoColResizing'#13'otoTabToArrow'#15'otoEnterToArrow'#16'otoAlwa'
- +'ysEditing'#14'otoNoSelection'#13'otoThumbTrack'#0#8'TabOrder'#2#0#13'OnGetC'
- +'ellData'#7#20'OvcTable1GetCellData'#8'CellData'#1#6#19'Form1.OvcTCColHead1'
- +#6#19'Form1.OvcTCRowHead1'#6#18'Form1.OvcTCString1'#6#16'Form1.OvcTCMemo1'#6
- +#20'Form1.OvcTCCheckBox1'#6#20'Form1.OvcTCComboBox1'#6#18'Form1.OvcTCBitMap1'
- +#0#7'RowData'#1#2'#'#0#7'ColData'#1#2'x'#8#9#6#19'Form1.OvcTCRowHead1'#2'd'#8
- +#9#6#18'Form1.OvcTCString1'#3#150#0#8#9#6#16'Form1.OvcTCMemo1'#2'x'#8#9#6#20
- +'Form1.OvcTCCheckBox1'#3#160#0#8#9#6#20'Form1.OvcTCComboBox1'#2'd'#8#9#6#18
- +'Form1.OvcTCBitMap1'#0#0#0#13'TOvcTCColHead'#13'OvcTCColHead1'#16'Headings.S'
- +'trings'#1#6#13'TOvcTCRowHead'#6#12'TOvcTCString'#6#10'TOvcTCMemo'#6#14'TOvc'
- +'TCCheckBox'#6#14'TOvcTCComboBox'#6#12'TOvcTCBitmap'#0#11'ShowLetters'#8#6'A'
- +'djust'#7#9'otaCenter'#5'Table'#7#9'OvcTable1'#4'Left'#2'0'#0#0#13'TOvcTCRow'
- +'Head'#13'OvcTCRowHead1'#6'Adjust'#7#9'otaCenter'#5'Table'#7#9'OvcTable1'#4
- +'Left'#2'P'#0#0#12'TOvcTCString'#12'OvcTCString1'#20'AutoAdvanceLeftRight'#9
- +#5'Table'#7#9'OvcTable1'#4'Left'#3#144#0#0#0#10'TOvcTCMemo'#10'OvcTCMemo1'#5
- +'Table'#7#9'OvcTable1'#4'Left'#3#8#1#0#0#14'TOvcTCCheckBox'#14'OvcTCCheckBox'
- +'1'#6'Adjust'#7#9'otaCenter'#20'CellGlyphs.IsDefault'#9#21'CellGlyphs.GlyphC'
- +'ount'#2#3#27'CellGlyphs.ActiveGlyphCount'#2#2#5'Table'#7#9'OvcTable1'#4'Lef'
- +'t'#3#128#1#0#0#14'TOvcTCComboBox'#14'OvcTCComboBox1'#5'Style'#7#14'csDropDo'
- +'wnList'#5'Table'#7#9'OvcTable1'#8'OnChange'#7#20'OvcTCComboBox1Change'#4'Le'
- +'ft'#3#0#2#0#0#12'TOvcTCBitMap'#12'OvcTCBitMap1'#6'Adjust'#7#12'otaTopCenter'
- +#5'Table'#7#9'OvcTable1'#4'Left'#3'p'#2#0#0#14'TOvcController'#14'OvcControl'
- +'ler1'#23'EntryCommands.TableList'#1#6#7'Default'#9#1#0#6#8'WordStar'#8#1#0#6
- +#4'Grid'#8#1#0#0#5'Epoch'#3#208#7#4'Left'#2#16#0#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/df/df7f4d63fcfb2cafe5ac8da54d4e30491f08310b.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/df/df7f4d63fcfb2cafe5ac8da54d4e30491f08310b.svn-base
deleted file mode 100644
index ea78150c..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/df/df7f4d63fcfb2cafe5ac8da54d4e30491f08310b.svn-base
+++ /dev/null
@@ -1,290 +0,0 @@
-{*********************************************************}
-{* OVCLABEL.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 ovclbl2;
- {-direction picker component}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- Classes, Controls, Graphics, OvcBase, OvcData, OvcMisc;
-
-type
- TOvcCustomDirectionPicker = class(TOvcGraphicControl)
- protected {private}
- {property variables}
- FDirection : Integer;
- FNumDirections : Integer;
- FSelectedBitmap : TBitmap;
- FShowCenter : Boolean;
- FDirectionBitmap : TBitmap;
-
- {event variables}
- FOnChange : TNotifyEvent;
-
- {property methods}
- procedure SetDirection(Value : Integer);
- procedure SetSelectedBitmap(Value : TBitmap);
- procedure SetNumDirections(Value : Integer);
- procedure SetShowCenter(Value : Boolean);
- procedure SetDirectionBitmap(Value : TBitmap);
-
- protected
- procedure MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
- override;
- procedure Paint;
- override;
-
- property Direction : Integer
- read FDirection write SetDirection default 0;
- property NumDirections : Integer
- read FNumDirections write SetNumDirections default 8;
- property SelectedBitmap : TBitmap
- read FSelectedBitmap write SetSelectedBitmap;
- property ShowCenter : Boolean
- read FShowCenter write SetShowCenter default True;
- property DirectionBitmap : TBitmap
- read FDirectionBitmap write SetDirectionBitmap;
-
- property OnChange : TNotifyEvent
- read FOnChange write FOnChange;
-
- public
- constructor Create(AComponent : TComponent);
- override;
- destructor Destroy;
- override;
- end;
-
- TOvcDirectionPicker = class(TOvcCustomDirectionPicker)
- published
- property Direction;
- property Enabled;
- property SelectedBitmap;
- property NumDirections;
- property ShowCenter;
- property DirectionBitmap;
-
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- end;
-
-
-implementation
-
-
-const
- DToR = Pi / 180;
-
-constructor TOvcCustomDirectionPicker.Create(AComponent : TComponent);
-begin
- inherited Create(AComponent);
-
- ControlStyle := [csClickEvents, csDoubleClicks];
-
- Width := 50;
- Height := 50;
-
- FDirection := -1;
- FNumDirections := 8;
- FShowCenter := True;
-
- {create and load the bitmap images}
- {resource are in ovcreg.rc}
- FDirectionBitmap := TBitmap.Create;
-{$IFNDEF LCL}
- FDirectionBitmap.Handle := LoadBitmap(HInstance, 'ORBLUEDOT');
-{$ELSE}
- FDirectionBitmap.LoadFromLazarusResource('ORBLUEDOT');
-{$ENDIF}
- FSelectedBitmap := TBitmap.Create;
-{$IFNDEF LCL}
- FSelectedBitmap.Handle := LoadBitmap(HInstance, 'ORREDDOT');
-{$ELSE}
- FSelectedBitmap.LoadFromLazarusResource('ORREDDOT');
-{$ENDIF}
-end;
-
-destructor TOvcCustomDirectionPicker.Destroy;
-begin
- {destroy bitmaps}
- FDirectionBitmap.Free;
- FDirectionBitmap := nil;
- FSelectedBitmap.Free;
- FSelectedBitmap := nil;
-
- inherited Destroy;
-end;
-
-procedure TOvcCustomDirectionPicker.MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
-var
- I : Integer;
- BW : Integer;
- Angle : Extended;
- Diameter : Integer;
- Radius : Integer;
- X1, Y1 : Integer;
- Distance : Integer;
- BestDirection : Integer;
- BestDistance : Integer;
-begin
- inherited MouseDown(Button, Shift, X, Y);
-
- if (Button = mbLeft) and Enabled then begin
- BW := MaxI(FDirectionBitmap.Width, FDirectionBitmap.Height);
- Diameter := MinI(Height, Width)-2*BW;
- Radius := Diameter div 2;
-
- if FShowCenter then begin
- {initialize at center (-1)}
- BestDistance := Round(Sqrt(Sqr(Radius+BW-X) + Sqr(Radius+BW-Y)));
- BestDirection := -1;
- end else begin
- BestDistance := Width*2;
- BestDirection := FDirection;
- end;
-
- for I := 0 to Pred(FNumDirections) do begin
- Angle := (I * (360/FNumDirections) + 90) * DToR;
- X1 := Round(Radius * (1-Cos(Angle))) + BW;
- Y1 := Round(Radius * (1-Sin(Angle))) + BW;
- Distance := Round(Sqrt(Sqr(X1-X) + Sqr(Y1-Y)));
- if Distance < BestDistance then begin
- BestDistance := Distance;
- BestDirection := I;
- end;
- end;
-
- Direction := BestDirection;
- end;
-end;
-
-procedure TOvcCustomDirectionPicker.Paint;
-var
- I : Integer;
- BW : Integer;
- BW2 : Integer;
- Angle : Extended;
- Diameter : Integer;
- Radius : Integer;
- X, Y : Integer;
-begin
- BW := MaxI(FDirectionBitmap.Width, FDirectionBitmap.Height);
- Diameter := MinI(Height, Width)-2*BW;
- Radius := Diameter div 2;
-
- if FShowCenter then
- Canvas.Draw(Radius+BW, Radius+BW, FDirectionBitmap);
- for I := 0 to Pred(FNumDirections) do begin
- Angle := (I * (360/FNumDirections) + 90) * DToR;
- X := Round(Radius * (1-Cos(Angle)));
- Y := Round(Radius * (1-Sin(Angle)));
- Canvas.Draw(X+BW, Y+BW, FDirectionBitmap);
- end;
-
- {draw the dot for the selected direction}
- BW2 := (MaxI(FSelectedBitmap.Width, FSelectedBitmap.Height)-BW) div 2; {adjustment for larger bitmap}
- if FDirection = -1 then begin
- if FShowCenter then
- Canvas.Draw(Radius+BW-BW2, Radius+BW-BW2, FSelectedBitmap)
- end else begin
- Angle := (FDirection * (360/FNumDirections) + 90) * DToR;
- X := Round(Radius * (1-Cos(Angle)));
- Y := Round(Radius * (1-Sin(Angle)));
- Canvas.Draw(X+BW-BW2, Y+BW-BW2, FSelectedBitmap);
- end;
-end;
-
-procedure TOvcCustomDirectionPicker.SetDirection(Value : Integer);
-begin
- if csLoading in ComponentState then begin
- FDirection := Value;
- Exit;
- end;
-
- if (Value <> FDirection) and (Value >= -1) and (Value < FNumDirections) then begin
- FDirection := Value;
- Invalidate;
- if Assigned(FOnChange) then
- FOnChange(Self);
- end;
-end;
-
-procedure TOvcCustomDirectionPicker.SetSelectedBitmap(Value : TBitmap);
-begin
- if Assigned(Value) then
- FSelectedBitmap.Assign(Value)
- else
- FSelectedBitmap.ReleaseHandle;
- Invalidate;
-end;
-
-procedure TOvcCustomDirectionPicker.SetNumDirections(Value : Integer);
-begin
- if (Value <> FNumDirections) and (Value >= 2) then begin
- FNumDirections := Value;
- Invalidate;
- end;
-end;
-
-procedure TOvcCustomDirectionPicker.SetShowCenter(Value : Boolean);
-begin
- if Value <> FShowCenter then begin
- FShowCenter := Value;
- Invalidate;
- end;
-end;
-
-procedure TOvcCustomDirectionPicker.SetDirectionBitmap(Value : TBitmap);
-begin
- if Assigned(Value) then
- FDirectionBitmap.Assign(Value)
- else
- FDirectionBitmap.ReleaseHandle;
- Invalidate;
-end;
-
-
-initialization
- if Classes.GetClass(TOvcDirectionPicker.ClassName) = nil then
- Classes.RegisterClass(TOvcDirectionPicker);
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/e0/e0b8b8024691610ed508962667322f8b9ef3e9b4.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/e0/e0b8b8024691610ed508962667322f8b9ef3e9b4.svn-base
deleted file mode 100644
index afd2acd4..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/e0/e0b8b8024691610ed508962667322f8b9ef3e9b4.svn-base
+++ /dev/null
@@ -1,584 +0,0 @@
-{*********************************************************}
-{* OVCTCBEF.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 ovctcbef;
- {-Orpheus Table Cell - base entry field type}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, LclType, MyMisc, {$ENDIF}
- SysUtils, Classes, Graphics, Controls, Forms,
- OvcBase, OvcCmd, OvcEF, OvcCaret, OvcTCmmn, OvcTCell, OvcTable, OvcTCStr;
-
-type
- TOvcTCBaseEntryField = class(TOvcTCBaseString)
- protected {private}
- FEdit : TOvcBaseEntryField;
- FEditDisplay : TOvcBaseEntryField;
-
- FOnError : TValidationErrorEvent;
- FOnUserCommand : TUserCommandEvent;
- FOnUserValidation : TUserValidationEvent;
-
- CopyOfData : pointer;
- CopyOfDataSize : Integer;
-
- protected
- function GetCaretIns : TOvcCaret;
- function GetCaretOvr : TOvcCaret;
- function GetControlCharColor : TColor;
- function GetDataSize : integer;
- function GetDecimalPlaces : byte;
- function GetOptions : TOvcEntryFieldOptions;
- function GetEFColors : TOvcEFColors;
- function GetMaxLength : word;
- function GetModified : boolean;
- function GetPadChar : AnsiChar;
- function GetPasswordChar : AnsiChar;
- function GetRangeHi : string;
- function GetRangeLo : string;
- function GetTextMargin : integer;
-
- procedure SetCaretIns(CI : TOvcCaret);
- procedure SetCaretOvr(CO : TOvcCaret);
- procedure SetControlCharColor(CCC : TColor);
- procedure SetDecimalPlaces(DP : byte);
- procedure SetEFColors(Value : TOvcEFColors);
- procedure SetMaxLength(ML : word);
- procedure SetOptions(Value : TOvcEntryFieldOptions);
- procedure SetPadChar(PC : AnsiChar);
- procedure SetPasswordChar(PC : AnsiChar);
- procedure SetRangeHi(const RI : string);
- procedure SetRangeLo(const RL : string);
- procedure SetTextMargin(TM : integer);
-
- procedure DefineProperties(Filer: TFiler); override;
-
- procedure tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer); override;
-
- {properties for entry fields, to be exposed by descendants}
- property CaretIns : TOvcCaret
- read GetCaretIns write SetCaretIns;
-
- property CaretOvr : TOvcCaret
- read GetCaretOvr write SetCaretOvr;
-
- property ControlCharColor : TColor
- read GetControlCharColor write SetControlCharColor;
-
- property DecimalPlaces : byte
- read GetDecimalPlaces write SetDecimalPlaces;
-
- property EFColors : TOvcEFColors
- read GetEFColors write SetEFColors;
-
- property MaxLength : word
- read GetMaxLength write SetMaxLength;
-
- property Options : TOvcEntryFieldOptions
- read GetOptions write SetOptions;
-
- property PadChar : AnsiChar
- read GetPadChar write SetPadChar;
-
- property PasswordChar : AnsiChar
- read GetPasswordChar write SetPasswordChar;
-
- property RangeHi : string
- read GetRangeHi write SetRangeHi
- stored false;
-
- property RangeLo : string
- read GetRangeLo write SetRangeLo
- stored false;
-
- property TextMargin : integer
- read GetTextMargin write SetTextMargin;
-
- {events}
- property OnError : TValidationErrorEvent
- read FOnError write FOnError;
-
- property OnUserCommand : TUserCommandEvent
- read FOnUserCommand write FOnUserCommand;
-
- property OnUserValidation : TUserValidationEvent
- read FOnUserValidation write FOnUserValidation;
-
- public
- constructor Create(AOwner : TComponent); override;
- destructor Destroy;
- override;
- function CreateEntryField(AOwner : TComponent) : TOvcBaseEntryField; virtual; abstract;
-
- function EditHandle : THandle; override;
- procedure EditHide; override;
- procedure EditMove(CellRect : TRect); override;
-
- function CanSaveEditedData(SaveValue : boolean) : boolean; override;
- procedure SaveEditedData(Data : pointer); override;
- procedure StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer); override;
- procedure StopEditing(SaveValue : boolean;
- Data : pointer); override;
-
- property DataSize : integer
- read GetDataSize;
-
- property Modified : boolean
- read GetModified;
-
- published
- property About;
- end;
-
-implementation
-
-uses
- Dialogs;
-
-type {for typecast to get around protected clause}
- TOvcBEF = class(TOvcBaseEntryField)
- public
- property CaretIns;
- property CaretOvr;
- property ControlCharColor;
- property DecimalPlaces;
- property EFColors;
- property MaxLength;
- property Options;
- property PadChar;
- property PasswordChar;
- property RangeHi;
- property RangeLo;
- property ShowHint;
- property TextMargin;
- end;
-
-{===TOvcTCBaseEntryField=============================================}
-constructor TOvcTCBaseEntryField.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
-
- FEdit := CreateEntryField(Self);
- FEdit.Visible := false;
-
- FEditDisplay := CreateEntryField(Self);
- FEditDisplay.Visible := false;
- end;
-
-destructor TOvcTCBaseEntryField.Destroy;
-begin
- if (CopyOfData <> nil) and (CopyOfDataSize > 0) then
- FreeMem(CopyOfData, CopyOfDataSize);
-
- inherited Destroy;
-end;
-
-{--------}
-function TOvcTCBaseEntryField.CanSaveEditedData(SaveValue : boolean) : boolean;
- begin
- Result := true;
- if Assigned(FEdit) then
- if SaveValue then
- with TOvcBEF(FEdit) do
- if Controller.ErrorPending then
- Result := false
- else
- Result := ValidateSelf
- else
- FEdit.Restore;
- end;
-{--------}
-function TOvcTCBaseEntryField.EditHandle : THandle;
- begin
- if Assigned(FEdit) then
- Result := FEdit.Handle
- else
- Result := 0;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.EditHide;
- begin
- if Assigned(FEdit) then
- with FEdit do
- begin
- SetWindowPos(FEdit.Handle, HWND_TOP,
- 0, 0, 0, 0,
- SWP_HIDEWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- end;
-
- end;
-{--------}
-procedure TOvcTCBaseEntryField.EditMove(CellRect : TRect);
- var
- EditHandle : HWND;
- begin
- if Assigned(FEdit) then
- begin
- EditHandle := FEdit.Handle;
- with CellRect do
- SetWindowPos(EditHandle, HWND_TOP,
- Left, Top, Right-Left, Bottom-Top,
- SWP_SHOWWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- InvalidateRect(EditHandle, nil, false);
- UpdateWindow(EditHandle);
-
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer);
- var
- S : ShortString;
- I : integer;
- begin
- if (Data = nil) then
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, Data)
- else
- begin
- FEditDisplay.Controller := TOvcTable(FTable).Controller;
- if (FEditDisplay.Controller = nil) then
- ShowMessage('NIL in tcPaint');
- FEditDisplay.Parent := FTable;
- SetWindowPos(FEditDisplay.Handle, HWND_TOP, 0, 0, 0, 0,
- SWP_HIDEWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- FEditDisplay.SetValue(Data^);
- S := Trim(FEditDisplay.DisplayString); // Inserted Trim
-(* TurboPower bug: this code trims string of white space, but in using I as
- index into string S doesn't check if I is in range of 1..Length(S),
- which can result in range-check error.
- I := 1;
- while (S[I] <= #32) do
- Inc(I);
- Delete(S, 1, I-1);
- I := Length(S);
- while (S[I] <= #32) do
- Dec(I);
- Delete(S, I+1, Length(S) - I);
-*)
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, @S);
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SaveEditedData(Data : pointer);
- begin
- if Assigned(Data) then
- begin
- FEdit.GetValue(CopyOfData^);
- Move(CopyOfData^, Data^, CopyOfDataSize);
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer);
- begin
- CopyOfDataSize := FEdit.DataSize;
- GetMem(CopyOfData, CopyOfDataSize);
- if (Data = nil) then
- FillChar(CopyOfData^, CopyOfDataSize, 0)
- else
- Move(Data^, CopyOfData^, CopyOfDataSize);
-
- with TOvcBEF(FEdit) do
- begin
- Parent := FTable;
- Font := CellAttr.caFont;
- Font.Color := CellAttr.caFontColor;
- Color := CellAttr.caColor;
- BorderStyle := bsNone;
- Ctl3D := false;
- case CellStyle of
- tesBorder : BorderStyle := bsSingle;
- tes3D : Ctl3D := true;
- end;{case}
- Left := CellRect.Left;
- Top := CellRect.Top;
- Width := CellRect.Right - CellRect.Left;
- Height := CellRect.Bottom - CellRect.Top;
- Hint := Self.Hint;
- ShowHint := Self.ShowHint;
- TabStop := false;
- Controller := TOvcTable(FTable).Controller;
- if (Controller = nil) then
- ShowMessage('NIL in StartEditing');
- SetValue(CopyOfData^);
- Visible := true;
-
- OnChange := Self.OnChange;
- OnClick := Self.OnClick;
- OnDblClick := Self.OnDblClick;
- OnDragDrop := Self.OnDragDrop;
- OnDragOver := Self.OnDragOver;
- OnEndDrag := Self.OnEndDrag;
- OnEnter := Self.OnEnter;
- OnError := Self.OnError;
- OnExit := Self.OnExit;
- OnKeyDown := Self.OnKeyDown;
- OnKeyPress := Self.OnKeyPress;
- OnKeyUp := Self.OnKeyUp;
- OnMouseDown := Self.OnMouseDown;
- OnMouseMove := Self.OnMouseMove;
- OnMouseUp := Self.OnMouseUp;
- OnUserCommand := Self.OnUserCommand;
- OnUserValidation := Self.OnUserValidation;
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.StopEditing(SaveValue : boolean;
- Data : pointer);
- begin
- if SaveValue and Assigned(Data) then
- begin
- FEdit.GetValue(CopyOfData^);
- Move(CopyOfData^, Data^, CopyOfDataSize);
- end;
- FreeMem(CopyOfData, CopyOfDataSize);
- CopyOfData := nil;
- CopyOfDataSize := 0;
- EditHide;
- end;
-{====================================================================}
-
-
-{===TOvcTCBaseEntryField property access=============================}
-procedure TOvcTCBaseEntryField.DefineProperties(Filer: TFiler);
- begin
- inherited DefineProperties(Filer);
- with Filer do
- begin
- DefineBinaryProperty('RangeHigh',
- TOvcBEF(FEdit).efReadRangeHi, TOvcBEF(FEdit).efWriteRangeHi, true);
- DefineBinaryProperty('RangeLow',
- TOvcBEF(FEdit).efReadRangeLo, TOvcBEF(FEdit).efWriteRangeLo, true);
- end;
- end;
-{--------}
-function TOvcTCBaseEntryField.GetOptions : TOvcEntryFieldOptions;
- begin
- if Assigned(FEdit) then
- Result := FEdit.Options
- else
- Result := [];
- end;
-function TOvcTCBaseEntryField.GetCaretIns : TOvcCaret;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).CaretIns
- else Result := nil;
- end;
-{--------}
-function TOvcTCBaseEntryField.GetCaretOvr : TOvcCaret;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).CaretOvr
- else Result := nil;
- end;
-{--------}
-function TOvcTCBaseEntryField.GetControlCharColor : TColor;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).ControlCharColor
- else Result := clRed;
- end;
-{--------}
-function TOvcTCBaseEntryField.GetDataSize : integer;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).DataSize
- else Result := 0;
- end ;
-{--------}
-function TOvcTCBaseEntryField.GetDecimalPlaces : byte;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).DecimalPlaces
- else Result := 0;
- end ;
-{--------}
-function TOvcTCBaseEntryField.GetEFColors : TOvcEFColors;
- begin
- Result := nil;
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).EFColors;
- end;
-{--------}
-function TOvcTCBaseEntryField.GetModified : boolean;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).Modified
- else Result := false;
- end ;
-{--------}
-function TOvcTCBaseEntryField.GetMaxLength : word;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).MaxLength
- else Result := 0;
- end;
-{--------}
-function TOvcTCBaseEntryField.GetPadChar : AnsiChar;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).PadChar
- else Result := ' ';
- end;
-{--------}
-function TOvcTCBaseEntryField.GetPasswordChar : AnsiChar;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).PasswordChar
- else Result := '*';
- end;
-{--------}
-function TOvcTCBaseEntryField.GetRangeHi : string;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).RangeHi
- else Result := '';
- end;
-{--------}
-function TOvcTCBaseEntryField.GetRangeLo : string;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).RangeLo
- else Result := '';
- end;
-{--------}
-function TOvcTCBaseEntryField.GetTextMargin : integer;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).TextMargin
- else Result := 0;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetCaretIns(CI : TOvcCaret);
- begin
- if Assigned(FEdit) then TOvcBEF(FEdit).CaretIns := CI;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetCaretOvr(CO : TOvcCaret);
- begin
- if Assigned(FEdit) then TOvcBEF(FEdit).CaretOvr := CO;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetControlCharColor(CCC : TColor);
- begin
- if Assigned(FEdit) then TOvcBEF(FEdit).ControlCharColor := CCC;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetDecimalPlaces(DP : byte);
- begin
- if Assigned(FEdit) then
- begin
- TOvcBEF(FEdit).DecimalPlaces := DP;
- TOvcBEF(FEditDisplay).DecimalPlaces := DP;
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetEFColors(Value : TOvcEFColors);
- begin
- if Assigned(FEdit) then
- TOvcBEF(FEdit).EFColors := Value;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetMaxLength(ML : word);
- begin
- if Assigned(FEdit) then begin
- TOvcBEF(FEdit).MaxLength := ML;
- TOvcBEF(FEditDisplay).MaxLength := ML;
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetOptions(Value : TOvcEntryFieldOptions);
- begin
- if Assigned(FEdit) then begin
- TOvcBEF(FEdit).Options := Value;
- TOvcBEF(FEditDisplay).Options := Value;
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetPadChar(PC : AnsiChar);
- begin
- if Assigned(FEdit) then
- begin
- TOvcBEF(FEdit).PadChar := PC;
- TOvcBEF(FEditDisplay).PadChar := PC;
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetPasswordChar(PC : AnsiChar);
- begin
- if Assigned(FEdit) then
- begin
- TOvcBEF(FEdit).PasswordChar := PC;
- TOvcBEF(FEditDisplay).PasswordChar := PC;
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetRangeHi(const RI : string);
- begin
- if Assigned(FEdit) then TOvcBEF(FEdit).RangeHi := RI;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetRangeLo(const RL : string);
- begin
- if Assigned(FEdit) then TOvcBEF(FEdit).RangeLo := RL;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetTextMargin(TM : integer);
- begin
- if Assigned(FEdit) then TOvcBEF(FEdit).TextMargin := TM;
- end;
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/e3/e301a52f609abdeeb1c0ccb900c50a9c6d9814f8.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/e3/e301a52f609abdeeb1c0ccb900c50a9c6d9814f8.svn-base
deleted file mode 100644
index 72fafe7f..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/e3/e301a52f609abdeeb1c0ccb900c50a9c6d9814f8.svn-base
+++ /dev/null
@@ -1,31 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, ovcbase, ovccal;
-
-type
- TForm1 = class(TForm)
- OvcCalendar1: TOvcCalendar;
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.dfm}
-{$ELSE}
-{$R *.lfm}
-{$ENDIF}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/e3/e3b1dd27bb51bd0d493a897cc103975387416809.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/e3/e3b1dd27bb51bd0d493a897cc103975387416809.svn-base
deleted file mode 100644
index cc6680b3..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/e3/e3b1dd27bb51bd0d493a897cc103975387416809.svn-base
+++ /dev/null
@@ -1,1290 +0,0 @@
-object OvcfrmAboutForm: TOvcfrmAboutForm
- Left = 202
- Top = 223
- BorderStyle = bsDialog
- Caption = 'About Orpheus'
- ClientHeight = 311
- Height = 311
- ClientWidth = 472
- Width = 472
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- OnCreate = FormCreate
- PixelsPerInch = 96
- object TBevel
- Left = 6
- Top = 265
- Width = 451
- Height = 17
- Shape = bsTopLine
- end
- object TLabel
- Left = 152
- Top = 8
- Width = 59
- Height = 16
- Caption = 'Orpheus'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -13
- Font.Style = [fsBold]
- ParentFont = False
- end
- object TLabel
- Left = 7
- Top = 273
- Width = 232
- Height = 13
- Caption = 'Copyright '#169' 1995-2003 TurboPower Software Co'
- end
- object TLabel
- Left = 7
- Top = 289
- Width = 86
- Height = 13
- Caption = 'All rights reserved.'
- end
- object Label1: TLabel
- Left = 151
- Top = 40
- Width = 290
- Height = 49
- AutoSize = False
- Caption =
- 'Orpheus was released under the Mozilla 1.1 license in January, 2' +
- '003. The project is hosted on SourceForge at sourceforge.net/pro' +
- 'jects/tporpheus.'
- WordWrap = True
- end
- object VisitUsLabel: TLabel
- Left = 153
- Top = 108
- Width = 194
- Height = 13
- Caption = 'Visit the Orpheus project on SourceForge'
- end
- object lblTurboLink: TLabel
- Left = 161
- Top = 124
- Width = 204
- Height = 13
- Cursor = crHandPoint
- Caption = 'http://sourceforge.net/projects/tporpheus/'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clBlue
- Font.Height = -11
- Font.Style = [fsUnderline]
- ParentFont = False
- OnClick = lblTurboLinkClick
- end
- object Bevel3: TBevel
- Left = 152
- Top = 160
- Width = 305
- Height = 96
- Shape = bsFrame
- end
- object GeneralNewsgroupsLabel: TLabel
- Left = 160
- Top = 168
- Width = 113
- Height = 13
- Caption = 'Orpheus support groups'
- end
- object lblHelp: TLabel
- Left = 168
- Top = 198
- Width = 276
- Height = 13
- Cursor = crHandPoint
- Caption = 'http://sourceforge.net/forum/forum.php?forum_id=241874'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clBlue
- Font.Height = -11
- Font.Style = [fsUnderline]
- ParentFont = False
- OnClick = lblHelpClick
- end
- object lblGeneralDiscussion: TLabel
- Left = 168
- Top = 230
- Width = 276
- Height = 13
- Cursor = crHandPoint
- Caption = 'http://sourceforge.net/forum/forum.php?forum_id=241873'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clBlue
- Font.Height = -11
- Font.Style = [fsUnderline]
- ParentFont = False
- OnClick = lblGeneralDiscussionClick
- end
- object Label3: TLabel
- Left = 168
- Top = 217
- Width = 94
- Height = 13
- Caption = 'General Discussion:'
- end
- object Label2: TLabel
- Left = 168
- Top = 186
- Width = 25
- Height = 13
- Caption = 'Help:'
- end
- object Panel1: TPanel
- Left = 6
- Top = 6
- Width = 139
- Height = 251
- BevelOuter = bvLowered
- TabOrder = 0
- object Image1: TImage
- Left = 1
- Top = 1
- Width = 137
- Height = 249
- Align = alClient
- Picture.Data = {
- 07544269746D6170628C0000424D628C00000000000036040000280000008900
- 0000F900000001000800000000002C8800000000000000000000000100000001
- 0000000000000000800000800000008080008000000080008000808000008080
- 8000C0DCC000F0CAA600AA3F2A00FF3F2A00005F2A00555F2A00AA5F2A00FF5F
- 2A00007F2A00557F2A00AA7F2A00FF7F2A00009F2A00559F2A00AA9F2A00FF9F
- 2A0000BF2A0055BF2A00AABF2A00FFBF2A0000DF2A0055DF2A00AADF2A00FFDF
- 2A0000FF2A0055FF2A00AAFF2A00FFFF2A000000550055005500AA005500FF00
- 5500001F5500551F5500AA1F5500FF1F5500003F5500553F5500AA3F5500FF3F
- 5500005F5500555F5500AA5F5500FF5F5500007F5500557F5500AA7F5500FF7F
- 5500009F5500559F5500AA9F5500FF9F550000BF550055BF5500AABF5500FFBF
- 550000DF550055DF5500AADF5500FFDF550000FF550055FF5500AAFF5500FFFF
- 550000007F0055007F00AA007F00FF007F00001F7F00551F7F00AA1F7F00FF1F
- 7F00003F7F00553F7F00AA3F7F00FF3F7F00005F7F00555F7F00AA5F7F00FF5F
- 7F00007F7F00557F7F00AA7F7F00FF7F7F00009F7F00559F7F00AA9F7F00FF9F
- 7F0000BF7F0055BF7F00AABF7F00FFBF7F0000DF7F0055DF7F00AADF7F00FFDF
- 7F0000FF7F0055FF7F00AAFF7F00FFFF7F000000AA005500AA00AA00AA00FF00
- AA00001FAA00551FAA00AA1FAA00FF1FAA00003FAA00553FAA00AA3FAA00FF3F
- AA00005FAA00555FAA00AA5FAA00FF5FAA00007FAA00557FAA00AA7FAA00FF7F
- AA00009FAA00559FAA00AA9FAA00FF9FAA0000BFAA0055BFAA00AABFAA00FFBF
- AA0000DFAA0055DFAA00AADFAA00FFDFAA0000FFAA0055FFAA00AAFFAA00FFFF
- AA000000D4005500D400AA00D400FF00D400001FD400551FD400AA1FD400FF1F
- D400003FD400553FD400AA3FD400FF3FD400005FD400555FD400AA5FD400FF5F
- D400007FD400557FD400AA7FD400FF7FD400009FD400559FD400AA9FD400FF9F
- D40000BFD40055BFD400AABFD400FFBFD40000DFD40055DFD400AADFD400FFDF
- D40000FFD40055FFD400AAFFD400FFFFD4005500FF00AA00FF00001FFF00551F
- FF00AA1FFF00FF1FFF00003FFF00553FFF00AA3FFF00FF3FFF00005FFF00555F
- FF00AA5FFF00FF5FFF00007FFF00557FFF00AA7FFF00FF7FFF00009FFF00559F
- FF00AA9FFF00FF9FFF0000BFFF0055BFFF00AABFFF00FFBFFF0000DFFF0055DF
- FF00AADFFF00FFDFFF0055FFFF00AAFFFF00FFCCCC00FFCCFF00FFFF3300FFFF
- 6600FFFF9900FFFFCC00007F0000557F0000AA7F0000FF7F0000009F0000559F
- 0000AA9F0000FF9F000000BF000055BF0000AABF0000FFBF000000DF000055DF
- 0000AADF0000FFDF000055FF0000AAFF000000002A0055002A00AA002A00FF00
- 2A00001F2A00551F2A00AA1F2A00FF1F2A00003F2A00553F2A00F0FBFF00A4A0
- A000808080000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFF
- FF00000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000000000000000000000F700000000
- 0000F5F000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000055FFF000002DF007FFF000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000031F5FF310031FF2D08AF0000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000000000000000F52D000031FFF0F6
- F62D07FF00FF0700000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000007FFF000F5FF31F7FF2D0708F5FFF6F0F7F6F5F559F1000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000F6FF072DAA862DFFF0860707F6F52D
- FF07F0FFFFF00000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000000000000000000000002D00AFFF
- 82F5FFF1FFF0AB3108F700FF5EF0FF0800000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000FFF70008FFEC08310855082DFFECAF82F0FFFF0700000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000F7FFF7000886558207868631
- 08F708F0FFFF07F0F52D00000000000000000000072D0000000000F582AF0831
- 0000003107000000F0F7F52D07F7073100000000000007AAAFAA07000000002D
- F700000000000000000007AAAF08070000000000000031F10000000000310000
- 0000F0070707F707F7002D07000000F0F72D00000000000000000000F0F50000
- F0F5FFAA00D4080831FF82F7F686F1FF0700F5AAFFFFF5000000000000000000
- FF820000000007FFFFAAAFFF86000008FF000000AFFFF0AFFFF6FFFFF6F00000
- 31FFFFAF08AFFFF62D000007FF000000000000002DFFFFAFAAAFFFFF31000000
- 000008070000000000FFF5000000F5FFFFFFFFFFFFF008FF000000AFFFF00000
- 0000000000000000F5F6F6F7F6310008AF00AAFF07083186D1F5F60731AFF686
- 31F0F5550000000000000000FFF7000000F0FF8200000031FF5500AAFF0000F7
- F6F50008080000F0FFAF002DF608F0000000F0AFF6F50007FF0000000000002D
- FF08F0000000F008F63100000000FFF60000000055FF07000000F0FF31000000
- 000086F6000007FFF50000000000000000000000000786FFFFFF82F05A08F186
- 2D00000000F6FF868655F12D07F6FFFF0700000000000000FFF70000005AFF00
- 00000000AF080086F600F0FFF70000AFAA00000007FF00FFAF00000000000000
- F6F60007FF000000000000FFF600000000000000AFF600000007FFFFF5000000
- 08FFF6000000F5FF31000000000086D100F0FFF7000000000000000000000000
- 00F02DF0F55586D108F6F60000000000002D0755F708FFFFF6AF31F000000000
- 00000000FFF7000000AAFF0000000000F7FF0086AF00D108000000AFAA000000
- F7F607FFF000000000000000F5FF2D31FF000000000031FFF500000000000000
- F1FF310000FF86AFF70000F1FFF7FF2D0000F0FF310000000000AA0800D10800
- 00000000000000000000000000F5FFFFAFF7312D31F7F70000000000000008FF
- 8207F0F1313100000000000000000000F6F700000086F6000000000007FF0082
- FF08FF31000000AF0800F007FF07F7FF000000000000000000FF0731F6F7F731
- 0000F7FF000000000000000000FF86002DFFF007FF0000F7FF00D1080000F1F6
- 31000000000086D108FF3100000000000000000000000000000031550782AA86
- AA8231000000000000000782868686F731312D000000000000000000FFF70000
- 0008D1000000000007FF00F7FF0808FF86000008FFFFFFFF070008D100000000
- 0000000000FFF731FFAFF6FFF60082F6000000000000000000AFAA0008FF0000
- FF3100FFF70007FFF000F0FFAF86AAD4860082FF0808FFAA0000000000000000
- 000000000000003131F5F50786FF86000000000000008607312D0782F6FFFFF5
- 0000000000000000FFF700000086F60000000000F7FF0082F60000F5FF070008
- AA002DFF310082FF000000000000000000FF0731FF0000F0FF8607FF00000000
- 0000000000FFF700FF070000AF082DF6F00000FF0700F1FFAFAA0808AA0082D1
- 0000F5FF070000000000000000000000F0F131F6FFF6F6AA0731072D00000000
- 0000FFF608D18631F5F02DF00000000000000000FFF700000008D10000000000
- 07FF0086FF000000AAAB00AF08000007FF0031F6F50000000000000031FFF031
- FF00000055FFF5FF31000000000000002DF6F531FFF0000031FFF6AF00000008
- FF00F0FF31000000000086F600000082AF000000000000000000000082FFF6AF
- 072DF10786AAFF08000000002D082DAA07F086FFFFFF08310000000000000000
- FF0700000086F6000000000007FF0082F600000008080008AA000007FF0000F6
- F600000000000000FFAF0007FF00000007FF0008FF00000000000000FFAF00FF
- 0800000000FFFF310000002DFFF500FF31000000000086AF0000000808F02DF5
- 00000000000000000031F5F03108F6082DF7082DF6F7318607FF08F5AF820059
- FFF7F6F60000000000000000FFF7000000AAF6000000000007FF0086F600F007
- FF3100D10800F5FF080000F1FFF6F50000002DFFFFF00007FF000031FFAA00F0
- FFFF2D0000002DF6FFF0F5F63100000000F7FF0000000000FF86ECFF31000000
- 000086F600F007FF072DF7070000000000000000000031FFF686F100F7AF2D08
- D10708D13186F7AFF008FFF1F00000F5F00000000008FFFFFFFFFFFF2D86F600
- 00000000F7F60086FFFFFFFFF7000008FFFFFF0800000000F0AFF6FFFFFFFF08
- F0000007FFFFFFFF08000000F008FFFFF6FFFF08F000AFF600000000002DF700
- 0000000007FF31F6FFFFFFFFFFF082F6FFFFFF5E002D07070000000000000000
- 00000031F1F0F7FFFFF0AB07082DAA0807862D82F60086FF0700000000000000
- 002D31312D31313100F52D0000000000F13100F131312D00000000F5312DF000
- 0000000000002D07F707F500000000F031312DF0000000000000F5078207F500
- 000031F5000000000000F000000000000031F52D313131313100F131312DF000
- 0000F5000000000000000000000000000007FFF6F00808F0AF318607AA070800
- FFAF0082FF000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000000000000000000000000000000000000000F0AFF600
- 82F60008820782F5F6F5F6F0F7FFF60031000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000F5FFFFF05AFFF131FF5586F72DFFF5AFF7F007FFFF00000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000000000000000000000F007F031FF07F0FFFFF5FF0731
- FF0755FFF000F0FF310000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000007FFF0FF3155F608F1FF2D0000F5F00000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000F6862DFF2D0031FFF03100000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000F5F631
- F0F50000F1F63100000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000F0F5000000000000F70000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000DF4F4F40D0D0CF5F4F4F40D0D0D0DF00000F0F400F4F4F0F50CF500F511
- 1115101111F5F000F0F0F400F00D0C0DF5F4F5110C00F0F100F0F00000F5F50C
- 110DF4F000F000F011F40D0DF4F40D11F4F5F4F5F40D110CF5F0F5F000F0F4F0
- 00F1F0F0F4F00D0C2D35F4F5F42CF429F4352C2C2855582C55544C4C4C797471
- 707194BB98BB98BB95BABB0000000CF00000F40DF4F0F5F0F100000000F000F0
- 00F5F400F5F400F1F400F00C110D0DF0F0F400F000F0F50000F0F5F0F4F0F40D
- F5F000F0F500F000F0F00C0D15F40000F00000F0F5F00000F0F5F0F000F4F4F0
- 00F00D11F4F4F400F0F0F5F4F0F0F0F0F1F43130F4352CF42DF02C2C2C312C28
- 2830552C5554284D4C784C71709895B69994BB94BA95940000000DF10000F50C
- 0D00F4F0F40000F00000F00000F0F0F1F4F5F4F4F0F5F4F5F40C0DF50C0DF500
- 0000F400F0000000F5F0F400F0F0F000F0F0F000F40DF000F5F0000000F00000
- F400F000F0F40000F00D19F000F0F40DF5F0F5F000F00CF1F0F0F0F4F0F40D0D
- F435F428F42DF4292C342D2C2830555058514C4C4C794C4C95BA999894999499
- 9998990000000CF4F0F0F40D0CF0F5F400F00000F00000F000F4F5F4F000F500
- F50DF0F4F50C110C0D0CF4F000F0F4000000F0F411F4F5F0F10000F4F000000D
- 0DF4F00000EC00F0F00000F011F00000F0F500F0F41111F4F1F4110CF4F4F400
- F0F00DF4F0F0F1F0F0F4303031342DF42C2C2C2C2C312C282855542C55544C4C
- 4D7C4D94949598959898999498959800000011F5F411110CF5F0F400F511F400
- F000F000F0F000F40DF4F0F4F400F4F50C0DF00D0C15110CF5F0F0F5F40D110D
- F0F5F400F0F0F0F1F000F00DF4000D110D11110D110CF0F10DF4F400F0F4F0F5
- 11101111F0F41111F4F5F4F000F10CF0F0F0F42C313031313031302C2C2C2D2C
- 2C592C282854555055544D4C4C7970989998999899999498999899000000F4F0
- F0F0F50D0CF0F5F0F0F5F00000F00000F0F5F5F0F400F0F1F0F0F0F40D0CF0F4
- 0D11150DF4F0F40DF5F4F4F0F0F40CF4F40000F0F100F00D11F0F40C0CF50C0D
- F40DF4F0F0F4F500F0F5F0F41515100DF40D0C0DF4F4F5F0F0F00DF4F4313130
- 59315834553055312C2C2C2C50592C502855545059504C4C7578999499949899
- 94989995BA9598000000F5F000F0F40CF5F0F4F0F0F4F000F000F00000F0F4F5
- F4F1F4F4F0F5F0F50C0DF5F40C0D11F50CF5F0F0F411F0000D0D0D110DF000F0
- F000F000F515110D110D0C0D110D00F000F50CF5F0F41035111111F4F4110D11
- F4F5F4F0F0F00C2D3058345934595959595854555455502C2C592C2950545950
- 7C554C4C5079989994999598BB989899989998000000F4F0F0000D11F4F1F4F1
- F4F500F00000F000F000F0F0F4F000F5F400F4F4F50C0DF40D0D0CF0F5F0F0F4
- F5F40D0CF4F000F5F0F000F0F400F000F0F4F4F4F4F4F5F4F4F4000000F0F411
- 0C0D1515111111F5F00C0C31F4F4F5F0F0F43130353559595958590303595958
- 55035554555950505055555059744C71749C9598999898999499989499989900
- 0000F4F5F4F4F40D0CF4F0F400F4000000F000F00000F0F1F4F0F4F400F4F00D
- F40D0C11150CF4F50C0C0DF400000D0CF500F0F0F00000F10000F000F4000D11
- 0D0D10111111F0F5F4F000F1F40DF0F50C390CF4F0F51111F4F5F4F0F02D3035
- 5459585958590359597D0359545554595903515050557C507D784D4C749998BB
- 989499BA999899BB9899940000000CF4F411110CF5F0F5F0F4F1F4F5F000F000
- F0F1F4F0F500F1F4F1F0F1F4F40D0C111100F5F40DF5F40DF4F00D0DF4F0F5F4
- F5F4F4F4F5F0F000F5340D0C0D0C0DF40D0CF0F00D00F4F40C11F40C0D10F5F0
- F40D3011F430F5F02C313455355859035D03597D0303597C59547D54545D5403
- 557C55507D547070759899989899989998999498989998000000F50C351511F4
- F4F0F4F1F0F4F40DF0F0F0F1F40DF4F0F4F4F0F4F0F4F00DF40D0D0C11F0F0F4
- F0F011F4F5F40CF4F500F0F4F4F100F0F4F0F03111110C0D0C0D110C110D00F0
- F4F40D393511393939110C0DF00C1539F50CF5F4303031585959035959595C59
- 7D597C597C7D547978597D037D037D547D795071749998999998999899BA9999
- BA9598000000302D0CF50CF5110DF0F4F0F500000DF0F0F0F000F40DF4F1F0F4
- F5F0F00CF510113915F50DF4F5F0110DF00D11110CF0F50DF0F0F0F5F000F511
- 100D0D0C0D0DF40D0CF5F0F4F1F0F4110C35110DF40DF4110C3939350C31F42C
- 3135543558595903807D598059807D7C597C7D7C7DA07879787D78797C787474
- 74BB98989899BA98989998989998990000000D0C0D0C0DF40D0CF4F4F1F400F0
- 11F0000000000D0DF4F0F0F5F4F0F4F5F411100D11F4F0F0F400F515F4F40DF4
- 0DF0F0F4F400F0F0F0F0F0F4F50D0C0D0C0C0D0C0D0CF40D0C00F00DF40D0CF4
- F0F4F00D353939112C0DF42C31545958595903595D59807D807D7C7DA4A5A5A0
- A1A0A1A0A1A09D78797974759998999899989999999898BB9499980000003031
- 0C11F4F4F1F0F5F0F4F4F000F4F000F0F000F0F0F4F5F4F4F1F4F50C0D1111F4
- F4F0F40D0DF4F00C0D15350C0DF4F1F4F5F0F0F5F000F0F5F40C110D110D3011
- 110DF0F5F4F50C110DF40DF5F435310CF01035350C3031303134595903598159
- 7C7C5D7D807DA5A4A5C6A4C6A5A4A5A0A0A1A0A19C9C79747499989998999898
- BA999998999894000000313435390D0CF4F4F4F5F0F500F0F5F0F000F00000F0
- F4F0F0F4F4F0F40D103911F4F5F00DF4F00D35F40C0DF4F5F4F40C110C00F0F0
- F5F0F0F41115F4F4F4F5F5F40CF5F0F43530F5F4F40CF0303D3911350C353435
- 0D303031543154585903038159817C7DA5A4C6A5C6A5A4A5C6A5A0C7A0A1A0A1
- A19C9C9D9C987598959899999898999894999900000030350CF5F4F5F5F411F4
- F4F4F000F4F40DF000F0F0F0F5F4F5F5F4F5F40D11391139F4F0F4F500F4F4F5
- 0D39110C0D0D39150DECF0F4F000F40D0DF43535390CF4F5F0F000F5F4F5F4F0
- F5353911350C2C3131113535303131303154595503597D037D7C81A4A4C7A4C7
- A4C6C7C7A4A4C7A4A1A4A0A0A09DA09D9C9D9899749994989998949999989400
- 000031350DF40D0CF4F4F5F4F4F500F0F5F50DECF0F000F0F4F4F00CF4F4F40D
- F4310C350DF00DF4EC0CF5F4F0F0F0F50CF0F5F40D00F4F5F0F0F1F4F40C110C
- 0DF4F50C0D31F0F0F00C0D350C3939350C350DF4F43134353031303055585558
- 597D03817C81A4A5CBA4C7A8C6A9A4A4A4C7A4C7A4A0C3A1A1A09D9C9D9C9D98
- 989598999499989998949900000030350C3011340DF400F4F5F4F0F0F4F0F400
- 00F0F0F0F5F4F5F40D35F5F4F00D0DF4F4F4F4F5F4F5F40CF50C00F00D00F0F0
- F4F0F0F4F1F0F4F41139393535F4F00D3030F0F4F42D2C303130303130313031
- 30312C353031305554555859037D037D7DA4C7A4C6CBA4CAA5C6CBC6C7A4C6A4
- C7A5A0A0A0A1A09DA09D9C9C7598719499949994989994000000353535393939
- 39F5F0F5F4F500F0F5F4F5F4F0EC0D300DF4F431F4F40C0DF430F42D2C312C2C
- 2DF4F5F43135F0F00CF0F5F4F5F0F5F4F0F0F0F431F4F5F0F5F4F4390DF52C2C
- 31303130303130313031303130353534313031303154555459037D7CA5A5A4CB
- A4CAC7CAA4CBA4A9C6A9C7A4C6A4C7A1A0A1A0A09D9C9D9C9998997494759499
- 95949900000035300D2C1135F0F0F0F4F4F4F0F0F4F4F435F5F00C0DF0F4F539
- 0DF0313030313130303031302C302C2C0DF4300D0DF0F0F4F4F0F0F4F1F0F535
- 0D0CF4F4F431F0F12C2C30313031305531543154313031303134353130353055
- 545558597C7D7C7DA4A4C7C6A8C7A8C7CACBC6CAC7C6A4C7A4C7A4A4C2A1A09D
- A09D9C9D9C987594997194709499940000003031300D3534F4F1F00DF42DF0F0
- 0DF4F530F0F0F5F534350C2C2CF0313031303430313130313031302D2C2C310D
- 0CF0F5F431F0F4F5F0F0F435300D35343530F42C302D31305530593054355435
- 303154313035595C355D59305455037903597CA5A4C7CAA9C6CBC6CACBA4CAA5
- C6A8C7CAA5C6A4C3A5A0A1A09DA09D9C9D9D7498717098719994950000003130
- 31303135F4F0F00CF50CF0F031F4F40DF0F030F435F42DF4F530303558595535
- 5430313031303130302D2C2C31F0F4F50CF0F52CF4F0F50C0D3039353935302D
- 2C30305530595459595859545954355459303535035D5C5955545558797C7DC6
- A4CBA4C7CAA4CAA5CACAC7CACAC7A4C6A5C6A5A4A0A5A0A1A09D9C9D9C9C9971
- 74987170707170000000583158313035F4F0F0310CF5F0F00CF5F431F4F03130
- 312CF42C2C595859590358595959585534315431303031302DF02C0C31F0F4F5
- F4F4F4313130F42D2C312C30313055545903590359035959585554555455585D
- 5D5D595C5954557C597CA5A5C6A4CAA4CBCBCACAA5CAA8C7A8CAC7A8C6A5C6A5
- C2A0A1A09DA09D9C9D9C9875707174717070710000005935303154312CF4F530
- F431F0F42DF42C31F0F43130352C2C2D5859597C595959030359595855583130
- 5531302C302CF42D31F0F42CF1F42C3030312C30312C30315455585503595903
- 59597C03595958595459035D615C5D8559540355787DA0C6A5C6C7CAC6A8CACB
- CACAC7CACBC6A8C7A4C6A5C6A5A0A0A1A0A19C7D9C9D78747574717471707000
- 00005958593031302C3534353530F0F435303134F42C3531593031545D5D5C5D
- 5C5D5C59595903595954555431543031552C3130302C2C312C2C2D3139615D5D
- 343055545554595903597C81597C5D5959037D545554555D5C5D595C59545579
- 7C7DA4A5C6A9CAA9CACBCBA4CBCBA8CBC6A9C6C7CAC7A4C7A0C7A1A0A1789D9C
- 9D789D7475707071707071000000035959585431305935303530F03135343159
- 2C2C5D345D30305980818181818181805D7C5959035959545530553030513035
- 352C3130303130305D5D30355455545503597D038159805980597D037C590359
- 587D545D5D5D0359545578037DA0A5C6CBC6C6CAA5CACACBCACACBA4CAC7CAA4
- C7A4C6A5A4A0A0A1A0A17C9D789D78757470754C714C700000005D0359553455
- 3031345D3531282C303130342D2C59355C5D5D818180818081808181805D7C03
- 590303595855545530305534352C31352C3031583559315455545554597C037D
- 7C7D817C817C817D037D597C5558557C5959550351545578797CA5A4A4CBA4CB
- CAA9CACAA9C6CACBA8CACBCAA4C7A4C6C7A4A5A0A19CA178A1789D7851744C75
- 70714C0000008059035955583154316134312C31593055352C54595459618580
- 81858085A481818081818181037D59585503555855542C31592C54312C313035
- 59585855545558597C7D7D7C8180818180817C817D7C7D59037D7C5503590381
- 037D58557CA1A4C7C6A4C7CAC7CACBCACBCACBCACBC6A4C7CAA4C7A4A4A1A0A1
- A0A178A1789D7878744D744C504C4C0000008159590354555431302C31302C30
- 303131582C555C555D85808185A885A9858584818180817C817D037D58555455
- 54555459032C35302C5459595C5D858154597C7D7D81808180A5A5A4A5A5A4A5
- 7C7D7C7C7D7C557C597C597D59808178797CA1C6A4CBCACAA9CAA4CBCACBA8CB
- C6A9CACBA4C7C6A5C7A4A1A0A17CA1789D7879797954504D4C4D4C000000807D
- 035959545554315859312C315930545954555D035D858580A8A9A9A8A8A4A5A4
- A4A5A0A5A17C7D7C7D7C555455545459592C55592C5558815D0355037D7C7D7C
- 817CA5A4A5A4A4A5C6A4A5A4A5A4A17D7C7D7C7903595454547D7C557C7DA4C7
- CAA4A8C7CACACBC6A9CACBCACACBC6A4CAC7A4A4C6A1A4A1A0A178A178797878
- 7C595050504C4C00000081807D0359035554595D58592C54595954595454617D
- 808181A9A9A8A9A9A5A4A5A5A5A4A5A4A4A1A07D7C7D7C555455555C59505859
- 515859035D5D54597C7D7C7D7CA5A8A5C6CBCAA8A5C6A5C6A5A4A0A5A07D7C7D
- 7C81797855037D7879A0A5A4C7C6C7CAA5CACACBCACAC6A9C6A4CBC7A4A4C7A4
- A5A4A1A0A17CA178A178797903555059545954000000807D7C7D7C5558555459
- 5954505558595903795479038585A8A9A8A5A4C6A4A9C6CAA4A9C6A5A5A4A5A0
- A1A07D7C795454595950595850595459858081807D7C7DA4A5CAC7CAA9C6A9C7
- C6A9C6A4A4C7A4A0A1A0A17C7D7C5455787D7D78797CA1C6A4A5C6A4CAC7A8C6
- A9CAA9CACBCACAA4CBCAA4C7A4A5A0A5A0A17CA17C797C78595451582D542D00
- 0000A5A17C7D7C7D7855035958595903550303590355547D808181A8C7A8CAA9
- CBCAA5A8A5C6A5C6A4A4A5A4A17C7D7C9D7C55037D545903557C590385858185
- 7C7DA4A5CACAA4CAC6CBC6CAA8C6A8A5C7A4A5A5A0A17CA1A07D7D78797C7C79
- 7C7DA0C6A5C6C7A4C7A4C7CBCACBCACBCAA9C6CBA8C7A5C6A5C6A4A1A07DA07D
- 7879787903555459542828000000A4A4A17C7D7C7D7859035903855903597D7C
- 5978797C8184A5CAA8CACBCAA8CBCACBCACBA8C6A9C7A4A5A4A1A07D7CA1787D
- 5C55037D5459037D8180798081A0C7CACBCACBA8CBCAA9CAC7A8C7CAA4C7A4A4
- A5A0A1A07DA07C7D7C817D78797CA1A4A5A4A4C7A4C6A8CACBCACBA8CBCAA9CA
- C7A4CAA4C7A4A5A4A1A0A1A07D7C797859543055302C28000000C7A4A5A07D78
- 7D787D7D0359597C590359817C7D787D80A9CACBCAA9CACBCACBA8CBCAA8C7A8
- C6A4C7A4A1A4A1A07D7CA17C7D588159587D7C8184817881A9CACACACAA9CACB
- A8CBCACBCACBA4C7A8A5C6C7A4A1A4A1A0A1A1A07D7C8178797CA1A4A1A4A1A4
- A5CACBCAA9CACACBCACBCAA9CACBC6A9C6A4C7A4A5A07D7CA17C7D0359595431
- 502D2C000000A4A5A4A1A07D7C7DA0787D0354597C7D7C81817C7D7CA5CACBCA
- CBCBCAA9CBCACBCACBCACACBA5CAA4A5C6A5A0A1A0A17CA17879037D787D7C81
- 81857CA1C6CBA8CBCACBCACACBCACAA9CAA4CBCAC6C6A5A4A5A4A1A0A1A0A0A1
- A0817C797C797CA1A4A1A4A5CAA9CACBCACBCBCAA9CACBCACAA4CBA4C6A5A4A4
- A5A0A5A07D7C7D545D5C5D59302C2C000000C7A4C7A4A17C7DA0797D7C7D8181
- 7C817C79807D7CA5CACBA8CBCACECBCACACBCACBA8CBCBA4CAC6A5C6A5A4A1A0
- A17CA1A0A17C7D8055807D8085A8A5A4CACACBCAA9CACBCACBCAA9CACACBCAA4
- CBA5A4C7A4A4A1A0A1A0A1A1A0A57C7D7C7DA0A1A0A5A0C7CACBCACBCACBCACB
- CACACBCAA9CBC6A8C7A8C7A5A4A5A07D80A17D7C5D595930313031000000A4A5
- A4A5A0A1A07DA09CA17C857C7D7D7C798081A9CACBCACFCACBCBCECBCBA8CBCA
- CBA8CACBCAA5C6A4C7A4A1A0A0A1A0A1A0A17C7D787D7C81A985A5CACBCACBCA
- CBCACBA9CACBCACBCBA8C7CAA4CAC6A5C6A5A4A1A0A1A0A0A1A0A18081A4A57C
- A1A0A5CACACBCACBCACBA8CACBCBA8CBCAA8CBA9C6A5A8C6A5A4A5A07D7C7C7D
- 7C593059305D39000000C6A5C6A0A5A0A17C7D7DA0A17C7D7C8081A07DA0A9CA
- CBCACBCBCACBCACBCACFCACBCACBCAA8C7CAA9C6A4A5A4A5A0A1A0A1A0A0A17C
- 7D7C7D80A9A4A5CAA8CBCACBCACBCACACBCACBCACACBCACBC6A9C6A4C7A4A5A4
- A1A0A1A0A1A0A0A57C7D7CA5A0A5A4CBCACBCACBA8CBCBCBCACBCACBCBCAC6CA
- A9C6A5A4A5A4A580A1817C7D7D585558313030000000A8C6A5A4A5A0A0A1A0A0
- A1A0A17C817D808180A5A4CBCACBCACBCFCACFCBCECBCBCACBCACBCACBA4C6A5
- C6A4C7A0A1A0A1A0A1A0A0A178817DA885A5C6CACBCAA9CACBCACBCBCACBCACB
- CAA9CAA8CBC6A4C7A5A4C6A1A0A1A4A1A0A1A0A580A5A4A5A4A1CACAA9CACBCA
- CBCACBCACBCACBCAA8CBA8CBC6CBA8C7A4A5A4A580807D8080815C8103593500
- 0000C6A5C6A5A0A1A1A0A1A1A0A1A0A581A481A4A5A4CBCACBCACBCECACBCBCA
- CBCBCACBA8CBA8C7A8C6A9C6A5C7A4A1A4A1A0A1A0A1A1A178A580A9A5A4C6CB
- CACBCACFCBCACFCACBCAA9CACBCACBC6CBA4CBC6A4C6A5A0A5A0A1A0A5A0C3A0
- 81A07DA4A5A4C6CBCACBCBCACBCFCACBA8CBA8CBCBCACBC6A9A8C6A5A4A4A580
- 7DA5858581815D5D5D5903000000CBA4C7A4A5A0A0A1A0A0A1A0A1A07C81A4A5
- A9A8CBCACBCACFCBCBCFCACFCBCECBCACBCACBCAC6CBC6A4C6A4A5A4A1A4A1A0
- A1A0A0A07D80A1A8A5A4A9CACBCACBCBCECBCBCACFCACBCBCACBA8CBA4CAC7A4
- C7A5A0A5A0A5A0A1A0A5A0A1A081A4A5A4C7CACBCACBCECBCBCACBCBCBCACBCA
- CAA9CAA9CAC6A9A8A5A5A481848584858485805D5C5D59000000C6A5C6A5C6A5
- A4A1A1A0A0C7A0A1A1A481A4A0A5CACFCACFCACFCACBCFCACBCBCACBCACBCAA9
- CAA8C7CAA5C6C6A0A1A0A1A4A1A5A1A0A0A580A5A4A1CACACBCBCACACBCECBCB
- CACBCACBCACBCACACBC6A8C6A4C6A5A4C7A0A5A0A1A0A5A0A5A0A5A4A1A4A9CA
- CBCACBCACFCBCACECBCBCACBCBCACBCAA9CAA5A4A8A980A9ADA8858585858581
- 5D5C5D000000A9C6A4C6A5A0A1A0A0A1A0A1A0A0A0A5A4A5A1A8CBCACBCACBCA
- CBCECBCBCECACFCBCACBCACACBC7A8C7C6A5A4C7A4A4A0A1C2A0A0C7A0A5A0A9
- A4A5C6CBCACACBCFCACBCACFCBCACBCAA9CACBCAC6A9C6A5C6A5C6A0A4A1A0C3
- A4A0C7A0A1A481A4A5C6CACBCACBCACBCACBCFCBCBCACBA8CBCACBA8CACBA8CB
- A5A4A9AC8585A98485848160815D5D000000C6A4C7A5C6A0A5A0A1A0A1A0A5C2
- A5A9A4A5A8C6CBCECBCFCBCFCFCBCBCECBCBCBCACBCAA9CBC6A8C6C6A5A4C7A4
- A1C3A1A4A0A1C3A0A1A481A8A9C2CACBCACBCBCACBCBCECBCACBCACBCACBA8C7
- A9C6CBC6A5C6A4C7A1A4A1A4A0A5A0C2A5A4A5A4C3A4CBCACFCBCFCACFCBCACB
- CACBCACBCAA9CBCAA9A5A8A5A8A9ADA985A88585858585615D5C5D000000CAC7
- A4C6A4C7A0A5A0A1A4C2A1A1A4A9A9A4A5A4CBCACBCACECBCACFCACBCFCACAA9
- CACBCACACAC7CAA5C6C6A4C3A4A4A0A0C7A0A4A1A4A1A4A9A5A5CACBCACFCACB
- CECBCBCBCACBCACBCACBCACACACAA5CAA4C7A5A0C6A1A4A1A4C3A0A5A4A1A0A5
- A4C6CBCACBCACBCBCACBCFCACBCFA9CACBCBA8CBA8CAA9A8A9A8A988A9898585
- 8584855C855D5D000000A5CAC7A4C7A4A1A4C3A4A1A4C2A4A1A0ADA4A5CBCACF
- CBCBCBCECBCFCFCACBCFCBCACBCACBA8CBA4CBC6A5C6A5A4C3A5C2A5A0C7A0C2
- A5A4A1A8A4C2A8CBCACBCACFCBCACFCACFCBCBA8CBCACBCAA5CAC6A5C6A4C6A5
- A0C6A1C6A1A4C3A0A57CA1A0A5A4CACBCACBCECBCFCACBCBCACBCBCBA8CACBA8
- CBA8CBA8A9ADA9ADA9AD858885856185615C5D000000CAC6A4C7A4C7A4C2A4A5
- C2A5A1C6A0A5A8A9A4A4CBCACACFCACBCFCACBCBCECACBCBCACBCAC7CACAC6A5
- C6A5C6A5A0A4A5A1C6A0A5C7A0A1A4A9C7A5C6CACBCACBCBCACBCACBCACBCACB
- CACBA8C7CAC7A8C6A5C6A5C6A5A4A0A5C6A1A4C6A0A1A0A5A4C7CACBCBCACBCB
- CACBCFCACFCACACBCBCBA8CBA8CBA9A8ADADA9AD8589A98585858584615D5D00
- 0000C7A4C7A4A4C7A0A5A1C2A5A0C6A4C7A4A5A5A4C7CACBCFCBCBCFCACBCFCA
- CBCBCBCACBCAA9CAA9C6A5CAA4C6A5C6A4C7A0C6A0A5C6A0A4A5A4A9A4A4C6CB
- CACBCECACFCACFCACBCACBCACBCACBCAA5CAC6A5C6C7A4C7A4C3A4C7A0A4C6A5
- A1A0A5A0C7A4CBCBCECBCBCACFCBCACBCBCBCBCBCAA8CBA8CBA9CAA9ADA9ADAD
- 85AD85858984856181605D000000CAC7A8C7C6A4C7A0C6A4A1C7A4C3A4A5A4A4
- A5C6CACBCACFCACFCBCFCACFCACBCACBCACBCAC6CAC7CAC6A5C7C6A4C7A0C7A0
- A5C2A5C2A1A4A5ADA5C6A5CACBCACBCBCACBCBCACBCACACBCAA9C6CACAA5C6C6
- A5A4C6A5A4C6A1A4A4C7A1C6A07DA0A5A4C6CACBCBCBCECBCACBCFCAA9CACBA8
- CBCBA8CBA8A9A8A9ADAD89A9AD85898585858461615D5D000000A8C6C7A4C7A4
- C6A5A1C6A4C2A5A4C6A9A9A5A4A5CBCACBCACBCACBCACBCBCBA8CBCAA9CACBA9
- C6A8C7A4C6A4C7A4C6A5A4C7A4C7A4C7A0A5A4A8A9A4C6CBCACBCACBCACACBCA
- CBCBCBA8CBCACBA4CBCAA5CAC6A5C6C6A5A5C6A5C6A4C7A4A5A0A1A0A5A5A8CA
- CACBCBCBCFCACBCBCECBCACBA8CBCBA8CBA9A8ADA9ADA989A989858985618585
- 605D5D000000C7C6A8C7A4C7A4C6C6A5C6A5C6C3A4A9A4A4A9C6A8CBCFCACFCB
- CECBCFCACBCACBCACBCACAC6CBC6C6CBA5C6A4C7A5C6C6A4C7A4C2A4A5A4A5A9
- CBA4A5CACBCACBCACBCBCAA9CACACACBCACBCACBC6A4CAA5C6C6A5A4C6C6A5C6
- C7A4C6A5A0A1A4A5A4C6C7CBCBCACACBCACBCACBCBCBCBCACBA9CAA9A8A9A9A9
- ADADADAD89A98984858585615D5D5D000000C6A8C7C6C7A4C7A4A5A4C7A4C7A4
- A5CBA4A5A5A4CBCBCACBCBCACBCBCACBCACBCACBCACBA4CBC6A4CBA4C6A4C7A4
- C6A4A5C7C6A4C7A5A0A5A4CBADA5C6CBCACACBCACBCACACBCACBCBCACBA8C6CA
- A5CBC6C7C6A9C6C7C6A5A4C7A4A5A5A4A5C6A5A4A5A5CACBCACBCBCBCBCBCBCB
- CACBA8CBA9CAA9A8CBA9A8ADADA98985858985858561615C615C39000000CAC7
- A4CAA5C6A4C7C6C6A5C6A4C7A4A9A5C6A9A4C7CACBCBCACBCBCACBCBCBA8CBCA
- A9CACBA4CBC6A4C7C6A5C6C7A4C7C6C6A4C7A4C6A4A5A4A4A8C7A4A4CBCBCACB
- CACBCBCACBCACAA9CAC6A9C7CAC6A5CAA4C7A4C6A5C6C7A4C7CACAC7CAA9CAC7
- A4CAA5CAA5CBCACBCACBCACBA9CACBCBCAA9CBA9A8A9A9A984858585855D8585
- 858485615D5D5D000000A5CAC7C6C7A4CBA4C7A4C6A5C6A8CBA8C7A8C7CAA5CA
- CBCACBCACBCBCACBCACBCAC7CAC7CAC6A8CBC6A8C7C6A4C7C6A4C7A4C7A4C7A4
- CBCAC7CBC6A8C7CAA4CACBCAA8CACBCAA9CACBC6CBCAC6CAA5CACBC6CBC6C7A4
- C7A8CBCACBA9CAA9CBC6A9CBCBA5CAA5CAA5CBC6A9CAA5CACBA9CBA8CBA8A9A9
- ADA989A9858985858461605D5D6161605D395D000000CAC7A8C7A8C7C6C7A4CB
- A9CACBCBCACBCACBCAA9C6C7A8C7CAA9CAC6CBC6CBCACACBA8CAA5CAC7C6A5C6
- C6A5C6C6A4C7C6A9CACACACBCAA4CAA8C7CAC6A5CAC7A4CAC7C7C6C6C6CBC6CA
- CAA5CAA5CAC6A4C7A4C7A4CBCACBCACBA8CBCBCBCAA9CBC6A9CAA5CBA4A5A4A9
- C6A5A8A5A4A9A8A5A9A9A9ADA989AD85AD85858585855D5D5C5D5D5D5D5C3900
- 0000C6A9C6C7C6A4C7A4CBCBCACBCBCACBCBCBA9CBC7A8CBA4C7A4C7C6A5A4C7
- A4C6C7A4C6C7C6C7C6A5C6C6A5C6C7A4C7C6A8CACBCACBA8CBCBCAC7CACAA5CA
- C7A4C6A5C6A4C6A5C7A4C6A5C7C6CBC6C6A9C7CAC7A4C7CACBCBA9CBCBCBCBCB
- A9CBCBA9CBA5CBA4C7A9CBA4A5A8A5A4A9A4A584A9A9ADADADA9A98985858584
- 85615C5D5D39595C5D3959000000CBC6CBA4CBC7CACFCBCBCBCFCBCBCBA9CACB
- A8CBC6A9C7CAA5C6A5C6C7A4C6A1C6C6A5C6A4C7A4C6A4C7C6A4C6C6A9CACBCB
- CAA9CACBCACAA9CAA9C6CBA4CAA5CBA4C7C6A5C6A4C6A5C6A4C6A4C7A5C6C6A5
- C6CBCECBCBCFCBCBCBCBA9CBCBA9CBCBA9CBA9CBA9A4A5A5A9A5A9A581A981A9
- ADADADA989AD89A9898585856161615D5D5C3935593835000000C6A9C6CBA4CB
- CBCBCFCFCBCBCBA9CBCBCBCBCBA9CBC7A8C7A9C6A5A4C7A4A5A4A1A1C6A1C6A4
- C7A4C7A4C7C6A5CACACBCACBCACBCACBCBCACBCACBCAA8C7CAC6A4C7A4A5C6A5
- C6A1C6A1C6A1C6A4C6A5C6C7A8CBCBCFCBCBCFCBCFCBCBCBCBCBA9CBCBA5CBA5
- CBA5A9A8A5A8A9A8A9A481A9ADADADADA989A9898589858585845D5C395D0339
- 353535000000A4C7A4C7CBCFCBCFCBCBCFCFCBCBCFCBCBA9CBCBCBA8C7A9C6A5
- C6A5A4C7C6A1A4A0A1A4A1C6A0C7A4C6A4A5CACBCBCACFCACBCACBCAA9CACBCA
- A8CBC6CAA5A5CAA4C7C6A4C6A5A4A5A4A1A4A5C2A5C6A5A4CBCBCFCBCFCBCBCF
- CBCBCFCBCBA9CBA9CBA9CBA9A5A9A5A5A9A5A5A9A98185ADADADADA989AD8985
- 898585856161615D5D393935343530000000C7C6C7CBCFCBCFCFCBCFCFCBCBCF
- CBCBCFCBCBCBA9C7CBA4C7A4A5C6A5C6A5A4A0A1A4A0A5A0A5A4C3A4C7CACBCE
- CACBCACBCACBCACBCACBA8CBCACBCAA9C6CAC6A5C6A4A5C7A4C7A0A1A4A1A0A5
- A4A5C6CBCFCBCFCBCBCFCFCCCBCFCCA9CFCBCBCBA9CBA9A5A9A9A5A9A5A5A9A5
- A9A9ADADAD85ADAD89AD85898585856184615D5C395C3534353535000000A4C7
- A9CBCFCFCBCFCCCFCBCFCFCBCFA9CBCBA9CBCBA9CBA5A5C6A5A5A0A5A0C7A0A1
- A0A1A0A5A0A1A4A1A4CBCACBCFCACBCECBCFCACBCBCACBCACBA4CBC6A8C7A5C6
- A4A5C6A4C2A5C6A0A1A4A5A0A5A4A5CFCBCFCBCFD0CBCBCFD0CBCFCBCBAACBAA
- CBAAA9A9A5A5A581A5A985A9A985ADA9ADAD89A9AD8589858585858561615D5D
- 3539353535340D000000A5A5CBCFCBCFCFCFCFCBD0CBCFD0CBD0CBCBCBA9CBCB
- A5CBA5A5A4A4A5A4A5A0A5A0A17CA1A0A1A4A0A5CACACFCACBCFCBCBCECBCBCE
- CBCBCACBCACBCAA5CAA4C6A5C7C6A5C7A4C6A5A4A1A0A1A4A1A4CBCBCFCBCFCB
- CFCFCFCBCFD0CBD0CBCFCBCBA9CBCBAAA9A9A9A585A581A985A9ADADAD89AD8A
- AD8989858961856185605D5D5C353534353530000000A5CBCFCFCFCBD0CBCFD0
- CFCFD0CBCFCBCBD0CBCBCBA9CBA5CBA5A5A5A0A5A0A5A4A1A0A1A0A1A0A1A5A4
- CBCFCACBCFCACFCACBCACFCBCACFCAA9CACBA8CACBC7A8C6A4A5A0A4A5A4C6A5
- A0A5A4A5A4A5CBCFCBCFCBCFCBD0CBD0CBCFD0CBCCAAAAAAA986818581A58185
- 818185A585AD8AAD85AD86AD8985898585858585615D5D3939353435350C0D00
- 0000A5CFCFCBD0CFCFCFD0CFCBD0CBD0D0CBD0A9CBCBA9CCA5CBA5A5A5A4A1A4
- A1A4A1A4A1A47CA5A4A5A4A4CBCACBCBCECBCBCFCBCFCBCACBCACBCBCACBCAC7
- A4A4C6A5A5C6A4C7A0C7A5C6A17CA1A4A5CBCFCBCFCFCBD0D0CFD0CFD0D0AAAA
- AA868286F7F7F7F7F75DF7818185818585A9AD89AE89AD898589858961856160
- 5D61395C35343535301131000000A9CBD0CFCFD0D0D0CFD0D0CFD0CFCBD0CBCC
- CFAACBA9CBA5A5A5A5A5A0A5A4A1A4A1A481A9AD85A4A5C6CBCFCACFCBCACFCA
- CFCACBCFCBCACBCACBA8CBA8CBC6A5C6A4A4A5A4A5A4C2A5A4A57C81A5A9CBCF
- CBD0CFCFCBD0CFD0AAAAAA86828686F786F786F761F75DF75D5DF7818589AE89
- 85AD89858985898585618561605D5D393535350C11300C000000A9CFCFCCCFCF
- CFD0CFD0CFD0D0D0D0D0D0CBCCCBCCA9CBA9A5A5A5A5A5A1A0A5A0A5A0A985AD
- A5A4A5A9CACBCFCACFCFCBCFCBCFCACBCFCBCAA9CACBCAC7A4CBA4A5C6A5A0A1
- A4A5A4C7A4A4A9A4A5CBCFCBCFCBD0D0CFD0CCAAAA82AA0886868686F7F7F7F7
- F7F75E5D075D5D5DF78989AE898986898989858585856161615D5C3935343535
- 311131000000CBCFD0CFD0D0D0D0D0D0D0D0D0CCAAAAAAAAAAAAA5A6A9A6A5A5
- A581A180A5A1A0A5A0A981A4A9A5A4CACBCECBCBCBCACBCECBCACBCFCAA8CBCB
- CACBA4CBA8C6A5C6A5A4A5A4A1A0A5A0A1A5A981A5CBCFCFD0CFCFCFD0AEAA08
- AA088686828682828686F75E5E5E5D07625D5E5D5D858A858985898985858985
- 6161615D5D5D393534353110310C0D000000CFD0CBCFD0CFD0D0D0D0D0AAAAAA
- AA86AA82AA8282868181F7A5A5A181A1A1A0A5A0A1A47D7DA580A5C7CACBCBCF
- CACFCFCBCBCFCFCACBCBCBCACAA9CACBC6A5C6A5A4A5A4A1A4A5A4A4A5A4A985
- A5A9CBCFCBCFCCD0CCAA08AA8686868686098662865E5E5E5E5E07625D07615D
- 5D8A89898A8986898589856161855D615C3939343535103110310C000000CCCF
- D0D0D0D0D0D0D0ABAA08AA09AAAA8208828682F7F7F781818181817DA4A17CA1
- A07D7C7C81A0A4CACBCFCACBCFCACBCACFCACBCBCECBCAA9CBCAA8C6A9C6A5A4
- A5A4A1A4A1A4A1A5A0A589A9A5CBD0CFD0D0CFAEAA8608860809860986625E82
- 5E5E625E5E5E62075E3D073E5D61868985898585898561856161605D5D393535
- 11340D0D310C0D000000CBD0CFD0D0D0D0AAAA08AA08AAAA09088686868286F7
- F7F7F707077D817D7D81A0A1A4A17D7C81A5A1A8CBCACFCACBCFCBCFCBCFCACB
- CBCACBCACBCBCBA4C6A9C6A5A47DA47DA0A1A4A0A5A0A985A5A5CFCBCFCFD0AA
- 0808860886868662098209625E5E5E5E5E5E5E073A075D073961898689856585
- 6185856161615D395D3934350D3530100D0D30000000CFD0D0D0D0D0ABAA0808
- AB08090886860982868286F7F7F707810781077D81A17D80A17C7D7C8180A1C6
- CBCBCBCBCBCACBCACBCACBCAA9CBCACBA8CAA4CBA8A5A4A4A5A4A1A0A57CA5A5
- A0A58581A5A9CFD0CFD0AA8686860886098609868262625E625E5E5E5E3A073A
- 07393A39073962898562858585616161615D395C3934353530110D310D0C0D00
- 0000CCD0D0D0D0AA08080809AA090886090982866209F7F7F7F75E07F75D0781
- 59817CA1A0818081807DA0A5CACBCAA9CACBCACBCBCBCACBCBCACBA8CBA9CBA4
- A5C6A5A5A47DA47D7CA1A0A0A57C858585A5CFCBD0AA86080808098686096209
- 62095E625E5E3A5E3A073A3A073A390739355D6185858561616161615C5D5D39
- 3535350C110C310C0C3035000000CCD0D0CCAB08090809080986090982860909
- F75E095E5EF7F70707075D07597D7D817C7D5D858180A1A4CBCACBCAA9CAA9CA
- A9CAA9CAA9CBA8CBC6CAA4CBA4A5A480A17C7D7CA57CA581A081858585A5D0CF
- D008868686860886098686625E625F5E5E5E5E3A5E3A36393A353A3939393561
- 616161616161615D395D383534350C11310D0C0D0D0D0D000000AAD0D0088609
- 86098609090986090962820909826282625E5E5E0707075D075D597D7D7C7D80
- 817D7CA5C6A9CACBCACBC6CBCACBCAC7CACBCAA9A9A9A4A8A4A5A5A0817C817C
- 7D7D7CA1A47D858585A5A9CFAA86088608868A6286096209625E625E5E3A5E5E
- 3A3A3A363A353635363535356161616161615D5D5D39393535350D300D300D0C
- 0C310C000000AAD0AA09860909090909860909620909096262095E625E5E5E5E
- 5D5E5D075D5959817C7D5C59817C7DA0A5CAC7A4A5A4A5A8A5A8A5A8A9A8A9A8
- A9A8A9A5A58080817C7D7C7D7C817C817D8085858685CBCF8686868A868A8686
- 86626262625E625E3A5E3A3A363A35363536353511351135355D61615D5D385D
- 39393435100D300D0C0DF40D310C0D000000AACC860909860986098609098609
- 0962625E095E625F625E5E5E5E07075D075D59597D815981805D7C7DA4C7A4A5
- A4A5A4A5A4A5A4A9A8A9A9A9A8A985808081817D7C7D7D7C7D7C7D807C818561
- 8581A9AA8A8AAE8689868A868661F7625E625E3A5E3A3A363A36363635123512
- 353535110D34395D5D395D393435350D310D0C0DF50C0D0C0C0D0C0000008209
- 09860909090909096209630962096309625F625E625E5E5E5D5E39075D07595D
- 595D5C595D7D807D7CA5A4A5A4A5A4A5A4A5A885A9ADA8A9A984A98581818080
- 5D7C7C597C7D807D815D8581615D85AEA98A89AE8A868A868A6262613A5D5E5E
- 3A3A3A3A353635123611351111110D110D0D0C353539343535350C0D0CF40D0C
- 0C0D0C0DF50CF5000000625E5E09620909620909636209626362626362626362
- 5E62625E5E5E0707595D5959595D5D035D5D597C7D7CA57C817C817D8085A9A8
- A9A9A9A984A98485808181817D5D817C597C7D807C5D5D5D8561A98AADAE8689
- 8A898A8562866262625E393A363636361236123511120D110D0D110D0D0D0D0D
- 0C0D11310C0C0D0C0D0DF40DF40DF40C0DF40C0000005E09095F090962096362
- 090963096209636263626262625E623A625D625D625D5D5D5903595D5D5C5D7D
- 037D7C7D7C7D7C8081818485A984AD85A98585858580815C5D80597C7D81037D
- 5D615D6185A989AE898AAD8A868A868A8562615E5D3A3A07393635113611110E
- 0D0D0D0D0D0D0D0D0D0C0D0C0D0C0D0C0D0D0CF50C0C0DF50CF40DF4F4F4F500
- 000063636262095E096362096263626263636263626263626362628686868685
- 8562855D5D595D5D5D5D595C7D7C7D7C7D7D8081818485A8A9AD85A885858085
- 80815D5903595D5D59037D5D8561615D898AAE85AEAD8A898A858A8562626261
- 5E3907393A35110E0D0D0E0D0D0D0D0D0D0D0D0D0D0D0C0DF4F4F50C0DF4F40D
- F4F5F4F4F4F5F4F5F40DF40000005E5E63636363626309636362636363626362
- 6362626262628A8A8A8A898A8585615D5D5D5C595D5C5D5D59037D7D037C7D59
- 808185858585A985848585815D5C5D5C5D59035D0359035D61856185ADAD89AD
- 898A8986898A856685616107393A393A353536110D0D0D0D0D0D0DF50D0D0D0D
- F40DF5F4F5F4F5F4F5F4F5F4F5F4F5F4F5F4F5F4F5F4F500000063625E626362
- 636263626363626362636263626362628A088A8A858A85868A6185855D5D595C
- 595D5839585903597D5903595D8085858485858585858485815D5D59035D3503
- 5D0359616161618589AE898AAD868989868962856262623D073939353935110D
- 0D0D0D0DF50D0D0DF5F5F4F5F5F4F5F4F5F4F4F4F4F4F4F4F4F4F4F4F4F4F4F4
- F4F4F40000005E5F635F62636363626362636362636263626762638A8A8AAE8A
- 8A8A8A89858661615D5D5C350359595D59035558035859585D5D858485858485
- 8461855D5C5D5C5D5935585D595D596161618589AD89A98986898A8A89868985
- 616161395D3935351135350D0D0D0DF50DF5F5F5F5F4F5F5F4F5F4F5F4F0F5F4
- F5F4F1F4F5F4F5F4F5F4F5F4F5F4F50000003A635E625F626362636363626263
- 3E63626362638A0808088A8A8A868986628561855D5D5D5959595859345D5958
- 55595959585D808585858585858580615D5D593559345959355C3538615D85AD
- 85AE898AAD8A85858565856162615D5D3935353535350D0D0D0DF50DF5F5F5F4
- F5F5F5F4F5F1F4F5F4F1F4F0F4F0F4F4F400F4F0F4F4F4F4F4F4F40000005F5E
- 3F63623B6263623F6263636362636263626608088A8A8AAA8A8A868989866161
- 5D5D5D34593435593559345959345958595D5D858485846184615D5D5C5D5835
- 3459353459355D5D616189898989AD8985898A898A8562616161613939353511
- 3511350D0DF5F5F5F4F5F5F5F5F4F1F5F4F4F1F0F4F0F0F5F0F4F500F5F4F4F5
- F4F5F0F5F4F5F40000003A5F5E3B62633B626362633E63626362676263080808
- 08AE8A8A8A898A8689618561615D395D355958593435353434553459345D5C5D
- 85858585855D5C5D595D5935353435353459383D616185AD8589868989868985
- 85898561615D5D3939353535110D110D0DF5F5F5F5F5F4F5F5F5F4F0F1F5F4F1
- F0F500F0F500F4F0F0F1F0F0F0F4F4F0F4F4F40000003B3A3A633B5E633E5F3F
- 6263633E63626362660808088A8AAE8A8A8A868962856161615D5C3558353530
- 593534353535303535595D5D5C615C5D5C5D5D5D5C3534353035313435353535
- 5D618989898989858A89858A8961616161615D39353511340D350C0DF5F4F5F4
- F5F0F5F500F5F5F5F400F1F4F000F4F000F4F1F0F4F0F4F1F400F5F4F1F4F500
- 00003A3A3B5E3E633E5F3F62633E3E63633E636609088A088AAE8A8A86898986
- 898661615D5D395935353435353035353530313530345D5C5D5D5D5D5D5D3958
- 353535303535343535343534396189858589858A89858985618561615D5D3939
- 353411310C0D0D0DF4F5F4F5F5F5F5F0F5F500F400F5F4F500F4F100F4F000F4
- 00F500F4F0F5F4F0F4F4F00000003A3B3A3B3B3A5F3E5E3F3A63633E62636262
- 080808AE8A8AAE898A868A896161615D615D3934353435313431393435303031
- 3135355D5D5D5C5D355C59353435343130313130353535393D61858989858989
- 85898565856161616139393411350C110D0D0C0DF5F5F5F4F1F400F5F400F5F0
- F500F0F40000F0F400F1F0F0F0F0F0F500F400F4F0F1F4000000363A3A3A3B3E
- 3B3B3E633E3E5F3F623F6366080808088AAE8A8A8A89868A858561615D5C5D35
- 3535303531343131350D30303031343534353534353534353531310C310C310D
- 30343961616185858989858985658561856161615D5D39353411310C0D0C0D0C
- F400F5F4F1F5F0F0F1F500F500F500F5F0F000F5F00000F100F400F0F0F5F0F1
- F4F0F0000000123A373A3A3B3A3E3B3A5F3F3E623F623E09088A8A8AAE8A8A86
- 8A8A8589626161615D393934353435313031F40C35300D310D30313535353435
- 35343535300D300D300D0C300D3539613D61858985858985898585856161615D
- 39383535350D0C0D0C0D0CF5F5F5F4F1F4F0F5F1F400F500F400F4F4F400F00D
- F4F4F0F0F0F0F1F400F0F0F400F5F40000001236163A3B3A3B3B3A3F3E3A633F
- 623E6362088A08AE8A8A8A898A85896261616161395D34353531300C3130F40D
- 3510F50C300C31313030310D303131300D300DF40D0C2C0D0D35103539616185
- 858985618561616161615D5D3939350D0C0D0C0D0C0DF4F5F4F400F500F500F4
- 00F500F500F4F4F1F0F100F4F515F4000000F000F4F0F0F1F0F4F40000000E12
- 36123A3B3A3A3B3A3A3F3A3E3F623E8A088A8A8A8A8A8A868A618A616161615D
- 5D39353510300D310C0DF4F41131F4F5F4F50C0C0D310D300D300D0C0DF40CF5
- 0CF50DF40C353539393D61858561858561856161615D5C39393510350D0C0DF4
- 0DF40DF4F0F1F5F400F5F0F1F500F400F0F1F4F4F4F400F4F4110CF4F4F1F0F0
- 00F500F4F0F5F40000000E12121236123B3A3A3B3B3A3F3A3E3F3E62088A8A8A
- 8A86898A86898685616161615D343535310D300D300DF10C11F4F4F4F5F4F5F4
- F4F4F5F40DF4F4F5F4F5F4F5F4F4F40D1011343D15393D616085618561616161
- 61395D393435350C0DF40D0D0CF5F4F1F4F400F5F400F400F0F1F0F1F0F400F5
- 00F0F00DF50D0DF5F4F400F0F000F000F4F0F00000000D0E1212123A123A3B3A
- 3A3A3A3A3F3A3E628A8A8A8A86898A868986656161615D5D383535300D300D30
- 0D0CF4F40D0C0DF4F4F4F0F4F5F4F4F4F4F5F4F4F4F4F4F4F4F5F4F40D350D11
- 34393D5D618561606160615D5C5D393435350C0D0C0D0CF4F5F4F5F0F500F500
- F0F100F500F400F0F0F1F4F0F4F5F00DF4000DF4F00DF40DF4F4F5F0F0F5F400
- 0000060E0E0E121236163A163A3B3A3A3A3A3E3E8A8A868A898A86658A616161
- 61615D393535340D0C0D0C0CF5F4F00D111111F4F0F5F4F5F0F4F5F4F5F4F4F5
- F0F5F4F4F1F4F40DF4390CF4F511393961616161615D5D395D393935350C0D0C
- F50CF4F5F4F4F0F400F400F0F1F400F0F000F5F4F5F400F5F000F4F4F0000000
- 0015110C11110CF0F5F4F0000000F50D060E0E12121236123A3A3A3A3A3A3A3A
- 628A8A8A868A858685866161615D393835340D0D2C0D0CF50CF5F0F40DF40DF4
- F0F4F0F0F5F4F4F4F0F5F0F4F4F0F5F0F4F510110D0D10391039393D3D5C5D5D
- 5D395D5D393435340D0D0C0DF4F4F5F4F500F500F500F5F0F000F400F1F400F4
- 00F0F400F4F0F5150CF0F0F5F00DF5F41115F400F000F40000000DF5F50D060E
- 1212123612163A163A3A163A5E89868986658A6561616161395D3935350D300D
- 0D0CF5F4F40C110C0D0D10F1F4F5F4F4F0F0F1F0F4F0F0F1F0F0F0F0F40D11F4
- 0C11113D1539393D1539395C5D5C39343535310D0C0DF4F5F4F5F4F400F4F0F4
- 00F400F0F100F1F0F0F0F5F0F4F1F4F0F100F40D0DF4F0F40CF4F40D1111F5F0
- F4F5F0000000F5F5DBF50A060E0E12121236121636163A3A15628A628A866186
- 6161615D5D393534350C0D0C0CF5F4F40D0D11F50C0D0DF0F4F4F500F4F0F0F0
- F1F0F0F4F00CF40DF0F4F41111110C0D35153915113511393935353535300D0C
- F5F4F5F4F4F400F5F0F100F000F1F000F0F4F0F4F1F400F400F400F4F400F40D
- 0000000D110DF40DF40CF000F100F4000000F5F5F5F5DBF5060E060E0E121212
- 36123611363A62896161616161613D5D383534350D0C0DF4F5F4F40D0CF4F4F4
- 0CF0F400F4F1F0F0F50D10110CF40D0C11110D150C0D0D0D0C0DF40D15391539
- 101110391138350C0C0DF4F4F4F4F00C0DF0F5F000F0F0F1F0F400F5F0F0F100
- F400F0F5F0F1F0F100F0F10C000000F4F5F4F0F4F4F5F0F0F0F4F0000000F5F5
- F5F5F5F50DF50E0D060E0E110E1112121111396261626161615D5D393935350D
- 0CF50CF4F4F5F40C0DF50DF50DF40DF1F4F4F400F411110C0D110C0D0C0DF4F5
- F4F0F00C11F40D15101539153915111511391115110C110DF40D110D0CF400F4
- F4F5F4F4F4F1F400F400F4F0F1F0F400F400F4F0F0F0F4F5F4F4F4F5000DF40D
- F4F5F500F400F0000000F0F1F5F5F5F5F50DF506F5060E060E060D0611110D39
- 6161615D5D5D393935300D0C0DF4F5F4F4F4F100F4F4F4F4F5F4F4F000F5F0F1
- F0100DF40C11110D11110C0DF4F5F40DF5F40C11153915391539393D11153D3D
- 110C15110C0C0D0DF5F0F000F400F5F0F4F4F1F4F0F1F0F0F400F5F0F0F400F0
- 000C0DF40D0D0DF000F4F00DF4F40C00F0F1F0000000F1F4F500F5F5F5F5F5F5
- 0D0D0DF5DB0D0D0D0D0D0D0D11395D39393935340D0D0CF5F4F5F4F40D11F4F0
- F5F4F5F40CF0F5F0F0F4F000F4F511150D0C0D0C0D100D0DF0F0F000F0F500F4
- 1111101111111015111015111111110D11F5F4F4F000F4F1F0F0F4F4F5F0F400
- F4F0F0F100F4F000F500F5F00011F5F4F4F0F0F4F00DF4DB11150DF000F00000
- 0000F0F500F5F5F0F5F5F5F5F5F5F50D0D0DF50D0D0D110D1539393935340C0D
- 0DF4F5F4F4F4F00D110CF0000CF5F4F4F5F4F400F5F000F0F01110110C0D0C0D
- 0C0D0D0C0000000DF4F4F40D151515151515153915111110111515F4F00CF4F5
- F40D15F400F0F1F000F400F4F100F400F4F100F4F0F0F0000D0CF0F40D0D0C0D
- 0DF4F00D0C110C00F0F0F0000000F400F5F400F5F500F4F5F1F5F4F5F5F40D15
- 110D111115393D1535110DF4F4F4F4F4F50C11F0F0DBF0F00DF4F5F50C0D0DF0
- F4F5F000F40D0DF40D0D0D0D0D0D0C0DF000F00D0DF00D110C11111110111115
- 110D0C0D0DF40DF5000D0DF40C11F5F4F400F0F0F5F0F1F0F0F0F1F400F0F0F1
- 00F000F0101111F4F0F4110C0D0DF4F411DBF50000F000000000F1F000F1F400
- F5F5F0F5F4F5F5F4F5F50C0D0D0D11113915393D15391111F40D150CF50C11F4
- F00DF100F4F4F4F4F5F40D00F0F0F500F0100DF4F40CF40CF40C0D0DF4F4F40C
- F5F0F4111110151111151115100DF5F4F5F0F0F000F0F0F5F0F10000F1F000F0
- 00F0F000F400F0F0F100F0F0F000F00D11150D00F5F00000F411F5F4F5F4F4F4
- F500F000000000F400F4F0F1F400F5F0F5F0F5F4F4F40D110DF40D1115111511
- 1515110C0D0C15110C0DF000F011F0F00DF4F50C0CF5F400F5F4F000F0F51115
- 110D0D0D0D110C0D000000F5F0F000F0110D111011111015110DF4F4F4000000
- 000000F400F000F0F4F4F000F0F000F100F0F000F4F0F00000F00D0C110D0C0D
- 0CF4F5F0F411F4F400F4F50DF400F0000000F0F1F0F100F400F0F1F0F4F1F4F1
- F511DB0D0CF40D10110D0C0D110C0D15151111110D10110CF5F4F0F0F5F4F5F0
- F500F4F0F00000F0F0110CF5F4F4F4F4F4F4F5F4F0F40DF4F4F50C1110111011
- 11111111110CF4F4F500F0F0F000F4F5F00000F4F5DB0DF40000F0F0F0F000F0
- 000000F0F5DA0DF4DB0C1511F0000DF4F511F40D0C0DF40C0D0000000000F000
- F0F0F1F0F5F0F4F1F4F0F0F40CF5F0F41111150D11F411F40D0D0C11110C0DF4
- F0F5110D0C110CDBF4F0F4F4F4F0F500F4F1F000F50CF5F40D11110D11111111
- 110D0CF5F4F4111511111111DBF4F00C0DF500F5F4F0F4F1F4F1F00D00F00000
- F4F0F4F5F0F4F0000000F000F1F4F0F40DF50CF40D11110D0CF5F000F40DF40D
- 1111F50D11F0F0000000F0F400F0F0000000000000F011111111F000F5F50C0D
- 10111515F40C0D10F500F4F5F4F0F40000F5F4F0F1F4F5F4F5F40C0000F0F000
- F00D100D0CF40DF4F4F40CF5F4F500F4F500F5F40D0C110D0CF50C0DF40C0DF4
- F5000000F00000F0000000F0F5F4F5F4111100F4F0F500F010150DF4F4F4F5F0
- 0C1511000DF4F000F00DF4F400F4F4F4F40000000000F50CF100F0F0F4F5F4F4
- F5F4F5F4F511F400F4F4F5F4DB111515F40D0D110CF40DF5F4F511000000F0F1
- F4F4F000F40DF500F0F00000F0F41111110D0C0D111111F400F4F0F5F4F4F0F4
- 111110110DF4F40D0C0DF0F5F400F0000000F00000F000F40DF4F4F5F4F400F4
- F50C00F0F50D0DF40DF50DF4110DF400F5F0F500F511F50DF0F4F5DB0D00F000
- 000000F0F4F000F40D11F4F0F5F4000DF40000000DF40D0C0D15F5F4F5F4F4F5
- 0D150CF4F4F4F4F4F5F40DF4F40D0DF4F5F0F400F0F500F0F111F4F4F5F40DF4
- F4F4F5F4F50D0DF4F4F10D110C111111100D0C11110DF4F4000000F000F00000
- F00000F5F4F0F5F4F4F500F5F40DF00000F4F40CF0F00CF0F5F00000F4F4F400
- 00F4F4F400F5F4F1F000F00000000C110DF4110DDAF5F40DF4F5F4F40DF400F0
- DB0C110D0C0DF400F40DF400F011150D0CF500F5F400F0F000F40DF0F400F500
- F000F000F40DF5F40D0C0D110D11110DF400F0F0F0F00CDB1111101111111111
- 0CF4F4F5F000F000F000F000000000F4F5F4F4F4110C00F4F411F400000D110D
- F50CF50C11F400000D0DF500F00DF5F4F0F4F4F4F400F0000000F50CF5F40DF4
- F5F4F5F4F5F40DF40DF50D0CF5F4F50C0D0DF4F40D0C0DF4F40D10F5F5F40CF5
- F40DF4F50DF4F5F4F5F0F4F000F400F0000C100DF4F5F4F5F4F4F4F5F00000F5
- 0000F40D100D110D101111150DF500F0F0000000000000F000F00000F000F1F0
- 0DF500F5F4000000F4110D0CF40DF4F5150DF00000F0F400F4DB0CF500F5F411
- 0D00F0000000F000F50C0D0D0DF4F00000F0F500F4F0F4F5F000F40D0D0CF40D
- 10111111F4DB0DF400F51100F40DF0F4F0F4F0F4F0F4F500F0F50000F00D0D11
- 0CF40D0C0D0D0DF4000000F0F4F5F4F5111110111111141511F4F0F50000F000
- F000F000F00000F0F00D0CF4000000110D0000000D0CF4110D1011F4F4DBF500
- 00F011F000F0F0F400F4F4F5F000F4000000F0F4F4F50CF4F0F400F0F0F4F400
- 0000F5F4F0F4F50D0C0C0D11DB1115110C0D0DF4F0F4F400F4F5000000F5F4F5
- 0CDBF4F0F5F400F0F10DF4F40D0D0D0C0DF000F0F0F100F4F5F4F500F40C0D0D
- 0C0D0D110CF500F000F0000000F000000000F000F5F4F5F00DF4000CF40000F0
- F50C0D110C0D110C110CF00000F5110000F0F50D0CDBF5000000110000001111
- F0F4110DF4F5F40D11F5F5F4F4F40D0D00F5F4F4F5F50C0CF4F5F410F5F40CF5
- F0F50D00F0F4F5F4F0F0F0F4F1F4F500F0F40000F40DF4F0F50CF4F50CF400F0
- 000C0DF0F000F0F4110D1110111011100DF4F0F4000000F00000F000F00000F0
- F00C0DF00DF5F0110D0000F011110CDB0D0CDB1111110C0000F00DF0F4DBF4F4
- F5F4F00DF400F40000000DDBF0F00DF4F40DF4F50CF4F5F4F5F0F4F0F0F0F5F4
- F411110DF4F40D1110110DF4F0F40DF0F1F40C0DF5F4F5F0F400F4F000F5F0F0
- 00F411150D0D0D0D0D0D0DF400F1F4F00000F5F40D0C11111111111111F400F1
- F000000000F0000000F00000F4F50CF00CF4000DF40000F00CF5F40DF40D0CF5
- F40DF50000F011F0F00DF0F50CF5F4F4F5F011000000F0F0000D110DF4F00D0C
- 110D0C0DF4000000F4F4F4F5F4F41111F4F5F4150D0D0CF0F50000F40CF40D0C
- F5F40DF4F5F0F500F0F00000F50CF5F4F4F4F4F40CF40DF4000000F5F000F4F0
- F00C1110111011150DF4F5F4F000F000F000F000F00000F0F5F4F5F011F5000D
- F500F00000F0F0F4F0F0F500F400F00000F40D00F00DF4F4F4F5F40DF000F400
- 00000C0DF0F40DF4F5F4F5F4F5F4F50CF50000F00D0D0D0CF5F00D0CF5F4F40D
- F4F4110D0CF000110D0D110D0CF000F4F0F0F400F0F000F0F40DF4F411111111
- 1111150D00F4F0F40000F40D0D111111111111110CF50CF0000000F000000000
- 000000F0F0F0F4F4F5F4F4F4F0000000F0F50CF5F4F5F4F40DF0000000F00DF0
- F411F4F0F5F4F411F4000D000000F50000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000F500000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000000000000000000000000000F500
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000000000000000000000000000F5000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000F50000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000F100000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000F000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000000000000024ECECEC24000000000000000000000000
- 00000000000000000000F1000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000000000000000000048F9F9F9F9F9
- EC00000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000ECF9F9F9F9F94800000000000000000000000000000000000000
- 0000F00000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000000000000000000000F9F9F9F9F96C00000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000090
- F9F9F9F9F9000000000000000000000000000000000000000000F10000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000006CF9F9F9F9F9000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000008FFFF0700000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000000000000048F9F9F9F9F9EC0000
- 000000000000000000000000000000000000F000000000000000000000000000
- 00000000000000000000000000000000000000000008FFFF0700000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000ECF9F9F9F9F94800000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0008FFFF07000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000000000000000F9F9F9F9F96C00000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000000000AAFFF607000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000090F9F9F9
- F9900000000000000000000000000000000000000000F0000000000000000000
- 0000000000000000000000000000000000000000000000000008FFFF07000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000006CF9F9F9F9F9000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000008D1FF070000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000000048F9F9F9F9F9EC0000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000008FFFF070000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- ECF9F9F9F9F94800000000000000000000000000000000000000F00000000000
- 0000000000000000002DF500000000000000000000000000000000000008FFFF
- 070000F0F5000000000000000000000000000000000000000000000000000000
- F0F5F5000000000000000000F0F5000000000000000000002DF5000000000000
- 00000000000000000000000000F9F9F9F9F96C00000000000000000000000000
- 0000000000000000000000000000000000000007FFFFFFFFF631000000000000
- 08FFFF070000000000AAFFFF55F0FFFFFFFF07000000000008FFFF0700000000
- 0007FFFF08000000000007F6FFFFFFFFFF820000000007FFFFFFFFF700F5F6FF
- 8607F6FFFFFFFF082D00000000000000000000000000000000F9F9F9F9F99000
- 00000000000000000000000000000000000000000000000000000000000008FF
- FFFFF6FFFFFFF7000000000008FFFF07000000000008FFFF07FFFFFFFFFFFF86
- 0000000008FFFF07000000000007FFFF0800000000AFF6FFFFF6F6F6F6FF0000
- 0031FFFFFFFFF6FF082DFFFF55FFFFFFF6F6F6FFFF3100000000000000000000
- 00000000006CF9F9F9F9F9000000000000000000000000000000000000000000
- 000000000000000000AFFFFFFFF70708FFFFFF070000000008FFFF0700000000
- 0008FFFFFFFF860782FFFFFF0700000008FFFF07000000000007FFFF08000000
- AFFFFFFFF72DF5F50708000000F6FFFFFFF707F6FFFFFFFF3107FF59F5F5F7FF
- FFF6F5000000000000000000000000000048F9F9F9F9F9EC0000000000000000
- 00000000000000000000F000000000000000000007FFFFFFF000000031FFFFFF
- 00000000AAFFF607000000000008FFFFFFF700000007FFFFFF00000008FFF607
- 000000000007FFD108000007FFFFFFF00000000000000000F5FFFFFF31000000
- 86FFFFF60700000000ECEC07FFFF82ECECECECECECECECECECECECECEC24F9F9
- F9F9F948ECECECECECEC00000000000000000000000000000000000000000000
- FFFFFF07000000000082FFFFF700000008FFFF070000000000AAFFFFFF000000
- 0000F6FFFF070000AAFFFF07000000000007FFFF080000F6FFFF070000000000
- 0000000007FFFFF60000000000FFFFFF0700000048F9F9F9FFFFF6F9F9F9F9F9
- F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F96C000000000000000000
- 00000000000000000000002DFFFFFF000000000000F5F6FFFF00000008D1FF07
- 000000000008FFFF86000000000007FFFF86000008FFFF07000000000007F6FF
- 0800F0FFFFFF00000000000000000000F7FFFF820000000000D1FFFF07000000
- ECF9F9F9FFFFFFF9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9
- F9F9F90000000000000000000000000000000000000000F7FFFF070000000000
- 0000F6FFFF31000008FFFF07000000000008FFFF070000000000F5FFFFFF0000
- 08FFFF07000000000007FFFFAA0007FFFF080000000000000000000008FFFF07
- 000000000008FFFF07000000006CF9B6FFFFFFF9F9F9F9F9F9F9F9F9F9F9F9F9
- F9F9F9F9F9F9F9F9F9F9F9F9F9F9F94800000000000000000000000000000000
- 000000F6FFFF310000000000000082FFFFF7000008FFF6070000000000AAFFF6
- 07000000000000FFFFFF0000AAFFF607000000000007FFFF080007FFFF070000
- 000000000000000008FFF6070000000000AAFFF607000000000001CCFFFFAA24
- 48484848484848484848484848486CF9F9F9F9F9014848484848482400000000
- 000000000000F00000000000000000FFFFFF000000000000000007FFFF080000
- AAFFFF07000000000008FFFF07000000000000FFFFF6F50008FFFF0700000000
- 0007FFFF8600AAFFFF5500000000000000000000AAFFFF07000000000008FFFF
- 07000000000082FFFFFF5100000000000000000000000000000024F9F9F9F9F9
- EC00000000000000000000000000000000002800000000000000F5F6FFFF0000
- 000000000000F5F6FFFF000008FFFF07000000000008D1FF07000000000000FF
- FFFFF50008FFFF07000000000007F6FF080008FFFFF7F1F4F5F5F5F5F52DF500
- 08FFFF07000000000008D1FF07000000F5F6FFFFFFC8F9240000000000000000
- 00000000000000F9F9F9F9F9480000000000000000000000000000000000F000
- 000000000000F5FFF6AF0000000000000000F5FFFFFF000008FFFF0700000000
- 0008FFFF07000000000000FFFFF6F500AAFFFF07000000000007FFFFAA0008FF
- FFFFFFFFFFFFFFFFFFFFFF0008FFFF07000000000008FFFF07000031FFFFFFFF
- F790F9F9240000000000000000000000000000F9F9F9F9F99000000000000000
- 00000000000000000000000000000000000007FFFFAA000000000000000000FF
- FFFF0000AAFFFF07000000000008FFF607000000000000FFFFFFF50008FFF607
- 000000000007FFFF080082FFFFFFF6F6F6F6FFFFFFFFFF00AAFFF60700000000
- 0008FFF6070031FFFFFFFF07000090F9F9240000000000000000000000000090
- F9F9F9F9F90000000000000000000000000000000000F00000000000000007FF
- FF08000000000000000000FFFFFFF50008FFFF070000000000AAFFFF07000000
- 000000FFFFFF000008FFFF07000000000007FFFFAA0007FFFF07F5F5F5F5F5F0
- FFFFFF0086FFFF070000000000AAFFFF0700FFFFFF08F00000000090F9F9EC00
- 000000000000000000000048F9F9F9F9F9000000000000000000000000000000
- 0000000000000000000007F6FF08000000000000000000FFFFFFF100AAFFFF82
- 000000000008FFFF070000000000F5F6FFF60000AAFFFF07000000000007FFFF
- 080031FFFFF7000000000000FFFFAF0008FFFF07000000000008FFFF5531FFFF
- F600000000000000F9F9F9EC000000000000000000000024F9F9F9F9F9EC0000
- 0000000000000000000000000000000000000000000007FFFFAA000000000000
- 000000FFFFFFF40008FFFFFF000000000008FFFF86000000000007FFF6AF0000
- 08FFFFF7000000000007FFFF080000FFFF080000000000F0FFFF0800AAFFFF07
- 000000000008FFFF3108FFFF3100000000000000ECF9F9F9EC00000000000000
- 00000000F9F9F9F9F94800000000000000000000000000000000000000000000
- 000007FFFF08000000000000000000FFFFF6F50008FFFFFF0700000000AAFFFF
- FF000000000008FFFF07000008FFFFF6000000000008FFFF07000008FFFF0000
- 00000007FFFF070008FFF607000000000008FFFF3186FFF6F100000000000000
- 00ECF9F9F90000000000000000000000F9F9F9F9F96C00000000000000000000
- 000000000000000000000000000007FFFF08000000000000000000FFFFFFF500
- AAFFFFFFFF0700000008FFFFFF0700000031FFFFFFF50000AAFFFFFF07000000
- F0FFFFFF31000007FFFFF700000000F6FFFFF000AAFFFF070000000000AAFFFF
- 5507FFFF07000000000000000000ECF9F9900000000000000000000090F9F9F9
- F990000000000000000000000000000000000000000000000000F5F6FF080000
- 000000000000F5F6FFFF000008FFFF07FFFFFF08F186FFFFFFFF07F159FFFFFF
- 0800000008FFFFFFFF07F531FFFFFFFF00000000FFFFFF070000F7FFFF080000
- 08FFFF07000000000008FFFF3100FFFFFF31000031820000000000ECF9F99000
- 000000000000000048F9F9F9F9F900000000000000000000000000000000F000
- 000000000000F5FFFFFF0000000000000000F5FFFFFF000008FFFF00FFFFFFFF
- F4AAFFFFF0FFFFFFFFFFFFFFF000000008FFFF07FFFFFFFFFFFFFF0700000000
- F0F6FFFFFFFFFFFFFFF1000008FFFF07000000000008FFFF070007FFFFFFFFFF
- FFFFF0000000000024F9F990000000000000000024F9F9F9F9F9EC0000000000
- 00000000000000000000000000000000000000FFFFFF000000000000000007FF
- FFF60000F6F6FF00F0F6FFFFF108F6FF0031FFFFFFFFFF2D00000000AAFFFF31
- F0F6F6FFFFFFF7000000000000F108FFFFFFFFFFF000000008F6FF0700000000
- 0008F6FF07000007FFFFFFFFF6FF2D00000000000024F9F96C00000000000000
- 00F9F9F9F9F948000000000000000000000000000000000000000000000000F6
- FFFF2D00000000000000F7FFFF8200002DF52D0000003107F0F52DF500000031
- 073100000000000008FFFF550000F50707F0000000000000000000F007072D00
- 00000000F52DF5F00000000000F52DF5F000000000310707F500000000000000
- 000024F9F96C00000000000000F9F9F9F9F96C00000000000000000000000000
- 0000000000000000000000F7FFFF0700000000000000F6FFFF07000000000000
- 000000000000000000000000000000000000000008D1FF070000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000000000000024F9F96C00000000000090F9F9F9F99000
- 00000000000000000000000000000000000000000000002DFFFFF60000000000
- 0000FFFFFFF00000000000000000000000000000000000000000000000000000
- 08FFFF0700000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000024F9F948
- 000000000048F9F9F9F9F9000000000000000000000000000000000000000000
- 00000000F6FFF6F50000000000F7FFFFAF000000000000000000000000000000
- 00000000000000000000000008FFF60700000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000001F9F9240000000024F9F9F9F9F9EC0000000000000000
- 000000000000F000000000000000000031FFFFF600000000F5F6FFF631000000
- 000000000000000000000000000000000000000000000000AAFFFF0700000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000007312D07318200D1000000006CF9F92400000000F9F9
- F9F9F92400000000000000000000000000000000000000000000000000AFF6FF
- F631F555FFFFFFAF000000000000000000000000000000000000000000000000
- 0000000008FFFF07000000000000000000000000000000000000000000000000
- 00000000000000000000000000000000000000000000072DF0AA07F6F5080000
- 0000006CF9F924000000F9F9F9F9F90100000000000000000000000000000000
- 00000000000000000000AFFFFFFFFFFFFFFFFFF0000000000000000000000000
- 0000000000000000000000000000000008FFFF07000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000007F50008AF3107070000000000006CF9F9EC000090F9F9F9F99000000000
- 0000000000000000000000000000000000000000000000F7FFFFFFFFFF080000
- 0000000000000000000000000000000000000000000000000000000008FFFF07
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000072D00FFF700AF07000000000000006CF9F9
- EC0001F9F9F9F9F9000000000000000000000000000000000000000000000000
- 0000000000310707F00000000000000000000000000000000000000000000000
- 000000000000000008FFFF070000000000000000000000000000000000000000
- 00000000000000000000000000000000000000000000000000F7AF0807082D00
- F707000000000000000090F9F9EC24F9F9F9F9F9000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000000000000090F9F9ECF9F9F9F9F9
- 2400000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000090F990F9F9F9F9F94800000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000090F9F9F9F9F9F99000000000000000
- 000000000000F000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000000000000000000000000000000000000000000090F9
- F9F9F9F9F9000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000F9F9F9F9F9F9000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000ECF9F9F9F9F9EC0000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000ECF9F9F9F94800000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000ECF9F9F96C00000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000000000000000000000000000ECF9
- F9F9000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000F00000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000000000000000000000000000F0000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000000000000000000000000000F0000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000EC0000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000F000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000000000000000000000000000EC00
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000EC000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000000000000000000000000000F0000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000EC0000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000}
- end
- end
- object btnOK: TButton
- Left = 367
- Top = 277
- Width = 88
- Height = 25
- Cancel = True
- Caption = 'OK'
- ModalResult = 2
- TabOrder = 1
- OnClick = btnOKClick
- end
-end
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/e5/e58a55a5876b7cacf39345aacd34bc0f4d3271f7.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/e5/e58a55a5876b7cacf39345aacd34bc0f4d3271f7.svn-base
deleted file mode 100644
index 0eff8b5c..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/e5/e58a55a5876b7cacf39345aacd34bc0f4d3271f7.svn-base
+++ /dev/null
@@ -1,99 +0,0 @@
-{*********************************************************}
-{* O32VLREG.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 o32vlreg;
- {Registration unit for the Orpheus Validator components.}
-
-interface
-
-uses
- Classes, O32Vldtr;
-
-var
- ValidatorList: TStrings;
-
-procedure RegisterValidator(ValidatorClass: TValidatorClass);
-procedure UnRegisterValidator(ValidatorClass: TValidatorClass);
-procedure GetRegisteredValidators(aList: TStrings);
-
-implementation
-
-procedure RegisterValidator(ValidatorClass: TValidatorClass);
-begin
- if ValidatorClass.InheritsFrom(TO32BaseValidator) then begin
- if ValidatorList.IndexOf(ValidatorClass.ClassName) = -1 then begin
- RegisterClass(TPersistentClass(ValidatorClass));
- ValidatorList.Add(ValidatorClass.ClassName);
- end;
- end;
-end;
-{=====}
-
-procedure UnRegisterValidator(ValidatorClass: TValidatorClass);
-var
- i: Integer;
-begin
- i := ValidatorList.IndexOf(ValidatorClass.ClassName);
- if i > -1 then begin
- ValidatorList.Delete(i);
- UnRegisterClass(TPersistentClass(ValidatorClass));
- end;
-end;
-{=====}
-
-procedure GetRegisteredValidators(aList: TStrings);
-begin
- Assert(Assigned(ValidatorList));
- Assert(Assigned(aList));
-
- aList.Clear;
- aList.BeginUpdate;
- aList.Assign(ValidatorList);
- aList.EndUpdate;
-end;
-
-initialization
-
- ValidatorList := TStringList.Create;
- ValidatorList.Add('None');
-
-
-finalization
-
- ValidatorList.Free;
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/e6/e64f4d5c9937dda3f1ef09389a8c91e1023c1441.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/e6/e64f4d5c9937dda3f1ef09389a8c91e1023c1441.svn-base
deleted file mode 100644
index 054b6511..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/pristine/e6/e64f4d5c9937dda3f1ef09389a8c91e1023c1441.svn-base and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/e8/e8c0224d48c1d0d36da869ce70470a56eb5c0cf7.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/e8/e8c0224d48c1d0d36da869ce70470a56eb5c0cf7.svn-base
deleted file mode 100644
index 8d0fe64e..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/e8/e8c0224d48c1d0d36da869ce70470a56eb5c0cf7.svn-base
+++ /dev/null
@@ -1,152 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
- ovcbase, ovctcbmp, ovctccbx, ovctcgly, ovctcbox, ovctcedt,
- ovctchdr, ovctcmmn, ovctcell, ovctcstr, ovctable;
-
-const
- MaxDataRecs = 20;
- MaxStrLen = 100;
- MaxMemoLen = 1000;
- cnStr = 1; {Column numbers for controls}
- cnMemo = 2;
- cnCheckbox = 3;
- cnCombo = 4;
- cnBitmap = 5;
-
-type
- TDataRec = record
- Str : string[MaxStrLen];
- Memo : array[0..MaxMemoLen] of Char;
- Check : TCheckBoxState;
- ComboIndex : Integer;
- Bitmap : TBitmap;
- end;
-
- TDataArray = array[1..MaxDataRecs] of TDataRec;
-
- TForm1 = class(TForm)
- OvcTable1: TOvcTable;
- OvcController1: TOvcController;
- OvcTCColHead1: TOvcTCColHead;
- OvcTCRowHead1: TOvcTCRowHead;
- OvcTCString1: TOvcTCString;
- OvcTCMemo1: TOvcTCMemo;
- OvcTCCheckBox1: TOvcTCCheckBox;
- OvcTCComboBox1: TOvcTCComboBox;
- OvcTCBitMap1: TOvcTCBitMap;
- procedure FormCreate(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure OvcTable1GetCellData(Sender: TObject; RowNum,
- ColNum: Integer; var Data: Pointer; Purpose: TOvcCellDataPurpose);
- procedure OvcTCComboBox1Change(Sender: TObject);
- private
- BmpPath : string; {Path to Orpheus .bmp files}
- DataArray : TDataArray; {A place to store data entered in table}
- public
- end;
-
-var
- Form1: TForm1;
-
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.dfm} {Link Delphi form file}
-{$ELSE}
-{$R *.lfm}
-{$ENDIF}
-
-procedure TForm1.FormCreate(Sender: TObject);
- {Initialize the main form.
- Do anything that needs to be done before the form
- can be displayed.}
-var
- SearchResult : Integer;
- SearchRec : TSearchRec;
-begin
- OvcTable1.RowLimit := MaxDataRecs + OvcTable1.LockedRows;
-
- OvcTCString1.MaxLength := MaxStrLen; {Be sure to set this here or in form}
- OvcTCMemo1.MaxLength := MaxMemoLen;
-
- {Populate cell combo box with names of Orpheus control bitmap files.
- Assumes bitmap files are two levels up from program with Windows and GTK
- or five levels up with OS X app bundle folder.}
- BmpPath := ExtractFilePath(ParamStr(0)) + '..' + PathDelim + '..' + PathDelim;
- if FindFirst(BmpPath + 'TO*.bmp', 0, SearchRec) <> 0 then
- begin
- BmpPath := '..' + PathDelim + '..' + PathDelim;
- if FindFirst(BmpPath + 'TO*.bmp', 0, SearchRec) <> 0 then
- BmpPath := ExtractFilePath(ParamStr(0)) + '..' + PathDelim + '..' +
- PathDelim + '..' + PathDelim + '..' + PathDelim + '..' + PathDelim;
- end;
- OvcTCComboBox1.Items.Add(' (None)'); {So we can "unselect"}
- try
- SearchResult := FindFirst(BmpPath + 'TO*.bmp', 0, SearchRec);
- while SearchResult = 0 do {Do until no more matching files found}
- begin
- OvcTCComboBox1.Items.Add(SearchRec.Name);
- SearchResult := FindNext(SearchRec);
- end;
- finally
- FindClose(SearchRec);
- end;
-end; {TForm1.FormCreate}
-
-
-procedure TForm1.FormDestroy(Sender: TObject);
-var
- RecNum : Integer;
-begin
- for RecNum := 1 to MaxDataRecs do {Free any TBitmap's created}
- DataArray[RecNum].Bitmap.Free;
-end; {TForm1.FormDestroy}
-
-
-procedure TForm1.OvcTable1GetCellData(Sender: TObject; RowNum,
- ColNum: Integer; var Data: Pointer; Purpose: TOvcCellDataPurpose);
- {This event handler is called when the table needs data to display
- or edit in a cell or a place to save a cell's edited data.}
-begin
- Data := nil;
- if (RowNum < OvcTable1.LockedRows) or (RowNum > OvcTable1.RowLimit) then
- Exit;
-
- case ColNum of
- cnStr : Data := @DataArray[RowNum].Str;
- cnMemo : Data := @DataArray[RowNum].Memo;
- cnCheckbox : Data := @DataArray[RowNum].Check;
- cnCombo : Data := @DataArray[RowNum].ComboIndex;
- cnBitmap : Data := pointer(DataArray[RowNum].Bitmap);
- end;
-end; {TForm1.OvcTable1GetCellData}
-
-
-procedure TForm1.OvcTCComboBox1Change(Sender: TObject);
- {This event handler is called whenever combo box selection
- changes.
- Note: TOvcTCComboBox is not descended from TCustomComboBox, but
- its editing control (Sender) is, so okay to typecast it in order
- to reference ItemIndex.}
-begin
- DataArray[OvcTable1.ActiveRow].Bitmap.Free;
- DataArray[OvcTable1.ActiveRow].Bitmap := nil;
- if TCustomComboBox(Sender).ItemIndex > 0 then {Bitmap file selected?}
- begin
- DataArray[OvcTable1.ActiveRow].Bitmap := TBitmap.Create;
- DataArray[OvcTable1.ActiveRow].Bitmap.LoadFromFile(
- BmpPath + OvcTCComboBox1.Items[TCustomComboBox(Sender).ItemIndex]);
- end;
- OvcTable1.AllowRedraw := False;
- OvcTable1.InvalidateCell(OvcTable1.ActiveRow, cnBitmap); {Force display of bitmap}
- OvcTable1.AllowRedraw := True;
-end; {TForm1.OvcTCComboBox1Change}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/e8/e8d00a0010aca757209e2147f1c07f6f113a06c5.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/e8/e8d00a0010aca757209e2147f1c07f6f113a06c5.svn-base
deleted file mode 100644
index e6f42378..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/e8/e8d00a0010aca757209e2147f1c07f6f113a06c5.svn-base
+++ /dev/null
@@ -1,372 +0,0 @@
-{*********************************************************}
-{* OVCEXCPT.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 ovcexcpt;
- {-Exceptions unit}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, {$ENDIF}
- Classes, SysUtils, OvcData, OvcConst, OvcIntl;
-
-type
- {*** Base Orpheus exeption class ***}
- EOvcException = class(Exception)
- public
- ErrorCode : LongInt;
- end;
-
- {*** General ***}
- ENoTimersAvailable = class(EOvcException)
- public
- constructor Create;
- end;
-
- {*** Controller ***}
- EControllerError = class(EOvcException);
- ENoControllerAssigned = class(EControllerError)
- public
- constructor Create;
- end;
-
- {*** Command Processor ***}
- ECmdProcessorError = class(EOvcException);
- EDuplicateCommand = class(ECmdProcessorError)
- public
- constructor Create;
- end;
-
- ETableNotFound = class(ECmdProcessorError)
- public
- constructor Create;
- end;
-
- {*** Entry Fields ***}
- EEntryFieldError = class(EOvcException);
- EInvalidDataType = class(EEntryFieldError)
- public
- constructor Create;
- end;
-
- EInvalidPictureMask = class(EEntryFieldError)
- public
- constructor Create(const Mask : string);
- end;
-
- EInvalidRangeValue = class(EEntryFieldError)
- public
- constructor Create(DataType : Byte);
- end;
-
- EInvalidDateForMask = class(EEntryFieldError)
- public
- constructor Create;
- end;
-
- {*** Editors ***}
- EEditorError = class(EOvcException)
- public
- constructor Create(const Msg : string; Error : Cardinal);
- end;
-
- EInvalidLineOrCol = class(EEditorError)
- public
- constructor Create;
- end;
-
- EInvalidLineOrPara = class(EEditorError)
- public
- constructor Create;
- end;
-
- {*** Viewers ***}
- EViewerError = class(EOvcException);
- ERegionTooLarge = class(EViewerError)
- public
- constructor Create;
- end;
-
- {*** Notebook ***}
- ENotebookError = class(EOvcException);
- EInvalidPageIndex = class(ENotebookError)
- public
- constructor Create;
- end;
-
- EInvalidTabFont = class(ENotebookError)
- public
- constructor Create;
- end;
-
- {*** Rotated Label ***}
- ERotatedLabelError = class(EOvcException);
- EInvalidLabelFont = class(ERotatedLabelError)
- public
- constructor Create;
- end;
-
- {*** Timer Pool ***}
- ETimerPoolError = class(EOvcException);
- EInvalidTriggerHandle = class(ETimerPoolError)
- public
- constructor Create;
- end;
-
- {*** Virtual ListBox ***}
- EVirtualListBoxError = class(EOvcException);
- EOnSelectNotAssigned = class(EVirtualListBoxError)
- public
- constructor Create;
- end;
-
- EOnIsSelectedNotAssigned = class(EVirtualListBoxError)
- public
- constructor Create;
- end;
-
- {*** Report View ***}
- EReportViewError = class(EOvcException) { generic report view exception}
- constructor Create(ErrorCode : Integer; Dummy : Byte);
- constructor CreateFmt(ErrorCode : Integer; const Args : array of const; Dummy : Byte);
- end;
- EUnknownView = class(EReportViewError); { unknown view name }
- EItemNotFound = class(EReportViewError); { attempt to change/remove nonexistent item}
- EItemAlreadyAdded = class(EReportViewError); { attempt to re-add existing item }
- EUpdatePending = class(EReportViewError); { operation is invalid while updates are pending }
- EItemIsNotGroup = class(EReportViewError); { item at specified line is not a group (IsGroup = False) }
- ELineNoOutOfRange = class(EReportViewError); { specified line is invalid (out of range) }
- ENotMultiSelect = class(EReportViewError); { operation is invalid while MultiSelect is false }
- EItemNotInIndex = class(EReportViewError); { specified data item is not in index }
- ENoActiveView = class(EReportViewError); { no active view }
- EOnCompareNotAsgnd = class(EReportViewError); { unassigned OnCompareFields }
- EGetAsFloatNotAsg = class(EReportViewError); { unassigned OnGetFieldAsFloat }
- EOnFilterNotAsgnd = class(EReportViewError); { unassigned OnFilter }
-
- {*** Sparse Array ***}
- ESparseArrayError = class(EOvcException);
- ESAEAtMaxSize = class(ESparseArrayError);
- ESAEOutOfBounds = class(ESparseArrayError);
-
- {*** Fixed Font ***}
- EFixedFontError = class(EOvcException);
- EInvalidFixedFont = class(EFixedFontError)
- public
- constructor Create;
- end;
-
- EInvalidFontParam = class(EFixedFontError)
- public
- constructor Create;
- end;
-
- {*** MRU List ***}
- EMenuMRUError = class(EOvcException);
-
-implementation
-
-
-{*** General ***}
-
-constructor ENoTimersAvailable.Create;
-begin
- inherited Create(GetOrphStr(SCNoTimersAvail));
-end;
-
-
-{*** Controller ***}
-
-constructor ENoControllerAssigned.Create;
-begin
- inherited Create(GetOrphStr(SCNoControllerAssigned));
-end;
-
-
-{*** Command Processor ***}
-
-constructor ETableNotFound.Create;
-begin
- inherited Create(GetOrphStr(SCTableNotFound));
-end;
-
-constructor EDuplicateCommand.Create;
-begin
- inherited Create(GetOrphStr(SCDuplicateCommand));
-end;
-
-
-{*** Entry Fields ***}
-
-constructor EInvalidDataType.Create;
-begin
- inherited Create(GetOrphStr(SCInvalidDataType));
-end;
-
-constructor EInvalidPictureMask.Create(const Mask : string);
-begin
- inherited CreateFmt(GetOrphStr(SCInvalidPictureMask), [Mask]);
-end;
-
-constructor EInvalidRangeValue.Create(DataType : Byte);
-var
- S : string;
-begin
- case DataType of
- fsubLongInt : inherited CreateFmt(GetOrphStr(SCInvalidRange), [Low(LongInt), High(LongInt)]);
- fsubWord : inherited CreateFmt(GetOrphStr(SCInvalidRange), [Low(Word), High(Word)]);
- fsubInteger : inherited CreateFmt(GetOrphStr(SCInvalidRange), [Low(SmallInt), High(SmallInt)]);
- fsubByte : inherited CreateFmt(GetOrphStr(SCInvalidRange), [Low(Byte), High(Byte)]);
- fsubShortInt : inherited CreateFmt(GetOrphStr(SCInvalidRange), [Low(ShortInt), High(ShortInt)]);
- fsubReal : inherited Create(GetOrphStr(SCInvalidRealRange));
- fsubExtended : inherited Create(GetOrphStr(SCInvalidExtendedRange));
- fsubDouble : inherited Create(GetOrphStr(SCInvalidDoubleRange));
- fsubSingle : inherited Create(GetOrphStr(SCInvalidSingleRange));
- fsubComp : inherited Create(GetOrphStr(SCInvalidCompRange));
- fsubDate :
- begin
- S := OvcIntlSup.InternationalDate(True);
- inherited CreateFmt(GetOrphStr(SCInvalidDateRange), [S]);
- end;
- fsubTime :
- begin
- S := OvcIntlSup.InternationalTime(False);
- inherited CreateFmt(GetOrphStr(SCInvalidTimeRange), [S]);
- end;
- else
- inherited Create(GetOrphStr(SCInvalidRangeValue));
- end;
-end;
-
-constructor EInvalidDateForMask.Create;
-begin
- inherited Create(GetOrphStr(SCInvalidDateForMask));
-end;
-
-
-{*** Editors ***}
-
-constructor EEditorError.Create(const Msg : string; Error : Cardinal);
-begin
- ErrorCode := Error;
- inherited Create(Msg);
-end;
-
-constructor EInvalidLineOrCol.Create;
-begin
- inherited Create(GetOrphStr(SCInvalidLineOrColumn), 0);
-end;
-
-constructor EInvalidLineOrPara.Create;
-begin
- inherited Create(GetOrphStr(SCInvalidLineOrParaIndex), 0);
-end;
-
-
-{*** Viewers ***}
-
-constructor ERegionTooLarge.Create;
-begin
- inherited Create(GetOrphStr(SCRegionTooLarge));
-end;
-
-
-{*** Notebook ***}
-
-constructor EInvalidPageIndex.Create;
-begin
- inherited Create(GetOrphStr(SCInvalidPageIndex));
-end;
-
-constructor EInvalidTabFont.Create;
-begin
- inherited Create(GetOrphStr(SCInvalidTabFont));
-end;
-
-
-{*** Rotated Label ***}
-
-constructor EInvalidLabelFont.Create;
-begin
- inherited Create(GetOrphStr(SCInvalidLabelFont));
-end;
-
-
-{*** Timer Pool ***}
-
-constructor EInvalidTriggerHandle.Create;
-begin
- inherited Create(GetOrphStr(SCBadTriggerHandle));
-end;
-
-
-{*** Virtual ListBox ***}
-
-constructor EOnSelectNotAssigned.Create;
-begin
- inherited Create(GetOrphStr(SCOnSelectNotAssigned));
-end;
-
-constructor EOnIsSelectedNotAssigned.Create;
-begin
- inherited Create(GetOrphStr(SCOnIsSelectedNotAssigned));
-end;
-
-
-{*** Fixed Font ***}
-
-constructor EInvalidFixedFont.Create;
-begin
- inherited Create(GetOrphStr(SCNonFixedFont));
-end;
-
-constructor EInvalidFontParam.Create;
-begin
- inherited Create(GetOrphStr(SCInvalidFontParam));
-end;
-
-
-constructor EReportViewError.Create(ErrorCode : Integer; Dummy : Byte);
-begin
- inherited Create(GetOrphStr(ErrorCode));
-end;
-
-constructor EReportViewError.CreateFmt(ErrorCode : Integer; const Args : array of const; Dummy : Byte);
-begin
- inherited CreateFmt(GetOrphStr(ErrorCode),Args);
-end;
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/ed/ed56d6813d16ded0e56d823e597e02f0774823dc.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/ed/ed56d6813d16ded0e56d823e597e02f0774823dc.svn-base
deleted file mode 100644
index 22337847..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/pristine/ed/ed56d6813d16ded0e56d823e597e02f0774823dc.svn-base and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/ed/eda9cf3e9a2f11aa061508cda5af45559f502438.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/ed/eda9cf3e9a2f11aa061508cda5af45559f502438.svn-base
deleted file mode 100644
index 4635858f..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/pristine/ed/eda9cf3e9a2f11aa061508cda5af45559f502438.svn-base and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/ed/ede546bf36b5bd6711d604c79f3f06fa6240c6b0.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/ed/ede546bf36b5bd6711d604c79f3f06fa6240c6b0.svn-base
deleted file mode 100644
index adf4d98e..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/ed/ede546bf36b5bd6711d604c79f3f06fa6240c6b0.svn-base
+++ /dev/null
@@ -1,33 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 423
- Height = 323
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'MS Sans Serif'
- Font.Style = []
- OldCreateOrder = False
- PixelsPerInch = 96
- TextHeight = 13
- object OvcSpinner1: TOvcSpinner
- Left = 144
- Top = 88
- Width = 49
- Height = 65
- AutoRepeat = True
- Delta = 1.000000000000000000
- FocusedControl = Edit1
- end
- object Edit1: TEdit
- Left = 208
- Top = 112
- Width = 57
- Height = 21
- TabOrder = 1
- Text = '0'
- end
-end
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/ee/ee1156da0b2adeb01336bbae68a82d53d889efdc.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/ee/ee1156da0b2adeb01336bbae68a82d53d889efdc.svn-base
deleted file mode 100644
index 9d4c0b0a..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/ee/ee1156da0b2adeb01336bbae68a82d53d889efdc.svn-base
+++ /dev/null
@@ -1,2758 +0,0 @@
-{*********************************************************}
-{* OVCBASE.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}
-
-{$IFNDEF VERSION3}
-!! Error - not for Delphi versions 1 and 2 or C++ Builder version 1
-{$ENDIF}
-
-{$IFNDEF LCL}
-{$R OVCBASE.RES}
-{$ENDIF}
-
-unit ovcbase;
- {-Base unit for Orpheus visual components}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, MyMisc, {$ENDIF}
- Classes, Controls, Dialogs, Forms, StdCtrls, SysUtils,
- OvcCmd, OvcData, OvcMisc, OvcConst, OvcExcpt, {$IFNDEF LCL} OvcTimer, {$ENDIF} OvcDate;
-
-type
- TOvcLabelPosition = (lpTopLeft, lpBottomLeft); {attached label types}
-
- TOvcAttachEvent = procedure(Sender : TObject; Value : Boolean)
- of object;
-
- TOvcAttachedLabel = class(TLabel)
- protected {private}
- FControl : TWinControl;
-
- protected
- procedure SavePosition;
- procedure Loaded;
- override;
-
- public
- constructor Create(AOwner : TComponent);
- override;
- constructor CreateEx(AOwner : TComponent; AControl : TWinControl);
- virtual;
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
- override;
-
- published
- property Control : TWinControl
- read FControl write FControl;
- end;
-
- TO32ContainerList = class(TList)
- FOwner: TComponent;
- public
- constructor Create(AOwner: TComponent); virtual;
- destructor Destroy; override;
- end;
-
- TOvcLabelInfo = class(TPersistent)
- protected {private}
- {property variables}
- FOffsetX : Integer;
- FOffsetY : Integer;
-
- {event variables}
- FOnChange : TNotifyEvent;
- FOnAttach : TOvcAttachEvent;
-
- {internal methods}
- procedure DoOnAttach;
- procedure DoOnChange;
- function IsVisible : Boolean;
-
- {property methods}
- procedure SetOffsetX(Value : Integer);
- procedure SetOffsetY(Value : Integer);
- procedure SetVisible(Value : Boolean);
-
- public
- ALabel : TOvcAttachedLabel;
- FVisible : Boolean;
-
- property OnAttach : TOvcAttachEvent
- read FOnAttach write FOnAttach;
- property OnChange : TNotifyEvent
- read FOnChange write FOnChange;
-
- procedure SetOffsets(X, Y : Integer);
-
- published
- property OffsetX: Integer
- read FOffsetX write SetOffsetX stored IsVisible;
- property OffsetY: Integer
- read FOffsetY write SetOffsetY stored IsVisible;
- property Visible : Boolean
- read FVisible write SetVisible
- default False;
- end;
-
- {event method types}
- TMouseWheelEvent = procedure(Sender : TObject; Shift : TShiftState;
- Delta, XPos, YPos : Word) of object;
-
- TDataErrorEvent =
- procedure(Sender : TObject; ErrorCode : Word; const ErrorMsg : string)
- of object;
- TPostEditEvent =
- procedure(Sender : TObject; GainingControl : TWinControl)
- of object;
- TPreEditEvent =
- procedure(Sender : TObject; LosingControl : TWinControl)
- of object;
- TDelayNotifyEvent =
- procedure(Sender : TObject; NotifyCode : Word)
- of object;
- TIsSpecialControlEvent =
- procedure(Sender : TObject; Control : TWinControl;
- var Special : Boolean)
- of object;
- TGetEpochEvent =
- procedure (Sender : TObject; var Epoch : Integer)
- of object;
-
- {options which will be the same for all fields attached to the same controller}
- TOvcBaseEFOption = (
- efoAutoAdvanceChar,
- efoAutoAdvanceLeftRight,
- efoAutoAdvanceUpDown,
- efoAutoSelect,
- efoBeepOnError,
- efoInsertPushes);
- TOvcBaseEFOptions = set of TOvcBaseEFOption;
-
-type
- TOvcCollectionStreamer = class;
- TOvcCollection = class;
- TO32Collection = class;
-
- {implements the About property and collection streaming}
- TOvcComponent = class(TComponent)
- protected {private}
- FCollectionStreamer : TOvcCollectionStreamer;
- FInternal : Boolean; {flag to suppress name generation
- on collection items}
- function GetAbout : string;
- procedure SetAbout(const Value : string);
-
- protected
- {OrCollection streaming hooks:}
- procedure GetChildren(Proc: TGetChildProc; Root : TComponent); override;
- function GetChildOwner: TComponent; override;
- procedure Loaded; override;
-
- public
- constructor Create(AOwner: TComponent);
- override;
- destructor Destroy;
- override;
-
- property CollectionStreamer : TOvcCollectionStreamer
- read FCollectionStreamer
- write FCollectionStreamer;
- property Internal : Boolean read FInternal write FInternal;
- published
- {properties}
- property About : string
- read GetAbout
- write SetAbout
- stored False;
- end;
-
- {implements the About property}
- TO32Component = class(TComponent)
- protected {private}
- FInternal : Boolean; {flag to suppress name generation
- on collection items}
- function GetAbout : string;
- procedure SetAbout(const Value : string);
- public
- constructor Create(AOwner: TComponent); override;
- property Internal : Boolean read FInternal write FInternal;
- published
- {properties}
- property About : string read GetAbout write SetAbout stored False;
- end;
-
- TOvcController = class(TOvcComponent)
- protected {private}
- FBaseEFOptions : TOvcBaseEFOptions; {options common to all entry fields}
- FEntryCommands : TOvcCommandProcessor; {command processor}
- FEpoch : Integer; {combined epoch year and century}
- FErrorPending : Boolean; {an error is pending for an ef}
- FErrorText : string; {text of last error}
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
- FHandle : TOvcHWnd{hWnd}; {our window handle}
-
- FInsertMode : Boolean; {global insert mode flag}
-{$IFNDEF LCL} //Currently not implemented
- FTimerPool : TOvcTimerPool; {general timer pool}
-{$ENDIF}
-
- {events}
- FOnDelayNotify : TDelayNotifyEvent;
- FOnError : TDataErrorEvent;
- FOnGetEpoch : TGetEpochEvent;
- FOnIsSpecialControl : TIsSpecialControlEvent;
- FOnPostEdit : TPostEditEvent;
- FOnPreEdit : TPreEditEvent;
-{$IFNDEF LCL}
- FOnTimerTrigger : TTriggerEvent;
-{$ENDIF}
-
- {property methods}
- function GetEpoch : Integer;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
- function GetHandle : TOvcHWnd{hWnd};
- procedure SetEpoch(Value : Integer);
-
- {internal methods}
- procedure cWndProc(var Msg : TMessage);
- {-window procedure}
-
- public
- constructor Create(AOwner: TComponent);
- override;
- destructor Destroy;
- override;
-
- procedure DestroyHandle;
-
-{$IFDEF LCL}
- function PostMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL;
-{$ENDIF}
- {wrappers for event handlers}
- procedure DoOnPostEdit(Sender : TObject; GainingControl : TWinControl);
- {-call the method assigned to the OnPostEdit event}
- procedure DoOnPreEdit(Sender : TObject; LosingControl : TWinControl);
- {-call the method assigned to the OnPreEdit event}
- procedure DoOnTimerTrigger(Sender : TObject; Handle : Integer;
- Interval : Cardinal; ElapsedTime : LongInt);
-
- procedure DelayNotify(Sender : TObject; NotifyCode : Word);
- {-start the chain of events that will fire the OnDelayNotify event}
- procedure DoOnError(Sender : TObject; ErrorCode : Word; const ErrorMsg : string);
- {-call the method assigned to the OnError event}
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
- function IsSpecialButton(H : TOvcHWnd{hWnd}) : Boolean;
- dynamic;
- {-return true if H is btnCancel, btnHelp, or btnRestore}
- procedure MarkAsUninitialized(Uninitialized : Boolean);
- {-mark all entry fields on form as uninitialized}
- function ValidateEntryFields : TComponent;
- {-ask each entry field to validate its contents. Return nil
- if no error, else return pointer to field with error}
- function ValidateEntryFieldsEx(ReportError, ChangeFocus : Boolean) : TComponent;
- {-ask each entry field to validate its contents. Return nil
- if no error, else return pointer to field with error.
- Conditionally move focus and report error}
- function ValidateTheseEntryFields(const Fields : array of TComponent) : TComponent;
- {-ask the specified entry fields to validate their contents. Return nil
- if no error, else return pointer to field with error}
-
- property ErrorPending : Boolean
- read FErrorPending write FErrorPending;
- property ErrorText : string
- read FErrorText write FErrorText;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
- property Handle : TOvcHWnd{hWnd}
- read GetHandle;
- property InsertMode : Boolean
- read FInsertMode write FInsertMode;
-{$IFNDEF LCL}
- property TimerPool : TOvcTimerPool
- read FTimerPool;
-{$ENDIF}
-
- published
- {properties}
- property EntryCommands : TOvcCommandProcessor
- read FEntryCommands write FEntryCommands stored True;
- property EntryOptions : TOvcBaseEFOptions
- read FBaseEFOptions write FBaseEFOptions
- default [efoAutoSelect, efoBeepOnError, efoInsertPushes];
- property Epoch : Integer
- read GetEpoch write SetEpoch;
-
- {events}
- property OnError : TDataErrorEvent
- read FOnError write FOnError;
- property OnGetEpoch : TGetEpochEvent
- read FOnGetEpoch write FOnGetEpoch;
- property OnDelayNotify : TDelayNotifyEvent
- read FOnDelayNotify write FOnDelayNotify;
- property OnIsSpecialControl : TIsSpecialControlEvent
- read FOnIsSpecialControl write FOnIsSpecialControl;
- property OnPostEdit : TPostEditEvent
- read FOnPostEdit write FOnPostEdit;
- property OnPreEdit : TPreEditEvent
- read FOnPreEdit write FOnPreEdit;
-{$IFNDEF LCL}
- property OnTimerTrigger : TTriggerEvent
- read FOnTimerTrigger write FOnTimerTrigger;
-{$ENDIF}
- end;
-
- TOvcGraphicControl = class(TGraphicControl)
- protected {private}
- FCollectionStreamer : TOvcCollectionStreamer;
- {property methods}
- function GetAbout : string;
- procedure SetAbout(const Value : string);
- protected
- {Collection streaming hooks:}
- procedure GetChildren(Proc: TGetChildProc; Root : TComponent); override;
- function GetChildOwner: TComponent; override;
- procedure Loaded; override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- property CollectionStreamer : TOvcCollectionStreamer
- read FCollectionStreamer write FCollectionStreamer;
- published
- property About : string
- read GetAbout write SetAbout stored False;
- end;
-
- {Replacement for the TOvcCustomControl except with standard VCL streaming}
- TO32CustomControl = class(TCustomControl)
- protected {private}
- {property variables}
- FAfterEnter : TNotifyEvent;
- FAfterExit : TNotifyEvent;
- FOnMouseWheel : TMouseWheelEvent;
- FLabelInfo : TOvcLabelInfo;
- FInternal : Boolean; {flag to suppress name generation
- on collection items}
-
- {property methods}
- function GetAttachedLabel : TOvcAttachedLabel;
- function GetAbout : string;
- procedure SetAbout(const Value : string);
-
- {internal methods}
- procedure LabelAttach(Sender : TObject; Value : Boolean);
- procedure LabelChange(Sender : TObject);
- procedure PositionLabel;
-
- {private message methods}
- procedure OMAssignLabel(var Msg : TMessage);
- message OM_ASSIGNLABEL;
- procedure OMPositionLabel(var Msg : TMessage);
- message OM_POSITIONLABEL;
- procedure OMRecordLabelPosition(var Msg : TMessage);
- message OM_RECORDLABELPOSITION;
- procedure OMAfterEnter(var Msg : TMessage);
- message OM_AFTERENTER;
- procedure OMAfterExit(var Msg : TMessage);
- message OM_AFTEREXIT;
-
- {VCL message methods}
- procedure CMVisibleChanged(var Msg : TMessage);
- message CM_VISIBLECHANGED;
-
- {windows message methods}
- procedure WMKillFocus(var Msg : TWMKillFocus);
- message WM_KILLFOCUS;
- procedure WMMouseWheel(var Msg : TMessage);
- message WM_MOUSEWHEEL;
- procedure WMSetFocus(var Msg : TWMSetFocus);
- message WM_SETFOCUS;
-
- protected
- DefaultLabelPosition : TOvcLabelPosition;
-
- procedure DoOnMouseWheel(Shift : TShiftState;
- Delta, XPos, YPos : SmallInt);
- dynamic;
- procedure CreateWnd;
- override;
- procedure Notification(AComponent : TComponent; Operation : TOperation);
- override;
-
- property AfterEnter : TNotifyEvent
- read FAfterEnter write FAfterEnter;
- property AfterExit : TNotifyEvent
- read FAfterExit write FAfterExit;
- property OnMouseWheel : TMouseWheelEvent
- read FOnMouseWheel write FOnMouseWheel;
- property LabelInfo : TOvcLabelInfo
- read FLabelInfo write FLabelInfo;
-
- public
- property Internal : Boolean read FInternal write FInternal;
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
- override;
- property AttachedLabel : TOvcAttachedLabel
- read GetAttachedLabel;
-
- published
- property About : string
- read GetAbout write SetAbout stored False;
- end;
- {End - TO32CustomControl}
-
-
- TOvcCustomControl = class(TCustomControl)
- protected {private}
- {property variables}
- FAfterEnter : TNotifyEvent;
- FAfterExit : TNotifyEvent;
- FCollectionStreamer : TOvcCollectionStreamer;
- FOnMouseWheel : TMouseWheelEvent;
- FLabelInfo : TOvcLabelInfo;
- FInternal : Boolean; {flag to suppress name generation
- on collection items}
-
- {property methods}
- function GetAttachedLabel : TOvcAttachedLabel;
- function GetAbout : string;
- procedure SetAbout(const Value : string);
-
- {internal methods}
- procedure LabelAttach(Sender : TObject; Value : Boolean);
- procedure LabelChange(Sender : TObject);
- procedure PositionLabel;
-
- {private message methods}
- procedure OMAssignLabel(var Msg : TMessage);
- message OM_ASSIGNLABEL;
- procedure OMPositionLabel(var Msg : TMessage);
- message OM_POSITIONLABEL;
- procedure OMRecordLabelPosition(var Msg : TMessage);
- message OM_RECORDLABELPOSITION;
- procedure OMAfterEnter(var Msg : TMessage);
- message OM_AFTERENTER;
- procedure OMAfterExit(var Msg : TMessage);
- message OM_AFTEREXIT;
-
- {VCL message methods}
- procedure CMVisibleChanged(var Msg : TMessage);
- message CM_VISIBLECHANGED;
-
- {windows message methods}
- procedure WMKillFocus(var Msg : TWMKillFocus);
- message WM_KILLFOCUS;
- procedure WMMouseWheel(var Msg : TMessage);
- message WM_MOUSEWHEEL;
- procedure WMSetFocus(var Msg : TWMSetFocus);
- message WM_SETFOCUS;
-
- protected
- {descendants can set the value of this variable after calling inherited }
- {create to set the default location and point-of-reference (POR) for the}
- {attached label. if dlpTopLeft, the default location and POR will be at }
- {the top left of the control. if dlpBottomLeft, the default location and}
- {POR will be at the bottom left}
- DefaultLabelPosition : TOvcLabelPosition;
-
- procedure DoOnMouseWheel(Shift : TShiftState;
- Delta, XPos, YPos : SmallInt);
- dynamic;
- procedure CreateWnd;
- override;
- procedure Notification(AComponent : TComponent; Operation : TOperation);
- override;
-
- {Collection streaming hooks:}
- procedure GetChildren(Proc: TGetChildProc; Root : TComponent); override;
- function GetChildOwner: TComponent; override;
- procedure Loaded; override;
-
- property AfterEnter : TNotifyEvent
- read FAfterEnter write FAfterEnter;
- property AfterExit : TNotifyEvent
- read FAfterExit write FAfterExit;
- property OnMouseWheel : TMouseWheelEvent
- read FOnMouseWheel write FOnMouseWheel;
- property LabelInfo : TOvcLabelInfo
- read FLabelInfo write FLabelInfo;
-
- public
- property Internal : Boolean read FInternal write FInternal;
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
- override;
- property AttachedLabel : TOvcAttachedLabel
- read GetAttachedLabel;
- property CollectionStreamer : TOvcCollectionStreamer
- read FCollectionStreamer write FCollectionStreamer;
-
- published
- property About : string
- read GetAbout write SetAbout stored False;
- end;
-
- TOvcCollectible = class(TOvcComponent)
- protected {private}
- FCollection : TOvcCollection;
- InChanged : Boolean;
-
- function GetIndex : Integer;
- procedure SetCollection(Value : TOvcCollection);
- procedure SetIndex(Value : Integer); virtual;
-
- protected
- procedure Changed; dynamic;
- function GenerateName : string;
- dynamic;
- function GetBaseName : string;
- dynamic;
- function GetDisplayText : string;
- virtual;
- procedure SetName(const NewName : TComponentName);
- override;
-
- public
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
- property Collection : TOvcCollection
- read FCollection;
- property DisplayText : string
- read GetDisplayText;
- property Index : Integer
- read GetIndex
- write SetIndex;
-
- property Name;
- end;
-
- TO32CollectionItem = class(TCollectionItem)
- protected {private}
- FName: String;
- FDisplayText: String;
- function GetAbout: String;
- procedure SetAbout(const Value: String);
- procedure SetName(Value: String); virtual;
- public
- property DisplayText : string read FDisplayText write FDisplayText;
- property Name: String read FName write SetName;
- published
- property About : String read GetAbout write SetAbout;
- end;
-
-
- TOvcCollectibleControl = class(TOvcCustomControl)
- protected {private}
- FCollection : TOvcCollection;
- FInternal : Boolean; {flag to suppress name generation
- on collection items}
- InChanged : Boolean;
-
- function GetIndex : Integer;
- procedure SetCollection(Value : TOvcCollection);
- procedure SetIndex(Value : Integer);
-
- protected
- procedure Changed; dynamic;
- function GenerateName : string;
- dynamic;
- function GetBaseName : string;
- dynamic;
- function GetDisplayText : string;
- virtual;
- procedure SetName(const NewName : TComponentName);
- override;
-
- public
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
-
- property Internal : Boolean read FInternal write FInternal;
-
- property Collection : TOvcCollection
- read FCollection;
-
- property DisplayText : string
- read GetDisplayText;
-
- property Index : Integer
- read GetIndex
- write SetIndex;
-
- property Name;
- end;
-
- TOvcCollectibleClass = class of TComponent;
- TO32CollectibleClass = class of TPersistent;
-
- TOvcItemSelectedEvent =
- procedure(Sender : TObject; Index : Integer) of object;
- TOvcGetEditorCaption =
- procedure(var Caption : string) of object;
- TO32GetEditorCaption =
- procedure(var Caption : string) of object;
-
- TOvcCollection = class(TPersistent)
- protected {private}
- {property variables}
- FItemClass : TOvcCollectibleClass;
- FItemEditor : TForm;
- FItems : TList;
- FOwner : TComponent;
- FReadOnly : Boolean;
- FStored : Boolean;
- FStreamer : TOvcCollectionStreamer;
-
- {event variables}
- FOnChanged : TNotifyEvent;
- FOnItemSelected : TOvcItemSelectedEvent;
- FOnGetEditorCaption : TOvcGetEditorCaption;
-
- {Internal variables}
- InLoaded : Boolean;
- IsLoaded : Boolean;
- InChanged : Boolean;
-
- protected
- function GetCount : Integer;
- function GetItem(Index: Integer): TComponent;
- procedure SetItem(Index: Integer; Value: TComponent);
-
- procedure Changed;
- virtual;
- procedure Loaded;
-
- public
- constructor Create(AOwner : TComponent; ItemClass : TOvcCollectibleClass);
- destructor Destroy;
- override;
- property ItemEditor : TForm
- read FItemEditor write FItemEditor;
-
- function Add : TComponent;
- procedure Clear; virtual;
- procedure Delete(Index : Integer);
- procedure DoOnItemSelected(Index : Integer);
- function GetEditorCaption : string;
- function ItemByName(const Name : string) : TComponent;
- function Insert(Index : Integer) : TComponent;
- function ParentForm : TForm;
-
- property Count: Integer
- read GetCount;
- property ItemClass : TOvcCollectibleClass
- read FItemClass;
- property Item[Index: Integer] : TComponent
- read GetItem write SetItem; default;
- property OnGetEditorCaption : TOvcGetEditorCaption
- read FOnGetEditorCaption write FOnGetEditorCaption;
- property Owner : TComponent
- read FOwner;
- property ReadOnly : Boolean
- read FReadOnly write FReadOnly default False;
- property Stored : Boolean
- read FStored write FStored default True;
- property OnChanged : TNotifyEvent
- read FOnChanged write FOnChanged;
- property OnItemSelected : TOvcItemSelectedEvent
- read FOnItemSelected write FOnItemSelected;
- end;
-
- TO32Collection = class(TCollection)
- protected {private}
- {property variables}
- FItemEditor : TForm;
- FReadOnly : Boolean;
-
- FOwner: TPersistent;
-
- {event variables}
- FOnChanged : TNotifyEvent;
- FOnItemSelected : TOvcItemSelectedEvent;
- FOnGetEditorCaption : TO32GetEditorCaption;
-
- {Internal variables}
- InLoaded : Boolean;
- IsLoaded : Boolean;
- InChanged : Boolean;
-
- protected
- function GetCount : Integer;
- procedure Loaded;
- public
- constructor Create(AOwner : TPersistent;
- ItemClass : TCollectionItemClass); virtual;
- destructor Destroy; override;
- property ItemEditor : TForm read FItemEditor write FItemEditor;
-
- function Add : TO32CollectionItem; dynamic;
-
- {$IFNDEF VERSION4}
- function Insert(Index: Integer): TO32CollectionItem; dynamic;
- {$ENDIF}
-
- function GetItem(Index: Integer): TO32CollectionItem;
- function GetOwner: TPersistent; override;
- procedure SetItem(Index: Integer; Value: TO32CollectionItem);
- procedure DoOnItemSelected(Index : Integer);
- function GetEditorCaption : string;
- function ItemByName(const Name : string) : TO32CollectionItem;
- function ParentForm : TForm;
-
- property Count: Integer
- read GetCount;
- property Item[Index: Integer] : TO32CollectionItem
- read GetItem write SetItem; default;
- property OnGetEditorCaption : TO32GetEditorCaption
- read FOnGetEditorCaption write FOnGetEditorCaption;
- property ReadOnly : Boolean
- read FReadOnly write FReadOnly default False;
- property OnChanged : TNotifyEvent
- read FOnChanged write FOnChanged;
- property OnItemSelected : TOvcItemSelectedEvent
- read FOnItemSelected write FOnItemSelected;
- end;
-
- TOvcCollectionStreamer = class
- protected {private}
- FCollectionList : TList;
- FOwner : TComponent;
-
- protected
- procedure Loaded;
- procedure GetChildren(Proc: TGetChildProc; Root : TComponent);
-
- public
- constructor Create(AOwner : TComponent);
- destructor Destroy;
- override;
-
- procedure Clear;
- function CollectionFromType(Component : TComponent) : TOvcCollection;
-
- property Owner : TComponent
- read FOwner;
- end;
-
-
-type
- {base class for Orpheus components. Provides controller access}
- TOvcCustomControlEx = class(TOvcCustomControl)
- protected {private}
- FController : TOvcController;
-
- function ControllerAssigned : Boolean;
- function GetController: TOvcController;
- procedure SetController(Value : TOvcController); virtual;
-
- protected
- procedure CreateWnd;
- override;
- procedure Notification(AComponent : TComponent; Operation : TOperation);
- override;
-
- public
- property Controller : TOvcController
- read GetController
- write SetController;
- end;
-
-
-function FindController(Form : TWinControl) : TOvcController;
- {-search for an existing controller component}
-function GetImmediateParentForm(Control : TControl) : TWinControl;
- {-return first form found while searching Parent}
-procedure ResolveController(AForm : TWinControl; var AController : TOvcController);
- {-find or create a controller on this form}
-
-function DefaultController : TOvcController;
-
-implementation
-
-{.$DEFINE Logging}
-uses
- OvcVer,
- TypInfo,
- ExtCtrls,
-{$IFNDEF LCL}
- Consts,
-{$ELSE}
- LclStrConsts,
-{$ENDIF}
- OvcEF
- {$IFDEF Logging}
- ,LogAPI
- {$ENDIF}
- ;
-
-type
- TLocalEF = class(TOvcBaseEntryField);
-var
- FDefaultController : TOvcController = nil;
-
-{===== TO32ContainerList =============================================}
-
-constructor TO32ContainerList.Create(AOwner: TComponent);
-begin
- inherited Create;
- FOwner := TComponent(AOwner);
-end;
-{=====}
-
-destructor TO32ContainerList.Destroy;
-var
- I: Integer;
-begin
- for I := 0 to Count - 1 do
- TPanel(Items[I]).Free;
- inherited;
-end;
-
-
-{*** TOvcLabelInfo ***}
-
-procedure TOvcLabelInfo.DoOnAttach;
-begin
- if Assigned(FOnAttach) then
- FOnAttach(Self, FVisible);
-end;
-
-procedure TOvcLabelInfo.DoOnChange;
-begin
- if Assigned(FOnChange) then
- FOnChange(Self);
-end;
-
-function TOvcLabelInfo.IsVisible : Boolean;
-begin
- Result := FVisible;
-end;
-
-procedure TOvcLabelInfo.SetOffsets(X, Y : Integer);
-begin
- if (X <> FOffsetX) or (Y <> FOffsetY) then begin
- FOffsetX := X;
- FOffsetY := Y;
- DoOnChange;
- end;
-end;
-
-procedure TOvcLabelInfo.SetOffsetX(Value : Integer);
-begin
- if Value <> FOffsetX then begin
- FOffsetX := Value;
- DoOnChange;
- end;
-end;
-
-procedure TOvcLabelInfo.SetOffsetY(Value : Integer);
-begin
- if Value <> FOffsetY then begin
- FOffsetY := Value;
- DoOnChange;
- end;
-end;
-
-procedure TOvcLabelInfo.SetVisible(Value : Boolean);
-begin
- if Value <> FVisible then begin
- FVisible := Value;
- DoOnAttach;
- end;
-end;
-
-
-{*** TOvcAttachedLabel ***}
-
-constructor TOvcAttachedLabel.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- {set new defaults}
- AutoSize := True;
- ParentFont := True;
- Transparent := False;
-end;
-
-constructor TOvcAttachedLabel.CreateEx(AOwner : TComponent; AControl : TWinControl);
-begin
- FControl := AControl;
-
- Create(AOwner);
-
- {set attached control property}
- FocusControl := FControl;
-end;
-
-procedure TOvcAttachedLabel.Loaded;
-begin
- inherited Loaded;
-
- SavePosition;
-end;
-
-procedure TOvcAttachedLabel.SavePosition;
-var
- PF : TWinControl;
- I : Integer;
-begin
- if (csLoading in ComponentState) or (csDestroying in ComponentState) then
- Exit;
-
- {see if our associated control is on the form - save position}
- PF := GetImmediateParentForm(Self);
- if Assigned(PF) then begin
- for I := 0 to Pred(PF.ComponentCount) do begin
- if PF.Components[I] = FControl then begin
- SendMessage(FControl.Handle, OM_ASSIGNLABEL, 0, LongInt(Self));
- PostMessage(FControl.Handle, OM_RECORDLABELPOSITION, 0, 0);
- Break;
- end;
- end;
- end;
-end;
-
-procedure TOvcAttachedLabel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
-begin
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
- SavePosition;
-
- { The following line causes the IDE to mark the form dirty, requiring it }
- { to be saved. Not sure what this was supposed to do, but commenting it }
- { out seems to solve the problem. }
- {Application.ProcessMessages;}
-end;
-
-function FindController(Form : TWinControl) : TOvcController;
- {-search for an existing controller component}
-var
- I : Integer;
-begin
- Result := nil;
- for I := 0 to Form.ComponentCount-1 do begin
- if Form.Components[I] is TOvcController then begin
- Result := TOvcController(Form.Components[I]);
- Break;
- end;
- end;
-end;
-
-function GetImmediateParentForm(Control : TControl) : TWinControl;
- {return first form found while searching Parent}
-var
- ParentCtrl : TControl;
-begin
- ParentCtrl := Control.Parent;
-{$IFDEF VERSION5}
- while Assigned(ParentCtrl) and
- not ((ParentCtrl is TCustomForm) or
- (ParentCtrl is TCustomFrame)) do
-{$ELSE}
- while Assigned(ParentCtrl) and (not (ParentCtrl is TCustomForm)) do
-{$ENDIF}
- ParentCtrl := ParentCtrl.Parent;
- Result := TWinControl(ParentCtrl);
-end;
-
-procedure ResolveController(AForm : TWinControl; var AController : TOvcController);
- {-find or create a controller on this form}
-begin
- if not Assigned(AController) then begin
- {search for an existing controller. If not found,}
- {create the controller as a child of the form}
- {and assign it as our controller}
- AController := FindController(AForm);
- (*
- if not Assigned(AController) then begin
- AController := TOvcController.Create(AForm);
- try
- AController.Name := 'OvcController1';
- except
- AController.Free;
- AController := nil;
- raise;
- end;
- end;
- *)
- end;
-end;
-
-{*** TOvcComponent ***}
-
-constructor TOvcComponent.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
-end;
-
-destructor TOvcComponent.Destroy;
-begin
- FCollectionStreamer.Free;
- FCollectionStreamer := nil;
-
- inherited Destroy;
-end;
-
-function TOvcComponent.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-
-procedure TOvcComponent.SetAbout(const Value : string);
-begin
-end;
-
-
-{Logic for streaming collections of sub-components}
-
-function TOvcComponent.GetChildOwner: TComponent;
-begin
- if assigned(FCollectionStreamer) then
- Result := FCollectionStreamer.Owner
- else
- Result := inherited GetChildOwner;
-end;
-
-procedure TOvcComponent.GetChildren(Proc: TGetChildProc; Root : TComponent);
-begin
- if assigned(FCollectionStreamer) then
- CollectionStreamer.GetChildren(Proc, Root)
- else
- inherited GetChildren(Proc,Root);
-end;
-
-procedure TOvcComponent.Loaded;
-begin
- if assigned(FCollectionStreamer) then
- FCollectionStreamer.Loaded;
-
- inherited Loaded;
-end;
-
-{*** TO32Component ***}
-constructor TO32Component.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
-end;
-
-function TO32Component.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-
-procedure TO32Component.SetAbout(const Value : string);
-begin
-end;
-
-
-{*** TOvcCollectible ***}
-constructor TOvcCollectible.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- if (AOwner is TOvcComponent) then begin
- if TOvcComponent(AOwner).CollectionStreamer = nil then
- raise Exception.Create(GetOrphStr(SCNoCollection));
- SetCollection(TOvcComponent(AOwner).CollectionStreamer.CollectionFromType(Self));
- end else
- if (AOwner is TOvcCustomControl) then begin
- if TOvcCustomControl(AOwner).CollectionStreamer = nil then
- raise Exception.Create(GetOrphStr(SCNoCollection));
- SetCollection(TOvcCustomControl(AOwner).CollectionStreamer.CollectionFromType(Self));
- end else
- raise Exception.Create(GetOrphStr(SCNotOvcDescendant));
-
- if (csDesigning in ComponentState)
- and (AOwner <> nil) then
- if ((AOwner is TOvcComponent) and not TOvcComponent(AOwner).FInternal)
- or ((AOwner is TOvcCollectibleControl) and not TOvcCollectibleControl(AOwner).FInternal)
- or ((AOwner is TOvcCustomControl) and not TOvcCustomControl(AOwner).FInternal) then
-{$IFDEF VERSION5}
- if not (csLoading in AOwner.ComponentState) then
-{$ELSE}
- if not (csLoading in AOwner.ComponentState) then
-{$ENDIF}
- Name := GenerateName;
-end;
-
-destructor TOvcCollectible.Destroy;
-var
- OldCollection : TOvcCollection;
-begin
- OldCollection := Collection;
- SetCollection(nil);
- inherited Destroy;
- {mark dirty}
- if (csDesigning in ComponentState)
- and (OldCollection <> nil)
- and not (csDestroying in
- OldCollection.Owner.ComponentState) then begin
- OldCollection.Changed;
- end;
-end;
-
-function TOvcCollectible.GenerateName : string;
-var
- PF : TWinControl;
- I : Integer;
- S : string;
-
- function SearchSubComponents(C : TComponent; const S : string) : TComponent;
- var
- I : Integer;
- begin
- Result := C;
- if CompareText(S, Result.Name) = 0 then
- Exit;
- for I := 0 to C.ComponentCount-1 do begin
- Result := SearchSubComponents(C.Components[I], S);
- if Result <> nil then
- Exit;
- end;
- Result := nil;
- end;
-
- function FindComponentName(const S : string) : TComponent;
- begin
- Result := SearchSubComponents(PF, S);
- end;
-
-begin
- I := 1;
- S := GetBaseName;
- Result := Format('%s%d', [S, I]);
- PF := Collection.ParentForm;
- if not Assigned(PF) then
- Exit;
-
- while FindComponentName(Result) <> nil do begin
- Inc(I);
- Result := Format('%s%d', [S, I]);
- end;
-end;
-
-procedure TOvcCollectible.SetName(const NewName : TComponentName);
-begin
- inherited SetName(NewName);
- if not (csLoading in ComponentState) then
-{$IFDEF VERSION5}
- if (csInLine in ComponentState) then
- Changed;
-{$ENDIF}
- if (Collection <> nil)
- and (Collection.ItemEditor <> nil) then
- SendMessage(Collection.ItemEditor.Handle, OM_PROPCHANGE, 0, 0);
-end;
-
-function TOvcCollectible.GetBaseName : string;
-begin
- Result := 'CollectionItem';
-end;
-
-function TOvcCollectible.GetDisplayText : string;
-begin
- Result := ClassName;
-end;
-
-procedure TOvcCollectible.Changed;
-begin
- if InChanged then exit;
- InChanged := True;
- try
- {$IFDEF Logging}
- LogMsg('TOvcCollectible.Changed');
- LogBoolean('assigned(FCollection)', assigned(FCollection));
- LogBoolean('(csInline in ComponentState)', (csInline in ComponentState));
- LogBoolean('csAncestor in Owner.ComponentState', csAncestor in Owner.ComponentState);
- {$ENDIF}
- if assigned(FCollection) then
- {$IFDEF Version5}
- if not (csInline in ComponentState) then
- {$ENDIF}
- FCollection.Changed;
- finally
- InChanged := False;
- end;
-end;
-
-function TOvcCollectible.GetIndex : Integer;
-begin
- if assigned(FCollection) then
- Result := FCollection.FItems.IndexOf(Self)
- else
- Result := -1;
-end;
-
-procedure TOvcCollectible.SetIndex(Value : Integer);
-begin
- if Value <> Index then begin
- if assigned(FCollection) then begin
- FCollection.FItems.Remove(Self);
- FCollection.FItems.Insert(Value,Self);
- end;
- Changed;
- end;
-end;
-
-procedure TOvcCollectible.SetCollection(Value : TOvcCollection);
-begin
- if Collection <> Value then begin
- if Collection <> nil then
- Collection.FItems.Remove(Self);
- if Value <> nil then begin
- if not (Self is Value.ItemClass) then
- raise Exception.Create(GetOrphStr(SCItemIncompatible));
- Value.FItems.Add(Self);
- end;
- FCollection := Value;
- end;
-end;
-
-
-
-{===== TO32CollectionItem ============================================}
-
-function TO32CollectionItem.GetAbout: String;
-begin
- Result := OrVersionStr;
-end;
-
-procedure TO32CollectionItem.SetAbout(const Value: String);
-begin
-end;
-
-procedure TO32CollectionItem.SetName(Value: String);
-begin
- FName := Value;
-end;
-{=====}
-
-{*** TOvcCollectibleControl ***}
-constructor TOvcCollectibleControl.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- if (AOwner is TOvcComponent) then begin
- if TOvcComponent(AOwner).CollectionStreamer = nil then
- raise Exception.Create(GetOrphStr(SCNoCollection));
- SetCollection(TOvcComponent(AOwner).CollectionStreamer.CollectionFromType(Self));
- end else
- if (AOwner is TOvcCustomControl) then begin
- if TOvcCustomControl(AOwner).CollectionStreamer = nil then
- raise Exception.Create(GetOrphStr(SCNoCollection));
- SetCollection(TOvcCustomControl(AOwner).CollectionStreamer.CollectionFromType(Self));
- end else
- raise Exception.Create(GetOrphStr(SCNotOvcDescendant));
-
- if (csDesigning in ComponentState)
- and (AOwner <> nil) then
- if ((AOwner is TOvcComponent) and not TOvcComponent(AOwner).FInternal)
- or ((AOwner is TOvcCollectibleControl) and not TOvcCollectibleControl(AOwner).FInternal)
- or ((AOwner is TOvcCustomControl) and not TOvcCustomControl(AOwner).FInternal) then
- if not (csLoading in AOwner.ComponentState)
- {$IFDEF Version5}
- and not (csInLine in AOwner.ComponentState)
- {$ENDIF}
- then Name := GenerateName;
-end;
-
-destructor TOvcCollectibleControl.Destroy;
-var
- OldCollection : TOvcCollection;
-begin
- OldCollection := Collection;
- SetCollection(nil);
- inherited Destroy;
- {mark dirty}
- if (csDesigning in ComponentState)
- and (OldCollection <> nil)
- and not (csDestroying in
- OldCollection.Owner.ComponentState) then begin
- OldCollection.Changed;
- end;
-end;
-
-function TOvcCollectibleControl.GenerateName : string;
-var
- PF : TWinControl;
- I : Integer;
- S : string;
-
- function SearchSubComponents(C : TComponent; const S : string) : TComponent;
- var
- I : Integer;
- begin
- Result := C;
- if CompareText(S, Result.Name) = 0 then
- Exit;
- for I := 0 to C.ComponentCount-1 do begin
- Result := SearchSubComponents(C.Components[I], S);
- if Result <> nil then
- Exit;
- end;
- Result := nil;
- end;
-
- function FindComponentName(const S : string) : TComponent;
- begin
- Result := SearchSubComponents(PF, S);
- end;
-
-begin
- I := 1;
- S := GetBaseName;
- Result := Format('%s%d', [S, I]);
- PF := Collection.ParentForm;
- if not Assigned(PF) then
- Exit;
-
- while FindComponentName(Result) <> nil do begin
- Inc(I);
- Result := Format('%s%d', [S, I]);
- end;
-end;
-
-procedure TOvcCollectibleControl.SetName(const NewName : TComponentName);
-begin
- inherited SetName(NewName);
- if not (csLoading in ComponentState) then
- {$IFDEF Version5}
- if not (csInLine in ComponentState) then
- {$ENDIF}
- Changed;
-end;
-
-function TOvcCollectibleControl.GetBaseName : string;
-begin
- Result := 'CollectionItem';
-end;
-
-function TOvcCollectibleControl.GetDisplayText : string;
-begin
- Result := ClassName;
-end;
-
-procedure TOvcCollectibleControl.Changed;
-begin
- if InChanged then exit;
- InChanged := True;
- try
- if assigned(FCollection) then
- {$IFDEF Version5}
- if not (csInline in ComponentState) then
- {$ENDIF}
- FCollection.Changed;
- finally
- InChanged := False;
- end;
-end;
-
-function TOvcCollectibleControl.GetIndex : Integer;
-begin
- if Collection <> nil then
- Result := Collection.FItems.IndexOf(Self)
- else
- Result := -1;
-end;
-
-procedure TOvcCollectibleControl.SetIndex(Value : Integer);
-begin
- if Value <> Index then begin
- if Collection <> nil then begin
- Collection.FItems.Remove(Self);
- Collection.FItems.Insert(Value,Self);
- end;
- Changed;
- end;
-end;
-
-procedure TOvcCollectibleControl.SetCollection(Value : TOvcCollection);
-begin
- if Collection <> Value then begin
- if Collection <> nil then
- Collection.FItems.Remove(Self);
- if Value <> nil then begin
- if not (Self is Value.ItemClass) then
- raise Exception.Create(GetOrphStr(SCItemIncompatible));
- Value.FItems.Add(Self);
- end;
- FCollection := Value;
- end;
-end;
-
-{*** TOvcController ***}
-constructor TOvcController.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- {create the command processor}
- FEntryCommands := TOvcCommandProcessor.Create;
- FBaseEFOptions := [efoAutoSelect, efoBeepOnError, efoInsertPushes];
- FEpoch := DefaultEpoch;
- FErrorPending := False;
- FInsertMode := True;
-
-{$IFNDEF LCL}
- {create the general use timer pool}
- FTimerPool := TOvcTimerPool.Create(Self);
- FTimerPool.OnAllTriggers := DoOnTimerTrigger;
-{$ENDIF}
-end;
-
-procedure TOvcController.cWndProc(var Msg : TMessage);
- {-window procedure}
-var
- C : TWinControl;
-begin
- C := TWinControl(Msg.lParam);
- try
- with Msg do begin
- case Msg of
- OM_SETFOCUS :
- begin
- C.Show;
- if C.CanFocus then
- C.SetFocus;
- end;
- OM_PREEDIT :
- if Assigned(FOnPreEdit) then
- FOnPreEdit(TWinControl(lParam), FindControl(wParam));
- OM_POSTEDIT :
- if Assigned(FOnPostEdit) then
- FOnPostEdit(TWinControl(lParam), FindControl(wParam));
- OM_DELAYNOTIFY :
- if Assigned(FOnDelayNotify) then
- FOnDelayNotify(TObject(lParam), wParam);
- else
- Result := DefWindowProc(Handle, Msg, wParam, lParam);
- end;
- end;
- except
- Application.HandleException(Self);
- end;
-end;
-
-{$IFDEF LCL}
-function TOvcController.PostMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL;
-var
- AMsg : TMessage;
-begin
- if hWnd = Handle then
- begin
- AMsg.Msg := Msg;
- AMsg.WParam := wParam;
- AMsg.LParam := lParam;
- cWndProc(AMsg);
- end
- else
-{$IFDEF MSWINDOWS}
- Result := MyMisc.PostMessage(hWnd, Msg, wParam, lParam);
-{$ELSE}
- Result := LclIntf.PostMessage(hWnd, Msg, wParam, lParam);
-{$ENDIF}
-end;
-{$ENDIF}
-
-procedure TOvcController.DelayNotify(Sender : TObject; NotifyCode : Word);
-begin
- if Assigned(FOnDelayNotify) then
- PostMessage(Handle, OM_DELAYNOTIFY, NotifyCode, LongInt(Sender));
-end;
-
-destructor TOvcController.Destroy;
-begin
- {destroy the command processor}
- FEntryCommands.Free;
- FEntryCommands := nil;
-
-{$IFNDEF LCL}
- FTimerPool.Free;
- FTimerPool := nil;
-{$ENDIF}
-
- {destroy window handle, if created}
- DestroyHandle;
-
- inherited Destroy;
-end;
-
-procedure TOvcController.DestroyHandle;
-begin
-{$IFNDEF LCL}
- if FHandle <> 0 then
- {$IFDEF VERSION6}
- Classes.DeallocateHWnd(FHandle);
- {$ELSE}
- DeallocateHWnd(FHandle);
- {$ENDIF}
-{$ENDIF}
-
- FHandle := 0;
-end;
-
-procedure TOvcController.DoOnError(Sender : TObject; ErrorCode : Word;
- const ErrorMsg : string);
-begin
- if Assigned(FOnError) then
- FOnError(Sender, ErrorCode, ErrorMsg)
- else
- MessageDlg(ErrorMsg, mtError, [mbOK], 0);
-end;
-
-procedure TOvcController.DoOnPostEdit(Sender : TObject; GainingControl : TWinControl);
-var
- H : hWnd;
-begin
- if Assigned(GainingControl) then
- H := GainingControl.Handle
- else
- H := 0;
-
- PostMessage(Handle, OM_POSTEDIT, H, LongInt(Sender));
-end;
-
-procedure TOvcController.DoOnPreEdit(Sender : TObject; LosingControl : TWinControl);
-var
- H : hWnd;
-begin
- if Assigned(LosingControl) then
- H := LosingControl.Handle
- else
- H := 0;
-
- PostMessage(Handle, OM_PREEDIT, H, LongInt(Sender));
-end;
-
-procedure TOvcController.DoOnTimerTrigger(Sender : TObject; Handle : Integer;
- Interval : Cardinal; ElapsedTime : LongInt);
-begin
-{$IFNDEF LCL}
- if Assigned(FOnTimerTrigger) then
- FOnTimerTrigger(Sender, Handle, Interval, ElapsedTime);
-{$ENDIF}
-end;
-
-function TOvcController.GetEpoch : Integer;
-begin
- Result := FEpoch;
- if Assigned(FOnGetEpoch) then
- FOnGetEpoch(Self, Result);
-end;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
-function TOvcController.GetHandle : TOvcHWnd{hWnd};
-begin
-// AllocateHWnd not available in LCL to create non-visual window that
-// responds to messages sent to controller. But shouldn't be needed
-// with controller's PostMessage method that intercepts messages.
-{$IFNDEF LCL}
- if FHandle = 0 then
- {$IFDEF VERSION6}
- FHandle := Classes.AllocateHWnd(cWndProc);
- {$ELSE}
- FHandle := AllocateHWnd(cWndProc);
- {$ENDIF}
-{$ENDIF}
- Result := FHandle;
-end;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
-function TOvcController.IsSpecialButton(H : TOvcHWnd{hWnd}) : Boolean;
-begin
- Result := False;
- if Assigned(FOnIsSpecialControl) then
- FOnIsSpecialControl(Self, FindControl(H), Result);
-end;
-
-procedure TOvcController.MarkAsUninitialized(Uninitialized : Boolean);
- {-mark all entry fields on form as uninitialized}
-var
- I : Integer;
-
- procedure MarkField(C : TComponent);
- var
- J : Integer;
- begin
- {first, see if this component is an entry field}
- if C is TOvcBaseEntryField then
- TOvcBaseEntryField(C).Uninitialized := Uninitialized;
-
- {recurse through all child components}
- for J := 0 to C.ComponentCount-1 do
- MarkField(C.Components[J]);
- end;
-
-begin
-{$IFDEF VERSION5}
- if (Owner is TCustomForm) or (Owner is TCustomFrame) then
- with TWinControl(Owner) do
-{$ELSE}
- if Owner is TForm then
- with TForm(Owner) do
-{$ENDIF}
- for I := 0 to ComponentCount-1 do
- MarkField(Components[I]);
-end;
-
-procedure TOvcController.SetEpoch(Value : Integer);
-begin
- if Value <> FEpoch then
- if (Value >= MinYear) and (Value <= MaxYear) then
- FEpoch := Value;
-end;
-
-function TOvcController.ValidateEntryFields : TComponent;
-begin
- {if error, report it and send focus to field with error}
- Result := ValidateEntryFieldsEx(True, True);
-end;
-
-function TOvcController.ValidateEntryFieldsEx(ReportError, ChangeFocus : Boolean) : TComponent;
-var
- I : Integer;
-
- procedure ValidateEF(C : TComponent);
- var
- J : Integer;
- EF : TLocalEF absolute C;
- begin
- {see if this component is an entry field}
- if (C is TOvcBaseEntryField) then begin
-
- {don't validate invisible or disabled fields}
- if not EF.Visible or not EF.Enabled then
- Exit;
-
- {ask entry field to validate itself}
- if (EF.ValidateContents(False) <> 0) then begin
- {remember only the first invalid field found}
- if not Assigned(Result) then
- Result := EF;
-
- {tell the entry field to report the error}
- if ReportError and not ErrorPending then
- PostMessage(EF.Handle, OM_REPORTERROR, EF.LastError, 0);
-
- {ask the controller to give the focus back to this field}
- if ChangeFocus and not ErrorPending then begin
- PostMessage(Handle, OM_SETFOCUS, 0, LongInt(EF));
- ErrorPending := True;
- end;
-
- {exit if we are reporting the error or changing the focus}
- if (ReportError or ChangeFocus) then
- Exit;
- end;
- end;
-
- {recurse through all child components}
- for J := 0 to C.ComponentCount-1 do begin
- ValidateEf(C.Components[J]);
-
- {exit if we've already found an error and should stop}
- if Assigned(Result) and (ReportError or ChangeFocus) then
- Break;
- end;
- end;
-
-begin
- Result := nil;
-{$IFDEF VERSION5}
- if ((Owner is TCustomForm) or (Owner is TCustomFrame)) then
- with TWinControl(Owner) do
-{$ELSE}
- if Owner is TForm then
- with TForm(Owner) do
-{$ENDIF}
- for I := 0 to ComponentCount-1 do begin
- ValidateEf(Components[I]);
-
- {stop checking if reporting the error or changing focus}
- if Assigned(Result) and (ReportError or ChangeFocus) then
- Break ;
- end;
-end;
-
-function TOvcController.ValidateTheseEntryFields(const Fields : array of TComponent) : TComponent;
- {-ask the specified entry fields to validate their contents. Return nil
- if no error, else return pointer to field with error}
-var
- I : Integer;
- EF : TLocalEF;
-begin
- Result := nil;
-
- for I := Low(Fields) to High(Fields) do begin
- if Fields[I] is TOvcBaseEntryField then begin
- EF := TLocalEF(Fields[I]);
-
- {ask entry field to validate itself}
- if (EF.ValidateContents(False) <> 0) then begin
- Result := EF;
-
- {tell the entry field to report the error}
- if not ErrorPending then
- PostMessage(EF.Handle, OM_REPORTERROR, EF.LastError, 0);
-
- {ask the controller to give the focus back to this field}
- if not ErrorPending then begin
- PostMessage(Handle, OM_SETFOCUS, 0, LongInt(EF));
- ErrorPending := True;
- end;
-
- Exit;
- end;
-
- end;
- end;
-end;
-
-{*** TOvcGraphicControl ***}
-
-constructor TOvcGraphicControl.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
-end;
-
-destructor TOvcGraphicControl.Destroy;
-begin
- FCollectionStreamer.Free;
- FCollectionStreamer := nil;
- inherited Destroy;
-end;
-
-
-procedure TOvcGraphicControl.Loaded;
-begin
- if Assigned(FCollectionStreamer) then
- FCollectionStreamer.Loaded;
- inherited Loaded;
-end;
-
-{Logic for streaming collections of sub-components}
-
-function TOvcGraphicControl.GetChildOwner: TComponent;
-begin
- if Assigned(FCollectionStreamer) then
- Result := FCollectionStreamer.Owner
- else
- Result := inherited GetChildOwner;
-end;
-
-procedure TOvcGraphicControl.GetChildren(Proc: TGetChildProc; Root : TComponent);
-begin
- if Assigned(FCollectionStreamer) then
- CollectionStreamer.GetChildren(Proc, Root)
- else
- inherited GetChildren(Proc, Root);
-end;
-
-function TOvcGraphicControl.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-
-
-procedure TOvcGraphicControl.SetAbout(const Value : string);
-begin
-end;
-
-
-{*** TO32CustomControl ***}
-
-procedure TO32CustomControl.CMVisibleChanged(var Msg : TMessage);
-begin
- inherited;
-
- if csLoading in ComponentState then
- Exit;
-
- if LabelInfo.Visible then
- AttachedLabel.Visible := Visible;
-end;
-
-constructor TO32CustomControl.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- DefaultLabelPosition := lpTopLeft;
-
- FLabelInfo := TOvcLabelInfo.Create;
- FLabelInfo.OnChange := LabelChange;
- FLabelInfo.OnAttach := LabelAttach;
-end;
-
-procedure TO32CustomControl.CreateWnd;
-begin
- inherited CreateWnd;
-end;
-
-destructor TO32CustomControl.Destroy;
-begin
- FLabelInfo.Visible := False;
- FLabelInfo.Free;
- FLabelInfo := nil;
- inherited Destroy;
-end;
-
-procedure TO32CustomControl.DoOnMouseWheel(Shift : TShiftState;
- Delta, XPos, YPos : SmallInt);
-// Another TurboPower bug? Their TMouseWheelEvent expects Word
-// params, yet passing SmallInts here. Delta is negative when
-// scroll down, which will raise exception if a descendent class
-// with a TMouseWheelEvent handler has range checking turned on.
-// Note that their TMouseWheelEvent redefines LCL's.
-begin
- if Assigned(FOnMouseWheel) then
- FOnMouseWheel(Self, Shift, Delta, XPos, YPos);
-end;
-
-function TO32CustomControl.GetAttachedLabel : TOvcAttachedLabel;
-begin
- if not FLabelInfo.Visible then
- raise Exception.Create(GetOrphStr(SCLabelNotAttached));
-
- Result := FLabelInfo.ALabel;
-end;
-
-function TO32CustomControl.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-
-procedure TO32CustomControl.LabelAttach(Sender : TObject; Value : Boolean);
-var
-{$IFDEF VERSION5}
- PF : TWinControl;
-{$ELSE}
- PF : TForm;
-{$ENDIF}
- S : string;
-begin
- if (csLoading in ComponentState) then
- Exit;
-
-{$IFDEF VERSION5}
- PF := GetImmediateParentForm(Self);
-{$ELSE}
- PF := TForm(GetParentForm(Self));
-{$ENDIF}
- if Value then begin
- if Assigned(PF) then begin
- FLabelInfo.ALabel.Free;
- FLabelInfo.ALabel := TOvcAttachedLabel.CreateEx(PF, Self);
- FLabelInfo.ALabel.Parent := Parent;
-
- S := GenerateComponentName(PF, Name + 'Label');
- FLabelInfo.ALabel.Name := S;
- FLabelInfo.ALabel.Caption := S;
-
- FLabelInfo.SetOffsets(0, 0);
- PositionLabel;
- FLabelInfo.ALabel.BringToFront;
-
- {force auto size}
- FLabelInfo.ALabel.AutoSize := True;
- end;
- end else begin
- if Assigned(PF) then begin
- FLabelInfo.ALabel.Free;
- FLabelInfo.ALabel := nil;
- end;
- end;
-end;
-
-procedure TO32CustomControl.LabelChange(Sender : TObject);
-begin
- if not (csLoading in ComponentState) then
- PositionLabel;
-end;
-
-procedure TO32CustomControl.Notification(AComponent : TComponent; Operation : TOperation);
-var
-{$IFDEF VERSION5}
- PF : TWinControl;
-{$ELSE}
- PF : TForm;
-{$ENDIF}
-begin
- inherited Notification(AComponent, Operation);
-
- if Operation = opRemove then
- if Assigned(FLabelInfo) and (AComponent = FLabelInfo.ALabel) then begin
-{$IFDEF VERSION5}
- PF := GetImmediateParentForm(Self);
-{$ELSE}
- PF := TForm(GetParentForm(Self));
-{$ENDIF}
- if Assigned(PF) and not (csDestroying in PF.ComponentState) then begin
- FLabelInfo.FVisible := False;
- FLabelInfo.ALabel := nil;
- end;
- end;
-end;
-
-procedure TO32CustomControl.OMAfterEnter(var Msg : TMessage);
-begin
- if Assigned(FAfterEnter) then
- FAfterEnter(Self);
-end;
-
-procedure TO32CustomControl.OMAfterExit(var Msg : TMessage);
-begin
- if Assigned(FAfterExit) then
- FAfterExit(Self);
-end;
-
-procedure TO32CustomControl.OMAssignLabel(var Msg : TMessage);
-begin
- FLabelInfo.ALabel := TOvcAttachedLabel(Msg.lParam);
-end;
-
-procedure TO32CustomControl.OMPositionLabel(var Msg : TMessage);
-const
- DX : Integer = 0;
- DY : Integer = 0;
-begin
- if FLabelInfo.Visible and
- Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) and
- not (csLoading in ComponentState) then begin
- if DefaultLabelPosition = lpTopLeft then begin
- DX := FLabelInfo.ALabel.Left - Left;
- DY := FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top;
- end else begin
- DX := FLabelInfo.ALabel.Left - Left;
- DY := FLabelInfo.ALabel.Top - Top - Height;
- end;
- if (DX <> FLabelInfo.OffsetX) or (DY <> FLabelInfo.OffsetY) then
- PositionLabel;
- end;
-end;
-
-procedure TO32CustomControl.OMRecordLabelPosition(var Msg : TMessage);
-begin
- if Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) then begin
- {if the label was cut and then pasted, this will complete the re-attachment}
- FLabelInfo.FVisible := True;
-
- if DefaultLabelPosition = lpTopLeft then
- FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
- FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top)
- else
- FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
- FLabelInfo.ALabel.Top - Top - Height);
- end;
-end;
-
-procedure TO32CustomControl.PositionLabel;
-begin
- if FLabelInfo.Visible and Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) and
- not (csLoading in ComponentState) then begin
-
- if DefaultLabelPosition = lpTopLeft then begin
- FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
- FLabelInfo.OffsetY - FLabelInfo.ALabel.Height + Top,
- FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
- end else begin
- FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
- FLabelInfo.OffsetY + Top + Height,
- FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
- end;
- end;
-end;
-
-procedure TO32CustomControl.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
-begin
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-
- if HandleAllocated then
- PostMessage(Handle, OM_POSITIONLABEL, 0, 0);
-end;
-
-procedure TO32CustomControl.SetAbout(const Value : string);
-begin
-end;
-
-procedure TO32CustomControl.WMKillFocus(var Msg : TWMKillFocus);
-begin
- inherited;
-
- PostMessage(Handle, OM_AFTEREXIT, 0, 0);
-end;
-
-procedure TO32CustomControl.WMMouseWheel(var Msg : TMessage);
-// TurboPower bug: They should have used TWMMouseWheel instead of
-// TMessage. Delta is negative on scroll down, but extracting it
-// from wParam with HIWORD returns a Word, which causes an
-// exception when passed as SmallInt to DoOnMouseWheel when
-// range checking turned on. Fix is to cast delta as SmallInt.
-begin
- with Msg do
- DoOnMouseWheel(KeysToShiftState(LOWORD(wParam)) {fwKeys},
- SmallInt(HIWORD(wParam)) {zDelta}, //bug fix
- LOWORD(lParam) {xPos}, HIWORD(lParam) {yPos});
-end;
-
-procedure TO32CustomControl.WMSetFocus(var Msg : TWMSetFocus);
-begin
- inherited;
-
- PostMessage(Handle, OM_AFTERENTER, 0, 0);
-end;
-
-{*** End - TO32CustomCOntrol ***}
-
-
-{*** TOvcCustomControl ***}
-procedure TOvcCustomControl.CMVisibleChanged(var Msg : TMessage);
-begin
- inherited;
-
- if csLoading in ComponentState then
- Exit;
-
- if LabelInfo.Visible then
- AttachedLabel.Visible := Visible;
-end;
-
-constructor TOvcCustomControl.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- DefaultLabelPosition := lpTopLeft;
-
- FLabelInfo := TOvcLabelInfo.Create;
- FLabelInfo.OnChange := LabelChange;
- FLabelInfo.OnAttach := LabelAttach;
-end;
-
-procedure TOvcCustomControl.CreateWnd;
-begin
- inherited CreateWnd;
-end;
-
-destructor TOvcCustomControl.Destroy;
-begin
- FLabelInfo.Visible := False;
- FLabelInfo.Free;
- FLabelInfo := nil;
- FCollectionStreamer.Free;
- FCollectionStreamer := nil;
- inherited Destroy;
-end;
-
-procedure TOvcCustomControl.DoOnMouseWheel(Shift : TShiftState;
- Delta, XPos, YPos : SmallInt);
-begin
- if Assigned(FOnMouseWheel) then
- FOnMouseWheel(Self, Shift, Delta, XPos, YPos);
-end;
-
-function TOvcCustomControl.GetAttachedLabel : TOvcAttachedLabel;
-begin
- if not FLabelInfo.Visible then
- raise Exception.Create(GetOrphStr(SCLabelNotAttached));
-
- Result := FLabelInfo.ALabel;
-end;
-
-function TOvcCustomControl.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-
-procedure TOvcCustomControl.LabelAttach(Sender : TObject; Value : Boolean);
-var
-{$IFDEF VERSION5}
- PF : TWinControl;
-{$ELSE}
- PF : TForm;
-{$ENDIF}
- S : string;
-begin
- if (csLoading in ComponentState) then
- Exit;
-
-{$IFDEF VERSION5}
- PF := GetImmediateParentForm(Self);
-{$ELSE}
- PF := TForm(GetParentForm(Self));
-{$ENDIF}
- if Value then begin
- if Assigned(PF) then begin
- FLabelInfo.ALabel.Free;
- FLabelInfo.ALabel := TOvcAttachedLabel.CreateEx(PF, Self);
- FLabelInfo.ALabel.Parent := Parent;
-
- S := GenerateComponentName(PF, Name + 'Label');
- FLabelInfo.ALabel.Name := S;
- FLabelInfo.ALabel.Caption := S;
-
- FLabelInfo.SetOffsets(0, 0);
- PositionLabel;
- FLabelInfo.ALabel.BringToFront;
-
- {force auto size}
- FLabelInfo.ALabel.AutoSize := True;
- end;
- end else begin
- if Assigned(PF) then begin
- FLabelInfo.ALabel.Free;
- FLabelInfo.ALabel := nil;
- end;
- end;
-end;
-
-procedure TOvcCustomControl.LabelChange(Sender : TObject);
-begin
- if not (csLoading in ComponentState) then
- PositionLabel;
-end;
-
-procedure TOvcCustomControl.Notification(AComponent : TComponent; Operation : TOperation);
-var
-{$IFDEF VERSION5}
- PF : TWinControl;
-{$ELSE}
- PF : TForm;
-{$ENDIF}
-begin
- inherited Notification(AComponent, Operation);
-
- if Operation = opRemove then
- if Assigned(FLabelInfo) and (AComponent = FLabelInfo.ALabel) then begin
-{$IFDEF VERSION5}
- PF := GetImmediateParentForm(Self);
-{$ELSE}
- PF := TForm(GetParentForm(Self));
-{$ENDIF}
- if Assigned(PF) and not (csDestroying in PF.ComponentState) then begin
- FLabelInfo.FVisible := False;
- FLabelInfo.ALabel := nil;
- end;
- end;
-end;
-
-procedure TOvcCustomControl.OMAfterEnter(var Msg : TMessage);
-begin
- if Assigned(FAfterEnter) then
- FAfterEnter(Self);
-end;
-
-procedure TOvcCustomControl.OMAfterExit(var Msg : TMessage);
-begin
- if Assigned(FAfterExit) then
- FAfterExit(Self);
-end;
-
-procedure TOvcCustomControl.OMAssignLabel(var Msg : TMessage);
-begin
- FLabelInfo.ALabel := TOvcAttachedLabel(Msg.lParam);
-end;
-
-procedure TOvcCustomControl.OMPositionLabel(var Msg : TMessage);
-const
- DX : Integer = 0;
- DY : Integer = 0;
-begin
- if FLabelInfo.Visible and
- Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) and
- not (csLoading in ComponentState) then begin
- if DefaultLabelPosition = lpTopLeft then begin
- DX := FLabelInfo.ALabel.Left - Left;
- DY := FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top;
- end else begin
- DX := FLabelInfo.ALabel.Left - Left;
- DY := FLabelInfo.ALabel.Top - Top - Height;
- end;
- if (DX <> FLabelInfo.OffsetX) or (DY <> FLabelInfo.OffsetY) then
- PositionLabel;
- end;
-end;
-
-procedure TOvcCustomControl.OMRecordLabelPosition(var Msg : TMessage);
-begin
- if Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) then begin
- {if the label was cut and then pasted, this will complete the re-attachment}
- FLabelInfo.FVisible := True;
-
- if DefaultLabelPosition = lpTopLeft then
- FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
- FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top)
- else
- FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
- FLabelInfo.ALabel.Top - Top - Height);
- end;
-end;
-
-procedure TOvcCustomControl.PositionLabel;
-begin
- if FLabelInfo.Visible and Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) and
- not (csLoading in ComponentState) then begin
-
- if DefaultLabelPosition = lpTopLeft then begin
- FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
- FLabelInfo.OffsetY - FLabelInfo.ALabel.Height + Top,
- FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
- end else begin
- FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
- FLabelInfo.OffsetY + Top + Height,
- FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
- end;
- end;
-end;
-
-procedure TOvcCustomControl.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
-begin
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-
- if HandleAllocated then
- PostMessage(Handle, OM_POSITIONLABEL, 0, 0);
-end;
-
-procedure TOvcCustomControl.SetAbout(const Value : string);
-begin
-end;
-
-procedure TOvcCustomControl.WMKillFocus(var Msg : TWMKillFocus);
-begin
- inherited;
-
- PostMessage(Handle, OM_AFTEREXIT, 0, 0);
-end;
-
-procedure TOvcCustomControl.WMMouseWheel(var Msg : TMessage);
-// See TurboPower bug comments above.
-begin
- with Msg do
- DoOnMouseWheel(KeysToShiftState(LOWORD(wParam)) {fwKeys},
- SmallInt(HIWORD(wParam)) {zDelta}, //bug fix
- LOWORD(lParam) {xPos}, HIWORD(lParam) {yPos});
-end;
-
-procedure TOvcCustomControl.WMSetFocus(var Msg : TWMSetFocus);
-begin
- inherited;
-
- PostMessage(Handle, OM_AFTERENTER, 0, 0);
-end;
-
-
-{Logic for streaming collections of sub-components}
-
-function TOvcCustomControl.GetChildOwner: TComponent;
-begin
- if Assigned(FCollectionStreamer) then
- Result := FCollectionStreamer.Owner
- else
- Result := inherited GetChildOwner;
-end;
-
-procedure TOvcCustomControl.GetChildren(Proc: TGetChildProc; Root : TComponent);
-begin
- if Assigned(FCollectionStreamer) then
- CollectionStreamer.GetChildren(Proc, Root)
- else
- inherited GetChildren(Proc, Root);
-end;
-
-procedure TOvcCustomControl.Loaded;
-begin
- if Assigned(FCollectionStreamer) then
- FCollectionStreamer.Loaded;
- inherited Loaded;
-end;
-
-{*** TOvcCustomControlEx ***}
-
-function TOvcCustomControlEx.ControllerAssigned : Boolean;
-begin
- Result := Assigned(FController);
-end;
-
-procedure TOvcCustomControlEx.CreateWnd;
-var
- OurForm : TWinControl;
-
-begin
- OurForm := GetImmediateParentForm(Self);
-
- {do this only when the component is first dropped on the form, not during loading}
- if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
- ResolveController(OurForm, FController);
-
- if not Assigned(FController) and not (csLoading in ComponentState) then begin
- {try to find a controller on this form that we can use}
- FController := FindController(OurForm);
-
- {if not found and we are not designing, use default controller}
- if not Assigned(FController) and not (csDesigning in ComponentState) then
- FController := DefaultController;
- end;
-
- inherited CreateWnd;
-end;
-
-function TOvcCustomControlEx.GetController: TOvcController;
-begin
- if FController = nil then
- Result := DefaultController
- else
- Result := FController;
-end;
-
-procedure TOvcCustomControlEx.Notification(AComponent : TComponent; Operation : TOperation);
-begin
- inherited Notification(AComponent, Operation);
-
- if Operation = opRemove then begin
- if (AComponent = FController) then
- FController := nil;
- end else if (Operation = opInsert) and (FController = nil) and
- (AComponent is TOvcController) then
- FController := TOvcController(AComponent);
-end;
-
-procedure TOvcCustomControlEx.SetController(Value : TOvcController);
-begin
- if not (TObject(Value) is TOvcController) then
- Value := nil;
- FController := Value;
- if Value <> nil then
- Value.FreeNotification(Self);
-end;
-
-function TOvcCollection.Add : TComponent;
-begin
- if not Assigned(FItemClass) then
- raise Exception.Create(GetOrphStr(SCClassNotSet));
- Result := FItemClass.Create(Owner);
- Changed;
- if ItemEditor <> nil then
- SendMessage(ItemEditor.Handle, OM_PROPCHANGE, 0, 0);
-end;
-
-procedure TOvcCollection.Changed;
-var
- Parent : TForm;
-begin
- {$IFDEF Logging}
- LogMsg('TOvcCollection.Changed');
- LogBoolean('InChanged', InChanged);
- {$ENDIF}
- if InChanged then exit;
- InChanged := True;
- try
- Parent := ParentForm;
- if Parent <> nil then begin
- {$IFDEF Logging}
- LogString('Parent.ClassName', Parent.ClassName);
- LogBoolean('(csLoading in Parent.ComponentState)', (csLoading in Parent.ComponentState));
- {$ENDIF}
- if not (csLoading in Parent.ComponentState)
- and (csDesigning in Parent.ComponentState) then begin
- {$IFDEF Logging}
- LogBoolean('TForm(Parent).Designer <> nil', TForm(Parent).Designer <> nil);
- LogBoolean('InLoaded', InLoaded);
- LogBoolean('IsLoaded', IsLoaded);
- LogBoolean('(csAncestor in Owner.ComponentState)', (csAncestor in Owner.ComponentState));
- LogBoolean('Stored', Stored);
- {$ENDIF}
- {$IFDEF VERSION5}
- if (TForm(Parent).Designer <> nil)
- {$ELSE}
- if (Parent.Designer <> nil)
- {$ENDIF}
- and not InLoaded
- and IsLoaded
- and not (csAncestor in Owner.ComponentState)
- and Stored then
- {$IFDEF VERSION5}
- TForm(Parent).Designer.Modified;
- {$ELSE}
- Parent.Designer.Modified;
- {$ENDIF}
- if (ItemEditor <> nil)
- and not (csAncestor in Owner.ComponentState)
- then
- SendMessage(ItemEditor.Handle, OM_PROPCHANGE, 0, 0);
- end;
- if Assigned(FOnChanged) then
- FOnChanged(Self);
- end;
- finally
- InChanged := False;
- end;
-end;
-
-procedure TOvcCollection.Clear;
-{$IFDEF Version5}
-var
- i : Integer;
-{$ENDIF}
-begin
- {$IFDEF Version5}
- for i := Count - 1 downto 0 do
- if not (csAncestor in Item[i].ComponentState) then
- Item[i].Free;
- {$ELSE}
- while Count > 0 do
- Item[0].Free;
- {$ENDIF}
- if ItemEditor <> nil then
- SendMessage(ItemEditor.Handle, OM_PROPCHANGE, 0, 0);
-end;
-
-constructor TOvcCollection.Create(AOwner : TComponent;
- ItemClass : TOvcCollectibleClass);
-begin
- inherited Create;
- FStored := True;
- FItemClass := ItemClass;
- FItems := TList.Create;
- FOwner := AOwner;
-
- if (AOwner is TOvcComponent) then
- begin
- if TOvcComponent(AOwner).CollectionStreamer = nil then
- TOvcComponent(AOwner).CollectionStreamer := TOvcCollectionStreamer.Create(AOwner);
- FStreamer := TOvcComponent(AOwner).CollectionStreamer;
- FStreamer.FCollectionList.Add(Self);
- end
- else
- if (AOwner is TOvcCustomControl) then
- begin
- if TOvcCustomControl(AOwner).CollectionStreamer = nil then
- TOvcCustomControl(AOwner).CollectionStreamer := TOvcCollectionStreamer.Create(AOwner);
- FStreamer := TOvcCustomControl(AOwner).CollectionStreamer;
- FStreamer.FCollectionList.Add(Self);
- end
- else
- raise Exception.Create(GetOrphStr(SCNotOvcDescendant));
-end;
-
-procedure TOvcCollection.Delete(Index : Integer);
-begin
- if (Index > -1) and (Index < Count) then
- Item[Index].Free;
- Changed;
-end;
-
-destructor TOvcCollection.Destroy;
-begin
- ItemEditor.Free;
- if (Owner is TOvcComponent) then
- TOvcComponent(Owner).CollectionStreamer.FCollectionList.Remove(Self)
- else
- TOvcCustomControl(Owner).CollectionStreamer.FCollectionList.Remove(Self);
- Clear;
- FItems.Free;
- inherited Destroy;
-end;
-
-procedure TOvcCollection.DoOnItemSelected(Index : Integer);
-begin
- if Assigned(FOnItemSelected) then
- FOnItemSelected(Self, Index);
-end;
-
-function TOvcCollection.GetCount : Integer;
-begin
- Result := FItems.Count;
-end;
-
-function TOvcCollection.GetEditorCaption : string;
-begin
- Result := 'Editing ' + ClassName;
- if Assigned(FOnGetEditorCaption) then
- FOnGetEditorCaption(Result);
-end;
-
-function TOvcCollection.GetItem(Index : Integer) : TComponent;
-begin
- Result := TComponent(FItems[Index]);
-end;
-
-function TOvcCollection.Insert(Index : Integer) : TComponent;
-begin
- if (Index < 0) or (Index > Count) then
- Index := Count;
- Result := Add;
- if Result is TOvcCollectible then
- TOvcCollectible(Item[Count-1]).Index := Index
- else
- if Result is TOvcCollectibleControl then
- TOvcCollectibleControl(Item[Count-1]).Index := Index
- else
- Result := nil;
-end;
-
-function TOvcCollection.ItemByName(const Name : string) : TComponent;
-var
- i : Integer;
-begin
- for i := 0 to pred(Count) do
- if Item[i].Name = Name then begin
- Result := Item[i];
- exit;
- end;
- Result := nil;
-end;
-
-procedure TOvcCollection.Loaded;
-begin
- InLoaded := True;
- try
- Changed;
- finally
- InLoaded := False;
- end;
- IsLoaded := True;
-end;
-
-function TOvcCollection.ParentForm : TForm;
-var
- Temp : TObject;
-begin
- Temp := Owner;
- while (Temp <> nil) and not (Temp is TForm) do
- Temp := TComponent(Temp).Owner;
- Result := TForm(Temp);
-end;
-
-procedure TOvcCollection.SetItem(Index : Integer; Value : TComponent);
-begin
- TOvcCollectible(FItems[Index]).Assign(Value);
-end;
-
-procedure TOvcCollectionStreamer.Clear;
-var
- I : Integer;
-begin
- for I := 0 to pred(FCollectionList.Count) do
- TOvcCollection(FCollectionList[I]).Clear;
-end;
-
-
-{===== TO32Collection ================================================}
-
-constructor TO32Collection.Create(AOwner : TPersistent;
- ItemClass : TCollectionItemClass);
-begin
- FOwner := AOwner;
- Inherited Create(ItemClass);
-end;
-
-destructor TO32Collection.Destroy;
-begin
- ItemEditor.Free;
- Clear;
- inherited Destroy;
-end;
-
-procedure TO32Collection.DoOnItemSelected(Index : Integer);
-begin
- if Assigned(FOnItemSelected) then
- FOnItemSelected(Self, Index);
-end;
-
-function TO32Collection.GetCount : Integer;
-begin
- Result := inherited Count;
-end;
-
-function TO32Collection.GetEditorCaption : string;
-begin
- Result := 'Editing ' + ClassName;
- if Assigned(FOnGetEditorCaption) then
- FOnGetEditorCaption(Result);
-end;
-
-function TO32Collection.Add : TO32CollectionItem;
-begin
- Result := TO32CollectionItem(inherited Add);
- if ItemEditor <> nil then
- SendMessage(ItemEditor.Handle, OM_PROPCHANGE, 0, 0);
-end;
-
-{$IFNDEF VERSION4}
-function TO32Collection.Insert(Index: Integer): TO32CollectionItem;
-var
- I: Integer;
-begin
- result := Add;
- for I := Index to Count - 2 do
- Items[I].Index := I + 1;
- Items[Count - 1].Index := Index;
-end;
-{$ENDIF}
-
-function TO32Collection.GetItem(Index : Integer) : TO32CollectionItem;
-begin
- Result := TO32CollectionItem(inherited GetItem(Index));
-end;
-
-function TO32Collection.GetOwner: TPersistent;
-begin
- result := FOwner;
-end;
-
-procedure TO32Collection.SetItem(Index : Integer; Value : TO32CollectionItem);
-begin
- inherited SetItem(Index, Value);
-end;
-
-function TO32Collection.ItemByName(const Name : string) : TO32CollectionItem;
-var
- i : Integer;
-begin
- for i := 0 to pred(Count) do
- if Item[i].Name = Name then begin
- Result := Item[i];
- exit;
- end;
- Result := nil;
-end;
-
-procedure TO32Collection.Loaded;
-begin
- InLoaded := True;
- try
- Changed;
- finally
- InLoaded := False;
- end;
- IsLoaded := True;
-end;
-
-function TO32Collection.ParentForm : TForm;
-var
- Temp : TObject;
-begin
- Temp := GetOwner;
- while (Temp <> nil) and not (Temp is TForm) do
- Temp := TComponent(Temp).Owner;
- Result := TForm(Temp);
-end;
-
-{End - TO32Collection }
-
-{===== TOvcCollectionStreamer ========================================}
-function TOvcCollectionStreamer.CollectionFromType(Component : TComponent) : TOvcCollection;
-var
- I : Integer;
-begin
- for I := 0 to pred(FCollectionList.Count) do
- if Component is TOvcCollection(FCollectionList[I]).ItemClass then begin
- Result := TOvcCollection(FCollectionList[I]);
- exit;
- end;
- raise Exception.Create(GetOrphStr(SCCollectionNotFound));
-end;
-
-constructor TOvcCollectionStreamer.Create(AOwner : TComponent);
-begin
- inherited Create;
-
- FOwner := AOwner;
- FCollectionList := TList.Create;
-end;
-
-destructor TOvcCollectionStreamer.Destroy;
-begin
- FCollectionList.Free;
- FCollectionList := nil;
-
- inherited Destroy;
-end;
-
-procedure TOvcCollectionStreamer.GetChildren(Proc: TGetChildProc; Root : TComponent);
-var
- I,J: Integer;
-begin
- for I := 0 to pred(FCollectionList.Count) do
- with TOvcCollection(FCollectionList[I]) do
- if Stored then
- for J := 0 to Count - 1 do
- Proc(Item[J]);
-end;
-
-procedure TOvcCollectionStreamer.Loaded;
-var
- I : Integer;
-begin
- for I := 0 to pred(FCollectionList.Count) do
- TOvcCollection(FCollectionList[I]).Loaded;
-end;
-
-function DefaultController : TOvcController;
-begin
- if FDefaultController = nil then
- FDefaultController := TOvcController.Create(nil);
- Result := FDefaultController;
-end;
-
-initialization
- {register the attached label class}
- if Classes.GetClass(TOvcAttachedLabel.ClassName) = nil then
- Classes.RegisterClass(TOvcAttachedLabel);
-{$IFDEF LCL}
- {$I ovcbase.lrs}
-{$ENDIF}
-finalization
- FDefaultController.Free;
- FDefaultController := nil;
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/ee/ee31392106c9e85be3e9e78ce4f5fd835c681092.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/ee/ee31392106c9e85be3e9e78ce4f5fd835c681092.svn-base
deleted file mode 100644
index 0ceb16ba..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/ee/ee31392106c9e85be3e9e78ce4f5fd835c681092.svn-base
+++ /dev/null
@@ -1,310 +0,0 @@
-{*********************************************************}
-{* OVCURL.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 ***** *}
-
-(*Changes)
-
- 01/23/02 - Added UnderlineURL property.
-*)
-
-
-{$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 ovcurl;
- {-URL label}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Classes, Controls, Dialogs, ExtCtrls, Graphics, Menus,
- {$IFDEF MSWINDOWS} ShellAPI, {$ELSE} Unix, {$ENDIF}
- StdCtrls, SysUtils, OvcVer;
-
-type
- TOvcURL = class(TCustomLabel)
- protected {private}
- FCaption : string;
- FHighlightColor : TColor;
- FURL : string;
- FUseVisitedColor : Boolean;
- FVisitedColor : TColor;
-
- {internal variables}
- urlTimer : TTimer;
- urlFontColor : TColor;
-
- {property methods}
- function GetAbout : string;
- function GetUnderlineURL: Boolean;
- procedure SetAbout(const Value : string);
- procedure SetCaption(const Value : string);
- procedure SetHighlightColor(const Value : TColor);
- procedure SetUnderlineURL(Value: Boolean);
- procedure SetURL(const Value : string);
- procedure SetVisitedColor(const Value : TColor);
-
- {internal methods}
- procedure TimerEvent(Sender : TObject);
-
- procedure Loaded; override;
-
- protected
- procedure MouseMove(Shift : TShiftState; X, Y : Integer);
- override;
-
- public
- procedure Click;
- override;
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
-
- published
- property About : string
- read GetAbout write SetAbout stored False;
- property Caption : string
- read FCaption write SetCaption;
- property HighlightColor : TColor
- read FHighlightColor write SetHighlightColor
- default clRed;
- property UnderlineURL: Boolean
- read GetUnderlineURL write SetUnderlineURL
- stored False;
- property URL : string
- read FURL write SetURL;
- property UseVisitedColor : Boolean
- read FUseVisitedColor write FUseVisitedColor
- default False;
- property VisitedColor : TColor
- read FVisitedColor write SetVisitedColor
- stored FUseVisitedColor
- default clBlack;
-
- {$IFDEF VERSION4}
- property Anchors;
- property Constraints;
- property DragKind;
- {$ENDIF}
- property Align;
- property Alignment;
- property AutoSize;
- property Color;
- property Cursor default crHandPoint;
- property DragCursor;
- property DragMode;
- property Enabled;
- property FocusControl;
- property Font;
- property ParentColor;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ShowAccelChar;
- property ShowHint;
- property Transparent default False;
- property Layout;
- property Visible;
- property WordWrap;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDrag;
- end;
-
-
-implementation
-
-const
- BadColor = $02000000;
-
-{*** TOvcURL ***}
-procedure TOvcURL.Loaded;
-begin
- inherited Loaded;
-
-// Font.Style := Font.Style + [fsUnderline];
- urlFontColor := BadColor;
-end;
-
-procedure TOvcURL.Click;
-{$IFDEF MSWINDOWS}
-var
- Buf : array[0..1023] of Char;
-begin
- if URL > '' then begin
- StrPLCopy(Buf, URL, SizeOf(Buf)-1);
- if ShellExecute(0, 'open', Buf, '', '', SW_SHOWNORMAL) <= 32 then
- MessageBeep(0);
- end;
-{$ELSE}
-begin
- if URL > '' then begin
- {$IFDEF DARWIN}
- if Shell('Open ' + URL) = 127 then
- MessageBeep(0);
- {$ELSE}
- if (GetBrowserPath = '') or
- (Shell(GetBrowserPath + ' ' + URL) = 127) then
- MessageBeep(0);
- {$ENDIF}
- end;
-{$ENDIF}
-
- inherited Click;
-
- {change color to visited color if enabled}
- if FUseVisitedColor then
- urlFontColor := FVisitedColor;
-end;
-
-constructor TOvcURL.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
- FHighlightColor := clRed;
- Cursor := crHandPoint;
- Font.Style := Font.Style + [fsUnderline];
-end;
-
-destructor TOvcURL.Destroy;
-begin
- if Assigned(urlTimer) then begin
- urlTimer.Free;
- urlTimer := nil;
- end;
-
- inherited Destroy;
-end;
-
-function TOvcURL.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-
-function TOvcURL.GetUnderlineURL: Boolean;
-begin
- result := fsUnderline in Font.Style;
-end;
-
-procedure TOvcURL.MouseMove(Shift : TShiftState; X, Y : Integer);
-begin
- inherited MouseMove(Shift, X, Y);
-
- if PtInRect(ClientRect, Point(X, Y)) then begin
- if not Assigned(urlTimer) then begin
- {save current font color}
- if urlFontColor = BadColor then
- urlFontColor := Font.Color;
- Font.Color := FHighlightColor;
- urlTimer := TTimer.Create(Self);
- urlTimer.Interval := 100;
- urlTimer.OnTimer := TimerEvent;
- urlTimer.Enabled := True;
- end;
- end;
-end;
-
-procedure TOvcURL.SetAbout(const Value : string);
-begin
-end;
-
-procedure TOvcURL.SetCaption(const Value : string);
-begin
- FCaption := Value;
- if FCaption > '' then
- inherited Caption := FCaption
- else
- inherited Caption := URL;
-end;
-
-procedure TOvcURL.SetHighlightColor(const Value: TColor);
-begin
- if Value = clNone then
- FHighlightColor := Font.Color
- else
- FHighlightColor := Value;
-
- {reset stored color}
- urlFontColor := BadColor;
-end;
-
-{ - added}
-procedure TOvcURL.SetUnderlineURL(Value: Boolean);
-begin
- if Value then
- Font.Style := Font.Style + [fsUnderline]
- else
- Font.Style := Font.Style - [fsUnderline];
-end;
-
-procedure TOvcURL.SetURL(const Value : string);
-begin
- FURL := Value;
- if FCaption = '' then
- inherited Caption := URL;
-end;
-
-procedure TOvcURL.SetVisitedColor(const Value : TColor);
-begin
- if Value = clNone then
- FVisitedColor := Font.Color
- else
- FVisitedColor := Value;
-
- {reset stored color}
- urlFontColor := BadColor;
-end;
-
-procedure TOvcURL.TimerEvent(Sender : TObject);
-var
- Pt : TPoint;
-begin
- GetCursorPos(Pt);
- Pt := ScreentoClient(Pt);
- if not PtInRect(ClientRect, Pt) then begin
- urlTimer.Free;
- urlTimer := nil;
- Font.Color := urlFontColor;
- Repaint;
- end;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/f0/f09f750657a617ad73cd4bac7d365ead0522a1d6.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/f0/f09f750657a617ad73cd4bac7d365ead0522a1d6.svn-base
deleted file mode 100644
index 4331db2a..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/f0/f09f750657a617ad73cd4bac7d365ead0522a1d6.svn-base
+++ /dev/null
@@ -1,341 +0,0 @@
-{*********************************************************}
-{* OVCEDPOP.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}
-{$J+} {Writable constants}
-
-unit ovcedpop;
- {-base popup edit field class}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Buttons, Classes, Controls, ExtCtrls, Forms, Graphics, Menus,
- StdCtrls, SysUtils, OvcEditF;
-
-const
- MsgClose = WM_USER+100;
- MsgOpen = WM_USER+101;
-
-type
- TOvcEdButton = class(TBitBtn)
- public
- procedure Click;
- override;
- end;
-
- TOvcPopupEvent =
- procedure(Sender : TObject) of object;
-
- TOvcPopupAnchor = (paLeft, paRight);
-
- TOvcEdPopup = class(TOvcCustomEdit)
- protected {private}
- {property variables}
- FButton : TOvcEdButton;
- FButtonGlyph : TBitmap;
- FPopupActive : Boolean;
- FPopupAnchor : TOvcPopupAnchor;
- FOnPopupClose : TOvcPopupEvent;
- FOnPopupOpen : TOvcPopupEvent;
- FShowButton : Boolean;
-
- {property methods}
- function GetButtonGlyph : TBitmap;
- procedure SetButtonGlyph(Value : TBitmap);
- procedure SetShowButton(Value : Boolean);
-
- {internal methods}
- function GetButtonWidth : Integer;
-
-{$IFDEF VERSION4}
- procedure CMDialogKey(var Msg : TCMDialogKey);
- message CM_DIALOGKEY;
-{$ENDIF}
-
- protected
- procedure CreateParams(var Params : TCreateParams);
- override;
- procedure CreateWnd;
- override;
- function GetButtonEnabled : Boolean;
- dynamic;
- procedure GlyphChanged;
- dynamic;
- procedure Loaded;
- override;
-
- procedure OnMsgClose(var M : TMessage);
- message MsgClose;
- procedure OnMsgOpen(var M : TMessage);
- message MsgOpen;
-
- property PopupAnchor : TOvcPopupAnchor
- read FPopupAnchor write FPopupAnchor;
- property ShowButton : Boolean
- read FShowButton write SetShowButton;
-
- public
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
- override;
-
- property ButtonGlyph : TBitmap
- read GetButtonGlyph
- write SetButtonGlyph;
-
- procedure PopupClose(Sender : TObject);
- dynamic;
- procedure PopupOpen;
- dynamic;
-
- property OnPopupClose : TOvcPopupEvent
- read FOnPopupClose
- write FOnPopupClose;
-
- property OnPopupOpen : TOvcPopupEvent
- read FOnPopupOpen
- write FOnPopupOpen;
-
- property PopupActive : Boolean
- read FPopupActive;
-
- property Controller;
- end;
-
-implementation
-
-{*** TOvcEdButton ***}
-
-procedure TOvcEdButton.Click;
-begin
- TOvcEdPopup(Parent).PopupOpen;
-end;
-
-
-{*** TOvcEdPopup ***}
-
-constructor TOvcEdPopup.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- ControlStyle := ControlStyle - [csSetCaption];
-
- FShowButton := True;
- FButton := TOvcEdButton.Create(Self);
- FButton.Visible := True;
- FButton.Parent := Self;
- FButton.Caption := '';
- FButton.TabStop := False;
-{$IFNDEF LCL}
- FButton.Style := bsNew;
-{$ENDIF}
-
- FButtonGlyph := TBitmap.Create;
-end;
-
-procedure TOvcEdPopup.CreateParams(var Params : TCreateParams);
-begin
- inherited CreateParams(Params);
-
- Params.Style := Params.Style or WS_CLIPCHILDREN;
-end;
-
-procedure TOvcEdPopup.CreateWnd;
-begin
- inherited CreateWnd;
-
- {force button placement}
- SetBounds(Left, Top, Width, Height);
-
- FButton.Enabled := GetButtonEnabled;
-end;
-
-
-destructor TOvcEdPopup.Destroy;
-begin
- {destroy button}
- FButton.Free;
- FButton := nil;
-
- {destroy button glyph}
- FButtonGlyph.Free;
- FButtonGlyph := nil;
-
- inherited Destroy;
-end;
-
-function TOvcEdPopup.GetButtonEnabled : Boolean;
-begin
- Result := not ReadOnly;
-end;
-
-function TOvcEdPopup.GetButtonWidth : Integer;
-begin
- if FShowButton then begin
- Result := GetSystemMetrics(SM_CXHSCROLL);
- if Assigned(FButtonGlyph) and not FButtonGlyph.Empty then
- if FButtonGlyph.Width + 4 > Result then
- Result := FButtonGlyph.Width + 4;
- end else
- Result := 0;
-end;
-
-function TOvcEdPopup.GetButtonGlyph : TBitmap;
-begin
- if not Assigned(FButtonGlyph) then
- FButtonGlyph := TBitmap.Create;
-
- Result := FButtonGlyph
-end;
-
-procedure TOvcEdPopup.GlyphChanged;
-begin
-end;
-
-procedure TOvcEdPopup.Loaded;
-begin
- inherited Loaded;
-
- if Assigned(FButtonGlyph) then
- FButton.Glyph.Assign(FButtonGlyph);
-end;
-
-procedure TOvcEdPopup.OnMsgClose(var M : TMessage);
-begin
- if (Assigned(FOnPopupClose)) then
- FOnPopupClose(Self);
-end;
-
-procedure TOvcEdPopup.OnMsgOpen(var M : TMessage);
-begin
- if (Assigned(FOnPopupOpen)) then
- FOnPopupOpen(Self);
-end;
-
-
-procedure TOvcEdPopup.PopupClose;
-begin
- FPopupActive := False;
- PostMessage(Handle, MsgClose, 0, 0);
-end;
-
-procedure TOvcEdPopup.PopupOpen;
-begin
- FPopupActive := True;
- PostMessage(Handle, MsgOpen, 0, 0);
-end;
-
-procedure TOvcEdPopup.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
-var
- H : Integer;
-begin
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-
- if not HandleAllocated then
- Exit;
-
- if not FShowButton then begin
- FButton.Height := 0;
- FButton.Width := 0;
- Exit;
- end;
-
- H := ClientHeight;
- if BorderStyle = bsNone then begin
- FButton.Height := H;
- FButton.Width := GetButtonWidth;
- FButton.Left := Width - FButton.Width;
- FButton.Top := 0;
- end else if Ctl3D then begin
- FButton.Height := H;
- FButton.Width := GetButtonWidth;
- FButton.Left := Width - FButton.Width - 4;
- FButton.Top := 0;
- end else begin
- FButton.Height := H - 2;
- FButton.Width := GetButtonWidth;
- FButton.Left := Width - FButton.Width - 1;
- FButton.Top := 1;
- end;
-end;
-
-procedure TOvcEdPopup.SetButtonGlyph(Value : TBitmap);
-begin
- if not Assigned(FButtonGlyph) then
- FButtonGlyph := TBitmap.Create;
-
- if not Assigned(Value) then begin
- FButtonGlyph.Free;
- FButtonGlyph := TBitmap.Create;
- end else
- FButtonGlyph.Assign(Value);
-
- GlyphChanged;
-
- FButton.Glyph.Assign(FButtonGlyph);
- SetBounds(Left, Top, Width, Height);
-end;
-
-procedure TOvcEdPopup.SetShowButton(Value : Boolean);
-begin
- if Value <> FShowButton then begin
- FShowButton := Value;
- {force resize and redisplay of button}
- SetBounds(Left, Top, Width, Height);
- end;
-end;
-
-{$IFDEF VERSION4}
-procedure TOvcEdPopup.CMDialogKey(var Msg : TCMDialogKey);
-begin
- if PopupActive then begin
- with Msg do begin
- if ((CharCode = VK_RETURN) or (CHarCode = VK_ESCAPE)) then begin
- PopupClose(Self);
- Result := 1;
- end;
- end;
- end else
- inherited;
-end;
-{$ENDIF}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/f2/f212b36b44505bf8978bf8082d5eb947b872db1b.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/f2/f212b36b44505bf8978bf8082d5eb947b872db1b.svn-base
deleted file mode 100644
index d84f6a28..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/f2/f212b36b44505bf8978bf8082d5eb947b872db1b.svn-base
+++ /dev/null
@@ -1,16 +0,0 @@
-#!/bin/sh
-lazdir=~/lazarus
-if ! [ -e $lazdir ]
-then
- lazdir=/usr/local/share/lazarus
-fi
-$lazdir/lazbuild -d --ws=gtk tests/TestFlexEdit/project1.lpi
-$lazdir/lazbuild -d --ws=gtk tests/TestLabel/project1.lpi
-$lazdir/lazbuild -d --ws=gtk tests/TestRLbl/project1.lpi
-$lazdir/lazbuild -d --ws=gtk tests/TestSimpField/project1.lpi
-$lazdir/lazbuild -d --ws=gtk tests/TestSpinner/project1.lpi
-$lazdir/lazbuild -d --ws=gtk tests/TestTable/project1.lpi
-$lazdir/lazbuild -d --ws=gtk tests/TestTblEdits/project1.lpi
-$lazdir/lazbuild -d --ws=gtk tests/TestURL/project1.lpi
-$lazdir/lazbuild -d --ws=gtk tests/TestVLB/project1.lpi
-$lazdir/lazbuild -d --ws=gtk tests/TestCalendar/project1.lpi
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/f3/f30affcb8995e9b8ca3f1a5e7f86dbb3ce415e5e.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/f3/f30affcb8995e9b8ca3f1a5e7f86dbb3ce415e5e.svn-base
deleted file mode 100644
index 00611234..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/f3/f30affcb8995e9b8ca3f1a5e7f86dbb3ce415e5e.svn-base
+++ /dev/null
@@ -1,1128 +0,0 @@
-{*********************************************************}
-{* OVCEDCAL.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 ovcedcal;
- {-date edit field with popup calendar}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Buttons, Classes, Controls, Forms, Graphics, Menus,
- StdCtrls, SysUtils, {$IFNDEF LCL} {$IFDEF VERSION4} MultiMon, {$ENDIF} {$ENDIF} OvcBase, OvcCal,
- OvcConst, OvcData, OvcEdPop, OvcExcpt, OvcIntl, OvcMisc, OvcEditF, OvcDate;
-
-type
- TOvcDateOrder = (doMDY, doDMY, doYMD);
- TOvcRequiredDateField = (rfYear, rfMonth, rfDay);
- TOvcRequiredDateFields = set of TOvcRequiredDateField;
-
- {Events}
- TOvcGetDateEvent = procedure(Sender : TObject; var Value : string) of object;
- TOvcPreParseDateEvent = procedure(Sender : TObject; var Value : string)
- of object;
- TOvcGetDateMaskEvent = procedure(Sender : TObject; var Mask : string)
- of object;
-
- TOvcCustomDateEdit = class(TOvcEdPopup)
- protected {private}
- {property variables}
- FAllowIncDec : Boolean;
- FCalendar : TOvcCalendar;
- FDate : TDateTime;
- FEpoch : Integer;
- FForceCentury : Boolean;
- FRequiredFields : TOvcRequiredDateFields;
- FTodayString : string;
-
- {event variables}
- FOnGetDate : TOvcGetDateEvent;
- FOnGetDateMask : TOvcGetDateMaskEvent;
- FOnPreParseDate : TOvcPreParseDateEvent;
- FOnSetDate : TNotifyEvent;
-
- {internal variables}
- DateOrder : TOvcDateOrder;
- HoldCursor : TCursor;
- PopupClosing : Boolean;
- WasAutoScroll : Boolean;
-
- {property methods}
- function GetDate : TDateTime;
- function GetEpoch : Integer;
- function GetPopupColors : TOvcCalColors;
- function GetPopupFont : TFont;
- function GetPopupHeight : Integer;
- function GetPopupDateFormat : TOvcDateFormat;
- function GetPopupDayNameWidth : TOvcDayNameWidth;
- function GetPopupOptions : TOvcCalDisplayOptions;
- function GetPopupWeekStarts : TOvcDayType;
- function GetPopupWidth : Integer;
- function GetReadOnly : Boolean;
- procedure SetEpoch(Value : Integer);
- procedure SetForceCentury(Value : Boolean);
- procedure SetPopupColors(Value : TOvcCalColors);
- procedure SetPopupFont(Value : TFont);
- procedure SetPopupHeight(Value : Integer);
- procedure SetPopupWidth(Value : Integer);
- procedure SetPopupDateFormat(Value : TOvcDateFormat);
- procedure SetPopupDayNameWidth(Value : TOvcDayNameWidth);
- procedure SetPopupOptions(Value : TOvcCalDisplayOptions);
- procedure SetPopupWeekStarts(Value : TOvcDayType);
- procedure SetReadOnly(Value : Boolean);
-
- {internal methods}
- function ParseDate(const Value : string) : string;
- procedure PopupDateChange(Sender : TObject; Date : TDateTime);
- procedure PopupKeyDown(Sender : TObject; var Key : Word;
- Shift : TShiftState);
- procedure PopupKeyPress(Sender : TObject; var Key : Char);
- procedure PopupMouseDown(Sender : TObject; Button : TMouseButton;
- Shift : TShiftState; X, Y : Integer);
- protected
- procedure DoExit; override;
- procedure GlyphChanged; override;
- procedure KeyDown(var Key : Word; Shift : TShiftState); override;
- procedure KeyPress(var Key : Char); override;
- procedure SetDate(Value : TDateTime);
-
- {protected properties}
- property AllowIncDec : Boolean read FAllowIncDec write FAllowIncDec;
- property Epoch : Integer read GetEpoch write SetEpoch;
- property ForceCentury : Boolean read FForceCentury write SetForceCentury;
- property PopupColors : TOvcCalColors read GetPopupColors
- write SetPopupColors;
- property PopupFont : TFont read GetPopupFont write SetPopupFont;
- property PopupHeight : Integer read GetPopupHeight write SetPopupHeight;
- property PopupWidth : Integer read GetPopupWidth write SetPopupWidth;
- property PopupDateFormat : TOvcDateFormat read GetPopupDateFormat
- write SetPopupDateFormat;
- property PopupDayNameWidth : TOvcDayNameWidth read GetPopupDayNameWidth
- write SetPopupDayNameWidth;
- property PopupOptions : TOvcCalDisplayOptions read GetPopupOptions
- write SetPopupOptions;
- property PopupWeekStarts : TOvcDayType read GetPopupWeekStarts
- write SetPopupWeekStarts;
- property ReadOnly : Boolean read GetReadOnly write SetReadOnly;
- property RequiredFields : TOvcRequiredDateFields read FRequiredFields
- write FRequiredFields;
- property TodayString : string read FTodayString write FTodayString;
-
- {protected events}
- property OnGetDate : TOvcGetDateEvent read FOnGetDate write FOnGetDate;
- property OnGetDateMask : TOvcGetDateMaskEvent read FOnGetDateMask
- write FOnGetDateMask;
- property OnPreParseDate : TOvcPreParseDateEvent read FOnPreParseDate
- write FOnPreParseDate;
- property OnSetDate : TNotifyEvent read FOnSetDate write FOnSetDate;
-
- public
- constructor Create(AOwner : TComponent); override;
- function DateString(const Mask : string) : string;
- function FormatDate(Value : TDateTime) : string; dynamic;
- procedure PopupClose(Sender : TObject); override;
- procedure PopupOpen; override;
- procedure SetDateText(Value : string); dynamic;
- {public properties}
- property Calendar : TOvcCalendar read FCalendar;
- property Date: TDateTime read GetDate write SetDate;
- end;
-
-
- TOvcDateEdit = class(TOvcCustomDateEdit)
- published
- {properties}
- {$IFDEF VERSION4}
- property Anchors;
- property Constraints;
- property DragKind;
- {$ENDIF}
- property About;
- property AllowIncDec;
-{$IFNDEF LCL}
- property AutoSelect;
-{$ENDIF}
- property AutoSize;
- property BorderStyle;
- property ButtonGlyph;
- property CharCase;
- property Color;
- property Controller;
- property Ctl3D;
- property Cursor;
- property DragCursor;
- property DragMode;
- property Enabled;
- property Epoch;
- property Font;
- property ForceCentury;
-{$IFNDEF LCL}
- property HideSelection;
-{$ENDIF}
- property LabelInfo;
- property ParentColor;
-{$IFNDEF LCL}
- property ParentCtl3D;
-{$ENDIF}
- property ParentFont;
- property ParentShowHint;
- property PopupAnchor;
- property PopupColors;
- property PopupDateFormat;
- property PopupDayNameWidth;
- property PopupFont;
- property PopupHeight;
- property PopupMenu;
- property PopupOptions;
- property PopupWidth;
- property PopupWeekStarts;
- property ReadOnly;
- property RequiredFields;
- property ShowButton;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property TodayString;
- property Visible;
-
- {inherited events}
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnGetDate;
- property OnGetDateMask;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnPopupClose;
- property OnPopupOpen;
- property OnPreParseDate;
- property OnSetDate;
- property OnStartDrag;
- end;
-
-implementation
-
-{*** TOvcCustomDateEdit ***}
-
-constructor TOvcCustomDateEdit.Create(AOwner : TComponent);
-var
- C : array[0..1] of Char;
-begin
- inherited Create(AOwner);
-
- ControlStyle := ControlStyle - [csSetCaption];
-
- FAllowIncDec := True;
- FForceCentury := False;
- FRequiredFields := [rfMonth, rfDay];
- FTodayString := DateSeparator;
-
- {get the date order from windows}
- C[0] := '0'; {default}
-
- GetProfileString('intl', 'iDate', '0', C, 2);
- DateOrder := TOvcDateOrder(Ord(C[0])-Ord('0'));
-
- {load button glyph}
-{$IFNDEF LCL}
- FButtonGlyph.Handle := LoadBaseBitmap('ORBTNCAL');
-{$ELSE}
- FButtonGlyph.LoadFromLazarusResource('ORBTNCAL');
-{$ENDIF}
- FButton.Glyph.Assign(FButtonGlyph);
-
- FCalendar := TOvcCalendar.CreateEx(Self, True);
- FCalendar.OnChange := PopupDateChange;
- FCalendar.OnExit := PopupClose;
- FCalendar.OnKeyDown := PopupKeyDown;
- FCalendar.OnKeyPress := PopupKeyPress;
- FCalendar.OnMouseDown := PopupMouseDown;
- FCalendar.Visible := False; {to avoid flash at 0,0}
- FCalendar.BorderStyle := bsSingle;
- FCalendar.ParentFont := False;
- FCalendar.Parent := GetImmediateParentForm(Self);
-end;
-
-procedure TOvcCustomDateEdit.DoExit;
-begin
- try
- SetDateText(Text);
- except
- SetFocus;
- raise;
- end;
-
- if not PopupActive then
- inherited DoExit;
-end;
-
-function TOvcCustomDateEdit.DateString(const Mask : string) : string;
-begin
- Result := OvcIntlSup.DateToDateString(Mask, DateTimeToSTDate(Date), False);
-end;
-
-function TOvcCustomDateEdit.FormatDate(Value : TDateTime) : string;
-var
- DateMask : string;
- Mask : string;
-begin
- DateMask := OvcIntlSup.InternationalDate(FForceCentury);
- if Assigned(FOnGetDateMask) then begin
- FOnGetDateMask(Self, DateMask);
- {see if the date order needs to be changed}
- Mask := AnsiUpperCase(DateMask);
- if (Pos('M', Mask) > Pos('Y', Mask)) or
- (Pos('N', Mask) > Pos('Y', Mask)) then
- DateOrder := doYMD
- else if (Pos('M', Mask) > Pos('D', Mask)) or
- (Pos('N', Mask) > Pos('D', Mask)) then
- DateOrder := doDMY
- else
- DateOrder := doMDY;
- end;
- Result := OvcIntlSup.DateToDateString(DateMask, DateTimeToSTDate(Value), False);
-end;
-
-function TOvcCustomDateEdit.GetDate : TDateTime;
-begin
- SetDateText(Text);
- Result := FDate;
-end;
-
-function TOvcCustomDateEdit.GetEpoch : Integer;
-begin
- Result := FEpoch;
-
- if (csWriting in ComponentState) then
- Exit;
-
- if (Result = 0) and ControllerAssigned then
- Result := Controller.Epoch;
-end;
-
-function TOvcCustomDateEdit.GetPopupColors : TOvcCalColors;
-begin
- Result := FCalendar.Colors;
-end;
-
-function TOvcCustomDateEdit.GetPopupDateFormat : TOvcDateFormat;
-begin
- Result := FCalendar.DateFormat;
-end;
-
-function TOvcCustomDateEdit.GetPopupDayNameWidth : TOvcDayNameWidth;
-begin
- Result := FCalendar.DayNameWidth;
-end;
-
-function TOvcCustomDateEdit.GetPopupFont : TFont;
-begin
- Result := FCalendar.Font;
-end;
-
-function TOvcCustomDateEdit.GetPopupHeight : Integer;
-begin
- Result := FCalendar.Height;
-end;
-
-function TOvcCustomDateEdit.GetPopupOptions: TOvcCalDisplayOptions;
-begin
- Result := FCalendar.Options;
-end;
-
-function TOvcCustomDateEdit.GetPopupWeekStarts: TOvcDayType;
-begin
- Result := FCalendar.WeekStarts;
-end;
-
-function TOvcCustomDateEdit.GetPopupWidth : Integer;
-begin
- Result := FCalendar.Width;
-end;
-
-function TOvcCustomDateEdit.GetReadOnly : Boolean;
-begin
- Result := inherited ReadOnly;
-end;
-
-procedure TOvcCustomDateEdit.GlyphChanged;
-begin
- inherited GlyphChanged;
-
- if FButtonGlyph.Empty then
-{$IFNDEF LCL}
- FButtonGlyph.Handle := LoadBaseBitmap('ORBTNCAL');
-{$ELSE}
- FButtonGlyph.LoadFromLazarusResource('ORBTNCAL');
-{$ENDIF}
-end;
-
-procedure TOvcCustomDateEdit.KeyDown(var Key : Word; Shift : TShiftState);
-begin
- inherited KeyDown(Key, Shift);
-
- if ShowButton and (Key = VK_DOWN) and (ssAlt in Shift) then
- PopupOpen;
-end;
-
-procedure TOvcCustomDateEdit.KeyPress(var Key : Char);
-var
- D : Word;
- M : Word;
- Y : Word;
-begin
- inherited KeyPress(Key);
-
- if (ReadOnly) then Exit;
-
- if FAllowIncDec and (Key in ['+', '-']) then begin
- {accept current date}
- DoExit;
- if FDate = 0 then
- DecodeDate(SysUtils.Date, Y, M, D)
- else
- DecodeDate(FDate, Y, M, D);
- if Key = '+' then begin
- Inc(D);
- if D > DaysInMonth(M, Y, Epoch) then begin
- D := 1;
- Inc(M);
- if M > 12 then begin
- Inc(Y);
- M := 1;
- end;
- end;
- end else begin
- {Key = '-'}
- Dec(D);
- if D < 1 then begin
- Dec(M);
- if M < 1 then begin
- M := 12;
- Dec(Y);
- end;
- D := DaysInMonth(M, Y, Epoch);
- end;
- end;
- SetDate(STDateToDateTime(DMYToSTDate(D, M, Y, Epoch)));
-
- {clear}
- Key := #0;
- end;
-end;
-
-function TOvcCustomDateEdit.ParseDate(const Value : string) : string;
-var
- S : string;
- ThisYear : Word;
- ThisMonth : Word;
- ThisDay : Word;
- DefaultDate : TStDate;
- Increment : Integer;
- Occurrence : Integer;
- StartDate : TStDate;
-
- procedure DoSetDate;
- var
- I : integer;
- D : TStDate;
- DOW : TStDayType;
- begin
- D := StartDate;
- DOW := DayofWeek(DateTimeToStDate(SysUtils.Date));
- if Pos(AnsiUppercase(Copy(LongDayNames[1],1,3)), S) > 0 then begin
- DOW := Sunday;
- end else if Pos(AnsiUppercase(Copy(LongDayNames[2],1,3)), S) > 0 then begin
- DOW := Monday;
- end else if Pos(AnsiUppercase(Copy(LongDayNames[3],1,3)), S) > 0 then begin
- DOW := Tuesday;
- end else if Pos(AnsiUppercase(Copy(LongDayNames[4],1,3)), S) > 0 then begin
- DOW := Wednesday;
- end else if Pos(AnsiUppercase(Copy(LongDayNames[5],1,3)), S) > 0 then begin
- DOW := Thursday;
- end else if Pos(AnsiUppercase(Copy(LongDayNames[6],1,3)), S) > 0 then begin
- DOW := Friday;
- end else if Pos(AnsiUppercase(Copy(LongDayNames[7],1,3)), S) > 0 then begin
- DOW := Saturday;
- end else begin
- if DefaultDate > 0 then begin
- D := DefaultDate;
- Occurrence := 0;
- end else if DefaultDate < 0 then begin
- Result := S;
- exit;
- end;
- end;
- I := 0;
- while I < Occurrence do begin
- D := D + Increment;
- if DayOfWeek(D) = DOW then begin
- inc(I);
- end;
- end;
- Result := FormatDate(StDateToDateTime(D));
- end;
-
-begin
- {The following code provides the user the ability to enter dates
- using text descriptions. All descriptions assume the current
- date as a reference date. The following descriptions are currently
- supported:
- Next is assumed; may be abbreviated -- 1st 3 chars
- Next
- Last current day of week is assumed
- Last
- First | 1st current day of week is assumed
- First | 1st
- Second | 2nd current day of week is assumed
- Second | 2nd
- Third | 3rd current day of week is assumed
- Third | 3rd
- Fourth | 4th current day of week is assumed
- Fourth | 4th
- Final | lst current day of week is assumed
- Final | lst
- BOM | Begin returns first day of current month
- EOM | End returns last day of current month
- Yesterday returns yesterday's date
- Today returns today's date
- Tomorrow returns tomorrow's date}
-
- S := AnsiUppercase(Value);
- if Pos(GetOrphStr(SCCalYesterday), S) > 0 then begin
- Result := FormatDate(StDateToDateTime(DateTimeToStDate(SysUtils.Date) - 1));
- end else if Pos(GetOrphStr(SCCalToday), S) > 0 then begin
- Result := FormatDate(StDateToDateTime(DateTimeToStDate(SysUtils.Date)));
- end else if Pos(GetOrphStr(SCCalTomorrow), S) > 0 then begin
- Result := FormatDate(StDateToDateTime(DateTimeToStDate(SysUtils.Date) + 1));
- end else if Pos(GetOrphStr(SCCalNext), S) > 0 then begin
- Increment := 1;
- Occurrence := 1;
- StartDate := DateTimeToStDate(SysUtils.Date);
- DefaultDate := StartDate + 7;
- DoSetDate;
- end else if Pos(GetOrphStr(SCCalLast), S) > 0 then begin
- Increment := -1;
- Occurrence := 1;
- StartDate := DateTimeToStDate(SysUtils.Date);
- DefaultDate := StartDate - 7;
- DoSetDate;
- end else if Pos(GetOrphStr(SCCalPrev), S) > 0 then begin
- Increment := -1;
- Occurrence := 1;
- StartDate := DateTimeToStDate(SysUtils.Date);
- DefaultDate := StartDate - 7;
- DoSetDate;
- end else if (Pos(GetOrphStr(SCCalFirst), S) > 0)
- or (Pos(GetOrphStr(SCCal1st), S) > 0) then begin
- Increment := 1;
- Occurrence := 1;
- DecodeDate(SysUtils.Date, ThisYear, ThisMonth, ThisDay);
- StartDate := DMYToStDate(1, ThisMonth, ThisYear, Epoch) - 1;
- DefaultDate := 0;
- DoSetDate;
- end else if (Pos(GetOrphStr(SCCalSecond), S) > 0)
- or (Pos(GetOrphStr(SCCal2nd), S) > 0) then begin
- Increment := 1;
- Occurrence := 2;
- DecodeDate(SysUtils.Date, ThisYear, ThisMonth, ThisDay);
- StartDate := DMYToStDate(1, ThisMonth, ThisYear, Epoch) - 1;
- DefaultDate := 0;
- DoSetDate;
- end else if (Pos(GetOrphStr(SCCalThird), S) > 0)
- or (Pos(GetOrphStr(SCCal3rd), S) > 0) then begin
- Increment := 1;
- Occurrence := 3;
- DecodeDate(SysUtils.Date, ThisYear, ThisMonth, ThisDay);
- StartDate := DMYToStDate(1, ThisMonth, ThisYear, Epoch) - 1;
- DefaultDate := 0;
- DoSetDate;
- end else if (Pos(GetOrphStr(SCCalFourth), S) > 0)
- or (Pos(GetOrphStr(SCCal4th), S) > 0) then begin
- Increment := 1;
- Occurrence := 4;
- DecodeDate(SysUtils.Date, ThisYear, ThisMonth, ThisDay);
- StartDate := DMYToStDate(1, ThisMonth, ThisYear, Epoch) - 1;
- DefaultDate := 0;
- DoSetDate;
- end else if Pos(GetOrphStr(SCCalFinal), S) > 0 then begin
- Increment := -1;
- Occurrence := 1;
- DecodeDate(SysUtils.Date, ThisYear, ThisMonth, ThisDay);
- StartDate := DMYToStDate(DaysInMonth(ThisMonth,
- ThisYear, Epoch),
- ThisMonth, ThisYear, Epoch) + 1;
- DefaultDate := 0;
- DoSetDate;
- end else if (Pos(GetOrphStr(SCCalBOM), S) > 0)
- or (Pos(GetOrphStr(SCCalBegin), S) > 0) then begin
- Increment := 0;
- Occurrence := 0;
- DecodeDate(SysUtils.Date, ThisYear, ThisMonth, ThisDay);
- StartDate := DMYToStDate(1, ThisMonth, ThisYear, Epoch);
- DefaultDate := StartDate;
- DoSetDate;
- end else if (Pos(GetOrphStr(SCCalEOM), S) > 0)
- or (Pos(GetOrphStr(SCCalEnd), S) > 0) then begin
- Increment := 0;
- Occurrence := 0;
- DecodeDate(SysUtils.Date, ThisYear, ThisMonth, ThisDay);
- StartDate := DMYToStDate(DaysInMonth(ThisMonth,
- ThisYear, Epoch),
- ThisMonth, ThisYear, Epoch);
- DefaultDate := StartDate;
- DoSetDate;
- end else begin
- Increment := 1;
- Occurrence := 1;
- StartDate := DateTimeToStDate(SysUtils.Date);
- DefaultDate := -1;
- DoSetDate;
- end;
-end;
-
-procedure TOvcCustomDateEdit.PopupClose(Sender : TObject);
-begin
- if not FCalendar.Visible then
- {already closed, exit}
- Exit;
-
- if PopupClosing then
- Exit;
-
- {avoid recursion}
- PopupClosing := True;
-
- try
- inherited PopupClose(Sender);
-
- if GetCapture = FCalendar.Handle then
- ReleaseCapture;
-
- SetFocus;
- {hide the Calendar}
- FCalendar.Hide;
- if FCalendar.Parent is TForm then
- TForm(FCalendar.Parent).AutoScroll := WasAutoScroll;
-
- Cursor := HoldCursor;
-
- {change parentage so that we control the window handle destruction}
- FCalendar.Parent := Self;
- finally
- PopupClosing := False;
- end;
-end;
-
-procedure TOvcCustomDateEdit.PopupKeyDown(Sender : TObject; var Key : Word; Shift : TShiftState);
-var
- X : Integer;
-begin
- case Key of
- VK_TAB :
- begin
- if Shift = [ssShift] then begin
- PopupClose(Sender);
- PostMessage(Handle, WM_KeyDown, VK_TAB, Integer(ssShift));
- end else if Shift = [] then begin
- PopupClose(Sender);
- PostMessage(Handle, WM_KeyDown, VK_TAB, 0);
- end;
- end;
- VK_UP :
- begin
- if Shift = [ssAlt] then begin
- PopupClose(Sender);
- X := SelStart;
- SetFocus;
- SelStart := X;
- SelLength := 0;
- end;
- end;
- end;
-end;
-
-procedure TOvcCustomDateEdit.PopupKeyPress(Sender : TObject; var Key : Char);
-var
- X : Integer;
-begin
- case Key of
- #13,
- #32,
- #27 :
- begin
- PopupClose(Sender);
- X := SelStart;
- SetFocus;
- SelStart := X;
- SelLength := 0;
- end;
- end;
-end;
-
-procedure TOvcCustomDateEdit.PopupMouseDown(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
-var
- P : TPoint;
- I : Integer;
-begin
- P := Point(X,Y);
- if not PtInRect(FCalendar.ClientRect, P) then
- PopUpClose(Sender);
-
- {convert to our coordinate system}
- P := ScreenToClient(FCalendar.ClientToScreen(P));
-
- if PtInRect(ClientRect, P) then begin
- I := SelStart;
- SetFocus;
- SelStart := I;
- SelLength := 0;
- end;
-end;
-
-procedure TOvcCustomDateEdit.PopupOpen;
-var
- P : TPoint;
- R : TRect;
- {$IFDEF VERSION4}
- {$IFNDEF LCL}
- F : TCustomForm;
- MonInfo : TMonitorInfo;
- {$ENDIF}
- {$ENDIF}
-begin
- if FCalendar.Visible then
- {already popped up, exit}
- Exit;
-
- inherited PopupOpen;
-
- {force update of date}
- DoExit;
-
- FCalendar.Parent := GetParentForm(Self);
- if FCalendar.Parent is TForm then begin
- WasAutoScroll := TForm(FCalendar.Parent).AutoScroll;
- TForm(FCalendar.Parent).AutoScroll := False;
- end;
-
- {set 3d to be the same as our own}
-{$IFNDEF LCL}
- FCalendar.ParentCtl3D := False;
-{$ENDIF}
- FCalendar.Ctl3D := False;
-
- {determine the proper position}
- SystemParametersInfo(SPI_GETWORKAREA, 0, @R, 0);
- {$IFDEF VERSION4}
- {$IFNDEF LCL}
- F := GetParentForm(Self);
- if Assigned(F) then begin
- FillChar(MonInfo, SizeOf(MonInfo), #0);
- MonInfo.cbSize := SizeOf(MonInfo);
- GetMonitorInfo(F.Monitor.Handle, @MonInfo);
- R := MonInfo.rcWork;
- end;
- {$ENDIF}
- {$ENDIF}
- if FPopupAnchor = paLeft then
- P := ClientToScreen(Point(-3, Height-4))
- else {paRight}
- P := ClientToScreen(Point(Width-FCalendar.Width-1, Height-2));
- if not Ctl3D then begin
- Inc(P.X, 3);
- Inc(P.Y, 3);
- end;
- if P.Y + FCalendar.Height >= R.Bottom then
- P.Y := P.Y - FCalendar.Height - Height;
- if P.X + FCalendar.Width >= R.Right then
- P.X := R.Right - FCalendar.Width - 1;
- if P.X <= R.Left then
- P.X := R.Left + 1;
-
- MoveWindow(FCalendar.Handle, P.X, P.Y, FCalendar.Width, FCalendar.Height, False);
-
- if Text = '' then
- FCalendar.Date := SysUtils.Date
- else
- FCalendar.Date := FDate;
-
- HoldCursor := Cursor;
- Cursor := crArrow;
- FCalendar.Show;
- FCalendar.SetFocus;
-
- SetCapture(FCalendar.Handle);
-end;
-
-procedure TOvcCustomDateEdit.PopupDateChange(Sender : TObject; Date : TDateTime);
-begin
- {get the current value}
- SetDate(FCalendar.Date);
- Modified := True;
-
- if FCalendar.Browsing then
- Exit;
-
- {hide the Calendar}
- PopupClose(Sender);
- SetFocus;
- SelStart := Length(Text);
- SelLength := 0;
-end;
-
-procedure TOvcCustomDateEdit.SetDate(Value : TDateTime);
-begin
- FDate := Value;
- Modified := True;
-
- if FDate = 0 then
- Text := ''
- else
- Text := FormatDate(FDate);
-
- if Assigned(FOnSetDate) then
- FOnSetDate(Self);
-end;
-
-procedure TOvcCustomDateEdit.SetDateText(Value : string);
-var
- Field : Integer;
- I1 : Integer;
- I2 : Integer;
- Error : Integer;
- ThisYear : Word;
- ThisMonth : Word;
- ThisDay : Word;
- Year : Word;
- Month : Word;
- Day : Word;
- EpochYear : Integer;
- EpochCent : Integer;
- StringList : TStringList;
- FieldOrder : string[3];
- S : string;
-begin
- if Assigned(FOnPreParseDate) then
- FOnPreParseDate(Self, Value);
- Value := ParseDate(Value);
-
- if Assigned(FOnGetDate) then
- FOnGetDate(Self, Value);
-
- if (Value = '') and (FRequiredFields <> []) then begin
- FDate := 0;
- Text := '';
- Exit;
- end;
-
- if AnsiCompareText(Value, TodayString) = 0 then begin
- SetDate(SysUtils.Date);
- Text := FormatDate(FDate);
- end else begin
- DecodeDate(SysUtils.Date, ThisYear, ThisMonth, ThisDay);
- Value := AnsiUpperCase(Value);
- StringList := TStringList.Create;
- try
- {parse the string into subfields using a string list to hold the parts}
- I1 := 1;
- while (I1 <= Length(Value)) and not (Value[I1] in ['0'..'9', 'A'..'Z']) do
- Inc(I1);
- while I1 <= Length(Value) do begin
- I2 := I1;
- while (I2 <= Length(Value)) and (Value[I2] in ['0'..'9', 'A'..'Z']) do
- Inc(I2);
- StringList.Add(Copy(Value, I1, I2-I1));
- while (I2 <= Length(Value)) and not (Value[I2] in ['0'..'9', 'A'..'Z']) do
- Inc(I2);
- I1 := I2;
- end;
-
- case DateOrder of
- doMDY : FieldOrder := 'MDY';
- doDMY : FieldOrder := 'DMY';
- doYMD : FieldOrder := 'YMD';
- end;
-
- Year := 0;
- Month := 0;
- Day := 0;
- Error := 0;
- for Field := 1 to Length(FieldOrder) do begin
- if StringList.Count > 0 then
- S := StringList[0]
- else
- S := '';
-
- case FieldOrder[Field] of
- 'M' :
- begin
- if (S = '') or (S[1] in ['0'..'9']) then begin
- {numeric month}
- try
- if S = '' then
- Month := 0
- else
- Month := StrToInt(S);
- except
- Month := 0;
- {error converting month number}
- Error := SCMonthConvertError;
- end;
- if not (Month in [1..12]) then
- Month := 0;
- end else begin
- {one or more letters in month}
- Month := 0;
- I1 := 1;
- S := Copy(S, 1, 3);
- {error converting month name}
- Error := SCMonthNameConvertError;
- repeat
- if S = AnsiUpperCase(Copy(ShortMonthNames[I1], 1, Length(S))) then begin
- Month := I1;
- I1 := 13;
- Error := 0;
- end else
- Inc(I1);
- until I1 = 13;
- end;
-
- if Month = 0 then begin
- if rfMonth in FRequiredFields then
- {month required}
- Error := SCMonthRequired
- else
- Month := ThisMonth;
- end else if StringList.Count > 0 then
- StringList.Delete(0);
-
- if Error > 0 then
- Break;
- end;
- 'Y' :
- begin
- try
- if S = '' then
- Year := 0
- else
- Year := StrToInt(S);
- except
- Year := 0;
- {error converting year}
- Error := SCYearConvertError;
- end;
- if (Epoch = 0) and (Year < 100) and (S <> '') then
- {default to current century if Epoch is zero}
- Year := Year + (ThisYear div 100 * 100)
- else if (Epoch > 0) and (Year < 100) and (S <> '') then begin
- {use epoch}
- EpochYear := Epoch mod 100;
- EpochCent := (Epoch div 100) * 100;
- if (Year < EpochYear) then
- Inc(Year,EpochCent+100)
- else
- Inc(Year,EpochCent);
- end;
- if Year = 0 then begin
- if rfYear in FRequiredFields then
- {year is required}
- Error := SCYearRequired
- else
- Year := ThisYear;
- end else if StringList.Count > 0 then
- StringList.Delete(0);
- if Error > 0 then
- Break;
- end;
- 'D' :
- begin
- try
- if S = '' then
- Day := 0
- else
- Day := StrToInt(S);
- except
- Day := 0;
- {error converting day}
- Error := SCDayConvertError;
- end;
- if not (Day in [1..31]) then
- Day := 0;
- if Day = 0 then begin
- if rfDay in FRequiredFields then
- {day is required}
- Error := SCDayRequired
- else
- Day := ThisDay;
- end
- else if StringList.Count > 0 then
- StringList.Delete(0);
-
- if Error > 0 then
- Break;
- end;
- end;
- end;
-
- case Error of
- SCDayConvertError :
- if S = '' then
- raise EOvcException.Create(
- GetOrphStr(SCInvalidDay) + ' "' + Value + '"')
- else
- raise EOvcException.Create(
- GetOrphStr(SCInvalidDay) + ' "' + S + '"');
- SCMonthConvertError :
- if S = '' then
- raise EOvcException.Create(
- GetOrphStr(SCInvalidMonth) + ' "' + Value + '"')
- else
- raise EOvcException.Create(
- GetOrphStr(SCInvalidMonth) + ' "' + S + '"');
- SCMonthNameConvertError :
- if S = '' then
- raise EOvcException.Create(
- GetOrphStr(SCInvalidMonthName) + ' "' + Value + '"')
- else
- raise EOvcException.Create(
- GetOrphStr(SCInvalidMonthName) + ' "' + S + '"');
- SCYearConvertError :
- if S = '' then
- raise EOvcException.Create(
- GetOrphStr(SCInvalidYear) + ' "' + Value + '"')
- else
- raise EOvcException.Create(
- GetOrphStr(SCInvalidYear) + ' "' + S + '"');
- SCDayRequired :
- raise EOvcException.Create(
- GetOrphStr(SCDayRequired));
- SCMonthRequired :
- raise EOvcException.Create(
- GetOrphStr(SCMonthRequired));
- SCYearRequired :
- raise EOvcException.Create(
- GetOrphStr(SCYearRequired));
- end;
-
- try
- SetDate(STDatetoDateTime(DMYToStDate(Day, Month, Year, Epoch)));
- Text := FormatDate(FDate);
- except
- raise EOvcException.Create(
- GetOrphStr(SCInvalidDate) + ' "' + Value + '"');
- end;
-
- finally
- StringList.Free;
- end;
- end;
-end;
-
-procedure TOvcCustomDateEdit.SetEpoch(Value : Integer);
-begin
- if Value <> FEpoch then
- if (Value = 0) or ((Value >= MinYear) and (Value <= MaxYear)) then
- FEpoch := Value;
-end;
-
-procedure TOvcCustomDateEdit.SetForceCentury(Value : Boolean);
-begin
- if Value <> FForceCentury then begin
- FForceCentury := Value;
- SetDate(FCalendar.Date);
- end;
-end;
-
-procedure TOvcCustomDateEdit.SetPopupColors(Value : TOvcCalColors);
-begin
- FCalendar.Colors := Value;
-end;
-
-procedure TOvcCustomDateEdit.SetPopupDateFormat(Value : TOvcDateFormat);
-begin
- FCalendar.DateFormat := Value;
-end;
-
-procedure TOvcCustomDateEdit.SetPopupFont(Value : TFont);
-begin
- if Assigned(Value) then
- FCalendar.Font.Assign(Value);
-end;
-
-procedure TOvcCustomDateEdit.SetPopupHeight(Value : Integer);
-begin
- FCalendar.Height := Value;
-end;
-
-procedure TOvcCustomDateEdit.SetPopupDayNameWidth(Value : TOvcDayNameWidth);
-begin
- FCalendar.DayNameWidth := Value;
-end;
-
-procedure TOvcCustomDateEdit.SetPopupOptions(Value : TOvcCalDisplayOptions);
-begin
- FCalendar.Options := Value;
-end;
-
-procedure TOvcCustomDateEdit.SetPopupWidth(Value : Integer);
-begin
- FCalendar.Width := Value;
-end;
-
-procedure TOvcCustomDateEdit.SetPopupWeekStarts(Value : TOvcDayType);
-begin
- FCalendar.WeekStarts := Value;
-end;
-
-procedure TOvcCustomDateEdit.SetReadOnly(Value : Boolean);
-begin
- inherited ReadOnly := Value;
-
- FButton.Enabled := not ReadOnly;
-end;
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/f3/f336d76124bae6ac699ac11514fbb81ede720b72.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/f3/f336d76124bae6ac699ac11514fbb81ede720b72.svn-base
deleted file mode 100644
index ac9c87b4..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/f3/f336d76124bae6ac699ac11514fbb81ede720b72.svn-base
+++ /dev/null
@@ -1,34 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, ovcbase, ovcrlbl;
-
-type
- TForm1 = class(TForm)
- OvcRotatedLabel1: TOvcRotatedLabel;
- OvcRotatedLabel2: TOvcRotatedLabel;
- OvcRotatedLabel3: TOvcRotatedLabel;
- OvcRotatedLabel4: TOvcRotatedLabel;
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.dfm}
-{$ELSE}
-{$R *.lfm}
-{$ENDIF}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/f3/f3850e29a703a2df47e2f74f53500f43385662cb.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/f3/f3850e29a703a2df47e2f74f53500f43385662cb.svn-base
deleted file mode 100644
index c3a4fb7e..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/f3/f3850e29a703a2df47e2f74f53500f43385662cb.svn-base
+++ /dev/null
@@ -1,585 +0,0 @@
-{*********************************************************}
-{* OVCTCBEF.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 ovctcbef;
- {-Orpheus Table Cell - base entry field type}
-
-interface
-
-uses
- SysUtils, Classes,
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, LclType, MyMisc, {$ENDIF}
- Graphics, Controls, Forms,
- OvcBase, OvcCmd, OvcEF, OvcCaret, OvcTCmmn, OvcTCell, OvcTable, OvcTCStr;
-
-type
- TOvcTCBaseEntryField = class(TOvcTCBaseString)
- protected {private}
- FEdit : TOvcBaseEntryField;
- FEditDisplay : TOvcBaseEntryField;
-
- FOnError : TValidationErrorEvent;
- FOnUserCommand : TUserCommandEvent;
- FOnUserValidation : TUserValidationEvent;
-
- CopyOfData : pointer;
- CopyOfDataSize : Integer;
-
- protected
- function GetCaretIns : TOvcCaret;
- function GetCaretOvr : TOvcCaret;
- function GetControlCharColor : TColor;
- function GetDataSize : integer;
- function GetDecimalPlaces : byte;
- function GetOptions : TOvcEntryFieldOptions;
- function GetEFColors : TOvcEFColors;
- function GetMaxLength : word;
- function GetModified : boolean;
- function GetPadChar : AnsiChar;
- function GetPasswordChar : AnsiChar;
- function GetRangeHi : string;
- function GetRangeLo : string;
- function GetTextMargin : integer;
-
- procedure SetCaretIns(CI : TOvcCaret);
- procedure SetCaretOvr(CO : TOvcCaret);
- procedure SetControlCharColor(CCC : TColor);
- procedure SetDecimalPlaces(DP : byte);
- procedure SetEFColors(Value : TOvcEFColors);
- procedure SetMaxLength(ML : word);
- procedure SetOptions(Value : TOvcEntryFieldOptions);
- procedure SetPadChar(PC : AnsiChar);
- procedure SetPasswordChar(PC : AnsiChar);
- procedure SetRangeHi(const RI : string);
- procedure SetRangeLo(const RL : string);
- procedure SetTextMargin(TM : integer);
-
- procedure DefineProperties(Filer: TFiler); override;
-
- procedure tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer); override;
-
- {properties for entry fields, to be exposed by descendants}
- property CaretIns : TOvcCaret
- read GetCaretIns write SetCaretIns;
-
- property CaretOvr : TOvcCaret
- read GetCaretOvr write SetCaretOvr;
-
- property ControlCharColor : TColor
- read GetControlCharColor write SetControlCharColor;
-
- property DecimalPlaces : byte
- read GetDecimalPlaces write SetDecimalPlaces;
-
- property EFColors : TOvcEFColors
- read GetEFColors write SetEFColors;
-
- property MaxLength : word
- read GetMaxLength write SetMaxLength;
-
- property Options : TOvcEntryFieldOptions
- read GetOptions write SetOptions;
-
- property PadChar : AnsiChar
- read GetPadChar write SetPadChar;
-
- property PasswordChar : AnsiChar
- read GetPasswordChar write SetPasswordChar;
-
- property RangeHi : string
- read GetRangeHi write SetRangeHi
- stored false;
-
- property RangeLo : string
- read GetRangeLo write SetRangeLo
- stored false;
-
- property TextMargin : integer
- read GetTextMargin write SetTextMargin;
-
- {events}
- property OnError : TValidationErrorEvent
- read FOnError write FOnError;
-
- property OnUserCommand : TUserCommandEvent
- read FOnUserCommand write FOnUserCommand;
-
- property OnUserValidation : TUserValidationEvent
- read FOnUserValidation write FOnUserValidation;
-
- public
- constructor Create(AOwner : TComponent); override;
- destructor Destroy;
- override;
- function CreateEntryField(AOwner : TComponent) : TOvcBaseEntryField; virtual; abstract;
-
- function EditHandle : THandle; override;
- procedure EditHide; override;
- procedure EditMove(CellRect : TRect); override;
-
- function CanSaveEditedData(SaveValue : boolean) : boolean; override;
- procedure SaveEditedData(Data : pointer); override;
- procedure StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer); override;
- procedure StopEditing(SaveValue : boolean;
- Data : pointer); override;
-
- property DataSize : integer
- read GetDataSize;
-
- property Modified : boolean
- read GetModified;
-
- published
- property About;
- end;
-
-implementation
-
-uses
- Dialogs;
-
-type {for typecast to get around protected clause}
- TOvcBEF = class(TOvcBaseEntryField)
- public
- property CaretIns;
- property CaretOvr;
- property ControlCharColor;
- property DecimalPlaces;
- property EFColors;
- property MaxLength;
- property Options;
- property PadChar;
- property PasswordChar;
- property RangeHi;
- property RangeLo;
- property ShowHint;
- property TextMargin;
- end;
-
-{===TOvcTCBaseEntryField=============================================}
-constructor TOvcTCBaseEntryField.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
-
- FEdit := CreateEntryField(Self);
- FEdit.Visible := false;
-
- FEditDisplay := CreateEntryField(Self);
- FEditDisplay.Visible := false;
- end;
-
-destructor TOvcTCBaseEntryField.Destroy;
-begin
- if (CopyOfData <> nil) and (CopyOfDataSize > 0) then
- FreeMem(CopyOfData, CopyOfDataSize);
-
- inherited Destroy;
-end;
-
-{--------}
-function TOvcTCBaseEntryField.CanSaveEditedData(SaveValue : boolean) : boolean;
- begin
- Result := true;
- if Assigned(FEdit) then
- if SaveValue then
- with TOvcBEF(FEdit) do
- if Controller.ErrorPending then
- Result := false
- else
- Result := ValidateSelf
- else
- FEdit.Restore;
- end;
-{--------}
-function TOvcTCBaseEntryField.EditHandle : THandle;
- begin
- if Assigned(FEdit) then
- Result := FEdit.Handle
- else
- Result := 0;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.EditHide;
- begin
- if Assigned(FEdit) then
- with FEdit do
- begin
- SetWindowPos(FEdit.Handle, HWND_TOP,
- 0, 0, 0, 0,
- SWP_HIDEWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- end;
-
- end;
-{--------}
-procedure TOvcTCBaseEntryField.EditMove(CellRect : TRect);
- var
- EditHandle : HWND;
- begin
- if Assigned(FEdit) then
- begin
- EditHandle := FEdit.Handle;
- with CellRect do
- SetWindowPos(EditHandle, HWND_TOP,
- Left, Top, Right-Left, Bottom-Top,
- SWP_SHOWWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- InvalidateRect(EditHandle, nil, false);
- UpdateWindow(EditHandle);
-
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer);
- var
- S : ShortString;
- I : integer;
- begin
- if (Data = nil) then
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, Data)
- else
- begin
- FEditDisplay.Controller := TOvcTable(FTable).Controller;
- if (FEditDisplay.Controller = nil) then
- ShowMessage('NIL in tcPaint');
- FEditDisplay.Parent := FTable;
- SetWindowPos(FEditDisplay.Handle, HWND_TOP, 0, 0, 0, 0,
- SWP_HIDEWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- FEditDisplay.SetValue(Data^);
- S := Trim(FEditDisplay.DisplayString); // Inserted Trim
-(* TurboPower bug: this code trims string of white space, but in using I as
- index into string S doesn't check if I is in range of 1..Length(S),
- which can result in range-check error.
- I := 1;
- while (S[I] <= #32) do
- Inc(I);
- Delete(S, 1, I-1);
- I := Length(S);
- while (S[I] <= #32) do
- Dec(I);
- Delete(S, I+1, Length(S) - I);
-*)
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, @S);
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SaveEditedData(Data : pointer);
- begin
- if Assigned(Data) then
- begin
- FEdit.GetValue(CopyOfData^);
- Move(CopyOfData^, Data^, CopyOfDataSize);
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer);
- begin
- CopyOfDataSize := FEdit.DataSize;
- GetMem(CopyOfData, CopyOfDataSize);
- if (Data = nil) then
- FillChar(CopyOfData^, CopyOfDataSize, 0)
- else
- Move(Data^, CopyOfData^, CopyOfDataSize);
-
- with TOvcBEF(FEdit) do
- begin
- Parent := FTable;
- Font := CellAttr.caFont;
- Font.Color := CellAttr.caFontColor;
- Color := CellAttr.caColor;
- BorderStyle := bsNone;
- Ctl3D := false;
- case CellStyle of
- tesBorder : BorderStyle := bsSingle;
- tes3D : Ctl3D := true;
- end;{case}
- Left := CellRect.Left;
- Top := CellRect.Top;
- Width := CellRect.Right - CellRect.Left;
- Height := CellRect.Bottom - CellRect.Top;
- Hint := Self.Hint;
- ShowHint := Self.ShowHint;
- TabStop := false;
- Controller := TOvcTable(FTable).Controller;
- if (Controller = nil) then
- ShowMessage('NIL in StartEditing');
- SetValue(CopyOfData^);
- Visible := true;
-
- OnChange := Self.OnChange;
- OnClick := Self.OnClick;
- OnDblClick := Self.OnDblClick;
- OnDragDrop := Self.OnDragDrop;
- OnDragOver := Self.OnDragOver;
- OnEndDrag := Self.OnEndDrag;
- OnEnter := Self.OnEnter;
- OnError := Self.OnError;
- OnExit := Self.OnExit;
- OnKeyDown := Self.OnKeyDown;
- OnKeyPress := Self.OnKeyPress;
- OnKeyUp := Self.OnKeyUp;
- OnMouseDown := Self.OnMouseDown;
- OnMouseMove := Self.OnMouseMove;
- OnMouseUp := Self.OnMouseUp;
- OnUserCommand := Self.OnUserCommand;
- OnUserValidation := Self.OnUserValidation;
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.StopEditing(SaveValue : boolean;
- Data : pointer);
- begin
- if SaveValue and Assigned(Data) then
- begin
- FEdit.GetValue(CopyOfData^);
- Move(CopyOfData^, Data^, CopyOfDataSize);
- end;
- FreeMem(CopyOfData, CopyOfDataSize);
- CopyOfData := nil;
- CopyOfDataSize := 0;
- EditHide;
- end;
-{====================================================================}
-
-
-{===TOvcTCBaseEntryField property access=============================}
-procedure TOvcTCBaseEntryField.DefineProperties(Filer: TFiler);
- begin
- inherited DefineProperties(Filer);
- with Filer do
- begin
- DefineBinaryProperty('RangeHigh',
- TOvcBEF(FEdit).efReadRangeHi, TOvcBEF(FEdit).efWriteRangeHi, true);
- DefineBinaryProperty('RangeLow',
- TOvcBEF(FEdit).efReadRangeLo, TOvcBEF(FEdit).efWriteRangeLo, true);
- end;
- end;
-{--------}
-function TOvcTCBaseEntryField.GetOptions : TOvcEntryFieldOptions;
- begin
- if Assigned(FEdit) then
- Result := FEdit.Options
- else
- Result := [];
- end;
-function TOvcTCBaseEntryField.GetCaretIns : TOvcCaret;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).CaretIns
- else Result := nil;
- end;
-{--------}
-function TOvcTCBaseEntryField.GetCaretOvr : TOvcCaret;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).CaretOvr
- else Result := nil;
- end;
-{--------}
-function TOvcTCBaseEntryField.GetControlCharColor : TColor;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).ControlCharColor
- else Result := clRed;
- end;
-{--------}
-function TOvcTCBaseEntryField.GetDataSize : integer;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).DataSize
- else Result := 0;
- end ;
-{--------}
-function TOvcTCBaseEntryField.GetDecimalPlaces : byte;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).DecimalPlaces
- else Result := 0;
- end ;
-{--------}
-function TOvcTCBaseEntryField.GetEFColors : TOvcEFColors;
- begin
- Result := nil;
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).EFColors;
- end;
-{--------}
-function TOvcTCBaseEntryField.GetModified : boolean;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).Modified
- else Result := false;
- end ;
-{--------}
-function TOvcTCBaseEntryField.GetMaxLength : word;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).MaxLength
- else Result := 0;
- end;
-{--------}
-function TOvcTCBaseEntryField.GetPadChar : AnsiChar;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).PadChar
- else Result := ' ';
- end;
-{--------}
-function TOvcTCBaseEntryField.GetPasswordChar : AnsiChar;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).PasswordChar
- else Result := '*';
- end;
-{--------}
-function TOvcTCBaseEntryField.GetRangeHi : string;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).RangeHi
- else Result := '';
- end;
-{--------}
-function TOvcTCBaseEntryField.GetRangeLo : string;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).RangeLo
- else Result := '';
- end;
-{--------}
-function TOvcTCBaseEntryField.GetTextMargin : integer;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).TextMargin
- else Result := 0;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetCaretIns(CI : TOvcCaret);
- begin
- if Assigned(FEdit) then TOvcBEF(FEdit).CaretIns := CI;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetCaretOvr(CO : TOvcCaret);
- begin
- if Assigned(FEdit) then TOvcBEF(FEdit).CaretOvr := CO;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetControlCharColor(CCC : TColor);
- begin
- if Assigned(FEdit) then TOvcBEF(FEdit).ControlCharColor := CCC;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetDecimalPlaces(DP : byte);
- begin
- if Assigned(FEdit) then
- begin
- TOvcBEF(FEdit).DecimalPlaces := DP;
- TOvcBEF(FEditDisplay).DecimalPlaces := DP;
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetEFColors(Value : TOvcEFColors);
- begin
- if Assigned(FEdit) then
- TOvcBEF(FEdit).EFColors := Value;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetMaxLength(ML : word);
- begin
- if Assigned(FEdit) then begin
- TOvcBEF(FEdit).MaxLength := ML;
- TOvcBEF(FEditDisplay).MaxLength := ML;
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetOptions(Value : TOvcEntryFieldOptions);
- begin
- if Assigned(FEdit) then begin
- TOvcBEF(FEdit).Options := Value;
- TOvcBEF(FEditDisplay).Options := Value;
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetPadChar(PC : AnsiChar);
- begin
- if Assigned(FEdit) then
- begin
- TOvcBEF(FEdit).PadChar := PC;
- TOvcBEF(FEditDisplay).PadChar := PC;
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetPasswordChar(PC : AnsiChar);
- begin
- if Assigned(FEdit) then
- begin
- TOvcBEF(FEdit).PasswordChar := PC;
- TOvcBEF(FEditDisplay).PasswordChar := PC;
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetRangeHi(const RI : string);
- begin
- if Assigned(FEdit) then TOvcBEF(FEdit).RangeHi := RI;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetRangeLo(const RL : string);
- begin
- if Assigned(FEdit) then TOvcBEF(FEdit).RangeLo := RL;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetTextMargin(TM : integer);
- begin
- if Assigned(FEdit) then TOvcBEF(FEdit).TextMargin := TM;
- end;
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/f3/f3ebc286f071e596adb7f2e1220add3acd124483.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/f3/f3ebc286f071e596adb7f2e1220add3acd124483.svn-base
deleted file mode 100644
index 533f25a6..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/f3/f3ebc286f071e596adb7f2e1220add3acd124483.svn-base
+++ /dev/null
@@ -1,1601 +0,0 @@
-{*********************************************************}
-{* O32FLXED.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}
-{$J+} {Writable constants}
-
-unit o32flxed;
- {OvcFlexEdit and support classes - Introduced in Orpheus 4.0}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, Types, LclType, MyMisc, {$ENDIF}
- Classes, Controls, Forms, SysUtils, StdCtrls, Buttons,
- OvcData, O32Editf, OvcEF, Graphics, O32SR, O32bordr, O32Vldtr,
- O32VlOp1, o32ovldr, {$IFNDEF LCL} o32pvldr, {$ENDIF} o32rxvld, Dialogs;
-
-type
- {Forward Declaration}
- TO32CustomFlexEdit = class;
-
- TO32PopupAnchor = (paLeft, paRight);
-
-
-// TO32FlexEditDataType = (feString, feFloat, feInteger, feDateTime, feExtended,
-// feStDate, feStTime, feLogical);
-
- TO32FEButton = class(TBitBtn)
- public
- procedure Click; override;
- end;
-
- TO32feButtonClickEvent =
- procedure(Sender: TO32CustomFlexEdit; PopupPoint: TPoint) of object;
- TFEUserValidationEvent =
- procedure(Sender : TObject; var ValidEntry : Boolean) of object;
- TFEValidationErrorEvent =
- procedure(Sender : TObject; ErrorCode : Word; ErrorMsg : string) of object;
-
- TFlexEditValidatorOptions = class(TValidatorOptions)
- published
- property InputRequired;
- end;
-
- TO32EditLines = class(TPersistent)
- protected{private}
- FlexEdit : TO32CustomFlexEdit;
- FMaxLines : Integer;
- FDefaultLines : Integer;
- FFocusedLines : Integer;
- FMouseOverLines: Integer;
- procedure SetDefaultLines(Value: Integer);
- procedure SetMaxLines(Value: Integer);
- procedure SetFocusedLines(Value: Integer);
- procedure SetMouseOverLines(Value: Integer);
- public
- constructor Create; virtual;
- destructor Destroy; override;
- published
- property MaxLines: Integer read FMaxLines write SetMaxLines
- default 3;
- property DefaultLines: Integer read FDefaultLines write SetDefaultLines
- default 1;
- property FocusedLines: Integer read FFocusedLines write SetFocusedLines
- default 3;
- property MouseOverLines: Integer read FMouseOverLines write SetMouseOverLines
- default 3;
- end;
-
- TFlexEditStrings = class(TStrings)
- protected {private}
- FCapacity: Integer;
- function Get(Index: Integer): string; override;
- function GetCount: Integer; override;
- function GetTextStr: string; override;
- procedure Put(Index: Integer; const S: string); override;
- procedure SetTextStr(const Value: string); override;
- procedure SetUpdateState(Updating: Boolean); override;
-
- public
- FlexEdit: TCustomEdit;
- procedure Clear; override;
- procedure SetCapacity(NewCapacity: Integer); override;
- procedure Delete(Index: Integer); override;
- procedure Insert(Index: Integer; const S: string); override;
- end;
-
- TO32CustomFlexEdit = class(TO32CustomEdit)
- protected {private}
- FAlignment : TAlignment;
- FBorders : TO32Borders;
- FButton : TO32FEButton;
- FButtonGlyph : TBitmap;
- FCanvas : TControlCanvas;
-// FDataType : TO32FlexEditDataType;
- FEditLines : TO32EditLines;
- FEFColors : TOvcEFColors;
- FDisplayedLines : Integer;
- FMaxLines : Integer;
- FStrings : TFlexEditStrings;
-// FPasswordChar : Char;
- FPopupAnchor : TO32PopupAnchor;
- FShowButton : Boolean;
- FWordWrap : Boolean;
- FWantReturns : Boolean;
- FWantTabs : Boolean;
- FMouseInControl : Boolean;
- FValidation : TFlexEditValidatorOptions;
- FValidator : TO32BaseValidator;
- FValidationError : Integer;
-
- FOnButtonClick : TO32feButtonClickEvent;
- FOnUserValidation : TFEUserValidationEvent;
- FOnValidationError: TFEValidationErrorEvent;
- FBeforeValidation : TNotifyEvent;
- FAfterValidation : TNotifyEvent;
-
- {Internal Variables}
- FSaveEdit : String; {saved copy of edit string}
- FCreating : Boolean;
-
- FColor : TColor;
- FFontColor : TColor;
-
- FUpdating : Integer;
- feValid : Boolean;
-
-
- {Property Methods}
- function GetButtonGlyph : TBitmap;
- procedure SetButtonGlyph(Value : TBitmap);
- procedure SetShowButton (Value : Boolean);
- function GetBoolean : Boolean;
- function GetYesNo : Boolean;
- function GetDateTime : TDateTime;
- function GetDouble : Double;
- function GetExtended : Extended;
- function GetInteger : Integer;
- function GetStrings : TStrings;
- function GetVariant : Variant;
- function GetText : String;
- function GetColor : TColor; virtual;
-
- procedure SetBoolean (Value : Boolean);
- procedure SetYesNo (Value : Boolean);
- procedure SetDateTime (Value : TDateTime);
-// procedure SetDataType (Value : TO32FlexEditDataType);
- procedure SetDouble (Value : Double);
- procedure SetExtended (Value : Extended);
- procedure SetInteger (Value : Integer);
- procedure SetStrings (Value : TStrings);
- procedure SetVariant (Value : Variant);
- procedure SetDisplayedLines(Value : Integer);
- procedure SetWordWrap (Value : Boolean);
- procedure SetWantReturns (Value : Boolean);
- procedure SetWantTabs (Value : Boolean);
- procedure SetText (const Value : String);
- procedure SetColor (Value : TColor); virtual;
-
- {Message Handlers}
- procedure WMGetDlgCode (var Message : TWMGetDlgCode); message WM_GETDLGCODE;
- procedure CMMouseEnter (var Message : TMessage); message CM_MOUSEENTER;
- procedure CMMouseLeave (var Message : TMessage); message CM_MOUSELEAVE;
-{$IFNDEF LCL}
- procedure CMGotFocus (var Message : TMessage); message WM_SETFOCUS;
- procedure CMLostFocus (var Message : TMessage); message WM_KILLFOCUS;
-{$ELSE}
- procedure CMGotFocus (var Message : TLMSetFocus); message WM_SETFOCUS;
- procedure CMLostFocus (var Message : TLMKillFocus); message WM_KILLFOCUS;
-{$ENDIF}
-
- { - added}
- procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
-
- procedure WMNCPaint (var Message : TWMNCPaint); message WM_NCPAINT;
-
-{ - was commented out in 4.02 and re-written in 4.06}
- procedure WMPaint (var Message : TWMPaint); message WM_PAINT;
-
- procedure OMValidate (var Message : TMessage); message OM_VALIDATE;
- procedure OMRecreateWnd(var Message : TMessage); message OM_RECREATEWND;
-
- {Internal Methods}
- procedure KeyPress(var Key: Char); override;
- procedure CreateParams(var Params : TCreateParams); override;
- procedure SetParent(Value: TWinControl); override;
- procedure CreateWnd; override;
-{$IFNDEF LCL}
- procedure CreateWindowHandle(const Params: TCreateParams); override;
-{$ENDIF}
- procedure AdjustHeight;
- procedure GlyphChanged; dynamic;
- procedure Loaded; override;
- procedure SetAlignment(Value: TAlignment);
- function MultiLineEnabled: Boolean;
- function GetButtonWidth : Integer;
- function GetButtonEnabled : Boolean; dynamic;
- procedure SetMaxLines(Value: Integer);
- function ValidateSelf: Boolean; virtual;
- procedure SaveEditString;
-
- procedure DoOnChange; virtual;
-
-{$IFDEF LCL}
- function ChildClassAllowed(ChildClass: TClass): Boolean; override;
-{$ENDIF}
-
- public
- constructor Create(AOwner : TComponent); override;
- destructor Destroy; override;
-
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
- procedure ButtonClick; dynamic;
- procedure Restore; virtual;
-
- procedure BeginUpdate;
- procedure EndUpdate;
-
- {properties}
- property Alignment: TAlignment
- read FAlignment write SetAlignment default taLeftJustify;
-// property DataType: TO32FlexEditDataType
-// read FDataType write SetDataType default feString;
- property Borders: TO32Borders
- read FBorders write FBorders;
- property Color: TColor
- read GetColor write SetColor default clWindow;
- property EfColors: TOvcEfColors
- read FEFColors write FEFColors;
- property EditLines: TO32EditLines
- read FEditLines write FEditLines;
-// property PasswordChar: char
-// read FPasswordChar write SetPwdChar;
- property PopupAnchor : TO32PopupAnchor
- read FPopupAnchor write FPopupAnchor;
- property ShowButton : Boolean
- read FShowButton write SetShowButton;
- property Validation: TFlexEditValidatorOptions
- read FValidation write FValidation;
- property WantReturns: Boolean
- read FWantReturns write SetWantReturns default False;
- property WantTabs: Boolean
- read FWantTabs write SetWantTabs default False;
- property WordWrap: Boolean
- read FWordWrap write SetWordWrap default False;
- property Text: String
- read GetText write SetText;
- property Strings: TStrings
- read GetStrings write SetStrings;
-
- property AsBoolean: Boolean
- read GetBoolean write SetBoolean;
- property AsYesNo: Boolean
- read GetYesNo write SetYesNo;
- property AsDateTime: TDateTime
- read GetDateTime write SetDateTime;
- property AsFloat: Double
- read GetDouble write SetDouble;
- property AsExtended: Extended
- read GetExtended write SetExtended;
- property AsInteger: Integer
- read GetInteger write SetInteger;
- property AsVariant: Variant
- read GetVariant write SetVariant;
- property ButtonGlyph : TBitmap
- read GetButtonGlyph write SetButtonGlyph;
- property Canvas :TControlCanvas
- read FCanvas;
- property OnButtonClick : TO32feButtonClickEvent
- read FOnButtonClick write FOnButtonClick;
- property OnUserValidation: TFEUserValidationEvent
- read FOnUserValidation write FOnUserValidation;
- property OnValidationError: TFEValidationErrorEvent
- read FOnValidationError write FOnValidationError;
- property BeforeValidation : TNotifyEvent
- read FBeforeValidation write FBeforeValidation;
- property AfterValidation : TNotifyEvent
- read FAfterValidation write FAfterValidation;
- end;
-
- {O32FlexEdit}
- TO32FlexEdit = class(TO32CustomFlexEdit)
- published
- {$IFDEF VERSION4}
- property Alignment;
- property Anchors;
-{$IFNDEF LCL}
- property BiDiMode;
- property ParentBiDiMode;
-{$ENDIF}
- property DragKind;
- property DragMode;
- property OnEndDock;
- property OnStartDock;
- {$ENDIF}
- property AutoSize default False;
- property About;
-{$IFNDEF LCL}
- property AutoSelect; // Added recently to LCL, but leave out for now
-{$ENDIF}
- property Borders;
- property ButtonGlyph;
- property CharCase;
- property Color;
- property Cursor;
- property DragCursor;
- property EditLines;
- property EfColors;
- property Enabled;
- property Font;
-{$IFNDEF LCL}
- property HideSelection;
- property ImeMode;
- property ImeName;
-{$ENDIF}
- property LabelInfo;
- property MaxLength;
-{$IFNDEF LCL}
- property OEMConvert;
-{$ENDIF}
- property ParentFont;
- property ParentShowHint;
- property PasswordChar;
- property PopupAnchor default paLeft;
- property PopupMenu;
- property ReadOnly;
- property ShowButton default False;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property Text;
- property Validation;
- property Visible;
- property WantReturns;
- property WantTabs;
- property WordWrap;
-
- property AfterValidation;
- property BeforeValidation;
- property OnButtonClick;
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDrag;
- property OnUserValidation;
- property OnValidationError;
- end;
-
-implementation
-
-// The optional button inside a TO32FlexEdit originally did not work with LCL,
-// so excluded all button-related code.
-// Note now seems to work with win32 and carbon as of 0.9.28. To enable,
-// delete the dot in the two DEFINE's.
-// For more information, see Lazarus bug 7097.
-{$IFNDEF LCL}
- {$DEFINE ButtonOkay}
-{$ELSE}
- {.$DEFINE ButtonOkay}
- {$IFNDEF MSWINDOWS}
- {.$DEFINE ButtonNotChild} //Manually reposition relative to edit control
- {$ENDIF}
-{$ENDIF}
-
-{===== TO32FEButton ==================================================}
-
-procedure TO32FEButton.Click;
-begin
- TO32FlexEdit(Parent).SetFocus;
- TO32FlexEdit(Parent).ButtonClick;
-end;
-
-{===== TO32EditLines =================================================}
-
-constructor TO32EditLines.Create;
-begin
- inherited Create;
- FMaxLines := 3{1};
- FFocusedLines := 3{1};
- FMouseOverLines := 3{1};
- FDefaultLines := 1;
-end;
-{=====}
-
-destructor TO32EditLines.Destroy;
-begin
- inherited Destroy;
-end;
-{=====}
-
-procedure TO32EditLines.SetDefaultLines(Value: Integer);
-begin
- if FDefaultLines <> Value then
- FDefaultLines := Value;
- if FDefaultLines > FMaxLines then
- FDefaultLines := FMaxLines;
-end;
-{=====}
-
-procedure TO32EditLines.SetMaxLines(Value: Integer);
-begin
- if FMaxLines <> Value then begin
- FMaxLines := Value;
- TO32CustomFlexEdit(FlexEdit).SetMaxLines(FMaxLines);
- end;
-end;
-{=====}
-
-procedure TO32EditLines.SetFocusedLines(Value: Integer);
-begin
- if FFocusedLines <> Value then
- FFocusedLines := Value;
- if FFocusedLines > FMaxLines then
- FFocusedLines := FMaxLines;
-end;
-{=====}
-
-procedure TO32EditLines.SetMouseOverLines(Value: Integer);
-begin
- if FMouseOverLines <> Value then
- FMouseOverLines := Value;
- if FMouseOverLines > FMaxLines then
- FMouseOverLines := FMaxLines;
-end;
-
-
-{===== TFlexEditStrings ==============================================}
-
-function TFlexEditStrings.GetCount: Integer;
-begin
- Result := 0;
- if FlexEdit.HandleAllocated then
- begin
- Result := SendMessage(FlexEdit.Handle, EM_GETLINECOUNT, 0, 0);
- if SendMessage(FlexEdit.Handle, EM_LINELENGTH, SendMessage(FlexEdit.Handle,
- EM_LINEINDEX, Result - 1, 0), 0) = 0 then Dec(Result);
- end;
-end;
-{=====}
-
-function TFlexEditStrings.Get(Index: Integer): string;
-var
- Text: array[0..4095] of Char;
-begin
- Word((@Text)^) := SizeOf(Text);
- SetString(Result, Text, SendMessage(FlexEdit.Handle, EM_GETLINE, Index,
- Longint(@Text)));
-end;
-{=====}
-
-procedure TFlexEditStrings.Put(Index: Integer; const S: string);
-var
- SelStart: Integer;
-begin
- SelStart := SendMessage(FlexEdit.Handle, EM_LINEINDEX, Index, 0);
- if SelStart >= 0 then
- begin
- SendMessage(FlexEdit.Handle, EM_SETSEL, SelStart, SelStart +
- SendMessage(FlexEdit.Handle, EM_LINELENGTH, SelStart, 0));
- SendMessage(FlexEdit.Handle, EM_REPLACESEL, 0, Longint(PChar(S)));
- end;
-end;
-{=====}
-
-procedure TFlexEditStrings.Insert(Index: Integer; const S: string);
-var
- SelStart, LineLen: Integer;
- Line: string;
-begin
- if Count = FCapacity then exit;
-
- if Index >= 0 then
- begin
- SelStart := SendMessage(FlexEdit.Handle, EM_LINEINDEX, Index, 0);
- if SelStart >= 0 then Line := S + #13#10 else
- begin
- SelStart := SendMessage(FlexEdit.Handle, EM_LINEINDEX, Index - 1, 0);
- if SelStart < 0 then Exit;
- LineLen := SendMessage(FlexEdit.Handle, EM_LINELENGTH, SelStart, 0);
- if LineLen = 0 then Exit;
- Inc(SelStart, LineLen);
- Line := #13#10 + s;
- end;
- SendMessage(FlexEdit.Handle, EM_SETSEL, SelStart, SelStart);
- SendMessage(FlexEdit.Handle, EM_REPLACESEL, 0, Longint(PChar(Line)));
- end;
-end;
-{=====}
-
-procedure TFlexEditStrings.Delete(Index: Integer);
-const
- Empty: PChar = '';
-var
- SelStart, SelEnd: Integer;
-begin
- SelStart := SendMessage(FlexEdit.Handle, EM_LINEINDEX, Index, 0);
- if SelStart >= 0 then
- begin
- SelEnd := SendMessage(FlexEdit.Handle, EM_LINEINDEX, Index + 1, 0);
- if SelEnd < 0 then SelEnd := SelStart +
- SendMessage(FlexEdit.Handle, EM_LINELENGTH, SelStart, 0);
- SendMessage(FlexEdit.Handle, EM_SETSEL, SelStart, SelEnd);
- SendMessage(FlexEdit.Handle, EM_REPLACESEL, 0, Longint(Empty));
- end;
-end;
-{=====}
-
-procedure TFlexEditStrings.Clear;
-begin
- FlexEdit.Clear;
-end;
-{=====}
-
-procedure TFlexEditStrings.SetUpdateState(Updating: Boolean);
-begin
- if FlexEdit.HandleAllocated then
- begin
- SendMessage(FlexEdit.Handle, WM_SETREDRAW, Ord(not Updating), 0);
- if not Updating then
- begin // WM_SETREDRAW causes visibility side effects in memo controls
- FlexEdit.Perform(CM_SHOWINGCHANGED,0,0); // This reasserts the visibility we want
- FlexEdit.Refresh;
- end;
- end;
-end;
-{=====}
-
-function TFlexEditStrings.GetTextStr: string;
-begin
- Result := FlexEdit.Text;
-end;
-{=====}
-
-procedure TFlexEditStrings.SetCapacity(NewCapacity: Integer);
-begin
- {Sets line-limit and destructively removes any lines that exceed the limit.}
- if FCapacity <> NewCapacity then begin
- FCapacity := NewCapacity;
- while Count > FCapacity do Delete(FCapacity);
- end;
-end;
-{=====}
-
-procedure TFlexEditStrings.SetTextStr(const Value: string);
-var
- NewText: string;
-begin
- NewText := AdjustLineBreaks(Value);
- if (Length(NewText) <> FlexEdit.GetTextLen) or (NewText <> FlexEdit.Text) then
- begin
-{$IFNDEF LCL}
- if SendMessage(FlexEdit.Handle, WM_SETTEXT, 0, Longint(NewText)) = 0 then
- raise EInvalidOperation.Create(RSTooManyBytes);
- FlexEdit.Perform(CM_TEXTCHANGED, 0, 0);
-{$ELSE} //Previous SendMessage always returns 0 (error) with LCL
- FlexEdit.SetTextBuf(PAnsiChar(NewText));
-{$ENDIF}
- end;
-end;
-
-{===== TO32CustomFlexEdit ============================================}
-
-constructor TO32CustomFlexEdit.Create(AOwner : TComponent);
-begin
- FCreating := True;
-
- inherited Create(AOwner);
-
- FWordWrap := False;
- FWantReturns := False;
- FWantTabs := False;
- Width := 185;
- AutoSize := False;
-
- {create support classes}
- FCanvas := TControlCanvas.Create;
- TControlCanvas(FCanvas).Control := Self;
-
- feValid := true;
- FShowButton := False;
-{$IFDEF ButtonOkay}
- FButton := TO32FEButton.Create(Self);
- FButton.Visible := True;
- FButton.Parent := Self;
- FButton.Caption := '';
- FButton.TabStop := False;
- {$IFNDEF LCL}
- FButton.Style := bsNew;
- {$ENDIF}
-{$ENDIF}
-
- FButtonGlyph := TBitmap.Create;
-
- FBorders := TO32Borders.Create(Self);
-
- FEFColors := TOvcEfColors.Create;
-
- FStrings := TFlexEditStrings.Create;
- TFlexEditStrings(FStrings).FlexEdit := Self;
-
- FEditLines := TO32EditLines.Create;
- TO32EditLines(FEditLines).FlexEdit := self;
-
- { now set in TO32EditLines.Create:
- EditLines.MaxLines := 3;
- EditLines.DefaultLines := 1;
- EditLines.FocusedLines := 3;
- EditLines.MouseOverLines := 3;
- }
-
- FDisplayedLines := FEditLines.FDefaultLines;
- TFlexEditStrings(FStrings).Capacity := FMaxLines;
-
- FMouseInControl := false;
-
- FSaveEdit := '';
-
- Height := 80;
- AdjustHeight;
-
- Validation := TFlexEditValidatorOptions.Create(self);
- FColor := Color;
- FFontColor := Font.Color;
- FCreating := False;
-end;
-{=====}
-
-destructor TO32CustomFlexEdit.Destroy;
-begin
- {Free support classes}
-{$IFDEF ButtonOkay}
- FButton.Free;
-{$ENDIF}
- FEFColors.Free;
- FEditLines.Free;
- FStrings.Free;
- FButtonGlyph.Free;
- FCanvas.Free;
- FBorders.Free;
- FValidation.Free;
-
- inherited Destroy;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.CreateParams(var Params: TCreateParams);
-const
- Passwords: array[Boolean] of DWORD = (0, ES_PASSWORD);
- Alignments: array[Boolean, TAlignment] of DWORD =
- ((ES_LEFT, ES_RIGHT, ES_CENTER),(ES_RIGHT, ES_LEFT, ES_CENTER));
- WordWraps: array[Boolean] of DWORD = (0, ES_AUTOHSCROLL);
-begin
- inherited CreateParams(Params);
- with Params do
- begin
- { - begin}
- if MultilineEnabled then
- Style := Style and not WordWraps[FWordWrap] or ES_MULTILINE
- {$IFDEF VERSION4}
-{$IFNDEF LCL}
- or Alignments[UseRightToLeftAlignment, FAlignment]
-{$ELSE}
- or Alignments[False, FAlignment]
-{$ENDIF}
- {$ENDIF}
- or WS_CLIPCHILDREN
- else
- Style := Style and not WordWraps[FWordWrap]
- or Passwords[PasswordChar <> #0]
- {$IFDEF VERSION4}
-{$IFNDEF LCL}
- or Alignments[UseRightToLeftAlignment, FAlignment]
-{$ELSE}
- or Alignments[False, FAlignment]
-{$ENDIF}
- {$ENDIF}
- or WS_CLIPCHILDREN
- { - end}
- end;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetParent(Value: TWinControl);
-begin
- inherited;
- {$IFNDEF VERSION4}
- {$IFDEF CBuilder}
- HandleNeeded; {BCB3 needs a handle here}
- {$ENDIF}
- {$ENDIF}
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
-begin
- inherited;
- if FWantTabs then Message.Result := Message.Result or DLGC_WANTTAB
- else Message.Result := Message.Result and not DLGC_WANTTAB;
- if not FWantReturns then
- Message.Result := Message.Result and not DLGC_WANTALLKEYS;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.WMNCPaint(var Message: TWMNCPaint);
-var
- DC: HDC;
-begin
- if (FUpdating > 0) then exit;
-
- inherited;
-
- if Borders.Active then begin
- DC := GetWindowDC(Handle);
- FCanvas.Handle := DC;
- try
- FBorders.DrawBorders(FCanvas, Color);
- finally
- FCanvas.Handle := 0;
- ReleaseDC( Handle, DC );
- end;
- Message.Result := 0;
- end;
-end;
-{=====}
-
-{WMPaint had been completely commented out in 4.02. It is now }
-{ re introduced as follows.... }
-{ - Re-written}
-procedure TO32CustomFlexEdit.WMPaint(var Message: TWMPaint);
-begin
- { known limitation, The ancestor is overriding the font color when the }
- { control is disabled }
- if not Enabled then begin
- inherited Color := efColors.Disabled.BackColor;
- Font.Color := efColors.Disabled.TextColor;
- end else begin
- if feValid then begin
- inherited Color := FColor;
- Font.Color := FFontColor;
- end else if Validation.SoftValidation then begin
- inherited Color := EFColors.Error.BackColor;
- Font.Color := EFColors.Error.TextColor;
- end;
- end;
- inherited;
-end;
-
-{ - Not necessary }
-(*
-procedure TO32CustomFlexEdit.WMPaint(var Message: TWMPaint);
-var
- Rct: TRect;
- Str: string;
- DC: HDC;
- PS: TPaintStruct;
-begin
- if (FUpdating > 0) then exit;
-
- if ((FAlignment = taLeftJustify ) or Focused)
- and not (csPaintCopy in ControlState)
- then inherited
- else begin
- DC := Message.DC;
- if DC = 0 then DC := BeginPaint(Handle, PS);
- FCanvas.Handle := DC;
- try
- if (FAlignment = taRightJustify) then begin
- FCanvas.Font := Font;
- with FCanvas do begin
- Rct := ClientRect;
- Brush.Color := Color;
- Str := Text;
- TextRect(Rct, Rct.Right - TextWidth(Str) - 2, 2, Str);
- end;
- end;
- finally
- FCanvas.Handle := 0;
- if Message.DC = 0 then EndPaint( Handle, PS );
- end;
- end;
-end;
-{=====}
-*)
-
-procedure TO32CustomFlexEdit.OMValidate (var Message : TMessage);
-begin
- if not ValidateSelf then begin
- if Assigned(FOnValidationError) then
-// TurboPower bug: With vtUser, FValidator is nil here.
-// FOnValidationError(Self, FValidator.ErrorCode, 'Invalid input');
- FOnValidationError(Self, FValidationError, 'Invalid input'); //Fixed
- Message.Result := FValidationError;
- if (Validation.ValidationEvent = veOnChange) then begin
- Validation.BeginUpdate;
- Restore;
- Validation.EndUpdate;
- end;
- end else begin
- Message.Result := 0;
- end;
-end;
-{=====}
-
-function TO32CustomFlexEdit.ValidateSelf: Boolean;
-begin
- result := true;
- if (FUpdating > 0) then exit;
-
- case Validation.ValidationType of
-
- vtNone: begin
- {User can specify that the field be non-empty even if he is specifying no
- custom validation}
- if Validation.InputRequired and (Text = '') then
- result := false;
- exit;
- end;
-
- vtUser: begin
- if (Text = '') then begin
- if Validation.InputRequired then
- result := false
- else
- result := true;
- end; { else } //Commented out; otherwise our validation handler never
- // gets called if Text is blank - TurboPower bug?.
- if Assigned(FOnUserValidation) then
- FOnUserValidation(Self, result);
-
- if not Result then
- FValidationError := 1;
- end; {vtUser}
-
- vtValidator: begin
-
- if (text = '') then begin
- if Validation.InputRequired then begin
- {Fail Validation for an empty, required field}
- result := false;
- FValidationError := 1;
- end else begin
- {Pass validation for a non-required, empty field}
- result := true;
- FValidationError := 0;
- end;
- end
-
- else if Validation.Mask = '' then begin
- result := true;
- FValidationError := 0;
- exit;
- end
-
- else if FValidation.ValidatorClass = nil then begin
- result := false;
- raise(Exception.Create('Error: Unknown validator Class.'));
- end
-
- else begin
- FValidator := FValidation.ValidatorClass.Create(Self);
- try
- FValidator.Mask := Validation.Mask;
- FValidator.Input := Text;
-
- if Assigned(FBeforeValidation) then
- FBeforeValidation(self);
-
- result := FValidator.IsValid;
- FValidationError := FValidator.ErrorCode;
-
- if Assigned(FAfterValidation) then
- FAfterValidation(self);
-
- finally
- FValidator.Free;
- end; {try}
- end; {if}
- end; {VtValidator}
-
- end; {case}
-
-{ - begin}
- feValid := result;
- if result then
- SaveEditString
- else
- if Validation.BeepOnError then
- MessageBeep(0);
-
- { Invalidate; } { !!.04 - Commented out - Causes flicker } {!!!!}
-{ - end}
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.OMRecreateWnd(var Message : TMessage);
-begin
- if (FUpdating > 0) then exit;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.CMMouseEnter(var Message : TMessage);
-begin
- inherited;
- if Enabled and MultiLineEnabled and (not FMouseInControl)
- and (not Focused) then begin
- if FDisplayedLines <> FEditLines.FMouseOverLines then begin
- SetDisplayedLines(FEditLines.FMouseOverLines);
- AdjustHeight;
- end;
- end;
- FMouseInControl := True;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.CMMouseLeave(var Message : TMessage);
-begin
- inherited;
-{$IFDEF ButtonOkay}
- if FButton.Focused then exit;
-{$ENDIF}
- if Enabled and FMouseInControl and MultiLineEnabled then begin
- if (Focused) then begin
- if FDisplayedLines <> FEditLines.FocusedLines then
- SetDisplayedLines(FEditLines.FocusedLines);
- end else begin
- if FDisplayedLines <> FEditLines.DefaultLines then
- SetDisplayedLines(FEditLines.DefaultLines);
- end;
- AdjustHeight;
- end;
- FMouseInControl := False;
-end;
-{=====}
-
-{$IFNDEF LCL}
-procedure TO32CustomFlexEdit.CMGotFocus(var Message : TMessage);
-{$ELSE}
-procedure TO32CustomFlexEdit.CMGotFocus(var Message : TLMSetFocus);
-{$ENDIF}
-begin
- inherited;
- if Enabled and MultiLineEnabled then begin
- if FDisplayedLines <> FEditLines.FocusedLines then begin
- SetDisplayedLines(FEditLines.FocusedLines);
- AdjustHeight;
- end;
- end;
-{$IFNDEF LCL} // AutoSelect is False by default in LCL TEdit
- if AutoSelect then
- SelectAll;
-{$ENDIF}
- SaveEditString;
-end;
-{=====}
-
-{$IFNDEF LCL}
-procedure TO32CustomFlexEdit.CMLostFocus(var Message : TMessage);
-{$ELSE}
-procedure TO32CustomFlexEdit.CMLostFocus(var Message : TLMKillFocus);
-{$ENDIF}
-begin
- inherited;
- if Enabled and MultiLineEnabled then begin
- if FMouseInControl then begin
- if FDisplayedLines <> FEditLines.MouseOverLines then
- SetDisplayedLines(FEditLines.MouseOverLines);
- end else begin
- if FDisplayedLines <> FEditLines.DefaultLines then
- SetDisplayedLines(FEditLines.DefaultLines);
- end;
- AdjustHeight;
- end;
-end;
-{=====}
-
-{ - added}
-procedure TO32CustomFlexEdit.CMFontChanged(var Message: TMessage);
-begin
- inherited;
- AdjustHeight;
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetText: String;
-begin
- result := FStrings.Text;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetText(const Value: String);
-var
- buffer: String;
- i : Integer;
-begin
- buffer := Value;
-
- if buffer <> '' then begin
- if not MultiLineEnabled then
- {strip out cr and lf's}
-// for i := Length(buffer) downto 0 do <== TurboPower bug!
- for i := Length(buffer) downto 1 do
- if (buffer[i] = #13) or (buffer[i] = #10) then begin
- Delete(buffer, i, 1);
- if ((buffer[i - 1] <> ' ') and (buffer[i - 1] <> #10)
- and (buffer[i - 1] <> #13))and (buffer[i] <> ' ') then
- Insert(' ', buffer, i);
- end;
- end;
-
- FStrings.Text := buffer;
-
- SetTextBuf(PAnsiChar(buffer));
-
- if Borders.Active then Borders.RedrawControl;
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetColor: TColor;
-begin
- Result := inherited Color;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetColor( Value: TColor );
-begin
- if Color <> Value then begin
- inherited Color := Value;
- FColor := Value;
- if Borders.Active then Borders.RedrawControl;
- end;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.KeyPress(var Key: Char);
-begin
- inherited KeyPress(Key);
- if (Key = Char(VK_RETURN)) then
- if not FWantReturns then
- Key := #0
- else begin
- if TFlexEditStrings(FStrings).Count >= FMaxLines then
- Key := #0;
- end;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.CreateWnd;
-begin
- if (FUpdating > 0) then exit;
-
- inherited CreateWnd;
-
- {force button placement}
- SetBounds(Left, Top, Width, Height);
-
-{$IFDEF ButtonOkay}
- FButton.Enabled := GetButtonEnabled;
-{$ENDIF}
- AdjustHeight;
-
- if Validation <> nil then
- Validation.AttachTo(Self);
-end;
-
-{$IFNDEF LCL} //With LCL, will never be called since not in ancestor
-procedure TO32CustomFlexEdit.CreateWindowHandle(const Params: TCreateParams);
-begin
- if (FUpdating > 0) then exit;
-
- if not HandleAllocated then begin
- if (csDesigning in ComponentState) then
- inherited
- else begin
- with Params do
- WindowHandle := CreateWindowEx(ExStyle, WinClassName, '', Style,
- X, Y, Width, Height, WndParent, 0, WindowClass.HInstance,
- Param);
- SendMessage(WindowHandle, WM_SETTEXT, 0, Longint(Caption));
- end;
- end;
-end;
-{$ENDIF}
-{=====}
-
-procedure TO32CustomFlexEdit.AdjustHeight;
-var
- DC: HDC;
- SaveFont: HFont;
- I: Integer;
- SysMetrics, Metrics: TTextMetric;
- Str: String;
-begin
- if (FUpdating > 0) then exit;
-
- if FCreating then exit;
-
- DC := GetDC(0);
- GetTextMetrics(DC, SysMetrics);
- SaveFont := SelectObject(DC, Font.Handle);
- GetTextMetrics(DC, Metrics);
- SelectObject(DC, SaveFont);
- ReleaseDC(0, DC);
- if NewStyleControls then
- begin
- if Ctl3D then I := 8 else I := 6;
- I := GetSystemMetrics(SM_CYBORDER) * I;
- end else
- begin
- I := SysMetrics.tmHeight;
- if I > Metrics.tmHeight then I := Metrics.tmHeight;
- I := I div 4 + GetSystemMetrics(SM_CYBORDER) * 4;
- end;
- Height := (Metrics.tmHeight * FDisplayedLines) + I;
- if Borders.Active and not FCreating then begin
- Str := Text;
- Borders.RedrawControl;
- Text := Str;
- end;
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetButtonEnabled : Boolean;
-begin
- result := (not ReadOnly);
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetMaxLines(Value: Integer);
-var
- buffer: String;
-begin
- if Value <> FMaxLines then begin
- FMaxLines := Value;
- TFlexEditStrings(FStrings).Capacity := FMaxLines;
- buffer := FStrings.Text;
- if buffer <> '' then
- while (buffer[Length(buffer)] = #13) or (buffer[Length(buffer)] = #10) do
- Delete(buffer, Length(buffer), 1);
- FStrings.Text := buffer;
- end;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SaveEditString;
-begin
- if (Text <> FSaveEdit) then
- FSaveEdit := Text;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.DoOnChange;
-begin
- if Assigned(OnChange) then
- OnChange(Self);
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetButtonWidth : Integer;
-begin
- if FShowButton then begin
- Result := GetSystemMetrics(SM_CXHSCROLL);
- if Assigned(FButtonGlyph) and not FButtonGlyph.Empty then
- if FButtonGlyph.Width + 4 > Result then
- Result := FButtonGlyph.Width + 4;
- end else
- Result := 0;
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetButtonGlyph : TBitmap;
-begin
- if not Assigned(FButtonGlyph) then
- FButtonGlyph := TBitmap.Create;
-
- Result := FButtonGlyph
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.GlyphChanged;
-begin
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.Loaded;
-begin
- inherited Loaded;
-
-{$IFDEF ButtonOkay}
- if Assigned(FButtonGlyph) then
- FButton.Glyph.Assign(FButtonGlyph);
-{$ENDIF}
-end;
-{=====}
-
-{ - rewritten to solve the "Text disappearing at alignment change" bug. }
-procedure TO32CustomFlexEdit.SetAlignment(Value: TAlignment);
-var
- Str: string;
-begin
-{$IFDEF LCL}
- if Value <> taLeftJustify then
- Exit; {taCenter and taRightJustify not supported and crash IDE, so ignore}
-{$ENDIF}
- if FAlignment <> Value then
- begin
- Str := Text;
- FAlignment := Value;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- Text := Str;
- end;
-end;
-{=====}
-
-function TO32CustomFlexEdit.MultiLineEnabled: Boolean;
-begin
- { The control is only multi-line able if either WordWrap or WantReturns is }
- { set and Password char is not being used }
- result := (FWantReturns or FWordWrap) and (PasswordChar = #0);
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.ButtonClick;
-var
- P: TPoint;
-begin
- if (Assigned(FOnButtonClick)) then begin
- {Get the screen coordinates of the bottom-left or bottom-right corner of
- the control.}
- if PopupAnchor = paLeft then
- P := Point(Left, Top + Height)
- else
- P := Point(Left + Width, Top + Height);
-
- {Call the user defined event handler, passing the desired popup point}
- FOnButtonClick(Self, P);
- end;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.Restore;
- {-restore the previous contents of the FlexEdit}
-var
- CursorPos: Integer;
-begin
- BeginUpdate;
- CursorPos := SelStart;
- Text := FSaveEdit;
- Repaint;
- DoOnChange;
- SelStart := CursorPos;
- EndUpdate;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.BeginUpdate;
-begin
- Inc(FUpdating);
- Validation.BeginUpdate;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.EndUpdate;
-begin
- Dec(FUpdating);
- Validation.EndUpdate;
- if (FUpdating < 0) then
- FUpdating := 0;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
-var
- CHgt : Integer;
-begin
- if (FUpdating > 0) then exit;
-
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-
- if not HandleAllocated then
- Exit;
-
-{$IFDEF ButtonOkay}
- if not FShowButton then begin
- FButton.Height := 0;
- FButton.Width := 0;
- Exit;
- end;
-
- CHgt := ClientHeight;
- if BorderStyle = bsNone then begin
- FButton.Height := CHgt;
- FButton.Width := GetButtonWidth;
- FButton.Left := Width - FButton.Width;
- FButton.Top := 0;
- end else if Ctl3D then begin
- FButton.Height := CHgt;
- FButton.Width := GetButtonWidth;
- FButton.Left := Width - FButton.Width - 4;
- FButton.Top := 0;
- end else begin
- FButton.Height := CHgt - 2;
- FButton.Width := GetButtonWidth;
-{$IFNDEF ButtonNotChild}
- FButton.Left := Width - FButton.Width - 1;
- FButton.Top := 1;
-{$ELSE}
- FButton.Left := Left + Width - FButton.Width - 1;
- FButton.Top := Top + 1;
-{$ENDIF}
- end;
-{$ENDIF}
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetButtonGlyph(Value : TBitmap);
-begin
- if not Assigned(FButtonGlyph) then
- FButtonGlyph := TBitmap.Create;
-
- if not Assigned(Value) then begin
- FButtonGlyph.Free;
- FButtonGlyph := TBitmap.Create;
- end else
- FButtonGlyph.Assign(Value);
-
- GlyphChanged;
-
-{$IFDEF ButtonOkay}
- FButton.Glyph.Assign(FButtonGlyph);
-{$ENDIF}
- SetBounds(Left, Top, Width, Height);
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetShowButton(Value : Boolean);
-begin
- if Value <> FShowButton then begin
- FShowButton := Value;
- {force resize and redisplay of button}
- SetBounds(Left, Top, Width, Height);
- end;
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetBoolean: Boolean;
-begin
- result := (AnsiUpperCase(Text) = AnsiUppercase(RSTrue));
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetYesNo: Boolean;
-begin
- result := (AnsiUpperCase(Text) = AnsiUppercase(RSYes));
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetDateTime: TDateTime;
-begin
- try
- result := StrToDateTime(Text);
- except
- result := 0;
- end;
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetDouble: Double;
-begin
- try
- result := StrToFloat(Text);
- except
- result := -1;
- end;
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetExtended: Extended;
-begin
- {Note: StrToFloat returns an Extended}
- try
- result := StrToFloat(Text);
- except
- result := -1;
- end;
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetInteger: Integer;
-begin
- result := StrToIntDef(Text, -1);
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetStrings: TStrings;
-begin
- result := TStrings(FStrings);
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetVariant: Variant;
-begin
- result := Text;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetBoolean(Value: Boolean);
-begin
- if Value then
- Text := 'True'
- else
- Text := 'False';
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetYesNo(Value: Boolean);
-begin
- if Value then
- Text := 'Yes'
- else
- Text := 'No';
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetDateTime(Value: TDateTime);
-begin
- Text := DateTimeToStr(Value);
-end;
-{=====}
-
-(*
-procedure TO32CustomFlexEdit.SetDataType(Value : TO32FlexEditDataType);
-begin
- { TODO : Implement }
-end;
-{=====}
-*)
-
-procedure TO32CustomFlexEdit.SetDouble(Value: Double);
-begin
- Text := FloatToStr(Value);
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetExtended(Value: Extended);
-begin
- Text := FloatToStr(Value);
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetInteger(Value: Integer);
-begin
- Text := IntToStr(Value);
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetStrings(Value: TStrings);
-begin
- FStrings.Assign(Value);
- Invalidate;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetVariant(Value: Variant);
-begin
- try
- Text := Value;
- except
- Text := '';
- end;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetDisplayedLines(Value: Integer);
-var
- buffer: String;
-begin
- if Value <> FDisplayedLines then begin
- buffer := Text;
- FDisplayedLines := Value;
- AdjustHeight;
- Text:= Buffer;
- end;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetWordWrap(Value: Boolean);
-var
- buffer: String;
-begin
- if Value <> FWordWrap then
- begin
- buffer := Text;
- FWordWrap := Value;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- Text:= buffer;
- end;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetWantReturns (Value : Boolean);
-var
- buffer: String;
-begin
- if Value <> FWantReturns then
- begin
- buffer := Text;
- FWantReturns := Value;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- Text:= buffer;
- end;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetWantTabs(Value : Boolean);
-var
- buffer: String;
-begin
- if Value <> FWantTabs then
- begin
- buffer := Text;
- FWantTabs := Value;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- Text:= buffer;
- end;
-end;
-
-{$IFDEF LCL}
-// Eliminates LCL "[Type1] can not have [Type2] as child" runtime message,
-// but button still doesn't work with all widgetsets. See Lazarus bug 7097.
-function TO32CustomFlexEdit.ChildClassAllowed(ChildClass: TClass): Boolean;
-begin
- Result := True;
-end;
-{$ENDIF}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/f5/f53c78301e1d5feecca3483c103cf9a2272dd32b.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/f5/f53c78301e1d5feecca3483c103cf9a2272dd32b.svn-base
deleted file mode 100644
index 5eb2d793..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/f5/f53c78301e1d5feecca3483c103cf9a2272dd32b.svn-base
+++ /dev/null
@@ -1,365 +0,0 @@
-{*********************************************************}
-{* O32OVLDR.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 ***** *}
-
-unit o32ovldr;
- {Orpheus Mask Validator}
-
-interface
-
-uses
- Classes, O32VlDtr;
-
-const
- OrpheusMaskCount = 17;
- OrpheusMaskLength = 11;
-
- { Sample Orpheus Masks }
- OrpheusMaskLookup : array [1..OrpheusMaskCount] of string =
- ('XXXXXXXXXX any character',
- '!!!!!!!!!! any char (upper)',
- 'LLLLLLLLLL any char (lower)',
- 'xxxxxxxxxx any char (mixed)',
- 'aaaaaaaaaa alphas only',
- 'AAAAAAAAAA alphas (upper)',
- 'llllllllll alphas (lower)',
- '9999999999 0-9',
- 'iiiiiiiiii 0-9, -',
- '########## 0-9, -, .',
- 'EEEEEEEEEE 0-9, E, -, .',
- 'KKKK Hexadecimal (1F3E) Allows 0-9, A-F, uppercase Alpha characters',
- 'KK Hexadecimal (FF) Allows 0-9, A-F, uppercase Alpha characters',
- 'OOOOOOOOOO 0-7 (octal)',
- 'bbbbbbbbbb 0, 1 (binary)',
- 'B T or F (upper)',
- 'Y Y or N (upper)');
-
-
- {Validation Error Codes}
- vecNotAnyOrUpperChar = 1;
- vecNotAnyOrLowerChar = 2;
- vecNotAlphaChar = 3;
- vecNotUpperAlpha = 4;
- vecNotLowerAlpha = 5;
- vecNotDS = 6;
- vecNotDSM = 9;
- vecNotDSMP = 10;
- vecNotDSMPE = 11;
- vecNotHexadecimal = 12;
- vecNotBinary = 13;
- vecNotOctal = 14;
- vecNotTrueFalse = 15;
- vecNotYesNo = 16;
-
-type
-{class - TO32OrMaskValidator}
- TO32OrMaskValidator = class(TO32BaseValidator)
- protected {private}
- FMaskBlank: Char;
-
- procedure SetInput(const Value: string); override;
- procedure SetMask(const Value: string); override;
- function GetValid: Boolean; override;
- function GetSampleMasks: TStringList; override;
- function Validate(const Value: string; var ErrorPos: Integer): Boolean;
- public
- function IsValid: Boolean; override;
- property Valid;
- property Input;
- published
- {Properties}
- property Mask;
- {Events}
- property BeforeValidation;
- property AfterValidation;
- property OnValidationError;
- end;
-
-implementation
-
-uses
- SysUtils, OvcData, O32VlReg;
-
-
-{===== TO32OrMaskValidator ===========================================}
-
-function TO32OrMaskValidator.GetSampleMasks: TStringList;
-var
- I : Integer;
-begin
- { Set the length of the mask portion of the string }
- FSampleMaskLength := OrpheusMaskLength;
-
- FSampleMasks.Clear;
-
- { Load the string list }
- for I := 1 to OrpheusMaskCount do
- FSampleMasks.Add(OrpheusMaskLookup[I]);
- result := FSampleMasks;
-end;
-{=====}
-
-function TO32OrMaskValidator.GetValid: Boolean;
-begin
- result := IsValid;
-end;
-{=====}
-
-function TO32OrMaskValidator.IsValid: Boolean;
-var
- ErrorStr: string;
- ErrorPos: Integer;
-begin
- DoBeforeValidation;
-
- {assume the worst}
- FValid := false;
-
- {Set up validation and execute it against the input}
- FValid := Validate(FInput, ErrorPos);
-
- DoAfterValidation;
-
- if not FValid then begin
- case FErrorCode of
- vecNotAnyOrUpperChar :
- ErrorStr := 'Lowercase characters not allowed in position '
- + IntToStr(ErrorPos) + '.';
- vecNotAnyOrLowerChar :
- ErrorStr := 'Uppercase characters not allowed in position '
- + IntToStr(ErrorPos) + '.';
- vecNotAlphaChar :
- ErrorStr := 'Non-Alpha characters not allowed in position '
- + IntToStr(ErrorPos) + '.';
- vecNotUpperAlpha :
- ErrorStr := 'Non-Uppercase Alpha characters not allowed in position '
- + IntToStr(ErrorPos) + '.';
- vecNotLowerAlpha :
- ErrorStr := 'Non-Lowercase Alpha characters not allowed in position '
- + IntToStr(ErrorPos) + '.';
- vecNotDS :
- ErrorStr := 'Digits and spaces only allowed in position '
- + IntToStr(ErrorPos) + '.';
- vecNotDSM :
- ErrorStr := 'Digits, spaces and ''-'' only allowed in position '
- + IntToStr(ErrorPos) + '.';
- vecNotDSMP :
- ErrorStr := 'Digits, spaces ''-'', and ''.'' only allowed in position '
- + IntToStr(ErrorPos) + '.';
- vecNotDSMPE :
- ErrorStr := 'Digits, spaces ''-'', ''.'', and ''e/E'' only allowed '
- + 'in position ' + IntToStr(ErrorPos) + '.';
- vecNotHexadecimal :
- ErrorStr := 'Hexadecimal characters only (0-F) allowed in position '
- + IntToStr(ErrorPos) + '.';
- vecNotBinary :
- ErrorStr := 'Binary characters only (0, 1, and space) allowed in '
- + 'position ' + IntToStr(ErrorPos) + '.';
- vecNotOctal :
- ErrorStr := 'Octal characters only (0-7) allowed in position '
- + IntToStr(ErrorPos) + '.';
- vecNotTrueFalse :
- ErrorStr := 'Only True/false characters (T, t, F, f) allowed in '
- + 'position ' + IntToStr(ErrorPos) + '.';
- vecNotYesNo :
- ErrorStr := 'Only Yes/No characters (Y, y, N, n) allowed in position '
- + IntToStr(ErrorPos) + '.';
- end;
- DoOnError(self, 'Invalid match at character position ' + IntToStr(ErrorPos));
- end;
- result := FValid;
-end;
-{=====}
-
-procedure TO32OrMaskValidator.SetInput(const Value: string);
-begin
- if FInput <> Value then
- FInput := Value;
-end;
-{=====}
-
-procedure TO32OrMaskValidator.SetMask(const Value: string);
-begin
- if FMask <> Value then
- FMask := Value;
-end;
-{=====}
-
-function TO32OrMaskValidator.Validate(const Value: string;
- var ErrorPos: Integer): Boolean;
-var
- I: Integer;
-begin
- ErrorPos := 0;
- result := true;
- if Length(Input) > Length(FMask) then begin
- result := false;
- ErrorPos := Length(FMask) + 1;
- exit;
- end;
-
- for I := 1 to Length(Input) do begin
- case FMask[I] of
- {pmAnyChar : 'X' allows any character}
- { do nothing here - All entry is OK.}
-
- pmForceUpper : {'!' allows any uppercase character}
- if (ord(Input[I]) in [97..122]{lowercase characters}) then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotAnyOrUpperChar;
- exit;
- end;
-
- pmForceLower : {'L' allows any lowercase character}
- if (ord(Input[I]) in [65..90]{uppercase characters}) then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotAnyOrLowerChar;
- exit;
- end;
-
- {pmForceMixed : 'x' allows any character. Just like 'X'}
- { do nothing here - All entry is ok, no way to force mixed case without }
- { back tracking }
-
- pmAlpha : {'a' allows alphas only}
- if not (ord(Input[I]) in [65..90, 97..122]{any alpha}) then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotAlphaChar;
- exit;
- end;
-
- pmUpperAlpha : {'A' allows uppercase alphas only}
- if not (ord(Input[I]) in [65..90]{uppercase alpha}) then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotUpperAlpha;
- exit;
- end;
-
- pmLowerAlpha : {'l' allows lowercase alphas only}
- if not (ord(Input[I]) in [97..122]{lowercase alpha}) then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotLowerAlpha;
- exit;
- end;
-
- pmPositive : {'9' allows numbers and spaces only}
- if not (ord(Input[I]) in [48..57, 32]) then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotDS;
- exit;
- end;
-
- pmWhole : {'i' allows numbers, spaces, minus}
- if not (ord(Input[I]) in [48..57, 32, 45]) then
- begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotDSM;
- exit;
- end;
-
- pmDecimal : {'#' allows numbers, spaces, minus, period}
- if not (ord(Input[I]) in [48..57, 32, 45, 46])
- then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotDSMP;
- exit;
- end;
-
- pmScientific : {'E' allows numbers, spaces, minus, period, 'e'}
- if not (ord(Input[I]) in [48..57, 32, 45, 46, 101, 69])
- then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotDSMPE;
- exit;
- end;
-
- pmHexadecimal : {'K' allows 0-9 and uppercase A-F}
- if not (ord(Input[I]) in [48..57, 65..70])
- then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotHexadecimal;
- exit;
- end;
-
- pmBinary : {'b' allows 0-1, space}
- if not (ord(Input[I]) in [48, 49, 32])
- then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotBinary;
- exit;
- end;
-
- pmOctal : {'O' allows 0-7, space}
- if not (ord(Input[I]) in [48..55, 32])
- then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotOctal;
- exit;
- end;
-
- pmTrueFalse : {'B' allows T, t, F, f}
- if not (ord(Input[I]) in [84, 116, 70, 102])
- then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotTrueFalse;
- exit;
- end;
-
- pmYesNo : {'Y' allows Y, y, N, n}
- if not (ord(Input[I]) in [89, 121, 78, 110])
- then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotYesNo;
- exit;
- end;
- end;
- end;
-end;
-
-
-initialization
- RegisterValidator(TO32OrMaskValidator);
-
-finalization
- UnRegisterValidator(TO32OrMaskValidator);
-
-end.
-
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/f6/f61ff333a5d92d2df7c10a688254f0351adcf82c.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/f6/f61ff333a5d92d2df7c10a688254f0351adcf82c.svn-base
deleted file mode 100644
index 473e5883..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/f6/f61ff333a5d92d2df7c10a688254f0351adcf82c.svn-base
+++ /dev/null
@@ -1,1510 +0,0 @@
-{*********************************************************}
-{* OVCBCALC.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}
-
-{$J+} {Writable constants}
-
-
-unit ovcbcalc;
- {-base edit field class w/ label and borders}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Buttons, Classes, Controls, ExtCtrls, Forms, Graphics, Menus,
- {$IFDEF VERSION4}{$IFNDEF LCL} MultiMon, {$ENDIF}{$ENDIF}
- StdCtrls, SysUtils, OvcBase, OvcVer, OvcMisc,
- OvcEditF, OvcBordr, OvcEdClc, ovcCalc, ovcEdPop;
-
-const
- BorderMsgClose = WM_USER+10;
- BorderMsgOpen = WM_USER+11;
-
-type
- TOvcPopupEvent =
- procedure(Sender : TObject) of object;
-
- TOvcPopupAnchor = (paLeft, paRight);
-
-
- TOvcBorderEdPopup = class;
-
- TOvcNumberEditEx = class(TOvcNumberEdit)
- protected
- BorderParent : TOvcBorderEdPopup;
- end;
-
- TOvcBorderEdPopup = class(TOvcBorderParent)
- protected {private}
- {new property variables}
- FEdit : TOvcCustomEdit;
- FButton : TOvcEdButton;
-
- FButtonGlyph : TBitmap;
- FController : TOvcController;
- FPopupActive : Boolean;
- FPopupAnchor : TOvcPopupAnchor;
- FOnPopupClose : TOvcPopupEvent;
- FOnPopupOpen : TOvcPopupEvent;
- FShowButton : Boolean;
-
-
- protected
- {property methods}
- function GetButtonGlyph : TBitmap;
-
- procedure SetButtonGlyph(Value : TBitmap);
- procedure SetShowButton(Value : Boolean);
-
- {internal methods}
- function GetButtonWidth : Integer;
-
-{$IFDEF VERSION4}
- procedure CMDialogKey(var Msg : TCMDialogKey);
- message CM_DIALOGKEY;
-{$ENDIF}
-
- procedure CreateParams(var Params : TCreateParams);
- override;
- procedure CreateWnd;
- override;
-
- function GetButtonEnabled : Boolean;
- dynamic;
- procedure GlyphChanged;
- dynamic;
- procedure Loaded;
- override;
-
- procedure OnMsgClose(var M : TMessage);
- message BorderMsgClose;
- procedure OnMsgOpen(var M : TMessage);
- message BorderMsgOpen;
-
- public
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
-
- procedure PopupClose(Sender : TObject);
- dynamic;
- procedure PopupOpen;
- dynamic;
-
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
- override;
-
- procedure SetEditControl(EC : TOvcCustomEdit); override;
-
- property Canvas;
-
- property PopupActive : Boolean
- read FPopupActive;
-
- property PopupAnchor : TOvcPopupAnchor
- read FPopupAnchor
- write FPopupAnchor;
-
- published
- property ButtonGlyph : TBitmap
- read GetButtonGlyph
- write SetButtonGlyph;
- end;
-
-
- TOvcBorderedNumberEdit = class(TOvcBorderEdPopup)
- protected
- {base property values}
- FOvcEdit : TOvcNumberEditEx;
-
- {$IFDEF VERSION4}
-{$IFNDEF LCL}
- FBiDiMode : TBiDiMode;
-{$ENDIF}
- FConstraints : TSizeConstraints;
- FParentBiDiMode: Boolean;
- FDragKind : TDragKind;
- {$ENDIF}
- FAbout : string;
-{$IFNDEF LCL}
- FAutoSelect : Boolean;
-{$ENDIF}
- FAutoSize : Boolean;
- FBorderStyle : TBorderStyle;
- FCharCase : TEditCharCase;
- FController : TOvcController;
- FCursor : TCursor;
- FDragCursor : TCursor;
- FDragMode : TDragMode;
- FEnabled : Boolean;
- FFont : TFont;
- FHeight : integer;
-{$IFNDEF LCL}
- FHideSelection : Boolean;
- FImeMode : TImeMode;
-{$ENDIF}
- FImeName : string;
- FMaxLength : Integer;
-{$IFNDEF LCL}
- FOEMConvert : Boolean;
-{$ENDIF}
- FParentFont : Boolean;
- FParentShowHint: Boolean;
- FPasswordChar : Char;
- FPopupMenu : TPopupMenu;
- FReadOnly : Boolean;
- FShowHint : Boolean;
- FTabOrder : TTabOrder;
- FVisible : Boolean;
- FWidth : integer;
-
- {events}
- FOnChange : TNotifyEvent;
- FOnClick : TNotifyEvent;
- FOnDblClick : TNotifyEvent;
- FOnDragDrop : TDragDropEvent;
- FOnDragOver : TDragOverEvent;
-
- FOnEndDrag : TEndDragEvent;
- FOnEnter : TNotifyEvent;
- FOnExit : TNotifyEvent;
- FOnKeyDown : TKeyEvent;
- FOnKeyPress : TKeyPressEvent;
- FOnKeyUp : TKeyEvent;
- FOnMouseDown : TMouseEvent;
- FOnMouseMove : TMouseMoveEvent;
- FOnMouseUp : TMouseEvent;
- FOnStartDrag : TStartDragEvent;
-
-
- FAllowIncDec : Boolean;
- FCalculator : TOvcCalculator;
-
- {internal variables}
- PopupClosing : Boolean;
- HoldCursor : TCursor;
- WasAutoScroll : Boolean;
-
- {base property methods}
- {$IFDEF VERSION4}
- {$IFNDEF LCL}
- function GetBiDiMode : TBiDiMode;
- {$ENDIF}
- function GetDragKind : TDragKind;
- {$IFNDEF LCL}
- function GetParentBiDiMode : Boolean;
- {$ENDIF}
-
-{$IFNDEF LCL}
- procedure SetBiDiMode(Value : TBiDiMode); override;
-{$ENDIF}
- procedure SetDragKind(Value : TDragKind);
-{$IFNDEF LCL}
- procedure SetParentBiDiMode(Value : Boolean); override;
-{$ENDIF}
- {$ENDIF}
-
- function GetAbout : string;
-{$IFNDEF LCL}
- function GetAutoSelect : Boolean;
-{$ENDIF}
- function GetAutoSize : Boolean;
- function GetCharCase : TEditCharCase;
- function GetController : TOvcController;
- function GetCursor : TCursor;
- function GetDragCursor : TCursor;
- function GetDragMode : TDragMode;
- function GetEditEnabled : Boolean;
- function GetFont : TFont;
-{$IFNDEF LCL}
- function GetHideSelection : Boolean;
- function GetImeMode : TImeMode;
- function GetImeName : string;
-{$ENDIF}
- function GetMaxLength : Integer;
-{$IFNDEF LCL}
- function GetOEMConvert : Boolean;
-{$ENDIF}
- function GetParentShowHint : Boolean;
- function GetPasswordChar : Char;
- function GetReadOnly : Boolean;
- function GetEditShowButton : Boolean;
-
- function GetParentFont : Boolean;
- function GetEditParentShowHint : Boolean;
-
- function GetOnChange : TNotifyEvent;
- function GetOnClick : TNotifyEvent;
- function GetOnDblClick : TNotifyEvent;
- function GetOnDragDrop : TDragDropEvent;
- function GetOnDragOver : TDragOverEvent;
- function GetOnEndDrag : TEndDragEvent;
- function GetOnKeyDown : TKeyEvent;
- function GetOnKeyPress : TKeyPressEvent;
- function GetOnKeyUp : TKeyEvent;
- function GetOnMouseDown: TMouseEvent;
- function GetOnMouseMove: TMouseMoveEvent;
- function GetOnMouseUp : TMouseEvent;
-
- function GetOnPopupClose : TOvcPopupEvent;
- function GetOnPopupOpen : TOvcPopupEvent;
- function GetPopupAnchor : TOvcPopupAnchor;
-
- procedure SetAbout(const Value : string);
-{$IFNDEF LCL}
- procedure SetAutoSelect(Value : Boolean);
-{$ENDIF}
- procedure SetAutoSize(Value : Boolean); {$IFDEF VERSION6}{$IFNDEF LCL} override;{$ENDIF}{$ENDIF}
- procedure SetCharCase(Value : TEditCharCase);
- procedure SetCursor(Value : TCursor);
- procedure SetDragCursor(Value : TCursor);
- procedure SetEditController(Value : TOvcController);
- procedure SetEditDragMode(Value : TDragMode);
- procedure SetEditEnabled(Value : Boolean);
- procedure SetFont(Value : TFont);
-{$IFNDEF LCL}
- procedure SetHideSelection(Value : Boolean);
- procedure SetImeMode(Value : TImeMode);
- procedure SetImeName(const Value : string);
-{$ENDIF}
- procedure SetMaxLength(Value : Integer);
-{$IFNDEF LCL}
- procedure SetOEMConvert(Value : Boolean);
-{$ENDIF}
- procedure SetParentShowHint(Value : Boolean);
- procedure SetPasswordChar(Value : Char);
- procedure SetReadOnly(Value : Boolean);
- procedure SetEditShowButton(Value : Boolean);
-
- procedure SetOnChange(Value : TNotifyEvent);
- procedure SetOnClick(Value : TNotifyEvent);
- procedure SetOnDblClick(Value : TNotifyEvent);
- procedure SetOnDragDrop(Value : TDragDropEvent);
- procedure SetOnDragOver(Value : TDragOverEvent);
- procedure SetOnEndDrag(Value : TEndDragEvent);
- procedure SetOnKeyDown(Value : TKeyEvent);
- procedure SetOnKeyPress(Value : TKeyPressEvent);
- procedure SetOnKeyUp(Value : TKeyEvent);
- procedure SetOnMouseDown(Value : TMouseEvent);
- procedure SetOnMouseMove(Value : TMouseMoveEvent);
- procedure SetOnMouseUp(Value : TMouseEvent);
-
- procedure SetOnPopupClose(Value : TOvcPopupEvent);
- procedure SetOnPopupOpen(Value : TOvcPopupEvent);
- procedure SetPopupAnchor(Value : TOvcPopupAnchor);
-
-
- {property methods}
- function GetAsFloat : Double;
- function GetAsInteger : LongInt;
- function GetAsString : string;
- function GetPopupColors : TOvcCalcColors;
- function GetPopupDecimals : Integer;
- function GetPopupFont : TFont;
- function GetPopupHeight : Integer;
- function GetPopupWidth : Integer;
- procedure SetAsFloat(Value : Double);
- procedure SetAsInteger(Value : LongInt);
- procedure SetAsString(const Value : string);
- procedure SetPopupColors(Value : TOvcCalcColors);
- procedure SetPopupDecimals(Value : Integer);
- procedure SetPopupFont(Value : TFont);
- procedure SetPopupHeight(Value : Integer);
- procedure SetPopupWidth(Value : Integer);
-
- procedure SetParentFont(Value : Boolean);
- procedure SetEditParentShowHint(Value : Boolean);
-
- protected
- procedure GlyphChanged;
- override;
-
- public
- constructor Create(AOwner : TComponent);
- override;
-
- destructor Destroy; override;
-
- property AsInteger : LongInt
- read GetAsInteger
- write SetAsInteger;
-
- property AsFloat : Double
- read GetAsFloat
- write SetAsFloat;
-
- property AsString : string
- read GetAsString
- write SetAsString;
-
- property Calculator : TOvcCalculator
- read FCalculator;
-
- property EditControl : TOvcNumberEditEx
- read FOvcEdit;
-
-
- published
- {$IFDEF VERSION4}
- property Anchors;
-
-{$IFNDEF LCL}
- property BiDiMode : TBiDiMode
- read GetBiDiMode
- write SetBiDiMode;
-{$ENDIF}
-
- property Constraints;
-
-{$IFNDEF LCL}
- property ParentBiDiMode : Boolean
- read GetParentBiDiMode
- write SetParentBiDiMode;
-{$ENDIF}
-
- property DragKind : TDragKind
- read GetDragKind
- write SetDragKind;
- {$ENDIF}
-
- property About : string
- read GetAbout
- write SetAbout;
-
- property AllowIncDec : Boolean
- read FAllowIncDec
- write FAllowIncDec;
-
-{$IFNDEF LCL}
- property AutoSelect : Boolean
- read GetAutoSelect
- write SetAutoSelect;
-{$ENDIF}
-
- property AutoSize : Boolean
- read GetAutoSize
- write SetAutoSize;
-
- property CharCase : TEditCharCase
- read GetCharCase
- write SetCharCase;
-
- property Controller : TOvcController
- read GetController
- write SetEditController;
-
- property Cursor : TCursor
- read GetCursor
- write SetCursor;
-
- property DragCursor : TCursor
- read GetDragCursor
- write SetDragCursor;
-
- {$IFDEF VERSION4}
- property DragMode : TDragMode
- read GetDragMode
- write SetDragMode;
- {$ENDIF}
-
- property Enabled : Boolean
- read FEnabled
- write FEnabled;
-
- property Font : TFont
- read GetFont
- write SetFont;
-
-{$IFNDEF LCL}
- property HideSelection : Boolean
- read GetHideSelection
- write SetHideSelection;
-
- property ImeMode : TImeMode
- read GetImeMode
- write SetImeMode;
-
- property ImeName;
-{$ENDIF}
-
- property MaxLength : integer
- read GetMaxLength
- write SetMaxLength;
-
-{$IFNDEF LCL}
- property OEMConvert : Boolean
- read GetOEMConvert
- write SetOEMConvert;
-{$ENDIF}
-
- property ParentFont : Boolean
- read GetParentFont
- write SetParentFont;
-
- property ParentShowHint : Boolean
- read GetParentShowHint
- write SetParentShowHint;
-
- property PasswordChar : Char
- read GetPasswordChar
- write SetPasswordChar;
-
- property PopupAnchor : TOvcPopupAnchor
- read GetPopupAnchor
- write SetPopupAnchor;
-
- property PopupColors : TOvcCalcColors
- read GetPopupColors
- write SetPopupColors;
-
- property PopupDecimals : Integer
- read GetPopupDecimals
- write SetPopupDecimals;
-
- property PopupFont : TFont
- read GetPopupFont
- write SetPopupFont;
-
- property PopupHeight : Integer
- read GetPopupHeight
- write SetPopupHeight;
-
- property PopupMenu;
-
- property PopupWidth : Integer
- read GetPopupWidth
- write SetPopupWidth;
-
- property ReadOnly : Boolean
- read GetReadOnly
- write SetReadOnly;
-
- property ShowButton : Boolean
- read GetEditShowButton
- write SetEditShowButton;
-
- property ShowHint;
- property TabOrder;
- property TabStop;
- property Visible;
-
- {events}
- property OnChange : TNotifyEvent
- read GetOnChange
- write SetOnChange;
-
- property OnClick : TNotifyEvent
- read GetOnClick
- write SetOnClick;
-
- property OnDblClick : TNotifyEvent
- read GetOnDblClick
- write SetOnDblClick;
-
- property OnDragDrop : TDragDropEvent
- read GetOnDragDrop
- write SetOnDragDrop;
-
- property OnDragOver : TDragOverEvent
- read GetOnDragOver
- write SetOnDragOver;
-
- property OnEndDrag : TEndDragEvent
- read GetOnEndDrag
- write SetOnEndDrag;
-
- property OnEnter;
- property OnExit;
-
- property OnKeyDown : TKeyEvent
- read GetOnKeyDown
- write SetOnKeyDown;
-
- property OnKeyPress : TKeyPressEvent
- read GetOnKeyPress
- write SetOnKeyPress;
-
- property OnKeyUp : TKeyEvent
- read GetOnKeyUp
- write SetOnKeyUp;
-
- property OnMouseDown : TMouseEvent
- read GetOnMouseDown
- write SetOnMouseDown;
-
- property OnMouseMove : TMouseMoveEvent
- read GetOnMouseMove
- write SetOnMouseMove;
-
- property OnMouseUp : TMouseEvent
- read GetOnMouseUp
- write SetOnMouseUp;
- property OnStartDrag;
-
- property OnPopupClose : TOvcPopupEvent
- read GetOnPopupClose
- write SetOnPopupClose;
-
- property OnPopupOpen : TOvcPopupEvent
- read GetOnPopupOpen
- write SetOnPopupOpen;
- end;
-
-
-implementation
-
-constructor TOvcBorderEdPopup.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- ControlStyle := ControlStyle - [csSetCaption];
-
- ButtonWidth := ButtonGlyph.Width;
- DoShowButton := FShowButton;
-end;
-
-
-procedure TOvcBorderEdPopup.CreateParams(var Params : TCreateParams);
-begin
- inherited CreateParams(Params);
-
- Params.Style := Params.Style or WS_CLIPCHILDREN;
-end;
-
-procedure TOvcBorderEdPopup.CreateWnd;
-begin
- inherited CreateWnd;
-
- {force button placement}
- SetBounds(Left, Top, Width, Height);
-
- if (Assigned(FButton)) then
- FButton.Enabled := GetButtonEnabled;
-end;
-
-destructor TOvcBorderEdPopup.Destroy;
-begin
- { Freeing the button glyph throws access violation for some reason }
- { we'll just let it leak for now. }
-// if FButtonGlyph <> nil then
-// FButtonGlyph.Free;
- inherited Destroy;
-end;
-
-
-
-function TOvcBorderEdPopup.GetButtonEnabled : Boolean;
-begin
- Result := not TOvcEdit(FEdit).ReadOnly;
-end;
-
-
-function TOvcBorderEdPopup.GetButtonWidth : Integer;
-begin
- if FShowButton then begin
- Result := GetSystemMetrics(SM_CXHSCROLL);
- if Assigned(FButtonGlyph) and not FButtonGlyph.Empty then
- if FButtonGlyph.Width + 4 > Result then
- Result := FButtonGlyph.Width + 4;
- end else
- Result := 0;
-end;
-
-function TOvcBorderEdPopup.GetButtonGlyph : TBitmap;
-begin
- if not Assigned(FButtonGlyph) then
- FButtonGlyph := TBitmap.Create;
-
- Result := FButtonGlyph
-end;
-
-procedure TOvcBorderEdPopup.GlyphChanged;
-begin
-end;
-
-procedure TOvcBorderEdPopup.Loaded;
-begin
- inherited Loaded;
-
- if Assigned(FButtonGlyph) then
- FButton.Glyph.Assign(FButtonGlyph);
-end;
-
-
-procedure TOvcBorderEdPopup.OnMsgClose(var M : TMessage);
-begin
- if (Assigned(FOnPopupClose)) then
- FOnPopupClose(Self);
-end;
-
-procedure TOvcBorderEdPopup.OnMsgOpen(var M : TMessage);
-begin
- if (Assigned(FOnPopupOpen)) then
- FOnPopupOpen(Self);
-end;
-
-
-procedure TOvcBorderEdPopup.PopupClose;
-begin
- FPopupActive := False;
- PostMessage(Handle, BorderMsgClose, 0, 0);
-end;
-
-procedure TOvcBorderEdPopup.PopupOpen;
-begin
- FPopupActive := True;
- PostMessage(Handle, BorderMsgOpen, 0, 0);
-end;
-
-
-procedure TOvcBorderEdPopup.SetEditControl(EC : TOvcCustomEdit);
-begin
- inherited SetEditControl(EC);
- FEdit := EC;
-end;
-
-procedure TOvcBorderEdPopup.SetButtonGlyph(Value : TBitmap);
-begin
- if not Assigned(FButtonGlyph) then
- FButtonGlyph := TBitmap.Create;
-
- if not Assigned(Value) then begin
- FButtonGlyph.Free;
- FButtonGlyph := TBitmap.Create;
- end else
- FButtonGlyph.Assign(Value);
-
- GlyphChanged;
-
- FButton.Glyph.Assign(FButtonGlyph);
- SetBounds(Left, Top, Width, Height);
-end;
-
-procedure TOvcBorderEdPopup.SetShowButton(Value : Boolean);
-begin
- FShowButton := Value;
- {force resize and redisplay of button}
- SetBounds(Left, Top, Width, Height);
-end;
-
-{$IFDEF VERSION4}
-procedure TOvcBorderEdPopup.CMDialogKey(var Msg : TCMDialogKey);
-begin
-(*
- if PopupActive then begin
- with Msg do begin
- if ((CharCode = VK_RETURN) or (CHarCode = VK_ESCAPE)) then begin
- PopupClose(Self);
- Result := 1;
- end;
- end;
- end else
- inherited;
-*)
-end;
-{$ENDIF}
-
-
-procedure TOvcBorderEdPopup.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
-begin
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-end;
-
-
-{******************************************************************************}
-{ TOvcBorderedNumberEdit }
-{******************************************************************************}
-
-constructor TOvcBorderedNumberEdit.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- FOvcEdit := TOvcNumberEditEx.Create(Self);
- SetEditControl(TOvcCustomEdit(FOvcEdit));
-
- FOvcEdit.Ctl3D := False;
- FOvcEdit.BorderStyle := bsNone;
- FOvcEdit.ParentColor := True;
- FOvcEdit.Parent := Self;
- FOvcEdit.Top := 0;
- FOvcEdit.Left := 0;
- FOvcEdit.TabStop := TabStop;
- FOvcEdit.BorderParent := Self;
-
- DoShowButton := FOvcEdit.ShowButton;
- ButtonWidth := FOvcEdit.ButtonGlyph.Width + 4;
-
- Height := FEdit.Height;
- Width := FEdit.Width;
- Borders.BottomBorder.Enabled := True;
-
- FController := FOvcEdit.Controller;
- FButton := FOvcEdit.FButton;
- FButtonGlyph := FOvcEdit.FButtonGlyph;
- FPopupActive := FOvcEdit.FPopupActive;
- FOnPopupClose := FOvcEdit.FOnPopupClose;
- FShowButton := FOvcEdit.FShowButton;
-
- {$IFDEF VERSION4}
- {$IFNDEF LCL}
- FBiDiMode := FOvcEdit.BiDiMode;
- {$ENDIF}
- FDragKind := FOvcEdit.DragKind;
- {$IFNDEF LCL}
- FParentBiDiMode:= FOvcEdit.ParentBiDiMode;
- {$ENDIF}
- {$ENDIF}
- FAbout := FOvcEdit.About;
- {$IFNDEF LCL}
- FAutoSelect := FOvcEdit.AutoSelect;
- {$ENDIF}
- FAutoSize := FOvcEdit.AutoSize;
- FBorderStyle := FOvcEdit.BorderStyle;
- FCharCase := FOvcEdit.CharCase;
- FCursor := FOvcEdit.Cursor;
- FDragCursor := FOvcEdit.DragCursor;
- FDragMode := FOvcEdit.DragMode;
- FEnabled := True;
- FFont := FOvcEdit.Font;
- {$IFNDEF LCL}
- FHideSelection := FOvcEdit.HideSelection;
- FImeMode := FOvcEdit.ImeMode;
- FImeName := FOvcEdit.ImeName;
- {$ENDIF}
- FMaxLength := FOvcEdit.MaxLength;
- {$IFNDEF LCL}
- FOEMConvert := FOvcEdit.OEMConvert;
- {$ENDIF}
- FParentFont := FOvcEdit.ParentFont;
- FParentShowHint:= FOvcEdit.ParentShowHint;
- FPasswordChar := FOvcEdit.PasswordChar;
- FPopupMenu := FOvcEdit.PopupMenu;
- FReadOnly := FOvcEdit.ReadOnly;
- FShowHint := FOvcEdit.ShowHint;
- FTabOrder := FOvcEdit.TabOrder;
- FVisible := True;
-
- FOnChange := FOvcEdit.OnChange;
- FOnClick := FOvcEdit.OnClick;
- FOnDblClick := FOvcEdit.OnDblClick;
- FOnDragDrop := FOvcEdit.OnDragDrop;
- FOnDragOver := FOvcEdit.OnDragOver;
-
- FOnEndDrag := FOvcEdit.OnEndDrag;
- FOnEnter := FOvcEdit.OnEnter;
- FOnExit := FOvcEdit.OnExit;
- FOnKeyDown := FOvcEdit.OnKeyDown;
- FOnKeyPress := FOvcEdit.OnKeyPress;
- FOnKeyUp := FOvcEdit.OnKeyUp;
- FOnMouseDown := FOvcEdit.OnMouseDown;
- FOnMouseMove := FOvcEdit.OnMouseMove;
- FOnMouseUp := FOvcEdit.OnMouseUp;
- FOnStartDrag := FOvcEdit.OnStartDrag;
-
- {load button glyph}
-{$IFNDEF LCL}
- FButtonGlyph.Handle := LoadBaseBitmap('ORBTNCLC');
-{$ELSE}
- FButtonGlyph.LoadFromLazarusResource('ORBTNCLC');
-{$ENDIF}
- FButton.Glyph.Assign(FButtonGlyph);
-
- FCalculator := FOvcEdit.Calculator;
-end;
-
-destructor TOvcBorderedNumberEdit.Destroy;
-begin
- FOvcEdit.Free;
- FOvcEdit := nil;
-
- inherited Destroy;
-end;
-
-
-function TOvcBorderedNumberEdit.GetAsFloat : Double;
-var
- I : Integer;
- S : string;
-begin
- S := Text;
- for I := Length(S) downto 1 do
- if not (S[I] in ['0'..'9', '+', '-', DecimalSeparator]) then
- Delete(S, I, 1);
- Result := StrToFloat(S);
-end;
-
-function TOvcBorderedNumberEdit.GetAsInteger : LongInt;
-begin
- Result := Round(GetAsFloat);
-end;
-
-function TOvcBorderedNumberEdit.GetAsString : string;
-begin
- Result := Text;
-end;
-
-function TOvcBorderedNumberEdit.GetPopupColors : TOvcCalcColors;
-begin
- Result := FCalculator.Colors;
-end;
-
-function TOvcBorderedNumberEdit.GetPopupDecimals : Integer;
-begin
- Result := FCalculator.Decimals;
-end;
-
-function TOvcBorderedNumberEdit.GetPopupFont : TFont;
-begin
- Result := FCalculator.Font;
-end;
-
-function TOvcBorderedNumberEdit.GetPopupHeight : Integer;
-begin
- Result := FCalculator.Height;
-end;
-
-function TOvcBorderedNumberEdit.GetPopupWidth : Integer;
-begin
- Result := FCalculator.Width;
-end;
-
-function TOvcBorderedNumberEdit.GetReadOnly : Boolean;
-begin
- Result := FOvcEdit.ReadOnly;
- FReadOnly := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetParentFont : Boolean;
-begin
- Result := FOvcEdit.ParentFont;
- FParentFont := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetEditParentShowHint : Boolean;
-begin
- Result := FOvcEdit.ParentShowHint;
- FParentShowHint := Result;
-end;
-
-
-procedure TOvcBorderedNumberEdit.GlyphChanged;
-begin
- inherited GlyphChanged;
-
- if FButtonGlyph.Empty then
-{$IFNDEF LCL}
- FButtonGlyph.Handle := LoadBaseBitmap('ORBTNCLC');
-{$ELSE}
- FButtonGlyph.LoadFromLazarusResource('ORBTNCLC');
-{$ENDIF}
-end;
-
-
-procedure TOvcBorderedNumberEdit.SetAsFloat(Value : Double);
-begin
- Text := FloatToStr(Value);
-end;
-
-procedure TOvcBorderedNumberEdit.SetAsInteger(Value : LongInt);
-begin
- Text := IntToStr(Value);
-end;
-
-procedure TOvcBorderedNumberEdit.SetAsString(const Value : string);
-begin
- Text := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetPopupColors(Value : TOvcCalcColors);
-begin
- FCalculator.Colors := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetPopupDecimals(Value : Integer);
-begin
- FCalculator.Decimals := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetPopupFont(Value : TFont);
-begin
- if Assigned(Value) then
- FCalculator.Font.Assign(Value);
-end;
-
-procedure TOvcBorderedNumberEdit.SetPopupHeight(Value : Integer);
-begin
- FCalculator.Height := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetPopupWidth(Value : Integer);
-begin
- FCalculator.Width := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetReadOnly(Value : Boolean);
-begin
- FReadOnly := Value;
- FOvcEdit.ReadOnly := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetParentFont(Value : Boolean);
-begin
- FParentFont := Value;
- FOvcEdit.ParentFont := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetEditParentShowHint(Value : Boolean);
-begin
- FOvcEdit.ParentShowHint := Value;
- FParentShowHint := Value;
-end;
-
-
-function TOvcBorderedNumberEdit.GetOnPopupClose : TOvcPopupEvent;
-begin
- Result := FOvcEdit.OnPopupClose;
- FOnPopupClose := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnPopupOpen : TOvcPopupEvent;
-begin
- Result := FOvcEdit.OnPopupOpen;
- FOnPopupOpen := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetPopupAnchor : TOvcPopupAnchor;
-begin
- Result := FOvcEdit.BorderParent.PopupAnchor;
- FPopupAnchor := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetEditShowButton : Boolean;
-begin
- Result := FOvcEdit.ShowButton;
- FShowButton := Result;
-end;
-
-
-procedure TOvcBorderedNumberEdit.SetOnPopupClose(Value : TOvcPopupEvent);
-begin
- FOvcEdit.OnPopupClose := Value;
- FOnPopupClose := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnPopupOpen(Value : TOvcPopupEvent);
-begin
- FOvcEdit.OnPopupOpen := Value;
- FOnPopupOpen := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetPopupAnchor(Value : TOvcPopupAnchor);
-begin
- FOvcEdit.BorderParent.PopupAnchor := Value;
- FPopupAnchor := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetEditShowButton(Value : Boolean);
-begin
- FOvcEdit.ShowButton := Value;
- FShowButton := Value;
-end;
-
-
-{base property methods}
-{$IFDEF VERSION4}
- {$IFNDEF LCL}
-function TOvcBorderedNumberEdit.GetBiDiMode : TBiDiMode;
-begin
- Result := FOvcEdit.BiDiMode;
- FBiDiMode := Result;
-end;
- {$ENDIF}
-
-function TOvcBorderedNumberEdit.GetDragKind : TDragKind;
-begin
- Result := FOvcEdit.DragKind;
- FDragKind := Result;
-end;
-
-(*
-function TOvcBorderedNumberEdit.GetEditConstraints : TSizeConstraints;
-begin
- Result := FOvcEdit.Constraints;
- FConstraints := Result;
-end;
-*)
-
-{$IFNDEF LCL}
-function TOvcBorderedNumberEdit.GetParentBiDiMode : Boolean;
-begin
- Result := FOvcEdit.ParentBiDiMode;
- FParentBiDiMode := Result;
-end;
-
-procedure TOvcBorderedNumberEdit.SetBiDiMode(Value : TBiDiMode);
-begin
- if (Value <> FBiDiMode) then begin
- inherited;
- FBiDiMode := Value;
- FOvcEdit.BiDiMode := Value;
- end;
-end;
-{$ENDIF}
-
-(*
-procedure TOvcBorderedNumberEdit.SetEditConstraints(Value : TSizeConstraints);
-begin
- FConstraints := Value;
- FOvcEdit.Constraints := Value;
-end;
-*)
-
-{$IFNDEF LCL}
-procedure TOvcBorderedNumberEdit.SetParentBiDiMode(Value : Boolean);
-begin
- if (Value <> FParentBiDiMode) then begin
- inherited;
- FParentBiDiMode := Value;
- FOvcEdit.ParentBiDiMode := Value;
- end;
-end;
-{$ENDIF}
-
-procedure TOvcBorderedNumberEdit.SetDragKind(Value : TDragKind);
-begin
- if (Value <> FDragKind) then begin
- FDragKind := Value;
- FOvcEdit.DragKind := Value;
- end;
-end;
-{$ENDIF}
-
-
-function TOvcBorderedNumberEdit.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-
-{$IFNDEF LCL}
-function TOvcBorderedNumberEdit.GetAutoSelect : Boolean;
-begin
- Result := FOvcEdit.AutoSelect;
- FAutoSelect := FOvcEdit.AutoSelect;
-end;
-{$ENDIF}
-
-function TOvcBorderedNumberEdit.GetAutoSize : Boolean;
-begin
- Result := FOvcEdit.AutoSize;
- FAutoSize := FOvcEdit.AutoSize;
-end;
-
-function TOvcBorderedNumberEdit.GetCharCase : TEditCharCase;
-begin
- Result := FOvcEdit.CharCase;
- FCharCase := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetController : TOvcController;
-begin
- Result := FOvcEdit.Controller;
- FController := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetCursor : TCursor;
-begin
- Result := FOvcEdit.Cursor;
- FCursor := Result;
-end;
-
-
-function TOvcBorderedNumberEdit.GetDragCursor : TCursor;
-begin
- Result := FOvcEdit.DragCursor;
- FDragCursor := Result;
-end;
-
-
-function TOvcBorderedNumberEdit.GetDragMode : TDragMode;
-begin
- Result := FOvcEdit.DragMode;
- FDragMode := Result;
-end;
-
-
-function TOvcBorderedNumberEdit.GetEditEnabled : Boolean;
-begin
- Result := FOvcEdit.Enabled;
- FEnabled := FOvcEdit.Enabled;
-end;
-
-function TOvcBorderedNumberEdit.GetFont : TFont;
-begin
- Result := FOvcEdit.Font;
- FFont := Result;
-end;
-
-{$IFNDEF LCL}
-function TOvcBorderedNumberEdit.GetHideSelection : Boolean;
-begin
- Result := FOvcEdit.HideSelection;
- FHideSelection := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetImeMode : TImeMode;
-begin
- Result := FOvcEdit.ImeMode;
- FImeMode := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetImeName : string;
-begin
- Result := FOvcEdit.ImeName;
- FImeName := Result;
-end;
-{$ENDIF}
-
-function TOvcBorderedNumberEdit.GetMaxLength : Integer;
-begin
- Result := FOvcEdit.MaxLength;
- FMaxLength := Result;
-end;
-
-{$IFNDEF LCL}
-function TOvcBorderedNumberEdit.GetOEMConvert : Boolean;
-begin
- Result := FOvcEdit.OEMConvert;
- FOEMConvert := Result;
-end;
-{$ENDIF}
-
-function TOvcBorderedNumberEdit.GetParentShowHint : Boolean;
-begin
- Result := FOvcEdit.ParentShowHint;
- FParentShowHint := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetPasswordChar : Char;
-begin
- Result := FOvcEdit.PasswordChar;
- FPasswordChar := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnChange : TNotifyEvent;
-begin
- Result := FOvcEdit.OnChange;
- FOnChange := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnClick : TNotifyEvent;
-begin
- Result := FOvcEdit.OnClick;
- FOnClick := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnDblClick : TNotifyEvent;
-begin
- Result := FOvcEdit.OnDblClick;
- FOnDblClick := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnDragDrop : TDragDropEvent;
-begin
- Result := FOvcEdit.OnDragDrop;
- FOnDragDrop := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnDragOver : TDragOverEvent;
-begin
- Result := FOvcEdit.OnDragOver;
- FOnDragOver := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnEndDrag : TEndDragEvent;
-begin
- Result := FOvcEdit.OnEndDrag;
- FOnEndDrag := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnKeyDown : TKeyEvent;
-begin
- Result := FOvcEdit.OnKeyDown;
- FOnKeyDown := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnKeyPress : TKeyPressEvent;
-begin
- Result := FOvcEdit.OnKeyPress;
- FOnKeyPress := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnKeyUp : TKeyEvent;
-begin
- Result := FOvcEdit.OnKeyUp;
- FOnKeyUp := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnMouseDown : TMouseEvent;
-begin
- Result := FOvcEdit.OnMouseDown;
- FOnMouseDown := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnMouseMove : TMouseMoveEvent;
-begin
- Result := FOvcEdit.OnMouseMove;
- FOnMouseMove := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnMouseUp : TMouseEvent;
-begin
- Result := FOvcEdit.OnMouseUp;
- FOnMouseUp := Result;
-end;
-
-
-
-procedure TOvcBorderedNumberEdit.SetAbout(const Value : string);
-begin
-end;
-
-
-{$IFNDEF LCL}
-procedure TOvcBorderedNumberEdit.SetAutoSelect(Value : Boolean);
-begin
- if (Value <> FAutoSelect) then begin
- FAutoSelect := Value;
- FOvcEdit.AutoSelect := Value;
- end;
-end;
-{$ENDIF}
-
-
-procedure TOvcBorderedNumberEdit.SetAutoSize(Value : Boolean);
-begin
- FAutoSize := Value;
- FOvcEdit.AutoSize := Value;
-end;
-
-
-procedure TOvcBorderedNumberEdit.SetCharCase(Value : TEditCharCase);
-begin
- FCharCase := Value;
- FOvcEdit.CharCase := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetEditController(Value : TOvcController);
-begin
- FController := Value;
- FOvcEdit.Controller := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetCursor(Value : TCursor);
-begin
- FCursor := Value;
- FOvcEdit.Cursor := Value;
-end;
-
-
-procedure TOvcBorderedNumberEdit.SetDragCursor(Value : TCursor);
-begin
- if (Value <> FDragCursor) then begin
- FDragCursor := Value;
- FOvcEdit.DragCursor := Value;
- end;
-end;
-
-
-procedure TOvcBorderedNumberEdit.SetEditDragMode(Value : TDragMode);
-begin
- if (Value <> FDragMode) then begin
- FDragMode := Value;
- FOvcEdit.DragMode := Value;
- end;
-end;
-
-procedure TOvcBorderedNumberEdit.SetEditEnabled(Value : Boolean);
-begin
- if (Value <> FEnabled) then begin
- FEnabled := Value;
- Enabled := Value;
- FOvcEdit.Enabled := Value;
- end;
-end;
-
-procedure TOvcBorderedNumberEdit.SetFont(Value : TFont);
-begin
- if (Value <> FFont) then begin
- FFont := Value;
- FOvcEdit.Font := Value;
- end;
-end;
-
-{$IFNDEF LCL}
-procedure TOvcBorderedNumberEdit.SetHideSelection(Value : Boolean);
-begin
- if (Value <> FHideSelection) then begin
- FHideSelection := Value;
- FOvcEdit.HideSelection := Value;
- end;
-end;
-
-procedure TOvcBorderedNumberEdit.SetImeMode(Value : TImeMode);
-begin
- if (Value <> FImeMode) then begin
- FImeMode := Value;
- FOvcEdit.ImeMode := Value;
- end;
-end;
-
-procedure TOvcBorderedNumberEdit.SetImeName(const Value : string);
-begin
- if (Value <> FImeName) then begin
- FImeName := Value;
- FOvcEdit.ImeName := Value;
- end;
-end;
-{$ENDIF}
-
-procedure TOvcBorderedNumberEdit.SetMaxLength(Value : Integer);
-begin
- if (Value <> FMaxLength) then begin
- FMaxLength := Value;
- FOvcEdit.MaxLength := Value;
- end;
-end;
-
-{$IFNDEF LCL}
-procedure TOvcBorderedNumberEdit.SetOEMConvert(Value : Boolean);
-begin
- if (Value <> FOEMConvert) then begin
- FOEMConvert := Value;
- FOvcEdit.OEMConvert := Value;
- end;
-end;
-{$ENDIF}
-
-procedure TOvcBorderedNumberEdit.SetParentShowHint(Value : Boolean);
-begin
- if (Value <> FParentShowHint) then begin
- FParentShowHint := Value;
- FOvcEdit.ParentShowHint := Value;
- end;
-end;
-
-procedure TOvcBorderedNumberEdit.SetPasswordChar(Value : Char);
-begin
- if (Value <> FPasswordChar) then begin
- FPasswordChar := Value;
- FOvcEdit.PasswordChar := Value;
- end;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnChange(Value : TNotifyEvent);
-begin
- FOnChange := Value;
- FOvcEdit.OnChange := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnClick(Value : TNotifyEvent);
-begin
- FOnClick := Value;
- FOvcEdit.OnClick := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnDblClick(Value : TNotifyEvent);
-begin
- FOnDblClick := Value;
- FOvcEdit.OnDblClick := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnDragDrop(Value : TDragDropEvent);
-begin
- FOnDragDrop := Value;
- FOvcEdit.OnDragDrop := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnDragOver(Value : TDragOverEvent);
-begin
- FOnDragOver := Value;
- FOvcEdit.OnDragOver := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnEndDrag(Value : TEndDragEvent);
-begin
- FOnEndDrag := Value;
- FOvcEdit.OnEndDrag := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnKeyDown(Value : TKeyEvent);
-begin
- FOnKeyDown := Value;
- FOvcEdit.OnKeyDown := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnKeyPress(Value : TKeyPressEvent);
-begin
- FOnKeyPress := Value;
- FOvcEdit.OnKeyPress := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnKeyUp(Value : TKeyEvent);
-begin
- FOnKeyUp := Value;
- FOvcEdit.OnKeyUp := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnMouseDown(Value : TMouseEvent);
-begin
- FOnMouseDown := Value;
- FOvcEdit.OnMouseDown := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnMouseMove(Value : TMouseMoveEvent);
-begin
- FOnMouseMove := Value;
- FOvcEdit.OnMouseMove := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnMouseUp(Value : TMouseEvent);
-begin
- FOnMouseUp := Value;
- FOvcEdit.OnMouseUp := Value;
-end;
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/f6/f69dd45bb9039f5eb4113c86447ff98ee1b6d662.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/f6/f69dd45bb9039f5eb4113c86447ff98ee1b6d662.svn-base
deleted file mode 100644
index 41a20b5e..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/f6/f69dd45bb9039f5eb4113c86447ff98ee1b6d662.svn-base
+++ /dev/null
@@ -1,294 +0,0 @@
-{*********************************************************}
-{* OVCTCSIM.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 ovctcsim;
- {-Orpheus Table Cell - Simple field type}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- SysUtils, Classes, Controls,
- OvcData, OvcEF, OvcSF, OvcTCmmn, OvcTCell, OvcTCBEF,
- Graphics; { - for default color definition}
-
-type
- {The editor class for TOvcTCSimpleField cell components}
- TOvcTCSimpleFieldEdit = class(TOvcSimpleField)
- protected {private}
- {.Z+}
- FCell : TOvcBaseTableCell;
- {.Z-}
-
- protected
- {.Z+}
- procedure efMoveFocusToNextField; override;
- procedure efMoveFocusToPrevField; override;
-
- procedure WMChar(var Msg : TWMKey); message WM_CHAR;
- procedure WMGetDlgCode(var Msg : TMessage); message WM_GETDLGCODE;
- procedure WMKeyDown(var Msg : TWMKey); message WM_KEYDOWN;
- procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS;
- procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
- {.Z-}
-
- published
- property CellOwner : TOvcBaseTableCell
- read FCell write FCell;
- end;
-
- {The simple field cell component class}
- TOvcTCCustomSimpleField = class(TOvcTCBaseEntryField)
- protected
- {.Z+}
- function GetCellEditor : TControl; override;
- function GetDataType : TSimpleDataType;
- function GetPictureMask : AnsiChar;
-
- procedure SetDataType(DT : TSimpleDataType);
- procedure SetPictureMask(PM : AnsiChar);
- {.Z-}
-
- property DataType : TSimpleDataType
- read GetDataType write SetDataType;
-
- property PictureMask : AnsiChar
- read GetPictureMask write SetPictureMask;
-
- public
- function CreateEntryField(AOwner : TComponent) : TOvcBaseEntryField; override;
- end;
-
- TOvcTCSimpleField = class(TOvcTCCustomSimpleField)
- published
- {properties inherited from custom ancestor}
- property Access default otxDefault;
- property Adjust default otaDefault;
- property CaretIns;
- property CaretOvr;
- property Color;
- property ControlCharColor default clRed;
- property DataType default sftString;
- property DecimalPlaces default 0;
- property EFColors;
- property Font;
- property Hint;
- property Margin default 4;
- property MaxLength default 15;
- property Options default [efoCaretToEnd, efoTrimBlanks];
- property PadChar default ' ';
- property PasswordChar default '*';
- property PictureMask default 'X';
- property RangeHi stored False;
- property RangeLo stored False;
- property ShowHint default False;
- property Table;
- property TableColor default True;
- property TableFont default True;
- property TextHiColor default clBtnHighlight;
- property TextMargin default 2;
- property TextStyle default tsFlat;
-
- {events inherited from custom ancestor}
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnError;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnOwnerDraw;
- property OnUserCommand;
- property OnUserValidation;
- end;
-
-
-implementation
-
-
-{===TOvcTCCustomSimpleField=========================================}
-function TOvcTCCustomSimpleField.CreateEntryField(AOwner : TComponent) : TOvcBaseEntryField;
- begin
- Result := TOvcTCSimpleFieldEdit.Create(AOwner);
- TOvcTCSimpleFieldEdit(Result).CellOwner := Self;
- end;
-{--------}
-function TOvcTCCustomSimpleField.GetCellEditor : TControl;
- begin
- Result := FEdit;
- end;
-{--------}
-function TOvcTCCustomSimpleField.GetDataType : TSimpleDataType;
- begin
- if Assigned(FEdit) then Result := TOvcTCSimpleFieldEdit(FEdit).DataType
- else Result := sftString;
- end;
-{--------}
-function TOvcTCCustomSimpleField.GetPictureMask : AnsiChar;
- begin
- if Assigned(FEdit) then Result := TOvcTCSimpleFieldEdit(FEdit).PictureMask
- else Result := pmAnyChar;
- end;
-{--------}
-procedure TOvcTCCustomSimpleField.SetDataType(DT : TSimpleDataType);
- begin
- if Assigned(FEdit) then
- begin
- TOvcTCSimpleFieldEdit(FEdit).DataType := DT;
- TOvcTCSimpleFieldEdit(FEditDisplay).DataType := DT;
- end;
- end;
-{--------}
-procedure TOvcTCCustomSimpleField.SetPictureMask(PM : AnsiChar);
- begin
- if Assigned(FEdit) then
- begin
- TOvcTCSimpleFieldEdit(FEdit).PictureMask := PM;
- TOvcTCSimpleFieldEdit(FEditDisplay).PictureMask := PM;
- end;
- end;
-{====================================================================}
-
-
-{===TOvcTCSimpleFieldEdit==============================================}
-procedure TOvcTCSimpleFieldEdit.efMoveFocusToNextField;
- var
- Msg : TWMKey;
- begin
- FillChar(Msg, sizeof(Msg), 0);
- with Msg do
- begin
- Msg := WM_KEYDOWN;
- CharCode := VK_RIGHT;
- end;
- CellOwner.SendKeyToTable(Msg);
- end;
-{--------}
-procedure TOvcTCSimpleFieldEdit.efMoveFocusToPrevField;
- var
- Msg : TWMKey;
- begin
- FillChar(Msg, sizeof(Msg), 0);
- with Msg do
- begin
- Msg := WM_KEYDOWN;
- CharCode := VK_LEFT;
- end;
- CellOwner.SendKeyToTable(Msg);
- end;
-{--------}
-procedure TOvcTCSimpleFieldEdit.WMChar(var Msg : TWMKey);
- begin
- if (Msg.CharCode <> 9) then {filter tab characters}
- inherited;
- end;
-{--------}
-procedure TOvcTCSimpleFieldEdit.WMGetDlgCode(var Msg : TMessage);
- begin
-{$IFNDEF LCL}
- inherited;
-{$ELSE}
- inherited WMGetDlgCode(TWMNoParams(Msg));
-{$ENDIF}
- if CellOwner.TableWantsTab then
- Msg.Result := Msg.Result or DLGC_WANTTAB;
- if CellOwner.TableWantsEnter then
- Msg.Result := Msg.Result or DLGC_WANTALLKEYS;
- end;
-{--------}
-procedure TOvcTCSimpleFieldEdit.WMKeyDown(var Msg : TWMKey);
- var
- GridReply : TOvcTblKeyNeeds;
- GridUsedIt : boolean;
- begin
- GridUsedIt := false;
- GridReply := otkDontCare;
- if (CellOwner <> nil) then
- GridReply := CellOwner.FilterTableKey(Msg);
- case GridReply of
- otkMustHave :
- begin
- {the entry field must also process this key - to restore its contents}
- if (Msg.CharCode = VK_ESCAPE) then
- Restore;
-
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- otkWouldLike :
- case Msg.CharCode of
- VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN :
- begin
-// TurboPower bug. Next line commented out and next two lines inserted.
-// if ValidateSelf then
- if not ValidateSelf then //Added - don't pass key to ancestor?
- Exit; //Added
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;
- {Note: VK_LEFT, VK_RIGHT are processed by efMoveFocusToNext(Next)Field}
- end;
- end;{case}
-
- if not GridUsedIt then
- inherited;
- end;
-{--------}
-procedure TOvcTCSimpleFieldEdit.WMKillFocus(var Msg : TWMKillFocus);
- begin
- inherited;
- CellOwner.PostMessageToTable(ctim_KillFocus, Msg.FocusedWnd, LastError);
- end;
-{--------}
-procedure TOvcTCSimpleFieldEdit.WMSetFocus(var Msg : TWMSetFocus);
- begin
- inherited;
- CellOwner.PostMessageToTable(ctim_SetFocus, Msg.FocusedWnd, 0);
- end;
-{====================================================================}
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/f9/f91b105d3b680d81075cf58f126e8624ad0c0ea2.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/f9/f91b105d3b680d81075cf58f126e8624ad0c0ea2.svn-base
deleted file mode 100644
index ee926c1c..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/f9/f91b105d3b680d81075cf58f126e8624ad0c0ea2.svn-base
+++ /dev/null
@@ -1,77 +0,0 @@
-{*********************************************************}
-{* OVCLBL1.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 ovclbl1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, Buttons, {$ENDIF}
- SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls;
-
-type
- TfrmSaveScheme = class(TForm)
- Label1: TLabel;
- SchemeNameEd: TEdit;
- OkBtn: TButton;
- CancelBtn: TButton;
- procedure FormCreate(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.DFM}
-{$ENDIF}
-
-procedure TfrmSaveScheme.FormCreate(Sender: TObject);
-begin
- Top := (Screen.Height - Height) div 3;
- Left := (Screen.Width - Width) div 2;
-end;
-
-initialization
-{$IFDEF LCL}
-{$I ovclbl1.lrs} {Include form's resource file}
-{$ENDIF}
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/f9/f98ff01d69dd693b9faf00dffa427c93f7de6ab6.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/f9/f98ff01d69dd693b9faf00dffa427c93f7de6ab6.svn-base
deleted file mode 100644
index 387f5398..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/f9/f98ff01d69dd693b9faf00dffa427c93f7de6ab6.svn-base
+++ /dev/null
@@ -1,139 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
- ovctcedt, ovctchdr, ovctcmmn, ovctable, ovcbase, ovctcsim, o32tcflx,
- ovcdata, ovcsf, ovctcbef, ovctcell, ovctcstr;
-
-const
- MaxDataRecs = 20;
- MaxStrLen = 100;
- cnStr = 1; {Column numbers for controls}
- cnSimp = 2;
- cnFlex = 3;
-
-type
- TDataRec = record
- Str : string[MaxStrLen];
- Simp : string[MaxStrLen];
- Flex : string;
- end;
-
- TDataArray = array[1..MaxDataRecs] of TDataRec;
-
- TForm1 = class(TForm)
- OvcTable1: TOvcTable;
- OvcController1: TOvcController;
- OvcTCColHead1: TOvcTCColHead;
- OvcTCRowHead1: TOvcTCRowHead;
- OvcTCString1: TOvcTCString;
- OvcTCSimpleField1: TOvcTCSimpleField;
- O32TCFlexEdit1: TO32TCFlexEdit;
- procedure FormCreate(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure OvcTable1GetCellData(Sender: TObject; RowNum,
- ColNum: Integer; var Data: Pointer; Purpose: TOvcCellDataPurpose);
- procedure OvcTCSimpleField1UserValidation(Sender: TObject;
- var ErrorCode: Word);
- procedure OvcTCSimpleField1Error(Sender: TObject; ErrorCode: Word;
- ErrorMsg: String);
- procedure O32TCFlexEdit1UserValidation(Sender: TObject; Value: String;
- var ValidEntry: Boolean);
- private
- DataArray : TDataArray; {A place to store data entered in table}
- public
- end;
-
-var
- Form1: TForm1;
-
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.dfm} {Link Delphi form file}
-{$ENDIF}
-
-procedure TForm1.FormCreate(Sender: TObject);
- {Initialize the main form.
- Do anything that needs to be done before the form
- can be displayed.}
-var
- RowNum : Integer;
-begin
- OvcTable1.RowLimit := MaxDataRecs + OvcTable1.LockedRows;
-
- OvcTCString1.MaxLength := MaxStrLen; {Be sure to set this here or in form}
- OvcTCSimpleField1.MaxLength := MaxStrLen;
- O32TCFlexEdit1.MaxLength := MaxStrLen;
-
-{$IFDEF FPC}
- for RowNum := 1 to MaxDataRecs do
- SetLength(DataArray[RowNum].Flex, MaxStrLen);
-{$ENDIF}
-end; {TForm1.FormCreate}
-
-
-procedure TForm1.FormDestroy(Sender: TObject);
-begin
-end; {TForm1.FormDestroy}
-
-
-procedure TForm1.OvcTable1GetCellData(Sender: TObject; RowNum,
- ColNum: Integer; var Data: Pointer; Purpose: TOvcCellDataPurpose);
- {This event handler is called when the table needs data to display
- or edit in a cell or a place to save a cell's edited data.}
-begin
- Data := nil;
- if (RowNum < OvcTable1.LockedRows) or (RowNum > OvcTable1.RowLimit) then
- Exit;
-
- case ColNum of
- cnStr : Data := @DataArray[RowNum].Str;
- cnSimp : Data := @DataArray[RowNum].Simp;
- cnFlex : Data := PChar(DataArray[RowNum].Flex);
- end;
-end; {TForm1.OvcTable1GetCellData}
-
-
-procedure TForm1.OvcTCSimpleField1UserValidation(Sender: TObject;
- var ErrorCode: Word);
-var
- AnInt : Integer;
-begin
- ErrorCode := 0;
- if (TOvcSimpleField(Sender).Text <> '') and
- (not TryStrToInt(TOvcSimpleField(Sender).Text, AnInt)) then
- ErrorCode := oeInvalidNumber;
-end;
-
-procedure TForm1.OvcTCSimpleField1Error(Sender: TObject; ErrorCode: Word;
- ErrorMsg: String);
-begin
- MessageDlg(ErrorMsg + #13#10 + 'Enter an integer or press Ctrl+Z to undo.',
- mtError, [mbOK], 0);
-end;
-
-procedure TForm1.O32TCFlexEdit1UserValidation(Sender: TObject;
- Value: String; var ValidEntry: Boolean);
-var
- AnInt : Integer;
-begin
- ValidEntry := True;
- if (Value <> '') and (not TryStrToInt(Value, AnInt)) then
- begin
- ValidEntry := False;
- MessageDlg('Invalid value.' + #13#10 +
- 'Enter an integer or press Ctrl+Z to undo.', mtError, [mbOK], 0);
- end;
-end;
-
-initialization
-{$IFDEF LCL}
-{$I unit1.lrs} {Include form's Lazarus resource file}
-{$ENDIF}
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/f9/f9cf8becd51207089d5e8256946a6a032593915c.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/f9/f9cf8becd51207089d5e8256946a6a032593915c.svn-base
deleted file mode 100644
index 1f072065..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/pristine/f9/f9cf8becd51207089d5e8256946a6a032593915c.svn-base and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/fe/fea2d74eee6f395859dd5726bc69e29d6ba2b1fb.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/fe/fea2d74eee6f395859dd5726bc69e29d6ba2b1fb.svn-base
deleted file mode 100644
index 614e2fa3..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/pristine/fe/fea2d74eee6f395859dd5726bc69e29d6ba2b1fb.svn-base and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/fe/febadf4eedf4ff610f10d484b9581fb5365194be.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/fe/febadf4eedf4ff610f10d484b9581fb5365194be.svn-base
deleted file mode 100644
index 5d3b3563..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/pristine/fe/febadf4eedf4ff610f10d484b9581fb5365194be.svn-base and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/fe/fef5ccb002018d8cd3e09d82a2b9984d8811452f.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/fe/fef5ccb002018d8cd3e09d82a2b9984d8811452f.svn-base
deleted file mode 100644
index 59ba68c9..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/fe/fef5ccb002018d8cd3e09d82a2b9984d8811452f.svn-base
+++ /dev/null
@@ -1,661 +0,0 @@
-{*********************************************************}
-{* O32SR.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 ***** *}
-
-(* Replaces the old String Resource Manager from Orpheus versions 3.x and
- below. The string resource is broken into 3 parts.
- Part 1: The actual string resources contained in O32***RS.inc
- (O32ENGRS.inc for English). (Translate these strings and define the
- language below to create new language versions of Orpheus.)
- Part 2: The index constants defined in OvcConst.pas.
- Part 3: The cross reference array (SrMsgNumLookup) used to convert an
- index into the corresponding string.
- It is very important that the cross reference array be kept in numerical
- order. The lookup is performed by a binary search and if any of the items
- are out of order, the lookup will fail some or all strings. *)
-
-{$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 o32sr;
- {- Orpheus String Resources
- Replaces the String Resource Manager from the olden days...}
-
-interface
-
-uses
- ovcconst;
-
-{$I O32SR.inc}
-
-resourcestring
-
-{Orpheus Internal and Design-time resource strings...}
-
-{!!!! - These should not be translated as they are used internally - !!!!}
-{!!!! - See O32SR.INC for the user visible resource strings - !!!!}
-
- {Navigation Commands}
- ccNoneStr = 'ccNone';
- ccBackStr = 'ccBack';
- ccBotOfPageStr = 'ccBotOfPage';
- ccBotRightCellStr = 'ccBotRightCell';
- ccCompleteDateStr = 'ccCompleteDate';
- ccCompleteTimeStr = 'ccCompleteTime';
- ccCopyStr = 'ccCopy';
- ccCtrlCharStr = 'ccCtrlChar';
- ccCutStr = 'ccCut';
- ccDecStr = 'ccDec';
- ccDelStr = 'ccDel';
- ccDelBolStr = 'ccDelBol';
- ccDelEolStr = 'ccDelEol';
- ccDelLineStr = 'ccDelLine';
- ccDelWordStr = 'ccDelWord';
- ccDownStr = 'ccDown';
- ccEndStr = 'ccEnd';
- ccExtendDownStr = 'ccExtendDown';
- ccExtendEndStr = 'ccExtendEnd';
- ccExtendHomeStr = 'ccExtendHome';
- ccExtendLeftStr = 'ccExtendLeft';
- ccExtendPgDnStr = 'ccExtendPgDn';
- ccExtendPgUpStr = 'ccExtendPgUp';
- ccExtendRightStr = 'ccExtendRight';
- ccExtendUpStr = 'ccExtendUp';
- ccExtBotOfPageStr = 'ccExtBotOfPage';
- ccExtFirstPageStr = 'ccExtFirstPage';
- ccExtLastPageStr = 'ccExtLastPage';
- ccExtTopOfPageStr = 'ccExtTopOfPage';
- ccExtWordLeftStr = 'ccExtWordLeft';
- ccExtWordRightStr = 'ccExtWordRight';
- ccFirstPageStr = 'ccFirstPage';
- ccGotoMarker0Str = 'ccGotoMarker0';
- ccGotoMarker1Str = 'ccGotoMarker1';
- ccGotoMarker2Str = 'ccGotoMarker2';
- ccGotoMarker3Str = 'ccGotoMarker3';
- ccGotoMarker4Str = 'ccGotoMarker4';
- ccGotoMarker5Str = 'ccGotoMarker5';
- ccGotoMarker6Str = 'ccGotoMarker6';
- ccGotoMarker7Str = 'ccGotoMarker7';
- ccGotoMarker8Str = 'ccGotoMarker8';
- ccGotoMarker9Str = 'ccGotoMarker9';
- ccHomeStr = 'ccHome';
- ccIncStr = 'ccInc';
- ccInsStr = 'ccIns';
- ccLastPageStr = 'ccLastPage';
- ccLeftStr = 'ccLeft';
- ccNewLineStr = 'ccNewLine';
- ccNextPageStr = 'ccNextPage';
- ccPageLeftStr = 'ccPageLeft';
- ccPageRightStr = 'ccPageRight';
- ccPasteStr = 'ccPaste';
- ccPrevPageStr = 'ccPrevPage';
- ccRedoStr = 'ccRedo';
- ccRestoreStr = 'ccRestore';
- ccRightStr = 'ccRight';
- ccScrollDownStr = 'ccScrollDown';
- ccScrollUpStr = 'ccScrollUp';
- ccSetMarker0Str = 'ccSetMarker0';
- ccSetMarker1Str = 'ccSetMarker1';
- ccSetMarker2Str = 'ccSetMarker2';
- ccSetMarker3Str = 'ccSetMarker3';
- ccSetMarker4Str = 'ccSetMarker4';
- ccSetMarker5Str = 'ccSetMarker5';
- ccSetMarker6Str = 'ccSetMarker6';
- ccSetMarker7Str = 'ccSetMarker7';
- ccSetMarker8Str = 'ccSetMarker8';
- ccSetMarker9Str = 'ccSetMarker9';
- ccTabStr = 'ccTab';
- ccTableEditStr = 'ccTableEdit';
- ccTopLeftCellStr = 'ccTopLeftCell';
- ccTopOfPageStr = 'ccTopOfPage';
- ccUndoStr = 'ccUndo';
- ccUpStr = 'ccUp';
- ccWordLeftStr = 'ccWordLeft';
- ccWordRightStr = 'ccWordRight';
-
- {DataType strings}
- StringStr = 'String';
- CharStr = 'Char';
- BooleanStr = 'Boolean';
- YesNoStr = 'YesNo';
- LongIntStr = 'LongInt';
- WordStr = 'Word';
- SmallIntStr = 'SmallInt';
- ByteStr = 'Byte';
- ShortIntStr = 'ShortInt';
- RealStr = 'Real';
- ExtendedStr = 'Extended';
- DoubleStr = 'Double';
- SingleStr = 'Single';
- CompStr = 'Comp';
- DateStr = 'Date';
- TimeStr = 'Time';
-
- {Sample masks for the EditField's property editors}
- CharMask1Str = 'X any character';
- CharMask2Str = '! any char (upper)';
- CharMask3Str = 'L any char (lower)';
- CharMask4Str = 'x any char (mixed)';
- CharMask5Str = 'a alphas only';
- CharMask6Str = 'A alphas (upper)';
- CharMask7Str = 'l alphas (lower)';
- CharMask8Str = '9 0-9';
- CharMask9Str = 'i 0-9, -';
- CharMask10Str = '# 0-9, -, .';
- CharMask11Str = 'E 0-9, E, -, .';
- CharMask12Str = 'K 0-9, A-F (hex)';
- CharMask14Str = 'O 0-7 (octal)';
- CharMask15Str = 'b 0, 1 (binary)';
- CharMask16Str = 'B T or F (upper)';
- CharMask17Str = 'Y Y or N (upper)';
- CharMask18Str = '1 User 1';
- CharMask19Str = '2 User 2';
- CharMask20Str = '3 User 3';
- CharMask21Str = '4 User 4';
- CharMask22Str = '5 User 5';
- CharMask23Str = '6 User 6';
- CharMask24Str = '7 User 7';
- CharMask25Str = '8 User 8';
-
- FieldMask1Str = '$##,###.## Allows entry of 0 through 9, space, minus, and period Uses floating currency symbol';
- FieldMask2Str = '9999999999 Allows entry of 0 through 9, and space';
- FieldMask3Str = 'iiiiiiiiii Allows entry of 0 through 9, space, and minus';
- FieldMask4Str = 'ii,iii,iii Allows entry of 0 through 9, space, and minus Displays number separators as needed';
- FieldMask5Str = '$iiiiiiiii Allows entry of 0 through 9, space, and minus Uses floating currency symbol';
- FieldMask6Str = '########## Allows entry of 0 through 9, space, minus, and period';
- FieldMask7Str = '#######.## Allows entry of 0 through 9, space, minus, and period Fixed decimal position';
- FieldMask8Str = '###,###.## Allows entry of 0 through 9, space, minus, and period Displays number separators as needed';
- FieldMask9Str = '$######.## Allows entry of 0 through 9, space, minus, and period Fixed decimal position Uses floating currency symbol';
- FieldMask10Str = '##########p Allows entry of 0 through 9, space, minus, and period Negative amounts use ()';
- FieldMask11Str = '###,###.##C Allows entry of 0 through 9, space, minus, and period Currency symbol at right';
- FieldMask12Str = 'KKKKKKKK Hexadecimal (E4401F3E) Allows entry of 0 through 9 and A through F Force upper case';
- FieldMask13Str = 'KKKK Hexadecimal (1F3E) Allows entry of 0 through 9 and A through F Force upper case';
- FieldMask14Str = 'KK Hexadecimal (3E) Allows entry of 0 through 9 and A through F Force upper case';
- FieldMask15Str = 'OOOOOOOO Octal (45135677) Allows entry of 0 through 7 ';
- FieldMask16Str = 'OOOO Octal (5677) Allows entry of 0 through 7 ';
- FieldMask17Str = 'bbbbbbbbbbbbbbbb Binary (0101001010010100) Allows entry of 0 and 1';
- FieldMask18Str = 'bbbbbbbb Binary (10010100) Allows entry of 0 and 1';
- FieldMask19Str = 'XXXXXXXXXX Any character can be entered';
- FieldMask20Str = '!!!!!!!!!! Any character can be entered Alphabetic characters are forced to upper case';
- FieldMask21Str = 'LLLLLLLLLL Any character can be entered Alphabetic characters are forced to lower case';
- FieldMask22Str = 'xxxxxxxxxx Any character can be entered Uses mixed case';
- FieldMask23Str = 'aaaaaaaaaa Alphabetic characters plus space, minus, period, and comma';
- FieldMask24Str = 'AAAAAAAAAA Alphabetic characters plus space, minus, period, and comma Alphabetic characters are forced to upper case';
- FieldMask25Str = 'llllllllll Alphabetic characters plus space, minus, period, and comma Alphabetic characters are forced to lower case';
- FieldMask26Str = '(999) 999-9999 Phone number mask Allows 0 through 9 and space';
- FieldMask27Str = '999-999-9999 Phone number mask Allows 0 through 9 and space';
- FieldMask28Str = '99999-9999 US Zip Code mask Allows 0 through 9 and space';
- FieldMask29Str = 'B Boolean mask Allows T, t, F, f Forces input to upper case';
- FieldMask30Str = 'Y Boolean mask Allows Y, y, N, n Forces input to upper case';
- FieldMask31Str = 'mm/dd/yy Date mask (01/05/96) Allows entry of 0 through 9 plus space Month and Day are padded with zeros';
- FieldMask32Str = 'mm/dd/yyyy Date mask (01/05/1996) Allows entry of 0 through 9 plus space Month and Day are padded with zeros';
- FieldMask33Str = 'dd nnn yyyy Date mask (05 Jan 1996) Allows entry of 0 through 9 plus space Day is padded with zeros';
- FieldMask34Str = 'MM/DD/yy Date mask ( 1/ 5/96) Allows entry of 0 through 9 plus space Month and Day are padded with spaces';
- FieldMask35Str = 'MM/DD/yyyy Date mask ( 1/ 5/1996) Allows entry of 0 through 9 plus space Month and Day are padded with spaces';
- FieldMask36Str = 'DD nnn yyyy Date mask ( 5 Jan 1996) Allows entry of 0 through 9 plus space Day is padded with spaces';
- FieldMask37Str = 'hh:mm Time mask (03:25) Allows entry of 0 through 9 plus space Hours and minutes are padded with zeros (24 hour clock)';
- FieldMask38Str = 'hh:mm tt Time mask (03:25 pm) Allows entry of 0 through 9 plus space Hours and minutes are padded with zeros';
- FieldMask39Str = 'hh:mm:ss Time mask (03:25:07) Allows entry of 0 through 9 plus space Hours, minutes, and seconds are padded with zeros';
- FieldMask40Str = 'HH:MM Time mask ( 3:25) Allows entry of 0 through 9 plus space Hours and minutes are padded with spaces (24 hour clock)';
- FieldMask41Str = 'HH:MM tt Time mask ( 3:25 pm) Allows entry of 0 through 9 plus space Hours and minutes are padded with spaces';
- FieldMask42Str = 'HH:MM:SS Time mask ( 3:25: 7) Allows entry of 0 through 9 plus space Hours, minutes, and seconds are padded with spaces';
-
-const
- {Change this when new strings are added.}
- SrMaxMessages = 375;
-
-type
- SrMsgNumLookupRec = record
- MessageNum : integer;
- MessageStr : string;
- end;
-
-const
- {Matches the index numbers to their associated Strings}
-
- {WARNING! When adding to or deleting from this array, make sure you keep the
- items in ascending numerical order by the value of the MessageNum constants.
- Otherwise, the Lookup will fail some or all strings...}
-
- SrMsgNumLookup : array [1..SrMaxMessages] of SrMsgNumLookupRec =
- {External Resource String Mapping. External resource strings are contained in
- O32SR.INC...}
- ((MessageNum : SCUnknownError; MessageStr : RSUnknownError),
- (MessageNum : SCDuplicateCommand; MessageStr : RSDuplicateCommand),
- (MessageNum : SCTableNotFound; MessageStr : RSTableNotFound),
- (MessageNum : SCNotDoneYet; MessageStr : RSNotDoneYet),
- (MessageNum : SCNoControllerAssigned; MessageStr : RSNoControllerAssigned),
- (MessageNum : SCCantCreateCommandTable; MessageStr : RSCantCreateCommandTable),
- (MessageNum : SCCantDelete; MessageStr : RSCantDelete),
- (MessageNum : SCInvalidKeySequence; MessageStr : RSInvalidKeySequence),
- (MessageNum : SCNotWordStarCommands; MessageStr : RSNotWordStarCommands),
- (MessageNum : SCNoCommandSelected; MessageStr : RSNoCommandSelected),
- (MessageNum : SCDuplicateKeySequence; MessageStr : RSDuplicateKeySequence),
- (MessageNum : SCRangeError; MessageStr : RSRangeError),
- (MessageNum : SCInvalidNumber; MessageStr : RSInvalidNumber),
- (MessageNum : SCRequiredField; MessageStr : RSRequiredField),
- (MessageNum : SCInvalidDate; MessageStr : RSInvalidDate),
- (MessageNum : SCInvalidTime; MessageStr : RSInvalidTime),
- (MessageNum : SCBlanksInField; MessageStr : RSBlanksInField),
- (MessageNum : SCPartialEntry; MessageStr : RSPartialEntry),
- (MessageNum : SCRegionTooLarge; MessageStr : RSRegionTooLarge),
- (MessageNum : SCOutOfMemoryForCopy; MessageStr : RSOutOfMemoryForCopy),
- (MessageNum : SCInvalidParamValue; MessageStr : RSInvalidParamValue),
- (MessageNum : SCNoTimersAvail; MessageStr : RSNoTimersAvail),
- (MessageNum : SCTooManyEvents; MessageStr : RSTooManyEvents),
- (MessageNum : SCBadTriggerHandle; MessageStr : RSBadTriggerHandle),
- (MessageNum : SCOnSelectNotAssigned; MessageStr : RSOnSelectNotAssigned),
- (MessageNum : SCInvalidPageIndex; MessageStr : RSInvalidPageIndex),
- (MessageNum : SCInvalidDataType; MessageStr : RSInvalidDataType),
- (MessageNum : SCInvalidTabFont; MessageStr : RSInvalidTabFont),
- (MessageNum : SCInvalidLabelFont; MessageStr : RSInvalidLabelFont),
- (MessageNum : SCOutOfMemory; MessageStr : RSOutOfMemory),
- (MessageNum : SCTooManyParas; MessageStr : RSTooManyParas),
- (MessageNum : SCCannotJoin; MessageStr : RSCannotJoin),
- (MessageNum : SCTooManyBytes; MessageStr : RSTooManyBytes),
- (MessageNum : SCParaTooLong; MessageStr : RSParaTooLong),
- (MessageNum : SCInvalidPictureMask; MessageStr : RSInvalidPictureMask),
- (MessageNum : SCInvalidRange; MessageStr : RSInvalidRange),
- (MessageNum : SCInvalidRealRange; MessageStr : RSInvalidRealRange),
- (MessageNum : SCInvalidExtendedRange; MessageStr : RSInvalidExtendedRange),
- (MessageNum : SCInvalidDoubleRange; MessageStr : RSInvalidDoubleRange),
- (MessageNum : SCInvalidSingleRange; MessageStr : RSInvalidSingleRange),
- (MessageNum : SCInvalidCompRange; MessageStr : RSInvalidCompRange),
- (MessageNum : SCInvalidDateRange; MessageStr : RSInvalidDateRange),
- (MessageNum : SCInvalidTimeRange; MessageStr : RSInvalidTimeRange),
- (MessageNum : SCInvalidRangeValue; MessageStr : RSInvalidRangeValue),
- (MessageNum : SCRangeNotSupported; MessageStr : RSRangeNotSupported),
- (MessageNum : SCInvalidLineOrParaIndex; MessageStr : RSInvalidLineOrParaIndex),
- (MessageNum : SCNonFixedFont; MessageStr : RSNonFixedFont),
- (MessageNum : SCInvalidFontParam; MessageStr : RSInvalidFontParam),
- (MessageNum : SCInvalidLineOrColumn; MessageStr : RSInvalidLineOrColumn),
- (MessageNum : SCSAEGeneral; MessageStr : RSSAEGeneral),
- (MessageNum : SCSAEAtMaxSize; MessageStr : RSSAEAtMaxSize),
- (MessageNum : SCInvalidXMLFile; MessageStr : RSInvalidXMLFile),
- (MessageNum : SCUnterminatedElement; MessageStr : RSUnterminatedElement),
- (MessageNum : SCBadColorConst; MessageStr : RSBadColorConstant),
- (MessageNum : SCBadColorValue; MessageStr : RSBadColorValue),
- (MessageNum : SCSAEOutOfBounds; MessageStr : RSSAEOutOfBounds),
- (MessageNum : SCInvalidFieldType; MessageStr : RSInvalidFieldType),
- (MessageNum : SCBadAlarmHandle; MessageStr : RSBadAlarmHandle),
- (MessageNum : SCOnIsSelectedNotAssigned; MessageStr : RSOnIsSelectedNotAssigned),
- (MessageNum : SCInvalidDateForMask; MessageStr : RSInvalidDateForMask),
- (MessageNum : SCNoTableAttached; MessageStr : RSNoTableAttached),
- (MessageNum : SCViewerIOError; MessageStr : RSViewerIOError),
- (MessageNum : SCViewerFileNotFound; MessageStr : RSViewerFileNotFound),
- (MessageNum : SCViewerPathNotFound; MessageStr : RSViewerPathNotFound),
- (MessageNum : SCViewerTooManyOpenFiles; MessageStr : RSViewerTooManyOpenFiles),
- (MessageNum : SCViewerFileAccessDenied; MessageStr : RSViewerFileAccessDenied),
- (MessageNum : SCControlAttached; MessageStr : RSControlAttached),
- (MessageNum : SCCantEdit; MessageStr : RSCantEdit),
- (MessageNum : SCChildTableError; MessageStr : RSChildTableError),
- (MessageNum : SCNoCollection; MessageStr : RSNoCollection),
- (MessageNum : SCNotOvcDescendant; MessageStr : RSNotOvcDescendant),
- (MessageNum : SCItemIncompatible; MessageStr : RSItemIncompatible),
- (MessageNum : SCLabelNotAttached; MessageStr : RSLabelNotAttached),
- (MessageNum : SCClassNotSet; MessageStr : RSClassNotSet),
- (MessageNum : SCCollectionNotFound; MessageStr : RSCollectionNotFound),
- (MessageNum : SCDayConvertError; MessageStr : RSDayConvertError),
- (MessageNum : SCMonthConvertError; MessageStr : RSMonthConvertError),
- (MessageNum : SCMonthNameConvertError; MessageStr : RSMonthNameConvertError),
- (MessageNum : SCYearConvertError; MessageStr : RSYearConvertError),
- (MessageNum : SCDayRequired; MessageStr : RSDayRequired),
- (MessageNum : SCMonthRequired; MessageStr : RSMonthRequired),
- (MessageNum : SCYearRequired; MessageStr : RSYearRequired),
- (MessageNum : SCInvalidDay; MessageStr : RSInvalidDay),
- (MessageNum : SCInvalidMonth; MessageStr : RSInvalidMonth),
- (MessageNum : SCInvalidMonthName; MessageStr : RSInvalidMonthName),
- (MessageNum : SCInvalidYear; MessageStr : RSInvalidYear),
- (MessageNum : SCTableRowOutOfBounds; MessageStr : RSTableRowOutOfBounds),
- (MessageNum : SCTableMaxRows; MessageStr : RSTableMaxRows),
- (MessageNum : SCTableMaxColumns; MessageStr : RSTableMaxColumns),
- (MessageNum : SCTableGeneral; MessageStr : RSTableGeneral),
- (MessageNum : SCTableToManyColumns; MessageStr : RSTableToManyColumns),
- (MessageNum : SCTableInvalidFieldIndex; MessageStr : RSTableInvalidFieldIndex),
- (MessageNum : SCTableHeaderNotAssigned; MessageStr : RSTableHeaderNotAssigned),
- (MessageNum : SCTableInvalidHeaderCell; MessageStr : RSTableInvalidHeaderCell),
- (MessageNum : SCGridTableName; MessageStr : RSGridTableName),
- (MessageNum : SCNoneStr; MessageStr : RSNoneStr),
- (MessageNum : SCccUser; MessageStr : RSccUser),
- (MessageNum : SCccUserNum; MessageStr : RSccUserNum),
- (MessageNum : SCDeleteTable; MessageStr : RSDeleteTable),
- (MessageNum : SCRenameTable; MessageStr : RSRenameTable),
- (MessageNum : SCEnterTableName; MessageStr : RSEnterTableName),
- (MessageNum : SCNewTable; MessageStr : RSNewTable),
- (MessageNum : SCDefaultTableName; MessageStr : RSDefaultTableName),
- (MessageNum : SCWordStarTableName; MessageStr : RSWordStarTableName ),
- (MessageNum : SCUnknownTable; MessageStr : RSUnknownTable),
- (MessageNum : SCDefaultEntryErrorText; MessageStr : RSDefaultEntryErrorText),
- (MessageNum : SCGotItemWarning; MessageStr : RSGotItemWarning),
- (MessageNum : SCSampleListItem; MessageStr : RSSampleListItem),
- (MessageNum : SCAlphaString; MessageStr : RSAlphaString),
- (MessageNum : SCTallLowChars; MessageStr : RSTallLowChars),
- (MessageNum : SCDefault; MessageStr : RSDefault),
- (MessageNum : SCDescending; MessageStr : RSDescending),
- (MessageNum : SCDefaultIndex; MessageStr : RSDefaultIndex),
- (MessageNum : SCRestoreMI; MessageStr : RSRestoreMI),
- (MessageNum : SCCutMI; MessageStr : RSCutMI),
- (MessageNum : SCCopyMI; MessageStr : RSCopyMI),
- (MessageNum : SCPasteMI; MessageStr : RSPasteMI),
- (MessageNum : SCDeleteMI; MessageStr : RSDeleteMI),
- (MessageNum : SCSelectAllMI; MessageStr : RSSelectAllMI),
- (MessageNum : SCCalcBack; MessageStr : RSCalcBack),
- (MessageNum : SCCalcMC; MessageStr : RSCalcMC),
- (MessageNum : SCCalcMR; MessageStr : RSCalcMR),
- (MessageNum : SCCalcMS; MessageStr : RSCalcMS),
- (MessageNum : SCCalcMPlus; MessageStr : RSCalcMPlus),
- (MessageNum : SCCalcMMinus; MessageStr : RSCalcMMinus),
- (MessageNum : SCCalcCT; MessageStr : RSCalcCT),
- (MessageNum : SCCalcCE; MessageStr : RSCalcCE),
- (MessageNum : SCCalcC; MessageStr : RSCalcC),
- (MessageNum : SCCalcSqrt; MessageStr : RSCalcSqrt),
- (MessageNum : SCCalNext; MessageStr : RSCalNext),
- (MessageNum : SCCalLast; MessageStr : RSCalLast),
- (MessageNum : SCCalFirst; MessageStr : RSCalFirst),
- (MessageNum : SCCal1st; MessageStr : RSCal1st),
- (MessageNum : SCCalSecond; MessageStr : RSCalSecond),
- (MessageNum : SCCal2nd; MessageStr : RSCal2nd),
- (MessageNum : SCCalThird; MessageStr : RSCalThird),
- (MessageNum : SCCal3rd; MessageStr : RSCal3rd),
- (MessageNum : SCCalFourth; MessageStr : RSCalFourth),
- (MessageNum : SCCal4th; MessageStr : RSCal4th),
- (MessageNum : SCCalFinal; MessageStr : RSCalFinal),
- (MessageNum : SCCalBOM; MessageStr : RSCalBOM),
- (MessageNum : SCCalEnd; MessageStr : RSCalEnd),
- (MessageNum : SCCalEOM; MessageStr : RSCalEOM),
- (MessageNum : SCCalYesterday; MessageStr : RSCalYesterday),
- (MessageNum : SCCalToday; MessageStr : RSCalToday),
- (MessageNum : SCCalTomorrow; MessageStr : RSCalTomorrow),
- (MessageNum : SCEditingSections; MessageStr : RSEditingSections),
- (MessageNum : SCEditingItems; MessageStr : RSEditingItems),
- (MessageNum : SCEditingFolders; MessageStr : RSEditingFolders),
- (MessageNum : SCEditingPages; MessageStr : RSEditingPages),
- (MessageNum : SCEditingImages; MessageStr : RSEditingImages),
- (MessageNum : SCSectionBaseName; MessageStr : RSSectionBaseName),
- (MessageNum : SCItemBaseName; MessageStr : RSItemBaseName),
- (MessageNum : SCFolderBaseName; MessageStr : RSFolderBaseName),
- (MessageNum : SCPageBaseName; MessageStr : RSPageBaseName),
- (MessageNum : SCImageBaseName; MessageStr : RSImageBaseName),
- (MessageNum : SCOwnerMustBeForm; MessageStr : RSOwnerMustBeForm),
- (MessageNum : SCTimeConvertError; MessageStr : RSTimeConvertError),
- (MessageNum : SCCancelQuery; MessageStr : RSCancelQuery),
- (MessageNum : SCNoPagesAssigned; MessageStr : RSNoPagesAssigned),
- (MessageNum : SCCalPrev; MessageStr : RSCalPrev),
- (MessageNum : SCCalBegin; MessageStr : RSCalBegin),
- (MessageNum : SCInvalidMinMaxValue; MessageStr : RSInvalidMinMaxValue),
- (MessageNum : SCFormUseOnly; MessageStr : RSFormUseOnly),
- (MessageNum : SCYes; MessageStr : RSYes),
- (MessageNum : SCNo; MessageStr : RSNo),
- (MessageNum : SCTrue; MessageStr : RSTrue),
- (MessageNum : SCFalse; MessageStr : RSFalse),
- (MessageNum : SCHoursName; MessageStr : RSHoursName),
- (MessageNum : SCMinutesName; MessageStr : RSMinutesName),
- (MessageNum : SCSecondsName; MessageStr : RSSecondsName),
- (MessageNum : SCCloseCaption; MessageStr : RSCloseCaption),
- (MessageNum : SCViewFieldNotFound; MessageStr : RSViewFieldNotFound),
- (MessageNum : SCCantResolveField; MessageStr : RSCantResolveField),
- (MessageNum : SCItemAlreadyExists; MessageStr : RSItemAlreadyExists),
- (MessageNum : SCAlreadyInTempMode; MessageStr : RSAlreadyInTempMode),
- (MessageNum : SCItemNotFound; MessageStr : RSItemNotFound),
- (MessageNum : SCUpdatePending; MessageStr : RSUpdatePending),
- (MessageNum : SCOnCompareNotAssigned; MessageStr : RSOnCompareNotAssigned),
- (MessageNum : SCOnFilterNotAssigned; MessageStr : RSOnFilterNotAssigned),
- (MessageNum : SCGetAsFloatNotAssigned; MessageStr : RSGetAsFloatNotAssigned),
- (MessageNum : SCNotInTempMode; MessageStr : RSNotInTempMode),
- (MessageNum : SCItemNotInIndex; MessageStr : RSItemNotInIndex),
- (MessageNum : SCNoActiveView; MessageStr : RSNoActiveView),
- (MessageNum : SCItemIsNotGroup; MessageStr : RSItemIsNotGroup),
- (MessageNum : SCNotMultiSelect; MessageStr : RSNotMultiSelect),
- (MessageNum : SCLineNoOutOfRange; MessageStr : RSLineNoOutOfRange),
- (MessageNum : SCUnknownView; MessageStr : RSUnknownView),
- (MessageNum : SCOnKeySearchNotAssigned; MessageStr : RSOnKeySearchNotAssigned),
- (MessageNum : SCOnEnumNotAssigned; MessageStr : RSOnEnumNotAssigned),
- (MessageNum : SCOnEnumSelectedNA; MessageStr : RSOnEnumSelectedNA),
- (MessageNum : SCNoMenuAssigned; MessageStr : RSNoMenuAssigned),
- (MessageNum : SCNoAnchorAssigned; MessageStr : RSNoAnchorAssigned),
- (MessageNum : SCInvalidParameter; MessageStr : RSInvalidParameter),
- (MessageNum : SCInvalidOperation; MessageStr : RSInvalidOperation),
- (MessageNum : SCColorBlack; MessageStr : RSColorBlack),
- (MessageNum : SCColorMaroon; MessageStr : RSColorMaroon),
- (MessageNum : SCColorGreen; MessageStr : RSColorGreen),
- (MessageNum : SCColorOlive; MessageStr : RSColorOlive),
- (MessageNum : SCColorNavy; MessageStr : RSColorNavy),
- (MessageNum : SCColorPurple; MessageStr : RSColorPurple),
- (MessageNum : SCColorTeal; MessageStr : RSColorTeal),
- (MessageNum : SCColorGray; MessageStr : RSColorGray),
- (MessageNum : SCColorSilver; MessageStr : RSColorSilver),
- (MessageNum : SCColorRed; MessageStr : RSColorRed),
- (MessageNum : SCColorLime; MessageStr : RSColorLime),
- (MessageNum : SCColorYellow; MessageStr : RSColorYellow),
- (MessageNum : SCColorBlue; MessageStr : RSColorBlue),
- (MessageNum : SCColorFuchsia; MessageStr : RSColorFuchsia),
- (MessageNum : SCColorAqua; MessageStr : RSColorAqua),
- (MessageNum : SCColorWhite; MessageStr : RSColorWhite),
- (MessageNum : SCColorLightGray; MessageStr : RSColorLightGray),
- (MessageNum : SCColorMediumGray; MessageStr : RSColorMediumGray),
- (MessageNum : SCColorDarkGray; MessageStr : RSColorDarkGray),
- (MessageNum : SCColorMoneyGreen; MessageStr : RSColorMoneyGreen),
- (MessageNum : SCColorSkyBlue; MessageStr : RSColorSkyBlue),
- (MessageNum : SCColorCream; MessageStr : RSColorCream),
-
- {End - Resource String Mapping...}
-
- {Internal Strings}
- (MessageNum : IccNone; MessageStr : ccNoneStr),
- (MessageNum : IccBack; MessageStr : ccBackStr),
- (MessageNum : IccBotOfPage; MessageStr : ccBotOfPageStr),
- (MessageNum : IccBotRightCell; MessageStr : ccBotRightCellStr),
- (MessageNum : IccCompleteDate; MessageStr : ccCompleteDateStr),
- (MessageNum : IccCompleteTime; MessageStr : ccCompleteTimeStr),
- (MessageNum : IccCopy; MessageStr : ccCopyStr),
- (MessageNum : IccCtrlChar; MessageStr : ccCtrlCharStr),
- (MessageNum : IccCut; MessageStr : ccCutStr),
- (MessageNum : IccDec; MessageStr : ccDecStr),
- (MessageNum : IccDel; MessageStr : ccDelStr),
- (MessageNum : IccDelBol; MessageStr : ccDelBolStr),
- (MessageNum : IccDelEol; MessageStr : ccDelEolStr),
- (MessageNum : IccDelLine; MessageStr : ccDelLineStr),
- (MessageNum : IccDelWord; MessageStr : ccDelWordStr),
- (MessageNum : IccDown; MessageStr : ccDownStr),
- (MessageNum : IccEnd; MessageStr : ccEndStr),
- (MessageNum : IccExtendDown; MessageStr : ccExtendDownStr),
- (MessageNum : IccExtendEnd; MessageStr : ccExtendEndStr),
- (MessageNum : IccExtendHome; MessageStr : ccExtendHomeStr),
- (MessageNum : IccExtendLeft; MessageStr : ccExtendLeftStr),
- (MessageNum : IccExtendPgDn; MessageStr : ccExtendPgDnStr),
- (MessageNum : IccExtendPgUp; MessageStr : ccExtendPgUpStr),
- (MessageNum : IccExtendRight; MessageStr : ccExtendRightStr),
- (MessageNum : IccExtendUp; MessageStr : ccExtendUpStr),
- (MessageNum : IccExtBotOfPage; MessageStr : ccExtBotOfPageStr),
- (MessageNum : IccExtFirstPage; MessageStr : ccExtFirstPageStr),
- (MessageNum : IccExtLastPage; MessageStr : ccExtLastPageStr),
- (MessageNum : IccExtTopOfPage; MessageStr : ccExtTopOfPageStr),
- (MessageNum : IccExtWordLeft; MessageStr : ccExtWordLeftStr),
- (MessageNum : IccExtWordRight; MessageStr : ccExtWordRightStr),
- (MessageNum : IccFirstPage; MessageStr : ccFirstPageStr),
- (MessageNum : IccGotoMarker0; MessageStr : ccGotoMarker0Str),
- (MessageNum : IccGotoMarker1; MessageStr : ccGotoMarker1Str),
- (MessageNum : IccGotoMarker2; MessageStr : ccGotoMarker2Str),
- (MessageNum : IccGotoMarker3; MessageStr : ccGotoMarker3Str),
- (MessageNum : IccGotoMarker4; MessageStr : ccGotoMarker4Str),
- (MessageNum : IccGotoMarker5; MessageStr : ccGotoMarker5Str),
- (MessageNum : IccGotoMarker6; MessageStr : ccGotoMarker6Str),
- (MessageNum : IccGotoMarker7; MessageStr : ccGotoMarker7Str),
- (MessageNum : IccGotoMarker8; MessageStr : ccGotoMarker8Str),
- (MessageNum : IccGotoMarker9; MessageStr : ccGotoMarker9Str),
- (MessageNum : IccHome; MessageStr : ccHomeStr),
- (MessageNum : IccInc; MessageStr : ccIncStr),
- (MessageNum : IccIns; MessageStr : ccInsStr),
- (MessageNum : IccLastPage; MessageStr : ccLastPageStr),
- (MessageNum : IccLeft; MessageStr : ccLeftStr),
- (MessageNum : IccNewLine; MessageStr : ccNewLineStr),
- (MessageNum : IccNextPage; MessageStr : ccNextPageStr),
- (MessageNum : IccPageLeft; MessageStr : ccPageLeftStr),
- (MessageNum : IccPageRight; MessageStr : ccPageRightStr),
- (MessageNum : IccPaste; MessageStr : ccPasteStr),
- (MessageNum : IccPrevPage; MessageStr : ccPrevPageStr),
- (MessageNum : IccRedo; MessageStr : ccRedoStr),
- (MessageNum : IccRestore; MessageStr : ccRestoreStr),
- (MessageNum : IccRight; MessageStr : ccRightStr),
- (MessageNum : IccScrollDown; MessageStr : ccScrollDownStr),
- (MessageNum : IccScrollUp; MessageStr : ccScrollUpStr),
- (MessageNum : IccSetMarker0; MessageStr : ccSetMarker0Str),
- (MessageNum : IccSetMarker1; MessageStr : ccSetMarker1Str),
- (MessageNum : IccSetMarker2; MessageStr : ccSetMarker2Str),
- (MessageNum : IccSetMarker3; MessageStr : ccSetMarker3Str),
- (MessageNum : IccSetMarker4; MessageStr : ccSetMarker4Str),
- (MessageNum : IccSetMarker5; MessageStr : ccSetMarker5Str),
- (MessageNum : IccSetMarker6; MessageStr : ccSetMarker6Str),
- (MessageNum : IccSetMarker7; MessageStr : ccSetMarker7Str),
- (MessageNum : IccSetMarker8; MessageStr : ccSetMarker8Str),
- (MessageNum : IccSetMarker9; MessageStr : ccSetMarker9Str),
- (MessageNum : IccTab; MessageStr : ccTabStr),
- (MessageNum : IccTableEdit; MessageStr : ccTableEditStr),
- (MessageNum : IccTopLeftCell; MessageStr : ccTopLeftCellStr),
- (MessageNum : IccTopOfPage; MessageStr : ccTopOfPageStr),
- (MessageNum : IccUndo; MessageStr : ccUndoStr),
- (MessageNum : IccUp; MessageStr : ccUpStr),
- (MessageNum : IccWordLeft; MessageStr : ccWordLeftStr),
- (MessageNum : IccWordRight; MessageStr : ccWordRightStr),
- (MessageNum : IString; MessageStr : StringStr),
- (MessageNum : IChar; MessageStr : CharStr),
- (MessageNum : IBoolean; MessageStr : BooleanStr),
- (MessageNum : IYesNo; MessageStr : YesNoStr),
- (MessageNum : ILongInt; MessageStr : LongIntStr),
- (MessageNum : IWord; MessageStr : WordStr),
- (MessageNum : ISmallInt; MessageStr : SmallIntStr),
- (MessageNum : IByte; MessageStr : ByteStr),
- (MessageNum : IShortInt; MessageStr : ShortIntStr),
- (MessageNum : IReal; MessageStr : RealStr),
- (MessageNum : IExtended; MessageStr : ExtendedStr),
- (MessageNum : IDouble; MessageStr : DoubleStr),
- (MessageNum : ISingle; MessageStr : SingleStr),
- (MessageNum : IComp; MessageStr : CompStr),
- (MessageNum : IDate; MessageStr : DateStr),
- (MessageNum : ITime; MessageStr : TimeStr),
- (MessageNum : ICharMask1; MessageStr : CharMask1Str),
- (MessageNum : ICharMask2; MessageStr : CharMask2Str),
- (MessageNum : ICharMask3; MessageStr : CharMask3Str),
- (MessageNum : ICharMask4; MessageStr : CharMask4Str),
- (MessageNum : ICharMask5; MessageStr : CharMask5Str),
- (MessageNum : ICharMask6; MessageStr : CharMask6Str),
- (MessageNum : ICharMask7; MessageStr : CharMask7Str),
- (MessageNum : ICharMask8; MessageStr : CharMask8Str),
- (MessageNum : ICharMask9; MessageStr : CharMask9Str),
- (MessageNum : ICharMask10; MessageStr : CharMask10Str),
- (MessageNum : ICharMask11; MessageStr : CharMask11Str),
- (MessageNum : ICharMask12; MessageStr : CharMask12Str),
- (MessageNum : ICharMask13; MessageStr : CharMask14Str),
- (MessageNum : ICharMask14; MessageStr : CharMask15Str),
- (MessageNum : ICharMask15; MessageStr : CharMask16Str),
- (MessageNum : ICharMask16; MessageStr : CharMask17Str),
- (MessageNum : ICharMask17; MessageStr : CharMask18Str),
- (MessageNum : ICharMask18; MessageStr : CharMask19Str),
- (MessageNum : ICharMask19; MessageStr : CharMask20Str),
- (MessageNum : ICharMask20; MessageStr : CharMask21Str),
- (MessageNum : ICharMask21; MessageStr : CharMask22Str),
- (MessageNum : ICharMask22; MessageStr : CharMask23Str),
- (MessageNum : ICharMask23; MessageStr : CharMask24Str),
- (MessageNum : ICharMask24; MessageStr : CharMask25Str),
- (MessageNum : IFieldMask1; MessageStr : FieldMask1Str),
- (MessageNum : IFieldMask2; MessageStr : FieldMask2Str),
- (MessageNum : IFieldMask3; MessageStr : FieldMask3Str),
- (MessageNum : IFieldMask4; MessageStr : FieldMask4Str),
- (MessageNum : IFieldMask5; MessageStr : FieldMask5Str),
- (MessageNum : IFieldMask6; MessageStr : FieldMask6Str),
- (MessageNum : IFieldMask7; MessageStr : FieldMask7Str),
- (MessageNum : IFieldMask8; MessageStr : FieldMask8Str),
- (MessageNum : IFieldMask9; MessageStr : FieldMask9Str),
- (MessageNum : IFieldMask10; MessageStr : FieldMask10Str),
- (MessageNum : IFieldMask11; MessageStr : FieldMask11Str),
- (MessageNum : IFieldMask12; MessageStr : FieldMask12Str),
- (MessageNum : IFieldMask13; MessageStr : FieldMask13Str),
- (MessageNum : IFieldMask14; MessageStr : FieldMask14Str),
- (MessageNum : IFieldMask15; MessageStr : FieldMask15Str),
- (MessageNum : IFieldMask16; MessageStr : FieldMask16Str),
- (MessageNum : IFieldMask17; MessageStr : FieldMask17Str),
- (MessageNum : IFieldMask18; MessageStr : FieldMask18Str),
- (MessageNum : IFieldMask19; MessageStr : FieldMask19Str),
- (MessageNum : IFieldMask20; MessageStr : FieldMask20Str),
- (MessageNum : IFieldMask21; MessageStr : FieldMask21Str),
- (MessageNum : IFieldMask22; MessageStr : FieldMask22Str),
- (MessageNum : IFieldMask23; MessageStr : FieldMask23Str),
- (MessageNum : IFieldMask24; MessageStr : FieldMask24Str),
- (MessageNum : IFieldMask25; MessageStr : FieldMask25Str),
- (MessageNum : IFieldMask26; MessageStr : FieldMask26Str),
- (MessageNum : IFieldMask27; MessageStr : FieldMask27Str),
- (MessageNum : IFieldMask28; MessageStr : FieldMask28Str),
- (MessageNum : IFieldMask29; MessageStr : FieldMask29Str),
- (MessageNum : IFieldMask30; MessageStr : FieldMask30Str),
- (MessageNum : IFieldMask31; MessageStr : FieldMask31Str),
- (MessageNum : IFieldMask32; MessageStr : FieldMask32Str),
- (MessageNum : IFieldMask33; MessageStr : FieldMask33Str),
- (MessageNum : IFieldMask34; MessageStr : FieldMask34Str),
- (MessageNum : IFieldMask35; MessageStr : FieldMask35Str),
- (MessageNum : IFieldMask36; MessageStr : FieldMask36Str),
- (MessageNum : IFieldMask37; MessageStr : FieldMask37Str),
- (MessageNum : IFieldMask38; MessageStr : FieldMask38Str),
- (MessageNum : IFieldMask39; MessageStr : FieldMask39Str),
- (MessageNum : IFieldMask40; MessageStr : FieldMask40Str),
- (MessageNum : IFieldMask41; MessageStr : FieldMask41Str),
- (MessageNum : IFieldMask42; MessageStr : FieldMask42Str));
-
- {End - Internal Strings...}
-
-function ResourceStrByNumber(Num: Word): String;
-
-implementation
-
-function ResourceStrByNumber(Num: Word): String;
-{Implements a simple binary search through the SrMsgNumLookup array.
- Returns an empty string is a match isn't found.}
-var
- Mid, Min, Max : integer;
-begin
- result := '';
- Min := 0;
- Max := SrMaxMessages;
- while (Min <= Max) do begin
- Mid := (Min + Max) div 2;
- if SrMsgNumLookup[Mid].MessageNum = Num then begin
- result := SrMsgNumLookup[Mid].MessageStr;
- exit;
- end else begin
- if Num < SrMsgNumLookup[Mid].MessageNum
- then Max := Mid - 1
- else Min := Mid + 1;
- end;
- end;
-end;
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/pristine/ff/ff4b009e3c57ece70fbbfcc057c9674756976aba.svn-base b/Source/3rdParty/Orpheus/.svn/pristine/ff/ff4b009e3c57ece70fbbfcc057c9674756976aba.svn-base
deleted file mode 100644
index b51fb4e3..00000000
--- a/Source/3rdParty/Orpheus/.svn/pristine/ff/ff4b009e3c57ece70fbbfcc057c9674756976aba.svn-base
+++ /dev/null
@@ -1,2705 +0,0 @@
-{*********************************************************}
-{* OVCCALC.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 ovccalc;
- {-calculator component}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, Types, LclType, GraphType, MyMisc, {$ENDIF}
- Buttons, Classes, ClipBrd, Controls, ExtCtrls, Forms, Graphics,
- Menus, StdCtrls, SysUtils,
- OvcData, OvcConst, OvcBase, OvcMisc;
-
-type
- TOvcCalculatorButton = (
- cbNone, cbTape, cbBack, cbClearEntry, cbClear, cbAdd, cbSub, cbMul, cbDiv,
- cb0, cb1, cb2, cb3, cb4, cb5, cb6, cb7, cb8, cb9,
- cbDecimal, cbEqual, cbInvert, cbChangeSign, cbPercent, cbSqrt,
- cbMemClear, cbMemRecall, cbMemStore, cbMemAdd, cbMemSub, cbSubTotal);
-
- TOvcButtonInfo = packed record
- Position : TRect; {position and size}
- Caption : string[10]; {button text}
- Visible : Boolean; {true to display button}
- end;
-
- TOvcButtonArray = array[cbTape..cbMemSub] of TOvcButtonInfo;
-
-type
- TOvcCalculatorOperation = (
- coNone, coAdd, coSub, coMul, coDiv,
- coEqual, coInvert, coPercent, coSqrt,
- coMemClear, coMemRecall, coMemStore, coMemAdd, coMemSub, coSubTotal);
-
- TOvcCalcState = (csValid, csLocked, csClear);
- TOvcCalcStates = set of TOvcCalcState;
-
-type
- TOvcCalcColorArray = array[0..7] of TColor;
- TOvcCalcColorScheme = (cscalcCustom, cscalcWindows, cscalcDark,
- cscalcOcean, cscalcPlain);
- TOvcCalcSchemeArray = array[TOvcCalcColorScheme] of TOvcCalcColorArray;
- TOvcCalcDisplayString = array[TOvcCalculatorButton] of string;
- TOvcCalcButtonToOperation = array[cbNone..cbSubTotal] of TOvcCalculatorOperation;
-
-
-const
- {DisabledMemoryButtons, Display, DisplayTextColor, EditButtons,
- FunctionButtons, MemoryButtons, NumberButtons, OperatorButtons}
- CalcScheme : TOvcCalcSchemeArray =
- ((0, 0, 0, 0, 0, 0, 0, 0),
- (clGray, clWindow, clWindowText, clMaroon, clNavy, clRed, clBlue, clRed),
- (clGray, clBlack, clAqua, clBlack, clTeal, clNavy, clMaroon, clBlue),
- (clGray, clAqua, clBlack, clPurple, clNavy, clNavy, clAqua, clBlue),
- (clGray, clWhite, clNavy, clBlack, clNavy, clNavy, clBlue, clBlue)
- );
-{ You must set the Length of the first entry (cbNone) to the Length of the largest entry}
- CalcDisplayString : TOvcCalcDisplayString =
- (' ',' ',' ','CE','C' ,'+' ,'-' ,'*' ,'/',
- ' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',
- ' ','=' ,'1/','-+','%' ,'SQ',
- 'MC','MR','MS','M+','M-','*' );
-
- CalcButtontoOperation : TOvcCalcButtonToOperation =
- (coNone, coNone, coNone, coNone, coNone, coAdd, coSub, coMul, coDiv,
- coNone, coNone, coNone, coNone, coNone, coNone, coNone, coNone, coNone, coNone,
- coNone, coEqual, coInvert, coNone, coPercent, coSqrt,
- coMemClear, coMemRecall, coMemStore, coMemAdd, coMemSub, coSubTotal);
-
-type
- TOvcCalcColors = class(TPersistent)
- {.Z+}
- private
- {property variables}
- FUpdating : Boolean;
- FOnChange : TNotifyEvent;
-
- {internal variables}
- SettingScheme : Boolean;
-
- {internal methods}
- procedure DoOnChange;
-
- {property methods}
- function GetColor(const Index : Integer) : TColor;
- procedure SetColor(const Index : Integer; const Value : TColor);
- procedure SetColorScheme(const Value : TOvcCalcColorScheme);
- procedure SetDisplayTextColor(const Value : TColor);
-
- public
- {property variables}
- FCalcColors : TOvcCalcColorArray;
- FColorScheme : TOvcCalcColorScheme;
-
- procedure Assign(Source : TPersistent);
- override;
- procedure BeginUpdate;
- procedure EndUpdate;
-
- property OnChange : TNotifyEvent
- read FOnChange write FOnChange;
- {.Z-}
-
- published
- property ColorScheme : TOvcCalcColorScheme
- read FColorScheme write SetColorScheme;
- property DisabledMemoryButtons : TColor index 0
- read GetColor write SetColor;
- property Display : TColor index 1
- read GetColor write SetColor;
- property DisplayTextColor : TColor
- read FCalcColors[2] write SetDisplayTextColor nodefault;
- property EditButtons : TColor index 3
- read GetColor write SetColor;
- property FunctionButtons : TColor index 4
- read GetColor write SetColor;
- property MemoryButtons : TColor index 5
- read GetColor write SetColor;
- property NumberButtons : TColor index 6
- read GetColor write SetColor;
- property OperatorButtons : TColor index 7
- read GetColor write SetColor;
- end;
-
-type
- {.Z+}
- TOvcCalcPanel = class(TPanel)
- protected
- procedure Click;
- override;
- public
- end;
- {.Z-}
-
-type
- {.Z+}
- TOvcCustomCalculatorEngine = class
- protected {private}
- {property variables}
- FDecimals : Integer;
- FShowSeparatePercent : Boolean;
-
- {internal variables}
- cCalculated : Extended;
- cLastOperation : TOvcCalculatorOperation;
- cOperationCount : Integer;
- cMemory : Extended; {value stored in memory register}
- cOperands : array [0..3] of Extended; {the operand stack}
- cState : TOvcCalcStates;
-
- public
- function AddOperand(const Value : Extended; const Button : TOvcCalculatorOperation) : Boolean;
- virtual; abstract;
- function AddOperation(const Button : TOvcCalculatorOperation) : Boolean;
- virtual; abstract;
- procedure ClearAll;
- procedure PushOperand(const Value : Extended);
- function PopOperand : Extended;
- function TopOperand : Extended;
-
- {public properties}
- property Decimals : Integer
- read FDecimals write FDecimals;
- property LastOperation : TOvcCalculatorOperation
- read cLastOperation write cLastOperation;
- property Memory : Extended
- read cMemory write cMemory;
- property OperationCount : Integer
- read cOperationCount write cOperationCount;
- property ShowSeparatePercent : Boolean
- read FShowSeparatePercent write FShowSeparatePercent;
- property State : TOvcCalcStates
- read cState write cState;
- end;
- {.Z-}
-
-type
- {.Z+}
- TOvcCalcTape = class(TObject)
- protected {private}
- {property variables}
- FMaxPaperCount : Integer;
- FShowTape : Boolean;
- FTapeDisplaySpace : Integer;
- FVisible : Boolean;
-
- {internal variables}
- taListBox : TListBox;
- taTapeColor : TColor;
- taHeight : Integer;
- taOwner : TComponent;
- taOperandSize : Integer;
- taFont : TFont;
- taMaxTapeCount : Integer;
- taTapeInitialized : Boolean;
- taWidth : Integer;
-
- procedure ValidateListBox;
- function GetFont : TFont;
- procedure SetFont(const Value : TFont);
- function GetHeight : Integer;
- procedure SetHeight(const Value : Integer);
- function GetTape : TStrings;
- procedure SetTape(const Value : TStrings);
- function GetTapeColor : TColor;
- procedure SetTapeColor(const Value : TColor);
- function GetTop : Integer;
- procedure SetTop(const Value : Integer);
- function GetTopIndex : Integer;
- procedure SetTopIndex(const Value : Integer);
- function GetVisible : Boolean;
- procedure SetVisible(const Value : Boolean);
- function GetWidth : Integer;
- procedure SetWidth(const Value : Integer);
-
- protected
- procedure Add(const Value : string);
- procedure DeleteFirst;
- procedure taOnClick(Sender : TObject);
- procedure taOnDblClick(Sender : TObject);
- procedure taOnDrawItem(Control: TWinControl; Index: Integer;
- Rect:TRect;State: TOwnerDrawState);
- procedure taTapeFontChange(Sender : TObject);
-
- public
- constructor Create(const AOwner : TComponent; const AOperandSize : Integer);
- destructor Destroy;
- override;
-
- procedure InitializeTape;
- procedure SetBounds(const ALeft, ATop, AWidth, AHeight : Integer);
- function GetDisplayedItemCount : Integer;
- procedure AddToTape(const Value : string;
- const OpString : string);
- procedure AddToTapeLeft(const Value : string);
- procedure ClearTape;
- procedure RefreshDisplays;
- procedure SpaceTape(const Value : char);
-
- property Font : TFont
- read GetFont write SetFont;
- property Height : Integer
- read GetHeight write SetHeight;
- property MaxPaperCount : Integer
- read FMaxPaperCount write FMaxPaperCount;
- property ShowTape : Boolean
- read FShowTape write FShowTape;
- property Tape : TStrings
- read GetTape write SetTape;
- property TapeColor : TColor
- read GetTapeColor write SetTapeColor;
- property TapeDisplaySpace : Integer
- read FTapeDisplaySpace write FTapeDisplaySpace;
- property Top : Integer
- read GetTop write SetTop;
- property TopIndex : Integer
- read GetTopIndex write SetTopIndex;
- property Visible : Boolean
- read GetVisible write SetVisible;
- property Width : Integer
- read GetWidth write SetWidth;
- end;
- {.Z-}
-
-type
- TOvcCalcButtonPressedEvent =
- procedure(Sender : TObject; Button : TOvcCalculatorButton)
- of object;
-
- TOvcCalculatorOption = (coShowItemCount, coShowMemoryButtons,
- coShowClearTapeButton, coShowTape, coShowSeparatePercent);
- TOvcCalculatorOptions = set of TOvcCalculatorOption;
-
- TOvcCustomCalculator = class(TOvcCustomControl)
- {.Z+}
- protected {private}
- {property variables}
- FBorderStyle : TBorderStyle;
- FColors : TOvcCalcColors;
- FDisplay : Extended; {the calculated value}
- FDisplayStr : string; {the string that is displayed}
- FLastOperand : Extended;
- FOptions : TOvcCalculatorOptions;
- FTapeSeparatorChar : Char;
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
-
- {event variables}
- FOnButtonPressed : TOvcCalcButtonPressedEvent;
-
- {internal variables}
- cButtons : TOvcButtonArray;
- cDecimalEntered : Boolean;
- cDownButton : TOvcCalculatorButton;
- cHitTest : TPoint; {location of mouse cursor}
- cLastButton : TOvcCalculatorButton;
- cMargin : Integer;
- cMinus0 : Boolean;
- cOverBar : Boolean;
- cPanel : TOvcCalcPanel;
- cPopup : Boolean; {true if being created as a popup}
- cScrBarWidth : Integer;
- cSizeOffset : Integer; { the offset of the sizing line }
- cSizing : Boolean; { Are we showing the sizing cursor? }
- cTabCursor : HCursor; {design-time tab slecting cursor handle}
- cTape : TOvcCalcTape;
- cEngine : TOvcCustomCalculatorEngine;
-
- {internal methods}
- procedure cAdjustHeight;
- procedure cCalculateLook;
- procedure cClearAll;
- procedure cColorChange(Sender : TObject);
- procedure cDisplayError;
- procedure cDrawCalcButton(const Button : TOvcButtonInfo; const Pressed : Boolean);
- procedure cDrawFocusState;
- procedure cDrawSizeLine;
- procedure cEvaluate(const Button : TOvcCalculatorButton);
- function cFormatString(const Value : Extended) : string;
- function cGetFontWidth : Integer;
- procedure cInvalidateIndicator;
- procedure cRefreshDisplays;
- procedure cSetDisplayString(const Value : string);
- procedure cTapeFontChange(Sender : TObject);
-
- {property methods}
- function GetDecimals : Integer;
- function GetMaxPaperCount : Integer;
- function GetMemory : Extended;
- function GetOperand : Extended;
- function GetTape : TStrings;
- function GetTapeFont : TFont;
- function GetTapeHeight : Integer;
- function GetVisible : Boolean;
- procedure SetBorderStyle(const Value : TBorderStyle);
- procedure SetDecimals(const Value : Integer);
- procedure SetDisplay(const Value : Extended);
- procedure SetDisplayStr(const Value : string);
- procedure SetMaxPaperCount(const Value : Integer);
- procedure SetMemory(const Value : Extended);
- procedure SetOperand(const Value : Extended);
- procedure SetOptions(const Value : TOvcCalculatorOptions);
- procedure SetTape(const Value : TStrings);
- procedure SetTapeFont(const Value : TFont);
- procedure SetTapeHeight(const Value : Integer);
- procedure SetVisible(const Value : Boolean);
-
- {VCL control methods}
-{$IFNDEF LCL}
- procedure CMCtl3DChanged(var Msg : TMessage);
- message CM_CTL3DCHANGED;
-{$ENDIF}
- procedure CMDesignHitTest(var Msg : TCMDesignHitTest);
- message CM_DESIGNHITTEST;
- procedure CMEnter(var Msg : TMessage);
- message CM_ENTER;
- procedure CMExit(var Msg : TMessage);
- message CM_EXIT;
- procedure CMFontChanged(var Msg : TMessage);
- message CM_FONTCHANGED;
-
- {windows message handlers}
- procedure WMCancelMode(var Msg : TMessage);
- message WM_CANCELMODE;
- procedure WMEraseBkgnd(var Msg : TWMEraseBkgnd);
- message WM_ERASEBKGND;
- procedure WMGetText(var Msg : TWMGetText);
- message WM_GETTEXT;
- procedure WMGetTextLength(var Msg : TWMGetTextLength);
- message WM_GETTEXTLENGTH;
- procedure WMKeyDown(var Msg : TWMKeyDown);
- message WM_KEYDOWN;
- procedure WMKillFocus(var Msg : TWMKillFocus);
- message WM_KILLFOCUS;
- procedure WMLButtonDown(var Msg : TWMMouse);
- message WM_LBUTTONDOWN;
- procedure WMLButtonUp(var Msg : TWMMouse);
- message WM_LBUTTONUP;
- procedure WMMouseMove(var Msg : TWMMouse);
- message WM_MOUSEMOVE;
- procedure WMNCHitTest(var Msg : TWMNCHitTest);
- message WM_NCHITTEST;
- procedure WMSetText(var Msg : TWMSetText);
- message WM_SETTEXT;
- procedure WMSetCursor(var Msg : TWMSetCursor);
- message WM_SETCURSOR;
-
- protected
- procedure CreateParams(var Params : TCreateParams);
- override;
- procedure CreateWnd;
- override;
- procedure KeyDown(var Key : Word; Shift : TShiftState);
- override;
- procedure MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
- override;
- procedure MouseUp(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
- override;
- procedure Paint;
- override;
- {.Z-}
-
- {protected properties}
- property BorderStyle : TBorderStyle
- read FBorderStyle write SetBorderStyle;
- property Colors : TOvcCalcColors
- read FColors write FColors;
- property Decimals : Integer
- read GetDecimals write SetDecimals;
- property MaxPaperCount : Integer
- read GetMaxPaperCount write SetMaxPaperCount;
- property Options : TOvcCalculatorOptions
- read FOptions write SetOptions;
- property TapeFont : TFont
- read GetTapeFont write SetTapeFont;
- property TapeHeight : Integer
- read GetTapeHeight write SetTapeHeight;
- property TapeSeparatorChar : Char
- read FTapeSeparatorChar write FTapeSeparatorChar;
- property Visible : Boolean
- read GetVisible write SetVisible;
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D;
-{$ENDIF}
-
- {protected events}
- property OnButtonPressed : TOvcCalcButtonPressedEvent
- read FOnButtonPressed write FOnButtonPressed;
-
- public
- {.Z+}
- constructor Create(AOwner : TComponent);
- override;
- constructor CreateEx(AOwner : TComponent; AsPopup : Boolean);
- virtual;
- destructor Destroy;
- override;
- procedure KeyPress(var Key : Char);
- override;
- procedure PushOperand(const Value : Extended);
- procedure SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
- override;
- {.Z-}
-
- procedure CopyToClipboard;
- procedure PasteFromClipboard;
- procedure PressButton(Button : TOvcCalculatorButton);
-
- {public properties}
- property LastOperand : Extended
- read FLastOperand write FLastOperand;
- property Memory : Extended
- read GetMemory write SetMemory;
- property Operand : Extended
- read GetOperand write SetOperand;
- property DisplayStr : string
- read FDisplayStr write SetDisplayStr;
- property DisplayValue : Extended
- read FDisplay write SetDisplay;
- property Tape : TStrings
- read GetTape write SetTape;
- end;
-
- TOvcCalculator = class(TOvcCustomCalculator)
- published
- {properties}
- {$IFDEF VERSION4}
- property Anchors;
- property Constraints;
- property DragKind;
- {$ENDIF}
- property About;
- property Align;
- property BorderStyle default bsNone;
- property Ctl3D;
- property Font; {must be prior to "Colors"}
- property TapeFont; {must be prior to "Colors"}
- property Colors;
- property Cursor;
- property Decimals;
- property DragCursor;
- property DragMode;
- property Enabled;
- property LabelInfo;
- property MaxPaperCount default 9999;
- property TapeHeight ; {Must be Prior to Options}
- property Options default [coShowMemoryButtons, coShowItemCount];
-{$IFNDEF LCL}
- property ParentCtl3D;
-{$ENDIF}
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ShowHint;
- property TabOrder;
- property TabStop default True;
- property TapeSeparatorChar default '_';
- property Visible default True;
-
- {events}
- property OnButtonPressed;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnMouseWheel;
- property OnStartDrag;
- end;
-
-
-implementation
-
-const
- calcDefMinSize = 30;
-
-
-{*** TOvcCalcColors ***}
-
-procedure TOvcCalcColors.Assign(Source : TPersistent);
-begin
- if Source is TOvcCalcColors then begin
- FCalcColors := TOvcCalcColors(Source).FCalcColors;
- FColorScheme := TOvcCalcColors(Source).FColorScheme;
- FOnChange := TOvcCalcColors(Source).FOnChange;
- end else
- inherited Assign(Source);
-end;
-
-procedure TOvcCalcColors.BeginUpdate;
-begin
- FUpdating := True;
-end;
-
-procedure TOvcCalcColors.EndUpdate;
-begin
- FUpdating := False;
- DoOnChange;
-end;
-
-procedure TOvcCalcColors.DoOnChange;
-begin
- if not FUpdating and Assigned(FOnChange) then
- FOnChange(Self);
-
- if not SettingScheme then
- FColorScheme := cscalcCustom;
-end;
-
-function TOvcCalcColors.GetColor(const Index : Integer) : TColor;
-begin
- Result := FCalcColors[Index];
-end;
-
-procedure TOvcCalcColors.SetColor(const Index : Integer; const Value : TColor);
-begin
- if Value <> FCalcColors[Index] then begin
- FCalcColors[Index] := Value;
- DoOnChange;
- end;
-end;
-
-procedure TOvcCalcColors.SetColorScheme(const Value : TOvcCalcColorScheme);
-begin
- if Value <> FColorScheme then begin
- SettingScheme := True;
- try
- FColorScheme := Value;
- if Value <> cscalcCustom then begin
- FCalcColors := CalcScheme[Value];
- DoOnChange;
- end;
- finally
- SettingScheme := False;
- end;
- end;
-end;
-
-procedure TOvcCalcColors.SetDisplayTextColor(const Value : TColor);
-begin
- if Value <> FCalcColors[2] then begin
- FCalcColors[2] := Value;
- DoOnChange;
- end;
-end;
-
-
-{*** TOvcCalcTape ***}
-
-constructor TOvcCalcTape.Create(const AOwner : TComponent; const AOperandSize : Integer);
-begin
- inherited Create;
- taOwner := AOwner;
- FVisible := False;
- taOperandSize := AOperandSize;
- taFont := TFont.Create;
- taFont.Name := 'Courier New';
- taFont.Size := 10;
- taFont.Style := [];
-end;
-
-destructor TOvcCalcTape.Destroy;
-begin
- taFont.Free;
- taFont := nil;
-
- inherited Destroy;
-end;
-
-procedure TOvcCalcTape.ValidateListBox;
-begin
- if not Assigned(taListBox) then begin
- taListBox := TListBox.Create(taOwner);
- with taListBox do begin
- OnClick := taOnClick;
- OnDblClick := taOnDblClick;
- OnDrawItem := taOnDrawItem;
- Style := lbOwnerDrawFixed;
- Parent := taOwner as TWinControl;
- ParentFont := False;
-{$IFNDEF LCL}
- ParentCtl3D := True;
-{$ENDIF}
- BorderStyle := bsSingle;
- Color := taTapeColor;
- Visible := FVisible;
- Width := taWidth;
- Height := taHeight;
- Font.Assign(taFont);
- Font.OnChange := taFont.OnChange;
- taFont.OnChange := taTapeFontChange;
- TabStop := False;
- end;
- taTapeInitialized := False;
- end;
- InitializeTape;
-end;
-
-procedure TOvcCalcTape.Add(const Value : string);
-begin
- ValidateListBox;
- taListBox.Items.Add(Value);
-end;
-
-procedure TOvcCalcTape.DeleteFirst;
-begin
- ValidateListBox;
- with taListBox, Items do
- if Strings[0] = '' then
- taListBox.Items.Delete(0)
- else
- Inc(taMaxTapeCount);
-end;
-
-procedure TOvcCalcTape.SetFont(const Value : TFont);
-begin
- taFont.Assign(Value);
- taFont.OnChange(Self);
-end;
-
-function TOvcCalcTape.GetFont : TFont;
-begin
- Result := taFont;
-end;
-
-procedure TOvcCalcTape.SetHeight(const Value : Integer);
-begin
- taHeight := Value;
- if Visible then begin
- ValidateListBox;
- taListBox.Height := Value;
- end;
-end;
-
-function TOvcCalcTape.GetHeight : Integer;
-begin
- if Visible then begin
- ValidateListBox;
- Result := taListBox.Height;
- end else
- Result := taHeight;
-end;
-
-function TOvcCalcTape.GetTape : TStrings;
-begin
- ValidateListBox;
- Result := taListBox.Items;
-end;
-
-procedure TOvcCalcTape.SetTape(const Value : TStrings);
-begin
- ValidateListBox;
- taListBox.Items.Assign(Value);
-end;
-
-function TOvcCalcTape.GetTapeColor : TColor;
-begin
- if Visible then begin
- ValidateListBox;
- Result := taListBox.Color;
- end else
- Result := taTapeColor;
-end;
-
-procedure TOvcCalcTape.SetTapeColor(const Value : TColor);
-begin
- taTapeColor := Value;
- if Visible then begin
- ValidateListBox;
- taListBox.Color := Value;
- end;
-end;
-
-procedure TOvcCalcTape.SetTop(const Value : Integer);
-begin
- ValidateListBox;
- taListBox.Top := Value;
-end;
-
-function TOvcCalcTape.GetTop : Integer;
-begin
- ValidateListBox;
- Result := taListBox.Top;
-end;
-
-function TOvcCalcTape.GetVisible : Boolean;
-begin
- Result := FVisible;
-end;
-
-procedure TOvcCalcTape.SetVisible(const Value : Boolean);
-begin
- FVisible := Value;
- if Assigned(taListBox) then begin
- if not Value and taListBox.Visible then begin
- if csDesigning in taListBox.Owner.ComponentState then begin
- {$IFDEF VERSION4}
- taListBox.Visible := Value;
- taListBox.Height := 0;
- {$ELSE}
- taListBox.Free;
- taListBox := nil;
- {$ENDIF}
- end else
- taListBox.Visible := Value;
- end else if Value and not taListBox.Visible then begin
- taListBox.Visible := Value;
- {$IFDEF VERSION4}
- taListBox.Height := taHeight;
- {$ENDIF}
- end;
- end else if Value then begin
- ValidateListBox;
- taListBox.Visible := Value;
- end;
-end;
-
-procedure TOvcCalcTape.SetWidth(const Value : Integer);
-begin
- taWidth := Value;
- if Visible then begin
- ValidateListBox;
- taListBox.Width := Value;
- end;
-end;
-
-function TOvcCalcTape.GetWidth : Integer;
-begin
- if Visible then begin
- ValidateListBox;
- Result := taListBox.Width;
- end else
- Result := taWidth;
-end;
-
-procedure TOvcCalcTape.SetTopIndex(const Value : Integer);
-begin
- ValidateListBox;
- taListBox.TopIndex := Value;
-end;
-
-function TOvcCalcTape.GetTopIndex : Integer;
-begin
- ValidateListBox;
- Result := taListBox.TopIndex;
-end;
-
-procedure TOvcCalcTape.SetBounds(const ALeft, ATop, AWidth, AHeight : Integer);
-begin
- ValidateListBox;
- taListBox.SetBounds(ALeft, ATop, AWidth, AHeight);
-end;
-
-procedure TOvcCalcTape.InitializeTape;
-begin
- if not Assigned(taListBox) then
- Exit;
- if csDesigning in taListBox.Owner.ComponentState then
- if not taListBox.HandleAllocated then
- Exit;
- if taTapeInitialized then
- Exit;
- ClearTape;
- taTapeInitialized := True;
-end;
-
-procedure TOvcCalcTape.taOnClick(Sender : TObject);
-begin
- ValidateListBox;
- (taListBox.Owner as TOvcCustomCalculator).SetFocus;
-end;
-
-procedure TOvcCalcTape.taOnDblClick(Sender : TObject);
-var
- Str : string;
-begin
- ValidateListBox;
- if (taListBox.Items.Count < 1) then
- Exit;
- Str := taListBox.Items.Strings[taListBox.ItemIndex];
- try
- if (Str[1] = '0') and
- (Str[2] <> '.') then
- Exit;
- if taListBox.Items.Strings[taListBox.ItemIndex] <> '' then begin
- (taListBox.Owner as TOvcCustomCalculator).DisplayValue :=
- StrToFloat(Copy(Str,1, Length(Str) - taOperandSize));
- (taListBox.Owner as TOvcCustomCalculator).LastOperand :=
- StrToFloat(Copy(Str,1, Length(Str) - taOperandSize));
- (taListBox.Owner as TOvcCustomCalculator).Operand :=
- StrToFloat(Copy(Str,1, Length(Str) - taOperandSize));
- (taListBox.Owner as TOvcCustomCalculator).DisplayStr :=
- Copy(Str,1, Length(Str) - taOperandSize);
- (taListBox.Owner as TOvcCustomCalculator).SetFocus;
- end;
- except
- end;
-end;
-
-procedure TOvcCalcTape.taOnDrawItem(Control: TWinControl; Index: Integer;
- Rect:TRect;State: TOwnerDrawState);
-var
- SaveColor : TColor;
- SaveBack : TColor;
- Str : String;
- I, FirstUsedIndex : Integer;
-begin
- FirstUsedIndex := 0;
- if Index > FMaxPaperCount then
- with (Control as TListBox) do begin
- for I := 0 to Index do begin
- if Items[I] <> '' then begin
- FirstUsedIndex := I;
- Break;
- end;
- end;
- end;
-
- Str := (Control as TListBox).Items[Index];
- with (Control as TListBox).Canvas do begin { draw on control canvas, not on the form }
- FillRect(Rect); { clear the rectangle }
-
- SaveColor := (Control as TListBox).Canvas.Font.Color;
- try
- SaveBack := (Control as TListBox).Canvas.Brush.Color;
- try
- if (Trim(Str) <> '') then begin
- if (Trim(Str)[1] = '-') then
- (Control as TListBox).Canvas.Font.Color := clRed;
- if FTapeDisplaySpace > Length(Str) then
- Str := Str + StringOfChar(' ', FTapeDisplaySpace - Length(Str));
- TextOut(Rect.Left, Rect.Top, Copy(Str, 1, Length(Str) - 1));
- if Index - FirstUsedIndex >= FMaxPaperCount then
- (Control as TListBox).Canvas.Brush.Color := clRed;
- TextOut(PenPos.X, PenPos.Y, Copy(Str, Length(Str), 1));
- end;
- finally
- (Control as TListBox).Canvas.Brush.Color := SaveBack;
- end;
- finally
- (Control as TListBox).Canvas.Font.Color := SaveColor;
- end;
- end;
-end;
-
-procedure TOvcCalcTape.taTapeFontChange(Sender : TObject);
-begin
- if Visible then begin
- taListBox.Font.Assign(taFont);
- taListBox.Font.OnChange(Sender);
- end;
-end;
-
-function TOvcCalcTape.GetDisplayedItemCount : Integer;
-var
- DC : hDC;
- SaveFont : hFont;
- Size : TSize;
-begin
- if not Assigned(taListBox) then begin
- Result := 0;
- Exit;
- end;
-
- DC := GetDC(0);
- SaveFont := SelectObject(DC, taListBox.Font.Handle);
- GetTextExtentPoint(DC, ' 0123456789', 11, Size);
- Result := taListBox.ClientHeight div Size.cy;
- if Result < 3 then
- Result := 3;
- SelectObject(DC, SaveFont);
- ReleaseDC(0, DC);
-end;
-
-procedure TOvcCalcTape.AddToTape(const Value : string; const OpString : string);
- {-adds an operand to the tape display}
-var
- TapeString : string;
- DSpace : Integer;
-begin
- DSpace := FTapeDisplaySpace - Length(Value);
- TapeString := StringOfChar(' ', DSpace - taOperandSize);
- TapeString := TapeString + Value + ' ' + OpString;
- Add(TapeString);
- DeleteFirst;
- TopIndex := taMaxTapeCount - GetDisplayedItemCount + 2;
-end;
-
-{adds an operand to the tape display}
-procedure TOvcCalcTape.AddToTapeLeft(const Value : string);
-var
- TapeString : string;
- DSpace : Integer;
-begin
- DSpace := FTapeDisplaySpace - Length(Value);
- TapeString := StringOfChar(' ', DSpace);
- TapeString := Value + TapeString;
- Add(Value);
- DeleteFirst;
- TopIndex := taMaxTapeCount - GetDisplayedItemCount + 2;
-end;
-
-procedure TOvcCalcTape.ClearTape;
-var
- I : Integer;
-begin
- if not Assigned(taListBox) then
- Exit;
- if csDesigning in taListBox.Owner.ComponentState then
- if not taListBox.HandleAllocated then
- Exit;
- taMaxTapeCount := 30; {set starting line count}
-
- taListBox.Items.Clear;
- for I := 0 to taMaxTapeCount - 1 do
- taListBox.Items.Add('');
- taListBox.TopIndex := taMaxTapeCount - GetDisplayedItemCount + 2;
-end;
-
-procedure TOvcCalcTape.RefreshDisplays;
-var
- I, Diff : Integer;
- S : string;
-
- function AllSame(const Str : string) : Boolean;
- var
- I : Integer;
- begin
- Result := True;
- for I := 2 to Length(Str) do begin
- if Str[1] <> Str[I] then
- Exit;
- end;
- end;
-
-begin
- if not Assigned(taListBox) then
- Exit;
- if not taListBox.HandleAllocated then
- Exit;
-
- if FShowTape then begin
- for I := 0 to taMaxTapeCount - 1 do begin
- S := taListBox.Items.Strings[I];
- if S <> '' then begin
- Diff := FTapeDisplaySpace - Length(S);
- if S[1] = ' ' then begin
- if Diff >= 0 then
- S := StringOfChar(' ', Diff) + S
- else if AllSame(copy(S, 1, -Diff)) then
- S := copy(S,-Diff + 1, Length(S));
- end else begin
- if AllSame(S) and (not (S[1] in ['0'..'9'])) then
- if Diff >= 0 then
- S := S + StringOfChar(S[1], Diff)
- else
- S := copy(S, 1, Length(S)-Diff + 1)
- else if (Diff >= 0) and not ((S[1] <> '0') or (S[2] <> '.')) then
- S := StringOfChar(' ', Diff) + S;
- end;
- taListBox.Items.Strings[I] := S;
- end;
- end;
- taListBox.TopIndex := taMaxTapeCount - GetDisplayedItemCount + 2;
- end;
-end;
-
-procedure TOvcCalcTape.SpaceTape(const Value : char);
-var
- TapeString : string;
-begin
- TapeString := StringOfChar(Value, FTapeDisplaySpace);
- Add(TapeString);
- DeleteFirst;
- TopIndex := taMaxTapeCount - GetDisplayedItemCount + 2;
-end;
-
-
-{*** TOvcCustomCalculatorEngine ***}
-
-procedure TOvcCustomCalculatorEngine.ClearAll;
-var
- I : Integer;
-begin
- for I := 0 to 3 do
- cOperands[I] := 0;
- cLastOperation := coNone;
- cOperationCount := 0;
- cState := [csValid, csClear];
-end;
-
-procedure TOvcCustomCalculatorEngine.PushOperand(const Value : Extended);
-var
- I : Integer;
-begin
- for I := 2 downto 0 do
- cOperands[I+1] := cOperands[I];
- cOperands[0] := Value;
-end;
-
-function TOvcCustomCalculatorEngine.PopOperand : Extended;
-var
- I : Integer;
-begin
- Result := cOperands[0];
- for I := 0 to 2 do
- cOperands[I] := cOperands[I+1];
- cOperands[3] := 0;
-end;
-
-function TOvcCustomCalculatorEngine.TopOperand : Extended;
-begin
- Result := cOperands[0];
-end;
-
-
-{*** TOvcBasicCalculatorEngine ***}
-type
- TOvcBasicCalculatorEngine = class(TOvcCustomCalculatorEngine)
- protected {private}
- {internal methods}
- procedure cEvaluate(const Operation : TOvcCalculatorOperation);
- public
- function AddOperand(const Value : Extended; const Button : TOvcCalculatorOperation) : Boolean;
- override;
- function AddOperation(const Button : TOvcCalculatorOperation) : Boolean;
- override;
- end;
-
-function TOvcBasicCalculatorEngine.AddOperand(
- const Value : Extended;
- const Button : TOvcCalculatorOperation) : Boolean;
-var
- I : Integer;
-begin
- Result := False;
- if Button <> coNone then begin
- if csValid in cState then begin
- Result := True;
- for I := 2 downto 0 do
- cOperands[I+1] := cOperands[I];
- cOperands[0] := Value;
- end;
- end;
-end;
-
-procedure TOvcBasicCalculatorEngine.cEvaluate(const Operation : TOvcCalculatorOperation);
-begin
- if csValid in cState then begin
- {evaluate the expression}
- case Operation of
- coAdd : begin
- cOperands[1] := cOperands[1] + cOperands[0];
- PopOperand;
- end;
- coSub : begin
- cOperands[1] := cOperands[1] - cOperands[0];
- PopOperand;
- end;
- coMul : begin
- cOperands[1] := cOperands[1] * cOperands[0];
- PopOperand;
- end;
- coDiv : begin
- cOperands[1] := cOperands[1] / cOperands[0];
- PopOperand;
- end;
- coEqual : ;
- coNone : ;
- coPercent : begin
- if cLastOperation in [coAdd, coSub] then
- cOperands[0] := (cOperands[0] / 100) * cOperands[1] {do markup/down}
- else
- cOperands[0] := cOperands[0] / 100; {as a percentage}
- cState := [csValid, csClear];
- end;
- coMemStore : begin
- cMemory := cOperands[0];
- Include(cState, csClear);
- end;
- coMemRecall : begin
- cOperands[0] := cMemory;
- cState := [csValid, csClear];
- end;
- coMemClear : begin
- cMemory := 0;
- end;
- coMemAdd,
- coMemSub : begin
- try
- if Operation = coMemAdd then
- cMemory := cMemory + cOperands[0]
- else
- cMemory := cMemory - cOperands[0];
- except
- cMemory := 0;
- end;
- Include(cState, csClear);
- end;
- coInvert : begin
- cOperands[0] := 1 / cOperands[0];
- end;
- coSqrt : begin
- cOperands[0] := Sqrt(cOperands[0]);
- end;
- end;
- end;
-end;
-
-function TOvcBasicCalculatorEngine.AddOperation(const Button : TOvcCalculatorOperation) : Boolean;
-begin
- Result := False;
- if csValid in cState then begin
- {evaluate the expression}
- case Button of
- coAdd : begin
- cEvaluate(cLastOperation);
- cState := [csValid, csClear];
- if cLastOperation in [coAdd, coSub] then
- Inc(cOperationCount)
- else
- cOperationCount := 1;
- cLastOperation := Button;
- Result := True;
- end;
- coSub : begin
- cEvaluate(cLastOperation);
- cState := [csValid, csClear];
- if cLastOperation in [coAdd, coSub] then
- Inc(cOperationCount)
- else
- cOperationCount := 1;
- cLastOperation := Button;
- Result := True;
- end;
- coMul : begin
- cEvaluate(cLastOperation);
- cState := [csValid, csClear];
- if cLastOperation = Button then
- cOperationCount := cOperationCount + 1
- else
- cOperationCount := 1;
- cLastOperation := Button;
- Result := True;
- end;
- coDiv : begin
- cEvaluate(cLastOperation);
- cState := [csValid, csClear];
- if cLastOperation = Button then
- cOperationCount := cOperationCount + 1
- else
- cOperationCount := 1;
- cLastOperation := Button;
- Result := True;
- end;
- coEqual : begin
- Include(cState, csClear);
- if cLastOperation <> coNone then begin
- cEvaluate(cLastOperation);
- cState := [csClear, csValid];
- if cLastOperation = coEqual then
- cLastOperation := coNone
- else
- cLastOperation := Button;
- end;
- Result := True;
- end;
- coNone : Result := True;
- coPercent : begin
- cEvaluate(Button);
- if not ShowSeparatePercent then begin
- cEvaluate(cLastOperation);
- cState := [csValid, csClear];
- if cLastOperation = Button then
- cOperationCount := cOperationCount + 1
- else
- cOperationCount := 0;
- cLastOperation := coEqual;
- Result := True;
- end else begin
- if cLastOperation = Button then
- cOperationCount := cOperationCount + 1
- else
- cOperationCount := 0;
- Result := True;
- end;
- end;
- coMemStore : begin
- cEvaluate(Button);
- end;
- coMemRecall : begin
- cEvaluate(Button);
- Result := True;
- end;
- coMemClear : begin
- cEvaluate(Button);
- end;
- coMemAdd,
- coMemSub : begin
- cEvaluate(Button);
- end;
- coInvert : begin
- cEvaluate(Button);
- Result := True;
- end;
- coSqrt : begin
- cEvaluate(Button);
- Result := True;
- end;
- end;
- end;
-end;
-
-
-{*** TOvcCalcPanel ***}
-
-procedure TOvcCalcPanel.Click;
-begin
- (Owner as TOvcCustomCalculator).SetFocus;
-end;
-
-
-{*** TOvcCustomCalculator ***}
-
-procedure TOvcCustomCalculator.cAdjustHeight;
-var
- DC : hDC;
- SaveFont : hFont;
- I : Integer;
- SysMetrics : TTextMetric;
- Metrics : TTextMetric;
-begin
- DC := GetDC(0);
- GetTextMetrics(DC, SysMetrics);
- SaveFont := SelectObject(DC, Font.Handle);
- GetTextMetrics(DC, Metrics);
- SelectObject(DC, SaveFont);
- ReleaseDC(0, DC);
- if NewStyleControls then begin
- if Ctl3D then
- I := 8
- else
- I := 6;
- I := GetSystemMetrics(SM_CYBORDER) * I;
- end else begin
- I := SysMetrics.tmHeight;
- if I > Metrics.tmHeight then
- I := Metrics.tmHeight;
- I := I div 4 + GetSystemMetrics(SM_CYBORDER) * 4;
- end;
- cPanel.Height := Metrics.tmHeight + I;
-end;
-
-procedure TOvcCustomCalculator.cCalculateLook;
-var
- CW : Integer; {client width}
- BW : Integer; {button width}
- BH : Integer; {button height}
- LBW : Integer; {large button width}
- M1 : Integer; {margin between buttons}
- M2 : Integer; {left and right edge margins}
- M3 : Integer; {margin between panel and frst row of buttons}
- M4 : Integer; {margin between memory buttons and other buttons}
- TM : Integer; {area where the panel is placed}
- X : Integer;
- Y : Integer;
- PW : Integer; {panel width}
- B : TOvcCalculatorButton;
-begin
- if not HandleAllocated then
- Exit;
-
- {set panel height based on font}
- cAdjustHeight;
-
- for B := Low(cButtons) to High(cButtons) do
- cButtons[B].Visible := True;
-
- CW := ClientWidth;
-
- if Width <= 200 then begin
- M1 := 2;
- M2 := 4;
- end else begin
- M1 := 4;
- M2 := 6;
- end;
- {save left/right/top/bottom margin value}
- cMargin := M2;
-
- M4 := M2;
- if coShowMemoryButtons in FOptions then begin
- BW := (CW - 3*M2 - 4*M1) div 6;
- M4 := CW - 2*M2 - 6*BW - 4*M1;
- end else begin
- BW := (CW - 2*M2 - 4*M1) div 5;
- if (CW - 2*M2 - 4*M1) div 6 >= 4 then
- Inc(M2, 2)
- else if (CW - 2*M2 - 4*M1) div 6 >= 2 then
- Inc(M2, 1);
- end;
-
- {button height, using an estimate for TM}
- TM := M2 + M2 + cPanel.Height;
-
- if coShowTape in FOptions then
- TM := TM + M2 + cTape.Height;
-
- BH := (ClientHeight - TM - M2 - 4*M1) div 5;
-
- {calculate actual area below panel}
- M3 := ClientHeight - M2 - cPanel.Height - 5*BH - 4*M1 - M2;
-
- {calculate actual height of area above buttons}
- TM := M2 + M3 + cPanel.Height;
-
- {large button width}
- if coShowClearTapeButton in FOptions then
- LBW := (5*BW + 3*M1 - 2*M1) div 4
- else
- LBW := (4*BW + 3*M1 - 2*M1) div 3;
-
- {calculate the width of the edit window}
- cMargin := M2;
- if coShowMemoryButtons in FOptions then
- PW := 6*BW + M4 + 4*M1
- else
- PW := 5*BW + 4*M1;
-
- if coShowTape in FOptions then
- PW := PW - cScrBarWidth;
-
-
- {position tape display and edit panel}
- if coShowTape in FOptions then begin
- cTape.Visible := True;
- cTape.SetBounds(cMargin, cMargin, PW + cScrBarWidth, cTape.Height);
- cPanel.SetBounds(cMargin + 2, cTape.Height + M2 +
- cMargin, PW, cPanel.Height);
- end else begin
- cTape.Visible := False;
- cPanel.SetBounds(cMargin, cMargin, PW, cPanel.Height);
- end;
-
- {calculate # of characters required to fill display space}
- {"FontWidth div 2" makes sure there is no cut off charaters}
- if coShowTape in FOptions then
- cTape.TapeDisplaySpace := (cTape.Width - cScrBarWidth - (cGetFontWidth div 2))
- div cGetFontWidth
- else
- cTape.TapeDisplaySpace := (cPanel.Width - (cGetFontWidth div 2)) div cGetFontWidth;
-
- cTape.InitializeTape;
-
- {redraw the edit panel and Tape}
- cRefreshDisplays;
-
- {memory column}
- if coShowMemoryButtons in FOptions then begin
- X := M2;
- Y := TM;
- cButtons[cbMemClear].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbMemClear].Caption := GetOrphStr(SCCalcMC);
-
- Y := TM + BH + M1;
- cButtons[cbMemRecall].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbMemRecall].Caption := GetOrphStr(SCCalcMR);
-
- Y := TM + 2*BH + 2*M1;
- cButtons[cbMemStore].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbMemStore].Caption := GetOrphStr(SCCalcMS);
-
- Y := TM + 3*BH + 3*M1;
- cButtons[cbMemAdd].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbMemAdd].Caption := GetOrphStr(SCCalcMPlus);
-
- Y := TM + 4*BH + 4*M1;
- cButtons[cbMemSub].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbMemSub].Caption := GetOrphStr(SCCalcMMinus);
- end else
- for B := cbMemClear to cbMemSub do
- cButtons[B].Visible := False;
-
- {row 1 - large buttons}
- Y := TM;
- if coShowMemoryButtons in FOptions then
- if coShowClearTapeButton in FOptions then
- X := BW + M2 + M4
- else
- X := 2*BW + M4 + M2 + M1
- else
- if coShowClearTapeButton in FOptions then
- X := M2
- else
- X := BW + M2 + M1;
-
- cButtons[cbTape].Position := Rect(X, Y, X+LBW, Y+BH);
- cButtons[cbTape].Caption := GetOrphStr(SCCalcCT);
-
- if coShowClearTapeButton in FOptions then begin
- cButtons[cbTape].Visible := True;
- Inc(X, LBW+M1);
- if ((BW+M1)*5 - (LBW+M1)*4) >= 3 then
- Inc(X, 1);
- end else begin
- cButtons[cbTape].Visible := False;
- end;
-
- cButtons[cbBack].Position := Rect(X, Y, X+LBW, Y+BH);
- cButtons[cbBack].Caption := GetOrphStr(SCCalcBack);
-
- Inc(X, LBW+M1);
- if coShowClearTapeButton in FOptions then begin
- if ((BW+M1)*5 - (LBW+M1)*4) >= 2 then
- Inc(X, 1);
- end else begin
- if ((BW+M1)*4 - (LBW+M1)*3) >= 2 then
- Inc(X, 1);
- end;
- cButtons[cbClearEntry].Position := Rect(X, Y, X+LBW, Y+BH);
- cButtons[cbClearEntry].Caption := GetOrphStr(SCCalcCE);
-
- Inc(X, LBW+M1);
- if coShowClearTapeButton in FOptions then begin
- if ((BW+M1)*5 - (LBW+M1)*4) >= 1 then
- Inc(X, 1);
- end else begin
- if ((BW+M1)*4 - (LBW+M1)*3) >= 1 then
- Inc(X, 1);
- end;
- cButtons[cbClear].Position := Rect(X, Y, X+LBW, Y+BH);
- cButtons[cbClear].Caption := GetOrphStr(SCCalcC);
-
- {row 2}
- Y := TM + BH + M1;
- if coShowMemoryButtons in FOptions then
- X := M2 + BW + M4
- else
- X := M2;
- cButtons[cb7].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cb7].Caption := '7';
-
- Inc(X, BW+M1);
- cButtons[cb8].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cb8].Caption := '8';
-
- Inc(X, BW+M1);
- cButtons[cb9].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cb9].Caption := '9';
-
- Inc(X, BW+M1);
- cButtons[cbDiv].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbDiv].Caption := '/';
-
- Inc(X, BW+M1);
- cButtons[cbSqrt].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbSqrt].Caption := GetOrphStr(SCCalcSqrt);
-
- {row 3}
- Y := TM + 2*BH + 2*M1;
- if coShowMemoryButtons in FOptions then
- X := M2 + BW + M4
- else
- X := M2;
- cButtons[cb4].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cb4].Caption := '4';
-
- Inc(X, BW+M1);
- cButtons[cb5].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cb5].Caption := '5';
-
- Inc(X, BW+M1);
- cButtons[cb6].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cb6].Caption := '6';
-
- Inc(X, BW+M1);
- cButtons[cbMul].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbMul].Caption := '*';
-
- Inc(X, BW+M1);
- cButtons[cbPercent].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbPercent].Caption := '%';
-
- {row 4}
- Y := TM + 3*BH + 3*M1;
- if coShowMemoryButtons in FOptions then
- X := M2 + BW + M4
- else
- X := M2;
- cButtons[cb1].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cb1].Caption := '1';
-
- Inc(X, BW+M1);
- cButtons[cb2].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cb2].Caption := '2';
-
- Inc(X, BW+M1);
- cButtons[cb3].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cb3].Caption := '3';
-
- Inc(X, BW+M1);
- cButtons[cbSub].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbSub].Caption := '-';
-
- Inc(X, BW+M1);
- cButtons[cbInvert].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbInvert].Caption := '1/x';
-
- {row 5}
- Y := TM + 4*BH + 4*M1;
- if coShowMemoryButtons in FOptions then
- X := M2 + BW + M4
- else
- X := M2;
- cButtons[cb0].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cb0].Caption := '0';
-
- Inc(X, BW+M1);
- cButtons[cbChangeSign].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbChangeSign].Caption := '+/-';
-
- Inc(X, BW+M1);
- cButtons[cbDecimal].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbDecimal].Caption := DecimalSeparator;
-
- Inc(X, BW+M1);
- cButtons[cbAdd].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbAdd].Caption := '+';
-
- Inc(X, BW+M1);
- cButtons[cbEqual].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbEqual].Caption := '=';
-end;
-
-procedure TOvcCustomCalculator.cClearAll;
-begin
- if not HandleAllocated then
- Exit;
-
- cEngine.ClearAll;
- FLastOperand := 0;
- DisplayValue := 0;
- FDisplayStr := '0';
- cMinus0 := False;
- cTape.InitializeTape;
- cPanel.Caption := StringOfChar(' ',
- (cTape.TapeDisplaySpace
- - Length('0')
- - Length(CalcDisplayString[cbNone]))
- ) + '0' + ' ';
-end;
-
-procedure TOvcCustomCalculator.cColorChange(Sender : TObject);
-begin
- {update panel background color}
- if Assigned(cPanel) then begin
- cPanel.Color := FColors.Display;
- cPanel.Font.Color := FColors.DisplayTextColor;
- {update the main font color}
- if not (csLoading in ComponentState) and (Font <> nil) then
- Font.Color := FColors.DisplayTextColor;
- end;
-
- if Assigned(cTape) then begin
- cTape.TapeColor := FColors.Display;
- end;
-
- Invalidate;
-end;
-
-procedure TOvcCustomCalculator.cDisplayError;
-begin
- cSetDisplayString('****** ');
- cEngine.State := [csLocked]; {user will have to clear this}
- MessageBeep(0);
-end;
-
-procedure TOvcCustomCalculator.cDrawCalcButton(const Button : TOvcButtonInfo; const Pressed : Boolean);
-var
- TR : TRect;
- Buf : array[0..255] of Char;
-begin
- if Button.Visible then begin
- TR := DrawButtonFace(Canvas, Button.Position, 1, bsNew, False, Pressed, False);
- StrPLCopy(Buf, Button.Caption, 255);
- DrawText(Canvas.Handle, Buf, StrLen(Buf), TR,
- DT_CENTER or DT_VCENTER or DT_SINGLELINE);
-
- if Focused and (Button.Caption = '=') then
- cDrawFocusState;
- end;
-end;
-
-procedure TOvcCustomCalculator.cDrawFocusState;
-var
- R : TRect;
-begin
- R := cButtons[cbEqual].Position;
- InflateRect(R, -3, -3);
-{$IFNDEF LCL}
- Canvas.DrawFocusRect(R);
-{$ENDIF}
-end;
-
-procedure TOvcCustomCalculator.cDrawSizeLine;
-var
- OldPen : TPen;
-begin
- if (cSizing) then
- with Canvas do begin
- OldPen := TPen.Create;
- try
- OldPen.Assign(Pen);
- Pen.Color := clBlack;
- Pen.Mode := pmXor;
- Pen.Style := psDot;
- Pen.Width := 1;
- MoveTo(0, cSizeOffset);
- LineTo(ClientWidth, cSizeOffset);
- finally
- Canvas.Pen := OldPen;
- OldPen.Free;
- end;
- end;
-end;
-
-procedure TOvcCustomCalculator.cEvaluate(const Button : TOvcCalculatorButton);
-begin
- if csValid in cEngine.State then begin
- try
- {evaluate the expression}
- if cEngine.AddOperation(CalcButtontoOperation[Button]) then begin
- DisplayValue := cEngine.TopOperand;
- if Button in [cbAdd, cbSub, cbMul, cbDiv, cbEqual, cbPercent, cbNone] then
- if (Button in [cbAdd, cbSub, cbMul, cbDiv]) and (cLastButton = Button) then
- cTape.AddToTape(cFormatString(LastOperand), CalcDisplayString[Button])
- else
- cTape.AddToTape(FDisplayStr, CalcDisplayString[Button]);
- if (Button = cbEqual) and (cEngine.LastOperation = coEqual) then begin
- if coShowItemCount in FOptions then
- cTape.AddToTapeLeft(Format('%3.3d',[cEngine.OperationCount+1]));
- cTape.AddToTape(cFormatString(DisplayValue), CalcDisplayString[cbSubTotal]);
- cTape.SpaceTape(TapeSeparatorChar);
- end;
- FDisplayStr := cFormatString(DisplayValue);
- end;
- except
- cDisplayError;
- end;
- end;
-end;
-
-function TOvcCustomCalculator.cFormatString(const Value : Extended) : string;
-begin
- if cEngine.Decimals = 0 then
- Result := Format('%g',[Value])
- else if cEngine.Decimals < 0 then
- Result := Format('%.*f',[-cEngine.Decimals, Value])
- else
- Result := Format('%.*f',[cEngine.Decimals, Value]);
-end;
-
-function TOvcCustomCalculator.cGetFontWidth : Integer;
-var
- DC : hDC;
- SaveFont : hFont;
- Size : TSize;
-begin
- if not assigned(cPanel) then begin
- Result := 8; {Return something resonable }
- Exit;
- end;
- DC := GetDC(0);
- SaveFont := SelectObject(DC, cPanel.Font.Handle);
- GetTextExtentPoint(DC, ' 0123456789', 11, Size);
- Result := Round(Size.cx/11);
- SelectObject(DC, SaveFont);
- ReleaseDC(0, DC);
-end;
-
-procedure TOvcCustomCalculator.cInvalidateIndicator;
-begin
- InvalidateRect(Handle, @cButtons[cbMemRecall].Position, False);
- InvalidateRect(Handle, @cButtons[cbMemClear].Position, False);
-end;
-
-procedure TOvcCustomCalculator.cRefreshDisplays;
-begin
- if not cPanel.HandleAllocated then
- Exit;
-
- cTape.RefreshDisplays;
-{ DisplayValue := DisplayValue; }
-end;
-
-procedure TOvcCustomCalculator.cSetDisplayString(const Value : string);
-var
- DSpace : Integer;
-begin
- try
- if cPanel.HandleAllocated then begin
- DSpace := cTape.TapeDisplaySpace
- - Length(Value)
- - Length(CalcDisplayString[cbNone]);
- cPanel.Caption := StringOfChar(' ', DSpace) + Value + ' ';
- end;
- except
- cDisplayError;
- end;
-end;
-
-procedure TOvcCustomCalculator.cTapeFontChange(Sender : TObject);
-begin
- cPanel.Font := TapeFont;
-end;
-
-procedure TOvcCustomCalculator.SetBorderStyle(const Value : TBorderStyle);
-begin
- if Value <> FBorderStyle then begin
- FBorderStyle := Value;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- RecreateWnd(Self);
-{$ENDIF}
- end;
-end;
-
-function TOvcCustomCalculator.GetDecimals : Integer;
-begin
- Result := cEngine.Decimals;
-end;
-
-procedure TOvcCustomCalculator.SetDecimals(const Value : Integer);
-begin
- if Value <> cEngine.Decimals then begin
- cEngine.Decimals := Value;
- ccalculateLook;
- Invalidate;
- end;
-end;
-
-function TOvcCustomCalculator.GetMemory : Extended;
-begin
- Result := cEngine.Memory;
-end;
-
-procedure TOvcCustomCalculator.SetMemory(const Value : Extended);
-begin
- if Value <> cEngine.Memory then begin
- cEngine.Memory := Value;
- cCalculateLook;
- Invalidate;
- end;
-end;
-
-procedure TOvcCustomCalculator.SetMaxPaperCount(const Value : Integer);
-begin
- if Value <> cTape.MaxPaperCount then begin
- cTape.MaxPaperCount := Value;
- Invalidate;
- end;
-end;
-
-function TOvcCustomCalculator.GetMaxPaperCount : Integer;
-begin
- Result := cTape.MaxPaperCount;
-end;
-
-procedure TOvcCustomCalculator.SetOptions(const Value : TOvcCalculatorOptions);
-begin
- if Value <> FOptions then begin
- FOptions := Value;
-
-
- cTape.ShowTape := coShowTape in FOptions;
- cTape.Visible := coShowTape in FOptions;
- cEngine.ShowSeparatePercent := coShowSeparatePercent in FOptions;
-
- cCalculateLook;
- Invalidate;
- end;
-end;
-
-function TOvcCustomCalculator.GetTape : TStrings;
-begin
- Result := cTape.Tape;
-end;
-
-procedure TOvcCustomCalculator.SetTape(const Value : TStrings);
-begin
- cTape.Tape := Value;
-end;
-
-function TOvcCustomCalculator.GetTapeFont : TFont;
-begin
- Result := cTape.Font;
-end;
-
-procedure TOvcCustomCalculator.SetTapeFont(const Value : TFont);
-begin
- cTape.Font := Value;
-end;
-
-function TOvcCustomCalculator.GetTapeHeight : Integer;
-begin
- Result := cTape.Height;
-end;
-
-procedure TOvcCustomCalculator.SetTapeHeight(const Value : Integer);
-begin
- cTape.Height := Value;
- cCalculateLook;
- Invalidate;
-end;
-
-function TOvcCustomCalculator.GetVisible : Boolean;
-begin
- Result := inherited Visible;
-end;
-
-procedure TOvcCustomCalculator.SetVisible(const Value : Boolean);
-begin
- inherited Visible := Value;
-
- cTape.Visible := cTape.ShowTape;
-end;
-
-procedure TOvcCustomCalculator.SetDisplay(const Value : Extended);
-var
- ValueString : string;
-begin
- try
- FDisplay := Value;
- if cPanel.HandleAllocated then begin
- ValueString := cFormatString(Value);
- cSetDisplayString(ValueString);
- end;
- except
- cDisplayError;
- end;
-end;
-
-procedure TOvcCustomCalculator.SetDisplayStr(const Value : string);
-begin
- FDisplayStr := Value;
- while (Length(FDisplayStr) > 0) and (FDisplayStr[1] = ' ') do
- FDisplayStr := Copy(FDisplayStr, 2, Length(FDisplayStr) - 1);
-end;
-
-function TOvcCustomCalculator.GetOperand : Extended;
-begin
- Result := cEngine.TopOperand;
-end;
-
-procedure TOvcCustomCalculator.SetOperand(const Value : Extended);
-begin
- if Value = cEngine.TopOperand then
- Exit;
- cEngine.PushOperand(Value);
-end;
-
-{$IFNDEF LCL}
-procedure TOvcCustomCalculator.CMCtl3DChanged(var Msg : TMessage);
-begin
- inherited;
-
- if (csLoading in ComponentState) or not HandleAllocated then
- Exit;
-
- if NewStyleControls and (FBorderStyle = bsSingle) then
-{$IFNDEF LCL}
- RecreateWnd;
-{$ENDIF}
-
- Invalidate;
-end;
-{$ENDIF}
-
-procedure TOvcCustomCalculator.CMDesignHitTest(var Msg : TCMDesignHitTest);
-begin
- Msg.Result := LongInt(cOverBar);
-end;
-
-procedure TOvcCustomCalculator.CMEnter(var Msg : TMessage);
-var
- R : TRect;
-begin
- inherited;
-
- {invalidate the "=" button to ensure that the focus rect is painted}
- R := cButtons[cbEqual].Position;
- InvalidateRect(Handle, @R, False);
-end;
-
-procedure TOvcCustomCalculator.CMExit(var Msg : TMessage);
-var
- R : TRect;
-begin
- inherited;
-
- {invalidate the "=" button to ensure that the focus rect is painted}
- R := cButtons[cbEqual].Position;
- InvalidateRect(Handle, @R, False);
-end;
-
-procedure TOvcCustomCalculator.CMFontChanged(var Msg : TMessage);
-begin
- inherited;
-
- if not (csLoading in ComponentState) and Assigned(cPanel) then begin
- cPanel.Color := FColors.Display;
- cPanel.Font.Color := FColors.DisplayTextColor;
- FColors.FCalcColors[2] := Font.Color;
- end;
-
- cCalculateLook;
- Invalidate;
-end;
-
-procedure TOvcCustomCalculator.WMEraseBkgnd(var Msg : TWMEraseBkgnd);
-begin
- Msg.Result := 1; {don't erase background, just say we did}
-end;
-
-procedure TOvcCustomCalculator.WMGetText(var Msg : TWMGetText);
-begin
- if not cPanel.HandleAllocated then
- Exit;
-
- Msg.Result := SendMessage(cPanel.Handle, WM_GETTEXT,
- TMessage(Msg).wParam, TMessage(Msg).lParam);
-end;
-
-procedure TOvcCustomCalculator.WMGetTextLength(var Msg : TWMGetTextLength);
-begin
- if not cPanel.HandleAllocated then
- Exit;
-
- Msg.Result := SendMessage(cPanel.Handle, WM_GETTEXTLENGTH,
- TMessage(Msg).wParam, TMessage(Msg).lParam);
-end;
-
-procedure TOvcCustomCalculator.WMKeyDown(var Msg : TWMKeyDown);
-begin
- if Msg.CharCode = Ord('M') then begin
- if ({$IFNDEF LCL} GetAsyncKeyState(VK_CONTROL) {$ELSE} GetKeyState(VK_CONTROL) {$ENDIF} and $8000) <> 0 then begin
- PressButton(cbMemStore);
- end;
- end else if Msg.CharCode = VK_RETURN then
- PressButton(cbEqual);
-
- inherited;
-end;
-
-procedure TOvcCustomCalculator.WMSetText(var Msg : TWMSetText);
-var
- I : Integer;
- C : AnsiChar;
-begin
- cClearAll;
- for I := 0 to Pred(StrLen(Msg.Text)) do begin
- C := Msg.Text[I];
- KeyPress(C);
- end;
- Msg.Result := 1{true};
-end;
-
-procedure TOvcCustomCalculator.WMNCHitTest(var Msg : TWMNCHitTest);
-begin
- inherited;
-
- cHitTest.X := Msg.Pos.X;
- cHitTest.Y := Msg.Pos.Y;
-end;
-
-procedure TOvcCustomCalculator.WMSetCursor(var Msg : TWMSetCursor);
-var
- vHitTest : TPoint;
-
- procedure SetNewCursor(C : HCursor);
- begin
-{$IFNDEF LCL}
- SetCursor(C);
-{$ELSE}
- LclIntf.SetCursor(C); {Don't call control's SetCursor!}
-{$ENDIF}
- Msg.Result := Ord(True);
- end;
-
-begin
- if not (coShowTape in FOptions) then
- Exit;
-
- if csDesigning in ComponentState then begin
- if (Msg.HitTest = HTCLIENT) then begin
- cOverBar := False;
- vHitTest := ScreenToClient(cHitTest);
- if vHitTest.Y > cTape.Top + cTape.Height then
- if vHitTest.Y < cTape.Top + cTape.Height+4 then
- cOverBar := True;
- end;
-
- {set appropriate cursor}
- if cOverBar then
- SetNewCursor(cTabCursor)
- else
- inherited;
- end else
- inherited;
-end;
-
-procedure TOvcCustomCalculator.WMCancelMode(var Msg : TMessage);
-begin
- inherited;
-
- cSizing := False;
-end;
-
-procedure TOvcCustomCalculator.WMKillFocus(var Msg : TWMKillFocus);
-begin
- inherited;
-
- Invalidate;
-end;
-
-procedure TOvcCustomCalculator.WMLButtonDown(var Msg : TWMMouse);
-begin
- inherited;
-
- {are we currently showing a sizing cursor? if so the user wants to
- resize a column/row}
- if (cOverBar) then begin
- cSizeOffset := Msg.YPos;
- cSizing := True;
- cDrawSizeLine;
- end;
-end;
-
-procedure TOvcCustomCalculator.WMLButtonUp(var Msg : TWMMouse);
-var
- Form : TForm;
-begin
- inherited;
-
- if (cSizing) then begin
- cDrawSizeLine;
- cSizing := False;
- cTape.Height := cSizeOffset - 8;
- cCalculateLook;
-
- Refresh;
- if (csDesigning in ComponentState) then begin
- Form := TForm(GetParentForm(Self));
- if (Form <> nil) and (Form.Designer <> nil) then
- Form.Designer.Modified;
- end;
- end;
-end;
-
-procedure TOvcCustomCalculator.WMMouseMove(var Msg : TWMMouse);
-begin
- inherited;
-
- if (cSizing) then begin
- cDrawSizeLine;
- if Msg.YPos >= calcDefMinSize + cTape.Top then
- if Msg.YPos <= Height - calcDefMinSize then
- cSizeOffset := Msg.YPos + 2
- else
- cSizeOffset := Height - calcDefMinSize
- else
- cSizeOffset := calcDefMinSize + cTape.Top;
- cDrawSizeLine;
- end;
-end;
-
-procedure TOvcCustomCalculator.CopyToClipboard;
-begin
- Clipboard.AsText := Text;
-end;
-
-constructor TOvcCustomCalculator.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- if cPopup then
- ControlStyle := ControlStyle + [csClickEvents, csFramed] - [csCaptureMouse]
- else
- ControlStyle := ControlStyle + [csClickEvents, csFramed, csCaptureMouse];
-
- Color := clBtnFace;
- TabStop := True;
- Width := 200;
- Font.Name := 'MS Sans Serif';
- Font.Size := 8;
- Font.Style := [];
- cDecimalEntered := False;
- cSizing := False;
- cScrBarWidth := 18;
-
- {create edit control}
- cPanel := TOvcCalcPanel.Create(Self);
- cPanel.Parent := Self;
- cPanel.ParentFont := False;
- cPanel.Font.Name := 'Courier New';
- cPanel.Font.Size := 10;
- cPanel.Font.Style := [];
-{$IFNDEF LCL}
- cPanel.ParentCtl3D := True;
-{$ENDIF}
- cPanel.Alignment := taLeftJustify;
- cPanel.BevelOuter := bvLowered;
- cPanel.BorderStyle := bsNone;
- cPanel.Color := clWindow;
- cPanel.BevelWidth := 2;
- cPanel.Caption := '0 ';
-
- {set property defaults}
- FBorderStyle := bsNone;
- Height := 140;
- FTapeSeparatorChar := '_';
- FOptions := [coShowMemoryButtons, coShowItemCount];
- FColors := TOvcCalcColors.Create;
- FColors.OnChange := cColorChange;
-
- {assign default color scheme}
- FColors.FCalcColors := CalcScheme[cscalcWindows];
-
- {create tape}
- cTape := TOvcCalcTape.Create(Self, Length(CalcDisplayString[cbNone]));
- cTape.ShowTape := False;
- cTape.TapeColor := clWindow;
- cTape.MaxPaperCount := 9999;
- TapeHeight := Height div 3;
- TapeFont.OnChange := cTapeFontChange;
- TapeFont.Name := 'Courier New';
- TapeFont.Size := 10;
- TapeFont.Style := [];
- cTape.Visible := cTape.ShowTape;
-
- cEngine := TOvcBasicCalculatorEngine.Create;
- cEngine.Decimals := 2;
- cEngine.ShowSeparatePercent := False;
-
- if csDesigning in ComponentState then
- cTabCursor := Screen.Cursors[crVSplit];
-end;
-
-constructor TOvcCustomCalculator.CreateEx(AOwner : TComponent; AsPopup : Boolean);
-begin
- cPopup := AsPopup;
- Create(AOwner);
-end;
-
-procedure TOvcCustomCalculator.CreateParams(var Params : TCreateParams);
-const
- BorderStyles : array[TBorderStyle] of LongInt = (0, WS_BORDER);
-begin
- inherited CreateParams(Params);
-
- with Params do begin
- Style := LongInt(Style) or BorderStyles[FBorderStyle];
- if cPopup then begin
- Style := WS_POPUP or WS_BORDER;
- WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
- end;
- end;
-
- if NewStyleControls and (Ctl3D or cPopup) and (FBorderStyle = bsSingle) then begin
- if not cPopup then
- Params.Style := Params.Style and not WS_BORDER;
- Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
- end;
-end;
-
-procedure TOvcCustomCalculator.CreateWnd;
-begin
- inherited CreateWnd;
-
- cCalculateLook;
- cClearAll;
-
- cPanel.Color := FColors.Display;
-end;
-
-destructor TOvcCustomCalculator.Destroy;
-begin
- cTape.Free;
- cTape := nil;
-
- cEngine.Free;
- cEngine := nil;
-
- FColors.Free;
- FColors := nil;
-
- cTabCursor := 0;
-
- inherited Destroy;
-end;
-
-procedure TOvcCustomCalculator.KeyDown(var Key : Word; Shift : TShiftState);
-begin
- inherited KeyDown(Key, Shift);
-
- case Key of
- VK_DELETE : if Shift = [] then
- PressButton(cbClearEntry);
- VK_F9 : if Shift = [] then
- PressButton(cbChangeSign);
- end;
-end;
-
-procedure TOvcCustomCalculator.KeyPress(var Key : Char);
-begin
- inherited KeyPress(Key);
-
- case Key of
- '0' : PressButton(cb0);
- '1' : PressButton(cb1);
- '2' : PressButton(cb2);
- '3' : PressButton(cb3);
- '4' : PressButton(cb4);
- '5' : PressButton(cb5);
- '6' : PressButton(cb6);
- '7' : PressButton(cb7);
- '8' : PressButton(cb8);
- '9' : PressButton(cb9);
-
- '+' : PressButton(cbAdd);
- '-' : PressButton(cbSub);
- '*' : PressButton(cbMul);
- '/' : PressButton(cbDiv);
-
- '.' : PressButton(cbDecimal);
- '=' : PressButton(cbEqual);
- 'r' : PressButton(cbInvert);
- '%' : PressButton(cbPercent);
- '@' : PressButton(cbSqrt);
-
- ^L : PressButton(cbMemClear); {^L}
- ^R : PressButton(cbMemRecall); {^R}
- ^P : PressButton(cbMemAdd); {^P}
- ^S : PressButton(cbMemSub); {^S}
- ^T : PressButton(cbTape); {^T}
-
- ^C : CopyToClipboard; {^C}{copy}
- ^V : PasteFromClipboard; {^V}{paste}
-
- #8 : PressButton(cbBack); {backspace}
- #27 : PressButton(cbClear); {esc}
- else
- if Key = DecimalSeparator then
- PressButton(cbDecimal);
- end;
-end;
-
-procedure TOvcCustomCalculator.MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
-var
- B : TOvcCalculatorButton;
-begin
- SetFocus;
-
- if Button = mbLeft then begin
- cDownButton := cbNone;
- for B := Low(cButtons) to High(cButtons) do
- if cButtons[B].Visible and PtInRect(cButtons[B].Position, Point(X,Y)) then begin
- if (B in [cbMemClear, cbMemRecall]) and (cEngine.Memory = 0) then
- Exit;
- cDownButton := B;
- InvalidateRect(Handle, @cButtons[cDownButton].Position, False);
- Break;
- end;
- end;
-
- inherited MouseDown(Button, Shift, X, Y);
-end;
-
-procedure TOvcCustomCalculator.MouseUp(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
-begin
- if cDownButton = cbNone then
- Exit;
-
- InvalidateRect(Handle, @cButtons[cDownButton].Position, False);
-
- {if still over the button...}
- if PtInRect(cButtons[cDownButton].Position, Point(X,Y)) then
- PressButton(cDownButton);
-
- cDownButton := cbNone;
-
- inherited MouseUp(Button, Shift, X, Y);
-end;
-
-procedure TOvcCustomCalculator.PasteFromClipboard;
-var
- I : Integer;
- C : AnsiChar;
- S : string;
-begin
- S := Clipboard.AsText;
- if S > '' then begin
- cClearAll;
- for I := 1 to Length(S) do begin
- C := S[I];
- if (C in ['0'..'9', DecimalSeparator, '.', '+', '-', '*', '/', '=', '%']) then
- KeyPress(C);
- end;
- end;
-end;
-
-procedure TOvcCustomCalculator.PressButton(Button : TOvcCalculatorButton);
-
- procedure Initialize;
- begin
- if (cLastButton <> cbClear) and (Button = cbClear) then begin
- cClearAll;
- cTape.SpaceTape(TapeSeparatorChar);
- end;
-
- if (csLocked in cEngine.State) then begin
- MessageBeep(0);
- Exit;
- end;
-
- {this logic is here to make cbEqual clear all the second time}
- if (cLastButton in [cbEqual, cbClear, cbNone]) and (Button = cbEqual) then begin
- Button := cbClear;
- cClearAll;
- end;
-
- if (cLastButton = cbPercent) and (Button in [cbAdd, cbSub, cbMul, cbDiv, cbEqual]) then
- cEvaluate(Button)
- else if ((((cLastButton in [cbEqual, cbMemRecall]) and
- (Button in [cbAdd, cbSub, cbMul, cbDiv])))) and
- cEngine.AddOperand(StrToFloat(FDisplayStr), CalcButtontoOperation[Button]) then begin
- cEvaluate(Button);
- end else if (Button = cbMemStore) then begin
- if (cLastButton <> cbEqual) then
- cEvaluate(Button);
- SetMemory(DisplayValue);
- end else if cEngine.AddOperand(LastOperand, CalcButtontoOperation[Button]) then begin
- cEvaluate(Button);
-
- {remove special operations from stack}
- if Button in [cbInvert, cbSqrt, cbEqual] then
- LastOperand := cEngine.PopOperand;
- end;
- end;
-
- procedure NumberButton;
- var
- D : Extended;
- DP : Integer;
- begin
- begin
- if cEngine.LastOperation = coEqual then begin
- {clear pending operations if last command was =}
- cClearAll;
- end;
-
- if csClear in cEngine.State then begin
- if (Decimals < 0) then begin
- FDisplayStr := '0.' + StringOfChar('0', -Decimals);
- end else begin
- FDisplayStr := '';
- cDecimalEntered := False;
- end;
- end;
-
- FDisplayStr := FDisplayStr + cButtons[Button].Caption[1];
- if cMinus0 then begin
- FDisplayStr := '-' + FDisplayStr;
- cMinus0 := False;
- end;
-
- if (Decimals < 0) and not cDecimalEntered then begin
- if Pos(DecimalSeparator, FDisplayStr) > 0 then begin
- DP := Pos(DecimalSeparator, FDisplayStr);
- if FDisplayStr[1] = '0' then
- FDisplayStr := Copy(FDisplayStr,2,DP-2) +
- Copy(FDisplayStr,DP+1,1) +
- DecimalSeparator +
- Copy(FDisplayStr,DP+2,Length(FDisplayStr) - DP)
- else
- FDisplayStr := Copy(FDisplayStr,1,DP-1) +
- Copy(FDisplayStr,DP+1,1) +
- DecimalSeparator +
- Copy(FDisplayStr,DP+2,Length(FDisplayStr) - DP);
- end;
- end;
- D := StrToFloat(FDisplayStr);
- LastOperand := D;
- if (D <> 0) or
- (Pos(DecimalSeparator, FDisplayStr) > 0) then begin
- DisplayValue := D;
- cSetDisplayString(FDisplayStr);
- cEngine.State := [csValid];
- end else begin
- FDisplayStr := '0';
- DisplayValue := D;
- cEngine.State := [csValid, csClear];
- end;
- end;
- end;
-
- procedure DecimalButton;
- var
- D : Extended;
- begin
- {check if the decimal was first character entered after a command}
- if csClear in cEngine.State then begin
- FDisplayStr := '0' + DecimalSeparator;
- cSetDisplayString(FDisplayStr);
- cDecimalEntered := True;
- cEngine.State := [csValid];
- end;
-
- {check if there is already a decimal separator in the string}
- if Pos(DecimalSeparator, FDisplayStr) = 0 then begin
- FDisplayStr := FDisplayStr + DecimalSeparator;
- if (pos(DecimalSeparator, FDisplayStr) = 1) then
- FDisplayStr := '0' + FDisplayStr;
- D := StrToFloat(FDisplayStr);
- cSetDisplayString(FDisplayStr);
- LastOperand := D;
- cEngine.State := [csValid];
- cDecimalEntered := True;
- end;
- end;
-
- procedure BackButton;
- var
- D : Extended;
- DP : Integer;
- SaveSign : string;
- begin
- if FDisplayStr = '' then exit;
- D := StrToFloat(FDisplayStr);
- if D <> 0 then begin
- if Length(FDisplayStr) > 1 then begin
- if (Decimals < 0) and not cDecimalEntered then begin
- if Pos(DecimalSeparator, FDisplayStr) > 0 then begin
- if FDisplayStr[1] = '-' then begin
- SaveSign :='-';
- FDisplayStr := Copy(FDisplayStr,2,Length(FDisplayStr)-1);
- end else begin
- SaveSign :='';
- end;
- DP := Pos(DecimalSeparator, FDisplayStr);
- FDisplayStr := '0' + Copy(FDisplayStr,1,DP-2) +
- DecimalSeparator +
- Copy(FDisplayStr,DP-1,1) +
- Copy(FDisplayStr,DP+1,Length(FDisplayStr) - DP);
- if (FDisplayStr[1] = '0') and (FDisplayStr[2] <> '.') then
- FDisplayStr := Copy(FDisplayStr,2,Length(FDisplayStr)-1);
- FDisplayStr := SaveSign + FDisplayStr;
- end;
- end;
- FDisplayStr := Copy(FDisplayStr, 1, Length(FDisplayStr)-1);
- LastOperand := StrToFloat(FDisplayStr);
- cSetDisplayString(FDisplayStr);
- end else begin
- LastOperand := 0;
- cMinus0 := False;
- DisplayValue := LastOperand;
- cEngine.State := [csValid, csClear];
- end;
- end;
- end;
-
- procedure ClearEntryButton;
- begin
- begin
- FDisplayStr := '';
- LastOperand := 0;
- cMinus0 := False;
- DisplayValue := LastOperand;
- end;
- end;
-
- procedure ChangeSignButton;
- begin
- if Length(FDisplayStr) > 0 then begin
- if FDisplayStr[1] <> '-' then begin
- FDisplayStr := '-' + FDisplayStr;
- LastOperand := StrToFloat(FDisplayStr);
- cSetDisplayString(FDisplayStr);
- end else begin
- FDisplayStr := Copy(FDisplayStr, 2, Length(FDisplayStr)-1);
- LastOperand := StrToFloat(FDisplayStr);
- cSetDisplayString(FDisplayStr);
- end;
- DisplayValue := LastOperand;
- end else begin
- LastOperand := 0;
- cMinus0 := not cMinus0;
- DisplayValue := LastOperand;
- if cMinus0 then
- FDisplayStr := '-';
- cEngine.State := [csValid, csClear];
- end;
- end;
-
- procedure ClearTapeButton;
- var
- I : Integer;
- begin
- with Tape do begin
- for I := 0 to Count - 1 do begin
- Strings[I] := '';
- end;
- cTape.RefreshDisplays;
- end;
- end;
-
-begin
- if not HandleAllocated then
- Exit;
-
- {simulate a button down if needed}
- if cDownButton = cbNone then begin
- cDownButton := Button;
- InvalidateRect(Handle, @cButtons[cDownButton].Position, False);
- Update;
- end;
-
- try try
- Initialize;
- case Button of
- cb0..cb9 : NumberButton;
- cbDecimal : DecimalButton;
- cbBack : BackButton;
- cbClearEntry : ClearEntryButton;
- cbMemStore,
- cbMemClear,
- cbMemAdd,
- cbMemSub : cInvalidateIndicator;
- cbChangeSign : ChangeSignButton;
- cbTape : ClearTapeButton;
- cbSqrt,
- cbInvert : {};
- end;
- except
- cDisplayError;
- end;
- finally
- {simulate a button up, if the mouse button is up or we aren't focused}
- if not Focused or ({$IFNDEF LCL} GetAsyncKeyState(GetLeftButton) {$ELSE} GetKeyState(GetLeftButton) {$ENDIF} and $8000 = 0) then begin
- InvalidateRect(Handle, @cButtons[cDownButton].Position, False);
- cDownButton := cbNone;
- Update;
- end;
- end;
-
- cLastButton := Button;
- if Assigned(FOnButtonPressed) then
- FOnButtonPressed(Self, Button);
-end;
-
-procedure TOvcCustomCalculator.PushOperand(const Value : Extended);
-begin
- cEngine.PushOperand(Value);
- LastOperand := Value;
- DisplayValue := Value;
-end;
-
-procedure TOvcCustomCalculator.Paint;
-var
- B : TOvcCalculatorButton;
-begin
- Canvas.Font := Font;
- Canvas.Brush.Color := clBtnFace;
- Canvas.FillRect(ClientRect);
-
- if Ctl3D then begin
- cPanel.BevelOuter := bvLowered;
- cPanel.BorderStyle := bsNone;
- end else begin
- cPanel.BevelOuter := bvNone;
- cPanel.BorderStyle := bsSingle;
- end;
-
- {draw buttons}
- for B := Low(cButtons) to High(cButtons) do begin
- if (B in [cbMemClear, cbMemRecall, cbMemStore, cbMemAdd, cbMemSub]) then begin
- if (B in [cbMemClear, cbMemRecall]) and (cEngine.Memory = 0) then
- Canvas.Font.Color := FColors.DisabledMemoryButtons
- else
- Canvas.Font.Color := FColors.MemoryButtons;
- end else if (B in [cbBack, cbClearEntry, cbClear, cbTape]) then
- Canvas.Font.Color := FColors.EditButtons
- else if (B in [cbAdd, cbSub, cbMul, cbDiv, cbEqual]) then
- Canvas.Font.Color := FColors.OperatorButtons
- else if (B in [cb0..cb9, cbDecimal]) then
- Canvas.Font.Color := FColors.NumberButtons
- else if (B in [cbInvert, cbChangeSign, cbPercent, cbSqrt]) then
- Canvas.Font.Color := FColors.FunctionButtons;
-
- cDrawCalcButton(cButtons[B], (B = cDownButton));
- end;
-end;
-
-procedure TOvcCustomCalculator.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
-begin
- if Height <> AHeight then
- if coShowTape in FOptions then
- if Top <> ATop then begin
- if TapeHeight + (AHeight - Height) > calcDefMinSize then begin
- TapeHeight := TapeHeight + (AHeight - Height);
- end else begin
- TapeHeight := calcDefMinSize;
- end
- end;
-
- inherited Setbounds(ALeft, ATop, AWidth, AHeight);
-
- cCalculateLook;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/.svn/wc.db b/Source/3rdParty/Orpheus/.svn/wc.db
deleted file mode 100644
index 80c9ebef..00000000
Binary files a/Source/3rdParty/Orpheus/.svn/wc.db and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/.svn/wc.db-journal b/Source/3rdParty/Orpheus/.svn/wc.db-journal
deleted file mode 100644
index e69de29b..00000000
diff --git a/Source/3rdParty/Orpheus/ORBLUEDOT.bmp b/Source/3rdParty/Orpheus/ORBLUEDOT.bmp
deleted file mode 100644
index 60a689de..00000000
Binary files a/Source/3rdParty/Orpheus/ORBLUEDOT.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/ORBTNCAL.bmp b/Source/3rdParty/Orpheus/ORBTNCAL.bmp
deleted file mode 100644
index b5ab49f4..00000000
Binary files a/Source/3rdParty/Orpheus/ORBTNCAL.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/ORBTNCLC.bmp b/Source/3rdParty/Orpheus/ORBTNCLC.bmp
deleted file mode 100644
index 1629a542..00000000
Binary files a/Source/3rdParty/Orpheus/ORBTNCLC.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/ORCOLUMNMOVECURSOR.cur b/Source/3rdParty/Orpheus/ORCOLUMNMOVECURSOR.cur
deleted file mode 100644
index 643454de..00000000
Binary files a/Source/3rdParty/Orpheus/ORCOLUMNMOVECURSOR.cur and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/ORLEFTARROW.bmp b/Source/3rdParty/Orpheus/ORLEFTARROW.bmp
deleted file mode 100644
index 054b6511..00000000
Binary files a/Source/3rdParty/Orpheus/ORLEFTARROW.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/ORLEFTARROWS.bmp b/Source/3rdParty/Orpheus/ORLEFTARROWS.bmp
deleted file mode 100644
index 614e2fa3..00000000
Binary files a/Source/3rdParty/Orpheus/ORLEFTARROWS.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/ORREDDOT.bmp b/Source/3rdParty/Orpheus/ORREDDOT.bmp
deleted file mode 100644
index 324afd19..00000000
Binary files a/Source/3rdParty/Orpheus/ORREDDOT.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/ORREVERT.bmp b/Source/3rdParty/Orpheus/ORREVERT.bmp
deleted file mode 100644
index 39225bf7..00000000
Binary files a/Source/3rdParty/Orpheus/ORREVERT.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/ORRIGHTARROW.bmp b/Source/3rdParty/Orpheus/ORRIGHTARROW.bmp
deleted file mode 100644
index b8145391..00000000
Binary files a/Source/3rdParty/Orpheus/ORRIGHTARROW.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/ORRIGHTARROWS.bmp b/Source/3rdParty/Orpheus/ORRIGHTARROWS.bmp
deleted file mode 100644
index 0f024016..00000000
Binary files a/Source/3rdParty/Orpheus/ORRIGHTARROWS.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/ORROWMOVECURSOR.cur b/Source/3rdParty/Orpheus/ORROWMOVECURSOR.cur
deleted file mode 100644
index e8ea822d..00000000
Binary files a/Source/3rdParty/Orpheus/ORROWMOVECURSOR.cur and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/ORTCCHECKGLYPHS.bmp b/Source/3rdParty/Orpheus/ORTCCHECKGLYPHS.bmp
deleted file mode 100644
index ac2b1317..00000000
Binary files a/Source/3rdParty/Orpheus/ORTCCHECKGLYPHS.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/ORTCCOMBOARROW.bmp b/Source/3rdParty/Orpheus/ORTCCOMBOARROW.bmp
deleted file mode 100644
index 7e71afc6..00000000
Binary files a/Source/3rdParty/Orpheus/ORTCCOMBOARROW.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/ORTODAY.bmp b/Source/3rdParty/Orpheus/ORTODAY.bmp
deleted file mode 100644
index 22337847..00000000
Binary files a/Source/3rdParty/Orpheus/ORTODAY.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/OrphStatus.html b/Source/3rdParty/Orpheus/OrphStatus.html
deleted file mode 100644
index 58aabe96..00000000
--- a/Source/3rdParty/Orpheus/OrphStatus.html
+++ /dev/null
@@ -1,771 +0,0 @@
-
-
-
-
-
-
-Status of Orpheus Port
-
-
-
-
-
-
-
-Status of Orpheus Port
-
-
-
-Contents
-What's New
-Introduction
-Installation
-Platforms Tested
-Examples
-Porting Philosophy
-Usage Notes
-Limitations
-Status of Individual Controls
-To Do
-Other Resources
-
-
-What's New
-
-
-20090921 release (0.2.2):
-
- Lazarus 0.9.27 eliminated the Ctl3D property, breaking Orpheus, which uses
- Ctl3D in several controls. This release restores the Ctl3D property so
- Orpheus can again be compiled with Lazarus.
- The status table below has been updated for all widgetsets. In some cases
- Orpheus controls have improved with general improvements and bug fixes
- in the LCL and underlying widgetset code; in a few cases, however, Orpheus
- controls perform worse than they did previously, probably due to
- side-effects from LCL changes.
-
-
- 20081229 release (0.2.1):
-
- Adds TOvcCalendar.
- Updated results of testing for Lazarus 0.9.26. GTK2 widgetset now working better.
-
-
- 20080720 release (0.2.0):
-
- Recent change in the Lazarus LCL broke Orpheus TOvcTable on Windows. This release
- works around that change.
- Numerous bugs fixed and workarounds found. See To Do list.
- Batch/script files are now included for compiling all test apps at once.
-
-
- 20080316 release (0.1.9):
-
- Recent changes in the Lazarus LCL broke Orpheus compilation. This release
- can now be compiled.
-
- 20080301 release (0.1.8):
-
- Recent changes in the Lazarus LCL broke all Orpheus property editors and example
- programs. This release fixes those problems.
-
- 20070903 release (0.1.7):
-
- Recent changes in the Lazarus LCL broke Orpheus compilation. This release
- can now be compiled.
- Recent improvements in the Lazarus Qt widgetset add basic functionality
- for several Orpheus controls (see table below). However, GTK2 widgetset
- does not work as well as it used to.
-
- 20070704 release (0.1.6):
-
- 3 new example programs have been added for demonstrating TOvcSpinner,
- TOvcSimpleField, TOvcTCSimpleField and TO32TCSimpleField. Note that the
- TestSimpField and TestTblEdits examples are intended primarily for
- Windows at this time since TOvcSimpleField and TOvcTCSimpleField are not
- yet working on other widgetsets (see table below).
- Fix improves functionality of TO32TCFlexEdit validation.
-
- 20070630 release (0.1.5):
-
- Most of the Orpheus controls now work with the Lazarus Carbon widgetset.
-
- 20070425 release (0.1.4):
-
- Recent changes to Lazarus LCL broke compilation of Orpheus. This
- release can now be compiled with the latest LCL.
-
- 20070401 release (0.1.3):
-
- Improvements to TO32FlexEdit on Windows.
-
- 20070317 note:
-
- Recent improvements in the Lazarus Carbon widgetset add basic functionality
- for several Orpheus controls on OS X (see table below).
-
- 20070211 note:
-
- Recent improvements in Lazarus fix display of custom cursor when
- sizing and moving columns and rows at runtime in TOvcTable.
-
- 20070204 release (0.1.2):
-
- Workarounds found for recent Lazarus changes that broke TOvcTable Columns
- and Rows editors.
- Workaround found for recent FPC 2.1.1 change that broke compilation of ovcvlb.pas.
-
- 20070128 release (0.1.1):
-
- An example program that demos the TO32FlexEdit control has been added
- even though validation doesn't work with LCL (see "To Do" list below).
- If you have Delphi you can compile the example to see how validation
- is supposed to work.
- Recent changes in Lazarus on Windows appear to have broken both the
- Columns and Rows design-time property editors for the TOvcTable control.
- The property editors still work with OS X. Stay tuned...
- Custom cursors are now visible when resizing table columns at runtime on
- Windows. However, cursor also disappears sometimes. Stay tuned on
- this one too...
-
- 20070127 note:
-
- Recent improvements in the Lazarus Qt widgetset make a couple of Orpheus controls
- work better with Qt.
-
- 20070115 note:
-
- 20070114 note:
-
- Controls have now been tested with GTK2 widgetset (see table below).
-
- 20070107 release (0.1.0):
-
- TOvcVirtualListBox control added.
- Installation no longer registers TOvcSimpleField and TOvcTCSimpleField
- controls (see myovcreg.pas) on non-Windows platforms since these two controls
- don't work on other platforms and crash Lazarus IDE if added to a form on
- those platforms.
-
-
-
-
-Introduction
-
-These notes describe the status of the OrphPort Project, an attempt to
-port a subset of TurboPower's Orpheus controls to Lazarus
-and Free Pascal . At this time,
-several enhanced label controls and most of the table (grid) controls
-have been ported. Some of the controls
-work quite well on multiple platforms; others need more work or
-await better support by the Lazarus LCL or by specific widgetsets before
-they are fully functional. The table below gives the status of individual
-controls. You are encouraged to work on improving these controls
-(see To Do list ). Please send your bug reports, suggestions
-and patches to:
-
- MacPgmr (at) fastermac (dot) net
-
-Note: You can also post to the "Ported from Delphi/Kylix" section of the Lazarus
-forum if you want your bug reports and suggestions to be seen by the entire
-Lazarus community.
-
-The ported source code is here: http://web.fastermac.net/~MacPgmr/OrphPort/downloads
-
-You can now also obtain the Orpheus ported source using Subversion:
-
-svn co https://lazarus-ccr.svn.sourceforge.net/svnroot/lazarus-ccr/components/orpheus [local_dir]
-
-The original Orpheus 4.06 source code that this port was based on is here:
-
-http://sourceforge.net/projects/tporpheus
-(although you don't need this for Lazarus)
-
-TurboPower's 1,392-page Orpheus User's Manual is also available from the Source Forge site.
-
-Note that the ported source remains under the original MPL 1.1 license.
-
-
-Installation
-
-
-Unzip the ported source files into their own folder.
- Start Lazarus.
- Optionally, choose File | New | Application to make sure Lazarus doesn't
-mess up the currently open project.
- Choose Package | Open package file and select orpheus.lpk.
- Click Compile to make sure your version of Lazarus can compile the
-Orpheus units.
- Click Install and click Yes when prompted to rebuild the Lazarus IDE.
- After rebuilding is finished, restart Lazarus if it didn't restart
-automatically. The installed Orpheus controls will be on the Orpheus tab
-of the component palette.
-
-
-Important! If you don't have write access to the folder where Lazarus
-is installed, you may have problems rebuilding the Lazarus IDE with older
-versions of Lazarus. However, if you have a relatively new version of Lazarus,
-it will compile itself to the ~/.lazarus/bin folder if you don't have write
-access to the Lazarus install folder. After rebuilding, be sure to start
-~/.lazarus/bin/lazarus, not the installed Lazarus.
-
-
-Platforms Tested
-
-
-
-
-Platform
-OS Version
-Library Versions
-Widgetsets Tested
-Lazarus Version Tested
-
-
-
-Windows
-XP SP2
-
-win32
-0.9.28 RC with FPC 2.2.4
-
-
-
-OS X
-10.4.11 (Tiger) on PowerPC
-gtk: 1.2.0.9.1 gtk2: 2.14.7 qt: 4.5.2
-gtk, gtk2, carbon, qt
-0.9.28 RC with FPC 2.2.4
-
-
-
-OS X
-10.5.8 (Leopard) on Intel
-
-carbon
-0.9.28 RC with FPC 2.2.4
-
-
-
-Linux
---not tested--
-
-
-
-
-
-
-
-
-Examples
-
-The source for several small test applications is included which demonstrates
-most of the ported controls. Open each test app's .lpi file and compile it once
-Orpheus has been installed in Lazarus. Folders for the test apps are located
-in the tests folder in your Orpheus folder, as follows:
-
-TestTable - demos TOvcTable and various table cell controls (column
-headers, row labels, string, memo, check box, combo box, bitmap).
- TestURL - demos TOvcURL
- TestRLbl - demos TOvcRotatedLabel
- TestLabel - demos TOvcLabel
- TestVLB - demos TOvcVirtualListBox
- TestSpinner - demos TOvcSpinner
- TestFlexEdit - demos TO32FlexEdit validation
- TestSimpField - demos TOvcSimpleField validation (Windows only for now)
- TestTblEdits - demos TOvcTCString, TOvcTCSimpleField validation and TO32TCFlexEdit
-validation (Windows only for now)
- TestCalendar - demos TOvcCalendar
-
-
-To see the TOvcSpinner control in action, try out the table's Rows and Columns
-property editors with the TestTable app.
-
-Note: The TestTable app uses the included .bmp files to demo the
-TOvcTCBitMap control. These bitmap files are not needed to rebuild the Lazarus
-IDE since they're in the ovcreg.lrs resource file, but they are
-included for completeness.
-
-Tip: The necessary files for compiling the test apps with Delphi are
-also included (.dof, .dfm, .bdsproj). If you have Delphi you can compile
-the apps to see exactly how the Orpheus controls are supposed to look and
-behave. Note that with the free Turbo Delphi Explorer you can't install
-Orpheus (a limitation of the free version). However, you can still compile
-the test apps, as follows:
-
-Start Turbo Delphi Explorer and open the test app's .bdsproj file.
- Click Ignore All to proceed when Delphi encounters the unrecognized
-Orpheus controls.
- Choose File | Close and click Cancel to close the main form.
- Choose Project | Options and make sure the Search path in
-Directories/Conditionals points to your Orpheus folder.
- Choose Project | Compile to compile the test app.
-
-
-
-Porting Philosophy
-
-
-All changes to the original source code were made via conditional
-compiling (IFDEF's). Thus the ported source retains full Delphi compatibility.
-An added benefit is that you can see what the original code was, something
-that is often lost with ported code.
- A compatibility unit, MyMisc , was added to fill in gaps in the
-Lazarus LCL and provide other compatibility routines.
- Orpheus functions written in assembly were "Pascal-ized" so the ported code could
-be compiled on non-Intel platforms.
- For now, the Lazarus package (orpheus.lpk) compiles the source with range,
-overflow and stack checking turned on. This revealed several apparently harmless
-bugs in the TurboPower code, which have been fixed. To find these and other
-minor bugs, grep the source for "TurboPower bug".
- In general, no other significant changes or "improvements" were made to
-the source. An exception is the o32tcflx unit, where a few additions were
-made to correct apparent omissions or inconsistencies.
- A note on comments: Comments added to the ported source are generally
-marked with "//". However, the "o32" units (developed later than other units
-by TurboPower) already included some "//" comments. With these units, you can
-tell the added comments by their context (near IFDEF's, for example).
-
-
-
-Usage Notes
-
-
-When you first add an Orpheus control to a form, Lazarus will add
-the Orpheus unit to the uses section of your main source file (.lpr).
-This pulls in a great deal of code that you don't need. Delete the Orpheus unit
-from the uses section to reduce the size of your executable file.
-<==Fixed in 0.2.2 release.
-
The TOvcSimpleField and TOvcTCSimpleField controls originally did not work
-at all on non-Windows widgetsets, although they now have some functionality.
-For now, don't use these controls in cross-platform applications. Just opening
-a form that has a TOvcSimpleField or TOvcTCSimpleField control on it may crash
-non-Windows versions of Lazarus. Use the TO32FlexEdit and TO32TCFlexEdit
-controls in place of TOvcSimpleField and TOvcTCSimpleField controls in
-cross-platform applications.
-
To display the TOvcLabel's Style Manager property editor in the Lazarus
-IDE, right-click on the TOvcLabel control (Apple key+click on Mac). You can
-also change Style Manager properties via the CustomSettings in the
-Object Inspector. Also, with GTK, the default clNone Color displays a black
-background, so be sure to set ParentColor to True or select a different
-Color.
-
An added benefit of the Orpheus TOvcSpinner control is that it is
-available for Delphi too, unlike the LCL TSpinEdit, which has no equivalent
-in the Delphi VCL.
-
-
-
-Limitations
-
-
-The TO32FlexEdit and TO32TCFlexEdit controls include code for displaying
-an optional button within the text editing area. However, this TBitBtn-within-
-a-TEdit has not been supported by the LCL, so the code has been IFDEF'd out for
-now. Beginning with Lazarus 0.9.27, this code appears to work okay with the win32
-and carbon widgetsets. To enable the button code, see the comments above the
-ButtonOkay define in o32flxed.pas.
-
Widgetsets generally implement LCL controls by creating native controls
-that correspond to the LCL controls (text edit, check box, etc.). However,
-Orpheus builds its TOvcSimpleField control from TCustomControl, rather than
-descending from an existing edit control such as TCustomEdit. In general,
-TOvcSimpleField and TOvcTCSimpleField have not worked very well on non-Windows
-widgetsets.
-
The GTK widgetset does not support TOvcRotatedLabel, apparently
-because the GetTextMetrics function is not fully implemented on that
-widgetset.
-
The Carbon widgetset has a few minor limitations as of Lazarus 0.9.26 that
-affect some of the Orpheus controls. Setting the BorderStyle property does
-nothing with Carbon in custom controls such as TOvcVirtualListBox, TOvcCalendar
-and TOvcTable. Also, since the Carbon widgetset does not implement the bvLowered
-bevel style, changing the focus of a TOvcCalendar control does not change
-the look of the currently selected date as it should (the date remains bvRaised,
-which actually looks lowered with the Carbon widgetset).
-
Differences between Delphi VCL and Lazarus LCL affect some Orpheus controls.
-For example, VCL messages like CM_ENTER and CM_EXIT are not supported in the
-LCL. In a couple places, the ported code uses LM_SETFOCUS and LM_KILLFOCUS
-messages to obtain some functionality. Similarly, the lack of LCL support for the
-CM_CTL3DCHANGED message means that changing the Ctl3D property in Lazarus for
-controls such as TOvcCalendar may not update the control's design (reloading the
-form will show the correct design). Finally, some properties are True
-by default in Delphi but False in Lazarus, meaning forms converted from Delphi
-may not look quite the same for properties with default values until you
-explicitly set the properties in Lazarus or in your code.
-
-
-
-Status of Individual Controls
-
-
-
-
-Control
-VCL / LCL ancestor
-Description
-Issues / To-do
-win32
-gtk
-gtk2
-carbon
-qt
-
-
-
-TOvcRotatedLabel
-TGraphicControl
-Rotated text
-gtk widgetset doesn't support
-Working
-Not working
-Partial
-Working
-Working
-
-
-
-TOvcLabel
-TGraphicControl
-Fancy shading, color and highlighting
-Property editor still needs work
-Working
-Working
-Working
-Working
-Working
-
-
-
-TOvcURL
-TCustomLabel
-Looks and acts like HTML hyperlink
-
-Working
-Working
-Working
-Working
-Partial
-
-
-
-TOvcSpinner
-TCustomControl
-Can associate with a TEdit; 8 different styles
-
-Working
-Working
-Working
-Working
-Crashes
-
-
-
-TOvcVirtualListBox
-TCustomControl
-Header row, variable width tabs, huge number of rows
-
-Working
-Working
-Working
-Working
-Partial
-
-
-
-TOvcCalendar
-TCustomControl
-Calendar control
-
-Working
-Working
-Working
-Working
-Partial
-
-
-
-TOvcSimpleField
-TCustomControl
-Edit control with validation
-
-Working
-Partial
-Partial
-Partial
-Partial
-
-
-
-TO32FlexEdit
-TCustomEdit
-Edit control with validation
-gtk and qt used to work better
-Working
-Partial
-Working
-Working
-Partial
-
-
-
-TOvcTable
-TCustomControl
-Full-featured grid control
-See "To Do" list; 0.9.26 didn't crash
-Working
-Crashes
-Crashes
-Partial
-Freezes
-
-
-
-TOvcTCColHead
-TComponent
-Table column headings
-
-Working
-Working
-Working
-Working
-Working
-
-
-
-TOvcTCRowHead
-TComponent
-Table row headings
-
-Working
-Working
-Working
-Working
-Working
-
-
-
-TOvcTCString
-TComponent (edits with TEdit)
-Table cell for editing strings
-
-Working
-Working
-Working
-Working
-Partial
-
-
-
-TOvcTCSimpleField
-TComponent (edits with TOvcSimpleField)
-Table cell for editing strings, with validation
-
-Working
-Partial
-Partial
-Partial
-Partial
-
-
-
-TOvcTCMemo
-TComponent (edits with TMemo)
-Table cell for editing memo text
-
-Working
-Working
-Working
-Working
-Partial
-
-
-
-TOvcTCCheckBox
-TComponent (edits with TCustomControl)
-Table cell for check box
-
-Working
-Working
-Working
-Working
-Partial
-
-
-
-TOvcTCComboBox
-TComponent (edits with TComboBox)
-Table cell for combo box
-Dropdown problem w/o XP manifest
-Working
-Not working
-Not working
-Working
-Partial
-
-
-
-TOvcTCBitmap
-TComponent
-Table cell for displaying bitmap
-
-Working
-Working
-Working
-Not working
-Partial
-
-
-
-TOvcTCGlyph
-TComponent
-Table cell for cycling thru glyphs
-
-Working?
-Working?
-Working?
-?
-?
-
-
-
-TOvcTCIcon
-TComponent
-Table cell for displaying icon
-
-Working?
-Working?
-Working?
-?
-?
-
-
-
-TO32TCFlexEdit
-TComponent (edits with TO32FlexEdit)
-Table cell for editing strings, with validation
-
-Working
-Working
-Working
-Working
-Partial
-
-
-
-TOvcController
-TComponent
-Key-to-command translator
-Property editor uses TTabSet
-?
-?
-?
-?
-?
-
-
-
-
-
-Notes:
-(1) "Working" means control is basically functional. "Partial" means
-control compiles, installs in IDE and displays at run-time, but doesn't function
-correctly. "Not working" means control compiles and installs in IDE but
-doesn't display correctly. "Widgetset doesn't support" means the widgetset
-currently does not provide the support needed for the control.
-(2) TOvcSimpleField and TOvcTable require a TOvcController on form.
-However, TO32FlexEdit doesn't need TOvcController.
-
-
-To Do
-
-TOvcLabel
-
- Figure out why TOvcColorComboBox controls in Style Manager property editor
- don't work on Windows.
- Figure out why Color's default value (clNone) displays black
- background with GTK. Workaround for now is to set TOvcLabel's
- ParentColor to True in Object Inspector or select a different Color.
-
- TOvcVirtualListBox
-
- Fix scrolling problems on Windows (not repainted right) and other platforms
- (scrolls too many with each click of arrow). <==Fixed in 0.2.0 release.
- Figure out why double-click doesn't work on GTK. <==Fixed.
-
- TO32FlexEdit
-
- Figure out why, on Windows, presence of XP manifest prevents setting Text.
- <==Appears to be fixed with 20070401 Lazarus.
- Come up with workaround for LCL's lack of MakeObjectInstance for making
- callback function from method. Without this, control's validation is not
- performed. <==Workaround in 0.1.3 release fixes this on win32 widgetset.
- <==Partial workaround in 0.2.0 release for other widgetsets is to call
- SendMessage(TO32FlexEdit(Sender).Handle, OM_VALIDATE, 0, 0); in OnExit handler.
- See TestFlexEdit example.
- Can't tab out of control on Windows with win32 widgetset (tabbing works
- with qt widgetset on Windows though). <==Fixed in 0.1.3 release.
-
- TOvcTable
-
- Custom cursors not visible when sizing and moving columns and rows.
- Determine whether this is an LCL limitation. <==Recently fixed in
- Lazarus for Windows.
- Sizing and moving columns and rows doesn't work at all with GTK or Carbon.
- Determine whether this is a GTK/Carbon limitation.
- Table scroll bar "thumb" extends entire length of scrollbar with GTK.
- <==Fixed in 0.2.0 release.
- Figure out how to move edit cell to stay with its row when scrolling
- table (non-Windows only).
- Figure out why scrolling table with keyboard doesn't repaint table with Carbon.
- Possibly related to TestTable issue with Carbon where selecting a .bmp in the
- combo box cell doesn't display the bitmap in the next column until form is resized.
-
- TOvcTCComboBox
-
- Figure out why, on Windows, won't drop down without presence of
- XP manifest.
-
- TO32TCFlexEdit
-
- Need a way of setting OnValidationError handler (an apparent omission
- since TO32FlexEdit has it). <==Workaround in 0.2.0 release is to
- set TO32TCFlexEditEditor(Sender).OnValidationError in UserValidation handler.
-
- TOvcSimpleField and TOvcTCSimpleField
-
- Recent improvements in GTK and Carbon widgetsets mean these controls no
- longer crash programs when they're used. However, they don't yet work as edit
- controls. Determine whether this means more improvement in widgetsets is needed.
- (Use TO32FlexEdit and TO32TCFlexExit in the meantime.)
-
- TOvcTCBitMap
-
- This previously worked, but changes to Lazarus LCL now cause it to crash
- when cell gets focus (win32 only). <==Fixed in 0.2.0 release.
-
- TOvcController
-
- Rewrite ovccmdp0.pas property editor to use TTabControl instead of
- TTabSet (not part of LCL).
-
-
-
-
-Other Resources
-
-Status of Lazarus widgetsets:
-http://wiki.lazarus.freepascal.org/Roadmap
-
-OS X tips for Lazarus:
-http://wiki.lazarus.freepascal.org/OS_X_Programming_Tips
-
-
-
-Last updated: Sept. 21, 2009
-
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/README.txt b/Source/3rdParty/Orpheus/README.txt
deleted file mode 100644
index 5bce555a..00000000
--- a/Source/3rdParty/Orpheus/README.txt
+++ /dev/null
@@ -1,5 +0,0 @@
-
-This is the Lazarus port of a subset of Orpheus controls.
-
-See OrphStatus.html for more information.
-
diff --git a/Source/3rdParty/Orpheus/TO32FLEXEDIT.bmp b/Source/3rdParty/Orpheus/TO32FLEXEDIT.bmp
deleted file mode 100644
index e8f07794..00000000
Binary files a/Source/3rdParty/Orpheus/TO32FLEXEDIT.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/TO32TCFLEXEDIT.bmp b/Source/3rdParty/Orpheus/TO32TCFLEXEDIT.bmp
deleted file mode 100644
index 47eb1a62..00000000
Binary files a/Source/3rdParty/Orpheus/TO32TCFLEXEDIT.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/TOVCCALENDAR.bmp b/Source/3rdParty/Orpheus/TOVCCALENDAR.bmp
deleted file mode 100644
index 688f10ec..00000000
Binary files a/Source/3rdParty/Orpheus/TOVCCALENDAR.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/TOVCCONTROLLER.bmp b/Source/3rdParty/Orpheus/TOVCCONTROLLER.bmp
deleted file mode 100644
index 779c273a..00000000
Binary files a/Source/3rdParty/Orpheus/TOVCCONTROLLER.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/TOVCDATEEDIT.bmp b/Source/3rdParty/Orpheus/TOVCDATEEDIT.bmp
deleted file mode 100644
index fb386ba4..00000000
Binary files a/Source/3rdParty/Orpheus/TOVCDATEEDIT.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/TOVCLABEL.bmp b/Source/3rdParty/Orpheus/TOVCLABEL.bmp
deleted file mode 100644
index 20f540dd..00000000
Binary files a/Source/3rdParty/Orpheus/TOVCLABEL.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/TOVCROTATEDLABEL.bmp b/Source/3rdParty/Orpheus/TOVCROTATEDLABEL.bmp
deleted file mode 100644
index b2f3865c..00000000
Binary files a/Source/3rdParty/Orpheus/TOVCROTATEDLABEL.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/TOVCSIMPLEFIELD.bmp b/Source/3rdParty/Orpheus/TOVCSIMPLEFIELD.bmp
deleted file mode 100644
index 30eb1442..00000000
Binary files a/Source/3rdParty/Orpheus/TOVCSIMPLEFIELD.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/TOVCSPINNER.bmp b/Source/3rdParty/Orpheus/TOVCSPINNER.bmp
deleted file mode 100644
index 63dd1eda..00000000
Binary files a/Source/3rdParty/Orpheus/TOVCSPINNER.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/TOVCTABLE.bmp b/Source/3rdParty/Orpheus/TOVCTABLE.bmp
deleted file mode 100644
index 4635858f..00000000
Binary files a/Source/3rdParty/Orpheus/TOVCTABLE.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/TOVCTCBITMAP.bmp b/Source/3rdParty/Orpheus/TOVCTCBITMAP.bmp
deleted file mode 100644
index 67a4e63e..00000000
Binary files a/Source/3rdParty/Orpheus/TOVCTCBITMAP.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/TOVCTCCHECKBOX.bmp b/Source/3rdParty/Orpheus/TOVCTCCHECKBOX.bmp
deleted file mode 100644
index 054e81e7..00000000
Binary files a/Source/3rdParty/Orpheus/TOVCTCCHECKBOX.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/TOVCTCCOLHEAD.bmp b/Source/3rdParty/Orpheus/TOVCTCCOLHEAD.bmp
deleted file mode 100644
index 87a270b9..00000000
Binary files a/Source/3rdParty/Orpheus/TOVCTCCOLHEAD.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/TOVCTCCOMBOBOX.bmp b/Source/3rdParty/Orpheus/TOVCTCCOMBOBOX.bmp
deleted file mode 100644
index 6b48011e..00000000
Binary files a/Source/3rdParty/Orpheus/TOVCTCCOMBOBOX.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/TOVCTCGLYPH.bmp b/Source/3rdParty/Orpheus/TOVCTCGLYPH.bmp
deleted file mode 100644
index 85f1c571..00000000
Binary files a/Source/3rdParty/Orpheus/TOVCTCGLYPH.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/TOVCTCICON.bmp b/Source/3rdParty/Orpheus/TOVCTCICON.bmp
deleted file mode 100644
index 8131baf7..00000000
Binary files a/Source/3rdParty/Orpheus/TOVCTCICON.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/TOVCTCMEMO.bmp b/Source/3rdParty/Orpheus/TOVCTCMEMO.bmp
deleted file mode 100644
index 7bc7e880..00000000
Binary files a/Source/3rdParty/Orpheus/TOVCTCMEMO.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/TOVCTCROWHEAD.bmp b/Source/3rdParty/Orpheus/TOVCTCROWHEAD.bmp
deleted file mode 100644
index 1f072065..00000000
Binary files a/Source/3rdParty/Orpheus/TOVCTCROWHEAD.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/TOVCTCSIMPLEFIELD.bmp b/Source/3rdParty/Orpheus/TOVCTCSIMPLEFIELD.bmp
deleted file mode 100644
index cf5d9c51..00000000
Binary files a/Source/3rdParty/Orpheus/TOVCTCSIMPLEFIELD.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/TOVCTCSTRING.bmp b/Source/3rdParty/Orpheus/TOVCTCSTRING.bmp
deleted file mode 100644
index 2add159e..00000000
Binary files a/Source/3rdParty/Orpheus/TOVCTCSTRING.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/TOVCURL.bmp b/Source/3rdParty/Orpheus/TOVCURL.bmp
deleted file mode 100644
index d397374d..00000000
Binary files a/Source/3rdParty/Orpheus/TOVCURL.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/TOVCVIRTUALLISTBOX.bmp b/Source/3rdParty/Orpheus/TOVCVIRTUALLISTBOX.bmp
deleted file mode 100644
index 5d3b3563..00000000
Binary files a/Source/3rdParty/Orpheus/TOVCVIRTUALLISTBOX.bmp and /dev/null differ
diff --git a/Source/3rdParty/Orpheus/alltests-carbon.sh b/Source/3rdParty/Orpheus/alltests-carbon.sh
deleted file mode 100644
index 7143b039..00000000
--- a/Source/3rdParty/Orpheus/alltests-carbon.sh
+++ /dev/null
@@ -1,16 +0,0 @@
-#!/bin/sh
-lazdir=~/lazarus
-if ! [ -e $lazdir ]
-then
- lazdir=/usr/local/share/lazarus
-fi
-$lazdir/lazbuild -d --ws=carbon tests/TestFlexEdit/project1.lpi
-$lazdir/lazbuild -d --ws=carbon tests/TestLabel/project1.lpi
-$lazdir/lazbuild -d --ws=carbon tests/TestRLbl/project1.lpi
-$lazdir/lazbuild -d --ws=carbon tests/TestSimpField/project1.lpi
-$lazdir/lazbuild -d --ws=carbon tests/TestSpinner/project1.lpi
-$lazdir/lazbuild -d --ws=carbon tests/TestTable/project1.lpi
-$lazdir/lazbuild -d --ws=carbon tests/TestTblEdits/project1.lpi
-$lazdir/lazbuild -d --ws=carbon tests/TestURL/project1.lpi
-$lazdir/lazbuild -d --ws=carbon tests/TestVLB/project1.lpi
-$lazdir/lazbuild -d --ws=carbon tests/TestCalendar/project1.lpi
diff --git a/Source/3rdParty/Orpheus/alltests-gtk.sh b/Source/3rdParty/Orpheus/alltests-gtk.sh
deleted file mode 100644
index d84f6a28..00000000
--- a/Source/3rdParty/Orpheus/alltests-gtk.sh
+++ /dev/null
@@ -1,16 +0,0 @@
-#!/bin/sh
-lazdir=~/lazarus
-if ! [ -e $lazdir ]
-then
- lazdir=/usr/local/share/lazarus
-fi
-$lazdir/lazbuild -d --ws=gtk tests/TestFlexEdit/project1.lpi
-$lazdir/lazbuild -d --ws=gtk tests/TestLabel/project1.lpi
-$lazdir/lazbuild -d --ws=gtk tests/TestRLbl/project1.lpi
-$lazdir/lazbuild -d --ws=gtk tests/TestSimpField/project1.lpi
-$lazdir/lazbuild -d --ws=gtk tests/TestSpinner/project1.lpi
-$lazdir/lazbuild -d --ws=gtk tests/TestTable/project1.lpi
-$lazdir/lazbuild -d --ws=gtk tests/TestTblEdits/project1.lpi
-$lazdir/lazbuild -d --ws=gtk tests/TestURL/project1.lpi
-$lazdir/lazbuild -d --ws=gtk tests/TestVLB/project1.lpi
-$lazdir/lazbuild -d --ws=gtk tests/TestCalendar/project1.lpi
diff --git a/Source/3rdParty/Orpheus/alltests-linux.sh b/Source/3rdParty/Orpheus/alltests-linux.sh
deleted file mode 100644
index fc6dc345..00000000
--- a/Source/3rdParty/Orpheus/alltests-linux.sh
+++ /dev/null
@@ -1,12 +0,0 @@
-#!/bin/sh
-
-lazbuild -d tests/TestFlexEdit/project1.lpi
-lazbuild -d tests/TestLabel/project1.lpi
-lazbuild -d tests/TestRLbl/project1.lpi
-lazbuild -d tests/TestSimpField/project1.lpi
-lazbuild -d tests/TestSpinner/project1.lpi
-lazbuild -d tests/TestTable/project1.lpi
-lazbuild -d tests/TestTblEdits/project1.lpi
-lazbuild -d tests/TestURL/project1.lpi
-lazbuild -d tests/TestVLB/project1.lpi
-lazbuild -d tests/TestCalendar/project1.lpi
diff --git a/Source/3rdParty/Orpheus/alltests-win.bat b/Source/3rdParty/Orpheus/alltests-win.bat
deleted file mode 100644
index 7c4dfc66..00000000
--- a/Source/3rdParty/Orpheus/alltests-win.bat
+++ /dev/null
@@ -1,13 +0,0 @@
-setlocal
-set lazpath="c:\tools\lazarus"
-if not exist %lazpath% (set lazpath="c:\lazarus")
-"%lazpath%\lazbuild" -d tests/TestFlexEdit/project1.lpi
-"%lazpath%\lazbuild" -d tests/TestLabel/project1.lpi
-"%lazpath%\lazbuild" -d tests/TestRLbl/project1.lpi
-"%lazpath%\lazbuild" -d tests/TestSimpField/project1.lpi
-"%lazpath%\lazbuild" -d tests/TestSpinner/project1.lpi
-"%lazpath%\lazbuild" -d tests/TestTable/project1.lpi
-"%lazpath%\lazbuild" -d tests/TestTblEdits/project1.lpi
-"%lazpath%\lazbuild" -d tests/TestURL/project1.lpi
-"%lazpath%\lazbuild" -d tests/TestVLB/project1.lpi
-"%lazpath%\lazbuild" -d tests/TestCalendar/project1.lpi
diff --git a/Source/3rdParty/Orpheus/makebaseres.bat b/Source/3rdParty/Orpheus/makebaseres.bat
deleted file mode 100644
index 3b41d2cf..00000000
--- a/Source/3rdParty/Orpheus/makebaseres.bat
+++ /dev/null
@@ -1 +0,0 @@
-\tools\xdev\lazres ovcbase.lrs ORTCCOMBOARROW.bmp ORTCCHECKGLYPHS.bmp ORBTNCLC.bmp ORLEFTARROW.bmp ORLEFTARROWS.bmp ORRIGHTARROW.bmp ORRIGHTARROWS.bmp ORREVERT.bmp ORTODAY.bmp ORBTNCAL.bmp ORCOLUMNMOVECURSOR.cur ORROWMOVECURSOR.cur
\ No newline at end of file
diff --git a/Source/3rdParty/Orpheus/makeregres.bat b/Source/3rdParty/Orpheus/makeregres.bat
deleted file mode 100644
index 93d164bb..00000000
--- a/Source/3rdParty/Orpheus/makeregres.bat
+++ /dev/null
@@ -1 +0,0 @@
-\tools\xdev\lazres ovcreg.lrs TOVCCONTROLLER.bmp TOVCTCSTRING.bmp TOVCTCCOLHEAD.bmp TOVCTCROWHEAD.bmp TOVCTCCOMBOBOX.bmp TOVCTCSIMPLEFIELD.bmp TOVCTCCHECKBOX.bmp TOVCTABLE.bmp TOVCURL.bmp TOVCSIMPLEFIELD.bmp TO32FLEXEDIT.bmp TO32TCFLEXEDIT.bmp TOVCTCMEMO.bmp TOVCTCBITMAP.bmp TOVCTCGLYPH.bmp TOVCTCICON.bmp TOVCROTATEDLABEL.bmp TOVCSPINNER.bmp TOVCLABEL.bmp TOVCVIRTUALLISTBOX.bmp TOVCCALENDAR.bmp TOVCDATEEDIT.bmp ORREDDOT.bmp ORBLUEDOT.bmp
\ No newline at end of file
diff --git a/Source/3rdParty/Orpheus/mymin.pas b/Source/3rdParty/Orpheus/mymin.pas
deleted file mode 100644
index b40bc941..00000000
--- a/Source/3rdParty/Orpheus/mymin.pas
+++ /dev/null
@@ -1,36 +0,0 @@
-unit MyMin;
-
- {Minimum uses to compile all ported runtime and property
- editor (design) units.
-
- Note: Doesn't compile orpheus.pas.}
-
-interface
-
-uses
- ovctcsim,
- ovctcedt,
- ovctccbx,
- ovctcbox,
- ovctcico,
- ovctable,
- o32tcflx,
- o32vpool,
- ovcrlbl,
- ovcurl,
- ovclabel,
- ovcsc,
- ovcvlb,
- ovcclrcb
-{$IFDEF FPC}, {These already installed in Delphi}
- ovcabot0,
- ovclbl0,
- ovclbl1,
- myovctbpe1,
- myovctbpe2,
- myovcreg
-{$ENDIF};
-
-implementation
-
-end.
diff --git a/Source/3rdParty/Orpheus/mymisc.pas b/Source/3rdParty/Orpheus/mymisc.pas
deleted file mode 100644
index da5372a6..00000000
--- a/Source/3rdParty/Orpheus/mymisc.pas
+++ /dev/null
@@ -1,1033 +0,0 @@
-{*********************************************************}
-{* mymisc.pas *}
-{*********************************************************}
-
-{* ***** 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 Orpheus for Lazarus Additional Units. *}
-{* *}
-{* The Initial Developer of the Original Code is Phil Hess. *}
-{* *}
-{* Portions created by Phil Hess are Copyright (C) 2006 Phil Hess. *}
-{* All Rights Reserved. *}
-{* *}
-{* Contributor(s): *}
-{* *}
-{* ***** END LICENSE BLOCK ***** *}
-
-unit MyMisc;
-
-{
- This unit provides types, constants, and functions that fill
- in some gaps in the Lazarus LCL for compiling the ported
- Orpheus controls.
-
- Declarations that have been commented out in the interface
- section are no longer needed. It is expected that over time
- more of these can be eliminated as the LCL evolves.
-
- Several of these functions are only used by Orpheus units
- that have not yet been ported to Lazarus. For now, these
- functions are just stubs on non-Windows platforms, as
- indicated in the function comments.
-}
-
-{$I ovc.inc}
-
-interface
-
-uses
- SysUtils,
- {$IFDEF MSWINDOWS} Windows, {$ELSE} Types, {$ENDIF}
- LclIntf, LMessages, LclType, InterfaceBase,
- {$IFDEF LINUX} FileUtil, {$ENDIF}
- GraphType, Graphics, Controls;
-
-type
- TButtonStyle = (bsAutoDetect, bsWin31, bsNew);
-
- TWMMouse = TLMMouse;
- TWMKeyDown = TLMKeyDown;
- TWMNCHitTest = TLMNCHitTest;
- TWMSetText = TLMSetText;
- TCMDesignHitTest = TWMMouse;
- TWMChar = TLMChar;
- TWMClear = TLMNoParams;
- TWMCopy = TLMNoParams;
- TWMCut = TLMNoParams;
- TWMLButtonDblClk = TLMLButtonDblClk;
- TWMLButtonDown = TLMLButtonDown;
- TWMLButtonUp = TLMLButtonUp;
- TWMRButtonDown = TLMRButtonDown;
- TWMSysKeyDown = TLMSysKeyDown;
- TWMMouseActivate = packed record
- Msg: Cardinal;
-{$ifdef cpu64} //64
- UnusedMsg: Cardinal;
-{$endif}
- TopLevel: HWND;
- HitTestCode: Word;
- MouseMsg: Word;
-{$ifdef cpu64} //64
- Unused: Longint;
-{$endif}
- Result: LRESULT; //64
- end;
- TWMMouseMove = TLMMouseMove;
- TWMPaste = TLMNoParams;
- TMessage = TLMessage;
- TWMEraseBkgnd = TLMEraseBkgnd;
- TWMGetText = TLMGetText;
- TWMGetTextLength = TLMGetTextLength;
- TWMKillFocus = TLMKillFocus;
- TWMSetCursor = TLMSetCursor; //64
-// TWMSetCursor = packed record
-// Msg: Cardinal;
-// CursorWnd: HWND;
-// HitTest: Word;
-// MouseMsg: Word;
-// Result: Longint;
-// end;
- TWMSetFocus = TLMSetFocus;
- TWMGetDlgCode = TLMNoParams;
- TWMSize = TLMSize;
- TWMSetFont = packed record
- Msg: Cardinal;
-{$ifdef cpu64} //64
- UnusedMsg: Cardinal;
-{$endif}
- Font: HFONT;
- Redraw: WordBool;
- Unused: Word;
-{$ifdef cpu64} //64
- Unused2: Longint;
-{$endif}
- Result: LRESULT; //64
- end;
- TWMCommand = TLMCommand;
- TWMDrawItem = TLMDrawItems;
- LPDWORD = PDWORD;
- TFNWndEnumProc = TFarProc;
- TNonClientMetrics = packed record
- cbSize: UINT;
- iBorderWidth: Integer;
- iScrollWidth: Integer;
- iScrollHeight: Integer;
- iCaptionWidth: Integer;
- iCaptionHeight: Integer;
- lfCaptionFont: TLogFontA;
- iSmCaptionWidth: Integer;
- iSmCaptionHeight: Integer;
- lfSmCaptionFont: TLogFontA;
- iMenuWidth: Integer;
- iMenuHeight: Integer;
- lfMenuFont: TLogFontA;
- lfStatusFont: TLogFontA;
- lfMessageFont: TLogFontA;
- end;
- TWMKey = TLMKey;
- TWMScroll = TLMScroll;
- TWMNoParams = TLMNoParams;
- TWMPaint = TLMPaint;
- TWMNCPaint = packed record
- Msg: Cardinal;
-{$ifdef cpu64} //64
- UnusedMsg: Cardinal;
-{$endif}
- RGN: HRGN;
- Unused: LPARAM; //64
- Result: LRESULT; //64
- end;
- TWMHScroll = TLMHScroll;
- TWMVScroll = TLMVScroll;
-
-const
- WM_WININICHANGE = CM_WININICHANGE;
- WM_CANCELMODE = LM_CANCELMODE;
- WM_ERASEBKGND = LM_ERASEBKGND;
- WM_GETTEXTLENGTH = LM_GETTEXTLENGTH;
- WM_KEYDOWN = LM_KEYDOWN;
- WM_KILLFOCUS = LM_KILLFOCUS;
- WM_LBUTTONDOWN = LM_LBUTTONDOWN;
- WM_LBUTTONUP = LM_LBUTTONUP;
- WM_MOUSEMOVE = LM_MOUSEMOVE;
- WM_NCHITTEST = LM_NCHITTEST;
- WM_SETCURSOR = LM_SETCURSOR;
- WM_SETTEXT = $000C;
- WM_GETTEXT = $000D;
- WM_SETFOCUS = LM_SETFOCUS;
- WM_CHAR = LM_CHAR;
- WM_CLEAR = LM_CLEAR;
- WM_COPY = LM_COPY;
- WM_CUT = LM_CUT;
- WM_PASTE = LM_PASTE;
-// With Lazarus versions prior to March 2008, LM_CLEAR, etc. are not defined,
-// so comment previous 4 lines and uncomment next 4 lines.
-{
- WM_CLEAR = LM_CLEARSEL;
- WM_COPY = LM_COPYTOCLIP;
- WM_CUT = LM_CUTTOCLIP;
- WM_PASTE = LM_PASTEFROMCLIP;
-}
- WM_GETDLGCODE = LM_GETDLGCODE;
- WM_SIZE = LM_SIZE;
- WM_SETFONT = LM_SETFONT;
- WM_SYSKEYDOWN = LM_SYSKEYDOWN;
- WM_RBUTTONUP = LM_RBUTTONUP;
- WM_MOUSEACTIVATE = $0021;
- WM_LBUTTONDBLCLK = LM_LBUTTONDBLCLK;
- WM_SETREDRAW = $000B;
- WM_NEXTDLGCTL = $0028;
- WM_MOUSEWHEEL = LM_MOUSEWHEEL;
- WM_PAINT = LM_PAINT;
- WM_VSCROLL = LM_VSCROLL;
- WM_HSCROLL = LM_HSCROLL;
- WM_NCPAINT = LM_NCPAINT;
- WM_MEASUREITEM = LM_MEASUREITEM;
-
- EM_GETMODIFY = $00B8;
- EM_SETMODIFY = $00B9;
- EM_GETSEL = $00B0;
- EM_SETSEL = $00B1;
- EM_GETLINECOUNT = $00BA;
- EM_LINELENGTH = $00C1;
- EM_LINEINDEX = $00BB;
- EM_GETLINE = $00C4;
- EM_REPLACESEL = $00C2;
-
- CS_SAVEBITS = $800;
- CS_DBLCLKS = 8;
- SPI_GETWORKAREA = 48;
- SPI_GETNONCLIENTMETRICS = 41;
- DLGC_STATIC = $100;
- GW_HWNDLAST = 1;
- GW_HWNDNEXT = 2;
- GW_HWNDPREV = 3;
- GW_CHILD = 5;
- DT_EXPANDTABS = $40;
- DT_END_ELLIPSIS = $8000;
- DT_MODIFYSTRING = $10000;
- GHND = 66;
- TMPF_TRUETYPE = 4;
- SWP_HIDEWINDOW = $80;
- SWP_SHOWWINDOW = $40;
- RDW_INVALIDATE = 1;
- RDW_UPDATENOW = $100;
- RDW_FRAME = $400;
- LANG_JAPANESE = $11;
- ES_PASSWORD = $20;
- ES_LEFT = 0;
- ES_RIGHT = 2;
- ES_CENTER = 1;
- ES_AUTOHSCROLL = $80;
- ES_MULTILINE = 4;
- ODS_COMBOBOXEDIT = $1000;
- CB_FINDSTRING = $014C;
- CB_SETITEMHEIGHT = $0153;
- CB_FINDSTRINGEXACT = $0158;
- CB_SETDROPPEDWIDTH = 352;
- CBS_DROPDOWN = 2;
- CBS_DROPDOWNLIST = 3;
- CBS_OWNERDRAWVARIABLE = $20;
- CBS_AUTOHSCROLL = $40;
- CBS_HASSTRINGS = $200;
- WHEEL_DELTA = 120;
- LB_GETCARETINDEX = $019F;
- LB_GETCOUNT = $018B;
- LB_GETCURSEL = $0188;
- LB_GETITEMHEIGHT = $01A1;
- LB_GETITEMRECT = $0198;
- LB_GETSEL = $0187;
- LB_GETTOPINDEX = $018E;
- LB_RESETCONTENT = $0184;
- LB_SELITEMRANGE = $019B;
- LB_SETCURSEL = $0186;
- LB_SETSEL = $0185;
- LB_SETTABSTOPS = $0192;
- LB_SETTOPINDEX = $0197;
- LB_ERR = -1;
- MA_ACTIVATE = 1;
- MA_NOACTIVATEANDEAT = 4;
-
-
- {These belong in LclIntf unit}
-function IsCharAlpha(c : Char) : Boolean;
-function DefWindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
-function GetProfileInt(lpAppName, lpKeyName: PChar; nDefault: Integer): UINT;
-function GetProfileString(lpAppName, lpKeyName, lpDefault: PChar;
- lpReturnedString: PChar; nSize: DWORD): DWORD;
-function GetTickCount : DWORD;
-//function SetTimer(hWnd: HWND; nIDEvent, uElapse: UINT;
-// lpTimerFunc: TFNTimerProc): UINT;
-//function KillTimer(hWnd: HWND; uIDEvent: UINT): BOOL;
-function GetCaretBlinkTime: UINT;
-function SetCaretBlinkTime(uMSeconds: UINT): BOOL;
-//function DestroyCaret: BOOL;
-function MessageBeep(uType: UINT): BOOL;
-function SystemParametersInfo(uiAction, uiParam: UINT;
- pvParam: Pointer; fWinIni: UINT): BOOL;
-{$IFNDEF MSWINDOWS}
-function GetSystemMetrics(nIndex: Integer): Integer;
-{$ENDIF}
-function MoveWindow(hWnd: HWND; X, Y, nWidth, nHeight: Integer; bRepaint: BOOL): BOOL;
-function SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND;
- X, Y, cx, cy: Integer; uFlags: UINT): BOOL;
-function UpdateWindow(hWnd: HWND): BOOL;
-function ValidateRect(hWnd: HWND; lpRect: PRect): BOOL;
-function InvalidateRect(hWnd: HWND; lpRect: PRect; bErase: BOOL): BOOL;
-function InvalidateRgn(hWnd: HWND; hRgn: HRGN; bErase: BOOL): BOOL;
-function GetRgnBox(RGN : HRGN; lpRect : PRect) : Longint;
-function PtInRegion(RGN: HRGN; X, Y: Integer) : Boolean;
-function SetWindowText(hWnd: HWND; lpString: PChar): BOOL;
-function GetBkColor(hDC: HDC): COLORREF;
-function GetBkMode(hDC: HDC): Integer;
-function GetWindow(hWnd: HWND; uCmd: UINT): HWND;
-function GetNextWindow(hWnd: HWND; uCmd: UINT): HWND;
-function RedrawWindow(hWnd: HWND; lprcUpdate: PRect; hrgnUpdate: HRGN; flags: UINT): BOOL;
-function GetWindowDC(hWnd: HWND): HDC;
-function ScrollDC(DC: HDC; DX, DY: Integer; var Scroll, Clip: TRect; Rgn: HRGN;
- Update: PRect): BOOL;
-function SetScrollRange(hWnd: HWND; nBar, nMinPos, nMaxPos: Integer; bRedraw: BOOL): BOOL;
-function GetTabbedTextExtent(hDC: HDC; lpString: PChar;
- nCount, nTabPositions: Integer;
- var lpnTabStopPositions): DWORD;
-function TabbedTextOut(hDC: HDC; X, Y: Integer; lpString: PChar;
- nCount, nTabPositions: Integer;
- var lpnTabStopPositions; nTabOrigin: Integer): Longint;
-function SetTextAlign(DC: HDC; Flags: UINT): UINT;
-function GetMapMode(DC: HDC): Integer;
-function SetMapMode(DC: HDC; p2: Integer): Integer;
-//function LoadBitmap(hInstance: HINST; lpBitmapName: PAnsiChar): HBITMAP;
-//function LoadCursor(hInstance: HINST; lpCursorName: PAnsiChar): HCURSOR;
-function EnumThreadWindows(dwThreadId: DWORD; lpfn: TFNWndEnumProc; lParam: LPARAM): BOOL;
-procedure OutputDebugString(lpOutputString: PChar);
-function SetViewportOrgEx(DC: HDC; X, Y: Integer; Point: PPoint): BOOL;
-function GlobalAlloc(uFlags: UINT; dwBytes: DWORD): HGLOBAL;
-function GlobalLock(hMem: HGLOBAL): Pointer;
-function GlobalUnlock(hMem: HGLOBAL): BOOL;
-//function DestroyCursor(hCursor: HICON): BOOL;
-//{$IFDEF MSWINDOWS} //Not needed with GTK and Qt (but doesn't hurt); Win32 and Carbon need it.
-function PostMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL;
-function SendMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
-//{$ENDIF}
-procedure RecreateWnd(const AWinControl:TWinControl);
-
- {These belong in Classes unit}
-//function MakeObjectInstance(Method: TWndMethod): Pointer;
-//procedure FreeObjectInstance(ObjectInstance: Pointer);
-//function AllocateHWnd(Method: TWndMethod): HWND;
-//procedure DeallocateHWnd(Wnd: HWND);
-
- {This belongs in System unit}
-//function FindClassHInstance(ClassType: TClass): LongWord;
-
- {This belongs in ExtCtrls unit}
-procedure Frame3D(Canvas: TCanvas; var Rect: TRect;
- TopColor, BottomColor: TColor; Width: Integer);
-
-// {This should be a TCanvas method} <--it is now, but still needed for TBitMap.BrushCopy.
-procedure BrushCopy(DestCanvas: TCanvas; const Dest: TRect; Bitmap: TBitmap;
- const Source: TRect; Color: TColor);
-
- {This belongs in Buttons unit}
-function DrawButtonFace(Canvas: TCanvas; const Client: TRect;
- BevelWidth: Integer; Style: TButtonStyle;
- IsRounded, IsDown, IsFocused: Boolean): TRect;
-
- {Additional routines}
-{$IFDEF LINUX}
-function GetBrowserPath : string;
-{$ENDIF}
-
-
-implementation
-
- {These functions belong in LclIntf unit}
-
-function IsCharAlpha(c : Char) : Boolean;
-// Doesn't handle upper-ANSI chars, but then LCL IsCharAlphaNumeric
-// function doesn't either.
-begin
- Result := ((Ord(c) >= 65) and (Ord(c) <= 90)) or
- ((Ord(c) >= 97) and (Ord(c) <= 122));
-end;
-
-function DefWindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
-// DefWindowProc is a Win API function for handling any window message
-// that the application doesn't handle.
-// Can't find equivalent in LCL.
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.DefWindowProc(hWnd, Msg, wParam, lParam);
-{$ELSE}
- Result := 0;
-{$ENDIF}
-end;
-
-function GetProfileInt(lpAppName, lpKeyName: PChar; nDefault: Integer): UINT;
-// Return the integer value for the key name in the lpAppName section
-// of the WIN.INI file, which on Win32 maps to the corresponding
-// section of the Windows registry.
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GetProfileInt(lpAppName, lpKeyName, nDefault);
-{$ELSE} //Just return default for now.
- Result := nDefault;
-{$ENDIF}
-end;
-
-function GetProfileString(lpAppName, lpKeyName, lpDefault: PChar;
- lpReturnedString: PChar; nSize: DWORD): DWORD;
-// Return the string value for the key name in the lpAppName section
-// of the WIN.INI file, which on Win32 maps to the corresponding
-// section of the Windows registry.
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GetProfileString(lpAppName, lpKeyName, lpDefault,
- lpReturnedString, nSize);
-{$ELSE} //Just return default for now.
- StrLCopy(lpReturnedString, lpDefault, Pred(nSize));
-{$ENDIF}
-end;
-
-function GetTickCount : DWORD;
- {On Windows, this is number of milliseconds since Windows was
- started. On non-Windows platforms, LCL returns number of
- milliseconds since Dec. 30, 1899, wrapped by size of DWORD.
- This value can overflow LongInt variable when checks turned on,
- so "wrap" value here so it fits within LongInt.
- Also, since same thing could happen with Windows that has been
- running for at least approx. 25 days, override it too.}
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GetTickCount mod High(LongInt);
-{$ELSE}
- Result := LclIntf.GetTickCount mod High(LongInt);
-{$ENDIF}
-end;
-
-function SetTimer(hWnd: HWND; nIDEvent, uElapse: UINT;
- lpTimerFunc: TFNTimerProc): UINT;
-begin
-{$IFDEF MSWINDOWS}
- Result := {Windows.}SetTimer(hWnd, nIDEvent, uElapse, lpTimerFunc);
-{$ENDIF}
-end;
-
-function KillTimer(hWnd: HWND; uIDEvent: UINT): BOOL;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.KillTimer(hWnd, UIDEvent);
-{$ENDIF}
-end;
-
-function GetCaretBlinkTime: UINT;
-// This function and SetCaretBlinkTime are only used in OvcCaret unit's
-// TOvcSingleCaret.SetLinked, which is used to write Linked property.
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GetCaretBlinkTime;
-{$ELSE}
- Result := 530; //Default on Win XP, so use as reasonable value
-{$ENDIF}
-end;
-
-function SetCaretBlinkTime(uMSeconds: UINT): BOOL;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.SetCaretBlinkTime(uMSeconds);
-{$ENDIF}
-end;
-
-function DestroyCaret: BOOL;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.DestroyCaret;
-{$ENDIF}
-end;
-
-function MessageBeep(uType: UINT): BOOL;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.MessageBeep(uType);
-{$ELSE}
- Beep; //Most calls pass 0 as uType (MB_OK), which is system default sound}
-{$ENDIF}
-end;
-
-function SystemParametersInfo(uiAction, uiParam: UINT;
- pvParam: Pointer; fWinIni: UINT): BOOL;
-// Only used in:
-// OvcMisc: PathEllipsis, which is only used in ovcmru (not yet ported).
-// OvcEdClc: TOvcCustomNumberEdit.PopupOpen.
-// OvcEdCal: TOvcCustomDateEdit.PopupOpen.
-// OvcEdSld (not yet ported).
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.SystemParametersInfo(uiAction, uiParam, pvParam,
- fWinIni);
-{$ENDIF}
-end;
-
-{$IFNDEF MSWINDOWS}
-function GetSystemMetrics(nIndex: Integer): Integer;
-// SM_CYBORDER, etc. not implemented yet in GTK widgetset.
-begin
- if nIndex = SM_SWAPBUTTON then
- Result := 0 {Not implemented on GTK, so assume buttons not swapped}
- else
- begin
- if nIndex = SM_CYBORDER then
-// nIndex := SM_CYEDGE; //Substitute for now so returned value is valid.
- begin //Neither implemented, so catch here to eliminate TODO messages.
- Result := 0; //0 was being returned before.
- Exit;
- end;
- Result := LclIntf.GetSystemMetrics(nIndex);
- end;
-end;
-{$ENDIF}
-
-function MoveWindow(hWnd: HWND; X, Y, nWidth, nHeight: Integer; bRepaint: BOOL): BOOL;
-// Only used in:
-// OvcEdClc: TOvcCustomNumberEdit.PopupOpen.
-// OvcEdCal: TOvcCustomDateEdit.PopupOpen.
-// OvcEdSld (not yet ported).
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.MoveWindow(hWnd, X, Y, nWidth, nHeight, bRepaint);
-{$ENDIF}
-end;
-
-function SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND;
- X, Y, cx, cy: Integer; uFlags: UINT): BOOL;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.SetWindowPos(hWnd, hWndInsertAfter, X, Y, cx, cy, uFlags);
-{$ELSE} //Doesn't do much with GTK, but call it anyway.
- Result := LclIntf.SetWindowPos(hWnd, hWndInsertAfter, X, Y, cx, cy, uFlags);
- if (uFlags and SWP_HIDEWINDOW) <> 0 then
- FindControl(hWnd).Visible := False
- else if (uFlags and SWP_SHOWWINDOW) <> 0 then
- FindControl(hWnd).Visible := True;
-{$ENDIF}
-end;
-
-function UpdateWindow(hWnd: HWND): BOOL;
- {For some reason, implementing this function in win32 widgetset
- on 27-May-2008 broke TOvcTable when a manifest is used.
- Since TOvcTable worked when this function was not implemented,
- just intercept and ignore call for now.}
-begin
- Result := True;
-end;
-
-function ValidateRect(hWnd: HWND; lpRect: PRect): BOOL;
-// Since LCL InvalidateRect redraws window, shouldn't need this function,
-// so leave it as stub for now.
-begin
-{$IFDEF MSWINDOWS}
-// Result := Windows.ValidateRect(hWnd, lpRect);
-{$ENDIF}
- Result := True;
-end;
-
-function InvalidateRect(hWnd: HWND; lpRect: PRect; bErase: BOOL): BOOL;
- {InvalidateRect crashes if lpRect is nil with some versions of LCL.}
-begin
-{$IFDEF MSWINDOWS}
- if Assigned(lpRect) then
- Result := LclIntf.InvalidateRect(hWnd, lpRect, bErase)
- else
- Result := Windows.InvalidateRect(hWnd, lpRect, bErase);
-{$ELSE}
- if Assigned(lpRect) then
- Result := LclIntf.InvalidateRect(hWnd, lpRect, bErase)
- else
- Result := True;
- //For now just ignore if nil since no alternative as with Windows.
-{$ENDIF}
-end;
-
-function InvalidateRgn(hWnd: HWND; hRgn: HRGN; bErase: BOOL): BOOL;
-{$IFDEF MSWINDOWS}
-begin
- Result := Windows.InvalidateRgn(hWnd, hRgn, bErase);
-{$ELSE}
-var
- ARect : TRect;
-begin
- GetRgnBox(hRgn, @ARect);
- Result := InvalidateRect(hWnd, @ARect, bErase);
-{$ENDIF}
-end;
-
-function GetRgnBox(RGN : HRGN; lpRect : PRect) : Longint;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GetRgnBox(RGN, lpRect);
-{$ELSE}
- Result := LclIntf.GetRgnBox(RGN, lpRect);
-{$ENDIF}
-end;
-
-function PtInRegion(RGN: HRGN; X, Y: Integer) : Boolean;
-{$IFDEF MSWINDOWS}
-begin
- Result := Windows.PtInRegion(RGN, X, Y);
-{$ELSE}
-var
- ARect : TRect;
- APt : TPoint;
-begin
- GetRgnBox(RGN, @ARect);
- APt.X := X;
- APt.Y := Y;
- Result := LclIntf.PtInRect(ARect, APt);
-{$ENDIF}
-end;
-
-function SetWindowText(hWnd: HWND; lpString: PChar): BOOL;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.SetWindowText(hWnd, lpString);
-{$ELSE}
-// Use FindControl, then assign to control's Text property?
-{$ENDIF}
-end;
-
-function GetBkColor(hDC: HDC): COLORREF;
-// Only used in:
-// OvcEF: TOvcBaseEntryField.efPaintPrim.
-// OvcLkOut (not yet ported).
-// O32LkOut (not yet ported).
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GetBkColor(hDC);
-{$ELSE} // Since SetBkColor returns previous color, use it to get color.
- Result := SetBkColor(hDC, 0); //Set background color to black.
- SetBkColor(hDC, Result); //Restore background color
-{$ENDIF}
-end;
-
-function GetBkMode(hDC: HDC): Integer;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GetBkMode(hDC);
-{$ELSE}
- Result := TRANSPARENT; //For now
-// Result := SetBkMode(hDC, TRANSPARENT); //Use when widgetsets support it
-// SetBkMode(hDC, Result);
-{$ENDIF}
-end;
-
-function GetWindow(hWnd: HWND; uCmd: UINT): HWND;
-{$IFDEF MSWINDOWS}
-begin
- Result := Windows.GetWindow(hWnd, uCmd);
-{$ELSE}
-var
- AWinControl : TWinControl;
-begin
- Result := 0;
- AWinControl := FindControl(hWnd);
- if AWinControl <> nil then
- begin
- case uCmd of
- GW_HWNDNEXT :
- begin
-// FindNextControl is declared in protected section, so can't use it.
-// AWinControl := AWinControl.FindNextControl(AWinControl, True, False, False);
-// if AWinControl <> nil then
-// Result := AWinControl.Handle;
- end;
- GW_CHILD :
- begin
- if AWinControl.ControlCount > 0 then
- Result := TWinControl(AWinControl.Controls[0]).Handle;
- end;
- GW_HWNDLAST :
- begin
- if AWinControl.Parent <> nil then
- Result := TWinControl(AWinControl.Parent.Controls[Pred(AWinControl.Parent.ControlCount)]).Handle;
- end;
- end;
- end;
-{$ENDIF}
-end;
-
-function GetNextWindow(hWnd: HWND; uCmd: UINT): HWND;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GetNextWindow(hWnd, uCmd);
-{$ELSE}
- Result := GetWindow(hWnd, uCmd);
-{$ENDIF}
-end;
-
-function RedrawWindow(hWnd: HWND; lprcUpdate: PRect; hrgnUpdate: HRGN; flags: UINT): BOOL;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.RedrawWindow(hWnd, lprcUpdate, hrgnUpdate, flags);
-{$ELSE}
-{$ENDIF}
-end;
-
-function GetWindowDC(hWnd: HWND): HDC;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GetWindowDC(hWnd);
-{$ELSE}
-{$ENDIF}
-end;
-
-function ScrollDC(DC: HDC; DX, DY: Integer; var Scroll, Clip: TRect; Rgn: HRGN;
- Update: PRect): BOOL;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.ScrollDC(DC, DX, DY, Scroll, Clip, Rgn, Update);
-{$ELSE}
-{$ENDIF}
-end;
-
-function SetScrollRange(hWnd: HWND; nBar, nMinPos, nMaxPos: Integer; bRedraw: BOOL): BOOL;
-{$IFDEF MSWINDOWS}
-begin
- Result := Windows.SetScrollRange(hWnd, nBar, nMinPos, nMaxPos, bRedraw);
-end;
-{$ELSE} //GTK needs more information, so use SetScrollInfo
-var
- ScrInfo : TScrollInfo;
-begin
- ScrInfo.fMask := SIF_RANGE or SIF_UPDATEPOLICY;
- ScrInfo.nTrackPos := SB_POLICY_CONTINUOUS;
- ScrInfo.nMin := nMinPos;
- ScrInfo.nMax := nMaxPos;
- LclIntf.SetScrollInfo(hWnd, nBar, ScrInfo, True);
- Result := True;
-end;
-{$ENDIF}
-
-function GetTabbedTextExtent(hDC: HDC; lpString: PChar;
- nCount, nTabPositions: Integer;
- var lpnTabStopPositions): DWORD;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GetTabbedTextExtent(hDC, lpString, nCount, nTabPositions,
- lpnTabStopPositions);
-{$ELSE}
- Result := 0; //Not implemented yet (see comment below).
-{$ENDIF}
-end;
-
-function TabbedTextOut(hDC: HDC; X, Y: Integer; lpString: PChar;
- nCount, nTabPositions: Integer;
- var lpnTabStopPositions; nTabOrigin: Integer): Longint;
-{$IFDEF MSWINDOWS}
-begin
- Result := Windows.TabbedTextOut(hDC, X, Y, lpString, nCount, nTabPositions,
- lpnTabStopPositions, nTabOrigin);
-{$ELSE}
-// TODO: Not yet implemented since not needed by Orpheus:
-// -Special case where nTabPositions is 0 and lpnTabStopPositions is nil.
-// -Special case where nTabPositions is 1 and >1 tab in string.
-// -Return value (height and width of string).
-// -Use of nTabOrigin. This is used in OvcVLB as a negative offset
-// with horizontal scrolling, but value passed is determined by
-// GetTabbedTextExtent, which is not yet implemented (above). Shouldn't
-// be needed if virtual list box doesn't have horizontal scrollbar.
-type
- TTabArray = array[1..1000] of Integer; {Assume no more than this many tabs}
-var
- OutX : Integer;
- TabCnt : Integer;
- StartPos : Integer;
- CharPos : Integer;
- OutCnt : Integer;
- TextSize : TSize;
-begin
- OutX := X;
- TabCnt := 0;
- StartPos := 0;
- for CharPos := 0 to Pred(nCount) do
- begin
- if (lpString[CharPos] = #9) or (CharPos = Pred(nCount)) then {Output text?}
- begin
- OutCnt := CharPos - StartPos;
- if CharPos = Pred(nCount) then {Include last char?}
- Inc(OutCnt);
- if (TabCnt > 0) and (TTabArray(lpnTabStopPositions)[TabCnt] < 0) then
- begin {Negative tab position means following text is right-aligned to it}
- GetTextExtentPoint(hDC, lpString+StartPos, OutCnt, TextSize);
- OutX := X + Abs(TTabArray(lpnTabStopPositions)[TabCnt]) - TextSize.cx;
- end;
- LclIntf.TextOut(hDC, OutX, Y, lpString+StartPos, OutCnt);
- StartPos := Succ(CharPos);
- if (lpString[CharPos] = #9) and (TabCnt < nTabPositions) then
- begin
- Inc(TabCnt);
- OutX := X + TTabArray(lpnTabStopPositions)[TabCnt];
- end;
- end;
- end;
- Result := 0; //Just return this for now.
-{$ENDIF}
-end;
-
-function SetTextAlign(DC: HDC; Flags: UINT): UINT;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.SetTextAlign(DC, Flags);
-{$ELSE}
-{$ENDIF}
-end;
-
-function GetMapMode(DC: HDC): Integer;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GetMapMode(DC);
-{$ELSE}
-{$ENDIF}
-end;
-
-function SetMapMode(DC: HDC; p2: Integer): Integer;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.SetMapMode(DC, p2);
-{$ELSE}
-{$ENDIF}
-end;
-
-function LoadBitmap(hInstance: HINST; lpBitmapName: PAnsiChar): HBITMAP;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.LoadBitmap(hInstance, lpBitmapName);
-{$ENDIF}
-end;
-
-function LoadCursor(hInstance: HINST; lpCursorName: PAnsiChar): HCURSOR;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.LoadCursor(hInstance, lpCursorName);
-{$ENDIF}
-end;
-
-function EnumThreadWindows(dwThreadId: DWORD; lpfn: TFNWndEnumProc; lParam: LPARAM): BOOL;
-// Only used in OvcMisc IsForegroundTask function, which is only
-// used in OvcSpeed (not yet ported).
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.EnumThreadWindows(dwThreadId, lpfn, lParam);
-{$ENDIF}
-end;
-
-procedure OutputDebugString(lpOutputString: PChar);
-begin
-{$IFDEF MSWINDOWS}
- Windows.OutputDebugString(lpOutputString);
-{$ENDIF}
-end;
-
-function SetViewportOrgEx(DC: HDC; X, Y: Integer; Point: PPoint): BOOL;
-// Only used in OvcMisc CopyParentImage procedure, which is only
-// used by TOvcCustomSpeedButton.Paint in OvcSpeed (not yet ported).
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.SetViewportOrgEx(DC, X, Y, Point);
-{$ENDIF}
-end;
-
-function GlobalAlloc(uFlags: UINT; dwBytes: DWORD): HGLOBAL;
-// GlobalAlloc, GlobalLock, and GlobalUnlock are only used in:
-// OvcEF: TOvcBaseEntryField.efCopyPrim and TOvcBaseEntryField.WMPaste.
-// OvcEdit (not yet ported).
-// OvcViewr (not yet ported).
-// Replace code in those units with calls to standard Clipboard methods?
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GlobalAlloc(uFlags, dwBytes);
-{$ELSE}
- Result := THandle(GetMem(dwBytes));
-{$ENDIF}
-end;
-
-function GlobalLock(hMem: HGLOBAL): Pointer;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GlobalLock(hMem);
-{$ELSE}
- Result := PAnsiChar(hMem);
-{$ENDIF}
-end;
-
-function GlobalUnlock(hMem: HGLOBAL): BOOL;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.GlobalUnlock(hMem);
-{$ELSE}
- FreeMem(Pointer(hMem));
- Result := True;
-{$ENDIF}
-end;
-
-function DestroyCursor(hCursor: HICON): BOOL;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.DestroyCursor(hCursor);
-{$ENDIF}
-end;
-
-
-function PostMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL;
- {Use control's Perform method to force it to respond to posted message.
- This doesn't work: Result := LclIntf.PostMessage(hWnd, Msg, wParam, lParam); }
-var
- AWinControl : TWinControl;
-begin
- Assert(hWnd <> 0, 'Window handle not assigned on entry to PostMessage');
- AWinControl := FindOwnerControl(hWnd);
-// Assert(AWinControl <> nil,
-// 'Owner control not found in PostMessage ($' + IntToHex(Msg, 4) + ') ');
- if AWinControl <> nil then
- AWinControl.Perform(Msg, wParam, lParam);
- Result := True;
-end;
-
-function SendMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT;
- {Use control's Perform method to force it to respond to sent message.
- This doesn't work: Result := LclIntf.SendMessage(hWnd, Msg, wParam, lParam); }
-var
- AWinControl : TWinControl;
-begin
- Assert(hWnd <> 0, 'Window handle not assigned on entry to SendMessage');
- AWinControl := FindOwnerControl(hWnd);
-// Assert(AWinControl <> nil,
-// 'Owner control not found in SendMessage ($' + IntToHex(Msg, 4) + ') ');
- if AWinControl <> nil then
- Result := AWinControl.Perform(Msg, wParam, lParam);
-end;
-
-procedure RecreateWnd(const AWinControl:TWinControl);
-// Calls to Controls.RecreateWnd shouldn't be needed with GTK widgetset,
-// so just ignore them.
-begin
-{$IFDEF MSWINDOWS}
- Controls.RecreateWnd(AWinControl);
-{$ENDIF}
-end;
-
-
- {These belong in Classes unit}
-function MakeObjectInstance(Method: TWndMethod): Pointer;
-begin
-end;
-
-procedure FreeObjectInstance(ObjectInstance: Pointer);
-begin
-end;
-
-function AllocateHWnd(Method: TWndMethod): HWND;
-begin
-end;
-
-procedure DeallocateHWnd(Wnd: HWND);
-begin
-end;
-
-
- {This belongs in System unit}
-function FindClassHInstance(ClassType: TClass): LongWord;
-begin
-(*
- Result := System.MainInstance;
-*)
- Result := System.HInstance;
-end;
-
-
- {This belongs in ExtCtrls unit}
-procedure Frame3D(Canvas: TCanvas; var Rect: TRect;
- TopColor, BottomColor: TColor; Width: Integer);
-begin
- Canvas.Frame3D(Rect, Width, bvLowered);
- {Need a way of determining whether to pass bvNone, bvLowered,
- bvRaised, or bvSpace based on TopColor and BottomColor.
- See Delphi help for Frame3D.}
-end;
-
-
- {This should be a TCanvas method}
-procedure BrushCopy(DestCanvas: TCanvas; const Dest: TRect; Bitmap: TBitmap;
- const Source: TRect; Color: TColor);
-begin
- StretchBlt(DestCanvas.Handle, Dest.Left, Dest.Top,
- Dest.Right - Dest.Left, Dest.Bottom - Dest.Top,
- Bitmap.Canvas.Handle, Source.Left, Source.Top,
- Source.Right - Source.Left, Source.Bottom - Source.Top, SrcCopy);
-end;
-
-
- {This belongs in Buttons unit}
-function DrawButtonFace(Canvas: TCanvas; const Client: TRect;
- BevelWidth: Integer; Style: TButtonStyle;
- IsRounded, IsDown, IsFocused: Boolean): TRect;
- {Draw a push button.
- Style, IsRounded and IsFocused params appear to be left over
- from Win 3.1, so ignore them.}
-var
- ARect : TRect;
-begin
- ARect := Client;
- {The way LCL TCustomSpeedButton draws a button}
- if IsDown then
- begin
- if WidgetSet.LCLPlatform <> lpCarbon then
- Canvas.Frame3D(ARect, BevelWidth, bvLowered)
- else //bvLowered currently not supported on Carbon.
- Canvas.Frame3D(ARect, BevelWidth, bvRaised)
- end
- else
- Canvas.Frame3D(ARect, BevelWidth, bvRaised);
- Result := Client; //Should reduce dimensions by edges and bevels.
-end;
-
-
- {Additional routines}
-{$IFDEF LINUX}
-function SearchForBrowser(const BrowserFileName : string) : string;
- {Search path for specified browser file name, returning
- its expanded file name that includes path to it.}
-begin
- Result :=
- SearchFileInPath(BrowserFileName, '', GetEnvironmentVariable('PATH'),
- PathSeparator, [sffDontSearchInBasePath]);
-end;
-
-function GetBrowserPath : string;
- {Return path to first browser found.}
-begin
- Result := SearchForBrowser('firefox');
- if Result = '' then
- Result := SearchForBrowser('konqueror'); {KDE browser}
- if Result = '' then
- Result := SearchForBrowser('epiphany'); {GNOME browser}
- if Result = '' then
- Result := SearchForBrowser('mozilla');
- if Result = '' then
- Result := SearchForBrowser('opera');
-end;
-{$ENDIF}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/myovcreg.pas b/Source/3rdParty/Orpheus/myovcreg.pas
deleted file mode 100644
index 1fb75f5c..00000000
--- a/Source/3rdParty/Orpheus/myovcreg.pas
+++ /dev/null
@@ -1,238 +0,0 @@
-{*********************************************************}
-{* myovcreg.pas *}
-{*********************************************************}
-
-{* ***** 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): *}
-{* *}
-{* Phil Hess - adapted ovcreg.pas to register only ported controls. *}
-{* *}
-{* ***** END LICENSE BLOCK ***** *}
-
-unit MyOvcReg;
-
-{
- Registration unit for the ported Orpheus components.
-}
-
-interface
-
-uses
- Classes,
- Forms,
- LResources,
- PropEdits,
- ComponentEditors,
- ovcabot0, {Property editors}
- ovclbl0,
- myovctbpe1,
- myovctbpe2,
- ovcbase, {Controls}
- ovctcedt,
- ovctchdr,
- ovctccbx,
- ovctcsim,
- ovctcbox,
- ovctcbmp,
- ovctcgly,
- ovctcico,
- ovctbcls,
- ovctbrws,
- ovctable,
- ovcurl,
- ovcrlbl,
- ovclabel,
- ovcsf,
- o32flxed,
- o32tcflx,
- ovccal,
-// ovcedcal,
-// ovccalc,
-// ovcclrcb,
- ovcsc,
- ovcvlb;
-
-procedure Register;
-
-
-implementation
-
-type
- TOvcHeaderProperty = class(TCaptionProperty);
-
- {component editor for the table}
- TOvcTableEditor = class(TDefaultComponentEditor)
- public
- procedure ExecuteVerb(Index : Integer);
- override;
- function GetVerb(Index : Integer) : AnsiString;
- override;
- function GetVerbCount : Integer;
- override;
- end;
-
-{*** TOvcTableEditor ***}
-
-const
- TableVerbs : array[0..1] of PAnsiChar =
- ('Columns Editor', 'Rows Editor');
-
-procedure TOvcTableEditor.ExecuteVerb(Index : Integer);
-var
- Table : TOvcTable;
- C : TOvcfrmColEditor;
- R : TOvcfrmRowEditor;
-begin
- Table := TOvcTable(Component);
- if Index = 0 then begin
- C := TOvcfrmColEditor.Create(Application);
- try
- C.Editor := Self;
- C.SetCols(TOvcTableColumns(Table.Columns));
- C.ShowModal;
- Designer.Modified;
- finally
- C.Free;
- end;
- end else if Index = 1 then begin
- R := TOvcfrmRowEditor.Create(Application);
- try
- R.SetRows(TOvcTableRows(Table.Rows));
- R.ShowModal;
- Designer.Modified;
- finally
- R.Free;
- end;
- end;
-end;
-
-function TOvcTableEditor.GetVerb(Index : Integer) : AnsiString;
-begin
- Result := StrPas(TableVerbs[Index]);
-end;
-
-function TOvcTableEditor.GetVerbCount : Integer;
-begin
- Result := High(TableVerbs) + 1;
-end;
-
-
-procedure Register;
-begin
- RegisterPropertyEditor(TypeInfo(string), TOvcURL, 'Caption', TOvcHeaderProperty);
- RegisterPropertyEditor(TypeInfo(string), TOvcURL, 'URL', TOvcHeaderProperty);
-
- RegisterPropertyEditor(TypeInfo(string), TOvcRotatedLabel, 'About', TOvcAboutProperty);
- RegisterPropertyEditor(TypeInfo(string), TOvcLabel, 'About', TOvcAboutProperty);
- RegisterPropertyEditor(TypeInfo(string), TOvcURL, 'About', TOvcAboutProperty);
- RegisterPropertyEditor(TypeInfo(string), TOvcSpinner, 'About', TOvcAboutProperty);
- RegisterPropertyEditor(TypeInfo(string), TOvcVirtualListBox, 'About', TOvcAboutProperty);
-//{$IFDEF MSWINDOWS}
- RegisterPropertyEditor(TypeInfo(string), TOvcSimpleField, 'About', TOvcAboutProperty);
-//{$ENDIF}
- RegisterPropertyEditor(TypeInfo(string), TO32FlexEdit, 'About', TOvcAboutProperty);
-// RegisterPropertyEditor(TypeInfo(string), TOvcCalculator, 'About', TOvcAboutProperty);
-// RegisterPropertyEditor(TypeInfo(string), TOvcColorComboBox, 'About', TOvcAboutProperty);
- RegisterPropertyEditor(TypeInfo(string), TOvcTable, 'About', TOvcAboutProperty);
- RegisterPropertyEditor(TypeInfo(string), TOvcTCColHead, 'About', TOvcAboutProperty);
- RegisterPropertyEditor(TypeInfo(string), TOvcTCRowHead, 'About', TOvcAboutProperty);
- RegisterPropertyEditor(TypeInfo(string), TOvcTCString, 'About', TOvcAboutProperty);
-//{$IFDEF MSWINDOWS}
- RegisterPropertyEditor(TypeInfo(string), TOvcTCSimpleField, 'About', TOvcAboutProperty);
-//{$ENDIF}
- RegisterPropertyEditor(TypeInfo(string), TOvcTCMemo, 'About', TOvcAboutProperty);
- RegisterPropertyEditor(TypeInfo(string), TOvcTCCheckBox, 'About', TOvcAboutProperty);
- RegisterPropertyEditor(TypeInfo(string), TOvcTCComboBox, 'About', TOvcAboutProperty);
- RegisterPropertyEditor(TypeInfo(string), TOvcTCBitMap, 'About', TOvcAboutProperty);
- RegisterPropertyEditor(TypeInfo(string), TOvcTCGlyph, 'About', TOvcAboutProperty);
- RegisterPropertyEditor(TypeInfo(string), TOvcTCIcon, 'About', TOvcAboutProperty);
- RegisterPropertyEditor(TypeInfo(string), TO32TCFlexEdit, 'About', TOvcAboutProperty);
- RegisterPropertyEditor(TypeInfo(string), TOvcController, 'About', TOvcAboutProperty);
-
- {register label component editor}
- RegisterComponentEditor(TOvcCustomLabel, TOvcLabelEditor);
-
- {register property editors for the entry fields}
-(*
- RegisterPropertyEditor(
- TypeInfo(Char), TOvcSimpleField, 'PictureMask', TSimpleMaskProperty);
- RegisterPropertyEditor(
- TypeInfo(string), TOvcPictureField, 'PictureMask', TPictureMaskProperty);
- RegisterPropertyEditor(
- TypeInfo(string), TOvcNumericField, 'PictureMask', TNumericMaskProperty);
- RegisterPropertyEditor(
- TypeInfo(string), TOvcSimpleField, 'RangeHi', OvcEfPe.TEfRangeProperty);
- RegisterPropertyEditor(
- TypeInfo(string), TOvcSimpleField, 'RangeLo', OvcEfPe.TEfRangeProperty);
- RegisterPropertyEditor(
- TypeInfo(string), TOvcPictureField, 'RangeHi', OvcEfPe.TEfRangeProperty);
- RegisterPropertyEditor(
- TypeInfo(string), TOvcPictureField, 'RangeLo', OvcEfPe.TEfRangeProperty);
- RegisterPropertyEditor(
- TypeInfo(string), TOvcNumericField, 'RangeHi', OvcEfPe.TEfRangeProperty);
- RegisterPropertyEditor(
- TypeInfo(string), TOvcNumericField, 'RangeLo', OvcEfPe.TEfRangeProperty);
- RegisterPropertyEditor(
- TypeInfo(string), TOvcPictureLabel, 'PictureMask', TPictureMaskProperty);
-*)
-
- RegisterPropertyEditor(TypeInfo(TOvcTableRows), TOvcTable, '', TOvcTableRowProperty);
- RegisterPropertyEditor(TypeInfo(TOvcTableColumns), TOvcTable, '', TOvcTableColumnProperty);
-
- {register component editor for the table}
- RegisterComponentEditor(TOvcTable, TOvcTableEditor);
-
- RegisterComponents('Orpheus', [TOvcRotatedLabel]);
- RegisterComponents('Orpheus', [TOvcLabel]);
- RegisterComponents('Orpheus', [TOvcURL]);
- RegisterComponents('Orpheus', [TOvcSpinner]);
- RegisterComponents('Orpheus', [TOvcVirtualListBox]);
-//{$IFDEF MSWINDOWS} //If used, crashes IDE with GTK, so only register if Windows
- RegisterComponents('Orpheus', [TOvcSimpleField]);
-//{$ENDIF}
- RegisterComponents('Orpheus', [TO32FlexEdit]);
- RegisterComponents('Orpheus', [TOvcCalendar]);
-// RegisterComponents('Orpheus', [TOvcDateEdit]); //Needs ButtonOkay fixes like TO32FlexEdit
-// RegisterComponents('Orpheus', [TOvcCalculator]);
-// RegisterComponents('Orpheus', [TOvcColorComboBox]);
- RegisterComponents('Orpheus', [TOvcTable]);
- RegisterComponents('Orpheus', [TOvcTCColHead]);
- RegisterComponents('Orpheus', [TOvcTCRowHead]);
- RegisterComponents('Orpheus', [TOvcTCString]);
-//{$IFDEF MSWINDOWS} //If used, crashes IDE with GTK, so only register if Windows
- RegisterComponents('Orpheus', [TOvcTCSimpleField]);
-//{$ENDIF}
- RegisterComponents('Orpheus', [TOvcTCMemo]);
- RegisterComponents('Orpheus', [TOvcTCCheckBox]);
- RegisterComponents('Orpheus', [TOvcTCComboBox]);
- RegisterComponents('Orpheus', [TOvcTCBitMap]);
- RegisterComponents('Orpheus', [TOvcTCGlyph]);
- RegisterComponents('Orpheus', [TOvcTCIcon]);
- RegisterComponents('Orpheus', [TO32TCFlexEdit]);
- RegisterComponents('Orpheus', [TOvcController]);
-end; {Register}
-
-initialization
-{$I ovcreg.lrs}
-
-end.
-
diff --git a/Source/3rdParty/Orpheus/myovctbpe1.lfm b/Source/3rdParty/Orpheus/myovctbpe1.lfm
deleted file mode 100644
index ddfefd5f..00000000
--- a/Source/3rdParty/Orpheus/myovctbpe1.lfm
+++ /dev/null
@@ -1,341 +0,0 @@
-object OvcfrmRowEditor: TOvcfrmRowEditor
- Left = 387
- Top = 266
- BorderIcons = [biSystemMenu]
- BorderStyle = bsDialog
- Caption = 'Rows Editor'
- ClientHeight = 280
- Height = 280
- ClientWidth = 401
- Width = 401
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- Position = poScreenCenter
- OnShow = FormShow
- PixelsPerInch = 96
- object DoneButton: TBitBtn
- Left = 307
- Top = 248
- Width = 75
- Height = 25
- Caption = 'Done'
- ModalResult = 1
- TabOrder = 5
- OnClick = DoneButtonClick
- NumGlyphs = 2
- end
- object Panel1: TPanel
- Left = 0
- Top = 0
- Width = 401
- Height = 41
- Align = alTop
- Alignment = taLeftJustify
- BevelInner = bvLowered
- TabOrder = 0
- object SpeedButton1: TSpeedButton
- Left = 8
- Top = 8
- Width = 25
- Height = 25
- Hint = 'Previous row'
- Glyph.Data = {
- 76010000424D7601000000000000760000002800000020000000100000000100
- 0400000000000001000000000000000000001000000010000000000000000000
- 80000080000000808000800000008000800080800000C0C0C000808080000000
- FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB0000
- BBBBBBBBBBBB777BBBBBBBBBBBB00CC0BBBBBBBBBBB7777BBBBBBBBBBB00CCC0
- BBBBBBBBBB77777BBBBBBBBBB00CCCC0BBBBBBBBB777777BBBBBBBBB00CCCCC0
- BBBBBBBB7777777BBBBBBBBF0CCCCCC0BBBBBBB77777777BBBBBBBBF0CCCCCC0
- BBBBBBB77777777BBBBBBBBBFCCCCCC0BBBBBBBB7777777BBBBBBBBBBFCCCCC0
- BBBBBBBBB777777BBBBBBBBBBBFCCCC0BBBBBBBBBB77777BBBBBBBBBBBBFCCC0
- BBBBBBBBBBB7777BBBBBBBBBBBBBFFFFBBBBBBBBBBBB777BBBBBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
- NumGlyphs = 2
- ParentShowHint = False
- ShowHint = True
- OnClick = SpeedButton1Click
- end
- object SpeedButton2: TSpeedButton
- Left = 32
- Top = 8
- Width = 25
- Height = 25
- Hint = 'Next row'
- Glyph.Data = {
- 76010000424D7601000000000000760000002800000020000000100000000100
- 0400000000000001000000000000000000001000000010000000000000000000
- 80000080000000808000800000008000800080800000C0C0C000808080000000
- FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBF000BBBBB
- BBBBBBBFFFFBBBBBBBBBBBBF0000BBBBBBBBBBBFFFFFBBBBBBBBBBBFCCC00BBB
- BBBBBBBFFFFFFBBBBBBBBBBFCCCC00BBBBBBBBBFFFFFFFBBBBBBBBBFCCCCC00B
- BBBBBBBFFFFFFFFBBBBBBBBFCCCCCC00BBBBBBBFFFFFFFFFBBBBBBBFCCCCCC0F
- BBBBBBBFFFFFFFFFBBBBBBBFCCCCCCFBBBBBBBBFFFFFFFFBBBBBBBBFCCCCCFBB
- BBBBBBBFFFFFFFBBBBBBBBBFCCCCFBBBBBBBBBBFFFFFFBBBBBBBBBBFCCCFBBBB
- BBBBBBBFFFFFBBBBBBBBBBBFFFFBBBBBBBBBBBBFFFFBBBBBBBBBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
- NumGlyphs = 2
- ParentShowHint = False
- ShowHint = True
- OnClick = SpeedButton2Click
- end
- object SpeedButton3: TSpeedButton
- Left = 72
- Top = 8
- Width = 25
- Height = 25
- Hint = 'First row'
- Glyph.Data = {
- 76010000424D7601000000000000760000002800000020000000100000000100
- 0400000000000001000000000000000000001000000010000000000000000000
- 80000080000000808000800000008000800080800000C0C0C000808080000000
- FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB00BBBBBB00
- BBBBBBFFBBBBBBFFBBBBBB00BBBBB000BBBBBBFFBBBBBFFFBBBBBB00BBBB00C0
- BBBBBBFFBBBBFFFFBBBBBB00BBB00CC0BBBBBBFFBBBFFFFFBBBBBB00BB00CCC0
- BBBBBBFFBBFFFFFFBBBBBB00B00CCCC0BBBBBBFFBFFFFFFFBBBBBB00BFCCCCC0
- BBBBBBFFBFFFFFFFBBBBBB00BBFCCCC0BBBBBBFFBBFFFFFFBBBBBB00BBBFCCC0
- BBBBBBFFBBBFFFFFBBBBBB00BBBBFCC0BBBBBBFFBBBBFFFFBBBBBB00BBBBBFC0
- BBBBBBFFBBBBBFFFBBBBBB00BBBBBBFFBBBBBBFFBBBBBBFFBBBBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
- NumGlyphs = 2
- ParentShowHint = False
- ShowHint = True
- OnClick = SpeedButton3Click
- end
- object SpeedButton4: TSpeedButton
- Left = 96
- Top = 8
- Width = 25
- Height = 25
- Hint = 'Last row'
- Glyph.Data = {
- 76010000424D7601000000000000760000002800000020000000100000000100
- 0400000000000001000000000000000000001000000010000000000000000000
- 80000080000000808000800000008000800080800000C0C0C000808080000000
- FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB00BBBBBB
- 00BBBBBB77BBBBBB77BBBBBB000BBBBB00BBBBBB777BBBBB77BBBBBB0C00BBBB
- 00BBBBBB7777BBBB77BBBBBB0CC00BBB00BBBBBB77777BBB77BBBBBB0CCC00BB
- 00BBBBBB777777BB77BBBBBB0CCCC00B00BBBBBB7777777B77BBBBBB0CCCCCFB
- 00BBBBBB7777777B77BBBBBB0CCCCFBB00BBBBBB777777BB77BBBBBB0CCCFBBB
- 00BBBBBB77777BBB77BBBBBB0CCFBBBB00BBBBBB7777BBBB77BBBBBB0CFBBBBB
- 00BBBBBB777BBBBB77BBBBBBFFBBBBBB00BBBBBB77BBBBBB77BBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
- NumGlyphs = 2
- ParentShowHint = False
- ShowHint = True
- OnClick = SpeedButton4Click
- end
- object SpeedButton5: TSpeedButton
- Left = 136
- Top = 8
- Width = 25
- Height = 25
- Hint = 'Insert row'
- Glyph.Data = {
- 76010000424D7601000000000000760000002800000020000000100000000100
- 0400000000000001000000000000000000001000000010000000000000000000
- 80000080000000808000800000008000800080800000C0C0C000808080000000
- FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBF000BBBBBBBBBBBBF777BBBBBBBBBBBBFCC0BB
- BBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BBBBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BB
- BBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BBBBBBBBBBBBFBB7BBBBBBB000000CC000
- 000BB777777BB777777BBFCCCCCCCCCCCC0BBFBBBBBBBBBBBB7BBFCCCCCCCCCC
- CC0BBFBBBBBBBBBBBB7BBFFFFFFCC0FFFFFBBFFFFFFBB7FFFFFBBBBBBBFCC0BB
- BBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BBBBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BB
- BBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BBBBBBBBBBBBFBB7BBBBBBBBBBBBFFF0BB
- BBBBBBBBBBFFF7BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
- NumGlyphs = 2
- ParentShowHint = False
- ShowHint = True
- OnClick = SpeedButton5Click
- end
- object SpeedButton6: TSpeedButton
- Left = 160
- Top = 8
- Width = 25
- Height = 25
- Hint = 'Delete Row'
- Glyph.Data = {
- 76010000424D7601000000000000760000002800000020000000100000000100
- 0400000000000001000000000000000000001000000010000000000000000000
- 80000080000000808000800000008000800080800000C0C0C000808080000000
- FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB00000000000
- 000BB77777777777777BBFCCCCCCCCCCCC0BBFBBBBBBBBBBBB7BBFCCCCCCCCCC
- CC0BBFBBBBBBBBBBBB7BBFFFFFFFFFFFFFFBBFFFFFFFFFFFFFFBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
- NumGlyphs = 2
- ParentShowHint = False
- ShowHint = True
- OnClick = SpeedButton6Click
- end
- object Label1: TLabel
- Left = 208
- Top = 13
- Width = 89
- Height = 16
- AutoSize = False
- Caption = '&Row number'
- end
- object OvcSpinner1: TOvcSpinner
- Left = 369
- Top = 12
- Width = 16
- Height = 21
- AutoRepeat = True
- Delta = 1.000000000000000000
- FocusedControl = ctlRowNumber
- end
- object ctlRowNumber: TEdit
- Left = 296
- Top = 12
- Width = 73
- Height = 21
- MaxLength = 8
- TabOrder = 0
- OnChange = ctlRowNumberChange
- OnExit = ctlRowNumberExit
- end
- end
- object GroupBox1: TGroupBox
- Left = 8
- Top = 48
- Width = 273
- Height = 113
- Caption = 'Selected row details'
- TabOrder = 1
- object ctlHidden: TCheckBox
- Left = 16
- Top = 8
- Width = 89
- Height = 17
- Caption = 'Hidde&n'
- TabOrder = 0
- end
- object ctlUseDefHeight: TRadioButton
- Left = 16
- Top = 40
- Width = 145
- Height = 25
- Caption = 'Use &default height'
- TabOrder = 1
- TabStop = True
- OnClick = ctlUseDefHeightClick
- end
- object ctlUseCustHeight: TRadioButton
- Left = 16
- Top = 64
- Width = 145
- Height = 25
- Caption = 'Use &custom height'
- TabOrder = 2
- OnClick = ctlUseCustHeightClick
- end
- object OvcSpinner2: TOvcSpinner
- Left = 217
- Top = 67
- Width = 16
- Height = 21
- AutoRepeat = True
- Delta = 1.000000000000000000
- FocusedControl = ctlHeight
- end
- object ctlHeight: TEdit
- Left = 168
- Top = 68
- Width = 49
- Height = 21
- MaxLength = 5
- TabOrder = 3
- end
- end
- object GroupBox2: TGroupBox
- Left = 8
- Top = 168
- Width = 273
- Height = 105
- Caption = 'Overall row details'
- TabOrder = 2
- object Label2: TLabel
- Left = 16
- Top = 17
- Width = 121
- Height = 16
- AutoSize = False
- Caption = 'De&fault row height'
- end
- object Label3: TLabel
- Left = 16
- Top = 53
- Width = 121
- Height = 16
- AutoSize = False
- Caption = 'Ma&ximum rows'
- end
- object OvcSpinner3: TOvcSpinner
- Left = 193
- Top = 17
- Width = 16
- Height = 21
- AutoRepeat = True
- Delta = 1.000000000000000000
- FocusedControl = ctlDefaultHeight
- end
- object OvcSpinner4: TOvcSpinner
- Left = 217
- Top = 53
- Width = 16
- Height = 21
- AutoRepeat = True
- Delta = 1.000000000000000000
- FocusedControl = ctlRowLimit
- end
- object ctlRowLimit: TEdit
- Left = 144
- Top = 52
- Width = 73
- Height = 21
- TabOrder = 1
- end
- object ctlDefaultHeight: TEdit
- Left = 144
- Top = 17
- Width = 49
- Height = 21
- MaxLength = 5
- TabOrder = 0
- end
- end
- object Reset: TBitBtn
- Left = 307
- Top = 88
- Width = 75
- Height = 25
- Caption = 'Re&set'
- TabOrder = 4
- OnClick = ResetClick
- NumGlyphs = 2
- end
- object ApplyButton: TBitBtn
- Left = 307
- Top = 56
- Width = 75
- Height = 25
- Caption = '&Apply'
- Default = True
- TabOrder = 3
- OnClick = ApplyButtonClick
- NumGlyphs = 2
- end
-end
diff --git a/Source/3rdParty/Orpheus/myovctbpe1.lrs b/Source/3rdParty/Orpheus/myovctbpe1.lrs
deleted file mode 100644
index b59f893c..00000000
--- a/Source/3rdParty/Orpheus/myovctbpe1.lrs
+++ /dev/null
@@ -1,170 +0,0 @@
-LazarusResources.Add('TOvcfrmRowEditor','FORMDATA',[
- 'TPF0'#16'TOvcfrmRowEditor'#15'OvcfrmRowEditor'#4'Left'#3#131#1#3'Top'#3#10#1
- +#11'BorderIcons'#11#12'biSystemMenu'#0#11'BorderStyle'#7#8'bsDialog'#7'Capti'
- +'on'#6#11'Rows Editor'#12'ClientHeight'#3#24#1#6'Height'#3#24#1#11'ClientWid'
- +'th'#3#145#1#5'Width'#3#145#1#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7#15
- +'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245#10
- +'Font.Style'#11#0#8'Position'#7#14'poScreenCenter'#6'OnShow'#7#8'FormShow'#13
- +'PixelsPerInch'#2'`'#0#7'TBitBtn'#10'DoneButton'#4'Left'#3'3'#1#3'Top'#3#248
- +#0#5'Width'#2'K'#6'Height'#2#25#7'Caption'#6#4'Done'#11'ModalResult'#2#1#8'T'
- +'abOrder'#2#5#7'OnClick'#7#15'DoneButtonClick'#9'NumGlyphs'#2#2#0#0#6'TPanel'
- +#6'Panel1'#4'Left'#2#0#3'Top'#2#0#5'Width'#3#145#1#6'Height'#2')'#5'Align'#7
- +#5'alTop'#9'Alignment'#7#13'taLeftJustify'#10'BevelInner'#7#9'bvLowered'#8'T'
- +'abOrder'#2#0#0#12'TSpeedButton'#12'SpeedButton1'#4'Left'#2#8#3'Top'#2#8#5'W'
- +'idth'#2#25#6'Height'#2#25#4'Hint'#6#12'Previous row'#10'Glyph.Data'#10'z'#1
- +#0#0'v'#1#0#0'BMv'#1#0#0#0#0#0#0'v'#0#0#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0#4#0
- +#0#0#0#0#0#1#0#0#0#0#0#0#0#0#0#0#16#0#0#0#16#0#0#0#0#0#0#0#0#0#128#0#0#128#0
- +#0#0#128#128#0#128#0#0#0#128#0#128#0#128#128#0#0#192#192#192#0#128#128#128#0
- +#0#0#255#0#0#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255
- +#255#0#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#0#0#187#187#187#187#187#187'w{'#187#187#187#187#187#176#12#192#187#187#187
- +#187#187#183'w{'#187#187#187#187#187#0#204#192#187#187#187#187#187'ww{'#187
- +#187#187#187#176#12#204#192#187#187#187#187#183'ww{'#187#187#187#187#0#204
- +#204#192#187#187#187#187'www{'#187#187#187#191#12#204#204#192#187#187#187#183
- +'www{'#187#187#187#191#12#204#204#192#187#187#187#183'www{'#187#187#187#187
- +#252#204#204#192#187#187#187#187'www{'#187#187#187#187#191#204#204#192#187
- +#187#187#187#183'ww{'#187#187#187#187#187#252#204#192#187#187#187#187#187'ww'
- +'{'#187#187#187#187#187#191#204#192#187#187#187#187#187#183'w{'#187#187#187
- +#187#187#187#255#255#187#187#187#187#187#187'w{'#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#9'NumGlyphs'#2#2#14'ParentShowHint'#8#8'Sho'
- +'wHint'#9#7'OnClick'#7#17'SpeedButton1Click'#0#0#12'TSpeedButton'#12'SpeedBu'
- +'tton2'#4'Left'#2' '#3'Top'#2#8#5'Width'#2#25#6'Height'#2#25#4'Hint'#6#8'Nex'
- +'t row'#10'Glyph.Data'#10'z'#1#0#0'v'#1#0#0'BMv'#1#0#0#0#0#0#0'v'#0#0#0'('#0
- +#0#0' '#0#0#0#16#0#0#0#1#0#4#0#0#0#0#0#0#1#0#0#0#0#0#0#0#0#0#0#16#0#0#0#16#0
- +#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128#0#128#0#0#0#128#0#128#0#128#128#0
- +#0#192#192#192#0#128#128#128#0#0#0#255#0#0#255#0#0#0#255#255#0#255#0#0#0#255
- +#0#255#0#255#255#0#0#255#255#255#0#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#191#0#11#187#187#187#187#187#191#255#251#187#187#187#187#187
- +#191#0#0#187#187#187#187#187#191#255#255#187#187#187#187#187#191#204#192#11
- +#187#187#187#187#191#255#255#251#187#187#187#187#191#204#204#0#187#187#187
- +#187#191#255#255#255#187#187#187#187#191#204#204#192#11#187#187#187#191#255
- +#255#255#251#187#187#187#191#204#204#204#0#187#187#187#191#255#255#255#255
- +#187#187#187#191#204#204#204#15#187#187#187#191#255#255#255#255#187#187#187
- +#191#204#204#204#251#187#187#187#191#255#255#255#251#187#187#187#191#204#204
- +#207#187#187#187#187#191#255#255#255#187#187#187#187#191#204#204#251#187#187
- +#187#187#191#255#255#251#187#187#187#187#191#204#207#187#187#187#187#187#191
- +#255#255#187#187#187#187#187#191#255#251#187#187#187#187#187#191#255#251#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#9'NumGlyphs'
- +#2#2#14'ParentShowHint'#8#8'ShowHint'#9#7'OnClick'#7#17'SpeedButton2Click'#0
- +#0#12'TSpeedButton'#12'SpeedButton3'#4'Left'#2'H'#3'Top'#2#8#5'Width'#2#25#6
- +'Height'#2#25#4'Hint'#6#9'First row'#10'Glyph.Data'#10'z'#1#0#0'v'#1#0#0'BMv'
- +#1#0#0#0#0#0#0'v'#0#0#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0#4#0#0#0#0#0#0#1#0#0#0
- +#0#0#0#0#0#0#0#16#0#0#0#16#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128#0#128
- +#0#0#0#128#0#128#0#128#128#0#0#192#192#192#0#128#128#128#0#0#0#255#0#0#255#0
- +#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#0#187#187#187#0#187#187#187#255
- +#187#187#187#255#187#187#187#0#187#187#176#0#187#187#187#255#187#187#191#255
- +#187#187#187#0#187#187#0#192#187#187#187#255#187#187#255#255#187#187#187#0
- +#187#176#12#192#187#187#187#255#187#191#255#255#187#187#187#0#187#0#204#192
- +#187#187#187#255#187#255#255#255#187#187#187#0#176#12#204#192#187#187#187#255
- +#191#255#255#255#187#187#187#0#191#204#204#192#187#187#187#255#191#255#255
- ,#255#187#187#187#0#187#252#204#192#187#187#187#255#187#255#255#255#187#187
- +#187#0#187#191#204#192#187#187#187#255#187#191#255#255#187#187#187#0#187#187
- +#252#192#187#187#187#255#187#187#255#255#187#187#187#0#187#187#191#192#187
- +#187#187#255#187#187#191#255#187#187#187#0#187#187#187#255#187#187#187#255
- +#187#187#187#255#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#9'NumGlyphs'#2#2#14'ParentShowHint'#8#8'ShowHint'#9#7'OnClick'#7#17'SpeedBu'
- +'tton3Click'#0#0#12'TSpeedButton'#12'SpeedButton4'#4'Left'#2'`'#3'Top'#2#8#5
- +'Width'#2#25#6'Height'#2#25#4'Hint'#6#8'Last row'#10'Glyph.Data'#10'z'#1#0#0
- +'v'#1#0#0'BMv'#1#0#0#0#0#0#0'v'#0#0#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0#4#0#0#0
- +#0#0#0#1#0#0#0#0#0#0#0#0#0#0#16#0#0#0#16#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0
- +#128#128#0#128#0#0#0#128#0#128#0#128#128#0#0#192#192#192#0#128#128#128#0#0#0
- +#255#0#0#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#0#187#187#187#0
- +#187#187#187'w'#187#187#187'w'#187#187#187#0#11#187#187#0#187#187#187'w{'#187
- +#187'w'#187#187#187#12#0#187#187#0#187#187#187'ww'#187#187'w'#187#187#187#12
- +#192#11#187#0#187#187#187'ww{'#187'w'#187#187#187#12#204#0#187#0#187#187#187
- +'www'#187'w'#187#187#187#12#204#192#11#0#187#187#187'www{w'#187#187#187#12
- +#204#204#251#0#187#187#187'www{w'#187#187#187#12#204#207#187#0#187#187#187'w'
- +'ww'#187'w'#187#187#187#12#204#251#187#0#187#187#187'ww{'#187'w'#187#187#187
- +#12#207#187#187#0#187#187#187'ww'#187#187'w'#187#187#187#12#251#187#187#0#187
- +#187#187'w{'#187#187'w'#187#187#187#255#187#187#187#0#187#187#187'w'#187#187
- +#187'w'#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#9'NumGlyphs'
- +#2#2#14'ParentShowHint'#8#8'ShowHint'#9#7'OnClick'#7#17'SpeedButton4Click'#0
- +#0#12'TSpeedButton'#12'SpeedButton5'#4'Left'#3#136#0#3'Top'#2#8#5'Width'#2#25
- +#6'Height'#2#25#4'Hint'#6#10'Insert row'#10'Glyph.Data'#10'z'#1#0#0'v'#1#0#0
- +'BMv'#1#0#0#0#0#0#0'v'#0#0#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0#4#0#0#0#0#0#0#1#0
- +#0#0#0#0#0#0#0#0#0#16#0#0#0#16#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128#0
- +#128#0#0#0#128#0#128#0#128#128#0#0#192#192#192#0#128#128#128#0#0#0#255#0#0
- +#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#240#0
- +#187#187#187#187#187#187#247'w'#187#187#187#187#187#187#252#192#187#187#187
- +#187#187#187#251#183#187#187#187#187#187#187#252#192#187#187#187#187#187#187
- +#251#183#187#187#187#187#187#187#252#192#187#187#187#187#187#187#251#183#187
- +#187#187#187#187#187#252#192#187#187#187#187#187#187#251#183#187#187#187#176
- +#0#0#12#192#0#0#11#183'ww{'#183'ww{'#191#204#204#204#204#204#204#11#191#187
- +#187#187#187#187#187'{'#191#204#204#204#204#204#204#11#191#187#187#187#187
- +#187#187'{'#191#255#255#252#192#255#255#251#191#255#255#251#183#255#255#251
- +#187#187#187#252#192#187#187#187#187#187#187#251#183#187#187#187#187#187#187
- +#252#192#187#187#187#187#187#187#251#183#187#187#187#187#187#187#252#192#187
- +#187#187#187#187#187#251#183#187#187#187#187#187#187#252#192#187#187#187#187
- +#187#187#251#183#187#187#187#187#187#187#255#240#187#187#187#187#187#187#255
- +#247#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#9'NumGlyphs'#2#2#14'ParentShowHint'#8#8'ShowHint'#9#7'OnClick'#7#17'Spe'
- +'edButton5Click'#0#0#12'TSpeedButton'#12'SpeedButton6'#4'Left'#3#160#0#3'Top'
- +#2#8#5'Width'#2#25#6'Height'#2#25#4'Hint'#6#10'Delete Row'#10'Glyph.Data'#10
- +'z'#1#0#0'v'#1#0#0'BMv'#1#0#0#0#0#0#0'v'#0#0#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0
- +#4#0#0#0#0#0#0#1#0#0#0#0#0#0#0#0#0#0#16#0#0#0#16#0#0#0#0#0#0#0#0#0#128#0#0
- +#128#0#0#0#128#128#0#128#0#0#0#128#0#128#0#128#128#0#0#192#192#192#0#128#128
- +#128#0#0#0#255#0#0#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255
- +#255#255#0#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#176#0#0#0#0#0#0#11#183'wwwwww{'#191#204#204#204#204#204#204
- +#11#191#187#187#187#187#187#187'{'#191#204#204#204#204#204#204#11#191#187#187
- +#187#187#187#187'{'#191#255#255#255#255#255#255#251#191#255#255#255#255#255
- +#255#251#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- ,#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#9'NumGlyphs'#2#2#14'ParentShowHint'#8#8'ShowHint'#9#7'OnClick'#7
- +#17'SpeedButton6Click'#0#0#6'TLabel'#6'Label1'#4'Left'#3#208#0#3'Top'#2#13#5
- +'Width'#2'Y'#6'Height'#2#16#8'AutoSize'#8#7'Caption'#6#11'&Row number'#0#0#11
- +'TOvcSpinner'#11'OvcSpinner1'#4'Left'#3'q'#1#3'Top'#2#12#5'Width'#2#16#6'Hei'
- +'ght'#2#21#10'AutoRepeat'#9#5'Delta'#5#0#0#0#0#0#0#0#128#255'?'#14'FocusedCo'
- +'ntrol'#7#12'ctlRowNumber'#0#0#5'TEdit'#12'ctlRowNumber'#4'Left'#3'('#1#3'To'
- +'p'#2#12#5'Width'#2'I'#6'Height'#2#21#9'MaxLength'#2#8#8'TabOrder'#2#0#8'OnC'
- +'hange'#7#18'ctlRowNumberChange'#6'OnExit'#7#16'ctlRowNumberExit'#0#0#0#9'TG'
- +'roupBox'#9'GroupBox1'#4'Left'#2#8#3'Top'#2'0'#5'Width'#3#17#1#6'Height'#2'q'
- +#7'Caption'#6#20'Selected row details'#8'TabOrder'#2#1#0#9'TCheckBox'#9'ctlH'
- +'idden'#4'Left'#2#16#3'Top'#2#8#5'Width'#2'Y'#6'Height'#2#17#7'Caption'#6#7
- +'Hidde&n'#8'TabOrder'#2#0#0#0#12'TRadioButton'#15'ctlUseDefHeight'#4'Left'#2
- +#16#3'Top'#2'('#5'Width'#3#145#0#6'Height'#2#25#7'Caption'#6#19'Use &default'
- +' height'#8'TabOrder'#2#1#7'TabStop'#9#7'OnClick'#7#20'ctlUseDefHeightClick'
- +#0#0#12'TRadioButton'#16'ctlUseCustHeight'#4'Left'#2#16#3'Top'#2'@'#5'Width'
- +#3#145#0#6'Height'#2#25#7'Caption'#6#18'Use &custom height'#8'TabOrder'#2#2#7
- +'OnClick'#7#21'ctlUseCustHeightClick'#0#0#11'TOvcSpinner'#11'OvcSpinner2'#4
- +'Left'#3#217#0#3'Top'#2'C'#5'Width'#2#16#6'Height'#2#21#10'AutoRepeat'#9#5'D'
- +'elta'#5#0#0#0#0#0#0#0#128#255'?'#14'FocusedControl'#7#9'ctlHeight'#0#0#5'TE'
- +'dit'#9'ctlHeight'#4'Left'#3#168#0#3'Top'#2'D'#5'Width'#2'1'#6'Height'#2#21#9
- +'MaxLength'#2#5#8'TabOrder'#2#3#0#0#0#9'TGroupBox'#9'GroupBox2'#4'Left'#2#8#3
- +'Top'#3#168#0#5'Width'#3#17#1#6'Height'#2'i'#7'Caption'#6#19'Overall row det'
- +'ails'#8'TabOrder'#2#2#0#6'TLabel'#6'Label2'#4'Left'#2#16#3'Top'#2#17#5'Widt'
- +'h'#2'y'#6'Height'#2#16#8'AutoSize'#8#7'Caption'#6#19'De&fault row height'#0
- +#0#6'TLabel'#6'Label3'#4'Left'#2#16#3'Top'#2'5'#5'Width'#2'y'#6'Height'#2#16
- +#8'AutoSize'#8#7'Caption'#6#13'Ma&ximum rows'#0#0#11'TOvcSpinner'#11'OvcSpin'
- +'ner3'#4'Left'#3#193#0#3'Top'#2#17#5'Width'#2#16#6'Height'#2#21#10'AutoRepea'
- +'t'#9#5'Delta'#5#0#0#0#0#0#0#0#128#255'?'#14'FocusedControl'#7#16'ctlDefault'
- +'Height'#0#0#11'TOvcSpinner'#11'OvcSpinner4'#4'Left'#3#217#0#3'Top'#2'5'#5'W'
- +'idth'#2#16#6'Height'#2#21#10'AutoRepeat'#9#5'Delta'#5#0#0#0#0#0#0#0#128#255
- +'?'#14'FocusedControl'#7#11'ctlRowLimit'#0#0#5'TEdit'#11'ctlRowLimit'#4'Left'
- +#3#144#0#3'Top'#2'4'#5'Width'#2'I'#6'Height'#2#21#8'TabOrder'#2#1#0#0#5'TEdi'
- +'t'#16'ctlDefaultHeight'#4'Left'#3#144#0#3'Top'#2#17#5'Width'#2'1'#6'Height'
- +#2#21#9'MaxLength'#2#5#8'TabOrder'#2#0#0#0#0#7'TBitBtn'#5'Reset'#4'Left'#3'3'
- +#1#3'Top'#2'X'#5'Width'#2'K'#6'Height'#2#25#7'Caption'#6#6'Re&set'#8'TabOrde'
- +'r'#2#4#7'OnClick'#7#10'ResetClick'#9'NumGlyphs'#2#2#0#0#7'TBitBtn'#11'Apply'
- +'Button'#4'Left'#3'3'#1#3'Top'#2'8'#5'Width'#2'K'#6'Height'#2#25#7'Caption'#6
- +#6'&Apply'#7'Default'#9#8'TabOrder'#2#3#7'OnClick'#7#16'ApplyButtonClick'#9
- +'NumGlyphs'#2#2#0#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/myovctbpe1.pas b/Source/3rdParty/Orpheus/myovctbpe1.pas
deleted file mode 100644
index b9767279..00000000
--- a/Source/3rdParty/Orpheus/myovctbpe1.pas
+++ /dev/null
@@ -1,350 +0,0 @@
-{*********************************************************}
-{* myovctbpe1.pas *}
-{*********************************************************}
-
-{* ***** 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): *}
-{* *}
-{* Phil Hess - adapted ovctbpe1.pas to eliminate TOvcSimpleField. *}
-{* *}
-{* ***** 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 MyOvcTbPE1;
- {Lazarus-specific Rows property editor for the table component.}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- Classes, Graphics, Controls,
- {$IFNDEF LCL} {$IFDEF VERSION6} DesignIntf, DesignEditors, {$ELSE} DsgnIntf, {$ENDIF} {$ELSE} PropEdits, {$ENDIF}
- SysUtils, Forms, Dialogs, StdCtrls, Buttons, ExtCtrls,
- OvcBase, OvcTCmmn, OvcTable, OvcTbRws, OvcSc;
-
-type
- TOvcfrmRowEditor = class(TForm)
- ctlHidden: TCheckBox;
- ctlUseDefHeight: TRadioButton;
- ctlUseCustHeight: TRadioButton;
- DoneButton: TBitBtn;
- Panel1: TPanel;
- SpeedButton1: TSpeedButton;
- SpeedButton2: TSpeedButton;
- SpeedButton3: TSpeedButton;
- SpeedButton4: TSpeedButton;
- SpeedButton5: TSpeedButton;
- SpeedButton6: TSpeedButton;
- Label1: TLabel;
- GroupBox1: TGroupBox;
- GroupBox2: TGroupBox;
- Label2: TLabel;
- Label3: TLabel;
- Reset: TBitBtn;
- ctlHeight: TEdit;
- ctlDefaultHeight: TEdit;
- ctlRowLimit: TEdit;
- ctlRowNumber: TEdit;
- ApplyButton: TBitBtn;
- OvcSpinner1: TOvcSpinner;
- OvcSpinner2: TOvcSpinner;
- OvcSpinner3: TOvcSpinner;
- OvcSpinner4: TOvcSpinner;
- procedure ctlUseDefHeightClick(Sender: TObject);
- procedure ctlUseCustHeightClick(Sender: TObject);
- procedure SpeedButton1Click(Sender: TObject);
- procedure SpeedButton2Click(Sender: TObject);
- procedure SpeedButton3Click(Sender: TObject);
- procedure SpeedButton4Click(Sender: TObject);
- procedure SpeedButton5Click(Sender: TObject);
- procedure SpeedButton6Click(Sender: TObject);
- procedure ctlRowNumberExit(Sender: TObject);
- procedure FormShow(Sender: TObject);
- procedure ResetClick(Sender: TObject);
- procedure ApplyButtonClick(Sender: TObject);
- procedure DoneButtonClick(Sender: TObject);
- procedure ctlRowNumberChange(Sender: TObject);
- private
- { Private declarations }
- FRows : TOvcTableRows;
- FRowNum : TRowNum;
- CurDefHt : boolean;
- FormShowCalled : Boolean;
-
- protected
- procedure RefreshRowData;
- procedure SetRowNum(R : TRowNum);
-
- public
- { Public declarations }
- procedure SetRows(RS : TOvcTableRows);
-
- property Rows : TOvcTableRows
- read FRows
- write SetRows;
-
- property RowNum : TRowNum
- read FRowNum
- write SetRowNum;
-
- end;
-
- {-A table row property editor}
- TOvcTableRowProperty = class(TClassProperty)
- public
- procedure Edit; override;
- function GetAttributes: TPropertyAttributes; override;
- end;
-
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.DFM}
-{$ENDIF}
-
-
-
-{===TOvcTableRowProperty=============================================}
-procedure TOvcTableRowProperty.Edit;
- var
- RowEditor : TOvcfrmRowEditor;
- begin
- RowEditor := TOvcfrmRowEditor.Create(Application);
- try
- RowEditor.SetRows(TOvcTableRows(GetOrdValue));
- RowEditor.ShowModal;
-{$IFNDEF LCL}
- Designer.Modified;
-{$ELSE}
- Modified;
-{$ENDIF}
- finally
- RowEditor.Free;
- end;{try..finally}
- end;
-{--------}
-function TOvcTableRowProperty.GetAttributes: TPropertyAttributes;
- begin
- Result := [paMultiSelect, paDialog, paReadOnly];
- end;
-{====================================================================}
-
-
-{===TRowEditor=======================================================}
-procedure TOvcfrmRowEditor.ApplyButtonClick(Sender: TObject);
- var
- NewRowLimit : Integer;
- NewDefHeight : Integer;
- NewHeight : Integer;
- RS : TRowStyle;
- begin
- {20070204 workaround for recent change to Lazarus where
- ctlRowNumberChange gets called by ShowModal for some reason
- (thus calling this method) before FormShow event handler
- which initializes things.}
- if not FormShowCalled then
- Exit;
- NewRowLimit := StrToIntDef(ctlRowLimit.Text, FRows.Limit);
- if (NewRowLimit < 1) or (NewRowLimit > MaxInt) then {Out of range?}
- NewRowLimit := FRows.Limit; {Restore previous row limit}
- FRows.Limit := NewRowLimit;
- ctlRowLimit.Text := IntToStr(NewRowLimit);
- if FRowNum >= FRows.Limit then
- RowNum := pred(FRows.Limit);
-
- NewDefHeight := StrToIntDef(ctlDefaultHeight.Text, FRows.DefaultHeight);
- if (NewDefHeight < 5) or (NewDefHeight > 32767) then {Out of range?}
- NewDefHeight := FRows.DefaultHeight; {Restore previous default height}
- FRows.DefaultHeight := NewDefHeight;
- ctlDefaultHeight.Text := IntToStr(NewDefHeight);
-
- with RS do
- begin
- if ctlUseDefHeight.Checked then
- Height := StrToIntDef(ctlDefaultHeight.Text, Height)
- else
- begin
- NewHeight := StrToIntDef(ctlHeight.Text, Height);
- if (NewHeight < 5) or (NewHeight > 32767) then {Out of range?}
- NewHeight := Height; {Restore previous row height}
- Height := NewHeight;
- ctlHeight.Text := IntToStr(NewHeight);
- if (Height = FRows.DefaultHeight) then
- ctlUseDefHeight.Checked := true;
- end;
- Hidden := ctlHidden.Checked;
- FRows[RowNum] := RS;
- end;
- end;
-{--------}
-procedure TOvcfrmRowEditor.ctlRowNumberExit(Sender: TObject);
- begin
- RowNum := StrToInt(ctlRowNumber.Text);
- end;
-{--------}
-procedure TOvcfrmRowEditor.ctlUseCustHeightClick(Sender: TObject);
- begin
- CurDefHt := false;
- ctlHeight.Enabled := true;
- end;
-{--------}
-procedure TOvcfrmRowEditor.ctlUseDefHeightClick(Sender: TObject);
- begin
- CurDefHt := true;
- ctlHeight.Text := IntToStr(FRows.DefaultHeight);
- ctlHeight.Enabled := false;
- end;
-{--------}
-procedure TOvcfrmRowEditor.FormShow(Sender: TObject);
- begin
- ctlDefaultHeight.Text := IntToStr(FRows.DefaultHeight);
- ctlRowLimit.Text := IntToStr(FRows.Limit);
- RefreshRowData;
- FormShowCalled := True;
- end;
-{--------}
-procedure TOvcfrmRowEditor.RefreshRowData;
- begin
- CurDefHt := FRows.Height[RowNum] = FRows.DefaultHeight;
-
- ctlHidden.Checked := FRows.Hidden[RowNum];
- ctlHeight.Text := IntToStr(FRows.Height[RowNum]);
- if CurDefHt then
- begin
- ctlUseDefHeight.Checked := true;
- ctlHeight.Enabled := false;
- end
- else
- begin
- ctlUseCustHeight.Checked := true;
- ctlHeight.Enabled := true;
- end;
-
- ctlRowLimit.Text := IntToStr(FRows.Limit);
- end;
-{--------}
-procedure TOvcfrmRowEditor.ResetClick(Sender: TObject);
- begin
- FRows.Clear;
- ctlDefaultHeight.Text := IntToStr(FRows.DefaultHeight);
- RefreshRowData;
- end;
-{--------}
-procedure TOvcfrmRowEditor.SetRowNum(R : TRowNum);
- begin
- if (FRowNum <> R) then
- begin
- FRowNum := R;
- RefreshRowData;
- ctlRowNumber.Text := IntToStr(R); //Do this after refresh
- end;
- end;
-{--------}
-procedure TOvcfrmRowEditor.SetRows(RS : TOvcTableRows);
- begin
- if Assigned(FRows) then
- FRows.Free;
- FRows := RS;
- FRowNum := 0;
- ctlRowNumber.Text := '0';
- CurDefHt := FRows.Height[RowNum] = FRows.DefaultHeight;
- end;
-{--------}
-procedure TOvcfrmRowEditor.SpeedButton1Click(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- if (RowNum > 0) then
- RowNum := RowNum - 1;
- end;
-{--------}
-procedure TOvcfrmRowEditor.SpeedButton2Click(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- if (RowNum < pred(FRows.Limit)) then
- RowNum := RowNum + 1;
- end;
-{--------}
-procedure TOvcfrmRowEditor.SpeedButton3Click(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- RowNum := 0;
- end;
-{--------}
-procedure TOvcfrmRowEditor.SpeedButton4Click(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- RowNum := pred(FRows.Limit);
- end;
-{--------}
-procedure TOvcfrmRowEditor.SpeedButton5Click(Sender: TObject);
- var
- RS : TRowStyle;
- begin
- RS.Hidden := false;
- RS.Height := FRows.DefaultHeight;
- FRows.Insert(FRowNum, RS);
- RefreshRowData;
- end;
-{--------}
-procedure TOvcfrmRowEditor.SpeedButton6Click(Sender: TObject);
- begin
- FRows.Delete(FRowNum);
- RefreshRowData;
- end;
-{====================================================================}
-
-procedure TOvcfrmRowEditor.DoneButtonClick(Sender: TObject);
-begin
- ApplyButtonClick(Self);
-end;
-
-procedure TOvcfrmRowEditor.ctlRowNumberChange(Sender: TObject);
-var
- NewRowNum : Integer;
-begin
- ApplyButtonClick(Self);
- if not TryStrToInt(ctlRowNumber.Text, NewRowNum) then {Invalid?}
- ctlRowNumber.Text := IntToStr(RowNum) {Restore previous row number}
- else if NewRowNum = -1 then {Wrap around to last row?}
- ctlRowNumber.Text := IntToStr(Pred(FRows.Limit))
- else if NewRowNum = FRows.Limit then {Wrap around to first row?}
- ctlRowNumber.Text := '0'
- else if not (NewRowNum in [0..Pred(FRows.Limit)]) then {Out of range?}
- ctlRowNumber.Text := IntToStr(RowNum); {Restore previous row number}
- RowNum := StrToInt(ctlRowNumber.Text);
-end;
-
-initialization
-{$IFDEF LCL}
-{$I myovctbpe1.lrs} {Include form's resource file}
-{$ENDIF}
-
-end.
diff --git a/Source/3rdParty/Orpheus/myovctbpe2.lfm b/Source/3rdParty/Orpheus/myovctbpe2.lfm
deleted file mode 100644
index 66e53f24..00000000
--- a/Source/3rdParty/Orpheus/myovctbpe2.lfm
+++ /dev/null
@@ -1,289 +0,0 @@
-object OvcfrmColEditor: TOvcfrmColEditor
- Left = 353
- Top = 207
- BorderIcons = [biSystemMenu]
- BorderStyle = bsDialog
- Caption = 'Columns Editor'
- ClientHeight = 190
- Height = 190
- ClientWidth = 386
- Width = 386
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- Position = poScreenCenter
- OnShow = FormShow
- PixelsPerInch = 96
- object Panel1: TPanel
- Left = 0
- Top = 0
- Width = 386
- Height = 41
- Align = alTop
- Alignment = taLeftJustify
- BevelInner = bvLowered
- TabOrder = 0
- object SpeedButton1: TSpeedButton
- Left = 8
- Top = 8
- Width = 25
- Height = 25
- Hint = 'Previous column'
- Glyph.Data = {
- 76010000424D7601000000000000760000002800000020000000100000000100
- 0400000000000001000000000000000000001000000010000000000000000000
- 80000080000000808000800000008000800080800000C0C0C000808080000000
- FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB0000
- BBBBBBBBBBBB777BBBBBBBBBBBB00CC0BBBBBBBBBBB7777BBBBBBBBBBB00CCC0
- BBBBBBBBBB77777BBBBBBBBBB00CCCC0BBBBBBBBB777777BBBBBBBBB00CCCCC0
- BBBBBBBB7777777BBBBBBBBF0CCCCCC0BBBBBBB77777777BBBBBBBBF0CCCCCC0
- BBBBBBB77777777BBBBBBBBBFCCCCCC0BBBBBBBB7777777BBBBBBBBBBFCCCCC0
- BBBBBBBBB777777BBBBBBBBBBBFCCCC0BBBBBBBBBB77777BBBBBBBBBBBBFCCC0
- BBBBBBBBBBB7777BBBBBBBBBBBBBFFFFBBBBBBBBBBBB777BBBBBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
- NumGlyphs = 2
- ParentShowHint = False
- ShowHint = True
- OnClick = SpeedButton1Click
- end
- object SpeedButton2: TSpeedButton
- Left = 32
- Top = 8
- Width = 25
- Height = 25
- Hint = 'Next column'
- Glyph.Data = {
- 76010000424D7601000000000000760000002800000020000000100000000100
- 0400000000000001000000000000000000001000000010000000000000000000
- 80000080000000808000800000008000800080800000C0C0C000808080000000
- FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBF000BBBBB
- BBBBBBBFFFFBBBBBBBBBBBBF0000BBBBBBBBBBBFFFFFBBBBBBBBBBBFCCC00BBB
- BBBBBBBFFFFFFBBBBBBBBBBFCCCC00BBBBBBBBBFFFFFFFBBBBBBBBBFCCCCC00B
- BBBBBBBFFFFFFFFBBBBBBBBFCCCCCC00BBBBBBBFFFFFFFFFBBBBBBBFCCCCCC0F
- BBBBBBBFFFFFFFFFBBBBBBBFCCCCCCFBBBBBBBBFFFFFFFFBBBBBBBBFCCCCCFBB
- BBBBBBBFFFFFFFBBBBBBBBBFCCCCFBBBBBBBBBBFFFFFFBBBBBBBBBBFCCCFBBBB
- BBBBBBBFFFFFBBBBBBBBBBBFFFFBBBBBBBBBBBBFFFFBBBBBBBBBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
- NumGlyphs = 2
- ParentShowHint = False
- ShowHint = True
- OnClick = SpeedButton2Click
- end
- object SpeedButton3: TSpeedButton
- Left = 72
- Top = 8
- Width = 25
- Height = 25
- Hint = 'First column'
- Glyph.Data = {
- 76010000424D7601000000000000760000002800000020000000100000000100
- 0400000000000001000000000000000000001000000010000000000000000000
- 80000080000000808000800000008000800080800000C0C0C000808080000000
- FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB00BBBBBB00
- BBBBBBFFBBBBBBFFBBBBBB00BBBBB000BBBBBBFFBBBBBFFFBBBBBB00BBBB00C0
- BBBBBBFFBBBBFFFFBBBBBB00BBB00CC0BBBBBBFFBBBFFFFFBBBBBB00BB00CCC0
- BBBBBBFFBBFFFFFFBBBBBB00B00CCCC0BBBBBBFFBFFFFFFFBBBBBB00BFCCCCC0
- BBBBBBFFBFFFFFFFBBBBBB00BBFCCCC0BBBBBBFFBBFFFFFFBBBBBB00BBBFCCC0
- BBBBBBFFBBBFFFFFBBBBBB00BBBBFCC0BBBBBBFFBBBBFFFFBBBBBB00BBBBBFC0
- BBBBBBFFBBBBBFFFBBBBBB00BBBBBBFFBBBBBBFFBBBBBBFFBBBBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
- NumGlyphs = 2
- ParentShowHint = False
- ShowHint = True
- OnClick = SpeedButton3Click
- end
- object SpeedButton4: TSpeedButton
- Left = 96
- Top = 8
- Width = 25
- Height = 25
- Hint = 'Last column'
- Glyph.Data = {
- 76010000424D7601000000000000760000002800000020000000100000000100
- 0400000000000001000000000000000000001000000010000000000000000000
- 80000080000000808000800000008000800080800000C0C0C000808080000000
- FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB00BBBBBB
- 00BBBBBB77BBBBBB77BBBBBB000BBBBB00BBBBBB777BBBBB77BBBBBB0C00BBBB
- 00BBBBBB7777BBBB77BBBBBB0CC00BBB00BBBBBB77777BBB77BBBBBB0CCC00BB
- 00BBBBBB777777BB77BBBBBB0CCCC00B00BBBBBB7777777B77BBBBBB0CCCCCFB
- 00BBBBBB7777777B77BBBBBB0CCCCFBB00BBBBBB777777BB77BBBBBB0CCCFBBB
- 00BBBBBB77777BBB77BBBBBB0CCFBBBB00BBBBBB7777BBBB77BBBBBB0CFBBBBB
- 00BBBBBB777BBBBB77BBBBBBFFBBBBBB00BBBBBB77BBBBBB77BBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
- NumGlyphs = 2
- ParentShowHint = False
- ShowHint = True
- OnClick = SpeedButton4Click
- end
- object SpeedButton5: TSpeedButton
- Left = 136
- Top = 8
- Width = 25
- Height = 25
- Hint = 'Insert column'
- Glyph.Data = {
- 76010000424D7601000000000000760000002800000020000000100000000100
- 0400000000000001000000000000000000001000000010000000000000000000
- 80000080000000808000800000008000800080800000C0C0C000808080000000
- FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBF000BBBBBBBBBBBBF777BBBBBBBBBBBBFCC0BB
- BBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BBBBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BB
- BBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BBBBBBBBBBBBFBB7BBBBBBB000000CC000
- 000BB777777BB777777BBFCCCCCCCCCCCC0BBFBBBBBBBBBBBB7BBFCCCCCCCCCC
- CC0BBFBBBBBBBBBBBB7BBFFFFFFCC0FFFFFBBFFFFFFBB7FFFFFBBBBBBBFCC0BB
- BBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BBBBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BB
- BBBBBBBBBBFBB7BBBBBBBBBBBBFCC0BBBBBBBBBBBBFBB7BBBBBBBBBBBBFFF0BB
- BBBBBBBBBBFFF7BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
- NumGlyphs = 2
- ParentShowHint = False
- ShowHint = True
- OnClick = SpeedButton5Click
- end
- object SpeedButton6: TSpeedButton
- Left = 160
- Top = 8
- Width = 25
- Height = 25
- Hint = 'Delete column'
- Glyph.Data = {
- 76010000424D7601000000000000760000002800000020000000100000000100
- 0400000000000001000000000000000000001000000010000000000000000000
- 80000080000000808000800000008000800080800000C0C0C000808080000000
- FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00BBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB00000000000
- 000BB77777777777777BBFCCCCCCCCCCCC0BBFBBBBBBBBBBBB7BBFCCCCCCCCCC
- CC0BBFBBBBBBBBBBBB7BBFFFFFFFFFFFFFFBBFFFFFFFFFFFFFFBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
- BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB}
- NumGlyphs = 2
- ParentShowHint = False
- ShowHint = True
- OnClick = SpeedButton6Click
- end
- object Label1: TLabel
- Left = 200
- Top = 12
- Width = 105
- Height = 16
- AutoSize = False
- Caption = 'Column &number'
- end
- object OvcSpinner2: TOvcSpinner
- Left = 361
- Top = 11
- Width = 16
- Height = 21
- AutoRepeat = True
- Delta = 1.000000000000000000
- FocusedControl = ctlColNumber
- end
- object ctlColNumber: TEdit
- Left = 312
- Top = 11
- Width = 49
- Height = 21
- MaxLength = 5
- TabOrder = 0
- OnChange = ctlColNumberChange
- OnExit = ctlColNumberExit
- end
- end
- object GroupBox1: TGroupBox
- Left = 8
- Top = 48
- Width = 273
- Height = 137
- Caption = 'Column details'
- TabOrder = 1
- object Label2: TLabel
- Left = 8
- Top = 4
- Width = 75
- Height = 16
- AutoSize = False
- Caption = 'De&fault Cell'
- FocusControl = ctlDefaultCell
- end
- object Label3: TLabel
- Left = 8
- Top = 92
- Width = 75
- Height = 16
- AutoSize = False
- Caption = '&Width'
- end
- object Label4: TLabel
- Left = 8
- Top = 56
- Width = 34
- Height = 13
- Caption = '&Hidden'
- FocusControl = ctlHidden
- end
- object ctlDefaultCell: TComboBox
- Left = 8
- Top = 24
- Width = 257
- Height = 21
- Style = csDropDownList
- DropDownCount = 16
- ItemHeight = 13
- TabOrder = 0
- end
- object ctlHidden: TCheckBox
- Left = 96
- Top = 56
- Width = 17
- Height = 17
- TabOrder = 1
- end
- object OvcSpinner1: TOvcSpinner
- Left = 145
- Top = 90
- Width = 16
- Height = 21
- AutoRepeat = True
- Delta = 1.000000000000000000
- FocusedControl = ctlWidth
- end
- object ctlWidth: TEdit
- Left = 96
- Top = 90
- Width = 49
- Height = 21
- MaxLength = 5
- TabOrder = 2
- end
- end
- object DoneButton: TBitBtn
- Left = 304
- Top = 160
- Width = 75
- Height = 25
- Caption = '&Done'
- ModalResult = 1
- TabOrder = 3
- OnClick = DoneButtonClick
- NumGlyphs = 2
- end
- object ApplyButton: TBitBtn
- Left = 304
- Top = 56
- Width = 75
- Height = 25
- Caption = '&Apply'
- Default = True
- TabOrder = 2
- OnClick = ApplyButtonClick
- NumGlyphs = 2
- end
-end
diff --git a/Source/3rdParty/Orpheus/myovctbpe2.lrs b/Source/3rdParty/Orpheus/myovctbpe2.lrs
deleted file mode 100644
index 603cf5d1..00000000
--- a/Source/3rdParty/Orpheus/myovctbpe2.lrs
+++ /dev/null
@@ -1,157 +0,0 @@
-LazarusResources.Add('TOvcfrmColEditor','FORMDATA',[
- 'TPF0'#16'TOvcfrmColEditor'#15'OvcfrmColEditor'#4'Left'#3'a'#1#3'Top'#3#207#0
- +#11'BorderIcons'#11#12'biSystemMenu'#0#11'BorderStyle'#7#8'bsDialog'#7'Capti'
- +'on'#6#14'Columns Editor'#12'ClientHeight'#3#190#0#6'Height'#3#190#0#11'Clie'
- +'ntWidth'#3#130#1#5'Width'#3#130#1#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7
- +#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245
- +#10'Font.Style'#11#0#8'Position'#7#14'poScreenCenter'#6'OnShow'#7#8'FormShow'
- +#13'PixelsPerInch'#2'`'#0#6'TPanel'#6'Panel1'#4'Left'#2#0#3'Top'#2#0#5'Width'
- +#3#130#1#6'Height'#2')'#5'Align'#7#5'alTop'#9'Alignment'#7#13'taLeftJustify'
- +#10'BevelInner'#7#9'bvLowered'#8'TabOrder'#2#0#0#12'TSpeedButton'#12'SpeedBu'
- +'tton1'#4'Left'#2#8#3'Top'#2#8#5'Width'#2#25#6'Height'#2#25#4'Hint'#6#15'Pre'
- +'vious column'#10'Glyph.Data'#10'z'#1#0#0'v'#1#0#0'BMv'#1#0#0#0#0#0#0'v'#0#0
- +#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0#4#0#0#0#0#0#0#1#0#0#0#0#0#0#0#0#0#0#16#0#0
- +#0#16#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128#0#128#0#0#0#128#0#128#0#128
- +#128#0#0#192#192#192#0#128#128#128#0#0#0#255#0#0#255#0#0#0#255#255#0#255#0#0
- +#0#255#0#255#0#255#255#0#0#255#255#255#0#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#0#0#187#187#187#187#187#187'w{'#187#187#187
- +#187#187#176#12#192#187#187#187#187#187#183'w{'#187#187#187#187#187#0#204#192
- +#187#187#187#187#187'ww{'#187#187#187#187#176#12#204#192#187#187#187#187#183
- +'ww{'#187#187#187#187#0#204#204#192#187#187#187#187'www{'#187#187#187#191#12
- +#204#204#192#187#187#187#183'www{'#187#187#187#191#12#204#204#192#187#187#187
- +#183'www{'#187#187#187#187#252#204#204#192#187#187#187#187'www{'#187#187#187
- +#187#191#204#204#192#187#187#187#187#183'ww{'#187#187#187#187#187#252#204#192
- +#187#187#187#187#187'ww{'#187#187#187#187#187#191#204#192#187#187#187#187#187
- +#183'w{'#187#187#187#187#187#187#255#255#187#187#187#187#187#187'w{'#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#9'NumGlyphs'#2#2#14'Par'
- +'entShowHint'#8#8'ShowHint'#9#7'OnClick'#7#17'SpeedButton1Click'#0#0#12'TSpe'
- +'edButton'#12'SpeedButton2'#4'Left'#2' '#3'Top'#2#8#5'Width'#2#25#6'Height'#2
- +#25#4'Hint'#6#11'Next column'#10'Glyph.Data'#10'z'#1#0#0'v'#1#0#0'BMv'#1#0#0
- +#0#0#0#0'v'#0#0#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0#4#0#0#0#0#0#0#1#0#0#0#0#0#0
- +#0#0#0#0#16#0#0#0#16#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128#0#128#0#0#0
- +#128#0#128#0#128#128#0#0#192#192#192#0#128#128#128#0#0#0#255#0#0#255#0#0#0
- +#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#191#0#11#187#187#187#187#187#191#255
- +#251#187#187#187#187#187#191#0#0#187#187#187#187#187#191#255#255#187#187#187
- +#187#187#191#204#192#11#187#187#187#187#191#255#255#251#187#187#187#187#191
- +#204#204#0#187#187#187#187#191#255#255#255#187#187#187#187#191#204#204#192#11
- +#187#187#187#191#255#255#255#251#187#187#187#191#204#204#204#0#187#187#187
- +#191#255#255#255#255#187#187#187#191#204#204#204#15#187#187#187#191#255#255
- +#255#255#187#187#187#191#204#204#204#251#187#187#187#191#255#255#255#251#187
- +#187#187#191#204#204#207#187#187#187#187#191#255#255#255#187#187#187#187#191
- +#204#204#251#187#187#187#187#191#255#255#251#187#187#187#187#191#204#207#187
- +#187#187#187#187#191#255#255#187#187#187#187#187#191#255#251#187#187#187#187
- +#187#191#255#251#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#9'NumGlyphs'#2#2#14'ParentShowHint'#8#8'ShowHint'#9#7'OnClick'#7#17
- +'SpeedButton2Click'#0#0#12'TSpeedButton'#12'SpeedButton3'#4'Left'#2'H'#3'Top'
- +#2#8#5'Width'#2#25#6'Height'#2#25#4'Hint'#6#12'First column'#10'Glyph.Data'
- +#10'z'#1#0#0'v'#1#0#0'BMv'#1#0#0#0#0#0#0'v'#0#0#0'('#0#0#0' '#0#0#0#16#0#0#0
- +#1#0#4#0#0#0#0#0#0#1#0#0#0#0#0#0#0#0#0#0#16#0#0#0#16#0#0#0#0#0#0#0#0#0#128#0
- +#0#128#0#0#0#128#128#0#128#0#0#0#128#0#128#0#128#128#0#0#192#192#192#0#128
- +#128#128#0#0#0#255#0#0#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0
- +#255#255#255#0#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#0
- +#187#187#187#0#187#187#187#255#187#187#187#255#187#187#187#0#187#187#176#0
- +#187#187#187#255#187#187#191#255#187#187#187#0#187#187#0#192#187#187#187#255
- +#187#187#255#255#187#187#187#0#187#176#12#192#187#187#187#255#187#191#255#255
- +#187#187#187#0#187#0#204#192#187#187#187#255#187#255#255#255#187#187#187#0
- +#176#12#204#192#187#187#187#255#191#255#255#255#187#187#187#0#191#204#204#192
- +#187#187#187#255#191#255#255#255#187#187#187#0#187#252#204#192#187#187#187
- +#255#187#255#255#255#187#187#187#0#187#191#204#192#187#187#187#255#187#191
- +#255#255#187#187#187#0#187#187#252#192#187#187#187#255#187#187#255#255#187
- ,#187#187#0#187#187#191#192#187#187#187#255#187#187#191#255#187#187#187#0#187
- +#187#187#255#187#187#187#255#187#187#187#255#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#9'NumGlyphs'#2#2#14'ParentShowHint'#8#8'ShowHin'
- +'t'#9#7'OnClick'#7#17'SpeedButton3Click'#0#0#12'TSpeedButton'#12'SpeedButton'
- +'4'#4'Left'#2'`'#3'Top'#2#8#5'Width'#2#25#6'Height'#2#25#4'Hint'#6#11'Last c'
- +'olumn'#10'Glyph.Data'#10'z'#1#0#0'v'#1#0#0'BMv'#1#0#0#0#0#0#0'v'#0#0#0'('#0
- +#0#0' '#0#0#0#16#0#0#0#1#0#4#0#0#0#0#0#0#1#0#0#0#0#0#0#0#0#0#0#16#0#0#0#16#0
- +#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128#0#128#0#0#0#128#0#128#0#128#128#0
- +#0#192#192#192#0#128#128#128#0#0#0#255#0#0#255#0#0#0#255#255#0#255#0#0#0#255
- +#0#255#0#255#255#0#0#255#255#255#0#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#0#187#187#187#0#187#187#187'w'#187#187#187'w'#187#187
- +#187#0#11#187#187#0#187#187#187'w{'#187#187'w'#187#187#187#12#0#187#187#0#187
- +#187#187'ww'#187#187'w'#187#187#187#12#192#11#187#0#187#187#187'ww{'#187'w'
- +#187#187#187#12#204#0#187#0#187#187#187'www'#187'w'#187#187#187#12#204#192#11
- +#0#187#187#187'www{w'#187#187#187#12#204#204#251#0#187#187#187'www{w'#187#187
- +#187#12#204#207#187#0#187#187#187'www'#187'w'#187#187#187#12#204#251#187#0
- +#187#187#187'ww{'#187'w'#187#187#187#12#207#187#187#0#187#187#187'ww'#187#187
- +'w'#187#187#187#12#251#187#187#0#187#187#187'w{'#187#187'w'#187#187#187#255
- +#187#187#187#0#187#187#187'w'#187#187#187'w'#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#9'NumGlyphs'#2#2#14'ParentShowHint'#8#8'ShowHint'#9
- +#7'OnClick'#7#17'SpeedButton4Click'#0#0#12'TSpeedButton'#12'SpeedButton5'#4
- +'Left'#3#136#0#3'Top'#2#8#5'Width'#2#25#6'Height'#2#25#4'Hint'#6#13'Insert c'
- +'olumn'#10'Glyph.Data'#10'z'#1#0#0'v'#1#0#0'BMv'#1#0#0#0#0#0#0'v'#0#0#0'('#0
- +#0#0' '#0#0#0#16#0#0#0#1#0#4#0#0#0#0#0#0#1#0#0#0#0#0#0#0#0#0#0#16#0#0#0#16#0
- +#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128#0#128#0#0#0#128#0#128#0#128#128#0
- +#0#192#192#192#0#128#128#128#0#0#0#255#0#0#255#0#0#0#255#255#0#255#0#0#0#255
- +#0#255#0#255#255#0#0#255#255#255#0#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#240#0#187#187#187#187#187#187#247'w'#187
- +#187#187#187#187#187#252#192#187#187#187#187#187#187#251#183#187#187#187#187
- +#187#187#252#192#187#187#187#187#187#187#251#183#187#187#187#187#187#187#252
- +#192#187#187#187#187#187#187#251#183#187#187#187#187#187#187#252#192#187#187
- +#187#187#187#187#251#183#187#187#187#176#0#0#12#192#0#0#11#183'ww{'#183'ww{'
- +#191#204#204#204#204#204#204#11#191#187#187#187#187#187#187'{'#191#204#204
- +#204#204#204#204#11#191#187#187#187#187#187#187'{'#191#255#255#252#192#255
- +#255#251#191#255#255#251#183#255#255#251#187#187#187#252#192#187#187#187#187
- +#187#187#251#183#187#187#187#187#187#187#252#192#187#187#187#187#187#187#251
- +#183#187#187#187#187#187#187#252#192#187#187#187#187#187#187#251#183#187#187
- +#187#187#187#187#252#192#187#187#187#187#187#187#251#183#187#187#187#187#187
- +#187#255#240#187#187#187#187#187#187#255#247#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#9'NumGlyphs'#2#2#14'ParentShowH'
- +'int'#8#8'ShowHint'#9#7'OnClick'#7#17'SpeedButton5Click'#0#0#12'TSpeedButton'
- +#12'SpeedButton6'#4'Left'#3#160#0#3'Top'#2#8#5'Width'#2#25#6'Height'#2#25#4
- +'Hint'#6#13'Delete column'#10'Glyph.Data'#10'z'#1#0#0'v'#1#0#0'BMv'#1#0#0#0#0
- +#0#0'v'#0#0#0'('#0#0#0' '#0#0#0#16#0#0#0#1#0#4#0#0#0#0#0#0#1#0#0#0#0#0#0#0#0
- +#0#0#16#0#0#0#16#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128#0#128#0#0#0#128
- +#0#128#0#128#128#0#0#192#192#192#0#128#128#128#0#0#0#255#0#0#255#0#0#0#255
- +#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#176#0#0#0#0#0#0
- +#11#183'wwwwww{'#191#204#204#204#204#204#204#11#191#187#187#187#187#187#187
- +'{'#191#204#204#204#204#204#204#11#191#187#187#187#187#187#187'{'#191#255#255
- +#255#255#255#255#251#191#255#255#255#255#255#255#251#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187#187
- +#187#187#187#187#187#187#187#187#187#187#187#187#187#187#9'NumGlyphs'#2#2#14
- +'ParentShowHint'#8#8'ShowHint'#9#7'OnClick'#7#17'SpeedButton6Click'#0#0#6'TL'
- ,'abel'#6'Label1'#4'Left'#3#200#0#3'Top'#2#12#5'Width'#2'i'#6'Height'#2#16#8
- +'AutoSize'#8#7'Caption'#6#14'Column &number'#0#0#11'TOvcSpinner'#11'OvcSpinn'
- +'er2'#4'Left'#3'i'#1#3'Top'#2#11#5'Width'#2#16#6'Height'#2#21#10'AutoRepeat'
- +#9#5'Delta'#5#0#0#0#0#0#0#0#128#255'?'#14'FocusedControl'#7#12'ctlColNumber'
- +#0#0#5'TEdit'#12'ctlColNumber'#4'Left'#3'8'#1#3'Top'#2#11#5'Width'#2'1'#6'He'
- +'ight'#2#21#9'MaxLength'#2#5#8'TabOrder'#2#0#8'OnChange'#7#18'ctlColNumberCh'
- +'ange'#6'OnExit'#7#16'ctlColNumberExit'#0#0#0#9'TGroupBox'#9'GroupBox1'#4'Le'
- +'ft'#2#8#3'Top'#2'0'#5'Width'#3#17#1#6'Height'#3#137#0#7'Caption'#6#14'Colum'
- +'n details'#8'TabOrder'#2#1#0#6'TLabel'#6'Label2'#4'Left'#2#8#3'Top'#2#4#5'W'
- +'idth'#2'K'#6'Height'#2#16#8'AutoSize'#8#7'Caption'#6#13'De&fault Cell'#12'F'
- +'ocusControl'#7#14'ctlDefaultCell'#0#0#6'TLabel'#6'Label3'#4'Left'#2#8#3'Top'
- +#2'\'#5'Width'#2'K'#6'Height'#2#16#8'AutoSize'#8#7'Caption'#6#6'&Width'#0#0#6
- +'TLabel'#6'Label4'#4'Left'#2#8#3'Top'#2'8'#5'Width'#2'"'#6'Height'#2#13#7'Ca'
- +'ption'#6#7'&Hidden'#12'FocusControl'#7#9'ctlHidden'#0#0#9'TComboBox'#14'ctl'
- +'DefaultCell'#4'Left'#2#8#3'Top'#2#24#5'Width'#3#1#1#6'Height'#2#21#5'Style'
- +#7#14'csDropDownList'#13'DropDownCount'#2#16#10'ItemHeight'#2#13#8'TabOrder'
- +#2#0#0#0#9'TCheckBox'#9'ctlHidden'#4'Left'#2'`'#3'Top'#2'8'#5'Width'#2#17#6
- +'Height'#2#17#8'TabOrder'#2#1#0#0#11'TOvcSpinner'#11'OvcSpinner1'#4'Left'#3
- +#145#0#3'Top'#2'Z'#5'Width'#2#16#6'Height'#2#21#10'AutoRepeat'#9#5'Delta'#5#0
- +#0#0#0#0#0#0#128#255'?'#14'FocusedControl'#7#8'ctlWidth'#0#0#5'TEdit'#8'ctlW'
- +'idth'#4'Left'#2'`'#3'Top'#2'Z'#5'Width'#2'1'#6'Height'#2#21#9'MaxLength'#2#5
- +#8'TabOrder'#2#2#0#0#0#7'TBitBtn'#10'DoneButton'#4'Left'#3'0'#1#3'Top'#3#160
- +#0#5'Width'#2'K'#6'Height'#2#25#7'Caption'#6#5'&Done'#11'ModalResult'#2#1#8
- +'TabOrder'#2#3#7'OnClick'#7#15'DoneButtonClick'#9'NumGlyphs'#2#2#0#0#7'TBitB'
- +'tn'#11'ApplyButton'#4'Left'#3'0'#1#3'Top'#2'8'#5'Width'#2'K'#6'Height'#2#25
- +#7'Caption'#6#6'&Apply'#7'Default'#9#8'TabOrder'#2#2#7'OnClick'#7#16'ApplyBu'
- +'ttonClick'#9'NumGlyphs'#2#2#0#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/myovctbpe2.pas b/Source/3rdParty/Orpheus/myovctbpe2.pas
deleted file mode 100644
index e18d114a..00000000
--- a/Source/3rdParty/Orpheus/myovctbpe2.pas
+++ /dev/null
@@ -1,351 +0,0 @@
-{*********************************************************}
-{* myovctbpe2.pas *}
-{*********************************************************}
-
-{* ***** 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): *}
-{* *}
-{* Phil Hess - adapted ovctbpe2.pas to eliminate TOvcSimpleField. *}
-{* *}
-{* ***** 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 MyOvcTbPE2;
- {Lazarus-specific Columns property editor for the table component}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Classes, Graphics, Controls,
- {$IFNDEF LCL} {$IFDEF VERSION6} DesignIntf, DesignEditors, {$ELSE} DsgnIntf, {$ENDIF} {$ELSE} PropEdits, ComponentEditors, {$ENDIF}
- TypInfo, Forms, Dialogs, StdCtrls, Buttons, ExtCtrls,
- OvcBase, OvcTCmmn, OvcTCell, OvcTbCls, OvcTable, OvcSc;
-
-type
- TOvcfrmColEditor = class(TForm)
- ctlColNumber: TEdit;
- ctlDefaultCell: TComboBox;
- ctlHidden: TCheckBox;
- ctlWidth: TEdit;
- Panel1: TPanel;
- SpeedButton1: TSpeedButton;
- SpeedButton2: TSpeedButton;
- SpeedButton3: TSpeedButton;
- SpeedButton4: TSpeedButton;
- SpeedButton5: TSpeedButton;
- SpeedButton6: TSpeedButton;
- Label1: TLabel;
- Label2: TLabel;
- Label3: TLabel;
- Label4: TLabel;
- GroupBox1: TGroupBox;
- DoneButton: TBitBtn;
- ApplyButton: TBitBtn;
- OvcSpinner1: TOvcSpinner;
- OvcSpinner2: TOvcSpinner;
- procedure ctlColNumberExit(Sender: TObject);
- procedure ApplyButtonClick(Sender: TObject);
- procedure SpeedButton1Click(Sender: TObject);
- procedure SpeedButton2Click(Sender: TObject);
- procedure SpeedButton3Click(Sender: TObject);
- procedure SpeedButton4Click(Sender: TObject);
- procedure SpeedButton5Click(Sender: TObject);
- procedure SpeedButton6Click(Sender: TObject);
- procedure FormShow(Sender: TObject);
- procedure DoneButtonClick(Sender: TObject);
- procedure ctlColNumberChange(Sender: TObject);
- private
- { Private declarations }
- FCols : TOvcTableColumns;
- FColNum : TColNum;
- CurCellIndex : integer;
- Cells : TStringList;
-
- protected
- procedure GetCells;
- procedure RefreshColData;
- procedure SetColNum(C : TColNum);
-
- procedure AddCellComponentName(const S : string);
-
- public
- { Public declarations }
- Editor : TObject;
- procedure SetCols(CS : TOvcTableColumns);
-
- property Cols : TOvcTableColumns
- read FCols
- write SetCols;
-
- property ColNum : TColNum
- read FColNum
- write SetColNum;
-
- end;
-
- {-A table column property editor}
- TOvcTableColumnProperty = class(TClassProperty)
- public
- procedure Edit; override;
- function GetAttributes: TPropertyAttributes; override;
- end;
-
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.DFM}
-{$ENDIF}
-
-
-
-{===TOvcTableColumnProperty==========================================}
-procedure TOvcTableColumnProperty.Edit;
- var
- ColEditor : TOvcfrmColEditor;
- begin
- ColEditor := TOvcfrmColEditor.Create(Application);
- try
- ColEditor.Editor := Self;
- ColEditor.SetCols(TOvcTableColumns(GetOrdValue));
- ColEditor.ShowModal;
-{$IFNDEF LCL}
- Designer.Modified;
-{$ELSE}
- Modified;
-{$ENDIF}
- finally
- ColEditor.Free;
- end;{try..finally}
- end;
-{--------}
-function TOvcTableColumnProperty.GetAttributes: TPropertyAttributes;
- begin
- Result := [paMultiSelect, paDialog, paReadOnly];
- end;
-{====================================================================}
-
-
-{===TColEditor=======================================================}
-procedure TOvcfrmColEditor.AddCellComponentName(const S : string);
- begin
- Cells.Add(S);
- end;
-{--------}
-procedure TOvcfrmColEditor.ApplyButtonClick(Sender: TObject);
- var
- NewColWidth : Integer;
- begin
- {20070204 workaround for recent change to Lazarus where
- ctlColNumberChange gets called by ShowModal for some reason
- (thus calling this method) before FormShow event handler
- which creates and initializes Cells.}
- if not Assigned(Cells) then
- Exit;
- FCols[ColNum].Hidden := ctlHidden.Checked;
- NewColWidth := StrToIntDef(ctlWidth.Text, FCols[ColNum].Width);
- if (NewColWidth < 5) or (NewColWidth > 32767) then {Out of range?}
- NewColWidth := FCols[ColNum].Width; {Restore previous column width}
- FCols[ColNum].Width := NewColWidth;
- ctlWidth.Text := IntToStr(NewColWidth);
- if (ctlDefaultCell.ItemIndex <> CurCellIndex) then
- begin
- CurCellIndex := ctlDefaultCell.ItemIndex;
- FCols[FColNum].DefaultCell := TOvcBaseTableCell(Cells.Objects[CurCellIndex]);
- end;
- end;
-{--------}
-procedure TOvcfrmColEditor.ctlColNumberExit(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- ColNum := StrToInt(ctlColNumber.Text);
- end;
-{--------}
-procedure TOvcfrmColEditor.DoneButtonClick(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- Cells.Free;
- end;
-{--------}
-procedure TOvcfrmColEditor.FormShow(Sender: TObject);
- begin
- if not Assigned(Cells) then
- begin
- Cells := TStringList.Create;
- GetCells;
- end;
- RefreshColData;
- end;
-{--------}
-procedure TOvcfrmColEditor.GetCells;
- var
- {$IFDEF VERSION4}
- {$IFDEF VERSION6}
-{$IFNDEF LCL}
- Designer : IDesigner;
-{$ENDIF}
- {$ELSE}
- Designer : IFormDesigner;
- {$ENDIF}
- {$ELSE}
- Designer : TFormDesigner;
- {$ENDIF}
- TI : PTypeInfo;
- Index: Integer;
- C : TComponent;
- Cell : TOvcBaseTableCell absolute C;
- begin
- Cells.Sorted := true;
- Cells.AddObject('(None)', nil);
- TI := TOvcBaseTableCell.ClassInfo;
-{$IFNDEF LCL}
- if (Editor is TClassProperty) then
- Designer := TClassProperty(Editor).Designer
- else {the editor is a TDefaultEditor}
- Designer := TDefaultEditor(Editor).Designer;
- Designer.GetComponentNames(GetTypeData(TI), AddCellComponentName);
- for Index := 1 to pred(Cells.Count) do
- Cells.Objects[Index] := Designer.GetComponent(Cells[Index]);
-{$ELSE}
- if (Editor is TClassProperty) then
- begin
- TClassProperty(Editor).PropertyHook.GetComponentNames(GetTypeData(TI), AddCellComponentName);
- for Index := 1 to pred(Cells.Count) do
- Cells.Objects[Index] := TClassProperty(Editor).PropertyHook.GetComponent(Cells[Index]);
- end
- else {the editor is a TDefaultComponentEditor}
- begin
- TDefaultComponentEditor(Editor).Designer.PropertyEditorHook.GetComponentNames(GetTypeData(TI), AddCellComponentName);
- for Index := 1 to pred(Cells.Count) do
- Cells.Objects[Index] := TDefaultComponentEditor(Editor).Designer.PropertyEditorHook.GetComponent(Cells[Index]);
- end;
-{$ENDIF}
- ctlDefaultCell.Items := Cells;
- end;
-{--------}
-procedure TOvcfrmColEditor.RefreshColData;
- begin
- CurCellIndex := Cells.IndexOfObject(FCols[ColNum].DefaultCell);
-
- ctlHidden.Checked := FCols[ColNum].Hidden;
- ctlWidth.Text := IntToStr(FCols[ColNum].Width);
- ctlDefaultCell.ItemIndex := CurCellIndex;
- end;
-{--------}
-procedure TOvcfrmColEditor.SetColNum(C : TColNum);
- begin
- if (FColNum <> C) then
- begin
- FColNum := C;
- RefreshColData;
- ctlColNumber.Text := IntToStr(C); //Do this after refresh
- end;
- end;
-{--------}
-procedure TOvcfrmColEditor.SetCols(CS : TOvcTableColumns);
- begin
- if Assigned(FCols) then
- FCols.Free;
- FCols := CS;
- FColNum := 0;
- ctlColNumber.Text := '0';
- end;
-{--------}
-procedure TOvcfrmColEditor.SpeedButton1Click(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- if (ColNum > 0) then
- ColNum := ColNum - 1;
- end;
-{--------}
-procedure TOvcfrmColEditor.SpeedButton2Click(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- if (ColNum < pred(FCols.Count)) then
- ColNum := ColNum + 1;
- end;
-{--------}
-procedure TOvcfrmColEditor.SpeedButton3Click(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- ColNum := 0;
- end;
-{--------}
-procedure TOvcfrmColEditor.SpeedButton4Click(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- ColNum := pred(FCols.Count);
- end;
-{--------}
-procedure TOvcfrmColEditor.SpeedButton5Click(Sender: TObject);
- var
- C : TOvcTableColumn;
- begin
- C := TOvcTableColumn.Create(FCols.Table);
- FCols.Insert(FColNum, C);
- RefreshColData;
- end;
-{--------}
-procedure TOvcfrmColEditor.SpeedButton6Click(Sender: TObject);
- begin
- if (FCols.Count > 1) then
- begin
- FCols.Delete(FColNum);
- if (FColNum = FCols.Count) then
- ColNum := pred(FColNum)
- else RefreshColData;
- end;
- end;
-{====================================================================}
-
-
-procedure TOvcfrmColEditor.ctlColNumberChange(Sender: TObject);
-var
- NewColNum : Integer;
-begin
- ApplyButtonClick(Self);
- if not TryStrToInt(ctlColNumber.Text, NewColNum) then {Invalid?}
- ctlColNumber.Text := IntToStr(ColNum) {Restore previous column number}
- else if NewColNum = -1 then {Wrap around to last column?}
- ctlColNumber.Text := IntToStr(Pred(FCols.Count))
- else if NewColNum = FCols.Count then {Wrap around to first column?}
- ctlColNumber.Text := '0'
- else if not (NewColNum in [0..Pred(FCols.Count)]) then {Out of range?}
- ctlColNumber.Text := IntToStr(ColNum); {Restore previous column number}
- ColNum := StrToInt(ctlColNumber.Text);
-end;
-
-initialization
-{$IFDEF LCL}
-{$I myovctbpe2.lrs} {Include form's resource file}
-{$ENDIF}
-
-end.
diff --git a/Source/3rdParty/Orpheus/o32bordr.pas b/Source/3rdParty/Orpheus/o32bordr.pas
deleted file mode 100644
index 42e167f2..00000000
--- a/Source/3rdParty/Orpheus/o32bordr.pas
+++ /dev/null
@@ -1,450 +0,0 @@
-{*********************************************************}
-{* O32BORDR.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 o32bordr;
- {New Style Border control for Orpheus 4 components.}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, MyMisc, {$ENDIF}
- Classes, Controls, Graphics;
-
-type
- TO32BorderStyle = (bstyNone, bstyRaised, bstyLowered, bstyFlat, bstyChannel,
- bstyRidge);
-
-const
- THiliteColor: array[TO32BorderStyle] of TColor = (clWindow, clBtnHighlight,
- clBtnShadow, clWindowFrame, clBtnShadow, clBtnHighlight);
-
- TBaseColor: array[TO32BorderStyle] of TColor = (clWindow, clBtnShadow,
- clBtnHighlight, clWindowFrame, clBtnHighlight, clBtnShadow);
-
-type
- TO32BorderSide = (bsidLeft, bsidRight, bsidTop, bsidBottom);
-
- TSides = (left, right, top, bottom);
-
- TO32Borders = class;
-
- TO32BorderSet = class(TPersistent)
- protected {private}
- FOwner : TPersistent;
- FLeft : Boolean;
- FTop : Boolean;
- FRight : Boolean;
- FBottom : Boolean;
- procedure SetLeft(Value: Boolean);
- procedure SetRight(Value: Boolean);
- procedure SetBottom(Value: Boolean);
- procedure SetTop(Value: Boolean);
- public
- constructor Create(AOwner: TPersistent);
- published
- property ShowLeft : Boolean read FLeft write SetLeft
- default True;
- property ShowRight : Boolean read FRight write SetRight
- default True;
- property ShowTop : Boolean read FTop write SetTop
- default True;
- property ShowBottom : Boolean read FBottom write SetBottom
- default True;
- end;
-
- TO32Borders = class(TPersistent)
- protected {private}
- Creating : Boolean;
- FControl : TWinControl;
- FBorderSet : TO32BorderSet;
- FActive : Boolean;
- FFlatColor : TColor;
- FBorderWidth : Integer;
- FBorderStyle : TO32BorderStyle;
- procedure SetActive (Value : Boolean);
- procedure SetBorderStyle (Value : TO32BorderStyle);
- procedure SetFlatColor (Value : TColor);
-
- procedure Draw3dBox(Canvas: TCanvas; Rct: TRect; Hilite,
- Base: TColor; DrawAllSides: Boolean);
- procedure DrawFlatBorder(Canvas: TControlCanvas; Rct: TRect;
- Color: TColor{; DrawAllSides: Boolean}); {!!!}
- procedure DrawBevel(Canvas: TControlCanvas; Rct: TRect; HiliteColor,
- BaseColor: TColor);
- procedure Draw3dBorders(Canvas: TControlCanvas; Rct: TRect);
- procedure EraseBorder(Canvas: TControlCanvas; Rct: TRect;
- Color: TColor; AllSides: Boolean);
- procedure DrawSingleSolidBorder(Canvas: TControlCanvas; Rct: TRect;
- Color: TColor; Side: TSides; Width: Integer);
- public
- constructor Create(Control: TWinControl);
- destructor Destroy; override;
- procedure Changed;
- procedure BordersChanged;
- property Control: TWinControl read FControl;
- procedure DrawBorders(var Canvas: TControlCanvas; Color: TColor);
- procedure RedrawControl;
- published
- property Active : Boolean read FActive write SetActive
- default False;
- property BorderSet : TO32BorderSet
- read FBorderSet write FBorderSet;
- property BorderStyle: TO32BorderStyle read FBorderStyle write SetBorderStyle
- default bstyRidge;
- property FlatColor: TColor read FFlatColor write SetFlatColor
- default clLime;
- end;
-
-implementation
-
-{===== TO32BorderSet =================================================}
-constructor TO32BorderSet.Create(AOwner: TPersistent);
-begin
- inherited Create;
- FOwner := AOwner;
-end;
-{=====}
-
-procedure TO32BorderSet.SetLeft(Value: Boolean);
-begin
- if Value <> FLeft then begin
- FLeft := Value;
- TO32Borders(FOwner).BordersChanged;
- end;
-end;
-{=====}
-
-procedure TO32BorderSet.SetRight(Value: Boolean);
-begin
- if Value <> FRight then begin
- FRight := Value;
- TO32Borders(FOwner).BordersChanged;
- end;
-end;
-{=====}
-
-procedure TO32BorderSet.SetBottom(Value: Boolean);
-begin
- if Value <> FBottom then begin
- FBottom := Value;
- TO32Borders(FOwner).BordersChanged;
- end;
-end;
-{=====}
-
-procedure TO32BorderSet.SetTop(Value: Boolean);
-begin
- if Value <> FTop then begin
- FTop := Value;
- TO32Borders(FOwner).BordersChanged;
- end;
-end;
-
-{===== TO32BorderSet - End =====}
-
-
-{===== TO32Borders =================================================}
-constructor TO32Borders.Create(Control: TWinControl);
-begin
- Creating := True;
- inherited Create;
- FControl := Control;
- FBorderSet := TO32BorderSet.Create(self);
- FActive := false;
- FBorderWidth := 2;
- FBorderStyle := bstyRidge;
- FFlatColor := clLime;
- FBorderSet.ShowBottom := true;
- FBorderSet.ShowLeft := true;
- FBorderSet.ShowRight := true;
- FBorderSet.ShowTop := true;
- Creating := False;
-end;
-{=====}
-
-destructor TO32Borders.Destroy;
-begin
- FBorderSet.Free;
- inherited Destroy;
-end;
-{=====}
-
-procedure TO32Borders.SetActive(Value: Boolean);
-begin
- if FActive <> Value then begin
- FActive := Value;
- Changed;
- end;
-end;
-{=====}
-
-procedure TO32Borders.SetBorderStyle(Value: TO32BorderStyle);
-begin
- if Value <> FBorderStyle then begin
- FBorderStyle := Value;
- Changed;
- end;
-end;
-{=====}
-
-procedure TO32Borders.SetFlatColor(Value: TColor);
-begin
- if Value <> FFlatColor then begin
- FFlatColor := Value;
- if FBorderStyle = bstyFlat then
- Changed;
- end;
-end;
-{=====}
-
-procedure TO32Borders.DrawBorders(var Canvas: TControlCanvas; Color: TColor);
-var
- Rct : TRect;
-begin
- if not FActive then exit;
-
- Rct := Rect(0, 0, FControl.Width, FControl.Height);
-
- {Erase the existing border.}
- EraseBorder(Canvas, Rct, Color, true);
-
- {If the border style is bstyNone then don't do anything else.}
- if FBorderStyle = bstyNone then exit;
-
- {otherwise, draw the border.}
- if FBorderStyle = bstyFlat then
- DrawFlatBorder(Canvas, Rct, FFlatColor{, false})
- else Draw3dBorders(Canvas, Rct);
-end;
-{=====}
-
-procedure TO32Borders.Draw3dBorders(Canvas: TControlCanvas; Rct: TRect);
-var
- Hilite, Base: TColor;
- R: TRect;
-begin
- Hilite := THiliteColor[FBorderStyle];
- Base := TBaseColor[FBorderStyle];
-
- if FBorderStyle in [bstyLowered, bstyRaised ] then
- DrawBevel(Canvas, Rct, Hilite, Base)
-
- else with FBorderSet do begin
- R := Rct;
- {Patch the border edges}
-
- if ShowRight then
- Canvas.Pixels[R.Right - 1, R.Top] := Base;
- if ShowTop and not ShowRight then
- Canvas.Pixels[R.Right - 1, R.Top] := Hilite;
- if ShowBottom then
- Canvas.Pixels[R.Left, R.Bottom - 1] := Base;
- if ShowLeft and not ShowBottom then
- Canvas.Pixels[R.Left, R.Bottom - 1] := Hilite;
- if ShowTop and not ShowLeft then
- Canvas.Pixels[R.Left, R.Top + 1] := Base;
- if not ShowTop and ShowLeft then
- Canvas.Pixels[R.Left + 1, R.Top] := Base;
- if ShowBottom and not ShowRight then
- Canvas.Pixels[R.Right - 1, R.Bottom - 2] := Hilite;
- if not ShowBottom and ShowRight then
- Canvas.Pixels[R.Right - 2, R.Bottom - 1] := Hilite;
-
- Inc( R.Left );
- Inc( R.Top );
- Draw3dBox(Canvas, R, Base, Base, false);
- OffsetRect(R, -1, -1);
- Draw3dBox(Canvas, R, Hilite, Hilite, false);
-
-{ - dead code}
-// if ShowLeft then Inc(Rct.Left, 2);
-// if ShowTop then Inc(Rct.Top, 2);
-// if ShowRight then Dec(Rct.Right, 2);
-// if ShowBottom then Dec(Rct.Bottom, 2);
- end;
-end;
-{=====}
-
-procedure TO32Borders.DrawSingleSolidBorder(Canvas: TControlCanvas; Rct: TRect;
- Color: TColor; Side: TSides; Width: Integer);
-var
- i: Integer;
-begin
- with Canvas, FBorderSet do begin
- Pen.Width := 1;
- Pen.Color := Color;
-
- if Side = left then
- for i := 0 to Width do begin
- MoveTo(Rct.Left - 1, Rct.Top);
- LineTo(Rct.Left - 1, Rct.Bottom);
- Inc(Rct.Left);
- end
- else if Side = right then
- for i := 0 to Width do begin
- MoveTo(Rct.Right , Rct.Top);
- LineTo(Rct.Right , Rct.Bottom);
- Dec(Rct.Right);
- end
- else if Side = top then
- for i := 0 to Width do begin
- MoveTo(Rct.Left, Rct.Top - 1);
- LineTo(Rct.Right, Rct.Top - 1);
- Inc(Rct.Top);
- end
- else if Side = bottom then
- for i := 0 to Width do begin
- MoveTo(Rct.Left, Rct.Bottom);
- LineTo(Rct.Right, Rct.Bottom);
- Dec(Rct.Bottom);
- end;
- end;
-end;
-{=====}
-
-procedure TO32Borders.Draw3dBox(Canvas: TCanvas; Rct: TRect; Hilite,
- Base: TColor; DrawAllSides: Boolean);
-begin
- with Canvas, Rct, FBorderSet do begin
- Pen.Width := 1;
- Pen.Color := Hilite;
- if ShowLeft or DrawAllSides then begin
- MoveTo( Left, Top );
- LineTo( Left, Bottom );
- end;
-
- if ShowTop or DrawAllSides then begin
- MoveTo( Left, Top );
- LineTo( Right, Top );
- end;
-
- Pen.Color := Base;
- if ShowRight or DrawAllSides then begin
- MoveTo( Right - 1, Top );
- LineTo( Right - 1, Bottom );
- end;
-
- if ShowBottom or DrawAllSides then begin
- MoveTo( Left, Bottom - 1 );
- LineTo( Right, Bottom - 1 );
- end;
- end;
-end;
-{=====}
-
-procedure TO32Borders.DrawBevel(Canvas: TControlCanvas; Rct: TRect; HiliteColor,
- BaseColor: TColor);
-var
- I: Integer;
-begin
- Canvas.Pen.Width := 1;
- for I := 1 to FBorderWidth do
- begin
- Draw3dBox(Canvas, Rct, HiliteColor, BaseColor, False);
- Inc(Rct.Left);
- Inc(Rct.Top);
- Dec(Rct.Right);
- Dec(Rct.Bottom);
- end;
-end;
-{=====}
-
-procedure TO32Borders.DrawFlatBorder(Canvas: TControlCanvas; Rct: TRect;
- Color: TColor{; DrawAllSides: Boolean});
-begin
- Canvas.Pen.Color := Color;
- with BorderSet do begin
- if ShowLeft then
- DrawSingleSolidBorder(Canvas, Rct, Color, left, FBorderWidth);
- if ShowRight then
- DrawSingleSolidBorder(Canvas, Rct, Color, right, FBorderWidth);
- if ShowTop then
- DrawSingleSolidBorder(Canvas, Rct, Color, top, FBorderWidth);
- if ShowBottom then
- DrawSingleSolidBorder(Canvas, Rct, Color, bottom, FBorderWidth);
- end;
-end;
-{=====}
-
-procedure TO32Borders.EraseBorder(Canvas: TControlCanvas; Rct: TRect;
- Color: TColor; AllSides: Boolean);
-var
- i: Integer;
-begin
- Canvas.Pen.Color := Color;
- with BorderSet do begin
- for i := 1 to FBorderWidth do begin
- Draw3dBox(Canvas, Rct, Color, Color, AllSides);
- Inc(Rct.Left);
- Inc(Rct.Top);
- Dec(Rct.Right);
- Dec(Rct.Bottom);
- end;
- end;
-end;
-{=====}
-
-procedure TO32Borders.BordersChanged;
-begin
- if FActive then Changed;
-end;
-{=====}
-
-procedure TO32Borders.RedrawControl;
-var
- Rct: TRect;
-begin
- if not Creating then begin
- Rct := FControl.ClientRect;
- RedrawWindow(FControl.Handle, @Rct, 0,
- rdw_Invalidate or rdw_UpdateNow or rdw_Frame );
- end;
-end;
-{=====}
-
-procedure TO32Borders.Changed;
-begin
- FControl.Invalidate;
- RedrawControl;
-end;
-
-{===== TO32Borders - End =====}
-
-end.
-
-
-
diff --git a/Source/3rdParty/Orpheus/o32editf.pas b/Source/3rdParty/Orpheus/o32editf.pas
deleted file mode 100644
index f40622ab..00000000
--- a/Source/3rdParty/Orpheus/o32editf.pas
+++ /dev/null
@@ -1,385 +0,0 @@
-{*********************************************************}
-{* O32EDITF.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}
-{$J+} {Writable constants}
-
-unit o32editf;
- {-base FlexEdit field class w/ attached label}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, Types, LclType, MyMisc, {$ENDIF}
- Buttons, Classes, Controls, ExtCtrls, Forms, Graphics, Menus,
- StdCtrls, SysUtils, OvcBase, OvcConst, OvcData, OvcVer,
- OvcMisc;
-
-type
- {base class for non-OvcController dependent edit fields...}
- TO32CustomEdit = class(TCustomEdit)
- protected {private}
- {property variables}
- FLabelInfo : TOvcLabelInfo;
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
- {property methods}
- function GetAbout : string;
- function GetAttachedLabel : TOvcAttachedLabel;
- procedure SetAbout(const Value : string);
- {internal methods}
- procedure LabelChange(Sender : TObject);
- procedure LabelAttach(Sender : TObject; Value : Boolean);
- procedure PositionLabel;
- {VCL message methods}
- procedure CMVisibleChanged(var Msg : TMessage); message CM_VISIBLECHANGED;
- procedure OrAssignLabel(var Msg : TMessage); message OM_ASSIGNLABEL;
- procedure OrPositionLabel(var Msg : TMessage); message OM_POSITIONLABEL;
- procedure OrRecordLabelPosition(var Msg : TMessage);
- message OM_RECORDLABELPOSITION;
- protected
- {descendants can set the value of this variable after calling inherited }
- {create to set the default location and point-of-reference (POR) for the}
- {attached label. if dlpTopLeft, the default location and POR will be at }
- {the top left of the control. if dlpBottomLeft, the default location and}
- {POR will be at the bottom left}
- DefaultLabelPosition : TOvcLabelPosition;
- procedure CreateWnd; override;
- procedure Notification(AComponent : TComponent; Operation: TOperation);
- override;
- property About : string read GetAbout write SetAbout stored False;
- property LabelInfo : TOvcLabelInfo read FLabelInfo write FLabelInfo;
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D;
-{$ENDIF}
- public
- constructor Create(AOwner : TComponent); override;
- destructor Destroy; override;
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
- property AttachedLabel : TOvcAttachedLabel read GetAttachedLabel;
- end;
-
- TO32Edit = class(TO32CustomEdit)
- published
- {properties}
- {$IFDEF VERSION4}
- property Anchors;
-{$IFNDEF LCL}
- property BiDiMode;
- property ParentBiDiMode;
-{$ENDIF}
- property Constraints;
- property DragKind;
- {$ENDIF}
- property About;
-{$IFNDEF LCL}
- property AutoSelect; // Added recently to LCL, but leave out for now
-{$ENDIF}
- property AutoSize;
- property BorderStyle;
- property CharCase;
- property Color;
- property Ctl3D;
- property Cursor;
- property DragCursor;
- property DragMode;
- property Enabled;
- property Font;
-{$IFNDEF LCL}
- property HideSelection;
- property ImeMode;
- property ImeName;
-{$ENDIF}
- property LabelInfo;
- property MaxLength;
-{$IFNDEF LCL}
- property OEMConvert;
-{$ENDIF}
- property ParentColor;
-{$IFNDEF LCL}
- property ParentCtl3D;
-{$ENDIF}
- property ParentFont;
- property ParentShowHint;
- property PasswordChar;
- property PopupMenu;
- property ReadOnly;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property Text;
- property Visible;
- {events}
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- {$IFDEF VERSION4}
- property OnEndDock;
- property OnStartDock;
- {$ENDIF}
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDrag;
- end;
-
-implementation
-
-{===== TO32CustomEdit ==============================================}
-procedure TO32CustomEdit.CMVisibleChanged(var Msg : TMessage);
-begin
- inherited;
-
- if csLoading in ComponentState then
- Exit;
-
- if LabelInfo.Visible then
- AttachedLabel.Visible := Visible;
-end;
-{=====}
-
-constructor TO32CustomEdit.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- ControlStyle := ControlStyle - [csSetCaption];
-
- {set default position and reference point}
- DefaultLabelPosition := lpTopLeft;
-
- FLabelInfo := TOvcLabelInfo.Create;
- FLabelInfo.OnChange := LabelChange;
- FLabelInfo.OnAttach := LabelAttach;
-end;
-{=====}
-
-procedure TO32CustomEdit.CreateWnd;
-// OurForm : TWinControl;
-begin
-// OurForm := GetImmediateParentForm(Self);
- inherited CreateWnd;
-end;
-{=====}
-
-destructor TO32CustomEdit.Destroy;
-begin
- {detatch and destroy label, if any}
- FLabelInfo.Visible := False;
-
- {destroy label info}
- FLabelInfo.Free;
- FLabelInfo := nil;
-
- inherited Destroy;
-end;
-{=====}
-
-function TO32CustomEdit.GetAttachedLabel : TOvcAttachedLabel;
-begin
- if not FLabelInfo.Visible then
- raise Exception.Create(GetOrphStr(SCLabelNotAttached));
-
- Result := FLabelInfo.ALabel;
-end;
-{=====}
-
-function TO32CustomEdit.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-{=====}
-
-procedure TO32CustomEdit.LabelAttach(Sender : TObject; Value : Boolean);
-var
-{$IFDEF VERSION5}
- PF : TWinControl;
-{$ELSE}
- PF : TForm;
-{$ENDIF}
- S :string;
-begin
- if csLoading in ComponentState then
- Exit;
-
-{$IFDEF VERSION5}
- PF := GetImmediateParentForm(Self);
-{$ELSE}
- PF := TForm(GetParentForm(Self));
-{$ENDIF}
- if Value then begin
- if Assigned(PF) then begin
- FLabelInfo.ALabel.Free;
- FLabelInfo.ALabel := TOvcAttachedLabel.CreateEx(PF, Self);
- FLabelInfo.ALabel.Parent := Parent;
-
- S := GenerateComponentName(PF, Name + 'Label');
- FLabelInfo.ALabel.Name := S;
- FLabelInfo.ALabel.Caption := S;
-
- FLabelInfo.SetOffsets(0, 0);
- PositionLabel;
- FLabelInfo.ALabel.BringToFront;
- {turn off auto size}
- TLabel(FLabelInfo.ALabel).AutoSize := False;
- end;
- end else begin
- if Assigned(PF) then begin
- FLabelInfo.ALabel.Free;
- FLabelInfo.ALabel := nil;
- end;
- end;
-end;
-{=====}
-
-procedure TO32CustomEdit.LabelChange(Sender : TObject);
-begin
- if not (csLoading in ComponentState) then
- PositionLabel;
-end;
-{=====}
-
-procedure TO32CustomEdit.Notification(AComponent : TComponent; Operation: TOperation);
-var
-{$IFDEF VERSION5}
- PF : TWinControl;
-{$ELSE}
- PF : TForm;
-{$ENDIF}
-begin
- inherited Notification(AComponent, Operation);
-
- if Operation = opRemove then
- if Assigned(FLabelInfo) and (AComponent = FLabelInfo.ALabel) then begin
- {$IFDEF VERSION5}
- PF := GetImmediateParentForm(Self);
- {$ELSE}
- PF := TForm(GetParentForm(Self));
- {$ENDIF}
- if Assigned(PF) and not (csDestroying in PF.ComponentState) then begin
- FLabelInfo.FVisible := False;
- FLabelInfo.ALabel := nil;
- end
- end;
-end;
-{=====}
-
-procedure TO32CustomEdit.OrAssignLabel(var Msg : TMessage);
-begin
- FLabelInfo.ALabel := TOvcAttachedLabel(Msg.lParam);
-end;
-{=====}
-
-procedure TO32CustomEdit.OrPositionLabel(var Msg : TMessage);
-const
- DX : Integer = 0;
- DY : Integer = 0;
-begin
- if FLabelInfo.Visible and Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) and
- not (csLoading in ComponentState) then begin
- if DefaultLabelPosition = lpTopLeft then begin
- DX := FLabelInfo.ALabel.Left - Left;
- DY := FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top;
- end else begin
- DX := FLabelInfo.ALabel.Left - Left;
- DY := FLabelInfo.ALabel.Top - Top - Height;
- end;
- if (DX <> FLabelInfo.OffsetX) or (DY <> FLabelInfo.OffsetY) then
- PositionLabel;
- end;
-end;
-{=====}
-
-procedure TO32CustomEdit.OrRecordLabelPosition(var Msg : TMessage);
-begin
- if Assigned(FLabelInfo.ALabel) and (FLabelInfo.ALabel.Parent <> nil) then begin
- {if the label was cut and then pasted, this will complete the reattachment}
- FLabelInfo.FVisible := True;
-
- if DefaultLabelPosition = lpTopLeft then
- FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
- FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top)
- else
- FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
- FLabelInfo.ALabel.Top - Top - Height);
- end;
-end;
-{=====}
-
-procedure TO32CustomEdit.PositionLabel;
-begin
- if FLabelInfo.Visible and Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) and
- not (csLoading in ComponentState) then begin
-
- if DefaultLabelPosition = lpTopLeft then begin
- FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
- FLabelInfo.OffsetY - FLabelInfo.ALabel.Height + Top,
- FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
- end else begin
- FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
- FLabelInfo.OffsetY + Top + Height,
- FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
- end;
- end;
-end;
-{=====}
-
-procedure TO32CustomEdit.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
-begin
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-
- if not HandleAllocated then
- Exit;
-
- if HandleAllocated then
- PostMessage(Handle, OM_POSITIONLABEL, 0, 0);
-end;
-{=====}
-
-procedure TO32CustomEdit.SetAbout(const Value : string);
-begin
-end;
-
-end.
diff --git a/Source/3rdParty/Orpheus/o32flxed.pas b/Source/3rdParty/Orpheus/o32flxed.pas
deleted file mode 100644
index c7beaefa..00000000
--- a/Source/3rdParty/Orpheus/o32flxed.pas
+++ /dev/null
@@ -1,1601 +0,0 @@
-{*********************************************************}
-{* O32FLXED.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}
-{$J+} {Writable constants}
-
-unit o32flxed;
- {OvcFlexEdit and support classes - Introduced in Orpheus 4.0}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, Types, LclType, MyMisc, {$ENDIF}
- Classes, Controls, Forms, SysUtils, StdCtrls, Buttons,
- OvcData, O32Editf, OvcEF, Graphics, O32SR, O32bordr, O32Vldtr,
- O32VlOp1, o32ovldr, {$IFNDEF LCL} o32pvldr, {$ENDIF} o32rxvld, Dialogs;
-
-type
- {Forward Declaration}
- TO32CustomFlexEdit = class;
-
- TO32PopupAnchor = (paLeft, paRight);
-
-
-// TO32FlexEditDataType = (feString, feFloat, feInteger, feDateTime, feExtended,
-// feStDate, feStTime, feLogical);
-
- TO32FEButton = class(TBitBtn)
- public
- procedure Click; override;
- end;
-
- TO32feButtonClickEvent =
- procedure(Sender: TO32CustomFlexEdit; PopupPoint: TPoint) of object;
- TFEUserValidationEvent =
- procedure(Sender : TObject; var ValidEntry : Boolean) of object;
- TFEValidationErrorEvent =
- procedure(Sender : TObject; ErrorCode : Word; ErrorMsg : string) of object;
-
- TFlexEditValidatorOptions = class(TValidatorOptions)
- published
- property InputRequired;
- end;
-
- TO32EditLines = class(TPersistent)
- protected{private}
- FlexEdit : TO32CustomFlexEdit;
- FMaxLines : Integer;
- FDefaultLines : Integer;
- FFocusedLines : Integer;
- FMouseOverLines: Integer;
- procedure SetDefaultLines(Value: Integer);
- procedure SetMaxLines(Value: Integer);
- procedure SetFocusedLines(Value: Integer);
- procedure SetMouseOverLines(Value: Integer);
- public
- constructor Create; virtual;
- destructor Destroy; override;
- published
- property MaxLines: Integer read FMaxLines write SetMaxLines
- default 3;
- property DefaultLines: Integer read FDefaultLines write SetDefaultLines
- default 1;
- property FocusedLines: Integer read FFocusedLines write SetFocusedLines
- default 3;
- property MouseOverLines: Integer read FMouseOverLines write SetMouseOverLines
- default 3;
- end;
-
- TFlexEditStrings = class(TStrings)
- protected {private}
- FCapacity: Integer;
- function Get(Index: Integer): string; override;
- function GetCount: Integer; override;
- function GetTextStr: string; override;
- procedure Put(Index: Integer; const S: string); override;
- procedure SetTextStr(const Value: string); override;
- procedure SetUpdateState(Updating: Boolean); override;
-
- public
- FlexEdit: TCustomEdit;
- procedure Clear; override;
- procedure SetCapacity(NewCapacity: Integer); override;
- procedure Delete(Index: Integer); override;
- procedure Insert(Index: Integer; const S: string); override;
- end;
-
- TO32CustomFlexEdit = class(TO32CustomEdit)
- protected {private}
- FAlignment : TAlignment;
- FBorders : TO32Borders;
- FButton : TO32FEButton;
- FButtonGlyph : TBitmap;
- FCanvas : TControlCanvas;
-// FDataType : TO32FlexEditDataType;
- FEditLines : TO32EditLines;
- FEFColors : TOvcEFColors;
- FDisplayedLines : Integer;
- FMaxLines : Integer;
- FStrings : TFlexEditStrings;
-// FPasswordChar : Char;
- FPopupAnchor : TO32PopupAnchor;
- FShowButton : Boolean;
- FWordWrap : Boolean;
- FWantReturns : Boolean;
- FWantTabs : Boolean;
- FMouseInControl : Boolean;
- FValidation : TFlexEditValidatorOptions;
- FValidator : TO32BaseValidator;
- FValidationError : Integer;
-
- FOnButtonClick : TO32feButtonClickEvent;
- FOnUserValidation : TFEUserValidationEvent;
- FOnValidationError: TFEValidationErrorEvent;
- FBeforeValidation : TNotifyEvent;
- FAfterValidation : TNotifyEvent;
-
- {Internal Variables}
- FSaveEdit : String; {saved copy of edit string}
- FCreating : Boolean;
-
- FColor : TColor;
- FFontColor : TColor;
-
- FUpdating : Integer;
- feValid : Boolean;
-
-
- {Property Methods}
- function GetButtonGlyph : TBitmap;
- procedure SetButtonGlyph(Value : TBitmap);
- procedure SetShowButton (Value : Boolean);
- function GetBoolean : Boolean;
- function GetYesNo : Boolean;
- function GetDateTime : TDateTime;
- function GetDouble : Double;
- function GetExtended : Extended;
- function GetInteger : Integer;
- function GetStrings : TStrings;
- function GetVariant : Variant;
- function GetText : String;
- function GetColor : TColor; virtual;
-
- procedure SetBoolean (Value : Boolean);
- procedure SetYesNo (Value : Boolean);
- procedure SetDateTime (Value : TDateTime);
-// procedure SetDataType (Value : TO32FlexEditDataType);
- procedure SetDouble (Value : Double);
- procedure SetExtended (Value : Extended);
- procedure SetInteger (Value : Integer);
- procedure SetStrings (Value : TStrings);
- procedure SetVariant (Value : Variant);
- procedure SetDisplayedLines(Value : Integer);
- procedure SetWordWrap (Value : Boolean);
- procedure SetWantReturns (Value : Boolean);
- procedure SetWantTabs (Value : Boolean);
- procedure SetText (const Value : String);
- procedure SetColor (Value : TColor); virtual;
-
- {Message Handlers}
- procedure WMGetDlgCode (var Message : TWMGetDlgCode); message WM_GETDLGCODE;
- procedure CMMouseEnter (var Message : TMessage); message CM_MOUSEENTER;
- procedure CMMouseLeave (var Message : TMessage); message CM_MOUSELEAVE;
-{$IFNDEF LCL}
- procedure CMGotFocus (var Message : TMessage); message WM_SETFOCUS;
- procedure CMLostFocus (var Message : TMessage); message WM_KILLFOCUS;
-{$ELSE}
- procedure CMGotFocus (var Message : TLMSetFocus); message WM_SETFOCUS;
- procedure CMLostFocus (var Message : TLMKillFocus); message WM_KILLFOCUS;
-{$ENDIF}
-
- { - added}
- procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
-
- procedure WMNCPaint (var Message : TWMNCPaint); message WM_NCPAINT;
-
-{ - was commented out in 4.02 and re-written in 4.06}
- procedure WMPaint (var Message : TWMPaint); message WM_PAINT;
-
- procedure OMValidate (var Message : TMessage); message OM_VALIDATE;
- procedure OMRecreateWnd(var Message : TMessage); message OM_RECREATEWND;
-
- {Internal Methods}
- procedure KeyPress(var Key: Char); override;
- procedure CreateParams(var Params : TCreateParams); override;
- procedure SetParent(Value: TWinControl); override;
- procedure CreateWnd; override;
-{$IFNDEF LCL}
- procedure CreateWindowHandle(const Params: TCreateParams); override;
-{$ENDIF}
- procedure AdjustHeight;
- procedure GlyphChanged; dynamic;
- procedure Loaded; override;
- procedure SetAlignment(Value: TAlignment);
- function MultiLineEnabled: Boolean;
- function GetButtonWidth : Integer;
- function GetButtonEnabled : Boolean; dynamic;
- procedure SetMaxLines(Value: Integer);
- function ValidateSelf: Boolean; virtual;
- procedure SaveEditString;
-
- procedure DoOnChange; virtual;
-
-{$IFDEF LCL}
- function ChildClassAllowed(ChildClass: TClass): Boolean; override;
-{$ENDIF}
-
- public
- constructor Create(AOwner : TComponent); override;
- destructor Destroy; override;
-
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
- procedure ButtonClick; dynamic;
- procedure Restore; virtual;
-
- procedure BeginUpdate;
- procedure EndUpdate;
-
- {properties}
- property Alignment: TAlignment
- read FAlignment write SetAlignment default taLeftJustify;
-// property DataType: TO32FlexEditDataType
-// read FDataType write SetDataType default feString;
- property Borders: TO32Borders
- read FBorders write FBorders;
- property Color: TColor
- read GetColor write SetColor default clWindow;
- property EfColors: TOvcEfColors
- read FEFColors write FEFColors;
- property EditLines: TO32EditLines
- read FEditLines write FEditLines;
-// property PasswordChar: char
-// read FPasswordChar write SetPwdChar;
- property PopupAnchor : TO32PopupAnchor
- read FPopupAnchor write FPopupAnchor;
- property ShowButton : Boolean
- read FShowButton write SetShowButton;
- property Validation: TFlexEditValidatorOptions
- read FValidation write FValidation;
- property WantReturns: Boolean
- read FWantReturns write SetWantReturns default False;
- property WantTabs: Boolean
- read FWantTabs write SetWantTabs default False;
- property WordWrap: Boolean
- read FWordWrap write SetWordWrap default False;
- property Text: String
- read GetText write SetText;
- property Strings: TStrings
- read GetStrings write SetStrings;
-
- property AsBoolean: Boolean
- read GetBoolean write SetBoolean;
- property AsYesNo: Boolean
- read GetYesNo write SetYesNo;
- property AsDateTime: TDateTime
- read GetDateTime write SetDateTime;
- property AsFloat: Double
- read GetDouble write SetDouble;
- property AsExtended: Extended
- read GetExtended write SetExtended;
- property AsInteger: Integer
- read GetInteger write SetInteger;
- property AsVariant: Variant
- read GetVariant write SetVariant;
- property ButtonGlyph : TBitmap
- read GetButtonGlyph write SetButtonGlyph;
- property Canvas :TControlCanvas
- read FCanvas;
- property OnButtonClick : TO32feButtonClickEvent
- read FOnButtonClick write FOnButtonClick;
- property OnUserValidation: TFEUserValidationEvent
- read FOnUserValidation write FOnUserValidation;
- property OnValidationError: TFEValidationErrorEvent
- read FOnValidationError write FOnValidationError;
- property BeforeValidation : TNotifyEvent
- read FBeforeValidation write FBeforeValidation;
- property AfterValidation : TNotifyEvent
- read FAfterValidation write FAfterValidation;
- end;
-
- {O32FlexEdit}
- TO32FlexEdit = class(TO32CustomFlexEdit)
- published
- {$IFDEF VERSION4}
- property Alignment;
- property Anchors;
-{$IFNDEF LCL}
- property BiDiMode;
- property ParentBiDiMode;
-{$ENDIF}
- property DragKind;
- property DragMode;
- property OnEndDock;
- property OnStartDock;
- {$ENDIF}
- property AutoSize default False;
- property About;
-{$IFNDEF LCL}
- property AutoSelect; // Added recently to LCL, but leave out for now
-{$ENDIF}
- property Borders;
- property ButtonGlyph;
- property CharCase;
- property Color;
- property Cursor;
- property DragCursor;
- property EditLines;
- property EfColors;
- property Enabled;
- property Font;
-{$IFNDEF LCL}
- property HideSelection;
- property ImeMode;
- property ImeName;
-{$ENDIF}
- property LabelInfo;
- property MaxLength;
-{$IFNDEF LCL}
- property OEMConvert;
-{$ENDIF}
- property ParentFont;
- property ParentShowHint;
- property PasswordChar;
- property PopupAnchor default paLeft;
- property PopupMenu;
- property ReadOnly;
- property ShowButton default False;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property Text;
- property Validation;
- property Visible;
- property WantReturns;
- property WantTabs;
- property WordWrap;
-
- property AfterValidation;
- property BeforeValidation;
- property OnButtonClick;
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDrag;
- property OnUserValidation;
- property OnValidationError;
- end;
-
-implementation
-
-// The optional button inside a TO32FlexEdit originally did not work with LCL,
-// so excluded all button-related code.
-// Note now seems to work with win32 and carbon as of 0.9.28. To enable,
-// delete the dot in the two DEFINE's.
-// For more information, see Lazarus bug 7097.
-{$IFNDEF LCL}
- {$DEFINE ButtonOkay}
-{$ELSE}
- {.$DEFINE ButtonOkay}
- {$IFNDEF MSWINDOWS}
- {.$DEFINE ButtonNotChild} //Manually reposition relative to edit control
- {$ENDIF}
-{$ENDIF}
-
-{===== TO32FEButton ==================================================}
-
-procedure TO32FEButton.Click;
-begin
- TO32FlexEdit(Parent).SetFocus;
- TO32FlexEdit(Parent).ButtonClick;
-end;
-
-{===== TO32EditLines =================================================}
-
-constructor TO32EditLines.Create;
-begin
- inherited Create;
- FMaxLines := 3{1};
- FFocusedLines := 3{1};
- FMouseOverLines := 3{1};
- FDefaultLines := 1;
-end;
-{=====}
-
-destructor TO32EditLines.Destroy;
-begin
- inherited Destroy;
-end;
-{=====}
-
-procedure TO32EditLines.SetDefaultLines(Value: Integer);
-begin
- if FDefaultLines <> Value then
- FDefaultLines := Value;
- if FDefaultLines > FMaxLines then
- FDefaultLines := FMaxLines;
-end;
-{=====}
-
-procedure TO32EditLines.SetMaxLines(Value: Integer);
-begin
- if FMaxLines <> Value then begin
- FMaxLines := Value;
- TO32CustomFlexEdit(FlexEdit).SetMaxLines(FMaxLines);
- end;
-end;
-{=====}
-
-procedure TO32EditLines.SetFocusedLines(Value: Integer);
-begin
- if FFocusedLines <> Value then
- FFocusedLines := Value;
- if FFocusedLines > FMaxLines then
- FFocusedLines := FMaxLines;
-end;
-{=====}
-
-procedure TO32EditLines.SetMouseOverLines(Value: Integer);
-begin
- if FMouseOverLines <> Value then
- FMouseOverLines := Value;
- if FMouseOverLines > FMaxLines then
- FMouseOverLines := FMaxLines;
-end;
-
-
-{===== TFlexEditStrings ==============================================}
-
-function TFlexEditStrings.GetCount: Integer;
-begin
- Result := 0;
- if FlexEdit.HandleAllocated then
- begin
- Result := SendMessage(FlexEdit.Handle, EM_GETLINECOUNT, 0, 0);
- if SendMessage(FlexEdit.Handle, EM_LINELENGTH, SendMessage(FlexEdit.Handle,
- EM_LINEINDEX, Result - 1, 0), 0) = 0 then Dec(Result);
- end;
-end;
-{=====}
-
-function TFlexEditStrings.Get(Index: Integer): string;
-var
- Text: array[0..4095] of Char;
-begin
- Word((@Text)^) := SizeOf(Text);
- SetString(Result, Text, SendMessage(FlexEdit.Handle, EM_GETLINE, Index,
- LPARAM(@Text))); //64
-end;
-{=====}
-
-procedure TFlexEditStrings.Put(Index: Integer; const S: string);
-var
- SelStart: Integer;
-begin
- SelStart := SendMessage(FlexEdit.Handle, EM_LINEINDEX, Index, 0);
- if SelStart >= 0 then
- begin
- SendMessage(FlexEdit.Handle, EM_SETSEL, SelStart, SelStart +
- SendMessage(FlexEdit.Handle, EM_LINELENGTH, SelStart, 0));
- SendMessage(FlexEdit.Handle, EM_REPLACESEL, 0, LPARAM(PChar(S))); //64
- end;
-end;
-{=====}
-
-procedure TFlexEditStrings.Insert(Index: Integer; const S: string);
-var
- SelStart, LineLen: Integer;
- Line: string;
-begin
- if Count = FCapacity then exit;
-
- if Index >= 0 then
- begin
- SelStart := SendMessage(FlexEdit.Handle, EM_LINEINDEX, Index, 0);
- if SelStart >= 0 then Line := S + #13#10 else
- begin
- SelStart := SendMessage(FlexEdit.Handle, EM_LINEINDEX, Index - 1, 0);
- if SelStart < 0 then Exit;
- LineLen := SendMessage(FlexEdit.Handle, EM_LINELENGTH, SelStart, 0);
- if LineLen = 0 then Exit;
- Inc(SelStart, LineLen);
- Line := #13#10 + s;
- end;
- SendMessage(FlexEdit.Handle, EM_SETSEL, SelStart, SelStart);
- SendMessage(FlexEdit.Handle, EM_REPLACESEL, 0, LPARAM(PChar(Line))); //64
- end;
-end;
-{=====}
-
-procedure TFlexEditStrings.Delete(Index: Integer);
-const
- Empty: PChar = '';
-var
- SelStart, SelEnd: Integer;
-begin
- SelStart := SendMessage(FlexEdit.Handle, EM_LINEINDEX, Index, 0);
- if SelStart >= 0 then
- begin
- SelEnd := SendMessage(FlexEdit.Handle, EM_LINEINDEX, Index + 1, 0);
- if SelEnd < 0 then SelEnd := SelStart +
- SendMessage(FlexEdit.Handle, EM_LINELENGTH, SelStart, 0);
- SendMessage(FlexEdit.Handle, EM_SETSEL, SelStart, SelEnd);
- SendMessage(FlexEdit.Handle, EM_REPLACESEL, 0, LPARAM(Empty)); //64
- end;
-end;
-{=====}
-
-procedure TFlexEditStrings.Clear;
-begin
- FlexEdit.Clear;
-end;
-{=====}
-
-procedure TFlexEditStrings.SetUpdateState(Updating: Boolean);
-begin
- if FlexEdit.HandleAllocated then
- begin
- SendMessage(FlexEdit.Handle, WM_SETREDRAW, Ord(not Updating), 0);
- if not Updating then
- begin // WM_SETREDRAW causes visibility side effects in memo controls
- FlexEdit.Perform(CM_SHOWINGCHANGED,0,0); // This reasserts the visibility we want
- FlexEdit.Refresh;
- end;
- end;
-end;
-{=====}
-
-function TFlexEditStrings.GetTextStr: string;
-begin
- Result := FlexEdit.Text;
-end;
-{=====}
-
-procedure TFlexEditStrings.SetCapacity(NewCapacity: Integer);
-begin
- {Sets line-limit and destructively removes any lines that exceed the limit.}
- if FCapacity <> NewCapacity then begin
- FCapacity := NewCapacity;
- while Count > FCapacity do Delete(FCapacity);
- end;
-end;
-{=====}
-
-procedure TFlexEditStrings.SetTextStr(const Value: string);
-var
- NewText: string;
-begin
- NewText := AdjustLineBreaks(Value);
- if (Length(NewText) <> FlexEdit.GetTextLen) or (NewText <> FlexEdit.Text) then
- begin
-{$IFNDEF LCL}
- if SendMessage(FlexEdit.Handle, WM_SETTEXT, 0, Longint(NewText)) = 0 then
- raise EInvalidOperation.Create(RSTooManyBytes);
- FlexEdit.Perform(CM_TEXTCHANGED, 0, 0);
-{$ELSE} //Previous SendMessage always returns 0 (error) with LCL
- FlexEdit.SetTextBuf(PAnsiChar(NewText));
-{$ENDIF}
- end;
-end;
-
-{===== TO32CustomFlexEdit ============================================}
-
-constructor TO32CustomFlexEdit.Create(AOwner : TComponent);
-begin
- FCreating := True;
-
- inherited Create(AOwner);
-
- FWordWrap := False;
- FWantReturns := False;
- FWantTabs := False;
- Width := 185;
- AutoSize := False;
-
- {create support classes}
- FCanvas := TControlCanvas.Create;
- TControlCanvas(FCanvas).Control := Self;
-
- feValid := true;
- FShowButton := False;
-{$IFDEF ButtonOkay}
- FButton := TO32FEButton.Create(Self);
- FButton.Visible := True;
- FButton.Parent := Self;
- FButton.Caption := '';
- FButton.TabStop := False;
- {$IFNDEF LCL}
- FButton.Style := bsNew;
- {$ENDIF}
-{$ENDIF}
-
- FButtonGlyph := TBitmap.Create;
-
- FBorders := TO32Borders.Create(Self);
-
- FEFColors := TOvcEfColors.Create;
-
- FStrings := TFlexEditStrings.Create;
- TFlexEditStrings(FStrings).FlexEdit := Self;
-
- FEditLines := TO32EditLines.Create;
- TO32EditLines(FEditLines).FlexEdit := self;
-
- { now set in TO32EditLines.Create:
- EditLines.MaxLines := 3;
- EditLines.DefaultLines := 1;
- EditLines.FocusedLines := 3;
- EditLines.MouseOverLines := 3;
- }
-
- FDisplayedLines := FEditLines.FDefaultLines;
- TFlexEditStrings(FStrings).Capacity := FMaxLines;
-
- FMouseInControl := false;
-
- FSaveEdit := '';
-
- Height := 80;
- AdjustHeight;
-
- Validation := TFlexEditValidatorOptions.Create(self);
- FColor := Color;
- FFontColor := Font.Color;
- FCreating := False;
-end;
-{=====}
-
-destructor TO32CustomFlexEdit.Destroy;
-begin
- {Free support classes}
-{$IFDEF ButtonOkay}
- FButton.Free;
-{$ENDIF}
- FEFColors.Free;
- FEditLines.Free;
- FStrings.Free;
- FButtonGlyph.Free;
- FCanvas.Free;
- FBorders.Free;
- FValidation.Free;
-
- inherited Destroy;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.CreateParams(var Params: TCreateParams);
-const
- Passwords: array[Boolean] of DWORD = (0, ES_PASSWORD);
- Alignments: array[Boolean, TAlignment] of DWORD =
- ((ES_LEFT, ES_RIGHT, ES_CENTER),(ES_RIGHT, ES_LEFT, ES_CENTER));
- WordWraps: array[Boolean] of DWORD = (0, ES_AUTOHSCROLL);
-begin
- inherited CreateParams(Params);
- with Params do
- begin
- { - begin}
- if MultilineEnabled then
- Style := Style and not WordWraps[FWordWrap] or ES_MULTILINE
- {$IFDEF VERSION4}
-{$IFNDEF LCL}
- or Alignments[UseRightToLeftAlignment, FAlignment]
-{$ELSE}
- or Alignments[False, FAlignment]
-{$ENDIF}
- {$ENDIF}
- or WS_CLIPCHILDREN
- else
- Style := Style and not WordWraps[FWordWrap]
- or Passwords[PasswordChar <> #0]
- {$IFDEF VERSION4}
-{$IFNDEF LCL}
- or Alignments[UseRightToLeftAlignment, FAlignment]
-{$ELSE}
- or Alignments[False, FAlignment]
-{$ENDIF}
- {$ENDIF}
- or WS_CLIPCHILDREN
- { - end}
- end;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetParent(Value: TWinControl);
-begin
- inherited;
- {$IFNDEF VERSION4}
- {$IFDEF CBuilder}
- HandleNeeded; {BCB3 needs a handle here}
- {$ENDIF}
- {$ENDIF}
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.WMGetDlgCode(var Message: TWMGetDlgCode);
-begin
- inherited;
- if FWantTabs then Message.Result := Message.Result or DLGC_WANTTAB
- else Message.Result := Message.Result and not DLGC_WANTTAB;
- if not FWantReturns then
- Message.Result := Message.Result and not DLGC_WANTALLKEYS;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.WMNCPaint(var Message: TWMNCPaint);
-var
- DC: HDC;
-begin
- if (FUpdating > 0) then exit;
-
- inherited;
-
- if Borders.Active then begin
- DC := GetWindowDC(Handle);
- FCanvas.Handle := DC;
- try
- FBorders.DrawBorders(FCanvas, Color);
- finally
- FCanvas.Handle := 0;
- ReleaseDC( Handle, DC );
- end;
- Message.Result := 0;
- end;
-end;
-{=====}
-
-{WMPaint had been completely commented out in 4.02. It is now }
-{ re introduced as follows.... }
-{ - Re-written}
-procedure TO32CustomFlexEdit.WMPaint(var Message: TWMPaint);
-begin
- { known limitation, The ancestor is overriding the font color when the }
- { control is disabled }
- if not Enabled then begin
- inherited Color := efColors.Disabled.BackColor;
- Font.Color := efColors.Disabled.TextColor;
- end else begin
- if feValid then begin
- inherited Color := FColor;
- Font.Color := FFontColor;
- end else if Validation.SoftValidation then begin
- inherited Color := EFColors.Error.BackColor;
- Font.Color := EFColors.Error.TextColor;
- end;
- end;
- inherited;
-end;
-
-{ - Not necessary }
-(*
-procedure TO32CustomFlexEdit.WMPaint(var Message: TWMPaint);
-var
- Rct: TRect;
- Str: string;
- DC: HDC;
- PS: TPaintStruct;
-begin
- if (FUpdating > 0) then exit;
-
- if ((FAlignment = taLeftJustify ) or Focused)
- and not (csPaintCopy in ControlState)
- then inherited
- else begin
- DC := Message.DC;
- if DC = 0 then DC := BeginPaint(Handle, PS);
- FCanvas.Handle := DC;
- try
- if (FAlignment = taRightJustify) then begin
- FCanvas.Font := Font;
- with FCanvas do begin
- Rct := ClientRect;
- Brush.Color := Color;
- Str := Text;
- TextRect(Rct, Rct.Right - TextWidth(Str) - 2, 2, Str);
- end;
- end;
- finally
- FCanvas.Handle := 0;
- if Message.DC = 0 then EndPaint( Handle, PS );
- end;
- end;
-end;
-{=====}
-*)
-
-procedure TO32CustomFlexEdit.OMValidate (var Message : TMessage);
-begin
- if not ValidateSelf then begin
- if Assigned(FOnValidationError) then
-// TurboPower bug: With vtUser, FValidator is nil here.
-// FOnValidationError(Self, FValidator.ErrorCode, 'Invalid input');
- FOnValidationError(Self, FValidationError, 'Invalid input'); //Fixed
- Message.Result := FValidationError;
- if (Validation.ValidationEvent = veOnChange) then begin
- Validation.BeginUpdate;
- Restore;
- Validation.EndUpdate;
- end;
- end else begin
- Message.Result := 0;
- end;
-end;
-{=====}
-
-function TO32CustomFlexEdit.ValidateSelf: Boolean;
-begin
- result := true;
- if (FUpdating > 0) then exit;
-
- case Validation.ValidationType of
-
- vtNone: begin
- {User can specify that the field be non-empty even if he is specifying no
- custom validation}
- if Validation.InputRequired and (Text = '') then
- result := false;
- exit;
- end;
-
- vtUser: begin
- if (Text = '') then begin
- if Validation.InputRequired then
- result := false
- else
- result := true;
- end; { else } //Commented out; otherwise our validation handler never
- // gets called if Text is blank - TurboPower bug?.
- if Assigned(FOnUserValidation) then
- FOnUserValidation(Self, result);
-
- if not Result then
- FValidationError := 1;
- end; {vtUser}
-
- vtValidator: begin
-
- if (text = '') then begin
- if Validation.InputRequired then begin
- {Fail Validation for an empty, required field}
- result := false;
- FValidationError := 1;
- end else begin
- {Pass validation for a non-required, empty field}
- result := true;
- FValidationError := 0;
- end;
- end
-
- else if Validation.Mask = '' then begin
- result := true;
- FValidationError := 0;
- exit;
- end
-
- else if FValidation.ValidatorClass = nil then begin
- result := false;
- raise(Exception.Create('Error: Unknown validator Class.'));
- end
-
- else begin
- FValidator := FValidation.ValidatorClass.Create(Self);
- try
- FValidator.Mask := Validation.Mask;
- FValidator.Input := Text;
-
- if Assigned(FBeforeValidation) then
- FBeforeValidation(self);
-
- result := FValidator.IsValid;
- FValidationError := FValidator.ErrorCode;
-
- if Assigned(FAfterValidation) then
- FAfterValidation(self);
-
- finally
- FValidator.Free;
- end; {try}
- end; {if}
- end; {VtValidator}
-
- end; {case}
-
-{ - begin}
- feValid := result;
- if result then
- SaveEditString
- else
- if Validation.BeepOnError then
- MessageBeep(0);
-
- { Invalidate; } { !!.04 - Commented out - Causes flicker } {!!!!}
-{ - end}
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.OMRecreateWnd(var Message : TMessage);
-begin
- if (FUpdating > 0) then exit;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.CMMouseEnter(var Message : TMessage);
-begin
- inherited;
- if Enabled and MultiLineEnabled and (not FMouseInControl)
- and (not Focused) then begin
- if FDisplayedLines <> FEditLines.FMouseOverLines then begin
- SetDisplayedLines(FEditLines.FMouseOverLines);
- AdjustHeight;
- end;
- end;
- FMouseInControl := True;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.CMMouseLeave(var Message : TMessage);
-begin
- inherited;
-{$IFDEF ButtonOkay}
- if FButton.Focused then exit;
-{$ENDIF}
- if Enabled and FMouseInControl and MultiLineEnabled then begin
- if (Focused) then begin
- if FDisplayedLines <> FEditLines.FocusedLines then
- SetDisplayedLines(FEditLines.FocusedLines);
- end else begin
- if FDisplayedLines <> FEditLines.DefaultLines then
- SetDisplayedLines(FEditLines.DefaultLines);
- end;
- AdjustHeight;
- end;
- FMouseInControl := False;
-end;
-{=====}
-
-{$IFNDEF LCL}
-procedure TO32CustomFlexEdit.CMGotFocus(var Message : TMessage);
-{$ELSE}
-procedure TO32CustomFlexEdit.CMGotFocus(var Message : TLMSetFocus);
-{$ENDIF}
-begin
- inherited;
- if Enabled and MultiLineEnabled then begin
- if FDisplayedLines <> FEditLines.FocusedLines then begin
- SetDisplayedLines(FEditLines.FocusedLines);
- AdjustHeight;
- end;
- end;
-{$IFNDEF LCL} // AutoSelect is False by default in LCL TEdit
- if AutoSelect then
- SelectAll;
-{$ENDIF}
- SaveEditString;
-end;
-{=====}
-
-{$IFNDEF LCL}
-procedure TO32CustomFlexEdit.CMLostFocus(var Message : TMessage);
-{$ELSE}
-procedure TO32CustomFlexEdit.CMLostFocus(var Message : TLMKillFocus);
-{$ENDIF}
-begin
- inherited;
- if Enabled and MultiLineEnabled then begin
- if FMouseInControl then begin
- if FDisplayedLines <> FEditLines.MouseOverLines then
- SetDisplayedLines(FEditLines.MouseOverLines);
- end else begin
- if FDisplayedLines <> FEditLines.DefaultLines then
- SetDisplayedLines(FEditLines.DefaultLines);
- end;
- AdjustHeight;
- end;
-end;
-{=====}
-
-{ - added}
-procedure TO32CustomFlexEdit.CMFontChanged(var Message: TMessage);
-begin
- inherited;
- AdjustHeight;
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetText: String;
-begin
- result := FStrings.Text;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetText(const Value: String);
-var
- buffer: String;
- i : Integer;
-begin
- buffer := Value;
-
- if buffer <> '' then begin
- if not MultiLineEnabled then
- {strip out cr and lf's}
-// for i := Length(buffer) downto 0 do <== TurboPower bug!
- for i := Length(buffer) downto 1 do
- if (buffer[i] = #13) or (buffer[i] = #10) then begin
- Delete(buffer, i, 1);
- if ((buffer[i - 1] <> ' ') and (buffer[i - 1] <> #10)
- and (buffer[i - 1] <> #13))and (buffer[i] <> ' ') then
- Insert(' ', buffer, i);
- end;
- end;
-
- FStrings.Text := buffer;
-
- SetTextBuf(PAnsiChar(buffer));
-
- if Borders.Active then Borders.RedrawControl;
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetColor: TColor;
-begin
- Result := inherited Color;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetColor( Value: TColor );
-begin
- if Color <> Value then begin
- inherited Color := Value;
- FColor := Value;
- if Borders.Active then Borders.RedrawControl;
- end;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.KeyPress(var Key: Char);
-begin
- inherited KeyPress(Key);
- if (Key = Char(VK_RETURN)) then
- if not FWantReturns then
- Key := #0
- else begin
- if TFlexEditStrings(FStrings).Count >= FMaxLines then
- Key := #0;
- end;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.CreateWnd;
-begin
- if (FUpdating > 0) then exit;
-
- inherited CreateWnd;
-
- {force button placement}
- SetBounds(Left, Top, Width, Height);
-
-{$IFDEF ButtonOkay}
- FButton.Enabled := GetButtonEnabled;
-{$ENDIF}
- AdjustHeight;
-
- if Validation <> nil then
- Validation.AttachTo(Self);
-end;
-
-{$IFNDEF LCL} //With LCL, will never be called since not in ancestor
-procedure TO32CustomFlexEdit.CreateWindowHandle(const Params: TCreateParams);
-begin
- if (FUpdating > 0) then exit;
-
- if not HandleAllocated then begin
- if (csDesigning in ComponentState) then
- inherited
- else begin
- with Params do
- WindowHandle := CreateWindowEx(ExStyle, WinClassName, '', Style,
- X, Y, Width, Height, WndParent, 0, WindowClass.HInstance,
- Param);
- SendMessage(WindowHandle, WM_SETTEXT, 0, Longint(Caption));
- end;
- end;
-end;
-{$ENDIF}
-{=====}
-
-procedure TO32CustomFlexEdit.AdjustHeight;
-var
- DC: HDC;
- SaveFont: HFont;
- I: Integer;
- SysMetrics, Metrics: TTextMetric;
- Str: String;
-begin
- if (FUpdating > 0) then exit;
-
- if FCreating then exit;
-
- DC := GetDC(0);
- GetTextMetrics(DC, SysMetrics);
- SaveFont := SelectObject(DC, Font.Handle);
- GetTextMetrics(DC, Metrics);
- SelectObject(DC, SaveFont);
- ReleaseDC(0, DC);
- if NewStyleControls then
- begin
- if Ctl3D then I := 8 else I := 6;
- I := GetSystemMetrics(SM_CYBORDER) * I;
- end else
- begin
- I := SysMetrics.tmHeight;
- if I > Metrics.tmHeight then I := Metrics.tmHeight;
- I := I div 4 + GetSystemMetrics(SM_CYBORDER) * 4;
- end;
- Height := (Metrics.tmHeight * FDisplayedLines) + I;
- if Borders.Active and not FCreating then begin
- Str := Text;
- Borders.RedrawControl;
- Text := Str;
- end;
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetButtonEnabled : Boolean;
-begin
- result := (not ReadOnly);
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetMaxLines(Value: Integer);
-var
- buffer: String;
-begin
- if Value <> FMaxLines then begin
- FMaxLines := Value;
- TFlexEditStrings(FStrings).Capacity := FMaxLines;
- buffer := FStrings.Text;
- if buffer <> '' then
- while (buffer[Length(buffer)] = #13) or (buffer[Length(buffer)] = #10) do
- Delete(buffer, Length(buffer), 1);
- FStrings.Text := buffer;
- end;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SaveEditString;
-begin
- if (Text <> FSaveEdit) then
- FSaveEdit := Text;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.DoOnChange;
-begin
- if Assigned(OnChange) then
- OnChange(Self);
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetButtonWidth : Integer;
-begin
- if FShowButton then begin
- Result := GetSystemMetrics(SM_CXHSCROLL);
- if Assigned(FButtonGlyph) and not FButtonGlyph.Empty then
- if FButtonGlyph.Width + 4 > Result then
- Result := FButtonGlyph.Width + 4;
- end else
- Result := 0;
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetButtonGlyph : TBitmap;
-begin
- if not Assigned(FButtonGlyph) then
- FButtonGlyph := TBitmap.Create;
-
- Result := FButtonGlyph
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.GlyphChanged;
-begin
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.Loaded;
-begin
- inherited Loaded;
-
-{$IFDEF ButtonOkay}
- if Assigned(FButtonGlyph) then
- FButton.Glyph.Assign(FButtonGlyph);
-{$ENDIF}
-end;
-{=====}
-
-{ - rewritten to solve the "Text disappearing at alignment change" bug. }
-procedure TO32CustomFlexEdit.SetAlignment(Value: TAlignment);
-var
- Str: string;
-begin
-{$IFDEF LCL}
- if Value <> taLeftJustify then
- Exit; {taCenter and taRightJustify not supported and crash IDE, so ignore}
-{$ENDIF}
- if FAlignment <> Value then
- begin
- Str := Text;
- FAlignment := Value;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- Text := Str;
- end;
-end;
-{=====}
-
-function TO32CustomFlexEdit.MultiLineEnabled: Boolean;
-begin
- { The control is only multi-line able if either WordWrap or WantReturns is }
- { set and Password char is not being used }
- result := (FWantReturns or FWordWrap) and (PasswordChar = #0);
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.ButtonClick;
-var
- P: TPoint;
-begin
- if (Assigned(FOnButtonClick)) then begin
- {Get the screen coordinates of the bottom-left or bottom-right corner of
- the control.}
- if PopupAnchor = paLeft then
- P := Point(Left, Top + Height)
- else
- P := Point(Left + Width, Top + Height);
-
- {Call the user defined event handler, passing the desired popup point}
- FOnButtonClick(Self, P);
- end;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.Restore;
- {-restore the previous contents of the FlexEdit}
-var
- CursorPos: Integer;
-begin
- BeginUpdate;
- CursorPos := SelStart;
- Text := FSaveEdit;
- Repaint;
- DoOnChange;
- SelStart := CursorPos;
- EndUpdate;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.BeginUpdate;
-begin
- Inc(FUpdating);
- Validation.BeginUpdate;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.EndUpdate;
-begin
- Dec(FUpdating);
- Validation.EndUpdate;
- if (FUpdating < 0) then
- FUpdating := 0;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
-var
- CHgt : Integer;
-begin
- if (FUpdating > 0) then exit;
-
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-
- if not HandleAllocated then
- Exit;
-
-{$IFDEF ButtonOkay}
- if not FShowButton then begin
- FButton.Height := 0;
- FButton.Width := 0;
- Exit;
- end;
-
- CHgt := ClientHeight;
- if BorderStyle = bsNone then begin
- FButton.Height := CHgt;
- FButton.Width := GetButtonWidth;
- FButton.Left := Width - FButton.Width;
- FButton.Top := 0;
- end else if Ctl3D then begin
- FButton.Height := CHgt;
- FButton.Width := GetButtonWidth;
- FButton.Left := Width - FButton.Width - 4;
- FButton.Top := 0;
- end else begin
- FButton.Height := CHgt - 2;
- FButton.Width := GetButtonWidth;
-{$IFNDEF ButtonNotChild}
- FButton.Left := Width - FButton.Width - 1;
- FButton.Top := 1;
-{$ELSE}
- FButton.Left := Left + Width - FButton.Width - 1;
- FButton.Top := Top + 1;
-{$ENDIF}
- end;
-{$ENDIF}
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetButtonGlyph(Value : TBitmap);
-begin
- if not Assigned(FButtonGlyph) then
- FButtonGlyph := TBitmap.Create;
-
- if not Assigned(Value) then begin
- FButtonGlyph.Free;
- FButtonGlyph := TBitmap.Create;
- end else
- FButtonGlyph.Assign(Value);
-
- GlyphChanged;
-
-{$IFDEF ButtonOkay}
- FButton.Glyph.Assign(FButtonGlyph);
-{$ENDIF}
- SetBounds(Left, Top, Width, Height);
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetShowButton(Value : Boolean);
-begin
- if Value <> FShowButton then begin
- FShowButton := Value;
- {force resize and redisplay of button}
- SetBounds(Left, Top, Width, Height);
- end;
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetBoolean: Boolean;
-begin
- result := (AnsiUpperCase(Text) = AnsiUppercase(RSTrue));
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetYesNo: Boolean;
-begin
- result := (AnsiUpperCase(Text) = AnsiUppercase(RSYes));
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetDateTime: TDateTime;
-begin
- try
- result := StrToDateTime(Text);
- except
- result := 0;
- end;
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetDouble: Double;
-begin
- try
- result := StrToFloat(Text);
- except
- result := -1;
- end;
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetExtended: Extended;
-begin
- {Note: StrToFloat returns an Extended}
- try
- result := StrToFloat(Text);
- except
- result := -1;
- end;
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetInteger: Integer;
-begin
- result := StrToIntDef(Text, -1);
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetStrings: TStrings;
-begin
- result := TStrings(FStrings);
-end;
-{=====}
-
-function TO32CustomFlexEdit.GetVariant: Variant;
-begin
- result := Text;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetBoolean(Value: Boolean);
-begin
- if Value then
- Text := 'True'
- else
- Text := 'False';
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetYesNo(Value: Boolean);
-begin
- if Value then
- Text := 'Yes'
- else
- Text := 'No';
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetDateTime(Value: TDateTime);
-begin
- Text := DateTimeToStr(Value);
-end;
-{=====}
-
-(*
-procedure TO32CustomFlexEdit.SetDataType(Value : TO32FlexEditDataType);
-begin
- { TODO : Implement }
-end;
-{=====}
-*)
-
-procedure TO32CustomFlexEdit.SetDouble(Value: Double);
-begin
- Text := FloatToStr(Value);
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetExtended(Value: Extended);
-begin
- Text := FloatToStr(Value);
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetInteger(Value: Integer);
-begin
- Text := IntToStr(Value);
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetStrings(Value: TStrings);
-begin
- FStrings.Assign(Value);
- Invalidate;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetVariant(Value: Variant);
-begin
- try
- Text := Value;
- except
- Text := '';
- end;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetDisplayedLines(Value: Integer);
-var
- buffer: String;
-begin
- if Value <> FDisplayedLines then begin
- buffer := Text;
- FDisplayedLines := Value;
- AdjustHeight;
- Text:= Buffer;
- end;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetWordWrap(Value: Boolean);
-var
- buffer: String;
-begin
- if Value <> FWordWrap then
- begin
- buffer := Text;
- FWordWrap := Value;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- Text:= buffer;
- end;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetWantReturns (Value : Boolean);
-var
- buffer: String;
-begin
- if Value <> FWantReturns then
- begin
- buffer := Text;
- FWantReturns := Value;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- Text:= buffer;
- end;
-end;
-{=====}
-
-procedure TO32CustomFlexEdit.SetWantTabs(Value : Boolean);
-var
- buffer: String;
-begin
- if Value <> FWantTabs then
- begin
- buffer := Text;
- FWantTabs := Value;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- Text:= buffer;
- end;
-end;
-
-{$IFDEF LCL}
-// Eliminates LCL "[Type1] can not have [Type2] as child" runtime message,
-// but button still doesn't work with all widgetsets. See Lazarus bug 7097.
-function TO32CustomFlexEdit.ChildClassAllowed(ChildClass: TClass): Boolean;
-begin
- Result := True;
-end;
-{$ENDIF}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/o32intdeq.pas b/Source/3rdParty/Orpheus/o32intdeq.pas
deleted file mode 100644
index 5e482e99..00000000
--- a/Source/3rdParty/Orpheus/o32intdeq.pas
+++ /dev/null
@@ -1,146 +0,0 @@
-{*********************************************************}
-{* O32INTDEQ.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 ***** *}
-
-{The following is a modified version of deque code, which was originally written
- for Algorithms Alfresco. It is copyright(c)2001 by Julian M. Bucknall and is
- used here with permission.}
-
-{$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 o32intdeq;
- {A simple deque class for Orpheus}
-
-interface
-
-uses
- Classes;
-
-type
- TO32IntDeque = class
- protected {private}
- FList : TList;
- FHead : integer;
- FTail : integer;
- procedure idGrow;
- public
- constructor Create(aCapacity : integer);
- destructor Destroy; override;
- function IsEmpty : boolean;
- procedure Enqueue(aValue: integer);
- procedure Push(aValue: integer);
- function Pop: integer;
- end;
-
-implementation
-
-uses
- SysUtils;
-
-{=== TO32IntDeque ====================================================}
-constructor TO32IntDeque.Create(aCapacity : integer);
-begin
- inherited Create;
- FList := TList.Create;
- FList.Count := aCapacity;
- {let's help out the user of the deque by putting the head and tail
- pointers in the middle: it's probably more efficient}
- FHead := aCapacity div 2;
- FTail := FHead;
-end;
-{--------}
-destructor TO32IntDeque.Destroy;
-begin
- FList.Free;
- inherited Destroy;
-end;
-{--------}
-procedure TO32IntDeque.Enqueue(aValue : integer);
-begin
- FList.List^[FTail] := pointer(aValue);
- inc(FTail);
- if (FTail = FList.Count) then
- FTail := 0;
- if (FTail = FHead) then
- idGrow;
-end;
-{--------}
-procedure TO32IntDeque.idGrow;
-var
- OldCount : integer;
- i, j : integer;
-begin
- {grow the list by 50%}
- OldCount := FList.Count;
- FList.Count := (OldCount * 3) div 2;
- {expand the data into the increased space, maintaining the deque}
- if (FHead = 0) then
- FTail := OldCount
- else begin
- j := FList.Count;
- for i := pred(OldCount) downto FHead do begin
- dec(j);
- FList.List^[j] := FList.List^[i]
- end;
- FHead := j;
- end;
-end;
-{--------}
-function TO32IntDeque.IsEmpty : boolean;
-begin
- Result := FHead = FTail;
-end;
-{--------}
-procedure TO32IntDeque.Push(aValue : integer);
-begin
- if (FHead = 0) then
- FHead := FList.Count;
- dec(FHead);
- FList.List^[FHead] := pointer(aValue);
- if (FTail = FHead) then
- idGrow;
-end;
-{--------}
-function TO32IntDeque.Pop : integer;
-begin
- if FHead = FTail then
- raise Exception.Create('Integer deque is empty: cannot pop');
- Result := integer(FList.List^[FHead]);
- inc(FHead);
- if (FHead = FList.Count) then
- FHead := 0;
-end;
-{=== TO32IntDeque - end ==============================================}
-
-end.
diff --git a/Source/3rdParty/Orpheus/o32intlst.pas b/Source/3rdParty/Orpheus/o32intlst.pas
deleted file mode 100644
index 28fffcee..00000000
--- a/Source/3rdParty/Orpheus/o32intlst.pas
+++ /dev/null
@@ -1,195 +0,0 @@
-{*********************************************************}
-{* O32INTLST.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 ***** *}
-
-//{$APPTYPE GUI}
-//{$A+,B-,C+,D+,E-,F-,G+,H+,I+,J+,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}
-//{$MINSTACKSIZE $00004000}
-//{$MAXSTACKSIZE $00100000}
-//{$IMAGEBASE $00400000}
-
-{The following is a modified version of stack code, which was originally written
- for Algorithms Alfresco. It is copyright(c)2001 by Julian M. Bucknall and is
- used here with permission.}
-
-{$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 o32intlst;
- {Integer List class for Orpheus.}
-
-interface
-
-uses
- Classes;
-
-type
- TO32IntList = class
- protected {private}
- FAllowDups : boolean;
- FCount : integer;
- FIsSorted : boolean;
- FList : TList;
- function ilGetCapacity : integer;
- function ilGetItem(aInx : integer) : integer;
- procedure ilSetCapacity(aValue : integer);
- procedure ilSetCount(aValue : integer);
- procedure ilSetIsSorted(aValue : boolean);
- procedure ilSetItem(aInx : integer; aValue : integer);
- procedure ilSort;
- public
- constructor Create;
- destructor Destroy; override;
- function Add(aItem : integer) : integer;
- procedure Clear;
- procedure Insert(aInx : Integer; aItem : Pointer);
- property AllowDups : boolean
- read FAllowDups write FAllowDups;
- property Capacity : integer
- read ilGetCapacity write ilSetCapacity;
- property Count : integer
- read FCount write ilSetCount;
- property IsSorted : boolean
- read FIsSorted write ilSetIsSorted;
- property Items[aInx : integer] : integer
- read ilGetItem write ilSetItem; default;
- end;
-
-implementation
-
-uses
- SysUtils;
-
-{===== TO32IntList ===================================================}
-constructor TO32IntList.Create;
-begin
- inherited Create;
- FList := TList.Create;
- FIsSorted := true;
- FAllowDups := false;
-end;
-{--------}
-destructor TO32IntList.Destroy;
-begin
- FList.Free;
- inherited Destroy;
-end;
-{--------}
-function TO32IntList.Add(aItem : integer) : integer;
-var
- L, R, M : integer;
-begin
- if (not IsSorted) or (Count = 0) then
- Result := FList.Add(pointer(aItem))
- else begin
- Result := -1;
- L := 0;
- R := pred(Count);
- while (L <= R) do begin
- M := (L + R) div 2;
- if (integer(FList.List^[M]) = aItem) then begin
- if AllowDups then begin
- FList.Insert(M, pointer(aItem));
- Result := M;
- end;
- Exit;
- end;
- if (integer(FList.List^[M]) < aItem) then
- L := M + 1
- else
- R := M - 1;
- end;
- FList.Insert(L, pointer(aItem));
- Result := L;
- end;
- inc(FCount);
-end;
-{--------}
-procedure TO32IntList.Clear;
-begin
- FList.Clear;
- FCount := 0;
- FIsSorted := true;
-end;
-{--------}
-function TO32IntList.ilGetCapacity : integer;
-begin
- Result := FList.Capacity;
-end;
-{--------}
-function TO32IntList.ilGetItem(aInx : integer) : integer;
-begin
- Assert((0 <= aInx) and (aInx < Count), 'Index out of bounds');
- Result := integer(FList.List^[aInx]);
-end;
-{--------}
-procedure TO32IntList.ilSetCapacity(aValue : integer);
-begin
- FList.Capacity := aValue;
-end;
-{--------}
-procedure TO32IntList.ilSetCount(aValue : integer);
-begin
- FList.Count := aValue;
- FCount := FList.Count;
-end;
-{--------}
-procedure TO32IntList.ilSetIsSorted(aValue : boolean);
-begin
- if (aValue <> FIsSorted) then begin
- FIsSOrted := aValue;
- if FIsSorted then
- ilSort;
- end;
-end;
-{--------}
-procedure TO32IntList.ilSetItem(aInx : integer; aValue : integer);
-begin
- Assert((0 <= aInx) and (aInx < Count), 'Index out of bounds');
- FList.List^[aInx] := pointer(aValue);
-end;
-{--------}
-procedure TO32IntList.ilSort;
-begin
- Assert(false, 'TO32IntList.ilSort has not been implemented yet');
-end;
-{--------}
-procedure TO32IntList.Insert(aInx : Integer; aItem : Pointer);
-begin
- FIsSorted := false;
- FList.Insert(aInx, pointer(aItem));
- inc(FCount);
-end;
-{===== TO32IntList - end =============================================}
-
-end.
diff --git a/Source/3rdParty/Orpheus/o32ovldr.pas b/Source/3rdParty/Orpheus/o32ovldr.pas
deleted file mode 100644
index 5eb2d793..00000000
--- a/Source/3rdParty/Orpheus/o32ovldr.pas
+++ /dev/null
@@ -1,365 +0,0 @@
-{*********************************************************}
-{* O32OVLDR.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 ***** *}
-
-unit o32ovldr;
- {Orpheus Mask Validator}
-
-interface
-
-uses
- Classes, O32VlDtr;
-
-const
- OrpheusMaskCount = 17;
- OrpheusMaskLength = 11;
-
- { Sample Orpheus Masks }
- OrpheusMaskLookup : array [1..OrpheusMaskCount] of string =
- ('XXXXXXXXXX any character',
- '!!!!!!!!!! any char (upper)',
- 'LLLLLLLLLL any char (lower)',
- 'xxxxxxxxxx any char (mixed)',
- 'aaaaaaaaaa alphas only',
- 'AAAAAAAAAA alphas (upper)',
- 'llllllllll alphas (lower)',
- '9999999999 0-9',
- 'iiiiiiiiii 0-9, -',
- '########## 0-9, -, .',
- 'EEEEEEEEEE 0-9, E, -, .',
- 'KKKK Hexadecimal (1F3E) Allows 0-9, A-F, uppercase Alpha characters',
- 'KK Hexadecimal (FF) Allows 0-9, A-F, uppercase Alpha characters',
- 'OOOOOOOOOO 0-7 (octal)',
- 'bbbbbbbbbb 0, 1 (binary)',
- 'B T or F (upper)',
- 'Y Y or N (upper)');
-
-
- {Validation Error Codes}
- vecNotAnyOrUpperChar = 1;
- vecNotAnyOrLowerChar = 2;
- vecNotAlphaChar = 3;
- vecNotUpperAlpha = 4;
- vecNotLowerAlpha = 5;
- vecNotDS = 6;
- vecNotDSM = 9;
- vecNotDSMP = 10;
- vecNotDSMPE = 11;
- vecNotHexadecimal = 12;
- vecNotBinary = 13;
- vecNotOctal = 14;
- vecNotTrueFalse = 15;
- vecNotYesNo = 16;
-
-type
-{class - TO32OrMaskValidator}
- TO32OrMaskValidator = class(TO32BaseValidator)
- protected {private}
- FMaskBlank: Char;
-
- procedure SetInput(const Value: string); override;
- procedure SetMask(const Value: string); override;
- function GetValid: Boolean; override;
- function GetSampleMasks: TStringList; override;
- function Validate(const Value: string; var ErrorPos: Integer): Boolean;
- public
- function IsValid: Boolean; override;
- property Valid;
- property Input;
- published
- {Properties}
- property Mask;
- {Events}
- property BeforeValidation;
- property AfterValidation;
- property OnValidationError;
- end;
-
-implementation
-
-uses
- SysUtils, OvcData, O32VlReg;
-
-
-{===== TO32OrMaskValidator ===========================================}
-
-function TO32OrMaskValidator.GetSampleMasks: TStringList;
-var
- I : Integer;
-begin
- { Set the length of the mask portion of the string }
- FSampleMaskLength := OrpheusMaskLength;
-
- FSampleMasks.Clear;
-
- { Load the string list }
- for I := 1 to OrpheusMaskCount do
- FSampleMasks.Add(OrpheusMaskLookup[I]);
- result := FSampleMasks;
-end;
-{=====}
-
-function TO32OrMaskValidator.GetValid: Boolean;
-begin
- result := IsValid;
-end;
-{=====}
-
-function TO32OrMaskValidator.IsValid: Boolean;
-var
- ErrorStr: string;
- ErrorPos: Integer;
-begin
- DoBeforeValidation;
-
- {assume the worst}
- FValid := false;
-
- {Set up validation and execute it against the input}
- FValid := Validate(FInput, ErrorPos);
-
- DoAfterValidation;
-
- if not FValid then begin
- case FErrorCode of
- vecNotAnyOrUpperChar :
- ErrorStr := 'Lowercase characters not allowed in position '
- + IntToStr(ErrorPos) + '.';
- vecNotAnyOrLowerChar :
- ErrorStr := 'Uppercase characters not allowed in position '
- + IntToStr(ErrorPos) + '.';
- vecNotAlphaChar :
- ErrorStr := 'Non-Alpha characters not allowed in position '
- + IntToStr(ErrorPos) + '.';
- vecNotUpperAlpha :
- ErrorStr := 'Non-Uppercase Alpha characters not allowed in position '
- + IntToStr(ErrorPos) + '.';
- vecNotLowerAlpha :
- ErrorStr := 'Non-Lowercase Alpha characters not allowed in position '
- + IntToStr(ErrorPos) + '.';
- vecNotDS :
- ErrorStr := 'Digits and spaces only allowed in position '
- + IntToStr(ErrorPos) + '.';
- vecNotDSM :
- ErrorStr := 'Digits, spaces and ''-'' only allowed in position '
- + IntToStr(ErrorPos) + '.';
- vecNotDSMP :
- ErrorStr := 'Digits, spaces ''-'', and ''.'' only allowed in position '
- + IntToStr(ErrorPos) + '.';
- vecNotDSMPE :
- ErrorStr := 'Digits, spaces ''-'', ''.'', and ''e/E'' only allowed '
- + 'in position ' + IntToStr(ErrorPos) + '.';
- vecNotHexadecimal :
- ErrorStr := 'Hexadecimal characters only (0-F) allowed in position '
- + IntToStr(ErrorPos) + '.';
- vecNotBinary :
- ErrorStr := 'Binary characters only (0, 1, and space) allowed in '
- + 'position ' + IntToStr(ErrorPos) + '.';
- vecNotOctal :
- ErrorStr := 'Octal characters only (0-7) allowed in position '
- + IntToStr(ErrorPos) + '.';
- vecNotTrueFalse :
- ErrorStr := 'Only True/false characters (T, t, F, f) allowed in '
- + 'position ' + IntToStr(ErrorPos) + '.';
- vecNotYesNo :
- ErrorStr := 'Only Yes/No characters (Y, y, N, n) allowed in position '
- + IntToStr(ErrorPos) + '.';
- end;
- DoOnError(self, 'Invalid match at character position ' + IntToStr(ErrorPos));
- end;
- result := FValid;
-end;
-{=====}
-
-procedure TO32OrMaskValidator.SetInput(const Value: string);
-begin
- if FInput <> Value then
- FInput := Value;
-end;
-{=====}
-
-procedure TO32OrMaskValidator.SetMask(const Value: string);
-begin
- if FMask <> Value then
- FMask := Value;
-end;
-{=====}
-
-function TO32OrMaskValidator.Validate(const Value: string;
- var ErrorPos: Integer): Boolean;
-var
- I: Integer;
-begin
- ErrorPos := 0;
- result := true;
- if Length(Input) > Length(FMask) then begin
- result := false;
- ErrorPos := Length(FMask) + 1;
- exit;
- end;
-
- for I := 1 to Length(Input) do begin
- case FMask[I] of
- {pmAnyChar : 'X' allows any character}
- { do nothing here - All entry is OK.}
-
- pmForceUpper : {'!' allows any uppercase character}
- if (ord(Input[I]) in [97..122]{lowercase characters}) then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotAnyOrUpperChar;
- exit;
- end;
-
- pmForceLower : {'L' allows any lowercase character}
- if (ord(Input[I]) in [65..90]{uppercase characters}) then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotAnyOrLowerChar;
- exit;
- end;
-
- {pmForceMixed : 'x' allows any character. Just like 'X'}
- { do nothing here - All entry is ok, no way to force mixed case without }
- { back tracking }
-
- pmAlpha : {'a' allows alphas only}
- if not (ord(Input[I]) in [65..90, 97..122]{any alpha}) then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotAlphaChar;
- exit;
- end;
-
- pmUpperAlpha : {'A' allows uppercase alphas only}
- if not (ord(Input[I]) in [65..90]{uppercase alpha}) then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotUpperAlpha;
- exit;
- end;
-
- pmLowerAlpha : {'l' allows lowercase alphas only}
- if not (ord(Input[I]) in [97..122]{lowercase alpha}) then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotLowerAlpha;
- exit;
- end;
-
- pmPositive : {'9' allows numbers and spaces only}
- if not (ord(Input[I]) in [48..57, 32]) then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotDS;
- exit;
- end;
-
- pmWhole : {'i' allows numbers, spaces, minus}
- if not (ord(Input[I]) in [48..57, 32, 45]) then
- begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotDSM;
- exit;
- end;
-
- pmDecimal : {'#' allows numbers, spaces, minus, period}
- if not (ord(Input[I]) in [48..57, 32, 45, 46])
- then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotDSMP;
- exit;
- end;
-
- pmScientific : {'E' allows numbers, spaces, minus, period, 'e'}
- if not (ord(Input[I]) in [48..57, 32, 45, 46, 101, 69])
- then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotDSMPE;
- exit;
- end;
-
- pmHexadecimal : {'K' allows 0-9 and uppercase A-F}
- if not (ord(Input[I]) in [48..57, 65..70])
- then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotHexadecimal;
- exit;
- end;
-
- pmBinary : {'b' allows 0-1, space}
- if not (ord(Input[I]) in [48, 49, 32])
- then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotBinary;
- exit;
- end;
-
- pmOctal : {'O' allows 0-7, space}
- if not (ord(Input[I]) in [48..55, 32])
- then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotOctal;
- exit;
- end;
-
- pmTrueFalse : {'B' allows T, t, F, f}
- if not (ord(Input[I]) in [84, 116, 70, 102])
- then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotTrueFalse;
- exit;
- end;
-
- pmYesNo : {'Y' allows Y, y, N, n}
- if not (ord(Input[I]) in [89, 121, 78, 110])
- then begin
- result := false;
- ErrorPos := I;
- FErrorCode := vecNotYesNo;
- exit;
- end;
- end;
- end;
-end;
-
-
-initialization
- RegisterValidator(TO32OrMaskValidator);
-
-finalization
- UnRegisterValidator(TO32OrMaskValidator);
-
-end.
-
diff --git a/Source/3rdParty/Orpheus/o32pvldr.pas b/Source/3rdParty/Orpheus/o32pvldr.pas
deleted file mode 100644
index d8c80390..00000000
--- a/Source/3rdParty/Orpheus/o32pvldr.pas
+++ /dev/null
@@ -1,319 +0,0 @@
-{*********************************************************}
-{* O32PVLDR.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} {-Defines}
-
-unit o32pvldr;
- {Paradox Mask Validator}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, MyMisc, {$ENDIF} O32Vldtr, Classes;
-
-const
- ParadoxMaskCount = 8;
- ParadoxMaskLength = 25;
-
- {Sample Paradox Masks}
- ParadoxMaskLookup : array [1..ParadoxMaskCount] of string =
- ('!\(999\)000-0000;1;_ Phone (415)555-1212',
- '!99999;1;_ Extension 15450',
- '000\-00\-0000;1;_ Social Security 555-55-5555',
- '00000;1;_ Short Zip Code 90504',
- '00000\-9999;1;_ Long Zip Code 90504-0000',
- '!99/99/00;1;_ Date 06/27/01',
- '!90:00:00>LL;1;_ Long Time 09:05:15PM',
- '!90:00;1;_ Short Time 13:45');
-
-type
-{class - TO32ParadoxValidator}
- TO32ParadoxValidator = class(TO32BaseValidator)
- protected {private}
- FMaskBlank: Char;
-
- procedure SetInput(const Value: string); override;
- procedure SetMask(const Value: string); override;
- function GetValid: Boolean; override;
- function GetSampleMasks: TStringList; override;
- function Validate(const Value: string; var Pos: Integer): Boolean;
- function DoValidateChar(NewChar: Char;
- MaskOffset: Integer): Boolean;
- function ValidateChar(NewChar: Char;
- Offset: Integer): Boolean;
- function FindLiteralChar(MaskOffset: Integer; InChar: Char): Integer;
- public
- constructor Create(AOwner: TComponent); override;
- function IsValid: Boolean; override;
- property Valid;
- property Input;
- published
- {Properties}
- property Mask;
- {Events}
- property BeforeValidation;
- property AfterValidation;
- property OnValidationError;
- end;
-
-implementation
-
-uses
- {$IFNDEF LCL} Mask, {$IFDEF VERSION6} MaskUtils, {$ENDIF} {$ELSE} MaskEdit, {$ENDIF}
- SysUtils, O32VlReg;
-
-// In the original Orpheus, TurboPower had just copied the following
-// functions from the VCL Mask unit in order to use them with Delphi 5
-// and earlier: MaskGetCharType, MaskOffsetToOffset, OffsetToMaskOffset,
-// MaskIntlLiteralToChar, and MaskGetCurrentDirectives.
-// With Delphi 6, these functions are now in MaskUtils unit and in the
-// interfaces section. However, these functions and the constants they
-// reference are not currently available with the LCL, so for now the
-// Paradox validator is not available for LCL.
-
-
-{===== TO32ParadoxValidator ==========================================}
-
-constructor TO32ParadoxValidator.Create(AOwner: TComponent);
-begin
- inherited;
- FMaskBlank := DefaultBlank;
-end;
-{=====}
-
-function TO32ParadoxValidator.GetValid: Boolean;
-begin
- result := IsValid;
-end;
-{=====}
-
-function TO32ParadoxValidator.GetSampleMasks: TStringList;
-var
- I : Integer;
-begin
- { Set the length of the mask portion of the string }
- FSampleMaskLength := ParadoxMaskLength;
-
- FSampleMasks.Clear;
-
- { Load the string list }
- for I := 1 to ParadoxMaskCount do
- FSampleMasks.Add(ParadoxMaskLookup[I]);
- result := FSampleMasks;
-end;
-{=====}
-
-function TO32ParadoxValidator.IsValid: Boolean;
-var
- ErrorPos: Integer;
-begin
- DoBeforeValidation;
-
- {assume the worst}
- FValid := false;
-
- {Set up validation and execute it against the input}
- FValid := Validate(FInput, ErrorPos);
-
- DoAfterValidation;
-
- if not FValid then begin
- DoOnError(self, 'Validation Error Encountered at string position '
- + IntToStr(ErrorPos));
- end;
-
- result := FValid;
-end;
-{=====}
-
-procedure TO32ParadoxValidator.SetInput(const Value: string);
-begin
- if FInput <> Value then
- FInput := Value;
-end;
-{=====}
-
-procedure TO32ParadoxValidator.SetMask(const Value: string);
-begin
- if FMask <> Value then
- FMask := Value;
-end;
-{=====}
-
-function TO32ParadoxValidator.Validate(const Value: string; var Pos: Integer): Boolean;
-var
- I : Integer;
-begin
- result := true;
- Pos := 0;
- for I := 1 to Length(Value) do begin
- if not ValidateChar(Value[I], I) then begin
- result := false;
- Pos := I;
- Exit;
- end;
- end;
-end;
-{=====}
-
-function TO32ParadoxValidator.ValidateChar(NewChar: Char;
- Offset: Integer): Boolean;
-var
- MaskOffset: Integer;
-begin
- Result := True;
- if FMask <> '' then
- begin
- Result := False;
- MaskOffset := OffsetToMaskOffset(FMask, Offset);
- if MaskOffset >= 0 then
- begin
- Result := DoValidateChar(NewChar, MaskOffset);
- end;
- end;
-end;
-{=====}
-
-function TO32ParadoxValidator.FindLiteralChar(MaskOffset: Integer;
- InChar: Char): Integer;
-var
- CType: TMaskCharType;
- LitChar: Char;
-begin
- Result := -1;
- while MaskOffset < Length(Mask) do
- begin
- Inc(MaskOffset);
- CType := MaskGetCharType(Mask, MaskOffset);
- if CType in [mcLiteral, mcIntlLiteral] then
- begin
- LitChar := Mask[MaskOffset];
- if CType = mcIntlLiteral then
- LitChar := MaskIntlLiteralToChar(LitChar);
- if LitChar = InChar then
- Result := MaskOffset;
- Exit;
- end;
- end;
-end;
-{=====}
-
-function TO32ParadoxValidator.DoValidateChar(NewChar: Char;
- MaskOffset: Integer): Boolean;
-var
- Dir: TMaskDirectives;
- Str: string;
- CType: TMaskCharType;
-
- function IsKatakana(const Chr: Byte): Boolean;
- begin
- Result := (SysLocale.PriLangID = LANG_JAPANESE) and (Chr in [$A1..$DF]);
- end;
-
- function TestChar(NewChar: Char): Boolean;
- var
- Offset: Integer;
- begin
- Offset := MaskOffsetToOffset(FMask, MaskOffset);
- Result := not ((MaskOffset < Length(FMask)) and
- (UpCase(FMask[MaskOffset]) = UpCase(Mask[MaskOffset+1]))) or
- (ByteType(FMask, Offset) = mbTrailByte) or
- (ByteType(FMask, Offset+1) = mbLeadByte);
- end;
-
-begin
- Result := True;
- CType := MaskGetCharType(FMask, MaskOffset);
- if not (CType in [mcLiteral, mcIntlLiteral]) then begin
- Dir := MaskGetCurrentDirectives(FMask, MaskOffset);
- case FMask[MaskOffset] of
- mMskNumeric, mMskNumericOpt:
- begin
- if not ((NewChar >= '0') and (NewChar <= '9')) then
- Result := False;
- end;
- mMskNumSymOpt:
- begin
- if not (((NewChar >= '0') and (NewChar <= '9')) or
- (NewChar = ' ') or(NewChar = '+') or(NewChar = '-')) then
- Result := False;
- end;
- mMskAscii, mMskAsciiOpt:
- begin
- if (NewChar in LeadBytes) and TestChar(NewChar) then
- begin
- Result := False;
- Exit;
- end;
- if IsCharAlpha(NewChar) then
- begin
- Str := ' ';
- Str[1] := NewChar;
- if (mdUpperCase in Dir) then
- Str := AnsiUpperCase(Str)
- else if mdLowerCase in Dir then
- Str := AnsiLowerCase(Str);
- end;
- end;
- mMskAlpha, mMskAlphaOpt, mMskAlphaNum, mMskAlphaNumOpt:
- begin
- if (NewChar in LeadBytes) then
- begin
- if TestChar(NewChar) then
- Result := False;
- Exit;
- end;
- Str := ' ';
- Str[1] := NewChar;
- if IsKatakana(Byte(NewChar)) then
- Exit;
- if not IsCharAlpha(NewChar) then
- begin
- Result := False;
- if ((FMask[MaskOffset] = mMskAlphaNum) or
- (FMask[MaskOffset] = mMskAlphaNumOpt)) and
- (IsCharAlphaNumeric(NewChar)) then
- Result := True;
- end
- else if mdUpperCase in Dir then
- Str := AnsiUpperCase(Str)
- else if mdLowerCase in Dir then
- Str := AnsiLowerCase(Str);
- end;
- end;
- end;
-end;
-
-initialization
- RegisterValidator(TO32ParadoxValidator);
-
-finalization
- UnRegisterValidator(TO32ParadoxValidator);
-
-end.
-
diff --git a/Source/3rdParty/Orpheus/o32rxngn.pas b/Source/3rdParty/Orpheus/o32rxngn.pas
deleted file mode 100644
index 464e6654..00000000
--- a/Source/3rdParty/Orpheus/o32rxngn.pas
+++ /dev/null
@@ -1,1063 +0,0 @@
-{*********************************************************}
-{* O32RXNGN.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 ***** *}
-
-{The following is a modified version of a Regex engine, which was originally
- written for Algorithms Alfresco. It is copyright(c)2001 by Julian M. Bucknall
- and is used here with permission.}
-
-{$I OVC.INC}
-
-{$B-} {Complete Boolean Evaluation}
-{$I+} {Input/Output-Checking}
-{$P+} {Open Parameters}
-{$T-} {Typed @ Operator}
-{.W-} {Windows Stack Frame}
-{$X+} {Extended Syntax}
-
-{Notes: these classes parse regular expressions that follow this grammar:
-
- ::= |
- '^' |
- '$' |
- '^' '$'
- ::= |
- '|' - alternation
- ::= |
- - concatenation
- ::= |
- '?' | - zero or one
- '*' | - zero or more
- '+' - one or more
- ::= |
- '.' | - any char
- '(' ') | - parentheses
- '[' ']' | - normal class
- '[^' ']' - negated class
- ::= |
-
- ::= |
- '-'
- ::= |
- '\'
- ::= |
- '\'
-
- This means that parentheses have maximum precedence, followed
- by square brackets, followed by the closure operators,
- followed by concatenation, finally followed by alternation.}
-
-unit o32rxngn;
- {Orpheus Regex Engine}
-
-interface
-
-uses
- Classes, SysUtils, O32IntDeq, O32IntLst;
-
-type
- PO32CharSet = ^TO32CharSet;
- TO32CharSet = set of char;
-
- TO32NFAMatchType = ( {types of matching performed...}
- mtNone, {..no match (an epsilon no-cost move)}
- mtAnyChar, {..any character}
- mtChar, {..a particular character}
- mtClass, {..a character class}
- mtNegClass, {..a negated character class}
- mtTerminal, {..the final state--no matching}
- mtUnused); {..an unused state--no matching}
-
- TO32RegexError = ( {error codes for invalid regex strings}
- recNone, {..no error}
- recSuddenEnd, {..unexpected end of string}
- recMetaChar, {..read metacharacter, but needed normal char}
- recNoCloseParen, {..expected close paren, but not there}
- recExtraChars); {..extra characters at the end of the Regex string}
-
- TO32UpcaseChar = function (aCh : char) : char;
-
- {- Regex Engine Class}
- TO32RegexEngine = class
- protected {private}
- FAnchorEnd : boolean;
- FAnchorStart : boolean;
- FErrorCode : TO32RegexError;
- FIgnoreCase : boolean;
- FPosn : PAnsiChar;
- FRegexStr : string;
- FStartState : integer;
- FTable : TList;
- FUpcase : TO32UpcaseChar;
- FLogging : Boolean;
- Log : System.Text;
- FLogFile : string;
-
- procedure SetLogFile(const Value: String);
-
- procedure rcSetIgnoreCase(aValue : boolean);
- procedure rcSetRegexStr(const aRegexStr : string);
- procedure rcSetUpcase(aValue : TO32UpcaseChar);
- procedure rcSetLogging(const aValue : Boolean);
-
- procedure rcClear;
- procedure rcLevel1Optimize;
- procedure rcLevel2Optimize;
- function rcMatchSubString(const S : string;
- StartPosn : integer) : boolean;
- function rcAddState(aMatchType : TO32NFAMatchType;
- aChar : char;
- aCharClass : PO32CharSet;
- aNextState1: integer;
- aNextState2: integer) : integer;
- function rcSetState(aState : integer;
- aNextState1: integer;
- aNextState2: integer) : integer;
-
- function rcParseAnchorExpr : integer;
- function rcParseAtom : integer;
- function rcParseCCChar : char;
- function rcParseChar : integer;
- function rcParseCharClass(aClass : PO32CharSet) : boolean;
- function rcParseCharRange(aClass : PO32CharSet) : boolean;
- function rcParseExpr : integer;
- function rcParseFactor : integer;
- function rcParseTerm : integer;
-
- procedure rcWalkNoCostTree(aList : TO32IntList;
- aState : integer);
- procedure rcDumpTable;
-
- public
- constructor Create(const aRegexStr : string);
- destructor Destroy; override;
-
- function Parse(var aErrorPos : integer;
- var aErrorCode: TO32RegexError) : boolean;
- function MatchString(const S : string) : integer;
-
- property IgnoreCase : boolean
- read FIgnoreCase write rcSetIgnoreCase;
- property RegexString : string
- read FRegexStr write rcSetRegexStr;
- property Upcase : TO32UpcaseChar
- read FUpcase write rcSetUpcase;
- property Logging : Boolean
- read FLogging write rcSetLogging;
- property LogFile : String read FLogFile write SetLogFile;
- end;
-
-implementation
-
-const
- MetaCharacters: set of char =
- ['?', '*', '+', '-', '.', '|', '(', ')', '[', ']', '^', '$'];
-
- {handy constants}
- UnusedState = -1;
- NewFinalState = -2;
- CreateNewState = -3;
- ErrorState = -4;
- MustScan = -5;
-
-type
- PO32NFAState = ^TO32NFAState;
- TO32NFAState = record
- sdNextState1: integer;
- sdNextState2: integer;
- sdNextList : TO32IntList;
- sdClass : PO32CharSet;
- sdMatchType : TO32NFAMatchType;
- sdChar : char;
- end;
-
-{===TO32RegexEngine=================================================}
-constructor TO32RegexEngine.Create(const aRegexStr : string);
-begin
- inherited Create;
- FRegexStr := aRegexStr;
- FIgnoreCase := true;
- FUpcase := System.Upcase;
- FTable := TList.Create;
- FTable.Capacity := 64;
- FLogging := false;
-end;
-{--------}
-destructor TO32RegexEngine.Destroy;
-begin
- if (FTable <> nil) then begin
- rcClear;
- FTable.Free;
- end;
- inherited Destroy;
-end;
-{--------}
-procedure TO32RegexEngine.rcSetLogging(const aValue : Boolean);
-begin
- FLogging := aValue;
-end;
-{--------}
-procedure TO32RegexEngine.SetLogFile(const Value: String);
-begin
- FLogFile := Value;
-end;
-{--------}
-function TO32RegexEngine.MatchString(const S : string) : integer;
-var
- i : integer;
- ErrorPos : integer;
- ErrorCode : TO32RegexError;
-begin
- {if the regex string hasn't been parsed yet, do so}
- if (FTable.Count = 0) then begin
- if not Parse(ErrorPos, ErrorCode) then begin
- raise Exception.Create(
- Format('The regex was invalid at position %d', [ErrorPos]));
- end;
- end;
- {now try and see if the string matches (empty strings don't)}
- Result := 0;
- if (S <> '') then
- {if the regex specified a start anchor, then we only need to check
- the string starting at the first position}
- if FAnchorStart then begin
- if rcMatchSubString(S, 1) then
- Result := 1;
- end
- {otherwise we try and match the string at every position and
- return at the first success}
- else begin
- for i := 1 to length(S) do
- if rcMatchSubString(S, i) then begin
- Result := i;
- Break;
- end;
- end;
-end;
-{--------}
-function TO32RegexEngine.Parse(var aErrorPos : integer;
- var aErrorCode: TO32RegexError)
- : boolean;
- procedure WriteError(aErrorPos : integer;
- aErrorCode: TO32RegexError);
- begin
- writeln(Log, '***parse error found at ', aErrorPos);
- case aErrorCode of
- recNone : writeln(Log, '-->no error');
- recSuddenEnd : writeln(Log, '-->unexpected end of regex');
- recMetaChar : writeln(Log, '-->found metacharacter in wrong place');
- recNoCloseParen : writeln(Log, '-->missing close paren');
- recExtraChars : writeln(Log, '-->extra chars after valid regex');
- end;
- writeln(Log, '"', FRegexStr, '"');
- writeln(Log, '^':succ(aErrorPos));
- end;
-begin
- result := false;
- if FLogging then begin
- if FLogFile = '' then FLogFile := 'Parse.log';
- System.Assign(Log, FLogFile);
- System.Rewrite(Log);
- end;
-
- try
- if FLogging then writeln(Log, 'Parsing regex: "', FRegexStr, '"');
-
- {clear the current transition table}
- rcClear;
- {empty regex strings are not allowed}
- if (FRegexStr = '') then begin
- aErrorPos := 1;
- aErrorCode := recSuddenEnd;
-
- if FLogging then WriteError(aErrorPos, aErrorCode);
- Exit;
- end;
- {parse the regex string}
- FPosn := PAnsiChar(FRegexStr);
- FStartState := rcParseAnchorExpr;
-
- {if an error occurred or we're not at the end of the regex string,
- clear the transition table, return false and the error position}
- if (FStartState = ErrorState) or (FPosn^ <> #0) then begin
- if (FStartState <> ErrorState) and (FPosn^ <> #0) then
- FErrorCode := recExtraChars;
- rcClear;
- aErrorPos := succ(FPosn - PAnsiChar(FRegexStr));
- aErrorCode := FErrorCode;
-
- if FLogging then WriteError(aErrorPos, aErrorCode);
- end
- {otherwise add a terminal state, optimize, return true}
- else begin
- rcAddState(mtTerminal, #0, nil, UnusedState, UnusedState);
- rcLevel1Optimize;
- rcLevel2Optimize;
- Result := true;
- aErrorPos := 0;
- aErrorCode := recNone;
-
- if FLogging then rcDumpTable;
- end;
- finally
- if FLogging then System.Close(Log);
- end;
-end;
-{--------}
-function TO32RegexEngine.rcAddState(aMatchType : TO32NFAMatchType;
- aChar : char;
- aCharClass : PO32CharSet;
- aNextState1: integer;
- aNextState2: integer) : integer;
-var
- StateData : PO32NFAState;
-begin
- {create the new state record}
- StateData := AllocMem(sizeof(TO32NFAState));
- {set up the fields in the state record}
- if (aNextState1 = NewFinalState) then
- StateData^.sdNextState1 := succ(FTable.Count)
- else
- StateData^.sdNextState1 := aNextState1;
- StateData^.sdNextState2 := aNextState2;
- StateData^.sdMatchType := aMatchType;
- if (aMatchType = mtChar) then
- StateData^.sdChar := aChar
- else if (aMatchType = mtClass) or (aMatchType = mtNegClass) then
- StateData^.sdClass := aCharClass;
- {add the new state}
- Result := FTable.Count;
- FTable.Add(StateData);
-end;
-{--------}
-procedure TO32RegexEngine.rcClear;
-var
- i : integer;
- StateData : PO32NFAState;
-begin
- {free all items in the state transition table}
- for i := 0 to pred(FTable.Count) do begin
- StateData := PO32NFAState(FTable.List^[i]);
- if (StateData <> nil) then begin
- with StateData^ do begin
- if (sdMatchType = mtClass) or
- (sdMatchType = mtNegClass) then
- if (sdClass <> nil) then
- FreeMem(StateData^.sdClass);
- sdNextList.Free;
- end;
- Dispose(StateData);
- end;
- end;
- {clear the state transition table}
- FTable.Clear;
- FTable.Capacity := 64;
- FAnchorStart := false;
- FAnchorEnd := false;
-end;
-{--------}
-procedure TO32RegexEngine.rcDumpTable;
-var
- i, j : integer;
-begin
- writeln(Log);
- if (FTable.Count = 0) then
- writeln(Log, 'No transition table to dump!')
- else begin
- writeln(Log, 'Transition table dump for "', FRegexStr, '"');
- if FAnchorStart then
- writeln(Log, 'anchored at start of string');
- if FAnchorEnd then
- writeln(Log, 'anchored at end of string');
- writeln(Log, 'start state: ', FStartState:3);
- for i := 0 to pred(FTable.Count) do begin
- write(Log, i:3);
- with PO32NFAState(FTable[i])^ do begin
- case sdMatchType of
- mtNone : write(Log, ' no match');
- mtAnyChar : write(Log, ' any char');
- mtChar : write(Log, ' char:', sdChar);
- mtClass : write(Log, ' class');
- mtNegClass: write(Log, ' neg class');
- mtTerminal: write(Log, '*******END');
- mtUnused : write(Log, ' --');
- else
- write(Log, ' **error**');
- end;
- if (sdNextList <> nil) then begin
- write(Log, ' next:');
- for j := 0 to pred(sdNextList.Count) do
- write(Log, ' ', sdNextList[j]);
- end
- else begin
- if (sdMatchType <> mtTerminal) and
- (sdMatchType <> mtUnused) then begin
- write(Log, ' next1: ', sdNextState1:3);
- if (sdNextState2 <> UnusedState) then
- write(Log, ' next2: ', sdNextState2:3);
- end;
- end;
- end;
- writeln(Log);
- end;
- end;
-end;
-{--------}
-procedure TO32RegexEngine.rcLevel1Optimize;
-var
- i : integer;
- Walker : PO32NFAState;
-begin
- {level 1 optimization removes all states that have only a single
- no-cost move to another state}
-
- {cycle through all the state records, except for the last one}
- for i := 0 to (FTable.Count - 2) do begin
- {get this state}
- with PO32NFAState(FTable.List^[i])^ do begin
- {walk the chain pointed to by the first next state, unlinking
- the states that are simple single no-cost moves}
- Walker := PO32NFAState(FTable.List^[sdNextState1]);
- while (Walker^.sdMatchType = mtNone) and
- (Walker^.sdNextState2 = UnusedState) do begin
- sdNextState1 := Walker^.sdNextState1;
- Walker := PO32NFAState(FTable.List^[sdNextState1]);
- end;
- {walk the chain pointed to by the first next state, unlinking
- the states that are simple single no-cost moves}
- if (sdNextState2 <> UnusedState) then begin
- Walker := PO32NFAState(FTable.List^[sdNextState2]);
- while (Walker^.sdMatchType = mtNone) and
- (Walker^.sdNextState2 = UnusedState) do begin
- sdNextState2 := Walker^.sdNextState1;
- Walker := PO32NFAState(FTable.List^[sdNextState2]);
- end;
- end;
- end;
- end;
-end;
-{--------}
-procedure TO32RegexEngine.rcLevel2Optimize;
-var
- i : integer;
-begin
- {level 2 optimization removes all no-cost moves, except for those
- from the start state, if that is a no-cost move state}
-
- {cycle through all the state records, except for the last one}
- for i := 0 to (FTable.Count - 2) do begin
- {get this state}
- with PO32NFAState(FTable.List^[i])^ do begin
- {if it's not a no-cost move state or it's the start state...}
- if (sdMatchType <> mtNone) or (i = FStartState) then begin
- {create the state list}
- sdNextList := TO32IntList.Create;
- {walk the chain pointed to by the first next state, adding
- the non-no-cost states to the list}
- rcWalkNoCostTree(sdNextList, sdNextState1);
- {if this is the start state, and it's a no-cost move state
- walk the chain pointed to by the second next state, adding
- the non-no-cost states to the list}
- if (sdMatchType = mtNone) then
- rcWalkNoCostTree(sdNextList, sdNextState2);
- end;
- end;
- end;
-
- {cycle through all the state records, except for the last one,
- marking unused ones--not strictly necessary but good for debugging}
- for i := 0 to (FTable.Count - 2) do begin
- if (i <> FStartState) then
- with PO32NFAState(FTable.List^[i])^ do begin
- if (sdMatchType = mtNone) then
- sdMatchType := mtUnused;
- end;
- end;
-end;
-{--------}
-function TO32RegexEngine.rcMatchSubString(const S : string;
- StartPosn : integer)
- : boolean;
-var
- i : integer;
- Ch : char;
- State : integer;
- Deque : TO32IntDeque;
- StrInx : integer;
-begin
- {assume we fail to match}
- Result := false;
- {create the deque}
- Deque := TO32IntDeque.Create(64);
- try
- {enqueue the special value to start scanning}
- Deque.Enqueue(MustScan);
- {enqueue the first state}
- Deque.Enqueue(FStartState);
- {prepare the string index}
- StrInx := StartPosn - 1;
- Ch := #0; //just to fool the engine
- {loop until the deque is empty or we run out of string}
- while (StrInx <= length(S)) and not Deque.IsEmpty do begin
- {pop the top state from the deque}
- State := Deque.Pop;
- {process the "must scan" state first}
- if (State = MustScan) then begin
- {if the deque is empty at this point, we might as well give up
- since there are no states left to process new characters}
- if not Deque.IsEmpty then begin
- {if we haven't run out of string, get the character, and
- enqueue the "must scan" state again}
- inc(StrInx);
- if (StrInx <= length(S)) then begin
- if IgnoreCase then
- Ch := Upcase(S[StrInx])
- else
- Ch := S[StrInx];
- Deque.Enqueue(MustScan);
- end;
- end;
- end
- {otherwise, process the state}
- else with PO32NFAState(FTable.List^[State])^ do begin
- case sdMatchType of
- mtNone :
- begin
- if (State <> FStartState) then
- Assert(false, 'no-cost states shouldn''t be seen');
- for i := 0 to pred(sdNextList.Count) do
- Deque.Push(sdNextList[i]);
- end;
- mtAnyChar :
- begin
- {for a match of any character, enqueue the next states}
- for i := 0 to pred(sdNextList.Count) do
- Deque.Enqueue(sdNextList[i]);
- end;
- mtChar :
- begin
- {for a match of a character, enqueue the next states}
- if (Ch = sdChar) then
- for i := 0 to pred(sdNextList.Count) do
- Deque.Enqueue(sdNextList[i]);
- end;
- mtClass :
- begin
- {for a match within a class, enqueue the next states}
- if (Ch in sdClass^) then
- for i := 0 to pred(sdNextList.Count) do
- Deque.Enqueue(sdNextList[i]);
- end;
- mtNegClass :
- begin
- {for a match not within a class, enqueue the next states}
- if not (Ch in sdClass^) then
- for i := 0 to pred(sdNextList.Count) do
- Deque.Enqueue(sdNextList[i]);
- end;
- mtTerminal :
- begin
- {for a terminal state, the string successfully matched
- if the regex had no end anchor, or we're at the end
- of the string}
- if (not FAnchorEnd) or (StrInx > length(S)) then begin
- Result := true;
- Exit;
- end;
- end;
- mtUnused :
- begin
- Assert(false, 'unused state ' + IntToStr(State)
- + ' shouldn''t be seen');
- end;
- end;
- end;
- end;
- {if we reach this point we've either exhausted the deque or we've
- run out of string; if the former, the substring did not match
- since there are no more states. If the latter, we need to check
- the states left on the deque to see if one is the terminating
- state; if so the string matched the regular expression defined by
- the transition table}
- while not Deque.IsEmpty do begin
- State := Deque.Pop;
- with PO32NFAState(FTable.List^[State])^ do begin
- case sdMatchType of
- mtTerminal :
- begin
- {for a terminal state, the string successfully matched
- if the regex had no end anchor, or we're at the end
- of the string}
- if (not FAnchorEnd) or (StrInx > length(S)) then begin
- Result := true;
- Exit;
- end;
- end;
- end;{case}
- end;
- end;
- finally
- Deque.Free;
- end;
-end;
-{--------}
-function TO32RegexEngine.rcParseAnchorExpr : integer;
-begin
- {check for an initial '^'}
- if (FPosn^ = '^') then begin
- FAnchorStart := true;
- inc(FPosn);
-
- if FLogging then writeln(Log, 'parsed start anchor');
-
- end;
-
- {parse an expression}
- Result := rcParseExpr;
-
- {if we were successful, check for the final '$'}
- if (Result <> ErrorState) then begin
- if (FPosn^ = '$') then begin
- FAnchorEnd := true;
- inc(FPosn);
-
- if FLogging then writeln(Log, 'parsed end anchor');
- end;
- end;
-end;
-{--------}
-function TO32RegexEngine.rcParseAtom : integer;
-var
- MatchType : TO32NFAMatchType;
- CharClass : PO32CharSet;
-begin
- case FPosn^ of
- '(' :
- begin
- {move past the open parenthesis}
- inc(FPosn);
-
- if FLogging then writeln(Log, 'parsed open paren');
-
- {parse a complete regex between the parentheses}
- Result := rcParseExpr;
- if (Result = ErrorState) then
- Exit;
- {if the current character is not a close parenthesis,
- there's an error}
- if (FPosn^ <> ')') then begin
- FErrorCode := recNoCloseParen;
- Result := ErrorState;
- Exit;
- end;
- {move past the close parenthesis}
- inc(FPosn);
-
- if FLogging then writeln(Log, 'parsed close paren');
- end;
- '[' :
- begin
- {move past the open square bracket}
- inc(FPosn);
-
- if Logging then
- writeln(Log, 'parsed open square bracket (start of class)');
-
- {if the first character in the class is a '^' then the
- class if negated, otherwise it's a normal one}
- if (FPosn^ = '^') then begin
- inc(FPosn);
- MatchType := mtNegClass;
-
- if FLogging then writeln(Log, 'it is a negated class');
- end
- else begin
- MatchType := mtClass;
-
- if FLogging then writeln(Log, 'it is a normal class');
- end;
- {allocate the class character set and parse the character
- class; this will return either with an error, or when the
- closing square bracket is encountered}
- New(CharClass);
- CharClass^ := [];
- if not rcParseCharClass(CharClass) then begin
- Dispose(CharClass);
- Result := ErrorState;
- Exit;
- end;
- {move past the closing square bracket}
- Assert(FPosn^ = ']',
- 'the rcParseCharClass terminated without finding a "]"');
- inc(FPosn);
-
- if Logging then
- writeln(Log, 'parsed close square bracket (end of class)');
-
- {add a new state for the character class}
- Result := rcAddState(MatchType, #0, CharClass,
- NewFinalState, UnusedState);
- end;
- '.' :
- begin
- {move past the period metacharacter}
- inc(FPosn);
-
- if FLogging then writeln(Log, 'parsed anychar operator "."');
-
- {add a new state for the 'any character' token}
- Result := rcAddState(mtAnyChar, #0, nil,
- NewFinalState, UnusedState);
- end;
- else
- {otherwise parse a single character}
- Result := rcParseChar;
- end;{case}
-end;
-{--------}
-function TO32RegexEngine.rcParseCCChar : char;
-begin
- {if we hit the end of the string, it's an error}
- if (FPosn^ = #0) then begin
- FErrorCode := recSuddenEnd;
- Result := #0;
- Exit;
- end;
- {if the current char is a metacharacter (at least in terms of a
- character class), it's an error}
- if FPosn^ in [']', '-'] then begin
- FErrorCode := recMetaChar;
- Result := #0;
- Exit;
- end;
- {otherwise return the character and advance past it}
- if (FPosn^ = '\') then
- {..it's an escaped character: get the next character instead}
- inc(FPosn);
- Result := FPosn^;
- inc(FPosn);
-
- if FLogging then writeln(Log, 'parsed charclass char: "', Result, '"');
-
-end;
-{--------}
-function TO32RegexEngine.rcParseChar : integer;
-var
- Ch : char;
-begin
- {if we hit the end of the string, it's an error}
- if (FPosn^ = #0) then begin
- Result := ErrorState;
- FErrorCode := recSuddenEnd;
- Exit;
- end;
- {if the current char is one of the metacharacters, it's an error}
- if FPosn^ in MetaCharacters then begin
- Result := ErrorState;
- FErrorCode := recMetaChar;
- Exit;
- end;
- {otherwise add a state for the character}
- {..if it's an escaped character: get the next character instead}
- if (FPosn^ = '\') then
- inc(FPosn);
- if IgnoreCase then
- Ch := Upcase(FPosn^)
- else
- Ch := FPosn^;
- Result := rcAddState(mtChar, Ch, nil, NewFinalState, UnusedState);
- inc(FPosn);
-
- if FLogging then writeln(Log, 'parsed char: "', Ch, '"');
-end;
-{--------}
-function TO32RegexEngine.rcParseCharClass(aClass : PO32CharSet) : boolean;
-begin
- {assume we can't parse a character class properly}
- Result := false;
- {parse a character range; if we can't there was an error and the
- caller will take care of it}
- if not rcParseCharRange(aClass) then
- Exit;
- {if the current character was not the right bracket, parse another
- character class (note: we're removing the tail recursion here)}
- while (FPosn^ <> ']') do begin
- if not rcParseCharRange(aClass) then
- Exit;
- end;
- {if we reach here we were successful}
- Result := true;
-end;
-{--------}
-function TO32RegexEngine.rcParseCharRange(aClass : PO32CharSet) : boolean;
-var
- StartChar : char;
- EndChar : char;
- Ch : char;
-begin
- {assume we can't parse a character range properly}
- Result := false;
- {parse a single character; if it's null there was an error}
- StartChar := rcParseCCChar;
- if (StartChar = #0) then
- Exit;
- {if the current character is not a dash, the range consisted of a
- single character}
- if (FPosn^ <> '-') then begin
- if IgnoreCase then
- Include(aClass^, Upcase(StartChar))
- else
- Include(aClass^, StartChar)
- end
- {otherwise it's a real range, so get the character at the end of the
- range; if that's null, there was an error}
- else begin
-
- if FLogging then writeln(Log, '-range to-');
-
- inc(FPosn); {move past the '-'}
- EndChar := rcParseCCChar;
- if (EndChar = #0) then
- Exit;
- {build the range as a character set}
- if (StartChar > EndChar) then begin
- Ch := StartChar;
- StartChar := EndChar;
- EndChar := Ch;
- end;
- for Ch := StartChar to EndChar do begin
- Include(aClass^, Ch);
- if IgnoreCase then
- Include(aClass^, Upcase(Ch));
- end;
- end;
- {if we reach here we were successful}
- Result := true;
-end;
-{--------}
-function TO32RegexEngine.rcParseExpr : integer;
-var
- StartState1 : integer;
- StartState2 : integer;
- EndState1 : integer;
- OverallStartState : integer;
-begin
- {assume the worst}
- Result := ErrorState;
- {parse an initial term}
- StartState1 := rcParseTerm;
- if (StartState1 = ErrorState) then
- Exit;
- {if the current character is *not* a pipe character, no alternation
- is present so return the start state of the initial term as our
- start state}
- if (FPosn^ <> '|') then
- Result := StartState1
- {otherwise, we need to parse another expr and join the two together
- in the transition table}
- else begin
-
- if FLogging then writeln(Log, 'OR (alternation)');
-
- {advance past the pipe}
- inc(FPosn);
- {the initial term's end state does not exist yet (although there
- is a state in the term that points to it), so create it}
- EndState1 := rcAddState(mtNone, #0, nil, UnusedState, UnusedState);
- {for the OR construction we need a new initial state: it will
- point to the initial term and the second just-about-to-be-parsed
- expr}
- OverallStartState := rcAddState(mtNone, #0, nil,
- UnusedState, UnusedState);
- {parse another expr}
- StartState2 := rcParseExpr;
- if (StartState2 = ErrorState) then
- Exit;
- {alter the state state for the overall expr so that the second
- link points to the start of the second expr}
- Result := rcSetState(OverallStartState, StartState1, StartState2);
- {now set the end state for the initial term to point to the final
- end state for the second expr and the overall expr}
- rcSetState(EndState1, FTable.Count, UnusedState);
- end;
-end;
-{--------}
-function TO32RegexEngine.rcParseFactor : integer;
-var
- StartStateAtom : integer;
- EndStateAtom : integer;
-begin
- {assume the worst}
- Result := ErrorState;
- {first parse an atom}
- StartStateAtom := rcParseAtom;
- if (StartStateAtom = ErrorState) then
- Exit;
- {check for a closure operator}
- case FPosn^ of
- '?' : begin
- if FLogging then writeln(Log, 'zero or one closure');
-
- {move past the ? operator}
- inc(FPosn);
- {the atom's end state doesn't exist yet, so create one}
- EndStateAtom := rcAddState(mtNone, #0, nil,
- UnusedState, UnusedState);
- {create a new start state for the overall regex}
- Result := rcAddState(mtNone, #0, nil,
- StartStateAtom, EndStateAtom);
- {make sure the new end state points to the next unused
- state}
- rcSetState(EndStateAtom, FTable.Count, UnusedState);
- end;
- '*' : begin
- if FLogging then writeln(Log, 'zero or more closure');
-
- {move past the * operator}
- inc(FPosn);
- {the atom's end state doesn't exist yet, so create one;
- it'll be the start of the overall regex subexpression}
- Result := rcAddState(mtNone, #0, nil,
- NewFinalState, StartStateAtom);
- end;
- '+' : begin
- if FLogging then writeln(Log, 'one or more closure');
-
- {move past the + operator}
- inc(FPosn);
- {the atom's end state doesn't exist yet, so create one}
- rcAddState(mtNone, #0, nil, NewFinalState, StartStateAtom);
- {the start of the overall regex subexpression will be the
- atom's start state}
- Result := StartStateAtom;
- end;
- else
- Result := StartStateAtom;
- end;{case}
-end;
-{--------}
-function TO32RegexEngine.rcParseTerm : integer;
-var
- StartState2 : integer;
- EndState1 : integer;
-begin
- {parse an initial factor, the state number returned will also be our
- return state number}
- Result := rcParseFactor;
- if (Result = ErrorState) then
- Exit;
- {Note: we have to "break the grammar" here. We've parsed a regular
- subexpression and we're possibly following on with another
- regular subexpression. There's no nice operator to key off
- for concatenation: we just have to know that for
- concatenating two subexpressions, the current character will
- be
- - an open parenthesis
- - an open square bracket
- - an any char operator
- - a character that's not a metacharacter
- i.e., the three possibilities for the start of an "atom" in
- our grammar}
- if (FPosn^ = '(') or
- (FPosn^ = '[') or
- (FPosn^ = '.') or
- ((FPosn^ <> #0) and not (FPosn^ in MetaCharacters)) then begin
- if FLogging then writeln(Log, 'concatenation');
-
- {the initial factor's end state does not exist yet (although there
- is a state in the term that points to it), so create it}
- EndState1 := rcAddState(mtNone, #0, nil, UnusedState, UnusedState);
- {parse another term}
- StartState2 := rcParseTerm;
- if (StartState2 = ErrorState) then begin
- Result := ErrorState;
- Exit;
- end;
- {join the first factor to the second term}
- rcSetState(EndState1, StartState2, UnusedState);
- end;
-end;
-{--------}
-procedure TO32RegexEngine.rcSetIgnoreCase(aValue : boolean);
-begin
- if (aValue <> FIgnoreCase) then begin
- rcClear;
- FIgnoreCase := aValue;
- end;
-end;
-{--------}
-procedure TO32RegexEngine.rcSetRegexStr(const aRegexStr : string);
-begin
- if (aRegexStr <> FRegexStr) then begin
- rcClear;
- FRegexStr := aRegexStr;
- end;
-end;
-{--------}
-function TO32RegexEngine.rcSetState(aState : integer;
- aNextState1: integer;
- aNextState2: integer) : integer;
-var
- StateData : PO32NFAState;
-begin
- Assert((0 <= aState) and (aState < FTable.Count),
- 'trying to change an invalid state');
-
- {get the state record and change the transition information}
- StateData := PO32NFAState(FTable.List^[aState]);
- StateData^.sdNextState1 := aNextState1;
- StateData^.sdNextState2 := aNextState2;
- Result := aState;
-end;
-{--------}
-procedure TO32RegexEngine.rcSetUpcase(aValue : TO32UpcaseChar);
-begin
- if not Assigned(aValue) then
- FUpcase := System.Upcase
- else
- FUpcase := aValue;
-end;
-{--------}
-procedure TO32RegexEngine.rcWalkNoCostTree(aList : TO32IntList;
- aState : integer);
-begin
- {look at this state's record...}
- with PO32NFAState(FTable.List^[aState])^ do begin
- {if it's a no-cost state, recursively walk the
- first, then the second chain}
- if (sdMatchType = mtNone) then begin
- rcWalkNoCostTree(aList, sdNextState1);
- rcWalkNoCostTree(aList, sdNextState2);
- end
- {otherwise, add it to the list}
- else
- aList.Add(aState);
- end;
-end;
-{----}
-
-end.
diff --git a/Source/3rdParty/Orpheus/o32rxvld.pas b/Source/3rdParty/Orpheus/o32rxvld.pas
deleted file mode 100644
index 4d8a4d3b..00000000
--- a/Source/3rdParty/Orpheus/o32rxvld.pas
+++ /dev/null
@@ -1,294 +0,0 @@
-{*********************************************************}
-{* O32RXVLD.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 o32rxvld;
- {Unit for the Orpheus RegEx Validator}
-
-interface
-
-uses Classes, O32Vldtr, O32RxNgn, SysUtils;
-
-const
- RXMaskCount = 13;
- RXMaskLength = 80;
-
- {Sample Regular Expressions for the Regex validator Property editor...}
- RXMaskLookup : array [1..RXMaskCount] of string =
- ('.+ 1 or more of any characters allowed. Minimum of 1 character required. Note: This is the default behavior. No expression is needed.',
- '.* Any number of any character allowed. Note: Although This expression allows an empty string, The RegexEngine will fail an empty string.',
- '(1[012]|[1-9]):[0-5][0-9] (am|pm) Time of day: Standard AM/PM time display (9:17 am) or (12:30 pm)',
- '(1[012]|[1-9]):[0-5][0-9]:[0-5][0-9] (am|pm) Time of day: Standard AM/PM time diplay with seconds. (9:17:22 am)',
- '(([01]?[0-9])|(2[0-3])):[0-5][0-9] Time of day: 24 hour clock (15:22).',
- '(([01]?[0-9])|(2[0-3])):[0-5][0-9]:[0-5][0-9] Time of day: 24 hour clock with seconds (15:22:07).',
- '(\(?[1-9][0-9][0-9]\)? )?[1-9][0-9][0-9]\-[0-9][0-9][0-9][0-9] Telephone Number: Optional area-code with optional parenthesis',
- '(0?[1-9]|1[012])(\\|/|\-)([012]?[1-9]|[123]0|31)(\\|/|\-)([123][0-9])?[0-9][0-9] Date: (mm\dd\yy) or (mm\dd\yyyy) formats. Also accepts / and - separators. Note: Only covers years from 1000-3999',
- '(y(es)?)|(no?) Boolean: Y, y, N, n, Yes, yes, No or no',
- '(t(rue)?)|(f(alse)?) Boolean: T, t, F, f, True, False, true or false',
- '([0-9]|[A-F])+ Hexadecimal: Allows any number of characters in the range 0-9 and A-F',
- '[0-7]+ Octal: Allows any number of characters in the range 0-7.',
- '[01]+ Binary:Allows any number of binary characters (0 and 1).');
-
- {Error Codes}
- EC_NO_ERROR = 0;
- EC_INVALID_EXPR = 1;
- EC_INVALID_INPUT = 2;
- EC_NO_MATCH = 3;
-
-type
-{class - TO32RegExValidator}
- TO32RegExValidator = class(TO32BaseValidator)
- protected {private}
- FLogging : Boolean; {Log validator parsing?}
- FLogFile : String; {Logging file name}
- FRegexEngine : TO32RegExEngine; {Regex engine used by the validator}
- FExprErrorPos : Integer; {Error position in the Regex string}
- FExprErrorCode : TO32RegexError; {Regex string error code}
- FIgnoreCase : Boolean; {Case sensitive matching}
- procedure SetIgnoreCase(const Value: Boolean);
- procedure SetLogging(const Value: Boolean);
- procedure SetLogFile(const Value: String);
- procedure SetMask(const Value: String); override;
- function GetValid: Boolean; override;
- function GetSampleMasks: TStringList; override;
- procedure SetInput(const Value: string); override;
- function CheckExpression(var ErrorPos: Integer): Boolean;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- function IsValid: Boolean; override;
- function GetExprError: String;
- property Valid;
- property ExprErrorPos: Integer read FExprErrorPos write FExprErrorPos;
- published
- property Input;
- { Surfaced the Mask property as "Expression" for the Regex validator
- Left Mask exposed as public for automated use such as the ValidatorPool}
- property Expression: string read FMask write SetMask stored true;
- property Logging: Boolean read FLogging write SetLogging
- default False;
- property LogFile: String read FLogFile write SetLogFile;
- property IgnoreCase: Boolean read FIgnoreCase write SetIgnoreCase stored true
- default True;
- {Events}
- property BeforeValidation;
- property AfterValidation;
- property OnValidationError;
- end;
-
-implementation
-
-uses
- O32VlReg;
-
-{=== TO32RegExValidator ==============================================}
-constructor TO32RegExValidator.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
-
- FLogging := false;
- FLogFile := 'parse.log';
- FIgnoreCase := true;
-
- FRegexEngine := TO32RegExEngine.Create('');
- FRegexEngine.Logging := FLogging;
- FRegexEngine.LogFile := FLogFile;
- FRegexEngine.IgnoreCase := FIgnoreCase;
-end;
-{=====}
-
-destructor TO32RegExValidator.Destroy;
-begin
- FRegexEngine.Free;
- inherited Destroy;
-end;
-{=====}
-
-function TO32RegExValidator.GetSampleMasks: TStringList;
-var
- I : Integer;
-begin
- { Set the length of the mask portion of the string }
- FSampleMaskLength := RXMaskLength;
-
- FSampleMasks.Clear;
-
- { Load the string list }
- for I := 1 to RXMaskCount do
- FSampleMasks.Add(RXMaskLookup[I]);
- result := FSampleMasks;
-end;
-{=====}
-
-procedure TO32RegExValidator.SetMask(const Value: String);
-var
- OldExpression: String;
-begin
- OldExpression := FMask;
- FMask := Value;
- if not CheckExpression(FExprErrorPos) then
- FMask := OldExpression;
-end;
-{=====}
-
-procedure TO32RegExValidator.SetInput(const Value: string);
-begin
- if FInput <> Value then
- FInput := Value;
-end;
-{=====}
-
-function TO32RegExValidator.CheckExpression(var ErrorPos: Integer): Boolean;
-begin
- if (FMask <> '') then begin
- FRegexEngine.RegexString := FMask;
- if not FRegexEngine.Parse(FExprErrorPos, FExprErrorCode) then begin
- result := false;
- FErrorCode := EC_INVALID_EXPR;
- DoOnError(self, GetExprError);
- end else
- result := true;
- end else begin
- {Allow the user to initialize the Validator with an empty string}
- result := true;
- ErrorPos := 0;
- FExprErrorPos := 0;
- FErrorCode := EC_NO_ERROR;
- FExprErrorCode := recNone;
- end;
-end;
-{=====}
-
-function TO32RegExValidator.GetValid: Boolean;
-begin
- result := IsValid;
-end;
-{=====}
-
-function TO32RegExValidator.IsValid: Boolean;
-var
- RegExStr: String;
-begin
- DoBeforeValidation;
-
- {assume the worst}
- FValid := false;
-
- {Create a copy of the Expression and then enclose it in anchor operators so
- that the RegexEngine only matches the whole string...}
- RegExStr := FMask;
- {Check for Anchor operator ^}
- if (Pos('^', RegExStr) <> 1) then
- Insert('^', RegExStr, 1);
- {Check for Anchor operator $}
- if (Pos('$', RegExStr) <> Length(RegExStr)) then
- RegexStr := RegExStr + '$';
-
- {Pass the RegexStr into the RegexEngine}
- FRegexEngine.RegexString := RegExStr;
-
- if (RegExStr = '') then begin
- FErrorCode := EC_INVALID_EXPR;
- FValid := false;
- end else if (FInput = '') then begin
- FErrorCode := EC_INVALID_INPUT;
- FValid := false;
- end else begin
- if (FRegexEngine.MatchString(FInput) = 1) then begin
- FValid := true;
- FErrorCode := 0;
- end else begin
- FValid := false;
- FErrorCode := EC_NO_MATCH;
- end;
- end;
-
- result := FValid;
-
- DoAfterValidation
-end;
-{=====}
-
-procedure TO32RegExValidator.SetLogging(const Value: Boolean);
-begin
- if (FLogging <> Value) then begin
- FLogging := Value;
- FRegexEngine.Logging := FLogging;
- end;
-end;
-{=====}
-
-procedure TO32RegExValidator.SetIgnoreCase(const Value: Boolean);
-begin
- if (FIgnoreCase <> Value) then begin
- FIgnoreCase := Value;
- FRegexEngine.IgnoreCase := FIgnoreCase;
- end;
-end;
-{=====}
-
-procedure TO32RegExValidator.SetLogFile(const Value: String);
-begin
- if (FLogFile <> Value) then begin
- FLogFile := Value;
- FRegexEngine.LogFile := FLogFile;
- end;
-end;
-{=====}
-
-function TO32RegExValidator.GetExprError: String;
-begin
- case FExprErrorCode of
- recNone : result := '';
- recSuddenEnd : result := 'Incomplete Expression';
- recMetaChar : result := 'Read a metacharacter where there should have'
- + ' been a normal character';
- recNoCloseParen : result := 'Missing closing parenthesis';
- recExtraChars : result := 'Unrecognizable text at the end of the'
- + ' expression';
- end;
-end;
-{=====}
-
-initialization
-
- RegisterValidator(TO32RegexValidator);
-
-finalization
-
- UnRegisterValidator(TO32RegexValidator);
-
-end.
diff --git a/Source/3rdParty/Orpheus/o32sr.inc b/Source/3rdParty/Orpheus/o32sr.inc
deleted file mode 100644
index ea084952..00000000
--- a/Source/3rdParty/Orpheus/o32sr.inc
+++ /dev/null
@@ -1,253 +0,0 @@
-{*********************************************************}
-{* O32SR.INC *}
-{*********************************************************}
-
-{* ***** 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 ***** *}
-
-{Orhpheus String Resources - To create language specific versions of Orpheus
- controls, translate these strings to the desired language and re-compile.}
-
-resourcestring
- RSNoneStr = '(None)';
- RSccUser = 'ccUser';
- RSccUserNum = 'ccUser%d';
- RSDeleteTable = 'Delete the %s table?';
- RSRenameTable = 'Rename Table';
- RSEnterTableName = 'Enter new table name for %s:';
- RSNewTable = 'NewTable';
- RSDefaultTableName = 'Default';
- RSWordStarTableName = 'WordStar';
- RSGridTableName = 'Grid';
- RSUnknownTable = '(Unknown)';
- RSDefaultEntryErrorText = 'Entry Error';
- RSGotItemWarning = '%d. *** Warning *** OnGetItem not assigned!';
- RSSampleListItem = '%d. - Sample virtual list box item';
- RSAlphaString = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
- RSTallLowChars = 'Wy';
- RSDefault = 'Default';
- RSYes = 'Y';
- RSNo = 'N';
- RSTrue = 'T';
- RSFalse = 'F';
- RSDescending = ' - Desc';
- RSDefaultIndex = '(Default)';
- RSDuplicateCommand = 'Duplicate command found while adding a new command to the table';
- RSTableNotFound = 'Command table not found or command table index out of range';
- RSNotDoneYet = 'This feature is not implemented at this time';
- RSNoControllerAssigned = 'No Controller assigned';
- RSCantCreateCommandTable = 'Unable to create command table';
- RSCantDelete = 'Can''t delete this table. Must have at least one command table defined';
- RSInvalidKeySequence = 'Invalid or no key sequence entered';
- RSNotWordStarCommands = 'Keys entered are not WordStar style commands';
- RSNoCommandSelected = 'No command selected';
- RSDuplicateKeySequence = 'Duplicate key sequence';
- RSRangeError = 'Value is not within required range';
- RSInvalidNumber = 'Value is not valid for this field type';
- RSRequiredField = 'A value is required in this field';
- RSInvalidDate = 'Value is not a valid date';
- RSInvalidTime = 'Value is not a valid time';
- RSBlanksInField = 'This field should contain no blanks';
- RSPartialEntry = 'This field should be either empty or completely full';
- RSRegionTooLarge = 'Region is too large (> 64K)';
- RSOutOfMemoryForCopy = 'Could not allocate memory for clipboard copy';
- RSInvalidParamValue = 'Parameter value is invalid';
- RSNoTimersAvail = 'No Window''s timers are available';
- RSTooManyEvents = 'Too many trigger events';
- RSBadTriggerHandle = 'Invalid trigger handle';
- RSOnSelectNotAssigned = 'OnSelect event is not assigned';
- RSInvalidPageIndex = 'Invalid page index value';
- RSInvalidDataType = 'Invalid data type for this field';
- RSInvalidTabFont = 'Invalid font. Non toTop oriented tabs require a True-Type font';
- RSInvalidLabelFont = 'Invalid font. Rotated text requires a True-Type font';
- RSOutOfMemory = 'insufficient memory for requested operation';
- RSTooManyParas = 'Current operation will exceed the maximum number of allowed paragraphs';
- RSCannotJoin = 'Cannot join paragraphs. New paragraph size exceeds maximum paragraph size';
- RSTooManyBytes = 'Current operation will exceed the maximum text size';
- RSParaTooLong = 'Current operation will exceed the maximum paragraph size';
- RSUnknownError = 'Unknown Error condition';
- RSInvalidPictureMask = 'Invalid picture mask: %s';
- RSInvalidRange = 'Invalid range. Enter a value between (%d) and (%d)';
- RSInvalidRealRange = 'Invalid range. Enter a value between (-1.7e+38) and (+1.7e+38)';
- RSInvalidExtendedRange = 'Invalid range. Enter a value between (-1.1e+4932) and (+1.1e+4932)';
- RSInvalidDoubleRange = 'Invalid range. Enter a value between (-1.7e+308) and (+1.7e+308)';
- RSInvalidSingleRange = 'Invalid range. Enter a value between (-3.4e+38) and (+3.4e+38)';
- RSInvalidCompRange = 'Invalid range. Enter a value between (-9.2e+18) and (+9.2e+18)';
- RSInvalidDateRange = 'Invalid date range. Enter a value using ''%s'' as the format';
- RSInvalidTimeRange = 'Invalid time range. Enter a value using ''%s'' as the format';
- RSInvalidRangeValue = 'Invalid range value';
- RSInvalidMinMaxValue = 'Invalid value - Maximum must always be greater than Minimum';
- RSRangeNotSupported = 'Range limits for the currently selected data type are not supported';
- RSInvalidLineOrParaIndex = 'Invalid line or paragraph index';
- RSNonFixedFont = 'Invalid font assignment. Font must be a fixed font';
- RSInvalidFontParam = 'Invalid font assignemnt. Font must be a TFont or TOvcFixedFont';
- RSInvalidLineOrColumn = 'Invalid line or column';
- RSSAEGeneral = 'Unknown sparse array error';
- RSSAEAtMaxSize = 'Sparse array is at the maximum size';
- RSInvalidXMLFile = 'Invalid XMLStore File Format';
- RSUnterminatedElement = 'Improperly terminated element';
- RSBadColorConstant = 'Invalid color constant';
- RSBadColorValue = 'Invalid color value';
- RSSAEOutOfBounds = 'Index is out of bounds for sparse array';
- RSInvalidFieldType = 'Requested field type is not supported';
- RSBadAlarmHandle = 'Invalid alarm handle';
- RSOnIsSelectedNotAssigned = 'OnIsSelected event is not assigned';
- RSInvalidDateForMask = 'Invalid date value for picture mask. (Year is outside the Epoch range)';
- RSViewerIOError = 'Viewer triggered I/O error %d';
- RSViewerFileNotFound = 'Viewer: file not found';
- RSViewerPathNotFound = 'Viewer: path not found or invalid file name';
- RSViewerTooManyOpenFiles = 'Viewer: too many open files';
- RSViewerFileAccessDenied = 'Viewer: file access denied';
- RSControlAttached = 'This control is already attached to %s';
- RSCantEdit = 'Could not enter edit mode';
- RSChildTableError = 'Data Source can not be a child table. Component %s has a MasterSource defined';
- RSNoTableAttached = 'DataSource must be attached to a TTable (or compatible) source';
- RSNoCollection = 'No collection exists in the owner component';
- RSNotOvcDescendant = 'Owner must be a TOvcComponent or TOvcCustomComponent descendant';
- RSItemIncompatible = 'Item incompatible with collection';
- RSLabelNotAttached = 'Label not attached';
- RSClassNotSet = 'Item class not set';
- RSCollectionNotFound = 'No collection found for this type';
- RSDayConvertError = 'Error converting day';
- RSMonthConvertError = 'Error converting month';
- RSMonthNameConvertError = 'Error converting month name';
- RSYearConvertError = 'Error converting year';
- RSInvalidDay = 'Invalid day';
- RSInvalidMonth = 'Invalid month';
- RSInvalidMonthName = 'Invalid month name';
- RSInvalidYear = 'Invalid year';
- RSDayRequired = 'Day is required';
- RSMonthRequired = 'Month is required';
- RSYearRequired = 'Year is required';
- RSOwnerMustBeForm = 'Owner must be a TForm or descendant';
- RSTimeConvertError = 'Error converting time value';
- RSCancelQuery = 'Cancel and lose changes?';
- RSNoPagesAssigned = 'No notebook pages assigned';
- RSRestoreMI = '&Restore';
- RSCutMI = 'Cu&t';
- RSCopyMI = '&Copy';
- RSPasteMI = '&Paste';
- RSDeleteMI = '&Delete';
- RSSelectAllMI = 'Select &All';
- RSTableRowOutOfBounds = 'Table row out of bounds';
- RSTableMaxRows = 'Table max rows error';
- RSTableMaxColumns = 'Table max columns error';
- RSTableGeneral = 'Table general error';
- RSTableToManyColumns = 'Too many columns';
- RSTableInvalidFieldIndex = 'Invalid field index';
- RSTableHeaderNotAssigned = 'Header not assigned';
- RSTableInvalidHeaderCell = 'Invalid header cell';
- RSCalcBack = 'Back';
- RSCalcMC = 'MC';
- RSCalcMR = 'MR';
- RSCalcMS = 'MS';
- RSCalcMPlus = 'M+';
- RSCalcMMinus = 'M-';
- RSCalcCT = 'CT';
- RSCalcCE = 'CE';
- RSCalcC = 'C';
- RSCalcSqrt = 'Sqrt';
- RSCalNext = 'NEXT';
- RSCalLast = 'LAST';
- RSCalPrev = 'PREV';
- RSCalFirst = 'FIRST';
- RSCal1st = '1ST';
- RSCalSecond = 'SECOND';
- RSCal2nd = '2ND';
- RSCalThird = 'THIRD';
- RSCal3rd = '3RD';
- RSCalFourth = 'FOURTH';
- RSCal4th = '4TH';
- RSCalFinal = 'FINAL';
- RSCalBOM = 'BOM';
- RSCalBegin = 'BEGIN';
- RSCalEOM = 'EOM';
- RSCalEnd = 'END';
- RSCalYesterday = 'YESTERDAY';
- RSCalToday = 'TODAY';
- RSCalTomorrow = 'TOMORROW';
- RSEditingSections = 'Header Sections Editor';
- RSEditingItems = 'Folder Items Editor';
- RSEditingFolders = 'Folder Editor';
- RSEditingPages = 'Tab Pages Editor';
- RSEditingImages = 'Image List Editor';
- RSSectionBaseName = 'Section';
- RSItemBaseName = 'Item';
- RSFolderBaseName = 'Folder';
- RSPageBaseName = 'Page';
- RSImageBaseName = 'Image';
- RSHoursName = 'Hours';
- RSMinutesName = 'Minutes';
- RSSecondsName = 'Seconds';
- RSCloseCaption = 'Close';
- RSViewFieldNotFound = 'The view field %s was not found';
- RSCantResolveField = 'Unable to resolve view field %s';
- RSItemAlreadyExists = 'Can''t add item %p - it already exists in the index';
- RSAlreadyInTempMode = 'The view is already in temporary index mode';
- RSItemNotFound = 'Specified report view data item %p was not found';
- RSUpdatePending = 'This report view operation is invalid while updates are pending';
- RSOnCompareNotAssigned = 'OnCompareFields not assigned';
- RSOnFilterNotAssigned = 'OnFilter not assigned';
- RSGetAsFloatNotAssigned = 'GetAsFloat not assigned';
- RSNotInTempMode = 'Report view is not in temporary index mode';
- RSItemNotInIndex = 'The specified data item (%p) is not in the index';
- RSNoActiveView = 'No active view';
- RSItemIsNotGroup = 'Item at line %d is not a group';
- RSNotMultiSelect = 'This report view operation is only allowed when multiselect is enabled';
- RSLineNoOutOfRange = 'Invalid index %d';
- RSUnknownView = 'Unknown view: %s';
- RSOnKeySearchNotAssigned = 'The OnKeySearch event is not assigned';
- RSOnEnumNotAssigned = 'The OnEnum event is not assigned';
- RSOnEnumSelectedNA = 'OnEnumSelected not assigned';
- RSNoMenuAssigned = 'No menu item assigned';
- RSNoAnchorAssigned = 'No anchor item assigned';
- RSInvalidParameter = 'Invalid parameter: mpAnchor';
- RSInvalidOperation = 'Invalid operation: Call AddSplit for split menus';
- RSFormUseOnly = 'This component can only be used on forms';
- RSColorBlack = 'Black';
- RSColorMaroon = 'Maroon';
- RSColorGreen = 'Green';
- RSColorOlive = 'Olive';
- RSColorNavy = 'Navy';
- RSColorPurple = 'Purple';
- RSColorTeal = 'Teal';
- RSColorGray = 'Gray';
- RSColorSilver = 'Silver';
- RSColorRed = 'Red';
- RSColorLime = 'Lime';
- RSColorYellow = 'Yellow';
- RSColorBlue = 'Blue';
- RSColorFuchsia = 'Fuchsia';
- RSColorAqua = 'Aqua';
- RSColorWhite = 'White';
- RSColorLightGray = 'Light Gray';
- RSColorMediumGray = 'Medium Gray';
- RSColorDarkGray = 'Dark Gray';
- RSColorMoneyGreen = 'Money Green';
- RSColorSkyBlue = 'Sky Blue';
- RSColorCream = 'Cream';
-
- {end - Index based resource strings}
-
-
diff --git a/Source/3rdParty/Orpheus/o32sr.pas b/Source/3rdParty/Orpheus/o32sr.pas
deleted file mode 100644
index 59ba68c9..00000000
--- a/Source/3rdParty/Orpheus/o32sr.pas
+++ /dev/null
@@ -1,661 +0,0 @@
-{*********************************************************}
-{* O32SR.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 ***** *}
-
-(* Replaces the old String Resource Manager from Orpheus versions 3.x and
- below. The string resource is broken into 3 parts.
- Part 1: The actual string resources contained in O32***RS.inc
- (O32ENGRS.inc for English). (Translate these strings and define the
- language below to create new language versions of Orpheus.)
- Part 2: The index constants defined in OvcConst.pas.
- Part 3: The cross reference array (SrMsgNumLookup) used to convert an
- index into the corresponding string.
- It is very important that the cross reference array be kept in numerical
- order. The lookup is performed by a binary search and if any of the items
- are out of order, the lookup will fail some or all strings. *)
-
-{$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 o32sr;
- {- Orpheus String Resources
- Replaces the String Resource Manager from the olden days...}
-
-interface
-
-uses
- ovcconst;
-
-{$I O32SR.inc}
-
-resourcestring
-
-{Orpheus Internal and Design-time resource strings...}
-
-{!!!! - These should not be translated as they are used internally - !!!!}
-{!!!! - See O32SR.INC for the user visible resource strings - !!!!}
-
- {Navigation Commands}
- ccNoneStr = 'ccNone';
- ccBackStr = 'ccBack';
- ccBotOfPageStr = 'ccBotOfPage';
- ccBotRightCellStr = 'ccBotRightCell';
- ccCompleteDateStr = 'ccCompleteDate';
- ccCompleteTimeStr = 'ccCompleteTime';
- ccCopyStr = 'ccCopy';
- ccCtrlCharStr = 'ccCtrlChar';
- ccCutStr = 'ccCut';
- ccDecStr = 'ccDec';
- ccDelStr = 'ccDel';
- ccDelBolStr = 'ccDelBol';
- ccDelEolStr = 'ccDelEol';
- ccDelLineStr = 'ccDelLine';
- ccDelWordStr = 'ccDelWord';
- ccDownStr = 'ccDown';
- ccEndStr = 'ccEnd';
- ccExtendDownStr = 'ccExtendDown';
- ccExtendEndStr = 'ccExtendEnd';
- ccExtendHomeStr = 'ccExtendHome';
- ccExtendLeftStr = 'ccExtendLeft';
- ccExtendPgDnStr = 'ccExtendPgDn';
- ccExtendPgUpStr = 'ccExtendPgUp';
- ccExtendRightStr = 'ccExtendRight';
- ccExtendUpStr = 'ccExtendUp';
- ccExtBotOfPageStr = 'ccExtBotOfPage';
- ccExtFirstPageStr = 'ccExtFirstPage';
- ccExtLastPageStr = 'ccExtLastPage';
- ccExtTopOfPageStr = 'ccExtTopOfPage';
- ccExtWordLeftStr = 'ccExtWordLeft';
- ccExtWordRightStr = 'ccExtWordRight';
- ccFirstPageStr = 'ccFirstPage';
- ccGotoMarker0Str = 'ccGotoMarker0';
- ccGotoMarker1Str = 'ccGotoMarker1';
- ccGotoMarker2Str = 'ccGotoMarker2';
- ccGotoMarker3Str = 'ccGotoMarker3';
- ccGotoMarker4Str = 'ccGotoMarker4';
- ccGotoMarker5Str = 'ccGotoMarker5';
- ccGotoMarker6Str = 'ccGotoMarker6';
- ccGotoMarker7Str = 'ccGotoMarker7';
- ccGotoMarker8Str = 'ccGotoMarker8';
- ccGotoMarker9Str = 'ccGotoMarker9';
- ccHomeStr = 'ccHome';
- ccIncStr = 'ccInc';
- ccInsStr = 'ccIns';
- ccLastPageStr = 'ccLastPage';
- ccLeftStr = 'ccLeft';
- ccNewLineStr = 'ccNewLine';
- ccNextPageStr = 'ccNextPage';
- ccPageLeftStr = 'ccPageLeft';
- ccPageRightStr = 'ccPageRight';
- ccPasteStr = 'ccPaste';
- ccPrevPageStr = 'ccPrevPage';
- ccRedoStr = 'ccRedo';
- ccRestoreStr = 'ccRestore';
- ccRightStr = 'ccRight';
- ccScrollDownStr = 'ccScrollDown';
- ccScrollUpStr = 'ccScrollUp';
- ccSetMarker0Str = 'ccSetMarker0';
- ccSetMarker1Str = 'ccSetMarker1';
- ccSetMarker2Str = 'ccSetMarker2';
- ccSetMarker3Str = 'ccSetMarker3';
- ccSetMarker4Str = 'ccSetMarker4';
- ccSetMarker5Str = 'ccSetMarker5';
- ccSetMarker6Str = 'ccSetMarker6';
- ccSetMarker7Str = 'ccSetMarker7';
- ccSetMarker8Str = 'ccSetMarker8';
- ccSetMarker9Str = 'ccSetMarker9';
- ccTabStr = 'ccTab';
- ccTableEditStr = 'ccTableEdit';
- ccTopLeftCellStr = 'ccTopLeftCell';
- ccTopOfPageStr = 'ccTopOfPage';
- ccUndoStr = 'ccUndo';
- ccUpStr = 'ccUp';
- ccWordLeftStr = 'ccWordLeft';
- ccWordRightStr = 'ccWordRight';
-
- {DataType strings}
- StringStr = 'String';
- CharStr = 'Char';
- BooleanStr = 'Boolean';
- YesNoStr = 'YesNo';
- LongIntStr = 'LongInt';
- WordStr = 'Word';
- SmallIntStr = 'SmallInt';
- ByteStr = 'Byte';
- ShortIntStr = 'ShortInt';
- RealStr = 'Real';
- ExtendedStr = 'Extended';
- DoubleStr = 'Double';
- SingleStr = 'Single';
- CompStr = 'Comp';
- DateStr = 'Date';
- TimeStr = 'Time';
-
- {Sample masks for the EditField's property editors}
- CharMask1Str = 'X any character';
- CharMask2Str = '! any char (upper)';
- CharMask3Str = 'L any char (lower)';
- CharMask4Str = 'x any char (mixed)';
- CharMask5Str = 'a alphas only';
- CharMask6Str = 'A alphas (upper)';
- CharMask7Str = 'l alphas (lower)';
- CharMask8Str = '9 0-9';
- CharMask9Str = 'i 0-9, -';
- CharMask10Str = '# 0-9, -, .';
- CharMask11Str = 'E 0-9, E, -, .';
- CharMask12Str = 'K 0-9, A-F (hex)';
- CharMask14Str = 'O 0-7 (octal)';
- CharMask15Str = 'b 0, 1 (binary)';
- CharMask16Str = 'B T or F (upper)';
- CharMask17Str = 'Y Y or N (upper)';
- CharMask18Str = '1 User 1';
- CharMask19Str = '2 User 2';
- CharMask20Str = '3 User 3';
- CharMask21Str = '4 User 4';
- CharMask22Str = '5 User 5';
- CharMask23Str = '6 User 6';
- CharMask24Str = '7 User 7';
- CharMask25Str = '8 User 8';
-
- FieldMask1Str = '$##,###.## Allows entry of 0 through 9, space, minus, and period Uses floating currency symbol';
- FieldMask2Str = '9999999999 Allows entry of 0 through 9, and space';
- FieldMask3Str = 'iiiiiiiiii Allows entry of 0 through 9, space, and minus';
- FieldMask4Str = 'ii,iii,iii Allows entry of 0 through 9, space, and minus Displays number separators as needed';
- FieldMask5Str = '$iiiiiiiii Allows entry of 0 through 9, space, and minus Uses floating currency symbol';
- FieldMask6Str = '########## Allows entry of 0 through 9, space, minus, and period';
- FieldMask7Str = '#######.## Allows entry of 0 through 9, space, minus, and period Fixed decimal position';
- FieldMask8Str = '###,###.## Allows entry of 0 through 9, space, minus, and period Displays number separators as needed';
- FieldMask9Str = '$######.## Allows entry of 0 through 9, space, minus, and period Fixed decimal position Uses floating currency symbol';
- FieldMask10Str = '##########p Allows entry of 0 through 9, space, minus, and period Negative amounts use ()';
- FieldMask11Str = '###,###.##C Allows entry of 0 through 9, space, minus, and period Currency symbol at right';
- FieldMask12Str = 'KKKKKKKK Hexadecimal (E4401F3E) Allows entry of 0 through 9 and A through F Force upper case';
- FieldMask13Str = 'KKKK Hexadecimal (1F3E) Allows entry of 0 through 9 and A through F Force upper case';
- FieldMask14Str = 'KK Hexadecimal (3E) Allows entry of 0 through 9 and A through F Force upper case';
- FieldMask15Str = 'OOOOOOOO Octal (45135677) Allows entry of 0 through 7 ';
- FieldMask16Str = 'OOOO Octal (5677) Allows entry of 0 through 7 ';
- FieldMask17Str = 'bbbbbbbbbbbbbbbb Binary (0101001010010100) Allows entry of 0 and 1';
- FieldMask18Str = 'bbbbbbbb Binary (10010100) Allows entry of 0 and 1';
- FieldMask19Str = 'XXXXXXXXXX Any character can be entered';
- FieldMask20Str = '!!!!!!!!!! Any character can be entered Alphabetic characters are forced to upper case';
- FieldMask21Str = 'LLLLLLLLLL Any character can be entered Alphabetic characters are forced to lower case';
- FieldMask22Str = 'xxxxxxxxxx Any character can be entered Uses mixed case';
- FieldMask23Str = 'aaaaaaaaaa Alphabetic characters plus space, minus, period, and comma';
- FieldMask24Str = 'AAAAAAAAAA Alphabetic characters plus space, minus, period, and comma Alphabetic characters are forced to upper case';
- FieldMask25Str = 'llllllllll Alphabetic characters plus space, minus, period, and comma Alphabetic characters are forced to lower case';
- FieldMask26Str = '(999) 999-9999 Phone number mask Allows 0 through 9 and space';
- FieldMask27Str = '999-999-9999 Phone number mask Allows 0 through 9 and space';
- FieldMask28Str = '99999-9999 US Zip Code mask Allows 0 through 9 and space';
- FieldMask29Str = 'B Boolean mask Allows T, t, F, f Forces input to upper case';
- FieldMask30Str = 'Y Boolean mask Allows Y, y, N, n Forces input to upper case';
- FieldMask31Str = 'mm/dd/yy Date mask (01/05/96) Allows entry of 0 through 9 plus space Month and Day are padded with zeros';
- FieldMask32Str = 'mm/dd/yyyy Date mask (01/05/1996) Allows entry of 0 through 9 plus space Month and Day are padded with zeros';
- FieldMask33Str = 'dd nnn yyyy Date mask (05 Jan 1996) Allows entry of 0 through 9 plus space Day is padded with zeros';
- FieldMask34Str = 'MM/DD/yy Date mask ( 1/ 5/96) Allows entry of 0 through 9 plus space Month and Day are padded with spaces';
- FieldMask35Str = 'MM/DD/yyyy Date mask ( 1/ 5/1996) Allows entry of 0 through 9 plus space Month and Day are padded with spaces';
- FieldMask36Str = 'DD nnn yyyy Date mask ( 5 Jan 1996) Allows entry of 0 through 9 plus space Day is padded with spaces';
- FieldMask37Str = 'hh:mm Time mask (03:25) Allows entry of 0 through 9 plus space Hours and minutes are padded with zeros (24 hour clock)';
- FieldMask38Str = 'hh:mm tt Time mask (03:25 pm) Allows entry of 0 through 9 plus space Hours and minutes are padded with zeros';
- FieldMask39Str = 'hh:mm:ss Time mask (03:25:07) Allows entry of 0 through 9 plus space Hours, minutes, and seconds are padded with zeros';
- FieldMask40Str = 'HH:MM Time mask ( 3:25) Allows entry of 0 through 9 plus space Hours and minutes are padded with spaces (24 hour clock)';
- FieldMask41Str = 'HH:MM tt Time mask ( 3:25 pm) Allows entry of 0 through 9 plus space Hours and minutes are padded with spaces';
- FieldMask42Str = 'HH:MM:SS Time mask ( 3:25: 7) Allows entry of 0 through 9 plus space Hours, minutes, and seconds are padded with spaces';
-
-const
- {Change this when new strings are added.}
- SrMaxMessages = 375;
-
-type
- SrMsgNumLookupRec = record
- MessageNum : integer;
- MessageStr : string;
- end;
-
-const
- {Matches the index numbers to their associated Strings}
-
- {WARNING! When adding to or deleting from this array, make sure you keep the
- items in ascending numerical order by the value of the MessageNum constants.
- Otherwise, the Lookup will fail some or all strings...}
-
- SrMsgNumLookup : array [1..SrMaxMessages] of SrMsgNumLookupRec =
- {External Resource String Mapping. External resource strings are contained in
- O32SR.INC...}
- ((MessageNum : SCUnknownError; MessageStr : RSUnknownError),
- (MessageNum : SCDuplicateCommand; MessageStr : RSDuplicateCommand),
- (MessageNum : SCTableNotFound; MessageStr : RSTableNotFound),
- (MessageNum : SCNotDoneYet; MessageStr : RSNotDoneYet),
- (MessageNum : SCNoControllerAssigned; MessageStr : RSNoControllerAssigned),
- (MessageNum : SCCantCreateCommandTable; MessageStr : RSCantCreateCommandTable),
- (MessageNum : SCCantDelete; MessageStr : RSCantDelete),
- (MessageNum : SCInvalidKeySequence; MessageStr : RSInvalidKeySequence),
- (MessageNum : SCNotWordStarCommands; MessageStr : RSNotWordStarCommands),
- (MessageNum : SCNoCommandSelected; MessageStr : RSNoCommandSelected),
- (MessageNum : SCDuplicateKeySequence; MessageStr : RSDuplicateKeySequence),
- (MessageNum : SCRangeError; MessageStr : RSRangeError),
- (MessageNum : SCInvalidNumber; MessageStr : RSInvalidNumber),
- (MessageNum : SCRequiredField; MessageStr : RSRequiredField),
- (MessageNum : SCInvalidDate; MessageStr : RSInvalidDate),
- (MessageNum : SCInvalidTime; MessageStr : RSInvalidTime),
- (MessageNum : SCBlanksInField; MessageStr : RSBlanksInField),
- (MessageNum : SCPartialEntry; MessageStr : RSPartialEntry),
- (MessageNum : SCRegionTooLarge; MessageStr : RSRegionTooLarge),
- (MessageNum : SCOutOfMemoryForCopy; MessageStr : RSOutOfMemoryForCopy),
- (MessageNum : SCInvalidParamValue; MessageStr : RSInvalidParamValue),
- (MessageNum : SCNoTimersAvail; MessageStr : RSNoTimersAvail),
- (MessageNum : SCTooManyEvents; MessageStr : RSTooManyEvents),
- (MessageNum : SCBadTriggerHandle; MessageStr : RSBadTriggerHandle),
- (MessageNum : SCOnSelectNotAssigned; MessageStr : RSOnSelectNotAssigned),
- (MessageNum : SCInvalidPageIndex; MessageStr : RSInvalidPageIndex),
- (MessageNum : SCInvalidDataType; MessageStr : RSInvalidDataType),
- (MessageNum : SCInvalidTabFont; MessageStr : RSInvalidTabFont),
- (MessageNum : SCInvalidLabelFont; MessageStr : RSInvalidLabelFont),
- (MessageNum : SCOutOfMemory; MessageStr : RSOutOfMemory),
- (MessageNum : SCTooManyParas; MessageStr : RSTooManyParas),
- (MessageNum : SCCannotJoin; MessageStr : RSCannotJoin),
- (MessageNum : SCTooManyBytes; MessageStr : RSTooManyBytes),
- (MessageNum : SCParaTooLong; MessageStr : RSParaTooLong),
- (MessageNum : SCInvalidPictureMask; MessageStr : RSInvalidPictureMask),
- (MessageNum : SCInvalidRange; MessageStr : RSInvalidRange),
- (MessageNum : SCInvalidRealRange; MessageStr : RSInvalidRealRange),
- (MessageNum : SCInvalidExtendedRange; MessageStr : RSInvalidExtendedRange),
- (MessageNum : SCInvalidDoubleRange; MessageStr : RSInvalidDoubleRange),
- (MessageNum : SCInvalidSingleRange; MessageStr : RSInvalidSingleRange),
- (MessageNum : SCInvalidCompRange; MessageStr : RSInvalidCompRange),
- (MessageNum : SCInvalidDateRange; MessageStr : RSInvalidDateRange),
- (MessageNum : SCInvalidTimeRange; MessageStr : RSInvalidTimeRange),
- (MessageNum : SCInvalidRangeValue; MessageStr : RSInvalidRangeValue),
- (MessageNum : SCRangeNotSupported; MessageStr : RSRangeNotSupported),
- (MessageNum : SCInvalidLineOrParaIndex; MessageStr : RSInvalidLineOrParaIndex),
- (MessageNum : SCNonFixedFont; MessageStr : RSNonFixedFont),
- (MessageNum : SCInvalidFontParam; MessageStr : RSInvalidFontParam),
- (MessageNum : SCInvalidLineOrColumn; MessageStr : RSInvalidLineOrColumn),
- (MessageNum : SCSAEGeneral; MessageStr : RSSAEGeneral),
- (MessageNum : SCSAEAtMaxSize; MessageStr : RSSAEAtMaxSize),
- (MessageNum : SCInvalidXMLFile; MessageStr : RSInvalidXMLFile),
- (MessageNum : SCUnterminatedElement; MessageStr : RSUnterminatedElement),
- (MessageNum : SCBadColorConst; MessageStr : RSBadColorConstant),
- (MessageNum : SCBadColorValue; MessageStr : RSBadColorValue),
- (MessageNum : SCSAEOutOfBounds; MessageStr : RSSAEOutOfBounds),
- (MessageNum : SCInvalidFieldType; MessageStr : RSInvalidFieldType),
- (MessageNum : SCBadAlarmHandle; MessageStr : RSBadAlarmHandle),
- (MessageNum : SCOnIsSelectedNotAssigned; MessageStr : RSOnIsSelectedNotAssigned),
- (MessageNum : SCInvalidDateForMask; MessageStr : RSInvalidDateForMask),
- (MessageNum : SCNoTableAttached; MessageStr : RSNoTableAttached),
- (MessageNum : SCViewerIOError; MessageStr : RSViewerIOError),
- (MessageNum : SCViewerFileNotFound; MessageStr : RSViewerFileNotFound),
- (MessageNum : SCViewerPathNotFound; MessageStr : RSViewerPathNotFound),
- (MessageNum : SCViewerTooManyOpenFiles; MessageStr : RSViewerTooManyOpenFiles),
- (MessageNum : SCViewerFileAccessDenied; MessageStr : RSViewerFileAccessDenied),
- (MessageNum : SCControlAttached; MessageStr : RSControlAttached),
- (MessageNum : SCCantEdit; MessageStr : RSCantEdit),
- (MessageNum : SCChildTableError; MessageStr : RSChildTableError),
- (MessageNum : SCNoCollection; MessageStr : RSNoCollection),
- (MessageNum : SCNotOvcDescendant; MessageStr : RSNotOvcDescendant),
- (MessageNum : SCItemIncompatible; MessageStr : RSItemIncompatible),
- (MessageNum : SCLabelNotAttached; MessageStr : RSLabelNotAttached),
- (MessageNum : SCClassNotSet; MessageStr : RSClassNotSet),
- (MessageNum : SCCollectionNotFound; MessageStr : RSCollectionNotFound),
- (MessageNum : SCDayConvertError; MessageStr : RSDayConvertError),
- (MessageNum : SCMonthConvertError; MessageStr : RSMonthConvertError),
- (MessageNum : SCMonthNameConvertError; MessageStr : RSMonthNameConvertError),
- (MessageNum : SCYearConvertError; MessageStr : RSYearConvertError),
- (MessageNum : SCDayRequired; MessageStr : RSDayRequired),
- (MessageNum : SCMonthRequired; MessageStr : RSMonthRequired),
- (MessageNum : SCYearRequired; MessageStr : RSYearRequired),
- (MessageNum : SCInvalidDay; MessageStr : RSInvalidDay),
- (MessageNum : SCInvalidMonth; MessageStr : RSInvalidMonth),
- (MessageNum : SCInvalidMonthName; MessageStr : RSInvalidMonthName),
- (MessageNum : SCInvalidYear; MessageStr : RSInvalidYear),
- (MessageNum : SCTableRowOutOfBounds; MessageStr : RSTableRowOutOfBounds),
- (MessageNum : SCTableMaxRows; MessageStr : RSTableMaxRows),
- (MessageNum : SCTableMaxColumns; MessageStr : RSTableMaxColumns),
- (MessageNum : SCTableGeneral; MessageStr : RSTableGeneral),
- (MessageNum : SCTableToManyColumns; MessageStr : RSTableToManyColumns),
- (MessageNum : SCTableInvalidFieldIndex; MessageStr : RSTableInvalidFieldIndex),
- (MessageNum : SCTableHeaderNotAssigned; MessageStr : RSTableHeaderNotAssigned),
- (MessageNum : SCTableInvalidHeaderCell; MessageStr : RSTableInvalidHeaderCell),
- (MessageNum : SCGridTableName; MessageStr : RSGridTableName),
- (MessageNum : SCNoneStr; MessageStr : RSNoneStr),
- (MessageNum : SCccUser; MessageStr : RSccUser),
- (MessageNum : SCccUserNum; MessageStr : RSccUserNum),
- (MessageNum : SCDeleteTable; MessageStr : RSDeleteTable),
- (MessageNum : SCRenameTable; MessageStr : RSRenameTable),
- (MessageNum : SCEnterTableName; MessageStr : RSEnterTableName),
- (MessageNum : SCNewTable; MessageStr : RSNewTable),
- (MessageNum : SCDefaultTableName; MessageStr : RSDefaultTableName),
- (MessageNum : SCWordStarTableName; MessageStr : RSWordStarTableName ),
- (MessageNum : SCUnknownTable; MessageStr : RSUnknownTable),
- (MessageNum : SCDefaultEntryErrorText; MessageStr : RSDefaultEntryErrorText),
- (MessageNum : SCGotItemWarning; MessageStr : RSGotItemWarning),
- (MessageNum : SCSampleListItem; MessageStr : RSSampleListItem),
- (MessageNum : SCAlphaString; MessageStr : RSAlphaString),
- (MessageNum : SCTallLowChars; MessageStr : RSTallLowChars),
- (MessageNum : SCDefault; MessageStr : RSDefault),
- (MessageNum : SCDescending; MessageStr : RSDescending),
- (MessageNum : SCDefaultIndex; MessageStr : RSDefaultIndex),
- (MessageNum : SCRestoreMI; MessageStr : RSRestoreMI),
- (MessageNum : SCCutMI; MessageStr : RSCutMI),
- (MessageNum : SCCopyMI; MessageStr : RSCopyMI),
- (MessageNum : SCPasteMI; MessageStr : RSPasteMI),
- (MessageNum : SCDeleteMI; MessageStr : RSDeleteMI),
- (MessageNum : SCSelectAllMI; MessageStr : RSSelectAllMI),
- (MessageNum : SCCalcBack; MessageStr : RSCalcBack),
- (MessageNum : SCCalcMC; MessageStr : RSCalcMC),
- (MessageNum : SCCalcMR; MessageStr : RSCalcMR),
- (MessageNum : SCCalcMS; MessageStr : RSCalcMS),
- (MessageNum : SCCalcMPlus; MessageStr : RSCalcMPlus),
- (MessageNum : SCCalcMMinus; MessageStr : RSCalcMMinus),
- (MessageNum : SCCalcCT; MessageStr : RSCalcCT),
- (MessageNum : SCCalcCE; MessageStr : RSCalcCE),
- (MessageNum : SCCalcC; MessageStr : RSCalcC),
- (MessageNum : SCCalcSqrt; MessageStr : RSCalcSqrt),
- (MessageNum : SCCalNext; MessageStr : RSCalNext),
- (MessageNum : SCCalLast; MessageStr : RSCalLast),
- (MessageNum : SCCalFirst; MessageStr : RSCalFirst),
- (MessageNum : SCCal1st; MessageStr : RSCal1st),
- (MessageNum : SCCalSecond; MessageStr : RSCalSecond),
- (MessageNum : SCCal2nd; MessageStr : RSCal2nd),
- (MessageNum : SCCalThird; MessageStr : RSCalThird),
- (MessageNum : SCCal3rd; MessageStr : RSCal3rd),
- (MessageNum : SCCalFourth; MessageStr : RSCalFourth),
- (MessageNum : SCCal4th; MessageStr : RSCal4th),
- (MessageNum : SCCalFinal; MessageStr : RSCalFinal),
- (MessageNum : SCCalBOM; MessageStr : RSCalBOM),
- (MessageNum : SCCalEnd; MessageStr : RSCalEnd),
- (MessageNum : SCCalEOM; MessageStr : RSCalEOM),
- (MessageNum : SCCalYesterday; MessageStr : RSCalYesterday),
- (MessageNum : SCCalToday; MessageStr : RSCalToday),
- (MessageNum : SCCalTomorrow; MessageStr : RSCalTomorrow),
- (MessageNum : SCEditingSections; MessageStr : RSEditingSections),
- (MessageNum : SCEditingItems; MessageStr : RSEditingItems),
- (MessageNum : SCEditingFolders; MessageStr : RSEditingFolders),
- (MessageNum : SCEditingPages; MessageStr : RSEditingPages),
- (MessageNum : SCEditingImages; MessageStr : RSEditingImages),
- (MessageNum : SCSectionBaseName; MessageStr : RSSectionBaseName),
- (MessageNum : SCItemBaseName; MessageStr : RSItemBaseName),
- (MessageNum : SCFolderBaseName; MessageStr : RSFolderBaseName),
- (MessageNum : SCPageBaseName; MessageStr : RSPageBaseName),
- (MessageNum : SCImageBaseName; MessageStr : RSImageBaseName),
- (MessageNum : SCOwnerMustBeForm; MessageStr : RSOwnerMustBeForm),
- (MessageNum : SCTimeConvertError; MessageStr : RSTimeConvertError),
- (MessageNum : SCCancelQuery; MessageStr : RSCancelQuery),
- (MessageNum : SCNoPagesAssigned; MessageStr : RSNoPagesAssigned),
- (MessageNum : SCCalPrev; MessageStr : RSCalPrev),
- (MessageNum : SCCalBegin; MessageStr : RSCalBegin),
- (MessageNum : SCInvalidMinMaxValue; MessageStr : RSInvalidMinMaxValue),
- (MessageNum : SCFormUseOnly; MessageStr : RSFormUseOnly),
- (MessageNum : SCYes; MessageStr : RSYes),
- (MessageNum : SCNo; MessageStr : RSNo),
- (MessageNum : SCTrue; MessageStr : RSTrue),
- (MessageNum : SCFalse; MessageStr : RSFalse),
- (MessageNum : SCHoursName; MessageStr : RSHoursName),
- (MessageNum : SCMinutesName; MessageStr : RSMinutesName),
- (MessageNum : SCSecondsName; MessageStr : RSSecondsName),
- (MessageNum : SCCloseCaption; MessageStr : RSCloseCaption),
- (MessageNum : SCViewFieldNotFound; MessageStr : RSViewFieldNotFound),
- (MessageNum : SCCantResolveField; MessageStr : RSCantResolveField),
- (MessageNum : SCItemAlreadyExists; MessageStr : RSItemAlreadyExists),
- (MessageNum : SCAlreadyInTempMode; MessageStr : RSAlreadyInTempMode),
- (MessageNum : SCItemNotFound; MessageStr : RSItemNotFound),
- (MessageNum : SCUpdatePending; MessageStr : RSUpdatePending),
- (MessageNum : SCOnCompareNotAssigned; MessageStr : RSOnCompareNotAssigned),
- (MessageNum : SCOnFilterNotAssigned; MessageStr : RSOnFilterNotAssigned),
- (MessageNum : SCGetAsFloatNotAssigned; MessageStr : RSGetAsFloatNotAssigned),
- (MessageNum : SCNotInTempMode; MessageStr : RSNotInTempMode),
- (MessageNum : SCItemNotInIndex; MessageStr : RSItemNotInIndex),
- (MessageNum : SCNoActiveView; MessageStr : RSNoActiveView),
- (MessageNum : SCItemIsNotGroup; MessageStr : RSItemIsNotGroup),
- (MessageNum : SCNotMultiSelect; MessageStr : RSNotMultiSelect),
- (MessageNum : SCLineNoOutOfRange; MessageStr : RSLineNoOutOfRange),
- (MessageNum : SCUnknownView; MessageStr : RSUnknownView),
- (MessageNum : SCOnKeySearchNotAssigned; MessageStr : RSOnKeySearchNotAssigned),
- (MessageNum : SCOnEnumNotAssigned; MessageStr : RSOnEnumNotAssigned),
- (MessageNum : SCOnEnumSelectedNA; MessageStr : RSOnEnumSelectedNA),
- (MessageNum : SCNoMenuAssigned; MessageStr : RSNoMenuAssigned),
- (MessageNum : SCNoAnchorAssigned; MessageStr : RSNoAnchorAssigned),
- (MessageNum : SCInvalidParameter; MessageStr : RSInvalidParameter),
- (MessageNum : SCInvalidOperation; MessageStr : RSInvalidOperation),
- (MessageNum : SCColorBlack; MessageStr : RSColorBlack),
- (MessageNum : SCColorMaroon; MessageStr : RSColorMaroon),
- (MessageNum : SCColorGreen; MessageStr : RSColorGreen),
- (MessageNum : SCColorOlive; MessageStr : RSColorOlive),
- (MessageNum : SCColorNavy; MessageStr : RSColorNavy),
- (MessageNum : SCColorPurple; MessageStr : RSColorPurple),
- (MessageNum : SCColorTeal; MessageStr : RSColorTeal),
- (MessageNum : SCColorGray; MessageStr : RSColorGray),
- (MessageNum : SCColorSilver; MessageStr : RSColorSilver),
- (MessageNum : SCColorRed; MessageStr : RSColorRed),
- (MessageNum : SCColorLime; MessageStr : RSColorLime),
- (MessageNum : SCColorYellow; MessageStr : RSColorYellow),
- (MessageNum : SCColorBlue; MessageStr : RSColorBlue),
- (MessageNum : SCColorFuchsia; MessageStr : RSColorFuchsia),
- (MessageNum : SCColorAqua; MessageStr : RSColorAqua),
- (MessageNum : SCColorWhite; MessageStr : RSColorWhite),
- (MessageNum : SCColorLightGray; MessageStr : RSColorLightGray),
- (MessageNum : SCColorMediumGray; MessageStr : RSColorMediumGray),
- (MessageNum : SCColorDarkGray; MessageStr : RSColorDarkGray),
- (MessageNum : SCColorMoneyGreen; MessageStr : RSColorMoneyGreen),
- (MessageNum : SCColorSkyBlue; MessageStr : RSColorSkyBlue),
- (MessageNum : SCColorCream; MessageStr : RSColorCream),
-
- {End - Resource String Mapping...}
-
- {Internal Strings}
- (MessageNum : IccNone; MessageStr : ccNoneStr),
- (MessageNum : IccBack; MessageStr : ccBackStr),
- (MessageNum : IccBotOfPage; MessageStr : ccBotOfPageStr),
- (MessageNum : IccBotRightCell; MessageStr : ccBotRightCellStr),
- (MessageNum : IccCompleteDate; MessageStr : ccCompleteDateStr),
- (MessageNum : IccCompleteTime; MessageStr : ccCompleteTimeStr),
- (MessageNum : IccCopy; MessageStr : ccCopyStr),
- (MessageNum : IccCtrlChar; MessageStr : ccCtrlCharStr),
- (MessageNum : IccCut; MessageStr : ccCutStr),
- (MessageNum : IccDec; MessageStr : ccDecStr),
- (MessageNum : IccDel; MessageStr : ccDelStr),
- (MessageNum : IccDelBol; MessageStr : ccDelBolStr),
- (MessageNum : IccDelEol; MessageStr : ccDelEolStr),
- (MessageNum : IccDelLine; MessageStr : ccDelLineStr),
- (MessageNum : IccDelWord; MessageStr : ccDelWordStr),
- (MessageNum : IccDown; MessageStr : ccDownStr),
- (MessageNum : IccEnd; MessageStr : ccEndStr),
- (MessageNum : IccExtendDown; MessageStr : ccExtendDownStr),
- (MessageNum : IccExtendEnd; MessageStr : ccExtendEndStr),
- (MessageNum : IccExtendHome; MessageStr : ccExtendHomeStr),
- (MessageNum : IccExtendLeft; MessageStr : ccExtendLeftStr),
- (MessageNum : IccExtendPgDn; MessageStr : ccExtendPgDnStr),
- (MessageNum : IccExtendPgUp; MessageStr : ccExtendPgUpStr),
- (MessageNum : IccExtendRight; MessageStr : ccExtendRightStr),
- (MessageNum : IccExtendUp; MessageStr : ccExtendUpStr),
- (MessageNum : IccExtBotOfPage; MessageStr : ccExtBotOfPageStr),
- (MessageNum : IccExtFirstPage; MessageStr : ccExtFirstPageStr),
- (MessageNum : IccExtLastPage; MessageStr : ccExtLastPageStr),
- (MessageNum : IccExtTopOfPage; MessageStr : ccExtTopOfPageStr),
- (MessageNum : IccExtWordLeft; MessageStr : ccExtWordLeftStr),
- (MessageNum : IccExtWordRight; MessageStr : ccExtWordRightStr),
- (MessageNum : IccFirstPage; MessageStr : ccFirstPageStr),
- (MessageNum : IccGotoMarker0; MessageStr : ccGotoMarker0Str),
- (MessageNum : IccGotoMarker1; MessageStr : ccGotoMarker1Str),
- (MessageNum : IccGotoMarker2; MessageStr : ccGotoMarker2Str),
- (MessageNum : IccGotoMarker3; MessageStr : ccGotoMarker3Str),
- (MessageNum : IccGotoMarker4; MessageStr : ccGotoMarker4Str),
- (MessageNum : IccGotoMarker5; MessageStr : ccGotoMarker5Str),
- (MessageNum : IccGotoMarker6; MessageStr : ccGotoMarker6Str),
- (MessageNum : IccGotoMarker7; MessageStr : ccGotoMarker7Str),
- (MessageNum : IccGotoMarker8; MessageStr : ccGotoMarker8Str),
- (MessageNum : IccGotoMarker9; MessageStr : ccGotoMarker9Str),
- (MessageNum : IccHome; MessageStr : ccHomeStr),
- (MessageNum : IccInc; MessageStr : ccIncStr),
- (MessageNum : IccIns; MessageStr : ccInsStr),
- (MessageNum : IccLastPage; MessageStr : ccLastPageStr),
- (MessageNum : IccLeft; MessageStr : ccLeftStr),
- (MessageNum : IccNewLine; MessageStr : ccNewLineStr),
- (MessageNum : IccNextPage; MessageStr : ccNextPageStr),
- (MessageNum : IccPageLeft; MessageStr : ccPageLeftStr),
- (MessageNum : IccPageRight; MessageStr : ccPageRightStr),
- (MessageNum : IccPaste; MessageStr : ccPasteStr),
- (MessageNum : IccPrevPage; MessageStr : ccPrevPageStr),
- (MessageNum : IccRedo; MessageStr : ccRedoStr),
- (MessageNum : IccRestore; MessageStr : ccRestoreStr),
- (MessageNum : IccRight; MessageStr : ccRightStr),
- (MessageNum : IccScrollDown; MessageStr : ccScrollDownStr),
- (MessageNum : IccScrollUp; MessageStr : ccScrollUpStr),
- (MessageNum : IccSetMarker0; MessageStr : ccSetMarker0Str),
- (MessageNum : IccSetMarker1; MessageStr : ccSetMarker1Str),
- (MessageNum : IccSetMarker2; MessageStr : ccSetMarker2Str),
- (MessageNum : IccSetMarker3; MessageStr : ccSetMarker3Str),
- (MessageNum : IccSetMarker4; MessageStr : ccSetMarker4Str),
- (MessageNum : IccSetMarker5; MessageStr : ccSetMarker5Str),
- (MessageNum : IccSetMarker6; MessageStr : ccSetMarker6Str),
- (MessageNum : IccSetMarker7; MessageStr : ccSetMarker7Str),
- (MessageNum : IccSetMarker8; MessageStr : ccSetMarker8Str),
- (MessageNum : IccSetMarker9; MessageStr : ccSetMarker9Str),
- (MessageNum : IccTab; MessageStr : ccTabStr),
- (MessageNum : IccTableEdit; MessageStr : ccTableEditStr),
- (MessageNum : IccTopLeftCell; MessageStr : ccTopLeftCellStr),
- (MessageNum : IccTopOfPage; MessageStr : ccTopOfPageStr),
- (MessageNum : IccUndo; MessageStr : ccUndoStr),
- (MessageNum : IccUp; MessageStr : ccUpStr),
- (MessageNum : IccWordLeft; MessageStr : ccWordLeftStr),
- (MessageNum : IccWordRight; MessageStr : ccWordRightStr),
- (MessageNum : IString; MessageStr : StringStr),
- (MessageNum : IChar; MessageStr : CharStr),
- (MessageNum : IBoolean; MessageStr : BooleanStr),
- (MessageNum : IYesNo; MessageStr : YesNoStr),
- (MessageNum : ILongInt; MessageStr : LongIntStr),
- (MessageNum : IWord; MessageStr : WordStr),
- (MessageNum : ISmallInt; MessageStr : SmallIntStr),
- (MessageNum : IByte; MessageStr : ByteStr),
- (MessageNum : IShortInt; MessageStr : ShortIntStr),
- (MessageNum : IReal; MessageStr : RealStr),
- (MessageNum : IExtended; MessageStr : ExtendedStr),
- (MessageNum : IDouble; MessageStr : DoubleStr),
- (MessageNum : ISingle; MessageStr : SingleStr),
- (MessageNum : IComp; MessageStr : CompStr),
- (MessageNum : IDate; MessageStr : DateStr),
- (MessageNum : ITime; MessageStr : TimeStr),
- (MessageNum : ICharMask1; MessageStr : CharMask1Str),
- (MessageNum : ICharMask2; MessageStr : CharMask2Str),
- (MessageNum : ICharMask3; MessageStr : CharMask3Str),
- (MessageNum : ICharMask4; MessageStr : CharMask4Str),
- (MessageNum : ICharMask5; MessageStr : CharMask5Str),
- (MessageNum : ICharMask6; MessageStr : CharMask6Str),
- (MessageNum : ICharMask7; MessageStr : CharMask7Str),
- (MessageNum : ICharMask8; MessageStr : CharMask8Str),
- (MessageNum : ICharMask9; MessageStr : CharMask9Str),
- (MessageNum : ICharMask10; MessageStr : CharMask10Str),
- (MessageNum : ICharMask11; MessageStr : CharMask11Str),
- (MessageNum : ICharMask12; MessageStr : CharMask12Str),
- (MessageNum : ICharMask13; MessageStr : CharMask14Str),
- (MessageNum : ICharMask14; MessageStr : CharMask15Str),
- (MessageNum : ICharMask15; MessageStr : CharMask16Str),
- (MessageNum : ICharMask16; MessageStr : CharMask17Str),
- (MessageNum : ICharMask17; MessageStr : CharMask18Str),
- (MessageNum : ICharMask18; MessageStr : CharMask19Str),
- (MessageNum : ICharMask19; MessageStr : CharMask20Str),
- (MessageNum : ICharMask20; MessageStr : CharMask21Str),
- (MessageNum : ICharMask21; MessageStr : CharMask22Str),
- (MessageNum : ICharMask22; MessageStr : CharMask23Str),
- (MessageNum : ICharMask23; MessageStr : CharMask24Str),
- (MessageNum : ICharMask24; MessageStr : CharMask25Str),
- (MessageNum : IFieldMask1; MessageStr : FieldMask1Str),
- (MessageNum : IFieldMask2; MessageStr : FieldMask2Str),
- (MessageNum : IFieldMask3; MessageStr : FieldMask3Str),
- (MessageNum : IFieldMask4; MessageStr : FieldMask4Str),
- (MessageNum : IFieldMask5; MessageStr : FieldMask5Str),
- (MessageNum : IFieldMask6; MessageStr : FieldMask6Str),
- (MessageNum : IFieldMask7; MessageStr : FieldMask7Str),
- (MessageNum : IFieldMask8; MessageStr : FieldMask8Str),
- (MessageNum : IFieldMask9; MessageStr : FieldMask9Str),
- (MessageNum : IFieldMask10; MessageStr : FieldMask10Str),
- (MessageNum : IFieldMask11; MessageStr : FieldMask11Str),
- (MessageNum : IFieldMask12; MessageStr : FieldMask12Str),
- (MessageNum : IFieldMask13; MessageStr : FieldMask13Str),
- (MessageNum : IFieldMask14; MessageStr : FieldMask14Str),
- (MessageNum : IFieldMask15; MessageStr : FieldMask15Str),
- (MessageNum : IFieldMask16; MessageStr : FieldMask16Str),
- (MessageNum : IFieldMask17; MessageStr : FieldMask17Str),
- (MessageNum : IFieldMask18; MessageStr : FieldMask18Str),
- (MessageNum : IFieldMask19; MessageStr : FieldMask19Str),
- (MessageNum : IFieldMask20; MessageStr : FieldMask20Str),
- (MessageNum : IFieldMask21; MessageStr : FieldMask21Str),
- (MessageNum : IFieldMask22; MessageStr : FieldMask22Str),
- (MessageNum : IFieldMask23; MessageStr : FieldMask23Str),
- (MessageNum : IFieldMask24; MessageStr : FieldMask24Str),
- (MessageNum : IFieldMask25; MessageStr : FieldMask25Str),
- (MessageNum : IFieldMask26; MessageStr : FieldMask26Str),
- (MessageNum : IFieldMask27; MessageStr : FieldMask27Str),
- (MessageNum : IFieldMask28; MessageStr : FieldMask28Str),
- (MessageNum : IFieldMask29; MessageStr : FieldMask29Str),
- (MessageNum : IFieldMask30; MessageStr : FieldMask30Str),
- (MessageNum : IFieldMask31; MessageStr : FieldMask31Str),
- (MessageNum : IFieldMask32; MessageStr : FieldMask32Str),
- (MessageNum : IFieldMask33; MessageStr : FieldMask33Str),
- (MessageNum : IFieldMask34; MessageStr : FieldMask34Str),
- (MessageNum : IFieldMask35; MessageStr : FieldMask35Str),
- (MessageNum : IFieldMask36; MessageStr : FieldMask36Str),
- (MessageNum : IFieldMask37; MessageStr : FieldMask37Str),
- (MessageNum : IFieldMask38; MessageStr : FieldMask38Str),
- (MessageNum : IFieldMask39; MessageStr : FieldMask39Str),
- (MessageNum : IFieldMask40; MessageStr : FieldMask40Str),
- (MessageNum : IFieldMask41; MessageStr : FieldMask41Str),
- (MessageNum : IFieldMask42; MessageStr : FieldMask42Str));
-
- {End - Internal Strings...}
-
-function ResourceStrByNumber(Num: Word): String;
-
-implementation
-
-function ResourceStrByNumber(Num: Word): String;
-{Implements a simple binary search through the SrMsgNumLookup array.
- Returns an empty string is a match isn't found.}
-var
- Mid, Min, Max : integer;
-begin
- result := '';
- Min := 0;
- Max := SrMaxMessages;
- while (Min <= Max) do begin
- Mid := (Min + Max) div 2;
- if SrMsgNumLookup[Mid].MessageNum = Num then begin
- result := SrMsgNumLookup[Mid].MessageStr;
- exit;
- end else begin
- if Num < SrMsgNumLookup[Mid].MessageNum
- then Max := Mid - 1
- else Min := Mid + 1;
- end;
- end;
-end;
-
-end.
diff --git a/Source/3rdParty/Orpheus/o32tcflx.pas b/Source/3rdParty/Orpheus/o32tcflx.pas
deleted file mode 100644
index cb5c788f..00000000
--- a/Source/3rdParty/Orpheus/o32tcflx.pas
+++ /dev/null
@@ -1,717 +0,0 @@
-{*********************************************************}
-{* OVCTCFLX.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 o32tcflx;
- {Orpheus Table Cell version of the FlexEdit}
-
-interface
-
-uses
- SysUtils, Classes,
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, Types, LclType, MyMisc, {$ENDIF}
- Graphics, Controls, Forms, StdCtrls,
- Menus, OvcTCmmn, OvcTCell,
- OvcTCStr, O32FlxEd, O32bordr, OvcEf, OvcCmd, O32VlOp1, O32Vldtr;
-
-type
-
- { Event for the TCFlexEdit User Validation }
- TTCFEUserValidationEvent =
- procedure(Sender : TObject; Value: string;
- var ValidEntry : Boolean) of object;
-
-
- {Class for storing the validation properties. These properties will be
- loaded dynamically when the editor is created.}
- TO32TCValidatorOptions = class(TPersistent)
- protected {private}
- FValidationType : TValidationType;
- FValidatorType : String;
- FValidatorClass : TValidatorClass;
- FMask : String;
- FLastValid : Boolean;
- FLastErrorCode : Word;
- FBeepOnError : Boolean;
- FInputRequired : Boolean;
-
- procedure SetValidatorType(const VType: String);
- procedure AssignValidator;
- public
- constructor Create; dynamic;
- property LastValid: Boolean
- read FLastValid write FLastValid;
- property LastErrorCode: Word
- read FLastErrorCode write FLastErrorCode;
-
- { - Moved from published}
- property ValidatorClass: TValidatorClass
- read FValidatorClass write FValidatorClass stored true;
- published
- property BeepOnError: Boolean
- read FBeepOnError write FBeepOnError stored true;
- property InputRequired: Boolean
- read FInputRequired write FInputRequired stored true;
- property ValidatorType : string
- read FValidatorType write SetValidatorType stored true;
- property ValidationType: TValidationType
- read FValidationType write FValidationType stored true;
- property Mask: String
- read FMask write FMask stored true;
- end;
-
-
- TO32TCFlexEditEditor = class(TO32CustomFlexEdit)
- protected {private}
- FCell : TOvcBaseTableCell;
- procedure WMChar(var Msg : TWMKey); message WM_CHAR;
-{$IFNDEF LCL}
- procedure WMGetDlgCode(var Msg : TMessage); message WM_GETDLGCODE;
-{$ELSE}
- procedure WMGetDlgCode(var Msg : TWMGetDlgCode); message WM_GETDLGCODE;
-{$ENDIF}
- procedure WMKeyDown(var Msg : TWMKey); message WM_KEYDOWN;
- procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS;
- procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
-
- function ValidateSelf: Boolean; override;
-
-// TurboPower bug? CellOwner property wasn't published.
- published //Added
- property CellOwner : TOvcBaseTableCell read FCell write FCell; //Moved to here
- end;
-
- TO32TCBorderProperties = class(TPersistent)
- protected {private}
- FActive : Boolean;
- FFlatColor : TColor;
- FBorderStyle : TO32BorderStyle;
- public
- constructor Create; virtual;
- published
- property Active: Boolean read FActive write FActive;
- property FlatColor: TColor read FFlatColor write FFlatColor;
- property BorderStyle: TO32BorderStyle read FBorderStyle write FBorderStyle;
- end;
-
- TO32TCEditorProperties = class(TPersistent)
- protected
- FAlignment : TAlignment;
- FBorders : TO32Borders;
- FButtonGlyph : TBitmap;
- FColor : TColor;
- FCursor : TCursor;
- FMaxLines : Integer;
- FShowButton : Boolean;
- FPasswordChar : Char;
- FReadOnly : Boolean;
- procedure SetButtonGlyph(Value :TBitmap);
- function GetButtonGlyph :TBitmap;
- public
- constructor Create; virtual;
- destructor Destroy; override;
-
- property Borders: TO32Borders read FBorders write FBorders;
-
- published
- {$IFDEF VERSION4}
- property Alignment: TAlignment read FAlignment write FAlignment;
- {$ENDIF}
- property ButtonGlyph: TBitmap
- read GetButtonGlyph write SetButtonGlyph;
-
- property Color: TColor Read FColor write FColor;
- property Cursor: TCursor read FCursor write FCursor;
- property MaxLines: Integer read FMaxLines write FMaxLines;
- property PasswordChar: Char read FPasswordChar write FPasswordChar;
- property ReadOnly: Boolean Read FReadOnly write FReadOnly;
- property ShowButton: Boolean read FShowButton write FShowButton;
- end;
-
- TO32TCCustomFlexEdit = class(TOvcTCBaseString)
- protected {private}
- FBorderProps : TO32TCBorderProperties;
- FEdit : TO32TCFlexEditEditor;
- FEditorOptions : TO32TCEditorProperties;
- FMaxLength : word;
- FValidation : TO32TCValidatorOptions;
- FWantReturns : Boolean;
- FWantTabs : Boolean;
- FWordWrap : Boolean;
-
- FOnError : TValidationErrorEvent;
- FOnUserCommand : TUserCommandEvent;
- FOnUserValidation : TTCFEUserValidationEvent;
-
- FOnButtonClick : TO32feButtonClickEvent;
-
- protected
- function GetCellEditor : TControl; override;
- function GetModified : boolean;
-
- property MaxLength : word
- read FMaxLength write FMaxLength stored true;
- property WantReturns : boolean
- read FWantReturns write FWantReturns stored true;
- property WantTabs : boolean
- read FWantTabs write FWantTabs stored true;
- property WordWrap: Boolean
- read FWordWrap write FWordWrap stored true;
- property EditorBorders: TO32TCBorderProperties
- read FBorderProps write FBorderProps;
- property OnButtonClick: TO32feButtonClickEvent
- read FOnButtonClick write FOnButtonClick;
- property Validation: TO32TCValidatorOptions
- read FValidation write FValidation;
- public
- constructor Create(AOwner : TComponent); override;
- destructor Destroy; override;
- function CreateEditControl(AOwner : TComponent) : TO32TCFlexEditEditor; virtual;
- function EditHandle : THandle; override;
- procedure EditHide; override;
- procedure EditMove(CellRect : TRect); override;
-
- function CanSaveEditedData(SaveValue : boolean) : boolean; override;
- procedure SaveEditedData(Data : pointer); override;
- function ValidateEntry: Boolean;
- procedure StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer); override;
- procedure StopEditing(SaveValue : boolean;
- Data : pointer); override;
- property Modified : boolean
- read GetModified;
- property EditorOptions: TO32TCEditorProperties
- read FEditorOptions write FEditorOptions;
- property OnUserValidation: TTCFEUserValidationEvent
- read FOnUserValidation write FOnUserValidation;
- end;
-
- TO32TCFlexEdit = class(TO32TCCustomFlexEdit)
- published
- {properties inherited from custom ancestor}
- property Access default otxDefault;
- property Adjust default otaDefault;
- property EditorBorders;
- property Color;
- property EditorOptions;
- property Font;
- property Hint;
- property Margin default 4;
- property MaxLength default 255;
- property ShowHint default False;
- property Table;
- property TableColor default True;
- property TableFont default True;
- property TextHiColor default clBtnHighlight;
- property TextStyle default tsFlat;
- property Validation;
- property WantReturns default False;
- property WantTabs default False;
- property WordWrap default False;
- {events inherited from custom ancestor}
- property OnButtonClick;
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnOwnerDraw;
- property OnUserValidation;
- end;
-
-implementation
-
-{===== TO32TCValidatorOptions ========================================}
-
-constructor TO32TCValidatorOptions.Create;
-begin
- inherited Create;
- FValidationType := vtNone;
- FValidatorType := 'None';
- FValidatorClass := nil;
- FMask := '';
- FLastValid := false;
- FLastErrorCode := 0;
- FBeepOnError := true;
- FInputRequired := false;
-end;
-
-procedure TO32TCValidatorOptions.AssignValidator;
-begin
- if (FValidatorType = 'None') or (FValidatorType = '')then
- FValidatorClass := nil
- else try
- FValidatorClass := TValidatorClass(FindClass(FValidatorType));
- except
- FValidatorClass := nil;
- end;
-end;
-{=====}
-
-procedure TO32TCValidatorOptions.SetValidatorType(const VType: String);
-begin
- if FValidatorType <> VType then begin
- FValidatorType := VType;
- AssignValidator;
- end;
-end;
-
-
-{===== TO32TCFlexEditEditor ==========================================}
-
-procedure TO32TCFlexEditEditor.WMChar(var Msg : TWMKey);
-begin
- if (not CellOwner.TableWantsTab) or (Msg.CharCode <> 9) then
- inherited;
-end;
-{=====}
-
-{$IFNDEF LCL}
-procedure TO32TCFlexEditEditor.WMGetDlgCode(var Msg : TMessage);
-{$ELSE}
-procedure TO32TCFlexEditEditor.WMGetDlgCode(var Msg : TWMGetDlgCode);
-{$ENDIF}
-begin
- inherited;
- if CellOwner.TableWantsTab then
- Msg.Result := Msg.Result or DLGC_WANTTAB;
-end;
-{=====}
-
-procedure TO32TCFlexEditEditor.WMKeyDown(var Msg : TWMKey);
- {Local Method}
- procedure GetSelection(var S, E : word);
- type
- LH = packed record L, H : word; end;
- var
- GetSel : longint;
- begin
- GetSel := SendMessage(Handle, EM_GETSEL, 0, 0);
- S := LH(GetSel).L;
- E := LH(GetSel).H;
- end;
-var
- GridReply : TOvcTblKeyNeeds;
- GridUsedIt : boolean;
- SStart, SEnd : word;
-begin
- GridUsedIt := false;
- GridReply := otkDontCare;
- if (CellOwner <> nil) then
- GridReply := CellOwner.FilterTableKey(Msg);
- case GridReply of
- otkMustHave :
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- otkWouldLike :
- case Msg.CharCode of
- VK_RETURN :
- if not WantReturns then
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- VK_LEFT :
- begin
- GetSelection(SStart, SEnd);
- if (SStart = SEnd) and (SStart = 0) then
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;
- VK_RIGHT :
- begin
- GetSelection(SStart, SEnd);
- if ((SStart = SEnd) or (SStart = 0)) and (SEnd = GetTextLen) then
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;
- VK_UP, VK_DOWN, VK_PRIOR, VK_NEXT : //TurboPower bug? left out this case
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;
- end;{case}
-
- if not GridUsedIt then
- inherited;
-end;
-{=====}
-
-procedure TO32TCFlexEditEditor.WMKillFocus(var Msg : TWMKillFocus);
-begin
-{$IFNDEF LCL}
- inherited;
-{$ELSE}
- inherited WMKillFocus(Msg);
-{$ENDIF}
-
- CellOwner.PostMessageToTable(ctim_KillFocus, Msg.FocusedWnd, 0);
-end;
-{=====}
-
-procedure TO32TCFlexEditEditor.WMSetFocus(var Msg : TWMSetFocus);
-begin
-{$IFNDEF LCL}
- inherited;
-{$ELSE}
- inherited WMSetFocus(Msg);
-{$ENDIF}
- CellOwner.PostMessageToTable(ctim_SetFocus, Msg.FocusedWnd, 0);
-end;
-{=====}
-
-function TO32TCFlexEditEditor.ValidateSelf;
-begin
- result := inherited ValidateSelf;
-end;
-
-{===== TO32TCBorderProperties ========================================}
-constructor TO32TCBorderProperties.Create;
-begin
- inherited;
- FActive := False;
- FFlatColor := clBlack;
- FBorderStyle := bstyRaised;
-end;
-
-{===== TO32TCEditorProperties ========================================}
-constructor TO32TCEditorProperties.Create;
-begin
- inherited Create;
- FAlignment := taLeftJustify;
- FButtonGlyph := TBitmap.Create;
- FColor := clWindow;
- FCursor := crDefault;
- FMaxLines := 3;
- FShowButton := false;
-// TurboPower bug: No default efoPasswordMode=False like TOvcTCSimpleField,
-// so '*' means TO32TCFlexEdit would be in password mode by default.
-// FPasswordChar := '*';
- FPasswordChar := #0; //Fixed
- FReadOnly := false;
-end;
-{=====}
-
-destructor TO32TCEditorProperties.Destroy;
-begin
- FButtonGlyph.Free;
- inherited Destroy;
-end;
-{=====}
-
-{ - begin}
-procedure TO32TCEditorProperties.SetButtonGlyph(Value :TBitmap);
-begin
- FButtonGlyph.Assign(Value);
-end;
-{=====}
-
-function TO32TCEditorProperties.GetButtonGlyph :TBitmap;
-begin
- Result := FButtonGlyph;
-end;
-{=====}
-{ - end}
-
-{===== TO32TCCustomFlexEdit ==========================================}
-constructor TO32TCCustomFlexEdit.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
- UseASCIIZStrings := true;
- UseWordWrap := true;
- FEditorOptions := TO32TCEditorProperties.Create;
- FBorderProps := TO32TCBorderProperties.Create;
- FValidation := TO32TCValidatorOptions.Create;
- MaxLength := 255;
-end;
-{=====}
-
-destructor TO32TCCustomFlexEdit.Destroy;
-begin
- FEditorOptions.Free;
- FBorderProps.Free;
- FValidation.Free;
- inherited;
-end;
-{=====}
-
-function TO32TCCustomFlexEdit.GetCellEditor : TControl;
-begin
- Result := FEdit;
- FEditorOptions.Free;
-end;
-{=====}
-
-function TO32TCCustomFlexEdit.GetModified : boolean;
-begin
- if Assigned(FEdit) then
- Result := FEdit.Modified
- else
- Result := false;
-end ;
-{=====}
-
-function TO32TCCustomFlexEdit.CreateEditControl(AOwner : TComponent):
- TO32TCFlexEditEditor;
-begin
- Result := TO32TCFlexEditEditor.Create(AOwner);
-end;
-{=====}
-
-function TO32TCCustomFlexEdit.EditHandle : THandle;
-begin
- if Assigned(FEdit) then
- Result := FEdit.Handle
- else
- Result := 0;
-end;
-{=====}
-
-procedure TO32TCCustomFlexEdit.EditHide;
-begin
- if Assigned(FEdit) then
-// with FEdit do
- SetWindowPos(FEdit.Handle, HWND_TOP, 0, 0, 0, 0, SWP_HIDEWINDOW
- or SWP_NOREDRAW or SWP_NOZORDER);
-end;
-{=====}
-
-procedure TO32TCCustomFlexEdit.EditMove(CellRect : TRect);
-begin
- if Assigned(FEdit) then
- begin
- with CellRect do
- SetWindowPos(FEdit.Handle, HWND_TOP,
- Left, Top, Right-Left, Bottom-Top,
- SWP_SHOWWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- InvalidateRect(FEdit.Handle, nil, false);
- UpdateWindow(FEdit.Handle);
- end;
-end;
-{=====}
-
-function TO32TCCustomFlexEdit.CanSaveEditedData(SaveValue : boolean) : boolean;
-begin
- Result := true;
- if Validation.InputRequired and (FEdit.Text = '') then begin
- result := false;
- FEdit.Restore;
- end
-
- else if (Validation.FValidationType <> vtNone) then
- if Assigned(FEdit) then
- if SaveValue then
- Result := ValidateEntry
- else begin
- FEdit.Restore;
-// result := false; //TurboPower bug? Inconsistent with
- //TOvcTCBaseEntryField.CanSaveEditedData and
- //p.928 of Orpheus.pdf. Prevents TOvcTable's
- //StopEditingState from completing if SaveValue=False.
- end;
-end;
-{=====}
-
-function TO32TCCustomFlexEdit.ValidateEntry: Boolean;
-begin
- if Assigned(FOnUserValidation) then begin
- FOnUserValidation(FEdit, FEdit.Text, result);
-
-// if Validation.BeepOnError then MessageBeep(0); <== TurboPower bug? not checking result
- if (not result) and Validation.BeepOnError then MessageBeep(0); //Fixed
-
-// Another TurboPower omission? Since OnError not published the way
-// OnUserValidation is, no way to display error if validation fails
-// (and displaying error in OnUserValidation handler causes problems).
-// Next two lines added to remedy this. In OnUserValidation handler,
-// you can set TO32TCFlexEditEditor(Sender).OnValidationError to have
-// your error method called here. Note that you can also call
-// TO32TCFlexEditEditor(Sender).Validation.SetLastErrorCode in your
-// OnUserValidation handler to set the error passed in ErrorCode to
-// your OnValidationError method.
- if (not result) and Assigned(FEdit.FOnValidationError) then
- FEdit.FOnValidationError(FEdit, FEdit.Validation.LastErrorCode, 'Invalid input');
-
- exit;
- end;
-
- result := FEdit.ValidateSelf;
- Validation.LastValid := FEdit.Validation.LastValid;
- Validation.LastErrorCode := FEdit.Validation.LastErrorCode;
-end;
-
-procedure TO32TCCustomFlexEdit.SaveEditedData(Data : pointer);
-begin
- {Abstract method does nothing.
- It is stubbed out so that BCB doesn't think this as an abstract class}
-end;
-{=====}
-
-procedure TO32TCCustomFlexEdit.StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer);
-{var
- Str: String;}
-begin
- FEdit := TO32TCFlexEditEditor.Create(FTable);
-
- FEdit.Validation.EnableHooking := false;
- FEdit.Validation.InputRequired := Validation.InputRequired;
- FEdit.Validation.ValidationType := Validation.ValidationType;
- FEdit.Validation.ValidatorType := Validation.ValidatorType;
- FEdit.Validation.ValidatorClass := Validation.ValidatorClass;
- FEdit.Validation.Mask := Validation.Mask;
- FEdit.Validation.BeepOnError := Validation.BeepOnError;
- FEdit.Validation.InputRequired := Validation.InputRequired;
- FEdit.Validation.ValidationEvent := veOnExit;
-
-
- FEdit.ShowButton := FEditorOptions.ShowButton;
- if FEdit.ShowButton then begin
- FEdit.ButtonGlyph := FEditorOptions.ButtonGlyph;
- if Assigned(OnButtonClick) then
- FEdit.OnButtonClick := OnButtonClick;
- end;
-
- with FEdit do begin
- Parent := FTable;
-
- Borders.Active := FBorderProps.FActive;
-
- if Borders.Active then begin
- Borders.BorderStyle := FBorderProps.FBorderStyle;
- Borders.FlatColor := FBorderProps.FFlatColor;
- BorderStyle := bsSingle;
- Ctl3D := true;
- end else begin
- BorderStyle := bsNone;
- Ctl3D := false;
- case CellStyle of
- tesBorder : BorderStyle := bsSingle;
- tes3D : Ctl3D := true;
- end;{case}
- end;
-
- Color := FEditorOptions.Color;
- Font := CellAttr.caFont;
- Font.Color := CellAttr.caFontColor;
- MaxLength := Self.MaxLength;
- WantReturns := Self.WantReturns;
- WantTabs := Self.WantTabs;
- WordWrap := Self.WordWrap;
- EditLines.MaxLines := FEditorOptions.MaxLines;
- EditLines.DefaultLines := 1;
- EditLines.FocusedLines := 3;
- EditLines.MouseOverLines := 3;
- Cursor := FEditorOptions.Cursor;
- PasswordChar := FEditorOptions.PasswordChar;
- ReadOnly := FEditorOptions.ReadOnly;
- Left := CellRect.Left;
- Top := CellRect.Top;
- Width := CellRect.Right - CellRect.Left;
- Height := CellRect.Bottom - CellRect.Top;
- Visible := true;
- TabStop := false;
- CellOwner := Self;
- Hint := Self.Hint;
- ShowHint := Self.ShowHint;
- Tag := Self.Tag; //TurboPower omission? Might be useful to know this too.
-
- {Str := PAnsiChar(Data);} {!!!}
- if (Data = nil) then
- SetTextBuf('')
- else begin
- SetTextBuf(PAnsiChar(Data));
- end;
-
- OnChange := Self.OnChange;
- OnClick := Self.OnClick;
- OnDblClick := Self.OnDblClick;
- OnDragDrop := Self.OnDragDrop;
- OnDragOver := Self.OnDragOver;
- OnEndDrag := Self.OnEndDrag;
- OnEnter := Self.OnEnter;
- OnExit := Self.OnExit;
- OnKeyDown := Self.OnKeyDown;
- OnKeyPress := Self.OnKeyPress;
- OnKeyUp := Self.OnKeyUp;
- OnMouseDown := Self.OnMouseDown;
- OnMouseMove := Self.OnMouseMove;
- OnMouseUp := Self.OnMouseUp;
- end;
-end;
-{=====}
-
-procedure TO32TCCustomFlexEdit.StopEditing(SaveValue : boolean;
- Data : pointer);
-{var
- Str: String;}
-begin
- try
- if SaveValue and Assigned(Data) then begin
- FEdit.GetTextBuf(PAnsiChar(Data), MaxLength);
- {Str := PAnsiChar(Data);} {!!!}
- end;
- finally
- FEdit.Free;
- FEdit := nil;
- end;
-end;
-{=====}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/o32vldtr.pas b/Source/3rdParty/Orpheus/o32vldtr.pas
deleted file mode 100644
index 99ec7636..00000000
--- a/Source/3rdParty/Orpheus/o32vldtr.pas
+++ /dev/null
@@ -1,193 +0,0 @@
-{*********************************************************}
-{* O32VLDTR.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 o32vldtr;
- {-Base classes for the TO32Validator and descendant components}
-
-{
-TO32BaseValidator is the abstract ancestor for all Orpheus Validator components
-Descendants must override SetInput, SetMask, GetValid and IsValid plus define
-the validation to provide full functionality.
-
-Descendant classes which call the RegisterValidator and UnRegisterValidator
-procedures in their unit's Initialization and Finalization sections will be
-available as a selection in the ValidatorType property of components that use
-validators internally.
-}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, MyMisc, {$ENDIF} Classes, OvcBase;
-
-type
- TValidationEvent = (veOnChange, veOnEnter, veOnExit);
-
- TValidatorErrorEvent =
- procedure(Sender: TObject; const ErrorMsg: string) of object;
-
- TValidatorClass = class of TO32BaseValidator;
-
- TO32BaseValidator = class(TO32Component)
- protected {private}
- {property variables}
- FBeforeValidation : TNotifyEvent;
- FAfterValidation : TNotifyEvent;
- FOnUserValidation : TNotifyEvent;
- FOnErrorEvent : TValidatorErrorEvent;
-
- FInput : string;
- FMask : string;
- FValid : boolean ;
- FErrorCode : Word;
- FSampleMaskLength : Word;
- FSampleMasks : TStringList;
-
- procedure SetAbout(const Value: string);
- procedure SetInput(const Value: string); virtual; abstract;
- procedure SetMask(const Value: string); virtual; abstract;
- procedure SetValid(Value: boolean);
- function GetAbout: string;
- function GetValid: Boolean; virtual; abstract;
- function GetSampleMasks: TStringList; virtual; abstract;
- procedure DoOnUserValidation;
- procedure DoBeforeValidation;
- procedure DoAfterValidation;
- procedure DoOnError(Sender: TObject; const ErrorMsg: string);
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
-
- {Public Methods}
- function IsValid: Boolean; virtual; abstract;
- function SampleMaskLength: integer;
-
- {Public Properties}
- property Input : string read FInput
- write SetInput;
- property Mask : string read FMask write SetMask;
- property Valid : boolean read GetValid;
- property ErrorCode: Word read FErrorCode;
- property SampleMasks: TStringList read GetSampleMasks;
-
- {Public Events}
- property BeforeValidation : TNotifyEvent
- read FBeforeValidation write FBeforeValidation;
- property AfterValidation : TNotifyEvent
- read FAfterValidation write FAfterValidation;
- property OnValidationError : TValidatorErrorEvent
- read FOnErrorEvent write FOnErrorEvent;
-
- published
- property About : string read GetAbout write SetAbout
- stored False;
- end;
-
-implementation
-
-uses
- OvcVer;
-
-{===== TO32BaseValidator ===========================================}
-constructor TO32BaseValidator.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
- FSampleMaskLength := 0;
- FSampleMasks := TStringList.Create;
-end;
-{=====}
-
-destructor TO32BaseValidator.Destroy;
-begin
- FSampleMasks.Clear;
- FSampleMasks.Free;
- inherited Destroy;
-end;
-{=====}
-
-function TO32BaseValidator.SampleMaskLength: integer;
-begin
- result := FSampleMaskLength;
-end;
-{=====}
-
-function TO32BaseValidator.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-{=====}
-
-procedure TO32BaseValidator.SetAbout(const Value : string);
-begin
-end;
-{=====}
-
-procedure TO32BaseValidator.SetValid(Value: boolean);
-begin
- if FValid <> Value then
- FValid := Value;
-end;
-{=====}
-
-procedure TO32BaseValidator.DoOnUserValidation;
-begin
- if Assigned(FOnUserValidation) then
- FOnUserValidation(Self);
-end;
-{=====}
-
-procedure TO32BaseValidator.DoBeforeValidation;
-begin
- if Assigned(FBeforeValidation) then
- FBeforeValidation(Self);
-end;
-{=====}
-
-procedure TO32BaseValidator.DoAfterValidation;
-begin
- if Assigned(FAfterValidation) then
- FAfterValidation(Self);
-end;
-{=====}
-
-procedure TO32BaseValidator.DoOnError(Sender: TObject; const ErrorMsg: string);
-begin
- if Assigned(FOnErrorEvent) then
- FOnErrorEvent(Self, ErrorMsg);
-end;
-
-end.
diff --git a/Source/3rdParty/Orpheus/o32vlop1.pas b/Source/3rdParty/Orpheus/o32vlop1.pas
deleted file mode 100644
index 006e1313..00000000
--- a/Source/3rdParty/Orpheus/o32vlop1.pas
+++ /dev/null
@@ -1,410 +0,0 @@
-{*********************************************************}
-{* O32VLOP1.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 o32vlop1;
- {-ValidatorOptions class for use in components and classes which contain
- their own validator objects, like the ValidatorPool, FlexEdit, Etc...}
-
-interface
-
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, Types, LclType, MyMisc, {$ENDIF}
- Controls, Classes, Forms, SysUtils,
- O32Vldtr, OvcData, OvcExcpt, OvcConst;
-
-type
- TValidationType = (vtNone, vtUser, vtValidator);
-
- TProtectedControl = class(TWinControl);
-
- TValidatorOptions = class(TPersistent)
- protected {private}
- FOwner : TWinControl;
- FHookedControl : TWinControl;
- FValidationType : TValidationType;
- FValidatorType : String;
- FValidatorClass : TValidatorClass;
- FSoftValidation : Boolean;
- FMask : String;
- FLastValid : Boolean;
- FLastErrorCode : Word;
- FBeepOnError : Boolean;
- FInputRequired : Boolean;
- FEnableHooking : Boolean;
- FUpdating : Integer;
-
- {Event for which this object will execute a validation}
- FEvent : TValidationEvent;
-
- {WndProc Pointers}
- NewWndProc : Pointer;
- PrevWndProc : Pointer;
-
- procedure HookControl;
- procedure UnHookControl;
- procedure voWndProc(var Msg : TMessage);
-
- procedure RecreateHookedWnd;
- function Validate: Boolean;
-
- procedure AssignValidator;
- procedure SetValidatorType(const VType: String);
- procedure SetEvent(Event: TValidationEvent);
- procedure SetEnableHooking(Value: Boolean);
-
- property InputRequired: Boolean read FInputRequired write FInputRequired;
-
- public
- constructor Create(AOwner: TWinControl); dynamic;
- destructor Destroy; override;
-
- procedure AttachTo(Value : TWinControl);
- procedure SetLastErrorCode(Code: Word);
- procedure SetLastValid(Valid: Boolean);
-
- procedure BeginUpdate;
- procedure EndUpdate;
-
- property LastValid: Boolean read FLastValid;
- property LastErrorCode: Word read FLastErrorCode;
- property EnableHooking: Boolean read FEnableHooking write SetEnableHooking;
- property ValidatorClass: TValidatorClass read FValidatorClass
- write FValidatorClass;
- published
- property BeepOnError: Boolean read FBeepOnError write FBeepOnError;
-
-
- property SoftValidation: Boolean read FSoftValidation write FSoftValidation;
-
- property ValidationEvent: TValidationEvent read FEvent write SetEvent
- stored true;
- property ValidatorType : string
- read FValidatorType write SetValidatorType stored true;
- property ValidationType: TValidationType
- read FValidationType write FValidationType stored true;
- property Mask: String read FMask write FMask stored true;
- end;
-
-implementation
-
-
-// Note that workaround below currently works only with win32.
-// Other widgetsets currently don't implement Get/SetWindowLong
-// or never call LclWndProc (don't implement CallWindowProc
-// correctly?), but the workaround code appears harmless.
-// Just undefine LCLWndProc to disable workaround code.
-{$IFDEF LCL}
- {$DEFINE LCLWndProc}
-{$ENDIF}
-
-{$IFDEF LCLWndProc}
-// Workaround for lack of MakeObjectInstance in LCL for making
-// a WindowProc callback function from an object method.
-// Pass pointer to this function to SetWindowLong wherever using
-// MakeObjectInstance. Also set window's user data to pointer to
-// object method's pointers so method can be reconstituted here.
-// Note: Adapted from Felipe's CallbackAllocateHWnd procedure.
-function LclWndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM) : LRESULT;
- {$IFDEF MSWINDOWS} stdcall; {$ELSE} cdecl; {$ENDIF}
-var
- AMsg : TMessage;
- MethodPtr : ^TWndMethod;
-begin
- FillChar(AMsg, SizeOf(Msg), #0);
-
- {Populate message}
- AMsg.Msg := Msg;
- AMsg.WParam := wParam;
- AMsg.LParam := lParam;
-
- {Get pointer to memory containing method's code and data pointers}
- MethodPtr := Pointer(GetWindowLong(hWnd, GWL_USERDATA));
-
- if Assigned(MethodPtr) then
- MethodPtr^(AMsg); {Dereference pointer and call method with message}
-end;
-{$ENDIF}
-
-
-{===== TValidatorOptions =============================================}
-constructor TValidatorOptions.Create(AOwner: TWinControl);
-begin
- inherited Create;
-
- FOwner := AOwner;
-
-{$IFNDEF LCL}
- {create a callable window proc pointer}
- {$IFDEF VERSION6}
- NewWndProc := Classes.MakeObjectInstance(voWndProc);
- {$ELSE}
- NewWndProc := MakeObjectInstance(voWndProc);
- {$ENDIF}
-{$ELSE}
- {$IFDEF LCLWndProc}
- NewWndProc := @LclWndProc;
- {$ENDIF}
-{$ENDIF}
-
- ValidatorType := 'None';
- FSoftValidation := false;
- ValidationType := vtNone;
- ValidationEvent := veOnExit;
- FInputRequired := false;
- FEnableHooking := true;
- BeepOnError := true;
- FValidatorClass := nil;
- FMask := '';
- FLastValid := false;
- FLastErrorCode := 0;
-end;
-{=====}
-
-destructor TValidatorOptions.Destroy;
-begin
- UnhookControl;
- FValidatorClass := nil;
- inherited destroy;
-end;
-{=====}
-
-procedure TValidatorOptions.HookControl;
-var
- P : Pointer;
-{$IFDEF LCLWndProc}
- MethodPtr : ^TWndMethod;
-{$ENDIF}
-begin
- if not FEnableHooking then exit;
- {hook into owner's window procedure}
- if (FHookedControl <> nil) then begin
- if not FHookedControl.HandleAllocated then FHookedControl.HandleNeeded;
- {save original window procedure if not already saved}
- P := Pointer(GetWindowLong(FHookedControl.Handle, GWL_WNDPROC));
- if (P <> NewWndProc) then begin
- PrevWndProc := P;
- {redirect message handling to ours}
-{$IFDEF LCLWndProc}
- GetMem(MethodPtr, SizeOf(TMethod)); {Allocate memory}
- MethodPtr^ := voWndProc; {Store method's code and data pointers}
- {Associate pointer to memory with window}
- SetWindowLong(FHookedControl.Handle, GWL_USERDATA, PtrInt(MethodPtr));
- if not Assigned(Pointer(GetWindowLong(FHookedControl.Handle, GWL_USERDATA))) then
- FreeMem(MethodPtr); //SetWindowLong not implemented for widgetset
-{$ENDIF}
- SetWindowLong(FHookedControl.Handle, GWL_WNDPROC, LPARAM(NewWndProc)); //64
- end;
- end;
-end;
-{=====}
-
-procedure TValidatorOptions.UnHookControl;
-{$IFDEF LCLWndProc}
-var
- MethodPtr : ^TWndMethod;
-{$ENDIF}
-begin
- if (FHookedControl <> nil) then begin
- if Assigned(PrevWndProc) and FHookedControl.HandleAllocated then
- begin
-{$IFDEF LCLWndProc}
- {Get pointer to memory allocated previously}
- MethodPtr := Pointer(GetWindowLong(FHookedControl.Handle, GWL_USERDATA));
- if Assigned(MethodPtr) then
- FreeMem(MethodPtr);
-{$ENDIF}
- SetWindowLong(FHookedControl.Handle, GWL_WNDPROC, LPARAM(PrevWndProc)); //64
- end;
- end;
- PrevWndProc := nil;
-end;
-{=====}
-
-procedure TValidatorOptions.AttachTo(Value : TWinControl);
-var
- WC : TWinControl;
-begin
- if not FEnableHooking then Exit;
-
- FHookedControl := Value;
-
- {unhook from attached control's window procedure}
- UnHookControl;
-
- {insure that we are the only one to hook to this control}
- if not (csLoading in FOwner.ComponentState) and Assigned(Value) then begin
- {send message asking if this control is attached to anything}
- {the control itself won't be able to respond unless it is attached}
- {in which case, it will be our hook into the window procedure that}
- {is actually responding}
-
- if not Value.HandleAllocated then
- Value.HandleNeeded;
-
- if Value.HandleAllocated then begin
- WC := TWinControl(SendMessage(Value.Handle, OM_ISATTACHED, 0, 0));
- if Assigned(WC) then
- raise EOvcException.CreateFmt(GetOrphStr(SCControlAttached),
- [WC.Name])
- else
- HookControl;
- end;
- end;
-end;
-{=====}
-
-procedure TValidatorOptions.SetEvent(Event: TValidationEvent);
-begin
- if Event <> FEvent then
- FEvent := Event;
-end;
-{=====}
-
-procedure TValidatorOptions.SetEnableHooking(Value: Boolean);
-begin
- if FEnableHooking <> Value then begin
- FEnableHooking := Value;
- if FEnableHooking and (FHookedControl <> nil) then
- AttachTo(FHookedControl);
- end else
- UnHookControl;
-end;
-{=====}
-
-procedure TValidatorOptions.RecreateHookedWnd;
-begin
- if not (csDestroying in FHookedControl.ComponentState) then
- PostMessage(FHookedControl.Handle, OM_RECREATEWND, 0, 0);
-end;
-{=====}
-
-procedure TValidatorOptions.voWndProc(var Msg : TMessage);
-begin
- with Msg do begin
- case FEvent of
- veOnEnter : if Msg = {$IFNDEF LCL} CM_ENTER {$ELSE} LM_SETFOCUS {$ENDIF} then
- Validate;
-
- veOnExit : if Msg = {$IFNDEF LCL} CM_EXIT {$ELSE} LM_KILLFOCUS {$ENDIF} then
- if (not Validate) and (not FSoftValidation) then
- begin
- FHookedControl.SetFocus;
-{$IFDEF LCL}
- Exit;
-{$ENDIF}
- end;
-
- {TextChanged}
- veOnChange : if Msg = 48435 then //Probably doesn't work with LCL
- Validate;
-
- end;
-
- {Pass the message on...}
- if PrevWndProc <> nil then
- Result := CallWindowProc(PrevWndProc, FHookedControl.Handle, Msg,
- WParam, LParam)
- else
- Result := CallWindowProc(TProtectedControl(FHookedControl).DefWndProc,
- FHookedControl.Handle, Msg, wParam, lParam);
- end;
-end;
-{=====}
-
-procedure TValidatorOptions.AssignValidator;
-begin
- if (FValidatorType = 'None') or (FValidatorType = '')then
- FValidatorClass := nil
- else try
- FValidatorClass := TValidatorClass(FindClass(FValidatorType));
- except
- FValidatorClass := nil;
- end;
-end;
-{=====}
-
-procedure TValidatorOptions.SetLastErrorCode(Code: Word);
-begin
- FLastErrorCode := Code;
-end;
-{=====}
-
-function TValidatorOptions.Validate: Boolean;
-begin
- {Don't validate if we're in the middle of updates.}
- if FUpdating > 0 then begin
- result := true;
- exit;
- end;
-
- {Send a Validate message to the Owner}
- SetLastErrorCode(SendMessage(FOwner.Handle, OM_VALIDATE, 0, 0));
- SetLastValid(FLastErrorCode = 0);
- result := FLastValid;
-end;
-
-procedure TValidatorOptions.SetLastValid(Valid: Boolean);
-begin
- FLastValid := Valid;
-end;
-{=====}
-
-procedure TValidatorOptions.BeginUpdate;
-begin
- Inc(FUpdating);
-end;
-{=====}
-
-procedure TValidatorOptions.EndUpdate;
-begin
- Dec(FUpdating);
- if FUpdating < 0 then
- FUpdating := 0;
-end;
-{=====}
-
-procedure TValidatorOptions.SetValidatorType(const VType: String);
-begin
- if FValidatorType <> VType then begin
- FValidatorType := VType;
- AssignValidator;
- end;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/o32vlreg.pas b/Source/3rdParty/Orpheus/o32vlreg.pas
deleted file mode 100644
index 0eff8b5c..00000000
--- a/Source/3rdParty/Orpheus/o32vlreg.pas
+++ /dev/null
@@ -1,99 +0,0 @@
-{*********************************************************}
-{* O32VLREG.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 o32vlreg;
- {Registration unit for the Orpheus Validator components.}
-
-interface
-
-uses
- Classes, O32Vldtr;
-
-var
- ValidatorList: TStrings;
-
-procedure RegisterValidator(ValidatorClass: TValidatorClass);
-procedure UnRegisterValidator(ValidatorClass: TValidatorClass);
-procedure GetRegisteredValidators(aList: TStrings);
-
-implementation
-
-procedure RegisterValidator(ValidatorClass: TValidatorClass);
-begin
- if ValidatorClass.InheritsFrom(TO32BaseValidator) then begin
- if ValidatorList.IndexOf(ValidatorClass.ClassName) = -1 then begin
- RegisterClass(TPersistentClass(ValidatorClass));
- ValidatorList.Add(ValidatorClass.ClassName);
- end;
- end;
-end;
-{=====}
-
-procedure UnRegisterValidator(ValidatorClass: TValidatorClass);
-var
- i: Integer;
-begin
- i := ValidatorList.IndexOf(ValidatorClass.ClassName);
- if i > -1 then begin
- ValidatorList.Delete(i);
- UnRegisterClass(TPersistentClass(ValidatorClass));
- end;
-end;
-{=====}
-
-procedure GetRegisteredValidators(aList: TStrings);
-begin
- Assert(Assigned(ValidatorList));
- Assert(Assigned(aList));
-
- aList.Clear;
- aList.BeginUpdate;
- aList.Assign(ValidatorList);
- aList.EndUpdate;
-end;
-
-initialization
-
- ValidatorList := TStringList.Create;
- ValidatorList.Add('None');
-
-
-finalization
-
- ValidatorList.Free;
-
-end.
diff --git a/Source/3rdParty/Orpheus/o32vpool.pas b/Source/3rdParty/Orpheus/o32vpool.pas
deleted file mode 100644
index b5ca663f..00000000
--- a/Source/3rdParty/Orpheus/o32vpool.pas
+++ /dev/null
@@ -1,312 +0,0 @@
-{*********************************************************}
-{* O32VPOOL.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 o32vpool;
- {O32ValidatorPool component classes}
-
-interface
-
-uses
- OvcBase, Classes, Graphics, stdctrls, O32Vldtr, o32ovldr, {$IFNDEF LCL} o32pvldr, {$ENDIF} o32rxvld;
-
-type
- TO32ValidatorPool = class;
-
- TVPoolNotifyEvent =
- procedure (Sender: TObject; ValidatorItem: Integer) of object;
-
-
- { - TO32ValidatorItem - }
- TO32ValidatorItem = class(TO32CollectionItem)
- protected {private}
- FValidator : TO32BaseValidator;
- FValidationEvent : String;
- FValidatorClass : TValidatorClass;
- FValidatorType : String;
- FBeepOnError : Boolean;
- FMask : String;
-
- {Component for which this item will validate}
- FComponent : TCustomEdit;
- FComponentColor : TColor;
- FErrorColor : TColor;
- {Event for which this object will execute a validation}
- FEvent : TValidationEvent;
-
- procedure DoValidation(Sender: TObject);
- procedure SetComponent(Value: TCustomEdit);
- procedure SetValidatorType(const Value: String);
- procedure AssignValidator;
- procedure SetEvent(Event: TValidationEvent);
- procedure AssignEvent;
- function ValidatorPool: TO32ValidatorPool;
- public
- constructor Create(Collection: TCollection); override;
- property Validator: TO32BaseValidator
- read FValidator write FValidator;
- property ValidatorClass: TValidatorClass read FValidatorClass
- write FValidatorClass;
- published
- property BeepOnError: Boolean
- read FBeepOnError write FBeepOnError;
- property Name;
- property ErrorColor: TCOlor
- read FErrorColor write FErrorColor;
- property Component: TCustomEdit
- read FComponent write SetComponent;
- property Mask: String
- read FMask write FMask;
- property ValidationEvent: TValidationEvent
- read FEvent write SetEvent;
- property ValidatorType : string
- read FValidatorType write SetValidatorType stored true;
- end;
-
- TO32Validators = class(TO32Collection)
- protected {private}
- FValidatorPool : TO32ValidatorPool;
- function GetItem(Index: Integer): TO32ValidatorItem;
- public
- constructor Create(AOwner : TPersistent;
- ItemClass : TCollectionItemClass); override;
- function AddItem(ValidatorClass: TValidatorClass): TCollectionItem;
- procedure Delete(Index: Integer);
- procedure DeleteByName(const Name: String);
- function GetValidatorByName(const Name: String): TO32BaseValidator;
- property ValidatorPool: TO32ValidatorPool
- read FValidatorPool;
- property Items[index: Integer]: TO32ValidatorItem
- read GetItem;
- end;
-
- { - TO32ValidatorPool - }
- TO32ValidatorPool = class(TO32Component)
- protected {private}
- FValidators: TO32Validators;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- published
- property Name;
- property Validators: TO32Validators
- read FValidators
- write FValidators;
- end;
-
-implementation
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, MyMisc, {$ENDIF} SysUtils, Controls, Dialogs;
-
-{===== TO32ValidatorPool =============================================}
-
-constructor TO32ValidatorPool.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
- FValidators := TO32Validators.Create(self, TO32ValidatorItem);
-end;
-{=====}
-
-destructor TO32ValidatorPool.Destroy;
-begin
- FValidators.Free;
- inherited Destroy;
-end;
-
-
-{===== TO32Validators ================================================}
-constructor TO32Validators.Create(AOwner : TPersistent;
- ItemClass : TCollectionItemClass);
-begin
- inherited;
- FValidatorPool := TO32ValidatorPool(AOwner);
-end;
-{=====}
-
-function TO32Validators.GetValidatorByName(const Name: String): TO32BaseValidator;
-var
- i: Integer;
-begin
- for i := 0 to Count - 1 do begin
- if TO32ValidatorItem(Items[i]).Name = Name then begin
- result := TO32ValidatorItem(Items[i]).Validator;
- exit;
- end;
- end;
- result := nil;
-end;
-{=====}
-
-function TO32Validators.AddItem(ValidatorClass: TValidatorClass):
- TCollectionItem;
-var
- NewItem: TO32ValidatorItem;
-begin
- NewItem := TO32ValidatorItem(inherited Add);
- NewItem.ValidatorClass := ValidatorClass;
- NewItem.Validator := ValidatorClass.Create(FValidatorPool);
- result := NewItem;
-end;
-{=====}
-
-procedure TO32Validators.Delete(Index: Integer);
-begin
- TO32ValidatorItem(Items[Index]).Validator.Free;
- {$IFDEF VERSION5}
- inherited Delete(Index);
- {$ENDIF}
-end;
-{=====}
-
-procedure TO32Validators.DeleteByName(const Name: String);
-var
- i: Integer;
-begin
- for i := 0 to Count - 1 do begin
- if TO32ValidatorItem(Items[i]).Name = Name then begin
- TO32ValidatorItem(Items[i]).Validator.Free;
- {$IFDEF VERSION5}
- inherited Delete(i);
- {$ENDIF}
- exit;
- end;
- end;
-end;
-{=====}
-
-function TO32Validators.GetItem(Index : LongInt) : TO32ValidatorItem;
-begin
- result := TO32ValidatorItem(inherited GetItem(Index));
-end;
-
-{===== TO32ValidatorItem =============================================}
-type
- TProtectedCustomEdit = class(TCustomEdit);
- TProtectedWinControl = class(TWinControl);
-
-constructor TO32ValidatorItem.Create(Collection: TCollection);
-begin
- inherited;
- SetName('ValidatorItem' + IntToStr(Collection.Count));
- FErrorColor := clRed;
- FBeepOnError := true;
-end;
-{=====}
-
-procedure TO32ValidatorItem.DoValidation(Sender: TObject);
-begin
- if not (csDesigning in ValidatorPool.ComponentState)
- and (FValidator <> nil) then begin
- { set the validator's values }
- FValidator.Mask := FMask;
- FValidator.Input := FComponent.Text;
- { execute validation }
- if not FValidator.IsValid then begin
- { beep or not }
- if BeepOnError then MessageBeep(0);
- TProtectedCustomEdit(FComponent).Color := FErrorColor;
- FComponent.SetFocus;
- end
- else
- if (FComponent is TCustomEdit) then
- TProtectedCustomEdit(FComponent).Color := FComponentColor;
- end;
-end;
-
-procedure TO32ValidatorItem.SetComponent(Value: TCustomEdit);
-begin
- if (Value is TCustomEdit) and (FComponent <> Value) then begin
- FComponent := Value;
- FComponentColor := TProtectedCustomEdit(FComponent).Color;
- AssignEvent;
- end;
-end;
-{=====}
-
-procedure TO32ValidatorItem.SetEvent(Event: TValidationEvent);
-begin
- FEvent := Event;
- AssignEvent;
-end;
-{=====}
-
-procedure TO32ValidatorItem.AssignEvent;
-begin
- if (FComponent <> nil) then
- case FEvent of
- veOnChange:
- TProtectedCustomEdit(FComponent).OnChange := DoValidation;
- veOnEnter :
- TProtectedCustomEdit(FComponent).OnEnter := DoValidation;
- veOnExit :
- TProtectedCustomEdit(FComponent).OnExit := DoValidation;
- end;
-end;
-{=====}
-
-procedure TO32ValidatorItem.SetValidatorType(const Value: string);
-begin
- if FValidatorType <> Value then begin
- FValidatorType := Value;
- AssignValidator;
- end;
-end;
-{=====}
-
-procedure TO32ValidatorItem.AssignValidator;
-begin
- if (FValidatorType = 'None') or (FValidatorType = '')then
- FValidatorClass := nil
- else try
- FValidatorClass := TValidatorClass(FindClass(FValidatorType));
- except
- FValidatorClass := nil;
- end;
-
- if FValidatorClass <> nil then
- FValidator
- := FValidatorClass.Create((Collection as TO32Validators).FValidatorPool);
-end;
-{=====}
-
-function TO32ValidatorItem.ValidatorPool: TO32ValidatorPool;
-begin
- Result := TO32Validators(Collection).FValidatorPool;
-end;
-{=====}
-
-end.
diff --git a/Source/3rdParty/Orpheus/orpheus.lpk b/Source/3rdParty/Orpheus/orpheus.lpk
deleted file mode 100644
index 5be49204..00000000
--- a/Source/3rdParty/Orpheus/orpheus.lpk
+++ /dev/null
@@ -1,59 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/orpheus.pas b/Source/3rdParty/Orpheus/orpheus.pas
deleted file mode 100644
index 43c0c3c7..00000000
--- a/Source/3rdParty/Orpheus/orpheus.pas
+++ /dev/null
@@ -1,21 +0,0 @@
-{ This file was automatically created by Lazarus. Do not edit!
-This source is only used to compile and install the package.
- }
-
-unit Orpheus;
-
-interface
-
-uses
- MyOvcReg, LazarusPackageIntf;
-
-implementation
-
-procedure Register;
-begin
- RegisterUnit('MyOvcReg', @MyOvcReg.Register);
-end;
-
-initialization
- RegisterPackage('Orpheus', @Register);
-end.
diff --git a/Source/3rdParty/Orpheus/ovc.inc b/Source/3rdParty/Orpheus/ovc.inc
deleted file mode 100644
index 6067cda7..00000000
--- a/Source/3rdParty/Orpheus/ovc.inc
+++ /dev/null
@@ -1,189 +0,0 @@
-{*********************************************************}
-{* OVC.INC *}
-{*********************************************************}
-
-{* ***** 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 ***** *}
-
-{Conditional defines that affect compilation}
-
-(*
-{$Q-} {Overflow Checking}
-{$R-} {Range-Checking}
-{$S-} {Stack-Overflow Checking}
-*)
-
-{$IFDEF OrphChecksOn}
- {$Q+,R+,S+}
-{$ELSE}
- {$IFDEF OrphChecksOff}
- {$Q-,R-,S-}
- {$ELSE}
- {$IFOPT Q+}
- {$Q+}
- {$ELSE}
- {$Q-}
- {$ENDIF}
-
- {$IFOPT R+}
- {$R+}
- {$ELSE}
- {$R-}
- {$ENDIF}
-
- {$IFOPT S+}
- {$S+}
- {$ELSE}
- {$S-}
- {$ENDIF}
- {$ENDIF}
-{$ENDIF}
-
-{$V-} {Var-String Checking}
-{$T-} {No type-checked pointers}
-{$X+} {Extended syntax}
-{$P-} {No open string parameters}
-{$B-} {Incomplete Boolean evaluation}
-{$J+} {Writable constants}
-{$H+} {Huge strings}
-
-{General define indicating use under C++ Builder}
-{$IFDEF VER93}
- {$DEFINE CBuilder}
-{$ENDIF}
-{$IFDEF VER110}
- {$DEFINE CBuilder}
- {$ObjExportAll On}
-{$ENDIF}
-{$IFDEF VER125}
- {$DEFINE CBuilder}
- {$ObjExportAll On}
-{$ENDIF}
-{$IFDEF VER130}
- {$IFDEF BCB}
- {$DEFINE CBuilder}
- {$ObjExportAll On}
- {$ENDIF}
-{$ENDIF}
-{$IFDEF VER140} {!!.04}
- {$IFDEF BCB} {!!.04}
- {$DEFINE CBuilder} {!!.04}
- {$ObjExportAll On} {!!.04}
- {$ENDIF} {!!.04}
-{$ENDIF} {!!.04}
-
-{$IFNDEF VER80} {Delphi 1.0}
- {$DEFINE VERSION2} {Delphi 2.0 and BCB 1 or higher}
-{$ENDIF}
-
-{$IFDEF VERSION2}
- {$IFNDEF VER90} {Delphi 2.0}
- {$IFNDEF VER93} {BCB 1.0}
- {$DEFINE VERSION3} {Delphi 3.0 or BCB 3.0}
- {$ENDIF}
- {$ENDIF}
-{$ENDIF}
-
-{$IFDEF VERSION3}
- {$IFNDEF VER100} {Delphi 3}
- {$IFNDEF VER110} {BCB 3}
- {$DEFINE VERSION4} {Delphi 4.0 or higher}
- {$ENDIF}
- {$ENDIF}
-{$ENDIF}
-
-{$IFDEF VERSION4}
- {$IFNDEF VER120} {Delphi 4}
- {$IFNDEF VER125} {BCB 4}
- {$DEFINE VERSION5} {Delphi 5.0 or higher}
- {$ENDIF}
- {$ENDIF}
-{$ENDIF}
-
-{$IFDEF VERSION5}
- {$IFNDEF VER130} {Delphi 5}
- {$IFNDEF VER135} {BCB 5}
- {$DEFINE VERSION6} {Delphi 6.0 or higher}
- {$ENDIF}
- {$ENDIF}
-{$ENDIF}
-
-{$IFDEF VERSION6}
- {$IFNDEF VER140} {Delphi 6}
- {$IFNDEF VER145} {BCB 6}
- {$DEFINE VERSION7} {Delphi 7.0 or higher}
- {$ENDIF}
- {$ENDIF}
-{$ENDIF}
-
-{$IFDEF VERSION2}
- {$IFNDEF VERSION3}
- {$DEFINE VERSION2ONLY}
- {$ENDIF}
-{$ENDIF}
-
-{$IFDEF VERSION3}
- {$IFNDEF VERSION4}
- {$DEFINE VERSION3ONLY}
- {$ENDIF}
-{$ENDIF}
-
-{$IFDEF Win32}
- {$A+} {Word Align Data}
-{$ELSE}
- {$A-} {Byte Align Data}
-{$ENDIF}
-
-{$IFDEF VERSION6}
- {$IFNDEF FPC}
- {$WARN SYMBOL_PLATFORM OFF}
- {$ENDIF}
- {$IFDEF VERSION7}
- {$B- Incomplete boolean evaluation}
- {$H+ Long string support}
- {$J+ Writeable typed constants}
- {$P- No open string parameters}
- {$T- No type-checked pointers}
- {$V- No var string checking}
- {$X+ Extended syntax}
- {$Z1 Enumerations are word sized}
- {$IFNDEF FPC}
- {$WARN UNIT_PLATFORM OFF}
- {$WARN UNSAFE_CODE OFF}
- {$WARN UNSAFE_TYPE OFF}
- {$WARN UNSAFE_CAST OFF}
- {$WARN UNIT_DEPRECATED OFF}
- {$ENDIF}
- {$ENDIF}
-{$ENDIF}
-{ This define turns off all platform warnings in Delphi 6. Delphi 6 }
-{ is cross-platform compatible with Kylix and all of Orpheus' Win32 }
-{ only stuff causes the compiler to throw a truckload of platform }
-{ warnings when rebuilding packages. }
-
-{.$DEFINE ZeroDateAsNull}
-{This define enables special handling for a zero date. If defined, }
-{assigning 0 to a date field is treated the same as assigning the }
-{constant "BadDate" (see manual) using the AsDateTime property. }
-{Otherwise, 0 is treated as a valid date. (32-bit only) }
diff --git a/Source/3rdParty/Orpheus/ovcabot0.lfm b/Source/3rdParty/Orpheus/ovcabot0.lfm
deleted file mode 100644
index cc6680b3..00000000
--- a/Source/3rdParty/Orpheus/ovcabot0.lfm
+++ /dev/null
@@ -1,1290 +0,0 @@
-object OvcfrmAboutForm: TOvcfrmAboutForm
- Left = 202
- Top = 223
- BorderStyle = bsDialog
- Caption = 'About Orpheus'
- ClientHeight = 311
- Height = 311
- ClientWidth = 472
- Width = 472
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- OnCreate = FormCreate
- PixelsPerInch = 96
- object TBevel
- Left = 6
- Top = 265
- Width = 451
- Height = 17
- Shape = bsTopLine
- end
- object TLabel
- Left = 152
- Top = 8
- Width = 59
- Height = 16
- Caption = 'Orpheus'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -13
- Font.Style = [fsBold]
- ParentFont = False
- end
- object TLabel
- Left = 7
- Top = 273
- Width = 232
- Height = 13
- Caption = 'Copyright '#169' 1995-2003 TurboPower Software Co'
- end
- object TLabel
- Left = 7
- Top = 289
- Width = 86
- Height = 13
- Caption = 'All rights reserved.'
- end
- object Label1: TLabel
- Left = 151
- Top = 40
- Width = 290
- Height = 49
- AutoSize = False
- Caption =
- 'Orpheus was released under the Mozilla 1.1 license in January, 2' +
- '003. The project is hosted on SourceForge at sourceforge.net/pro' +
- 'jects/tporpheus.'
- WordWrap = True
- end
- object VisitUsLabel: TLabel
- Left = 153
- Top = 108
- Width = 194
- Height = 13
- Caption = 'Visit the Orpheus project on SourceForge'
- end
- object lblTurboLink: TLabel
- Left = 161
- Top = 124
- Width = 204
- Height = 13
- Cursor = crHandPoint
- Caption = 'http://sourceforge.net/projects/tporpheus/'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clBlue
- Font.Height = -11
- Font.Style = [fsUnderline]
- ParentFont = False
- OnClick = lblTurboLinkClick
- end
- object Bevel3: TBevel
- Left = 152
- Top = 160
- Width = 305
- Height = 96
- Shape = bsFrame
- end
- object GeneralNewsgroupsLabel: TLabel
- Left = 160
- Top = 168
- Width = 113
- Height = 13
- Caption = 'Orpheus support groups'
- end
- object lblHelp: TLabel
- Left = 168
- Top = 198
- Width = 276
- Height = 13
- Cursor = crHandPoint
- Caption = 'http://sourceforge.net/forum/forum.php?forum_id=241874'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clBlue
- Font.Height = -11
- Font.Style = [fsUnderline]
- ParentFont = False
- OnClick = lblHelpClick
- end
- object lblGeneralDiscussion: TLabel
- Left = 168
- Top = 230
- Width = 276
- Height = 13
- Cursor = crHandPoint
- Caption = 'http://sourceforge.net/forum/forum.php?forum_id=241873'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clBlue
- Font.Height = -11
- Font.Style = [fsUnderline]
- ParentFont = False
- OnClick = lblGeneralDiscussionClick
- end
- object Label3: TLabel
- Left = 168
- Top = 217
- Width = 94
- Height = 13
- Caption = 'General Discussion:'
- end
- object Label2: TLabel
- Left = 168
- Top = 186
- Width = 25
- Height = 13
- Caption = 'Help:'
- end
- object Panel1: TPanel
- Left = 6
- Top = 6
- Width = 139
- Height = 251
- BevelOuter = bvLowered
- TabOrder = 0
- object Image1: TImage
- Left = 1
- Top = 1
- Width = 137
- Height = 249
- Align = alClient
- Picture.Data = {
- 07544269746D6170628C0000424D628C00000000000036040000280000008900
- 0000F900000001000800000000002C8800000000000000000000000100000001
- 0000000000000000800000800000008080008000000080008000808000008080
- 8000C0DCC000F0CAA600AA3F2A00FF3F2A00005F2A00555F2A00AA5F2A00FF5F
- 2A00007F2A00557F2A00AA7F2A00FF7F2A00009F2A00559F2A00AA9F2A00FF9F
- 2A0000BF2A0055BF2A00AABF2A00FFBF2A0000DF2A0055DF2A00AADF2A00FFDF
- 2A0000FF2A0055FF2A00AAFF2A00FFFF2A000000550055005500AA005500FF00
- 5500001F5500551F5500AA1F5500FF1F5500003F5500553F5500AA3F5500FF3F
- 5500005F5500555F5500AA5F5500FF5F5500007F5500557F5500AA7F5500FF7F
- 5500009F5500559F5500AA9F5500FF9F550000BF550055BF5500AABF5500FFBF
- 550000DF550055DF5500AADF5500FFDF550000FF550055FF5500AAFF5500FFFF
- 550000007F0055007F00AA007F00FF007F00001F7F00551F7F00AA1F7F00FF1F
- 7F00003F7F00553F7F00AA3F7F00FF3F7F00005F7F00555F7F00AA5F7F00FF5F
- 7F00007F7F00557F7F00AA7F7F00FF7F7F00009F7F00559F7F00AA9F7F00FF9F
- 7F0000BF7F0055BF7F00AABF7F00FFBF7F0000DF7F0055DF7F00AADF7F00FFDF
- 7F0000FF7F0055FF7F00AAFF7F00FFFF7F000000AA005500AA00AA00AA00FF00
- AA00001FAA00551FAA00AA1FAA00FF1FAA00003FAA00553FAA00AA3FAA00FF3F
- AA00005FAA00555FAA00AA5FAA00FF5FAA00007FAA00557FAA00AA7FAA00FF7F
- AA00009FAA00559FAA00AA9FAA00FF9FAA0000BFAA0055BFAA00AABFAA00FFBF
- AA0000DFAA0055DFAA00AADFAA00FFDFAA0000FFAA0055FFAA00AAFFAA00FFFF
- AA000000D4005500D400AA00D400FF00D400001FD400551FD400AA1FD400FF1F
- D400003FD400553FD400AA3FD400FF3FD400005FD400555FD400AA5FD400FF5F
- D400007FD400557FD400AA7FD400FF7FD400009FD400559FD400AA9FD400FF9F
- D40000BFD40055BFD400AABFD400FFBFD40000DFD40055DFD400AADFD400FFDF
- D40000FFD40055FFD400AAFFD400FFFFD4005500FF00AA00FF00001FFF00551F
- FF00AA1FFF00FF1FFF00003FFF00553FFF00AA3FFF00FF3FFF00005FFF00555F
- FF00AA5FFF00FF5FFF00007FFF00557FFF00AA7FFF00FF7FFF00009FFF00559F
- FF00AA9FFF00FF9FFF0000BFFF0055BFFF00AABFFF00FFBFFF0000DFFF0055DF
- FF00AADFFF00FFDFFF0055FFFF00AAFFFF00FFCCCC00FFCCFF00FFFF3300FFFF
- 6600FFFF9900FFFFCC00007F0000557F0000AA7F0000FF7F0000009F0000559F
- 0000AA9F0000FF9F000000BF000055BF0000AABF0000FFBF000000DF000055DF
- 0000AADF0000FFDF000055FF0000AAFF000000002A0055002A00AA002A00FF00
- 2A00001F2A00551F2A00AA1F2A00FF1F2A00003F2A00553F2A00F0FBFF00A4A0
- A000808080000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFF
- FF00000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000000000000000000000F700000000
- 0000F5F000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000055FFF000002DF007FFF000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000031F5FF310031FF2D08AF0000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000000000000000F52D000031FFF0F6
- F62D07FF00FF0700000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000007FFF000F5FF31F7FF2D0708F5FFF6F0F7F6F5F559F1000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000F6FF072DAA862DFFF0860707F6F52D
- FF07F0FFFFF00000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000000000000000000000002D00AFFF
- 82F5FFF1FFF0AB3108F700FF5EF0FF0800000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000FFF70008FFEC08310855082DFFECAF82F0FFFF0700000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000F7FFF7000886558207868631
- 08F708F0FFFF07F0F52D00000000000000000000072D0000000000F582AF0831
- 0000003107000000F0F7F52D07F7073100000000000007AAAFAA07000000002D
- F700000000000000000007AAAF08070000000000000031F10000000000310000
- 0000F0070707F707F7002D07000000F0F72D00000000000000000000F0F50000
- F0F5FFAA00D4080831FF82F7F686F1FF0700F5AAFFFFF5000000000000000000
- FF820000000007FFFFAAAFFF86000008FF000000AFFFF0AFFFF6FFFFF6F00000
- 31FFFFAF08AFFFF62D000007FF000000000000002DFFFFAFAAAFFFFF31000000
- 000008070000000000FFF5000000F5FFFFFFFFFFFFF008FF000000AFFFF00000
- 0000000000000000F5F6F6F7F6310008AF00AAFF07083186D1F5F60731AFF686
- 31F0F5550000000000000000FFF7000000F0FF8200000031FF5500AAFF0000F7
- F6F50008080000F0FFAF002DF608F0000000F0AFF6F50007FF0000000000002D
- FF08F0000000F008F63100000000FFF60000000055FF07000000F0FF31000000
- 000086F6000007FFF50000000000000000000000000786FFFFFF82F05A08F186
- 2D00000000F6FF868655F12D07F6FFFF0700000000000000FFF70000005AFF00
- 00000000AF080086F600F0FFF70000AFAA00000007FF00FFAF00000000000000
- F6F60007FF000000000000FFF600000000000000AFF600000007FFFFF5000000
- 08FFF6000000F5FF31000000000086D100F0FFF7000000000000000000000000
- 00F02DF0F55586D108F6F60000000000002D0755F708FFFFF6AF31F000000000
- 00000000FFF7000000AAFF0000000000F7FF0086AF00D108000000AFAA000000
- F7F607FFF000000000000000F5FF2D31FF000000000031FFF500000000000000
- F1FF310000FF86AFF70000F1FFF7FF2D0000F0FF310000000000AA0800D10800
- 00000000000000000000000000F5FFFFAFF7312D31F7F70000000000000008FF
- 8207F0F1313100000000000000000000F6F700000086F6000000000007FF0082
- FF08FF31000000AF0800F007FF07F7FF000000000000000000FF0731F6F7F731
- 0000F7FF000000000000000000FF86002DFFF007FF0000F7FF00D1080000F1F6
- 31000000000086D108FF3100000000000000000000000000000031550782AA86
- AA8231000000000000000782868686F731312D000000000000000000FFF70000
- 0008D1000000000007FF00F7FF0808FF86000008FFFFFFFF070008D100000000
- 0000000000FFF731FFAFF6FFF60082F6000000000000000000AFAA0008FF0000
- FF3100FFF70007FFF000F0FFAF86AAD4860082FF0808FFAA0000000000000000
- 000000000000003131F5F50786FF86000000000000008607312D0782F6FFFFF5
- 0000000000000000FFF700000086F60000000000F7FF0082F60000F5FF070008
- AA002DFF310082FF000000000000000000FF0731FF0000F0FF8607FF00000000
- 0000000000FFF700FF070000AF082DF6F00000FF0700F1FFAFAA0808AA0082D1
- 0000F5FF070000000000000000000000F0F131F6FFF6F6AA0731072D00000000
- 0000FFF608D18631F5F02DF00000000000000000FFF700000008D10000000000
- 07FF0086FF000000AAAB00AF08000007FF0031F6F50000000000000031FFF031
- FF00000055FFF5FF31000000000000002DF6F531FFF0000031FFF6AF00000008
- FF00F0FF31000000000086F600000082AF000000000000000000000082FFF6AF
- 072DF10786AAFF08000000002D082DAA07F086FFFFFF08310000000000000000
- FF0700000086F6000000000007FF0082F600000008080008AA000007FF0000F6
- F600000000000000FFAF0007FF00000007FF0008FF00000000000000FFAF00FF
- 0800000000FFFF310000002DFFF500FF31000000000086AF0000000808F02DF5
- 00000000000000000031F5F03108F6082DF7082DF6F7318607FF08F5AF820059
- FFF7F6F60000000000000000FFF7000000AAF6000000000007FF0086F600F007
- FF3100D10800F5FF080000F1FFF6F50000002DFFFFF00007FF000031FFAA00F0
- FFFF2D0000002DF6FFF0F5F63100000000F7FF0000000000FF86ECFF31000000
- 000086F600F007FF072DF7070000000000000000000031FFF686F100F7AF2D08
- D10708D13186F7AFF008FFF1F00000F5F00000000008FFFFFFFFFFFF2D86F600
- 00000000F7F60086FFFFFFFFF7000008FFFFFF0800000000F0AFF6FFFFFFFF08
- F0000007FFFFFFFF08000000F008FFFFF6FFFF08F000AFF600000000002DF700
- 0000000007FF31F6FFFFFFFFFFF082F6FFFFFF5E002D07070000000000000000
- 00000031F1F0F7FFFFF0AB07082DAA0807862D82F60086FF0700000000000000
- 002D31312D31313100F52D0000000000F13100F131312D00000000F5312DF000
- 0000000000002D07F707F500000000F031312DF0000000000000F5078207F500
- 000031F5000000000000F000000000000031F52D313131313100F131312DF000
- 0000F5000000000000000000000000000007FFF6F00808F0AF318607AA070800
- FFAF0082FF000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000000000000000000000000000000000000000F0AFF600
- 82F60008820782F5F6F5F6F0F7FFF60031000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000F5FFFFF05AFFF131FF5586F72DFFF5AFF7F007FFFF00000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000000000000000000000F007F031FF07F0FFFFF5FF0731
- FF0755FFF000F0FF310000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000007FFF0FF3155F608F1FF2D0000F5F00000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000F6862DFF2D0031FFF03100000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000F5F631
- F0F50000F1F63100000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000F0F5000000000000F70000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000DF4F4F40D0D0CF5F4F4F40D0D0D0DF00000F0F400F4F4F0F50CF500F511
- 1115101111F5F000F0F0F400F00D0C0DF5F4F5110C00F0F100F0F00000F5F50C
- 110DF4F000F000F011F40D0DF4F40D11F4F5F4F5F40D110CF5F0F5F000F0F4F0
- 00F1F0F0F4F00D0C2D35F4F5F42CF429F4352C2C2855582C55544C4C4C797471
- 707194BB98BB98BB95BABB0000000CF00000F40DF4F0F5F0F100000000F000F0
- 00F5F400F5F400F1F400F00C110D0DF0F0F400F000F0F50000F0F5F0F4F0F40D
- F5F000F0F500F000F0F00C0D15F40000F00000F0F5F00000F0F5F0F000F4F4F0
- 00F00D11F4F4F400F0F0F5F4F0F0F0F0F1F43130F4352CF42DF02C2C2C312C28
- 2830552C5554284D4C784C71709895B69994BB94BA95940000000DF10000F50C
- 0D00F4F0F40000F00000F00000F0F0F1F4F5F4F4F0F5F4F5F40C0DF50C0DF500
- 0000F400F0000000F5F0F400F0F0F000F0F0F000F40DF000F5F0000000F00000
- F400F000F0F40000F00D19F000F0F40DF5F0F5F000F00CF1F0F0F0F4F0F40D0D
- F435F428F42DF4292C342D2C2830555058514C4C4C794C4C95BA999894999499
- 9998990000000CF4F0F0F40D0CF0F5F400F00000F00000F000F4F5F4F000F500
- F50DF0F4F50C110C0D0CF4F000F0F4000000F0F411F4F5F0F10000F4F000000D
- 0DF4F00000EC00F0F00000F011F00000F0F500F0F41111F4F1F4110CF4F4F400
- F0F00DF4F0F0F1F0F0F4303031342DF42C2C2C2C2C312C282855542C55544C4C
- 4D7C4D94949598959898999498959800000011F5F411110CF5F0F400F511F400
- F000F000F0F000F40DF4F0F4F400F4F50C0DF00D0C15110CF5F0F0F5F40D110D
- F0F5F400F0F0F0F1F000F00DF4000D110D11110D110CF0F10DF4F400F0F4F0F5
- 11101111F0F41111F4F5F4F000F10CF0F0F0F42C313031313031302C2C2C2D2C
- 2C592C282854555055544D4C4C7970989998999899999498999899000000F4F0
- F0F0F50D0CF0F5F0F0F5F00000F00000F0F5F5F0F400F0F1F0F0F0F40D0CF0F4
- 0D11150DF4F0F40DF5F4F4F0F0F40CF4F40000F0F100F00D11F0F40C0CF50C0D
- F40DF4F0F0F4F500F0F5F0F41515100DF40D0C0DF4F4F5F0F0F00DF4F4313130
- 59315834553055312C2C2C2C50592C502855545059504C4C7578999499949899
- 94989995BA9598000000F5F000F0F40CF5F0F4F0F0F4F000F000F00000F0F4F5
- F4F1F4F4F0F5F0F50C0DF5F40C0D11F50CF5F0F0F411F0000D0D0D110DF000F0
- F000F000F515110D110D0C0D110D00F000F50CF5F0F41035111111F4F4110D11
- F4F5F4F0F0F00C2D3058345934595959595854555455502C2C592C2950545950
- 7C554C4C5079989994999598BB989899989998000000F4F0F0000D11F4F1F4F1
- F4F500F00000F000F000F0F0F4F000F5F400F4F4F50C0DF40D0D0CF0F5F0F0F4
- F5F40D0CF4F000F5F0F000F0F400F000F0F4F4F4F4F4F5F4F4F4000000F0F411
- 0C0D1515111111F5F00C0C31F4F4F5F0F0F43130353559595958590303595958
- 55035554555950505055555059744C71749C9598999898999499989499989900
- 0000F4F5F4F4F40D0CF4F0F400F4000000F000F00000F0F1F4F0F4F400F4F00D
- F40D0C11150CF4F50C0C0DF400000D0CF500F0F0F00000F10000F000F4000D11
- 0D0D10111111F0F5F4F000F1F40DF0F50C390CF4F0F51111F4F5F4F0F02D3035
- 5459585958590359597D0359545554595903515050557C507D784D4C749998BB
- 989499BA999899BB9899940000000CF4F411110CF5F0F5F0F4F1F4F5F000F000
- F0F1F4F0F500F1F4F1F0F1F4F40D0C111100F5F40DF5F40DF4F00D0DF4F0F5F4
- F5F4F4F4F5F0F000F5340D0C0D0C0DF40D0CF0F00D00F4F40C11F40C0D10F5F0
- F40D3011F430F5F02C313455355859035D03597D0303597C59547D54545D5403
- 557C55507D547070759899989899989998999498989998000000F50C351511F4
- F4F0F4F1F0F4F40DF0F0F0F1F40DF4F0F4F4F0F4F0F4F00DF40D0D0C11F0F0F4
- F0F011F4F5F40CF4F500F0F4F4F100F0F4F0F03111110C0D0C0D110C110D00F0
- F4F40D393511393939110C0DF00C1539F50CF5F4303031585959035959595C59
- 7D597C597C7D547978597D037D037D547D795071749998999998999899BA9999
- BA9598000000302D0CF50CF5110DF0F4F0F500000DF0F0F0F000F40DF4F1F0F4
- F5F0F00CF510113915F50DF4F5F0110DF00D11110CF0F50DF0F0F0F5F000F511
- 100D0D0C0D0DF40D0CF5F0F4F1F0F4110C35110DF40DF4110C3939350C31F42C
- 3135543558595903807D598059807D7C597C7D7C7DA07879787D78797C787474
- 74BB98989899BA98989998989998990000000D0C0D0C0DF40D0CF4F4F1F400F0
- 11F0000000000D0DF4F0F0F5F4F0F4F5F411100D11F4F0F0F400F515F4F40DF4
- 0DF0F0F4F400F0F0F0F0F0F4F50D0C0D0C0C0D0C0D0CF40D0C00F00DF40D0CF4
- F0F4F00D353939112C0DF42C31545958595903595D59807D807D7C7DA4A5A5A0
- A1A0A1A0A1A09D78797974759998999899989999999898BB9499980000003031
- 0C11F4F4F1F0F5F0F4F4F000F4F000F0F000F0F0F4F5F4F4F1F4F50C0D1111F4
- F4F0F40D0DF4F00C0D15350C0DF4F1F4F5F0F0F5F000F0F5F40C110D110D3011
- 110DF0F5F4F50C110DF40DF5F435310CF01035350C3031303134595903598159
- 7C7C5D7D807DA5A4A5C6A4C6A5A4A5A0A0A1A0A19C9C79747499989998999898
- BA999998999894000000313435390D0CF4F4F4F5F0F500F0F5F0F000F00000F0
- F4F0F0F4F4F0F40D103911F4F5F00DF4F00D35F40C0DF4F5F4F40C110C00F0F0
- F5F0F0F41115F4F4F4F5F5F40CF5F0F43530F5F4F40CF0303D3911350C353435
- 0D303031543154585903038159817C7DA5A4C6A5C6A5A4A5C6A5A0C7A0A1A0A1
- A19C9C9D9C987598959899999898999894999900000030350CF5F4F5F5F411F4
- F4F4F000F4F40DF000F0F0F0F5F4F5F5F4F5F40D11391139F4F0F4F500F4F4F5
- 0D39110C0D0D39150DECF0F4F000F40D0DF43535390CF4F5F0F000F5F4F5F4F0
- F5353911350C2C3131113535303131303154595503597D037D7C81A4A4C7A4C7
- A4C6C7C7A4A4C7A4A1A4A0A0A09DA09D9C9D9899749994989998949999989400
- 000031350DF40D0CF4F4F5F4F4F500F0F5F50DECF0F000F0F4F4F00CF4F4F40D
- F4310C350DF00DF4EC0CF5F4F0F0F0F50CF0F5F40D00F4F5F0F0F1F4F40C110C
- 0DF4F50C0D31F0F0F00C0D350C3939350C350DF4F43134353031303055585558
- 597D03817C81A4A5CBA4C7A8C6A9A4A4A4C7A4C7A4A0C3A1A1A09D9C9D9C9D98
- 989598999499989998949900000030350C3011340DF400F4F5F4F0F0F4F0F400
- 00F0F0F0F5F4F5F40D35F5F4F00D0DF4F4F4F4F5F4F5F40CF50C00F00D00F0F0
- F4F0F0F4F1F0F4F41139393535F4F00D3030F0F4F42D2C303130303130313031
- 30312C353031305554555859037D037D7DA4C7A4C6CBA4CAA5C6CBC6C7A4C6A4
- C7A5A0A0A0A1A09DA09D9C9C7598719499949994989994000000353535393939
- 39F5F0F5F4F500F0F5F4F5F4F0EC0D300DF4F431F4F40C0DF430F42D2C312C2C
- 2DF4F5F43135F0F00CF0F5F4F5F0F5F4F0F0F0F431F4F5F0F5F4F4390DF52C2C
- 31303130303130313031303130353534313031303154555459037D7CA5A5A4CB
- A4CAC7CAA4CBA4A9C6A9C7A4C6A4C7A1A0A1A0A09D9C9D9C9998997494759499
- 95949900000035300D2C1135F0F0F0F4F4F4F0F0F4F4F435F5F00C0DF0F4F539
- 0DF0313030313130303031302C302C2C0DF4300D0DF0F0F4F4F0F0F4F1F0F535
- 0D0CF4F4F431F0F12C2C30313031305531543154313031303134353130353055
- 545558597C7D7C7DA4A4C7C6A8C7A8C7CACBC6CAC7C6A4C7A4C7A4A4C2A1A09D
- A09D9C9D9C987594997194709499940000003031300D3534F4F1F00DF42DF0F0
- 0DF4F530F0F0F5F534350C2C2CF0313031303430313130313031302D2C2C310D
- 0CF0F5F431F0F4F5F0F0F435300D35343530F42C302D31305530593054355435
- 303154313035595C355D59305455037903597CA5A4C7CAA9C6CBC6CACBA4CAA5
- C6A8C7CAA5C6A4C3A5A0A1A09DA09D9C9D9D7498717098719994950000003130
- 31303135F4F0F00CF50CF0F031F4F40DF0F030F435F42DF4F530303558595535
- 5430313031303130302D2C2C31F0F4F50CF0F52CF4F0F50C0D3039353935302D
- 2C30305530595459595859545954355459303535035D5C5955545558797C7DC6
- A4CBA4C7CAA4CAA5CACAC7CACAC7A4C6A5C6A5A4A0A5A0A1A09D9C9D9C9C9971
- 74987170707170000000583158313035F4F0F0310CF5F0F00CF5F431F4F03130
- 312CF42C2C595859590358595959585534315431303031302DF02C0C31F0F4F5
- F4F4F4313130F42D2C312C30313055545903590359035959585554555455585D
- 5D5D595C5954557C597CA5A5C6A4CAA4CBCBCACAA5CAA8C7A8CAC7A8C6A5C6A5
- C2A0A1A09DA09D9C9D9C9875707174717070710000005935303154312CF4F530
- F431F0F42DF42C31F0F43130352C2C2D5859597C595959030359595855583130
- 5531302C302CF42D31F0F42CF1F42C3030312C30312C30315455585503595903
- 59597C03595958595459035D615C5D8559540355787DA0C6A5C6C7CAC6A8CACB
- CACAC7CACBC6A8C7A4C6A5C6A5A0A0A1A0A19C7D9C9D78747574717471707000
- 00005958593031302C3534353530F0F435303134F42C3531593031545D5D5C5D
- 5C5D5C59595903595954555431543031552C3130302C2C312C2C2D3139615D5D
- 343055545554595903597C81597C5D5959037D545554555D5C5D595C59545579
- 7C7DA4A5C6A9CAA9CACBCBA4CBCBA8CBC6A9C6C7CAC7A4C7A0C7A1A0A1789D9C
- 9D789D7475707071707071000000035959585431305935303530F03135343159
- 2C2C5D345D30305980818181818181805D7C5959035959545530553030513035
- 352C3130303130305D5D30355455545503597D038159805980597D037C590359
- 587D545D5D5D0359545578037DA0A5C6CBC6C6CAA5CACACBCACACBA4CAC7CAA4
- C7A4C6A5A4A0A0A1A0A17C9D789D78757470754C714C700000005D0359553455
- 3031345D3531282C303130342D2C59355C5D5D818180818081808181805D7C03
- 590303595855545530305534352C31352C3031583559315455545554597C037D
- 7C7D817C817C817D037D597C5558557C5959550351545578797CA5A4A4CBA4CB
- CAA9CACAA9C6CACBA8CACBCAA4C7A4C6C7A4A5A0A19CA178A1789D7851744C75
- 70714C0000008059035955583154316134312C31593055352C54595459618580
- 81858085A481818081818181037D59585503555855542C31592C54312C313035
- 59585855545558597C7D7D7C8180818180817C817D7C7D59037D7C5503590381
- 037D58557CA1A4C7C6A4C7CAC7CACBCACBCACBCACBC6A4C7CAA4C7A4A4A1A0A1
- A0A178A1789D7878744D744C504C4C0000008159590354555431302C31302C30
- 303131582C555C555D85808185A885A9858584818180817C817D037D58555455
- 54555459032C35302C5459595C5D858154597C7D7D81808180A5A5A4A5A5A4A5
- 7C7D7C7C7D7C557C597C597D59808178797CA1C6A4CBCACAA9CAA4CBCACBA8CB
- C6A9CACBA4C7C6A5C7A4A1A0A17CA1789D7879797954504D4C4D4C000000807D
- 035959545554315859312C315930545954555D035D858580A8A9A9A8A8A4A5A4
- A4A5A0A5A17C7D7C7D7C555455545459592C55592C5558815D0355037D7C7D7C
- 817CA5A4A5A4A4A5C6A4A5A4A5A4A17D7C7D7C7903595454547D7C557C7DA4C7
- CAA4A8C7CACACBC6A9CACBCACACBC6A4CAC7A4A4C6A1A4A1A0A178A178797878
- 7C595050504C4C00000081807D0359035554595D58592C54595954595454617D
- 808181A9A9A8A9A9A5A4A5A5A5A4A5A4A4A1A07D7C7D7C555455555C59505859
- 515859035D5D54597C7D7C7D7CA5A8A5C6CBCAA8A5C6A5C6A5A4A0A5A07D7C7D
- 7C81797855037D7879A0A5A4C7C6C7CAA5CACACBCACAC6A9C6A4CBC7A4A4C7A4
- A5A4A1A0A17CA178A178797903555059545954000000807D7C7D7C5558555459
- 5954505558595903795479038585A8A9A8A5A4C6A4A9C6CAA4A9C6A5A5A4A5A0
- A1A07D7C795454595950595850595459858081807D7C7DA4A5CAC7CAA9C6A9C7
- C6A9C6A4A4C7A4A0A1A0A17C7D7C5455787D7D78797CA1C6A4A5C6A4CAC7A8C6
- A9CAA9CACBCACAA4CBCAA4C7A4A5A0A5A0A17CA17C797C78595451582D542D00
- 0000A5A17C7D7C7D7855035958595903550303590355547D808181A8C7A8CAA9
- CBCAA5A8A5C6A5C6A4A4A5A4A17C7D7C9D7C55037D545903557C590385858185
- 7C7DA4A5CACAA4CAC6CBC6CAA8C6A8A5C7A4A5A5A0A17CA1A07D7D78797C7C79
- 7C7DA0C6A5C6C7A4C7A4C7CBCACBCACBCAA9C6CBA8C7A5C6A5C6A4A1A07DA07D
- 7879787903555459542828000000A4A4A17C7D7C7D7859035903855903597D7C
- 5978797C8184A5CAA8CACBCAA8CBCACBCACBA8C6A9C7A4A5A4A1A07D7CA1787D
- 5C55037D5459037D8180798081A0C7CACBCACBA8CBCAA9CAC7A8C7CAA4C7A4A4
- A5A0A1A07DA07C7D7C817D78797CA1A4A5A4A4C7A4C6A8CACBCACBA8CBCAA9CA
- C7A4CAA4C7A4A5A4A1A0A1A07D7C797859543055302C28000000C7A4A5A07D78
- 7D787D7D0359597C590359817C7D787D80A9CACBCAA9CACBCACBA8CBCAA8C7A8
- C6A4C7A4A1A4A1A07D7CA17C7D588159587D7C8184817881A9CACACACAA9CACB
- A8CBCACBCACBA4C7A8A5C6C7A4A1A4A1A0A1A1A07D7C8178797CA1A4A1A4A1A4
- A5CACBCAA9CACACBCACBCAA9CACBC6A9C6A4C7A4A5A07D7CA17C7D0359595431
- 502D2C000000A4A5A4A1A07D7C7DA0787D0354597C7D7C81817C7D7CA5CACBCA
- CBCBCAA9CBCACBCACBCACACBA5CAA4A5C6A5A0A1A0A17CA17879037D787D7C81
- 81857CA1C6CBA8CBCACBCACACBCACAA9CAA4CBCAC6C6A5A4A5A4A1A0A1A0A0A1
- A0817C797C797CA1A4A1A4A5CAA9CACBCACBCBCAA9CACBCACAA4CBA4C6A5A4A4
- A5A0A5A07D7C7D545D5C5D59302C2C000000C7A4C7A4A17C7DA0797D7C7D8181
- 7C817C79807D7CA5CACBA8CBCACECBCACACBCACBA8CBCBA4CAC6A5C6A5A4A1A0
- A17CA1A0A17C7D8055807D8085A8A5A4CACACBCAA9CACBCACBCAA9CACACBCAA4
- CBA5A4C7A4A4A1A0A1A0A1A1A0A57C7D7C7DA0A1A0A5A0C7CACBCACBCACBCACB
- CACACBCAA9CBC6A8C7A8C7A5A4A5A07D80A17D7C5D595930313031000000A4A5
- A4A5A0A1A07DA09CA17C857C7D7D7C798081A9CACBCACFCACBCBCECBCBA8CBCA
- CBA8CACBCAA5C6A4C7A4A1A0A0A1A0A1A0A17C7D787D7C81A985A5CACBCACBCA
- CBCACBA9CACBCACBCBA8C7CAA4CAC6A5C6A5A4A1A0A1A0A0A1A0A18081A4A57C
- A1A0A5CACACBCACBCACBA8CACBCBA8CBCAA8CBA9C6A5A8C6A5A4A5A07D7C7C7D
- 7C593059305D39000000C6A5C6A0A5A0A17C7D7DA0A17C7D7C8081A07DA0A9CA
- CBCACBCBCACBCACBCACFCACBCACBCAA8C7CAA9C6A4A5A4A5A0A1A0A1A0A0A17C
- 7D7C7D80A9A4A5CAA8CBCACBCACBCACACBCACBCACACBCACBC6A9C6A4C7A4A5A4
- A1A0A1A0A1A0A0A57C7D7CA5A0A5A4CBCACBCACBA8CBCBCBCACBCACBCBCAC6CA
- A9C6A5A4A5A4A580A1817C7D7D585558313030000000A8C6A5A4A5A0A0A1A0A0
- A1A0A17C817D808180A5A4CBCACBCACBCFCACFCBCECBCBCACBCACBCACBA4C6A5
- C6A4C7A0A1A0A1A0A1A0A0A178817DA885A5C6CACBCAA9CACBCACBCBCACBCACB
- CAA9CAA8CBC6A4C7A5A4C6A1A0A1A4A1A0A1A0A580A5A4A5A4A1CACAA9CACBCA
- CBCACBCACBCACBCAA8CBA8CBC6CBA8C7A4A5A4A580807D8080815C8103593500
- 0000C6A5C6A5A0A1A1A0A1A1A0A1A0A581A481A4A5A4CBCACBCACBCECACBCBCA
- CBCBCACBA8CBA8C7A8C6A9C6A5C7A4A1A4A1A0A1A0A1A1A178A580A9A5A4C6CB
- CACBCACFCBCACFCACBCAA9CACBCACBC6CBA4CBC6A4C6A5A0A5A0A1A0A5A0C3A0
- 81A07DA4A5A4C6CBCACBCBCACBCFCACBA8CBA8CBCBCACBC6A9A8C6A5A4A4A580
- 7DA5858581815D5D5D5903000000CBA4C7A4A5A0A0A1A0A0A1A0A1A07C81A4A5
- A9A8CBCACBCACFCBCBCFCACFCBCECBCACBCACBCAC6CBC6A4C6A4A5A4A1A4A1A0
- A1A0A0A07D80A1A8A5A4A9CACBCACBCBCECBCBCACFCACBCBCACBA8CBA4CAC7A4
- C7A5A0A5A0A5A0A1A0A5A0A1A081A4A5A4C7CACBCACBCECBCBCACBCBCBCACBCA
- CAA9CAA9CAC6A9A8A5A5A481848584858485805D5C5D59000000C6A5C6A5C6A5
- A4A1A1A0A0C7A0A1A1A481A4A0A5CACFCACFCACFCACBCFCACBCBCACBCACBCAA9
- CAA8C7CAA5C6C6A0A1A0A1A4A1A5A1A0A0A580A5A4A1CACACBCBCACACBCECBCB
- CACBCACBCACBCACACBC6A8C6A4C6A5A4C7A0A5A0A1A0A5A0A5A0A5A4A1A4A9CA
- CBCACBCACFCBCACECBCBCACBCBCACBCAA9CAA5A4A8A980A9ADA8858585858581
- 5D5C5D000000A9C6A4C6A5A0A1A0A0A1A0A1A0A0A0A5A4A5A1A8CBCACBCACBCA
- CBCECBCBCECACFCBCACBCACACBC7A8C7C6A5A4C7A4A4A0A1C2A0A0C7A0A5A0A9
- A4A5C6CBCACACBCFCACBCACFCBCACBCAA9CACBCAC6A9C6A5C6A5C6A0A4A1A0C3
- A4A0C7A0A1A481A4A5C6CACBCACBCACBCACBCFCBCBCACBA8CBCACBA8CACBA8CB
- A5A4A9AC8585A98485848160815D5D000000C6A4C7A5C6A0A5A0A1A0A1A0A5C2
- A5A9A4A5A8C6CBCECBCFCBCFCFCBCBCECBCBCBCACBCAA9CBC6A8C6C6A5A4C7A4
- A1C3A1A4A0A1C3A0A1A481A8A9C2CACBCACBCBCACBCBCECBCACBCACBCACBA8C7
- A9C6CBC6A5C6A4C7A1A4A1A4A0A5A0C2A5A4A5A4C3A4CBCACFCBCFCACFCBCACB
- CACBCACBCAA9CBCAA9A5A8A5A8A9ADA985A88585858585615D5C5D000000CAC7
- A4C6A4C7A0A5A0A1A4C2A1A1A4A9A9A4A5A4CBCACBCACECBCACFCACBCFCACAA9
- CACBCACACAC7CAA5C6C6A4C3A4A4A0A0C7A0A4A1A4A1A4A9A5A5CACBCACFCACB
- CECBCBCBCACBCACBCACBCACACACAA5CAA4C7A5A0C6A1A4A1A4C3A0A5A4A1A0A5
- A4C6CBCACBCACBCBCACBCFCACBCFA9CACBCBA8CBA8CAA9A8A9A8A988A9898585
- 8584855C855D5D000000A5CAC7A4C7A4A1A4C3A4A1A4C2A4A1A0ADA4A5CBCACF
- CBCBCBCECBCFCFCACBCFCBCACBCACBA8CBA4CBC6A5C6A5A4C3A5C2A5A0C7A0C2
- A5A4A1A8A4C2A8CBCACBCACFCBCACFCACFCBCBA8CBCACBCAA5CAC6A5C6A4C6A5
- A0C6A1C6A1A4C3A0A57CA1A0A5A4CACBCACBCECBCFCACBCBCACBCBCBA8CACBA8
- CBA8CBA8A9ADA9ADA9AD858885856185615C5D000000CAC6A4C7A4C7A4C2A4A5
- C2A5A1C6A0A5A8A9A4A4CBCACACFCACBCFCACBCBCECACBCBCACBCAC7CACAC6A5
- C6A5C6A5A0A4A5A1C6A0A5C7A0A1A4A9C7A5C6CACBCACBCBCACBCACBCACBCACB
- CACBA8C7CAC7A8C6A5C6A5C6A5A4A0A5C6A1A4C6A0A1A0A5A4C7CACBCBCACBCB
- CACBCFCACFCACACBCBCBA8CBA8CBA9A8ADADA9AD8589A98585858584615D5D00
- 0000C7A4C7A4A4C7A0A5A1C2A5A0C6A4C7A4A5A5A4C7CACBCFCBCBCFCACBCFCA
- CBCBCBCACBCAA9CAA9C6A5CAA4C6A5C6A4C7A0C6A0A5C6A0A4A5A4A9A4A4C6CB
- CACBCECACFCACFCACBCACBCACBCACBCAA5CAC6A5C6C7A4C7A4C3A4C7A0A4C6A5
- A1A0A5A0C7A4CBCBCECBCBCACFCBCACBCBCBCBCBCAA8CBA8CBA9CAA9ADA9ADAD
- 85AD85858984856181605D000000CAC7A8C7C6A4C7A0C6A4A1C7A4C3A4A5A4A4
- A5C6CACBCACFCACFCBCFCACFCACBCACBCACBCAC6CAC7CAC6A5C7C6A4C7A0C7A0
- A5C2A5C2A1A4A5ADA5C6A5CACBCACBCBCACBCBCACBCACACBCAA9C6CACAA5C6C6
- A5A4C6A5A4C6A1A4A4C7A1C6A07DA0A5A4C6CACBCBCBCECBCACBCFCAA9CACBA8
- CBCBA8CBA8A9A8A9ADAD89A9AD85898585858461615D5D000000A8C6C7A4C7A4
- C6A5A1C6A4C2A5A4C6A9A9A5A4A5CBCACBCACBCACBCACBCBCBA8CBCAA9CACBA9
- C6A8C7A4C6A4C7A4C6A5A4C7A4C7A4C7A0A5A4A8A9A4C6CBCACBCACBCACACBCA
- CBCBCBA8CBCACBA4CBCAA5CAC6A5C6C6A5A5C6A5C6A4C7A4A5A0A1A0A5A5A8CA
- CACBCBCBCFCACBCBCECBCACBA8CBCBA8CBA9A8ADA9ADA989A989858985618585
- 605D5D000000C7C6A8C7A4C7A4C6C6A5C6A5C6C3A4A9A4A4A9C6A8CBCFCACFCB
- CECBCFCACBCACBCACBCACAC6CBC6C6CBA5C6A4C7A5C6C6A4C7A4C2A4A5A4A5A9
- CBA4A5CACBCACBCACBCBCAA9CACACACBCACBCACBC6A4CAA5C6C6A5A4C6C6A5C6
- C7A4C6A5A0A1A4A5A4C6C7CBCBCACACBCACBCACBCBCBCBCACBA9CAA9A8A9A9A9
- ADADADAD89A98984858585615D5D5D000000C6A8C7C6C7A4C7A4A5A4C7A4C7A4
- A5CBA4A5A5A4CBCBCACBCBCACBCBCACBCACBCACBCACBA4CBC6A4CBA4C6A4C7A4
- C6A4A5C7C6A4C7A5A0A5A4CBADA5C6CBCACACBCACBCACACBCACBCBCACBA8C6CA
- A5CBC6C7C6A9C6C7C6A5A4C7A4A5A5A4A5C6A5A4A5A5CACBCACBCBCBCBCBCBCB
- CACBA8CBA9CAA9A8CBA9A8ADADA98985858985858561615C615C39000000CAC7
- A4CAA5C6A4C7C6C6A5C6A4C7A4A9A5C6A9A4C7CACBCBCACBCBCACBCBCBA8CBCA
- A9CACBA4CBC6A4C7C6A5C6C7A4C7C6C6A4C7A4C6A4A5A4A4A8C7A4A4CBCBCACB
- CACBCBCACBCACAA9CAC6A9C7CAC6A5CAA4C7A4C6A5C6C7A4C7CACAC7CAA9CAC7
- A4CAA5CAA5CBCACBCACBCACBA9CACBCBCAA9CBA9A8A9A9A984858585855D8585
- 858485615D5D5D000000A5CAC7C6C7A4CBA4C7A4C6A5C6A8CBA8C7A8C7CAA5CA
- CBCACBCACBCBCACBCACBCAC7CAC7CAC6A8CBC6A8C7C6A4C7C6A4C7A4C7A4C7A4
- CBCAC7CBC6A8C7CAA4CACBCAA8CACBCAA9CACBC6CBCAC6CAA5CACBC6CBC6C7A4
- C7A8CBCACBA9CAA9CBC6A9CBCBA5CAA5CAA5CBC6A9CAA5CACBA9CBA8CBA8A9A9
- ADA989A9858985858461605D5D6161605D395D000000CAC7A8C7A8C7C6C7A4CB
- A9CACBCBCACBCACBCAA9C6C7A8C7CAA9CAC6CBC6CBCACACBA8CAA5CAC7C6A5C6
- C6A5C6C6A4C7C6A9CACACACBCAA4CAA8C7CAC6A5CAC7A4CAC7C7C6C6C6CBC6CA
- CAA5CAA5CAC6A4C7A4C7A4CBCACBCACBA8CBCBCBCAA9CBC6A9CAA5CBA4A5A4A9
- C6A5A8A5A4A9A8A5A9A9A9ADA989AD85AD85858585855D5D5C5D5D5D5D5C3900
- 0000C6A9C6C7C6A4C7A4CBCBCACBCBCACBCBCBA9CBC7A8CBA4C7A4C7C6A5A4C7
- A4C6C7A4C6C7C6C7C6A5C6C6A5C6C7A4C7C6A8CACBCACBA8CBCBCAC7CACAA5CA
- C7A4C6A5C6A4C6A5C7A4C6A5C7C6CBC6C6A9C7CAC7A4C7CACBCBA9CBCBCBCBCB
- A9CBCBA9CBA5CBA4C7A9CBA4A5A8A5A4A9A4A584A9A9ADADADA9A98985858584
- 85615C5D5D39595C5D3959000000CBC6CBA4CBC7CACFCBCBCBCFCBCBCBA9CACB
- A8CBC6A9C7CAA5C6A5C6C7A4C6A1C6C6A5C6A4C7A4C6A4C7C6A4C6C6A9CACBCB
- CAA9CACBCACAA9CAA9C6CBA4CAA5CBA4C7C6A5C6A4C6A5C6A4C6A4C7A5C6C6A5
- C6CBCECBCBCFCBCBCBCBA9CBCBA9CBCBA9CBA9CBA9A4A5A5A9A5A9A581A981A9
- ADADADA989AD89A9898585856161615D5D5C3935593835000000C6A9C6CBA4CB
- CBCBCFCFCBCBCBA9CBCBCBCBCBA9CBC7A8C7A9C6A5A4C7A4A5A4A1A1C6A1C6A4
- C7A4C7A4C7C6A5CACACBCACBCACBCACBCBCACBCACBCAA8C7CAC6A4C7A4A5C6A5
- C6A1C6A1C6A1C6A4C6A5C6C7A8CBCBCFCBCBCFCBCFCBCBCBCBCBA9CBCBA5CBA5
- CBA5A9A8A5A8A9A8A9A481A9ADADADADA989A9898589858585845D5C395D0339
- 353535000000A4C7A4C7CBCFCBCFCBCBCFCFCBCBCFCBCBA9CBCBCBA8C7A9C6A5
- C6A5A4C7C6A1A4A0A1A4A1C6A0C7A4C6A4A5CACBCBCACFCACBCACBCAA9CACBCA
- A8CBC6CAA5A5CAA4C7C6A4C6A5A4A5A4A1A4A5C2A5C6A5A4CBCBCFCBCFCBCBCF
- CBCBCFCBCBA9CBA9CBA9CBA9A5A9A5A5A9A5A5A9A98185ADADADADA989AD8985
- 898585856161615D5D393935343530000000C7C6C7CBCFCBCFCFCBCFCFCBCBCF
- CBCBCFCBCBCBA9C7CBA4C7A4A5C6A5C6A5A4A0A1A4A0A5A0A5A4C3A4C7CACBCE
- CACBCACBCACBCACBCACBA8CBCACBCAA9C6CAC6A5C6A4A5C7A4C7A0A1A4A1A0A5
- A4A5C6CBCFCBCFCBCBCFCFCCCBCFCCA9CFCBCBCBA9CBA9A5A9A9A5A9A5A5A9A5
- A9A9ADADAD85ADAD89AD85898585856184615D5C395C3534353535000000A4C7
- A9CBCFCFCBCFCCCFCBCFCFCBCFA9CBCBA9CBCBA9CBA5A5C6A5A5A0A5A0C7A0A1
- A0A1A0A5A0A1A4A1A4CBCACBCFCACBCECBCFCACBCBCACBCACBA4CBC6A8C7A5C6
- A4A5C6A4C2A5C6A0A1A4A5A0A5A4A5CFCBCFCBCFD0CBCBCFD0CBCFCBCBAACBAA
- CBAAA9A9A5A5A581A5A985A9A985ADA9ADAD89A9AD8589858585858561615D5D
- 3539353535340D000000A5A5CBCFCBCFCFCFCFCBD0CBCFD0CBD0CBCBCBA9CBCB
- A5CBA5A5A4A4A5A4A5A0A5A0A17CA1A0A1A4A0A5CACACFCACBCFCBCBCECBCBCE
- CBCBCACBCACBCAA5CAA4C6A5C7C6A5C7A4C6A5A4A1A0A1A4A1A4CBCBCFCBCFCB
- CFCFCFCBCFD0CBD0CBCFCBCBA9CBCBAAA9A9A9A585A581A985A9ADADAD89AD8A
- AD8989858961856185605D5D5C353534353530000000A5CBCFCFCFCBD0CBCFD0
- CFCFD0CBCFCBCBD0CBCBCBA9CBA5CBA5A5A5A0A5A0A5A4A1A0A1A0A1A0A1A5A4
- CBCFCACBCFCACFCACBCACFCBCACFCAA9CACBA8CACBC7A8C6A4A5A0A4A5A4C6A5
- A0A5A4A5A4A5CBCFCBCFCBCFCBD0CBD0CBCFD0CBCCAAAAAAA986818581A58185
- 818185A585AD8AAD85AD86AD8985898585858585615D5D3939353435350C0D00
- 0000A5CFCFCBD0CFCFCFD0CFCBD0CBD0D0CBD0A9CBCBA9CCA5CBA5A5A5A4A1A4
- A1A4A1A4A1A47CA5A4A5A4A4CBCACBCBCECBCBCFCBCFCBCACBCACBCBCACBCAC7
- A4A4C6A5A5C6A4C7A0C7A5C6A17CA1A4A5CBCFCBCFCFCBD0D0CFD0CFD0D0AAAA
- AA868286F7F7F7F7F75DF7818185818585A9AD89AE89AD898589858961856160
- 5D61395C35343535301131000000A9CBD0CFCFD0D0D0CFD0D0CFD0CFCBD0CBCC
- CFAACBA9CBA5A5A5A5A5A0A5A4A1A4A1A481A9AD85A4A5C6CBCFCACFCBCACFCA
- CFCACBCFCBCACBCACBA8CBA8CBC6A5C6A4A4A5A4A5A4C2A5A4A57C81A5A9CBCF
- CBD0CFCFCBD0CFD0AAAAAA86828686F786F786F761F75DF75D5DF7818589AE89
- 85AD89858985898585618561605D5D393535350C11300C000000A9CFCFCCCFCF
- CFD0CFD0CFD0D0D0D0D0D0CBCCCBCCA9CBA9A5A5A5A5A5A1A0A5A0A5A0A985AD
- A5A4A5A9CACBCFCACFCFCBCFCBCFCACBCFCBCAA9CACBCAC7A4CBA4A5C6A5A0A1
- A4A5A4C7A4A4A9A4A5CBCFCBCFCBD0D0CFD0CCAAAA82AA0886868686F7F7F7F7
- F7F75E5D075D5D5DF78989AE898986898989858585856161615D5C3935343535
- 311131000000CBCFD0CFD0D0D0D0D0D0D0D0D0CCAAAAAAAAAAAAA5A6A9A6A5A5
- A581A180A5A1A0A5A0A981A4A9A5A4CACBCECBCBCBCACBCECBCACBCFCAA8CBCB
- CACBA4CBA8C6A5C6A5A4A5A4A1A0A5A0A1A5A981A5CBCFCFD0CFCFCFD0AEAA08
- AA088686828682828686F75E5E5E5D07625D5E5D5D858A858985898985858985
- 6161615D5D5D393534353110310C0D000000CFD0CBCFD0CFD0D0D0D0D0AAAAAA
- AA86AA82AA8282868181F7A5A5A181A1A1A0A5A0A1A47D7DA580A5C7CACBCBCF
- CACFCFCBCBCFCFCACBCBCBCACAA9CACBC6A5C6A5A4A5A4A1A4A5A4A4A5A4A985
- A5A9CBCFCBCFCCD0CCAA08AA8686868686098662865E5E5E5E5E07625D07615D
- 5D8A89898A8986898589856161855D615C3939343535103110310C000000CCCF
- D0D0D0D0D0D0D0ABAA08AA09AAAA8208828682F7F7F781818181817DA4A17CA1
- A07D7C7C81A0A4CACBCFCACBCFCACBCACFCACBCBCECBCAA9CBCAA8C6A9C6A5A4
- A5A4A1A4A1A4A1A5A0A589A9A5CBD0CFD0D0CFAEAA8608860809860986625E82
- 5E5E625E5E5E62075E3D073E5D61868985898585898561856161605D5D393535
- 11340D0D310C0D000000CBD0CFD0D0D0D0AAAA08AA08AAAA09088686868286F7
- F7F7F707077D817D7D81A0A1A4A17D7C81A5A1A8CBCACFCACBCFCBCFCBCFCACB
- CBCACBCACBCBCBA4C6A9C6A5A47DA47DA0A1A4A0A5A0A985A5A5CFCBCFCFD0AA
- 0808860886868662098209625E5E5E5E5E5E5E073A075D073961898689856585
- 6185856161615D395D3934350D3530100D0D30000000CFD0D0D0D0D0ABAA0808
- AB08090886860982868286F7F7F707810781077D81A17D80A17C7D7C8180A1C6
- CBCBCBCBCBCACBCACBCACBCAA9CBCACBA8CAA4CBA8A5A4A4A5A4A1A0A57CA5A5
- A0A58581A5A9CFD0CFD0AA8686860886098609868262625E625E5E5E5E3A073A
- 07393A39073962898562858585616161615D395C3934353530110D310D0C0D00
- 0000CCD0D0D0D0AA08080809AA090886090982866209F7F7F7F75E07F75D0781
- 59817CA1A0818081807DA0A5CACBCAA9CACBCACBCBCBCACBCBCACBA8CBA9CBA4
- A5C6A5A5A47DA47D7CA1A0A0A57C858585A5CFCBD0AA86080808098686096209
- 62095E625E5E3A5E3A073A3A073A390739355D6185858561616161615C5D5D39
- 3535350C110C310C0C3035000000CCD0D0CCAB08090809080986090982860909
- F75E095E5EF7F70707075D07597D7D817C7D5D858180A1A4CBCACBCAA9CAA9CA
- A9CAA9CAA9CBA8CBC6CAA4CBA4A5A480A17C7D7CA57CA581A081858585A5D0CF
- D008868686860886098686625E625F5E5E5E5E3A5E3A36393A353A3939393561
- 616161616161615D395D383534350C11310D0C0D0D0D0D000000AAD0D0088609
- 86098609090986090962820909826282625E5E5E0707075D075D597D7D7C7D80
- 817D7CA5C6A9CACBCACBC6CBCACBCAC7CACBCAA9A9A9A4A8A4A5A5A0817C817C
- 7D7D7CA1A47D858585A5A9CFAA86088608868A6286096209625E625E5E3A5E5E
- 3A3A3A363A353635363535356161616161615D5D5D39393535350D300D300D0C
- 0C310C000000AAD0AA09860909090909860909620909096262095E625E5E5E5E
- 5D5E5D075D5959817C7D5C59817C7DA0A5CAC7A4A5A4A5A8A5A8A5A8A9A8A9A8
- A9A8A9A5A58080817C7D7C7D7C817C817D8085858685CBCF8686868A868A8686
- 86626262625E625E3A5E3A3A363A35363536353511351135355D61615D5D385D
- 39393435100D300D0C0DF40D310C0D000000AACC860909860986098609098609
- 0962625E095E625F625E5E5E5E07075D075D59597D815981805D7C7DA4C7A4A5
- A4A5A4A5A4A5A4A9A8A9A9A9A8A985808081817D7C7D7D7C7D7C7D807C818561
- 8581A9AA8A8AAE8689868A868661F7625E625E3A5E3A3A363A36363635123512
- 353535110D34395D5D395D393435350D310D0C0DF50C0D0C0C0D0C0000008209
- 09860909090909096209630962096309625F625E625E5E5E5D5E39075D07595D
- 595D5C595D7D807D7CA5A4A5A4A5A4A5A4A5A885A9ADA8A9A984A98581818080
- 5D7C7C597C7D807D815D8581615D85AEA98A89AE8A868A868A6262613A5D5E5E
- 3A3A3A3A353635123611351111110D110D0D0C353539343535350C0D0CF40D0C
- 0C0D0C0DF50CF5000000625E5E09620909620909636209626362626362626362
- 5E62625E5E5E0707595D5959595D5D035D5D597C7D7CA57C817C817D8085A9A8
- A9A9A9A984A98485808181817D5D817C597C7D807C5D5D5D8561A98AADAE8689
- 8A898A8562866262625E393A363636361236123511120D110D0D110D0D0D0D0D
- 0C0D11310C0C0D0C0D0DF40DF40DF40C0DF40C0000005E09095F090962096362
- 090963096209636263626262625E623A625D625D625D5D5D5903595D5D5C5D7D
- 037D7C7D7C7D7C8081818485A984AD85A98585858580815C5D80597C7D81037D
- 5D615D6185A989AE898AAD8A868A868A8562615E5D3A3A07393635113611110E
- 0D0D0D0D0D0D0D0D0D0C0D0C0D0C0D0C0D0D0CF50C0C0DF50CF40DF4F4F4F500
- 000063636262095E096362096263626263636263626263626362628686868685
- 8562855D5D595D5D5D5D595C7D7C7D7C7D7D8081818485A8A9AD85A885858085
- 80815D5903595D5D59037D5D8561615D898AAE85AEAD8A898A858A8562626261
- 5E3907393A35110E0D0D0E0D0D0D0D0D0D0D0D0D0D0D0C0DF4F4F50C0DF4F40D
- F4F5F4F4F4F5F4F5F40DF40000005E5E63636363626309636362636363626362
- 6362626262628A8A8A8A898A8585615D5D5D5C595D5C5D5D59037D7D037C7D59
- 808185858585A985848585815D5C5D5C5D59035D0359035D61856185ADAD89AD
- 898A8986898A856685616107393A393A353536110D0D0D0D0D0D0DF50D0D0D0D
- F40DF5F4F5F4F5F4F5F4F5F4F5F4F5F4F5F4F5F4F5F4F500000063625E626362
- 636263626363626362636263626362628A088A8A858A85868A6185855D5D595C
- 595D5839585903597D5903595D8085858485858585858485815D5D59035D3503
- 5D0359616161618589AE898AAD868989868962856262623D073939353935110D
- 0D0D0D0DF50D0D0DF5F5F4F5F5F4F5F4F5F4F4F4F4F4F4F4F4F4F4F4F4F4F4F4
- F4F4F40000005E5F635F62636363626362636362636263626762638A8A8AAE8A
- 8A8A8A89858661615D5D5C350359595D59035558035859585D5D858485858485
- 8461855D5C5D5C5D5935585D595D596161618589AD89A98986898A8A89868985
- 616161395D3935351135350D0D0D0DF50DF5F5F5F5F4F5F5F4F5F4F5F4F0F5F4
- F5F4F1F4F5F4F5F4F5F4F5F4F5F4F50000003A635E625F626362636363626263
- 3E63626362638A0808088A8A8A868986628561855D5D5D5959595859345D5958
- 55595959585D808585858585858580615D5D593559345959355C3538615D85AD
- 85AE898AAD8A85858565856162615D5D3935353535350D0D0D0DF50DF5F5F5F4
- F5F5F5F4F5F1F4F5F4F1F4F0F4F0F4F4F400F4F0F4F4F4F4F4F4F40000005F5E
- 3F63623B6263623F6263636362636263626608088A8A8AAA8A8A868989866161
- 5D5D5D34593435593559345959345958595D5D858485846184615D5D5C5D5835
- 3459353459355D5D616189898989AD8985898A898A8562616161613939353511
- 3511350D0DF5F5F5F4F5F5F5F5F4F1F5F4F4F1F0F4F0F0F5F0F4F500F5F4F4F5
- F4F5F0F5F4F5F40000003A5F5E3B62633B626362633E63626362676263080808
- 08AE8A8A8A898A8689618561615D395D355958593435353434553459345D5C5D
- 85858585855D5C5D595D5935353435353459383D616185AD8589868989868985
- 85898561615D5D3939353535110D110D0DF5F5F5F5F5F4F5F5F5F4F0F1F5F4F1
- F0F500F0F500F4F0F0F1F0F0F0F4F4F0F4F4F40000003B3A3A633B5E633E5F3F
- 6263633E63626362660808088A8AAE8A8A8A868962856161615D5C3558353530
- 593534353535303535595D5D5C615C5D5C5D5D5D5C3534353035313435353535
- 5D618989898989858A89858A8961616161615D39353511340D350C0DF5F4F5F4
- F5F0F5F500F5F5F5F400F1F4F000F4F000F4F1F0F4F0F4F1F400F5F4F1F4F500
- 00003A3A3B5E3E633E5F3F62633E3E63633E636609088A088AAE8A8A86898986
- 898661615D5D395935353435353035353530313530345D5C5D5D5D5D5D5D3958
- 353535303535343535343534396189858589858A89858985618561615D5D3939
- 353411310C0D0D0DF4F5F4F5F5F5F5F0F5F500F400F5F4F500F4F100F4F000F4
- 00F500F4F0F5F4F0F4F4F00000003A3B3A3B3B3A5F3E5E3F3A63633E62636262
- 080808AE8A8AAE898A868A896161615D615D3934353435313431393435303031
- 3135355D5D5D5C5D355C59353435343130313130353535393D61858989858989
- 85898565856161616139393411350C110D0D0C0DF5F5F5F4F1F400F5F400F5F0
- F500F0F40000F0F400F1F0F0F0F0F0F500F400F4F0F1F4000000363A3A3A3B3E
- 3B3B3E633E3E5F3F623F6366080808088AAE8A8A8A89868A858561615D5C5D35
- 3535303531343131350D30303031343534353534353534353531310C310C310D
- 30343961616185858989858985658561856161615D5D39353411310C0D0C0D0C
- F400F5F4F1F5F0F0F1F500F500F500F5F0F000F5F00000F100F400F0F0F5F0F1
- F4F0F0000000123A373A3A3B3A3E3B3A5F3F3E623F623E09088A8A8AAE8A8A86
- 8A8A8589626161615D393934353435313031F40C35300D310D30313535353435
- 35343535300D300D300D0C300D3539613D61858985858985898585856161615D
- 39383535350D0C0D0C0D0CF5F5F5F4F1F4F0F5F1F400F500F400F4F4F400F00D
- F4F4F0F0F0F0F1F400F0F0F400F5F40000001236163A3B3A3B3B3A3F3E3A633F
- 623E6362088A08AE8A8A8A898A85896261616161395D34353531300C3130F40D
- 3510F50C300C31313030310D303131300D300DF40D0C2C0D0D35103539616185
- 858985618561616161615D5D3939350D0C0D0C0D0C0DF4F5F4F400F500F500F4
- 00F500F500F4F4F1F0F100F4F515F4000000F000F4F0F0F1F0F4F40000000E12
- 36123A3B3A3A3B3A3A3F3A3E3F623E8A088A8A8A8A8A8A868A618A616161615D
- 5D39353510300D310C0DF4F41131F4F5F4F50C0C0D310D300D300D0C0DF40CF5
- 0CF50DF40C353539393D61858561858561856161615D5C39393510350D0C0DF4
- 0DF40DF4F0F1F5F400F5F0F1F500F400F0F1F4F4F4F400F4F4110CF4F4F1F0F0
- 00F500F4F0F5F40000000E12121236123B3A3A3B3B3A3F3A3E3F3E62088A8A8A
- 8A86898A86898685616161615D343535310D300D300DF10C11F4F4F4F5F4F5F4
- F4F4F5F40DF4F4F5F4F5F4F5F4F4F40D1011343D15393D616085618561616161
- 61395D393435350C0DF40D0D0CF5F4F1F4F400F5F400F400F0F1F0F1F0F400F5
- 00F0F00DF50D0DF5F4F400F0F000F000F4F0F00000000D0E1212123A123A3B3A
- 3A3A3A3A3F3A3E628A8A8A8A86898A868986656161615D5D383535300D300D30
- 0D0CF4F40D0C0DF4F4F4F0F4F5F4F4F4F4F5F4F4F4F4F4F4F4F5F4F40D350D11
- 34393D5D618561606160615D5C5D393435350C0D0C0D0CF4F5F4F5F0F500F500
- F0F100F500F400F0F0F1F4F0F4F5F00DF4000DF4F00DF40DF4F4F5F0F0F5F400
- 0000060E0E0E121236163A163A3B3A3A3A3A3E3E8A8A868A898A86658A616161
- 61615D393535340D0C0D0C0CF5F4F00D111111F4F0F5F4F5F0F4F5F4F5F4F4F5
- F0F5F4F4F1F4F40DF4390CF4F511393961616161615D5D395D393935350C0D0C
- F50CF4F5F4F4F0F400F400F0F1F400F0F000F5F4F5F400F5F000F4F4F0000000
- 0015110C11110CF0F5F4F0000000F50D060E0E12121236123A3A3A3A3A3A3A3A
- 628A8A8A868A858685866161615D393835340D0D2C0D0CF50CF5F0F40DF40DF4
- F0F4F0F0F5F4F4F4F0F5F0F4F4F0F5F0F4F510110D0D10391039393D3D5C5D5D
- 5D395D5D393435340D0D0C0DF4F4F5F4F500F500F500F5F0F000F400F1F400F4
- 00F0F400F4F0F5150CF0F0F5F00DF5F41115F400F000F40000000DF5F50D060E
- 1212123612163A163A3A163A5E89868986658A6561616161395D3935350D300D
- 0D0CF5F4F40C110C0D0D10F1F4F5F4F4F0F0F1F0F4F0F0F1F0F0F0F0F40D11F4
- 0C11113D1539393D1539395C5D5C39343535310D0C0DF4F5F4F5F4F400F4F0F4
- 00F400F0F100F1F0F0F0F5F0F4F1F4F0F100F40D0DF4F0F40CF4F40D1111F5F0
- F4F5F0000000F5F5DBF50A060E0E12121236121636163A3A15628A628A866186
- 6161615D5D393534350C0D0C0CF5F4F40D0D11F50C0D0DF0F4F4F500F4F0F0F0
- F1F0F0F4F00CF40DF0F4F41111110C0D35153915113511393935353535300D0C
- F5F4F5F4F4F400F5F0F100F000F1F000F0F4F0F4F1F400F400F400F4F400F40D
- 0000000D110DF40DF40CF000F100F4000000F5F5F5F5DBF5060E060E0E121212
- 36123611363A62896161616161613D5D383534350D0C0DF4F5F4F40D0CF4F4F4
- 0CF0F400F4F1F0F0F50D10110CF40D0C11110D150C0D0D0D0C0DF40D15391539
- 101110391138350C0C0DF4F4F4F4F00C0DF0F5F000F0F0F1F0F400F5F0F0F100
- F400F0F5F0F1F0F100F0F10C000000F4F5F4F0F4F4F5F0F0F0F4F0000000F5F5
- F5F5F5F50DF50E0D060E0E110E1112121111396261626161615D5D393935350D
- 0CF50CF4F4F5F40C0DF50DF50DF40DF1F4F4F400F411110C0D110C0D0C0DF4F5
- F4F0F00C11F40D15101539153915111511391115110C110DF40D110D0CF400F4
- F4F5F4F4F4F1F400F400F4F0F1F0F400F400F4F0F0F0F4F5F4F4F4F5000DF40D
- F4F5F500F400F0000000F0F1F5F5F5F5F50DF506F5060E060E060D0611110D39
- 6161615D5D5D393935300D0C0DF4F5F4F4F4F100F4F4F4F4F5F4F4F000F5F0F1
- F0100DF40C11110D11110C0DF4F5F40DF5F40C11153915391539393D11153D3D
- 110C15110C0C0D0DF5F0F000F400F5F0F4F4F1F4F0F1F0F0F400F5F0F0F400F0
- 000C0DF40D0D0DF000F4F00DF4F40C00F0F1F0000000F1F4F500F5F5F5F5F5F5
- 0D0D0DF5DB0D0D0D0D0D0D0D11395D39393935340D0D0CF5F4F5F4F40D11F4F0
- F5F4F5F40CF0F5F0F0F4F000F4F511150D0C0D0C0D100D0DF0F0F000F0F500F4
- 1111101111111015111015111111110D11F5F4F4F000F4F1F0F0F4F4F5F0F400
- F4F0F0F100F4F000F500F5F00011F5F4F4F0F0F4F00DF4DB11150DF000F00000
- 0000F0F500F5F5F0F5F5F5F5F5F5F50D0D0DF50D0D0D110D1539393935340C0D
- 0DF4F5F4F4F4F00D110CF0000CF5F4F4F5F4F400F5F000F0F01110110C0D0C0D
- 0C0D0D0C0000000DF4F4F40D151515151515153915111110111515F4F00CF4F5
- F40D15F400F0F1F000F400F4F100F400F4F100F4F0F0F0000D0CF0F40D0D0C0D
- 0DF4F00D0C110C00F0F0F0000000F400F5F400F5F500F4F5F1F5F4F5F5F40D15
- 110D111115393D1535110DF4F4F4F4F4F50C11F0F0DBF0F00DF4F5F50C0D0DF0
- F4F5F000F40D0DF40D0D0D0D0D0D0C0DF000F00D0DF00D110C11111110111115
- 110D0C0D0DF40DF5000D0DF40C11F5F4F400F0F0F5F0F1F0F0F0F1F400F0F0F1
- 00F000F0101111F4F0F4110C0D0DF4F411DBF50000F000000000F1F000F1F400
- F5F5F0F5F4F5F5F4F5F50C0D0D0D11113915393D15391111F40D150CF50C11F4
- F00DF100F4F4F4F4F5F40D00F0F0F500F0100DF4F40CF40CF40C0D0DF4F4F40C
- F5F0F4111110151111151115100DF5F4F5F0F0F000F0F0F5F0F10000F1F000F0
- 00F0F000F400F0F0F100F0F0F000F00D11150D00F5F00000F411F5F4F5F4F4F4
- F500F000000000F400F4F0F1F400F5F0F5F0F5F4F4F40D110DF40D1115111511
- 1515110C0D0C15110C0DF000F011F0F00DF4F50C0CF5F400F5F4F000F0F51115
- 110D0D0D0D110C0D000000F5F0F000F0110D111011111015110DF4F4F4000000
- 000000F400F000F0F4F4F000F0F000F100F0F000F4F0F00000F00D0C110D0C0D
- 0CF4F5F0F411F4F400F4F50DF400F0000000F0F1F0F100F400F0F1F0F4F1F4F1
- F511DB0D0CF40D10110D0C0D110C0D15151111110D10110CF5F4F0F0F5F4F5F0
- F500F4F0F00000F0F0110CF5F4F4F4F4F4F4F5F4F0F40DF4F4F50C1110111011
- 11111111110CF4F4F500F0F0F000F4F5F00000F4F5DB0DF40000F0F0F0F000F0
- 000000F0F5DA0DF4DB0C1511F0000DF4F511F40D0C0DF40C0D0000000000F000
- F0F0F1F0F5F0F4F1F4F0F0F40CF5F0F41111150D11F411F40D0D0C11110C0DF4
- F0F5110D0C110CDBF4F0F4F4F4F0F500F4F1F000F50CF5F40D11110D11111111
- 110D0CF5F4F4111511111111DBF4F00C0DF500F5F4F0F4F1F4F1F00D00F00000
- F4F0F4F5F0F4F0000000F000F1F4F0F40DF50CF40D11110D0CF5F000F40DF40D
- 1111F50D11F0F0000000F0F400F0F0000000000000F011111111F000F5F50C0D
- 10111515F40C0D10F500F4F5F4F0F40000F5F4F0F1F4F5F4F5F40C0000F0F000
- F00D100D0CF40DF4F4F40CF5F4F500F4F500F5F40D0C110D0CF50C0DF40C0DF4
- F5000000F00000F0000000F0F5F4F5F4111100F4F0F500F010150DF4F4F4F5F0
- 0C1511000DF4F000F00DF4F400F4F4F4F40000000000F50CF100F0F0F4F5F4F4
- F5F4F5F4F511F400F4F4F5F4DB111515F40D0D110CF40DF5F4F511000000F0F1
- F4F4F000F40DF500F0F00000F0F41111110D0C0D111111F400F4F0F5F4F4F0F4
- 111110110DF4F40D0C0DF0F5F400F0000000F00000F000F40DF4F4F5F4F400F4
- F50C00F0F50D0DF40DF50DF4110DF400F5F0F500F511F50DF0F4F5DB0D00F000
- 000000F0F4F000F40D11F4F0F5F4000DF40000000DF40D0C0D15F5F4F5F4F4F5
- 0D150CF4F4F4F4F4F5F40DF4F40D0DF4F5F0F400F0F500F0F111F4F4F5F40DF4
- F4F4F5F4F50D0DF4F4F10D110C111111100D0C11110DF4F4000000F000F00000
- F00000F5F4F0F5F4F4F500F5F40DF00000F4F40CF0F00CF0F5F00000F4F4F400
- 00F4F4F400F5F4F1F000F00000000C110DF4110DDAF5F40DF4F5F4F40DF400F0
- DB0C110D0C0DF400F40DF400F011150D0CF500F5F400F0F000F40DF0F400F500
- F000F000F40DF5F40D0C0D110D11110DF400F0F0F0F00CDB1111101111111111
- 0CF4F4F5F000F000F000F000000000F4F5F4F4F4110C00F4F411F400000D110D
- F50CF50C11F400000D0DF500F00DF5F4F0F4F4F4F400F0000000F50CF5F40DF4
- F5F4F5F4F5F40DF40DF50D0CF5F4F50C0D0DF4F40D0C0DF4F40D10F5F5F40CF5
- F40DF4F50DF4F5F4F5F0F4F000F400F0000C100DF4F5F4F5F4F4F4F5F00000F5
- 0000F40D100D110D101111150DF500F0F0000000000000F000F00000F000F1F0
- 0DF500F5F4000000F4110D0CF40DF4F5150DF00000F0F400F4DB0CF500F5F411
- 0D00F0000000F000F50C0D0D0DF4F00000F0F500F4F0F4F5F000F40D0D0CF40D
- 10111111F4DB0DF400F51100F40DF0F4F0F4F0F4F0F4F500F0F50000F00D0D11
- 0CF40D0C0D0D0DF4000000F0F4F5F4F5111110111111141511F4F0F50000F000
- F000F000F00000F0F00D0CF4000000110D0000000D0CF4110D1011F4F4DBF500
- 00F011F000F0F0F400F4F4F5F000F4000000F0F4F4F50CF4F0F400F0F0F4F400
- 0000F5F4F0F4F50D0C0C0D11DB1115110C0D0DF4F0F4F400F4F5000000F5F4F5
- 0CDBF4F0F5F400F0F10DF4F40D0D0D0C0DF000F0F0F100F4F5F4F500F40C0D0D
- 0C0D0D110CF500F000F0000000F000000000F000F5F4F5F00DF4000CF40000F0
- F50C0D110C0D110C110CF00000F5110000F0F50D0CDBF5000000110000001111
- F0F4110DF4F5F40D11F5F5F4F4F40D0D00F5F4F4F5F50C0CF4F5F410F5F40CF5
- F0F50D00F0F4F5F4F0F0F0F4F1F4F500F0F40000F40DF4F0F50CF4F50CF400F0
- 000C0DF0F000F0F4110D1110111011100DF4F0F4000000F00000F000F00000F0
- F00C0DF00DF5F0110D0000F011110CDB0D0CDB1111110C0000F00DF0F4DBF4F4
- F5F4F00DF400F40000000DDBF0F00DF4F40DF4F50CF4F5F4F5F0F4F0F0F0F5F4
- F411110DF4F40D1110110DF4F0F40DF0F1F40C0DF5F4F5F0F400F4F000F5F0F0
- 00F411150D0D0D0D0D0D0DF400F1F4F00000F5F40D0C11111111111111F400F1
- F000000000F0000000F00000F4F50CF00CF4000DF40000F00CF5F40DF40D0CF5
- F40DF50000F011F0F00DF0F50CF5F4F4F5F011000000F0F0000D110DF4F00D0C
- 110D0C0DF4000000F4F4F4F5F4F41111F4F5F4150D0D0CF0F50000F40CF40D0C
- F5F40DF4F5F0F500F0F00000F50CF5F4F4F4F4F40CF40DF4000000F5F000F4F0
- F00C1110111011150DF4F5F4F000F000F000F000F00000F0F5F4F5F011F5000D
- F500F00000F0F0F4F0F0F500F400F00000F40D00F00DF4F4F4F5F40DF000F400
- 00000C0DF0F40DF4F5F4F5F4F5F4F50CF50000F00D0D0D0CF5F00D0CF5F4F40D
- F4F4110D0CF000110D0D110D0CF000F4F0F0F400F0F000F0F40DF4F411111111
- 1111150D00F4F0F40000F40D0D111111111111110CF50CF0000000F000000000
- 000000F0F0F0F4F4F5F4F4F4F0000000F0F50CF5F4F5F4F40DF0000000F00DF0
- F411F4F0F5F4F411F4000D000000F50000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000F500000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000000000000000000000000000F500
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000000000000000000000000000F5000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000F50000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000F100000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000F000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000000000000024ECECEC24000000000000000000000000
- 00000000000000000000F1000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000000000000000000048F9F9F9F9F9
- EC00000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000ECF9F9F9F9F94800000000000000000000000000000000000000
- 0000F00000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000000000000000000000F9F9F9F9F96C00000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000090
- F9F9F9F9F9000000000000000000000000000000000000000000F10000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000006CF9F9F9F9F9000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000008FFFF0700000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000000000000048F9F9F9F9F9EC0000
- 000000000000000000000000000000000000F000000000000000000000000000
- 00000000000000000000000000000000000000000008FFFF0700000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000ECF9F9F9F9F94800000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0008FFFF07000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000000000000000F9F9F9F9F96C00000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000000000AAFFF607000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000090F9F9F9
- F9900000000000000000000000000000000000000000F0000000000000000000
- 0000000000000000000000000000000000000000000000000008FFFF07000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000006CF9F9F9F9F9000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000008D1FF070000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000000048F9F9F9F9F9EC0000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000008FFFF070000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- ECF9F9F9F9F94800000000000000000000000000000000000000F00000000000
- 0000000000000000002DF500000000000000000000000000000000000008FFFF
- 070000F0F5000000000000000000000000000000000000000000000000000000
- F0F5F5000000000000000000F0F5000000000000000000002DF5000000000000
- 00000000000000000000000000F9F9F9F9F96C00000000000000000000000000
- 0000000000000000000000000000000000000007FFFFFFFFF631000000000000
- 08FFFF070000000000AAFFFF55F0FFFFFFFF07000000000008FFFF0700000000
- 0007FFFF08000000000007F6FFFFFFFFFF820000000007FFFFFFFFF700F5F6FF
- 8607F6FFFFFFFF082D00000000000000000000000000000000F9F9F9F9F99000
- 00000000000000000000000000000000000000000000000000000000000008FF
- FFFFF6FFFFFFF7000000000008FFFF07000000000008FFFF07FFFFFFFFFFFF86
- 0000000008FFFF07000000000007FFFF0800000000AFF6FFFFF6F6F6F6FF0000
- 0031FFFFFFFFF6FF082DFFFF55FFFFFFF6F6F6FFFF3100000000000000000000
- 00000000006CF9F9F9F9F9000000000000000000000000000000000000000000
- 000000000000000000AFFFFFFFF70708FFFFFF070000000008FFFF0700000000
- 0008FFFFFFFF860782FFFFFF0700000008FFFF07000000000007FFFF08000000
- AFFFFFFFF72DF5F50708000000F6FFFFFFF707F6FFFFFFFF3107FF59F5F5F7FF
- FFF6F5000000000000000000000000000048F9F9F9F9F9EC0000000000000000
- 00000000000000000000F000000000000000000007FFFFFFF000000031FFFFFF
- 00000000AAFFF607000000000008FFFFFFF700000007FFFFFF00000008FFF607
- 000000000007FFD108000007FFFFFFF00000000000000000F5FFFFFF31000000
- 86FFFFF60700000000ECEC07FFFF82ECECECECECECECECECECECECECEC24F9F9
- F9F9F948ECECECECECEC00000000000000000000000000000000000000000000
- FFFFFF07000000000082FFFFF700000008FFFF070000000000AAFFFFFF000000
- 0000F6FFFF070000AAFFFF07000000000007FFFF080000F6FFFF070000000000
- 0000000007FFFFF60000000000FFFFFF0700000048F9F9F9FFFFF6F9F9F9F9F9
- F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F96C000000000000000000
- 00000000000000000000002DFFFFFF000000000000F5F6FFFF00000008D1FF07
- 000000000008FFFF86000000000007FFFF86000008FFFF07000000000007F6FF
- 0800F0FFFFFF00000000000000000000F7FFFF820000000000D1FFFF07000000
- ECF9F9F9FFFFFFF9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9
- F9F9F90000000000000000000000000000000000000000F7FFFF070000000000
- 0000F6FFFF31000008FFFF07000000000008FFFF070000000000F5FFFFFF0000
- 08FFFF07000000000007FFFFAA0007FFFF080000000000000000000008FFFF07
- 000000000008FFFF07000000006CF9B6FFFFFFF9F9F9F9F9F9F9F9F9F9F9F9F9
- F9F9F9F9F9F9F9F9F9F9F9F9F9F9F94800000000000000000000000000000000
- 000000F6FFFF310000000000000082FFFFF7000008FFF6070000000000AAFFF6
- 07000000000000FFFFFF0000AAFFF607000000000007FFFF080007FFFF070000
- 000000000000000008FFF6070000000000AAFFF607000000000001CCFFFFAA24
- 48484848484848484848484848486CF9F9F9F9F9014848484848482400000000
- 000000000000F00000000000000000FFFFFF000000000000000007FFFF080000
- AAFFFF07000000000008FFFF07000000000000FFFFF6F50008FFFF0700000000
- 0007FFFF8600AAFFFF5500000000000000000000AAFFFF07000000000008FFFF
- 07000000000082FFFFFF5100000000000000000000000000000024F9F9F9F9F9
- EC00000000000000000000000000000000002800000000000000F5F6FFFF0000
- 000000000000F5F6FFFF000008FFFF07000000000008D1FF07000000000000FF
- FFFFF50008FFFF07000000000007F6FF080008FFFFF7F1F4F5F5F5F5F52DF500
- 08FFFF07000000000008D1FF07000000F5F6FFFFFFC8F9240000000000000000
- 00000000000000F9F9F9F9F9480000000000000000000000000000000000F000
- 000000000000F5FFF6AF0000000000000000F5FFFFFF000008FFFF0700000000
- 0008FFFF07000000000000FFFFF6F500AAFFFF07000000000007FFFFAA0008FF
- FFFFFFFFFFFFFFFFFFFFFF0008FFFF07000000000008FFFF07000031FFFFFFFF
- F790F9F9240000000000000000000000000000F9F9F9F9F99000000000000000
- 00000000000000000000000000000000000007FFFFAA000000000000000000FF
- FFFF0000AAFFFF07000000000008FFF607000000000000FFFFFFF50008FFF607
- 000000000007FFFF080082FFFFFFF6F6F6F6FFFFFFFFFF00AAFFF60700000000
- 0008FFF6070031FFFFFFFF07000090F9F9240000000000000000000000000090
- F9F9F9F9F90000000000000000000000000000000000F00000000000000007FF
- FF08000000000000000000FFFFFFF50008FFFF070000000000AAFFFF07000000
- 000000FFFFFF000008FFFF07000000000007FFFFAA0007FFFF07F5F5F5F5F5F0
- FFFFFF0086FFFF070000000000AAFFFF0700FFFFFF08F00000000090F9F9EC00
- 000000000000000000000048F9F9F9F9F9000000000000000000000000000000
- 0000000000000000000007F6FF08000000000000000000FFFFFFF100AAFFFF82
- 000000000008FFFF070000000000F5F6FFF60000AAFFFF07000000000007FFFF
- 080031FFFFF7000000000000FFFFAF0008FFFF07000000000008FFFF5531FFFF
- F600000000000000F9F9F9EC000000000000000000000024F9F9F9F9F9EC0000
- 0000000000000000000000000000000000000000000007FFFFAA000000000000
- 000000FFFFFFF40008FFFFFF000000000008FFFF86000000000007FFF6AF0000
- 08FFFFF7000000000007FFFF080000FFFF080000000000F0FFFF0800AAFFFF07
- 000000000008FFFF3108FFFF3100000000000000ECF9F9F9EC00000000000000
- 00000000F9F9F9F9F94800000000000000000000000000000000000000000000
- 000007FFFF08000000000000000000FFFFF6F50008FFFFFF0700000000AAFFFF
- FF000000000008FFFF07000008FFFFF6000000000008FFFF07000008FFFF0000
- 00000007FFFF070008FFF607000000000008FFFF3186FFF6F100000000000000
- 00ECF9F9F90000000000000000000000F9F9F9F9F96C00000000000000000000
- 000000000000000000000000000007FFFF08000000000000000000FFFFFFF500
- AAFFFFFFFF0700000008FFFFFF0700000031FFFFFFF50000AAFFFFFF07000000
- F0FFFFFF31000007FFFFF700000000F6FFFFF000AAFFFF070000000000AAFFFF
- 5507FFFF07000000000000000000ECF9F9900000000000000000000090F9F9F9
- F990000000000000000000000000000000000000000000000000F5F6FF080000
- 000000000000F5F6FFFF000008FFFF07FFFFFF08F186FFFFFFFF07F159FFFFFF
- 0800000008FFFFFFFF07F531FFFFFFFF00000000FFFFFF070000F7FFFF080000
- 08FFFF07000000000008FFFF3100FFFFFF31000031820000000000ECF9F99000
- 000000000000000048F9F9F9F9F900000000000000000000000000000000F000
- 000000000000F5FFFFFF0000000000000000F5FFFFFF000008FFFF00FFFFFFFF
- F4AAFFFFF0FFFFFFFFFFFFFFF000000008FFFF07FFFFFFFFFFFFFF0700000000
- F0F6FFFFFFFFFFFFFFF1000008FFFF07000000000008FFFF070007FFFFFFFFFF
- FFFFF0000000000024F9F990000000000000000024F9F9F9F9F9EC0000000000
- 00000000000000000000000000000000000000FFFFFF000000000000000007FF
- FFF60000F6F6FF00F0F6FFFFF108F6FF0031FFFFFFFFFF2D00000000AAFFFF31
- F0F6F6FFFFFFF7000000000000F108FFFFFFFFFFF000000008F6FF0700000000
- 0008F6FF07000007FFFFFFFFF6FF2D00000000000024F9F96C00000000000000
- 00F9F9F9F9F948000000000000000000000000000000000000000000000000F6
- FFFF2D00000000000000F7FFFF8200002DF52D0000003107F0F52DF500000031
- 073100000000000008FFFF550000F50707F0000000000000000000F007072D00
- 00000000F52DF5F00000000000F52DF5F000000000310707F500000000000000
- 000024F9F96C00000000000000F9F9F9F9F96C00000000000000000000000000
- 0000000000000000000000F7FFFF0700000000000000F6FFFF07000000000000
- 000000000000000000000000000000000000000008D1FF070000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000000000000024F9F96C00000000000090F9F9F9F99000
- 00000000000000000000000000000000000000000000002DFFFFF60000000000
- 0000FFFFFFF00000000000000000000000000000000000000000000000000000
- 08FFFF0700000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000024F9F948
- 000000000048F9F9F9F9F9000000000000000000000000000000000000000000
- 00000000F6FFF6F50000000000F7FFFFAF000000000000000000000000000000
- 00000000000000000000000008FFF60700000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000001F9F9240000000024F9F9F9F9F9EC0000000000000000
- 000000000000F000000000000000000031FFFFF600000000F5F6FFF631000000
- 000000000000000000000000000000000000000000000000AAFFFF0700000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000007312D07318200D1000000006CF9F92400000000F9F9
- F9F9F92400000000000000000000000000000000000000000000000000AFF6FF
- F631F555FFFFFFAF000000000000000000000000000000000000000000000000
- 0000000008FFFF07000000000000000000000000000000000000000000000000
- 00000000000000000000000000000000000000000000072DF0AA07F6F5080000
- 0000006CF9F924000000F9F9F9F9F90100000000000000000000000000000000
- 00000000000000000000AFFFFFFFFFFFFFFFFFF0000000000000000000000000
- 0000000000000000000000000000000008FFFF07000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000007F50008AF3107070000000000006CF9F9EC000090F9F9F9F99000000000
- 0000000000000000000000000000000000000000000000F7FFFFFFFFFF080000
- 0000000000000000000000000000000000000000000000000000000008FFFF07
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000072D00FFF700AF07000000000000006CF9F9
- EC0001F9F9F9F9F9000000000000000000000000000000000000000000000000
- 0000000000310707F00000000000000000000000000000000000000000000000
- 000000000000000008FFFF070000000000000000000000000000000000000000
- 00000000000000000000000000000000000000000000000000F7AF0807082D00
- F707000000000000000090F9F9EC24F9F9F9F9F9000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000000000000090F9F9ECF9F9F9F9F9
- 2400000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000090F990F9F9F9F9F94800000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000090F9F9F9F9F9F99000000000000000
- 000000000000F000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000000000000000000000000000000000000000000090F9
- F9F9F9F9F9000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000F9F9F9F9F9F9000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000ECF9F9F9F9F9EC0000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000ECF9F9F9F94800000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000ECF9F9F96C00000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000000000000000000000000000ECF9
- F9F9000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000F00000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000000000000000000000000000F0000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000000000000000000000000000F0000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000EC0000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000F000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 000000000000000000000000000000000000000000000000000000000000EC00
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000EC000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 00000000000000000000000000000000000000000000F0000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000EC0000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000000000000000000000000000000000000000
- 0000000000000000000000000000}
- end
- end
- object btnOK: TButton
- Left = 367
- Top = 277
- Width = 88
- Height = 25
- Cancel = True
- Caption = 'OK'
- ModalResult = 2
- TabOrder = 1
- OnClick = btnOKClick
- end
-end
diff --git a/Source/3rdParty/Orpheus/ovcabot0.lrs b/Source/3rdParty/Orpheus/ovcabot0.lrs
deleted file mode 100644
index f41359e9..00000000
--- a/Source/3rdParty/Orpheus/ovcabot0.lrs
+++ /dev/null
@@ -1,1323 +0,0 @@
-LazarusResources.Add('TOvcfrmAboutForm','FORMDATA',[
- 'TPF0'#16'TOvcfrmAboutForm'#15'OvcfrmAboutForm'#4'Left'#3#202#0#3'Top'#3#223#0
- +#11'BorderStyle'#7#8'bsDialog'#7'Caption'#6#13'About Orpheus'#12'ClientHeigh'
- +'t'#3'7'#1#6'Height'#3'7'#1#11'ClientWidth'#3#216#1#5'Width'#3#216#1#5'Color'
- +#7#9'clBtnFace'#12'Font.Charset'#7#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'c'
- +'lWindowText'#11'Font.Height'#2#245#10'Font.Style'#11#0#8'OnCreate'#7#10'For'
- +'mCreate'#13'PixelsPerInch'#2'`'#0#6'TBevel'#0#4'Left'#2#6#3'Top'#3#9#1#5'Wi'
- +'dth'#3#195#1#6'Height'#2#17#5'Shape'#7#9'bsTopLine'#0#0#6'TLabel'#0#4'Left'
- +#3#152#0#3'Top'#2#8#5'Width'#2';'#6'Height'#2#16#7'Caption'#6#7'Orpheus'#12
- +'Font.Charset'#7#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Fo'
- +'nt.Height'#2#243#10'Font.Style'#11#6'fsBold'#0#10'ParentFont'#8#0#0#6'TLabe'
- +'l'#0#4'Left'#2#7#3'Top'#3#17#1#5'Width'#3#232#0#6'Height'#2#13#7'Caption'#6
- +',Copyright '#169' 1995-2003 TurboPower Software Co'#0#0#6'TLabel'#0#4'Left'
- +#2#7#3'Top'#3'!'#1#5'Width'#2'V'#6'Height'#2#13#7'Caption'#6#20'All rights r'
- +'eserved.'#0#0#6'TLabel'#6'Label1'#4'Left'#3#151#0#3'Top'#2'('#5'Width'#3'"'
- +#1#6'Height'#2'1'#8'AutoSize'#8#7'Caption'#6#144'Orpheus was released under '
- +'the Mozilla 1.1 license in January, 2003. The project is hosted on SourceFo'
- +'rge at sourceforge.net/projects/tporpheus.'#8'WordWrap'#9#0#0#6'TLabel'#12
- +'VisitUsLabel'#4'Left'#3#153#0#3'Top'#2'l'#5'Width'#3#194#0#6'Height'#2#13#7
- +'Caption'#6'(Visit the Orpheus project on SourceForge'#0#0#6'TLabel'#12'lblT'
- +'urboLink'#4'Left'#3#161#0#3'Top'#2'|'#5'Width'#3#204#0#6'Height'#2#13#6'Cur'
- +'sor'#7#11'crHandPoint'#7'Caption'#6'*http://sourceforge.net/projects/tporph'
- +'eus/'#12'Font.Charset'#7#15'DEFAULT_CHARSET'#10'Font.Color'#7#6'clBlue'#11
- +'Font.Height'#2#245#10'Font.Style'#11#11'fsUnderline'#0#10'ParentFont'#8#7'O'
- +'nClick'#7#17'lblTurboLinkClick'#0#0#6'TBevel'#6'Bevel3'#4'Left'#3#152#0#3'T'
- +'op'#3#160#0#5'Width'#3'1'#1#6'Height'#2'`'#5'Shape'#7#7'bsFrame'#0#0#6'TLab'
- +'el'#22'GeneralNewsgroupsLabel'#4'Left'#3#160#0#3'Top'#3#168#0#5'Width'#2'q'
- +#6'Height'#2#13#7'Caption'#6#22'Orpheus support groups'#0#0#6'TLabel'#7'lblH'
- +'elp'#4'Left'#3#168#0#3'Top'#3#198#0#5'Width'#3#20#1#6'Height'#2#13#6'Cursor'
- +#7#11'crHandPoint'#7'Caption'#6'6http://sourceforge.net/forum/forum.php?foru'
- +'m_id=241874'#12'Font.Charset'#7#15'DEFAULT_CHARSET'#10'Font.Color'#7#6'clBl'
- +'ue'#11'Font.Height'#2#245#10'Font.Style'#11#11'fsUnderline'#0#10'ParentFont'
- +#8#7'OnClick'#7#12'lblHelpClick'#0#0#6'TLabel'#20'lblGeneralDiscussion'#4'Le'
- +'ft'#3#168#0#3'Top'#3#230#0#5'Width'#3#20#1#6'Height'#2#13#6'Cursor'#7#11'cr'
- +'HandPoint'#7'Caption'#6'6http://sourceforge.net/forum/forum.php?forum_id=24'
- +'1873'#12'Font.Charset'#7#15'DEFAULT_CHARSET'#10'Font.Color'#7#6'clBlue'#11
- +'Font.Height'#2#245#10'Font.Style'#11#11'fsUnderline'#0#10'ParentFont'#8#7'O'
- +'nClick'#7#25'lblGeneralDiscussionClick'#0#0#6'TLabel'#6'Label3'#4'Left'#3
- +#168#0#3'Top'#3#217#0#5'Width'#2'^'#6'Height'#2#13#7'Caption'#6#19'General D'
- +'iscussion:'#0#0#6'TLabel'#6'Label2'#4'Left'#3#168#0#3'Top'#3#186#0#5'Width'
- +#2#25#6'Height'#2#13#7'Caption'#6#5'Help:'#0#0#6'TPanel'#6'Panel1'#4'Left'#2
- +#6#3'Top'#2#6#5'Width'#3#139#0#6'Height'#3#251#0#10'BevelOuter'#7#9'bvLowere'
- +'d'#8'TabOrder'#2#0#0#6'TImage'#6'Image1'#4'Left'#2#1#3'Top'#2#1#5'Width'#3
- +#137#0#6'Height'#3#249#0#5'Align'#7#8'alClient'#12'Picture.Data'#10'n'#140#0
- +#0#7'TBitmapb'#140#0#0'BMb'#140#0#0#0#0#0#0'6'#4#0#0'('#0#0#0#137#0#0#0#249#0
- +#0#0#1#0#8#0#0#0#0#0','#136#0#0#0#0#0#0#0#0#0#0#0#1#0#0#0#1#0#0#0#0#0#0#0#0
- +#128#0#0#128#0#0#0#128#128#0#128#0#0#0#128#0#128#0#128#128#0#0#128#128#128#0
- +#192#220#192#0#240#202#166#0#170'?*'#0#255'?*'#0#0'_*'#0'U_*'#0#170'_*'#0#255
- +'_*'#0#0'*'#0'U*'#0#170'*'#0#255'*'#0#0#159'*'#0'U'#159'*'#0#170#159'*'#0
- +#255#159'*'#0#0#191'*'#0'U'#191'*'#0#170#191'*'#0#255#191'*'#0#0#223'*'#0'U'
- +#223'*'#0#170#223'*'#0#255#223'*'#0#0#255'*'#0'U'#255'*'#0#170#255'*'#0#255
- +#255'*'#0#0#0'U'#0'U'#0'U'#0#170#0'U'#0#255#0'U'#0#0#31'U'#0'U'#31'U'#0#170
- +#31'U'#0#255#31'U'#0#0'?U'#0'U?U'#0#170'?U'#0#255'?U'#0#0'_U'#0'U_U'#0#170'_'
- +'U'#0#255'_U'#0#0'U'#0'UU'#0#170'U'#0#255'U'#0#0#159'U'#0'U'#159'U'#0#170
- +#159'U'#0#255#159'U'#0#0#191'U'#0'U'#191'U'#0#170#191'U'#0#255#191'U'#0#0#223
- +'U'#0'U'#223'U'#0#170#223'U'#0#255#223'U'#0#0#255'U'#0'U'#255'U'#0#170#255'U'
- +#0#255#255'U'#0#0#0''#0'U'#0''#0#170#0''#0#255#0''#0#0#31''#0'U'#31''#0
- +#170#31''#0#255#31''#0#0'?'#0'U?'#0#170'?'#0#255'?'#0#0'_'#0'U_'#0
- +#170'_'#0#255'_'#0#0''#0'U'#0#170''#0#255''#0#0#159''#0'U'#159''
- +#0#170#159''#0#255#159''#0#0#191''#0'U'#191''#0#170#191''#0#255#191''#0
- +#0#223''#0'U'#223''#0#170#223''#0#255#223''#0#0#255''#0'U'#255''#0#170
- +#255''#0#255#255''#0#0#0#170#0'U'#0#170#0#170#0#170#0#255#0#170#0#0#31#170
- +#0'U'#31#170#0#170#31#170#0#255#31#170#0#0'?'#170#0'U?'#170#0#170'?'#170#0
- +#255'?'#170#0#0'_'#170#0'U_'#170#0#170'_'#170#0#255'_'#170#0#0''#170#0'U'
- +#170#0#170''#170#0#255''#170#0#0#159#170#0'U'#159#170#0#170#159#170#0#255
- ,#159#170#0#0#191#170#0'U'#191#170#0#170#191#170#0#255#191#170#0#0#223#170#0
- +'U'#223#170#0#170#223#170#0#255#223#170#0#0#255#170#0'U'#255#170#0#170#255
- +#170#0#255#255#170#0#0#0#212#0'U'#0#212#0#170#0#212#0#255#0#212#0#0#31#212#0
- +'U'#31#212#0#170#31#212#0#255#31#212#0#0'?'#212#0'U?'#212#0#170'?'#212#0#255
- +'?'#212#0#0'_'#212#0'U_'#212#0#170'_'#212#0#255'_'#212#0#0''#212#0'U'#212#0
- +#170''#212#0#255''#212#0#0#159#212#0'U'#159#212#0#170#159#212#0#255#159#212
- +#0#0#191#212#0'U'#191#212#0#170#191#212#0#255#191#212#0#0#223#212#0'U'#223
- +#212#0#170#223#212#0#255#223#212#0#0#255#212#0'U'#255#212#0#170#255#212#0#255
- +#255#212#0'U'#0#255#0#170#0#255#0#0#31#255#0'U'#31#255#0#170#31#255#0#255#31
- +#255#0#0'?'#255#0'U?'#255#0#170'?'#255#0#255'?'#255#0#0'_'#255#0'U_'#255#0
- +#170'_'#255#0#255'_'#255#0#0''#255#0'U'#255#0#170''#255#0#255''#255#0#0
- +#159#255#0'U'#159#255#0#170#159#255#0#255#159#255#0#0#191#255#0'U'#191#255#0
- +#170#191#255#0#255#191#255#0#0#223#255#0'U'#223#255#0#170#223#255#0#255#223
- +#255#0'U'#255#255#0#170#255#255#0#255#204#204#0#255#204#255#0#255#255'3'#0
- +#255#255'f'#0#255#255#153#0#255#255#204#0#0''#0#0'U'#0#0#170''#0#0#255''
- +#0#0#0#159#0#0'U'#159#0#0#170#159#0#0#255#159#0#0#0#191#0#0'U'#191#0#0#170
- +#191#0#0#255#191#0#0#0#223#0#0'U'#223#0#0#170#223#0#0#255#223#0#0'U'#255#0#0
- +#170#255#0#0#0#0'*'#0'U'#0'*'#0#170#0'*'#0#255#0'*'#0#0#31'*'#0'U'#31'*'#0
- +#170#31'*'#0#255#31'*'#0#0'?*'#0'U?*'#0#240#251#255#0#164#160#160#0#128#128
- +#128#0#0#0#255#0#0#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255
- +#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#247#0#0#0#0#0#0#245#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'U'#255
- +#240#0#0'-'#240#7#255#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'1'#245#255'1'#0'1'#255
- +'-'#8#175#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#245'-'#0#0'1'#255#240#246#246'-'#7#255#0#255#7
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#7#255#240#0#245#255'1'#247#255'-'#7#8#245#255#246#240
- +#247#246#245#245'Y'#241#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#246#255#7'-'#170#134'-'#255#240#134#7#7#246
- +#245'-'#255#7#240#255#255#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'-'#0#175#255#130#245#255#241#255#240#171
- +'1'#8#247#0#255'^'#240#255#8#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#247#0#8#255#236#8'1'#8'U'#8'-'
- +#255#236#175#130#240#255#255#7#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#247#255#247#0#8#134'U'#130#7#134
- +#134'1'#8#247#8#240#255#255#7#240#245'-'#0#0#0#0#0#0#0#0#0#0#7'-'#0#0#0#0#0
- +#245#130#175#8'1'#0#0#0'1'#7#0#0#0#240#247#245'-'#7#247#7'1'#0#0#0#0#0#0#7
- +#170#175#170#7#0#0#0#0'-'#247#0#0#0#0#0#0#0#0#0#7#170#175#8#7#0#0#0#0#0#0#0
- +'1'#241#0#0#0#0#0'1'#0#0#0#0#240#7#7#7#247#7#247#0'-'#7#0#0#0#240#247'-'#0#0
- +#0#0#0#0#0#0#0#0#240#245#0#0#240#245#255#170#0#212#8#8'1'#255#130#247#246#134
- +#241#255#7#0#245#170#255#255#245#0#0#0#0#0#0#0#0#0#255#130#0#0#0#0#7#255#255
- +#170#175#255#134#0#0#8#255#0#0#0#175#255#240#175#255#246#255#255#246#240#0#0
- +'1'#255#255#175#8#175#255#246'-'#0#0#7#255#0#0#0#0#0#0#0'-'#255#255#175#170
- ,#175#255#255'1'#0#0#0#0#0#8#7#0#0#0#0#0#255#245#0#0#0#245#255#255#255#255#255
- +#255#240#8#255#0#0#0#175#255#240#0#0#0#0#0#0#0#0#0#0#245#246#246#247#246'1'#0
- +#8#175#0#170#255#7#8'1'#134#209#245#246#7'1'#175#246#134'1'#240#245'U'#0#0#0
- +#0#0#0#0#0#255#247#0#0#0#240#255#130#0#0#0'1'#255'U'#0#170#255#0#0#247#246
- +#245#0#8#8#0#0#240#255#175#0'-'#246#8#240#0#0#0#240#175#246#245#0#7#255#0#0#0
- +#0#0#0'-'#255#8#240#0#0#0#240#8#246'1'#0#0#0#0#255#246#0#0#0#0'U'#255#7#0#0#0
- +#240#255'1'#0#0#0#0#0#134#246#0#0#7#255#245#0#0#0#0#0#0#0#0#0#0#0#0#7#134#255
- +#255#255#130#240'Z'#8#241#134'-'#0#0#0#0#246#255#134#134'U'#241'-'#7#246#255
- +#255#7#0#0#0#0#0#0#0#255#247#0#0#0'Z'#255#0#0#0#0#0#175#8#0#134#246#0#240#255
- +#247#0#0#175#170#0#0#0#7#255#0#255#175#0#0#0#0#0#0#0#246#246#0#7#255#0#0#0#0
- +#0#0#255#246#0#0#0#0#0#0#0#175#246#0#0#0#7#255#255#245#0#0#0#8#255#246#0#0#0
- +#245#255'1'#0#0#0#0#0#134#209#0#240#255#247#0#0#0#0#0#0#0#0#0#0#0#0#0#240'-'
- +#240#245'U'#134#209#8#246#246#0#0#0#0#0#0'-'#7'U'#247#8#255#255#246#175'1'
- +#240#0#0#0#0#0#0#0#0#255#247#0#0#0#170#255#0#0#0#0#0#247#255#0#134#175#0#209
- +#8#0#0#0#175#170#0#0#0#247#246#7#255#240#0#0#0#0#0#0#0#245#255'-1'#255#0#0#0
- +#0#0'1'#255#245#0#0#0#0#0#0#0#241#255'1'#0#0#255#134#175#247#0#0#241#255#247
- +#255'-'#0#0#240#255'1'#0#0#0#0#0#170#8#0#209#8#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#245#255#255#175#247'1-1'#247#247#0#0#0#0#0#0#0#8#255#130#7#240#241'11'#0#0#0
- +#0#0#0#0#0#0#0#246#247#0#0#0#134#246#0#0#0#0#0#7#255#0#130#255#8#255'1'#0#0#0
- +#175#8#0#240#7#255#7#247#255#0#0#0#0#0#0#0#0#0#255#7'1'#246#247#247'1'#0#0
- +#247#255#0#0#0#0#0#0#0#0#0#255#134#0'-'#255#240#7#255#0#0#247#255#0#209#8#0#0
- +#241#246'1'#0#0#0#0#0#134#209#8#255'1'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'1U'#7
- +#130#170#134#170#130'1'#0#0#0#0#0#0#0#7#130#134#134#134#247'11-'#0#0#0#0#0#0
- +#0#0#0#255#247#0#0#0#8#209#0#0#0#0#0#7#255#0#247#255#8#8#255#134#0#0#8#255
- +#255#255#255#7#0#8#209#0#0#0#0#0#0#0#0#0#255#247'1'#255#175#246#255#246#0#130
- +#246#0#0#0#0#0#0#0#0#0#175#170#0#8#255#0#0#255'1'#0#255#247#0#7#255#240#0#240
- +#255#175#134#170#212#134#0#130#255#8#8#255#170#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +'11'#245#245#7#134#255#134#0#0#0#0#0#0#0#134#7'1-'#7#130#246#255#255#245#0#0
- +#0#0#0#0#0#0#255#247#0#0#0#134#246#0#0#0#0#0#247#255#0#130#246#0#0#245#255#7
- +#0#8#170#0'-'#255'1'#0#130#255#0#0#0#0#0#0#0#0#0#255#7'1'#255#0#0#240#255#134
- +#7#255#0#0#0#0#0#0#0#0#0#255#247#0#255#7#0#0#175#8'-'#246#240#0#0#255#7#0#241
- +#255#175#170#8#8#170#0#130#209#0#0#245#255#7#0#0#0#0#0#0#0#0#0#0#0#240#241'1'
- +#246#255#246#246#170#7'1'#7'-'#0#0#0#0#0#0#255#246#8#209#134'1'#245#240'-'
- +#240#0#0#0#0#0#0#0#0#255#247#0#0#0#8#209#0#0#0#0#0#7#255#0#134#255#0#0#0#170
- +#171#0#175#8#0#0#7#255#0'1'#246#245#0#0#0#0#0#0#0'1'#255#240'1'#255#0#0#0'U'
- +#255#245#255'1'#0#0#0#0#0#0#0'-'#246#245'1'#255#240#0#0'1'#255#246#175#0#0#0
- +#8#255#0#240#255'1'#0#0#0#0#0#134#246#0#0#0#130#175#0#0#0#0#0#0#0#0#0#0#0#130
- +#255#246#175#7'-'#241#7#134#170#255#8#0#0#0#0'-'#8'-'#170#7#240#134#255#255
- +#255#8'1'#0#0#0#0#0#0#0#0#255#7#0#0#0#134#246#0#0#0#0#0#7#255#0#130#246#0#0#0
- +#8#8#0#8#170#0#0#7#255#0#0#246#246#0#0#0#0#0#0#0#255#175#0#7#255#0#0#0#7#255
- +#0#8#255#0#0#0#0#0#0#0#255#175#0#255#8#0#0#0#0#255#255'1'#0#0#0'-'#255#245#0
- +#255'1'#0#0#0#0#0#134#175#0#0#0#8#8#240'-'#245#0#0#0#0#0#0#0#0#0'1'#245#240
- +'1'#8#246#8'-'#247#8'-'#246#247'1'#134#7#255#8#245#175#130#0'Y'#255#247#246
- +#246#0#0#0#0#0#0#0#0#255#247#0#0#0#170#246#0#0#0#0#0#7#255#0#134#246#0#240#7
- +#255'1'#0#209#8#0#245#255#8#0#0#241#255#246#245#0#0#0'-'#255#255#240#0#7#255
- +#0#0'1'#255#170#0#240#255#255'-'#0#0#0'-'#246#255#240#245#246'1'#0#0#0#0#247
- +#255#0#0#0#0#0#255#134#236#255'1'#0#0#0#0#0#134#246#0#240#7#255#7'-'#247#7#0
- +#0#0#0#0#0#0#0#0#0'1'#255#246#134#241#0#247#175'-'#8#209#7#8#209'1'#134#247
- +#175#240#8#255#241#240#0#0#245#240#0#0#0#0#8#255#255#255#255#255#255'-'#134
- +#246#0#0#0#0#0#247#246#0#134#255#255#255#255#247#0#0#8#255#255#255#8#0#0#0#0
- +#240#175#246#255#255#255#255#8#240#0#0#7#255#255#255#255#8#0#0#0#240#8#255
- +#255#246#255#255#8#240#0#175#246#0#0#0#0#0'-'#247#0#0#0#0#0#7#255'1'#246#255
- +#255#255#255#255#240#130#246#255#255#255'^'#0'-'#7#7#0#0#0#0#0#0#0#0#0#0#0'1'
- +#241#240#247#255#255#240#171#7#8'-'#170#8#7#134'-'#130#246#0#134#255#7#0#0#0
- +#0#0#0#0#0'-11-111'#0#245'-'#0#0#0#0#0#241'1'#0#241'11-'#0#0#0#0#245'1-'#240
- +#0#0#0#0#0#0#0'-'#7#247#7#245#0#0#0#0#240'11-'#240#0#0#0#0#0#0#245#7#130#7
- +#245#0#0#0'1'#245#0#0#0#0#0#0#240#0#0#0#0#0#0'1'#245'-11111'#0#241'11-'#240#0
- +#0#0#245#0#0#0#0#0#0#0#0#0#0#0#0#0#0#7#255#246#240#8#8#240#175'1'#134#7#170#7
- +#8#0#255#175#0#130#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#175#246#0#130#246#0#8#130#7#130#245#246
- +#245#246#240#247#255#246#0'1'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- ,#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#245#255#255#240'Z'#255#241'1'#255'U'#134
- +#247'-'#255#245#175#247#240#7#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#7#240'1'#255#7#240#255#255
- +#245#255#7'1'#255#7'U'#255#240#0#240#255'1'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#7#255#240
- +#255'1U'#246#8#241#255'-'#0#0#245#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#246#134'-'#255'-'
- +#0'1'#255#240'1'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#245#246'1'#240#245#0#0#241#246
- +'1'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#245#0#0#0#0#0#0#247#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#13#244#244#244#13#13#12#245#244#244#244#13#13#13#13
- +#240#0#0#240#244#0#244#244#240#245#12#245#0#245#17#17#21#16#17#17#245#240#0
- +#240#240#244#0#240#13#12#13#245#244#245#17#12#0#240#241#0#240#240#0#0#245#245
- +#12#17#13#244#240#0#240#0#240#17#244#13#13#244#244#13#17#244#245#244#245#244
- +#13#17#12#245#240#245#240#0#240#244#240#0#241#240#240#244#240#13#12'-5'#244
- +#245#244','#244')'#244'5,,(UX,UTLLLytqpq'#148#187#152#187#152#187#149#186#187
- +#0#0#0#12#240#0#0#244#13#244#240#245#240#241#0#0#0#0#240#0#240#0#245#244#0
- +#245#244#0#241#244#0#240#12#17#13#13#240#240#244#0#240#0#240#245#0#0#240#245
- +#240#244#240#244#13#245#240#0#240#245#0#240#0#240#240#12#13#21#244#0#0#240#0
- +#0#240#245#240#0#0#240#245#240#240#0#244#244#240#0#240#13#17#244#244#244#0
- +#240#240#245#244#240#240#240#240#241#244'10'#244'5,'#244'-'#240',,,1,((0U,UT'
- +'(MLxLqp'#152#149#182#153#148#187#148#186#149#148#0#0#0#13#241#0#0#245#12#13
- +#0#244#240#244#0#0#240#0#0#240#0#0#240#240#241#244#245#244#244#240#245#244
- +#245#244#12#13#245#12#13#245#0#0#0#244#0#240#0#0#0#245#240#244#0#240#240#240
- +#0#240#240#240#0#244#13#240#0#245#240#0#0#0#240#0#0#244#0#240#0#240#244#0#0
- +#240#13#25#240#0#240#244#13#245#240#245#240#0#240#12#241#240#240#240#244#240
- +#244#13#13#244'5'#244'('#244'-'#244'),4-,(0UPXQLLLyLL'#149#186#153#152#148
- +#153#148#153#153#152#153#0#0#0#12#244#240#240#244#13#12#240#245#244#0#240#0#0
- +#240#0#0#240#0#244#245#244#240#0#245#0#245#13#240#244#245#12#17#12#13#12#244
- +#240#0#240#244#0#0#0#240#244#17#244#245#240#241#0#0#244#240#0#0#13#13#244#240
- +#0#0#236#0#240#240#0#0#240#17#240#0#0#240#245#0#240#244#17#17#244#241#244#17
- +#12#244#244#244#0#240#240#13#244#240#240#241#240#240#244'0014-'#244',,,,,1,('
- +'(UT,UTLLM|M'#148#148#149#152#149#152#152#153#148#152#149#152#0#0#0#17#245
- +#244#17#17#12#245#240#244#0#245#17#244#0#240#0#240#0#240#240#0#244#13#244#240
- +#244#244#0#244#245#12#13#240#13#12#21#17#12#245#240#240#245#244#13#17#13#240
- +#245#244#0#240#240#240#241#240#0#240#13#244#0#13#17#13#17#17#13#17#12#240#241
- +#13#244#244#0#240#244#240#245#17#16#17#17#240#244#17#17#244#245#244#240#0#241
- +#12#240#240#240#244',1011010,,,-,,Y,((TUPUTMLLyp'#152#153#152#153#152#153#153
- +#148#152#153#152#153#0#0#0#244#240#240#240#245#13#12#240#245#240#240#245#240
- +#0#0#240#0#0#240#245#245#240#244#0#240#241#240#240#240#244#13#12#240#244#13
- +#17#21#13#244#240#244#13#245#244#244#240#240#244#12#244#244#0#0#240#241#0#240
- +#13#17#240#244#12#12#245#12#13#244#13#244#240#240#244#245#0#240#245#240#244
- ,#21#21#16#13#244#13#12#13#244#244#245#240#240#240#13#244#244'110Y1X4U0U1,,,,'
- +'PY,P(UTPYPLLux'#153#148#153#148#152#153#148#152#153#149#186#149#152#0#0#0
- +#245#240#0#240#244#12#245#240#244#240#240#244#240#0#240#0#240#0#0#240#244#245
- +#244#241#244#244#240#245#240#245#12#13#245#244#12#13#17#245#12#245#240#240
- +#244#17#240#0#13#13#13#17#13#240#0#240#240#0#240#0#245#21#17#13#17#13#12#13
- +#17#13#0#240#0#245#12#245#240#244#16'5'#17#17#17#244#244#17#13#17#244#245#244
- +#240#240#240#12'-0X4Y4YYYYXTUTUP,,Y,)PTYP|ULLPy'#152#153#148#153#149#152#187
- +#152#152#153#152#153#152#0#0#0#244#240#240#0#13#17#244#241#244#241#244#245#0
- +#240#0#0#240#0#240#0#240#240#244#240#0#245#244#0#244#244#245#12#13#244#13#13
- +#12#240#245#240#240#244#245#244#13#12#244#240#0#245#240#240#0#240#244#0#240#0
- +#240#244#244#244#244#244#245#244#244#244#0#0#0#240#244#17#12#13#21#21#17#17
- +#17#245#240#12#12'1'#244#244#245#240#240#244'1055YYYXY'#3#3'YYXU'#3'UTUYPPPU'
- +'UPYtLqt'#156#149#152#153#152#152#153#148#153#152#148#153#152#153#0#0#0#244
- +#245#244#244#244#13#12#244#240#244#0#244#0#0#0#240#0#240#0#0#240#241#244#240
- +#244#244#0#244#240#13#244#13#12#17#21#12#244#245#12#12#13#244#0#0#13#12#245#0
- +#240#240#240#0#0#241#0#0#240#0#244#0#13#17#13#13#16#17#17#17#240#245#244#240
- +#0#241#244#13#240#245#12'9'#12#244#240#245#17#17#244#245#244#240#240'-05TYXY'
- +'XY'#3'YY}'#3'YTUTYY'#3'QPPU|P}xMLt'#153#152#187#152#148#153#186#153#152#153
- +#187#152#153#148#0#0#0#12#244#244#17#17#12#245#240#245#240#244#241#244#245
- +#240#0#240#0#240#241#244#240#245#0#241#244#241#240#241#244#244#13#12#17#17#0
- +#245#244#13#245#244#13#244#240#13#13#244#240#245#244#245#244#244#244#245#240
- +#240#0#245'4'#13#12#13#12#13#244#13#12#240#240#13#0#244#244#12#17#244#12#13
- +#16#245#240#244#13'0'#17#244'0'#245#240',14U5XY'#3']'#3'Y}'#3#3'Y|YT}TT]T'#3
- +'U|UP}Tppu'#152#153#152#152#153#152#153#152#153#148#152#152#153#152#0#0#0#245
- +#12'5'#21#17#244#244#240#244#241#240#244#244#13#240#240#240#241#244#13#244
- +#240#244#244#240#244#240#244#240#13#244#13#13#12#17#240#240#244#240#240#17
- +#244#245#244#12#244#245#0#240#244#244#241#0#240#244#240#240'1'#17#17#12#13#12
- +#13#17#12#17#13#0#240#244#244#13'95'#17'999'#17#12#13#240#12#21'9'#245#12#245
- +#244'001XYY'#3'YYY\Y}Y|Y|}TyxY}'#3'}'#3'}T}yPqt'#153#152#153#153#152#153#152
- +#153#186#153#153#186#149#152#0#0#0'0-'#12#245#12#245#17#13#240#244#240#245#0
- +#0#13#240#240#240#240#0#244#13#244#241#240#244#245#240#240#12#245#16#17'9'#21
- +#245#13#244#245#240#17#13#240#13#17#17#12#240#245#13#240#240#240#245#240#0
- +#245#17#16#13#13#12#13#13#244#13#12#245#240#244#241#240#244#17#12'5'#17#13
- +#244#13#244#17#12'995'#12'1'#244',15T5XYY'#3#128'}Y'#128'Y'#128'}|Y|}|}'#160
- +'xyx}xy|xttt'#187#152#152#152#153#186#152#152#153#152#152#153#152#153#0#0#0
- +#13#12#13#12#13#244#13#12#244#244#241#244#0#240#17#240#0#0#0#0#13#13#244#240
- +#240#245#244#240#244#245#244#17#16#13#17#244#240#240#244#0#245#21#244#244#13
- +#244#13#240#240#244#244#0#240#240#240#240#240#244#245#13#12#13#12#12#13#12#13
- +#12#244#13#12#0#240#13#244#13#12#244#240#244#240#13'599'#17','#13#244',1TYXY'
- +'Y'#3'Y]Y'#128'}'#128'}|}'#164#165#165#160#161#160#161#160#161#160#157'xyytu'
- +#153#152#153#152#153#152#153#153#153#152#152#187#148#153#152#0#0#0'01'#12#17
- +#244#244#241#240#245#240#244#244#240#0#244#240#0#240#240#0#240#240#244#245
- +#244#244#241#244#245#12#13#17#17#244#244#240#244#13#13#244#240#12#13#21'5'#12
- +#13#244#241#244#245#240#240#245#240#0#240#245#244#12#17#13#17#13'0'#17#17#13
- +#240#245#244#245#12#17#13#244#13#245#244'51'#12#240#16'55'#12'01014YY'#3'Y'
- +#129'Y||]}'#128'}'#165#164#165#198#164#198#165#164#165#160#160#161#160#161
- +#156#156'ytt'#153#152#153#152#153#152#152#186#153#153#152#153#152#148#0#0#0
- +'1459'#13#12#244#244#244#245#240#245#0#240#245#240#240#0#240#0#0#240#244#240
- +#240#244#244#240#244#13#16'9'#17#244#245#240#13#244#240#13'5'#244#12#13#244
- +#245#244#244#12#17#12#0#240#240#245#240#240#244#17#21#244#244#244#245#245#244
- +#12#245#240#244'50'#245#244#244#12#240'0=9'#17'5'#12'545'#13'001T1TXY'#3#3
- +#129'Y'#129'|}'#165#164#198#165#198#165#164#165#198#165#160#199#160#161#160
- +#161#161#156#156#157#156#152'u'#152#149#152#153#153#152#152#153#152#148#153
- +#153#0#0#0'05'#12#245#244#245#245#244#17#244#244#244#240#0#244#244#13#240#0
- +#240#240#240#245#244#245#245#244#245#244#13#17'9'#17'9'#244#240#244#245#0#244
- +#244#245#13'9'#17#12#13#13'9'#21#13#236#240#244#240#0#244#13#13#244'559'#12
- +#244#245#240#240#0#245#244#245#244#240#245'59'#17'5'#12',11'#17'5501101TYU'#3
- +'Y}'#3'}|'#129#164#164#199#164#199#164#198#199#199#164#164#199#164#161#164
- +#160#160#160#157#160#157#156#157#152#153't'#153#148#152#153#152#148#153#153
- +#152#148#0#0#0'15'#13#244#13#12#244#244#245#244#244#245#0#240#245#245#13#236
- +#240#240#0#240#244#244#240#12#244#244#244#13#244'1'#12'5'#13#240#13#244#236
- +#12#245#244#240#240#240#245#12#240#245#244#13#0#244#245#240#240#241#244#244
- +#12#17#12#13#244#245#12#13'1'#240#240#240#12#13'5'#12'995'#12'5'#13#244#244
- +'1450100UXUXY}'#3#129'|'#129#164#165#203#164#199#168#198#169#164#164#164#199
- ,#164#199#164#160#195#161#161#160#157#156#157#156#157#152#152#149#152#153#148
- +#153#152#153#152#148#153#0#0#0'05'#12'0'#17'4'#13#244#0#244#245#244#240#240
- +#244#240#244#0#0#240#240#240#245#244#245#244#13'5'#245#244#240#13#13#244#244
- +#244#244#245#244#245#244#12#245#12#0#240#13#0#240#240#244#240#240#244#241#240
- +#244#244#17'9955'#244#240#13'00'#240#244#244'-,01001010101,5010UTUXY'#3'}'#3
- +'}}'#164#199#164#198#203#164#202#165#198#203#198#199#164#198#164#199#165#160
- +#160#160#161#160#157#160#157#156#156'u'#152'q'#148#153#148#153#148#152#153
- +#148#0#0#0'5559999'#245#240#245#244#245#0#240#245#244#245#244#240#236#13'0'
- +#13#244#244'1'#244#244#12#13#244'0'#244'-,1,,-'#244#245#244'15'#240#240#12
- +#240#245#244#245#240#245#244#240#240#240#244'1'#244#245#240#245#244#244'9'#13
- +#245',,101001010101055410101TUTY'#3'}|'#165#165#164#203#164#202#199#202#164
- +#203#164#169#198#169#199#164#198#164#199#161#160#161#160#160#157#156#157#156
- +#153#152#153't'#148'u'#148#153#149#148#153#0#0#0'50'#13','#17'5'#240#240#240
- +#244#244#244#240#240#244#244#244'5'#245#240#12#13#240#244#245'9'#13#240'1001'
- +'100010,0,,'#13#244'0'#13#13#240#240#244#244#240#240#244#241#240#245'5'#13#12
- +#244#244#244'1'#240#241',,01010U1T1T10101451050UTUXY|}|}'#164#164#199#198#168
- +#199#168#199#202#203#198#202#199#198#164#199#164#199#164#164#194#161#160#157
- +#160#157#156#157#156#152'u'#148#153'q'#148'p'#148#153#148#0#0#0'010'#13'54'
- +#244#241#240#13#244'-'#240#240#13#244#245'0'#240#240#245#245'45'#12',,'#240
- +'1010401101010-,,1'#13#12#240#245#244'1'#240#244#245#240#240#244'50'#13'5450'
- +#244',0-10U0Y0T5T501T105Y\5]Y0TU'#3'y'#3'Y|'#165#164#199#202#169#198#203#198
- +#202#203#164#202#165#198#168#199#202#165#198#164#195#165#160#161#160#157#160
- +#157#156#157#157't'#152'qp'#152'q'#153#148#149#0#0#0'101015'#244#240#240#12
- +#245#12#240#240'1'#244#244#13#240#240'0'#244'5'#244'-'#244#245'005XYU5T01010'
- +'100-,,1'#240#244#245#12#240#245','#244#240#245#12#13'095950-,00U0YTYYXYTYT5'
- +'TY055'#3']\YUTUXy|}'#198#164#203#164#199#202#164#202#165#202#202#199#202#202
- +#199#164#198#165#198#165#164#160#165#160#161#160#157#156#157#156#156#153'qt'
- +#152'qppqp'#0#0#0'X1X105'#244#240#240'1'#12#245#240#240#12#245#244'1'#244#240
- +'101,'#244',,YXYY'#3'XYYYXU41T10010-'#240','#12'1'#240#244#245#244#244#244'1'
- +'10'#244'-,1,010UTY'#3'Y'#3'Y'#3'YYXUTUTUX]]]Y\YTU|Y|'#165#165#198#164#202
- +#164#203#203#202#202#165#202#168#199#168#202#199#168#198#165#198#165#194#160
- +#161#160#157#160#157#156#157#156#152'upqtqppq'#0#0#0'Y501T1,'#244#245'0'#244
- +'1'#240#244'-'#244',1'#240#244'105,,-XYY|YYY'#3#3'YYXUX10U10,0,'#244'-1'#240
- +#244','#241#244',001,01,01TUXU'#3'YY'#3'YY|'#3'YYXYTY'#3']a\]'#133'YT'#3'Ux}'
- +#160#198#165#198#199#202#198#168#202#203#202#202#199#202#203#198#168#199#164
- +#198#165#198#165#160#160#161#160#161#156'}'#156#157'xtutqtqpp'#0#0#0'YXY010,'
- +'54550'#240#244'5014'#244',51Y01T]]\]\]\YYY'#3'YYTUT1T01U,100,,1,,-19a]]40UT'
- +'UTYY'#3'Y|'#129'Y|]YY'#3'}TUTU]\]Y\YTUy|}'#164#165#198#169#202#169#202#203
- +#203#164#203#203#168#203#198#169#198#199#202#199#164#199#160#199#161#160#161
- +'x'#157#156#157'x'#157'tuppqppq'#0#0#0#3'YYXT10Y5050'#240'1541Y,,]4]00Y'#128
- +#129#129#129#129#129#129#128']|YY'#3'YYTU0U00Q055,100100]]05TUTU'#3'Y}'#3#129
- +'Y'#128'Y'#128'Y}'#3'|Y'#3'YX}T]]]'#3'YTUx'#3'}'#160#165#198#203#198#198#202
- +#165#202#202#203#202#202#203#164#202#199#202#164#199#164#198#165#164#160#160
- +#161#160#161'|'#157'x'#157'xutpuLqLp'#0#0#0']'#3'YU4U014]51(,0104-,Y5\]]'#129
- +#129#128#129#128#129#128#129#129#128']|'#3'Y'#3#3'YXUTU00U45,15,01X5Y1TUTUTY'
- +'|'#3'}|}'#129'|'#129'|'#129'}'#3'}Y|UXU|YYU'#3'QTUxy|'#165#164#164#203#164
- +#203#202#169#202#202#169#198#202#203#168#202#203#202#164#199#164#198#199#164
- +#165#160#161#156#161'x'#161'x'#157'xQtLupqL'#0#0#0#128'Y'#3'YUX1T1a41,1Y0U5,'
- +'TYTYa'#133#128#129#133#128#133#164#129#129#128#129#129#129#129#3'}YXU'#3'UX'
- +'UT,1Y,T1,105YXXUTUXY|}}|'#129#128#129#129#128#129'|'#129'}|}Y'#3'}|U'#3'Y'#3
- +#129#3'}XU|'#161#164#199#198#164#199#202#199#202#203#202#203#202#203#202#203
- +#198#164#199#202#164#199#164#164#161#160#161#160#161'x'#161'x'#157'xxtMtLPLL'
- +#0#0#0#129'YY'#3'TUT10,10,0011X,U\U]'#133#128#129#133#168#133#169#133#133#132
- +#129#129#128#129'|'#129'}'#3'}XUTUTUTY'#3',50,TYY\]'#133#129'TY|}}'#129#128
- +#129#128#165#165#164#165#165#164#165'|}||}|U|Y|Y}Y'#128#129'xy|'#161#198#164
- +#203#202#202#169#202#164#203#202#203#168#203#198#169#202#203#164#199#198#165
- +#199#164#161#160#161'|'#161'x'#157'xyyyTPMLML'#0#0#0#128'}'#3'YYTUT1XY1,1Y0T'
- +'YTU]'#3']'#133#133#128#168#169#169#168#168#164#165#164#164#165#160#165#161
- +'|}|}|UTUTTYY,UY,UX'#129']'#3'U'#3'}|}|'#129'|'#165#164#165#164#164#165#198
- +#164#165#164#165#164#161'}|}|y'#3'YTTT}|U|}'#164#199#202#164#168#199#202#202
- +#203#198#169#202#203#202#202#203#198#164#202#199#164#164#198#161#164#161#160
- +#161'x'#161'xyxx|YPPPLL'#0#0#0#129#128'}'#3'Y'#3'UTY]XY,TYYTYTTa}'#128#129
- +#129#169#169#168#169#169#165#164#165#165#165#164#165#164#164#161#160'}|}|UTU'
- +'U\YPXYQXY'#3']]TY|}|}|'#165#168#165#198#203#202#168#165#198#165#198#165#164
- ,#160#165#160'}|}|'#129'yxU'#3'}xy'#160#165#164#199#198#199#202#165#202#202
- +#203#202#202#198#169#198#164#203#199#164#164#199#164#165#164#161#160#161'|'
- +#161'x'#161'xyy'#3'UPYTYT'#0#0#0#128'}|}|UXUTYYTPUXYY'#3'yTy'#3#133#133#168
- +#169#168#165#164#198#164#169#198#202#164#169#198#165#165#164#165#160#161#160
- +'}|yTTYYPYXPYTY'#133#128#129#128'}|}'#164#165#202#199#202#169#198#169#199#198
- +#169#198#164#164#199#164#160#161#160#161'|}|TUx}}xy|'#161#198#164#165#198#164
- +#202#199#168#198#169#202#169#202#203#202#202#164#203#202#164#199#164#165#160
- +#165#160#161'|'#161'|y|xYTQX-T-'#0#0#0#165#161'|}|}xU'#3'YXYY'#3'U'#3#3'Y'#3
- +'UT}'#128#129#129#168#199#168#202#169#203#202#165#168#165#198#165#198#164#164
- +#165#164#161'|}|'#157'|U'#3'}TY'#3'U|Y'#3#133#133#129#133'|}'#164#165#202#202
- +#164#202#198#203#198#202#168#198#168#165#199#164#165#165#160#161'|'#161#160
- +'}}xy||y|}'#160#198#165#198#199#164#199#164#199#203#202#203#202#203#202#169
- +#198#203#168#199#165#198#165#198#164#161#160'}'#160'}xyxy'#3'UTYT(('#0#0#0
- +#164#164#161'|}|}xY'#3'Y'#3#133'Y'#3'Y}|Yxy|'#129#132#165#202#168#202#203#202
- +#168#203#202#203#202#203#168#198#169#199#164#165#164#161#160'}|'#161'x}\U'#3
- +'}TY'#3'}'#129#128'y'#128#129#160#199#202#203#202#203#168#203#202#169#202#199
- +#168#199#202#164#199#164#164#165#160#161#160'}'#160'|}|'#129'}xy|'#161#164
- +#165#164#164#199#164#198#168#202#203#202#203#168#203#202#169#202#199#164#202
- +#164#199#164#165#164#161#160#161#160'}|yxYT0U0,('#0#0#0#199#164#165#160'}x}x'
- +'}}'#3'YY|Y'#3'Y'#129'|}x}'#128#169#202#203#202#169#202#203#202#203#168#203
- +#202#168#199#168#198#164#199#164#161#164#161#160'}|'#161'|}X'#129'YX}|'#129
- +#132#129'x'#129#169#202#202#202#202#169#202#203#168#203#202#203#202#203#164
- +#199#168#165#198#199#164#161#164#161#160#161#161#160'}|'#129'xy|'#161#164#161
- +#164#161#164#165#202#203#202#169#202#202#203#202#203#202#169#202#203#198#169
- +#198#164#199#164#165#160'}|'#161'|}'#3'YYT1P-,'#0#0#0#164#165#164#161#160'}|'
- +'}'#160'x}'#3'TY|}|'#129#129'|}|'#165#202#203#202#203#203#202#169#203#202#203
- +#202#203#202#202#203#165#202#164#165#198#165#160#161#160#161'|'#161'xy'#3'}x'
- +'}|'#129#129#133'|'#161#198#203#168#203#202#203#202#202#203#202#202#169#202
- +#164#203#202#198#198#165#164#165#164#161#160#161#160#160#161#160#129'|y|y|'
- +#161#164#161#164#165#202#169#202#203#202#203#203#202#169#202#203#202#202#164
- +#203#164#198#165#164#164#165#160#165#160'}|}T]\]Y0,,'#0#0#0#199#164#199#164
- +#161'|}'#160'y}|}'#129#129'|'#129'|y'#128'}|'#165#202#203#168#203#202#206#203
- +#202#202#203#202#203#168#203#203#164#202#198#165#198#165#164#161#160#161'|'
- +#161#160#161'|}'#128'U'#128'}'#128#133#168#165#164#202#202#203#202#169#202
- +#203#202#203#202#169#202#202#203#202#164#203#165#164#199#164#164#161#160#161
- +#160#161#161#160#165'|}|}'#160#161#160#165#160#199#202#203#202#203#202#203
- +#202#203#202#202#203#202#169#203#198#168#199#168#199#165#164#165#160'}'#128
- +#161'}|]YY0101'#0#0#0#164#165#164#165#160#161#160'}'#160#156#161'|'#133'|}}|'
- +'y'#128#129#169#202#203#202#207#202#203#203#206#203#203#168#203#202#203#168
- +#202#203#202#165#198#164#199#164#161#160#160#161#160#161#160#161'|}x}|'#129
- +#169#133#165#202#203#202#203#202#203#202#203#169#202#203#202#203#203#168#199
- +#202#164#202#198#165#198#165#164#161#160#161#160#160#161#160#161#128#129#164
- +#165'|'#161#160#165#202#202#203#202#203#202#203#168#202#203#203#168#203#202
- +#168#203#169#198#165#168#198#165#164#165#160'}||}|Y0Y0]9'#0#0#0#198#165#198
- +#160#165#160#161'|}}'#160#161'|}|'#128#129#160'}'#160#169#202#203#202#203#203
- +#202#203#202#203#202#207#202#203#202#203#202#168#199#202#169#198#164#165#164
- +#165#160#161#160#161#160#160#161'|}|}'#128#169#164#165#202#168#203#202#203
- +#202#203#202#202#203#202#203#202#202#203#202#203#198#169#198#164#199#164#165
- +#164#161#160#161#160#161#160#160#165'|}|'#165#160#165#164#203#202#203#202#203
- +#168#203#203#203#202#203#202#203#203#202#198#202#169#198#165#164#165#164#165
- +#128#161#129'|}}XUX100'#0#0#0#168#198#165#164#165#160#160#161#160#160#161#160
- +#161'|'#129'}'#128#129#128#165#164#203#202#203#202#203#207#202#207#203#206
- +#203#203#202#203#202#203#202#203#164#198#165#198#164#199#160#161#160#161#160
- +#161#160#160#161'x'#129'}'#168#133#165#198#202#203#202#169#202#203#202#203
- +#203#202#203#202#203#202#169#202#168#203#198#164#199#165#164#198#161#160#161
- +#164#161#160#161#160#165#128#165#164#165#164#161#202#202#169#202#203#202#203
- +#202#203#202#203#202#203#202#168#203#168#203#198#203#168#199#164#165#164#165
- +#128#128'}'#128#128#129'\'#129#3'Y5'#0#0#0#198#165#198#165#160#161#161#160
- +#161#161#160#161#160#165#129#164#129#164#165#164#203#202#203#202#203#206#202
- +#203#203#202#203#203#202#203#168#203#168#199#168#198#169#198#165#199#164#161
- +#164#161#160#161#160#161#161#161'x'#165#128#169#165#164#198#203#202#203#202
- +#207#203#202#207#202#203#202#169#202#203#202#203#198#203#164#203#198#164#198
- +#165#160#165#160#161#160#165#160#195#160#129#160'}'#164#165#164#198#203#202
- +#203#203#202#203#207#202#203#168#203#168#203#203#202#203#198#169#168#198#165
- ,#164#164#165#128'}'#165#133#133#129#129']]]Y'#3#0#0#0#203#164#199#164#165#160
- +#160#161#160#160#161#160#161#160'|'#129#164#165#169#168#203#202#203#202#207
- +#203#203#207#202#207#203#206#203#202#203#202#203#202#198#203#198#164#198#164
- +#165#164#161#164#161#160#161#160#160#160'}'#128#161#168#165#164#169#202#203
- +#202#203#203#206#203#203#202#207#202#203#203#202#203#168#203#164#202#199#164
- +#199#165#160#165#160#165#160#161#160#165#160#161#160#129#164#165#164#199#202
- +#203#202#203#206#203#203#202#203#203#203#202#203#202#202#169#202#169#202#198
- +#169#168#165#165#164#129#132#133#132#133#132#133#128']\]Y'#0#0#0#198#165#198
- +#165#198#165#164#161#161#160#160#199#160#161#161#164#129#164#160#165#202#207
- +#202#207#202#207#202#203#207#202#203#203#202#203#202#203#202#169#202#168#199
- +#202#165#198#198#160#161#160#161#164#161#165#161#160#160#165#128#165#164#161
- +#202#202#203#203#202#202#203#206#203#203#202#203#202#203#202#203#202#202#203
- +#198#168#198#164#198#165#164#199#160#165#160#161#160#165#160#165#160#165#164
- +#161#164#169#202#203#202#203#202#207#203#202#206#203#203#202#203#203#202#203
- +#202#169#202#165#164#168#169#128#169#173#168#133#133#133#133#133#129']\]'#0#0
- +#0#169#198#164#198#165#160#161#160#160#161#160#161#160#160#160#165#164#165
- +#161#168#203#202#203#202#203#202#203#206#203#203#206#202#207#203#202#203#202
- +#202#203#199#168#199#198#165#164#199#164#164#160#161#194#160#160#199#160#165
- +#160#169#164#165#198#203#202#202#203#207#202#203#202#207#203#202#203#202#169
- +#202#203#202#198#169#198#165#198#165#198#160#164#161#160#195#164#160#199#160
- +#161#164#129#164#165#198#202#203#202#203#202#203#202#203#207#203#203#202#203
- +#168#203#202#203#168#202#203#168#203#165#164#169#172#133#133#169#132#133#132
- +#129'`'#129']]'#0#0#0#198#164#199#165#198#160#165#160#161#160#161#160#165#194
- +#165#169#164#165#168#198#203#206#203#207#203#207#207#203#203#206#203#203#203
- +#202#203#202#169#203#198#168#198#198#165#164#199#164#161#195#161#164#160#161
- +#195#160#161#164#129#168#169#194#202#203#202#203#203#202#203#203#206#203#202
- +#203#202#203#202#203#168#199#169#198#203#198#165#198#164#199#161#164#161#164
- +#160#165#160#194#165#164#165#164#195#164#203#202#207#203#207#202#207#203#202
- +#203#202#203#202#203#202#169#203#202#169#165#168#165#168#169#173#169#133#168
- +#133#133#133#133#133'a]\]'#0#0#0#202#199#164#198#164#199#160#165#160#161#164
- +#194#161#161#164#169#169#164#165#164#203#202#203#202#206#203#202#207#202#203
- +#207#202#202#169#202#203#202#202#202#199#202#165#198#198#164#195#164#164#160
- +#160#199#160#164#161#164#161#164#169#165#165#202#203#202#207#202#203#206#203
- +#203#203#202#203#202#203#202#203#202#202#202#202#165#202#164#199#165#160#198
- +#161#164#161#164#195#160#165#164#161#160#165#164#198#203#202#203#202#203#203
- +#202#203#207#202#203#207#169#202#203#203#168#203#168#202#169#168#169#168#169
- +#136#169#137#133#133#133#132#133'\'#133']]'#0#0#0#165#202#199#164#199#164#161
- +#164#195#164#161#164#194#164#161#160#173#164#165#203#202#207#203#203#203#206
- +#203#207#207#202#203#207#203#202#203#202#203#168#203#164#203#198#165#198#165
- +#164#195#165#194#165#160#199#160#194#165#164#161#168#164#194#168#203#202#203
- +#202#207#203#202#207#202#207#203#203#168#203#202#203#202#165#202#198#165#198
- +#164#198#165#160#198#161#198#161#164#195#160#165'|'#161#160#165#164#202#203
- +#202#203#206#203#207#202#203#203#202#203#203#203#168#202#203#168#203#168#203
- +#168#169#173#169#173#169#173#133#136#133#133'a'#133'a\]'#0#0#0#202#198#164
- +#199#164#199#164#194#164#165#194#165#161#198#160#165#168#169#164#164#203#202
- +#202#207#202#203#207#202#203#203#206#202#203#203#202#203#202#199#202#202#198
- +#165#198#165#198#165#160#164#165#161#198#160#165#199#160#161#164#169#199#165
- +#198#202#203#202#203#203#202#203#202#203#202#203#202#203#202#203#168#199#202
- +#199#168#198#165#198#165#198#165#164#160#165#198#161#164#198#160#161#160#165
- +#164#199#202#203#203#202#203#203#202#203#207#202#207#202#202#203#203#203#168
- +#203#168#203#169#168#173#173#169#173#133#137#169#133#133#133#133#132'a]]'#0#0
- +#0#199#164#199#164#164#199#160#165#161#194#165#160#198#164#199#164#165#165
- +#164#199#202#203#207#203#203#207#202#203#207#202#203#203#203#202#203#202#169
- +#202#169#198#165#202#164#198#165#198#164#199#160#198#160#165#198#160#164#165
- +#164#169#164#164#198#203#202#203#206#202#207#202#207#202#203#202#203#202#203
- +#202#203#202#165#202#198#165#198#199#164#199#164#195#164#199#160#164#198#165
- +#161#160#165#160#199#164#203#203#206#203#203#202#207#203#202#203#203#203#203
- +#203#202#168#203#168#203#169#202#169#173#169#173#173#133#173#133#133#137#132
- +#133'a'#129'`]'#0#0#0#202#199#168#199#198#164#199#160#198#164#161#199#164#195
- +#164#165#164#164#165#198#202#203#202#207#202#207#203#207#202#207#202#203#202
- +#203#202#203#202#198#202#199#202#198#165#199#198#164#199#160#199#160#165#194
- +#165#194#161#164#165#173#165#198#165#202#203#202#203#203#202#203#203#202#203
- +#202#202#203#202#169#198#202#202#165#198#198#165#164#198#165#164#198#161#164
- +#164#199#161#198#160'}'#160#165#164#198#202#203#203#203#206#203#202#203#207
- ,#202#169#202#203#168#203#203#168#203#168#169#168#169#173#173#137#169#173#133
- +#137#133#133#133#132'aa]]'#0#0#0#168#198#199#164#199#164#198#165#161#198#164
- +#194#165#164#198#169#169#165#164#165#203#202#203#202#203#202#203#202#203#203
- +#203#168#203#202#169#202#203#169#198#168#199#164#198#164#199#164#198#165#164
- +#199#164#199#164#199#160#165#164#168#169#164#198#203#202#203#202#203#202#202
- +#203#202#203#203#203#168#203#202#203#164#203#202#165#202#198#165#198#198#165
- +#165#198#165#198#164#199#164#165#160#161#160#165#165#168#202#202#203#203#203
- +#207#202#203#203#206#203#202#203#168#203#203#168#203#169#168#173#169#173#169
- +#137#169#137#133#137#133'a'#133#133'`]]'#0#0#0#199#198#168#199#164#199#164
- +#198#198#165#198#165#198#195#164#169#164#164#169#198#168#203#207#202#207#203
- +#206#203#207#202#203#202#203#202#203#202#202#198#203#198#198#203#165#198#164
- +#199#165#198#198#164#199#164#194#164#165#164#165#169#203#164#165#202#203#202
- +#203#202#203#203#202#169#202#202#202#203#202#203#202#203#198#164#202#165#198
- +#198#165#164#198#198#165#198#199#164#198#165#160#161#164#165#164#198#199#203
- +#203#202#202#203#202#203#202#203#203#203#203#202#203#169#202#169#168#169#169
- +#169#173#173#173#173#137#169#137#132#133#133#133'a]]]'#0#0#0#198#168#199#198
- +#199#164#199#164#165#164#199#164#199#164#165#203#164#165#165#164#203#203#202
- +#203#203#202#203#203#202#203#202#203#202#203#202#203#164#203#198#164#203#164
- +#198#164#199#164#198#164#165#199#198#164#199#165#160#165#164#203#173#165#198
- +#203#202#202#203#202#203#202#202#203#202#203#203#202#203#168#198#202#165#203
- +#198#199#198#169#198#199#198#165#164#199#164#165#165#164#165#198#165#164#165
- +#165#202#203#202#203#203#203#203#203#203#203#202#203#168#203#169#202#169#168
- +#203#169#168#173#173#169#137#133#133#137#133#133#133'aa\a\9'#0#0#0#202#199
- +#164#202#165#198#164#199#198#198#165#198#164#199#164#169#165#198#169#164#199
- +#202#203#203#202#203#203#202#203#203#203#168#203#202#169#202#203#164#203#198
- +#164#199#198#165#198#199#164#199#198#198#164#199#164#198#164#165#164#164#168
- +#199#164#164#203#203#202#203#202#203#203#202#203#202#202#169#202#198#169#199
- +#202#198#165#202#164#199#164#198#165#198#199#164#199#202#202#199#202#169#202
- +#199#164#202#165#202#165#203#202#203#202#203#202#203#169#202#203#203#202#169
- +#203#169#168#169#169#169#132#133#133#133#133']'#133#133#133#132#133'a]]]'#0#0
- +#0#165#202#199#198#199#164#203#164#199#164#198#165#198#168#203#168#199#168
- +#199#202#165#202#203#202#203#202#203#203#202#203#202#203#202#199#202#199#202
- +#198#168#203#198#168#199#198#164#199#198#164#199#164#199#164#199#164#203#202
- +#199#203#198#168#199#202#164#202#203#202#168#202#203#202#169#202#203#198#203
- +#202#198#202#165#202#203#198#203#198#199#164#199#168#203#202#203#169#202#169
- +#203#198#169#203#203#165#202#165#202#165#203#198#169#202#165#202#203#169#203
- +#168#203#168#169#169#173#169#137#169#133#137#133#133#132'a`]]aa`]9]'#0#0#0
- +#202#199#168#199#168#199#198#199#164#203#169#202#203#203#202#203#202#203#202
- +#169#198#199#168#199#202#169#202#198#203#198#203#202#202#203#168#202#165#202
- +#199#198#165#198#198#165#198#198#164#199#198#169#202#202#202#203#202#164#202
- +#168#199#202#198#165#202#199#164#202#199#199#198#198#198#203#198#202#202#165
- +#202#165#202#198#164#199#164#199#164#203#202#203#202#203#168#203#203#203#202
- +#169#203#198#169#202#165#203#164#165#164#169#198#165#168#165#164#169#168#165
- +#169#169#169#173#169#137#173#133#173#133#133#133#133#133']]\]]]]\9'#0#0#0#198
- +#169#198#199#198#164#199#164#203#203#202#203#203#202#203#203#203#169#203#199
- +#168#203#164#199#164#199#198#165#164#199#164#198#199#164#198#199#198#199#198
- +#165#198#198#165#198#199#164#199#198#168#202#203#202#203#168#203#203#202#199
- +#202#202#165#202#199#164#198#165#198#164#198#165#199#164#198#165#199#198#203
- +#198#198#169#199#202#199#164#199#202#203#203#169#203#203#203#203#203#169#203
- +#203#169#203#165#203#164#199#169#203#164#165#168#165#164#169#164#165#132#169
- +#169#173#173#173#169#169#137#133#133#133#132#133'a\]]9Y\]9Y'#0#0#0#203#198
- +#203#164#203#199#202#207#203#203#203#207#203#203#203#169#202#203#168#203#198
- +#169#199#202#165#198#165#198#199#164#198#161#198#198#165#198#164#199#164#198
- +#164#199#198#164#198#198#169#202#203#203#202#169#202#203#202#202#169#202#169
- +#198#203#164#202#165#203#164#199#198#165#198#164#198#165#198#164#198#164#199
- +#165#198#198#165#198#203#206#203#203#207#203#203#203#203#169#203#203#169#203
- +#203#169#203#169#203#169#164#165#165#169#165#169#165#129#169#129#169#173#173
- +#173#169#137#173#137#169#137#133#133#133'aaa]]\95Y85'#0#0#0#198#169#198#203
- +#164#203#203#203#207#207#203#203#203#169#203#203#203#203#203#169#203#199#168
- +#199#169#198#165#164#199#164#165#164#161#161#198#161#198#164#199#164#199#164
- +#199#198#165#202#202#203#202#203#202#203#202#203#203#202#203#202#203#202#168
- +#199#202#198#164#199#164#165#198#165#198#161#198#161#198#161#198#164#198#165
- +#198#199#168#203#203#207#203#203#207#203#207#203#203#203#203#203#169#203#203
- +#165#203#165#203#165#169#168#165#168#169#168#169#164#129#169#173#173#173#173
- ,#169#137#169#137#133#137#133#133#133#132']\9]'#3'9555'#0#0#0#164#199#164#199
- +#203#207#203#207#203#203#207#207#203#203#207#203#203#169#203#203#203#168#199
- +#169#198#165#198#165#164#199#198#161#164#160#161#164#161#198#160#199#164#198
- +#164#165#202#203#203#202#207#202#203#202#203#202#169#202#203#202#168#203#198
- +#202#165#165#202#164#199#198#164#198#165#164#165#164#161#164#165#194#165#198
- +#165#164#203#203#207#203#207#203#203#207#203#203#207#203#203#169#203#169#203
- +#169#203#169#165#169#165#165#169#165#165#169#169#129#133#173#173#173#173#169
- +#137#173#137#133#137#133#133#133'aaa]]995450'#0#0#0#199#198#199#203#207#203
- +#207#207#203#207#207#203#203#207#203#203#207#203#203#203#169#199#203#164#199
- +#164#165#198#165#198#165#164#160#161#164#160#165#160#165#164#195#164#199#202
- +#203#206#202#203#202#203#202#203#202#203#202#203#168#203#202#203#202#169#198
- +#202#198#165#198#164#165#199#164#199#160#161#164#161#160#165#164#165#198#203
- +#207#203#207#203#203#207#207#204#203#207#204#169#207#203#203#203#169#203#169
- +#165#169#169#165#169#165#165#169#165#169#169#173#173#173#133#173#173#137#173
- +#133#137#133#133#133'a'#132'a]\9\54555'#0#0#0#164#199#169#203#207#207#203#207
- +#204#207#203#207#207#203#207#169#203#203#169#203#203#169#203#165#165#198#165
- +#165#160#165#160#199#160#161#160#161#160#165#160#161#164#161#164#203#202#203
- +#207#202#203#206#203#207#202#203#203#202#203#202#203#164#203#198#168#199#165
- +#198#164#165#198#164#194#165#198#160#161#164#165#160#165#164#165#207#203#207
- +#203#207#208#203#203#207#208#203#207#203#203#170#203#170#203#170#169#169#165
- +#165#165#129#165#169#133#169#169#133#173#169#173#173#137#169#173#133#137#133
- +#133#133#133#133'aa]]595554'#13#0#0#0#165#165#203#207#203#207#207#207#207#203
- +#208#203#207#208#203#208#203#203#203#169#203#203#165#203#165#165#164#164#165
- +#164#165#160#165#160#161'|'#161#160#161#164#160#165#202#202#207#202#203#207
- +#203#203#206#203#203#206#203#203#202#203#202#203#202#165#202#164#198#165#199
- +#198#165#199#164#198#165#164#161#160#161#164#161#164#203#203#207#203#207#203
- +#207#207#207#203#207#208#203#208#203#207#203#203#169#203#203#170#169#169#169
- +#165#133#165#129#169#133#169#173#173#173#137#173#138#173#137#137#133#137'a'
- +#133'a'#133'`]]\554550'#0#0#0#165#203#207#207#207#203#208#203#207#208#207#207
- +#208#203#207#203#203#208#203#203#203#169#203#165#203#165#165#165#160#165#160
- +#165#164#161#160#161#160#161#160#161#165#164#203#207#202#203#207#202#207#202
- +#203#202#207#203#202#207#202#169#202#203#168#202#203#199#168#198#164#165#160
- +#164#165#164#198#165#160#165#164#165#164#165#203#207#203#207#203#207#203#208
- +#203#208#203#207#208#203#204#170#170#170#169#134#129#133#129#165#129#133#129
- +#129#133#165#133#173#138#173#133#173#134#173#137#133#137#133#133#133#133#133
- +'a]]995455'#12#13#0#0#0#165#207#207#203#208#207#207#207#208#207#203#208#203
- +#208#208#203#208#169#203#203#169#204#165#203#165#165#165#164#161#164#161#164
- +#161#164#161#164'|'#165#164#165#164#164#203#202#203#203#206#203#203#207#203
- +#207#203#202#203#202#203#203#202#203#202#199#164#164#198#165#165#198#164#199
- +#160#199#165#198#161'|'#161#164#165#203#207#203#207#207#203#208#208#207#208
- +#207#208#208#170#170#170#134#130#134#247#247#247#247#247']'#247#129#129#133
- +#129#133#133#169#173#137#174#137#173#137#133#137#133#137'a'#133'a`]a9\54550'
- +#17'1'#0#0#0#169#203#208#207#207#208#208#208#207#208#208#207#208#207#203#208
- +#203#204#207#170#203#169#203#165#165#165#165#165#160#165#164#161#164#161#164
- +#129#169#173#133#164#165#198#203#207#202#207#203#202#207#202#207#202#203#207
- +#203#202#203#202#203#168#203#168#203#198#165#198#164#164#165#164#165#164#194
- +#165#164#165'|'#129#165#169#203#207#203#208#207#207#203#208#207#208#170#170
- +#170#134#130#134#134#247#134#247#134#247'a'#247']'#247']]'#247#129#133#137
- +#174#137#133#173#137#133#137#133#137#133#133'a'#133'a`]]9555'#12#17'0'#12#0#0
- +#0#169#207#207#204#207#207#207#208#207#208#207#208#208#208#208#208#208#203
- +#204#203#204#169#203#169#165#165#165#165#165#161#160#165#160#165#160#169#133
- +#173#165#164#165#169#202#203#207#202#207#207#203#207#203#207#202#203#207#203
- +#202#169#202#203#202#199#164#203#164#165#198#165#160#161#164#165#164#199#164
- +#164#169#164#165#203#207#203#207#203#208#208#207#208#204#170#170#130#170#8
- +#134#134#134#134#247#247#247#247#247#247'^]'#7']]]'#247#137#137#174#137#137
- +#134#137#137#137#133#133#133#133'aaa]\954551'#17'1'#0#0#0#203#207#208#207#208
- +#208#208#208#208#208#208#208#208#204#170#170#170#170#170#170#165#166#169#166
- +#165#165#165#129#161#128#165#161#160#165#160#169#129#164#169#165#164#202#203
- +#206#203#203#203#202#203#206#203#202#203#207#202#168#203#203#202#203#164#203
- +#168#198#165#198#165#164#165#164#161#160#165#160#161#165#169#129#165#203#207
- +#207#208#207#207#207#208#174#170#8#170#8#134#134#130#134#130#130#134#134#247
- +'^^^]'#7'b]^]]'#133#138#133#137#133#137#137#133#133#137#133'aaa]]]95451'#16
- +'1'#12#13#0#0#0#207#208#203#207#208#207#208#208#208#208#208#170#170#170#170
- +#134#170#130#170#130#130#134#129#129#247#165#165#161#129#161#161#160#165#160
- ,#161#164'}}'#165#128#165#199#202#203#203#207#202#207#207#203#203#207#207#202
- +#203#203#203#202#202#169#202#203#198#165#198#165#164#165#164#161#164#165#164
- +#164#165#164#169#133#165#169#203#207#203#207#204#208#204#170#8#170#134#134
- +#134#134#134#9#134'b'#134'^^^^^'#7'b]'#7'a]]'#138#137#137#138#137#134#137#133
- +#137#133'aa'#133']a\99455'#16'1'#16'1'#12#0#0#0#204#207#208#208#208#208#208
- +#208#208#171#170#8#170#9#170#170#130#8#130#134#130#247#247#247#129#129#129
- +#129#129'}'#164#161'|'#161#160'}||'#129#160#164#202#203#207#202#203#207#202
- +#203#202#207#202#203#203#206#203#202#169#203#202#168#198#169#198#165#164#165
- +#164#161#164#161#164#161#165#160#165#137#169#165#203#208#207#208#208#207#174
- +#170#134#8#134#8#9#134#9#134'b^'#130'^^b^^^b'#7'^='#7'>]a'#134#137#133#137
- +#133#133#137#133'a'#133'aa`]]955'#17'4'#13#13'1'#12#13#0#0#0#203#208#207#208
- +#208#208#208#170#170#8#170#8#170#170#9#8#134#134#134#130#134#247#247#247#247
- +#7#7'}'#129'}}'#129#160#161#164#161'}|'#129#165#161#168#203#202#207#202#203
- +#207#203#207#203#207#202#203#203#202#203#202#203#203#203#164#198#169#198#165
- +#164'}'#164'}'#160#161#164#160#165#160#169#133#165#165#207#203#207#207#208
- +#170#8#8#134#8#134#134#134'b'#9#130#9'b^^^^^^^'#7':'#7']'#7'9a'#137#134#137
- +#133'e'#133'a'#133#133'aaa]9]945'#13'50'#16#13#13'0'#0#0#0#207#208#208#208
- +#208#208#171#170#8#8#171#8#9#8#134#134#9#130#134#130#134#247#247#247#7#129#7
- +#129#7'}'#129#161'}'#128#161'|}|'#129#128#161#198#203#203#203#203#203#202#203
- +#202#203#202#203#202#169#203#202#203#168#202#164#203#168#165#164#164#165#164
- +#161#160#165'|'#165#165#160#165#133#129#165#169#207#208#207#208#170#134#134
- +#134#8#134#9#134#9#134#130'bb^b^^^^:'#7':'#7'9:9'#7'9b'#137#133'b'#133#133
- +#133'aaaa]9\94550'#17#13'1'#13#12#13#0#0#0#204#208#208#208#208#170#8#8#8#9
- +#170#9#8#134#9#9#130#134'b'#9#247#247#247#247'^'#7#247']'#7#129'Y'#129'|'#161
- +#160#129#128#129#128'}'#160#165#202#203#202#169#202#203#202#203#203#203#202
- +#203#203#202#203#168#203#169#203#164#165#198#165#165#164'}'#164'}|'#161#160
- +#160#165'|'#133#133#133#165#207#203#208#170#134#8#8#8#9#134#134#9'b'#9'b'#9
- +'^b^^:^:'#7'::'#7':9'#7'95]a'#133#133#133'aaaaa\]]9555'#12#17#12'1'#12#12'05'
- +#0#0#0#204#208#208#204#171#8#9#8#9#8#9#134#9#9#130#134#9#9#247'^'#9'^^'#247
- +#247#7#7#7']'#7'Y}}'#129'|}]'#133#129#128#161#164#203#202#203#202#169#202#169
- +#202#169#202#169#202#169#203#168#203#198#202#164#203#164#165#164#128#161'|}|'
- +#165'|'#165#129#160#129#133#133#133#165#208#207#208#8#134#134#134#134#8#134#9
- +#134#134'b^b_^^^^:^:69:5:9995aaaaaaaa]9]8545'#12#17'1'#13#12#13#13#13#13#0#0
- +#0#170#208#208#8#134#9#134#9#134#9#9#9#134#9#9'b'#130#9#9#130'b'#130'b^^^'#7
- +#7#7']'#7']Y}}|}'#128#129'}|'#165#198#169#202#203#202#203#198#203#202#203#202
- +#199#202#203#202#169#169#169#164#168#164#165#165#160#129'|'#129'|}}|'#161#164
- +'}'#133#133#133#165#169#207#170#134#8#134#8#134#138'b'#134#9'b'#9'b^b^^:^^::'
- +':6:5656555aaaaaa]]]99555'#13'0'#13'0'#13#12#12'1'#12#0#0#0#170#208#170#9#134
- +#9#9#9#9#9#134#9#9'b'#9#9#9'bb'#9'^b^^^^]^]'#7']YY'#129'|}\Y'#129'|}'#160#165
- +#202#199#164#165#164#165#168#165#168#165#168#169#168#169#168#169#168#169#165
- +#165#128#128#129'|}|}|'#129'|'#129'}'#128#133#133#134#133#203#207#134#134#134
- +#138#134#138#134#134#134'bbbb^b^:^::6:565655'#17'5'#17'55]aa]]8]9945'#16#13
- +'0'#13#12#13#244#13'1'#12#13#0#0#0#170#204#134#9#9#134#9#134#9#134#9#9#134#9
- +#9'bb^'#9'^b_b^^^^'#7#7']'#7']YY}'#129'Y'#129#128']|}'#164#199#164#165#164
- +#165#164#165#164#165#164#169#168#169#169#169#168#169#133#128#128#129#129'}|}'
- +'}|}|}'#128'|'#129#133'a'#133#129#169#170#138#138#174#134#137#134#138#134#134
- +'a'#247'b^b^:^::6:6665'#18'5'#18'555'#17#13'49]]9]9455'#13'1'#13#12#13#245#12
- +#13#12#12#13#12#0#0#0#130#9#9#134#9#9#9#9#9#9'b'#9'c'#9'b'#9'c'#9'b_b^b^^^]^'
- +'9'#7']'#7'Y]Y]\Y]}'#128'}|'#165#164#165#164#165#164#165#164#165#168#133#169
- +#173#168#169#169#132#169#133#129#129#128#128']||Y|}'#128'}'#129']'#133#129'a'
- +']'#133#174#169#138#137#174#138#134#138#134#138'bba:]^^::::565'#18'6'#17'5'
- +#17#17#17#13#17#13#13#12'5594555'#12#13#12#244#13#12#12#13#12#13#245#12#245#0
- +#0#0'b^^'#9'b'#9#9'b'#9#9'cb'#9'bcbbcbbcb^bb^^^'#7#7'Y]YYY]]'#3']]Y|}|'#165
- +'|'#129'|'#129'}'#128#133#169#168#169#169#169#169#132#169#132#133#128#129#129
- +#129'}]'#129'|Y|}'#128'|]]]'#133'a'#169#138#173#174#134#137#138#137#138#133
- +'b'#134'bbb^9:6666'#18'6'#18'5'#17#18#13#17#13#13#17#13#13#13#13#13#12#13#17
- +'1'#12#12#13#12#13#13#244#13#244#13#244#12#13#244#12#0#0#0'^'#9#9'_'#9#9'b'#9
- +'cb'#9#9'c'#9'b'#9'cbcbbbb^b:b]b]b]]]Y'#3'Y]]\]}'#3'}|}|}|'#128#129#129#132
- +#133#169#132#173#133#169#133#133#133#133#128#129'\]'#128'Y|}'#129#3'}]a]a'
- +#133#169#137#174#137#138#173#138#134#138#134#138#133'ba^]::'#7'965'#17'6'#17
- +#17#14#13#13#13#13#13#13#13#13#13#12#13#12#13#12#13#12#13#13#12#245#12#12#13
- +#245#12#244#13#244#244#244#245#0#0#0'ccbb'#9'^'#9'cb'#9'bcbbccbcbbcbcbb'#134
- +#134#134#134#133#133'b'#133']]Y]]]]Y\}|}|}}'#128#129#129#132#133#168#169#173
- +#133#168#133#133#128#133#128#129']Y'#3'Y]]Y'#3'}]'#133'aa]'#137#138#174#133
- ,#174#173#138#137#138#133#138#133'bbba^9'#7'9:5'#17#14#13#13#14#13#13#13#13#13
- +#13#13#13#13#13#13#12#13#244#244#245#12#13#244#244#13#244#245#244#244#244#245
- +#244#245#244#13#244#0#0#0'^^ccccbc'#9'ccbcccbcbcbbbbb'#138#138#138#138#137
- +#138#133#133'a]]]\Y]\]]Y'#3'}}'#3'|}Y'#128#129#133#133#133#133#169#133#132
- +#133#133#129']\]\]Y'#3']'#3'Y'#3']a'#133'a'#133#173#173#137#173#137#138#137
- +#134#137#138#133'f'#133'aa'#7'9:9:556'#17#13#13#13#13#13#13#13#245#13#13#13
- +#13#244#13#245#244#245#244#245#244#245#244#245#244#245#244#245#244#245#244
- +#245#244#245#244#245#0#0#0'cb^bcbcbcbccbcbcbcbcbb'#138#8#138#138#133#138#133
- +#134#138'a'#133#133']]Y\Y]X9XY'#3'Y}Y'#3'Y]'#128#133#133#132#133#133#133#133
- +#133#132#133#129']]Y'#3']5'#3']'#3'Yaaaa'#133#137#174#137#138#173#134#137#137
- +#134#137'b'#133'bbb='#7'99595'#17#13#13#13#13#13#245#13#13#13#245#245#244#245
- +#245#244#245#244#245#244#244#244#244#244#244#244#244#244#244#244#244#244#244
- +#244#244#244#244#0#0#0'^_c_bcccbcbccbcbcbgbc'#138#138#138#174#138#138#138#138
- +#137#133#134'aa]]\5'#3'YY]Y'#3'UX'#3'XYX]]'#133#132#133#133#132#133#132'a'
- +#133']\]\]Y5X]Y]Yaaa'#133#137#173#137#169#137#134#137#138#138#137#134#137#133
- +'aaa9]955'#17'55'#13#13#13#13#245#13#245#245#245#245#244#245#245#244#245#244
- +#245#244#240#245#244#245#244#241#244#245#244#245#244#245#244#245#244#245#244
- +#245#0#0#0':c^b_bcbcccbbc>cbcbc'#138#8#8#8#138#138#138#134#137#134'b'#133'a'
- +#133']]]YYYXY4]YXUYYYX]'#128#133#133#133#133#133#133#133#128'a]]Y5Y4YY5\58a]'
- +#133#173#133#174#137#138#173#138#133#133#133'e'#133'aba]]955555'#13#13#13#13
- +#245#13#245#245#245#244#245#245#245#244#245#241#244#245#244#241#244#240#244
- +#240#244#244#244#0#244#240#244#244#244#244#244#244#244#0#0#0'_^?cb;bcb?bcccb'
- +'cbcbf'#8#8#138#138#138#170#138#138#134#137#137#134'aa]]]4Y45Y5Y4YY4YXY]]'
- +#133#132#133#132'a'#132'a]]\]X54Y54Y5]]aa'#137#137#137#137#173#137#133#137
- +#138#137#138#133'baaaa9955'#17'5'#17'5'#13#13#245#245#245#244#245#245#245#245
- +#244#241#245#244#244#241#240#244#240#240#245#240#244#245#0#245#244#244#245
- +#244#245#240#245#244#245#244#0#0#0':_^;bc;bcbc>cbcbgbc'#8#8#8#8#174#138#138
- +#138#137#138#134#137'a'#133'aa]9]5YXY45544U4Y4]\]'#133#133#133#133#133']\]Y]'
- +'Y554554Y8=aa'#133#173#133#137#134#137#137#134#137#133#133#137#133'aa]]99555'
- +#17#13#17#13#13#245#245#245#245#245#244#245#245#245#244#240#241#245#244#241
- +#240#245#0#240#245#0#244#240#240#241#240#240#240#244#244#240#244#244#244#0#0
- +#0';::c;^c>_?bcc>cbcbf'#8#8#8#138#138#174#138#138#138#134#137'b'#133'aaa]\5X'
- +'550Y54555055Y]]\a\]\]]]\54505145555]a'#137#137#137#137#137#133#138#137#133
- +#138#137'aaaaa]955'#17'4'#13'5'#12#13#245#244#245#244#245#240#245#245#0#245
- +#245#245#244#0#241#244#240#0#244#240#0#244#241#240#244#240#244#241#244#0#245
- +#244#241#244#245#0#0#0'::;^>c>_?bc>>cc>cf'#9#8#138#8#138#174#138#138#134#137
- +#137#134#137#134'aa]]9Y55455055501504]\]]]]]]9X5550554554549a'#137#133#133
- +#137#133#138#137#133#137#133'a'#133'aa]]9954'#17'1'#12#13#13#13#244#245#244
- +#245#245#245#245#240#245#245#0#244#0#245#244#245#0#244#241#0#244#240#0#244#0
- +#245#0#244#240#245#244#240#244#244#240#0#0#0':;:;;:_>^?:cc>bcbb'#8#8#8#174
- +#138#138#174#137#138#134#138#137'aaa]a]94545141945001155]]]\]5\Y545410110555'
- +'9=a'#133#137#137#133#137#137#133#137#133'e'#133'aaaa994'#17'5'#12#17#13#13
- +#12#13#245#245#245#244#241#244#0#245#244#0#245#240#245#0#240#244#0#0#240#244
- +#0#241#240#240#240#240#240#245#0#244#0#244#240#241#244#0#0#0'6:::;>;;>c>>_?b'
- +'?cf'#8#8#8#8#138#174#138#138#138#137#134#138#133#133'aa]\]5550514115'#13'00'
- +'014545545545511'#12'1'#12'1'#13'049aaa'#133#133#137#137#133#137#133'e'#133
- +'a'#133'aaa]]954'#17'1'#12#13#12#13#12#244#0#245#244#241#245#240#240#241#245
- +#0#245#0#245#0#245#240#240#0#245#240#0#0#241#0#244#0#240#240#245#240#241#244
- +#240#240#0#0#0#18':7::;:>;:_?>b?b>'#9#8#138#138#138#174#138#138#134#138#138
- +#133#137'baaa]994545101'#244#12'50'#13'1'#13'015554554550'#13'0'#13'0'#13#12
- +'0'#13'59a=a'#133#137#133#133#137#133#137#133#133#133'aaa]98555'#13#12#13#12
- +#13#12#245#245#245#244#241#244#240#245#241#244#0#245#0#244#0#244#244#244#0
- +#240#13#244#244#240#240#240#240#241#244#0#240#240#244#0#245#244#0#0#0#18'6'
- +#22':;:;;:?>:c?b>cb'#8#138#8#174#138#138#138#137#138#133#137'baaaa9]45510'#12
- +'10'#244#13'5'#16#245#12'0'#12'11001'#13'0110'#13'0'#13#244#13#12','#13#13'5'
- +#16'59aa'#133#133#137#133'a'#133'aaaaa]]995'#13#12#13#12#13#12#13#244#245#244
- +#244#0#245#0#245#0#244#0#245#0#245#0#244#244#241#240#241#0#244#245#21#244#0#0
- +#0#240#0#244#240#240#241#240#244#244#0#0#0#14#18'6'#18':;::;::?:>?b>'#138#8
- +#138#138#138#138#138#138#134#138'a'#138'aaaa]]955'#16'0'#13'1'#12#13#244#244
- +#17'1'#244#245#244#245#12#12#13'1'#13'0'#13'0'#13#12#13#244#12#245#12#245#13
- +#244#12'5599=a'#133#133'a'#133#133'a'#133'aaa]\995'#16'5'#13#12#13#244#13#244
- +#13#244#240#241#245#244#0#245#240#241#245#0#244#0#240#241#244#244#244#244#0
- +#244#244#17#12#244#244#241#240#240#0#245#0#244#240#245#244#0#0#0#14#18#18#18
- +'6'#18';::;;:?:>?>b'#8#138#138#138#138#134#137#138#134#137#134#133'aaaa]4551'
- ,#13'0'#13'0'#13#241#12#17#244#244#244#245#244#245#244#244#244#245#244#13#244
- +#244#245#244#245#244#245#244#244#244#13#16#17'4='#21'9=a`'#133'a'#133'aaaaa9'
- +']9455'#12#13#244#13#13#12#245#244#241#244#244#0#245#244#0#244#0#240#241#240
- +#241#240#244#0#245#0#240#240#13#245#13#13#245#244#244#0#240#240#0#240#0#244
- +#240#240#0#0#0#13#14#18#18#18':'#18':;:::::?:>b'#138#138#138#138#134#137#138
- +#134#137#134'eaaa]]8550'#13'0'#13'0'#13#12#244#244#13#12#13#244#244#244#240
- +#244#245#244#244#244#244#245#244#244#244#244#244#244#244#245#244#244#13'5'#13
- +#17'49=]a'#133'a`a`a]\]9455'#12#13#12#13#12#244#245#244#245#240#245#0#245#0
- +#240#241#0#245#0#244#0#240#240#241#244#240#244#245#240#13#244#0#13#244#240#13
- +#244#13#244#244#245#240#240#245#244#0#0#0#6#14#14#14#18#18'6'#22':'#22':;:::'
- +':>>'#138#138#134#138#137#138#134'e'#138'aaaaa]9554'#13#12#13#12#12#245#244
- +#240#13#17#17#17#244#240#245#244#245#240#244#245#244#245#244#244#245#240#245
- +#244#244#241#244#244#13#244'9'#12#244#245#17'99aaaaa]]9]9955'#12#13#12#245#12
- +#244#245#244#244#240#244#0#244#0#240#241#244#0#240#240#0#245#244#245#244#0
- +#245#240#0#244#244#240#0#0#0#0#21#17#12#17#17#12#240#245#244#240#0#0#0#245#13
- +#6#14#14#18#18#18'6'#18'::::::::b'#138#138#138#134#138#133#134#133#134'aaa]9'
- +'854'#13#13','#13#12#245#12#245#240#244#13#244#13#244#240#244#240#240#245#244
- +#244#244#240#245#240#244#244#240#245#240#244#245#16#17#13#13#16'9'#16'99==\]'
- +']]9]]9454'#13#13#12#13#244#244#245#244#245#0#245#0#245#0#245#240#240#0#244#0
- +#241#244#0#244#0#240#244#0#244#240#245#21#12#240#240#245#240#13#245#244#17#21
- +#244#0#240#0#244#0#0#0#13#245#245#13#6#14#18#18#18'6'#18#22':'#22'::'#22':^'
- +#137#134#137#134'e'#138'eaaaa9]955'#13'0'#13#13#12#245#244#244#12#17#12#13#13
- +#16#241#244#245#244#244#240#240#241#240#244#240#240#241#240#240#240#240#244
- +#13#17#244#12#17#17'='#21'99='#21'99\]\94551'#13#12#13#244#245#244#245#244
- +#244#0#244#240#244#0#244#0#240#241#0#241#240#240#240#245#240#244#241#244#240
- +#241#0#244#13#13#244#240#244#12#244#244#13#17#17#245#240#244#245#240#0#0#0
- +#245#245#219#245#10#6#14#14#18#18#18'6'#18#22'6'#22'::'#21'b'#138'b'#138#134
- +'a'#134'aaa]]9545'#12#13#12#12#245#244#244#13#13#17#245#12#13#13#240#244#244
- +#245#0#244#240#240#240#241#240#240#244#240#12#244#13#240#244#244#17#17#17#12
- +#13'5'#21'9'#21#17'5'#17'9955550'#13#12#245#244#245#244#244#244#0#245#240#241
- +#0#240#0#241#240#0#240#244#240#244#241#244#0#244#0#244#0#244#244#0#244#13#0#0
- +#0#13#17#13#244#13#244#12#240#0#241#0#244#0#0#0#245#245#245#245#219#245#6#14
- +#6#14#14#18#18#18'6'#18'6'#17'6:b'#137'aaaaaa=]8545'#13#12#13#244#245#244#244
- +#13#12#244#244#244#12#240#244#0#244#241#240#240#245#13#16#17#12#244#13#12#17
- +#17#13#21#12#13#13#13#12#13#244#13#21'9'#21'9'#16#17#16'9'#17'85'#12#12#13
- +#244#244#244#244#240#12#13#240#245#240#0#240#240#241#240#244#0#245#240#240
- +#241#0#244#0#240#245#240#241#240#241#0#240#241#12#0#0#0#244#245#244#240#244
- +#244#245#240#240#240#244#240#0#0#0#245#245#245#245#245#245#13#245#14#13#6#14
- +#14#17#14#17#18#18#17#17'9babaaa]]9955'#13#12#245#12#244#244#245#244#12#13
- +#245#13#245#13#244#13#241#244#244#244#0#244#17#17#12#13#17#12#13#12#13#244
- +#245#244#240#240#12#17#244#13#21#16#21'9'#21'9'#21#17#21#17'9'#17#21#17#12#17
- +#13#244#13#17#13#12#244#0#244#244#245#244#244#244#241#244#0#244#0#244#240#241
- +#240#244#0#244#0#244#240#240#240#244#245#244#244#244#245#0#13#244#13#244#245
- +#245#0#244#0#240#0#0#0#240#241#245#245#245#245#245#13#245#6#245#6#14#6#14#6
- +#13#6#17#17#13'9aaa]]]9950'#13#12#13#244#245#244#244#244#241#0#244#244#244
- +#244#245#244#244#240#0#245#240#241#240#16#13#244#12#17#17#13#17#17#12#13#244
- +#245#244#13#245#244#12#17#21'9'#21'9'#21'99='#17#21'=='#17#12#21#17#12#12#13
- +#13#245#240#240#0#244#0#245#240#244#244#241#244#240#241#240#240#244#0#245#240
- +#240#244#0#240#0#12#13#244#13#13#13#240#0#244#240#13#244#244#12#0#240#241#240
- +#0#0#0#241#244#245#0#245#245#245#245#245#245#13#13#13#245#219#13#13#13#13#13
- +#13#13#17'9]99954'#13#13#12#245#244#245#244#244#13#17#244#240#245#244#245#244
- +#12#240#245#240#240#244#240#0#244#245#17#21#13#12#13#12#13#16#13#13#240#240
- +#240#0#240#245#0#244#17#17#16#17#17#17#16#21#17#16#21#17#17#17#17#13#17#245
- +#244#244#240#0#244#241#240#240#244#244#245#240#244#0#244#240#240#241#0#244
- +#240#0#245#0#245#240#0#17#245#244#244#240#240#244#240#13#244#219#17#21#13#240
- +#0#240#0#0#0#0#240#245#0#245#245#240#245#245#245#245#245#245#245#13#13#13#245
- +#13#13#13#17#13#21'99954'#12#13#13#244#245#244#244#244#240#13#17#12#240#0#12
- +#245#244#244#245#244#244#0#245#240#0#240#240#17#16#17#12#13#12#13#12#13#13#12
- +#0#0#0#13#244#244#244#13#21#21#21#21#21#21#21'9'#21#17#17#16#17#21#21#244#240
- +#12#244#245#244#13#21#244#0#240#241#240#0#244#0#244#241#0#244#0#244#241#0#244
- +#240#240#240#0#13#12#240#244#13#13#12#13#13#244#240#13#12#17#12#0#240#240#240
- +#0#0#0#244#0#245#244#0#245#245#0#244#245#241#245#244#245#245#244#13#21#17#13
- +#17#17#21'9='#21'5'#17#13#244#244#244#244#244#245#12#17#240#240#219#240#240
- +#13#244#245#245#12#13#13#240#244#245#240#0#244#13#13#244#13#13#13#13#13#13#12
- ,#13#240#0#240#13#13#240#13#17#12#17#17#17#16#17#17#21#17#13#12#13#13#244#13
- +#245#0#13#13#244#12#17#245#244#244#0#240#240#245#240#241#240#240#240#241#244
- +#0#240#240#241#0#240#0#240#16#17#17#244#240#244#17#12#13#13#244#244#17#219
- +#245#0#0#240#0#0#0#0#241#240#0#241#244#0#245#245#240#245#244#245#245#244#245
- +#245#12#13#13#13#17#17'9'#21'9='#21'9'#17#17#244#13#21#12#245#12#17#244#240
- +#13#241#0#244#244#244#244#245#244#13#0#240#240#245#0#240#16#13#244#244#12#244
- +#12#244#12#13#13#244#244#244#12#245#240#244#17#17#16#21#17#17#21#17#21#16#13
- +#245#244#245#240#240#240#0#240#240#245#240#241#0#0#241#240#0#240#0#240#240#0
- +#244#0#240#240#241#0#240#240#240#0#240#13#17#21#13#0#245#240#0#0#244#17#245
- +#244#245#244#244#244#245#0#240#0#0#0#0#244#0#244#240#241#244#0#245#240#245
- +#240#245#244#244#244#13#17#13#244#13#17#21#17#21#17#21#21#17#12#13#12#21#17
- +#12#13#240#0#240#17#240#240#13#244#245#12#12#245#244#0#245#244#240#0#240#245
- +#17#21#17#13#13#13#13#17#12#13#0#0#0#245#240#240#0#240#17#13#17#16#17#17#16
- +#21#17#13#244#244#244#0#0#0#0#0#0#244#0#240#0#240#244#244#240#0#240#240#0#241
- +#0#240#240#0#244#240#240#0#0#240#13#12#17#13#12#13#12#244#245#240#244#17#244
- +#244#0#244#245#13#244#0#240#0#0#0#240#241#240#241#0#244#0#240#241#240#244#241
- +#244#241#245#17#219#13#12#244#13#16#17#13#12#13#17#12#13#21#21#17#17#17#13#16
- +#17#12#245#244#240#240#245#244#245#240#245#0#244#240#240#0#0#240#240#17#12
- +#245#244#244#244#244#244#244#245#244#240#244#13#244#244#245#12#17#16#17#16#17
- +#17#17#17#17#17#12#244#244#245#0#240#240#240#0#244#245#240#0#0#244#245#219#13
- +#244#0#0#240#240#240#240#0#240#0#0#0#240#245#218#13#244#219#12#21#17#240#0#13
- +#244#245#17#244#13#12#13#244#12#13#0#0#0#0#0#240#0#240#240#241#240#245#240
- +#244#241#244#240#240#244#12#245#240#244#17#17#21#13#17#244#17#244#13#13#12#17
- +#17#12#13#244#240#245#17#13#12#17#12#219#244#240#244#244#244#240#245#0#244
- +#241#240#0#245#12#245#244#13#17#17#13#17#17#17#17#17#13#12#245#244#244#17#21
- +#17#17#17#17#219#244#240#12#13#245#0#245#244#240#244#241#244#241#240#13#0#240
- +#0#0#244#240#244#245#240#244#240#0#0#0#240#0#241#244#240#244#13#245#12#244#13
- +#17#17#13#12#245#240#0#244#13#244#13#17#17#245#13#17#240#240#0#0#0#240#244#0
- +#240#240#0#0#0#0#0#0#240#17#17#17#17#240#0#245#245#12#13#16#17#21#21#244#12
- +#13#16#245#0#244#245#244#240#244#0#0#245#244#240#241#244#245#244#245#244#12#0
- +#0#240#240#0#240#13#16#13#12#244#13#244#244#244#12#245#244#245#0#244#245#0
- +#245#244#13#12#17#13#12#245#12#13#244#12#13#244#245#0#0#0#240#0#0#240#0#0#0
- +#240#245#244#245#244#17#17#0#244#240#245#0#240#16#21#13#244#244#244#245#240
- +#12#21#17#0#13#244#240#0#240#13#244#244#0#244#244#244#244#0#0#0#0#0#245#12
- +#241#0#240#240#244#245#244#244#245#244#245#244#245#17#244#0#244#244#245#244
- +#219#17#21#21#244#13#13#17#12#244#13#245#244#245#17#0#0#0#240#241#244#244#240
- +#0#244#13#245#0#240#240#0#0#240#244#17#17#17#13#12#13#17#17#17#244#0#244#240
- +#245#244#244#240#244#17#17#16#17#13#244#244#13#12#13#240#245#244#0#240#0#0#0
- +#240#0#0#240#0#244#13#244#244#245#244#244#0#244#245#12#0#240#245#13#13#244#13
- +#245#13#244#17#13#244#0#245#240#245#0#245#17#245#13#240#244#245#219#13#0#240
- +#0#0#0#0#240#244#240#0#244#13#17#244#240#245#244#0#13#244#0#0#0#13#244#13#12
- +#13#21#245#244#245#244#244#245#13#21#12#244#244#244#244#244#245#244#13#244
- +#244#13#13#244#245#240#244#0#240#245#0#240#241#17#244#244#245#244#13#244#244
- +#244#245#244#245#13#13#244#244#241#13#17#12#17#17#17#16#13#12#17#17#13#244
- +#244#0#0#0#240#0#240#0#0#240#0#0#245#244#240#245#244#244#245#0#245#244#13#240
- +#0#0#244#244#12#240#240#12#240#245#240#0#0#244#244#244#0#0#244#244#244#0#245
- +#244#241#240#0#240#0#0#0#12#17#13#244#17#13#218#245#244#13#244#245#244#244#13
- +#244#0#240#219#12#17#13#12#13#244#0#244#13#244#0#240#17#21#13#12#245#0#245
- +#244#0#240#240#0#244#13#240#244#0#245#0#240#0#240#0#244#13#245#244#13#12#13
- +#17#13#17#17#13#244#0#240#240#240#240#12#219#17#17#16#17#17#17#17#17#12#244
- +#244#245#240#0#240#0#240#0#240#0#0#0#0#244#245#244#244#244#17#12#0#244#244#17
- +#244#0#0#13#17#13#245#12#245#12#17#244#0#0#13#13#245#0#240#13#245#244#240#244
- +#244#244#244#0#240#0#0#0#245#12#245#244#13#244#245#244#245#244#245#244#13#244
- +#13#245#13#12#245#244#245#12#13#13#244#244#13#12#13#244#244#13#16#245#245#244
- +#12#245#244#13#244#245#13#244#245#244#245#240#244#240#0#244#0#240#0#12#16#13
- +#244#245#244#245#244#244#244#245#240#0#0#245#0#0#244#13#16#13#17#13#16#17#17
- +#21#13#245#0#240#240#0#0#0#0#0#0#240#0#240#0#0#240#0#241#240#13#245#0#245#244
- +#0#0#0#244#17#13#12#244#13#244#245#21#13#240#0#0#240#244#0#244#219#12#245#0
- +#245#244#17#13#0#240#0#0#0#240#0#245#12#13#13#13#244#240#0#0#240#245#0#244
- +#240#244#245#240#0#244#13#13#12#244#13#16#17#17#17#244#219#13#244#0#245#17#0
- +#244#13#240#244#240#244#240#244#240#244#245#0#240#245#0#0#240#13#13#17#12#244
- +#13#12#13#13#13#244#0#0#0#240#244#245#244#245#17#17#16#17#17#17#20#21#17#244
- +#240#245#0#0#240#0#240#0#240#0#240#0#0#240#240#13#12#244#0#0#0#17#13#0#0#0#13
- +#12#244#17#13#16#17#244#244#219#245#0#0#240#17#240#0#240#240#244#0#244#244
- ,#245#240#0#244#0#0#0#240#244#244#245#12#244#240#244#0#240#240#244#244#0#0#0
- +#245#244#240#244#245#13#12#12#13#17#219#17#21#17#12#13#13#244#240#244#244#0
- +#244#245#0#0#0#245#244#245#12#219#244#240#245#244#0#240#241#13#244#244#13#13
- +#13#12#13#240#0#240#240#241#0#244#245#244#245#0#244#12#13#13#12#13#13#17#12
- +#245#0#240#0#240#0#0#0#240#0#0#0#0#240#0#245#244#245#240#13#244#0#12#244#0#0
- +#240#245#12#13#17#12#13#17#12#17#12#240#0#0#245#17#0#0#240#245#13#12#219#245
- +#0#0#0#17#0#0#0#17#17#240#244#17#13#244#245#244#13#17#245#245#244#244#244#13
- +#13#0#245#244#244#245#245#12#12#244#245#244#16#245#244#12#245#240#245#13#0
- +#240#244#245#244#240#240#240#244#241#244#245#0#240#244#0#0#244#13#244#240#245
- +#12#244#245#12#244#0#240#0#12#13#240#240#0#240#244#17#13#17#16#17#16#17#16#13
- +#244#240#244#0#0#0#240#0#0#240#0#240#0#0#240#240#12#13#240#13#245#240#17#13#0
- +#0#240#17#17#12#219#13#12#219#17#17#17#12#0#0#240#13#240#244#219#244#244#245
- +#244#240#13#244#0#244#0#0#0#13#219#240#240#13#244#244#13#244#245#12#244#245
- +#244#245#240#244#240#240#240#245#244#244#17#17#13#244#244#13#17#16#17#13#244
- +#240#244#13#240#241#244#12#13#245#244#245#240#244#0#244#240#0#245#240#240#0
- +#244#17#21#13#13#13#13#13#13#13#244#0#241#244#240#0#0#245#244#13#12#17#17#17
- +#17#17#17#17#244#0#241#240#0#0#0#0#240#0#0#0#240#0#0#244#245#12#240#12#244#0
- +#13#244#0#0#240#12#245#244#13#244#13#12#245#244#13#245#0#0#240#17#240#240#13
- +#240#245#12#245#244#244#245#240#17#0#0#0#240#240#0#13#17#13#244#240#13#12#17
- +#13#12#13#244#0#0#0#244#244#244#245#244#244#17#17#244#245#244#21#13#13#12#240
- +#245#0#0#244#12#244#13#12#245#244#13#244#245#240#245#0#240#240#0#0#245#12#245
- +#244#244#244#244#244#12#244#13#244#0#0#0#245#240#0#244#240#240#12#17#16#17#16
- +#17#21#13#244#245#244#240#0#240#0#240#0#240#0#240#0#0#240#245#244#245#240#17
- +#245#0#13#245#0#240#0#0#240#240#244#240#240#245#0#244#0#240#0#0#244#13#0#240
- +#13#244#244#244#245#244#13#240#0#244#0#0#0#12#13#240#244#13#244#245#244#245
- +#244#245#244#245#12#245#0#0#240#13#13#13#12#245#240#13#12#245#244#244#13#244
- +#244#17#13#12#240#0#17#13#13#17#13#12#240#0#244#240#240#244#0#240#240#0#240
- +#244#13#244#244#17#17#17#17#17#17#21#13#0#244#240#244#0#0#244#13#13#17#17#17
- +#17#17#17#17#12#245#12#240#0#0#0#240#0#0#0#0#0#0#0#240#240#240#244#244#245
- +#244#244#244#240#0#0#0#240#245#12#245#244#245#244#244#13#240#0#0#0#240#13#240
- +#244#17#244#240#245#244#244#17#244#0#13#0#0#0#245#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#245#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#245#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#245#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#245#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- ,#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#241#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'$'
- +#236#236#236'$'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#241#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'H'#249#249#249#249
- +#249#236#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#236#249#249#249#249#249'H'#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#249#249#249#249#249'l'#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#144#249#249#249#249#249#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#241#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0'l'#249#249#249#249#249#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8
- +#255#255#7#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0'H'#249#249#249#249#249#236#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#255
- +#255#7#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#236#249#249#249#249#249'H'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#255#255#7#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#249
- +#249#249#249#249'l'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#170#255#246#7#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#144#249#249
- +#249#249#144#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#255#255#7#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'l'#249#249#249#249
- +#249#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#209#255#7#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'H'#249#249#249#249#249#236#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#255#255#7#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#236#249#249#249#249#249'H'#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0'-'#245#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#8#255#255#7#0#0#240#245#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#245#245#0#0#0#0#0#0#0#0#0#240#245#0#0#0#0#0
- ,#0#0#0#0#0'-'#245#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#249#249#249#249#249
- +'l'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#7#255#255
- +#255#255#246'1'#0#0#0#0#0#0#8#255#255#7#0#0#0#0#0#170#255#255'U'#240#255#255
- +#255#255#7#0#0#0#0#0#8#255#255#7#0#0#0#0#0#7#255#255#8#0#0#0#0#0#7#246#255
- +#255#255#255#255#130#0#0#0#0#7#255#255#255#255#247#0#245#246#255#134#7#246
- +#255#255#255#255#8'-'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#249#249#249#249#249#144
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#255#255#255
- +#246#255#255#255#247#0#0#0#0#0#8#255#255#7#0#0#0#0#0#8#255#255#7#255#255#255
- +#255#255#255#134#0#0#0#0#8#255#255#7#0#0#0#0#0#7#255#255#8#0#0#0#0#175#246
- +#255#255#246#246#246#246#255#0#0#0'1'#255#255#255#255#246#255#8'-'#255#255'U'
- +#255#255#255#246#246#246#255#255'1'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'l'#249#249
- +#249#249#249#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#175
- +#255#255#255#247#7#8#255#255#255#7#0#0#0#0#8#255#255#7#0#0#0#0#0#8#255#255
- +#255#255#134#7#130#255#255#255#7#0#0#0#8#255#255#7#0#0#0#0#0#7#255#255#8#0#0
- +#0#175#255#255#255#247'-'#245#245#7#8#0#0#0#246#255#255#255#247#7#246#255#255
- +#255#255'1'#7#255'Y'#245#245#247#255#255#246#245#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +'H'#249#249#249#249#249#236#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#0#0#0#0#0
- +#0#0#0#0#7#255#255#255#240#0#0#0'1'#255#255#255#0#0#0#0#170#255#246#7#0#0#0#0
- +#0#8#255#255#255#247#0#0#0#7#255#255#255#0#0#0#8#255#246#7#0#0#0#0#0#7#255
- +#209#8#0#0#7#255#255#255#240#0#0#0#0#0#0#0#0#245#255#255#255'1'#0#0#0#134#255
- +#255#246#7#0#0#0#0#236#236#7#255#255#130#236#236#236#236#236#236#236#236#236
- +#236#236#236#236#236'$'#249#249#249#249#249'H'#236#236#236#236#236#236#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#7#0#0#0#0#0#130#255#255
- +#247#0#0#0#8#255#255#7#0#0#0#0#0#170#255#255#255#0#0#0#0#0#246#255#255#7#0#0
- +#170#255#255#7#0#0#0#0#0#7#255#255#8#0#0#246#255#255#7#0#0#0#0#0#0#0#0#0#7
- +#255#255#246#0#0#0#0#0#255#255#255#7#0#0#0'H'#249#249#249#255#255#246#249#249
- +#249#249#249#249#249#249#249#249#249#249#249#249#249#249#249#249#249#249#249
- +#249#249#249#249#249#249'l'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'-'#255
- +#255#255#0#0#0#0#0#0#245#246#255#255#0#0#0#8#209#255#7#0#0#0#0#0#8#255#255
- +#134#0#0#0#0#0#7#255#255#134#0#0#8#255#255#7#0#0#0#0#0#7#246#255#8#0#240#255
- +#255#255#0#0#0#0#0#0#0#0#0#0#247#255#255#130#0#0#0#0#0#209#255#255#7#0#0#0
- +#236#249#249#249#255#255#255#249#249#249#249#249#249#249#249#249#249#249#249
- +#249#249#249#249#249#249#249#249#249#249#249#249#249#249#249#249#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#247#255#255#7#0#0#0#0#0#0#0#246#255#255'1'#0#0#8
- +#255#255#7#0#0#0#0#0#8#255#255#7#0#0#0#0#0#245#255#255#255#0#0#8#255#255#7#0
- +#0#0#0#0#7#255#255#170#0#7#255#255#8#0#0#0#0#0#0#0#0#0#0#8#255#255#7#0#0#0#0
- +#0#8#255#255#7#0#0#0#0'l'#249#182#255#255#255#249#249#249#249#249#249#249#249
- +#249#249#249#249#249#249#249#249#249#249#249#249#249#249#249#249#249#249#249
- +#249'H'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#246#255#255'1'#0#0#0#0#0#0#0
- +#130#255#255#247#0#0#8#255#246#7#0#0#0#0#0#170#255#246#7#0#0#0#0#0#0#255#255
- +#255#0#0#170#255#246#7#0#0#0#0#0#7#255#255#8#0#7#255#255#7#0#0#0#0#0#0#0#0#0
- +#0#8#255#246#7#0#0#0#0#0#170#255#246#7#0#0#0#0#0#1#204#255#255#170'$HHHHHHHH'
- +'HHHHHHl'#249#249#249#249#249#1'HHHHHH$'#0#0#0#0#0#0#0#0#0#0#240#0#0#0#0#0#0
- +#0#0#255#255#255#0#0#0#0#0#0#0#0#7#255#255#8#0#0#170#255#255#7#0#0#0#0#0#8
- +#255#255#7#0#0#0#0#0#0#255#255#246#245#0#8#255#255#7#0#0#0#0#0#7#255#255#134
- +#0#170#255#255'U'#0#0#0#0#0#0#0#0#0#0#170#255#255#7#0#0#0#0#0#8#255#255#7#0#0
- +#0#0#0#130#255#255#255'Q'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'$'#249#249#249#249
- +#249#236#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'('#0#0#0#0#0#0#0#245#246#255#255#0
- +#0#0#0#0#0#0#0#245#246#255#255#0#0#8#255#255#7#0#0#0#0#0#8#209#255#7#0#0#0#0
- +#0#0#255#255#255#245#0#8#255#255#7#0#0#0#0#0#7#246#255#8#0#8#255#255#247#241
- +#244#245#245#245#245#245'-'#245#0#8#255#255#7#0#0#0#0#0#8#209#255#7#0#0#0#245
- +#246#255#255#255#200#249'$'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#249#249#249#249#249
- +'H'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#0#0#0#0#0#0#0#245#255#246#175#0#0#0
- +#0#0#0#0#0#245#255#255#255#0#0#8#255#255#7#0#0#0#0#0#8#255#255#7#0#0#0#0#0#0
- +#255#255#246#245#0#170#255#255#7#0#0#0#0#0#7#255#255#170#0#8#255#255#255#255
- +#255#255#255#255#255#255#255#255#0#8#255#255#7#0#0#0#0#0#8#255#255#7#0#0'1'
- +#255#255#255#255#247#144#249#249'$'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#249#249#249
- +#249#249#144#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#7#255#255#170
- +#0#0#0#0#0#0#0#0#0#255#255#255#0#0#170#255#255#7#0#0#0#0#0#8#255#246#7#0#0#0
- +#0#0#0#255#255#255#245#0#8#255#246#7#0#0#0#0#0#7#255#255#8#0#130#255#255#255
- +#246#246#246#246#255#255#255#255#255#0#170#255#246#7#0#0#0#0#0#8#255#246#7#0
- +'1'#255#255#255#255#7#0#0#144#249#249'$'#0#0#0#0#0#0#0#0#0#0#0#0#0#144#249
- +#249#249#249#249#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#0#0#0#0#0#0#0#7#255
- +#255#8#0#0#0#0#0#0#0#0#0#255#255#255#245#0#8#255#255#7#0#0#0#0#0#170#255#255
- ,#7#0#0#0#0#0#0#255#255#255#0#0#8#255#255#7#0#0#0#0#0#7#255#255#170#0#7#255
- +#255#7#245#245#245#245#245#240#255#255#255#0#134#255#255#7#0#0#0#0#0#170#255
- +#255#7#0#255#255#255#8#240#0#0#0#0#144#249#249#236#0#0#0#0#0#0#0#0#0#0#0#0'H'
- +#249#249#249#249#249#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#7#246
- +#255#8#0#0#0#0#0#0#0#0#0#255#255#255#241#0#170#255#255#130#0#0#0#0#0#8#255
- +#255#7#0#0#0#0#0#245#246#255#246#0#0#170#255#255#7#0#0#0#0#0#7#255#255#8#0'1'
- +#255#255#247#0#0#0#0#0#0#255#255#175#0#8#255#255#7#0#0#0#0#0#8#255#255'U1'
- +#255#255#246#0#0#0#0#0#0#0#249#249#249#236#0#0#0#0#0#0#0#0#0#0#0'$'#249#249
- +#249#249#249#236#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#7#255#255
- +#170#0#0#0#0#0#0#0#0#0#255#255#255#244#0#8#255#255#255#0#0#0#0#0#8#255#255
- +#134#0#0#0#0#0#7#255#246#175#0#0#8#255#255#247#0#0#0#0#0#7#255#255#8#0#0#255
- +#255#8#0#0#0#0#0#240#255#255#8#0#170#255#255#7#0#0#0#0#0#8#255#255'1'#8#255
- +#255'1'#0#0#0#0#0#0#0#236#249#249#249#236#0#0#0#0#0#0#0#0#0#0#0#249#249#249
- +#249#249'H'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#7#255#255#8#0#0#0
- +#0#0#0#0#0#0#255#255#246#245#0#8#255#255#255#7#0#0#0#0#170#255#255#255#0#0#0
- +#0#0#8#255#255#7#0#0#8#255#255#246#0#0#0#0#0#8#255#255#7#0#0#8#255#255#0#0#0
- +#0#0#7#255#255#7#0#8#255#246#7#0#0#0#0#0#8#255#255'1'#134#255#246#241#0#0#0#0
- +#0#0#0#0#236#249#249#249#0#0#0#0#0#0#0#0#0#0#0#249#249#249#249#249'l'#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#7#255#255#8#0#0#0#0#0#0#0#0#0#255
- +#255#255#245#0#170#255#255#255#255#7#0#0#0#8#255#255#255#7#0#0#0'1'#255#255
- +#255#245#0#0#170#255#255#255#7#0#0#0#240#255#255#255'1'#0#0#7#255#255#247#0#0
- +#0#0#246#255#255#240#0#170#255#255#7#0#0#0#0#0#170#255#255'U'#7#255#255#7#0#0
- +#0#0#0#0#0#0#0#236#249#249#144#0#0#0#0#0#0#0#0#0#0#144#249#249#249#249#144#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#245#246#255#8#0#0#0#0#0#0#0#0
- +#245#246#255#255#0#0#8#255#255#7#255#255#255#8#241#134#255#255#255#255#7#241
- +'Y'#255#255#255#8#0#0#0#8#255#255#255#255#7#245'1'#255#255#255#255#0#0#0#0
- +#255#255#255#7#0#0#247#255#255#8#0#0#8#255#255#7#0#0#0#0#0#8#255#255'1'#0#255
- +#255#255'1'#0#0'1'#130#0#0#0#0#0#236#249#249#144#0#0#0#0#0#0#0#0#0'H'#249#249
- +#249#249#249#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#0#0#0#0#0#0#0#245#255#255
- +#255#0#0#0#0#0#0#0#0#245#255#255#255#0#0#8#255#255#0#255#255#255#255#244#170
- +#255#255#240#255#255#255#255#255#255#255#240#0#0#0#8#255#255#7#255#255#255
- +#255#255#255#255#7#0#0#0#0#240#246#255#255#255#255#255#255#255#241#0#0#8#255
- +#255#7#0#0#0#0#0#8#255#255#7#0#7#255#255#255#255#255#255#255#240#0#0#0#0#0'$'
- +#249#249#144#0#0#0#0#0#0#0#0'$'#249#249#249#249#249#236#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#0#0#0#0#0#0#0#0#7#255#255#246#0#0#246
- +#246#255#0#240#246#255#255#241#8#246#255#0'1'#255#255#255#255#255'-'#0#0#0#0
- +#170#255#255'1'#240#246#246#255#255#255#247#0#0#0#0#0#0#241#8#255#255#255#255
- +#255#240#0#0#0#8#246#255#7#0#0#0#0#0#8#246#255#7#0#0#7#255#255#255#255#246
- +#255'-'#0#0#0#0#0#0'$'#249#249'l'#0#0#0#0#0#0#0#0#249#249#249#249#249'H'#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#246#255#255'-'#0#0#0#0#0#0#0#247
- +#255#255#130#0#0'-'#245'-'#0#0#0'1'#7#240#245'-'#245#0#0#0'1'#7'1'#0#0#0#0#0
- +#0#8#255#255'U'#0#0#245#7#7#240#0#0#0#0#0#0#0#0#0#240#7#7'-'#0#0#0#0#0#245'-'
- +#245#240#0#0#0#0#0#245'-'#245#240#0#0#0#0'1'#7#7#245#0#0#0#0#0#0#0#0#0'$'#249
- +#249'l'#0#0#0#0#0#0#0#249#249#249#249#249'l'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#247#255#255#7#0#0#0#0#0#0#0#246#255#255#7#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#209#255#7#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0'$'#249#249'l'#0#0#0#0#0#0#144#249#249#249#249#144#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0'-'#255#255#246#0#0#0#0#0#0#0#255#255#255#240#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#255#255#7#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0'$'#249#249'H'#0#0#0#0#0'H'#249#249#249#249#249#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#246#255#246#245#0#0#0#0#0#247#255#255
- +#175#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#255#246#7#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#1#249#249'$'#0#0#0#0'$'#249#249#249#249#249
- +#236#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#0#0#0#0#0#0#0#0#0'1'#255#255#246#0#0#0#0
- +#245#246#255#246'1'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#170
- +#255#255#7#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#7'1-'#7'1'#130#0#209#0#0#0#0'l'#249#249'$'#0#0#0#0
- +#249#249#249#249#249'$'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#175
- +#246#255#246'1'#245'U'#255#255#255#175#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#8#255#255#7#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#7'-'#240#170#7#246#245#8#0#0#0
- ,#0#0'l'#249#249'$'#0#0#0#249#249#249#249#249#1#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#175#255#255#255#255#255#255#255#255#240#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#255#255#7#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#7#245
- +#0#8#175'1'#7#7#0#0#0#0#0#0'l'#249#249#236#0#0#144#249#249#249#249#144#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#247#255#255#255#255#255#8#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#255#255#7#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#7'-'#0#255#247#0#175#7#0#0#0#0#0#0#0'l'#249#249#236#0#1#249#249
- +#249#249#249#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0'1'#7#7
- +#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#8#255#255
- +#7#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#247#175#8#7#8'-'#0#247#7#0#0#0#0#0#0#0#0#144#249#249#236'$'
- +#249#249#249#249#249#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#144#249#249#236#249
- +#249#249#249#249'$'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#144#249#144#249#249#249
- +#249#249'H'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#144#249#249#249#249#249#249
- +#144#0#0#0#0#0#0#0#0#0#0#0#0#0#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#144#249#249#249#249#249#249#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#249#249#249#249#249#249#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#236#249#249#249#249#249#236#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#236#249#249#249#249'H'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#236#249#249#249'l'#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#236#249
- +#249#249#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- ,#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- ,#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#236#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#236#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#236#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#240#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#236#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#7'TButton'#5'btnOK'#4'Left'
- +#3'o'#1#3'Top'#3#21#1#5'Width'#2'X'#6'Height'#2#25#6'Cancel'#9#7'Caption'#6#2
- +'OK'#11'ModalResult'#2#2#8'TabOrder'#2#1#7'OnClick'#7#10'btnOKClick'#0#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/ovcabot0.pas b/Source/3rdParty/Orpheus/ovcabot0.pas
deleted file mode 100644
index 2bc48f4a..00000000
--- a/Source/3rdParty/Orpheus/ovcabot0.pas
+++ /dev/null
@@ -1,197 +0,0 @@
-{*********************************************************}
-{* OVCABOT0.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 Ovcabot0;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, MyMisc, Buttons, {$ENDIF}
- SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
- {$IFNDEF LCL} {$IFDEF VERSION6} DesignIntf, DesignEditors, {$ELSE} DsgnIntf, {$ENDIF} {$ELSE} PropEdits, {$ENDIF}
- ExtCtrls, OvcVer, OvcURL, {$IFDEF MSWINDOWS} ShellAPI; {$ELSE} Unix; {$ENDIF}
-
-type
- TOvcfrmAboutForm = class(TForm)
- Panel1: TPanel;
- Image1: TImage;
- btnOK: TButton;
- Label1: TLabel;
- VisitUsLabel: TLabel;
- lblTurboLink: TLabel;
- Bevel3: TBevel;
- GeneralNewsgroupsLabel: TLabel;
- lblHelp: TLabel;
- lblGeneralDiscussion: TLabel;
- Label3: TLabel;
- Label2: TLabel;
- procedure btnOKClick(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure lblTurboLinkClick(Sender: TObject);
- procedure lblHelpClick(Sender: TObject);
- procedure lblGeneralDiscussionClick(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
- TOvcAboutProperty = class(TStringProperty)
- public
- function GetAttributes: TPropertyAttributes;
- override;
- procedure Edit;
- override;
- end;
-
-implementation
-{$IFNDEF LCL}
-{$R *.DFM}
-{$ENDIF}
-
-
-{*** TOrAboutProperty ***}
-
-function TOvcAboutProperty.GetAttributes: TPropertyAttributes;
-begin
- Result := [paDialog, paReadOnly];
-end;
-
-procedure TOvcAboutProperty.Edit;
-begin
- with TOvcfrmAboutForm.Create(Application) do begin
- try
- ShowModal;
- finally
- Free;
- end;
- end;
-end;
-
-{*** TEsAboutForm ***}
-
-procedure TOvcfrmAboutForm.btnOKClick(Sender: TObject);
-begin
- Close;
-end;
-
-procedure TOvcfrmAboutForm.FormCreate(Sender: TObject);
-begin
- Top := (Screen.Height - Height) div 3;
- Left := (Screen.Width - Width) div 2;
-
- lblTurboLink.Cursor := crHandPoint;
- lblHelp.Cursor := crHandPoint;
- lblGeneralDiscussion.Cursor := crHandPoint;
-
-{$IFDEF LCL}
- Image1.Transparent := False; //Default is True with Laz, False with Delphi
-{$ENDIF}
-end;
-
-procedure TOvcfrmAboutForm.lblTurboLinkClick(Sender: TObject);
-begin
-{$IFDEF MSWINDOWS}
- {$IFNDEF LCL}
- if ShellExecute(0, 'open', 'http://sourceforge.net/projects/tporpheus/',
- {$ELSE}
- if ShellExecute(0, 'open', PChar('http://sourceforge.net/projects/tporpheus/'),
- {$ENDIF}
- '', '', SW_SHOWNORMAL) <= 32
-{$ELSE}
- {$IFDEF DARWIN}
- if fpSystem('Open http://sourceforge.net/projects/tporpheus/') = 127
- {$ELSE}
- if (GetBrowserPath = '') or
- (fpSystem(GetBrowserPath + ' http://sourceforge.net/projects/tporpheus/') = 127)
- {$ENDIF}
-{$ENDIF}
- then
- ShowMessage('Error launching browser.');
-end;
-
-procedure TOvcfrmAboutForm.lblHelpClick(Sender: TObject);
-begin
-{$IFDEF MSWINDOWS}
- if ShellExecute(0, 'open',
- {$IFNDEF LCL}
- 'http://sourceforge.net/forum/forum.php?forum_id=241874', '', '',
- {$ELSE}
- PChar('http://sourceforge.net/forum/forum.php?forum_id=241874'), '', '',
- {$ENDIF}
- SW_SHOWNORMAL) <= 32
-{$ELSE}
- {$IFDEF DARWIN}
- if fpSystem('Open http://sourceforge.net/forum/forum.php?forum_id=241874') = 127
- {$ELSE}
- if (GetBrowserPath = '') or
- (fpSystem(GetBrowserPath + ' http://sourceforge.net/forum/forum.php?forum_id=241874') = 127)
- {$ENDIF}
-{$ENDIF}
- then
- ShowMessage('Error launching browser.');
-end;
-
-procedure TOvcfrmAboutForm.lblGeneralDiscussionClick(Sender: TObject);
-begin
-{$IFDEF MSWINDOWS}
- if ShellExecute(0, 'open',
- {$IFNDEF LCL}
- 'http://sourceforge.net/forum/forum.php?forum_id=241873', '', '',
- {$ELSE}
- PChar('http://sourceforge.net/forum/forum.php?forum_id=241873'), '', '',
- {$ENDIF}
- SW_SHOWNORMAL) <= 32
-{$ELSE}
- {$IFDEF DARWIN}
- if fpSystem('Open http://sourceforge.net/forum/forum.php?forum_id=241873') = 127
- {$ELSE}
- if (GetBrowserPath = '') or
- (fpSystem(GetBrowserPath + ' http://sourceforge.net/forum/forum.php?forum_id=241873') = 127)
- {$ENDIF}
-{$ENDIF}
- then
- ShowMessage('Error launching browser.');
-end;
-
-initialization
-{$IFDEF LCL}
-{$I Ovcabot0.lrs} {Include form's resource file}
-{$ENDIF}
-
-end.
-
diff --git a/Source/3rdParty/Orpheus/ovcbase.lrs b/Source/3rdParty/Orpheus/ovcbase.lrs
deleted file mode 100644
index a221158c..00000000
--- a/Source/3rdParty/Orpheus/ovcbase.lrs
+++ /dev/null
@@ -1,136 +0,0 @@
-LazarusResources.Add('ORTCCOMBOARROW','BMP',[
- 'BM'#162#0#0#0#0#0#0#0'v'#0#0#0'('#0#0#0#7#0#0#0#11#0#0#0#1#0#4#0#0#0#0#0','#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128#0
- +#128#0#0#0#128#0#128#0#128#128#0#0#128#128#128#0#192#192#192#0#0#0#255#0#0
- +#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0#136#136
- +#136#128#136#136#136#128#136#136#136#128#136#128#136#128#136#0#8#128#128#0#0
- +#128#0#0#0#0#136#136#136#128#136#136#136#128#136#136#136#128#136#136#136#128
-]);
-LazarusResources.Add('ORTCCHECKGLYPHS','BMP',[
- 'BM'#198#1#0#0#0#0#0#0'v'#0#0#0'('#0#0#0'*'#0#0#0#14#0#0#0#1#0#4#0#0#0#0#0'P'
- +#1#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128
- +#0#128#0#0#0#128#0#128#0#128#128#0#0#128#128#128#0#192#192#192#0#0#0#255#0#0
- +#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0#215'www'
- +'www'#215'wwwwww'#215'wwwwww'#0#0#0#15#255#255#255#255#255#247#15#255#255#255
- +#255#255#247#15#255#255#255#255#255#247#0#0#0#7#136#136#136#136#136#247#7#136
- +#136#136#136#136#247#7#8#128#8#128#8#247#0#0#0#7#136#136#136#136#136#247#7
- +#128#8#136#128#8#247#7#128#8#128#8#128#247#0#0#0#7#136#136#136#136#136#247#7
- +#128#0#136#0#8#247#7#128#8#128#8#128#247#0#0#0#7#136#136#136#136#136#247#7
- +#136#0#0#0#136#247#7#8#128#8#128#8#247#0#0#0#7#136#136#136#136#136#247#7#136
- +#128#0#8#136#247#7#8#128#8#128#8#247#0#0#0#7#136#136#136#136#136#247#7#136
- +#128#0#8#136#247#7#128#8#128#8#128#247#0#0#0#7#136#136#136#136#136#247#7#136
- +#0#0#0#136#247#7#128#8#128#8#128#247#0#0#0#7#136#136#136#136#136#247#7#128#0
- +#136#0#8#247#7#8#128#8#128#8#247#0#0#0#7#136#136#136#136#136#247#7#128#8#136
- +#128#8#247#7#8#128#8#128#8#247#0#0#0#7#136#136#136#136#136#247#7#136#136#136
- +#136#136#247#7#128#8#128#8#128#247#0#0#0#7'wwwww'#247#7'wwwww'#247#7'wwwww'
- +#247#0#0#0#0#0#0#0#0#0#7#0#0#0#0#0#0#7#0#0#0#0#0#0#7#0#0#0
-]);
-LazarusResources.Add('ORBTNCLC','BMP',[
- 'BM'#206#0#0#0#0#0#0#0'v'#0#0#0'('#0#0#0#11#0#0#0#11#0#0#0#1#0#4#0#0#0#0#0'X'
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128
- +#0#128#0#0#0#128#0#128#0#128#128#0#0#128#128#128#0#192#192#192#0#0#0#255#0#0
- +#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0'0'#0#0#0
- +#0'0'#0#0#8#136#136#136#136#0#0#0#8#8#8#153#152#0#0#0#8#136#136#136#136#0#0#0
- +#8#8#8#8#8#0#0#0#8#136#136#136#136#0#0#0#8#0#0#0#8#0#0#0#8#0#14#14#8#0#0#0#8
- +#0#0#0#8#0#0#0#8#136#136#136#136#0#0#0'0'#0#0#0#0'0'#0#0
-]);
-LazarusResources.Add('ORLEFTARROW','BMP',[
- 'BM'#206#0#0#0#0#0#0#0'v'#0#0#0'('#0#0#0#11#0#0#0#11#0#0#0#1#0#4#0#0#0#0#0'X'
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128
- +#0#128#0#0#0#128#0#128#0#128#128#0#0#128#128#128#0#192#192#192#0#0#0#255#0#0
- +#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0#255#255
- +#255#255#255#240#0#0#255#255#255#255#255#240#0#0#255#255#255#255#255#240#0#0
- +#255#255#0#255#255#240#0#0#255#240#0#255#255#240#0#0#255#0#0#255#255#240#0#0
- +#240#0#0#255#255#240#0#0#255#0#0#255#255#240#0#0#255#240#0#255#255#240#0#0
- +#255#255#0#255#255#240#0#0#255#255#255#255#255#240#0#0
-]);
-LazarusResources.Add('ORLEFTARROWS','BMP',[
- 'BM'#206#0#0#0#0#0#0#0'v'#0#0#0'('#0#0#0#13#0#0#0#11#0#0#0#1#0#4#0#0#0#0#0'X'
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128
- +#0#128#0#0#0#128#0#128#0#128#128#0#0#128#128#128#0#192#192#192#0#0#0#255#0#0
- +#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0#255#255
- +#255#255#255#255#240#0#255#255#255#255#255#255#240#0#255#255#255#255#255#255
- +#240#0#255#255#0#255#255#0#240#0#255#240#0#255#240#0#240#0#255#0#0#255#0#0
- +#240#0#240#0#0#240#0#0#240#0#255#0#0#255#0#0#240#0#255#240#0#255#240#0#240#0
- +#255#255#0#255#255#0#240#0#255#255#255#255#255#255#240#0
-]);
-LazarusResources.Add('ORRIGHTARROW','BMP',[
- 'BM'#206#0#0#0#0#0#0#0'v'#0#0#0'('#0#0#0#11#0#0#0#11#0#0#0#1#0#4#0#0#0#0#0'X'
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128
- +#0#128#0#0#0#128#0#128#0#128#128#0#0#128#128#128#0#192#192#192#0#0#0#255#0#0
- +#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0#255#255
- +#255#255#255#240#0#0#255#255#255#255#255#240#0#0#255#255#255#255#255#240#0#0
- +#240#15#255#255#255#240#0#0#240#0#255#255#255#240#0#0#240#0#15#255#255#240#0
- +#0#240#0#0#255#255#240#0#0#240#0#15#255#255#240#0#0#240#0#255#255#255#240#0#0
- +#240#15#255#255#255#240#0#0#255#255#255#255#255#240#0#0
-]);
-LazarusResources.Add('ORRIGHTARROWS','BMP',[
- 'BM'#206#0#0#0#0#0#0#0'v'#0#0#0'('#0#0#0#13#0#0#0#11#0#0#0#1#0#4#0#0#0#0#0'X'
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128
- +#0#128#0#0#0#128#0#128#0#128#128#0#0#128#128#128#0#192#192#192#0#0#0#255#0#0
- +#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0#255#255
- +#255#255#255#255#240#0#255#255#255#255#255#255#240#0#255#255#255#255#255#255
- +#240#0#240#15#255#240#15#255#240#0#240#0#255#240#0#255#240#0#240#0#15#240#0
- +#15#240#0#240#0#0#240#0#0#240#0#240#0#15#240#0#15#240#0#240#0#255#240#0#255
- +#240#0#240#15#255#240#15#255#240#0#255#255#255#255#255#255#240#0
-]);
-LazarusResources.Add('ORREVERT','BMP',[
- 'BM'#206#0#0#0#0#0#0#0'v'#0#0#0'('#0#0#0#14#0#0#0#11#0#0#0#1#0#4#0#0#0#0#0'X'
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128
- +#0#128#0#0#0#128#0#128#0#128#128#0#0#128#128#128#0#192#192#192#0#0#0#255#0#0
- +#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0#255#255
- +#255#255#255#255#255#0#255#255#255#255#255#255#255#0#136#136#136#136#136#136
- +#136#0#136#136#136#136#136't'#136#0#132'DD'#136#136#132'x'#0#132'DH'#136#136
- +#136'H'#0#132'D'#136#136#136#136'H'#0#132'HH'#136#136#136'H'#0#132#136#132'H'
- +#136#132'x'#0#136#136#136#132'DG'#136#0#136#136#136#136#136#136#136#0
-]);
-LazarusResources.Add('ORTODAY','BMP',[
- 'BM'#206#0#0#0#0#0#0#0'v'#0#0#0'('#0#0#0#14#0#0#0#11#0#0#0#1#0#4#0#0#0#0#0'X'
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128
- +#0#128#0#0#0#128#0#128#0#128#128#0#0#128#128#128#0#192#192#192#0#0#0#255#0#0
- +#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0#255#255
- +#255#255#255#255#255#0#255#255#255#255#255#255#255#0#255#255#255#255#255#247
- +#15#0#255#255#255#255#255#255'p'#0#255#255#255#240#255#255#240#0#255#247#255
- +#240#255#247#240#0#255#0#15#240#255#0#15#0#240#247#255#240#255#247#255#0#240
- +#255#255#0#15#255#255#0#240''#255#255#255#255#255#0#255#7#255#255#255#255
- +#255#0
-]);
-LazarusResources.Add('ORBTNCAL','BMP',[
- 'BM'#206#0#0#0#0#0#0#0'v'#0#0#0'('#0#0#0#11#0#0#0#11#0#0#0#1#0#4#0#0#0#0#0'X'
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#128#0#0#0#128#128
- +#0#128#0#0#0#128#0#128#0#128#128#0#0#128#128#128#0#192#192#192#0#0#0#255#0#0
- +#255#0#0#0#255#255#0#255#0#0#0#255#0#255#0#255#255#0#0#255#255#255#0'0'#0#0#0
- +#0'0'#0#0#8#135#136'x'#136#0#0#0#9#135#152'y'#136#0#0#0#7'wwww'#0#0#0#8#135
- +#136'x'#136#0#0#0#9#135#152'y'#136#0#0#0#7'wwww'#0#0#0#8#135#136'x'#136#0#0#0
- +#9#135#152'y'#136#0#0#0#0#0#0#0#0#0#0#0'<'#199'ww'#204'0'#0#0
-]);
-LazarusResources.Add('ORCOLUMNMOVECURSOR','CUR',[
- #0#0#2#0#1#0' '#0#0#0#0#0#0'0'#1#0#0#22#0#0#0'('#0#0#0' '#0#0#0'@'#0#0#0#1#0
- +#1#0#0#0#0#0#0#1#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#31#224#0#0#31#224#0#0#31#224
- +#0#0#31#224#0#0#31#224#0#0'_'#224#0#0#223#224#0#0#223#224#0#1#159#224#0#1#159
- +#224#0#3#0#0#0#3#31#224#0'F'#31#224#0'f'#0#0#0'|'#0#0#0'|'#0#0#0''#192#0#0
- +''#128#0#0''#0#0#0'~'#0#0#0'|'#0#0#0'x'#0#0#0'p'#0#0#0'`'#0#0#0'@'#0#0#0#0
- +#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#192#15#255#255#223#239#255#255#223#239#255#255#223#239#255
- +#255#223#239#255#255#159#239#255#255#31#239#255#254#31#239#255#254#31#239#255
- +#252#31#239#255#252#31#239#255#248'@'#15#255'8@'#15#255#16#192#15#255#0#192
- +#15#255#1#255#255#255#0#31#255#255#0#31#255#255#0'?'#255#255#0''#255#255#0
- +#255#255#255#1#255#255#255#3#255#255#255#7#255#255#255#15#255#255#255#31#255
- +#255#255'?'#255#255#255
-]);
-LazarusResources.Add('ORROWMOVECURSOR','CUR',[
- #0#0#2#0#1#0' '#0#0#0#0#0#0'0'#1#0#0#22#0#0#0'('#0#0#0' '#0#0#0'@'#0#0#0#1#0
- +#1#0#0#0#0#0#0#1#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#29#255#240#0
- +#29#255#240#0#29#255#240#0#0#0#0#0#0#192#0#0#0#192#0#0#1#128#0#0#1#128#0#0#3
- +#0#0#0#3#0#0#0'F'#0#0#0'f'#0#0#0'|'#0#0#0'|'#0#0#0''#192#0#0''#128#0#0''#0
- +#0#0'~'#0#0#0'|'#0#0#0'x'#0#0#0'p'#0#0#0'`'#0#0#0'@'#0#0#0#0#0#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#192#0#7#255#193#255#247#255#193#255#247#255#193
- +#255#247#255#192#0#7#255#254#31#255#255#254#31#255#255#252'?'#255#255#252'?'
- +#255#255#248''#255#255'8'#255#255#16#255#255#255#0#255#255#255#1#255#255
- +#255#0#31#255#255#0#31#255#255#0'?'#255#255#0''#255#255#0#255#255#255#1#255
- +#255#255#3#255#255#255#7#255#255#255#15#255#255#255#31#255#255#255'?'#255#255
- +#255
-]);
diff --git a/Source/3rdParty/Orpheus/ovcbase.pas b/Source/3rdParty/Orpheus/ovcbase.pas
deleted file mode 100644
index a79b3793..00000000
--- a/Source/3rdParty/Orpheus/ovcbase.pas
+++ /dev/null
@@ -1,2758 +0,0 @@
-{*********************************************************}
-{* OVCBASE.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}
-
-{$IFNDEF VERSION3}
-!! Error - not for Delphi versions 1 and 2 or C++ Builder version 1
-{$ENDIF}
-
-{$IFNDEF LCL}
-{$R OVCBASE.RES}
-{$ENDIF}
-
-unit ovcbase;
- {-Base unit for Orpheus visual components}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, MyMisc, {$ENDIF}
- Classes, Controls, Dialogs, Forms, StdCtrls, SysUtils,
- OvcCmd, OvcData, OvcMisc, OvcConst, OvcExcpt, {$IFNDEF LCL} OvcTimer, {$ENDIF} OvcDate;
-
-type
- TOvcLabelPosition = (lpTopLeft, lpBottomLeft); {attached label types}
-
- TOvcAttachEvent = procedure(Sender : TObject; Value : Boolean)
- of object;
-
- TOvcAttachedLabel = class(TLabel)
- protected {private}
- FControl : TWinControl;
-
- protected
- procedure SavePosition;
- procedure Loaded;
- override;
-
- public
- constructor Create(AOwner : TComponent);
- override;
- constructor CreateEx(AOwner : TComponent; AControl : TWinControl);
- virtual;
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
- override;
-
- published
- property Control : TWinControl
- read FControl write FControl;
- end;
-
- TO32ContainerList = class(TList)
- FOwner: TComponent;
- public
- constructor Create(AOwner: TComponent); virtual;
- destructor Destroy; override;
- end;
-
- TOvcLabelInfo = class(TPersistent)
- protected {private}
- {property variables}
- FOffsetX : Integer;
- FOffsetY : Integer;
-
- {event variables}
- FOnChange : TNotifyEvent;
- FOnAttach : TOvcAttachEvent;
-
- {internal methods}
- procedure DoOnAttach;
- procedure DoOnChange;
- function IsVisible : Boolean;
-
- {property methods}
- procedure SetOffsetX(Value : Integer);
- procedure SetOffsetY(Value : Integer);
- procedure SetVisible(Value : Boolean);
-
- public
- ALabel : TOvcAttachedLabel;
- FVisible : Boolean;
-
- property OnAttach : TOvcAttachEvent
- read FOnAttach write FOnAttach;
- property OnChange : TNotifyEvent
- read FOnChange write FOnChange;
-
- procedure SetOffsets(X, Y : Integer);
-
- published
- property OffsetX: Integer
- read FOffsetX write SetOffsetX stored IsVisible;
- property OffsetY: Integer
- read FOffsetY write SetOffsetY stored IsVisible;
- property Visible : Boolean
- read FVisible write SetVisible
- default False;
- end;
-
- {event method types}
- TMouseWheelEvent = procedure(Sender : TObject; Shift : TShiftState;
- Delta, XPos, YPos : Word) of object;
-
- TDataErrorEvent =
- procedure(Sender : TObject; ErrorCode : Word; const ErrorMsg : string)
- of object;
- TPostEditEvent =
- procedure(Sender : TObject; GainingControl : TWinControl)
- of object;
- TPreEditEvent =
- procedure(Sender : TObject; LosingControl : TWinControl)
- of object;
- TDelayNotifyEvent =
- procedure(Sender : TObject; NotifyCode : Word)
- of object;
- TIsSpecialControlEvent =
- procedure(Sender : TObject; Control : TWinControl;
- var Special : Boolean)
- of object;
- TGetEpochEvent =
- procedure (Sender : TObject; var Epoch : Integer)
- of object;
-
- {options which will be the same for all fields attached to the same controller}
- TOvcBaseEFOption = (
- efoAutoAdvanceChar,
- efoAutoAdvanceLeftRight,
- efoAutoAdvanceUpDown,
- efoAutoSelect,
- efoBeepOnError,
- efoInsertPushes);
- TOvcBaseEFOptions = set of TOvcBaseEFOption;
-
-type
- TOvcCollectionStreamer = class;
- TOvcCollection = class;
- TO32Collection = class;
-
- {implements the About property and collection streaming}
- TOvcComponent = class(TComponent)
- protected {private}
- FCollectionStreamer : TOvcCollectionStreamer;
- FInternal : Boolean; {flag to suppress name generation
- on collection items}
- function GetAbout : string;
- procedure SetAbout(const Value : string);
-
- protected
- {OrCollection streaming hooks:}
- procedure GetChildren(Proc: TGetChildProc; Root : TComponent); override;
- function GetChildOwner: TComponent; override;
- procedure Loaded; override;
-
- public
- constructor Create(AOwner: TComponent);
- override;
- destructor Destroy;
- override;
-
- property CollectionStreamer : TOvcCollectionStreamer
- read FCollectionStreamer
- write FCollectionStreamer;
- property Internal : Boolean read FInternal write FInternal;
- published
- {properties}
- property About : string
- read GetAbout
- write SetAbout
- stored False;
- end;
-
- {implements the About property}
- TO32Component = class(TComponent)
- protected {private}
- FInternal : Boolean; {flag to suppress name generation
- on collection items}
- function GetAbout : string;
- procedure SetAbout(const Value : string);
- public
- constructor Create(AOwner: TComponent); override;
- property Internal : Boolean read FInternal write FInternal;
- published
- {properties}
- property About : string read GetAbout write SetAbout stored False;
- end;
-
- TOvcController = class(TOvcComponent)
- protected {private}
- FBaseEFOptions : TOvcBaseEFOptions; {options common to all entry fields}
- FEntryCommands : TOvcCommandProcessor; {command processor}
- FEpoch : Integer; {combined epoch year and century}
- FErrorPending : Boolean; {an error is pending for an ef}
- FErrorText : string; {text of last error}
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
- FHandle : TOvcHWnd{hWnd}; {our window handle}
-
- FInsertMode : Boolean; {global insert mode flag}
-{$IFNDEF LCL} //Currently not implemented
- FTimerPool : TOvcTimerPool; {general timer pool}
-{$ENDIF}
-
- {events}
- FOnDelayNotify : TDelayNotifyEvent;
- FOnError : TDataErrorEvent;
- FOnGetEpoch : TGetEpochEvent;
- FOnIsSpecialControl : TIsSpecialControlEvent;
- FOnPostEdit : TPostEditEvent;
- FOnPreEdit : TPreEditEvent;
-{$IFNDEF LCL}
- FOnTimerTrigger : TTriggerEvent;
-{$ENDIF}
-
- {property methods}
- function GetEpoch : Integer;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
- function GetHandle : TOvcHWnd{hWnd};
- procedure SetEpoch(Value : Integer);
-
- {internal methods}
- procedure cWndProc(var Msg : TMessage);
- {-window procedure}
-
- public
- constructor Create(AOwner: TComponent);
- override;
- destructor Destroy;
- override;
-
- procedure DestroyHandle;
-
-{$IFDEF LCL}
- function PostMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL;
-{$ENDIF}
- {wrappers for event handlers}
- procedure DoOnPostEdit(Sender : TObject; GainingControl : TWinControl);
- {-call the method assigned to the OnPostEdit event}
- procedure DoOnPreEdit(Sender : TObject; LosingControl : TWinControl);
- {-call the method assigned to the OnPreEdit event}
- procedure DoOnTimerTrigger(Sender : TObject; Handle : Integer;
- Interval : Cardinal; ElapsedTime : LongInt);
-
- procedure DelayNotify(Sender : TObject; NotifyCode : Word);
- {-start the chain of events that will fire the OnDelayNotify event}
- procedure DoOnError(Sender : TObject; ErrorCode : Word; const ErrorMsg : string);
- {-call the method assigned to the OnError event}
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
- function IsSpecialButton(H : TOvcHWnd{hWnd}) : Boolean;
- dynamic;
- {-return true if H is btnCancel, btnHelp, or btnRestore}
- procedure MarkAsUninitialized(Uninitialized : Boolean);
- {-mark all entry fields on form as uninitialized}
- function ValidateEntryFields : TComponent;
- {-ask each entry field to validate its contents. Return nil
- if no error, else return pointer to field with error}
- function ValidateEntryFieldsEx(ReportError, ChangeFocus : Boolean) : TComponent;
- {-ask each entry field to validate its contents. Return nil
- if no error, else return pointer to field with error.
- Conditionally move focus and report error}
- function ValidateTheseEntryFields(const Fields : array of TComponent) : TComponent;
- {-ask the specified entry fields to validate their contents. Return nil
- if no error, else return pointer to field with error}
-
- property ErrorPending : Boolean
- read FErrorPending write FErrorPending;
- property ErrorText : string
- read FErrorText write FErrorText;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
- property Handle : TOvcHWnd{hWnd}
- read GetHandle;
- property InsertMode : Boolean
- read FInsertMode write FInsertMode;
-{$IFNDEF LCL}
- property TimerPool : TOvcTimerPool
- read FTimerPool;
-{$ENDIF}
-
- published
- {properties}
- property EntryCommands : TOvcCommandProcessor
- read FEntryCommands write FEntryCommands stored True;
- property EntryOptions : TOvcBaseEFOptions
- read FBaseEFOptions write FBaseEFOptions
- default [efoAutoSelect, efoBeepOnError, efoInsertPushes];
- property Epoch : Integer
- read GetEpoch write SetEpoch;
-
- {events}
- property OnError : TDataErrorEvent
- read FOnError write FOnError;
- property OnGetEpoch : TGetEpochEvent
- read FOnGetEpoch write FOnGetEpoch;
- property OnDelayNotify : TDelayNotifyEvent
- read FOnDelayNotify write FOnDelayNotify;
- property OnIsSpecialControl : TIsSpecialControlEvent
- read FOnIsSpecialControl write FOnIsSpecialControl;
- property OnPostEdit : TPostEditEvent
- read FOnPostEdit write FOnPostEdit;
- property OnPreEdit : TPreEditEvent
- read FOnPreEdit write FOnPreEdit;
-{$IFNDEF LCL}
- property OnTimerTrigger : TTriggerEvent
- read FOnTimerTrigger write FOnTimerTrigger;
-{$ENDIF}
- end;
-
- TOvcGraphicControl = class(TGraphicControl)
- protected {private}
- FCollectionStreamer : TOvcCollectionStreamer;
- {property methods}
- function GetAbout : string;
- procedure SetAbout(const Value : string);
- protected
- {Collection streaming hooks:}
- procedure GetChildren(Proc: TGetChildProc; Root : TComponent); override;
- function GetChildOwner: TComponent; override;
- procedure Loaded; override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- property CollectionStreamer : TOvcCollectionStreamer
- read FCollectionStreamer write FCollectionStreamer;
- published
- property About : string
- read GetAbout write SetAbout stored False;
- end;
-
- {Replacement for the TOvcCustomControl except with standard VCL streaming}
- TO32CustomControl = class(TCustomControl)
- protected {private}
- {property variables}
- FAfterEnter : TNotifyEvent;
- FAfterExit : TNotifyEvent;
- FOnMouseWheel : TMouseWheelEvent;
- FLabelInfo : TOvcLabelInfo;
- FInternal : Boolean; {flag to suppress name generation
- on collection items}
-
- {property methods}
- function GetAttachedLabel : TOvcAttachedLabel;
- function GetAbout : string;
- procedure SetAbout(const Value : string);
-
- {internal methods}
- procedure LabelAttach(Sender : TObject; Value : Boolean);
- procedure LabelChange(Sender : TObject);
- procedure PositionLabel;
-
- {private message methods}
- procedure OMAssignLabel(var Msg : TMessage);
- message OM_ASSIGNLABEL;
- procedure OMPositionLabel(var Msg : TMessage);
- message OM_POSITIONLABEL;
- procedure OMRecordLabelPosition(var Msg : TMessage);
- message OM_RECORDLABELPOSITION;
- procedure OMAfterEnter(var Msg : TMessage);
- message OM_AFTERENTER;
- procedure OMAfterExit(var Msg : TMessage);
- message OM_AFTEREXIT;
-
- {VCL message methods}
- procedure CMVisibleChanged(var Msg : TMessage);
- message CM_VISIBLECHANGED;
-
- {windows message methods}
- procedure WMKillFocus(var Msg : TWMKillFocus);
- message WM_KILLFOCUS;
- procedure WMMouseWheel(var Msg : TMessage);
- message WM_MOUSEWHEEL;
- procedure WMSetFocus(var Msg : TWMSetFocus);
- message WM_SETFOCUS;
-
- protected
- DefaultLabelPosition : TOvcLabelPosition;
-
- procedure DoOnMouseWheel(Shift : TShiftState;
- Delta, XPos, YPos : SmallInt);
- dynamic;
- procedure CreateWnd;
- override;
- procedure Notification(AComponent : TComponent; Operation : TOperation);
- override;
-
- property AfterEnter : TNotifyEvent
- read FAfterEnter write FAfterEnter;
- property AfterExit : TNotifyEvent
- read FAfterExit write FAfterExit;
- property OnMouseWheel : TMouseWheelEvent
- read FOnMouseWheel write FOnMouseWheel;
- property LabelInfo : TOvcLabelInfo
- read FLabelInfo write FLabelInfo;
-
- public
- property Internal : Boolean read FInternal write FInternal;
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
- override;
- property AttachedLabel : TOvcAttachedLabel
- read GetAttachedLabel;
-
- published
- property About : string
- read GetAbout write SetAbout stored False;
- end;
- {End - TO32CustomControl}
-
-
- TOvcCustomControl = class(TCustomControl)
- protected {private}
- {property variables}
- FAfterEnter : TNotifyEvent;
- FAfterExit : TNotifyEvent;
- FCollectionStreamer : TOvcCollectionStreamer;
- FOnMouseWheel : TMouseWheelEvent;
- FLabelInfo : TOvcLabelInfo;
- FInternal : Boolean; {flag to suppress name generation
- on collection items}
-
- {property methods}
- function GetAttachedLabel : TOvcAttachedLabel;
- function GetAbout : string;
- procedure SetAbout(const Value : string);
-
- {internal methods}
- procedure LabelAttach(Sender : TObject; Value : Boolean);
- procedure LabelChange(Sender : TObject);
- procedure PositionLabel;
-
- {private message methods}
- procedure OMAssignLabel(var Msg : TMessage);
- message OM_ASSIGNLABEL;
- procedure OMPositionLabel(var Msg : TMessage);
- message OM_POSITIONLABEL;
- procedure OMRecordLabelPosition(var Msg : TMessage);
- message OM_RECORDLABELPOSITION;
- procedure OMAfterEnter(var Msg : TMessage);
- message OM_AFTERENTER;
- procedure OMAfterExit(var Msg : TMessage);
- message OM_AFTEREXIT;
-
- {VCL message methods}
- procedure CMVisibleChanged(var Msg : TMessage);
- message CM_VISIBLECHANGED;
-
- {windows message methods}
- procedure WMKillFocus(var Msg : TWMKillFocus);
- message WM_KILLFOCUS;
- procedure WMMouseWheel(var Msg : TMessage);
- message WM_MOUSEWHEEL;
- procedure WMSetFocus(var Msg : TWMSetFocus);
- message WM_SETFOCUS;
-
- protected
- {descendants can set the value of this variable after calling inherited }
- {create to set the default location and point-of-reference (POR) for the}
- {attached label. if dlpTopLeft, the default location and POR will be at }
- {the top left of the control. if dlpBottomLeft, the default location and}
- {POR will be at the bottom left}
- DefaultLabelPosition : TOvcLabelPosition;
-
- procedure DoOnMouseWheel(Shift : TShiftState;
- Delta, XPos, YPos : SmallInt);
- dynamic;
- procedure CreateWnd;
- override;
- procedure Notification(AComponent : TComponent; Operation : TOperation);
- override;
-
- {Collection streaming hooks:}
- procedure GetChildren(Proc: TGetChildProc; Root : TComponent); override;
- function GetChildOwner: TComponent; override;
- procedure Loaded; override;
-
- property AfterEnter : TNotifyEvent
- read FAfterEnter write FAfterEnter;
- property AfterExit : TNotifyEvent
- read FAfterExit write FAfterExit;
- property OnMouseWheel : TMouseWheelEvent
- read FOnMouseWheel write FOnMouseWheel;
- property LabelInfo : TOvcLabelInfo
- read FLabelInfo write FLabelInfo;
-
- public
- property Internal : Boolean read FInternal write FInternal;
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
- override;
- property AttachedLabel : TOvcAttachedLabel
- read GetAttachedLabel;
- property CollectionStreamer : TOvcCollectionStreamer
- read FCollectionStreamer write FCollectionStreamer;
-
- published
- property About : string
- read GetAbout write SetAbout stored False;
- end;
-
- TOvcCollectible = class(TOvcComponent)
- protected {private}
- FCollection : TOvcCollection;
- InChanged : Boolean;
-
- function GetIndex : Integer;
- procedure SetCollection(Value : TOvcCollection);
- procedure SetIndex(Value : Integer); virtual;
-
- protected
- procedure Changed; dynamic;
- function GenerateName : string;
- dynamic;
- function GetBaseName : string;
- dynamic;
- function GetDisplayText : string;
- virtual;
- procedure SetName(const NewName : TComponentName);
- override;
-
- public
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
- property Collection : TOvcCollection
- read FCollection;
- property DisplayText : string
- read GetDisplayText;
- property Index : Integer
- read GetIndex
- write SetIndex;
-
- property Name;
- end;
-
- TO32CollectionItem = class(TCollectionItem)
- protected {private}
- FName: String;
- FDisplayText: String;
- function GetAbout: String;
- procedure SetAbout(const Value: String);
- procedure SetName(Value: String); virtual;
- public
- property DisplayText : string read FDisplayText write FDisplayText;
- property Name: String read FName write SetName;
- published
- property About : String read GetAbout write SetAbout;
- end;
-
-
- TOvcCollectibleControl = class(TOvcCustomControl)
- protected {private}
- FCollection : TOvcCollection;
- FInternal : Boolean; {flag to suppress name generation
- on collection items}
- InChanged : Boolean;
-
- function GetIndex : Integer;
- procedure SetCollection(Value : TOvcCollection);
- procedure SetIndex(Value : Integer);
-
- protected
- procedure Changed; dynamic;
- function GenerateName : string;
- dynamic;
- function GetBaseName : string;
- dynamic;
- function GetDisplayText : string;
- virtual;
- procedure SetName(const NewName : TComponentName);
- override;
-
- public
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
-
- property Internal : Boolean read FInternal write FInternal;
-
- property Collection : TOvcCollection
- read FCollection;
-
- property DisplayText : string
- read GetDisplayText;
-
- property Index : Integer
- read GetIndex
- write SetIndex;
-
- property Name;
- end;
-
- TOvcCollectibleClass = class of TComponent;
- TO32CollectibleClass = class of TPersistent;
-
- TOvcItemSelectedEvent =
- procedure(Sender : TObject; Index : Integer) of object;
- TOvcGetEditorCaption =
- procedure(var Caption : string) of object;
- TO32GetEditorCaption =
- procedure(var Caption : string) of object;
-
- TOvcCollection = class(TPersistent)
- protected {private}
- {property variables}
- FItemClass : TOvcCollectibleClass;
- FItemEditor : TForm;
- FItems : TList;
- FOwner : TComponent;
- FReadOnly : Boolean;
- FStored : Boolean;
- FStreamer : TOvcCollectionStreamer;
-
- {event variables}
- FOnChanged : TNotifyEvent;
- FOnItemSelected : TOvcItemSelectedEvent;
- FOnGetEditorCaption : TOvcGetEditorCaption;
-
- {Internal variables}
- InLoaded : Boolean;
- IsLoaded : Boolean;
- InChanged : Boolean;
-
- protected
- function GetCount : Integer;
- function GetItem(Index: Integer): TComponent;
- procedure SetItem(Index: Integer; Value: TComponent);
-
- procedure Changed;
- virtual;
- procedure Loaded;
-
- public
- constructor Create(AOwner : TComponent; ItemClass : TOvcCollectibleClass);
- destructor Destroy;
- override;
- property ItemEditor : TForm
- read FItemEditor write FItemEditor;
-
- function Add : TComponent;
- procedure Clear; virtual;
- procedure Delete(Index : Integer);
- procedure DoOnItemSelected(Index : Integer);
- function GetEditorCaption : string;
- function ItemByName(const Name : string) : TComponent;
- function Insert(Index : Integer) : TComponent;
- function ParentForm : TForm;
-
- property Count: Integer
- read GetCount;
- property ItemClass : TOvcCollectibleClass
- read FItemClass;
- property Item[Index: Integer] : TComponent
- read GetItem write SetItem; default;
- property OnGetEditorCaption : TOvcGetEditorCaption
- read FOnGetEditorCaption write FOnGetEditorCaption;
- property Owner : TComponent
- read FOwner;
- property ReadOnly : Boolean
- read FReadOnly write FReadOnly default False;
- property Stored : Boolean
- read FStored write FStored default True;
- property OnChanged : TNotifyEvent
- read FOnChanged write FOnChanged;
- property OnItemSelected : TOvcItemSelectedEvent
- read FOnItemSelected write FOnItemSelected;
- end;
-
- TO32Collection = class(TCollection)
- protected {private}
- {property variables}
- FItemEditor : TForm;
- FReadOnly : Boolean;
-
- FOwner: TPersistent;
-
- {event variables}
- FOnChanged : TNotifyEvent;
- FOnItemSelected : TOvcItemSelectedEvent;
- FOnGetEditorCaption : TO32GetEditorCaption;
-
- {Internal variables}
- InLoaded : Boolean;
- IsLoaded : Boolean;
- InChanged : Boolean;
-
- protected
- function GetCount : Integer;
- procedure Loaded;
- public
- constructor Create(AOwner : TPersistent;
- ItemClass : TCollectionItemClass); virtual;
- destructor Destroy; override;
- property ItemEditor : TForm read FItemEditor write FItemEditor;
-
- function Add : TO32CollectionItem; dynamic;
-
- {$IFNDEF VERSION4}
- function Insert(Index: Integer): TO32CollectionItem; dynamic;
- {$ENDIF}
-
- function GetItem(Index: Integer): TO32CollectionItem;
- function GetOwner: TPersistent; override;
- procedure SetItem(Index: Integer; Value: TO32CollectionItem);
- procedure DoOnItemSelected(Index : Integer);
- function GetEditorCaption : string;
- function ItemByName(const Name : string) : TO32CollectionItem;
- function ParentForm : TForm;
-
- property Count: Integer
- read GetCount;
- property Item[Index: Integer] : TO32CollectionItem
- read GetItem write SetItem; default;
- property OnGetEditorCaption : TO32GetEditorCaption
- read FOnGetEditorCaption write FOnGetEditorCaption;
- property ReadOnly : Boolean
- read FReadOnly write FReadOnly default False;
- property OnChanged : TNotifyEvent
- read FOnChanged write FOnChanged;
- property OnItemSelected : TOvcItemSelectedEvent
- read FOnItemSelected write FOnItemSelected;
- end;
-
- TOvcCollectionStreamer = class
- protected {private}
- FCollectionList : TList;
- FOwner : TComponent;
-
- protected
- procedure Loaded;
- procedure GetChildren(Proc: TGetChildProc; Root : TComponent);
-
- public
- constructor Create(AOwner : TComponent);
- destructor Destroy;
- override;
-
- procedure Clear;
- function CollectionFromType(Component : TComponent) : TOvcCollection;
-
- property Owner : TComponent
- read FOwner;
- end;
-
-
-type
- {base class for Orpheus components. Provides controller access}
- TOvcCustomControlEx = class(TOvcCustomControl)
- protected {private}
- FController : TOvcController;
-
- function ControllerAssigned : Boolean;
- function GetController: TOvcController;
- procedure SetController(Value : TOvcController); virtual;
-
- protected
- procedure CreateWnd;
- override;
- procedure Notification(AComponent : TComponent; Operation : TOperation);
- override;
-
- public
- property Controller : TOvcController
- read GetController
- write SetController;
- end;
-
-
-function FindController(Form : TWinControl) : TOvcController;
- {-search for an existing controller component}
-function GetImmediateParentForm(Control : TControl) : TWinControl;
- {-return first form found while searching Parent}
-procedure ResolveController(AForm : TWinControl; var AController : TOvcController);
- {-find or create a controller on this form}
-
-function DefaultController : TOvcController;
-
-implementation
-
-{.$DEFINE Logging}
-uses
- OvcVer,
- TypInfo,
- ExtCtrls,
-{$IFNDEF LCL}
- Consts,
-{$ELSE}
- LclStrConsts,
-{$ENDIF}
- OvcEF
- {$IFDEF Logging}
- ,LogAPI
- {$ENDIF}
- ;
-
-type
- TLocalEF = class(TOvcBaseEntryField);
-var
- FDefaultController : TOvcController = nil;
-
-{===== TO32ContainerList =============================================}
-
-constructor TO32ContainerList.Create(AOwner: TComponent);
-begin
- inherited Create;
- FOwner := TComponent(AOwner);
-end;
-{=====}
-
-destructor TO32ContainerList.Destroy;
-var
- I: Integer;
-begin
- for I := 0 to Count - 1 do
- TPanel(Items[I]).Free;
- inherited;
-end;
-
-
-{*** TOvcLabelInfo ***}
-
-procedure TOvcLabelInfo.DoOnAttach;
-begin
- if Assigned(FOnAttach) then
- FOnAttach(Self, FVisible);
-end;
-
-procedure TOvcLabelInfo.DoOnChange;
-begin
- if Assigned(FOnChange) then
- FOnChange(Self);
-end;
-
-function TOvcLabelInfo.IsVisible : Boolean;
-begin
- Result := FVisible;
-end;
-
-procedure TOvcLabelInfo.SetOffsets(X, Y : Integer);
-begin
- if (X <> FOffsetX) or (Y <> FOffsetY) then begin
- FOffsetX := X;
- FOffsetY := Y;
- DoOnChange;
- end;
-end;
-
-procedure TOvcLabelInfo.SetOffsetX(Value : Integer);
-begin
- if Value <> FOffsetX then begin
- FOffsetX := Value;
- DoOnChange;
- end;
-end;
-
-procedure TOvcLabelInfo.SetOffsetY(Value : Integer);
-begin
- if Value <> FOffsetY then begin
- FOffsetY := Value;
- DoOnChange;
- end;
-end;
-
-procedure TOvcLabelInfo.SetVisible(Value : Boolean);
-begin
- if Value <> FVisible then begin
- FVisible := Value;
- DoOnAttach;
- end;
-end;
-
-
-{*** TOvcAttachedLabel ***}
-
-constructor TOvcAttachedLabel.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- {set new defaults}
- AutoSize := True;
- ParentFont := True;
- Transparent := False;
-end;
-
-constructor TOvcAttachedLabel.CreateEx(AOwner : TComponent; AControl : TWinControl);
-begin
- FControl := AControl;
-
- Create(AOwner);
-
- {set attached control property}
- FocusControl := FControl;
-end;
-
-procedure TOvcAttachedLabel.Loaded;
-begin
- inherited Loaded;
-
- SavePosition;
-end;
-
-procedure TOvcAttachedLabel.SavePosition;
-var
- PF : TWinControl;
- I : Integer;
-begin
- if (csLoading in ComponentState) or (csDestroying in ComponentState) then
- Exit;
-
- {see if our associated control is on the form - save position}
- PF := GetImmediateParentForm(Self);
- if Assigned(PF) then begin
- for I := 0 to Pred(PF.ComponentCount) do begin
- if PF.Components[I] = FControl then begin
- SendMessage(FControl.Handle, OM_ASSIGNLABEL, 0, LPARAM(Self)); //64
- PostMessage(FControl.Handle, OM_RECORDLABELPOSITION, 0, 0);
- Break;
- end;
- end;
- end;
-end;
-
-procedure TOvcAttachedLabel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
-begin
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
- SavePosition;
-
- { The following line causes the IDE to mark the form dirty, requiring it }
- { to be saved. Not sure what this was supposed to do, but commenting it }
- { out seems to solve the problem. }
- {Application.ProcessMessages;}
-end;
-
-function FindController(Form : TWinControl) : TOvcController;
- {-search for an existing controller component}
-var
- I : Integer;
-begin
- Result := nil;
- for I := 0 to Form.ComponentCount-1 do begin
- if Form.Components[I] is TOvcController then begin
- Result := TOvcController(Form.Components[I]);
- Break;
- end;
- end;
-end;
-
-function GetImmediateParentForm(Control : TControl) : TWinControl;
- {return first form found while searching Parent}
-var
- ParentCtrl : TControl;
-begin
- ParentCtrl := Control.Parent;
-{$IFDEF VERSION5}
- while Assigned(ParentCtrl) and
- not ((ParentCtrl is TCustomForm) or
- (ParentCtrl is TCustomFrame)) do
-{$ELSE}
- while Assigned(ParentCtrl) and (not (ParentCtrl is TCustomForm)) do
-{$ENDIF}
- ParentCtrl := ParentCtrl.Parent;
- Result := TWinControl(ParentCtrl);
-end;
-
-procedure ResolveController(AForm : TWinControl; var AController : TOvcController);
- {-find or create a controller on this form}
-begin
- if not Assigned(AController) then begin
- {search for an existing controller. If not found,}
- {create the controller as a child of the form}
- {and assign it as our controller}
- AController := FindController(AForm);
- (*
- if not Assigned(AController) then begin
- AController := TOvcController.Create(AForm);
- try
- AController.Name := 'OvcController1';
- except
- AController.Free;
- AController := nil;
- raise;
- end;
- end;
- *)
- end;
-end;
-
-{*** TOvcComponent ***}
-
-constructor TOvcComponent.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
-end;
-
-destructor TOvcComponent.Destroy;
-begin
- FCollectionStreamer.Free;
- FCollectionStreamer := nil;
-
- inherited Destroy;
-end;
-
-function TOvcComponent.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-
-procedure TOvcComponent.SetAbout(const Value : string);
-begin
-end;
-
-
-{Logic for streaming collections of sub-components}
-
-function TOvcComponent.GetChildOwner: TComponent;
-begin
- if assigned(FCollectionStreamer) then
- Result := FCollectionStreamer.Owner
- else
- Result := inherited GetChildOwner;
-end;
-
-procedure TOvcComponent.GetChildren(Proc: TGetChildProc; Root : TComponent);
-begin
- if assigned(FCollectionStreamer) then
- CollectionStreamer.GetChildren(Proc, Root)
- else
- inherited GetChildren(Proc,Root);
-end;
-
-procedure TOvcComponent.Loaded;
-begin
- if assigned(FCollectionStreamer) then
- FCollectionStreamer.Loaded;
-
- inherited Loaded;
-end;
-
-{*** TO32Component ***}
-constructor TO32Component.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
-end;
-
-function TO32Component.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-
-procedure TO32Component.SetAbout(const Value : string);
-begin
-end;
-
-
-{*** TOvcCollectible ***}
-constructor TOvcCollectible.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- if (AOwner is TOvcComponent) then begin
- if TOvcComponent(AOwner).CollectionStreamer = nil then
- raise Exception.Create(GetOrphStr(SCNoCollection));
- SetCollection(TOvcComponent(AOwner).CollectionStreamer.CollectionFromType(Self));
- end else
- if (AOwner is TOvcCustomControl) then begin
- if TOvcCustomControl(AOwner).CollectionStreamer = nil then
- raise Exception.Create(GetOrphStr(SCNoCollection));
- SetCollection(TOvcCustomControl(AOwner).CollectionStreamer.CollectionFromType(Self));
- end else
- raise Exception.Create(GetOrphStr(SCNotOvcDescendant));
-
- if (csDesigning in ComponentState)
- and (AOwner <> nil) then
- if ((AOwner is TOvcComponent) and not TOvcComponent(AOwner).FInternal)
- or ((AOwner is TOvcCollectibleControl) and not TOvcCollectibleControl(AOwner).FInternal)
- or ((AOwner is TOvcCustomControl) and not TOvcCustomControl(AOwner).FInternal) then
-{$IFDEF VERSION5}
- if not (csLoading in AOwner.ComponentState) then
-{$ELSE}
- if not (csLoading in AOwner.ComponentState) then
-{$ENDIF}
- Name := GenerateName;
-end;
-
-destructor TOvcCollectible.Destroy;
-var
- OldCollection : TOvcCollection;
-begin
- OldCollection := Collection;
- SetCollection(nil);
- inherited Destroy;
- {mark dirty}
- if (csDesigning in ComponentState)
- and (OldCollection <> nil)
- and not (csDestroying in
- OldCollection.Owner.ComponentState) then begin
- OldCollection.Changed;
- end;
-end;
-
-function TOvcCollectible.GenerateName : string;
-var
- PF : TWinControl;
- I : Integer;
- S : string;
-
- function SearchSubComponents(C : TComponent; const S : string) : TComponent;
- var
- I : Integer;
- begin
- Result := C;
- if CompareText(S, Result.Name) = 0 then
- Exit;
- for I := 0 to C.ComponentCount-1 do begin
- Result := SearchSubComponents(C.Components[I], S);
- if Result <> nil then
- Exit;
- end;
- Result := nil;
- end;
-
- function FindComponentName(const S : string) : TComponent;
- begin
- Result := SearchSubComponents(PF, S);
- end;
-
-begin
- I := 1;
- S := GetBaseName;
- Result := Format('%s%d', [S, I]);
- PF := Collection.ParentForm;
- if not Assigned(PF) then
- Exit;
-
- while FindComponentName(Result) <> nil do begin
- Inc(I);
- Result := Format('%s%d', [S, I]);
- end;
-end;
-
-procedure TOvcCollectible.SetName(const NewName : TComponentName);
-begin
- inherited SetName(NewName);
- if not (csLoading in ComponentState) then
-{$IFDEF VERSION5}
- if (csInLine in ComponentState) then
- Changed;
-{$ENDIF}
- if (Collection <> nil)
- and (Collection.ItemEditor <> nil) then
- SendMessage(Collection.ItemEditor.Handle, OM_PROPCHANGE, 0, 0);
-end;
-
-function TOvcCollectible.GetBaseName : string;
-begin
- Result := 'CollectionItem';
-end;
-
-function TOvcCollectible.GetDisplayText : string;
-begin
- Result := ClassName;
-end;
-
-procedure TOvcCollectible.Changed;
-begin
- if InChanged then exit;
- InChanged := True;
- try
- {$IFDEF Logging}
- LogMsg('TOvcCollectible.Changed');
- LogBoolean('assigned(FCollection)', assigned(FCollection));
- LogBoolean('(csInline in ComponentState)', (csInline in ComponentState));
- LogBoolean('csAncestor in Owner.ComponentState', csAncestor in Owner.ComponentState);
- {$ENDIF}
- if assigned(FCollection) then
- {$IFDEF Version5}
- if not (csInline in ComponentState) then
- {$ENDIF}
- FCollection.Changed;
- finally
- InChanged := False;
- end;
-end;
-
-function TOvcCollectible.GetIndex : Integer;
-begin
- if assigned(FCollection) then
- Result := FCollection.FItems.IndexOf(Self)
- else
- Result := -1;
-end;
-
-procedure TOvcCollectible.SetIndex(Value : Integer);
-begin
- if Value <> Index then begin
- if assigned(FCollection) then begin
- FCollection.FItems.Remove(Self);
- FCollection.FItems.Insert(Value,Self);
- end;
- Changed;
- end;
-end;
-
-procedure TOvcCollectible.SetCollection(Value : TOvcCollection);
-begin
- if Collection <> Value then begin
- if Collection <> nil then
- Collection.FItems.Remove(Self);
- if Value <> nil then begin
- if not (Self is Value.ItemClass) then
- raise Exception.Create(GetOrphStr(SCItemIncompatible));
- Value.FItems.Add(Self);
- end;
- FCollection := Value;
- end;
-end;
-
-
-
-{===== TO32CollectionItem ============================================}
-
-function TO32CollectionItem.GetAbout: String;
-begin
- Result := OrVersionStr;
-end;
-
-procedure TO32CollectionItem.SetAbout(const Value: String);
-begin
-end;
-
-procedure TO32CollectionItem.SetName(Value: String);
-begin
- FName := Value;
-end;
-{=====}
-
-{*** TOvcCollectibleControl ***}
-constructor TOvcCollectibleControl.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- if (AOwner is TOvcComponent) then begin
- if TOvcComponent(AOwner).CollectionStreamer = nil then
- raise Exception.Create(GetOrphStr(SCNoCollection));
- SetCollection(TOvcComponent(AOwner).CollectionStreamer.CollectionFromType(Self));
- end else
- if (AOwner is TOvcCustomControl) then begin
- if TOvcCustomControl(AOwner).CollectionStreamer = nil then
- raise Exception.Create(GetOrphStr(SCNoCollection));
- SetCollection(TOvcCustomControl(AOwner).CollectionStreamer.CollectionFromType(Self));
- end else
- raise Exception.Create(GetOrphStr(SCNotOvcDescendant));
-
- if (csDesigning in ComponentState)
- and (AOwner <> nil) then
- if ((AOwner is TOvcComponent) and not TOvcComponent(AOwner).FInternal)
- or ((AOwner is TOvcCollectibleControl) and not TOvcCollectibleControl(AOwner).FInternal)
- or ((AOwner is TOvcCustomControl) and not TOvcCustomControl(AOwner).FInternal) then
- if not (csLoading in AOwner.ComponentState)
- {$IFDEF Version5}
- and not (csInLine in AOwner.ComponentState)
- {$ENDIF}
- then Name := GenerateName;
-end;
-
-destructor TOvcCollectibleControl.Destroy;
-var
- OldCollection : TOvcCollection;
-begin
- OldCollection := Collection;
- SetCollection(nil);
- inherited Destroy;
- {mark dirty}
- if (csDesigning in ComponentState)
- and (OldCollection <> nil)
- and not (csDestroying in
- OldCollection.Owner.ComponentState) then begin
- OldCollection.Changed;
- end;
-end;
-
-function TOvcCollectibleControl.GenerateName : string;
-var
- PF : TWinControl;
- I : Integer;
- S : string;
-
- function SearchSubComponents(C : TComponent; const S : string) : TComponent;
- var
- I : Integer;
- begin
- Result := C;
- if CompareText(S, Result.Name) = 0 then
- Exit;
- for I := 0 to C.ComponentCount-1 do begin
- Result := SearchSubComponents(C.Components[I], S);
- if Result <> nil then
- Exit;
- end;
- Result := nil;
- end;
-
- function FindComponentName(const S : string) : TComponent;
- begin
- Result := SearchSubComponents(PF, S);
- end;
-
-begin
- I := 1;
- S := GetBaseName;
- Result := Format('%s%d', [S, I]);
- PF := Collection.ParentForm;
- if not Assigned(PF) then
- Exit;
-
- while FindComponentName(Result) <> nil do begin
- Inc(I);
- Result := Format('%s%d', [S, I]);
- end;
-end;
-
-procedure TOvcCollectibleControl.SetName(const NewName : TComponentName);
-begin
- inherited SetName(NewName);
- if not (csLoading in ComponentState) then
- {$IFDEF Version5}
- if not (csInLine in ComponentState) then
- {$ENDIF}
- Changed;
-end;
-
-function TOvcCollectibleControl.GetBaseName : string;
-begin
- Result := 'CollectionItem';
-end;
-
-function TOvcCollectibleControl.GetDisplayText : string;
-begin
- Result := ClassName;
-end;
-
-procedure TOvcCollectibleControl.Changed;
-begin
- if InChanged then exit;
- InChanged := True;
- try
- if assigned(FCollection) then
- {$IFDEF Version5}
- if not (csInline in ComponentState) then
- {$ENDIF}
- FCollection.Changed;
- finally
- InChanged := False;
- end;
-end;
-
-function TOvcCollectibleControl.GetIndex : Integer;
-begin
- if Collection <> nil then
- Result := Collection.FItems.IndexOf(Self)
- else
- Result := -1;
-end;
-
-procedure TOvcCollectibleControl.SetIndex(Value : Integer);
-begin
- if Value <> Index then begin
- if Collection <> nil then begin
- Collection.FItems.Remove(Self);
- Collection.FItems.Insert(Value,Self);
- end;
- Changed;
- end;
-end;
-
-procedure TOvcCollectibleControl.SetCollection(Value : TOvcCollection);
-begin
- if Collection <> Value then begin
- if Collection <> nil then
- Collection.FItems.Remove(Self);
- if Value <> nil then begin
- if not (Self is Value.ItemClass) then
- raise Exception.Create(GetOrphStr(SCItemIncompatible));
- Value.FItems.Add(Self);
- end;
- FCollection := Value;
- end;
-end;
-
-{*** TOvcController ***}
-constructor TOvcController.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- {create the command processor}
- FEntryCommands := TOvcCommandProcessor.Create;
- FBaseEFOptions := [efoAutoSelect, efoBeepOnError, efoInsertPushes];
- FEpoch := DefaultEpoch;
- FErrorPending := False;
- FInsertMode := True;
-
-{$IFNDEF LCL}
- {create the general use timer pool}
- FTimerPool := TOvcTimerPool.Create(Self);
- FTimerPool.OnAllTriggers := DoOnTimerTrigger;
-{$ENDIF}
-end;
-
-procedure TOvcController.cWndProc(var Msg : TMessage);
- {-window procedure}
-var
- C : TWinControl;
-begin
- C := TWinControl(Msg.lParam);
- try
- with Msg do begin
- case Msg of
- OM_SETFOCUS :
- begin
- C.Show;
- if C.CanFocus then
- C.SetFocus;
- end;
- OM_PREEDIT :
- if Assigned(FOnPreEdit) then
- FOnPreEdit(TWinControl(lParam), FindControl(wParam));
- OM_POSTEDIT :
- if Assigned(FOnPostEdit) then
- FOnPostEdit(TWinControl(lParam), FindControl(wParam));
- OM_DELAYNOTIFY :
- if Assigned(FOnDelayNotify) then
- FOnDelayNotify(TObject(lParam), wParam);
- else
- Result := DefWindowProc(Handle, Msg, wParam, lParam);
- end;
- end;
- except
- Application.HandleException(Self);
- end;
-end;
-
-{$IFDEF LCL}
-function TOvcController.PostMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): BOOL;
-var
- AMsg : TMessage;
-begin
- if hWnd = Handle then
- begin
- AMsg.Msg := Msg;
- AMsg.WParam := wParam;
- AMsg.LParam := lParam;
- cWndProc(AMsg);
- end
- else
-{$IFDEF MSWINDOWS}
- Result := MyMisc.PostMessage(hWnd, Msg, wParam, lParam);
-{$ELSE}
- Result := LclIntf.PostMessage(hWnd, Msg, wParam, lParam);
-{$ENDIF}
-end;
-{$ENDIF}
-
-procedure TOvcController.DelayNotify(Sender : TObject; NotifyCode : Word);
-begin
- if Assigned(FOnDelayNotify) then
- PostMessage(Handle, OM_DELAYNOTIFY, NotifyCode, LPARAM(Sender)); //64
-end;
-
-destructor TOvcController.Destroy;
-begin
- {destroy the command processor}
- FEntryCommands.Free;
- FEntryCommands := nil;
-
-{$IFNDEF LCL}
- FTimerPool.Free;
- FTimerPool := nil;
-{$ENDIF}
-
- {destroy window handle, if created}
- DestroyHandle;
-
- inherited Destroy;
-end;
-
-procedure TOvcController.DestroyHandle;
-begin
-{$IFNDEF LCL}
- if FHandle <> 0 then
- {$IFDEF VERSION6}
- Classes.DeallocateHWnd(FHandle);
- {$ELSE}
- DeallocateHWnd(FHandle);
- {$ENDIF}
-{$ENDIF}
-
- FHandle := 0;
-end;
-
-procedure TOvcController.DoOnError(Sender : TObject; ErrorCode : Word;
- const ErrorMsg : string);
-begin
- if Assigned(FOnError) then
- FOnError(Sender, ErrorCode, ErrorMsg)
- else
- MessageDlg(ErrorMsg, mtError, [mbOK], 0);
-end;
-
-procedure TOvcController.DoOnPostEdit(Sender : TObject; GainingControl : TWinControl);
-var
- H : hWnd;
-begin
- if Assigned(GainingControl) then
- H := GainingControl.Handle
- else
- H := 0;
-
- PostMessage(Handle, OM_POSTEDIT, H, LPARAM(Sender)); //64
-end;
-
-procedure TOvcController.DoOnPreEdit(Sender : TObject; LosingControl : TWinControl);
-var
- H : hWnd;
-begin
- if Assigned(LosingControl) then
- H := LosingControl.Handle
- else
- H := 0;
-
- PostMessage(Handle, OM_PREEDIT, H, LPARAM(Sender)); //64
-end;
-
-procedure TOvcController.DoOnTimerTrigger(Sender : TObject; Handle : Integer;
- Interval : Cardinal; ElapsedTime : LongInt);
-begin
-{$IFNDEF LCL}
- if Assigned(FOnTimerTrigger) then
- FOnTimerTrigger(Sender, Handle, Interval, ElapsedTime);
-{$ENDIF}
-end;
-
-function TOvcController.GetEpoch : Integer;
-begin
- Result := FEpoch;
- if Assigned(FOnGetEpoch) then
- FOnGetEpoch(Self, Result);
-end;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
-function TOvcController.GetHandle : TOvcHWnd{hWnd};
-begin
-// AllocateHWnd not available in LCL to create non-visual window that
-// responds to messages sent to controller. But shouldn't be needed
-// with controller's PostMessage method that intercepts messages.
-{$IFNDEF LCL}
- if FHandle = 0 then
- {$IFDEF VERSION6}
- FHandle := Classes.AllocateHWnd(cWndProc);
- {$ELSE}
- FHandle := AllocateHWnd(cWndProc);
- {$ENDIF}
-{$ENDIF}
- Result := FHandle;
-end;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
-function TOvcController.IsSpecialButton(H : TOvcHWnd{hWnd}) : Boolean;
-begin
- Result := False;
- if Assigned(FOnIsSpecialControl) then
- FOnIsSpecialControl(Self, FindControl(H), Result);
-end;
-
-procedure TOvcController.MarkAsUninitialized(Uninitialized : Boolean);
- {-mark all entry fields on form as uninitialized}
-var
- I : Integer;
-
- procedure MarkField(C : TComponent);
- var
- J : Integer;
- begin
- {first, see if this component is an entry field}
- if C is TOvcBaseEntryField then
- TOvcBaseEntryField(C).Uninitialized := Uninitialized;
-
- {recurse through all child components}
- for J := 0 to C.ComponentCount-1 do
- MarkField(C.Components[J]);
- end;
-
-begin
-{$IFDEF VERSION5}
- if (Owner is TCustomForm) or (Owner is TCustomFrame) then
- with TWinControl(Owner) do
-{$ELSE}
- if Owner is TForm then
- with TForm(Owner) do
-{$ENDIF}
- for I := 0 to ComponentCount-1 do
- MarkField(Components[I]);
-end;
-
-procedure TOvcController.SetEpoch(Value : Integer);
-begin
- if Value <> FEpoch then
- if (Value >= MinYear) and (Value <= MaxYear) then
- FEpoch := Value;
-end;
-
-function TOvcController.ValidateEntryFields : TComponent;
-begin
- {if error, report it and send focus to field with error}
- Result := ValidateEntryFieldsEx(True, True);
-end;
-
-function TOvcController.ValidateEntryFieldsEx(ReportError, ChangeFocus : Boolean) : TComponent;
-var
- I : Integer;
-
- procedure ValidateEF(C : TComponent);
- var
- J : Integer;
- EF : TLocalEF absolute C;
- begin
- {see if this component is an entry field}
- if (C is TOvcBaseEntryField) then begin
-
- {don't validate invisible or disabled fields}
- if not EF.Visible or not EF.Enabled then
- Exit;
-
- {ask entry field to validate itself}
- if (EF.ValidateContents(False) <> 0) then begin
- {remember only the first invalid field found}
- if not Assigned(Result) then
- Result := EF;
-
- {tell the entry field to report the error}
- if ReportError and not ErrorPending then
- PostMessage(EF.Handle, OM_REPORTERROR, EF.LastError, 0);
-
- {ask the controller to give the focus back to this field}
- if ChangeFocus and not ErrorPending then begin
- PostMessage(Handle, OM_SETFOCUS, 0, LPARAM(EF)); //64
- ErrorPending := True;
- end;
-
- {exit if we are reporting the error or changing the focus}
- if (ReportError or ChangeFocus) then
- Exit;
- end;
- end;
-
- {recurse through all child components}
- for J := 0 to C.ComponentCount-1 do begin
- ValidateEf(C.Components[J]);
-
- {exit if we've already found an error and should stop}
- if Assigned(Result) and (ReportError or ChangeFocus) then
- Break;
- end;
- end;
-
-begin
- Result := nil;
-{$IFDEF VERSION5}
- if ((Owner is TCustomForm) or (Owner is TCustomFrame)) then
- with TWinControl(Owner) do
-{$ELSE}
- if Owner is TForm then
- with TForm(Owner) do
-{$ENDIF}
- for I := 0 to ComponentCount-1 do begin
- ValidateEf(Components[I]);
-
- {stop checking if reporting the error or changing focus}
- if Assigned(Result) and (ReportError or ChangeFocus) then
- Break ;
- end;
-end;
-
-function TOvcController.ValidateTheseEntryFields(const Fields : array of TComponent) : TComponent;
- {-ask the specified entry fields to validate their contents. Return nil
- if no error, else return pointer to field with error}
-var
- I : Integer;
- EF : TLocalEF;
-begin
- Result := nil;
-
- for I := Low(Fields) to High(Fields) do begin
- if Fields[I] is TOvcBaseEntryField then begin
- EF := TLocalEF(Fields[I]);
-
- {ask entry field to validate itself}
- if (EF.ValidateContents(False) <> 0) then begin
- Result := EF;
-
- {tell the entry field to report the error}
- if not ErrorPending then
- PostMessage(EF.Handle, OM_REPORTERROR, EF.LastError, 0);
-
- {ask the controller to give the focus back to this field}
- if not ErrorPending then begin
- PostMessage(Handle, OM_SETFOCUS, 0, LPARAM(EF)); //64
- ErrorPending := True;
- end;
-
- Exit;
- end;
-
- end;
- end;
-end;
-
-{*** TOvcGraphicControl ***}
-
-constructor TOvcGraphicControl.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
-end;
-
-destructor TOvcGraphicControl.Destroy;
-begin
- FCollectionStreamer.Free;
- FCollectionStreamer := nil;
- inherited Destroy;
-end;
-
-
-procedure TOvcGraphicControl.Loaded;
-begin
- if Assigned(FCollectionStreamer) then
- FCollectionStreamer.Loaded;
- inherited Loaded;
-end;
-
-{Logic for streaming collections of sub-components}
-
-function TOvcGraphicControl.GetChildOwner: TComponent;
-begin
- if Assigned(FCollectionStreamer) then
- Result := FCollectionStreamer.Owner
- else
- Result := inherited GetChildOwner;
-end;
-
-procedure TOvcGraphicControl.GetChildren(Proc: TGetChildProc; Root : TComponent);
-begin
- if Assigned(FCollectionStreamer) then
- CollectionStreamer.GetChildren(Proc, Root)
- else
- inherited GetChildren(Proc, Root);
-end;
-
-function TOvcGraphicControl.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-
-
-procedure TOvcGraphicControl.SetAbout(const Value : string);
-begin
-end;
-
-
-{*** TO32CustomControl ***}
-
-procedure TO32CustomControl.CMVisibleChanged(var Msg : TMessage);
-begin
- inherited;
-
- if csLoading in ComponentState then
- Exit;
-
- if LabelInfo.Visible then
- AttachedLabel.Visible := Visible;
-end;
-
-constructor TO32CustomControl.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- DefaultLabelPosition := lpTopLeft;
-
- FLabelInfo := TOvcLabelInfo.Create;
- FLabelInfo.OnChange := LabelChange;
- FLabelInfo.OnAttach := LabelAttach;
-end;
-
-procedure TO32CustomControl.CreateWnd;
-begin
- inherited CreateWnd;
-end;
-
-destructor TO32CustomControl.Destroy;
-begin
- FLabelInfo.Visible := False;
- FLabelInfo.Free;
- FLabelInfo := nil;
- inherited Destroy;
-end;
-
-procedure TO32CustomControl.DoOnMouseWheel(Shift : TShiftState;
- Delta, XPos, YPos : SmallInt);
-// Another TurboPower bug? Their TMouseWheelEvent expects Word
-// params, yet passing SmallInts here. Delta is negative when
-// scroll down, which will raise exception if a descendent class
-// with a TMouseWheelEvent handler has range checking turned on.
-// Note that their TMouseWheelEvent redefines LCL's.
-begin
- if Assigned(FOnMouseWheel) then
- FOnMouseWheel(Self, Shift, Delta, XPos, YPos);
-end;
-
-function TO32CustomControl.GetAttachedLabel : TOvcAttachedLabel;
-begin
- if not FLabelInfo.Visible then
- raise Exception.Create(GetOrphStr(SCLabelNotAttached));
-
- Result := FLabelInfo.ALabel;
-end;
-
-function TO32CustomControl.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-
-procedure TO32CustomControl.LabelAttach(Sender : TObject; Value : Boolean);
-var
-{$IFDEF VERSION5}
- PF : TWinControl;
-{$ELSE}
- PF : TForm;
-{$ENDIF}
- S : string;
-begin
- if (csLoading in ComponentState) then
- Exit;
-
-{$IFDEF VERSION5}
- PF := GetImmediateParentForm(Self);
-{$ELSE}
- PF := TForm(GetParentForm(Self));
-{$ENDIF}
- if Value then begin
- if Assigned(PF) then begin
- FLabelInfo.ALabel.Free;
- FLabelInfo.ALabel := TOvcAttachedLabel.CreateEx(PF, Self);
- FLabelInfo.ALabel.Parent := Parent;
-
- S := GenerateComponentName(PF, Name + 'Label');
- FLabelInfo.ALabel.Name := S;
- FLabelInfo.ALabel.Caption := S;
-
- FLabelInfo.SetOffsets(0, 0);
- PositionLabel;
- FLabelInfo.ALabel.BringToFront;
-
- {force auto size}
- FLabelInfo.ALabel.AutoSize := True;
- end;
- end else begin
- if Assigned(PF) then begin
- FLabelInfo.ALabel.Free;
- FLabelInfo.ALabel := nil;
- end;
- end;
-end;
-
-procedure TO32CustomControl.LabelChange(Sender : TObject);
-begin
- if not (csLoading in ComponentState) then
- PositionLabel;
-end;
-
-procedure TO32CustomControl.Notification(AComponent : TComponent; Operation : TOperation);
-var
-{$IFDEF VERSION5}
- PF : TWinControl;
-{$ELSE}
- PF : TForm;
-{$ENDIF}
-begin
- inherited Notification(AComponent, Operation);
-
- if Operation = opRemove then
- if Assigned(FLabelInfo) and (AComponent = FLabelInfo.ALabel) then begin
-{$IFDEF VERSION5}
- PF := GetImmediateParentForm(Self);
-{$ELSE}
- PF := TForm(GetParentForm(Self));
-{$ENDIF}
- if Assigned(PF) and not (csDestroying in PF.ComponentState) then begin
- FLabelInfo.FVisible := False;
- FLabelInfo.ALabel := nil;
- end;
- end;
-end;
-
-procedure TO32CustomControl.OMAfterEnter(var Msg : TMessage);
-begin
- if Assigned(FAfterEnter) then
- FAfterEnter(Self);
-end;
-
-procedure TO32CustomControl.OMAfterExit(var Msg : TMessage);
-begin
- if Assigned(FAfterExit) then
- FAfterExit(Self);
-end;
-
-procedure TO32CustomControl.OMAssignLabel(var Msg : TMessage);
-begin
- FLabelInfo.ALabel := TOvcAttachedLabel(Msg.lParam);
-end;
-
-procedure TO32CustomControl.OMPositionLabel(var Msg : TMessage);
-const
- DX : Integer = 0;
- DY : Integer = 0;
-begin
- if FLabelInfo.Visible and
- Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) and
- not (csLoading in ComponentState) then begin
- if DefaultLabelPosition = lpTopLeft then begin
- DX := FLabelInfo.ALabel.Left - Left;
- DY := FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top;
- end else begin
- DX := FLabelInfo.ALabel.Left - Left;
- DY := FLabelInfo.ALabel.Top - Top - Height;
- end;
- if (DX <> FLabelInfo.OffsetX) or (DY <> FLabelInfo.OffsetY) then
- PositionLabel;
- end;
-end;
-
-procedure TO32CustomControl.OMRecordLabelPosition(var Msg : TMessage);
-begin
- if Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) then begin
- {if the label was cut and then pasted, this will complete the re-attachment}
- FLabelInfo.FVisible := True;
-
- if DefaultLabelPosition = lpTopLeft then
- FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
- FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top)
- else
- FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
- FLabelInfo.ALabel.Top - Top - Height);
- end;
-end;
-
-procedure TO32CustomControl.PositionLabel;
-begin
- if FLabelInfo.Visible and Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) and
- not (csLoading in ComponentState) then begin
-
- if DefaultLabelPosition = lpTopLeft then begin
- FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
- FLabelInfo.OffsetY - FLabelInfo.ALabel.Height + Top,
- FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
- end else begin
- FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
- FLabelInfo.OffsetY + Top + Height,
- FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
- end;
- end;
-end;
-
-procedure TO32CustomControl.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
-begin
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-
- if HandleAllocated then
- PostMessage(Handle, OM_POSITIONLABEL, 0, 0);
-end;
-
-procedure TO32CustomControl.SetAbout(const Value : string);
-begin
-end;
-
-procedure TO32CustomControl.WMKillFocus(var Msg : TWMKillFocus);
-begin
- inherited;
-
- PostMessage(Handle, OM_AFTEREXIT, 0, 0);
-end;
-
-procedure TO32CustomControl.WMMouseWheel(var Msg : TMessage);
-// TurboPower bug: They should have used TWMMouseWheel instead of
-// TMessage. Delta is negative on scroll down, but extracting it
-// from wParam with HIWORD returns a Word, which causes an
-// exception when passed as SmallInt to DoOnMouseWheel when
-// range checking turned on. Fix is to cast delta as SmallInt.
-begin
- with Msg do
- DoOnMouseWheel(KeysToShiftState(LOWORD(wParam)) {fwKeys},
- SmallInt(HIWORD(wParam)) {zDelta}, //bug fix
- LOWORD(lParam) {xPos}, HIWORD(lParam) {yPos});
-end;
-
-procedure TO32CustomControl.WMSetFocus(var Msg : TWMSetFocus);
-begin
- inherited;
-
- PostMessage(Handle, OM_AFTERENTER, 0, 0);
-end;
-
-{*** End - TO32CustomCOntrol ***}
-
-
-{*** TOvcCustomControl ***}
-procedure TOvcCustomControl.CMVisibleChanged(var Msg : TMessage);
-begin
- inherited;
-
- if csLoading in ComponentState then
- Exit;
-
- if LabelInfo.Visible then
- AttachedLabel.Visible := Visible;
-end;
-
-constructor TOvcCustomControl.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- DefaultLabelPosition := lpTopLeft;
-
- FLabelInfo := TOvcLabelInfo.Create;
- FLabelInfo.OnChange := LabelChange;
- FLabelInfo.OnAttach := LabelAttach;
-end;
-
-procedure TOvcCustomControl.CreateWnd;
-begin
- inherited CreateWnd;
-end;
-
-destructor TOvcCustomControl.Destroy;
-begin
- FLabelInfo.Visible := False;
- FLabelInfo.Free;
- FLabelInfo := nil;
- FCollectionStreamer.Free;
- FCollectionStreamer := nil;
- inherited Destroy;
-end;
-
-procedure TOvcCustomControl.DoOnMouseWheel(Shift : TShiftState;
- Delta, XPos, YPos : SmallInt);
-begin
- if Assigned(FOnMouseWheel) then
- FOnMouseWheel(Self, Shift, Delta, XPos, YPos);
-end;
-
-function TOvcCustomControl.GetAttachedLabel : TOvcAttachedLabel;
-begin
- if not FLabelInfo.Visible then
- raise Exception.Create(GetOrphStr(SCLabelNotAttached));
-
- Result := FLabelInfo.ALabel;
-end;
-
-function TOvcCustomControl.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-
-procedure TOvcCustomControl.LabelAttach(Sender : TObject; Value : Boolean);
-var
-{$IFDEF VERSION5}
- PF : TWinControl;
-{$ELSE}
- PF : TForm;
-{$ENDIF}
- S : string;
-begin
- if (csLoading in ComponentState) then
- Exit;
-
-{$IFDEF VERSION5}
- PF := GetImmediateParentForm(Self);
-{$ELSE}
- PF := TForm(GetParentForm(Self));
-{$ENDIF}
- if Value then begin
- if Assigned(PF) then begin
- FLabelInfo.ALabel.Free;
- FLabelInfo.ALabel := TOvcAttachedLabel.CreateEx(PF, Self);
- FLabelInfo.ALabel.Parent := Parent;
-
- S := GenerateComponentName(PF, Name + 'Label');
- FLabelInfo.ALabel.Name := S;
- FLabelInfo.ALabel.Caption := S;
-
- FLabelInfo.SetOffsets(0, 0);
- PositionLabel;
- FLabelInfo.ALabel.BringToFront;
-
- {force auto size}
- FLabelInfo.ALabel.AutoSize := True;
- end;
- end else begin
- if Assigned(PF) then begin
- FLabelInfo.ALabel.Free;
- FLabelInfo.ALabel := nil;
- end;
- end;
-end;
-
-procedure TOvcCustomControl.LabelChange(Sender : TObject);
-begin
- if not (csLoading in ComponentState) then
- PositionLabel;
-end;
-
-procedure TOvcCustomControl.Notification(AComponent : TComponent; Operation : TOperation);
-var
-{$IFDEF VERSION5}
- PF : TWinControl;
-{$ELSE}
- PF : TForm;
-{$ENDIF}
-begin
- inherited Notification(AComponent, Operation);
-
- if Operation = opRemove then
- if Assigned(FLabelInfo) and (AComponent = FLabelInfo.ALabel) then begin
-{$IFDEF VERSION5}
- PF := GetImmediateParentForm(Self);
-{$ELSE}
- PF := TForm(GetParentForm(Self));
-{$ENDIF}
- if Assigned(PF) and not (csDestroying in PF.ComponentState) then begin
- FLabelInfo.FVisible := False;
- FLabelInfo.ALabel := nil;
- end;
- end;
-end;
-
-procedure TOvcCustomControl.OMAfterEnter(var Msg : TMessage);
-begin
- if Assigned(FAfterEnter) then
- FAfterEnter(Self);
-end;
-
-procedure TOvcCustomControl.OMAfterExit(var Msg : TMessage);
-begin
- if Assigned(FAfterExit) then
- FAfterExit(Self);
-end;
-
-procedure TOvcCustomControl.OMAssignLabel(var Msg : TMessage);
-begin
- FLabelInfo.ALabel := TOvcAttachedLabel(Msg.lParam);
-end;
-
-procedure TOvcCustomControl.OMPositionLabel(var Msg : TMessage);
-const
- DX : Integer = 0;
- DY : Integer = 0;
-begin
- if FLabelInfo.Visible and
- Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) and
- not (csLoading in ComponentState) then begin
- if DefaultLabelPosition = lpTopLeft then begin
- DX := FLabelInfo.ALabel.Left - Left;
- DY := FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top;
- end else begin
- DX := FLabelInfo.ALabel.Left - Left;
- DY := FLabelInfo.ALabel.Top - Top - Height;
- end;
- if (DX <> FLabelInfo.OffsetX) or (DY <> FLabelInfo.OffsetY) then
- PositionLabel;
- end;
-end;
-
-procedure TOvcCustomControl.OMRecordLabelPosition(var Msg : TMessage);
-begin
- if Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) then begin
- {if the label was cut and then pasted, this will complete the re-attachment}
- FLabelInfo.FVisible := True;
-
- if DefaultLabelPosition = lpTopLeft then
- FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
- FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top)
- else
- FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
- FLabelInfo.ALabel.Top - Top - Height);
- end;
-end;
-
-procedure TOvcCustomControl.PositionLabel;
-begin
- if FLabelInfo.Visible and Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) and
- not (csLoading in ComponentState) then begin
-
- if DefaultLabelPosition = lpTopLeft then begin
- FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
- FLabelInfo.OffsetY - FLabelInfo.ALabel.Height + Top,
- FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
- end else begin
- FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
- FLabelInfo.OffsetY + Top + Height,
- FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
- end;
- end;
-end;
-
-procedure TOvcCustomControl.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
-begin
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-
- if HandleAllocated then
- PostMessage(Handle, OM_POSITIONLABEL, 0, 0);
-end;
-
-procedure TOvcCustomControl.SetAbout(const Value : string);
-begin
-end;
-
-procedure TOvcCustomControl.WMKillFocus(var Msg : TWMKillFocus);
-begin
- inherited;
-
- PostMessage(Handle, OM_AFTEREXIT, 0, 0);
-end;
-
-procedure TOvcCustomControl.WMMouseWheel(var Msg : TMessage);
-// See TurboPower bug comments above.
-begin
- with Msg do
- DoOnMouseWheel(KeysToShiftState(LOWORD(wParam)) {fwKeys},
- SmallInt(HIWORD(wParam)) {zDelta}, //bug fix
- LOWORD(lParam) {xPos}, HIWORD(lParam) {yPos});
-end;
-
-procedure TOvcCustomControl.WMSetFocus(var Msg : TWMSetFocus);
-begin
- inherited;
-
- PostMessage(Handle, OM_AFTERENTER, 0, 0);
-end;
-
-
-{Logic for streaming collections of sub-components}
-
-function TOvcCustomControl.GetChildOwner: TComponent;
-begin
- if Assigned(FCollectionStreamer) then
- Result := FCollectionStreamer.Owner
- else
- Result := inherited GetChildOwner;
-end;
-
-procedure TOvcCustomControl.GetChildren(Proc: TGetChildProc; Root : TComponent);
-begin
- if Assigned(FCollectionStreamer) then
- CollectionStreamer.GetChildren(Proc, Root)
- else
- inherited GetChildren(Proc, Root);
-end;
-
-procedure TOvcCustomControl.Loaded;
-begin
- if Assigned(FCollectionStreamer) then
- FCollectionStreamer.Loaded;
- inherited Loaded;
-end;
-
-{*** TOvcCustomControlEx ***}
-
-function TOvcCustomControlEx.ControllerAssigned : Boolean;
-begin
- Result := Assigned(FController);
-end;
-
-procedure TOvcCustomControlEx.CreateWnd;
-var
- OurForm : TWinControl;
-
-begin
- OurForm := GetImmediateParentForm(Self);
-
- {do this only when the component is first dropped on the form, not during loading}
- if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
- ResolveController(OurForm, FController);
-
- if not Assigned(FController) and not (csLoading in ComponentState) then begin
- {try to find a controller on this form that we can use}
- FController := FindController(OurForm);
-
- {if not found and we are not designing, use default controller}
- if not Assigned(FController) and not (csDesigning in ComponentState) then
- FController := DefaultController;
- end;
-
- inherited CreateWnd;
-end;
-
-function TOvcCustomControlEx.GetController: TOvcController;
-begin
- if FController = nil then
- Result := DefaultController
- else
- Result := FController;
-end;
-
-procedure TOvcCustomControlEx.Notification(AComponent : TComponent; Operation : TOperation);
-begin
- inherited Notification(AComponent, Operation);
-
- if Operation = opRemove then begin
- if (AComponent = FController) then
- FController := nil;
- end else if (Operation = opInsert) and (FController = nil) and
- (AComponent is TOvcController) then
- FController := TOvcController(AComponent);
-end;
-
-procedure TOvcCustomControlEx.SetController(Value : TOvcController);
-begin
- if not (TObject(Value) is TOvcController) then
- Value := nil;
- FController := Value;
- if Value <> nil then
- Value.FreeNotification(Self);
-end;
-
-function TOvcCollection.Add : TComponent;
-begin
- if not Assigned(FItemClass) then
- raise Exception.Create(GetOrphStr(SCClassNotSet));
- Result := FItemClass.Create(Owner);
- Changed;
- if ItemEditor <> nil then
- SendMessage(ItemEditor.Handle, OM_PROPCHANGE, 0, 0);
-end;
-
-procedure TOvcCollection.Changed;
-var
- Parent : TForm;
-begin
- {$IFDEF Logging}
- LogMsg('TOvcCollection.Changed');
- LogBoolean('InChanged', InChanged);
- {$ENDIF}
- if InChanged then exit;
- InChanged := True;
- try
- Parent := ParentForm;
- if Parent <> nil then begin
- {$IFDEF Logging}
- LogString('Parent.ClassName', Parent.ClassName);
- LogBoolean('(csLoading in Parent.ComponentState)', (csLoading in Parent.ComponentState));
- {$ENDIF}
- if not (csLoading in Parent.ComponentState)
- and (csDesigning in Parent.ComponentState) then begin
- {$IFDEF Logging}
- LogBoolean('TForm(Parent).Designer <> nil', TForm(Parent).Designer <> nil);
- LogBoolean('InLoaded', InLoaded);
- LogBoolean('IsLoaded', IsLoaded);
- LogBoolean('(csAncestor in Owner.ComponentState)', (csAncestor in Owner.ComponentState));
- LogBoolean('Stored', Stored);
- {$ENDIF}
- {$IFDEF VERSION5}
- if (TForm(Parent).Designer <> nil)
- {$ELSE}
- if (Parent.Designer <> nil)
- {$ENDIF}
- and not InLoaded
- and IsLoaded
- and not (csAncestor in Owner.ComponentState)
- and Stored then
- {$IFDEF VERSION5}
- TForm(Parent).Designer.Modified;
- {$ELSE}
- Parent.Designer.Modified;
- {$ENDIF}
- if (ItemEditor <> nil)
- and not (csAncestor in Owner.ComponentState)
- then
- SendMessage(ItemEditor.Handle, OM_PROPCHANGE, 0, 0);
- end;
- if Assigned(FOnChanged) then
- FOnChanged(Self);
- end;
- finally
- InChanged := False;
- end;
-end;
-
-procedure TOvcCollection.Clear;
-{$IFDEF Version5}
-var
- i : Integer;
-{$ENDIF}
-begin
- {$IFDEF Version5}
- for i := Count - 1 downto 0 do
- if not (csAncestor in Item[i].ComponentState) then
- Item[i].Free;
- {$ELSE}
- while Count > 0 do
- Item[0].Free;
- {$ENDIF}
- if ItemEditor <> nil then
- SendMessage(ItemEditor.Handle, OM_PROPCHANGE, 0, 0);
-end;
-
-constructor TOvcCollection.Create(AOwner : TComponent;
- ItemClass : TOvcCollectibleClass);
-begin
- inherited Create;
- FStored := True;
- FItemClass := ItemClass;
- FItems := TList.Create;
- FOwner := AOwner;
-
- if (AOwner is TOvcComponent) then
- begin
- if TOvcComponent(AOwner).CollectionStreamer = nil then
- TOvcComponent(AOwner).CollectionStreamer := TOvcCollectionStreamer.Create(AOwner);
- FStreamer := TOvcComponent(AOwner).CollectionStreamer;
- FStreamer.FCollectionList.Add(Self);
- end
- else
- if (AOwner is TOvcCustomControl) then
- begin
- if TOvcCustomControl(AOwner).CollectionStreamer = nil then
- TOvcCustomControl(AOwner).CollectionStreamer := TOvcCollectionStreamer.Create(AOwner);
- FStreamer := TOvcCustomControl(AOwner).CollectionStreamer;
- FStreamer.FCollectionList.Add(Self);
- end
- else
- raise Exception.Create(GetOrphStr(SCNotOvcDescendant));
-end;
-
-procedure TOvcCollection.Delete(Index : Integer);
-begin
- if (Index > -1) and (Index < Count) then
- Item[Index].Free;
- Changed;
-end;
-
-destructor TOvcCollection.Destroy;
-begin
- ItemEditor.Free;
- if (Owner is TOvcComponent) then
- TOvcComponent(Owner).CollectionStreamer.FCollectionList.Remove(Self)
- else
- TOvcCustomControl(Owner).CollectionStreamer.FCollectionList.Remove(Self);
- Clear;
- FItems.Free;
- inherited Destroy;
-end;
-
-procedure TOvcCollection.DoOnItemSelected(Index : Integer);
-begin
- if Assigned(FOnItemSelected) then
- FOnItemSelected(Self, Index);
-end;
-
-function TOvcCollection.GetCount : Integer;
-begin
- Result := FItems.Count;
-end;
-
-function TOvcCollection.GetEditorCaption : string;
-begin
- Result := 'Editing ' + ClassName;
- if Assigned(FOnGetEditorCaption) then
- FOnGetEditorCaption(Result);
-end;
-
-function TOvcCollection.GetItem(Index : Integer) : TComponent;
-begin
- Result := TComponent(FItems[Index]);
-end;
-
-function TOvcCollection.Insert(Index : Integer) : TComponent;
-begin
- if (Index < 0) or (Index > Count) then
- Index := Count;
- Result := Add;
- if Result is TOvcCollectible then
- TOvcCollectible(Item[Count-1]).Index := Index
- else
- if Result is TOvcCollectibleControl then
- TOvcCollectibleControl(Item[Count-1]).Index := Index
- else
- Result := nil;
-end;
-
-function TOvcCollection.ItemByName(const Name : string) : TComponent;
-var
- i : Integer;
-begin
- for i := 0 to pred(Count) do
- if Item[i].Name = Name then begin
- Result := Item[i];
- exit;
- end;
- Result := nil;
-end;
-
-procedure TOvcCollection.Loaded;
-begin
- InLoaded := True;
- try
- Changed;
- finally
- InLoaded := False;
- end;
- IsLoaded := True;
-end;
-
-function TOvcCollection.ParentForm : TForm;
-var
- Temp : TObject;
-begin
- Temp := Owner;
- while (Temp <> nil) and not (Temp is TForm) do
- Temp := TComponent(Temp).Owner;
- Result := TForm(Temp);
-end;
-
-procedure TOvcCollection.SetItem(Index : Integer; Value : TComponent);
-begin
- TOvcCollectible(FItems[Index]).Assign(Value);
-end;
-
-procedure TOvcCollectionStreamer.Clear;
-var
- I : Integer;
-begin
- for I := 0 to pred(FCollectionList.Count) do
- TOvcCollection(FCollectionList[I]).Clear;
-end;
-
-
-{===== TO32Collection ================================================}
-
-constructor TO32Collection.Create(AOwner : TPersistent;
- ItemClass : TCollectionItemClass);
-begin
- FOwner := AOwner;
- Inherited Create(ItemClass);
-end;
-
-destructor TO32Collection.Destroy;
-begin
- ItemEditor.Free;
- Clear;
- inherited Destroy;
-end;
-
-procedure TO32Collection.DoOnItemSelected(Index : Integer);
-begin
- if Assigned(FOnItemSelected) then
- FOnItemSelected(Self, Index);
-end;
-
-function TO32Collection.GetCount : Integer;
-begin
- Result := inherited Count;
-end;
-
-function TO32Collection.GetEditorCaption : string;
-begin
- Result := 'Editing ' + ClassName;
- if Assigned(FOnGetEditorCaption) then
- FOnGetEditorCaption(Result);
-end;
-
-function TO32Collection.Add : TO32CollectionItem;
-begin
- Result := TO32CollectionItem(inherited Add);
- if ItemEditor <> nil then
- SendMessage(ItemEditor.Handle, OM_PROPCHANGE, 0, 0);
-end;
-
-{$IFNDEF VERSION4}
-function TO32Collection.Insert(Index: Integer): TO32CollectionItem;
-var
- I: Integer;
-begin
- result := Add;
- for I := Index to Count - 2 do
- Items[I].Index := I + 1;
- Items[Count - 1].Index := Index;
-end;
-{$ENDIF}
-
-function TO32Collection.GetItem(Index : Integer) : TO32CollectionItem;
-begin
- Result := TO32CollectionItem(inherited GetItem(Index));
-end;
-
-function TO32Collection.GetOwner: TPersistent;
-begin
- result := FOwner;
-end;
-
-procedure TO32Collection.SetItem(Index : Integer; Value : TO32CollectionItem);
-begin
- inherited SetItem(Index, Value);
-end;
-
-function TO32Collection.ItemByName(const Name : string) : TO32CollectionItem;
-var
- i : Integer;
-begin
- for i := 0 to pred(Count) do
- if Item[i].Name = Name then begin
- Result := Item[i];
- exit;
- end;
- Result := nil;
-end;
-
-procedure TO32Collection.Loaded;
-begin
- InLoaded := True;
- try
- Changed;
- finally
- InLoaded := False;
- end;
- IsLoaded := True;
-end;
-
-function TO32Collection.ParentForm : TForm;
-var
- Temp : TObject;
-begin
- Temp := GetOwner;
- while (Temp <> nil) and not (Temp is TForm) do
- Temp := TComponent(Temp).Owner;
- Result := TForm(Temp);
-end;
-
-{End - TO32Collection }
-
-{===== TOvcCollectionStreamer ========================================}
-function TOvcCollectionStreamer.CollectionFromType(Component : TComponent) : TOvcCollection;
-var
- I : Integer;
-begin
- for I := 0 to pred(FCollectionList.Count) do
- if Component is TOvcCollection(FCollectionList[I]).ItemClass then begin
- Result := TOvcCollection(FCollectionList[I]);
- exit;
- end;
- raise Exception.Create(GetOrphStr(SCCollectionNotFound));
-end;
-
-constructor TOvcCollectionStreamer.Create(AOwner : TComponent);
-begin
- inherited Create;
-
- FOwner := AOwner;
- FCollectionList := TList.Create;
-end;
-
-destructor TOvcCollectionStreamer.Destroy;
-begin
- FCollectionList.Free;
- FCollectionList := nil;
-
- inherited Destroy;
-end;
-
-procedure TOvcCollectionStreamer.GetChildren(Proc: TGetChildProc; Root : TComponent);
-var
- I,J: Integer;
-begin
- for I := 0 to pred(FCollectionList.Count) do
- with TOvcCollection(FCollectionList[I]) do
- if Stored then
- for J := 0 to Count - 1 do
- Proc(Item[J]);
-end;
-
-procedure TOvcCollectionStreamer.Loaded;
-var
- I : Integer;
-begin
- for I := 0 to pred(FCollectionList.Count) do
- TOvcCollection(FCollectionList[I]).Loaded;
-end;
-
-function DefaultController : TOvcController;
-begin
- if FDefaultController = nil then
- FDefaultController := TOvcController.Create(nil);
- Result := FDefaultController;
-end;
-
-initialization
- {register the attached label class}
- if Classes.GetClass(TOvcAttachedLabel.ClassName) = nil then
- Classes.RegisterClass(TOvcAttachedLabel);
-{$IFDEF LCL}
- {$I ovcbase.lrs}
-{$ENDIF}
-finalization
- FDefaultController.Free;
- FDefaultController := nil;
-end.
diff --git a/Source/3rdParty/Orpheus/ovcbcalc.pas b/Source/3rdParty/Orpheus/ovcbcalc.pas
deleted file mode 100644
index 473e5883..00000000
--- a/Source/3rdParty/Orpheus/ovcbcalc.pas
+++ /dev/null
@@ -1,1510 +0,0 @@
-{*********************************************************}
-{* OVCBCALC.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}
-
-{$J+} {Writable constants}
-
-
-unit ovcbcalc;
- {-base edit field class w/ label and borders}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Buttons, Classes, Controls, ExtCtrls, Forms, Graphics, Menus,
- {$IFDEF VERSION4}{$IFNDEF LCL} MultiMon, {$ENDIF}{$ENDIF}
- StdCtrls, SysUtils, OvcBase, OvcVer, OvcMisc,
- OvcEditF, OvcBordr, OvcEdClc, ovcCalc, ovcEdPop;
-
-const
- BorderMsgClose = WM_USER+10;
- BorderMsgOpen = WM_USER+11;
-
-type
- TOvcPopupEvent =
- procedure(Sender : TObject) of object;
-
- TOvcPopupAnchor = (paLeft, paRight);
-
-
- TOvcBorderEdPopup = class;
-
- TOvcNumberEditEx = class(TOvcNumberEdit)
- protected
- BorderParent : TOvcBorderEdPopup;
- end;
-
- TOvcBorderEdPopup = class(TOvcBorderParent)
- protected {private}
- {new property variables}
- FEdit : TOvcCustomEdit;
- FButton : TOvcEdButton;
-
- FButtonGlyph : TBitmap;
- FController : TOvcController;
- FPopupActive : Boolean;
- FPopupAnchor : TOvcPopupAnchor;
- FOnPopupClose : TOvcPopupEvent;
- FOnPopupOpen : TOvcPopupEvent;
- FShowButton : Boolean;
-
-
- protected
- {property methods}
- function GetButtonGlyph : TBitmap;
-
- procedure SetButtonGlyph(Value : TBitmap);
- procedure SetShowButton(Value : Boolean);
-
- {internal methods}
- function GetButtonWidth : Integer;
-
-{$IFDEF VERSION4}
- procedure CMDialogKey(var Msg : TCMDialogKey);
- message CM_DIALOGKEY;
-{$ENDIF}
-
- procedure CreateParams(var Params : TCreateParams);
- override;
- procedure CreateWnd;
- override;
-
- function GetButtonEnabled : Boolean;
- dynamic;
- procedure GlyphChanged;
- dynamic;
- procedure Loaded;
- override;
-
- procedure OnMsgClose(var M : TMessage);
- message BorderMsgClose;
- procedure OnMsgOpen(var M : TMessage);
- message BorderMsgOpen;
-
- public
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
-
- procedure PopupClose(Sender : TObject);
- dynamic;
- procedure PopupOpen;
- dynamic;
-
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
- override;
-
- procedure SetEditControl(EC : TOvcCustomEdit); override;
-
- property Canvas;
-
- property PopupActive : Boolean
- read FPopupActive;
-
- property PopupAnchor : TOvcPopupAnchor
- read FPopupAnchor
- write FPopupAnchor;
-
- published
- property ButtonGlyph : TBitmap
- read GetButtonGlyph
- write SetButtonGlyph;
- end;
-
-
- TOvcBorderedNumberEdit = class(TOvcBorderEdPopup)
- protected
- {base property values}
- FOvcEdit : TOvcNumberEditEx;
-
- {$IFDEF VERSION4}
-{$IFNDEF LCL}
- FBiDiMode : TBiDiMode;
-{$ENDIF}
- FConstraints : TSizeConstraints;
- FParentBiDiMode: Boolean;
- FDragKind : TDragKind;
- {$ENDIF}
- FAbout : string;
-{$IFNDEF LCL}
- FAutoSelect : Boolean;
-{$ENDIF}
- FAutoSize : Boolean;
- FBorderStyle : TBorderStyle;
- FCharCase : TEditCharCase;
- FController : TOvcController;
- FCursor : TCursor;
- FDragCursor : TCursor;
- FDragMode : TDragMode;
- FEnabled : Boolean;
- FFont : TFont;
- FHeight : integer;
-{$IFNDEF LCL}
- FHideSelection : Boolean;
- FImeMode : TImeMode;
-{$ENDIF}
- FImeName : string;
- FMaxLength : Integer;
-{$IFNDEF LCL}
- FOEMConvert : Boolean;
-{$ENDIF}
- FParentFont : Boolean;
- FParentShowHint: Boolean;
- FPasswordChar : Char;
- FPopupMenu : TPopupMenu;
- FReadOnly : Boolean;
- FShowHint : Boolean;
- FTabOrder : TTabOrder;
- FVisible : Boolean;
- FWidth : integer;
-
- {events}
- FOnChange : TNotifyEvent;
- FOnClick : TNotifyEvent;
- FOnDblClick : TNotifyEvent;
- FOnDragDrop : TDragDropEvent;
- FOnDragOver : TDragOverEvent;
-
- FOnEndDrag : TEndDragEvent;
- FOnEnter : TNotifyEvent;
- FOnExit : TNotifyEvent;
- FOnKeyDown : TKeyEvent;
- FOnKeyPress : TKeyPressEvent;
- FOnKeyUp : TKeyEvent;
- FOnMouseDown : TMouseEvent;
- FOnMouseMove : TMouseMoveEvent;
- FOnMouseUp : TMouseEvent;
- FOnStartDrag : TStartDragEvent;
-
-
- FAllowIncDec : Boolean;
- FCalculator : TOvcCalculator;
-
- {internal variables}
- PopupClosing : Boolean;
- HoldCursor : TCursor;
- WasAutoScroll : Boolean;
-
- {base property methods}
- {$IFDEF VERSION4}
- {$IFNDEF LCL}
- function GetBiDiMode : TBiDiMode;
- {$ENDIF}
- function GetDragKind : TDragKind;
- {$IFNDEF LCL}
- function GetParentBiDiMode : Boolean;
- {$ENDIF}
-
-{$IFNDEF LCL}
- procedure SetBiDiMode(Value : TBiDiMode); override;
-{$ENDIF}
- procedure SetDragKind(Value : TDragKind);
-{$IFNDEF LCL}
- procedure SetParentBiDiMode(Value : Boolean); override;
-{$ENDIF}
- {$ENDIF}
-
- function GetAbout : string;
-{$IFNDEF LCL}
- function GetAutoSelect : Boolean;
-{$ENDIF}
- function GetAutoSize : Boolean;
- function GetCharCase : TEditCharCase;
- function GetController : TOvcController;
- function GetCursor : TCursor;
- function GetDragCursor : TCursor;
- function GetDragMode : TDragMode;
- function GetEditEnabled : Boolean;
- function GetFont : TFont;
-{$IFNDEF LCL}
- function GetHideSelection : Boolean;
- function GetImeMode : TImeMode;
- function GetImeName : string;
-{$ENDIF}
- function GetMaxLength : Integer;
-{$IFNDEF LCL}
- function GetOEMConvert : Boolean;
-{$ENDIF}
- function GetParentShowHint : Boolean;
- function GetPasswordChar : Char;
- function GetReadOnly : Boolean;
- function GetEditShowButton : Boolean;
-
- function GetParentFont : Boolean;
- function GetEditParentShowHint : Boolean;
-
- function GetOnChange : TNotifyEvent;
- function GetOnClick : TNotifyEvent;
- function GetOnDblClick : TNotifyEvent;
- function GetOnDragDrop : TDragDropEvent;
- function GetOnDragOver : TDragOverEvent;
- function GetOnEndDrag : TEndDragEvent;
- function GetOnKeyDown : TKeyEvent;
- function GetOnKeyPress : TKeyPressEvent;
- function GetOnKeyUp : TKeyEvent;
- function GetOnMouseDown: TMouseEvent;
- function GetOnMouseMove: TMouseMoveEvent;
- function GetOnMouseUp : TMouseEvent;
-
- function GetOnPopupClose : TOvcPopupEvent;
- function GetOnPopupOpen : TOvcPopupEvent;
- function GetPopupAnchor : TOvcPopupAnchor;
-
- procedure SetAbout(const Value : string);
-{$IFNDEF LCL}
- procedure SetAutoSelect(Value : Boolean);
-{$ENDIF}
- procedure SetAutoSize(Value : Boolean); {$IFDEF VERSION6}{$IFNDEF LCL} override;{$ENDIF}{$ENDIF}
- procedure SetCharCase(Value : TEditCharCase);
- procedure SetCursor(Value : TCursor);
- procedure SetDragCursor(Value : TCursor);
- procedure SetEditController(Value : TOvcController);
- procedure SetEditDragMode(Value : TDragMode);
- procedure SetEditEnabled(Value : Boolean);
- procedure SetFont(Value : TFont);
-{$IFNDEF LCL}
- procedure SetHideSelection(Value : Boolean);
- procedure SetImeMode(Value : TImeMode);
- procedure SetImeName(const Value : string);
-{$ENDIF}
- procedure SetMaxLength(Value : Integer);
-{$IFNDEF LCL}
- procedure SetOEMConvert(Value : Boolean);
-{$ENDIF}
- procedure SetParentShowHint(Value : Boolean);
- procedure SetPasswordChar(Value : Char);
- procedure SetReadOnly(Value : Boolean);
- procedure SetEditShowButton(Value : Boolean);
-
- procedure SetOnChange(Value : TNotifyEvent);
- procedure SetOnClick(Value : TNotifyEvent);
- procedure SetOnDblClick(Value : TNotifyEvent);
- procedure SetOnDragDrop(Value : TDragDropEvent);
- procedure SetOnDragOver(Value : TDragOverEvent);
- procedure SetOnEndDrag(Value : TEndDragEvent);
- procedure SetOnKeyDown(Value : TKeyEvent);
- procedure SetOnKeyPress(Value : TKeyPressEvent);
- procedure SetOnKeyUp(Value : TKeyEvent);
- procedure SetOnMouseDown(Value : TMouseEvent);
- procedure SetOnMouseMove(Value : TMouseMoveEvent);
- procedure SetOnMouseUp(Value : TMouseEvent);
-
- procedure SetOnPopupClose(Value : TOvcPopupEvent);
- procedure SetOnPopupOpen(Value : TOvcPopupEvent);
- procedure SetPopupAnchor(Value : TOvcPopupAnchor);
-
-
- {property methods}
- function GetAsFloat : Double;
- function GetAsInteger : LongInt;
- function GetAsString : string;
- function GetPopupColors : TOvcCalcColors;
- function GetPopupDecimals : Integer;
- function GetPopupFont : TFont;
- function GetPopupHeight : Integer;
- function GetPopupWidth : Integer;
- procedure SetAsFloat(Value : Double);
- procedure SetAsInteger(Value : LongInt);
- procedure SetAsString(const Value : string);
- procedure SetPopupColors(Value : TOvcCalcColors);
- procedure SetPopupDecimals(Value : Integer);
- procedure SetPopupFont(Value : TFont);
- procedure SetPopupHeight(Value : Integer);
- procedure SetPopupWidth(Value : Integer);
-
- procedure SetParentFont(Value : Boolean);
- procedure SetEditParentShowHint(Value : Boolean);
-
- protected
- procedure GlyphChanged;
- override;
-
- public
- constructor Create(AOwner : TComponent);
- override;
-
- destructor Destroy; override;
-
- property AsInteger : LongInt
- read GetAsInteger
- write SetAsInteger;
-
- property AsFloat : Double
- read GetAsFloat
- write SetAsFloat;
-
- property AsString : string
- read GetAsString
- write SetAsString;
-
- property Calculator : TOvcCalculator
- read FCalculator;
-
- property EditControl : TOvcNumberEditEx
- read FOvcEdit;
-
-
- published
- {$IFDEF VERSION4}
- property Anchors;
-
-{$IFNDEF LCL}
- property BiDiMode : TBiDiMode
- read GetBiDiMode
- write SetBiDiMode;
-{$ENDIF}
-
- property Constraints;
-
-{$IFNDEF LCL}
- property ParentBiDiMode : Boolean
- read GetParentBiDiMode
- write SetParentBiDiMode;
-{$ENDIF}
-
- property DragKind : TDragKind
- read GetDragKind
- write SetDragKind;
- {$ENDIF}
-
- property About : string
- read GetAbout
- write SetAbout;
-
- property AllowIncDec : Boolean
- read FAllowIncDec
- write FAllowIncDec;
-
-{$IFNDEF LCL}
- property AutoSelect : Boolean
- read GetAutoSelect
- write SetAutoSelect;
-{$ENDIF}
-
- property AutoSize : Boolean
- read GetAutoSize
- write SetAutoSize;
-
- property CharCase : TEditCharCase
- read GetCharCase
- write SetCharCase;
-
- property Controller : TOvcController
- read GetController
- write SetEditController;
-
- property Cursor : TCursor
- read GetCursor
- write SetCursor;
-
- property DragCursor : TCursor
- read GetDragCursor
- write SetDragCursor;
-
- {$IFDEF VERSION4}
- property DragMode : TDragMode
- read GetDragMode
- write SetDragMode;
- {$ENDIF}
-
- property Enabled : Boolean
- read FEnabled
- write FEnabled;
-
- property Font : TFont
- read GetFont
- write SetFont;
-
-{$IFNDEF LCL}
- property HideSelection : Boolean
- read GetHideSelection
- write SetHideSelection;
-
- property ImeMode : TImeMode
- read GetImeMode
- write SetImeMode;
-
- property ImeName;
-{$ENDIF}
-
- property MaxLength : integer
- read GetMaxLength
- write SetMaxLength;
-
-{$IFNDEF LCL}
- property OEMConvert : Boolean
- read GetOEMConvert
- write SetOEMConvert;
-{$ENDIF}
-
- property ParentFont : Boolean
- read GetParentFont
- write SetParentFont;
-
- property ParentShowHint : Boolean
- read GetParentShowHint
- write SetParentShowHint;
-
- property PasswordChar : Char
- read GetPasswordChar
- write SetPasswordChar;
-
- property PopupAnchor : TOvcPopupAnchor
- read GetPopupAnchor
- write SetPopupAnchor;
-
- property PopupColors : TOvcCalcColors
- read GetPopupColors
- write SetPopupColors;
-
- property PopupDecimals : Integer
- read GetPopupDecimals
- write SetPopupDecimals;
-
- property PopupFont : TFont
- read GetPopupFont
- write SetPopupFont;
-
- property PopupHeight : Integer
- read GetPopupHeight
- write SetPopupHeight;
-
- property PopupMenu;
-
- property PopupWidth : Integer
- read GetPopupWidth
- write SetPopupWidth;
-
- property ReadOnly : Boolean
- read GetReadOnly
- write SetReadOnly;
-
- property ShowButton : Boolean
- read GetEditShowButton
- write SetEditShowButton;
-
- property ShowHint;
- property TabOrder;
- property TabStop;
- property Visible;
-
- {events}
- property OnChange : TNotifyEvent
- read GetOnChange
- write SetOnChange;
-
- property OnClick : TNotifyEvent
- read GetOnClick
- write SetOnClick;
-
- property OnDblClick : TNotifyEvent
- read GetOnDblClick
- write SetOnDblClick;
-
- property OnDragDrop : TDragDropEvent
- read GetOnDragDrop
- write SetOnDragDrop;
-
- property OnDragOver : TDragOverEvent
- read GetOnDragOver
- write SetOnDragOver;
-
- property OnEndDrag : TEndDragEvent
- read GetOnEndDrag
- write SetOnEndDrag;
-
- property OnEnter;
- property OnExit;
-
- property OnKeyDown : TKeyEvent
- read GetOnKeyDown
- write SetOnKeyDown;
-
- property OnKeyPress : TKeyPressEvent
- read GetOnKeyPress
- write SetOnKeyPress;
-
- property OnKeyUp : TKeyEvent
- read GetOnKeyUp
- write SetOnKeyUp;
-
- property OnMouseDown : TMouseEvent
- read GetOnMouseDown
- write SetOnMouseDown;
-
- property OnMouseMove : TMouseMoveEvent
- read GetOnMouseMove
- write SetOnMouseMove;
-
- property OnMouseUp : TMouseEvent
- read GetOnMouseUp
- write SetOnMouseUp;
- property OnStartDrag;
-
- property OnPopupClose : TOvcPopupEvent
- read GetOnPopupClose
- write SetOnPopupClose;
-
- property OnPopupOpen : TOvcPopupEvent
- read GetOnPopupOpen
- write SetOnPopupOpen;
- end;
-
-
-implementation
-
-constructor TOvcBorderEdPopup.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- ControlStyle := ControlStyle - [csSetCaption];
-
- ButtonWidth := ButtonGlyph.Width;
- DoShowButton := FShowButton;
-end;
-
-
-procedure TOvcBorderEdPopup.CreateParams(var Params : TCreateParams);
-begin
- inherited CreateParams(Params);
-
- Params.Style := Params.Style or WS_CLIPCHILDREN;
-end;
-
-procedure TOvcBorderEdPopup.CreateWnd;
-begin
- inherited CreateWnd;
-
- {force button placement}
- SetBounds(Left, Top, Width, Height);
-
- if (Assigned(FButton)) then
- FButton.Enabled := GetButtonEnabled;
-end;
-
-destructor TOvcBorderEdPopup.Destroy;
-begin
- { Freeing the button glyph throws access violation for some reason }
- { we'll just let it leak for now. }
-// if FButtonGlyph <> nil then
-// FButtonGlyph.Free;
- inherited Destroy;
-end;
-
-
-
-function TOvcBorderEdPopup.GetButtonEnabled : Boolean;
-begin
- Result := not TOvcEdit(FEdit).ReadOnly;
-end;
-
-
-function TOvcBorderEdPopup.GetButtonWidth : Integer;
-begin
- if FShowButton then begin
- Result := GetSystemMetrics(SM_CXHSCROLL);
- if Assigned(FButtonGlyph) and not FButtonGlyph.Empty then
- if FButtonGlyph.Width + 4 > Result then
- Result := FButtonGlyph.Width + 4;
- end else
- Result := 0;
-end;
-
-function TOvcBorderEdPopup.GetButtonGlyph : TBitmap;
-begin
- if not Assigned(FButtonGlyph) then
- FButtonGlyph := TBitmap.Create;
-
- Result := FButtonGlyph
-end;
-
-procedure TOvcBorderEdPopup.GlyphChanged;
-begin
-end;
-
-procedure TOvcBorderEdPopup.Loaded;
-begin
- inherited Loaded;
-
- if Assigned(FButtonGlyph) then
- FButton.Glyph.Assign(FButtonGlyph);
-end;
-
-
-procedure TOvcBorderEdPopup.OnMsgClose(var M : TMessage);
-begin
- if (Assigned(FOnPopupClose)) then
- FOnPopupClose(Self);
-end;
-
-procedure TOvcBorderEdPopup.OnMsgOpen(var M : TMessage);
-begin
- if (Assigned(FOnPopupOpen)) then
- FOnPopupOpen(Self);
-end;
-
-
-procedure TOvcBorderEdPopup.PopupClose;
-begin
- FPopupActive := False;
- PostMessage(Handle, BorderMsgClose, 0, 0);
-end;
-
-procedure TOvcBorderEdPopup.PopupOpen;
-begin
- FPopupActive := True;
- PostMessage(Handle, BorderMsgOpen, 0, 0);
-end;
-
-
-procedure TOvcBorderEdPopup.SetEditControl(EC : TOvcCustomEdit);
-begin
- inherited SetEditControl(EC);
- FEdit := EC;
-end;
-
-procedure TOvcBorderEdPopup.SetButtonGlyph(Value : TBitmap);
-begin
- if not Assigned(FButtonGlyph) then
- FButtonGlyph := TBitmap.Create;
-
- if not Assigned(Value) then begin
- FButtonGlyph.Free;
- FButtonGlyph := TBitmap.Create;
- end else
- FButtonGlyph.Assign(Value);
-
- GlyphChanged;
-
- FButton.Glyph.Assign(FButtonGlyph);
- SetBounds(Left, Top, Width, Height);
-end;
-
-procedure TOvcBorderEdPopup.SetShowButton(Value : Boolean);
-begin
- FShowButton := Value;
- {force resize and redisplay of button}
- SetBounds(Left, Top, Width, Height);
-end;
-
-{$IFDEF VERSION4}
-procedure TOvcBorderEdPopup.CMDialogKey(var Msg : TCMDialogKey);
-begin
-(*
- if PopupActive then begin
- with Msg do begin
- if ((CharCode = VK_RETURN) or (CHarCode = VK_ESCAPE)) then begin
- PopupClose(Self);
- Result := 1;
- end;
- end;
- end else
- inherited;
-*)
-end;
-{$ENDIF}
-
-
-procedure TOvcBorderEdPopup.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
-begin
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-end;
-
-
-{******************************************************************************}
-{ TOvcBorderedNumberEdit }
-{******************************************************************************}
-
-constructor TOvcBorderedNumberEdit.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- FOvcEdit := TOvcNumberEditEx.Create(Self);
- SetEditControl(TOvcCustomEdit(FOvcEdit));
-
- FOvcEdit.Ctl3D := False;
- FOvcEdit.BorderStyle := bsNone;
- FOvcEdit.ParentColor := True;
- FOvcEdit.Parent := Self;
- FOvcEdit.Top := 0;
- FOvcEdit.Left := 0;
- FOvcEdit.TabStop := TabStop;
- FOvcEdit.BorderParent := Self;
-
- DoShowButton := FOvcEdit.ShowButton;
- ButtonWidth := FOvcEdit.ButtonGlyph.Width + 4;
-
- Height := FEdit.Height;
- Width := FEdit.Width;
- Borders.BottomBorder.Enabled := True;
-
- FController := FOvcEdit.Controller;
- FButton := FOvcEdit.FButton;
- FButtonGlyph := FOvcEdit.FButtonGlyph;
- FPopupActive := FOvcEdit.FPopupActive;
- FOnPopupClose := FOvcEdit.FOnPopupClose;
- FShowButton := FOvcEdit.FShowButton;
-
- {$IFDEF VERSION4}
- {$IFNDEF LCL}
- FBiDiMode := FOvcEdit.BiDiMode;
- {$ENDIF}
- FDragKind := FOvcEdit.DragKind;
- {$IFNDEF LCL}
- FParentBiDiMode:= FOvcEdit.ParentBiDiMode;
- {$ENDIF}
- {$ENDIF}
- FAbout := FOvcEdit.About;
- {$IFNDEF LCL}
- FAutoSelect := FOvcEdit.AutoSelect;
- {$ENDIF}
- FAutoSize := FOvcEdit.AutoSize;
- FBorderStyle := FOvcEdit.BorderStyle;
- FCharCase := FOvcEdit.CharCase;
- FCursor := FOvcEdit.Cursor;
- FDragCursor := FOvcEdit.DragCursor;
- FDragMode := FOvcEdit.DragMode;
- FEnabled := True;
- FFont := FOvcEdit.Font;
- {$IFNDEF LCL}
- FHideSelection := FOvcEdit.HideSelection;
- FImeMode := FOvcEdit.ImeMode;
- FImeName := FOvcEdit.ImeName;
- {$ENDIF}
- FMaxLength := FOvcEdit.MaxLength;
- {$IFNDEF LCL}
- FOEMConvert := FOvcEdit.OEMConvert;
- {$ENDIF}
- FParentFont := FOvcEdit.ParentFont;
- FParentShowHint:= FOvcEdit.ParentShowHint;
- FPasswordChar := FOvcEdit.PasswordChar;
- FPopupMenu := FOvcEdit.PopupMenu;
- FReadOnly := FOvcEdit.ReadOnly;
- FShowHint := FOvcEdit.ShowHint;
- FTabOrder := FOvcEdit.TabOrder;
- FVisible := True;
-
- FOnChange := FOvcEdit.OnChange;
- FOnClick := FOvcEdit.OnClick;
- FOnDblClick := FOvcEdit.OnDblClick;
- FOnDragDrop := FOvcEdit.OnDragDrop;
- FOnDragOver := FOvcEdit.OnDragOver;
-
- FOnEndDrag := FOvcEdit.OnEndDrag;
- FOnEnter := FOvcEdit.OnEnter;
- FOnExit := FOvcEdit.OnExit;
- FOnKeyDown := FOvcEdit.OnKeyDown;
- FOnKeyPress := FOvcEdit.OnKeyPress;
- FOnKeyUp := FOvcEdit.OnKeyUp;
- FOnMouseDown := FOvcEdit.OnMouseDown;
- FOnMouseMove := FOvcEdit.OnMouseMove;
- FOnMouseUp := FOvcEdit.OnMouseUp;
- FOnStartDrag := FOvcEdit.OnStartDrag;
-
- {load button glyph}
-{$IFNDEF LCL}
- FButtonGlyph.Handle := LoadBaseBitmap('ORBTNCLC');
-{$ELSE}
- FButtonGlyph.LoadFromLazarusResource('ORBTNCLC');
-{$ENDIF}
- FButton.Glyph.Assign(FButtonGlyph);
-
- FCalculator := FOvcEdit.Calculator;
-end;
-
-destructor TOvcBorderedNumberEdit.Destroy;
-begin
- FOvcEdit.Free;
- FOvcEdit := nil;
-
- inherited Destroy;
-end;
-
-
-function TOvcBorderedNumberEdit.GetAsFloat : Double;
-var
- I : Integer;
- S : string;
-begin
- S := Text;
- for I := Length(S) downto 1 do
- if not (S[I] in ['0'..'9', '+', '-', DecimalSeparator]) then
- Delete(S, I, 1);
- Result := StrToFloat(S);
-end;
-
-function TOvcBorderedNumberEdit.GetAsInteger : LongInt;
-begin
- Result := Round(GetAsFloat);
-end;
-
-function TOvcBorderedNumberEdit.GetAsString : string;
-begin
- Result := Text;
-end;
-
-function TOvcBorderedNumberEdit.GetPopupColors : TOvcCalcColors;
-begin
- Result := FCalculator.Colors;
-end;
-
-function TOvcBorderedNumberEdit.GetPopupDecimals : Integer;
-begin
- Result := FCalculator.Decimals;
-end;
-
-function TOvcBorderedNumberEdit.GetPopupFont : TFont;
-begin
- Result := FCalculator.Font;
-end;
-
-function TOvcBorderedNumberEdit.GetPopupHeight : Integer;
-begin
- Result := FCalculator.Height;
-end;
-
-function TOvcBorderedNumberEdit.GetPopupWidth : Integer;
-begin
- Result := FCalculator.Width;
-end;
-
-function TOvcBorderedNumberEdit.GetReadOnly : Boolean;
-begin
- Result := FOvcEdit.ReadOnly;
- FReadOnly := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetParentFont : Boolean;
-begin
- Result := FOvcEdit.ParentFont;
- FParentFont := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetEditParentShowHint : Boolean;
-begin
- Result := FOvcEdit.ParentShowHint;
- FParentShowHint := Result;
-end;
-
-
-procedure TOvcBorderedNumberEdit.GlyphChanged;
-begin
- inherited GlyphChanged;
-
- if FButtonGlyph.Empty then
-{$IFNDEF LCL}
- FButtonGlyph.Handle := LoadBaseBitmap('ORBTNCLC');
-{$ELSE}
- FButtonGlyph.LoadFromLazarusResource('ORBTNCLC');
-{$ENDIF}
-end;
-
-
-procedure TOvcBorderedNumberEdit.SetAsFloat(Value : Double);
-begin
- Text := FloatToStr(Value);
-end;
-
-procedure TOvcBorderedNumberEdit.SetAsInteger(Value : LongInt);
-begin
- Text := IntToStr(Value);
-end;
-
-procedure TOvcBorderedNumberEdit.SetAsString(const Value : string);
-begin
- Text := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetPopupColors(Value : TOvcCalcColors);
-begin
- FCalculator.Colors := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetPopupDecimals(Value : Integer);
-begin
- FCalculator.Decimals := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetPopupFont(Value : TFont);
-begin
- if Assigned(Value) then
- FCalculator.Font.Assign(Value);
-end;
-
-procedure TOvcBorderedNumberEdit.SetPopupHeight(Value : Integer);
-begin
- FCalculator.Height := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetPopupWidth(Value : Integer);
-begin
- FCalculator.Width := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetReadOnly(Value : Boolean);
-begin
- FReadOnly := Value;
- FOvcEdit.ReadOnly := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetParentFont(Value : Boolean);
-begin
- FParentFont := Value;
- FOvcEdit.ParentFont := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetEditParentShowHint(Value : Boolean);
-begin
- FOvcEdit.ParentShowHint := Value;
- FParentShowHint := Value;
-end;
-
-
-function TOvcBorderedNumberEdit.GetOnPopupClose : TOvcPopupEvent;
-begin
- Result := FOvcEdit.OnPopupClose;
- FOnPopupClose := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnPopupOpen : TOvcPopupEvent;
-begin
- Result := FOvcEdit.OnPopupOpen;
- FOnPopupOpen := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetPopupAnchor : TOvcPopupAnchor;
-begin
- Result := FOvcEdit.BorderParent.PopupAnchor;
- FPopupAnchor := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetEditShowButton : Boolean;
-begin
- Result := FOvcEdit.ShowButton;
- FShowButton := Result;
-end;
-
-
-procedure TOvcBorderedNumberEdit.SetOnPopupClose(Value : TOvcPopupEvent);
-begin
- FOvcEdit.OnPopupClose := Value;
- FOnPopupClose := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnPopupOpen(Value : TOvcPopupEvent);
-begin
- FOvcEdit.OnPopupOpen := Value;
- FOnPopupOpen := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetPopupAnchor(Value : TOvcPopupAnchor);
-begin
- FOvcEdit.BorderParent.PopupAnchor := Value;
- FPopupAnchor := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetEditShowButton(Value : Boolean);
-begin
- FOvcEdit.ShowButton := Value;
- FShowButton := Value;
-end;
-
-
-{base property methods}
-{$IFDEF VERSION4}
- {$IFNDEF LCL}
-function TOvcBorderedNumberEdit.GetBiDiMode : TBiDiMode;
-begin
- Result := FOvcEdit.BiDiMode;
- FBiDiMode := Result;
-end;
- {$ENDIF}
-
-function TOvcBorderedNumberEdit.GetDragKind : TDragKind;
-begin
- Result := FOvcEdit.DragKind;
- FDragKind := Result;
-end;
-
-(*
-function TOvcBorderedNumberEdit.GetEditConstraints : TSizeConstraints;
-begin
- Result := FOvcEdit.Constraints;
- FConstraints := Result;
-end;
-*)
-
-{$IFNDEF LCL}
-function TOvcBorderedNumberEdit.GetParentBiDiMode : Boolean;
-begin
- Result := FOvcEdit.ParentBiDiMode;
- FParentBiDiMode := Result;
-end;
-
-procedure TOvcBorderedNumberEdit.SetBiDiMode(Value : TBiDiMode);
-begin
- if (Value <> FBiDiMode) then begin
- inherited;
- FBiDiMode := Value;
- FOvcEdit.BiDiMode := Value;
- end;
-end;
-{$ENDIF}
-
-(*
-procedure TOvcBorderedNumberEdit.SetEditConstraints(Value : TSizeConstraints);
-begin
- FConstraints := Value;
- FOvcEdit.Constraints := Value;
-end;
-*)
-
-{$IFNDEF LCL}
-procedure TOvcBorderedNumberEdit.SetParentBiDiMode(Value : Boolean);
-begin
- if (Value <> FParentBiDiMode) then begin
- inherited;
- FParentBiDiMode := Value;
- FOvcEdit.ParentBiDiMode := Value;
- end;
-end;
-{$ENDIF}
-
-procedure TOvcBorderedNumberEdit.SetDragKind(Value : TDragKind);
-begin
- if (Value <> FDragKind) then begin
- FDragKind := Value;
- FOvcEdit.DragKind := Value;
- end;
-end;
-{$ENDIF}
-
-
-function TOvcBorderedNumberEdit.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-
-{$IFNDEF LCL}
-function TOvcBorderedNumberEdit.GetAutoSelect : Boolean;
-begin
- Result := FOvcEdit.AutoSelect;
- FAutoSelect := FOvcEdit.AutoSelect;
-end;
-{$ENDIF}
-
-function TOvcBorderedNumberEdit.GetAutoSize : Boolean;
-begin
- Result := FOvcEdit.AutoSize;
- FAutoSize := FOvcEdit.AutoSize;
-end;
-
-function TOvcBorderedNumberEdit.GetCharCase : TEditCharCase;
-begin
- Result := FOvcEdit.CharCase;
- FCharCase := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetController : TOvcController;
-begin
- Result := FOvcEdit.Controller;
- FController := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetCursor : TCursor;
-begin
- Result := FOvcEdit.Cursor;
- FCursor := Result;
-end;
-
-
-function TOvcBorderedNumberEdit.GetDragCursor : TCursor;
-begin
- Result := FOvcEdit.DragCursor;
- FDragCursor := Result;
-end;
-
-
-function TOvcBorderedNumberEdit.GetDragMode : TDragMode;
-begin
- Result := FOvcEdit.DragMode;
- FDragMode := Result;
-end;
-
-
-function TOvcBorderedNumberEdit.GetEditEnabled : Boolean;
-begin
- Result := FOvcEdit.Enabled;
- FEnabled := FOvcEdit.Enabled;
-end;
-
-function TOvcBorderedNumberEdit.GetFont : TFont;
-begin
- Result := FOvcEdit.Font;
- FFont := Result;
-end;
-
-{$IFNDEF LCL}
-function TOvcBorderedNumberEdit.GetHideSelection : Boolean;
-begin
- Result := FOvcEdit.HideSelection;
- FHideSelection := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetImeMode : TImeMode;
-begin
- Result := FOvcEdit.ImeMode;
- FImeMode := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetImeName : string;
-begin
- Result := FOvcEdit.ImeName;
- FImeName := Result;
-end;
-{$ENDIF}
-
-function TOvcBorderedNumberEdit.GetMaxLength : Integer;
-begin
- Result := FOvcEdit.MaxLength;
- FMaxLength := Result;
-end;
-
-{$IFNDEF LCL}
-function TOvcBorderedNumberEdit.GetOEMConvert : Boolean;
-begin
- Result := FOvcEdit.OEMConvert;
- FOEMConvert := Result;
-end;
-{$ENDIF}
-
-function TOvcBorderedNumberEdit.GetParentShowHint : Boolean;
-begin
- Result := FOvcEdit.ParentShowHint;
- FParentShowHint := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetPasswordChar : Char;
-begin
- Result := FOvcEdit.PasswordChar;
- FPasswordChar := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnChange : TNotifyEvent;
-begin
- Result := FOvcEdit.OnChange;
- FOnChange := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnClick : TNotifyEvent;
-begin
- Result := FOvcEdit.OnClick;
- FOnClick := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnDblClick : TNotifyEvent;
-begin
- Result := FOvcEdit.OnDblClick;
- FOnDblClick := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnDragDrop : TDragDropEvent;
-begin
- Result := FOvcEdit.OnDragDrop;
- FOnDragDrop := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnDragOver : TDragOverEvent;
-begin
- Result := FOvcEdit.OnDragOver;
- FOnDragOver := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnEndDrag : TEndDragEvent;
-begin
- Result := FOvcEdit.OnEndDrag;
- FOnEndDrag := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnKeyDown : TKeyEvent;
-begin
- Result := FOvcEdit.OnKeyDown;
- FOnKeyDown := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnKeyPress : TKeyPressEvent;
-begin
- Result := FOvcEdit.OnKeyPress;
- FOnKeyPress := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnKeyUp : TKeyEvent;
-begin
- Result := FOvcEdit.OnKeyUp;
- FOnKeyUp := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnMouseDown : TMouseEvent;
-begin
- Result := FOvcEdit.OnMouseDown;
- FOnMouseDown := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnMouseMove : TMouseMoveEvent;
-begin
- Result := FOvcEdit.OnMouseMove;
- FOnMouseMove := Result;
-end;
-
-function TOvcBorderedNumberEdit.GetOnMouseUp : TMouseEvent;
-begin
- Result := FOvcEdit.OnMouseUp;
- FOnMouseUp := Result;
-end;
-
-
-
-procedure TOvcBorderedNumberEdit.SetAbout(const Value : string);
-begin
-end;
-
-
-{$IFNDEF LCL}
-procedure TOvcBorderedNumberEdit.SetAutoSelect(Value : Boolean);
-begin
- if (Value <> FAutoSelect) then begin
- FAutoSelect := Value;
- FOvcEdit.AutoSelect := Value;
- end;
-end;
-{$ENDIF}
-
-
-procedure TOvcBorderedNumberEdit.SetAutoSize(Value : Boolean);
-begin
- FAutoSize := Value;
- FOvcEdit.AutoSize := Value;
-end;
-
-
-procedure TOvcBorderedNumberEdit.SetCharCase(Value : TEditCharCase);
-begin
- FCharCase := Value;
- FOvcEdit.CharCase := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetEditController(Value : TOvcController);
-begin
- FController := Value;
- FOvcEdit.Controller := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetCursor(Value : TCursor);
-begin
- FCursor := Value;
- FOvcEdit.Cursor := Value;
-end;
-
-
-procedure TOvcBorderedNumberEdit.SetDragCursor(Value : TCursor);
-begin
- if (Value <> FDragCursor) then begin
- FDragCursor := Value;
- FOvcEdit.DragCursor := Value;
- end;
-end;
-
-
-procedure TOvcBorderedNumberEdit.SetEditDragMode(Value : TDragMode);
-begin
- if (Value <> FDragMode) then begin
- FDragMode := Value;
- FOvcEdit.DragMode := Value;
- end;
-end;
-
-procedure TOvcBorderedNumberEdit.SetEditEnabled(Value : Boolean);
-begin
- if (Value <> FEnabled) then begin
- FEnabled := Value;
- Enabled := Value;
- FOvcEdit.Enabled := Value;
- end;
-end;
-
-procedure TOvcBorderedNumberEdit.SetFont(Value : TFont);
-begin
- if (Value <> FFont) then begin
- FFont := Value;
- FOvcEdit.Font := Value;
- end;
-end;
-
-{$IFNDEF LCL}
-procedure TOvcBorderedNumberEdit.SetHideSelection(Value : Boolean);
-begin
- if (Value <> FHideSelection) then begin
- FHideSelection := Value;
- FOvcEdit.HideSelection := Value;
- end;
-end;
-
-procedure TOvcBorderedNumberEdit.SetImeMode(Value : TImeMode);
-begin
- if (Value <> FImeMode) then begin
- FImeMode := Value;
- FOvcEdit.ImeMode := Value;
- end;
-end;
-
-procedure TOvcBorderedNumberEdit.SetImeName(const Value : string);
-begin
- if (Value <> FImeName) then begin
- FImeName := Value;
- FOvcEdit.ImeName := Value;
- end;
-end;
-{$ENDIF}
-
-procedure TOvcBorderedNumberEdit.SetMaxLength(Value : Integer);
-begin
- if (Value <> FMaxLength) then begin
- FMaxLength := Value;
- FOvcEdit.MaxLength := Value;
- end;
-end;
-
-{$IFNDEF LCL}
-procedure TOvcBorderedNumberEdit.SetOEMConvert(Value : Boolean);
-begin
- if (Value <> FOEMConvert) then begin
- FOEMConvert := Value;
- FOvcEdit.OEMConvert := Value;
- end;
-end;
-{$ENDIF}
-
-procedure TOvcBorderedNumberEdit.SetParentShowHint(Value : Boolean);
-begin
- if (Value <> FParentShowHint) then begin
- FParentShowHint := Value;
- FOvcEdit.ParentShowHint := Value;
- end;
-end;
-
-procedure TOvcBorderedNumberEdit.SetPasswordChar(Value : Char);
-begin
- if (Value <> FPasswordChar) then begin
- FPasswordChar := Value;
- FOvcEdit.PasswordChar := Value;
- end;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnChange(Value : TNotifyEvent);
-begin
- FOnChange := Value;
- FOvcEdit.OnChange := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnClick(Value : TNotifyEvent);
-begin
- FOnClick := Value;
- FOvcEdit.OnClick := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnDblClick(Value : TNotifyEvent);
-begin
- FOnDblClick := Value;
- FOvcEdit.OnDblClick := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnDragDrop(Value : TDragDropEvent);
-begin
- FOnDragDrop := Value;
- FOvcEdit.OnDragDrop := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnDragOver(Value : TDragOverEvent);
-begin
- FOnDragOver := Value;
- FOvcEdit.OnDragOver := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnEndDrag(Value : TEndDragEvent);
-begin
- FOnEndDrag := Value;
- FOvcEdit.OnEndDrag := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnKeyDown(Value : TKeyEvent);
-begin
- FOnKeyDown := Value;
- FOvcEdit.OnKeyDown := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnKeyPress(Value : TKeyPressEvent);
-begin
- FOnKeyPress := Value;
- FOvcEdit.OnKeyPress := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnKeyUp(Value : TKeyEvent);
-begin
- FOnKeyUp := Value;
- FOvcEdit.OnKeyUp := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnMouseDown(Value : TMouseEvent);
-begin
- FOnMouseDown := Value;
- FOvcEdit.OnMouseDown := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnMouseMove(Value : TMouseMoveEvent);
-begin
- FOnMouseMove := Value;
- FOvcEdit.OnMouseMove := Value;
-end;
-
-procedure TOvcBorderedNumberEdit.SetOnMouseUp(Value : TMouseEvent);
-begin
- FOnMouseUp := Value;
- FOvcEdit.OnMouseUp := Value;
-end;
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovcbordr.pas b/Source/3rdParty/Orpheus/ovcbordr.pas
deleted file mode 100644
index c1502d4b..00000000
--- a/Source/3rdParty/Orpheus/ovcbordr.pas
+++ /dev/null
@@ -1,743 +0,0 @@
-{*********************************************************}
-{* OVCBORDR.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 ovcbordr;
- {Old style, To be deprecated - simple, single, solid borders for entry
- controls}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, MyMisc, {$ENDIF}
- Buttons, Classes, Controls, ExtCtrls, Forms, Graphics, Menus,
- StdCtrls, SysUtils, OvcBase, OvcConst, OvcData,
- OvcMisc, OvcEditF;
-
-type
- TOvcBorderStyle = (bpsSolid);
-
- TOvcBorderEdButton = class(TBitBtn)
- public
- procedure Click; override;
- end;
-
- TOvcBorder = class(TPersistent)
- protected {private}
- FEnabled : Boolean; {is border used}
- FBorderStyle : TOvcBorderStyle; {bpsSolid only for now}
- FPenColor : TColor; {color of pen}
- FPenStyle : TPenStyle; {Windows pen style}
- FPenWidth : integer; {width of pen}
-
- FOnChange : TNotifyEvent; {notify owner of changes}
-
- protected
- procedure DoOnChange;
- procedure SetDefaults;
-
- procedure SetEnabled(Value : Boolean);
- procedure SetBorderStyle(Value : TOvcBorderStyle);
- procedure SetPenColor(Value : TColor);
- procedure SetPenStyle(Value : TPenStyle);
- procedure SetPenWidth(Value : integer);
-
- public
- procedure Assign(Value : TPersistent); override;
- constructor Create;
-
- published
- property BorderStyle : TOvcBorderStyle
- read FBorderStyle
- write SetBorderStyle
- stored FEnabled
- default bpsSolid;
-
- property Enabled : Boolean
- read FEnabled
- write SetEnabled
- default False;
-
- property OnChange : TNotifyEvent
- read FOnChange
- write FOnChange;
-
- property PenColor : TColor
- read FPenColor
- write SetPenColor
- stored FEnabled
- default clBlack;
-
- property PenStyle : TPenStyle
- read FPenStyle
- write SetPenStyle
- stored FEnabled
- default psSolid;
-
- property PenWidth : integer
- read FPenWidth
- write SetPenWidth
- stored FEnabled
- default 2;
- end;
-
-
- TOvcBorders = class(TPersistent)
- protected {private}
- FLeftBorder : TOvcBorder;
- FRightBorder : TOvcBorder;
- FTopBorder : TOvcBorder;
- FBottomBorder : TOvcBorder;
-
- public
- procedure Assign(Source : TPersistent); override;
- constructor Create;
- destructor Destroy; override;
-
- published
- property BottomBorder : TOvcBorder
- read FBottomBorder
- write FBottomBorder;
-
- property LeftBorder : TOvcBorder
- read FLeftBorder
- write FLeftBorder;
-
- property RightBorder : TOvcBorder
- read FRightBorder
- write FRightBorder;
-
- property TopBorder : TOvcBorder
- read FTopBorder
- write FTopBorder;
- end;
-
- TOvcBorderParent = class(TOvcCustomControl)
- {.Z+}
- protected {private}
- {property variables}
- FBorders : TOvcBorders;
- FEdit : TOvcCustomEdit;
- FLabelInfo : TOvcLabelInfo;
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
-
- FOrgHeight : integer;
-
- protected
- DefaultLabelPosition : TOvcLabelPosition;
- DoingBorders : Boolean;
-
- procedure BorderChanged(ABorder : TObject);
- function GetAttachedLabel : TOvcAttachedLabel;
- procedure Paint; override;
- procedure PaintBorders; virtual;
-
- procedure WMSetFocus(var Msg : TWMSetFocus);
- message WM_SETFOCUS;
- procedure WMKillFocus(var Msg : TWMKillFocus);
- message WM_KillFOCUS;
-
- {internal methods}
- procedure LabelChange(Sender : TObject);
- procedure LabelAttach(Sender : TObject; Value : Boolean);
- procedure PositionLabel;
-
- {VCL message methods}
- procedure CMVisibleChanged(var Msg : TMessage);
- message CM_VISIBLECHANGED;
-
- procedure OrAssignLabel(var Msg : TMessage);
- message OM_ASSIGNLABEL;
- procedure OrPositionLabel(var Msg : TMessage);
- message OM_POSITIONLABEL;
- procedure OrRecordLabelPosition(var Msg : TMessage);
- message OM_RECORDLABELPOSITION;
-
-
- procedure CreateWnd;
- override;
- procedure Notification(AComponent : TComponent; Operation: TOperation);
- override;
-
- public
- ButtonWidth : integer;
- DoShowButton : Boolean;
-
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
- override;
- procedure SetEditControl(EC : TOvcCustomEdit); virtual;
-
- property AttachedLabel : TOvcAttachedLabel
- read GetAttachedLabel;
-
- property Canvas;
-
- property EditControl : TOvcCustomEdit
- read FEdit
- write FEdit;
-
- published
- property Borders : TOvcBorders
- read FBorders
- write FBorders;
-
- property LabelInfo : TOvcLabelInfo
- read FLabelInfo
- write FLabelInfo;
-
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D;
-{$ENDIF}
-
- end;
-
-implementation
-
-uses
- OvcBCalc;
-
-procedure TOvcBorderEdButton.Click;
-begin
- TOvcBorderEdPopup(Parent).PopupOpen;
-end;
-
-{******************************************************************************}
-{ TOvcBorder }
-{******************************************************************************}
-constructor TOvcBorder.Create;
-begin
- inherited Create;
- SetDefaults;
-end;
-
-
-procedure TOvcBorder.Assign(Value : TPersistent);
-var
- B : TOvcBorder absolute Value;
-begin
- if (Value <> nil) and (Value is TOvcBorder) then begin
- Enabled := B.Enabled;
- PenColor := B.PenColor;
- PenStyle := B.PenStyle;
- PenWidth := B.PenWidth;
- end else
- inherited Assign(Value);
-end;
-
-
-procedure TOvcBorder.DoOnChange;
-begin
- if (Assigned(FOnChange)) then
- FOnChange(Self);
-end;
-
-
-procedure TOvcBorder.SetDefaults;
-begin
- FEnabled := False;
- FPenColor := clBlack;
- FPenStyle := psSolid;
- FPenWidth := 2;
-end;
-
-procedure TOvcBorder.SetBorderStyle(Value : TOvcBorderStyle);
-begin
- if (FBorderStyle <> Value) then begin
- FBorderStyle := Value;
- DoOnChange;
- end;
-end;
-
-
-procedure TOvcBorder.SetEnabled(Value : Boolean);
-begin
- if (FEnabled <> Value) then begin
- FEnabled := Value;
- DoOnChange;
- end;
-end;
-
-
-procedure TOvcBorder.SetPenColor(Value : TColor);
-begin
- if (FPenColor <> Value) then begin
- FPenColor := Value;
- DoOnChange;
- end;
-end;
-
-
-procedure TOvcBorder.SetPenStyle(Value : TPenStyle);
-begin
- if (FPenStyle <> Value) then begin
- FPenStyle := Value;
- DoOnChange;
- end;
-end;
-
-
-procedure TOvcBorder.SetPenWidth(Value : integer);
-begin
- if (FPenWidth <> Value) and (Value > 0) then begin
- FPenWidth := Value;
- DoOnChange;
- end;
-end;
-
-{******************************************************************************}
-{ TOvcBorders }
-{******************************************************************************}
-
-constructor TOvcBorders.Create;
-begin
- inherited Create;
-
- FBottomBorder := TOvcBorder.Create;
- FLeftBorder := TOvcBorder.Create;
- FRightBorder := TOvcBorder.Create;
- FTopBorder := TOvcBorder.Create;
-end;
-
-destructor TOvcBorders.Destroy;
-begin
- FBottomBorder.Free;
- FBottomBorder := nil;
-
- FLeftBorder.Free;
- FLeftBorder := nil;
-
- FRightBorder.Free;
- FRightBorder := nil;
-
- FTopBorder.Free;
- FTopBorder := nil;
-
- inherited Destroy;
-end;
-
-procedure TOvcBorders.Assign(Source : TPersistent);
-var
- B : TOvcBorders absolute Source;
-begin
- if (Source <> nil) and (Source is TOvcBorders) then begin
- FBottomBorder.Assign(B.BottomBorder);
- FLeftBorder.Assign(B.LeftBorder);
- FRightBorder.Assign(B.RightBorder);
- FTopBorder.Assign(B.TopBorder);
- end else
- inherited Assign(Source);
-end;
-
-
-{******************************************************************************}
-{ TOvcBorderParent }
-{******************************************************************************}
-
-procedure TOvcBorderParent.BorderChanged(ABorder : TObject);
-begin
- PaintBorders;
-end;
-
-
-procedure TOvcBorderParent.CMVisibleChanged(var Msg : TMessage);
-begin
- inherited;
-
- if csLoading in ComponentState then
- Exit;
-
- if LabelInfo.Visible then
- AttachedLabel.Visible := Visible;
-end;
-
-
-constructor TOvcBorderParent.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- Parent := TWinControl(AOwner);
-
- Height := 21;
- Width := 121;
-
- FOrgHeight := 21;
-
- ControlStyle := ControlStyle - [csSetCaption];
-
- ParentColor := True;
- Ctl3D := False;
-
-
- {set default position and reference point}
- DefaultLabelPosition := lpTopLeft;
-
- FLabelInfo := TOvcLabelInfo.Create;
- FLabelInfo.OnChange := LabelChange;
- FLabelInfo.OnAttach := LabelAttach;
-
- {create borders class and assign notifications}
- FBorders := TOvcBorders.Create;
-
- FBorders.LeftBorder.OnChange := BorderChanged;
- FBorders.RightBorder.OnChange := BorderChanged;
- FBorders.TopBorder.OnChange := BorderChanged;
- FBorders.BottomBorder.OnChange := BorderChanged;
-end;
-
-destructor TOvcBorderParent.Destroy;
-begin
- {detatch and destroy label, if any}
- FLabelInfo.Visible := False;
-
- {dispose the borders object}
- FBorders.Free;
- FLabelInfo.Free;
- FBorders := nil;
- FLabelInfo := nil;
-
- inherited Destroy;
-end;
-
-function TOvcBorderParent.GetAttachedLabel : TOvcAttachedLabel;
-begin
- if not FLabelInfo.Visible then
- raise Exception.Create(GetOrphStr(SCLabelNotAttached));
-
- Result := FLabelInfo.ALabel;
-end;
-
-
-procedure TOvcBorderParent.WMSetFocus(var Msg : TWMSetFocus);
-begin
- inherited;
- if (Assigned(FEdit)) then
- FEdit.SetFocus;
-end;
-
-procedure TOvcBorderParent.WMKillFocus(var Msg : TWMKillFocus);
-begin
- inherited;
-end;
-
-procedure TOvcBorderParent.LabelAttach(Sender : TObject; Value : Boolean);
-var
-{$IFDEF VERSION5}
- PF : TWinControl;
-{$ELSE}
- PF : TForm;
-{$ENDIF}
- S :string;
-begin
- if csLoading in ComponentState then
- Exit;
-
-{$IFDEF VERSION5}
- PF := GetImmediateParentForm(Self);
-{$ELSE}
- PF := TForm(GetParentForm(Self));
-{$ENDIF}
- if Value then begin
- if Assigned(PF) then begin
- FLabelInfo.ALabel.Free;
- FLabelInfo.ALabel := TOvcAttachedLabel.CreateEx(PF, Self);
- FLabelInfo.ALabel.Parent := Parent;
-
- S := GenerateComponentName(PF, Name + 'Label');
- FLabelInfo.ALabel.Name := S;
- FLabelInfo.ALabel.Caption := S;
-
- FLabelInfo.SetOffsets(0, 0);
- PositionLabel;
- FLabelInfo.ALabel.BringToFront;
- {turn off auto size}
- TLabel(FLabelInfo.ALabel).AutoSize := False;
- end;
- end else begin
- if Assigned(PF) then begin
- FLabelInfo.ALabel.Free;
- FLabelInfo.ALabel := nil;
- end;
- end;
-end;
-
-
-procedure TOvcBorderParent.LabelChange(Sender : TObject);
-begin
- if not (csLoading in ComponentState) then
- PositionLabel;
-end;
-
-
-procedure TOvcBorderParent.CreateWnd;
-begin
- inherited CreateWnd;
-end;
-
-procedure TOvcBorderParent.Notification(AComponent : TComponent; Operation: TOperation);
-var
-{$IFDEF VERSION5}
- PF : TWinControl;
-{$ELSE}
- PF : TForm;
-{$ENDIF}
-begin
- inherited Notification(AComponent, Operation);
-
- if Operation = opRemove then begin
- if Assigned(FLabelInfo) and (AComponent = FLabelInfo.ALabel) then begin
- {$IFDEF VERSION5}
- PF := GetImmediateParentForm(Self);
- {$ELSE}
- PF := TForm(GetParentForm(Self));
- {$ENDIF}
- if Assigned(PF) and not (csDestroying in PF.ComponentState) then begin
- FLabelInfo.FVisible := False;
- FLabelInfo.ALabel := nil;
- end
- end;
- end;
-end;
-
-
-procedure TOvcBorderParent.OrAssignLabel(var Msg : TMessage);
-begin
- FLabelInfo.ALabel := TOvcAttachedLabel(Msg.lParam);
-end;
-
-
-procedure TOvcBorderParent.OrPositionLabel(var Msg : TMessage);
-const
- DX : Integer = 0;
- DY : Integer = 0;
-begin
- if FLabelInfo.Visible and Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) and
- not (csLoading in ComponentState) then begin
- if DefaultLabelPosition = lpTopLeft then begin
- DX := FLabelInfo.ALabel.Left - Left;
- DY := FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top;
- end else begin
- DX := FLabelInfo.ALabel.Left - Left;
- DY := FLabelInfo.ALabel.Top - Top - Height;
- end;
- if (DX <> FLabelInfo.OffsetX) or (DY <> FLabelInfo.OffsetY) then
- PositionLabel;
- end;
-end;
-
-
-procedure TOvcBorderParent.OrRecordLabelPosition(var Msg : TMessage);
-begin
- if Assigned(FLabelInfo.ALabel) and (FLabelInfo.ALabel.Parent <> nil) then begin
- {if the label was cut and then pasted, this will complete the reattachment}
- FLabelInfo.FVisible := True;
-
- if DefaultLabelPosition = lpTopLeft then
- FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
- FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top)
- else
- FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
- FLabelInfo.ALabel.Top - Top - Height);
- end;
-end;
-
-
-procedure TOvcBorderParent.PositionLabel;
-begin
- if FLabelInfo.Visible and Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) and
- not (csLoading in ComponentState) then begin
-
- if DefaultLabelPosition = lpTopLeft then begin
- FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
- FLabelInfo.OffsetY - FLabelInfo.ALabel.Height + Top,
- FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
- end else begin
- FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
- FLabelInfo.OffsetY + Top + Height,
- FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
- end;
- end;
-end;
-
-
-procedure TOvcBorderParent.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
-begin
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-
- if not HandleAllocated then
- Exit;
-
- if HandleAllocated then
- PostMessage(Handle, OM_POSITIONLABEL, 0, 0);
-end;
-
-
-procedure TOvcBorderParent.SetEditControl(EC : TOvcCustomEdit);
-begin
- FEdit := EC;
-end;
-
-
-procedure TOvcBorderParent.Paint;
-begin
- PaintBorders;
-end;
-
-procedure TOvcBorderParent.PaintBorders;
-var
- R : TRect;
- C : TCanvas;
- W : integer;
- BW : integer;
-begin
- Height := FOrgHeight;
-
-
- C := Canvas;
- if DoShowButton then
- W := ButtonWidth + 4
- else
- W := 0;
-
- if (FBorders.LeftBorder.Enabled) then
- FEdit.Left := FBorders.LeftBorder.PenWidth
- else
- FEdit.Left := 0;
-
- if (FBorders.TopBorder.Enabled) then
- FEdit.Top := FBorders.TopBorder.PenWidth
- else
- FEdit.Top := 0;
-
- if (not (FBorders.LeftBorder.Enabled or FBorders.RightBorder.Enabled)) then
- FEdit.Width := Width
- else begin
- BW := W;
- if (FBorders.LeftBorder.Enabled) then
- BW := FBorders.LeftBorder.PenWidth;
- if (FBorders.RightBorder.Enabled) then
- BW := BW + FBorders.RightBorder.PenWidth;
- FEdit.Width := Width - BW;
- end;
-
- if (not (FBorders.TopBorder.Enabled or FBorders.BottomBorder.Enabled)) then
-{ Height := FEdit.Height}
- FEdit.Height := Height
- else begin
- BW := 0;
- if (FBorders.TopBorder.Enabled) then
- BW := FBorders.TopBorder.PenWidth;
- if (FBorders.BottomBorder.Enabled) then
- BW := BW + FBorders.BottomBorder.PenWidth;
-
- FEdit.Height := Height - BW;
- end;
-
- R.Left := 0;
- R.Top := 0;
- R.Right := Width;
- R.Bottom := Height;
-
- if (Assigned(FBorders.FLeftBorder)) then begin
- if (FBorders.LeftBorder.Enabled) then begin
- C.Pen.Color := FBorders.LeftBorder.PenColor;
- C.Pen.Width := FBorders.LeftBorder.PenWidth;
- C.Pen.Style := FBorders.LeftBorder.PenStyle;
-
- C.MoveTo(R.Left + (FBorders.LeftBorder.PenWidth div 2), R.Top);
- C.LineTo(R.Left + (FBorders.LeftBorder.PenWidth div 2), R.Bottom);
- end;
- end;
-
- if (Assigned(FBorders.FRightBorder)) then begin
- if (FBorders.RightBorder.Enabled) then begin
- C.Pen.Color := FBorders.RightBorder.PenColor;
- C.Pen.Width := FBorders.RightBorder.PenWidth;
- C.Pen.Style := FBorders.RightBorder.PenStyle;
-
- if ((FBorders.RightBorder.PenWidth mod 2) = 0) then begin
- C.MoveTo(R.Right - (FBorders.RightBorder.PenWidth div 2), R.Top);
- C.LineTo(R.Right - (FBorders.RightBorder.PenWidth div 2), R.Bottom);
- end else begin
- C.MoveTo(R.Right - (FBorders.RightBorder.PenWidth div 2) - 1, R.Top);
- C.LineTo(R.Right - (FBorders.RightBorder.PenWidth div 2) - 1, R.Bottom);
- end;
- end;
- end;
-
- if (Assigned(FBorders.FTopBorder)) then begin
- if (FBorders.TopBorder.Enabled) then begin
- C.Pen.Color := FBorders.TopBorder.PenColor;
- C.Pen.Width := FBorders.TopBorder.PenWidth;
- C.Pen.Style := FBorders.TopBorder.PenStyle;
-
- C.MoveTo(R.Left, R.Top + (FBorders.TopBorder.PenWidth div 2));
- C.LineTo(R.Right, R.Top + (FBorders.TopBorder.PenWidth div 2));
- end;
- end;
-
- if (Assigned(FBorders.FBottomBorder)) then begin
- if (FBorders.BottomBorder.Enabled) then begin
- C.Pen.Color := FBorders.BottomBorder.PenColor;
- C.Pen.Width := FBorders.BottomBorder.PenWidth;
- C.Pen.Style := FBorders.BottomBorder.PenStyle;
-
- if ((FBorders.BottomBorder.PenWidth mod 2) = 0) then begin
- C.MoveTo(R.Left, R.Bottom - (FBorders.BottomBorder.PenWidth div 2));
- C.LineTo(R.Right - (FBorders.BottomBorder.PenWidth div 2),
- R.Bottom - (FBorders.BottomBorder.PenWidth div 2));
- end else begin
- C.MoveTo(R.Left, R.Bottom - (FBorders.BottomBorder.PenWidth div 2) - 1);
- C.LineTo(R.Right, R.Bottom - (FBorders.BottomBorder.PenWidth div 2) - 1);
- end;
- end;
- end;
- if (Assigned(FEdit)) then
- FEdit.Refresh;
- ValidateRect(Handle, @R);
-end;
-
-end.
-
-
-
diff --git a/Source/3rdParty/Orpheus/ovccal.pas b/Source/3rdParty/Orpheus/ovccal.pas
deleted file mode 100644
index 4f928abd..00000000
--- a/Source/3rdParty/Orpheus/ovccal.pas
+++ /dev/null
@@ -1,1798 +0,0 @@
-{*********************************************************}
-{* OVCCAL.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 ovccal;
- {-Calendar component}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, FileUtil,{$ENDIF}
- Buttons, Classes, Controls, Forms, Graphics, Menus,
- SysUtils, OvcBase, OvcConst, OvcData, OvcIntl,
- OvcMisc, OvcDate;
-
-type
- TOvcDateFormat = (dfShort, dfLong);
- TOvcDayNameWidth = 1..3;
- TOvcDayType = (dtSunday, dtMonday, dtTuesday, dtWednesday,
- dtThursday, dtFriday, dtSaturday);
- TOvcCalDisplayOption = (cdoShortNames, cdoShowYear, cdoShowInactive,
- cdoShowRevert, cdoShowToday, cdoShowNavBtns,
- cdoHideActive);
- TOvcCalDisplayOptions = set of TOvcCalDisplayOption;
-
-type
- TOvcCalColorArray = array[0..5] of TColor;
- TOvcCalColorScheme = (cscalCustom, cscalClassic, cscalWindows,
- cscalGold, cscalOcean, cscalRose);
- TOvcCalSchemeArray = array[TOvcCalColorScheme] of TOvcCalColorArray;
-
-const
- {ActiveDay, DayNames, Days, InactiveDays, MonthAndYear, Weekend}
- CalScheme : TOvcCalSchemeArray =
- ((0, 0, 0, 0, 0, 0),
- (clHighlight, clWindow, clWindow, clWindow, clWindow, clWindow),
- (clRed, clMaroon, clBlack, clGray, clBlue, clRed),
- (clBlack, clBlack, clYellow, clGray, clBlack, clTeal),
- (clBlack, clBlack, clAqua, clGray, clBlack, clNavy),
- (clRed, clRed, clFuchsia, clGray, clBlue, clTeal)
- );
-
-type
- TOvcCalColors = class(TPersistent)
- {.Z+}
- protected {private}
- {property variables}
- FUpdating : Boolean;
- FOnChange : TNotifyEvent;
-
- {internal variables}
- SettingScheme : Boolean;
-
- {property methods}
- function GetColor(Index : Integer) : TColor;
- procedure SetColor(Index : Integer; Value : TColor);
- procedure SetColorScheme(Value : TOvcCalColorScheme);
-
- {internal methods}
- procedure DoOnChange;
-
- public
- {public property variables}
- FCalColors : TOvcCalColorArray;
- FColorScheme : TOvcCalColorScheme;
-
- procedure Assign(Source : TPersistent);
- override;
- procedure BeginUpdate;
- procedure EndUpdate;
-
- property OnChange : TNotifyEvent
- read FOnChange write FOnChange;
- {.Z-}
-
- published
- property ActiveDay : TColor index 0
- read GetColor write SetColor;
- property ColorScheme : TOvcCalColorScheme
- read FColorScheme write SetColorScheme;
- property DayNames : TColor index 1
- read GetColor write SetColor;
- property Days : TColor index 2
- read GetColor write SetColor;
- property InactiveDays : TColor index 3
- read GetColor write SetColor;
- property MonthAndYear : TColor index 4
- read GetColor write SetColor;
- property Weekend : TColor index 5
- read GetColor write SetColor;
- end;
-
-type
- TDateChangeEvent = procedure(Sender : TObject; Date : TDateTime)
- of object;
- TCalendarDateEvent =
- procedure(Sender : TObject; ADate : TDateTime; const Rect : TRect)
- of object;
- TGetHighlightEvent =
- procedure(Sender : TObject; ADate : TDateTime; var Color : TColor)
- of object;
- TGetDateEnabledEvent =
- procedure(Sender : TObject; ADate : TDateTime; var Enabled : Boolean)
- of object;
-
-
- TOvcCustomCalendar = class(TOvcCustomControl)
- {.Z+}
- protected {private}
- {property variables}
- FBorderStyle : TBorderStyle;
- FBrowsing : Boolean;
- FColors : TOvcCalColors;
- FOptions : TOvcCalDisplayOptions;
- FDate : TDateTime;
- FDay : Integer; {calendar day}
- FDateFormat : TOvcDateFormat;
- FDayNameWidth : TOvcDayNameWidth;
- FDrawHeader : Boolean; {true to draw day name header}
- FIntlSup : TOvcIntlSup; {international date/time support}
- FMonth : Integer; {calendar month}
- FReadOnly : Boolean; {true if in read only mode}
- FWantDblClicks : Boolean; {true to include cs_dblclks style}
- FWeekStarts : TOvcDayType; {the day that begins the week}
- FYear : Integer; {calendar year}
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
-
- {event variables}
- FOnChange : TDateChangeEvent;
- FOnDrawDate : TCalendarDateEvent;
- FOnDrawItem : TCalendarDateEvent;
- FOnGetDateEnabled: TGetDateEnabledEvent;
- FOnGetHighlight : TGetHighlightEvent;
-
- {internal variables}
- clBtnLeft : TSpeedButton;
- clBtnRevert : TSpeedButton;
- clBtnRight : TSpeedButton;
- clBtnToday : TSpeedButton;
- clInPopup : Boolean;
- clBtnNextYear : TSpeedButton;
- clBtnPrevYear : TSpeedButton;
- clCalendar : array[1..49] of Byte; {current month grid}
- clDay : Word;
- clFirst : Byte; {index for first day in current month}
- clLast : Byte; {index for last day in current month}
- clMonth : Word;
- clRowCol : array[0..8, 0..6] of TRect; {cell TRect info}
- cSettingScheme : Boolean;
- clYear : Word;
- clWidth : Integer; {client width - margins}
- clMask : array[0..MaxDateLen] of AnsiChar; {default date mask}
- clPopup : Boolean; {true if being created as a popup}
- clRevertDate : TDateTime; {date on entry}
- clRowCount : Integer; {7 if no header, otherwise 8}
- clStartRow : Integer; {first row number}
-
- {property methods}
- function GetAsDateTime : TDateTime;
- function GetAsStDate : TStDate;
- function GetCalendarDate : TDateTime;
- function GetDay : Integer;
- function GetMonth : Integer;
- function GetYear : Integer;
- procedure SetAsDateTime(Value : TDateTime);
- procedure SetAsStDate(Value : TStDate);
- procedure SetBorderStyle(Value : TBorderStyle);
- procedure SetDate(Value : TDateTime);
- procedure SetDateFormat(Value : TOvcDateFormat);
- procedure SetDayNameWidth(Value : TOvcDayNameWidth);
- procedure SetDisplayOptions(Value : TOvcCalDisplayOptions);
- procedure SetDrawHeader(Value : Boolean);
- procedure SetIntlSupport(Value : TOvcIntlSup);
- procedure SetWantDblClicks(Value : Boolean);
- procedure SetWeekStarts(Value : TOvcDayType);
-
- {internal methods}
- procedure calChangeMonth(Sender : TObject);
- procedure calColorChange(Sender : TObject);
- function calGetCurrentRectangle : TRect;
- {-get bounding rectangle for the current calendar day}
- function calGetValidDate(ADate : TDateTime; Delta : Integer) : TDateTime;
- procedure calRebuildCalArray;
- {-recalculate the contents of the calendar array}
- procedure calRecalcSize;
- {-calcualte new sizes for rows and columns}
-
- {VCL control methods}
-{$IFNDEF LCL}
- procedure CMCtl3DChanged(var Msg : TMessage);
- message CM_CTL3DCHANGED;
-{$ENDIF}
- procedure CMEnter(var Msg : TMessage);
- message {$IFNDEF LCL} CM_ENTER; {$ELSE} LM_SETFOCUS; {$ENDIF}
- //CM_ messages not supported in LCL, so use something similar
- // so clRevertDate is initialized properly.
- procedure CMExit(var Msg : TMessage);
- message CM_EXIT;
- procedure CMFontChanged(var Msg : TMessage);
- message CM_FONTCHANGED;
-
- {windows message methods}
- procedure WMEraseBkgnd(var Msg : TWMEraseBkgnd);
- message WM_ERASEBKGND;
- procedure WMGetDlgCode(var Msg : TWMGetDlgCode);
- message WM_GETDLGCODE;
- procedure WMKillFocus(var Msg : TWMKillFocus);
- message WM_KILLFOCUS;
-
- protected
- procedure calBtnClick(Sender : TObject);
- procedure CreateParams(var Params : TCreateParams);
- override;
- procedure CreateWnd;
- override;
- procedure DoOnChange(Value : TDateTime);
- dynamic;
- function DoOnGetDateEnabled(ADate : TDateTime) : Boolean;
- dynamic;
- procedure DoOnMouseWheel(Shift : TShiftState; Delta, XPos, YPos : SmallInt);
- override;
- function IsReadOnly : Boolean;
- dynamic;
- {-return true if the calendar is in read-only mode}
- procedure KeyDown(var Key : Word; Shift : TShiftState);
- override;
- procedure KeyPress(var Key : Char);
- override;
- procedure MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
- override;
- procedure MouseUp(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
- override;
- procedure Paint;
- override;
-
- {virtual property methods}
- procedure SetCalendarDate(Value : TDateTime);
- virtual;
-
- public
- constructor Create(AOwner : TComponent);
- override;
- constructor CreateEx(AOwner : TComponent; AsPopup : Boolean);
- virtual;
- destructor Destroy;
- override;
- procedure SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
- override;
-
- {.Z-}
-
- function DateString(const Mask : string): string;
- function DayString : string;
- procedure IncDay(Delta : Integer);
- procedure IncMonth(Delta : Integer);
- procedure IncYear(Delta : Integer);
- function MonthString : string;
- procedure SetToday;
-
- property AsDateTime : TDateTime
- read GetAsDateTime write SetAsDateTime;
- property AsStDate : TStDate
- read GetAsStDate write SetAsStDate;
- property Browsing : Boolean
- read FBrowsing;
- property Canvas;
- property Day : Integer
- read GetDay;
- property Month : Integer
- read GetMonth;
- property Year : Integer
- read GetYear;
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D default True;
-{$ENDIF}
-
- {properties}
- property BorderStyle : TBorderStyle
- read FBorderStyle write SetBorderStyle;
- property CalendarDate : TDateTime
- read GetCalendarDate write SetCalendarDate;
- property Colors : TOvcCalColors
- read FColors write FColors;
- property Date : TDateTime
- read FDate write SetDate;
- property DateFormat : TOvcDateFormat
- read FDateFormat write SetDateFormat;
- property DayNameWidth : TOvcDayNameWidth
- read FDayNameWidth write SetDayNameWidth;
- property DrawHeader : Boolean
- read FDrawHeader write SetDrawHeader;
- property IntlSupport : TOvcIntlSup
- read FIntlSup write SetIntlSupport;
- property Options : TOvcCalDisplayOptions
- read FOptions write SetDisplayOptions;
- property ReadOnly : Boolean
- read FReadOnly write FReadOnly;
- property WantDblClicks : Boolean
- read FWantDblClicks write SetWantDblClicks;
- property WeekStarts : TOvcDayType
- read FWeekStarts write SetWeekStarts;
-
- {events}
- property OnChange : TDateChangeEvent
- read FOnChange write FOnChange;
- property OnDrawDate : TCalendarDateEvent
- read FOnDrawDate write FOnDrawDate;
- property OnDrawItem : TCalendarDateEvent
- read FOnDrawItem write FOnDrawItem;
- property OnGetDateEnabled : TGetDateEnabledEvent
- read FOnGetDateEnabled write FOnGetDateEnabled;
- property OnGetHighlight : TGetHighlightEvent
- read FOnGetHighlight write FOnGetHighlight;
- end;
-
-
- TOvcCalendar = class(TOvcCustomCalendar)
- published
- {properties}
- {$IFDEF VERSION4}
- property Anchors;
- property Constraints;
- property DragKind;
- {$ENDIF}
- property About;
- property Align;
- property BorderStyle;
- property Colors;
- property Color;
- property Ctl3D;
- property Cursor;
- property DateFormat default dfLong;
- property DayNameWidth;
- property DragCursor;
- property DragMode;
- property Enabled;
- property Font;
- property LabelInfo;
- property Options;
-{$IFNDEF LCL}
- property ParentCtl3D;
-{$ENDIF}
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ReadOnly default False;
- property ShowHint;
- property TabOrder;
- property TabStop default True;
- property Visible;
- property WantDblClicks default True;
- property WeekStarts default dtSunday;
- {events}
- property AfterEnter;
- property AfterExit;
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnDrawDate;
- property OnDrawItem;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnGetDateEnabled;
- property OnGetHighlight;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDrag;
- end;
-
-
-implementation
-
-
-const
- calMargin = 4; {left, right, and top margin}
-
-{*** TOvcCalColors ***}
-
-procedure TOvcCalColors.Assign(Source : TPersistent);
-begin
- if Source is TOvcCalColors then begin
- FCalColors := TOvcCalColors(Source).FCalColors;
- FColorScheme := TOvcCalColors(Source).FColorScheme;
- FOnChange := TOvcCalColors(Source).FOnChange;
- end else
- inherited Assign(Source);
-end;
-
-procedure TOvcCalColors.BeginUpdate;
-begin
- FUpdating := True;
-end;
-
-procedure TOvcCalColors.EndUpdate;
-begin
- FUpdating := False;
- DoOnChange;
-end;
-
-procedure TOvcCalColors.DoOnChange;
-begin
- if not FUpdating and Assigned(FOnChange) then
- FOnChange(Self);
-
- if not SettingScheme then
- FColorScheme := cscalCustom;
-end;
-
-function TOvcCalColors.GetColor(Index : Integer) : TColor;
-begin
- Result := FCalColors[Index];
-end;
-
-procedure TOvcCalColors.SetColor(Index : Integer; Value : TColor);
-begin
- if Value <> FCalColors[Index] then begin
- FCalColors[Index] := Value;
- DoOnChange;
- end;
-end;
-
-procedure TOvcCalColors.SetColorScheme(Value : TOvcCalColorScheme);
-begin
- if Value <> FColorScheme then begin
- SettingScheme := True;
- try
- FColorScheme := Value;
- if Value <> cscalCustom then begin
- FCalColors := CalScheme[Value];
- DoOnChange;
- end;
- finally
- SettingScheme := False;
- end;
- end;
-end;
-
-
-{*** TOvcCustomCalendar ***}
-
-procedure TOvcCustomCalendar.calBtnClick(Sender : TObject);
-var
- Key : Word;
-begin
- SetFocus;
- Key := 0;
-
- if Sender = clBtnLeft then begin
- Key := VK_PRIOR;
- KeyDown(Key, []);
- end else if Sender = clBtnRevert then begin
- Key := VK_ESCAPE;
- KeyDown(Key, []);
- end else if Sender = clBtnRight then begin
- Key := VK_NEXT;
- KeyDown(Key, []);
- end else if Sender = clBtnToday then begin
- Key := VK_BACK;
- KeyDown(Key, [ssAlt]);
- end else if Sender = clBtnNextYear then begin
- Key := VK_NEXT;
- KeyDown(Key, [ssCtrl]);
- end else if Sender = clBtnPrevYear then begin
- Key := VK_PRIOR;
- KeyDown(Key, [ssCtrl]);
- end;
-end;
-
-procedure TOvcCustomCalendar.calChangeMonth(Sender : TObject);
-var
- Y, M, D : Word;
- MO : Integer;
- MI : TMenuItem;
-begin
- MI := (Sender as TMenuItem);
- DecodeDate(FDate, Y, M, D);
- MO := MI.Tag;
- {set month and year}
- if (MO > M) and (MI.HelpContext < 3) then
- Dec(Y)
- else if (MO < M) and (MI.HelpContext > 3) then
- Inc(Y);
- M := M + MO;
- {set day}
- if D > DaysInMonth(MO, Y, 0) then
- D := DaysInMonth(MO, Y, 0);
- SetDate(calGetValidDate(EncodeDate(Y, MO, D)-1, +1));
- if (Assigned(FOnChange)) then
- FOnChange(Self, FDate);
-end;
-
-procedure TOvcCustomCalendar.calColorChange(Sender : TObject);
-begin
- Invalidate;
-end;
-
-function TOvcCustomCalendar.calGetCurrentRectangle : TRect;
- {-get bounding rectangle for the current date}
-var
- Idx : Integer;
- R, C : Integer;
-begin
- {index into the month grid}
- Idx := clFirst + Pred(clDay) + 13;
- R := (Idx div 7);
- C := (Idx mod 7);
- Result := clRowCol[R,C];
-end;
-
-{added}
-{Modified July 9, 2001}
-function TOvcCustomCalendar.calGetValidDate(ADate : TDateTime;
- Delta : Integer) : TDateTime;
-var
- I, X : Integer;
- Valid: Boolean;
- Fwd: Boolean;
-begin
- Valid := false;
- Fwd := false;
- X := Delta;
- I := 1;
- while not Valid and (I < 1000) do begin
- {If the date is valid then yay!}
- if (DoOnGetDateEnabled(ADate + (X * I))) then begin
- Valid := true;
- Fwd := True;
- end
- {otherwise check the other direction}
- else if (DoOnGetDateEnabled(ADate - (X * I))) then begin
- valid := true;
- end
- else Inc(I);
- end;
- if Valid then
- if Fwd then Result := ADate + (X * I)
- else Result := ADate - (X * I)
- else
- raise(Exception.Create(GetOrphStr(SCInvalidDate)));
-end;
-
-procedure TOvcCustomCalendar.calRebuildCalArray;
-var
- Day1 : TOvcDayType;
- I, J : Integer;
-begin
- HandleNeeded;
- DecodeDate(FDate, clYear, clMonth, clDay);
-
- {get the first day of the current month and year}
- Day1 := TOvcDayType(SysUtils.DayOfWeek(EncodeDate(clYear, clMonth, 1)) -1);
-
- {find its index}
- I := Byte(Day1) - Byte(WeekStarts) + 1;
- if I < 1 then
- Inc(I, 7);
- clFirst := I;
-
- {find the index of the last day in the month}
- clLast := clFirst + DaysInMonth(clMonth, clYear, 0) - 1;
-
- {initialize the first part of the calendar}
- if clMonth = 1 then
- J := DaysInMonth(12, clYear-1, 0)
- else
- J := DaysInMonth(clMonth-1, clYear, 0);
- for I := clFirst-1 downto 1 do begin
- clCalendar[I] := J;
- Dec(J);
- end;
-
- {initialize the rest of the calendar}
- J := 1;
- for I := clFirst to 49 do begin
- clCalendar[I] := J;
- if I = clLast then
- J := 1
- else
- Inc(J);
- end;
-end;
-
-procedure TOvcCustomCalendar.calRecalcSize;
- {-calcualte new sizes for rows and columns}
-var
- R : Integer;
- C : Integer;
- D1 : Integer;
- D2 : Integer;
- CH : Integer;
- RH : Integer;
- Row : array[0..8] of Integer;
- Col : array[0..6] of Integer;
-
- function SumOf(const A : array of Integer; First, Last : Integer) : Integer;
- var
- I : Integer;
- begin
- Result := 0;
- for I := First to Last do
- Result := Result + A[I];
- end;
-
-begin
- if not HandleAllocated then
- Exit;
-
- {clear row/col position structure}
- FillChar(clRowCol, SizeOf(clRowCol), #0);
-
- {set the way the buttons should look}
- clBtnLeft.Flat := not Ctl3D and not clPopup;
- clBtnRevert.Flat := not Ctl3D and not clPopup;
- clBtnRight.Flat := not Ctl3D and not clPopup;
- clBtnToday.Flat := not Ctl3D and not clPopup;
- clBtnNextYear.Flat := not Ctl3D and not clPopup;
- clBtnPrevYear.Flat := not Ctl3D and not clPopup;
-
- clBtnRevert.Visible := cdoShowRevert in FOptions;
- clBtnToday.Visible := cdoShowToday in FOptions;
- clBtnLeft.Visible := (cdoShowNavBtns in FOptions);
- clBtnRight.Visible := (cdoShowNavBtns in FOptions);
- clBtnNextYear.Visible := (cdoShowNavBtns in FOptions);
- clBtnPrevYear.Visible := (cdoShowNavBtns in FOptions);
-
- clWidth := ClientWidth - 2*calMargin;
- {store row and column sizes}
- for C := 0 to 6 do
- Col[C] := clWidth div 7;
-
- Canvas.Font := Font;
-(*
- Row[0] := Round(1.3 * Canvas.TextHeight('Yy')); {button and date row}
- Row[1] := Round(1.5 * Canvas.TextHeight('Yy'));; {day name row}
-*)
-
- if (DrawHeader) then begin
- {button and date row}
- Row[0] := Round(1.4 * Canvas.TextHeight('Yy'));
- {day name row}
- Row[1] := Round(1.5 * Canvas.TextHeight('Yy'))
- end else begin
- {button and date row}
- Row[0] := Round(1.3 * Canvas.TextHeight('Yy'));
- {day name row}
- Row[1] := 0;
- end;
-
- CH := ClientHeight - 2*calMargin - Row[0] - Row[1];
- RH := CH div 7;
- for R := 2 to 8 do
- Row[R] := RH;
-
- {distribute any odd horizontal space equally among the columns}
- for C := 0 to clWidth mod 7 do
- Inc(Col[C]);
-
- {distribute odd vertical space to top 2 rows}
- D1 := 0;
- for R := 0 to 8 do
- D1 := D1 + Row[R];
- D1 := ClientHeight - D1 - 2*calMargin;
- D2 := D1 div 2;
- D1 := D1 - D2;
- Row[0] := Row[0] + D1;
- if (DrawHeader) then
- Row[1] := Row[1] + D2;
-
- {initialize each cells TRect structure using}
- {the row heights from the Row[] array and the}
- {column widths from the Col[] array}
- for R := clStartRow to 7 do begin
- for C := 0 to 6 do begin
- clRowCol[R, C].Left := SumOf(Col, 0, C-1) + calMargin;
- clRowCol[R, C].Right := SumOf(Col, 0, C) + calMargin;
- clRowCol[R, C].Top := SumOf(Row, 0, R-1) + calMargin;
- clRowCol[R, C].Bottom := SumOf(Row, 0, R) + calMargin;
- end;
- end;
-
- {position and size the left and right month buttons}
- {position and size the next and prev year buttons}
- clBtnNextYear.Height := Row[0] - calMargin;
- clBtnNextYear.Width := Col[1] - calMargin;
- if clBtnNextYear.Width < clBtnNextYear.Glyph.Width + 3 then
- clBtnNextYear.Width := clBtnNextYear.Glyph.Width + 3;
- clBtnNextYear.Top := calMargin;
- clBtnNextYear.Left := ClientWidth - calMargin - clBtnNextYear.Width;
-
- clBtnPrevYear.Height := Row[0] - calMargin;
- clBtnPrevYear.Width := Col[5] - calMargin;
- if clBtnPrevYear.Width < clBtnPrevYear.Glyph.Width + 3 then
- clBtnPrevYear.Width := clBtnPrevYear.Glyph.Width + 3;
- clBtnPrevYear.Top := calMargin;
- clBtnPrevYear.Left := calMargin;
-
- clBtnLeft.Height := Row[0] - calMargin;
- clBtnLeft.Width := Col[0] - calMargin;
- if clBtnLeft.Width < clBtnLeft.Glyph.Width + 3 then
- clBtnLeft.Width := clBtnLeft.Glyph.Width + 3;
- clBtnLeft.Top := calMargin;
- clBtnLeft.Left := clBtnPrevYear.Left + clBtnPrevYear.Width;
-
- clBtnRight.Height := Row[0] - calMargin;
- clBtnRight.Width := Col[6] - calMargin;
- if clBtnRight.Width < clBtnRight.Glyph.Width + 3 then
- clBtnRight.Width := clBtnRight.Glyph.Width + 3;
- clBtnRight.Top := calMargin;
- clBtnRight.Left := clBtnNextYear.Left - clBtnRight.Width;
-
- {position and size "today" button}
- clBtnToday.Height := Row[8];
- clBtnToday.Width := Col[5] + Col[6] - calMargin;
- clBtnToday.Top := ClientHeight - calMargin - clBtnToday.Height + 1;
- clBtnToday.Left := ClientWidth - calMargin - clBtnToday.Width;
-
-
- {position and size "revert" button}
- clBtnRevert.Height := Row[8];
- clBtnRevert.Width := Col[5] + Col[6] - calMargin;
- clBtnRevert.Top := ClientHeight - calMargin - clBtnRevert.Height + 1;
- clBtnRevert.Left := clBtnToday.Left - clBtnRevert.Width - calMargin;
-end;
-
-{$IFNDEF LCL}
-procedure TOvcCustomCalendar.CMCtl3DChanged(var Msg : TMessage);
-begin
- inherited;
-
- if (csLoading in ComponentState) or not HandleAllocated then
- Exit;
-
- if NewStyleControls and (FBorderStyle = bsSingle) then
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
-
- calReCalcSize;
-
- Invalidate;
-end;
-{$ENDIF}
-
-procedure TOvcCustomCalendar.CMEnter(var Msg : TMessage);
-var
- R : TRect;
-begin
- inherited;
-
- clRevertDate := FDate;
-
- {invalidate the active date to ensure that the focus rect is painted}
- R := calGetCurrentRectangle;
- InvalidateRect(Handle, @R, False);
-end;
-
-procedure TOvcCustomCalendar.CMExit(var Msg : TMessage);
-var
- R : TRect;
-begin
- inherited;
-
- {invalidate the active date to ensure that the focus rect is painted}
- R := calGetCurrentRectangle;
- InvalidateRect(Handle, @R, False);
-end;
-
-procedure TOvcCustomCalendar.CMFontChanged(var Msg : TMessage);
-begin
- inherited;
-
- if csLoading in ComponentState then
- Exit;
-
- calRecalcSize;
- Invalidate;
-end;
-
-constructor TOvcCustomCalendar.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- ControlStyle := ControlStyle + [csClickEvents, csFramed] - [csCaptureMouse];
-
- Height := 140;
- TabStop := True;
- Width := 200;
-{$IFDEF MSWINDOWS}
- Font.Name := 'MS Sans Serif';
- Font.Size := 8;
-{$ELSE} //Size 8 doesn't convert in LCL to Height -11 as it should.
- Font.Name := 'Arial';
- Font.Height := -11;
-{$ENDIF}
-
-{$IFDEF LCL}
- FCtl3D := True;
-{$ENDIF}
- FBorderStyle := bsNone;
- FDayNameWidth := 3;
- FDateFormat := dfLong;
- FOptions := [cdoShortNames, cdoShowYear, cdoShowInactive,
- cdoShowRevert, cdoShowToday, cdoShowNavBtns];
- FWantDblClicks := True;
- FWeekStarts := dtSunday;
-
- {create navigation buttons}
- clBtnLeft := TSpeedButton.Create(Self);
- clBtnLeft.Parent := Self;
-{$IFNDEF LCL}
- clBtnLeft.Glyph.Handle := LoadBaseBitmap('ORLEFTARROW');
-{$ELSE}
- clBtnLeft.Glyph.LoadFromLazarusResource('ORLEFTARROW');
-{$ENDIF}
- clBtnLeft.OnClick := calBtnClick;
-
- clBtnRight := TSpeedButton.Create(Self);
- clBtnRight.Parent := Self;
-{$IFNDEF LCL}
- clBtnRight.Glyph.Handle := LoadBaseBitmap('ORRIGHTARROW');
-{$ELSE}
- clBtnRight.Glyph.LoadFromLazarusResource('ORRIGHTARROW');
-{$ENDIF}
- clBtnRight.OnClick := calBtnClick;
-
- clBtnNextYear := TSpeedButton.Create(Self);
- clBtnNextYear.Parent := Self;
-{$IFNDEF LCL}
- clBtnNextYear.Glyph.Handle := LoadBaseBitmap('ORRIGHTARROWS');
-{$ELSE}
- clBtnNextYear.Glyph.LoadFromLazarusResource('ORRIGHTARROWS');
-{$ENDIF}
- clBtnNextYear.OnClick := calBtnClick;
-
- clBtnPrevYear := TSpeedButton.Create(Self);
- clBtnPrevYear.Parent := Self;
-{$IFNDEF LCL}
- clBtnPrevYear.Glyph.Handle := LoadBaseBitmap('ORLEFTARROWS');
-{$ELSE}
- clBtnPrevYear.Glyph.LoadFromLazarusResource('ORLEFTARROWS');
-{$ENDIF}
- clBtnPrevYear.OnClick := calBtnClick;
-
- {create "revert" button}
- clBtnRevert := TSpeedButton.Create(Self);
- clBtnRevert.Parent := Self;
-{$IFNDEF LCL}
- clBtnRevert.Glyph.Handle := LoadBaseBitmap('ORREVERT');
-{$ELSE}
- clBtnRevert.Glyph.LoadFromLazarusResource('ORREVERT');
-{$ENDIF}
- clBtnRevert.OnClick := calBtnClick;
-
- {create "today" button}
- clBtnToday := TSpeedButton.Create(Self);
- clBtnToday.Parent := Self;
-{$IFNDEF LCL}
- clBtnToday.Glyph.Handle := LoadBaseBitmap('ORTODAY');
-{$ELSE}
- clBtnToday.Glyph.LoadFromLazarusResource('ORTODAY');
-{$ENDIF}
- clBtnToday.OnClick := calBtnClick;
-
- {assign default color scheme}
- FColors := TOvcCalColors.Create;
- FColors.OnChange := calColorChange;
- FColors.FCalColors := CalScheme[cscalWindows];
-
- {assign default international support object}
- FIntlSup := OvcIntlSup;
-
- FDrawHeader:= True;
- clRowCount := 8;
- clStartRow := 0;
-end;
-
-constructor TOvcCustomCalendar.CreateEx(AOwner : TComponent; AsPopup : Boolean);
-begin
- clPopup := AsPopup;
- Create(AOwner);
-end;
-
-procedure TOvcCustomCalendar.CreateParams(var Params : TCreateParams);
-const
- BorderStyles : array[TBorderStyle] of LongInt = (0, WS_BORDER);
-begin
- inherited CreateParams(Params);
-
- with Params do begin
- Style := LongInt(Style) or BorderStyles[FBorderStyle];
- if clPopup then begin
- Style := WS_POPUP or WS_BORDER;
- WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
- end;
- end;
-
- if NewStyleControls and (Ctl3D or clPopup) and (FBorderStyle = bsSingle) then begin
- if not clPopup then
- Params.Style := Params.Style and not WS_BORDER;
- Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
- end;
-
-{$IFDEF LCL}
- inherited SetBorderStyle(FBorderStyle);
-{$ENDIF}
-
- {set style to reflect desire for double clicks}
- if FWantDblClicks then
- ControlStyle := ControlStyle + [csDoubleClicks]
- else
- ControlStyle := ControlStyle - [csDoubleClicks];
-
- {get windows date mask}
- FIntlSup.InternationalLongDatePChar(clMask, cdoShortNames in FOptions, False);
-end;
-
-procedure TOvcCustomCalendar.CreateWnd;
-begin
- inherited CreateWnd;
-
- calRecalcSize;
-
- {if not set, get current date}
- if FDate = 0 then
- SetDate(calGetValidDate(SysUtils.Date-1, +1));
-end;
-
-destructor TOvcCustomCalendar.Destroy;
-begin
- FColors.Free;
- FColors := nil;
-
- inherited Destroy;
-end;
-
-function TOvcCustomCalendar.DateString(const Mask : string): string;
-var
- M : string;
-begin
- M := Mask;
- if Length(M) = 0 then
- M := StrPas(clMask);
-
- {convert calendar month and year to a string}
- Result := FIntlSup.DateToDateString(M, DateTimeToStDate(FDate), True);
-end;
-
-function TOvcCustomCalendar.DayString: string;
-begin
- Result := IntlSupport.DayOfWeekToString(DayOfWeek(DateTimeToStDate(FDate)));
-end;
-
-procedure TOvcCustomCalendar.DoOnChange(Value : TDateTime);
-begin
- if Assigned(FOnChange) then
- FOnChange(Self, Value);
-end;
-
-
-function TOvcCustomCalendar.DoOnGetDateEnabled(ADate : TDateTime) : Boolean;
-begin
- Result := True;
- if Assigned(FOnGetDateEnabled) then
- FOnGetDateEnabled(Self, ADate, Result);
-end;
-
-procedure TOvcCustomCalendar.DoOnMouseWheel(Shift : TShiftState; Delta, XPos, YPos : SmallInt);
-var
- Key : Word;
-begin
- inherited DoOnMouseWheel(Shift, Delta, XPos, YPos);
-
- if Abs(Delta) = WHEEL_DELTA then begin
- {inc/dec month}
- if Delta < 0 then
- Key := VK_NEXT
- else
- Key := VK_PRIOR;
- KeyDown(Key, []);
- end else if Abs(Delta) > WHEEL_DELTA then begin
- {inc/dec year}
- if Delta < 0 then
- Key := VK_NEXT
- else
- Key := VK_PRIOR;
- KeyDown(Key, [ssCtrl]);
- end else if Abs(Delta) < WHEEL_DELTA then begin
- {inc/dec Week}
- if Delta < 0 then
- Key := VK_DOWN
- else
- Key := VK_UP;
- KeyDown(Key, []);
- end;
-end;
-
-function TOvcCustomCalendar.GetAsDateTime : TDateTime;
-begin
- Result := FDate;
-end;
-
-function TOvcCustomCalendar.GetAsStDate : TStDate;
-begin
- Result := DateTimeToStDate(FDate)
-end;
-
-function TOvcCustomCalendar.IsReadOnly : Boolean;
-begin
- Result := ReadOnly;
-end;
-
- {revised}
-procedure TOvcCustomCalendar.KeyDown(var Key : Word; Shift : TShiftState);
-var
- Y : Word;
- M : Word;
- D : Word;
- HD : TDateTime;
-
-begin
- inherited KeyDown(Key, Shift);
-
- if IsReadOnly then
- Exit;
-
- HD := FDate;
- case Key of
- VK_LEFT : if Shift = [] then
- SetDate(calGetValidDate(FDate, -1));
- VK_RIGHT : if Shift = [] then
- SetDate(calGetValidDate(FDate, +1));
- VK_UP : if Shift = [] then
- SetDate(calGetValidDate(FDate, -7));
- VK_DOWN : if Shift = [] then
- SetDate(calGetValidDate(FDate, +7));
- VK_HOME :
- begin
- if ssCtrl in Shift then begin
- DecodeDate(FDate, Y, M, D);
- SetDate(calGetValidDate(EncodeDate(Y, 1, 1)-1, +1));
- end else if Shift = [] then begin
- DecodeDate(FDate, Y, M, D);
- SetDate(calGetValidDate(EncodeDate(Y, M, 1)-1, +1));
- end;
- end;
- VK_END :
- begin
- if ssCtrl in Shift then begin
- DecodeDate(FDate, Y, M, D);
- SetDate(calGetValidDate(EncodeDate(Y, 12, DaysInMonth(12, Y, 0))+1, -1));
- end else if Shift = [] then begin
- DecodeDate(FDate, Y, M, D);
- SetDate(calGetValidDate(EncodeDate(Y, M, DaysInMonth(M, Y, 0))+1, -1));
- end;
- end;
- VK_PRIOR :
- begin
- if ssCtrl in Shift then begin
- IncYear(-1);
- end else if Shift = [] then begin
- IncMonth(-1);
- end;
- end;
- VK_NEXT :
- begin
- if ssCtrl in Shift then begin
- IncYear(1);
- end else if Shift = [] then begin
- IncMonth(1);
- end;
- end;
- VK_BACK :
- begin
- if ssAlt in Shift then
- SetDate(calGetValidDate(SysUtils.Date-1, +1));
- end;
- VK_ESCAPE:
- begin
- if Shift = [] then
- SetDate(calGetValidDate(clRevertDate-1, +1));
- end;
- end;
-
- if HD <> FDate then begin
- FBrowsing := True;
- try
- DoOnChange(FDate);
- finally
- FBrowsing := False;
- end;
- end;
-end;
-
-procedure TOvcCustomCalendar.KeyPress(var Key : Char);
-begin
- inherited KeyPress(Key);
-
- if IsReadOnly then
- Exit;
-
- case Key of
- '+' : SetDate(calGetValidDate(FDate, +1));
- '-' : SetDate(calGetValidDate(FDate, -1));
- #13 : DoOnChange(FDate); {date selected}
- #32 : DoOnChange(FDate); {date selected}
- ^Z : SetDate(calGetValidDate(SysUtils.Date-1, +1));
- end;
-end;
-
-procedure TOvcCustomCalendar.MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
-var
- Yr : Word;
- M : Word;
- D : Word;
- Yr2 : Word;
- M2 : Word;
- D2 : Word;
- R, C : Integer;
- OldIdx : Integer;
- NewIdx : Integer;
- Re : TRect;
- Ignore : Boolean;
-begin
- {exit if this click happens when the popup menu is active}
- if clInPopup then
- Exit;
-
- SetFocus;
-
- inherited MouseDown(Button, Shift, X, Y);
-
- if IsReadOnly then
- Exit;
-
- {if we have the mouse captured, see if a button was clicked}
- if GetCapture = Handle then begin
- if (cdoShowNavBtns in Options) then begin
- Re := clBtnLeft.ClientRect;
- Re.TopLeft := ScreenToClient(clBtnLeft.ClientToScreen(Re.TopLeft));
- Re.BottomRight := ScreenToClient(clBtnLeft.ClientToScreen(Re.BottomRight));
- if PtInRect(Re, Point(X, Y)) then begin
- clBtnLeft.Click;
- Exit;
- end;
-
-
- Re := clBtnRight.ClientRect;
- Re.TopLeft := ScreenToClient(clBtnRight.ClientToScreen(Re.TopLeft));
- Re.BottomRight := ScreenToClient(clBtnRight.ClientToScreen(Re.BottomRight));
- if PtInRect(Re, Point(X, Y)) then begin
- clBtnRight.Click;
- Exit;
- end;
-
- Re := clBtnNextYear.ClientRect;
- Re.TopLeft := ScreenToClient(clBtnNextYear.ClientToScreen(Re.TopLeft));
- Re.BottomRight := ScreenToClient(clBtnNextYear.ClientToScreen(Re.BottomRight));
- if PtInRect(Re, Point(X, Y)) then begin
- clBtnNextYear.Click;
- Exit;
- end;
-
- Re := clBtnPrevYear.ClientRect;
- Re.TopLeft := ScreenToClient(clBtnPrevYear.ClientToScreen(Re.TopLeft));
- Re.BottomRight := ScreenToClient(clBtnPrevYear.ClientToScreen(Re.BottomRight));
- if PtInRect(Re, Point(X, Y)) then begin
- clBtnPrevYear.Click;
- Exit;
- end;
- end;
-
- if (cdoShowRevert in Options) then begin
- Re := clBtnRevert.ClientRect;
- Re.TopLeft := ScreenToClient(clBtnRevert.ClientToScreen(Re.TopLeft));
- Re.BottomRight := ScreenToClient(clBtnRevert.ClientToScreen(Re.BottomRight));
- if PtInRect(Re, Point(X, Y)) then begin
- clBtnRevert.Click;
- Exit;
- end;
- end;
-
- if (cdoShowToday in Options) then begin
- Re := clBtnToday.ClientRect;
- Re.TopLeft := ScreenToClient(clBtnToday.ClientToScreen(Re.TopLeft));
- Re.BottomRight := ScreenToClient(clBtnToday.ClientToScreen(Re.BottomRight));
- if PtInRect(Re, Point(X, Y)) then begin
- clBtnToday.Click;
- Exit;
- end;
- end;
- end;
-
- {save current date}
- DecodeDate(FDate, Yr, M, D);
- M2 := M;
-
- {calculate the row and column clicked on}
- for R := 2 to 8 do begin
- for C := 0 to 6 do begin
- if PtInRect(clRowCol[R,C], Point(X, Y)) then begin
- {convert to an index}
- NewIdx := ((R-2) * 7) + Succ(C);
- OldIdx := clFirst + Pred(clDay);
- Ignore := False;
- if NewIdx <> OldIdx then begin
-
- {see if this date is disabled - selection not allowed}
- if not DoOnGetDateEnabled(FDate+(NewIdx-OldIdx)) then
- Break;
-
- DecodeDate(FDate+(NewIdx-OldIdx), Yr2, M2, D2);
- if not (cdoShowInactive in FOptions) then begin
- {will this change the month?}
- if M2 <> M then
- Ignore := True;
- end;
- {convert to a date and redraw}
- if not Ignore then
- SetDate(FDate+(NewIdx-OldIdx));
- end;
-
- if (not Ignore) and (Button = mbLeft) then begin
- if M2 <> M then begin
- FBrowsing := True;
- try
- DoOnChange(FDate);
- finally
- FBrowsing := False;
- end;
- end else
- DoOnChange(FDate);
- end;
-
- Break;
- end;
- end;
- end;
-end;
-
-procedure TOvcCustomCalendar.MouseUp(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
-var
- P : TPoint;
- M : TPopUpMenu;
- MI : TMenuItem;
- I : Integer;
- J : Integer;
- K : Integer;
- MO : Integer;
- YR : Word;
- MM : Word;
- DA : Word;
- HC : Boolean;
-begin
- inherited MouseUp(Button, Shift, X, Y);
-
- if (PopUpMenu = nil) and (Button = mbRight) and
- (Y < clRowCol[1,0].Top) {above day names} and
- (X > clBtnPrevYear.Left + clBtnNextYear.Width) and
- (X < clBtnNextYear.Left) then begin
-
- if not Focused and CanFocus then
- SetFocus;
-
- M := TPopupMenu.Create(Self);
- try
- DecodeDate(FDate, YR, MM, DA);
- MO := MM; {convert to integer to avoid wrap-around errors with words}
-
- {determine the starting month}
- I := MO - 3;
- if I < 1 then
- I := MO - 3 + 12;
-
- {determine the ending month + 1}
- J := MO + 4;
- if J > 12 then
- J := MO + 4 - 12;
-
- K := 0;
- {create the menu items}
- repeat
- MI := TMenuItem.Create(M);
- MI.Caption := LongMonthNames[I];
- MI.Enabled := Enabled;
- MI.OnClick := calChangeMonth;
- MI.Tag := I;
- MI.HelpContext := K;
- M.Items.Add(MI);
- Inc(I);
- Inc(K);
- if I > 12 then
- I := 1;
- until I = J;
-
- HC := GetCapture = Handle;
-
- P.X := X-20;
- P.Y := Y - ((GetSystemMetrics(SM_CYMENU)*7) div 2);
- P := ClientToScreen(P);
- {move the mouse to cause the menu item to highlight}
- PostMessage(Handle, WM_MOUSEMOVE, 0, MAKELONG(P.X,P.Y+1));
-
- clInPopup := True;
- try
- M.PopUp(P.X, P.Y);
-
- Application.ProcessMessages;
-
- {capture the mouse again}
- if clPopup and HC then
- SetCapture(Handle);
- finally
- clInPopup := false;
- end;
- finally
- M.Free;
- end;
- end;
-end;
-
-procedure TOvcCustomCalendar.IncDay(Delta : Integer);
- {-change the day by Delta (signed) days}
-begin
- if Delta > 0 then
- SetDate(calGetValidDate(FDate+Delta-1, +1))
- else
- SetDate(calGetValidDate(FDate+Delta+1, -1))
-end;
-
-
-procedure TOvcCustomCalendar.IncMonth(Delta : Integer);
- {-change the month by Delta (signed) months}
-var
- Y, M, D : Word;
- iY, iM, iD : Integer;
-begin
- DecodeDate(FDate, Y, M, D);
- iY := Y; iM := M; iD := D;
- Inc(iM, Delta);
- if iM > 12 then begin
- iM := iM - 12;
- Inc(iY);
- end else if iM < 1 then begin
- iM := iM + 12;
- Dec(iY);
- end;
- if iD > DaysInMonth(iM, iY, 0) then
- iD := DaysInMonth(iM, iY, 0);
-
- SetDate(calGetValidDate(EncodeDate(iY, iM, iD)-1, +1));
-end;
-
-
-procedure TOvcCustomCalendar.IncYear(Delta : Integer);
-var
- Y, M, D : Word;
- iY, iM, iD : Integer;
-begin
- DecodeDate(FDate, Y, M, D);
- iY := Y; iM := M; iD := D;
- Inc(iY, Delta);
- if iD > DaysInMonth(iM, iY, 0) then
- iD := DaysInMonth(iM, iY, 0);
- SetDate(calGetValidDate(EncodeDate(iY, iM, iD)-1, +1));
-end;
-
-function TOvcCustomCalendar.MonthString: string;
-var
- M, D, Y : Word;
-begin
- DecodeDate(FDate, Y, M, D);
- Result := IntlSupport.MonthToString(M);
-end;
-
-procedure TOvcCustomCalendar.Paint;
-var
- R, C : Integer;
- I : Integer;
- {CurIndex : Integer;}
- SatCol : Integer;
- SunCol : Integer;
- DOW : TOvcDayType;
-
- procedure DrawDate;
- var
- R : TRect;
- S : string;
- begin
- if FDateFormat = dfLong then
- if cdoShowYear in FOptions then
- S := FormatDateTime('mmmm yyyy', FDate)
- else
- S := FormatDateTime('mmmm', FDate)
- else
- if cdoShowYear in FOptions then
- S := FormatDateTime('mmm yyyy', FDate)
- else
- S := FormatDateTime('mmm', FDate);
-
- R := clRowCol[0,1];
- R.Right := clRowCol[0,6].Left;
-
- {switch to short date format if string won't fit}
- if FDateFormat = dfLong then
- if Canvas.TextWidth(S) > R.Right-R.Left then
- S := FormatDateTime('mmm yyyy', FDate);
-
-{$IFDEF LCL}
- S := SysToUTF8(S); //DrawText expects UTF8 with most widgetsets
-{$ENDIF}
-
- Canvas.Font.Color := FColors.MonthAndYear;
- if Assigned(FOnDrawDate) then
- FOnDrawDate(Self, FDate, R)
- else
- DrawText(Canvas.Handle, @S[1], Length(S), R, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
- end;
-
- procedure DrawDayNames;
- var
- I : Integer;
- S : string[3];
- begin
- {draw the day name column labels}
- Canvas.Font.Color := FColors.DayNames;
- I := 0;
- DOW := FWeekStarts;
- repeat
- {record columns for weekends}
- if DOW = dtSaturday then
- SatCol := I;
- if DOW = dtSunday then
- SunCol := I;
-
- {get the day name}
- S := Copy(ShortDayNames[Ord(DOW)+1], 1, FDayNameWidth);
-
-{$IFDEF LCL}
- S := SysToUTF8(S);
-{$ENDIF}
-
- {draw the day name above each column}
- DrawText(Canvas.Handle, @S[1], Length(S), clRowCol[1,I],
- DT_SINGLELINE or DT_CENTER or DT_VCENTER);
-
- Inc(I);
- if DOW < High(DOW) then
- Inc(DOW)
- else
- DOW := Low(DOW);
- until DOW = WeekStarts;
- end;
-
- procedure DrawLine;
- begin
- if Ctl3D then begin
- Canvas.Pen.Color := clBtnHighlight;
- Canvas.MoveTo(0, clRowCol[1,0].Bottom-3);
- Canvas.LineTo(ClientWidth, clRowCol[1,0].Bottom-3);
- Canvas.Pen.Color := clBtnShadow;
- Canvas.MoveTo(0, clRowCol[1,0].Bottom-2);
- Canvas.LineTo(ClientWidth, clRowCol[1,0].Bottom-2);
- end else if BorderStyle = bsSingle then begin
- Canvas.Pen.Color := Font.Color;
- Canvas.MoveTo(0, clRowCol[1,0].Bottom-3);
- Canvas.LineTo(ClientWidth, clRowCol[1,0].Bottom-3);
- end;
- end;
-
- procedure DrawDay(R, C, I : Integer; Grayed{, Current} : Boolean);
- var
- Cl : TColor;
- OldIdx : Integer;
- NewIdx : Integer;
- S : string[10];
- begin
-
- {avoid painting day number under buttons}
- if cdoShowRevert in FOptions then
- if (R = 8) {bottom} and (C >= 3) then
- Exit;
- if cdoShowToday in FOptions then
- if (R = 8) {bottom} and (C >= 5) then
- Exit;
-
- {convert to a string and draw it centered in its rectangle}
- S := IntToStr(clCalendar[I]);
-
- if Grayed then
- Canvas.Font.Color := FColors.InactiveDays;
-
- if not Grayed or (cdoShowInactive in FOptions) then begin
- NewIdx := ((R-2) * 7) + Succ(C);
- OldIdx := clFirst + Pred(clDay);
- if Assigned(FOnGetHighlight) then begin
- Cl := Canvas.Font.Color;
- FOnGetHighlight(Self, FDate+(NewIdx-OldIdx), Cl);
- Canvas.Font.Color := Cl;
- end;
-{$IFDEF LCL}
- S := SysToUTF8(S);
-{$ENDIF}
- if Assigned(FOnDrawItem) then
- FOnDrawItem(Self, FDate+(NewIdx-OldIdx), clRowCol[R,C])
- else
- DrawText(Canvas.Handle, @S[1], Length(S), clRowCol[R,C], DT_SINGLELINE or DT_CENTER or DT_VCENTER);
- end;
- end;
-
- procedure DrawFocusBox;
- var
- R : TRect;
- S : string[10];
- BS : TButtonStyle;
- begin
- S := IntToStr(clDay);
- if Ctl3D then
- BS := bsNew
- else
- BS := bsWin31;
- if Focused then
- R := DrawButtonFace(Canvas, calGetCurrentRectangle, 1, BS, True, True, False)
- else
- R := DrawButtonFace(Canvas, calGetCurrentRectangle, 1, BS, True, False, False);
-{$IFDEF LCL}
- S := SysToUTF8(S);
-{$ENDIF}
- DrawText(Canvas.Handle, @S[1], Length(S), R, DT_CENTER or DT_VCENTER or DT_SINGLELINE);
- end;
-
-begin
- Canvas.Font := Font;
- Canvas.Brush.Color := Color;{clBtnFace;}
- Canvas.FillRect(ClientRect);
-
- {draw the month and year at the top of the calendar}
- DrawDate;
-
- {draw the days of the week}
- DrawDayNames;
-
- {draw line under day names}
- DrawLine;
-
- {draw each day}
- {CurIndex := clFirst + Pred(clDay);}
- I := 1;
- for R := 2 to 8 do
- for C := 0 to 6 do begin
- if (C = SatCol) or (C = SunCol) then
- Canvas.Font.Color := FColors.WeekEnd
- else
- Canvas.Font.Color := FColors.Days;
- DrawDay(R, C, I, (I < clFirst) or (I > clLast){, I = CurIndex});
- Inc(I);
- end;
-
- Canvas.Font.Color := FColors.ActiveDay;
- if not Assigned(FOnDrawItem) then
- if not (cdoHideActive in FOptions) then
- DrawFocusBox;
-end;
-
-function TOvcCustomCalendar.GetCalendarDate : TDateTime;
-begin
- Result := FDate;
-end;
-
-function TOvcCustomCalendar.GetDay : Integer;
-begin
- Result := clDay;
-end;
-
-function TOvcCustomCalendar.GetMonth : Integer;
-begin
- Result := clMonth;
-end;
-
-function TOvcCustomCalendar.GetYear : Integer;
-begin
- Result := clYear;
-end;
-
-procedure TOvcCustomCalendar.SetAsDateTime(Value : TDateTime);
-begin
- SetDate(calGetValidDate(Value-1, +1));
-end;
-
-procedure TOvcCustomCalendar.SetAsStDate(Value : TStDate);
-begin
- SetDate(calGetValidDate(StDateToDateTime(Value)-1, +1));
-end;
-
-procedure TOvcCustomCalendar.SetBorderStyle(Value : TBorderStyle);
-begin
- if Value <> FBorderStyle then begin
- FBorderStyle := Value;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
-end;
-
-procedure TOvcCustomCalendar.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
-begin
- inherited Setbounds(ALeft, ATop, AWidth, AHeight);
-
- if csLoading in ComponentState then
- Exit;
-
- calRecalcSize;
-end;
-
-procedure TOvcCustomCalendar.SetCalendarDate(Value : TDateTime);
-var
- NewDate : TStDate;
-begin
- NewDate := DateTimeToStDate(Value);
- if (NewDate = BadDate) or (NewDate = CalendarDate) or
- (IncDateTrunc(NewDate, 1, 0) = BadDate) or
- (IncDateTrunc(NewDate, -1, 0) = BadDate) then begin
- Exit;
- end;
- SetDate(calGetValidDate(Value-1, +1));
-end;
-
-procedure TOvcCustomCalendar.SetDate(Value : TDateTime);
-var
- R : TRect;
- Y : Word;
- M : Word;
- D : Word;
-begin
- if Value <> FDate then begin
- {determine if the new date is in the same month}
- DecodeDate(Value, Y, M, D);
- if (clYear = Y) and (clMonth = M) then begin
- {invalidate the old date}
- R := calGetCurrentRectangle;
- InvalidateRect(Handle, @R, False);
- end else
- Invalidate;
-
- DecodeDate(Value, clYear, clMonth, clDay);
- FDate := Value;
- calRebuildCalArray;
-
- {invalidate the new date}
- R := calGetCurrentRectangle;
- InvalidateRect(Handle, @R, False);
- end;
-end;
-
-procedure TOvcCustomCalendar.SetDateFormat(Value : TOvcDateFormat);
-begin
- if Value <> FDateFormat then begin
- FDateFormat := Value;
- Invalidate;
- end;
-end;
-
-procedure TOvcCustomCalendar.SetDayNameWidth(Value : TOvcDayNameWidth);
-begin
- if Value <> FDayNameWidth then begin
- FDayNameWidth := Value;
- Invalidate;
- end;
-end;
-
-procedure TOvcCustomCalendar.SetDisplayOptions(Value : TOvcCalDisplayOptions);
-begin
- if Value <> FOptions then begin
- FOptions := Value;
- calRecalcSize;
- Invalidate;
- end;
-end;
-
-procedure TOvcCustomCalendar.SetDrawHeader(Value : Boolean);
- {-set the DrawHeader property value}
-begin
- if Value <> FDrawHeader then begin
- FDrawHeader := Value;
- if FDrawHeader then begin
- clStartRow := 0;
- clRowCount := 8;
- end else begin
- clStartRow := 2;
- clRowCount := 7;
- end;
- calRecalcSize;
- Refresh;
- end;
-end;
-
-procedure TOvcCustomCalendar.SetIntlSupport(Value : TOvcIntlSup);
- {-set the international support object this field will use}
-begin
- if Assigned(Value) then
- FIntlSup := Value
- else
- FIntlSup := OvcIntlSup;
-end;
-
-procedure TOvcCustomCalendar.SetToday;
- {-set the calendar to todays date}
-begin
- SetDate(calGetValidDate(SysUtils.Date-1, +1));
-end;
-
-procedure TOvcCustomCalendar.SetWantDblClicks(Value : Boolean);
-begin
- if Value <> FWantDblClicks then begin
- FWantDblClicks := Value;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
-end;
-
-procedure TOvcCustomCalendar.SetWeekStarts(Value : TOvcDayType);
-begin
- if Value <> FWeekStarts then begin
- FWeekStarts := Value;
- if csLoading in ComponentState then
- Exit;
- calRebuildCalArray;
- Invalidate;
- end;
-end;
-
-procedure TOvcCustomCalendar.WMEraseBkgnd(var Msg : TWMEraseBkgnd);
-begin
- Msg.Result := 1; {don't erase background, just say we did}
-end;
-
-procedure TOvcCustomCalendar.WMGetDlgCode(var Msg : TWMGetDlgCode);
-begin
- Msg.Result := DLGC_WANTARROWS;
-end;
-
-procedure TOvcCustomCalendar.WMKillFocus(var Msg : TWMKillFocus);
-begin
- inherited;
-
- Invalidate;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovccalc.pas b/Source/3rdParty/Orpheus/ovccalc.pas
deleted file mode 100644
index b51fb4e3..00000000
--- a/Source/3rdParty/Orpheus/ovccalc.pas
+++ /dev/null
@@ -1,2705 +0,0 @@
-{*********************************************************}
-{* OVCCALC.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 ovccalc;
- {-calculator component}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, Types, LclType, GraphType, MyMisc, {$ENDIF}
- Buttons, Classes, ClipBrd, Controls, ExtCtrls, Forms, Graphics,
- Menus, StdCtrls, SysUtils,
- OvcData, OvcConst, OvcBase, OvcMisc;
-
-type
- TOvcCalculatorButton = (
- cbNone, cbTape, cbBack, cbClearEntry, cbClear, cbAdd, cbSub, cbMul, cbDiv,
- cb0, cb1, cb2, cb3, cb4, cb5, cb6, cb7, cb8, cb9,
- cbDecimal, cbEqual, cbInvert, cbChangeSign, cbPercent, cbSqrt,
- cbMemClear, cbMemRecall, cbMemStore, cbMemAdd, cbMemSub, cbSubTotal);
-
- TOvcButtonInfo = packed record
- Position : TRect; {position and size}
- Caption : string[10]; {button text}
- Visible : Boolean; {true to display button}
- end;
-
- TOvcButtonArray = array[cbTape..cbMemSub] of TOvcButtonInfo;
-
-type
- TOvcCalculatorOperation = (
- coNone, coAdd, coSub, coMul, coDiv,
- coEqual, coInvert, coPercent, coSqrt,
- coMemClear, coMemRecall, coMemStore, coMemAdd, coMemSub, coSubTotal);
-
- TOvcCalcState = (csValid, csLocked, csClear);
- TOvcCalcStates = set of TOvcCalcState;
-
-type
- TOvcCalcColorArray = array[0..7] of TColor;
- TOvcCalcColorScheme = (cscalcCustom, cscalcWindows, cscalcDark,
- cscalcOcean, cscalcPlain);
- TOvcCalcSchemeArray = array[TOvcCalcColorScheme] of TOvcCalcColorArray;
- TOvcCalcDisplayString = array[TOvcCalculatorButton] of string;
- TOvcCalcButtonToOperation = array[cbNone..cbSubTotal] of TOvcCalculatorOperation;
-
-
-const
- {DisabledMemoryButtons, Display, DisplayTextColor, EditButtons,
- FunctionButtons, MemoryButtons, NumberButtons, OperatorButtons}
- CalcScheme : TOvcCalcSchemeArray =
- ((0, 0, 0, 0, 0, 0, 0, 0),
- (clGray, clWindow, clWindowText, clMaroon, clNavy, clRed, clBlue, clRed),
- (clGray, clBlack, clAqua, clBlack, clTeal, clNavy, clMaroon, clBlue),
- (clGray, clAqua, clBlack, clPurple, clNavy, clNavy, clAqua, clBlue),
- (clGray, clWhite, clNavy, clBlack, clNavy, clNavy, clBlue, clBlue)
- );
-{ You must set the Length of the first entry (cbNone) to the Length of the largest entry}
- CalcDisplayString : TOvcCalcDisplayString =
- (' ',' ',' ','CE','C' ,'+' ,'-' ,'*' ,'/',
- ' ',' ',' ',' ',' ',' ',' ',' ',' ',' ',
- ' ','=' ,'1/','-+','%' ,'SQ',
- 'MC','MR','MS','M+','M-','*' );
-
- CalcButtontoOperation : TOvcCalcButtonToOperation =
- (coNone, coNone, coNone, coNone, coNone, coAdd, coSub, coMul, coDiv,
- coNone, coNone, coNone, coNone, coNone, coNone, coNone, coNone, coNone, coNone,
- coNone, coEqual, coInvert, coNone, coPercent, coSqrt,
- coMemClear, coMemRecall, coMemStore, coMemAdd, coMemSub, coSubTotal);
-
-type
- TOvcCalcColors = class(TPersistent)
- {.Z+}
- private
- {property variables}
- FUpdating : Boolean;
- FOnChange : TNotifyEvent;
-
- {internal variables}
- SettingScheme : Boolean;
-
- {internal methods}
- procedure DoOnChange;
-
- {property methods}
- function GetColor(const Index : Integer) : TColor;
- procedure SetColor(const Index : Integer; const Value : TColor);
- procedure SetColorScheme(const Value : TOvcCalcColorScheme);
- procedure SetDisplayTextColor(const Value : TColor);
-
- public
- {property variables}
- FCalcColors : TOvcCalcColorArray;
- FColorScheme : TOvcCalcColorScheme;
-
- procedure Assign(Source : TPersistent);
- override;
- procedure BeginUpdate;
- procedure EndUpdate;
-
- property OnChange : TNotifyEvent
- read FOnChange write FOnChange;
- {.Z-}
-
- published
- property ColorScheme : TOvcCalcColorScheme
- read FColorScheme write SetColorScheme;
- property DisabledMemoryButtons : TColor index 0
- read GetColor write SetColor;
- property Display : TColor index 1
- read GetColor write SetColor;
- property DisplayTextColor : TColor
- read FCalcColors[2] write SetDisplayTextColor nodefault;
- property EditButtons : TColor index 3
- read GetColor write SetColor;
- property FunctionButtons : TColor index 4
- read GetColor write SetColor;
- property MemoryButtons : TColor index 5
- read GetColor write SetColor;
- property NumberButtons : TColor index 6
- read GetColor write SetColor;
- property OperatorButtons : TColor index 7
- read GetColor write SetColor;
- end;
-
-type
- {.Z+}
- TOvcCalcPanel = class(TPanel)
- protected
- procedure Click;
- override;
- public
- end;
- {.Z-}
-
-type
- {.Z+}
- TOvcCustomCalculatorEngine = class
- protected {private}
- {property variables}
- FDecimals : Integer;
- FShowSeparatePercent : Boolean;
-
- {internal variables}
- cCalculated : Extended;
- cLastOperation : TOvcCalculatorOperation;
- cOperationCount : Integer;
- cMemory : Extended; {value stored in memory register}
- cOperands : array [0..3] of Extended; {the operand stack}
- cState : TOvcCalcStates;
-
- public
- function AddOperand(const Value : Extended; const Button : TOvcCalculatorOperation) : Boolean;
- virtual; abstract;
- function AddOperation(const Button : TOvcCalculatorOperation) : Boolean;
- virtual; abstract;
- procedure ClearAll;
- procedure PushOperand(const Value : Extended);
- function PopOperand : Extended;
- function TopOperand : Extended;
-
- {public properties}
- property Decimals : Integer
- read FDecimals write FDecimals;
- property LastOperation : TOvcCalculatorOperation
- read cLastOperation write cLastOperation;
- property Memory : Extended
- read cMemory write cMemory;
- property OperationCount : Integer
- read cOperationCount write cOperationCount;
- property ShowSeparatePercent : Boolean
- read FShowSeparatePercent write FShowSeparatePercent;
- property State : TOvcCalcStates
- read cState write cState;
- end;
- {.Z-}
-
-type
- {.Z+}
- TOvcCalcTape = class(TObject)
- protected {private}
- {property variables}
- FMaxPaperCount : Integer;
- FShowTape : Boolean;
- FTapeDisplaySpace : Integer;
- FVisible : Boolean;
-
- {internal variables}
- taListBox : TListBox;
- taTapeColor : TColor;
- taHeight : Integer;
- taOwner : TComponent;
- taOperandSize : Integer;
- taFont : TFont;
- taMaxTapeCount : Integer;
- taTapeInitialized : Boolean;
- taWidth : Integer;
-
- procedure ValidateListBox;
- function GetFont : TFont;
- procedure SetFont(const Value : TFont);
- function GetHeight : Integer;
- procedure SetHeight(const Value : Integer);
- function GetTape : TStrings;
- procedure SetTape(const Value : TStrings);
- function GetTapeColor : TColor;
- procedure SetTapeColor(const Value : TColor);
- function GetTop : Integer;
- procedure SetTop(const Value : Integer);
- function GetTopIndex : Integer;
- procedure SetTopIndex(const Value : Integer);
- function GetVisible : Boolean;
- procedure SetVisible(const Value : Boolean);
- function GetWidth : Integer;
- procedure SetWidth(const Value : Integer);
-
- protected
- procedure Add(const Value : string);
- procedure DeleteFirst;
- procedure taOnClick(Sender : TObject);
- procedure taOnDblClick(Sender : TObject);
- procedure taOnDrawItem(Control: TWinControl; Index: Integer;
- Rect:TRect;State: TOwnerDrawState);
- procedure taTapeFontChange(Sender : TObject);
-
- public
- constructor Create(const AOwner : TComponent; const AOperandSize : Integer);
- destructor Destroy;
- override;
-
- procedure InitializeTape;
- procedure SetBounds(const ALeft, ATop, AWidth, AHeight : Integer);
- function GetDisplayedItemCount : Integer;
- procedure AddToTape(const Value : string;
- const OpString : string);
- procedure AddToTapeLeft(const Value : string);
- procedure ClearTape;
- procedure RefreshDisplays;
- procedure SpaceTape(const Value : char);
-
- property Font : TFont
- read GetFont write SetFont;
- property Height : Integer
- read GetHeight write SetHeight;
- property MaxPaperCount : Integer
- read FMaxPaperCount write FMaxPaperCount;
- property ShowTape : Boolean
- read FShowTape write FShowTape;
- property Tape : TStrings
- read GetTape write SetTape;
- property TapeColor : TColor
- read GetTapeColor write SetTapeColor;
- property TapeDisplaySpace : Integer
- read FTapeDisplaySpace write FTapeDisplaySpace;
- property Top : Integer
- read GetTop write SetTop;
- property TopIndex : Integer
- read GetTopIndex write SetTopIndex;
- property Visible : Boolean
- read GetVisible write SetVisible;
- property Width : Integer
- read GetWidth write SetWidth;
- end;
- {.Z-}
-
-type
- TOvcCalcButtonPressedEvent =
- procedure(Sender : TObject; Button : TOvcCalculatorButton)
- of object;
-
- TOvcCalculatorOption = (coShowItemCount, coShowMemoryButtons,
- coShowClearTapeButton, coShowTape, coShowSeparatePercent);
- TOvcCalculatorOptions = set of TOvcCalculatorOption;
-
- TOvcCustomCalculator = class(TOvcCustomControl)
- {.Z+}
- protected {private}
- {property variables}
- FBorderStyle : TBorderStyle;
- FColors : TOvcCalcColors;
- FDisplay : Extended; {the calculated value}
- FDisplayStr : string; {the string that is displayed}
- FLastOperand : Extended;
- FOptions : TOvcCalculatorOptions;
- FTapeSeparatorChar : Char;
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
-
- {event variables}
- FOnButtonPressed : TOvcCalcButtonPressedEvent;
-
- {internal variables}
- cButtons : TOvcButtonArray;
- cDecimalEntered : Boolean;
- cDownButton : TOvcCalculatorButton;
- cHitTest : TPoint; {location of mouse cursor}
- cLastButton : TOvcCalculatorButton;
- cMargin : Integer;
- cMinus0 : Boolean;
- cOverBar : Boolean;
- cPanel : TOvcCalcPanel;
- cPopup : Boolean; {true if being created as a popup}
- cScrBarWidth : Integer;
- cSizeOffset : Integer; { the offset of the sizing line }
- cSizing : Boolean; { Are we showing the sizing cursor? }
- cTabCursor : HCursor; {design-time tab slecting cursor handle}
- cTape : TOvcCalcTape;
- cEngine : TOvcCustomCalculatorEngine;
-
- {internal methods}
- procedure cAdjustHeight;
- procedure cCalculateLook;
- procedure cClearAll;
- procedure cColorChange(Sender : TObject);
- procedure cDisplayError;
- procedure cDrawCalcButton(const Button : TOvcButtonInfo; const Pressed : Boolean);
- procedure cDrawFocusState;
- procedure cDrawSizeLine;
- procedure cEvaluate(const Button : TOvcCalculatorButton);
- function cFormatString(const Value : Extended) : string;
- function cGetFontWidth : Integer;
- procedure cInvalidateIndicator;
- procedure cRefreshDisplays;
- procedure cSetDisplayString(const Value : string);
- procedure cTapeFontChange(Sender : TObject);
-
- {property methods}
- function GetDecimals : Integer;
- function GetMaxPaperCount : Integer;
- function GetMemory : Extended;
- function GetOperand : Extended;
- function GetTape : TStrings;
- function GetTapeFont : TFont;
- function GetTapeHeight : Integer;
- function GetVisible : Boolean;
- procedure SetBorderStyle(const Value : TBorderStyle);
- procedure SetDecimals(const Value : Integer);
- procedure SetDisplay(const Value : Extended);
- procedure SetDisplayStr(const Value : string);
- procedure SetMaxPaperCount(const Value : Integer);
- procedure SetMemory(const Value : Extended);
- procedure SetOperand(const Value : Extended);
- procedure SetOptions(const Value : TOvcCalculatorOptions);
- procedure SetTape(const Value : TStrings);
- procedure SetTapeFont(const Value : TFont);
- procedure SetTapeHeight(const Value : Integer);
- procedure SetVisible(const Value : Boolean);
-
- {VCL control methods}
-{$IFNDEF LCL}
- procedure CMCtl3DChanged(var Msg : TMessage);
- message CM_CTL3DCHANGED;
-{$ENDIF}
- procedure CMDesignHitTest(var Msg : TCMDesignHitTest);
- message CM_DESIGNHITTEST;
- procedure CMEnter(var Msg : TMessage);
- message CM_ENTER;
- procedure CMExit(var Msg : TMessage);
- message CM_EXIT;
- procedure CMFontChanged(var Msg : TMessage);
- message CM_FONTCHANGED;
-
- {windows message handlers}
- procedure WMCancelMode(var Msg : TMessage);
- message WM_CANCELMODE;
- procedure WMEraseBkgnd(var Msg : TWMEraseBkgnd);
- message WM_ERASEBKGND;
- procedure WMGetText(var Msg : TWMGetText);
- message WM_GETTEXT;
- procedure WMGetTextLength(var Msg : TWMGetTextLength);
- message WM_GETTEXTLENGTH;
- procedure WMKeyDown(var Msg : TWMKeyDown);
- message WM_KEYDOWN;
- procedure WMKillFocus(var Msg : TWMKillFocus);
- message WM_KILLFOCUS;
- procedure WMLButtonDown(var Msg : TWMMouse);
- message WM_LBUTTONDOWN;
- procedure WMLButtonUp(var Msg : TWMMouse);
- message WM_LBUTTONUP;
- procedure WMMouseMove(var Msg : TWMMouse);
- message WM_MOUSEMOVE;
- procedure WMNCHitTest(var Msg : TWMNCHitTest);
- message WM_NCHITTEST;
- procedure WMSetText(var Msg : TWMSetText);
- message WM_SETTEXT;
- procedure WMSetCursor(var Msg : TWMSetCursor);
- message WM_SETCURSOR;
-
- protected
- procedure CreateParams(var Params : TCreateParams);
- override;
- procedure CreateWnd;
- override;
- procedure KeyDown(var Key : Word; Shift : TShiftState);
- override;
- procedure MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
- override;
- procedure MouseUp(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
- override;
- procedure Paint;
- override;
- {.Z-}
-
- {protected properties}
- property BorderStyle : TBorderStyle
- read FBorderStyle write SetBorderStyle;
- property Colors : TOvcCalcColors
- read FColors write FColors;
- property Decimals : Integer
- read GetDecimals write SetDecimals;
- property MaxPaperCount : Integer
- read GetMaxPaperCount write SetMaxPaperCount;
- property Options : TOvcCalculatorOptions
- read FOptions write SetOptions;
- property TapeFont : TFont
- read GetTapeFont write SetTapeFont;
- property TapeHeight : Integer
- read GetTapeHeight write SetTapeHeight;
- property TapeSeparatorChar : Char
- read FTapeSeparatorChar write FTapeSeparatorChar;
- property Visible : Boolean
- read GetVisible write SetVisible;
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D;
-{$ENDIF}
-
- {protected events}
- property OnButtonPressed : TOvcCalcButtonPressedEvent
- read FOnButtonPressed write FOnButtonPressed;
-
- public
- {.Z+}
- constructor Create(AOwner : TComponent);
- override;
- constructor CreateEx(AOwner : TComponent; AsPopup : Boolean);
- virtual;
- destructor Destroy;
- override;
- procedure KeyPress(var Key : Char);
- override;
- procedure PushOperand(const Value : Extended);
- procedure SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
- override;
- {.Z-}
-
- procedure CopyToClipboard;
- procedure PasteFromClipboard;
- procedure PressButton(Button : TOvcCalculatorButton);
-
- {public properties}
- property LastOperand : Extended
- read FLastOperand write FLastOperand;
- property Memory : Extended
- read GetMemory write SetMemory;
- property Operand : Extended
- read GetOperand write SetOperand;
- property DisplayStr : string
- read FDisplayStr write SetDisplayStr;
- property DisplayValue : Extended
- read FDisplay write SetDisplay;
- property Tape : TStrings
- read GetTape write SetTape;
- end;
-
- TOvcCalculator = class(TOvcCustomCalculator)
- published
- {properties}
- {$IFDEF VERSION4}
- property Anchors;
- property Constraints;
- property DragKind;
- {$ENDIF}
- property About;
- property Align;
- property BorderStyle default bsNone;
- property Ctl3D;
- property Font; {must be prior to "Colors"}
- property TapeFont; {must be prior to "Colors"}
- property Colors;
- property Cursor;
- property Decimals;
- property DragCursor;
- property DragMode;
- property Enabled;
- property LabelInfo;
- property MaxPaperCount default 9999;
- property TapeHeight ; {Must be Prior to Options}
- property Options default [coShowMemoryButtons, coShowItemCount];
-{$IFNDEF LCL}
- property ParentCtl3D;
-{$ENDIF}
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ShowHint;
- property TabOrder;
- property TabStop default True;
- property TapeSeparatorChar default '_';
- property Visible default True;
-
- {events}
- property OnButtonPressed;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnMouseWheel;
- property OnStartDrag;
- end;
-
-
-implementation
-
-const
- calcDefMinSize = 30;
-
-
-{*** TOvcCalcColors ***}
-
-procedure TOvcCalcColors.Assign(Source : TPersistent);
-begin
- if Source is TOvcCalcColors then begin
- FCalcColors := TOvcCalcColors(Source).FCalcColors;
- FColorScheme := TOvcCalcColors(Source).FColorScheme;
- FOnChange := TOvcCalcColors(Source).FOnChange;
- end else
- inherited Assign(Source);
-end;
-
-procedure TOvcCalcColors.BeginUpdate;
-begin
- FUpdating := True;
-end;
-
-procedure TOvcCalcColors.EndUpdate;
-begin
- FUpdating := False;
- DoOnChange;
-end;
-
-procedure TOvcCalcColors.DoOnChange;
-begin
- if not FUpdating and Assigned(FOnChange) then
- FOnChange(Self);
-
- if not SettingScheme then
- FColorScheme := cscalcCustom;
-end;
-
-function TOvcCalcColors.GetColor(const Index : Integer) : TColor;
-begin
- Result := FCalcColors[Index];
-end;
-
-procedure TOvcCalcColors.SetColor(const Index : Integer; const Value : TColor);
-begin
- if Value <> FCalcColors[Index] then begin
- FCalcColors[Index] := Value;
- DoOnChange;
- end;
-end;
-
-procedure TOvcCalcColors.SetColorScheme(const Value : TOvcCalcColorScheme);
-begin
- if Value <> FColorScheme then begin
- SettingScheme := True;
- try
- FColorScheme := Value;
- if Value <> cscalcCustom then begin
- FCalcColors := CalcScheme[Value];
- DoOnChange;
- end;
- finally
- SettingScheme := False;
- end;
- end;
-end;
-
-procedure TOvcCalcColors.SetDisplayTextColor(const Value : TColor);
-begin
- if Value <> FCalcColors[2] then begin
- FCalcColors[2] := Value;
- DoOnChange;
- end;
-end;
-
-
-{*** TOvcCalcTape ***}
-
-constructor TOvcCalcTape.Create(const AOwner : TComponent; const AOperandSize : Integer);
-begin
- inherited Create;
- taOwner := AOwner;
- FVisible := False;
- taOperandSize := AOperandSize;
- taFont := TFont.Create;
- taFont.Name := 'Courier New';
- taFont.Size := 10;
- taFont.Style := [];
-end;
-
-destructor TOvcCalcTape.Destroy;
-begin
- taFont.Free;
- taFont := nil;
-
- inherited Destroy;
-end;
-
-procedure TOvcCalcTape.ValidateListBox;
-begin
- if not Assigned(taListBox) then begin
- taListBox := TListBox.Create(taOwner);
- with taListBox do begin
- OnClick := taOnClick;
- OnDblClick := taOnDblClick;
- OnDrawItem := taOnDrawItem;
- Style := lbOwnerDrawFixed;
- Parent := taOwner as TWinControl;
- ParentFont := False;
-{$IFNDEF LCL}
- ParentCtl3D := True;
-{$ENDIF}
- BorderStyle := bsSingle;
- Color := taTapeColor;
- Visible := FVisible;
- Width := taWidth;
- Height := taHeight;
- Font.Assign(taFont);
- Font.OnChange := taFont.OnChange;
- taFont.OnChange := taTapeFontChange;
- TabStop := False;
- end;
- taTapeInitialized := False;
- end;
- InitializeTape;
-end;
-
-procedure TOvcCalcTape.Add(const Value : string);
-begin
- ValidateListBox;
- taListBox.Items.Add(Value);
-end;
-
-procedure TOvcCalcTape.DeleteFirst;
-begin
- ValidateListBox;
- with taListBox, Items do
- if Strings[0] = '' then
- taListBox.Items.Delete(0)
- else
- Inc(taMaxTapeCount);
-end;
-
-procedure TOvcCalcTape.SetFont(const Value : TFont);
-begin
- taFont.Assign(Value);
- taFont.OnChange(Self);
-end;
-
-function TOvcCalcTape.GetFont : TFont;
-begin
- Result := taFont;
-end;
-
-procedure TOvcCalcTape.SetHeight(const Value : Integer);
-begin
- taHeight := Value;
- if Visible then begin
- ValidateListBox;
- taListBox.Height := Value;
- end;
-end;
-
-function TOvcCalcTape.GetHeight : Integer;
-begin
- if Visible then begin
- ValidateListBox;
- Result := taListBox.Height;
- end else
- Result := taHeight;
-end;
-
-function TOvcCalcTape.GetTape : TStrings;
-begin
- ValidateListBox;
- Result := taListBox.Items;
-end;
-
-procedure TOvcCalcTape.SetTape(const Value : TStrings);
-begin
- ValidateListBox;
- taListBox.Items.Assign(Value);
-end;
-
-function TOvcCalcTape.GetTapeColor : TColor;
-begin
- if Visible then begin
- ValidateListBox;
- Result := taListBox.Color;
- end else
- Result := taTapeColor;
-end;
-
-procedure TOvcCalcTape.SetTapeColor(const Value : TColor);
-begin
- taTapeColor := Value;
- if Visible then begin
- ValidateListBox;
- taListBox.Color := Value;
- end;
-end;
-
-procedure TOvcCalcTape.SetTop(const Value : Integer);
-begin
- ValidateListBox;
- taListBox.Top := Value;
-end;
-
-function TOvcCalcTape.GetTop : Integer;
-begin
- ValidateListBox;
- Result := taListBox.Top;
-end;
-
-function TOvcCalcTape.GetVisible : Boolean;
-begin
- Result := FVisible;
-end;
-
-procedure TOvcCalcTape.SetVisible(const Value : Boolean);
-begin
- FVisible := Value;
- if Assigned(taListBox) then begin
- if not Value and taListBox.Visible then begin
- if csDesigning in taListBox.Owner.ComponentState then begin
- {$IFDEF VERSION4}
- taListBox.Visible := Value;
- taListBox.Height := 0;
- {$ELSE}
- taListBox.Free;
- taListBox := nil;
- {$ENDIF}
- end else
- taListBox.Visible := Value;
- end else if Value and not taListBox.Visible then begin
- taListBox.Visible := Value;
- {$IFDEF VERSION4}
- taListBox.Height := taHeight;
- {$ENDIF}
- end;
- end else if Value then begin
- ValidateListBox;
- taListBox.Visible := Value;
- end;
-end;
-
-procedure TOvcCalcTape.SetWidth(const Value : Integer);
-begin
- taWidth := Value;
- if Visible then begin
- ValidateListBox;
- taListBox.Width := Value;
- end;
-end;
-
-function TOvcCalcTape.GetWidth : Integer;
-begin
- if Visible then begin
- ValidateListBox;
- Result := taListBox.Width;
- end else
- Result := taWidth;
-end;
-
-procedure TOvcCalcTape.SetTopIndex(const Value : Integer);
-begin
- ValidateListBox;
- taListBox.TopIndex := Value;
-end;
-
-function TOvcCalcTape.GetTopIndex : Integer;
-begin
- ValidateListBox;
- Result := taListBox.TopIndex;
-end;
-
-procedure TOvcCalcTape.SetBounds(const ALeft, ATop, AWidth, AHeight : Integer);
-begin
- ValidateListBox;
- taListBox.SetBounds(ALeft, ATop, AWidth, AHeight);
-end;
-
-procedure TOvcCalcTape.InitializeTape;
-begin
- if not Assigned(taListBox) then
- Exit;
- if csDesigning in taListBox.Owner.ComponentState then
- if not taListBox.HandleAllocated then
- Exit;
- if taTapeInitialized then
- Exit;
- ClearTape;
- taTapeInitialized := True;
-end;
-
-procedure TOvcCalcTape.taOnClick(Sender : TObject);
-begin
- ValidateListBox;
- (taListBox.Owner as TOvcCustomCalculator).SetFocus;
-end;
-
-procedure TOvcCalcTape.taOnDblClick(Sender : TObject);
-var
- Str : string;
-begin
- ValidateListBox;
- if (taListBox.Items.Count < 1) then
- Exit;
- Str := taListBox.Items.Strings[taListBox.ItemIndex];
- try
- if (Str[1] = '0') and
- (Str[2] <> '.') then
- Exit;
- if taListBox.Items.Strings[taListBox.ItemIndex] <> '' then begin
- (taListBox.Owner as TOvcCustomCalculator).DisplayValue :=
- StrToFloat(Copy(Str,1, Length(Str) - taOperandSize));
- (taListBox.Owner as TOvcCustomCalculator).LastOperand :=
- StrToFloat(Copy(Str,1, Length(Str) - taOperandSize));
- (taListBox.Owner as TOvcCustomCalculator).Operand :=
- StrToFloat(Copy(Str,1, Length(Str) - taOperandSize));
- (taListBox.Owner as TOvcCustomCalculator).DisplayStr :=
- Copy(Str,1, Length(Str) - taOperandSize);
- (taListBox.Owner as TOvcCustomCalculator).SetFocus;
- end;
- except
- end;
-end;
-
-procedure TOvcCalcTape.taOnDrawItem(Control: TWinControl; Index: Integer;
- Rect:TRect;State: TOwnerDrawState);
-var
- SaveColor : TColor;
- SaveBack : TColor;
- Str : String;
- I, FirstUsedIndex : Integer;
-begin
- FirstUsedIndex := 0;
- if Index > FMaxPaperCount then
- with (Control as TListBox) do begin
- for I := 0 to Index do begin
- if Items[I] <> '' then begin
- FirstUsedIndex := I;
- Break;
- end;
- end;
- end;
-
- Str := (Control as TListBox).Items[Index];
- with (Control as TListBox).Canvas do begin { draw on control canvas, not on the form }
- FillRect(Rect); { clear the rectangle }
-
- SaveColor := (Control as TListBox).Canvas.Font.Color;
- try
- SaveBack := (Control as TListBox).Canvas.Brush.Color;
- try
- if (Trim(Str) <> '') then begin
- if (Trim(Str)[1] = '-') then
- (Control as TListBox).Canvas.Font.Color := clRed;
- if FTapeDisplaySpace > Length(Str) then
- Str := Str + StringOfChar(' ', FTapeDisplaySpace - Length(Str));
- TextOut(Rect.Left, Rect.Top, Copy(Str, 1, Length(Str) - 1));
- if Index - FirstUsedIndex >= FMaxPaperCount then
- (Control as TListBox).Canvas.Brush.Color := clRed;
- TextOut(PenPos.X, PenPos.Y, Copy(Str, Length(Str), 1));
- end;
- finally
- (Control as TListBox).Canvas.Brush.Color := SaveBack;
- end;
- finally
- (Control as TListBox).Canvas.Font.Color := SaveColor;
- end;
- end;
-end;
-
-procedure TOvcCalcTape.taTapeFontChange(Sender : TObject);
-begin
- if Visible then begin
- taListBox.Font.Assign(taFont);
- taListBox.Font.OnChange(Sender);
- end;
-end;
-
-function TOvcCalcTape.GetDisplayedItemCount : Integer;
-var
- DC : hDC;
- SaveFont : hFont;
- Size : TSize;
-begin
- if not Assigned(taListBox) then begin
- Result := 0;
- Exit;
- end;
-
- DC := GetDC(0);
- SaveFont := SelectObject(DC, taListBox.Font.Handle);
- GetTextExtentPoint(DC, ' 0123456789', 11, Size);
- Result := taListBox.ClientHeight div Size.cy;
- if Result < 3 then
- Result := 3;
- SelectObject(DC, SaveFont);
- ReleaseDC(0, DC);
-end;
-
-procedure TOvcCalcTape.AddToTape(const Value : string; const OpString : string);
- {-adds an operand to the tape display}
-var
- TapeString : string;
- DSpace : Integer;
-begin
- DSpace := FTapeDisplaySpace - Length(Value);
- TapeString := StringOfChar(' ', DSpace - taOperandSize);
- TapeString := TapeString + Value + ' ' + OpString;
- Add(TapeString);
- DeleteFirst;
- TopIndex := taMaxTapeCount - GetDisplayedItemCount + 2;
-end;
-
-{adds an operand to the tape display}
-procedure TOvcCalcTape.AddToTapeLeft(const Value : string);
-var
- TapeString : string;
- DSpace : Integer;
-begin
- DSpace := FTapeDisplaySpace - Length(Value);
- TapeString := StringOfChar(' ', DSpace);
- TapeString := Value + TapeString;
- Add(Value);
- DeleteFirst;
- TopIndex := taMaxTapeCount - GetDisplayedItemCount + 2;
-end;
-
-procedure TOvcCalcTape.ClearTape;
-var
- I : Integer;
-begin
- if not Assigned(taListBox) then
- Exit;
- if csDesigning in taListBox.Owner.ComponentState then
- if not taListBox.HandleAllocated then
- Exit;
- taMaxTapeCount := 30; {set starting line count}
-
- taListBox.Items.Clear;
- for I := 0 to taMaxTapeCount - 1 do
- taListBox.Items.Add('');
- taListBox.TopIndex := taMaxTapeCount - GetDisplayedItemCount + 2;
-end;
-
-procedure TOvcCalcTape.RefreshDisplays;
-var
- I, Diff : Integer;
- S : string;
-
- function AllSame(const Str : string) : Boolean;
- var
- I : Integer;
- begin
- Result := True;
- for I := 2 to Length(Str) do begin
- if Str[1] <> Str[I] then
- Exit;
- end;
- end;
-
-begin
- if not Assigned(taListBox) then
- Exit;
- if not taListBox.HandleAllocated then
- Exit;
-
- if FShowTape then begin
- for I := 0 to taMaxTapeCount - 1 do begin
- S := taListBox.Items.Strings[I];
- if S <> '' then begin
- Diff := FTapeDisplaySpace - Length(S);
- if S[1] = ' ' then begin
- if Diff >= 0 then
- S := StringOfChar(' ', Diff) + S
- else if AllSame(copy(S, 1, -Diff)) then
- S := copy(S,-Diff + 1, Length(S));
- end else begin
- if AllSame(S) and (not (S[1] in ['0'..'9'])) then
- if Diff >= 0 then
- S := S + StringOfChar(S[1], Diff)
- else
- S := copy(S, 1, Length(S)-Diff + 1)
- else if (Diff >= 0) and not ((S[1] <> '0') or (S[2] <> '.')) then
- S := StringOfChar(' ', Diff) + S;
- end;
- taListBox.Items.Strings[I] := S;
- end;
- end;
- taListBox.TopIndex := taMaxTapeCount - GetDisplayedItemCount + 2;
- end;
-end;
-
-procedure TOvcCalcTape.SpaceTape(const Value : char);
-var
- TapeString : string;
-begin
- TapeString := StringOfChar(Value, FTapeDisplaySpace);
- Add(TapeString);
- DeleteFirst;
- TopIndex := taMaxTapeCount - GetDisplayedItemCount + 2;
-end;
-
-
-{*** TOvcCustomCalculatorEngine ***}
-
-procedure TOvcCustomCalculatorEngine.ClearAll;
-var
- I : Integer;
-begin
- for I := 0 to 3 do
- cOperands[I] := 0;
- cLastOperation := coNone;
- cOperationCount := 0;
- cState := [csValid, csClear];
-end;
-
-procedure TOvcCustomCalculatorEngine.PushOperand(const Value : Extended);
-var
- I : Integer;
-begin
- for I := 2 downto 0 do
- cOperands[I+1] := cOperands[I];
- cOperands[0] := Value;
-end;
-
-function TOvcCustomCalculatorEngine.PopOperand : Extended;
-var
- I : Integer;
-begin
- Result := cOperands[0];
- for I := 0 to 2 do
- cOperands[I] := cOperands[I+1];
- cOperands[3] := 0;
-end;
-
-function TOvcCustomCalculatorEngine.TopOperand : Extended;
-begin
- Result := cOperands[0];
-end;
-
-
-{*** TOvcBasicCalculatorEngine ***}
-type
- TOvcBasicCalculatorEngine = class(TOvcCustomCalculatorEngine)
- protected {private}
- {internal methods}
- procedure cEvaluate(const Operation : TOvcCalculatorOperation);
- public
- function AddOperand(const Value : Extended; const Button : TOvcCalculatorOperation) : Boolean;
- override;
- function AddOperation(const Button : TOvcCalculatorOperation) : Boolean;
- override;
- end;
-
-function TOvcBasicCalculatorEngine.AddOperand(
- const Value : Extended;
- const Button : TOvcCalculatorOperation) : Boolean;
-var
- I : Integer;
-begin
- Result := False;
- if Button <> coNone then begin
- if csValid in cState then begin
- Result := True;
- for I := 2 downto 0 do
- cOperands[I+1] := cOperands[I];
- cOperands[0] := Value;
- end;
- end;
-end;
-
-procedure TOvcBasicCalculatorEngine.cEvaluate(const Operation : TOvcCalculatorOperation);
-begin
- if csValid in cState then begin
- {evaluate the expression}
- case Operation of
- coAdd : begin
- cOperands[1] := cOperands[1] + cOperands[0];
- PopOperand;
- end;
- coSub : begin
- cOperands[1] := cOperands[1] - cOperands[0];
- PopOperand;
- end;
- coMul : begin
- cOperands[1] := cOperands[1] * cOperands[0];
- PopOperand;
- end;
- coDiv : begin
- cOperands[1] := cOperands[1] / cOperands[0];
- PopOperand;
- end;
- coEqual : ;
- coNone : ;
- coPercent : begin
- if cLastOperation in [coAdd, coSub] then
- cOperands[0] := (cOperands[0] / 100) * cOperands[1] {do markup/down}
- else
- cOperands[0] := cOperands[0] / 100; {as a percentage}
- cState := [csValid, csClear];
- end;
- coMemStore : begin
- cMemory := cOperands[0];
- Include(cState, csClear);
- end;
- coMemRecall : begin
- cOperands[0] := cMemory;
- cState := [csValid, csClear];
- end;
- coMemClear : begin
- cMemory := 0;
- end;
- coMemAdd,
- coMemSub : begin
- try
- if Operation = coMemAdd then
- cMemory := cMemory + cOperands[0]
- else
- cMemory := cMemory - cOperands[0];
- except
- cMemory := 0;
- end;
- Include(cState, csClear);
- end;
- coInvert : begin
- cOperands[0] := 1 / cOperands[0];
- end;
- coSqrt : begin
- cOperands[0] := Sqrt(cOperands[0]);
- end;
- end;
- end;
-end;
-
-function TOvcBasicCalculatorEngine.AddOperation(const Button : TOvcCalculatorOperation) : Boolean;
-begin
- Result := False;
- if csValid in cState then begin
- {evaluate the expression}
- case Button of
- coAdd : begin
- cEvaluate(cLastOperation);
- cState := [csValid, csClear];
- if cLastOperation in [coAdd, coSub] then
- Inc(cOperationCount)
- else
- cOperationCount := 1;
- cLastOperation := Button;
- Result := True;
- end;
- coSub : begin
- cEvaluate(cLastOperation);
- cState := [csValid, csClear];
- if cLastOperation in [coAdd, coSub] then
- Inc(cOperationCount)
- else
- cOperationCount := 1;
- cLastOperation := Button;
- Result := True;
- end;
- coMul : begin
- cEvaluate(cLastOperation);
- cState := [csValid, csClear];
- if cLastOperation = Button then
- cOperationCount := cOperationCount + 1
- else
- cOperationCount := 1;
- cLastOperation := Button;
- Result := True;
- end;
- coDiv : begin
- cEvaluate(cLastOperation);
- cState := [csValid, csClear];
- if cLastOperation = Button then
- cOperationCount := cOperationCount + 1
- else
- cOperationCount := 1;
- cLastOperation := Button;
- Result := True;
- end;
- coEqual : begin
- Include(cState, csClear);
- if cLastOperation <> coNone then begin
- cEvaluate(cLastOperation);
- cState := [csClear, csValid];
- if cLastOperation = coEqual then
- cLastOperation := coNone
- else
- cLastOperation := Button;
- end;
- Result := True;
- end;
- coNone : Result := True;
- coPercent : begin
- cEvaluate(Button);
- if not ShowSeparatePercent then begin
- cEvaluate(cLastOperation);
- cState := [csValid, csClear];
- if cLastOperation = Button then
- cOperationCount := cOperationCount + 1
- else
- cOperationCount := 0;
- cLastOperation := coEqual;
- Result := True;
- end else begin
- if cLastOperation = Button then
- cOperationCount := cOperationCount + 1
- else
- cOperationCount := 0;
- Result := True;
- end;
- end;
- coMemStore : begin
- cEvaluate(Button);
- end;
- coMemRecall : begin
- cEvaluate(Button);
- Result := True;
- end;
- coMemClear : begin
- cEvaluate(Button);
- end;
- coMemAdd,
- coMemSub : begin
- cEvaluate(Button);
- end;
- coInvert : begin
- cEvaluate(Button);
- Result := True;
- end;
- coSqrt : begin
- cEvaluate(Button);
- Result := True;
- end;
- end;
- end;
-end;
-
-
-{*** TOvcCalcPanel ***}
-
-procedure TOvcCalcPanel.Click;
-begin
- (Owner as TOvcCustomCalculator).SetFocus;
-end;
-
-
-{*** TOvcCustomCalculator ***}
-
-procedure TOvcCustomCalculator.cAdjustHeight;
-var
- DC : hDC;
- SaveFont : hFont;
- I : Integer;
- SysMetrics : TTextMetric;
- Metrics : TTextMetric;
-begin
- DC := GetDC(0);
- GetTextMetrics(DC, SysMetrics);
- SaveFont := SelectObject(DC, Font.Handle);
- GetTextMetrics(DC, Metrics);
- SelectObject(DC, SaveFont);
- ReleaseDC(0, DC);
- if NewStyleControls then begin
- if Ctl3D then
- I := 8
- else
- I := 6;
- I := GetSystemMetrics(SM_CYBORDER) * I;
- end else begin
- I := SysMetrics.tmHeight;
- if I > Metrics.tmHeight then
- I := Metrics.tmHeight;
- I := I div 4 + GetSystemMetrics(SM_CYBORDER) * 4;
- end;
- cPanel.Height := Metrics.tmHeight + I;
-end;
-
-procedure TOvcCustomCalculator.cCalculateLook;
-var
- CW : Integer; {client width}
- BW : Integer; {button width}
- BH : Integer; {button height}
- LBW : Integer; {large button width}
- M1 : Integer; {margin between buttons}
- M2 : Integer; {left and right edge margins}
- M3 : Integer; {margin between panel and frst row of buttons}
- M4 : Integer; {margin between memory buttons and other buttons}
- TM : Integer; {area where the panel is placed}
- X : Integer;
- Y : Integer;
- PW : Integer; {panel width}
- B : TOvcCalculatorButton;
-begin
- if not HandleAllocated then
- Exit;
-
- {set panel height based on font}
- cAdjustHeight;
-
- for B := Low(cButtons) to High(cButtons) do
- cButtons[B].Visible := True;
-
- CW := ClientWidth;
-
- if Width <= 200 then begin
- M1 := 2;
- M2 := 4;
- end else begin
- M1 := 4;
- M2 := 6;
- end;
- {save left/right/top/bottom margin value}
- cMargin := M2;
-
- M4 := M2;
- if coShowMemoryButtons in FOptions then begin
- BW := (CW - 3*M2 - 4*M1) div 6;
- M4 := CW - 2*M2 - 6*BW - 4*M1;
- end else begin
- BW := (CW - 2*M2 - 4*M1) div 5;
- if (CW - 2*M2 - 4*M1) div 6 >= 4 then
- Inc(M2, 2)
- else if (CW - 2*M2 - 4*M1) div 6 >= 2 then
- Inc(M2, 1);
- end;
-
- {button height, using an estimate for TM}
- TM := M2 + M2 + cPanel.Height;
-
- if coShowTape in FOptions then
- TM := TM + M2 + cTape.Height;
-
- BH := (ClientHeight - TM - M2 - 4*M1) div 5;
-
- {calculate actual area below panel}
- M3 := ClientHeight - M2 - cPanel.Height - 5*BH - 4*M1 - M2;
-
- {calculate actual height of area above buttons}
- TM := M2 + M3 + cPanel.Height;
-
- {large button width}
- if coShowClearTapeButton in FOptions then
- LBW := (5*BW + 3*M1 - 2*M1) div 4
- else
- LBW := (4*BW + 3*M1 - 2*M1) div 3;
-
- {calculate the width of the edit window}
- cMargin := M2;
- if coShowMemoryButtons in FOptions then
- PW := 6*BW + M4 + 4*M1
- else
- PW := 5*BW + 4*M1;
-
- if coShowTape in FOptions then
- PW := PW - cScrBarWidth;
-
-
- {position tape display and edit panel}
- if coShowTape in FOptions then begin
- cTape.Visible := True;
- cTape.SetBounds(cMargin, cMargin, PW + cScrBarWidth, cTape.Height);
- cPanel.SetBounds(cMargin + 2, cTape.Height + M2 +
- cMargin, PW, cPanel.Height);
- end else begin
- cTape.Visible := False;
- cPanel.SetBounds(cMargin, cMargin, PW, cPanel.Height);
- end;
-
- {calculate # of characters required to fill display space}
- {"FontWidth div 2" makes sure there is no cut off charaters}
- if coShowTape in FOptions then
- cTape.TapeDisplaySpace := (cTape.Width - cScrBarWidth - (cGetFontWidth div 2))
- div cGetFontWidth
- else
- cTape.TapeDisplaySpace := (cPanel.Width - (cGetFontWidth div 2)) div cGetFontWidth;
-
- cTape.InitializeTape;
-
- {redraw the edit panel and Tape}
- cRefreshDisplays;
-
- {memory column}
- if coShowMemoryButtons in FOptions then begin
- X := M2;
- Y := TM;
- cButtons[cbMemClear].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbMemClear].Caption := GetOrphStr(SCCalcMC);
-
- Y := TM + BH + M1;
- cButtons[cbMemRecall].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbMemRecall].Caption := GetOrphStr(SCCalcMR);
-
- Y := TM + 2*BH + 2*M1;
- cButtons[cbMemStore].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbMemStore].Caption := GetOrphStr(SCCalcMS);
-
- Y := TM + 3*BH + 3*M1;
- cButtons[cbMemAdd].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbMemAdd].Caption := GetOrphStr(SCCalcMPlus);
-
- Y := TM + 4*BH + 4*M1;
- cButtons[cbMemSub].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbMemSub].Caption := GetOrphStr(SCCalcMMinus);
- end else
- for B := cbMemClear to cbMemSub do
- cButtons[B].Visible := False;
-
- {row 1 - large buttons}
- Y := TM;
- if coShowMemoryButtons in FOptions then
- if coShowClearTapeButton in FOptions then
- X := BW + M2 + M4
- else
- X := 2*BW + M4 + M2 + M1
- else
- if coShowClearTapeButton in FOptions then
- X := M2
- else
- X := BW + M2 + M1;
-
- cButtons[cbTape].Position := Rect(X, Y, X+LBW, Y+BH);
- cButtons[cbTape].Caption := GetOrphStr(SCCalcCT);
-
- if coShowClearTapeButton in FOptions then begin
- cButtons[cbTape].Visible := True;
- Inc(X, LBW+M1);
- if ((BW+M1)*5 - (LBW+M1)*4) >= 3 then
- Inc(X, 1);
- end else begin
- cButtons[cbTape].Visible := False;
- end;
-
- cButtons[cbBack].Position := Rect(X, Y, X+LBW, Y+BH);
- cButtons[cbBack].Caption := GetOrphStr(SCCalcBack);
-
- Inc(X, LBW+M1);
- if coShowClearTapeButton in FOptions then begin
- if ((BW+M1)*5 - (LBW+M1)*4) >= 2 then
- Inc(X, 1);
- end else begin
- if ((BW+M1)*4 - (LBW+M1)*3) >= 2 then
- Inc(X, 1);
- end;
- cButtons[cbClearEntry].Position := Rect(X, Y, X+LBW, Y+BH);
- cButtons[cbClearEntry].Caption := GetOrphStr(SCCalcCE);
-
- Inc(X, LBW+M1);
- if coShowClearTapeButton in FOptions then begin
- if ((BW+M1)*5 - (LBW+M1)*4) >= 1 then
- Inc(X, 1);
- end else begin
- if ((BW+M1)*4 - (LBW+M1)*3) >= 1 then
- Inc(X, 1);
- end;
- cButtons[cbClear].Position := Rect(X, Y, X+LBW, Y+BH);
- cButtons[cbClear].Caption := GetOrphStr(SCCalcC);
-
- {row 2}
- Y := TM + BH + M1;
- if coShowMemoryButtons in FOptions then
- X := M2 + BW + M4
- else
- X := M2;
- cButtons[cb7].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cb7].Caption := '7';
-
- Inc(X, BW+M1);
- cButtons[cb8].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cb8].Caption := '8';
-
- Inc(X, BW+M1);
- cButtons[cb9].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cb9].Caption := '9';
-
- Inc(X, BW+M1);
- cButtons[cbDiv].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbDiv].Caption := '/';
-
- Inc(X, BW+M1);
- cButtons[cbSqrt].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbSqrt].Caption := GetOrphStr(SCCalcSqrt);
-
- {row 3}
- Y := TM + 2*BH + 2*M1;
- if coShowMemoryButtons in FOptions then
- X := M2 + BW + M4
- else
- X := M2;
- cButtons[cb4].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cb4].Caption := '4';
-
- Inc(X, BW+M1);
- cButtons[cb5].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cb5].Caption := '5';
-
- Inc(X, BW+M1);
- cButtons[cb6].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cb6].Caption := '6';
-
- Inc(X, BW+M1);
- cButtons[cbMul].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbMul].Caption := '*';
-
- Inc(X, BW+M1);
- cButtons[cbPercent].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbPercent].Caption := '%';
-
- {row 4}
- Y := TM + 3*BH + 3*M1;
- if coShowMemoryButtons in FOptions then
- X := M2 + BW + M4
- else
- X := M2;
- cButtons[cb1].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cb1].Caption := '1';
-
- Inc(X, BW+M1);
- cButtons[cb2].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cb2].Caption := '2';
-
- Inc(X, BW+M1);
- cButtons[cb3].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cb3].Caption := '3';
-
- Inc(X, BW+M1);
- cButtons[cbSub].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbSub].Caption := '-';
-
- Inc(X, BW+M1);
- cButtons[cbInvert].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbInvert].Caption := '1/x';
-
- {row 5}
- Y := TM + 4*BH + 4*M1;
- if coShowMemoryButtons in FOptions then
- X := M2 + BW + M4
- else
- X := M2;
- cButtons[cb0].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cb0].Caption := '0';
-
- Inc(X, BW+M1);
- cButtons[cbChangeSign].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbChangeSign].Caption := '+/-';
-
- Inc(X, BW+M1);
- cButtons[cbDecimal].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbDecimal].Caption := DecimalSeparator;
-
- Inc(X, BW+M1);
- cButtons[cbAdd].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbAdd].Caption := '+';
-
- Inc(X, BW+M1);
- cButtons[cbEqual].Position := Rect(X, Y, X+BW, Y+BH);
- cButtons[cbEqual].Caption := '=';
-end;
-
-procedure TOvcCustomCalculator.cClearAll;
-begin
- if not HandleAllocated then
- Exit;
-
- cEngine.ClearAll;
- FLastOperand := 0;
- DisplayValue := 0;
- FDisplayStr := '0';
- cMinus0 := False;
- cTape.InitializeTape;
- cPanel.Caption := StringOfChar(' ',
- (cTape.TapeDisplaySpace
- - Length('0')
- - Length(CalcDisplayString[cbNone]))
- ) + '0' + ' ';
-end;
-
-procedure TOvcCustomCalculator.cColorChange(Sender : TObject);
-begin
- {update panel background color}
- if Assigned(cPanel) then begin
- cPanel.Color := FColors.Display;
- cPanel.Font.Color := FColors.DisplayTextColor;
- {update the main font color}
- if not (csLoading in ComponentState) and (Font <> nil) then
- Font.Color := FColors.DisplayTextColor;
- end;
-
- if Assigned(cTape) then begin
- cTape.TapeColor := FColors.Display;
- end;
-
- Invalidate;
-end;
-
-procedure TOvcCustomCalculator.cDisplayError;
-begin
- cSetDisplayString('****** ');
- cEngine.State := [csLocked]; {user will have to clear this}
- MessageBeep(0);
-end;
-
-procedure TOvcCustomCalculator.cDrawCalcButton(const Button : TOvcButtonInfo; const Pressed : Boolean);
-var
- TR : TRect;
- Buf : array[0..255] of Char;
-begin
- if Button.Visible then begin
- TR := DrawButtonFace(Canvas, Button.Position, 1, bsNew, False, Pressed, False);
- StrPLCopy(Buf, Button.Caption, 255);
- DrawText(Canvas.Handle, Buf, StrLen(Buf), TR,
- DT_CENTER or DT_VCENTER or DT_SINGLELINE);
-
- if Focused and (Button.Caption = '=') then
- cDrawFocusState;
- end;
-end;
-
-procedure TOvcCustomCalculator.cDrawFocusState;
-var
- R : TRect;
-begin
- R := cButtons[cbEqual].Position;
- InflateRect(R, -3, -3);
-{$IFNDEF LCL}
- Canvas.DrawFocusRect(R);
-{$ENDIF}
-end;
-
-procedure TOvcCustomCalculator.cDrawSizeLine;
-var
- OldPen : TPen;
-begin
- if (cSizing) then
- with Canvas do begin
- OldPen := TPen.Create;
- try
- OldPen.Assign(Pen);
- Pen.Color := clBlack;
- Pen.Mode := pmXor;
- Pen.Style := psDot;
- Pen.Width := 1;
- MoveTo(0, cSizeOffset);
- LineTo(ClientWidth, cSizeOffset);
- finally
- Canvas.Pen := OldPen;
- OldPen.Free;
- end;
- end;
-end;
-
-procedure TOvcCustomCalculator.cEvaluate(const Button : TOvcCalculatorButton);
-begin
- if csValid in cEngine.State then begin
- try
- {evaluate the expression}
- if cEngine.AddOperation(CalcButtontoOperation[Button]) then begin
- DisplayValue := cEngine.TopOperand;
- if Button in [cbAdd, cbSub, cbMul, cbDiv, cbEqual, cbPercent, cbNone] then
- if (Button in [cbAdd, cbSub, cbMul, cbDiv]) and (cLastButton = Button) then
- cTape.AddToTape(cFormatString(LastOperand), CalcDisplayString[Button])
- else
- cTape.AddToTape(FDisplayStr, CalcDisplayString[Button]);
- if (Button = cbEqual) and (cEngine.LastOperation = coEqual) then begin
- if coShowItemCount in FOptions then
- cTape.AddToTapeLeft(Format('%3.3d',[cEngine.OperationCount+1]));
- cTape.AddToTape(cFormatString(DisplayValue), CalcDisplayString[cbSubTotal]);
- cTape.SpaceTape(TapeSeparatorChar);
- end;
- FDisplayStr := cFormatString(DisplayValue);
- end;
- except
- cDisplayError;
- end;
- end;
-end;
-
-function TOvcCustomCalculator.cFormatString(const Value : Extended) : string;
-begin
- if cEngine.Decimals = 0 then
- Result := Format('%g',[Value])
- else if cEngine.Decimals < 0 then
- Result := Format('%.*f',[-cEngine.Decimals, Value])
- else
- Result := Format('%.*f',[cEngine.Decimals, Value]);
-end;
-
-function TOvcCustomCalculator.cGetFontWidth : Integer;
-var
- DC : hDC;
- SaveFont : hFont;
- Size : TSize;
-begin
- if not assigned(cPanel) then begin
- Result := 8; {Return something resonable }
- Exit;
- end;
- DC := GetDC(0);
- SaveFont := SelectObject(DC, cPanel.Font.Handle);
- GetTextExtentPoint(DC, ' 0123456789', 11, Size);
- Result := Round(Size.cx/11);
- SelectObject(DC, SaveFont);
- ReleaseDC(0, DC);
-end;
-
-procedure TOvcCustomCalculator.cInvalidateIndicator;
-begin
- InvalidateRect(Handle, @cButtons[cbMemRecall].Position, False);
- InvalidateRect(Handle, @cButtons[cbMemClear].Position, False);
-end;
-
-procedure TOvcCustomCalculator.cRefreshDisplays;
-begin
- if not cPanel.HandleAllocated then
- Exit;
-
- cTape.RefreshDisplays;
-{ DisplayValue := DisplayValue; }
-end;
-
-procedure TOvcCustomCalculator.cSetDisplayString(const Value : string);
-var
- DSpace : Integer;
-begin
- try
- if cPanel.HandleAllocated then begin
- DSpace := cTape.TapeDisplaySpace
- - Length(Value)
- - Length(CalcDisplayString[cbNone]);
- cPanel.Caption := StringOfChar(' ', DSpace) + Value + ' ';
- end;
- except
- cDisplayError;
- end;
-end;
-
-procedure TOvcCustomCalculator.cTapeFontChange(Sender : TObject);
-begin
- cPanel.Font := TapeFont;
-end;
-
-procedure TOvcCustomCalculator.SetBorderStyle(const Value : TBorderStyle);
-begin
- if Value <> FBorderStyle then begin
- FBorderStyle := Value;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- RecreateWnd(Self);
-{$ENDIF}
- end;
-end;
-
-function TOvcCustomCalculator.GetDecimals : Integer;
-begin
- Result := cEngine.Decimals;
-end;
-
-procedure TOvcCustomCalculator.SetDecimals(const Value : Integer);
-begin
- if Value <> cEngine.Decimals then begin
- cEngine.Decimals := Value;
- ccalculateLook;
- Invalidate;
- end;
-end;
-
-function TOvcCustomCalculator.GetMemory : Extended;
-begin
- Result := cEngine.Memory;
-end;
-
-procedure TOvcCustomCalculator.SetMemory(const Value : Extended);
-begin
- if Value <> cEngine.Memory then begin
- cEngine.Memory := Value;
- cCalculateLook;
- Invalidate;
- end;
-end;
-
-procedure TOvcCustomCalculator.SetMaxPaperCount(const Value : Integer);
-begin
- if Value <> cTape.MaxPaperCount then begin
- cTape.MaxPaperCount := Value;
- Invalidate;
- end;
-end;
-
-function TOvcCustomCalculator.GetMaxPaperCount : Integer;
-begin
- Result := cTape.MaxPaperCount;
-end;
-
-procedure TOvcCustomCalculator.SetOptions(const Value : TOvcCalculatorOptions);
-begin
- if Value <> FOptions then begin
- FOptions := Value;
-
-
- cTape.ShowTape := coShowTape in FOptions;
- cTape.Visible := coShowTape in FOptions;
- cEngine.ShowSeparatePercent := coShowSeparatePercent in FOptions;
-
- cCalculateLook;
- Invalidate;
- end;
-end;
-
-function TOvcCustomCalculator.GetTape : TStrings;
-begin
- Result := cTape.Tape;
-end;
-
-procedure TOvcCustomCalculator.SetTape(const Value : TStrings);
-begin
- cTape.Tape := Value;
-end;
-
-function TOvcCustomCalculator.GetTapeFont : TFont;
-begin
- Result := cTape.Font;
-end;
-
-procedure TOvcCustomCalculator.SetTapeFont(const Value : TFont);
-begin
- cTape.Font := Value;
-end;
-
-function TOvcCustomCalculator.GetTapeHeight : Integer;
-begin
- Result := cTape.Height;
-end;
-
-procedure TOvcCustomCalculator.SetTapeHeight(const Value : Integer);
-begin
- cTape.Height := Value;
- cCalculateLook;
- Invalidate;
-end;
-
-function TOvcCustomCalculator.GetVisible : Boolean;
-begin
- Result := inherited Visible;
-end;
-
-procedure TOvcCustomCalculator.SetVisible(const Value : Boolean);
-begin
- inherited Visible := Value;
-
- cTape.Visible := cTape.ShowTape;
-end;
-
-procedure TOvcCustomCalculator.SetDisplay(const Value : Extended);
-var
- ValueString : string;
-begin
- try
- FDisplay := Value;
- if cPanel.HandleAllocated then begin
- ValueString := cFormatString(Value);
- cSetDisplayString(ValueString);
- end;
- except
- cDisplayError;
- end;
-end;
-
-procedure TOvcCustomCalculator.SetDisplayStr(const Value : string);
-begin
- FDisplayStr := Value;
- while (Length(FDisplayStr) > 0) and (FDisplayStr[1] = ' ') do
- FDisplayStr := Copy(FDisplayStr, 2, Length(FDisplayStr) - 1);
-end;
-
-function TOvcCustomCalculator.GetOperand : Extended;
-begin
- Result := cEngine.TopOperand;
-end;
-
-procedure TOvcCustomCalculator.SetOperand(const Value : Extended);
-begin
- if Value = cEngine.TopOperand then
- Exit;
- cEngine.PushOperand(Value);
-end;
-
-{$IFNDEF LCL}
-procedure TOvcCustomCalculator.CMCtl3DChanged(var Msg : TMessage);
-begin
- inherited;
-
- if (csLoading in ComponentState) or not HandleAllocated then
- Exit;
-
- if NewStyleControls and (FBorderStyle = bsSingle) then
-{$IFNDEF LCL}
- RecreateWnd;
-{$ENDIF}
-
- Invalidate;
-end;
-{$ENDIF}
-
-procedure TOvcCustomCalculator.CMDesignHitTest(var Msg : TCMDesignHitTest);
-begin
- Msg.Result := LongInt(cOverBar);
-end;
-
-procedure TOvcCustomCalculator.CMEnter(var Msg : TMessage);
-var
- R : TRect;
-begin
- inherited;
-
- {invalidate the "=" button to ensure that the focus rect is painted}
- R := cButtons[cbEqual].Position;
- InvalidateRect(Handle, @R, False);
-end;
-
-procedure TOvcCustomCalculator.CMExit(var Msg : TMessage);
-var
- R : TRect;
-begin
- inherited;
-
- {invalidate the "=" button to ensure that the focus rect is painted}
- R := cButtons[cbEqual].Position;
- InvalidateRect(Handle, @R, False);
-end;
-
-procedure TOvcCustomCalculator.CMFontChanged(var Msg : TMessage);
-begin
- inherited;
-
- if not (csLoading in ComponentState) and Assigned(cPanel) then begin
- cPanel.Color := FColors.Display;
- cPanel.Font.Color := FColors.DisplayTextColor;
- FColors.FCalcColors[2] := Font.Color;
- end;
-
- cCalculateLook;
- Invalidate;
-end;
-
-procedure TOvcCustomCalculator.WMEraseBkgnd(var Msg : TWMEraseBkgnd);
-begin
- Msg.Result := 1; {don't erase background, just say we did}
-end;
-
-procedure TOvcCustomCalculator.WMGetText(var Msg : TWMGetText);
-begin
- if not cPanel.HandleAllocated then
- Exit;
-
- Msg.Result := SendMessage(cPanel.Handle, WM_GETTEXT,
- TMessage(Msg).wParam, TMessage(Msg).lParam);
-end;
-
-procedure TOvcCustomCalculator.WMGetTextLength(var Msg : TWMGetTextLength);
-begin
- if not cPanel.HandleAllocated then
- Exit;
-
- Msg.Result := SendMessage(cPanel.Handle, WM_GETTEXTLENGTH,
- TMessage(Msg).wParam, TMessage(Msg).lParam);
-end;
-
-procedure TOvcCustomCalculator.WMKeyDown(var Msg : TWMKeyDown);
-begin
- if Msg.CharCode = Ord('M') then begin
- if ({$IFNDEF LCL} GetAsyncKeyState(VK_CONTROL) {$ELSE} GetKeyState(VK_CONTROL) {$ENDIF} and $8000) <> 0 then begin
- PressButton(cbMemStore);
- end;
- end else if Msg.CharCode = VK_RETURN then
- PressButton(cbEqual);
-
- inherited;
-end;
-
-procedure TOvcCustomCalculator.WMSetText(var Msg : TWMSetText);
-var
- I : Integer;
- C : AnsiChar;
-begin
- cClearAll;
- for I := 0 to Pred(StrLen(Msg.Text)) do begin
- C := Msg.Text[I];
- KeyPress(C);
- end;
- Msg.Result := 1{true};
-end;
-
-procedure TOvcCustomCalculator.WMNCHitTest(var Msg : TWMNCHitTest);
-begin
- inherited;
-
- cHitTest.X := Msg.Pos.X;
- cHitTest.Y := Msg.Pos.Y;
-end;
-
-procedure TOvcCustomCalculator.WMSetCursor(var Msg : TWMSetCursor);
-var
- vHitTest : TPoint;
-
- procedure SetNewCursor(C : HCursor);
- begin
-{$IFNDEF LCL}
- SetCursor(C);
-{$ELSE}
- LclIntf.SetCursor(C); {Don't call control's SetCursor!}
-{$ENDIF}
- Msg.Result := Ord(True);
- end;
-
-begin
- if not (coShowTape in FOptions) then
- Exit;
-
- if csDesigning in ComponentState then begin
- if (Msg.HitTest = HTCLIENT) then begin
- cOverBar := False;
- vHitTest := ScreenToClient(cHitTest);
- if vHitTest.Y > cTape.Top + cTape.Height then
- if vHitTest.Y < cTape.Top + cTape.Height+4 then
- cOverBar := True;
- end;
-
- {set appropriate cursor}
- if cOverBar then
- SetNewCursor(cTabCursor)
- else
- inherited;
- end else
- inherited;
-end;
-
-procedure TOvcCustomCalculator.WMCancelMode(var Msg : TMessage);
-begin
- inherited;
-
- cSizing := False;
-end;
-
-procedure TOvcCustomCalculator.WMKillFocus(var Msg : TWMKillFocus);
-begin
- inherited;
-
- Invalidate;
-end;
-
-procedure TOvcCustomCalculator.WMLButtonDown(var Msg : TWMMouse);
-begin
- inherited;
-
- {are we currently showing a sizing cursor? if so the user wants to
- resize a column/row}
- if (cOverBar) then begin
- cSizeOffset := Msg.YPos;
- cSizing := True;
- cDrawSizeLine;
- end;
-end;
-
-procedure TOvcCustomCalculator.WMLButtonUp(var Msg : TWMMouse);
-var
- Form : TForm;
-begin
- inherited;
-
- if (cSizing) then begin
- cDrawSizeLine;
- cSizing := False;
- cTape.Height := cSizeOffset - 8;
- cCalculateLook;
-
- Refresh;
- if (csDesigning in ComponentState) then begin
- Form := TForm(GetParentForm(Self));
- if (Form <> nil) and (Form.Designer <> nil) then
- Form.Designer.Modified;
- end;
- end;
-end;
-
-procedure TOvcCustomCalculator.WMMouseMove(var Msg : TWMMouse);
-begin
- inherited;
-
- if (cSizing) then begin
- cDrawSizeLine;
- if Msg.YPos >= calcDefMinSize + cTape.Top then
- if Msg.YPos <= Height - calcDefMinSize then
- cSizeOffset := Msg.YPos + 2
- else
- cSizeOffset := Height - calcDefMinSize
- else
- cSizeOffset := calcDefMinSize + cTape.Top;
- cDrawSizeLine;
- end;
-end;
-
-procedure TOvcCustomCalculator.CopyToClipboard;
-begin
- Clipboard.AsText := Text;
-end;
-
-constructor TOvcCustomCalculator.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- if cPopup then
- ControlStyle := ControlStyle + [csClickEvents, csFramed] - [csCaptureMouse]
- else
- ControlStyle := ControlStyle + [csClickEvents, csFramed, csCaptureMouse];
-
- Color := clBtnFace;
- TabStop := True;
- Width := 200;
- Font.Name := 'MS Sans Serif';
- Font.Size := 8;
- Font.Style := [];
- cDecimalEntered := False;
- cSizing := False;
- cScrBarWidth := 18;
-
- {create edit control}
- cPanel := TOvcCalcPanel.Create(Self);
- cPanel.Parent := Self;
- cPanel.ParentFont := False;
- cPanel.Font.Name := 'Courier New';
- cPanel.Font.Size := 10;
- cPanel.Font.Style := [];
-{$IFNDEF LCL}
- cPanel.ParentCtl3D := True;
-{$ENDIF}
- cPanel.Alignment := taLeftJustify;
- cPanel.BevelOuter := bvLowered;
- cPanel.BorderStyle := bsNone;
- cPanel.Color := clWindow;
- cPanel.BevelWidth := 2;
- cPanel.Caption := '0 ';
-
- {set property defaults}
- FBorderStyle := bsNone;
- Height := 140;
- FTapeSeparatorChar := '_';
- FOptions := [coShowMemoryButtons, coShowItemCount];
- FColors := TOvcCalcColors.Create;
- FColors.OnChange := cColorChange;
-
- {assign default color scheme}
- FColors.FCalcColors := CalcScheme[cscalcWindows];
-
- {create tape}
- cTape := TOvcCalcTape.Create(Self, Length(CalcDisplayString[cbNone]));
- cTape.ShowTape := False;
- cTape.TapeColor := clWindow;
- cTape.MaxPaperCount := 9999;
- TapeHeight := Height div 3;
- TapeFont.OnChange := cTapeFontChange;
- TapeFont.Name := 'Courier New';
- TapeFont.Size := 10;
- TapeFont.Style := [];
- cTape.Visible := cTape.ShowTape;
-
- cEngine := TOvcBasicCalculatorEngine.Create;
- cEngine.Decimals := 2;
- cEngine.ShowSeparatePercent := False;
-
- if csDesigning in ComponentState then
- cTabCursor := Screen.Cursors[crVSplit];
-end;
-
-constructor TOvcCustomCalculator.CreateEx(AOwner : TComponent; AsPopup : Boolean);
-begin
- cPopup := AsPopup;
- Create(AOwner);
-end;
-
-procedure TOvcCustomCalculator.CreateParams(var Params : TCreateParams);
-const
- BorderStyles : array[TBorderStyle] of LongInt = (0, WS_BORDER);
-begin
- inherited CreateParams(Params);
-
- with Params do begin
- Style := LongInt(Style) or BorderStyles[FBorderStyle];
- if cPopup then begin
- Style := WS_POPUP or WS_BORDER;
- WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
- end;
- end;
-
- if NewStyleControls and (Ctl3D or cPopup) and (FBorderStyle = bsSingle) then begin
- if not cPopup then
- Params.Style := Params.Style and not WS_BORDER;
- Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
- end;
-end;
-
-procedure TOvcCustomCalculator.CreateWnd;
-begin
- inherited CreateWnd;
-
- cCalculateLook;
- cClearAll;
-
- cPanel.Color := FColors.Display;
-end;
-
-destructor TOvcCustomCalculator.Destroy;
-begin
- cTape.Free;
- cTape := nil;
-
- cEngine.Free;
- cEngine := nil;
-
- FColors.Free;
- FColors := nil;
-
- cTabCursor := 0;
-
- inherited Destroy;
-end;
-
-procedure TOvcCustomCalculator.KeyDown(var Key : Word; Shift : TShiftState);
-begin
- inherited KeyDown(Key, Shift);
-
- case Key of
- VK_DELETE : if Shift = [] then
- PressButton(cbClearEntry);
- VK_F9 : if Shift = [] then
- PressButton(cbChangeSign);
- end;
-end;
-
-procedure TOvcCustomCalculator.KeyPress(var Key : Char);
-begin
- inherited KeyPress(Key);
-
- case Key of
- '0' : PressButton(cb0);
- '1' : PressButton(cb1);
- '2' : PressButton(cb2);
- '3' : PressButton(cb3);
- '4' : PressButton(cb4);
- '5' : PressButton(cb5);
- '6' : PressButton(cb6);
- '7' : PressButton(cb7);
- '8' : PressButton(cb8);
- '9' : PressButton(cb9);
-
- '+' : PressButton(cbAdd);
- '-' : PressButton(cbSub);
- '*' : PressButton(cbMul);
- '/' : PressButton(cbDiv);
-
- '.' : PressButton(cbDecimal);
- '=' : PressButton(cbEqual);
- 'r' : PressButton(cbInvert);
- '%' : PressButton(cbPercent);
- '@' : PressButton(cbSqrt);
-
- ^L : PressButton(cbMemClear); {^L}
- ^R : PressButton(cbMemRecall); {^R}
- ^P : PressButton(cbMemAdd); {^P}
- ^S : PressButton(cbMemSub); {^S}
- ^T : PressButton(cbTape); {^T}
-
- ^C : CopyToClipboard; {^C}{copy}
- ^V : PasteFromClipboard; {^V}{paste}
-
- #8 : PressButton(cbBack); {backspace}
- #27 : PressButton(cbClear); {esc}
- else
- if Key = DecimalSeparator then
- PressButton(cbDecimal);
- end;
-end;
-
-procedure TOvcCustomCalculator.MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
-var
- B : TOvcCalculatorButton;
-begin
- SetFocus;
-
- if Button = mbLeft then begin
- cDownButton := cbNone;
- for B := Low(cButtons) to High(cButtons) do
- if cButtons[B].Visible and PtInRect(cButtons[B].Position, Point(X,Y)) then begin
- if (B in [cbMemClear, cbMemRecall]) and (cEngine.Memory = 0) then
- Exit;
- cDownButton := B;
- InvalidateRect(Handle, @cButtons[cDownButton].Position, False);
- Break;
- end;
- end;
-
- inherited MouseDown(Button, Shift, X, Y);
-end;
-
-procedure TOvcCustomCalculator.MouseUp(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
-begin
- if cDownButton = cbNone then
- Exit;
-
- InvalidateRect(Handle, @cButtons[cDownButton].Position, False);
-
- {if still over the button...}
- if PtInRect(cButtons[cDownButton].Position, Point(X,Y)) then
- PressButton(cDownButton);
-
- cDownButton := cbNone;
-
- inherited MouseUp(Button, Shift, X, Y);
-end;
-
-procedure TOvcCustomCalculator.PasteFromClipboard;
-var
- I : Integer;
- C : AnsiChar;
- S : string;
-begin
- S := Clipboard.AsText;
- if S > '' then begin
- cClearAll;
- for I := 1 to Length(S) do begin
- C := S[I];
- if (C in ['0'..'9', DecimalSeparator, '.', '+', '-', '*', '/', '=', '%']) then
- KeyPress(C);
- end;
- end;
-end;
-
-procedure TOvcCustomCalculator.PressButton(Button : TOvcCalculatorButton);
-
- procedure Initialize;
- begin
- if (cLastButton <> cbClear) and (Button = cbClear) then begin
- cClearAll;
- cTape.SpaceTape(TapeSeparatorChar);
- end;
-
- if (csLocked in cEngine.State) then begin
- MessageBeep(0);
- Exit;
- end;
-
- {this logic is here to make cbEqual clear all the second time}
- if (cLastButton in [cbEqual, cbClear, cbNone]) and (Button = cbEqual) then begin
- Button := cbClear;
- cClearAll;
- end;
-
- if (cLastButton = cbPercent) and (Button in [cbAdd, cbSub, cbMul, cbDiv, cbEqual]) then
- cEvaluate(Button)
- else if ((((cLastButton in [cbEqual, cbMemRecall]) and
- (Button in [cbAdd, cbSub, cbMul, cbDiv])))) and
- cEngine.AddOperand(StrToFloat(FDisplayStr), CalcButtontoOperation[Button]) then begin
- cEvaluate(Button);
- end else if (Button = cbMemStore) then begin
- if (cLastButton <> cbEqual) then
- cEvaluate(Button);
- SetMemory(DisplayValue);
- end else if cEngine.AddOperand(LastOperand, CalcButtontoOperation[Button]) then begin
- cEvaluate(Button);
-
- {remove special operations from stack}
- if Button in [cbInvert, cbSqrt, cbEqual] then
- LastOperand := cEngine.PopOperand;
- end;
- end;
-
- procedure NumberButton;
- var
- D : Extended;
- DP : Integer;
- begin
- begin
- if cEngine.LastOperation = coEqual then begin
- {clear pending operations if last command was =}
- cClearAll;
- end;
-
- if csClear in cEngine.State then begin
- if (Decimals < 0) then begin
- FDisplayStr := '0.' + StringOfChar('0', -Decimals);
- end else begin
- FDisplayStr := '';
- cDecimalEntered := False;
- end;
- end;
-
- FDisplayStr := FDisplayStr + cButtons[Button].Caption[1];
- if cMinus0 then begin
- FDisplayStr := '-' + FDisplayStr;
- cMinus0 := False;
- end;
-
- if (Decimals < 0) and not cDecimalEntered then begin
- if Pos(DecimalSeparator, FDisplayStr) > 0 then begin
- DP := Pos(DecimalSeparator, FDisplayStr);
- if FDisplayStr[1] = '0' then
- FDisplayStr := Copy(FDisplayStr,2,DP-2) +
- Copy(FDisplayStr,DP+1,1) +
- DecimalSeparator +
- Copy(FDisplayStr,DP+2,Length(FDisplayStr) - DP)
- else
- FDisplayStr := Copy(FDisplayStr,1,DP-1) +
- Copy(FDisplayStr,DP+1,1) +
- DecimalSeparator +
- Copy(FDisplayStr,DP+2,Length(FDisplayStr) - DP);
- end;
- end;
- D := StrToFloat(FDisplayStr);
- LastOperand := D;
- if (D <> 0) or
- (Pos(DecimalSeparator, FDisplayStr) > 0) then begin
- DisplayValue := D;
- cSetDisplayString(FDisplayStr);
- cEngine.State := [csValid];
- end else begin
- FDisplayStr := '0';
- DisplayValue := D;
- cEngine.State := [csValid, csClear];
- end;
- end;
- end;
-
- procedure DecimalButton;
- var
- D : Extended;
- begin
- {check if the decimal was first character entered after a command}
- if csClear in cEngine.State then begin
- FDisplayStr := '0' + DecimalSeparator;
- cSetDisplayString(FDisplayStr);
- cDecimalEntered := True;
- cEngine.State := [csValid];
- end;
-
- {check if there is already a decimal separator in the string}
- if Pos(DecimalSeparator, FDisplayStr) = 0 then begin
- FDisplayStr := FDisplayStr + DecimalSeparator;
- if (pos(DecimalSeparator, FDisplayStr) = 1) then
- FDisplayStr := '0' + FDisplayStr;
- D := StrToFloat(FDisplayStr);
- cSetDisplayString(FDisplayStr);
- LastOperand := D;
- cEngine.State := [csValid];
- cDecimalEntered := True;
- end;
- end;
-
- procedure BackButton;
- var
- D : Extended;
- DP : Integer;
- SaveSign : string;
- begin
- if FDisplayStr = '' then exit;
- D := StrToFloat(FDisplayStr);
- if D <> 0 then begin
- if Length(FDisplayStr) > 1 then begin
- if (Decimals < 0) and not cDecimalEntered then begin
- if Pos(DecimalSeparator, FDisplayStr) > 0 then begin
- if FDisplayStr[1] = '-' then begin
- SaveSign :='-';
- FDisplayStr := Copy(FDisplayStr,2,Length(FDisplayStr)-1);
- end else begin
- SaveSign :='';
- end;
- DP := Pos(DecimalSeparator, FDisplayStr);
- FDisplayStr := '0' + Copy(FDisplayStr,1,DP-2) +
- DecimalSeparator +
- Copy(FDisplayStr,DP-1,1) +
- Copy(FDisplayStr,DP+1,Length(FDisplayStr) - DP);
- if (FDisplayStr[1] = '0') and (FDisplayStr[2] <> '.') then
- FDisplayStr := Copy(FDisplayStr,2,Length(FDisplayStr)-1);
- FDisplayStr := SaveSign + FDisplayStr;
- end;
- end;
- FDisplayStr := Copy(FDisplayStr, 1, Length(FDisplayStr)-1);
- LastOperand := StrToFloat(FDisplayStr);
- cSetDisplayString(FDisplayStr);
- end else begin
- LastOperand := 0;
- cMinus0 := False;
- DisplayValue := LastOperand;
- cEngine.State := [csValid, csClear];
- end;
- end;
- end;
-
- procedure ClearEntryButton;
- begin
- begin
- FDisplayStr := '';
- LastOperand := 0;
- cMinus0 := False;
- DisplayValue := LastOperand;
- end;
- end;
-
- procedure ChangeSignButton;
- begin
- if Length(FDisplayStr) > 0 then begin
- if FDisplayStr[1] <> '-' then begin
- FDisplayStr := '-' + FDisplayStr;
- LastOperand := StrToFloat(FDisplayStr);
- cSetDisplayString(FDisplayStr);
- end else begin
- FDisplayStr := Copy(FDisplayStr, 2, Length(FDisplayStr)-1);
- LastOperand := StrToFloat(FDisplayStr);
- cSetDisplayString(FDisplayStr);
- end;
- DisplayValue := LastOperand;
- end else begin
- LastOperand := 0;
- cMinus0 := not cMinus0;
- DisplayValue := LastOperand;
- if cMinus0 then
- FDisplayStr := '-';
- cEngine.State := [csValid, csClear];
- end;
- end;
-
- procedure ClearTapeButton;
- var
- I : Integer;
- begin
- with Tape do begin
- for I := 0 to Count - 1 do begin
- Strings[I] := '';
- end;
- cTape.RefreshDisplays;
- end;
- end;
-
-begin
- if not HandleAllocated then
- Exit;
-
- {simulate a button down if needed}
- if cDownButton = cbNone then begin
- cDownButton := Button;
- InvalidateRect(Handle, @cButtons[cDownButton].Position, False);
- Update;
- end;
-
- try try
- Initialize;
- case Button of
- cb0..cb9 : NumberButton;
- cbDecimal : DecimalButton;
- cbBack : BackButton;
- cbClearEntry : ClearEntryButton;
- cbMemStore,
- cbMemClear,
- cbMemAdd,
- cbMemSub : cInvalidateIndicator;
- cbChangeSign : ChangeSignButton;
- cbTape : ClearTapeButton;
- cbSqrt,
- cbInvert : {};
- end;
- except
- cDisplayError;
- end;
- finally
- {simulate a button up, if the mouse button is up or we aren't focused}
- if not Focused or ({$IFNDEF LCL} GetAsyncKeyState(GetLeftButton) {$ELSE} GetKeyState(GetLeftButton) {$ENDIF} and $8000 = 0) then begin
- InvalidateRect(Handle, @cButtons[cDownButton].Position, False);
- cDownButton := cbNone;
- Update;
- end;
- end;
-
- cLastButton := Button;
- if Assigned(FOnButtonPressed) then
- FOnButtonPressed(Self, Button);
-end;
-
-procedure TOvcCustomCalculator.PushOperand(const Value : Extended);
-begin
- cEngine.PushOperand(Value);
- LastOperand := Value;
- DisplayValue := Value;
-end;
-
-procedure TOvcCustomCalculator.Paint;
-var
- B : TOvcCalculatorButton;
-begin
- Canvas.Font := Font;
- Canvas.Brush.Color := clBtnFace;
- Canvas.FillRect(ClientRect);
-
- if Ctl3D then begin
- cPanel.BevelOuter := bvLowered;
- cPanel.BorderStyle := bsNone;
- end else begin
- cPanel.BevelOuter := bvNone;
- cPanel.BorderStyle := bsSingle;
- end;
-
- {draw buttons}
- for B := Low(cButtons) to High(cButtons) do begin
- if (B in [cbMemClear, cbMemRecall, cbMemStore, cbMemAdd, cbMemSub]) then begin
- if (B in [cbMemClear, cbMemRecall]) and (cEngine.Memory = 0) then
- Canvas.Font.Color := FColors.DisabledMemoryButtons
- else
- Canvas.Font.Color := FColors.MemoryButtons;
- end else if (B in [cbBack, cbClearEntry, cbClear, cbTape]) then
- Canvas.Font.Color := FColors.EditButtons
- else if (B in [cbAdd, cbSub, cbMul, cbDiv, cbEqual]) then
- Canvas.Font.Color := FColors.OperatorButtons
- else if (B in [cb0..cb9, cbDecimal]) then
- Canvas.Font.Color := FColors.NumberButtons
- else if (B in [cbInvert, cbChangeSign, cbPercent, cbSqrt]) then
- Canvas.Font.Color := FColors.FunctionButtons;
-
- cDrawCalcButton(cButtons[B], (B = cDownButton));
- end;
-end;
-
-procedure TOvcCustomCalculator.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
-begin
- if Height <> AHeight then
- if coShowTape in FOptions then
- if Top <> ATop then begin
- if TapeHeight + (AHeight - Height) > calcDefMinSize then begin
- TapeHeight := TapeHeight + (AHeight - Height);
- end else begin
- TapeHeight := calcDefMinSize;
- end
- end;
-
- inherited Setbounds(ALeft, ATop, AWidth, AHeight);
-
- cCalculateLook;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovccaret.pas b/Source/3rdParty/Orpheus/ovccaret.pas
deleted file mode 100644
index 66571f3a..00000000
--- a/Source/3rdParty/Orpheus/ovccaret.pas
+++ /dev/null
@@ -1,690 +0,0 @@
-{*********************************************************}
-{* OVCCARET.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-} {Short-circuit Boolean Evaluation}
-{$I+} {Input/Output-Checking}
-{$P+} {Open Parameters}
-{$T-} {Typed @ Operator}
-{.W-} {Windows Stack Frame}
-{$X+} {Extended Syntax}
-
-unit ovccaret;
- {-Caret handling class}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, MyMisc, {$ENDIF}
- Graphics, Classes, Controls, Forms;
-
-type
- TOvcCaretShape = ( {Predefined caret shapes..}
- csBlock, {..block over whole cell}
- csHalfBlock, {..block over bottom part of cell}
- csVertLine, {..vertical line to left of cell}
- csHorzLine, {..horizontal line on bottom of cell}
- csCustom, {..custom width/height}
- csBitmap); {..bitmap caret, custom width/height}
-
- TOvcCaretAlign = ( {Alignment of caret in cell..}
- caLeft, {..left side, centered vertically}
- caTop, {..top side, centered horizontally}
- caRight, {..right side, centered vertically}
- caBottom, {..bottom side, centered horizontally}
- caCenter); {..centered vertically and horizontally}
-
-type
- {Class defining a caret shape}
- TOvcCaret = class(TPersistent)
- {.Z+}
- protected
- {property fields}
- FAlign : TOvcCaretAlign; {Caret alignment in cell}
- FBitmap : TBitmap; {Bitmap for a bitmapped caret}
- FBitmapX : Integer; {Bitmap's hotspot X}
- FBitmapY : Integer; {Bitmap's hotspot Y}
- FBlinkTime : word; {Blink time}
- FCaretHt : Integer; {Height: autosized for some shapes}
- FCaretWd : Integer; {Width: autosized for some shapes}
- FIsGray : boolean; {True if a 'gray' caret}
- FShape : TOvcCaretShape; {Shape}
-
- FOnChange : TNotifyEvent; {Owner's change notification}
-
- {internal fields}
- RefCount : word; {Reference count}
-
- {property access methods}
- procedure SetAlign(A : TOvcCaretAlign);
- procedure SetBitmap(BM : TBitMap);
- procedure SetBitmapX(X : Integer);
- procedure SetBitmapY(Y : Integer);
- procedure SetBlinkTime(BT : word);
- procedure SetCaretHeight(CH : Integer);
- procedure SetCaretWidth(CW : Integer);
- procedure SetIsGray(IG : boolean);
- procedure SetShape(S : TOvcCaretShape);
-
- {general methods}
- procedure NotifyChange;
-
- public
- {VCL methods}
- constructor Create;
- destructor Destroy; override;
-
- {other methods}
- procedure Register;
- procedure Deregister;
-
- {properties}
- property OnChange : TNotifyEvent
- read FOnChange
- write FOnChange;
- {.Z-}
-
- published
- {properties}
- property Bitmap : TBitmap
- read FBitmap write SetBitmap;
- property BitmapHotSpotX : Integer
- read FBitmapX write SetBitmapX
- default 0;
- property BitmapHotSpotY : Integer
- read FBitmapY write SetBitmapY
- default 0;
- property Shape : TOvcCaretShape
- read FShape write SetShape
- default csVertLine;
- property Align : TOvcCaretAlign
- read FAlign write SetAlign
- default caLeft;
- property BlinkTime : word
- read FBlinkTime write SetBlinkTime
- default 0;
- property CaretHeight : Integer
- read FCaretHt write SetCaretHeight
- default 10;
- property CaretWidth : Integer
- read FCaretWd write SetCaretWidth
- default 2;
- property IsGray : boolean
- read FIsGray write SetIsGray
- default False;
- end;
-
-{.Z+}
-type
- TOvcSingleCaret = class(TPersistent)
- {Class defining a Single caret}
- protected
- {property fields}
- FCaretType : TOvcCaret; {Current caret type}
- FHeight : Integer; {Cell height}
- FLinked : boolean; {True if linked to owner}
- FPos : TPoint; {Position within owner}
- FVisible : boolean; {True if visible}
- FWidth : Integer; {Cell width}
-
- {other fields}
- OrigBlinkTime : word; {Blink time before linking}
- Owner : TWinControl; {Owning control}
- XOffset : Integer; {X Offset of caret in cell}
- YOffset : Integer; {Y Offset of caret in cell}
-
- {property access methods}
- procedure SetCaretType(CT : TOvcCaret);
- procedure SetCellHeight(CH : Integer);
- procedure SetCellWidth(CW : Integer);
- procedure SetLinked(L : boolean);
- procedure SetPos(P : TPoint);
- procedure SetVisible(V : boolean);
-
- {general methods}
- procedure MakeShape;
- procedure Reinit;
- procedure ResetPos;
-
- public
- {VCL methods}
- constructor Create(AOwner : TWinControl);
- destructor Destroy; override;
-
- {general methods}
- procedure CaretTypeHasChanged(Sender : TObject);
-
- {properties}
- property CaretType : TOvcCaret
- read FCaretType
- write SetCaretType;
-
- property CellHeight : Integer
- read FHeight
- write SetCellHeight;
-
- property CellWidth : Integer
- read FWidth
- write SetCellWidth;
-
- property Linked : boolean
- read FLinked
- write SetLinked
- stored false;
-
- property Position : TPoint
- read FPos
- write SetPos;
-
- property Visible : boolean
- read FVisible
- write SetVisible;
- end;
-
-type
- TOvcCaretPair = class(TOvcSingleCaret)
- {Class defining a pair of carets, one each for insert/overwrite modes}
- protected
- {property fields}
- FInsMode : boolean;
- FInsCaretType : TOvcCaret;
- FOvrCaretType : TOvcCaret;
-
- {property access methods}
- procedure SetInsMode(IM : boolean);
- procedure SetInsCaretType(ICT : TOvcCaret);
- procedure SetOvrCaretType(OCT : TOvcCaret);
-
- public
- {VCL methods}
- constructor Create(AOwner : TWinControl);
- destructor Destroy; override;
-
- {properties}
- property InsertMode : boolean
- read FInsMode
- write SetInsMode;
-
- property InsCaretType : TOvcCaret
- read FInsCaretType
- write SetInsCaretType;
-
- property OvrCaretType : TOvcCaret
- read FOvrCaretType
- write SetOvrCaretType;
- end;
-{.Z-}
-
-
-implementation
-
-
-
-{---TOvcCaret----------------------------------------------------}
-constructor TOvcCaret.Create;
- begin
- inherited Create;
-
- FShape := csVertLine;
- FAlign := caLeft;
- FBlinkTime := 0;
- FIsGray := False;
- FBitMap := TBitMap.Create;
- FCaretHt := 10;
- FCaretWd := 2;
- end;
-{--------}
-destructor TOvcCaret.Destroy;
- begin
- FBitMap.Free;
- inherited Destroy;
- end;
-{--------}
-procedure TOvcCaret.Deregister;
- begin
- {decrement the reference count, if no one references us
- any more, kill ourselves}
- dec(RefCount);
- if (RefCount = 0) then
- Free;
- end;
-{--------}
-procedure TOvcCaret.NotifyChange;
- begin
- if Assigned(FOnChange) then
- FOnChange(Self);
- end;
-{--------}
-procedure TOvcCaret.Register;
- begin
- inc(RefCount);
- end;
-{--------}
-procedure TOvcCaret.SetAlign(A : TOvcCaretAlign);
- begin
- if (A <> FAlign) then
- begin
- FAlign := A;
- NotifyChange;
- end;
- end;
-{--------}
-procedure TOvcCaret.SetBitmap(BM : TBitmap);
- begin
- if not Assigned(BM) then
- Exit;
- FBitMap.Assign(BM);
- NotifyChange;
- end;
-{--------}
-procedure TOvcCaret.SetBitmapX(X : Integer);
- begin
- if (X <> FBitMapX) then
- begin
- FBitMapX := X;
- if (Shape = csBitMap) then
- NotifyChange;
- end;
- end;
-{--------}
-procedure TOvcCaret.SetBitmapY(Y : Integer);
- begin
- if (Y <> FBitMapY) then
- begin
- FBitMapY := Y;
- if (Shape = csBitMap) then
- NotifyChange;
- end;
- end;
-{--------}
-procedure TOvcCaret.SetBlinkTime(BT : word);
- begin
- if (BT <> FBlinkTime) then
- begin
- FBlinkTime := BT;
- NotifyChange;
- end;
- end;
-{--------}
-procedure TOvcCaret.SetCaretHeight(CH : Integer);
- begin
- if (CH <> FCaretHt) and (CH > 0) then
- begin
- FCaretHt := CH;
- NotifyChange;
- end;
- end;
-{--------}
-procedure TOvcCaret.SetCaretWidth(CW : Integer);
- begin
- if (CW <> FCaretWd) and (CW > 0) then
- begin
- FCaretWd := CW;
- NotifyChange;
- end;
- end;
-{--------}
-procedure TOvcCaret.SetIsGray(IG : boolean);
- begin
- if (IG <> FIsGray) then
- begin
- FIsGray := IG;
- NotifyChange;
- end;
- end;
-{--------}
-procedure TOvcCaret.SetShape(S : TOvcCaretShape);
- begin
- if (S <> FShape) then
- begin
- FShape := S;
- case FShape of
- csBlock:
- FAlign := caLeft;
- csVertLine :
- begin
- FAlign := caLeft;
- FCaretWd := 2;
- end;
- csHalfBlock:
- FAlign := caBottom;
- csHorzLine :
- begin
- FAlign := caBottom;
- FCaretHt := 2;
- end;
- csBitmap :
- begin
- FCaretHt := FBitMap.Height;
- FCaretWd := FBitMap.Width;
- end;
- end;{case}
- NotifyChange;
- end;
- end;
-{--------------------------------------------------------------------}
-
-
-{---TOvcSingleCaret--------------------------------------------------}
-constructor TOvcSingleCaret.Create(AOwner : TWinControl);
- begin
- inherited Create;
- Owner := AOwner;
-
- FHeight := 10;
- FWidth := 10;
-
- {make our default caret type}
- FCaretType := TOvcCaret.Create;
- FCaretType.Register;
- Reinit;
- end;
-{--------}
-destructor TOvcSingleCaret.Destroy;
- begin
- Visible := false;
- Linked := false;
- FCaretType.Deregister;
-
- inherited Destroy;
- end;
-{--------}
-procedure TOvcSingleCaret.CaretTypeHasChanged(Sender : TObject);
- var
- WasLinked : boolean;
- begin
- {if something has changed about the caret, unlink from
- our owner, recalc our values, relink}
- WasLinked := Linked;
- Linked := false;
- Reinit;
- Linked := WasLinked;
- end;
-{--------}
-procedure TOvcSingleCaret.MakeShape;
- begin
- {don't bother if we aren't linked to anything or if we
- don't have a caret type}
- if (not Linked) or (not Assigned(FCaretType)) then
- Exit;
-
- {create the caret, and if necessary show it}
- with FCaretType do
- if (Shape = csBitmap) then
- CreateCaret(Owner.Handle, Bitmap.Handle, 0, 0)
- else CreateCaret(Owner.Handle, ord(IsGray), CaretWidth, CaretHeight);
- if Visible then
- ShowCaret(Owner.Handle);
- end;
-{--------}
-procedure TOvcSingleCaret.Reinit;
- var
- NewXOfs : Integer;
- NewYOfs : Integer;
- begin
- {don't bother if we don't have a caret type}
- if (not Assigned(FCaretType)) then
- Exit;
-
- {inits}
- NewXOfs := 0;
- NewYOfs := 0;
-
- with FCaretType do
- begin
- {stop recursion}
- OnChange := nil;
-
- {recalc the caret type's height and width}
- if (Shape <> csBitmap) and (Shape <> csCustom) then
- begin
- case Shape of
- csBlock :
- begin
- CaretHeight := FHeight;
- CaretWidth := FWidth;
- end;
- csHalfBlock:
- begin
- CaretHeight := FHeight div 2;
- CaretWidth := FWidth;
- end;
- csVertLine : CaretHeight := FHeight;
- csHorzLine : CaretWidth := FWidth;
- end;{case}
- end;
-
- {allow changes to percolate through again}
- OnChange := CaretTypeHasChanged;
-
- {recalc the X and Y offsets}
- case Align of
- caLeft : begin
- NewXOfs := 0;
- NewYOfs := (FHeight - CaretHeight) div 2;
- end;
- caTop : begin
- NewXOfs := (FWidth - CaretWidth) div 2;
- NewYOfs := 0;
- end;
- caRight : begin
- NewXOfs := FWidth - CaretWidth;
- NewYOfs := (FHeight - CaretHeight) div 2;;
- end;
- caBottom : begin
- NewXOfs := (FWidth - CaretWidth) div 2;
- NewYOfs := FHeight - CaretHeight;
- end;
- caCenter : begin
- NewXOfs := (FWidth - CaretWidth) div 2;
- NewYOfs := (FHeight - CaretHeight) div 2;
- end;
- end;{case}
- if (Shape = csBitMap) then
- begin
- dec(NewXOfs, BitMapHotSpotX);
- dec(NewYOfs, BitMapHotSpotY);
- end;
- if (NewXOfs <> XOffset) or (NewYOfs <> YOffset) then
- begin
- XOffset := NewXOfs;
- YOffset := NewYOfs;
- if Linked then
- ResetPos;
- end;
- end;
- end;
-{--------}
-procedure TOvcSingleCaret.ResetPos;
- var
- NewX, NewY : Integer;
- begin
- if (FPos.X = MaxInt) then
- NewX := MaxInt
- else NewX := FPos.X + XOffset;
- if (FPos.Y = MaxInt) then
- NewY := MaxInt
- else NewY := FPos.Y + YOffset;
- SetCaretPos(NewX, NewY);
- end;
-{--------}
-procedure TOvcSingleCaret.SetCaretType(CT : TOvcCaret);
- begin
- if (CT <> FCaretType) then
- begin
- FCaretType.Deregister;
- FCaretType := CT;
- FCaretType.Register;
- FCaretType.OnChange := CaretTypeHasChanged;
- CaretTypeHasChanged(Self);
- end;
- end;
-{--------}
-procedure TOvcSingleCaret.SetCellHeight(CH : Integer);
- begin
- if (CH <> FHeight) and (CH > 0) then
- begin
- FHeight := CH;
- CaretTypeHasChanged(Self);
- end;
- end;
-{--------}
-procedure TOvcSingleCaret.SetCellWidth(CW : Integer);
- begin
- if (CW <> FWidth) and (CW > 0) then
- begin
- FWidth := CW;
- CaretTypeHasChanged(Self);
- end;
- end;
-{--------}
-procedure TOvcSingleCaret.SetLinked(L : boolean);
- begin
- if (L <> FLinked) then
- begin
- FLinked := L;
- if Assigned(Owner) and Owner.HandleAllocated then
- if FLinked then
- begin
- OrigBlinkTime := GetCaretBlinkTime;
- MakeShape;
- ResetPos;
- if (OrigBlinkTime <> CaretType.BlinkTime) then
- if (CaretType.BlinkTime <> 0) then
- SetCaretBlinkTime(CaretType.BlinkTime);
- end
- else
- begin
- SetCaretBlinkTime(OrigBlinkTime);
-{$IFNDEF LCL}
- DestroyCaret;
-{$ELSE}
- DestroyCaret(Owner.Handle);
-{$ENDIF}
- end
- else
- FLinked := false;
- end;
- end;
-{--------}
-procedure TOvcSingleCaret.SetPos(P : TPoint);
- begin
- if (P.X < 0) then
- P.X := MaxInt;
- if (P.Y < 0) then
- P.Y := MaxInt;
- if (P.X <> FPos.X) or (P.Y <> FPos.Y) then
- begin
- FPos := P;
- if Linked then
- ResetPos;
- end;
- end;
-{--------}
-procedure TOvcSingleCaret.SetVisible(V : boolean);
- begin
- if (V <> FVisible) then
- begin
- FVisible := V;
- if Linked then
- if Owner.HandleAllocated then
- if FVisible then
- ShowCaret(Owner.Handle)
- else
- HideCaret(Owner.Handle);
- end;
- end;
-
-
-{---TOvcCaretPair----------------------------------------------------}
-constructor TOvcCaretPair.Create(AOwner : TWinControl);
- begin
- inherited Create(AOwner);
-
- FInsCaretType := TOvcCaret.Create;
- FInsCaretType.Register;
-
- FOvrCaretType := TOvcCaret.Create;
- FOvrCaretType.Register;
- FOvrCaretType.Shape := csBlock;
-
- FInsMode := True;
-
- if FInsMode then
- CaretType := FInsCaretType
- else
- CaretType := FOvrCaretType
- end;
-
-destructor TOvcCaretPair.Destroy;
-begin
- FInsCaretType.Deregister;
- FOvrCaretType.Deregister;
-
- inherited Destroy;
-end;
-
-procedure TOvcCaretPair.SetInsMode(IM : boolean);
- begin
- if (IM <> FInsMode) then
- begin
- FInsMode := IM;
- if FInsMode then
- CaretType := FInsCaretType
- else CaretType := FOvrCaretType;
- end;
- end;
-{--------}
-procedure TOvcCaretPair.SetInsCaretType(ICT : TOvcCaret);
- begin
- if (ICT <> FInsCaretType) then
- begin
- FInsCaretType.Deregister;
- FInsCaretType := ICT;
- FInsCaretType.Register;
- if InsertMode then
- CaretType := FInsCaretType;
- end;
- end;
-{--------}
-procedure TOvcCaretPair.SetOvrCaretType(OCT : TOvcCaret);
- begin
- if (OCT <> FOvrCaretType) then
- begin
- FOvrCaretType.Deregister;
- FOvrCaretType := OCT;
- FOvrCaretType.Register;
- if not InsertMode then
- CaretType := FOvrCaretType;
- end;
- end;
-{--------------------------------------------------------------------}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovcclrcb.pas b/Source/3rdParty/Orpheus/ovcclrcb.pas
deleted file mode 100644
index ee86f3b3..00000000
--- a/Source/3rdParty/Orpheus/ovcclrcb.pas
+++ /dev/null
@@ -1,372 +0,0 @@
-{*********************************************************}
-{* OVCCLRCB.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 ovcclrcb;
- {-color ComboBox selector}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, MyMisc, {$ENDIF}
- Classes, Controls, Forms, Graphics, Menus, StdCtrls,
- OvcCmbx, OvcConst, OvcData;
-
-type
- TOvcCustomColorComboBox = class(TOvcBaseComboBox)
- protected {private}
- {property Variables}
- FShowColorNames : Boolean;
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
-
- {internal variables}
- BoxWidth : Integer;
-
- {property methods}
- function GetSelectedColor : TColor;
- procedure SetSelectedColor(Value : TColor);
- procedure SetShowColorNames(Value : Boolean);
- function ColorFromString(Str: string): TColor;
-
- {internal methods}
- procedure CalculateBoxWidth;
-
- {message methods}
- procedure CMFontChanged(var Message : TMessage);
- message CM_FONTCHANGED;
-
- procedure CreateWnd; override;
-
- property SelectedColor : TColor
- read GetSelectedColor write SetSelectedColor;
- property ShowColorNames : Boolean
- read FShowColorNames write SetShowColorNames default True;
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D;
-{$ENDIF}
-
- public
- constructor Create(AOwner : TComponent); override;
- destructor Destroy; override;
- procedure DrawItem(Index : Integer; Rect : TRect; State : TOwnerDrawState);
- override;
- procedure SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
- override;
- end;
-
- TOvcColorComboBox = class(TOvcCustomColorComboBox)
- published
- {$IFDEF VERSION4}
- property Anchors;
- property Constraints;
- property DragKind;
- {$ENDIF}
- property About;
- property Color;
- property Ctl3D;
- property Cursor;
- property DragCursor;
- property DragMode;
- property DropDownCount;
- property Enabled;
- property Font;
- property HotTrack;
-// property Items;
- property ItemHeight;
- property LabelInfo;
- property ParentColor;
-{$IFNDEF LCL}
- property ParentCtl3D;
-{$ENDIF}
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property SelectedColor default clBlack;
- property ShowColorNames;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property Text;
- property Visible;
-
- {events}
- property AfterEnter;
- property AfterExit;
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnDropDown;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnSelectionChange;
- property OnStartDrag;
- property OnMouseWheel;
- end;
-
-implementation
-
-procedure TOvcCustomColorComboBox.CalculateBoxWidth;
-var
- I : Integer;
- X : Integer;
- T : Integer;
-begin
- if not HandleAllocated or (BoxWidth > 0) then
- Exit;
-
- if not FShowColorNames then begin
- BoxWidth := ClientWidth - 1;
- Exit;
- end;
-
- Canvas.Font := Font;
- BoxWidth := 0;
- T := 0;
-
- {calculate width of the color box}
- for I := 0 to pred(Items.Count) do begin
- X := Canvas.TextWidth(Items[I]+'X');
- if X > T then
- T := X;
- end;
-
- BoxWidth := ClientWidth - T;
- if BoxWidth < 25 then
- BoxWidth := 25;
-end;
-
-procedure TOvcCustomColorComboBox.CMFontChanged(var Message : TMessage);
-begin
- inherited;
-
- BoxWidth := 0;
- Invalidate;
-end;
-
-constructor TOvcCustomColorComboBox.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- {disable MRU list}
- FMRUList.MaxItems := 0;
-
- Style := ocsDropDownList;
-
- FShowColorNames := True;
-
-// On Carbon, SetSelectedColor gets called before Items is populated
-// in CreateWnd below, so moved code to here.
-// Note: Isn't CreateWnd an odd place to initialize a control?
-{$IFDEF LCL}
- Text := '';
- Items.Clear;
- Items.Add(GetOrphStr(SCColorBlack));
- Items.Add(GetOrphStr(SCColorMaroon));
- Items.Add(GetOrphStr(SCColorGreen));
- Items.Add(GetOrphStr(SCColorOlive));
- Items.Add(GetOrphStr(SCColorNavy));
- Items.Add(GetOrphStr(SCColorPurple));
- Items.Add(GetOrphStr(SCColorTeal));
- Items.Add(GetOrphStr(SCColorGray));
- Items.Add(GetOrphStr(SCColorSilver));
- Items.Add(GetOrphStr(SCColorRed));
- Items.Add(GetOrphStr(SCColorLime));
- Items.Add(GetOrphStr(SCColorYellow));
- Items.Add(GetOrphStr(SCColorBlue));
- Items.Add(GetOrphStr(SCColorFuchsia));
- Items.Add(GetOrphStr(SCColorAqua));
- Items.Add(GetOrphStr(SCColorLightGray));
- Items.Add(GetOrphStr(SCColorMediumGray));
- Items.Add(GetOrphStr(SCColorDarkGray));
- Items.Add(GetOrphStr(SCColorWhite));
- Items.Add(GetOrphStr(SCColorMoneyGreen));
- Items.Add(GetOrphStr(SCColorSkyBlue));
- Items.Add(GetOrphStr(SCColorCream));
-
- ItemIndex := 0;
-{$ENDIF}
-end;
-
-destructor TOvcCustomColorComboBox.Destroy;
-begin
- inherited;
-end;
-
-{ - modified}
-procedure TOvcCustomColorComboBox.CreateWnd;
-begin
- inherited CreateWnd;
-
-{$IFNDEF LCL} //See note above.
- Text := '';
- Items.Clear;
- Items.Add(GetOrphStr(SCColorBlack));
- Items.Add(GetOrphStr(SCColorMaroon));
- Items.Add(GetOrphStr(SCColorGreen));
- Items.Add(GetOrphStr(SCColorOlive));
- Items.Add(GetOrphStr(SCColorNavy));
- Items.Add(GetOrphStr(SCColorPurple));
- Items.Add(GetOrphStr(SCColorTeal));
- Items.Add(GetOrphStr(SCColorGray));
- Items.Add(GetOrphStr(SCColorSilver));
- Items.Add(GetOrphStr(SCColorRed));
- Items.Add(GetOrphStr(SCColorLime));
- Items.Add(GetOrphStr(SCColorYellow));
- Items.Add(GetOrphStr(SCColorBlue));
- Items.Add(GetOrphStr(SCColorFuchsia));
- Items.Add(GetOrphStr(SCColorAqua));
- Items.Add(GetOrphStr(SCColorLightGray));
- Items.Add(GetOrphStr(SCColorMediumGray));
- Items.Add(GetOrphStr(SCColorDarkGray));
- Items.Add(GetOrphStr(SCColorWhite));
- Items.Add(GetOrphStr(SCColorMoneyGreen));
- Items.Add(GetOrphStr(SCColorSkyBlue));
- Items.Add(GetOrphStr(SCColorCream));
-
- ItemIndex := 0;
-{$ENDIF}
-end;
-
-procedure TOvcCustomColorComboBox.DrawItem(Index : Integer; Rect : TRect;
- State : TOwnerDrawState);
-var
- BC : TColor;
- S : string;
-begin
- {get selected color and text to display}
- if Index > -1 then begin
- S := Items[Index];
- BC := ColorFromString(S);
- end else begin
- S := GetOrphStr(SCColorBlack);
- BC := clBlack;
- end;
-
- CalculateBoxWidth;
-
- Canvas.Font.Color := Font.Color;
- Canvas.Brush.Color := Color;
-
- if FShowColorNames then begin
- Canvas.Pen.Color := Canvas.Brush.Color;
- Canvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
- Inc(Rect.Left);
- DrawText(Canvas.Handle, @S[1], Length(S), Rect,
- DT_LEFT or DT_VCENTER or DT_SINGLELINE);
- end;
-
- Canvas.Pen.Color := Font.Color;
- Canvas.Brush.Color := BC;
- Canvas.Rectangle(ClientWidth - BoxWidth, Rect.Top + 1, Rect.Right -1,
- Rect.Bottom - 1);
-end;
-
-function TOvcCustomColorComboBox.GetSelectedColor : TColor;
-begin
- if ItemIndex > -1 then
- Result := ColorFromString(Items[ItemIndex])
- else
- Result := clBlack;
-end;
-
-procedure TOvcCustomColorComboBox.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
-begin
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
- BoxWidth := 0;
- Invalidate;
-end;
-
-procedure TOvcCustomColorComboBox.SetSelectedColor(Value : TColor);
-var
- I : Integer;
-begin
- for I := 0 to Pred(Items.Count) do
- if Value = ColorFromString(Items[I]) then begin
- ItemIndex := I;
- Change;
- Break;
- end;
-end;
-
-{ - New}
-function TOvcCustomColorComboBox.ColorFromString(Str: string):TColor;
-begin
- if Str = GetOrphStr(SCColorBlack) then result := clBlack
- else if Str = GetOrphStr(SCColorMaroon) then result := clMaroon
- else if Str = GetOrphStr(SCColorGreen) then result := clGreen
- else if Str = GetOrphStr(SCColorOlive) then result := clOlive
- else if Str = GetOrphStr(SCColorNavy) then result := clNavy
- else if Str = GetOrphStr(SCColorPurple) then result := clPurple
- else if Str = GetOrphStr(SCColorTeal) then result := clTeal
- else if Str = GetOrphStr(SCColorGray) then result := clGray
- else if Str = GetOrphStr(SCColorSilver) then result := clSilver
- else if Str = GetOrphStr(SCColorRed) then result := clRed
- else if Str = GetOrphStr(SCColorLime) then result := clLime
- else if Str = GetOrphStr(SCColorYellow) then result := clYellow
- else if Str = GetOrphStr(SCColorBlue) then result := clBlue
- else if Str = GetOrphStr(SCColorFuchsia) then result := clFuchsia
- else if Str = GetOrphStr(SCColorAqua) then result := clAqua
- else if Str = GetOrphStr(SCColorLightGray) then result := TColor($C0C0C0)
- else if Str = GetOrphStr(SCColorMediumGray) then result := TColor($A4A0A0)
- else if Str = GetOrphStr(SCColorDarkGray) then result := TColor($808080)
- else if Str = GetOrphStr(SCColorWhite) then result := clWhite
- else if Str = GetOrphStr(SCColorMoneyGreen) then result := TColor($C0DCC0)
- else if Str = GetOrphStr(SCColorSkyBlue) then result := TColor($F0CAA6)
- else if Str = GetOrphStr(SCColorCream) then result := TColor($F0FBFF)
- else result := clBlack;
-end;
-
-procedure TOvcCustomColorComboBox.SetShowColorNames(Value : Boolean);
-begin
- if Value <> FShowColorNames then begin
- FShowColorNames := Value;
- BoxWidth := 0;
- Invalidate;
- end;
-end;
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovccmbx.pas b/Source/3rdParty/Orpheus/ovccmbx.pas
deleted file mode 100644
index 95bbb089..00000000
--- a/Source/3rdParty/Orpheus/ovccmbx.pas
+++ /dev/null
@@ -1,1711 +0,0 @@
-{*********************************************************}
-{* OVCCMBX.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 ovccmbx;
-
-interface
-
-uses
- SysUtils, Classes,
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, MyMisc, {$ENDIF}
- Graphics, Controls, Forms, StdCtrls,
- Buttons, OvcBase, OvcConst, OvcData, OvcMisc, OvcBordr {$IFNDEF LCL}, OvcTimer {$ENDIF};
-
-type
- {this class implements a stack for keeping track of
- most recently used items in the ComboBox}
- TOvcMRUList = class
- protected {private}
- {property variables}
- FMaxItems : Integer; {maximum items to keep}
- FList : TStrings; {the items themselves}
-
- {property methods}
- procedure SetMaxItems(Value: Integer);
-
- public
- procedure Clear;
- constructor Create;
- destructor Destroy;
- override;
-
- procedure NewItem(const Item : string; Obj : TObject);
- procedure Shrink;
- function RemoveItem(const Item : string) : Boolean;
-
- property Items : TStrings
- read FList;
-
- property MaxItems : Integer
- read FMaxItems
- write SetMaxItems;
- end;
-
-const
- cbxSeparatorHeight = 3;
-
-type
- TOvcComboStyle = (ocsDropDown, ocsDropDownList);
-
- TOvcHTColors = class(TPersistent)
- protected {private}
- FHighlight : TColor;
- FShadow : TColor;
-
- public
- constructor Create;
- virtual;
-
- published
- property Highlight : TColor
- read FHighlight
- write FHighlight
- default clBtnHighlight;
-
- property Shadow : TColor
- read FShadow
- write FShadow
- default clBtnShadow;
- end;
-
- TOvcBaseComboBox = class(TCustomComboBox)
- protected {private}
- {property variables}
- FAutoSearch : Boolean;
- FBorders : TOvcBorders;
- FDrawingEdit : Boolean;
- FDroppedWidth : Integer;
- FHotTrack : Boolean;
- FHTBorder : Boolean;
- FHTColors : TOvcHTColors;
- FKeyDelay : Integer;
- FItemHeight : Integer; {hides inherited property}
- FLabelInfo : TOvcLabelInfo;
- FMRUListColor : TColor;
- FMRUListCount : Integer;
- FStyle : TOvcComboStyle;
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
-
- {event variables}
- FAfterEnter : TNotifyEvent;
- FAfterExit : TNotifyEvent;
- FOnMouseWheel : TMouseWheelEvent;
- FOnSelChange : TNotifyEvent; {called when the selection changes}
-
- {internal variables}
- FEventActive : Boolean;
- FIsFocused : Boolean;
- FIsHot : Boolean;
- FLastKeyWasBackSpace : Boolean;
- FMRUList : TOvcMRUList;
- FList : TStringList; {Items sans MRU Items}
- FListIndex : Integer; {ItemIndex sans MRU Items}
- FSaveItemIndex : Integer;
- FStandardHomeEnd : Boolean;
- FTimer : Integer; {timer-pool handle}
-
- FCurItemIndex : integer;
-
- {internal methods}
- procedure HotTimerEvent(Sender : TObject; Handle : Integer;
- Interval : Cardinal; ElapsedTime : LongInt);
- procedure TimerEvent(Sender : TObject; Handle : Integer;
- Interval : Cardinal; ElapsedTime : LongInt);
-
- {property methods}
- procedure SetAbout(const Value : string);
- procedure SetDroppedWidth(Value : Integer);
- procedure SetHotTrack(Value : Boolean);
- procedure SetItemHeight(Value : Integer);
- {$IFDEF VERSION6}reintroduce;{$ENDIF}
- function GetListIndex: Integer;
- procedure SetListIndex(Value: Integer);
- function GetList : TStrings;
- function GetMRUList: TStrings;
- procedure SetKeyDelay(Value : Integer);
- procedure SetMRUListCount(Value : Integer);
- procedure SetOcbStyle(Value : TOvcComboStyle);
- procedure SetStandardHomeEnd(Value : Boolean);
-
- {internal methods}
- procedure AddItemToMRUList(Index: Integer);
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
- procedure CheckHot(HotWnd : TOvcHWnd{hWnd});
-
- function GetAttachedLabel : TOvcAttachedLabel;
- function GetAbout : string;
- procedure LabelAttach(Sender : TObject; Value : Boolean);
- procedure LabelChange(Sender : TObject);
- procedure PositionLabel;
- procedure RecalcHeight;
- procedure SetHot;
- procedure UpdateMRUList;
- procedure UpdateMRUListModified;
- procedure MRUListUpdate(Count : Integer);
-
- {private message methods}
- procedure OMAssignLabel(var Msg : TMessage);
- message OM_ASSIGNLABEL;
- procedure OMPositionLabel(var Msg : TMessage);
- message OM_POSITIONLABEL;
- procedure OMRecordLabelPosition(var Msg : TMessage);
- message OM_RECORDLABELPOSITION;
- procedure OMAfterEnter(var Msg : TMessage);
- message OM_AFTERENTER;
- procedure OMAfterExit(var Msg : TMessage);
- message OM_AFTEREXIT;
-
- {windows message methods}
- procedure CNCommand(var Message: TWmCommand);
- message CN_COMMAND;
- procedure CNDrawItem(var Msg : TWMDrawItem);
- message CN_DRAWITEM;
- procedure WMKillFocus(var Msg : TWMKillFocus);
- message WM_KILLFOCUS;
- procedure WMMeasureItem(var Message : TMessage);
- message WM_MEASUREITEM;
- procedure WMMouseWheel(var Msg : TMessage);
- message WM_MOUSEWHEEL;
- procedure WMSetFocus(var Msg : TWMSetFocus);
- message WM_SETFOCUS;
-
- {VCL message methods}
- procedure CMVisibleChanged(var Msg : TMessage);
- message CM_VISIBLECHANGED;
- procedure CMFontChanged(var Message: TMessage);
- message CM_FONTCHANGED;
- procedure CMMouseEnter (var Message : TMessage); message CM_MOUSEENTER;
- procedure CMMouseLeave (var Message : TMessage); message CM_MOUSELEAVE;
-
- protected
- {descendants can set the value of this variable after calling inherited }
- {create to set the default location and point-of-reference (POR) for the}
- {attached label. if dlpTopLeft, the default location and POR will be at }
- {the top left of the control. if dlpBottomLeft, the default location and}
- {POR will be at the bottom left}
- DefaultLabelPosition : TOvcLabelPosition;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
- procedure ComboWndProc(var Message: TMessage;
- ComboWnd: TOvcHWnd{HWnd}; ComboProc: Pointer);
- {$IFDEF CBuilder} reintroduce; {$ELSE} {$IFNDEF LCL} override; {$ENDIF} {$ENDIF}
-
- procedure CreateParams(var Params : TCreateParams);
- override;
- procedure CreateWnd;
- override;
- procedure DestroyWnd;
- override;
- procedure DoOnMouseWheel(Shift : TShiftState;
- Delta, XPos, YPos : SmallInt);
- dynamic;
- procedure DoExit;
- override;
- procedure DrawItem(Index : Integer; ItemRect : TRect; State : TOwnerDrawState);
- override;
- procedure KeyDown(var Key : Word; Shift: TShiftState);
- override;
- procedure Loaded;
- override;
- procedure MeasureItem(Index : Integer; var IHeight : Integer);
- override;
- procedure Notification(AComponent : TComponent; Operation : TOperation);
- override;
- procedure WndProc(var Message: TMessage);
- override;
-
- procedure SelectionChanged;
- virtual;
-
- procedure BorderChanged(ABorder : TObject);
- procedure Paint;
- procedure PaintBorders;
-
-{ - Hdc changed to TOvcHdc for BCB Compatibility }
- procedure PaintWindow(DC : TOvcHdc{HDC});
- {$IFDEF CBuilder} reintroduce; {$ELSE} override; {$ENDIF}
-
- procedure WMPaint(var Msg : TWMPaint); message WM_PAINT;
-
- procedure SetHTBorder(Value : Boolean);
- procedure SetHTColors(Value : TOvcHTColors);
-
- {properties}
- property About : string
- read GetAbout write SetAbout stored False;
- property AutoSearch : Boolean
- read FAutoSearch write FAutoSearch
- default True;
- property ItemHeight: Integer
- read FItemHeight write SetItemHeight;
- property KeyDelay : Integer
- read FKeyDelay write SetKeyDelay
- default 500;
- property LabelInfo : TOvcLabelInfo
- read FLabelInfo write FLabelInfo;
- property MRUListColor: TColor
- read FMRUListColor write FMRUListColor
- default clWindow;
- property MRUListCount : Integer
- read FMRUListCount write SetMRUListCount
- default 3;
- property Style : TOvcComboStyle
- read FStyle write SetOcbStyle;
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D;
-{$ENDIF}
-
- {events}
- property AfterEnter : TNotifyEvent
- read FAfterEnter write FAfterEnter;
- property AfterExit : TNotifyEvent
- read FAfterExit write FAfterExit;
-
- property OnMouseWheel : TMouseWheelEvent
- read FOnMouseWheel write FOnMouseWheel;
-
- property OnSelectionChange : TNotifyEvent
- read FOnSelChange write FOnSelChange;
-
- public
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
- property DrawingEdit : Boolean
- read FDrawingEdit;
-
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
- override;
- function AddItem(const Item : string;
- AObject : TObject) : Integer;
- {$IFDEF VERSION4}reintroduce;{$ENDIF}
- procedure AssignItems(Source: TPersistent);
- procedure ClearItems;
- procedure InsertItem(Index : Integer; const Item : string;
- AObject: TObject);
- procedure RemoveItem(const Item : string);
-
- procedure ClearMRUList;
- procedure ForceItemsToMRUList(Value: Integer);
-
- property AttachedLabel : TOvcAttachedLabel
- read GetAttachedLabel;
-
- property DroppedWidth : Integer
- read FDroppedWidth
- write SetDroppedWidth
- default -1;
-
- property HotTrack : Boolean
- read FHotTrack
- write SetHotTrack
- default False;
-
- property List: TStrings
- read GetList;
-
- property ListIndex: Integer
- read GetListIndex write SetListIndex;
-
- property MRUList: TStrings
- read GetMRUList;
-
- property StandardHomeEnd : Boolean
- read FStandardHomeEnd write SetStandardHomeEnd;
-
- published
- property Borders : TOvcBorders
- read FBorders
- write FBorders;
-
- property HotTrackBorder : Boolean
- read FHTBorder
- write SetHTBorder
- default True;
-
- property HotTrackColors : TOvcHTColors
- read FHTColors
- write SetHTColors;
- {$IFDEF VERSION6}
- property AutoComplete
- default False;
- {$ENDIF}
- end;
-
- {TOvcComboBox}
-
- TOvcComboBox = class(TOvcBaseComboBox)
- published
- {properties}
- {$IFDEF VERSION4}
- property Anchors;
- property Constraints;
- property DragKind;
- {$ENDIF}
- property About;
- property AutoSearch;
- property Color;
- property Ctl3D;
- property Cursor;
- property DragCursor;
- property DragMode;
- property DropDownCount;
- property DroppedWidth;
- property Enabled;
- property Font;
- property HotTrack;
-{$IFNDEF LCL}
- property ImeMode;
- property ImeName;
-{$ENDIF}
- property ItemHeight;
- property Items;
- property KeyDelay;
- property LabelInfo;
- property MaxLength;
- property MRUListColor;
- property MRUListCount;
- property ParentColor;
-{$IFNDEF LCL}
- property ParentCtl3D;
-{$ENDIF}
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ShowHint;
- property Sorted;
- property Style default ocsDropDown;
- property TabOrder;
- property TabStop;
- property Text;
- property Visible;
-
- {events}
- property AfterEnter;
- property AfterExit;
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnDropDown;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnSelectionChange;
- property OnStartDrag;
- property OnMouseWheel;
- end;
-
-implementation
-
-uses
- OvcVer, OvcExcpt;
-
-constructor TOvcHTColors.Create;
-begin
- inherited Create;
-
- {create color objects and assign defaults}
- FHighlight := clBtnHighlight;
- FShadow := clBtnShadow;
-end;
-
-{*** TOvcMRUList ***}
-
-constructor TOvcMRUList.Create;
-begin
- FList := TStringList.Create;
- FMaxItems := 3;
-end;
-
-destructor TOvcMRUList.Destroy;
-begin
- FList.Free;
-
- inherited Destroy;
-end;
-
-procedure TOvcMRUList.NewItem(const Item: string; Obj: TObject);
-var
- Index: Integer;
-begin
- Index := FList.IndexOf(Item);
- if Index > -1 then begin
- { If the item is already in the list, just bring it to the top }
- FList.Delete(Index);
- FList.InsertObject(0, Item, Obj);
- end else begin
- FList.InsertObject(0, Item, Obj);
- {this may result in more items in the list than are allowed,}
- {but a call to Shrink will remove the excess items}
- Shrink;
- end;
-end;
-
-function TOvcMRUList.RemoveItem(const Item : string) : Boolean;
-var
- Index : Integer;
-begin
- Index := FList.IndexOf(Item);
- if (Index > -1) and (Index < FList.Count) then begin
- FList.Delete(Index);
- Result := True;
- end else
- Result := False;
-end;
-
-procedure TOvcMRUList.Shrink;
-begin
- while FList.Count > FMaxItems do
- FList.Delete(FList.Count - 1);
-end;
-
-procedure TOvcMRUList.Clear;
-begin
- FList.Clear;
-end;
-
-procedure TOvcMRUList.SetMaxItems(Value: Integer);
-begin
- FMaxItems := Value;
- Shrink;
-end;
-
-
-{*** TOvcBaseComboBox ***}
-
-procedure TOvcBaseComboBox.CMVisibleChanged(var Msg : TMessage);
-begin
- inherited;
-
- if csLoading in ComponentState then
- Exit;
-
- if LabelInfo.Visible then
- AttachedLabel.Visible := Visible;
-end;
-
-procedure TOvcBaseComboBox.ClearItems;
-begin
- ClearMRUList;
- if HandleAllocated then
- Clear;
-end;
-
-procedure TOvcBaseComboBox.ClearMRUList;
-var
- I : Integer;
-begin
- if (FMRUList.Items.Count > 0) then begin
- for I := 1 to FMRUList.Items.Count do
- if (I <= Items.Count) then
- Items.Delete(0);
- FMRUList.Clear;
- end;
-end;
-
-{ - added}
-procedure TOvcBaseComboBox.ForceItemsToMRUList(Value: Integer);
-var
- I, J: Integer;
- Str: string;
-begin
- if (Value > 0) or (Value <= FMRUList.MaxItems) then begin
- for I := 0 to pred(Value) do begin
- Str := Items.Strings[I];
- J := I + 1;
- while (J < Items.Count) and (Items.Strings[J] <> Str) do
- Inc(J);
- if (J < Items.Count) then begin
- Items.Delete(I);
- AddItemToMRUList(J - 1);
- end;
- end;
- end;
-
- UpdateMRUList;
-end;
-
-procedure TOvcBaseComboBox.CNDrawItem(var Msg : TWMDrawItem);
-begin
- {gather flag information that Borland left out}
- FDrawingEdit := (ODS_COMBOBOXEDIT and Msg.DrawItemStruct.itemState) <> 0;
- inherited;
-end;
-
-function TOvcBaseComboBox.GetList : TStrings;
-var
- I : Integer;
-begin
- FList.Clear;
- FList.Assign(Items);
- if FMRUList.Items.Count > 0 then
- for I := 0 to Pred(FMRUList.Items.Count) do
- FList.Delete(0);
- Result := FList;
-end;
-
-{ - Added}
-function TOvcBaseComboBox.GetMRUList: TStrings;
-begin
- result := FMRUList.FList;
-end;
-
-procedure TOvcBaseComboBox.SetListIndex(Value : Integer);
- {Value is the index into the list sans MRU items}
-var
- I : Integer;
-begin
- I := FMRUList.Items.Count;
- if (((Value + I) < Items.Count) and (Value >= 0)) then
- ItemIndex := Value + I
- else
- ItemIndex := -1;
-end;
-
-function TOvcBaseComboBox.GetListIndex;
- {Translates ItemIndex into index sans MRU Items}
-begin
- Result := ItemIndex - FMRUList.Items.Count;
-end;
-
-procedure TOvcBaseComboBox.AssignItems(Source: TPersistent);
-begin
- Clear;
- Items.Assign(Source);
- RecalcHeight;
-end;
-
-function TOvcBaseComboBox.AddItem(const Item :
- string; AObject : TObject) : Integer;
-begin
- Result := -1;
- if (Items.IndexOf(Item) < 0) then begin
- Result := Items.AddObject(Item, AObject) - FMRUList.Items.Count;
- UpdateMRUList;
- end;
- RecalcHeight;
-end;
-
-procedure TOvcBaseComboBox.InsertItem(Index : Integer;
- const Item : string; AObject: TObject);
-var
- I : Integer;
-begin
- I := FMRUList.Items.Count;
- if (Index> -1) and (Index < (Items.Count - I)) then begin
- Items.InsertObject(Index + I, Item, AObject);
- UpdateMRUList;
- end;
- RecalcHeight;
-end;
-
-procedure TOvcBaseComboBox.RemoveItem(const Item : string);
-var
- I : Integer;
- SelChange : Boolean;
-begin
- if FMRUList.RemoveItem(Item) then
- UpdateMRUListModified;
- I := Items.IndexOf(Item);
- if (I > -1) then begin
- SelChange := (ItemIndex = I);
- Items.Delete(I);
- UpdateMRUList;
- if SelChange then begin
- Text := '';
- SelectionChanged;
- end;
- RecalcHeight;
- end;
-end;
-
-procedure TOvcBaseComboBox.AddItemToMRUList(Index: Integer);
-var
- I : Integer;
-begin
- I := FMRUList.Items.Count;
- if (I > -1) and (Index > -1) then begin
- FMRUList.NewItem(Items[Index], Items.Objects[Index]);
- if FMRUList.Items.Count > I then
- Items.InsertObject(0, Items[Index], Items.Objects[Index]);
- end;
-end;
-
-procedure TOvcBaseComboBox.UpdateMRUList;
-begin
- MRUListUpdate(FMRUList.Items.Count);
-end;
-
-procedure TOvcBaseComboBox.UpdateMRUListModified;
- {Use this to update MRUList after removing item from MRUList}
-begin
- MRUListUpdate(FMRUList.Items.Count + 1);
-end;
-
-procedure TOvcBaseComboBox.MRUListUpdate(Count : Integer);
-var
- I,
- L : Integer;
- SrchText : PChar;
-begin
- L := Length(Text) + 1;
- GetMem(SrchText, L);
- try
- StrPCopy(SrchText, Text);
- {the first items are part of the MRU list}
- if (Count > 0) then
- for I := 1 to Count do
- Items.Delete(0);
- {make sure the MRU list is limited to its maximum size}
- FMRUList.Shrink;
- {add the MRU list items to the beginning of the combo list}
- if (FMRUList.Items.Count > 0) then begin
- for I := Pred(FMRUList.Items.Count) downto 0 do
- Items.InsertObject(0, FMRUList.Items[I], FMRUList.Items.Objects[I]);
-
- {this is necessary because we are always inserting item 0 and Windows
- thinks that it knows the height of all other items, so it only sends
- a WM_MEASUREITEM for item 0. We need the last item of the MRU list
- to be taller so we can draw a separator under it}
- SendMessage(Handle, CB_SETITEMHEIGHT, wParam(FMRUList.Items.Count - 1),
- lParam(FItemHeight + cbxSeparatorHeight));
- end;
- ItemIndex := SendMessage(Handle,
- CB_FINDSTRINGEXACT,
- FMRUList.Items.Count - 1,
- LPARAM(SrchText)); //64
- finally
- FreeMem(SrchText, L);
- end;
-end;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
-procedure TOvcBaseComboBox.CheckHot(HotWnd : TOvcHWnd{hWnd});
-begin
- if FIsHot and ((HotWnd <> Handle)
- {$IFNDEF LCL} and (HotWnd <> EditHandle) {$ENDIF}) then begin
- FIsHot := False;
- Invalidate;
- end;
-end;
-
-procedure TOvcBaseComboBox.CMFontChanged(var Message: TMessage);
-begin
- if not (csLoading in ComponentState) then
- RecalcHeight
-end;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
-procedure TOvcBaseComboBox.ComboWndProc(var Message: TMessage;
- ComboWnd: TOvcHWnd{HWnd}; ComboProc: Pointer);
-begin
- if HotTrack and (Message.Msg = WM_NCHITTEST) then
- SetHot;
- {$IFDEF CBuilder}
- inherited ComboWndProc(Message, HWnd(ComboWnd), ComboProc);
- {$ELSE}
-{$IFNDEF LCL}
- inherited ComboWndProc(Message, ComboWnd, ComboProc);
-{$ENDIF}
- {$ENDIF}
-end;
-
-procedure TOvcBaseComboBox.CNCommand(var Message: TWmCommand);
-begin
- if Message.NotifyCode = CBN_DROPDOWN then begin
- FCurItemIndex := ItemIndex;
- end else if Message.NotifyCode = CBN_CLOSEUP then begin
- if ItemIndex > -1 then begin
- AddItemToMRUList(ItemIndex);
- Text := Items[ItemIndex];
- Click;
- SelectionChanged;
- end;
- end;
-
- if HotTrack then
- case Message.NotifyCode of
- CBN_CLOSEUP :
- Invalidate;
- CBN_SETFOCUS:
- begin
- FIsFocused := True;
- Invalidate;
- end;
- CBN_KILLFOCUS:
- begin
- FIsFocused := False;
- Invalidate;
- end;
- end;
- inherited;
-end;
-
-constructor TOvcBaseComboBox.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- {$IFDEF VERSION6}
- AutoComplete := false;
- {$ENDIF}
-
- FLabelInfo := TOvcLabelInfo.Create;
- FLabelInfo.OnChange := LabelChange;
- FLabelInfo.OnAttach := LabelAttach;
- DefaultLabelPosition := lpTopLeft;
-
- FList := TStringList.Create;
- FMRUList := TOvcMRUList.Create;
-
- FAutoSearch := True;
- FDroppedWidth := -1;
- FMRUListColor := clWindow;
- FMRUListCount := 3;
- FKeyDelay := 500;
-
- FSaveItemIndex := -1;
- FStandardHomeEnd := True;
-
- FTimer := -1;
- FLastKeyWasBackSpace := False;
-
- {create borders class and assign notifications}
- FBorders := TOvcBorders.Create;
-
- FBorders.LeftBorder.OnChange := BorderChanged;
- FBorders.RightBorder.OnChange := BorderChanged;
- FBorders.TopBorder.OnChange := BorderChanged;
- FBorders.BottomBorder.OnChange := BorderChanged;
-
- FHTBorder := True;
- FHTColors := TOvcHTColors.Create;
- RecalcHeight;
-end;
-
-procedure TOvcBaseComboBox.CreateParams(var Params : TCreateParams);
-begin
- inherited CreateParams(Params);
-
- Params.Style := Params.Style or (WS_VSCROLL or CBS_HASSTRINGS or CBS_AUTOHSCROLL);
- case FStyle of
- ocsDropDown :
- Params.Style := Params.Style or CBS_DROPDOWN or CBS_OWNERDRAWVARIABLE;
- ocsDropDownList :
- Params.Style := Params.Style or CBS_DROPDOWNLIST or CBS_OWNERDRAWVARIABLE;
- end;
- if NewStyleControls and Ctl3D then
- Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
-{$IFDEF LCL} //Ancestor's Style needs to be set with LCL.
- case FStyle of
- ocsDropDown : inherited SetStyle(csDropDown);
- ocsDropDownList : inherited SetStyle(csDropDownList);
- end;
-{$ENDIF}
-end;
-
-procedure TOvcBaseComboBox.CreateWnd;
-begin
- inherited CreateWnd;
-
- if FSaveItemIndex > -1 then begin
- ItemIndex := FSaveItemIndex;
- FSaveItemIndex := -1;
- end;
-
- if FDroppedWidth <> -1 then
- SendMessage(Handle,CB_SETDROPPEDWIDTH,FDroppedWidth,0);
-end;
-
-destructor TOvcBaseComboBox.Destroy;
-begin
- FLabelInfo.Visible := False;
- FLabelInfo.Free;
- FLabelInfo := nil;
-
- FMRUList.Free;
- FMRUList := nil;
- FList.Free;
- FList := nil;
-
- if (FTimer > -1) then begin
-{$IFNDEF LCL}
- DefaultController.TimerPool.Remove(FTimer);
-{$ENDIF}
- FTimer := -1;
- end;
-
- FBorders.Free;
- FBorders := nil;
-
- FHTColors.Free;
- FHTColors := nil;
-
- inherited Destroy;
-end;
-
-procedure TOvcBaseComboBox.DestroyWnd;
-begin
- FSaveItemIndex := ItemIndex;
-
- inherited DestroyWnd;
-end;
-
-procedure TOvcBaseComboBox.DoExit;
-begin
- AddItemToMRUList(ItemIndex);
-
- inherited DoExit;
-end;
-
-procedure TOvcBaseComboBox.DoOnMouseWheel(Shift : TShiftState;
- Delta, XPos, YPos : SmallInt);
-begin
- if Assigned(FOnMouseWheel) then
- FOnMouseWheel(Self, Shift, Delta, XPos, YPos);
-end;
-
-procedure TOvcBaseComboBox.DrawItem(Index : Integer; ItemRect: TRect;
- State : TOwnerDrawState);
-var
- SepRect : TRect;
- BkColor : TColor;
- TxtRect : TRect;
- TxtItem : PChar;
- L : integer;
- BkMode : Integer;
-begin
- with Canvas do begin
- if (FMRUList.Items.Count > 0) and (Index < FMRUList.Items.Count) then
- BkColor := FMRUListColor
- else
- BkColor := Color;
-
- if odSelected in State then
- Brush.Color := clHighlight
- else
- Brush.Color := BkColor;
- FillRect(ItemRect);
-
- with ItemRect do
- TxtRect := Rect(Left + 2, Top, Right, Bottom);
- L := Length(Items[Index])+1;
- GetMem(TxtItem, L);
- try
- StrPCopy(TxtItem, Items[Index]);
- BkMode := GetBkMode(Canvas.Handle);
- SetBkMode(Canvas.Handle, TRANSPARENT);
- DrawText(Canvas.Handle, TxtItem, StrLen(TxtItem),
- TxtRect, DT_VCENTER or DT_LEFT);
- SetBkMode(Canvas.Handle, BkMode);
- if (FMRUList.Items.Count > 0) and
- (Index = FMRUList.Items.Count - 1) and DroppedDown then begin
- SepRect := ItemRect;
- SepRect.Top := SepRect.Bottom - cbxSeparatorHeight;
- SepRect.Bottom := SepRect.Bottom;
- Pen.Color := clGrayText;
-
- if not DrawingEdit then
- with SepRect do
- Rectangle(Left-1, Top, Right+1, Bottom);
- end;
- finally
- FreeMem(TxtItem, L);
- end;
- end;
-end;
-
-function TOvcBaseComboBox.GetAttachedLabel : TOvcAttachedLabel;
-begin
- if not FLabelInfo.Visible then
- raise Exception.Create(GetOrphStr(SCLabelNotAttached));
-
- Result := FLabelInfo.ALabel;
-end;
-
-function TOvcBaseComboBox.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-
-procedure TOvcBaseComboBox.HotTimerEvent(Sender : TObject;
- Handle : Integer; Interval : Cardinal; ElapsedTime : LongInt);
-var
- P : TPoint;
- WindowHandle : THandle;
-begin
- if FEventActive then
- exit;
- FEventActive := True;
- if FIsHot and Visible and HandleAllocated then begin
- GetCursorPos(P);
- WindowHandle := WindowFromPoint(P);
- CheckHot(WindowHandle);
- end;
- FEventActive := False;
-end;
-
-procedure TOvcBaseComboBox.KeyDown(var Key: Word; Shift: TShiftState);
-var
- Index : Integer;
- SrchText: PChar;
-begin
- FLastKeyWasBackSpace := False;
- case Key of
- VK_RETURN, 9999{timer event}:
- begin
- GetMem(SrchText, length(Text) + 1);
- try
- StrPCopy(SrchText, Text);
- {this will search for the first matching item}
- Index := SendMessage(Handle, CB_FINDSTRING,
- FMRUList.Items.Count - 1,
- LPARAM(SrchText)); //64
- finally
- FreeMem(SrchText, length(Text) + 1);
- end;
- if Index > -1 then begin
- Text := Items[Index];
- if Key = VK_RETURN then
- Click;
- SelLength := Length(Text);
- SelectionChanged;
- end else if Key = VK_RETURN then
- MessageBeep(0);
- end;
- VK_HOME:
- begin
- if (not StandardHomeEnd) then begin
- if Shift = [] then begin
- ItemIndex := 0;
- Change;
- end;
- end;
- end;
- VK_END:
- begin
- if (not StandardHomeEnd) then begin
- if Shift = [] then begin
- ItemIndex := Items.Count - 1;
- Change;
- end;
- end;
- end;
- VK_BACK:
- FLastKeyWasBackSpace := True;
- VK_ESCAPE:
- begin
- ItemIndex := 0;
- Change;
- end;
- else
- case Key of
- VK_LBUTTON, VK_RBUTTON, VK_CANCEL, VK_MBUTTON, VK_BACK,
- VK_TAB, VK_CLEAR, VK_RETURN, VK_SHIFT, VK_CONTROL, VK_MENU,
- VK_PAUSE, VK_CAPITAL, VK_ESCAPE, VK_PRIOR, VK_NEXT, VK_END,
- VK_HOME, VK_LEFT, VK_UP, VK_RIGHT, VK_DOWN, VK_SELECT, VK_PRINT,
- VK_EXECUTE, VK_SNAPSHOT, VK_INSERT, VK_DELETE, VK_HELP,
- VK_F1..VK_F24, VK_NUMLOCK, VK_SCROLL :
- else
- {start/reset timer}
- if AutoSearch then begin
- {see if we need to reset the timer}
-{$IFNDEF LCL}
- if (FTimer <> -1) then
- DefaultController.TimerPool.Remove(FTimer);
- FTimer := DefaultController.TimerPool.AddOneTime(TimerEvent, FKeyDelay);
-{$ENDIF}
- end;
- end;
- end;
-
- inherited KeyDown(Key, Shift);
-end;
-
-procedure TOvcBaseComboBox.LabelAttach(Sender : TObject; Value : Boolean);
-var
- PF : TForm;
- S : string;
-begin
- if csLoading in ComponentState then
- Exit;
-
- PF := TForm(GetParentForm(Self));
- if Value then begin
- if Assigned(PF) then begin
- FLabelInfo.ALabel.Free;
- FLabelInfo.ALabel := TOvcAttachedLabel.CreateEx(PF, Self);
- FLabelInfo.ALabel.Parent := Parent;
-
- S := GenerateComponentName(PF, Name + 'Label');
- FLabelInfo.ALabel.Name := S;
- FLabelInfo.ALabel.Caption := S;
-
- FLabelInfo.SetOffsets(0, 0);
- PositionLabel;
- FLabelInfo.ALabel.BringToFront;
- {turn off auto size}
- FLabelInfo.ALabel.AutoSize := False;
- end;
- end else begin
- if Assigned(PF) then begin
- FLabelInfo.ALabel.Free;
- FLabelInfo.ALabel := nil;
- end;
- end;
-end;
-
-procedure TOvcBaseComboBox.LabelChange(Sender : TObject);
-begin
- if not (csLoading in ComponentState) then
- PositionLabel;
-end;
-
-procedure TOvcBaseComboBox.Loaded;
-begin
- inherited Loaded;
-
- RecalcHeight;
-end;
-
-procedure TOvcBaseComboBox.MeasureItem(Index : Integer; var IHeight : Integer);
-begin
- {because Item 0 is always the one queried by WM_MEASUREITEM, we
- set the item height of the last MRU item in the AddMRU
- method of TOvcBaseComboBox. This method is still necessary because we
- need the CB_OWNERDRAWVARIABLE style.}
- IHeight := FItemHeight;
-end;
-
-procedure TOvcBaseComboBox.Notification(AComponent : TComponent;
- Operation : TOperation);
-var
- PF : TForm;
-begin
- inherited Notification(AComponent, Operation);
-
- if Operation = opRemove then begin
- if Assigned(FLabelInfo) and (AComponent = FLabelInfo.ALabel) then begin
- PF := TForm(GetParentForm(Self));
- if Assigned(PF) and
- not (csDestroying in PF.ComponentState) then begin
- FLabelInfo.FVisible := False;
- FLabelInfo.ALabel := nil;
- end;
- end;
- end;
-end;
-
-procedure TOvcBaseComboBox.WndProc(var Message: TMessage);
-var
- PaintStruct : TPaintStruct;
- ArLeft : Integer;
- ds : TOwnerDrawState;
-begin
- if not HotTrack or (csDesigning in ComponentState) then begin
- inherited WndProc(Message);
- exit;
- end;
- if Message.Msg = WM_NCHitTest then begin
- inherited WndProc(Message);
- SetHot;
- end else
- if Message.Msg = WM_PAINT then begin
- BeginPaint(Handle,PaintStruct);
- ArLeft := Width - 15;
- with Canvas do begin
- Handle := PaintStruct.hdc;
- Font := Self.Font;
- Pen.Color := Color; {clBtnFace;}
- Brush.Color := Color; {clBtnFace;}
- Rectangle(0,0,Width,Height);
- if DroppedDown or FIsHot or FIsFocused then begin
- Pen.Width := 1;
- if (FHTBorder) then begin
- Pen.Color := FHTColors.FShadow;
- MoveTo(1,Height-2);
- LineTo(1,1);
- LineTo(Width-1,1);
- Pen.Color := FHTColors.FHighlight;
- MoveTo(Width-2,1);
- LineTo(Width-2,Height-2);
- LineTo(1,Height-2);
- Pen.Color := Color;
- MoveTo(2,2);
- LineTo(2,Height-3);
- LineTo(Width-3,Height-3);
- LineTo(Width-3,2);
- LineTo(2,2);
- end;
-
- if DroppedDown then begin
- Pen.Width := 1;
- Pen.Color := clBtnFace;
- Brush.Color := clBtnFace;
-{ Rectangle(ArLeft, 4, Width - 4, Height - 4);}
- DrawButtonFace(Canvas, Rect(ArLeft, 3, Width-3, Height-3),
- 1, bsAutoDetect, False, False, False);
- Brush.Color := clBlack;
- Pen.Color := clBlack;
- Polygon(
- [
- Point(ArLeft + 4, Height div 2),
- Point(ArLeft + 6, Height div 2 + 2),
- Point(ArLeft + 8, Height div 2)]);
- Pen.Color := clBtnHighlight;
- MoveTo(ArLeft,Height - 4);
- LineTo(Width - 4,Height - 4);
- LineTo(Width - 4,3);
- Pen.Color := clBtnShadow;
- MoveTo(ArLeft, Height - 4);
- LineTo(ArLeft, 3);
- LineTo(Width - 4, 3);
-
- if FStyle = ocsDropDownList then begin
- if FCurItemIndex <> -1 then
- DrawItem(FCurItemIndex,Rect(4,4,ArLeft-1,Height-3),[]);
- end;
- end else begin
- Pen.Color := clBtnFace;
- Pen.Width := 1;
- Brush.Color := clBtnFace;
-{ Rectangle(ArLeft, 4, Width - 4, Height - 4);}
- DrawButtonFace(Canvas, Rect(ArLeft, 3, Width-3, Height-3),
- 1, bsAutoDetect, False, False, False);
- Brush.Color := clBlack;
- Pen.Color := clBlack;
- Polygon(
- [
- Point(ArLeft + 3, Height div 2 - 1),
- Point(ArLeft + 5, Height div 2 + 1),
- Point(ArLeft + 7, Height div 2 - 1)]);
- Pen.Color := Color; {clWhite}
- MoveTo(ArLeft, Height - 4);
- LineTo(ArLeft, 3);
- LineTo(Width - 4, 3);
- if FIsFocused then begin
- ds := [odFocused];
- Font.Color := clHighLightText;
- end else begin
- ds := [];
- Font.Color := clWindowText;
- end;
- if FIsFocused and (ItemIndex <> -1) then begin
- ds := ds + [odSelected];
- Font.Color := clHighLightText;
- end;
- if FStyle = ocsDropDownList then
- if ItemIndex <> -1 then
- DrawItem(ItemIndex,Rect(4,4,ArLeft-1,Height-3),ds);
- end;
- Pen.Color := Color; {clBtnFace;}
- dec(ArLeft,2);
- MoveTo(ArLeft,3);
- LineTo(ArLeft,Height - 3);
- end else begin
- Brush.Color := Color; {clBtnHighlight;}
- Rectangle(2,2,Width-2,Height-2);
- Brush.Color := Color; {clBtnFace;}
- Rectangle(ArLeft, 4, Width - 4, Height - 4);
- Pen.Color := clBlack;
- Pen.Width := 1;
- Brush.Color := clBlack;
- Polygon(
- [
- Point(ArLeft + 3, Height div 2 - 1),
- Point(ArLeft + 5, Height div 2 + 1),
- Point(ArLeft + 7, Height div 2 - 1)]);
- Brush.Color := Color;
-
- Pen.Color := Color; {clBtnFace;}
- MoveTo(2,Height-3);
- LineTo(Width-3,Height-3);
- if FStyle = ocsDropDownList then
- if ItemIndex <> -1 then
- DrawItem(ItemIndex,Rect(4,4,ArLeft-1,Height-3),[]);
- end;
- PaintBorders;
- Handle := 0;
- end;
- EndPaint(Handle,PaintStruct);
- Message.Result := 1;
- end else
- inherited WndProc(Message);
-end;
-
-procedure TOvcBaseComboBox.OMAfterEnter(var Msg : TMessage);
-begin
- if Assigned(FAfterEnter) then
- FAfterEnter(Self);
-end;
-
-procedure TOvcBaseComboBox.OMAfterExit(var Msg : TMessage);
-begin
- if Assigned(FAfterExit) then
- FAfterExit(Self);
-end;
-
-procedure TOvcBaseComboBox.OMAssignLabel(var Msg : TMessage);
-begin
- FLabelInfo.ALabel := TOvcAttachedLabel(Msg.lParam);
-end;
-
-procedure TOvcBaseComboBox.OMPositionLabel(var Msg : TMessage);
-const
- DX : Integer = 0;
- DY : Integer = 0;
-begin
- if FLabelInfo.Visible and
- Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) and
- not (csLoading in ComponentState) then begin
- if DefaultLabelPosition = lpTopLeft then begin
- DX := FLabelInfo.ALabel.Left - Left;
- DY := FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top;
- end else begin
- DX := FLabelInfo.ALabel.Left - Left;
- DY := FLabelInfo.ALabel.Top - Top - Height;
- end;
- if (DX <> FLabelInfo.OffsetX) or (DY <> FLabelInfo.OffsetY) then
- PositionLabel;
- end;
-end;
-
-procedure TOvcBaseComboBox.OMRecordLabelPosition(var Msg : TMessage);
-begin
- if Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) then begin
- {if the label was cut and then pasted, this will complete the re-attachment}
- FLabelInfo.FVisible := True;
-
- if DefaultLabelPosition = lpTopLeft then
- FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
- FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top)
- else
- FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
- FLabelInfo.ALabel.Top - Top - Height);
- end;
-end;
-
-procedure TOvcBaseComboBox.PositionLabel;
-begin
- if FLabelInfo.Visible and Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) and
- not (csLoading in ComponentState) then begin
- if DefaultLabelPosition = lpTopLeft then begin
- FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
- FLabelInfo.OffsetY - FLabelInfo.ALabel.Height + Top,
- FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
- end else begin
- FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
- FLabelInfo.OffsetY + Top + Height,
- FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
- end;
- end;
-end;
-
-procedure TOvcBaseComboBox.RecalcHeight;
-var
- DC : HDC;
- F : HFont;
- M : TTextMetric;
-begin
- DC := GetDC(0);
- F := SelectObject(DC, Font.Handle);
- GetTextMetrics(DC, M);
- SelectObject(DC, F);
- ReleaseDC(0, DC);
- SetItemHeight(M.tmHeight - 1);
-end;
-
-procedure TOvcBaseComboBox.SelectionChanged;
-var
- L : Integer;
- SrchText : PChar;
-begin
- if FMRUListCount > 0 then
- UpdateMRUList
- else if (FList.Count > 0) and (FAutoSearch) then begin
- L := Length(Text) + 1;
- GetMem(SrchText, L);
- try
- StrPCopy(SrchText, Text);
- ItemIndex := SendMessage(Handle,
- CB_FINDSTRINGEXACT,
- 0,
- LPARAM(SrchText)); //64
- finally
- FreeMem(SrchText, L);
- end;
- end;
-
- if Assigned(FOnSelChange) then
- FOnSelChange(Self);
-end;
-
-procedure TOvcBaseComboBox.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
-begin
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-
- if HandleAllocated then
- PostMessage(Handle, OM_POSITIONLABEL, 0, 0);
-end;
-
-procedure TOvcBaseComboBox.SetDroppedWidth(Value : Integer);
-begin
- if Value <> FDroppedWidth then begin
- if HandleAllocated then
- if Value <> -1 then
- SendMessage(Handle,CB_SETDROPPEDWIDTH,Value,0)
- else
- SendMessage(Handle,CB_SETDROPPEDWIDTH,0,0);
- FDroppedWidth := Value;
- end;
-end;
-
-procedure TOvcBaseComboBox.SetHot;
-begin
- if not FIsHot {$IFNDEF LCL} and Application.Active {$ENDIF} then begin
- FIsHot := True;
- Invalidate;
- end;
-end;
-
-procedure TOvcBaseComboBox.SetHotTrack(Value : Boolean);
-begin
- if FHotTrack <> Value then begin
- FHotTrack := Value;
- Invalidate;
- end;
-end;
-
-{Changed !!.04}
-procedure TOvcBaseComboBox.SetItemHeight(Value : Integer);
-begin
- if Value <> FItemHeight then begin
- FItemHeight := Value;
- (* !!.05
- {$IFDEF VERSION6}
- inherited SetItemHeight(Value);
- {$ELSE}
- SetItemHeight(Value);
- {$ENDIF}
- *)
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- if HandleAllocated then //For some reason, handle may not be allocated.
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
-end;
-
-procedure TOvcBaseComboBox.SetMRUListCount(Value: Integer);
-begin
- if ([csDesigning, csLoading] * ComponentState) = [] then
- ClearMRUList;
- FMRUList.MaxItems := Value;
- FMRUListCount := Value;
-end;
-
-procedure TOvcBaseComboBox.SetKeyDelay(Value : Integer);
-begin
- if (Value <> FKeyDelay) and (Value >= 0) then begin
- FKeyDelay := Value;
- end;
-end;
-
-procedure TOvcBaseComboBox.SetOcbStyle(Value : TOvcComboStyle);
-begin
- if Value <> FStyle then begin
- FStyle := Value;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- if HandleAllocated then
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
-end;
-
-
-procedure TOvcBaseComboBox.SetStandardHomeEnd(Value : Boolean);
-begin
- if (Value <> FStandardHomeEnd) then
- FStandardHomeEnd := Value;
-end;
-
-
-
-procedure TOvcBaseComboBox.SetAbout(const Value : string);
-begin
-end;
-
-procedure TOvcBaseComboBox.TimerEvent(Sender : TObject;
- Handle : Integer; Interval : Cardinal; ElapsedTime : LongInt);
-var
- Key : Word;
- S : Word;
- SP : Word;
- EP : Integer;
-begin
- FTimer := -1;
- if FLastKeyWasBackSpace then
- Exit;
-
-(*
- S := Length(Text); {remember current length}
-*)
-{$IFNDEF LCL}
- SendMessage(Self.EditHandle, EM_GETSEL, WPARAM(@SP), LPARAM(@EP));
-{$ENDIF}
- S := SP;
- Key := 9999{timer event};
- {fake a key return to force the field to update}
- KeyDown(Key, []);
- SelStart := S;
- SelLength := Length(Text) - S;
-end;
-
-procedure TOvcBaseComboBox.WMKillFocus(var Msg : TWMKillFocus);
-begin
- inherited;
-
- PostMessage(Handle, OM_AFTEREXIT, 0, 0);
-end;
-
-procedure TOvcBaseComboBox.WMMeasureItem(var Message : TMessage);
-var
- PMStruct : PMeasureItemStruct;
- IHeight : Integer;
-begin
- PMStruct := PMeasureItemStruct(Message.lParam);
- with PMStruct^ do begin
- ItemWidth := ClientWidth;
- IHeight := ItemHeight;
- MeasureItem(LongInt(ItemID), IHeight); // LCL: UINT ItemID can be out of range on Win.
- ItemHeight := IHeight;
- end;
-end;
-
-procedure TOvcBaseComboBox.WMMouseWheel(var Msg : TMessage);
-// See TurboPower bug comments in TO32CustomControl.WMMouseWheel.
-begin
- inherited;
-
- with Msg do
- DoOnMouseWheel(KeysToShiftState(LOWORD(wParam)) {fwKeys},
- SmallInt(HIWORD(wParam)) {zDelta}, //bug fix
- LOWORD(lParam) {xPos}, HIWORD(lParam) {yPos});
-end;
-
-procedure TOvcBaseComboBox.WMSetFocus(var Msg : TWMSetFocus);
-begin
- inherited;
-
- PostMessage(Handle, OM_AFTERENTER, 0, 0);
-end;
-
-procedure TOvcBaseComboBox.SetHTBorder(Value : Boolean);
-begin
- if (Value <> FHTBorder) then begin
- FHTBorder := Value;
- if (FHTBorder) then begin
- FBorders.BottomBorder.Enabled := False;
- FBorders.LeftBorder.Enabled := False;
- FBorders.RightBorder.Enabled := False;
- FBorders.TopBorder.Enabled := False;
- end;
- end;
-end;
-
-procedure TOvcBaseComboBox.SetHTColors(Value : TOvcHTColors);
-begin
- FHTColors.FHighlight := Value.FHighlight;
- FHTColors.FShadow := Value.FShadow;
-end;
-
-{ - Hdc changed to TOvcHdc for BCB Compatibility }
-procedure TOvcBaseComboBox.PaintWindow(DC : TOvcHDC{Hdc});
-begin
- inherited PaintWindow(DC);
- Canvas.Handle := DC;
- try
- PaintBorders;
- finally
- Canvas.Handle := 0;
- end;
-end;
-
-
-procedure TOvcBaseComboBox.Paint;
-begin
- PaintBorders;
-end;
-
-
-procedure TOvcBaseComboBox.WMPaint(var Msg : TWMPaint);
-begin
- PaintHandler(Msg);
-end;
-
-procedure TOvcBaseComboBox.PaintBorders;
-var
- R : TRect;
- C : TCanvas;
- L : Integer;
- DC: HDC;
- DoRelease : Boolean;
-begin
- if (not Assigned(FBorders)) then Exit;
-
- R.Left := 0;
- R.Top := 0;
- R.Right := Width;
- R.Bottom := Height;
-
- DoRelease := True;
- DC := GetDC(self.handle);
- Canvas.Handle := DC;
-
- if (HotTrack) then
- L := 17
- else
- L := 19;
-
- try
- C := Canvas;
- if (FBorders.LeftBorder <> nil) then begin
- if (FBorders.LeftBorder.Enabled) then begin
- C.Pen.Color := FBorders.LeftBorder.PenColor;
- C.Pen.Width := FBorders.LeftBorder.PenWidth;
- C.Pen.Style := FBorders.LeftBorder.PenStyle;
-
- C.MoveTo(R.Left + (FBorders.LeftBorder.PenWidth div 2), R.Top);
- C.LineTo(R.Left + (FBorders.LeftBorder.PenWidth div 2), R.Bottom);
- end;
- end;
-
- if (FBorders.RightBorder <> nil) then begin
- if (FBorders.RightBorder.Enabled) then begin
- C.Pen.Color := FBorders.RightBorder.PenColor;
- C.Pen.Width := FBorders.RightBorder.PenWidth;
- C.Pen.Style := FBorders.RightBorder.PenStyle;
-
- C.MoveTo(R.Right - L - (FBorders.RightBorder.PenWidth div 2), R.Top);
- C.LineTo(R.Right - L - (FBorders.RightBorder.PenWidth div 2), R.Bottom);
- end;
- end;
-
- if (FBorders.TopBorder <> nil) then begin
- if (FBorders.TopBorder.Enabled) then begin
- C.Pen.Color := FBorders.TopBorder.PenColor;
- C.Pen.Width := FBorders.TopBorder.PenWidth;
- C.Pen.Style := FBorders.TopBorder.PenStyle;
-
- C.MoveTo(R.Left, R.Top + (FBorders.TopBorder.PenWidth div 2));
- C.LineTo(R.Right - L, R.Top + (FBorders.TopBorder.PenWidth div 2));
- end;
- end;
-
- if (FBorders.BottomBorder <> nil) then begin
- if (FBorders.BottomBorder.Enabled) then begin
- C.Pen.Color := FBorders.BottomBorder.PenColor;
- C.Pen.Width := FBorders.BottomBorder.PenWidth;
- C.Pen.Style := FBorders.BottomBorder.PenStyle;
-
- C.MoveTo(R.Left, R.Bottom - (FBorders.BottomBorder.PenWidth div 2));
- C.LineTo(R.Right - L-1, R.Bottom - (FBorders.BottomBorder.PenWidth div 2));
- end;
- end;
- finally
- if DoRelease then begin
- ReleaseDC(Self.Handle, DC);
- Canvas.Handle := 0;
- end;
- end;
-end;
-
-procedure TOvcBaseComboBox.BorderChanged(ABorder : TObject);
-begin
- if (FBorders.BottomBorder.Enabled) or
- (FBorders.LeftBorder.Enabled) or
- (FBorders.RightBorder.Enabled) or
- (FBorders.TopBorder.Enabled) then begin
- FHTBorder := False;
- FHotTrack := True;
- Ctl3D := False;
- end else begin
- Ctl3D := True;
- FHTBorder := False;
- FHotTrack := False;
- end;
-
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- if HandleAllocated then
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
-end;
-
-
-procedure TOvcBaseComboBox.CMMouseEnter(var Message: TMessage);
-begin
- if not FIsHot and HotTrack then begin
- FIsHot := True;
- Invalidate;
- end;
-end;
-
-procedure TOvcBaseComboBox.CMMouseLeave(var Message: TMessage);
-begin
- if FIsHot and HotTrack then begin
- FIsHot := False;
- Invalidate;
- end;
-end;
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovccmd.pas b/Source/3rdParty/Orpheus/ovccmd.pas
deleted file mode 100644
index 10ff5a6c..00000000
--- a/Source/3rdParty/Orpheus/ovccmd.pas
+++ /dev/null
@@ -1,1494 +0,0 @@
-{*********************************************************}
-{* OVCCMD.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 ovccmd;
- {-Translates messages into commands}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, LclType, {$ENDIF}
- Classes, Forms, Menus, Messages, SysUtils, OvcConst, OvcData,
- OvcExcpt, OvcMisc;
-
-const
- {default primary command/key table}
- DefCommandTable : array[0..63] of TOvcCmdRec = (
- {Key #1 Shift state #1
- Key #2 Shift state #2 Command}
- (Key1:VK_LEFT; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccLeft),
- (Key1:VK_RIGHT; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccRight),
- (Key1:VK_LEFT; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccWordLeft),
- (Key1:VK_RIGHT; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccWordRight),
- (Key1:VK_HOME; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccHome),
- (Key1:VK_END; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccEnd),
- (Key1:VK_DELETE; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccDel),
- (Key1:VK_BACK; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccBack),
- (Key1:VK_BACK; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccBack),
- (Key1:VK_PRIOR; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccTopOfPage),
- (Key1:VK_NEXT; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccBotOfPage),
- (Key1:VK_INSERT; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccIns),
- (Key1:VK_Z; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccUndo),
- (Key1:VK_BACK; SS1:ss_Alt;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccRestore),
- (Key1:VK_UP; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccUp),
- (Key1:VK_DOWN; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccDown),
- (Key1:VK_RETURN; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccNewLine),
- (Key1:VK_LEFT; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendLeft),
- (Key1:VK_RIGHT; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendRight),
- (Key1:VK_HOME; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendHome),
- (Key1:VK_END; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendEnd),
- (Key1:VK_LEFT; SS1:ss_Shift+ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtWordLeft),
- (Key1:VK_RIGHT; SS1:ss_Shift+ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtWordRight),
- (Key1:VK_PRIOR; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendPgUp),
- (Key1:VK_NEXT; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendPgDn),
- (Key1:VK_UP; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendUp),
- (Key1:VK_DOWN; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendDown),
- (Key1:VK_HOME; SS1:ss_Shift+ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtFirstPage),
- (Key1:VK_END; SS1:ss_Shift+ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtLastPage),
- (Key1:VK_PRIOR; SS1:ss_Shift+ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtTopOfPage),
- (Key1:VK_NEXT; SS1:ss_Shift+ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtBotOfPage),
- (Key1:VK_DELETE; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccCut),
- (Key1:VK_X; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccCut),
- (Key1:VK_INSERT; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccCopy),
- (Key1:VK_C; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccCopy),
- (Key1:VK_INSERT; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccPaste),
- (Key1:VK_V; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccPaste),
- (Key1:VK_PRIOR; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccPrevPage),
- (Key1:VK_NEXT; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccNextPage),
- (Key1:VK_HOME; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccFirstPage),
- (Key1:VK_END; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccLastPage),
- (Key1:VK_TAB; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccTab),
- (Key1:VK_TAB; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccTab),
- (Key1:VK_Z; SS1:ss_Ctrl+ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccRedo),
- (Key1:VK_0; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccGotoMarker0),
- (Key1:VK_1; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccGotoMarker1),
- (Key1:VK_2; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccGotoMarker2),
- (Key1:VK_3; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccGotoMarker3),
- (Key1:VK_4; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccGotoMarker4),
- (Key1:VK_5; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccGotoMarker5),
- (Key1:VK_6; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccGotoMarker6),
- (Key1:VK_7; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccGotoMarker7),
- (Key1:VK_8; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccGotoMarker8),
- (Key1:VK_9; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccGotoMarker9),
- (Key1:VK_0; SS1:ss_Ctrl+ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccSetMarker0),
- (Key1:VK_1; SS1:ss_Ctrl+ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccSetMarker1),
- (Key1:VK_2; SS1:ss_Ctrl+ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccSetMarker2),
- (Key1:VK_3; SS1:ss_Ctrl+ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccSetMarker3),
- (Key1:VK_4; SS1:ss_Ctrl+ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccSetMarker4),
- (Key1:VK_5; SS1:ss_Ctrl+ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccSetMarker5),
- (Key1:VK_6; SS1:ss_Ctrl+ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccSetMarker6),
- (Key1:VK_7; SS1:ss_Ctrl+ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccSetMarker7),
- (Key1:VK_8; SS1:ss_Ctrl+ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccSetMarker8),
- (Key1:VK_9; SS1:ss_Ctrl+ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccSetMarker9));
-
- {default WordStar command-key table}
- DefWsMaxCommands = 40;
- DefWsCommandTable : array[0..DefWsMaxCommands-1] of TOvcCmdRec = (
- {Key #1 Shift state #1
- Key #2 Shift state #2 Command}
- (Key1:VK_S; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccLeft),
- (Key1:VK_D; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccRight),
- (Key1:VK_E; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccUp),
- (Key1:VK_X; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccDown),
- (Key1:VK_R; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccPrevPage),
- (Key1:VK_C; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccNextPage),
- (Key1:VK_W; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccScrollUp),
- (Key1:VK_Z; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccScrollDown),
- (Key1:VK_A; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccWordLeft),
- (Key1:VK_F; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccWordRight),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_S; SS2:ss_Wordstar; Cmd:ccHome),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_D; SS2:ss_Wordstar; Cmd:ccEnd),
- (Key1:VK_G; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccDel),
- (Key1:VK_H; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccBack),
- (Key1:VK_Y; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccDelLine),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_Y; SS2:ss_Wordstar; Cmd:ccDelEol),
- (Key1:VK_V; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccIns),
- (Key1:VK_T; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccDelWord),
- (Key1:VK_P; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccCtrlChar),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_L; SS2:ss_Wordstar; Cmd:ccRestore),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_0; SS2:ss_Wordstar; Cmd:ccGotoMarker0),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_1; SS2:ss_Wordstar; Cmd:ccGotoMarker1),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_2; SS2:ss_Wordstar; Cmd:ccGotoMarker2),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_3; SS2:ss_Wordstar; Cmd:ccGotoMarker3),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_4; SS2:ss_Wordstar; Cmd:ccGotoMarker4),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_5; SS2:ss_Wordstar; Cmd:ccGotoMarker5),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_6; SS2:ss_Wordstar; Cmd:ccGotoMarker6),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_7; SS2:ss_Wordstar; Cmd:ccGotoMarker7),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_8; SS2:ss_Wordstar; Cmd:ccGotoMarker8),
- (Key1:VK_Q; SS1:ss_Ctrl;
- Key2:VK_9; SS2:ss_Wordstar; Cmd:ccGotoMarker9),
- (Key1:VK_K; SS1:ss_Ctrl;
- Key2:VK_0; SS2:ss_Wordstar; Cmd:ccSetMarker0),
- (Key1:VK_K; SS1:ss_Ctrl;
- Key2:VK_1; SS2:ss_Wordstar; Cmd:ccSetMarker1),
- (Key1:VK_K; SS1:ss_Ctrl;
- Key2:VK_2; SS2:ss_Wordstar; Cmd:ccSetMarker2),
- (Key1:VK_K; SS1:ss_Ctrl;
- Key2:VK_3; SS2:ss_Wordstar; Cmd:ccSetMarker3),
- (Key1:VK_K; SS1:ss_Ctrl;
- Key2:VK_4; SS2:ss_Wordstar; Cmd:ccSetMarker4),
- (Key1:VK_K; SS1:ss_Ctrl;
- Key2:VK_5; SS2:ss_Wordstar; Cmd:ccSetMarker5),
- (Key1:VK_K; SS1:ss_Ctrl;
- Key2:VK_6; SS2:ss_Wordstar; Cmd:ccSetMarker6),
- (Key1:VK_K; SS1:ss_Ctrl;
- Key2:VK_7; SS2:ss_Wordstar; Cmd:ccSetMarker7),
- (Key1:VK_K; SS1:ss_Ctrl;
- Key2:VK_8; SS2:ss_Wordstar; Cmd:ccSetMarker8),
- (Key1:VK_K; SS1:ss_Ctrl;
- Key2:VK_9; SS2:ss_Wordstar; Cmd:ccSetMarker9));
-
- {default Orpheus Table command/key table}
- DefGridMaxCommands = 38;
- DefGridCommandTable : array[0..DefGridMaxCommands-1] of TOvcCmdRec = (
- {Key #1 Shift state #1
- Key #2 Shift state #2 Command}
- (Key1:VK_LEFT; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccLeft),
- (Key1:VK_RIGHT; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccRight),
- (Key1:VK_LEFT; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccPageLeft),
- (Key1:VK_RIGHT; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccPageRight),
- (Key1:VK_HOME; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccHome),
- (Key1:VK_END; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccEnd),
- (Key1:VK_DELETE; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccDel),
- (Key1:VK_BACK; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccBack),
- (Key1:VK_NEXT; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccBotOfPage),
- (Key1:VK_PRIOR; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccTopOfPage),
- (Key1:VK_INSERT; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccIns),
- (Key1:VK_Z; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccRestore),
- (Key1:VK_UP; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccUp),
- (Key1:VK_DOWN; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccDown),
- (Key1:VK_LEFT; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendLeft),
- (Key1:VK_RIGHT; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendRight),
- (Key1:VK_HOME; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendHome),
- (Key1:VK_END; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendEnd),
- (Key1:VK_LEFT; SS1:ss_Shift+ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtWordLeft),
- (Key1:VK_RIGHT; SS1:ss_Shift+ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtWordRight),
- (Key1:VK_PRIOR; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendPgUp),
- (Key1:VK_NEXT; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendPgDn),
- (Key1:VK_UP; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendUp),
- (Key1:VK_DOWN; SS1:ss_Shift;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtendDown),
- (Key1:VK_HOME; SS1:ss_Shift+ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtFirstPage),
- (Key1:VK_END; SS1:ss_Shift+ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtLastPage),
- (Key1:VK_PRIOR; SS1:ss_Shift+ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtTopOfPage),
- (Key1:VK_NEXT; SS1:ss_Shift+ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccExtBotOfPage),
- (Key1:VK_X; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccCut),
- (Key1:VK_C; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccCopy),
- (Key1:VK_V; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccPaste),
- (Key1:VK_PRIOR; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccPrevPage),
- (Key1:VK_HOME; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccFirstPage),
- (Key1:VK_NEXT; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccNextPage),
- (Key1:VK_END; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccLastPage),
- (Key1:VK_UP; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccTopLeftCell),
- (Key1:VK_DOWN; SS1:ss_Ctrl;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccBotRightCell),
- (Key1:VK_F2; SS1:ss_None;
- Key2:VK_NONE; SS2:ss_None; Cmd:ccTableEdit));
-
-type
- {command processor states}
- TOvcProcessorState = (stNone, stPartial, stLiteral);
-
- {user command notify event}
- TUserCommandEvent =
- procedure(Sender : TObject; Command : Word)
- of object;
-
- {forward class declarations}
- TOvcCommandProcessor = class;
-
- TOvcCommandTable = class(TPersistent)
- {.Z+}
- protected {private}
- FActive : Boolean; {true to use this command table}
- FCommandList : TList; {list of command/key mappings}
- FTableName : string; {the name of this command table}
-
- {property methods}
- function GetCmdRec(Index : Integer) : TOvcCmdRec;
- {-return the list item corresponding to "Index"}
- function GetCount : Integer;
- {-return the number of records in the list}
- procedure PutCmdRec(Index : Integer; const CmdRec : TOvcCmdRec);
- {-store a new command entry to the list at "Index" position}
-
- {internal methods}
- procedure ctDisposeCommandEntry(P : POvcCmdRec);
- {-dispose of a command entry record}
- function ctNewCommandEntry(const CmdRec : TOvcCmdRec): POvcCmdRec;
- {-allocate a new command entry record}
- procedure ctReadData(Reader : TReader);
- {-called to read the table from the stream}
- procedure ctWriteData(Writer : TWriter);
- {-called to store the table on the stream}
-
- protected
- procedure DefineProperties(Filer : TFiler);
- override;
-
- public
- constructor Create;
- destructor Destroy;
- override;
- {.Z-}
-
- function AddRec(const CmdRec : TOvcCmdRec) : Integer;
- {-add a record to the list}
- procedure Clear;
- {-delete all records from the list}
- procedure Delete(Index : Integer);
- {-delete a record from the list}
- procedure Exchange(Index1, Index2 : Integer);
- {-exchange list locations of the two specified records}
- function IndexOf(const CmdRec : TOvcCmdRec) : Integer;
- {-return the index of the specified record}
- procedure InsertRec(Index : Integer; const CmdRec : TOvcCmdRec);
- {-insert a record at the specified index}
- procedure LoadFromFile(const FileName : string);
- {-read command entries from a text file}
- procedure Move(CurIndex, NewIndex : Integer);
- {-move one record to anothers index location}
- procedure SaveToFile(const FileName: string);
- {-write command entries to a text file}
-
- property Commands[Index : Integer] : TOvcCmdRec
- read GetCmdRec write PutCmdRec; default;
- property Count : Integer
- read GetCount stored False;
- property IsActive : Boolean
- read FActive write FActive;
- property TableName : string
- read FTableName write FTableName;
- end;
-
- TOvcCommandProcessor = class(TPersistent)
- {.Z+}
- protected {private}
- {property variables}
- FTableList : TList; {list of command tables}
-
- {internal variables}
- cpState : TOvcProcessorState; {current state}
- cpSaveKey : Byte; {saved last key processed}
- cpSaveSS : Byte; {saved shift key state}
-
- {property methods}
- function GetCount: Integer;
- {-return the number of tables in the list}
- function GetTable(Index : Integer) : TOvcCommandTable;
- {-return the table referenced by "Index"}
- procedure SetTable(Index : Integer; CT : TOvcCommandTable);
- {-store a command table at position "Index"}
-
- {internal methods}
- function cpFillCommandRec(Key1, ShiftState1,
- Key2, ShiftState2 : Byte;
- Command : Word) : TOvcCmdRec;
- {-fill a command record}
- procedure cpReadData(Reader: TReader);
- {-called to read the command processor from the stream}
- function cpScanTable(CT : TOvcCommandTable; Key, SFlags : Byte) : Word;
- {-Scan the command table for a match}
- procedure cpWriteData(Writer: TWriter);
- {-called to store the command processor to the stream}
-
- protected
- procedure DefineProperties(Filer: TFiler);
- override;
-
- public
- constructor Create;
- destructor Destroy;
- override;
- {.Z-}
-
- procedure Add(CT : TOvcCommandTable);
- {-add a command table to the list of tables}
- procedure AddCommand(const TableName: string;
- Key1, ShiftState1,
- Key2, ShiftState2 : Byte;
- Command : Word);
- {-add a command and key sequence to the command table}
- procedure AddCommandRec(const TableName: string; const CmdRec : TOvcCmdRec);
- {-add a command record to the command table}
- procedure ChangeTableName(const OldName, NewName: string);
- {-change the name of a table}
- procedure Clear;
- {-delete all tables from the list}
- function CreateCommandTable(const TableName : string; Active : Boolean) : Integer;
- {-create a command table and add it to the table list}
- procedure Delete(Index : Integer);
- {-delete the "Index" table from the list of tables}
- procedure DeleteCommand(const TableName: string;
- Key1, ShiftState1,
- Key2, ShiftState2 : Byte);
- {-delete a command and key sequence from a command table}
- procedure DeleteCommandTable(const TableName : string);
- {-delete a command table and remove it from the table list}
- procedure Exchange(Index1, Index2 : Integer);
- {-exchange list locations of the two specified command tables}
- function GetCommandCount(const TableName : string) : Integer;
- {-return the number of commands in the command table}
- function GetCommandTable(const TableName : string) : TOvcCommandTable;
- {-return a pointer to the specified command table or nil}
- {.Z+}
- procedure GetState(var State : TOvcProcessorState; var Key, Shift : Byte);
- {-return the current status of the command processor}
- {.Z-}
- function GetCommandTableIndex(const TableName : string) : Integer;
- {-return index to the specified command table or -1 for failure}
- function LoadCommandTable(const FileName : string) : Integer; virtual;
- {-creates and then fills a command table from a text file}
- procedure ResetCommandProcessor;
- {-reset the command processor}
- procedure SaveCommandTable(const TableName, FileName : string); virtual;
- {-save a command table to a text file}
- procedure SetScanPriority(const Names : array of string);
- {-reorder the list of tables based on this array}
- {.Z+}
- procedure SetState(State : TOvcProcessorState; Key, Shift : Byte);
- {-set the state to the command processor}
- {.Z-}
- function Translate(var Msg : TMessage) : Word;
- {-translate a message into a command}
- function TranslateUsing(const Tables : array of string; var Msg : TMessage) : Word;
- {-translate a message into a command using the given tables}
- function TranslateKey(Key : Word; ShiftState : TShiftState) : Word;
- {-translate a key and shift-state into a command}
- function TranslateKeyUsing(const Tables : array of string; Key : Word; ShiftState : TShiftState) : Word;
- {-translate a key and shift-state into a command using the given tables}
-
- property Count: Integer
- read GetCount
- stored False;
-
- property Table[Index : Integer]: TOvcCommandTable
- read GetTable
- write SetTable;
- default;
- end;
-
-
-implementation
-
-
-{*** TOvcCommandTable ***}
-
-function TOvcCommandTable.AddRec(const CmdRec : TOvcCmdRec) : Integer;
-begin
- Result := GetCount;
- InsertRec(Result, CmdRec);
-end;
-
-procedure TOvcCommandTable.Clear;
-var
- I: Integer;
-begin
- {dispose of all command records in the list}
- for I := 0 to FCommandList.Count - 1 do
- ctDisposeCommandEntry(FCommandList[I]);
- {clear the list entries}
- FCommandList.Clear;
-end;
-
-constructor TOvcCommandTable.Create;
-begin
- inherited Create;
- FTableName := GetOrphStr(SCUnknownTable);
- FActive := True;
- FCommandList := TList.Create;
-end;
-
-procedure TOvcCommandTable.ctDisposeCommandEntry(P : POvcCmdRec);
-begin
- if Assigned(P) then
- FreeMem(P, SizeOf(TOvcCmdRec));
-end;
-
-function TOvcCommandTable.ctNewCommandEntry(const CmdRec : TOvcCmdRec): POvcCmdRec;
-begin
- GetMem(Result, SizeOf(TOvcCmdRec));
- Result^ := CmdRec;
-end;
-
-procedure TOvcCommandTable.ctReadData(Reader : TReader);
-var
- CmdRec : TOvcCmdRec;
-
- procedure ReadAndCompareTable(const CT : array of TOvcCmdRec);
- var
- I : Integer;
- Idx : Integer;
- begin
- {add all records initially}
- for I := 0 to High(CT) do
- AddRec(CT[I]);
-
- while not Reader.EndOfList do begin
- with CmdRec, Reader do begin
- Keys := ReadInteger;
- Cmd := ReadInteger;
- end;
- {if keys on stream are dups replace default with redefinition}
- Idx := IndexOf(CmdRec);
- if Idx > -1 then begin
- {if assigned to ccNone, remove instead of replace}
- if CmdRec.Cmd = ccNone then
- Delete(Idx)
- else
- Commands[Idx] := CmdRec
- end else
- AddRec(CmdRec);
- end;
- end;
-
-begin
- FTableName := Reader.ReadString;
- FActive := Reader.ReadBoolean;
- Reader.ReadListBegin;
- Clear;
-
- if CompareText(GetOrphStr(SCDefaultTableName), FTableName) = 0 then
- {if this is the "default" table, fill it with default commands}
- ReadAndCompareTable(DefCommandTable)
- else if CompareText(GetOrphStr(SCWordStarTableName), FTableName) = 0 then
- {if this is the "wordstar" table, fill it with default commands}
- ReadAndCompareTable(DefWsCommandTable)
- else if CompareText(GetOrphStr(SCGridTableName), FTableName) = 0 then
- {if this is the "grid" table, fill it with default commands}
- ReadAndCompareTable(DefGridCommandTable)
- else begin
- {otherwise, load complete command table from stream}
- while not Reader.EndOfList do begin
- with CmdRec, Reader do begin
- Keys := ReadInteger;
- Cmd := ReadInteger;
- end;
- AddRec(CmdRec);
- end;
- end;
-
- Reader.ReadListEnd;
-end;
-
-procedure TOvcCommandTable.ctWriteData(Writer : TWriter);
-var
- I : Integer;
- Cmdrec : TOvcCmdRec;
-
- procedure CompareAndWriteTable(const CT : array of TOvcCmdRec);
- var
- I, J : Integer;
- Idx : Integer;
- begin
- {find commands in the CT table but missing from this table}
- for I := 0 to High(CT) do begin
- Idx := IndexOf(CT[I]);
- if Idx = -1 then begin
- {not found, store and assign to ccNone}
- with CT[I], Writer do begin
- WriteInteger(Keys);
- WriteInteger(ccNone);
- end;
- end;
- end;
-
- {store all commands in new table if they are additions to the CT table}
- for I := 0 to Count - 1 do begin
- CmdRec := GetCmdRec(I);
- {search CT for a match}
- Idx := -1;
- for J := 0 to High(CT) do begin
- if (CmdRec.Keys = CT[J].Keys) and (CmdRec.Cmd = CT[J].Cmd) then begin
- Idx := J;
- Break;
- end;
- end;
- if Idx = -1 then begin
- {not found, store it}
- with CmdRec, Writer do begin
- WriteInteger(Keys);
- WriteInteger(Cmd);
- end;
- end;
- end;
- end;
-
-begin
- Writer.WriteString(FTableName);
- Writer.WriteBoolean(FActive);
- Writer.WriteListBegin;
-
- {if this is the default command table, don't store command if not changed}
- if CompareText(GetOrphStr(SCDefaultTableName), FTableName) = 0 then
- {if this is the "default" command table, don't store commands if not changed}
- CompareAndWriteTable(DefCommandTable)
- else if CompareText(GetOrphStr(SCWordStarTableName), FTableName) = 0 then
- {if this is the "wordstar" command table, don't store commands if not changed}
- CompareAndWriteTable(DefWsCommandTable)
- else if CompareText(GetOrphStr(SCGridTableName), FTableName) = 0 then
- {if this is the "grid" command table, don't store commands if not changed}
- CompareAndWriteTable(DefGridCommandTable)
- else begin
- {otherwise, save the complete table}
- for I := 0 to Count - 1 do begin
- CmdRec := GetCmdRec(I);
- with CmdRec, Writer do begin
- WriteInteger(Keys);
- WriteInteger(Cmd);
- end;
- end;
- end;
-
- Writer.WriteListEnd;
-end;
-
-procedure TOvcCommandTable.DefineProperties(Filer : TFiler);
-begin
- inherited DefineProperties(Filer);
- Filer.DefineProperty('CommandList', ctReadData, ctWriteData, Count > 0);
-end;
-
-procedure TOvcCommandTable.Delete(Index : Integer);
-begin
- ctDisposeCommandEntry(FCommandList[Index]);
- FCommandList.Delete(Index);
-end;
-
-destructor TOvcCommandTable.Destroy;
-begin
- Clear;
- FCommandList.Free;
- FCommandList := nil;
-
- inherited Destroy;
-end;
-
-procedure TOvcCommandTable.Exchange(Index1, Index2 : Integer);
-begin
- FCommandList.Exchange(Index1, Index2);
-end;
-
-function TOvcCommandTable.GetCmdRec(Index : Integer) : TOvcCmdRec;
-begin
- Result := POvcCmdRec(FCommandList[Index])^;
-end;
-
-function TOvcCommandTable.GetCount : Integer;
-begin
- Result := FCommandList.Count;
-end;
-
-function TOvcCommandTable.IndexOf(const CmdRec : TOvcCmdRec) : Integer;
-begin
- for Result := 0 to GetCount - 1 do
- if CmdRec.Keys = GetCmdRec(Result).Keys then
- Exit;
- Result := -1;
-end;
-
-procedure TOvcCommandTable.InsertRec(Index : Integer; const Cmdrec : TOvcCmdRec);
-begin
- FCommandList.Expand.Insert(Index, ctNewCommandEntry(CmdRec));
-end;
-
-procedure TOvcCommandTable.LoadFromFile(const FileName: string);
-var
- T : System.Text;
- CmdRec : TOvcCmdRec;
-begin
- Clear; {erase current contents of list}
- System.Assign(T, FileName);
- System.Reset(T);
- try {finally}
- ReadLn(T, FTableName); {get table name}
- while not Eof(T) do begin
- with CmdRec do ReadLn(T, Key1, SS1, Key2, SS2, Cmd);
- AddRec(CmdRec);
- end;
- finally
- System.Close(T);
- end;
-end;
-
-procedure TOvcCommandTable.Move(CurIndex, NewIndex : Integer);
-var
- CmdRec : TOvcCmdRec;
-begin
- if CurIndex <> NewIndex then begin
- CmdRec := GetCmdRec(CurIndex);
- Delete(CurIndex);
- InsertRec(NewIndex, CmdRec);
- end;
-end;
-
-procedure TOvcCommandTable.PutCmdRec(Index : Integer; const CmdRec : TOvcCmdRec);
-var
- P : POvcCmdRec;
-begin
- P := FCommandList[Index];
- try
- FCommandList[Index] := ctNewCommandEntry(CmdRec);
- finally
- ctDisposeCommandEntry(P);
- end;
-end;
-
-procedure TOvcCommandTable.SaveToFile(const FileName: string);
-var
- T : System.Text;
- I : Integer;
- CmdRec : TOvcCmdRec;
-begin
- System.Assign(T, FileName);
- System.Rewrite(T);
- try {finally}
- System.WriteLn(T, FTableName); {save the table name}
- for I := 0 to Count-1 do begin
- CmdRec := GetCmdRec(I);
- with CmdRec do
- System.WriteLn(T, Key1:4, SS1:4, Key2:4, SS2:4, Cmd:6);
- end;
- finally
- System.Close(T);
- end;
-end;
-
-
-{*** TCommandProcessor ***}
-
-procedure TOvcCommandProcessor.Add(CT : TOvcCommandTable);
- {-add a command table to the list of tables}
-var
- I : Integer;
- Base : string;
- Name : string;
-begin
- {make sure the table name is unique}
- I := 0;
-
- Base := CT.TableName;
-
- {remove trailing numbers from the name, forming the base name}
- while (Length(Base) > 1) and (Base[Length(Base)] in ['0'..'9']) do
- {$IFOPT H+}
- SetLength(Base, Length(Base)-1);
- {$ELSE}
- Dec(Byte(Base[0]));
- {$ENDIF}
-
- Name := Base;
-
- {keep appending numbers until we find a unique name}
- while GetCommandTable(Name) <> nil do begin
- Inc(I);
- Name := Base + Format('%d', [I]);
- end;
- if I > 0 then
- CT.TableName := Name;
-
- {add table to the list}
- FTableList.Add(CT);
-end;
-
-procedure TOvcCommandProcessor.AddCommand(const TableName: string;
- Key1, ShiftState1,
- Key2, ShiftState2 : Byte;
- Command : Word);
- {-add a command and key sequence to the command table}
-var
- CmdRec : TOvcCmdRec;
-begin
- {fill temp command record}
- CmdRec := cpFillCommandRec(Key1, ShiftState1, Key2, ShiftState2, Command);
- {add the command}
- AddCommandRec(TableName, CmdRec);
-end;
-
-procedure TOvcCommandProcessor.AddCommandRec(const TableName: string; const CmdRec : TOvcCmdRec);
- {-add a command record to the command table}
-var
- TmpTbl : TOvcCommandTable;
-begin
- {get the command table pointer}
- TmpTbl := GetCommandTable(TableName);
- if Assigned(TmpTbl) then begin
- {does this key sequence conflict with any others}
- if TmpTbl.IndexOf(CmdRec) = -1 then
- {add the new command-key sequence}
- TmpTbl.AddRec(CmdRec)
- else
- raise EDuplicateCommand.Create;
- end else
- raise ETableNotFound.Create;
-end;
-
-procedure TOvcCommandProcessor.ChangeTableName(const OldName, NewName: string);
- {-change the name of a table}
-var
- TmpTbl : TOvcCommandTable;
-begin
- TmpTbl := GetCommandTable(OldName);
- if Assigned(TmpTbl) then
- TmpTbl.TableName := NewName
- else
- raise ETableNotFound.Create;
-end;
-
-procedure TOvcCommandProcessor.Clear;
- {-delete all tables from the list}
-var
- I : Integer;
-begin
- {dispose of all command tables in the list}
- for I := 0 to Count - 1 do
- TOvcCommandTable(FTableList[I]).Free;
- {clear the list entries}
- FTableList.Clear;
-end;
-
-function TOvcCommandProcessor.cpFillCommandRec(Key1, ShiftState1,
- Key2, ShiftState2 : Byte;
- Command : Word) : TOvcCmdRec;
- {-fill a command record}
-begin
- Result.Key1 := Key1;
- Result.SS1 := ShiftState1;
- Result.Key2 := Key2;
- Result.SS2 := ShiftState2;
- Result.Cmd := Command;
-end;
-
-procedure TOvcCommandProcessor.cpReadData(Reader : TReader);
-var
- TmpTbl : TOvcCommandTable;
-begin
- {empty current table list}
- Clear;
- {read the start of list marker}
- Reader.ReadListBegin;
- while not Reader.EndOfList do begin
- {create a command table}
- TmpTbl := TOvcCommandTable.Create;
- {load commands into the table}
- TmpTbl.ctReadData(Reader);
- {add the new table to the table list}
- Add(TmpTbl);
- end;
- {read the end of list marker}
- Reader.ReadListEnd;
-end;
-
-function TOvcCommandProcessor.cpScanTable(CT : TOvcCommandTable; Key, SFlags : Byte) : Word;
- {-Scan the command table for a match}
-var
- J : Integer;
-begin
- {assume failed match}
- Result := ccNone;
-
- {scan the list of commands looking for a match}
- for J := 0 to CT.Count-1 do with CT[J] do begin
-
- {do we already have a partial command}
- if cpState = stPartial then begin
- {does first key/shift state match the saved key/shift state?}
- if (Key1 = cpSaveKey) and (SS1 = cpSaveSS) then
- {does the key match?}
- if (Key2 = Key) then
- {does the shift state match?}
- {or, is this the second key of a wordstar command}
- if (SS2 = SFlags) or ((SS2 = ss_Wordstar) and
- ((SFlags = ss_None) or (SFlags = ss_Ctrl))) then begin
- Result := Cmd; {return the command}
- {if the command is ccCtrlChar, next key is literal}
- if Cmd = ccCtrlChar then
- cpState := stLiteral
- else
- cpState := stNone;
- Exit;
- end;
- end else if (Key1 = Key) and (SS1 = SFlags) then begin
- {we have an initial key match}
- if Key2 = 0 then begin
- {no second key}
- Result := Cmd; {return the command}
- {if the command is ccCtrlChar, next key is literal}
- if Cmd = ccCtrlChar then
- cpState := stLiteral;
- Exit;
- end else begin
- {it's a partial command}
- Result := ccPartial;
- cpState := stPartial;
-
- {save the key and shift state}
- cpSaveKey := Key;
- cpSaveSS := SFlags;
- Exit;
- end;
- end;
-
- end;
-end;
-
-procedure TOvcCommandProcessor.cpWriteData(Writer: TWriter);
-var
- I : Integer;
-begin
- {write the start of list marker}
- Writer.WriteListBegin;
- {have each table write itself}
- for I := 0 to Count - 1 do
- TOvcCommandTable(FTableList[I]).ctWriteData(Writer);
- {write the end of list marker}
- Writer.WriteListEnd;
-end;
-
-constructor TOvcCommandProcessor.Create;
-var
- I : Integer;
- S : string;
-begin
- inherited Create;
-
- {create an empty command table list}
- FTableList := TList.Create;
-
- {create and fill the default command table}
- S := GetOrphStr(SCDefaultTableName);
- CreateCommandTable(S, True {active});
- for I := 0 to High(DefCommandTable) do
- AddCommandRec(S, DefCommandTable[I]);
-
- {create and fill the WordStar command table}
- S := GetOrphStr(SCWordStarTableName);
- CreateCommandTable(S, False {not active});
- for I := 0 to DefWsMaxCommands-1 do
- AddCommandRec(S, DefWsCommandTable[I]);
-
- {create and fill the table(grid) command table}
- S := GetOrphStr(SCGridTableName);
- CreateCommandTable(S, False {not active});
- for I := 0 to DefGridMaxCommands-1 do
- AddCommandRec(S, DefGridCommandTable[I]);
-
- ResetCommandProcessor;
-end;
-
-function TOvcCommandProcessor.CreateCommandTable(const TableName : string; Active : Boolean) : Integer;
- {-create a command table and add it to the table list}
-var
- TmpTbl : TOvcCommandTable;
-begin
- TmpTbl := TOvcCommandTable.Create;
- TmpTbl.TableName := TableName;
- TmpTbl.IsActive := Active;
- Add(TmpTbl);
- Result := FTableList.IndexOf(TmpTbl);
-end;
-
-procedure TOvcCommandProcessor.DefineProperties(Filer: TFiler);
-begin
- inherited DefineProperties(Filer);
- Filer.DefineProperty('TableList', cpReadData, cpWriteData, Count > 0);
-end;
-
-procedure TOvcCommandProcessor.Delete(Index : Integer);
- {-delete the "Index" table from the list of tables}
-begin
- if (Index >= 0) and (Index < Count) then begin
- {delete the command table}
- TOvcCommandTable(FTableList[Index]).Free;
- {remove it from the list}
- FTableList.Delete(Index);
- end else
- raise ETableNotFound.Create;
-end;
-
-procedure TOvcCommandProcessor.DeleteCommand(const TableName: string;
- Key1, ShiftState1,
- Key2, ShiftState2 : Byte);
-var
- I : Integer;
- CmdRec : TOvcCmdRec;
- TmpTbl : TOvcCommandTable;
-begin
- {get the command table pointer}
- TmpTbl := GetCommandTable(TableName);
- if Assigned(TmpTbl) then begin
- {fill temp command record}
- CmdRec := cpFillCommandRec(Key1, ShiftState1, Key2, ShiftState2, 0);
- {find index of entry}
- I := TmpTbl.IndexOf(CmdRec);
- {if found, delete it -- no error if not found}
- if I > -1 then
- TmpTbl.Delete(I);
- end else
- raise ETableNotFound.Create;
-end;
-
-procedure TOvcCommandProcessor.DeleteCommandTable(const TableName : string);
- {-delete a command table and remove from the table list}
-var
- I : Integer;
- TmpTbl : TOvcCommandTable;
-begin
- TmpTbl := GetCommandTable(TableName);;
- if Assigned(TmpTbl) then begin
- I := FTableList.IndexOf(TmpTbl);
- Delete(I);
- end else
- raise ETableNotFound.Create;
-end;
-
-destructor TOvcCommandProcessor.Destroy;
-begin
- if Assigned(FTableList) then begin
- Clear;
- FTableList.Free;
- end;
- inherited Destroy;
-end;
-
-procedure TOvcCommandProcessor.Exchange(Index1, Index2 : Integer);
- {-exchange list locations of the two specified command tables}
-begin
- FTableList.Exchange(Index1, Index2);
-end;
-
-function TOvcCommandProcessor.GetTable(Index : Integer) : TOvcCommandTable;
- {-return the table referenced by "Index"}
-begin
- Result := TOvcCommandTable(FTableList[Index]);
-end;
-
-function TOvcCommandProcessor.GetCommandCount(const TableName : string) : Integer;
- {-return the number of commands in the command table}
-var
- TmpTbl : TOvcCommandTable;
-begin
- {get the command table pointer}
- TmpTbl := GetCommandTable(TableName);
- if Assigned(TmpTbl) then
- Result := TmpTbl.Count
- else
- raise ETableNotFound.Create;
-end;
-
-function TOvcCommandProcessor.GetCommandTable(const TableName : string) : TOvcCommandTable;
- {-return a pointer to the specified command table or nil}
-var
- I : Integer;
-begin
- Result := nil;
- for I := 0 To Count-1 do
- if AnsiUpperCase(TOvcCommandTable(FTableList[I]).TableName)
- = AnsiUpperCase(TableName) then
- begin
- Result := FTableList[I];
- Break;
- end;
-end;
-
-function TOvcCommandProcessor.GetCommandTableIndex(const TableName : string) : Integer;
- {-return index to the specified command table or -1 for failure}
-var
- I : Integer;
-begin
- Result := -1;
- for I := 0 To Count-1 do
- if AnsiUpperCase(TOvcCommandTable(FTableList[I]).TableName)
- = AnsiUpperCase(TableName) then
- begin
- Result := I;
- Break;
- end;
-end;
-
-function TOvcCommandProcessor.GetCount : Integer;
- {-return the number of tables in the list}
-begin
- Result := FTableList.Count;
-end;
-
-procedure TOvcCommandProcessor.GetState(var State : TOvcProcessorState; var Key, Shift : Byte);
-begin
- State := cpState;
- Key := cpSaveKey;
- Shift := cpSaveSS;
-end;
-
-function TOvcCommandProcessor.LoadCommandTable(const FileName : string) : Integer;
- {-creates and then fills a command table from a text file}
-var
- TmpTbl : TOvcCommandTable;
-begin
- TmpTbl := TOvcCommandTable.Create;
- try
- TmpTbl.LoadFromFile(FileName);
- Add(TmpTbl);
- Result := FTableList.IndexOf(TmpTbl);
- except
- TmpTbl.Free;
- raise;
- end;
-end;
-
-procedure TOvcCommandProcessor.ResetCommandProcessor;
- {-reset the command processor}
-begin
- cpState := stNone;
- cpSaveKey := VK_NONE;
- cpSaveSS := 0;
-end;
-
-procedure TOvcCommandProcessor.SaveCommandTable(const TableName, FileName : string);
- {-save a command table to a text file}
-var
- TmpTbl : TOvcCommandTable;
-begin
- TmpTbl := GetCommandTable(TableName);
- if Assigned(TmpTbl) then
- TmpTbl.SaveToFile(FileName);
-end;
-
-procedure TOvcCommandProcessor.SetScanPriority(const Names : array of string);
- {-reorder the list of tables based on this array}
-var
- I : Integer;
- Idx : Integer;
- TmpTbl : TOvcCommandTable;
-begin
- for I := 0 to Pred(High(Names)) do begin
- TmpTbl := GetCommandTable(Names[I]);
- if Assigned(TmpTbl) then begin
- Idx := FTableList.IndexOf(TmpTbl);
- if (Idx > -1) and (Idx <> I) then
- Exchange(I, Idx);
- end;
- end;
-end;
-
-procedure TOvcCommandProcessor.SetTable(Index : Integer; CT : TOvcCommandTable);
- {-store a command table at position "Index"}
-var
- P : TOvcCommandTable;
-begin
- if (Index >= 0) and (Index < Count) then begin
- P := FTableList[Index];
- FTableList[Index] := CT;
- P.Free;
- end else
- raise ETableNotFound.Create;
-end;
-
-procedure TOvcCommandProcessor.SetState(State : TOvcProcessorState; Key, Shift : Byte);
-begin
- cpState := State;
- cpSaveKey := Key;
- cpSaveSS := Shift;
-end;
-
-function TOvcCommandProcessor.Translate(var Msg : TMessage) : Word;
- {-translate a message into a command}
-var
- Command : Word;
- I : Integer;
- K : Byte; {message key code}
- SS : Byte; {shift flags}
-begin
- {accept the key if no match found}
- Result := ccAccept;
-
- {check for shift state keys, note partial status and exit}
- K := Lo(Msg.wParam);
- case K of
- VK_SHIFT, {shift}
- VK_CONTROL, {ctrl}
- VK_ALT, {alt}
- VK_CAPITAL, {caps lock}
- VK_NUMLOCK, {num lock}
- VK_SCROLL : {scroll lock}
- begin
- {if we had a partial command before, we still do}
- if cpState = stPartial then
- Result := ccPartial;
- Exit;
- end;
- end;
-
- {exit if this key is to be interpreted literally}
- if cpState = stLiteral then begin
- cpState := stNone;
- Exit;
- end;
-
- {get the current shift flags}
- SS := GetShiftFlags;
-
- Command := ccNone;
- for I := 0 to Count-1 do
- if TOvcCommandTable(FTableList[I]).IsActive then begin
- Command := cpScanTable(FTableList[I], K, SS);
- if Command <> ccNone then
- Break;
- end;
-
- {if we found a match, return command and exit}
- if Command <> ccNone then begin
- Result := Command;
- Exit;
- end;
-
- {if we had a partial command, suppress this key}
- if cpState = stPartial then
- Result:= ccSuppress;
-
- cpState := stNone;
-end;
-
-function TOvcCommandProcessor.TranslateKey(Key : Word; ShiftState : TShiftState) : Word;
- {-translate a key and shift-state into a command}
-var
- Command : Word;
- I : Integer;
- SS : Byte; {shift flags}
-begin
- {accept the key if no match found}
- Result := ccAccept;
-
- {check for shift state keys, note partial status and exit}
- case Key of
- VK_SHIFT, {shift}
- VK_CONTROL, {ctrl}
- VK_ALT, {alt}
- VK_CAPITAL, {caps lock}
- VK_NUMLOCK, {num lock}
- VK_SCROLL : {scroll lock}
- begin
- {if we had a partial command before, we still do}
- if cpState = stPartial then
- Result := ccPartial;
- Exit;
- end;
- end;
-
- {exit if this key is to be interpreted literally}
- if cpState = stLiteral then begin
- cpState := stNone;
- Exit;
- end;
-
- {get the current shift flags}
- SS := (Ord(ssCtrl in ShiftState) * ss_Ctrl) +
- (Ord(ssShift in ShiftState) * ss_Shift) +
- (Ord(ssAlt in ShiftState) * ss_Alt);
-
- Command := ccNone;
- for I := 0 to Count-1 do
- if TOvcCommandTable(FTableList[I]).IsActive then begin
- Command := cpScanTable(FTableList[I], Key, SS);
- if Command <> ccNone then
- Break;
- end;
-
- {if we found a match, return command and exit}
- if Command <> ccNone then begin
- Result := Command;
- Exit;
- end;
-
- {if we had a partial command, suppress this key}
- if cpState = stPartial then
- Result:= ccSuppress;
-
- cpState := stNone;
-end;
-
-function TOvcCommandProcessor.TranslateUsing(const Tables : array of string; var Msg : TMessage) : Word;
- {-translate a message into a command using the given tables}
-var
- TmpTbl : TOvcCommandTable;
- Command : Word;
- I : Integer;
- K : Byte; {message key code}
- SS : Byte; {shift flags}
-begin
- {accept the key if no match found}
- Result := ccAccept;
-
- {check for shift state keys, note partial status and exit}
- K := Lo(Msg.wParam);
- case K of
- VK_SHIFT, {shift}
- VK_CONTROL, {ctrl}
- VK_ALT, {alt}
- VK_CAPITAL, {caps lock}
- VK_NUMLOCK, {num lock}
- VK_SCROLL : {scroll lock}
- begin
- {if we had a partial command before, we still do}
- if cpState = stPartial then
- Result := ccPartial;
- Exit;
- end;
- end;
-
- {get out if this key is to be interpreted literally}
- if cpState = stLiteral then begin
- cpState := stNone;
- Exit;
- end;
-
- {get the current shift flags}
- SS := GetShiftFlags;
-
- Command := ccNone;
- for I := 0 to High(Tables) do begin
- TmpTbl := GetCommandTable(Tables[I]);
- if Assigned(TmpTbl) then begin
- Command := cpScanTable(TmpTbl, K, SS);
- if Command <> ccNone then
- Break;
- end;
- end;
-
- {if we found a match, return command and exit}
- if Command <> ccNone then begin
- Result := Command;
- Exit;
- end;
-
- {if we had a partial command, suppress this key}
- if cpState = stPartial then
- Result:= ccSuppress;
-
- cpState := stNone;
-end;
-
-function TOvcCommandProcessor.TranslateKeyUsing(const Tables : array of string; Key : Word; ShiftState : TShiftState) : Word;
- {-translate a Key and shift-state into a command using the given tables}
-var
- TmpTbl : TOvcCommandTable;
- Command : Word;
- I : Integer;
- SS : Byte; {shift flags}
-begin
- {accept the key if no match found}
- Result := ccAccept;
-
- {check for shift state keys, note partial status and exit}
- case Key of
- VK_SHIFT, {shift}
- VK_CONTROL, {ctrl}
- VK_ALT, {alt}
- VK_CAPITAL, {caps lock}
- VK_NUMLOCK, {num lock}
- VK_SCROLL : {scroll lock}
- begin
- {if we had a partial command before, we still do}
- if cpState = stPartial then
- Result := ccPartial;
- Exit;
- end;
- end;
-
- {get out if this key is to be interpreted literally}
- if cpState = stLiteral then begin
- cpState := stNone;
- Exit;
- end;
-
- {get the shift flags}
- SS := (Ord(ssCtrl in ShiftState) * ss_Ctrl) +
- (Ord(ssShift in ShiftState) * ss_Shift) +
- (Ord(ssAlt in ShiftState) * ss_Alt);
-
- Command := ccNone;
- for I := 0 to High(Tables) do begin
- TmpTbl := GetCommandTable(Tables[I]);
- if Assigned(TmpTbl) then begin
- Command := cpScanTable(TmpTbl, Key, SS);
- if Command <> ccNone then
- Break;
- end;
- end;
-
- {if we found a match, return command and exit}
- if Command <> ccNone then begin
- Result := Command;
- Exit;
- end;
-
- {if we had a partial command, suppress this key}
- if cpState = stPartial then
- Result:= ccSuppress;
-
- cpState := stNone;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovccolor.pas b/Source/3rdParty/Orpheus/ovccolor.pas
deleted file mode 100644
index 5ef1ff77..00000000
--- a/Source/3rdParty/Orpheus/ovccolor.pas
+++ /dev/null
@@ -1,200 +0,0 @@
-{*********************************************************}
-{* OVCCOLOR.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 ovccolor;
- {-Color selection class}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, {$ENDIF} Classes, Graphics;
-
-type
- TOvcColors = class(TPersistent)
- {.Z+}
- protected {private}
- {property variables}
- FBackColor : TColor; {background color}
- FTextColor : TColor; {text or font color}
- FUseDefault : Boolean; {true to use defaults}
-
- {event variables}
- FOnColorChange : TNotifyEvent;
-
- {internal variables}
- cDefBackColor : TColor; {default background}
- cDefTextColor : TColor; {default text color}
-
- {property methods}
- procedure SetBackColor(Value: TColor);
- {-set the color used for the background}
- procedure SetTextColor(Value: TColor);
- {-set the color used for the foreground}
- procedure SetUseDefault(Value: Boolean);
- {-set the flag to reset colors to parent default values}
-
- procedure ReadUseDefault(Reader : TReader);
- {-read the UseDefault property. for backward compatibility only}
-
- protected
- procedure DefineProperties(Filer : TFiler);
- override;
-
- procedure DoOnColorChange;
- {-notify onwing object that a color has changed}
- dynamic;
-
- procedure ResetToDefaultColors;
- {-assign default color values}
- dynamic;
-
- public
- procedure Assign(Source : TPersistent);
- override;
- constructor Create(FG, BG : TColor);
- virtual;
- {.Z-}
-
- property OnColorChange : TNotifyEvent
- read FOnColorChange
- write FOnColorChange;
-
- published
- property BackColor : TColor
- read FBackColor
- write SetBackColor;
-
- property TextColor : TColor
- read FTextColor
- write SetTextColor;
-
- property UseDefault : Boolean
- read FUseDefault
- write SetUseDefault
- stored False;
- end;
-
-
-implementation
-
-
-{*** TOvcColors ***}
-
-procedure TOvcColors.Assign(Source : TPersistent);
-var
- C : TOvcColors absolute Source;
-begin
- if (Source <> nil) and (Source is TOvcColors) then begin
- BackColor := C.BackColor;
- TextColor := C.TextColor;
- end else
- inherited Assign(Source);
-end;
-
-constructor TOvcColors.Create(FG, BG : TColor);
-begin
- inherited Create;
-
- cDefBackColor := BG;
- cDefTextColor := FG;
- FUseDefault := True;
-
- {initialize to these colors}
- ResetToDefaultColors;
-end;
-
-procedure TOvcColors.DefineProperties(Filer : TFiler);
-begin
- inherited DefineProperties(Filer);
- {define a UseDefault property for compatibility with eariler versions}
- Filer.DefineProperty('UseDefault', ReadUseDefault, nil, False);
-end;
-
-procedure TOvcColors.DoOnColorChange;
- {-notify onwing object that a color has changed}
-begin
- if Assigned(FOnColorChange) then
- FOnColorChange(Self);
-end;
-
-procedure TOvcColors.ReadUseDefault(Reader : TReader);
-begin
- {read property and discard it}
- Reader.ReadBoolean;
-end;
-
-procedure TOvcColors.ResetToDefaultColors;
- {-obtain default color values}
-begin
- FBackColor := cDefBackColor;
- FTextColor := cDefTextColor;
-end;
-
-procedure TOvcColors.SetBackColor(Value: TColor);
- {-set the color used for the background}
-begin
- if Value <> FBackColor then begin
- if Value <> cDefBackColor then
- FUseDefault := False;
- FBackColor := Value;
- DoOnColorChange;
- end;
-end;
-
-procedure TOvcColors.SetTextColor(Value: TColor);
- {-set the color used for the foreground}
-begin
- if Value <> FTextColor then begin
- if Value <> cDefTextColor then
- FUseDefault := False;
- FTextColor := Value;
- DoOnColorChange;
- end;
-end;
-
-procedure TOvcColors.SetUseDefault(Value: Boolean);
- {-set the flag to reset colors to parent default values}
-begin
- FUseDefault := Value;
- if FUseDefault then begin
- ResetToDefaultColors; {assign default values}
- DoOnColorChange;
- end;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovcconst.pas b/Source/3rdParty/Orpheus/ovcconst.pas
deleted file mode 100644
index bd33a701..00000000
--- a/Source/3rdParty/Orpheus/ovcconst.pas
+++ /dev/null
@@ -1,604 +0,0 @@
-{*********************************************************}
-{* OVCCONST.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 ovcconst;
- {-Command and resource constants}
-
-interface
-
-const
- {value used to offset string resource id's}
- BaseOffset = 32768; {***}
-
-const
- {constants for exception messages}
- SCUnknownError = 30168;
- SCDuplicateCommand = 30169;
- SCTableNotFound = 30170;
- SCNotDoneYet = 30171;
- SCNoControllerAssigned = 30172;
- SCCantCreateCommandTable = 30173;
- SCCantDelete = 30174;
- SCInvalidKeySequence = 30175;
- SCNotWordStarCommands = 30176;
- SCNoCommandSelected = 30177;
- SCDuplicateKeySequence = 30178;
- SCRangeError = 30179;
- SCInvalidNumber = 30180;
- SCRequiredField = 30181;
- SCInvalidDate = 30182;
- SCInvalidTime = 30183;
- SCBlanksInField = 30184;
- SCPartialEntry = 30185;
- SCRegionTooLarge = 30186;
- SCOutOfMemoryForCopy = 30187;
- SCInvalidParamValue = 30188;
- SCNoTimersAvail = 30189;
- SCTooManyEvents = 30190;
- SCBadTriggerHandle = 30191;
- SCOnSelectNotAssigned = 30192;
- SCInvalidPageIndex = 30193;
- SCInvalidDataType = 30194;
- SCInvalidTabFont = 30195;
- SCInvalidLabelFont = 30196;
- SCOutOfMemory = 30197;
- SCTooManyParas = 30198;
- SCCannotJoin = 30199;
- SCTooManyBytes = 30200;
- SCParaTooLong = 30201;
- SCInvalidPictureMask = 30202;
- SCInvalidRange = 30203;
- SCInvalidRealRange = 30204;
- SCInvalidExtendedRange = 30205;
- SCInvalidDoubleRange = 30206;
- SCInvalidSingleRange = 30207;
- SCInvalidCompRange = 30208;
- SCInvalidDateRange = 30209;
- SCInvalidTimeRange = 30210;
- SCInvalidRangeValue = 30211;
- SCRangeNotSupported = 30212;
- SCInvalidLineOrParaIndex = 30213;
- SCNonFixedFont = 30214;
- SCInvalidFontParam = 30215;
- SCInvalidLineOrColumn = 30216;
- SCSAEGeneral = 30217;
- SCSAEAtMaxSize = 30218;
- SCSAEOutOfBounds = 30219;
- SCInvalidXMLFile = 30220;
- SCUnterminatedElement = 30221;
- SCBadColorConst = 30222;
- SCBadColorValue = 30223;
- SCInvalidFieldType = 30224;
- SCBadAlarmHandle = 30225;
- SCOnIsSelectedNotAssigned= 30226;
- SCInvalidDateForMask = 30227;
- SCNoTableAttached = 30228;
- SCViewerIOError = 30232;
- SCViewerFileNotFound = 30233;
- SCViewerPathNotFound = 30234;
- SCViewerTooManyOpenFiles = 30235;
- SCViewerFileAccessDenied = 30236;
- SCControlAttached = 30237;
- SCCantEdit = 30238;
- SCChildTableError = 30239;
- SCNoCollection = 30241;
- SCNotOvcDescendant = 30242;
- SCItemIncompatible = 30243;
- SCLabelNotAttached = 30244;
- SCClassNotSet = 30245;
- SCCollectionNotFound = 30246;
- SCDayConvertError = 30247;
- SCMonthConvertError = 30248;
- SCMonthNameConvertError = 30249;
- SCYearConvertError = 30250;
- SCDayRequired = 30251;
- SCMonthRequired = 30252;
- SCYearRequired = 30253;
- SCInvalidDay = 30254;
- SCInvalidMonth = 30255;
- SCInvalidMonthName = 30256;
- SCInvalidYear = 30257;
- SCTableRowOutOfBounds = 30258;
- SCTableMaxRows = 30259;
- SCTableMaxColumns = 30260;
- SCTableGeneral = 30261;
- SCTableToManyColumns = 30262;
- SCTableInvalidFieldIndex = 30263;
- SCTableHeaderNotAssigned = 30264;
- SCTableInvalidHeaderCell = 30265;
- SCGridTableName = 30266;
- {general constants for string table resource entries}
- SCNoneStr = 30268;
- SCccUser = 30269;
- SCccUserNum = 30270;
- SCDeleteTable = 30271;
- SCRenameTable = 30272;
- SCEnterTableName = 30273;
- SCNewTable = 30274;
- SCDefaultTableName = 30275;
- SCWordStarTableName = 30276;
- SCUnknownTable = 30277;
- SCDefaultEntryErrorText = 30278;
- SCGotItemWarning = 30279;
- SCSampleListItem = 30280;
- SCAlphaString = 30281;
- SCTallLowChars = 30282;
- SCDefault = 30283;
- SCDescending = 30285;
- SCDefaultIndex = 30286;
- SCRestoreMI = 30287;
- SCCutMI = 30288;
- SCCopyMI = 30289;
- SCPasteMI = 30290;
- SCDeleteMI = 30291;
- SCSelectAllMI = 30292;
- SCCalcBack = 30293;
- SCCalcMC = 30294;
- SCCalcMR = 30295;
- SCCalcMS = 30296;
- SCCalcMPlus = 30297;
- SCCalcMMinus = 30298;
- SCCalcCT = 30299;
- SCCalcCE = 30300;
- SCCalcC = 30301;
- SCCalcSqrt = 30302;
- SCCalNext = 30303;
- SCCalLast = 30304;
- SCCalFirst = 30305;
- SCCal1st = 30306;
- SCCalSecond = 30307;
- SCCal2nd = 30308;
- SCCalThird = 30309;
- SCCal3rd = 30310;
- SCCalFourth = 30311;
- SCCal4th = 30312;
- SCCalFinal = 30313;
- SCCalBOM = 30314;
- SCCalEnd = 30315;
- SCCalEOM = 30316;
- SCCalYesterday = 30317;
- SCCalToday = 30318;
- SCCalTomorrow = 30319;
- SCEditingSections = 30320;
- SCEditingItems = 30321;
- SCEditingFolders = 30322;
- SCEditingPages = 30323;
- SCEditingImages = 30324;
- SCSectionBaseName = 30325;
- SCItemBaseName = 30326;
- SCFolderBaseName = 30327;
- SCPageBaseName = 30328;
- SCImageBaseName = 30329;
- SCOwnerMustBeForm = 30330;
- SCTimeConvertError = 30331;
- SCCancelQuery = 30332;
- SCNoPagesAssigned = 30333;
- SCCalPrev = 30334;
- SCCalBegin = 30335;
- SCInvalidMinMaxValue = 30336;
- SCFormUseOnly = 30337;
-
- {misc constant values}
- SCYes = 30368;
- SCNo = 30369;
- SCTrue = 30370;
- SCFalse = 30371;
- SCHoursName = 30372;
- SCMinutesName = 30373;
- SCSecondsName = 30374;
- SCCloseCaption = 30375;
-
- {report view exceptions}
- SCViewFieldNotFound = 30376;
- SCCantResolveField = 30377;
- SCItemAlreadyExists = 30378;
- SCAlreadyInTempMode = 30379;
- SCItemNotFound = 30380;
- SCUpdatePending = 30381;
- SCOnCompareNotAssigned = 30382;
- SCOnFilterNotAssigned = 30383;
- SCGetAsFloatNotAssigned = 30384;
- SCNotInTempMode = 30385;
- SCItemNotInIndex = 30387;
- SCNoActiveView = 30388;
- SCItemIsNotGroup = 30389;
- SCNotMultiSelect = 30390;
- SCLineNoOutOfRange = 30391;
- SCUnknownView = 30392;
- SCOnKeySearchNotAssigned = 30393;
- SCOnEnumNotAssigned = 30394;
- SCOnEnumSelectedNA = 30395;
-
- {MRU list exceptions }
- SCNoMenuAssigned = 30400;
- SCNoAnchorAssigned = 30401;
- SCInvalidParameter = 30402;
- SCInvalidOperation = 30403;
-
- SCColorBlack = 30500;
- SCColorMaroon = 30501;
- SCColorGreen = 30502;
- SCColorOlive = 30503;
- SCColorNavy = 30504;
- SCColorPurple = 30505;
- SCColorTeal = 30506;
- SCColorGray = 30507;
- SCColorSilver = 30508;
- SCColorRed = 30509;
- SCColorLime = 30510;
- SCColorYellow = 30511;
- SCColorBlue = 30512;
- SCColorFuchsia = 30513;
- SCColorAqua = 30514;
- SCColorWhite = 30515;
- SCColorLightGray = 30516;
- SCColorMediumGray = 30517;
- SCColorDarkGray = 30518;
- SCColorMoneyGreen = 30519;
- SCColorSkyBlue = 30520;
- SCColorCream = 30521;
-
-const
- cHotKeyChar = '&'; {hotkey prefix character}
-
-const
- {offset for resource id's}
- CommandResOfs = BaseOffset + 1000; {***}
-
- {command codes - corresponding text offset by CommandOfs, stored in rc file}
- {*** must be contiguous ***}
- ccFirstCmd = 0; {first defined command}
- ccNone = 0; {no command or not a known command}
- ccBack = 1; {backspace one character}
- ccBotOfPage = 2; {move caret to end of last page}
- ccBotRightCell = 3; {move to the bottom right hand cell in a table}
- ccCompleteDate = 4; {use default date for current date sub field}
- ccCompleteTime = 5; {use default time for current time sub field}
- ccCopy = 6; {copy highlighted text to clipboard}
- ccCtrlChar = 7; {accept control character}
- ccCut = 8; {copy highlighted text to clipboard and delete it}
- ccDec = 9; {decrement the current entry field value}
- ccDel = 10; {delete current character}
- ccDelBol = 11; {delete from caret to beginning of line}
- ccDelEol = 12; {delete from caret to end of line}
- ccDelLine = 13; {delete entire line}
- ccDelWord = 14; {delete word to right of caret}
- ccDown = 15; {cursor down}
- ccEnd = 16; {caret to end of line}
- ccExtendDown = 17; {extend selection down one line}
- ccExtendEnd = 18; {extend highlight to end of field}
- ccExtendHome = 19; {extend highlight to start of field}
- ccExtendLeft = 20; {extend highlight left one character}
- ccExtendPgDn = 21; {extend selection down one page}
- ccExtendPgUp = 22; {extend selection up one page}
- ccExtendRight = 23; {extend highlight right one character}
- ccExtendUp = 24; {extend selection up one line}
- ccExtBotOfPage = 25; {extend selection to bottom of page}
- ccExtFirstPage = 26; {extend selection to first page}
- ccExtLastPage = 27; {extend selection to last page}
- ccExtTopOfPage = 28; {extend selection to top of page}
- ccExtWordLeft = 29; {extend highlight left one word}
- ccExtWordRight = 30; {extend highlight right one word}
- ccFirstPage = 31; {first page in table}
- ccGotoMarker0 = 32; {editor & viewer, go to a position marker}
- ccGotoMarker1 = 33; {editor & viewer, go to a position marker}
- ccGotoMarker2 = 34; {editor & viewer, go to a position marker}
- ccGotoMarker3 = 35; {editor & viewer, go to a position marker}
- ccGotoMarker4 = 36; {editor & viewer, go to a position marker}
- ccGotoMarker5 = 37; {editor & viewer, go to a position marker}
- ccGotoMarker6 = 38; {editor & viewer, go to a position marker}
- ccGotoMarker7 = 39; {editor & viewer, go to a position marker}
- ccGotoMarker8 = 40; {editor & viewer, go to a position marker}
- ccGotoMarker9 = 41; {editor & viewer, go to a position marker}
- ccHome = 42; {caret to beginning of line}
- ccInc = 43; {increment the current entry field value}
- ccIns = 44; {toggle insert mode}
- ccLastPage = 45; {last page in table}
- ccLeft = 46; {caret left by one character}
- ccNewLine = 47; {editor, create a new line}
- ccNextPage = 48; {next page in table}
- ccPageLeft = 49; {move left a page in the table}
- ccPageRight = 50; {move right a page in the table}
- ccPaste = 51; {paste text from clipboard}
- ccPrevPage = 52; {previous page in table}
- ccRedo = 53; {re-do the last undone operation}
- ccRestore = 54; {restore default and continue}
- ccRight = 55; {caret right by one character}
- ccScrollDown = 56; {editor, scroll page up one line}
- ccScrollUp = 57; {editor, scroll page down one line}
- ccSetMarker0 = 58; {editor & viewer, set a position marker}
- ccSetMarker1 = 59; {editor & viewer, set a position marker}
- ccSetMarker2 = 60; {editor & viewer, set a position marker}
- ccSetMarker3 = 61; {editor & viewer, set a position marker}
- ccSetMarker4 = 62; {editor & viewer, set a position marker}
- ccSetMarker5 = 63; {editor & viewer, set a position marker}
- ccSetMarker6 = 64; {editor & viewer, set a position marker}
- ccSetMarker7 = 65; {editor & viewer, set a position marker}
- ccSetMarker8 = 66; {editor & viewer, set a position marker}
- ccSetMarker9 = 67; {editor & viewer, set a position marker}
- ccTab = 68; {editor, for tab entry}
- ccTableEdit = 69; {enter/exit table edit mode}
- ccTopLeftCell = 70; {move to the top left cell in a table}
- ccTopOfPage = 71; {move caret to beginning of first page}
- ccUndo = 72; {undo last operation}
- ccUp = 73; {cursor up}
- ccWordLeft = 74; {caret left one word}
- ccWordRight = 75; {caret right one word}
-
- ccLastCmd = 75; {***} {last interfaced command}
-
- {internal}
- ccChar = 249; {regular character; generated internally}
- ccMouse = 250; {mouse selection; generated internally}
- ccMouseMove = 251; {mouse move; generated internally}
- ccAccept = 252; {accept next key; internal}
- ccDblClk = 253; {mouse double click; generated internally}
- ccSuppress = 254; {suppress next key; internal}
- ccPartial = 255; {partial command; internal}
-
- {user defined commands start here}
- ccUserFirst = 256;
- ccUser0 = ccUserFirst + 0;
- ccUser1 = ccUserFirst + 1;
- ccUser2 = ccUserFirst + 2;
- ccUser3 = ccUserFirst + 3;
- ccUser4 = ccUserFirst + 4;
- ccUser5 = ccUserFirst + 5;
- ccUser6 = ccUserFirst + 6;
- ccUser7 = ccUserFirst + 7;
- ccUser8 = ccUserFirst + 8;
- ccUser9 = ccUserFirst + 9;
- {... = ccUserFirst + 65535 - ccUserFirst}
-
-
-{data type base offset}
-const
- DataTypeOfs = BaseOffset + 1300; {***}
-
-{entry field data type sub codes}
-const
- fsubString = 0; {field subclass codes}
- fsubChar = 1;
- fsubBoolean = 2;
- fsubYesNo = 3;
- fsubLongInt = 4;
- fsubWord = 5;
- fsubInteger = 6;
- fsubByte = 7;
- fsubShortInt = 8;
- fsubReal = 9;
- fsubExtended = 10;
- fsubDouble = 11;
- fsubSingle = 12;
- fsubComp = 13;
- fsubDate = 14;
- fsubTime = 15;
-
-
-{constants for simple, picture, and numeric picture}
-{mask samples used in the property editors}
-const
- PictureMaskOfs = BaseOffset + 1700; {***}
-
- {simple field mask characters}
- stsmFirst = 34468;
- stsmLast = 34468 + 23;
-
- {numeric field picture masks}
- stnmFirst = 34493;
- stnmLast = 34493 + 17;
-
- {picture field picture masks}
- stpmFirst = 34518;
- stpmLast = 34518 + 23;
-
-const
-{String Resource Constants...}
-
-{Note: These should stay in numerical order. It's not as important here as it
- is in the O32SR.pas file's Lookup Array, but you should still keep it in
- mind when editing these values...}
-
- {String Resource Index Constants}
- IccNone = 33768;
- IccBack = 33769;
- IccBotOfPage = 33770;
- IccBotRightCell = 33771;
- IccCompleteDate = 33772;
- IccCompleteTime = 33773;
- IccCopy = 33774;
- IccCtrlChar = 33775;
- IccCut = 33776;
- IccDec = 33777;
- IccDel = 33778;
- IccDelBol = 33779;
- IccDelEol = 33780;
- IccDelLine = 33781;
- IccDelWord = 33782;
- IccDown = 33783;
- IccEnd = 33784;
- IccExtendDown = 33785;
- IccExtendEnd = 33786;
- IccExtendHome = 33787;
- IccExtendLeft = 33788;
- IccExtendPgDn = 33789;
- IccExtendPgUp = 33790;
- IccExtendRight = 33791;
- IccExtendUp = 33792;
- IccExtBotOfPage = 33793;
- IccExtFirstPage = 33794;
- IccExtLastPage = 33795;
- IccExtTopOfPage = 33796;
- IccExtWordLeft = 33797;
- IccExtWordRight = 33798;
- IccFirstPage = 33799;
- IccGotoMarker0 = 33800;
- IccGotoMarker1 = 33801;
- IccGotoMarker2 = 33802;
- IccGotoMarker3 = 33803;
- IccGotoMarker4 = 33804;
- IccGotoMarker5 = 33805;
- IccGotoMarker6 = 33806;
- IccGotoMarker7 = 33807;
- IccGotoMarker8 = 33808;
- IccGotoMarker9 = 33809;
- IccHome = 33810;
- IccInc = 33811;
- IccIns = 33812;
- IccLastPage = 33813;
- IccLeft = 33814;
- IccNewLine = 33815;
- IccNextPage = 33816;
- IccPageLeft = 33817;
- IccPageRight = 33818;
- IccPaste = 33819;
- IccPrevPage = 33820;
- IccRedo = 33821;
- IccRestore = 33822;
- IccRight = 33823;
- IccScrollDown = 33824;
- IccScrollUp = 33825;
- IccSetMarker0 = 33826;
- IccSetMarker1 = 33827;
- IccSetMarker2 = 33828;
- IccSetMarker3 = 33829;
- IccSetMarker4 = 33830;
- IccSetMarker5 = 33831;
- IccSetMarker6 = 33832;
- IccSetMarker7 = 33833;
- IccSetMarker8 = 33834;
- IccSetMarker9 = 33835;
- IccTab = 33836;
- IccTableEdit = 33837;
- IccTopLeftCell = 33838;
- IccTopOfPage = 33839;
- IccUndo = 33840;
- IccUp = 33841;
- IccWordLeft = 33842;
- IccWordRight = 33843;
-
- IString = 34068;
- IChar = 34069;
- IBoolean = 34070;
- IYesNo = 34071;
- ILongInt = 34072;
- IWord = 34073;
- ISmallInt = 34074;
- IByte = 34075;
- IShortInt = 34076;
- IReal = 34077;
- IExtended = 34078;
- IDouble = 34079;
- ISingle = 34080;
- IComp = 34081;
- IDate = 34082;
- ITime = 34083;
-
- {Character Masks}
- ICharMask1 = 34468;
- ICharMask2 = 34469;
- ICharMask3 = 34470;
- ICharMask4 = 34471;
- ICharMask5 = 34472;
- ICharMask6 = 34473;
- ICharMask7 = 34474;
- ICharMask8 = 34475;
- ICharMask9 = 34476;
- ICharMask10 = 34477;
- ICharMask11 = 34478;
- ICharMask12 = 34479;
- ICharMask13 = 34480;
- ICharMask14 = 34481;
- ICharMask15 = 34482;
- ICharMask16 = 34483;
- ICharMask17 = 34484;
- ICharMask18 = 34485;
- ICharMask19 = 34486;
- ICharMask20 = 34487;
- ICharMask21 = 34488;
- ICharMask22 = 34489;
- ICharMask23 = 34490;
- ICharMask24 = 34491;
-
- {Sample Field Masks }
- IFieldMask1 = 34493;
- IFieldMask2 = 34494;
- IFieldMask3 = 34495;
- IFieldMask4 = 34496;
- IFieldMask5 = 34497;
- IFieldMask6 = 34498;
- IFieldMask7 = 34499;
- IFieldMask8 = 34500;
- IFieldMask9 = 34501;
- IFieldMask10 = 34502;
- IFieldMask11 = 34503;
- IFieldMask12 = 34504;
- IFieldMask13 = 34505;
- IFieldMask14 = 34506;
- IFieldMask15 = 34507;
- IFieldMask16 = 34508;
- IFieldMask17 = 34509;
- IFieldMask18 = 34510;
-
- IFieldMask19 = 34518;
- IFieldMask20 = 34519;
- IFieldMask21 = 34520;
- IFieldMask22 = 34521;
- IFieldMask23 = 34522;
- IFieldMask24 = 34523;
- IFieldMask25 = 34524;
- IFieldMask26 = 34525;
- IFieldMask27 = 34526;
- IFieldMask28 = 34527;
- IFieldMask29 = 34528;
- IFieldMask30 = 34529;
- IFieldMask31 = 34530;
- IFieldMask32 = 34531;
- IFieldMask33 = 34532;
- IFieldMask34 = 34533;
- IFieldMask35 = 34534;
- IFieldMask36 = 34535;
- IFieldMask37 = 34536;
- IFieldMask38 = 34537;
- IFieldMask39 = 34538;
- IFieldMask40 = 34539;
- IFieldMask41 = 34540;
- IFieldMask42 = 34541;
-
-implementation
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovcdata.pas b/Source/3rdParty/Orpheus/ovcdata.pas
deleted file mode 100644
index 6c365f16..00000000
--- a/Source/3rdParty/Orpheus/ovcdata.pas
+++ /dev/null
@@ -1,624 +0,0 @@
-{*********************************************************}
-{* OVCDATA.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 ovcdata;
- {-Miscellaneous type and constant declarations}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Controls, Forms, Graphics, StdCtrls, SysUtils, OvcConst, OvcDate, O32SR;
-
-const
- BorderStyles : array[TBorderStyle] of LongInt =
- (0, WS_BORDER);
- ScrollBarStyles : array [TScrollStyle] of LongInt =
- (0, WS_HSCROLL, WS_VSCROLL, WS_HSCROLL or WS_VSCROLL
-{$IFDEF LCL}
- ,WS_HSCROLL, WS_VSCROLL, WS_HSCROLL or WS_VSCROLL
-{$ENDIF}
- );
-
-{$IFNDEF VERSION4}
-type
- PDateTime = ^TDateTime;
-{$ENDIF}
-
-{some colors that are not defined by Delphi}
-const
- clCream = TColor($A6CAF0);
- clMoneyGreen = TColor($C0DCC0);
- clSkyBlue = TColor($FFFBF0);
-
-type
- TCharSet = set of AnsiChar; {a Pascal set of characters}
-
-type
- PPointer = ^Pointer;
-
-type
- {secondary field options--internal}
- TsefOption = (
- sefValPending, {field needs validation}
- sefInvalid, {field is invalid}
- sefNoHighlight, {Don't highlight field initially}
- sefIgnoreFocus, {We're ignoring the focus}
- sefValidating, {We're validating a field}
- sefModified, {Field recently modified}
- sefEverModified, {Field has been modified after last data transfer}
- sefFixSemiLits, {Semi-literals were stripped}
- sefHexadecimal, {Field's value is shown in hex}
- sefOctal, {Field's value is shown in octal}
- sefBinary, {Field's value is shown in binary}
- sefNumeric, {Edit from right to left--for numbers only}
- sefRealVar, {Field is of a real/8087 type}
- sefNoLiterals, {Picture mask has no literals}
- sefHaveFocus, {Control has the focus}
- sefRetainPos, {Retain caret position}
- sefErrorPending, {Error pending?}
- sefInsert, {Insert mode on}
- sefLiteral, {Next char is literal}
- sefAcceptChar, {Accept next character}
- sefCharOK, {OK to add a character}
- sefUpdating, {field is being updated}
- sefGettingValue, {field contents are being retrieved}
- sefUserValidating, {user validation in progress}
- sefNoUserValidate); {don't perform user validation}
-
- {Set of current secondary options for entry fields}
- TsefOptionSet = set of TsefOption;
-
-const
- {default secondary field options}
- sefDefOptions : TsefOptionSet = [sefCharOK, sefInsert];
-
-const
- DefPadChar = ' '; {Default character used to pad the end of a display string}
- MaxEditLen = 255; {Maximum length of edit string}
- MaxPicture = 255; {Maximum length of a picture mask}
-
-{*** Picture masks ***}
-const
- {the following characters are meaningful in Picture masks}
- pmAnyChar = 'X'; {allows any character}
- pmForceUpper = '!'; {allows any character, forces upper case}
- pmForceLower = 'L'; {allows any character, forces lower case}
- pmForceMixed = 'x'; {allows any character, forces mixed case}
- pmAlpha = 'a'; {allows alphas only}
- pmUpperAlpha = 'A'; {allows alphas only, forces upper case}
- pmLowerAlpha = 'l'; {allows alphas only, forces lower case}
- pmPositive = '9'; {allows numbers and spaces only}
- pmWhole = 'i'; {allows numbers, spaces, minus}
- pmDecimal = '#'; {allows numbers, spaces, minus, period}
- pmScientific = 'E'; {allows numbers, spaces, minus, period, 'e'}
- pmHexadecimal = 'K'; {allows 0-9, A-F, and space forces upper case}
- pmOctal = 'O'; {allows 0-7, space}
- pmBinary = 'b'; {allows 0-1, space}
- pmTrueFalse = 'B'; {allows T, t, F, f}
- pmYesNo = 'Y'; {allows Y, y, N, n}
-
- pmUser1 = '1'; {User-defined picture mask characters}
- pmUser2 = '2';
- pmUser3 = '3';
- pmUser4 = '4';
- pmUser5 = '5';
- pmUser6 = '6';
- pmUser7 = '7';
- pmUser8 = '8';
-
- Subst1 = #241; {User-defined substitution characters}
- Subst2 = #242;
- Subst3 = #243;
- Subst4 = #244;
- Subst5 = #245;
- Subst6 = #246;
- Subst7 = #247;
- Subst8 = #248;
-
-const
- {Other special characters allowed in Picture strings}
- pmDecimalPt = '.'; {insert decimal point}
- pmComma = ','; {character used to separate numbers}
- pmFloatDollar = '$'; {floating dollar sign}
- pmCurrencyLt = 'c'; {currency to left of the amount}
- pmCurrencyRt = 'C'; {currency to right of the amount}
- pmNegParens = 'p'; {indicates () should be used for negative #'s}
- pmNegHere = 'g'; {placeholder for minus sign}
- {NOTE: Comma and FloatDollar are allowed only in fields containing fixed
- decimal points and/or numeric fields. NegParens and NegHere should be used
- only in numeric fields.}
-
-const
- {the following characters are meaningful in date Picture masks}
- pmMonth = 'm'; {formatting character for a date string picture mask}
- pmMonthU = 'M'; {formatting character for a date string picture mask.
- Uppercase means pad with ' ' rather than '0'}
- pmDay = 'd'; {formatting character for a date string picture mask}
- pmDayU = 'D'; {formatting character for a date string picture mask.
- Uppercase means pad with ' ' rather then '0'}
- pmYear = 'y'; {formatting character for a date string picture mask}
- pmDateSlash = '/'; {formatting character for a date string picture mask}
-
- {'n'/'N' may be used in place of 'm'/'M' when the name of the month is
- desired instead of its number. E.g., 'dd/nnn/yyyy' -\> '01-Jan-1980'.
- 'dd/NNN/yyyy' -\> '01-JAN-1980' (if SlashChar = '-'). The abbreviation used
- is based on the width of the subfield (3 in the example) and the current
- contents of the MonthString array.}
- pmMonthName = 'n'; {formatting character for a date string picture mask}
- pmMonthNameU = 'N'; {formatting character for a date string picture mask.
- Uppercase causes the output to be in uppercase}
-
- {'w'/'W' may be used to include the day of the week in a date string. E.g.,
- 'www dd nnn yyyy' -\> 'Mon 01 Jan 1989'. The abbreviation used is based on
- the width of the subfield (3 in the example) and the current contents of the
- DayString array. Note that entry field will not allow the user to enter
- text into a subfield containing 'w' or 'W'. The day of the week will be
- supplied automatically when a valid date is entered.}
- pmWeekDay = 'w'; {formatting character for a date string picture mask}
- pmWeekDayU = 'W'; {formatting character for a date string picture mask.
- Uppercase causes the output to be in uppercase}
-
- pmLongDateSub1 = 'f'; {mask character used with Window's long date format}
- pmLongDateSub2 = 'g'; {mask character used with Window's long date format}
- pmLongDateSub3 = 'h'; {mask character used with Window's long date format}
-
-const
- {if uppercase letters are used, numbers are padded with ' ' rather than '0'}
- pmHour = 'h'; {formatting character for a time string picture mask}
- pmHourU = 'H'; {formatting character for a time string picture mask}
- pmMinute = 'm'; {formatting character for a time string picture mask}
- pmMinuteU = 'M'; {formatting character for a time string picture mask}
- pmSecond = 's'; {formatting character for a time string picture mask}
- pmSecondU = 'S'; {formatting character for a time string picture mask}
- {'hh:mm:ss tt' -\> '12:00:00 pm', 'hh:mmt' -\> '12:00p'}
- pmAmPm = 't'; {formatting character for a time string picture mask.
- This generates 'AM' or 'PM'}
- pmTimeColon = ':'; {formatting character for a time string picture mask}
-
-const
- PictureChars : TCharSet = [
- pmAnyChar, pmForceUpper, pmForceLower, pmForceMixed,
- pmAlpha, pmUpperAlpha, pmLowerAlpha,
- pmPositive, pmWhole, pmDecimal, pmScientific,
- pmHexadecimal, pmOctal, pmBinary,
- pmTrueFalse, pmYesNo,
- pmMonthName, pmMonthNameU, pmMonth,
- pmMonthU, pmDay, pmDayU, pmYear, pmHour, pmHourU, {$IFNDEF FPC} pmMinute,
- pmMinuteU, {$ENDIF} pmSecond, pmSecondU, pmAmPm, pmUser1..pmUser8];
-
-const
- {set of allowable picture characters for simple fields}
- SimplePictureChars : TCharSet = [
- pmAnyChar, pmForceUpper, pmForceLower, pmForceMixed,
- pmAlpha, pmUpperAlpha, pmLowerAlpha,
- pmPositive, pmWhole, pmDecimal, pmScientific,
- pmHexadecimal, pmOctal, pmBinary,
- pmTrueFalse, pmYesNo,
- pmUser1..pmUser8];
-
-type
- {types of case change operations associated with a picture mask character}
- TCaseChange = (mcNoChange, mcUpperCase, mcLowerCase, mcMixedCase);
-
-type
- TUserSetRange = pmUser1..pmUser8;
- TForceCaseRange = pmUser1..pmUser8;
- TSubstCharRange = Subst1..Subst8;
-
- TUserCharSets = array[TUserSetRange] of TCharSet;
- TForceCase = array[TForceCaseRange] of TCaseChange;
- TSubstChars = array[TSubstCharRange] of AnsiChar;
-
-const
- MaxDateLen = 40; {maximum length of date picture strings}
- MaxMonthName = 15; {maximum length for month names}
- MaxDayName = 15; {maximum length for day names}
-
-const
- otf_SizeData = 0; {These three constants are used in data transfers to}
- otf_GetData = 1; {specify the type of transfer operation being requested}
- otf_SetData = 2;
-
-type
- TEditString = array[0..MaxEditLen] of AnsiChar;
- TPictureMask = array[0..MaxPicture] of AnsiChar;
-
- {An array of flags that indicate the type of mask character at a given
- location in a picture mask}
- TPictureFlags = array[0..MaxEditLen+1] of Byte;
-
- {Each entry field maintains two data structures of this type, one to store
- the lower limit of a field's value, and another to store the upper limit}
- PRangeType = ^TRangeType;
- TRangeType = packed record
- case Byte of {size}
- 00 : (rtChar : AnsiChar); {01}
- 01 : (rtByte : Byte); {01}
- 02 : (rtSht : ShortInt); {01}
- 03 : (rtInt : SmallInt); {02}
- 04 : (rtWord : Word); {02}
- 05 : (rtLong : LongInt); {04}
- 06 : (rtSgl : Single); {04}
- 07 : (rtPtr : Pointer); {04}
- {$IFDEF CBuilder}
- 08 : (rtReal : Double); {06}
- {$ELSE}
- 08 : (rtReal : Real); {06}
- {$ENDIF CBuilder}
- 09 : (rtDbl : Double); {08}
- {$IFDEF CBuilder}
- 10 : (rtComp : Double); {08}
- {$ELSE}
- {$IFNDEF FPC} {Delphi}
- 10 : (rtComp : Comp); {08}
- {$ELSE} {FPC}
- {$IFDEF CPU86}
- 10 : (rtComp : Comp); {08}
- {$ELSE} {Comp is true integer with non-Intel}
- 10 : (rtComp : Double); {08}
- {$ENDIF}
- {$ENDIF}
- {$ENDIF CBuilder}
- 11 : (rtExt : Extended); {10}
- 12 : (rtDate : LongInt); {04}
- 13 : (rtTime : LongInt); {04}
- 14 : (rt10 : array[1..10] of Byte); {10} {forces structure to size of 10 bytes}
- end;
-
-const
- BlankRange : TRangeType = (rt10 : (0, 0, 0, 0, 0, 0, 0, 0, 0, 0));
-
-{*** Date/Time declarations ***}
-type
- TOvcDate = TStDate;
- TOvcTime = TStTime;
- TDayType = TStDayType;
-
-type
- {states for data aware entry fields}
- TDbEntryFieldStates = (esFocused, esSelected, esReset);
- TDbEntryFieldState = set of TDbEntryFieldStates;
-
-type
- {Search option flags for editor and viewer}
- TSearchOptions = (
- soFind, {find (this option is assumed) }
- soBackward, {search backwards }
- soMatchCase, {don't ignore case when searching }
- soGlobal, {search globally }
- soReplace, {find and replace (editor only)}
- soReplaceAll, {find and replace all (editor only)}
- soWholeWord, {match on whole word only (editor only)}
- soSelText); {search in selected text (editor only)}
- TSearchOptionSet = set of TSearchOptions;
-
-const
- {maximum length of a search/replacement string}
- MaxSearchString = 255;
-
-type
- {types of tabs supported in the editor}
- TTabType = (ttReal, ttFixed, ttSmart);
-
- {entry field flag for display of number field with zero value}
- TZeroDisplay = (zdShow, zdHide, zdHideUntilModified);
-
-type
- {structrue of the commands stored in the command table}
- POvcCmdRec = ^TOvcCmdRec;
- TOvcCmdRec = packed record
- case Byte of
- 0 : (Key1 : Byte; {first keys' virtual key code}
- SS1 : Byte; {shift state of first key}
- Key2 : Byte; {second keys' virtual key code, if any}
- SS2 : Byte; {shift state of second key}
- Cmd : Word); {command to return for this entry}
- 1 : (Keys : LongInt); {used for sorting, searching, and storing}
- end;
-
-const
- {shift state flags for command processors}
- ss_None = $00; {no shift key is pressed}
- ss_Shift = $02; {the shift key is pressed}
- ss_Ctrl = $04; {the control key is pressed}
- ss_Alt = $08; {the alt key is pressed}
- ss_Wordstar = $80; {2nd key of a twokey wordstar command: ss_Ctrl or ss_None}
- {the second key of a two-key wordstar command is accepted if}
- {pressed by itself of with the ctrl key. case is ignored}
-
-const
- {virtual key constants not already defined}
- VK_NONE = 0;
- VK_ALT = VK_MENU;
- VK_A = Ord('A'); VK_B = Ord('B'); VK_C = Ord('C'); VK_D = Ord('D');
- VK_E = Ord('E'); VK_F = Ord('F'); VK_G = Ord('G'); VK_H = Ord('H');
- VK_I = Ord('I'); VK_J = Ord('J'); VK_K = Ord('K'); VK_L = Ord('L');
- VK_M = Ord('M'); VK_N = Ord('N'); VK_O = Ord('O'); VK_P = Ord('P');
- VK_Q = Ord('Q'); VK_R = Ord('R'); VK_S = Ord('S'); VK_T = Ord('T');
- VK_U = Ord('U'); VK_V = Ord('V'); VK_W = Ord('W'); VK_X = Ord('X');
- VK_Y = Ord('Y'); VK_Z = Ord('Z'); VK_0 = Ord('0'); VK_1 = Ord('1');
- VK_2 = Ord('2'); VK_3 = Ord('3'); VK_4 = Ord('4'); VK_5 = Ord('5');
- VK_6 = Ord('6'); VK_7 = Ord('7'); VK_8 = Ord('8'); VK_9 = Ord('9');
-
-var
- AlphaCharSet : TCharSet;
-
-const
- IntegerCharSet: TCharSet = ['0'..'9', ' '];
- RealCharSet : TCharSet = ['0'..'9', ' ', '-', '.'];
-
-const
- {Picture flag values for elements in a TPictureFlags array}
- pflagLiteral = 0; {Corresponding char in the mask is a literal}
- pflagFormat = 1; {Corresponding char in the mask is a formatting character}
- pflagSemiLit = 2; {Corresponding char in the mask is a semi-literal character}
-
-const
- {------------------- Windows messages -----------------------}
- {Not a message code. Value of the first of the message codes used}
- OM_FIRST = $7F00; {***}
-
- {entry field error}
- OM_REPORTERROR = OM_FIRST + 0;
- {messages for/from viewer/editor controls}
- OM_SETFOCUS = OM_FIRST + 1;
- {sent by an entry field to the controller to request return of the
- focus. lParam is pointer of the object to return the focus to}
- OM_SHOWSTATUS = OM_FIRST + 2;
- {sent by a viewer or editor control to itself when the caret moves, or
- when text is inserted or deleted. wParam is the current column (an
- effective column number), and lParam is the current line}
- OM_GETDATASIZE = OM_FIRST + 3;
- {sent to an entry field to obtain its data size}
- OM_RECREATEWND = OM_FIRST + 5;
- {sent to force a call to RecreateWnd}
- OM_PREEDIT = OM_FIRST + 6;
- {sent to preform pre-edit notification for entry fields}
- OM_POSTEDIT = OM_FIRST + 7;
- {sent to preform post-edit notification for entry fields}
- OM_AFTERENTER = OM_FIRST + 8;
- {sent to preform after-enter notification}
- OM_AFTEREXIT = OM_FIRST + 9;
- {sent to preform after-exit notification}
- OM_DELAYNOTIFY = OM_FIRST + 10;
- {sent to preform delayed notification}
- OM_POSITIONLABEL = OM_FIRST + 11;
- {sent to cause the label to be repositioned}
- OM_RECORDLABELPOSITION = OM_FIRST + 12;
- {sent to cause the current position of the label to be recorded}
- OM_ASSIGNLABEL = OM_FIRST + 13;
- {sent to assign a albel to a control}
- OM_FONTUPDATEPREVIEW = OM_FIRST + 14;
- {sent to postpone the font change of the preview control}
- OM_DESTROYHOOK = OM_FIRST + 15;
- {send to cause the window hook to be destroyed}
- OM_PROPCHANGE = OM_FIRST + 16;
- {sent by a collection to its property editor when a property is changed}
- OM_ISATTACHED = OM_FIRST + 17;
- {sent to other controls to see if they are attached. Used by attached
- button components and components that use an internal validator.
- Result is LongInt(Self) if true}
- OM_VALIDATE = OM_FIRST + 18;
- {Sent to the FlexEdit as a call for it to Validate Itself}
-
-{message crackers for the above Orpheus messages}
-
-type
- TOMReportError = packed record
- Msg : Cardinal;
- Error : Word;
- Unused : Word;
- lParam : LongInt;
- Result : LongInt;
- end;
-
- TOMSetFocus = packed record
- Msg : Cardinal;
- wParam : Integer;
- Control: TWinControl;
- Result : LongInt;
- end;
-
- TOMShowStatus = packed record
- Msg : Cardinal;
- Column : Integer;
- Line : LongInt;
- Result : LongInt;
- end;
-
-
-type
- TShowStatusEvent =
- procedure(Sender : TObject; LineNum : LongInt; ColNum : Integer)
- of object;
- {-event to notify of a viewer or editor caret position change}
-
- TTopLineChangedEvent =
- procedure(Sender : TObject; Line : LongInt)
- of object;
- {-event to notify when the top line changes for the editor or viewer}
-
-const
- {*** Error message codes ***}
- oeFirst = 256;
-
- oeRangeError = oeFirst + 0;
- {This error occurs when a user enters a value that is not within the
- accepted range of values for the field}
- oeInvalidNumber = oeFirst + 1;
- {This error is reported if the user enters a string that does not represent
- a number in a field that should contain a numeric value}
- oeRequiredField = oeFirst + 2;
- {This error occurs when the user leaves blank a field that is marked as
- required}
- oeInvalidDate = oeFirst + 3;
- {This error occurs when the user enters a value in a date field that does
- not represent a valid date}
- oeInvalidTime = oeFirst + 4;
- {This error occurs when the user enters a value in a time field that does
- not represent a valid time of day}
- oeBlanksInField = oeFirst + 5;
- {This error is reported only by the validation helper routines
- ValidateNoBlanks and ValidateSubfields. It indicates that a blank was left
- in a field or subfield in which no blanks are allowed}
- oePartialEntry = oeFirst + 6;
- {This error is reported only by the validation helper routines
- ValidateNotPartial and ValidateSubfields in OODEWCC. It indicates that a
- partial entry was given in a field or subfield in which the field/subfield
- must be either entirely empty or entirely full}
- oeOutOfMemory = oeFirst + 7;
- {This error is reported by a viewer or editor control when there is
- insufficient memory to perform the requested operation. A viewer control
- reports this error only when copying selected text to the clipboard}
- oeRegionSize = oeFirst + 8;
- {This error is reported by an editor control when the user asks to
- copy selected text to the clipboard, and the selected region exceeds
- 64K in size}
- oeTooManyParas = oeFirst + 9;
- {This error is reported by an editor control when the limit on the number
- of paragraphs is reached, and the requested operation would cause it to be
- exceeded}
- oeCannotJoin = oeFirst + 10;
- {This error is reported by an editor control when the user attempts to join
- two paragraphs that cannot be joined. Typically this occurs when joining
- the two paragraphs would cause the new paragraph to exceed its size limit}
- oeTooManyBytes = oeFirst + 11;
- {This error is reported by an editor control when the limit on the total
- number of bytes is reached, and the requested operation would cause it to
- be exceeded}
- oeParaTooLong = oeFirst + 12;
- {This error is reported by an editor control when the limit on the length
- of an individual paragraph is reached, and the requested operation would
- cause it to be exceeded}
- oeCustomError = 32768;
- {the first error code reserved for user applications. All }
- {error values less than this value are reserved for use by}
- {Orpheus}
-
-{*** Field class and type constant id's ***}
-
-const
- {Field class codes}
- fcSimple = 0;
- fcPicture = 1;
- fcNumeric = 2;
-
- {Field class divisor}
- fcpDivisor = $40;
-
- {Field class prefixes}
- fcpSimple = fcpDivisor*fcSimple;
- fcpPicture = fcpDivisor*fcPicture;
- fcpNumeric = fcpDivisor*fcNumeric;
-
- {Field type IDs for simple fields}
- fidSimpleString = fcpSimple+fsubString;
- fidSimpleChar = fcpSimple+fsubChar;
- fidSimpleBoolean = fcpSimple+fsubBoolean;
- fidSimpleYesNo = fcpSimple+fsubYesNo;
- fidSimpleLongInt = fcpSimple+fsubLongInt;
- fidSimpleWord = fcpSimple+fsubWord;
- fidSimpleInteger = fcpSimple+fsubInteger;
- fidSimpleByte = fcpSimple+fsubByte;
- fidSimpleShortInt = fcpSimple+fsubShortInt;
- fidSimpleReal = fcpSimple+fsubReal;
- fidSimpleExtended = fcpSimple+fsubExtended;
- fidSimpleDouble = fcpSimple+fsubDouble;
- fidSimpleSingle = fcpSimple+fsubSingle;
- fidSimpleComp = fcpSimple+fsubComp;
-
- {Field type IDs for picture fields}
- fidPictureString = fcpPicture+fsubString;
- fidPictureChar = fcpPicture+fsubChar;
- fidPictureBoolean = fcpPicture+fsubBoolean;
- fidPictureYesNo = fcpPicture+fsubYesNo;
- fidPictureLongInt = fcpPicture+fsubLongInt;
- fidPictureWord = fcpPicture+fsubWord;
- fidPictureInteger = fcpPicture+fsubInteger;
- fidPictureByte = fcpPicture+fsubByte;
- fidPictureShortInt = fcpPicture+fsubShortInt;
- fidPictureReal = fcpPicture+fsubReal;
- fidPictureExtended = fcpPicture+fsubExtended;
- fidPictureDouble = fcpPicture+fsubDouble;
- fidPictureSingle = fcpPicture+fsubSingle;
- fidPictureComp = fcpPicture+fsubComp;
- fidPictureDate = fcpPicture+fsubDate;
- fidPictureTime = fcpPicture+fsubTime;
-
- {Field type IDs for numeric fields}
- fidNumericLongInt = fcpNumeric+fsubLongInt;
- fidNumericWord = fcpNumeric+fsubWord;
- fidNumericInteger = fcpNumeric+fsubInteger;
- fidNumericByte = fcpNumeric+fsubByte;
- fidNumericShortInt = fcpNumeric+fsubShortInt;
- fidNumericReal = fcpNumeric+fsubReal;
- fidNumericExtended = fcpNumeric+fsubExtended;
- fidNumericDouble = fcpNumeric+fsubDouble;
- fidNumericSingle = fcpNumeric+fsubSingle;
- fidNumericComp = fcpNumeric+fsubComp;
-
-
-function GetOrphStr(Index : Word) : string;
- {-return a string from our RCDATA string resource}
-
-implementation
-
-function GetOrphStr(Index : Word) : string;
-begin
- Result := ResourceStrByNumber(Index);
- if Result = '' then
- Result := 'Unknown';
-end;
-
-
-procedure InitAlphaCharSet;
- {-Initialize AlphaOnlySet}
-var
- C : AnsiChar;
-begin
- AlphaCharSet := ['A'..'Z', 'a'..'z', ' ', '-', '.', ','];
- for C := #128 to #255 do
- {ask windows what other characters are considered alphas}
- if IsCharAlpha(C) then
- AlphaCharSet := AlphaCharSet + [C];
-end;
-
-initialization
- InitAlphaCharSet;
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovcdate.pas b/Source/3rdParty/Orpheus/ovcdate.pas
deleted file mode 100644
index 6084d41e..00000000
--- a/Source/3rdParty/Orpheus/ovcdate.pas
+++ /dev/null
@@ -1,996 +0,0 @@
-{*********************************************************}
-{* OVCDATE.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}
-
-{$IFDEF VERSION7}
- {$IFNDEF FPC}
- {$WARN UNSAFE_CODE OFF}
- {$WARN UNSAFE_TYPE OFF}
- {$WARN UNSAFE_CAST OFF}
- {$ENDIF}
-{$ENDIF}
-
-{For BCB 3.0 package support.}
-{$IFDEF VER110}
- {$ObjExportAll On}
-{$ENDIF}
-
-
-{---Global compiler defines for Delphi 2.0---}
-{$A+} {Word Align Data}
-{$H+} {Huge string support}
-{$Q-} {Overflow check}
-{$R-} {Range check}
-{$S-} {Stack check}
-{$T-} {Typed @ check}
-{$V-} {Var strings}
-
-unit ovcdate; {formerly StDate}
- {-Date and time manipulation}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, {$ENDIF} SysUtils;
-
-type
- TStDate = LongInt;
- {In STDATE, dates are stored in long integer format as the number of days
- since January 1, 1600}
-
- TDateArray = array[0..(MaxLongInt div SizeOf(TStDate))-1] of TStDate;
- {Type for StDate open array}
-
- TStDayType = (Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday);
- {An enumerated type used when representing a day of the week}
-
- TStBondDateType = (bdtActual, bdt30E360, bdt30360, bdt30360psa);
- {An enumerated type used for calculating bond date differences}
-
- TStTime = LongInt;
- {STDATE handles time in a manner similar to dates, representing a given
- time of day as the number of seconds since midnight}
-
- TStDateTimeRec =
- record
- {This record type simply combines the two basic date types defined by
- STDATE, Date and Time}
- D : TStDate;
- T : TStTime;
- end;
-
-const
- MinYear = 1600; {Minimum valid year for a date variable}
- MaxYear = 3999; {Maximum valid year for a date variable}
- Mindate = $00000000; {Minimum valid date for a date variable - 01/01/1600}
- Maxdate = $000D6025; {Maximum valid date for a date variable - 12/31/3999}
- Date1900 = $0001AC05; {This constant contains the Julian date for 01/01/1900}
- Date1980 = $00021E28; {This constant contains the Julian date for 01/01/1980}
- Date2000 = $00023AB1; {This constant contains the Julian date for 01/01/2000}
- {This value is used to represent an invalid date, such as 12/32/1992}
- BadDate = LongInt($FFFFFFFF);
-
- DeltaJD = $00232DA8; {Days between 1/1/-4173 and 1/1/1600}
-
- MinTime = 0; {Minimum valid time for a time variable - 00:00:00 am}
- MaxTime = 86399; {Maximum valid time for a time variable - 23:59:59 pm}
- {This value is used to represent an invalid time of day, such as 12:61:00}
- BadTime = LongInt($FFFFFFFF);
-
- SecondsInDay = 86400; {Number of seconds in a day}
- SecondsInHour = 3600; {Number of seconds in an hour}
- SecondsInMinute = 60; {Number of seconds in a minute}
- HoursInDay = 24; {Number of hours in a day}
- MinutesInHour = 60; {Number of minutes in an hour}
- MinutesInDay = 1440; {Number of minutes in a day}
-
-var
- DefaultYear : Integer; {default year--used by DateStringToDMY}
- DefaultMonth : ShortInt; {default month}
-
- {-------julian date routines---------------}
-
-function CurrentDate : TStDate;
- {-returns today's date as a Julian date}
-
-function ValidDate(Day, Month, Year, Epoch : Integer) : Boolean;
- {-Verify that day, month, year is a valid date}
-
-function DMYtoStDate(Day, Month, Year, Epoch : Integer) : TStDate;
- {-Convert from day, month, year to a Julian date}
-
-procedure StDateToDMY(Julian : TStDate; var Day, Month, Year : Integer);
- {-Convert from a Julian date to day, month, year}
-
-function IncDate(Julian : TStDate; Days, Months, Years : Integer) : TStDate;
- {-Add (or subtract) the number of days, months, and years to a date}
-
-function IncDateTrunc(Julian : TStDate; Months, Years : Integer) : TStDate;
- {-Add (or subtract) the specified number of months and years to a date}
-
-procedure DateDiff(Date1, Date2 : TStDate;
- var Days, Months, Years : Integer);
-{-Return the difference in days, months, and years between two valid Julian
- dates}
-
-function BondDateDiff(Date1, Date2 : TStDate; DayBasis : TStBondDateType) : TStDate;
- {-Return the difference in days between two valid Julian
- dates using a specific financial basis}
-
-function WeekOfYear(Julian : TStDate) : Byte;
- {-Returns the week number of the year given the Julian Date}
-
-function AstJulianDate(Julian : TStDate) : Double;
- {-Returns the Astronomical Julian Date from a TStDate}
-
-function AstJulianDatetoStDate(AstJulian : Double; Truncate : Boolean) : TStDate;
- {-Returns a TStDate from an Astronomical Julian Date.
- Truncate TRUE Converts to appropriate 0 hours then truncates
- FALSE Converts to appropriate 0 hours, then rounds to
- nearest;}
-
-function AstJulianDatePrim(Year, Month, Date : Integer; UT : TStTime) : Double;
- {-Returns an Astronomical Julian Date for any year, even those outside
- MinYear..MaxYear}
-
-function DayOfWeek(Julian : TStDate) : TStDayType;
- {-Return the day of the week for a Julian date}
-
-function DayOfWeekDMY(Day, Month, Year, Epoch : Integer) : TStDayType;
- {-Return the day of the week for the day, month, year}
-
-function IsLeapYear(Year : Integer) : Boolean;
- {-Return True if Year is a leap year}
-
-function DaysInMonth(Month : Integer; Year, Epoch : Integer) : Integer;
- {-Return the number of days in the specified month of a given year}
-
-function ResolveEpoch(Year, Epoch : Integer) : Integer;
- {-Convert 2 digit year to 4 digit year according to Epoch}
-
-
- {-------time routines---------------}
-
-function ValidTime(Hours, Minutes, Seconds : Integer) : Boolean;
- {-Return True if Hours:Minutes:Seconds is a valid time}
-
-procedure StTimeToHMS(T : TStTime;
- var Hours, Minutes, Seconds : Byte);
- {-Convert a time variable to hours, minutes, seconds}
-
-function HMStoStTime(Hours, Minutes, Seconds : Byte) : TStTime;
- {-Convert hours, minutes, seconds to a time variable}
-
-function CurrentTime : TStTime;
- {-Return the current time in seconds since midnight}
-
-procedure TimeDiff(Time1, Time2 : TStTime;
- var Hours, Minutes, Seconds : Byte);
- {-Return the difference in hours, minutes, and seconds between two times}
-
-function IncTime(T : TStTime; Hours, Minutes, Seconds : Byte) : TStTime;
- {-Add the specified hours, minutes, and seconds to a given time of day}
-
-function DecTime(T : TStTime; Hours, Minutes, Seconds : Byte) : TStTime;
- {-Subtract the specified hours, minutes, and seconds from a given time of day}
-
-function RoundToNearestHour(T : TStTime; Truncate : Boolean) : TStTime;
- {-Given a time, round it to the nearest hour, or truncate minutes and
- seconds}
-
-function RoundToNearestMinute(const T : TStTime; Truncate : Boolean) : TStTime;
- {-Given a time, round it to the nearest minute, or truncate seconds}
-
- {-------- routines for DateTimeRec records ---------}
-
-procedure DateTimeDiff(DT1 : TStDateTimeRec; var DT2 : TStDateTimeRec;
- var Days : LongInt; var Secs : LongInt);
- {-Return the difference in days and seconds between two points in time}
-
-procedure IncDateTime(DT1 : TStDateTimeRec; var DT2 : TStDateTimeRec;
- Days : Integer; Secs : LongInt);
- {-Increment (or decrement) a date and time by the specified number of days
- and seconds}
-
-function DateTimeToStDate(DT : TDateTime) : TStDate;
- {-Convert Delphi TDateTime to TStDate}
-
-function DateTimeToStTime(DT : TDateTime) : TStTime;
- {-Convert Delphi TDateTime to TStTime}
-
-function StDateToDateTime(D : TStDate) : TDateTime;
- {-Convert TStDate to TDateTime}
-
-function StTimeToDateTime(T : TStTime) : TDateTime;
- {-Convert TStTime to TDateTime}
-
-function Convert2ByteDate(TwoByteDate : Word) : TStDate;
- {-Convert an Object Professional two byte date into a SysTools date}
-
-function Convert4ByteDate(FourByteDate : TStDate) : Word;
- {-Convert a SysTools date into an Object Professional two byte date}
-
-
-implementation
-
-const
- First2Months = 59; {1600 was a leap year}
- FirstDayOfWeek = Saturday; {01/01/1600 was a Saturday}
- DateLen = 40; {maximum length of Picture strings}
- MaxMonthName = 15;
- MaxDayName = 15;
-
-
-type
-{ DateString = string[DateLen];}
- SString = string[255];
-
-function IsLeapYear(Year : Integer) : Boolean;
- {-Return True if Year is a leap year}
-begin
- Result := (Year mod 4 = 0) and (Year mod 4000 <> 0) and
- ((Year mod 100 <> 0) or (Year mod 400 = 0));
-end;
-
-function IsLastDayofMonth(Day, Month, Year : Integer) : Boolean;
- {-Return True if date is the last day in month}
-var
- Epoch : Integer;
-begin
- Epoch := (Year div 100) * 100;
- if ValidDate(Day + 1, Month, Year, Epoch) then
- Result := false
- else
- Result := true;
-end;
-
-function IsLastDayofFeb(Date : TStDate) : Boolean;
- {-Return True if date is the last day in February}
-var
- Day, Month, Year : Integer;
-begin
- StDateToDMY(Date, Day, Month, Year);
- if (Month = 2) and IsLastDayOfMonth(Day, Month, Year) then
- Result := true
- else
- Result := false;
-end;
-
-
-{$IFDEF NoAsm}
-procedure ExchangeLongInts(var I, J : LongInt);
-var
- Temp : LongInt;
-begin
- Temp := I;
- I := J;
- J := Temp;
-end;
-
-// ExchangeStructs not needed - see the one place where called below.
-
-{$ELSE}
-procedure ExchangeLongInts(var I, J : LongInt);
-register;
-asm
- mov ecx, [eax]
- push ecx
- mov ecx, [edx]
- mov [eax], ecx
- pop ecx
- mov [edx], ecx
-end;
-
-procedure ExchangeStructs(var I, J; Size : Cardinal);
-register;
-asm
- push edi
- push ebx
- push ecx
- shr ecx, 2
- jz @@LessThanFour
-
-@@AgainDWords:
- mov ebx, [eax]
- mov edi, [edx]
- mov [edx], ebx
- mov [eax], edi
- add eax, 4
- add edx, 4
- dec ecx
- jnz @@AgainDWords
-
-@@LessThanFour:
- pop ecx
- and ecx, $3
- jz @@Done
- mov bl, [eax]
- mov bh, [edx]
- mov [edx], bl
- mov [eax], bh
- inc eax
- inc edx
- dec ecx
- jz @@Done
-
- mov bl, [eax]
- mov bh, [edx]
- mov [edx], bl
- mov [eax], bh
- inc eax
- inc edx
- dec ecx
- jz @@Done
-
- mov bl, [eax]
- mov bh, [edx]
- mov [edx], bl
- mov [eax], bh
-
-@@Done:
- pop ebx
- pop edi
-end;
-{$ENDIF}
-
-function ResolveEpoch(Year, Epoch : Integer) : Integer;
- {-Convert 2-digit year to 4-digit year according to Epoch}
-var
- EpochYear,
- EpochCent : Integer;
-begin
- if Word(Year) < 100 then begin
- EpochYear := Epoch mod 100;
- EpochCent := (Epoch div 100) * 100;
- if (Year < EpochYear) then
- Inc(Year,EpochCent+100)
- else
- Inc(Year,EpochCent);
- end;
- Result := Year;
-end;
-
-function CurrentDate : TStDate;
- {-Returns today's date as a julian}
-var
- Year, Month, Date : Word;
-begin
- DecodeDate(Now,Year,Month,Date);
- Result := DMYToStDate(Date,Month,Year,0);
-end;
-
-function DaysInMonth(Month : integer; Year, Epoch : Integer) : Integer;
- {-Return the number of days in the specified month of a given year}
-begin
- Year := ResolveEpoch(Year, Epoch);
-
- if (Year < MinYear) OR (Year > MaxYear) then
- begin
- Result := 0;
- Exit;
- end;
-
- case Month of
- 1, 3, 5, 7, 8, 10, 12 :
- Result := 31;
- 4, 6, 9, 11 :
- Result := 30;
- 2 :
- Result := 28+Ord(IsLeapYear(Year));
- else
- Result := 0;
- end;
-end;
-
-function ValidDate(Day, Month, Year, Epoch : Integer) : Boolean;
- {-Verify that day, month, year is a valid date}
-begin
- Year := ResolveEpoch(Year, Epoch);
-
- if (Day < 1) or (Year < MinYear) or (Year > MaxYear) then
- Result := False
- else case Month of
- 1..12 :
- Result := Day <= DaysInMonth(Month, Year, Epoch);
- else
- Result := False;
- end
-end;
-
-function DMYtoStDate(Day, Month, Year, Epoch : Integer) : TStDate;
- {-Convert from day, month, year to a julian date}
-begin
- Year := ResolveEpoch(Year, Epoch);
-
- if not ValidDate(Day, Month, Year, Epoch) then
- Result := BadDate
- else if (Year = MinYear) and (Month < 3) then
- if Month = 1 then
- Result := Pred(Day)
- else
- Result := Day+30
- else begin
- if Month > 2 then
- Dec(Month, 3)
- else begin
- Inc(Month, 9);
- Dec(Year);
- end;
- Dec(Year, MinYear);
- Result :=
- ((LongInt(Year div 100)*146097) div 4)+
- ((LongInt(Year mod 100)*1461) div 4)+
- (((153*Month)+2) div 5)+Day+First2Months;
- end;
-end;
-
-function WeekOfYear(Julian : TStDate) : Byte;
- {-Returns the week number of the year given the Julian Date}
-var
- Day, Month, Year : Integer;
- FirstJulian : TStDate;
-begin
- if (Julian < MinDate) or (Julian > MaxDate) then
- begin
- Result := 0;
- Exit;
- end;
-
- Julian := Julian + 3 - ((6 + Ord(DayOfWeek(Julian))) mod 7);
- StDateToDMY(Julian,Day,Month,Year);
- FirstJulian := DMYToStDate(1,1,Year,0);
- Result := 1 + (Julian - FirstJulian) div 7;
-end;
-
-function AstJulianDate(Julian : TStDate) : Double;
- {-Returns the Astronomical Julian Date from a TStDate}
-begin
- {Subtract 0.5d since Astronomical JD starts at noon
- while TStDate (with implied .0) starts at midnight}
- Result := Julian - 0.5 + DeltaJD;
-end;
-
-
-function AstJulianDatePrim(Year, Month, Date : Integer; UT : TStTime) : Double;
-var
- A, B : integer;
- LY,
- GC : Boolean;
-
-begin
- Result := -MaxLongInt;
- if (not (Month in [1..12])) or (Date < 1) then
- Exit
- else if (Month in [1, 3, 5, 7, 8, 10, 12]) and (Date > 31) then
- Exit
- else if (Month in [4, 6, 9, 11]) and (Date > 30) then
- Exit
- else if (Month = 2) then begin
- LY := IsLeapYear(Year);
- if ((LY) and (Date > 29)) or (not (LY) and (Date > 28)) then
- Exit;
- end else if ((UT < 0) or (UT >= SecondsInDay)) then
- Exit;
-
- if (Month <= 2) then begin
- Year := Year - 1;
- Month := Month + 12;
- end;
- A := abs(Year div 100);
-
- if (Year > 1582) then
- GC := True
- else if (Year = 1582) then begin
- if (Month > 10) then
- GC := True
- else if (Month < 10) then
- GC := False
- else begin
- if (Date >= 15) then
- GC := True
- else
- GC := False;
- end;
- end else
- GC := False;
- if (GC) then
- B := 2 - A + abs(A div 4)
- else
- B := 0;
-
- Result := Trunc(365.25 * (Year + 4716))
- + Trunc(30.6001 * (Month + 1))
- + Date + B - 1524.5
- + UT / SecondsInDay;
-end;
-
-
-function AstJulianDatetoStDate(AstJulian : Double; Truncate : Boolean) : TStDate;
- {-Returns a TStDate from an Astronomical Julian Date.
- Truncate TRUE Converts to appropriate 0 hours then truncates
- FALSE Converts to appropriate 0 hours, then rounds to
- nearest;}
-begin
- {Convert to TStDate, adding 0.5d for implied .0d of TStDate}
- AstJulian := AstJulian + 0.5 - DeltaJD;
- if (AstJulian < MinDate) OR (AstJulian > MaxDate) then
- begin
- Result := BadDate;
- Exit;
- end;
-
- if Truncate then
- Result := Trunc(AstJulian)
- else
- Result := Trunc(AstJulian + 0.5);
-end;
-
-procedure StDateToDMY(Julian : TStDate; var Day, Month, Year : Integer);
- {-Convert from a julian date to month, day, year}
-var
- I, J : LongInt;
-begin
- if Julian = BadDate then begin
- Day := 0;
- Month := 0;
- Year := 0;
- end else if Julian <= First2Months then begin
- Year := MinYear;
- if Julian <= 30 then begin
- Month := 1;
- Day := Succ(Julian);
- end else begin
- Month := 2;
- Day := Julian-30;
- end;
- end else begin
- I := (4*LongInt(Julian-First2Months))-1;
-
- J := (4*((I mod 146097) div 4))+3;
- Year := (100*(I div 146097))+(J div 1461);
- I := (5*(((J mod 1461)+4) div 4))-3;
- Day := ((I mod 153)+5) div 5;
-
- Month := I div 153;
- if Month < 10 then
- Inc(Month, 3)
- else begin
- Dec(Month, 9);
- Inc(Year);
- end;
- Inc(Year, MinYear);
- end;
-end;
-
-function IncDate(Julian : TStDate; Days, Months, Years : Integer) : TStDate;
- {-Add (or subtract) the number of months, days, and years to a date.
- Months and years are added before days. No overflow/underflow
- checks are made}
-var
- Day, Month, Year, Day28Delta : Integer;
-begin
- StDateToDMY(Julian, Day, Month, Year);
- Day28Delta := Day-28;
- if Day28Delta < 0 then
- Day28Delta := 0
- else
- Day := 28;
-
- Inc(Year, Years);
- Inc(Year, Months div 12);
- Inc(Month, Months mod 12);
- if Month < 1 then begin
- Inc(Month, 12);
- Dec(Year);
- end
- else if Month > 12 then begin
- Dec(Month, 12);
- Inc(Year);
- end;
-
- Julian := DMYtoStDate(Day, Month, Year,0);
- if Julian <> BadDate then begin
- Inc(Julian, Days);
- Inc(Julian, Day28Delta);
- end;
- Result := Julian;
-end;
-
-function IncDateTrunc(Julian : TStDate; Months, Years : Integer) : TStDate;
- {-Add (or subtract) the specified number of months and years to a date}
-var
- Day, Month, Year : Integer;
- MaxDay, Day28Delta : Integer;
-begin
- StDateToDMY(Julian, Day, Month, Year);
- Day28Delta := Day-28;
- if Day28Delta < 0 then
- Day28Delta := 0
- else
- Day := 28;
-
- Inc(Year, Years);
- Inc(Year, Months div 12);
- Inc(Month, Months mod 12);
- if Month < 1 then begin
- Inc(Month, 12);
- Dec(Year);
- end
- else if Month > 12 then begin
- Dec(Month, 12);
- Inc(Year);
- end;
-
- Julian := DMYtoStDate(Day, Month, Year,0);
- if Julian <> BadDate then begin
- MaxDay := DaysInMonth(Month, Year,0);
- if Day+Day28Delta > MaxDay then
- Inc(Julian, MaxDay-Day)
- else
- Inc(Julian, Day28Delta);
- end;
- Result := Julian;
-end;
-
-procedure DateDiff(Date1, Date2 : TStDate; var Days, Months, Years : Integer);
- {-Return the difference in days,months,years between two valid julian dates}
-var
- Day1, Day2, Month1, Month2, Year1, Year2 : Integer;
-begin
- {we want Date2 > Date1}
- if Date1 > Date2 then
- ExchangeLongInts(Date1, Date2);
-
- {convert dates to day,month,year}
- StDateToDMY(Date1, Day1, Month1, Year1);
- StDateToDMY(Date2, Day2, Month2, Year2);
-
- {days first}
- if (Day1 = DaysInMonth(Month1, Year1, 0)) then begin
- Day1 := 0;
- Inc(Month1); {OK if Month1 > 12}
- end;
- if (Day2 = DaysInMonth(Month2, Year2, 0)) then begin
- Day2 := 0;
- Inc(Month2); {OK if Month2 > 12}
- end;
- if (Day2 < Day1) then begin
- Dec(Month2);
- if Month2 = 0 then begin
- Month2 := 12;
- Dec(Year2);
- end;
- Days := Day2 + DaysInMonth(Month1, Year1, 0) - Day1;
- end else
- Days := Day2-Day1;
-
- {now months and years}
- if Month2 < Month1 then begin
- Inc(Month2, 12);
- Dec(Year2);
- end;
- Months := Month2-Month1;
- Years := Year2-Year1;
-end;
-
-function BondDateDiff(Date1, Date2 : TStDate; DayBasis : TStBondDateType) : TStDate;
- {-Return the difference in days between two valid Julian
- dates using one a specific accrual method}
-var
- Day1,
- Month1,
- Year1,
- Day2,
- Month2,
- Year2 : Integer;
- IY : LongInt;
-begin
- {we want Date2 > Date1}
- if Date1 > Date2 then
- ExchangeLongInts(Date1, Date2);
-
- if (DayBasis = bdtActual) then
- Result := Date2-Date1
- else
- begin
- StDateToDMY(Date1, Day1, Month1, Year1);
- StDateToDMY(Date2, Day2, Month2, Year2);
-
- if ((DayBasis = bdt30360PSA) and IsLastDayofFeb(Date1)) or (Day1 = 31) then
- Day1 := 30;
- if (DayBasis = bdt30E360) then
- begin
- if (Day2 = 31) then
- Day2 := 30
- end else
- if (Day2 = 31) and (Day1 >= 30) then
- Day2 := 30;
-
- IY := 360 * (Year2 - Year1);
- Result := IY + 30 * (Month2 - Month1) + (Day2 - Day1);
- end;
-end;
-
-function DayOfWeek(Julian : TStDate) : TStDayType;
- {-Return the day of the week for the date. Returns TStDayType(7) if Julian =
- BadDate.}
-var
- B : Byte;
-begin
- if Julian = BadDate then begin
- B := 7;
- Result := TStDayType(B);
- end else
- Result := TStDayType( (Julian+Ord(FirstDayOfWeek)) mod 7 );
-end;
-
-function DayOfWeekDMY(Day, Month, Year, Epoch : Integer) : TStDayType;
- {-Return the day of the week for the day, month, year}
-begin
- Result := DayOfWeek( DMYtoStDate(Day, Month, Year, Epoch) );
-end;
-
-procedure StTimeToHMS(T : TStTime; var Hours, Minutes, Seconds : Byte);
- {-Convert a Time variable to Hours, Minutes, Seconds}
-begin
- if T = BadTime then begin
- Hours := 0;
- Minutes := 0;
- Seconds := 0;
- end
- else begin
- Hours := T div SecondsInHour;
- Dec(T, LongInt(Hours)*SecondsInHour);
- Minutes := T div SecondsInMinute;
- Dec(T, LongInt(Minutes)*SecondsInMinute);
- Seconds := T;
- end;
-end;
-
-function HMStoStTime(Hours, Minutes, Seconds : Byte) : TStTime;
- {-Convert Hours, Minutes, Seconds to a Time variable}
-var
- T : TStTime;
-begin
- Hours := Hours mod HoursInDay;
- T := (LongInt(Hours)*SecondsInHour)+(LongInt(Minutes)*SecondsInMinute)+Seconds;
- Result := T mod SecondsInDay;
-end;
-
-function ValidTime(Hours, Minutes, Seconds : Integer) : Boolean;
- {-Return true if Hours:Minutes:Seconds is a valid time}
-begin
- if (Hours < 0) or (Hours > 23) or
- (Minutes < 0) or (Minutes >= 60) or
- (Seconds < 0) or (Seconds >= 60) then
- Result := False
- else
- Result := True;
-end;
-
-function CurrentTime : TStTime;
- {-Returns current time in seconds since midnight}
-begin
- Result := Trunc(SysUtils.Time * SecondsInDay);
-end;
-
-procedure TimeDiff(Time1, Time2 : TStTime; var Hours, Minutes, Seconds : Byte);
- {-Return the difference in hours,minutes,seconds between two times}
-begin
- StTimeToHMS(Abs(Time1-Time2), Hours, Minutes, Seconds);
-end;
-
-function IncTime(T : TStTime; Hours, Minutes, Seconds : Byte) : TStTime;
- {-Add the specified hours,minutes,seconds to T and return the result}
-begin
- Inc(T, HMStoStTime(Hours, Minutes, Seconds));
- Result := T mod SecondsInDay;
-end;
-
-function DecTime(T : TStTime; Hours, Minutes, Seconds : Byte) : TStTime;
- {-Subtract the specified hours,minutes,seconds from T and return the result}
-begin
- Hours := Hours mod HoursInDay;
- Dec(T, HMStoStTime(Hours, Minutes, Seconds));
- if T < 0 then
- Result := T+SecondsInDay
- else
- Result := T;
-end;
-
-function RoundToNearestHour(T : TStTime; Truncate : Boolean) : TStTime;
- {-Round T to the nearest hour, or Truncate minutes and seconds from T}
-var
- Hours, Minutes, Seconds : Byte;
-begin
- StTimeToHMS(T, Hours, Minutes, Seconds);
- Seconds := 0;
- if not Truncate then
- if Minutes >= (MinutesInHour div 2) then
- Inc(Hours);
- Minutes := 0;
- Result := HMStoStTime(Hours, Minutes, Seconds);
-end;
-
-function RoundToNearestMinute(const T : TStTime; Truncate : Boolean) : TStTime;
- {-Round T to the nearest minute, or Truncate seconds from T}
-var
- Hours, Minutes, Seconds : Byte;
-begin
- StTimeToHMS(T, Hours, Minutes, Seconds);
- if not Truncate then
- if Seconds >= (SecondsInMinute div 2) then
- Inc(Minutes);
- Seconds := 0;
- Result := HMStoStTime(Hours, Minutes, Seconds);
-end;
-
-
-procedure DateTimeDiff(DT1 : TStDateTimeRec; var DT2 : TStDateTimeRec;
- var Days : LongInt; var Secs : LongInt);
- {-Return the difference in days and seconds between two points in time}
-var
- tDT1, tDT2 : TStDateTimeRec;
-{$IFDEF NoAsm}
- Temp : TStDateTimeRec;
-{$ENDIF}
-begin
- tDT1 := DT1;
- tDT2 := DT2;
- {swap if tDT1 later than tDT2}
- if (tDT1.D > tDT2.D) or ((tDT1.D = tDT2.D) and (tDT1.T > tDT2.T)) then
-{$IFDEF NoAsm}
- begin
- Temp := tDT1;
- tDT1 := tDT2;
- tDT2 := Temp;
- end;
-{$ELSE}
- ExchangeStructs(tDT1, tDT2,sizeof(TStDateTimeRec));
-{$ENDIF}
-
- {the difference in days is easy}
- Days := tDT2.D-tDT1.D;
-
- {difference in seconds}
- if tDT2.T < tDT1.T then begin
- {subtract one day, add 24 hours}
- Dec(Days);
- Inc(tDT2.T, SecondsInDay);
- end;
- Secs := tDT2.T-tDT1.T;
-end;
-
-function DateTimeToStDate(DT : TDateTime) : TStDate;
- {-Convert Delphi TDateTime to TStDate}
-var
- Day, Month, Year : Word;
-begin
- DecodeDate(DT, Year, Month, Day);
- Result := DMYToStDate(Day, Month, Year, 0);
-end;
-
-function DateTimeToStTime(DT : TDateTime) : TStTime;
- {-Convert Delphi TDateTime to TStTime}
-var
- Hour, Min, Sec, MSec : Word;
-begin
- DecodeTime(DT, Hour, Min, Sec, MSec);
- Result := HMSToStTime(Hour, Min, Sec);
-end;
-
-function StDateToDateTime(D : TStDate) : TDateTime;
- {-Convert TStDate to TDateTime}
-var
- Day, Month, Year : Integer;
-begin
- Result := 0;
- if D <> BadDate then begin
- StDateToDMY(D, Day, Month, Year);
- Result := EncodeDate(Year, Month, Day);
- end;
-end;
-
-function StTimeToDateTime(T : TStTime) : TDateTime;
- {-Convert TStTime to TDateTime}
-var
- Hour, Min, Sec : Byte;
-begin
- Result := 0;
- if T <> BadTime then begin
- StTimeToHMS(T, Hour, Min, Sec);
- Result := EncodeTime(Hour, Min, Sec, 0);
- end;
-end;
-
-procedure IncDateTime(DT1 : TStDateTimeRec; var DT2 : TStDateTimeRec; Days : Integer; Secs : LongInt);
- {-Increment (or decrement) DT1 by the specified number of days and seconds
- and put the result in DT2}
-begin
- DT2 := DT1;
-
- {date first}
- Inc(DT2.D, LongInt(Days));
-
- if Secs < 0 then begin
- {change the sign}
- Secs := -Secs;
-
- {adjust the date}
- Dec(DT2.D, Secs div SecondsInDay);
- Secs := Secs mod SecondsInDay;
-
- if Secs > DT2.T then begin
- {subtract a day from DT2.D and add a day's worth of seconds to DT2.T}
- Dec(DT2.D);
- Inc(DT2.T, SecondsInDay);
- end;
-
- {now subtract the seconds}
- Dec(DT2.T, Secs);
- end
- else begin
- {increment the seconds}
- Inc(DT2.T, Secs);
-
- {adjust date if necessary}
- Inc(DT2.D, DT2.T div SecondsInDay);
-
- {force time to 0..SecondsInDay-1 range}
- DT2.T := DT2.T mod SecondsInDay;
- end;
-end;
-
-function Convert2ByteDate(TwoByteDate : Word) : TStDate;
-begin
- Result := LongInt(TwoByteDate) + Date1900;
-end;
-
-function Convert4ByteDate(FourByteDate : TStDate) : Word;
-begin
- Result := Word(FourByteDate - Date1900);
-end;
-
-procedure SetDefaultYear;
- {-Initialize DefaultYear and DefaultMonth}
-var
- Month, Day, Year : Word;
- T : TDateTime;
-begin
- T := Now;
- DecodeDate(T, Year, Month, Day);
- DefaultYear := Year;
- DefaultMonth := Month;
-end;
-
-
-initialization
- {initialize DefaultYear and DefaultMonth}
- SetDefaultYear;
-end.
diff --git a/Source/3rdParty/Orpheus/ovcdrag.pas b/Source/3rdParty/Orpheus/ovcdrag.pas
deleted file mode 100644
index e61514ee..00000000
--- a/Source/3rdParty/Orpheus/ovcdrag.pas
+++ /dev/null
@@ -1,272 +0,0 @@
-{*********************************************************}
-{* OVCDRAG.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 ovcdrag;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, LclType, MyMisc, {$ENDIF}
- Classes, Graphics;
-
-type
- TOvcDragShow = class(TObject)
- {.Z+}
- protected
- dStretchBltMode : Integer;
- dMemDC,dSMemDC,
- dDstDC,dSaveDC : hDC;
- dSaveBmp, dMemBmp,
- dSMemBmp : hBITMAP;
- dcrText, dcrBack : TColorRef;
- dRect : TRect;
- dSize : TPoint;
- dSystemPalette16 : hPalette;
- dOldPal : hPalette;
- Bitmap,dMask : TBitmap;
- DeltaX, DeltaY : Integer;
- dDragging,
- dHaveOriginal : Boolean;
-
- procedure ilDragDraw;
- procedure ilRestoreOriginal;
- procedure ilSaveOriginal;
-
- public
- constructor Create(X, Y : Integer; SourceRect : TRect; TransColor : TColor);
- destructor Destroy;
- override;
- procedure DragMove(X, Y : Integer);
- procedure HideDragImage;
- procedure ShowDragImage;
- {.Z+}
- end;
-
-
-implementation
-
-
-{*** TOvcDragShow ***}
-
-constructor TOvcDragShow.Create(X, Y : Integer; SourceRect : TRect; TransColor : TColor);
-var
- dMaskDC : HDC;
- SrcDC : HDC;
-begin
- dHaveOriginal := False;
- dDstDC := GetDC(0);
- DeltaX := X - SourceRect.Left;
- DeltaY := Y - SourceRect.Top;
- dec(X, DeltaX);
- dec(Y, DeltaY);
- dRect.Left := X;
- dRect.Top := Y;
- Bitmap := nil;
- dMask := nil;
- try
- Bitmap := TBitmap.Create;
- Bitmap.Width := SourceRect.Right - SourceRect.Left + 1;
- Bitmap.Height := SourceRect.Bottom - SourceRect.Top + 1;
-
- dMask := TBitmap.Create;
- dMask.Width := SourceRect.Right - SourceRect.Left + 1;
- dMask.Height := SourceRect.Bottom - SourceRect.Top + 1;
-
- BitBlt(Bitmap.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height, dDstDC, SourceRect.Left,
- SourceRect.Top, SRCCOPY);
-{$IFNDEF LCL}
- dMask.Canvas.BrushCopy(Rect(0, 0, dMask.Width - 1, dMask.Height - 1), Bitmap,
- Rect(0, 0, dMask.Width - 1, dMask.Height - 1), TransColor);
-{$ELSE}
- BrushCopy(dMask.Canvas, Rect(0, 0, dMask.Width - 1, dMask.Height - 1), Bitmap,
- Rect(0, 0, dMask.Width - 1, dMask.Height - 1), TransColor);
-{$ENDIF}
-
- dMemDC := CreateCompatibleDC(0);
- dSaveDC := CreateCompatibleDC(0);
- dDragging := True;
- dStretchBltMode := SetStretchBltMode(dDstDC, BLACKONWHITE);
- dSize.X := Bitmap.Width;
- dSize.Y := Bitmap.Height;
- dRect.Right := dRect.Left + dSize.X - 1;
- dRect.Bottom := dRect.Top + dSize.Y - 1;
- SrcDC := Bitmap.Canvas.Handle;
- dMaskDC := dMask.Canvas.Handle;
- dSMemDC := CreateCompatibleDC(dMaskDC);
- dMemBmp := CreateCompatibleBitmap(SrcDC, dSize.X, dSize.Y);
- SelectObject(dMemDC, dMemBmp);
- dSMemBmp := CreateCompatibleBitmap(dMaskDC, dSize.X, dSize.Y);
- SelectObject(dSMemDC, dSMemBmp);
- dSaveBmp := CreateCompatibleBitmap(SrcDC, dSize.X, dSize.Y);
- SelectObject(dSaveDC, dSaveBmp);
- dSystemPalette16 := GetStockObject(DEFAULT_PALETTE);
- dOldPal := SelectPalette(SrcDC, dSystemPalette16, False);
- SelectPalette(SrcDC, dOldPal, False);
- if dOldPal <> 0 then begin
- SelectPalette(dMemDC, dOldPal, True);
- SelectPalette(dSaveDC, dOldPal, True);
- end else begin
- SelectPalette(dMemDC, dSystemPalette16, True);
- SelectPalette(dSaveDC, dSystemPalette16, True);
- end;
- RealizePalette(dMemDC);
- RealizePalette(dSaveDC);
-
- BitBlt(dSMemDC, 0, 0, dSize.X, dSize.Y, dMaskDC, 0, 0, SrcCopy);
- BitBlt(dMemDC, 0, 0, dSize.X, dSize.Y, dMaskDC, 0, 0, SrcCopy);
- BitBlt(dMemDC, 0, 0, dSize.X, dSize.Y, SrcDC, 0, 0, SrcErase);
- dcrText := SetTextColor(dDstDC, $0);
- dcrBack := SetBkColor(dDstDC, $FFFFFF);
- ilSaveOriginal;
- ilDragDraw;
- except
- Bitmap.Free;
- dMask.Free;
- raise;
- end;
-end;
-
-destructor TOvcDragShow.Destroy;
-begin
- ilRestoreOriginal;
- SetTextColor(dDstDC, dcrText);
- SetBkColor(dDstDC, dcrBack);
- DeleteObject(dMemBmp);
- DeleteObject(dSaveBmp);
- DeleteObject(dSMemBmp);
- DeleteDC(dMemDC);
- DeleteDC(dSMemDC);
- DeleteDC(dSaveDC);
- SetStretchBltMode(dDstDC, dStretchBltMode);
- ReleaseDC(0,dDstDC);
- dDragging := False;
- Bitmap.Free;
- dMask.Free;
- inherited Destroy;
-end;
-
-procedure TOvcDragShow.DragMove(X, Y: Integer);
-var
- NewRect, Union : TRect;
- UnionSize : TPoint;
- WorkDC : hDC;
- WorkBM : hBitmap;
-begin
- if not dDragging then exit;
- dec(X, DeltaX);
- dec(Y, DeltaY);
- {if we didn't move, get out}
- if (X = dRect.Left) and (Y = dRect.Top) then exit;
- {let's see where we're going}
- NewRect := Rect(X, Y, X + dSize.X - 1, Y + dSize.Y - 1);
- {if drag image not currently shown, just update next draw position and exit}
- if not dHaveOriginal then begin
- dRect := NewRect;
- exit;
- end;
- {do the old and new positions overlap?}
- if ord(IntersectRect(Union, dRect, NewRect)) <> 0 then begin
- {rect old and new combined:}
- UnionRect(Union, NewRect, dRect);
- {size of union:}
- UnionSize.X := Union.Right - Union.Left + 1;
- UnionSize.Y := Union.Bottom - Union.Top + 1;
- {create combination buffer}
- WorkDC := CreateCompatibleDC(0);
- WorkBM := CreateCompatibleBitmap(dDstDC, UnionSize.X, UnionSize.Y);
- SelectObject(WorkDC, WorkBM);
- if dOldPal <> 0 then
- SelectPalette(WorkDC, dOldPal, True)
- else
- SelectPalette(WorkDC, dSystemPalette16, True);
- RealizePalette(WorkDC);
- {copy screen section (including old image) to local buffer}
- BitBlt(WorkDC, 0, 0, UnionSize.X, UnionSize.Y, dDstDC, Union.Left, Union.Top, SRCCOPY);
- {"repair" by restoring background for old image}
- BitBlt(WorkDC, dRect.Left - Union.Left, dRect.Top - Union.Top,
- dSize.X, dSize.Y, dSaveDC, 0, 0, SRCCOPY);
- {save background so we can do the same next time}
- BitBlt(dSaveDC, 0, 0, dSize.X, dSize.Y, WorkDC, NewRect.Left - Union.Left, NewRect.Top - Union.Top, SrcCopy);
- {write image at new position into local buffer}
- BitBlt(WorkDC, NewRect.Left - Union.Left, NewRect.Top - Union.Top, dSize.X, dSize.Y, dSMemDC, 0, 0, SrcAnd);
- BitBlt(WorkDC, NewRect.Left - Union.Left, NewRect.Top - Union.Top, dSize.X, dSize.Y, dMemDC, 0, 0, SrcInvert);
- {copy combined image to screen}
- BitBlt(dDstDC, Union.Left, Union.Top, UnionSize.X, UnionSize.Y, WorkDC, 0, 0, SRCCOPY);
- dRect := NewRect;
- DeleteDC(WorkDC);
- DeleteObject(WorkBM);
- end else begin
- {images dont overlap, so we might as well do the draw in two steps}
- ilRestoreOriginal;
- dRect := NewRect;
- ilSaveOriginal;
- ilDragDraw;
- end;
-end;
-
-procedure TOvcDragShow.HideDragImage;
-begin
- ilRestoreOriginal;
-end;
-
-procedure TOvcDragShow.ilDragDraw;
-begin
- BitBlt(dDstDC, dRect.Left, dRect.Top, dSize.X, dSize.Y, dSMemDC, 0, 0, SrcAnd);
- BitBlt(dDstDC, dRect.Left, dRect.Top, dSize.X, dSize.Y, dMemDC, 0, 0, SrcInvert);
-end;
-
-procedure TOvcDragShow.ilRestoreOriginal;
-begin
- if not dHaveOriginal then exit;
- BitBlt(dDstDC, dRect.Left, dRect.Top, dSize.X, dSize.Y, dSaveDC, 0, 0, SrcCopy);
- dHaveOriginal := False;
-end;
-
-procedure TOvcDragShow.ilSaveOriginal;
-begin
- BitBlt(dSaveDC, 0, 0, dSize.X, dSize.Y, dDstDC, dRect.Left, dRect.Top, SrcCopy);
- dHaveOriginal := True;
-end;
-
-procedure TOvcDragShow.ShowDragImage;
-begin
- ilSaveOriginal;
- ilDragDraw;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovcedcal.pas b/Source/3rdParty/Orpheus/ovcedcal.pas
deleted file mode 100644
index 00611234..00000000
--- a/Source/3rdParty/Orpheus/ovcedcal.pas
+++ /dev/null
@@ -1,1128 +0,0 @@
-{*********************************************************}
-{* OVCEDCAL.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 ovcedcal;
- {-date edit field with popup calendar}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Buttons, Classes, Controls, Forms, Graphics, Menus,
- StdCtrls, SysUtils, {$IFNDEF LCL} {$IFDEF VERSION4} MultiMon, {$ENDIF} {$ENDIF} OvcBase, OvcCal,
- OvcConst, OvcData, OvcEdPop, OvcExcpt, OvcIntl, OvcMisc, OvcEditF, OvcDate;
-
-type
- TOvcDateOrder = (doMDY, doDMY, doYMD);
- TOvcRequiredDateField = (rfYear, rfMonth, rfDay);
- TOvcRequiredDateFields = set of TOvcRequiredDateField;
-
- {Events}
- TOvcGetDateEvent = procedure(Sender : TObject; var Value : string) of object;
- TOvcPreParseDateEvent = procedure(Sender : TObject; var Value : string)
- of object;
- TOvcGetDateMaskEvent = procedure(Sender : TObject; var Mask : string)
- of object;
-
- TOvcCustomDateEdit = class(TOvcEdPopup)
- protected {private}
- {property variables}
- FAllowIncDec : Boolean;
- FCalendar : TOvcCalendar;
- FDate : TDateTime;
- FEpoch : Integer;
- FForceCentury : Boolean;
- FRequiredFields : TOvcRequiredDateFields;
- FTodayString : string;
-
- {event variables}
- FOnGetDate : TOvcGetDateEvent;
- FOnGetDateMask : TOvcGetDateMaskEvent;
- FOnPreParseDate : TOvcPreParseDateEvent;
- FOnSetDate : TNotifyEvent;
-
- {internal variables}
- DateOrder : TOvcDateOrder;
- HoldCursor : TCursor;
- PopupClosing : Boolean;
- WasAutoScroll : Boolean;
-
- {property methods}
- function GetDate : TDateTime;
- function GetEpoch : Integer;
- function GetPopupColors : TOvcCalColors;
- function GetPopupFont : TFont;
- function GetPopupHeight : Integer;
- function GetPopupDateFormat : TOvcDateFormat;
- function GetPopupDayNameWidth : TOvcDayNameWidth;
- function GetPopupOptions : TOvcCalDisplayOptions;
- function GetPopupWeekStarts : TOvcDayType;
- function GetPopupWidth : Integer;
- function GetReadOnly : Boolean;
- procedure SetEpoch(Value : Integer);
- procedure SetForceCentury(Value : Boolean);
- procedure SetPopupColors(Value : TOvcCalColors);
- procedure SetPopupFont(Value : TFont);
- procedure SetPopupHeight(Value : Integer);
- procedure SetPopupWidth(Value : Integer);
- procedure SetPopupDateFormat(Value : TOvcDateFormat);
- procedure SetPopupDayNameWidth(Value : TOvcDayNameWidth);
- procedure SetPopupOptions(Value : TOvcCalDisplayOptions);
- procedure SetPopupWeekStarts(Value : TOvcDayType);
- procedure SetReadOnly(Value : Boolean);
-
- {internal methods}
- function ParseDate(const Value : string) : string;
- procedure PopupDateChange(Sender : TObject; Date : TDateTime);
- procedure PopupKeyDown(Sender : TObject; var Key : Word;
- Shift : TShiftState);
- procedure PopupKeyPress(Sender : TObject; var Key : Char);
- procedure PopupMouseDown(Sender : TObject; Button : TMouseButton;
- Shift : TShiftState; X, Y : Integer);
- protected
- procedure DoExit; override;
- procedure GlyphChanged; override;
- procedure KeyDown(var Key : Word; Shift : TShiftState); override;
- procedure KeyPress(var Key : Char); override;
- procedure SetDate(Value : TDateTime);
-
- {protected properties}
- property AllowIncDec : Boolean read FAllowIncDec write FAllowIncDec;
- property Epoch : Integer read GetEpoch write SetEpoch;
- property ForceCentury : Boolean read FForceCentury write SetForceCentury;
- property PopupColors : TOvcCalColors read GetPopupColors
- write SetPopupColors;
- property PopupFont : TFont read GetPopupFont write SetPopupFont;
- property PopupHeight : Integer read GetPopupHeight write SetPopupHeight;
- property PopupWidth : Integer read GetPopupWidth write SetPopupWidth;
- property PopupDateFormat : TOvcDateFormat read GetPopupDateFormat
- write SetPopupDateFormat;
- property PopupDayNameWidth : TOvcDayNameWidth read GetPopupDayNameWidth
- write SetPopupDayNameWidth;
- property PopupOptions : TOvcCalDisplayOptions read GetPopupOptions
- write SetPopupOptions;
- property PopupWeekStarts : TOvcDayType read GetPopupWeekStarts
- write SetPopupWeekStarts;
- property ReadOnly : Boolean read GetReadOnly write SetReadOnly;
- property RequiredFields : TOvcRequiredDateFields read FRequiredFields
- write FRequiredFields;
- property TodayString : string read FTodayString write FTodayString;
-
- {protected events}
- property OnGetDate : TOvcGetDateEvent read FOnGetDate write FOnGetDate;
- property OnGetDateMask : TOvcGetDateMaskEvent read FOnGetDateMask
- write FOnGetDateMask;
- property OnPreParseDate : TOvcPreParseDateEvent read FOnPreParseDate
- write FOnPreParseDate;
- property OnSetDate : TNotifyEvent read FOnSetDate write FOnSetDate;
-
- public
- constructor Create(AOwner : TComponent); override;
- function DateString(const Mask : string) : string;
- function FormatDate(Value : TDateTime) : string; dynamic;
- procedure PopupClose(Sender : TObject); override;
- procedure PopupOpen; override;
- procedure SetDateText(Value : string); dynamic;
- {public properties}
- property Calendar : TOvcCalendar read FCalendar;
- property Date: TDateTime read GetDate write SetDate;
- end;
-
-
- TOvcDateEdit = class(TOvcCustomDateEdit)
- published
- {properties}
- {$IFDEF VERSION4}
- property Anchors;
- property Constraints;
- property DragKind;
- {$ENDIF}
- property About;
- property AllowIncDec;
-{$IFNDEF LCL}
- property AutoSelect;
-{$ENDIF}
- property AutoSize;
- property BorderStyle;
- property ButtonGlyph;
- property CharCase;
- property Color;
- property Controller;
- property Ctl3D;
- property Cursor;
- property DragCursor;
- property DragMode;
- property Enabled;
- property Epoch;
- property Font;
- property ForceCentury;
-{$IFNDEF LCL}
- property HideSelection;
-{$ENDIF}
- property LabelInfo;
- property ParentColor;
-{$IFNDEF LCL}
- property ParentCtl3D;
-{$ENDIF}
- property ParentFont;
- property ParentShowHint;
- property PopupAnchor;
- property PopupColors;
- property PopupDateFormat;
- property PopupDayNameWidth;
- property PopupFont;
- property PopupHeight;
- property PopupMenu;
- property PopupOptions;
- property PopupWidth;
- property PopupWeekStarts;
- property ReadOnly;
- property RequiredFields;
- property ShowButton;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property TodayString;
- property Visible;
-
- {inherited events}
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnGetDate;
- property OnGetDateMask;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnPopupClose;
- property OnPopupOpen;
- property OnPreParseDate;
- property OnSetDate;
- property OnStartDrag;
- end;
-
-implementation
-
-{*** TOvcCustomDateEdit ***}
-
-constructor TOvcCustomDateEdit.Create(AOwner : TComponent);
-var
- C : array[0..1] of Char;
-begin
- inherited Create(AOwner);
-
- ControlStyle := ControlStyle - [csSetCaption];
-
- FAllowIncDec := True;
- FForceCentury := False;
- FRequiredFields := [rfMonth, rfDay];
- FTodayString := DateSeparator;
-
- {get the date order from windows}
- C[0] := '0'; {default}
-
- GetProfileString('intl', 'iDate', '0', C, 2);
- DateOrder := TOvcDateOrder(Ord(C[0])-Ord('0'));
-
- {load button glyph}
-{$IFNDEF LCL}
- FButtonGlyph.Handle := LoadBaseBitmap('ORBTNCAL');
-{$ELSE}
- FButtonGlyph.LoadFromLazarusResource('ORBTNCAL');
-{$ENDIF}
- FButton.Glyph.Assign(FButtonGlyph);
-
- FCalendar := TOvcCalendar.CreateEx(Self, True);
- FCalendar.OnChange := PopupDateChange;
- FCalendar.OnExit := PopupClose;
- FCalendar.OnKeyDown := PopupKeyDown;
- FCalendar.OnKeyPress := PopupKeyPress;
- FCalendar.OnMouseDown := PopupMouseDown;
- FCalendar.Visible := False; {to avoid flash at 0,0}
- FCalendar.BorderStyle := bsSingle;
- FCalendar.ParentFont := False;
- FCalendar.Parent := GetImmediateParentForm(Self);
-end;
-
-procedure TOvcCustomDateEdit.DoExit;
-begin
- try
- SetDateText(Text);
- except
- SetFocus;
- raise;
- end;
-
- if not PopupActive then
- inherited DoExit;
-end;
-
-function TOvcCustomDateEdit.DateString(const Mask : string) : string;
-begin
- Result := OvcIntlSup.DateToDateString(Mask, DateTimeToSTDate(Date), False);
-end;
-
-function TOvcCustomDateEdit.FormatDate(Value : TDateTime) : string;
-var
- DateMask : string;
- Mask : string;
-begin
- DateMask := OvcIntlSup.InternationalDate(FForceCentury);
- if Assigned(FOnGetDateMask) then begin
- FOnGetDateMask(Self, DateMask);
- {see if the date order needs to be changed}
- Mask := AnsiUpperCase(DateMask);
- if (Pos('M', Mask) > Pos('Y', Mask)) or
- (Pos('N', Mask) > Pos('Y', Mask)) then
- DateOrder := doYMD
- else if (Pos('M', Mask) > Pos('D', Mask)) or
- (Pos('N', Mask) > Pos('D', Mask)) then
- DateOrder := doDMY
- else
- DateOrder := doMDY;
- end;
- Result := OvcIntlSup.DateToDateString(DateMask, DateTimeToSTDate(Value), False);
-end;
-
-function TOvcCustomDateEdit.GetDate : TDateTime;
-begin
- SetDateText(Text);
- Result := FDate;
-end;
-
-function TOvcCustomDateEdit.GetEpoch : Integer;
-begin
- Result := FEpoch;
-
- if (csWriting in ComponentState) then
- Exit;
-
- if (Result = 0) and ControllerAssigned then
- Result := Controller.Epoch;
-end;
-
-function TOvcCustomDateEdit.GetPopupColors : TOvcCalColors;
-begin
- Result := FCalendar.Colors;
-end;
-
-function TOvcCustomDateEdit.GetPopupDateFormat : TOvcDateFormat;
-begin
- Result := FCalendar.DateFormat;
-end;
-
-function TOvcCustomDateEdit.GetPopupDayNameWidth : TOvcDayNameWidth;
-begin
- Result := FCalendar.DayNameWidth;
-end;
-
-function TOvcCustomDateEdit.GetPopupFont : TFont;
-begin
- Result := FCalendar.Font;
-end;
-
-function TOvcCustomDateEdit.GetPopupHeight : Integer;
-begin
- Result := FCalendar.Height;
-end;
-
-function TOvcCustomDateEdit.GetPopupOptions: TOvcCalDisplayOptions;
-begin
- Result := FCalendar.Options;
-end;
-
-function TOvcCustomDateEdit.GetPopupWeekStarts: TOvcDayType;
-begin
- Result := FCalendar.WeekStarts;
-end;
-
-function TOvcCustomDateEdit.GetPopupWidth : Integer;
-begin
- Result := FCalendar.Width;
-end;
-
-function TOvcCustomDateEdit.GetReadOnly : Boolean;
-begin
- Result := inherited ReadOnly;
-end;
-
-procedure TOvcCustomDateEdit.GlyphChanged;
-begin
- inherited GlyphChanged;
-
- if FButtonGlyph.Empty then
-{$IFNDEF LCL}
- FButtonGlyph.Handle := LoadBaseBitmap('ORBTNCAL');
-{$ELSE}
- FButtonGlyph.LoadFromLazarusResource('ORBTNCAL');
-{$ENDIF}
-end;
-
-procedure TOvcCustomDateEdit.KeyDown(var Key : Word; Shift : TShiftState);
-begin
- inherited KeyDown(Key, Shift);
-
- if ShowButton and (Key = VK_DOWN) and (ssAlt in Shift) then
- PopupOpen;
-end;
-
-procedure TOvcCustomDateEdit.KeyPress(var Key : Char);
-var
- D : Word;
- M : Word;
- Y : Word;
-begin
- inherited KeyPress(Key);
-
- if (ReadOnly) then Exit;
-
- if FAllowIncDec and (Key in ['+', '-']) then begin
- {accept current date}
- DoExit;
- if FDate = 0 then
- DecodeDate(SysUtils.Date, Y, M, D)
- else
- DecodeDate(FDate, Y, M, D);
- if Key = '+' then begin
- Inc(D);
- if D > DaysInMonth(M, Y, Epoch) then begin
- D := 1;
- Inc(M);
- if M > 12 then begin
- Inc(Y);
- M := 1;
- end;
- end;
- end else begin
- {Key = '-'}
- Dec(D);
- if D < 1 then begin
- Dec(M);
- if M < 1 then begin
- M := 12;
- Dec(Y);
- end;
- D := DaysInMonth(M, Y, Epoch);
- end;
- end;
- SetDate(STDateToDateTime(DMYToSTDate(D, M, Y, Epoch)));
-
- {clear}
- Key := #0;
- end;
-end;
-
-function TOvcCustomDateEdit.ParseDate(const Value : string) : string;
-var
- S : string;
- ThisYear : Word;
- ThisMonth : Word;
- ThisDay : Word;
- DefaultDate : TStDate;
- Increment : Integer;
- Occurrence : Integer;
- StartDate : TStDate;
-
- procedure DoSetDate;
- var
- I : integer;
- D : TStDate;
- DOW : TStDayType;
- begin
- D := StartDate;
- DOW := DayofWeek(DateTimeToStDate(SysUtils.Date));
- if Pos(AnsiUppercase(Copy(LongDayNames[1],1,3)), S) > 0 then begin
- DOW := Sunday;
- end else if Pos(AnsiUppercase(Copy(LongDayNames[2],1,3)), S) > 0 then begin
- DOW := Monday;
- end else if Pos(AnsiUppercase(Copy(LongDayNames[3],1,3)), S) > 0 then begin
- DOW := Tuesday;
- end else if Pos(AnsiUppercase(Copy(LongDayNames[4],1,3)), S) > 0 then begin
- DOW := Wednesday;
- end else if Pos(AnsiUppercase(Copy(LongDayNames[5],1,3)), S) > 0 then begin
- DOW := Thursday;
- end else if Pos(AnsiUppercase(Copy(LongDayNames[6],1,3)), S) > 0 then begin
- DOW := Friday;
- end else if Pos(AnsiUppercase(Copy(LongDayNames[7],1,3)), S) > 0 then begin
- DOW := Saturday;
- end else begin
- if DefaultDate > 0 then begin
- D := DefaultDate;
- Occurrence := 0;
- end else if DefaultDate < 0 then begin
- Result := S;
- exit;
- end;
- end;
- I := 0;
- while I < Occurrence do begin
- D := D + Increment;
- if DayOfWeek(D) = DOW then begin
- inc(I);
- end;
- end;
- Result := FormatDate(StDateToDateTime(D));
- end;
-
-begin
- {The following code provides the user the ability to enter dates
- using text descriptions. All descriptions assume the current
- date as a reference date. The following descriptions are currently
- supported:
- Next is assumed; may be abbreviated -- 1st 3 chars
- Next
- Last current day of week is assumed
- Last
- First | 1st current day of week is assumed
- First | 1st
- Second | 2nd current day of week is assumed
- Second | 2nd
- Third | 3rd current day of week is assumed
- Third | 3rd
- Fourth | 4th current day of week is assumed
- Fourth | 4th
- Final | lst current day of week is assumed
- Final | lst
- BOM | Begin returns first day of current month
- EOM | End returns last day of current month
- Yesterday returns yesterday's date
- Today returns today's date
- Tomorrow returns tomorrow's date}
-
- S := AnsiUppercase(Value);
- if Pos(GetOrphStr(SCCalYesterday), S) > 0 then begin
- Result := FormatDate(StDateToDateTime(DateTimeToStDate(SysUtils.Date) - 1));
- end else if Pos(GetOrphStr(SCCalToday), S) > 0 then begin
- Result := FormatDate(StDateToDateTime(DateTimeToStDate(SysUtils.Date)));
- end else if Pos(GetOrphStr(SCCalTomorrow), S) > 0 then begin
- Result := FormatDate(StDateToDateTime(DateTimeToStDate(SysUtils.Date) + 1));
- end else if Pos(GetOrphStr(SCCalNext), S) > 0 then begin
- Increment := 1;
- Occurrence := 1;
- StartDate := DateTimeToStDate(SysUtils.Date);
- DefaultDate := StartDate + 7;
- DoSetDate;
- end else if Pos(GetOrphStr(SCCalLast), S) > 0 then begin
- Increment := -1;
- Occurrence := 1;
- StartDate := DateTimeToStDate(SysUtils.Date);
- DefaultDate := StartDate - 7;
- DoSetDate;
- end else if Pos(GetOrphStr(SCCalPrev), S) > 0 then begin
- Increment := -1;
- Occurrence := 1;
- StartDate := DateTimeToStDate(SysUtils.Date);
- DefaultDate := StartDate - 7;
- DoSetDate;
- end else if (Pos(GetOrphStr(SCCalFirst), S) > 0)
- or (Pos(GetOrphStr(SCCal1st), S) > 0) then begin
- Increment := 1;
- Occurrence := 1;
- DecodeDate(SysUtils.Date, ThisYear, ThisMonth, ThisDay);
- StartDate := DMYToStDate(1, ThisMonth, ThisYear, Epoch) - 1;
- DefaultDate := 0;
- DoSetDate;
- end else if (Pos(GetOrphStr(SCCalSecond), S) > 0)
- or (Pos(GetOrphStr(SCCal2nd), S) > 0) then begin
- Increment := 1;
- Occurrence := 2;
- DecodeDate(SysUtils.Date, ThisYear, ThisMonth, ThisDay);
- StartDate := DMYToStDate(1, ThisMonth, ThisYear, Epoch) - 1;
- DefaultDate := 0;
- DoSetDate;
- end else if (Pos(GetOrphStr(SCCalThird), S) > 0)
- or (Pos(GetOrphStr(SCCal3rd), S) > 0) then begin
- Increment := 1;
- Occurrence := 3;
- DecodeDate(SysUtils.Date, ThisYear, ThisMonth, ThisDay);
- StartDate := DMYToStDate(1, ThisMonth, ThisYear, Epoch) - 1;
- DefaultDate := 0;
- DoSetDate;
- end else if (Pos(GetOrphStr(SCCalFourth), S) > 0)
- or (Pos(GetOrphStr(SCCal4th), S) > 0) then begin
- Increment := 1;
- Occurrence := 4;
- DecodeDate(SysUtils.Date, ThisYear, ThisMonth, ThisDay);
- StartDate := DMYToStDate(1, ThisMonth, ThisYear, Epoch) - 1;
- DefaultDate := 0;
- DoSetDate;
- end else if Pos(GetOrphStr(SCCalFinal), S) > 0 then begin
- Increment := -1;
- Occurrence := 1;
- DecodeDate(SysUtils.Date, ThisYear, ThisMonth, ThisDay);
- StartDate := DMYToStDate(DaysInMonth(ThisMonth,
- ThisYear, Epoch),
- ThisMonth, ThisYear, Epoch) + 1;
- DefaultDate := 0;
- DoSetDate;
- end else if (Pos(GetOrphStr(SCCalBOM), S) > 0)
- or (Pos(GetOrphStr(SCCalBegin), S) > 0) then begin
- Increment := 0;
- Occurrence := 0;
- DecodeDate(SysUtils.Date, ThisYear, ThisMonth, ThisDay);
- StartDate := DMYToStDate(1, ThisMonth, ThisYear, Epoch);
- DefaultDate := StartDate;
- DoSetDate;
- end else if (Pos(GetOrphStr(SCCalEOM), S) > 0)
- or (Pos(GetOrphStr(SCCalEnd), S) > 0) then begin
- Increment := 0;
- Occurrence := 0;
- DecodeDate(SysUtils.Date, ThisYear, ThisMonth, ThisDay);
- StartDate := DMYToStDate(DaysInMonth(ThisMonth,
- ThisYear, Epoch),
- ThisMonth, ThisYear, Epoch);
- DefaultDate := StartDate;
- DoSetDate;
- end else begin
- Increment := 1;
- Occurrence := 1;
- StartDate := DateTimeToStDate(SysUtils.Date);
- DefaultDate := -1;
- DoSetDate;
- end;
-end;
-
-procedure TOvcCustomDateEdit.PopupClose(Sender : TObject);
-begin
- if not FCalendar.Visible then
- {already closed, exit}
- Exit;
-
- if PopupClosing then
- Exit;
-
- {avoid recursion}
- PopupClosing := True;
-
- try
- inherited PopupClose(Sender);
-
- if GetCapture = FCalendar.Handle then
- ReleaseCapture;
-
- SetFocus;
- {hide the Calendar}
- FCalendar.Hide;
- if FCalendar.Parent is TForm then
- TForm(FCalendar.Parent).AutoScroll := WasAutoScroll;
-
- Cursor := HoldCursor;
-
- {change parentage so that we control the window handle destruction}
- FCalendar.Parent := Self;
- finally
- PopupClosing := False;
- end;
-end;
-
-procedure TOvcCustomDateEdit.PopupKeyDown(Sender : TObject; var Key : Word; Shift : TShiftState);
-var
- X : Integer;
-begin
- case Key of
- VK_TAB :
- begin
- if Shift = [ssShift] then begin
- PopupClose(Sender);
- PostMessage(Handle, WM_KeyDown, VK_TAB, Integer(ssShift));
- end else if Shift = [] then begin
- PopupClose(Sender);
- PostMessage(Handle, WM_KeyDown, VK_TAB, 0);
- end;
- end;
- VK_UP :
- begin
- if Shift = [ssAlt] then begin
- PopupClose(Sender);
- X := SelStart;
- SetFocus;
- SelStart := X;
- SelLength := 0;
- end;
- end;
- end;
-end;
-
-procedure TOvcCustomDateEdit.PopupKeyPress(Sender : TObject; var Key : Char);
-var
- X : Integer;
-begin
- case Key of
- #13,
- #32,
- #27 :
- begin
- PopupClose(Sender);
- X := SelStart;
- SetFocus;
- SelStart := X;
- SelLength := 0;
- end;
- end;
-end;
-
-procedure TOvcCustomDateEdit.PopupMouseDown(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
-var
- P : TPoint;
- I : Integer;
-begin
- P := Point(X,Y);
- if not PtInRect(FCalendar.ClientRect, P) then
- PopUpClose(Sender);
-
- {convert to our coordinate system}
- P := ScreenToClient(FCalendar.ClientToScreen(P));
-
- if PtInRect(ClientRect, P) then begin
- I := SelStart;
- SetFocus;
- SelStart := I;
- SelLength := 0;
- end;
-end;
-
-procedure TOvcCustomDateEdit.PopupOpen;
-var
- P : TPoint;
- R : TRect;
- {$IFDEF VERSION4}
- {$IFNDEF LCL}
- F : TCustomForm;
- MonInfo : TMonitorInfo;
- {$ENDIF}
- {$ENDIF}
-begin
- if FCalendar.Visible then
- {already popped up, exit}
- Exit;
-
- inherited PopupOpen;
-
- {force update of date}
- DoExit;
-
- FCalendar.Parent := GetParentForm(Self);
- if FCalendar.Parent is TForm then begin
- WasAutoScroll := TForm(FCalendar.Parent).AutoScroll;
- TForm(FCalendar.Parent).AutoScroll := False;
- end;
-
- {set 3d to be the same as our own}
-{$IFNDEF LCL}
- FCalendar.ParentCtl3D := False;
-{$ENDIF}
- FCalendar.Ctl3D := False;
-
- {determine the proper position}
- SystemParametersInfo(SPI_GETWORKAREA, 0, @R, 0);
- {$IFDEF VERSION4}
- {$IFNDEF LCL}
- F := GetParentForm(Self);
- if Assigned(F) then begin
- FillChar(MonInfo, SizeOf(MonInfo), #0);
- MonInfo.cbSize := SizeOf(MonInfo);
- GetMonitorInfo(F.Monitor.Handle, @MonInfo);
- R := MonInfo.rcWork;
- end;
- {$ENDIF}
- {$ENDIF}
- if FPopupAnchor = paLeft then
- P := ClientToScreen(Point(-3, Height-4))
- else {paRight}
- P := ClientToScreen(Point(Width-FCalendar.Width-1, Height-2));
- if not Ctl3D then begin
- Inc(P.X, 3);
- Inc(P.Y, 3);
- end;
- if P.Y + FCalendar.Height >= R.Bottom then
- P.Y := P.Y - FCalendar.Height - Height;
- if P.X + FCalendar.Width >= R.Right then
- P.X := R.Right - FCalendar.Width - 1;
- if P.X <= R.Left then
- P.X := R.Left + 1;
-
- MoveWindow(FCalendar.Handle, P.X, P.Y, FCalendar.Width, FCalendar.Height, False);
-
- if Text = '' then
- FCalendar.Date := SysUtils.Date
- else
- FCalendar.Date := FDate;
-
- HoldCursor := Cursor;
- Cursor := crArrow;
- FCalendar.Show;
- FCalendar.SetFocus;
-
- SetCapture(FCalendar.Handle);
-end;
-
-procedure TOvcCustomDateEdit.PopupDateChange(Sender : TObject; Date : TDateTime);
-begin
- {get the current value}
- SetDate(FCalendar.Date);
- Modified := True;
-
- if FCalendar.Browsing then
- Exit;
-
- {hide the Calendar}
- PopupClose(Sender);
- SetFocus;
- SelStart := Length(Text);
- SelLength := 0;
-end;
-
-procedure TOvcCustomDateEdit.SetDate(Value : TDateTime);
-begin
- FDate := Value;
- Modified := True;
-
- if FDate = 0 then
- Text := ''
- else
- Text := FormatDate(FDate);
-
- if Assigned(FOnSetDate) then
- FOnSetDate(Self);
-end;
-
-procedure TOvcCustomDateEdit.SetDateText(Value : string);
-var
- Field : Integer;
- I1 : Integer;
- I2 : Integer;
- Error : Integer;
- ThisYear : Word;
- ThisMonth : Word;
- ThisDay : Word;
- Year : Word;
- Month : Word;
- Day : Word;
- EpochYear : Integer;
- EpochCent : Integer;
- StringList : TStringList;
- FieldOrder : string[3];
- S : string;
-begin
- if Assigned(FOnPreParseDate) then
- FOnPreParseDate(Self, Value);
- Value := ParseDate(Value);
-
- if Assigned(FOnGetDate) then
- FOnGetDate(Self, Value);
-
- if (Value = '') and (FRequiredFields <> []) then begin
- FDate := 0;
- Text := '';
- Exit;
- end;
-
- if AnsiCompareText(Value, TodayString) = 0 then begin
- SetDate(SysUtils.Date);
- Text := FormatDate(FDate);
- end else begin
- DecodeDate(SysUtils.Date, ThisYear, ThisMonth, ThisDay);
- Value := AnsiUpperCase(Value);
- StringList := TStringList.Create;
- try
- {parse the string into subfields using a string list to hold the parts}
- I1 := 1;
- while (I1 <= Length(Value)) and not (Value[I1] in ['0'..'9', 'A'..'Z']) do
- Inc(I1);
- while I1 <= Length(Value) do begin
- I2 := I1;
- while (I2 <= Length(Value)) and (Value[I2] in ['0'..'9', 'A'..'Z']) do
- Inc(I2);
- StringList.Add(Copy(Value, I1, I2-I1));
- while (I2 <= Length(Value)) and not (Value[I2] in ['0'..'9', 'A'..'Z']) do
- Inc(I2);
- I1 := I2;
- end;
-
- case DateOrder of
- doMDY : FieldOrder := 'MDY';
- doDMY : FieldOrder := 'DMY';
- doYMD : FieldOrder := 'YMD';
- end;
-
- Year := 0;
- Month := 0;
- Day := 0;
- Error := 0;
- for Field := 1 to Length(FieldOrder) do begin
- if StringList.Count > 0 then
- S := StringList[0]
- else
- S := '';
-
- case FieldOrder[Field] of
- 'M' :
- begin
- if (S = '') or (S[1] in ['0'..'9']) then begin
- {numeric month}
- try
- if S = '' then
- Month := 0
- else
- Month := StrToInt(S);
- except
- Month := 0;
- {error converting month number}
- Error := SCMonthConvertError;
- end;
- if not (Month in [1..12]) then
- Month := 0;
- end else begin
- {one or more letters in month}
- Month := 0;
- I1 := 1;
- S := Copy(S, 1, 3);
- {error converting month name}
- Error := SCMonthNameConvertError;
- repeat
- if S = AnsiUpperCase(Copy(ShortMonthNames[I1], 1, Length(S))) then begin
- Month := I1;
- I1 := 13;
- Error := 0;
- end else
- Inc(I1);
- until I1 = 13;
- end;
-
- if Month = 0 then begin
- if rfMonth in FRequiredFields then
- {month required}
- Error := SCMonthRequired
- else
- Month := ThisMonth;
- end else if StringList.Count > 0 then
- StringList.Delete(0);
-
- if Error > 0 then
- Break;
- end;
- 'Y' :
- begin
- try
- if S = '' then
- Year := 0
- else
- Year := StrToInt(S);
- except
- Year := 0;
- {error converting year}
- Error := SCYearConvertError;
- end;
- if (Epoch = 0) and (Year < 100) and (S <> '') then
- {default to current century if Epoch is zero}
- Year := Year + (ThisYear div 100 * 100)
- else if (Epoch > 0) and (Year < 100) and (S <> '') then begin
- {use epoch}
- EpochYear := Epoch mod 100;
- EpochCent := (Epoch div 100) * 100;
- if (Year < EpochYear) then
- Inc(Year,EpochCent+100)
- else
- Inc(Year,EpochCent);
- end;
- if Year = 0 then begin
- if rfYear in FRequiredFields then
- {year is required}
- Error := SCYearRequired
- else
- Year := ThisYear;
- end else if StringList.Count > 0 then
- StringList.Delete(0);
- if Error > 0 then
- Break;
- end;
- 'D' :
- begin
- try
- if S = '' then
- Day := 0
- else
- Day := StrToInt(S);
- except
- Day := 0;
- {error converting day}
- Error := SCDayConvertError;
- end;
- if not (Day in [1..31]) then
- Day := 0;
- if Day = 0 then begin
- if rfDay in FRequiredFields then
- {day is required}
- Error := SCDayRequired
- else
- Day := ThisDay;
- end
- else if StringList.Count > 0 then
- StringList.Delete(0);
-
- if Error > 0 then
- Break;
- end;
- end;
- end;
-
- case Error of
- SCDayConvertError :
- if S = '' then
- raise EOvcException.Create(
- GetOrphStr(SCInvalidDay) + ' "' + Value + '"')
- else
- raise EOvcException.Create(
- GetOrphStr(SCInvalidDay) + ' "' + S + '"');
- SCMonthConvertError :
- if S = '' then
- raise EOvcException.Create(
- GetOrphStr(SCInvalidMonth) + ' "' + Value + '"')
- else
- raise EOvcException.Create(
- GetOrphStr(SCInvalidMonth) + ' "' + S + '"');
- SCMonthNameConvertError :
- if S = '' then
- raise EOvcException.Create(
- GetOrphStr(SCInvalidMonthName) + ' "' + Value + '"')
- else
- raise EOvcException.Create(
- GetOrphStr(SCInvalidMonthName) + ' "' + S + '"');
- SCYearConvertError :
- if S = '' then
- raise EOvcException.Create(
- GetOrphStr(SCInvalidYear) + ' "' + Value + '"')
- else
- raise EOvcException.Create(
- GetOrphStr(SCInvalidYear) + ' "' + S + '"');
- SCDayRequired :
- raise EOvcException.Create(
- GetOrphStr(SCDayRequired));
- SCMonthRequired :
- raise EOvcException.Create(
- GetOrphStr(SCMonthRequired));
- SCYearRequired :
- raise EOvcException.Create(
- GetOrphStr(SCYearRequired));
- end;
-
- try
- SetDate(STDatetoDateTime(DMYToStDate(Day, Month, Year, Epoch)));
- Text := FormatDate(FDate);
- except
- raise EOvcException.Create(
- GetOrphStr(SCInvalidDate) + ' "' + Value + '"');
- end;
-
- finally
- StringList.Free;
- end;
- end;
-end;
-
-procedure TOvcCustomDateEdit.SetEpoch(Value : Integer);
-begin
- if Value <> FEpoch then
- if (Value = 0) or ((Value >= MinYear) and (Value <= MaxYear)) then
- FEpoch := Value;
-end;
-
-procedure TOvcCustomDateEdit.SetForceCentury(Value : Boolean);
-begin
- if Value <> FForceCentury then begin
- FForceCentury := Value;
- SetDate(FCalendar.Date);
- end;
-end;
-
-procedure TOvcCustomDateEdit.SetPopupColors(Value : TOvcCalColors);
-begin
- FCalendar.Colors := Value;
-end;
-
-procedure TOvcCustomDateEdit.SetPopupDateFormat(Value : TOvcDateFormat);
-begin
- FCalendar.DateFormat := Value;
-end;
-
-procedure TOvcCustomDateEdit.SetPopupFont(Value : TFont);
-begin
- if Assigned(Value) then
- FCalendar.Font.Assign(Value);
-end;
-
-procedure TOvcCustomDateEdit.SetPopupHeight(Value : Integer);
-begin
- FCalendar.Height := Value;
-end;
-
-procedure TOvcCustomDateEdit.SetPopupDayNameWidth(Value : TOvcDayNameWidth);
-begin
- FCalendar.DayNameWidth := Value;
-end;
-
-procedure TOvcCustomDateEdit.SetPopupOptions(Value : TOvcCalDisplayOptions);
-begin
- FCalendar.Options := Value;
-end;
-
-procedure TOvcCustomDateEdit.SetPopupWidth(Value : Integer);
-begin
- FCalendar.Width := Value;
-end;
-
-procedure TOvcCustomDateEdit.SetPopupWeekStarts(Value : TOvcDayType);
-begin
- FCalendar.WeekStarts := Value;
-end;
-
-procedure TOvcCustomDateEdit.SetReadOnly(Value : Boolean);
-begin
- inherited ReadOnly := Value;
-
- FButton.Enabled := not ReadOnly;
-end;
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovcedclc.pas b/Source/3rdParty/Orpheus/ovcedclc.pas
deleted file mode 100644
index ed75a922..00000000
--- a/Source/3rdParty/Orpheus/ovcedclc.pas
+++ /dev/null
@@ -1,603 +0,0 @@
-{*********************************************************}
-{* OVCEDCLC.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 ovcedclc;
- {-numeric edit field with popup calculator}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Buttons, Classes, Controls, Forms, Graphics, Menus,
- StdCtrls, SysUtils, {$IFDEF VERSION4}{$IFNDEF LCL} MultiMon, {$ENDIF}{$ENDIF}
- OvcBase, OvcCalc, OvcEdPop, OvcMisc;
-
-type
- TOvcCustomNumberEdit = class(TOvcEdPopup)
- {.Z+}
- protected {private}
- FAllowIncDec : Boolean;
- FCalculator : TOvcCalculator;
-
- {internal variables}
- PopupClosing : Boolean;
- HoldCursor : TCursor;
- WasAutoScroll : Boolean;
-
- {property methods}
- function GetAsFloat : Double;
- function GetAsInteger : LongInt;
- function GetAsString : string;
- function GetPopupColors : TOvcCalcColors;
- function GetPopupDecimals : Integer;
- function GetPopupFont : TFont;
- function GetPopupHeight : Integer;
- function GetPopupWidth : Integer;
- function GetReadOnly : Boolean;
- procedure SetAsFloat(Value : Double);
- procedure SetAsInteger(Value : LongInt);
- procedure SetAsString(const Value : string);
- procedure SetPopupColors(Value : TOvcCalcColors);
- procedure SetPopupDecimals(Value : Integer);
- procedure SetPopupFont(Value : TFont);
- procedure SetPopupHeight(Value : Integer);
- procedure SetPopupWidth(Value : Integer);
- procedure SetReadOnly(Value : Boolean);
-
- {internal methods}
- procedure PopupButtonPressed(Sender : TObject; Button : TOvcCalculatorButton);
- procedure PopupKeyDown(Sender : TObject; var Key : Word; Shift : TShiftState);
- procedure PopupKeyPress(Sender : TObject; var Key : Char);
- procedure PopupMouseDown(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
-
- protected
- procedure DoExit;
- override;
- procedure GlyphChanged;
- override;
- procedure KeyDown(var Key : Word; Shift : TShiftState);
- override;
- procedure KeyPress(var Key : Char);
- override;
- {.Z-}
-
- property AllowIncDec : Boolean
- read FAllowIncDec write FAllowIncDec;
- property PopupColors : TOvcCalcColors
- read GetPopupColors write SetPopupColors;
- property PopupDecimals : Integer
- read GetPopupDecimals write SetPopupDecimals;
- property PopupFont : TFont
- read GetPopupFont write SetPopupFont;
- property PopupHeight : Integer
- read GetPopupHeight write SetPopupHeight;
- property PopupWidth : Integer
- read GetPopupWidth write SetPopupWidth;
- property ReadOnly : Boolean
- read GetReadOnly write SetReadOnly;
-
- public
- {.Z+}
- constructor Create(AOwner : TComponent);
- override;
- {.Z-}
-
- procedure PopupClose(Sender : TObject);
- override;
- procedure PopupOpen;
- override;
-
- property AsInteger : LongInt
- read GetAsInteger
- write SetAsInteger;
-
- {public properties}
- property Calculator : TOvcCalculator
- read FCalculator;
- property AsFloat : Double
- read GetAsFloat write SetAsFloat;
- property AsString : string
- read GetAsString write SetAsString;
- end;
-
- TOvcNumberEdit = class(TOvcCustomNumberEdit)
- published
- {properties}
- {$IFDEF VERSION4}
- property Anchors;
- property Constraints;
- property DragKind;
- {$ENDIF}
- property About;
- property AllowIncDec;
-{$IFNDEF LCL}
- property AutoSelect;
-{$ENDIF}
- property AutoSize;
- property BorderStyle;
- property ButtonGlyph;
- property Color;
- property Ctl3D;
- property Cursor;
- property DragCursor;
- property DragMode;
- property Enabled;
- property Font;
-{$IFNDEF LCL}
- property HideSelection;
-{$ENDIF}
- property LabelInfo;
- property ParentColor;
-{$IFNDEF LCL}
- property ParentCtl3D;
-{$ENDIF}
- property ParentFont;
- property ParentShowHint;
- property PopupAnchor;
- property PopupColors;
- property PopupDecimals;
- property PopupFont;
- property PopupHeight;
- property PopupWidth;
- property PopupMenu;
- property ReadOnly;
- property ShowHint;
- property ShowButton;
- property TabOrder;
- property TabStop;
- property Visible;
-
- {events}
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnPopupClose;
- property OnPopupOpen;
- property OnStartDrag;
- end;
-
-
-implementation
-
-
-{*** TOvcCustomNumberEdit ***}
-
-constructor TOvcCustomNumberEdit.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- ControlStyle := ControlStyle - [csSetCaption];
-
- FAllowIncDec := False;
-
- {load button glyph}
-{$IFNDEF LCL}
- FButtonGlyph.Handle := LoadBaseBitmap('ORBTNCLC');
-{$ELSE}
- FButtonGlyph.LoadFromLazarusResource('ORBTNCLC');
-{$ENDIF}
- FButton.Glyph.Assign(FButtonGlyph);
-
- FCalculator := TOvcCalculator.CreateEx(Self, True);
- FCalculator.OnButtonPressed := PopupButtonPressed;
- FCalculator.OnExit := PopupClose;
- FCalculator.OnKeyDown := PopupKeyDown;
- FCalculator.OnKeyPress := PopupKeyPress;
- FCalculator.OnMouseDown := PopupMouseDown;
- FCalculator.Visible := False; {to avoid flash at 0,0}
- FCalculator.Options := [coShowItemCount];
- FCalculator.BorderStyle := bsSingle;
- FCalculator.ParentFont := False;
-end;
-
-procedure TOvcCustomNumberEdit.DoExit;
-begin
- if not PopupActive then
- inherited DoExit;
-end;
-
-function TOvcCustomNumberEdit.GetAsFloat : Double;
-var
- I : Integer;
- S : string;
-begin
- S := Text;
- for I := Length(S) downto 1 do
- if not (S[I] in ['0'..'9', '+', '-', DecimalSeparator]) then
- Delete(S, I, 1);
- Result := StrToFloat(S);
-end;
-
-function TOvcCustomNumberEdit.GetAsInteger : LongInt;
-begin
- Result := Round(GetAsFloat);
-end;
-
-function TOvcCustomNumberEdit.GetAsString : string;
-begin
- Result := Text;
-end;
-
-function TOvcCustomNumberEdit.GetPopupColors : TOvcCalcColors;
-begin
- Result := FCalculator.Colors;
-end;
-
-function TOvcCustomNumberEdit.GetPopupDecimals : Integer;
-begin
- Result := FCalculator.Decimals;
-end;
-
-function TOvcCustomNumberEdit.GetPopupFont : TFont;
-begin
- Result := FCalculator.Font;
-end;
-
-function TOvcCustomNumberEdit.GetPopupHeight : Integer;
-begin
- Result := FCalculator.Height;
-end;
-
-function TOvcCustomNumberEdit.GetPopupWidth : Integer;
-begin
- Result := FCalculator.Width;
-end;
-
-function TOvcCustomNumberEdit.GetReadOnly : Boolean;
-begin
- Result := inherited ReadOnly;
-end;
-
-procedure TOvcCustomNumberEdit.GlyphChanged;
-begin
- inherited GlyphChanged;
-
- if FButtonGlyph.Empty then
-{$IFNDEF LCL}
- FButtonGlyph.Handle := LoadBaseBitmap('ORBTNCLC');
-{$ELSE}
- FButtonGlyph.LoadFromLazarusResource('ORBTNCLC');
-{$ENDIF}
-end;
-
-procedure TOvcCustomNumberEdit.KeyDown(var Key : Word; Shift : TShiftState);
-begin
- inherited KeyDown(Key, Shift);
-
- if (Key = VK_DOWN) and (ssAlt in Shift) then
- PopupOpen;
-end;
-
-procedure TOvcCustomNumberEdit.KeyPress(var Key : Char);
-var
- D : Double;
- X : Integer;
- L : Integer;
-begin
- inherited KeyPress(Key);
-
- if not ((Key = #22) or (Key = #3) or (Key = #24)) then begin
- if not (Key in [#27, '0'..'9', '.', DecimalSeparator,
- #8, '+', '-', '*', '/']) then begin
- Key := #0;
-{$IFNDEF LCL}
- MessageBeep(0);
-{$ENDIF}
- Exit;
- end;
-
- {Disallow more than one DecimalSeparator in the number}
- if (SelLength <> Length(Text))
- and (Key = DecimalSeparator) and (Pos(DecimalSeparator, Text) > 0)
- then begin
- Key := #0;
-{$IFNDEF LCL}
- MessageBeep(0);
-{$ENDIF}
- Exit;
- end;
-
- if FAllowIncDec and (Key in ['+', '-']) then begin
- if Text = '' then
- Text := '0';
- D := StrToFloat(Text);
- X := SelStart;
- L := SelLength;
-
- if Key = '+' then
- Text := FloatToStr(D+1)
- else {'-'}
- Text := FloatToStr(D-1);
-
- SelStart := X;
- SelLength := L;
-
- Key := #0; {clear key}
- end;
-
- if (Key in ['+', '*', '/']) then begin
- PopUpOpen;
- FCalculator.KeyPress(Key);
- Key := #0; {clear key}
- end;
- end;
-end;
-
-procedure TOvcCustomNumberEdit.PopupButtonPressed(Sender : TObject;
- Button : TOvcCalculatorButton);
-begin
- case Button of
- cbEqual :
- begin
- {get the current value}
- Text := FloatToStr(FCalculator.DisplayValue);
- Modified := True;
-
- {hide the calculator}
- PopupClose(Sender);
- SetFocus;
- SelStart := Length(Text);
- SelLength := 0;
- end;
- end;
-end;
-
-procedure TOvcCustomNumberEdit.PopupClose(Sender : TObject);
-begin
- if not FCalculator.Visible then
- Exit; {already closed, exit}
-
- if PopupClosing then
- Exit;
-
- PopupClosing := True; {avoid recursion}
- try
- inherited PopupClose(Sender);
-
- if GetCapture = FCalculator.Handle then
- ReleaseCapture;
-
- SetFocus;
- FCalculator.Hide; {hide the calculator}
- TForm(FCalculator.Parent).AutoScroll := WasAutoScroll;
- Cursor := HoldCursor;
-
- {change parentage so that we control the window handle destruction}
- FCalculator.Parent := Self;
- finally
- PopupClosing := False;
- end;
-end;
-
-procedure TOvcCustomNumberEdit.PopupKeyDown(Sender : TObject; var Key : Word; Shift : TShiftState);
-var
- X : Integer;
-begin
- case Key of
-
- VK_TAB :
- begin
- if Shift = [ssShift] then begin
- PopupClose(Sender);
- PostMessage(Handle, WM_KeyDown, VK_TAB, Integer(ssShift));
- end else if Shift = [] then begin
- PopupClose(Sender);
- PostMessage(Handle, WM_KeyDown, VK_TAB, 0);
- end;
- end;
-
-
- VK_UP : if Shift = [ssAlt] then begin
- PopupClose(Sender);
- X := SelStart;
- SetFocus;
- SelStart := X;
- SelLength := 0;
- end;
- end;
-end;
-
-procedure TOvcCustomNumberEdit.PopupKeyPress(Sender : TObject; var Key : Char);
-var
- X : Integer;
-begin
- case Key of
- #27 :
- begin
- PopupClose(Sender);
- X := SelStart;
- SetFocus;
- SelStart := X;
- SelLength := 0;
- end;
- end;
-end;
-
-procedure TOvcCustomNumberEdit.PopupMouseDown(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
-var
- P : TPoint;
- I : Integer;
-begin
- P := Point(X,Y);
- if not PtInRect(FCalculator.ClientRect, P) then
- PopUpClose(Sender);
-
- {convert to our coordinate system}
- P := ScreenToClient(FCalculator.ClientToScreen(P));
-
- if PtInRect(ClientRect, P) then begin
- I := SelStart;
- SetFocus;
- SelStart := I;
- SelLength := 0;
- end;
-end;
-
-procedure TOvcCustomNumberEdit.PopupOpen;
-var
- P : TPoint;
- R : TRect;
- {$IFDEF VERSION4}
- {$IFNDEF LCL}
- F : TCustomForm;
- MonInfo : TMonitorInfo;
- {$ENDIF}
- {$ENDIF}
-begin
- if FCalculator.Visible then
- Exit; {already popped up, exit}
-
- inherited PopupOpen;
-
- FCalculator.Parent := GetImmediateParentForm(Self);
- if FCalculator.Parent is TForm then begin
- WasAutoScroll := TForm(FCalculator.Parent).AutoScroll;
- TForm(FCalculator.Parent).AutoScroll := False;
- end;
-
- {set 3d to be the same as our own}
-{$IFNDEF LCL}
- FCalculator.ParentCtl3D := False;
-{$ENDIF}
- FCalculator.Ctl3D := False;
-
- {determine the proper position}
- SystemParametersInfo(SPI_GETWORKAREA, 0, @R, 0);
- {$IFDEF VERSION4}
- {$IFNDEF LCL}
- F := GetParentForm(Self);
- if Assigned(F) then begin
- FillChar(MonInfo, SizeOf(MonInfo), #0);
- MonInfo.cbSize := SizeOf(MonInfo);
- GetMonitorInfo(F.Monitor.Handle, @MonInfo);
- R := MonInfo.rcWork;
- end;
- {$ENDIF}
- {$ENDIF}
- if FPopupAnchor = paLeft then
- P := ClientToScreen(Point(-3, Height-4))
- else {paRight}
- P := ClientToScreen(Point(Width-FCalculator.Width-1, Height-2));
- if not Ctl3D then begin
- Inc(P.X, 3);
- Inc(P.Y, 3);
- end;
- if P.Y + FCalculator.Height >= R.Bottom then
- P.Y := P.Y - FCalculator.Height - Height;
- if P.X + FCalculator.Width >= R.Right then
- P.X := R.Right - FCalculator.Width - 1;
- if P.X <= R.Left then
- P.X := R.Left + 1;
-
-{$IFNDEF LCL}
- MoveWindow(FCalculator.Handle, P.X, P.Y, FCalculator.Width, FCalculator.Height, False);
- {$ENDIF}
-
- HoldCursor := Cursor;
- Cursor := crArrow;
- FCalculator.PressButton(cbClear);
- FCalculator.Show;
- FCalculator.Visible := True;
- if Text <> '' then
- FCalculator.PushOperand(AsFloat)
- else
- FCalculator.PushOperand(0);
- FCalculator.SetFocus;
-
- SetCapture(FCalculator.Handle);
-end;
-
-procedure TOvcCustomNumberEdit.SetAsFloat(Value : Double);
-begin
- Text := FloatToStr(Value);
-end;
-
-procedure TOvcCustomNumberEdit.SetAsInteger(Value : LongInt);
-begin
- Text := IntToStr(Value);
-end;
-
-procedure TOvcCustomNumberEdit.SetAsString(const Value : string);
-begin
- Text := Value;
-end;
-
-procedure TOvcCustomNumberEdit.SetPopupColors(Value : TOvcCalcColors);
-begin
- FCalculator.Colors := Value;
-end;
-
-procedure TOvcCustomNumberEdit.SetPopupDecimals(Value : Integer);
-begin
- FCalculator.Decimals := Value;
-end;
-
-procedure TOvcCustomNumberEdit.SetPopupFont(Value : TFont);
-begin
- if Assigned(Value) then
- FCalculator.Font.Assign(Value);
-end;
-
-procedure TOvcCustomNumberEdit.SetPopupHeight(Value : Integer);
-begin
- FCalculator.Height := Value;
-end;
-
-procedure TOvcCustomNumberEdit.SetPopupWidth(Value : Integer);
-begin
- FCalculator.Width := Value;
-end;
-
-procedure TOvcCustomNumberEdit.SetReadOnly(Value : Boolean);
-begin
- inherited ReadOnly := Value;
-
- FButton.Enabled := not ReadOnly;
-end;
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovceditf.pas b/Source/3rdParty/Orpheus/ovceditf.pas
deleted file mode 100644
index d784ad4c..00000000
--- a/Source/3rdParty/Orpheus/ovceditf.pas
+++ /dev/null
@@ -1,426 +0,0 @@
-{*********************************************************}
-{* OVCEDITF.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}
-{$J+} {Writable constants}
-
-unit ovceditf;
- {-old style base edit field class w/ attached label}
- {to be deprecated in a future release}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, MyMisc, {$ENDIF}
- Buttons, Classes, Controls, ExtCtrls, Forms, Graphics, Menus,
- StdCtrls, SysUtils, OvcBase, OvcConst, OvcData, OvcExcpt, OvcVer, OvcMisc;
-
-type
- TOvcCustomEdit = class(TCustomEdit)
- protected {private}
- {property variables}
- FController : TOvcController;
- FLabelInfo : TOvcLabelInfo;
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
- {property methods}
- function GetAbout : string;
- function GetAttachedLabel : TOvcAttachedLabel;
- procedure SetAbout(const Value : string);
- procedure SetController(Value : TOvcController);
- {internal methods}
- procedure LabelChange(Sender : TObject);
- procedure LabelAttach(Sender : TObject; Value : Boolean);
- procedure PositionLabel;
- {VCL message methods}
- procedure CMVisibleChanged(var Msg : TMessage); message CM_VISIBLECHANGED;
- procedure OrAssignLabel(var Msg : TMessage); message OM_ASSIGNLABEL;
- procedure OrPositionLabel(var Msg : TMessage); message OM_POSITIONLABEL;
- procedure OrRecordLabelPosition(var Msg : TMessage);
- message OM_RECORDLABELPOSITION;
- protected
- {descendants can set the value of this variable after calling inherited }
- {create to set the default location and point-of-reference (POR) for the}
- {attached label. if dlpTopLeft, the default location and POR will be at }
- {the top left of the control. if dlpBottomLeft, the default location and}
- {POR will be at the bottom left}
- DefaultLabelPosition : TOvcLabelPosition;
- procedure CreateWnd; override;
- procedure Notification(AComponent : TComponent; Operation: TOperation);
- override;
- function ControllerAssigned : Boolean;
- property About : string read GetAbout write SetAbout stored False;
- property LabelInfo : TOvcLabelInfo read FLabelInfo write FLabelInfo;
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D;
-{$ENDIF}
- public
- constructor Create(AOwner : TComponent); override;
- destructor Destroy; override;
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
- property AttachedLabel : TOvcAttachedLabel read GetAttachedLabel;
- property Controller : TOvcController read FController write SetController;
- end;
-
- TOvcEdit = class(TOvcCustomEdit)
- published
- {properties}
- {$IFDEF VERSION4}
- property Anchors;
-{$IFNDEF LCL}
- property BiDiMode;
- property ParentBiDiMode;
-{$ENDIF}
- property Constraints;
- property DragKind;
- {$ENDIF}
- property About;
-{$IFNDEF LCL}
- property AutoSelect;
-{$ENDIF}
- property AutoSize;
- property BorderStyle;
- property CharCase;
- property Color;
- property Controller;
- property Ctl3D;
- property Cursor;
- property DragCursor;
- property DragMode;
- property Enabled;
- property Font;
-{$IFNDEF LCL}
- property HideSelection;
- property ImeMode;
- property ImeName;
-{$ENDIF}
- property LabelInfo;
- property MaxLength;
-{$IFNDEF LCL}
- property OEMConvert;
-{$ENDIF}
- property ParentColor;
-{$IFNDEF LCL}
- property ParentCtl3D;
-{$ENDIF}
- property ParentFont;
- property ParentShowHint;
- property PasswordChar;
- property PopupMenu;
- property ReadOnly;
- property ShowHint;
- property TabOrder;
- property TabStop;
- property Text;
- property Visible;
- {events}
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- {$IFDEF VERSION4}
- property OnEndDock;
- property OnStartDock;
- {$ENDIF}
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDrag;
- end;
-
-implementation
-
-{===== TOvcCustomEdit ================================================}
-
-procedure TOvcCustomEdit.CMVisibleChanged(var Msg : TMessage);
-begin
- inherited;
-
- if csLoading in ComponentState then
- Exit;
-
- if LabelInfo.Visible then
- AttachedLabel.Visible := Visible;
-end;
-{=====}
-
-function TOvcCustomEdit.ControllerAssigned : Boolean;
-begin
- Result := Assigned(FController);
-end;
-{=====}
-
-constructor TOvcCustomEdit.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- ControlStyle := ControlStyle - [csSetCaption];
-
- {set default position and reference point}
- DefaultLabelPosition := lpTopLeft;
-
- FLabelInfo := TOvcLabelInfo.Create;
- FLabelInfo.OnChange := LabelChange;
- FLabelInfo.OnAttach := LabelAttach;
-end;
-{=====}
-
-procedure TOvcCustomEdit.CreateWnd;
-var
- OurForm : TWinControl;
-begin
- OurForm := GetImmediateParentForm(Self);
-
- {do this only when the component is first dropped on the form, not during loading}
- if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
- ResolveController(OurForm, FController);
-
- if not Assigned(FController) and not (csLoading in ComponentState) then begin
- {try to find a controller on this form that we can use}
- FController := FindController(OurForm);
-
- {if not found and we are not designing, use default controller}
- if not Assigned(FController) and not (csDesigning in ComponentState) then
- FController := DefaultController;
- end;
-
- inherited CreateWnd;
-end;
-{=====}
-
-destructor TOvcCustomEdit.Destroy;
-begin
- {detatch and destroy label, if any}
- FLabelInfo.Visible := False;
-
- {destroy label info}
- FLabelInfo.Free;
- FLabelInfo := nil;
-
- inherited Destroy;
-end;
-{=====}
-
-function TOvcCustomEdit.GetAttachedLabel : TOvcAttachedLabel;
-begin
- if not FLabelInfo.Visible then
- raise Exception.Create(GetOrphStr(SCLabelNotAttached));
-
- Result := FLabelInfo.ALabel;
-end;
-{=====}
-
-function TOvcCustomEdit.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-{=====}
-
-procedure TOvcCustomEdit.LabelAttach(Sender : TObject; Value : Boolean);
-var
-{$IFDEF VERSION5}
- PF : TWinControl;
-{$ELSE}
- PF : TForm;
-{$ENDIF}
- S :string;
-begin
- if csLoading in ComponentState then
- Exit;
-
-{$IFDEF VERSION5}
- PF := GetImmediateParentForm(Self);
-{$ELSE}
- PF := TForm(GetParentForm(Self));
-{$ENDIF}
- if Value then begin
- if Assigned(PF) then begin
- FLabelInfo.ALabel.Free;
- FLabelInfo.ALabel := TOvcAttachedLabel.CreateEx(PF, Self);
- FLabelInfo.ALabel.Parent := Parent;
-
- S := GenerateComponentName(PF, Name + 'Label');
- FLabelInfo.ALabel.Name := S;
- FLabelInfo.ALabel.Caption := S;
-
- FLabelInfo.SetOffsets(0, 0);
- PositionLabel;
- FLabelInfo.ALabel.BringToFront;
- {turn off auto size}
- TLabel(FLabelInfo.ALabel).AutoSize := False;
- end;
- end else begin
- if Assigned(PF) then begin
- FLabelInfo.ALabel.Free;
- FLabelInfo.ALabel := nil;
- end;
- end;
-end;
-{=====}
-
-procedure TOvcCustomEdit.LabelChange(Sender : TObject);
-begin
- if not (csLoading in ComponentState) then
- PositionLabel;
-end;
-{=====}
-
-procedure TOvcCustomEdit.Notification(AComponent : TComponent; Operation: TOperation);
-var
-{$IFDEF VERSION5}
- PF : TWinControl;
-{$ELSE}
- PF : TForm;
-{$ENDIF}
-begin
- inherited Notification(AComponent, Operation);
-
- if Operation = opRemove then
- if Assigned(FLabelInfo) and (AComponent = FLabelInfo.ALabel) then begin
- {$IFDEF VERSION5}
- PF := GetImmediateParentForm(Self);
- {$ELSE}
- PF := TForm(GetParentForm(Self));
- {$ENDIF}
- if Assigned(PF) and not (csDestroying in PF.ComponentState) then begin
- FLabelInfo.FVisible := False;
- FLabelInfo.ALabel := nil;
- end
- end;
-
- if (AComponent = FController) and (Operation = opRemove) then
- FController := nil
- else if (Operation = opInsert) and (FController = nil) then begin
- if (AComponent is TOvcController) then
- FController := TOvcController(AComponent);
- end;
-end;
-{=====}
-
-procedure TOvcCustomEdit.OrAssignLabel(var Msg : TMessage);
-begin
- FLabelInfo.ALabel := TOvcAttachedLabel(Msg.lParam);
-end;
-{=====}
-
-procedure TOvcCustomEdit.OrPositionLabel(var Msg : TMessage);
-const
- DX : Integer = 0;
- DY : Integer = 0;
-begin
- if FLabelInfo.Visible and Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) and
- not (csLoading in ComponentState) then begin
- if DefaultLabelPosition = lpTopLeft then begin
- DX := FLabelInfo.ALabel.Left - Left;
- DY := FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top;
- end else begin
- DX := FLabelInfo.ALabel.Left - Left;
- DY := FLabelInfo.ALabel.Top - Top - Height;
- end;
- if (DX <> FLabelInfo.OffsetX) or (DY <> FLabelInfo.OffsetY) then
- PositionLabel;
- end;
-end;
-{=====}
-
-procedure TOvcCustomEdit.OrRecordLabelPosition(var Msg : TMessage);
-begin
- if Assigned(FLabelInfo.ALabel) and (FLabelInfo.ALabel.Parent <> nil) then begin
- {if the label was cut and then pasted, this will complete the reattachment}
- FLabelInfo.FVisible := True;
-
- if DefaultLabelPosition = lpTopLeft then
- FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
- FLabelInfo.ALabel.Top + FLabelInfo.ALabel.Height - Top)
- else
- FLabelInfo.SetOffsets(FLabelInfo.ALabel.Left - Left,
- FLabelInfo.ALabel.Top - Top - Height);
- end;
-end;
-{=====}
-
-procedure TOvcCustomEdit.PositionLabel;
-begin
- if FLabelInfo.Visible and Assigned(FLabelInfo.ALabel) and
- (FLabelInfo.ALabel.Parent <> nil) and
- not (csLoading in ComponentState) then begin
-
- if DefaultLabelPosition = lpTopLeft then begin
- FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
- FLabelInfo.OffsetY - FLabelInfo.ALabel.Height + Top,
- FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
- end else begin
- FLabelInfo.ALabel.SetBounds(Left + FLabelInfo.OffsetX,
- FLabelInfo.OffsetY + Top + Height,
- FLabelInfo.ALabel.Width, FLabelInfo.ALabel.Height);
- end;
- end;
-end;
-{=====}
-
-procedure TOvcCustomEdit.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
-begin
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-
- if not HandleAllocated then
- Exit;
-
- if HandleAllocated then
- PostMessage(Handle, OM_POSITIONLABEL, 0, 0);
-end;
-{=====}
-
-procedure TOvcCustomEdit.SetController(Value : TOvcController);
-begin
- FController := Value;
- if Value <> nil then
- Value.FreeNotification(Self);
-end;
-{=====}
-
-procedure TOvcCustomEdit.SetAbout(const Value : string);
-begin
-end;
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovcedpop.pas b/Source/3rdParty/Orpheus/ovcedpop.pas
deleted file mode 100644
index 4331db2a..00000000
--- a/Source/3rdParty/Orpheus/ovcedpop.pas
+++ /dev/null
@@ -1,341 +0,0 @@
-{*********************************************************}
-{* OVCEDPOP.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}
-{$J+} {Writable constants}
-
-unit ovcedpop;
- {-base popup edit field class}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Buttons, Classes, Controls, ExtCtrls, Forms, Graphics, Menus,
- StdCtrls, SysUtils, OvcEditF;
-
-const
- MsgClose = WM_USER+100;
- MsgOpen = WM_USER+101;
-
-type
- TOvcEdButton = class(TBitBtn)
- public
- procedure Click;
- override;
- end;
-
- TOvcPopupEvent =
- procedure(Sender : TObject) of object;
-
- TOvcPopupAnchor = (paLeft, paRight);
-
- TOvcEdPopup = class(TOvcCustomEdit)
- protected {private}
- {property variables}
- FButton : TOvcEdButton;
- FButtonGlyph : TBitmap;
- FPopupActive : Boolean;
- FPopupAnchor : TOvcPopupAnchor;
- FOnPopupClose : TOvcPopupEvent;
- FOnPopupOpen : TOvcPopupEvent;
- FShowButton : Boolean;
-
- {property methods}
- function GetButtonGlyph : TBitmap;
- procedure SetButtonGlyph(Value : TBitmap);
- procedure SetShowButton(Value : Boolean);
-
- {internal methods}
- function GetButtonWidth : Integer;
-
-{$IFDEF VERSION4}
- procedure CMDialogKey(var Msg : TCMDialogKey);
- message CM_DIALOGKEY;
-{$ENDIF}
-
- protected
- procedure CreateParams(var Params : TCreateParams);
- override;
- procedure CreateWnd;
- override;
- function GetButtonEnabled : Boolean;
- dynamic;
- procedure GlyphChanged;
- dynamic;
- procedure Loaded;
- override;
-
- procedure OnMsgClose(var M : TMessage);
- message MsgClose;
- procedure OnMsgOpen(var M : TMessage);
- message MsgOpen;
-
- property PopupAnchor : TOvcPopupAnchor
- read FPopupAnchor write FPopupAnchor;
- property ShowButton : Boolean
- read FShowButton write SetShowButton;
-
- public
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
- override;
-
- property ButtonGlyph : TBitmap
- read GetButtonGlyph
- write SetButtonGlyph;
-
- procedure PopupClose(Sender : TObject);
- dynamic;
- procedure PopupOpen;
- dynamic;
-
- property OnPopupClose : TOvcPopupEvent
- read FOnPopupClose
- write FOnPopupClose;
-
- property OnPopupOpen : TOvcPopupEvent
- read FOnPopupOpen
- write FOnPopupOpen;
-
- property PopupActive : Boolean
- read FPopupActive;
-
- property Controller;
- end;
-
-implementation
-
-{*** TOvcEdButton ***}
-
-procedure TOvcEdButton.Click;
-begin
- TOvcEdPopup(Parent).PopupOpen;
-end;
-
-
-{*** TOvcEdPopup ***}
-
-constructor TOvcEdPopup.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- ControlStyle := ControlStyle - [csSetCaption];
-
- FShowButton := True;
- FButton := TOvcEdButton.Create(Self);
- FButton.Visible := True;
- FButton.Parent := Self;
- FButton.Caption := '';
- FButton.TabStop := False;
-{$IFNDEF LCL}
- FButton.Style := bsNew;
-{$ENDIF}
-
- FButtonGlyph := TBitmap.Create;
-end;
-
-procedure TOvcEdPopup.CreateParams(var Params : TCreateParams);
-begin
- inherited CreateParams(Params);
-
- Params.Style := Params.Style or WS_CLIPCHILDREN;
-end;
-
-procedure TOvcEdPopup.CreateWnd;
-begin
- inherited CreateWnd;
-
- {force button placement}
- SetBounds(Left, Top, Width, Height);
-
- FButton.Enabled := GetButtonEnabled;
-end;
-
-
-destructor TOvcEdPopup.Destroy;
-begin
- {destroy button}
- FButton.Free;
- FButton := nil;
-
- {destroy button glyph}
- FButtonGlyph.Free;
- FButtonGlyph := nil;
-
- inherited Destroy;
-end;
-
-function TOvcEdPopup.GetButtonEnabled : Boolean;
-begin
- Result := not ReadOnly;
-end;
-
-function TOvcEdPopup.GetButtonWidth : Integer;
-begin
- if FShowButton then begin
- Result := GetSystemMetrics(SM_CXHSCROLL);
- if Assigned(FButtonGlyph) and not FButtonGlyph.Empty then
- if FButtonGlyph.Width + 4 > Result then
- Result := FButtonGlyph.Width + 4;
- end else
- Result := 0;
-end;
-
-function TOvcEdPopup.GetButtonGlyph : TBitmap;
-begin
- if not Assigned(FButtonGlyph) then
- FButtonGlyph := TBitmap.Create;
-
- Result := FButtonGlyph
-end;
-
-procedure TOvcEdPopup.GlyphChanged;
-begin
-end;
-
-procedure TOvcEdPopup.Loaded;
-begin
- inherited Loaded;
-
- if Assigned(FButtonGlyph) then
- FButton.Glyph.Assign(FButtonGlyph);
-end;
-
-procedure TOvcEdPopup.OnMsgClose(var M : TMessage);
-begin
- if (Assigned(FOnPopupClose)) then
- FOnPopupClose(Self);
-end;
-
-procedure TOvcEdPopup.OnMsgOpen(var M : TMessage);
-begin
- if (Assigned(FOnPopupOpen)) then
- FOnPopupOpen(Self);
-end;
-
-
-procedure TOvcEdPopup.PopupClose;
-begin
- FPopupActive := False;
- PostMessage(Handle, MsgClose, 0, 0);
-end;
-
-procedure TOvcEdPopup.PopupOpen;
-begin
- FPopupActive := True;
- PostMessage(Handle, MsgOpen, 0, 0);
-end;
-
-procedure TOvcEdPopup.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
-var
- H : Integer;
-begin
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-
- if not HandleAllocated then
- Exit;
-
- if not FShowButton then begin
- FButton.Height := 0;
- FButton.Width := 0;
- Exit;
- end;
-
- H := ClientHeight;
- if BorderStyle = bsNone then begin
- FButton.Height := H;
- FButton.Width := GetButtonWidth;
- FButton.Left := Width - FButton.Width;
- FButton.Top := 0;
- end else if Ctl3D then begin
- FButton.Height := H;
- FButton.Width := GetButtonWidth;
- FButton.Left := Width - FButton.Width - 4;
- FButton.Top := 0;
- end else begin
- FButton.Height := H - 2;
- FButton.Width := GetButtonWidth;
- FButton.Left := Width - FButton.Width - 1;
- FButton.Top := 1;
- end;
-end;
-
-procedure TOvcEdPopup.SetButtonGlyph(Value : TBitmap);
-begin
- if not Assigned(FButtonGlyph) then
- FButtonGlyph := TBitmap.Create;
-
- if not Assigned(Value) then begin
- FButtonGlyph.Free;
- FButtonGlyph := TBitmap.Create;
- end else
- FButtonGlyph.Assign(Value);
-
- GlyphChanged;
-
- FButton.Glyph.Assign(FButtonGlyph);
- SetBounds(Left, Top, Width, Height);
-end;
-
-procedure TOvcEdPopup.SetShowButton(Value : Boolean);
-begin
- if Value <> FShowButton then begin
- FShowButton := Value;
- {force resize and redisplay of button}
- SetBounds(Left, Top, Width, Height);
- end;
-end;
-
-{$IFDEF VERSION4}
-procedure TOvcEdPopup.CMDialogKey(var Msg : TCMDialogKey);
-begin
- if PopupActive then begin
- with Msg do begin
- if ((CharCode = VK_RETURN) or (CHarCode = VK_ESCAPE)) then begin
- PopupClose(Self);
- Result := 1;
- end;
- end;
- end else
- inherited;
-end;
-{$ENDIF}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovcedtim.pas b/Source/3rdParty/Orpheus/ovcedtim.pas
deleted file mode 100644
index 2c184315..00000000
--- a/Source/3rdParty/Orpheus/ovcedtim.pas
+++ /dev/null
@@ -1,708 +0,0 @@
-{*********************************************************}
-{* OVCEDTIM.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 ovcedtim;
- {-time edit field}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Buttons, Classes, Controls, Forms, Graphics, Menus,
- StdCtrls, SysUtils, OvcConst, OvcData, OvcExcpt, OvcIntl, OvcMisc,
- OvcEditF, OvcDate;
-
-type
- TOvcTimeField = (tfHours, tfMinutes, tfSeconds);
- TOvcTimeMode = (tmClock, tmDuration);
- TOvcDurationDisplay = (ddHMS, ddHM, ddMS, ddHHH, ddMMM, ddSSS);
-
- TOvcGetTimeEvent = procedure(Sender : TObject; var Value : string)
- of object;
- TOvcPreParseTimeEvent = procedure(Sender : TObject; var Value : string)
- of object;
-
- TOvcCustomTimeEdit = class(TOvcCustomEdit)
- {.Z+}
- protected {private}
- {property variables}
- FDurationDisplay : TOvcDurationDisplay;
- FNowString : string;
- FDefaultToPM : Boolean;
- FPrimaryField : TOvcTimeField;
- FShowSeconds : Boolean;
- FShowUnits : Boolean;
- FTime : TDateTime;
- FTimeMode : TOvcTimeMode;
- FUnitsLength : Integer;
-
- {event variables}
- FOnGetTime : TOvcGetTimeEvent;
- FOnPreParseTime : TOvcPreParseTimeEvent;
- FOnSetTime : TNotifyEvent;
-
- {property methods}
- function GetAsHours : LongInt;
- function GetAsMinutes : LongInt;
- function GetAsSeconds : LongInt;
- function GetTime : TDateTime;
- procedure SetAsHours(Value : LongInt);
- procedure SetAsMinutes(Value : LongInt);
- procedure SetAsSeconds(Value : LongInt);
- procedure SetDurationDisplay(Value : TOvcDurationDisplay);
- procedure SetShowSeconds(Value : Boolean);
- procedure SetShowUnits(Value : Boolean);
- procedure SetTimeMode(Value : TOvcTimeMode);
- procedure SetUnitsLength(Value : Integer);
-
- {internal methods}
- procedure ParseFields(const Value : string; S : TStringList);
-
- protected
- procedure DoExit;
- override;
- procedure SetTime(Value : TDateTime);
- procedure SetTimeText(Value : string);
- dynamic;
- {.Z-}
-
- {protected properties}
- property DefaultToPM : Boolean
- read FDefaultToPM write FDefaultToPM;
- property DurationDisplay : TOvcDurationDisplay
- read FDurationDisplay write SetDurationDisplay;
- property NowString : string
- read FNowString write FNowString;
- property PrimaryField : TOvcTimeField
- read FPrimaryField write FPrimaryField;
- property ShowSeconds : Boolean
- read FShowSeconds write SetShowSeconds;
- property ShowUnits : Boolean
- read FShowUnits write SetShowUnits;
- property TimeMode : TOvcTimeMode
- read FTimeMode write SetTimeMode;
- property UnitsLength : Integer
- read FUnitsLength write SetUnitsLength;
-
- {protected events}
- property OnGetTime : TOvcGetTimeEvent
- read FOnGetTime write FOnGetTime;
- property OnPreParseTime : TOvcPreParseTimeEvent
- read FOnPreParseTime write FOnPreParseTime;
- property OnSetTime : TNotifyEvent
- read FOnSetTime write FOnSetTime;
-
- public
- {.Z+}
- constructor Create(AOwner : TComponent);
- override;
- {.Z-}
-
- function FormatTime(Value : TDateTime) : string;
- dynamic;
-
- {public properties}
- property AsDateTime : TDateTime
- read GetTime write SetTime;
- property AsHours : LongInt
- read GetAsHours write SetAsHours;
- property AsMinutes : LongInt
- read GetAsMinutes write SetAsMinutes;
- property AsSeconds : LongInt
- read GetAsSeconds write SetAsSeconds;
- end;
-
- TOvcTimeEdit = class(TOvcCustomTimeEdit)
- published
- {properties}
- {$IFDEF VERSION4}
- property Anchors;
- property Constraints;
- property DragKind;
- {$ENDIF}
- property About;
-{$IFNDEF LCL}
- property AutoSelect;
-{$ENDIF}
- property AutoSize;
- property BorderStyle;
- property CharCase;
- property Color;
- property Controller;
- property Ctl3D;
- property Cursor;
- property DefaultToPM;
- property DragCursor;
- property DragMode;
- property DurationDisplay;
- property Enabled;
- property Font;
-{$IFNDEF LCL}
- property HideSelection;
- property ImeMode;
- property ImeName;
-{$ENDIF}
- property LabelInfo;
- property MaxLength;
- property NowString;
-{$IFNDEF LCL}
- property OEMConvert;
- {$IFDEF VERSION4}
- property ParentBiDiMode;
- {$ENDIF}
-{$ENDIF}
- property ParentColor;
-{$IFNDEF LCL}
- property ParentCtl3D;
-{$ENDIF}
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property PrimaryField;
- property ReadOnly;
- property ShowHint;
- property ShowSeconds;
- property ShowUnits;
- property TabOrder;
- property TabStop;
- property TimeMode;
- property UnitsLength;
- property Visible;
-
- {inherited events}
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- {$IFDEF VERSION4}
- property OnEndDock;
- {$ENDIF}
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnGetTime;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnPreParseTime;
- property OnSetTime;
- property OnStartDrag;
- end;
-
-
-implementation
-
-
-procedure DateTimeToHMS(D : TDateTime; var H, M, S : LongInt);
-var
- HS, Days : Double;
-begin
- HS := 1 / 86400 / 2; {half second portion of a day}
- Days := Trunc(D);
- D := (D-Days) * 24;
- H := Trunc(D + HS);
- D := (D - H) * 60;
- M := Trunc(D + HS);
- S := Trunc((D - M + HS) * 60);
- H := Trunc(H + Days * 24);
-end;
-
-function HMSToDateTime(H, M, S : LongInt) : TDateTime;
-var
- HID, MID, SID : Double;
-begin
- HID := 24;
- MID := 24*60;
- SID := 24*60*60;
- Result := H / HID + M / MID + S / SID;
-end;
-
-{*** TOvcCustomTimeEdit ***}
-
-constructor TOvcCustomTimeEdit.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- ControlStyle := ControlStyle - [csSetCaption];
-
- FDurationDisplay := ddHMS;
- FPrimaryField := tfHours;
- FNowString := TimeSeparator;
- FShowSeconds := False;
- FTime := SysUtils.Time;
- FTimeMode := tmClock;
- FUnitsLength := 1;
-end;
-
-procedure TOvcCustomTimeEdit.DoExit;
-begin
- try
- SetTimeText(Text);
- except
- SetFocus;
- raise;
- end;
- inherited DoExit;
-end;
-
-function TOvcCustomTimeEdit.FormatTime(Value : TDateTime) : string;
-var
- H, M, S : LongInt;
- TimeMask : string;
-begin
- TimeMask := OvcIntlSup.InternationalTime(FShowSeconds);
-
- if FTimeMode = tmClock then
- Result := OvcIntlSup.TimeToTimeString(TimeMask, DateTimeToSTTime(Value), False)
- else begin
- DateTimeToHMS(Value, H, M, S);
- if FShowUnits then begin
- case FDurationDisplay of
- ddHMS : Result :=
- IntToStr(H) + ' ' + Copy(GetOrphStr(SCHoursName), 1, FUnitsLength) + ' ' +
- InttoStr(M) + ' ' + Copy(GetOrphStr(SCMinutesName), 1, FUnitsLength) + ' ' +
- InttoStr(S) + ' ' + Copy(GetOrphStr(SCSecondsName), 1, FUnitsLength);
- ddHM : Result :=
- IntToStr(H) + ' ' + Copy(GetOrphStr(SCHoursName), 1, FUnitsLength) + ' ' +
- InttoStr(M) + ' ' + Copy(GetOrphStr(SCMinutesName), 1, FUnitsLength);
- ddMS : Result :=
- InttoStr(H*60+M) + ' ' + Copy(GetOrphStr(SCMinutesName), 1, FUnitsLength) + ' ' +
- InttoStr(S) + ' ' + Copy(GetOrphStr(SCSecondsName), 1, FUnitsLength);
- ddHHH : Result :=
- IntToStr(H) + ' ' + Copy(GetOrphStr(SCHoursName), 1, FUnitsLength);
- ddMMM : Result :=
- InttoStr(H*60+M) + ' ' + Copy(GetOrphStr(SCMinutesName), 1, FUnitsLength);
- ddSSS : Result :=
- InttoStr((H*60+M)*60+S) + ' ' + Copy(GetOrphStr(SCSecondsName), 1, FUnitsLength);
- end;
- end else begin
- case FDurationDisplay of
- ddHMS : Result := IntToStr(H) + TimeSeparator + InttoStr(M) + TimeSeparator + InttoStr(S);
- ddHM : Result := IntToStr(H) + TimeSeparator + InttoStr(M);
- ddMS : Result := IntToStr(H*60+M) + TimeSeparator + InttoStr(S);
- ddHHH : Result := IntToStr(H);
- ddMMM : Result := IntToStr(H*60+M);
- ddSSS : Result := IntToStr((H*60+M)*60+S);
- end;
- end;
- end;
-end;
-
-function TOvcCustomTimeEdit.GetAsHours : LongInt;
-var
- H, M, S : LongInt;
-begin
- DateTimeToHMS(FTime, H, M, S);
- Result := H;
-end;
-
-function TOvcCustomTimeEdit.GetAsMinutes : LongInt;
-var
- H, M, S : LongInt;
-begin
- DateTimeToHMS(FTime, H, M, S);
- Result := H*60+M;
-end;
-
-function TOvcCustomTimeEdit.GetAsSeconds : LongInt;
-var
- H, M, S : LongInt;
-begin
- DateTimeToHMS(FTime, H, M, S);
- Result := (H*60+M)*60+S;
-end;
-
-function TOvcCustomTimeEdit.GetTime : TDateTime;
-begin
- SetTimeText(Text);
- Result := FTime;
-end;
-
-procedure TOvcCustomTimeEdit.SetAsHours(Value : LongInt);
-var
- D, H : Integer;
-begin
- H := Value;
- D := H div 24;
- H := H - D * 24;
- SetTime(D + EncodeTime(H, 0, 0, 0));
-end;
-
-procedure TOvcCustomTimeEdit.SetAsMinutes(Value : LongInt);
-var
- D, H, M : Integer;
-begin
- M := Value;
- D := M div (24 * 60);
- M := M - D * (24 * 60);
- H := M div 60;
- M := M - H * 60;
- SetTime(D + EncodeTime(H, M, 0, 0));
-end;
-
-procedure TOvcCustomTimeEdit.SetAsSeconds(Value : LongInt);
-var
- D, H, M, S : Integer;
-begin
- S := Value;
- D := S div (24 * 60 * 60);
- S := S - D * (24 * 60 * 60);
- H := S div (60 * 60);
- S := S - H * (60 * 60);
- M := S div 60;
- S := S - M * 60;
- SetTime(D + EncodeTime(H, M, S, 0));
-end;
-
-procedure TOvcCustomTimeEdit.SetDurationDisplay(Value : TOvcDurationDisplay);
-begin
- if Value <> FDurationDisplay then begin
- FDurationDisplay := Value;
- if not (csLoading in ComponentState) then
- SetTime(FTime); {force redisplay with current options}
- end;
-end;
-
-procedure TOvcCustomTimeEdit.SetShowSeconds(Value : Boolean);
-begin
- if Value <> FShowSeconds then begin
- FShowSeconds := Value;
- if not (csLoading in ComponentState) then
- SetTime(FTime); {force redisplay with current options}
- end;
-end;
-
-procedure TOvcCustomTimeEdit.SetShowUnits(Value : Boolean);
-begin
- if Value <> FShowUnits then begin
- FShowUnits := Value;
- if not (csLoading in ComponentState) then
- SetTime(FTime); {force redisplay with current options}
- end;
-end;
-
-procedure TOvcCustomTimeEdit.SetTime(Value : TDateTime);
-begin
- FTime := Value;
- Modified := True;
-
- if FTime < 0 then
- Text := ''
- else
- Text := FormatTime(FTime);
-
- if Assigned(FOnSetTime) then
- FOnSetTime(Self);
-end;
-
-procedure TOvcCustomTimeEdit.SetTimeMode(Value : TOvcTimeMode);
-begin
- if Value <> FTimeMode then begin
- FTimeMode := Value;
- if not (csLoading in ComponentState) then
- SetTime(FTime); {force redisplay with current options}
- end;
-end;
-
-procedure TOvcCustomTimeEdit.ParseFields(const Value : string; S : TStringList);
-var
- I : Integer;
- I1 : Integer;
- I2 : Integer;
- T : string;
-begin
- {parse the string into subfields using a string list to hold the parts}
- I1 := 1;
- while (I1 <= Length(Value)) and not (Value[I1] in ['0'..'9', 'A'..'Z']) do
- Inc(I1);
- while I1 <= Length(Value) do begin
- I2 := I1;
- while (I2 <= Length(Value)) and (Value[I2] in ['0'..'9', 'A'..'Z']) do
- Inc(I2);
-
- T := Copy(Value, I1, I2-I1);
- {if this is a combination of numbers and letters without sperators}
- {representing multiple fields, split them up}
- while Length(T) > 0 do begin
- I := 1;
- case T[1] of
- 'A'..'Z' : while T[I] in ['A'..'Z'] do Inc(I);
- '0'..'9' : while T[I] in ['0'..'9'] do Inc(I);
- end;
- S.Add(Copy(T, 1, I-1));
- Delete(T, 1, I-1);
- end;
-
- while (I2 <= Length(Value)) and not (Value[I2] in ['0'..'9', 'A'..'Z']) do
- Inc(I2);
- I1 := I2;
- end;
-end;
-
-procedure TOvcCustomTimeEdit.SetTimeText(Value : string);
-var
- Field : Integer;
- Error : Integer;
- Hours : Integer;
- Minutes : Integer;
- Seconds : Integer;
- FieldList : TStringList;
- S : string;
- FieldCount : Integer;
- Am, Pm, AmPm : string[1];
- FoundUnits : Boolean;
- V : Integer;
-begin
- if Assigned(FOnPreParseTime) then
- FOnPreParseTime(Self, Value);
-
- if Assigned(FOnGetTime) then
- FOnGetTime(Self, Value);
-
- if (Value = '') then begin
- FTime := 0;
- Text := '';
- Exit;
- end;
-
- if AnsiCompareText(Value, NowString) = 0 then begin
- SetTime(SysUtils.Time);
- Text := FormatTime(FTime);
- end else begin
- Value := AnsiUpperCase(Value);
- FieldList := TStringList.Create;
- try
- {break entry into fields}
- ParseFields(Value, FieldList);
-
- Hours := -1;
- Minutes := -1;
- Seconds := -1;
- if FTimeMode = tmDuration then begin
- {if a single field entered, assume primary field}
- if FieldList.Count = 1 then begin
- case FPrimaryField of
- tfHours : Hours := StrToIntDef(FieldList[0], -1);
- tfMinutes : Minutes := StrToIntDef(FieldList[0], -1);
- tfSeconds : Seconds := StrToIntDef(FieldList[0], -1);
- end;
- end else begin
- FieldCount := FieldList.Count;
- FoundUnits := False;
- for Field := 1 to FieldCount do begin
- if FoundUnits then begin
- FoundUnits := False;
- Continue; {skip this field - it is a unit field}
- end;
- S := FieldList[Field-1];
- V := StrToIntDef(S, -1);
- {if more fields, see if next field is units for this one}
- if Field < FieldCount then begin
- S := FieldList[Field]; {get next field value}
- if not (S[1] in ['0'..'9']) then begin
- if PartialCompare(S, GetOrphStr(SCHoursName)) then begin
- Hours := V;
- FoundUnits := True;
- end else if PartialCompare(S, GetOrphStr(SCMinutesName)) then begin
- Minutes := V;
- FoundUnits := True;
- end else if PartialCompare(S, GetOrphStr(SCSecondsName)) then begin
- Seconds := V;
- FoundUnits := True;
- end;
- end;
- end;
- {uses "logical" units for the time field based on prior fields}
- if not FoundUnits then begin
- if Hours = -1 then
- Hours := V
- else if Minutes = -1 then
- Minutes := V
- else if Seconds = -1 then
- Seconds := V;
- end;
- end;
- end;
-
- {if a value assigned, set time and exit}
- if (Hours > -1) or (Minutes > -1) or (Seconds > -1) then begin
- if Hours = -1 then
- Hours := 0;
- if Minutes = -1 then
- Minutes := 0;
- if Seconds = -1 then
- Seconds := 0;
- SetTime(HMSToDateTime(Hours, Minutes, Seconds));
- Exit;
- end;
- end;
-
- {handle as "normal" time -- "hh:mm:ss tt" format or variations}
- Hours := 0;
- Minutes := 0;
- Seconds := 0;
- Error := 0;
-
- {set default am/pm}
- {in case user has deleted these window settings}
- if (TimeAmString > '') and (TimePmString > '') then begin
- Am := AnsiUpperCase(TimeAmString[1]);
- Pm := AnsiUpperCase(TimePmString[1]);
- end else begin
- Am := 'A';
- Pm := 'P'
- end;
- if FDefaultToPM then
- AmPm := Pm
- else
- AmPm := Am;
-
- {see if we're using a 24 hour time format}
- if (Pos(Am, ShortTimeFormat) = 0) and
- (Pos(Pm, ShortTimeFormat) = 0) then
- AmPm := '';
-
- FieldCount := FieldList.Count;
- for Field := FieldCount-1 downto 0 do begin
- S := AnsiUpperCase(FieldList[Field]);
- if Pos(Am, S) > 0 then begin
- AmPm := Am;
- FieldList.Delete(Field);
- Continue;
- end;
- if Pos(Pm, S) > 0 then begin
- AmPm := Pm;
- FieldList.Delete(Field);
- Continue;
- end;
- end;
-
- FieldCount := FieldList.Count;
- for Field := 1 to FieldCount do begin
- S := FieldList[Field-1];
- case Field of
- 1 :
- begin
- if (S = '') or (S[1] in ['0'..'9']) then begin
- V := StrToIntDef(S, 0);
- if FTimeMode = tmDuration then begin
- case FPrimaryField of
- tfHours : Hours := V;
- tfMinutes : Minutes := V;
- tfSeconds : Seconds := V;
- end;
- end else begin
- Hours := V;
- if (Hours < 12) and (AmPm = Pm) then
- Inc(Hours, 12);
- if not (Hours in [0..23]) then
- Error := SCTimeConvertError;
- end;
- end;
- if Error > 0 then
- Break;
- end;
- 2 :
- begin
- if (S = '') or (S[1] in ['0'..'9']) then begin
- V := StrToIntDef(S, 0);
- if FTimeMode = tmDuration then begin
- case FPrimaryField of
- tfHours : Minutes := V;
- tfMinutes : Seconds := V;
- end;
- end else begin
- Minutes := V;
- if not (Minutes in [0..59]) then
- Error := SCTimeConvertError;
- end;
- end;
- if Error > 0 then
- Break;
- end;
- 3 :
- begin
- if (S = '') or (S[1] in ['0'..'9']) then begin
- V := StrToIntDef(S, 0);
- if FTimeMode = tmDuration then begin
- case FPrimaryField of
- tfHours : Seconds := V;
- end;
- end else begin
- Seconds := V;
- if not (Seconds in [0..59]) then
- Error := SCTimeConvertError;
- end;
- end;
- if Error > 0 then
- Break;
- end;
- end;
- end;
-
- {special handling for times at or just after midnight}
- if (AmPm = Am) then
- if (Hours = 12) or (Hours = 24) then
- Hours := 0;
-
- if Error > 0 then
- raise EOvcException.Create(GetOrphStr(Error) + ' "' + Value + '"');
-
- SetTime(HMSToDateTime(Hours, Minutes, Seconds));
-
- finally
- FieldList.Free;
- end;
-
- end;
-end;
-
-procedure TOvcCustomTimeEdit.SetUnitsLength(Value : Integer);
-begin
- if Value <> FUnitsLength then begin
- FUnitsLength := Value;
- if not (csLoading in ComponentState) then
- SetTime(FTime); {force redisplay with current options}
- end;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovcef.pas b/Source/3rdParty/Orpheus/ovcef.pas
deleted file mode 100644
index b19800aa..00000000
--- a/Source/3rdParty/Orpheus/ovcef.pas
+++ /dev/null
@@ -1,4767 +0,0 @@
-{*********************************************************}
-{* OVCEF.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 ovcef;
- {-Base entry field class}
-
-interface
-
-uses
- SysUtils, Classes,
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, Types, LclType, MyMisc, {$ENDIF}
- ClipBrd, Controls, Forms, Graphics, Menus,
- {$IFDEF VERSION6} Variants, {$ENDIF}
- OvcBase, OvcCaret, OvcColor, OvcConst, OvcCmd, OvcData, OvcExcpt,
- OvcIntl, OvcMisc, OvcStr, OvcUser, OvcDate, OvcBordr;
-
-type
- {user validation event}
- TUserValidationEvent =
- procedure(Sender : TObject; var ErrorCode : Word)
- of object;
- TValidationErrorEvent =
- procedure(Sender : TObject; ErrorCode : Word; ErrorMsg : string)
- of object;
-
- {options available to specific fields}
- TOvcEntryFieldOption = (efoArrowIncDec, efoCaretToEnd, efoForceInsert,
- efoForceOvertype, efoInputRequired,
- efoPasswordMode, efoReadOnly, efoRightAlign,
- efoRightJustify, efoSoftValidation,
- efoStripLiterals, efoTrimBlanks);
-
- TOvcEntryFieldOptions = set of TOvcEntryFieldOption;
-
-const
- efDefOptions = [efoCaretToEnd, efoTrimBlanks];
-
-type
- {combined color class}
- TOvcEfColors = class(TPersistent)
- protected {private}
- FDisabled : TOvcColors; {colors for disabled fields}
- FError : TOvcColors; {colors for invalid fields}
- FHighlight : TOvcColors; {background and text highlight colors}
- public
- procedure Assign(Source : TPersistent); override;
- constructor Create; virtual;
- destructor Destroy; override;
- published
- property Disabled : TOvcColors read FDisabled write FDisabled;
- property Error : TOvcColors read FError write FError;
- property Highlight : TOvcColors read FHighlight write FHighlight;
- end;
-
- {abstract entry field class}
- TOvcBaseEntryField = class(TOvcCustomControlEx)
- {.Z+}
- protected {private}
- {property instance variables}
- FAutoSize : Boolean; {size control when font changes}
- FBorders : TOvcBorders; {simple line borders}
- FBorderStyle : TBorderStyle; {border around the edit field}
- FCtrlColor : TColor; {control character foreground color}
- FDecimalPlaces : Byte; {max decimal places, if no '.' in Picture}
- FEFColors : TOvcEfColors; {entry field colors}
- FEpoch : Integer; {combined epoch year and cenury}
- FIntlSup : TOvcIntlSup; {international support object}
- FLastError : Word; {result of last validation}
- FMaxLength : Word; {maximum length of string}
- FOptions : TOvcEntryFieldOptions;
- FPadChar : AnsiChar; {character used to pad end of string}
- FPasswordChar : AnsiChar; {character used in password mode}
- FTextMargin : Integer; {indent from left (right)}
- FUninitialized : Boolean; {the field isblanked out completely except when it has the focus}
- FUserData : TOvcUserData; {field mask and data object}
- FZeroDisplay : TZeroDisplay; {true to display an empty field}
- FZeroDisplayValue : Double; {value used by ZeroDisplay logic}
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
-
- {event variables}
- FOnChange : TNotifyEvent;
- FOnError : TValidationErrorEvent;
- FOnGetEpoch : TGetEpochEvent;
- FOnUserCommand : TUserCommandEvent;
- FOnUserValidation : TUserValidationEvent;
-
- {internal variables}
- efCaret : TOvcCaretPair; {our carets}
- efDataSize : Word; {size of data type being edited}
- efDataType : Byte; {code indicating field type}
- efEditSt : TEditString; {the edit string}
- efFieldClass : Byte; {fcSimple, fcPicture, or fcNumeric}
- efHOffset : Integer; {horizontal scrolling offset}
- efHPos : Integer; {current position in field (column)}
- efPicLen : Word; {length of picture mask}
- efPicture : TPictureMask; {picture mask}
- efRangeHi : TRangeType; {high range for the field}
- efRangeLo : TRangeType; {low range for the field}
- efRightAlignActive : Boolean; {true if right-align is in use}
- efSaveData : Boolean; {save data during create window}
- efSaveEdit : PAnsiChar; {saved copy of edit string}
- efSelStart : Integer; {start of highlighted selection}
- efSelEnd : Integer; {end of highlighted selection}
- efTopMargin : Integer; {margin above text}
- sefOptions : TsefOptionSet; {secondary field options}
-
- {property methods}
- function GetAsBoolean : Boolean;
- function GetAsCents : LongInt;
- function GetAsExtended : Extended;
- function GetAsFloat : Double;
- function GetAsInteger : Longint;
- function GetAsDateTime : TDateTime;
- function GetAsStDate : TStDate;
- function GetAsStTime : TStTime;
- function GetAsString : string;
- function GetAsVariant : Variant;
- function GetCurrentPos : Integer;
- function GetDataSize : Word;
- function GetDisplayString : string;
- function GetEditString : string;
- function GetEpoch : Integer;
- function GetEverModified : Boolean;
- function GetInsCaretType : TOvcCaret;
- function GetInsertMode : Boolean;
- function GetModified : Boolean;
- function GetOvrCaretType : TOvcCaret;
- function GetRangeHiStr : string;
- function GetRangeLoStr : string;
- function GetSelLength : Integer;
- function GetSelStart : Integer;
- function GetSelText : string;
- procedure SetAsBoolean(Value : Boolean);
- procedure SetAsCents(Value : LongInt);
- procedure SetAsDateTime(Value : TDateTime);
- procedure SetAsExtended(Value : Extended);
- procedure SetAsFloat(Value : Double);
- procedure SetAsInteger(Value : Longint);
- procedure SetAsStDate(Value : TStDate);
- procedure SetAsStTime(Value : TStTime);
- procedure SetAsVariant(Value : Variant);
- procedure SetAutoSize(Value : Boolean); {$IFDEF VERSION6}{$IFNDEF LCL} override;{$ENDIF}{$ENDIF}
- procedure SetBorderStyle(Value : TBorderStyle);
- procedure SetDecimalPlaces(Value : Byte);
- procedure SetEpoch(Value : Integer);
- procedure SetEverModified(Value : Boolean);
- procedure SetInsCaretType(const Value : TOvcCaret);
- procedure SetInsertMode(Value : Boolean);
- procedure SetIntlSupport(Value : TOvcIntlSup);
- procedure SetMaxLength(Value : Word);
- procedure SetModified(Value : Boolean);
- procedure SetOptions(Value : TOvcEntryFieldOptions);
- procedure SetOvrCaretType(const Value : TOvcCaret);
- procedure SetPadChar(Value : AnsiChar);
- procedure SetPasswordChar(Value : AnsiChar);
- procedure SetRangeLoStr(const Value : string);
- procedure SetRangeHiStr(const Value : string);
- procedure SetSelLength(Value : Integer);
- procedure SetSelStart(Value : Integer);
- procedure SetSelText(const Value : string);
- procedure SetTextMargin(Value : Integer);
- procedure SetUninitialized(Value : Boolean);
- procedure SetUserData(Value : TOvcUserData);
- procedure SetZeroDisplay(Value : TZeroDisplay);
- procedure SetZeroDisplayValue(Value : Double);
-
- {internal methods}
- procedure efBorderChanged(ABorder : TObject);
- procedure efCalcTopMargin;
- procedure efColorChanged(AColor : TObject);
- function efGetTextExtent(S : PChar; Len : Integer) : Word;
- procedure efInitializeDataSize;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
- function efIsSibling(HW : TOvcHWnd{hWnd}) : Boolean;
-
- procedure efMoveFocus(C : TWinControl);
- procedure efPaintBorders;
- procedure efPerformEdit(var Msg : TMessage; Cmd : Word);
- procedure efPerformPreEditNotify(C : TWinControl);
- procedure efPerformPostEditNotify(C : TWinControl);
- procedure efReadRangeHi(Stream : TStream);
- procedure efReadRangeLo(Stream : TStream);
- function efTransferPrim(DataPtr : Pointer; TransferFlag : Word) : Word;
- procedure efWriteRangeHi(Stream : TStream);
- procedure efWriteRangeLo(Stream : TStream);
-
-
-
- {VCL control methods}
-{$IFNDEF LCL}
- procedure CMCtl3DChanged(var Msg : TMessage);
- message CM_CTL3DCHANGED;
-{$ENDIF}
- procedure CMDialogChar(var Msg : TCMDialogChar);
- message CM_DIALOGCHAR;
- procedure CMEnabledChanged(var Msg : TMessage);
- message CM_ENABLEDCHANGED;
- procedure CMFontChanged(var Msg : TMessage);
- message CM_FONTCHANGED;
-
- {private message response methods}
- procedure OMGetDataSize(var Msg : TMessage);
- message OM_GETDATASIZE;
- procedure OMReportError(var Msg : TOMReportError);
- message OM_REPORTERROR;
-
- {windows message response methods}
- procedure WMChar(var Msg : TWMChar);
- message WM_CHAR;
- procedure WMClear(var Msg : TWMClear);
- message WM_CLEAR;
- procedure WMCopy(var Msg : TWMCopy);
- message WM_COPY;
- procedure WMCut(var Msg : TWMCut);
- message WM_CUT;
- procedure WMEraseBkGnd(var Msg : TWMEraseBkGnd);
- message WM_ERASEBKGND;
- procedure WMGetDlgCode(var Msg : TWMGetDlgCode);
- message WM_GETDLGCODE;
- procedure WMKeyDown(var Msg : TWMKeyDown);
- message WM_KEYDOWN;
- procedure WMKillFocus(var Msg : TWMKillFocus);
- message WM_KILLFOCUS;
- procedure WMLButtonDblClk(var Msg : TWMLButtonDblClk);
- message WM_LBUTTONDBLCLK;
- procedure WMLButtonDown(var Msg : TWMLButtonDown);
- message WM_LBUTTONDOWN;
- procedure WMMouseActivate(var Msg : TWMMouseActivate);
- message WM_MOUSEACTIVATE;
- procedure WMMouseMove(var Msg : TWMMouseMove);
- message WM_MOUSEMOVE;
- procedure WMPaste(var Msg : TWMPaste);
- message WM_PASTE;
- procedure WMRButtonUp(var Msg : TWMRButtonDown);
- message WM_RBUTTONUP;
- procedure WMSetFocus(var Msg : TWMSetFocus);
- message WM_SETFOCUS;
- procedure WMSetFont(var Msg : TWMSetFont);
- message WM_SETFONT;
- procedure WMSetText(var Msg : TWMSetText);
- message WM_SETTEXT;
- procedure WMSize(var Msg : TWMSize);
- message WM_SIZE;
- procedure WMSysKeyDown(var Msg : TWMSysKeyDown);
- message WM_SYSKEYDOWN;
-
- {edit control message methods}
- procedure EMGetModify(var Msg : TMessage);
- message EM_GETMODIFY;
- procedure EMGetSel(var Msg : TMessage);
- message EM_GETSEL;
- procedure EMSetModify(var Msg : TMessage);
- message EM_SETMODIFY;
- procedure EMSetSel(var Msg : TMessage);
- message EM_SETSEL;
-
- protected
- {VCL methods}
- procedure CreateParams(var Params : TCreateParams);
- override;
- procedure CreateWnd;
- override;
- procedure DefineProperties(Filer : TFiler);
- override;
- procedure Paint;
- override;
-
- {dynamic event wrappers}
- procedure DoOnChange;
- dynamic;
- {-perform notification of a change}
- procedure DoOnError(ErrorCode : Word; const ErrorMsg : string);
- dynamic;
- {-perform notification of an error}
- procedure DoOnUserCommand(Command : Word);
- dynamic;
- {-perform notification of a user command}
- procedure DoOnUserValidation(var ErrorCode : Word);
- dynamic;
- {-perform call to user validation event handler}
-
- procedure DoRestoreClick(Sender : TObject);
- dynamic;
- procedure DoCutClick(Sender : TObject);
- dynamic;
- procedure DoCopyClick(Sender : TObject);
- dynamic;
- procedure DoPasteClick(Sender : TObject);
- dynamic;
- procedure DoDeleteClick(Sender : TObject);
- dynamic;
- procedure DoSelectAllClick(Sender : TObject);
- dynamic;
-
- procedure efAdjustSize;
- dynamic;
- {-adjust the size of the control based on the current font}
- function efCanClose(DoValidation : Boolean) : Boolean;
- virtual;
- {-returns true if the field contents are valid}
- procedure efCaretToEnd;
- virtual;
- {-move the caret to the end of the field}
- procedure efCaretToStart;
- virtual;
- {-move the caret to the beginning of the field}
- procedure efChangeMask(Mask : PAnsiChar);
- dynamic;
- {-change the picture mask}
- function efCharOK(PicChar : AnsiChar; var Ch : AnsiChar;
- PrevCh : AnsiChar; Fix : Boolean) : Boolean;
- {-return True if Ch is in character set corresponding to PicChar}
- procedure efConditionalBeep;
- {-beep if pefBeepOnError option is active}
- procedure efCopyPrim;
- {-Primitive clipboard copy method}
- function efBinStr2Long(St : PAnsiChar; var L : LongInt) : Boolean;
- {-convert a binary string to a longint}
- function efCalcDataSize(St : PAnsiChar; MaxLen : Word) : Word;
- {-calculate data size of a string field with literal stripping option on}
- procedure efEdit(var Msg : TMessage; Cmd : Word);
- virtual; abstract;
- {-process the specified editing command}
- function efEditBegin : Word;
- virtual;
- {-return offset of first editable position in field}
- function efFieldIsEmpty : Boolean;
- virtual;
- {-return True if the field is empty}
- procedure efFieldModified;
- {-mark the field as modified; tell parent form it changed}
- procedure efFindCtrlChars(P : PAnsiChar; var ChCnt, CtCnt : Integer);
- {-find control caracters and return normal and control char counts}
- procedure efFixCase(PicChar : AnsiChar; var Ch : AnsiChar; PrevCh : AnsiChar);
- {-fix the case of Ch based on PicChar}
- function efGetDisplayString(Dest : PAnsiChar; Size : Word) : PAnsiChar;
- virtual;
- {-return the display string in Dest and a pointer as the result}
- function efGetMousePos(MPos : Integer) : Integer;
- {-get the position of a mouse click}
- procedure efGetSampleDisplayData(T : PAnsiChar);
- dynamic;
- {-return sample data for the current field type}
- procedure efIncDecValue(Wrap : Boolean; Delta : Double);
- dynamic; abstract;
- {-increment field by Delta}
- function efIsNumericType : Boolean;
- {-return True if field is of a numeric type}
- function efIsReadOnly : Boolean;
- virtual;
- {-return True if field is read-only}
- procedure efLong2Str(P : PAnsiChar; L : LongInt);
- {-convert a longint to a string}
- procedure efMapControlChars(Dest, Src : PAnsiChar);
- {-copy from Src to Dest, mapping control characters to alph in process}
- procedure efMoveFocusToNextField;
- dynamic;
- {-give next field the focus}
- procedure efMoveFocusToPrevField;
- dynamic;
- {-give previous field the focus}
- function efNthMaskChar(N : Word) : AnsiChar;
- {-return the N'th character in the picture mask. N is 0-based}
- function efOctStr2Long(St : PAnsiChar; var L : LongInt) : Boolean;
- {-convert an octal string to a longint}
-
-{ - Hdc changed to TOvcHdc for BCB Compatibility }
- procedure efPaintPrim(DC : TOvcHDC{Hdc}; ARect : TRect; Offset : Integer);
- {-primitive routine to draw the entry field control}
-
- procedure efPerformRepaint(Modified : Boolean);
- {-flag the field as modified and redraw it}
- function efPositionCaret(Adjust : Boolean) : Boolean;
- {-position the editing caret}
- function efRangeToStRange(const Value : TRangeType) : string;
- {-returns the range as a string}
- function efStRangeToRange(const Value : string; var R : TRangeType) : Boolean;
- {-converts a string range to a RangeType}
- procedure efRemoveBadOptions;
- virtual;
- {-remove inappropriate options for this field and data type}
- procedure efResetCaret;
- virtual;
- {-move the caret to the beginning or end of the field, as appropriate}
- procedure efSaveEditString;
- {-save a copy of the edit string}
- procedure efSetDefaultRange(FT : Byte);
- {-set the default range for the given field type}
- procedure efSetInitialValue;
- {-set the initial value of the field}
- function efStr2Long(P : PAnsiChar; var L : LongInt) : Boolean;
- {-convert a string to a longint}
- function efTransfer(DataPtr : Pointer; TransferFlag : Word) : Word;
- virtual;
- {-transfer data to/from the entry fields}
- function efValidateField : Word;
- virtual; abstract;
- {-validate contents of field; result is error code or 0}
-
- {virtual property methods}
- procedure efSetCaretPos(Value : Integer);
- virtual;
- {-set position of the caret within the field}
- procedure SetAsString(const Value : string);
- virtual;
- {-sets the field value to a String Value}
- procedure SetName(const Value : TComponentName);
- override;
- {-catch when component name is changed}
-
- public
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
- procedure SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
- override;
- {.Z-}
-
- procedure ClearContents;
- {-clear the contents of the entry field}
- procedure ClearSelection;
- {-erase the highlighted text}
- procedure CopyToClipboard;
- {-copies the highlighted text to the clipboard}
- procedure CutToClipboard;
- dynamic;
- {-performs a CopyToClipboard then deletes the highlighted text from the field}
- procedure DecreaseValue(Wrap : Boolean; Delta : Double);
- {-decrease the value of the field by Delta, wrapping if enabled}
- procedure Deselect;
- {-unhighlight any highlighted text}
- function FieldIsEmpty : Boolean;
- {-return True if the field is completely empty}
- function GetStrippedEditString : string;
- dynamic;
- {-return edit string stripped of literals and semi-literals}
- function GetValue(var Data) : Word;
- {-returns the current field value in Data. Result is 0 or error code}
- procedure IncreaseValue(Wrap : Boolean; Delta : Double);
- {-increase the value of the field by Delta, wrapping if enabled}
- function IsValid : Boolean;
- {-returns true if the field is not marked as invalid}
- procedure MergeWithPicture(const S : string);
- dynamic;
- {-combines S with the picture mask and updates the edit string}
- procedure MoveCaret(Delta : Integer);
- {-moves the caret to the right or left Value positions}
- procedure MoveCaretToEnd;
- {-move the caret to the end of the field}
- procedure MoveCaretToStart;
- {-move the caret to the beginning of the field}
- procedure PasteFromClipboard;
- dynamic;
- {-places the text content of the clipboard into the field}
- procedure ProcessCommand(Cmd, CharCode : Word);
- {-process the specified command}
- procedure ResetCaret;
- {-move the caret to the beginning or end of the field, as appropriate}
- procedure Restore;
- dynamic;
- {-restore the previous contents of the field}
- procedure SelectAll;
- {-selects the current edit text}
- procedure SetInitialValue;
- {-resets the field value to its initial value}
- procedure SetRangeHi(const Value : TRangeType);
- {-set the high range for this field}
- procedure SetRangeLo(const Value : TRangeType);
- {-set the low range for this field}
- procedure SetSelection(Start, Stop : Word);
- {-mark offsets Start..Stop as selected}
- procedure SetValue(const Data);
- {-changes the field's value to the value in Data}
- function ValidateContents(ReportError : Boolean) : Word;
- dynamic;
- {-performs field validation, returns error code, and conditionally reports error}
- function ValidateSelf : Boolean;
- {-performs field validation, returns true if no errors, and reports error}
-
- {public properties}
- property ParentColor default False;
- property AsBoolean : Boolean
- read GetAsBoolean write SetAsBoolean;
- property AsCents : LongInt
- read GetAsCents write SetAsCents;
- property AsDateTime : TDateTime
- read GetAsDateTime write SetAsDateTime;
- property AsExtended : Extended
- read GetAsExtended write SetAsExtended;
- property AsFloat : Double
- read GetAsFloat write SetAsFloat;
- property AsInteger : Longint
- read GetAsInteger write SetAsInteger;
- property AsOvcDate : TOvcDate
- read GetAsStDate write SetAsStDate;
- property AsOvcTime : TOvcTime
- read GetAsStTime write SetAsStTime;
- property AsString : string
- read GetAsString write SetAsString;
- property AsVariant : Variant
- read GetAsVariant write SetAsVariant;
- property AsStDate : TStDate
- read GetAsStDate write SetAsStDate;
- property AsStTime : TStTime
- read GetAsStTime write SetAsStTime;
- property Font;
- property Canvas;
- property Color;
- property CurrentPos : Integer
- read GetCurrentPos write efSetCaretPos;
- property DataSize : Word
- read GetDataSize;
- property DisplayString : string
- read GetDisplayString;
- property EditString : string
- read GetEditString;
- property Epoch : Integer
- read GetEpoch write SetEpoch;
- property EverModified : Boolean
- read GetEverModified write SetEverModified;
-
- {.Z+}
- property InsertMode : Boolean
- read GetInsertMode write SetInsertMode;
- {.Z-}
-
- property IntlSupport : TOvcIntlSup
- read FIntlSup write SetIntlSupport;
- property LastError : Word
- read FLastError;
- property Modified : Boolean
- read GetModified write SetModified;
- property SelectionLength : Integer
- read GetSelLength write SetSelLength;
- property SelectionStart : Integer
- read GetSelStart write SetSelStart;
- property SelectedText : string
- read GetSelText write SetSelText;
- property Text : string
- read GetAsString write SetAsString;
- property UserData : TOvcUserData
- read FUserData write SetUserData;
-
- {publishable properties}
- {revised}
- property AttachedLabel : TOvcAttachedLabel
- read GetAttachedLabel;
- property AutoSize : Boolean
- read FAutoSize write SetAutoSize default True;
- property Borders : TOvcBorders
- read FBorders write FBorders;
- property BorderStyle : TBorderStyle
- read FBorderStyle write SetBorderStyle default bsSingle;
- property CaretIns : TOvcCaret
- read GetInsCaretType write SetInsCaretType;
- property CaretOvr : TOvcCaret
- read GetOvrCaretType write SetOvrCaretType;
- property ControlCharColor : TColor
- read FCtrlColor write FCtrlColor;
- property DecimalPlaces : Byte
- read FDecimalPlaces write SetDecimalPlaces;
- property EFColors : TOvcEfColors
- read FEFColors write FEFColors;
- property MaxLength : Word
- read FMaxLength write SetMaxLength default 15;
- property Options : TOvcEntryFieldOptions
- read FOptions write SetOptions default efDefOptions;
- property PadChar : AnsiChar
- read FPadChar write SetPadChar default DefPadChar;
- property PasswordChar : AnsiChar
- read FPasswordChar write SetPasswordChar default '*';
- property RangeHi : string
- read GetRangeHiStr write SetRangeHiStr stored False;
- property RangeLo : string
- read GetRangeLoStr write SetRangeLoStr stored False;
- property TextMargin : Integer
- read FTextMargin write SetTextMargin default 2;
- property Uninitialized : Boolean
- read FUninitialized write SetUninitialized default False;
- property ZeroDisplay : TZeroDisplay
- read FZeroDisplay write SetZeroDisplay default zdShow;
- property ZeroDisplayValue : Double
- read FZeroDisplayValue write SetZeroDisplayValue;
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D default True;
-{$ENDIF}
-
- {events}
- property OnChange : TNotifyEvent
- read FOnChange write FOnChange;
- property OnError : TValidationErrorEvent
- read FOnError write FOnError;
- property OnGetEpoch : TGetEpochEvent
- read FOnGetEpoch write FOnGetEpoch;
- property OnUserCommand : TUserCommandEvent
- read FOnUserCommand write FOnUserCommand;
- property OnUserValidation : TUserValidationEvent
- read FOnUserValidation write FOnUserValidation;
- end;
-
-
-implementation
-
-{*** TOvcEfColors ***}
-
-procedure TOvcEfColors.Assign(Source : TPersistent);
-var
- C : TOvcEfColors absolute Source;
-begin
- if (Source <> nil) and (Source is TOvcEfColors) then begin
- FDisabled.Assign(C.Disabled);
- FError.Assign(C.Error);
- FHighlight.Assign(C.Highlight);
- end else
- inherited Assign(Source);
-end;
-
-constructor TOvcEfColors.Create;
-begin
- inherited Create;
-
- {create color objects and assign defaults}
- FDisabled := TOvcColors.Create(clGrayText, clWindow);
- FError := TOvcColors.Create(clBlack, clRed);
- FHighlight := TOvcColors.Create(clHighlightText, clHighlight);
-end;
-
-destructor TOvcEfColors.Destroy;
-begin
- {dispose of the color objects}
- FDisabled.Free;
- FError.Free;
- FHighlight.Free;
-
- inherited Destroy;
-end;
-
-
-{*** TOvcBaseEntryField ***}
-
-procedure TOvcBaseEntryField.ClearContents;
- {-erases the contents of the edit field}
-var
- RO : Boolean;
-begin
- if HandleAllocated then begin
- RO := efoReadOnly in Options; {store current read only state}
- Exclude(FOptions, efoReadOnly);
-
- {set the updating flag so OnChange doesn't get fired}
- Include(sefOptions, sefUpdating);
- SetWindowText(Handle, '');
- Exclude(sefOptions, sefUpdating);
- {restore previous state}
- if RO then
- Include(FOptions, efoReadOnly);
- end;
-end;
-
-procedure TOvcBaseEntryField.ClearSelection;
-begin
- if HandleAllocated then
- Perform(WM_CLEAR, 0, 0);
-end;
-
-{$IFNDEF LCL}
-procedure TOvcBaseEntryField.CMCtl3DChanged(var Msg : TMessage);
-begin
- if not HandleAllocated then
- Exit;
-
- if NewStyleControls and (FBorderStyle = bsSingle) then begin
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- if not (csLoading in ComponentState) then
- efAdjustSize;
- end;
-
- efCalcTopMargin;
-
- inherited;
-end;
-{$ENDIF}
-
-procedure TOvcBaseEntryField.CMDialogChar(var Msg : TCMDialogChar);
-begin
- {see if this is an Alt-Backspace key sequence (Alt flag is bit 29}
- if (Msg.CharCode = VK_BACK) and (HiWord(Msg.KeyData) and $2000 <> 0) then
- {don't pass it on as a dialog character since we use it as}
- {the restore command by default}
- Msg.Result := 1;
-
- inherited;
-end;
-
-procedure TOvcBaseEntryField.CMEnabledChanged(var Msg : TMessage);
-begin
- inherited;
-
- Repaint;
-end;
-
-procedure TOvcBaseEntryField.CMFontChanged(var Msg : TMessage);
-begin
- inherited;
-
- if (csLoading in ComponentState) then
- Exit;
-
- if not HandleAllocated then
- Exit;
-
- {efCalcTopMargin;}
- efAdjustSize; {adjust height based on font}
- efCalcTopMargin;
-
- if GetFocus = Handle then
- efPositionCaret(False); {adjust caret for new font}
-end;
-
-procedure TOvcBaseEntryField.CopyToClipboard;
- {-copies the selected text to the clipboard}
-begin
- if HandleAllocated then
- Perform(WM_COPY, 0, 0);
-end;
-
-constructor TOvcBaseEntryField.Create(AOwner : TComponent);
-const
- CStyle = [csClickEvents, csCaptureMouse, csOpaque];
-begin
- inherited Create(AOwner);
-
- if NewStyleControls then
- ControlStyle := ControlStyle + CStyle
- else
- ControlStyle := ControlStyle + CStyle + [csFramed];
-
-// TurboPower bug: forgot to enable XP theme support.
- ControlStyle := ControlStyle + [csNeedsBorderPaint]; //Added
-
- {create borders class and assign notifications}
- FBorders := TOvcBorders.Create;
-
- FBorders.LeftBorder.OnChange := efBorderChanged;
- FBorders.RightBorder.OnChange := efBorderChanged;
- FBorders.TopBorder.OnChange := efBorderChanged;
- FBorders.BottomBorder.OnChange := efBorderChanged;
-
-
- Cursor := crIBeam;
- Height := 25;
- ParentColor := False;
- Width := 130;
- TabStop := True;
-
- {defaults}
- FAutoSize := True;
- FBorderStyle := bsSingle;
- FCtrlColor := clRed;
- FDecimalPlaces := 0;
- FMaxLength := 15;
- FOptions := efDefOptions;
- FPadChar := DefPadChar;
- FPasswordChar := '*';
- FTextMargin := 2;
- FUninitialized := False;
- FZeroDisplay := zdShow;
- FZeroDisplayValue := 0;
-{$IFDEF LCL}
- FCtl3D := True;
- Color := clWindow;
-{$ENDIF}
-
- efRangeLo := BlankRange;
- efRangeHi := BlankRange;
-
- {default picture and field settings}
- efPicture[0] := 'X';
- efPicture[1] := #0;
- efPicLen := 1;
- efFieldClass := fcSimple;
- efDataType := fidSimpleString;
-
- {assign default user data object}
- FUserData := OvcUserData;
-
- {assign default international support object}
- FIntlSup := OvcIntlSup;
-
- {create the caret class}
- efCaret := TOvcCaretPair.Create(Self);
-
- {init edit and save edit strings}
- FillChar(efEditSt, MaxEditLen, #0);
- efSaveEdit := nil;
-
- {create colors class}
- FEFColors := TOvcEfColors.Create;
-
- {assign color change notification methods}
- FEFColors.FDisabled.OnColorChange := efColorChanged;
- FEFColors.FError.OnColorChange := efColorChanged;
- FEFColors.FHighlight.OnColorChange := efColorChanged;
-
- efCalcTopMargin;
-end;
-
-
-procedure TOvcBaseEntryField.CreateParams(var Params : TCreateParams);
-begin
- inherited CreateParams(Params);
-
- Params.Style := LongInt(Params.Style) or BorderStyles[FBorderStyle];
-
- if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then begin
- Params.Style := Params.Style and not WS_BORDER;
- Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
- end;
-
- {set picture length and check MaxLength}
- efPicLen := StrLen(efPicture);
- if FMaxLength = 0 then
- FMaxLength := efPicLen;
-
- {reset secondary options}
- sefOptions := sefDefOptions;
-
-{$IFDEF LCL}
- inherited SetBorderStyle(FBorderStyle);
-{$ENDIF}
-end;
-
-procedure TOvcBaseEntryField.CreateWnd;
-begin
- inherited CreateWnd;
-
- efHOffset := 0;
- efHPos := 0;
- efSelStart := 0;
- efSelEnd := 0;
-
- {set efDataSize for this field type}
- efInitializeDataSize;
-
- {if input is required then these fields must also be uninitialized}
- if efoInputRequired in Options then
- case efDataType mod fcpDivisor of
- fsubChar, fsubBoolean, fsubYesNo, fsubLongInt,
- fsubWord, fsubInteger, fsubByte, fsubShortInt,
- fsubReal, fsubExtended, fsubDouble, fsubSingle,
- fsubComp : Uninitialized := True;
- end;
-
- {is it a hex, binary, octal, and/or numeric field?}
- if StrScan(efPicture, pmHexadecimal) <> nil then
- Include(sefOptions, sefHexadecimal)
- else
- Exclude(sefOptions, sefHexadecimal);
-
- if StrScan(efPicture, pmBinary) <> nil then
- Include(sefOptions, sefBinary)
- else
- Exclude(sefOptions, sefBinary);
-
- if StrScan(efPicture, pmOctal) <> nil then
- Include(sefOptions, sefOctal)
- else
- Exclude(sefOptions, sefOctal);
-
- if efFieldClass = fcNumeric then
- Include(sefOptions, sefNumeric)
- else
- Exclude(sefOptions, sefNumeric);
-
- {assume no literals in mask}
- Include(sefOptions, sefNoLiterals);
-
- {reject bad options}
- efRemoveBadOptions;
-
- {set canvas font to selected font}
- Canvas.Font := Font;
-
- efAdjustSize; {adjust height based on font}
- efCalcTopMargin;
-
- efRightAlignActive := efoRightAlign in Options;
-end;
-
-procedure TOvcBaseEntryField.CutToClipboard;
- {-erases the selected text and places it in the clipboard}
-begin
- if HandleAllocated then
- Perform(WM_CUT, 0, 0);
-end;
-
-procedure TOvcBaseEntryField.DefineProperties(Filer : TFiler);
-var
- Save : Boolean;
-begin
- inherited DefineProperties(Filer);
-
- Save := not (efDataType mod fcpDivisor in [fsubString, fsubBoolean, fsubYesNo]);
-
- Filer.DefineBinaryProperty('RangeHigh', efReadRangeHi, efWriteRangeHi, Save);
- Filer.DefineBinaryProperty('RangeLow', efReadRangeLo, efWriteRangeLo, Save);
-end;
-
-procedure TOvcBaseEntryField.DecreaseValue(Wrap : Boolean; Delta : Double);
- {-decrease the value of the field by Delta, wrapping if enabled}
-begin
- SendMessage(Handle, WM_SETREDRAW, 0, 0);
- efIncDecValue(Wrap, -Delta);
- SetSelection(0, 0);
- SendMessage(Handle, WM_SETREDRAW, 1, 0);
- Refresh;
-end;
-
-procedure TOvcBaseEntryField.Deselect;
- {-unhighlight any highlighted text}
-begin
- SetSelection(0, 0);
-end;
-
-destructor TOvcBaseEntryField.Destroy;
-var
- PF : TCustomForm;
-begin
- if Focused then begin
- PF := GetParentForm(Self);
- PF.DefocusControl(Self, True);
- end;
-
- {dispose of the caret object}
- efCaret.Free;
-
- {dispose of the color object}
- FEFColors.Free;
-
- {dispose the borders object}
- FBorders.Free;
-
- {dispose of the saved edit string}
- if efSaveEdit <> nil then
- StrDispose(efSaveEdit);
-
- inherited Destroy;
-end;
-
-procedure TOvcBaseEntryField.DoOnChange;
- {-perform notification of a change}
-begin
- if Assigned(FOnChange) and not (sefUpdating in sefOptions) then
- FOnChange(Self);
-end;
-
-procedure TOvcBaseEntryField.DoOnError(ErrorCode : Word; const ErrorMsg : string);
-begin
- if Assigned(FOnError) then
- FOnError(Self, ErrorCode, ErrorMsg)
- else
- Controller.DoOnError(Self, ErrorCode, ErrorMsg);
-end;
-
-procedure TOvcBaseEntryField.DoOnUserCommand(Command : Word);
- {-perform notification of a user command}
-begin
- if Assigned(FOnUserCommand) then
- FOnUserCommand(Self, Command);
-end;
-
-procedure TOvcBaseEntryField.DoOnUserValidation(var ErrorCode : Word);
- {-perform call to user validation event handler}
-begin
- if Assigned(FOnUserValidation) then
- if not (sefNoUserValidate in sefOptions) then
- FOnUserValidation(Self, ErrorCode);
-end;
-
-procedure TOvcBaseEntryField.DoRestoreClick(Sender : TObject);
-begin
- Restore;
- efPositionCaret(True);
-end;
-
-procedure TOvcBaseEntryField.DoCutClick(Sender : TObject);
-begin
- CutToClipboard
-end;
-
-procedure TOvcBaseEntryField.DoCopyClick(Sender : TObject);
-begin
- CopyToClipboard;
-end;
-
-procedure TOvcBaseEntryField.DoPasteClick(Sender : TObject);
-begin
- PasteFromClipboard;
-end;
-
-procedure TOvcBaseEntryField.DoDeleteClick(Sender : TObject);
-begin
- ClearSelection;
-end;
-
-procedure TOvcBaseEntryField.DoSelectAllClick(Sender : TObject);
-begin
- SelectAll;
-end;
-
-procedure TOvcBaseEntryField.efAdjustSize;
- {-adjust the height of the control based on the current font}
-var
- DC : hDC;
- SaveFont : hFont;
- I : Integer;
- SysMetrics : TTextMetric;
- Metrics : TTextMetric;
-begin
- if not FAutoSize then
- Exit;
-
- DC := GetDC(0);
- try
- GetTextMetrics(DC, SysMetrics);
- SaveFont := SelectObject(DC, Font.Handle);
- GetTextMetrics(DC, Metrics);
- SelectObject(DC, SaveFont);
- finally
- ReleaseDC(0, DC);
- end;
-
- if NewStyleControls then begin
- if Ctl3D then
- I := 8
- else
- I := 6;
- I := GetSystemMetrics(SM_CYBORDER) * I;
- end else begin
- I := SysMetrics.tmHeight;
- if I > Metrics.tmHeight then
- I := Metrics.tmHeight;
- I := I div 4 + GetSystemMetrics(SM_CYBORDER) * 4;
- end;
-
- Height := Metrics.tmHeight + I;
-
- {SetBounds may have turn this off, turn it back on}
- if not FAutoSize then
- FAutoSize := True;
-end;
-
-function TOvcBaseEntryField.efBinStr2Long(St : PAnsiChar; var L : LongInt) : Boolean;
- {-convert a binary string to a longint}
-var
- BitNum : Word;
- Len : Word;
- LT : LongInt;
-begin
- Result := False;
- Len := StrLen(St);
- BitNum := 0;
- LT := 0;
- while Len > 0 do begin
- Dec(Len);
- case St[Len] of
- '0' : {OK};
- '1' : if BitNum > 31 then
- Exit
- else
- Inc(LT, LongInt(1) shl BitNum);
- else Exit;
- end;
- Inc(BitNum);
- end;
- L := LT;
- Result := True;
-end;
-
-function TOvcBaseEntryField.efCalcDataSize(St : PAnsiChar; MaxLen : Word) : Word;
- {-calculate data size of a string field with literal stripping option on}
-var
- I, L : Word;
-begin
- I := 0;
- L := StrLen(St);
- while St^ <> #0 do begin
- if (St^ in PictureChars) then
- Inc(I)
- else case St^ of
- pmFloatDollar, pmComma : Inc(I);
- end;
- Inc(St);
- end;
- Result := I+(MaxLen-L)+1;
-end;
-
-function TOvcBaseEntryField.efCanClose(DoValidation : Boolean) : Boolean;
-var
- SoftV : Boolean;
-begin
- Result := True;
-
- {don't do any of this if we're hidden or not enabled}
- if (not Visible) or (not Enabled) then
- Exit;
-
- HandleNeeded;
-
- {clear error flag}
- FLastError := 0;
-
- {check for empty/uninitialized required field}
- if (efoInputRequired in Options) and not efIsReadOnly then
- if efFieldIsEmpty or (Uninitialized and not (sefModified in sefOptions)) then
- FLastError := oeRequiredField;
-
- {ask the validation routine if there's an error}
- if FLastError = 0 then begin
- Include(sefOptions, sefValidating);
- FLastError := efValidateField;
- Exclude(sefOptions, sefValidating);
- end;
-
- if efHPos > LongInt(StrLen(efEditSt)) then
- efHPos := LongInt(StrLen(efEditSt));
-
- if FLastError = 0 then
- Exclude(sefOptions, sefInvalid)
- else begin
- if DoValidation and (efoSoftValidation in Options) then begin
- Include(sefOptions, sefInvalid);
- Result := True; {say we can close, error is in FLastError}
- Exit;
- end else begin
- if (efoSoftValidation in Options) then
- Include(sefOptions, sefInvalid);
-
- {set flag to indicate that an error is pending}
- Include(sefOptions, sefErrorPending);
-
- {keep the caret where it is if we have the focus}
- if sefHaveFocus in sefOptions then
- Include(sefOptions, sefRetainPos);
-
- {force soft validation on}
- SoftV := efoSoftValidation in Options;
- Include(FOptions, efoSoftValidation);
- try
- {ask the parent form to give us back the focus}
- efMoveFocus(Self);
-
- {report the error}
- if not Controller.ErrorPending then
- PostMessage(Handle, om_ReportError, FLastError, 0);
-
- {set controller's error pending flag}
- Controller.ErrorPending := True;
- finally
- {restore old options}
- if SoftV then
- Include(FOptions, efoSoftValidation)
- else
- Exclude(FOptions, efoSoftValidation);
- end;
- end;
- end;
-
- Result := FLastError = 0;
-end;
-
-procedure TOvcBaseEntryField.efCaretToEnd;
- {-move the caret to the end of the field}
-begin
- efHPos := StrLen(efEditSt);
-end;
-
-procedure TOvcBaseEntryField.efCaretToStart;
- {-move the caret to the beginning of the field}
-begin
- efHPos := 0;
- efHOffset := 0;
-end;
-
-procedure TOvcBaseEntryField.efChangeMask(Mask : PAnsiChar);
- {-change the picture mask}
-var
- Buf : array[0..MaxEditLen] of Byte;
-begin
- if (Mask <> nil) and (Mask^ <> #0) then begin
- if csLoading in ComponentState then begin
- {change the mask}
- StrLCopy(efPicture, Mask, MaxPicture);
- efPicLen := StrLen(efPicture);
- end else begin
- {save the current field value in tmp buffer}
- efTransfer(@Buf, otf_GetData);
-
- {change the mask}
- StrLCopy(efPicture, Mask, MaxPicture);
- efPicLen := StrLen(efPicture);
-
- {reset the field to its former value}
- efTransfer(@Buf, otf_SetData);
- end;
- end;
-end;
-
-function TOvcBaseEntryField.efCharOK(PicChar : AnsiChar; var Ch : AnsiChar;
- PrevCh : AnsiChar; Fix : Boolean) : Boolean;
- {-return True if Ch is in character set corresponding to PicChar}
-begin
- if Ch = #0 then begin
- Result := False;
- Exit;
- end;
-
- if Fix then
- efFixCase(PicChar, Ch, PrevCh);
-
- {assume it's OK}
- Result := True;
-
- case PicChar of
- pmAnyChar, pmForceUpper, pmForceLower, pmForceMixed :
- ;
- pmMonthName, pmMonthNameU, pmAlpha, pmUpperAlpha, pmLowerAlpha :
- Result := Ch in AlphaCharSet;
- pmDecimal :
- Result := Ch in RealCharSet;
- pmWhole :
- Result := (Ch = '-') or (Ch in IntegerCharSet);
- pmMonth, pmMonthU, pmDay, pmDayU, pmYear,
- pmHour, pmHourU, pmSecond, pmSecondU,
- pmPositive :
- Result := Ch in IntegerCharSet;
- pmHexadecimal :
- case Ch of
- 'A'..'F' : ;
- else
- Result := Ch in IntegerCharSet;
- end;
- pmOctal :
- case Ch of
- '0'..'7', ' ' : ;
- else
- Result := False;
- end;
- pmBinary :
- case Ch of
- '0', '1', ' ' : ;
- else
- Result := False;
- end;
- pmAmPm : {};
- pmTrueFalse :
- Result := (Ch = FIntlSup.TrueChar) or (Ch = FIntlSup.FalseChar);
- pmYesNo :
- Result := (Ch = FIntlSup.YesChar) or (Ch = FIntlSup.NoChar);
- pmScientific :
- case Ch of
- '+', 'E' : ;
- else
- Result := Ch in RealCharSet;
- end;
- pmUser1..pmUser8 :
- Result := Ch in UserData.UserCharSet[PicChar];
- end;
-end;
-
-procedure TOvcBaseEntryField.efConditionalBeep;
-begin
- if (efoBeepOnError in Controller.EntryOptions) then
- MessageBeep(0);
-end;
-
-procedure TOvcBaseEntryField.efCopyPrim;
-var
- Size : Word;
- H : THandle;
- GP : PAnsiChar;
- I : Word;
- T : TEditString;
-
-begin
- Size := efSelEnd-efSelStart;
- if Size > 0 then begin
- {allocate global memory block}
- H := GlobalAlloc(GHND, Size+1);
- if H = 0 then
- Exit;
-
- {copy selected text to global memory block}
- GP := GlobalLock(H);
- efGetDisplayString(T, MaxEditLen);
- StrStCopy(GP, T, efSelStart, Size);
-
- {remove control characters}
- for I := efSelStart to efSelEnd-1 do
- case efEditSt[I] of
- #1..#31 : GP[I-efSelStart] := efEditSt[I];
- end;
-
- GlobalUnlock(H);
-
- {give the handle to the clipboard}
-{$IFNDEF LCL}
- Clipboard.SetAsHandle(CF_TEXT, H);
-{$ENDIF}
- end;
-end;
-
-function TOvcBaseEntryField.efEditBegin : Word;
- {-return offset of first editable position in field}
-begin
- Result := 0;
-end;
-
-function TOvcBaseEntryField.efFieldIsEmpty : Boolean;
- {-return True if the field is empty}
-var
- P : PAnsiChar;
-begin
- P := efEditSt;
- while P^ = ' ' do
- Inc(P);
- Result := (P^ = #0);
-end;
-
-procedure TOvcBaseEntryField.efFieldModified;
- {-mark the field as modified; call notify event}
-begin
- Include(sefOptions, sefModified);
- Include(sefOptions, sefEverModified);
- DoOnChange;
-end;
-
-procedure TOvcBaseEntryField.efFindCtrlChars(P : PAnsiChar; var ChCnt, CtCnt : Integer);
- {-find control caracters and return normal and control char counts}
-const
- Space = ' ';
-var
- I : Integer;
-begin
- ChCnt := 0;
- CtCnt := 0;
- I := 0;
- {count "normal" characters}
- while (I < LongInt(StrLen(P))) and (P[I] >= Space) do begin
- Inc(ChCnt);
- Inc(I);
- end;
- {count "control" characters}
- while (I < LongInt(StrLen(P))) and (P[I] < Space) do begin
- Inc(CtCnt);
- Inc(I);
- end;
-end;
-
-procedure TOvcBaseEntryField.efFixCase(PicChar : AnsiChar; var Ch : AnsiChar; PrevCh : AnsiChar);
- {-fix the case of Ch based on PicChar}
-begin
- case PicChar of
- pmMonthNameU, pmForceUpper, pmUpperAlpha, pmTrueFalse,
- pmYesNo, pmScientific, pmHexadecimal :
- Ch := UpCaseChar(Ch);
- pmForceLower, pmLowerAlpha :
- Ch := LoCaseChar(Ch);
- pmForceMixed :
- case PrevCh of
- ' ', '-' :
- Ch := UpCaseChar(Ch);
- end;
- pmAmPm : ;
- pmUser1..pmUser8 :
- case UserData.ForceCase[PicChar] of
- mcUpperCase :
- Ch := UpCaseChar(Ch);
- mcLowerCase :
- Ch := LoCaseChar(Ch);
- mcMixedCase :
- case PrevCh of
- ' ', '-' :
- Ch := UpCaseChar(Ch);
- end;
- end;
- end;
-end;
-
-function TOvcBaseEntryField.efGetDisplayString(Dest : PAnsiChar; Size : Word) : PAnsiChar;
- {-return the display string in Dest and a pointer as the result}
-var
- Len : Word;
- Value : Double;
- Code : Integer;
- S : string;
-begin
- FillChar(Dest^, Size, #0);
- efMapControlChars(Dest, efEditSt);
-
- {see if zero values should be displayed}
- if efIsNumericType and not (sefHaveFocus in sefOptions) then begin
- if (ZeroDisplay = zdHide) or
- ((ZeroDisplay = zdHideUntilModified) and not EverModified) then begin
- S := Trim(GetStrippedEditString);
- Val(S, Value, Code);
- if (Value = ZeroDisplayValue) and (Code = 0) then begin
- Len := StrLen(Dest);
- if Len > 0 then
- FillChar(Dest^, Len, ' ');
- end;
- end;
- end;
-
- Result := Dest;
-end;
-
-function TOvcBaseEntryField.efGetMousePos(MPos : Integer) : Integer;
- {-get the position of a mouse click}
-var
- I : Integer;
- Len : Integer;
- Ex : Integer;
- Pos : Integer;
- S : PAnsiChar;
- Metrics : TTextMetric;
- TmpSt : TEditString;
- Done : Boolean;
- SLen : Integer;
- X : Integer;
- LMargin : Integer;
-begin
- LMargin := TextMargin;
- if (MPos < 0) and (efHOffset > 0) then begin
- GetTextMetrics(Canvas.Handle, Metrics);
- I := (Abs(MPos)+Metrics.tmAveCharWidth) div Metrics.tmAveCharWidth;
- Dec(efHOffset, I);
- if efHOffset < 0 then
- efHOffset := 0;
- end;
-
- {get a copy of the display string}
- efGetDisplayString(TmpSt, MaxEditLen);
- Len := StrLen(TmpSt);
-
- if efHOffset > Len then
- I := Len
- else
- I := efHOffset;
- S := @TmpSt[I];
-
- if efRightAlignActive then begin
- if (Assigned(FBorders)) then begin
- if (FBorders.RightBorder.Enabled) then
- LMargin := LMargin + FBorders.RightBorder.PenWidth;
- end;
- MPos := ClientWidth-LMargin-1-MPos;
-
- Pos := Len + 1;
- I := 0;
- end else begin
- if (Assigned(FBorders)) then begin
- if (FBorders.LeftBorder.Enabled) then
- LMargin := LMargin + FBorders.LeftBorder.PenWidth;
- end;
- MPos := MPos - LMargin+1;
- Pos := 0;
- end;
-
- repeat
- if efRightAlignActive then begin
- Dec(Pos);
- S := @TmpSt[Pos-1];
- SLen := Len - Pos + 1;
- end else begin
- Inc(Pos);
- SLen := Pos;
- end;
- Ex := efGetTextExtent(S, SLen);
- X := (efGetTextExtent(@S[SLen-1], 1) div 2);
- if efRightAlignActive then
- Done := (Ex+X > MPos) or (I+Pos < 1)
- else
- Done := (Ex-X > MPos) or (I+Pos > Len);
- until Done;
-
- Result := I+(Pos-1);
- if Result < 0 then
- Result := 0;
-
- if efRightAlignActive then begin
- if MPos < 1 then
- Result := I+Pos;
- end;
-end;
-
-procedure TOvcBaseEntryField.efGetSampleDisplayData(T : PAnsiChar);
- {-return sample data for the current field type}
-var
- Buf : TEditString;
- I : Integer;
-begin
- {return the picture mask for the sample display data}
- StrLCopy(Buf, efPicture, MaxLength);
- if efFieldClass = fcSimple then begin
- for I := 1 to MaxLength-1 do
- Buf[I] := Buf[I-1];
- Buf[MaxLength] := #0;
- end;
- StrLCopy(T, Buf, MaxLength);
-end;
-
-function TOvcBaseEntryField.efGetTextExtent(S : PChar; Len : Integer) : Word;
-var
- Size : TSize;
-begin
-// Apparent TurboPower bug: sometimes Len is 1 when string is blank.
-// Probably meaningless width returned in that case.
-// Could also return width of "x" if a non-zero width is assumed
-// by calling code.
- if Length(S) = 0 then
- begin
- Result := 0;
- Exit;
- end;
- GetTextExtentPoint32(Canvas.Handle, S, Len, Size);
- Result := Size.cX;
-end;
-
-
-
-procedure TOvcBaseEntryField.efBorderChanged(ABorder : TObject);
-begin
- if (FBorders.BottomBorder.Enabled) or
- (FBorders.LeftBorder.Enabled) or
- (FBorders.RightBorder.Enabled) or
- (FBorders.TopBorder.Enabled) then begin
- BorderStyle := bsNone;
- Ctl3D := False;
- end else begin
- BorderStyle := bsSingle;
- Ctl3D := True;
- end;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
-end;
-
-
-
-procedure TOvcBaseEntryField.efCalcTopMargin;
-begin
- if HandleAllocated then
- efTopMargin := GetTopTextMargin(Font, BorderStyle, Height, Ctl3D)
- else
- efTopMargin := 0;
-
- if (Assigned(FBorders)) then begin
- if (FBorders.TopBorder.Enabled) then
- efTopMargin := efTopMargin + FBorders.TopBorder.PenWidth;
- end;
-end;
-
-procedure TOvcBaseEntryField.efColorChanged(AColor : TObject);
-begin
- Repaint;
-end;
-
-procedure TOvcBaseEntryField.efInitializeDataSize;
-begin
- case efDataType mod fcpDivisor of
- fsubString :
- begin
- efDataSize := MaxLength+1;
- {handle special data size cases}
- if efDataType = fidPictureString then
- if (efoStripLiterals in Options) then
- efDataSize := efCalcDataSize(efPicture, MaxLength);
- end;
-
- fsubChar : efDataSize := SizeOf(AnsiChar);
- fsubBoolean : efDataSize := SizeOf(Boolean);
- fsubYesNo : efDataSize := SizeOf(Boolean);
- fsubLongInt : efDataSize := SizeOf(LongInt);
- fsubWord : efDataSize := SizeOf(Word);
- fsubInteger : efDataSize := SizeOf(SmallInt);
- fsubByte : efDataSize := SizeOf(Byte);
- fsubShortInt : efDataSize := SizeOf(ShortInt);
- fsubReal : efDataSize := SizeOf(Real);
- fsubExtended : efDataSize := SizeOf(Extended);
- fsubDouble : efDataSize := SizeOf(Double);
- fsubSingle : efDataSize := SizeOf(Single);
- fsubComp : efDataSize := SizeOf(Comp);
- fsubDate : efDataSize := SizeOf(TStDate);
- fsubTime : efDataSize := SizeOf(TStTime);
- else
- efDataSize := 0;
- end;
-end;
-
-function TOvcBaseEntryField.efIsNumericType : Boolean;
- {-return True if field is of a numeric type}
-begin
- case efDataType mod fcpDivisor of
- fsubLongInt, fsubWord, fsubInteger, fsubByte,
- fsubShortInt, fsubReal, fsubExtended, fsubDouble,
- fsubSingle, fsubComp :
- Result := True;
- else
- Result := False;
- end;
-end;
-
-function TOvcBaseEntryField.efIsReadOnly : Boolean;
- {-return True if field is read-only}
-begin
- Result := efoReadOnly in Options;
-end;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
-function TOvcBaseEntryField.efIsSibling(HW : TOvcHWnd{hWnd}) : Boolean;
- {-is the window HW one of our siblings}
-var
- C : TWinControl;
- H : hWnd;
-begin
- Result := False;
- if HW = 0 then
- Exit;
-
- C := FindControl(HW);
-
- {see if this window is a child of one of our siblings}
- if not Assigned(C) then begin
- H := GetParent(HW);
- if H > 0 then
- C := FindControl(H);
- end;
-
- if Assigned(C) then
- {$IFDEF VERSION5}
- if (GetImmediateParentForm(C) = GetImmediateParentForm(Self)) then
- {$ELSE}
- if GetParentForm(C) = GetParentForm(Self) then
- {$ENDIF}
- Result := True;
-end;
-
-procedure TOvcBaseEntryField.efLong2Str(P : PAnsiChar; L : LongInt);
- {-convert a longint to a string}
-var
- W : Word;
- S : array[0..32] of AnsiChar;
- St : string[32];
-begin
- W := efDataSize * 2;
- if sefHexadecimal in sefOptions then begin
- HexLPChar(S, L);
- if W < 8 then
- StrStDeletePrim(S, 0, 8-W);
- end else if sefOctal in sefOptions then begin
- OctalLPChar(S, L);
- if W < 8 then
- StrStDeletePrim(S, 0, 12-(W*2));
- end else if sefBinary in sefOptions then begin
- BinaryLPChar(S, L);
- if W < 8 then
- StrStDeletePrim(S, 0, 32-(W*4));
- end else if L = 0 then begin
- S[0] := '0';
- S[1] := #0;
- end else begin
- Str(L, St);
- StrPCopy(S, St);
- end;
- StrCopy(P, S);
-end;
-
-procedure TOvcBaseEntryField.efMapControlChars(Dest, Src : PAnsiChar);
- {-copy from Src to Dest, mapping control characters to alpha in process}
-var
- I : Integer;
-begin
- StrCopy(Dest, Src);
- if (StrLen(Dest) > 0) then begin
- for I := 0 to StrLen(Dest)-1 do
- if Dest[I] < ' ' then
- Dest[I] := AnsiChar(Byte(Dest[I])+64);
- end;
-end;
-
-procedure TOvcBaseEntryField.efMoveFocus(C : TWinControl);
- {-ask the controller to move the focus to the specified control}
-begin
-{$IFNDEF LCL}
- PostMessage(Controller.Handle, om_SetFocus, 0, LongInt(C));
-{$ELSE}
- Controller.PostMessage(Controller.Handle, om_SetFocus, 0, LPARAM(C)); //64
-{$ENDIF}
-end;
-
-procedure TOvcBaseEntryField.efMoveFocusToNextField;
- {-give next field the focus}
-var
- PF : TForm;
-begin
- PF := TForm(GetParentForm(Self));
- if not Assigned(PF) then
- Exit;
-
-{$IFNDEF LCL}
- PostMessage(PF.Handle, WM_NEXTDLGCTL, 0, 0);
-{$ELSE} //WM_NEXTDLGCTL message apparently not handled by LCL TForm
- Self.PerformTab(True);
-{$ENDIF}
-end;
-
-procedure TOvcBaseEntryField.efMoveFocusToPrevField;
- {-give previous field the focus}
-var
- PF : TForm;
-begin
- PF := TForm(GetParentForm(Self));
- if not Assigned(PF) then
- Exit;
-
-{$IFNDEF LCL}
- PostMessage(PF.Handle, WM_NEXTDLGCTL, 1, 0);
-{$ELSE} //WM_NEXTDLGCTL message apparently not handled by LCL TForm
- Self.PerformTab(False);
-{$ENDIF}
-end;
-
-function TOvcBaseEntryField.efNthMaskChar(N : Word) : AnsiChar;
- {-return the N'th character in the picture mask. N is 0-based}
-begin
- if N >= efPicLen then
- Result := efPicture[efPicLen-1]
- else
- Result := efPicture[N];
-end;
-
-function TOvcBaseEntryField.efOctStr2Long(St : PAnsiChar; var L : LongInt) : Boolean;
- {-convert an octal string to a longint}
-var
- I : Word;
-begin
- Result := True;
- L := 0;
- for I := 0 to StrLen(St)-1 do begin
- {are we going to loose any of the top 3 bits}
- if (L and $E0000000) <> 0 then
- Result := False;
- L := L shl 3;
- L := L or (Ord(St[I]) - Ord('0'));
- end;
-end;
-
-{ - Hdc changed to TOvcHdc for BCB Compatibility }
-procedure TOvcBaseEntryField.efPaintPrim(DC : TOvcHdc{Hdc};
- ARect : TRect; Offset : Integer);
- {-primitive routine to draw the entry field control}
-var
- X, Y : Integer;
- ChCnt : Integer;
- CtCnt : Integer;
- HStart : Integer;
- HEnd : Integer;
- OldBKMode : Integer;
- RTC, HTC : LongInt;
- RBC, HBC : LongInt;
- CtlClr : LongInt;
- SA, SD : PAnsiChar;
- T : TEditString;
- LMargin : Integer;
-// I : Integer;
-
- procedure Display(Count : Word; TC, BC : LongInt);
- begin
- if (Count <> 0) and (X < ARect.Right) then begin
- SetTextColor(DC, TC);
- SetBkColor(DC, BC);
- ExtTextOut(DC, X, Y, ETO_CLIPPED, @ARect, SD, Count, nil);
- end;
-
- if (Count <> 0) then begin
- {adjust X coordinate}
- Inc(X, efGetTextExtent(SD, Count));
-
- {advance string pointers}
- Inc(SD, Count);
- Inc(SA, Count);
-
- {adjust highlight indices}
- Dec(HStart, Count);
- if HStart < 0 then
- HStart := 0;
- Dec(HEnd, Count);
- if HEnd <= HStart then
- HEnd := 0;
- end;
- end;
-
- procedure DisplayPrim(Count : Word; TC, HC : LongInt);
- var
- SubCnt : Word;
- Buf : TEditString;
- begin
- if (Count > 0) and (efFieldClass = fcNumeric) then begin
- StrCopy(Buf, SD);
-
- {remove leading and trailing spaces}
- TrimAllSpacesPChar(Buf);
- SubCnt := StrLen(Buf);
- if HStart < HEnd then begin
- SetTextColor(DC, HTC);
- SetBkColor(DC, HBC)
- end else begin
- SetTextColor(DC, RTC);
- SetBkColor(DC, RBC);
- end;
-
- {set right alignment}
- SetTextAlign(DC, TA_RIGHT);
-
-
- {paint the text right aligned}
- ExtTextOut(DC, X, Y, ETO_CLIPPED, @ARect, Buf, SubCnt, nil);
- Exit;
- end;
-
- if (HStart = 0) and (HEnd > 0) then begin
- SubCnt := HEnd-HStart;
- if SubCnt > Count then
- SubCnt := Count;
-
- {highlighted chars}
- OldBKMode := SetBkMode(DC, OPAQUE);
- Display(SubCnt, HC, HBC);
- SetBkMode(DC, OldBkMode);
- end else begin
- if HStart > 0 then begin
- SubCnt := HStart;
- if SubCnt > Count then
- SubCnt := Count;
- end else
- SubCnt := Count;
- Display(SubCnt, TC, RBC);
- end;
-
- {do we need to recurse?}
- Dec(Count, SubCnt);
- if Count > 0 then
- DisplayPrim(Count, TC, HC);
- end;
-
-begin
- {select the font into our painting DC}
- SelectObject(DC, Font.Handle);
- SetBkColor(DC, Graphics.ColorToRGB(Color));
- SetTextColor(DC, Graphics.ColorToRGB(Font.Color));
-
- {display samples of appropriate data while designing}
- if csDesigning in ComponentState then begin
- efGetSampleDisplayData(T);
- SD := @T[0];
- end else begin
- {get the display version of the string}
- efGetDisplayString(T, MaxEditLen);
- SD := @T[Offset];
- end;
-
- {point to the starting point of the string}
- SA := @efEditSt[Offset];
-
- {determine highlighted portion of the string}
- if not (sefHaveFocus in sefOptions) then begin
- HStart := 0;
- HEnd := 0;
- end else begin
- HStart := efSelStart-Offset;
- HEnd := efSelEnd-Offset;
- if HStart < 0 then
- HStart := 0;
- if HEnd <= HStart then
- HEnd := 0;
- end;
-
- {get text colors to use}
- if IsValid then begin
- RTC := GetTextColor(DC);
- RBC := GetBkColor(DC);
- end else begin
- RTC := Graphics.ColorToRGB(FEFColors.Error.TextColor);
- RBC := Graphics.ColorToRGB(FEFColors.Error.BackColor);
- end;
-
- {fill in the background}
- if not Enabled then
- Canvas.Brush.Color := FEFColors.Disabled.BackColor
- else if IsValid then
- Canvas.Brush.Color := Color
- else
- Canvas.Brush.Color := FEFColors.Error.BackColor;
-
- OldBkMode := SetBkMode(DC, TRANSPARENT);
- FillRect(DC, ARect, Canvas.Brush.Handle);
- SetBkMode(DC, OldBkMode);
-
- if csDesigning in ComponentState then begin
- {no highlights if we're designing}
- HStart := 0;
- HEnd := 0;
- end else if not Enabled then begin
- {no highlights}
- HStart := 0;
- HEnd := 0;
- RTC := Graphics.ColorToRGB(FEFColors.Disabled.TextColor);
- RBC := Graphics.ColorToRGB(FEFColors.Disabled.BackColor);
- end;
-
- if csDesigning in ComponentState then begin
- ChCnt := StrLen(T);
- CtCnt := 0;
- end else
- {count characters (use actual string, SA, not display string, SD)}
- efFindCtrlChars(SA, ChCnt, CtCnt);
-
- LMargin := FTextMargin;
- if (efFieldClass = fcNumeric) then begin
- if (Assigned(FBorders)) then begin
- if (FBorders.RightBorder.Enabled) then
- LMargin := LMargin + FBorders.RightBorder.PenWidth;
- end;
- X := ClientWidth-LMargin-1;
-
- end else begin
- efRightAlignActive := efoRightAlign in Options;
- if efRightAlignActive then begin
- if (Assigned(FBorders)) then begin
- if (FBorders.RightBorder.Enabled) then
- LMargin := LMargin + FBorders.RightBorder.PenWidth;
- end;
- X := efGetTextExtent(SD, StrLen(SD));
- if X >= ClientWidth-LMargin-1 then begin
-(*
-!!.04 - This is a classic bad idea. It royally messes stuff up.
- {the display string doesn't fit in the client area, so strip all }
- {padding. }
- while SD[0] = PadChar do begin
- for I := 0 to Length(SD) - 1 do
- SD[i] := SD[i + 1];
- end;
- ChCnt := Length(SD);
- efRightAlignActive := False;
-*)
- X := LMargin-1;
- end else
- X := ClientWidth-X-LMargin-1;
- end else begin
- if (Assigned(FBorders)) then begin
- if (FBorders.LeftBorder.Enabled) then
- LMargin := LMargin + Borders.LeftBorder.PenWidth;
- end;
-(*
-!!.04 - This is a classic bad idea. It royally messes stuff up.
- {the display string doesn't fit in the client area, so strip any }
- {padding away so that the important stuff can show }
- X := efGetTextExtent(SD, StrLen(SD));
- if X >= ClientWidth-LMargin-1 then
- if efoTrimBlanks in Options then
- while SD[0] = PadChar do begin
- for I := 0 to Length(SD) - 1 do
- SD[i] := SD[i + 1];
- end;
- ChCnt := Length(SD);
-*)
- X := LMargin-1;
- end;
- end;
-
- Y := efTopMargin;
-
- {convert TColor values to RGB values}
- CtlClr := Graphics.ColorToRGB(FCtrlColor);
- HTC := Graphics.ColorToRGB(FEFColors.Highlight.TextColor);
- HBC := Graphics.ColorToRGB(FEFColors.Highlight.BackColor);
-
- {display loop}
- while (ChCnt or CtCnt) <> 0 do begin
- {display regular characters}
- if ChCnt > 0 then
- DisplayPrim(ChCnt, RTC, HTC);
-
- {display control characters}
- if CtCnt > 0 then
- DisplayPrim(CtCnt, CtlClr, CtlClr);
-
- {check for more characters}
- if CtCnt = 0 then
- ChCnt := 0
- else
- efFindCtrlChars(SA, ChCnt, CtCnt);
- end;
-end;
-
-procedure TOvcBaseEntryField.efPerformEdit(var Msg : TMessage; Cmd : Word);
- {-process the specified editing command if appropriate}
-begin
- HandleNeeded;
- if not HandleAllocated then
- Exit;
-
- {the null character implies that the this key should be}
- {ignored. the only way for the null character to get here}
- {is by changing a key after it has been entered , probably}
- {in a key preview event handler}
- if (Cmd = ccChar) and (AnsiChar(Lo(Msg.wParam)) = #0) then
- Exit;
-
- {filter out commands that are inappropriate in read-only mode}
- if efIsReadOnly then begin
- case Cmd of
- ccChar, ccCtrlChar, ccRestore, ccBack, ccDel, ccDelEol,
- ccDelBol, ccDelLine, ccDelWord, ccCut, ccPaste,
- ccInc, ccDec :
- begin
- efConditionalBeep;
- Exit;
- end;
- end;
- end;
-
- {do user command notification for user commands}
- if Cmd >= ccUserFirst then begin
- DoOnUserCommand(Cmd);
- Cmd := ccSuppress;
- end;
-
- {allow descendant classes to perform edit processing}
- efEdit(Msg, Cmd);
-end;
-
-procedure TOvcBaseEntryField.efPerformRepaint(Modified : Boolean);
- {-flag the field as modified and redraw it}
-begin
- if Modified then
- efFieldModified;
- Refresh;
-end;
-
-procedure TOvcBaseEntryField.efPerformPreEditNotify(C : TWinControl);
- {-pre-edit notification to parent form}
-begin
- Controller.DoOnPreEdit(Self, C);
-end;
-
-procedure TOvcBaseEntryField.efPerformPostEditNotify(C : TWinControl);
- {-post-edit notification to parent form}
-begin
- Controller.DoOnPostEdit(Self, C);
-end;
-
-function TOvcBaseEntryField.efPositionCaret(Adjust : Boolean) : Boolean;
- {-position the editing caret}
-var
- Delta : Word;
- S : PAnsiChar;
- OK : Boolean;
- Metrics : TTextMetric;
- CW : Integer;
- Pos : TPoint;
- T : TEditString;
- SLen : Integer;
- LMargin : Integer;
-begin
- Result := False;
- if not (sefHaveFocus in sefOptions) then
- Exit;
-
- if Adjust then begin
- {when a character is entered that erases the existing text,
- efHPos may be 1 greater than EditBegin because of the
- entered character}
- if ((efHPos = efEditBegin) or (efHPos = efEditBegin+1)) and
- (efHOffset <> 0) then begin
- efHOffset := 0;
- Result := True;
- end else if (efHPos < efHOffset) then begin
- efHOffset := efHPos;
- Result := True;
- end;
- end;
-
- efGetDisplayString(T, MaxEditLen);
-
- efRightAlignActive := efoRightAlign in Options;
- if efRightAlignActive then begin
- Delta := efGetTextExtent(T, StrLen(T));
- if Delta >= ClientWidth-FTextMargin-1 then begin
- {the display string doesn't fit in the client area, it is displayed left aligned}
- efRightAlignActive := False;
- end else begin
- efRightAlignActive := True;
- efHOffset := 0;
- end;
- end;
-
- repeat
- if not efRightAlignActive then begin
- S := @T[efHOffset];
- end else begin
- S := @T[efHPos];
- end;
-
- SLen := StrLen(S);
- if (efHPos = efHOffset) and not efRightAlignActive then
- Delta := 0
- else begin
- if not efRightAlignActive then
- Delta := efGetTextExtent(S, efHPos-efHOffset)
- else
- Delta := efGetTextExtent(S, SLen);
- end;
-
- OK := (Delta < ClientWidth-FTextMargin-1) or
- (sefNumeric in sefOptions) or not Adjust;
- if not OK then begin
- if efHOffset >= efHPos then
- OK := True
- else begin
- Inc(efHOffset);
- Result := True;
- end;
- end;
- until OK;
-
- {get metrics for current font}
- GetTextMetrics(Canvas.Handle, Metrics);
-
- {get character width}
- CW := efGetTextExtent(@T[efHPos], 1);
-
- {set caret cell height and width}
- efCaret.CellHeight := Metrics.tmHeight;
- efCaret.CellWidth := CW;
-
- {adjust caret position if using a wide cursor}
- if (efCaret.CaretType.Shape in [csBlock, csHalfBlock, csHorzLine]) or
- (efCaret.CaretType.CaretWidth > 4) then
- if efRightAlignActive then
- Dec(Delta)
- else
- Inc(Delta);
-
- {set caret position}
-
- LMargin := FTextMargin;
- if (efFieldClass = fcNumeric) then begin
- if (Assigned(FBorders)) then begin
- if (FBorders.RightBorder.Enabled) then
- LMargin := LMargin + FBorders.RightBorder.PenWidth;
- end;
- Pos.X := ClientWidth-LMargin-1;
- end else begin
- if efRightAlignActive then begin
- if (Assigned(FBorders)) then begin
- if (FBorders.RightBorder.Enabled) then
- LMargin := LMargin + FBorders.RightBorder.PenWidth;
- end;
- Pos.X := ClientWidth - Succ(Delta) - LMargin - 1;
- end else begin
- if (Assigned(FBorders)) then begin
- if (FBorders.LeftBorder.Enabled) then
- LMargin := LMargin + FBorders.LeftBorder.PenWidth;
- end;
- Pos.X := Succ(Delta) + LMargin - 3;
- end;
- end;
-
- Pos.Y := efTopMargin;
- if Pos.Y < 0 then
- Pos.Y := 0;
-
- efCaret.Position := Pos;
-end;
-
-function TOvcBaseEntryField.efRangeToStRange(const Value : TRangeType) : string;
- {-returns the range as a string}
-var
- D : Byte;
- Ex : Extended;
- Buf : TEditString;
- DateMask : string[MaxDateLen];
- TimeMask : string[MaxDateLen];
-
- function GetDecimalPlaces : Byte;
- var
- I : Cardinal;
- DotPos : Cardinal;
- begin
- if not StrChPos(efPicture, pmDecimalPt, DotPos) then
- Result := DecimalPlaces
- else begin
- Result := 0;
- for I := DotPos+1 to MaxLength-1 do
- if efNthMaskChar(I) in PictureChars then
- Inc(Result)
- else
- Break;
- end;
- end;
-
- function ExtendedToString(E : Extended; DP : Byte) : string;
- label
- UseScientificNotation;
- var
- I : Cardinal;
- S : TEditString;
- begin
- if StrScan(efPicture, pmScientific) <> nil then
- goto UseScientificNotation;
-
- {try to use regular notation}
- Str(E:0:DP, S);
-
- {trim trailing 0's if appropriate}
- if StrScan(S, pmDecimalPt) <> nil then
- TrimTrailingZerosPChar(S);
-
- {does it fit?}
- if StrLen(S) > MaxLength then begin
- {won't fit--use scientific notation}
- UseScientificNotation:
- if (DP > 0) and (9+DP < MaxLength) then
- Str(E:9+DP, S)
- else
- Str(E:MaxLength, S);
- TrimAllSpacesPChar(S);
- TrimEmbeddedZerosPChar(S);
- end;
-
- {convert decimal point}
- if StrChPos(S, pmDecimalPt, I) then
- S[I] := IntlSupport.DecimalChar;
- Result := StrPas(S);
- end;
-
-begin
- Result := '';
- D := GetDecimalPlaces;
- case efDataType mod fcpDivisor of
- fsubString : {};
- fsubBoolean, fsubYesNo : {};
- fsubChar :
- if Value.rtChar <= ' ' then begin
- Str(Ord(Value.rtChar), Result);
- Result := '#' + Result;
- end else
- Result := Value.rtChar;
- fsubLongInt, fsubInteger, fsubShortInt, fsubWord, fsubByte :
- begin
- efLong2Str(Buf, Value.rtLong);
- Result := StrPas(Buf);
- end;
- fsubReal :
- begin
- Ex := Value.rtReal;
- Result := ExtendedToString(Ex, D);
- end;
- fsubExtended, fsubDouble, fsubSingle, fsubComp :
- Result := ExtendedToString(Value.rtExt, D);
- fsubDate :
- begin
- DateMask := OvcIntlSup.InternationalDate(True);
- if Value.rtDate = BadDate then
- Result := ''
- else
- Result := OvcIntlSup.DateToDateString(DateMask, Value.rtDate, False);
- end;
- fsubTime :
- begin
- TimeMask := OvcIntlSup.InternationalTime(False);
- if Value.rtTime = BadTime then
- Result := ''
- else
- Result := OvcIntlSup.TimeToTimeString(TimeMask, Value.rtTime, False);
- end;
- end;
-end;
-
-procedure TOvcBaseEntryField.efRemoveBadOptions;
- {-remove inappropriate options for this field and data type}
-begin
- if csLoading in ComponentState then
- Exit;
-
- case efFieldClass of
- fcSimple :
- case efDataType mod fcpDivisor of
- fsubString :
- begin
- Exclude(FOptions, efoRightJustify);
- Exclude(FOptions, efoStripLiterals);
- end;
- fsubChar, fsubBoolean, fsubYesNo :
- begin
- Exclude(FOptions, efoCaretToEnd);
- Exclude(FOptions, efoForceInsert);
- Exclude(FOptions, efoTrimBlanks);
- Exclude(FOptions, efoRightJustify);
- Exclude(FOptions, efoStripLiterals);
- end;
- fsubLongInt, fsubWord, fsubInteger, fsubByte,
- fsubShortInt, fsubReal, fsubExtended, fsubDouble,
- fsubSingle, fsubComp :
- begin
- Exclude(FOptions, efoTrimBlanks);
- Exclude(FOptions, efoRightJustify);
- Exclude(FOptions, efoStripLiterals);
- end;
- end;
- fcPicture :
- case efDataType mod fcpDivisor of
- fsubString : {};
- fsubChar, fsubBoolean, fsubYesNo :
- begin
- Exclude(FOptions, efoCaretToEnd);
- Exclude(FOptions, efoForceInsert);
- Exclude(FOptions, efoTrimBlanks);
- Exclude(FOptions, efoRightJustify);
- Exclude(FOptions, efoStripLiterals);
- end;
- fsubLongInt, fsubWord, fsubInteger, fsubByte,
- fsubShortInt, fsubReal, fsubExtended, fsubDouble,
- fsubSingle, fsubComp :
- begin
- Exclude(FOptions, efoTrimBlanks);
- Exclude(FOptions, efoStripLiterals);
- end;
- fsubDate, fsubTime :
- begin
- Exclude(FOptions, efoTrimBlanks);
- Exclude(FOptions, efoRightJustify);
- Exclude(FOptions, efoStripLiterals);
- end;
- end;
- fcNumeric :
- begin
- Exclude(FOptions, efoCaretToEnd);
- Exclude(FOptions, efoForceInsert);
- Exclude(FOptions, efoTrimBlanks);
- Exclude(FOptions, efoRightJustify);
- Exclude(FOptions, efoStripLiterals);
- Exclude(FOptions, efoRightAlign);
- end;
- end;
-
- {if input is required then these fields must also be uninitialized}
- if (csDesigning in ComponentState) and (efoInputRequired in Options) then
- case efDataType mod fcpDivisor of
- fsubChar, fsubBoolean, fsubYesNo, fsubLongInt,
- fsubWord, fsubInteger, fsubByte, fsubShortInt,
- fsubReal, fsubExtended, fsubDouble, fsubSingle,
- fsubComp : FUninitialized := True;
- end;
-end;
-
-procedure TOvcBaseEntryField.efResetCaret;
- {-move the caret to the beginning or end of the field, as appropriate}
-begin
- if (efoCaretToEnd in FOptions) then
- efCaretToEnd
- else
- efCaretToStart;
-end;
-
-procedure TOvcBaseEntryField.efSaveEditString;
- {-save a copy of the edit string}
-begin
- if (efSaveEdit = nil) or (StrLen(efEditSt) <> StrLen(efSaveEdit)) then begin
- if efSaveEdit <> nil then
- StrDispose(efSaveEdit);
- efSaveEdit := StrNew(efEditSt);
- end else
- StrCopy(efSaveEdit, efEditSt);
-end;
-
-procedure TOvcBaseEntryField.efSetCaretPos(Value : Integer);
- {-set position of caret within the field}
-begin
- if not (sefHaveFocus in sefOptions) then
- Exit;
-
- if Value < 0 then
- efHPos := 0
- else if Value > LongInt(StrLen(efEditSt)) then
- efHPos := StrLen(efEditSt)+1
- else
- efHPos := Value;
- efPositionCaret(True);
-end;
-
-procedure TOvcBaseEntryField.efSetDefaultRange(FT : Byte);
- {-set the default range for the given field type FT}
-begin
- efRangeLo := BlankRange;
- efRangeHi := BlankRange;
- case FT mod fcpDivisor of
- fsubString : {};
- fsubBoolean, fsubYesNo : {};
- fsubChar :
- begin
- efRangeLo.rtChar := #32;
- efRangeHi.rtChar := #32;
- end;
- fsubLongInt :
- begin
- efRangeLo.rtLong := Low(LongInt); {80000000}
- efRangeHi.rtLong := High(LongInt); {7FFFFFFF}
- end;
- fsubWord :
- begin
- efRangeLo.rtLong := Low(Word); {0}
- efRangeHi.rtLong := High(Word); {65535}
- end;
- fsubInteger :
- begin
- efRangeLo.rtLong := Low(SmallInt); {-32768}
- efRangeHi.rtLong := High(SmallInt); {+32767}
- end;
- fsubByte :
- begin
- efRangeLo.rtLong := Low(Byte); {0}
- efRangeHi.rtLong := High(Byte); {255}
- end;
- fsubShortInt :
- begin
- efRangeLo.rtLong := Low(ShortInt); {-128}
- efRangeHi.rtLong := High(ShortInt); {127}
- end;
- fsubReal :
- begin
- efRangeLo.rtReal := -1.7e+38;
- efRangeHi.rtReal := +1.7e+38;
- end;
- fsubExtended :
- begin
-{$IFNDEF FPC}
- efRangeLo.rtExt := -1.1e+4932;
- efRangeHi.rtExt := +1.1e+4932;
-{$ELSE}
- {$IFDEF FPC_HAS_TYPE_EXTENDED}
- efRangeLo.rtExt := -1.1e+4932;
- efRangeHi.rtExt := +1.1e+4932;
- {$ELSE} {Extended same as Double on PPC}
- efRangeLo.rtExt := -1.7e+308;
- efRangeHi.rtExt := +1.7e+308;
- {$ENDIF}
-{$ENDIF}
- end;
- fsubDouble :
- begin
- efRangeLo.rtExt := -1.7e+308;
- efRangeHi.rtExt := +1.7e+308;
- end;
- fsubSingle :
- begin
- efRangeLo.rtExt := -3.4e+38;
- efRangeHi.rtExt := +3.4e+38;
- end;
- fsubComp :
- begin
- efRangeLo.rtExt := -9.2e+18;
- efRangeHi.rtExt := +9.2e+18;
- end;
- fsubDate :
- begin
- efRangeLo.rtDate := MinDate;
- efRangeHi.rtDate := MaxDate;
- end;
- fsubTime :
- begin
- efRangeLo.rtTime := MinTime;
- efRangeHi.rtTime := MaxTime;
- end;
- end;
-end;
-
-procedure TOvcBaseEntryField.efSetInitialValue;
- {-set the initial value of the field}
-var
- R : TRangeType;
- FST : Byte;
-begin
- if csDesigning in ComponentState then
- Exit;
-
- R := BlankRange;
- FST := efDataType mod fcpDivisor;
- case FST of
- fsubChar :
- if (' ' >= efRangeLo.rtChar) and (' ' <= efRangeHi.rtChar) then
- R.rtChar := ' '
- else
- R.rtChar := efRangeLo.rtChar;
- fsubLongInt, fsubWord, fsubInteger, fsubByte, fsubShortInt :
- if (0 < efRangeLo.rtLong) or (0 > efRangeHi.rtLong) then
- R.rtLong := efRangeLo.rtLong;
- fsubReal :
- if (0 < efRangeLo.rtReal) or (0 > efRangeHi.rtReal) then
- R.rtReal := efRangeLo.rtReal;
- fsubExtended, fsubDouble, fsubSingle, fsubComp :
- if (0 < efRangeLo.rtExt) or (0 > efRangeHi.rtExt) then
- case FST of
- fsubExtended : R.rtExt := efRangeLo.rtExt;
- fsubDouble : R.rtDbl := efRangeLo.rtExt;
- fsubSingle : R.rtSgl := efRangeLo.rtExt;
- fsubComp : R.rtComp := efRangeLo.rtExt;
- end;
- fsubDate : R.rtDate := BadDate;
- fsubTime : R.rtTime := BadTime;
- end;
- efTransfer(@R, otf_SetData);
-end;
-
-procedure TOvcBaseEntryField.SetName(const Value : TComponentName);
-begin
- inherited SetName(Value);
-
- Repaint;
-end;
-
-procedure TOvcBaseEntryField.SetSelection(Start, Stop : Word);
- {-mark offsets Start..Stop as selected}
-var
- Len : Word;
-begin
- if Start <= Stop then begin
- Len := StrLen(efEditSt);
-
- if Start > Len then
- Start := Len;
- if Stop > Len then
- Stop := Len;
-
- {all or nothing for numeric fields}
- if (efFieldClass = fcNumeric) then
- if (Start <> Stop) then begin
- Start := 0;
- Stop := MaxEditLen;
- end;
-
- efSelStart := Start;
- efSelEnd := Stop;
- end;
-end;
-
-function TOvcBaseEntryField.efStr2Long(P : PAnsiChar; var L : LongInt) : Boolean;
- {-convert a string to a long integer}
-var
- S : TEditString;
-begin
- Result := True;
- StrCopy(S, P);
- TrimAllSpacesPChar(S);
-
- {treat an empty string as 0}
- if StrLen(S) = 0 then begin
- L := 0;
- Exit;
- end;
-
- if sefBinary in sefOptions then
- Result := efBinStr2Long(S, L)
- else if sefOctal in sefOptions then
- Result := efOctStr2Long(S, L)
- else begin
- if (sefHexadecimal in sefOptions) and (S[0] <> #0) then
- if StrPos(S, '$') = nil then
- StrChInsertPrim(S, '$', 0);
-
- {check for special value the Val() doesn't handle correctly}
- if StrComp(S, '-2147483648') = 0 then
- L := LongInt($80000000)
- else
- Result := StrToLongPChar(S, L);
- end;
-end;
-
-function TOvcBaseEntryField.efStRangeToRange(const Value : string; var R : TRangeType) : Boolean;
- {-converts a string range to a RangeType}
-var
- I : Integer;
- Code : Integer;
- fSub : Byte;
- Buf : TEditString;
- DateMask : string[MaxDateLen];
- TimeMask : string[MaxDateLen];
-begin
- Code := 0; {assume success}
- R := BlankRange;
- fSub := efDataType mod fcpDivisor;
- case fSub of
- fsubString : {};
- fsubBoolean, fsubYesNo : {};
- fsubChar :
- if Value = '' then
- R.rtChar := #32
- else if Value[1] = '#' then begin
- Val(Copy(Value, 2, 3), I, Code);
- if Code = 0 then
- R.rtChar := Chr(I)
- else begin
- Code := 0;
- R.rtChar := #32;
- end;
- end else
- R.rtChar := Value[1];
- fsubLongInt, fsubWord, fsubInteger, fsubByte, fsubShortInt :
- begin
- StrPCopy(Buf, Value);
- if not efStr2Long(Buf, R.rtLong) then
- Code := 1
- else if (fSub = fsubWord) and
- ((R.rtLong < Low(Word)) or (R.rtLong > High(Word))) then
- Code := 1
- else if (fSub = fsubInteger) and
- ((R.rtLong < Low(SmallInt)) or (R.rtLong > High(SmallInt))) then
- Code := 1
- else if (fSub = fsubByte) and
- ((R.rtLong < Low(Byte)) or (R.rtLong > High(Byte))) then
- Code := 1
- else if (fSub = fsubShortInt) and
- ((R.rtLong < Low(ShortInt)) or (R.rtLong > High(ShortInt))) then
- Code := 1;
- end;
- fsubReal :
- if Value = '' then
- R.rtReal := 0
- else
- Val(Value, R.rtReal, Code);
- fsubExtended, fsubDouble, fsubSingle, fsubComp :
- begin
- if Value = '' then
- R.rtExt := 0
- else
- Val(Value, R.rtExt, Code);
- if (Code = 0) then begin
- if (fSub = fsubDouble) and ((R.rtExt < -1.7e+308) or (R.rtExt > +1.7e+308)) then
- Code := 1
- else if (fSub = fsubSingle) and ((R.rtExt < -3.4e+38) or (R.rtExt > +3.4e+38)) then
- Code := 1
- else if (fSub = fsubComp) and ((R.rtExt < -9.2e+18) or (R.rtExt > +9.2e+18)) then
- Code := 1;
- end;
- end;
- fsubDate :
- begin
- DateMask := OvcIntlSup.InternationalDate(True);
- if Length(Value) <> Length(DateMask) then
- R.rtDate := BadDate
- else
- R.rtDate := OvcIntlSup.DateStringToDate(DateMask, Value, GetEpoch);
- if R.rtDate = BadDate then
- Code := 1;
- end;
- fsubTime :
- begin
- TimeMask := OvcIntlSup.InternationalTime(False);
- if Length(Value) <> Length(TimeMask) then
- R.rtTime := BadTime
- else
- R.rtTime := OvcIntlSup.TimeStringToTime(TimeMask, Value);
- if R.rtTime = BadTime then
- Code := 1;
- end;
- end;
- Result := Code = 0;
-end;
-
-procedure TOvcBaseEntryField.efReadRangeHi(Stream : TStream);
- {-called to read the high range from the stream}
-begin
- Stream.Read(efRangeHi, SizeOf(TRangeType));
-end;
-
-procedure TOvcBaseEntryField.efReadRangeLo(Stream : TStream);
- {-called to read the low range from the stream}
-begin
- Stream.Read(efRangeLo, SizeOf(TRangeType));
-end;
-
-function TOvcBaseEntryField.efTransfer(DataPtr : Pointer; TransferFlag : Word) : Word;
- {-transfer data to or from the field}
-begin
- if (TransferFlag <> otf_SizeData) and not (csDesigning in ComponentState) then
- Result := efTransferPrim(DataPtr, TransferFlag)
- else
- Result := efDataSize;
- {descendant classes will do the actual transfering of data}
-end;
-
-function TOvcBaseEntryField.efTransferPrim(DataPtr : Pointer; TransferFlag : Word) : Word;
- {-reset for new data in field}
-begin
- Result := efDataSize;
- if TransferFlag = otf_SetData then begin
- if not (sefValidating in sefOptions) then begin
- Exclude(sefOptions, sefRetainPos);
- if sefHaveFocus in sefOptions then begin
- efResetCaret;
- efPositionCaret(True);
-
- {if we are doing a transfer due to a GetValue}
- {validation, don't reset selection}
- if not (sefGettingValue in sefOptions) then
- SetSelection(0, MaxEditLen);
- end else
- Exclude(sefOptions, sefInvalid);
-
- {clear modified flags}
- Exclude(sefOptions, sefModified);
- Exclude(sefOptions, sefEverModified);
-
- Invalidate;
- end;
- end;
-end;
-
-procedure TOvcBaseEntryField.efWriteRangeHi(Stream : TStream);
- {-called to store the high range on the stream}
-begin
- Stream.Write(efRangeHi, SizeOf(TRangeType));
-end;
-
-procedure TOvcBaseEntryField.efWriteRangeLo(Stream : TStream);
- {-called to store the low range on the stream}
-begin
- Stream.Write(efRangeLo, SizeOf(TRangeType));
-end;
-
-procedure TOvcBaseEntryField.EMGetModify(var Msg : TMessage);
-begin
- Msg.Result := 0;
- if sefModified in sefOptions then
- Msg.Result := 1;
-end;
-
-procedure TOvcBaseEntryField.EMGetSel(var Msg : TMessage);
-begin
- {Return this info in Msg as well as in Result}
- with Msg do begin
- if LPDWORD(wParam) <> nil then
- LPDWORD(wParam)^ := efSelStart;
- if LPDWORD(lParam) <> nil then
- LPDWORD(lParam)^ := efSelEnd;
- end;
- Msg.Result := MakeLong(efSelStart, efSelEnd);
-end;
-
-procedure TOvcBaseEntryField.EMSetModify(var Msg : TMessage);
-begin
- if Msg.wParam > 0 then begin
- Include(sefOptions, sefModified);
- Include(sefOptions, sefEverModified);
- end else
- Exclude(sefOptions, sefModified);
-end;
-
-procedure TOvcBaseEntryField.EMSetSel(var Msg : TMessage);
-begin
- with Msg do begin
- if LoWord(LParam) = $FFFF then //64
- SetSelection(0, 0)
- else if (LoWord(LParam) = 0) and (HiWord(LParam) = $FFFF) then //64
- SetSelection(0, MaxEditLen)
- else if HiWord(LParam) >= LoWord(LParam) then //64
- SetSelection(LoWord(LParam), HiWord(LParam)); //64
- end;
- Invalidate;
-end;
-
-function TOvcBaseEntryField.GetAsBoolean : Boolean;
- {-returns the field value as a Boolean Value}
-begin
- Result := False;
- if (efDataType mod fcpDivisor) in [fsubBoolean, fsubYesNo] then
- FLastError := GetValue(Result)
- else
- raise EInvalidDataType.Create;
-end;
-
-function TOvcBaseEntryField.GetAsCents : LongInt;
- {-returns the field value as a LongInt Value representing pennies}
-const
- C = 100.0;
-var
- Re : Real;
- Db : Double;
- Si : Single;
- Ex : Extended;
-begin
- Result := 0;
- case (efDataType mod fcpDivisor) of
- fsubReal :
- begin
- FLastError := GetValue(Re);
- if FLastError = 0 then
- Result := Round(Re * C);
- end;
- fsubDouble :
- begin
- FLastError := GetValue(Db);
- if FLastError = 0 then
- Result := Round(Db * C);
- end;
- fsubSingle :
- begin
- FLastError := GetValue(Si);
- if FLastError = 0 then
- Result := Round(Si * C);
- end;
- fsubExtended :
- begin
- FLastError := GetValue(Ex);
- if FLastError = 0 then
- Result := Round(Ex * C);
- end;
- else
- raise EInvalidDataType.Create;
- end;
-end;
-
-function TOvcBaseEntryField.GetAsDateTime : TDateTime;
- {-returns the field value as a Delphi DateTime Value}
-var
- D : TStDate;
- T : TStTime;
-begin
- case (efDataType mod fcpDivisor) of
- fsubDate :
- begin
- FLastError := GetValue(D);
- if FLastError <> 0 then
- Result := 0
- else
- Result := StDateToDateTime(D);
- end;
- fsubTime :
- begin
- FLastError := GetValue(T);
- if FLastError <> 0 then
- Result := 0
- else
- Result := StTimeToDateTime(T);
- end;
- else
- raise EInvalidDataType.Create;
- end;
-end;
-
-function TOvcBaseEntryField.GetAsExtended : Extended;
- {-returns the field value as an Extended Value}
-var
- Ex : Extended;
- Co : Comp absolute Ex;
- Db : Double;
- Sg : Single absolute Db;
- Re : Real absolute Db;
- Li : Longint;
- Wo : Word absolute Li;
- It : SmallInt absolute Li;
- By : Byte absolute Li;
- Si : ShortInt absolute Li;
-begin
- Result := 0;
- case efDataType mod fcpDivisor of
- fsubExtended :
- begin
- FLastError := GetValue(Ex);
- if FLastError = 0 then
- Result := Ex;
- end;
- fsubComp :
- begin
- FLastError := GetValue(Co);
- if FLastError = 0 then
- Result := Co;
- end;
- fsubReal :
- begin
- FLastError := GetValue(Re);
- if FLastError = 0 then
- Result := Re;
- end;
- fsubDouble :
- begin
- FLastError := GetValue(Db);
- if FLastError = 0 then
- Result := Db;
- end;
- fsubSingle :
- begin
- FLastError := GetValue(Sg);
- if FLastError = 0 then
- Result := Sg;
- end;
- fsubLongInt :
- begin
- FLastError := GetValue(Li);
- if FLastError = 0 then
- Result := Li;
- end;
- fsubWord :
- begin
- FLastError := GetValue(Wo);
- if FLastError = 0 then
- Result := Wo;
- end;
- fsubInteger :
- begin
- FLastError := GetValue(It);
- if FLastError = 0 then
- Result := It;
- end;
- fsubByte :
- begin
- FLastError := GetValue(By);
- if FLastError = 0 then
- Result := By;
- end;
- fsubShortInt :
- begin
- FLastError := GetValue(Si);
- if FLastError = 0 then
- Result := Si;
- end;
- else
- raise EInvalidDataType.Create;
- end;
-end;
-
-function TOvcBaseEntryField.GetAsFloat : Double;
- {-returns the field value as a Double Value}
-var
- Db : Double;
- Sg : Single absolute Db;
- Re : Real absolute Db;
- Ex : Extended;
- Co : Comp absolute Ex;
- Li : LongInt;
- Wo : Word absolute Li;
- It : SmallInt absolute Li;
- By : Byte absolute Li;
- Si : ShortInt absolute Li;
-begin
- Result := 0;
- case efDataType mod fcpDivisor of
- fsubReal :
- begin
- FLastError := GetValue(Re);
- if FLastError = 0 then
- Result := Re;
- end;
- fsubDouble :
- begin
- FLastError := GetValue(Db);
- if FLastError = 0 then
- Result := Db;
- end;
- fsubSingle :
- begin
- FLastError := GetValue(Sg);
- if FLastError = 0 then
- Result := Sg;
- end;
- fsubExtended :
- begin
- FLastError := GetValue(Ex);
- if FLastError = 0 then
- Result := Ex;
- end;
- fsubComp :
- begin
- FLastError := GetValue(Co);
- if FLastError = 0 then
- Result := Co;
- end;
- fsubLongInt :
- begin
- FLastError := GetValue(Li);
- if FLastError = 0 then
- Result := Li;
- end;
- fsubWord :
- begin
- FLastError := GetValue(Wo);
- if FLastError = 0 then
- Result := Wo;
- end;
- fsubInteger :
- begin
- FLastError := GetValue(It);
- if FLastError = 0 then
- Result := It;
- end;
- fsubByte :
- begin
- FLastError := GetValue(By);
- if FLastError = 0 then
- Result := By;
- end;
- fsubShortInt :
- begin
- FLastError := GetValue(Si);
- if FLastError = 0 then
- Result := Si;
- end;
- else
- raise EInvalidDataType.Create;
- end;
-end;
-
-function TOvcBaseEntryField.GetAsInteger : Longint;
- {-returns the field value as a LongInt Value}
-var
- Li : Longint;
- Wo : Word absolute Li;
- It : SmallInt absolute Li;
- By : Byte absolute Li;
- Si : ShortInt absolute Li;
-begin
- Result := 0;
- case efDataType mod fcpDivisor of
- fsubLongInt :
- begin
- FLastError := GetValue(Li);
- if FLastError = 0 then
- Result := Li;
- end;
- fsubWord :
- begin
- FLastError := GetValue(Wo);
- if FLastError = 0 then
- Result := Wo;
- end;
- fsubInteger :
- begin
- FLastError := GetValue(It);
- if FLastError = 0 then
- Result := It;
- end;
- fsubByte :
- begin
- FLastError := GetValue(By);
- if FLastError = 0 then
- Result := By;
- end;
- fsubShortInt :
- begin
- FLastError := GetValue(Si);
- if FLastError = 0 then
- Result := Si;
- end;
- else
- raise EInvalidDataType.Create;
- end;
-end;
-
-function TOvcBaseEntryField.GetAsString : string;
- {-return the field value as a string value}
-var
- Buf : TEditString;
- S : string[MaxEditLen];
-begin
- Result := '';
- if (efDataType mod fcpDivisor) = fsubString then begin
- FLastError := GetValue(S);
- if FLastError = 0 then
- Result := S;
- end else begin
- StrCopy(Buf, efEditSt);
- if efoTrimBlanks in Options then
- TrimAllSpacesPChar(Buf);
- Result := StrPas(Buf);
- FLastError := 0;
- end;
-end;
-
-function TOvcBaseEntryField.GetAsVariant : Variant;
- {return the field value as a Variant value}
-begin
- case efDataType mod fcpDivisor of
- fsubBoolean : Result := GetAsBoolean;
- fsubYesNo : Result := GetAsBoolean;
- fsubLongInt : Result := GetAsInteger;
- fsubWord : Result := GetAsInteger;
- fsubInteger : Result := GetAsInteger;
- fsubByte : Result := GetAsInteger;
- fsubShortInt : Result := GetAsInteger;
- fsubReal : Result := GetAsFloat;
- fsubDouble : Result := GetAsFloat;
- fsubSingle : Result := GetAsFloat;
- fsubExtended : Result := GetAsExtended;
- fsubComp : Result := GetAsExtended;
- else
- Result := GetAsString;
- end;
-end;
-
-function TOvcBaseEntryField.GetAsStDate : TStDate;
- {-returns the field value as a Date Value}
-begin
- if (efDataType mod fcpDivisor) = fsubDate then begin
- FLastError := GetValue(Result);
- if FLastError <> 0 then
- Result := BadDate;
- end else
- raise EInvalidDataType.Create;
-end;
-
-function TOvcBaseEntryField.GetAsStTime : TStTime;
- {-returns the field value as a Time Value}
-begin
- if (efDataType mod fcpDivisor) = fsubTime then begin
- FLastError := GetValue(Result);
- if FLastError <> 0 then
- Result := BadTime;
- end else
- raise EInvalidDataType.Create;
-end;
-
-function TOvcBaseEntryField.GetCurrentPos : Integer;
- {-get position of the caret within the field}
-begin
- if sefHaveFocus in sefOptions then
- Result := efHPos
- else
- Result := -1;
-end;
-
-function TOvcBaseEntryField.GetDataSize : Word;
- {-return the size of the data for this field}
-begin
- if efDataSize = 0 then
- efInitializeDataSize;
- Result := efDataSize;
-end;
-
-function TOvcBaseEntryField.GetDisplayString : string;
- {-return the display string}
-var
- Buf : TEditString;
-begin
- efGetDisplayString(Buf, MaxEditLen);
- Result := StrPas(Buf);
-end;
-
-function TOvcBaseEntryField.GetEditString : string;
- {-return a string containing the edit text}
-var
- Buf : TEditString;
-begin
- StrLCopy(Buf, efEditSt, MaxEditLen);
- Result := StrPas(Buf);
-end;
-
-function TOvcBaseEntryField.GetEpoch : Integer;
-begin
- Result := FEpoch;
-
- {avoid writing controller's epoch value}
- if csWriting in ComponentState then
- Exit;
-
- if Assigned(FOnGetEpoch) then
- FOnGetEpoch(Self, Result);
- if (Result = 0) and ControllerAssigned then
- Result := Controller.Epoch;
-end;
-
-function TOvcBaseEntryField.GetEverModified : Boolean;
- {-return true if this field has ever been modified}
-begin
- Result := (sefEverModified in sefOptions) or (sefModified in sefOptions);
-end;
-
-function TOvcBaseEntryField.GetInsCaretType : TOvcCaret;
- {-return the current caret type}
-begin
- Result := efCaret.InsCaretType;
-end;
-
-function TOvcBaseEntryField.GetInsertMode : Boolean;
- {-return the controller's insert mode state}
-begin
- if ControllerAssigned then
- Result := Controller.InsertMode
- else
- Result := sefInsert in sefOptions;
-end;
-
-function TOvcBaseEntryField.GetModified : Boolean;
- {-return true if this field is modified}
-begin
- Result := sefModified in sefOptions;
-end;
-
-function TOvcBaseEntryField.GetOvrCaretType : TOvcCaret;
- {-return the current caret type}
-begin
- Result := efCaret.OvrCaretType;
-end;
-
-function TOvcBaseEntryField.GetRangeHiStr : string;
- {-get the high field range as string value}
-begin
- Result := efRangeToStRange(efRangeHi);
-end;
-
-function TOvcBaseEntryField.GetRangeLoStr : string;
- {-get the low field range as string value}
-begin
- Result := efRangeToStRange(efRangeLo);
-end;
-
-function TOvcBaseEntryField.GetSelLength : Integer;
- {-return the length of the currently selected text}
-begin
- Result := efSelEnd - efSelStart;
-end;
-
-function TOvcBaseEntryField.GetSelStart : Integer;
- {-return the starting position of the selection, if any}
-begin
- Result := efSelStart;
-end;
-
-function TOvcBaseEntryField.GetSelText : string;
- {-return the currently selected text}
-var
- Len : Integer;
-begin
- Result := '';
- Len := efSelEnd - efSelStart;
- if Len > 0 then begin
- {limit length to max edit length}
- if Len > MaxEditLen then
- Len := MaxEditLen;
- SetLength(Result, Len);
- StrLCopy(@Result[1], @efEditSt[efSelStart], Len);
- end;
-end;
-
-function TOvcBaseEntryField.FieldIsEmpty : Boolean;
- {-return True if the field is completely empty}
-begin
- HandleNeeded;
- Result := efFieldIsEmpty;
-end;
-
-function TOvcBaseEntryField.GetStrippedEditString : string;
- {-return edit string stripped of literals and semi-literals}
-begin
- Result := GetEditString;
-end;
-
-function TOvcBaseEntryField.GetValue(var Data) : Word;
- {-returns the current field value in Data. Result is 0 or error code}
-begin
- {flag to inform validate and transfer}
- {methods that we are retrieving a value}
- Include(sefOptions, sefGettingValue);
- try
- Result := efValidateField;
- if Result <> 0 then
- Exit;
-
- case efDataType mod fcpDivisor of
- fsubString : efTransfer(@ShortString(Data), otf_GetData);
- fsubChar : efTransfer(@AnsiChar(Data), otf_GetData);
- fsubBoolean : efTransfer(@Boolean(Data), otf_GetData);
- fsubYesNo : efTransfer(@Boolean(Data), otf_GetData);
- fsubLongInt : efTransfer(@LongInt(Data), otf_GetData);
- fsubWord : efTransfer(@Word(Data), otf_GetData);
- fsubInteger : efTransfer(@SmallInt(Data), otf_GetData);
- fsubByte : efTransfer(@Byte(Data), otf_GetData);
- fsubShortInt : efTransfer(@ShortInt(Data), otf_GetData);
- fsubReal : efTransfer(@Real(Data), otf_GetData);
- fsubExtended : efTransfer(@Extended(Data), otf_GetData);
- fsubDouble : efTransfer(@Double(Data), otf_GetData);
- fsubSingle : efTransfer(@Single(Data), otf_GetData);
- fsubComp : efTransfer(@Comp(Data), otf_GetData);
- fsubDate : efTransfer(@TStDate(Data), otf_GetData);
- fsubTime : efTransfer(@TStTime(Data), otf_GetData);
- else
- raise EOvcException.Create(GetOrphStr(SCInvalidParamValue));
- end;
- finally
- Exclude(sefOptions, sefGettingValue);
- end;
-end;
-
-procedure TOvcBaseEntryField.IncreaseValue(Wrap : Boolean; Delta : Double);
- {-increase the value of the field by Delta, wrapping if enabled}
-begin
- SendMessage(Handle, WM_SETREDRAW, 0, 0);
- efIncDecValue(Wrap, +Delta);
- SetSelection(0, 0);
- SendMessage(Handle, WM_SETREDRAW, 1, 0);
- Refresh;
-end;
-
-function TOvcBaseEntryField.IsValid : Boolean;
- {-returns true if the field is not marked as invalid}
-begin
- Result := not (sefInvalid in sefOptions);
-end;
-
-procedure TOvcBaseEntryField.MergeWithPicture(const S : string);
- {-combines S with the picture mask and updates the edit string}
-begin
- StrPLCopy(efEditSt, S, MaxLength);
-end;
-
-procedure TOvcBaseEntryField.MoveCaret(Delta : Integer);
- {-moves the caret to the right or left Value positions}
-var
- I : Integer;
- Msg : TMessage;
-begin
- if not (sefHaveFocus in sefOptions) then
- Exit;
-
- FillChar(Msg, SizeOf(Msg), 0);
- if Delta > 0 then begin
- for I := 1 to Delta do
- efPerformEdit(Msg, ccRight)
- end else if Delta < 0 then begin
- for I := 1 to Abs(Delta) do
- efPerformEdit(Msg, ccLeft)
- end;
-end;
-
-procedure TOvcBaseEntryField.MoveCaretToEnd;
- {-move the caret to the end of the field}
-begin
- efCaretToEnd;
-end;
-
-procedure TOvcBaseEntryField.MoveCaretToStart;
- {-move the caret to the beginning of the field}
-begin
- efCaretToStart;
-end;
-
-procedure TOvcBaseEntryField.OMGetDataSize(var Msg : TMessage);
- {-return the fields data size}
-begin
- Msg.Result := DataSize;
-end;
-
-procedure TOvcBaseEntryField.OMReportError(var Msg : TOMReportError);
- {-report the error}
-var
- P : string;
-begin
- if Msg.Error = 0 then
- Exit;
-
- case Msg.Error of
- oeRangeError : P := GetOrphStr(SCRangeError);
- oeInvalidNumber : P := GetOrphStr(SCInvalidNumber);
- oeRequiredField : P := GetOrphStr(SCRequiredField);
- oeInvalidDate : P := GetOrphStr(SCInvalidDate);
- oeInvalidTime : P := GetOrphStr(SCInvalidTime);
- oeBlanksInField : P := GetOrphStr(SCBlanksInField);
- oePartialEntry : P := GetOrphStr(SCPartialEntry);
- else
- if Msg.Error >= oeCustomError then
- P := Controller.ErrorText
- else
- P := GetOrphStr(SCDefaultEntryErrorText);
- end;
-
- {update the error text}
- if P <> Controller.ErrorText then
- Controller.ErrorText := P;
-
- {do error notification}
- DoOnError(Msg.Error, P);
-end;
-
-procedure TOvcBaseEntryField.Paint;
- {-draw the entry field control}
-var
- hCBM : hBitmap;
- MemDC : hDC;
- CR : TRect;
-begin
- inherited Paint;
-
- {get dimensions of client area}
- CR.Top := 0; CR.Left := 0;
- CR.Right := Width; CR.Bottom := Height;
-
- {create a compatible display context and bitmap}
- MemDC := CreateCompatibleDC(Canvas.Handle);
- hCBM := CreateCompatibleBitmap(Canvas.Handle, CR.Right, CR.Bottom);
- SelectObject(MemDC, hCBM);
- SetMapMode(MemDC, GetMapMode(Canvas.Handle));
-
- {set text alignment}
- SetTextAlign(MemDC, TA_LEFT or TA_TOP);
-
- {call our paint routine}
- efPaintPrim(MemDC, CR, efHOffset);
-
- {copy everything to the original display context}
- BitBlt(Canvas.Handle, 0, 0, CR.Right, CR.Bottom, MemDC, 0, 0, SrcCopy);
-
- efPaintBorders;
-
- {dispose of the bitmap and the extra display context}
- DeleteDC(MemDC);
- DeleteObject(hCBM);
-end;
-
-procedure TOvcBaseEntryField.efPaintBorders;
-var
- R : TRect;
- C : TCanvas;
-begin
- R.Left := 0;
- R.Top := 0;
- R.Right := Width;
- R.Bottom := Height;
-
- C := Canvas;
- if (FBorders.LeftBorder <> nil) then begin
- if (FBorders.LeftBorder.Enabled) then begin
- C.Pen.Color := FBorders.LeftBorder.PenColor;
- C.Pen.Width := FBorders.LeftBorder.PenWidth;
- C.Pen.Style := FBorders.LeftBorder.PenStyle;
-
- C.MoveTo(R.Left + (FBorders.LeftBorder.PenWidth div 2), R.Top);
- C.LineTo(R.Left + (FBorders.LeftBorder.PenWidth div 2), R.Bottom);
- end;
- end;
-
- if (FBorders.RightBorder <> nil) then begin
- if (FBorders.RightBorder.Enabled) then begin
- C.Pen.Color := FBorders.RightBorder.PenColor;
- C.Pen.Width := FBorders.RightBorder.PenWidth;
- C.Pen.Style := FBorders.RightBorder.PenStyle;
-
- if ((FBorders.RightBorder.PenWidth mod 2) = 0) then begin
- C.MoveTo(R.Right - (FBorders.RightBorder.PenWidth div 2), R.Top);
- C.LineTo(R.Right - (FBorders.RightBorder.PenWidth div 2), R.Bottom);
- end else begin
- C.MoveTo(R.Right - (FBorders.RightBorder.PenWidth div 2) - 1, R.Top);
- C.LineTo(R.Right - (FBorders.RightBorder.PenWidth div 2) - 1, R.Bottom);
- end;
- end;
- end;
-
- if (FBorders.TopBorder <> nil) then begin
- if (FBorders.TopBorder.Enabled) then begin
- C.Pen.Color := FBorders.TopBorder.PenColor;
- C.Pen.Width := FBorders.TopBorder.PenWidth;
- C.Pen.Style := FBorders.TopBorder.PenStyle;
-
- C.MoveTo(R.Left, R.Top + (FBorders.TopBorder.PenWidth div 2));
- C.LineTo(R.Right, R.Top + (FBorders.TopBorder.PenWidth div 2));
- end;
- end;
-
- if (FBorders.BottomBorder <> nil) then begin
- if (FBorders.BottomBorder.Enabled) then begin
- C.Pen.Color := FBorders.BottomBorder.PenColor;
- C.Pen.Width := FBorders.BottomBorder.PenWidth;
- C.Pen.Style := FBorders.BottomBorder.PenStyle;
-
- if ((FBorders.BottomBorder.PenWidth mod 2) = 0) then begin
- C.MoveTo(R.Left, R.Bottom - (FBorders.BottomBorder.PenWidth div 2));
- C.LineTo(R.Right, R.Bottom - (FBorders.BottomBorder.PenWidth div 2));
- end else begin
- C.MoveTo(R.Left, R.Bottom - (FBorders.BottomBorder.PenWidth div 2) - 1);
- C.LineTo(R.Right, R.Bottom - (FBorders.BottomBorder.PenWidth div 2) - 1);
- end;
- end;
- end;
-end;
-
-procedure TOvcBaseEntryField.PasteFromClipboard;
- {-pastes the contents of the clipboard in the edit field}
-begin
- if HandleAllocated then
- Perform(WM_PASTE, 0, 0);
-end;
-
-procedure TOvcBaseEntryField.ProcessCommand(Cmd, CharCode : Word);
- {-process the specified command}
-var
- Msg : TMessage;
-begin
- FillChar(Msg, SizeOf(Msg), #0);
- Msg.wParam := CharCode;
- efPerformEdit(Msg, Cmd);
-end;
-
-procedure TOvcBaseEntryField.ResetCaret;
- {-move the caret to the beginning or end of the field, as appropriate}
-begin
- efResetCaret;
-end;
-
-procedure TOvcBaseEntryField.Restore;
- {-restore the previous contents of the field}
-begin
- if efSaveEdit = nil then
- Exit;
-
- StrCopy(efEditSt, efSaveEdit);
- efResetCaret;
- SetSelection(0, MaxEditLen);
-
- {clear modified flag}
- Exclude(sefOptions, sefModified);
- Repaint;
- DoOnChange;
-end;
-
-procedure TOvcBaseEntryField.SelectAll;
- {-selects the entire contents of the edit field}
-begin
- if HandleAllocated then
- Perform(EM_SETSEL, 1, LongInt($FFFF0000));
-end;
-
-procedure TOvcBaseEntryField.SetAsBoolean(Value : Boolean);
- {-sets the field value to a Boolean Value}
-begin
- if (efDataType mod fcpDivisor) in [fsubBoolean, fsubYesNo] then
- SetValue(Value)
- else
- raise EInvalidDataType.Create;
-end;
-
-procedure TOvcBaseEntryField.SetAsCents(Value : LongInt);
- {-sets the field value given a LongInt Value representing pennies}
-const
- C = 100.0;
-var
- Re : Real;
- Db : Double;
- Si : Single;
- Ex : Extended;
-begin
- case efDataType mod fcpDivisor of
- fsubReal :
- begin
- Re := Value / C;
- SetValue(Re);
- end;
- fsubDouble :
- begin
- Db := Value / C;
- SetValue(Db);
- end;
- fsubSingle :
- begin
- Si := Value / C;
- SetValue(Si);
- end;
- fsubExtended :
- begin
- Ex := Value / C;
- SetValue(Ex);
- end;
- else
- raise EInvalidDataType.Create;
- end;
-end;
-
-procedure TOvcBaseEntryField.SetAsDateTime(Value : TDateTime);
- {-sets the field value to a Delphi DateTime value}
-var
- D : TStDate;
- T : TStTime;
- Day,
- Month,
- Year : Word;
- Hour,
- Min,
- Sec,
- MSec : Word;
-begin
- case (efDataType mod fcpDivisor) of
- fsubDate :
- begin
- {$IFDEF ZeroDateAsNull}
- if Value = 0 then
- Value := BadDate;
- {$ENDIF}
- DecodeDate(Value, Year, Month, Day);
- D := DMYToStDate(Day, Month, Year, GetEpoch);
- if D = DateTimeToStDate(BadDate) then
- D := BadDate;
- SetValue(D);
- end;
- fsubTime :
- begin
- DecodeTime(Value, Hour, Min, Sec, MSec);
- T := HMSToStTime(Hour, Min, Sec);
- if (T <> 0) and (T = DateTimeToStTime(BadTime)) then
- T := BadTime;
- SetValue(T);
- end;
- else
- raise EInvalidDataType.Create;
- end;
-end;
-
-procedure TOvcBaseEntryField.SetAsExtended(Value : Extended);
- {-sets the field value to an Extended Value}
-var
- Co : Comp;
-begin
- case efDataType mod fcpDivisor of
- fsubExtended :
- SetValue(Value);
- fsubComp :
- begin
- Co := Trunc(Value);
- SetValue(Co);
- end;
- else
- raise EInvalidDataType.Create;
- end;
-end;
-
-procedure TOvcBaseEntryField.SetAsFloat(Value : Double);
- {-sets the field value to a Double Value}
-var
- Sg : Single;
- Re : Real;
- Co : Comp;
- Ex : Extended;
-begin
- case efDataType mod fcpDivisor of
- fsubReal :
- begin
- Re := Value;
- SetValue(Re);
- end;
- fsubDouble :
- SetValue(Value);
- fsubSingle :
- begin
- Sg := Value;
- SetValue(Sg);
- end;
- fsubExtended :
- begin
- Ex := Value;
- SetValue(Ex);
- end;
- fsubComp :
- begin
- Co := Trunc(Value);
- SetValue(Co);
- end;
- else
- raise EInvalidDataType.Create;
- end;
-end;
-
-procedure TOvcBaseEntryField.SetAsInteger(Value : Longint);
- {-sets the field value to a LongInt Value}
-var
- Wo : Word;
- It : SmallInt absolute Wo;
- By : Byte absolute Wo;
- Si : ShortInt absolute Wo;
-begin
- case efDataType mod fcpDivisor of
- fsubLongInt :
- SetValue(Value);
- fsubWord :
- begin
- Wo := LOWORD(Value);
- SetValue(Wo);
- end;
- fsubInteger :
- begin
- It := SmallInt(LOWORD(Value));
- SetValue(It);
- end;
- fsubByte :
- begin
- By := Lo(LOWORD(Value));
- SetValue(By);
- end;
- fsubShortInt :
- begin
- Si := ShortInt(Lo(LOWORD(Value)));
- SetValue(Si);
- end;
- else
- raise EInvalidDataType.Create;
- end;
-end;
-
-procedure TOvcBaseEntryField.SetAsString(const Value : string);
- {-sets the field value to a String Value}
-var
- R : TRangeType;
- fSub : Byte;
- B : Boolean;
- Ch : AnsiChar;
- S : string[MaxEditLen];
-begin
- if sefUserValidating in sefOptions then
- Exit;
-
- fSub := (efDataType mod fcpDivisor);
- if fSub = fsubString then begin
- S := Value;
- SetValue(S)
- end else if fSub in [fsubBoolean, fsubYesNo] then begin
- B := False;
- if Length(Value) > 0 then begin
- Ch := UpCaseChar(Value[1]);
- B := (Ch = FIntlSup.TrueChar) or (Ch = FIntlSup.YesChar);
- end;
- SetValue(B);
- end else begin
- {use range conversion routines to process string assignment}
- if efStRangeToRange(Value, R) then begin
- case (efDataType mod fcpDivisor) of
- {assign result to proper sub-field in range type var}
- fsubWord : R.rtWord := R.rtLong;
- fsubInteger : R.rtInt := R.rtLong;
- fsubByte : R.rtByte := R.rtLong;
- fsubShortInt : R.rtSht := R.rtLong;
- fsubDouble : R.rtDbl := R.rtExt;
- fsubSingle : R.rtSgl := R.rtExt;
- fsubComp : R.rtComp := R.rtExt;
- end;
- SetValue(R);
- end else
- raise EEntryFieldError.Create(GetOrphStr(SCInvalidNumber));
- end;
-end;
-
-procedure TOvcBaseEntryField.SetAsVariant(Value : Variant);
- {-sets the field value to a Variant value}
-var
- fSub : Byte;
-begin
- {what data type is this field}
- fSub := efDataType mod fcpDivisor;
-
- case VarType(Value) of
- varSmallInt,
- varInteger :
- case fSub of
- fsubByte,
- fsubShortInt,
- fsubWord,
- fsubInteger,
- fsubLongInt : SetAsInteger(Value);
- else
- {try to convert it into a string}
- SetAsString(VarAsType(Value, varString));
- end;
- varSingle,
- varDouble,
- varCurrency :
- case fSub of
- fsubReal,
- fsubDouble,
- fsubSingle,
- fsubExtended,
- fsubComp : SetAsFloat(Value);
- else
- {try to convert it into a string}
- SetAsString(VarAsType(Value, varString));
- end;
- varDate :
- if fSub = fsubDate then
- SetAsDateTime(Value)
- else
- {try to convert it into a string}
- SetAsString(VarAsType(Value, varString));
- varBoolean :
- if fSub in [fsubBoolean, fsubYesNo] then
- SetAsBoolean(Value)
- else
- {try to convert it into a string}
- SetAsString(VarAsType(Value, varString));
- varString : SetAsString(Value);
- end;
-end;
-
-procedure TOvcBaseEntryField.SetAsStDate(Value : TStDate);
- {-sets the field value to a Date Value}
-begin
- if (efDataType mod fcpDivisor) = fsubDate then
- SetValue(Value)
- else
- raise EInvalidDataType.Create;
-end;
-
-procedure TOvcBaseEntryField.SetAsStTime(Value : TStTime);
- {-sets the field value to a Time Value}
-begin
- if efDataType mod fcpDivisor = fsubTime then
- SetValue(Value)
- else
- raise EInvalidDataType.Create;
-end;
-
-procedure TOvcBaseEntryField.SetAutoSize(Value : Boolean);
-begin
- if Value <> FAutoSize then begin
- FAutoSize := Value;
-
- if not (csLoading in ComponentState) then
- efAdjustSize; {adjust height based on font}
- end;
-end;
-
-procedure TOvcBaseEntryField.SetBorderStyle(Value : TBorderStyle);
-begin
- if FBorderStyle <> Value then begin
- FBorderStyle := Value;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
-end;
-
-procedure TOvcBaseEntryField.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
-begin
- if FAutoSize and (AHeight <> Height) and
- not (csLoading in ComponentState) then
- FAutoSize := False;
-
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-
- efCalcTopMargin;
-
- if HandleAllocated and (GetFocus = Handle) then
- efPositionCaret(False); {adjust caret for new size}
- Refresh;
-end;
-
-procedure TOvcBaseEntryField.SetDecimalPlaces(Value : Byte);
- {-set the number of decimal places for the edit field}
-begin
- if Value <> FDecimalPlaces then begin
- FDecimalPlaces := Value;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
-end;
-
-procedure TOvcBaseEntryField.SetEpoch(Value : Integer);
-begin
- if Value <> FEpoch then
- if (Value = 0) or ((Value >= MinYear) and (Value <= MaxYear)) then
- FEpoch := Value;
- if ControllerAssigned and (FEpoch = Controller.Epoch) then
- FEpoch := 0;
-end;
-
-procedure TOvcBaseEntryField.SetEverModified(Value : Boolean);
- {-set the EverModified flag}
-begin
- if Value then
- Include(sefOptions, sefEverModified)
- else begin
- Exclude(sefOptions, sefEverModified);
-
- {clear sefModified also}
- Exclude(sefOptions, sefModified);
- end;
-end;
-
-procedure TOvcBaseEntryField.SetInsCaretType(const Value : TOvcCaret);
- {-set the type of caret to use}
-begin
- if Value <> efCaret.InsCaretType then
- efCaret.InsCaretType := Value;
-end;
-
-procedure TOvcBaseEntryField.SetIntlSupport(Value : TOvcIntlSup);
- {-set the international support object this field will use}
-begin
- if Assigned(Value) then
- FIntlSup := Value
- else
- FIntlSup := OvcIntlSup;
-end;
-
-procedure TOvcBaseEntryField.SetMaxLength(Value : Word);
- {-set the maximum length of the edit field}
-begin
- if csLoading in ComponentState then
- FMaxLength := Value
- else if (FMaxLength <> Value) and
- (Value > 0) and
- (Value <= MaxEditLen) and
- (Value >= efPicLen) then begin
- FMaxLength := Value;
- if StrLen(efEditSt) > FMaxLength then
- efEditSt[FMaxLength] := #0;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
-end;
-
-procedure TOvcBaseEntryField.SetModified(Value : Boolean);
- {-set the modified flag}
-begin
- if Value then begin
- Include(sefOptions, sefModified);
-
- {set sefEverModified also}
- Include(sefOptions, sefEverModified);
- end else
- Exclude(sefOptions, sefModified);
-end;
-
-procedure TOvcBaseEntryField.SetOptions(Value : TOvcEntryFieldOptions);
- {-set the options flags}
-begin
- if Value <> Options then begin
- FOptions := Value;
- if (efoForceInsert in FOptions) then
- Exclude(FOptions, efoForceOvertype);
- if (efoForceOvertype in FOptions) then
- Exclude(FOptions, efoForceInsert);
- if (efoRightJustify in FOptions) then
- if efDataType mod fcpDivisor = fsubString then
- Include(FOptions, efoTrimBlanks);
- if (efoRightAlign in FOptions) then
- efPositionCaret(True);
- if not (efoTrimBlanks in FOptions) then begin
- {if this is a string picture field then turn off right justify}
- if efFieldClass = fcPicture then
- if efDataType mod fcpDivisor = fsubString then
- Exclude(FOptions, efoRightJustify);
- end;
- end;
- efRemoveBadOptions;
- Refresh;
-end;
-
-procedure TOvcBaseEntryField.SetOvrCaretType(const Value : TOvcCaret);
- {-set the type of caret to use}
-begin
- if Value <> efCaret.OvrCaretType then
- efCaret.OvrCaretType := Value;
-end;
-
-procedure TOvcBaseEntryField.SetPadChar(Value : AnsiChar);
- {-set the character used to pad the end of the edit string}
-begin
- if Value <> FPadChar then begin
- FPadChar := Value;
- Refresh;
- end;
-end;
-
-procedure TOvcBaseEntryField.SetPasswordChar(Value : AnsiChar);
- {-set the character used to mask password entry}
-begin
- if FPasswordChar <> Value then begin
- FPasswordChar := Value;
- if Value = #0 then
- Exclude(FOptions, efoPasswordMode);
- Refresh;
- end;
-end;
-
-procedure TOvcBaseEntryField.SetSelLength(Value : Integer);
- {-set the extent of the selected text}
-begin
- SetSelection(efSelStart, efSelStart + Value);
- Refresh;
-end;
-
-procedure TOvcBaseEntryField.SetInitialValue;
- {-resets the field value to its initial value}
-begin
- efSetInitialValue;
-end;
-
-procedure TOvcBaseEntryField.SetInsertMode(Value : Boolean);
- {-changes the field's insert mode}
-begin
- if Value <> (sefInsert in sefOptions) then begin
- if Value then
- Include(sefOptions, sefInsert)
- else
- Exclude(sefOptions, sefInsert);
- Controller.InsertMode := Value;
- efCaret.InsertMode := Value;
- end;
-end;
-
-procedure TOvcBaseEntryField.SetRangeHi(const Value : TRangeType);
- {-set the high range for this field}
-begin
- case efDataType mod fcpDivisor of
- fsubLongInt : efRangeHi.rtLong := Value.rtLong;
- fsubWord : efRangeHi.rtLong := Value.rtWord;
- fsubInteger : efRangeHi.rtLong := Value.rtInt;
- fsubByte : efRangeHi.rtLong := Value.rtByte;
- fsubShortInt : efRangeHi.rtLong := Value.rtSht;
- fsubExtended : efRangeHi.rtExt := Value.rtExt;
- fsubDouble : efRangeHi.rtExt := Value.rtDbl;
- fsubSingle : efRangeHi.rtExt := Value.rtSgl;
- fsubComp : efRangeHi.rtExt := Value.rtComp;
- else
- efRangeHi := Value;
- end;
- if (ValidateContents(true) > 0)
- and (Parent <> nil)
- and (Parent.Visible)
- and (Parent.Enabled) then
- SetFocus;
-end;
-
-procedure TOvcBaseEntryField.SetRangeHiStr(const Value : string);
- {-set the high field range from a string value}
-var
- R : TRangeType;
-begin
- R := efRangeHi;
- if not (csLoading in ComponentState) then
- if not efStRangeToRange(Value, R) then
- raise EInvalidRangeValue.Create(efDataType mod fcpDivisor);
- efRangeHi := R;
- if (ValidateContents(true) > 0)
- and (Parent <> nil)
- and (Parent.Visible)
- and (Parent.Enabled) then
- SetFocus;
-end;
-
-procedure TOvcBaseEntryField.SetRangeLo(const Value : TRangeType);
- {-set the low range for this field}
-begin
- case efDataType mod fcpDivisor of
- fsubLongInt : efRangeLo.rtLong := Value.rtLong;
- fsubWord : efRangeLo.rtLong := Value.rtWord;
- fsubInteger : efRangeLo.rtLong := Value.rtInt;
- fsubByte : efRangeLo.rtLong := Value.rtByte;
- fsubShortInt : efRangeLo.rtLong := Value.rtSht;
- fsubExtended : efRangeLo.rtExt := Value.rtExt;
- fsubDouble : efRangeLo.rtExt := Value.rtDbl;
- fsubSingle : efRangeLo.rtExt := Value.rtSgl;
- fsubComp : efRangeLo.rtExt := Value.rtComp;
- else
- efRangeLo := Value;
- end;
- if (ValidateContents(true) > 0)
- and (Parent <> nil)
- and (Parent.Visible)
- and (Parent.Enabled) then
- SetFocus;
-end;
-
-procedure TOvcBaseEntryField.SetRangeLoStr(const Value : string);
- {-set the low field range from a string value}
-var
- R : TRangeType;
-begin
- R := efRangeLo;
- if not (csLoading in ComponentState) then
- if not efStRangeToRange(Value, R) then
- raise EInvalidRangeValue.Create(efDataType mod fcpDivisor);
- efRangeLo := R;
- if (ValidateContents(true) > 0)
- and (Parent <> nil)
- and (Parent.Visible)
- and (Parent.Enabled) then
- SetFocus;
-end;
-
-procedure TOvcBaseEntryField.SetSelStart(Value : Integer);
- {-set the starting position of the selection}
-begin
- SetSelection(Value, Value);
- Refresh;
-end;
-
-procedure TOvcBaseEntryField.SetSelText(const Value : string);
- {-replace selected text with Value}
-var
- Msg : TMessage;
- Buf : array[0..MaxEditLen] of AnsiChar;
-begin
- StrPCopy(Buf, Value);
- Msg.lParam := LPARAM(@Buf); //64
- efPerformEdit(Msg, ccPaste);
-end;
-
-procedure TOvcBaseEntryField.SetTextMargin(Value : Integer);
- {-set the text margin}
-begin
- if (Value <> FTextMargin) and (Value >= 2) then begin
- FTextMargin := Value;
- Refresh;
- end;
-end;
-
-procedure TOvcBaseEntryField.SetUninitialized(Value : Boolean);
- {-sets the Uninitialized option}
-begin
- if Value <> FUninitialized then begin
- FUninitialized := Value;
- efRemoveBadOptions;
- end;
-end;
-
-procedure TOvcBaseEntryField.SetUserData(Value : TOvcUserData);
- {-sets pointer to user-defined mask data object}
-begin
- if Assigned(Value) then
- FUserData := Value
- else
- FUserData := OvcUserData;
-end;
-
-procedure TOvcBaseEntryField.SetValue(const Data);
- {-changes the field value to the value in Data}
-begin
- if sefUserValidating in sefOptions then
- Exit;
-
- HandleNeeded;
-
- {set the updating flag so OnChange doesn't get fired}
- Include(sefOptions, sefUpdating);
- try
- case efDataType mod fcpDivisor of
- fsubString : efTransfer(@ShortString(Data), otf_SetData);
- fsubChar : efTransfer(@AnsiChar(Data), otf_SetData);
- fsubBoolean : efTransfer(@Boolean(Data), otf_SetData);
- fsubYesNo : efTransfer(@Boolean(Data), otf_SetData);
- fsubLongInt : efTransfer(@LongInt(Data), otf_SetData);
- fsubWord : efTransfer(@Word(Data), otf_SetData);
- fsubInteger : efTransfer(@SmallInt(Data), otf_SetData);
- fsubByte : efTransfer(@Byte(Data), otf_SetData);
- fsubShortInt : efTransfer(@ShortInt(Data), otf_SetData);
- fsubReal : efTransfer(@Real(Data), otf_SetData);
- fsubExtended : efTransfer(@Extended(Data), otf_SetData);
- fsubDouble : efTransfer(@Double(Data), otf_SetData);
- fsubSingle : efTransfer(@Single(Data), otf_SetData);
- fsubComp : efTransfer(@Comp(Data), otf_SetData);
- fsubDate : efTransfer(@TStDate(Data), otf_SetData);
- fsubTime : efTransfer(@TStTime(Data), otf_SetData);
- else
- raise EOvcException.Create(GetOrphStr(SCInvalidParamValue));
- end;
- finally
- Exclude(sefOptions, sefUpdating);
- end;
-end;
-
-procedure TOvcBaseEntryField.SetZeroDisplay(Value : TZeroDisplay);
- {-set flag that determines if zeros are hidden}
-begin
- if Value <> FZeroDisplay then begin
- FZeroDisplay := Value;
- Refresh;
- end;
-end;
-
-procedure TOvcBaseEntryField.SetZeroDisplayValue(Value : Double);
- {-set value used by ZeroDisplay logic}
-begin
- if Value <> FZeroDisplayValue then begin
- FZeroDisplayValue := Value;
- Refresh;
- end;
-end;
-
-function TOvcBaseEntryField.ValidateContents(ReportError : Boolean) : Word;
- {-performs field validation, returns error code, and conditionally reports error}
-var
- WasValid : Boolean;
-begin
-{ - If the parent is not enabled or visible then don't attempt to }
-{ validate the contents of the control. }
- if (not (Enabled and Visible)) or (Parent = nil)
- or (not (Parent.Enabled and Parent.Visible))
- then begin
- Result := 0;
- Exit;
- end;
-
- FLastError := 0;
-
- {record current valid state}
- WasValid := IsValid;
-
- {check for empty/uninitialized required field}
- if (efoInputRequired in Options) and not efIsReadOnly then
- if efFieldIsEmpty or (Uninitialized and not (sefModified in sefOptions)) then
- FLastError := oeRequiredField;
-
- {ask the validation routine if there's an error}
- if FLastError = 0 then begin
- Include(sefOptions, sefValidating);
- try
- FLastError := efValidateField;
- finally
- Exclude(sefOptions, sefValidating);
- end;
- end;
-
- if ReportError and (FLastError <> 0) then
- PostMessage(Handle, om_ReportError, FLastError, 0);
-
- {update invalid flag}
- if FLastError = 0 then
- Exclude(sefOptions, sefInvalid)
- else if efoSoftValidation in Options then
- Include(sefOptions, sefInvalid);
-
- {force field to repaint if valid state has changed}
- if WasValid <> IsValid then
- Invalidate;
-
- Result := FLastError;
-end;
-
-function TOvcBaseEntryField.ValidateSelf : Boolean;
- {-performs field validation, returns true if no errors, and reports error if not using SoftValidation}
-begin
- Result := ValidateContents(not (efoSoftValidation in Options)) = 0;
-end;
-
-procedure TOvcBaseEntryField.WMChar(var Msg : TWMChar);
-begin
- inherited;
-
- if sefCharOk in sefOptions then
- efPerformEdit(TMessage(Msg), ccChar);
-end;
-
-procedure TOvcBaseEntryField.WMClear(var Msg : TWMClear);
-begin
- efPerformEdit(TMessage(Msg), ccCut);
-end;
-
-procedure TOvcBaseEntryField.WMCopy(var Msg : TWMCopy);
-begin
- efPerformEdit(TMessage(Msg), ccCopy);
-end;
-
-procedure TOvcBaseEntryField.WMCut(var Msg : TWMCut);
-begin
- efCopyPrim;
- efPerformEdit(TMessage(Msg), ccCut);
-end;
-
-procedure TOvcBaseEntryField.WMEraseBkGnd(var Msg : TWMEraseBkGnd);
-begin
- Msg.Result := 1; {don't erase background}
-end;
-
-procedure TOvcBaseEntryField.WMGetDlgCode(var Msg : TWMGetDlgCode);
-begin
- inherited;
-
- if csDesigning in ComponentState then
- Msg.Result := DLGC_STATIC
- else
- Msg.Result := Msg.Result or DLGC_WANTCHARS or DLGC_WANTARROWS;
-end;
-
-procedure TOvcBaseEntryField.WMKeyDown(var Msg : TWMKeyDown);
-var
- Cmd : Word;
-begin
- inherited;
-
- if Msg.CharCode = 0 then
- Exit;
-
- {don't process shift key by itself}
- if Msg.CharCode = VK_SHIFT then
- Exit;
-
- {see if this command should be processed by us}
- Cmd := Controller.EntryCommands.Translate(TMessage(Msg));
-
- {convert undo to restore since ctrl-Z is mapped to ccUndo by default}
- {and cannot be mapped to more than one command in a command table}
- if Cmd = ccUndo then
- Cmd := ccRestore;
-
- if Cmd <> ccNone then begin
- if (Cmd <> ccIns) or
- not ((efoForceInsert in Options) or
- (efoForceOvertype in Options)) then begin
- case Cmd of
- ccCut : WMCut(TWMCut(Msg));
- ccCopy : WMCopy(TWMCopy(Msg));
- ccPaste : WMPaste(TWMPaste(Msg));
- else
- efPerformEdit(TMessage(Msg), Cmd);
- end;
- end;
- end;
-end;
-
-procedure TOvcBaseEntryField.WMKillFocus(var Msg : TWMKillFocus);
-var
- NewWindow : HWnd;
- SaveModified : Boolean;
-begin
- {where is the focus going?}
- NewWindow := Msg.FocusedWnd;
- if NewWindow = Handle then
- NewWindow := 0
- else if not efIsSibling(NewWindow) then
- NewWindow := 0;
-
- {retain caret position if focus is moving }
- {to a menu or a component not on this form}
- if (NewWindow = 0) then
- Include(sefOptions, sefRetainPos)
- else
- Exclude(sefOptions, sefRetainPos);
-
- {destroy caret}
- efCaret.Linked := False;
-
- {if the mouse if currently captured, release it}
- if MouseCapture then
- MouseCapture := False;
-
- {perform default processing}
- inherited;
-
- {set controller's insert mode flag for sibling fields' to access}
- if not ((efoForceInsert in Options) or
- (efoForceOvertype in Options)) then
- {are we in insert mode}
- Controller.InsertMode := sefInsert in sefOptions;
-
- {if no error is pending for this control...}
- if not (sefErrorPending in sefOptions) and
- not (sefIgnoreFocus in sefOptions) then begin
- Include(sefOptions, sefValPending);
-
- {and focus is going to a control...}
- if (NewWindow <> 0) then begin
- if sefModified in sefOptions then
- {clear the unitialized option}
- Uninitialized := False;
-
- {that isn't a Cancel, Restore, or Help button...}
- if not Controller.IsSpecialButton(Msg.FocusedWnd) then begin
- {then validate this field}
- efCanClose(True {validate});
- if sefErrorPending in sefOptions then
- Include(sefOptions, sefValPending)
- else
- Exclude(sefOptions, sefValPending);
- end else begin
- {just call validate field and ignore the error, if any}
- {this forces the field to redisplay using the proper format}
- SaveModified := Modified;
- efValidateField;
- Modified := SaveModified;
- end;
- end;
- end else begin
- {set the validation pending flag on if an error is pending}
- if sefErrorPending in sefOptions then
- Include(sefOptions, sefValPending)
- else
- Exclude(sefOptions, sefValPending);
- end;
-
- {we no longer have the focus}
- Exclude(sefOptions, sefHaveFocus);
-
- {if we're not coming back...}
- if (NewWindow <> 0) and not (sefRetainPos in sefOptions) and
- not (sefIgnoreFocus in sefOptions) then begin
- efPerformPostEditNotify(FindControl(Msg.FocusedWnd));
- end;
- Exclude(sefOptions, sefIgnoreFocus);
-
- {reset the caret position}
- if not (sefRetainPos in sefOptions) then
- efCaretToStart;
-
- {redraw the field}
- Refresh;
-end;
-
-procedure TOvcBaseEntryField.WMLButtonDblClk(var Msg : TWMLButtonDblClk);
-begin
- if sefHaveFocus in sefOptions then
- efPerformEdit(TMessage(Msg), ccDblClk);
-
- inherited;
-end;
-
-procedure TOvcBaseEntryField.WMLButtonDown(var Msg : TWMLButtonDown);
-begin
- inherited;
-
- if not (sefHaveFocus in sefOptions) then begin
- Include(sefOptions, sefNoHighlight);
- SetSelection(0, 0);
- if not Focused then
- SetFocus;
- end;
-
-// inherited;
-
- if sefHaveFocus in sefOptions then
- efPerformEdit(TMessage(Msg), ccMouse);
-end;
-
-procedure TOvcBaseEntryField.WMMouseActivate(var Msg : TWMMouseActivate);
-begin
- if csDesigning in ComponentState then
- Exit;
-
- inherited;
-end;
-
-procedure TOvcBaseEntryField.WMMouseMove(var Msg : TWMMouseMove);
-begin
- inherited;
-
- if MouseCapture then
- if {$IFNDEF LCL} GetAsyncKeyState(GetLeftButton) {$ELSE} GetKeyState(GetLeftButton) {$ENDIF} and $8000 <> 0 then
- efPerformEdit(TMessage(Msg), ccMouseMove);
-end;
-
-procedure TOvcBaseEntryField.WMPaste(var Msg : TWMPaste);
- {-paste text in the clipboard into the field}
-var
- H : THandle;
-begin
-{$IFNDEF LCL}
- H := Clipboard.GetAsHandle(CF_TEXT);
- if H <> 0 then begin
- TMessage(Msg).lParam := LongInt(GlobalLock(H));
- efPerformEdit(TMessage(Msg), ccPaste);
- GlobalUnlock(H);
- end;
-{$ENDIF}
-end;
-
-procedure TOvcBaseEntryField.WMRButtonUp(var Msg : TWMRButtonDown);
-var
- P : TPoint;
- M : TPopUpMenu;
- MI : TMenuItem;
-begin
- if not (sefHaveFocus in sefOptions) then
- if not Focused and CanFocus then
- SetFocus;
-
- inherited;
- if PopUpMenu = nil then begin
- M := TPopupMenu.Create(Self);
- try
- MI := TMenuItem.Create(M);
- MI.Caption := GetOrphStr(SCRestoreMI);
- MI.Enabled := Modified;
- MI.OnClick := DoRestoreClick;
- M.Items.Add(MI);
-
- MI := TMenuItem.Create(M);
- MI.Caption := '-';
- M.Items.Add(MI);
-
- MI := TMenuItem.Create(M);
- MI.Caption := GetOrphStr(SCCutMI);
- MI.Enabled := (SelectionLength > 0) and not efIsReadOnly;
- MI.OnClick := DoCutClick;
- M.Items.Add(MI);
-
- MI := TMenuItem.Create(M);
- MI.Caption := GetOrphStr(SCCopyMI);
- MI.Enabled := SelectionLength > 0;
- MI.OnClick := DoCopyClick;
- M.Items.Add(MI);
-
- MI := TMenuItem.Create(M);
- MI.Caption := GetOrphStr(SCPasteMI);
- MI.Enabled := not efIsReadOnly and Clipboard.HasFormat(CF_TEXT);
- MI.OnClick := DoPasteClick;
- M.Items.Add(MI);
-
- MI := TMenuItem.Create(M);
- MI.Caption := GetOrphStr(SCDeleteMI);
- MI.Enabled := (SelectionLength > 0) and not efIsReadOnly;
- MI.OnClick := DoDeleteClick;
- M.Items.Add(MI);
-
- MI := TMenuItem.Create(M);
- MI.Caption := '-';
- M.Items.Add(MI);
-
- MI := TMenuItem.Create(M);
- MI.Caption := GetOrphStr(SCSelectAllMI);
- MI.Enabled := LongInt(StrLen(efEditSt)) > SelectionLength;
- MI.OnClick := DoSelectAllClick;
- M.Items.Add(MI);
-
- P.X := Msg.XPos;
- P.Y := Msg.YPos;
- P := ClientToScreen(P);
- M.PopUp(P.X, P.Y);
-
- Application.ProcessMessages;
- finally
- M.Free;
- end;
- end;
-end;
-
-procedure TOvcBaseEntryField.WMSetFocus(var Msg : TWMSetFocus);
-var
- Highlight,
- Ignore,
- FixHOfs,
- ValPending : Boolean;
- PF : TForm;
- P : TPoint;
-begin
- if ((csLoading in ComponentState) or
- (csDesigning in ComponentState)) then
- Exit;
-
- {we have the focus}
- Include(sefOptions, sefHaveFocus);
-
- {reset command processor}
- Controller.EntryCommands.ResetCommandProcessor;
-
- {get validation state}
- ValPending := sefValPending in sefOptions;
-
- {calling Show forces the parent to do whatever is necessary to}
- {make sure that we are visible. In the case where the entry}
- {field is on a non-visible notebook page that has had its}
- {handle deallocated, this insures that the page is made visible}
- {and that the window handles have been created}
-
- {if focus is retruning because of an error condition}
- if ValPending then begin
-
- {tell the control that lost the focus to}
- {cancel any special modes it might be in}
- if Msg.FocusedWnd > 0 then begin
- SendMessage(Msg.FocusedWnd, WM_CANCELMODE, 0, 0);
- GetCursorPos(P);
- {send a fake mouse up message to force release of mouse capture}
- {this is necessary so that the TStringGrid exits highlight mode}
- SendMessage(Msg.FocusedWnd, WM_LBUTTONUP, 0, MakeLong(P.X, P.Y));
- end;
-
- Show;
- PF := TForm(GetParentForm(Self));
- if Assigned(PF) then
- PF.FocusControl(Self);
- end;
-
- {get the field's insert mode}
- if not ((efoForceInsert in Options) or
- (efoForceOvertype in Options)) then
- if Controller.InsertMode then
- Include(sefOptions, sefInsert)
- else
- Exclude(sefOptions, sefInsert);
-
- if sefRetainPos in sefOptions then begin
- Highlight := False;
- FixHOfs := False;
- Ignore := False;
- end else begin
- Ignore := Controller.ErrorPending and {not us} (FLastError = 0);
- if not Ignore then begin
- if not ValPending then
- Exclude(sefOptions, sefModified);
- efPerformPreEditNotify(FindControl(Msg.FocusedWnd));
- {save a copy of the current edit string}
- efSaveEditString;
- end;
-
- if sefNoHighlight in sefOptions then begin
- Highlight := False;
- FixHOfs := False;
- end else begin
- Highlight := (not Ignore);
- FixHOfs := True;
- efResetCaret;
- end;
- end;
-
- if Ignore and not (efoSoftValidation in Options) then
- Include(sefOptions, sefIgnoreFocus)
- else
- Exclude(sefOptions, sefIgnoreFocus);
-
- Exclude(sefOptions, sefErrorPending);
- Exclude(sefOptions, sefRetainPos);
- Exclude(sefOptions, sefNoHighlight);
- Exclude(sefOptions, sefValPending);
-
- {clear controller's error pending flag}
- if not Ignore then
- Controller.ErrorPending := False;
-
- inherited;
-
- if (efoForceInsert in Options) then
- Include(sefOptions, sefInsert)
- else if (efoForceOvertype in Options) then
- Exclude(sefOptions, sefInsert);
-
- efCaret.Linked := True;
- efCaret.Visible := True;
- efCaret.InsertMode := (sefInsert in sefOptions);
- efPositionCaret(FixHOfs);
-
- if Highlight and (efoAutoSelect in Controller.EntryOptions) then
- SetSelection(0, MaxEditLen);
-
- Refresh;
-end;
-
-procedure TOvcBaseEntryField.WMSetFont(var Msg : TWMSetFont);
-begin
- inherited;
-
- {inherited WMSetFont sets our font. Set it as our canvas font}
- Canvas.Font := Font;
-end;
-
-procedure TOvcBaseEntryField.WMSetText(var Msg : TWMSetText);
-begin
- if HandleAllocated then begin
- SetSelection(0, MaxEditLen);
- efPerformEdit(TMessage(Msg), ccPaste);
- end;
-end;
-
-procedure TOvcBaseEntryField.WMSize(var Msg : TWMSize);
-begin
- inherited;
-
- Refresh;
-end;
-
-procedure TOvcBaseEntryField.WMSysKeyDown(var Msg : TWMSysKeyDown);
-var
- Cmd : Word;
-begin
- inherited;
-
- {exit if this is a Tab key or an Alt key by itself}
- if (Msg.CharCode = VK_TAB) or (Msg.CharCode = VK_ALT) then
- Exit;
-
- {see if this command should be processed by us}
- Cmd := Controller.EntryCommands.TranslateKey(Msg.CharCode, [ssAlt]);
-
- {convert undo to restore since ctrl-Z is mapped to ccUndo by default}
- {and cannot be mapped to more than one command in a command table}
- if Cmd = ccUndo then
- Cmd := ccRestore;
-
- if Cmd <> ccNone then begin
- case Cmd of
- ccCut : WMCut(TWMCut(Msg));
- ccCopy : WMCopy(TWMCopy(Msg));
- ccPaste : WMPaste(TWMPaste(Msg));
- else
- efPerformEdit(TMessage(Msg), Cmd);
- end;
-
- {allow entering of characters using Alt-keypad numbers}
- case Msg.CharCode of
- vk_NumPad0, vk_NumPad1, vk_NumPad2, vk_NumPad3, vk_NumPad4,
- vk_NumPad5, vk_NumPad6, vk_NumPad7, vk_NumPad8, vk_NumPad9:
- begin
- Include(sefOptions, sefCharOk);
- Include(sefOptions, sefAcceptChar);
- end;
- end;
- end;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovcexcpt.pas b/Source/3rdParty/Orpheus/ovcexcpt.pas
deleted file mode 100644
index e6f42378..00000000
--- a/Source/3rdParty/Orpheus/ovcexcpt.pas
+++ /dev/null
@@ -1,372 +0,0 @@
-{*********************************************************}
-{* OVCEXCPT.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 ovcexcpt;
- {-Exceptions unit}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, {$ENDIF}
- Classes, SysUtils, OvcData, OvcConst, OvcIntl;
-
-type
- {*** Base Orpheus exeption class ***}
- EOvcException = class(Exception)
- public
- ErrorCode : LongInt;
- end;
-
- {*** General ***}
- ENoTimersAvailable = class(EOvcException)
- public
- constructor Create;
- end;
-
- {*** Controller ***}
- EControllerError = class(EOvcException);
- ENoControllerAssigned = class(EControllerError)
- public
- constructor Create;
- end;
-
- {*** Command Processor ***}
- ECmdProcessorError = class(EOvcException);
- EDuplicateCommand = class(ECmdProcessorError)
- public
- constructor Create;
- end;
-
- ETableNotFound = class(ECmdProcessorError)
- public
- constructor Create;
- end;
-
- {*** Entry Fields ***}
- EEntryFieldError = class(EOvcException);
- EInvalidDataType = class(EEntryFieldError)
- public
- constructor Create;
- end;
-
- EInvalidPictureMask = class(EEntryFieldError)
- public
- constructor Create(const Mask : string);
- end;
-
- EInvalidRangeValue = class(EEntryFieldError)
- public
- constructor Create(DataType : Byte);
- end;
-
- EInvalidDateForMask = class(EEntryFieldError)
- public
- constructor Create;
- end;
-
- {*** Editors ***}
- EEditorError = class(EOvcException)
- public
- constructor Create(const Msg : string; Error : Cardinal);
- end;
-
- EInvalidLineOrCol = class(EEditorError)
- public
- constructor Create;
- end;
-
- EInvalidLineOrPara = class(EEditorError)
- public
- constructor Create;
- end;
-
- {*** Viewers ***}
- EViewerError = class(EOvcException);
- ERegionTooLarge = class(EViewerError)
- public
- constructor Create;
- end;
-
- {*** Notebook ***}
- ENotebookError = class(EOvcException);
- EInvalidPageIndex = class(ENotebookError)
- public
- constructor Create;
- end;
-
- EInvalidTabFont = class(ENotebookError)
- public
- constructor Create;
- end;
-
- {*** Rotated Label ***}
- ERotatedLabelError = class(EOvcException);
- EInvalidLabelFont = class(ERotatedLabelError)
- public
- constructor Create;
- end;
-
- {*** Timer Pool ***}
- ETimerPoolError = class(EOvcException);
- EInvalidTriggerHandle = class(ETimerPoolError)
- public
- constructor Create;
- end;
-
- {*** Virtual ListBox ***}
- EVirtualListBoxError = class(EOvcException);
- EOnSelectNotAssigned = class(EVirtualListBoxError)
- public
- constructor Create;
- end;
-
- EOnIsSelectedNotAssigned = class(EVirtualListBoxError)
- public
- constructor Create;
- end;
-
- {*** Report View ***}
- EReportViewError = class(EOvcException) { generic report view exception}
- constructor Create(ErrorCode : Integer; Dummy : Byte);
- constructor CreateFmt(ErrorCode : Integer; const Args : array of const; Dummy : Byte);
- end;
- EUnknownView = class(EReportViewError); { unknown view name }
- EItemNotFound = class(EReportViewError); { attempt to change/remove nonexistent item}
- EItemAlreadyAdded = class(EReportViewError); { attempt to re-add existing item }
- EUpdatePending = class(EReportViewError); { operation is invalid while updates are pending }
- EItemIsNotGroup = class(EReportViewError); { item at specified line is not a group (IsGroup = False) }
- ELineNoOutOfRange = class(EReportViewError); { specified line is invalid (out of range) }
- ENotMultiSelect = class(EReportViewError); { operation is invalid while MultiSelect is false }
- EItemNotInIndex = class(EReportViewError); { specified data item is not in index }
- ENoActiveView = class(EReportViewError); { no active view }
- EOnCompareNotAsgnd = class(EReportViewError); { unassigned OnCompareFields }
- EGetAsFloatNotAsg = class(EReportViewError); { unassigned OnGetFieldAsFloat }
- EOnFilterNotAsgnd = class(EReportViewError); { unassigned OnFilter }
-
- {*** Sparse Array ***}
- ESparseArrayError = class(EOvcException);
- ESAEAtMaxSize = class(ESparseArrayError);
- ESAEOutOfBounds = class(ESparseArrayError);
-
- {*** Fixed Font ***}
- EFixedFontError = class(EOvcException);
- EInvalidFixedFont = class(EFixedFontError)
- public
- constructor Create;
- end;
-
- EInvalidFontParam = class(EFixedFontError)
- public
- constructor Create;
- end;
-
- {*** MRU List ***}
- EMenuMRUError = class(EOvcException);
-
-implementation
-
-
-{*** General ***}
-
-constructor ENoTimersAvailable.Create;
-begin
- inherited Create(GetOrphStr(SCNoTimersAvail));
-end;
-
-
-{*** Controller ***}
-
-constructor ENoControllerAssigned.Create;
-begin
- inherited Create(GetOrphStr(SCNoControllerAssigned));
-end;
-
-
-{*** Command Processor ***}
-
-constructor ETableNotFound.Create;
-begin
- inherited Create(GetOrphStr(SCTableNotFound));
-end;
-
-constructor EDuplicateCommand.Create;
-begin
- inherited Create(GetOrphStr(SCDuplicateCommand));
-end;
-
-
-{*** Entry Fields ***}
-
-constructor EInvalidDataType.Create;
-begin
- inherited Create(GetOrphStr(SCInvalidDataType));
-end;
-
-constructor EInvalidPictureMask.Create(const Mask : string);
-begin
- inherited CreateFmt(GetOrphStr(SCInvalidPictureMask), [Mask]);
-end;
-
-constructor EInvalidRangeValue.Create(DataType : Byte);
-var
- S : string;
-begin
- case DataType of
- fsubLongInt : inherited CreateFmt(GetOrphStr(SCInvalidRange), [Low(LongInt), High(LongInt)]);
- fsubWord : inherited CreateFmt(GetOrphStr(SCInvalidRange), [Low(Word), High(Word)]);
- fsubInteger : inherited CreateFmt(GetOrphStr(SCInvalidRange), [Low(SmallInt), High(SmallInt)]);
- fsubByte : inherited CreateFmt(GetOrphStr(SCInvalidRange), [Low(Byte), High(Byte)]);
- fsubShortInt : inherited CreateFmt(GetOrphStr(SCInvalidRange), [Low(ShortInt), High(ShortInt)]);
- fsubReal : inherited Create(GetOrphStr(SCInvalidRealRange));
- fsubExtended : inherited Create(GetOrphStr(SCInvalidExtendedRange));
- fsubDouble : inherited Create(GetOrphStr(SCInvalidDoubleRange));
- fsubSingle : inherited Create(GetOrphStr(SCInvalidSingleRange));
- fsubComp : inherited Create(GetOrphStr(SCInvalidCompRange));
- fsubDate :
- begin
- S := OvcIntlSup.InternationalDate(True);
- inherited CreateFmt(GetOrphStr(SCInvalidDateRange), [S]);
- end;
- fsubTime :
- begin
- S := OvcIntlSup.InternationalTime(False);
- inherited CreateFmt(GetOrphStr(SCInvalidTimeRange), [S]);
- end;
- else
- inherited Create(GetOrphStr(SCInvalidRangeValue));
- end;
-end;
-
-constructor EInvalidDateForMask.Create;
-begin
- inherited Create(GetOrphStr(SCInvalidDateForMask));
-end;
-
-
-{*** Editors ***}
-
-constructor EEditorError.Create(const Msg : string; Error : Cardinal);
-begin
- ErrorCode := Error;
- inherited Create(Msg);
-end;
-
-constructor EInvalidLineOrCol.Create;
-begin
- inherited Create(GetOrphStr(SCInvalidLineOrColumn), 0);
-end;
-
-constructor EInvalidLineOrPara.Create;
-begin
- inherited Create(GetOrphStr(SCInvalidLineOrParaIndex), 0);
-end;
-
-
-{*** Viewers ***}
-
-constructor ERegionTooLarge.Create;
-begin
- inherited Create(GetOrphStr(SCRegionTooLarge));
-end;
-
-
-{*** Notebook ***}
-
-constructor EInvalidPageIndex.Create;
-begin
- inherited Create(GetOrphStr(SCInvalidPageIndex));
-end;
-
-constructor EInvalidTabFont.Create;
-begin
- inherited Create(GetOrphStr(SCInvalidTabFont));
-end;
-
-
-{*** Rotated Label ***}
-
-constructor EInvalidLabelFont.Create;
-begin
- inherited Create(GetOrphStr(SCInvalidLabelFont));
-end;
-
-
-{*** Timer Pool ***}
-
-constructor EInvalidTriggerHandle.Create;
-begin
- inherited Create(GetOrphStr(SCBadTriggerHandle));
-end;
-
-
-{*** Virtual ListBox ***}
-
-constructor EOnSelectNotAssigned.Create;
-begin
- inherited Create(GetOrphStr(SCOnSelectNotAssigned));
-end;
-
-constructor EOnIsSelectedNotAssigned.Create;
-begin
- inherited Create(GetOrphStr(SCOnIsSelectedNotAssigned));
-end;
-
-
-{*** Fixed Font ***}
-
-constructor EInvalidFixedFont.Create;
-begin
- inherited Create(GetOrphStr(SCNonFixedFont));
-end;
-
-constructor EInvalidFontParam.Create;
-begin
- inherited Create(GetOrphStr(SCInvalidFontParam));
-end;
-
-
-constructor EReportViewError.Create(ErrorCode : Integer; Dummy : Byte);
-begin
- inherited Create(GetOrphStr(ErrorCode));
-end;
-
-constructor EReportViewError.CreateFmt(ErrorCode : Integer; const Args : array of const; Dummy : Byte);
-begin
- inherited CreateFmt(GetOrphStr(ErrorCode),Args);
-end;
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovcintl.pas b/Source/3rdParty/Orpheus/ovcintl.pas
deleted file mode 100644
index fed17048..00000000
--- a/Source/3rdParty/Orpheus/ovcintl.pas
+++ /dev/null
@@ -1,1651 +0,0 @@
-{*********************************************************}
-{* OVCINTL.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 ovcintl;
- {-International date/time support class}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Registry, Classes, Forms, SysUtils, OvcConst, OvcData, OvcStr, OvcDate;
-
-type
- TCurrencySt = array[0..5] of AnsiChar;
-
- {.Z+}
- TIntlData = packed record
- {substitution strings for semi-literal mask characters}
- CurrencyLtStr : TCurrencySt; {corresponding string for 'c'}
- CurrencyRtStr : TCurrencySt; {corresponding string for 'C'}
- DecimalChar : AnsiChar; {character used for decimal point}
- CommaChar : AnsiChar; {character used for comma}
- {format specifiers for currency masks}
- CurrDigits : Byte; {number of dec places in currency}
- SlashChar : AnsiChar; {date seperator}
- {characters that represent boolean values}
- TrueChar : AnsiChar;
- FalseChar : AnsiChar;
- YesChar : AnsiChar;
- NoChar : AnsiChar;
- end;
- {.Z-}
-
-type
- TOvcIntlSup = class(TObject)
- {.Z+}
- protected {private}
- FAutoUpdate : Boolean; {true to reset settings when win.ini changes}
-
- {substitution strings for semi-literal mask characters}
- FCurrencyLtStr : TCurrencySt; {corresponding string for 'c'}
- FCurrencyRtStr : TCurrencySt; {corresponding string for 'C'}
- FDecimalChar : AnsiChar; {character used for decimal point}
-
- {general international settings}
- FCommaChar : AnsiChar; {character used for comma}
- FCurrencyDigits : Byte; {number of dec places in currency}
- FListChar : AnsiChar; {list serarater}
- FSlashChar : AnsiChar; {character used to separate dates}
-
- {characters that represent boolean values}
- FTrueChar : AnsiChar;
- FFalseChar : AnsiChar;
- FYesChar : AnsiChar;
- FNoChar : AnsiChar;
-
- {event variables}
- FOnWinIniChange : TNotifyEvent; {notify of win.ini changes}
-
- {internal working variables}
- intlHandle : hWnd; {our window handle}
- w1159 : array[0..5] of AnsiChar;
- w2359 : array[0..5] of AnsiChar;
- wColonChar : AnsiChar;
- wCountry : PAnsiChar;
- wCurrencyForm : Byte;
- wldSub1 : array[0..5] of AnsiChar;
- wldSub2 : array[0..5] of AnsiChar;
- wldSub3 : array[0..5] of AnsiChar;
- wLongDate : array[0..39] of AnsiChar;
- wNegCurrencyForm : Byte;
- wShortDate : array[0..29] of AnsiChar;
- wTLZero : Boolean;
- w12Hour : Boolean;
-
- {property methods}
- function GetCountry : string;
- function GetCurrencyLtStr : string;
- function GetCurrencyRtStr : string;
- procedure SetAutoUpdate(Value : Boolean);
- procedure SetCurrencyLtStr(const Value : string);
- procedure SetCurrencyRtStr(const Value : string);
-
- {internal methods}
- procedure isExtractFromPicture(Picture, S : PAnsiChar; Ch : AnsiChar;
- var I : Integer; Blank, Default : Integer);
- procedure isIntlWndProc(var Msg : TMessage);
- function isMaskCharCount(P : PAnsiChar; MC : AnsiChar) : Word;
- procedure isMergeIntoPicture(Picture : PAnsiChar; Ch : AnsiChar; I : Integer);
- procedure isMergePictureSt(Picture, P : PAnsiChar; MC : AnsiChar; SP : PAnsiChar);
- procedure isPackResult(Picture, S : PAnsiChar);
- procedure isSubstChar(Picture : PAnsiChar; OldCh, NewCh : AnsiChar);
- procedure isSubstCharSim(P : PAnsiChar; OC, NC : AnsiChar);
- function isTimeToTimeStringPrim(Dest, Picture : PAnsiChar; T : TStTime;
- Pack : Boolean; t1159, t2359 : PAnsiChar) : PAnsiChar;
-
- public
- constructor Create;
- destructor Destroy;
- override;
- {.Z-}
-
- function CurrentDateString(const Picture : string;
- Pack : Boolean) : string;
- {.Z+}
- function CurrentDatePChar(Dest : PAnsiChar; Picture : PAnsiChar;
- Pack : Boolean) : PAnsiChar;
- {-returns today's date as a string of the specified form}
- {.Z-}
-
- function CurrentTimeString(const Picture : string; Pack : Boolean) : string;
- {.Z+}
- function CurrentTimePChar(Dest : PAnsiChar; Picture : PAnsiChar; Pack : Boolean) : PAnsiChar;
- {-returns current time as a string of the specified form}
- {.Z-}
-
- function DateToDateString(const Picture : string; Julian : TStDate;
- Pack : Boolean) : string;
- {.Z+}
- function DateToDatePChar(Dest : PAnsiChar; Picture : PAnsiChar; Julian : TStDate;
- Pack : Boolean) : PAnsiChar;
- {.Z-}
- {-convert Julian to a string of the form indicated by Picture}
-
- function DateStringToDMY(const Picture, S : string; var Day, Month, Year : Integer;
- Epoch : Integer) : Boolean;
- {.Z+}
- function DatePCharToDMY(Picture, S : PAnsiChar; var Day, Month, Year : Integer;
- Epoch : Integer) : Boolean;
- {.Z-}
- {-extract day, month, and year from S, returning true if string is valid}
-
- function DateStringIsBlank(const Picture, S : string) : Boolean;
- {.Z+}
- function DatePCharIsBlank(Picture, S : PAnsiChar) : Boolean;
- {.Z-}
- {-return True if the month, day, and year in S are all blank}
-
- function DateStringToDate(const Picture, S : string; Epoch : Integer) : TStDate;
- {.Z+}
- function DatePCharToDate(Picture, S : PAnsiChar; Epoch : Integer) : TStDate;
- {.Z-}
- {-convert St, a string of the form indicated by Picture, to a julian date. Picture and St must be of equal lengths}
-
- function DayOfWeekToString(WeekDay : TDayType) : string;
- {.Z+}
- function DayOfWeekToPChar(Dest : PAnsiChar; WeekDay : TDayType) : PAnsiChar;
- {.Z-}
- {-return a string for the specified day of the week}
-
- function DMYtoDateString(const Picture : string;
- Day, Month, Year : Integer; Pack : Boolean; Epoch : Integer) : string;
- {.Z+}
- function DMYtoDatePChar(Dest : PAnsiChar; Picture : PAnsiChar;
- Day, Month, Year : Integer; Pack : Boolean; Epoch : Integer) : PAnsiChar;
- {.Z-}
- {-merge the month, day, and year into the picture}
-
- function InternationalCurrency(FormChar : AnsiChar; MaxDigits : Byte; Float,
- AddCommas, IsNumeric : Boolean) : string;
- {.Z+}
- function InternationalCurrencyPChar(Dest : PAnsiChar; FormChar : AnsiChar;
- MaxDigits : Byte; Float,
- AddCommas, IsNumeric : Boolean) : PAnsiChar;
- {.Z-}
- {-return a picture mask for a currency string, based on Windows' intl info}
-
- function InternationalDate(ForceCentury : Boolean) : string;
- {.Z+}
- function InternationalDatePChar(Dest : PAnsiChar; ForceCentury : Boolean) : PAnsiChar;
- {.Z-}
- {-return a picture mask for a short date string, based on Windows' international information}
-
- function InternationalLongDate(ShortNames : Boolean; ExcludeDOW : Boolean) : string;
- {.Z+}
- function InternationalLongDatePChar(Dest : PAnsiChar; ShortNames : Boolean; ExcludeDOW : Boolean) : PAnsiChar;
- {.Z-}
- {-return a picture mask for a date string, based on Windows' international information}
-
- function InternationalTime(ShowSeconds : Boolean) : string;
- {.Z+}
- function InternationalTimePChar(Dest : PAnsiChar; ShowSeconds : Boolean) : PAnsiChar;
- {.Z-}
- {-return a picture mask for a time string, based on Windows' international information}
-
- function MonthStringToMonth(const S : string; Width : Byte) : Byte;
- {.Z+}
- function MonthPCharToMonth(S : PAnsiChar; Width : Byte) : Byte;
- {.Z-}
- {-Convert the month name in S to a month (1..12)}
-
- function MonthToString(Month : Integer) : string;
- {.Z+}
- function MonthToPChar(Dest : PAnsiChar; Month : Integer) : PAnsiChar;
- {.Z-}
- {return month name as a string for Month}
-
- procedure ResetInternationalInfo;
- {-read string resources and update internal info to match Windows'}
-
- function TimeStringToHMS(const Picture, S : string; var Hour, Minute, Second : Integer) : Boolean;
- {.Z+}
- function TimePCharToHMS(Picture, S : PAnsiChar; var Hour, Minute, Second : Integer) : Boolean;
- {.Z-}
- {-extract Hours, Minutes, Seconds from St, returning true if string is valid}
-
- function TimeStringToTime(const Picture, S : string) : TStTime;
- {.Z+}
- function TimePCharToTime(Picture, S : PAnsiChar) : TStTime;
- {.Z-}
- {-convert S, a string of the form indicated by Picture, to a Time variable}
-
- function TimeToTimeString(const Picture : string; T : TStTime; Pack : Boolean) : string;
- {.Z+}
- function TimeToTimePChar(Dest : PAnsiChar; Picture : PAnsiChar; T : TStTime; Pack : Boolean) : PAnsiChar;
- {.Z-}
- {-convert T to a string of the form indicated by Picture}
-
- function TimeToAmPmString(const Picture : string; T : TStTime; Pack : Boolean) : string;
- {.Z+}
- function TimeToAmPmPChar(Dest : PAnsiChar; Picture : PAnsiChar; T : TStTime; Pack : Boolean) : PAnsiChar;
- {.Z-}
- {-convert T to a string of the form indicated by Picture. Times are always displayed in am/pm format.}
-
- property AutoUpdate : Boolean
- read FAutoUpdate write SetAutoUpdate;
- property CurrencyLtStr : string
- read GetCurrencyLtStr write SetCurrencyLtStr;
- property CurrencyRtStr : string
- read GetCurrencyRtStr write SetCurrencyRtStr;
- property DecimalChar : AnsiChar
- read FDecimalChar write FDecimalChar;
- property CommaChar : AnsiChar
- read FCommaChar write FCommaChar;
- property Country : string
- read GetCountry;
- property CurrencyDigits : Byte
- read FCurrencyDigits write FCurrencyDigits;
- property ListChar : AnsiChar
- read FListChar write FListChar;
- property SlashChar : AnsiChar
- read FSlashChar write FSlashChar;
- property TrueChar : AnsiChar
- read FTrueChar write FTrueChar;
- property FalseChar : AnsiChar
- read FFalseChar write FFalseChar;
- property YesChar : AnsiChar
- read FYesChar write FYesChar;
- property NoChar : AnsiChar
- read FNoChar write FNoChar;
- property OnWinIniChange : TNotifyEvent
- read FOnWinIniChange write FOnWinIniChange;
- end;
-
-const
- DefaultIntlData : TIntlData = (
- {substitution strings for semi-literal mask characters}
- CurrencyLtStr : '$'; {corresponding string for 'c'}
- CurrencyRtStr : ''; {corresponding string for 'C'}
- DecimalChar : '.'; {character used for decimal point}
- CommaChar : ','; {character used for comma}
- {format specifiers for currency masks}
- CurrDigits : 2; {number of dec places in currency}
- SlashChar : '/'; {date seperator}
- {characters that represent boolean values}
- TrueChar : 'T';
- FalseChar : 'F';
- YesChar : 'Y';
- NoChar : 'N');
-
-var
- {global default international support object}
- OvcIntlSup : TOvcIntlSup;
-
-implementation
-
-{*** Inline routines ***}
-
-{$IFDEF NoAsm}
-function GetMaxWord(A, B : Word) : Word;
-begin
- if A >= B then
- Result := A
- else
- Result := B;
-end;
-{$ELSE}
-function GetMaxWord(A, B : Word) : Word; register;
- {-Return the greater of A and B}
-asm
- and eax,0FFFFH {faster than movzx }
- and edx,0FFFFH {faster than movzx }
- cmp eax,edx {compare A and B }
- jae @@001 {done if ax is greater or equal }
- mov eax,edx {dx is larger, set result }
-@@001:
-end;
-{$ENDIF}
-
-{*** TOvcIntlSup ***}
-
-constructor TOvcIntlSup.Create;
-begin
- inherited Create;
-
- FAutoUpdate := False;
-
- {substitution strings for semi-literal mask characters}
- StrCopy(FCurrencyLtStr, DefaultIntlData.CurrencyLtStr);
- StrCopy(FCurrencyRtStr, DefaultIntlData.CurrencyRtStr);
- FDecimalChar := DefaultIntlData.DecimalChar;
- FCommaChar := DefaultIntlData.CommaChar;
-
- {format specifiers for currency masks}
- FCurrencyDigits := DefaultIntlData.CurrDigits;
- FSlashChar := DefaultIntlData.SlashChar;
-
- {characters that represent boolean values}
- FTrueChar := DefaultIntlData.TrueChar;
- FFalseChar := DefaultIntlData.FalseChar;
- FYesChar := DefaultIntlData.YesChar;
- FNoChar := DefaultIntlData.NoChar;
-
- {get windows international information}
- ResetInternationalInfo;
-end;
-
-function TOvcIntlSup.CurrentDateString(const Picture : string;
- Pack : Boolean) : string;
- {-returns today's date as a string of the specified form}
-begin
- Result := DateToDateString(Picture, CurrentDate, Pack);
-end;
-
-function TOvcIntlSup.CurrentDatePChar(Dest : PAnsiChar; Picture : PAnsiChar;
- Pack : Boolean) : PAnsiChar;
- {-returns today's date as a string of the specified form}
-begin
- Result := DateToDatePChar(Dest, Picture, CurrentDate, Pack);
-end;
-
-function TOvcIntlSup.CurrentTimeString(const Picture : string; Pack : Boolean) : string;
- {-returns current time as a string of the specified form}
-begin
- Result := TimeToTimeString(Picture, CurrentTime, Pack);
-end;
-
-function TOvcIntlSup.CurrentTimePChar(Dest : PAnsiChar; Picture : PAnsiChar; Pack : Boolean) : PAnsiChar;
- {-returns current time as a string of the specified form}
-begin
- Result := TimeToTimePChar(Dest, Picture, CurrentTime, Pack);
-end;
-
-function TOvcIntlSup.DateStringIsBlank(const Picture, S : string) : Boolean;
- {-return True if the month, day, and year in S are all blank}
-var
- Buf1 : array[0..255] of AnsiChar;
- Buf2 : array[0..255] of AnsiChar;
-begin
- StrPCopy(Buf1, Picture);
- StrPCopy(Buf2, S);
- Result := DatePCharIsBlank(Buf1, Buf2);
-end;
-
-function TOvcIntlSup.DatePCharIsBlank(Picture, S : PAnsiChar) : Boolean;
- {-return True if the month, day, and year in S are all blank}
-var
- M, D, Y : Integer;
-begin
- isExtractFromPicture(Picture, S, pmMonthName, M, -2, 0);
- if M = 0 then
- isExtractFromPicture(Picture, S, pmMonth, M, -2, -2);
- isExtractFromPicture(Picture, S, pmDay, D, -2, -2);
- isExtractFromPicture(Picture, S, pmYear, Y, -2, -2);
- Result := (M = -2) and (D = -2) and (Y = -2);
-end;
-
-function TOvcIntlSup.DateStringToDate(const Picture, S : string; Epoch : Integer) : TStDate;
- {-convert St, a string of the form indicated by Picture, to a julian date.
- Picture and St must be of equal lengths}
-var
- Buf1 : array[0..255] of AnsiChar;
- Buf2 : array[0..255] of AnsiChar;
-begin
- StrPCopy(Buf1, Picture);
- StrPCopy(Buf2, S);
- Result := DatePCharToDate(Buf1, Buf2, Epoch);
-end;
-
-function TOvcIntlSup.DatePCharToDate(Picture, S : PAnsiChar; Epoch : Integer) : TStDate;
- {-convert St, a string of the form indicated by Picture, to a julian date.
- Picture and St must be of equal lengths}
-var
- Month, Day, Year : Integer;
-begin
- {extract day, month, year from St}
- if DatePCharToDMY(Picture, S, Day, Month, Year, Epoch) then
- {convert to julian date}
- Result := DMYtoStDate(Day, Month, Year, Epoch)
- else
- Result := BadDate;
-end;
-
-function TOvcIntlSup.DateStringToDMY(const Picture, S : string; var Day, Month, Year : Integer;
- Epoch : Integer) : Boolean;
- {-extract day, month, and year from S, returning true if string is valid}
-var
- Buf1 : array[0..255] of AnsiChar;
- Buf2 : array[0..255] of AnsiChar;
-begin
- StrPCopy(Buf1, Picture);
- StrPCopy(Buf2, S);
- Result := DatePCharToDMY(Buf1, Buf2, Day, Month, Year, Epoch);
-end;
-
-function TOvcIntlSup.DatePCharToDMY(Picture, S : PAnsiChar; var Day, Month, Year : Integer;
- Epoch : Integer) : Boolean;
- {-extract day, month, and year from S, returning true if string is valid}
-begin
- Result := False;
- if StrLen(Picture) <> StrLen(S) then
- Exit;
-
- isExtractFromPicture(Picture, S, pmMonthName, Month, -1, 0);
- if Month = 0 then
- isExtractFromPicture(Picture, S, pmMonth, Month, -1, DefaultMonth);
- isExtractFromPicture(Picture, S, pmDay, Day, -1, 1);
- isExtractFromPicture(Picture, S, pmYear, Year, -1, DefaultYear);
- Result := ValidDate(Day, Month, Year, Epoch);
-end;
-
-function TOvcIntlSup.DateToDateString(const Picture : string;
- Julian : TStDate; Pack : Boolean) : string;
- {-convert Julian to a string of the form indicated by Picture}
-var
- Buf1 : array[0..255] of AnsiChar;
- Buf2 : array[0..255] of AnsiChar;
-begin
- StrPCopy(Buf1, Picture);
- Result := StrPas(DateToDatePChar(Buf2, Buf1, Julian, Pack));
-end;
-
-function TOvcIntlSup.DateToDatePChar(Dest : PAnsiChar; Picture : PAnsiChar;
- Julian : TStDate; Pack : Boolean) : PAnsiChar;
- {-convert Julian to a string of the form indicated by Picture}
-var
- Month, Day, Year : Integer;
-begin
- Move(Picture[0], Dest[0], StrLen(Picture)+1);
- if Julian = BadDate then begin
- {map picture characters to spaces}
- isSubstChar(Dest, pmMonth, ' ');
- isSubstChar(Dest, pmMonthName, ' ');
- isSubstChar(Dest, pmDay, ' ');
- isSubstChar(Dest, pmYear, ' ');
- isSubstChar(Dest, pmWeekDay, ' ');
- isMergePictureSt(Picture, Dest, pmLongDateSub1, wldSub1);
- isMergePictureSt(Picture, Dest, pmLongDateSub2, wldSub2);
- isMergePictureSt(Picture, Dest, pmLongDateSub3, wldSub3);
-
- {map slashes}
- isSubstChar(Dest, pmDateSlash, SlashChar);
-
- Result := Dest;
- end else begin
- {convert Julian to day/month/year}
- StDateToDMY(Julian, Day, Month, Year);
- {merge the month, day, and year into the picture}
- Result := DMYtoDatePChar(Dest, Picture, Day, Month, Year, Pack, 0);
- end;
-end;
-
-function TOvcIntlSup.DayOfWeekToString(WeekDay : TDayType) : string;
- {-return the day of the week specified by WeekDay as a string. Will
- honor the international names as specified in the INI file.}
-begin
- Result := LongDayNames[Ord(WeekDay)+1];
-end;
-
-function TOvcIntlSup.DayOfWeekToPChar(Dest : PAnsiChar; WeekDay : TDayType) : PAnsiChar;
- {-return the day of the week specified by WeekDay as a string in Dest. Will
- honor the international names as specified in the INI file.}
-begin
- Result := Dest;
- StrPCopy(Dest, LongDayNames[Ord(WeekDay)+1]);
-end;
-
-destructor TOvcIntlSup.Destroy;
-begin
-{$IFNDEF LCL}
- if intlHandle <> 0 then
- {$IFDEF VERSION6}
- Classes.DeallocateHWnd(intlHandle);
- {$ELSE}
- DeallocateHWnd(intlHandle);
- {$ENDIF}
-{$ENDIF}
- StrDispose(wCountry);
- inherited Destroy;
-end;
-
-function TOvcIntlSup.DMYtoDateString(const Picture : string; Day, Month,
- Year : Integer; Pack : Boolean; Epoch : Integer) : string;
- {-merge the month, day, and year into the picture}
-var
- Buf1 : array[0..255] of AnsiChar;
- Buf2 : array[0..255] of AnsiChar;
-begin
- StrPCopy(Buf1, Picture);
- Result := StrPas(DMYtoDatePChar(Buf2, Buf1, Day, Month, Year, Pack, Epoch));
-end;
-
-function TOvcIntlSup.DMYtoDatePChar(Dest : PAnsiChar; Picture : PAnsiChar; Day, Month,
- Year : Integer; Pack : Boolean; Epoch : Integer) : PAnsiChar;
- {-merge the month, day, and year into the picture}
-var
- DOW : Integer;
- EpochCent : Integer;
-begin
- Move(Picture[0], Dest[0], StrLen(Picture)+1);
-
- EpochCent := (Epoch div 100)*100;
- if Word(Year) < 100 then begin
- if Year < (Epoch mod 100) then
- Inc(Year, EpochCent + 100)
- else
- Inc(Year, EpochCent)
- end;
-
- DOW := Integer(DayOfWeekDMY(Day, Month, Year, Epoch));
- isMergeIntoPicture(Dest, pmMonth, Month);
- isMergeIntoPicture(Dest, pmDay, Day);
- isMergeIntoPicture(Dest, pmYear, Year);
- isMergeIntoPicture(Dest, pmMonthName, Month);
- isMergeIntoPicture(Dest, pmWeekDay, DOW);
-
- {map slashes}
- isSubstChar(Dest, pmDateSlash, SlashChar);
-
- isMergePictureSt(Picture, Dest, pmLongDateSub1, wldSub1);
- isMergePictureSt(Picture, Dest, pmLongDateSub2, wldSub2);
- isMergePictureSt(Picture, Dest, pmLongDateSub3, wldSub3);
-
- if Pack then
- isPackResult(Picture, Dest);
-
- Result := Dest;
-end;
-
-function TOvcIntlSup.GetCountry : string;
- {-return the country setting}
-begin
- Result := StrPas(wCountry);
-end;
-
-function TOvcIntlSup.GetCurrencyLtStr : string;
-begin
- Result := StrPas(FCurrencyLtStr);
-end;
-
-function TOvcIntlSup.GetCurrencyRtStr : string;
-begin
- Result := StrPas(FCurrencyRtStr);
-end;
-
-function TOvcIntlSup.InternationalCurrency(FormChar : AnsiChar; MaxDigits : Byte; Float,
- AddCommas, IsNumeric : Boolean) : string;
- {-Return a picture mask for a currency string, based on Windows' intl info}
-var
- Buf1 : array[0..255] of AnsiChar;
-begin
- Result := StrPas(InternationalCurrencyPChar(Buf1, FormChar, MaxDigits,
- Float, AddCommas, IsNumeric));
-end;
-
-function TOvcIntlSup.InternationalCurrencyPChar(Dest : PAnsiChar; FormChar : AnsiChar;
- MaxDigits : Byte; Float, AddCommas, IsNumeric : Boolean) : PAnsiChar;
- {-Return a picture mask for a currency string, based on Windows' intl info}
-const
- NP : array[0..1] of AnsiChar = pmNegParens+#0;
- NH : array[0..1] of AnsiChar = pmNegHere+#0;
-var
- CLSlen, DLen, I, J : Word;
- Tmp : array[0..10] of AnsiChar;
-begin
- Dest[0] := #0;
- Result := Dest;
-
- if (MaxDigits = 0) then
- Exit;
-
- {initialize Dest with the numeric part of the string to left of decimal point}
- I := Pred(MaxDigits) div 3 ;
- J := Word(MaxDigits)+(I*Ord(AddCommas));
- if J > 247 then
- DLen := 247
- else
- DLen := J;
- FillChar(Dest[0], DLen, FormChar);
- Dest[DLen] := #0;
-
- if AddCommas then begin
- {insert commas at appropriate points}
- J := 0;
- for I := DLen-1 downto 0 do
- if J < 3 then
- Inc(J)
- else begin
- Dest[I] := pmComma;
- J := 0;
- end;
- end;
-
- {add in the decimals}
- if CurrencyDigits > 0 then begin
- Dest[DLen] := pmDecimalPt;
- FillChar(Dest[DLen+1], CurrencyDigits, FormChar);
- Inc(DLen, CurrencyDigits+1);
- Dest[DLen] := #0;
- end;
-
- {do we need a minus before the currency symbol}
- if (wNegCurrencyForm = 6) then
- StrCat(Dest, NH);
-
- {see if we can do a floating currency symbol}
- if Float then
- Float := not Odd(wCurrencyForm);
-
- {plug in the picture characters for the currency symbol}
- CLSlen := StrLen(FCurrencyLtStr);
- if Float then
- StrStInsertPrim(Dest, CharStrPChar(Tmp, pmFloatDollar, CLSlen), 0)
- else if not Odd(wCurrencyForm) then
- StrStInsertPrim(Dest, CharStrPChar(Tmp, pmCurrencyLt, CLSlen), 0)
- else
- StrCat(Dest, CharStrPChar(Tmp, pmCurrencyRt, StrLen(FCurrencyRtStr)));
-
- {plug in special minus characters}
- if IsNumeric then
- case wNegCurrencyForm of
- 0, 4 :
- StrCat(Dest, NP);
- 3, 7, 10 :
- if Odd(wCurrencyForm) then
- StrCat(Dest, NH);
- end;
-end;
-
-function TOvcIntlSup.InternationalDate(ForceCentury : Boolean) : string;
- {-return a picture mask for a short date string, based on Windows' international information}
-var
- Buf : array[0..255] of AnsiChar;
-begin
- InternationalDatePChar(Buf, ForceCentury);
- Result := StrPas(Buf);
-end;
-
-function TOvcIntlSup.InternationalDatePChar(Dest : PAnsiChar;
- ForceCentury : Boolean) : PAnsiChar;
- {-return a picture mask for a date string, based on Windows' int'l info}
-
-
- procedure FixMask(MC : AnsiChar; DL : Integer);
- var
- I : Cardinal;
- J, AL : Word;
- MCT : AnsiChar;
- Found : Boolean;
- begin
- {find number of matching characters}
- MCT := MC;
-
- Found := StrChPos(Dest, MC, I);
- if not Found then begin
- MCT := UpCase(MC);
- Found := StrChPos(Dest, MCT, I);
- end;
- if not Found then
- Exit;
-
- {pad substring to desired length}
- AL := isMaskCharCount(Dest, MCT);
- if AL < DL then
- for J := 1 to DL-AL do
- StrChInsertPrim(Dest, MCT, I);
-
-
- if MC <> pmYear then
- {choose blank/zero padding}
- case AL of
- 1 : if MCT = MC then
- isSubstCharSim(Dest, MCT, UpCase(MCT));
- 2 : if MCT <> MC then
- isSubstCharSim(Dest, MCT, MC);
- end;
- end;
-
-begin
- {copy Windows mask into our var}
- StrCopy(Dest, wShortDate);
-
- {if single Day marker, make double}
- FixMask(pmDay, 2);
-
- {if single Month marker, make double}
- FixMask(pmMonth, 2);
-
- {force yyyy if desired}
- FixMask(pmYear, 2 shl Ord(ForceCentury));
-
- Result := Dest;
-end;
-
-function TOvcIntlSup.InternationalLongDate(ShortNames : Boolean; ExcludeDOW : Boolean) : string;
- {-return a picture mask for a date string, based on Windows' int'l info}
-var
- Buf : array[0..255] of AnsiChar;
-begin
- Result := StrPas(InternationalLongDatePChar(Buf, ShortNames, ExcludeDOW));
-end;
-
-function TOvcIntlSup.InternationalLongDatePChar(Dest : PAnsiChar; ShortNames : Boolean;
- ExcludeDOW : Boolean) : PAnsiChar;
- {-return a picture mask for a date string, based on Windows' int'l info}
-var
- I : Cardinal;
- WC : Word;
- Temp : array[0..80] of AnsiChar;
- Stop : Boolean;
-
- function LongestMonthName : Word;
- var
- I : Word;
- begin
- Result := 0;
- for I := 1 to 12 do
- Result := GetMaxWord(Result, Length(LongMonthNames[I]));
- end;
-
- function LongestDayName : Word;
- var
- D : TDayType;
- begin
- Result := 0;
- for D := Sunday to Saturday do
- Result := GetMaxWord(Result, Length(LongDayNames[Ord(D)+1]));
- end;
-
- procedure FixMask(MC : AnsiChar; DL : Integer);
- var
- I : Cardinal;
- J, AL : Word;
- MCT : AnsiChar;
- Found : Boolean;
- begin
- {find first matching mask character}
- MCT := MC;
- Found := StrChPos(Temp, MC, I);
- if not Found then begin
- MCT := UpCase(MC);
- Found := StrChPos(Temp, MCT, I);
- end;
- if not Found then
- Exit;
-
- {pad substring to desired length}
- AL := isMaskCharCount(Temp, MCT);
- if AL < DL then begin
- for J := 1 to DL-AL do
- StrChInsertPrim(Temp, MCT, I);
- end else if (AL > DL) then
- StrStDeletePrim(Temp, I, AL-DL);
-
- if MC <> pmYear then
- {choose blank/zero padding}
- case AL of
- 1 : if MCT = MC then
- isSubstCharSim(Temp, MCT, UpCase(MCT));
- 2 : if MCT <> MC then
- isSubstCharSim(Temp, MCT, MC);
- end;
- end;
-
-begin
- {copy Windows mask into temporary var}
- StrCopy(Temp, wLongDate);
-
- if ExcludeDOW then begin
- {remove day-of-week and any junk that follows}
- if StrChPos(Temp, pmWeekDay, I) then begin
- WC := 1;
- Stop := False;
- repeat
- case LoCaseChar(Temp[I+WC]) of
- #0, pmMonth, pmDay, pmYear, pmMonthName : Stop := True;
- else
- Inc(WC);
- end;
- until Stop;
- StrStDeletePrim(Temp, I, WC);
- end;
- end else if ShortNames then
- FixMask(pmWeekDay, 3)
- else if isMaskCharCount(Temp, pmWeekday) = 4 then
- FixMask(pmWeekDay, LongestDayName);
-
- {fix month names}
- if ShortNames then
- FixMask(pmMonthName, 3)
- else if isMaskCharCount(Temp, pmMonthName) = 4 then
- FixMask(pmMonthName, LongestMonthName);
-
- {if single Day marker, make double}
- FixMask(pmDay, 2);
-
- {if single Month marker, make double}
- FixMask(pmMonth, 2);
-
- {force yyyy}
- FixMask(pmYear, 4);
-
- {copy result into Dest}
- StrCopy(Dest, Temp);
- Result := Dest;
-end;
-
-function TOvcIntlSup.InternationalTime(ShowSeconds : Boolean) : string;
- {-return a picture mask for a time string, based on Windows' int'l info}
-var
- Buf : array[0..255] of AnsiChar;
-begin
- Result := StrPas(InternationalTimePChar(Buf, ShowSeconds));
-end;
-
-function TOvcIntlSup.InternationalTimePChar(Dest : PAnsiChar; ShowSeconds : Boolean) : PAnsiChar;
- {-return a picture mask for a time string, based on Windows' int'l info}
-var
- SL, ML : Word;
- S : array[0..20] of AnsiChar;
-begin
- {format the default string}
- StrCopy(S, 'hh:mm:ss');
- if not wTLZero then
- S[0] := pmHourU;
-
- {show seconds?}
- if not ShowSeconds then
- S[5] := #0;
-
- {handle international AM/PM markers}
- if w12Hour then begin
- ML := GetMaxWord(StrLen(@w1159), StrLen(@w2359));
- if (ML <> 0) then begin
- SL := StrLen(S);
- S[SL] := ' ';
- FillChar(S[SL+1], ML, pmAmPm);
- S[SL+ML+1] := #0;
- end;
- end;
-
- StrCopy(Dest, S);
- Result := Dest;
-end;
-
-procedure TOvcIntlSup.isIntlWndProc(var Msg : TMessage);
- {-window procedure to catch WM_WININICHANGE messages}
-begin
- with Msg do
- if AutoUpdate and (Msg = WM_WININICHANGE) then
- try
- if Assigned(FOnWinIniChange) then
- FOnWinIniChange(Self)
- else
- ResetInternationalInfo;
- except
- Application.HandleException(Self);
- end
- else
- Result := DefWindowProc(intlHandle, Msg, wParam, lParam);
-end;
-
-procedure TOvcIntlSup.isExtractFromPicture(Picture, S : PAnsiChar;
- Ch : AnsiChar; var I : Integer;
- Blank, Default : Integer);
- {-extract the value of the subfield specified by Ch from S and return in
- I. I will be set to -1 in case of an error, Blank if the subfield exists
- in Picture but is empty, Default if the subfield doesn't exist in
- Picture.}
-var
- PTmp : Array[0..20] of AnsiChar;
- J, K, W : Cardinal;
- Code : Integer;
- Found,
- UpFound : Boolean;
-begin
- {find the start of the subfield}
- I := Default;
- Found := StrChPos(Picture, Ch, J);
- Ch := UpCaseChar(Ch);
- UpFound := StrChPos(Picture, Ch, K);
-
- if not Found or (UpFound and (K < J)) then begin
- J := K;
- Found := UpFound;
- end;
- if not Found or (StrLen(S) <> StrLen(Picture)) then
- Exit;
-
- {extract the substring}
- PTmp[0] := #0;
- W := 0;
- K := 0;
- while (UpCaseChar(Picture[J]) = Ch) and (J < StrLen(Picture)) do begin
- if S[J] <> ' ' then begin
- PTmp[k] := S[J];
- Inc(K);
- PTmp[k] := #0;
- end;
- Inc(J);
- Inc(W);
- end;
-
- if StrLen(PTmp) = 0 then
- I := Blank
- else if Ch = pmMonthNameU then begin
- I := MonthPCharToMonth(PTmp, W);
- if I = 0 then
- I := -1;
- end else begin
- {convert to a value}
- Val(PTmp, I, Code);
- if Code <> 0 then
- I := -1;
- end;
-end;
-
-function TOvcIntlSup.isMaskCharCount(P : PAnsiChar; MC : AnsiChar) : Word;
- {-return the number of mask characters (MC) in P}
-var
- I : Cardinal;
-begin
- if StrChPos(P, MC, I) then begin
- Result := 1;
- while P[I+Result] = MC do
- Inc(Result);
- end else
- Result := 0;
-end;
-
-procedure TOvcIntlSup.isMergePictureSt(Picture, P : PAnsiChar; MC : AnsiChar; SP : PAnsiChar);
-var
- I, J : Cardinal;
-begin
- if not StrChPos(Picture, MC, I) then
- Exit;
- J := 0;
- while Picture[I] = MC do begin
- if SP[J] = #0 then
- P[I] := ' '
- else begin
- P[I] := SP[J];
- Inc(J);
- end;
- Inc(I);
- end;
-end;
-
-procedure TOvcIntlSup.isMergeIntoPicture(Picture : PAnsiChar; Ch : AnsiChar;
- I : Integer);
- {-merge I into location in Picture indicated by format character Ch}
-var
- Tmp : string[MaxDateLen];
- TLen : Byte absolute Tmp;
- J : Cardinal;
- K, L : Word;
- UCh, CPJ, CTI : AnsiChar;
- Done : Boolean;
-begin
- {find the start of the subfield}
- UCh := UpCaseChar(Ch);
- if not StrChPos(Picture, Ch, J) then
- if not StrChPos(Picture, UCh, J) then
- Exit;
-
- {find the end of the subfield}
- K := J;
- while (J < StrLen(Picture)) and (UpCaseChar(Picture[J]) = UCh) do
- Inc(J);
- Dec(J);
-
- if (UCh = pmWeekDayU) or (UCh = pmMonthNameU) then begin
- if UCh = pmWeekDayU then
- case I of
- Ord(Sunday)..Ord(Saturday) :
- Tmp := LongDayNames[I+1];
- else
- Tmp := '';
- end
- else
- case I of
- 1..12 :
- Tmp := LongMonthNames[I];
- else
- Tmp := '';
- end;
- K := Succ(J-K);
- if K > TLen then
- FillChar(Tmp[TLen+1], K-TLen, ' ');
- TLen := K;
- end else
- {convert I to a string}
- Str(I:MaxDateLen, Tmp);
-
- {now merge}
- L := TLen;
- Done := False;
- CPJ := Picture[J];
-
- while (UpCaseChar(CPJ) = UCh) and not Done do begin
- CTI := Tmp[L];
- if (UCh = pmMonthNameU) or (UCh = pmWeekDayU) then begin
- case CPJ of
- pmMonthNameU, pmWeekDayU :
- CTI := UpCaseChar(CTI);
- end;
- end
- {change spaces to 0's if desired}
- else if (CPJ >= 'a') and (CTI = ' ') then
- CTI := '0';
- Picture[J] := CTI;
- Done := (J = 0) or (L = 0);
- if not Done then begin
- Dec(J);
- Dec(L);
- end;
- CPJ := Picture[J];
- end;
-end;
-
-procedure TOvcIntlSup.isPackResult(Picture, S : PAnsiChar);
- {-remove unnecessary blanks from S}
-var
- Temp : array[0..80] of AnsiChar;
- I, J : Integer;
-begin
- FillChar(Temp, SizeOf(Temp), #0);
- I := 0;
- J := 0;
- while Picture[I] <> #0 do begin
- case Picture[I] of
- pmMonthU, pmDayU, pmMonthName, pmMonthNameU, pmWeekDay,
- pmWeekDayU, pmHourU, {pmMinU,} pmSecondU :
- if S[I] <> ' ' then begin
- Temp[J] := S[I];
- Inc(J);
- end;
- pmAmPm :
- if S[I] <> ' ' then begin
- Temp[J] := S[I];
- Inc(J);
- end
- else if (I > 0) and (Picture[I-1] = ' ') then begin
- Dec(J);
- Temp[J] := #0;
- end;
- else
- Temp[J] := S[I];
- Inc(J);
- end;
- Inc(I);
- end;
-
- StrCopy(S, Temp);
-end;
-
-procedure TOvcIntlSup.isSubstChar(Picture : PAnsiChar; OldCh, NewCh : AnsiChar);
- {-replace all instances of OldCh in Picture with NewCh}
-var
- I : Byte;
- UpCh : AnsiChar;
- Temp : Cardinal;
-begin
- UpCh := UpCaseChar(OldCh);
- if StrChPos(Picture, OldCh, Temp) or
- StrChPos(Picture, UpCh, Temp) then
- for I := 0 to StrLen(Picture)-1 do
- if UpCaseChar(Picture[I]) = UpCh then
- Picture[I] := NewCh;
-end;
-
-procedure TOvcIntlSup.isSubstCharSim(P : PAnsiChar; OC, NC : AnsiChar);
-begin
- while P^ <> #0 do begin
- if P^ = OC then
- P^ := NC;
- Inc(P);
- end;
-end;
-
-function TOvcIntlSup.isTimeToTimeStringPrim(Dest, Picture : PAnsiChar;
- T : TStTime; Pack : Boolean;
- t1159, t2359 : PAnsiChar) : PAnsiChar;
- {-convert T to a string of the form indicated by Picture}
-var
- I : Word;
- Hours : Byte;
- Minutes : Byte;
- Seconds : Byte;
- P : PAnsiChar;
- TPos : Cardinal;
- Found : Boolean;
-begin
- {merge the hours, minutes, and seconds into the picture}
- StTimeToHMS(T, Hours, Minutes, Seconds);
- StrCopy(Dest, Picture);
-
- P := nil;
-
- {check for TimeOnly}
- Found := StrChPos(Dest, pmAmPm, TPos);
- if Found then begin
- if (Hours >= 12) then
- P := t2359
- else
- P := t1159;
- if (t1159[0] <> #0) and (t2359[0] <> #0) then begin
- {adjust hours}
- case Hours of
- 0 : Hours := 12;
- 13..23 : Dec(Hours, 12);
- end;
- end;
- end;
-
- if T = BadTime then begin
- {map picture characters to spaces}
- isSubstChar(Dest, pmHour, ' ');
- isSubstChar(Dest, pmMinute, ' ');
- isSubstChar(Dest, pmSecond, ' ');
- end else begin
- {merge the numbers into the picture}
- isMergeIntoPicture(Dest, pmHour, Hours);
- isMergeIntoPicture(Dest, pmMinute, Minutes);
- isMergeIntoPicture(Dest, pmSecond, Seconds);
- end;
-
- {map colons}
- isSubstChar(Dest, pmTimeColon, wColonChar);
-
- {plug in AM/PM string if appropriate}
- if Found then begin
- if (t1159[0] = #0) and (t2359[0] = #0) then
- isSubstCharSim(@Dest[TPos], pmAmPm, ' ')
- else if (T = BadTime) and (t1159[0] = #0) then
- isSubstCharSim(@Dest[TPos], pmAmPm, ' ')
- else begin
- I := 0;
- while (Dest[TPos] = pmAmPm) and (P[I] <> #0) do begin
- Dest[TPos] := P[I];
- Inc(I);
- Inc(TPos);
- end;
- end;
- end;
-
- if Pack and (T <> BadTime) then
- isPackResult(Picture, Dest);
-
- Result := Dest;
-end;
-
-function TOvcIntlSup.MonthStringToMonth(const S : string; Width : Byte) : Byte;
- {-Convert the month name in MSt to a month (1..12)}
-var
- I : Word;
- Mt : string[MaxDateLen];
- MLen : Byte absolute Mt;
- St : string[MaxDateLen];
- SLen : Byte absolute St;
-begin
- Result := 0;
- Mt := AnsiUpperCase(S);
- if Width > MLen then
- FillChar(Mt[MLen+1], Width-MLen, ' ');
- MLen := Width;
-
- for I := 1 to 12 do begin
- St := AnsiUpperCase(LongMonthNames[I]);
- if Width > SLen then
- FillChar(St[SLen+1], Width-SLen, ' ');
- SLen := Width;
- if Mt = St then begin
- Result := I;
- Break;
- end;
- end;
-end;
-
-function TOvcIntlSup.MonthPCharToMonth(S : PAnsiChar; Width : Byte) : Byte;
- {-convert the month name in S to a month (1..12)}
-var
- I : Word;
- Mt : string[MaxDateLen];
- MLen : Byte absolute Mt;
- St : string[MaxDateLen];
- SLen : Byte absolute St;
-begin
- Result := 0;
- Mt := AnsiUpperCase(StrPas(S));
- if Width > MLen then
- FillChar(Mt[MLen+1], Width-MLen, ' ');
- MLen := Width;
-
- for I := 1 to 12 do begin
- St := AnsiUpperCase(LongMonthNames[I]);
- if Width > SLen then
- FillChar(St[SLen+1], Width-SLen, ' ');
- SLen := Width;
- if Mt = St then begin
- Result := I;
- Break;
- end;
- end;
-end;
-
-function TOvcIntlSup.MonthToString(Month : Integer) : string;
- {-return month name as a string for Month}
-begin
- if (Month >= 1) and (Month <= 12) then
- Result := LongMonthNames[Month]
- else
- Result := '';
-end;
-
-function TOvcIntlSup.MonthToPChar(Dest : PAnsiChar; Month : Integer) : PAnsiChar;
- {-return month name as a string for Month}
-begin
- Result := Dest;
- if (Month >= 1) and (Month <= 12) then
- StrPCopy(Dest, LongMonthNames[Month])
- else
- Dest[0] := #0;
-end;
-
-procedure TOvcIntlSup.ResetInternationalInfo;
- {-read Window's international information and string resources}
-var
- S : string;
- I : Cardinal;
- Buf : array[0..255] of AnsiChar;
- R : TRegistry;
-
- procedure GetIntlString(S, Def, Buf : PAnsiChar; Size : Word);
- begin
- GetProfileString('intl', S, Def, Buf, Size);
- end;
-
- function GetIntlChar(S, Def : PAnsiChar) : AnsiChar;
- var
- B : array[0..5] of AnsiChar;
- begin
- GetIntlString(S, Def, B, SizeOf(B));
- Result := B[0];
- if (Result = #0) then
- Result := Def[0];
- end;
-
- procedure ExtractSubString(SubChar : AnsiChar; Dest : PAnsiChar);
- var
- I, Temp : Cardinal;
- L : Word;
- begin
- FillChar(Dest^, SizeOf(wldSub1), 0);
- if not StrChPos(wLongDate, '''', I) then
- Exit;
-
- {delete the first quote}
- StrChDeletePrim(wLongDate, I);
-
- {assure that there is another quote}
- if not StrChPos(wLongDate, '''', Temp) then
- Exit;
-
- {copy substring into Dest, replace substring with SubChar}
- L := 0;
- while wLongDate[I] <> '''' do
- if L < SizeOf(wldSub1) then begin
- Dest[L] := wLongDate[I];
- Inc(L);
- wLongDate[I] := SubChar;
- Inc(I);
- end else
- StrChDeletePrim(wLongDate, I);
-
- {delete the second quote}
- StrChDeletePrim(wLongDate, I);
- end;
-
-begin
- FDecimalChar := GetIntlChar('sDecimal',
- @DefaultIntlData.DecimalChar);
- FCommaChar := GetIntlChar('sThousand',
- @DefaultIntlData.CommaChar);
- FCurrencyDigits := GetProfileInt('intl', 'iCurrDigits',
- DefaultIntlData.CurrDigits);
- if (FCommaChar = FDecimalChar) then begin
- FDecimalChar := DefaultIntlData.DecimalChar;
- FCommaChar := DefaultIntlData.CommaChar;
- end;
- wNegCurrencyForm := GetProfileInt('intl', 'iNegCurr', 0);
- FListChar := GetIntlChar('sList', ',');
-
- GetIntlString('sCountry', '', Buf, SizeOf(Buf));
- wCountry := StrNew(Buf);
-
- GetIntlString('sCurrency', DefaultIntlData.CurrencyLtStr,
- FCurrencyLtStr, SizeOf(FCurrencyLtStr));
- StrCopy(FCurrencyRtStr, FCurrencyLtStr);
-
- wCurrencyForm := GetProfileInt('intl', 'iCurrency', 0);
- case wCurrencyForm of
- 0 : {};
- 1 : {};
- 2 : StrCat(FCurrencyLtStr, ' ');
- 3 : StrChInsertPrim(FCurrencyRtStr, ' ', 0);
- end;
-
- wTLZero := GetProfileInt('intl', 'iTLZero', 0) <> 0;
- w12Hour := LongTimeFormat[Length(LongTimeFormat)] = 'M';
-
- wColonChar := GetIntlChar('sTTime', ':');
- FSlashChar := GetIntlChar('sDate', @DefaultIntlData.SlashChar);
- GetIntlString('s1159', 'AM', w1159, SizeOf(w1159));
- GetIntlString('s2359', 'PM', w2359, SizeOf(w2359));
-
- {get short date mask and fix it up}
-{$IFDEF MSWINDOWS}
- R := TRegistry.Create;
- try
- R.RootKey := HKEY_CURRENT_USER;
- if R.OpenKey('Control Panel\International', False) then begin
- try
- if R.ValueExists('sShortDate') then
- StrPCopy(wShortDate, R.ReadString('sShortDate'))
- else
- GetIntlString('sShortDate', 'MM/dd/yy',
- wShortDate, SizeOf(wShortDate));
- finally
- R.CloseKey;
- end;
- end else
- GetIntlString('sShortDate', 'MM/dd/yy',
- wShortDate, SizeOf(wShortDate));
- finally
- R.Free;
- end;
-{$ELSE}
- GetIntlString('sShortDate', 'MM/dd/yy',
- wShortDate, SizeOf(wShortDate));
-{$ENDIF}
-
- I := 0;
- while wShortDate[I] <> #0 do begin
- if wShortDate[I] = SlashChar then
- wShortDate[I] := '/';
- Inc(I);
- end;
-
- {get long date mask and fix it up}
- GetIntlString('sLongDate', 'dddd, MMMM dd, yyyy',
- wLongDate, SizeOf(wLongDate));
- ExtractSubString(pmLongDateSub1, wldSub1);
- ExtractSubString(pmLongDateSub2, wldSub2);
- ExtractSubString(pmLongDateSub3, wldSub3);
-
- {replace ddd/dddd with www/wwww}
- if StrStPos(wLongDate, 'ddd', I) then
- while wLongDate[I] = 'd' do begin
- wLongDate[I] := 'w';
- Inc(I);
- end;
-
- {replace MMM/MMMM with nnn/nnnn}
- if StrStPos(wShortDate, 'MMM', I) then
- while wShortDate[I] = 'M' do begin
- wShortDate[I] := 'n';
- Inc(I);
- end;
-
- {replace MMM/MMMM with nnn/nnnn}
- if StrStPos(wLongDate, 'MMM', I) then
- while wLongDate[I] = 'M' do begin
- wLongDate[I] := 'n';
- Inc(I);
- end;
-
- {deal with oddities concerning . and ,}
- I := 0;
- while wLongDate[I] <> #0 do begin
- case wLongDate[I] of
- '.', ',' :
- if wLongDate[I+1] <> ' ' then begin
- StrChInsertPrim(wLongDate, ' ', I+1);
- Inc(I);
- end;
- end;
- Inc(I);
- end;
-
- {get Y/N and T/F values}
- S := GetOrphStr(SCYes);
- if Length(S) = 1 then
- YesChar := S[1];
- S := GetOrphStr(SCNo);
- if Length(S) = 1 then
- NoChar := S[1];
- S := GetOrphStr(SCTrue);
- if Length(S) = 1 then
- TrueChar := S[1];
- S := GetOrphStr(SCFalse);
- if Length(S) = 1 then
- FalseChar := S[1];
-end;
-
-procedure TOvcIntlSup.SetAutoUpdate(Value : Boolean);
- {-set the AutoUpdate option}
-begin
- if Value <> FAutoUpdate then begin
- FAutoUpdate := Value;
-// AllocateHWnd not available in LCL to create non-visual window that
-// responds to messages sent to control. But not needed?
-{$IFNDEF LCL}
- if FAutoUpdate then
- {allocate our window handle}
- {$IFDEF VERSION6}
- intlHandle := Classes.AllocateHWnd(isIntlWndProc)
- {$ELSE}
- intlHandle := AllocateHWnd(isIntlWndProc)
- {$ENDIF}
- else begin
- {deallocate our window handle}
- if intlHandle <> 0 then
- {$IFDEF VERSION6}
- Classes.DeallocateHWnd(intlHandle);
- {$ELSE}
- DeallocateHWnd(intlHandle);
- {$ENDIF}
- intlHandle := 0;
- end;
-{$ENDIF}
- end;
-end;
-
-procedure TOvcIntlSup.SetCurrencyLtStr(const Value : string);
-begin
- StrPLCopy(FCurrencyLtStr, Value, SizeOf(FCurrencyLtStr)-1);
-end;
-
-procedure TOvcIntlSup.SetCurrencyRtStr(const Value : string);
-begin
- StrPLCopy(FCurrencyRtStr, Value, SizeOf(FCurrencyRtStr)-1);
-end;
-
-function TOvcIntlSup.TimeStringToHMS(const Picture, S : string;
- var Hour, Minute, Second : Integer) : Boolean;
- {-extract Hours, Minutes, Seconds from St, returning true if string is valid}
-var
- Buf1 : array[0..255] of AnsiChar;
- Buf2 : array[0..255] of AnsiChar;
-begin
- StrPCopy(Buf1, Picture);
- StrPCopy(Buf2, S);
- Result := TimePCharToHMS(Buf1, Buf2, Hour, Minute, Second);
-end;
-
-function TOvcIntlSup.TimePCharToHMS(Picture, S : PAnsiChar;
- var Hour, Minute, Second : Integer) : Boolean;
- {-extract Hours, Minutes, Seconds from St, returning true if string is valid}
-var
- I, J : Cardinal;
- Tmp,
- t1159,
- t2359 : array[0..20] of AnsiChar;
-begin
- Result := False;
- if StrLen(Picture) <> StrLen(S) then
- Exit;
-
- {extract hours, minutes, seconds from St}
- isExtractFromPicture(Picture, S, pmHour, Hour, -1, 0);
- isExtractFromPicture(Picture, S, pmMinute, Minute, -1, 0);
- isExtractFromPicture(Picture, S, pmSecond, Second, -1, 0);
- if (Hour = -1) or (Minute = -1) or (Second = -1) then begin
- Result := False;
- Exit;
- end;
-
- {check for TimeOnly}
- if StrChPos(Picture, pmAmPm, I) and (w1159[0] <> #0)
- and (w2359[0] <> #0) then begin
- Tmp[0] := #0;
- J := 0;
- while Picture[I] = pmAmPm do begin
- Tmp[J] := S[I];
- Inc(J);
- Inc(I);
- end;
- Tmp[J] := #0;
- TrimTrailPrimPChar(Tmp);
-
- StrCopy(t1159, w1159);
- t1159[J] := #0;
- StrCopy(t2359, w2359);
- t2359[J] := #0;
-
- if (Tmp[0] = #0) then
- Hour := -1
- else if StrIComp(Tmp, t2359) = 0 then begin
- if (Hour < 12) then
- Inc(Hour, 12)
- else if (Hour = 0) or (Hour > 12) then
- {force BadTime}
- Hour := -1;
- end else if StrIComp(Tmp, t1159) = 0 then begin
- if Hour = 12 then
- Hour := 0
- else if (Hour = 0) or (Hour > 12) then
- {force BadTime}
- Hour := -1;
- end else
- {force BadTime}
- Hour := -1;
- end;
-
- Result := ValidTime(Hour, Minute, Second);
-end;
-
-function TOvcIntlSup.TimeToAmPmString(const Picture : string; T : TStTime; Pack : Boolean) : string;
- {-convert T to a string of the form indicated by Picture. Times are always displayed in am/pm format.}
-var
- Buf1 : array[0..255] of AnsiChar;
- Buf2 : array[0..255] of AnsiChar;
-begin
- StrPCopy(Buf1, Picture);
- Result := StrPas(TimeToAmPmPChar(Buf2, Buf1, T, Pack));
-end;
-
-function TOvcIntlSup.TimeToAmPmPChar(Dest : PAnsiChar; Picture : PAnsiChar; T : TStTime; Pack : Boolean) : PAnsiChar;
- {-convert T to a string of the form indicated by Picture. Times are always displayed in am/pm format.}
-const
- t1159 = 'AM'#0;
- t2359 = 'PM'#0;
-var
- PLen : Byte;
- Temp : Cardinal;
-begin
- Move(Picture[0], Dest[0], StrLen(Picture)+1);
- if not StrChPos(Dest, pmAmPm, Temp) then begin
- PLen := StrLen(Dest);
- Dest[PLen] := pmAmPm;
- Dest[PLen+1] := #0;
- end;
- Result := isTimeToTimeStringPrim(Dest, Dest, T, Pack, t1159, t2359);
-end;
-
-function TOvcIntlSup.TimeStringToTime(const Picture, S : string) : TStTime;
- {-convert S, a string of the form indicated by Picture, to a Time variable}
-var
- Buf1 : array[0..255] of AnsiChar;
- Buf2 : array[0..255] of AnsiChar;
-begin
- StrPCopy(Buf1, Picture);
- StrPCopy(Buf2, S);
- Result := TimePCharToTime(Buf1, Buf2);
-end;
-
-function TOvcIntlSup.TimePCharToTime(Picture, S : PAnsiChar) : TStTime;
- {-convert S, a string of the form indicated by Picture, to a Time variable}
-var
- Hours, Minutes, Seconds : Integer;
-begin
- if TimePCharToHMS(Picture, S, Hours, Minutes, Seconds) then
- Result := HMStoStTime(Hours, Minutes, Seconds)
- else
- Result := BadTime;
-end;
-
-function TOvcIntlSup.TimeToTimeString(const Picture : string; T : TStTime; Pack : Boolean) : string;
- {-convert T to a string of the form indicated by Picture}
-var
- Buf1 : array[0..255] of AnsiChar;
- Buf2 : array[0..255] of AnsiChar;
-begin
- StrPCopy(Buf1, Picture);
- Result := StrPas(TimeToTimePChar(Buf2, Buf1, T, Pack));
-end;
-
-function TOvcIntlSup.TimeToTimePChar(Dest : PAnsiChar; Picture : PAnsiChar; T : TStTime; Pack : Boolean) : PAnsiChar;
- {-convert T to a string of the form indicated by Picture}
-begin
- Result := isTimeToTimeStringPrim(Dest, Picture, T, Pack, w1159, w2359);
-end;
-
-procedure DestroyGlobalIntlSup; far;
-begin
- OvcIntlSup.Free;
-end;
-
-
-initialization
- {create instance of default user data class}
- OvcIntlSup := TOvcIntlSup.Create;
-
-finalization
- DestroyGlobalIntlSup;
-end.
diff --git a/Source/3rdParty/Orpheus/ovclabel.pas b/Source/3rdParty/Orpheus/ovclabel.pas
deleted file mode 100644
index 702fcf20..00000000
--- a/Source/3rdParty/Orpheus/ovclabel.pas
+++ /dev/null
@@ -1,839 +0,0 @@
-{*********************************************************}
-{* OVCLABEL.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 ovclabel;
- {-label component}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Classes, Controls, Graphics, StdCtrls, SysUtils,
- OvcMisc, OvcVer;
-
-type
- {preset "looks"}
- TOvcAppearance = (apNone, apCustom, apFlying, apRaised, apSunken, apShadow);
- {preset color schemes}
- TOvcColorScheme = (csCustom, csText, csWindows, csEmbossed, csGold, csSteel);
- {options for varying the shadow/highlight for the label}
- TOvcGraduateStyle = (gsNone, gsHorizontal, gsVertical);
- {directions for shading (highlights and shadows)}
- TOvcShadeDirection = (sdNone, sdUp, sdUpRight, sdRight, sdDownRight, sdDown,
- sdDownLeft, sdLeft, sdUpLeft);
- {options for varying the text of the label}
- TOvcShadeStyle = (ssPlain, ssExtrude, ssGraduated);
-
- TOvcDepth = 0..255;
-
-const
- lblDefAppearance = apRaised;
- lblDefAutoSize = False;
- lblDefColorScheme = csWindows;
-{$IFNDEF LCL}
- lblDefFontName = 'Times New Roman';
-{$ELSE}
- lblDefFontName = 'default';
-{$ENDIF}
- lblDefFontSize = 20;
- lblDefGraduateFromColor = clGray;
- lblDefGraduateStyle = gsNone;
- lblDefHighlightColor = clWhite;
- lblDefHighlightDepth = 1;
- lblDefHighlightDirection = sdUpLeft;
- lblDefHighlightStyle = ssPlain;
- lblDefShadowColor = clBlack;
- lblDefShadowDepth = 1;
- lblDefShadowDirection = sdDownRight;
- lblDefShadowStyle = ssPlain;
- lblDefTransparent = True;
- lblDefWordWrap = True;
-
-type
- TOvcCustomSettings = class(TPersistent)
- private
- {.Z+}
- {property variables}
- FGraduateFromColor : TColor;
- FGraduateStyle : TOvcGraduateStyle;
- FHighlightColor : TColor;
- FHighlightDepth : TOvcDepth;
- FHighlightDirection : TOvcShadeDirection;
- FHighlightStyle : TOvcShadeStyle;
- FShadowColor : TColor;
- FShadowDepth : TOvcDepth;
- FShadowDirection : TOvcShadeDirection;
- FShadowStyle : TOvcShadeStyle;
-
- {event variables}
- FOnColorChange : TNotifyEvent;
- FOnStyleChange : TNotifyEvent;
-
- {internal variables}
- FUpdating : Boolean;
-
- {internal methods}
- procedure DoOnColorChange;
- procedure DoOnStyleChange;
-
- {property methods}
- procedure SetGraduateFromColor(Value : TColor);
- procedure SetGraduateStyle(Value : TOvcGraduateStyle);
- procedure SetHighlightColor(Value : TColor);
- procedure SetHighlightDepth(Value : TOvcDepth);
- procedure SetHighlightDirection(Value : TOvcShadeDirection);
- procedure SetHighlightStyle(Value : TOvcShadeStyle);
- procedure SetShadowColor(Value : TColor);
- procedure SetShadowDepth(Value : TOvcDepth);
- procedure SetShadowDirection(Value : TOvcShadeDirection);
- procedure SetShadowStyle(Value : TOvcShadeStyle);
- {.Z-}
- public
- procedure Assign(Source : TPersistent);
- override;
-
- procedure BeginUpdate;
- procedure EndUpdate;
-
- {.Z+}
- property OnColorChange : TNotifyEvent
- read FOnColorChange write FOnColorChange;
- property OnStyleChange : TNotifyEvent
- read FOnStyleChange write FOnStyleChange;
- {.Z-}
-
- published
- property GraduateFromColor : TColor
- read FGraduateFromColor write SetGraduateFromColor default lblDefGraduateFromColor;
- property GraduateStyle : TOvcGraduateStyle
- read FGraduateStyle write SetGraduateStyle default lblDefGraduateStyle;
- property HighlightColor : TColor
- read FHighlightColor write SetHighlightColor default lblDefHighlightColor;
- property HighlightDepth : TOvcDepth
- read FHighlightDepth write SetHighlightDepth default lblDefHighlightDepth;
- property HighlightDirection : TOvcShadeDirection
- read FHighlightDirection write SetHighlightDirection default lblDefHighlightDirection;
- property HighlightStyle : TOvcShadeStyle
- read FHighlightStyle write SetHighlightStyle default lblDefHighlightStyle;
- property ShadowColor : TColor
- read FShadowColor write SetShadowColor default lblDefShadowColor;
- property ShadowDepth : TOvcDepth
- read FShadowDepth write SetShadowDepth default lblDefShadowDepth;
- property ShadowDirection : TOvcShadeDirection
- read FShadowDirection write SetShadowDirection default lblDefShadowDirection;
- property ShadowStyle : TOvcShadeStyle
- read FShadowStyle write SetShadowStyle default lblDefShadowStyle;
- end;
-
- TOvcCustomLabel = class(TCustomLabel)
- {.Z+}
- protected {private}
- {property variables}
- FAppearance : TOvcAppearance;
- FColorScheme : TOvcColorScheme;
- FCustomSettings : TOvcCustomSettings;
-
- {interal variables}
- eslSchemes : array [TOvcColorScheme, (cpHighlight, cpShadow, cpFace)] of TColor;
- SettingColorScheme : Boolean;
- SettingAppearance : Boolean;
-
- {property methods}
- function GetAbout : string;
- function GetWordWrap : Boolean;
- procedure SetAppearance(Value : TOvcAppearance);
- procedure SetColorScheme(Value : TOvcColorScheme);
- procedure SetWordWrap(Value : Boolean);
- procedure SetAbout(const Value : string);
-
- {internal methods}
- procedure PaintPrim(CR : TRect; Flags : Word);
- procedure ColorChanged(Sender : TObject);
- procedure StyleChanged(Sender : TObject);
-
- protected
- procedure Paint;
- override;
- {.Z-}
-
- {protected properties} {can be published by descendants}
- property About : string
- read GetAbout write SetAbout stored False;
- property Appearance : TOvcAppearance
- read FAppearance write SetAppearance default lblDefAppearance;
- property ColorScheme : TOvcColorScheme
- read FColorScheme write SetColorScheme default lblDefColorScheme;
- property CustomSettings : TOvcCustomSettings
- read FCustomSettings write FCustomSettings;
- property WordWrap : Boolean
- read GetWordWrap write SetWordWrap default lblDefWordWrap;
- public
- {.Z+}
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
-
-{ - Hdc changed to TOvcHdc for BCB Compatibility }
- procedure PaintTo(DC : TOvcHdc{Hdc}; CR : TRect; Flags : Word);
-
- property AutoSize;
- {.Z-}
- end;
-
- TOvcLabel = class(TOvcCustomLabel)
- published
- {properties}
- property About;
- property Align;
- property Alignment;
- {$IFDEF VERSION 4}
- property Anchors;
- {$ENDIF}
- property Appearance;
- property Caption;
- property Color;
- property ColorScheme;
- property Cursor;
- property CustomSettings;
- property DragCursor;
- property DragMode;
- property Enabled;
- property FocusControl;
- property Font;
- property ParentColor;
- property ParentFont default False;
- property ParentShowHint;
- property ShowAccelChar;
- property ShowHint;
- property Transparent
- default lblDefTransparent;
- property Visible;
- property WordWrap;
-
- {events}
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- end;
-
-
-implementation
-
-{*** TOvcCustomSettings ***}
-
-procedure TOvcCustomSettings.Assign(Source : TPersistent);
-var
- LS : TOvcCustomSettings absolute Source;
-begin
- if Assigned(Source) and (Source is TOvcCustomSettings) then begin
- FGraduateFromColor := LS.GraduateFromColor;
- FGraduateStyle := LS.GraduateStyle;
- FHighlightColor := LS.HighlightColor;
- FHighlightDepth := LS.HighlightDepth;
- FHighlightDirection := LS.HighlightDirection;
- FHighlightStyle := LS.HighlightStyle;
- FShadowColor := LS.ShadowColor;
- FShadowDepth := LS.ShadowDepth;
- FShadowDirection := LS.ShadowDirection;
- FShadowStyle := LS.ShadowStyle;
- end else
- inherited Assign(Source);
-end;
-
-procedure TOvcCustomSettings.BeginUpdate;
-begin
- FUpdating := True;
-end;
-
-procedure TOvcCustomSettings.EndUpdate;
-begin
- FUpdating := False;
- DoOnColorChange;
- DoOnStyleChange;
-end;
-
-procedure TOvcCustomSettings.DoOnColorChange;
-begin
- if not FUpdating and Assigned(FOnColorChange) then
- FOnColorChange(Self);
-end;
-
-procedure TOvcCustomSettings.DoOnStyleChange;
-begin
- if not FUpdating and Assigned(FOnStyleChange) then
- FOnStyleChange(Self);
-end;
-
-procedure TOvcCustomSettings.SetGraduateFromColor(Value : TColor);
-begin
- if Value <> FGraduateFromColor then begin
- FGraduateFromColor := Value;
- DoOnColorChange;
- end;
-end;
-
-procedure TOvcCustomSettings.SetGraduateStyle(Value : TOvcGraduateStyle);
-begin
- if Value <> FGraduateStyle then begin
- FGraduateStyle := Value;
- DoOnStyleChange;
- end;
-end;
-
-procedure TOvcCustomSettings.SetHighlightColor(Value : TColor);
-begin
- if Value <> FHighlightColor then begin
- FHighlightColor := Value;
- DoOnColorChange;
- end;
-end;
-
-procedure TOvcCustomSettings.SetHighlightDepth(Value : TOvcDepth);
-begin
- if Value <> FHighlightDepth then begin
- FHighlightDepth := Value;
- DoOnStyleChange;
- end;
-end;
-
-procedure TOvcCustomSettings.SetHighlightDirection(Value : TOvcShadeDirection);
-begin
- if Value <> FHighlightDirection then begin
- FHighlightDirection := Value;
- DoOnStyleChange;
- end;
-end;
-
-procedure TOvcCustomSettings.SetHighlightStyle(Value : TOvcShadeStyle);
-begin
- if Value <> FHighlightStyle then begin
- FHighlightStyle := Value;
- DoOnStyleChange;
- end;
-end;
-
-procedure TOvcCustomSettings.SetShadowColor(Value : TColor);
-begin
- if Value <> FShadowColor then begin
- FShadowColor := Value;
- DoOnColorChange;
- end;
-end;
-
-procedure TOvcCustomSettings.SetShadowDepth(Value : TOvcDepth);
-begin
- if Value <> FShadowDepth then begin
- FShadowDepth := Value;
- DoOnStyleChange;
- end;
-end;
-
-procedure TOvcCustomSettings.SetShadowDirection(Value : TOvcShadeDirection);
-begin
- if Value <> FShadowDirection then begin
- FShadowDirection := Value;
- DoOnStyleChange;
- end;
-end;
-
-procedure TOvcCustomSettings.SetShadowStyle(Value : TOvcShadeStyle);
-begin
- if Value <> FShadowStyle then begin
- FShadowStyle := Value;
- DoOnStyleChange;
- end;
-end;
-
-
-{*** TOvcCustomLabel ***}
-
-constructor TOvcCustomLabel.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- eslSchemes[csWindows, cpHighlight] := lblDefHighlightColor;
- eslSchemes[csWindows, cpFace] := clGray;
- eslSchemes[csWindows, cpShadow] := lblDefShadowColor;
-
- eslSchemes[csText, cpHighlight] := clWhite;
- eslSchemes[csText, cpFace] := clBlack;
- eslSchemes[csText, cpShadow] := clGray;
-
- eslSchemes[csEmbossed, cpHighlight] := clWhite;
- eslSchemes[csEmbossed, cpFace] := clSilver;
- eslSchemes[csEmbossed, cpShadow] := clBlack;
-
- eslSchemes[csGold, cpHighlight] := clYellow;
- eslSchemes[csGold, cpFace] := clOlive;
- eslSchemes[csGold, cpShadow] := clBlack;
-
- eslSchemes[csSteel, cpHighlight] := clAqua;
- eslSchemes[csSteel, cpFace] := clTeal;
- eslSchemes[csSteel, cpShadow] := clNavy;
-
- eslSchemes[csCustom, cpHighlight] := eslSchemes[csWindows,cpHighlight];
- eslSchemes[csCustom, cpFace] := eslSchemes[csWindows,cpFace];
- eslSchemes[csCustom, cpShadow] := eslSchemes[csWindows,cpShadow];
-
- {initialize defaults}
- FAppearance := lblDefAppearance;
- FColorScheme := lblDefColorScheme;
- FCustomSettings := TOvcCustomSettings.Create;
- FCustomSettings.FGraduateFromColor := lblDefGraduateFromColor;
- FCustomSettings.FGraduateStyle := lblDefGraduateStyle;
- FCustomSettings.FHighlightColor := eslSchemes[csWindows, cpHighlight];
- FCustomSettings.FHighlightDepth := lblDefHighlightDepth;
- FCustomSettings.FHighlightDirection := lblDefHighlightDirection;
- FCustomSettings.FHighlightStyle := lblDefHighlightStyle;
- FCustomSettings.FShadowColor := eslSchemes[csWindows, cpShadow];
- FCustomSettings.FShadowDepth := lblDefShadowDepth;
- FCustomSettings.FShadowDirection := lblDefShadowDirection;
- FCustomSettings.FShadowStyle := lblDefShadowStyle;
- FCustomSettings.OnColorChange := ColorChanged;
- FCustomSettings.OnStyleChange := StyleChanged;
-
- AutoSize := lblDefAutoSize;
- Height := 35;
- Width := 150;
- Transparent := lblDefTransparent;
- Font.Name := lblDefFontName;
- Font.Size := lblDefFontSize;
- Font.Color := eslSchemes[FColorScheme, cpFace];
- WordWrap := lblDefWordWrap;
-
- SettingColorScheme := False;
- SettingAppearance := False;
-end;
-
-destructor TOvcCustomLabel.Destroy;
-begin
- FCustomSettings.Free;
- FCustomSettings := nil;
-
- inherited Destroy;
-end;
-
-function TOvcCustomLabel.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-
-function TOvcCustomLabel.GetWordWrap : Boolean;
-begin
- Result := inherited WordWrap;
-end;
-
-procedure TOvcCustomLabel.Paint;
-const
- Alignments : array [TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
- Wrap : array[Boolean] of Word = (0, DT_WORDBREAK);
- Prefix : array[Boolean] of Word = (DT_NOPREFIX, 0);
-begin
- PaintPrim(ClientRect, Wrap[WordWrap] or DT_EXPANDTABS or
- Alignments[Alignment] or Prefix[ShowAccelChar]);
-end;
-
-procedure TOvcCustomLabel.PaintPrim(CR : TRect; Flags : Word);
-const
- DrawingOffset : array [TOvcShadeDirection, (ioX, ioY)] of -1..1 =
- ((0,0),(0,-1),(+1,-1),(+1,0),(+1,+1),(0,+1),(-1,+1),(-1,0),(-1,-1));
- BandCount = 16;
-var
- I : Integer;
- MinOffset : Integer;
- MaxOffset : Integer;
- IX, IY : Integer;
- IU, IV : Integer;
- Limit : Integer;
- Adjustment : Integer;
- AdjustR : Double;
- AdjustG : Double;
- AdjustB : Double;
- Step : Double;
- RctTemp : TRect;
- FromR : Byte;
- FromG : Byte;
- FromB : Byte;
- ToR : Byte;
- ToG : Byte;
- ToB : Byte;
- BmpTemp : TBitmap;
- BmpWork : TBitmap;
- CnvWork : TCanvas;
- Buf : PChar;
-begin
- if not Assigned(FCustomSettings) then
- Exit;
-
- {get offsets based on shadow and highlight directions and depths}
- MinOffset := MinI(MinI(MinI(MinI(DrawingOffset[FCustomSettings.HighlightDirection, ioX] * FCustomSettings.HighlightDepth,
- DrawingOffset[FCustomSettings.ShadowDirection, ioX] * FCustomSettings.ShadowDepth),
- DrawingOffset[FCustomSettings.HighlightDirection, ioY] * FCustomSettings.HighlightDepth),
- DrawingOffset[FCustomSettings.ShadowDirection, ioY] * FCustomSettings.ShadowDepth), 0);
- MaxOffset := MaxI(MaxI(MaxI(MaxI(DrawingOffset[FCustomSettings.HighlightDirection, ioX] * FCustomSettings.HighlightDepth,
- DrawingOffset[FCustomSettings.ShadowDirection, ioX] * FCustomSettings.ShadowDepth),
- DrawingOffset[FCustomSettings.HighlightDirection, ioY] * FCustomSettings.HighlightDepth),
- DrawingOffset[FCustomSettings.ShadowDirection, ioY] * FCustomSettings.ShadowDepth), 0);
-
- if Flags and DT_CENTER <> 0 then
- Adjustment := (MaxOffset - MinOffset) div 2
- else if Flags and DT_RIGHT <> 0 then
- Adjustment := MaxOffset - MinOffset
- else
- Adjustment := 0;
-
- {create temporary drawing surfaces}
- BmpTemp := TBitmap.Create;
- BmpWork := TBitmap.Create;
- try
- BmpTemp.Height := CR.Bottom-CR.Top;
- BmpTemp.Width := CR.Right-CR.Left;
- BmpTemp.Canvas.Font := Self.Font;
-
- BmpWork.Height := CR.Bottom-CR.Top;
- BmpWork.Width := CR.Right-CR.Left;
- BmpWork.Canvas.Font := Self.Font;
-
- {get copy of our canvas}
- BmpWork.Canvas.CopyRect(CR, Self.Canvas, CR);
-
- {set starting point for text - IX, IY}
- IX := 0; IY := 0;
- if not Transparent then begin
- BmpWork.Canvas.Brush.Color := Self.Color;
- BmpWork.Canvas.Brush.Style := bsSolid;
- BmpWork.Canvas.FillRect(CR);
- end;
- BmpWork.Canvas.Brush.Style := bsClear;
-
- Buf := StrAlloc(GetTextLen+1);
- try
- {get label's caption}
- GetTextBuf(Buf, GetTextLen+1);
-
- {prepare for extruding shadow, if requested}
- GetRGB(FCustomSettings.ShadowColor, FromR, FromG, FromB);
- AdjustR := 0;
- AdjustG := 0;
- AdjustB := 0;
- Limit := FCustomSettings.ShadowDepth;
- if (FCustomSettings.ShadowStyle <> ssPlain) and (FCustomSettings.ShadowDepth > 1) then begin
- Limit := 1;
- {find changes in RGB colors}
- if FCustomSettings.ShadowStyle = ssGraduated then begin
- GetRGB(Font.Color, ToR, ToG, ToB);
- AdjustR := (ToR - FromR) / (FCustomSettings.ShadowDepth - 1);
- AdjustG := (ToG - FromG) / (FCustomSettings.ShadowDepth - 1);
- AdjustB := (ToB - FromB) / (FCustomSettings.ShadowDepth - 1);
- end;
- end;
- CnvWork := BmpWork.Canvas;
-
- {process for each copy of the shadow}
- for I := FCustomSettings.ShadowDepth downto Limit do begin
- CnvWork.Font.Color :=
- RGB(FromR + Round(AdjustR * (FCustomSettings.ShadowDepth - I)),
- FromG + Round(AdjustG * (FCustomSettings.ShadowDepth - I)),
- FromB + Round(AdjustB * (FCustomSettings.ShadowDepth - I)));
- {create a rect that is offset for the shadow}
- RctTemp:= Rect(
- CR.Left - MinOffset -Adjustment + DrawingOffset[FCustomSettings.ShadowDirection, ioX] * I,
- CR.Top - MinOffset + DrawingOffset[FCustomSettings.ShadowDirection, ioY] * I,
- CR.Right - MinOffset - Adjustment + DrawingOffset[FCustomSettings.ShadowDirection, ioX] * I,
- CR.Bottom - MinOffset + DrawingOffset[FCustomSettings.ShadowDirection, ioY] * I);
- {draw shadow text with alignment}
- DrawText(CnvWork.Handle, Buf, StrLen(Buf), RctTemp, Flags);
- end;
-
- {prepare for extruding highlight, if requested}
- GetRGB(FCustomSettings.HighlightColor, FromR, FromG, FromB);
- AdjustR := 0;
- AdjustG := 0;
- AdjustB := 0;
- Limit := FCustomSettings.HighlightDepth;
- if (FCustomSettings.HighlightStyle <> ssPlain) and (FCustomSettings.HighlightDepth > 1) then begin
- Limit := 1;
- if FCustomSettings.HighlightStyle = ssGraduated then begin {find changes in RGB Colors}
- GetRGB(Font.Color, ToR, ToG, ToB);
- AdjustR := (ToR - FromR) / (FCustomSettings.HighlightDepth - 1);
- AdjustG := (ToG - FromG) / (FCustomSettings.HighlightDepth - 1);
- AdjustB := (ToB - FromB) / (FCustomSettings.HighlightDepth - 1);
- end;
- end;
-
- CnvWork := BmpWork.Canvas;
-
- {process for each copy of the highlight}
- for I := FCustomSettings.HighlightDepth downto Limit do begin
- CnvWork.Font.Color :=
- RGB(FromR + Round(AdjustR * (FCustomSettings.HighlightDepth - I)),
- FromG + Round(AdjustG * (FCustomSettings.HighlightDepth - I)),
- FromB + Round(AdjustB * (FCustomSettings.HighlightDepth - I)));
- {create a rect that is offset for the highlight}
- RctTemp:= Rect(
- CR.Left - MinOffset - Adjustment + DrawingOffset[FCustomSettings.HighlightDirection, ioX] * I,
- CR.Top - MinOffset + DrawingOffset[FCustomSettings.HighlightDirection, ioY] * I,
- CR.Right - MinOffset - Adjustment + DrawingOffset[FCustomSettings.HighlightDirection, ioX] * I,
- CR.Bottom - MinOffset + DrawingOffset[FCustomSettings.HighlightDirection, ioY] * I);
- {draw highlight text with alignment}
- DrawText(CnvWork.Handle, Buf, StrLen(Buf), RctTemp, Flags);
- end;
-
- if FCustomSettings.GraduateStyle <> gsNone then begin
- {copy original canvas to work area}
- BmpTemp.Canvas.CopyRect(CR, BmpWork.Canvas, CR);
- {choose an unusual color}
- BmpTemp.Canvas.Font.Color := $00FE09F1;
- BmpTemp.Canvas.Brush.Style := bsClear;
- CnvWork := BmpTemp.Canvas;
- end else begin
- BmpWork.Canvas.Font.Color := Font.Color; {restore original font Color}
- CnvWork := BmpWork.Canvas;
- end;
-
- {create a rect that is offset for the original text}
- RctTemp:= Rect(CR.Left - MinOffset - Adjustment,
- CR.Top - MinOffset,
- CR.Right - MinOffset - Adjustment,
- CR.Bottom - MinOffset);
-
- {draw original text with alignment}
- DrawText(CnvWork.Handle, Buf, StrLen(Buf), RctTemp, Flags);
- finally
- StrDispose(Buf);
- end;
-
- if FCustomSettings.GraduateStyle <> gsNone then begin
- {transfer graduations from temporary canvas}
- {calculate start point and extent}
- Limit := BmpWork.Canvas.TextWidth(Caption);
- IV := IY - MinOffset;
-
- if Flags and DT_CENTER <> 0 then
- IU := (CR.Right-CR.Left - Limit) div 2 - MinOffset - Adjustment
- else if Flags and DT_RIGHT <> 0 then
- IU := CR.Bottom-CR.Top - MaxOffset - Limit
- else
- IU := IX - MinOffset;
-
- if FCustomSettings.GraduateStyle = gsVertical then
- Limit := CR.Bottom-CR.Top-1
- else
- Dec(Limit);
-
- {calculate change in color at each step}
- GetRGB(FCustomSettings.GraduateFromColor, FromR, FromG, FromB);
- GetRGB(Font.Color, ToR, ToG, ToB);
- AdjustR := (ToR - FromR) / Pred(BandCount);
- AdjustG := (ToG - FromG) / Pred(BandCount);
- AdjustB := (ToB - FromB) / Pred(BandCount);
-
- Step := Limit / Pred(BandCount);
-
- {and draw it onto the canvas}
- BmpWork.Canvas.Brush.Style := bsSolid;
- for I := 0 to Pred(BandCount) do begin
- BmpWork.Canvas.Brush.Color := RGB(FromR + Round(AdjustR * I),
- FromG + Round(AdjustG * I),
- FromB + Round(AdjustB * I));
- if FCustomSettings.GraduateStyle = gsVertical then
- RctTemp := Rect(0, IV + Round(I*Step), CR.Right-CR.Left, IV + Round((I+1)*Step))
- else
- RctTemp := Rect(IU + Round(I*Step), 0, IU + Round((I+1)*Step), CR.Bottom-CR.Top);
-//{$IFNDEF LCL}
- BmpWork.Canvas.BrushCopy(RctTemp, BmpTemp, RctTemp, BmpTemp.Canvas.Font.Color);
-//{$ELSE}
-// BrushCopy(BmpWork.Canvas, RctTemp, BmpTemp, RctTemp, BmpTemp.Canvas.Font.Color);
-//{$ENDIF}
- end;
- end;
-
- Canvas.CopyRect(CR, BmpWork.Canvas, CR);
- finally
- BmpTemp.Free;
- BmpWork.Free;
- end;
-end;
-
-{ - Hdc changed to TOvcHdc for BCB compatibility}
-procedure TOvcCustomLabel.PaintTo(DC : TOvcHdc {Hdc}; CR : TRect; Flags : Word);
-begin
- Canvas.Handle := DC;
- try
- if not Transparent then begin
- Canvas.Brush.Color := Self.Color;
- Canvas.Brush.Style := bsSolid;
- {clear complete client area}
- Canvas.FillRect(Rect(0, 0, CR.Right, CR.Bottom));
- end;
- Canvas.Brush.Style := bsClear;
- PaintPrim(CR, Flags)
- finally
- Canvas.Handle := 0;
- end;
-end;
-
-procedure TOvcCustomLabel.SetAppearance(Value : TOvcAppearance);
-begin
- if FAppearance <> Value then begin
- SettingAppearance := True;
- try
- FAppearance := Value;
- FCustomSettings.BeginUpdate;
- try
- FCustomSettings.HighlightColor := eslSchemes[ColorScheme,cpHighlight];
- case FAppearance of
- apRaised:
- begin
- FCustomSettings.HighlightDirection := sdUpLeft;
- FCustomSettings.ShadowDirection := sdDownRight;
- FCustomSettings.HighlightDepth := 1;
- FCustomSettings.ShadowDepth := 1;
- end;
- apSunken:
- begin
- FCustomSettings.HighlightDirection := sdDownRight;
- FCustomSettings.ShadowDirection := sdUpLeft;
- FCustomSettings.HighlightDepth := 1;
- FCustomSettings.ShadowDepth := 1;
- end;
- apShadow:
- begin
- FCustomSettings.HighlightDirection := sdNone;
- FCustomSettings.ShadowDirection := sdDownRight;
- FCustomSettings.HighlightDepth := 0;
- FCustomSettings.ShadowDepth := 2;
- end;
- apFlying:
- begin
- FCustomSettings.HighlightDirection := sdDownRight;
- FCustomSettings.ShadowDirection := sdDownRight;
- FCustomSettings.HighlightDepth :=1;
- FCustomSettings.ShadowDepth :=5;
- {flying has two shadows}
- FCustomSettings.HighlightColor := eslSchemes[ColorScheme, cpShadow];
- end;
- apNone:
- begin
- FCustomSettings.HighlightDirection := sdNone;
- FCustomSettings.ShadowDirection := sdNone;
- FCustomSettings.HighlightDepth :=0;
- FCustomSettings.ShadowDepth :=0;
- end;
- end;
- finally
- FCustomSettings.EndUpdate;
- end;
- finally
- SettingAppearance := False;
- Perform(CM_TEXTCHANGED, 0, 0);
- end;
- end;
-end;
-
-procedure TOvcCustomLabel.SetColorScheme(Value : TOvcColorScheme);
-begin
- if FColorScheme <> Value then begin
- SettingColorScheme := True;
- try
- FColorScheme := Value;
- FCustomSettings.BeginUpdate;
- try
- FCustomSettings.HighlightColor := eslSchemes[FColorScheme, cpHighlight];
- Font.Color := eslSchemes[FColorScheme, cpFace];
- FCustomSettings.ShadowColor := eslSchemes[FColorScheme, cpShadow];
- if FColorScheme <> csCustom then begin
- eslSchemes[csCustom, cpHighlight] := eslSchemes[FColorScheme, cpHighlight];
- eslSchemes[csCustom, cpFace] := eslSchemes[FColorScheme, cpFace];
- eslSchemes[csCustom, cpShadow] := eslSchemes[FColorScheme, cpShadow];
- end;
- finally
- FCustomSettings.EndUpdate;
- end;
- finally
- SettingColorScheme := False;
- Perform(CM_TEXTCHANGED, 0, 0);
- end;
- end;
-end;
-
-procedure TOvcCustomLabel.ColorChanged(Sender : TObject);
-begin
- if csLoading in ComponentState then
- Exit;
-
- Invalidate;
-
- if not SettingColorScheme then
- FColorScheme := csCustom;
-
- if not SettingColorScheme then
- Perform(CM_COLORCHANGED, 0, 0);
-end;
-
-procedure TOvcCustomLabel.StyleChanged(Sender : TObject);
-begin
- if csLoading in ComponentState then
- Exit;
-
- Invalidate;
-
- if not SettingAppearance then begin
- FAppearance := apCustom;
- Perform(CM_TEXTCHANGED, 0, 0);
- end;
-end;
-
-procedure TOvcCustomLabel.SetAbout(const Value : string);
-begin
-end;
-
-procedure TOvcCustomLabel.SetWordWrap(Value : Boolean);
-begin
- if Value <> WordWrap then begin
- inherited WordWrap := Value;
- Invalidate;
- end;
-end;
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovclbl0.lfm b/Source/3rdParty/Orpheus/ovclbl0.lfm
deleted file mode 100644
index 29fb54b2..00000000
--- a/Source/3rdParty/Orpheus/ovclbl0.lfm
+++ /dev/null
@@ -1,381 +0,0 @@
-object frmOvcLabel: TfrmOvcLabel
- Left = 328
- Top = 198
- BorderStyle = bsDialog
- Caption = 'Style Manager'
- ClientHeight = 456
- Height = 456
- ClientWidth = 577
- Width = 577
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- OnCreate = FormCreate
- PixelsPerInch = 96
- object Panel1: TPanel
- Left = 0
- Top = 0
- Width = 577
- Height = 97
- Align = alTop
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- ParentFont = False
- TabOrder = 0
- object OvcLabel: TOvcLabel
- Left = 1
- Top = 1
- Width = 575
- Height = 95
- Align = alClient
- Alignment = taCenter
- Appearance = apCustom
- Caption = 'Orpheus Labels'
- ColorScheme = csCustom
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clGray
- Font.Height = -27
- Font.Style = []
- ParentFont = False
- end
- end
- object Button1: TButton
- Left = 418
- Top = 427
- Width = 75
- Height = 25
- Caption = 'OK'
- Default = True
- ModalResult = 1
- TabOrder = 4
- end
- object Button2: TButton
- Left = 500
- Top = 427
- Width = 75
- Height = 25
- Cancel = True
- Caption = 'Cancel'
- ModalResult = 2
- TabOrder = 5
- end
- object Panel2: TPanel
- Left = 0
- Top = 364
- Width = 393
- Height = 91
- TabOrder = 3
- object Label1: TLabel
- Left = 4
- Top = 4
- Width = 57
- Height = 13
- Caption = 'Style Name:'
- end
- object Label2: TLabel
- Left = 256
- Top = 5
- Width = 61
- Height = 13
- Caption = 'Appearance:'
- end
- object Label3: TLabel
- Left = 256
- Top = 48
- Width = 69
- Height = 13
- Caption = 'Color Scheme:'
- end
- object SchemeCb: TComboBox
- Left = 4
- Top = 20
- Width = 233
- Height = 21
- Style = csDropDownList
- ItemHeight = 13
- Items.Strings = (
- 'one'
- 'two')
- MaxLength = 255
- Sorted = True
- TabOrder = 0
- OnChange = SchemeCbChange
- end
- object SaveAsBtn: TButton
- Left = 4
- Top = 55
- Width = 75
- Height = 25
- Caption = 'Save &As...'
- TabOrder = 1
- OnClick = SaveAsBtnClick
- end
- object DeleteBtn: TButton
- Left = 161
- Top = 55
- Width = 75
- Height = 25
- Caption = '&Delete'
- TabOrder = 2
- OnClick = DeleteBtnClick
- end
- object AppearanceCb: TComboBox
- Left = 256
- Top = 20
- Width = 126
- Height = 21
- ItemHeight = 13
- TabOrder = 3
- OnChange = AppearanceCbChange
- end
- object ColorSchemeCb: TComboBox
- Left = 256
- Top = 62
- Width = 126
- Height = 21
- ItemHeight = 13
- TabOrder = 4
- OnChange = ColorSchemeCbChange
- end
- end
- object Panel3: TPanel
- Left = 0
- Top = 97
- Width = 577
- Height = 189
- TabOrder = 1
- object Label4: TLabel
- Left = 152
- Top = 83
- Width = 70
- Height = 13
- Caption = 'Gradient Color:'
- end
- object Label5: TLabel
- Left = 294
- Top = 83
- Width = 71
- Height = 13
- Caption = 'Highlight Color:'
- end
- object Label6: TLabel
- Left = 437
- Top = 83
- Width = 69
- Height = 13
- Caption = 'Shadow Color:'
- end
- object HighlightDirectionLbl: TLabel
- Left = 304
- Top = 128
- Width = 50
- Height = 32
- AutoSize = False
- Caption = 'Highlight Direction:'
- WordWrap = True
- end
- object ShadowDirectionLbl: TLabel
- Left = 447
- Top = 128
- Width = 50
- Height = 32
- AutoSize = False
- Caption = 'Shadow Direction:'
- WordWrap = True
- end
- object Label7: TLabel
- Left = 8
- Top = 65
- Width = 53
- Height = 13
- Caption = 'Text Color/'
- end
- object Label8: TLabel
- Left = 8
- Top = 78
- Width = 86
- Height = 13
- Caption = 'Gradient To Color:'
- end
- object GraduateRg: TRadioGroup
- Left = 150
- Top = 3
- Width = 137
- Height = 73
- Caption = 'Text &Gradient Style'
- ItemIndex = 0
- Items.Strings = (
- 'None'
- 'Horizontal'
- 'Vertical')
- OnClick = GraduateRgClick
- end
- object ShadowRg: TRadioGroup
- Left = 436
- Top = 3
- Width = 137
- Height = 73
- Caption = '&Shadow Style'
- ItemIndex = 0
- Items.Strings = (
- 'Plain'
- 'Extrude'
- 'Graduate')
- OnClick = ShadowRgClick
- end
- object HighlightRg: TRadioGroup
- Left = 293
- Top = 3
- Width = 137
- Height = 73
- Caption = '&Highlight Style'
- ItemIndex = 0
- Items.Strings = (
- 'Plain'
- 'Extrude'
- 'Graduate')
- OnClick = HighlightRgClick
- end
- object FromColorCcb: TOvcColorComboBox
- Left = 151
- Top = 99
- Width = 137
- Height = 22
- ItemHeight = 12
- SelectedColor = clBlack
- TabOrder = 4
- Text = 'Black'
- OnChange = FromColorCcbChange
- end
- object HighlightColorCcb: TOvcColorComboBox
- Left = 293
- Top = 99
- Width = 137
- Height = 22
- ItemHeight = 12
- SelectedColor = clBlack
- TabOrder = 5
- Text = 'Black'
- OnChange = HighlightColorCcbChange
- end
- object ShadowColorCcb: TOvcColorComboBox
- Left = 436
- Top = 99
- Width = 137
- Height = 22
- ItemHeight = 12
- SelectedColor = clBlack
- TabOrder = 6
- Text = 'Black'
- OnChange = ShadowColorCcbChange
- end
- object FontColorCcb: TOvcColorComboBox
- Left = 7
- Top = 99
- Width = 137
- Height = 22
- ItemHeight = 12
- SelectedColor = clBlack
- TabOrder = 0
- Text = 'Black'
- OnChange = FontColorCcbChange
- end
- end
- object Panel4: TPanel
- Left = 0
- Top = 286
- Width = 577
- Height = 78
- TabOrder = 2
- object Label9: TLabel
- Left = 20
- Top = 8
- Width = 105
- Height = 13
- Alignment = taRightJustify
- AutoSize = False
- Caption = 'Font Size: '
- end
- object FontSizeLbl: TLabel
- Left = 500
- Top = 8
- Width = 6
- Height = 13
- Caption = '0'
- end
- object HighlightDepthLbl: TLabel
- Left = 500
- Top = 32
- Width = 6
- Height = 13
- Caption = '0'
- end
- object ShadowDepthLbl: TLabel
- Left = 500
- Top = 56
- Width = 6
- Height = 13
- Caption = '0'
- end
- object Label10: TLabel
- Left = 20
- Top = 32
- Width = 105
- Height = 13
- Alignment = taRightJustify
- AutoSize = False
- Caption = 'Highlight Depth: '
- end
- object Label11: TLabel
- Left = 20
- Top = 56
- Width = 105
- Height = 13
- Alignment = taRightJustify
- AutoSize = False
- Caption = 'Shadow Depth: '
- end
- object FontSizeSb: TScrollBar
- Left = 132
- Top = 8
- Width = 357
- Height = 14
- TabOrder = 0
- OnChange = FontSizeSbChange
- end
- object ShadowDepthSb: TScrollBar
- Left = 132
- Top = 56
- Width = 357
- Height = 14
- Max = 50
- TabOrder = 2
- OnChange = ShadowDepthSbChange
- end
- object HighlightDepthSb: TScrollBar
- Left = 132
- Top = 32
- Width = 357
- Height = 14
- Max = 50
- TabOrder = 1
- OnChange = HighlightDepthSbChange
- end
- end
- object OvcController1: TOvcController
- EntryCommands.TableList = (
- 'Default'
- True
- ()
- 'WordStar'
- False
- ()
- 'Grid'
- False
- ())
- Epoch = 1900
- end
-end
diff --git a/Source/3rdParty/Orpheus/ovclbl0.lrs b/Source/3rdParty/Orpheus/ovclbl0.lrs
deleted file mode 100644
index 7b5eb1e0..00000000
--- a/Source/3rdParty/Orpheus/ovclbl0.lrs
+++ /dev/null
@@ -1,91 +0,0 @@
-LazarusResources.Add('TfrmOvcLabel','FORMDATA',[
- 'TPF0'#12'TfrmOvcLabel'#11'frmOvcLabel'#4'Left'#3'H'#1#3'Top'#3#198#0#11'Bord'
- +'erStyle'#7#8'bsDialog'#7'Caption'#6#13'Style Manager'#12'ClientHeight'#3#200
- +#1#6'Height'#3#200#1#11'ClientWidth'#3'A'#2#5'Width'#3'A'#2#12'Font.Charset'
- +#7#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2
- +#245#10'Font.Style'#11#0#8'OnCreate'#7#10'FormCreate'#13'PixelsPerInch'#2'`'
- +#0#6'TPanel'#6'Panel1'#4'Left'#2#0#3'Top'#2#0#5'Width'#3'A'#2#6'Height'#2'a'
- +#5'Align'#7#5'alTop'#12'Font.Charset'#7#15'DEFAULT_CHARSET'#10'Font.Color'#7
- +#12'clWindowText'#11'Font.Height'#2#245#10'Font.Style'#11#0#10'ParentFont'#8
- +#8'TabOrder'#2#0#0#9'TOvcLabel'#8'OvcLabel'#4'Left'#2#1#3'Top'#2#1#5'Width'#3
- +'?'#2#6'Height'#2'_'#5'Align'#7#8'alClient'#9'Alignment'#7#8'taCenter'#10'Ap'
- +'pearance'#7#8'apCustom'#7'Caption'#6#14'Orpheus Labels'#11'ColorScheme'#7#8
- +'csCustom'#12'Font.Charset'#7#15'DEFAULT_CHARSET'#10'Font.Color'#7#6'clGray'
- +#11'Font.Height'#2#229#10'Font.Style'#11#0#10'ParentFont'#8#0#0#0#7'TButton'
- +#7'Button1'#4'Left'#3#162#1#3'Top'#3#171#1#5'Width'#2'K'#6'Height'#2#25#7'Ca'
- +'ption'#6#2'OK'#7'Default'#9#11'ModalResult'#2#1#8'TabOrder'#2#4#0#0#7'TButt'
- +'on'#7'Button2'#4'Left'#3#244#1#3'Top'#3#171#1#5'Width'#2'K'#6'Height'#2#25#6
- +'Cancel'#9#7'Caption'#6#6'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2#5#0#0#6
- +'TPanel'#6'Panel2'#4'Left'#2#0#3'Top'#3'l'#1#5'Width'#3#137#1#6'Height'#2'['
- +#8'TabOrder'#2#3#0#6'TLabel'#6'Label1'#4'Left'#2#4#3'Top'#2#4#5'Width'#2'9'#6
- +'Height'#2#13#7'Caption'#6#11'Style Name:'#0#0#6'TLabel'#6'Label2'#4'Left'#3
- +#0#1#3'Top'#2#5#5'Width'#2'='#6'Height'#2#13#7'Caption'#6#11'Appearance:'#0#0
- +#6'TLabel'#6'Label3'#4'Left'#3#0#1#3'Top'#2'0'#5'Width'#2'E'#6'Height'#2#13#7
- +'Caption'#6#13'Color Scheme:'#0#0#9'TComboBox'#8'SchemeCb'#4'Left'#2#4#3'Top'
- +#2#20#5'Width'#3#233#0#6'Height'#2#21#5'Style'#7#14'csDropDownList'#10'ItemH'
- +'eight'#2#13#13'Items.Strings'#1#6#3'one'#6#3'two'#0#9'MaxLength'#3#255#0#6
- +'Sorted'#9#8'TabOrder'#2#0#8'OnChange'#7#14'SchemeCbChange'#0#0#7'TButton'#9
- +'SaveAsBtn'#4'Left'#2#4#3'Top'#2'7'#5'Width'#2'K'#6'Height'#2#25#7'Caption'#6
- +#11'Save &As...'#8'TabOrder'#2#1#7'OnClick'#7#14'SaveAsBtnClick'#0#0#7'TButt'
- +'on'#9'DeleteBtn'#4'Left'#3#161#0#3'Top'#2'7'#5'Width'#2'K'#6'Height'#2#25#7
- +'Caption'#6#7'&Delete'#8'TabOrder'#2#2#7'OnClick'#7#14'DeleteBtnClick'#0#0#9
- +'TComboBox'#12'AppearanceCb'#4'Left'#3#0#1#3'Top'#2#20#5'Width'#2'~'#6'Heigh'
- +'t'#2#21#10'ItemHeight'#2#13#8'TabOrder'#2#3#8'OnChange'#7#18'AppearanceCbCh'
- +'ange'#0#0#9'TComboBox'#13'ColorSchemeCb'#4'Left'#3#0#1#3'Top'#2'>'#5'Width'
- +#2'~'#6'Height'#2#21#10'ItemHeight'#2#13#8'TabOrder'#2#4#8'OnChange'#7#19'Co'
- +'lorSchemeCbChange'#0#0#0#6'TPanel'#6'Panel3'#4'Left'#2#0#3'Top'#2'a'#5'Widt'
- +'h'#3'A'#2#6'Height'#3#189#0#8'TabOrder'#2#1#0#6'TLabel'#6'Label4'#4'Left'#3
- +#152#0#3'Top'#2'S'#5'Width'#2'F'#6'Height'#2#13#7'Caption'#6#15'Gradient Col'
- +'or:'#0#0#6'TLabel'#6'Label5'#4'Left'#3'&'#1#3'Top'#2'S'#5'Width'#2'G'#6'Hei'
- +'ght'#2#13#7'Caption'#6#16'Highlight Color:'#0#0#6'TLabel'#6'Label6'#4'Left'
- +#3#181#1#3'Top'#2'S'#5'Width'#2'E'#6'Height'#2#13#7'Caption'#6#13'Shadow Col'
- +'or:'#0#0#6'TLabel'#21'HighlightDirectionLbl'#4'Left'#3'0'#1#3'Top'#3#128#0#5
- +'Width'#2'2'#6'Height'#2' '#8'AutoSize'#8#7'Caption'#6#20'Highlight Directio'
- +'n:'#8'WordWrap'#9#0#0#6'TLabel'#18'ShadowDirectionLbl'#4'Left'#3#191#1#3'To'
- +'p'#3#128#0#5'Width'#2'2'#6'Height'#2' '#8'AutoSize'#8#7'Caption'#6#17'Shado'
- +'w Direction:'#8'WordWrap'#9#0#0#6'TLabel'#6'Label7'#4'Left'#2#8#3'Top'#2'A'
- +#5'Width'#2'5'#6'Height'#2#13#7'Caption'#6#11'Text Color/'#0#0#6'TLabel'#6'L'
- +'abel8'#4'Left'#2#8#3'Top'#2'N'#5'Width'#2'V'#6'Height'#2#13#7'Caption'#6#18
- +'Gradient To Color:'#0#0#11'TRadioGroup'#10'GraduateRg'#4'Left'#3#150#0#3'To'
- +'p'#2#3#5'Width'#3#137#0#6'Height'#2'I'#7'Caption'#6#20'Text &Gradient Style'
- +#9'ItemIndex'#2#0#13'Items.Strings'#1#6#4'None'#6#10'Horizontal'#6#8'Vertica'
- +'l'#0#7'OnClick'#7#15'GraduateRgClick'#0#0#11'TRadioGroup'#8'ShadowRg'#4'Lef'
- +'t'#3#180#1#3'Top'#2#3#5'Width'#3#137#0#6'Height'#2'I'#7'Caption'#6#13'&Shad'
- +'ow Style'#9'ItemIndex'#2#0#13'Items.Strings'#1#6#5'Plain'#6#7'Extrude'#6#8
- +'Graduate'#0#7'OnClick'#7#13'ShadowRgClick'#0#0#11'TRadioGroup'#11'Highlight'
- +'Rg'#4'Left'#3'%'#1#3'Top'#2#3#5'Width'#3#137#0#6'Height'#2'I'#7'Caption'#6
- +#16'&Highlight Style'#9'ItemIndex'#2#0#13'Items.Strings'#1#6#5'Plain'#6#7'Ex'
- +'trude'#6#8'Graduate'#0#7'OnClick'#7#16'HighlightRgClick'#0#0#17'TOvcColorCo'
- +'mboBox'#12'FromColorCcb'#4'Left'#3#151#0#3'Top'#2'c'#5'Width'#3#137#0#6'Hei'
- +'ght'#2#22#10'ItemHeight'#2#12#13'SelectedColor'#7#7'clBlack'#8'TabOrder'#2#4
- +#4'Text'#6#5'Black'#8'OnChange'#7#18'FromColorCcbChange'#0#0#17'TOvcColorCom'
- +'boBox'#17'HighlightColorCcb'#4'Left'#3'%'#1#3'Top'#2'c'#5'Width'#3#137#0#6
- +'Height'#2#22#10'ItemHeight'#2#12#13'SelectedColor'#7#7'clBlack'#8'TabOrder'
- +#2#5#4'Text'#6#5'Black'#8'OnChange'#7#23'HighlightColorCcbChange'#0#0#17'TOv'
- +'cColorComboBox'#14'ShadowColorCcb'#4'Left'#3#180#1#3'Top'#2'c'#5'Width'#3
- ,#137#0#6'Height'#2#22#10'ItemHeight'#2#12#13'SelectedColor'#7#7'clBlack'#8'T'
- +'abOrder'#2#6#4'Text'#6#5'Black'#8'OnChange'#7#20'ShadowColorCcbChange'#0#0
- +#17'TOvcColorComboBox'#12'FontColorCcb'#4'Left'#2#7#3'Top'#2'c'#5'Width'#3
- +#137#0#6'Height'#2#22#10'ItemHeight'#2#12#13'SelectedColor'#7#7'clBlack'#8'T'
- +'abOrder'#2#0#4'Text'#6#5'Black'#8'OnChange'#7#18'FontColorCcbChange'#0#0#0#6
- +'TPanel'#6'Panel4'#4'Left'#2#0#3'Top'#3#30#1#5'Width'#3'A'#2#6'Height'#2'N'#8
- +'TabOrder'#2#2#0#6'TLabel'#6'Label9'#4'Left'#2#20#3'Top'#2#8#5'Width'#2'i'#6
- +'Height'#2#13#9'Alignment'#7#14'taRightJustify'#8'AutoSize'#8#7'Caption'#6#11
- +'Font Size: '#0#0#6'TLabel'#11'FontSizeLbl'#4'Left'#3#244#1#3'Top'#2#8#5'Wid'
- +'th'#2#6#6'Height'#2#13#7'Caption'#6#1'0'#0#0#6'TLabel'#17'HighlightDepthLbl'
- +#4'Left'#3#244#1#3'Top'#2' '#5'Width'#2#6#6'Height'#2#13#7'Caption'#6#1'0'#0
- +#0#6'TLabel'#14'ShadowDepthLbl'#4'Left'#3#244#1#3'Top'#2'8'#5'Width'#2#6#6'H'
- +'eight'#2#13#7'Caption'#6#1'0'#0#0#6'TLabel'#7'Label10'#4'Left'#2#20#3'Top'#2
- +' '#5'Width'#2'i'#6'Height'#2#13#9'Alignment'#7#14'taRightJustify'#8'AutoSiz'
- +'e'#8#7'Caption'#6#17'Highlight Depth: '#0#0#6'TLabel'#7'Label11'#4'Left'#2
- +#20#3'Top'#2'8'#5'Width'#2'i'#6'Height'#2#13#9'Alignment'#7#14'taRightJustif'
- +'y'#8'AutoSize'#8#7'Caption'#6#14'Shadow Depth: '#0#0#10'TScrollBar'#10'Font'
- +'SizeSb'#4'Left'#3#132#0#3'Top'#2#8#5'Width'#3'e'#1#6'Height'#2#14#8'TabOrde'
- +'r'#2#0#8'OnChange'#7#16'FontSizeSbChange'#0#0#10'TScrollBar'#13'ShadowDepth'
- +'Sb'#4'Left'#3#132#0#3'Top'#2'8'#5'Width'#3'e'#1#6'Height'#2#14#3'Max'#2'2'#8
- +'TabOrder'#2#2#8'OnChange'#7#19'ShadowDepthSbChange'#0#0#10'TScrollBar'#16'H'
- +'ighlightDepthSb'#4'Left'#3#132#0#3'Top'#2' '#5'Width'#3'e'#1#6'Height'#2#14
- +#3'Max'#2'2'#8'TabOrder'#2#1#8'OnChange'#7#22'HighlightDepthSbChange'#0#0#0
- +#14'TOvcController'#14'OvcController1'#23'EntryCommands.TableList'#1#6#7'Def'
- +'ault'#9#1#0#6#8'WordStar'#8#1#0#6#4'Grid'#8#1#0#0#5'Epoch'#3'l'#7#0#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/ovclbl0.pas b/Source/3rdParty/Orpheus/ovclbl0.pas
deleted file mode 100644
index c4acc7e1..00000000
--- a/Source/3rdParty/Orpheus/ovclbl0.pas
+++ /dev/null
@@ -1,610 +0,0 @@
-{*********************************************************}
-{* OVCLBL0.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 ovclbl0;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, Buttons, {$ENDIF}
- SysUtils, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls, ExtCtrls,
- {$IFNDEF LCL} {$IFDEF VERSION6} DesignIntf, DesignEditors, {$ELSE} DsgnIntf, {$ENDIF} {$ELSE} PropEdits, ComponentEditors, {$ENDIF}
- Menus, IniFiles, OvcLbl2, TypInfo, OvcCmbx, OvcClrCb, OvcLabel, OvcBase,
- OvcData;
-
-type
- TfrmOvcLabel = class(TForm)
- Panel1: TPanel;
- OvcLabel: TOvcLabel;
- Button1: TButton;
- Button2: TButton;
- Panel2: TPanel;
- Label1: TLabel;
- Label2: TLabel;
- Label3: TLabel;
- SchemeCb: TComboBox;
- SaveAsBtn: TButton;
- DeleteBtn: TButton;
- Panel3: TPanel;
- Label4: TLabel;
- Label5: TLabel;
- Label6: TLabel;
- Label7: TLabel;
- Label8: TLabel;
- GraduateRg: TRadioGroup;
- ShadowRg: TRadioGroup;
- HighlightRg: TRadioGroup;
- FromColorCcb: TOvcColorComboBox;
- HighlightColorCcb: TOvcColorComboBox;
- ShadowColorCcb: TOvcColorComboBox;
- HighlightDirectionLbl: TLabel;
- ShadowDirectionLbl: TLabel;
- FontColorCcb: TOvcColorComboBox;
- Panel4: TPanel;
- Label9: TLabel;
- Label10: TLabel;
- Label11: TLabel;
- FontSizeSb: TScrollBar;
- FontSizeLbl: TLabel;
- HighlightDepthLbl: TLabel;
- ShadowDepthLbl: TLabel;
- ShadowDepthSb: TScrollBar;
- HighlightDepthSb: TScrollBar;
- AppearanceCb: TComboBox;
- ColorSchemeCb: TComboBox;
- OvcController1: TOvcController;
- procedure FontSizeSbChange(Sender: TObject);
- procedure HighlightDepthSbChange(Sender: TObject);
- procedure ShadowDepthSbChange(Sender: TObject);
- procedure GraduateRgClick(Sender: TObject);
- procedure HighlightRgClick(Sender: TObject);
- procedure ShadowRgClick(Sender: TObject);
- procedure FromColorCcbChange(Sender: TObject);
- procedure HighlightColorCcbChange(Sender: TObject);
- procedure ShadowColorCcbChange(Sender: TObject);
- procedure FontColorCcbChange(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure SaveAsBtnClick(Sender: TObject);
- procedure DeleteBtnClick(Sender: TObject);
- procedure SchemeCbChange(Sender: TObject);
- procedure AppearanceCbChange(Sender: TObject);
- procedure ColorSchemeCbChange(Sender: TObject);
- private
- public
- HighlightDirectionDp : TOvcDirectionPicker;
- ShadowDirectionDp : TOvcDirectionPicker;
- SettingScheme : Boolean;
- SettingCb : Boolean;
-
- procedure DeleteScheme(const S : string);
- procedure HighlightDirectionChange(Sender: TObject);
- procedure ShadowDirectionChange(Sender: TObject);
- procedure SchemeChange;
- end;
-
-type
- {component editor for the notebook pages}
-{$IFNDEF LCL}
- TOvcLabelEditor = class(TDefaultEditor)
-{$ELSE}
- TOvcLabelEditor = class(TDefaultComponentEditor)
-{$ENDIF}
- public
- procedure ExecuteVerb(Index : Integer);
- override;
- function GetVerb(Index : Integer) : AnsiString;
- override;
- function GetVerbCount : Integer;
- override;
- end;
-
- {property editor for the special settings class}
- TOvcCustomSettingsProperty = class(TClassProperty)
- public
- procedure Edit;
- override;
- function GetAttributes : TPropertyAttributes;
- override;
- end;
-
-function EditOvcLabel(L : TOvcLabel) : Boolean;
-
-
-implementation
-
-uses
- OvcLbl1;
-
-{$IFNDEF LCL}
-{$R *.DFM}
-{$ENDIF}
-
-const
- IniFileName = 'orpheus.ini';
-// Note: Location of this file needs to consider platform differences.
-// Currently creates it in Lazarus folder (Windows) or root folder (OS X).
-
-function EditOvcLabel(L : TOvcLabel) : Boolean;
-var
- D : TfrmOvcLabel;
-begin
- Result := False;
- D := TfrmOvcLabel.Create(Application);
- try
- D.OvcLabel.Font.Assign(L.Font);
- D.OvcLabel.CustomSettings.Assign(L.CustomSettings);
-
- D.FontSizeSb.Position := L.Font.Size;
- D.HighlightDepthSB.Position := L.CustomSettings.HighlightDepth;
- D.ShadowDepthSB.Position := L.CustomSettings.ShadowDepth;
-
- D.GraduateRg.ItemIndex := Ord(L.CustomSettings.GraduateStyle);
- D.HighlightRg.ItemIndex := Ord(L.CustomSettings.HighlightStyle);
- D.ShadowRg.ItemIndex := Ord(L.CustomSettings.ShadowStyle);
-
- D.FontColorCcb.SelectedColor := L.Font.Color;
- D.FromColorCcb.SelectedColor := L.CustomSettings.GraduateFromColor;
- D.HighlightColorCcb.SelectedColor := L.CustomSettings.HighlightColor;
- D.ShadowColorCcb.SelectedColor := L.CustomSettings.ShadowColor;
-
- D.HighlightDirectionDp.Direction := Ord(L.CustomSettings.HighlightDirection)-1;
- D.ShadowDirectionDp.Direction := Ord(L.CustomSettings.ShadowDirection)-1;
-
- if D.ShowModal = mrOK then begin
- L.CustomSettings.BeginUpdate;
- try
- L.Font.Assign(D.OvcLabel.Font);
- L.CustomSettings.Assign(D.OvcLabel.CustomSettings);
- finally
- L.CustomSettings.EndUpdate;
- end;
- Result := True;
- end;
- finally
- D.Free;
- end;
-end;
-
-
-{*** TOvcLabelEditor ***}
-
-procedure TOvcLabelEditor.ExecuteVerb(Index : Integer);
-begin
- if EditOvcLabel(TOvcLabel(Component)) then
-{$IFNDEF LCL}
- Designer.Modified;
-{$ELSE}
- Modified;
-{$ENDIF}
-end;
-
-function TOvcLabelEditor.GetVerb(Index : Integer) : AnsiString;
-begin
- Result := 'Style Manager...';
-end;
-
-function TOvcLabelEditor.GetVerbCount : Integer;
-begin
- Result := 1;
-end;
-
-
-{*** TOvcCustomSettingsProperty ***}
-
-procedure TOvcCustomSettingsProperty.Edit;
-var
- I : Integer;
- C : TComponent;
- L : TOvcLabel;
- M : TOvcLabel;
-begin
- C := TComponent(GetComponent(0));
- if C is TOvcCustomLabel then begin
- L := TOvcLabel(C);
- if EditOvcLabel(L) then begin
- {if more than one component selected, apply changes to others}
- for I := 2 to PropCount do begin
- M := TOvcLabel(GetComponent(Pred(I)));
- M.CustomSettings.BeginUpdate;
- try
- M.Font.Assign(L.Font);
- M.CustomSettings.Assign(L.CustomSettings);
- finally
- M.CustomSettings.EndUpdate;
- end;
- M.Invalidate;
- end;
-{$IFNDEF LCL}
- Designer.Modified;
-{$ELSE}
- Modified;
-{$ENDIF}
- end;
- end;
-end;
-
-function TOvcCustomSettingsProperty.GetAttributes: TPropertyAttributes;
-begin
- Result := [paSubProperties, paMultiSelect, paDialog, paReadOnly]
-end;
-
-
-{*** TOvcLabelFrm ***}
-
-procedure TfrmOvcLabel.FontSizeSbChange(Sender: TObject);
-begin
- OvcLabel.Font.Size := FontSizeSb.Position;
- FontSizeLbl.Caption := IntToStr(OvcLabel.Font.Size);
- SchemeChange;
-end;
-
-procedure TfrmOvcLabel.HighlightDepthSbChange(Sender: TObject);
-begin
- OvcLabel.CustomSettings.HighlightDepth := HighlightDepthSb.Position;
- HighlightDepthLbl.Caption := IntToStr(OvcLabel.CustomSettings.HighlightDepth);
- SchemeChange;
-end;
-
-procedure TfrmOvcLabel.ShadowDepthSbChange(Sender: TObject);
-begin
- OvcLabel.CustomSettings.ShadowDepth := ShadowDepthSb.Position;
- ShadowDepthLbl.Caption := IntToStr(OvcLabel.CustomSettings.ShadowDepth);
- SchemeChange;
-end;
-
-procedure TfrmOvcLabel.GraduateRgClick(Sender: TObject);
-begin
- case GraduateRg.ItemIndex of
- 0 : OvcLabel.CustomSettings.GraduateStyle := gsNone;
- 1 : OvcLabel.CustomSettings.GraduateStyle := gsHorizontal;
- 2 : OvcLabel.CustomSettings.GraduateStyle := gsVertical;
- end;
- SchemeChange;
-end;
-
-procedure TfrmOvcLabel.HighlightRgClick(Sender: TObject);
-begin
- case HighlightRg.ItemIndex of
- 0 : OvcLabel.CustomSettings.HighlightStyle := ssPlain;
- 1 : OvcLabel.CustomSettings.HighlightStyle := ssExtrude;
- 2 : OvcLabel.CustomSettings.HighlightStyle := ssGraduated;
- end;
- SchemeChange;
-end;
-
-procedure TfrmOvcLabel.ShadowRgClick(Sender: TObject);
-begin
- case ShadowRg.ItemIndex of
- 0 : OvcLabel.CustomSettings.ShadowStyle := ssPlain;
- 1 : OvcLabel.CustomSettings.ShadowStyle := ssExtrude;
- 2 : OvcLabel.CustomSettings.ShadowStyle := ssGraduated;
- end;
- SchemeChange;
-end;
-
-procedure TfrmOvcLabel.FromColorCcbChange(Sender: TObject);
-begin
- OvcLabel.CustomSettings.GraduateFromColor := FromColorCcb.SelectedColor;
- SchemeChange;
-end;
-
-procedure TfrmOvcLabel.HighlightColorCcbChange(Sender: TObject);
-begin
- OvcLabel.CustomSettings.HighlightColor := HighlightColorCcb.SelectedColor;
- SchemeChange;
-end;
-
-procedure TfrmOvcLabel.ShadowColorCcbChange(Sender: TObject);
-begin
- OvcLabel.CustomSettings.ShadowColor := ShadowColorCcb.SelectedColor;
- SchemeChange;
-end;
-
-procedure TfrmOvcLabel.FontColorCcbChange(Sender: TObject);
-begin
- OvcLabel.Font.Color := FontColorCcb.SelectedColor;
- SchemeChange;
-end;
-
-procedure TfrmOvcLabel.FormCreate(Sender: TObject);
-var
- Ini : TIniFile;
- A : TOvcAppearance;
- C : TOvcColorScheme;
-begin
- Top := (Screen.Height - Height) div 3;
- Left := (Screen.Width - Width) div 2;
-
- {load scheme names into combo box}
- Ini := TIniFile.Create(IniFileName);
- try
- SchemeCb.Items.Clear;
- Ini.ReadSection('Schemes', SchemeCb.Items);
- finally
- Ini.Free;
- end;
-
- {create direction pickers}
- HighlightDirectionDp := TOvcDirectionPicker.Create(Self);
- HighlightDirectionDp.Top := HighlightDirectionLbl.Top;
- HighlightDirectionDp.Left := HighlightDirectionLbl.Left + HighlightDirectionLbl.Width;
- HighlightDirectionDp.Width := 50;
- HighlightDirectionDp.Height := 50;
- HighlightDirectionDp.NumDirections := 8;
- HighlightDirectionDp.OnChange := HighlightDirectionChange;
- HighlightDirectionDp.Parent := HighlightDirectionLbl.Parent;
- HighlightDirectionDp.Visible := True;
-
- ShadowDirectionDp := TOvcDirectionPicker.Create(Self);
- ShadowDirectionDp.Top := ShadowDirectionLbl.Top;
- ShadowDirectionDp.Left := ShadowDirectionLbl.Left + ShadowDirectionLbl.Width;
- ShadowDirectionDp.Width := 50;
- ShadowDirectionDp.Height := 50;
- ShadowDirectionDp.NumDirections := 8;
- ShadowDirectionDp.OnChange := ShadowDirectionChange;
- ShadowDirectionDp.Parent := ShadowDirectionLbl.Parent;
- ShadowDirectionDp.Visible := True;
-
- {initialize appearance and color scheme ComboBoxes using rtti}
- for A := Low(TOvcAppearance) to High(TOvcAppearance) do
- AppearanceCb.Items.Add(GetEnumName(TypeInfo(TOvcAppearance), Ord(A)));
- for C := Low(TOvcColorScheme) to High(TOvcColorScheme) do
- ColorSchemeCb.Items.Add(GetEnumName(TypeInfo(TOvcColorScheme), Ord(C)));
-end;
-
-procedure TfrmOvcLabel.SaveAsBtnClick(Sender: TObject);
-var
- Ini : TIniFile;
- S : string;
-begin
- with TfrmSaveScheme.Create(Self) do begin
- if (ShowModal = mrOK) and (SchemeNameEd.Text > '') then begin
- S := SchemeNameEd.Text;
- Ini := TIniFile.Create(IniFileName);
- try
- {delete scheme}
- DeleteScheme(S);
-
- {add scheme name to list of schemes}
- Ini.WriteInteger('Schemes', S, 0);
-
- {create new scheme section and add values}
- Ini.WriteInteger(S, 'GraduateStyle', Ord(OvcLabel.CustomSettings.GraduateStyle));
- Ini.WriteInteger(S, 'HighlightStyle', Ord(OvcLabel.CustomSettings.HighlightStyle));
- Ini.WriteInteger(S, 'ShadowStyle', Ord(OvcLabel.CustomSettings.ShadowStyle));
- Ini.WriteString(S, 'GraduateFromColor', ColorToString(OvcLabel.CustomSettings.GraduateFromColor));
- Ini.WriteString(S, 'HighlightColor', ColorToString(OvcLabel.CustomSettings.HighlightColor));
- Ini.WriteString(S, 'ShadowColor', ColorToString(OvcLabel.CustomSettings.ShadowColor));
- Ini.WriteInteger(S, 'HighlightDirection', Ord(OvcLabel.CustomSettings.HighlightDirection));
- Ini.WriteInteger(S, 'ShadowDirection', Ord(OvcLabel.CustomSettings.ShadowDirection));
- Ini.WriteString(S, 'FontColor', ColorToString(OvcLabel.Font.Color));
- Ini.WriteString(S, 'FontName', OvcLabel.Font.Name);
- Ini.WriteInteger(S, 'FontPitch', Ord(OvcLabel.Font.Pitch));
- Ini.WriteInteger(S, 'FontSize', OvcLabel.Font.Size);
- Ini.WriteBool(S, 'FontBold', fsBold in OvcLabel.Font.Style);
- Ini.WriteBool(S, 'FontItalic', fsItalic in OvcLabel.Font.Style);
- Ini.WriteBool(S, 'FontUnderline', fsUnderline in OvcLabel.Font.Style);
- Ini.WriteBool(S, 'FontStrikeOut', fsStrikeOut in OvcLabel.Font.Style);
- Ini.WriteInteger(S, 'HighlightDepth', OvcLabel.CustomSettings.HighlightDepth);
- Ini.WriteInteger(S, 'ShadowDepth', OvcLabel.CustomSettings.ShadowDepth);
- finally
- Ini.Free;
- end;
-
- {add item to the ComboBox, if its not there already}
- if SchemeCb.Items.IndexOf(S) < 0 then
- SchemeCb.Items.Add(S);
- end;
- Free;
- end;
-end;
-
-procedure TfrmOvcLabel.DeleteBtnClick(Sender: TObject);
-var
- I : Integer;
-begin
- I := SchemeCb.ItemIndex;
- if I > -1 then begin
- DeleteScheme(SchemeCb.Items[I]);
- {delete the entry from the combo box}
- SchemeCb.Items.Delete(I);
- end;
-end;
-
-procedure TfrmOvcLabel.DeleteScheme(const S : string);
-var
- Ini : TIniFile;
-begin
- {delete the scheme entry from the ini file}
- Ini := TIniFile.Create(IniFileName);
- try
- {delete the section}
- Ini.EraseSection(S);
- {delete the scheme name}
- Ini.DeleteKey('Schemes', S);
- finally
- Ini.Free;
- end;
-end;
-
-procedure TfrmOvcLabel.SchemeCbChange(Sender: TObject);
-var
- I : Integer;
- Ini : TIniFile;
- S : string;
-begin
- I := SchemeCb.ItemIndex;
- if I > -1 then begin
- S := SchemeCb.Items[I];
- Ini := TIniFile.Create(IniFileName);
- SettingScheme := True;
- try
- OvcLabel.CustomSettings.GraduateStyle := TOvcGraduateStyle(Ini.ReadInteger(S, 'GraduateStyle', 0));
- OvcLabel.CustomSettings.HighlightStyle := TOvcShadeStyle(Ini.ReadInteger(S, 'HighlightStyle', 0));
- OvcLabel.CustomSettings.ShadowStyle := TOvcShadeStyle(Ini.ReadInteger(S, 'ShadowStyle', 0));
- OvcLabel.CustomSettings.GraduateFromColor := StringToColor(Ini.ReadString(S, 'GraduateFromColor', '0'));
- OvcLabel.CustomSettings.HighlightColor := StringToColor(Ini.ReadString(S, 'HighlightColor', '0'));
- OvcLabel.CustomSettings.ShadowColor := StringToColor(Ini.ReadString(S, 'ShadowColor', '0'));
- OvcLabel.CustomSettings.HighlightDirection := TOvcShadeDirection(Ini.ReadInteger(S, 'HighlightDirection', 0));
- OvcLabel.CustomSettings.ShadowDirection := TOvcShadeDirection(Ini.ReadInteger(S, 'ShadowDirection', 0));
- OvcLabel.CustomSettings.HighlightDepth := Ini.ReadInteger(S, 'HighlightDepth', 1);
- OvcLabel.CustomSettings.ShadowDepth := Ini.ReadInteger(S, 'ShadowDepth', 1);
-
- OvcLabel.Font.Color := StringToColor(Ini.ReadString(S, 'FontColor', '0'));
-{$IFNDEF LCL}
- OvcLabel.Font.Name := Ini.ReadString(S, 'FontName', 'Times New Roman');
-{$ELSE}
- OvcLabel.Font.Name := Ini.ReadString(S, 'FontName', 'default');
-{$ENDIF}
- OvcLabel.Font.Pitch := TFontPitch(Ini.ReadInteger(S, 'FontPitch', 0));
- OvcLabel.Font.Size := Ini.ReadInteger(S, 'FontSize', 10);
- OvcLabel.Font.Style := [];
- if Ini.ReadBool(S, 'FontBold', False) then
- OvcLabel.Font.Style := OvcLabel.Font.Style + [fsBold];
- if Ini.ReadBool(S, 'FontItalic', False) then
- OvcLabel.Font.Style := OvcLabel.Font.Style + [fsItalic];
- if Ini.ReadBool(S, 'FontUnderline', False) then
- OvcLabel.Font.Style := OvcLabel.Font.Style + [fsUnderline];
- if Ini.ReadBool(S, 'FontStrikeOut', False) then
- OvcLabel.Font.Style := OvcLabel.Font.Style + [fsStrikeOut];
-
- FontSizeSb.Position := OvcLabel.Font.Size;
- HighlightDepthSB.Position := OvcLabel.CustomSettings.HighlightDepth;
- ShadowDepthSB.Position := OvcLabel.CustomSettings.ShadowDepth;
- GraduateRg.ItemIndex := Ord(OvcLabel.CustomSettings.GraduateStyle);
- HighlightRg.ItemIndex := Ord(OvcLabel.CustomSettings.HighlightStyle);
- ShadowRg.ItemIndex := Ord(OvcLabel.CustomSettings.ShadowStyle);
- FontColorCcb.SelectedColor := OvcLabel.Font.Color;
- FromColorCcb.SelectedColor := OvcLabel.CustomSettings.GraduateFromColor;
- HighlightColorCcb.SelectedColor := OvcLabel.CustomSettings.HighlightColor;
- ShadowColorCcb.SelectedColor := OvcLabel.CustomSettings.ShadowColor;
- HighlightDirectionDp.Direction := Ord(OvcLabel.CustomSettings.HighlightDirection)-1;
- ShadowDirectionDp.Direction := Ord(OvcLabel.CustomSettings.ShadowDirection)-1;
- finally
- SettingScheme := False;
- Ini.Free;
- end;
- end;
-end;
-
-procedure TfrmOvcLabel.HighlightDirectionChange(Sender: TObject);
-begin
- OvcLabel.CustomSettings.HighlightDirection :=
- TOvcShadeDirection(HighlightDirectionDp.Direction+1);
- SchemeChange;
-end;
-
-procedure TfrmOvcLabel.ShadowDirectionChange(Sender: TObject);
-begin
- OvcLabel.CustomSettings.ShadowDirection :=
- TOvcShadeDirection(ShadowDirectionDp.Direction+1);
- SchemeChange;
-end;
-
-procedure TfrmOvcLabel.SchemeChange;
-begin
- if not SettingScheme then
- SchemeCb.ItemIndex := -1;
-
- if not SettingCb then begin
- AppearanceCb.ItemIndex := -1;
- ColorSchemeCb.ItemIndex := -1;
- end;
-end;
-
-
-procedure TfrmOvcLabel.AppearanceCbChange(Sender: TObject);
-begin
- if AppearanceCb.ItemIndex > -1 then begin
- SettingScheme := True;
- SettingCb := True;
- try
- OvcLabel.Appearance := TOvcAppearance(AppearanceCb.ItemIndex);
-
- FontSizeSb.Position := OvcLabel.Font.Size;
- HighlightDepthSB.Position := OvcLabel.CustomSettings.HighlightDepth;
- ShadowDepthSB.Position := OvcLabel.CustomSettings.ShadowDepth;
- GraduateRg.ItemIndex := Ord(OvcLabel.CustomSettings.GraduateStyle);
- HighlightRg.ItemIndex := Ord(OvcLabel.CustomSettings.HighlightStyle);
- ShadowRg.ItemIndex := Ord(OvcLabel.CustomSettings.ShadowStyle);
- FontColorCcb.SelectedColor := OvcLabel.Font.Color;
- FromColorCcb.SelectedColor := OvcLabel.CustomSettings.GraduateFromColor;
- HighlightColorCcb.SelectedColor := OvcLabel.CustomSettings.HighlightColor;
- ShadowColorCcb.SelectedColor := OvcLabel.CustomSettings.ShadowColor;
- HighlightDirectionDp.Direction := Ord(OvcLabel.CustomSettings.HighlightDirection)-1;
- ShadowDirectionDp.Direction := Ord(OvcLabel.CustomSettings.ShadowDirection)-1;
- finally
- SettingCb := False;
- SettingScheme := False;
- end;
- end;
-end;
-
-procedure TfrmOvcLabel.ColorSchemeCbChange(Sender: TObject);
-begin
- if ColorSchemeCb.ItemIndex > -1 then begin
- SettingScheme := True;
- SettingCb := True;
- try
- OvcLabel.ColorScheme := TOvcColorScheme(ColorSchemeCb.ItemIndex);
-
- FontSizeSb.Position := OvcLabel.Font.Size;
- HighlightDepthSB.Position := OvcLabel.CustomSettings.HighlightDepth;
- ShadowDepthSB.Position := OvcLabel.CustomSettings.ShadowDepth;
- GraduateRg.ItemIndex := Ord(OvcLabel.CustomSettings.GraduateStyle);
- HighlightRg.ItemIndex := Ord(OvcLabel.CustomSettings.HighlightStyle);
- ShadowRg.ItemIndex := Ord(OvcLabel.CustomSettings.ShadowStyle);
- FontColorCcb.SelectedColor := OvcLabel.Font.Color;
- FromColorCcb.SelectedColor := OvcLabel.CustomSettings.GraduateFromColor;
- HighlightColorCcb.SelectedColor := OvcLabel.CustomSettings.HighlightColor;
- ShadowColorCcb.SelectedColor := OvcLabel.CustomSettings.ShadowColor;
- HighlightDirectionDp.Direction := Ord(OvcLabel.CustomSettings.HighlightDirection)-1;
- ShadowDirectionDp.Direction := Ord(OvcLabel.CustomSettings.ShadowDirection)-1;
- finally
- SettingCb := False;
- SettingScheme := False;
- end;
- end;
-end;
-
-initialization
-{$IFDEF LCL}
-{$I ovclbl0.lrs} {Include form's resource file}
-{$ENDIF}
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovclbl1.lfm b/Source/3rdParty/Orpheus/ovclbl1.lfm
deleted file mode 100644
index 85396d64..00000000
--- a/Source/3rdParty/Orpheus/ovclbl1.lfm
+++ /dev/null
@@ -1,51 +0,0 @@
-object frmSaveScheme: TfrmSaveScheme
- Left = 347
- Top = 298
- BorderStyle = bsDialog
- Caption = 'Save Style'
- ClientHeight = 85
- Height = 85
- ClientWidth = 348
- Width = 348
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- OnCreate = FormCreate
- PixelsPerInch = 96
- object Label1: TLabel
- Left = 4
- Top = 8
- Width = 85
- Height = 13
- Caption = 'Save this style as:'
- end
- object SchemeNameEd: TEdit
- Left = 4
- Top = 24
- Width = 341
- Height = 21
- MaxLength = 255
- TabOrder = 0
- end
- object OkBtn: TButton
- Left = 192
- Top = 56
- Width = 75
- Height = 25
- Caption = 'OK'
- Default = True
- ModalResult = 1
- TabOrder = 1
- end
- object CancelBtn: TButton
- Left = 272
- Top = 56
- Width = 75
- Height = 25
- Cancel = True
- Caption = 'Cancel'
- ModalResult = 2
- TabOrder = 2
- end
-end
diff --git a/Source/3rdParty/Orpheus/ovclbl1.lrs b/Source/3rdParty/Orpheus/ovclbl1.lrs
deleted file mode 100644
index 32b4a60d..00000000
--- a/Source/3rdParty/Orpheus/ovclbl1.lrs
+++ /dev/null
@@ -1,15 +0,0 @@
-LazarusResources.Add('TfrmSaveScheme','FORMDATA',[
- 'TPF0'#14'TfrmSaveScheme'#13'frmSaveScheme'#4'Left'#3'['#1#3'Top'#3'*'#1#11'B'
- +'orderStyle'#7#8'bsDialog'#7'Caption'#6#10'Save Style'#12'ClientHeight'#2'U'
- +#6'Height'#2'U'#11'ClientWidth'#3'\'#1#5'Width'#3'\'#1#12'Font.Charset'#7#15
- +'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245#10
- +'Font.Style'#11#0#8'OnCreate'#7#10'FormCreate'#13'PixelsPerInch'#2'`'#0#6'TL'
- +'abel'#6'Label1'#4'Left'#2#4#3'Top'#2#8#5'Width'#2'U'#6'Height'#2#13#7'Capti'
- +'on'#6#19'Save this style as:'#0#0#5'TEdit'#12'SchemeNameEd'#4'Left'#2#4#3'T'
- +'op'#2#24#5'Width'#3'U'#1#6'Height'#2#21#9'MaxLength'#3#255#0#8'TabOrder'#2#0
- +#0#0#7'TButton'#5'OkBtn'#4'Left'#3#192#0#3'Top'#2'8'#5'Width'#2'K'#6'Height'
- +#2#25#7'Caption'#6#2'OK'#7'Default'#9#11'ModalResult'#2#1#8'TabOrder'#2#1#0#0
- +#7'TButton'#9'CancelBtn'#4'Left'#3#16#1#3'Top'#2'8'#5'Width'#2'K'#6'Height'#2
- +#25#6'Cancel'#9#7'Caption'#6#6'Cancel'#11'ModalResult'#2#2#8'TabOrder'#2#2#0
- +#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/ovclbl1.pas b/Source/3rdParty/Orpheus/ovclbl1.pas
deleted file mode 100644
index ee926c1c..00000000
--- a/Source/3rdParty/Orpheus/ovclbl1.pas
+++ /dev/null
@@ -1,77 +0,0 @@
-{*********************************************************}
-{* OVCLBL1.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 ovclbl1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, Buttons, {$ENDIF}
- SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls;
-
-type
- TfrmSaveScheme = class(TForm)
- Label1: TLabel;
- SchemeNameEd: TEdit;
- OkBtn: TButton;
- CancelBtn: TButton;
- procedure FormCreate(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.DFM}
-{$ENDIF}
-
-procedure TfrmSaveScheme.FormCreate(Sender: TObject);
-begin
- Top := (Screen.Height - Height) div 3;
- Left := (Screen.Width - Width) div 2;
-end;
-
-initialization
-{$IFDEF LCL}
-{$I ovclbl1.lrs} {Include form's resource file}
-{$ENDIF}
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovclbl2.pas b/Source/3rdParty/Orpheus/ovclbl2.pas
deleted file mode 100644
index ea78150c..00000000
--- a/Source/3rdParty/Orpheus/ovclbl2.pas
+++ /dev/null
@@ -1,290 +0,0 @@
-{*********************************************************}
-{* OVCLABEL.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 ovclbl2;
- {-direction picker component}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- Classes, Controls, Graphics, OvcBase, OvcData, OvcMisc;
-
-type
- TOvcCustomDirectionPicker = class(TOvcGraphicControl)
- protected {private}
- {property variables}
- FDirection : Integer;
- FNumDirections : Integer;
- FSelectedBitmap : TBitmap;
- FShowCenter : Boolean;
- FDirectionBitmap : TBitmap;
-
- {event variables}
- FOnChange : TNotifyEvent;
-
- {property methods}
- procedure SetDirection(Value : Integer);
- procedure SetSelectedBitmap(Value : TBitmap);
- procedure SetNumDirections(Value : Integer);
- procedure SetShowCenter(Value : Boolean);
- procedure SetDirectionBitmap(Value : TBitmap);
-
- protected
- procedure MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
- override;
- procedure Paint;
- override;
-
- property Direction : Integer
- read FDirection write SetDirection default 0;
- property NumDirections : Integer
- read FNumDirections write SetNumDirections default 8;
- property SelectedBitmap : TBitmap
- read FSelectedBitmap write SetSelectedBitmap;
- property ShowCenter : Boolean
- read FShowCenter write SetShowCenter default True;
- property DirectionBitmap : TBitmap
- read FDirectionBitmap write SetDirectionBitmap;
-
- property OnChange : TNotifyEvent
- read FOnChange write FOnChange;
-
- public
- constructor Create(AComponent : TComponent);
- override;
- destructor Destroy;
- override;
- end;
-
- TOvcDirectionPicker = class(TOvcCustomDirectionPicker)
- published
- property Direction;
- property Enabled;
- property SelectedBitmap;
- property NumDirections;
- property ShowCenter;
- property DirectionBitmap;
-
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- end;
-
-
-implementation
-
-
-const
- DToR = Pi / 180;
-
-constructor TOvcCustomDirectionPicker.Create(AComponent : TComponent);
-begin
- inherited Create(AComponent);
-
- ControlStyle := [csClickEvents, csDoubleClicks];
-
- Width := 50;
- Height := 50;
-
- FDirection := -1;
- FNumDirections := 8;
- FShowCenter := True;
-
- {create and load the bitmap images}
- {resource are in ovcreg.rc}
- FDirectionBitmap := TBitmap.Create;
-{$IFNDEF LCL}
- FDirectionBitmap.Handle := LoadBitmap(HInstance, 'ORBLUEDOT');
-{$ELSE}
- FDirectionBitmap.LoadFromLazarusResource('ORBLUEDOT');
-{$ENDIF}
- FSelectedBitmap := TBitmap.Create;
-{$IFNDEF LCL}
- FSelectedBitmap.Handle := LoadBitmap(HInstance, 'ORREDDOT');
-{$ELSE}
- FSelectedBitmap.LoadFromLazarusResource('ORREDDOT');
-{$ENDIF}
-end;
-
-destructor TOvcCustomDirectionPicker.Destroy;
-begin
- {destroy bitmaps}
- FDirectionBitmap.Free;
- FDirectionBitmap := nil;
- FSelectedBitmap.Free;
- FSelectedBitmap := nil;
-
- inherited Destroy;
-end;
-
-procedure TOvcCustomDirectionPicker.MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : Integer);
-var
- I : Integer;
- BW : Integer;
- Angle : Extended;
- Diameter : Integer;
- Radius : Integer;
- X1, Y1 : Integer;
- Distance : Integer;
- BestDirection : Integer;
- BestDistance : Integer;
-begin
- inherited MouseDown(Button, Shift, X, Y);
-
- if (Button = mbLeft) and Enabled then begin
- BW := MaxI(FDirectionBitmap.Width, FDirectionBitmap.Height);
- Diameter := MinI(Height, Width)-2*BW;
- Radius := Diameter div 2;
-
- if FShowCenter then begin
- {initialize at center (-1)}
- BestDistance := Round(Sqrt(Sqr(Radius+BW-X) + Sqr(Radius+BW-Y)));
- BestDirection := -1;
- end else begin
- BestDistance := Width*2;
- BestDirection := FDirection;
- end;
-
- for I := 0 to Pred(FNumDirections) do begin
- Angle := (I * (360/FNumDirections) + 90) * DToR;
- X1 := Round(Radius * (1-Cos(Angle))) + BW;
- Y1 := Round(Radius * (1-Sin(Angle))) + BW;
- Distance := Round(Sqrt(Sqr(X1-X) + Sqr(Y1-Y)));
- if Distance < BestDistance then begin
- BestDistance := Distance;
- BestDirection := I;
- end;
- end;
-
- Direction := BestDirection;
- end;
-end;
-
-procedure TOvcCustomDirectionPicker.Paint;
-var
- I : Integer;
- BW : Integer;
- BW2 : Integer;
- Angle : Extended;
- Diameter : Integer;
- Radius : Integer;
- X, Y : Integer;
-begin
- BW := MaxI(FDirectionBitmap.Width, FDirectionBitmap.Height);
- Diameter := MinI(Height, Width)-2*BW;
- Radius := Diameter div 2;
-
- if FShowCenter then
- Canvas.Draw(Radius+BW, Radius+BW, FDirectionBitmap);
- for I := 0 to Pred(FNumDirections) do begin
- Angle := (I * (360/FNumDirections) + 90) * DToR;
- X := Round(Radius * (1-Cos(Angle)));
- Y := Round(Radius * (1-Sin(Angle)));
- Canvas.Draw(X+BW, Y+BW, FDirectionBitmap);
- end;
-
- {draw the dot for the selected direction}
- BW2 := (MaxI(FSelectedBitmap.Width, FSelectedBitmap.Height)-BW) div 2; {adjustment for larger bitmap}
- if FDirection = -1 then begin
- if FShowCenter then
- Canvas.Draw(Radius+BW-BW2, Radius+BW-BW2, FSelectedBitmap)
- end else begin
- Angle := (FDirection * (360/FNumDirections) + 90) * DToR;
- X := Round(Radius * (1-Cos(Angle)));
- Y := Round(Radius * (1-Sin(Angle)));
- Canvas.Draw(X+BW-BW2, Y+BW-BW2, FSelectedBitmap);
- end;
-end;
-
-procedure TOvcCustomDirectionPicker.SetDirection(Value : Integer);
-begin
- if csLoading in ComponentState then begin
- FDirection := Value;
- Exit;
- end;
-
- if (Value <> FDirection) and (Value >= -1) and (Value < FNumDirections) then begin
- FDirection := Value;
- Invalidate;
- if Assigned(FOnChange) then
- FOnChange(Self);
- end;
-end;
-
-procedure TOvcCustomDirectionPicker.SetSelectedBitmap(Value : TBitmap);
-begin
- if Assigned(Value) then
- FSelectedBitmap.Assign(Value)
- else
- FSelectedBitmap.ReleaseHandle;
- Invalidate;
-end;
-
-procedure TOvcCustomDirectionPicker.SetNumDirections(Value : Integer);
-begin
- if (Value <> FNumDirections) and (Value >= 2) then begin
- FNumDirections := Value;
- Invalidate;
- end;
-end;
-
-procedure TOvcCustomDirectionPicker.SetShowCenter(Value : Boolean);
-begin
- if Value <> FShowCenter then begin
- FShowCenter := Value;
- Invalidate;
- end;
-end;
-
-procedure TOvcCustomDirectionPicker.SetDirectionBitmap(Value : TBitmap);
-begin
- if Assigned(Value) then
- FDirectionBitmap.Assign(Value)
- else
- FDirectionBitmap.ReleaseHandle;
- Invalidate;
-end;
-
-
-initialization
- if Classes.GetClass(TOvcDirectionPicker.ClassName) = nil then
- Classes.RegisterClass(TOvcDirectionPicker);
-end.
diff --git a/Source/3rdParty/Orpheus/ovcmisc.pas b/Source/3rdParty/Orpheus/ovcmisc.pas
deleted file mode 100644
index 356b743c..00000000
--- a/Source/3rdParty/Orpheus/ovcmisc.pas
+++ /dev/null
@@ -1,1116 +0,0 @@
-{*********************************************************}
-{* OVCMISC.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 ***** *}
-
-(*Changes)
-
- 10/20/01- Hdc changed to TOvcHdc for BCB Compatibility
- 10/20/01- HWnd changed to TOvcHWnd for BCB Compatibility
-*)
-
-{$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 ovcmisc;
- {-Miscellaneous functions and procedures}
-
-interface
-
-uses
- SysUtils, Classes,
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Buttons, Controls, ExtCtrls, Forms, Graphics,
- {$IFNDEF LCL} Consts, {$ELSE} LclStrConsts, {$ENDIF} OvcData;
-
-{ Hdc needs to be an Integer for BCB compatibility }
-{$IFDEF CBuilder}
-type
- TOvcHdc = Integer;
- TOvcHWND = Cardinal;
-{$ELSE}
-type
- TOvcHdc = HDC;
- TOvcHWND = HWND;
-{$ENDIF}
-
-{$IFNDEF LCL}
-function LoadBaseBitmap(lpBitmapName : PAnsiChar) : HBITMAP;
- {-load and return the handle to bitmap resource}
-function LoadBaseCursor(lpCursorName : PAnsiChar) : HCURSOR;
- {-load and return the handle to cursor resource}
-{$ENDIF}
-function CompStruct(const S1, S2; Size : Cardinal) : Integer;
- {-compare two fixed size structures}
-function DefaultEpoch : Integer;
- {-return the current century}
-function DrawButtonFrame(Canvas : TCanvas; const Client : TRect;
- IsDown, IsFlat : Boolean; Style : TButtonStyle) : TRect;
- {-produce a button similar to DrawFrameControl}
-procedure FixRealPrim(P : PAnsiChar; DC : AnsiChar);
- {-get a PChar string representing a real ready for Val()}
-function GetDisplayString(Canvas : TCanvas; const S : string;
- MinChars, MaxWidth : Integer) : string;
- {-given a string, a minimum number of chars to display, and a max width,
- find the string that can be displayed in that width - add ellipsis to
- the end if necessary and possible}
-function GetLeftButton: Byte;
- {-return the mapped left button}
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
-function GetNextDlgItem(Ctrl : TOvcHWnd{hWnd}) : hWnd;
-
- {-get handle of next control in the same form}
-procedure GetRGB(Clr : TColor; var IR, IG, IB : Byte);
- {-return component parts of the rgb value}
-function GetShiftFlags : Byte;
- {-get current shift flags, the high order bit is set if the key is down}
-function CreateRotatedFont(F : TFont; Angle : Integer) : hFont;
- {-create a rotated font based on the font object F}
-function GetTopTextMargin(Font : TFont; BorderStyle : TBorderStyle;
- Height : Integer; Ctl3D : Boolean) : Integer;
- {-return the pixel top margin size}
-function ExtractWord(N : Integer; const S : string; WordDelims : TCharSet) : string;
- {-return the Nth word from S}
-function IsForegroundTask : Boolean;
- {-returns true if this task is currently in the foreground}
-function TrimLeft(const S : string) : string;
- {-return a string with leading white space removed}
-function TrimRight(const S : string) : string;
- {-return a string with trailing white space removed}
-function QuotedStr(const S : string) : string;
- {-return a quoted string string with internal quotes escaped}
-function WordCount(const S : string; const WordDelims : TCharSet) : Integer;
- {-return the word count given a set of word delimiters}
-function WordPosition(const N : Integer; const S : string; const WordDelims : TCharSet) : Integer;
- {-return start position of N'th word in S}
-function PtrDiff(const P1, P2) : Word;
- {-return the difference between P1 and P2}
-procedure PtrInc(var P; Delta : Word);
- {-increase P by Delta}
-procedure PtrDec(var P; Delta : Word);
- {-decrease P by Delta}
-procedure FixTextBuffer(InBuf, OutBuf : PChar; OutSize : Integer);
- {-replace orphan linefeeds with cr/lf pairs}
-
-{ - Hdc changed to TOvcHdc for BCB Compatibility }
-procedure TransStretchBlt(DstDC: TOvcHdc{HDC}; DstX, DstY, DstW, DstH: Integer;
- SrcDC: TOvcHdc{HDC}; SrcX, SrcY, SrcW, SrcH: Integer;
- MaskDC: TOvcHdc{HDC};
- MaskX, MaskY : Integer);
-function MaxL(A, B : LongInt) : LongInt;
-function MinL(A, B : LongInt) : LongInt;
-function MinI(X, Y : Integer) : Integer;
- {-return the minimum of two integers}
-function MaxI(X, Y : Integer) : Integer;
- {-return the maximum of two integers}
-
-{function GenerateComponentName(PF : TCustomForm; const Root : string) : string;}
-function GenerateComponentName(PF : TWinControl; const Root : string) : string;
- {-return a component name unique for this form}
-function PartialCompare(const S1, S2 : string) : Boolean;
- {-compare minimum length of S1 and S2 strings}
-
-function PathEllipsis(const S : string; MaxWidth : Integer) : string;
-function CreateDisabledBitmap(FOriginal : TBitmap; OutlineColor : TColor) : TBitmap;
-procedure CopyParentImage(Control : TControl; Dest : TCanvas);
-procedure DrawTransparentBitmap(Dest : TCanvas; X, Y, W, H : Integer;
- Rect : TRect; Bitmap : TBitmap; TransparentColor : TColor);
-function WidthOf(const R : TRect) : Integer;
- {returnd R.Right - R.Left}
-function HeightOf(const R : TRect) : Integer;
- {returnd R.Bottom - R.Top}
-procedure DebugOutput(const S : string);
- {use OutputDebugString()}
-
-implementation
-
-uses
- OvcBase, OvcStr;
-
-{$IFNDEF LCL}
-function LoadBaseBitmap(lpBitmapName : PAnsiChar) : HBITMAP;
-begin
- Result := LoadBitmap(FindClassHInstance(TOvcCustomControlEx), lpBitmapName);
-end;
-
-function LoadBaseCursor(lpCursorName : PAnsiChar) : HCURSOR;
-begin
- Result := LoadCursor(FindClassHInstance(TOvcCustomControlEx), lpCursorName);
-end;
-{$ENDIF}
-
-{$IFDEF NoAsm}
-function CompStruct(const S1, S2; Size : Cardinal) : Integer;
-// Since CompStruct currently only used elsewhere to determine if
-// two structures are different, just use CompareMem and don't
-// worry about whether "greater than" or "less than".
-begin
- if CompareMem(@S1, @S2, Size) then {Structures identical?}
- Result := 0
- else {Structures not identical, so just return as though S1 > S2}
- Result := 1;
-end;
-
-{$ELSE}
-function CompStruct(const S1, S2; Size : Cardinal) : Integer; register;
- {-compare two fixed size structures}
-asm
- push esi
- push edi
-
- mov esi, eax {pointer to S1}
- mov edi, edx {pointer to S2}
-
- xor eax, eax {eax holds temporary result (Equal)}
-
- or ecx, ecx {size is already in ecx}
- jz @@CSDone {make sure size isn't zero}
-
- cld {go forward}
- repe cmpsb {compare until no match or ecx = 0}
-
- je @@CSDone {if equal, result is already in eax}
- inc eax {prepare for greater}
- ja @@CSDone {S1 greater? return +1}
- mov eax, -1 {else S1 less, return -1}
-
-@@CSDone:
-
- pop edi
- pop esi
-end;
-{$ENDIF}
-
-procedure FixRealPrim(P : PAnsiChar; DC : AnsiChar);
- {-Get a string representing a real ready for Val()}
-var
- DotPos : Cardinal;
- EPos : Cardinal;
- Len : Word;
- Found : Boolean;
- EFound : Boolean;
-begin
- TrimAllSpacesPChar(P);
-
- Len := StrLen(P);
- if Len > 0 then begin
- if P[Len-1] = DC then begin
- Dec(Len);
- P[Len] := #0;
- TrimAllSpacesPChar(P);
- end;
-
- {Val doesn't accept alternate decimal point chars}
- Found := StrChPos(P, DC, DotPos);
- {replace with '.'}
- if Found and (DotPos > 0) then
- P[DotPos] := '.'
- else
- Found := StrChPos(P, pmDecimalPt, DotPos);
-
- if Found then begin
- {check for 'nnnn.'}
- if LongInt(DotPos) = Len-1 then begin
- P[Len] := '0';
- Inc(Len);
- P[Len] := #0;
- end;
-
- {check for '.nnnn'}
- if DotPos = 0 then begin
- StrChInsertPrim(P, '0', 0);
- Inc(Len);
- Inc(DotPos);
- end;
-
- {check for '-.nnnn'}
- if (Len > 1) and (P^ = '-') and (DotPos = 1) then begin
- StrChInsertPrim(P, '0', 1);
- Inc(DotPos);
- end;
-
- end;
-
- {fix up numbers with exponents}
- EFound := StrChPos(P, 'E', EPos);
- if EFound and (EPos > 0) then begin
- if not Found then begin
- StrChInsertPrim(P, '.', EPos);
- DotPos := EPos;
- Inc(EPos);
- end;
- if EPos-DotPos < 12 then
- StrStInsertPrim(P, '00000', EPos);
- end;
-
- {remove blanks before and after '.' }
- if Found then begin
- while (DotPos > 0) and (P[DotPos-1] = ' ') do begin
- StrStDeletePrim(P, DotPos-1, 1);
- Dec(DotPos);
- end;
- while P[DotPos+1] = ' ' do
- StrStDeletePrim(P, DotPos+1, 1);
- end;
-
- end else begin
- {empty string = '0'}
- P[0] := '0';
- P[1] := #0;
- end;
-end;
-
-function GetLeftButton: Byte;
-const
- RLButton : array[Boolean] of Word = (VK_LBUTTON, VK_RBUTTON);
-begin
- Result := RLButton[GetSystemMetrics(SM_SWAPBUTTON) <> 0];
-end;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
-function GetNextDlgItem(Ctrl : TOvcHWnd{hWnd}) : hWnd;
- {-Get handle of next control in the same form}
-begin
- {asking for previous returns next}
- Result := GetNextWindow(Ctrl, GW_HWNDPREV);
- if Result = 0 then begin
- {asking for last returns first}
- Result := GetWindow(Ctrl, GW_HWNDLAST);
- if Result = 0 then
- Result := Ctrl;
- end;
-end;
-
-procedure GetRGB(Clr : TColor; var IR, IG, IB : Byte);
-begin
- if (Clr < 0) then begin
- Clr := Clr + MaxLongInt + 1;
- Clr := GetSysColor(Clr);
- end;
- IR := GetRValue(Clr);
- IG := GetGValue(Clr);
- IB := GetBValue(Clr);
-end;
-
-function GetShiftFlags : Byte;
- {-get current shift flags, the high order bit is set if the key is down}
-begin
- Result := (Ord(GetKeyState(VK_CONTROL) < 0) * ss_Ctrl) +
- (Ord(GetKeyState(VK_SHIFT ) < 0) * ss_Shift) +
- (Ord(GetKeyState(VK_ALT ) < 0) * ss_Alt);
-end;
-
-function CreateRotatedFont(F : TFont; Angle : Integer) : hFont;
- {-create a rotated font based on the font object F}
-var
- LF : TLogFont;
-begin
- FillChar(LF, SizeOf(LF), #0);
- with LF do begin
- lfHeight := F.Height;
- lfWidth := 0;
- lfEscapement := Angle*10;
- lfOrientation := 0;
- if fsBold in F.Style then
- lfWeight := FW_BOLD
- else
- lfWeight := FW_NORMAL;
- lfItalic := Byte(fsItalic in F.Style);
- lfUnderline := Byte(fsUnderline in F.Style);
- lfStrikeOut := Byte(fsStrikeOut in F.Style);
- lfCharSet := DEFAULT_CHARSET;
- StrPCopy(lfFaceName, F.Name);
- lfQuality := DEFAULT_QUALITY;
- {everything else as default}
- lfOutPrecision := OUT_DEFAULT_PRECIS;
- lfClipPrecision := CLIP_DEFAULT_PRECIS;
- case F.Pitch of
- fpVariable : lfPitchAndFamily := VARIABLE_PITCH;
- fpFixed : lfPitchAndFamily := FIXED_PITCH;
- else
- lfPitchAndFamily := DEFAULT_PITCH;
- end;
- end;
- Result := CreateFontIndirect(LF);
-end;
-
-function GetTopTextMargin(Font : TFont; BorderStyle : TBorderStyle;
- Height : Integer; Ctl3D : Boolean) : Integer;
- {-return the pixel top margin size}
-var
- I : Integer;
- DC : hDC;
- Metrics : TTextMetric;
- SaveFont : hFont;
- SysMetrics : TTextMetric;
-begin
- DC := GetDC(0);
- try
- GetTextMetrics(DC, SysMetrics);
- SaveFont := SelectObject(DC, Font.Handle);
- GetTextMetrics(DC, Metrics);
- SelectObject(DC, SaveFont);
- finally
- ReleaseDC(0, DC);
- end;
- I := SysMetrics.tmHeight;
- if I > Metrics.tmHeight then
- I := Metrics.tmHeight;
-
- if NewStyleControls then begin
- if BorderStyle = bsNone then begin
- Result := 0;
- if I >= Height-2 then
- Result := (Height-I-2) div 2 - Ord(Odd(Height-I));
- end else if Ctl3D then begin
- Result := 1;
- if I >= Height-4 then
- Result := (Height-I-4) div 2 - 1;
- end else begin
- Result := 1;
- if I >= Height-4 then
- Result := (Height-I-4) div 2 - Ord(Odd(Height-I));
- end;
- end else begin
- Result := (Height-Metrics.tmHeight-1) div 2;
- if I > Height-2 then begin
- Dec(Result, 2);
- if BorderStyle = bsNone then
- Inc(Result, 1);
- end;
- end;
-end;
-
-function PtrDiff(const P1, P2) : Word;
- {-return the difference between P1 and P2}
-begin
- {P1 and P2 are assumed to point within the same buffer}
- Result := PAnsiChar(P1) - PAnsiChar(P2);
-end;
-
-procedure PtrInc(var P; Delta : Word);
- {-increase P by Delta}
-begin
- Inc(PAnsiChar(P), Delta);
-end;
-
-procedure PtrDec(var P; Delta : Word);
- {-increase P by Delta}
-begin
- Dec(PAnsiChar(P), Delta);
-end;
-
-{$IFDEF NoAsm}
-function MinI(X, Y : Integer) : Integer;
-begin
- if X < Y then
- Result := X
- else
- Result := Y;
-end;
-
-function MaxI(X, Y : Integer) : Integer;
-begin
- if X >= Y then
- Result := X
- else
- Result := Y;
-end;
-
-{$ELSE}
-function MinI(X, Y : Integer) : Integer;
-asm
- cmp eax, edx
- jle @@Exit
- mov eax, edx
-@@Exit:
-end;
-
-function MaxI(X, Y : Integer) : Integer;
-asm
- cmp eax, edx
- jge @@Exit
- mov eax, edx
-@@Exit:
-end;
-{$ENDIF}
-
-function MaxL(A, B : LongInt) : LongInt;
-begin
- if (A < B) then
- Result := B
- else
- Result := A;
-end;
-
-function MinL(A, B : LongInt) : LongInt;
-begin
- if (A < B) then
- Result := A
- else
- Result := B;
-end;
-
-function TrimLeft(const S : string) : string;
-var
- I, L : Integer;
-begin
- L := Length(S);
- I := 1;
- while (I <= L) and (S[I] <= ' ') do
- Inc(I);
- Result := Copy(S, I, Length(S)-I+1);
-end;
-
-function TrimRight(const S : string) : string;
-var
- I : Integer;
-begin
- I := Length(S);
- while (I > 0) and (S[I] <= ' ') do
- Dec(I);
- Result := Copy(S, 1, I);
-end;
-
-function QuotedStr(const S: string): string;
-var
- I : Integer;
-begin
- Result := S;
- for I := Length(Result) downto 1 do
- if Result[I] = '''' then Insert('''', Result, I);
- Result := '''' + Result + '''';
-end;
-
-function WordCount(const S : string; const WordDelims : TCharSet) : Integer;
-var
- SLen, I : Integer;
-begin
- Result := 0;
- I := 1;
- SLen := Length(S);
- while I <= SLen do begin
- while (I <= SLen) and (S[I] in WordDelims) do
- Inc(I);
- if I <= SLen then
- Inc(Result);
- while (I <= SLen) and not(S[I] in WordDelims) do
- Inc(I);
- end;
-end;
-
-function ExtractWord(N : Integer; const S : string; WordDelims : TCharSet) : string;
-var
- I : Word;
- Len : Integer;
-begin
- Len := 0;
- I := WordPosition(N, S, WordDelims);
- if I <> 0 then
- { find the end of the current word }
- while (I <= Length(S)) and not(S[I] in WordDelims) do begin
- { add the I'th character to result }
- Inc(Len);
- SetLength(Result, Len);
- Result[Len] := S[I];
- Inc(I);
- end;
- SetLength(Result, Len);
-end;
-
-function WordPosition(const N : Integer; const S : string; const WordDelims : TCharSet) : Integer;
-var
- Count, I : Integer;
-begin
- Count := 0;
- I := 1;
- Result := 0;
- while (I <= Length(S)) and (Count <> N) do begin
- {skip over delimiters}
- while (I <= Length(S)) and (S[I] in WordDelims) do
- Inc(I);
- {if we're not beyond end of S, we're at the start of a word}
- if I <= Length(S) then
- Inc(Count);
- {if not finished, find the end of the current word}
- if Count <> N then
- while (I <= Length(S)) and not (S[I] in WordDelims) do
- Inc(I)
- else
- Result := I;
- end;
-end;
-
-function DrawButtonFrame(Canvas : TCanvas; const Client : TRect;
- IsDown, IsFlat : Boolean; Style : TButtonStyle) : TRect;
-var
- NewStyle : Boolean;
-begin
- Result := Client;
- NewStyle := (Style = bsNew) or (NewStyleControls and (Style = bsAutoDetect));
- if IsDown then begin
- if NewStyle then begin
- Frame3D(Canvas, Result, clWindowFrame, clBtnHighlight, 1);
- if not IsFlat then
- Frame3D(Canvas, Result, clBtnShadow, clBtnFace, 1);
- end else begin
- if IsFlat then
- Frame3D(Canvas, Result, clWindowFrame, clBtnHighlight, 1)
- else begin
- Frame3D(Canvas, Result, clWindowFrame, clWindowFrame, 1);
- Canvas.Pen.Color := clBtnShadow;
- Canvas.PolyLine([Point(Result.Left, Result.Bottom - 1),
- Point(Result.Left, Result.Top), Point(Result.Right, Result.Top)]);
- end;
- end;
- end else begin
- if NewStyle then begin
- if IsFlat then
- Frame3D(Canvas, Result, clBtnHighlight, clBtnShadow, 1)
- else begin
- Frame3D(Canvas, Result, clBtnHighlight, clWindowFrame, 1);
- Frame3D(Canvas, Result, clBtnFace, clBtnShadow, 1);
- end;
- end else begin
- if IsFlat then
- Frame3D(Canvas, Result, clBtnHighlight, clWindowFrame, 1)
- else begin
- Frame3D(Canvas, Result, clWindowFrame, clWindowFrame, 1);
- Frame3D(Canvas, Result, clBtnHighlight, clBtnShadow, 1);
- end;
- end;
- end;
- InflateRect(Result, -1, -1);
-end;
-
-function GetDisplayString(Canvas : TCanvas; const S : string;
- MinChars, MaxWidth : Integer) : string;
-var
- iDots, EllipsisWidth, Extent, Len, Width : Integer;
- ShowEllipsis : Boolean;
-begin
- {be sure that the Canvas Font is set before entering this routine}
- EllipsisWidth := Canvas.TextWidth('...');
- Len := Length(S);
- Result := S;
- Extent := Canvas.TextWidth(Result);
- ShowEllipsis := False;
- Width := MaxWidth;
- while (Extent > Width) do begin
- ShowEllipsis := True;
- Width := MaxWidth - EllipsisWidth;
- if Len > MinChars then begin
- Delete(Result, Len, 1);
- dec(Len);
- end else
- break;
- Extent := Canvas.TextWidth(Result);
- end;
- if ShowEllipsis then begin
- Result := Result + '...';
- inc(Len, 3);
- Extent := Canvas.TextWidth(Result);
- iDots := 3;
- while (iDots > 0) and (Extent > MaxWidth) do begin
- Delete(Result, Len, 1);
- Dec(Len);
- Extent := Canvas.TextWidth(Result);
- Dec(iDots);
- end;
- end;
-end;
-
-type
- PCheckTaskInfo = ^TCheckTaskInfo;
- TCheckTaskInfo = packed record
- FocusWnd: HWnd;
- Found: Boolean;
- end;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
-function CheckTaskWindow(Window: TOvcHWnd{HWnd};
- Data: PCheckTaskInfo): WordBool; stdcall; //64
-begin
- Result := True;
- if PCheckTaskInfo(Data)^.FocusWnd = Window then begin
- Result := False;
- PCheckTaskInfo(Data)^.Found := True;
- end;
-end;
-
-function IsForegroundTask : Boolean;
-var
- Info : TCheckTaskInfo;
-begin
- Info.FocusWnd := GetActiveWindow;
- Info.Found := False;
-{$IFNDEF DARWIN}
- EnumThreadWindows(GetCurrentThreadID, @CheckTaskWindow, LPARAM(@Info)); //64
-{$ELSE}
- EnumThreadWindows(LongWord(GetCurrentThreadID), @CheckTaskWindow, LPARAM(@Info)); //64
-{$ENDIF}
- Result := Info.Found;
-end;
-
-procedure FixTextBuffer(InBuf, OutBuf : PChar; OutSize : Integer);
-var
- I, P : Integer;
-begin
- P := 0;
- for I := 0 to StrLen(InBuf) do begin
- if (InBuf[I] = #10) and ((I = 0) or (InBuf[I-1] <> #13)) then begin
- OutBuf[P] := #13;
- Inc(P);
- end;
- OutBuf[P] := InBuf[I];
- {is outbuf full?}
- if P = OutSize-1 then begin
- {if so, terminate and exit}
- OutBuf[OutSize] := #0;
- Break;
- end;
- Inc(P);
- end;
-end;
-
-{ - Hdc changed to TOvcHdc for BCB Compatibility }
-procedure TransStretchBlt(DstDC: TOvcHdc{HDC}; DstX, DstY, DstW, DstH: Integer;
- SrcDC: TOvcHdc{HDC}; SrcX, SrcY, SrcW, SrcH: Integer;
- MaskDC: TOvcHdc{HDC};
- MaskX, MaskY : Integer);
-var
- MemDC : HDC;
- MemBmp : HBITMAP;
- Save : THandle;
- crText, crBack : TColorRef;
- SystemPalette16, SavePal : HPALETTE;
-begin
- SavePal := 0;
- MemDC := CreateCompatibleDC(0);
- try
- MemBmp := CreateCompatibleBitmap(SrcDC, SrcW, SrcH);
- Save := SelectObject(MemDC, MemBmp);
- SystemPalette16 := GetStockObject(DEFAULT_PALETTE);
- SavePal := SelectPalette(SrcDC, SystemPalette16, False);
- SelectPalette(SrcDC, SavePal, False);
- if SavePal <> 0 then
- SavePal := SelectPalette(MemDC, SavePal, True)
- else
- SavePal := SelectPalette(MemDC, SystemPalette16, True);
- RealizePalette(MemDC);
-
- StretchBlt(MemDC, 0, 0, SrcW, SrcH, MaskDC, MaskX, MaskY,
- SrcW, SrcH, SrcCopy);
- StretchBlt(MemDC, 0, 0, SrcW, SrcH, SrcDC, SrcX, SrcY, SrcW, SrcH,
- SrcErase);
- crText := SetTextColor(DstDC, $0);
- crBack := SetBkColor(DstDC, $FFFFFF);
- StretchBlt(DstDC, DstX, DstY, DstW, DstH, MaskDC, MaskX, MaskY,
- SrcW, SrcH, SrcAnd);
- StretchBlt(DstDC, DstX, DstY, DstW, DstH, MemDC, 0, 0,
- SrcW, SrcH, SrcInvert);
- SetTextColor(DstDC, crText);
- SetBkColor(DstDC, crBack);
- if Save <> 0 then
- SelectObject(MemDC, Save);
- DeleteObject(MemBmp);
- finally
- if SavePal <> 0 then
- SelectPalette(MemDC, SavePal, False);
- DeleteDC(MemDC);
- end;
-end;
-
-function DefaultEpoch : Integer;
-var
- ThisYear : Word;
- ThisMonth : Word;
- ThisDay : Word;
-begin
- DecodeDate(SysUtils.Date, ThisYear, ThisMonth, ThisDay);
- Result := (ThisYear div 100) * 100;
-end;
-
-{function GenerateComponentName(PF : TCustomForm; const Root : string) : string;}
-function GenerateComponentName(PF : TWinControl; const Root : string) : string;
-var
- I : Integer;
-begin
- if not IsValidIdent(Root) then
- raise EComponentError.CreateFmt('''''%s'''' is not a valid component name',
- [Root]);
- I := 0;
- repeat
- Inc(I);
- Result := Root + IntToStr(I);
- until (PF.FindComponent(Result) = nil);
-end;
-
-function PartialCompare(const S1, S2 : string) : Boolean;
-var
- L : Integer;
-begin
- {and empty string matches nothing}
- Result := False;
- L := MinI(Length(S1), Length(S2));
- if L > 0 then
- Result := AnsiUpperCase(Copy(S1, 1, L)) = AnsiUpperCase(Copy(S2, 1, L));
-end;
-
-function PathEllipsis(const S : string; MaxWidth : Integer) : string;
- { PathEllipsis function. Trims a path down to the }
- { specified number of pixels. For example, }
- { 'd:\program files\my stuff\some long document.txt' }
- { becomes 'd:\...\some long...' or a variation thereof }
- { depending on the value of MaxWidth. }
-var
- R : TRect;
- BM : TBitmap;
- NCM : TNonClientMetrics;
-begin
- if MaxWidth = 0 then begin
- Result := S;
- Exit;
- end;
- NCM.cbSize := SizeOf(NCM);
- SystemParametersInfo(
- SPI_GETNONCLIENTMETRICS, NCM.cbSize, @NCM, 0);
- BM := TBitmap.Create;
- try
- BM.Canvas.Font.Handle := CreateFontIndirect(NCM.lfMenuFont);
- if BM.Canvas.TextWidth(S) < MaxWidth then begin
- Result := S;
- Exit;
- end;
- Result := ExtractFilePath(S);
- Delete(Result, Length(Result), 1);
- while BM.Canvas.TextWidth(Result + '\...\' + ExtractFileName(S)) > MaxWidth do begin
- { Start trimming the path, working backwards }
- Result := ExtractFilePath(Result);
- Delete(Result, Length(Result), 1);
- { Only drive letter left so break out of loop. }
- if Length(Result) = 2 then
- Break;
- end;
- { Add the filename back onto the modified path. }
- Result := Result + '\...\' + ExtractFileName(S);
- { Still too long? }
- if BM.Canvas.TextWidth(Result) > MaxWidth then begin
- R := Rect(0, 0, MaxWidth, 0);
- DrawText(BM.Canvas.Handle, PChar(Result), -1,
- R, DT_SINGLELINE or DT_END_ELLIPSIS or DT_MODIFYSTRING or DT_CALCRECT);
- end;
- finally
- BM.Free;
- end;
-end;
-
-function CreateDisabledBitmap(FOriginal : TBitmap; OutlineColor : TColor) : TBitmap;
- {-create TBitmap object with disabled glyph}
-const
- ROP_DSPDxax = $00E20746;
-var
- MonoBmp : TBitmap;
- IRect : TRect;
-begin
- IRect := Rect(0, 0, FOriginal.Width, FOriginal.Height);
- Result := TBitmap.Create;
- try
- Result.Width := FOriginal.Width;
- Result.Height := FOriginal.Height;
- MonoBmp := TBitmap.Create;
- try
- with MonoBmp do begin
- Assign(FOriginal);
- HandleType := bmDDB;
- Canvas.Brush.Color := OutlineColor;
- if Monochrome then begin
- Canvas.Font.Color := clWhite;
- Monochrome := False;
- Canvas.Brush.Color := clWhite;
- end;
- Monochrome := True;
- end;
- with Result.Canvas do begin
- Brush.Color := clBtnFace;
- FillRect(IRect);
- Brush.Color := clBtnHighlight;
- SetTextColor(Handle, clBlack);
- SetBkColor(Handle, clWhite);
- BitBlt(Handle, 1, 1, WidthOf(IRect), HeightOf(IRect),
- MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
- Brush.Color := clBtnShadow;
- SetTextColor(Handle, clBlack);
- SetBkColor(Handle, clWhite);
- BitBlt(Handle, 0, 0, WidthOf(IRect), HeightOf(IRect),
- MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
- end;
- finally
- MonoBmp.Free;
- end;
- except
- Result.Free;
- raise;
- end;
-end;
-
-type
- TParentControl = class(TWinControl);
-
-procedure CopyParentImage(Control : TControl; Dest : TCanvas);
-var
- I : Integer;
- Count : Integer;
- X, Y : Integer;
- OldDC : Integer;
- DC : hDC;
- R : TRect;
- SelfR : TRect;
- CtlR : TRect;
-begin
- if Control.Parent = nil then
- Exit;
-
- Count := Control.Parent.ControlCount;
- DC := Dest.Handle;
- SelfR := Bounds(Control.Left, Control.Top, Control.Width, Control.Height);
- X := -Control.Left; Y := -Control.Top;
-
- {copy parent control image}
- OldDC := SaveDC(DC);
- SetViewportOrgEx(DC, X, Y, nil);
- IntersectClipRect(DC, 0, 0, Control.Parent.ClientWidth, Control.Parent.ClientHeight);
- TParentControl(Control.Parent).PaintWindow(DC);
- RestoreDC(DC, OldDC);
-
- {copy images of graphic controls}
- for I := 0 to Count - 1 do begin
- if (Control.Parent.Controls[I] <> nil) and
- not (Control.Parent.Controls[I] is TWinControl) then begin
- if Control.Parent.Controls[I] = Control then
- Break;
- with Control.Parent.Controls[I] do begin
- CtlR := Bounds(Left, Top, Width, Height);
- if Bool(IntersectRect(R, SelfR, CtlR)) and Visible then begin
- OldDC := SaveDC(DC);
- SetViewportOrgEx(DC, Left + X, Top + Y, nil);
- IntersectClipRect(DC, 0, 0, Width, Height);
- Perform(WM_PAINT, DC, 0);
- RestoreDC(DC, OldDC);
- end;
- end;
- end;
- end;
-end;
-
-{ - Hdc changed to TOvcHdc for BCB Compatibility }
-procedure DrawTransparentBitmapPrim(DC : TOvcHdc{HDC}; Bitmap : HBitmap;
- xStart, yStart, Width, Height : Integer; Rect : TRect;
- TransparentColor : TColorRef);
- {-draw transparent bitmap}
-var
-{$IFNDEF LCL}
- BM : Windows.TBitmap;
-{$ELSE}
- BM : LclType.tagBITMAP;
-{$ENDIF}
- cColor : TColorRef;
- bmAndBack : hBitmap;
- bmAndObject : hBitmap;
- bmAndMem : hBitmap;
- bmSave : hBitmap;
- bmBackOld : hBitmap;
- bmObjectOld : hBitmap;
- bmMemOld : hBitmap;
- bmSaveOld : hBitmap;
- hdcMem : hDC;
- hdcBack : hDC;
- hdcObject : hDC;
- hdcTemp : hDC;
- hdcSave : hDC;
- ptSize : TPoint;
- ptRealSize : TPoint;
- ptBitSize : TPoint;
- ptOrigin : TPoint;
-begin
- hdcTemp := CreateCompatibleDC(DC);
- SelectObject(hdcTemp, Bitmap);
- GetObject(Bitmap, SizeOf(BM), @BM);
- ptRealSize.x := MinL(Rect.Right - Rect.Left, BM.bmWidth - Rect.Left);
- ptRealSize.y := MinL(Rect.Bottom - Rect.Top, BM.bmHeight - Rect.Top);
- DPtoLP(hdcTemp, ptRealSize, 1);
- ptOrigin.x := Rect.Left;
- ptOrigin.y := Rect.Top;
-
- {convert from device to logical points}
- DPtoLP(hdcTemp, ptOrigin, 1);
- {get width of bitmap}
- ptBitSize.x := BM.bmWidth;
- {get height of bitmap}
- ptBitSize.y := BM.bmHeight;
- DPtoLP(hdcTemp, ptBitSize, 1);
-
- if (ptRealSize.x = 0) or (ptRealSize.y = 0) then begin
- ptSize := ptBitSize;
- ptRealSize := ptSize;
- end else
- ptSize := ptRealSize;
- if (Width = 0) or (Height = 0) then begin
- Width := ptSize.x;
- Height := ptSize.y;
- end;
-
- {create DCs to hold temporary data}
- hdcBack := CreateCompatibleDC(DC);
- hdcObject := CreateCompatibleDC(DC);
- hdcMem := CreateCompatibleDC(DC);
- hdcSave := CreateCompatibleDC(DC);
- {create a bitmap for each DC}
- {monochrome DC}
- bmAndBack := CreateBitmap(ptSize.x, ptSize.y, 1, 1, nil);
- bmAndObject := CreateBitmap(ptSize.x, ptSize.y, 1, 1, nil);
- bmAndMem := CreateCompatibleBitmap(DC, MaxL(ptSize.x, Width), MaxL(ptSize.y, Height));
- bmSave := CreateCompatibleBitmap(DC, ptBitSize.x, ptBitSize.y);
- {select a bitmap object to store pixel data}
- bmBackOld := SelectObject(hdcBack, bmAndBack);
- bmObjectOld := SelectObject(hdcObject, bmAndObject);
- bmMemOld := SelectObject(hdcMem, bmAndMem);
- bmSaveOld := SelectObject(hdcSave, bmSave);
-
- SetMapMode(hdcTemp, GetMapMode(DC));
-
- {save the bitmap sent here, it will be overwritten}
- BitBlt(hdcSave, 0, 0, ptBitSize.x, ptBitSize.y, hdcTemp, 0, 0, SRCCOPY);
-
- {set the background color of the source DC to the color,}
- {contained in the parts of the bitmap that should be transparent}
- cColor := SetBkColor(hdcTemp, TransparentColor);
-
- {create the object mask for the bitmap by performing a BitBlt()}
- {from the source bitmap to a monochrome bitmap}
- BitBlt(hdcObject, 0, 0, ptSize.x, ptSize.y, hdcTemp, ptOrigin.x, ptOrigin.y, SRCCOPY);
-
- {set the background color of the source DC back to the original color}
- SetBkColor(hdcTemp, cColor);
-
- {create the inverse of the object mask}
- BitBlt(hdcBack, 0, 0, ptSize.x, ptSize.y, hdcObject, 0, 0, NOTSRCCOPY);
-
- {copy the background of the main DC to the destination}
- BitBlt(hdcMem, 0, 0, Width, Height, DC, xStart, yStart, SRCCOPY);
-
- {mask out the places where the bitmap will be placed}
- StretchBlt(hdcMem, 0, 0, Width, Height, hdcObject, 0, 0, ptSize.x, ptSize.y, SRCAND);
-
- {mask out the transparent colored pixels on the bitmap}
- BitBlt(hdcTemp, ptOrigin.x, ptOrigin.y, ptSize.x, ptSize.y, hdcBack, 0, 0, SRCAND);
-
- {XOR the bitmap with the background on the destination DC}
- StretchBlt(hdcMem, 0, 0, Width, Height, hdcTemp, ptOrigin.x, ptOrigin.y, ptSize.x, ptSize.y, SRCPAINT);
-
- {copy the destination to the screen}
- BitBlt(DC, xStart, yStart, MaxL(ptRealSize.x, Width), MaxL(ptRealSize.y, Height), hdcMem, 0, 0, SRCCOPY);
-
- {place the original bitmap back into the bitmap sent}
- BitBlt(hdcTemp, 0, 0, ptBitSize.x, ptBitSize.y, hdcSave, 0, 0, SRCCOPY);
-
- {delete the memory bitmaps}
- DeleteObject(SelectObject(hdcBack, bmBackOld));
- DeleteObject(SelectObject(hdcObject, bmObjectOld));
- DeleteObject(SelectObject(hdcMem, bmMemOld));
- DeleteObject(SelectObject(hdcSave, bmSaveOld));
-
- {delete the memory DCs}
- DeleteDC(hdcMem);
- DeleteDC(hdcBack);
- DeleteDC(hdcObject);
- DeleteDC(hdcSave);
- DeleteDC(hdcTemp);
-end;
-
-procedure DrawTransparentBitmap(Dest : TCanvas; X, Y, W, H : Integer;
- Rect : TRect; Bitmap : TBitmap; TransparentColor : TColor);
-var
- MemImage : TBitmap;
- R : TRect;
-begin
- MemImage := TBitmap.Create;
- try
- R := Bounds(0, 0, Bitmap.Width, Bitmap.Height);
- if TransparentColor = clNone then begin
-
- if (WidthOf(Rect) <> 0) and (HeightOf(Rect) <> 0) then
- R := Rect;
- MemImage.Width := WidthOf(R);
- MemImage.Height := HeightOf(R);
- MemImage.Canvas.CopyRect(Bounds(0, 0, MemImage.Width, MemImage.Height),
- Bitmap.Canvas, R);
-
- if (W = 0) or (H = 0) then
- Dest.Draw(X, Y, MemImage)
- else
- Dest.StretchDraw(Bounds(X, Y, W, H), MemImage);
-
- end else begin
- MemImage.Width := WidthOf(R);
- MemImage.Height := HeightOf(R);
- MemImage.Canvas.CopyRect(R, Bitmap.Canvas, R);
- if TransparentColor = clDefault then
- TransparentColor := MemImage.Canvas.Pixels[0, MemImage.Height - 1];
- DrawTransparentBitmapPrim(Dest.Handle, MemImage.Handle, X, Y, W, H,
- Rect, ColorToRGB(TransparentColor and not $02000000));
- end;
- finally
- MemImage.Free;
- end;
-end;
-
-
-function WidthOf(const R : TRect) : Integer;
-begin
- Result := R.Right - R.Left;
-end;
-
-function HeightOf(const R : TRect) : Integer;
-begin
- Result := R.Bottom - R.Top;
-end;
-
-procedure DebugOutput(const S : string);
-begin
- OutputDebugString(PChar(S));
- OutputDebugString(#13#10);
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovcnf.pas b/Source/3rdParty/Orpheus/ovcnf.pas
deleted file mode 100644
index c84b904b..00000000
--- a/Source/3rdParty/Orpheus/ovcnf.pas
+++ /dev/null
@@ -1,1808 +0,0 @@
-{*********************************************************}
-{* OVCNF.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 ovcnf;
- {-Numeric field visual component}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Classes, Controls, Forms, Graphics, Menus, SysUtils,
- OvcBase, OvcCaret, OvcColor, OvcConst, OvcData, OvcEF, OvcExcpt,
- OvcMisc, OvcPB, OvcStr;
-
-type
- {numeric field types}
- TNumericDataType = (
- nftLongInt, nftWord, nftInteger, nftByte, nftShortInt, nftReal,
- nftExtended, nftDouble, nftSingle, nftComp);
-
-type
- TOvcCustomNumericField = class(TOvcPictureBase)
- {.Z+}
- protected {private}
- {property instance variables}
- FNumericDataType : TNumericDataType;
- FPictureMask : string;
-
- {private instance variables}
- nfMaxLen : Word; {maximum length of numeric string}
- nfMaxDigits : Word; {maximum # of digits to left of decimal}
- nfPlaces : Word; {# of decimal places}
- nfMinus : Boolean; {true if number is negative}
- nfTmp : TEditString; {temporary input string}
-
- function nfGetDataType(Value : TNumericDataType) : Byte;
- {-return a Byte value representing the data type of this field}
- procedure nfReloadTmp;
- {-reload Tmp from efEditSt, etc.}
- procedure nfResetFieldProperties(FT : TNumericDataType);
- {-reset field properties}
- procedure nfSetDefaultRanges;
- {-set default range values based on the field type}
- procedure nfSetMaxLength(Mask : PAnsiChar);
- {-determine and set MaxLength}
-
- procedure WMSetFocus(var Msg : TWMSetFocus);
- message WM_SETFOCUS;
- procedure WMKillFocus(var Msg : TWMKillFocus);
- message WM_KILLFOCUS;
-
- protected
- {VCL methods}
- procedure CreateParams(var Params : TCreateParams);
- override;
- procedure CreateWnd;
- override;
-
- procedure efCaretToEnd;
- override;
- {-move the caret to the end of the field}
- procedure efCaretToStart;
- override;
- {-move the caret to the beginning of the field}
- procedure efChangeMask(Mask : PAnsiChar);
- override;
- {-change the picture mask}
- procedure efEdit(var Msg : TMessage; Cmd : Word);
- override;
- {-process the specified editing command}
- function efGetDisplayString(Dest : PAnsiChar; Size : Word) : PAnsiChar;
- override;
- {-return the display string in Dest and a pointer as the result}
- procedure efIncDecValue(Wrap : Boolean; Delta : Double);
- override;
- {-increment field by Delta}
- function efTransfer(DataPtr : Pointer; TransferFlag : Word) : Word;
- override;
- {-transfer data to/from the entry fields}
- procedure pbRemoveSemiLits;
- override;
- {-remove semi-literal mask characters from the edit string}
-
- {virtual property methods}
- procedure efSetCaretPos(Value : Integer);
- override;
- {-set position of caret within the field}
- procedure nfSetDataType(Value : TNumericDataType);
- virtual;
- {-set the data type for this field}
- procedure nfSetPictureMask(const Value : string);
- virtual;
- {-set the picture mask}
-
- public
- procedure Assign(Source : TPersistent);
- override;
- constructor Create(AOwner: TComponent);
- override;
-
- function efValidateField : Word;
- override;
- {-validate contents of field; result is error code or 0}
- {.Z-}
-
- {public properties}
- property DataType : TNumericDataType
- read FNumericDataType
- write nfSetDataType;
-
- property PictureMask : string
- read FPictureMask
- write nfSetPictureMask;
- end;
-
- TOvcNumericField = class(TOvcCustomNumericField)
- published
- {inherited properties}
- property DataType; {needs to loaded before most other properties}
- {$IFDEF VERSION4}
- property Anchors;
- property Constraints;
- property DragKind;
- {$ENDIF}
- property AutoSize;
- property BorderStyle;
- property CaretIns;
- property CaretOvr;
- property Color;
- property Controller;
- property Ctl3D;
- property Borders;
- property DragCursor;
- property DragMode;
- property EFColors;
- property Enabled;
- property Font;
- property LabelInfo;
- property Options;
- property PadChar;
- property ParentColor;
- property ParentCtl3D;
- property ParentFont;
- property ParentShowHint;
- property PictureMask;
- property PopupMenu;
- property RangeHi stored False;
- property RangeLo stored False;
- property ShowHint;
- property TabOrder;
- property TabStop default True;
- property Tag;
- property TextMargin;
- property Uninitialized;
- property Visible;
- property ZeroDisplay;
- property ZeroDisplayValue;
-
- {inherited events}
- property AfterEnter;
- property AfterExit;
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnError;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnMouseWheel;
- property OnStartDrag;
- property OnUserCommand;
- property OnUserValidation;
- end;
-
-
-implementation
-
-
-{*** TOvcCustomNumericField ***}
-
-procedure TOvcCustomNumericField.Assign(Source : TPersistent);
-var
- NF : TOvcCustomNumericField absolute Source;
-begin
- if (Source <> nil) and (Source is TOvcCustomNumericField) then begin
- DataType := NF.DataType;
- AutoSize := NF.AutoSize;
- BorderStyle := NF.BorderStyle;
- Color := NF.Color;
- EFColors.Error.Assign(NF.EFColors.Error);
- EFColors.Highlight.Assign(NF.EFColors.Highlight);
- Options := NF.Options;
- PadChar := NF.PadChar;
- PictureMask := NF.PictureMask;
- RangeHi := NF.RangeHi;
- RangeLo := NF.RangeLo;
- TextMargin := NF.TextMargin;
- Uninitialized := NF.Uninitialized;
- ZeroDisplay := NF.ZeroDisplay;
- ZeroDisplayValue := NF.ZeroDisplayValue;
- end else
- inherited Assign(Source);
-end;
-
-constructor TOvcCustomNumericField.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
-
- FNumericDataType := nftLongInt;
- FPictureMask := 'iiiiiiiiiii';
- efFieldClass := fcNumeric;
- efDataType := nfGetDataType(FNumericDataType);
- efRangeHi.rtLong := High(LongInt);
- efRangeLo.rtLong := Low(LongInt);
-end;
-
-procedure TOvcCustomNumericField.CreateParams(var Params: TCreateParams);
-begin
- inherited CreateParams(Params);
-
- pfSelPos := 0;
-
- {get current picture string}
- StrPLCopy(efPicture, FPictureMask, MaxPicture);
-
- {set MaxLength based on picture mask}
- nfSetMaxLength(efPicture);
-
- FillChar(nfTmp, SizeOf(nfTmp), #0);
- pfSemiLits := 0;
- pbCalcWidthAndPlaces(nfMaxLen, nfPlaces);
-
- {adjust max length for decimal point if needed}
- nfMaxDigits := nfMaxLen;
- if nfPlaces <> 0 then
- Dec(nfMaxDigits, nfPlaces+1);
-end;
-
-procedure TOvcCustomNumericField.CreateWnd;
-var
- P : array[0..MaxEditLen+1] of Byte;
-begin
- {save field data}
- if efSaveData then
- efTransfer(@P, otf_GetData);
-
- inherited CreateWnd;
-
- {try to optimize InitPictureFlags}
- pbOptimizeInitPictureFlags;
-
- pfSemiLits := 0;
- nfSetDefaultRanges;
- efSetInitialValue;
-
- {if we saved the field data, restore it}
- if efSaveData then
- efTransfer(@P, otf_SetData);
-
- {set save data flag}
- efSaveData := True;
-end;
-
-procedure TOvcCustomNumericField.efCaretToEnd;
- {-move the caret to the end of the field}
-begin
- efHPos := efEditEnd + 1;
-end;
-
-procedure TOvcCustomNumericField.efCaretToStart;
- {-move the caret to the beginning of the field}
-begin
- efHPos := efEditEnd + 1;
-end;
-
-procedure TOvcCustomNumericField.efChangeMask(Mask : PAnsiChar);
- {-change the picture mask}
-begin
- inherited efChangeMask(Mask);
-
- pfSemiLits := 0;
- pbCalcWidthAndPlaces(nfMaxLen, nfPlaces);
-
- {set MaxLength based on picture mask}
- nfSetMaxLength(Mask);
- nfMaxDigits := nfMaxLen;
- if nfPlaces <> 0 then
- Dec(nfMaxDigits, nfPlaces+1);
-end;
-
-procedure TOvcCustomNumericField.efEdit(var Msg : TMessage; Cmd : Word);
- {-process the specified editing command}
-label
- ExitPoint;
-var
- MF : Byte;
- Ch : AnsiChar;
- HaveSel : Boolean;
- PicChar : AnsiChar;
- StLen : Word;
- StBgn : Word;
- StEnd : Word;
- DotPos : Cardinal;
- Found : Boolean;
-
- function MinusVal : Byte;
- begin
- if nfMinus then
- Result := 1
- else
- Result := 0;
- end;
-
- procedure ClearString;
- {-clear the string being edited}
- begin
- nfTmp[0] := #0;
- nfMinus := False;
- StLen := 0;
- end;
-
- function CharIsOK : Boolean;
- {-return true if Ch can be added to the string}
- begin
- Result := (Ch >= ' ');
- end;
-
- function CheckAutoAdvance(SP : Integer) : Boolean;
- {-see if we need to auto-advance to next/previous field}
- begin
- Result := False;
- if (SP < 0) and
- (efoAutoAdvanceLeftRight in Controller.EntryOptions) then begin
- efMoveFocusToPrevField;
- Result := True;
- end else if (SP > 0) then
- if (Cmd = ccChar) and
- (efoAutoAdvanceChar in Controller.EntryOptions) then begin
- efMoveFocusToNextField;
- Result := True;
- end else if (Cmd <> ccChar) and
- (efoAutoAdvanceLeftRight in Controller.EntryOptions) then begin
- efMoveFocusToNextField;
- Result := True;
- end;
- end;
-
- procedure DeleteChar;
- {-delete char at end of string}
- begin
- if (StLen = 0) then
- if not nfMinus then
- Exit
- else
- nfMinus := False
- else begin
- {remove the last character}
- nfTmp[StLen-1] := #0;
- Dec(StLen);
-
- {if all that's left is a 0, remove it}
- if (StLen = 1) and (nfTmp[0] = '0') then
- nfTmp[0] := #0;
- end;
- MF := 10;
- end;
-
- procedure DeleteSel;
- begin
- ClearString;
- efSelStart := 0;
- efSelEnd := 0;
- MF := 10;
- end;
-
- function InsertChar : Boolean;
- {-insert Ch}
- var
- tDotPos : Cardinal;
- tFound : Boolean;
-
- function DigitCount : Word;
- {-return number of digits to left of decimal place in St}
- begin
- if tFound then
- Result := tDotPos + MinusVal
- else
- Result := StLen + MinusVal;
- end;
-
- begin
- Result := False;
-
- {reject spaces}
- if (Ch = ' ') then
- Exit;
-
- {ok to add decimal point?}
- tFound := StrChPos(nfTmp, pmDecimalPt, tDotPos);
- if (Ch = pmDecimalPt) then
- if not Found or tFound then
- Exit;
-
- if (Ch = '-') then begin
- {minus sign treated as toggle}
- if nfMinus then
- nfMinus := False
- else begin
- nfMinus := (DigitCount < nfMaxDigits) and (StLen < nfMaxLen);
- if not nfMinus then
- Exit;
- end
- end else if (StLen+MinusVal < nfMaxLen) then begin
- {don't allow initial zeros}
- if (Ch = '0') and (StLen = 0) then begin
- Result := True;
- Exit;
- end;
-
- {check for too many digits to left of decimal point}
- if Found and (Ch <> pmDecimalPt) then
- if not tFound and (DigitCount >= nfMaxDigits) then
- Exit;
-
- {append the character}
- nfTmp[StLen] := Ch;
- Inc(StLen);
- nfTmp[StLen] := #0;
- end else if (nfMaxLen = 1) then
- if (Ch = pmDecimalPt) then
- Exit
- else
- {overwrite the character}
- nfTmp[0] := Ch
- else
- Exit;
-
- Result := True;
- end;
-
- procedure Adjust;
- {-adjust display string to show correct number of decimal places}
- var
- Delta : Integer;
- ActPlaces : Integer;
- DP : Cardinal;
- Len : Word;
- ExDec : TEditString;
- begin
- Len := StrLen(nfTmp);
- if not StrChPos(nfTmp, pmDecimalPt, DP) then
- Delta := nfPlaces+1
- else begin
- ActPlaces := Len-Succ(DP);
- Delta := nfPlaces-ActPlaces;
- end;
-
- if Delta = 0 then
- Exit;
-
- if Delta > 0 then begin
- StrStDeletePrim(efEditSt, StEnd-Pred(Delta), Delta);
- StrStInsertPrim(efEditSt, CharStrPChar(ExDec, ' ', Delta), StBgn);
- end else begin
- Delta := -Delta;
- StrStCopy(ExDec, nfTmp, DP+nfPlaces+1, Delta);
- StrStDeletePrim(efEditSt, StBgn, Delta);
- StrStInsertPrim(efEditSt, ExDec, StEnd-Pred(Delta));
- end;
- end;
-
- procedure UpdateEditSt;
- {-update efEditSt}
- begin
- StrCopy(efEditSt, nfTmp);
- case efEditSt[0] of
- #0 :
- begin
- {string is empty, put in a 0}
- efEditSt[0] := '0';
- efEditSt[1] := #0;
- end;
- '.' :
- StrChInsertPrim(efEditSt, '0', 0);
- end;
-
- {prepend the minus sign}
- if nfMinus then
- StrChInsertPrim(efEditSt, '-', 0);
-
- pbMergePicture(efEditSt, efEditSt);
- if Found then
- Adjust;
- end;
-
- procedure UpdateSel(Delta : Integer);
- begin
- if Delta <> 0 then begin
- efSelStart := 0;
- efSelEnd := MaxEditLen;
- end else begin
- efSelStart := 0;
- efSelEnd := 0;
- end;
- end;
-
- procedure PastePrim(P : PAnsiChar);
- begin
- if HaveSel then
- DeleteSel;
- while P^ <> #0 do begin
- Ch := P^;
- if (Ch = '(') then
- if StrScan(efPicture, pmNegParens) <> nil then
- if StrScan(P, ')') <> nil then
- Ch := '-';
- if (Ch <> '-') or not nfMinus then
- if (StLen+MinusVal <= nfMaxLen) then begin
- if Ch = IntlSupport.DecimalChar then
- Ch := pmDecimalPt
- else if Ch = pmDecimalPt then
- Ch := #0;
- if efCharOK(PicChar, Ch, #255, True) then
- if InsertChar then
- MF := 10
- end;
- Inc(P);
- end;
- end;
-
-begin {edit}
- HaveSel := efSelStart <> efSelEnd;
- MF := Ord(HaveSel);
-
- case Cmd of
- ccAccept : ;
- else
- if not (sefFixSemiLits in sefOptions) then
- pbRemoveSemiLits;
-
- Exclude(sefOptions, sefLiteral);
- end;
-
- StBgn := efEditBegin;
- StEnd := efEditEnd;
- StLen := StrLen(nfTmp);
- PicChar := efNthMaskChar(efHPos-1);
- Found := StrChPos(efPicture, pmDecimalPt, DotPos);
-
- Exclude(sefOptions, sefCharOK);
- case Cmd of
- ccChar :
- begin
- Ch := AnsiChar(Lo(Msg.wParam));
- if not (sefAcceptChar in sefOptions) then
- Exit
- else begin
- Exclude(sefOptions, sefAcceptChar);
- if HaveSel and CharIsOk then
- DeleteSel;
- if StLen+MinusVal <= nfMaxLen then begin
- if Ch = IntlSupport.DecimalChar then
- Ch := pmDecimalPt
- else if Ch = pmDecimalPt then
- Ch := #0;
- if not efCharOK(PicChar, Ch, #255, True) then
- efConditionalBeep
- else begin
- if InsertChar then begin
- if (Ch <> '-') and (StLen+MinusVal = nfMaxLen) then
- CheckAutoAdvance(1);
- MF := 10;
- end else
- efConditionalBeep;
- end;
- end else if not CheckAutoAdvance(1) then
- efConditionalBeep;
- end;
- end;
- ccLeft, ccWordLeft :
- CheckAutoAdvance(-1);
- ccRight, ccWordRight :
- CheckAutoAdvance(1);
- ccUp :
- if (efoAutoAdvanceUpDown in Controller.EntryOptions) then
- efMoveFocusToPrevField
- else if (efoArrowIncDec in Options) and
- not (efoReadOnly in Options) then
- IncreaseValue(True, 1)
- else
- CheckAutoAdvance(-1);
- ccDown :
- if (efoAutoAdvanceUpDown in Controller.EntryOptions) then
- efMoveFocusToNextField
- else if (efoArrowIncDec in Options) and not (efoReadOnly in Options) then
- DecreaseValue(True, 1)
- else
- CheckAutoAdvance(1);
- ccMouse :
- begin
- efSelStart := 0;
- efSelEnd := 0;
- end;
- ccDblClk :
- SetSelection(0, MaxEditLen);
- ccHome, ccEnd : {do nothing};
- ccBack, ccDel :
- if HaveSel then
- DeleteSel
- else
- DeleteChar;
- ccDelWord :
- if HaveSel then
- DeleteSel;
- ccExtendLeft :
- UpdateSel(-1);
- ccExtendRight :
- UpdateSel(+1);
- ccExtWordLeft, ccExtendHome :
- UpdateSel(-MaxEditLen);
- ccExtWordRight, ccExtendEnd :
- UpdateSel(+MaxEditLen);
- ccCut :
- if HaveSel then
- DeleteSel;
- ccCopy : efCopyPrim;
- ccPaste :
- {for some reason, a paste action within the IDE}
- {gets passed to the control. filter it out}
- if not (csDesigning in ComponentState) then
- PastePrim(PAnsiChar(Msg.lParam));
- ccDelLine :
- begin
- ClearString;
- MF := 10;
- end;
- ccIns :
- begin
- if sefInsert in sefOptions then
- Exclude(sefOptions, sefInsert)
- else
- Include(sefOptions, sefInsert);
- efCaret.InsertMode := (sefInsert in sefOptions);
- end;
- ccRestore :
- begin
- Restore;
- nfReloadTmp;
- end;
- ccAccept :
- begin
- Include(sefOptions, sefCharOK);
- Include(sefOptions, sefAcceptChar);
- Exit;
- end;
- ccCtrlChar : {};
- ccDec :
- DecreaseValue(True, 1);
- ccInc :
- IncreaseValue(True, 1);
- ccSuppress, ccPartial :
- goto ExitPoint;
- else
- Include(sefOptions, sefCharOK);
- end;
- Exclude(sefOptions, sefAcceptChar);
-
- case Cmd of
- ccMouse : {};
- ccRestore, ccDblClk,
- ccExtendLeft, ccExtendRight, ccExtendEnd,
- ccExtendHome, ccExtWordLeft, ccExtWordRight :
- Inc(MF);
- ccCut, ccCopy, ccPaste : {};
- else
- efSelStart := efHPos;
- efSelEnd := efHPos;
- end;
-
-
-ExitPoint:
- if MF >= 10 then begin
- UpdateEditSt;
- efFieldModified;
- end;
- if efPositionCaret(True) then
- Inc(MF);
- if MF > 0 then
- Invalidate;
-end;
-
-function TOvcCustomNumericField.efGetDisplayString(Dest : PAnsiChar; Size : Word) : PAnsiChar;
- {-return the display string in Dest and a pointer as the result}
-var
- I, J : Cardinal;
- Found : Boolean;
-begin
- Result := inherited efGetDisplayString(Dest, Size);
-
- if Uninitialized and not (sefHaveFocus in sefOptions) then
- Exit;
-
- Found := StrChPos(Dest, '-', I);
- if StrChPos(efPicture, pmNegParens, J) then
- if not Found then
- Dest[J] := ' '
- else begin
- Dest[I] := '(';
- Dest[J] := ')';
- end;
-
- if StrChPos(efPicture, pmNegHere, J) then
- if not Found then
- Dest[J] := ' '
- else begin
- Dest[J] := '-';
- J := efEditBegin;
- if J = I then
- Dest[I] := ' '
- else begin
- StrChDeletePrim(Dest, I);
- StrChInsertPrim(Dest, ' ', J);
- end;
- end;
-
- TrimAllSpacesPChar(Dest);
-end;
-
-procedure TOvcCustomNumericField.efIncDecValue(Wrap : Boolean; Delta : Double);
- {-increment field by Delta}
-var
- Code : Integer;
-
- procedure IncDecValueLongInt;
- var
- L : LongInt;
- S : TEditString;
- begin
- pbStripPicture(S, efEditSt);
-
- if efStr2Long(S, L) then begin
- if (Delta < 0) and (L <= efRangeLo.rtLong) then
- if Wrap then
- L := efRangeHi.rtLong
- else
- Exit
- else if (Delta > 0) and (L >= efRangeHi.rtLong) then
- if Wrap then
- L := efRangeLo.rtLong
- else
- Exit
- else
- Inc(L, Trunc(Delta));
-
- {insure valid value}
- if L < efRangeLo.rtLong then
- L := efRangeLo.rtLong;
- if L > efRangeHi.rtLong then
- L := efRangeHi.rtLong;
-
- efTransfer(@L, otf_SetData);
- nfReloadTmp;
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueReal;
- var
- Re : Real;
- S : TEditString;
- begin
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Re, Code);
-{$ELSE}
- Val(string(S), Re, Code);
-{$ENDIF}
-
- if Code = 0 then begin
- if (Delta < 0) and (Re <= efRangeLo.rtReal) then
- if Wrap then
- Re := efRangeHi.rtReal
- else
- Exit
- else if (Delta > 0) and (Re >= efRangeHi.rtReal) then
- if Wrap then
- Re := efRangeLo.rtReal
- else
- Exit
- else
- Re := Re + Delta;
-
- {insure valid value}
- if Re < efRangeLo.rtReal then
- Re := efRangeLo.rtReal;
- if Re > efRangeHi.rtReal then
- Re := efRangeHi.rtReal;
-
- efTransfer(@Re, otf_SetData);
- nfReloadTmp;
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueExtended;
- var
- Ex : Extended;
- S : TEditString;
- begin
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Ex, Code);
-{$ELSE}
- Val(string(S), Ex, Code);
-{$ENDIF}
-
- if Code = 0 then begin
- if (Delta < 0) and (Ex <= efRangeLo.rtExt) then
- if Wrap then
- Ex := efRangeHi.rtExt
- else
- Exit
- else if (Delta > 0) and (Ex >= efRangeHi.rtExt) then
- if Wrap then
- Ex := efRangeLo.rtExt
- else
- Exit
- else
- Ex := Ex + Delta;
-
- {insure valid value}
- if Ex < efRangeLo.rtExt then
- Ex := efRangeLo.rtExt;
- if Ex > efRangeHi.rtExt then
- Ex := efRangeHi.rtExt;
-
- efTransfer(@Ex, otf_SetData);
- nfReloadTmp;
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueDouble;
- var
- Db : Double;
- S : TEditString;
- begin
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Db, Code);
-{$ELSE}
- Val(string(S), Db, Code);
-{$ENDIF}
-
- if Code = 0 then begin
- if (Delta < 0) and (Db <= efRangeLo.rtExt) then
- if Wrap then
- Db := efRangeHi.rtExt
- else
- Exit
- else if (Delta > 0) and (Db >= efRangeHi.rtExt) then
- if Wrap then
- Db := efRangeLo.rtExt
- else
- Exit
- else
- Db := Db + Delta;
-
- {insure valid value}
- if Db < efRangeLo.rtExt then
- Db := efRangeLo.rtExt;
- if Db > efRangeHi.rtExt then
- Db := efRangeHi.rtExt;
-
- efTransfer(@Db, otf_SetData);
- nfReloadTmp;
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueSingle;
- var
- Si : Single;
- S : TEditString;
- begin
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Si, Code);
-{$ELSE}
- Val(string(S), Si, Code);
-{$ENDIF}
-
- if Code = 0 then begin
- if (Delta < 0) and (Si <= efRangeLo.rtExt) then
- if Wrap then
- Si := efRangeHi.rtExt
- else
- Exit
- else if (Delta > 0) and (Si >= efRangeHi.rtExt) then
- if Wrap then
- Si := efRangeLo.rtExt
- else
- Exit
- else
- Si := Si + Delta;
-
- {insure valid value}
- if Si < efRangeLo.rtExt then
- Si := efRangeLo.rtExt;
- if Si > efRangeHi.rtExt then
- Si := efRangeHi.rtExt;
-
- efTransfer(@Si, otf_SetData);
- nfReloadTmp;
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueComp;
- var
-{$IFNDEF FPC}
- Co : Comp;
-{$ELSE}
- {$IFDEF CPU86}
- Co : Comp;
- {$ELSE}
- Co : Double;
- {$ENDIF}
-{$ENDIF}
- S : TEditString;
- begin
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Co, Code);
-{$ELSE}
- Val(string(S), Co, Code);
-{$ENDIF}
-
- if Code = 0 then begin
- if (Delta < 0) and (Co <= efRangeLo.rtExt) then
- if Wrap then
- Co := efRangeHi.rtExt
- else
- Exit
- else if (Delta > 0) and (Co >= efRangeHi.rtExt) then
- if Wrap then
- Co := efRangeLo.rtExt
- else
- Exit
- else
- Co := Co + Delta;
-
- {insure valid value}
- if Co < efRangeLo.rtExt then
- Co := efRangeLo.rtExt;
- if Co > efRangeHi.rtExt then
- Co := efRangeHi.rtExt;
-
- efTransfer(@Co, otf_SetData);
- nfReloadTmp;
- efPerformRepaint(True);
- end;
- end;
-
-begin
- if not (sefHaveFocus in sefOptions) then
- Exit;
-
- case FNumericDataType of
- nftLongInt,
- nftWord,
- nftInteger,
- nftByte,
- nftShortInt : IncDecValueLongInt;
- nftReal : IncDecValueReal;
- nftExtended : IncDecValueExtended;
- nftDouble : IncDecValueDouble;
- nftSingle : IncDecValueSingle;
- nftComp : IncDecValueComp;
- end;
- efPositionCaret(False);
-end;
-
-procedure TOvcCustomNumericField.efSetCaretPos(Value : Integer);
- {-set position of caret within the field}
-begin
- {do nothing}
-end;
-
-function TOvcCustomNumericField.efTransfer(DataPtr : Pointer; TransferFlag : Word) : Word;
- {-transfer data to/from the entry fields}
-var
- E : Extended;
-
- procedure TransferLongInt;
- var
- S : TEditString;
- begin
- if TransferFlag = otf_GetData then begin
- pbStripPicture(S, efEditSt);
-
- if not efStr2Long(S, LongInt(DataPtr^)) then
- LongInt(DataPtr^) := 0;
- end else begin
- efLong2Str(S, LongInt(DataPtr^));
- pbMergePicture(efEditSt, S);
- end;
- end;
-
- procedure TransferWord;
- var
- L : LongInt;
- S : TEditString;
- begin
- if TransferFlag = otf_GetData then begin
- pbStripPicture(S, efEditSt);
-
- if efStr2Long(S, L) then
- Word(DataPtr^) := L
- else
- Word(DataPtr^) := 0;
- end else begin
- efLong2Str(S, Word(DataPtr^));
- pbMergePicture(efEditSt, S);
- end;
- end;
-
- procedure TransferInteger;
- var
- L : LongInt;
- S : TEditString;
- begin
- if TransferFlag = otf_GetData then begin
- pbStripPicture(S, efEditSt);
-
- if efStr2Long(S, L) then
- SmallInt(DataPtr^) := L
- else
- SmallInt(DataPtr^) := 0;
- end else begin
- efLong2Str(S, SmallInt(DataPtr^));
- pbMergePicture(efEditSt, S);
- end;
- end;
-
- procedure TransferByte;
- var
- L : LongInt;
- S : TEditString;
- begin
- if TransferFlag = otf_GetData then begin
- pbStripPicture(S, efEditSt);
-
- if efStr2Long(S, L) then
- Byte(DataPtr^) := L
- else
- Byte(DataPtr^) := 0;
- end else begin
- efLong2Str(S, Byte(DataPtr^));
- pbMergePicture(efEditSt, S);
- end;
- end;
-
- procedure TransferShortInt;
- var
- L : LongInt;
- S : TEditString;
- begin
- if TransferFlag = otf_GetData then begin
- pbStripPicture(S, efEditSt);
-
- if efStr2Long(S, L) then
- ShortInt(DataPtr^) := L
- else
- ShortInt(DataPtr^) := 0;
- end else begin
- efLong2Str(S, ShortInt(DataPtr^));
- pbMergePicture(efEditSt, S);
- end;
- end;
-
- procedure TransferReal;
- var
- Code : Integer;
- Places : Word;
- R : Real;
- S : TEditString;
- Width : Word;
- begin
- if TransferFlag = otf_GetData then begin
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, R, Code);
-{$ELSE}
- Val(string(S), R, Code);
-{$ENDIF}
-
- if Code <> 0 then
- R := 0;
- Real(DataPtr^) := R;
- end else begin
- pbCalcWidthAndPlaces(Width, Places);
- Str(Real(DataPtr^):Width:Places, S);
- if DecimalPlaces <> 0 then
- TrimTrailingZerosPChar(S)
- else
- TrimAllSpacesPChar(S);
- pbMergePicture(efEditSt, S);
- end;
- end;
-
- procedure TransferExtended;
- var
- Code : Integer;
- Places : Word;
- S : TEditString;
- Width : Word;
- begin
- if TransferFlag = otf_GetData then begin
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, E, Code);
-{$ELSE}
- Val(string(S), E, Code);
-{$ENDIF}
-
- if Code <> 0 then
- E := 0;
- Extended(DataPtr^) := E;
- end else begin
- pbCalcWidthAndPlaces(Width, Places);
- Str(Extended(DataPtr^):Width:Places, S);
- if DecimalPlaces <> 0 then
- TrimTrailingZerosPChar(S)
- else
- TrimAllSpacesPChar(S);
- pbMergePicture(efEditSt, S);
- end;
- end;
-
- procedure TransferDouble;
- var
- D : Double;
- Code : Integer;
- Places : Word;
- S : TEditString;
- Width : Word;
- begin
- if TransferFlag = otf_GetData then begin
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, D, Code);
-{$ELSE}
- Val(string(S), D, Code);
-{$ENDIF}
-
- if Code <> 0 then
- D := 0;
- Double(DataPtr^) := D;
- end else begin
- pbCalcWidthAndPlaces(Width, Places);
- Str(Double(DataPtr^):Width:Places, S);
- if DecimalPlaces <> 0 then
- TrimTrailingZerosPChar(S)
- else
- TrimAllSpacesPChar(S);
- pbMergePicture(efEditSt, S);
- end;
- end;
-
- procedure TransferSingle;
- var
- Code : Integer;
- G : Single;
- Places : Word;
- S : TEditString;
- Width : Word;
- begin
- if TransferFlag = otf_GetData then begin
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, G, Code);
-{$ELSE}
- Val(string(S), G, Code);
-{$ENDIF}
-
- if Code <> 0 then
- G := 0;
- Single(DataPtr^) := G;
- end else begin
- pbCalcWidthAndPlaces(Width, Places);
- Str(Single(DataPtr^):Width:Places, S);
- if DecimalPlaces <> 0 then
- TrimTrailingZerosPChar(S)
- else
- TrimAllSpacesPChar(S);
- pbMergePicture(efEditSt, S);
- end;
- end;
-
- procedure TransferComp;
- var
-{$IFNDEF FPC}
- C : Comp;
-{$ELSE}
- {$IFDEF CPU86}
- C : Comp;
- {$ELSE}
- C : Double;
- {$ENDIF}
-{$ENDIF}
- Code : Integer;
- Places : Word;
- S : TEditString;
- Width : Word;
- begin
- if TransferFlag = otf_GetData then begin
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, C, Code);
-{$ELSE}
- Val(string(S), C, Code);
-{$ENDIF}
-
- if Code <> 0 then
- C := 0;
-{$IFNDEF FPC}
- Comp(DataPtr^) := C;
-{$ELSE}
- {$IFDEF CPU86}
- Comp(DataPtr^) := C;
- {$ELSE}
- Double(DataPtr^) := C;
- {$ENDIF}
-{$ENDIF}
- end else begin
- pbCalcWidthAndPlaces(Width, Places);
-{$IFNDEF FPC}
- Str(Comp(DataPtr^):Width:Places, S);
-{$ELSE}
- {$IFDEF CPU86}
- Str(Comp(DataPtr^):Width:Places, S);
- {$ELSE}
- Str(Double(DataPtr^):Width:Places, S);
- {$ENDIF}
-{$ENDIF}
- if DecimalPlaces <> 0 then
- TrimTrailingZerosPChar(S)
- else
- TrimAllSpacesPChar(S);
- pbMergePicture(efEditSt, S);
- end;
- end;
-
-begin {transfer}
- if DataPtr = nil then begin
- Result := 0;
- Exit;
- end;
-
- case FNumericDataType of
- nftLongInt : TransferLongInt;
- nftWord : TransferWord;
- nftInteger : TransferInteger;
- nftByte : TransferByte;
- nftShortInt : TransferShortInt;
- nftReal : TransferReal;
- nftExtended : TransferExtended;
- nftDouble : TransferDouble;
- nftSingle : TransferSingle;
- nftComp : TransferComp;
- end;
- Result := inherited efTransfer(DataPtr, TransferFlag);
-end;
-
-function TOvcCustomNumericField.efValidateField : Word;
- {-validate contents of field; result is error code or 0}
-
- procedure ValidateLongInt;
- var
- L : LongInt;
- S : TEditString;
- begin
- pbStripPicture(S, efEditSt);
-
- if not efStr2Long(S, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- efTransfer(@L, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateWord;
- var
- L : LongInt;
- W : Word;
- S : TEditString;
- begin
- pbStripPicture(S, efEditSt);
-
- if not efStr2Long(S, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- W := L;
- efTransfer(@W, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateInteger;
- var
- L : LongInt;
- I : Integer;
- S : TEditString;
- begin
- pbStripPicture(S, efEditSt);
-
- if not efStr2Long(S, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- I := L;
- efTransfer(@I, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateByte;
- var
- L : LongInt;
- B : Byte;
- S : TEditString;
- begin
- pbStripPicture(S, efEditSt);
-
- if not efStr2Long(S, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- B := L;
- efTransfer(@B, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateShortInt;
- var
- L : LongInt;
- Si : Byte;
- S : TEditString;
- begin
- pbStripPicture(S, efEditSt);
-
- if not efStr2Long(S, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- Si := L;
- efTransfer(@Si, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateReal;
- var
- R : Real;
- Code : Integer;
- S : TEditString;
- begin
- {convert efEditSt to a real}
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, R, Code);
-{$ELSE}
- Val(string(S), R, Code);
-{$ENDIF}
-
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (R < efRangeLo.rtReal) or (R > efRangeHi.rtReal) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- efTransfer(@R, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateExtended;
- var
- E : Extended;
- Code : Integer;
- S : TEditString;
- begin
- {convert efEditSt to an extended}
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, E, Code);
-{$ELSE}
- Val(string(S), E, Code);
-{$ENDIF}
-
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (E < efRangeLo.rtExt) or (E > efRangeHi.rtExt) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- efTransfer(@E, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateDouble;
- var
- E : Extended;
- D : Double;
- Code : Integer;
- S : TEditString;
- begin
- {convert efEditSt to an extended}
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, E, Code);
-{$ELSE}
- Val(string(S), E, Code);
-{$ENDIF}
-
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (E < efRangeLo.rtExt) or (E > efRangeHi.rtExt) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- D := E;
- efTransfer(@D, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateSingle;
- var
- E : Extended;
- Si : Single;
- Code : Integer;
- S : TEditString;
- begin
- {convert efEditSt to an extended}
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, E, Code);
-{$ELSE}
- Val(string(S), E, Code);
-{$ENDIF}
-
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (E < efRangeLo.rtExt) or (E > efRangeHi.rtExt) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- Si := E;
- efTransfer(@Si, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateComp;
- var
- E : Extended;
-{$IFNDEF FPC}
- C : Comp;
-{$ELSE}
- {$IFDEF CPU86}
- C : Comp;
- {$ELSE}
- C : Double;
- {$ENDIF}
-{$ENDIF}
- Code : Integer;
- S : TEditString;
- begin
- {convert efEditSt to an comp}
- pbStripPicture(S, efEditSt);
-
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, C, Code);
-{$ELSE}
- Val(string(S), C, Code);
-{$ENDIF}
-
- E := C;
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (E < efRangeLo.rtExt) or (E > efRangeHi.rtExt) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- efTransfer(@C, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
-begin {validate}
- Result := 0;
- case FNumericDataType of
- nftLongInt : ValidateLongInt;
- nftWord : ValidateWord;
- nftInteger : ValidateInteger;
- nftByte : ValidateByte;
- nftShortInt : ValidateShortInt;
- nftReal : ValidateReal;
- nftExtended : ValidateExtended;
- nftDouble : ValidateDouble;
- nftSingle : ValidateSingle;
- nftComp : ValidateComp;
- end;
-
- if not (sefUserValidating in sefOptions) then begin
- {user may retrieve data from field. flag that we are doing}
- {user validation to avoid calling this routine recursively}
- Include(sefOptions, sefUserValidating);
- DoOnUserValidation(Result);
- Exclude(sefOptions, sefUserValidating);
- end;
-end;
-
-function TOvcCustomNumericField.nfGetDataType(Value: TNumericDataType) : Byte;
- {-return a Byte value representing the type of this field}
-begin
- case Value of
- nftLongInt : Result := fidNumericLongInt;
- nftWord : Result := fidNumericWord;
- nftInteger : Result := fidNumericInteger;
- nftByte : Result := fidNumericByte;
- nftShortInt : Result := fidNumericShortInt;
- nftReal : Result := fidNumericReal;
- nftExtended : Result := fidNumericExtended;
- nftDouble : Result := fidNumericDouble;
- nftSingle : Result := fidNumericSingle;
- nftComp : Result := fidNumericComp;
- else
- raise EOvcException.Create(GetOrphStr(SCInvalidParamValue));
- end;
-end;
-
-procedure TOvcCustomNumericField.nfReloadTmp;
- {-reload Tmp from efEditSt, etc.}
-begin
- {load nfTmp}
- pbStripPicture(nfTmp, efEditSt);
-
- TrimAllSpacesPChar(nfTmp);
-
- {remove the minus sign if there is one}
- nfMinus := (nfTmp[0] = '-');
- if nfMinus then
- StrChDeletePrim(nfTmp, 0);
-
- {want a blank string if it's a zero}
- if (nfTmp[0] = '0') and (nfTmp[1] = #0) then
- nfTmp[0] := #0;
-end;
-
-procedure TOvcCustomNumericField.nfResetFieldProperties(FT: TNumericDataType);
- {-reset field properties}
-begin
- DecimalPlaces := 0;
- case FT of
- nftLongInt : PictureMask := 'iiiiiiiiiii';
- nftWord : PictureMask := '99999';
- nftInteger : PictureMask := 'iiiiii';
- nftByte : PictureMask := '999';
- nftShortInt : PictureMask := 'iiii';
- nftReal : PictureMask := '##########';
- nftExtended : PictureMask := '##########';
- nftDouble : PictureMask := '##########';
- nftSingle : PictureMask := '##########';
- nftComp : PictureMask := 'iiiiiiiiii';
- else
- raise EOvcException.Create(GetOrphStr(SCInvalidParamValue));
- end;
-end;
-
-procedure TOvcCustomNumericField.nfSetDataType(Value: TNumericDataType);
- {-set the data type for this field}
-begin
- if FNumericDataType <> Value then begin
- FNumericDataType := Value;
- efDataType := nfGetDataType(FNumericDataType);
- efSetDefaultRange(efDataType);
-
- {set defaults for this field type}
- nfResetFieldProperties(FNumericDataType);
- if HandleAllocated then begin
- {don't save data through create window}
- efSaveData := False;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
- end;
-end;
-
-procedure TOvcCustomNumericField.nfSetDefaultRanges;
- {-set default range values based on the field type}
-begin
- case FNumericDataType of
- nftLongInt, nftWord, nftInteger, nftByte, nftShortInt :
- if efRangeLo.rtLong = efRangeHi.rtLong then
- efSetDefaultRange(efDataType);
- nftReal :
- if efRangeLo.rtReal = efRangeHi.rtReal then
- efSetDefaultRange(efDataType);
- nftExtended, nftDouble, nftSingle, nftComp :
- if efRangeLo.rtExt = efRangeHi.rtExt then
- efSetDefaultRange(efDataType);
- else
- efSetDefaultRange(efDataType);
- end;
-end;
-
-procedure TOvcCustomNumericField.nfSetMaxLength(Mask : PChar);
- {-determine and set MaxLength}
-var
- C : Cardinal;
-begin
- FMaxLength := StrLen(Mask);
-
- {decrease this if Mask has special characters that}
- {should not be considered part of the display string}
- if StrChPos(Mask, pmNegParens, C) then
- Dec(FMaxLength);
- if StrChPos(Mask, pmNegHere, C) then
- Dec(FMaxLength);
-end;
-
-procedure TOvcCustomNumericField.nfSetPictureMask(const Value: string);
- {-set the picture mask}
-var
- Buf : TPictureMask;
-begin
- if (FPictureMask <> Value) and (Value <> '') then begin
-
- {test for blatantly invalid masks}
- if csDesigning in ComponentState then begin
- {check for masks like "999.99" or "iii.ii" in fields editing floating data types}
- if (efDataType mod fcpDivisor) in [fsubReal, fsubExtended, fsubDouble, fsubSingle] then
- if (Pos(pmDecimalPt, Value) > 0) and
- ((Pos(pmPositive, Value) > 0) or (Pos(pmWhole, Value) > 0)) then
- raise EInvalidPictureMask.Create(Value);
- end;
-
- FPictureMask := Value;
- if csDesigning in ComponentState then begin
- StrPLCopy(efPicture, FPictureMask, MaxPicture);
- efPicLen := StrLen(efPicture);
- {set MaxLength based on picture mask}
- nfSetMaxLength(efPicture);
- pbOptimizeInitPictureFlags;
- efInitializeDataSize;
- Repaint;
- end else begin
- StrPLCopy(Buf, FPictureMask, MaxPicture);
- efChangeMask(Buf);
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
- end;
-end;
-
-procedure TOvcCustomNumericField.pbRemoveSemiLits;
- {-remove semi-literal mask characters from the edit string}
-begin
- if (sefHexadecimal in sefOptions) or (sefOctal in sefOptions) or
- (sefBinary in sefOptions) then
- Include(sefOptions, sefFixSemiLits)
- else
- Exclude(sefOptions, sefFixSemiLits);
-end;
-
-procedure TOvcCustomNumericField.WMKillFocus(var Msg : TWMKillFocus);
-begin
- inherited;
-
- {are we giving up the focus?}
- if not (sefRetainPos in sefOptions) then
- FillChar(nfTmp, SizeOf(nfTmp), #0);
-end;
-
-procedure TOvcCustomNumericField.WMSetFocus(var Msg : TWMSetFocus);
-begin
- inherited;
- nfReloadTmp;
- efResetCaret;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovcpb.pas b/Source/3rdParty/Orpheus/ovcpb.pas
deleted file mode 100644
index bdf5e64a..00000000
--- a/Source/3rdParty/Orpheus/ovcpb.pas
+++ /dev/null
@@ -1,1006 +0,0 @@
-{*********************************************************}
-{* OVCPB.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 ovcpb;
- {-Base picture field class, Picture and Numeric fields are derived from this}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Classes, Graphics, SysUtils, OvcConst,
- OvcData, OvcEF, OvcStr;
-
-type
- TOvcPictureBase = class(TOvcBaseEntryField)
- {.Z+}
- protected {private}
- pfSemiLits : Byte; {# of semi-literals in field}
- pfPicFlags : TPictureFlags; {picture flags array}
- pfSelPos : Integer; {current position of selection highlight}
-
- {windows message methods}
- procedure WMSetFocus(var Msg : TWMSetFocus);
- message WM_SETFOCUS;
- procedure WMKillFocus(var Msg : TWMKillFocus);
- message WM_KILLFOCUS;
-
- protected
- procedure CreateWnd;
- override;
-
- function efCanClose(DoValidation : Boolean) : Boolean;
- override;
- {-return True if window can be closed}
- procedure efCaretToEnd;
- override;
- {-move the caret to the end of the field}
- procedure efCaretToStart;
- override;
- {-move the caret to the beginning of the field}
- procedure efChangeMask(Mask : PAnsiChar);
- override;
- {-change the picture mask}
- function efEditBegin : Word;
- override;
- {-return offset of first editable position in field}
- function efEditEnd : Word;
- {-return offset of last editable position in field}
- function efFieldIsEmpty : Boolean;
- override;
- {-return True if the field is empty}
- function efGetDisplayString(Dest : PAnsiChar; Size : Word) : PAnsiChar;
- override;
- {-return the display string in Dest and a pointer as the result}
- procedure efRemoveBadOptions;
- override;
- {-remove inappropriate options for this field and data type}
- procedure efSetCaretPos(Value : Integer);
- override;
- {-set position of caret within the field}
-
- function pbCalcLength : Word;
- {-calculate length of efEditSt}
- procedure pbCalcWidthAndPlaces(var Width, Places : Word);
- {-calculate width and decimal places for a numeric field}
- procedure pbFixDecimalPoint(P : PAnsiChar);
- {-fix decimal points for real numbers before merging}
- procedure pbFixNumber(DotPos, StBgn, StEnd : Integer; FirstHalf, SecondHalf : Boolean);
- {-fix the first and/or second half of a numeric field}
- function pbIsLiteral(N : Word) : Boolean;
- {-return True if N'th mask character is a literal. N is 0-based}
- procedure pbInitPictureFlags;
- {-initialize picture mask flags}
- function pbIsNumber : Boolean;
- {-return True if field is treated as numeric by MergePicture}
- function pbIsSemiLiteral(N : Word) : Boolean;
- {-return True if N'th mask character is a semi-literal. N is 0-based}
- procedure pbMergePicture(const Dest, Src : PAnsiChar);
- {-merge Src with efPicture and return result in Dest}
- procedure pbOptimizeInitPictureFlags;
- {-see if we can optimize InitPictureFlags}
- procedure pbRemoveSemiLits;
- virtual;
- {-remove semi-literal mask characters from the edit string}
- procedure pbRestoreSemiLits;
- {-restore semi-literal mask characters in the edit string}
- procedure pbStripLiterals(Dest, Src : PAnsiChar);
- {-strip literal mask characters from source and put result in Dest}
- procedure pbStripPicture(const Dest, Src : PAnsiChar);
- {-strip the mask characters from Src and put result in Dest}
-
- public
- {interfaced for internal use only--to allow validation}
- {helper routines access to the picture flags array}
- procedure pbGetPictureFlags(var Flags : TPictureFlags);
- {-return an array of the fields picture flags}
- function GetStrippedEditString : string;
- override;
- {-return edit string stripped of literals and semi-literals}
- procedure MergeWithPicture(const S : string);
- override;
- {-combines S with the picture mask and updates the edit string}
- function ValidateContents(ReportError : Boolean) : Word;
- override;
- {.Z-}
- end;
-
-
-implementation
-
-
-{*** TOvcPictureBase ***}
-
-procedure TOvcPictureBase.CreateWnd;
-begin
- pbInitPictureFlags;
-
- inherited CreateWnd;
-
- {set flags for Real fields and clear DecimalPlaces if decimal point is in mask}
- case efDataType mod fcpDivisor of
- fsubReal, fsubExtended, fsubDouble, fsubSingle, fsubComp :
- begin
- Include(sefOptions, sefRealVar);
- if StrScan(efPicture, pmDecimalPt) <> nil then
- DecimalPlaces := 0;
- end;
- end;
-end;
-
-procedure TOvcPictureBase.pbGetPictureFlags(var Flags : TPictureFlags);
- {-return an array of the fields picture flags}
-begin
- Flags := pfPicFlags;
-end;
-
-function TOvcPictureBase.pbIsLiteral(N : Word) : Boolean;
- {-return True if N'th mask character is a literal. N is 0-based}
-begin
- Result := pfPicFlags[N] = pflagLiteral;
-end;
-
-function TOvcPictureBase.pbIsSemiLiteral(N : Word) : Boolean;
- {-return True if N'th mask character is a semi-literal. N is 0-based}
-begin
- Result := pfPicFlags[N] = pflagSemiLit;
-end;
-
-procedure TOvcPictureBase.pbFixNumber(DotPos, StBgn, StEnd : Integer; FirstHalf, SecondHalf : Boolean);
- {-fix the first and/or second half of a numeric field}
-var
- I, J, K : Integer;
- SaveHP : Word;
-
- function StartOfSubField : Word;
- begin
- Result := efHPos;
- while (Result > StBgn) and not pbIsLiteral(Result - 1) do
- Dec(Result);
- end;
-
- function EndOfSubField : Word;
- begin
- Result := efHPos;
- while (Result < StEnd) and not pbIsLiteral(Result + 1) do
- Inc(Result);
- end;
-
-begin
- SaveHP := efHPos;
-
- if FirstHalf then begin
- {bring numbers to left of decimal flush right}
- if DotPos = -1 then
- efHPos := StEnd
- else
- efHPos := DotPos-1;
- K := EndOfSubField;
- J := StartOfSubField;
- I := J;
- while efEditSt[I] = ' ' do
- Inc(I);
- while I <= K do begin
- if efEditSt[I] = ' ' then begin
- StrStDeletePrim(efEditSt, I, 1);
- StrChInsertPrim(efEditSt, ' ', J);
- end;
- Inc(I);
- end;
-
- {make sure it isn't all blanks to left of decimal}
- if efEditSt[K] = ' ' then
- efEditSt[K] := '0';
- end;
-
- if (DotPos <> -1) and SecondHalf then begin
- efHPos := DotPos+1;
-
- {bring numbers to right of decimal flush left}
- J := EndOfSubField;
- if efHPos <= J then begin
- K := J;
- J := StartOfSubField;
- I := K;
- while efEditSt[I] = ' ' do begin
- efEditSt[I] := '0';
- Dec(I);
- end;
- while I >= J do begin
- if efEditSt[I] = ' ' then begin
- StrStDeletePrim(efEditSt, I, 1);
- StrChInsertPrim(efEditSt, '0', K);
- end;
- Dec(I);
- end;
- end;
- end;
-
- efHPos := SaveHP;
-end;
-
-procedure TOvcPictureBase.pbStripLiterals(Dest, Src : PAnsiChar);
- {-strip literal mask characters from source and put result in Dest}
-var
- I : Word;
-begin
- for I := 0 to MaxLength-1 do begin
- if not pbIsLiteral(I) then begin
- Dest^ := Src^;
- Inc(Dest);
- end;
- Inc(Src);
- end;
- Dest^ := #0;
-end;
-
-procedure TOvcPictureBase.pbFixDecimalPoint(P : PAnsiChar);
- {-fix decimal points for real numbers before merging}
-var
- PT : PAnsiChar;
-begin
- PT := StrScan(P, pmDecimalPt);
- if PT <> nil then
- PT^ := IntlSupport.DecimalChar;
-end;
-
-procedure TOvcPictureBase.pbRestoreSemiLits;
- {-restore semi-literal mask characters in the edit string}
-var
- P : PChar;
-begin
- if not (sefFixSemiLits in sefOptions) then
- Exit;
-
- Exclude(sefOptions, sefFixSemiLits);
- pbStripPicture(efEditSt, efEditSt);
- P := StrScan(efEditSt, IntlSupport.DecimalChar);
- if P <> nil then
- P^ := pmDecimalPt;
- pbMergePicture(efEditSt, efEditSt);
- Invalidate;
-end;
-
-procedure TOvcPictureBase.pbInitPictureFlags;
-var
- I : Word;
-begin
- if sefNoLiterals in sefOptions then begin
- FillChar(pfPicFlags, MaxLength, pflagFormat);
- pfPicFlags[MaxLength] := pflagLiteral;
- end else begin
- FillChar(pfPicFlags, MaxLength+1, pflagLiteral);
- for I := 0 to MaxLength-1 do
- if efNthMaskChar(I) in PictureChars then
- pfPicFlags[I] := pflagFormat
- else
- case efNthMaskChar(I) of
- pmFloatDollar, pmComma :
- pfPicFlags[I] := pflagSemiLit;
- end;
- end;
-end;
-
-function TOvcPictureBase.pbIsNumber : Boolean;
- {-return True if field is treated as numeric by MergePicture}
-begin
- Result :=
- (pfSemiLits <> 0) or
- (sefNumeric in sefOptions) or
- (sefHexadecimal in sefOptions) or
- (sefOctal in sefOptions) or
- (sefBinary in sefOptions) or
- (StrScan(efPicture, pmDecimalPt) <> nil) or
- (StrScan(efPicture, pmCurrencyLt) <> nil) or
- (StrScan(efPicture, pmCurrencyRt) <> nil);
-end;
-
-function TOvcPictureBase.pbCalcLength : Word;
- {-calculate length of efEditSt}
-var
- I : Integer;
-begin
- I := efEditEnd;
- while (I >= 0) and ((efEditSt[I] = ' ') or pbIsLiteral(I)) do
- Dec(I);
- Result := I + 1;
-end;
-
-function TOvcPictureBase.efGetDisplayString(Dest : PAnsiChar; Size : Word) : PAnsiChar;
- {-return the display string in Dest}
-var
- I : Integer;
-begin
- Result := inherited efGetDisplayString(Dest, Size);
-
- if Uninitialized and not (sefHaveFocus in sefOptions) then begin
- FillChar(Dest[0], MaxLength, ' ');
- Dest[MaxLength] := #0;
- Exit;
- end;
-
- if (efoPasswordMode in Options) or (PadChar <> ' ') then begin
- I := MaxLength-1;
- while I >= 0 do begin
- while (I >= 0) and pbIsLiteral(I) do
- Dec(I);
-
- if efFieldClass <> fcNumeric then
- while (I >= 0) and (not pbIsLiteral(I)) and (Dest[I] = ' ') do begin
- Dest[I] := PadChar;
- Dec(I);
- end;
-
- while (I >= 0) and (not pbIsLiteral(I)) and (Dest[I] <> ' ') do begin
- if (efoPasswordMode in Options) then
- Dest[I] := PasswordChar;
- Dec(I);
- end;
-
- if efFieldClass = fcNumeric then
- while (I >= 0) and (not pbIsLiteral(I)) and (Dest[I] = ' ') do begin
- Dest[I] := PadChar;
- Dec(I);
- end;
- end;
- end;
-end;
-
-function TOvcPictureBase.efFieldIsEmpty : Boolean;
- {-return True if the field is empty}
-var
- I : Word;
-begin
- I := 0;
- Result := True;
- while (I+1 <= MaxLength) and Result do
- if (not pbIsLiteral(I)) and (efEditSt[I] <> ' ') then
- Result := False
- else
- Inc(I);
-end;
-
-procedure TOvcPictureBase.efRemoveBadOptions;
- {-remove inappropriate options for this field and data type}
-begin
- if csLoading in ComponentState then
- Exit;
-
- case efDataType of
- fidPictureString :
- if not (sefNoLiterals in sefOptions) then begin
- Exclude( FOptions, efoRightJustify );
- Exclude( FOptions, efoTrimBlanks );
- end;
- else
- inherited efRemoveBadOptions;
- end;
-end;
-
-procedure TOvcPictureBase.efSetCaretPos(Value : Integer);
- {-set position of caret within the field}
-begin
- if not (sefHaveFocus in sefOptions) then
- Exit;
-
- if Value < efEditBegin then
- efHPos := efEditBegin
- else if Value > efEditEnd then
- efHPos := efEditEnd + 1
- else begin
- while pbIsLiteral(Value) do
- Dec(Value);
- efHPos := Value;
- end;
- efPositionCaret(True);
-end;
-
-procedure TOvcPictureBase.efCaretToStart;
- {-move the caret to the beginning of the field}
-begin
- efHPos := efEditBegin;
- efHOffset := 0;
-end;
-
-procedure TOvcPictureBase.efCaretToEnd;
- {-move the caret to the end of the field}
-var
- StEnd : Word;
-begin
- efHPos := pbCalcLength;
- StEnd := efEditEnd;
- while (efHPos < StEnd) and pbIsLiteral(efHPos) do
- Inc(efHPos);
-end;
-
-function TOvcPictureBase.efEditBegin : Word;
- {-return offset of first editable position in field}
-var
- I : Word;
-begin
- I := 0;
- while (I < MaxLength-1) and (pfPicFlags[I] = pflagLiteral) do
- Inc(I);
- Result := I + pfSemiLits;
-end;
-
-function TOvcPictureBase.efEditEnd : Word;
- {-return offset of last editable position in field}
-begin
- Result := MaxLength - 1;
- while (Result > 0) and (pfPicFlags[Result] = pflagLiteral) do
- Dec(Result);
-end;
-
-procedure TOvcPictureBase.efChangeMask(Mask : PAnsiChar);
- {-change the picture mask}
-var
- I : Cardinal;
- Buf : array[0..MaxEditLen] of Char;
-begin
- {save current value}
- pbStripPicture(Buf, efEditSt);
-
- inherited efChangeMask(Mask);
-
- {disallow 'p' and 'g' in picture fields}
- if efFieldClass <> fcNumeric then begin
- if StrChPos(efPicture, pmNegParens, I) then
- StrChDeletePrim(efPicture, I);
- if StrChPos(efPicture, pmNegHere, I) then
- StrChDeletePrim(efPicture, I);
- end;
-
- efPicLen := StrLen(efPicture);
- if (MaxLength < efPicLen) or
- ((MaxLength <> efPicLen) and (efFieldClass = fcNumeric)) then begin
- if not (csLoading in ComponentState) then
- MaxLength := efPicLen;
- end;
-
- {clear the edit string}
- FillChar(efEditSt, MaxEditLen, #0);
-
- {see if we can optimize InitPictureFlags}
- pbOptimizeInitPictureFlags;
-
- {restore value}
- pbMergePicture(efEditSt, Buf);
-end;
-
-function TOvcPictureBase.GetStrippedEditString : string;
- {-return edit string stripped of literals and semi-literals}
-var
- Buf : TEditString;
-begin
- {get copy of edit string and limit to MaxEditLen}
- StrLCopy(Buf, efEditSt, MaxEditLen);
-
- {strip the copy of the edit string}
- pbStripPicture(Buf, Buf);
- Result := StrPas(Buf);
-end;
-
-procedure TOvcPictureBase.MergeWithPicture(const S : string);
- {-combines S with the picture mask and updates the edit string}
-var
- Buf : TEditString;
-begin
- HandleNeeded;
- StrPCopy(Buf, S);
- pbMergePicture(efEditSt, Buf);
-end;
-
-function TOvcPictureBase.efCanClose(DoValidation : Boolean) : Boolean;
- {-return True if window can be closed}
-var
- DotPos : Cardinal;
-begin
- if efFieldClass = fcPicture then
- if ((sefModified in sefOptions) and (sefHaveFocus in sefOptions)) then
- if StrChPos(efPicture, pmDecimalPt, DotPos) then
- pbFixNumber(DotPos, efEditBegin, efEditEnd, True, True);
- Result := inherited efCanClose(DoValidation);
-end;
-
-procedure TOvcPictureBase.pbRemoveSemiLits;
- {-remove semi-literal mask characters from the edit string}
-var
- I : Cardinal;
- B : Word;
- E : Word;
- P : Word;
- D : Word;
- Buf : array[0..255] of Char;
-begin
- if pfSemiLits = 0 then begin
- if (sefHexadecimal in sefOptions) or (sefOctal in sefOptions) or
- (sefBinary in sefOptions) then
- Include(sefOptions, sefFixSemiLits);
- Exit;
- end;
-
- Include(sefOptions, sefFixSemiLits);
-
- B := efEditBegin;
- E := efEditEnd;
- P := B - pfSemiLits;
-
- if StrScan(efPicture, pmFloatDollar) <> nil then begin
- StrPCopy(Buf, IntlSupport.CurrencyLtStr);
- if StrStPos(efEditSt, Buf, I) then begin
- D := StrLen(Buf);
- StrStDeletePrim(efEditSt, I, D);
- StrInsertChars(efEditSt, ' ', P, D);
- Inc(P, D);
- end;
- end;
-
- if StrScan(efPicture, pmComma) <> nil then
- for I := P{B} to E do
- if (efEditSt[I] = IntlSupport.CommaChar) then begin
- StrStDeletePrim(efEditSt, I, 1);
- StrChInsertPrim(efEditSt, ' ', P);
- Inc(P);
- end;
-end;
-
-procedure TOvcPictureBase.pbCalcWidthAndPlaces(var Width, Places : Word);
- {-calculate width and decimal places for a numeric field}
-var
- I : Word;
- DotPos : Cardinal;
-begin
- pbInitPictureFlags;
-
- {find position of period and calculate decimal places}
- if not StrChPos(efPicture, pmDecimalPt, DotPos) then
- Places := DecimalPlaces
- else begin
- Places := 0;
- I := DotPos+1;
- while (pfPicFlags[I] = pflagFormat) do begin
- Inc(Places);
- Inc(I);
- end;
- end;
-
- {calculate width}
- I := 0;
- Width := 0;
- while pbIsLiteral(I) or pbIsSemiLiteral(I) do
- Inc(I);
- while (pfPicFlags[I] = pflagFormat) or (efNthMaskChar(I) = pmComma) do begin
- Inc(Width, Ord(pfPicFlags[I] = pflagFormat));
- Inc(I);
- end;
-
- {add decimal places and period}
- if (DotPos <> $FFFF) and (Places <> 0) then
- Inc(Width, Places + 1);
-end;
-
-procedure TOvcPictureBase.pbOptimizeInitPictureFlags;
- {-see if we can optimize InitPictureFlags}
-var
- I : Word;
-begin
- pfSemiLits := 0;
- Exclude(sefOptions, sefNoLiterals);
- pbInitPictureFlags;
- Include(sefOptions, sefNoLiterals);
- for I := 0 to MaxLength-1 do
- case pfPicFlags[I] of
- pflagLiteral :
- Exclude(sefOptions, sefNoLiterals);
- pflagSemiLit :
- begin
- Inc(pfSemiLits);
- Exclude(sefOptions, sefNoLiterals);
- end;
- end;
-
- {if we have literals, turn off TrimBlanks and RightJustify}
- if not (sefNoLiterals in sefOptions) then begin
- Exclude( FOptions, efoTrimBlanks );
- Exclude( FOptions, efoRightJustify );
- end;
-end;
-
-procedure TOvcPictureBase.pbMergePicture(const Dest, Src : PAnsiChar);
- {-merge Src with efPicture and return result in Dest}
-var
- SrcLen : Integer;
- DestLen : Integer;
- DotPosP : Cardinal;
- DotPosS : Cardinal;
- FloatPos : Integer;
- FP : Cardinal;
- I : Cardinal;
- J, K, N : Integer;
- PicChar : AnsiChar;
- NeedFloat : Boolean;
- CurLeftMax : Byte;
- CurLeftLen : Byte;
- IsNum : Boolean;
- NeedMinus : Boolean;
- FoundP : Boolean;
- FoundS : Boolean;
- CopyOfSrc : TEditString;
- Buf : array[0..255] of Char;
-
- procedure HandleOtherCases;
- begin
- if NeedFloat then begin
- Dec(CurLeftLen);
- Dest[I] := IntlSupport.CurrencyLtStr[CurLeftLen+1];
- NeedFloat := CurLeftLen <> 0;
- end else if NeedMinus then begin
- Dest[I] := '-';
- NeedMinus := False;
- end else if (sefHexadecimal in sefOptions) or (sefOctal in sefOptions) or
- (sefBinary in sefOptions) then
- Dest[I] := '0'
- else
- Dest[I] := ' ';
- end;
-
-begin
- {get initial size of Src}
- SrcLen := StrLen(Src);
-
- if SrcLen = 0 then
- CopyOfSrc[0] := #0
- else
- StrCopy(CopyOfSrc, Src);
-
- {copy picture mask into Dest}
- StrCopy(Dest, efPicture);
-
- {mask may be artificially short -- extend with last character of mask}
- if MaxLength > efPicLen then begin
- FillChar(Dest[efPicLen], MaxLength-efPicLen, Dest[efPicLen-1]);
- Dest[MaxLength] := #0;
- end;
- DestLen := MaxLength;
-
- {get position of decimal point}
- FoundP := StrChPos(efPicture, pmDecimalPt, DotPosP);
-
- {is it a numeric string?}
- IsNum := pbIsNumber;
-
- {take care of currency strings}
- if StrChPos(efPicture, pmCurrencyLt, I) then begin
- K := I;
- while (K+1 < DestLen) and (efNthMaskChar(K+1) = pmCurrencyLt) do
- Inc(K);
- StrPCopy(Buf, IntlSupport.CurrencyLtStr);
- J := StrLen(Buf);
- for N := K downto I do
- if J > 0 then begin
- Dec(J);
- Dest[N] := Buf[J];
- end else
- Dest[N] := ' ';
- end;
-
- if StrChPos(efPicture, pmCurrencyRt, I) then begin
- J := 0;
- StrPCopy(Buf, IntlSupport.CurrencyRtStr);
- K := StrLen(Buf);
- while (LongInt(I+1) <= DestLen) and (efNthMaskChar(I) = pmCurrencyRt) do begin
- if J < K then begin
- Dest[I] := Buf[J];
- Inc(J);
- end else
- Dest[I] := ' ';
- Inc(I);
- end;
- end;
-
- if IsNum then begin
- {we need to fill in the FloatDollar positions too, if any}
- if StrChPos(efPicture, pmFloatDollar, FP) then begin
- FloatPos := FP;
- CurLeftLen := Length(IntlSupport.CurrencyLtStr);
- CurLeftMax := 1;
- while efNthMaskChar(FloatPos+1) = pmFloatDollar do begin
- Inc(FloatPos);
- Inc(CurLeftMax);
- end;
- if CurLeftMax < CurLeftLen then
- CurLeftLen := CurLeftMax;
- end else begin
- CurLeftLen := 0;
- FloatPos := -1;
- end;
-
- {trim leading and trailing blanks}
- TrimAllSpacesPChar(CopyOfSrc);
-
- {check for a minus sign}
- NeedMinus := (CopyOfSrc[0] = '-');
- if NeedMinus then
- StrStDeletePrim(CopyOfSrc, 0, 1);
-
- {it's a numeric field--align the decimal points}
- FoundS := StrChPos(CopyOfSrc, pmDecimalPt, DotPosS);
-
- {see if we need a floating dollar sign}
- SrcLen := StrLen(CopyOfSrc);
- NeedFloat := (SrcLen <> 0) and (CurLeftLen <> 0);
-
- {if there's no tail, pretend there's a dot beyond the end of CopyOfSrc}
- if not FoundS then
- K := SrcLen
- else
- K := DotPosS;
-
- {copy the tail of the string}
- if not FoundP then
- I := DestLen
- else
- I := DotPosP+1;
- J := K+1;
- while (J+1 <= SrcLen) and (LongInt(I+1) <= DestLen) and not pbIsLiteral(I) do begin
- Dest[I] := CopyOfSrc[J];
- Inc(I);
- Inc(J);
- end;
-
- {pad to end with 0's}
- while (LongInt(I+1) <= DestLen) and not pbIsLiteral(I) do begin
- Dest[I] := '0';
- Inc(I);
- end;
-
- {handle trailing substitution characters}
- while (LongInt(I+1) <= DestLen) and pbIsLiteral(I) do begin
- PicChar := efNthMaskChar(I);
- case PicChar of
- Subst1..Subst8 : Dest[I] := UserData.SubstChars[PicChar];
- end;
- Inc(I);
- end;
-
- {merge the head of the string}
- if not FoundP then
- J := DestLen-1
- else
- J := DotPosP;
-
- if FoundS then
- SrcLen := DotPosS;
-
- for I := J downto 0 do begin
- PicChar := efNthMaskChar(I);
- case pfPicFlags[I] of
- pflagFormat,
- pflagSemiLit :
- if PicChar = pmComma then begin
- if (SrcLen <> 0) then begin
- if IntlSupport.CommaChar <> #0 then
- Dest[I] := IntlSupport.CommaChar
- else
- StrStDeletePrim(Dest, I, 1);
- end else
- HandleOtherCases;
- end else if (SrcLen > 0) and (Integer(I) > FloatPos) then begin
- Dec(SrcLen);
- Dest[I] := CopyOfSrc[SrcLen];
- end else
- HandleOtherCases;
- pflagLiteral :
- case PicChar of
- Subst1..Subst8 :
- Dest[I] := UserData.SubstChars[PicChar];
- pmDecimalPt :
- Dest[I] := IntlSupport.DecimalChar;
- end;
- end;
- end;
-
- {put in a 0 before the dot if necessary}
- if FoundP and (Dest[DotPosP-1] = ' ') then
- Dest[DotPosP-1] := '0';
- end else begin
- {deal with problem w/ reals w/ variable # of places}
- if (sefRealVar in sefOptions) and (SrcLen > DestLen) then
- if StrScan(CopyOfSrc, pmDecimalPt) <> nil then begin
- TrimTrailingZerosPChar(CopyOfSrc);
- SrcLen := StrLen(CopyOfSrc);
- end;
-
- if efoRightJustify in Options then begin
- {fill in the characters from CopyOfSrc}
- J := SrcLen-1;
- for I := DestLen-1 downto 0 do begin
- PicChar := efNthMaskChar(I);
- case pfPicFlags[I] of
- pflagLiteral :
- case PicChar of
- Subst1..Subst8 :
- Dest[I] := UserData.SubstChars[PicChar];
- end;
- else
- if (J = -1) then
- Dest[I] := ' '
- else begin
- Dest[I] := CopyOfSrc[J];
- efFixCase(PicChar, AnsiChar(Dest[I]), #255);
- Dec(J);
- end;
- end;
- end;
- end else begin
- {fill in the characters from CopyOfSrc}
- J := 0;
- for I := 0 to DestLen-1 do begin
- PicChar := efNthMaskChar(I);
- case pfPicFlags[I] of
- pflagLiteral :
- case PicChar of
- Subst1..Subst8 :
- Dest[I] := UserData.SubstChars[PicChar];
- end;
- else
- if (J <= SrcLen-1) then begin
- Dest[I] := CopyOfSrc[J];
- efFixCase(PicChar, AnsiChar(Dest[I]), #255);
- Inc(J);
- end else
- Dest[I] := ' ';
- end;
- end;
- end;
-
- if sefRealVar in sefOptions then
- pbFixDecimalPoint(Dest);
- end;
-
- Dest[DestLen] := #0;
-end;
-
-procedure TOvcPictureBase.pbStripPicture(const Dest, Src : PAnsiChar);
- {-strip the mask characters from Src and put result in Dest}
-var
- SLen : Byte;
- Found : Boolean;
- P : PAnsiChar;
- DotPos : Cardinal;
- I : Integer;
- CLT : array[0..5] of AnsiChar;
-begin
- {this won't work if string isn't the same length as the picture mask}
- if StrLen(Src) <> MaxLength then begin
- if Pointer(Dest) <> Pointer(Src) then
- StrCopy(Dest, Src);
- Exit;
- end;
-
- {check for fixed decimal point}
- Found := StrChPos(efPicture, pmDecimalPt, DotPos);
-
- {copy all non-literals from Src into Dest. Note: it's OK if Dest *is* Src}
- SLen := 0;
- for I := 0 to MaxLength-1 do
- if (Found and (I = LongInt(DotPos))) or not pbIsLiteral(I) then begin
- Inc(SLen);
- Dest[SLen-1] := Src[I];
- end;
- Dest[SLen] := #0;
-
- {remove floating dollar sign}
- P := StrScan(efPicture, pmFloatDollar);
- if P <> nil then begin
- I := 1;
-
- {find end of currency mask}
- while P[1] = pmFloatDollar do begin
- Inc(I);
- Inc(P);
- end;
- StrPCopy(CLT, IntlSupport.CurrencyLtStr);
- CLT[I] := #0;
- P := StrPos(Dest, CLT);
- if P <> nil then
- StrStDeletePrim(P, 0, I);
- end;
-
- {remove commas}
- if (StrScan(efPicture, pmComma) <> nil) and
- (IntlSupport.CommaChar <> #0) then
- repeat
- P := StrScan(Dest, IntlSupport.CommaChar);
- if P <> nil then
- StrStDeletePrim(P, 0, 1);
- until (P = nil);
-
- {fix up decimal point}
- if Found then begin
- P := StrScan(Dest, IntlSupport.DecimalChar);
- if P <> nil then
- P^ := pmDecimalPt;
- end;
-end;
-
-function TOvcPictureBase.ValidateContents(ReportError : Boolean) : Word;
-var
- DotPos : Cardinal;
-begin
- if efFieldClass = fcPicture then
- if sefModified in sefOptions then begin
- if StrChPos(efPicture, pmDecimalPt, DotPos) then
- pbFixNumber(DotPos, efEditBegin, efEditEnd, True, True);
- end;
-
- Result := inherited ValidateContents(ReportError);
-end;
-
-procedure TOvcPictureBase.WMSetFocus(var Msg : TWMSetFocus);
-var
- B : Boolean;
-begin
- pbInitPictureFlags;
- B := sefRetainPos in sefOptions;
- inherited;
- if not B then
- pfSelPos := efSelEnd;
-end;
-
-procedure TOvcPictureBase.WMKillFocus(var Msg : TWMKillFocus);
-var
- DotPos : Cardinal;
-begin
- if efFieldClass = fcPicture then
- if sefModified in sefOptions then begin
- if StrChPos(efPicture, pmDecimalPt, DotPos) then
- pbFixNumber(DotPos, efEditBegin, efEditEnd, True, True);
- end;
-
- inherited;
-
- {are we giving up the focus?}
- if not (sefRetainPos in sefOptions) then begin
- {restore semi-literal characters}
- pbRestoreSemiLits;
- end;
-end;
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovcreg.lrs b/Source/3rdParty/Orpheus/ovcreg.lrs
deleted file mode 100644
index 6a1db435..00000000
--- a/Source/3rdParty/Orpheus/ovcreg.lrs
+++ /dev/null
@@ -1,1756 +0,0 @@
-LazarusResources.Add('TOVCCONTROLLER','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#0#0#0#128#128#0#0#0#0
- +#128#128#0#0#0#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#128#128#0#0#0#0#128#128#0#0
- +#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0
- +#0#0#0#255#0#0#255#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#0#0#0#0#0#0#128#128#0#0#0#0#128#128#0#0#0#0#0#0#0#128#128#0#128#128#0#128
- +#128#0#0#0#0#0#0#0#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#0#0#0
- +#0#0#0#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#0#0#0#0#0#0
- +#128#128#0#0#0#0#128#128#0#0#0#0#0#0#0#0#0#255#0#0#255#0#0#255#0#0#255#0#0
- +#255#0#0#0#0#0#0#0#0#0#0#0#255#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#0#0#0#0
- +#0#0#0#0#0#128#128#0#0#0#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#255#0#0#255#0
- +#0#255#0#0#255#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0
- +#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#128#128#0#128#128#0#0#0#0#0#0#0#0
- +#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#0#0#0#0#0#0#0#255#255#0#128#128#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0
- +#0#0#0#128#128#0#0#0#0#0#0#255#0#0#255#0#0#255#0#0#255#0#0#0#0#0#0#0#0#0#0#0
- +#0#128#128#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#255#0#0#255#0#0#255#0#0
- +#255#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0
- +#0#255#0#0#255#0#0#255#0#0#255#0#0#0#0#0#0#0#0#0#128#128#0#0#0#0#0#0#0#0#0#0
- +#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#0#0#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#0#0#255#0#0#255#0#0#255#0#0#255#0#0#0#0#0#0#0#0#0#128
- +#128#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#255#0#0#255#0
- +#0#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#255#0#0#255#0#0#255#0
- +#0#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0
- +#0#0#0#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0
- +#0#0#0#0#255#0#0#255#0#0#0#0#0#0#0#0#0#128#128#0#0#0#0#255#255#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#255#255#0#0#0#0#0#0#255#0#0#255#0#0#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#0#0#0#0#0#255#0#0#255#0#0#0#0#0#0#0#0#0#128#128#0
- +#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#255#0#0#255#0#0
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#255#0#0
- +#255#0#0#255#0#0#0#0#0#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#0
- +#0#0#0#0#0#255#255#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#0#0#255#0#0#255#0#0#0#0#0#0#0#0#0#128#128#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#255#255#255#0#0#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#255
- +#0#0#0#0#0#0#0#0#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#255#255#0#255#255#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#0#0#255#0#0#255#0#0#0#0#0#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#0#0#255#0#0#0#0#0#0#0#0#0#128#128#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#255#0#0#255#0#0#0#128#128#0#0#0#0#255#255#0#0#0#0#255
- +#255#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#255#0#0#0#0#0#0
- +#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#0#0#255#0#0#0#128#128
- +#0#128#128#0#255#255#0#0#0#0#255#255#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#0#0#255#0#0#0#0#0#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#255#0#0#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0#0#0#0#255#255#0
- +#128#128#0#255#255#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0
- +#255#0#0#0#0#0#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#255#0#0#255#0#0#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#255#0#0#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#255#0#0#255#0#0#255#0#0
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#0#0#255#0#0#255#0#0#255#0#0#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128
-]);
-LazarusResources.Add('TOVCTCSTRING','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0
- +#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0
- +#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0
- +#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255
- +#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0
- +#0#0#0#0#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255
- +#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0
- +#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255
- +#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255
- +#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#0#0
- +#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- ,#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255
- +#255#0#0#255#0#0#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0
-]);
-LazarusResources.Add('TOVCTCCOLHEAD','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0
- +#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#255#255#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0
- +#0#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255
- +#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#0#0#0#0#0#0#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255
- +#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255
- +#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255
- +#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#255#255#255#255
- +#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255
- +#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255
- +#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- ,#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255
- +#255#255#255#0#0#255#0#0#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0
-]);
-LazarusResources.Add('TOVCTCROWHEAD','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0
- +#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0
- +#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0
- +#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0
- +#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0
- +#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#0
- +#0#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#0#0#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0
- +#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255
- +#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255
- +#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0
- +#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255
- +#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255
- +#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#255#255
- +#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255
- +#255#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255
- +#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255
- ,#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255
- +#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0
-]);
-LazarusResources.Add('TOVCTCCOMBOBOX','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#0#0#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#0#0#192#192#192#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#192#192#192#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#0#0#192#192#192#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#192#192#192#0#0#0#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#192#192#192#192#192#192
- +#192#192#192#0#0#0#192#192#192#192#192#192#192#192#192#0#0#0#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#192#192#192
- +#192#192#192#0#0#0#0#0#0#0#0#0#192#192#192#192#192#192#0#0#0#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#192#192#192
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#192#192#192#0#0#0#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#192#192#192#192#192
- +#192#128#128#128#0#0#0#128#128#128#192#192#192#192#192#192#0#0#0#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#192
- +#192#192#192#192#192#128#128#128#0#0#0#128#128#128#192#192#192#192#192#192#0
- +#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#0#0#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#0#0#0#0
- +#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255
- +#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255
- +#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255
- +#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255
- +#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#0#0#255#0#0
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255
- ,#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#0#0
- +#255#0#0#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
-]);
-LazarusResources.Add('TOVCTCSIMPLEFIELD','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0
- +#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255
- +#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255
- +#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255
- +#0#0#0#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0#0
- +#0#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255
- +#255#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255
- +#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255
- +#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255
- +#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255
- +#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- ,#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255
- +#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0
-]);
-LazarusResources.Add('TOVCTCCHECKBOX','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#0#0#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#0#0#0#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#255#255#255#0#0#0#0#0#0
- +#255#255#255#0#0#0#0#0#0#255#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#255#255#255#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#255#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#0#0#255#255#255#255#255#255#0#0#0#192
- +#192#192#0#0#0#255#255#255#255#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#255#255#255#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#255#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#0#0#255#255#255#0#0#0#0#0#0#255#255#255
- +#0#0#0#0#0#0#255#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#0#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#0#0#255#0#0
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255
- +#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0
- +#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0
- +#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255
- +#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255
- +#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255
- +#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- ,#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255
- +#0#0#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#0#0#0#0#0#0
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
-]);
-LazarusResources.Add('TOVCTABLE','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#0#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#128
- +#0#128#128#0#128#128#0#128#128#0#0#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#0#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#0#128#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#0#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#0#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#0#128#0#128#128#0#128#128#0#128#128#0#0#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#0#128#0#0#128#0#128#128#0#0#128#0#0
- +#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#128
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#128#128
- +#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128
- +#128#128#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128
- +#128#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#128#128#128#128#128#128
- +#128#128#128#128#128#128#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0
- +#255#0#0#255#128#128#128#128#128#128#0#0#0#0#128#128#0#0#128#0#0#128#0#128
- +#128#0#0#128#0#0#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#0#255#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#0#255#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#0#255#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#0#255#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#128#128#128#128#128
- +#128#128#128#128#128#128#128#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255
- +#0#0#255#0#0#255#128#128#128#128#128#128#0#0#0#0#128#128#0#0#128#0#0#128#0
- +#128#128#0#0#128#0#0#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128
- +#128#0#128#128#128#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#128#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128
- +#128#0#128#128#0#128#128#128#128#128#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#128#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#0#0#0#0#128#128#0#0#128#0#0#128#0#128#128#0#0#128#0#0#128#0#128
- +#128#0#128#128#0#0#0#255#0#0#255#0#0#255#0#0#255#0#0#128#128#128#255#0#0#255
- +#0#0#255#0#0#255#0#0#255#0#0#255#0#0#128#128#128#255#0#0#255#0#0#0#0#0#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#0#0#255#0#0#255#0#0#255#0#0#255#0#0#128#128#128#255#0#0#255#0#0#255#0#0#255
- ,#0#0#255#0#0#255#0#0#128#128#128#255#0#0#255#0#0#0#0#0#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#128#128#0#0#128#0#0#128#0#128#128#0#0#128#0#0#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128
-]);
-LazarusResources.Add('TOVCURL','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128#0#0#0#0#0#0#0#0#0#0#0#0#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#0#0#0#192#192#192#255#255#255#192#192#192#255#255#255#0#0#0#255#255
- +#255#192#192#192#255#255#255#192#192#192#0#0#0#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#0#0#0#192#192#192#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#192#192#192#0#0#0#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#0#0#0#255#255#255#0#0#0#128#128#128#0#0
- +#0#192#192#192#192#192#192#192#192#192#0#0#0#128#128#128#0#0#0#255#255#255#0
- +#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#0#0#0#192#192
- +#192#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#192#192#192#0#0#0
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#0#0#0#128#0#0#0#0#0#192#192#192
- +#255#255#255#192#192#192#255#255#255#0#0#0#255#255#255#192#192#192#255#255
- +#255#192#192#192#0#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#0#0#0
- +#255#0#0#255#0#0#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#0#0#255#0#0
- +#255#0#0#255#0#0#0#128#0#0#128#0#0#128#0#0#128#0#255#0#0#128#0#0#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#255#0#0#255#0#0#255#0#0#255#0#0#0#128#0#0#128#0#0#128#0#0#128#0#128#128
- +#0#255#0#0#0#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#255#0#0#255#0#0#0#128#0#0#128#0#0#128#0#0#128#0#0#128#0
- +#0#128#0#255#0#0#255#0#0#0#0#0#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#255#0#0#0#128#0#0#128#0#0#128#0#0#128#0
- +#0#128#0#128#0#0#128#128#0#128#0#0#0#128#0#0#0#0#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#255#0#0#192#192#192#0
- +#128#0#0#128#0#128#0#0#0#128#0#0#128#0#255#0#0#0#128#0#0#128#0#0#0#0#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#255#0#0#255#255#255#192#192#192#255#0#0#255#0#0#255#0#0#255#0#0#0
- +#128#0#0#128#0#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#255#255#255#192#192#192#255#255
- ,#255#0#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#0#0#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#0#192#192#192#0#128#0#0#128#0#0#128#0#0
- +#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128
-]);
-LazarusResources.Add('TOVCSIMPLEFIELD','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#0#0#0#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#255
- +#255#255#255#255#255#255#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#0#0#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#0#0#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#0#0#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#0#0#255#255#255#0#0#0#0#128#128#0#128#128#0
- +#128#128#255#0#0#255#0#0#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#0#0#255#255#255#0#0#0#0#128#128#0#128#128#255
- +#0#0#255#0#0#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#0#0#255#255#255#0#0#0#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#0#0#255#255#255#0#0#0#0#128#128#0#128
- +#128#0#128#128#255#0#0#255#0#0#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#0#0#255#255#255#0#0#0#0#128#128#0#128
- +#128#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#0#0#255#255#255#0#0#0#0#128#128#0
- +#128#128#255#0#0#255#0#0#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#0#0#255#255#255#0#0#0#0#128#128#0
- +#128#128#0#128#128#255#0#0#255#0#0#255#0#0#255#0#0#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#0#0#255#255#255#0#0#0#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#255#255#255#0#0#0#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255#255#255
- +#255#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#0#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#0#0#0#0#0
- ,#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128
-]);
-LazarusResources.Add('TO32FLEXEDIT','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#128#128
- +#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128
- +#128#128#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#0#0#0#0#128#128#128#128#128#192#192#192#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#0#0#0#0#128
- +#128#128#128#128#192#192#192#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#0#0#0#0#128#128#128#128#128#192#192#192#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#255#255#255#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128#128#128#128#128#192
- +#192#192#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#255#255#255#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128#128#128#128
- +#128#192#192#192#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#255#255#255
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0
- +#0#0#128#128#128#128#128#192#192#192#0#255#255#0#255#255#0#0#0#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#0#0#0#0#128#128#128#128#128#192#192#192#0#255#255#0#255#255
- +#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255
- +#0#255#255#255#255#255#192#192#192#0#0#0#192#192#192#0#0#0#192#192#192#0#0#0
- +#0#0#0#0#128#128#128#128#128#192#192#192#0#255#255#0#255#255#0#0#0#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255
- +#0#255#255#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#0#0#0#0#128#128#128#128#128#192#192#192#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#255#255#255#255#255#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128#128#128#128#128#192#192
- +#192#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#255#255#0#255#255#255#255#255#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#0#0#0#0#128#128#128#128#128#192#192#192
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#255#255#255#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128
- +#128#128#128#128#192#192#192#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#0#0#128#128#128#128#128#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- ,#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128
-]);
-LazarusResources.Add('TO32TCFLEXEDIT','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#0#0#0#128#128#0#128
- +#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0
- +#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#0#0#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128
- +#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#0#0#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#0#0#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#0#0#0#128#128#0#128
- +#128#0#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#128#128#128#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#0#0#0#128#128#128#192#192#192#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#128#128#128#0#0#0#128#128#128#192#192#192
- +#0#255#255#0#255#255#128#0#0#128#0#0#128#0#0#0#255#255#0#255#255#0#255#255
- +#128#0#0#128#0#0#128#0#0#0#255#255#0#255#255#0#255#255#128#0#0#0#255#255#0
- +#255#255#0#255#255#128#0#0#0#255#255#128#128#128#0#0#0#128#128#128#192#192
- +#192#0#255#255#128#0#0#0#255#255#0#255#255#0#255#255#128#0#0#0#255#255#128#0
- +#0#0#255#255#0#255#255#0#255#255#128#0#0#0#255#255#0#255#255#128#0#0#0#255
- +#255#0#255#255#0#255#255#128#0#0#0#255#255#128#128#128#0#0#0#128#128#128#192
- +#192#192#0#255#255#128#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255
- +#128#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#128#0#0
- +#0#255#255#0#255#255#0#255#255#128#0#0#0#255#255#128#128#128#0#0#0#128#128
- +#128#192#192#192#0#255#255#128#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#0#255#255#0#255#255#128#0#0
- +#0#255#255#0#255#255#0#255#255#128#0#0#0#255#255#128#128#128#0#0#0#128#128
- +#128#192#192#192#0#255#255#128#0#0#0#255#255#0#255#255#0#255#255#128#0#0#0
- +#255#255#128#0#0#0#255#255#0#255#255#0#255#255#128#0#0#0#255#255#0#255#255
- +#128#0#0#0#255#255#0#255#255#0#255#255#128#0#0#0#255#255#128#128#128#0#0#0
- +#128#128#128#192#192#192#0#255#255#0#255#255#128#0#0#128#0#0#128#0#0#0#255
- +#255#0#255#255#0#255#255#128#0#0#128#0#0#128#0#0#0#255#255#0#255#255#0#255
- +#255#128#0#0#0#255#255#0#255#255#0#255#255#128#0#0#0#255#255#128#128#128#0#0
- +#0#128#128#128#192#192#192#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#128#0#0#0#255#255#0#255#255#0#255#255#128#0#0#0#255#255#128
- +#128#128#0#0#0#128#128#128#192#192#192#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#128#0#0#128#0#0#128#0#0#0#255#255#128#0#0#128#0#0#128#0#0#0#255#255
- ,#128#128#128#0#0#0#128#128#128#192#192#192#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#128#128#128#0#0#0#128#128#128#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#128
- +#128#128#0#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
-]);
-LazarusResources.Add('TOVCTCMEMO','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#255
- +#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#0
- +#0#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255
- +#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0
- +#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0
- +#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0
- +#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255
- +#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#255#255
- +#0#0#0#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0
- +#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255
- +#255#0#255#255#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0
- +#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255
- +#255#255#255#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255#255
- +#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255
- +#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255
- +#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255
- +#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0
- +#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255
- ,#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255
- +#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#0#0#0#0#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0
-]);
-LazarusResources.Add('TOVCTCBITMAP','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0
- +#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0
- +#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255
- +#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255
- +#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0
- +#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#0
- +#0#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#255#255#0#255#255#0
- +#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#0
- +#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#0#0#255#0#0
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255
- +#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0
- +#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0
- +#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255
- +#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255
- +#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255
- +#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- ,#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255
- +#0#0#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#0#0#0#0#0#0
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
-]);
-LazarusResources.Add('TOVCTCGLYPH','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#255#255
- +#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255
- +#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255
- +#255#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0
- +#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#0
- +#0#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0
- +#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0
- +#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0
- +#0#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0
- +#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0
- +#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255
- +#255#255#255#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255#255
- +#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255
- +#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255
- +#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255
- +#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0
- +#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255
- ,#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255
- +#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#0#0#0#0#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0
-]);
-LazarusResources.Add('TOVCTCICON','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0
- +#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0
- +#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0
- +#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255
- +#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#0#0#0#0#0#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255
- +#255#0#0#0#0#255#255#0#0#0#0#255#255#0#0#0#0#0#0#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255
- +#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0
- +#255#255#0#0#0#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255
- +#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0
- +#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#0
- +#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0
- +#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#255#255#0#0#0#0#255#255#0#255#255
- +#0#0#0#0#255#255#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0
- +#255#255#0#0#0#0#0#0#0#0#0#0#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0
- +#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#0#0#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
- +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#0#0#0#0
- +#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255
- +#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255
- +#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255
- +#0#0#0#0#0#0#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255
- +#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#0#0#255#0#0
- +#255#0#0#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- ,#255#255#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#255
- +#255#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#0#0
- +#255#0#0#255#0#0#255#255#255#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
-]);
-LazarusResources.Add('TOVCROTATEDLABEL','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#0#0#0#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#0#0#0#128
- +#128#128#0#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#0#0#0#128#128#128#128#128#128#128#128#128#0#0#0
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#0#0#0#128#128#128#128#128#128#128#128#128#0#0#0#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#0#0#0#128#128#128#128#128#128#0#0#0#128#128#128#128
- +#128#128#0#0#0#0#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#0#0#0#128#128
- +#128#128#128#128#128#128#128#0#0#0#0#0#0#128#128#128#128#128#128#128#128#128
- +#0#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#0#0#0#128#128#128#128#128#128#0#0#0#128
- +#128#128#128#128#128#128#128#128#0#0#0#0#0#0#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#0#0#0#0#0#0#128#128#128#128#128#128#128#128#128#0#0#0#128#128#128
- +#128#128#128#0#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#0#0#0#128#128#128#128#128#128#128#128#128#128#128#128#0
- +#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#0#0#0#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#0#0#0#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#0#0#0#0#0#0#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#0#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#0#0#0#128#128#128#128
- +#128#128#0#0#0#128#128#128#128#128#128#128#128#128#0#0#0#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- ,#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#0#0#0#128#128#128#128#128#128#128#128#128#128#128#128#0#0#0#0#0#0#0
- +#0#0#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
-]);
-LazarusResources.Add('TOVCSPINNER','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#128#128#128#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128
- +#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#255#255#255#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128#128#0#128#128#0
- +#128#128#0#128#128#255#255#255#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#255#255#255#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#255#255
- +#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#128#128#128#0#0#0#255#255#255#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128
- +#128#0#128#128#0#128#128#0#128#128#255#255#255#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#128#128#128#0#0#0
- +#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#0#0#0#0#128#128#0#128#128#0#128#128#0#128
- +#128#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#128#128#128#0#0#0#0#0#0#0#0#0#255#255#255#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128
- +#128#0#128#128#0#128#128#0#128#128#255#255#255#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#128#128#128#0#0#0#0#0#0#0#0#0
- +#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#255#255
- +#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#128#128#128
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128#128#0#128#128#0#128#128
- +#0#128#128#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#128#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128#128
- +#0#128#128#0#128#128#0#128#128#255#255#255#192#192#192#192#192#192#192#192
- +#192#192#192#192#128#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255
- +#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0
- +#128#128#0#128#128#0#128#128#0#128#128#255#255#255#192#192#192#192#192#192
- +#192#192#192#192#192#192#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#255#255#255#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128#128#0#128#128#0#128#128
- +#0#128#128#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#255#255#255#192
- +#192#192#192#192#192#192#192#192#192#192#192#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128#128
- +#0#128#128#0#128#128#0#128#128#255#255#255#192#192#192#192#192#192#192#192
- +#192#192#192#192#128#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255
- +#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0
- +#128#128#0#128#128#0#128#128#0#128#128#255#255#255#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#128#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#255#255#255#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#128#128#128#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#255#255#255#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#0#0#0#0#128#128#0#128#128#0#128#128#0#128
- +#128#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#128#128#128#0#0#0#0#0#0#0#0#0#255#255#255#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128
- +#128#0#128#128#0#128#128#0#128#128#255#255#255#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#128#128#128#0#0#0#0#0#0#0#0#0
- ,#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#255#255
- +#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#128#128#128#0#0#0#255#255#255#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128
- +#128#0#128#128#0#128#128#0#128#128#255#255#255#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#128#128#128#0#0#0
- +#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#0#0#0#0#128#128#0#128#128#0#128#128#0#128
- +#128#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#255#255#255#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#255#255#255#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#0#0#0#0#128#128#0#128
- +#128#0#128#128#0#128#128#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#128#128#128#0#128#128#0#128#128
-]);
-LazarusResources.Add('TOVCLABEL','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0
- +#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#0#0#0#0#0#128#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#128#128#128#0#0#0#0#0#0#128#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#128#128#128#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#0#0#0#0#0#128#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#128#128#128#0#0#0#0#0#0#128#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#128#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#0#0#0#0#0#128#128#128#0#128#128#0#128#128#0#128#128#128#128
- +#128#0#0#0#0#0#0#128#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#128#128#128#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#0
- +#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#0#0#0#0#0#128#128#128#0#128#128#128#128#128#0#0#0
- +#0#0#0#128#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#128#128#128#0#0#0#0#0#0#0#128#128#0#0#0#0#0#0#0
- +#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#128#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- ,#128#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128
-]);
-LazarusResources.Add('TOVCVIRTUALLISTBOX','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0#255
- +#255#255#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#255
- +#255#255#255#255#255#255#255#255#255#255#255#128#0#0#255#255#255#255#255#255
- +#255#255#255#0#0#0#128#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#0#0#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#128#0#0#128
- +#0#0#128#0#0#255#255#255#255#255#255#0#0#0#128#128#128#0#0#0#0#128#128#0#128
- +#128#0#128#128#0#0#0#255#255#255#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#128
- +#0#0#128#0#0#128#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#0#0#0#128#128#128#0#0#0#0#128#128#0
- +#128#128#0#128#128#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#0#0#0#128#128#128#0#0#0#0#128
- +#128#0#128#128#0#128#128#0#0#0#255#255#255#128#0#0#128#0#0#128#0#0#128#0#0
- +#128#0#0#128#0#0#128#0#0#128#0#0#255#255#255#255#255#255#255#255#255#128#128
- +#128#255#255#255#128#128#128#255#255#255#255#255#255#0#0#0#128#128#128#0#0#0
- +#0#128#128#0#128#128#0#128#128#0#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#128#128#128#255#255#255#128#128#128#255#255#255#128#128#128
- +#255#255#255#0#0#0#128#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#0#0#255
- +#255#255#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#255
- +#255#255#255#255#255#255#255#255#128#128#128#255#255#255#128#128#128#255#255
- +#255#255#255#255#0#0#0#128#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#0#0
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#128#128#128#255#255
- +#255#128#128#128#255#255#255#128#128#128#255#255#255#0#0#0#128#128#128#0#0#0
- +#0#128#128#0#128#128#0#128#128#0#0#0#255#255#255#128#0#0#128#0#0#128#0#0#128
- +#0#0#128#0#0#128#0#0#128#0#0#128#0#0#255#255#255#255#255#255#255#255#255#128
- +#128#128#255#255#255#128#128#128#255#255#255#255#255#255#0#0#0#128#128#128#0
- +#0#0#0#128#128#0#128#128#0#128#128#0#0#0#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#128#128#128#255#255#255#128#128#128#255#255#255#128#128
- +#128#255#255#255#0#0#0#128#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#0#0
- +#255#255#255#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0
- +#255#255#255#255#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#0#0#0#128
- +#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#0#0#0#128#128#128#0#0#0#0#128#128#0#128#128#0
- +#128#128#0#0#0#255#255#255#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0#128#0#0
- +#128#0#0#128#0#0#255#255#255#255#255#255#255#255#255#128#0#0#128#0#0#128#0#0
- +#255#255#255#255#255#255#0#0#0#128#128#128#0#0#0#0#128#128#0#128#128#0#128
- +#128#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#128#0#0#255#255#255#255#255#255#255#255#255#0#0#0#128#128
- +#128#0#0#0#0#128#128#0#128#128#0#128#128#0#0#0#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#0#0#0#128#128#128#0#0#0#0#128#128#0#128#128#0#128
- +#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#128#0#0#0#0#128#128#0#128
- ,#128#0#128#128#0#128#128#0#0#0#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128
-]);
-LazarusResources.Add('TOVCCALENDAR','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#0#0#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#0#0#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#255#0#0#255#0#0
- +#255#0#0#255#0#0#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#255#0#0#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#255#0#0#255
- +#0#0#0#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#255
- +#0#0#255#0#0#255#0#0#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128
- +#0#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#255#0#0#255#0#0
- +#255#0#0#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0
- +#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#255#0#0#0#128#128#0
- +#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0
- +#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#255#0#0#0#128#128#0
- +#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0
- +#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128
- +#0#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#0#128
- +#128#255#0#0#255#0#0#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128
- +#0#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128
- +#128#0#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#255#0#0#0#128
- +#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128
- +#128#0#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#255#0#0#0#128
- +#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#255#0#0#255#0#0#0#128#128
- +#0#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#255#0#0#255#0#0
- +#255#0#0#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#255#0#0#255#0#0#255#0#0#255#0#0#0#128#128#0#128
- +#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#255#0#0#255#0
- +#0#255#0#0#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#255#0#0#255#0#0#0#128#128#0#128#128
- +#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#255#0#0
- +#255#0#0#255#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#0#0
- +#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#0#0#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0#128
- ,#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#255#255#255#0#0#0#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128
-]);
-LazarusResources.Add('TOVCDATEEDIT','BMP',[
- 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
- +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#0#255#0#0#255#0#0#255#0#0#255#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#128#128#128#128#128#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#255#255
- +#255#0#128#128#128#128#128#0#0#0#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255
- +#0#0#255#192#192#192#255#255#255#0#128#128#128#128#128#0#0#0#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255
- +#0#0#255#0#0#255#0#0#255#255#255#255#192#192#192#255#255#255#0#128#128#128
- +#128#128#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0
- +#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#192#192#192#192#192#192#192#192
- +#192#255#255#255#0#128#128#128#128#128#0#0#0#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#192#192#192#192
- +#192#192#192#192#192#192#192#192#255#255#255#0#128#128#128#128#128#0#0#0#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#255#255#255#0
- +#128#128#128#128#128#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#0#0#0
- +#255#255#255#0#0#0#0#0#0#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#255#255
- +#255#0#128#128#128#128#128#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#0
- +#0#0#255#255#255#0#0#0#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#255
- +#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#255#255#255#0#128#128#128#128#128#0#0#0#0#0#0#255#255#255#0#0#0#255#255
- +#255#0#0#0#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#0
- +#255#255#255#192#192#192#192#192#192#0#0#0#192#192#192#192#192#192#192#192
- +#192#255#255#255#0#128#128#128#128#128#0#0#0#0#0#0#0#0#0#255#255#255#0#0#0#0
- +#0#0#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#0#255#255#255#0#0#0
- +#192#192#192#0#0#0#0#0#0#0#0#0#192#192#192#192#192#192#255#255#255#0#128#128
- +#128#128#128#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#0#0#255#0#0#255
- +#0#0#255#0#0#255#0#0#255#0#0#255#255#255#255#0#0#0#255#255#255#0#0#0#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#255#255#255
- +#0#128#128#128#128#128#0#0#0#255#255#255#255#255#255#255#255#255#0#0#255#0#0
- +#255#0#0#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#192#192#192#192#255#255#255#0#128#128#128#128#128#0#0#0#255#255#255#255#255
- +#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#192#192#192#192#192#192#192
- +#192#192#192#192#192#192#192#192#192#192#192#255#255#255#0#128#128#128#128
- +#128#0#0#0#255#255#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
- +#255#255#255#0#128#128#128#128#128#0#0#0#0#0#255#0#0#255#0#0#255#0#0#255#0#0
- +#255#0#0#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#255#255#255#0#128#128#128#128#128#0#0#255#0#0#255#0#0
- +#255#0#0#255#0#0#255#0#0#255#128#128#128#128#128#128#128#128#128#128#128#128
- +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
- ,#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#0#128
- +#128#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#0#255#0#0#255#0#0#255#0#0#255#0#0#255#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#0#255#0#0#255#0#0#255#0#0#255#0#128#128#0#128#128#0#128#128
- +#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#0#255#0#0#255#0#0#255#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128
- +#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0#128#128#0
- +#128#128#0#128#128#0#128#128
-]);
-LazarusResources.Add('ORREDDOT','BMP',[
- 'BM>'#1#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#7#0#0#0#11#0#0#0#1#0#24#0#0#0#0#0#8#1#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#0#0#0#255#255#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0
- +#0#255#255#255#0#0#0#255#255#0#0#0#255#0#0#255#0#0#255#0#0#255#0#0#0#255#255
- +#255#0#0#0#255#255#0#0#0#255#0#0#255#0#0#255#0#0#255#0#0#0#255#255#255#0#0#0
- +#255#255#0#0#0#255#0#0#255#0#0#255#0#0#255#0#0#0#255#255#255#0#0#0#255#255#0
- +#0#0#255#0#0#255#0#0#255#0#0#255#0#0#0#255#255#255#0#0#0#255#255#0#255#255#0
- +#255#255#0#255#255#0#255#255#0#0#0#0#255#255#255#0#0#0
-]);
-LazarusResources.Add('ORBLUEDOT','BMP',[
- 'BM>'#1#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#7#0#0#0#11#0#0#0#1#0#24#0#0#0#0#0#8#1#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#0#0#0#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#0#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#0#0#0#255#255#255#255#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#0#0#0#255#255#255#255#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#0#0#0#255#255#255#255#255
- +#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#255#0#0#0#255
- +#255#0#0#0#0#0#0#0#0#0#0#255#255#255#255#255#255#255#255#255#0#0#0#255#255#0
- +#128#128#0#128#128#0#0#0#0#255#255#255#255#255#255#255#255#255#0#0#0#255#255
- +#0#128#128#0#128#128#0#0#0#0#255#255#255#255#255#255#255#255#255#0#0#0#255
- +#255#0#255#255#0#255#255#0#0#0#0#255#255#255#255#255#255#255#255#255#0#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/ovcrlbl.pas b/Source/3rdParty/Orpheus/ovcrlbl.pas
deleted file mode 100644
index d95364bd..00000000
--- a/Source/3rdParty/Orpheus/ovcrlbl.pas
+++ /dev/null
@@ -1,520 +0,0 @@
-{*********************************************************}
-{* OVCRLBL.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 ovcrlbl;
- {-Rotated label component}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Classes, Controls, Graphics, SysUtils,
- OvcBase, OvcMisc;
-
-type
- TOvcCustomRotatedLabel = class(TOvcGraphicControl)
- {.Z+}
- protected {private}
- {property instance variables}
- FAlignment : TAlignment;
- FAutoSize : Boolean;
- FCaption : string;
- FFontAngle : Integer;
- FOriginX : Integer;
- FOriginY : Integer;
- FShadowColor : TColor; {color for text shadowing}
- FShadowedText : Boolean; {true to draw shadowed text}
-
- {internal variables}
- rlBusy : Boolean;
-
- {property methods}
- function GetTransparent : Boolean;
- procedure SetAlignment(Value : TAlignment);
- procedure SetAutoSize(Value : Boolean); {$IFDEF VERSION6}{$IFNDEF LCL} override;{$ENDIF}{$ENDIF}
- procedure SetCaption(const Value : string);
- procedure SetOriginX(Value : Integer);
- procedure SetOriginY(Value : Integer);
- procedure SetShadowColor(const Value : TColor);
- procedure SetShadowedText(Value : Boolean);
- procedure SetTransparent(Value : Boolean);
- procedure SetFontAngle(Value : Integer);
-
- {internal methods}
- procedure lblAdjustSize;
- {-adjust horizontal and/or vertical size of control}
- procedure lblDrawText(var R : TRect; Flags : Word);
- {-draw the label text}
-
- {VCL message handling methods}
- procedure CMFontChanged(var Msg : TMessage);
- message CM_FONTCHANGED;
- procedure CMTextChanged(var Mes : TMessage);
- message CM_TEXTCHANGED;
-
- protected
- procedure Loaded;
- override;
- procedure Paint;
- override;
- procedure SetName(const NewName : TComponentName);
- override;
- {.Z-}
-
- property Alignment : TAlignment
- read FAlignment write SetAlignment;
- property AutoSize : Boolean
- read FAutoSize write SetAutoSize;
- property Caption : string
- read FCaption write SetCaption;
- property FontAngle : Integer
- read FFontAngle write SetFontAngle;
- property OriginX : Integer
- read FOriginX write SetOriginX;
- property OriginY : Integer
- read FOriginY write SetOriginY;
- property ShadowColor : TColor
- read FShadowColor write SetShadowColor;
- property ShadowedText : Boolean
- read FShadowedText write SetShadowedText;
- property Transparent : Boolean
- read GetTransparent write SetTransparent;
-
- public
- {.Z+}
- constructor Create(AOwner: TComponent);
- override;
- {.Z-}
-
- {public properties}
- property Canvas;
- end;
-
- TOvcRotatedLabel = class(TOvcCustomRotatedLabel)
- published
- {$IFDEF VERSION4}
- property Anchors;
- property Constraints;
- property DragKind;
- {$ENDIF}
- property Align;
- property Alignment default taLeftJustify;
- property AutoSize;
- property Caption;
- property Color;
- property DragCursor;
- property DragMode;
- property Enabled;
- property Font;
- property FontAngle default 0;
- property Height default 20;
- property OriginX default 0;
- property OriginY default 0;
- property ParentColor;
- {property ParentFont;}
- property ParentShowHint;
- property PopupMenu;
- property ShadowColor default clBtnShadow;
- property ShadowedText;
- property ShowHint;
- property Transparent default False;
- property Visible;
-
- {events}
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDrag;
- end;
-
-implementation
-
-{*** TOvcCustomRotatedLabel ***}
-
-procedure TOvcCustomRotatedLabel.CMFontChanged(var Msg : TMessage);
-var
- TM : TTextMetric;
-begin
- inherited;
-
- if csLoading in ComponentState then
- Exit;
-
- if FFontAngle <> 0 then begin
- {check if the current font can be rotated}
- Canvas.Font := Self.Font;
- GetTextMetrics(Canvas.Handle, TM);
- if (TM.tmPitchAndFamily and TMPF_TRUETYPE) = 0 then
- {force zero font angle}
- FontAngle := 0;
- end;
- lblAdjustSize;
-end;
-
-procedure TOvcCustomRotatedLabel.CMTextChanged(var Mes : TMessage);
-begin
- lblAdjustSize;
-end;
-
-constructor TOvcCustomRotatedLabel.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- ControlStyle := ControlStyle + [csReplicatable, csOpaque];
-
- {default property values}
- FAlignment := taLeftJustify;
- FFontAngle := 0;
- FOriginX := 0;
- FOriginY := 0;
- FShadowColor := clBtnShadow;
- FShadowedText := False;
-
-{$IFDEF MSWINDOWS}
- Font.Name := 'Arial';
-{$ELSE}
- Font.Name := 'default';
-{$ENDIF}
- Height := 20;
- Width := 130;
-
- if csDesigning in ComponentState then
- lblAdjustSize;
-end;
-
-function TOvcCustomRotatedLabel.GetTransparent : Boolean;
-begin
- Result := not (csOpaque in ControlStyle);
-end;
-
-procedure TOvcCustomRotatedLabel.lblAdjustSize;
- {-adjust horizontal and/or vertical size of control}
-var
- R : TRect;
- W, H, X, Y : Integer;
-begin
- if rlBusy then {avoid reentrance}
- Exit;
-
- rlBusy := True;
- try
- if not (csLoading in ComponentState) and AutoSize then begin
- R := ClientRect;
- Canvas.Font := Font;
- W := Canvas.TextWidth(Caption);
- H := Canvas.TextHeight(Caption);
- if FFontAngle <> 0 then begin
- {adjust height and width as necessary}
- {width (X) of text at new angle}
- X := Round(W * Cos(FFontAngle*Pi/180));
- {height (y) of text at new angle}
- Y := Round(W * Sin(FFontAngle*Pi/180));
- R.Bottom := Abs(Y) + 2*H;
- R.Right := Abs(X) + 2*H;
- if X < 0 then
- FOriginX := R.Right-H
- else
- FOriginX := H;
- if Y < 0 then
- FOriginY := H
- else begin
- if X < 0 then
- FOriginY := R.Bottom - H
- else
- FOriginY := R.Bottom - H - H div 2;
- end;
- end else begin
- FOriginX := 0;
- FOriginY := 0;
- R.Right := W;
- R.Bottom := H;
- end;
-
- SetBounds(Left, Top, R.Right, R.Bottom);
- end;
- finally
- rlBusy := False;
- end;
-end;
-
-procedure TOvcCustomRotatedLabel.lblDrawText(var R : TRect; Flags : Word);
- {-paint the controls display or calculate a TRect to fit text}
-var
- HoldColor : TColor;
- T : string;
- XO, YO : Integer;
- A : Integer;
- Buf : array[0..255] of Char;
-{$IFDEF LCL}
- FontHand : hFont;
-{$ENDIF}
-begin
- T := Caption;
- if (Flags and DT_CALCRECT <> 0) and (T = '') then
- T := ' ';
-
- Flags := Flags or DT_NOPREFIX;
-
- {use our font}
- Canvas.Font := Font;
-
- {create the rotated font}
- if FFontAngle <> 0 then
-{$IFNDEF LCL}
- Canvas.Font.Handle := CreateRotatedFont(Font, FFontAngle);
-{$ELSE} //Workaround for now - Qt widgetset not setting Handle?
- FontHand := CreateRotatedFont(Font, FFontAngle);
-{$ENDIF}
-
- {force disabled text color, if not enabled}
- if not Enabled then
- Canvas.Font.Color := clGrayText;
-
- {draw the text}
- StrPLCopy(Buf, T, 255);
- if FFontAngle = 0 then begin
- {draw shadow first, if selected}
- if FShadowedText then begin
- HoldColor := Canvas.Font.Color;
- Canvas.Font.Color := FShadowColor;
- if not Transparent then begin
- SetBkMode(Canvas.Handle, OPAQUE);
- Canvas.Brush.Color := Color;
- end;
- OffsetRect(R, +2, +1);
- DrawText(Canvas.Handle, @Buf, -1, R, Flags);
- Canvas.Font.Color := HoldColor;
-{$IFNDEF LCL}
- SetBkMode(Canvas.Handle, Windows.TRANSPARENT);
-{$ELSE}
- SetBkMode(Canvas.Handle, LclType.TRANSPARENT);
-{$ENDIF}
- OffsetRect(R, -2, -1);
- DrawText(Canvas.Handle, @Buf, -1, R, Flags);
- end else begin
- DrawText(Canvas.Handle, @Buf, -1, R, Flags)
- end;
- end else begin
- if FShadowedText then begin
- HoldColor := Canvas.Font.Color;
- Canvas.Font.Color := FShadowColor;
- if not Transparent then begin
-{$IFNDEF LCL}
- SetBkMode(Canvas.Handle, Windows.OPAQUE);
-{$ELSE}
- SetBkMode(Canvas.Handle, LclType.OPAQUE);
-{$ENDIF}
- Canvas.Brush.Color := Color;
- end;
- {calculate the shadow offset based on the quadrant the text is in}
- { | } { 1 -- X+2, Y+1}
- { 2 | 1 } { 2 -- X-1, Y-2}
- { -------+--------- } { 3 -- X+2, Y+1}
- { 3 | 4 } { 4 -- X-1, Y-2}
- { | }
- A := FFontAngle;
- if A < 0 then A := 360 + A;
- if A >= 270 then begin
- XO := 2; YO := 1; {Quad=4}
- end else if A >= 180 then begin
- XO := 2; YO := 1; {Quad=3}
- end else if A >= 90 then begin
- XO := 2; YO := 1; {Quad=2}
- end else begin
- XO := 2; YO := 1; {Quad=1}
- end;
-{$IFDEF LCL}
- SelectObject(Canvas.Handle, FontHand);
-{$ENDIF}
- ExtTextOut(Canvas.Handle, OriginX+XO, OriginY+YO, ETO_CLIPPED,
- @R, Buf, StrLen(Buf), nil);
- Canvas.Font.Color := HoldColor;
-{$IFNDEF LCL}
- SetBkMode(Canvas.Handle, Windows.TRANSPARENT);
-{$ELSE}
- SetBkMode(Canvas.Handle, LclType.TRANSPARENT);
-{$ENDIF}
-{$IFDEF LCL}
- SelectObject(Canvas.Handle, FontHand);
-{$ENDIF}
- ExtTextOut(Canvas.Handle, OriginX, OriginY, ETO_CLIPPED,
- @R, Buf, StrLen(Buf), nil);
- end else begin
-{$IFDEF LCL}
- SelectObject(Canvas.Handle, FontHand);
-{$ENDIF}
- ExtTextOut(Canvas.Handle, OriginX, OriginY, ETO_CLIPPED,
- @R, Buf, StrLen(Buf), nil);
- end;
- end;
-end;
-
-procedure TOvcCustomRotatedLabel.Loaded;
-begin
- inherited Loaded;
-
- lblAdjustSize;
-end;
-
-procedure TOvcCustomRotatedLabel.Paint;
-const
- Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
-var
- R : TRect;
-begin
- R := ClientRect;
- with Canvas do begin
- if not Transparent then begin
- Brush.Color := Self.Color;
- Brush.Style := bsSolid;
- FillRect(R);
- end;
- Brush.Style := bsClear;
- lblDrawText(R, Alignments[FAlignment])
- end;
-end;
-
-procedure TOvcCustomRotatedLabel.SetAlignment(Value : TAlignment);
-begin
- if FAlignment <> Value then begin
- FAlignment := Value;
- Invalidate;
- end;
-end;
-
-procedure TOvcCustomRotatedLabel.SetAutoSize(Value : Boolean);
-begin
- if Value <> FAutoSize then begin
- FAutoSize := Value;
- lblAdjustSize;
- end;
-end;
-
-procedure TOvcCustomRotatedLabel.SetCaption(const Value : string);
-begin
- if Value <> FCaption then begin
- FCaption := Value;
- lblAdjustSize;
- Repaint;
- end;
-end;
-
-procedure TOvcCustomRotatedLabel.SetOriginX(Value : Integer);
-begin
- if Value <> FOriginX then begin
- FOriginX := Value;
- Invalidate;
- end;
-end;
-
-procedure TOvcCustomRotatedLabel.SetOriginY(Value : Integer);
-begin
- if Value <> FOriginY then begin
- FOriginY := Value;
- Invalidate;
- end;
-end;
-
-procedure TOvcCustomRotatedLabel.SetShadowColor(const Value : TColor);
-begin
- if Value <> FShadowColor then begin
- FShadowColor := Value;
- invalidate;
- end;
-end;
-
-procedure TOvcCustomRotatedLabel.SetShadowedText(Value : Boolean);
-begin
- if Value <> FShadowedText then begin
- FShadowedText := Value;
- Invalidate;
- end;
-end;
-
-procedure TOvcCustomRotatedLabel.SetTransparent(Value : Boolean);
-begin
- if Transparent <> Value then begin
- if Value then
- ControlStyle := ControlStyle - [csOpaque]
- else
- ControlStyle := ControlStyle + [csOpaque];
- Invalidate;
- end;
-end;
-
-procedure TOvcCustomRotatedLabel.SetFontAngle(Value : Integer);
-var
- Neg : Integer;
- TM : TTextMetric;
-begin
- if Value <> FFontAngle then begin
- {check if the current font can be rotated}
- if not (csLoading in ComponentState) then begin
- if Value <> 0 then begin
- Canvas.Font := Font;
- GetTextMetrics(Canvas.Handle, TM);
- if (TM.tmPitchAndFamily and TMPF_TRUETYPE) = 0 then
- {force true-type font}
-{$IFDEF MSWINDOWS}
- Font.Name := 'Arial';
-{$ENDIF}
- end;
- end;
- if Value < 0 then Neg := -1 else Neg := 1;
- FFontAngle := (Abs(Value) mod 360) * Neg;
-
- lblAdjustSize;
-
- {repaint with new font}
- Invalidate;
- end;
-end;
-
-procedure TOvcCustomRotatedLabel.SetName(const NewName : TComponentName);
-begin
- inherited SetName(NewName);
- if (csDesigning in ComponentState) and (FCaption = '') then
- FCaption := Self.Name;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovcsc.pas b/Source/3rdParty/Orpheus/ovcsc.pas
deleted file mode 100644
index e5bdb00e..00000000
--- a/Source/3rdParty/Orpheus/ovcsc.pas
+++ /dev/null
@@ -1,1717 +0,0 @@
-{*********************************************************}
-{* OVCSC.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 ***** *}
-
-(*Changes)
-
- 01/15/02 - Set AutoRepeat modified to prevent deadlocks at runtime.
-*)
-
-{$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 ovcsc;
- {-Spin control}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Buttons, Classes, Controls, Forms, Graphics, StdCtrls,
- SysUtils, OvcBase, OvcData, OvcEF, OvcMisc, OvcExcpt;
-
-type
- TOvcSpinnerStyle = (stNormalVertical, stNormalHorizontal, stFourWay, stStar,
- stDiagonalVertical, stDiagonalHorizontal, stDiagonalFourWay,
- stPlainStar);
-
- TOvcDirection = (dUp, dDown, dRight, dLeft);
-
- TOvcSpinState = (ssNone, ssNormal, ssUpBtn, ssDownBtn, ssLeftBtn,
- ssRightBtn, ssCenterBtn);
-
- TOvcSpinnerLineType = (ltSingle,
- ltTopBevel, ltBottomBevel, ltTopSlice, ltBottomSlice,
- ltTopSliceSquare, ltBottomSliceSquare,
- ltDiagTopBevel,ltDiagBottomBevel,
- ltStarLine0, ltStarLine1, ltStarLine2, ltStarLine3, ltStarLine4, ltStarLine5
- );
-
- TSpinClickEvent =
- procedure(Sender : TObject; State : TOvcSpinState; Delta : Double; Wrap : Boolean)
- of object;
-
-type
- TOvcSpinner = class(TOvcCustomControl)
- protected {private}
- {property variables}
- FAcceleration : Integer; {value used to determine acceleration}
- FAutoRepeat : Boolean; {repeat if button held}
- FDelayTime : LongInt;
- FDelta : Double; {amount to change by}
- FRepeatCount : LongInt;
- FFocusedControl : TWinControl; {the control to give the focus to}
- FShowArrows : Boolean;
- FStyle : TOvcSpinnerStyle;
- FWrapMode : Boolean; {wrap at field bounderies}
-
- {events}
- FOnClick : TSpinClickEvent;
-
- {private instance variables}
- scNextMsgTime : LongInt;
-
- {regions for the five spin button sections}
- scUpRgn : hRgn;
- scDownRgn : hRgn;
- scLeftRgn : hRgn;
- scRightRgn : hRgn;
- scCenterRgn : hRgn;
-
- scCurrentState : TOvcSpinState;
- scLButton : Byte;
- scMouseOverBtn : Boolean;
- scPrevState : TOvcSpinState;
- scSizing : Boolean;
- scTopLeft, scTopRight, scBottomLeft, scBottomRight, scCenter : TPoint;
- scTopLeftCenter, scBottomLeftCenter, scTopRightCenter, scBottomRightCenter : TPoint;
- scTopMiddle, scBottomMiddle, scLeftMiddle, scRightMiddle : TPoint;
- scTopLeft4, scBottomLeft4, scTopRight4, scBottomRight4 : TPoint;
-
- {property methods}
- procedure SetAcceleration(const Value : Integer);
- procedure SetAutoRepeat(Value: Boolean);
- procedure SetShowArrows(const Value : Boolean);
- procedure SetStyle(Value : TOvcSpinnerStyle);
-
- {internal methods}
- function scCheckMousePos : TOvcSpinState;
- procedure scDeleteRegions;
- procedure scDoAutoRepeat;
- procedure scDrawArrow(const R: TRect; const Pressed: Boolean; const Direction: TOvcDirection);
- procedure scDrawLine(P1, P2 : TPoint; const Up : Boolean; LineType : TOvcSpinnerLineType);
- procedure scDrawNormalButton(const Redraw : Boolean);
- procedure scDrawFourWayButton(const Redraw : Boolean);
- procedure scDrawStarButton(const Redraw : Boolean);
- procedure scDrawDiagonalVertical(const Redraw : Boolean);
- procedure scDrawDiagonalHorizontal(const Redraw : Boolean);
- procedure scDrawDiagonalFourWay(const Redraw : Boolean);
- procedure scDrawPlainStar(const Redraw : Boolean);
- procedure scDrawButton(const Redraw : Boolean);
- procedure scInvalidateButton(const State : TOvcSpinState);
- procedure scPolyline(const Points: array of TPoint);
-
- {private message response methods}
- procedure OMRecreateWnd(var Msg : TMessage);
- message om_RecreateWnd;
-
- {windows message handling methods}
- procedure WMGetDlgCode(var Msg : TWMGetDlgCode);
- message WM_GETDLGCODE;
- procedure WMLButtonDown(var Msg : TWMLButtonDown);
- message WM_LBUTTONDOWN;
- procedure WMLButtonUp(var Msg : TWMLButtonUp);
- message WM_LBUTTONUP;
-
- protected
- procedure CreateParams(var Params : TCreateParams);
- override;
- procedure Loaded;
- override;
- procedure Notification(AComponent : TComponent; Operation : TOperation);
- override;
- procedure Paint;
- override;
-
- {dynamic event wrappers}
- procedure DoOnClick(State : TOvcSpinState);
- dynamic;
-
- procedure scDoMouseDown(const XPos, YPos: Integer);
- virtual;
- procedure scDoMouseUp;
- virtual;
- procedure scUpdateNormalSizes;
- procedure scUpdateFourWaySizes;
- procedure scUpdateStarSizes;
- procedure scUpdateDiagonalVerticalSizes;
- procedure scUpdateDiagonalHorizontalSizes;
- procedure scUpdateDiagonalFourWaySizes;
- procedure scUpdatePlainStarSizes;
- procedure scUpdateSizes;
- virtual;
-
- public
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
- override;
-
- property RepeatCount : LongInt
- read FRepeatCount;
-
- published
- {properties}
- property Acceleration : Integer
- read FAcceleration write SetAcceleration
- default 5;
- property AutoRepeat : Boolean
- read FAutoRepeat write SetAutoRepeat;
- property Delta : Double
- read FDelta write FDelta;
- property DelayTime : LongInt
- read FDelayTime write FDelayTime
- default 500;
- property FocusedControl : TWinControl
- read FFocusedControl write FFocusedControl;
- property ShowArrows : Boolean
- read FShowArrows write SetShowArrows
- default True;
- property Style : TOvcSpinnerStyle
- read FStyle write SetStyle
- default stNormalVertical;
- property WrapMode : Boolean
- read FWrapMode write FWrapMode
- default True;
-
- {inherited properties}
- {$IFDEF VERSION4}
- property Anchors;
- property Constraints;
- {$ENDIF}
- property Enabled;
- property ParentShowHint;
- property ShowHint;
- property Visible;
-
- {events}
- property OnClick : TSpinClickEvent
- read FOnClick write FOnClick;
-
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- end;
-
-
-implementation
-
-uses
- OvcEdCal, OvcEdTim;
-
-const
- scDefMinSize = 13;
-
-
-{$IFDEF NoAsm}
-function GetArrowWidth(Width, Height : Integer) : Integer;
-begin
- Result := Height;
- if Width < Height then
- Result := Width;
- Result := (Result SHR 1) OR 1;
-end;
-{$ELSE}
-function GetArrowWidth(Width, Height : Integer) : Integer; register;
-asm
- cmp eax, edx
- jle @@1
- mov eax, edx
-@@1:
- shr eax, 1
- or eax, 1
-end;
-{$ENDIF}
-
-{*** TOvcSpinner ***}
-
-constructor TOvcSpinner.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
- ControlStyle := ControlStyle + [csFramed, csOpaque];
- ControlStyle := ControlStyle + [csReplicatable];
-
- {initialize property variables}
- FAcceleration := 5;
- FAutoRepeat := True;
- FDelayTime := 500;
- FDelta := 1;
- FRepeatCount := 0;
- FShowArrows := True;
- FStyle := stNormalVertical;
- FWrapMode := True;
-
- Width := 16;
- Height := 25;
- TabStop := False;
-
- scCurrentState := ssNormal;
- scPrevState := ssNone;
- scMouseOverBtn := False;
-end;
-
-procedure TOvcSpinner.CreateParams(var Params : TCreateParams);
-begin
- inherited CreateParams(Params);
- ControlStyle := ControlStyle + [csOpaque] - [csFramed];
-
- if not (csDesigning in ComponentState) then
- ControlStyle := ControlStyle - [csDoubleClicks];
-end;
-
-destructor TOvcSpinner.Destroy;
-begin
- scDeleteRegions;
-
- inherited Destroy;
-end;
-
-procedure TOvcSpinner.DoOnClick(State : TOvcSpinState);
-var
- D : Double;
-begin
- if Assigned(FOnClick) or
- (Assigned(FFocusedControl) and
- ((FFocusedControl is TOvcBaseEntryField) or
- (FFocusedControl is TCustomEdit))) then begin
- if scMouseOverBtn then begin
- if LongInt(GetTickCount) > scNextMsgTime then begin
-
- {auto link with Orpheus entry fields}
- if Assigned(FFocusedControl) and (FFocusedControl is TOvcBaseEntryField) then begin
- case State of
- ssUpBtn : TOvcBaseEntryField(FFocusedControl).IncreaseValue(FWrapMode, Delta);
- ssDownBtn : TOvcBaseEntryField(FFocusedControl).DecreaseValue(FWrapMode, Delta);
- ssLeftBtn : TOvcBaseEntryField(FFocusedControl).MoveCaret(-1);
- ssRightBtn : TOvcBaseEntryField(FFocusedControl).MoveCaret(+1);
- end;
- end;
-
- {auto link with TCustomEdit controls}
- if Assigned(FFocusedControl) and (FFocusedControl is TCustomEdit) then begin
- try
- if (FFocusedControl is TOvcCustomDateEdit) then
- D := TOvcCustomDateEdit(FFocusedControl).Date
- else if (FFocusedControl is TOvcCustomTimeEdit) then
- D := TOvcCustomTimeEdit(FFocusedControl).AsMinutes
- else
- D := StrToFloat(TCustomEdit(FFocusedControl).Text);
-
- case State of
- ssUpBtn : D := D + Delta;
- ssDownBtn : D := D - Delta;
- end;
-
- if (FFocusedControl is TOvcCustomDateEdit) then
- TOvcCustomDateEdit(FFocusedControl).Date := D
- else if (FFocusedControl is TOvcCustomTimeEdit) then
- TOvcCustomTimeEdit(FFocusedControl).AsMinutes := trunc(D)
- else
- TCustomEdit(FFocusedControl).Text := FloatToStr(D);
- except
- end;
- end;
-
- {call OnClick event handler, if assigned}
- if Assigned(FOnClick) then
- FOnClick(Self, State, Delta, FWrapMode);
-
- {setup for next time}
- scNextMsgTime := LongInt(GetTickCount) + DelayTime - Acceleration*10*FRepeatCount;
- Inc(FRepeatCount);
- end;
- end;
- end;
-end;
-
-procedure TOvcSpinner.Loaded;
-begin
- inherited Loaded;
-
- scUpdateSizes;
-end;
-
-procedure TOvcSpinner.Notification(AComponent : TComponent; Operation : TOperation);
-begin
- inherited Notification(AComponent, Operation);
-
- if (AComponent = FFocusedControl) and (Operation = opRemove) then
- FocusedControl := nil;
-end;
-
-procedure TOvcSpinner.OMRecreateWnd(var Msg : TMessage);
-begin
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
-end;
-
-function TOvcSpinner.scCheckMousePos : TOvcSpinState;
-var
- P : TPoint;
-begin
- GetCursorPos(P);
- P := ScreenToClient(P);
-
- {see which button the mouse is over}
- Result := ssNone;
- if PtInRect(ClientRect, P) then begin
-{$IFDEF MSWINDOWS}
- if not (csClicked in ControlState) then
-{$ELSE} //csClicked not getting set with GTK
- if not (csLButtonDown in ControlState) then
-{$ENDIF}
- Result := ssNormal
-
- {mouse is over one of the buttons, which one?}
- else if (scUpRgn <> 0) and PtInRegion(scUpRgn, P.X, P.Y) then
- if (Style = stNormalHorizontal) then
- Result := ssRightBtn
- else
- Result := ssUpBtn
- else if (scDownRgn <> 0) and PtInRegion(scDownRgn, P.X, P.Y) then
- if (Style = stNormalHorizontal) then
- Result := ssLeftBtn
- else
- Result := ssDownBtn
- else if (scLeftRgn <> 0) and PtInRegion(scLeftRgn, P.X, P.Y) then
- Result := ssLeftBtn
- else if (scRightRgn <> 0) and PtInRegion(scRightRgn, P.X, P.Y) then
- Result := ssRightBtn
- else if (scCenterRgn <> 0) and PtInRegion(scCenterRgn, P.X, P.Y) then
- Result := ssCenterBtn
- else
- Result := ssNormal;
- end;
-end;
-
-procedure TOvcSpinner.scDeleteRegions;
-begin
- if scUpRgn <> 0 then begin
- DeleteObject(scUpRgn);
- scUpRgn := 0;
- end;
- if scDownRgn <> 0 then begin
- DeleteObject(scDownRgn);
- scDownRgn := 0;
- end;
- if scLeftRgn <> 0 then begin
- DeleteObject(scLeftRgn);
- scLeftRgn := 0;
- end;
- if scRightRgn <> 0 then begin
- DeleteObject(scRightRgn);
- scRightRgn := 0;
- end;
- if scCenterRgn <> 0 then begin
- DeleteObject(scCenterRgn);
- scCenterRgn := 0;
- end;
-end;
-
-procedure TOvcSpinner.scDoAutoRepeat;
-var
- NewState : TOvcSpinState;
-begin
- DoOnClick(scCurrentState);
-
- {don't auto-repeat for center button}
- if (scCurrentState = ssCenterBtn) or (not AutoRepeat) then begin
- repeat
- {allow other messages}
- Application.ProcessMessages;
-
- {until the mouse button is released}
-{$IFDEF MSWINDOWS}
- until ({$IFNDEF LCL} GetAsyncKeyState(scLButton) {$ELSE} GetKeyState(scLButton) {$ENDIF} and $8000) = 0;
-{$ELSE} //GTK GetKeyState returns 0
- until not (csLButtonDown in ControlState);
-{$ENDIF}
- scDoMouseUp;
- Exit;
- end;
-
- {repeat until left button released}
- repeat
- if AutoRepeat then
- DoOnClick(scCurrentState);
-
- {allow other messages}
- Application.ProcessMessages;
-
- {get new button/mouse state}
- NewState := scCheckMousePos;
-
- {has anything changed}
- if NewState <> scCurrentState then begin
- {the mouse is not over a button or its over a new one}
- scPrevState := scCurrentState;
- scCurrentState := NewState;
-
- {don't depress the center button if the mouse moves over it}
- if NewState = ssCenterBtn then
- scCurrentState := ssNormal;
-
- scMouseOverBtn := not (scCurrentState in [ssNone, ssNormal]);
-
- scInvalidateButton(scPrevState);
- scInvalidateButton(scCurrentState);
- end;
-
- {until the mouse button is released}
-{$IFDEF MSWINDOWS}
- until ({$IFNDEF LCL} GetAsyncKeyState(scLButton) {$ELSE} GetKeyState(scLButton) {$ENDIF} and $8000) = 0;
-{$ELSE} //GTK GetKeyState returns 0
- until not (csLButtonDown in ControlState);
-{$ENDIF}
- scDoMouseUp;
-end;
-
-procedure TOvcSpinner.scDoMouseDown(const XPos, YPos: Integer);
-begin
- scPrevState := scCurrentState;
-
- {find which button was clicked}
- scCurrentState := scCheckMousePos;
- scMouseOverBtn := True;
-
- scInvalidateButton(scPrevState);
- scInvalidateButton(scCurrentState);
-
- {initialize and start repeating}
- FRepeatCount := 0;
- scLButton := GetLeftButton;
- scNextMsgTime := GetTickCount-1;
- scDoAutoRepeat;
-end;
-
-procedure TOvcSpinner.scDoMouseUp;
-begin
- {save last state and redraw}
- scPrevState := scCurrentState;
- scCurrentState := ssNormal;
- scMouseOverBtn := False;
-
- scInvalidateButton(scPrevState);
- scInvalidateButton(scCurrentState);
- scDrawButton(False);
-end;
-
-procedure TOvcSpinner.scDrawArrow(const R: TRect; const Pressed: Boolean;
- const Direction: TOvcDirection);
-var
- ArrowWidth, ArrowHeight : Integer;
- X, Y : Integer;
- LeftPoint, RightPoint, PointPoint : TPoint;
- PLeftPoint, PRightPoint, PPointPoint : TPoint;
-begin
- if not FShowArrows then
- Exit;
-
- with Canvas do begin
- ArrowWidth := GetArrowWidth(R.Right-R.Left, R.Bottom-R.Top);
- ArrowHeight := (ArrowWidth + 1) div 2;
- if Direction in [dUp, dDown] then begin
- X := (R.Right-R.Left-ArrowWidth) div 2;
- Y := (R.Bottom-R.Top-ArrowHeight) div 2;
- end else begin
- X := (R.Right-R.Left-ArrowHeight) div 2;
- Y := (R.Bottom-R.Top-ArrowWidth) div 2;
- end;
- case Direction of
- dUp :
- begin
- LeftPoint := Point(R.Left + X, Y + ArrowHeight + R.Top - 1);
- RightPoint := Point(R.Left + X + ArrowWidth - 1, Y + ArrowHeight + R.Top -1 );
- PointPoint := Point(R.Left + X + (ArrowWidth div 2), Y + R.Top);
- end;
- dDown :
- begin
- LeftPoint := Point(R.Left + X, Y + R.Top);
- RightPoint := Point(R.Left + X + ArrowWidth - 1 , Y + R.Top);
- PointPoint := Point(R.Left + X + (ArrowWidth div 2), Y + ArrowHeight + R.Top - 1);
- end;
- dRight :
- begin
- LeftPoint := Point(R.Left + X, Y + R.Top);
- RightPoint := Point(R.Left + X, Y + ArrowWidth + R.Top - 1);
- PointPoint := Point(R.Left + X + ArrowHeight - 1, Y + (ArrowWidth div 2) + R.Top);
- end;
- dLeft :
- begin
- LeftPoint := Point(R.Left + X + ArrowHeight - 1, Y + R.Top);
- RightPoint := Point(R.Left + X + ArrowHeight - 1, Y + ArrowWidth - 1 + R.Top);
- PointPoint := Point(R.Left + X, Y + (ArrowWidth div 2) + R.Top);
- end;
- end;
- PLeftPoint.X := LeftPoint.X + 1;
- PLeftPoint.Y := LeftPoint.Y + 1;
- PRightPoint.X := RightPoint.X + 1;
- PRightPoint.Y := RightPoint.Y + 1;
- PPointPoint.X := PointPoint.X + 1;
- PPointPoint.Y := PointPoint.Y + 1;
- if Pressed then begin
- Pen.Color := clBtnFace;
- Brush.Color := clBtnFace;
- Polygon([LeftPoint, RightPoint, PointPoint]);
- Pen.Color := clBtnText;
- Brush.Color := clBtnText;
- Polygon([PLeftPoint, PRightPoint, PPointPoint]);
- end else begin
- Pen.Color := clBtnFace;
- Brush.Color := clBtnFace;
- Polygon([PLeftPoint, PRightPoint, PPointPoint]);
- Pen.Color := clBtnText;
- Brush.Color := clBtnText;
- Polygon([LeftPoint, RightPoint, PointPoint]);
- end;
- end;
-end;
-
-procedure TOvcSpinner.scDrawButton(const Redraw : Boolean);
-begin
- case FStyle of
- stDiagonalFourWay : scDrawDiagonalFourWay(Redraw);
- stDiagonalHorizontal : scDrawDiagonalHorizontal(Redraw);
- stDiagonalVertical : scDrawDiagonalVertical(Redraw);
- stFourWay : scDrawFourWayButton(Redraw);
- stNormalHorizontal : scDrawNormalButton(Redraw);
- stNormalVertical : scDrawNormalButton(Redraw);
- stPlainStar : scDrawPlainStar(Redraw);
- stStar : scDrawStarButton(Redraw);
- end;
-end;
-
-procedure TOvcSpinner.scDrawDiagonalFourWay(const Redraw : Boolean);
-
- procedure DrawBasicShape;
- begin
- with Canvas do begin
- Brush.Color := clBtnFace;
- Brush.Style := bsSolid;
- Pen.Color := clBtnFace;
- FillRect(Rect(scTopLeft.X, scTopLeft.Y, scBottomRight.X, scBottomRight.Y));
- scDrawLine(scBottomLeft4, scTopRight4, True, ltSingle);
- scDrawLine(scBottomLeft, scTopLeft, True, ltTopBevel);
- scDrawLine(scTopLeft, scTopRight, True, ltTopBevel);
- scDrawLine(scBottomLeft, scBottomRight, True, ltBottomBevel);
- scDrawLine(scBottomRight, scTopRight, True, ltBottomBevel);
- end;
- end;
-
- procedure DrawFace(State : TOvcSpinState; Up : Boolean);
- begin
- with Canvas do begin
- case State of
- ssUpBtn : begin
- scDrawArrow(Rect(Width Div 4, 0, Width Div 2, Height div 2), not(Up), dUp);
- scDrawLine(scTopLeft4, scTopRight4, Up, ltTopBevel);
- scDrawLine(scTopLeft4, scBottomLeft4, Up, ltDiagTopBevel);
- scDrawLine(scBottomLeft4, scTopRight4, Up, ltBottomSlice);
- end;
- ssDownBtn : begin
- scDrawArrow(Rect(Width Div 2, (Height+1) div 2, Width * 3 Div 4, Height), not(Up), dDown);
- scDrawLine(scBottomRight4, scBottomLeft4, Up, ltBottomBevel);
- scDrawLine(scTopRight4, scBottomRight4, Up, ltDiagBottomBevel);
- scDrawLine(scBottomLeft4, scTopRight4, Up, ltTopSlice);
- end;
- ssLeftBtn : begin
- scDrawArrow(Rect(0, 0, Width Div 4, Height), not(Up), dLeft);
- scDrawLine(scTopLeft, scTopLeft4, Up, ltTopBevel);
- scDrawLine(scTopLeft, scBottomLeft, Up, ltTopBevel);
- scDrawLine(scTopLeft4, scBottomLeft4, Up, ltBottomBevel);
- scDrawLine(scBottomLeft, scBottomLeft4, Up, ltBottomBevel);
- end;
- ssRightBtn : begin
- scDrawArrow(Rect(Width * 3 Div 4, 0, Width, Height), not(Up), dRight);
- scDrawLine(scTopRight4, scTopRight, Up, ltTopBevel);
- scDrawLine(scTopRight4, scBottomRight4, Up, ltTopBevel);
- scDrawLine(scTopRight, scBottomRight, Up, ltBottomBevel);
- scDrawLine(scBottomRight4, scBottomRight, Up, ltBottomBevel);
- end;
- end;
- end;
- end;
-
-begin
- with Canvas do begin
- if Redraw then begin
- DrawBasicShape;
- DrawFace(ssUpBtn, True);
- DrawFace(ssDownBtn, True);
- DrawFace(ssLeftBtn, True);
- DrawFace(ssRightBtn, True);
- end;
-
- if scPrevState <> scCurrentState then
- DrawFace(scPrevState, True);
- if scMouseOverBtn then
- DrawFace(scCurrentState, False);
- end;
-end;
-
-procedure TOvcSpinner.scDrawDiagonalHorizontal(const Redraw : Boolean);
-
- procedure DrawBasicShape;
- begin
- with Canvas do begin
- Brush.Color := clBtnFace;
- Brush.Style := bsSolid;
- Pen.Color := clBtnFace;
- FillRect(Rect(scTopLeft.X, scTopLeft.Y, scBottomRight.X, scBottomRight.Y));
- scDrawLine(scBottomLeft, scTopRight, True, ltSingle);
- scDrawLine(scBottomLeft, scTopLeft, True, ltTopBevel);
- scDrawLine(scTopLeft, scTopRight, True, ltTopBevel);
- scDrawLine(scBottomLeft, scBottomRight, True, ltBottomBevel);
- scDrawLine(scBottomRight, scTopRight, True, ltBottomBevel);
- end;
- end;
-
- procedure DrawFace(State : TOvcSpinState; Up : Boolean);
- begin
- with Canvas do begin
- case State of
- ssLeftBtn : begin
- scDrawArrow(Rect(0, 0, Width div 2, (Height div 2)), not(Up), dLeft);
- scDrawLine(scTopLeft, scTopRight, Up, ltTopBevel);
- scDrawLine(scTopLeft, scBottomLeft, Up, ltTopBevel);
- scDrawLine(scBottomLeft, scTopRight, Up, ltBottomSlice);
- end;
- ssRightBtn : begin
- scDrawArrow(Rect((Width+1) div 2, (Height+1) div 2, Width, Height), not(Up), dRight);
- scDrawLine(scBottomLeft, scBottomRight, Up, ltBottomBevel);
- scDrawLine(scTopRight, scBottomRight, Up, ltBottomBevel);
- scDrawLine(scBottomLeft, scTopRight, Up, ltTopSlice);
- end;
- end;
- end;
- end;
-
-begin
- with Canvas do begin
- if Redraw then begin
- DrawBasicShape;
- DrawFace(ssLeftBtn, True);
- DrawFace(ssRightBtn, True);
- end;
-
- if scPrevState <> scCurrentState then
- DrawFace(scPrevState, True);
- if scMouseOverBtn then
- DrawFace(scCurrentState, False);
- end;
-end;
-
-procedure TOvcSpinner.scDrawDiagonalVertical(const Redraw : Boolean);
-
- procedure DrawBasicShape;
- begin
- with Canvas do begin
- Brush.Color := clBtnFace;
- Brush.Style := bsSolid;
- Pen.Color := clBtnFace;
- FillRect(Rect(scTopLeft.X, scTopLeft.Y, scBottomRight.X, scBottomRight.Y));
- scDrawLine(scBottomLeft, scTopRight, True, ltSingle);
- scDrawLine(scBottomLeft, scTopLeft, True, ltTopBevel);
- scDrawLine(scTopLeft, scTopRight, True, ltTopBevel);
- scDrawLine(scBottomLeft, scBottomRight, True, ltBottomBevel);
- scDrawLine(scBottomRight, scTopRight, True, ltBottomBevel);
- end;
- end;
-
- procedure DrawFace(State : TOvcSpinState; Up : Boolean);
- begin
- with Canvas do begin
- case State of
- ssUpBtn : begin
- scDrawArrow(Rect(0, 0, Width div 2, (Height div 2)), not(Up), dUp);
- scDrawLine(scTopLeft, scTopRight, Up, ltTopBevel);
- scDrawLine(scTopLeft, scBottomLeft, Up, ltTopBevel);
- scDrawLine(scBottomLeft, scTopRight, Up, ltBottomSlice);
- end;
- ssDownBtn : begin
- scDrawArrow(Rect((Width+1) div 2, (Height+1) div 2, Width, Height), not(Up), dDown);
- scDrawLine(scBottomLeft, scBottomRight, Up, ltBottomBevel);
- scDrawLine(scTopRight, scBottomRight, Up, ltBottomBevel);
- scDrawLine(scBottomLeft, scTopRight, Up, ltTopSlice);
- end;
- end;
- end;
- end;
-
-begin
- with Canvas do begin
- if Redraw then begin
- DrawBasicShape;
- DrawFace(ssUpBtn, True);
- DrawFace(ssDownBtn, True);
- end;
-
- if scPrevState <> scCurrentState then
- DrawFace(scPrevState, True);
- if scMouseOverBtn then
- DrawFace(scCurrentState, False);
- end;
-end;
-
-procedure TOvcSpinner.scDrawFourWayButton(const Redraw : Boolean);
-
- procedure DrawBasicShape;
- begin
- with Canvas do begin
- Brush.Color := clBtnFace;
- Brush.Style := bsSolid;
- Pen.Color := clBtnFace;
- FillRect(Rect(scTopLeft.X, scTopLeft.Y, scBottomRight.X, scBottomRight.Y));
- scDrawLine(scTopLeft, scBottomRight, True, ltSingle);
- scDrawLine(scBottomLeft, scTopRight, True, ltSingle);
- scDrawLine(scBottomLeft, scTopLeft, True, ltTopBevel);
- scDrawLine(scTopLeft, scTopRight, True, ltTopBevel);
- scDrawLine(scBottomLeft, scBottomRight, True, ltBottomBevel);
- scDrawLine(scBottomRight, scTopRight, True, ltBottomBevel);
- end;
- end;
-
- procedure DrawFace(State : TOvcSpinState; Up : Boolean);
- begin
- with Canvas do begin
- case State of
- ssUpBtn : begin
- scDrawArrow(Rect(0, 0, Width, (Height div 3)), not(Up), dUp);
- scDrawLine(scTopLeft, scTopRight, Up, ltTopBevel);
- scDrawLine(scTopRight, scCenter, Up, ltBottomSliceSquare);
- scDrawLine(scTopLeft, scCenter, Up, ltBottomSliceSquare);
- end;
- ssDownBtn : begin
- scDrawArrow(Rect(0, Height - (Height div 3), Width, Height), not(Up), dDown);
- scDrawLine(scBottomLeft, scBottomRight, Up, ltBottomBevel);
- scDrawLine(scBottomLeft, scCenter, Up, ltTopSliceSquare);
- scDrawLine(scBottomRight, scCenter, Up, ltTopSliceSquare);
- end;
- ssLeftBtn : begin
- scDrawArrow(Rect(0, 0, (Width div 3), Height), not(Up), dLeft);
- scDrawLine(scTopLeft, scBottomLeft, Up, ltTopBevel);
- scDrawLine(scBottomLeft, scCenter, Up, ltBottomSliceSquare);
- scDrawLine(scTopLeft, scCenter, Up, ltTopSliceSquare);
- end;
- ssRightBtn : begin
- scDrawArrow(Rect(Width - (Width div 3), 0, Width, Height), not(Up), dRight);
- scDrawLine(scTopRight, scBottomRight, Up, ltBottomBevel);
- scDrawLine(scTopRight, scCenter, Up, ltTopSliceSquare);
- scDrawLine(scBottomRight, scCenter, Up, ltBottomSliceSquare);
- end;
- end;
- end;
- end;
-
-begin
- with Canvas do begin
- if Redraw then begin
- DrawBasicShape;
- DrawFace(ssUpBtn, True);
- DrawFace(ssDownBtn, True);
- DrawFace(ssLeftBtn, True);
- DrawFace(ssRightBtn, True);
- end;
-
- if scPrevState <> scCurrentState then
- DrawFace(scPrevState, True);
- if scMouseOverBtn then
- DrawFace(scCurrentState, False);
- end;
-end;
-
-procedure TOvcSpinner.scDrawLine(P1, P2 : TPoint; const Up : Boolean; LineType : TOvcSpinnerLineType);
- {-this routine draws a parallel line}
- {The Offset is required because of the nature of Bressenham's algorithm}
- {Negative Offsets are above the line, and Positive Offsets are Below}
-
- function GetSlope(const P1, P2 : TPoint) : Extended;
- var
- dX, dY : Integer;
- begin
- dY := (P1.y - P2.y);
- dX := (P1.x - P2.x);
-
- if (dX = 0) then
- if dY > 0 then
- Result := 999999.0
- else
- Result := -999999.0
- else
- Result := dY / dX;
- end;
-
- procedure DrawLine(P1, P2 : TPoint; Offset : Integer; const Square : Boolean);
- var
- Slope : Extended;
- P : TPoint;
- P1Square, P2Square : Boolean;
- begin
- P2Square := Square;
- P1Square := False;
- if P1.x > P2.X then begin
- P := P1;
- P1 := P2;
- P2 := P;
- P2Square := False;
- P1Square := Square;
- end;
-
- Slope := GetSlope(P1, P2);
-
- if Slope >= 0 then begin
- if P1.x > scTopMiddle.x then
- Offset := -Offset;
- end;
-
- if abs(Slope) <= 1 then begin
- if Slope = 0 then begin
- P1.y := P1.y + Offset;
- P2.y := P2.y + Offset;
- {these are to shorten the lines a little}
- P1.X := P1.X - Abs(Offset);
- P2.X := P2.X + Abs(Offset);
- end else if (Slope = 1) and (Offset > 0) then begin
- if P1Square then begin
- P1.X := P1.X + 0 * Abs(Offset);
- P1.y := P1.y + 1 * Abs(Offset);
- end else begin
- P1.X := P1.X + 2 * Abs(Offset);
- P1.y := P1.y + 3 * Abs(Offset);
- end;
- if P2Square then begin
- P2.X := P2.X - 1 * Abs(Offset);
- P2.y := P2.y - 0 * Abs(Offset);
- end else begin
- P2.X := P2.X - 3 * Abs(Offset);
- P2.y := P2.y - 2 * Abs(Offset);
- end;
- end else if (Slope = 1) and (Offset < 0) then begin
- if P1Square then begin
- P1.X := P1.X + 1 * Abs(Offset);
- P1.y := P1.y + 0 * Abs(Offset);
- end else begin
- P1.X := P1.X + 3 * Abs(Offset);
- P1.y := P1.y + 2 * Abs(Offset);
- end;
- if P2Square then begin
- P2.X := P2.X - 0 * Abs(Offset);
- P2.y := P2.y - 1 * Abs(Offset);
- end else begin
- P2.X := P2.X - 2 * Abs(Offset);
- P2.y := P2.y - 3 * Abs(Offset);
- end;
- end else if (Slope = -1) and (Offset > 0) then begin
- if P1Square then begin
- P1.X := P1.X + 1 * Abs(Offset);
- P1.y := P1.y - 0 * Abs(Offset);
- end else begin
- P1.X := P1.X + 3 * Abs(Offset);
- P1.y := P1.y - 2 * Abs(Offset);
- end;
- if P2Square then begin
- P2.X := P2.X - 0 * Abs(Offset);
- P2.y := P2.y + 1 * Abs(Offset);
- end else begin
- P2.X := P2.X - 2 * Abs(Offset);
- P2.y := P2.y + 3 * Abs(Offset);
- end;
- end else if (Slope = -1) and (Offset < 0) then begin
- if P1Square then begin
- P1.X := P1.X + 0 * Abs(Offset);
- P1.y := P1.y - 1 * Abs(Offset);
- end else begin
- P1.X := P1.X + 2 * Abs(Offset);
- P1.y := P1.y - 3 * Abs(Offset);
- end;
- if P2Square then begin
- P2.X := P2.X - 1 * Abs(Offset);
- P2.y := P2.y + 0 * Abs(Offset);
- end else begin
- P2.X := P2.X - 3 * Abs(Offset);
- P2.y := P2.y + 2 * Abs(Offset);
- end;
- end else begin
- P1.y := P1.y + Offset;
- P2.y := P2.y + Offset;
- end;
- end else begin
- P1.x := P1.x + Offset;
- P2.x := P2.x + Offset;
- if ((P1.x - P2.x) = 0) then begin
- {These are to shorten the lines a little}
- if (P1.y - P2.y) > 0 then begin
- P1.Y := P1.Y - Abs(Offset);
- P2.Y := P2.Y + Abs(Offset);
- end else begin
- P1.Y := P1.Y + Abs(Offset);
- P2.Y := P2.Y - Abs(Offset);
- end;
- end;
- end;
- scPolyLine([P1, P2]);
- end;
-
-const
- BtnColor : array[Boolean, 0..7] of TColor = (
- (clBtnShadow, clBtnShadow, clBtnFace,
- clBtnHighlight, clWindowFrame, clBtnHighLight, clRed, clWindowFrame),
- (clBtnHighlight, clBtnFace, clBtnShadow,
- clWindowFrame, clBtnHighlight, clBtnFace, clGreen, clWindowFrame));
- SpinnerLines : array[TOvcSpinnerLineType, 0..1] of -1..7 = (
- (7, -1), {ltSingle}
- (4, 1), {ltTopBevel}
- (3, 2), {ltBottomBevel}
- (4, 7), {ltTopSlice}
- (3, 7), {ltBottomSlice}
- (4, 7), {ltTopSliceSquare}
- (3, 7), {ltBottomSliceSquare}
- (4, 1), {ltDiagTopBevel}
- (3, 2), {ltDiagBottomBevel}
- (0, -1), {ltStarLine0}
- (3, -1), {ltStarLine1}
- (4, 1), {ltStarLine2}
- (3, 2), {ltStarLine3}
- (4, 7), {ltStarLine4}
- (2, 7) {ltStarLine5}
- );
-
-{ComplementLine is used for shading the Left/Right Lines}
- ComplementLine : array[TOvcSpinnerLineType] of TOvcSpinnerLineType = (
- ltSingle, {ltSingle}
- ltTopBevel, {ltTopBevel}
- ltBottomBevel, {ltBottomBevel}
- ltBottomSlice, {ltTopSlice}
- ltTopSlice, {ltBottomSlice}
- ltBottomSliceSquare, {ltTopSliceSquare}
- ltTopSliceSquare, {ltBottomSliceSquare}
- ltDiagBottomBevel, {ltDiagTopBevel}
- ltDiagTopBevel, {ltDiagBottomBevel}
- ltStarLine1, {ltStarLine0}
- ltStarLine0, {ltStarLine1}
- ltStarLine3, {ltStarLine2}
- ltStarLine2, {ltStarLine3}
- ltStarLine5, {ltStarLine4}
- ltStarLine4 {ltStarLine5}
- );
-
-var
- DrawSquare : Boolean;
- Offset : Integer;
-
-begin
- with Canvas do begin
-{if the line is on the other side then ComplementLine}
- if (GetSlope(P1, P2) > 1) then
- linetype := ComplementLine[LineType];
-
- Pen.Color := BtnColor[Up, SpinnerLines[LineType, 0]];
- DrawSquare := False;
- Offset := 0;
-
- case LineType of
- ltTopSlice :
- begin
- Offset := 1;
- end;
- ltBottomSlice :
- begin
- Offset := -1;
- end;
- ltTopSliceSquare :
- begin
- DrawSquare := True;
- Offset := 1;
- end;
- ltBottomSliceSquare :
- begin
- DrawSquare := True;
- Offset := -1;
- end;
- ltDiagTopBevel :
- begin
- Offset := 1;
- end;
- ltDiagBottomBevel :
- begin
- Offset := -1;
- end;
- ltStarLine2 :
- begin
- if P1.X = P2.X then begin
- Inc(P1.X);Inc(P1.y);Inc(P2.X);Dec(P2.y);
- end else begin
- Inc(P1.X);Inc(P1.y);Dec(P2.X);Inc(P2.y);
- end;
- end;
- ltStarLine3 :
- begin
- if P1.X = P2.X then begin
- Dec(P1.X);Inc(P1.y);Dec(P2.X);Dec(P2.y);
- end else begin
- Inc(P1.X);Dec(P1.y);Dec(P2.X);Dec(P2.y);
- end;
- end;
- ltStarLine4 :
- begin
- DrawSquare := True;
- Offset := 1;
- end;
- ltStarLine5 :
- begin
- DrawSquare := True;
- Offset := -1;
- end;
- end;
-
- DrawLine(P1, P2, Offset, DrawSquare);
-
- if SpinnerLines[LineType, 1] = -1 then
- Exit;
-
- Pen.Color := BtnColor[Up, SpinnerLines[LineType, 1]];
- DrawSquare := False;
- Offset := 0;
-
- case LineType of
- ltTopBevel :
- begin
- Offset := 1;
- end;
- ltBottomBevel :
- begin
- Offset := -1;
- end;
- ltTopSliceSquare :
- begin
- DrawSquare := True;
- end;
- ltBottomSliceSquare :
- begin
- DrawSquare := True;
- end;
- ltDiagTopBevel :
- begin
- Offset := 2;
- end;
- ltDiagBottomBevel :
- begin
- Offset := -2;
- end;
- ltStarLine2 :
- begin
- if P1.X = P2.X then begin
- Inc(P1.X);Inc(P1.y);Inc(P2.X);Dec(P2.y);
- end else begin
- Inc(P1.X);Inc(P1.y);Dec(P2.X);Inc(P2.y);
- end;
- end;
- ltStarLine3 :
- begin
- if P1.X = P2.X then begin
- Dec(P1.X);Inc(P1.y);Dec(P2.X);Dec(P2.y);
- end else begin
- Inc(P1.X);Dec(P1.y);Dec(P2.X);Dec(P2.y);
- end;
- end;
- end;
-
- DrawLine(P1, P2, Offset, DrawSquare);
- end;
-end;
-
-procedure TOvcSpinner.scDrawNormalButton(const Redraw : Boolean);
-var
- TopPressed : Boolean;
- BottomPressed : Boolean;
- UpRect : TRect;
- DownRect : TRect;
-
-begin
-{$IFDEF MSWINDOWS}
- if (csClicked in ControlState) and scMouseOverBtn then begin
-{$ELSE} //csClicked not getting set with GTK
- if (csLButtonDown in ControlState) and scMouseOverBtn then begin
-{$ENDIF}
- TopPressed := (scCurrentState in [ssUpBtn, ssRightBtn]);
- BottomPressed := (scCurrentState in [ssDownBtn, ssLeftBtn]);
- end else begin
- TopPressed := False;
- BottomPressed := False;
- end;
-{$IFNDEF LCL}
- GetRgnBox(scUpRgn, UpRect);
- GetRgnBox(scDownRgn, DownRect);
-{$ELSE}
- MyMisc.GetRgnBox(scUpRgn, @UpRect);
- MyMisc.GetRgnBox(scDownRgn, @DownRect);
-{$ENDIF}
- if FStyle = stNormalVertical then begin
- Inc(UpRect.Right);
- Inc(UpRect.Bottom);
- Inc(DownRect.Top);
- end else begin
- Inc(UpRect.Bottom);
- Dec(DownRect.Right);
- end;
- Inc(DownRect.Bottom);
- Inc(DownRect.Right);
- DrawButtonFace(Canvas, UpRect, 1, bsNew, False, TopPressed, False);
- DrawButtonFace(Canvas, DownRect, 1, bsNew, False, BottomPressed, False);
- if FStyle = stNormalVertical then begin
- scDrawArrow(UpRect, TopPressed, dUp);
- scDrawArrow(DownRect, BottomPressed, dDown);
- end else begin
- scDrawArrow(UpRect, TopPressed, dRight);
- scDrawArrow(DownRect, BottomPressed, dLeft);
- end;
-end;
-
-procedure TOvcSpinner.scDrawPlainStar(const Redraw : Boolean);
-var
- PC : TColor;
-
- procedure DrawBasicShape;
- begin
- with Canvas do begin
- Pen.Color := clWindowFrame;
- Brush.Color := PC;
- Brush.Style := bsSolid;
- FillRect(Rect(scTopLeft.X, scTopLeft.Y, scBottomRight.X, scBottomRight.Y));
- end;
- end;
-
- procedure DrawFace(State : TOvcSpinState; Up : Boolean);
- begin
- with Canvas do begin
- case State of
- ssUpBtn :
- begin
- scDrawArrow(Rect(scTopLeftCenter.X, scTopMiddle.Y, scTopRightCenter.X, scCenter.Y), not(Up), dUp);
- scDrawLine(scTopMiddle, scTopRightCenter, Up, ltStarLine0);
- scDrawLine(scTopRightCenter, scCenter, Up, ltStarLine5);
- scDrawLine(scCenter, scTopLeftCenter, Up, ltStarLine5);
- scDrawLine(scTopMiddle, scTopLeftCenter, Up, ltStarLine0);
- end;
- ssDownBtn :
- begin
- scDrawArrow(Rect(scBottomLeftCenter.X, scCenter.Y, scBottomRightCenter.X, scBottomMiddle.Y), not(Up), dDown);
- scDrawLine(scBottomMiddle, scBottomLeftCenter, Up, ltStarLine1);
- scDrawLine(scCenter, scBottomLeftCenter, Up, ltStarLine4);
- scDrawLine(scBottomRightCenter, scCenter, Up, ltStarLine4);
- scDrawLine(scBottomMiddle, scBottomRightCenter, Up, ltStarLine1);
- end;
- ssLeftBtn :
- begin
- scDrawArrow(Rect(scLeftMiddle.X, scTopLeftCenter.Y, scCenter.X, scBottomLeftCenter.Y), not(Up), dLeft);
- scDrawLine(scLeftMiddle, scTopLeftCenter, Up, ltStarLine0);
- scDrawLine(scTopLeftCenter, scCenter, Up, ltStarLine4);
- scDrawLine(scCenter, scBottomLeftCenter, Up, ltStarLine5);
- scDrawLine(scBottomLeftCenter, scLeftMiddle, Up, ltStarLine1);
- end;
- ssRightBtn :
- begin
- scDrawArrow(Rect(scCenter.X, scTopRightCenter.Y, scRightMiddle.X, scBottomRightCenter.Y),not(Up), dRight);
- scDrawLine(scCenter, scTopRightCenter, Up, ltStarLine4);
- scDrawLine(scTopRightCenter, scRightMiddle, Up, ltStarLine0);
- scDrawLine(scRightMiddle, scBottomRightCenter, Up, ltStarLine1);
- scDrawLine(scBottomRightCenter, scCenter, Up, ltStarLine5);
- end;
- end;
- end;
- end;
-
-begin
- {get current parent color}
- {$IFDEF VERSION5}
- if (Parent is TCustomForm) then
- PC := TForm(Parent).Color
- else if (Parent is TCustomFrame) then
- PC := TFrame(Parent).Color
- {$ELSE}
- if Parent is TForm then
- PC := TForm(Parent).Color
- {$ENDIF}
- else
- PC := Color;
-
- with Canvas do begin
- if Redraw then begin
- DrawBasicShape;
- DrawFace(ssUpBtn, True);
- DrawFace(ssDownBtn, True);
- DrawFace(ssLeftBtn, True);
- DrawFace(ssRightBtn, True);
- end;
-
- if scPrevState <> scCurrentState then
- DrawFace(scPrevState, True);
- if scMouseOverBtn then
- DrawFace(scCurrentState, False);
- end;
-end;
-
-procedure TOvcSpinner.scDrawStarButton(const Redraw : Boolean);
-var
- PC : TColor;
-
- procedure DrawBasicShape;
- begin
- with Canvas do begin
- Pen.Color := clWindowFrame;
- Brush.Color := PC;
- Brush.Style := bsSolid;
- FillRect(Rect(scTopLeft.X, scTopLeft.Y,
- scBottomRight.X, scBottomRight.Y));
- end;
- end;
-
- procedure DrawFace(State : TOvcSpinState; Up : Boolean);
- begin
- with Canvas do begin
- case State of
- ssUpBtn :
- begin
- scDrawArrow(Rect(scTopLeftCenter.X, scTopMiddle.Y,
- scTopRightCenter.X, scTopLeftCenter.Y), not(Up), dUp);
- scDrawLine(scTopMiddle, scTopRightCenter, Up, ltStarLine0);
- scDrawLine(scTopRightCenter, scTopLeftCenter, Up, ltStarLine1);
- scDrawLine(scTopMiddle, scTopLeftCenter, Up, ltStarLine0);
- end;
- ssDownBtn :
- begin
- scDrawArrow(Rect(scBottomLeftCenter.X, scBottomLeftCenter.Y,
- scBottomRightCenter.X, scBottomMiddle.Y),not(Up), dDown);
- scDrawLine(scBottomMiddle, scBottomLeftCenter, Up, ltStarLine1);
- scDrawLine(scBottomRightCenter, scBottomLeftCenter, Up, ltStarLine0);
- scDrawLine(scBottomMiddle, scBottomRightCenter, Up, ltStarLine1);
- end;
- ssLeftBtn :
- begin
- scDrawArrow(Rect(scLeftMiddle.X, scTopLeftCenter.Y,
- scTopLeftCenter.X, scBottomLeftCenter.Y), not(Up), dLeft);
- scDrawLine(scLeftMiddle, scTopLeftCenter, Up, ltStarLine0);
- scDrawLine(scTopLeftCenter, scBottomLeftCenter, Up, ltStarLine1);
- scDrawLine(scBottomLeftCenter, scLeftMiddle, Up, ltStarLine1);
- end;
- ssRightBtn :
- begin
- scDrawArrow(Rect(scTopRightCenter.X, scTopRightCenter.Y,
- scRightMiddle.X, scBottomRightCenter.Y), not(Up), dRight);
- scDrawLine(scTopRightCenter, scBottomRightCenter, Up, ltStarLine0);
- scDrawLine(scRightMiddle, scTopRightCenter, Up, ltStarLine0);
- scDrawLine(scBottomRightCenter, scRightMiddle, Up, ltStarLine1);
- end;
- ssCenterBtn :
- begin
- scDrawLine(scTopLeftCenter, scTopRightCenter, Up, ltStarLine2);
- scDrawLine(scTopLeftCenter, scBottomLeftCenter, Up, ltStarLine2);
- scDrawLine(scTopRightCenter, scBottomRightCenter, Up, ltStarLine3);
- scDrawLine(scBottomLeftCenter, scBottomRightCenter, Up, ltStarLine3);
- end;
- end;
- end;
- end;
-
-begin
- {get current parent color}
- {$IFDEF VERSION5}
- if (Parent is TCustomForm) then
- PC := TForm(Parent).Color
- else if (Parent is TCustomFrame) then
- PC := TFrame(Parent).Color
- {$ELSE}
- if Parent is TForm then
- PC := TForm(Parent).Color
- {$ENDIF}
- else
- PC := Color;
-
- with Canvas do begin
- if Redraw then begin
- DrawBasicShape;
- DrawFace(ssUpBtn, True);
- DrawFace(ssDownBtn, True);
- DrawFace(ssLeftBtn, True);
- DrawFace(ssRightBtn, True);
- DrawFace(ssCenterBtn, True);
- end;
-
- if scPrevState <> scCurrentState then
- DrawFace(scPrevState, True);
- if scMouseOverBtn then
- DrawFace(scCurrentState, False);
- end;
-end;
-
-procedure TOvcSpinner.scInvalidateButton(const State : TOvcSpinState);
-begin
- case State of
- ssUpBtn : InvalidateRgn(Handle, scUpRgn, False);
- ssDownBtn : InvalidateRgn(Handle, scDownRgn, False);
- ssLeftBtn : InvalidateRgn(Handle, scLeftRgn, False);
- ssRightBtn : InvalidateRgn(Handle, scRightRgn, False);
- ssCenterBtn : InvalidateRgn(Handle, scCenterRgn, False);
- end;
-end;
-
-procedure TOvcSpinner.scPolyline(const Points: array of TPoint);
-begin
- Canvas.Polyline(Points);
- with Points[High(Points)] do
- Canvas.Pixels[X,Y] := Canvas.Pen.Color;
-end;
-
-procedure TOvcSpinner.scUpdateNormalSizes;
-var
- scHeight : Integer; {Height of client area}
- scWidth : Integer; {Width of client area}
-begin
- {get size of client area}
- scWidth := scBottomRight.X;
- scHeight := scBottomRight.Y;
-
- {setup the TRect structures with new sizes}
- if FStyle = stNormalVertical then begin
- scUpRgn := CreateRectRgn(0, 0, scWidth, scHeight div 2);
- scDownRgn := CreateRectRgn(0, scHeight div 2, scWidth, scHeight);
- end else begin
- scUpRgn := CreateRectRgn(scWidth div 2, 0, scWidth, scHeight);
- scDownRgn := CreateRectRgn(0, 0, scWidth div 2, scHeight);
- end;
-end;
-
-procedure TOvcSpinner.scUpdateFourWaySizes;
-var
- Points : array[0..2] of TPoint;
-begin
- Points[0] := scTopLeft;
- Points[1] := scTopRight;
- Points[2] := scCenter;
- scUpRgn := CreatePolygonRgn(Points, 3, ALTERNATE);
-
- Points[0] := scBottomLeft;
- Points[1] := scCenter;
- Points[2] := scBottomRight;
- scDownRgn := CreatePolygonRgn(Points, 3, ALTERNATE);
-
- Points[0] := scTopLeft;
- Points[1] := scCenter;
- Points[2] := scBottomLeft;
- scLeftRgn := CreatePolygonRgn(Points, 3, ALTERNATE);
-
- Points[0] := scTopRight;
- Points[1] := scBottomRight;
- Points[2] := scCenter;
- scRightRgn := CreatePolygonRgn(Points, 3, ALTERNATE);
-end;
-
-procedure TOvcSpinner.scUpdateStarSizes;
-var
- Points : array[0..3] of TPoint;
-begin
- {up}
- Points[0] := scTopMiddle;
- Points[1] := scTopRightCenter;
- Points[2] := scTopLeftCenter;
- scUpRgn := CreatePolygonRgn(Points, 3, ALTERNATE);
-
- {down}
- Points[0] := scBottomMiddle;
- Points[1] := scBottomLeftCenter;
- Points[2] := scBottomRightCenter;
- scDownRgn := CreatePolygonRgn(Points, 3, ALTERNATE);
-
- {left}
- Points[0] := scLeftMiddle;
- Points[1] := scTopLeftCenter;
- Points[2] := scBottomLeftCenter;
- scLeftRgn := CreatePolygonRgn(Points, 3, ALTERNATE);
-
- {right}
- Points[0] := scRightMiddle;
- Points[1] := scBottomRightCenter;
- Points[2] := scTopRightCenter;
- scRightRgn := CreatePolygonRgn(Points, 3, ALTERNATE);
-
- {center}
- Points[0] := scTopLeftCenter;
- Points[1] := scTopRightCenter;
- Points[2] := scBottomRightCenter;
- Points[3] := scBottomLeftCenter;
- scCenterRgn := CreatePolygonRgn(Points, 4, ALTERNATE);
-end;
-
-procedure TOvcSpinner.scUpdateDiagonalVerticalSizes;
-var
- Points : array[0..2] of TPoint;
-begin
- Points[0] := scTopLeft;
- Points[1] := scTopRight;
- Points[2] := scBottomLeft;
- scUpRgn := CreatePolygonRgn(Points, 3, ALTERNATE);
-
- Points[0] := scBottomLeft;
- Points[1] := scTopRight;
- Points[2] := scBottomRight;
- scDownRgn := CreatePolygonRgn(Points, 3, ALTERNATE);
-end;
-
-procedure TOvcSpinner.scUpdateDiagonalHorizontalSizes;
-var
- Points : array[0..2] of TPoint;
-begin
- Points[0] := scTopLeft;
- Points[1] := scTopRight;
- Points[2] := scBottomLeft;
- scLeftRgn := CreatePolygonRgn(Points, 3, ALTERNATE);
-
- Points[0] := scBottomLeft;
- Points[1] := scTopRight;
- Points[2] := scBottomRight;
- scRightRgn := CreatePolygonRgn(Points, 3, ALTERNATE);
-end;
-
-procedure TOvcSpinner.scUpdateDiagonalFourWaySizes;
-var
- Points : array[0..3] of TPoint;
-begin
- Points[0] := scTopLeft4;
- Points[1] := scTopRight4;
- Points[2] := scBottomLeft4;
- scUpRgn := CreatePolygonRgn(Points, 3, ALTERNATE);
-
- Points[0] := scTopRight4;
- Points[1] := scBottomRight4;
- Points[2] := scBottomLeft4;
- scDownRgn := CreatePolygonRgn(Points, 3, ALTERNATE);
-
- Points[0] := scTopLeft;
- Points[1] := scTopLeft4;
- Points[2] := scBottomLeft4;
- Points[3] := scBottomLeft;
- scLeftRgn := CreatePolygonRgn(Points, 4, ALTERNATE);
-
- Points[0] := scTopRight4;
- Points[1] := scTopRight;
- Points[2] := scBottomRight;
- Points[3] := scBottomRight4;
- scRightRgn := CreatePolygonRgn(Points, 4, ALTERNATE);
-end;
-
-procedure TOvcSpinner.scUpdatePlainStarSizes;
-var
- Points : array[0..3] of TPoint;
-begin
- Points[0] := scTopMiddle;
- Points[1] := scTopRightCenter;
- Points[2] := scCenter;
- Points[3] := scTopLeftCenter;
- scUpRgn := CreatePolygonRgn(Points, 4, ALTERNATE);
-
- Points[0] := scBottomLeftCenter;
- Points[1] := scCenter;
- Points[2] := scBottomRightCenter;
- Points[3] := scBottomMiddle;
- scDownRgn := CreatePolygonRgn(Points, 4, ALTERNATE);
-
- Points[0] := scLeftMiddle;
- Points[1] := scTopLeftCenter;
- Points[2] := scCenter;
- Points[3] := scBottomLeftCenter;
- scLeftRgn := CreatePolygonRgn(Points, 4, ALTERNATE);
-
- Points[0] := scTopRightCenter;
- Points[1] := scRightMiddle;
- Points[2] := scBottomRightCenter;
- Points[3] := scCenter;
- scRightRgn := CreatePolygonRgn(Points, 4, ALTERNATE);
-end;
-
-procedure TOvcSpinner.scUpdateSizes;
-begin
- {store info about button locations}
- scDeleteRegions;
-
- case FStyle of
- stNormalVertical : scUpdateNormalSizes;
- stNormalHorizontal : scUpdateNormalSizes;
- stFourWay : scUpdateFourWaySizes;
- stStar : scUpdateStarSizes;
- stDiagonalVertical : scUpdateDiagonalVerticalSizes;
- stDiagonalHorizontal : scUpdateDiagonalHorizontalSizes;
- stDiagonalFourWay : scUpdateDiagonalFourWaySizes;
- stPlainStar : scUpdatePlainStarSizes;
- end;
-end;
-
-procedure TOvcSpinner.Paint;
-begin
- scDrawButton(True);
-end;
-
-procedure TOvcSpinner.SetAcceleration(const Value : Integer);
-begin
- if Value <= 10 then
- FAcceleration := Value;
-end;
-
-{ - Added}
-procedure TOvcSpinner.SetAutoRepeat(Value: Boolean);
-begin
- FAutoRepeat := Value;
- if FAutoRepeat and not (csLoading in ComponentState) then
- scDoAutoRepeat;
-end;
-
-procedure TOvcSpinner.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
-var
- L, T, H, W : Integer;
-begin
- if (csDesigning in ComponentState) and not (csLoading in ComponentState) then begin
- {limit smallest size}
- if AWidth < scDefMinSize then
- AWidth := scDefMinSize ;
- if AHeight < scDefMinSize then
- AHeight := scDefMinSize ;
- end;
-
- L := Left;
- T := Top;
- H := Height;
- W := Width;
-
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-
- if (L <> Left) or (T <> Top) or (H <> Height) or (W <> Width) then begin
-
- scTopLeft := Point(0 , 0 );
- scTopRight := Point(Width-1 , 0 );
- scBottomLeft := Point(0 , Height-1);
- scBottomRight := Point(Width-1 , Height-1);
- scCenter := Point(Width div 2 , Height div 2 );
-
- scTopLeftCenter := Point(Width * 1 div 3 , Height * 1 div 3 );
- scBottomLeftCenter := Point(Width * 1 div 3 , Height * 2 div 3 );
- scTopRightCenter := Point(Width * 2 div 3 , Height * 1 div 3 );
- scBottomRightCenter:= Point(Width * 2 div 3 , Height * 2 div 3 );
-
- scTopMiddle := Point(Width div 2 , 0 );
- scBottomMiddle:= Point(Width div 2 , Height - 1 );
- scLeftMiddle := Point(0 , Height div 2 );
- scRightMiddle := Point(Width - 1 , Height div 2 );
-
- scTopLeft4 := Point(Width div 4 , 0 );
- scBottomLeft4 := Point(Width div 4 , Height - 1 );
- scTopRight4 := Point(Width * 3 div 4, 0 );
- scBottomRight4:= Point(Width * 3 div 4, Height - 1 );
- end;
-
- {update sizes of control and button regions}
- scUpdateSizes;
-
- if HandleAllocated then
- Invalidate;
-end;
-
-procedure TOvcSpinner.SetShowArrows(const Value : Boolean);
-begin
- if Value <> FShowArrows then begin
- FShowArrows := Value;
- Invalidate;
- end;
-end;
-
-procedure TOvcSpinner.SetStyle(Value : TOvcSpinnerStyle);
-begin
- if Value <> FStyle then begin
- FStyle := Value;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- if not (csLoading in ComponentState) then
- SetBounds(Left, Top, Width, Height); {force resize}
- end;
-end;
-
-procedure TOvcSpinner.WMGetDlgCode(var Msg : TWMGetDlgCode);
-begin
- {tell windows we are a static control to avoid receiving the focus}
- Msg.Result := DLGC_STATIC;
-end;
-
-procedure TOvcSpinner.WMLButtonDown(var Msg : TWMLButtonDown);
-begin
- inherited;
-
- if Assigned(FFocusedControl) then begin
- if GetFocus <> FFocusedControl.Handle then begin
- {set focus to ourself to force field validation}
- SetFocus;
-
- {allow message processing}
- Application.ProcessMessages;
-
- {if we didn't keep the focus, something must have happened--exit}
- if (GetFocus <> Handle) then
- Exit;
- end;
-
- if GetFocus <> FFocusedControl.Handle then
- if FFocusedControl.CanFocus then
- FFocusedControl.SetFocus;
- end;
-
- try
- scDoMouseDown(Msg.XPos, Msg.YPos);
- except
- scDoMouseUp;
- raise;
- end;
-end;
-
-procedure TOvcSpinner.WMLButtonUp(var Msg : TWMLButtonUp);
-begin
- inherited;
- scDoMouseUp;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovcsf.pas b/Source/3rdParty/Orpheus/ovcsf.pas
deleted file mode 100644
index 8c4ade61..00000000
--- a/Source/3rdParty/Orpheus/ovcsf.pas
+++ /dev/null
@@ -1,2048 +0,0 @@
-{*********************************************************}
-{* OVCSF.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 ovcsf;
- {-Simple field visual component}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Classes, Controls, Graphics, SysUtils,
- OvcBase, OvcColor, OvcCaret, OvcConst, OvcData, OvcEF, OvcExcpt,
- OvcIntl, OvcMisc, OvcStr;
-
-type
- {simple field type names}
- TSimpleDataType = (
- sftString, sftChar, sftBoolean, sftYesNo,
- sftLongInt, sftWord, sftInteger, sftByte, sftShortInt,
- sftReal, sftExtended, sftDouble, sftSingle, sftComp);
-
-type
- TOvcCustomSimpleField = class(TOvcBaseEntryField)
- {.Z+}
- protected {private}
- {property instance variables}
- FSimpleDataType : TSimpleDataType; {data type for this field}
- FPictureMask : AnsiChar; {picture mask name}
-
- function sfGetDataType(Value : TSimpleDataType) : Byte;
- {-return a Byte value representing the type of this field}
- procedure sfResetFieldProperties(FT : TSimpleDataType);
- {-reset field properties}
- procedure sfSetDefaultRanges;
- {-set default range values based on the field type}
-
- protected
- procedure CreateWnd;
- override;
-
- procedure efEdit(var Msg : TMessage; Cmd : Word);
- override;
- {-process the specified editing command}
- function efGetDisplayString(Dest : PAnsiChar; Size : Word) : PAnsiChar;
- override;
- {-return the display string in Dest and a pointer as the result}
- procedure efIncDecValue(Wrap : Boolean; Delta : Double);
- override;
- {-increment field by Delta}
- function efTransfer(DataPtr : Pointer; TransferFlag : Word) : Word;
- override;
- {-transfer data to/from the entry fields}
-
- {virtual property methods}
- procedure sfSetDataType(Value : TSimpleDataType);
- virtual;
- {-set the data type for this field}
- procedure sfSetPictureMask(Value: AnsiChar);
- virtual;
- {-set the picture mask}
-
- public
- procedure Assign(Source : TPersistent);
- override;
- constructor Create(AOwner: TComponent);
- override;
-
- function efValidateField : Word;
- override;
- {-validate contents of field; result is error code or 0}
- {.Z-}
-
- {public properties}
- property DataType : TSimpleDataType
- read FSimpleDataType
- write sfSetDataType;
-
- property PictureMask : AnsiChar
- read FPictureMask
- write sfSetPictureMask;
-
- end;
-
- TOvcSimpleField = class(TOvcCustomSimpleField)
- published
- {inherited properties}
- property DataType; {needs to loaded before most other properties}
- {$IFDEF VERSION4}
- property Anchors;
- property Constraints;
- property DragKind;
- {$ENDIF}
- property AutoSize;
- property BorderStyle;
- property CaretIns;
- property CaretOvr;
- property Color;
- property ControlCharColor;
- property Controller;
- property Ctl3D;
- property Borders;
- property DecimalPlaces;
- property DragCursor;
- property DragMode;
- property EFColors;
- property Enabled;
- property Font;
- property LabelInfo;
- property MaxLength;
- property Options;
- property PadChar;
- property ParentColor;
-{$IFNDEF LCL}
- property ParentCtl3D;
-{$ENDIF}
- property ParentFont;
- property ParentShowHint;
- property PasswordChar;
- property PictureMask;
- property PopupMenu;
- property RangeHi stored False;
- property RangeLo stored False;
- property ShowHint;
- property TabOrder;
- property TabStop default True;
- property Tag;
- property TextMargin;
- property Uninitialized;
- property Visible;
- property ZeroDisplay;
- property ZeroDisplayValue;
-
- {inherited events}
- property AfterEnter;
- property AfterExit;
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnError;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDrag;
- property OnMouseWheel;
- property OnUserCommand;
- property OnUserValidation;
- end;
-
-implementation
-
-{*** TOvcCustomSimpleField ***}
-
-procedure TOvcCustomSimpleField.Assign(Source : TPersistent);
-var
- SF : TOvcCustomSimpleField absolute Source;
-begin
- if (Source <> nil) and (Source is TOvcCustomSimpleField) then begin
- DataType := SF.DataType;
- AutoSize := SF.AutoSize;
- BorderStyle := SF.BorderStyle;
- Color := SF.Color;
- ControlCharColor := SF.ControlCharColor;
- DecimalPlaces := SF.DecimalPlaces;
- EFColors.Error.Assign(SF.EFColors.Error);
- EFColors.Highlight.Assign(SF.EFColors.Highlight);
- MaxLength := SF.MaxLength;
- Options := SF.Options;
- PadChar := SF.PadChar;
- PasswordChar := SF.PasswordChar;
- PictureMask := SF.PictureMask;
- RangeHi := SF.RangeHi;
- RangeLo := SF.RangeLo;
- TextMargin := SF.TextMargin;
- Uninitialized := SF.Uninitialized;
- ZeroDisplay := SF.ZeroDisplay;
- ZeroDisplayValue := SF.ZeroDisplayValue;
- end else
- inherited Assign(Source);
-end;
-
-constructor TOvcCustomSimpleField.Create(AOwner: TComponent);
-begin
- inherited Create(AOwner);
-
- FSimpleDataType := sftString;
- FPictureMask := pmAnyChar;
-
- efFieldClass := fcSimple;
- efDataType := sfGetDataType(FSimpleDataType);
- efPicture[0] := pmAnyChar;
- efPicture[1] := #0;
-end;
-
-procedure TOvcCustomSimpleField.CreateWnd;
-var
- P : array[0..MaxEditLen+1] of Byte;
-begin
- {save field data}
- if efSaveData then
- efTransfer(@P, otf_GetData);
-
- inherited CreateWnd;
-
- sfSetDefaultRanges;
- efSetInitialValue;
-
- {if we saved the field data, restore it}
- if efSaveData then
- efTransfer(@P, otf_SetData);
-
- {set save data flag}
- efSaveData := True;
-end;
-
-procedure TOvcCustomSimpleField.efEdit(var Msg : TMessage; Cmd : Word);
- {-process the specified editing command}
-
- procedure EditSimple(var Msg : TMessage; Cmd : Word);
- {-process the specified editing command for String and PChar fields}
- label
- ExitPoint;
- var
- SaveHPos : Word;
- DelEnd : Word;
- Len : Word;
- Ch : AnsiChar;
- PrevCh : AnsiChar;
- MF : ShortInt;
- HaveSel : Boolean;
- SelExtended : Boolean;
-
- function CharIsOK : Boolean;
- {-return true if Ch can be added to the string}
- var
- PrevCh : AnsiChar;
- begin
- if efIsNumericType then
- if Ch = IntlSupport.DecimalChar then
- Ch := pmDecimalPt
- else if Ch = pmDecimalPt then
- Ch := #0;
- if (Ch < ' ') and not (sefLiteral in sefOptions) then begin
- CharIsOK := False;
- Exit;
- end;
- if efHPos = 0 then
- PrevCh := ' '
- else
- PrevCh := efEditSt[efHPos-1];
- CharIsOK := efCharOK(efPicture[0], Ch, PrevCh, True);
- if efIsNumericType and (Ch = pmDecimalPt) then
- Ch := IntlSupport.DecimalChar;
- end;
-
- function CheckAutoAdvance(SP : Integer) : Boolean;
- {-see if we need to auto-advance to next/previous field}
- begin
- CheckAutoAdvance := False;
- if (SP < 0) and
- (efoAutoAdvanceLeftRight in Controller.EntryOptions) then begin
- efMoveFocusToPrevField;
- CheckAutoAdvance := True;
- end else if (SP >= MaxLength) then
- if (Cmd = ccChar) and
- (efoAutoAdvanceChar in Controller.EntryOptions) then begin
- efMoveFocusToNextField;
- CheckAutoAdvance := True;
- end else if (Cmd <> ccChar) and
- (efoAutoAdvanceLeftRight in Controller.EntryOptions) then begin
- efMoveFocusToNextField;
- CheckAutoAdvance := True;
- end;
- end;
-
- procedure FixSelValues;
- var
- I : Integer;
- begin
- if efSelStart > efSelEnd then begin
- I := efSelStart;
- efSelStart := efSelEnd;
- efSelEnd := I;
- end;
- end;
-
- procedure UpdateSel;
- begin
- if efSelStart = SaveHPos then
- efSelStart := efHPos
- else
- efSelEnd := efHPos;
- FixSelValues;
- end;
-
- procedure WordLeftPrim;
- begin
- Dec(efHPos);
- while (efHPos >= 0) and ((efHPos >= Len) or (efEditSt[efHPos] = ' ')) do
- Dec(efHPos);
- while (efHPos >= 0) and (efEditSt[efHPos] <> ' ') do
- Dec(efHPos);
- Inc(efHPos);
- end;
-
- procedure WordRightPrim;
- begin
- if efEditSt[efHPos] <> ' ' then
- Inc(efHPos);
- while (efHPos < Len) and (efEditSt[efHPos] <> ' ') do
- Inc(efHPos);
- while (efHPos < Len) and (efEditSt[efHPos] = ' ') do
- Inc(efHPos);
- end;
-
- procedure DeleteSel;
- begin
- StrStDeletePrim(efEditSt, efSelStart, efSelEnd-efSelStart);
- Len := StrLen(efEditSt);
- efHPos := efSelStart;
- efSelEnd := efHPos;
- MF := 10;
- end;
-
- procedure PastePrim(P : PAnsiChar);
- var
- Ch : AnsiChar;
- IsNum : Boolean;
- begin
- if HaveSel then
- DeleteSel;
- IsNum := efIsNumericType;
- while P^ <> #0 do begin
- Ch := P^;
- if IsNum then
- if Ch = IntlSupport.DecimalChar then
- Ch := pmDecimalPt
- else if (Ch = pmDecimalPt) or (Ch = ' ') then
- Ch := #0;
- if efCharOK(efPicture[0], Ch, #255, True) then begin
- if (Len = MaxLength) and (efHPos < Len) and
- (efoInsertPushes in Controller.EntryOptions) then begin
- Dec(Len);
- efEditSt[Len] := #0;
- end;
- if (Len < MaxLength) then begin
- if efIsNumericType and (Ch = pmDecimalPt) then
- Ch := IntlSupport.DecimalChar;
- StrChInsertPrim(efEditSt, Ch, efHPos);
- Inc(efHPos);
- Inc(Len);
- end;
- MF := 10;
- end;
- Inc(P);
- end;
- end;
-
- begin
- HaveSel := efSelStart <> efSelEnd;
- MF := Ord(HaveSel);
- SaveHPos := efHPos;
- SelExtended := False;
-
- case Cmd of
- ccAccept : {};
- ccCtrlChar : Include(sefOptions, sefLiteral);
- else
- if Cmd <> ccChar then
- Exclude(sefOptions, sefLiteral);
- end;
-
- Len := StrLen(efEditSt);
- Exclude(sefOptions, sefCharOK);
-
- case Cmd of
- ccChar :
- begin
- Ch := AnsiChar(Lo(Msg.wParam));
- if (sefAcceptChar in sefOptions) and CharIsOk then begin
- Exclude(sefOptions, sefAcceptChar);
- Exclude(sefOptions, sefLiteral);
- if HaveSel then begin
- DeleteSel;
- if efHPos = 0 then
- PrevCh := ' '
- else
- PrevCh := efEditSt[efHPos-1];
- efCharOK(efPicture[0], Ch, PrevCh, True);
- end;
- if (sefInsert in sefOptions) then begin
- if (Len = MaxLength) and (efHPos < Len) and
- (efoInsertPushes in Controller.EntryOptions) then begin
- Dec(Len);
- efEditSt[Len] := #0;
- end;
- if (Len < MaxLength) then begin
- StrChInsertPrim(efEditSt, Ch, efHPos);
- Inc(efHPos);
- CheckAutoAdvance(efHPos);
- end else if not CheckAutoAdvance(efHPos) then
- efConditionalBeep;
- end else if (efHPos+1) <= MaxLength then begin
- efEditSt[efHPos] := Ch;
- if efHPos >= Len then
- efEditSt[efHPos+1] := #0;
- Inc(efHPos);
- CheckAutoAdvance(efHPos);
- end else begin
- if not CheckAutoAdvance(efHPos) then
- efConditionalBeep;
- Dec(MF, 10);
- end;
- Inc(MF, 10);
- end else begin
- Exclude(sefOptions, sefLiteral);
- if sefAcceptChar in sefOptions then
- efConditionalBeep
- else
- goto ExitPoint;
- end;
- end;
- ccMouse :
- if Len > 0 then begin
- efHPos := efGetMousePos(SmallInt(LoWord(Msg.LParam))); //64
- {drag highlight initially if shift key is being pressed}
- if (GetKeyState(vk_Shift) < 0) then begin
- SelExtended := True;
- if HaveSel then begin
- if efHPos > efSelStart then
- efSelEnd := efHPos
- else
- efSelStart := efHPos;
- end else begin
- efSelStart := SaveHPos;
- efSelEnd := efHPos;
- end;
- FixSelValues;
- end else begin
- SetSelection(efHPos, efHPos);
- efPositionCaret(False);
- end;
- end;
- ccMouseMove :
- if Len > 0 then begin
- efHPos := efGetMousePos(SmallInt(LoWord(Msg.LParam))); //64
- UpdateSel;
- end;
- ccDblClk :
- if Len > 0 then begin
- efHPos := efGetMousePos(SmallInt(LoWord(Msg.LParam))); //64
- WordLeftPrim;
- SaveHPos := efHPos;
- efSelStart := SaveHPos;
- efSelEnd := SaveHPos;
- WordRightPrim;
- UpdateSel;
- end;
-{$IFDEF LCL} //LCL form not seeing tab (?), so handle tab command here}
- ccTab : efMoveFocusToNextField;
-{$ENDIF}
- ccLeft :
- if efHPos > 0 then
- Dec(efHPos)
- else
- CheckAutoAdvance(-1);
- ccRight :
- if efHPos < Len then
- Inc(efHPos)
- else
- CheckAutoAdvance(MaxLength);
- ccUp :
- if (efoAutoAdvanceUpDown in Controller.EntryOptions) then
- efMoveFocusToPrevField
- else if (efoArrowIncDec in Options) and not (efoReadOnly in Options) then
- IncreaseValue(True, 1)
- else if efHPos > 0 then
- Dec(efHPos)
- else
- CheckAutoAdvance(-1);
- ccDown :
- if (efoAutoAdvanceUpDown in Controller.EntryOptions) then
- efMoveFocusToNextField
- else if (efoArrowIncDec in Options) and not (efoReadOnly in Options) then
- DecreaseValue(True, 1)
- else if efHPos < Len then
- Inc(efHPos)
- else
- CheckAutoAdvance(MaxLength);
- ccWordLeft :
- if efHPos > 0 then
- WordLeftPrim
- else
- CheckAutoAdvance(-1);
- ccWordRight :
- if efHPos < Len then
- WordRightPrim
- else
- CheckAutoAdvance(MaxLength);
- ccHome :
- efHPos := 0;
- ccEnd :
- efHPos := Len;
- ccExtendLeft :
- if efHPos > 0 then begin
- Dec(efHPos);
- UpdateSel;
- end else
- MF := -1;
- ccExtendRight :
- if efHPos < Len then begin
- Inc(efHPos);
- UpdateSel;
- end else
- MF := -1;
- ccExtendHome :
- begin
- efHPos := 0;
- UpdateSel;
- end;
- ccExtendEnd :
- begin
- efHPos := Len;
- UpdateSel;
- end;
- ccExtWordLeft :
- if efHPos > 0 then begin
- WordLeftPrim;
- UpdateSel;
- end else
- MF := -1;
- ccExtWordRight :
- if efHPos < Len then begin
- WordRightPrim;
- UpdateSel;
- end else
- MF := -1;
- ccCut :
- if HaveSel then
- DeleteSel;
- ccCopy : efCopyPrim;
- ccPaste :
- {for some reason, a paste action within the IDE}
- {gets passed to the control. filter it out}
- if not (csDesigning in ComponentState) then
- PastePrim(PAnsiChar(Msg.lParam));
- ccBack :
- if HaveSel then
- DeleteSel
- else if efHPos > 0 then begin
- Dec(efHPos);
- StrStDeletePrim(efEditSt, efHPos, 1);
- MF := 10;
- end;
- ccDel :
- if HaveSel then
- DeleteSel
- else if efHPos < Len then begin
- StrStDeletePrim(efEditSt, efHPos, 1);
- MF := 10;
- end;
- ccDelWord :
- if HaveSel then
- DeleteSel
- else if efHPos < Len then begin
- {start deleting at the caret}
- DelEnd := efHPos;
-
- {delete all of the current word, if any}
- if efEditSt[efHPos] <> ' ' then
- while (efEditSt[DelEnd] <> ' ') and (DelEnd < Len) do
- Inc(DelEnd);
-
- {delete any spaces prior to the next word, if any}
- while (efEditSt[DelEnd] = ' ') and (DelEnd < Len) do
- Inc(DelEnd);
-
- StrStDeletePrim(efEditSt, efHPos, DelEnd-efHPos);
- MF := 10;
- end;
- ccDelLine :
- if Len > 0 then begin
- efEditSt[0] := #0;
- efHPos := 0;
- MF := 10;
- end;
- ccDelEol :
- if efHPos < Len then begin
- efEditSt[efHPos] := #0;
- MF := 10;
- end;
- ccDelBol :
- if Len > 0 then begin
- StrStDeletePrim(efEditSt, 0, efHPos);
- efHPos := 0;
- MF := 10;
- end;
- ccIns :
- begin
- if sefInsert in sefOptions then
- Exclude(sefOptions, sefInsert)
- else
- Include(sefOptions, sefInsert);
- efCaret.InsertMode := (sefInsert in sefOptions);
- end;
- ccRestore : Restore;
- ccAccept :
- begin
- Include(sefOptions, sefCharOK);
- Include(sefOptions, sefAcceptChar);
- Exit;
- end;
- ccDec :
- DecreaseValue(True, 1);
- ccInc :
- IncreaseValue(True, 1);
- ccCtrlChar, ccSuppress, ccPartial :
- goto ExitPoint;
- else
- Include(sefOptions, sefCharOK);
- goto ExitPoint;
- end;
- Exclude(sefOptions, sefAcceptChar);
-
- case Cmd of
- ccRestore, ccMouseMove, ccDblClk,
- ccExtendLeft, ccExtendRight,
- ccExtendHome, ccExtendEnd,
- ccExtWordLeft, ccExtWordRight :
- Inc(MF);
- ccMouse :
- if SelExtended then
- Inc(MF);
- ccCut, ccCopy, ccPaste : {};
- else
- efSelStart := efHPos;
- efSelEnd := efHPos;
- end;
-
- ExitPoint:
- if efPositionCaret(True) then
- Inc(MF);
- if MF >= 10 then
- efFieldModified;
- if MF > 0 then
- Invalidate;
- end;
-
- procedure EditChar(var Msg : TMessage; Cmd : Word);
- {-process the specified editing command for Char fields}
- label
- ExitPoint;
- var
- MF : Byte;
- Ch : AnsiChar;
-
- function CharIsOK : Boolean;
- {-return true if Ch can be added to the string}
- begin
- if (Ch < ' ') and not (sefLiteral in sefOptions) then
- CharIsOK := False
- else
- CharIsOK := efCharOK(efPicture[0], Ch, ' ', True);
- end;
-
- function CheckAutoAdvance(SP : Integer) : Boolean;
- {-see if we need to auto-advance to next/previous field}
- begin
- CheckAutoAdvance := False;
- if (SP < 0) and
- (efoAutoAdvanceLeftRight in Controller.EntryOptions) then begin
- efMoveFocusToPrevField;
- Result := True;
- end else if (SP > 0) then
- if (Cmd = ccChar) and
- (efoAutoAdvanceChar in Controller.EntryOptions) then begin
- efMoveFocusToNextField;
- Result := True;
- end else if (Cmd <> ccChar) and
- (efoAutoAdvanceLeftRight in Controller.EntryOptions) then begin
- efMoveFocusToNextField;
- Result := True;
- end;
- end;
-
- procedure PastePrim(P : PAnsiChar);
- begin
- while P^ <> #0 do begin
- Ch := P^;
- if efCharOK(efPicture[0], Ch, #255, True) then begin
- efEditSt[0] := Ch;
- MF := 10;
- Exit;
- end;
- Inc(P);
- end;
- end;
-
- begin
- MF := Ord(efSelStart <> efSelEnd);
- case Cmd of
- ccAccept : ;
- ccCtrlChar :
- Include(sefOptions, sefLiteral);
- else
- efHPos := 0;
- if Cmd <> ccChar then
- Exclude(sefOptions, sefLiteral);
- end;
-
- Exclude(sefOptions, sefCharOK);
- case Cmd of
- ccChar :
- begin
- Ch := AnsiChar(Lo(Msg.wParam));
- if sefAcceptChar in sefOptions then
- if CharIsOk then begin
- efEditSt[0] := Ch;
- efEditSt[1] := #0;
- CheckAutoAdvance(1);
- MF := 10;
- end else
- efConditionalBeep;
- {end;}
- sefOptions := sefOptions - [sefAcceptChar, sefLiteral];
- end;
- ccLeft, ccWordLeft :
- CheckAutoAdvance(-1);
- ccRight, ccWordRight :
- CheckAutoAdvance(MaxLength);
- ccUp :
- if (efoAutoAdvanceUpDown in Controller.EntryOptions) then
- efMoveFocusToPrevField
- else
- CheckAutoAdvance(-1);
- ccDown :
- if (efoAutoAdvanceUpDown in Controller.EntryOptions) then
- efMoveFocusToNextField
- else
- CheckAutoAdvance(MaxLength);
- ccRestore :
- Restore;
- ccExtendRight, ccExtendEnd, ccExtWordRight :
- efSelEnd := 1;
- ccMouseMove :
- if efGetMousePos(SmallInt(LoWord(Msg.LParam))) > 0 then //64
- efSelEnd := 1
- else
- efSelEnd := 0;
- ccDblClk :
- efSelEnd := 1;
- ccCopy : efCopyPrim;
- ccPaste :
- {for some reason, a paste action within the IDE}
- {gets passed to the control. filter it out}
- if not (csDesigning in ComponentState) then
- PastePrim(PAnsiChar(Msg.lParam));
- ccAccept :
- begin
- sefOptions := sefOptions + [sefCharOK, sefAcceptChar];
- Exit;
- end;
- ccMouse, ccExtendLeft, ccExtendHome, ccExtWordLeft : ;
- ccDec :
- DecreaseValue(True, 1);
- ccInc :
- IncreaseValue(True, 1);
- ccCtrlChar, ccSuppress, ccPartial :
- goto ExitPoint;
- else
- Include(sefOptions, sefCharOK);
- goto ExitPoint;
- end;
- Exclude(sefOptions, sefAcceptChar);
-
- case Cmd of
- ccRestore, ccMouseMove, ccDblClk, ccExtendRight,
- ccExtendEnd, ccExtWordRight :
- Inc(MF);
- else
- efSelStart := 0;
- efSelEnd := 0;
- end;
-
- ExitPoint:
- if efPositionCaret(True) then
- Inc(MF);
- if MF >= 10 then
- efFieldModified;
- if MF > 0 then
- Invalidate;
- end;
-
-begin {edit}
- case FSimpleDataType of
- sftString,
- sftLongInt, sftWord, sftInteger, sftByte, sftShortInt,
- sftReal, sftExtended, sftDouble, sftSingle, sftComp :
- EditSimple(Msg, Cmd);
- sftChar, sftBoolean, sftYesNo :
- EditChar(Msg, Cmd);
- end;
-end;
-
-function TOvcCustomSimpleField.efGetDisplayString(Dest : PAnsiChar; Size : Word) : PAnsiChar;
- {-return the display string in Dest and a pointer as the result}
-var
- Len : Word;
-begin
- Result := inherited efGetDisplayString(Dest, Size);
-
- Len := StrLen(Dest);
- if Len = 0 then
- Exit;
-
- if Uninitialized and not (sefHaveFocus in sefOptions) then begin
- FillChar(Dest[0], Len, ' ');
- Exit;
- end;
-
- if (efoPasswordMode in Options) then
- FillChar(Dest[0], Len, PasswordChar);
-
- if PadChar <> ' ' then begin
- FillChar(Dest[Len], MaxLength-Len, PadChar);
- Dest[MaxLength] := #0;
- end;
-end;
-
-procedure TOvcCustomSimpleField.efIncDecValue(Wrap : Boolean; Delta : Double);
- {-increment field by Delta}
-var
- S : TEditString;
-
- procedure IncDecValueChar;
- {-increment Char field by Delta}
- var
- C, CC, CL, CH, MC : AnsiChar;
- OK : Boolean;
- begin
- {get valid range}
- CL := efRangeLo.rtChar;
- CH := efRangeHi.rtChar;
- if CL = CH then begin
- CL := #1;
- CH := #255;
- end;
-
- {get current character}
- C := efEditSt[0];
-
- {get mask character}
- MC := efPicture[0];
-
- {exit if we're at the range limit and not allowed to wrap}
- if (Delta < 0) and (C = CL) then begin
- if not Wrap then
- Exit;
- end else if (Delta > 0) and (C = CH) then
- if not Wrap then
- Exit;
-
- {find the next/prev allowable character}
- OK := False;
- repeat
- repeat
- if Delta = 1 then
- Inc(C)
- else
- Dec(C);
- CC := C;
- efFixCase(MC, CC, ' ');
- until efCharOK(MC, C, ' ', False) and (C = CC);
-
- {check result to see if it's in valid range}
- if (C >= CL) and (C <= CH) then
- OK := True
- else if Wrap then
- OK := False
- else
- Exit;
- until OK;
-
- efTransfer(@C, otf_SetData);
- efPerformRepaint(True);
- end;
-
- procedure IncDecValueBoolean;
- var
- Ch : AnsiChar;
- B : Boolean;
- begin
- Ch := UpCaseChar(efEditSt[0]);
- if Ch = IntlSupport.TrueChar then
- Ch := IntlSupport.FalseChar
- else
- Ch := IntlSupport.TrueChar;
- B := Ch = IntlSupport.TrueChar;
-
- efTransfer(@B, otf_SetData);
- efPerformRepaint(True);
- end;
-
- procedure IncDecValueYesNo;
- var
- Ch : AnsiChar;
- B : Boolean;
- begin
- Ch := UpCaseChar(efEditSt[0]);
- if Ch = IntlSupport.YesChar then
- Ch := IntlSupport.NoChar
- else
- Ch := IntlSupport.YesChar;
- B := Ch = IntlSupport.YesChar;
-
- efTransfer(@B, otf_SetData);
- efPerformRepaint(True);
- end;
-
- procedure IncDecValueLongInt;
- var
- L : LongInt;
- begin
- if efStr2Long(efEditSt, L) then begin
- if (Delta < 0) and (L <= efRangeLo.rtLong) then
- if Wrap then
- L := efRangeHi.rtLong
- else Exit
- else if (Delta > 0) and (L >= efRangeHi.rtLong) then
- if Wrap then
- L := efRangeLo.rtLong
- else Exit
- else
- Inc(L, Trunc(Delta));
-
- {insure valid value}
- if L < efRangeLo.rtLong then
- L := efRangeLo.rtLong;
- if L > efRangeHi.rtLong then
- L := efRangeHi.rtLong;
-
- efTransfer(@L, otf_SetData);
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueReal;
- var
- Re : Real;
- Code : Integer;
- begin
- {convert efEditSt to a real}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Re, Code);
-{$ELSE}
- Val(String(S), Re, Code);
-{$ENDIF}
- if Code = 0 then begin
- if (Delta < 0) and (Re <= efRangeLo.rtReal) then
- if Wrap then
- Re := efRangeHi.rtReal
- else Exit
- else if (Delta > 0) and (Re >= efRangeHi.rtReal) then
- if Wrap then
- Re := efRangeLo.rtReal
- else Exit
- else
- Re := Re + Delta;
-
- {insure valid value}
- if Re < efRangeLo.rtReal then
- Re := efRangeLo.rtReal;
- if Re > efRangeHi.rtReal then
- Re := efRangeHi.rtReal;
-
- efTransfer(@Re, otf_SetData);
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueExtended;
- var
- Ex : Extended;
- Code : Integer;
- begin
- {convert efEditSt to an real}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Ex, Code);
-{$ELSE}
- Val(String(S), Ex, Code);
-{$ENDIF}
- if Code = 0 then begin
- if (Delta < 0) and (Ex <= efRangeLo.rtExt) then
- if Wrap then
- Ex := efRangeHi.rtExt
- else Exit
- else if (Delta > 0) and (Ex >= efRangeHi.rtExt) then
- if Wrap then
- Ex := efRangeLo.rtExt
- else Exit
- else
- Ex := Ex + Delta;
-
- {insure valid value}
- if Ex < efRangeLo.rtExt then
- Ex := efRangeLo.rtExt;
- if Ex > efRangeHi.rtExt then
- Ex := efRangeHi.rtExt;
-
- efTransfer(@Ex, otf_SetData);
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueDouble;
- var
- Db : Double;
- Code : Integer;
- begin
- {convert efEditSt to an real}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Db, Code);
-{$ELSE}
- Val(String(S), Db, Code);
-{$ENDIF}
- if Code = 0 then begin
- if (Delta < 0) and (Db <= efRangeLo.rtExt) then
- if Wrap then
- Db := efRangeHi.rtExt
- else Exit
- else if (Delta > 0) and (Db >= efRangeHi.rtExt) then
- if Wrap then
- Db := efRangeLo.rtExt
- else Exit
- else
- Db := Db + Delta;
-
- {insure valid value}
- if Db < efRangeLo.rtExt then
- Db := efRangeLo.rtExt;
- if Db > efRangeHi.rtExt then
- Db := efRangeHi.rtExt;
-
- efTransfer(@Db, otf_SetData);
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueSingle;
- var
- Si : Single;
- Code : Integer;
- begin
- {convert efEditSt to an real}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Si, Code);
-{$ELSE}
- Val(String(S), Si, Code);
-{$ENDIF}
- if Code = 0 then begin
- if (Delta < 0) and (Si <= efRangeLo.rtExt) then
- if Wrap then
- Si := efRangeHi.rtExt
- else Exit
- else if (Delta > 0) and (Si >= efRangeHi.rtExt) then
- if Wrap then
- Si := efRangeLo.rtExt
- else Exit
- else
- Si := Si + Delta;
-
- {insure valid value}
- if Si < efRangeLo.rtExt then
- Si := efRangeLo.rtExt;
- if Si > efRangeHi.rtExt then
- Si := efRangeHi.rtExt;
-
- efTransfer(@Si, otf_SetData);
- efPerformRepaint(True);
- end;
- end;
-
- procedure IncDecValueComp;
- var
-{$IFNDEF FPC}
- Co : Comp;
-{$ELSE}
- {$IFDEF CPU86}
- Co : Comp;
- {$ELSE}
- Co : Double;
- {$ENDIF}
-{$ENDIF}
- Code : Integer;
- begin
- {convert efEditSt to an real}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, Co, Code);
-{$ELSE}
- Val(String(S), Co, Code);
-{$ENDIF}
- if Code = 0 then begin
- if (Delta < 0) and (Co <= efRangeLo.rtExt) then
- if Wrap then
- Co := efRangeHi.rtExt
- else Exit
- else if (Delta > 0) and (Co >= efRangeHi.rtExt) then
- if Wrap then
- Co := efRangeLo.rtExt
- else Exit
- else
- Co := Co + Delta;
-
- {insure valid value}
- if Co < efRangeLo.rtExt then
- Co := efRangeLo.rtExt;
- if Co > efRangeHi.rtExt then
- Co := efRangeHi.rtExt;
-
- efTransfer(@Co, otf_SetData);
- efPerformRepaint(True);
- end;
- end;
-
-begin
- if not (sefHaveFocus in sefOptions) then
- Exit;
- case FSimpleDataType of
- sftString : {not supported for this field type};
- sftChar : IncDecValueChar;
- sftBoolean : IncDecValueBoolean;
- sftYesNo : IncDecValueYesNo;
- sftLongInt,
- sftWord,
- sftInteger,
- sftByte,
- sftShortInt : IncDecValueLongInt;
- sftReal : IncDecValueReal;
- sftExtended : IncDecValueExtended;
- sftDouble : IncDecValueDouble;
- sftSingle : IncDecValueSingle;
- sftComp : IncDecValueComp;
- else
- raise EOvcException.Create(GetOrphStr(SCInvalidParamValue));
- end;
- efPositionCaret(False);
-end;
-
-function TOvcCustomSimpleField.efTransfer(DataPtr : Pointer; TransferFlag : Word) : Word;
- {-transfer data to/from the entry fields}
-var
- S : TEditString;
-
- procedure TransferString;
- var
- I : Integer;
- begin
- if TransferFlag = otf_GetData then
- ShortString(DataPtr^) := StrPas(efEditSt)
- else begin
- if ShortString(DataPtr^) = '' then
- efEditSt[0] := #0
- else begin
- StrPLCopy(efEditSt, ShortString(DataPtr^), MaxLength);
- for I := 0 to Integer(StrLen(efEditSt))-1 do
- efFixCase(efNthMaskChar(I), efEditSt[I], #255);
- end;
- end;
- end;
-
- procedure TransferChar;
- begin
- if TransferFlag = otf_GetData then
- AnsiChar(DataPtr^) := efEditSt[0]
- else begin
- efEditSt[0] := AnsiChar(DataPtr^);
- efEditSt[1] := #0;
- end;
- end;
-
- procedure TransferBoolean;
- begin
- if TransferFlag = otf_GetData then
- Boolean(DataPtr^) := (UpCaseChar(efEditSt[0]) = IntlSupport.TrueChar)
- else begin
- if Boolean(DataPtr^) then
- efEditSt[0] := IntlSupport.TrueChar
- else
- efEditSt[0] := IntlSupport.FalseChar;
- efEditSt[1] := #0;
- end;
- end;
-
- procedure TransferYesNo;
- begin
- if TransferFlag = otf_GetData then
- Boolean(DataPtr^) := (UpCaseChar(efEditSt[0]) = IntlSupport.YesChar)
- else begin
- if Boolean(DataPtr^) then
- efEditSt[0] := IntlSupport.YesChar
- else
- efEditSt[0] := IntlSupport.NoChar;
- efEditSt[1] := #0;
- end;
- end;
-
- procedure TransferLongInt;
- begin
- if TransferFlag = otf_GetData then begin
- if not efStr2Long(efEditSt, LongInt(DataPtr^)) then
- LongInt(DataPtr^) := 0;
- end else
- efLong2Str(efEditSt, LongInt(DataPtr^));
- end;
-
- procedure TransferWord;
- var
- L : LongInt;
- begin
- if TransferFlag = otf_GetData then begin
- if efStr2Long(efEditSt, L) then
- Word(DataPtr^) := Word(L)
- else
- Word(DataPtr^) := 0;
- end else
- efLong2Str(efEditSt, Word(DataPtr^));
- end;
-
- procedure TransferInteger;
- var
- L : LongInt;
- begin
- if TransferFlag = otf_GetData then begin
- if efStr2Long(efEditSt, L) then
- SmallInt(DataPtr^) := SmallInt(L)
- else
- SmallInt(DataPtr^) := 0;
- end else
- efLong2Str(efEditSt, SmallInt(DataPtr^));
- end;
-
- procedure TransferByte;
- var
- L : LongInt;
- begin
- if TransferFlag = otf_GetData then begin
- if efStr2Long(efEditSt, L) then
- Byte(DataPtr^) := Byte(L)
- else
- Byte(DataPtr^) := 0;
- end else
- efLong2Str(efEditSt, Byte(DataPtr^));
- end;
-
- procedure TransferShortInt;
- var
- L : LongInt;
- begin
- if TransferFlag = otf_GetData then begin
- if efStr2Long(efEditSt, L) then
- ShortInt(DataPtr^) := ShortInt(L)
- else
- ShortInt(DataPtr^) := 0;
- end else
- efLong2Str(efEditSt, ShortInt(DataPtr^));
- end;
-
- procedure TransferReal;
- label
- UseExp;
- var
- Code : Integer;
- I : Cardinal;
- R : Real;
- begin
- if TransferFlag = otf_GetData then begin
- StrCopy(S, efEditSt);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(PAnsiChar(@S[0]), R, Code);
-{$ELSE}
- Val(String(PAnsiChar(@S[0])), R, Code);
-{$ENDIF}
- if Code <> 0 then
- R := 0;
- Real(DataPtr^) := R;
- end else begin
- {try to use regular notation}
- R := Real(DataPtr^);
- if StrScan(efPicture, pmScientific) <> nil then
- goto UseExp;
- Str(R:0:DecimalPlaces, S);
-
- {trim trailing 0's if appropriate}
- if StrScan(S, pmDecimalPt) <> nil then
- TrimTrailingZerosPChar(S);
-
- {does it fit?}
- if StrLen(S) > MaxLength then begin
- {won't fit--use scientific notation}
- UseExp:
- if (DecimalPlaces <> 0) and (9+DecimalPlaces < MaxLength) then
- Str(R:9+DecimalPlaces, S)
- else
- Str(R:MaxLength, S);
- TrimAllSpacesPChar(S);
- TrimEmbeddedZerosPChar(S);
- end;
-
- {convert decimal point}
- if StrChPos(S, pmDecimalPt, I) then
- S[I] := IntlSupport.DecimalChar;
-
- StrLCopy(efEditSt, S, MaxLength);
- end;
- end;
-
- procedure TransferExtended;
- label
- UseExp;
- var
- Code : Integer;
- I : Cardinal;
- E : Extended;
- begin
- if TransferFlag = otf_GetData then begin
- StrCopy(S, efEditSt);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, E, Code);
-{$ELSE}
- Val(String(S), E, Code);
-{$ENDIF}
- if Code <> 0 then
- E := 0;
- Extended(DataPtr^) := E;
- end else begin
- {try to use regular notation}
- E := Extended(DataPtr^);
- if StrScan(efPicture, pmScientific) <> nil then
- goto UseExp;
- Str(E:0:DecimalPlaces, S);
-
- {trim trailing 0's if appropriate}
- if StrScan(S, pmDecimalPt) <> nil then
- TrimTrailingZerosPChar(S);
-
- {does it fit?}
- if StrLen(S) > MaxLength then begin
- {won't fit--use scientific notation}
- UseExp:
- if (DecimalPlaces <> 0) and (9+DecimalPlaces < MaxLength) then
- Str(E:9+DecimalPlaces, S)
- else
- Str(E:MaxLength, S);
- TrimAllSpacesPChar(S);
- TrimEmbeddedZerosPChar(S);
- end;
-
- {convert decimal point}
- if StrChPos(S, pmDecimalPt, I) then
- S[I] := IntlSupport.DecimalChar;
-
- StrLCopy(efEditSt, S, MaxLength);
- end;
- end;
-
- procedure TransferDouble;
- label
- UseExp;
- var
- Code : Integer;
- I : Cardinal;
- D : Double;
- begin
- if TransferFlag = otf_GetData then begin
- StrCopy(S, efEditSt);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(PAnsiChar(@S[0]), D, Code);
-{$ELSE}
- Val(String(PAnsiChar(@S[0])), D, Code);
-{$ENDIF}
- if Code <> 0 then
- D := 0;
- Double(DataPtr^) := D;
- end else begin
- {try to use regular notation}
- D := Double(DataPtr^);
- if StrScan(efPicture, pmScientific) <> nil then
- goto UseExp;
- Str(D:0:DecimalPlaces, S);
-
- {trim trailing 0's if appropriate}
- if StrScan(S, pmDecimalPt) <> nil then
- TrimTrailingZerosPChar(S);
-
- {does it fit?}
- if StrLen(S) > MaxLength then begin
- {won't fit--use scientific notation}
- UseExp:
- if (DecimalPlaces <> 0) and (9+DecimalPlaces < MaxLength) then
- Str(D:9+DecimalPlaces, S)
- else
- Str(D:MaxLength, S);
- TrimAllSpacesPChar(S);
- TrimEmbeddedZerosPChar(S);
- end;
-
- {convert decimal point}
- if StrChPos(S, pmDecimalPt, I) then
- S[I] := IntlSupport.DecimalChar;
-
- StrLCopy(efEditSt, S, MaxLength);
- end;
- end;
-
- procedure TransferSingle;
- label
- UseExp;
- var
- Code : Integer;
- I : Cardinal;
- G : Single;
- begin
- if TransferFlag = otf_GetData then begin
- StrCopy(S, efEditSt);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, G, Code);
-{$ELSE}
- Val(String(S), G, Code);
-{$ENDIF}
- if Code <> 0 then
- G := 0;
- Single(DataPtr^) := G;
- end else begin
- {try to use regular notation}
- G := Single(DataPtr^);
- if StrScan(efPicture, pmScientific) <> nil then
- goto UseExp;
- Str(G:0:DecimalPlaces, S);
-
- {trim trailing 0's if appropriate}
- if StrScan(S, pmDecimalPt) <> nil then
- TrimTrailingZerosPChar(S);
-
- {does it fit?}
- if StrLen(S) > MaxLength then begin
- {won't fit--use scientific notation}
- UseExp:
- if (DecimalPlaces <> 0) and (9+DecimalPlaces < MaxLength) then
- Str(G:9+DecimalPlaces, S)
- else
- Str(G:MaxLength, S);
- TrimAllSpacesPChar(S);
- TrimEmbeddedZerosPChar(S);
- end;
-
- {convert decimal point}
- if StrChPos(S, pmDecimalPt, I) then
- S[I] := IntlSupport.DecimalChar;
-
- StrLCopy(efEditSt, S, MaxLength);
- end;
- end;
-
- procedure TransferComp;
- {-transfer data to or from Comp fields}
- label
- UseExp;
- var
- Code : Integer;
-{$IFNDEF FPC}
- C : Comp;
-{$ELSE}
- {$IFDEF CPU86}
- C : Comp;
- {$ELSE}
- C : Double;
- {$ENDIF}
-{$ENDIF}
- begin
- if TransferFlag = otf_GetData then begin
- StrCopy(S, efEditSt);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(PAnsiChar(@S[0]), C, Code);
-{$ELSE}
- Val(String(PAnsiChar(@S[0])), C, Code);
-{$ENDIF}
- if Code <> 0 then
- C := 0;
-{$IFNDEF FPC}
- Comp(DataPtr^) := C;
-{$ELSE}
- {$IFDEF CPU86}
- Comp(DataPtr^) := C;
- {$ELSE}
- Double(DataPtr^) := C;
- {$ENDIF}
-{$ENDIF}
- end else begin
- {try to use regular notation}
-{$IFNDEF FPC}
- C := Comp(DataPtr^);
-{$ELSE}
- {$IFDEF CPU86}
- C := Comp(DataPtr^);
- {$ELSE}
- C := Double(DataPtr^);
- {$ENDIF}
-{$ENDIF}
- if StrScan(efPicture, pmScientific) <> nil then
- goto UseExp;
- Str(C:0:DecimalPlaces, S);
-
- {trim trailing 0's if appropriate}
- if StrScan(S, pmDecimalPt) <> nil then
- TrimTrailingZerosPChar(S);
-
- {does it fit?}
- if StrLen(S) > MaxLength then begin
- {won't fit--use scientific notation}
- UseExp:
- Str(C:MaxLength, S);
- TrimAllSpacesPChar(S);
- TrimEmbeddedZerosPChar(S);
- end;
- StrLCopy(efEditSt, S, MaxLength);
- end;
- end;
-
-begin {transfer}
- if DataPtr = nil then begin
- Result := 0;
- Exit;
- end;
-
- case FSimpleDataType of
- sftString : TransferString;
- sftChar : TransferChar;
- sftBoolean : TransferBoolean;
- sftYesNo : TransferYesNo;
- sftLongInt : TransferLongInt;
- sftWord : TransferWord;
- sftInteger : TransferInteger;
- sftByte : TransferByte;
- sftShortInt : TransferShortInt;
- sftReal : TransferReal;
- sftExtended : TransferExtended;
- sftDouble : TransferDouble;
- sftSingle : TransferSingle;
- sftComp : TransferComp;
- else
- raise EOvcException.Create(GetOrphStr(SCInvalidParamValue));
- end;
-
- Result := inherited efTransfer(DataPtr, TransferFlag);
-end;
-
-function TOvcCustomSimpleField.efValidateField : Word;
- {-validate contents of field; result is error code or 0}
-var
- S : TEditString;
-
- procedure ValidateString;
- var
- L : Word;
- begin
- if sefGettingValue in sefOptions then
- Exit;
-
- if efoTrimBlanks in Options then
- if sefHaveFocus in sefOptions then begin
- L := StrLen(efEditSt);
- TrimAllSpacesPChar(efEditSt);
- if StrLen(efEditSt) <> L then
- Invalidate;
- end;
- end;
-
- procedure ValidateChar;
- begin
- if (efRangeLo.rtChar <> efRangeHi.rtChar) and
- ((efEditSt[0] < efRangeLo.rtChar) or (efEditSt[0] > efRangeHi.rtChar)) then
- Result := oeRangeError;
- end;
-
- procedure ValidateBoolean;
- begin
- if (UpCaseChar(efEditSt[0]) <> IntlSupport.TrueChar) and
- (UpCaseChar(efEditSt[0]) <> IntlSupport.FalseChar) then
- Result := oeRangeError;
- end;
-
- procedure ValidateYesNo;
- begin
- if (UpCaseChar(efEditSt[0]) <> IntlSupport.YesChar) and
- (UpCaseChar(efEditSt[0]) <> IntlSupport.NoChar) then
- Result := oeRangeError;
- end;
-
- procedure ValidateLongInt;
- var
- L : LongInt;
- begin
- if not efStr2Long(efEditSt, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- efTransfer(@L, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateWord;
- var
- L : LongInt;
- begin
- if not efStr2Long(efEditSt, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- efTransfer(@L, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateInteger;
- var
- L : LongInt;
- I : Integer;
- begin
- if not efStr2Long(efEditSt, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- I := L;
- efTransfer(@I, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateByte;
- var
- L : LongInt;
- B : Byte;
- begin
- if not efStr2Long(efEditSt, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- B := L;
- efTransfer(@B, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateShortInt;
- var
- L : LongInt;
- Si : ShortInt;
- begin
- if not efStr2Long(efEditSt, L) then
- Result := oeInvalidNumber
- else if (L < efRangeLo.rtLong) or (L > efRangeHi.rtLong) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- Si := L;
- efTransfer(@Si, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateReal;
- var
- R : Real;
- Code : Integer;
- begin
- {convert efEditSt to a real}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, R, Code);
-{$ELSE}
- Val(String(S), R, Code);
-{$ENDIF}
-
- {format OK?}
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (R < efRangeLo.rtReal) or (R > efRangeHi.rtReal) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- efTransfer(@R, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateExtended;
- var
- E : Extended;
- Code : Integer;
- begin
- {convert efEditSt to an extended}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, E, Code);
-{$ELSE}
- Val(String(S), E, Code);
-{$ENDIF}
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (E < efRangeLo.rtExt) or (E > efRangeHi.rtExt) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- efTransfer(@E, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateDouble;
- var
- E : Extended;
- D : Double;
- Code : Integer;
- begin
- {convert efEditSt to an extended}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, E, Code);
-{$ELSE}
- Val(String(S), E, Code);
-{$ENDIF}
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (E < efRangeLo.rtExt) or (E > efRangeHi.rtExt) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- D := E;
- efTransfer(@D, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateSingle;
- var
- E : Extended;
- Si : Single;
- Code : Integer;
- begin
- {convert efEditSt to an extended}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, E, Code);
-{$ELSE}
- Val(String(S), E, Code);
-{$ENDIF}
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (E < efRangeLo.rtExt) or (E > efRangeHi.rtExt) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- Si := E;
- efTransfer(@Si, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
- procedure ValidateComp;
- var
- E : Extended;
-{$IFNDEF FPC}
- C : Comp;
-{$ELSE}
- {$IFDEF CPU86}
- C : Comp;
- {$ELSE}
- C : Double;
- {$ENDIF}
-{$ENDIF}
- Code : Integer;
- begin
- {convert efEditSt to an extended}
- StrLCopy(S, efEditSt, 80);
- FixRealPrim(S, IntlSupport.DecimalChar);
-{$IFNDEF FPC}
- Val(S, C, Code);
-{$ELSE}
- Val(String(S), C, Code);
-{$ENDIF}
- E := C;
- if Code <> 0 then
- Result := oeInvalidNumber
- else if (E < efRangeLo.rtExt) or (E > efRangeHi.rtExt) then
- Result := oeRangeError
- else begin
- if sefHaveFocus in sefOptions then
- if not (sefGettingValue in sefOptions) then begin
- efTransfer(@C, otf_SetData);
- Invalidate;
- end;
- end;
- end;
-
-begin
- Result := 0;
- case FSimpleDataType of
- sftString : ValidateString;
- sftChar : ValidateChar;
- sftBoolean : ValidateBoolean;
- sftYesNo : ValidateYesNo;
- sftLongInt : ValidateLongInt;
- sftWord : ValidateWord;
- sftInteger : ValidateInteger;
- sftByte : ValidateByte;
- sftShortInt : ValidateShortInt;
- sftReal : ValidateReal;
- sftExtended : ValidateExtended;
- sftDouble : ValidateDouble;
- sftSingle : ValidateSingle;
- sftComp : ValidateComp;
- end;
-
- if not (sefUserValidating in sefOptions) then begin
- {user may retrieve data from field. flag that we are doing}
- {user validation to avoid calling this routine recursively}
- Include(sefOptions, sefUserValidating);
- DoOnUserValidation(Result);
- Exclude(sefOptions, sefUserValidating);
- end;
-end;
-
-procedure TOvcCustomSimpleField.sfSetDataType(Value : TSimpleDataType);
- {-set the data type for this field}
-begin
- if FSimpleDataType <> Value then begin
- FSimpleDataType := Value;
- efDataType := sfGetDataType(FSimpleDataType);
- Options := Options + [efoCaretToEnd];
- efSetDefaultRange(efDataType);
-
- {set defaults for this field type}
- sfResetFieldProperties(FSimpleDataType);
- if HandleAllocated then begin
- {don't save data through create window}
- efSaveData := False;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
- end;
-end;
-
-procedure TOvcCustomSimpleField.sfSetPictureMask(Value: AnsiChar);
- {-set the picture mask}
-var
- Buf : array[0..1] of AnsiChar;
-begin
- if FPictureMask <> Value then begin
- if Value in SimplePictureChars then begin
- FPictureMask := Value;
- if csDesigning in ComponentState then begin
- efPicture[0] := Value;
- efPicture[1] := #0;
- Repaint;
- end else begin
- Buf[0] := Value;
- Buf[1] := #0;
- efChangeMask(Buf);
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
- end else
- raise EInvalidPictureMask.Create(Value);
- end;
-end;
-
-function TOvcCustomSimpleField.sfGetDataType(Value : TSimpleDataType) : Byte;
- {-return a Byte value representing the type of this field}
-begin
- case Value of
- sftString : Result := fidSimpleString;
- sftChar : Result := fidSimpleChar;
- sftBoolean : Result := fidSimpleBoolean;
- sftYesNo : Result := fidSimpleYesNo;
- sftLongInt : Result := fidSimpleLongInt;
- sftWord : Result := fidSimpleWord;
- sftInteger : Result := fidSimpleInteger;
- sftByte : Result := fidSimpleByte;
- sftShortInt : Result := fidSimpleShortInt;
- sftReal : Result := fidSimpleReal;
- sftExtended : Result := fidSimpleExtended;
- sftDouble : Result := fidSimpleDouble;
- sftSingle : Result := fidSimpleSingle;
- sftComp : Result := fidSimpleComp;
- else
- raise EOvcException.Create(GetOrphStr(SCInvalidParamValue));
- end;
-end;
-
-procedure TOvcCustomSimpleField.sfResetFieldProperties(FT : TSimpleDataType);
- {-reset field properties based on current setings}
-
- procedure Update(Len: Word; Mask: AnsiChar);
- begin
- MaxLength := Len;
- FPictureMask := Mask;
- efPicture[0] := Mask;
- efPicture[1] := #0;
- DecimalPlaces := 0;
- end;
-
-begin
- case FT of
- sftString : Update(15, pmAnyChar);
- sftBoolean : Update(1, pmTrueFalse);
- sftYesNo : Update(1, pmYesNo);
- sftChar : Update(1, pmAnyChar);
- sftLongInt : Update(11, pmWhole);
- sftWord : Update(5, pmPositive);
- sftInteger : Update(6, pmWhole);
- sftByte : Update(3, pmPositive);
- sftShortInt : Update(4, pmWhole);
- sftReal : Update(14, pmDecimal);
- sftExtended : Update(14, pmDecimal);
- sftDouble : Update(14, pmDecimal);
- sftSingle : Update(14, pmDecimal);
- sftComp : Update(14, pmWhole);
- else
- raise EOvcException.Create(GetOrphStr(SCInvalidParamValue));
- end;
-end;
-
-procedure TOvcCustomSimpleField.sfSetDefaultRanges;
- {-set default range values based on the field type}
-begin
- case FSimpleDataType of
- sftChar, sftBoolean, sftYesNo :
- if efRangeLo.rtChar = efRangeHi.rtChar then
- efSetDefaultRange(efDataType);
- sftLongInt, sftWord, sftInteger, sftByte, sftShortInt :
- if efRangeLo.rtLong = efRangeHi.rtLong then
- efSetDefaultRange(efDataType);
- sftReal :
- if efRangeLo.rtReal = efRangeHi.rtReal then
- efSetDefaultRange(efDataType);
- sftExtended, sftDouble, sftSingle, sftComp :
- if efRangeLo.rtExt = efRangeHi.rtExt then
- efSetDefaultRange(efDataType);
- else
- efSetDefaultRange(efDataType);
- end;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovcspary.pas b/Source/3rdParty/Orpheus/ovcspary.pas
deleted file mode 100644
index 52b12161..00000000
--- a/Source/3rdParty/Orpheus/ovcspary.pas
+++ /dev/null
@@ -1,698 +0,0 @@
-{*********************************************************}
-{* OVCSPARY.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 ovcspary;
- {-Orpheus - sparse array implementation}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, {$ENDIF}
- SysUtils, OvcExcpt, OvcConst, OvcData;
-
-const
- MaxSparseArrayItems = 320000; {maximum items in a sparse array}
-
-type
- TSparseArrayFunc = function (Index : longint; Item : pointer;
- ExtraData : pointer) : boolean;
- {-Sparse array's iterator type. Should return true to continue iterating,
- false otherwise.}
-
- {The sparse array class}
- TOvcSparseArray = class
- protected {private}
- FCount : longint; {Fake count of the items}
- FArray : pointer; {Sparse array}
-
- ChunkCount : word; {Number of chunks}
- ChunkArraySize : word; {Size of FArray}
-
- procedure RecalcCount;
-
- protected
- function GetActiveCount : longint;
- function GetItem(Index : longint) : pointer;
- procedure PutItem(Index : longint; Item : pointer);
-
- public
- constructor Create;
- destructor Destroy; override;
-
- function Add(Item : pointer) : longint;
- {-Add Item to end of array}
- procedure Clear;
- {-Clear array}
- procedure Delete(Index : longint);
- {-Delete item at Index, all items below move up one}
- procedure Exchange(Index1, Index2 : longint);
- {-Swap the items at Index1 and Index2}
- function First : pointer;
- {-Return First item}
- function ForAll(Action : TSparseArrayFunc;
- Backwards : boolean;
- ExtraData : pointer) : longint;
- {-Iterate through all active items, maybe backwards}
- function IndexOf(Item : pointer) : longint;
- {-Get the index of Item}
- procedure Insert(Index : longint; Item : pointer);
- {-Insert Item at Index, it and all items below move down one}
- function Last : pointer;
- {-Return Last item}
- procedure Squeeze;
- {-Pack the sparse array}
-
- property Count : longint
- {-Logical count of the number of items (=IndexOf(Last)+1)}
- read FCount;
- property ActiveCount : longint
- {-Count of non-nil items}
- read GetActiveCount;
- property Items[Index : longint] : pointer
- {-Items array}
- read GetItem write PutItem;
- default;
- end;
-
-
-implementation
-
-
-{Notes: the sparse array is implemented as an array of chunks, each
- chunk contains 32 items (2^5). The array of chunks consists
- of a set of elements, each with chunk index and a pointer to
- the chunk. To find the item for a given index you do two
- things: calculate the chunk index (divide by 32) and the
- index into the chunk (the remainder once divided by 32).
- For example: where is item 100? 100 = 3*32 + 4, so you try
- and find chunk index 3 in the chunk array (the array is sorted
- by chunk index, hence you do a binary search), and if found
- return the 5th element (zero based arrays). If not found then
- the item does not exist.
- Thus setting item 10000 in a sparse array will allocate only
- one chunk, the 9999 previous items are all assumed nil.
- The sparse array can only accomodate pointers. An unused item
- will be nil. A nil pointer will indicate an unused item. Hence
- you cannot really use a sparse array for longints say, unless
- you can guarantee that all your values will be non-nil.
-
- Sizing stuff: maximum number of pointers that can be stored is
- just less than 350,000. For various reasons the maximum index
- that is allowed for the sparse array is 319,999 meaning that a
- sparse array could hold up to 320,000 pointers. To increase this
- you could hold 64 or 128 pointers per chunk instead.
- The minimum heap the sparse array will take is 896 bytes.
-
- Sparse arrays cannot really be used for keeping sorted items:
- obviously all the items will appear at the start of the array,
- there can be no holes.
-}
-
-const
- ShiftValue = 5;
- ChunkElements = 1 shl ShiftValue; {Number of elements in a chunk: 32}
- ChunkMask = pred(ChunkElements); {Mask used for the item in a chunk: $1F}
-
-type
- PChunk = ^TChunk; {Definition of a chunk}
- TChunk = array [0..pred(ChunkElements)] of pointer;
-
- TChunkArrayElement = packed record {Definition of a chunk array element}
- ChunkIndex : word; {..index of the chunk}
- Chunk : PChunk; {..the chunk itself}
- end;
-
-const
- DefChunkArrayElements = 4; {Initial size of the chunk array}
- MaxChunkArrayElements = ($10000 div sizeof(TChunkArrayElement)) - 1;
- {Absolute maximum of chunk array elements}
-
-type
- PChunkArray = ^TChunkArray; {Definition of a chunk array}
- TChunkArray = array [0..pred(MaxChunkArrayElements)] of TChunkArrayElement;
-
-{===Helper routines==================================================}
-procedure RaiseException(ClassType : integer);
- begin
- case ClassType of
- 1 : raise ESAEAtMaxSize.Create(GetOrphStr(SCSAEAtMaxSize));
- 2 : raise ESAEOutOfBounds.Create(GetOrphStr(SCSAEOutOfBounds));
- else
- raise ESparseArrayError.Create(GetOrphStr(SCSAEGeneral));
- end;{case}
- end;
-{--------}
-function GrowChunkArray(A : PChunkArray; var CurSize : word) : PChunkArray;
- {-Grow the chunk array, return the new size and the new pointer}
- var
- NewSize : longint;
- NewSizeAdj : word;
- begin
- NewSize := longint(CurSize) +
- (DefChunkArrayElements * sizeof(TChunkArrayElement));
- NewSizeAdj := MaxChunkArrayElements * sizeof(TChunkArrayElement);
- if (NewSize < NewSizeAdj) then
- NewSizeAdj := NewSize;
- GetMem(Result, NewSizeAdj);
- {$IFOPT D+}
- FillChar(Result^, NewSizeAdj, $CC);
- {$ENDIF}
- if (CurSize <> 0) then
- begin
- Move(A^, Result^, CurSize);
- FreeMem(A, CurSize);
- end;
- CurSize := NewSizeAdj;
- end;
-{--------}
-function GetChunk(A : PChunkArray;
- CI : word; NumChunks : word) : integer;
- {-Find a chunk array element given the chunk index CI and the number of
- chunks. Return the index into the chunk array, or -1 if not found.}
- var
- L, R : integer;
- MsInx : word;
- begin
- L := 0;
- R := pred(NumChunks);
- repeat
- Result := (L + R) div 2;
- MsInx := A^[Result].ChunkIndex;
- if (CI = MsInx) then
- Exit
- else if (CI < MsInx) then
- R := pred(Result)
- else
- L := succ(Result);
- until (L > R);
- Result := -1;
- end;
-{--------}
-function EnsureChunk(var A : PChunkArray; CI : word;
- var NumChunks, Size : word;
- DontCreate : boolean) : integer;
- {-Makes sure that chunk CI is available for use. If it does not yet
- exist and DontCreate is false, creates a new chunk, inserts it into
- the chunk array (possibly growing the array). Return the index of
- the chunk in the array.}
- var
- NumElements : word;
- L, R, M : integer;
- MsInx : word;
- begin
- L := 0;
- if (NumChunks > 0) then
- begin
- R := pred(NumChunks);
- repeat
- M := (L + R) div 2;
- MsInx := A^[M].ChunkIndex;
- if (CI = MsInx) then
- begin
- Result := M;
- Exit;
- end
- else if (CI < MsInx) then
- R := pred(M)
- else
- L := succ(M);
- until (L > R);
- end;
-
- if DontCreate then
- begin
- Result := -1;
- Exit;
- end;
-
- Result := L;
-
- NumElements := Size div sizeof(TChunkArrayElement);
- if (NumChunks = NumElements) then
- A := GrowChunkArray(A, Size);
-
- if (Result < NumChunks) then
- Move(A^[Result], A^[succ(Result)],
- (NumChunks - Result) * sizeof(TChunkArrayElement));
-
- with A^[Result] do
- begin
- ChunkIndex := CI;
- Chunk := New(PChunk);
- FillChar(Chunk^, sizeof(TChunk), 0);
- end;
-
- inc(NumChunks);
- end;
-{--------}
-function ChunkIsBlank(A : PChunkArray; ArrayInx : word) : boolean;
- {-Return true if the chunk has no items (all pointers are nil).}
- const
- ChunkSizeInWords = sizeof(TChunk) div 2;
- ChunkSizeInDWords = sizeof(TChunk) div 4;
- var
- Chunk : PChunk;
-{$IFDEF NoAsm}
- ItemNum : Integer;
-{$ENDIF}
- begin
- Chunk := A^[ArrayInx].Chunk;
-{$IFDEF NoAsm}
- for ItemNum := 0 to Pred(ChunkElements) do
- begin
- if Chunk^[ItemNum] <> nil then
- begin
- Result := False;
- Exit;
- end;
- end;
- Result := True;
-{$ELSE}
- asm
- push edi
-{$IFDEF VERSION6} { Delphi 6 codegen bug }
- push ecx
-{$ENDIF}
- lea eax, Chunk
- mov edi, [eax]
- xor eax, eax
- mov edx, eax
- mov ecx, ChunkSizeInDWords
- repe scasd
- jne @@Exit
- inc edx
- @@Exit:
-{$IFDEF VERSION6} { Delphi 6 codegen bug }
- pop ecx
-{$ENDIF}
- mov @Result, dl
- pop edi
- end;
-{$ENDIF}
- end;
-{--------}
-procedure DeleteChunk(A : PChunkArray; ArrayInx : word; var NumChunks : word);
- {-Delete a chunk, moving chunks below up one.}
- begin
- Dispose(A^[ArrayInx].Chunk);
- if ArrayInx < pred(NumChunks) then
- Move(A^[succ(ArrayInx)], A^[ArrayInx],
- (NumChunks - ArrayInx) * sizeof(TChunkArrayElement));
- dec(NumChunks);
- {$IFOPT D+}
- FillChar(A^[NumChunks], sizeof(TChunkArrayElement), $CC);
- {$ENDIF}
- end;
-
-{===TOvcSparseArray ForAll routines=====================================}
-function CountActiveElements(Index : longint;
- Item : pointer;
- ExtraData : pointer) : boolean; far;
- var
- ED : ^longint absolute ExtraData;
- begin
- Result := True;
- inc(ED^);
- end;
-{=====}
-
-function Find1stOrLastElement(Index : longint;
- Item : pointer;
- ExtraData : pointer) : boolean; far;
- var
- ED : ^pointer absolute ExtraData;
- begin
- Find1stOrLastElement := false;
- ED^ := Item;
- end;
-{=====}
-
-function FindSpecificElement(Index : longint;
- Item : pointer;
- ExtraData : pointer) : boolean; far;
- begin
- {continue looking if this Item is NOT the one we want}
- FindSpecificElement := Item <> ExtraData;
- end;
-{=====}
-
-constructor TOvcSparseArray.Create;
- begin
- FArray := GrowChunkArray(FArray, ChunkArraySize);
- end;
-{=====}
-
-destructor TOvcSparseArray.Destroy;
- begin
- if Assigned(FArray) then
- begin
- Clear;
- FreeMem(FArray, ChunkArraySize);
- end;
- end;
-{=====}
-
-procedure TOvcSparseArray.RecalcCount;
- var
- Dummy : pointer;
- begin
- FCount := succ(ForAll(Find1stOrLastElement, true, @Dummy));
- end;
-{--------}
-procedure TOvcSparseArray.Squeeze;
- var
- ArrayInx : word;
- begin
- ArrayInx := 0;
- while ArrayInx <> ChunkCount do
- if ChunkIsBlank(FArray, ArrayInx) then
- DeleteChunk(FArray, ArrayInx, ChunkCount)
- else
- inc(ArrayInx);
- end;
-{=======================================================================}
-
-
-{===TOvcSparseArray property access=====================================}
-function TOvcSparseArray.GetActiveCount : longint;
- begin
- Result := 0;
- ForAll(CountActiveElements, true, @Result);
- end;
-{--------}
-function TOvcSparseArray.GetItem(Index : longint) : pointer;
- var
- ChunkIndex : word;
- ChunkNum : integer;
- begin
- if (Index < 0) or (Index >= MaxSparseArrayItems) then
- begin
- RaiseException(2);
- end;
-
- Result := nil;
- if (ChunkCount > 0) then
- begin
- ChunkIndex := Index shr ShiftValue;
- ChunkNum := GetChunk(FArray, ChunkIndex, ChunkCount);
- if (ChunkNum <> -1) then
- Result := PChunkArray(FArray)^[ChunkNum].Chunk^[Index and ChunkMask];
- end;
- end;
-{--------}
-procedure TOvcSparseArray.PutItem(Index : longint; Item : pointer);
- var
- ChunkIndex : word;
- ChunkNum : integer;
- begin
- if (Index < 0) or (Index >= MaxSparseArrayItems) then
- begin
- RaiseException(2);
- end;
-
- ChunkIndex := Index shr ShiftValue;
- ChunkNum := EnsureChunk(PChunkArray(FArray),
- ChunkIndex, ChunkCount, ChunkArraySize,
- (Item = nil));
-
- if (ChunkNum <> -1) then
- begin
- PChunkArray(FArray)^[ChunkNum].Chunk^[Index and ChunkMask] := Item;
- if (Item = nil) then
- Squeeze;
- RecalcCount;
- end;
- end;
-{====================================================================}
-
-
-{===TOvcSparseArray item maintenance====================================}
-function TOvcSparseArray.Add(Item : pointer) : longint;
- begin
- if (FCount = MaxSparseArrayItems) then
- RaiseException(1);
-
- Result := FCount;
- PutItem(Result, Item);
- end;
-{--------}
-procedure TOvcSparseArray.Clear;
- var
- i : integer;
- begin
- if (ChunkCount > 0) then
- begin
- for i := 0 to pred(ChunkCount) do
- Dispose(PChunkArray(FArray)^[i].Chunk);
- {$IFOPT D+}
- FillChar(FArray^, ChunkArraySize, $CC);
- {$ENDIF}
- end;
- ChunkCount := 0;
- FCount := 0;
- end;
-{--------}
-procedure TOvcSparseArray.Delete(Index : longint);
- const
- LastPos = pred(ChunkElements);
- var
- MajorInx : word;
- ChunkNum, Dummy : integer;
- StartPos : word;
- OurChunk : PChunk;
- Transferred : boolean;
- begin
- if (Index < 0) or (Index >= MaxSparseArrayItems) then
- begin
- RaiseException(2);
- end;
-
- if (Index >= FCount) then
- Exit;
-
- MajorInx := Index shr ShiftValue;
- ChunkNum := EnsureChunk(PChunkArray(FArray),
- MajorInx, ChunkCount, ChunkArraySize,
- false);
-
- StartPos := Index and ChunkMask;
- OurChunk := PChunkArray(FArray)^[ChunkNum].Chunk;
- if (StartPos <> LastPos) then
- Move(OurChunk^[succ(StartPos)], OurChunk^[StartPos],
- (LastPos-StartPos)*sizeof(Pointer));
-
- inc(ChunkNum);
- while (ChunkNum <> ChunkCount) do
- begin
- with PChunkArray(FArray)^[ChunkNum] do
- begin
- if (ChunkIndex = MajorInx+1) then
- begin
- Transferred := true;
- OurChunk^[LastPos] := Chunk^[0];
- end
- else
- begin
- Transferred := false;
- OurChunk^[LastPos] := nil;
- end;
- MajorInx := ChunkIndex;
- OurChunk := Chunk;
- end;
- if (OurChunk^[0] <> nil) and (not Transferred) then
- begin
- Dummy := EnsureChunk(PChunkArray(FArray),
- MajorInx-1, ChunkCount, ChunkArraySize,
- true);
- PChunkArray(FArray)^[Dummy].Chunk^[LastPos] :=
- OurChunk^[0];
- end;
- Move(OurChunk^[1], OurChunk^[0], LastPos*sizeof(Pointer));
- inc(ChunkNum);
- end;
-
- OurChunk^[LastPos] := nil;
- Squeeze;
- RecalcCount;
- end;
-{--------}
-procedure TOvcSparseArray.Exchange(Index1, Index2 : longint);
- var
- Item1, Item2 : pointer;
- begin
- if (Index1 = Index2) then
- Exit;
-
- if (Index1 < 0) or (Index1 >= MaxSparseArrayItems) then
- begin
- RaiseException(2);
- end;
- if (Index2 < 0) or (Index2 >= MaxSparseArrayItems) then
- begin
- RaiseException(2);
- end;
-
- Item1 := GetItem(Index1);
- Item2 := GetItem(Index2);
- PutItem(Index2, Item1);
- PutItem(Index1, Item2);
- end;
-{--------}
-function TOvcSparseArray.First : pointer;
- begin
- Result := nil;
- ForAll(Find1stOrLastElement, false, @Result);
- end;
-{--------}
-function TOvcSparseArray.ForAll(Action : TSparseArrayFunc;
- Backwards : boolean;
- ExtraData : pointer) : longint;
- var
- MajorInx : word;
- MinorInx : word;
- MajorStub : longint;
- label
- ExitLoopsReverse, ExitLoopsForwards;
- begin
- if (ChunkCount = 0) then
- Result := -1
- else if Backwards then
- begin
- for MajorInx := pred(ChunkCount) downto 0 do
- with PChunkArray(FArray)^[MajorInx] do
- begin
- MajorStub := longint(ChunkIndex) shl ShiftValue;
- for MinorInx := pred(ChunkElements) downto 0 do
- if (Chunk^[MinorInx] <> nil) then
- begin
- Result := MajorStub + MinorInx;
- if not Action(Result,
- Chunk^[MinorInx],
- ExtraData) then
- Goto ExitLoopsReverse;
- end;
- end;
- Result := -1;
- ExitLoopsReverse:
- end
- else
- begin
- for MajorInx := 0 to pred(ChunkCount) do
- with PChunkArray(FArray)^[MajorInx] do
- begin
- MajorStub := longint(ChunkIndex) shl ShiftValue;
- for MinorInx := 0 to pred(ChunkElements) do
- if (Chunk^[MinorInx] <> nil) then
- begin
- Result := MajorStub + MinorInx;
- if not Action(Result,
- Chunk^[MinorInx],
- ExtraData) then
- Goto ExitLoopsForwards;
- end;
- end;
- Result := -1;
- ExitLoopsForwards:
- end;
- end;
-{--------}
-function TOvcSparseArray.IndexOf(Item : pointer) : longint;
- begin
- Result := ForAll(FindSpecificElement, true, Item);
- end;
-{--------}
-procedure TOvcSparseArray.Insert(Index : longint; Item : pointer);
- const
- LastPos = pred(ChunkElements);
- var
- MajorInx : word;
- ChunkNum : integer;
- CarryItem, NewCarryItem : pointer;
- StartPos : word;
- begin
- if (Index < 0) or (Index >= MaxSparseArrayItems) then
- begin
- RaiseException(2);
- end;
-
- if (FCount = MaxSparseArrayItems) then
- RaiseException(1);
-
- if (Index >= FCount) then
- begin
- PutItem(Index, Item);
- Exit;
- end;
-
- MajorInx := Index shr ShiftValue;
- ChunkNum := EnsureChunk(PChunkArray(FArray),
- MajorInx, ChunkCount, ChunkArraySize,
- false);
-
- CarryItem := Item;
- StartPos := Index and ChunkMask;
- repeat
- with PChunkArray(FArray)^[ChunkNum] do
- begin
- MajorInx := ChunkIndex;
- NewCarryItem := Chunk^[LastPos];
- if (StartPos <> LastPos) then
- Move(Chunk^[StartPos], Chunk^[succ(StartPos)],
- (LastPos-StartPos)*sizeof(Pointer));
- Chunk^[StartPos] := CarryItem;
- CarryItem := NewCarryItem;
- StartPos := 0;
- end;
- inc(ChunkNum);
- if (CarryItem <> nil) then
- if (ChunkNum = ChunkCount) or
- (PChunkArray(FArray)^[ChunkNum].ChunkIndex <> MajorInx+1) then
- ChunkNum := EnsureChunk(PChunkArray(FArray),
- MajorInx+1, ChunkCount, ChunkArraySize,
- false);
- until (ChunkNum = ChunkCount);
- inc(FCount);
- end;
-{--------}
-function TOvcSparseArray.Last : pointer;
- begin
- Result := nil;
- ForAll(Find1stOrLastElement, true, @Result);
- end;
-{====================================================================}
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovcstr.pas b/Source/3rdParty/Orpheus/ovcstr.pas
deleted file mode 100644
index 09a9a76e..00000000
--- a/Source/3rdParty/Orpheus/ovcstr.pas
+++ /dev/null
@@ -1,1262 +0,0 @@
-{*********************************************************}
-{* OVCSTR.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 ovcstr;
- {-General string handling routines}
-
-interface
-
-type
- BTable = array[0..255] of Byte;
- {table used by the Boyer-Moore search routines}
-
-function BinaryBPChar(Dest : PAnsiChar; B : Byte) : PAnsiChar;
- {-Return a binary PAnsiChar string for a byte}
-function BinaryLPChar(Dest : PAnsiChar; L : LongInt) : PAnsiChar;
- {-Return the binary PAnsiChar string for a long integer}
-function BinaryWPChar(Dest : PAnsiChar; W : Word) : PAnsiChar;
- {-Return the binary PAnsiChar string for a word}
-procedure BMMakeTable(MatchString : PAnsiChar; var BT : BTable);
- {-Build a Boyer-Moore link table}
-function BMSearch(var Buffer; BufLength : Cardinal; var BT : BTable;
- MatchString : PAnsiChar ; var Pos : Cardinal) : Boolean;
- {-Use the Boyer-Moore search method to search a buffer for a string}
-function BMSearchUC(var Buffer; BufLength : Cardinal; var BT : BTable;
- MatchString : PAnsiChar ; var Pos : Cardinal) : Boolean;
- {-Use the Boyer-Moore search method to search a buffer for a string. This
- search is not case sensitive}
-function CharStrPChar(Dest : PAnsiChar; C : AnsiChar; Len : Cardinal) : PAnsiChar;
- {-Return a PAnsiChar string filled with the specified character}
-function DetabPChar(Dest : PAnsiChar; Src : PAnsiChar; TabSize : Byte) : PAnsiChar;
- {-Expand tabs in a PAnsiChar string to blanks}
-function HexBPChar(Dest : PAnsiChar; B : Byte) : PAnsiChar;
- {-Return hex PAnsiChar string for byte}
-function HexLPChar(Dest : PAnsiChar; L : LongInt) : PAnsiChar;
- {-Return the hex PAnsiChar string for a long integer}
-function HexPtrPChar(Dest : PAnsiChar; P : Pointer) : PAnsiChar;
- {-Return hex PAnsiChar string for pointer}
-function HexWPChar(Dest : PAnsiChar; W : Word) : PAnsiChar;
- {-Return the hex PAnsiChar string for a word}
-function LoCaseChar(C : AnsiChar) : AnsiChar;
- {-Convert C to lower case}
-function OctalLPChar(Dest : PAnsiChar; L : LongInt) : PAnsiChar;
- {-Return the octal PAnsiChar string for a long integer}
-function StrChDeletePrim(P : PAnsiChar; Pos : Cardinal) : PAnsiChar;
- {-Primitive routine to delete a character from a PAnsiChar string}
-function StrChInsertPrim(Dest : PAnsiChar; C : AnsiChar; Pos : Cardinal) : PAnsiChar;
- {-Primitive routine to insert a character into a PAnsiChar string}
-function StrChPos(P : PAnsiChar; C : AnsiChar; var Pos : Cardinal) : Boolean;
- {-Sets Pos to location of C in P, return is True if found}
-procedure StrInsertChars(Dest : PAnsiChar; Ch : AnsiChar; Pos, Count : Word);
- {-Insert count instances of Ch into S at Pos}
-function StrStCopy(Dest, S : PAnsiChar; Pos, Count : Cardinal) : PAnsiChar;
- {-Copy characters at a specified position in a PAnsiChar string}
-function StrStDeletePrim(P : PAnsiChar; Pos, Count : Cardinal) : PAnsiChar;
- {-Primitive routine to delete a sub-string from a PAnsiChar string}
-function StrStInsert(Dest, S1, S2 : PAnsiChar; Pos : Cardinal) : PAnsiChar;
- {-Insert a PAnsiChar string into another at a specified position}
-function StrStInsertPrim(Dest, S : PAnsiChar; Pos : Cardinal) : PAnsiChar;
- {-Insert a PAnsiChar string into another at a specified position. This
- primitive version modifies the source directly}
-function StrStPos(P, S : PAnsiChar; var Pos : Cardinal) : Boolean;
- {-Sets Pos to position of the S in P, returns True if found}
-function StrToLongPChar(S : PAnsiChar; var I : LongInt) : Boolean;
- {-Convert a PAnsiChar string to a long integer}
-procedure TrimAllSpacesPChar(P : PAnsiChar);
- {-Trim leading and trailing blanks from P}
-function TrimEmbeddedZeros(const S : string) : string;
- {-Trim embedded zeros from a numeric string in exponential format}
-procedure TrimEmbeddedZerosPChar(P : PAnsiChar);
- {-Trim embedded zeros from a numeric PAnsiChar string in exponential format}
-function TrimTrailPrimPChar(S : PAnsiChar) : PAnsiChar;
- {-Return a PAnsiChar string with trailing white space removed}
-function TrimTrailPChar(Dest, S : PAnsiChar) : PAnsiChar;
- {-Return a PAnsiChar string with trailing white space removed}
-function TrimTrailingZeros(const S : string) : string;
- {-Trim trailing zeros from a numeric string. It is assumed that there is
- a decimal point prior to the zeros. Also strips leading spaces.}
-procedure TrimTrailingZerosPChar(P : PAnsiChar);
- {-Trim trailing zeros from a numeric PAnsiChar string. It is assumed that
- there is a decimal point prior to the zeros. Also strips leading spaces.}
-function UpCaseChar(C : AnsiChar) : AnsiChar;
- {-Convert a character to uppercase using the AnsiUpper API}
-
-
-implementation
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, LclType, {$ENDIF} SysUtils;
-
-const
- Digits : array[0..$F] of AnsiChar = '0123456789ABCDEF';
-
-function BinaryBPChar(Dest : PAnsiChar; B : Byte) : PAnsiChar;
- {-Return binary string for byte}
-var
- I : Word;
-begin
- Result := Dest;
- for I := 7 downto 0 do begin
- Dest^ := Digits[Ord(B and (1 shl I) <> 0)]; {0 or 1}
- Inc(Dest);
- end;
- Dest^ := #0;
-end;
-
-function BinaryLPChar(Dest : PAnsiChar; L : LongInt) : PAnsiChar;
- {-Return binary string for LongInt}
-var
- I : LongInt;
-begin
- Result := Dest;
- for I := 31 downto 0 do begin
- Dest^ := Digits[Ord(L and LongInt(1 shl I) <> 0)]; {0 or 1}
- Inc(Dest);
- end;
- Dest^ := #0;
-end;
-
-function BinaryWPChar(Dest : PAnsiChar; W : Word) : PAnsiChar;
- {-Return binary string for word}
-var
- I : Word;
-begin
- Result := Dest;
- for I := 15 downto 0 do begin
- Dest^ := Digits[Ord(W and (1 shl I) <> 0)]; {0 or 1}
- Inc(Dest);
- end;
- Dest^ := #0;
-end;
-
-{$IFDEF NoAsm}
-// These 3 routines not used by TOvcTable, etc. so don't Pascal-ize for now.
-procedure BMMakeTable(MatchString : PAnsiChar; var BT : BTable);
-begin
- Assert(False, 'BMMakeTable not yet supported on non-Intel processors.');
-end;
-
-function BMSearch(var Buffer; BufLength : Cardinal; var BT : BTable;
- MatchString : PAnsiChar; var Pos : Cardinal) : Boolean;
-begin
- Assert(False, 'BMSearch not yet supported on non-Intel processors.');
-end;
-
-function BMSearchUC(var Buffer; BufLength : Cardinal; var BT : BTable;
- MatchString : PAnsiChar; var Pos : Cardinal) : Boolean;
-begin
- Assert(False, 'BMSearchUC not yet supported on non-Intel processors.');
-end;
-
-{$ELSE}
-procedure BMMakeTable(MatchString : PAnsiChar; var BT : BTable); register;
- {Build Boyer-Moore link table}
-asm
- push esi { Save registers because they will be changed }
- push edi
- push ebx
-
- cld { Ensure forward string ops }
- mov edi, eax { Move EAX to ESI & EDI }
- mov esi, eax
- xor eax, eax { Zero EAX }
- or ecx, -1
- repne scasb { Search for null terminator }
- not ecx
- dec ecx { ECX is length of search string }
- cmp ecx, 0FFh { If ECX > 255, force to 255 }
- jbe @@1
- mov ecx, 0FFh
-
-@@1:
- mov ch, cl { Duplicate CL in CH }
- mov eax, ecx { Fill each byte in EAX with length }
- shl eax, 16
- mov ax, cx
- mov edi, edx { Point to the table }
- mov ecx, 64 { Fill table bytes with length }
- rep stosd
- cmp al, 1 { If length >= 1, we're done }
- jbe @@MTDone
- mov edi, edx { Reset EDI to beginning of table }
- xor ebx, ebx { Zero EBX }
- mov cl, al { Restore CL to length of string }
- dec ecx
-
-@@MTNext:
- lodsb { Load table with positions of letters }
- mov bl, al { That exist in the search string }
- mov [edi+ebx], cl
- loop @@MTNext
-
-@@MTDone:
- pop ebx { Restore registers }
- pop edi
- pop esi
-end;
-
-function BMSearch(var Buffer; BufLength : Cardinal; var BT : BTable;
- MatchString : PAnsiChar; var Pos : Cardinal) : Boolean; register;
-var
- BufPtr : Pointer;
-asm
- push edi { Save registers since we will be changing }
- push esi
- push ebx
- push edx
-
- mov BufPtr, eax { Copy Buffer to local variable and ESI }
- mov esi, eax
- mov ebx, ecx { Copy BufLength to EBX }
-
- cld { Ensure forward string ops }
- xor eax, eax { Zero out EAX so we can search for null }
- mov edi, MatchString { Set EDI to beginning of MatchString }
- or ecx, -1 { We will be counting down }
- repne scasb { Find null }
- not ecx { ECX = length of MatchString + null }
- dec ecx { ECX = length of MatchString }
- mov edx, ecx { Copy length of MatchString to EDX }
-
- pop ecx { Pop length of buffer into ECX }
- mov edi, esi { Set EDI to beginning of search buffer }
- mov esi, MatchString { Set ESI to beginning of MatchString }
-
- cmp dl, 1 { Check to see if we have a trivial case }
- ja @@BMSInit { If Length(MatchString) > 1 do BM search }
- jb @@BMSNotFound { If Length(MatchString) = 0 we're done }
-
- mov al,[esi] { If Length(MatchString) = 1 do a REPNE SCASB }
- mov ebx, edi
- repne scasb
- jne @@BMSNotFound { No match during REP SCASB }
- dec edi { Found, calculate position }
- sub edi, ebx
- mov esi, Pos { Set position in Pos }
- mov [esi], edi
- mov eax, 1 { Set result to True }
- jmp @@BMSDone { We're done }
-
-@@BMSInit:
- dec edx { Set up for BM Search }
- add esi, edx { Set ESI to end of MatchString }
- add ecx, edi { Set ECX to end of buffer }
- add edi, edx { Set EDI to first check point }
- mov dh, [esi] { Set DH to character we'll be looking for }
- dec esi { Dec ESI in prep for BMSFound loop }
- std { Backward string ops }
- jmp @@BMSComp { Jump to first comparison }
-
-@@BMSNext:
- mov al, [ebx+eax] { Look up skip distance from table }
- add edi, eax { Skip EDI ahead to next check point }
-
-@@BMSComp:
- cmp edi, ecx { Have we reached end of buffer? }
- jae @@BMSNotFound { If so, we're done }
- mov al, [edi] { Move character from buffer into AL for comparison }
- cmp dh, al { Compare }
- jne @@BMSNext { If not equal, go to next checkpoint }
-
- push ecx { Save ECX }
- dec edi
- xor ecx, ecx { Zero ECX }
- mov cl, dl { Move Length(MatchString) to ECX }
- repe cmpsb { Compare MatchString to buffer }
- je @@BMSFound { If equal, string is found }
-
- mov al, dl { Move Length(MatchString) to AL }
- sub al, cl { Calculate offset that string didn't match }
- add esi, eax { Move ESI back to end of MatchString }
- add edi, eax { Move EDI to pre-string compare location }
- inc edi
- mov al, dh { Move character back to AL }
- pop ecx { Restore ECX }
- jmp @@BMSNext { Do another compare }
-
-@@BMSFound: { EDI points to start of match }
- mov edx, BufPtr { Move pointer to buffer into EDX }
- sub edi, edx { Calculate position of match }
- mov eax, edi
- inc eax
- mov esi, Pos
- mov [esi], eax { Set Pos to position of match }
- mov eax, 1 { Set result to True }
- pop ecx { Restore ESP }
- jmp @@BMSDone
-
-@@BMSNotFound:
- xor eax, eax { Set result to False }
-
-@@BMSDone:
- cld { Restore direction flag }
- pop ebx { Restore registers }
- pop esi
- pop edi
-end;
-
-function BMSearchUC(var Buffer; BufLength : Cardinal; var BT : BTable;
- MatchString : PAnsiChar; var Pos : Cardinal) : Boolean; register;
- {- Case-insensitive search of Buffer for MatchString. Return indicates
- success or failure. Assumes MatchString is already raised to
- uppercase (PRIOR to creating the table) -}
-var
- BufPtr : Pointer;
-asm
- push edi { Save registers since we will be changing }
- push esi
- push ebx
- push edx
-
- mov BufPtr, eax { Copy Buffer to local variable and ESI }
- mov esi, eax
- mov ebx, ecx { Copy BufLength to EBX }
-
- cld { Ensure forward string ops }
- xor eax, eax { Zero out EAX so we can search for null }
- mov edi, MatchString { Set EDI to beginning of MatchString }
- or ecx, -1 { We will be counting down }
- repne scasb { Find null }
- not ecx { ECX = length of MatchString + null }
- dec ecx { ECX = length of MatchString }
- mov edx, ecx { Copy length of MatchString to EDX }
-
- pop ecx { Pop length of buffer into ECX }
- mov edi, esi { Set EDI to beginning of search buffer }
- mov esi, MatchString { Set ESI to beginning of MatchString }
-
- or dl, dl { Check to see if we have a trivial case }
- jz @@BMSNotFound { If Length(MatchString) = 0 we're done }
-
-@@BMSInit:
- dec edx { Set up for BM Search }
- add esi, edx { Set ESI to end of MatchString }
- add ecx, edi { Set ECX to end of buffer }
- add edi, edx { Set EDI to first check point }
- mov dh, [esi] { Set DH to character we'll be looking for }
- dec esi { Dec ESI in prep for BMSFound loop }
- std { Backward string ops }
- jmp @@BMSComp { Jump to first comparison }
-
-@@BMSNext:
- mov al, [ebx+eax] { Look up skip distance from table }
- add edi, eax { Skip EDI ahead to next check point }
-
-@@BMSComp:
- cmp edi, ecx { Have we reached end of buffer? }
- jae @@BMSNotFound { If so, we're done }
- mov al, [edi] { Move character from buffer into AL for comparison }
-
- push ebx { Save registers }
- push ecx
- push edx
- push eax { Push Char onto stack for CharUpper }
- cld
- call CharUpper
- std
- pop edx { Restore registers }
- pop ecx
- pop ebx
-
- cmp dh, al { Compare }
- jne @@BMSNext { If not equal, go to next checkpoint }
-
- push ecx { Save ECX }
- dec edi
- xor ecx, ecx { Zero ECX }
- mov cl, dl { Move Length(MatchString) to ECX }
- jecxz @@BMSFound { If ECX is zero, string is found }
-
-@@StringComp:
- mov al, [edi] { Get char from buffer }
- dec edi { Dec buffer index }
-
- push ebx { Save registers }
- push ecx
- push edx
- push eax { Push Char onto stack for CharUpper }
- cld
- call CharUpper
- std
- pop edx { Restore registers }
- pop ecx
- pop ebx
-
- mov ah, al { Move buffer char to AH }
- lodsb { Get MatchString char }
- cmp ah, al { Compare }
- loope @@StringComp { OK? Get next character }
- je @@BMSFound { Matched! }
-
- xor ah, ah { Zero AH }
- mov al, dl { Move Length(MatchString) to AL }
- sub al, cl { Calculate offset that string didn't match }
- add esi, eax { Move ESI back to end of MatchString }
- add edi, eax { Move EDI to pre-string compare location }
- inc edi
- mov al, dh { Move character back to AL }
- pop ecx { Restore ECX }
- jmp @@BMSNext { Do another compare }
-
-@@BMSFound: { EDI points to start of match }
- mov edx, BufPtr { Move pointer to buffer into EDX }
- sub edi, edx { Calculate position of match }
- mov eax, edi
- inc eax
- mov esi, Pos
- mov [esi], eax { Set Pos to position of match }
- mov eax, 1 { Set result to True }
- pop ecx { Restore ESP }
- jmp @@BMSDone
-
-@@BMSNotFound:
- xor eax, eax { Set result to False }
-
-@@BMSDone:
- cld { Restore direction flag }
- pop ebx { Restore registers }
- pop esi
- pop edi
-end;
-{$ENDIF}
-
-{$IFDEF NoAsm}
-function CharStrPChar(Dest : PAnsiChar; C : AnsiChar;
- Len : Cardinal) : PAnsiChar;
-begin
- Result := StrPCopy(Dest, StringOfChar(C, Len));
-end;
-
-{$ELSE}
-function CharStrPChar(Dest : PAnsiChar; C : AnsiChar;
- Len : Cardinal) : PAnsiChar; register;
-asm
- push edi { Save EDI-about to change it }
- push eax { Save Dest pointer for return }
- mov edi, eax { Point EDI to Dest }
-
- mov dh, dl { Dup character 4 times }
- mov eax, edx
- shl eax, $10
- mov ax, dx
-
- mov edx, ecx { Save Len }
-
- cld { Forward! }
- shr ecx, 2 { Store dword char chunks first }
- rep stosd
- mov ecx, edx { Store remaining characters }
- and ecx, 3
- rep stosb
-
- xor al,al { Add null terminator }
- stosb
-
- pop eax { Return Dest pointer }
- pop edi { Restore orig value of EDI }
-end;
-{$ENDIF}
-
-{$IFDEF NoAsm}
-// This routine not used by TOvcTable, etc. so don't Pascal-ize for now.
-function DetabPChar(Dest : PAnsiChar; Src : PAnsiChar;
- TabSize : Byte) : PAnsiChar;
-begin
- Assert(False, 'DetabPChar not yet supported on non-Intel processors.');
-end;
-
-{$ELSE}
-function DetabPChar(Dest : PAnsiChar; Src : PAnsiChar;
- TabSize : Byte) : PAnsiChar; register;
- { -Expand tabs in a string to blanks on spacing TabSize- }
-asm
- push eax { Save Dest for return value }
- push edi { Save EDI, ESI and EBX, we'll be changing them }
- push esi
- push ebx
-
- mov esi, edx { ESI -> Src }
- mov edi, eax { EDI -> Dest }
- xor ebx, ebx { Get TabSize in EBX }
- add bl, cl
- jz @@Done { Exit if TabSize is zero }
-
- cld { Forward! }
- xor edx, edx { Set output length to zero }
-
-@@Next:
- lodsb { Get next input character }
- or al, al { Is it a null? }
- jz @@Done { Yes-all done }
- cmp al, 09 { Is it a tab? }
- je @@Tab { Yes, compute next tab stop }
- stosb { No, store to output }
- inc edx { Increment output length }
- jmp @@Next { Next character }
-
-@@Tab:
- push edx { Save output length }
- mov eax, edx { Get current output length in DX:AX }
- xor edx, edx
- div ebx { Output length MOD TabSize in DX }
- mov ecx, ebx { Calc number of spaces to insert... }
- sub ecx, edx { = TabSize - Mod value }
- pop edx
- add edx, ecx { Add count of spaces into current output length }
-
- mov eax,$2020 { Blank in AH, Blank in AL }
- shr ecx, 1 { Store blanks }
- rep stosw
- adc ecx, ecx
- rep stosb
- jmp @@Next { Back for next input }
-
-@@Done:
- xor al,al { Store final null terminator }
- stosb
-
- pop ebx { Restore caller's EBX, ESI and EDI }
- pop esi
- pop edi
- pop eax { Return Dest }
-end;
-{$ENDIF}
-
-function HexBPChar(Dest : PAnsiChar; B : Byte) : PAnsiChar;
- {-Return hex string for byte}
-begin
- Result := Dest;
- Dest^ := Digits[B shr 4];
- Inc(Dest);
- Dest^ := Digits[B and $F];
- Inc(Dest);
- Dest^ := #0;
-end;
-
-function HexLPChar(Dest : PAnsiChar; L : LongInt) : PAnsiChar;
- {-Return the hex string for a long integer}
-var
- T2 : Array[0..4] of AnsiChar;
-begin
- Result := StrCat(HexWPChar(Dest, HIWORD(L)), HexWPChar(T2, LOWORD(L)));
-end;
-
-function HexPtrPChar(Dest : PAnsiChar; P : Pointer) : PAnsiChar;
- {-Return hex string for pointer}
-var
- T2 : Array[0..4] of AnsiChar;
-begin
- StrCat(HexWPChar(Dest, HIWORD(LongInt(P))), ':');
- Result := StrCat(Dest, HexWPChar(T2, LOWORD(LongInt(P))));
-end;
-
-function HexWPChar(Dest : PAnsiChar; W : Word) : PAnsiChar;
-begin
- Result := Dest;
- Dest^ := Digits[Hi(W) shr 4];
- Inc(Dest);
- Dest^ := Digits[Hi(W) and $F];
- Inc(Dest);
- Dest^ := Digits[Lo(W) shr 4];
- Inc(Dest);
- Dest^ := Digits[Lo(W) and $F];
- Inc(Dest);
- Dest^ := #0;
-end;
-
-{$IFDEF NoAsm}
-function LoCaseChar(C: AnsiChar) : AnsiChar;
-var
- AStr : string;
-begin
- AStr := AnsiLowerCase(C);
- Result := AStr[1];
-end;
-
-{$ELSE}
-function LoCaseChar(C: AnsiChar) : AnsiChar; register;
-asm
- mov edx, eax
- xor eax, eax
- mov al, dl
- push eax
- call CharLower
-end;
-{$ENDIF}
-
-function OctalLPChar(Dest : PAnsiChar; L : LongInt) : PAnsiChar;
- {-Return the octal PAnsiChar string for a long integer}
-var
- I : LongInt;
-begin
- Result := Dest;
- FillChar(Dest^, 12, '0');
- Dest[12] := #0;
- for I := 11 downto 0 do begin
- if L = 0 then
- Exit;
-
- Dest[I] := Digits[L and 7];
- L := L shr 3;
- end;
-end;
-
-{$IFDEF NoAsm}
-function StrChDeletePrim(P : PAnsiChar; Pos : Cardinal) : PAnsiChar;
-var
- AStr : string;
-begin
- AStr := StrPas(P);
- Delete(AStr, Succ(Pos), 1);
- Result := StrPCopy(P, AStr);
-end;
-
-function StrChInsertPrim(Dest : PAnsiChar; C : AnsiChar;
- Pos : Cardinal) : PAnsiChar;
-var
- AStr : string;
-begin
- AStr := StrPas(Dest);
- Insert(C, AStr, Succ(Pos));
- Result := StrPCopy(Dest, AStr);
-end;
-
-function StrChPos(P : PAnsiChar; C : AnsiChar;
- var Pos : Cardinal): Boolean;
-var
- AStr : string;
- ChPos : Integer;
-begin
- AStr := StrPas(P);
- ChPos := System.Pos(C, AStr);
- Result := ChPos > 0;
- if Result then
- Pos := Pred(ChPos);
-end;
-
-{$ELSE}
-function StrChDeletePrim(P : PAnsiChar; Pos : Cardinal) : PAnsiChar; register;
-asm
- push edi { Save because we will be changing them }
- push esi
- push ebx
-
- mov ebx, eax { Save P to EDI & EBX }
- mov edi, eax
-
- xor al, al { Zero }
- or ecx, -1 { Set ECX to $FFFFFFFF }
- cld
- repne scasb { Find null terminator }
- not ecx
- jecxz @@ExitPoint
- sub ecx, edx { Calc number to move }
- jb @@ExitPoint { Exit if Pos > StrLen }
-
- mov edi, ebx
- add edi, edx { Point to position to adjust }
- mov esi, edi
- inc esi { Offset for source string }
- inc ecx { One more to include null terminator }
- rep movsb { Adjust the string }
-@@ExitPoint:
-
- mov eax, ebx
- pop ebx { restore registers }
- pop esi
- pop edi
-end;
-
-function StrChInsertPrim(Dest : PAnsiChar; C : AnsiChar;
- Pos : Cardinal) : PAnsiChar; register;
-asm
- push eax {save because we will be changing them}
- push edi
- push esi
- push ebx
-
- xor ebx, ebx {zero}
- mov ebx, ecx {move POS to ebx}
-
- mov esi, eax {copy Dest to ESI and EDI}
- mov edi, eax
-
- xor al, al {zero}
- or ecx, -1 {set ECX to $FFFFFFFF}
- cld {ensure forward}
- repne scasb {find null terminator}
-
- not ecx {calc length (including null)}
- std {backwards string ops}
- add esi, ecx
- dec esi {point to end of source string}
- sub ecx, ebx {calculate number to do}
- jae @@1 {append if Pos greater than strlen + 1}
- mov ecx, 1
-
-@@1:
- rep movsb {adjust tail of string}
- mov eax, edx
- stosb {insert the new character}
-
-@@ExitPoint:
-
- cld {be a good neighbor}
- pop ebx {restore registers}
- pop esi
- pop edi
- pop eax
-end;
-
-function StrChPos(P : PAnsiChar; C : AnsiChar;
- var Pos : Cardinal): Boolean; register;
- {-Sets Pos to position of character C within string P returns True if found}
-asm
- push esi {save since we'll be changing}
- push edi
- push ebx
- mov esi, ecx {save Pos}
-
- cld {forward string ops}
- mov edi, eax {copy P to EDI}
- or ecx, -1
- xor eax, eax {zero}
- mov ebx, edi {save EDI to EBX}
- repne scasb {search for NULL terminator}
- not ecx
- dec ecx {ecx has len of string}
-
- test ecx, ecx
- jz @@NotFound {if len of P = 0 then done}
-
- mov edi, ebx {reset EDI to beginning of string}
- mov al, dl {copy C to AL}
- repne scasb {find C in string}
- jne @@NotFound
-
- mov ecx, edi {calculate position of C}
- sub ecx, ebx
- dec ecx {ecx holds found position}
-
- mov [esi], ecx {store location}
- mov eax, 1 {return true}
- jmp @@ExitCode
-
-@@NotFound:
- xor eax, eax
-
-@@ExitCode:
-
- pop ebx {restore registers}
- pop edi
- pop esi
-end;
-{$ENDIF}
-
-procedure StrInsertChars(Dest : PAnsiChar; Ch : AnsiChar; Pos, Count : Word);
- {-Insert count instances of Ch into S at Pos}
-var
- A : array[0..1024] of AnsiChar;
-begin
- FillChar(A, Count, Ch);
- A[Count] := #0;
- StrStInsertPrim(Dest, A, Pos);
-end;
-
-function StrStCopy(Dest : PAnsiChar; S : PAnsiChar; Pos, Count : Cardinal) : PAnsiChar;
-var
- Len : Cardinal;
-begin
- Len := StrLen(S);
- if Pos < Len then begin
- if (Len-Pos) < Count then
- Count := Len-Pos;
- Move(S[Pos], Dest^, Count);
- Dest[Count] := #0;
- end else
- Dest[0] := #0;
- Result := Dest;
-end;
-
-{$IFDEF NoAsm}
-function StrStDeletePrim(P : PAnsiChar; Pos, Count : Cardinal) : PAnsiChar;
-var
- AStr : string;
-begin
- AStr := StrPas(P);
- Delete(AStr, Succ(Pos), Count);
- Result := StrPCopy(P, AStr);
-end;
-
-{$ELSE}
-function StrStDeletePrim(P : PAnsiChar; Pos, Count : Cardinal) : PAnsiChar; register;
-asm
- push eax {save because we will be changing them}
- push edi
- push esi
- push ebx
-
- mov ebx, ecx {move Count to BX}
- mov esi, eax {move P to ESI and EDI}
- mov edi, eax
-
- xor eax, eax {null}
- or ecx, -1
- cld
- repne scasb {find null terminator}
- not ecx {calc length}
- jecxz @@ExitPoint
-
- sub ecx, ebx {subtract Count}
- sub ecx, edx {subtract Pos}
- jns @@L1
-
- mov edi,esi {delete everything after Pos}
- add edi,edx
- stosb
- jmp @@ExitPoint
-
-@@L1:
- mov edi,esi
- add edi,edx {point to position to adjust}
- mov esi,edi
- add esi,ebx {point past string to delete in src}
- inc ecx {one more to include null terminator}
- rep movsb {adjust the string}
-
-@@ExitPoint:
-
- pop ebx {restore registers}
- pop esi
- pop edi
- pop eax
-end;
-{$ENDIF}
-
-function StrStInsert(Dest : PAnsiChar; S1, S2 : PAnsiChar; Pos : Cardinal) : PAnsiChar;
-begin
- StrCopy(Dest, S1);
- Result := StrStInsertPrim(Dest, S2, Pos);
-end;
-
-{$IFDEF NoAsm}
-function StrStInsertPrim(Dest : PAnsiChar; S : PAnsiChar;
- Pos : Cardinal) : PAnsiChar;
-// Note source (S) not modified as in assembler version.
-var
- AStr : string;
-begin
- AStr := StrPas(Dest);
- Insert(StrPas(S), AStr, Succ(Pos));
- Result := StrPCopy(Dest, AStr);
-end;
-
-function StrStPos(P, S : PAnsiChar; var Pos : Cardinal) : boolean;
-var
- AStr : string;
- ChPos : Integer;
-begin
- AStr := StrPas(P);
- ChPos := System.Pos(StrPas(S), AStr);
- Result := ChPos > 0;
- if Result then
- Pos := Pred(ChPos);
-end;
-
-{$ELSE}
-function StrStInsertPrim(Dest : PAnsiChar; S : PAnsiChar;
- Pos : Cardinal) : PAnsiChar; register;
-asm
- push eax {save because we will be changing them}
- push edi
- push esi
- push ebx
-
- mov ebx, ecx {move POS to ebx}
- mov esi, eax {copy Dest to ESI, S to EDI}
- mov edi, edx
-
- xor al, al {zero}
- or ecx, -1 {set ECX to $FFFFFFFF}
- cld {ensure forward}
- repne scasb {find null terminator}
- not ecx {calc length of source string (including null)}
- dec ecx {length without null}
- jecxz @@ExitPoint {if source length = 0, exit}
- push ecx {save length for later}
-
- mov edi, esi {reset EDI to Dest}
- or ecx, -1
- repne scasb {find null}
- not ecx {length of dest string}
-
- cmp ebx, ecx
- jb @@1
- mov ebx, ecx
- dec ebx
-
-@@1:
- std {backwards string ops}
- pop eax {restore length of S from stack}
- add edi, eax {set EDI S beyond end of Dest}
- dec edi {back up one for null}
-
- add esi, ecx {set ESI to end of Dest}
- dec esi {back up one for null}
- sub ecx, ebx {# of chars in Dest that are past Pos}
- rep movsb {adjust tail of string}
-
- mov esi, edx {set ESI to S}
- add esi, eax {set ESI to end of S}
- dec esi {back up one for null}
- mov ecx, eax {# of chars in S}
- rep movsb {copy S into Dest}
-
- cld {be a good neighbor}
-
-@@ExitPoint:
- pop ebx {restore registers}
- pop esi
- pop edi
- pop eax
-end;
-
-function StrStPos(P, S : PAnsiChar; var Pos : Cardinal) : boolean; register;
-asm
- push edi { Save registers }
- push esi
- push ebx
- push ecx
-
- mov ebx, eax { Move P to EBX }
- mov edi, edx { Move S to EDI & ESI }
- mov esi, edx
-
- xor eax, eax { Zero EAX }
- or ecx, -1 { Set ECX to FFFFFFFF }
- repne scasb { Find null at end of S }
- not ecx
-
- mov edx, ecx { Save length to EDX }
- dec edx { EDX has len of S }
- test edx, edx
- jz @@NotFound { If len of S = 0 then done }
-
- mov edi, ebx { Set EDI to beginning of P }
- or ecx, -1 { Set ECX to FFFFFFFF }
- repne scasb { Find null at end of P }
- not ecx
- dec ecx { ECX has len of P }
- jcxz @@NotFound { If len of P = 0 then done }
-
- dec edx
- sub ecx,edx { Max chars to search }
- jbe @@NotFound { Done if len S > len P }
- lodsb { Get first char of S in AL }
- mov edi,ebx { Set EDI to beginning of EDI }
-
-@@Next:
- repne scasb { Find first char of S in P }
- jne @@NotFound { If not found then done }
- test edx, edx { If length of S was one then found }
- jz @@Found
- push ecx
- push edi
- push esi
- mov ecx,edx
- repe cmpsb { See if remaining chars in S match }
- pop esi
- pop edi
- pop ecx
- je @@Found { Yes, so found }
- jmp @@Next { Look for next first char occurrence }
-
-@@NotFound:
- pop ecx
- xor eax,eax { Set return to False }
- jmp @@ExitPoint
-
-@@Found:
- dec edi { Calc position of found string }
- mov eax, edi
- sub eax, ebx
- pop ecx
- mov [ecx], eax
- mov eax, 1 { Set return to True }
-
-@@ExitPoint:
- pop ebx { Restore registers }
- pop esi
- pop edi
-end;
-{$ENDIF}
-
-function StrToLongPChar(S : PAnsiChar; var I : LongInt) : Boolean;
- {-Convert a string to a longint, returning true if successful}
-var
- Code : Cardinal;
- P : array[0..255] of AnsiChar;
-begin
- if StrLen(S)+1 > SizeOf(P) then begin
- Result := False;
- I := -1;
- Exit;
- end;
- StrCopy(P, S);
- TrimTrailPrimPChar(P);
- if StrStPos(P, '0x', Code) then begin
- StrStDeletePrim(P, Code, 2);
- StrChInsertPrim(P, '$', Code);
- end;
-{$IFNDEF FPC}
- Val(P, I, Code);
-{$ELSE}
- Val(String(P), I, Integer(Code));
-{$ENDIF}
- if Code <> 0 then begin
- I := Code - 1;
- Result := False;
- end else
- Result := True;
-end;
-
-procedure TrimAllSpacesPChar(P : PAnsiChar);
- {-Trim leading and trailing blanks from P}
-var
- I : Integer;
- PT : PAnsiChar;
-begin
- I := StrLen(P);
- if I = 0 then
- Exit;
-
- {delete trailing spaces}
- Dec(I);
- while (I >= 0) and (P[I] = ' ') do begin
- P[I] := #0;
- Dec(I);
- end;
-
- {delete leading spaces}
- I := 0;
- PT := P;
- while PT^ = ' ' do begin
- Inc(I);
- Inc(PT);
- end;
- if I > 0 then
- StrStDeletePrim(P, 0, I);
-end;
-
-function TrimEmbeddedZeros(const S : string) : string;
- {-trim embedded zeros from a numeric string in exponential format}
-var
- I, J : Integer;
-begin
- I := Pos('E', S);
- if I = 0 then
- Exit; {nothing to do}
-
- Result := S;
-
- {get rid of excess 0's after the decimal point}
- J := I;
- while (J > 1) and (Result[J-1] = '0') do
- Dec(J);
- if J <> I then begin
- System.Delete(Result, J, I-J);
-
- {get rid of the decimal point if that's all that's left}
- if (J > 1) and (Result[J-1] = '.') then
- System.Delete(Result, J-1, 1);
- end;
-
- {get rid of excess 0's in the exponent}
- I := Pos('E', Result);
- if I > 0 then begin
- Inc(I);
- J := I;
- while Result[J+1] = '0' do
- Inc(J);
- if J > I then
- System.Delete(Result, I+1, J-I);
- end;
-end;
-
-procedure TrimEmbeddedZerosPChar(P : PAnsiChar);
- {-Trim embedded zeros from a numeric string in exponential format}
-var
- I, J : Cardinal;
-begin
- if not StrChPos(P, 'E', I) then
- Exit;
-
- {get rid of excess 0's after the decimal point}
- J := I;
- while (J > 0) and (P[J-1] = '0') do
- Dec(J);
- if J <> I then begin
- StrStDeletePrim(P, J, I-J);
-
- {get rid of the decimal point if that's all that's left}
- if (J > 0) and (P[J-1] = '.') then
- StrStDeletePrim(P, J-1, 1);
- end;
-
- {Get rid of excess 0's in the exponent}
- if StrChPos(P, 'E', I) then begin
- Inc(I);
- J := I;
- while P[J+1] = '0' do
- Inc(J);
- if J > I then
- if P[J+1] = #0 then
- P[I-1] := #0
- else
- StrStDeletePrim(P, I+1, J-I);
- end;
-end;
-
-function TrimTrailingZeros(const S : string) : string;
- {-Trim trailing zeros from a numeric string. It is assumed that there is
- a decimal point prior to the zeros. Also strips leading spaces.}
-var
- I : Integer;
-begin
- if S = '' then
- Exit;
-
- Result := S;
- I := Length(Result);
- {delete trailing zeros}
- while (Result[I] = '0') and (I > 1) do
- Dec(I);
- {delete decimal point, if any}
- if Result[I] = '.' then
- Dec(I);
- Result := Trim(Copy(Result, 1, I));
-end;
-
-procedure TrimTrailingZerosPChar(P : PAnsiChar);
- {-Trim trailing zeros from a numeric string. It is assumed that there is
- a decimal point prior to the zeros. Also strips leading spaces.}
-var
- PT : PAnsiChar;
-begin
- PT := StrEnd(P);
- if Pointer(PT) = Pointer(P) then
- Exit;
-
- {back up to character prior to null}
- Dec(PT);
-
- {delete trailing zeros}
- while PT^ = '0' do begin
- PT^ := #0;
- Dec(PT);
- end;
-
- {delete decimal point, if any}
- if PT^ = '.' then
- PT^ := #0;
-
- TrimAllSpacesPChar(P);
-end;
-
-{$IFDEF NoAsm}
-function TrimTrailPrimPChar(S : PAnsiChar) : PAnsiChar;
-var
- AStr : string;
-begin
- AStr := StrPas(S);
- Result := StrPCopy(S, TrimRight(AStr));
-end;
-
-{$ELSE}
-function TrimTrailPrimPChar(S : PAnsiChar) : PAnsiChar; register;
-asm
- cld
- push edi
- mov edx, eax
- mov edi, eax
-
- or ecx, -1
- xor al, al
- repne scasb
- not ecx
- dec ecx
- jecxz @@ExitPoint
-
- dec edi
-
-@@1:
- dec edi
- cmp byte ptr [edi],' '
- jbe @@1
- mov byte ptr [edi+1],00h
-@@ExitPoint:
- mov eax, edx
- pop edi
-end;
-{$ENDIF}
-
-function TrimTrailPChar(Dest, S : PAnsiChar) : PAnsiChar;
- {-Return a string with trailing white space removed}
-begin
- StrCopy(Dest, S);
- Result := TrimTrailPrimPChar(Dest);
-end;
-
-{$IFDEF NoAsm}
-function UpCaseChar(C : AnsiChar) : AnsiChar;
-var
- AStr : string;
-begin
- AStr := AnsiUpperCase(C);
- Result := AStr[1];
-end;
-
-{$ELSE}
-function UpCaseChar(C : AnsiChar) : AnsiChar; register;
-asm
- and eax, 0FFh
- push eax
- call CharUpper
-end;
-{$ENDIF}
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovctable.pas b/Source/3rdParty/Orpheus/ovctable.pas
deleted file mode 100644
index 2c6a0569..00000000
--- a/Source/3rdParty/Orpheus/ovctable.pas
+++ /dev/null
@@ -1,6411 +0,0 @@
-{*********************************************************}
-{* OVCTABLE.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 ***** *}
-
-(*Changes)
-
- 10/20/01- Hdc changed to TOvcHdc for BCB Compatibility
-*)
-
-{$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 ovctable;
- {Orpheus table definitions}
-
-interface
-
-uses
- SysUtils, Classes,
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Graphics, Controls, Forms, StdCtrls,
- Menus, Dialogs, OvcMisc, OvcData, OvcConst, OvcBase, OvcCmd, OvcTCmmn,
- OvcTCAry, OvcTSelL, OvcTCell, OvcTCHdr, OvcTGPns,
- OvcTbClr, OvcTbRws, OvcTbCls, OvcDrag;
-
-type
- TOvcCustomTable = class(TOvcTableAncestor)
- {-The custom class for tables}
- protected {private}
- {property fields - even size}
- FActiveCol : TColNum; {column of active cell}
- FActiveRow : TRowNum; {row of active cell}
- FBlockColBegin : TColNum; {start column for settings}
- FBlockColEnd : TColNum; {end column for settings}
- FBlockRowBegin : TRowNum; {start row for settings}
- FBlockRowEnd : TRowNum; {end row for settings}
- FCells : TOvcTableCells; {independent cells}
- FColors : TOvcTableColors; {table cell colors}
- FCols : TOvcTableColumns; {table column definitions}
- FGridPenSet : TOvcGridPenSet; {set of grid pens}
- FLeftCol : TColNum; {leftmost column}
- FLockedCols : TColNum; {number of locked columns}
- FLockedRows : TRowNum; {number of locked rows}
- FLockedRowsCell : TOvcBaseTableCell; {cell for column headings}
- FRows : TOvcTableRows; {table row definitions}
- FSelAnchorCol : TColNum; {selection: anchor column}
- FSelAnchorRow : TRowNum; {selection: anchor row}
- FTopRow : TRowNum; {topmost row}
- FColorUnused : TColor; {color of unused area}
- FOldRowColBehavior: Boolean;
-
- {property fields - odd size}
- FAccess : TOvcTblAccess; {default access mode for the table}
- FAdjust : TOvcTblAdjust; {default adjustment for the table}
- FBorderStyle : TBorderStyle; {border type around table}
- FOptions : TOvcTblOptionSet; {set of table options}
- FScrollBars : TScrollStyle; {scroll bar presence}
- Filler : byte;
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
-
- {property event fields}
- FActiveCellChanged : TCellNotifyEvent; {active cell changed event}
- FActiveCellMoving : TCellMoveNotifyEvent; {active cell moving event}
- FBeginEdit : TCellBeginEditNotifyEvent;{active cell about to be edited}
- FClipboardCopy : TNotifyEvent; {copy to clipboard requested}
- FClipboardCut : TNotifyEvent; {cut to clipboard requested}
- FClipboardPaste : TNotifyEvent; {paste from clipboard requested}
- FColumnsChanged : TColChangeNotifyEvent; {column insert/delete/exchange}
- FDoneEdit : TCellNotifyEvent; {active cell has been edited}
- FEndEdit : TCellEndEditNotifyEvent;{active cell about to be stopped being edited}
- FEnteringColumn : TColNotifyEvent; {entering column event}
- FEnteringRow : TRowNotifyEvent; {entering row event}
- FGetCellData : TCellDataNotifyEvent; {get cell data event}
- FGetCellAttributes : TCellAttrNotifyEvent; {get cell attributes event}
- FLeavingColumn : TColNotifyEvent; {leaving column event}
- FLeavingRow : TRowNotifyEvent; {leaving row event}
- FLockedCellClick : TCellNotifyEvent; {locked cell clicked event}
- FPaintUnusedArea : TNotifyEvent; {unused bit needs painting event}
- FRowsChanged : TRowChangeNotifyEvent; {row insert/delete/exchange}
- FSizeCellEditor : TSizeCellEditorNotifyEvent;{sizing of cell editor}
- FTopLeftCellChanged : TCellNotifyEvent; {top left cell change event}
- FTopLeftCellChanging: TCellChangeNotifyEvent; {top left cell moving event}
- FUserCommand : TUserCommandEvent; {user command event}
- FOnResizeColumn : TColResizeEvent;
- FOnResizeRow : TRowResizeEvent;
-
- {other fields - even size}
- tbColNums : POvcTblDisplayArray; {displayed column numbers}
- tbRowNums : POvcTblDisplayArray; {displayed row numbers}
- tbRowsOnLastPage : TRowNum; {number of complete rows on last page}
- tbLastTopRow : TRowNum; {the last row number that can be top}
- tbColsOnLastPage : TColNum; {num of complete columns on rightmost page}
- tbLastLeftCol : TColNum; {the last column number that can be leftmost}
- tbLockCount : integer; {the lock display count}
- tbCmdTable : PString; {the command table name for the grid}
- tbState : TOvcTblStates; {the state of the table}
- tbSizeOffset : integer; {the offset of the sizing line}
- tbSizeIndex : integer; {the index of the sized row/col}
- tbMoveIndex : integer; {the index of the column being moved}
- tbMoveIndexTo : integer; {the index of the column being targeted by move}
- tbLastEntRow : TRowNum; {last row that was entered}
- tbLastEntCol : TColNum; {last column that was entered}
- tbActCell : TOvcBaseTableCell; {the active cell object}
- tbInvCells : TOvcCellArray; {cells that need repainting}
- tbSelList : TOvcSelectionList; {list of selected cells}
- tbCellAttrFont : TFont; {cached font for painting cells}
- tbColMoveCursor : HCursor; {cursor for column moves}
- tbRowMoveCursor : HCursor; {cursor for row moves}
- tbHSBarPosCount : integer; {number of positions for horz scrollbar}
- tbDrag : TOvcDragShow;
-
- {other fields - odd size}
- tbHasHSBar : boolean; {true if horiz scroll bar present}
- tbHasVSBar : boolean; {true if vert scroll bar present}
- tbUpdateSBs : boolean; {true if the scroll bars must be updated}
- tbIsSelecting : boolean; {is in mouse selection mode}
- tbIsDeselecting : boolean; {is in mouse deselection mode}
- tbIsKeySelecting : boolean; {is in key selection mode}
- tbMustUpdate : boolean; {scrolling has left an invalid region}
- tbMustFinishLoading : boolean; {finish loading data in CreateWnd}
- ProcessingVScrollMessage: Boolean;{Internal flag}
-
- protected
- {property read routines}
- function GetAllowRedraw : boolean;
- function GetColCount : TColNum;
- function GetColOffset(ColNum : TColNum) : integer;
- function GetRowLimit : TRowNum;
- function GetRowOffset(RowNum : TRowNum) : integer;
-
- {property write routines}
- procedure SetAccess(A : TOvcTblAccess);
- procedure SetActiveCol(ColNum : TColNum);
- procedure SetActiveRow(RowNum : TRowNum);
- procedure SetAdjust(A : TOvcTblAdjust);
- procedure SetAllowRedraw(AR : boolean);
- procedure SetBorderStyle(const BS : TBorderStyle);
- procedure SetBlockAccess(A : TOvcTblAccess);
- procedure SetBlockAdjust(A : TOvcTblAdjust);
- procedure SetBlockCell(C : TOvcBaseTableCell);
- procedure SetBlockColBegin(ColNum : TColNum);
- procedure SetBlockColEnd(ColNum : TColNum);
- procedure SetBlockColor(C : TColor);
- procedure SetBlockFont(F : TFont);
- procedure SetBlockRowBegin(RowNum : TRowNum);
- procedure SetBlockRowEnd(RowNum : TRowNum);
- procedure SetColors(C : TOvcTableColors);
- procedure SetColCount(CC : integer);
- procedure SetCols(CS : TOvcTableColumns);
- procedure SetLeftCol(ColNum : TColNum);
- procedure SetLockedCols(ColNum : TColNum);
- procedure SetLockedRows(RowNum : TRowNum);
- procedure SetLockedRowsCell(C : TOvcBaseTableCell);
- procedure SetOptions(O : TOvcTblOptionSet);
- procedure SetPaintUnusedArea(PUA : TNotifyEvent);
- procedure SetRowLimit(RowNum : TRowNum);
- procedure SetRows(RS : TOvcTableRows);
- procedure SetScrollBars(const SB : TScrollStyle);
- procedure SetTopRow(RowNum : TRowNum);
- procedure SetColorUnused(CU : TColor);
-
- {overridden Delphi VCL methods}
- procedure ChangeScale(M, D : integer); override;
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
-
- {general methods}
- function tbCalcActiveCellRect(var ACR : TRect) : boolean;
- function tbCalcCellsFromRect(const UR : TRect; var GR : TRect) : integer;
- procedure tbCalcColData(var CD : POvcTblDisplayArray; NewLeftCol : TColNum);
- procedure tbCalcColsOnLastPage;
- procedure tbCalcHSBarPosCount;
- function tbCalcRequiresVSBar : boolean;
- procedure tbCalcRowData(var RD : POvcTblDisplayArray; NewTopRow : TRowNum);
- procedure tbCalcRowsOnLastPage;
-
- procedure tbDrawActiveCell;
- procedure tbDrawCells(RowInxStart, RowInxEnd : integer;
- ColInxStart, ColInxEnd : integer);
- procedure tbDrawInvalidCells(InvCells : TOvcCellArray);
- procedure tbDrawMoveLine;
- procedure tbDrawRow(RowInx : integer; ColInxStart, ColInxEnd : integer);
- procedure tbDrawSizeLine;
- procedure tbDrawUnusedBit;
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
- function tbEditCellHasFocus(FocusHandle : TOvcHWnd{HWND}) : boolean;
-
- procedure tbEnsureColumnIsVisible(ColNum : TColNum);
- procedure tbEnsureRowIsVisible(RowNum : TRowNum);
-
- function tbFindCell(RowNum : TRowNum;
- ColNum : TColNum) : TOvcBaseTableCell;
- function tbFindColInx(ColNum : TColNum) : integer;
- function tbFindRowInx(RowNum : TRowNum) : integer;
-
- function tbIsOnGridLine(MouseX, MouseY : integer;
- var VerticalGrid : boolean) : boolean;
- function tbIsInMoveArea(MouseX, MouseY : integer;
- var IsColMove : boolean) : boolean;
- procedure tbSetActiveCellWithSel(RowNum : TRowNum;
- ColNum : TColNum);
- procedure tbSetActiveCellPrim(RowNum : TRowNum; ColNum : TColNum);
-
- {selection methods}
- procedure tbDeselectAll(CA : TOvcCellArray);
- function tbDeselectAllIterator(RowNum1 : TRowNum; ColNum1 : TColNum;
- RowNum2 : TRowNum; ColNum2 : TColNum;
- ExtraData : pointer) : boolean;
- procedure tbSelectCol(ColNum : TColNum);
- procedure tbSelectRow(RowNum : TRowNum);
- procedure tbSelectTable;
- procedure tbSetAnchorCell(RowNum : TRowNum; ColNum : TColNum;
- Action : TOvcTblSelectionType);
- procedure tbUpdateSelection(RowNum : TRowNum; ColNum : TColNum;
- Action : TOvcTblSelectionType);
-
- {notification procedures}
- procedure DoActiveCellChanged(RowNum : TRowNum; ColNum : TColNum);
- virtual;
- procedure DoActiveCellMoving(Command : word; var RowNum : TRowNum;
- var ColNum : TColNum); virtual;
- procedure DoBeginEdit(RowNum : TRowNum; ColNum : TColNum;
- var AllowIt : boolean); virtual;
- procedure DoClipboardCopy; virtual;
- procedure DoClipboardCut; virtual;
- procedure DoClipboardPaste; virtual;
- procedure DoColumnsChanged(ColNum1, ColNum2 : TColNum;
- Action : TOvcTblActions); virtual;
- procedure DoDoneEdit(RowNum : TRowNum; ColNum : TColNum); virtual;
- procedure DoEndEdit(Cell : TOvcBaseTableCell;
- RowNum : TRowNum; ColNum : TColNum;
- var AllowIt : boolean); virtual;
- procedure DoEnteringColumn(ColNum : TColNum); virtual;
- procedure DoEnteringRow(RowNum : TRowNum); virtual;
- procedure DoGetCellAttributes(RowNum : TRowNum; ColNum : TColNum;
- var CellAttr : TOvcCellAttributes); virtual;
- procedure DoGetCellData(RowNum : TRowNum; ColNum : TColNum;
- var Data : pointer;
- Purpose : TOvcCellDataPurpose); virtual;
- procedure DoLeavingColumn(ColNum : TColNum); virtual;
- procedure DoLeavingRow(RowNum : TRowNum); virtual;
- procedure DoLockedCellClick(RowNum : TRowNum; ColNum : TColNum); virtual;
- procedure DoOnMouseWheel(Shift : TShiftState; Delta, XPos, YPos : SmallInt);
- override;
- procedure DoPaintUnusedArea; virtual;
- procedure DoRowsChanged(RowNum1, RowNum2 : TRowNum;
- Action : TOvcTblActions); virtual;
- procedure DoSizeCellEditor(RowNum : TRowNum;
- ColNum : TColNum;
- var CellRect : TRect;
- var CellStyle: TOvcTblEditorStyle); virtual;
- procedure DoTopLeftCellChanged(RowNum : TRowNum; ColNum : TColNum); virtual;
- procedure DoTopLeftCellChanging(var RowNum : TRowNum;
- var ColNum : TColNum); virtual;
- procedure DoUserCommand(Cmd : word); virtual;
-
- {row/col data retrieval}
- function tbIsColHidden(ColNum : TColNum) : boolean;
- function tbIsRowHidden(RowNum : TRowNum) : boolean;
- procedure tbQueryColData(ColNum : TColNum;
- var W : integer;
- var A : TOvcTblAccess;
- var H : boolean);
- procedure tbQueryRowData(RowNum : TRowNum;
- var Ht: integer;
- var H : boolean);
-
- {invalidation}
- procedure tbInvalidateColHdgPrim(ColNum : TColNum; InvCells : TOvcCellArray);
- procedure tbInvalidateRowHdgPrim(RowNum : TRowNum; InvCells : TOvcCellArray);
-
- {scrollbar stuff}
- procedure tbSetScrollPos(SB : TOvcScrollBar);
- procedure tbSetScrollRange(SB : TOvcScrollBar);
-
- {active cell movement}
- procedure tbMoveActCellBotOfPage;
- procedure tbMoveActCellBotRight;
- procedure tbMoveActCellDown;
- procedure tbMoveActCellFirstCol;
- procedure tbMoveActCellFirstRow;
- procedure tbMoveActCellLastCol;
- procedure tbMoveActCellLastRow;
- procedure tbMoveActCellLeft;
- procedure tbMoveActCellPageDown;
- procedure tbMoveActCellPageLeft;
- procedure tbMoveActCellPageRight;
- procedure tbMoveActCellPageUp;
- procedure tbMoveActCellRight;
- procedure tbMoveActCellTopLeft;
- procedure tbMoveActCellTopOfPage;
- procedure tbMoveActCellUp;
-
- {scrollbar scrolling routine}
- procedure tbScrollBarDown;
- procedure tbScrollBarLeft;
- procedure tbScrollBarPageDown;
- procedure tbScrollBarPageLeft;
- procedure tbScrollBarPageRight;
- procedure tbScrollBarPageUp;
- procedure tbScrollBarRight;
- procedure tbScrollBarUp;
-
- {table scrolling routines}
- procedure tbScrollTableLeft(NewLeftCol : TColNum);
- procedure tbScrollTableRight(NewLeftCol : TColNum);
- procedure tbScrollTableUp(NewTopRow : TRowNum);
- procedure tbScrollTableDown(NewTopRow : TRowNum);
-
- {notifications}
- procedure tbCellChanged(Sender : TObject); override;
- procedure tbColChanged(Sender : TObject; ColNum1, ColNum2 : TColNum;
- Action : TOvcTblActions);
- procedure tbGridPenChanged(Sender : TObject);
- procedure tbRowChanged(Sender : TObject; RowNum1, RowNum2 : TRowNum;
- Action : TOvcTblActions);
- procedure tbColorsChanged(Sender : TObject);
-
- {streaming routines}
- procedure DefineProperties(Filer : TFiler); override;
- procedure tbFinishLoadingDefaultCells;
- procedure tbReadColData(Reader : TReader);
- procedure tbReadRowData(Reader : TReader);
- procedure tbWriteColData(Writer : TWriter);
- procedure tbWriteRowData(Writer : TWriter);
-
- {Cell-Table interaction messages}
- procedure ctimLoadDefaultCells(var Msg : TMessage); message ctim_LoadDefaultCells;
- procedure ctimQueryOptions(var Msg : TMessage); message ctim_QueryOptions;
- procedure ctimQueryColor(var Msg : TMessage); message ctim_QueryColor;
- procedure ctimQueryFont(var Msg : TMessage); message ctim_QueryFont;
- procedure ctimQueryLockedCols(var Msg : TMessage); message ctim_QueryLockedCols;
- procedure ctimQueryLockedRows(var Msg : TMessage); message ctim_QueryLockedRows;
- procedure ctimQueryActiveCol(var Msg : TMessage); message ctim_QueryActiveCol;
- procedure ctimQueryActiveRow(var Msg : TMessage); message ctim_QueryActiveRow;
- procedure ctimRemoveCell(var Msg : TMessage); message ctim_RemoveCell;
- procedure ctimStartEdit(var Msg : TMessage); message ctim_StartEdit;
- procedure ctimStartEditMouse(var Msg : TWMMouse); message ctim_StartEditMouse;
- procedure ctimStartEditKey(var Msg : TWMKey); message ctim_StartEditKey;
-
- {Delphi component messages}
- procedure CMColorChanged(var Msg : TMessage); message CM_COLORCHANGED;
-{$IFNDEF LCL}
- procedure CMCtl3DChanged(var Msg : TMessage); message CM_CTL3DCHANGED;
-{$ENDIF}
- procedure CMDesignHitTest(var Msg : TCMDesignHitTest); message CM_DESIGNHITTEST;
- procedure CMFontChanged(var Msg : TMessage); message CM_FONTCHANGED;
-
- {Windows messages}
- procedure WMCancelMode(var Msg : TMessage); message WM_CANCELMODE;
- procedure WMEraseBkGnd(var Msg : TWMEraseBkGnd); message WM_ERASEBKGND;
- procedure WMGetDlgCode(var Msg : TMessage); message WM_GETDLGCODE;
- procedure WMHScroll(var Msg : TWMScroll); message WM_HSCROLL;
- procedure WMKeyDown(var Msg : TWMKey); message WM_KEYDOWN;
- procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS;
- procedure WMLButtonDblClk(var Msg : TWMMouse); message WM_LBUTTONDBLCLK;
- procedure WMLButtonDown(var Msg : TWMMouse); message WM_LBUTTONDOWN;
- procedure WMLButtonUp(var Msg : TWMMouse); message WM_LBUTTONUP;
- procedure WMMouseMove(var Msg : TWMMouse); message WM_MOUSEMOVE;
- procedure WMNCHitTest(var Msg : TMessage); message WM_NCHITTEST;
- procedure WMSetCursor(var Msg : TWMSetCursor); message WM_SETCURSOR;
- procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
- procedure WMVScroll(var Msg : TWMScroll); message WM_VSCROLL;
-
- {unpublishable or should not be published properties}
- property AllowRedraw : boolean
- read GetAllowRedraw write SetAllowRedraw
- stored false;
-
- property BlockAccess : TOvcTblAccess
- write SetBlockAccess;
-
- property BlockAdjust : TOvcTblAdjust
- write SetBlockAdjust;
-
- property BlockColBegin : TColNum
- read FBlockColBegin write SetBlockColBegin;
-
- property BlockColEnd : TColNum
- read FBlockColEnd write SetBlockColEnd;
-
- property BlockColor : TColor
- write SetBlockColor;
-
- property BlockCell : TOvcBaseTableCell
- write SetBlockCell;
-
- property BlockFont : TFont
- write SetBlockFont;
-
- property BlockRowBegin : TRowNum
- read FBlockRowBegin write SetBlockRowBegin;
-
- property BlockRowEnd : TRowNum
- read FBlockRowEnd write SetBlockRowEnd;
-
- property ColOffset [ColNum : TColNum] : integer
- read GetColOffset;
-
- property RowOffset [RowNum : TRowNum] : integer
- read GetRowOffset;
-
- property TableState : TOvcTblStates
- read tbState;
-
- {publishable properties}
- property Access : TOvcTblAccess
- read FAccess write SetAccess;
-
- property ActiveCol : TColNum
- read FActiveCol write SetActiveCol;
-
- property ActiveRow : TRowNum
- read FActiveRow write SetActiveRow;
-
- property Adjust : TOvcTblAdjust
- read FAdjust write SetAdjust;
-
- property BorderStyle : TBorderStyle
- read FBorderStyle write SetBorderStyle;
-
- property ColCount : TColNum
- read GetColCount write SetColCount;
-
- property Colors : TOvcTableColors
- read FColors write SetColors;
-
- property ColorUnused : TColor
- read FColorUnused write SetColorUnused;
-
- property Columns : TOvcTableColumns
- read FCols write SetCols;
-
- property GridPenSet : TOvcGridPenSet
- read FGridPenSet write FGridPenSet;
-
- property LeftCol : TColNum
- read FLeftCol write SetLeftCol;
-
- property LockedCols : TColNum
- read FLockedCols write SetLockedCols;
-
- property LockedRows : TRowNum
- read FLockedRows write SetLockedRows;
-
- property LockedRowsCell : TOvcBaseTableCell
- read FLockedRowsCell write SetLockedRowsCell;
-
- property OldRowColBehavior : Boolean
- read FOldRowColBehavior write FOldRowColBehavior;
-
- property Options : TOvcTblOptionSet
- read FOptions write SetOptions;
-
- property RowLimit : TRowNum
- read GetRowLimit write SetRowLimit;
-
- property Rows : TOvcTableRows
- read FRows write SetRows;
-
- property ScrollBars : TScrollStyle
- read FScrollBars write SetScrollBars;
-
- property TopRow : TRowNum
- read FTopRow write SetTopRow;
-
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D default True;
-{$ENDIF}
-
- {New events}
- property OnActiveCellChanged : TCellNotifyEvent
- read FActiveCellChanged write FActiveCellChanged;
-
- property OnActiveCellMoving : TCellMoveNotifyEvent
- read FActiveCellMoving write FActiveCellMoving;
-
- property OnBeginEdit : TCellBeginEditNotifyEvent
- read FBeginEdit write FBeginEdit;
-
- property OnClipboardCopy : TNotifyEvent
- read FClipboardCopy write FClipboardCopy;
-
- property OnClipboardCut : TNotifyEvent
- read FClipboardCut write FClipboardCut;
-
- property OnClipboardPaste : TNotifyEvent
- read FClipboardPaste write FClipboardPaste;
-
- property OnColumnsChanged : TColChangeNotifyEvent
- read FColumnsChanged write FColumnsChanged;
-
- property OnDoneEdit : TCellNotifyEvent
- read FDoneEdit write FDoneEdit;
-
- property OnEndEdit : TCellEndEditNotifyEvent
- read FEndEdit write FEndEdit;
-
- property OnEnteringColumn : TColNotifyEvent
- read FEnteringColumn write FEnteringColumn;
-
- property OnEnteringRow : TRowNotifyEvent
- read FEnteringRow write FEnteringRow;
-
- property OnGetCellData : TCellDataNotifyEvent
- read FGetCellData write FGetCellData;
-
- property OnGetCellAttributes : TCellAttrNotifyEvent
- read FGetCellAttributes write FGetCellAttributes;
-
- property OnLeavingColumn : TColNotifyEvent
- read FLeavingColumn write FLeavingColumn;
-
- property OnLeavingRow : TRowNotifyEvent
- read FLeavingRow write FLeavingRow;
-
- property OnLockedCellClick : TCellNotifyEvent
- read FLockedCellClick write FLockedCellClick;
-
- property OnPaintUnusedArea : TNotifyEvent
- read FPaintUnusedArea write SetPaintUnusedArea;
-
- property OnResizeColumn : TColResizeEvent
- read FOnResizeColumn write FOnResizeColumn;
-
- property OnResizeRow : TRowResizeEvent
- read FOnResizeRow write FOnResizeRow;
-
- property OnRowsChanged : TRowChangeNotifyEvent
- read FRowsChanged write FRowsChanged;
-
- property OnSizeCellEditor : TSizeCellEditorNotifyEvent
- read FSizeCellEditor write FSizeCellEditor;
-
- property OnTopLeftCellChanged : TCellNotifyEvent
- read FTopLeftCellChanged write FTopLeftCellChanged;
-
- property OnTopLeftCellChanging : TCellChangeNotifyEvent
- read FTopLeftCellChanging write FTopLeftCellChanging;
-
- property OnUserCommand : TUserCommandEvent
- read FUserCommand write FUserCommand;
-
- public
- {overridden methods}
- constructor Create(AOwner : TComponent); override;
- destructor Destroy; override;
- procedure CreateParams(var Params : TCreateParams); override;
- procedure CreateWnd; override;
- procedure Loaded; override;
- procedure Paint; override;
-{$IFNDEF LCL}
- procedure SetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
-{$ELSE}
- procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
-{$ENDIF}
-
- {new public methods}
- function CalcRowColFromXY(X, Y : integer;
- var RowNum : TRowNum;
- var ColNum : TColNum) : TOvcTblRegion;
- function FilterKey(var Msg : TWMKey) : TOvcTblKeyNeeds; override;
- procedure GetDisplayedColNums(var NA : TOvcTableNumberArray);
- procedure GetDisplayedRowNums(var NA : TOvcTableNumberArray);
- procedure ResolveCellAttributes(RowNum : TRowNum; ColNum : TColNum;
- var CellAttr : TOvcCellAttributes); override;
-
- {methods for setting cells, faster than setting row/col properties}
- procedure SetActiveCell(RowNum : TRowNum; ColNum : TColNum);
- procedure SetTopLeftCell(RowNum : TRowNum; ColNum : TColNum);
-
- {methods for calculating next/prev row/col numbers for main area}
- function IncCol(ColNum : TColNum; Direction : integer) : TColNum;
- function IncRow(RowNum : TRowNum; Direction : integer) : TRowNum;
-
- {methods for invalidating cells to force a redraw}
- procedure InvalidateCell(RowNum : TRowNum; ColNum : TColNum);
- procedure InvalidateColumn(ColNum : TColNum);
- procedure InvalidateRow(RowNum : TRowNum);
- procedure InvalidateTable;
- procedure InvalidateCellsInRect(const R : TRect);
- procedure InvalidateColumnHeading(ColNum : TColNum);
- procedure InvalidateRowHeading(RowNum : TRowNum);
- procedure InvalidateTableNotLockedCols;
- procedure InvalidateTableNotLockedRows;
-
- {selection methods}
- function HaveSelection : boolean;
- function InSelection(RowNum : TRowNum; ColNum : TColNum) : boolean;
- procedure IterateSelections(SI : TSelectionIterator; ExtraData : pointer);
-
- {editing state method}
- function InEditingState : boolean;
- function SaveEditedData : boolean;
- function StartEditingState : boolean;
- function StopEditingState(SaveValue : boolean) : boolean;
-
- {scrollbar scrolling routine}
- procedure ProcessScrollBarClick(ScrollBar : TOvcScrollBar;
- ScrollCode : TScrollCode); virtual;
-
- {active cell movement routine}
- procedure MoveActiveCell(Command : word); virtual;
-
- {public property}
- property Cells : TOvcTableCells
- read FCells;
-
-
- end;
-
- TOvcTable = class(TOvcCustomTable)
- public
- property AllowRedraw;
- property BlockAccess;
- property BlockAdjust;
- property BlockColBegin;
- property BlockColEnd;
- property BlockColor;
- property BlockCell;
- property BlockFont;
- property BlockRowBegin;
- property BlockRowEnd;
- property Canvas;
- property ColOffset;
- property RowOffset;
- property TableState;
- published
- {Properties}
- property LockedRows default 1;
- property TopRow default 1;
- property ActiveRow default 1;
- property RowLimit default 10;
-
- property LockedCols default 1;
- property LeftCol default 1;
- property ActiveCol default 1;
-
- property OldRowColBehavior default false;
-
- {$IFDEF VERSION4}
- property Anchors;
- property Constraints;
- property DragKind;
- {$ENDIF}
- property Access default otxNormal;
- property Adjust default otaCenterLeft;
- property Align;
- property BorderStyle default bsSingle;
- property ColCount stored False;
- property Color default tbDefTableColor;
- property ColorUnused default clWindow;
- property Colors;
- property Columns;
- property Controller;
- property Ctl3D;
- property DragCursor;
- property DragMode;
- property Enabled;
- property Font;
- property GridPenSet;
- property LockedRowsCell;
- property Options default [];
- property ParentColor default False;
-{$IFNDEF LCL}
- property ParentCtl3D;
-{$ENDIF}
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property Rows;
- property ScrollBars default ssBoth;
- property ShowHint;
- property TabOrder;
- property TabStop default True;
- property Visible;
-
- {Events}
- property OnActiveCellChanged;
- property OnActiveCellMoving;
- property OnBeginEdit;
- property OnClipboardCopy;
- property OnClipboardCut;
- property OnClipboardPaste;
- property OnColumnsChanged;
- property OnDblClick;
- property OnDoneEdit;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEndEdit;
- property OnEnter;
- property OnEnteringColumn;
- property OnEnteringRow;
- property OnExit;
- property OnGetCellData;
- property OnGetCellAttributes;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnLeavingColumn;
- property OnLeavingRow;
- property OnLockedCellClick;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnMouseWheel;
- property OnPaintUnusedArea;
- property OnResizeColumn;
- property OnResizeRow;
- property OnRowsChanged;
- property OnSizeCellEditor;
- property OnTopLeftCellChanged;
- property OnTopLeftCellChanging;
- property OnUserCommand;
- end;
-
-implementation
-{===== Local Routines ================================================}
-
-function NewString(const S: string): PString;
-begin
- New(Result);
- Result^ := S;
-end;
-
-procedure DisposeString(P: PString);
-begin
- if (P <> nil)
- and (P^ <> '') then
- Dispose(P);
-end;
-
-
-{===== TOvcTable creation and destruction ============================}
-
-constructor TOvcCustomTable.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
-
- ProcessingVScrollMessage := false;
-
- tbState := [otsNormal];
-
- if NewStyleControls then
- ControlStyle := ControlStyle + [csOpaque, csCaptureMouse, csDoubleClicks]
- else
- ControlStyle := ControlStyle + [csOpaque, csCaptureMouse, csDoubleClicks, csFramed];
-
- Height := tbDefHeight;
- Width := tbDefWidth;
- FColorUnused := clWindow;
-
- ParentColor := false;
- Color := tbDefTableColor;
- TabStop := true;
-
-
- FGridPenSet := TOvcGridPenSet.Create;
- FGridPenSet.OnCfgChanged := tbGridPenChanged;
-
- FColors := TOvcTableColors.Create;
- FColors.OnCfgChanged := tbColorsChanged;
-
- FCols := TOvcTableColumns.Create(Self, tbDefColCount, TOvcTableColumn);
- FCols.OnColumnChanged := tbColChanged;
- FCols.Table := Self;
-
- FCells := TOvcTableCells.Create(Self);
- FCells.OnCfgChanged := tbCellChanged;
- FCells.Table := Self;
- tbInvCells := TOvcCellArray.Create;
-
- FRows := TOvcTableRows.Create;
- RowLimit := tbDefRowCount;
- FRows.OnCfgChanged := tbRowChanged;
-
- FBorderStyle := tbDefBorderStyle;
- FScrollBars := tbDefScrollBars;
- FAccess := tbDefAccess;
- FAdjust := tbDefAdjust;
- tbCellAttrFont := TFont.Create;
-
- FActiveCol := tbDefLockedCols;
- FLockedCols := tbDefLockedCols;
- FLeftCol := tbDefLockedCols;
- FSelAnchorCol := tbDefLockedCols;
-
- FActiveRow := tbDefLockedRows;
- FLockedRows := tbDefLockedRows;
- FTopRow := tbDefLockedRows;
- FSelAnchorRow := tbDefLockedRows;
-
-{$IFDEF LCL}
- FCtl3D := True;
-{$ENDIF}
-
-{$IFNDEF LCL}
- tbColMoveCursor := LoadBaseCursor('ORCOLUMNMOVECURSOR');
- tbRowMoveCursor := LoadBaseCursor('ORROWMOVECURSOR');
-{$ELSE}
- {$IFDEF MSWINDOWS} //Has never worked, plus crashes Carbon, so leave out for now.
- tbColMoveCursor := LoadCursorFromLazarusResource('ORCOLUMNMOVECURSOR');
- tbRowMoveCursor := LoadCursorFromLazarusResource('ORROWMOVECURSOR');
- {$ENDIF}
-{$ENDIF}
-
- tbSelList := TOvcSelectionList.Create(tbDefRowCount, tbDefColCount);
-
- tbLastEntRow := -1;
- tbLastEntCol := -1;
-
- tbCmdTable := NewString(GetOrphStr(SCGridTableName));
-
- AssignDisplayArray(tbColNums, succ(tbDefColCount));
- AssignDisplayArray(tbRowNums, succ(tbDefRowCount));
-
- if csDesigning in ComponentState then
- tbState := tbState + [otsDesigning]
- else
- tbState := tbState + [otsUnfocused];
-
- tbMustFinishLoading := true;
- end;
-{--------}
-
-destructor TOvcCustomTable.Destroy;
- begin
- if not (csDestroying in ComponentState) then
- Destroying;
- FCols.Free;
- FCells.Free;
- FRows.Free;
- tbInvCells.Free;
- tbSelList.Free;
- tbCellAttrFont.Free;
- if Assigned(tbColNums) then
- AssignDisplayArray(tbColNums, 0);
- if Assigned(tbRowNums) then
- AssignDisplayArray(tbRowNums, 0);
- DisposeString(tbCmdTable);
- GridPenSet.Free;
- FColors.Free;
-
- inherited Destroy;
- end;
-{--------}
-
-procedure TOvcCustomTable.CreateParams(var Params: TCreateParams);
- begin
- inherited CreateParams(Params);
-
- with Params do
- Style := LongInt(Style) or OvcData.ScrollBarStyles[FScrollBars]
- or OvcData.BorderStyles[FBorderStyle];
-
- if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then begin
- Params.Style := Params.Style and not WS_BORDER;
- Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
- end;
-
-{$IFDEF LCL}
- inherited SetBorderStyle(FBorderStyle);
-{$ENDIF}
- end;
-{--------}
-
-procedure TOvcCustomTable.CreateWnd;
- begin
- inherited CreateWnd;
- {post a message to ourselves to finish loading the cells}
- {--the reason for this is that cell components _may_ be }
- { on a data module: we must wait until all data modules}
- { have been created, otherwise we may not pick up some }
- { cell references (Delphi 2 does not guarantee any }
- { particular order for form/data module creation). }
-
- PostMessage(Handle, ctim_LoadDefaultCells, 0, 0);
-
- tbLockCount := 0;
-
- tbHasHSBar := false;
- tbHasVSBar := false;
- if (FScrollBars = ssBoth) or (FScrollBars = ssHorizontal) then
- tbHasHSBar := true;
- if (FScrollBars = ssBoth) or (FScrollBars = ssVertical) then
- tbHasVSBar := true;
-
- tbCalcColData(tbColNums, LeftCol);
- tbCalcRowData(tbRowNums, TopRow);
- {make sure the column/row properties are valid}
- LeftCol := LeftCol;
- TopRow := TopRow;
- ActiveCol := ActiveCol;
- ActiveRow := ActiveRow;
- FSelAnchorCol := ActiveCol;
- FSelAnchorRow := ActiveRow;
-
- {Set up the scrollbars}
- tbSetScrollRange(otsbHorizontal);
- tbSetScrollPos(otsbHorizontal);
- tbSetScrollRange(otsbVertical);
- tbSetScrollPos(otsbVertical);
-
- {Must trigger the active cell and topleft cell change events}
- DoTopLeftCellChanged(TopRow, LeftCol);
- DoActiveCellChanged(ActiveRow, ActiveCol);
-
- if not (otsDesigning in tbState) and (otoAlwaysEditing in Options) then
- PostMessage(Handle, ctim_StartEdit, 0, 0);
- end;
-{--------}
-
-procedure TOvcCustomTable.Loaded;
- begin
- inherited Loaded;
- end;
-
-{==TOvcTable property streaming routines=============================}
-
-procedure TOvcCustomTable.DefineProperties(Filer : TFiler);
- begin
- inherited DefineProperties(Filer);
- with Filer do
- begin
- DefineProperty('RowData', tbReadRowData, tbWriteRowData, true);
- DefineProperty('ColData', tbReadColData, tbWriteColData, true);
- end;
- end;
-{--------}
-
-procedure TOvcCustomTable.tbFinishLoadingDefaultCells;
- var
- i : integer;
- begin
- FCols.tcStopLoading;
- {if our cell list is empty refresh it now}
- if (taCellList.Count = 0) then
- begin
- if Assigned(FLockedRowsCell) then
- tbIncludeCell(FLockedRowsCell);
- for i := 0 to pred(FCols.Count) do
- tbIncludeCell(FCols.DefaultCell[i]);
- {we don't have to do the Cells matrix: no design time support}
- end;
- end;
-{--------}
-
-procedure TOvcCustomTable.tbReadColData(Reader : TReader);
- var
- ColObj : TOvcTableColumn;
- Fixups : TStringList;
- begin
- AllowRedraw := false;
- with Reader do
- begin
- ReadListBegin;
- FCols.Clear;
- Fixups := FCols.tcStartLoading;
- while not EndOfList do
- begin
- ColObj := TOvcTableColumn.Create(Self);
- ColObj.Width := Readinteger;
- ColObj.Hidden := ReadBoolean;
- if ReadBoolean then
- Fixups.AddObject(ReadString, ColObj);
- FCols.Append(ColObj);
- end;
- ReadListEnd;
- end;
- AllowRedraw := true;
- end;
-{--------}
-
-procedure TOvcCustomTable.tbReadRowData(Reader : TReader);
- var
- RowNum : TRowNum;
- RS : TRowStyle;
- begin
- with Reader do
- begin
- ReadListBegin;
- FRows.Clear;
- FRows.DefaultHeight := Readinteger;
- while not EndOfList do
- begin
- RowNum := Readinteger;
- RS.Hidden := ReadBoolean;
- RS.Height := Readinteger;
- FRows[RowNum] := RS;
- end;
- ReadListEnd;
- end;
- end;
-{--------}
-
-procedure TOvcCustomTable.tbWriteColData(Writer : TWriter);
- var
- ColNum : TColNum;
- S : string;
- begin
- if tbMustFinishLoading then begin
- tbFinishLoadingCellList;
- tbFinishLoadingDefaultCells;
- tbMustFinishLoading := false;
- end;
-
- with Writer do
- begin
- WriteListBegin;
- for ColNum := 0 to pred(ColCount) do
- with FCols[ColNum] do
- begin
- WriteInteger(Width);
- WriteBoolean(Hidden);
- if (DefaultCell <> nil) then
- begin
- WriteBoolean(true);
- S := DefaultCell.Owner.Name;
- if (S <> '') then
- S := S + '.' + DefaultCell.Name
- else
- S := DefaultCell.Name;
- WriteString(S);
- end
- else
- WriteBoolean(false);
- end;
- WriteListEnd;
- end;
- end;
-{--------}
-
-procedure TOvcCustomTable.tbWriteRowData(Writer : TWriter);
- var
- RowNum : TRowNum;
- RS : TRowStyle;
- begin
- with Writer do
- begin
- WriteListBegin;
- Writeinteger(FRows.DefaultHeight);
- for RowNum := 0 to pred(FRows.Limit) do
- if FRows.RowIsSpecial[RowNum] then
- begin
- Writeinteger(RowNum);
- RS := FRows[RowNum];
- WriteBoolean(RS.Hidden);
- Writeinteger(RS.Height);
- end;
- WriteListEnd;
- end;
- end;
-{====================================================================}
-
-
-{==TOvcTable property read routines==================================}
-function TOvcCustomTable.GetAllowRedraw : boolean;
- begin
- Result := (tbLockCount = 0);
- end;
-{--------}
-function TOvcCustomTable.GetColCount : TColNum;
- begin
- Result := FCols.Count;
- end;
-{--------}
-function TOvcCustomTable.GetColOffset(ColNum : TColNum) : integer;
- var
- ColInx : integer;
- begin
- ColInx := tbFindColInx(ColNum);
- if (ColInx <> -1) then
- Result := tbColNums^.Ay[ColInx].Offset
- else
- Result := -1;
- end;
-{--------}
-function TOvcCustomTable.GetRowLimit : TRowNum;
- begin
- Result := FRows.Limit;
- end;
-{--------}
-function TOvcCustomTable.GetRowOffset(RowNum : TRowNum) : integer;
- var
- RowInx : integer;
- begin
- RowInx := tbFindRowInx(RowNum);
- if (RowInx <> -1) then
- Result := tbRowNums^.Ay[RowInx].Offset
- else
- Result := -1;
- end;
-{--------}
-procedure TOvcCustomTable.ResolveCellAttributes(RowNum : TRowNum; ColNum : TColNum;
- var CellAttr : TOvcCellAttributes);
- var
- TempAccess : TOvcTblAccess;
- TempAdjust : TOvcTblAdjust;
- TempColor : TColor;
- TempFontColor : TColor;
- TempSparseAttr: TOvcSparseAttr;
- begin
- FCells.ResolveFullAttr(RowNum, ColNum, TempSparseAttr);
- with CellAttr do
- begin
- {calculate the access rights}
- TempAccess := TempSparseAttr.scaAccess;
- if (TempAccess = otxDefault) then
- begin
- TempAccess := caAccess;
- if (TempAccess = otxDefault) then
- TempAccess := Access;
- end;
- caAccess := TempAccess;
- {calculate the adjustment}
- TempAdjust := TempSparseAttr.scaAdjust;
- if (TempAdjust = otaDefault) then
- begin
- TempAdjust := caAdjust;
- if (TempAdjust = otaDefault) then
- TempAdjust := Adjust;
- end;
- caAdjust := TempAdjust;
- {calculate the font}
- if Assigned(TempSparseAttr.scaFont) then
- caFont.Assign(TempSparseAttr.scaFont);
- {calculate the colors}
- if (RowNum = ActiveRow) and (ColNum = ActiveCol) then
- if (otsFocused in tbState) then
- if InEditingState or
- ((otoAlwaysEditing in Options) and (caAccess = otxNormal)) then
- begin
- TempColor := Colors.Editing;
- TempFontColor := Colors.EditingText
- end
- else
- begin
- TempColor := Colors.ActiveFocused;
- TempFontColor := Colors.ActiveFocusedText;
- end
- else
- begin
- TempColor := Colors.ActiveUnfocused;
- TempFontColor := Colors.ActiveUnfocusedText;
- end
- else
- begin
- if (RowNum = ActiveRow) and (otoBrowseRow in FOptions) then
- if (otsFocused in tbState) then
- begin
- TempColor := Colors.ActiveFocused;
- TempFontColor := Colors.ActiveFocusedText;
- end
- else
- begin
- TempColor := Colors.ActiveUnfocused;
- TempFontColor := Colors.ActiveUnfocusedText;
- end
- else if InSelection(RowNum, ColNum) then
- begin
- TempColor := Colors.Selected;
- TempFontColor := Colors.SelectedText;
- end
- else
- begin
- TempColor := TempSparseAttr.scaColor;
- if Assigned(TempSparseAttr.scaFont) then
- TempFontColor := TempSparseAttr.scaFont.Color
- else if (RowNum < LockedRows) or (ColNum < LockedCols) then
- TempFontColor := Colors.LockedText
- else
- TempFontColor := caFontColor;
- if (TempColor = clOvcTableDefault) then
- if (RowNum < LockedRows) or (ColNum < LockedCols) then
- TempColor := Colors.Locked
- else
- TempColor := caColor;
- end;
- end;
- caColor := TempColor;
- caFontColor := TempFontColor;
- end;
- DoGetCellAttributes(RowNum, ColNum, CellAttr);
- end;
-{====================================================================}
-
-
-{==TOvcTable property write routines=================================}
-procedure TOvcCustomTable.SetAccess(A : TOvcTblAccess);
- var
- TempAccess : TOvcTblAccess;
- begin
- if (A = otxDefault) then
- TempAccess := tbDefAccess
- else TempAccess := A;
- if (TempAccess <> FAccess) then
- begin
- AllowRedraw := false;
- try
- if (TempAccess = otxInvisible) or (FAccess = otxInvisible) then
- InvalidateTable;
- FAccess := TempAccess;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetActiveCell(RowNum : TRowNum; ColNum : TColNum);
- begin
- DoActiveCellMoving(ccNone, RowNum, ColNum);
- tbSetActiveCellWithSel(RowNum, ColNum);
- end;
-{--------}
-procedure TOvcCustomTable.tbSetActiveCellWithSel(RowNum : TRowNum;
- ColNum : TColNum);
- begin
- if tbIsKeySelecting then
- tbUpdateSelection(RowNum, ColNum, tstDeselectAll)
- else
- tbSetAnchorCell(RowNum, ColNum, tstDeselectAll);
- tbSetActiveCellPrim(RowNum, ColNum);
- end;
-{--------}
-
-procedure TOvcCustomTable.tbSetActiveCellPrim(RowNum : TRowNum; ColNum : TColNum);
- var
- TempInvCells : TOvcCellArray;
- begin
- {verify the row/column numbers to be visible}
- RowNum := IncRow(RowNum, 0);
- ColNum := IncCol(ColNum, 0);
- {if nothing to do, get out}
- if (RowNum = FActiveRow) and (ColNum = FActiveCol) then
- Exit;
- {if can't do anything visually, just set the internal fields and
- then exit}
- if (not HandleAllocated) or
- (tbRowNums^.Count = 0) or (tbColNums^.Count = 0) then
- begin
- FActiveRow := RowNum;
- FActiveCol := ColNum;
- Exit;
- end;
- {set the new active cell}
- TempInvCells := nil;
- AllowRedraw := false;
- try
- TempInvCells := TOvcCellArray.Create;
- if (RowNum <> FActiveRow) then
- begin
- tbInvalidateRowHdgPrim(FActiveRow, TempInvCells);
- InvalidateRowHeading(RowNum);
- DoLeavingRow(FActiveRow);
- end;
- if (ColNum <> FActiveCol) then
- begin
- tbInvalidateColHdgPrim(FActiveCol, TempInvCells);
- InvalidateColumnHeading(ColNum);
- DoLeavingColumn(FActiveCol);
- end;
- tbInvCells.DeleteCell(ActiveRow, ActiveCol);
- TempInvCells.AddCell(ActiveRow, ActiveCol);
-
- if not OldRowColBehavior then
- if FActiveRow <> RowNum then
- DoEnteringRow(RowNum);
-
- FActiveRow := RowNum;
-
- if not OldRowColBehavior then
- if FActiveCol <> ColNum then
- DoEnteringColumn(ColNum);
-
- FActiveCol := ColNum;
- tbDrawInvalidCells(TempInvCells);
- tbEnsureRowIsVisible(RowNum);
- tbEnsureColumnIsVisible(ColNum);
- if not (otsDesigning in tbState) and (otoAlwaysEditing in Options) then
- PostMessage(Handle, ctim_StartEdit, 0, 0)
- else
- InvalidateCell(ActiveRow, ActiveCol);
- finally
- AllowRedraw := true;
- TempInvCells.Free;
- end;{try..finally}
- tbSetScrollPos(otsbHorizontal);
- tbSetScrollPos(otsbVertical);
- DoActiveCellChanged(RowNum, ColNum);
- end;
-{--------}
-procedure TOvcCustomTable.SetActiveCol(ColNum : TColNum);
- begin
- SetActiveCell(FActiveRow, ColNum);
- end;
-{--------}
-procedure TOvcCustomTable.SetActiveRow(RowNum : TRowNum);
- begin
- SetActiveCell(RowNum, FActiveCol);
- end;
-{--------}
-procedure TOvcCustomTable.SetAdjust(A : TOvcTblAdjust);
- var
- TempAdjust : TOvcTblAdjust;
- begin
- if (A = otaDefault) then
- TempAdjust := tbDefAdjust
- else TempAdjust := A;
- if (TempAdjust <> FAdjust) then
- begin
- AllowRedraw := false;
- try
- InvalidateTable;
- FAdjust := TempAdjust;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetAllowRedraw(AR : boolean);
- var
- CellRect : TRect;
- MustFocus: boolean;
- R : TRect;
- CellStyle: TOvcTblEditorStyle;
- begin
- if AR {AllowRedraw is true} then
- begin
- dec(tbLockCount);
- if (tbLockCount <= 0) then
- begin
- {Setting the tbLockCount explicitly to zero is to catch
- programmers who call AllowRedraw := true once to often}
- tbLockCount := 0;
- {Update the scroll bars}
- if tbUpdateSBs then
- begin
- tbUpdateSBs := false;
- tbSetScrollPos(otsbHorizontal);
- tbSetScrollPos(otsbVertical);
- end;
- {if in row selection mode invalidate it}
- if (otoBrowseRow in Options) then
- InvalidateRow(ActiveRow);
- {draw the invalid and active cells if we have a handle}
- if HandleAllocated then
- begin
- {redraw invalid cells}
- if not tbInvCells.Empty then
- tbDrawInvalidCells(tbInvCells);
- if (otsHiddenEdit in tbState) then
- begin
- if tbCalcActiveCellRect(CellRect) then
- begin
- {note: cell style is ignored here}
- CellStyle := tesNormal;
- DoSizeCellEditor(ActiveRow, ActiveCol, CellRect, CellStyle);
- MustFocus := Focused;
- tbActCell.EditMove(CellRect);
- tbState := tbState - [otsHiddenEdit] + [otsEditing];
- if MustFocus then
-{$IFNDEF LCL}
- Windows.SetFocus(tbActCell.EditHandle);
-{$ELSE}
- LclIntf.SetFocus(tbActCell.EditHandle);
-{$ENDIF}
- end
- end
- else
- tbDrawActiveCell;
- end;
- end;
- end
- else
- begin
- inc(tbLockCount);
- if (tbLockCount = 1) and (HandleAllocated) then
- begin
- if (otoBrowseRow in Options) then
- InvalidateRow(ActiveRow);
- if (otsEditing in tbState) then
- begin
-{$IFNDEF LCL}
- MustFocus := tbEditCellHasFocus(Windows.GetFocus);
-{$ELSE}
- MustFocus := tbEditCellHasFocus(LclIntf.GetFocus);
-{$ENDIF}
- GetWindowRect(tbActCell.EditHandle, R);
- R.TopLeft := ScreenToClient(R.TopLeft);
- R.BottomRight := ScreenToClient(R.BottomRight);
- InvalidateCellsInRect(R);
- tbActCell.EditHide;
- tbState := tbState - [otsEditing] + [otsHiddenEdit];
- if MustFocus then
- SetFocus;
- end
- else if not (otoBrowseRow in Options) then
- InvalidateCell(ActiveRow, ActiveCol);
- end;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetBorderStyle(const BS : TBorderStyle);
- begin
- if (BS <> BorderStyle) then
- begin
- FBorderStyle := BS;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetBlockAccess(A : TOvcTblAccess);
- var
- R : TRowNum;
- C : TColNum;
- begin
- for R := BlockRowBegin to BlockRowEnd do
- for C := BlockColBegin to BlockColEnd do
- FCells.Access[R, C] := A;
- end;
-{--------}
-procedure TOvcCustomTable.SetBlockAdjust(A : TOvcTblAdjust);
- var
- R : TRowNum;
- C : TColNum;
- begin
- for R := BlockRowBegin to BlockRowEnd do
- for C := BlockColBegin to BlockColEnd do
- FCells.Adjust[R, C] := A;
- end;
-{--------}
-procedure TOvcCustomTable.SetBlockCell(C : TOvcBaseTableCell);
- var
- Rn : TRowNum;
- Cn : TColNum;
- begin
- for Rn := BlockRowBegin to BlockRowEnd do
- for Cn := BlockColBegin to BlockColEnd do
- FCells.Cell[Rn, Cn] := C;
- end;
-{--------}
-procedure TOvcCustomTable.SetBlockColBegin(ColNum : TColNum);
- begin
- if (ColNum <> FBlockColBegin) then
- if (0 <= ColNum) and (ColNum < ColCount) then
- begin
- FBlockColBegin := ColNum;
- if (FBlockColEnd < FBlockColBegin) then
- FBlockColEnd := ColNum;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetBlockColEnd(ColNum : TColNum);
- begin
- if (ColNum <> FBlockColEnd) then
- if (0 <= ColNum) and (ColNum < ColCount) then
- begin
- FBlockColEnd := ColNum;
- if (FBlockColEnd < FBlockColBegin) then
- FBlockColBegin := ColNum;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetBlockColor(C : TColor);
- var
- Rn : TRowNum;
- Cn : TColNum;
- begin
- for Rn := BlockRowBegin to BlockRowEnd do
- for Cn := BlockColBegin to BlockColEnd do
- FCells.Color[Rn, Cn] := C;
- end;
-{--------}
-procedure TOvcCustomTable.SetBlockFont(F : TFont);
- var
- R : TRowNum;
- C : TColNum;
- begin
- for R := BlockRowBegin to BlockRowEnd do
- for C := BlockColBegin to BlockColEnd do
- FCells.Font[R, C] := F;
- end;
-{--------}
-procedure TOvcCustomTable.SetBlockRowBegin(RowNum : TRowNum);
- begin
- if (RowNum <> FBlockRowBegin) then
- if (0 <= RowNum) and (RowNum < RowLimit) then
- begin
- FBlockRowBegin := RowNum;
- if (FBlockRowEnd < FBlockRowBegin) then
- FBlockRowEnd := RowNum;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetBlockRowEnd(RowNum : TRowNum);
- begin
- if (RowNum <> FBlockRowEnd) then
- if (0 <= RowNum) and (RowNum < RowLimit) then
- begin
- FBlockRowEnd := RowNum;
- if (FBlockRowEnd < FBlockRowBegin) then
- FBlockRowBegin := RowNum;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetColors(C : TOvcTableColors);
- begin
- FColors.Assign(C);
- end;
-{--------}
-procedure TOvcCustomTable.SetColorUnused(CU : TColor);
- begin
- if (CU <> ColorUnused) then
- begin
- AllowRedraw := false;
- FColorUnused := CU;
- tbInvCells.AddUnusedBit;
- AllowRedraw := true;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetColCount(CC : integer);
- begin
- if (CC <> ColCount) and (CC > LockedCols) then
- begin
- AllowRedraw := false;
- try
- Columns.Count := CC;
- tbSelList.SetColCount(CC);
- tbSetScrollRange(otsbHorizontal);
- if (CC <= ActiveCol) then
- ActiveCol := pred(CC);
- if (CC <= LeftCol) then
- LeftCol := pred(CC);
- if (CC <= FSelAnchorCol) then
- FSelAnchorCol := pred(CC);
- if (CC <= BlockColBegin) then
- BlockColBegin := pred(CC);
- if (CC <= BlockColEnd) then
- BlockColEnd := pred(CC);
- tbSetScrollPos(otsbHorizontal);
-
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetCols(CS : TOvcTableColumns);
- begin
- AllowRedraw := false;
- try
- FCols.Free;
- FCols := CS;
- FCols.Table := Self;
- FCols.OnColumnChanged := tbColChanged;
- tbColChanged(FCols, 0, 0, taGeneral);
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-procedure TOvcCustomTable.SetLeftCol(ColNum : TColNum);
- begin
- SetTopLeftCell(TopRow, ColNum);
- end;
-{--------}
-procedure TOvcCustomTable.SetLockedCols(ColNum : TColNum);
- begin
- if not HandleAllocated then
- FLockedCols := ColNum
- else
- if (ColNum <> FLockedCols) then
- if (0 <= ColNum) and (ColNum < ColCount) then
- begin
- AllowRedraw := false;
- try
- FLockedCols := ColNum;
- if LeftCol < ColNum then
- LeftCol := LeftCol; {this does do something!}
- if (ActiveCol < ColNum) then
- ActiveCol := LeftCol; {this does do something!}
- tbCalcColData(tbColNums, LeftCol);
- InvalidateTable;
- finally
- AllowRedraw := true;
- end;{try..finally}
- tbSetScrollRange(otsbHorizontal);
- tbSetScrollPos(otsbHorizontal);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetLockedRows(RowNum : TRowNum);
- begin
- if not HandleAllocated then
- FLockedRows := RowNum
- else
- if (RowNum <> FLockedRows) then
- if (0 <= RowNum) then
- begin
- AllowRedraw := false;
- try
- FLockedRows := RowNum;
- if (TopRow < RowNum) then
- TopRow := TopRow; {this does do something!}
- if (ActiveRow < RowNum) then
- ActiveRow := ActiveRow; {this does do something!}
- tbCalcRowData(tbRowNums, TopRow);
- InvalidateTable;
- finally
- AllowRedraw := true;
- end;{try..finally}
- tbSetScrollRange(otsbVertical);
- tbSetScrollPos(otsbVertical);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetLockedRowsCell(C : TOvcBaseTableCell);
- var
- DoIt : boolean;
- begin
- DoIt := false;
- if (C <> FLockedRowsCell) then
- if Assigned(C) then
- begin
- if (C.References = 0) or
- ((C.References > 0) and (C.Table = Self)) then
- DoIt := true;
- end
- else
- DoIt := true;
-
- if DoIt then
- begin
- if Assigned(FLockedRowsCell) then
- FLockedRowsCell.DecRefs;
- FLockedRowsCell := C;
- if Assigned(FLockedRowsCell) then
- begin
- if (FLockedRowsCell.References = 0) then
- FLockedRowsCell.Table := Self;
- FLockedRowsCell.IncRefs;
- end;
- tbCellChanged(Self);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetOptions(O : TOvcTblOptionSet);
- begin
- AllowRedraw := false;
- try
- FOptions := O;
- if HaveSelection then
- begin
- tbIsSelecting := false;
- tbIsDeselecting := false;
- tbSetAnchorCell(ActiveRow, ActiveCol, tstDeselectAll);
- end;
- {patch up the options set to exclude meaningless combinations}
- if (otoBrowseRow in FOptions) then
- begin
- FOptions := FOptions +
- [otoNoSelection, otoNoRowResizing{, otoNoColResizing}] -
- [otoMouseDragSelect, otoRowSelection, otoColSelection];
- end;
- if (otoAlwaysEditing in FOptions) then
- begin
- FOptions := FOptions +
- [otoNoSelection, otoNoRowResizing, otoNoColResizing] -
- [otoMouseDragSelect, otoRowSelection, otoColSelection];
- end
- else if (otoNoSelection in FOptions) then
- begin
- FOptions := FOptions -
- [otoMouseDragSelect, otoRowSelection, otoColSelection];
- end;
- if (otoRowSelection in FOptions) then
- FOptions := FOptions - [otoAllowRowMoves];
- if (otoColSelection in FOptions) then
- FOptions := FOptions - [otoAllowColMoves];
- InvalidateTable;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-procedure TOvcCustomTable.SetPaintUnusedArea(PUA : TNotifyEvent);
- begin
- AllowRedraw := false;
- FPaintUnusedArea := PUA;
- tbInvCells.AddUnusedBit;
- AllowRedraw := true;
- end;
-{--------}
-procedure TOvcCustomTable.SetRowLimit(RowNum : TRowNum);
- begin
- if (RowNum <> FRows.Limit) and (RowNum > LockedRows) then
- begin
- AllowRedraw := false;
- try
- FRows.Limit := RowNum;
- tbSelList.SetRowCount(RowLimit);
- tbSetScrollRange(otsbVertical);
- if (RowNum <= ActiveRow) then
- ActiveRow := pred(RowNum);
- if (RowNum <= TopRow) then
- TopRow := pred(RowNum);
- if (RowNum <= FSelAnchorRow) then
- FSelAnchorRow := pred(RowNum);
- if (RowNum <= BlockRowBegin) then
- BlockRowBegin := pred(RowNum);
- if (RowNum <= BlockRowEnd) then
- BlockRowEnd := pred(RowNum);
- tbSetScrollPos(otsbVertical);
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetRows(RS : TOvcTableRows);
- begin
- AllowRedraw := false;
- try
- FRows.Free;
- FRows := RS;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-procedure TOvcCustomTable.SetScrollBars(const SB : TScrollStyle);
- begin
- if (SB <> ScrollBars) then
- begin
- FScrollBars := SB;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
- end;
-{--------}
-procedure TOvcCustomTable.SetTopRow(RowNum : TRowNum);
- begin
- SetTopLeftCell(RowNum, LeftCol);
- end;
-{--------}
-procedure TOvcCustomTable.SetTopLeftCell(RowNum : TRowNum; ColNum : TColNum);
- begin
- {ensure that the new top left cell minimises the unused space}
- if (ColNum > tbLastLeftCol) then
- ColNum := tbLastLeftCol;
- if (RowNum > tbLastTopRow) then
- RowNum := tbLastTopRow;
- {ensure that RowNum and C are not hidden}
- RowNum := IncRow(RowNum, 0);
- ColNum := IncCol(ColNum, 0);
- DoTopLeftCellChanging(RowNum, ColNum);
- {change the topmost row and leftmost column if required}
- if not HandleAllocated then
- begin
- FTopRow := RowNum;
- FLeftCol := ColNum;
- end
- else
- if (RowNum <> FTopRow) or (ColNum <> FLeftCol) then
- begin
- AllowRedraw := false;
- {note: the tbScrollTableXxx routines set FTopRow and FLeftCol}
- try
- if (RowNum > FTopRow) then
- tbScrollTableUp(RowNum)
- else if (RowNum < FTopRow) then
- tbScrollTableDown(RowNum);
- if (ColNum > FLeftCol) then
- tbScrollTableLeft(ColNum)
- else if (ColNum < FLeftCol) then
- tbScrollTableRight(ColNum);
- finally
- AllowRedraw := true;
- end;{try..finally}
- tbSetScrollPos(otsbVertical);
- tbSetScrollPos(otsbHorizontal);
- DoTopLeftCellChanged(RowNum, ColNum);
- end;
- end;
-{====================================================================}
-
-
-{==TOvcTable Scroller routines=======================================}
-procedure TOvcCustomTable.tbSetScrollPos(SB : TOvcScrollBar);
- var
- ColNum : TColNum;
- ColCnt : TColNum;
- Divisor : LongInt;
-{$IFNDEF MSWINDOWS}
- SI : TScrollInfo;
-{$ENDIF}
- begin
- if (SB = otsbVertical) then
- begin
- if tbHasVSBar then
- if HandleAllocated and (tbLockCount = 0) then
- begin
-{$IFDEF MSWINDOWS}
- if (tbLastTopRow < 16*1024) then
- SetScrollPos(Handle, SB_VERT, TopRow, true)
- else
- begin
- if (tbLastTopRow > (16 * 1024)) then
- Divisor := RowLimit div $400
- else
- Divisor := RowLimit div $40;
- SetScrollPos(Handle, SB_VERT,
- TopRow div Divisor,
- True);
- end
-{$ELSE}
- SI.fMask := SIF_POS;
- SI.nPos := TopRow;
- SI.nTrackPos := SI.nPos;
- SetScrollInfo(Handle, SB_Vert, SI, True);
-{$ENDIF}
- end
- else
- tbUpdateSBs := true;
- end
- else {SB = otsbHorizontal}
- begin
- if tbHasHSBar then
- if HandleAllocated and (tbLockCount = 0) then
- begin
- ColCnt := 0;
- for ColNum := LockedCols to pred(LeftCol) do
- if not tbIsColHidden(ColNum) then
- inc(ColCnt);
-{$IFDEF MSWINDOWS}
- SetScrollPos(Handle, SB_HORZ, ColCnt, true)
-{$ELSE}
- SI.fMask := SIF_POS;
- SI.nPos := ColCnt;
- SI.nTrackPos := SI.nPos;
- SetScrollInfo(Handle, SB_Horz, SI, True);
-{$ENDIF}
- end
- else
- tbUpdateSBs := true;
- end;
- end;
-{--------}
-
-procedure TOvcCustomTable.tbSetScrollRange(SB : TOvcScrollBar);
- var
- Divisor : LongInt;
-{$IFNDEF MSWINDOWS}
- SI : TScrollInfo;
-{$ENDIF}
- begin
- if (SB = otsbVertical) then
- begin
- if HandleAllocated then
- tbCalcRowsOnLastPage;
- if tbHasVSBar and HandleAllocated then
- begin
-{$IFDEF MSWINDOWS}
-// tbCalcRowsOnLastPage;
- if (tbLastTopRow < 16*1024) then
- if tbCalcRequiresVSBar then
- SetScrollRange(Handle, SB_Vert, LockedRows, tbLastTopRow, false)
- else
- SetScrollRange(Handle, SB_Vert, LockedRows, LockedRows, false)
- else begin
- if (tbLastTopRow > (16*1024)) then
- Divisor := Succ(tbLastTopRow div $400)
- else
- Divisor := Succ(tbLastTopRow div $40);
- SetScrollRange(Handle, SB_Vert,
- LockedRows,
- tbLastTopRow div Divisor,
- False)
- end;
-{$ELSE}
- SI.fMask := SIF_RANGE or SIF_PAGE;
- SI.nMin := LockedRows;
- SI.nMax := Pred(RowLimit);
- SI.nPage := (ClientHeight div Rows[LockedRows].Height) - LockedRows;
- if SI.nPage < 1 then
- SI.nPage := 1;
- SetScrollInfo(Handle, SB_Vert, SI, True);
-{$ENDIF}
- end
- end
- else {SB = otsbHorizontal}
- begin
- tbCalcColsOnLastPage;
- if tbHasHSBar and HandleAllocated then
- begin
-{$IFDEF MSWINDOWS}
- tbCalcHSBarPosCount;
- SetScrollRange(Handle, SB_HORZ, 0, pred(tbHSBarPosCount), false);
-{$ELSE}
- SI.fMask := SIF_RANGE or SIF_PAGE;
- SI.nMin := 0;
- SI.nMax := Pred(ColCount) - LockedCols;
- SI.nPage := ColCount div 3;
- if SI.nPage < 1 then
- SI.nPage := 1;
- SetScrollInfo(Handle, SB_Horz, SI, True);
-{$ENDIF}
- end;
- end;
- end;
-{====================================================================}
-
-
-{==TOvcTable editing routines========================================}
-function TOvcCustomTable.FilterKey(var Msg : TWMKey) : TOvcTblKeyNeeds;
- var
- Cmd : word;
- begin
- Result := otkDontCare;
- Cmd := Controller.EntryCommands.TranslateUsing([tbCmdTable^], TMessage(Msg));
- {first the hard coded keys}
- case Msg.CharCode of
- VK_RETURN :
- if (otoEnterToArrow in Options) then
- Result := otkMustHave;
- VK_TAB :
- if (otoTabToArrow in Options) then
- Result := otkMustHave;
- VK_ESCAPE :
- Result := otkMustHave;
- end;{case}
- {now the translated commands}
- case Cmd of
- ccTableEdit :
- Result := otkMustHave;
- ccBotOfPage, ccBotRightCell, ccDown, ccEnd, ccFirstPage, ccHome,
- ccLastPage, ccLeft, ccNextPage, ccPageLeft, ccPageRight, ccPrevPage,
- ccRight, ccTopLeftCell, ccTopOfPage, ccUp, ccWordLeft, ccWordRight :
- Result := otkWouldLike;
- end;{case}
- end;
-{--------}
-function TOvcCustomTable.SaveEditedData : boolean;
- var
- Data : pointer;
- begin
- Result := true;
- if InEditingState then
- begin
- Result := false;
- if not tbActCell.CanSaveEditedData(true) then
- Exit;
- Result := true;
- DoEnteringColumn(ActiveCol);
- DoEnteringRow(ActiveRow);
- DoGetCellData(ActiveRow, ActiveCol, Data, cdpForSave);
- tbActCell.SaveEditedData(Data);
- end;
- end;
-{--------}
-function TOvcCustomTable.StartEditingState : boolean;
- var
- CellRect : TRect;
- Data : pointer;
- CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- begin
- Result := true;
- if InEditingState then
- Exit;
- DoBeginEdit(ActiveRow, ActiveCol, Result);
- if not Result then
- Exit;
- Result := false;
- AllowRedraw := false;
- try
- tbEnsureRowIsVisible(ActiveRow);
- tbEnsureColumnIsVisible(ActiveCol);
- tbActCell := tbFindCell(ActiveRow, ActiveCol);
- if Assigned(tbActCell) then
- begin
- FillChar(CellAttr, sizeof(CellAttr), 0);
- CellAttr.caFont := tbCellAttrFont;
- CellAttr.caFont.Assign(Font);
- tbActCell.ResolveAttributes(ActiveRow, ActiveCol, CellAttr);
- if (CellAttr.caAccess = otxNormal) then
- begin
- if not tbCalcActiveCellRect(CellRect) then
- {we're in big trouble, lads};
- CellStyle := tesNormal;
- DoSizeCellEditor(ActiveRow, ActiveCol, CellRect, CellStyle);
- DoEnteringColumn(ActiveCol);
- DoEnteringRow(ActiveRow);
- DoGetCellData(ActiveRow, ActiveCol, Data, cdpForEdit);
- tbState := tbState - [otsNormal] + [otsHiddenEdit];
- CellAttr.caColor := Colors.Editing;
- CellAttr.caFontColor := Colors.EditingText;
- tbActCell.StartEditing(ActiveRow, ActiveCol, CellRect, CellAttr, CellStyle, Data);
- Result := (tbActCell.EditHandle <> 0);
- if not Result then
- begin
- tbState := tbState + [otsNormal] - [otsHiddenEdit];
- tbActCell := nil;
- end;
- end
- else
- tbActCell := nil;
- end;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-function TOvcCustomTable.StopEditingState(SaveValue : boolean) : boolean;
- var
- Data : pointer;
- MustFocus : boolean;
-
- R : TRect;
-
- begin
- Result := true;
- if not InEditingState then
- Exit;
- Result := false;
- if not tbActCell.CanSaveEditedData(SaveValue) then
- Exit;
- DoEndEdit(tbActCell, ActiveRow, ActiveCol, Result);
- if not Result then
- Exit;
- Result := true;
- GetWindowRect(tbActCell.EditHandle, R);
- AllowRedraw := false;
- try
-{$IFNDEF LCL}
- MustFocus := tbEditCellHasFocus(Windows.GetFocus);
-{$ELSE}
- MustFocus := tbEditCellHasFocus(LclIntf.GetFocus);
-{$ENDIF}
- if not MustFocus then
- MustFocus := Focused;
- DoEnteringColumn(ActiveCol);
- DoEnteringRow(ActiveRow);
- DoGetCellData(ActiveRow, ActiveCol, Data, cdpForSave);
-
- R.TopLeft := ScreenToClient(R.TopLeft);
- R.BottomRight := ScreenToClient(R.BottomRight);
- InvalidateCellsInRect(R);
-
- tbActCell.StopEditing(SaveValue, Data);
- tbActCell := nil;
- try
- DoDoneEdit(ActiveRow, ActiveCol);
- finally
- if not (otoAlwaysEditing in Options) then
- InvalidateCell(ActiveRow, ActiveCol);
- tbState := tbState - [otsEditing, otsHiddenEdit] + [otsNormal];
- if MustFocus then
- SetFocus
- else
- tbState := tbState - [otsFocused] + [otsUnfocused];
- end;{try..finally}
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{====================================================================}
-
-
-{==TOvcTable selection methods=======================================}
-procedure TOvcCustomTable.tbDeselectAll(CA : TOvcCellArray);
- begin
- with tbSelList do
- begin
- Iterate(tbDeselectAllIterator, pointer(CA));
- DeselectAll;
- end;
- end;
-{--------}
-function TOvcCustomTable.tbDeselectAllIterator(RowNum1 : TRowNum; ColNum1 : TColNum;
- RowNum2 : TRowNum; ColNum2 : TColNum;
- ExtraData : pointer) : boolean;
- var
- RowNum : TRowNum;
- ColNum : TColNum;
- RowInx : integer;
- CA : TOvcCellArray absolute ExtraData;
- begin
- {optimisations: 1. generally ColNum1 = ColNum2
- 2. take it from the viewpoint of what rows are visible
- rather than what rows are selected}
- Result := true;
- for ColNum := ColNum1 to ColNum2 do
- if (tbFindColInx(ColNum) <> -1) then
- with tbRowNums^ do
- for RowInx := 0 to pred(Count) do
- begin
- RowNum := Ay[RowInx].Number;
- if (RowNum1 <= RowNum) and (RowNum <= RowNum2) then
- CA.AddCell(RowNum, ColNum);
- end;
- end;
-{--------}
-function TOvcCustomTable.HaveSelection : boolean;
- begin
- Result := tbSelList.HaveSelection;
- end;
-{--------}
-function TOvcCustomTable.InSelection(RowNum : TRowNum; ColNum : TColNum) : boolean;
- begin
- if HaveSelection then
- Result := tbSelList.IsCellSelected(RowNum, ColNum)
- else
- Result := false;
- end;
-{--------}
-procedure TOvcCustomTable.IterateSelections(SI : TSelectionIterator; ExtraData : pointer);
- begin
- with tbSelList do
- Iterate(SI, ExtraData);
- end;
-{--------}
-procedure TOvcCustomTable.tbSelectCol(ColNum : TColNum);
- var
- RowInx : integer;
- ColInx : integer;
- begin
- tbSelList.SelectCellRange(LockedRows, ColNum, pred(RowLimit), ColNum);
- ColInx := tbFindColInx(ColNum);
- if (ColInx <> -1) then
- with tbRowNums^ do
- for RowInx := 0 to pred(Count) do
- tbInvCells.AddCell(Ay[RowInx].Number, ColNum);
- end;
-{--------}
-procedure TOvcCustomTable.tbSelectRow(RowNum : TRowNum);
- var
- RowInx : integer;
- ColInx : integer;
- begin
- tbSelList.SelectCellRange(RowNum, LockedCols, RowNum, pred(ColCount));
- RowInx := tbFindRowInx(RowNum);
- if (RowInx <> -1) then
- with tbColNums^ do
- for ColInx := 0 to pred(Count) do
- tbInvCells.AddCell(RowNum, Ay[ColInx].Number);
- end;
-{--------}
-procedure TOvcCustomTable.tbSelectTable;
- begin
- tbSelList.SelectAll;
- InvalidateTable;
- end;
-{--------}
-procedure TOvcCustomTable.tbSetAnchorCell(RowNum : TRowNum; ColNum : TColNum;
- Action : TOvcTblSelectionType);
- begin
- {deselect the current selection(s) if required}
- if (Action = tstDeselectAll) then
- tbDeselectAll(tbInvCells);
- {set the anchor point to a sensible value}
- if (ColNum < LockedCols) then
- FSelAnchorCol := LockedCols
- else if (ColNum >= ColCount) then
- FSelAnchorCol := pred(ColCount)
- else
- FSelAnchorCol := ColNum;
- if (RowNum < LockedRows) then
- FSelAnchorRow := LockedRows
- else if (RowNum >= RowLimit) then
- FSelAnchorRow := pred(RowLimit)
- else
- FSelAnchorRow := RowNum;
- {tell the selection list object}
- tbSelList.SetRangeAnchor(RowNum, ColNum, Action);
- {try and work out whether we are selecting or deselecting}
- tbIsSelecting := false;
- tbIsDeselecting := false;
- if (Action = tstAdditional) then
- begin
- if InSelection(RowNum, ColNum) then
- tbIsDeselecting := true
- else
- tbIsSelecting := true;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbUpdateSelection(RowNum : TRowNum; ColNum : TColNum;
- Action : TOvcTblSelectionType);
- var
- R : TRowNum;
- C : TColNum;
- OldSelRow1 : TRowNum;
- OldSelRow2 : TRowNum;
- OldSelCol1 : TColNum;
- OldSelCol2 : TColNum;
- NewSelRow1 : TRowNum;
- NewSelRow2 : TRowNum;
- NewSelCol1 : TColNum;
- NewSelCol2 : TColNum;
- RowInx : integer;
- ColInx : integer;
- NewInvCells: TOvcCellArray;
- DeselCells : TOvcCellArray;
- begin
- NewInvCells := nil;
- DeselCells := nil;
- try
- {create temporary cell arrays: one for new invalid cells,
- one for any deselected cells}
- NewInvCells := TOvcCellArray.Create;
- DeselCells := TOvcCellArray.Create;
- {deselect currently selected cells if required}
- if (Action = tstDeselectAll) then
- tbDeselectAll(DeselCells);
- {calculate the old and new selections (the parameters RowNum,
- ColNum form the address of the new active cell)}
- OldSelRow1 := MinL(ActiveRow, FSelAnchorRow);
- OldSelRow2 := MaxL(ActiveRow, FSelAnchorRow);
- NewSelRow1 := MinL(RowNum, FSelAnchorRow);
- NewSelRow2 := MaxL(RowNum, FSelAnchorRow);
- if (otoBrowseRow in Options) then
- begin
- OldSelCol1 := LockedCols;
- OldSelCol2 := pred(ColCount);
- NewSelCol1 := LockedCols;
- NewSelCol2 := pred(ColCount);
- end
- else
- begin
- OldSelCol1 := MinI(ActiveCol, FSelAnchorCol);
- OldSelCol2 := MaxI(ActiveCol, FSelAnchorCol);
- NewSelCol1 := MinI(ColNum, FSelAnchorCol);
- NewSelCol2 := MaxI(ColNum, FSelAnchorCol);
- end;
- {extend the range in the selection list}
- tbSelList.ExtendRange(RowNum, ColNum, tbIsSelecting or tbIsKeySelecting);
- {for the old selection, remove the cells from the deselected cell
- array (if they are there) and add them to the new selected cell
- array}
- for RowInx := 0 to pred(tbRowNums^.Count) do
- begin
- R := tbRowNums^.Ay[RowInx].Number;
- if (OldSelRow1 <= R) and (R <= OldSelRow2) then
- for ColInx := 0 to pred(tbColNums^.Count) do
- begin
- C := tbColNums^.Ay[ColInx].Number;
- if (OldSelCol1 <= C) and (C <= OldSelCol2) then
- begin
- DeselCells.DeleteCell(R, C);
- NewInvCells.AddCell(R, C);
- end;
- end;
- end;
- {for the new selection, for each cell remove it from the new selected
- cell array; if it wasn't there add it to the same array}
- for RowInx := 0 to pred(tbRowNums^.Count) do
- begin
- R := tbRowNums^.Ay[RowInx].Number;
- if (NewSelRow1 <= R) and (R <= NewSelRow2) then
- for ColInx := 0 to pred(tbColNums^.Count) do
- begin
- C := tbColNums^.Ay[ColInx].Number;
- if (NewSelCol1 <= C) and (C <= NewSelCol2) then
- if not NewInvCells.DeleteCell(R, C) then
- NewInvCells.AddCell(R, C);
- end;
- end;
- {add the current active cell to the new selected cell array}
- NewInvCells.AddCell(ActiveRow, ActiveCol);
- {merge the cells from the temporary arrays into the main invalid
- cell array}
- tbInvCells.Merge(NewInvCells);
- tbInvCells.Merge(DeselCells);
- finally
- NewInvCells.Free;
- DeselCells.Free
- end;{try..finally}
- end;
-{====================================================================}
-
-
-{==TOvcTable notification methods====================================}
-procedure TOvcCustomTable.tbCellChanged(Sender : TObject);
- begin
- {don't bother if we're being loaded or destroyed}
- if ((ComponentState * [csLoading, csDestroying]) <> []) then
- Exit;
- {if we have a handle repaint the table}
- if HandleAllocated then
- begin
- AllowRedraw := false;
- try
- InvalidateTable;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbColChanged(Sender : TObject; ColNum1, ColNum2 : TColNum;
- Action : TOvcTblActions);
- var
- CC : TColNum;
- DoIt : boolean;
- begin
- {don't bother if we're being loaded or destroyed}
- if ((ComponentState * [csLoading, csDestroying]) <> []) then
- Exit;
- {similarly don't bother if we have no handle}
- if not HandleAllocated then begin
- tbSelList.SetColCount(ColCount);
- Exit;
- end;
- {make sure there's no flicker}
- AllowRedraw := false;
- try
- {decide whether there's anything to do to the visible display}
- DoIt := false;
- with tbColNums^ do
-{$IFDEF LCL} //Apparent TurboPower bug revealed when checks on
- if Count > 0 then
-{$ENDIF}
- case Action of
- taGeneral : DoIt := true;
- taSingle : begin
- DoIt := (Ay[0].Number <= ColNum1) and
- (ColNum1 <= Ay[pred(Count)].Number);
- {check for unhiding a column after all others}
- if not DoIt then
- DoIt := (ColNum1 > Ay[pred(Count)].Number) and
- (ClientWidth > Ay[Count].Offset);
- DoColumnsChanged(ColNum1, -1, taSingle);
- end;
- taAll : DoIt := true;
- taInsert : begin
- DoIt := (Ay[0].Number <= ColNum1) and
- (ColNum1 <= Ay[pred(Count)].Number);
- {check for appending a column}
- if not DoIt then
- DoIt := (ColNum1 > Ay[pred(Count)].Number) and
- (ClientWidth > Ay[Count].Offset);
- FCells.InsertCol(ColNum1);
- DoColumnsChanged(ColNum1, -1, taInsert);
- end;
- taDelete : begin
- DoIt := (Ay[0].Number <= ColNum1) and
- (ColNum1 <= Ay[pred(Count)].Number);
- FCells.DeleteCol(ColNum1);
- DoColumnsChanged(ColNum1, -1, taDelete);
- end;
- taExchange: begin
- DoIt := (Ay[0].Number <= ColNum1) and
- (ColNum1 <= Ay[pred(Count)].Number);
- if not DoIt then
- DoIt := (Ay[0].Number <= ColNum2) and
- (ColNum2 <= Ay[pred(Count)].Number);
- FCells.ExchangeCols(ColNum1, ColNum2);
- DoColumnsChanged(ColNum1, ColNum2, taExchange);
- end;
- end;{case}
- {if nothing to do to the visible columns, then do it!}
- if not DoIt then
- begin
- {must still reset the horizontal scroll bar even so}
- tbSelList.SetColCount(ColCount);
- tbSetScrollRange(otsbHorizontal);
- tbSetScrollPos(otsbHorizontal);
- Exit;
- end;
- {redisplay the table}
- tbCalcColData(tbColNums, LeftCol);
- InvalidateTable;
- {the column could have changed because it was hidden or deleted...
- ...must make sure that LeftCol and ActiveCol haven't
- been hidden as well.}
- if (Action = taSingle) or (Action = taDelete) then
- begin
- if (ColNum1 = LeftCol) then
- LeftCol := LeftCol; {this does do something!}
- if (ColNum1 = ActiveCol) then
- ActiveCol := ActiveCol; {this does do something!}
- end;
- {reset the block column values}
- CC := ColCount;
- if (CC <= BlockColBegin) then
- BlockColBegin := pred(CC);
- if (CC <= BlockColEnd) then
- BlockColEnd := pred(CC);
- tbSelList.SetColCount(ColCount);
- tbSetScrollRange(otsbHorizontal);
- tbSetScrollPos(otsbHorizontal);
- if (LeftCol > tbLastLeftCol) then
- LeftCol := tbLastLeftCol;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-procedure TOvcCustomTable.tbColorsChanged(Sender : TObject);
- begin
- {don't bother if we're being loaded or destroyed}
- if ((ComponentState * [csLoading, csDestroying]) <> []) then
- Exit;
- {if we have a handle repaint the table}
- if HandleAllocated then
- begin
- AllowRedraw := false;
- try
- InvalidateTable;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbGridPenChanged(Sender : TObject);
- begin
- {don't bother if we're being loaded or destroyed}
- if ((ComponentState * [csLoading, csDestroying]) <> []) then
- Exit;
- {if we have a handle repaint the table}
- if HandleAllocated then
- begin
- AllowRedraw := false;
- try
- InvalidateTable;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbRowChanged(Sender : TObject; RowNum1, RowNum2 : TRowNum;
- Action : TOvcTblActions);
- var
- RL : TRowNum;
- DoIt : boolean;
- begin
- {don't bother if we're being loaded or destroyed}
- if ((ComponentState * [csLoading, csDestroying]) <> []) then
- Exit;
- {similarly don't bother if we have no handle}
- if not HandleAllocated then begin
- tbSelList.SetRowCount(RowLimit);
- Exit;
- end;
- {make sure there's no flicker}
- AllowRedraw := false;
- try
- {decide whether there's anything to do to the visible display}
- DoIt := false;
- with tbRowNums^ do
- case Action of
- taGeneral : DoIt := true;
- taSingle : begin
- DoIt := (Ay[0].Number <= RowNum1) and
- (RowNum1 <= Ay[pred(Count)].Number);
- {check for unhiding a row after all others}
- if not DoIt then
- DoIt := (RowNum1 > Ay[pred(Count)].Number) and
- (ClientHeight > Ay[Count].Offset);
- DoRowsChanged(RowNum1, -1, taSingle);
- end;
- taAll : DoIt := true;
- taInsert : begin
- DoIt := (Ay[0].Number <= RowNum1) and
- (RowNum1 <= Ay[pred(Count)].Number);
- {check for appending a row}
- if not DoIt then
- DoIt := (RowNum1 > Ay[pred(Count)].Number) and
- (ClientHeight > Ay[Count].Offset);
- FCells.InsertRow(RowNum1);
- DoRowsChanged(RowNum1, -1, taInsert);
- end;
- taDelete : begin
- DoIt := (Ay[0].Number <= RowNum1) and
- (RowNum1 <= Ay[pred(Count)].Number);
- FCells.DeleteRow(RowNum1);
- DoRowsChanged(RowNum1, -1, taDelete);
- end;
- taExchange: begin
- DoIt := (Ay[0].Number <= RowNum1) and
- (RowNum1 <= Ay[pred(Count)].Number);
- if not DoIt then
- DoIt := (Ay[0].Number <= RowNum2) and
- (RowNum2 <= Ay[pred(Count)].Number);
- FCells.ExchangeRows(RowNum1, RowNum2);
- DoRowsChanged(RowNum1, RowNum2, taExchange);
- end;
- end;{case}
- {if nothing to do to the visible rows, then do it!}
- if not DoIt then
- begin
- {must still reset the vertical scroll bar even so}
- tbSelList.SetRowCount(RowLimit);
- tbSetScrollRange(otsbVertical);
- tbSetScrollPos(otsbVertical);
- Exit;
- end;
- {redisplay the table}
- tbCalcRowData(tbRowNums, TopRow);
- InvalidateTable;
- {the row could have changed because it was hidden or deleted...
- ...must make sure that TopRow and ActiveRow haven't
- been hidden as well.}
- if (Action = taSingle) or (Action = taDelete) then
- begin
- if (RowNum1 = TopRow) then
- TopRow := TopRow; {this does do something!}
- if (RowNum1 = ActiveRow) then
- ActiveRow := ActiveRow; {this does do something!}
- end;
- {reset the block row values}
- RL := RowLimit;
- if (RL <= BlockRowBegin) then
- BlockRowBegin := pred(RL);
- if (RL <= BlockRowEnd) then
- BlockRowEnd := pred(RL);
- tbSelList.SetRowCount(RowLimit);
- tbSetScrollRange(otsbVertical);
- tbSetScrollPos(otsbVertical);
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{====================================================================}
-
-
-{==TOvcTable invalidate cell methods=================================}
-procedure TOvcCustomTable.InvalidateCell(RowNum : TRowNum; ColNum : TColNum);
- var
- CInx : integer;
- RInx : integer;
- begin
- RInx := tbFindRowInx(RowNum);
- if (RInx <> -1) then
- begin
- CInx := tbFindColInx(ColNum);
- if (CInx <> -1) then
- tbInvCells.AddCell(RowNum, ColNum);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.InvalidateCellsInRect(const R : TRect);
- var
- GR : TRect;
- WhatToPaint : integer;
- RowInx : integer;
- ColInx : integer;
- begin
- WhatToPaint := tbCalcCellsFromRect(R, GR);
-
- if (WhatToPaint <> 2) then
- for RowInx := GR.Top to GR.Bottom do
- for ColInx := GR.Left to GR.Right do
- InvalidateCell(tbRowNums^.Ay[RowInx].Number, tbColNums^.Ay[ColInx].Number);
-
- if (WhatToPaint <> 0) then
- tbInvCells.AddUnusedBit;
- end;
-{--------}
-procedure TOvcCustomTable.InvalidateColumn(ColNum : TColNum);
- var
- RowInx : integer;
- ColInx : integer;
- begin
- ColInx := tbFindColInx(ColNum);
- if (ColInx <> -1) then
- with tbRowNums^ do
- for RowInx := 0 to pred(Count) do
- tbInvCells.AddCell(Ay[RowInx].Number, ColNum);
- end;
-{--------}
-procedure TOvcCustomTable.tbInvalidateColHdgPrim(ColNum : TColNum; InvCells : TOvcCellArray);
- var
- RowInx : integer;
- ColInx : integer;
- begin
- ColInx := tbFindColInx(ColNum);
- if (ColInx <> -1) then
- with tbRowNums^ do
- for RowInx := 0 to pred(LockedRows) do
- InvCells.AddCell(Ay[RowInx].Number, ColNum);
- end;
-{--------}
-procedure TOvcCustomTable.InvalidateColumnHeading(ColNum : TColNum);
- begin
- tbInvalidateColHdgPrim(ColNum, tbInvCells);
- end;
-{--------}
-procedure TOvcCustomTable.InvalidateRow(RowNum : TRowNum);
- var
- RowInx : integer;
- ColInx : integer;
- begin
- RowInx := tbFindRowInx(RowNum);
- if (RowInx <> -1) then
- with tbColNums^ do
- for ColInx := 0 to pred(Count) do
- tbInvCells.AddCell(RowNum, Ay[ColInx].Number);
- end;
-{--------}
-procedure TOvcCustomTable.tbInvalidateRowHdgPrim(RowNum : TRowNum; InvCells : TOvcCellArray);
- var
- RowInx : integer;
- ColInx : integer;
- begin
- RowInx := tbFindRowInx(RowNum);
- if (RowInx <> -1) then
- with tbColNums^ do
- for ColInx := 0 to pred(LockedCols) do
- InvCells.AddCell(RowNum, Ay[ColInx].Number);
- end;
-{--------}
-procedure TOvcCustomTable.InvalidateRowHeading(RowNum : TRowNum);
- begin
- tbInvalidateRowHdgPrim(RowNum, tbInvCells);
- end;
-{--------}
-procedure TOvcCustomTable.InvalidateTable;
- var
- RowInx : integer;
- ColInx : integer;
- PredColNumsCount : integer;
- PredRowNumsCount : integer;
- begin
-{$IFDEF LCL} //Apparent TurboPower bug revealed when checks on
- if (tbColNums^.Count > 0) and (tbRowNums^.Count > 0) then
- begin
-{$ENDIF}
- PredColNumsCount := pred(tbColNums^.Count);
- PredRowNumsCount := pred(tbRowNums^.Count);
- for RowInx := 0 to PredRowNumsCount do
- for ColInx := 0 to PredColNumsCount do
- tbInvCells.AddCell(tbRowNums^.Ay[RowInx].Number,
- tbColNums^.Ay[ColInx].Number);
-{$IFDEF LCL}
- end;
-{$ENDIF}
- tbInvCells.AddUnusedBit;
- end;
-{--------}
-procedure TOvcCustomTable.InvalidateTableNotLockedCols;
- var
- RowInx : integer;
- ColInx : integer;
- StartColInx : integer;
- PredColNumsCount : integer;
- PredRowNumsCount : integer;
- begin
- StartColInx := 0;
- PredColNumsCount := pred(tbColNums^.Count);
- PredRowNumsCount := pred(tbRowNums^.Count);
- while (StartColInx <= PredColNumsCount) and
- (tbColNums^.Ay[StartColInx].Number < LockedCols) do
- inc(StartColInx);
- for RowInx := 0 to PredRowNumsCount do
- for ColInx := StartColInx to PredColNumsCount do
- tbInvCells.AddCell(tbRowNums^.Ay[RowInx].Number,
- tbColNums^.Ay[ColInx].Number);
- tbInvCells.AddUnusedBit;
- end;
-{--------}
-procedure TOvcCustomTable.InvalidateTableNotLockedRows;
- var
- RowInx : integer;
- ColInx : integer;
- StartRowInx : integer;
- PredColNumsCount : integer;
- PredRowNumsCount : integer;
- begin
- StartRowInx := 0;
- PredColNumsCount := pred(tbColNums^.Count);
- PredRowNumsCount := pred(tbRowNums^.Count);
- while (StartRowInx <= PredRowNumsCount) and
- (tbRowNums^.Ay[StartRowInx].Number < LockedRows) do
- inc(StartRowInx);
- for RowInx := StartRowInx to PredRowNumsCount do
- for ColInx := 0 to PredColNumsCount do
- tbInvCells.AddCell(tbRowNums^.Ay[RowInx].Number,
- tbColNums^.Ay[ColInx].Number);
- tbInvCells.AddUnusedBit;
- end;
-{====================================================================}
-
-
-{==TOvcTable miscellaneous===========================================}
-function TOvcCustomTable.tbCalcActiveCellRect(var ACR : TRect) : boolean;
- var
- RInx : integer;
- CInx : integer;
- begin
- Result := false;
- RInx := tbFindRowInx(ActiveRow);
- if (RInx = -1) then
- Exit;
- CInx := tbFindColInx(ActiveCol);
- if (CInx = -1) then
- Exit;
-
- Result := true;
- with ACR do
- begin
- Top := tbRowNums^.Ay[RInx].Offset;
- Bottom := tbRowNums^.Ay[succ(RInx)].Offset;
- Left := tbColNums^.Ay[CInx].Offset;
- Right := tbColNums^.Ay[succ(CInx)].Offset;
- end;
- with GridPenSet.NormalGrid do
- case Effect of
- geVertical : dec(ACR.Right);
- geHorizontal : dec(ACR.Bottom);
- geBoth : begin
- dec(ACR.Right);
- dec(ACR.Bottom);
- end;
- ge3D : InflateRect(ACR, -1, -1);
- end;{case}
- end;
-{--------}
-function TOvcCustomTable.tbCalcCellsFromRect(const UR : TRect; var GR : TRect) : integer;
- {-Converts a paint rect into a 'grid' rect. A grid rect is a rectangle of
- cells, defined by their display indexes rather than their row/column
- numbers.
- The function result is a definition of the type of rectangle produced:
- 0--top left and bottom right corners of the original rect are
- exclusively within the table;
- 1--top left of the rect is in the displayed table, the bottom right is
- in the 'unused' bit (the bit between the displayed cells and the
- client area;
- 2--the original rectangle is exclusively in the 'unused bit'.
- }
- var
- Row : TRowNum;
- Col : TColNum;
- Region : TOvcTblRegion;
- begin
- Result := 0;
- Region := CalcRowColFromXY(UR.Left, UR.Top, Row, Col);
- if (Region = otrInUnused) then
- begin
- Result := 2;
- FillChar(GR, sizeof(GR), $FF); {set 'em all to -1}
- Exit;
- end;
- GR.Left := tbFindColInx(Col);
- GR.Top := tbFindRowInx(Row);
- Region := CalcRowColFromXY(UR.Right, UR.Bottom, Row, Col);
- if (Region = otrInUnused) or (Region = otrOutside) then
- Result := 1;
- if (Col = CRCFXY_ColToRight) then
- GR.Right := pred(tbColNums^.Count)
- else
- GR.Right := tbFindColInx(Col);
- if (Row = CRCFXY_RowBelow) then
- GR.Bottom := pred(tbRowNums^.Count)
- else
- GR.Bottom := tbFindRowInx(Row);
- end;
-{--------}
-procedure TOvcCustomTable.tbCalcColData(var CD : POvcTblDisplayArray;
- NewLeftCol : TColNum);
- var
- X : integer;
- Width : integer;
- Access : TOvcTblAccess;
- Hidden : boolean;
- ColNum : TColNum;
- FullWidth : integer;
- PredColCount : TColNum;
- PredLocked : TColNum;
- begin
- {initialise}
- X := 0;
- ColNum := -1;
- CD^.Count := 0;
- FullWidth := ClientWidth; {save expense of function call in loop}
- PredColCount := pred(ColCount); {save expense of function call in loop}
- PredLocked := pred(LockedCols); {save expense of function call in loop}
-
- {deal with the locked columns first}
- if (LockedCols <> 0) then
- while (X < FullWidth) and (ColNum < PredLocked) do
- begin
- inc(ColNum);
- tbQueryColData(ColNum, Width, Access, Hidden);
- if not Hidden then
- begin
- with CD^ do
- begin
- with Ay[Count] do
- begin
- Number := ColNum;
- Offset := X;
- end;
- inc(Count);
- if (Count >= AllocNm) then
- AssignDisplayArray(CD, AllocNm+16);
- end;
- inc(X, Width);
- end;
- end;
-
- {now deal with the rightmost columns}
- ColNum := pred(NewLeftCol);
- while (X < FullWidth) and (ColNum < PredColCount) do
- begin
- inc(ColNum);
- tbQueryColData(ColNum, Width, Access, Hidden);
- if not Hidden then
- begin
- with CD^ do
- begin
- with Ay[Count] do
- begin
- Number := ColNum;
- Offset := X;
- end;
- inc(Count);
- if (Count >= AllocNm) then
- AssignDisplayArray(CD, AllocNm+16);
- end;
- inc(X, Width);
- end;
- end;
-
- {use the next spare element for storing the offset for the grid}
- with CD^ do
- Ay[Count].Offset := X;
- end;
-{--------}
-function TOvcCustomTable.CalcRowColFromXY(X, Y : integer;
- var RowNum : TRowNum;
- var ColNum : TColNum) : TOvcTblRegion;
- var
- ColInx : integer;
- RowInx : integer;
- CW : integer;
- CH : integer;
- TW : integer;
- TH : integer;
- begin
- RowNum := CRCFXY_RowBelow;
- ColNum := CRCFXY_ColToRight;
- CW := ClientWidth;
- CH := ClientHeight;
-
- {calculate the table width and height}
- with tbColNums^ do
- TW := MinI(CW, Ay[Count].Offset);
- with tbRowNums^ do
- TH := MinI(CH, Ay[Count].Offset);
-
- {make a first pass at calculating the region}
- if (X < 0) or (Y < 0) or (X >= CW) or (Y >= CH) then
- Result := otrOutside {definitely}
- else
- Result := otrInMain; {possibly, could also be one of the other two}
-
- {calculate row first}
- with tbRowNums^ do
- if (0 <= Y) and (Y < TH) then
- begin
- RowInx := 0;
- while (Ay[RowInx].Offset <= Y) do
- inc(RowInx);
- RowNum := Ay[pred(RowInx)].Number;
- end;
-
- {now calculate column}
- with tbColNums^ do
- if (0 <= X) and (X < TW) then
- begin
- ColInx := 0;
- while (Ay[ColInx].Offset <= X) do
- inc(ColInx);
- ColNum := Ay[pred(ColInx)].Number;
- end;
-
- {now patch up the region}
- if (Result = otrInMain) then
- if (RowNum = CRCFXY_RowBelow) or (ColNum = CRCFXY_ColToRight) then
- Result := otrInUnused
- else if (RowNum < LockedRows) or (ColNum < LockedCols) then
- Result := otrInLocked;
-
- {now patch up the row and column numbers}
- if (Result = otrOutside) or (Result = otrInUnused) then
- begin
- if (RowNum = CRCFXY_RowBelow) and (Y < 0) then
- RowNum := CRCFXY_RowAbove;
- if (ColNum = CRCFXY_ColToRight) and (X < 0) then
- ColNum := CRCFXY_ColToLeft;
- end;
- end;
-{--------}
-{$IFDEF SuppressWarnings}
-{$Warnings OFF}
-{$ENDIF}
-procedure TOvcCustomTable.tbCalcColsOnLastPage;
- var
- CD : POvcTblDisplayArray;
- OldLeftCol : TColNum;
- NewLeftCol : TColNum;
- StillGoing : boolean;
- begin
- OldLeftCol := 0;
- if (ColCount <= LockedCols) then
- begin
- tbColsOnLastPage := 0;
- Exit;
- end;
-
- CD := nil;
- AssignDisplayArray(CD, tbColNums^.AllocNm);
-
- try
- NewLeftCol := IncCol(pred(ColCount), 0);
- tbCalcColData(CD, NewLeftCol);
- if (CD^.Ay[CD^.Count].Offset > ClientWidth) then
- begin
- tbLastLeftCol := NewLeftCol;
- tbColsOnLastPage := 1;
- Exit;
- end;
-
- StillGoing := true;
- while StillGoing do
- begin
- OldLeftCol := NewLeftCol;
- NewLeftCol := IncCol(NewLeftCol, -1);
- if (NewLeftCol = OldLeftCol) then
- StillGoing := false
- else
- begin
- tbCalcColData(CD, NewLeftCol);
- StillGoing := (CD^.Ay[CD^.Count].Offset < ClientWidth);
- end;
- end;
- tbColsOnLastPage := ColCount - NewLeftCol;
- tbLastLeftCol := OldLeftCol;
- if tbLastLeftCol < LeftCol then
- LeftCol := tbLastLeftCol;
- finally
- AssignDisplayArray(CD, 0);
- end;{try..finally}
- end;
-{$IFDEF SuppressWarnings}
-{$Warnings ON}
-{$ENDIF}
-{--------}
-procedure TOvcCustomTable.tbCalcRowData(var RD : POvcTblDisplayArray;
- NewTopRow : TRowNum);
- var
- Y : integer;
- Height : integer;
- Hidden : boolean;
- RowNum : TRowNum;
- FullHeight : integer;
- PredRowLimit : TRowNum;
- PredLocked : TRowNum;
- begin
- {initialise}
- Y := 0;
- RowNum := -1;
- RD^.Count := 0;
- FullHeight := ClientHeight; {save expense of function call in loop}
- PredRowLimit := pred(RowLimit); {save expense of function call in loop}
- PredLocked := pred(LockedRows); {save expense of function call in loop}
-
- {deal with the locked rows first}
- if (LockedRows <> 0) then
- while (Y < FullHeight) and (RowNum < PredLocked) do
- begin
- inc(RowNum);
- tbQueryRowData(RowNum, Height, Hidden);
- if not Hidden then
- begin
- with RD^ do
- begin
- with Ay[Count] do
- begin
- Number := RowNum;
- Offset := Y;
- end;
- inc(Count);
- if (Count >= AllocNm) then
- AssignDisplayArray(RD, AllocNm+16);
- end;
- inc(Y, Height);
- end;
- end;
-
- {now deal with the rows underneath the fixed rows}
- RowNum := pred(NewTopRow);
- while (Y < FullHeight) and (RowNum < PredRowLimit) do
- begin
- inc(RowNum);
- tbQueryRowData(RowNum, Height, Hidden);
- if not Hidden then
- begin
- with RD^ do
- begin
- with Ay[Count] do
- begin
- Number := RowNum;
- Offset := Y;
- end;
- inc(Count);
- if (Count >= AllocNm) then
- AssignDisplayArray(RD, AllocNm+16);
- end;
- inc(Y, Height);
- end;
- end;
-
- {use the next spare element for storing the offset for the grid}
- with RD^ do
- Ay[Count].Offset := Y;
- end;
-{--------}
-{$IFDEF SuppressWarnings}
-{$Warnings OFF}
-{$ENDIF}
-procedure TOvcCustomTable.tbCalcRowsOnLastPage;
- var
- RD : POvcTblDisplayArray;
- OldTopRow : TRowNum;
- NewTopRow : TRowNum;
- StillGoing : boolean;
- begin
- OldTopRow := 0;
- if (RowLimit <= LockedRows) then
- begin
- tbRowsOnLastPage := 0;
- Exit;
- end;
-
- RD := nil;
- AssignDisplayArray(RD, tbRowNums^.AllocNm);
-
- try
- NewTopRow := IncRow(pred(RowLimit), 0);
- tbCalcRowData(RD, NewTopRow);
- if (RD^.Ay[RD^.Count].Offset >= ClientHeight) then
- begin
- tbLastTopRow := NewTopRow;
- tbRowsOnLastPage := 1;
- Exit;
- end;
-
- StillGoing := true;
- while StillGoing do
- begin
- OldTopRow := NewTopRow;
- NewTopRow := IncRow(OldTopRow, -1);
- if (NewTopRow = OldTopRow) then
- StillGoing := false
- else
- begin
- tbCalcRowData(RD, NewTopRow);
- StillGoing := (RD^.Ay[RD^.Count].Offset < ClientHeight);
- end;
- end;
- tbRowsOnLastPage := RowLimit - OldTopRow;
- tbLastTopRow := OldTopRow;
- if tbLastTopRow < TopRow then
- TopRow := tbLastTopRow;
- finally
- AssignDisplayArray(RD, 0);
- end;{try..finally}
- end;
-{$IFDEF SuppressWarnings}
-{$Warnings ON}
-{$ENDIF}
-{--------}
-procedure TOvcCustomTable.tbCalcHSBarPosCount;
- var
- Col : TColNum;
- begin
- tbHSBarPosCount := 0;
- for Col := LockedCols to tbLastLeftCol do
- if not tbIsColHidden(Col) then
- inc(tbHSBarPosCount);
- end;
-{--------}
-function TOvcCustomTable.tbCalcRequiresVSBar : boolean;
- var
- Row : TRowNum;
- begin
- {a fast check for possible hidden rows: if there are none and the
- last page's top row is not equal to the number of locked rows
- then obviously a vertical scrollbar is required.}
- if (LockedRows < tbLastTopRow) and
- (Rows.Count = 0) then
- begin
- Result := true;
- Exit;
- end;
- {otherwise check to see whether all rows between the locked rows
- and the last page's top row are hidden: if so no vertical scroll
- bar is required.}
- Result := false;
- for Row := LockedRows to pred(tbLastTopRow) do
- if not Rows.Hidden[Row] then
- begin
- Result := true;
- Exit;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.ChangeScale(M, D : integer);
- var
- i : TColNum;
- begin
- inherited ChangeScale(M, D);
- if (M <> D) then
- begin
- Rows.rwScaleHeights(M, D);
- for i := 0 to pred(ColCount) do
- with Columns[i] do
- Width := MulDiv(Width, M, D);
- end;
- end;
-{--------}
-
-{ - HWnd changed to TOvcHWnd for BCB Compatibility }
-function TOvcCustomTable.tbEditCellHasFocus(
- FocusHandle : TOvcHWnd{HWND}) : boolean;
- var
- ChildHandle : HWND;
- begin
- Result := false;
- if not InEditingState then
- Exit;
- if (tbActCell.EditHandle = 0) then
- Exit;
- Result := true;
- if (FocusHandle = tbActCell.EditHandle) then
- Exit;
- ChildHandle := GetWindow(tbActCell.EditHandle, GW_CHILD);
- while (ChildHandle <> 0) do
- begin
- if (FocusHandle = ChildHandle) then
- Exit;
- ChildHandle := GetWindow(ChildHandle, GW_CHILD);
- end;
- Result := false;
- end;
-{--------}
-procedure TOvcCustomTable.tbEnsureColumnIsVisible(ColNum : TColNum);
- var
- ColInx : integer;
- CW : integer;
- FarRight : integer;
- LeftInx : integer;
- LColOfs : integer;
- LColWd : integer;
- begin
- {get the index for the column}
- ColInx := tbFindColInx(ColNum);
- if (ColInx = -1) then
- begin
- {the column is not even visible}
- {make this column the left column}
- LeftCol := ColNum;
- end
- else
- begin
- CW := ClientWidth;
- with tbColNums^ do
- FarRight := Ay[succ(ColInx)].Offset;
- if (FarRight > CW) then
- begin
- {the column is partially visible}
-
- {pretend that we're scrolling the table left
- column by column, until either
- (1) the column we want is fully visible, or
- (2) the column we want is the leftmost column
- then set the leftmost column}
- LeftInx := tbFindColInx(LeftCol);
- LColOfs := tbColNums^.Ay[LeftInx].Offset;
- LColWd := tbColNums^.Ay[succ(LeftInx)].Offset - LColOfs;
- dec(FarRight, LColWd);
- inc(LColOfs, LColWd);
- inc(LeftInx);
- while (LeftInx < ColInx) and (FarRight > CW) do
- begin
- LColWd := tbColNums^.Ay[succ(LeftInx)].Offset - LColOfs;
- dec(FarRight, LColWd);
- inc(LColOfs, LColWd);
- inc(LeftInx);
- end;
- if (LeftInx < tbColNums^.Count) then
- LeftCol := tbColNums^.Ay[LeftInx].Number;
- end;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbEnsureRowIsVisible(RowNum : TRowNum);
- var
- RowInx : integer;
- CH : integer;
- FarBottom: integer;
- TopInx : integer;
- TpRowOfs : integer;
- TpRowHt : integer;
- begin
- RowInx := tbFindRowInx(RowNum);
- if (RowInx = -1) then
- begin
- {the row is not even visible}
- {make this row the top row}
- TopRow := RowNum;
- end
- else
- begin
- CH := ClientHeight;
- with tbRowNums^ do
- FarBottom := Ay[succ(RowInx)].Offset;
- if (FarBottom > CH) then
- begin
- {the row is partially visible}
-
- {pretend that we're scrolling the table up
- row by row, until either
- (1) the row we want is fully visible, or
- (2) the row we want is the topmost row
- then set the topmost row}
- TopInx := tbFindRowInx(TopRow);
- TpRowOfs := tbRowNums^.Ay[TopInx].Offset;
- TpRowHt := tbRowNums^.Ay[succ(TopInx)].Offset - TpRowOfs;
- dec(FarBottom, TpRowHt);
- inc(TpRowOfs, TpRowHt);
- inc(TopInx);
- while (TopInx < RowInx) and (FarBottom > CH) do
- begin
- TpRowHt := tbRowNums^.Ay[succ(TopInx)].Offset - TpRowOfs;
- dec(FarBottom, TpRowHt);
- inc(TpRowOfs, TpRowHt);
- inc(TopInx);
- end;
- if (TopInx < tbRowNums^.Count) then
- TopRow := tbRowNums^.Ay[TopInx].Number;
- end;
- end;
- end;
-{--------}
-function TOvcCustomTable.tbFindCell(RowNum : TRowNum;
- ColNum : TColNum) : TOvcBaseTableCell;
- begin
- Result := FCells[RowNum, ColNum];
- if not Assigned(Result) then
- if (RowNum < LockedRows) then
- Result := FLockedRowsCell
- else
- Result := FCols[ColNum].DefaultCell;
- end;
-{--------}
-function TOvcCustomTable.tbFindColInx(ColNum : TColNum) : integer;
- var
- L, M, R : integer;
- CurNumber : TColNum;
- begin
- Result := -1;
- with tbColNums^ do
- begin
- if (Count = 0) then
- Exit;
- L := 0;
- R := pred(Count);
- repeat
- M := (L + R) div 2;
- CurNumber := Ay[M].Number;
- if (ColNum = CurNumber) then
- begin
- Result := M;
- Exit;
- end
- else if (ColNum < CurNumber) then
- R := pred(M)
- else
- L := succ(M);
- until (L > R);
- end;
- end;
-{--------}
-function TOvcCustomTable.tbFindRowInx(RowNum : TRowNum) : integer;
- var
- L, M, R : integer;
- CurNumber : TRowNum;
- begin
- Result := -1;
- with tbRowNums^ do
- begin
- if (Count = 0) then
- Exit;
- L := 0;
- R := pred(Count);
- repeat
- M := (L + R) div 2;
- CurNumber := Ay[M].Number;
- if (RowNum = CurNumber) then
- begin
- Result := M;
- Exit;
- end
- else if (RowNum < CurNumber) then
- R := pred(M)
- else
- L := succ(M);
- until (L > R);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.GetDisplayedColNums(var NA : TOvcTableNumberArray);
- var
- i : integer;
- WorkCount : integer;
- begin
- WorkCount := MinL(NA.NumElements, tbColNums^.Count);
- for i := 0 to pred(WorkCount) do
- NA.Number[i] := tbColNums^.Ay[i].Number;
- NA.Count := tbColNums^.Count
- end;
-{--------}
-procedure TOvcCustomTable.GetDisplayedRowNums(var NA : TOvcTableNumberArray);
- var
- i : integer;
- WorkCount : integer;
- begin
- WorkCount := MinL(NA.NumElements, tbRowNums^.Count);
- for i := 0 to pred(WorkCount) do
- NA.Number[i] := tbRowNums^.Ay[i].Number;
- NA.Count := tbRowNums^.Count
- end;
-{--------}
-function TOvcCustomTable.IncCol(ColNum : TColNum; Direction : integer) : TColNum;
- {-Return a valid unhidden column number. If Direction is:
- -ve : start at C and find the previous unhidden column number, if there
- is none previous to this one, return C.
- +ve : start at R and find the next unhidden column number, if there is
- none after this one, return C
- 0 : verify that C is unhidden, if not find the next unhidden column
- number, if none after this one, find the previous one. If still
- none, return C.}
- var
- CL, CC : TColNum;
- begin
- {save the values of properties in local variables}
- CL := LockedCols;
- CC := ColCount;
- {adjust ColNum to be in range}
- if (ColNum < CL) or (ColNum >= CC) then
- ColNum := CL;
- {first direction=0, ie to see whether the column is visible}
- Result := ColNum;
- if (Direction = 0) then {check not hidden}
- if not tbIsColHidden(Result) then
- Exit;
- {now direction>=0, ie to increment the column number}
- if (Direction >= 0) then {go forwards}
- begin
- inc(Result);
- while Result < CC do
- begin
- if not tbIsColHidden(Result) then
- Exit;
- inc(Result);
- end;
- Result := ColNum;
- end;
- {now direction<=0, ie to decrement the column number}
- if (Direction <= 0) then {go backwards}
- begin
- dec(Result);
- while (Result >= CL) do
- begin
- if not tbIsColHidden(Result) then
- Exit;
- dec(Result);
- end;
- Result := ColNum;
- end;
- end;
-{--------}
-function TOvcCustomTable.IncRow(RowNum : TRowNum; Direction : integer) : TRowNum;
- {-Return a valid unhidden row number. If Direction is:
- -ve : start at R and find the previous unhidden row number, if there
- is none previous to this one, return R.
- +ve : start at R and find the next unhidden row number, if there is
- none after this one, return R
- 0 : verify that R is unhidden, if not find the next unhidden row
- number, if none after this one, find the previous one. If still
- none, return R.}
- var
- RL, RC : TRowNum;
- begin
- {save the values of properties in local variables}
- RL := LockedRows;
- RC := RowLimit;
- {adjust RowNum to be in range}
- if (RowNum < RL) or (RowNum >= RC) then
- RowNum := RL;
- {first direction=0, ie to see whether the column is visible}
- Result := RowNum;
- if (Direction = 0) then {check not hidden}
- if not tbIsRowHidden(Result) then
- Exit;
- {now direction>=0, ie to increment the column number}
- if (Direction >= 0) then {go forwards}
- begin
- inc(Result);
- while (Result < RC) do
- begin
- if not tbIsRowHidden(Result) then
- Exit;
- inc(Result);
- end;
- Result := RowNum;
- end;
- {now direction<=0, ie to decrement the column number}
- if (Direction <= 0) then {go backwards}
- begin
- dec(Result);
- while (Result >= RL) do
- begin
- if not tbIsRowHidden(Result) then
- Exit;
- dec(Result);
- end;
- Result := RowNum;
- end;
- end;
-{--------}
-function TOvcCustomTable.InEditingState : boolean;
- begin
- Result := (tbState * [otsEditing, otsHiddenEdit]) <> [];
- end;
-{--------}
-function TOvcCustomTable.tbIsColHidden(ColNum : TColNum) : boolean;
- begin
- if (ColNum < 0) or (ColNum >= FCols.Count) then
- Result := True
- else
- Result := FCols[ColNum].Hidden;
- end;
-{--------}
-function TOvcCustomTable.tbIsOnGridLine(MouseX, MouseY : integer;
- var VerticalGrid : boolean) : boolean;
- var
- GridLine : integer;
- Inx : integer;
- LockedColsOffset : integer;
- LockedRowsOffset : integer;
- begin
- Result := false;
- {calc the offsets of the column and row}
- LockedColsOffset := -1;
- Inx := 0;
- with tbColNums^ do
- while (Inx < Count) do
- begin
- if (Ay[Inx].Number >= LockedCols) then
- Break;
- inc(Inx);
- LockedColsOffset := Ay[Inx].Offset;
- end;
- LockedRowsOffset := -1;
- Inx := 0;
- with tbRowNums^ do
- while (Inx < Count) do
- begin
- if (Ay[Inx].Number >= LockedRows) then
- Break;
- inc(Inx);
- LockedRowsOffset := Ay[Inx].Offset;
- end;
- {do the obvious test: cursor is not within the locked area}
- if (MouseX >= LockedColsOffset) and (MouseY >= LockedRowsOffset) then
- Exit;
- {check rows first}
- if (MouseX < LockedColsOffset) then
- begin
- Inx := 0;
- with tbRowNums^ do
- while (Inx < Count) do
- begin
- inc(Inx);
- GridLine := Ay[Inx].Offset;
- if (GridLine-2 <= MouseY) and (MouseY <= GridLine+2) then
- begin
- VerticalGrid := false;
- Result := true;
- tbSizeIndex := pred(Inx);
- Exit;
- end;
- end;
- end;
- {check columns next}
- if (MouseY < LockedRowsOffset) then
- begin
- Inx := 0;
- with tbColNums^ do
- while (Inx < Count) do
- begin
- inc(Inx);
- GridLine := Ay[Inx].Offset;
- if (GridLine-2 <= MouseX) and (MouseX <= GridLine+2) then
- begin
- VerticalGrid := true;
- Result := true;
- tbSizeIndex := pred(Inx);
- Exit;
- end;
- end;
- end;
- end;
-{--------}
-function TOvcCustomTable.tbIsInMoveArea(MouseX, MouseY : integer;
- var IsColMove : boolean) : boolean;
- var
- Inx : integer;
- LockedColsOffset : integer;
- LockedRowsOffset : integer;
- begin
- Result := false;
- IsColMove := false;
- {calc the offsets of the column and row}
- LockedColsOffset := -1;
- Inx := 0;
- with tbColNums^ do
- while (Inx < Count) do
- begin
- if (Ay[Inx].Number >= LockedCols) then
- Break;
- inc(Inx);
- LockedColsOffset := Ay[Inx].Offset;
- end;
- LockedRowsOffset := -1;
- Inx := 0;
- with tbRowNums^ do
- while (Inx < Count) do
- begin
- if (Ay[Inx].Number >= LockedRows) then
- Break;
- inc(Inx);
- LockedRowsOffset := Ay[Inx].Offset;
- end;
- {do the obvious test: cursor is not within the locked area}
- if (MouseX >= LockedColsOffset) and (MouseY >= LockedRowsOffset) then
- Exit;
- {the cursor is within the column move area if it's in a locked cell
- above the main area of the table; otherwise the cursor is within the
- row move area if it's in a locked cell to the left of the main area
- of the table}
- Result := (MouseX >= LockedColsOffset) and (MouseY < LockedRowsOffset) and
- (MouseX < tbColNums^.Ay[tbColNums^.Count].Offset);
- if Result then
- IsColMove := true
- else
- Result := (MouseX < LockedColsOffset) and (MouseY >= LockedRowsOffset) and
- (MouseY < tbRowNums^.Ay[tbRowNums^.Count].Offset);
- end;
-{--------}
-function TOvcCustomTable.tbIsRowHidden(RowNum : TRowNum) : boolean;
- begin
- Result := Rows[RowNum].Hidden;
- end;
-{--------}
-procedure TOvcCustomTable.Notification(AComponent: TComponent; Operation: TOperation);
- begin
- inherited Notification(AComponent, Operation);
- if (AComponent is TOvcBaseTableCell) and (Operation = opRemove) then
- begin
- AllowRedraw := false;
- try
- if (FLockedRowsCell = TOvcBaseTableCell(AComponent)) then
- begin
- FLockedRowsCell.DecRefs;
- FLockedRowsCell := nil;
- tbCellChanged(Self);
- end;
- if Assigned(FCols) then
- FCols.tcNotifyCellDeletion(TOvcBaseTableCell(AComponent));
- if Assigned(FCells) then
- FCells.tcNotifyCellDeletion(TOvcBaseTableCell(AComponent));
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbQueryColData(ColNum : TColNum;
- var W : integer;
- var A : TOvcTblAccess;
- var H : boolean);
- var
- ColData : TOvcTableColumn;
- begin
- ColData := FCols[ColNum];
- if Assigned(ColData) then with ColData do
- begin
- W := Width;
- if (DefaultCell <> nil) then
- A := DefaultCell.Access
- else
- A := otxReadOnly;
- H := Hidden;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbQueryRowData(RowNum : TRowNum;
- var Ht: integer;
- var H : boolean);
- var
- RowData : TRowStyle;
- begin
- RowData := FRows[RowNum];
- with RowData do
- begin
- Ht:= Height;
- H := Hidden;
- end;
- end;
-{--------}
-{$IFNDEF LCL}
-procedure TOvcCustomTable.SetBounds(ALeft, ATop, AWidth, AHeight: integer);
-{$ELSE}
-procedure TOvcCustomTable.DoSetBounds(ALeft, ATop, AWidth, AHeight: integer);
-{$ENDIF}
-// LCL port: Behavior of SetBounds changed in 0.9.29, so using DoSetBounds.
-// http://wiki.lazarus.freepascal.org/Lazarus_0.9.30_release_notes#overriding_TControl.SetBounds
-// Calls to TOvcTable.SetBounds will just be handled by ancestor.
- var
- WidthChanged : boolean;
- HeightChanged : boolean;
- begin
- if (not HandleAllocated) then
- begin
-{$IFNDEF LCL}
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-{$ELSE}
- inherited DoSetBounds(ALeft, ATop, AWidth, AHeight);
-{$ENDIF}
- Exit;
- end;
-
- WidthChanged := (Width <> AWidth);
- HeightChanged := (Height <> AHeight);
-
- if WidthChanged or HeightChanged then
- begin
- AllowRedraw := false;
- try
-{$IFNDEF LCL}
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-{$ELSE}
- inherited DoSetBounds(ALeft, ATop, AWidth, AHeight);
-{$ENDIF}
- if WidthChanged then
- tbCalcColData(tbColNums, LeftCol);
- if HeightChanged then
- tbCalcRowData(tbRowNums, TopRow);
- tbSetScrollRange(otsbVertical);
- tbSetScrollRange(otsbHorizontal);
- if (TopRow > tbLastTopRow) then
- TopRow := tbLastTopRow;
- if (LeftCol > tbLastLeftCol) then
- LeftCol := tbLastLeftCol;
- InvalidateTable;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end
- else
-{$IFNDEF LCL}
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-{$ELSE}
- inherited DoSetBounds(ALeft, ATop, AWidth, AHeight);
-{$ENDIF}
- end;
-{====================================================================}
-
-
-{==TOvcTable active cell movement====================================}
-procedure TOvcCustomTable.tbMoveActCellBotOfPage;
- var
- RowInx : integer;
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- with tbRowNums^ do
- if (Ay[Count].Offset <= ClientHeight) then
- NewActiveRow := IncRow(Ay[pred(Count)].Number, 0)
- else
- begin
- RowInx := pred(Count);
- if (RowInx > 0) then
- dec(RowInx);
- if (Ay[RowInx].Number < LockedRows) then
- NewActiveRow := IncRow(TopRow, 0)
- else
- NewActiveRow := IncRow(Ay[RowInx].Number, 0);
- end;
- NewActiveCol := ActiveCol;
- DoActiveCellMoving(ccBotOfPage, NewActiveRow, NewActiveCol);
- if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellBotRight;
- var
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- NewActiveRow := IncRow(pred(RowLimit), 0);
- NewActiveCol := IncCol(pred(ColCount), 0);
- DoActiveCellMoving(ccBotRightCell, NewActiveRow, NewActiveCol);
- if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellDown;
- var
- NewTopRow : TRowNum;
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- i : integer;
- begin
- NewTopRow := TopRow;
- NewActiveRow := IncRow(ActiveRow, 1);
- NewActiveCol := ActiveCol;
- DoActiveCellMoving(ccDown, NewActiveRow, NewActiveCol);
- if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then
- begin
- {we need to take care of a special case: if the current active
- cell is *exactly* on the last row of the page, we need to
- artificially move the top row down by one, before setting the
- active cell, otherwise the top row is forced to the active cell
- later on--a bit disconcerting.}
- with tbRowNums^ do
- if (Ay[Count].Offset = ClientHeight) and
- (ActiveRow = Ay[pred(Count)].Number) and
- (NewActiveRow > ActiveRow) then
- begin
- for i := 1 to NewActiveRow-ActiveRow do
- NewTopRow := IncRow(TopRow, 1);
- if (NewTopRow < NewActiveRow) then
- begin
- AllowRedraw := False;
- try
- TopRow := NewTopRow;
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- finally
- AllowRedraw := True;
- end;{try..finally}
- end
- else
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end
- else
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellFirstCol;
- var
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- NewActiveCol := IncCol(LockedCols, 0);
- NewActiveRow := ActiveRow;
- DoActiveCellMoving(ccHome, NewActiveRow, NewActiveCol);
- if (ActiveCol <> NewActiveCol) or (ActiveRow <> NewActiveRow) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellFirstRow;
- var
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- NewActiveRow := IncRow(LockedRows, 0);
- NewActiveCol := ActiveCol;
- DoActiveCellMoving(ccFirstPage, NewActiveRow, NewActiveCol);
- if (ActiveRow <> NewActiveRow) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellLastCol;
- var
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- NewActiveCol := IncCol(pred(ColCount), 0);
- NewActiveRow := ActiveRow;
- DoActiveCellMoving(ccEnd, NewActiveRow, NewActiveCol);
- if (ActiveCol <> NewActiveCol) or (ActiveRow <> NewActiveRow) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellLastRow;
- var
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
-// Apparent TurboPower bug: not initializing NewActiveCol.
-// But not sure what it should be set to.
- NewActiveRow := IncRow(pred(RowLimit), 0);
- if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then
- begin
- NewActiveCol := ActiveCol;
- DoActiveCellMoving(ccLastPage, NewActiveRow, NewActiveCol);
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellLeft;
- var
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- NewActiveCol := IncCol(ActiveCol, -1);
- NewActiveRow := ActiveRow;
- DoActiveCellMoving(ccLeft, NewActiveRow, NewActiveCol);
- if (ActiveCol <> NewActiveCol) or (ActiveRow <> NewActiveRow) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellPageDown;
- var
- NewTopRow,
- CurRow, LastRow : TRowNum;
- CurInx, LastInx : integer;
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- CurRow := ActiveRow;
- CurInx := tbFindRowInx(CurRow);
- with tbRowNums^ do
- begin
- LastInx := pred(Count);
- LastRow := Ay[LastInx].Number;
- end;
- if (CurRow = LastRow) then
- NewTopRow := IncRow(LastRow, 1)
- else
- NewTopRow := LastRow;
-
- AllowRedraw := false;
- try
- TopRow := NewTopRow;
-
- if (CurInx = -1) then
- NewActiveRow := IncRow(TopRow, 0)
- else if (CurInx < tbRowNums^.Count) then
- NewActiveRow := IncRow(tbRowNums^.Ay[CurInx].Number, 0)
- else
- NewActiveRow := IncRow(tbRowNums^.Ay[pred(tbRowNums^.Count)].Number, 0);
- NewActiveCol := ActiveCol;
- DoActiveCellMoving(ccNextPage, NewActiveRow, NewActiveCol);
- if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellPageLeft;
- var
- Walker,
- CurLeftCol : TRowNum;
- CurInx : integer;
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- CurLeftCol := LeftCol;
- if (ActiveCol = LeftCol) then
- begin
- Walker := IncCol(CurLeftCol, -1);
- if (Walker = CurLeftCol) then
- Exit;
- end;
- CurInx := tbFindColInx(ActiveCol);
- AllowRedraw := false;
- try
- tbScrollBarPageLeft;
- if (CurInx = -1) or (CurLeftCol = LeftCol) then
- NewActiveCol := IncCol(LeftCol, 0)
- else if (CurInx < tbColNums^.Count) then
- NewActiveCol := IncCol(tbColNums^.Ay[CurInx].Number, 0)
- else
- NewActiveCol := IncCol(tbColNums^.Ay[pred(tbColNums^.Count)].Number, 0);
- NewActiveRow := ActiveRow;
- DoActiveCellMoving(ccPageLeft, NewActiveRow, NewActiveCol);
- if (ActiveCol <> NewActiveCol) or (ActiveRow <> NewActiveRow) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellPageRight;
- var
- NewLeftCol,
- CurCol, LastCol : TColNum;
- CurInx, LastInx : integer;
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- CurCol := ActiveCol;
- CurInx := tbFindColInx(CurCol);
- with tbColNums^ do
- begin
- LastInx := pred(Count);
- LastCol := Ay[LastInx].Number;
- end;
- if (CurCol = LastCol) then
- NewLeftCol := IncCol(LastCol, 1)
- else
- NewLeftCol := LastCol;
-
- AllowRedraw := false;
- try
- LeftCol := NewLeftCol;
-
- if (CurInx = -1) then
- NewActiveCol := IncCol(LeftCol, 0)
- else if (CurInx < tbColNums^.Count) then
- NewActiveCol := IncCol(tbColNums^.Ay[CurInx].Number, 0)
- else
- NewActiveCol := IncCol(tbColNums^.Ay[pred(tbColNums^.Count)].Number, 0);
- NewActiveRow := ActiveRow;
- DoActiveCellMoving(ccPageRight, NewActiveRow, NewActiveCol);
- if (ActiveCol <> NewActiveCol) or (ActiveRow <> NewActiveRow) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellPageUp;
- var
- Walker,
- CurTopRow : TRowNum;
- CurInx : integer;
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- CurTopRow := TopRow;
- if (ActiveRow = TopRow) then
- begin
- Walker := IncRow(CurTopRow, -1);
- if (Walker = CurTopRow) then
- Exit;
- end;
- CurInx := tbFindRowInx(ActiveRow);
- AllowRedraw := false;
- try
- tbScrollBarPageUp;
- if (CurInx = -1) or (CurTopRow = TopRow) then
- NewActiveRow := IncRow(TopRow, 0)
- else if (CurInx < tbRowNums^.Count) then
- NewActiveRow := IncRow(tbRowNums^.Ay[CurInx].Number, 0)
- else
- NewActiveRow := IncRow(tbRowNums^.Ay[pred(tbRowNums^.Count)].Number, 0);
- NewActiveCol := ActiveCol;
- DoActiveCellMoving(ccPrevPage, NewActiveRow, NewActiveCol);
- if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellRight;
- var
- NewActiveRow : TRowNum;
- NewLeftCol,
- NewActiveCol : TColNum;
- i : integer;
- begin
- NewLeftCol := LeftCol;
- NewActiveCol := IncCol(ActiveCol, 1);
- NewActiveRow := ActiveRow;
- DoActiveCellMoving(ccRight, NewActiveRow, NewActiveCol);
- if (ActiveCol <> NewActiveCol) or (ActiveRow <> NewActiveRow) then
- begin
- {we need to take care of a special case: if the current active
- cell is *exactly* on the last column of the page, we need to
- artificially move the leftmost column across by one, before
- setting the active cell, otherwise the leftmost column is
- forced to the active cell later on--a bit disconcerting.}
- with tbColNums^ do
- if (NewActiveCol > ActiveCol) and
- (ActiveCol = Ay[pred(Count)].Number) and
- (Ay[Count].Offset = ClientWidth) then
- begin
- for i := 1 to NewActiveCol-ActiveCol do
- NewLeftCol := IncCol(LeftCol, 1);
- if (NewLeftCol < NewActiveCol) then
- begin
- AllowRedraw := False;
- try
- LeftCol := NewLeftCol;
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- finally
- AllowRedraw := True;
- end;{try..finally}
- end
- else
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol)
- end
- else
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellTopLeft;
- var
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- NewActiveRow := IncRow(LockedRows, 0);
- NewActiveCol := IncCol(LockedCols, 0);
- DoActiveCellMoving(ccTopLeftCell, NewActiveRow, NewActiveCol);
- if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellTopOfPage;
- var
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- NewActiveRow := IncRow(TopRow, 0);
- NewActiveCol := ActiveCol;
- DoActiveCellMoving(ccTopOfPage, NewActiveRow, NewActiveCol);
- if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbMoveActCellUp;
- var
- NewActiveRow : TRowNum;
- NewActiveCol : TColNum;
- begin
- NewActiveRow := IncRow(ActiveRow, -1);
- NewActiveCol := ActiveCol;
- DoActiveCellMoving(ccUp, NewActiveRow, NewActiveCol);
- if (ActiveRow <> NewActiveRow) or (ActiveCol <> NewActiveCol) then
- begin
- tbSetActiveCellWithSel(NewActiveRow, NewActiveCol);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.MoveActiveCell(Command : word);
- begin
- if (otoNoSelection in Options) then
- tbIsKeySelecting := false;
-
- case Command of
- {NOTE: this case statement has been optimised, the ccXxx
- constants are in ASCENDING order of value not name--it's
- lucky that the former implies the latter.}
- ccBotOfPage : tbMoveActCellBotOfPage;
- ccBotRightCell : tbMoveActCellBotRight;
- ccDown : tbMoveActCellDown;
- ccEnd : tbMoveActCellLastCol;
- ccFirstPage : tbMoveActCellFirstRow;
- ccHome : tbMoveActCellFirstCol;
- ccLastPage : tbMoveActCellLastRow;
- ccLeft : tbMoveActCellLeft;
- ccNextPage : tbMoveActCellPageDown;
- ccPageLeft : tbMoveActCellPageLeft;
- ccPageRight : tbMoveActCellPageRight;
- ccPrevPage : tbMoveActCellPageUp;
- ccRight : tbMoveActCellRight;
- ccTopLeftCell : tbMoveActCellTopLeft;
- ccTopOfPage : tbMoveActCellTopOfPage;
- ccUp : tbMoveActCellUp;
- end;{case}
- end;
-{====================================================================}
-
-
-{==TOvcTable scrollbar event handlers================================}
-procedure TOvcCustomTable.ProcessScrollBarClick(ScrollBar : TOvcScrollBar;
- ScrollCode : TScrollCode);
- var
- Form : TCustomForm;
- begin
- {check to see whether the cell being edited is valid;
- no scrolling allowed if it isn't (tough).}
- if InEditingState then
- begin
- if not tbActCell.CanSaveEditedData(true) then
- Exit;
- end;
- {perform the scroll}
- if (ScrollBar = otsbVertical) then
- case ScrollCode of
- scLineUp : tbScrollBarUp;
- scLineDown : tbScrollBarDown;
- scPageUp : tbScrollBarPageUp;
- scPageDown : tbScrollBarPageDown;
- end{case}
- else {it's otsbHorizontal}
- case ScrollCode of
- scLineUp : tbScrollBarLeft;
- scLineDown : tbScrollBarRight;
- scPageUp : tbScrollBarPageLeft;
- scPageDown : tbScrollBarPageRight;
- end;{case}
- if (otsDesigning in tbState) then
- begin
- Form := TCustomForm(GetParentForm(Self));
- if (Form <> nil) and (Form.Designer <> nil) then
- Form.Designer.Modified;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbScrollBarDown;
- begin
- TopRow := IncRow(TopRow, 1);
- end;
-{--------}
-procedure TOvcCustomTable.tbScrollBarPageDown;
- var
- LastInx : integer;
- LastRow : TRowNum;
- begin
- with tbRowNums^ do
- begin
- LastInx := pred(Count);
- LastRow := Ay[LastInx].Number;
- end;
- if (TopRow <> LastRow) then
- TopRow := LastRow
- else
- TopRow := IncRow(TopRow, 1);
- end;
-{--------}
-procedure TOvcCustomTable.tbScrollBarPageUp;
- var
- CurTopRow : TRowNum;
- Walker : TRowNum;
- CH : integer;
- OurRowNums: POvcTblDisplayArray;
- NewTopRow : TRowNum;
- begin
- {-Scroll the table so that the current top row appears at
- the bottom of the table window (if possible).}
- CurTopRow := TopRow;
- Walker := IncRow(CurTopRow, -1);
- if (Walker = CurTopRow) then
- Exit;
-
- OurRowNums := nil;
- AssignDisplayArray(OurRowNums, tbRowNums^.AllocNm);
- try
- CH := ClientHeight;
- NewTopRow := Walker;
- tbCalcRowData(OurRowNums, NewTopRow);
- while (OurRowNums^.Ay[OurRowNums^.Count].Offset < CH) or
- (OurRowNums^.Ay[pred(OurRowNums^.Count)].Number > CurTopRow) do
- begin
- Walker := IncRow(NewTopRow, -1);
- if (Walker = NewTopRow) then
- Break;
- NewTopRow := Walker;
- tbCalcRowData(OurRowNums, NewTopRow);
- end;
- finally
- AssignDisplayArray(OurRowNums, 0);
- end;{try..finally}
- TopRow := NewTopRow;
- end;
-{--------}
-procedure TOvcCustomTable.tbScrollBarUp;
- begin
- TopRow := IncRow(TopRow, -1);
- end;
-{--------}
-procedure TOvcCustomTable.tbScrollBarLeft;
- begin
- LeftCol := IncCol(LeftCol, -1);
- end;
-{--------}
-procedure TOvcCustomTable.tbScrollBarPageLeft;
- var
- CurLeftCol : TColNum;
- Walker : TColNum;
- CW : integer;
- OurColNums : POvcTblDisplayArray;
- NewLeftCol : TColNum;
- begin
- CurLeftCol := LeftCol;
- Walker := IncCol(CurLeftCol, -1);
- if (Walker = CurLeftCol) then
- Exit;
-
- OurColNums := nil;
- AssignDisplayArray(OurColNums, tbColNums^.AllocNm);
- try
- CW := ClientWidth;
- NewLeftCol := Walker;
- tbCalcColData(OurColNums, NewLeftCol);
- while (OurColNums^.Ay[OurColNums^.Count].Offset < CW) or
- (OurColNums^.Ay[pred(OurColNums^.Count)].Number > CurLeftCol) do
- begin
- Walker := IncCol(NewLeftCol, -1);
- if (Walker = NewLeftCol) then
- Break;
- NewLeftCol := Walker;
- tbCalcColData(OurColNums, NewLeftCol);
- end;
- finally
- AssignDisplayArray(OurColNums, 0);
- end;{try..finally}
- LeftCol := NewLeftCol;
- end;
-{--------}
-procedure TOvcCustomTable.tbScrollBarPageRight;
- var
- LastInx : integer;
- LastCol : TColNum;
- begin
- with tbColNums^ do
- begin
- LastInx := pred(Count);
- LastCol := Ay[LastInx].Number;
- end;
- if (LeftCol <> LastCol) then
- LeftCol := LastCol
- else
- LeftCol := IncCol(LeftCol, 1);
- end;
-{--------}
-procedure TOvcCustomTable.tbScrollBarRight;
- begin
- LeftCol := IncCol(LeftCol, 1);
- end;
-{====================================================================}
-
-
-{==TOvcTable table scrolling routines================================}
-procedure TOvcCustomTable.tbScrollTableLeft(NewLeftCol : TColNum);
- var
- NewColInx : integer;
- NewCLOfs : integer;
- OldColRight : TColNum;
- OldColInx : integer;
- OldCLOfs : integer;
- ColNum : TColNum;
- R : TRect;
- CW : integer;
- begin
- {the window is scrolled left, ie the new leftmost column
- is to the right of the current leftmost column}
- AllowRedraw := false;
- try
- NewColInx := tbFindColInx(NewLeftCol);
- CW := ClientWidth;
- if (NewColInx = -1) or
- (tbColNums^.Ay[succ(NewColInx)].Offset > CW) then
- begin
- {the new leftmost column is not (fully) visible}
- FLeftCol := NewLeftCol;
- tbCalcColData(tbColNums, LeftCol);
- InvalidateTableNotLockedCols;
- end
- else
- begin
- {the new leftmost column is fully visible}
- OldColInx := tbFindColInx(FLeftCol);
- with tbColNums^ do
- begin
- OldColRight := Ay[pred(Count)].Number;
- if (Ay[Count].Offset < CW) then
- begin
- inc(OldColRight);
- tbInvCells.AddUnusedBit;
- end;
- NewCLOfs := Ay[NewColInx].Offset;
- OldCLOfs := Ay[OldColInx].Offset;
- end;
- R := Rect(OldCLOfs, 0, CW, ClientHeight);
- ScrollWindow(Handle,
- (OldCLOfs-NewCLOfs), 0,
- @R, @R);
- FLeftCol := NewLeftCol;
- tbCalcColData(tbColNums, LeftCol);
-{$IFDEF MSWINDOWS}
- if (OldColRight <= tbColNums^.Ay[pred(tbColNums^.Count)].Number) then
- begin
- tbInvCells.AddUnusedBit;
- for ColNum := OldColRight to tbColNums^.Ay[pred(tbColNums^.Count)].Number do
- InvalidateColumn(ColNum);
- end;
-{$ELSE} //With GTK, ScrollWindow (above) does nothing, so redraw all columns
- InvalidateTableNotLockedCols;
-{$ENDIF}
- R.Left := OldCLOfs + (CW - NewCLOfs);
- ValidateRect(Handle, @R);
- tbMustUpdate := true;
- UpdateWindow(Handle);
- end;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-procedure TOvcCustomTable.tbScrollTableRight(NewLeftCol : TColNum);
- var
- OldLeftCol: TColNum;
- OldColInx : integer;
- OldCLOfs : integer;
- OrigOfs : integer;
- ColNum : TColNum;
- R : TRect;
- begin
- {the window is scrolled right, ie the new leftmost column
- is to the left of the current leftmost column}
- AllowRedraw := false;
- try
- OldLeftCol := FLeftCol;
- OldColInx := tbFindColInx(OldLeftCol);
- OrigOfs := tbColNums^.Ay[OldColInx].Offset;
- FLeftCol := NewLeftCol;
- tbCalcColData(tbColNums, LeftCol);
- OldColInx := tbFindColInx(OldLeftCol);
- if (OldColInx = -1) then
- begin
- {the old leftmost column is no longer visible}
- InvalidateTableNotLockedCols;
- end
- else
- begin
- {the old leftmost column is (partially) visible}
- OldCLOfs := tbColNums^.Ay[OldColInx].Offset;
- R := Rect(OrigOfs, 0, ClientWidth, ClientHeight);
- ScrollWindow(Handle,
- (OldClOfs-OrigOfs), 0,
- @R, @R);
-{$IFDEF MSWINDOWS}
- for ColNum := FLeftCol to pred(OldLeftCol) do
- InvalidateColumn(ColNum);
-{$ELSE} //With GTK, ScrollWindow (above) does nothing, so redraw all columns
- InvalidateTableNotLockedCols;
-{$ENDIF}
- R.Right := OldCLOfs;
- ValidateRect(Handle, @R);
- tbMustUpdate := true;
- UpdateWindow(Handle);
- end;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-procedure TOvcCustomTable.tbScrollTableUp(NewTopRow : TRowNum);
- var
- NewRowInx : integer;
- NewRTOfs : integer;
- OldRowBottom : TRowNum;
- OldRowInx : integer;
- OldRTOfs : integer;
- RowNum : TRowNum;
- R : TRect;
- CH : integer;
- begin
- {the window is scrolled up, ie the new topmost row
- is underneath the current topmost row}
- AllowRedraw := false;
- try
- NewRowInx := tbFindRowInx(NewTopRow);
- CH := ClientHeight;
- if (NewRowInx = -1) or
- (tbRowNums^.Ay[succ(NewRowInx)].Offset > CH) then
- begin
- {the new topmost row is not (fully) visible}
- FTopRow := NewTopRow;
- tbCalcRowData(tbRowNums, TopRow);
- InvalidateTableNotLockedRows;
- end
- else
- begin
- {the new topmost row is fully visible}
- OldRowInx := tbFindRowInx(FTopRow);
- with tbRowNums^ do
- begin
- OldRowBottom := Ay[pred(Count)].Number;
- if (Ay[Count].Offset < CH) then
- begin
- inc(OldRowBottom);
- tbInvCells.AddUnusedBit;
- end;
- NewRTOfs := Ay[NewRowInx].Offset;
- OldRTOfs := Ay[OldRowInx].Offset;
- end;
- R := Rect(0, OldRTOfs, ClientWidth, CH);
- ScrollWindow(Handle,
- 0, (OldRTOfs-NewRTOfs),
- @R, @R);
- FTopRow := NewTopRow;
- tbCalcRowData(tbRowNums, TopRow);
-{$IFDEF MSWINDOWS}
- if (OldRowBottom <= tbRowNums^.Ay[pred(tbRowNums^.Count)].Number) then
- begin
- tbInvCells.AddUnusedBit;
- for RowNum := OldRowBottom to tbRowNums^.Ay[pred(tbRowNums^.Count)].Number do
- InvalidateRow(RowNum);
- end;
-{$ELSE} //With GTK, ScrollWindow (above) does nothing, so redraw all rows
- InvalidateTableNotLockedRows;
-{$ENDIF}
- R.Top := OldRTOfs + (CH - NewRTOfs);
- ValidateRect(Handle, @R);
- tbMustUpdate := true;
- UpdateWindow(Handle);
- end;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-procedure TOvcCustomTable.tbScrollTableDown(NewTopRow : TRowNum);
- var
- OldTopRow : TRowNum;
- OldRowInx : integer;
- OldRTOfs : integer;
- OrigOfs : integer;
- RowNum : TRowNum;
- R : TRect;
- begin
- {the window is scrolled down, ie the new topmost row
- is above the current topmost row}
- AllowRedraw := false;
- try
- OldTopRow := FTopRow;
- OldRowInx := tbFindRowInx(OldTopRow);
- OrigOfs := tbRowNums^.Ay[OldRowInx].Offset;
- FTopRow := NewTopRow;
- tbCalcRowData(tbRowNums, TopRow);
- OldRowInx := tbFindRowInx(OldTopRow);
- if (OldRowInx = -1) then
- begin
- {the old topmost row is no longer visible}
- InvalidateTableNotLockedRows;
- end
- else
- begin
- {the old topmost row is (partially) visible}
- OldRTOfs := tbRowNums^.Ay[OldRowInx].Offset;
- R := Rect(0, OrigOfs, ClientWidth, ClientHeight);
- ScrollWindow(Handle,
- 0, (OldRTOfs-OrigOfs),
- @R, @R);
-{$IFDEF MSWINDOWS}
- for RowNum := FTopRow to pred(OldTopRow) do
- InvalidateRow(RowNum);
-{$ELSE} //With GTK, ScrollWindow (above) does nothing, so redraw all rows
- InvalidateTableNotLockedRows;
-{$ENDIF}
- R.Bottom := OldRTOfs;
- ValidateRect(Handle, @R);
- tbMustUpdate := true;
- UpdateWindow(Handle);
- end;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{====================================================================}
-
-
-{==TOvcTable drawing routines========================================}
-procedure TOvcCustomTable.tbDrawActiveCell;
- var
- RowOfs : integer;
- ColOfs : integer;
- RowInx : integer;
- ColInx : integer;
- Ht : integer;
- Wd : integer;
- ActRowOfs : integer;
- ActRowBottom : integer;
- ActColOfs : integer;
- ActColRight : integer;
- GridPen : TOvcGridPen;
- BrushColor : TColor;
- DrawItFocused: boolean;
- begin
- ActRowOfs := 0;
- ActRowBottom := 0;
- ActColOfs := 0;
- ActColRight := 0;
-
- {Find the cell's row on the screen, exit if not present}
- RowInx := tbFindRowInx(ActiveRow);
- if (RowInx = -1) then Exit;
-
- {Find the cell's column on the screen, exit if not present}
- ColInx := tbFindColInx(ActiveCol);
- if (ColInx = -1) then Exit;
-
- {If we are in editing mode, display the editing control for the
- cell, otherwise, draw the focus box around the cell contents}
- if InEditingState then
- begin
-{$IFDEF MSWINDOWS}
- UpdateWindow(tbActCell.EditHandle); //Not implemented on Gtk/Qt and recurses w/ Carbon
-{$ENDIF}
- end
- else
- begin
- {draw the box round the cell}
- with Canvas do
- begin
- {get the correct grid pen}
- if (otsFocused in tbState) then
- begin
- GridPen := GridPenSet.CellWhenFocused;
- DrawItFocused := true;
- end
- else
- begin
- GridPen := GridPenSet.CellWhenUnfocused;
- DrawItFocused := false;
- end;
- if GridPen.Effect = geNone then
- Exit;
-
- RowOfs := tbRowNums^.Ay[RowInx].Offset;
- Ht := tbRowNums^.Ay[succ(RowInx)].Offset - RowOfs;
- ColOfs := tbColNums^.Ay[ColInx].Offset;
- Wd := tbColNums^.Ay[succ(ColInx)].Offset - ColOfs;
-
- {calculate where to draw the vertical/horizontal lines}
- case GridPenSet.NormalGrid.Effect of
- geNone : begin
- ActRowOfs := RowOfs;
- ActRowBottom := RowOfs+Ht-1;
- ActColOfs := ColOfs;
- ActColRight := ColOfs+Wd-1
- end;
- geVertical : begin
- ActRowOfs := RowOfs;
- ActRowBottom := RowOfs+Ht-1;
- ActColOfs := ColOfs;
- ActColRight := ColOfs+Wd-2;
- end;
- geHorizontal: begin
- ActRowOfs := RowOfs;
- ActRowBottom := RowOfs+Ht-2;
- ActColOfs := ColOfs;
- ActColRight := ColOfs+Wd-1;
- end;
- geBoth : begin
- ActRowOfs := RowOfs;
- ActRowBottom := RowOfs+Ht-2;
- ActColOfs := ColOfs;
- ActColRight := ColOfs+Wd-2;
- end;
- ge3D : begin
- ActRowOfs := RowOfs+1;
- ActRowBottom := RowOfs+Ht-2;
- ActColOfs := ColOfs+1;
- ActColRight := ColOfs+Wd-2;
- end;
- end;{case}
-
- {get the correct background color for the pen}
- if DrawItFocused then
-{$IFNDEF LCL}
- BrushColor := Colors.ActiveFocused
- else BrushColor := Colors.ActiveUnfocused;
-{$ELSE}
- BrushColor := Self.Colors.ActiveFocused
- else BrushColor := Self.Colors.ActiveUnfocused;
-{$ENDIF}
- Brush.Color := Color;
-
-{$IFNDEF LCL}
- Windows.SetBkColor(Handle, ColorToRGB(BrushColor));
-{$ELSE}
- LclIntf.SetBkColor(Handle, ColorToRGB(BrushColor));
-{$ENDIF}
-
- {set up the pen}
- with Pen do
- begin
- Width := 1;
- Style := GridPen.Style;
- Color := GridPen.NormalColor;
- end;
-
- {right line}
- if GridPen.Effect in [geVertical, geBoth, ge3D] then
- begin
- MoveTo(ActColRight, ActRowOfs);
- LineTo(ActColRight, ActRowBottom+1);
- end;
- {bottom line}
- if GridPen.Effect in [geHorizontal, geBoth, ge3D] then
- begin
- MoveTo(ActColOfs, ActRowBottom);
- LineTo(ActColRight+1, ActRowBottom);
- end;
-
- {if in 3D, must change colors}
- if (GridPen.Effect = ge3D) then
- Pen.Color := GridPen.SecondColor;
-
- {left line}
- if GridPen.Effect in [geVertical, geBoth, ge3D] then
- begin
- MoveTo(ActColOfs, ActRowOfs);
- LineTo(ActColOfs, ActRowBottom+1);
- end;
- {top line}
- if GridPen.Effect in [geHorizontal, geBoth, ge3D] then
- begin
- MoveTo(ActColOfs, ActRowOfs);
- LineTo(ActColRight+1, ActRowOfs);
- end;
- end;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbDrawCells(RowInxStart, RowInxEnd : integer;
- ColInxStart, ColInxEnd : integer);
- var
- RowInx : integer;
- begin
- {Delphi bug fix - refresh the canvas handle to force brush to be recreated}
- Canvas.Refresh;
- {draw cells that need it}
-
- if (RowInxStart < 0) or (RowInxEnd < 0) or
- (ColInxStart < 0) or (ColInxEnd < 0) then
- Exit;
-
- with tbRowNums^ do
- for RowInx := RowInxStart to RowInxEnd do
- tbDrawRow(RowInx, ColInxStart, ColInxEnd);
- end;
-{--------}
-procedure TOvcCustomTable.tbDrawInvalidCells(InvCells : TOvcCellArray);
- var
- RowInx : integer;
- ColInx : integer;
- EndColInx : integer;
- CellInx : integer;
- NextCellInx: integer;
- OldRowNum : TRowNum;
- CellAddr : TOvcCellAddress;
- NewCellAddr: TOvcCellAddress;
- EndCol : TColNum;
- ContinueTrying : boolean;
- begin
- if (InvCells.Count > 0) then
- begin
- {Delphi bug fix - refresh the canvas handle to force brush to be recreated}
- Canvas.Refresh;
- {set up for while loop}
- OldRowNum := -1;
- CellInx := 0;
- while (CellInx < InvCells.Count) do
- begin
- InvCells.GetCellAddr(CellInx, CellAddr);
- RowInx := tbFindRowInx(CellAddr.Row);
- if (RowInx <> -1) then
- begin
- ColInx := tbFindColInx(CellAddr.Col);
- if (ColInx <> -1) then
- begin
- {have we switched rows?}
- if (OldRowNum <> CellAddr.Row) then
- OldRowNum := CellAddr.Row;
- {try and get a block of columns}
- EndCol := CellAddr.Col;
- NextCellInx := succ(CellInx);
- ContinueTrying := true;
- while ContinueTrying do
- begin
- if (NextCellInx >= InvCells.Count) then
- ContinueTrying := false
- else
- begin
- InvCells.GetCellAddr(NextCellInx, NewCellAddr);
- if (OldRowNum = NewCellAddr.Row) and
- (NewCellAddr.Col = succ(EndCol)) then
- begin
- EndCol := NewCellAddr.Col;
- inc(NextCellInx);
- end
- else
- ContinueTrying := false;
- end
- end;
- if (EndCol <> CellAddr.Col) then
- begin
- EndColInx := tbFindColInx(EndCol);
- CellInx := pred(NextCellInx);
- {just in case (hidden cols perhaps?)}
- while (EndColInx = -1) do
- begin
- dec(EndCol);
- EndColInx := tbFindColInx(EndCol);
- end
- end
- else
- EndColInx := ColInx;
- tbDrawRow(RowInx, ColInx, EndColInx);
- end;
- end;
- inc(CellInx);
- end;
- end;
- if InvCells.MustDoUnusedBit then
- DoPaintUnusedArea;
- InvCells.Clear;
- end;
-{--------}
-procedure TOvcCustomTable.tbDrawMoveLine;
- var
- OldPen : TPen;
- MoveOffset : integer;
- begin
- if tbDrag <> nil then
- tbDrag.HideDragImage;
- if (otsMoving in tbState) then
- with Canvas do
- begin
- OldPen := TPen.Create;
- try
- OldPen.Assign(Pen);
- try
- Pen.Mode := pmXor;
- Pen.Style := psSolid;
- Pen.Color := clWhite;
- Pen.Width := 3;
- if (otsDoingCol in tbState) then
- begin
- if (tbMoveIndex < tbMoveIndexTo) then
- MoveOffset := tbColNums^.Ay[succ(tbMoveIndexTo)].Offset
- else
- MoveOffset := tbColNums^.Ay[tbMoveIndexTo].Offset;
- MoveTo(MoveOffset, 0);
- LineTo(MoveOffset, ClientHeight);
- end
- else {doing row}
- begin
- if (tbMoveIndex < tbMoveIndexTo) then
- MoveOffset := tbRowNums^.Ay[succ(tbMoveIndexTo)].Offset
- else
- MoveOffset := tbRowNums^.Ay[tbMoveIndexTo].Offset;
- MoveTo(0, MoveOffset);
- LineTo(ClientWidth, MoveOffset);
- end
- finally
- Canvas.Pen := OldPen;
- end;{try..finally}
- finally
- OldPen.Free;
- end;{try..finally}
- end;
- if tbDrag <> nil then
- tbDrag.ShowDragImage;
- end;
-{--------}
-procedure TOvcCustomTable.tbDrawRow(RowInx : integer; ColInxStart, ColInxEnd : integer);
- var
- RowOfs : integer;
- RowHt : integer;
- RowNum : TRowNum;
- ColInx : integer;
- ColNum : TColNum;
- ColOfs : integer;
- ColWd : integer;
- Cell : TOvcBaseTableCell;
- Data : pointer;
- GridPen : TOvcGridPen;
- BrushColor: TColor;
- CellAttr : TOvcCellAttributes;
- DestRect : TRect;
- RowIsLocked : boolean;
- ColIsLocked : boolean;
- IsActiveRow : boolean;
- begin
- {calculate data about the row, tell the user we're entering the row}
- with tbRowNums^ do
- begin
- RowNum := Ay[RowInx].Number;
- RowOfs := Ay[RowInx].Offset;
- RowHt := Ay[succ(RowInx)].Offset - RowOfs;
- end;
- IsActiveRow := ActiveRow = RowNum;
- RowIsLocked := RowNum < LockedRows;
- { Don't fire the OnEnteringRow when we are painting, unless }
- { OldRowColBehavior is true }
- if OldRowColBehavior then
- DoEnteringRow(RowNum);
-
- {set up the cell attribute record}
- FillChar(CellAttr, sizeof(CellAttr), 0);
- CellAttr.caFont := tbCellAttrFont;
-
- {for all required cells}
- for ColInx := ColInxEnd downto ColInxStart do
- begin
- {calculate data about the column, tell the user we're entering the column}
- with tbColNums^ do
- begin
- ColNum := Ay[ColInx].Number;
- ColOfs := Ay[ColInx].Offset;
- ColWd := Ay[succ(ColInx)].Offset - ColOfs;
- end;
- ColIsLocked := (ColNum < LockedCols);
- { Don't fire the OnEnteringCol when we are painting, unless }
- { OldRowColBehavior is true }
- if OldRowColBehavior then
- DoEnteringColumn(ColNum);
-
- {get the gridpen for the cell}
- if (RowIsLocked or ColIsLocked) then
- GridPen := GridPenSet.LockedGrid
- else
- GridPen := GridPenSet.NormalGrid;
-
- {calculate row height/column width available to the cell}
- DestRect := Rect(ColOfs, RowOfs, ColOfs+ColWd, RowOfs+RowHt);
- case GridPen.Effect of
- geVertical : dec(DestRect.Right);
- geHorizontal: dec(DestRect.Bottom);
- geBoth : begin
- dec(DestRect.Right);
- dec(DestRect.Bottom);
- end;
- ge3D : InflateRect(DestRect, -1, -1);
- end;{case}
-
- {don't do painting for the cell being edited}
- Cell := nil;
- if not (IsActiveRow and (ColNum = ActiveCol) and
- (InEditingState)) then
- begin
- {get the cell}
- Cell := tbFindCell(RowNum, ColNum);
- if Assigned(Cell) then begin
- {paint it}
- DoGetCellData(RowNum, ColNum, Data, cdpForPaint);
- CellAttr.caFont.Assign(Font);
- Cell.ResolveAttributes(RowNum, ColNum, CellAttr);
- Cell.Paint(Canvas, DestRect,
- RowNum, ColNum,
- CellAttr,
- Data);
- end;
- end;
-
- {if no cell found or it's the active cell in editing mode
- clear the rectangle}
- if not Assigned(Cell) or
- (IsActiveRow and (ColNum = ActiveCol) and InEditingState) then
- begin
- with CellAttr do
- begin
- caAccess := otxDefault;
- caAdjust := otaDefault;
- caColor := Color;
- caFont.Assign(Font);
- caFontColor := Font.Color;
- end;
- ResolveCellAttributes(RowNum, ColNum, CellAttr);
- Canvas.Brush.Color := CellAttr.caColor;
- Canvas.FillRect(DestRect);
- end;
-
- {Check to see if there is a grid to display}
- if (GridPen.Effect <> geNone) then
- with Canvas do
- begin
- {Get ready to draw the cell's grid}
- BrushColor := Color;
- Brush.Color := BrushColor;
- Pen.Style := GridPen.Style;
- Pen.Width := 1;
-
-{$IFNDEF LCL}
- Windows.SetBkColor(Handle, ColorToRGB(BrushColor));
-{$ELSE}
- LclIntf.SetBkColor(Handle, ColorToRGB(BrushColor));
-{$ENDIF}
-
- {draw the top and left lines, only if required of course}
- if (GridPen.Effect = ge3D) then
- begin
- {set the pen color for the top & left}
- Pen.Color := GridPen.SecondColor;
- {draw the lines}
- MoveTo(ColOfs, pred(RowOfs+RowHt));
- LineTo(ColOfs, RowOfs);
- LineTo(ColOfs+ColWd, RowOfs);
- end;
-
- {set the pen color for the bottom & right}
- Pen.Color := GridPen.NormalColor;
-
- {draw right line}
- if (GridPen.Effect <> geHorizontal) then
- begin
- MoveTo(ColOfs+ColWd-1, RowOfs);
- LineTo(ColOfs+ColWd-1, RowOfs+RowHt);
- end;
-
- {draw bottom line}
- if (GridPen.Effect <> geVertical) then
- begin
- MoveTo(ColOfs, pred(RowOfs+RowHt));
- LineTo(ColOfs+ColWd, pred(RowOfs+RowHt));
- end;
- end;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbDrawSizeLine;
- var
- OldPen : TPen;
- begin
- if (otsSizing in tbState) then
- with Canvas do
- begin
- OldPen := TPen.Create;
- try
- OldPen.Assign(Pen);
- Pen.Color := clBlack;
- Pen.Mode := pmXor;
- Pen.Style := psDot;
- Pen.Width := 1;
- if (otsDoingRow in tbState) then
- begin
- MoveTo(0, tbSizeOffset);
- LineTo(ClientWidth, tbSizeOffset);
- end
- else
- begin
- MoveTo(tbSizeOffset, 0);
- LineTo(tbSizeOffset, ClientHeight);
- end;
- finally
- Canvas.Pen := OldPen;
- OldPen.Free;
- end;{try..finally}
- end;
- end;
-{--------}
-procedure TOvcCustomTable.tbDrawUnusedBit;
- var
- R : TRect;
- CR : TRect;
- ChangedBrush : boolean;
- begin
- ChangedBrush := false;
-{$IFNDEF LCL}
- Windows.GetClientRect(Handle, CR);
-{$ELSE}
- LclIntf.GetClientRect(Handle, CR);
-{$ENDIF}
- with R, tbColNums^ do
- begin
- Left := Ay[Count].Offset;
- Right := CR.Right;
- Top := 0;
- Bottom := CR.Bottom;
- end;
- if (R.Left < R.Right) then
- with Canvas do
- begin
- Brush.Color := ColorUnused;
- FillRect(R);
- ChangedBrush := true;
- end;
-
- with R, tbRowNums^ do
- begin
- Right := Left;
- Left := 0;
- Top := Ay[Count].Offset;
- end;
- if (R.Top < R.Bottom) then
- with Canvas do
- begin
- if not ChangedBrush then
- Brush.Color := ColorUnused;
- FillRect(R);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.Paint;
- var
- UR, GR : TRect;
- WhatToPaint : integer;
- RowInx : integer;
- ColInx : integer;
- begin
- {don't do anything if the table is locked from drawing and
- there is no scrolling going on (tbMustUpdate is *only* set in
- the tbScrollTableXxx methods to force an update).}
- if (tbLockCount > 0) and (not tbMustUpdate) then
- begin
- Exit;
- end;
-
- if tbDrag <> nil then
- tbDrag.HideDragImage;
-
-{$IFNDEF LCL}
- Windows.GetClipBox(Canvas.Handle, UR);
-{$ELSE}
- LclIntf.GetClipBox(Canvas.Handle, @UR);
-{$ENDIF}
- WhatToPaint := tbCalcCellsFromRect(UR, GR);
-
- if (WhatToPaint = 0) and
- (otsEditing in tbState) and
- ((GR.Top = ActiveRow) and (GR.Bottom = ActiveRow) and
- (GR.Left = ActiveCol) and (GR.Right = ActiveCol)) then
- Exit;
-
- {if we are actually processing a WM_PAINT message, then paint the
- invalid cells, etc}
- if (tbLockCount = 0) then
- begin
- if (WhatToPaint <> 2) then
- tbDrawCells(GR.Top, GR.Bottom, GR.Left, GR.Right);
-
- if (WhatToPaint <> 0) then
- DoPaintUnusedArea;
-
- tbDrawActiveCell;
- end
- {otherwise we are in the middle of a scroll operation, so just invalidate
- the cells that need it}
- else {tbLockCount > 0, ie tbMustUpdate is true}
- begin
- if (WhatToPaint <> 2) then
- for RowInx := GR.Top to GR.Bottom do
- for ColInx := GR.Left to GR.Right do
- InvalidateCell(tbRowNums^.Ay[RowInx].Number, tbColNums^.Ay[ColInx].Number);
- if (WhatToPaint <> 0) then
- tbInvCells.AddUnusedBit;
- tbMustUpdate := false;
- end;
-
- if tbDrag <> nil then
- tbDrag.ShowDragImage;
-
- end;
-{====================================================================}
-
-
-{==TOvcTable event handlers==========================================}
-procedure TOvcCustomTable.DoActiveCellChanged(RowNum : TRowNum; ColNum : TColNum);
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FActiveCellChanged) then
- FActiveCellChanged(Self, RowNum, ColNum);
- end;
-{--------}
-procedure TOvcCustomTable.DoActiveCellMoving(Command : word;
- var RowNum : TRowNum;
- var ColNum : TColNum);
- begin
- if ((ComponentState * [csLoading, csDestroying]) <> []) then
- Exit;
- if Assigned(FActiveCellMoving) then
- FActiveCellMoving(Self, Command, RowNum, ColNum);
- if InEditingState and ((RowNum <> ActiveRow) or (ColNum <> ActiveCol)) then
- if not StopEditingState(true) then
- begin
- RowNum := ActiveRow;
- ColNum := ActiveCol;
- Exit;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.DoBeginEdit(RowNum : TRowNum; ColNum : TColNum;
- var AllowIt : boolean);
- begin
- if ((ComponentState * [csLoading, csDestroying]) <> []) then
- AllowIt := false
- else
- begin
- AllowIt := true;
- if Assigned(FBeginEdit) then
- FBeginEdit(Self, RowNum, ColNum, AllowIt);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.DoClipboardCopy;
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FClipboardCopy) then
- FClipboardCopy(Self);
- end;
-{--------}
-procedure TOvcCustomTable.DoClipboardCut;
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FClipboardCut) then
- FClipboardCut(Self);
- end;
-{--------}
-procedure TOvcCustomTable.DoClipboardPaste;
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FClipboardPaste) then
- FClipboardPaste(Self);
- end;
-{--------}
-procedure TOvcCustomTable.DoColumnsChanged(ColNum1, ColNum2 : TColNum;
- Action : TOvcTblActions);
- var
- i : integer;
- begin
- for i := 0 to pred(taCellList.Count) do
- if (TOvcTableCellAncestor(taCellList[i]) is TOvcTCColHead) then
- TOvcTCColHead(taCellList[i]).chColumnsChanged(ColNum1, ColNum2, Action);
-
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FColumnsChanged) then
- FColumnsChanged(Self, ColNum1, ColNum2, Action);
- end;
-{--------}
-procedure TOvcCustomTable.DoDoneEdit(RowNum : TRowNum; ColNum : TColNum);
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FDoneEdit) then
- FDoneEdit(Self, RowNum, ColNum);
- end;
-{--------}
-procedure TOvcCustomTable.DoEndEdit(Cell : TOvcBaseTableCell;
- RowNum : TRowNum; ColNum : TColNum;
- var AllowIt : boolean);
- begin
- if ((ComponentState * [csLoading, csDestroying]) <> []) then
- AllowIt := false
- else
- begin
- AllowIt := true;
- if Assigned(FEndEdit) then
- FEndEdit(Self, Cell, RowNum, ColNum, AllowIt);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.DoEnteringColumn(ColNum : TColNum);
- begin
- if (ColNum <> tbLastEntCol) then
- begin
- tbLastEntCol := ColNum;
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FEnteringColumn) then
- FEnteringColumn(Self, ColNum);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.DoEnteringRow(RowNum : TRowNum);
- begin
- if (RowNum <> tbLastEntRow) then
- begin
- tbLastEntRow := RowNum;
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FEnteringRow) then
- FEnteringRow(Self, RowNum);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.DoGetCellAttributes(RowNum : TRowNum; ColNum : TColNum;
- var CellAttr : TOvcCellAttributes);
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FGetCellAttributes) then
- FGetCellAttributes(Self, RowNum, ColNum, CellAttr);
- end;
-{--------}
-procedure TOvcCustomTable.DoGetCellData(RowNum : TRowNum; ColNum : TColNum;
- var Data : pointer;
- Purpose : TOvcCellDataPurpose);
- begin
- Data := nil;
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- HandleAllocated and
- Assigned(FGetCellData) then
- FGetCellData(Self, RowNum, ColNum, Data, Purpose);
- end;
-{--------}
-procedure TOvcCustomTable.DoLeavingColumn(ColNum : TColNum);
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FLeavingColumn) then
- FLeavingColumn(Self, ColNum);
- end;
-{--------}
-procedure TOvcCustomTable.DoLeavingRow(RowNum : TRowNum);
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FLeavingRow) then
- FLeavingRow(Self, RowNum);
- end;
-{--------}
-procedure TOvcCustomTable.DoLockedCellClick(RowNum : TRowNum; ColNum : TColNum);
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FLockedCellClick) then
- FLockedCellClick(Self, RowNum, ColNum);
- end;
-{--------}
-
-procedure TOvcCustomTable.DoOnMouseWheel(Shift : TShiftState; Delta, XPos, YPos : SmallInt);
-begin
- inherited DoOnMouseWheel(Shift, Delta, XPos, YPos);
-
- if (ssCtrl in Shift) then begin
- if (Delta > 0) then
- tbMoveActCellPageUp
- else
- tbMoveActCellPageDown;
- end else begin
- if Delta < 0 then
- MoveActiveCell(ccDown)
- else
- MoveActiveCell(ccUp);
- end;
-end;
-
-procedure TOvcCustomTable.DoPaintUnusedArea;
- begin
- if ((ComponentState * [csLoading, csDestroying]) <> []) then
- Exit;
- if Assigned(FPaintUnusedArea) then
- FPaintUnusedArea(Self)
- else
- tbDrawUnusedBit;
- end;
-{--------}
-procedure TOvcCustomTable.DoRowsChanged(RowNum1, RowNum2 : TRowNum;
- Action : TOvcTblActions);
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FRowsChanged) then
- FRowsChanged(Self, RowNum1, RowNum2, Action);
- end;
-{--------}
-procedure TOvcCustomTable.DoSizeCellEditor(RowNum : TRowNum;
- ColNum : TColNum;
- var CellRect : TRect;
- var CellStyle: TOvcTblEditorStyle);
- begin
- if Assigned(FSizeCellEditor) then
- FSizeCellEditor(Self, RowNum, ColNum, CellRect, CellStyle);
- end;
-{--------}
-procedure TOvcCustomTable.DoTopLeftCellChanged(RowNum : TRowNum; ColNum : TColNum);
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FTopLeftCellChanged) then
- FTopLeftCellChanged(Self, RowNum, ColNum);
- end;
-{--------}
-procedure TOvcCustomTable.DoTopLeftCellChanging(var RowNum : TRowNum;
- var ColNum : TColNum);
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FTopLeftCellChanging) then
- FTopLeftCellChanging(Self, RowNum, ColNum);
- end;
-{--------}
-procedure TOvcCustomTable.DoUserCommand(Cmd : word);
- begin
- if ((ComponentState * [csLoading, csDestroying]) = []) and
- Assigned(FUserCommand) then
- FUserCommand(Self, Cmd);
- end;
-{====================================================================}
-
-
-{==TOvcTable Windows Message handlers================================}
-procedure TOvcCustomTable.CMColorChanged(var Msg : TMessage);
- begin
- inherited;
- AllowRedraw := false;
- tbNotifyCellsOfTableChange;
- AllowRedraw := true;
- end;
-{--------}
-{$IFNDEF LCL}
-procedure TOvcCustomTable.CMCtl3DChanged(var Msg : TMessage);
- begin
- if (csLoading in ComponentState) or not HandleAllocated then
- Exit;
-
- if NewStyleControls and (FBorderStyle = bsSingle) then
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
-
- inherited;
- end;
-{$ENDIF}
-{--------}
-procedure TOvcCustomTable.CMDesignHitTest(var Msg : TCMDesignHitTest);
- var
- IsVert : boolean;
- IsColMove : boolean;
- OnGridLine : boolean;
- begin
- Msg.Result := 1;
- if (otsDesigning in tbState) then
- begin
- if ((tbState * [otsSizing, otsMoving]) <> []) then
- Exit;
- Msg.Result := 0;
- OnGridLine := tbIsOnGridLine(Msg.Pos.X, Msg.Pos.Y, IsVert);
- if OnGridLine then
- Msg.Result := 1
- else
- Msg.Result := longint(tbIsInMoveArea(Msg.Pos.X, Msg.Pos.Y, IsColMove));
- end;
- end;
-{--------}
-procedure TOvcCustomTable.CMFontChanged(var Msg : TMessage);
- begin
- inherited;
- AllowRedraw := false;
- tbNotifyCellsOfTableChange;
- AllowRedraw := true;
- end;
-{--------}
-procedure TOvcCustomTable.ctimQueryOptions(var Msg : TMessage);
- begin
-{$IFNDEF LCL}
- Msg.Result := longint(word(FOptions));
-{$ELSE}
-// Msg.Result := longint(FOptions); //this used to compile - not sure what changed in Laz 1.6
- Msg.Result := longint(word(FOptions));
-{$ENDIF}
- end;
-{--------}
-procedure TOvcCustomTable.ctimQueryColor(var Msg : TMessage);
- begin
- Msg.Result := longint(Color);
- end;
-{--------}
-procedure TOvcCustomTable.ctimQueryFont(var Msg : TMessage);
- begin
- Msg.Result := LRESULT(Font); //64
- end;
-{--------}
-procedure TOvcCustomTable.ctimQueryLockedCols(var Msg : TMessage);
- begin
- Msg.Result := longint(LockedCols);
- end;
-{--------}
-procedure TOvcCustomTable.ctimQueryLockedRows(var Msg : TMessage);
- begin
- Msg.Result := longint(LockedRows);
- end;
-{--------}
-procedure TOvcCustomTable.ctimQueryActiveCol(var Msg : TMessage);
- begin
- Msg.Result := longint(ActiveCol);
- end;
-{--------}
-procedure TOvcCustomTable.ctimQueryActiveRow(var Msg : TMessage);
- begin
- Msg.Result := longint(ActiveRow);
- end;
-{--------}
-procedure TOvcCustomTable.ctimRemoveCell(var Msg : TMessage);
- begin
- Notification(TComponent(Msg.LParam), opRemove);
- Msg.Result := 0;
- end;
-{--------}
-procedure TOvcCustomTable.ctimStartEdit(var Msg : TMessage);
- begin
- if not StartEditingState then
- begin
- AllowRedraw := false;
- InvalidateCell(ActiveRow, ActiveCol);
- AllowRedraw := true;
- end;
- Msg.Result := 1;
- end;
-{--------}
-procedure TOvcCustomTable.ctimStartEditMouse(var Msg : TWMMouse);
- begin
- if Assigned(tbActCell) and InEditingState then
- if tbActCell.AcceptActivationClick then
- begin
-{$IFNDEF LCL}
- Windows.SetFocus(tbActCell.EditHandle);
-{$ELSE}
- LclIntf.SetFocus(tbActCell.EditHandle);
-{$ENDIF}
- PostMessage(tbActCell.EditHandle,
- WM_LBUTTONDOWN,
- Msg.Keys, longint(Msg.Pos))
- end;
- Msg.Result := 1;
- end;
-{--------}
-procedure TOvcCustomTable.ctimStartEditKey(var Msg : TWMKey);
- begin
- if Assigned(tbActCell) and InEditingState then
- begin
-{$IFNDEF LCL}
- Windows.SetFocus(tbActCell.EditHandle);
-{$ELSE}
- LclIntf.SetFocus(tbActCell.EditHandle);
-{$ENDIF}
- PostMessage(tbActCell.EditHandle, WM_KEYDOWN, Msg.CharCode, Msg.KeyData);
- end;
- Msg.Result := 1;
- end;
-{--------}
-procedure TOvcCustomTable.ctimLoadDefaultCells(var Msg : TMessage);
- begin
- AllowRedraw := false;
- tbFinishLoadingCellList;
- tbFinishLoadingDefaultCells;
- Msg.Result := 0;
- tbMustFinishLoading := false;
- AllowRedraw := true;
- end;
-{--------}
-procedure TOvcCustomTable.WMCancelMode(var Msg : TMessage);
- begin
- inherited;
- tbIsKeySelecting := false;
- if (otsMouseSelect in tbState) then
- tbState := tbState - [otsMouseSelect] + [otsNormal];
- end;
-{--------}
-procedure TOvcCustomTable.WMEraseBkGnd(var Msg : TWMEraseBkGnd);
- begin
- Msg.Result := 1; {no erasing of the background, we'll do it all}
- end;
-{--------}
-procedure TOvcCustomTable.WMGetDlgCode(var Msg : TMessage);
- begin
- Msg.Result := DLGC_WANTCHARS or DLGC_WANTARROWS;
- if (otoTabToArrow in Options) then
- Msg.Result := Msg.Result or DLGC_WANTTAB;
- end;
-{--------}
-procedure TOvcCustomTable.WMHScroll(var Msg : TWMScroll);
- {------}
- procedure ProcessThumb;
- var
- i : integer;
- NewLeftCol : TColNum;
- begin
- NewLeftCol := LockedCols;
- for i := 0 to pred(Msg.Pos) do
- NewLeftCol := IncCol(NewLeftCol, 1);
- if (NewLeftCol <> LeftCol) then
- LeftCol := NewLeftCol;
- end;
- {------}
- begin
- {ignore SB_ENDSCROLL and SB_THUMBTRACK messages (the latter
- if required to by the Options property): this'll possibly
- avoid multiple validations}
- if (Msg.ScrollCode = SB_ENDSCROLL) or
- ((Msg.ScrollCode = SB_THUMBTRACK) and
- (not (otoThumbTrack in Options))) then
- begin
- inherited;
- Exit;
- end;
- {if not focused then do so; if being designed update the
- table view}
- if (otsUnfocused in tbState) then
-{$IFDEF MSWINDOWS} //Apparently can't focus scroll bar with GTK?
- SetFocus
-{$ENDIF}
- else if (otsDesigning in tbState) then
- Update;
- {check to see whether the cell being edited is valid;
- no scrolling allowed if it isn't (tough).}
- if InEditingState then
- begin
- if not tbActCell.CanSaveEditedData(true) then
- Exit;
- end;
- {process the scrollbar message}
- case Msg.ScrollCode of
- SB_LINELEFT : ProcessScrollBarClick(otsbHorizontal, scLineUp);
- SB_LINERIGHT : ProcessScrollBarClick(otsbHorizontal, scLineDown);
- SB_PAGELEFT : ProcessScrollBarClick(otsbHorizontal, scPageUp);
- SB_PAGERIGHT : ProcessScrollBarClick(otsbHorizontal, scPageDown);
- SB_THUMBPOSITION : ProcessThumb;
- SB_THUMBTRACK : if (otoThumbTrack in Options) then ProcessThumb;
- else
- inherited;
- Exit;
- end;
- Msg.Result := 0;
- end;
-{--------}
-procedure TOvcCustomTable.WMKeyDown(var Msg : TWMKey);
- var
- Cmd : word;
- ShiftFlags : byte;
- begin
- inherited;
-
- {If Tab key is being converted to arrow key, do it}
- if (otoTabToArrow in Options) and (Msg.CharCode = VK_TAB) then
- begin
- {get shift value}
- ShiftFlags := GetShiftFlags;
- {convert Tab combination to command}
- if (ShiftFlags = 0) then
- Cmd := ccRight
- else if (ShiftFlags = ss_Shift) then
- Cmd := ccLeft
- else
- Cmd := ccNone;
- end
- {If Enter key is being converted to right arrow, do it.}
- else if (otoEnterToArrow in Options) and (Msg.CharCode = VK_RETURN) then
- begin
- {get shift value}
- ShiftFlags := GetShiftFlags;
- {convert Enter combination to command}
- if (ShiftFlags = 0) then
- Cmd := ccRight
- else
- Cmd := ccNone;
- end
- {Otherwise just translate into a command}
- else
- Cmd := Controller.EntryCommands.TranslateUsing([tbCmdTable^], TMessage(Msg));
-
- if InEditingState then
- begin
- if (not (otoAlwaysEditing in Options)) and
- ((Cmd = ccTableEdit) or (Msg.CharCode = VK_ESCAPE)) then
- begin
- if not StopEditingState(Msg.CharCode <> VK_ESCAPE) then
- begin
- inherited;
- Exit;
- end;
- end
- end
- else {not editing}
- if (Cmd = ccTableEdit) or
- ((Cmd > ccLastCmd) and (Cmd < ccUserFirst) and
- ((Msg.CharCode = VK_SPACE) or
- ((VK_0 <= Msg.CharCode) and (Msg.CharCode <= VK_DIVIDE)) or
- (Msg.CharCode >= $BA))) then
- begin
- PostMessage(Handle, ctim_StartEdit, 0, 0);
- if (Cmd <> ccTableEdit) then
- PostMessage(Handle, ctim_StartEditKey, Msg.CharCode, Msg.KeyData);
- end;
-
- tbIsKeySelecting := false;
- case Cmd of
- ccBotOfPage, ccBotRightCell,
- ccDown, ccEnd,
- ccFirstPage, ccHome,
- ccLastPage, ccLeft,
- ccNextPage, ccPageLeft,
- ccPageRight, ccPrevPage,
- ccRight, ccTopLeftCell,
- ccTopOfPage, ccUp : MoveActiveCell(Cmd);
- ccExtendDown : begin tbIsKeySelecting := true; MoveActiveCell(ccDown); end;
- ccExtendEnd : begin tbIsKeySelecting := true; MoveActiveCell(ccEnd); end;
- ccExtendHome : begin tbIsKeySelecting := true; MoveActiveCell(ccHome); end;
- ccExtendLeft : begin tbIsKeySelecting := true; MoveActiveCell(ccLeft); end;
- ccExtendPgDn : begin tbIsKeySelecting := true; MoveActiveCell(ccNextPage); end;
- ccExtendPgUp : begin tbIsKeySelecting := true; MoveActiveCell(ccPrevPage); end;
- ccExtendRight : begin tbIsKeySelecting := true; MoveActiveCell(ccRight); end;
- ccExtendUp : begin tbIsKeySelecting := true; MoveActiveCell(ccUp); end;
- ccExtBotOfPage : begin tbIsKeySelecting := true; MoveActiveCell(ccBotOfPage); end;
- ccExtFirstPage : begin tbIsKeySelecting := true; MoveActiveCell(ccFirstPage); end;
- ccExtLastPage : begin tbIsKeySelecting := true; MoveActiveCell(ccLastPage); end;
- ccExtTopOfPage : begin tbIsKeySelecting := true; MoveActiveCell(ccTopOfPage); end;
- ccExtWordLeft : begin tbIsKeySelecting := true; MoveActiveCell(ccWordLeft); end;
- ccExtWordRight : begin tbIsKeySelecting := true; MoveActiveCell(ccWordRight); end;
- ccCopy : DoClipboardCopy;
- ccCut : DoClipboardCut;
- ccPaste : DoClipboardPaste;
- else
- if (Cmd >= ccUserFirst) then
- DoUserCommand(Cmd);
- end;
- end;
-{--------}
-procedure TOvcCustomTable.WMKillFocus(var Msg : TWMKillFocus);
- begin
- inherited;
-
- if (otsEditing in tbState) then
- begin
- Exit;
- end;
-
- AllowRedraw := false;
- try
- InvalidateCell(ActiveRow, ActiveCol);
- tbState := tbState - [otsFocused] + [otsUnfocused];
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-procedure TOvcCustomTable.WMLButtonDblClk(var Msg : TWMMouse);
- var
- Row : TRowNum;
- Col : TColNum;
- Region : TOvcTblRegion;
- begin
- inherited;
- if not (otsDesigning in tbState) then
- begin
- Region := CalcRowColFromXY(Msg.XPos, Msg.YPos, Row, Col);
- if Region = (otrInMain) then
- begin
- PostMessage(Handle, ctim_StartEdit, Msg.Keys, longint(Msg.Pos));
- PostMessage(Handle, ctim_StartEditMouse, Msg.Keys, longint(Msg.Pos));
- end;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.WMLButtonDown(var Msg : TWMMouse);
- var
- Row : TRowNum;
- Col : TColNum;
- Action : TOvcTblSelectionType;
- Region : TOvcTblRegion;
- R : TRect;
- P : TPoint;
- ShiftKeyDown : boolean;
- CtrlKeyDown : boolean;
- AllowDrag : boolean;
- WasUnfocused : boolean;
- begin
- inherited;
-
- {are we currently unfocused? if so focus the table}
- WasUnfocused := false;
- if (otsUnfocused in tbState) then
- begin
- WasUnfocused := true;
- AllowRedraw := false;
- try
- {note: by the time SetFocus returns WMSetFocus will have been called}
- SetFocus;
- {..to get round an MDI bug..}
- if not Focused then
-{$IFNDEF LCL}
- Windows.SetFocus(Handle);
-{$ELSE}
- LclIntf.SetFocus(Handle);
-{$ENDIF}
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-
- {are we currently showing a sizing cursor? if so the user wants to
- resize a column/row}
- if (otsShowSize in tbState) then
- begin
- tbState := tbState - [otsShowSize] + [otsSizing];
- if (otsDoingRow in tbState) then
- begin
- if (Msg.YPos >= tbRowNums^.Ay[tbSizeIndex].Offset+6) then
- tbSizeOffset := Msg.YPos;
- tbDrawSizeLine;
- end
- else {we're sizing a column}
- begin
- if (Msg.XPos >= tbColNums^.Ay[tbSizeIndex].Offset+6) then
- tbSizeOffset := Msg.XPos;
- tbDrawSizeLine;
- end;
- Exit;
- end;
-
- {are we currently showing a row/col move cursor? if so the user wants
- to move that row/col}
- if (otsShowMove in tbState) then
- begin
- tbState := tbState - [otsShowMove] + [otsMoving];
- {work out the row/column we're in}
- CalcRowColFromXY(Msg.XPos, Msg.YPos, Row, Col);
- if (otsDoingCol in tbState) then begin
- tbMoveIndex := tbFindColInx(Col);
- R.Left := ColOffset[Col];
- R.Right := MinI(ClientWidth, R.Left + Columns[Col].Width);
- R.Top := RowOffset[0];
- R.Bottom := RowOffset[1];
- end else begin{doing row}
- tbMoveIndex := tbFindRowInx(Row);
- R.Top := RowOffset[Row];
- R.Bottom := RowOffset[Row + 1];
- R.Bottom := MinI(ClientHeight, R.Top + Rows[Row].Height);
- R.Left := ColOffset[0];
- R.Right := ColOffset[1];
- end;
-
- R.TopLeft := ClientToScreen(R.TopLeft);
- R.BottomRight := ClientToScreen(R.BottomRight);
-
- P := ClientToScreen(Point(Msg.XPos, Msg.YPos));
-
- tbDrag := TOvcDragShow.Create(P.x, P.y, R, clBtnFace);
-
- tbMoveIndexTo := tbMoveIndex;
- tbDrawMoveLine;
- Exit;
- end;
-
- {are we focused and do we allow selections? if so be prepared to start or
- extend the current selection (note that AlwaysEditing will be false)}
- if (otsFocused in tbState) and (not (otoNoSelection in Options)) then
- begin
- {if we are editing a cell then stop editing it now (if possible)}
- if InEditingState then
- begin
-{$IFNDEF LCL}
- Windows.SetFocus(tbActCell.EditHandle);
-{$ELSE}
- LclIntf.SetFocus(tbActCell.EditHandle);
-{$ENDIF}
- end;
- {get the state of the shift & ctrl keys}
- ShiftKeyDown := (Msg.Keys and MK_SHIFT) <> 0;
- CtrlKeyDown := (Msg.Keys and MK_CONTROL) <> 0;
- {calculate where the mouse button was pressed}
- Region := CalcRowColFromXY(Msg.XPos, Msg.YPos, Row, Col);
- case Region of
- otrInMain :
- {the mouse was clicked in the main area}
- begin
- AllowRedraw := false;
- try
- AllowDrag := true;
- {confirm the new active cell}
- DoActiveCellMoving(ccMouse, Row, Col);
- {if neither shift nor control are down, or control is
- down on its own, we have to reset the anchor point}
- if (not ShiftKeyDown) then
- begin
- if CtrlKeyDown then
- Action := tstAdditional
- else
- begin
- Action := tstDeselectAll;
- {if the active cell hasn't changed (ie the user
- clicked on the active cell, must start editing}
- if (ActiveRow = Row) and (ActiveCol = Col) and
- not WasUnfocused then
- begin
- PostMessage(Handle, ctim_StartEdit, 0, 0);
- PostMessage(Handle, ctim_StartEditMouse,
- Msg.Keys, longint(Msg.Pos));
- AllowDrag := false;
- end;
- end;
- tbSetAnchorCell(Row, Col, Action);
- end
- {if the shift key is down then the user is either extending
- the last selection only (control is up) or the last
- selection in addition to the other selections (control is
- down); extend the selection}
- else {shift key is down}
- begin
- if CtrlKeyDown then
- Action := tstAdditional
- else
- begin
- Action := tstDeselectAll;
- tbIsSelecting := true;
- end;
- tbUpdateSelection(Row, Col, Action);
- end;
- {now set the active cell}
- tbSetActiveCellPrim(Row, Col);
- finally
- AllowRedraw := true;
- end;{try..finally}
- {until we get a mouse up message we are selecting with
- the mouse (if we're allowed to, that is)}
- if (otoMouseDragSelect in Options) and AllowDrag then
- tbState := tbState - [otsNormal] + [otsMouseSelect];
- end;
- otrInLocked :
- begin
- {the mouse was clicked on a locked cell}
- if InEditingState then
- if not StopEditingState(true) then
- Exit;
- AllowRedraw := false;
- try
- if (otoRowSelection in Options) and (Row >= LockedRows) then
- tbSelectRow(Row);
- if (otoColSelection in Options) and (Col >= LockedCols) then
- tbSelectCol(Col);
- if (otoRowSelection in Options) and (otoColSelection in Options) and
- (Row < LockedRows) and (Col < LockedCols) then
- tbSelectTable;
- finally
- AllowRedraw := true;
- end;{try..finally}
- if (otsNormal in tbState) then
- DoLockedCellClick(Row, Col);
- end;
- otrInUnused :
- begin
- {clicking in the unused area deselects all selections}
- if InEditingState then
- if not StopEditingState(true) then
- Exit;
-
- {move to new location}
- if (Row = CRCFXY_RowBelow) then
- Row := IncRow(pred(RowLimit), 0);
- if (Col = CRCFXY_ColToRight) then
- Col := IncCol(pred(ColCount), 0);
-
- {if row or col should changed, notify and doit}
- if (Col <> ActiveCol) or (Row <> ActiveRow) then begin
- DoActiveCellMoving(ccNone, Row, Col);
- tbSetAnchorCell(Row, Col, tstDeselectAll);
- tbSetActiveCellPrim(Row, Col);
- end;
- end;
- end;{case}
- Exit;
- end;
-
- {are we focused? (and selections are not allowed)}
- if (otsFocused in tbState) then
- if ((tbState * [otsNormal, otsEditing, otsHiddenEdit]) <> []) then
- begin
- Region := CalcRowColFromXY(Msg.XPos, Msg.YPos, Row, Col);
- case Region of
- otrInMain :
- begin
- if InEditingState then
-{$IFNDEF LCL}
- Windows.SetFocus(tbActCell.EditHandle);
-{$ELSE}
- LclIntf.SetFocus(tbActCell.EditHandle);
-{$ENDIF}
- AllowRedraw := false;
- try
- DoActiveCellMoving(ccMouse, Row, Col);
- if not (otoAlwaysEditing in Options) then
- if (ActiveRow = Row) and (ActiveCol = Col) and
- not WasUnfocused then
- begin
- PostMessage(Handle, ctim_StartEdit, 0, 0);
- PostMessage(Handle, ctim_StartEditMouse,
- Msg.Keys, longint(Msg.Pos));
- end;
- tbSetActiveCellPrim(Row, Col);
- finally
- AllowRedraw := true;
- end;{try..finally}
- PostMessage(Handle, ctim_StartEditMouse,
- Msg.Keys, longint(Msg.Pos));
- end;
- otrInLocked :
- if (otsNormal in tbState) then
- DoLockedCellClick(Row, Col);
- end;{case}
- Exit;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.WMLButtonUp(var Msg : TWMMouse);
- var
- Form : TForm;
- ColNum : TColNum;
- ColFrom : TColNum;
- ColTo : TColNum;
- RowNum : TRowNum;
- RowFrom : TRowNum;
- RowTo : TRowNum;
- DoingCol: boolean;
- begin
- inherited;
-
- if tbDrag <> nil then begin
- tbDrag.Free;
- tbDrag := nil;
- end;
-
- if (otsMouseSelect in tbState) then
- begin
- {tbIsSelecting := false;}
- tbState := tbState - [otsMouseSelect] + [otsNormal];
- Exit;
- end;
-
- if (otsSizing in tbState) then
- begin
- tbDrawSizeLine;
- AllowRedraw := false;
- try
- if (otsDoingRow in tbState) then
- begin
- if (tbSizeOffset < tbRowNums^.Ay[tbSizeIndex].Offset+6) then
- tbSizeOffset := tbRowNums^.Ay[tbSizeIndex].Offset+6;
- FRows.Height[tbRowNums^.Ay[tbSizeIndex].Number] :=
- tbSizeOffset - tbRowNums^.Ay[tbSizeIndex].Offset;
- if Assigned(OnResizeRow) then
- OnResizeRow(Self, tbRowNums^.Ay[tbSizeIndex].Number,
- FRows.Height[tbRowNums^.Ay[tbSizeIndex].Number]);
- end
- else
- begin
- if (tbSizeOffset < tbColNums^.Ay[tbSizeIndex].Offset+6) then
- tbSizeOffset := tbColNums^.Ay[tbSizeIndex].Offset+6;
- FCols[tbColNums^.Ay[tbSizeIndex].Number].Width :=
- tbSizeOffset - tbColNums^.Ay[tbSizeIndex].Offset;
- if Assigned(OnResizeColumn) then
- OnResizeColumn(Self, tbColNums^.Ay[tbSizeIndex].Number,
- FCols[tbColNums^.Ay[tbSizeIndex].Number].Width);
- end;
-// Apparent TurboPower bug: otsDoingRow appears twice in set. Probably second
-// otsDoingRow should be otsDoingCol (see otsMoving code below).
-// tbState := tbState - [otsSizing, otsDoingRow, otsDoingRow] + [otsNormal];
- tbState := tbState - [otsSizing, otsDoingRow, otsDoingCol] + [otsNormal]; //Fixed
- if (otsDesigning in tbState) then
- begin
- Form := TForm(GetParentForm(Self));
- if (Form <> nil) and (Form.Designer <> nil) then
- Form.Designer.Modified;
- end;
- InvalidateTable;
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-
- if (otsMoving in tbState) then
- begin
- tbDrawMoveLine;
- DoingCol := otsDoingCol in tbState;
- tbState := tbState - [otsMoving, otsDoingRow, otsDoingCol] + [otsNormal];
- if (tbMoveIndex <> tbMoveIndexTo) then
- begin
- AllowRedraw := false;
- try
- if DoingCol then
- begin
- ColFrom := tbColNums^.Ay[tbMoveIndex].Number;
- ColTo := tbColNums^.Ay[tbMoveIndexTo].Number;
- if (ColTo > ColFrom) then
- for ColNum := ColFrom to pred(ColTo) do
- Columns.Exchange(ColNum, succ(ColNum))
- else
- for ColNum := pred(ColFrom) downto ColTo do
- Columns.Exchange(ColNum, succ(ColNum));
- if ActiveCol = ColFrom then
- ActiveCol := ColTo
- else if (ColTo > ColFrom) then begin
- if (ColFrom < ActiveCol) and (ActiveCol <= ColTo) then
- ActiveCol := IncCol(ActiveCol, -1);
- end
- else begin
- if (ColTo <= ActiveCol) and (ActiveCol < ColFrom) then
- ActiveCol := IncCol(ActiveCol, +1);
- end;
- end
- else {doing rows}
- begin
- RowFrom := tbRowNums^.Ay[tbMoveIndex].Number;
- RowTo := tbRowNums^.Ay[tbMoveIndexTo].Number;
- if (RowTo > RowFrom) then
- for RowNum := RowFrom to pred(RowTo) do
- Rows.Exchange(RowNum, succ(RowNum))
- else
- for RowNum := pred(RowFrom) downto RowTo do
- Rows.Exchange(RowNum, succ(RowNum));
- if ActiveRow = RowFrom then
- ActiveRow := RowTo
- else if (RowTo > RowFrom) then begin
- if (RowFrom < ActiveRow) and (ActiveRow <= RowTo) then
- ActiveRow := IncRow(ActiveRow, -1);
- end
- else begin
- if (RowTo <= ActiveRow) and (ActiveRow < RowFrom) then
- ActiveRow := IncRow(ActiveRow, +1);
- end;
- end;
- finally
- AllowRedraw := true;
- end;{try..finally}
- if (otsDesigning in tbState) then
- begin
- Form := TForm(GetParentForm(Self));
- if (Form <> nil) and (Form.Designer <> nil) then
- Form.Designer.Modified;
- end;
- end;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.WMMouseMove(var Msg : TWMMouse);
- var
- Row : TRowNum;
- Col : TColNum;
- NewMoveIndexTo : integer;
- Region : TOvcTblRegion;
- Action : TOvcTblSelectionType;
- P : TPoint;
- begin
- inherited;
-
- if tbDrag <> nil then begin
- P := ClientToScreen(Point(Msg.XPos, Msg.YPos));
- tbDrag.DragMove(P.x, P.y);
- end;
-
- if (otsMouseSelect in tbState) then
- begin
- Region := CalcRowColFromXY(Msg.XPos, Msg.YPos, Row, Col);
- if (Region = otrOutside) or (Region = otrInUnused) then
- begin
- if (Row = CRCFXY_RowAbove) then
- Row := IncRow(ActiveRow, -1)
- else if (Row = CRCFXY_RowBelow) then
- with tbRowNums^ do
- Row := MinL(pred(RowLimit), succ(Ay[pred(Count)].Number));
- if (Col = CRCFXY_ColToLeft) then
- Col := IncCol(ActiveCol, -1)
- else if (Col = CRCFXY_ColToRight) then
- with tbColNums^ do
- Col := MinI(pred(ColCount), succ(Ay[pred(Count)].Number));
- end
- else if (Region = otrInLocked) then
- begin
- if (Row < LockedRows) then
- Row := IncRow(ActiveRow, -1);
- if (Col < LockedCols) then
- Col := IncCol(ActiveCol, -1);
- end;
- DoActiveCellMoving(ccMouse, Row, Col);
- if (Row = ActiveRow) and (Col = ActiveCol) then
- Exit; {there's nothing to do, just moved within cell}
- if ((Msg.Keys and MK_CONTROL) <> 0) then
- Action := tstAdditional
- else
- begin
- Action := tstDeselectAll;
- tbIsSelecting := true;
- end;
- AllowRedraw := false;
- try
- tbUpdateSelection(Row, Col, Action);
- tbSetActiveCellPrim(Row, Col);
- finally
- AllowRedraw := true;
- end;{try..finally}
- Exit;
- end;
-
- if (otsSizing in tbState) then
- begin
- tbDrawSizeLine;
- if (otsDoingRow in tbState) then
- begin
- if (Msg.YPos >= tbRowNums^.Ay[tbSizeIndex].Offset+6) then
- tbSizeOffset := Msg.YPos;
- end
- else
- begin
- if (Msg.XPos >= tbColNums^.Ay[tbSizeIndex].Offset+6) then
- tbSizeOffset := Msg.XPos;
- end;
- tbDrawSizeLine;
- Exit;
- end;
-
- if (otsMoving in tbState) then
- begin
- CalcRowColFromXY(Msg.XPos, Msg.YPos, Row, Col);
- if (otsDoingCol in tbState) then
- begin
- if (Col >= LockedCols) then
- begin
- NewMoveIndexTo := tbFindColInx(Col);
- if (NewMoveIndexTo <> tbMoveIndexTo) then
- begin
- tbDrawMoveLine;
- tbMoveIndexTo := NewMoveIndexTo;
- tbDrawMoveLine;
- end;
- end;
- end
- else {we're moving rows}
- begin
- if (Row >= LockedRows) then
- begin
- NewMoveIndexTo := tbFindRowInx(Row);
- if (NewMoveIndexTo <> tbMoveIndexTo) then
- begin
- tbDrawMoveLine;
- tbMoveIndexTo := NewMoveIndexTo;
- tbDrawMoveLine;
- end;
- end;
- end;
- end;
- end;
-{--------}
-procedure TOvcCustomTable.WMNCHitTest(var Msg : TMessage);
- begin
- if (otsDesigning in tbState) then
- DefaultHandler(Msg)
- else
- inherited;
- end;
-{--------}
-procedure TOvcCustomTable.WMSetCursor(var Msg : TWMSetCursor);
- var
- CurMousePos : TPoint;
- NewCursor : HCursor;
- IsVert : boolean;
- IsColMove : boolean;
- OnGridLine : boolean;
- InMoveArea : boolean;
- begin
- {ignore non client hit tests, let our ancestor deal with it}
- if (Msg.HitTest <> HTCLIENT) then
- begin
- inherited;
- if ((tbState * [otsShowSize, otsShowMove]) <> []) then
- tbState := tbState - [otsShowSize, otsShowMove, otsDoingRow, otsDoingCol]
- + [otsNormal];
- Exit;
- end;
-
- {if the table is unfocused or we are editing, let our ancestor deal with it}
- if (otsUnfocused in tbState) or InEditingState then
- begin
- inherited;
- Exit;
- end;
-
- {get the mouse cursor position in terms of the table client area}
- GetCursorPos(CurMousePos);
- CurMousePos := ScreenToClient(CurMousePos);
- {work out whether the cursor is over a grid line or on the column
- move area; take into account whether such definitions are allowed}
- OnGridLine := tbIsOnGridLine(CurMousePos.X, CurMousePos.Y, IsVert);
- if OnGridLine then
- if IsVert then
- OnGridLine := (not (otoNoColResizing in Options)) or
- (otsDesigning in tbState)
- else
- OnGridLine := (not (otoNoRowResizing in Options)) or
- (otsDesigning in tbState);
- InMoveArea := false;
- if (not OnGridLine) and
- ((otoAllowColMoves in Options) or (otoAllowRowMoves in Options) or
- (otsDesigning in tbState)) then
- begin
- InMoveArea := tbIsInMoveArea(CurMousePos.X, CurMousePos.Y, IsColMove);
- if InMoveArea then
- if IsColMove then
- InMoveArea := otoAllowColMoves in Options
- else
- InMoveArea := otoAllowRowMoves in Options;
- end;
- {now set the cursor}
- if InMoveArea then
- begin
- if IsColMove then
- begin
- NewCursor := tbColMoveCursor;
- tbState := tbState - [otsNormal, otsShowSize, otsDoingRow]
- + [otsShowMove, otsDoingCol];
- end
- else {row move}
- begin
- NewCursor := tbRowMoveCursor;
- tbState := tbState - [otsNormal, otsShowSize, otsDoingCol]
- + [otsShowMove, otsDoingRow];
- end;
- end
- else if OnGridLine then
- if IsVert then
- begin
- NewCursor := Screen.Cursors[crHSplit];
- tbState := tbState - [otsNormal, otsShowMove, otsDoingRow]
- + [otsShowSize, otsDoingCol];
- end
- else
- begin
- NewCursor := Screen.Cursors[crVSplit];
- tbState := tbState - [otsNormal, otsShowMove, otsDoingCol]
- + [otsShowSize, otsDoingRow];
- end
- else
- begin
- NewCursor := Screen.Cursors[Cursor];
- tbState := tbState - [otsShowMove, otsShowSize, otsDoingRow, otsDoingCol]
- + [otsNormal];
- end;
-{$IFNDEF LCL}
- SetCursor(NewCursor);
-{$ELSE}
- LclIntf.SetCursor(NewCursor); {Don't call control's SetCursor!}
-{$ENDIF}
-
- Msg.Result := 1;
- end;
-{--------}
-procedure TOvcCustomTable.WMSetFocus(var Msg : TWMSetFocus);
- begin
- inherited;
-
- if (otsEditing in tbState) then
- begin
- if tbEditCellHasFocus(Msg.FocusedWnd) then
- GetParentForm(Self).Perform(WM_NEXTDLGCTL, 1, 0)
- else
-{$IFNDEF LCL}
- Windows.SetFocus(tbActCell.EditHandle);
-{$ELSE}
- LclIntf.SetFocus(tbActCell.EditHandle);
-{$ENDIF}
- Exit;
- end;
-
- if (otsFocused in tbState) then
- Exit;
-
- AllowRedraw := false;
- try
- InvalidateCell(ActiveRow, ActiveCol);
- tbState := tbState - [otsUnfocused] + [otsFocused];
- finally
- AllowRedraw := true;
- end;{try..finally}
- end;
-{--------}
-
-procedure TOvcCustomTable.WMVScroll(var Msg : TWMScroll);
-
- procedure ProcessThumb;
- var
- Divisor : LongInt;
- begin
- if (Msg.Pos <> TopRow) then
- begin
- if RowLimit < (16*1024) then
- TopRow := Msg.Pos
- else if Msg.Pos = LockedRows then
- TopRow := LockedRows
- else begin
- if (RowLimit > (16*1024)) then
- Divisor := Succ(RowLimit div $400)
- else
- Divisor := Succ(RowLimit div $40);
- if (Msg.Pos = RowLimit div Divisor) then
- TopRow := pred(RowLimit)
- else
- TopRow := Msg.Pos * Divisor;
- end;
- end;
- end;
-
-begin
- if ProcessingVScrollMessage then
- Exit;
- ProcessingVScrollMessage := true;
- try
- {ignore SB_ENDSCROLL and SB_THUMBTRACK messages (the latter
- if required to by the Options property): this'll possibly
- avoid multiple validations}
- if (Msg.ScrollCode = SB_ENDSCROLL) or
- ((Msg.ScrollCode = SB_THUMBTRACK) and
- (not (otoThumbTrack in Options))) then
- begin
- inherited;
- Exit;
- end;
- {if we're not focused then do so; if we're being designed
- update the table view}
- if (otsUnFocused in tbState) then
-{$IFDEF MSWINDOWS}
- SetFocus //Apparently can't focus scroll bar with GTK?
-{$ENDIF}
- else if (otsDesigning in tbState) then
- Update;
- {check to see whether the cell being edited is valid;
- no scrolling allowed if it isn't (tough).}
- if InEditingState then
- begin
- if not tbActCell.CanSaveEditedData(true) then
- Exit;
- end;
- {process the scrollbar message}
- case Msg.ScrollCode of
- SB_LINEUP : ProcessScrollBarClick(otsbVertical, scLineUp);
- SB_LINEDOWN : ProcessScrollBarClick(otsbVertical, scLineDown);
- SB_PAGEUP : ProcessScrollBarClick(otsbVertical, scPageUp);
- SB_PAGEDOWN : ProcessScrollBarClick(otsbVertical, scPageDown);
- SB_THUMBPOSITION : ProcessThumb;
- SB_THUMBTRACK : if (otoThumbTrack in Options) then ProcessThumb;
- else
- inherited;
- Exit;
- end;
- Msg.Result := 0;
- finally
- ProcessingVScrollMessage := false;
- end;
-end;
-{====================================================================}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovctbclr.pas b/Source/3rdParty/Orpheus/ovctbclr.pas
deleted file mode 100644
index a000362d..00000000
--- a/Source/3rdParty/Orpheus/ovctbclr.pas
+++ /dev/null
@@ -1,266 +0,0 @@
-{*********************************************************}
-{* OVCTBCLR.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 ovctbclr;
- {-Orpheus table colors}
-
-interface
-
-uses
- Graphics, Classes;
-
-type
- TOvcTableColors = class(TPersistent)
- protected {private}
- {.Z+}
- FLocked : TColor;
- FLockedText : TColor;
- FActiveFocused : TColor;
- FActiveFocusedText : TColor;
- FActiveUnfocused : TColor;
- FActiveUnfocusedText : TColor;
- FEditing : TColor;
- FEditingText : TColor;
- FSelected : TColor;
- FSelectedText : TColor;
-
- FOnCfgChanged : TNotifyEvent;
- {.Z-}
-
- protected
- {.Z+}
- procedure SetLocked(C : TColor);
- procedure SetLockedText(C : TColor);
- procedure SetActiveFocused(C : TColor);
- procedure SetActiveFocusedText(C : TColor);
- procedure SetActiveUnfocused(C : TColor);
- procedure SetActiveUnfocusedText(C : TColor);
- procedure SetEditing(C : TColor);
- procedure SetEditingText(C : TColor);
- procedure SetSelected(C : TColor);
- procedure SetSelectedText(C : TColor);
-
- procedure DoCfgChanged;
- {.Z-}
-
- public {protected}
- {.Z+}
- property OnCfgChanged : TNotifyEvent
- read FOnCfgChanged write FOnCfgChanged;
- {.Z-}
-
- public
- constructor Create;
- procedure Assign(Source : TPersistent); override;
-
- published
- {properties}
- property ActiveFocused : TColor
- read FActiveFocused write SetActiveFocused
- default clHighlight;
-
- property ActiveFocusedText : TColor
- read FActiveFocusedText write SetActiveFocusedText
- default clHighlightText;
-
- property ActiveUnfocused : TColor
- read FActiveUnfocused write SetActiveUnfocused
- default clHighlight;
-
- property ActiveUnfocusedText : TColor
- read FActiveUnfocusedText write SetActiveUnfocusedText
- default clHighlightText;
-
- property Locked : TColor
- read FLocked write SetLocked
- default clBtnFace;
-
- property LockedText : TColor
- read FLockedText write SetLockedText
- default clWindowText;
-
- property Editing : TColor
- read FEditing write SetEditing
- default clBtnFace;
-
- property EditingText : TColor
- read FEditingText write SetEditingText
- default clWindowText;
-
- property Selected : TColor
- read FSelected write SetSelected
- default clHighlight;
-
- property SelectedText : TColor
- read FSelectedText write SetSelectedText
- default clHighlightText;
- end;
-
-implementation
-
-
-{===TOvcTableColors==================================================}
-constructor TOvcTableColors.Create;
- begin
- FLocked := clBtnFace;
- FLockedText := clWindowText;
- FActiveFocused := clHighlight;
- FActiveFocusedText := clHighlightText;
- FActiveUnfocused := clHighlight;
- FActiveUnfocusedText := clHighlightText;
- FEditing := clBtnFace;
- FEditingText := clWindowText;
- FSelected := clHighlight;
- FSelectedText := clHighlightText;
- end;
-{--------}
-procedure TOvcTableColors.Assign(Source : TPersistent);
- begin
- if (Source is TOvcTableColors) then
- begin
- FLocked := TOvcTableColors(Source).Locked;
- FLockedText := TOvcTableColors(Source).LockedText;
- FActiveFocused := TOvcTableColors(Source).ActiveFocused;
- FActiveFocusedText := TOvcTableColors(Source).ActiveFocusedText;
- FActiveUnfocused := TOvcTableColors(Source).ActiveUnfocused;
- FActiveUnfocusedText := TOvcTableColors(Source).ActiveUnfocusedText;
- FEditing := TOvcTableColors(Source).Editing;
- FEditingText := TOvcTableColors(Source).EditingText;
- FSelected := TOvcTableColors(Source).Selected;
- FSelectedText := TOvcTableColors(Source).SelectedText;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableColors.DoCfgChanged;
- begin
- if Assigned(FOnCfgChanged) then
- FOnCfgChanged(Self);
- end;
-{--------}
-procedure TOvcTableColors.SetActiveFocused(C : TColor);
- begin
- if (C <> FActiveFocused) then
- begin
- FActiveFocused := C;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableColors.SetActiveFocusedText(C : TColor);
- begin
- if (C <> FActiveFocusedText) then
- begin
- FActiveFocusedText := C;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableColors.SetActiveUnfocused(C : TColor);
- begin
- if (C <> FActiveUnfocused) then
- begin
- FActiveUnfocused := C;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableColors.SetActiveUnfocusedText(C : TColor);
- begin
- if (C <> FActiveUnfocusedText) then
- begin
- FActiveUnfocusedText := C;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableColors.SetEditing(C : TColor);
- begin
- if (C <> FEditing) then
- begin
- FEditing := C;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableColors.SetEditingText(C : TColor);
- begin
- if (C <> FEditingText) then
- begin
- FEditingText := C;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableColors.SetLocked(C : TColor);
- begin
- if (C <> FLocked) then
- begin
- FLocked := C;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableColors.SetLockedText(C : TColor);
- begin
- if (C <> FLockedText) then
- begin
- FLockedText := C;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableColors.SetSelected(C : TColor);
- begin
- if (C <> FSelected) then
- begin
- FSelected := C;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableColors.SetSelectedText(C : TColor);
- begin
- if (C <> FSelectedText) then
- begin
- FSelectedText := C;
- DoCfgChanged;
- end;
- end;
-{====================================================================}
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovctbcls.pas b/Source/3rdParty/Orpheus/ovctbcls.pas
deleted file mode 100644
index b50f83df..00000000
--- a/Source/3rdParty/Orpheus/ovctbcls.pas
+++ /dev/null
@@ -1,608 +0,0 @@
-{*********************************************************}
-{* OVCTBCLS.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 ovctbcls;
- {-Table column, column array classes}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, LclType, {$ENDIF}
- SysUtils, Graphics, Classes, Controls, Forms,
- OvcConst, OvcTCmmn, OvcTCell;
-
-type
- TOvcTableColumnClass = class of TOvcTableColumn;
- TOvcTableColumn = class(TPersistent)
- protected {private}
- {property fields-even size}
- FDefCell : TOvcBaseTableCell;
- FNumber : TColNum;
- FOnColumnChanged : TColChangeNotifyEvent;
- FTable : TOvcTableAncestor;
- FWidth : Integer;
- {property fields-odd size}
- FHidden : boolean;
- Filler : byte;
-
- protected
- {property access}
- procedure SetDefCell(BTC : TOvcBaseTableCell);
- procedure SetHidden(H : boolean);
- procedure SetWidth(W : Integer);
-
- {miscellaneous}
- procedure tcDoColumnChanged;
- procedure tcNotifyCellDeletion(Cell : TOvcBaseTableCell);
-
- public {protected}
- {internal only usage}
- property Number : TColNum
- read FNumber write FNumber;
- property OnColumnChanged : TColChangeNotifyEvent
- write FOnColumnChanged;
-
- public
- procedure Assign(Source : TPersistent); override;
- constructor Create(ATable : TOvcTableAncestor); virtual;
- destructor Destroy; override;
-
- {properties}
- property Table : TOvcTableAncestor
- read FTable;
-
- published
- {properties for streaming}
- property DefaultCell: TOvcBaseTableCell
- read FDefCell write SetDefCell;
-
- property Hidden : boolean
- read FHidden write SetHidden;
-
- property Width : Integer
- read FWidth write SetWidth;
- end;
-
- TOvcTableColumns = class(TPersistent)
- protected {private}
- {property fields}
- FList : TList;
- FOnColumnChanged: TColChangeNotifyEvent;
- FFixups : TStringList;
- FTable : TOvcTableAncestor;
-
- {other fields}
- tcColumnClass : TOvcTableColumnClass;
-
- protected
- {property access}
- function GetCol(ColNum : TColNum) : TOvcTableColumn;
- function GetCount : Integer;
- function GetDefaultCell(ColNum : TColNum) : TOvcBaseTableCell;
- function GetHidden(ColNum : TColNum) : boolean;
- function GetWidth(ColNum : TColNum) : Integer;
-
- procedure SetCol(ColNum : TColNum; C : TOvcTableColumn);
- procedure SetCount(C : Integer);
- procedure SetDefaultCell(ColNum : TColNum; C : TOvcBaseTableCell);
- procedure SetHidden(ColNum : TColNum; H : boolean);
- procedure SetWidth(ColNum : TColNum; W : Integer);
-
- {event access}
- procedure SetOnColumnChanged(OC : TColChangeNotifyEvent);
-
- {other}
- procedure tcDoColumnChanged(ColNum1, ColNum2 : TColNum;
- Action : TOvcTblActions);
-
- public
- {internal only usage}
- procedure tcNotifyCellDeletion(Cell : TOvcBaseTableCell);
- function tcStartLoading : TStringList;
- procedure tcStopLoading;
-
- property OnColumnChanged : TColChangeNotifyEvent
- write SetOnColumnChanged;
-
- public
- constructor Create(ATable : TOvcTableAncestor; ANumber : Integer;
- AColumnClass : TOvcTableColumnClass);
- destructor Destroy; override;
-
- procedure Append(C : TOvcTableColumn);
- procedure Clear;
- procedure Delete(ColNum : TColNum);
- procedure Exchange(ColNum1, ColNum2 : TColNum);
- procedure Insert(const ColNum : TColNum; C : TOvcTableColumn);
-
- property Count : Integer
- read GetCount write SetCount;
-
- property DefaultCell [ColNum : TColNum] : TOvcBaseTableCell
- read GetDefaultCell write SetDefaultCell;
-
- property Hidden [ColNum : TColNum] : boolean
- read GetHidden write SetHidden;
-
- property List [ColNum : TColNum] : TOvcTableColumn
- read GetCol write SetCol;
- default;
-
- property Table : TOvcTableAncestor
- read FTable write FTable;
-
- property Width [ColNum : TColNum] : Integer
- read GetWidth write SetWidth;
- end;
-
-implementation
-
-
-{===TOvcTableColumn=====================================================}
-constructor TOvcTableColumn.Create(ATable : TOvcTableAncestor);
- begin
- inherited Create;
- FWidth := tbDefColWidth;
- FDefCell := nil;
- FTable := ATable;
- end;
-{--------}
-destructor TOvcTableColumn.Destroy;
- begin
- DefaultCell := nil;
- inherited Destroy;
- end;
-{--------}
-procedure TOvcTableColumn.Assign(Source : TPersistent);
- var
- Src : TOvcTableColumn absolute Source;
- begin
- if not (Source is TOvcTableColumn) then
- Exit;
- FWidth := Src.Width;
- FHidden := Src.Hidden;
- DefaultCell := Src.DefaultCell;
- end;
-{--------}
-procedure TOvcTableColumn.tcDoColumnChanged;
- begin
- if Assigned(FOnColumnChanged) then
- FOnColumnChanged(Self, FNumber, 0, taSingle);
- end;
-{--------}
-procedure TOvcTableColumn.tcNotifyCellDeletion(Cell : TOvcBaseTableCell);
- begin
- if (Cell = FDefCell) then
- DefaultCell := nil;
- end;
-{--------}
-procedure TOvcTableColumn.SetDefCell(BTC : TOvcBaseTableCell);
- var
- DoIt : boolean;
- begin
- DoIt := false;
- if (BTC <> FDefCell) then
- if Assigned(BTC) then
- begin
- if (BTC.References = 0) or
- ((BTC.References > 0) and (BTC.Table = FTable)) then
- DoIt := true;
- end
- else
- DoIt := true;
-
- if DoIt then
- begin
- if Assigned(FDefCell) then
- FDefCell.DecRefs;
- FDefCell := BTC;
- if Assigned(FDefCell) then
- begin
- if (FDefCell.References = 0) then
- FDefCell.Table := FTable;
- FDefCell.IncRefs;
- end;
- tcDoColumnChanged;
- end;
- end;
-{--------}
-procedure TOvcTableColumn.SetHidden(H : boolean);
- begin
- if (H <> FHidden) then
- begin
- FHidden := H;
- tcDoColumnChanged;
- end;
- end;
-{--------}
-procedure TOvcTableColumn.SetWidth(W : Integer);
- begin
- if (W <> FWidth) then
- begin
- FWidth := W;
- tcDoColumnChanged;
- end;
- end;
-{====================================================================}
-
-
-
-{===TOvcTableColumns=======================================================}
-constructor TOvcTableColumns.Create(ATable : TOvcTableAncestor;
- ANumber : Integer;
- AColumnClass : TOvcTableColumnClass);
- var
- i : Integer;
- Col : TOvcTableColumn;
- begin
- inherited Create;
- FTable := ATable;
- FList := TList.Create;
- tcColumnClass := AColumnClass;
- for i := 0 to pred(ANumber) do
- begin
- Col := AColumnClass.Create(FTable);
- Col.Number := i;
- Append(Col);
- end;
- end;
-{--------}
-destructor TOvcTableColumns.Destroy;
- begin
- if Assigned(FList) then
- begin
- OnColumnChanged := nil;
- Clear;
- FList.Free;
- end;
- FFixups.Free;
- end;
-{--------}
-procedure TOvcTableColumns.Append(C : TOvcTableColumn);
- begin
- if (FList.Count = Classes.MaxListSize) then
- TableErrorRes(SCTableMaxColumns);
- if (C.Table <> FTable) or (not (C is tcColumnClass)) then
- Exit;
- C.Number := FList.Count;
- FList.Add(C);
- C.OnColumnChanged := FOnColumnChanged;
- tcDoColumnChanged(C.Number, 0, taInsert);
- end;
-{--------}
-procedure TOvcTableColumns.Clear;
- var
- i : Integer;
- begin
- for i := 0 to pred(FList.Count) do
- TOvcTableColumn(FList[i]).Free;
- FList.Clear;
- tcDoColumnChanged(0, 0, taAll);
- end;
-{--------}
-procedure TOvcTableColumns.Delete(ColNum : TColNum);
- var
- i : integer;
- begin
- if (0 <= ColNum) and (ColNum < FList.Count) then
- begin
- TOvcTableColumn(FList[ColNum]).Free;
- FList.Delete(ColNum);
- for i := 0 to pred(FList.Count) do
- TOvcTableColumn(FList[i]).Number := i;
- tcDoColumnChanged(ColNum, 0, taDelete);
- if Assigned(FFixups) then
- if (ColNum < FFixups.Count) then
- FFixups.Delete(ColNum);
- end;
- end;
-{--------}
-procedure TOvcTableColumns.Exchange(ColNum1, ColNum2 : TColNum);
- var
- Temp1, Temp2 : pointer;
- begin
- if (ColNum1 <> ColNum2) and
- (0 <= ColNum1) and (ColNum1 < FList.Count) and
- (0 <= ColNum2) and (ColNum2 < FList.Count) then
- begin
- Temp1 := FList[ColNum1];
- Temp2 := FList[ColNum2];
- TOvcTableColumn(Temp1).Number := ColNum2;
- TOvcTableColumn(Temp2).Number := ColNum1;
- FList[ColNum1] := Temp2;
- FList[ColNum2] := Temp1;
- tcDoColumnChanged(ColNum1, ColNum2, taExchange);
- end;
- end;
-{--------}
-function TOvcTableColumns.GetCol(ColNum : TColNum) : TOvcTableColumn;
- begin
- if (0 <= ColNum) and (ColNum < FList.Count) then
- Result := TOvcTableColumn(FList[ColNum])
- else
- Result := nil;
- end;
-{--------}
-function TOvcTableColumns.GetCount : Integer;
- begin
- Result := FList.Count;
- end;
-{--------}
-function TOvcTableColumns.GetDefaultCell(ColNum : TColNum) : TOvcBaseTableCell;
- begin
- Result := nil;
- if (0 <= ColNum) and (ColNum < FList.Count) then
- Result := TOvcTableColumn(FList[ColNum]).DefaultCell;
- end;
-{--------}
-function TOvcTableColumns.GetHidden(ColNum : TColNum) : boolean;
- begin
- Result := True;
- if (0 <= ColNum) and (ColNum < FList.Count) then
- Result := TOvcTableColumn(FList[ColNum]).Hidden;
- end;
-{--------}
-function TOvcTableColumns.GetWidth(ColNum : TColNum) : Integer;
- begin
- Result := 0;
- if (0 <= ColNum) and (ColNum < FList.Count) then
- Result := TOvcTableColumn(FList[ColNum]).Width;
- end;
-{--------}
-procedure TOvcTableColumns.Insert(const ColNum : TColNum;
- C : TOvcTableColumn);
- var
- i : integer;
- begin
- if (FList.Count = Classes.MaxListSize) then
- TableErrorRes(SCTableMaxColumns);
- if (C.Table <> FTable) or (not (C is tcColumnClass)) then
- Exit;
- if (0 <= ColNum) and (ColNum < FList.Count) then
- begin
- FList.Insert(ColNum, C);
- for i := 0 to pred(FList.Count) do
- TOvcTableColumn(FList[i]).Number := i;
- C.OnColumnChanged := FOnColumnChanged;
- tcDoColumnChanged(ColNum, 0, taInsert);
- if Assigned(FFixups) then begin
- FFixups.Insert(ColNum, 'unknown');
- FFixups.Objects[ColNum] := C;
- end;
- end;
- end;
-{--------}
-procedure TOvcTableColumns.tcDoColumnChanged(ColNum1, ColNum2 : TColNum;
- Action : TOvcTblActions);
- begin
- if Assigned(FOnColumnChanged) then
- FOnColumnChanged(Self, ColNum1, ColNum2, Action);
- end;
-{--------}
-procedure TOvcTableColumns.tcNotifyCellDeletion(Cell : TOvcBaseTableCell);
- var
- ColNum : TColNum;
- begin
- for ColNum := 0 to pred(FList.Count) do
- TOvcTableColumn(FList[ColNum]).tcNotifyCellDeletion(Cell);
- end;
-{--------}
-procedure TOvcTableColumns.SetCol(ColNum : TColNum; C : TOvcTableColumn);
- var
- PC : TOvcTableColumn;
- begin
- if (C.Table <> FTable) or (not (C is tcColumnClass)) then
- Exit;
- if (0 <= ColNum) and (ColNum < FList.Count) then
- begin
- PC := GetCol(ColNum);
- PC.Assign(C);
- end;
- end;
-{--------}
-procedure TOvcTableColumns.SetCount(C : Integer);
- var
- ColNum : TColNum;
- Col : TOvcTableColumn;
- begin
- if (C > 0) and (C <> Count) then
- if (C < Count) then
- begin
- {must destroy the end set of columns}
- for ColNum := pred(Count) downto C do
- Delete(ColNum);
- end
- else {C > Count}
- begin
- {must add some new columns on the end}
- for ColNum := Count to pred(C) do
- begin
- Col := tcColumnClass.Create(FTable);
- Col.Number := ColNum;
- Append(Col);
- end;
- end;
- end;
-{--------}
-procedure TOvcTableColumns.SetDefaultCell(ColNum : TColNum; C : TOvcBaseTableCell);
- begin
- if (0 <= ColNum) and (ColNum < FList.Count) then
- TOvcTableColumn(FList[ColNum]).DefaultCell := C;
- end;
-{--------}
-procedure TOvcTableColumns.SetHidden(ColNum : TColNum; H : boolean);
- begin
- if (0 <= ColNum) and (ColNum < FList.Count) then
- TOvcTableColumn(FList[ColNum]).Hidden := H;
- end;
-{--------}
-procedure TOvcTableColumns.SetOnColumnChanged(OC : TColChangeNotifyEvent);
- var
- i : Integer;
- begin
- FOnColumnChanged := OC;
- for i := 0 to pred(FList.Count) do
- TOvcTableColumn(FList[i]).OnColumnChanged := OC;
- end;
-{--------}
-procedure TOvcTableColumns.SetWidth(ColNum : TColNum; W : Integer);
- begin
- if (0 <= ColNum) and (ColNum < FList.Count) then
- TOvcTableColumn(FList[ColNum]).Width := W;
- end;
-{--------}
-function TOvcTableColumns.tcStartLoading : TStringList;
- begin
- if Assigned(FFixups) then
- FFixups.Clear
- else
- FFixups := TStringList.Create;
- Result := FFixups;
- end;
-{--------}
-procedure TOvcTableColumns.tcStopLoading;
- {------}
- function GetImmediateParentForm(Control : TControl) : TWinControl;
- var
- ParentCtrl : TControl;
- begin
- ParentCtrl := Control.Parent;
- while (Assigned(ParentCtrl)) and
- (not (ParentCtrl is TCustomForm))
- {$IFDEF VERSION5}
- and (not (ParentCtrl is TCustomFrame))
- {$ENDIF}
- do
- ParentCtrl := ParentCtrl.Parent;
- Result := TForm(ParentCtrl);
- end;
- {------}
- function GetFormName(const S, FormName : string) : string;
- var
- PosDot : integer;
- begin
- PosDot := Pos('.', S);
- if (PosDot <> 0) then
- Result := Copy(S, 1, pred(PosDot))
- else
- Result := FormName;
- end;
- {------}
- function FormNamesEqual(const CmptFormName, FormName : string) : boolean;
- var
- PosUL : integer;
- begin
- Result := true;
- if (FormName = '') or (CmptFormName = FormName) then
- Exit;
- PosUL := length(FormName);
- while (PosUL > 0) and (FormName[PosUL] <> '_') do
- dec(PosUL);
- if (PosUL > 0) then
- if (CmptFormName = Copy(FormName, 1, pred(PosUL))) then
- Exit;
- Result := false;
- end;
- {------}
- function GetComponentName(const S : string) : string;
- var
- PosDot : integer;
- begin
- PosDot := Pos('.', S);
- if (PosDot <> 0) then
- Result := Copy(S, succ(PosDot), length(S))
- else
- Result := S;
- end;
- {------}
- var
- i : integer;
- Form : TWinControl;
- Compnt : TComponent;
- DM : integer;
- DataMod: TDataModule;
- DMCount: integer;
- begin
- {if there's nothing to fix up, exit now}
- if not Assigned(FFixups) then
- Exit;
- {fixup references to cell components on the table's form}
- try
- Form := GetImmediateParentForm(FTable);
- for i := pred(FFixups.Count) downto 0 do
- if FormNamesEqual(GetFormName(FFixups[i], Form.Name),
- Form.Name) then
- begin
- Compnt := Form.FindComponent(GetComponentName(FFixups[i]));
- if Assigned(Compnt) and (Compnt is TOvcBaseTableCell) then
- begin
- TOvcTableColumn(FFixups.Objects[i]).DefaultCell := TOvcBaseTableCell(Compnt);
- FFixups.Delete(i);
- end;
- end;
- {fixup references to cell components on any data modules}
- if (FFixups.Count <> 0) then begin
- DM := 0;
-//{$IFNDEF LCL}
- DMCount := Screen.DataModuleCount;
-//{$ELSE}
-// DMCount := 0;
-//{$ENDIF}
- while (FFixups.Count > 0) and (DM < DMCount) do begin
-//{$IFNDEF LCL}
- DataMod := Screen.DataModules[DM];
-//{$ENDIF}
- for i := pred(FFixups.Count) downto 0 do
- if (GetFormName(FFixups[i], Form.Name) = DataMod.Name) then begin
- Compnt := DataMod.FindComponent(GetComponentName(FFixups[i]));
- if Assigned(Compnt) and (Compnt is TOvcBaseTableCell) then begin
- TOvcTableColumn(FFixups.Objects[i]).DefaultCell
- := TOvcBaseTableCell(Compnt);
- FFixups.Delete(i);
- end;
- end;
- inc(DM);
- end;
- end;
- finally
- FFixups.Free;
- FFixups := nil;
- end;
- end;
-{====================================================================}
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovctbpe1.pas b/Source/3rdParty/Orpheus/ovctbpe1.pas
deleted file mode 100644
index bbae5243..00000000
--- a/Source/3rdParty/Orpheus/ovctbpe1.pas
+++ /dev/null
@@ -1,315 +0,0 @@
-{*********************************************************}
-{* OVCTBPE1.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 ovctbpe1;
- {-Property editor for the table component}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- Classes, Graphics, Controls,
- {$IFNDEF LCL} {$IFDEF VERSION6} DesignIntf, DesignEditors, {$ELSE} DsgnIntf, {$ENDIF} {$ELSE} PropEdits, {$ENDIF}
- SysUtils, Forms, Dialogs, StdCtrls, OvcBase, OvcEf, OvcPb, OvcNf,
- Buttons, ExtCtrls, OvcTCmmn, OvcTable, OvcTbRws, OvcSf, OvcSc;
-
-type
- TOvcfrmRowEditor = class(TForm)
- ctlHidden: TCheckBox;
- ctlUseDefHeight: TRadioButton;
- ctlUseCustHeight: TRadioButton;
- DoneButton: TBitBtn;
- Panel1: TPanel;
- SpeedButton1: TSpeedButton;
- SpeedButton2: TSpeedButton;
- SpeedButton3: TSpeedButton;
- SpeedButton4: TSpeedButton;
- SpeedButton5: TSpeedButton;
- SpeedButton6: TSpeedButton;
- Label1: TLabel;
- GroupBox1: TGroupBox;
- GroupBox2: TGroupBox;
- Label2: TLabel;
- Label3: TLabel;
- Reset: TBitBtn;
- ctlHeight: TOvcSimpleField;
- ctlDefaultHeight: TOvcSimpleField;
- ctlRowLimit: TOvcSimpleField;
- ctlRowNumber: TOvcSimpleField;
- ApplyButton: TBitBtn;
- DefaultController: TOvcController;
- OvcSpinner1: TOvcSpinner;
- OvcSpinner2: TOvcSpinner;
- OvcSpinner3: TOvcSpinner;
- OvcSpinner4: TOvcSpinner;
- procedure ctlUseDefHeightClick(Sender: TObject);
- procedure ctlUseCustHeightClick(Sender: TObject);
- procedure SpeedButton1Click(Sender: TObject);
- procedure SpeedButton2Click(Sender: TObject);
- procedure SpeedButton3Click(Sender: TObject);
- procedure SpeedButton4Click(Sender: TObject);
- procedure SpeedButton5Click(Sender: TObject);
- procedure SpeedButton6Click(Sender: TObject);
- procedure ctlRowNumberExit(Sender: TObject);
- procedure FormShow(Sender: TObject);
- procedure ResetClick(Sender: TObject);
- procedure ApplyButtonClick(Sender: TObject);
- procedure DoneButtonClick(Sender: TObject);
- procedure ctlRowNumberChange(Sender: TObject);
- private
- { Private declarations }
- FRows : TOvcTableRows;
- FRowNum : TRowNum;
- CurDefHt : boolean;
-
- protected
- procedure RefreshRowData;
- procedure SetRowNum(R : TRowNum);
-
- public
- { Public declarations }
- procedure SetRows(RS : TOvcTableRows);
-
- property Rows : TOvcTableRows
- read FRows
- write SetRows;
-
- property RowNum : TRowNum
- read FRowNum
- write SetRowNum;
-
- end;
-
- {-A table row property editor}
- TOvcTableRowProperty = class(TClassProperty)
- public
- procedure Edit; override;
- function GetAttributes: TPropertyAttributes; override;
- end;
-
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.DFM}
-{$ENDIF}
-
-
-
-{===TOvcTableRowProperty=============================================}
-procedure TOvcTableRowProperty.Edit;
- var
- RowEditor : TOvcfrmRowEditor;
- begin
- RowEditor := TOvcfrmRowEditor.Create(Application);
- try
- RowEditor.SetRows(TOvcTableRows(GetOrdValue));
- RowEditor.ShowModal;
-{$IFNDEF LCL}
- Designer.Modified;
-{$ELSE}
- Modified;
-{$ENDIF}
- finally
- RowEditor.Free;
- end;{try..finally}
- end;
-{--------}
-function TOvcTableRowProperty.GetAttributes: TPropertyAttributes;
- begin
- Result := [paMultiSelect, paDialog, paReadOnly];
- end;
-{====================================================================}
-
-
-{===TRowEditor=======================================================}
-procedure TOvcfrmRowEditor.ApplyButtonClick(Sender: TObject);
- var
- RS : TRowStyle;
- begin
- FRows.Limit := ctlRowLimit.AsInteger;
- if FRowNum >= FRows.Limit then
- RowNum := pred(FRows.Limit);
- FRows.DefaultHeight := ctlDefaultHeight.AsInteger;
- with RS do
- begin
- if ctlUseDefHeight.Checked then
- Height := ctlDefaultHeight.AsInteger
- else
- begin
- Height := ctlHeight.AsInteger;
- if (Height = FRows.DefaultHeight) then
- ctlUseDefHeight.Checked := true;
- end;
- Hidden := ctlHidden.Checked;
- FRows[RowNum] := RS;
- end;
- end;
-{--------}
-procedure TOvcfrmRowEditor.ctlRowNumberExit(Sender: TObject);
- begin
- RowNum := ctlRowNumber.AsInteger;
- end;
-{--------}
-procedure TOvcfrmRowEditor.ctlUseCustHeightClick(Sender: TObject);
- begin
- CurDefHt := false;
- ctlHeight.Enabled := true;
- end;
-{--------}
-procedure TOvcfrmRowEditor.ctlUseDefHeightClick(Sender: TObject);
- begin
- CurDefHt := true;
- ctlHeight.AsInteger := FRows.DefaultHeight;
- ctlHeight.Enabled := false;
- end;
-{--------}
-procedure TOvcfrmRowEditor.FormShow(Sender: TObject);
- begin
- ctlDefaultHeight.AsInteger := FRows.DefaultHeight;
- ctlRowLimit.AsInteger := FRows.Limit;
- RefreshRowData;
- end;
-{--------}
-procedure TOvcfrmRowEditor.RefreshRowData;
- begin
- CurDefHt := FRows.Height[RowNum] = FRows.DefaultHeight;
-
- ctlRowNumber.RangeHi := IntToStr(pred(FRows.Limit));
-
- ctlHidden.Checked := FRows.Hidden[RowNum];
- ctlHeight.AsInteger := FRows.Height[RowNum];
- if CurDefHt then
- begin
- ctlUseDefHeight.Checked := true;
- ctlHeight.Enabled := false;
- end
- else
- begin
- ctlUseCustHeight.Checked := true;
- ctlHeight.Enabled := true;
- end;
-
- ctlRowLimit.AsInteger := FRows.Limit;
- end;
-{--------}
-procedure TOvcfrmRowEditor.ResetClick(Sender: TObject);
- begin
- FRows.Clear;
- ctlDefaultHeight.AsInteger := FRows.DefaultHeight;
- RefreshRowData;
- end;
-{--------}
-procedure TOvcfrmRowEditor.SetRowNum(R : TRowNum);
- begin
- if (FRowNum <> R) then
- begin
- FRowNum := R;
- ctlRowNumber.AsInteger := R;
- RefreshRowData;
- end;
- end;
-{--------}
-procedure TOvcfrmRowEditor.SetRows(RS : TOvcTableRows);
- begin
- if Assigned(FRows) then
- FRows.Free;
- FRows := RS;
- FRowNum := 0;
- CurDefHt := FRows.Height[RowNum] = FRows.DefaultHeight;
- end;
-{--------}
-procedure TOvcfrmRowEditor.SpeedButton1Click(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- if (RowNum > 0) then
- RowNum := RowNum - 1;
- end;
-{--------}
-procedure TOvcfrmRowEditor.SpeedButton2Click(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- if (RowNum < pred(FRows.Limit)) then
- RowNum := RowNum + 1;
- end;
-{--------}
-procedure TOvcfrmRowEditor.SpeedButton3Click(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- RowNum := 0;
- end;
-{--------}
-procedure TOvcfrmRowEditor.SpeedButton4Click(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- RowNum := pred(FRows.Limit);
- end;
-{--------}
-procedure TOvcfrmRowEditor.SpeedButton5Click(Sender: TObject);
- var
- RS : TRowStyle;
- begin
- RS.Hidden := false;
- RS.Height := FRows.DefaultHeight;
- FRows.Insert(FRowNum, RS);
- RefreshRowData;
- end;
-{--------}
-procedure TOvcfrmRowEditor.SpeedButton6Click(Sender: TObject);
- begin
- FRows.Delete(FRowNum);
- RefreshRowData;
- end;
-{====================================================================}
-
-procedure TOvcfrmRowEditor.DoneButtonClick(Sender: TObject);
-begin
- ApplyButtonClick(Self);
-end;
-
-procedure TOvcfrmRowEditor.ctlRowNumberChange(Sender: TObject);
-begin
- ApplyButtonClick(Self);
- RowNum := ctlRowNumber.AsInteger;
-end;
-
-initialization
-{$IFDEF LCL}
-{$I ovctbpe1.lrs} {Include form's resource file}
-{$ENDIF}
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovctbpe2.pas b/Source/3rdParty/Orpheus/ovctbpe2.pas
deleted file mode 100644
index 67d92b14..00000000
--- a/Source/3rdParty/Orpheus/ovctbpe2.pas
+++ /dev/null
@@ -1,332 +0,0 @@
-{*********************************************************}
-{* OVCTBPE2.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 ovctbpe2;
- {-Property editor for the data-aware table component}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Classes, Graphics, Controls,
- {$IFNDEF LCL} {$IFDEF VERSION6} DesignIntf, DesignEditors, {$ELSE} DsgnIntf, {$ENDIF} {$ELSE} PropEdits, ComponentEditors, {$ENDIF}
- TypInfo, Forms, Dialogs, StdCtrls, OvcBase, OvcEf, OvcPb, OvcNf, Buttons,
- ExtCtrls, OvcTCmmn, OvcTCell, OvcTbCls, OvcTable, OvcSf, OvcSc;
-
-type
- TOvcfrmColEditor = class(TForm)
- ctlColNumber: TOvcSimpleField;
- ctlDefaultCell: TComboBox;
- ctlHidden: TCheckBox;
- ctlWidth: TOvcSimpleField;
- Panel1: TPanel;
- SpeedButton1: TSpeedButton;
- SpeedButton2: TSpeedButton;
- SpeedButton3: TSpeedButton;
- SpeedButton4: TSpeedButton;
- SpeedButton5: TSpeedButton;
- SpeedButton6: TSpeedButton;
- Label1: TLabel;
- Label2: TLabel;
- Label3: TLabel;
- Label4: TLabel;
- GroupBox1: TGroupBox;
- DoneButton: TBitBtn;
- ApplyButton: TBitBtn;
- DefaultController: TOvcController;
- OvcSpinner1: TOvcSpinner;
- OvcSpinner2: TOvcSpinner;
- procedure ctlColNumberExit(Sender: TObject);
- procedure ApplyButtonClick(Sender: TObject);
- procedure SpeedButton1Click(Sender: TObject);
- procedure SpeedButton2Click(Sender: TObject);
- procedure SpeedButton3Click(Sender: TObject);
- procedure SpeedButton4Click(Sender: TObject);
- procedure SpeedButton5Click(Sender: TObject);
- procedure SpeedButton6Click(Sender: TObject);
- procedure FormShow(Sender: TObject);
- procedure DoneButtonClick(Sender: TObject);
- procedure ctlColNumberChange(Sender: TObject);
- private
- { Private declarations }
- FCols : TOvcTableColumns;
- FColNum : TColNum;
- CurCellIndex : integer;
- Cells : TStringList;
-
- protected
- procedure GetCells;
- procedure RefreshColData;
- procedure SetColNum(C : TColNum);
-
- procedure AddCellComponentName(const S : string);
-
- public
- { Public declarations }
- Editor : TObject;
- procedure SetCols(CS : TOvcTableColumns);
-
- property Cols : TOvcTableColumns
- read FCols
- write SetCols;
-
- property ColNum : TColNum
- read FColNum
- write SetColNum;
-
- end;
-
- {-A table column property editor}
- TOvcTableColumnProperty = class(TClassProperty)
- public
- procedure Edit; override;
- function GetAttributes: TPropertyAttributes; override;
- end;
-
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.DFM}
-{$ENDIF}
-
-
-
-{===TOvcTableColumnProperty==========================================}
-procedure TOvcTableColumnProperty.Edit;
- var
- ColEditor : TOvcfrmColEditor;
- begin
- ColEditor := TOvcfrmColEditor.Create(Application);
- try
- ColEditor.Editor := Self;
- ColEditor.SetCols(TOvcTableColumns(GetOrdValue));
- ColEditor.ShowModal;
-{$IFNDEF LCL}
- Designer.Modified;
-{$ELSE}
- Modified;
-{$ENDIF}
- finally
- ColEditor.Free;
- end;{try..finally}
- end;
-{--------}
-function TOvcTableColumnProperty.GetAttributes: TPropertyAttributes;
- begin
- Result := [paMultiSelect, paDialog, paReadOnly];
- end;
-{====================================================================}
-
-
-{===TColEditor=======================================================}
-procedure TOvcfrmColEditor.AddCellComponentName(const S : string);
- begin
- Cells.Add(S);
- end;
-{--------}
-procedure TOvcfrmColEditor.ApplyButtonClick(Sender: TObject);
- begin
- with FCols[ColNum] do
- begin
- Hidden := ctlHidden.Checked;
- FCols[ColNum].Width := ctlWidth.AsInteger;
- if (ctlDefaultCell.ItemIndex <> CurCellIndex) then
- begin
- CurCellIndex := ctlDefaultCell.ItemIndex;
- FCols[FColNum].DefaultCell := TOvcBaseTableCell(Cells.Objects[CurCellIndex]);
- end;
- end;
- end;
-{--------}
-procedure TOvcfrmColEditor.ctlColNumberExit(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- ColNum := ctlColNumber.AsInteger;
- end;
-{--------}
-procedure TOvcfrmColEditor.DoneButtonClick(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- Cells.Free;
- end;
-{--------}
-procedure TOvcfrmColEditor.FormShow(Sender: TObject);
- begin
- if not Assigned(Cells) then
- begin
- Cells := TStringList.Create;
- GetCells;
- end;
- RefreshColData;
- end;
-{--------}
-procedure TOvcfrmColEditor.GetCells;
- var
- {$IFDEF VERSION4}
- {$IFDEF VERSION6}
-{$IFNDEF LCL}
- Designer : IDesigner;
-{$ENDIF}
- {$ELSE}
- Designer : IFormDesigner;
- {$ENDIF}
- {$ELSE}
- Designer : TFormDesigner;
- {$ENDIF}
- TI : PTypeInfo;
- Index: Integer;
- C : TComponent;
- Cell : TOvcBaseTableCell absolute C;
- begin
- Cells.Sorted := true;
- Cells.AddObject('(None)', nil);
- TI := TOvcBaseTableCell.ClassInfo;
-{$IFNDEF LCL}
- if (Editor is TClassProperty) then
- Designer := TClassProperty(Editor).Designer
- else {the editor is a TDefaultEditor}
- Designer := TDefaultEditor(Editor).Designer;
- Designer.GetComponentNames(GetTypeData(TI), AddCellComponentName);
- for Index := 1 to pred(Cells.Count) do
- Cells.Objects[Index] := Designer.GetComponent(Cells[Index]);
-{$ELSE}
- if (Editor is TClassProperty) then
- begin
- TClassProperty(Editor).PropertyHook.GetComponentNames(GetTypeData(TI), AddCellComponentName);
- for Index := 1 to pred(Cells.Count) do
- Cells.Objects[Index] := TClassProperty(Editor).PropertyHook.GetComponent(Cells[Index]);
- end
- else {the editor is a TDefaultComponentEditor}
- begin
- TDefaultComponentEditor(Editor).Designer.PropertyEditorHook.GetComponentNames(GetTypeData(TI), AddCellComponentName);
- for Index := 1 to pred(Cells.Count) do
- Cells.Objects[Index] := TDefaultComponentEditor(Editor).Designer.PropertyEditorHook.GetComponent(Cells[Index]);
- end;
-{$ENDIF}
- ctlDefaultCell.Items := Cells;
- end;
-{--------}
-procedure TOvcfrmColEditor.RefreshColData;
- begin
- CurCellIndex := Cells.IndexOfObject(FCols[ColNum].DefaultCell);
-
- ctlColNumber.RangeHi := IntToStr(pred(FCols.Count));
-
- ctlHidden.Checked := FCols[ColNum].Hidden;
- ctlWidth.AsInteger := FCols[ColNum].Width;
- ctlDefaultCell.ItemIndex := CurCellIndex;
- end;
-{--------}
-procedure TOvcfrmColEditor.SetColNum(C : TColNum);
- begin
- if (FColNum <> C) then
- begin
- FColNum := C;
- ctlColNumber.AsInteger := C;
- RefreshColData;
- end;
- end;
-{--------}
-procedure TOvcfrmColEditor.SetCols(CS : TOvcTableColumns);
- begin
- if Assigned(FCols) then
- FCols.Free;
- FCols := CS;
- FColNum := 0;
- end;
-{--------}
-procedure TOvcfrmColEditor.SpeedButton1Click(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- if (ColNum > 0) then
- ColNum := ColNum - 1;
- end;
-{--------}
-procedure TOvcfrmColEditor.SpeedButton2Click(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- if (ColNum < pred(FCols.Count)) then
- ColNum := ColNum + 1;
- end;
-{--------}
-procedure TOvcfrmColEditor.SpeedButton3Click(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- ColNum := 0;
- end;
-{--------}
-procedure TOvcfrmColEditor.SpeedButton4Click(Sender: TObject);
- begin
- ApplyButtonClick(Self);
- ColNum := pred(FCols.Count);
- end;
-{--------}
-procedure TOvcfrmColEditor.SpeedButton5Click(Sender: TObject);
- var
- C : TOvcTableColumn;
- begin
- C := TOvcTableColumn.Create(FCols.Table);
- FCols.Insert(FColNum, C);
- RefreshColData;
- end;
-{--------}
-procedure TOvcfrmColEditor.SpeedButton6Click(Sender: TObject);
- begin
- if (FCols.Count > 1) then
- begin
- FCols.Delete(FColNum);
- if (FColNum = FCols.Count) then
- ColNum := pred(FColNum)
- else RefreshColData;
- end;
- end;
-{====================================================================}
-
-
-procedure TOvcfrmColEditor.ctlColNumberChange(Sender: TObject);
-begin
- ApplyButtonClick(Self);
- ColNum := ctlColNumber.AsInteger;
-end;
-
-initialization
-{$IFDEF LCL}
-{$I ovctbpe2.lrs} {Include form's resource file}
-{$ENDIF}
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovctbrws.pas b/Source/3rdParty/Orpheus/ovctbrws.pas
deleted file mode 100644
index 14aa2d7e..00000000
--- a/Source/3rdParty/Orpheus/ovctbrws.pas
+++ /dev/null
@@ -1,511 +0,0 @@
-{*********************************************************}
-{* OVCTBRWS.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 ovctbrws;
- {-Orpheus Table Rows array}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, LclType, {$ENDIF}
- SysUtils, Classes, OvcConst, OvcTCmmn, OvcSpAry;
-
-type
- TOvcTableRows = class(TPersistent)
- {-Sparse array for rows}
- protected {private}
- {property fields}
- FActiveCount : TRowNum;
- FList : TOvcSparseArray;
- FDefHeight : integer;
- FLimit : TRowNum;
- {property event fields}
- FOnCfgChanged : TRowChangeNotifyEvent;
-
- protected
- {property read access}
- function GetRow(RowNum : TRowNum) : TRowStyle;
- function GetRowHeight(RowNum : TRowNum) : integer;
- function GetRowHidden(RowNum : TRowNum) : boolean;
- function GetRowIsSpecial(RowNum : TRowNum) : boolean;
- {property write access}
- procedure SetDefHeight(H : integer);
- procedure SetRow(RowNum : TRowNum; const RS : TRowStyle);
- procedure SetRowHeight(RowNum : TRowNum; H : integer);
- procedure SetRowHidden(RowNum : TRowNum; H : boolean);
- procedure SetLimit(RowNum : TRowNum);
-
- {general}
- procedure trDoCfgChanged(RowNum1, RowNum2 : TRowNum; Action : TOvcTblActions);
-
- public {protected}
- procedure rwScaleHeights(M, D : integer);
-
- property OnCfgChanged : TRowChangeNotifyEvent
- write FOnCfgChanged;
-
- public
- constructor Create;
- {-Create an array of row styles}
- destructor Destroy; override;
- {-Destroy an array of row styles}
-
- procedure Append(const RS : TRowStyle);
- {-Add row to end of current list, increment Limit}
- procedure Clear;
- {-Delete all row styles (reset all rows to the defaults)}
- procedure Delete(RowNum : TRowNum);
- {-Delete a row, move rows below it up one, decrement Limit}
- procedure Exchange(const RowNum1, RowNum2 : TRowNum);
- {-Exchange two rows}
- procedure Insert(const RowNum : TRowNum;
- const RS : TRowStyle);
- {-Insert a row, move rows below it down one, increment Limit}
- procedure Reset(const RowNum : TRowNum);
- {-Reset a row to the defaults}
-
- property List [RowNum : TRowNum] : TRowStyle
- {-Array of row styles}
- read GetRow write SetRow;
- default;
-
- {properties}
- property Count : TRowNum
- {-The current number of rows with explicit attributes}
- read FActiveCount;
-
- property DefaultHeight : integer
- {-The default row height}
- read FDefHeight write SetDefHeight;
-
- property Height [RowNum : TRowNum] : integer
- {-Array of row heights}
- read GetRowHeight write SetRowHeight;
-
- property Hidden [RowNum : TRowNum] : boolean
- {-Array of row hidden flags}
- read GetRowHidden write SetRowHidden;
-
- property RowIsSpecial [RowNum : TRowNum] : boolean
- read GetRowIsSpecial;
-
- property Limit : TRowNum
- {-Maximum number of rows}
- read FLimit write SetLimit;
- end;
-
-
-implementation
-
-
-{===Extra RowStyle routines==========================================}
-function NewRowStyle(AHeight : integer; AHidden : boolean) : PRowStyle;
- {-Allocate a row style on the heap}
- begin
- Result := New(PRowStyle);
- with Result^ do
- begin
- Height := AHeight;
- Hidden := AHidden;
- end;
- end;
-{--------}
-function DelRow(Index : longint; Item : pointer; ExtraData : pointer) : boolean; far;
- {-Iterator to delete a row style from the sparse list}
- var
- R : PRowStyle absolute Item;
- begin
- Dispose(R);
- Result := true;
- end;
-{--------------------------------------------------------------------}
-
-{Note: the row numbers passed to this class have a minimum limit of
- zero, and an upper limit that consists of two parts. Firstly
- the real upper limit is the value of Limit: if a row number
- is greater than this an out-of-bounds exception is generated.
- Secondly the upper limit for rows with explicit styles is
- MaxSparseArrayItems, since that is the limit for the under-
- lying sparse array. Generally exceeding this limit causes the
- action to be ignored, no exception is generated.}
-
-
-{===TOvcTableRows==========================================================}
-constructor TOvcTableRows.Create;
- begin
- FList := TOvcSparseArray.Create;
- FDefHeight := tbDefRowHeight;
- FLimit := tbDefRowCount;
- end;
-{--------}
-destructor TOvcTableRows.Destroy;
- begin
- if Assigned(FList) then
- begin
- Clear;
- FList.Free;
- end;
- end;
-{--------}
-procedure TOvcTableRows.Append(const RS : TRowStyle);
- begin
- Insert(Limit, RS);
- end;
-{--------}
-procedure TOvcTableRows.Clear;
- var
- DummyPtr : pointer;
- begin
- DummyPtr := nil;
- FList.ForAll(DelRow, false, DummyPtr);
- FList.Clear;
- FActiveCount := 0;
- trDoCfgChanged(0, 0, taAll);
- end;
-{--------}
-procedure TOvcTableRows.Delete(RowNum : TRowNum);
- var
- RS : PRowStyle;
- begin
- if (RowNum < 0) or (RowNum >= Limit) then
- TableErrorRes(SCTableRowOutOfBounds);
- if (RowNum < OvcSpAry.MaxSparseArrayItems) then
- begin
- RS := PRowStyle(FList[RowNum]);
- if Assigned(RS) then
- begin
- Dispose(RS);
- dec(FActiveCount);
- end;
- FList.Delete(RowNum);
- Limit := Limit - 1;
- trDoCfgChanged(RowNum, 0, taDelete);
- end;
- end;
-{--------}
-procedure TOvcTableRows.trDoCfgChanged(RowNum1, RowNum2 : TRowNum; Action : TOvcTblActions);
- {-On a change, call the notify event handler}
- begin
- if Assigned(FOnCfgChanged) then
- FOnCfgChanged(Self, RowNum1, RowNum2, Action);
- end;
-{--------}
-procedure TOvcTableRows.Exchange(const RowNum1, RowNum2 : TRowNum);
- begin
- if (RowNum1 < 0) or (RowNum1 >= Limit) then
- TableErrorRes(SCTableRowOutOfBounds);
- if (RowNum2 < 0) or (RowNum2 >= Limit) then
- TableErrorRes(SCTableRowOutOfBounds);
- if (RowNum1 <> RowNum2) and
- (RowNum1 < OvcSpAry.MaxSparseArrayItems) and
- (RowNum2 < OvcSpAry.MaxSparseArrayItems) then
- begin
- FList.Exchange(RowNum1, RowNum2);
- trDoCfgChanged(RowNum1, RowNum2, taExchange);
- end;
- end;
-{--------}
-function TOvcTableRows.GetRow(RowNum : TRowNum) : TRowStyle;
- var
- PRS : PRowStyle;
- begin
- if (RowNum < 0) or (RowNum >= Limit) then
- TableErrorRes(SCTableRowOutOfBounds);
- if (FActiveCount > 0) and (RowNum < OvcSpAry.MaxSparseArrayItems) then
- PRS := PRowStyle(FList[RowNum])
- else
- PRS := nil;
- if Assigned(PRS) then
- begin
- Result := PRS^;
- if (Result.Height = UseDefHt) then
- Result.Height := DefaultHeight;
- end
- else
- with Result do
- begin
- Height := DefaultHeight;
- Hidden := false;
- end;
- end;
-{--------}
-function TOvcTableRows.GetRowHeight(RowNum : TRowNum) : integer;
- var
- PRS : PRowStyle;
- begin
- if (RowNum < 0) or (RowNum >= Limit) then
- TableErrorRes(SCTableRowOutOfBounds);
- Result := DefaultHeight;
- if (FActiveCount > 0) and (RowNum < OvcSpAry.MaxSparseArrayItems) then
- begin
- PRS := PRowStyle(FList[RowNum]);
- if Assigned(PRS) then
- begin
- Result := PRS^.Height;
- if (Result = UseDefHt) then
- Result := DefaultHeight;
- end;
- end;
- end;
-{--------}
-function TOvcTableRows.GetRowHidden(RowNum : TRowNum) : boolean;
- var
- PRS : PRowStyle;
- begin
- if (RowNum < 0) or (RowNum >= Limit) then
- TableErrorRes(SCTableRowOutOfBounds);
- Result := false;
- if (FActiveCount > 0) and (RowNum < OvcSpAry.MaxSparseArrayItems) then
- begin
- PRS := PRowStyle(FList[RowNum]);
- if Assigned(PRS) then
- Result := PRS^.Hidden;
- end;
- end;
-{--------}
-function TOvcTableRows.GetRowIsSpecial(RowNum : TRowNum) : boolean;
- var
- PRS : PRowStyle;
- begin
- if (RowNum < 0) or (RowNum >= Limit) then
- TableErrorRes(SCTableRowOutOfBounds);
- if (FActiveCount > 0) and (RowNum < OvcSpAry.MaxSparseArrayItems) then
- begin
- PRS := PRowStyle(FList[RowNum]);
- Result := Assigned(PRS);
- end
- else
- Result := false;
- end;
-{--------}
-procedure TOvcTableRows.Insert(const RowNum : TRowNum;
- const RS : TRowStyle);
- var
- Height : integer;
- begin
- {note: you can insert a style at row number Limit}
- if (RowNum < 0) or (RowNum > Limit) then
- TableErrorRes(SCTableRowOutOfBounds);
- if (RowNum >= OvcSpAry.MaxSparseArrayItems) then
- TableErrorRes(SCTableMaxRows);
- Height := RS.Height;
- if (Height < 1) or (Height = DefaultHeight) then
- Height := UseDefHt;
- if (RS.Hidden = false) and (Height = UseDefHt) then
- FList.Insert(RowNum, nil)
- else
- begin
- FList.Insert(RowNum, NewRowStyle(Height, RS.Hidden));
- inc(FActiveCount);
- end;
- Limit := Limit + 1;
- trDoCfgChanged(RowNum, 0, taInsert);
- end;
-{--------}
-procedure TOvcTableRows.Reset(const RowNum : TRowNum);
- var
- PRS : PRowStyle;
- begin
- if (RowNum < 0) or (RowNum >= Limit) then
- TableErrorRes(SCTableRowOutOfBounds);
- if (FActiveCount > 0) and (RowNum < OvcSpAry.MaxSparseArrayItems) then
- begin
- PRS := PRowStyle(FList[RowNum]);
- if Assigned(PRS) then
- begin
- Dispose(PRS);
- FList[RowNum] := nil;
- dec(FActiveCount);
- trDoCfgChanged(RowNum, 0, taSingle);
- end;
- end;
- end;
-{--------}
-type
- PScaleExtraData = ^TScaleExtraData;
- TScaleExtraData = packed record
- M, D : integer;
- end;
- {------}
-function ScaleHeight(Index : longint; Item : pointer;
- ExtraData : pointer) : boolean; far;
- var
- RS : PRowStyle absolute Item;
- ED : PScaleExtraData absolute ExtraData;
- begin
- Result := true;
- with RS^ do
- if (Height <> UseDefHt) then
- Height := MulDiv(Height, ED^.M, ED^.D);
- end;
- {------}
-procedure TOvcTableRows.rwScaleHeights(M, D : integer);
- var
- ExtraData : TScaleExtraData;
- begin
- FDefHeight := MulDiv(FDefHeight, M, D);
- if (FActiveCount > 0) then
- begin
- ExtraData.M := M;
- ExtraData.D := D;
- FList.ForAll(ScaleHeight, false, @ExtraData);
- end;
- end;
-{--------}
-procedure TOvcTableRows.SetDefHeight(H : integer);
- begin
- if (H <> FDefHeight) and (H >= 1) then
- begin
- FDefHeight := H;
- trDoCfgChanged(0, 0, taAll);
- end;
- end;
-{--------}
-procedure TOvcTableRows.SetLimit(RowNum : TRowNum);
- begin
- if RowNum < 1 then
- RowNum := 1;
- if (RowNum <> FLimit) then
- begin
- FLimit := RowNum;
- trDoCfgChanged(RowLimitChanged, 0, taGeneral);
- end;
- end;
-{--------}
-procedure TOvcTableRows.SetRow(RowNum : TRowNum; const RS : TRowStyle);
- var
- PRS : PRowStyle;
- Height : integer;
- begin
- if (RowNum < 0) or (RowNum >= Limit) then
- TableErrorRes(SCTableRowOutOfBounds);
- if (RowNum < OvcSpAry.MaxSparseArrayItems) then
- begin
- Height := RS.Height;
- if (Height < 1) or (Height = DefaultHeight) then
- Height := UseDefHt;
- if (RS.Hidden = false) and (Height = UseDefHt) then
- Reset(RowNum)
- else
- begin
- PRS := PRowStyle(FList[RowNum]);
- if Assigned(PRS) then
- PRS^ := RS
- else
- begin
- FList[RowNum] := NewRowStyle(Height, RS.Hidden);
- inc(FActiveCount);
- end;
- trDoCfgChanged(RowNum, 0, taSingle);
- end;
- end;
- end;
-{--------}
-procedure TOvcTableRows.SetRowHeight(RowNum : TRowNum; H : integer);
- var
- PRS : PRowStyle;
- begin
- if (RowNum < 0) or (RowNum >= Limit) then
- TableErrorRes(SCTableRowOutOfBounds);
- if (RowNum < OvcSpAry.MaxSparseArrayItems) then
- begin
- if (H < 1) or (H = DefaultHeight) then
- H := UseDefHt;
- PRS := PRowStyle(FList[RowNum]);
- if Assigned(PRS) then
- begin
- if (H <> PRS^.Height) then
- begin
- if (H = UseDefHt) then
- if not PRS^.Hidden then
- begin
- Dispose(PRS);
- FList[RowNum] := nil;
- dec(FActiveCount);
- end
- else
- PRS^.Height := UseDefHt
- else
- PRS^.Height := H;
- trDoCfgChanged(RowNum, 0, taSingle);
- end;
- end
- else if (H <> UseDefHt) then {only create new style if not default}
- begin
- FList[RowNum] := NewRowStyle(H, false);
- inc(FActiveCount);
- trDoCfgChanged(RowNum, 0, taSingle);
- end;
- end;
- end;
-{--------}
-procedure TOvcTableRows.SetRowHidden(RowNum : TRowNum; H : boolean);
- var
- PRS : PRowStyle;
- begin
- if (RowNum < 0) or (RowNum >= Limit) then
- TableErrorRes(SCTableRowOutOfBounds);
- if (RowNum < OvcSpAry.MaxSparseArrayItems) then
- begin
- PRS := PRowStyle(FList[RowNum]);
- if Assigned(PRS) then
- begin
- if (H <> PRS^.Hidden) then
- begin
- if (not H) and (PRS^.Height = UseDefHt) then
- begin
- Dispose(PRS);
- FList[RowNum] := nil;
- dec(FActiveCount);
- end
- else
- PRS^.Hidden := H;
- trDoCfgChanged(RowNum, 0, taSingle);
- end;
- end
- else if H then {only create new style if hidden}
- begin
- FList[RowNum] := NewRowStyle(UseDefHt, H);
- inc(FActiveCount);
- trDoCfgChanged(RowNum, 0, taSingle);
- end;
- end;
- end;
-{====================================================================}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovctcary.pas b/Source/3rdParty/Orpheus/ovctcary.pas
deleted file mode 100644
index 40cff001..00000000
--- a/Source/3rdParty/Orpheus/ovctcary.pas
+++ /dev/null
@@ -1,324 +0,0 @@
-{*********************************************************}
-{* OVCTCARY.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 ovctcary;
- {-Orpheus Table - Cell Array class}
-
-interface
-
-{Note: this class exists for the *sole* purpose of providing a sorted
- list of cell addresses that need repainting. It has no other
- possible application. It also stores a flag that states that
- the unused bit of the table window needs painting}
-
-uses
- SysUtils, Classes, OvcTCmmn;
-
-type
- TOvcCellAddress = packed record
- Row : TRowNum;
- Col : TColNum;
- end;
-
- TOvcCellArray = class
- protected {private}
- {.Z+}
- FArray : pointer;
- FLimit : Integer;
- FCount : Integer;
-
- DoUnusedBit : boolean;
- {.Z-}
-
- protected
- {.Z+}
- function GetEmpty : boolean;
- {.Z-}
-
- public
- destructor Destroy; override;
-
- procedure AddCell(RowNum : TRowNum; ColNum : TColNum);
- procedure AddUnusedBit;
- procedure Clear;
- function DeleteCell(RowNum : TRowNum; ColNum : TColNum) : boolean;
- procedure GetCellAddr(Inx : Integer; var CellAddr : TOvcCellAddress);
- procedure Merge(CA : TOvcCellArray);
- function MustDoUnusedBit : boolean;
-
- property Count : Integer
- read FCount;
-
- property Empty : boolean
- read GetEmpty;
- end;
-
-implementation
-
-
-type
- POvcCellArrayPrim = ^TOvcCellArrayPrim;
- TOvcCellArrayPrim = array [0..9999] of TOvcCellAddress;
-
-
-{===TOvcCellArray====================================================}
-destructor TOvcCellArray.Destroy;
- begin
- if Assigned(FArray) then
- FreeMem(FArray, sizeof(TOvcCellAddress) * FLimit);
- end;
-{--------}
-procedure TOvcCellArray.AddCell(RowNum : TRowNum; ColNum : TColNum);
- var
- NewLimit : Integer;
- L, R, M : Integer;
- NewArray : pointer;
- MCell : TOvcCellAddress;
- begin
- {grow array if required}
- if (FCount = FLimit) then
- begin
- NewLimit := FLimit + 128;
- GetMem(NewArray, sizeof(TOvcCellAddress) * NewLimit);
- if Assigned(FArray) then
- begin
- Move(FArray^, NewArray^, sizeof(TOvcCellAddress) * FLimit);
- FreeMem(FArray, sizeof(TOvcCellAddress) * FLimit);
- end;
- FLimit := NewLimit;
- FArray := NewArray;
- end;
- {do special case, er, specially}
- if (FCount = 0) then
- begin
- with POvcCellArrayPrim(FArray)^[0] do
- begin
- Row := RowNum;
- Col := ColNum;
- end;
- FCount := 1;
- Exit;
- end;
- {binary search through array, insert in order}
- L := 0;
- R := pred(FCount);
- repeat
- M := (L + R) div 2;
- MCell := POvcCellArrayPrim(FArray)^[M];
- if (RowNum = MCell.Row) then
- if (ColNum = MCell.Col) then
- Exit {nothing to do-already present}
- else if (ColNum < MCell.Col) then
- R := M - 1
- else
- L := M + 1
- else if (RowNum < MCell.Row) then
- R := M - 1
- else
- L := M + 1;
- until (L > R);
- {insert at L}
- if (L < FCount) then
- Move(POvcCellArrayPrim(FArray)^[L],
- POvcCellArrayPrim(FArray)^[L+1],
- sizeof(TOvcCellAddress)*(FCount-L));
- with POvcCellArrayPrim(FArray)^[L] do
- begin
- Row := RowNum;
- Col := ColNum;
- end;
- inc(FCount);
- end;
-{--------}
-procedure TOvcCellArray.AddUnusedBit;
- begin
- DoUnusedBit := true;
- end;
-{--------}
-procedure TOvcCellArray.Clear;
- begin
- FCount := 0;
- DoUnusedBit := false;
- end;
-{--------}
-function TOvcCellArray.DeleteCell(RowNum : TRowNum; ColNum : TColNum) : boolean;
- var
- L, R, M : Integer;
- MCell : TOvcCellAddress;
- begin
- Result := false;
- {do special case, er, specially}
- if (FCount = 0) then
- Exit;
- {binary search through array}
- L := 0;
- R := pred(FCount);
- repeat
- M := (L + R) div 2;
- MCell := POvcCellArrayPrim(FArray)^[M];
- if (RowNum = MCell.Row) then
- if (ColNum = MCell.Col) then
- begin
- {got it}
- dec(FCount);
- if (FCount > M) then
- Move(POvcCellArrayPrim(FArray)^[M+1],
- POvcCellArrayPrim(FArray)^[M],
- sizeof(TOvcCellAddress)*(FCount-M));
- Result := true;
- Exit;
- end
- else if (ColNum < MCell.Col) then
- R := M - 1
- else
- L := M + 1
- else if (RowNum < MCell.Row) then
- R := M - 1
- else
- L := M + 1;
- until (L > R);
- end;
-{--------}
-procedure TOvcCellArray.GetCellAddr(Inx : Integer; var CellAddr : TOvcCellAddress);
- begin
- if (0 <= Inx) and (Inx < FCount) then
- CellAddr := POvcCellArrayPrim(FArray)^[Inx]
- else
- FillChar(CellAddr, sizeof(CellAddr), 0);
- end;
-{--------}
-function TOvcCellArray.GetEmpty : boolean;
- begin
- Result := (Count = 0) and (not DoUnusedBit);
- end;
-{--------}
-procedure TOvcCellArray.Merge(CA : TOvcCellArray);
- var
- NewA : POvcCellArrayPrim;
- InxMerge : integer;
- InxSelf : integer;
- InxCA : integer;
- CellSelf : TOvcCellAddress;
- CellCA : TOvcCellAddress;
- NewLimit : integer;
- MergeNum : integer;
- i : integer;
- begin
- {if both cell arrays are empty, there's nothing to do}
- if (Count = 0) and (CA.Count = 0) then
- Exit;
- {make a new array at least as large as both arrays put together}
- NewLimit := ((Count + CA.Count) + 127) and $7FFFFF80;
- GetMem(NewA, sizeof(TOvcCellAddress) * NewLimit);
- {prepare for the loop}
- InxMerge := 0;
- InxSelf := 0;
- InxCA := 0;
- if (Count > 0) then
- CellSelf := POvcCellArrayPrim(FArray)^[0];
- if (CA.Count > 0) then
- CellCA := POvcCellArrayPrim(CA.FArray)^[0];
- {loop until one (or both) of the arrays is exhausted}
- while (InxSelf < Count) and (InxCA < CA.Count) do
- begin
- if (CellSelf.Row < CellCA.Row) then
- MergeNum := 1
- else if (CellSelf.Row > CellCA.Row) then
- MergeNum := 2
- else {CellSelf.Row = CellCA.Row}
- if (CellSelf.Col < CellCA.Col) then
- MergeNum := 1
- else if (CellSelf.Col > CellCA.Col) then
- MergeNum := 2
- else {both rows & cols equal}
- MergeNum := 0;
- case MergeNum of
- 0 : begin {equal}
- NewA^[InxMerge] := CellSelf;
- inc(InxMerge);
- inc(InxSelf);
- if (InxSelf < Count) then
- CellSelf := POvcCellArrayPrim(FArray)^[InxSelf];
- inc(InxCA);
- if (InxCA < CA.Count) then
- CellCA := POvcCellArrayPrim(CA.FArray)^[InxCA];
- end;
- 1 : begin
- NewA^[InxMerge] := CellSelf;
- inc(InxMerge);
- inc(InxSelf);
- if (InxSelf < Count) then
- CellSelf := POvcCellArrayPrim(FArray)^[InxSelf];
- end;
- 2 : begin
- NewA^[InxMerge] := CellCA;
- inc(InxMerge);
- inc(InxCA);
- if (InxCA < CA.Count) then
- CellCA := POvcCellArrayPrim(CA.FArray)^[InxCA];
- end;
- end;{case}
- end;
- {after this loop one (or both) of the input merge streams has been
- exhausted; copy the remaining elements from the other}
- if (InxSelf = Count) then {self array exhausted}
- for i := InxCA to pred(CA.Count) do
- begin
- NewA^[InxMerge] := POvcCellArrayPrim(CA.FArray)^[i];
- inc(InxMerge);
- end
- else if (InxCA = CA.Count) then {CA array exhausted}
- for i := InxSelf to pred(Count) do
- begin
- NewA^[InxMerge] := POvcCellArrayPrim(FArray)^[i];
- inc(InxMerge);
- end;
- {all merged, replace the current array with the merged array}
- FreeMem(FArray, sizeof(TOvcCellAddress) * FLimit);
- FArray := NewA;
- FLimit := NewLimit;
- FCount := InxMerge;
- end;
-{--------}
-function TOvcCellArray.MustDoUnusedBit : boolean;
- begin
- Result := DoUnusedBit;
- end;
-{====================================================================}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovctcbef.pas b/Source/3rdParty/Orpheus/ovctcbef.pas
deleted file mode 100644
index c3a4fb7e..00000000
--- a/Source/3rdParty/Orpheus/ovctcbef.pas
+++ /dev/null
@@ -1,585 +0,0 @@
-{*********************************************************}
-{* OVCTCBEF.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 ovctcbef;
- {-Orpheus Table Cell - base entry field type}
-
-interface
-
-uses
- SysUtils, Classes,
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, LclType, MyMisc, {$ENDIF}
- Graphics, Controls, Forms,
- OvcBase, OvcCmd, OvcEF, OvcCaret, OvcTCmmn, OvcTCell, OvcTable, OvcTCStr;
-
-type
- TOvcTCBaseEntryField = class(TOvcTCBaseString)
- protected {private}
- FEdit : TOvcBaseEntryField;
- FEditDisplay : TOvcBaseEntryField;
-
- FOnError : TValidationErrorEvent;
- FOnUserCommand : TUserCommandEvent;
- FOnUserValidation : TUserValidationEvent;
-
- CopyOfData : pointer;
- CopyOfDataSize : Integer;
-
- protected
- function GetCaretIns : TOvcCaret;
- function GetCaretOvr : TOvcCaret;
- function GetControlCharColor : TColor;
- function GetDataSize : integer;
- function GetDecimalPlaces : byte;
- function GetOptions : TOvcEntryFieldOptions;
- function GetEFColors : TOvcEFColors;
- function GetMaxLength : word;
- function GetModified : boolean;
- function GetPadChar : AnsiChar;
- function GetPasswordChar : AnsiChar;
- function GetRangeHi : string;
- function GetRangeLo : string;
- function GetTextMargin : integer;
-
- procedure SetCaretIns(CI : TOvcCaret);
- procedure SetCaretOvr(CO : TOvcCaret);
- procedure SetControlCharColor(CCC : TColor);
- procedure SetDecimalPlaces(DP : byte);
- procedure SetEFColors(Value : TOvcEFColors);
- procedure SetMaxLength(ML : word);
- procedure SetOptions(Value : TOvcEntryFieldOptions);
- procedure SetPadChar(PC : AnsiChar);
- procedure SetPasswordChar(PC : AnsiChar);
- procedure SetRangeHi(const RI : string);
- procedure SetRangeLo(const RL : string);
- procedure SetTextMargin(TM : integer);
-
- procedure DefineProperties(Filer: TFiler); override;
-
- procedure tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer); override;
-
- {properties for entry fields, to be exposed by descendants}
- property CaretIns : TOvcCaret
- read GetCaretIns write SetCaretIns;
-
- property CaretOvr : TOvcCaret
- read GetCaretOvr write SetCaretOvr;
-
- property ControlCharColor : TColor
- read GetControlCharColor write SetControlCharColor;
-
- property DecimalPlaces : byte
- read GetDecimalPlaces write SetDecimalPlaces;
-
- property EFColors : TOvcEFColors
- read GetEFColors write SetEFColors;
-
- property MaxLength : word
- read GetMaxLength write SetMaxLength;
-
- property Options : TOvcEntryFieldOptions
- read GetOptions write SetOptions;
-
- property PadChar : AnsiChar
- read GetPadChar write SetPadChar;
-
- property PasswordChar : AnsiChar
- read GetPasswordChar write SetPasswordChar;
-
- property RangeHi : string
- read GetRangeHi write SetRangeHi
- stored false;
-
- property RangeLo : string
- read GetRangeLo write SetRangeLo
- stored false;
-
- property TextMargin : integer
- read GetTextMargin write SetTextMargin;
-
- {events}
- property OnError : TValidationErrorEvent
- read FOnError write FOnError;
-
- property OnUserCommand : TUserCommandEvent
- read FOnUserCommand write FOnUserCommand;
-
- property OnUserValidation : TUserValidationEvent
- read FOnUserValidation write FOnUserValidation;
-
- public
- constructor Create(AOwner : TComponent); override;
- destructor Destroy;
- override;
- function CreateEntryField(AOwner : TComponent) : TOvcBaseEntryField; virtual; abstract;
-
- function EditHandle : THandle; override;
- procedure EditHide; override;
- procedure EditMove(CellRect : TRect); override;
-
- function CanSaveEditedData(SaveValue : boolean) : boolean; override;
- procedure SaveEditedData(Data : pointer); override;
- procedure StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer); override;
- procedure StopEditing(SaveValue : boolean;
- Data : pointer); override;
-
- property DataSize : integer
- read GetDataSize;
-
- property Modified : boolean
- read GetModified;
-
- published
- property About;
- end;
-
-implementation
-
-uses
- Dialogs;
-
-type {for typecast to get around protected clause}
- TOvcBEF = class(TOvcBaseEntryField)
- public
- property CaretIns;
- property CaretOvr;
- property ControlCharColor;
- property DecimalPlaces;
- property EFColors;
- property MaxLength;
- property Options;
- property PadChar;
- property PasswordChar;
- property RangeHi;
- property RangeLo;
- property ShowHint;
- property TextMargin;
- end;
-
-{===TOvcTCBaseEntryField=============================================}
-constructor TOvcTCBaseEntryField.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
-
- FEdit := CreateEntryField(Self);
- FEdit.Visible := false;
-
- FEditDisplay := CreateEntryField(Self);
- FEditDisplay.Visible := false;
- end;
-
-destructor TOvcTCBaseEntryField.Destroy;
-begin
- if (CopyOfData <> nil) and (CopyOfDataSize > 0) then
- FreeMem(CopyOfData, CopyOfDataSize);
-
- inherited Destroy;
-end;
-
-{--------}
-function TOvcTCBaseEntryField.CanSaveEditedData(SaveValue : boolean) : boolean;
- begin
- Result := true;
- if Assigned(FEdit) then
- if SaveValue then
- with TOvcBEF(FEdit) do
- if Controller.ErrorPending then
- Result := false
- else
- Result := ValidateSelf
- else
- FEdit.Restore;
- end;
-{--------}
-function TOvcTCBaseEntryField.EditHandle : THandle;
- begin
- if Assigned(FEdit) then
- Result := FEdit.Handle
- else
- Result := 0;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.EditHide;
- begin
- if Assigned(FEdit) then
- with FEdit do
- begin
- SetWindowPos(FEdit.Handle, HWND_TOP,
- 0, 0, 0, 0,
- SWP_HIDEWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- end;
-
- end;
-{--------}
-procedure TOvcTCBaseEntryField.EditMove(CellRect : TRect);
- var
- EditHandle : HWND;
- begin
- if Assigned(FEdit) then
- begin
- EditHandle := FEdit.Handle;
- with CellRect do
- SetWindowPos(EditHandle, HWND_TOP,
- Left, Top, Right-Left, Bottom-Top,
- SWP_SHOWWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- InvalidateRect(EditHandle, nil, false);
- UpdateWindow(EditHandle);
-
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer);
- var
- S : ShortString;
- I : integer;
- begin
- if (Data = nil) then
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, Data)
- else
- begin
- FEditDisplay.Controller := TOvcTable(FTable).Controller;
- if (FEditDisplay.Controller = nil) then
- ShowMessage('NIL in tcPaint');
- FEditDisplay.Parent := FTable;
- SetWindowPos(FEditDisplay.Handle, HWND_TOP, 0, 0, 0, 0,
- SWP_HIDEWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- FEditDisplay.SetValue(Data^);
- S := Trim(FEditDisplay.DisplayString); // Inserted Trim
-(* TurboPower bug: this code trims string of white space, but in using I as
- index into string S doesn't check if I is in range of 1..Length(S),
- which can result in range-check error.
- I := 1;
- while (S[I] <= #32) do
- Inc(I);
- Delete(S, 1, I-1);
- I := Length(S);
- while (S[I] <= #32) do
- Dec(I);
- Delete(S, I+1, Length(S) - I);
-*)
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, @S);
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SaveEditedData(Data : pointer);
- begin
- if Assigned(Data) then
- begin
- FEdit.GetValue(CopyOfData^);
- Move(CopyOfData^, Data^, CopyOfDataSize);
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer);
- begin
- CopyOfDataSize := FEdit.DataSize;
- GetMem(CopyOfData, CopyOfDataSize);
- if (Data = nil) then
- FillChar(CopyOfData^, CopyOfDataSize, 0)
- else
- Move(Data^, CopyOfData^, CopyOfDataSize);
-
- with TOvcBEF(FEdit) do
- begin
- Parent := FTable;
- Font := CellAttr.caFont;
- Font.Color := CellAttr.caFontColor;
- Color := CellAttr.caColor;
- BorderStyle := bsNone;
- Ctl3D := false;
- case CellStyle of
- tesBorder : BorderStyle := bsSingle;
- tes3D : Ctl3D := true;
- end;{case}
- Left := CellRect.Left;
- Top := CellRect.Top;
- Width := CellRect.Right - CellRect.Left;
- Height := CellRect.Bottom - CellRect.Top;
- Hint := Self.Hint;
- ShowHint := Self.ShowHint;
- TabStop := false;
- Controller := TOvcTable(FTable).Controller;
- if (Controller = nil) then
- ShowMessage('NIL in StartEditing');
- SetValue(CopyOfData^);
- Visible := true;
-
- OnChange := Self.OnChange;
- OnClick := Self.OnClick;
- OnDblClick := Self.OnDblClick;
- OnDragDrop := Self.OnDragDrop;
- OnDragOver := Self.OnDragOver;
- OnEndDrag := Self.OnEndDrag;
- OnEnter := Self.OnEnter;
- OnError := Self.OnError;
- OnExit := Self.OnExit;
- OnKeyDown := Self.OnKeyDown;
- OnKeyPress := Self.OnKeyPress;
- OnKeyUp := Self.OnKeyUp;
- OnMouseDown := Self.OnMouseDown;
- OnMouseMove := Self.OnMouseMove;
- OnMouseUp := Self.OnMouseUp;
- OnUserCommand := Self.OnUserCommand;
- OnUserValidation := Self.OnUserValidation;
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.StopEditing(SaveValue : boolean;
- Data : pointer);
- begin
- if SaveValue and Assigned(Data) then
- begin
- FEdit.GetValue(CopyOfData^);
- Move(CopyOfData^, Data^, CopyOfDataSize);
- end;
- FreeMem(CopyOfData, CopyOfDataSize);
- CopyOfData := nil;
- CopyOfDataSize := 0;
- EditHide;
- end;
-{====================================================================}
-
-
-{===TOvcTCBaseEntryField property access=============================}
-procedure TOvcTCBaseEntryField.DefineProperties(Filer: TFiler);
- begin
- inherited DefineProperties(Filer);
- with Filer do
- begin
- DefineBinaryProperty('RangeHigh',
- TOvcBEF(FEdit).efReadRangeHi, TOvcBEF(FEdit).efWriteRangeHi, true);
- DefineBinaryProperty('RangeLow',
- TOvcBEF(FEdit).efReadRangeLo, TOvcBEF(FEdit).efWriteRangeLo, true);
- end;
- end;
-{--------}
-function TOvcTCBaseEntryField.GetOptions : TOvcEntryFieldOptions;
- begin
- if Assigned(FEdit) then
- Result := FEdit.Options
- else
- Result := [];
- end;
-function TOvcTCBaseEntryField.GetCaretIns : TOvcCaret;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).CaretIns
- else Result := nil;
- end;
-{--------}
-function TOvcTCBaseEntryField.GetCaretOvr : TOvcCaret;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).CaretOvr
- else Result := nil;
- end;
-{--------}
-function TOvcTCBaseEntryField.GetControlCharColor : TColor;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).ControlCharColor
- else Result := clRed;
- end;
-{--------}
-function TOvcTCBaseEntryField.GetDataSize : integer;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).DataSize
- else Result := 0;
- end ;
-{--------}
-function TOvcTCBaseEntryField.GetDecimalPlaces : byte;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).DecimalPlaces
- else Result := 0;
- end ;
-{--------}
-function TOvcTCBaseEntryField.GetEFColors : TOvcEFColors;
- begin
- Result := nil;
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).EFColors;
- end;
-{--------}
-function TOvcTCBaseEntryField.GetModified : boolean;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).Modified
- else Result := false;
- end ;
-{--------}
-function TOvcTCBaseEntryField.GetMaxLength : word;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).MaxLength
- else Result := 0;
- end;
-{--------}
-function TOvcTCBaseEntryField.GetPadChar : AnsiChar;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).PadChar
- else Result := ' ';
- end;
-{--------}
-function TOvcTCBaseEntryField.GetPasswordChar : AnsiChar;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).PasswordChar
- else Result := '*';
- end;
-{--------}
-function TOvcTCBaseEntryField.GetRangeHi : string;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).RangeHi
- else Result := '';
- end;
-{--------}
-function TOvcTCBaseEntryField.GetRangeLo : string;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).RangeLo
- else Result := '';
- end;
-{--------}
-function TOvcTCBaseEntryField.GetTextMargin : integer;
- begin
- if Assigned(FEdit) then
- Result := TOvcBEF(FEdit).TextMargin
- else Result := 0;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetCaretIns(CI : TOvcCaret);
- begin
- if Assigned(FEdit) then TOvcBEF(FEdit).CaretIns := CI;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetCaretOvr(CO : TOvcCaret);
- begin
- if Assigned(FEdit) then TOvcBEF(FEdit).CaretOvr := CO;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetControlCharColor(CCC : TColor);
- begin
- if Assigned(FEdit) then TOvcBEF(FEdit).ControlCharColor := CCC;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetDecimalPlaces(DP : byte);
- begin
- if Assigned(FEdit) then
- begin
- TOvcBEF(FEdit).DecimalPlaces := DP;
- TOvcBEF(FEditDisplay).DecimalPlaces := DP;
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetEFColors(Value : TOvcEFColors);
- begin
- if Assigned(FEdit) then
- TOvcBEF(FEdit).EFColors := Value;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetMaxLength(ML : word);
- begin
- if Assigned(FEdit) then begin
- TOvcBEF(FEdit).MaxLength := ML;
- TOvcBEF(FEditDisplay).MaxLength := ML;
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetOptions(Value : TOvcEntryFieldOptions);
- begin
- if Assigned(FEdit) then begin
- TOvcBEF(FEdit).Options := Value;
- TOvcBEF(FEditDisplay).Options := Value;
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetPadChar(PC : AnsiChar);
- begin
- if Assigned(FEdit) then
- begin
- TOvcBEF(FEdit).PadChar := PC;
- TOvcBEF(FEditDisplay).PadChar := PC;
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetPasswordChar(PC : AnsiChar);
- begin
- if Assigned(FEdit) then
- begin
- TOvcBEF(FEdit).PasswordChar := PC;
- TOvcBEF(FEditDisplay).PasswordChar := PC;
- end;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetRangeHi(const RI : string);
- begin
- if Assigned(FEdit) then TOvcBEF(FEdit).RangeHi := RI;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetRangeLo(const RL : string);
- begin
- if Assigned(FEdit) then TOvcBEF(FEdit).RangeLo := RL;
- end;
-{--------}
-procedure TOvcTCBaseEntryField.SetTextMargin(TM : integer);
- begin
- if Assigned(FEdit) then TOvcBEF(FEdit).TextMargin := TM;
- end;
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovctcbmp.pas b/Source/3rdParty/Orpheus/ovctcbmp.pas
deleted file mode 100644
index 2521709d..00000000
--- a/Source/3rdParty/Orpheus/ovctcbmp.pas
+++ /dev/null
@@ -1,274 +0,0 @@
-{*********************************************************}
-{* OVCTCBMP.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 ovctcbmp;
- {-Orpheus Table Cell - Bitmap type}
-
-interface
-
-uses
- SysUtils, Classes,
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, LclType, MyMisc, {$ENDIF}
- Graphics, OvcTCmmn, OvcTCell;
-
-type
- TOvcTCBaseBitMap = class(TOvcBaseTableCell)
- protected
- {.Z+}
- procedure tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer); override;
- {.Z-}
- public
- function EditHandle : THandle; override;
- procedure EditHide; override;
- procedure EditMove(CellRect : TRect); override;
- procedure SaveEditedData(Data : pointer); override;
- procedure StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer); override;
- procedure StopEditing(SaveValue : boolean;
- Data : pointer); override;
- end;
-
- TOvcTCCustomBitMap = class(TOvcTCBaseBitMap)
- protected
- {.Z+}
- procedure tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer); override;
- {.Z-}
- public
- {.Z+}
- procedure ResolveAttributes(RowNum : TRowNum; ColNum : TColNum;
- var CellAttr : TOvcCellAttributes); override;
- {.Z-}
- end;
-
- TOvcTCBitMap = class(TOvcTCCustomBitMap)
- published
- {properties inherited from custom ancestor}
- property AcceptActivationClick default False;
- property Access default otxDefault;
- property Adjust default otaDefault;
- property Color;
- property Margin default 4;
- property Table;
- property TableColor default True;
-
- property OnOwnerDraw;
- end;
-
-
-implementation
-
-
-{===TOvcTCBaseBitMap=================================================}
-procedure TOvcTCBaseBitMap.tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer);
- type
- LH = packed record cX, cY : word; end;
- var
- BMInfo : PCellBitMapInfo absolute Data;
- Wd, Ht : integer;
- DisplayWd : integer;
- DisplayHt : integer;
- CellWidth : integer;
- CellHeight : integer;
- SrcRect, DestRect : TRect;
- TransparentColor : TColor;
- CellAdj : TOvcTblAdjust;
- begin
- {blank out the cell (also sets the brush color)}
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, Data);
- {if there's no data, the index to the sub-bitmap is zero or
- the cell is invisible anyway, just exit}
- if (Data = nil) or
- (BMInfo^.Index = -1) or
- (CellAttr.caAccess = otxInvisible) then
- Exit;
- {make a note of the adjustment, and calc the cell width and height}
- CellAdj := CellAttr.caAdjust;
- CellWidth := CellRect.Right - CellRect.Left;
- CellHeight := CellRect.Bottom - CellRect.Top;
- {calculate data about the bitmap, including the source rectangle}
- with BMInfo^ do
- begin
- Wd := BM.Width;
- if (Count <= 1) then
- Index := 0
- else
- begin
- Wd := Wd div Count;
- if (Index >= Count) then
- Index := 0;
- end;
- Ht := BM.Height;
- DisplayWd := MinI(Wd, (CellWidth - 2*Margin));
- DisplayHt := MinI(Ht, (CellHeight - 2*Margin));
- with SrcRect do
- begin
- Left := Index * Wd;
- Right := Left + DisplayWd;
- Top := 0;
- Bottom := Top + DisplayHt;
- end;
- TransparentColor := BM.Canvas.Pixels[SrcRect.Left, Ht-1]
- end;
- {calculate the destination rectangle}
- with DestRect do
- begin
- case CellAdj of
- otaTopLeft, otaCenterLeft, otaBottomLeft :
- Left := Margin;
- otaTopRight, otaCenterRight, otaBottomRight :
- Left := (CellWidth - DisplayWd - Margin);
- else
- Left := (CellWidth - DisplayWd) div 2;
- end;{case}
- inc(Left, CellRect.Left);
- case CellAdj of
- otaTopLeft, otaTopCenter, otaTopRight :
- Top := Margin;
- otaBottomLeft, otaBottomCenter, otaBottomRight :
- Top := (CellHeight - DisplayHt - Margin);
- else
- Top := (CellHeight - DisplayHt) div 2;
- end;{case}
- inc(Top, CellRect.Top);
- Right := Left + DisplayWd;
- Bottom := Top + DisplayHt;
- end;
- {brush copy the bitmap onto the table}
-//{$IFNDEF LCL}
-// TableCanvas.BrushCopy(DestRect, BMInfo^.BM, SrcRect, TransparentColor);
-//{$ELSE}
- BrushCopy(TableCanvas, DestRect, BMInfo^.BM, SrcRect, TransparentColor);
-//{$ENDIF}
- end;
-
-function TOvcTCBaseBitMap.EditHandle : THandle;
-begin
- {stub out abstract method so BCB doesn't see this as an abstract class}
- Result := 0;
-end;
-
-procedure TOvcTCBaseBitMap.EditHide;
-begin
- {stub out abstract method so BCB doesn't see this as an abstract class}
-end;
-
-procedure TOvcTCBaseBitMap.EditMove(CellRect : TRect);
-begin
- {stub out abstract method so BCB doesn't see this as an abstract class}
-end;
-
-procedure TOvcTCBaseBitMap.SaveEditedData(Data : pointer);
-begin
- {stub out abstract method so BCB doesn't see this as an abstract class}
-end;
-
-procedure TOvcTCBaseBitMap.StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer);
-begin
- {stub out abstract method so BCB doesn't see this as an abstract class}
-end;
-
-procedure TOvcTCBaseBitMap.StopEditing(SaveValue : boolean;
- Data : pointer);
-begin
- {stub out abstract method so BCB doesn't see this as an abstract class}
-end;
-
-
-{====================================================================}
-
-{===TOvcTCCustomBitMap===============================================}
-procedure TOvcTCCustomBitMap.tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer);
- var
- BitMap : TBitmap absolute Data;
- BMInfo : TCellBitMapInfo;
- begin
- {if there's no bitmap, just let our ancestor deal with it}
- if (Data = nil) then
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, nil)
- {otherwise set up a bitmap info record, and let the ancestor paint it}
- else
- begin
- with BMInfo do
- begin
- BM := BitMap;
- Count := 1;
- ActiveCount := 1;
- Index := 0;
- end;
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, @BMInfo);
- end;
- end;
-{--------}
-procedure TOvcTCCustomBitMap.ResolveAttributes(RowNum : TRowNum; ColNum : TColNum;
- var CellAttr : TOvcCellAttributes);
- begin
- inherited ResolveAttributes(RowNum, ColNum, CellAttr);
- case CellAttr.caAccess of
- otxDefault, otxNormal : CellAttr.caAccess := otxReadOnly;
- end;{case}
- end;
-{====================================================================}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovctcbox.pas b/Source/3rdParty/Orpheus/ovctcbox.pas
deleted file mode 100644
index 72b5529a..00000000
--- a/Source/3rdParty/Orpheus/ovctcbox.pas
+++ /dev/null
@@ -1,224 +0,0 @@
-{*********************************************************}
-{* OVCTCBOX.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 ovctcbox;
- {-Orpheus Table Cell - Check box type}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, {$ENDIF}
- SysUtils, Graphics, Classes, Controls, StdCtrls,
- OvcTCmmn, OvcTCell, OvcTGRes, OvcTCGly;
-
-type
- TOvcTCCustomCheckBox = class(TOvcTCCustomGlyph)
- protected {private}
- {.Z+}
- FAllowGrayed : boolean;
-
- FatherValue : Integer;
- {.Z-}
-
- protected
- {.Z+}
- procedure SetAllowGrayed(AG : boolean);
-
- procedure GlyphsHaveChanged(Sender : TObject);
- procedure tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer); override;
- {.Z-}
-
- public
- constructor Create(AOwner : TComponent); override;
-
- function CanAssignGlyphs(CBG : TOvcCellGlyphs) : boolean; override;
-
- procedure SaveEditedData(Data : pointer); override;
- procedure StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer); override;
- procedure StopEditing(SaveValue : boolean;
- Data : pointer); override;
-
- property AllowGrayed : boolean
- read FAllowGrayed write SetAllowGrayed;
-
- end;
-
- TOvcTCCheckBox = class(TOvcTCCustomCheckBox)
- published
- {properties inherited from custom ancestor}
- property AcceptActivationClick default True;
- property Access default otxDefault;
- property Adjust default otaDefault;
- property AllowGrayed default False;
- property CellGlyphs;
- property Color;
- property Hint;
- property Margin default 4;
- property ShowHint default False;
- property Table;
- property TableColor default True;
-
- {events inherited from custom ancestor}
- property OnClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnOwnerDraw;
- end;
-
-implementation
-
-
-{===TOvcTCCustomCheckBox creation/destruction========================}
-constructor TOvcTCCustomCheckBox.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
- CellGlyphs.OnCfgChanged := nil;
- if (CellGlyphs.ActiveGlyphCount = 3) then
- CellGlyphs.ActiveGlyphCount := 2;
- CellGlyphs.OnCfgChanged := GlyphsHaveChanged;
- FAcceptActivationClick := true;
- end;
-{--------}
-procedure TOvcTCCustomCheckBox.SetAllowGrayed(AG : boolean);
- begin
- if AG <> FAllowGrayed then
- begin
- FAllowGrayed := AG;
- if AG then
- CellGlyphs.ActiveGlyphCount := 3
- else
- CellGlyphs.ActiveGlyphCount := 2;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-function TOvcTCCustomCheckBox.CanAssignGlyphs(CBG : TOvcCellGlyphs) : boolean;
- begin
- Result := CBG.GlyphCount = 3;
- end;
-{--------}
-procedure TOvcTCCustomCheckBox.GlyphsHaveChanged(Sender : TObject);
- begin
- CellGlyphs.OnCfgChanged := nil;
- if FAllowGrayed then
- CellGlyphs.ActiveGlyphCount := 3
- else
- CellGlyphs.ActiveGlyphCount := 2;
- CellGlyphs.OnCfgChanged := GlyphsHaveChanged;
- tcDoCfgChanged;
- end;
-{====================================================================}
-
-
-{===TOvcTCCustomCheckBox painting====================================}
-procedure TOvcTCCustomCheckBox.tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer);
- var
- B : ^TCheckBoxState absolute Data;
- Value : integer;
- begin
- if (Data = nil) then
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, nil)
- else
- begin
- Value := ord(B^);
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, @Value);
- end;
- end;
-{====================================================================}
-
-
-{===TOvcTCCheckBox editing===========================================}
-procedure TOvcTCCustomCheckBox.SaveEditedData(Data : pointer);
- begin
- if Assigned(Data) then
- begin
- inherited SaveEditedData(@FatherValue);
- TCheckBoxState(Data^) := TCheckBoxState(FatherValue);
- end;
- end;
-{--------}
-procedure TOvcTCCustomCheckBox.StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer);
- begin
- if (Data = nil) then
- inherited StartEditing(RowNum, ColNum,
- CellRect, CellAttr, CellStyle, nil)
- else
- begin
- FatherValue := Integer(TCheckBoxState(Data^));
- inherited StartEditing(RowNum, ColNum,
- CellRect, CellAttr, CellStyle, @FatherValue);
- end;
- end;
-{--------}
-procedure TOvcTCCustomCheckBox.StopEditing(SaveValue : boolean;
- Data : pointer);
- begin
- inherited StopEditing(SaveValue, @FatherValue);
- if SaveValue and Assigned(Data) then
- TCheckBoxState(Data^) := TCheckBoxState(FatherValue);
- end;
-{====================================================================}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovctccbx.pas b/Source/3rdParty/Orpheus/ovctccbx.pas
deleted file mode 100644
index a32b87ca..00000000
--- a/Source/3rdParty/Orpheus/ovctccbx.pas
+++ /dev/null
@@ -1,966 +0,0 @@
-{*********************************************************}
-{* OVCTCCBX.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}
-
-{$IFDEF VERSION6}
- {$IFNDEF LCL}
- {$WARN SYMBOL_DEPRECATED OFF}
- {$ENDIF}
-{$ENDIF}
-
-unit ovctccbx;
- {-Orpheus Table Cell - combo box type}
-
-interface
-
-uses
- SysUtils, Classes,
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Graphics, Controls, Forms, StdCtrls,
- OvcMisc, OvcTCmmn, OvcTCell, OvcTCStr;
-
-type
- TOvcTCComboBoxState = (otlbsUp, otlbsDown);
-
-type
- TOvcTCComboBoxEdit = class(TCustomComboBox)
- protected {private}
- {.Z+}
- FCell : TOvcBaseTableCell;
-
- EditField : HWnd;
- PrevEditWndProc : pointer;
- NewEditWndProc : pointer;
- {.Z-}
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
-
- protected
- {.Z+}
- procedure EditWindowProc(var Msg : TMessage);
- function FilterWMKEYDOWN(var Msg : TWMKey) : boolean;
-
- procedure CMRelease(var Message: TMessage); message CM_RELEASE;
-
- procedure WMChar(var Msg : TWMKey); message WM_CHAR;
- procedure WMGetDlgCode(var Msg : TMessage); message WM_GETDLGCODE;
- procedure WMKeyDown(var Msg : TWMKey); message WM_KEYDOWN;
- procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS;
- procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
- {.Z-}
-
- public
- constructor Create(AOwner : TComponent); override;
- destructor Destroy; override;
- procedure CreateWnd; override;
-
- property CellOwner : TOvcBaseTableCell
- read FCell write FCell;
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D;
-{$ENDIF}
- end;
-
- TOvcTCCustomComboBox = class(TOvcTCBaseString)
- protected {private}
- {.Z+}
- {property fields - even size}
- FDropDownCount : Integer;
- FEdit : TOvcTCComboBoxEdit;
- FItems : TStrings;
- FMaxLength : Word;
-
- {property fields - odd size}
- FStyle : TComboBoxStyle;
- FAutoAdvanceChar : Boolean;
- FAutoAdvanceLeftRight : Boolean;
- FHideButton : Boolean;
- FSaveStringValue : boolean;
- FSorted : Boolean;
- FShowArrow : Boolean;
- FUseRunTimeItems : Boolean;
-
- {events}
- FOnChange : TNotifyEvent;
- FOnDropDown : TNotifyEvent;
- FOnDrawItem : TDrawItemEvent;
- FOnMeasureItem : TMeasureItemEvent;
- {.Z-}
-
- protected
- {.Z+}
- function GetCellEditor : TControl; override;
-
- procedure SetShowArrow(Value : Boolean);
- procedure SetItems(I : TStrings);
- procedure SetSorted(S : boolean);
-
- procedure DrawArrow(Canvas : TCanvas;
- const CellRect : TRect;
- const CellAttr : TOvcCellAttributes);
- procedure DrawButton(Canvas : TCanvas;
- const CellRect : TRect);
-
- procedure tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer); override;
- {.Z-}
-
- {properties}
- property AutoAdvanceChar : boolean
- read FAutoAdvanceChar write FAutoAdvanceChar;
- property AutoAdvanceLeftRight : boolean
- read FAutoAdvanceLeftRight write FAutoAdvanceLeftRight;
- property DropDownCount : Integer
- read FDropDownCount write FDropDownCount;
- property HideButton : Boolean
- read FHideButton write FHideButton;
- property Items : TStrings
- read FItems write SetItems;
- property MaxLength : word
- read FMaxLength write FMaxLength;
- property SaveStringValue : boolean
- read FSaveStringValue write FSaveStringValue;
- property Sorted : boolean
- read FSorted write SetSorted;
- property ShowArrow : Boolean
- read FShowArrow write SetShowArrow;
- property Style : TComboBoxStyle
- read FStyle write FStyle;
- property UseRunTimeItems : boolean
- read FUseRunTimeItems write FUseRunTimeItems;
-
- {events}
- property OnChange : TNotifyEvent
- read FOnChange write FOnChange;
- property OnDropDown: TNotifyEvent
- read FOnDropDown write FOnDropDown;
- property OnDrawItem: TDrawItemEvent
- read FOnDrawItem write FOnDrawItem;
- property OnMeasureItem: TMeasureItemEvent
- read FOnMeasureItem write FOnMeasureItem;
-
- public
- constructor Create(AOwner : TComponent); override;
- destructor Destroy; override;
- function CreateEditControl : TOvcTCComboBoxEdit; virtual;
-
- function EditHandle : THandle; override;
- procedure EditHide; override;
- procedure EditMove(CellRect : TRect); override;
-
- procedure SaveEditedData(Data : pointer); override;
- procedure StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer); override;
- procedure StopEditing(SaveValue : boolean;
- Data : pointer); override;
- end;
-
- TOvcTCComboBox = class(TOvcTCCustomComboBox)
- published
- property AcceptActivationClick default True;
- property Access default otxDefault;
- property Adjust default otaDefault;
- property AutoAdvanceChar default False;
- property AutoAdvanceLeftRight default False;
- property Color;
- property DropDownCount default 8;
- property Font;
- property HideButton default False;
- property Hint;
- property Items;
- property ShowHint default False;
- property Margin default 4;
- property MaxLength default 0;
- property SaveStringValue default False;
- property ShowArrow default False;
- property Sorted default False;
- property Style default csDropDown;
- property Table;
- property TableColor default True;
- property TableFont default True;
- property TextHiColor default clBtnHighlight;
- property TextStyle default tsFlat;
- property UseRunTimeItems default False;
-
- {events inherited from custom ancestor}
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnDrawItem;
- property OnDropDown;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMeasureItem;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnOwnerDraw;
- end;
-
-
-var
- OvcComboBoxBitmap : TBitmap;
- OvcComboBoxButtonWidth : Integer;
-
-implementation
-
-const
- ComboBoxHeight = 24;
-
-var
- ComboBoxResourceCount : longint = 0;
-
-// Workaround for lack of MakeObjectInstance in LCL for making
-// WindowProc callback function from object method.
-// Note: Not using: function appears to work with Win32, but
-// crash when object destroyed. Doesn't work with GTK.
-{$IFDEF LCL}
-function LclEditWindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM) : LRESULT; stdcall;
-var
- CbEdit : TWinControl;
- AMsg : TMessage;
-begin
- CbEdit := FindOwnerControl(hWnd);
- AMsg.Msg := Msg;
- AMsg.WParam := wParam;
- AMsg.LParam := lParam;
- TOvcTCComboBoxEdit(CbEdit).EditWindowProc(AMsg);
-// Result := AMsg.Result;
-end;
-{$ENDIF}
-
-{===TOvcTCComboBoxEdit================================================}
-constructor TOvcTCComboBoxEdit.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
-{$IFNDEF LCL}
- NewEditWndProc := MakeObjectInstance(EditWindowProc);
-{$ELSE}
-// NewEditWndProc := @LclEditWindowProc;
-{$ENDIF}
- end;
-{--------}
-destructor TOvcTCComboBoxEdit.Destroy;
- begin
- if (Style = csDropDown) or (Style = csSimple) then
- SetWindowLong(EditField, GWL_WNDPROC, longint(PrevEditWndProc));
-{$IFNDEF LCL}
- FreeObjectInstance(NewEditWndProc);
-{$ENDIF}
- inherited Destroy;
- end;
-{--------}
-procedure TOvcTCComboBoxEdit.CreateWnd;
- begin
- inherited CreateWnd;
-
- if (Style = csDropDown) or (Style = csSimple) then
- begin
- EditField := GetWindow(Handle, GW_CHILD);
- if (Style = csSimple) then
- EditField := GetWindow(EditField, GW_HWNDNEXT);
- PrevEditWndProc := pointer(GetWindowLong(EditField, GWL_WNDPROC));
-{$IFNDEF LCL}
- SetWindowLong(EditField, GWL_WNDPROC, longint(NewEditWndProc));
-{$ENDIF}
- end;
- end;
-{--------}
-procedure TOvcTCComboBoxEdit.EditWindowProc(var Msg : TMessage);
- var
- GridUsedIt : boolean;
- KeyMsg : TWMKey absolute Msg;
- begin
- GridUsedIt := false;
- if (Msg.Msg = WM_KEYDOWN) then
- GridUsedIt := FilterWMKEYDOWN(KeyMsg)
- else if (Msg.Msg = WM_CHAR) then
- if (KeyMsg.CharCode = 9) or
- (KeyMsg.CharCode = 13) or
- (KeyMsg.CharCode = 27) then
- GridUsedIt := true;
- if not GridUsedIt then
- with Msg do
- Result := CallWindowProc(PrevEditWndProc, EditField, Msg, wParam, lParam);
- end;
-{--------}
-function TOvcTCComboBoxEdit.FilterWMKEYDOWN(var Msg : TWMKey) : boolean;
- procedure GetSelection(var S, E : word);
- type
- LH = packed record L, H : word; end;
- var
- GetSel : longint;
- begin
- GetSel := SendMessage(EditField, EM_GETSEL, 0, 0);
- S := LH(GetSel).L;
- E := LH(GetSel).H;
- end;
- var
- GridReply : TOvcTblKeyNeeds;
- SStart, SEnd : word;
- GridUsedIt : boolean;
- PassIton : boolean;
- begin
- GridUsedIt := false;
- GridReply := otkDontCare;
- if (CellOwner <> nil) then
- GridReply := CellOwner.FilterTableKey(Msg);
- case GridReply of
- otkMustHave :
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- otkWouldLike :
- begin
- PassItOn := false;
- case Msg.CharCode of
- VK_LEFT :
- begin
- case Style of
- csDropDown, csSimple :
- if TOvcTCCustomComboBox(CellOwner).AutoAdvanceLeftRight then
- begin
- GetSelection(SStart, SEnd);
- if (SStart = SEnd) and (SStart = 0) then
- PassItOn := true;
- end;
- else
- PassItOn := true;
- end;{case}
- end;
- VK_RIGHT :
- begin
- case Style of
- csDropDown, csSimple :
- if TOvcTCCustomComboBox(CellOwner).AutoAdvanceLeftRight then
- begin
- GetSelection(SStart, SEnd);
- if ((SStart = SEnd) or (SStart = 0)) and
- (SEnd = GetTextLen) then
- PassItOn := true;
- end;
- else
- PassItOn := true;
- end;{case}
- end;
- end;{case}
- if PassItOn then
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;
- end;{case}
- Result := GridUsedIt;
- end;
-{--------}
-
-
- procedure TOvcTCComboBoxEdit.CMRelease(var Message: TMessage);
- begin
- Free;
- end;
-
- procedure TOvcTCComboBoxEdit.WMChar(var Msg : TWMKey);
- var
- CurText : string;
- begin
- inherited;
- if TOvcTCCustomComboBox(CellOwner).AutoAdvanceChar then
- begin
- CurText := Text;
- if (length(CurText) >= MaxLength) then
- begin
- FillChar(Msg, sizeof(Msg), 0);
- with Msg do
- begin
- Msg := WM_KEYDOWN;
- CharCode := VK_RIGHT;
- end;
- CellOwner.SendKeyToTable(Msg);
- end;
- end;
- end;
-{--------}
-procedure TOvcTCComboBoxEdit.WMGetDlgCode(var Msg : TMessage);
- begin
- inherited;
- if CellOwner.TableWantsTab then
- Msg.Result := Msg.Result or DLGC_WANTTAB;
- end;
-{--------}
-procedure TOvcTCComboBoxEdit.WMKeyDown(var Msg : TWMKey);
- var
- GridUsedIt : boolean;
- begin
- if (Style <> csDropDown) and (Style <> csSimple) then
- begin
- GridUsedIt := FilterWMKEYDOWN(Msg);
- if not GridUsedIt then
- inherited;
- end
- else
- inherited;
- end;
-{--------}
-procedure TOvcTCComboBoxEdit.WMKillFocus(var Msg : TWMKillFocus);
- begin
- inherited;
- {ComboBox posts cbn_killfocus message to table}
- end;
-{--------}
-procedure TOvcTCComboBoxEdit.WMSetFocus(var Msg : TWMSetFocus);
- begin
- inherited;
- CellOwner.PostMessageToTable(ctim_SetFocus, Msg.FocusedWnd, 0);
- end;
-{====================================================================}
-
-
-{===TOvcTCCustomComboBox=============================================}
-constructor TOvcTCCustomComboBox.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
- FItems := TStringList.Create;
- FDropDownCount := 8;
- if (ComboBoxResourceCount = 0) then
- begin
- OvcComboBoxBitmap := TBitMap.Create;
-{$IFNDEF LCL}
- OvcComboBoxBitmap.Handle := LoadBaseBitMap('ORTCCOMBOARROW');
-{$ELSE}
- OvcComboBoxBitmap.LoadFromLazarusResource('ORTCCOMBOARROW');
-{$ENDIF}
- OvcComboBoxButtonWidth := OvcComboBoxBitmap.Width + 11;
- end;
- inc(ComboBoxResourceCount);
- FAcceptActivationClick := true;
- FShowArrow := False;
- FHideButton := False;
- end;
-{--------}
-destructor TOvcTCCustomComboBox.Destroy;
- begin
- FItems.Free;
- dec(ComboBoxResourceCount);
- if (ComboBoxResourceCount = 0) then
- OvcComboBoxBitmap.Free;
- inherited Destroy;
- end;
-{--------}
-function TOvcTCCustomComboBox.CreateEditControl : TOvcTCComboBoxEdit;
- begin
- Result := TOvcTCComboBoxEdit.Create(FTable);
- end;
-{--------}
-procedure TOvcTCCustomComboBox.DrawArrow(Canvas : TCanvas;
- const CellRect : TRect;
- const CellAttr : TOvcCellAttributes);
- var
- ArrowDim : Integer;
- X, Y : Integer;
- LeftPoint, RightPoint, BottomPoint : TPoint;
-{$IFNDEF LCL}
- Width : integer;
- Height : integer;
-{$ELSE} //LCL TCanvas has Width and Height properties
- AWidth : integer;
- AHeight : integer;
-{$ENDIF}
- R : TRect;
- begin
- R := CellRect;
- R.Left := R.Right - OvcComboBoxButtonWidth;
-{$IFNDEF LCL}
- Width := R.Right - R.Left;
- Height := R.Bottom - R.Top;
-{$ELSE}
- AWidth := R.Right - R.Left;
- AHeight := R.Bottom - R.Top;
-{$ENDIF}
- with Canvas do
- begin
- Brush.Color := CellAttr.caColor;
- FillRect(R);
- Pen.Color := CellAttr.caFont.Color;
- Brush.Color := Pen.Color;
-{$IFNDEF LCL}
- ArrowDim := MinI(Width, Height) div 3;
- X := R.Left + (Width - ArrowDim) div 2;
- Y := R.Top + (Height - ArrowDim) div 2;
-{$ELSE}
- ArrowDim := MinI(AWidth, AHeight) div 3;
- X := R.Left + (AWidth - ArrowDim) div 2;
- Y := R.Top + (AHeight - ArrowDim) div 2;
-{$ENDIF}
- LeftPoint := Point(X, Y);
- RightPoint := Point(X+ArrowDim, Y);
- BottomPoint := Point(X+(ArrowDim div 2), Y+ArrowDim);
- Polygon([LeftPoint, RightPoint, BottomPoint]);
- end;
- end;
-{--------}
-procedure TOvcTCCustomComboBox.DrawButton(Canvas : TCanvas;
- const CellRect : TRect);
- var
- EffCellWidth : Integer;
- Wd, Ht : Integer;
- TopPixel : Integer;
- BotPixel : Integer;
- LeftPixel : Integer;
- RightPixel : Integer;
- SrcRect : TRect;
- DestRect : TRect;
- begin
- {Calculate the effective cell width (the cell width less the size
- of the button)}
- EffCellWidth := CellRect.Right - CellRect.Left - OvcComboBoxButtonWidth;
-
- {Calculate the black border's rectangle}
- LeftPixel := CellRect.Left + EffCellWidth;
- RightPixel := CellRect.Right - 1;
- TopPixel := CellRect.Top + 1;
- BotPixel := CellRect.Bottom - 1;
-
- {Paint the button}
- with Canvas do
- begin
- {FIRST: paint the black border around the button}
- Pen.Color := clBlack;
- Pen.Width := 1;
- Brush.Color := clBtnFace;
- {Note: Rectangle excludes the Right and bottom pixels}
- Rectangle(LeftPixel, TopPixel, RightPixel, BotPixel);
- {SECOND: paint the highlight border on left/top sides}
- {decrement drawing area}
- inc(TopPixel);
- dec(BotPixel);
- inc(LeftPixel);
- dec(RightPixel);
- {Note: PolyLine excludes the end points of a line segment,
- but since the end points are generally used as the
- starting point of the next we must adjust for it.}
- Pen.Color := clBtnHighlight;
- PolyLine([Point(RightPixel-1, TopPixel),
- Point(LeftPixel, TopPixel),
- Point(LeftPixel, BotPixel)]);
- {THIRD: paint the highlight border on bottom/right sides}
- Pen.Color := clBtnShadow;
- PolyLine([Point(LeftPixel, BotPixel-1),
- Point(RightPixel-1, BotPixel-1),
- Point(RightPixel-1, TopPixel-1)]);
- inc(TopPixel);
- dec(BotPixel);
- inc(LeftPixel);
- dec(RightPixel);
- PolyLine([Point(LeftPixel, BotPixel-1),
- Point(RightPixel-1, BotPixel-1),
- Point(RightPixel-1, TopPixel-1)]);
- {THIRD: paint the arrow bitmap}
- Wd := OvcComboBoxBitmap.Width;
- Ht := OvcComboBoxBitmap.Height;
- SrcRect := Rect(0, 0, Wd, Ht);
- with DestRect do
- begin
- Left := CellRect.Left + EffCellWidth + 5;
- Top := CellRect.Top +
- ((CellRect.Bottom - CellRect.Top - Ht) div 2);
- Right := Left + Wd;
- Bottom := Top + Ht;
- end;
-//{$IFNDEF LCL}
- BrushCopy(DestRect, OvcComboBoxBitmap, SrcRect, clSilver);
-//{$ELSE}
-// BrushCopy(Canvas, DestRect, OvcComboBoxBitmap, SrcRect, clSilver);
-//{$ENDIF}
- end;
- end;
-{--------}
-function TOvcTCCustomComboBox.EditHandle : THandle;
- begin
- if Assigned(FEdit) then
- Result := FEdit.Handle
- else
- Result := 0;
- end;
-{--------}
-procedure TOvcTCCustomComboBox.EditHide;
- begin
- if Assigned(FEdit) then
- with FEdit do
- begin
- SetWindowPos(FEdit.Handle, HWND_TOP,
- 0, 0, 0, 0,
- SWP_HIDEWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- end;
- end;
-{--------}
-procedure TOvcTCCustomComboBox.EditMove(CellRect : TRect);
- var
- EditHandle : HWND;
- NewTop : Integer;
- begin
- if Assigned(FEdit) then
- begin
- EditHandle := FEdit.Handle;
- with CellRect do
- begin
- NewTop := Top;
- if FEdit.Ctl3D then
- InflateRect(CellRect, -1, -1);
- SetWindowPos(EditHandle, HWND_TOP,
- Left, NewTop, Right-Left, ComboBoxHeight,
- SWP_SHOWWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- end;
- InvalidateRect(EditHandle, nil, false);
- UpdateWindow(EditHandle);
- end;
- end;
-
-function TOvcTCCustomComboBox.GetCellEditor : TControl;
-begin
- Result := FEdit;
-end;
-
-procedure TOvcTCCustomComboBox.tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer);
-var
- ItemRec : PCellComboBoxInfo absolute Data;
- ActiveRow : TRowNum;
- ActiveCol : TColNum;
- R : TRect;
- S : ShortString;
- OurItems : TStrings;
-begin
- {Note: Data is a pointer to an integer, or to an integer and a
- shortstring. The first is used for drop down ListBoxes
- (only) and the latter with simple and drop down combo boxes}
-
- {If the cell is invisible let the ancestor to all the work}
- if (CellAttr.caAccess = otxInvisible) then begin
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, nil);
- Exit;
- end;
-
- {If we have valid data, get the string to display from the stringlist
- or from the Data pointer. }
- S := '';
- if (Data <> nil) then begin
- if UseRunTimeItems then
- OurItems := ItemRec^.RTItems
- else
- OurItems := Items;
- if (0 <= ItemRec^.Index) and (ItemRec^.Index < OurItems.Count) then
- S := OurItems[ItemRec^.Index]
- else if (Style = csDropDown) or (Style = csSimple) then begin
- if UseRunTimeItems then
- {$IFDEF CBuilder}
- S := StrPas(ItemRec^.RTSt)
- {$ELSE}
- S := ItemRec^.RTSt
- {$ENDIF}
- else
- {$IFDEF CBuilder}
- S := StrPas(ItemRec^.St);
- {$ELSE}
- S := ItemRec^.St;
- {$ENDIF}
- end;
- end
- {Otherwise, mock up a string in design mode.}
- else if (csDesigning in ComponentState) and (Items.Count > 0) then
- S := Items[RowNum mod Items.Count];
-
- ActiveRow := tcRetrieveTableActiveRow;
- ActiveCol := tcRetrieveTableActiveCol;
- {Calculate the effective cell width (the cell width less the size of the button)}
- R := CellRect;
- dec(R.Right, OvcComboBoxButtonWidth);
- if (ActiveRow = RowNum) and (ActiveCol = ColNum) then begin
- if FHideButton then begin
- {let ancestor paint the text}
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, @S);
- end else begin
- {Paint the string in the restricted rectangle}
- inherited tcPaint(TableCanvas, R, RowNum, ColNum, CellAttr, @S);
- {Paint the button on the right side}
- DrawButton(TableCanvas, CellRect);
- end;
- end else if FShowArrow then begin
- {paint the string in the restricted rectangle}
- inherited tcPaint(TableCanvas, R, RowNum, ColNum, CellAttr, @S);
- {Paint the arrow on the right side}
- DrawArrow(TableCanvas, CellRect, CellAttr);
- end else
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, @S);
-
-(*
- {Are we just displaying a button on the active cell?}
- if not FHideButton then begin
- {If we are not the active cell, let the ancestor do the painting (we only
- paint a button when the cell is the active one)}
- if (ActiveRow <> RowNum) or (ActiveCol <> ColNum) then begin
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, @S);
- Exit;
- end;
- {Calculate the effective cell width (the cell width less the size
- of the button)}
- R := CellRect;
- dec(R.Right, OvcComboBoxButtonWidth);
- {Paint the string in this restricted rectangle}
- inherited tcPaint(TableCanvas, R, RowNum, ColNum, CellAttr, @S);
- {Paint the button on the right side}
- DrawButton(TableCanvas, CellRect);
- end else if FShowArrow then begin
- {Calculate the effective cell width (the cell width less the size
- of the button)}
- R := CellRect;
- dec(R.Right, OvcComboBoxButtonWidth);
- {Paint the string in this restricted rectangle}
- inherited tcPaint(TableCanvas, R, RowNum, ColNum, CellAttr, @S);
- {Paint the arrow on the right side}
- DrawArrow(TableCanvas, CellRect, CellAttr);
- end else
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, @S);
-*)
-end;
-
-procedure TOvcTCCustomComboBox.SaveEditedData(Data : pointer);
- var
- ItemRec : PCellComboBoxInfo absolute Data;
- begin
- if Assigned(Data) then
- begin
- ItemRec^.Index := FEdit.ItemIndex;
- if (Style = csDropDown) or (Style = csSimple) or SaveStringValue then
- begin
- if (ItemRec^.Index = -1) then
- if UseRunTimeItems then
- {$IFDEF CBuilder}
- StrPCopy(ItemRec^.RTSt, Copy(FEdit.Text, 1, MaxLength))
- {$ELSE}
- ItemRec^.RTSt := Copy(FEdit.Text, 1, MaxLength)
- {$ENDIF}
- else
- {$IFDEF CBuilder}
- StrPCopy(ItemRec^.St, Copy(FEdit.Text, 1, MaxLength))
- {$ELSE}
- ItemRec^.St := Copy(FEdit.Text, 1, MaxLength)
- {$ENDIF}
- else
- if UseRunTimeItems then
- {$IFDEF CBuilder}
- StrPCopy(ItemRec^.RTSt, Copy(ItemRec^.RTItems[ItemRec^.Index], 1, MaxLength))
- {$ELSE}
- ItemRec^.RTSt := Copy(ItemRec^.RTItems[ItemRec^.Index], 1, MaxLength)
- {$ENDIF}
- else
- {$IFDEF CBuilder}
- StrPCopy(ItemRec^.St, Copy(Items[ItemRec^.Index], 1, MaxLength));
- {$ELSE}
- ItemRec^.St := Copy(Items[ItemRec^.Index], 1, MaxLength);
- {$ENDIF}
- end;
- end;
- end;
-{--------}
-procedure TOvcTCCustomComboBox.SetItems(I : TStrings);
- begin
- FItems.Assign(I);
- if Sorted then
- TStringList(FItems).Sorted := true;
- tcDoCfgChanged;
- end;
-
-procedure TOvcTCCustomComboBox.SetShowArrow(Value : Boolean);
-begin
- if (Value <> FShowArrow) then begin
- FShowArrow := Value;
- tcDoCfgChanged;
- end;
-end;
-
-procedure TOvcTCCustomComboBox.SetSorted(S : boolean);
- begin
- if (S <> Sorted) then
- begin
- FSorted := S;
- if Sorted then
- TStringList(Items).Sorted := True;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTCCustomComboBox.StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer);
- var
- ItemRec : PCellComboBoxInfo absolute Data;
- begin
- FEdit := CreateEditControl;
- with FEdit do
- begin
- Color := CellAttr.caColor;
- Ctl3D := false;
- case CellStyle of
- tes3D : Ctl3D := true;
- end;{case}
- Left := CellRect.Left;
- Top := CellRect.Top;
- Width := CellRect.Right - CellRect.Left;
- Font := CellAttr.caFont;
- Font.Color := CellAttr.caFontColor;
- MaxLength := Self.MaxLength;
- Hint := Self.Hint;
- ShowHint := Self.ShowHint;
- Visible := true;
- CellOwner := Self;
- TabStop := false;
- Parent := FTable;
- DropDownCount := Self.DropDownCount;
- Sorted := Self.Sorted;
- Style := Self.Style;
- if UseRunTimeItems then
- Items := ItemRec^.RTItems
- else
- Items := Self.Items;
- if Data = nil then
- ItemIndex := -1
- else
- begin
- ItemIndex := ItemRec^.Index;
- if (ItemIndex = -1) and
- ((Style = csDropDown) or (Style = csSimple)) then
- if UseRunTimeItems then
- {$IFDEF CBuilder}
- Text := StrPas(ItemRec^.RTSt)
- {$ELSE}
- Text := ItemRec^.RTSt
- {$ENDIF}
- else
- {$IFDEF CBuilder}
- Text := StrPas(ItemRec^.St)
- {$ELSE}
- Text := ItemRec^.St;
- {$ENDIF}
- end;
-
- OnChange := Self.OnChange;
- OnClick := Self.OnClick;
- OnDblClick := Self.OnDblClick;
- OnDragDrop := Self.OnDragDrop;
- OnDragOver := Self.OnDragOver;
- OnDrawItem := Self.OnDrawItem;
- OnDropDown := Self.OnDropDown;
- OnEndDrag := Self.OnEndDrag;
- OnEnter := Self.OnEnter;
- OnExit := Self.OnExit;
- OnKeyDown := Self.OnKeyDown;
- OnKeyPress := Self.OnKeyPress;
- OnKeyUp := Self.OnKeyUp;
- OnMeasureItem := Self.OnMeasureItem;
- OnMouseDown := Self.OnMouseDown;
- OnMouseMove := Self.OnMouseMove;
- OnMouseUp := Self.OnMouseUp;
- end;
- end;
-{--------}
-procedure TOvcTCCustomComboBox.StopEditing(SaveValue : boolean;
- Data : pointer);
- var
- ItemRec : PCellComboBoxInfo absolute Data;
- begin
- if SaveValue and Assigned(Data) then
- begin
- ItemRec^.Index := FEdit.ItemIndex;
- if (Style = csDropDown) or (Style = csSimple) or SaveStringValue then
- begin
- if (ItemRec^.Index = -1) then
- if UseRunTimeItems then
- {$IFDEF CBuilder}
- StrPCopy(ItemRec^.RTSt, Copy(FEdit.Text, 1, MaxLength))
- {$ELSE}
- ItemRec^.RTSt := Copy(FEdit.Text, 1, MaxLength)
- {$ENDIF}
- else
- {$IFDEF CBuilder}
- StrPCopy(ItemRec^.St, Copy(FEdit.Text, 1, MaxLength))
- {$ELSE}
- ItemRec^.St := Copy(FEdit.Text, 1, MaxLength)
- {$ENDIF}
- else
- if UseRunTimeItems then
- {$IFDEF CBuilder}
- StrPCopy(ItemRec^.RTSt, Copy(ItemRec^.RTItems[ItemRec^.Index], 1, MaxLength))
- {$ELSE}
- ItemRec^.RTSt := Copy(ItemRec^.RTItems[ItemRec^.Index], 1, MaxLength)
- {$ENDIF}
- else
- {$IFDEF CBuilder}
- StrPCopy(ItemRec^.St, Copy(Items[ItemRec^.Index], 1, MaxLength));
- {$ELSE}
- ItemRec^.St := Copy(Items[ItemRec^.Index], 1, MaxLength);
- {$ENDIF}
- end;
- end;
- PostMessage(FEdit.Handle, CM_RELEASE, 0, 0);
- {FEdit.Free;}
- FEdit := nil;
- end;
-{====================================================================}
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovctcedt.pas b/Source/3rdParty/Orpheus/ovctcedt.pas
deleted file mode 100644
index 7f115490..00000000
--- a/Source/3rdParty/Orpheus/ovctcedt.pas
+++ /dev/null
@@ -1,730 +0,0 @@
-{*********************************************************}
-{* OVCTCEDT.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 ovctcedt;
- {-Orpheus Table Cell - Windows edit Control type}
-
-interface
-
-uses
- SysUtils, Classes,
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Controls, Forms, StdCtrls,
- OvcTCmmn, OvcTCell, OvcTCStr,
- Graphics; { - for default color definition}
-
-type
- TOvcTCStringEdit = class(TEdit)
- protected {private}
- FCell : TOvcBaseTableCell;
-
- protected
- procedure WMChar(var Msg : TWMKey); message WM_CHAR;
- procedure WMGetDlgCode(var Msg : TMessage); message WM_GETDLGCODE;
- procedure WMKeyDown(var Msg : TWMKey); message WM_KEYDOWN;
- procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS;
- procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
-
- property CellOwner : TOvcBaseTableCell
- read FCell write FCell;
- end;
-
- TOvcTCCustomString = class(TOvcTCBaseString)
- protected {private}
- FEdit : TOvcTCStringEdit;
- FMaxLength : word;
- FAutoAdvanceChar : boolean;
- FAutoAdvanceLeftRight : boolean;
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
-
- protected
- function GetCellEditor : TControl; override;
- function GetModified : boolean;
-
- property AutoAdvanceChar : boolean
- read FAutoAdvanceChar write FAutoAdvanceChar;
-
- property AutoAdvanceLeftRight : boolean
- read FAutoAdvanceLeftRight write FAutoAdvanceLeftRight;
-
- property MaxLength : word
- read FMaxLength write FMaxLength;
-
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D;
-{$ENDIF}
- public
- function CreateEditControl(AOwner : TComponent) : TOvcTCStringEdit; virtual;
-
- function EditHandle : THandle; override;
- procedure EditHide; override;
- procedure EditMove(CellRect : TRect); override;
-
- procedure SaveEditedData(Data : pointer); override;
- procedure StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer); override;
- procedure StopEditing(SaveValue : boolean;
- Data : pointer); override;
-
- property Modified : boolean
- read GetModified;
- end;
-
- TOvcTCString = class(TOvcTCCustomString)
- published
- {properties inherited from custom ancestor}
- property Access default otxDefault;
- property Adjust default otaDefault;
- property AutoAdvanceChar default False;
- property AutoAdvanceLeftRight default False;
- property Color;
- property Font;
- property Hint;
- property Margin default 4;
- property MaxLength default 0;
- property ShowHint default False;
- property Table;
- property TableColor default True;
- property TableFont default True;
- property TextHiColor default clBtnHighlight;
- property TextStyle default tsFlat;
- property UseWordWrap default False;
- property UseASCIIZStrings default False;
-
- {events inherited from custom ancestor}
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnOwnerDraw;
- public
- constructor Create(AOwner : TComponent); override;
- end;
-
-type
- TOvcTCMemoEdit = class(TMemo)
- protected {private}
- FCell : TOvcBaseTableCell;
-
- protected
- procedure WMChar(var Msg : TWMKey); message WM_CHAR;
- procedure WMGetDlgCode(var Msg : TMessage); message WM_GETDLGCODE;
- procedure WMKeyDown(var Msg : TWMKey); message WM_KEYDOWN;
- procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS;
- procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
-
- property CellOwner : TOvcBaseTableCell
- read FCell write FCell;
- end;
-
- TOvcTCCustomMemo = class(TOvcTCBaseString)
- protected {private}
- FEdit : TOvcTCMemoEdit;
- FMaxLength : word;
- FWantReturns : boolean;
- FWantTabs : boolean;
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
-
- protected
- function GetCellEditor : TControl; override;
- function GetModified : boolean;
-
- property MaxLength : word
- read FMaxLength write FMaxLength;
-
- property WantReturns : boolean
- read FWantReturns write FWantReturns;
-
- property WantTabs : boolean
- read FWantTabs write FWantTabs;
-
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D;
-{$ENDIF}
- public
- constructor Create(AOwner : TComponent); override;
- function CreateEditControl(AOwner : TComponent) : TOvcTCMemoEdit; virtual;
-
- function EditHandle : THandle; override;
- procedure EditHide; override;
- procedure EditMove(CellRect : TRect); override;
- procedure SaveEditedData(Data : pointer); override;
- procedure StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer); override;
- procedure StopEditing(SaveValue : boolean;
- Data : pointer); override;
-
- property Modified : boolean
- read GetModified;
- end;
-
- TOvcTCMemo = class(TOvcTCCustomMemo)
- published
- {properties inherited from custom ancestor}
- property Access default otxDefault;
- property Adjust default otaDefault;
- property Color;
- property Font;
- property Hint;
- property Margin default 4;
- property MaxLength default 0;
- property ShowHint default False;
- property Table;
- property TableColor default True;
- property TableFont default True;
- property TextHiColor default clBtnHighlight;
- property TextStyle default tsFlat;
- property WantReturns default False;
- property WantTabs default False;
-
- {events inherited from custom ancestor}
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnOwnerDraw;
- end;
-
-implementation
-
-{===TOvcTCCustomString===============================================}
-function TOvcTCCustomString.CreateEditControl(AOwner : TComponent) : TOvcTCStringEdit;
- begin
- Result := TOvcTCStringEdit.Create(AOwner);
- end;
-{--------}
-function TOvcTCCustomString.EditHandle : THandle;
- begin
- if Assigned(FEdit) then
- Result := FEdit.Handle
- else
- Result := 0;
- end;
-{--------}
-procedure TOvcTCCustomString.EditHide;
- begin
- if Assigned(FEdit) then
- with FEdit do
- begin
- SetWindowPos(FEdit.Handle, HWND_TOP,
- 0, 0, 0, 0,
- SWP_HIDEWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- end;
- end;
-{--------}
-procedure TOvcTCCustomString.EditMove(CellRect : TRect);
- var
- EditHandle : HWND;
- begin
- if Assigned(FEdit) then
- begin
- EditHandle := FEdit.Handle;
- with CellRect do
- SetWindowPos(EditHandle, HWND_TOP,
- Left, Top, Right-Left, Bottom-Top,
- SWP_SHOWWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- InvalidateRect(EditHandle, nil, false);
- UpdateWindow(EditHandle);
- end;
- end;
-{--------}
-function TOvcTCCustomString.GetCellEditor : TControl;
- begin
- Result := FEdit;
- end;
-{--------}
-function TOvcTCCustomString.GetModified : boolean;
- begin
- if Assigned(FEdit) then
- Result := FEdit.Modified
- else Result := false;
- end ;
-{--------}
-procedure TOvcTCCustomString.SaveEditedData(Data : pointer);
- begin
- if Assigned(Data) then
- if UseASCIIZStrings then
- FEdit.GetTextBuf(PAnsiChar(Data), MaxLength)
- else
- POvcShortString(Data)^ := Copy(FEdit.Text, 1, MaxLength);
- end;
-{--------}
-procedure TOvcTCCustomString.StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer);
- begin
- FEdit := CreateEditControl(FTable);
- with FEdit do
- begin
- if UseASCIIZStrings then
- begin
- if (Data = nil) then
- SetTextBuf('')
- else
- SetTextBuf(PAnsiChar(Data));
- end
- else
- begin
- if (Data = nil) then
- Text := ''
- else
- Text := POvcShortString(Data)^;
- end;
- Color := CellAttr.caColor;
- Font := CellAttr.caFont;
- Font.Color := CellAttr.caFontColor;
- Left := CellRect.Left;
- Top := CellRect.Top;
- Width := CellRect.Right - CellRect.Left;
- Height := CellRect.Bottom - CellRect.Top;
- TabStop := false;
- CellOwner := Self;
- MaxLength := Self.MaxLength;
- Hint := Self.Hint;
- ShowHint := Self.ShowHint;
- Parent := FTable;
- BorderStyle := bsNone;
- Ctl3D := false;
- case CellStyle of
- tesBorder : BorderStyle := bsSingle;
- tes3D : Ctl3D := true;
- end;{case}
-
- OnChange := Self.OnChange;
- OnClick := Self.OnClick;
- OnDblClick := Self.OnDblClick;
- OnDragDrop := Self.OnDragDrop;
- OnDragOver := Self.OnDragOver;
- OnEndDrag := Self.OnEndDrag;
- OnEnter := Self.OnEnter;
- OnExit := Self.OnExit;
- OnKeyDown := Self.OnKeyDown;
- OnKeyPress := Self.OnKeyPress;
- OnKeyUp := Self.OnKeyUp;
- OnMouseDown := Self.OnMouseDown;
- OnMouseMove := Self.OnMouseMove;
- OnMouseUp := Self.OnMouseUp;
- end;
- end;
-{--------}
-procedure TOvcTCCustomString.StopEditing(SaveValue : boolean;
- Data : pointer);
-
- begin
- try
- if SaveValue and Assigned(Data) then
- if UseASCIIZStrings then
- FEdit.GetTextBuf(PAnsiChar(Data), MaxLength+1)
- else
- POvcShortString(Data)^ := Copy(FEdit.Text, 1, MaxLength);
- finally
- FEdit.Free;
- FEdit := nil;
- end;
- end;
-{====================================================================}
-
-
-{===TOvcTCStringEdit===============================================}
-procedure TOvcTCStringEdit.WMChar(var Msg : TWMKey);
- var
- CurText : string;
- begin
- if (Msg.CharCode <> 13) and {Enter}
- (Msg.CharCode <> 9) and {Tab}
- (Msg.CharCode <> 27) then {Escape}
- inherited;
- if TOvcTCCustomString(CellOwner).AutoAdvanceChar then
- begin
- CurText := Text;
- if (length(CurText) >= MaxLength) then
- begin
- FillChar(Msg, sizeof(Msg), 0);
- with Msg do
- begin
- Msg := WM_KEYDOWN;
- CharCode := VK_RIGHT;
- end;
- CellOwner.SendKeyToTable(Msg);
- end;
- end;
- end;
-{--------}
-procedure TOvcTCStringEdit.WMGetDlgCode(var Msg : TMessage);
- begin
- inherited;
- if CellOwner.TableWantsTab then
- Msg.Result := Msg.Result or DLGC_WANTTAB;
- if CellOwner.TableWantsEnter then
- Msg.Result := Msg.Result or DLGC_WANTALLKEYS;
- end;
-{--------}
-procedure TOvcTCStringEdit.WMKeyDown(var Msg : TWMKey);
- procedure GetSelection(var S, E : word);
- type
- LH = packed record L, H : word; end;
- var
- GetSel : longint;
- begin
- GetSel := SendMessage(Handle, EM_GETSEL, 0, 0);
- S := LH(GetSel).L;
- E := LH(GetSel).H;
- end;
- var
- GridReply : TOvcTblKeyNeeds;
- GridUsedIt : boolean;
- SStart, SEnd : word;
- begin
- GridUsedIt := false;
- GridReply := otkDontCare;
- if (CellOwner <> nil) then
- GridReply := CellOwner.FilterTableKey(Msg);
- case GridReply of
- otkMustHave :
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- otkWouldLike :
- case Msg.CharCode of
- VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN :
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- VK_LEFT :
- if TOvcTCCustomString(CellOwner).AutoAdvanceLeftRight then
- begin
- GetSelection(SStart, SEnd);
- if (SStart = SEnd) and (SStart = 0) then
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;
- VK_RIGHT :
- if TOvcTCCustomString(CellOwner).AutoAdvanceLeftRight then
- begin
- GetSelection(SStart, SEnd);
- if ((SStart = SEnd) or (SStart = 0)) and (SEnd = GetTextLen) then
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;
- end;
- end;{case}
-
- if not GridUsedIt then
- inherited;
- end;
-{--------}
-procedure TOvcTCStringEdit.WMKillFocus(var Msg : TWMKillFocus);
- begin
- inherited;
- CellOwner.PostMessageToTable(ctim_KillFocus, Msg.FocusedWnd, 0);
- end;
-{--------}
-procedure TOvcTCStringEdit.WMSetFocus(var Msg : TWMSetFocus);
- begin
- inherited;
- CellOwner.PostMessageToTable(ctim_SetFocus, Msg.FocusedWnd, 0);
- end;
-{====================================================================}
-
-
-
-
-{===TOvcTCCustomMemo=================================================}
-constructor TOvcTCCustomMemo.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
- UseASCIIZStrings := true;
- UseWordWrap := true;
- end;
-{--------}
-function TOvcTCCustomMemo.CreateEditControl(AOwner : TComponent) : TOvcTCMemoEdit;
- begin
- Result := TOvcTCMemoEdit.Create(AOwner);
- end;
-{--------}
-function TOvcTCCustomMemo.EditHandle : THandle;
- begin
- if Assigned(FEdit) then
- Result := FEdit.Handle
- else
- Result := 0;
- end;
-{--------}
-procedure TOvcTCCustomMemo.EditHide;
- begin
- if Assigned(FEdit) then
- with FEdit do
- begin
- SetWindowPos(FEdit.Handle, HWND_TOP,
- 0, 0, 0, 0,
- SWP_HIDEWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- end;
- end;
-{--------}
-procedure TOvcTCCustomMemo.EditMove(CellRect : TRect);
- begin
- if Assigned(FEdit) then
- begin
- with CellRect do
- SetWindowPos(FEdit.Handle, HWND_TOP,
- Left, Top, Right-Left, Bottom-Top,
- SWP_SHOWWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- InvalidateRect(FEdit.Handle, nil, false);
- UpdateWindow(FEdit.Handle);
- end;
- end;
-{--------}
-function TOvcTCCustomMemo.GetCellEditor : TControl;
- begin
- Result := FEdit;
- end;
-{--------}
-function TOvcTCCustomMemo.GetModified : boolean;
- begin
- if Assigned(FEdit) then
- Result := FEdit.Modified
- else Result := false;
- end ;
-{--------}
-procedure TOvcTCCustomMemo.StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer);
- begin
- FEdit := CreateEditControl(FTable);
- with FEdit do
- begin
- if (Data = nil) then
- SetTextBuf('')
- else
- SetTextBuf(PAnsiChar(Data));
- Color := CellAttr.caColor;
- Font := CellAttr.caFont;
- Font.Color := CellAttr.caFontColor;
- MaxLength := Self.MaxLength;
- WantReturns := Self.WantReturns;
- WantTabs := Self.WantTabs;
- Left := CellRect.Left;
- Top := CellRect.Top;
- Width := CellRect.Right - CellRect.Left;
- Height := CellRect.Bottom - CellRect.Top;
- Visible := true;
- TabStop := false;
- CellOwner := Self;
- Hint := Self.Hint;
- ShowHint := Self.ShowHint;
- Parent := FTable;
- BorderStyle := bsNone;
- Ctl3D := false;
- case CellStyle of
- tesBorder : BorderStyle := bsSingle;
- tes3D : Ctl3D := true;
- end;{case}
-
- OnChange := Self.OnChange;
- OnClick := Self.OnClick;
- OnDblClick := Self.OnDblClick;
- OnDragDrop := Self.OnDragDrop;
- OnDragOver := Self.OnDragOver;
- OnEndDrag := Self.OnEndDrag;
- OnEnter := Self.OnEnter;
- OnExit := Self.OnExit;
- OnKeyDown := Self.OnKeyDown;
- OnKeyPress := Self.OnKeyPress;
- OnKeyUp := Self.OnKeyUp;
- OnMouseDown := Self.OnMouseDown;
- OnMouseMove := Self.OnMouseMove;
- OnMouseUp := Self.OnMouseUp;
- end;
- end;
-{--------}
-procedure TOvcTCCustomMemo.StopEditing(SaveValue : boolean;
- Data : pointer);
- begin
- try
- if SaveValue and Assigned(Data) then
- FEdit.GetTextBuf(PAnsiChar(Data), MaxLength);
- finally
- FEdit.Free;
- FEdit := nil;
- end;
- end;
-
-procedure TOvcTCCustomMemo.SaveEditedData(Data : pointer);
-begin
- {stub out abstract method so BCB doesn't see this as an abstract class}
-end;
-
-{====================================================================}
-
-
-{===TOvcTCMemoEdit===============================================}
-procedure TOvcTCMemoEdit.WMChar(var Msg : TWMKey);
- begin
- if (not CellOwner.TableWantsTab) or
- (Msg.CharCode <> 9) then
- inherited;
- end;
-{--------}
-procedure TOvcTCMemoEdit.WMGetDlgCode(var Msg : TMessage);
- begin
- inherited;
- if CellOwner.TableWantsTab then
- Msg.Result := Msg.Result or DLGC_WANTTAB;
- end;
-{--------}
-procedure TOvcTCMemoEdit.WMKeyDown(var Msg : TWMKey);
- procedure GetSelection(var S, E : word);
- type
- LH = packed record L, H : word; end;
- var
- GetSel : longint;
- begin
- GetSel := SendMessage(Handle, EM_GETSEL, 0, 0);
- S := LH(GetSel).L;
- E := LH(GetSel).H;
- end;
- var
- GridReply : TOvcTblKeyNeeds;
- GridUsedIt : boolean;
- SStart, SEnd : word;
- begin
- GridUsedIt := false;
- GridReply := otkDontCare;
- if (CellOwner <> nil) then
- GridReply := CellOwner.FilterTableKey(Msg);
- case GridReply of
- otkMustHave :
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- otkWouldLike :
- case Msg.CharCode of
- VK_RETURN :
-{$IFNDEF LCL}
- if not WantReturns then
-{$ENDIF}
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- VK_LEFT :
- begin
- GetSelection(SStart, SEnd);
- if (SStart = SEnd) and (SStart = 0) then
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;
- VK_RIGHT :
- begin
- GetSelection(SStart, SEnd);
- if ((SStart = SEnd) or (SStart = 0)) and (SEnd = GetTextLen) then
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;
- end;
- end;{case}
-
- if not GridUsedIt then
- inherited;
- end;
-{--------}
-procedure TOvcTCMemoEdit.WMKillFocus(var Msg : TWMKillFocus);
- begin
- inherited;
- CellOwner.PostMessageToTable(ctim_KillFocus, Msg.FocusedWnd, 0);
- end;
-{--------}
-procedure TOvcTCMemoEdit.WMSetFocus(var Msg : TWMSetFocus);
- begin
- inherited;
- CellOwner.PostMessageToTable(ctim_SetFocus, Msg.FocusedWnd, 0);
- end;
-{====================================================================}
-
-{===TOvcTCString===============================================}
-constructor TOvcTCString.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
- end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovctcell.pas b/Source/3rdParty/Orpheus/ovctcell.pas
deleted file mode 100644
index 212cceb4..00000000
--- a/Source/3rdParty/Orpheus/ovctcell.pas
+++ /dev/null
@@ -1,1384 +0,0 @@
-{*********************************************************}
-{* OVCTCELL.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 ovctcell;
- {-Cell ancestor class; cell matrix class}
-
-interface
-
-uses
- SysUtils, Classes,
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Graphics, Controls,
- OvcTCmmn, OvcSpAry, OvcVer;
-
-type
- TOvcBaseTableCell = class(TOvcTableCellAncestor)
- protected {private}
- {.Z+}
- {property fields - even size}
- FColor : TColor;
- FFont : TFont;
- FHint : string;
- FMargin : Integer;
- FReferences : longint;
- FTable : TOvcTableAncestor;
- FTextHiColor: TColor;
- {property fields - odd size}
- FAcceptActivationClick : boolean;
- FAccess : TOvcTblAccess;
- FAdjust : TOvcTblAdjust;
- FShowHint : boolean;
- FTableColor : boolean;
- FTableFont : boolean;
- FTextStyle : TOvcTextStyle;
- Filler : Byte;
- {property event fields}
- FOnClick : TNotifyEvent;
- FOnDblClick : TNotifyEvent;
- FOnDragDrop : TDragDropEvent;
- FOnDragOver : TDragOverEvent;
- FOnEndDrag : TEndDragEvent;
- FOnEnter : TNotifyEvent;
- FOnExit : TNotifyEvent;
- FOnKeyDown : TKeyEvent;
- FOnKeyPress : TKeyPressEvent;
- FOnKeyUp : TKeyEvent;
- FOnMouseDown : TMouseEvent;
- FOnMouseMove : TMouseMoveEvent;
- FOnMouseUp : TMouseEvent;
- FOnOwnerDraw : TCellPaintNotifyEvent;
- {.Z-}
-
- tcBadColorValue : boolean;
- tcBadFontValue : boolean;
- tcNoConfigChange : boolean;
-
- {property methods}
- function GetAbout : string;
- procedure SetAbout(const Value : string);
-
- protected
- {.Z+}
- {property access}
- function GetColor : TColor;
- function GetCellEditor : TControl; virtual;
- function GetFont : TFont;
-
- procedure SetAccess(A : TOvcTblAccess);
- procedure SetAdjust(A : TOvcTblAdjust);
- procedure SetColor(C : TColor);
- procedure SetFont(F : TFont);
- procedure SetHint(const H : string);
- procedure SetMargin(M : Integer);
- procedure SetTable(T : TOvcTableAncestor);
- procedure SetTableColor(B : boolean);
- procedure SetTableFont(B : boolean);
- procedure SetTextHiColor(THC : TColor);
- procedure SetTextStyle(TS : TOvcTextStyle);
-
- {property storage}
- function IsColorStored : boolean;
- function IsFontStored : boolean;
-
- {miscellaneous}
- procedure tcChangeScale(M, D : integer); override;
- procedure tcFontHasChanged(Sender : TObject);
- procedure tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer); virtual;
- procedure tcRetrieveTableColor;
- function tcRetrieveTableActiveCol : TColNum;
- function tcRetrieveTableActiveRow : TRowNum;
- procedure tcRetrieveTableFont;
- function tcRetrieveTableLockedCols : TColNum;
- function tcRetrieveTableLockedRows : TRowNum;
- {.Z-}
-
- {properties}
- property Color : TColor
- read GetColor write SetColor
- stored IsColorStored;
-
- property TextHiColor : TColor
- read FTextHiColor write SetTextHiColor;
-
- property Font : TFont
- read GetFont write SetFont
- stored IsFontStored;
-
- property Hint : string
- read FHint write SetHint;
-
- property Margin : Integer
- read FMargin write SetMargin;
-
- property ShowHint : boolean
- read FShowHint write FShowHint;
-
- property TableColor : boolean
- read FTableColor write SetTableColor;
-
- property TableFont : boolean
- read FTableFont write SetTableFont;
-
- property TextStyle : TOvcTextStyle
- read FTextStyle write SetTextStyle;
-
- {events}
- property OnClick : TNotifyEvent
- read FOnClick write FOnClick;
-
- property OnDblClick : TNotifyEvent
- read FOnDblClick write FOnDblClick;
-
- property OnDragDrop : TDragDropEvent
- read FOnDragDrop write FOnDragDrop;
-
- property OnDragOver : TDragOverEvent
- read FOnDragOver write FOnDragOver;
-
- property OnEndDrag : TEndDragEvent
- read FOnEndDrag write FOnEndDrag;
-
- property OnEnter : TNotifyEvent
- read FOnEnter write FOnEnter;
-
- property OnExit : TNotifyEvent
- read FOnExit write FOnExit;
-
- property OnKeyDown : TKeyEvent
- read FOnKeyDown write FOnKeyDown;
-
- property OnKeyPress : TKeyPressEvent
- read FOnKeyPress write FOnKeyPress;
-
- property OnKeyUp : TKeyEvent
- read FOnKeyUp write FOnKeyUp;
-
- property OnMouseDown : TMouseEvent
- read FOnMouseDown write FOnMouseDown;
-
- property OnMouseMove : TMouseMoveEvent
- read FOnMouseMove write FOnMouseMove;
-
- property OnMouseUp : TMouseEvent
- read FOnMouseUp write FOnMouseUp;
-
- property OnOwnerDraw : TCellPaintNotifyEvent
- read FOnOwnerDraw write FOnOwnerDraw;
-
- public {protected}
- {.Z+}
- {internal use only methods}
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- procedure tcResetTableValues; override;
-
- {methods to support third-party components in the data-aware table}
- function SpecialCellSupported(Field : TObject) : Boolean;
- virtual;
- function SpecialCellDataSize : Integer;
- virtual;
- procedure SpecialCellDataTransfer(Field : TObject; Data : Pointer; Purpose : TOvcCellDataPurpose);
- virtual;
- {.Z-}
-
- public
- constructor Create(AOwner : TComponent); override;
- destructor Destroy; override;
-
- {reference counting}
- procedure IncRefs;
- procedure DecRefs;
-
- {Edit cell base methods to override}
- function EditHandle : THandle; virtual;
- procedure EditHide; virtual;
- procedure EditMove(CellRect : TRect); virtual;
-
- {Editing base methods to override}
- function CanSaveEditedData(SaveValue : boolean) : boolean; virtual;
- function CanStopEditing(SaveValue : boolean) : boolean; {for Orpheus 1.0 compatibility}
- function FilterTableKey(var Msg : TWMKey) : TOvcTblKeyNeeds; virtual;
- {.Z+}
- procedure PostMessageToTable(Msg: UINT; wParam: WPARAM; lParam: LPARAM); //64
- {.Z-}
- procedure SendKeyToTable(var Msg : TWMKey);
- procedure SaveEditedData(Data : pointer); virtual;
- procedure StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer); virtual;
- procedure StopEditing(SaveValue : boolean;
- Data : pointer); virtual;
- function TableWantsEnter : boolean;
- function TableWantsTab : boolean;
-
- {painting}
- {.Z+}
- function DoOwnerDraw(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer) : boolean; virtual;
- {.Z-}
- procedure Paint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer);
- procedure ResolveAttributes(RowNum : TRowNum; ColNum : TColNum;
- var CellAttr : TOvcCellAttributes); virtual;
-
- {properties}
- property AcceptActivationClick : boolean
- read FAcceptActivationClick write FAcceptActivationClick;
-
- property Access : TOvcTblAccess
- read FAccess write SetAccess;
-
- property Adjust : TOvcTblAdjust
- read FAdjust write SetAdjust;
-
- property CellEditor : TControl
- read GetCellEditor;
-
- property References : longint
- read FReferences;
-
- property Table : TOvcTableAncestor
- read FTable write SetTable;
-
- published
- property About : string
- read GetAbout write SetAbout stored False;
- end;
-
- TOvcTableCells = class
- protected {private}
- {.Z+}
- {property fields}
- FMatrix : TOvcSparseArray;
- FOnCfgChanged : TNotifyEvent;
- FTable : TOvcTableAncestor;
-
- {other fields}
- tcCellAttrCount : longint; {count of non-blank cells}
- {.Z-}
-
- protected
- {.Z+}
- function GetAccess(RowNum : TRowNum; ColNum : TColNum) : TOvcTblAccess;
- function GetAdjust(RowNum : TRowNum; ColNum : TColNum) : TOvcTblAdjust;
- function GetCell(RowNum : TRowNum; ColNum : TColNum) : TOvcBaseTableCell;
- function GetColor(RowNum : TRowNum; ColNum : TColNum) : TColor;
- function GetFont(RowNum : TRowNum; ColNum : TColNum) : TFont;
-
- procedure SetAccess(RowNum : TRowNum; ColNum : TColNum; A : TOvcTblAccess);
- procedure SetAdjust(RowNum : TRowNum; ColNum : TColNum; A : TOvcTblAdjust);
- procedure SetCell(RowNum : TRowNum; ColNum : TColNum; BTC : TOvcBaseTableCell);
- procedure SetColor(RowNum : TRowNum; ColNum : TColNum; C : TColor);
- procedure SetFont(RowNum : TRowNum; ColNum : TColNum; F : TFont);
- {.Z-}
-
- public {protected}
- {.Z+}
- {internal use only methods}
- procedure tcNotifyCellDeletion(Cell : TOvcBaseTableCell);
- procedure tcDoCfgChanged;
-
- property OnCfgChanged : TNotifyEvent
- write FOnCfgChanged;
- property Table : TOvcTableAncestor
- read FTable write FTable;
- {.Z-}
-
- public
- constructor Create(ATable : TOvcTableAncestor);
- destructor Destroy; override;
-
- procedure DeleteCol(ColNum : TColNum);
- procedure DeleteRow(RowNum : TRowNum);
- procedure ExchangeCols(ColNum1, ColNum2 : TColNum);
- procedure ExchangeRows(RowNum1, RowNum2 : TRowNum);
- procedure InsertCol(ColNum : TColNum);
- procedure InsertRow(RowNum : TRowNum);
-
- procedure ResetCell(RowNum : TRowNum; ColNum : TColNum);
- procedure ResolveFullAttr(RowNum : TRowNum; ColNum : TColNum;
- var SCA : TOvcSparseAttr);
-
- property Access [RowNum : TRowNum; ColNum : TColNum] : TOvcTblAccess
- read GetAccess write SetAccess;
-
- property Adjust [RowNum : TRowNum; ColNum : TColNum] : TOvcTblAdjust
- read GetAdjust write SetAdjust;
-
- property Cell [RowNum : TRowNum; ColNum : TColNum] : TOvcBaseTableCell
- read GetCell write SetCell;
- default;
-
- property Color [RowNum : TRowNum; ColNum : TColNum] : TColor
- read GetColor write SetColor;
-
- property Font [RowNum : TRowNum; ColNum : TColNum] : TFont
- read GetFont write SetFont;
- end;
-
-implementation
-
-{===TOvcCustomCell===================================================}
-constructor TOvcBaseTableCell.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
-
- FAccess := otxDefault;
- FAdjust := otaDefault;
- FColor := tbDefTableColor;
- FTextHiColor := clBtnHighlight;
- FFont := TFont.Create;
- FFont.OnChange := tcFontHasChanged;
- FTableColor := true;
- tcBadColorValue := true;
- FTableFont := true;
- tcBadFontValue := true;
- FMargin := tbDefMargin;
- end;
-{--------}
-destructor TOvcBaseTableCell.Destroy;
- begin
- Table := nil;
- FFont.Free;
- inherited Destroy;
- end;
-{--------}
-
-function TOvcBaseTableCell.EditHandle : THandle;
-begin
- {do nothing. just here to satisfy BCB}
- Result := 0;
-end;
-
-procedure TOvcBaseTableCell.EditHide;
-begin
- {do nothing. just here to satisfy BCB}
-end;
-
-procedure TOvcBaseTableCell.EditMove(CellRect : TRect);
-begin
- {do nothing. just here to satisfy BCB}
-end;
-
-function TOvcBaseTableCell.CanSaveEditedData(SaveValue : boolean) : boolean;
- begin
- Result := true;
- end;
-{--------}
-function TOvcBaseTableCell.CanStopEditing(SaveValue : boolean) : boolean;
- begin
- Result := CanSaveEditedData(SaveValue);
- end;
-{--------}
-procedure TOvcBaseTableCell.tcChangeScale(M, D : integer);
- begin
- if (M <> D) and (not TableFont) then
- FFont.Size := MulDiv(FFont.Size, M, D);
- end;
-{--------}
-procedure TOvcBaseTableCell.DecRefs;
- begin
-//try // LCL: On Carbon, get "EXC_BAD_ACCESS, Could not access memory" for
- // FReferences when free cell's column (for example, when quit app),
- // as though cell object's memory already freed, so trap and ignore.
- if (FReferences > 0) then
- begin
- dec(FReferences);
- if (FReferences = 0) then
- begin
- FTable.tbExcludeCell(Self);
- FTable := nil;
- FOnCfgChanged := nil;
- end;
- end;
-//except
-//end;
- end;
-{--------}
-function TOvcBaseTableCell.DoOwnerDraw(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer) : boolean;
- begin
- Result := false;
- if Assigned(FOnOwnerDraw) then
- FOnOwnerDraw(Self, TableCanvas, CellRect, RowNum, ColNum, CellAttr, Data, Result);
- end;
-{--------}
-function TOvcBaseTableCell.FilterTableKey(var Msg : TWMKey) : TOvcTblKeyNeeds;
- begin
- if not Assigned(FTable) then
- Result := otkDontCare
- else
- Result := FTable.FilterKey(Msg);
- end;
-{--------}
-procedure TOvcBaseTableCell.tcFontHasChanged(Sender : TObject);
- begin
- if not tcNoConfigChange then
- begin
- FTableFont := false;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-function TOvcBaseTableCell.GetColor : TColor;
- begin
- if TableColor and tcBadColorValue then
- tcRetrieveTableColor;
- Result := FColor;
- end;
-{--------}
-function TOvcBaseTableCell.GetCellEditor : TControl;
- begin
- Result := nil;
- end;
-{--------}
-function TOvcBaseTableCell.GetFont : TFont;
- begin
- if TableFont and tcBadFontValue then
- begin
- tcNoConfigChange := true;
- tcRetrieveTableFont;
- tcNoConfigChange := false;
- end;
- Result := FFont;
- end;
-{--------}
-procedure TOvcBaseTableCell.IncRefs;
- begin
- if (FReferences = 0) and Assigned(FTable) then
- FTable.tbIncludeCell(Self);
- inc(FReferences);
- end;
-{--------}
-function TOvcBaseTableCell.IsColorStored : boolean;
- begin
- Result := not TableColor;
- end;
-{--------}
-function TOvcBaseTableCell.IsFontStored : boolean;
- begin
- Result := not TableFont;
- end;
-{--------}
-procedure TOvcBaseTableCell.Notification(AComponent: TComponent; Operation: TOperation);
- begin
- inherited Notification(AComponent, Operation);
- if (AComponent is TOvcTableAncestor) and
- (Operation = opRemove) and
- (TOvcTableAncestor(AComponent) = FTable) then
- begin
- FTable := nil;
- FOnCfgChanged := nil;
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.Paint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer);
- begin
- if not DoOwnerDraw(TableCanvas, CellRect, RowNum, ColNum, CellAttr, Data) then
- tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, Data);
- end;
-{--------}
-procedure TOvcBaseTableCell.tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer);
- begin
- with TableCanvas do
- begin
- Brush.Color := CellAttr.caColor;
- FillRect(CellRect);
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.PostMessageToTable(Msg: UINT; wParam: WPARAM; lParam: LPARAM); //64
- begin
- if Assigned(FTable) and FTable.HandleAllocated then
- PostMessage(FTable.Handle, Msg, wParam, lParam)
- end;
-{--------}
-procedure TOvcBaseTableCell.tcResetTableValues;
- begin
- if Assigned(FTable) then
- begin
- if TableFont then
- tcRetrieveTableFont;
- if TableColor then
- tcRetrieveTableColor;
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.ResolveAttributes(RowNum : TRowNum; ColNum : TColNum;
- var CellAttr : TOvcCellAttributes);
- begin
- with CellAttr do
- begin
- caAccess := Access;
- caAdjust := Adjust;
- caColor := Color;
- caFont.Assign(Font);
- caFontColor := Font.Color;
- caFontHiColor := TextHiColor;
- caTextStyle := TextStyle;
- end;
- if Assigned(FTable) then
- FTable.ResolveCellAttributes(RowNum, ColNum, CellAttr);
- with CellAttr do
- begin
- if (caAccess = otxDefault) then
- caAccess := tbDefAccess;
- if (caAdjust = otaDefault) then
- caAdjust := tbDefAdjust;
- if (caColor = clOvcTableDefault) then
- caColor := tbDefTableColor;
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.tcRetrieveTableColor;
- begin
- if Assigned(FTable) and FTable.HandleAllocated then
- begin
- FColor := SendMessage(FTable.Handle, ctim_QueryColor, 0, 0);
- tcBadColorValue := false;
- end
- else
- tcBadColorValue := true;
- end;
-{--------}
-function TOvcBaseTableCell.tcRetrieveTableActiveCol : TColNum;
- begin
- Result := 0;
- if Assigned(FTable) and FTable.HandleAllocated then
- Result := SendMessage(FTable.Handle, ctim_QueryActiveCol, 0, 0);
- end;
-{--------}
-function TOvcBaseTableCell.tcRetrieveTableActiveRow : TRowNum;
- begin
- Result := 0;
- if Assigned(FTable) and FTable.HandleAllocated then
- Result := SendMessage(FTable.Handle, ctim_QueryActiveRow, 0, 0);
- end;
-{--------}
-procedure TOvcBaseTableCell.tcRetrieveTableFont;
- var
- TblFont : TFont;
- begin
- if Assigned(FTable) and FTable.HandleAllocated then
- begin
- TblFont := TFont(SendMessage(FTable.Handle, ctim_QueryFont, 0, 0));
- if Assigned(TblFont) then
- FFont.Assign(TblFont);
- tcBadFontValue := false;
- FTableFont := true;
- end
- else
- tcBadFontValue := true;
- end;
-{--------}
-function TOvcBaseTableCell.tcRetrieveTableLockedCols : TColNum;
- begin
- Result := 0;
- if Assigned(FTable) and FTable.HandleAllocated then
- Result := SendMessage(FTable.Handle, ctim_QueryLockedCols, 0, 0);
- end;
-{--------}
-function TOvcBaseTableCell.tcRetrieveTableLockedRows : TRowNum;
- begin
- Result := 0;
- if Assigned(FTable) and FTable.HandleAllocated then
- Result := SendMessage(FTable.Handle, ctim_QueryLockedRows, 0, 0);
- end;
-{--------}
-procedure TOvcBaseTableCell.SendKeyToTable(var Msg : TWMKey);
- begin
- if Assigned(FTable) and FTable.HandleAllocated then
- PostMessage(FTable.Handle, WM_KEYDOWN, Msg.CharCode, Msg.KeyData);
- end;
-{--------}
-procedure TOvcBaseTableCell.SetAccess(A : TOvcTblAccess);
- begin
- if (A <> FAccess) then
- begin
- FAccess := A;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.SetAdjust(A : TOvcTblAdjust);
- begin
- if (A <> FAdjust) then
- begin
- FAdjust := A;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.SetColor(C : TColor);
- begin
- if (C <> FColor) then
- begin
- FColor := C;
- FTableColor := false;
- tcBadColorValue := false;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.SetFont(F : TFont);
- begin
- FFont.Assign(F);
- tcBadFontValue := false;
- FTableFont := false;
- tcDoCfgChanged;
- end;
-{--------}
-procedure TOvcBaseTableCell.SetHint(const H : string);
- begin
- FHint := H;
- end;
-{--------}
-procedure TOvcBaseTableCell.SetMargin(M : Integer);
- begin
- if (M >= 0) and (M <> FMargin) then
- begin
- FMargin := M;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.SetTable(T : TOvcTableAncestor);
- begin
- if (T <> FTable) then
- if (not Assigned(T)) or (T is TOvcTableAncestor) then
- begin
- if Assigned(FTable) and FTable.HandleAllocated then
- SendMessage(FTable.Handle, ctim_RemoveCell, 0, LPARAM(Self)); //64
- FTable := T;
- FOnCfgChanged := nil;
- FReferences := 0;
- tcResetTableValues;
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.SetTableColor(B : boolean);
- begin
- if (B <> FTableColor) then
- begin
- tcBadColorValue := false;
- FTableColor := B;
- if B then
- tcRetrieveTableColor;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.SetTableFont(B : boolean);
- begin
- if (B <> FTableFont) then
- begin
- tcBadFontValue := false;
- if B then
- tcRetrieveTableFont;
- FTableFont := B;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.SetTextHiColor(THC : TColor);
- begin
- if (THC <> FTextHiColor) then
- begin
- FTextHiColor := THC;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.SetTextStyle(TS : TOvcTextStyle);
- begin
- if (TS <> FTextStyle) then
- begin
- FTextStyle := TS;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcBaseTableCell.SaveEditedData(Data : pointer);
-begin
- {do nothing. just here to satisfy BCB}
-end;
-
-procedure TOvcBaseTableCell.StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer);
-begin
- {do nothing. just here to satisfy BCB}
-end;
-
-procedure TOvcBaseTableCell.StopEditing(SaveValue : boolean;
- Data : pointer);
-begin
- {do nothing. just here to satisfy BCB}
-end;
-
-function TOvcBaseTableCell.TableWantsEnter : boolean;
- var
- Typecast : record
- case boolean of
- false : (LI : longint);
- true : (TblOpts : TOvcTblOptionSet);
- end;
- begin
- Result := false;
- if Assigned(FTable) and FTable.HandleAllocated then
- begin
- Typecast.LI := SendMessage(FTable.Handle, ctim_QueryOptions, 0, 0);
- Result := otoEnterToArrow in Typecast.TblOpts;
- end;
- end;
-{--------}
-function TOvcBaseTableCell.TableWantsTab : boolean;
- var
- Typecast : record
- case boolean of
- false : (LI : longint);
- true : (TblOpts : TOvcTblOptionSet);
- end;
- begin
- Result := false;
- if Assigned(FTable) and FTable.HandleAllocated then
- begin
- Typecast.LI := SendMessage(FTable.Handle, ctim_QueryOptions, 0, 0);
- Result := otoTabToArrow in Typecast.TblOpts;
- end;
- end;
-
-function TOvcBaseTableCell.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-
-procedure TOvcBaseTableCell.SetAbout(const Value : string);
-begin
-end;
-
-{the following three methods should be implemented for descendant }
-{cell components to allow them to be used by the data-aware table.}
-
-function TOvcBaseTableCell.SpecialCellSupported(Field : TObject) : Boolean;
-begin
- {return true if Field is a supported cell type for the data-aware table}
- Result := False;
-end;
-
-function TOvcBaseTableCell.SpecialCellDataSize : Integer;
-begin
- {return the size of the buffer needed to save data for this field/cell type}
- Result := 0;
-end;
-
-procedure TOvcBaseTableCell.SpecialCellDataTransfer(
- Field : TObject; Data : Pointer; Purpose : TOvcCellDataPurpose);
-begin
- {handle transfer of data to/from Field/Pointer}
- {as indicated by the value of Purpose:}
- {cdpForPaint ..for painting}
- {cdpForEdit ..for editing}
- {cdpForSave ..for saving edited data}
-end;
-
-
-{====================================================================}
-
-
-{===CellAttribute helper routines====================================}
-function CellAttributeIsBlank(CA : POvcSparseAttr) : boolean;
- begin
- Result := true;
- if Assigned(CA) then with CA^ do
- Result := (scaAccess = otxDefault) and
- (scaAdjust = otaDefault) and
- (scaColor = clOvcTableDefault) and
- (scaFont = nil) and
- (scaCell = nil);
- end;
-{--------}
-procedure DisposeCellAttribute(CA : POvcSparseAttr);
- begin
- if Assigned(CA) then with CA^ do
- begin
- scaFont.Free;
- if Assigned(scaCell) then
- TOvcBaseTableCell(scaCell).DecRefs;
- Dispose(CA);
- end;
- end;
-{--------}
-function GetCellAttribute(SA : TOvcSparseArray; RowNum : TRowNum; ColNum : TColNum) : POvcSparseAttr;
- var
- WorkSA : TOvcSparseArray;
- begin
- Result := nil;
- WorkSA := SA[RowNum];
- if Assigned(WorkSA) then
- Result := POvcSparseAttr(WorkSA[ColNum]);
- end;
-{--------}
-procedure InitCellAttribute(var SCA : TOvcSparseAttr);
- begin
- with SCA do
- begin
- scaAccess := otxDefault;
- scaAdjust := otaDefault;
- scaColor := clOvcTableDefault;
- scaFont := nil;
- scaCell := nil;
- end;
- end;
-{--------}
-function NewCellAttribute : POvcSparseAttr;
- begin
- New(Result);
- InitCellAttribute(Result^);
- end;
-{--------}
-function PutCellAttribute(SA : TOvcSparseArray; RowNum : TRowNum; ColNum : TColNum) : POvcSparseAttr;
- var
- WorkSA : TOvcSparseArray;
- begin
- Result := NewCellAttribute;
- WorkSA := SA[RowNum];
- if not Assigned(WorkSA) then
- begin
- WorkSA := TOvcSparseArray.Create;
- SA[RowNum] := WorkSA;
- end;
- WorkSA[ColNum] := Result;
- end;
-{--------}
-procedure ResetCellAttribute(SA : TOvcSparseArray; RowNum : TRowNum; ColNum : TColNum);
- var
- WorkSA : TOvcSparseArray;
- begin
- WorkSA := SA[RowNum];
- if Assigned(WorkSA) then
- WorkSA[ColNum] := nil;
- end;
-{====================================================================}
-
-
-{===SparseArray iterators============================================}
-type
- PDelColRec = ^TDelColRec;
- TDelColRec = packed record
- dcrCellAttrCount : longint;
- dcrColNum : longint;
- end;
- PExchColRec = ^TExchColRec;
- TExchColRec = packed record
- ecrColNum1 : longint;
- ecrColNum2 : longint;
- end;
-{--------}
-function DelCellAttribute(Index : longint;
- Item : pointer;
- ExtraData : pointer) : boolean; far;
- var
- CA : POvcSparseAttr absolute Item;
- begin
- DisposeCellAttribute(CA);
- Result := true;
- end;
-{--------}
-function DelSparseArray(Index : longint;
- Item : pointer;
- ExtraData : pointer) : boolean; far;
- var
- SL : TOvcSparseArray absolute Item;
- begin
- SL.ForAll(DelCellAttribute, false, ExtraData);
- SL.Destroy;
- Result := true;
- end;
-{--------}
-function DelCellMinor(Index : longint;
- Item : pointer;
- ExtraData : pointer) : boolean; far;
- var
- CA : POvcSparseAttr absolute Item;
- Cell : TOvcBaseTableCell absolute ExtraData;
- begin
- if (CA^.scaCell = Cell) then
- begin
- Cell.DecRefs;
- CA^.scaCell := nil;
- end;
- Result := true;
- end;
-{--------}
-function DelCellMajor(Index : longint;
- Item : pointer;
- ExtraData : pointer) : boolean; far;
- var
- SL : TOvcSparseArray absolute Item;
- begin
- SL.ForAll(DelCellMinor, false, ExtraData);
- Result := true;
- end;
-{--------}
-function DelCol(Index : longint;
- Item : pointer;
- ExtraData : pointer) : boolean; far;
- var
- SL : TOvcSparseArray absolute Item;
- MyExtraData : PDelColRec absolute ExtraData;
- CA : POvcSparseAttr;
- begin
- CA := POvcSparseAttr(SL[MyExtraData^.dcrColNum]);
- if Assigned(CA) then
- begin
- dec(MyExtraData^.dcrCellAttrCount);
- DisposeCellAttribute(CA);
- end;
- SL.Delete(MyExtraData^.dcrColNum);
- Result := true;
- end;
-{--------}
-function ExchCols(Index : longint;
- Item : pointer;
- ExtraData : pointer) : boolean; far;
- var
- SL : TOvcSparseArray absolute Item;
- MyExtraData : PExchColRec absolute ExtraData;
- begin
- with MyExtraData^ do
- SL.Exchange(ecrColNum1, ecrColNum2);
- Result := true;
- end;
-{--------}
-function InsCol(Index : longint;
- Item : pointer;
- ExtraData : pointer) : boolean; far;
- var
- SL : TOvcSparseArray absolute Item;
- ColNum : longint absolute ExtraData;
- begin
- SL.Insert(ColNum, nil);
- Result := true;
- end;
-{====================================================================}
-
-
-{===TOvcTableCells===================================================}
-constructor TOvcTableCells.Create;
- begin
- inherited Create;
- FMatrix := TOvcSparseArray.Create;
- end;
-{--------}
-destructor TOvcTableCells.Destroy;
- var
- DummyPtr : pointer;
- begin
- DummyPtr := nil;
- FMatrix.ForAll(DelSparseArray, false, DummyPtr);
- FMatrix.Destroy;
- inherited Destroy;
- end;
-{--------}
-procedure TOvcTableCells.DeleteCol(ColNum : TColNum);
- var
- MyExtraData : TDelColRec;
- begin
- if (tcCellAttrCount > 0) then
- begin
- MyExtraData.dcrCellAttrCount := tcCellAttrCount;
- MyExtraData.dcrColNum := ColNum;
- FMatrix.ForAll(DelCol, false, @MyExtraData);
- tcCellAttrCount := MyExtraData.dcrCellAttrCount;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableCells.DeleteRow(RowNum : TRowNum);
- var
- WorkSA : TOvcSparseArray;
- begin
- if (tcCellAttrCount > 0) then
- begin
- WorkSA := FMatrix[RowNum];
- if Assigned(WorkSA) then
- begin
- dec(tcCellAttrCount, WorkSA.ActiveCount);
- WorkSA.ForAll(DelCellAttribute, false, nil);
- end;
- FMatrix.Delete(RowNum);
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableCells.ExchangeCols(ColNum1, ColNum2 : TColNum);
- var
- MyExtraData : TExchColRec;
- begin
- if (tcCellAttrCount > 0) then
- begin
- MyExtraData.ecrColNum1 := ColNum1;
- MyExtraData.ecrColNum2 := ColNum2;
- FMatrix.ForAll(ExchCols, false, @MyExtraData);
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableCells.ExchangeRows(RowNum1, RowNum2 : TRowNum);
- begin
- if (tcCellAttrCount > 0) then
- begin
- FMatrix.Exchange(RowNum1, RowNum2);
- tcDoCfgChanged;
- end;
- end;
-{--------}
-function TOvcTableCells.GetAccess(RowNum : TRowNum; ColNum : TColNum) : TOvcTblAccess;
- var
- CellAttr : POvcSparseAttr;
- begin
- Result := otxDefault;
- if (tcCellAttrCount > 0) then
- begin
- CellAttr := GetCellAttribute(FMatrix, RowNum, ColNum);
- if Assigned(CellAttr) then
- Result := CellAttr^.scaAccess;
- end;
- end;
-{--------}
-function TOvcTableCells.GetAdjust(RowNum : TRowNum; ColNum : TColNum) : TOvcTblAdjust;
- var
- CellAttr : POvcSparseAttr;
- begin
- Result := otaDefault;
- if (tcCellAttrCount > 0) then
- begin
- CellAttr := GetCellAttribute(FMatrix, RowNum, ColNum);
- if Assigned(CellAttr) then
- Result := CellAttr^.scaAdjust;
- end;
- end;
-{--------}
-function TOvcTableCells.GetCell(RowNum : TRowNum; ColNum : TColNum) : TOvcBaseTableCell;
- var
- CellAttr : POvcSparseAttr;
- begin
- Result := nil;
- if (tcCellAttrCount > 0) then
- begin
- CellAttr := GetCellAttribute(FMatrix, RowNum, ColNum);
- if Assigned(CellAttr) then
- Result := TOvcBaseTableCell(CellAttr^.scaCell);
- end;
- end;
-{--------}
-function TOvcTableCells.GetColor(RowNum : TRowNum; ColNum : TColNum) : TColor;
- var
- CellAttr : POvcSparseAttr;
- begin
- Result := clOvcTableDefault;
- if (tcCellAttrCount > 0) then
- begin
- CellAttr := GetCellAttribute(FMatrix, RowNum, ColNum);
- if Assigned(CellAttr) then
- Result := CellAttr^.scaColor;
- end;
- end;
-{--------}
-function TOvcTableCells.GetFont(RowNum : TRowNum; ColNum : TColNum) : TFont;
- var
- CellAttr : POvcSparseAttr;
- begin
- Result := nil;
- if (tcCellAttrCount > 0) then
- begin
- CellAttr := GetCellAttribute(FMatrix, RowNum, ColNum);
- if Assigned(CellAttr) then
- Result := CellAttr^.scaFont;
- end;
- end;
-{--------}
-procedure TOvcTableCells.InsertCol(ColNum : TColNum);
- var
- LI : longint;
- begin
- if (tcCellAttrCount > 0) then
- begin
- LI := ColNum;
- FMatrix.ForAll(InsCol, false, pointer(LI));
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableCells.InsertRow(RowNum : TRowNum);
- begin
- if (tcCellAttrCount > 0) then
- begin
- FMatrix.Insert(RowNum, nil);
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableCells.tcNotifyCellDeletion(Cell : TOvcBaseTableCell);
- begin
- if (tcCellAttrCount > 0) then
- FMatrix.ForAll(DelCellMajor, false, Cell);
- end;
-{--------}
-procedure TOvcTableCells.ResolveFullAttr(RowNum : TRowNum; ColNum : TColNum;
- var SCA : TOvcSparseAttr);
- var
- CellAttr : POvcSparseAttr;
- begin
- if (tcCellAttrCount = 0) then
- InitCellAttribute(SCA)
- else
- begin
- CellAttr := GetCellAttribute(FMatrix, RowNum, ColNum);
- if Assigned(CellAttr) then
- SCA := CellAttr^
- else
- InitCellAttribute(SCA);
- end;
- end;
-{--------}
-procedure TOvcTableCells.tcDoCfgChanged;
- begin
- if Assigned(FOnCfgChanged) then FOnCfgChanged(Self);
- end;
-{--------}
-procedure TOvcTableCells.ResetCell(RowNum : TRowNum; ColNum : TColNum);
- var
- CellAttr : POvcSparseAttr;
- begin
- if (tcCellAttrCount > 0) then
- begin
- CellAttr := GetCellAttribute(FMatrix, RowNum, ColNum);
- if Assigned(CellAttr) then
- begin
- DisposeCellAttribute(CellAttr);
- ResetCellAttribute(FMatrix, RowNum, ColNum);
- dec(tcCellAttrCount);
- tcDoCfgChanged;
- end;
- end;
- end;
-{--------}
-procedure TOvcTableCells.SetAccess(RowNum : TRowNum; ColNum : TColNum; A : TOvcTblAccess);
- var
- CellAttr : POvcSparseAttr;
- begin
- if (tcCellAttrCount = 0) then
- CellAttr := nil
- else
- CellAttr := GetCellAttribute(FMatrix, RowNum, ColNum);
- if not Assigned(CellAttr) then
- begin
- CellAttr := PutCellAttribute(FMatrix, RowNum, ColNum);
- inc(tcCellAttrCount);
- end;
- CellAttr^.scaAccess := A;
- if CellAttributeIsBlank(CellAttr) then
- begin
- DisposeCellAttribute(CellAttr);
- ResetCellAttribute(FMatrix, RowNum, ColNum);
- dec(tcCellAttrCount);
- end;
- tcDoCfgChanged;
- end;
-{--------}
-procedure TOvcTableCells.SetAdjust(RowNum : TRowNum; ColNum : TColNum; A : TOvcTblAdjust);
- var
- CellAttr : POvcSparseAttr;
- begin
- if (tcCellAttrCount = 0) then
- CellAttr := nil
- else
- CellAttr := GetCellAttribute(FMatrix, RowNum, ColNum);
- if not Assigned(CellAttr) then
- begin
- CellAttr := PutCellAttribute(FMatrix, RowNum, ColNum);
- inc(tcCellAttrCount);
- end;
- CellAttr^.scaAdjust := A;
- if CellAttributeIsBlank(CellAttr) then
- begin
- DisposeCellAttribute(CellAttr);
- ResetCellAttribute(FMatrix, RowNum, ColNum);
- dec(tcCellAttrCount);
- end;
- tcDoCfgChanged;
- end;
-{--------}
-procedure TOvcTableCells.SetCell(RowNum : TRowNum; ColNum : TColNum; BTC : TOvcBaseTableCell);
- var
- CellAttr : POvcSparseAttr;
- DoIt : boolean;
- begin
- DoIt := false;
- if Assigned(BTC) then
- begin
- if (BTC.References = 0) or
- ((BTC.References > 0) and (BTC.Table = FTable)) then
- DoIt := true;
- end
- else
- DoIt := true;
-
- if DoIt then
- begin
- if (tcCellAttrCount = 0) then
- CellAttr := nil
- else
- CellAttr := GetCellAttribute(FMatrix, RowNum, ColNum);
- if not Assigned(CellAttr) then
- begin
- CellAttr := PutCellAttribute(FMatrix, RowNum, ColNum);
- inc(tcCellAttrCount);
- end;
- if Assigned(CellAttr^.scaCell) then
- TOvcBaseTableCell(CellAttr^.scaCell).DecRefs;
- if Assigned(BTC) then
- begin
- if (BTC.References = 0) then
- BTC.Table := FTable;
- BTC.IncRefs;
- end;
- CellAttr^.scaCell := BTC;
- if CellAttributeIsBlank(CellAttr) then
- begin
- DisposeCellAttribute(CellAttr);
- ResetCellAttribute(FMatrix, RowNum, ColNum);
- dec(tcCellAttrCount);
- end;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTableCells.SetColor(RowNum : TRowNum; ColNum : TColNum; C : TColor);
- var
- CellAttr : POvcSparseAttr;
- begin
- if (tcCellAttrCount = 0) then
- CellAttr := nil
- else
- CellAttr := GetCellAttribute(FMatrix, RowNum, ColNum);
- if not Assigned(CellAttr) then
- begin
- CellAttr := PutCellAttribute(FMatrix, RowNum, ColNum);
- inc(tcCellAttrCount);
- end;
- CellAttr^.scaColor := C;
- if CellAttributeIsBlank(CellAttr) then
- begin
- DisposeCellAttribute(CellAttr);
- ResetCellAttribute(FMatrix, RowNum, ColNum);
- dec(tcCellAttrCount);
- end;
- tcDoCfgChanged;
- end;
-{--------}
-procedure TOvcTableCells.SetFont(RowNum : TRowNum; ColNum : TColNum; F : TFont);
- var
- CellAttr : POvcSparseAttr;
- begin
- if (tcCellAttrCount = 0) then
- CellAttr := nil
- else
- CellAttr := GetCellAttribute(FMatrix, RowNum, ColNum);
- if not Assigned(CellAttr) then
- begin
- CellAttr := PutCellAttribute(FMatrix, RowNum, ColNum);
- inc(tcCellAttrCount);
- end;
- with CellAttr^ do
- begin
- if not Assigned(F) then
- begin
- scaFont.Free;
- scaFont := nil;
- end
- else
- begin
- if not Assigned(scaFont) then
- scaFont := TFont.Create;
- scaFont.Assign(F);
- end;
- end;
- if CellAttributeIsBlank(CellAttr) then
- begin
- DisposeCellAttribute(CellAttr);
- ResetCellAttribute(FMatrix, RowNum, ColNum);
- dec(tcCellAttrCount);
- end;
- tcDoCfgChanged;
- end;
-{====================================================================}
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovctcgly.pas b/Source/3rdParty/Orpheus/ovctcgly.pas
deleted file mode 100644
index be6ba326..00000000
--- a/Source/3rdParty/Orpheus/ovctcgly.pas
+++ /dev/null
@@ -1,469 +0,0 @@
-{*********************************************************}
-{* OVCTCGLY.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 ovctcgly;
- {-Orpheus Table Cell - Glyph type}
-
-interface
-
-uses
- SysUtils, Classes,
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Graphics, Controls,
- OvcTCmmn, OvcTCell, OvcTGRes, OvcTCBmp;
-
-type
- TOvcTCGlyphEdit = class(TCustomControl)
- protected {private}
- {.Z+}
- FValue : Integer;
- FCell : TOvcBaseTableCell;
- FRow : TRowNum;
- FCol : TColNum;
- FCellAttr : TOvcCellAttributes;
- {.Z-}
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
-
- protected
- {.Z+}
- procedure SetValue(V : integer);
-
- procedure WMGetDlgCode(var Msg : TMessage); message WM_GETDLGCODE;
- procedure WMKeyDown(var Msg : TWMKey); message WM_KEYDOWN;
- procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS;
- procedure WMLButtonDown(var Msg : TWMMouse); message WM_LBUTTONDOWN;
- procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
- {.Z-}
-
- public
- constructor Create(AOwner : TComponent); override;
- procedure Paint; override;
-
- property CellOwner : TOvcBaseTableCell
- read FCell write FCell;
- property Value : integer
- read FValue write SetValue;
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D;
-{$ENDIF}
- end;
-
- TOvcTCCustomGlyph = class(TOvcTCBaseBitMap)
- protected {private}
- {.Z+}
- FCellGlyphs : TOvcCellGlyphs;
- FEdit : TOvcTCGlyphEdit;
- {.Z-}
-
- protected
- {.Z+}
- function GetCellEditor : TControl; override;
- procedure SetCellGlyphs(CBG : TOvcCellGlyphs);
-
- procedure GlyphsHaveChanged(Sender : TObject);
-
- {painting}
- procedure tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer); override;
- {.Z-}
-
- {properties}
- property CellGlyphs : TOvcCellGlyphs
- read FCellGlyphs write SetCellGlyphs;
-
- public
- {create/destroy}
- constructor Create(AOwner : TComponent); override;
- destructor Destroy; override;
- function CreateEditControl : TOvcTCGlyphEdit; virtual;
-
- function CanAssignGlyphs(CBG : TOvcCellGlyphs) : boolean; virtual;
-
- function EditHandle : THandle; override;
- procedure EditHide; override;
- procedure EditMove(CellRect : TRect); override;
-
- procedure SaveEditedData(Data : pointer); override;
- procedure StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer); override;
- procedure StopEditing(SaveValue : boolean;
- Data : pointer); override;
-
- end;
-
- TOvcTCGlyph = class(TOvcTCCustomGlyph)
- published
- {properties inherited from custom ancestor}
- property AcceptActivationClick default True;
- property Access default otxDefault;
- property Adjust default otaDefault;
- property CellGlyphs;
- property Color;
- property Hint;
- property Margin default 4;
- property ShowHint default False;
- property Table;
- property TableColor default True;
-
- {events inherited from custom ancestor}
- property OnClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnOwnerDraw;
- end;
-
-implementation
-
-
-{===TOvcTCCustomGlyph creation/destruction===========================}
-constructor TOvcTCCustomGlyph.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
- FCellGlyphs := TOvcCellGlyphs.Create;
- FCellGlyphs.OnCfgChanged := GlyphsHaveChanged;
- FAcceptActivationClick := true;
- end;
-{--------}
-destructor TOvcTCCustomGlyph.Destroy;
- begin
- FCellGlyphs.Free;
- inherited Destroy;
- end;
-{--------}
-function TOvcTCCustomGlyph.CanAssignGlyphs(CBG : TOvcCellGlyphs) : boolean;
- begin
- Result := true;
- end;
-{--------}
-function TOvcTCCustomGlyph.CreateEditControl : TOvcTCGlyphEdit;
- begin
- Result := TOvcTCGlyphEdit.Create(FTable);
- end;
-{--------}
-function TOvcTCCustomGlyph.GetCellEditor : TControl;
- begin
- Result := FEdit;
- end;
-{--------}
-procedure TOvcTCCustomGlyph.GlyphsHaveChanged(Sender : TObject);
- begin
- tcDoCfgChanged;
- end;
-{--------}
-procedure TOvcTCCustomGlyph.SetCellGlyphs(CBG : TOvcCellGlyphs);
- begin
- if CanAssignGlyphs(CBG) then
- FCellGlyphs.Assign(CBG);
- end;
-{====================================================================}
-
-
-{===TOvcTCCustomGlyph painting================================}
-procedure TOvcTCCustomGlyph.tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer);
- var
- B : ^integer absolute Data;
- BitMapInfo : TCellBitMapInfo;
- begin
- {set up a bitmap info record}
- with BitMapInfo do
- begin
- BM := FCellGlyphs.BitMap;
- ActiveCount := FCellGlyphs.ActiveGlyphCount;
- Count := FCellGlyphs.GlyphCount;
- if (Data = nil) then
- begin
- if (csDesigning in ComponentState) then
- Index := (RowNum mod ActiveCount) {for testing purposes}
- else
- Index := -1
- end
- else
- Index := B^;
- if (Index >= ActiveCount) then
- Index := pred(ActiveCount);
- end;
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, @BitMapInfo);
- end;
-{====================================================================}
-
-
-{===TOvcTCCustomGlyph editing========================================}
-function TOvcTCCustomGlyph.EditHandle : THandle;
- begin
- if Assigned(FEdit) then
- Result := FEdit.Handle
- else
- Result := 0;
- end;
-{--------}
-procedure TOvcTCCustomGlyph.EditHide;
- begin
- if Assigned(FEdit) then
- with FEdit do
- begin
- SetWindowPos(FEdit.Handle, HWND_TOP,
- 0, 0, 0, 0,
- SWP_HIDEWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- end;
- end;
-{--------}
-procedure TOvcTCCustomGlyph.EditMove(CellRect : TRect);
- var
- EditHandle : HWND;
- begin
- if Assigned(FEdit) then
- begin
- EditHandle := FEdit.Handle;
- with CellRect do
- SetWindowPos(EditHandle, HWND_TOP,
- Left, Top, Right-Left, Bottom-Top,
- SWP_SHOWWINDOW or SWP_NOREDRAW or SWP_NOZORDER);
- InvalidateRect(EditHandle, nil, false);
- UpdateWindow(EditHandle);
- end;
- end;
-{--------}
-procedure TOvcTCCustomGlyph.SaveEditedData(Data : pointer);
- begin
- if Assigned(Data) then
- Integer(Data^) := FEdit.Value;
- end;
-{--------}
-procedure TOvcTCCustomGlyph.StartEditing(RowNum : TRowNum; ColNum : TColNum;
- CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- CellStyle: TOvcTblEditorStyle;
- Data : pointer);
- begin
- FEdit := CreateEditControl;
- with FEdit do
- begin
- CellOwner := Self;
- if Data = nil then
- Value := 0
- else
- Value := Integer(Data^);
- FRow := RowNum;
- FCol := ColNum;
- FCellAttr := CellAttr;
- Color := CellAttr.caColor;
- Ctl3D := false;
- case CellStyle of
- tes3D : Ctl3D := true;
- end;{case}
- Left := CellRect.Left;
- Top := CellRect.Top;
- Width := CellRect.Right - CellRect.Left;
- Height := CellRect.Bottom - CellRect.Top;
- Hint := Self.Hint;
- ShowHint := Self.ShowHint;
- Parent := FTable;
- Visible := true;
- TabStop := false;
-
- OnClick := Self.OnClick;
- OnDblClick := Self.OnDblClick;
- OnDragDrop := Self.OnDragDrop;
- OnDragOver := Self.OnDragOver;
- OnEndDrag := Self.OnEndDrag;
- OnEnter := Self.OnEnter;
- OnExit := Self.OnExit;
- OnKeyDown := Self.OnKeyDown;
- OnKeyPress := Self.OnKeyPress;
- OnKeyUp := Self.OnKeyUp;
- OnMouseDown := Self.OnMouseDown;
- OnMouseMove := Self.OnMouseMove;
- OnMouseUp := Self.OnMouseUp;
- end;
- end;
-{--------}
-procedure TOvcTCCustomGlyph.StopEditing(SaveValue : boolean;
- Data : pointer);
- begin
- if SaveValue and Assigned(Data) then
- Integer(Data^) := FEdit.Value;
- FEdit.Free;
- FEdit := nil;
- end;
-{====================================================================}
-
-
-{---TOvcTCGlyphEdit===========================================}
-constructor TOvcTCGlyphEdit.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
- ControlStyle := ControlStyle - [csDoubleClicks];
- end;
-{--------}
-procedure TOvcTCGlyphEdit.Paint;
- var
- R : TRect;
- begin
-{$IFNDEF LCL}
- Windows.GetClientRect(Handle, R);
-{$ELSE}
- LclIntf.GetClientRect(Handle, R);
-{$ENDIF}
- FCell.Paint(Canvas, R, FRow, FCol, FCellAttr, @FValue);
- end;
-{--------}
-procedure TOvcTCGlyphEdit.SetValue(V : integer);
- begin
- if (V <> FValue) then
- begin
- if (V < 0) then
- V := 0
- else if (V >= TOvcTCGlyph(CellOwner).CellGlyphs.ActiveGlyphCount) then
- V := TOvcTCGlyph(CellOwner).CellGlyphs.ActiveGlyphCount;
- FValue := V;
- if HandleAllocated then
- begin
- Invalidate;
- Update;
- end;
- end;
- end;
-{--------}
-procedure TOvcTCGlyphEdit.WMGetDlgCode(var Msg : TMessage);
- begin
- Msg.Result := DLGC_WANTARROWS;
- if CellOwner.TableWantsTab then
- Msg.Result := Msg.Result or DLGC_WANTTAB;
- if CellOwner.TableWantsEnter then
- Msg.Result := Msg.Result or DLGC_WANTALLKEYS;
- end;
-{--------}
-procedure TOvcTCGlyphEdit.WMKeyDown(var Msg : TWMKey);
- var
- GridReply : TOvcTblKeyNeeds;
- GridUsedIt : boolean;
- begin
- GridUsedIt := false;
- GridReply := otkDontCare;
- if (CellOwner <> nil) then
- GridReply := CellOwner.FilterTableKey(Msg);
- case GridReply of
- otkMustHave :
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- otkWouldLike :
- if Msg.CharCode <> VK_SPACE then
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;{case}
-
- if not GridUsedIt then
- begin
- inherited;
- if (Msg.CharCode = VK_SPACE) then
- begin
- inc(FValue);
- if (FValue >= TOvcTCGlyph(FCell).FCellGlyphs.ActiveGlyphCount) then
- FValue := 0;
- Invalidate;
- Update;
-
- if ((@TOvcTCGlyph(FCell).FOnClick) <> nil) then
- OnClick(Self);
- end
- else if (Msg.CharCode = VK_BACK) then
- begin
- dec(FValue);
- if (FValue < 0) then
- FValue := pred(TOvcTCGlyph(FCell).FCellGlyphs.ActiveGlyphCount);
- Invalidate;
- Update;
-
- if ((@TOvcTCGlyph(FCell).FOnClick) <> nil) then
- OnClick(Self);
- end;
- end;
- end;
-{--------}
-procedure TOvcTCGlyphEdit.WMLButtonDown(var Msg : TWMMouse);
- begin
- inc(FValue);
- if (FValue >= TOvcTCGlyph(FCell).FCellGlyphs.ActiveGlyphCount) then
- FValue := 0;
- Invalidate;
- Update;
-
- inherited;
- end;
-{--------}
-procedure TOvcTCGlyphEdit.WMKillFocus(var Msg : TWMKillFocus);
- begin
- inherited;
- CellOwner.PostMessageToTable(ctim_KillFocus, Msg.FocusedWnd, 0);
- end;
-{--------}
-procedure TOvcTCGlyphEdit.WMSetFocus(var Msg : TWMSetFocus);
- begin
- inherited;
- CellOwner.PostMessageToTable(ctim_SetFocus, Msg.FocusedWnd, 0);
- end;
-{====================================================================}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovctchdr.pas b/Source/3rdParty/Orpheus/ovctchdr.pas
deleted file mode 100644
index c474f606..00000000
--- a/Source/3rdParty/Orpheus/ovctchdr.pas
+++ /dev/null
@@ -1,467 +0,0 @@
-{*********************************************************}
-{* OVCTCHDR.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 ovctchdr;
- {Orpheus Table Cell - Headers for columns and rows}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, {$ENDIF}
- SysUtils, Graphics, Classes, OvcTCmmn, OvcTCell, OvcTCStr;
-
-type
- TOvcTCColHead = class(TOvcTCBaseString)
- protected {private}
- {.Z+}
- FHeadings : TStringList;
- FShowActiveCol : boolean;
- FShowLetters : boolean;
- {.Z-}
-
- protected
- {.Z+}
- procedure SetHeadings(H : TStringList);
- procedure SetShowActiveCol(SAC : boolean);
- procedure SetShowLetters(SL : boolean);
-
- procedure tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer); override;
- {.Z-}
-
- public {protected}
- {.Z+}
- procedure chColumnsChanged(ColNum1, ColNum2 : TColNum; Action : TOvcTblActions);
- {.Z-}
-
- public
- constructor Create(AOwner : TComponent); override;
- destructor Destroy; override;
-
- published
- property Headings : TStringList
- read FHeadings write SetHeadings;
-
- property ShowActiveCol : boolean
- read FShowActiveCol write SetShowActiveCol
- default False;
-
- property ShowLetters : boolean
- read FShowLetters write SetShowLetters
- default True;
-
- {properties inherited from custom ancestor}
- property About;
- property Adjust default otaDefault;
- property Color;
- property Font;
- property Margin default 4;
- property Table;
- property TableColor default True;
- property TableFont default True;
- property TextHiColor default clBtnHighlight;
- property TextStyle default tsFlat;
- property UseASCIIZStrings default False;
- property UseWordWrap default False;
-
- {events inherited from custom ancestor}
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnOwnerDraw;
- end;
-
- TOvcTCRowHead = class(TOvcTCBaseString)
- protected {private}
- {.Z+}
- FShowActiveRow : boolean;
- FShowNumbers : boolean;
- {.Z-}
-
- protected
- {.Z+}
- procedure SetShowActiveRow(SAR : boolean);
- procedure SetShowNumbers(SN : boolean);
- procedure tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer); override;
- {.Z-}
-
- public
- constructor Create(AOwner : TComponent); override;
-
- published
- property ShowActiveRow : boolean
- read FShowActiveRow write SetShowActiveRow
- default False;
-
- property ShowNumbers : boolean
- read FShowNumbers write SetShowNumbers
- default True;
-
- {properties inherited from custom ancestor}
- property About;
- property Adjust default otaDefault;
- property Color;
- property Font;
- property Margin default 4;
- property Table;
- property TableColor default True;
- property TableFont default True;
- property TextHiColor default clBtnHighlight;
- property TextStyle default tsFlat;
-
- {events inherited from custom ancestor}
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnOwnerDraw;
- end;
-
-implementation
-
-
-
-{===TOvcTCColHead====================================================}
-constructor TOvcTCColHead.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
- FHeadings := TStringList.Create;
- Access := otxReadOnly;
- UseASCIIZStrings := false;
- {UseWordWrap := false;}
- ShowLetters := true;
- end;
-{--------}
-destructor TOvcTCColHead.Destroy;
- begin
- FHeadings.Free;
- inherited Destroy;
- end;
-{--------}
-procedure TOvcTCColHead.chColumnsChanged(ColNum1, ColNum2 : TColNum;
- Action : TOvcTblActions);
- var
- MaxColNum : TColNum;
- ColNum : TColNum;
- Temp : string;
- begin
- case Action of
- taInsert :
- if (0 <= ColNum1) and (ColNum1 < FHeadings.Count) then
- FHeadings.Insert(ColNum1, '')
- else if (ColNum1 = FHeadings.Count) then
- FHeadings.Add('');
- taDelete :
- if (0 <= ColNum1) and (ColNum1 < FHeadings.Count) then
- FHeadings.Delete(ColNum1);
- taExchange :
- begin
- MaxColNum := MaxL(ColNum1, ColNum2);
- if (MaxColNum >= FHeadings.Count) and (FHeadings.Count > 0) then
- for ColNum := FHeadings.Count to MaxColNum do
- FHeadings.Add('');
- if (0 <= ColNum1) and (0 <= ColNum2) and
- (FHeadings.Count > 0) then
- begin
- Temp := FHeadings[ColNum1];
- FHeadings[ColNum1] := FHeadings[ColNum2];
- FHeadings[ColNum2] := Temp;
- end;
- end;
- end;
- end;
-{--------}
-procedure TOvcTCColHead.tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer);
- {------}
- procedure PaintAnArrow;
- var
- ArrowDim : Integer;
- X, Y : Integer;
- LeftPoint, RightPoint, BottomPoint : TPoint;
- CellWidth : integer;
- CellHeight : integer;
- begin
- CellWidth := CellRect.Right - CellRect.Left;
- CellHeight := CellRect.Bottom - CellRect.Top;
- with TableCanvas do
- begin
- Pen.Color := CellAttr.caFont.Color;
- Brush.Color := Pen.Color;
- ArrowDim := MinI(CellWidth, CellHeight) div 3;
- case CellAttr.caAdjust of
- otaTopLeft, otaCenterLeft, otaBottomLeft:
- X := Margin;
- otaTopRight, otaCenterRight, otaBottomRight:
- X := CellWidth-Margin-ArrowDim;
- else
- X := (CellWidth - ArrowDim) div 2;
- end;{case}
- inc(X, CellRect.Left);
- case CellAttr.caAdjust of
- otaTopLeft, otaTopCenter, otaTopRight:
- Y := Margin;
- otaBottomLeft, otaBottomCenter, otaBottomRight:
- Y := CellHeight-Margin-ArrowDim;
- else
- Y := (CellHeight - ArrowDim) div 2;
- end;{case}
- inc(Y, CellRect.Top);
- LeftPoint := Point(X, Y);
- RightPoint := Point(X+ArrowDim, Y);
- BottomPoint := Point(X+(ArrowDim div 2), Y+ArrowDim);
- Polygon([LeftPoint, RightPoint, BottomPoint]);
- end;
- end;
- {------}
- var
- DataSt : POvcShortString absolute Data;
- LockedCols: TColNum;
- ActiveCol : TColNum;
- WorkCol : TColNum;
- C : string[1];
- HeadSt : ShortString;
- CA : TOvcCellAttributes;
- begin
- CA := CellAttr;
- if Assigned(FTable) then
- begin
- LockedCols := tcRetrieveTableLockedCols;
- ActiveCol := tcRetrieveTableActiveCol;
- end
- else
- begin
- LockedCols := 0;
- ActiveCol := -1;
- end;
- HeadSt := '';
- { Set the cell color and font }
- if not TableColor then
- CA.caColor := Color;
- if not TableFont then begin
- CA.caFont.Assign(Font);
- CA.caFontColor := Font.Color;
- end;
- { if required show a down arrow for the active column }
- if ShowActiveCol and (ColNum = ActiveCol) then
- begin
- {this call to inherited tcPaint blanks out the cell}
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CA,
- @HeadSt);
- PaintAnArrow;
- end
- else if ShowLetters then
- begin
- {convert the column number to the spreadsheet-style letters}
- WorkCol := ColNum - LockedCols + 1;
- HeadSt := '.';
- while (WorkCol > 0) do
- begin
- C := AnsiChar(pred(WorkCol) mod 26 + ord('A'));
- System.Insert(C, HeadSt, 1);
- WorkCol := pred(WorkCol) div 26;
- end;
- Delete(HeadSt, length(HeadSt), 1);
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CA,
- @HeadSt);
- end
- else {Data points to a column heading}
- begin
- if Assigned(Data) then
- HeadSt := DataSt^
- else if (0 <= ColNum) and (ColNum < Headings.Count) then
- HeadSt := Headings[ColNum];
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CA,
- @HeadSt);
- end;
- end;
-{--------}
-procedure TOvcTCColHead.SetHeadings(H : TStringList);
- begin
- FHeadings.Assign(H);
- tcDoCfgChanged;
- end;
-{--------}
-procedure TOvcTCColHead.SetShowActiveCol(SAC : boolean);
- begin
- if (SAC <> ShowActiveCol) then
- begin
- FShowActiveCol := SAC;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTCColHead.SetShowLetters(SL : boolean);
- begin
- if (SL <> ShowLetters) then
- begin
- FShowLetters := SL;
- tcDoCfgChanged;
- end;
- end;
-{====================================================================}
-
-{===TOvcTCRowHead====================================================}
-constructor TOvcTCRowHead.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
- Access := otxReadOnly;
- UseASCIIZStrings := false;
- UseWordWrap := false;
- ShowNumbers := true;
- end;
-{--------}
-procedure TOvcTCRowHead.tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer);
- {------}
- procedure PaintAnArrow;
- var
- ArrowDim : Integer;
- X, Y : Integer;
- TopPoint, BottomPoint, RightPoint : TPoint;
- CellWidth : integer;
- CellHeight : integer;
- begin
- CellWidth := CellRect.Right - CellRect.Left;
- CellHeight := CellRect.Bottom - CellRect.Top;
- with TableCanvas do
- begin
- Pen.Color := CellAttr.caFont.Color;
- Brush.Color := Pen.Color;
- ArrowDim := MinI(CellWidth-8, CellHeight div 3);
- case CellAttr.caAdjust of
- otaTopLeft, otaCenterLeft, otaBottomLeft : X := Margin;
- otaTopRight, otaCenterRight, otaBottomRight : X := CellWidth-Margin-ArrowDim;
- else
- X := (CellWidth - ArrowDim) div 2;
- end;{case}
- inc(X, CellRect.Left);
- case CellAttr.caAdjust of
- otaTopLeft, otaTopCenter, otaTopRight : Y := Margin;
- otaBottomLeft, otaBottomCenter, otaBottomRight : Y := CellHeight-Margin-ArrowDim;
- else
- Y := (CellHeight - ArrowDim) div 2;
- end;{case}
- inc(Y, CellRect.Top);
- TopPoint := Point(X, Y);
- BottomPoint := Point(X, Y+ArrowDim);
- RightPoint := Point(X+ArrowDim, Y+(ArrowDim div 2));
- Polygon([RightPoint, TopPoint, BottomPoint]);
- end;
- end;
- {------}
- var
- HeadSt : ShortString;
- ActiveRow : TRowNum;
- LockedRows : TRowNum;
- WorkRow : TRowNum;
- begin
- if Assigned(FTable) then
- begin
- LockedRows := tcRetrieveTableLockedRows;
- ActiveRow := tcRetrieveTableActiveRow;
- end
- else
- begin
- LockedRows := 0;
- ActiveRow := -1;
- end;
- {display the row number, etc}
- HeadSt := '';
- if (ShowActiveRow and (RowNum = ActiveRow)) then
- begin
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, @HeadSt);
- PaintAnArrow;
- end
- else
- begin
- if ShowNumbers then
- begin
- WorkRow := (RowNum + 1) - LockedRows;
- HeadSt := Format('%d', [WorkRow]);
- end;
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, @HeadSt);
- end;
- end;
-{--------}
-procedure TOvcTCRowHead.SetShowActiveRow(SAR : boolean);
- begin
- if (SAR <> ShowActiveRow) then
- begin
- FShowActiveRow := SAR;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTCRowHead.SetShowNumbers(SN : boolean);
- begin
- if (SN <> ShowNumbers) then
- begin
- FShowNumbers := SN;
- tcDoCfgChanged;
- end;
- end;
-{====================================================================}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovctcico.pas b/Source/3rdParty/Orpheus/ovctcico.pas
deleted file mode 100644
index 7904ff5b..00000000
--- a/Source/3rdParty/Orpheus/ovctcico.pas
+++ /dev/null
@@ -1,147 +0,0 @@
-{*********************************************************}
-{* OVCTCICO.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 ovctcico;
- {-Orpheus Table Cell - Icon type}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, {$ENDIF}
- SysUtils, Messages, Graphics, Classes, OvcTCmmn, OvcTCell;
-
-type
- TOvcTCCustomIcon = class(TOvcBaseTableCell)
- protected
- {.Z+}
- procedure tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer); override;
- {.Z-}
- public
- {.Z+}
- procedure ResolveAttributes(RowNum : TRowNum; ColNum : TColNum;
- var CellAttr : TOvcCellAttributes); override;
- {.Z-}
- end;
-
- TOvcTCIcon = class(TOvcTCCustomIcon)
- published
- {properties inherited from custom ancestor}
- property AcceptActivationClick default False;
- property Access default otxDefault;
- property Adjust default otaDefault;
- property Color;
- property Margin default 4;
- property Table;
- property TableColor default True;
- property OnOwnerDraw;
- end;
-
-
-implementation
-
-
-{===TOvcTCBaseBitMap=================================================}
-procedure TOvcTCCustomIcon.tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer);
- var
- Icon : TIcon absolute Data;
- Wd, Ht : integer;
- CellWidth : integer;
- CellHeight : integer;
- Left, Top : integer;
- CellAdj : TOvcTblAdjust;
- begin
- {blank out the cell (also sets the brush color)}
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, Data);
- {nothing else to do if the data is nil or the cell in invisible}
- if (Data = nil) or
- (CellAttr.caAccess = otxInvisible) then
- Exit;
- {make a note of the adjustment, calc the cell width and height}
- CellAdj := CellAttr.caAdjust;
- CellWidth := CellRect.Right - CellRect.Left;
- CellHeight := CellRect.Bottom - CellRect.Top;
- {get the width/height of the icon}
- with Icon do
- begin
- Wd := Width;
- Ht := Height;
- end;
- {calculate the destination position}
- case CellAdj of
- otaTopLeft, otaCenterLeft, otaBottomLeft :
- Left := Margin;
- otaTopRight, otaCenterRight, otaBottomRight :
- Left := (CellWidth - Wd - Margin);
- else
- Left := (CellWidth - Wd) div 2;
- end;{case}
- inc(Left, CellRect.Left);
- case CellAdj of
- otaTopLeft, otaTopCenter, otaTopRight :
- Top := Margin;
- otaBottomLeft, otaBottomCenter, otaBottomRight :
- Top := (CellHeight - Ht - Margin);
- else
- Top := (CellHeight - Ht) div 2;
- end;{case}
- inc(Top, CellRect.Top);
-
- TableCanvas.Draw(Left, Top, Icon);
- end;
-{--------}
-procedure TOvcTCCustomIcon.ResolveAttributes(RowNum : TRowNum; ColNum : TColNum;
- var CellAttr : TOvcCellAttributes);
- begin
- inherited ResolveAttributes(RowNum, ColNum, CellAttr);
- case CellAttr.caAccess of
- otxDefault, otxNormal : CellAttr.caAccess := otxReadOnly;
- end;{case}
- end;
-{====================================================================}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovctcmmn.pas b/Source/3rdParty/Orpheus/ovctcmmn.pas
deleted file mode 100644
index ef28a80c..00000000
--- a/Source/3rdParty/Orpheus/ovctcmmn.pas
+++ /dev/null
@@ -1,813 +0,0 @@
-{*********************************************************}
-{* OVCTCMMN.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 ovctcmmn;
- {-Orpheus table: common unit}
-
-interface
-
-uses
- SysUtils, Classes,
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Graphics, Forms, StdCtrls, Controls,
- OvcBase, OvcData, OvcExcpt;
-
-{---Enumeration types}
-type
- TOvcTblAdjust = ( {data adjustment in cell}
- otaDefault, {the default for the next higher class}
- otaTopLeft, {top left hand corner}
- otaTopCenter, {top, centered horizontally}
- otaTopRight, {top right hand corner}
- otaCenterLeft, {left hand side, centered vertically}
- otaCenter, {centered vertically and horizontally}
- otaCenterRight, {right hand side, centered vertically}
- otaBottomLeft, {bottom left hand corner}
- otaBottomCenter, {bottom, centered horizontally}
- otaBottomRight); {bottom right hand corner}
-
- TOvcTblAccess = ( {cell access types}
- otxDefault, {the default for the next higher class}
- otxNormal, {read & write}
- otxReadOnly, {read only, no write}
- otxInvisible); {no read or write, ie invisible}
-
- TOvcTblState = ( {grid states}
- {..Major}
- otsFocused, { focused, or cell being edited}
- otsUnfocused, { unfocused}
- otsDesigning, { being designed}
- {..Minor}
- otsNormal, { normal}
- otsEditing, { cell being edited}
- otsHiddenEdit, { ditto, however currently hidden}
- otsMouseSelect, { mouse is selecting}
- otsShowSize, { row/col sizing cursor shown}
- otsSizing, { row/col being resized}
- otsShowMove, { row/col move cursor shown}
- otsMoving, { row/col is being moved}
- {..Qualifiers}
- otsDoingRow, { moving/sizing a row}
- otsDoingCol, { moving/sizing a column}
-
- otsANOther);
- TOvcTblStates = set of TOvcTblState;
-
- TOvcTblKeyNeeds = ( {grid's requirements for keystrokes}
- otkDontCare, {grid does not need key}
- otkWouldLike, {grid would like key, but cell can take it}
- otkMustHave); {grid must have key}
-
- TOvcTblRegion = ( {table regions}
- otrInMain, {..main table area}
- otrInLocked, {..locked row or col area}
- otrInUnused, {..unused bit}
- otrOutside); {..outside table client area}
-
- TOvcTblOption = ( {table options}
- otoBrowseRow, {Highlight row when browsing}
- otoNoRowResizing, {No run-time row resizing allowed}
- otoNoColResizing, {No run-time column resizing allowed}
- otoTabToArrow, {Tab moves cell to right, ShiftTab left}
- otoEnterToArrow, {Enter stops editing and moves cell right}
- otoAlwaysEditing, {Edit mode is always active}
- otoNoSelection, {No run-time selection allowed}
- otoMouseDragSelect, {dragging with mouse selects}
- otoRowSelection, {clicking on row header selects entire row}
- otoColSelection, {clicking on column header selects entire column}
- otoThumbTrack, {Scrollbar thumb-tracking}
- otoAllowColMoves, {Enable column moves}
- otoAllowRowMoves); {Enable row moves}
- TOvcTblOptionSet = set of TOvcTblOption;
-
- TOvcScrollBar = ( {scroll bar identifiers}
- otsbVertical, {..the vertical one}
- otsbHorizontal); {..the horizontal one}
-
- TOvcTblActions = ( {configuration actions on rows/columns}
- taGeneral, {..general}
- taSingle, {..changing a single row/column}
- taAll, {..changing all rows/columns}
- taInsert, {..inserting a row/column}
- taDelete, {..deleting a row/column}
- taExchange); {..exchanging two rows/columns}
-
- TOvcCellDataPurpose = ( {OnGetCellData data request purpose}
- cdpForPaint, {..for painting}
- cdpForEdit, {..for editing}
- cdpForSave); {..for saving an edited data}
-
- TOvcTextStyle = ( {text painting styles}
- tsFlat, {..flat}
- tsRaised, {..raised look}
- tsLowered); {..lowered look}
-
- TOvcTblSelectionType = ( {Internal selection type}
- tstDeselectAll, {..deselect all selections}
- tstAdditional); {..additional selection/deselection}
-
- TOvcTblEditorStyle = ( {Table's cell editor style}
- tesNormal, {..normal (ie nothing special)}
- tesBorder, {..with border}
- tes3D); {..3D look}
-
-{---Row/Column number (index) types}
-type
- TRowNum = longint; {actually 0..2 billion}
- TColNum = integer; {actually 0..16K}
-
-{---record types for cells---}
-type
- PCellBitMapInfo = ^TCellBitMapInfo;
- TCellBitMapInfo = packed record
- BM : TBitMap; {bitmap object to display}
- Count : integer; {number of glyphs}
- ActiveCount : integer; {number of active glyphs}
- Index : integer; {index of glyph to display}
- end;
-
- PCellComboBoxInfo = ^TCellComboBoxInfo;
- TCellComboBoxInfo = packed record
- Index : integer; {index into Items list}
- {$IFDEF CBuilder}
- case integer of
- 0 : (St : array[0..255] of char);
- 1 : (RTItems : TStrings;
- RTSt : array[0..255] of char);
- {$ELSE}
- case integer of
- 0 : (St : ShortString); {string value if Index = -1}
- 1 : (RTItems : TStrings; {run-time items list}
- RTSt : ShortString); {run-time string value if Index = -1}
- {$ENDIF}
- end;
-
- TOvcCellAttributes = packed record {display attributes for a cell}
- caAccess : TOvcTblAccess; {..access rights}
- caAdjust : TOvcTblAdjust; {..data adjustment}
- caColor : TColor; {..background color}
- caFont : TFont; {..text font}
- caFontColor : TColor; {..text color}
- caFontHiColor : TColor; {..text highlight color}
- caTextStyle : TOvcTextStyle; {..text style}
- end;
-
-
-{---Table cell ancestor---}
- TOvcTableCellAncestor = class(TComponent)
- protected {private}
- {.Z+}
- FOnCfgChanged : TNotifyEvent;
- {.Z-}
- protected
- {.Z+}
- procedure tcChangeScale(M, D : integer); dynamic;
- procedure tcDoCfgChanged;
- {.Z-}
- public {protected}
- {.Z+}
- procedure tcResetTableValues; virtual; abstract;
- property OnCfgChanged : TNotifyEvent
- write FOnCfgChanged;
- {.Z-}
- public
- end;
-
-{---Table ancestor---}
-
- TOvcTableAncestor = class(TO32CustomControl)
- protected {private}
- FController : TOvcController;
- taCellList : TList;
- taLoadList : TStringList;
-
- function ControllerAssigned : Boolean;
- procedure SetController(Value : TOvcController); virtual;
-
- protected
- procedure CreateWnd;
- override;
- procedure Notification(AComponent : TComponent; Operation : TOperation);
- override;
-
- {streaming routines}
- procedure ChangeScale(M, D : integer); override;
- procedure DefineProperties(Filer : TFiler); override;
- procedure Loaded; override;
-
- procedure tbFinishLoadingCellList;
- procedure tbReadCellData(Reader : TReader);
- procedure tbWriteCellData(Writer : TWriter);
-
- procedure tbCellChanged(Sender : TObject); virtual; abstract;
-
- public {protected}
- {internal use only methods}
- procedure tbExcludeCell(Cell : TOvcTableCellAncestor);
- procedure tbIncludeCell(Cell : TOvcTableCellAncestor);
- procedure tbNotifyCellsOfTableChange;
-
- public
- constructor Create(AOwner : TComponent); override;
- destructor Destroy; override;
-
- property Controller : TOvcController
- read FController
- write SetController;
-
- function FilterKey(var Msg : TWMKey) : TOvcTblKeyNeeds; virtual; abstract;
- procedure ResolveCellAttributes(RowNum : TRowNum; ColNum : TColNum;
- var CellAttr : TOvcCellAttributes); virtual; abstract;
- end;
-
-type
- POvcSparseAttr = ^TOvcSparseAttr;
-{attributes for cells in sparse matrix--INTERNAL USE}
- TOvcSparseAttr = packed record
- scaAccess : TOvcTblAccess;
- scaAdjust : TOvcTblAdjust;
- scaColor : TColor;
- scaFont : TFont;
- scaCell : TOvcTableCellAncestor;
- end;
-
- POvcTableNumberArray = ^TOvcTableNumberArray;
-{structure passed to GetDisplayedRow(Col)Numbers}
- TOvcTableNumberArray = packed record
- NumElements : longint; {..number of elements in Number array}
- Count : longint; {..return count of used elements in Number array}
- Number : array [0..29] of longint; {..Number array}
- end;
-
-{---Row style type}
-type
- PRowStyle = ^TRowStyle;
- TRowStyle = packed record
- Height : Integer; {-1 means default}
- Hidden : boolean;
- end;
-
-{---Short string type (length-byte string)}
-type
- POvcShortString = ^ShortString; {pointer to shortstring}
-
-{---Exception classes}
-type
- EOrpheusTable = class(Exception);
-
-{---Notification events}
-type
- TRowNotifyEvent = procedure (Sender : TObject; RowNum : TRowNum) of object;
- TColNotifyEvent = procedure (Sender : TObject; ColNum : TColNum) of object;
- TColResizeEvent = procedure ( Sender: TObject; ColNum : TColNum;
- NewWidth: Integer) of object;
- TRowResizeEvent = procedure ( Sender: TObject; RowNum : TRowNum;
- NewHeight: Integer) of object;
- TCellNotifyEvent = procedure (Sender : TObject;
- RowNum : TRowNum; ColNum : TColNum) of object;
- TCellDataNotifyEvent = procedure (Sender : TObject;
- RowNum : TRowNum; ColNum : TColNum;
- var Data : pointer;
- Purpose : TOvcCellDataPurpose) of object;
- TCellAttrNotifyEvent = procedure (Sender : TObject;
- RowNum : TRowNum; ColNum : TColNum;
- var CellAttr : TOvcCellAttributes) of object;
- TCellPaintNotifyEvent = procedure (Sender : TObject;
- TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer;
- var DoneIt : boolean) of object;
- TCellBeginEditNotifyEvent = procedure (Sender : TObject;
- RowNum : TRowNum; ColNum : TColNum;
- var AllowIt : boolean) of object;
- TCellEndEditNotifyEvent = procedure (Sender : TObject;
- Cell : TOvcTableCellAncestor;
- RowNum : TRowNum; ColNum : TColNum;
- var AllowIt : boolean) of object;
- TCellMoveNotifyEvent = procedure (Sender : TObject; Command : word;
- var RowNum : TRowNum;
- var ColNum : TColNum) of object;
- TCellChangeNotifyEvent = procedure (Sender : TObject;
- var RowNum : TRowNum;
- var ColNum : TColNum) of object;
- TRowChangeNotifyEvent = procedure (Sender : TObject; RowNum1, RowNum2 : TRowNum;
- Action : TOvcTblActions) of object;
- TColChangeNotifyEvent = procedure (Sender : TObject; ColNum1, ColNum2 : TColNum;
- Action : TOvcTblActions) of object;
- TSizeCellEditorNotifyEvent = procedure (Sender : TObject;
- RowNum : TRowNum;
- ColNum : TColNum;
- var CellRect : TRect;
- var CellStyle: TOvcTblEditorStyle) of object;
- TSelectionIterator = function(RowNum1 : TRowNum; ColNum1 : TColNum;
- RowNum2 : TRowNum; ColNum2 : TColNum;
- ExtraData : pointer) : boolean of object;
-
-
-{---Cell-Table interaction messages---}
-const
- ctim_Base = WM_USER + $4545;
- ctim_QueryOptions = ctim_Base;
- ctim_QueryColor = ctim_Base + 1;
- ctim_QueryFont = ctim_Base + 2;
- ctim_QueryLockedCols = ctim_Base + 3;
- ctim_QueryLockedRows = ctim_Base + 4;
- ctim_QueryActiveCol = ctim_Base + 5;
- ctim_QueryActiveRow = ctim_Base + 6;
-
- ctim_RemoveCell = ctim_Base + 10;
- ctim_StartEdit = ctim_Base + 11;
- ctim_StartEditMouse = ctim_Base + 12;
- ctim_StartEditKey = ctim_Base + 13;
-
- ctim_SetFocus = ctim_Base + 14;
- ctim_KillFocus = ctim_Base + 15;
-
- ctim_LoadDefaultCells = ctim_Base + 20;
-
-{---Property defaults}
-const
- tbDefAccess = otxNormal;
- tbDefAdjust = otaCenterLeft;
- tbDefBorderStyle = bsSingle;
- tbDefColCount = 10;
- tbDefColWidth = 150;
- tbDefGridColor = clBlack;
- tbDefHeight = 100;
- tbDefLockedCols = 1;
- tbDefLockedRows = 1;
- tbDefMargin = 4;
- tbDefRowCount = 10;
- tbDefRowHeight = 30;
- tbDefScrollBars = ssBoth;
- tbDefTableColor = clBtnFace;
- tbDefWidth = 300;
-
-{---Default color for cells (to force them to table color)}
-const
- clOvcTableDefault = $2FFFFFF;
-
-{---Handy extra constants for table's CalcRowColFromXY method}
-const
- CRCFXY_RowAbove = -2; {Y is above all table cells}
- CRCFXY_RowBelow = -1; {Y is below all table cells}
- CRCFXY_ColToLeft = -2; {X is to left of all table cells}
- CRCFXY_ColToRight = -1; {X is to right of all table cells}
-
-{---Handy extra constants for TRowNum variables, Row Heights}
-const
- RowLimitChanged = -2;
- UseDefHt = -1;
-
-type {internal use only}
- TOvcTblDisplayItem = packed record
- Number : longint;
- Offset : Integer;
- end;
- POvcTblDisplayArray = ^TOvcTblDisplayArray;
- TOvcTblDisplayArray = packed record
- AllocNm : word;
- Count : word;
- Ay : array [0..127] of TOvcTblDisplayItem; {127 is arbitrary}
- end;
-
-{--Utility routines}
-function MinI(X, Y : Integer) : Integer;
- {Return the minimum of two integers}
-function MaxI(X, Y : Integer) : Integer;
- {Return the maximum of two integers}
-function MaxL(A, B : longint) : longint;
-function MinL(A, B : longint) : longint;
-
-function MakeRowStyle(AHeight : Integer; AHidden : boolean) : TRowStyle;
- {-Make a row style variable from a height and hidden flag.}
-
-procedure TableError(const Msg : string);
- {-Raise an exception with supplied string}
-procedure TableErrorRes(StringCode : word);
- {-Raise an exception with supplied string resource code}
-
-procedure AssignDisplayArray(var A : POvcTblDisplayArray; Num : word);
- {-Table internal: (re)assign a display array}
-
-implementation
-
-{===Standard routines================================================}
-{$IFDEF NoAsm}
-function MinI(X, Y : Integer) : Integer;
-begin
- if X < Y then
- Result := X
- else
- Result := Y;
-end;
-
-function MaxI(X, Y : Integer) : Integer;
-begin
- if X >= Y then
- Result := X
- else
- Result := Y;
-end;
-
-{$ELSE}
-function MinI(X, Y : Integer) : Integer;
- {Return the minimum of two integers}
-asm
- cmp eax, edx
- jle @@Exit
- mov eax, edx
-@@Exit:
-end;
-{--------}
-function MaxI(X, Y : Integer) : Integer;
- {Return the maximum of two integers}
-asm
- cmp eax, edx
- jge @@Exit
- mov eax, edx
-@@Exit:
-end;
-{$ENDIF}
-{--------}
-procedure TableError(const Msg : string);
- begin
- raise EOrpheusTable.Create(Msg);
- end;
-{--------}
-procedure TableErrorRes(StringCode : word);
- begin
- raise EOrpheusTable.Create(GetOrphStr(StringCode));
- end;
-{--------}
-function MaxL(A, B : longint) : longint;
- begin
- if (A < B) then Result := B else Result := A;
- end;
-{--------}
-function MinL(A, B : longint) : longint;
- begin
- if (A < B) then Result := A else Result := B;
- end;
-{--------}
-procedure AssignDisplayArray(var A : POvcTblDisplayArray; Num : word);
- var
- NewA : POvcTblDisplayArray;
- NumToXfer : word;
- begin
- NewA := nil;
- if (Num > 0) then
- begin
- GetMem(NewA, Num*sizeof(TOvcTblDisplayItem)+2*sizeof(word));
- {$IFOPT D+}
- FillChar(NewA^, Num*sizeof(TOvcTblDisplayItem)+2*sizeof(word), $CC);
- {$ENDIF}
- if Assigned(A) then
- begin
- NumToXfer := MinL(Num, A^.Count);
- if (NumToXfer > 0) then
- Move(A^.Ay, NewA^.Ay, NumToXFer*sizeof(TOvcTblDisplayItem));
- end
- else
- NumToXfer := 0;
- with NewA^ do
- begin
- AllocNm := Num;
- Count := NumToXfer;
- end;
- end;
- if Assigned(A) then
- FreeMem(A, A^.AllocNm*sizeof(TOvcTblDisplayItem)+2*sizeof(word));
- A := NewA;
- end;
-{--------}
-function MakeRowStyle(AHeight : Integer; AHidden : boolean) : TRowStyle;
- begin
- with Result do
- begin
- Height := AHeight;
- Hidden := AHidden;
- end;
- end;
-{====================================================================}
-
-
-{===TOvcTableCellAncestor============================================}
-procedure TOvcTableCellAncestor.tcChangeScale(M, D : integer);
- begin
- {do nothing at this level in the cell component hierarchy}
- end;
-{--------}
-procedure TOvcTableCellAncestor.tcDoCfgChanged;
- begin
- if Assigned(FOnCfgChanged) then
- FOnCfgChanged(Self);
- end;
-{====================================================================}
-
-
-{===TOvcTableAncestor================================================}
-constructor TOvcTableAncestor.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
- taCellList := TList.Create;
- end;
-{--------}
-destructor TOvcTableAncestor.Destroy;
- begin
- taLoadList.Free;
- taCellList.Free;
- inherited Destroy;
- end;
-{--------}
-
-function TOvcTableAncestor.ControllerAssigned : Boolean;
-begin
- Result := Assigned(FController);
-end;
-
-procedure TOvcTableAncestor.CreateWnd;
-var
- OurForm : TWinControl;
-
-begin
- OurForm := GetImmediateParentForm(Self);
-
- {do this only when the component is first dropped on the form, not during loading}
- if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
- ResolveController(OurForm, FController);
-
- if not Assigned(FController) and not (csLoading in ComponentState) then begin
- {try to find a controller on this form that we can use}
- FController := FindController(OurForm);
-
- {if not found and we are not designing, use default controller}
- if not Assigned(FController) and not (csDesigning in ComponentState) then
- FController := DefaultController;
- end;
-
- inherited CreateWnd;
-end;
-
-procedure TOvcTableAncestor.Notification(AComponent : TComponent; Operation : TOperation);
-begin
- inherited Notification(AComponent, Operation);
-
- if Operation = opRemove then begin
- if (AComponent = FController) then
- FController := nil;
- end else if (Operation = opInsert) and (FController = nil) and
- (AComponent is TOvcController) then
- FController := TOvcController(AComponent);
-end;
-
-procedure TOvcTableAncestor.SetController(Value : TOvcController);
-begin
- FController := Value;
- if Value <> nil then
- Value.FreeNotification(Self);
-end;
-
-procedure TOvcTableAncestor.ChangeScale(M, D : integer);
- var
- i : integer;
- begin
- inherited ChangeScale(M, D);
- if (M <> D) then
- for i := 0 to pred(taCellList.Count) do
- TOvcTableCellAncestor(taCellList[i]).tcChangeScale(M, D);
- end;
-{--------}
-procedure TOvcTableAncestor.DefineProperties(Filer : TFiler);
- begin
- inherited DefineProperties(Filer);
- Filer.DefineProperty('CellData', tbReadCellData, tbWriteCellData, true);
- end;
-{--------}
-procedure TOvcTableAncestor.tbExcludeCell(Cell : TOvcTableCellAncestor);
- begin
- taCellList.Remove(pointer(Cell));
- end;
-{--------}
-procedure TOvcTableAncestor.tbFinishLoadingCellList;
- {Local methods}
- function GetImmediateParentForm(Control : TControl) : TWinControl;
- var
- ParentCtrl : TControl;
- begin
- ParentCtrl := Control.Parent;
- {$IFDEF VERSION5}
- while Assigned(ParentCtrl) and
- (not ((ParentCtrl is TCustomForm) or
- (ParentCtrl is TCustomFrame))) do
- ParentCtrl := ParentCtrl.Parent;
- Result := TWinControl(ParentCtrl);
- {$ELSE}
- while Assigned(ParentCtrl) and (not (ParentCtrl is TCustomForm)) do
- ParentCtrl := ParentCtrl.Parent;
- Result := TForm(ParentCtrl);
- {$ENDIF}
- end;
-
- {------}
-
- function FormNamesEqual(const CmptFormName, FormName : string) : boolean;
- var
- PosUL : integer;
- begin
- Result := true;
- if (FormName = '') or (CmptFormName = FormName) then
- Exit;
- PosUL := length(FormName);
- while (PosUL > 0) and (FormName[PosUL] <> '_') do
- dec(PosUL);
- if (PosUL > 0) then
- if (CmptFormName = Copy(FormName, 1, pred(PosUL))) then
- Exit;
- Result := false;
- end;
- {------}
-
- function GetFormName(const S, FormName : string) : string;
- var
- PosDot : integer;
- begin
- PosDot := Pos('.', S);
- if (PosDot <> 0) then
- Result := Copy(S, 1, pred(PosDot))
- else
- Result := FormName;
- end;
- {------}
-
- function GetComponentName(const S : string) : string;
- var
- PosDot : integer;
- begin
- PosDot := Pos('.', S);
- if (PosDot <> 0) then
- Result := Copy(S, succ(PosDot), length(S))
- else
- Result := S;
- end;
- {------}
-var
- i : integer;
- Form : TWinControl;
- Compnt : TComponent;
- DM : integer;
- DataMod: TDataModule;
- DMCount: integer;
-begin
- if Assigned(taLoadList) then
- begin
- {fixup the cell component list: the cells now exist}
- try
- Form := GetImmediateParentForm(Self);
- for i := pred(taLoadList.Count) downto 0 do
- if FormNamesEqual(GetFormName(taLoadList[i], Form.Name),
- Form.Name) then
- begin
- Compnt := Form.FindComponent(GetComponentName(taLoadList[i]));
- if Assigned(Compnt) and (Compnt is TOvcTableCellAncestor) then
- begin
- tbIncludeCell(TOvcTableCellAncestor(Compnt));
- taLoadList.Delete(i);
- end;
- end;
- {fixup references to cell components on any data modules}
- if (taLoadList.Count <> 0) then
- begin
- DM := 0;
-//{$IFNDEF LCL}
- DMCount := Screen.DataModuleCount;
-//{$ELSE}
-// DMCount := 0;
-//{$ENDIF}
- while (taLoadList.Count > 0) and (DM < DMCount) do
- begin
-//{$IFNDEF LCL}
- DataMod := Screen.DataModules[DM];
-//{$ENDIF}
- for i := pred(taLoadList.Count) downto 0 do
- if (GetFormName(taLoadList[i], Form.Name) = DataMod.Name) then
- begin
- Compnt := DataMod.FindComponent(GetComponentName(taLoadList[i]));
- if Assigned(Compnt) and (Compnt is TOvcTableCellAncestor) then
- begin
- tbIncludeCell(TOvcTableCellAncestor(Compnt));
- taLoadList.Delete(i);
- end;
- end;
- inc(DM);
- end;
- end;
- finally
- taLoadList.Free;
- taLoadList := nil;
- end;
- end;
-end;
-{--------}
-procedure TOvcTableAncestor.tbIncludeCell(Cell : TOvcTableCellAncestor);
- begin
- if Assigned(Cell) then
- with taCellList do
- if (IndexOf(pointer(Cell)) = -1) then
- begin
- Add(pointer(Cell));
- Cell.OnCfgChanged := tbCellChanged;
- end;
- end;
-{--------}
-procedure TOvcTableAncestor.Loaded;
- begin
- inherited Loaded;
- end;
-{--------}
-procedure TOvcTableAncestor.tbNotifyCellsOfTableChange;
- var
- i : integer;
- begin
- if Assigned(taCellList) then
- for i := 0 to pred(taCellList.Count) do
- TOvcTableCellAncestor(taCellList[i]).tcResetTableValues;
- end;
-{--------}
-procedure TOvcTableAncestor.tbReadCellData(Reader : TReader);
- begin
- if Assigned(taLoadList) then
- taLoadList.Clear
- else
- taLoadList := TStringList.Create;
- with Reader do
- begin
- ReadListBegin;
- while not EndOfList do
- taLoadList.Add(ReadString);
- ReadListEnd;
- end;
- end;
-{--------}
-procedure TOvcTableAncestor.tbWriteCellData(Writer : TWriter);
- var
- i : integer;
- Cell : TOvcTableCellAncestor;
- S : string;
- begin
- with Writer do
- begin
- WriteListBegin;
- for i := 0 to pred(taCellList.Count) do
- begin
- Cell := TOvcTableCellAncestor(taCellList[i]);
- S := Cell.Owner.Name;
- if (S <> '') then
- S := S + '.' + Cell.Name
- else
- S := Cell.Name;
- WriteString(S);
- end;
- WriteListEnd;
- end;
- end;
-{====================================================================}
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovctcsim.pas b/Source/3rdParty/Orpheus/ovctcsim.pas
deleted file mode 100644
index 41a20b5e..00000000
--- a/Source/3rdParty/Orpheus/ovctcsim.pas
+++ /dev/null
@@ -1,294 +0,0 @@
-{*********************************************************}
-{* OVCTCSIM.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 ovctcsim;
- {-Orpheus Table Cell - Simple field type}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- SysUtils, Classes, Controls,
- OvcData, OvcEF, OvcSF, OvcTCmmn, OvcTCell, OvcTCBEF,
- Graphics; { - for default color definition}
-
-type
- {The editor class for TOvcTCSimpleField cell components}
- TOvcTCSimpleFieldEdit = class(TOvcSimpleField)
- protected {private}
- {.Z+}
- FCell : TOvcBaseTableCell;
- {.Z-}
-
- protected
- {.Z+}
- procedure efMoveFocusToNextField; override;
- procedure efMoveFocusToPrevField; override;
-
- procedure WMChar(var Msg : TWMKey); message WM_CHAR;
- procedure WMGetDlgCode(var Msg : TMessage); message WM_GETDLGCODE;
- procedure WMKeyDown(var Msg : TWMKey); message WM_KEYDOWN;
- procedure WMKillFocus(var Msg : TWMKillFocus); message WM_KILLFOCUS;
- procedure WMSetFocus(var Msg : TWMSetFocus); message WM_SETFOCUS;
- {.Z-}
-
- published
- property CellOwner : TOvcBaseTableCell
- read FCell write FCell;
- end;
-
- {The simple field cell component class}
- TOvcTCCustomSimpleField = class(TOvcTCBaseEntryField)
- protected
- {.Z+}
- function GetCellEditor : TControl; override;
- function GetDataType : TSimpleDataType;
- function GetPictureMask : AnsiChar;
-
- procedure SetDataType(DT : TSimpleDataType);
- procedure SetPictureMask(PM : AnsiChar);
- {.Z-}
-
- property DataType : TSimpleDataType
- read GetDataType write SetDataType;
-
- property PictureMask : AnsiChar
- read GetPictureMask write SetPictureMask;
-
- public
- function CreateEntryField(AOwner : TComponent) : TOvcBaseEntryField; override;
- end;
-
- TOvcTCSimpleField = class(TOvcTCCustomSimpleField)
- published
- {properties inherited from custom ancestor}
- property Access default otxDefault;
- property Adjust default otaDefault;
- property CaretIns;
- property CaretOvr;
- property Color;
- property ControlCharColor default clRed;
- property DataType default sftString;
- property DecimalPlaces default 0;
- property EFColors;
- property Font;
- property Hint;
- property Margin default 4;
- property MaxLength default 15;
- property Options default [efoCaretToEnd, efoTrimBlanks];
- property PadChar default ' ';
- property PasswordChar default '*';
- property PictureMask default 'X';
- property RangeHi stored False;
- property RangeLo stored False;
- property ShowHint default False;
- property Table;
- property TableColor default True;
- property TableFont default True;
- property TextHiColor default clBtnHighlight;
- property TextMargin default 2;
- property TextStyle default tsFlat;
-
- {events inherited from custom ancestor}
- property OnChange;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnError;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnOwnerDraw;
- property OnUserCommand;
- property OnUserValidation;
- end;
-
-
-implementation
-
-
-{===TOvcTCCustomSimpleField=========================================}
-function TOvcTCCustomSimpleField.CreateEntryField(AOwner : TComponent) : TOvcBaseEntryField;
- begin
- Result := TOvcTCSimpleFieldEdit.Create(AOwner);
- TOvcTCSimpleFieldEdit(Result).CellOwner := Self;
- end;
-{--------}
-function TOvcTCCustomSimpleField.GetCellEditor : TControl;
- begin
- Result := FEdit;
- end;
-{--------}
-function TOvcTCCustomSimpleField.GetDataType : TSimpleDataType;
- begin
- if Assigned(FEdit) then Result := TOvcTCSimpleFieldEdit(FEdit).DataType
- else Result := sftString;
- end;
-{--------}
-function TOvcTCCustomSimpleField.GetPictureMask : AnsiChar;
- begin
- if Assigned(FEdit) then Result := TOvcTCSimpleFieldEdit(FEdit).PictureMask
- else Result := pmAnyChar;
- end;
-{--------}
-procedure TOvcTCCustomSimpleField.SetDataType(DT : TSimpleDataType);
- begin
- if Assigned(FEdit) then
- begin
- TOvcTCSimpleFieldEdit(FEdit).DataType := DT;
- TOvcTCSimpleFieldEdit(FEditDisplay).DataType := DT;
- end;
- end;
-{--------}
-procedure TOvcTCCustomSimpleField.SetPictureMask(PM : AnsiChar);
- begin
- if Assigned(FEdit) then
- begin
- TOvcTCSimpleFieldEdit(FEdit).PictureMask := PM;
- TOvcTCSimpleFieldEdit(FEditDisplay).PictureMask := PM;
- end;
- end;
-{====================================================================}
-
-
-{===TOvcTCSimpleFieldEdit==============================================}
-procedure TOvcTCSimpleFieldEdit.efMoveFocusToNextField;
- var
- Msg : TWMKey;
- begin
- FillChar(Msg, sizeof(Msg), 0);
- with Msg do
- begin
- Msg := WM_KEYDOWN;
- CharCode := VK_RIGHT;
- end;
- CellOwner.SendKeyToTable(Msg);
- end;
-{--------}
-procedure TOvcTCSimpleFieldEdit.efMoveFocusToPrevField;
- var
- Msg : TWMKey;
- begin
- FillChar(Msg, sizeof(Msg), 0);
- with Msg do
- begin
- Msg := WM_KEYDOWN;
- CharCode := VK_LEFT;
- end;
- CellOwner.SendKeyToTable(Msg);
- end;
-{--------}
-procedure TOvcTCSimpleFieldEdit.WMChar(var Msg : TWMKey);
- begin
- if (Msg.CharCode <> 9) then {filter tab characters}
- inherited;
- end;
-{--------}
-procedure TOvcTCSimpleFieldEdit.WMGetDlgCode(var Msg : TMessage);
- begin
-{$IFNDEF LCL}
- inherited;
-{$ELSE}
- inherited WMGetDlgCode(TWMNoParams(Msg));
-{$ENDIF}
- if CellOwner.TableWantsTab then
- Msg.Result := Msg.Result or DLGC_WANTTAB;
- if CellOwner.TableWantsEnter then
- Msg.Result := Msg.Result or DLGC_WANTALLKEYS;
- end;
-{--------}
-procedure TOvcTCSimpleFieldEdit.WMKeyDown(var Msg : TWMKey);
- var
- GridReply : TOvcTblKeyNeeds;
- GridUsedIt : boolean;
- begin
- GridUsedIt := false;
- GridReply := otkDontCare;
- if (CellOwner <> nil) then
- GridReply := CellOwner.FilterTableKey(Msg);
- case GridReply of
- otkMustHave :
- begin
- {the entry field must also process this key - to restore its contents}
- if (Msg.CharCode = VK_ESCAPE) then
- Restore;
-
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- otkWouldLike :
- case Msg.CharCode of
- VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN :
- begin
-// TurboPower bug. Next line commented out and next two lines inserted.
-// if ValidateSelf then
- if not ValidateSelf then //Added - don't pass key to ancestor?
- Exit; //Added
- begin
- CellOwner.SendKeyToTable(Msg);
- GridUsedIt := true;
- end;
- end;
- {Note: VK_LEFT, VK_RIGHT are processed by efMoveFocusToNext(Next)Field}
- end;
- end;{case}
-
- if not GridUsedIt then
- inherited;
- end;
-{--------}
-procedure TOvcTCSimpleFieldEdit.WMKillFocus(var Msg : TWMKillFocus);
- begin
- inherited;
- CellOwner.PostMessageToTable(ctim_KillFocus, Msg.FocusedWnd, LastError);
- end;
-{--------}
-procedure TOvcTCSimpleFieldEdit.WMSetFocus(var Msg : TWMSetFocus);
- begin
- inherited;
- CellOwner.PostMessageToTable(ctim_SetFocus, Msg.FocusedWnd, 0);
- end;
-{====================================================================}
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovctcstr.pas b/Source/3rdParty/Orpheus/ovctcstr.pas
deleted file mode 100644
index e332cc2c..00000000
--- a/Source/3rdParty/Orpheus/ovctcstr.pas
+++ /dev/null
@@ -1,261 +0,0 @@
-{*********************************************************}
-{* OVCTCSTR.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 ovctcstr;
- {-Orpheus Table Cell - base string type}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, Types, LclType, MyMisc, {$ENDIF}
- SysUtils, Graphics, Classes, OvcTCmmn, OvcTCell;
-
-type
- TOvcTCBaseString = class(TOvcBaseTableCell)
- protected {private}
- {.Z+}
- FUseASCIIZStrings : boolean;
- FUseWordWrap : boolean;
-
- FOnChange : TNotifyEvent;
- {.Z-}
-
- protected
- {.Z+}
- procedure SetUseASCIIZStrings(AZS : boolean);
- procedure SetUseWordWrap(WW : boolean);
-
- procedure tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer); override;
- procedure tcPaintStrZ(TblCanvas : TCanvas;
- const CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- StZ : PAnsiChar);
- {.Z-}
-
- {properties}
- property UseASCIIZStrings : boolean
- read FUseASCIIZStrings write SetUseASCIIZStrings;
-
- property UseWordWrap : boolean
- read FUseWordWrap write SetUseWordWrap;
-
- {events}
- property OnChange : TNotifyEvent
- read FOnChange write FOnChange;
- public
- constructor Create(AOwner : TComponent); override;
- end;
-
-
-implementation
-
-
-{===TOvcTCBaseString==========================================}
-constructor TOvcTCBaseString.Create(AOwner : TComponent);
- begin
- inherited Create(AOwner);
- end;
-
-procedure TOvcTCBaseString.tcPaint(TableCanvas : TCanvas;
- const CellRect : TRect;
- RowNum : TRowNum;
- ColNum : TColNum;
- const CellAttr : TOvcCellAttributes;
- Data : pointer);
- var
- S : POvcShortString absolute Data;
- SZ: PAnsiChar absolute Data;
- StZ : PAnsiChar;
- SAsPChar : array [0..255] of AnsiChar;
- StZAllocated : boolean;
- IsEmptyString : boolean;
-
- begin
- {blank out the cell}
- inherited tcPaint(TableCanvas, CellRect, RowNum, ColNum, CellAttr, Data);
- {if the cell is invisible or the passed data is nil and we're not
- designing, all's done}
- if (CellAttr.caAccess = otxInvisible) or
- ((Data = nil) and not (csDesigning in ComponentState)) then
- Exit;
- {prepare to paint the string}
- StZAllocated := false;
- {for a null string, output the row:column in that format}
- if (Data = nil) then
- begin
- StZ := StrAlloc(32); {should be ample}
- StZAllocated := true;
- StrFmt(StZ, '%d:%d', [RowNum, ColNum]);
- end
- {for an ASCIIZ string, just go paint it}
- else if UseASCIIZStrings then
- StZ := SZ
- {for a Pascal shortstring, convert to an ASCIIZ version}
- else
- StZ := StrPCopy(SAsPChar, S^);
- IsEmptyString := (StZ[0] = #0);
- {now paint the ASCIIZ string}
- try
- if not IsEmptyString then
- tcPaintStrZ(TableCanvas, CellRect, CellAttr, StZ);
- finally
- if StZAllocated then
- StrDispose(StZ);
- end;
- end;
-{--------}
-procedure TOvcTCBaseString.tcPaintStrZ(TblCanvas : TCanvas;
- const CellRect : TRect;
- const CellAttr : TOvcCellAttributes;
- StZ : PAnsiChar);
- var
- Size : TSize;
- var
- Wd : integer;
- LenStZ : integer;
- DTOpts : Cardinal;
- R : TRect;
- OurAdjust : TOvcTblAdjust;
- begin
- TblCanvas.Font := CellAttr.caFont;
- TblCanvas.Font.Color := CellAttr.caFontColor;
-
- LenStZ := StrLen(StZ);
-
- R := CellRect;
- InflateRect(R, -Margin div 2, -Margin div 2);
-
- if FUseWordWrap then
- begin
- DTOpts:= DT_NOPREFIX or DT_WORDBREAK;
- case CellAttr.caAdjust of
- otaTopLeft, otaCenterLeft, otaBottomLeft :
- DTOpts := DTOpts or DT_LEFT;
- otaTopRight, otaCenterRight, otaBottomRight :
- DTOpts := DTOpts or DT_RIGHT;
- else
- DTOpts := DTOpts or DT_CENTER;
- end;{case}
- end
- else
- begin
- DTOpts:= DT_NOPREFIX or DT_SINGLELINE;
-
- {make sure that if the string doesn't fit, we at least see
- the first few characters}
- GetTextExtentPoint32(TblCanvas.Handle, StZ, LenStZ, Size);
- Wd := Size.cX;
- OurAdjust := CellAttr.caAdjust;
- if Wd > (R.Right - R.Left) then
- case CellAttr.caAdjust of
- otaTopCenter, otaTopRight : OurAdjust := otaTopLeft;
- otaCenter, otaCenterRight : OurAdjust := otaCenterLeft;
- otaBottomCenter, otaBottomRight : OurAdjust := otaBottomLeft;
- end;
-
- case OurAdjust of
- otaTopLeft, otaCenterLeft, otaBottomLeft :
- DTOpts := DTOpts or DT_LEFT;
- otaTopRight, otaCenterRight, otaBottomRight :
- DTOpts := DTOpts or DT_RIGHT;
- else
- DTOpts := DTOpts or DT_CENTER;
- end;{case}
- case OurAdjust of
- otaTopLeft, otaTopCenter, otaTopRight :
- DTOpts := DTOpts or DT_TOP;
- otaBottomLeft, otaBottomCenter, otaBottomRight :
- DTOpts := DTOpts or DT_BOTTOM;
- else
- DTOpts := DTOpts or DT_VCENTER;
- end;{case}
- end;
-
- case CellAttr.caTextStyle of
- tsFlat :
- DrawText(TblCanvas.Handle, StZ, LenStZ, R, DTOpts);
- tsRaised :
- begin
- OffsetRect(R, -1, -1);
- TblCanvas.Font.Color := CellAttr.caFontHiColor;
- DrawText(TblCanvas.Handle, StZ, LenStZ, R, DTOpts);
- OffsetRect(R, 1, 1);
- TblCanvas.Font.Color := CellAttr.caFontColor;
- TblCanvas.Brush.Style := bsClear;
- DrawText(TblCanvas.Handle, StZ, LenStZ, R, DTOpts);
- TblCanvas.Brush.Style := bsSolid;
- end;
- tsLowered :
- begin
- OffsetRect(R, 1, 1);
- TblCanvas.Font.Color := CellAttr.caFontHiColor;
- DrawText(TblCanvas.Handle, StZ, LenStZ, R, DTOpts);
- OffsetRect(R, -1, -1);
- TblCanvas.Font.Color := CellAttr.caFontColor;
- TblCanvas.Brush.Style := bsClear;
- DrawText(TblCanvas.Handle, StZ, LenStZ, R, DTOpts);
- TblCanvas.Brush.Style := bsSolid;
- end;
- end;
- end;
-{--------}
-procedure TOvcTCBaseString.SetUseASCIIZStrings(AZS : boolean);
- begin
- if (AZS <> FUseASCIIZStrings) then
- begin
- FUseASCIIZStrings := AZS;
- tcDoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcTCBaseString.SetUseWordWrap(WW : boolean);
- begin
- if (WW <> FUseWordWrap) then
- begin
- FUseWordWrap := WW;
- tcDoCfgChanged;
- end;
- end;
-{====================================================================}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovctgpns.pas b/Source/3rdParty/Orpheus/ovctgpns.pas
deleted file mode 100644
index bce8b609..00000000
--- a/Source/3rdParty/Orpheus/ovctgpns.pas
+++ /dev/null
@@ -1,263 +0,0 @@
-{*********************************************************}
-{* OVCTGPNS.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 ovctgpns;
- {-Orpheus Table - grid pens}
-
-interface
-
-uses
- Classes, Graphics;
-
-type
- TGridEffect = (geNone, geVertical, geHorizontal, geBoth, ge3D);
-
-type
- TOvcGridPen = class(TPersistent)
- protected {private}
- {.Z+}
- FNormalColor : TColor;
- FSecondColor : TColor;
- FEffect : TGridEffect;
- FStyle : TPenStyle;
-
- FOnCfgChanged : TNotifyEvent;
- {.Z-}
-
- protected
- {.Z+}
- procedure SetNormalColor(C : TColor);
- procedure SetSecondColor(C : TColor);
- procedure SetEffect(E : TGridEffect);
- procedure SetStyle(S : TPenStyle);
-
- procedure DoCfgChanged;
- {.Z-}
-
- public {protected}
- {.Z+}
- property OnCfgChanged : TNotifyEvent
- read FOnCfgChanged write FOnCfgChanged;
- {.Z-}
-
- public
- constructor Create;
- procedure Assign(Source : TPersistent); override;
-
- published
- property NormalColor : TColor
- read FNormalColor write SetNormalColor;
-
- property SecondColor : TColor
- read FSecondColor write SetSecondColor
- default clBtnHighlight;
-
- property Style : TPenStyle
- read FStyle write SetStyle;
-
- property Effect : TGridEffect
- read FEffect write SetEffect;
- end;
-
- TOvcGridPenSet = class(TPersistent)
- protected {private}
- {.Z+}
- FNormalGrid : TOvcGridPen;
- FLockedGrid : TOvcGridPen;
- FCellWhenFocused : TOvcGridPen;
- FCellWhenUnfocused : TOvcGridPen;
- {.Z-}
-
- protected
- {.Z+}
- procedure SetOnCfgChanged(OC : TNotifyEvent);
- {.Z-}
-
- public {protected}
- {.Z+}
- property OnCfgChanged : TNotifyEvent
- write SetOnCfgChanged;
- {.Z-}
-
- public
- constructor Create;
- destructor Destroy; override;
-
- procedure Assign(Source : TPersistent); override;
-
- published
- property NormalGrid : TOvcGridPen
- read FNormalGrid write FNormalGrid;
-
- property LockedGrid : TOvcGridPen
- read FLockedGrid write FLockedGrid;
-
- property CellWhenFocused : TOvcGridPen
- read FCellWhenFocused write FCellWhenFocused;
-
- property CellWhenUnfocused : TOvcGridPen
- read FCellWhenUnfocused write FCellWhenUnfocused;
- end;
-
-implementation
-
-
-{===TOvcGridPen==========================================================}
-constructor TOvcGridPen.Create;
- begin
- FNormalColor := clBtnShadow;
- FSecondColor := clBtnHighlight;
- FStyle := psSolid;
- FEffect := geBoth;
- end;
-{--------}
-procedure TOvcGridPen.Assign(Source : TPersistent);
- var
- Src : TOvcGridPen absolute Source;
- begin
- if (Source is TOvcGridPen) then
- begin
- FNormalColor := Src.NormalColor;
- FSecondColor := Src.SecondColor;
- FStyle := Src.Style;
- FEffect := Src.Effect;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcGridPen.DoCfgChanged;
- begin
- if Assigned(FOnCfgChanged) then
- OnCfgChanged(Self);
- end;
-{--------}
-procedure TOvcGridPen.SetNormalColor(C : TColor);
- begin
- if (C <> FNormalColor) then
- begin
- FNormalColor := C;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcGridPen.SetSecondColor(C : TColor);
- begin
- if (C <> FSecondColor) then
- begin
- FSecondColor := C;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcGridPen.SetStyle(S : TPenStyle);
- begin
- if (S <> FStyle) then
- begin
- FStyle := S;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcGridPen.SetEffect(E : TGridEffect);
- begin
- if (E <> FEffect) then
- begin
- FEffect := E;
- DoCfgChanged;
- end;
- end;
-{=====================================================================}
-
-
-{===TOvcGridPenSet=======================================================}
-constructor TOvcGridPenSet.Create;
- begin
- FNormalGrid := TOvcGridPen.Create;
- with FNormalGrid do
- begin
- Style := psDot;
- end;
- FLockedGrid := TOvcGridPen.Create;
- with FLockedGrid do
- begin
- Effect := ge3D;
- end;
- FCellWhenFocused := TOvcGridPen.Create;
- with FCellWhenFocused do
- begin
- NormalColor := clBlack;
- end;
- FCellWhenUnfocused := TOvcGridPen.Create;
- with FCellWhenUnfocused do
- begin
- NormalColor := clBlack;
- Style := psDash;
- end;
- end;
-{--------}
-destructor TOvcGridPenSet.Destroy;
- begin
- FNormalGrid.Free;
- FLockedGrid.Free;
- FCellWhenFocused.Free;
- FCellWhenUnfocused.Free;
- end;
-{--------}
-procedure TOvcGridPenSet.Assign(Source : TPersistent);
- var
- Src : TOvcGridPenSet absolute Source;
- begin
- if (Source is TOvcGridPenSet) then
- begin
- FNormalGrid.Assign(Src.NormalGrid);
- FLockedGrid.Assign(Src.LockedGrid);
- FCellWhenFocused.Assign(Src.CellWhenFocused);
- FCellWhenUnfocused.Assign(Src.CellWhenUnfocused);
- end;
- end;
-{--------}
-procedure TOvcGridPenSet.SetOnCfgChanged(OC : TNotifyEvent);
- begin
- FNormalGrid.OnCfgChanged := OC;
- FLockedGrid.OnCfgChanged := OC;
- FCellWhenFocused.OnCfgChanged := OC;
- FCellWhenUnfocused.OnCfgChanged := OC;
- end;
-{=====================================================================}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovctgres.pas b/Source/3rdParty/Orpheus/ovctgres.pas
deleted file mode 100644
index 294c20e2..00000000
--- a/Source/3rdParty/Orpheus/ovctgres.pas
+++ /dev/null
@@ -1,373 +0,0 @@
-{*********************************************************}
-{* OVCTGRES.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 ovctgres;
- {-Orpheus glyph resource manager}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, {$ENDIF}
- SysUtils, Classes, Graphics, OvcMisc;
-
-type
- TOvcCellGlyphs = class(TPersistent)
- protected {private}
- {.Z+}
- FResource : pointer;
- FActiveGlyphCount : Integer;
- FGlyphCount : Integer;
- FOnCfgChanged : TNotifyEvent;
- {.Z-}
- protected
- {.Z+}
- function GetBitMap : TBitMap;
- function GetIsDefault : boolean;
- procedure SetActiveGlyphCount(G : Integer);
- procedure SetBitMap(BM : TBitMap);
- procedure SetGlyphCount(G : Integer);
- procedure SetIsDefault(D : boolean);
-
- procedure CalcGlyphCount;
- function IsNotDefault : boolean;
- procedure DoCfgChanged;
- {.Z-}
- public {protected}
- {.Z+}
- property OnCfgChanged : TNotifyEvent
- read FOnCfgChanged write FOnCfgChanged;
- {.Z-}
-
- public
- constructor Create;
- destructor Destroy; override;
-
- procedure Assign(Source : TPersistent); override;
-
- published
- {Note: must be in this order--IsDefault, BitMap, GlyphCount, ActiveGlyphCount}
- property IsDefault : boolean
- read GetIsDefault write SetIsDefault
- stored true;
-
- property BitMap : TBitMap
- read GetBitMap write SetBitMap
- stored IsNotDefault;
-
- property GlyphCount : Integer
- read FGlyphCount write SetGlyphCount;
-
- property ActiveGlyphCount : Integer
- read FActiveGlyphCount write SetActiveGlyphCount;
- end;
-
-implementation
-
-
-type
- PCellGlyphResource = ^TCellGlyphResource;
- TCellGlyphResource = packed record
- BitMap : TBitMap;
- ResourceCount : Integer;
- Next : PCellGlyphResource;
- end;
-
- TGlyphResourceManager = class
- private
- FList : PCellGlyphResource;
- DefRes : PCellGlyphResource;
- protected
- public
- constructor Create;
- destructor Destroy; override;
-
- function AllocResource(BM : TBitMap) : PCellGlyphResource;
- procedure FreeResource(CBGR : PCellGlyphResource);
- function ReallocResource(ToCBGR, FromCBGR : PCellGlyphResource) : PCellGlyphResource;
- function DefaultResource : PCellGlyphResource;
- end;
-
-var
- CBResMgr : TGlyphResourceManager;
-
-function CreateNewResource : PCellGlyphResource;
- var
- Size : Integer;
- begin
- Size := sizeof(TCellGlyphResource);
- GetMem(Result, Size);
- FillChar(Result^, Size, 0);
- with Result^ do
- begin
- ResourceCount := 1;
- end;
- end;
-
-procedure DestroyResource(ARes : PCellGlyphResource);
- begin
- FreeMem(ARes, sizeof(TCellGlyphResource));
- end;
-
-{===TGlyphResourceManager=========================================}
-constructor TGlyphResourceManager.Create;
- begin
- DefRes := CreateNewResource;
- with DefRes^ do
- begin
- BitMap := TBitMap.Create;
-{$IFNDEF LCL}
- BitMap.Handle := LoadBaseBitmap('ORTCCHECKGLYPHS');
-{$ELSE}
- BitMap.LoadFromLazarusResource('ORTCCHECKGLYPHS');
-{$ENDIF}
- end;
- FList := DefRes;
- end;
-{--------}
-destructor TGlyphResourceManager.Destroy;
- var
- Temp : PCellGlyphResource;
- begin
- while Assigned(FList) do
- begin
- Temp := FList;
- FList := Temp^.Next;
- Temp^.BitMap.Free;
- DestroyResource(Temp);
- end;
- end;
-{--------}
-function TGlyphResourceManager.AllocResource(BM : TBitMap) : PCellGlyphResource;
- var
- NewRes : PCellGlyphResource;
- begin
- NewRes := CreateNewResource;
- with NewRes^ do
- begin
- BitMap := TBitMap.Create;
- BitMap.Assign(BM);
- Next := FList;
- end;
- FList := NewRes;
- Result := NewRes;
- end;
-{--------}
-procedure TGlyphResourceManager.FreeResource(CBGR : PCellGlyphResource);
- var
- Temp, Dad : PCellGlyphResource;
- begin
- Temp := FList;
- Dad := nil;
- while (Temp <> nil) do
- if (Temp = CBGR) then
- begin
- dec(Temp^.ResourceCount);
- if (Temp^.ResourceCount = 0) then
- begin
- with Temp^ do
- begin
- if (Dad = nil) then
- FList := Next
- else Dad^.Next := Next;
- BitMap.Free;
- end;
- DestroyResource(Temp);
- end;
- Temp := nil; {get out of loop}
- end
- else
- begin
- Dad := Temp;
- Temp := Temp^.Next;
- end;
- end;
-{--------}
-function TGlyphResourceManager.ReallocResource(ToCBGR, FromCBGR : PCellGlyphResource)
- : PCellGlyphResource;
- var
- Temp : PCellGlyphResource;
- begin
- FreeResource(FromCBGR);
- Temp := FList;
- while (Temp <> nil) do
- if (Temp = ToCBGR) then
- begin
- inc(Temp^.ResourceCount);
- Result := Temp;
- Exit;
- end
- else
- Temp := Temp^.Next;
- Result := DefaultResource;
- end;
-{--------}
-function TGlyphResourceManager.DefaultResource : PCellGlyphResource;
- begin
- inc(DefRes^.ResourceCount);
- Result := DefRes;
- end;
-{====================================================================}
-
-{===TOvcCellGlyphs==================================================}
-constructor TOvcCellGlyphs.Create;
- begin
- FResource := CBResMgr.DefaultResource;
- CalcGlyphCount;
- end;
-{--------}
-destructor TOvcCellGlyphs.Destroy;
- begin
- CBResMgr.FreeResource(PCellGlyphResource(FResource));
- end;
-{--------}
-procedure TOvcCellGlyphs.Assign(Source : TPersistent);
- begin
- if Source is TOvcCellGlyphs then begin
- if (Source = nil) then
- begin
- CBResMgr.FreeResource(PCellGlyphResource(FResource));
- FResource := CBResMgr.DefaultResource;
- end
- else if (FResource <> TOvcCellGlyphs(Source).FResource) then
- FResource :=
- CBResMgr.ReallocResource(PCellGlyphResource(TOvcCellGlyphs(Source).FResource),
- PCellGlyphResource(FResource));
- CalcGlyphCount;
- DoCfgChanged
- end else inherited Assign(Source);
- end;
-{--------}
-procedure TOvcCellGlyphs.CalcGlyphCount;
- var
- Temp : Integer;
- begin
- FGlyphCount := 1;
- FActiveGlyphCount := 1;
- with BitMap do
- begin
- if (Height > 0) then
- begin
- Temp := Width div Height;
- if ((Temp * Height) = Width) then
- begin
- FGlyphCount := Temp;
- FActiveGlyphCount := Temp;
- end;
- end;
- end;
- end;
-{--------}
-function TOvcCellGlyphs.GetBitMap : TBitMap;
- begin
- with PCellGlyphResource(FResource)^ do
- Result := Bitmap;
- end;
-{--------}
-function TOvcCellGlyphs.GetIsDefault : boolean;
- begin
- Result := FResource = pointer(CBResMgr.DefRes);
- end;
-{--------}
-function TOvcCellGlyphs.IsNotDefault : boolean;
- begin
- Result := not IsDefault;
- end;
-{--------}
-procedure TOvcCellGlyphs.DoCfgChanged;
- begin
- if Assigned(FOnCfgChanged) then
- FOnCfgChanged(Self);
- end;
-{--------}
-procedure TOvcCellGlyphs.SetActiveGlyphCount(G : Integer);
- begin
- if (G <> FActiveGlyphCount) and
- (1 <= G) and (G <= GlyphCount)then
- begin
- FActiveGlyphCount := G;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcCellGlyphs.SetBitMap(BM : TBitMap);
- begin
- CBResMgr.FreeResource(PCellGlyphResource(FResource));
- if (BM = nil) then
- FResource := CBResMgr.DefaultResource
- else
- FResource := CBResMgr.AllocResource(BM);
- CalcGlyphCount;
- DoCfgChanged;
- end;
-{--------}
-procedure TOvcCellGlyphs.SetGlyphCount(G : Integer);
- begin
- if (G <> FGlyphCount) then
- begin
- FGlyphCount := G;
- FActiveGlyphCount := G;
- DoCfgChanged;
- end;
- end;
-{--------}
-procedure TOvcCellGlyphs.SetIsDefault(D : boolean);
- begin
- if (D <> IsDefault) then
- begin
- if D then
- Assign(nil)
- else
- BitMap := BitMap; {note: this actually does do something!}
- CalcGlyphCount;
- DoCfgChanged;
- end;
- end;
-{====================================================================}
-
-
-procedure DestroyManager; far;
- begin
- CBResMgr.Free;
- end;
-
-
-initialization
- CBResMgr := TGlyphResourceManager.Create;
-
-finalization
- DestroyManager;
-end.
diff --git a/Source/3rdParty/Orpheus/ovctsell.pas b/Source/3rdParty/Orpheus/ovctsell.pas
deleted file mode 100644
index 84c47a85..00000000
--- a/Source/3rdParty/Orpheus/ovctsell.pas
+++ /dev/null
@@ -1,704 +0,0 @@
-{*********************************************************}
-{* OVCTSELL.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 ovctsell;
- {-Table cell selection list class}
-
-{Notes:
-
- The TOvcSelectionList class implements a data structure that stores which
- cells in a table are selected. The structure is implemented as an array
- of (sub)arrays, each element of the outer array pertaining to a single
- column. The items in each subarray are ranges of rows that are selected.
- Thus if the cells (in (row,col) format) (1,1)..(2,3) are all selected,
- the structure will look like this:
- Column Value
- 0 nil
- 1 array with 1 element: range row 1 to row 2
- 2 array with 1 element: range row 1 to row 2
- 3 array with 1 element: range row 1 to row 2
- 4 nil
- ...
- Adding a new selected cell at (4,2) would add an element to the third
- column's subarray: a range from row 4 to row 4.
-
- To check whether a cell is selected or not, get the element of the array
- pertaining to the column. If nil, the cell is not selected. If not,
- search through the ranges sequentially until the cell's row falls into a
- range.
-
- Adding a selected cell (or cells) will generally add a new row range
- element to the relevant column array, but it might cause row range
- mergings. Deselecting a cell (or cells) might cause range splittings and
- mergings.
-
- To aid in dynamic selection of cells, the class remembers the 'current
- range'. The table using this class will set the anchor cell address and
- then periodically set the new active cell; the difference between these
- is the current range. The class will move the current range to the above
- data structure when the anchor cell is set. IsCellSelected and
- HaveSelection will both look at this current range as well as the data
- structure. Note that the current range could be for selecting as well as
- deselecting cells: there's a flag to define which.
-
- One important assumption has been made. This is that generally there are
- 'few' selections (obviously one can imagine the fanatical user who is
- determined to see 1000 separate disjoint selections, but normally there
- will be one selection to maybe half a dozen). In other words it will be
- more efficient to code a sequential search internally rather than a
- binary one, and other similar types of speed improvements have not been
- used.
-}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, {$ELSE} LclIntf, {$ENDIF} SysUtils, OvcTCmmn;
-
-type
- TOvcSelRowRange = packed record {a row range}
- L, H : TRowNum;
- end;
-
- POvcSelRRArray = ^TOvcSelRRArray; {an array of row ranges}
- TOvcSelRRArray = packed record
- RRCount : integer;
- RRTotal : integer;
- RRs : array [0..(MaxInt div sizeof(TOvcSelRowRange))-2] of TOvcSelRowRange;
- end;
-
- POvcSelColArray = ^TOvcSelColArray; {an array of arrays of row ranges}
- TOvcSelColArray = array [0..(MaxInt div sizeof(POvcSelRRArray))-1] of POvcSelRRArray;
-
- TOvcSelectionList = class {class to manage list of selected cells}
- protected {private}
- {.Z+}
- {even sized}
- slArray : POvcSelColArray; {array of arrays of row ranges}
- slColCount : TColNum; {number of columns in slArray}
- slColWithSelCount : TColNum; {num of columns with at least 1 selected cell}
- slActiveCol : TColNum; {current active cell-column}
- slActiveRow : TColNum; { -row}
- slAnchorCol : TColNum; {current anchor-column}
- slAnchorRow : TColNum; { -row}
- slRowCount : TRowNum; {number of rows in slArray}
- slColMin : TColNum; {current range-minimum column}
- slColMax : TColNum; { -maximum column}
- slRowMin : TRowNum; { -minimum row}
- slRowMax : TRowNum; { -maximum row}
- {odd sized}
- slSelecting : boolean; {current range is for selection}
- slEmptyRange : boolean; {current range is empty}
- {.Z-}
- protected
- {.Z+}
- procedure slDeselectCellRangeInCol(Row1, Row2 : TRowNum; ColNum : TColNum);
- procedure slSelectCellRangeInCol(Row1, Row2 : TRowNum; ColNum : TColNum);
- {.Z-}
- public
- constructor Create(RowCount : TRowNum; ColCount : TColNum);
- {-Create a new instance for RowCount rows & ColCount columns}
- destructor Destroy; override;
- {-Destroy the instance}
-
- procedure DeselectAll;
- {-Deselect all cells}
- procedure DeselectCell(RowNum : TRowNum; ColNum : TColNum);
- {-Deselect a single cell}
- procedure DeselectCellRange(FromRow : TRowNum; FromCol : TColNum;
- ToRow : TRowNum; ToCol : TColNum);
- {-Deselect a range of cells}
- procedure ExtendRange(RowNum : TRowNum; ColNum : TColNum;
- IsSelecting : boolean);
- {-Extend/shrink the current range to RowNum, ColNum}
- function HaveSelection : boolean;
- {-Return true if at least one cell is selected}
- function IsCellSelected(RowNum : TRowNum; ColNum : TColNum) : boolean;
- {-Return true if specified cell is selected}
- procedure Iterate(SI : TSelectionIterator; ExtraData : pointer);
- {-Iterate through all the selection ranges calling SI for each}
- procedure SelectAll;
- {-Select all cells}
- procedure SelectCell(RowNum : TRowNum; ColNum : TColNum);
- {-Mark a single cell as selected}
- procedure SelectCellRange(FromRow : TRowNum; FromCol : TColNum;
- ToRow : TRowNum; ToCol : TColNum);
- {-Mark a range of cells as selected}
- procedure SetColCount(ColCount : TColNum);
- {-Change the number of columns}
- procedure SetRangeAnchor(RowNum : TRowNum; ColNum : TColNum;
- Action : TOvcTblSelectionType);
- {-Set the anchor cell; if Action is tstAdditional the current
- selection is stored, if not all DeselectAll is called}
- procedure SetRowCount(RowCount : TRowNum);
- {-Change the number of rows}
- end;
-
-implementation
-
-const
- RRArrayInc = 16;
- RRElemSize = sizeof(TOvcSelRowRange);
-
-{===Helper routines==================================================}
-function CalcRRArraySize(ElementCount : integer) : integer;
- {-Given a number of elements, calcs the memory block size}
- begin
- Result := (ElementCount * RRElemSize) + (2 * sizeof(integer));
- end;
-{--------}
-procedure AllocRRArray(var RRA : POvcSelRRArray);
- {-Allocates/grows a row range array}
- var
- NewTotal : integer;
- NewArray: POvcSelRRArray;
- begin
- {are we growing a current allocation?}
- if Assigned(RRA) then
- begin
- NewTotal := RRA^.RRTotal + RRArrayInc;
- NewArray := AllocMem(CalcRRArraySize(NewTotal));
- NewArray^.RRTotal := NewTotal;
- NewArray^.RRCount := RRA^.RRCount;
- Move(RRA^.RRs, NewArray^.RRs, RRA^.RRCount * RRElemSize);
- FreeMem(RRA, CalcRRArraySize(RRA^.RRTotal));
- RRA := NewArray;
- end
- {otherwise this is a new allocation}
- else
- begin
- RRA := AllocMem(CalcRRArraySize(RRArrayInc));
- RRA^.RRTotal := RRArrayInc;
- end;
- end;
-{--------}
-procedure FreeRRArray(var RRA : POvcSelRRArray);
- {-Frees a row range array}
- begin
- {Note: assumes RRA is not nil}
- FreeMem(RRA, CalcRRArraySize(RRA^.RRTotal));
- RRA := nil;
- end;
-{--------}
-procedure ReallocColArray(var CA : POvcSelColArray; OldCC, NewCC : TColNum);
- {-Reallocates (ie allocs or frees or grows) a column array}
- var
- NewArray : POvcSelColArray;
- i : integer;
- begin
- {if there's no change, forget it}
- if (NewCC = OldCC) then
- Exit;
- {if the new array size is greater then just copy over the
- old array's contents after clearing the new array}
- if (NewCC > OldCC) then
- begin
- NewArray := AllocMem(NewCC * sizeof(pointer));
- if (OldCC > 0) then
- Move(CA^, NewArray^, OldCC * sizeof(pointer));
- end
- {if the new array size is smaller then we have to dispose of
- the subarrays that will no longer be used, then copy over
- the remaining elements (if any).}
- else
- begin
- for i := NewCC to pred(OldCC) do
- if Assigned(CA^[i]) then
- FreeRRArray(CA^[i]);
- if (NewCC = 0) then
- NewArray := nil
- else
- begin
- GetMem(NewArray, NewCC * sizeof(pointer));
- Move(CA^, NewArray^, NewCC * sizeof(pointer));
- end;
- end;
- {dispose of the old array, return the new one}
- if (OldCC > 0) then
- FreeMem(CA, OldCC * sizeof(pointer));
- CA := NewArray;
- end;
-{====================================================================}
-
-
-{===TOvcSelectionList================================================}
-constructor TOvcSelectionList.Create(RowCount : TRowNum; ColCount : TColNum);
- begin
- {inherited Create;}
- SetRowCount(RowCount);
- SetColCount(ColCount);
- end;
-{--------}
-destructor TOvcSelectionList.Destroy;
- begin
- SetColCount(0);
- {inherited Destroy;}
- end;
-{--------}
-procedure TOvcSelectionList.DeselectAll;
- var
- ColNum : TColNum;
- begin
- if (slColWithSelCount > 0) then
- begin
- for ColNum := 0 to pred(slColCount) do
- if Assigned(slArray^[ColNum]) then
- FreeRRArray(slArray^[ColNum]);
- slColWithSelCount := 0;
- end;
- slEmptyRange := true;
- end;
-{--------}
-procedure TOvcSelectionList.DeselectCell(RowNum : TRowNum; ColNum : TColNum);
- begin
- {sanity checks}
- if (RowNum < 0) or (RowNum >= slRowCount) or
- (ColNum < 0) or (ColNum >= slColCount) then
- Exit;
- {do it}
- slDeselectCellRangeInCol(RowNum, RowNum, ColNum);
- end;
-{--------}
-procedure TOvcSelectionList.DeselectCellRange(FromRow : TRowNum; FromCol : TColNum;
- ToRow : TRowNum; ToCol : TColNum);
- var
- ColNum : TColNum;
- SwapTemp : longint;
- begin
- {save the caller from himself: sort the rows/cols into ascending order}
- if FromRow > ToRow then
- begin
- SwapTemp := FromRow;
- FromRow := ToRow;
- ToRow := SwapTemp;
- end;
- if FromCol > ToCol then
- begin
- SwapTemp := FromCol;
- FromCol := ToCol;
- ToCol := SwapTemp;
- end;
- {sanity checks}
- if (FromRow < 0) or (FromRow >= slRowCount) or
- (ToRow < 0) or (ToRow >= slRowCount) or
- (FromCol < 0) or (FromCol >= slColCount) or
- (ToCol < 0) or (ToCol >= slColCount) then
- Exit;
- {for each column, deselect cells in that column}
- for ColNum := FromCol to ToCol do
- slDeselectCellRangeInCol(FromRow, ToRow, ColNum);
- end;
-{--------}
-{$IFDEF SuppressWarnings}
-{$WARNINGS OFF}
-{$ENDIF}
-procedure TOvcSelectionList.slDeselectCellRangeInCol(Row1, Row2 : TRowNum;
- ColNum : TColNum);
- var
- Inx : integer;
- i : integer;
- RRA : POvcSelRRArray;
- MustDelete : boolean;
- StillGoing : boolean;
- begin
- Inx := 0;
- {take care of the simple special case first: there are no
- selections in the column at all}
- if (not Assigned(slArray^[ColNum])) then
- Exit;
- {make sure the array has at least one spare element: we could
- be splitting a range}
- RRA := slArray^[ColNum];
- if (RRA^.RRCount = RRA^.RRTotal) then
- begin
- AllocRRArray(RRA);
- slArray^[ColNum] := RRA;
- end;
- {with this array}
- with RRA^ do
- begin
- {search for the place to delete from}
- MustDelete := false;
- for i := 0 to pred(RRCount) do
- if (Row1 < RRs[i].L) then
- begin
- MustDelete := true;
- Inx := i;
- Break;{out of for loop}
- end
- else if (Row1 <= RRs[i].H) then
- begin
- MustDelete := true;
- Inx := succ(i);
- Break;{out of for loop}
- end;
-
- {if the range to deselect appears after all other
- ranges, just exit, nothing to do}
- if not MustDelete then
- Exit;
- {walk through the array starting at pred(Inx)
- and split/remove as we go}
- if (Inx > 0) then
- dec(Inx);
- StillGoing := true;
- while StillGoing and (Inx < RRCount) do
- if (RRs[Inx].L < Row1) then
- if (RRs[Inx].H < Row1) then
- inc(Inx)
- else {H >= Row1} if (RRs[Inx].H > Row2) then
- begin
- {split, the deselect range is entirely within this range}
- Move(RRs[Inx], RRs[succ(Inx)], (RRCount-Inx)*RRElemSize);
- inc(RRCount);
- RRs[Inx].H := pred(Row1);
- RRs[succ(Inx)].L := succ(Row2);
- StillGoing := false;
- end
- else {H >= Row1 and <= Row2}
- begin
- RRs[Inx].H := pred(Row1);
- inc(Inx);
- end
- else {L >= Row1} if (RRs[Inx].L <= Row2) then
- if (RRs[Inx].H > Row2) then
- begin
- RRs[Inx].L := succ(Row2);
- StillGoing := false;
- end
- else {H <= Row2}
- begin
- {delete the range completely}
- dec(RRCount);
- Move(RRs[succ(Inx)], RRs[Inx], (RRCount-Inx)*RRElemSize);
- end
- else {L >= Row1 and > Row2}
- StillGoing := false;
- end;
- {check to see whether we've managed to deselect every cell, if so
- free the row range array}
- if (RRA^.RRCount = 0) then
- begin
- FreeRRArray(slArray^[ColNum]);
- dec(slColWithSelCount);
- end;
- end;
-{$IFDEF SuppressWarnings}
-{$WARNINGS ON}
-{$ENDIF}
-{--------}
-procedure TOvcSelectionList.ExtendRange(RowNum : TRowNum; ColNum : TColNum;
- IsSelecting : boolean);
- begin
- if (RowNum < 0) or (RowNum >= slRowCount) or
- (ColNum < 0) or (ColNum >= slColCount) then
- Exit;
- slSelecting := IsSelecting;
- slActiveRow := RowNum;
- slActiveCol := ColNum;
- slEmptyRange := (slAnchorRow = RowNum) and (slAnchorCol = ColNum);
- if not slEmptyRange then
- begin
- slColMin := MinL(slAnchorCol, ColNum);
- slColMax := MaxL(slAnchorCol, ColNum);
- slRowMin := MinL(slAnchorRow, RowNum);
- slRowMax := MaxL(slAnchorRow, RowNum);
- end;
- end;
-{--------}
-function TOvcSelectionList.HaveSelection : boolean;
- begin
- Result := (not slEmptyRange) or (slColWithSelCount <> 0);
- end;
-{--------}
-function TOvcSelectionList.IsCellSelected(RowNum : TRowNum; ColNum : TColNum) : boolean;
- var
- i : integer;
- begin
- {assume false, the cell is not selected}
- Result := false;
- {sanity checks}
- if (RowNum < 0) or (RowNum >= slRowCount) or
- (ColNum < 0) or (ColNum >= slColCount) then
- Exit;
- {check in current range}
- if (not slEmptyRange) then
- if (slColMin <= ColNum) and (ColNum <= slColMax) and
- (slRowMin <= RowNum) and (RowNum <= slRowMax) then
- begin
- Result := slSelecting;
- Exit;
- end;
- {if the column array exists, search through it; note we use a
- sequential search: it'll be faster than a binary search for a
- 'few' elements, and generally there will be 'few' elements}
- if Assigned(slArray^[ColNum]) then with slArray^[ColNum]^ do
- for i := 0 to pred(RRCount) do
- if (RRs[i].L <= RowNum) and (RowNum <= RRs[i].H) then
- begin
- Result := true;
- Exit;
- end;
- end;
-{--------}
-procedure TOvcSelectionList.Iterate(SI : TSelectionIterator; ExtraData : pointer);
- var
- ColNum : TColNum;
- RangeNum : integer;
- begin
- {fix the current range}
- if not slEmptyRange then
- begin
- if slSelecting then
- SelectCellRange(slRowMin, slColMin, slRowMax, slColMax)
- else
- DeselectCellRange(slRowMin, slColMin, slRowMax, slColMax);
- slEmptyRange := true;
- end;
- {iterate through the ranges}
- for ColNum := 0 to pred(slColCount) do
- if Assigned(slArray^[ColNum]) then
- with slArray^[ColNum]^ do
- for RangeNum := 0 to pred(RRCount) do
- if not SI(RRs[RangeNum].L, ColNum, RRs[RangeNum].H, ColNum, ExtraData) then
- Exit;
- end;
-{--------}
-procedure TOvcSelectionList.SelectAll;
- var
- ColNum : TColNum;
- begin
- for ColNum := 0 to pred(slColCount) do
- begin
- if not Assigned(slArray^[ColNum]) then
- AllocRRArray(slArray^[ColNum]);
- with slArray^[ColNum]^ do
- begin
- RRCount := 1;
- RRs[0].L := 0;
- RRs[0].H := pred(slRowCount);
- end;
- end;
- slColWithSelCount := slColCount;
- end;
-{--------}
-procedure TOvcSelectionList.SelectCell(RowNum : TRowNum; ColNum : TColNum);
- begin
- {sanity checks}
- if (RowNum < 0) or (RowNum >= slRowCount) or
- (ColNum < 0) or (ColNum >= slColCount) then
- Exit;
- {do it}
- slSelectCellRangeInCol(RowNum, RowNum, ColNum);
- end;
-{--------}
-procedure TOvcSelectionList.SelectCellRange(FromRow : TRowNum; FromCol : TColNum;
- ToRow : TRowNum; ToCol : TColNum);
- var
- ColNum : TColNum;
- SwapTemp : longint;
- begin
- {save the caller from himself: sort the rows/cols into ascending order}
- if FromRow > ToRow then
- begin
- SwapTemp := FromRow;
- FromRow := ToRow;
- ToRow := SwapTemp;
- end;
- if FromCol > ToCol then
- begin
- SwapTemp := FromCol;
- FromCol := ToCol;
- ToCol := SwapTemp;
- end;
- {sanity checks}
- if (FromRow < 0) or (FromRow >= slRowCount) or
- (ToRow < 0) or (ToRow >= slRowCount) or
- (FromCol < 0) or (FromCol >= slColCount) or
- (ToCol < 0) or (ToCol >= slColCount) then
- Exit;
- {for each column, select cells in that column}
- for ColNum := FromCol to ToCol do
- slSelectCellRangeInCol(FromRow, ToRow, ColNum);
- end;
-{--------}
-{$IFDEF SuppressWarnings}
-{$WARNINGS OFF}
-{$ENDIF}
-procedure TOvcSelectionList.slSelectCellRangeInCol(Row1, Row2 : TRowNum;
- ColNum : TColNum);
- var
- i : integer;
- Inx : integer;
- NextInx : integer;
- RRA : POvcSelRRArray;
- MustInsert : boolean;
- StillGoing : boolean;
- AlreadyMerged: boolean;
- begin
- Inx := 0;
- {take care of the simple special case first: there are no
- selections in the column as yet}
- if (not Assigned(slArray^[ColNum])) then
- begin
- AllocRRArray(slArray^[ColNum]);
- inc(slColWithSelCount);
- with slArray^[ColNum]^ do
- begin
- RRCount := 1;
- RRs[0].L := Row1;
- RRs[0].H := Row2;
- end;
- Exit;
- end;
- {make sure the array has at least one spare element}
- RRA := slArray^[ColNum];
- if (RRA^.RRCount = RRA^.RRTotal) then
- begin
- AllocRRArray(RRA);
- slArray^[ColNum] := RRA;
- end;
- {with this array}
- with RRA^ do
- begin
- {search for the place to insert/merge}
- MustInsert := false;
- for i := 0 to pred(RRCount) do
- if (Row1 < RRs[i].L) then
- begin
- MustInsert := true;
- Inx := i;
- Break;{out of for loop}
- end;
- {if the new range appears after all the other ranges, add it
- to the end of the list; check to be able to merge it first}
- if not MustInsert then
- begin
- if (Row1 <= succ(RRs[pred(RRCount)].H)) then
- RRs[pred(RRCount)].H := MaxL(Row2, RRs[pred(RRCount)].H)
- else
- begin
- RRs[RRCount].L := Row1;
- RRs[RRCount].H := Row2;
- inc(RRCount);
- end;
- Exit;
- end;
- {otherwise we must insert; first insert the new range}
- Move(RRs[Inx], RRs[succ(Inx)], (RRCount-Inx) * RRElemSize);
- RRs[Inx].L := Row1;
- RRs[Inx].H := Row2;
- inc(RRCount);
- {now walk through the array starting at pred(Inx) and merge
- ranges as we move forward}
- if (Inx > 0) then
- dec(Inx);
- NextInx := succ(Inx);
- AlreadyMerged := false;
- StillGoing := true;
- while StillGoing and (NextInx < RRCount) do
- begin
- if (succ(RRs[Inx].H) >= RRs[NextInx].L) then
- begin
- RRs[Inx].H := MaxL(RRs[Inx].H, RRs[NextInx].H);
- inc(NextInx);
- AlreadyMerged := true;
- end
- else if AlreadyMerged then
- StillGoing := false
- else
- begin
- inc(Inx);
- inc(NextInx);
- AlreadyMerged := true;
- end;
- end;
- {by this point we know we must get rid of the elements
- in between Inx and NextInx -- they've been merged into
- other ranges}
- if ((NextInx - Inx) > 1) then
- begin
- if (NextInx < RRCount) then
- Move(RRs[NextInx], RRs[succ(Inx)], (RRCount-NextInx)*RRElemSize);
- dec(RRCount, NextInx - Inx - 1);
- end;
- end;
- end;
-{$IFDEF SuppressWarnings}
-{$WARNINGS ON}
-{$ENDIF}
-{--------}
-procedure TOvcSelectionList.SetRangeAnchor(RowNum : TRowNum; ColNum : TColNum;
- Action : TOvcTblSelectionType);
- begin
- {sanity checks}
- if (RowNum < 0) or (RowNum >= slRowCount) or
- (ColNum < 0) or (ColNum >= slColCount) then
- Exit;
- {what's happening? deselecting all, or adding a new range}
- if (Action = tstDeselectAll) then
- DeselectAll
- else {an additional range is being set up}
- if not slEmptyRange then
- if slSelecting then
- SelectCellRange(slRowMin, slColMin, slRowMax, slColMax)
- else
- DeselectCellRange(slRowMin, slColMin, slRowMax, slColMax);
- slAnchorRow := RowNum;
- slAnchorCol := ColNum;
- slActiveRow := RowNum;
- slActiveCol := ColNum;
- slEmptyRange := true;
- end;
-{--------}
-procedure TOvcSelectionList.SetColCount(ColCount : TColNum);
- begin
- if (ColCount >= 0) then
- begin
- ReallocColArray(slArray, slColCount, ColCount);
- slColCount := ColCount;
- end;
- end;
-{--------}
-procedure TOvcSelectionList.SetRowCount(RowCount : TRowNum);
- begin
- if (RowCount >= 0) then
- slRowCount := RowCount;
- end;
-{====================================================================}
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovcurl.pas b/Source/3rdParty/Orpheus/ovcurl.pas
deleted file mode 100644
index c42c0abe..00000000
--- a/Source/3rdParty/Orpheus/ovcurl.pas
+++ /dev/null
@@ -1,310 +0,0 @@
-{*********************************************************}
-{* OVCURL.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 ***** *}
-
-(*Changes)
-
- 01/23/02 - Added UnderlineURL property.
-*)
-
-
-{$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 ovcurl;
- {-URL label}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, MyMisc, {$ENDIF}
- Classes, Controls, Dialogs, ExtCtrls, Graphics, Menus,
- {$IFDEF MSWINDOWS} ShellAPI, {$ELSE} Unix, {$ENDIF}
- StdCtrls, SysUtils, OvcVer;
-
-type
- TOvcURL = class(TCustomLabel)
- protected {private}
- FCaption : string;
- FHighlightColor : TColor;
- FURL : string;
- FUseVisitedColor : Boolean;
- FVisitedColor : TColor;
-
- {internal variables}
- urlTimer : TTimer;
- urlFontColor : TColor;
-
- {property methods}
- function GetAbout : string;
- function GetUnderlineURL: Boolean;
- procedure SetAbout(const Value : string);
- procedure SetCaption(const Value : string);
- procedure SetHighlightColor(const Value : TColor);
- procedure SetUnderlineURL(Value: Boolean);
- procedure SetURL(const Value : string);
- procedure SetVisitedColor(const Value : TColor);
-
- {internal methods}
- procedure TimerEvent(Sender : TObject);
-
- procedure Loaded; override;
-
- protected
- procedure MouseMove(Shift : TShiftState; X, Y : Integer);
- override;
-
- public
- procedure Click;
- override;
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
-
- published
- property About : string
- read GetAbout write SetAbout stored False;
- property Caption : string
- read FCaption write SetCaption;
- property HighlightColor : TColor
- read FHighlightColor write SetHighlightColor
- default clRed;
- property UnderlineURL: Boolean
- read GetUnderlineURL write SetUnderlineURL
- stored False;
- property URL : string
- read FURL write SetURL;
- property UseVisitedColor : Boolean
- read FUseVisitedColor write FUseVisitedColor
- default False;
- property VisitedColor : TColor
- read FVisitedColor write SetVisitedColor
- stored FUseVisitedColor
- default clBlack;
-
- {$IFDEF VERSION4}
- property Anchors;
- property Constraints;
- property DragKind;
- {$ENDIF}
- property Align;
- property Alignment;
- property AutoSize;
- property Color;
- property Cursor default crHandPoint;
- property DragCursor;
- property DragMode;
- property Enabled;
- property FocusControl;
- property Font;
- property ParentColor;
- property ParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ShowAccelChar;
- property ShowHint;
- property Transparent default False;
- property Layout;
- property Visible;
- property WordWrap;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDrag;
- end;
-
-
-implementation
-
-const
- BadColor = $02000000;
-
-{*** TOvcURL ***}
-procedure TOvcURL.Loaded;
-begin
- inherited Loaded;
-
-// Font.Style := Font.Style + [fsUnderline];
- urlFontColor := BadColor;
-end;
-
-procedure TOvcURL.Click;
-{$IFDEF MSWINDOWS}
-var
- Buf : array[0..1023] of Char;
-begin
- if URL > '' then begin
- StrPLCopy(Buf, URL, SizeOf(Buf)-1);
- if ShellExecute(0, 'open', Buf, '', '', SW_SHOWNORMAL) <= 32 then
- MessageBeep(0);
- end;
-{$ELSE}
-begin
- if URL > '' then begin
- {$IFDEF DARWIN}
- if fpSystem('Open ' + URL) = 127 then
- MessageBeep(0);
- {$ELSE}
- if (GetBrowserPath = '') or
- (fpSystem(GetBrowserPath + ' ' + URL) = 127) then
- MessageBeep(0);
- {$ENDIF}
- end;
-{$ENDIF}
-
- inherited Click;
-
- {change color to visited color if enabled}
- if FUseVisitedColor then
- urlFontColor := FVisitedColor;
-end;
-
-constructor TOvcURL.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
- FHighlightColor := clRed;
- Cursor := crHandPoint;
- Font.Style := Font.Style + [fsUnderline];
-end;
-
-destructor TOvcURL.Destroy;
-begin
- if Assigned(urlTimer) then begin
- urlTimer.Free;
- urlTimer := nil;
- end;
-
- inherited Destroy;
-end;
-
-function TOvcURL.GetAbout : string;
-begin
- Result := OrVersionStr;
-end;
-
-function TOvcURL.GetUnderlineURL: Boolean;
-begin
- result := fsUnderline in Font.Style;
-end;
-
-procedure TOvcURL.MouseMove(Shift : TShiftState; X, Y : Integer);
-begin
- inherited MouseMove(Shift, X, Y);
-
- if PtInRect(ClientRect, Point(X, Y)) then begin
- if not Assigned(urlTimer) then begin
- {save current font color}
- if urlFontColor = BadColor then
- urlFontColor := Font.Color;
- Font.Color := FHighlightColor;
- urlTimer := TTimer.Create(Self);
- urlTimer.Interval := 100;
- urlTimer.OnTimer := TimerEvent;
- urlTimer.Enabled := True;
- end;
- end;
-end;
-
-procedure TOvcURL.SetAbout(const Value : string);
-begin
-end;
-
-procedure TOvcURL.SetCaption(const Value : string);
-begin
- FCaption := Value;
- if FCaption > '' then
- inherited Caption := FCaption
- else
- inherited Caption := URL;
-end;
-
-procedure TOvcURL.SetHighlightColor(const Value: TColor);
-begin
- if Value = clNone then
- FHighlightColor := Font.Color
- else
- FHighlightColor := Value;
-
- {reset stored color}
- urlFontColor := BadColor;
-end;
-
-{ - added}
-procedure TOvcURL.SetUnderlineURL(Value: Boolean);
-begin
- if Value then
- Font.Style := Font.Style + [fsUnderline]
- else
- Font.Style := Font.Style - [fsUnderline];
-end;
-
-procedure TOvcURL.SetURL(const Value : string);
-begin
- FURL := Value;
- if FCaption = '' then
- inherited Caption := URL;
-end;
-
-procedure TOvcURL.SetVisitedColor(const Value : TColor);
-begin
- if Value = clNone then
- FVisitedColor := Font.Color
- else
- FVisitedColor := Value;
-
- {reset stored color}
- urlFontColor := BadColor;
-end;
-
-procedure TOvcURL.TimerEvent(Sender : TObject);
-var
- Pt : TPoint;
-begin
- GetCursorPos(Pt);
- Pt := ScreentoClient(Pt);
- if not PtInRect(ClientRect, Pt) then begin
- urlTimer.Free;
- urlTimer := nil;
- Font.Color := urlFontColor;
- Repaint;
- end;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovcuser.pas b/Source/3rdParty/Orpheus/ovcuser.pas
deleted file mode 100644
index 4c60b145..00000000
--- a/Source/3rdParty/Orpheus/ovcuser.pas
+++ /dev/null
@@ -1,186 +0,0 @@
-{*********************************************************}
-{* 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.
diff --git a/Source/3rdParty/Orpheus/ovcver.pas b/Source/3rdParty/Orpheus/ovcver.pas
deleted file mode 100644
index f8f647c1..00000000
--- a/Source/3rdParty/Orpheus/ovcver.pas
+++ /dev/null
@@ -1,48 +0,0 @@
-{*********************************************************}
-{* OVCVER.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 ovcver;
- {-Versioning defines and methods}
-
-interface
-
-const
- OrVersionStr = 'v4.06';
-
-implementation
-
-end.
diff --git a/Source/3rdParty/Orpheus/ovcvlb.pas b/Source/3rdParty/Orpheus/ovcvlb.pas
deleted file mode 100644
index 8474a466..00000000
--- a/Source/3rdParty/Orpheus/ovcvlb.pas
+++ /dev/null
@@ -1,2540 +0,0 @@
-{*********************************************************}
-{* OVCVLB.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}
-//{$Q-} {Arithmatic-Overflow Checking} <== Does this hide Turbopower bugs?
-
-unit ovcvlb;
- {-Virtual list box component}
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, Types, LclType, MyMisc, {$ENDIF}
- Classes, Controls, Forms, Graphics, StdCtrls, Menus,
- SysUtils, OvcBase, OvcData, OvcCmd, OvcConst, OvcMisc, OvcExcpt, OvcColor;
-
-const
- vlbMaxTabStops = 128; {maximum number of tab stops}
-
-const
- {default property values}
- vlDefAutoRowHeight = True;
- vlDefAlign = alNone;
- vlDefBorderStyle = bsSingle;
- vlDefColor = clWindow;
- vlDefColumns = 255;
- vlDefCtl3D = True;
- vlDefHeaderBack = clBtnFace;
- vlDefHeaderText = clBtnText;
- vlDefHeight = 150;
- vlDefIntegralHeight = True;
- vlDefItemIndex = -1;
- vlDefMultiSelect = False;
-{$IFDEF MSWINDOWS}
- vlDefNumItems = MaxLongInt; //2,147,483,647
-{$ELSE}
- vlDefNumItems = 126322582; //Apparent max. scrollbar positions with Carbon.
-{$ENDIF} // GTK apparently allows 2,115,747,484.
- vlDefOwnerDraw = False;
- vlDefParentColor = False;
- vlDefParentCtl3D = True;
- vlDefParentFont = True;
- vlDefProtectBack = clRed;
- vlDefProtectText = clWhite;
- vlDefRowHeight = 17;
- vlDefScrollBars = ssVertical;
- vlDefSelectBack = clHighlight;
- vlDefSelectText = clHighlightText;
- vlDefShowHeader = False;
- vlDefTopIndex = 0;
- vlDefTabStop = True;
- vlDefUseTabStops = False;
- vlDefWidth = 100;
-
-type
- TCharToItemEvent =
- procedure(Sender : TObject; Ch : Char; var Index : LongInt)
- of object;
- {-event to notify caller of a key press and return new item index}
- TDrawItemEvent =
- procedure(Sender : TObject; Index : LongInt; Rect : TRect; const S : string)
- of object;
- {-event to allow user to draw the cell items}
- TGetItemEvent =
- procedure(Sender : TObject; Index : LongInt; var ItemString : string)
- of object;
- {-event to get string to display}
- TGetItemColorEvent =
- procedure(Sender : TObject; Index : LongInt; var FG, BG : TColor)
- of object;
- {-event to get color of the item cell}
- TGetItemStatusEvent =
- procedure(Sender : TObject; Index : LongInt; var Protect : Boolean)
- of object;
- {-event to get the protected status item cell}
- THeaderClickEvent =
- procedure(Sender : TObject; Point : TPoint)
- of object;
- {-event to notify of a mouse click in the header area}
- TIsSelectedEvent =
- procedure(Sender : TObject; Index : LongInt; var Selected : Boolean)
- of object;
- {-event to get the current selection status from the user}
- TSelectEvent =
- procedure(Sender : TObject; Index : LongInt; Selected : Boolean)
- of object;
- {-event to notify of a selection change}
- TTopIndexChanged =
- procedure(Sender : TObject; NewTopIndex : LongInt)
- of object;
- {-event to notify when the top index changes}
-
-type
- TTabStopArray = array[0..vlbMaxTabStops] of Integer;
- TBuffer = array[0..255] of AnsiChar;
-
-type
- TOvcCustomVirtualListBox = class(TOvcCustomControlEx)
- {.Z+}
- protected {private}
- {property variables}
- FItemIndex : LongInt; {selected item}
- FAutoRowHeight : Boolean; {true to handle row height calc}
- FBorderStyle : TBorderStyle;{border style to use}
- FColumns : Integer; {number of char columns}
- FFillColor : TColor;
- FHeader : string; {the column header}
- FHeaderColor : TOvcColors; {header line colors}
- FIntegralHeight : Boolean; {adjust height based on font}
- FMultiSelect : Boolean; {allow multiple selections}
- FNumItems : LongInt; {total number of items}
- FOwnerDraw : Boolean; {true if user will draw rows}
- FProtectColor : TOvcColors; {protected item colors}
- FRowHeight : Integer; {height of one row}
- FScrollBars : TScrollStyle;{scroll bar style to use}
- FSelectColor : TOvcColors; {selected item color}
- FShowHeader : Boolean; {true to use the header}
- FSmoothScroll : Boolean; {use smooth scrolling (duh) }
- FTopIndex : LongInt; {item at top of window}
- FUseTabStops : Boolean; {true to use tab stops}
- FWheelDelta : Integer;
-{$IFDEF LCL}
- FCtl3D : Boolean;
-{$ENDIF}
-
- {event variables}
- FOnCharToItem : TCharToItemEvent;
- FOnClickHeader : THeaderClickEvent;
- FOnDrawItem : TDrawItemEvent;
- FOnGetItem : TGetItemEvent;
- FOnGetItemColor : TGetItemColorEvent;
- FOnGetItemStatus : TGetItemStatusEvent;
- FOnIsSelected : TIsSelectedEvent;
- FOnSelect : TSelectEvent;
- FOnTopIndexChanged : TTopIndexChanged;
- FOnUserCommand : TUserCommandEvent;
-
- {internal/working variables}
- lAnchor : LongInt; {anchor point for extended selections}
- lDivisor : LongInt; {divisor for scroll bars}
- lDlgUnits : Integer; {used for tab spacing}
- lFocusedIndex : LongInt; {index of the focused item}
- lHaveHS : Boolean; {if True, we have a horizontal scroll bar}
- lHaveVS : Boolean; {if True, we have a vertical scroll bar}
- lHDelta : LongInt; {horizontal scroll delta}
- lHighIndex : LongInt; {highest allowable index}
- lNumTabStops : 0..vlbMaxTabStops; {number of tab stops in tabstop array}
- lRows : Integer; {number of rows in window}
- lString : TBuffer; {temp item string buffer}
- lTabs : TTabStopArray;
- lUpdating : Integer; {user updating flag}
- lVSHigh : Integer; {vertical scroll limit}
- lVMargin : Integer; {extra vertical line margin}
- MousePassThru : Boolean;
-
- {property methods}
- procedure SetAutoRowHeight(Value : Boolean);
- {-set use of auto row height calculations}
- procedure SetBorderStyle(const Value : TBorderStyle);
- {-set the style used for the border}
- procedure SetColumns(const Value: Integer);
- procedure SetHeader(const Value : string);
- {-set the header at top of list box}
- procedure SetIntegralHeight(Value : Boolean);
- {-set use of integral font height adjustment}
- procedure SetMultiSelect(Value : Boolean); virtual;
- {-set ability to select multiple items}
- procedure InternalSetNumItems(Value : LongInt; Paint, UpdateIndices : Boolean);
- {-set the number of items in the list box}
- procedure SetNumItems(Value : LongInt);
- {-set the number of items in the list box}
- procedure SetRowHeight(Value : Integer);
- {-set height of cell row}
- procedure SetScrollBars(const Value : TScrollStyle); virtual;
- {-set use of vertical and horizontal scroll bars}
- procedure SetShowHeader(Value : Boolean);
- {-set the header at top of list box}
-
- {internal methods}
- procedure vlbAdjustIntegralHeight;
- {-adjust height of the list box}
- procedure vlbCalcFontFields; virtual;
- {-calculate sizes based on font selection}
- procedure vlbClearAllItems;
- {-clear the highlight from all items}
- procedure vlbClearSelRange(First, Last : LongInt);
- {-clear the selection for the given range of indexes}
- procedure vlbColorChanged(AColor: TObject);
- {-a color has changed, refresh display}
- procedure vlbDragSelection(First, Last : LongInt);
- {-drag the selection}
- procedure vlbDrawFocusRect(Index : LongInt);
- {-draw the focus rectangle}
- procedure vlbDrawHeader;
- {-draw the header and text area}
- procedure vlbExtendSelection(Index : LongInt);
- {-process Shift-LMouseBtn}
- procedure vlbHScrollPrim(Delta : Integer);
- {-scroll horizontally}
- procedure vlbInitScrollInfo;
- {-setup scroll bar range and initial position}
- procedure vlbMakeItemVisible(Index : LongInt);
- {-make sure the item is visible}
- procedure vlbNewActiveItem(Index : LongInt);
- {-set the currently selected item}
- function vlbScaleDown(N : LongInt) : Integer;
- {-scale down index for scroll bar use}
- function vlbScaleUp(N : LongInt) : LongInt;
- {-scale up scroll index to our index}
- procedure vlbSelectRangePrim(First, Last : LongInt; Select : Boolean);
- {-change the selection for the given range of indexes}
- procedure vlbSetAllItemsPrim(Select : Boolean);
- {-primitive routine thats acts on all items}
- procedure vlbSetFocusedIndex(Index : LongInt);
- {-set focus to this item. invalidate previous}
- procedure vlbSetHScrollPos;
- {-set the horizontal scroll position}
- procedure vlbSetHScrollRange;
- {-set the horizontal scroll range}
- procedure vlbSetSelRange(First, Last : LongInt);
- {-set the selection on for the given range of indexes}
- procedure vlbSetVScrollPos;
- {-set the vertical scroll position}
- procedure vlbSetVScrollRange;
- {-set the vertical scroll range}
- procedure vlbToggleSelection(Index : LongInt);
- {-process Ctrl-LMouseBtn}
- procedure vlbValidateItem(Index : LongInt);
- {-validate the area for this item}
- procedure vlbVScrollPrim(Delta : Integer);
- {-scroll vertically}
-
- {VCL control messages}
-{$IFNDEF LCL}
- procedure CMCtl3DChanged(var Message: TMessage);
- message CM_CTL3DCHANGED;
-{$ENDIF}
- procedure CMFontChanged(var Message: TMessage);
- message CM_FONTCHANGED;
-
- {windows message methods}
- procedure WMChar(var Msg : TWMChar);
- message WM_CHAR;
- procedure WMEraseBkgnd(var Msg : TWMEraseBkgnd);
- message WM_ERASEBKGND;
- procedure WMGetDlgCode(var Msg : TWMGetDlgCode);
- message WM_GETDLGCODE;
- procedure WMHScroll(var Msg : TWMScroll);
- message WM_HSCROLL;
- procedure WMKeyDown(var Msg : TWMKeyDown);
- message WM_KEYDOWN;
- procedure WMKillFocus(var Msg : TWMKillFocus);
- message WM_KILLFOCUS;
- procedure WMLButtonDown(var Msg : TWMLButtonDown);
- message WM_LBUTTONDOWN;
- procedure WMLButtonDblClk(var Msg : TWMLButtonDblClk);
- message WM_LBUTTONDBLCLK;
- procedure WMMouseActivate(var Msg : TWMMouseActivate);
- message WM_MOUSEACTIVATE;
- procedure WMSetFocus(var Msg : TWMSetFocus);
- message WM_SETFOCUS;
- procedure WMSize(var Msg : TWMSize);
- message WM_SIZE;
- procedure WMVScroll(var Msg : TWMScroll);
- message WM_VSCROLL;
-
- {list box messages}
- procedure LBGetCaretIndex(var Msg : TMessage);
- message LB_GETCARETINDEX;
- procedure LBGetCount(var Msg : TMessage);
- message LB_GETCOUNT;
- procedure LBGetCurSel(var Msg : TMessage);
- message LB_GETCURSEL;
- procedure LBGetItemHeight(var Msg : TMessage);
- message LB_GETITEMHEIGHT;
- procedure LBGetItemRect(var Msg : TMessage);
- message LB_GETITEMRECT;
- procedure LBGetSel(var Msg : TMessage);
- message LB_GETSEL;
- procedure LBGetTopIndex(var Msg : TMessage);
- message LB_GETTOPINDEX;
- procedure LBResetContent(var Msg : TMessage);
- message LB_RESETCONTENT;
- procedure LBSelItemRange(var Msg : TMessage);
- message LB_SELITEMRANGE;
- procedure LBSetCurSel(var Msg : TMessage);
- message LB_SETCURSEL;
- procedure LBSetSel(var Msg : TMessage);
- message LB_SETSEL;
- procedure LBSetTabStops(var Msg : TMessage);
- message LB_SETTABSTOPS;
- procedure LBSetTopIndex(var Msg : TMessage);
- message LB_SETTOPINDEX;
-
- protected
- procedure ChangeScale(M, D : Integer);
- override;
- procedure CreateParams(var Params: TCreateParams);
- override;
- procedure CreateWnd;
- override;
- procedure DragCanceled;
- override;
- procedure Paint;
- override;
- procedure WndProc(var Message: TMessage);
- override;
-
- {event wrappers}
- function DoOnCharToItem(Ch : AnsiChar) : LongInt;
- dynamic;
- {-call the OnCharToItem event, if assigned}
- procedure DoOnClickHeader(Point : TPoint);
- dynamic;
- {-call the OnClickHeader event, if assigned}
- procedure DoOnDrawItem(Index : LongInt; Rect : TRect; const S : string);
- virtual;
- {-call the OnDrawItem event, if assigned}
- function DoOnGetItem(Index : LongInt) : PAnsiChar;
- virtual;
- {-call the OnGetItem event, if assigned}
- procedure DoOnGetItemColor(Index : LongInt; var FG, BG : TColor);
- virtual;
- {-call the OnGetItemColor event, if assigned}
- function DoOnGetItemStatus(Index : LongInt) : Boolean;
- virtual;
- {-call the OnGetItemStatus event, if assigned}
- function DoOnIsSelected(Index : LongInt) : Boolean;
- virtual;
- {-call the OnIsSelected event, if assigned}
- procedure DoOnMouseWheel(Shift : TShiftState; Delta, XPos, YPos : SmallInt);
- override;
- procedure DoOnSelect(Index : LongInt; Selected : Boolean);
- dynamic;
- {-call the OnSelect event, if assigned}
- procedure DoOnTopIndexChanged(NewTopIndex : LongInt);
- dynamic;
- {-call the OnTopIndexChanged event, if assigned}
- procedure DoOnUserCommand(Command : Word);
- dynamic;
- {-perform notification of a user command}
-
- {virtual property methods}
- procedure SetItemIndex(Index : LongInt);
- virtual;
- {-change the currently selected item}
- procedure SetTopIndex(Index : LongInt);
- virtual;
- {-set the index of the first visible entry in the list}
- procedure ForceTopIndex(Index : LongInt; ThumbTracking : Boolean);
- virtual;
- {-re-set the index of the first visible entry in the list - even if it doesn't change}
-
- procedure SimulatedClick;
- virtual;
- {-generates a click event when called. Called from SetItemIndex. Introduced so that
- descendants can turn off the behavior.}
- function IsValidIndex(Index : LongInt) : Boolean;
-
- {.Z-}
-
- {protected properties}
- property AutoRowHeight : Boolean
- read FAutoRowHeight write SetAutoRowHeight default vlDefAutoRowHeight;
- property BorderStyle : TBorderStyle
- read FBorderStyle write SetBorderStyle default vlDefBorderStyle;
- property Columns : Integer
- read FColumns write SetColumns default vlDefColumns;
- property Header : string
- read FHeader write SetHeader;
- property HeaderColor : TOvcColors
- read FHeaderColor write FHeaderColor;
- property IntegralHeight : Boolean
- read FIntegralHeight write SetIntegralHeight default vlDefIntegralHeight;
- property MultiSelect : Boolean
- read FMultiSelect write SetMultiSelect default vlDefMultiSelect;
- property NumItems : LongInt
- read FNumItems write SetNumItems default vlDefNumItems;
- property OwnerDraw : Boolean
- read FOwnerDraw write FOwnerDraw default vlDefOwnerDraw;
- property ProtectColor : TOvcColors
- read FProtectColor write FProtectColor;
- property RowHeight : Integer
- read FRowHeight write SetRowHeight default vlDefRowHeight;
- property ScrollBars : TScrollStyle
- read FScrollBars write SetScrollBars default vlDefScrollBars;
- property SelectColor : TOvcColors
- read FSelectColor write FSelectColor;
- property ShowHeader : Boolean
- read FShowHeader write SetShowHeader default vlDefShowHeader;
- property UseTabStops : Boolean
- read FUseTabStops write FUseTabStops default vlDefUseTabStops;
- property WheelDelta: Integer
- read FWheelDelta write FWheelDelta default 3;
-{$IFDEF LCL}
- property Ctl3D : Boolean read FCtl3D write FCtl3D default vlDefCtl3D;
-{$ENDIF}
- {protected events}
- property OnCharToItem : TCharToItemEvent
- read FOnCharToItem write FOnCharToItem;
- property OnClickHeader : THeaderClickEvent
- read FOnClickHeader write FOnClickHeader;
- property OnDrawItem : TDrawItemEvent
- read FOnDrawItem write FOnDrawItem;
- property OnGetItem : TGetItemEvent
- read FOnGetItem write FOnGetItem;
- property OnGetItemColor : TGetItemColorEvent
- read FOnGetItemColor write FOnGetItemColor;
- property OnGetItemStatus : TGetItemStatusEvent
- read FOnGetItemStatus write FOnGetItemStatus;
- property OnIsSelected : TIsSelectedEvent
- read FOnIsSelected write FOnIsSelected;
- property OnSelect : TSelectEvent
- read FOnSelect write FOnSelect;
- property OnTopIndexChanged : TTopIndexChanged
- read FOnTopIndexChanged write FOnTopIndexChanged;
- property OnUserCommand : TUserCommandEvent
- read FOnUserCommand write FOnUserCommand;
-
- public
-
- {.Z+}
- constructor Create(AOwner : TComponent);
- override;
- destructor Destroy;
- override;
- {.Z-}
-
- procedure BeginUpdate; virtual;
- {-user is updating the list items--don't paint}
- procedure CenterCurrentLine;
- {- center the currently selected line (if any) on screen}
- procedure CenterLine(Index : Integer);
- {- center the specified line (if any) vertically on screen}
- procedure DeselectAll;
- {-deselect all items}
- procedure DrawItem(Index : LongInt);
- {-invalidate and update the area for this item}
- procedure EndUpdate; virtual;
- {-user is done updating the list items--force repaint}
- procedure InsertItemsAt(Items : LongInt; Index : LongInt);
- {-increase NumItems with Items amount while scrolling window down from Index}
- procedure DeleteItemsAt(Items : LongInt; Index : LongInt);
- {-decrease NumItems with Items amount while scrolling window up from Index}
- procedure InvalidateItem(Index : LongInt);
- {-invalidate the area for this item}
- function ItemAtPos(Pos : TPoint; Existing : Boolean) : LongInt;
- {-return the index of the cell that contains the point Pos}
- procedure Scroll(HDelta, VDelta : Integer);
- {-scroll the list by the give delta amount}
- procedure SelectAll;
- {-select all items}
- procedure SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
- override;
- procedure SetTabStops(const Tabs : array of Integer);
- {-set tab stop positions}
-
- {public properties}
- property Canvas;
-
- property ItemIndex : LongInt
- read FItemIndex write SetItemIndex;
- property FillColor : TColor read FFillColor write FFillColor;
- property SmoothScroll : Boolean
- read FSmoothScroll write FSmoothScroll default True;
- property TopIndex : LongInt
- read FTopIndex write SetTopIndex;
- end;
-
- TOvcVirtualListBox = class(TOvcCustomVirtualListBox)
- published
- property AutoRowHeight;
- property BorderStyle;
- property Columns;
- property Header;
- property HeaderColor;
- property IntegralHeight;
- property MultiSelect;
- property NumItems;
- property OwnerDraw;
- property ProtectColor;
- property RowHeight;
- property ScrollBars;
- property SelectColor;
- property ShowHeader;
- property SmoothScroll;
- property UseTabStops;
- property WheelDelta;
- property OnCharToItem;
- property OnClickHeader;
- property OnDrawItem;
- property OnGetItem;
- property OnGetItemColor;
- property OnGetItemStatus;
- property OnIsSelected;
- property OnSelect;
- property OnTopIndexChanged;
- property OnUserCommand;
-
- {inherited properties}
- {$IFDEF VERSION4}
- property Anchors;
- property Constraints;
- property DragKind;
- {$ENDIF}
- property Align;
- property Color;
- property Controller;
- property Ctl3D;
- property DragCursor;
- property DragMode;
- property Enabled;
- property Font;
- property ParentColor default vlDefParentColor;
-{$IFNDEF LCL}
- property ParentCtl3D default vlDefParentCtl3D;
-{$ENDIF}
- property ParentFont default vlDefParentFont;
- property ParentShowHint;
- property PopupMenu;
- property ShowHint;
- property TabOrder;
- property TabStop default vlDefTabStop;
- property Visible;
-
- {inherited events}
- property AfterEnter;
- property AfterExit;
- property OnClick;
- property OnDblClick;
- property OnDragDrop;
- property OnDragOver;
- property OnEndDrag;
- property OnEnter;
- property OnExit;
- property OnKeyDown;
- property OnKeyPress;
- property OnKeyUp;
- property OnMouseDown;
- property OnMouseMove;
- property OnMouseUp;
- property OnStartDrag;
- end;
-
-
-implementation
-
-{const
- vlbWheelDelta = 3;} {changed to property}
-
-{*** TOvcVirtualListBox ***}
-
-procedure TOvcCustomVirtualListBox.BeginUpdate;
- {-user is updating the list items--don't paint}
-begin
- inc(lUpdating);
-end;
-
-procedure TOvcCustomVirtualListBox.CenterCurrentLine;
-{- center the currently selected line (if any) on screen}
-begin
- if ItemIndex <> -1 then
- TopIndex := ItemIndex - (lRows div 2);
-end;
-
-procedure TOvcCustomVirtualListBox.CenterLine(Index : Integer);
-begin
- if Index <> -1 then
- TopIndex := Index - (lRows div 2);
-end;
-
-procedure TOvcCustomVirtualListBox.ChangeScale(M, D : Integer);
-begin
- inherited ChangeScale(M, D);
-
- if M <> D then begin
- {scale row height}
- FRowHeight := MulDiv(FRowHeight, M, D);
-
- vlbCalcFontFields;
- vlbAdjustIntegralHeight;
- vlbCalcFontFields;
- vlbInitScrollInfo;
- Refresh;
- end;
-end;
-
-{$IFNDEF LCL}
-procedure TOvcCustomVirtualListBox.CMCtl3DChanged(var Message: TMessage);
-begin
- if (csLoading in ComponentState) or not HandleAllocated then
- Exit;
-
- if NewStyleControls and (FBorderStyle = bsSingle) then
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
-
- inherited;
-end;
-{$ENDIF}
-
-procedure TOvcCustomVirtualListBox.CMFontChanged(var Message: TMessage);
-begin
- inherited;
-
- if (csLoading in ComponentState) then
- Exit;
-
- if not HandleAllocated then
- Exit;
-
- {reset internal size variables}
- if FIntegralHeight then begin
- vlbCalcFontFields;
- vlbAdjustIntegralHeight;
- end;
-
- vlbCalcFontFields;
- vlbInitScrollInfo;
-end;
-
-constructor TOvcCustomVirtualListBox.Create(AOwner : TComponent);
-begin
- inherited Create(AOwner);
-
- FillColor := Color;
- FSmoothScroll := True;
-
- if NewStyleControls then
- ControlStyle := ControlStyle + [csClickEvents, csCaptureMouse, csOpaque]
- else
- ControlStyle := ControlStyle + [csClickEvents, csCaptureMouse, csOpaque, csFramed];
-
- {set default values for inherited persistent properties}
- Align := vlDefAlign;
- Color := vlDefColor;
- Ctl3D := vlDefCtl3D;
- Height := vlDefHeight;
- ParentColor := vlDefParentColor;
-{$IFNDEF LCL}
- ParentCtl3D := vlDefParentCtl3D;
-{$ENDIF}
- ParentFont := vlDefParentFont;
- TabStop := vlDefTabStop;
- Width := vlDefWidth;
-
- {set default values for new persistent properties}
- FAutoRowHeight := vlDefAutoRowHeight;
- FBorderStyle := vlDefBorderStyle;
- FColumns := vlDefColumns;
- FHeader := '';
- FIntegralHeight := vlDefIntegralHeight;
- FItemIndex := vlDefItemIndex;
- FMultiSelect := vlDefMultiSelect;
- FNumItems := vlDefNumItems;
- FOwnerDraw := vlDefOwnerDraw;
- FRowHeight := vlDefRowHeight;
- FScrollBars := vlDefScrollBars;
- FShowHeader := vlDefShowHeader;
- FTopIndex := vlDefTopIndex;
- FUseTabStops := vlDefUseTabStops;
-
- {set defaults for internal variables}
- lHDelta := 0;
- lHaveHS := False;
- lHaveVS := False;
-
- lAnchor := 0;
- lFocusedIndex := 0; {-1;}
-
- lNumTabStops := 0;
- FillChar(lTabs, SizeOf(lTabs), #0);
-
- {create and initialize color objects}
- FHeaderColor := TOvcColors.Create(vlDefHeaderText, vlDefHeaderBack);
- FHeaderColor.OnColorChange := vlbColorChanged;
- FProtectColor := TOvcColors.Create(vlDefProtectText, vlDefProtectBack);
- FProtectColor.OnColorChange := vlbColorChanged;
- FSelectColor := TOvcColors.Create(vlDefSelectText, vlDefSelectBack);
- FSelectColor.OnColorChange := vlbColorChanged;
- FWheelDelta := 3;
-end;
-
-procedure TOvcCustomVirtualListBox.CreateParams(var Params: TCreateParams);
-begin
- inherited CreateParams(Params);
-
- with Params do
- Style := Style or DWord(ScrollBarStyles[FScrollBars])
- or DWord(BorderStyles[FBorderStyle]);
- if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then begin
- Params.Style := Params.Style and not WS_BORDER;
- Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
- end;
-
-{$IFDEF LCL}
- if not (csDesigning in ComponentState) then
- inherited SetBorderStyle(FBorderStyle); //Crashes IDE for some reason
-{$ENDIF}
-end;
-
-procedure TOvcCustomVirtualListBox.CreateWnd;
-begin
- inherited CreateWnd;
-
- {do we have scroll bars}
- lHaveVS := FScrollBars in [ssVertical, ssBoth];
- lHaveHS := FScrollBars in [ssHorizontal, ssBoth];
- lHighIndex := Pred(FNumItems);
-
- lFocusedIndex := 0; {-1;}
-
- {determine the height of one row and number of rows}
- vlbCalcFontFields;
- vlbAdjustIntegralHeight;
-
- {setup scroll bar info}
- vlbInitScrollInfo;
-end;
-
-function TOvcCustomVirtualListBox.DoOnCharToItem(Ch : AnsiChar) : LongInt;
-begin
- Result := FItemIndex;
- if Assigned(FOnCharToItem) then
- FOnCharToItem(Self, Ch, Result);
-end;
-
-procedure TOvcCustomVirtualListBox.DoOnClickHeader(Point : TPoint);
-begin
- if Assigned(FOnClickHeader) then
- FOnClickHeader(Self, Point);
-end;
-
-procedure TOvcCustomVirtualListBox.DoOnDrawItem(Index : LongInt; Rect : TRect;
- const S : string);
-begin
- if Assigned(FOnDrawItem) then
- FOnDrawItem(Self, Index, Rect, S);
-end;
-
-function TOvcCustomVirtualListBox.DoOnGetItem(Index : LongInt) : PAnsiChar;
- {-returns the string representing Nth item}
-var
- S : string;
-begin
- if Assigned(FOnGetItem) {$IFDEF LCL} and not (csDesigning in ComponentState) {$ENDIF} then begin
- S := '';
- FOnGetItem(Self, Index, S);
- StrPCopy(lString, S);
- Result := @lString[0];
- end else if csDesigning in ComponentState then begin
- StrPCopy(lString, Format(GetOrphStr(SCSampleListItem), [Index]));
- Result := @lString[0];
- end else
- Result := StrPCopy(lString, Format(GetOrphStr(SCGotItemWarning), [Index]));
-end;
-
-procedure TOvcCustomVirtualListBox.DoOnGetItemColor(Index : LongInt; var FG, BG : TColor);
-begin
- if Assigned(FOnGetItemColor) then
- FOnGetItemColor(Self, Index, FG, BG);
-end;
-
-function TOvcCustomVirtualListBox.DoOnGetItemStatus(Index : LongInt) : Boolean;
-begin
- Result := False;
- if Assigned(FOnGetItemStatus) then
- FOnGetItemStatus(Self, Index, Result);
-end;
-
-function TOvcCustomVirtualListBox.DoOnIsSelected(Index : LongInt) : Boolean;
- {-returns the selected status for the "Index" item}
-begin
- if csDesigning in ComponentState then
- Result := Index = 0
- else begin
- Result := (Index = FItemIndex);
- if FMultiSelect then begin
- if Assigned(FOnIsSelected) then
- FOnIsSelected(Self, Index, Result)
- else
- raise EOnIsSelectedNotAssigned.Create;
- end;
- end;
-end;
-
-procedure TOvcCustomVirtualListBox.DoOnMouseWheel(Shift : TShiftState; Delta, XPos, YPos : SmallInt);
-var
- I : Integer;
-begin
- inherited DoOnMouseWheel(Shift, Delta, XPos, YPos);
-
- if Delta < 0 then begin
- for I := 1 to {vlb}WheelDelta do
- Perform(WM_VSCROLL, MAKELONG(SB_LINEDOWN, 0), 0);
- end else if Delta > 0 then begin
- for I := 1 to {vlb}WheelDelta do
- Perform(WM_VSCROLL, MAKELONG(SB_LINEUP, 0), 0);
- end;
-end;
-
-procedure TOvcCustomVirtualListBox.DoOnSelect(Index : LongInt; Selected : Boolean);
- {-notify of selection change}
-begin
- if csDesigning in ComponentState then
- Exit;
-
- if FMultiSelect then begin
- if Assigned(FOnSelect) then begin
- {select if not protected-deselect always}
- if (not Selected) or (not DoOnGetItemStatus(Index)) then
- FOnSelect(Self, Index, Selected);
- end else
- raise EOnSelectNotAssigned.Create;
- end;
-end;
-
-procedure TOvcCustomVirtualListBox.DoOnTopIndexChanged(NewTopIndex : LongInt);
- {-call the OnTopIndexChanged event, if assigned}
-begin
- if Assigned(FOnTopIndexChanged) then
- FOnTopIndexChanged(Self, NewTopIndex);
-end;
-
-procedure TOvcCustomVirtualListBox.DoOnUserCommand(Command : Word);
- {-perform notification of a user command}
-begin
- if Assigned(FOnUserCommand) then
- FOnUserCommand(Self, Command);
-end;
-
-procedure TOvcCustomVirtualListBox.DeselectAll;
- {-deselect all items}
-begin
- vlbSetAllItemsPrim(False {deselect});
-end;
-
-procedure TOvcCustomVirtualListBox.DrawItem(Index : LongInt);
- {-invalidate and update the area for this item}
-begin
- InvalidateItem(Index);
- Update;
-end;
-
-destructor TOvcCustomVirtualListBox.Destroy;
-begin
- {if lUpdating <> 0 then debug code}
- {raise Exception.Create('Mismatched BeginUpdate/EndUpdate');}
- FHeaderColor.Free;
- FProtectColor.Free;
- FSelectColor.Free;
-
- inherited Destroy;
-end;
-
-procedure TOvcCustomVirtualListBox.EndUpdate;
- {-user is done updating the list items--force repaint}
-begin
- dec(lUpdating);
- if lUpdating < 0 then
- raise Exception.Create('Mismatched BeginUpdate/EndUpdate');
- if lUpdating = 0 then
- Invalidate;
-end;
-
-function ScrollCanvas(Canvas : TCanvas; R : TRect; EastWest : Boolean; Distance : Integer;
- Smooth : Boolean) : TRect;
-var
- UpdRect : TRect;
- NextStep,StepSize : Integer;
- {OldColor : TColor;}
-begin
- if Distance = 0 then begin
- Result := Rect(0,0,0,0);
- exit;
- end;
- if Smooth then
- StepSize := MaxI((Abs(Distance) div 4), MinI(2, Abs(Distance)))
- else
- StepSize := Abs(Distance);
- Result := R;
- if EastWest then
- if abs(Distance) < (Result.Right-Result.Left+1) then
- if Distance < 0 then
- Result.Left := Result.Right + Distance
- else
- Result.Right := Result.Left + Distance
- else
- else
- if abs(Distance) < (Result.Bottom-Result.Top+1) then
- if Distance < 0 then
- Result.Top := Result.Bottom + Distance
- else
- Result.Bottom := Result.Top + Distance;
- repeat
- if Distance > 0 then
- if Distance > StepSize then
- NextStep := StepSize
- else
- NextStep := Distance
- else
- if Distance < -StepSize then
- NextStep := -StepSize
- else
- NextStep := Distance;
- if EastWest then
- ScrollDC(Canvas.Handle,NextStep,0,R,R,0,@UpdRect)
- else
- ScrollDC(Canvas.Handle,0,NextStep,R,R,0,@UpdRect);
- UnionRect(Result, UpdRect, Result);
- dec(Distance,NextStep);
- until Distance = 0;
-end;
-
-procedure TOvcCustomVirtualListBox.InsertItemsAt(Items : LongInt; Index : LongInt);
- {-increase NumItems with Items amount while scrolling window down from Index}
-var
- CR : TRect;
- AbsBottom : Integer;
- OldItemIndex : Integer;
-begin
- OldItemIndex := ItemIndex;
- ItemIndex := -1;
- InternalSetNumItems(NumItems + Items,False,False);
- if (lUpdating = 0) then
- if (Index-FTopIndex) < lRows then begin
- AbsBottom := (ClientRect.Bottom div FRowHeight) * FRowHeight;
- if Index >= FTopIndex then begin
- CR := Rect(0, (Index-FTopIndex+Ord(FShowHeader))*FRowHeight, ClientWidth, AbsBottom);
- {Make sure the canvas is updated,
- because we will be validating the scrolled portion.}
- CR := ScrollCanvas(Canvas, CR, False, Items*FRowHeight, FSmoothScroll);
- InvalidateRect(Handle,@CR,False);
- end else begin
- CR := Rect(0, (Ord(FShowHeader))*FRowHeight, ClientWidth, AbsBottom);
- Update;
- {Make sure the canvas is updated,
- because we will be validating the scrolled portion.}
- CR := ScrollCanvas(Canvas, CR, False, Items*FRowHeight, FSmoothScroll);
- InvalidateRect(Handle, @CR, False);
- Update;
- end;
- end;
- if OldItemIndex >= Index then
- inc(OldItemIndex,Items);
- ItemIndex := OldItemIndex;
-end;
-
-procedure TOvcCustomVirtualListBox.DeleteItemsAt(Items : LongInt; Index : LongInt);
- {-decrease NumItems with Items amount while scrolling window up from Index}
-var
- CR : TRect;
- AbsBottom,OldItemIndex : Integer;
-begin
- OldItemIndex := ItemIndex;
- ItemIndex := -1;
- if lUpdating = 0 then
- Update;
- InternalSetNumItems(NumItems - Items,False,False);
- if lUpdating = 0 then begin
- if (Index-FTopIndex) < lRows then begin
- AbsBottom := (ClientRect.Bottom div FRowHeight) * FRowHeight;
- if Index >= FTopIndex then begin
- CR := Rect(0, (Index-FTopIndex+Ord(FShowHeader))*FRowHeight, ClientWidth, AbsBottom);
- CR := ScrollCanvas(Canvas, CR, False, -Items*FRowHeight, FSmoothScroll);
- InvalidateRect(Handle,@CR,False);
- Update;
- end else begin
- CR := Rect(0, (Ord(FShowHeader))*FRowHeight, ClientWidth, AbsBottom);
- CR := ScrollCanvas(Canvas, CR, False, -Items*FRowHeight, FSmoothScroll);
- InvalidateRect(Handle,@CR,False);
- Update;
- end;
- end;
- end;
- if OldItemIndex >= Index+Items then
- dec(OldItemIndex,Items)
- else
- if OldItemIndex >= Index then
- OldItemIndex := -1;
- ItemIndex := OldItemIndex;
- if TopIndex + lRows > FNumItems then
- ForceTopIndex(FNumItems - 1, True)
- else
- ForceTopIndex(TopIndex, False);
-end;
-
-procedure TOvcCustomVirtualListBox.InvalidateItem(Index : LongInt);
- {-invalidate the area for this item}
-var
- CR : TRect;
-begin
- if (Index >= FTopIndex) and (Index-FTopIndex < lRows) then begin {visible?}
- CR := Rect(0, (Index-FTopIndex+Ord(FShowHeader))*FRowHeight, ClientWidth, 0);
- CR.Bottom := CR.Top+FRowHeight;
- InvalidateRect(Handle, @CR, True);
- end;
-end;
-
-function TOvcCustomVirtualListBox.ItemAtPos(Pos : TPoint;
- Existing : Boolean) : LongInt;
- {-return the index of the cell that contains the point Pos}
-begin
- if (Pos.Y < Ord(FShowHeader)*FRowHeight) then begin
- if Existing then
- Result := -1
- else
- Result := 0;
- end else if (Pos.Y >= ClientHeight) then begin
- if Existing then
- Result := -1
- else
- Result := lHighIndex;
- end else begin {convert to an index}
- Result := FTopIndex-Ord(FShowHeader)+(Pos.Y div FRowHeight);
- {test for click below last item (IntegralHeight not set)}
- if ClientHeight mod FRowHeight > 0 then
- if Result > FTopIndex+lRows-1 then
- Result := FTopIndex+lRows-1;
- if Result > NumItems then
- if Existing then
- Result := -1
- else
- Result := NumItems;
- end;
-end;
-
-procedure TOvcCustomVirtualListBox.LBGetCaretIndex(var Msg : TMessage);
-begin
- Msg.Result := lFocusedIndex;
-end;
-
-procedure TOvcCustomVirtualListBox.LBGetCount(var Msg : TMessage);
-begin
- Msg.Result := FNumItems;
-end;
-
-procedure TOvcCustomVirtualListBox.LBGetCurSel(var Msg : TMessage);
-begin
- Msg.Result := FItemIndex;
-end;
-
-procedure TOvcCustomVirtualListBox.LBGetItemHeight(var Msg : TMessage);
-begin
- Msg.Result := FRowHeight;
-end;
-
-procedure TOvcCustomVirtualListBox.LBGetItemRect(var Msg : TMessage);
-begin
- PRect(Msg.LParam)^ :=
- Rect(0, (Msg.WParam - FTopIndex) * FRowHeight,
- ClientWidth, (Msg.WParam - FTopIndex) * FRowHeight + FRowHeight);
-end;
-
-procedure TOvcCustomVirtualListBox.LBGetSel(var Msg : TMessage);
-begin
- if (Msg.wParam >= 0) and (Msg.wParam <= lHighIndex) then
- Msg.Result := Ord(DoOnIsSelected(Msg.wParam))
- else
- Msg.Result := LB_ERR;
-end;
-
-procedure TOvcCustomVirtualListBox.LBGetTopIndex(var Msg : TMessage);
-begin
- Msg.Result := FTopIndex;
-end;
-
-procedure TOvcCustomVirtualListBox.LBResetContent(var Msg : TMessage);
-begin
- NumItems := 0;
-end;
-
-procedure TOvcCustomVirtualListBox.LBSelItemRange(var Msg : TMessage);
-begin
- if FMultiSelect and (LoWord(Msg.WParam) <= lHighIndex) //64
- and (HiWord(Msg.WParam) <= lHighIndex) then begin //64
- vlbSelectRangePrim(LoWord(Msg.LParam), HiWord(Msg.LParam), Msg.wParam > 0); //64
- Msg.Result := 0;
- end else
- Msg.Result := LB_ERR;
-end;
-
-procedure TOvcCustomVirtualListBox.LBSetCurSel(var Msg : TMessage);
-begin
- if FMultiSelect and (Msg.wParam >= -1) and (Msg.wParam <= lHighIndex) then begin
- SetItemIndex(Msg.wParam);
- if Msg.wParam = $FFFF then
- Msg.Result := LB_ERR
- else
- Msg.Result := 0;
- end else
- Msg.Result := LB_ERR;
-end;
-
-procedure TOvcCustomVirtualListBox.LBSetSel(var Msg : TMessage);
-begin
- if FMultiSelect and (Msg.lParam >= -1) and (Msg.lParam <= lHighIndex) then begin
- if Msg.lParam = -1 then
- vlbSetAllItemsPrim(Msg.wParam > 0)
- else begin
- DoOnSelect(Msg.lParam, Msg.wParam > 0);
- InvalidateItem(Msg.lParam);
- end;
- Msg.Result := 0;
- end else
- Msg.Result := LB_ERR;
-end;
-
-procedure TOvcCustomVirtualListBox.LBSetTabStops(var Msg : TMessage);
-type
- IA = TTabStopArray;
- IP = ^IA;
-var
- I : Integer;
-begin
- lNumTabStops := Msg.wParam;
- if lNumTabStops > vlbMaxTabStops then begin
- lNumTabStops := vlbMaxTabStops;
- Msg.Result := 0; {didn't set all tabs}
- end else
- Msg.Result := 1;
-
- for I := 0 to Pred(lNumTabStops) do
- lTabs[I] := IP(Msg.lParam)^[I] * lDlgUnits;
-end;
-
-procedure TOvcCustomVirtualListBox.LBSetTopIndex(var Msg : TMessage);
-begin
- if (Msg.wParam >= 0) and (Msg.wParam <= lHighIndex) then begin
- SetTopIndex(Msg.wParam);
- Msg.Result := 0;
- end else
- Msg.Result := LB_ERR;
-end;
-
-procedure TOvcCustomVirtualListBox.Paint;
-var
- I : Integer;
- ST : PAnsiChar;
- CR : TRect;
- IR : TRect;
- Clip : TRect;
- Last : Integer;
-
-{20070204 workaround for recent change to FPC that
- no longer permits nested procedure to have same
- name as other method in class.}
-{$IFNDEF FPC}
- procedure DrawItem(N : LongInt; Row : Integer);
-{$ELSE}
- procedure DrawItem2(N : LongInt; Row : Integer);
-{$ENDIF}
- {-Draw item N at Row}
- var
- S : PAnsiChar;
- FGColor : TColor;
- BGColor : TColor;
- DX : Integer;
- begin
- {get bounding rectangle}
- CR.Top := Pred(Row)*FRowHeight;
- CR.Bottom := CR.Top+FRowHeight;
-
- {do we have anything to paint}
- if Bool(IntersectRect(IR, Clip, CR)) then begin
-
- {get colors}
- if DoOnGetItemStatus(N) then begin
- BGColor := FProtectColor.BackColor;
- FGColor := FProtectColor.TextColor;
- end else if DoOnIsSelected(N) and (Row <= lRows+Ord(FShowHeader)) then begin
- BGColor := FSelectColor.BackColor;
- FGColor := FSelectColor.TextColor;
- end else begin
- BGColor := Color;
- FGColor := Font.Color;
- DoOnGetItemColor(N, FGColor, BGColor);
- end;
-
- {assign colors to our canvas}
- Canvas.Brush.Color := BGColor;
- Canvas.Font.Color := FGColor;
-
- {clear the line}
- Canvas.FillRect(CR);
-
- {get the string}
- if N <= lHighIndex then begin
- ST := DoOnGetItem(N);
- if lHDelta >= LongInt(StrLen(ST)) then
- S := nil
- else
- S := @ST[lHDelta];
- end else
- S := nil;
-
- {draw the string}
- if S <> nil then begin
- if FOwnerDraw then
- DoOnDrawItem(N, CR, StrPas(S))
- else if FUseTabStops then begin
- DX := 0;
- if lHDelta > 0 then begin
- {measure portion of string to the left of the window}
- DX := LOWORD(GetTabbedTextExtent(Canvas.Handle,
- ST, lHDelta, lNumTabStops, lTabs));
- end;
- TabbedTextOut(Canvas.Handle, CR.Left+2, CR.Top,
- S, StrLen(S), lNumTabStops, lTabs, -DX)
- end else
- ExtTextOut(Canvas.Handle, CR.Left+2, CR.Top,
- ETO_CLIPPED + ETO_OPAQUE, @CR, S, StrLen(S), nil);
- end;
- end;
- end;
-
-begin
- {exit if the updating flag is set}
- if lUpdating > 0 then
- Exit;
-
- Canvas.Font := Font;
-
- {we will erase our own background}
- SetBkMode(Canvas.Handle, TRANSPARENT);
-
- {get the client rectangle}
- CR := ClientRect;
-
- {get the clipping region}
-{$IFNDEF LCL}
- GetClipBox(Canvas.Handle, Clip);
-{$ELSE}
- GetClipBox(Canvas.Handle, @Clip);
-{$ENDIF}
-
- {do we have a header?}
- if FShowHeader then begin
- if Bool(IntersectRect(IR, Clip, Rect(CR.Left, CR.Top, CR.Right, FRowHeight))) then
- vlbDrawHeader;
- end;
-
- {calculate last visible item}
- Last := lRows;
- if Last > NumItems then
- Last := NumItems;
-
- {display each row}
- for I := 1 to Last do
-{$IFNDEF FPC}
- DrawItem(FTopIndex+Pred(I), I+Ord(FShowHeader));
-{$ELSE}
- DrawItem2(FTopIndex+Pred(I), I+Ord(FShowHeader));
-{$ENDIF}
-
- {paint any blank area below last item}
- CR.Top := FRowHeight * (Last+Ord(FShowHeader));
- if CR.Top < ClientHeight then begin
- CR.Bottom := ClientHeight;
- {clear the area}
- Canvas.Brush.Color := Color;
- Canvas.FillRect(CR);
- end;
-
- Canvas.Brush.Color := Color;
- Canvas.Font.Color := Font.Color;
- if Canvas.Handle > 0 then {force colors to be selected into canvas};
- {conditionally, draw the focus rect}
- if lFocusedIndex <> -1 then
- vlbDrawFocusRect(lFocusedIndex);
-end;
-
-procedure TOvcCustomVirtualListBox.DragCanceled;
-var
- M: TWMMouse;
- P, MousePos: TPoint;
-begin
- with M do
- begin
- Msg := WM_LBUTTONDOWN;
- GetCursorPos(MousePos);
- P := ScreenToClient(MousePos);
- Pos := PointToSmallPoint(P);
- Keys := 0;
- Result := 0;
- end;
- DefaultHandler(M);
- M.Msg := WM_LBUTTONUP;
- DefaultHandler(M);
-end;
-
-procedure TOvcCustomVirtualListBox.WndProc(var Message: TMessage);
-begin
- {for auto drag mode, let listbox handle itself, instead of TControl}
- if not (csDesigning in ComponentState) and ((Message.Msg = WM_LBUTTONDOWN) or
- (Message.Msg = WM_LBUTTONDBLCLK)) and not Dragging then
- begin
- if DragMode = dmAutomatic then
- begin
- if IsControlMouseMsg(TWMMouse(Message)) then
- Exit;
- ControlState := ControlState + [csLButtonDown];
- Dispatch(Message); {overrides TControl's BeginDrag}
- Exit;
- end;
- end;
- inherited WndProc(Message);
-end;
-
-procedure TOvcCustomVirtualListBox.Scroll(HDelta, VDelta : Integer);
- {-scroll the list by the give delta amount}
-begin
- if HDelta <> 0 then
- vlbHScrollPrim(HDelta);
-
- if VDelta <> 0 then
- vlbVScrollPrim(VDelta);
-end;
-
-procedure TOvcCustomVirtualListBox.SelectAll;
- {-select all items}
-begin
- vlbSetAllItemsPrim(True {select});
-end;
-
-procedure TOvcCustomVirtualListBox.SetAutoRowHeight(Value : Boolean);
- {-set use of auto row height calculations}
-begin
- if Value <> FAutoRowHeight then begin
- FAutoRowHeight := Value;
- if FAutoRowHeight then begin
- vlbCalcFontFields;
- vlbAdjustIntegralHeight;
- vlbCalcFontFields;
- vlbInitScrollInfo;
- Refresh;
- end;
- end;
-end;
-
-procedure TOvcCustomVirtualListBox.SetBorderStyle(const Value : TBorderStyle);
- {-set the style used for the border}
-begin
- if Value <> FBorderStyle then begin
- FBorderStyle := Value;
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
-end;
-
-procedure TOvcCustomVirtualListBox.SetBounds(ALeft, ATop, AWidth, AHeight : Integer);
-begin
- if not (Align in [alNone, alTop, alBottom]) then
- FIntegralHeight := False;
-
- inherited SetBounds(ALeft, ATop, AWidth, AHeight);
-end;
-
-procedure TOvcCustomVirtualListBox.SetHeader(const Value : string);
- {-set the header at top of list box}
-begin
- if Value <> FHeader then begin
- FHeader := Value;
- {toggle show header flag as appropriate}
- if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
- ShowHeader := FHeader <> '';
- Repaint;
- end;
-end;
-
-procedure TOvcCustomVirtualListBox.SetIntegralHeight(Value : Boolean);
- {-set use of integral font height adjustment}
-begin
- if (Value <> FIntegralHeight) and (Align in [alNone, alTop, alBottom]) then begin
- FIntegralHeight := Value;
- if FIntegralHeight then begin
- vlbCalcFontFields;
- vlbAdjustIntegralHeight;
- vlbCalcFontFields;
- vlbInitScrollInfo;
- end;
- end;
-end;
-
-procedure TOvcCustomVirtualListBox.SetItemIndex(Index : LongInt);
- {-change the currently selected item}
-begin
- {verify valid index}
- if Index > lHighIndex then
- if lHighIndex < 0 then
- Index := -1
- else
- Index := lHighIndex;
-
- {do we need to do any more}
- if (Index = FItemIndex) then
- Exit;
-
- {erase current selection}
- InvalidateItem(FItemIndex);
-
- {if Index <> -1 then}
- DoOnSelect(FItemIndex, False);
-
- {set the newly selected item index}
- FItemIndex := Index;
- {lFocusedIndex := -1;}
- Update;
-
- if csDesigning in ComponentState then
- Exit;
-
- {vlbMakeItemVisible(Index);}
- if FItemIndex > -1 then begin
- vlbMakeItemVisible(Index);
- DoOnSelect(FItemIndex, True);
- end;
- if FItemIndex <> -1 then
- vlbSetFocusedIndex(FItemIndex)
- else
- vlbSetFocusedIndex(0);
- DrawItem(FItemIndex);
-
- {notify of an index change}
- if not MouseCapture then
- SimulatedClick;
-end;
-
-procedure TOvcCustomVirtualListBox.SimulatedClick;
-begin
- Click;
-end;
-
-function TOvcCustomVirtualListBox.IsValidIndex(Index : LongInt) : Boolean;
-begin
- Result := (Index >= 0) and (Index <= lHighIndex);
-end;
-
-procedure TOvcCustomVirtualListBox.SetMultiSelect(Value : Boolean);
- {-set ability to select multiple items}
-begin
- if (csDesigning in ComponentState) or (csLoading in ComponentState) then
- if Value <> FMultiSelect then
- FMultiSelect := Value;
-end;
-
-procedure TOvcCustomVirtualListBox.InternalSetNumItems(Value : LongInt; Paint, UpdateIndices : Boolean);
- {-set the number of items in the list box}
-var
- OldNumItems : LongInt;
-begin
- if Value <> FNumItems then begin
- if (Value < 0) then
-{$IFDEF MSWINDOWS}
- Value := MaxLongInt;
-{$ELSE}
- Value := vlDefNumItems;
-{$ENDIF}
-
- OldNumItems := FNumItems;
- {set new item index}
- FNumItems := Value;
-
- {reset high index}
- lHighIndex := Pred(FNumItems);
- {reset horizontal offset}
- lHDelta := 0;
-
- {reset selected item}
- if UpdateIndices then
- if not (csLoading in ComponentState) then begin
- if ItemIndex >= FNumItems then
- ItemIndex := -1;
- if TopIndex + lRows > FNumItems then
- ForceTopIndex(FNumItems - 1, True)
- else
- ForceTopIndex(TopIndex, False);
- end;
- if Paint and ((NumItems <= lRows) or (OldNumItems <= lRows)) then
- Repaint;
-
- vlbInitScrollInfo;
- end;
-end;
-
-procedure TOvcCustomVirtualListBox.SetNumItems(Value : LongInt);
- {-set the number of items in the list box}
-begin
- InternalSetNumItems(Value, True, True);
-end;
-
-procedure TOvcCustomVirtualListBox.SetRowHeight(Value : Integer);
- {-set height of cell row}
-begin
- if Value <> FRowHeight then begin
- FRowHeight := Value;
- if not (csLoading in ComponentState) then
- AutoRowHeight := False;
- vlbCalcFontFields;
- vlbAdjustIntegralHeight;
- vlbCalcFontFields;
- vlbInitScrollInfo;
- Refresh;
- end;
-end;
-
-procedure TOvcCustomVirtualListBox.SetScrollBars(const Value : TScrollStyle);
- {-set use of vertical and horizontal scroll bars}
-begin
- if Value <> FScrollBars then begin
- FScrollBars := Value;
- lHaveVS := (FScrollBars = ssVertical) or (FScrollBars = ssBoth);
- lHaveHS := (FScrollBars = ssHorizontal) or (FScrollBars = ssBoth);
-{$IFNDEF LCL}
- RecreateWnd;
-{$ELSE}
- MyMisc.RecreateWnd(Self);
-{$ENDIF}
- end;
-end;
-
-procedure TOvcCustomVirtualListBox.SetShowHeader(Value : Boolean);
- {-set show flag for the header}
-begin
- if Value <> FShowHeader then begin
- FShowHeader := Value;
- Refresh;
- end;
-end;
-
-procedure TOvcCustomVirtualListBox.SetTabStops(const Tabs : array of Integer);
- {-set tab stop positions}
-var
- I : Integer;
-begin
- HandleNeeded;
- lNumTabStops := High(Tabs)+1;
- if lNumTabStops > vlbMaxTabStops then
- lNumTabStops := vlbMaxTabStops;
- for I := 0 to Pred(lNumTabStops) do
- lTabs[I] := Tabs[I] * lDlgUnits;
-end;
-
-procedure TOvcCustomVirtualListBox.ForceTopIndex(Index : LongInt; ThumbTracking : Boolean);
- {-set the index of the first visible entry in the list}
-var
- DY : LongInt;
- SaveD : LongInt;
- ClipBox,
- TmpArea,
- ClipArea : TRect;
- Inv : TRect;
-begin
- if (Index >= 0) and (Index <= lHighIndex) then begin
- Update;
- SaveD := FTopIndex;
- {if we can't make the requested item the top one, at least show it}
- if Index + lRows -1 <= lHighIndex then
- FTopIndex := Index
- else
- FTopIndex := lHighIndex - lRows + 1;
-
- {check for valid index}
- if FTopIndex < 0 then
- FTopIndex := 0;
- if FTopIndex = SaveD then
- Exit;
- vlbSetVScrollPos;
- ClipArea := ClientRect;
- {adjust top of the clipping region to exclude the header, if any}
- if FShowHeader then with ClipArea do
- Top := Top + FRowHeight;
-
-{$IFNDEF LCL}
- if GetClipBox(Canvas.Handle, ClipBox) <> SIMPLEREGION then
-{$ELSE} //Something about code below doesn't work so just always InvalidateRect
- // for now as workaround. If bug is in ScrollCanvas, then InsertItemsAt
- // and DeleteItemsAt will probably also need a similar workaround.
- if GetClipBox(Canvas.Handle, @ClipBox) <> Region_Error then
-{$ENDIF}
- InvalidateRect(Handle, @ClipArea, True)
- else begin
- InterSectRect(ClipArea, ClipArea, ClipBox);
-
- TmpArea := ClipArea;
- TmpArea.Bottom := ClipArea.Bottom;
- {adjust bottom of the clipping region to an even number of rows}
- with ClipArea do
- Bottom := (Bottom div FRowHeight) * FRowHeight;
- TmpArea.Top := ClipArea.Bottom;
- {if ThumbTracking then
- InvalidateRect(Handle, @ClipArea, True)
- else} begin
- DY := (SaveD - FTopIndex);
- if Abs(DY) > lRows then
- DY := lRows;
- DY := DY * FRowHeight;
- Update;
- {Make sure the canvas is updated,
- because we will be validating the scrolled portion.}
- Inv := ScrollCanvas(Canvas, ClipArea, False, DY, (not ThumbTracking) and FSmoothScroll);
- InvalidateRect(Handle, @Inv, False);
- InvalidateRect(Handle, @TmpArea, False);
- if SaveD <> FTopIndex then begin
- DoOnTopIndexChanged(FTopIndex);
- SaveD := FTopIndex;
- end;
- Update;
- end;
- end;
- vlbSetFocusedIndex(FItemIndex);
-
- {notify that top index has changed}
- if SaveD <> FTopIndex then
- DoOnTopIndexChanged(FTopIndex);
- end;
-end;
-
-procedure TOvcCustomVirtualListBox.SetTopIndex(Index : LongInt);
- {-set the index of the first visible entry in the list}
-begin
- if csDesigning in ComponentState then
- Exit;
-
- if Index <> FTopIndex then
- ForceTopIndex(Index, False);
-end;
-
-procedure TOvcCustomVirtualListBox.vlbAdjustIntegralHeight;
-begin
- if (csDesigning in ComponentState) and
- not (csLoading in ComponentState) then
- if FIntegralHeight then
- if ClientHeight mod FRowHeight <> 0 then
- ClientHeight := (ClientHeight div FRowHeight) * FRowHeight;
-end;
-
-procedure TOvcCustomVirtualListBox.vlbCalcFontFields;
-var
- Alpha : string;
-begin
- if not HandleAllocated then
- Exit;
-
- Alpha := GetOrphStr(SCAlphaString);
-
- {set the canvas font}
- Canvas.Font := Self.Font;
-
- {determine the height of one row}
- if FAutoRowHeight and not (csLoading in ComponentState) then
- FRowHeight := Canvas.TextHeight(GetOrphStr(SCTallLowChars)) + lVMargin;
- lRows := (ClientHeight div FRowHeight)-Ord(FShowHeader);
- if lRows < 1 then
- lRows := 1;
-
- {calculate the base dialog unit for tab spacing}
- lDlgUnits := (Canvas.TextWidth(Alpha) div Length(Alpha)) div 4
-end;
-
-procedure TOvcCustomVirtualListBox.vlbClearAllItems;
- {-clear the highlight from all items}
-begin
- vlbSetAllItemsPrim(False);
-end;
-
-procedure TOvcCustomVirtualListBox.vlbClearSelRange(First, Last : LongInt);
- {-clear the selection for the given range of indexes}
-begin
- vlbSelectRangePrim(First, Last, False);
-end;
-
-procedure TOvcCustomVirtualListBox.vlbColorChanged(AColor: TObject);
- {-a color has changed, refresh display}
-begin
- Refresh;
-end;
-
-procedure TOvcCustomVirtualListBox.vlbDrawFocusRect(Index : LongInt);
- {-draw the focus rectangle}
-var
- CR : TRect;
-begin
- if Index < 0 then exit;
- if Focused then begin
- if (Index >= FTopIndex) and (Index-FTopIndex <= Pred(lRows)) then begin
- CR := ClientRect;
- CR.Top := (Index-FTopIndex+Ord(FShowHeader))*FRowHeight;
- CR.Bottom := CR.Top + FRowHeight;
- Canvas.DrawFocusRect(CR);
- end;
- end;
- lFocusedIndex := Index;
-end;
-
-procedure TOvcCustomVirtualListBox.vlbDragSelection(First, Last : LongInt);
- {-drag the selection}
-var
- I : LongInt;
- OutSide : Boolean;
-begin
-
- {set new active item}
- vlbNewActiveItem(Last);
-
- {remove selection from visible selected items not in range}
- for I := FTopIndex to FTopIndex+Pred(lRows) do begin
- if First <= Last then
- OutSide := (I < First) or (I > Last)
- else
- OutSide := (I < Last) or (I > First);
-
- if DoOnIsSelected(I) and OutSide then
- InvalidateItem(I);
-
- end;
-
- {deselect all items}
- DoOnSelect(-1, False);
-
- {select new range}
- vlbSetSelRange(First, Last);
- vlbSetFocusedIndex(Last);
- Update;
-end;
-
-procedure TOvcCustomVirtualListBox.vlbDrawHeader;
- {-draw the header and text}
-var
- R : TRect;
- Buf : array[0..255] of AnsiChar;
- S : PAnsiChar;
- DX : Integer;
-begin
- {get the printable area of the header text}
- StrPCopy(Buf, FHeader);
- if lHDelta >= LongInt(StrLen(Buf)) then
- S := ' ' {space to erase last character from header}
- else
- S := @Buf[lHDelta];
-
- Canvas.Font := Font;
- with Canvas do begin
- {draw header text}
- Brush.Color := FHeaderColor.BackColor;
- Font.Color := FHeaderColor.TextColor;
-
- R := Bounds(0, 0, Width, FRowHeight-1);
-
- {clear the line}
- Canvas.FillRect(R);
-
- if S <> nil then
- if FUseTabStops then begin
- DX := 0;
- if lHDelta > 0 then begin
- {measure portion of string to the left of the window}
- DX := LOWORD(GetTabbedTextExtent(Canvas.Handle, Buf, lHDelta,
- lNumTabStops, lTabs));
- end;
- TabbedTextOut(Canvas.Handle, 2, 0,
- S, StrLen(S), lNumTabStops, lTabs, -DX)
- end else
- ExtTextOut(Canvas.Handle, 2, 0, ETO_OPAQUE + ETO_CLIPPED,
- @R, S, StrLen(S), nil);
-
- {draw border line}
- Pen.Color := clBlack;
- PolyLine([Point(R.Left, R.Bottom), Point(R.Right, R.Bottom)]);
-
- {draw ctl3d highlight}
- if Ctl3D then begin
- Pen.Color := clBtnHighlight;
- PolyLine([Point(R.Left, R.Bottom-1),
- Point(R.Left, R.Top),
- Point(R.Right, R.Top)]);
- end;
- end;
-end;
-
-procedure TOvcCustomVirtualListBox.vlbExtendSelection(Index : LongInt);
- {-process Shift-LMouseBtn}
-begin
- {verify valid index}
- if Index < 0 then
- Index := 0
- else if Index > lHighIndex then
- Index := lHighIndex;
-
- {clear current selections}
- vlbClearAllItems;
-
- {set selection for all items from the active one to the currently selected item}
- vlbSetSelRange(lAnchor, Index);
-
- {set new active item}
- FItemIndex := Index;
- vlbSetFocusedIndex(FItemIndex);
- Update;
-end;
-
-procedure TOvcCustomVirtualListBox.vlbHScrollPrim(Delta : Integer);
-var
- SaveD : LongInt;
-begin
- SaveD := lHDelta;
- if Delta < 0 then
- if Delta > lHDelta then
- lHDelta := 0
- else
- Inc(lHDelta, Delta)
- else
- if LongInt(lHDelta)+Delta > LongInt(FColumns) then
- lHDelta := FColumns
- else
- Inc(lHDelta, Delta);
-
- if lhDelta < 0 then
- lhDelta := 0;
-
- if lHDelta <> SaveD then begin
- vlbSetHScrollPos;
- Refresh;
- end;
-end;
-
-procedure TOvcCustomVirtualListBox.vlbInitScrollInfo;
- {-setup scroll bar range and initial position}
-begin
- if not HandleAllocated then
- Exit;
-
- {initialize scroll bars, if any}
- vlbSetVScrollRange;
- vlbSetVScrollPos;
- vlbSetHScrollRange;
- vlbSetHScrollPos;
-end;
-
-procedure TOvcCustomVirtualListBox.vlbMakeItemVisible(Index : LongInt);
- {-make sure the item is visible}
-begin
- if Index < FTopIndex then
- TopIndex := Index
- else if Index+LongInt($80000000) > (FTopIndex+Pred(lRows))+LongInt($80000000) then begin
- TopIndex := Index-Pred(lRows);
- if FTopIndex < 0 then
- TopIndex := 0;
- end;
-end;
-
-procedure TOvcCustomVirtualListBox.vlbNewActiveItem(Index : LongInt);
- {-set the currently selected item}
-begin
- {verify valid index}
- if Index < 0 then
- Index := 0
- else if Index > lHighIndex then
- Index := lHighIndex;
-
- {set the newly selected item index}
- FItemIndex := Index;
- vlbMakeItemVisible(Index);
- DoOnSelect(Index, True);
- InvalidateItem(Index);
-end;
-
-function TOvcCustomVirtualListBox.vlbScaleDown(N : LongInt) : Integer;
-begin
- Result := N div lDivisor;
-end;
-
-function TOvcCustomVirtualListBox.vlbScaleUp(N : LongInt) : LongInt;
-begin
- Result := N * lDivisor;
-end;
-
-procedure TOvcCustomVirtualListBox.vlbSelectRangePrim(First, Last : LongInt; Select : Boolean);
- {-change the selection for the given range of indexes}
-var
- I : LongInt;
-begin
- if First <= Last then begin
- for I := First to Last do begin
- DoOnSelect(I, Select);
- InvalidateItem(I);
- end;
- end else begin
- for I := First downto Last do begin
- DoOnSelect(I, Select);
- InvalidateItem(I);
- end;
- end;
-end;
-
-procedure TOvcCustomVirtualListBox.vlbSetAllItemsPrim(Select : Boolean);
- {-primitive routine thats acts on all items}
-var
- I : LongInt;
- LastIndex : LongInt;
-begin
- {determine highest index to test}
- LastIndex := FTopIndex+Pred(lRows);
- if LastIndex > Pred(FNumItems) then
- LastIndex := Pred(FNumItems);
-
- {invalidate items that require repainting}
- for I := FTopIndex to LastIndex do
- if DoOnIsSelected(I) <> Select then
- InvalidateItem(I);
-
- {select or deselect all items}
- DoOnSelect(-1, Select);
-end;
-
-procedure TOvcCustomVirtualListBox.vlbSetFocusedIndex(Index : LongInt);
- {-set focus index to this item. invalidate previous}
-begin
- if Index <> lFocusedIndex then begin
- InvalidateItem(lFocusedIndex);
-
- lFocusedIndex := Index;
- InvalidateItem(lFocusedIndex);
- end;
-end;
-
-{ rewritten - see below
-procedure TOvcCustomVirtualListBox.vlbSetHScrollPos;
-begin
- if lHaveHS then
- SetScrollPos(Handle, SB_HORZ, lHDelta, True);
-end;
-}
-
-{ rewritten}
-procedure TOvcCustomVirtualListBox.vlbSetHScrollPos;
-var
- SI : TScrollInfo;
-begin
- if lHaveHS and HandleAllocated then begin
- with SI do begin
- cbSize := SizeOf(SI);
- fMask := SIF_RANGE or SIF_PAGE or SIF_POS;
- nMin := 0;
- nMax := FColumns;
- nPage := FColumns div 2;
- nPos := lhDelta;
- nTrackPos := nPos;
- end;
- SetScrollInfo(Handle, SB_HORZ, SI, True);
- end;
-end;
-
-{ rewritten - see below
-procedure TOvcCustomVirtualListBox.vlbSetHScrollRange;
-begin
- if lHaveHS then
- SetScrollRange(Handle, SB_HORZ, 0, FColumns, False);
-end;
-}
-
-{ rewritten}
-procedure TOvcCustomVirtualListBox.vlbSetHScrollRange;
-{var
- SI : TScrollInfo;}
-begin
- vlbSetHScrollPos;
- (*
- if lHaveHS then
- begin
- with SI do
- begin
- fMask := {SIF_PAGE + }SIF_RANGE;
- nMin := 1;
- nMax := FColumns - ClientWidth;
- //nPage := nMax div 10;
- cbSize := SizeOf(SI);
- end;
- SetScrollInfo(Handle, SB_HORZ, SI, False);
- end;
- *)
-end;
-
-procedure TOvcCustomVirtualListBox.vlbSetSelRange(First, Last : LongInt);
- {-set the selection on for the given range of indexes}
-begin
- vlbSelectRangePrim(First, Last, True);
-end;
-
-procedure TOvcCustomVirtualListBox.vlbSetVScrollPos;
-var
- SI : TScrollInfo;
-begin
- if not HandleAllocated then
- Exit;
- with SI do begin
- cbSize := SizeOf(SI);
- fMask := SIF_RANGE or SIF_PAGE or SIF_POS;
- nMin := 0;
- nMax := Pred(lVSHigh);
- nPage := lRows;
- nPos := vlbScaleDown(FTopIndex);
- nTrackPos := nPos;
- end;
- SetScrollInfo(Handle, SB_VERT, SI, True);
-end;
-
-procedure TOvcCustomVirtualListBox.vlbSetVScrollRange;
-var
- ItemRange : LongInt;
-begin
- ItemRange := FNumItems;
- lDivisor := 1;
- if ItemRange < lRows then
- lVSHigh := 1
-{$IFDEF MSWINDOWS}
- else if ItemRange <= High(SmallInt) then
- lVSHigh := ItemRange
- else begin
- lDivisor := 2*(ItemRange div 32768);
- lVSHigh := ItemRange div lDivisor;
- end;
-{$ELSE} //lDivisor not needed apparently (and causes clicks to scroll >1 item).
- else
- lVSHigh := ItemRange;
-{$ENDIF}
-
- if lHaveVS then
- if not ((FNumItems > lRows) or (csDesigning in ComponentState)) then
- lvSHigh := 0
- else
- else
- lvSHigh := 0;
- vlbSetVScrollPos;
-end;
-
-procedure TOvcCustomVirtualListBox.vlbToggleSelection(Index : LongInt);
- {-process Ctrl-LMouseBtn}
-var
- WasSelected : Boolean;
-begin
- if (Index < 0) or (Index > lHighIndex) then
- exit;
- {toggle highlight}
- WasSelected := DoOnIsSelected(Index);
- DoOnSelect(Index, not WasSelected);
- vlbSetFocusedIndex(Index);
- DrawItem(Index);
- {set new active item}
- FItemIndex := Index;
- {and anchor point}
- lAnchor := Index;
-end;
-
-procedure TOvcCustomVirtualListBox.vlbValidateItem(Index : LongInt);
- {-validate the area for this item}
-var
- CR : TRect;
-begin
- if (Index >= FTopIndex) and (Index-FTopIndex < lRows) then begin {visible?}
- CR := Rect(0, (Index-FTopIndex+Ord(FShowHeader))*FRowHeight, ClientWidth, 0);
- CR.Bottom := CR.Top+FRowHeight;
- ValidateRect(Handle, @CR);
- end;
-end;
-
-procedure TOvcCustomVirtualListBox.vlbVScrollPrim(Delta : Integer);
-var
- I : LongInt;
-begin
- I := FTopIndex+Delta;
- if I < 0 then
- if Delta > 0 then
- I := lHighIndex
- else
- I := 0
- else if (I > lHighIndex-Pred(lRows)) then begin
- if lHighIndex > Pred(lRows) then
- I := lHighIndex-Pred(lRows)
- else
- I := 0;
- end;
-
- SetTopIndex(I);
-end;
-
-procedure TOvcCustomVirtualListBox.WMChar(var Msg : TWMChar);
-var
- L : LongInt;
-begin
- inherited;
-
- L := DoOnCharToItem(AnsiChar(Msg.CharCode));
- if (L >= 0) and (L <= lHighIndex) then
- SetItemIndex(L);
-end;
-
-procedure TOvcCustomVirtualListBox.WMEraseBkgnd(var Msg : TWMEraseBkGnd);
-begin
- {indicate that we have processed this message}
- Msg.Result := 1;
-end;
-
-procedure TOvcCustomVirtualListBox.WMGetDlgCode(var Msg : TWMGetDlgCode);
-begin
- inherited;
-
- Msg.Result := Msg.Result or DLGC_WANTCHARS or DLGC_WANTARROWS;
-end;
-
-procedure TOvcCustomVirtualListBox.WMHScroll(var Msg : TWMHScroll);
-begin
- case Msg.ScrollCode of
- SB_LINERIGHT : vlbHScrollPrim(+1);
- SB_LINELEFT : vlbHScrollPrim(-1);
- SB_PAGERIGHT : vlbHScrollPrim(+10);
- SB_PAGELEFT : vlbHScrollPrim(-10);
- SB_THUMBPOSITION, SB_THUMBTRACK :
- if lHDelta <> Msg.Pos then begin
- lHDelta := Msg.Pos;
- vlbSetHScrollPos;
- Refresh;
- end;
- end;
-end;
-
-procedure TOvcCustomVirtualListBox.WMKeyDown(var Msg : TWMKeyDown);
-var
- I : LongInt;
- Cmd : Word;
-begin
- inherited;
-
- Cmd := Controller.EntryCommands.Translate(TMessage(Msg));
- if Cmd <> ccNone then begin
-
- {filter invalid commands}
- case Cmd of
- ccExtendHome, ccExtendEnd, ccExtendPgUp,
- ccExtendPgDn, ccExtendUp, ccExtendDown :
- if not FMultiSelect then
- Exit;
- end;
-
- case Cmd of
- ccLeft :
- if lHaveHs then begin
- if lHDelta > 0 then begin
- Dec(lHDelta);
- vlbSetHScrollPos;
- Refresh;
- end;
- end else begin
- if FItemIndex > 0 then begin
- vlbClearAllItems;
- SetItemIndex(FItemIndex-1);
- lAnchor := FItemIndex;
- end;
- end;
- ccRight :
- if lHaveHs then begin
- if lHDelta < FColumns then begin
- Inc(lHDelta);
- vlbSetHScrollPos;
- Refresh;
- end;
- end else begin
- if FItemIndex < lHighIndex then begin
- vlbClearAllItems;
- SetItemIndex(FItemIndex+1);
- lAnchor := FItemIndex;
- end;
- end;
- ccUp :
- if FItemIndex > 0 then begin
- vlbClearAllItems;
- SetItemIndex(FItemIndex-1);
- lAnchor := FItemIndex;
- end;
- ccDown :
- if FItemIndex < lHighIndex then begin
- vlbClearAllItems;
- SetItemIndex(FItemIndex+1);
- lAnchor := FItemIndex;
- end;
- ccHome :
- if FItemIndex <> 0 then begin
- vlbClearAllItems;
- SetItemIndex(0);
- lAnchor := FItemIndex;
- end;
- ccEnd :
- if (FNumItems > 0) and (FItemIndex <> lHighIndex) then begin
- vlbClearAllItems;
- SetItemIndex(lHighIndex);
- lAnchor := FItemIndex;
- end;
- ccPrevPage :
- if FNumItems > 0 then begin
- if lRows = 1 then
- I := Pred(FItemIndex)
- else
- I := FItemIndex-Pred(lRows);
- if I < 0 then
- I := 0;
- if I <> FItemIndex then begin
- vlbClearAllItems;
- SetItemIndex(I);
- lAnchor := FItemIndex;
- end;
- end;
- ccNextPage :
- if FNumItems > 0 then begin
- if lRows = 1 then begin
- if FItemIndex < lHighIndex then
- I := Succ(FItemIndex)
- else
- I := lHighIndex;
- end else if FItemIndex <= lHighIndex-Pred(lRows) then
- I := FItemIndex+Pred(lRows)
- else
- I := lHighIndex;
- if I <> FItemIndex then begin
- vlbClearAllItems;
- SetItemIndex(I);
- lAnchor := FItemIndex;
- end;
- end;
- ccExtendHome :
- if FItemIndex > 0 then begin
- vlbNewActiveItem(0);
- vlbExtendSelection(0);
- end;
- ccExtendEnd :
- if FItemIndex < lHighIndex then begin
- vlbNewActiveItem(lHighIndex);
- vlbExtendSelection(lHighIndex);
- end;
- ccExtendPgUp :
- begin
- I := FItemIndex-Pred(lRows);
- vlbNewActiveItem(I);
- vlbExtendSelection(I);
- end;
- ccExtendPgDn :
- begin
- I := FItemIndex+Pred(lRows);
- vlbNewActiveItem(I);
- vlbExtendSelection(I);
- end;
- ccExtendUp :
- begin
- I := FItemIndex-1;
- vlbNewActiveItem(I);
- vlbExtendSelection(I);
- end;
- ccExtendDown :
- begin
- I := FItemIndex+1;
- vlbNewActiveItem(I);
- vlbExtendSelection(I);
- end;
- else
- {do user command notification for user commands}
- if Cmd >= ccUserFirst then
- DoOnUserCommand(Cmd);
- end;
-
- {indicate that this message was processed}
- Msg.Result := 0;
- end;
-end;
-
-procedure TOvcCustomVirtualListBox.WMKillFocus(var Msg : TWMKillFocus);
-begin
- inherited;
-
- {re-draw focused item to erase focus rect}
- DrawItem(lFocusedIndex);
-end;
-
-procedure TOvcCustomVirtualListBox.WMLButtonDown(var Msg : TWMLButtonDown);
-var
- I : LongInt;
- LastI : LongInt;
- LButton : Byte;
- CtrlKeyDown : Boolean;
- ShiftKeyDown : Boolean;
-
- function PointToIndex : LongInt;
- var
- Pt : TPoint;
- begin
- GetCursorPos(Pt);
- Pt := ScreenToClient(Pt);
- if Pt.Y < Ord(FShowHeader)*FRowHeight then begin
- {speed up as the cursor moves farther away}
- Result := FTopIndex+(Pt.Y div FRowHeight)-1;
- if Result < 0 then
- Result := 0;
- end else if Pt.Y >= ClientHeight then begin
- {speed up as the cursor moves farther away}
- Result := FTopIndex+(Pt.Y div FRowHeight);
- if Result > lHighIndex then
- Result := lHighIndex;
- end else begin
- {convert to an index}
- Result := FTopIndex-Ord(FShowHeader)+(Pt.Y div FRowHeight);
- if ClientHeight mod FRowHeight > 0 then
- if Result > FTopIndex-1 + lRows then
- Result := FTopIndex-1 + lRows;
- end;
- end;
-
-var
- ItemNo : Integer;
- ShiftState: TShiftState;
-begin
- ShiftState := KeysToShiftState(Msg.Keys);
- if (DragMode = dmAutomatic) and FMultiSelect then
- begin
- if not (ssShift in ShiftState) or (ssCtrl in ShiftState) then
- begin
- ItemNo := ItemAtPos(SmallPointToPoint(Msg.Pos), True);
- if (ItemNo >= 0) and (DoOnIsSelected(ItemNo)) then
- begin
- BeginDrag (False);
- Exit;
- end;
- end;
- end;
- inherited;
- if (DragMode = dmAutomatic) and not (FMultiSelect and
- ((ssCtrl in ShiftState) or (ssShift in ShiftState))) then
- BeginDrag(False);
-
- if MousePassThru then exit;
-
- {solve problem with minimized modeless dialogs and MDI child windows}
- {that contain virtual ListBox components}
- if not Focused and CanFocus then
-{$IFNDEF LCL}
- Windows.SetFocus(Handle);
-{$ELSE}
- LclIntf.SetFocus(Handle);
-{$ENDIF}
-
- {is this click on the header?}
- if FShowHeader and (Msg.YPos < FRowHeight) then begin
- DoOnClickHeader(Point(Msg.XPos, Msg.YPos));
- Exit;
- end;
-
- if (FNumItems <> 0) then begin
- {get the actual left button}
- LButton := GetLeftButton;
-
- {get the key state}
- if FMultiSelect then begin
-{$IFNDEF LCLCarbon}
- CtrlKeyDown := GetKeyState(VK_CONTROL) and $8000 <> 0;
-{$ELSE} {Cmd+click used on Mac for non-contiguous selection; see it as VK_LWIN}
- CtrlKeyDown := GetKeyState(VK_LWIN) and $8000 <> 0;
-{$ENDIF}
- ShiftKeyDown := GetKeyState(VK_SHIFT) and $8000 <> 0;
- end else begin
- CtrlKeyDown := False;
- ShiftKeyDown := False;
- end;
-
- if CtrlKeyDown then
- vlbToggleSelection(PointToIndex)
- else if ShiftKeyDown then
- vlbExtendSelection(PointToIndex)
- else begin
- vlbClearAllItems;
-
- {reselect the active item}
- if FItemIndex <> -1 then begin
- DoOnSelect(FItemIndex, True);
- vlbSetFocusedIndex(FItemIndex);
- end;
-
- {watch the mouse position while the left button is down}
- LastI := -1;
- repeat
- I := PointToIndex;
- if I <= lHighIndex then
- if not FMultiSelect or (LastI = -1) then begin
- SetItemIndex(I);
- lAnchor := I;
- LastI := I;
- end else begin
- {extend/shrink the selection to follow the mouse}
- if I <> LastI then begin
- vlbDragSelection(lAnchor, I);
- LastI := I;
- end;
- end;
- Application.ProcessMessages; {Gasp}
-{$IFDEF MSWINDOWS}
- until ({$IFNDEF LCL} GetAsyncKeyState(LButton) {$ELSE} GetKeyState(LButton) {$ENDIF} and $8000 = 0)
-{$ELSE} //GTK GetKeyState returns 0
- until (not (csLButtonDown in ControlState))
-{$ENDIF}
- or Dragging or (GetCapture <> Handle);
-
- end;
- end;
-end;
-
-procedure TOvcCustomVirtualListBox.WMLButtonDblClk(var Msg : TWMLButtonDblClk);
-begin
- {is this click below the header, if any}
- if (Msg.YPos > FRowHeight * Ord(FShowHeader)) then
- inherited
- else
- {say we processed this message}
- Msg.Result := 0;
-end;
-
-procedure TOvcCustomVirtualListBox.WMMouseActivate(var Msg : TWMMouseActivate);
-begin
- if (csDesigning in ComponentState) or (GetFocus = Handle) then
- inherited
- else begin
- if Controller.ErrorPending then
- Msg.Result := MA_NOACTIVATEANDEAT
- else
- Msg.Result := MA_ACTIVATE;
- end;
-end;
-
-procedure TOvcCustomVirtualListBox.WMSetFocus(var Msg : TWMSetFocus);
-begin
- inherited;
-
- Update;
- DrawItem(lFocusedIndex);
-end;
-
-procedure TOvcCustomVirtualListBox.WMSize(var Msg : TWMSize);
-begin
- if FRowHeight > 0 then begin
- {integral font height adjustment}
- vlbCalcFontFields;
- vlbAdjustIntegralHeight;
-{$IFDEF LCL} //Make sure calling code knows about any change in height.
- if (csDesigning in ComponentState) and
- not (csLoading in ComponentState) then
- if FIntegralHeight then
- Msg.Height := Height; //was ClientHeight, but no longer works on Windows
-{$ENDIF}
- vlbCalcFontFields;
- vlbInitScrollInfo;
-
- {reposition so that items are displayed at bottom of list}
- if lRows + FTopIndex - 1 >= FNumItems then
- if NumItems-lRows >= 0 then
- TopIndex := NumItems-lRows
- else
- TopIndex := 0;
- end;
-
- inherited;
-end;
-
-procedure TOvcCustomVirtualListBox.WMVScroll(var Msg : TWMVScroll);
-var
- I : LongInt;
-begin
- case Msg.ScrollCode of
- SB_LINEUP : vlbVScrollPrim(-1);
- SB_LINEDOWN : vlbVScrollPrim(+1);
- SB_PAGEDOWN : vlbVScrollPrim(+Pred(lRows));
- SB_PAGEUP : vlbVScrollPrim(-Pred(lRows));
- SB_THUMBPOSITION, SB_THUMBTRACK :
- begin
- if Msg.Pos = 0 then
- I := 0
- else if Msg.Pos = lVSHigh then
- if lRows >= FNumItems then
- I := 0
- else
- I := lHighIndex-Pred(lRows)
- else
- I := vlbScaleUp(Msg.Pos);
- ForceTopIndex(I,True);
- end;
- end;
-end;
-
-{ new}
-procedure TOvcCustomVirtualListBox.SetColumns(const Value: Integer);
-begin
- if Value <> FColumns then begin
- FColumns := Value;
- vlbInitScrollInfo;
- end;
-end;
-
-end.
diff --git a/Source/3rdParty/Orpheus/tests/TestCalendar/project1.bdsproj b/Source/3rdParty/Orpheus/tests/TestCalendar/project1.bdsproj
deleted file mode 100644
index acea5547..00000000
--- a/Source/3rdParty/Orpheus/tests/TestCalendar/project1.bdsproj
+++ /dev/null
@@ -1,175 +0,0 @@
-
-
-
-
- Delphi.Personality
- VCLApplication
- 1.0
- {88CE0102-AC1C-464D-AE40-EC184791C58A}
-
-
-
-
- project1.dpr
-
-
- 7.0
-
-
- 8
- 0
- 1
- 1
- 0
- 0
- 1
- 1
- 1
- 0
- 0
- 1
- 0
- 1
- 1
- 1
- 0
- 0
- 0
- 0
- 0
- 1
- 0
- 1
- 1
- 1
- True
- True
- WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-
- False
-
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- False
- False
- False
- True
- True
- True
- True
- True
- True
-
-
-
- 0
- 0
- False
- 1
- False
- False
- False
- 16384
- 1048576
- 4194304
-
-
-
-
-
-
-
-
-
-
-
- False
-
-
-
-
-
- False
-
-
- True
- False
-
-
-
- $00000000
-
-
-
- False
- False
- 1
- 0
- 0
- 0
- False
- False
- False
- False
- False
- 1033
- 1252
-
-
-
-
- 1.0.0.0
-
-
-
-
-
- 1.0.0.0
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/tests/TestCalendar/project1.cfg b/Source/3rdParty/Orpheus/tests/TestCalendar/project1.cfg
deleted file mode 100644
index 34d0442f..00000000
--- a/Source/3rdParty/Orpheus/tests/TestCalendar/project1.cfg
+++ /dev/null
@@ -1,38 +0,0 @@
--$A8
--$B-
--$C+
--$D+
--$E-
--$F-
--$G+
--$H+
--$I+
--$J-
--$K-
--$L+
--$M-
--$N+
--$O+
--$P+
--$Q-
--$R-
--$S-
--$T-
--$U-
--$V+
--$W-
--$X+
--$YD
--$Z1
--cg
--AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
--H+
--W+
--M
--$M16384,1048576
--K$00400000
--LE"c:\delphi7\Projects\Bpl"
--LN"c:\delphi7\Projects\Bpl"
--w-UNSAFE_TYPE
--w-UNSAFE_CODE
--w-UNSAFE_CAST
diff --git a/Source/3rdParty/Orpheus/tests/TestCalendar/project1.dof b/Source/3rdParty/Orpheus/tests/TestCalendar/project1.dof
deleted file mode 100644
index fbb8e82c..00000000
--- a/Source/3rdParty/Orpheus/tests/TestCalendar/project1.dof
+++ /dev/null
@@ -1,136 +0,0 @@
-[FileVersion]
-Version=7.0
-[Compiler]
-A=8
-B=0
-C=1
-D=1
-E=0
-F=0
-G=1
-H=1
-I=1
-J=0
-K=0
-L=1
-M=0
-N=1
-O=1
-P=1
-Q=0
-R=0
-S=0
-T=0
-U=0
-V=1
-W=0
-X=1
-Y=1
-Z=1
-ShowHints=1
-ShowWarnings=1
-UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-NamespacePrefix=
-SymbolDeprecated=1
-SymbolLibrary=1
-SymbolPlatform=1
-UnitLibrary=1
-UnitPlatform=1
-UnitDeprecated=1
-HResultCompat=1
-HidingMember=1
-HiddenVirtual=1
-Garbage=1
-BoundsError=1
-ZeroNilCompat=1
-StringConstTruncated=1
-ForLoopVarVarPar=1
-TypedConstVarPar=1
-AsgToTypedConst=1
-CaseLabelRange=1
-ForVariable=1
-ConstructingAbstract=1
-ComparisonFalse=1
-ComparisonTrue=1
-ComparingSignedUnsigned=1
-CombiningSignedUnsigned=1
-UnsupportedConstruct=1
-FileOpen=1
-FileOpenUnitSrc=1
-BadGlobalSymbol=1
-DuplicateConstructorDestructor=1
-InvalidDirective=1
-PackageNoLink=1
-PackageThreadVar=1
-ImplicitImport=1
-HPPEMITIgnored=1
-NoRetVal=1
-UseBeforeDef=1
-ForLoopVarUndef=1
-UnitNameMismatch=1
-NoCFGFileFound=1
-MessageDirective=1
-ImplicitVariants=1
-UnicodeToLocale=1
-LocaleToUnicode=1
-ImagebaseMultiple=1
-SuspiciousTypecast=1
-PrivatePropAccessor=1
-UnsafeType=0
-UnsafeCode=0
-UnsafeCast=0
-[Linker]
-MapFile=0
-OutputObjs=0
-ConsoleApp=1
-DebugInfo=0
-RemoteSymbols=0
-MinStackSize=16384
-MaxStackSize=1048576
-ImageBase=4194304
-ExeDescription=
-[Directories]
-OutputDir=
-UnitOutputDir=
-PackageDLLOutputDir=
-PackageDCPOutputDir=
-SearchPath=
-Packages=
-Conditionals=
-DebugSourceDirs=
-UsePackages=0
-[Parameters]
-RunParams=
-HostApplication=
-Launcher=
-UseLauncher=0
-DebugCWD=
-[Language]
-ActiveLang=
-ProjectLang=
-RootDir=
-[Version Info]
-IncludeVerInfo=0
-AutoIncBuild=0
-MajorVer=1
-MinorVer=0
-Release=0
-Build=0
-Debug=0
-PreRelease=0
-Special=0
-Private=0
-DLL=0
-Locale=1033
-CodePage=1252
-[Version Info Keys]
-CompanyName=
-FileDescription=
-FileVersion=1.0.0.0
-InternalName=
-LegalCopyright=
-LegalTrademarks=
-OriginalFilename=
-ProductName=
-ProductVersion=1.0.0.0
-Comments=
diff --git a/Source/3rdParty/Orpheus/tests/TestCalendar/project1.dpr b/Source/3rdParty/Orpheus/tests/TestCalendar/project1.dpr
deleted file mode 100644
index 57ac782f..00000000
--- a/Source/3rdParty/Orpheus/tests/TestCalendar/project1.dpr
+++ /dev/null
@@ -1,21 +0,0 @@
-program Project1;
-
-uses
-{$IFDEF LCL}
- Interfaces,
- {$IFDEF UNIX}
- clocale,
- {$ENDIF}
-{$ENDIF}
- Forms,
- Unit1 in 'Unit1.pas' {Form1};
-
-{$IFDEF MSWINDOWS}
-{$R *.res}
-{$ENDIF}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Orpheus/tests/TestCalendar/project1.lpi b/Source/3rdParty/Orpheus/tests/TestCalendar/project1.lpi
deleted file mode 100644
index 78e86da7..00000000
--- a/Source/3rdParty/Orpheus/tests/TestCalendar/project1.lpi
+++ /dev/null
@@ -1,109 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/tests/TestCalendar/unit1.dfm b/Source/3rdParty/Orpheus/tests/TestCalendar/unit1.dfm
deleted file mode 100644
index 7ff0c4d0..00000000
--- a/Source/3rdParty/Orpheus/tests/TestCalendar/unit1.dfm
+++ /dev/null
@@ -1,33 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 440
- Height = 336
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'MS Sans Serif'
- Font.Style = []
- OldCreateOrder = False
- PixelsPerInch = 96
- TextHeight = 13
- object OvcCalendar1: TOvcCalendar
- Left = 56
- Top = 40
- Width = 313
- Height = 209
- BorderStyle = bsNone
- Colors.ActiveDay = clRed
- Colors.ColorScheme = cscalCustom
- Colors.DayNames = clMaroon
- Colors.Days = clBlack
- Colors.InactiveDays = clGray
- Colors.MonthAndYear = clBlue
- Colors.Weekend = clRed
- DayNameWidth = 3
- Options = [cdoShortNames, cdoShowYear, cdoShowInactive, cdoShowRevert, cdoShowToday, cdoShowNavBtns]
- TabOrder = 0
- end
-end
diff --git a/Source/3rdParty/Orpheus/tests/TestCalendar/unit1.lfm b/Source/3rdParty/Orpheus/tests/TestCalendar/unit1.lfm
deleted file mode 100644
index b02944b4..00000000
--- a/Source/3rdParty/Orpheus/tests/TestCalendar/unit1.lfm
+++ /dev/null
@@ -1,30 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 432
- Height = 302
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- PixelsPerInch = 96
- object OvcCalendar1: TOvcCalendar
- Left = 56
- Top = 40
- Width = 313
- Height = 209
- BorderStyle = bsNone
- Colors.ActiveDay = clRed
- Colors.ColorScheme = cscalCustom
- Colors.DayNames = clMaroon
- Colors.Days = clBlack
- Colors.InactiveDays = clGray
- Colors.MonthAndYear = clBlue
- Colors.Weekend = clRed
- DayNameWidth = 3
- Options = [cdoShortNames, cdoShowYear, cdoShowInactive, cdoShowRevert, cdoShowToday, cdoShowNavBtns]
- TabOrder = 0
- end
-end
diff --git a/Source/3rdParty/Orpheus/tests/TestCalendar/unit1.lrs b/Source/3rdParty/Orpheus/tests/TestCalendar/unit1.lrs
deleted file mode 100644
index 58f189f6..00000000
--- a/Source/3rdParty/Orpheus/tests/TestCalendar/unit1.lrs
+++ /dev/null
@@ -1,13 +0,0 @@
-LazarusResources.Add('TForm1','FORMDATA',[
- 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#192#0#3'Top'#2'r'#5'Width'#3#176#1#6'Heig'
- +'ht'#3'.'#1#7'Caption'#6#5'Form1'#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7
- +#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245
- +#10'Font.Style'#11#0#13'PixelsPerInch'#2'`'#0#12'TOvcCalendar'#12'OvcCalenda'
- +'r1'#4'Left'#2'8'#3'Top'#2'('#5'Width'#3'9'#1#6'Height'#3#209#0#11'BorderSty'
- +'le'#7#6'bsNone'#16'Colors.ActiveDay'#7#5'clRed'#18'Colors.ColorScheme'#7#11
- +'cscalCustom'#15'Colors.DayNames'#7#8'clMaroon'#11'Colors.Days'#7#7'clBlack'
- +#19'Colors.InactiveDays'#7#6'clGray'#19'Colors.MonthAndYear'#7#6'clBlue'#14
- +'Colors.Weekend'#7#5'clRed'#12'DayNameWidth'#2#3#7'Options'#11#13'cdoShortNa'
- +'mes'#11'cdoShowYear'#15'cdoShowInactive'#13'cdoShowRevert'#12'cdoShowToday'
- +#14'cdoShowNavBtns'#0#8'TabOrder'#2#0#0#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/tests/TestCalendar/unit1.pas b/Source/3rdParty/Orpheus/tests/TestCalendar/unit1.pas
deleted file mode 100644
index 72fafe7f..00000000
--- a/Source/3rdParty/Orpheus/tests/TestCalendar/unit1.pas
+++ /dev/null
@@ -1,31 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, ovcbase, ovccal;
-
-type
- TForm1 = class(TForm)
- OvcCalendar1: TOvcCalendar;
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.dfm}
-{$ELSE}
-{$R *.lfm}
-{$ENDIF}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/tests/TestFlexEdit/project1.bdsproj b/Source/3rdParty/Orpheus/tests/TestFlexEdit/project1.bdsproj
deleted file mode 100644
index 21fa3766..00000000
--- a/Source/3rdParty/Orpheus/tests/TestFlexEdit/project1.bdsproj
+++ /dev/null
@@ -1,175 +0,0 @@
-
-
-
-
- Delphi.Personality
- VCLApplication
- 1.0
- {CD069137-4C4C-40B2-AAA5-777E14CC0753}
-
-
-
-
- project1.dpr
-
-
- 7.0
-
-
- 8
- 0
- 1
- 1
- 0
- 0
- 1
- 1
- 1
- 0
- 0
- 1
- 0
- 1
- 1
- 1
- 1
- 1
- 0
- 1
- 0
- 1
- 0
- 1
- 1
- 1
- True
- True
- WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-
- False
-
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- False
- False
- False
- True
- True
- True
- True
- True
- True
-
-
-
- 0
- 0
- False
- 1
- False
- False
- False
- 16384
- 1048576
- 4194304
-
-
-
-
-
-
-
- C:\Orpheus4\FPC
- vcl;rtl;vclx;indy;vclie;xmlrtl;inetdbbde;inet;inetdbxpress;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;inetdb;bdertl;vcldbx;adortl;teeui;teedb;tee;ibxpress;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k
-
-
- False
-
-
-
-
-
- False
-
-
- True
- False
-
-
-
- $00000000
-
-
-
- False
- False
- 1
- 0
- 0
- 0
- False
- False
- False
- False
- False
- 1033
- 1252
-
-
-
-
- 1.0.0.0
-
-
-
-
-
- 1.0.0.0
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/tests/TestFlexEdit/project1.cfg b/Source/3rdParty/Orpheus/tests/TestFlexEdit/project1.cfg
deleted file mode 100644
index 45be3be1..00000000
--- a/Source/3rdParty/Orpheus/tests/TestFlexEdit/project1.cfg
+++ /dev/null
@@ -1,38 +0,0 @@
--$A8
--$B-
--$C+
--$D+
--$E-
--$F-
--$G+
--$H+
--$I+
--$J-
--$K-
--$L+
--$M-
--$N+
--$O+
--$P+
--$Q+
--$R+
--$S-
--$T+
--$U-
--$V+
--$W-
--$X+
--$YD
--$Z1
--cg
--AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
--H+
--W+
--M
--$M16384,1048576
--K$00400000
--LE"c:\delphi7\Projects\Bpl"
--LN"c:\delphi7\Projects\Bpl"
--w-UNSAFE_TYPE
--w-UNSAFE_CODE
--w-UNSAFE_CAST
diff --git a/Source/3rdParty/Orpheus/tests/TestFlexEdit/project1.dof b/Source/3rdParty/Orpheus/tests/TestFlexEdit/project1.dof
deleted file mode 100644
index a964abf6..00000000
--- a/Source/3rdParty/Orpheus/tests/TestFlexEdit/project1.dof
+++ /dev/null
@@ -1,136 +0,0 @@
-[FileVersion]
-Version=7.0
-[Compiler]
-A=8
-B=0
-C=1
-D=1
-E=0
-F=0
-G=1
-H=1
-I=1
-J=0
-K=0
-L=1
-M=0
-N=1
-O=1
-P=1
-Q=1
-R=1
-S=0
-T=1
-U=0
-V=1
-W=0
-X=1
-Y=1
-Z=1
-ShowHints=1
-ShowWarnings=1
-UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-NamespacePrefix=
-SymbolDeprecated=1
-SymbolLibrary=1
-SymbolPlatform=1
-UnitLibrary=1
-UnitPlatform=1
-UnitDeprecated=1
-HResultCompat=1
-HidingMember=1
-HiddenVirtual=1
-Garbage=1
-BoundsError=1
-ZeroNilCompat=1
-StringConstTruncated=1
-ForLoopVarVarPar=1
-TypedConstVarPar=1
-AsgToTypedConst=1
-CaseLabelRange=1
-ForVariable=1
-ConstructingAbstract=1
-ComparisonFalse=1
-ComparisonTrue=1
-ComparingSignedUnsigned=1
-CombiningSignedUnsigned=1
-UnsupportedConstruct=1
-FileOpen=1
-FileOpenUnitSrc=1
-BadGlobalSymbol=1
-DuplicateConstructorDestructor=1
-InvalidDirective=1
-PackageNoLink=1
-PackageThreadVar=1
-ImplicitImport=1
-HPPEMITIgnored=1
-NoRetVal=1
-UseBeforeDef=1
-ForLoopVarUndef=1
-UnitNameMismatch=1
-NoCFGFileFound=1
-MessageDirective=1
-ImplicitVariants=1
-UnicodeToLocale=1
-LocaleToUnicode=1
-ImagebaseMultiple=1
-SuspiciousTypecast=1
-PrivatePropAccessor=1
-UnsafeType=0
-UnsafeCode=0
-UnsafeCast=0
-[Linker]
-MapFile=0
-OutputObjs=0
-ConsoleApp=1
-DebugInfo=0
-RemoteSymbols=0
-MinStackSize=16384
-MaxStackSize=1048576
-ImageBase=4194304
-ExeDescription=
-[Directories]
-OutputDir=
-UnitOutputDir=
-PackageDLLOutputDir=
-PackageDCPOutputDir=
-SearchPath=
-Packages=vcl;rtl;vclx;indy;vclie;xmlrtl;inetdbbde;inet;inetdbxpress;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;inetdb;bdertl;vcldbx;adortl;teeui;teedb;tee;ibxpress;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k
-Conditionals=
-DebugSourceDirs=
-UsePackages=0
-[Parameters]
-RunParams=
-HostApplication=
-Launcher=
-UseLauncher=0
-DebugCWD=
-[Language]
-ActiveLang=
-ProjectLang=
-RootDir=
-[Version Info]
-IncludeVerInfo=0
-AutoIncBuild=0
-MajorVer=1
-MinorVer=0
-Release=0
-Build=0
-Debug=0
-PreRelease=0
-Special=0
-Private=0
-DLL=0
-Locale=1033
-CodePage=1252
-[Version Info Keys]
-CompanyName=
-FileDescription=
-FileVersion=1.0.0.0
-InternalName=
-LegalCopyright=
-LegalTrademarks=
-OriginalFilename=
-ProductName=
-ProductVersion=1.0.0.0
-Comments=
diff --git a/Source/3rdParty/Orpheus/tests/TestFlexEdit/project1.dpr b/Source/3rdParty/Orpheus/tests/TestFlexEdit/project1.dpr
deleted file mode 100644
index 7e174316..00000000
--- a/Source/3rdParty/Orpheus/tests/TestFlexEdit/project1.dpr
+++ /dev/null
@@ -1,18 +0,0 @@
-program Project1;
-
-uses
-{$IFDEF LCL}
- Interfaces,
-{$ENDIF}
- Forms,
- Unit1 in 'unit1.pas' {Form1};
-
-{$IFDEF MSWINDOWS}
-{$R *.res}
-{$ENDIF}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Orpheus/tests/TestFlexEdit/project1.lpi b/Source/3rdParty/Orpheus/tests/TestFlexEdit/project1.lpi
deleted file mode 100644
index aac4d262..00000000
--- a/Source/3rdParty/Orpheus/tests/TestFlexEdit/project1.lpi
+++ /dev/null
@@ -1,110 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/tests/TestFlexEdit/unit1.dfm b/Source/3rdParty/Orpheus/tests/TestFlexEdit/unit1.dfm
deleted file mode 100644
index c71592f5..00000000
--- a/Source/3rdParty/Orpheus/tests/TestFlexEdit/unit1.dfm
+++ /dev/null
@@ -1,84 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 423
- Height = 323
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'MS Sans Serif'
- Font.Style = []
- OldCreateOrder = False
- PixelsPerInch = 96
- TextHeight = 13
- object Label1: TLabel
- Left = 16
- Top = 16
- Width = 385
- Height = 41
- Alignment = taCenter
- AutoSize = False
- Caption =
- 'Enter a positive integer, then move to next control to validate ' +
- 'the number.'
- WordWrap = True
- end
- object Label2: TLabel
- Left = 16
- Top = 120
- Width = 385
- Height = 41
- Alignment = taCenter
- AutoSize = False
- Caption =
- 'Enter a positive real number, then move to next control to valid' +
- 'ate the number.'
- WordWrap = True
- end
- object O32FlexEdit1: TO32FlexEdit
- Left = 168
- Top = 56
- Width = 81
- Height = 21
- EfColors.Disabled.BackColor = clWindow
- EfColors.Disabled.TextColor = clGrayText
- EfColors.Error.BackColor = clRed
- EfColors.Error.TextColor = clBlack
- EfColors.Highlight.BackColor = clHighlight
- EfColors.Highlight.TextColor = clHighlightText
- TabOrder = 0
- Validation.BeepOnError = True
- Validation.SoftValidation = False
- Validation.ValidationEvent = veOnExit
- Validation.ValidatorType = 'None'
- Validation.ValidationType = vtUser
- Validation.InputRequired = False
- OnExit = O32FlexEditExit
- OnUserValidation = O32FlexEdit1UserValidation
- OnValidationError = O32FlexEditValidationError
- end
- object O32FlexEdit2: TO32FlexEdit
- Left = 168
- Top = 160
- Width = 81
- Height = 21
- EfColors.Disabled.BackColor = clWindow
- EfColors.Disabled.TextColor = clGrayText
- EfColors.Error.BackColor = clRed
- EfColors.Error.TextColor = clBlack
- EfColors.Highlight.BackColor = clHighlight
- EfColors.Highlight.TextColor = clHighlightText
- TabOrder = 1
- Validation.BeepOnError = True
- Validation.SoftValidation = False
- Validation.ValidationEvent = veOnExit
- Validation.ValidatorType = 'None'
- Validation.ValidationType = vtUser
- Validation.InputRequired = False
- OnExit = O32FlexEditExit
- OnUserValidation = O32FlexEdit2UserValidation
- OnValidationError = O32FlexEditValidationError
- end
-end
diff --git a/Source/3rdParty/Orpheus/tests/TestFlexEdit/unit1.lfm b/Source/3rdParty/Orpheus/tests/TestFlexEdit/unit1.lfm
deleted file mode 100644
index 408db444..00000000
--- a/Source/3rdParty/Orpheus/tests/TestFlexEdit/unit1.lfm
+++ /dev/null
@@ -1,81 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 415
- Height = 289
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- PixelsPerInch = 96
- object Label1: TLabel
- Left = 16
- Top = 16
- Width = 385
- Height = 41
- Alignment = taCenter
- AutoSize = False
- Caption =
- 'Enter a positive integer, then move to next control to validate ' +
- 'the number.'
- WordWrap = True
- end
- object Label2: TLabel
- Left = 16
- Top = 120
- Width = 385
- Height = 41
- Alignment = taCenter
- AutoSize = False
- Caption =
- 'Enter a positive real number, then move to next control to valid' +
- 'ate the number.'
- WordWrap = True
- end
- object O32FlexEdit1: TO32FlexEdit
- Left = 168
- Top = 56
- Width = 81
- Height = 21
- EfColors.Disabled.BackColor = clWindow
- EfColors.Disabled.TextColor = clGrayText
- EfColors.Error.BackColor = clRed
- EfColors.Error.TextColor = clBlack
- EfColors.Highlight.BackColor = clHighlight
- EfColors.Highlight.TextColor = clHighlightText
- TabOrder = 0
- Validation.BeepOnError = True
- Validation.SoftValidation = False
- Validation.ValidationEvent = veOnExit
- Validation.ValidatorType = 'None'
- Validation.ValidationType = vtUser
- Validation.InputRequired = False
- OnExit = O32FlexEditExit
- OnUserValidation = O32FlexEdit1UserValidation
- OnValidationError = O32FlexEditValidationError
- end
- object O32FlexEdit2: TO32FlexEdit
- Left = 168
- Top = 160
- Width = 81
- Height = 21
- EfColors.Disabled.BackColor = clWindow
- EfColors.Disabled.TextColor = clGrayText
- EfColors.Error.BackColor = clRed
- EfColors.Error.TextColor = clBlack
- EfColors.Highlight.BackColor = clHighlight
- EfColors.Highlight.TextColor = clHighlightText
- TabOrder = 1
- Validation.BeepOnError = True
- Validation.SoftValidation = False
- Validation.ValidationEvent = veOnExit
- Validation.ValidatorType = 'None'
- Validation.ValidationType = vtUser
- Validation.InputRequired = False
- OnExit = O32FlexEditExit
- OnUserValidation = O32FlexEdit2UserValidation
- OnValidationError = O32FlexEditValidationError
- end
-end
diff --git a/Source/3rdParty/Orpheus/tests/TestFlexEdit/unit1.lrs b/Source/3rdParty/Orpheus/tests/TestFlexEdit/unit1.lrs
deleted file mode 100644
index 4ed8bcd6..00000000
--- a/Source/3rdParty/Orpheus/tests/TestFlexEdit/unit1.lrs
+++ /dev/null
@@ -1,32 +0,0 @@
-LazarusResources.Add('TForm1','FORMDATA',[
- 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#192#0#3'Top'#2'r'#5'Width'#3#159#1#6'Heig'
- +'ht'#3'!'#1#7'Caption'#6#5'Form1'#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7
- +#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245
- +#10'Font.Style'#11#0#13'PixelsPerInch'#2'`'#0#6'TLabel'#6'Label1'#4'Left'#2
- +#16#3'Top'#2#16#5'Width'#3#129#1#6'Height'#2')'#9'Alignment'#7#8'taCenter'#8
- +'AutoSize'#8#7'Caption'#6'KEnter a positive integer, then move to next contr'
- +'ol to validate the number.'#8'WordWrap'#9#0#0#6'TLabel'#6'Label2'#4'Left'#2
- +#16#3'Top'#2'x'#5'Width'#3#129#1#6'Height'#2')'#9'Alignment'#7#8'taCenter'#8
- +'AutoSize'#8#7'Caption'#6'OEnter a positive real number, then move to next c'
- +'ontrol to validate the number.'#8'WordWrap'#9#0#0#12'TO32FlexEdit'#12'O32Fl'
- +'exEdit1'#4'Left'#3#168#0#3'Top'#2'8'#5'Width'#2'Q'#6'Height'#2#21#27'EfColo'
- +'rs.Disabled.BackColor'#7#8'clWindow'#27'EfColors.Disabled.TextColor'#7#10'c'
- +'lGrayText'#24'EfColors.Error.BackColor'#7#5'clRed'#24'EfColors.Error.TextCo'
- +'lor'#7#7'clBlack'#28'EfColors.Highlight.BackColor'#7#11'clHighlight'#28'EfC'
- +'olors.Highlight.TextColor'#7#15'clHighlightText'#8'TabOrder'#2#0#22'Validat'
- +'ion.BeepOnError'#9#25'Validation.SoftValidation'#8#26'Validation.Validation'
- +'Event'#7#8'veOnExit'#24'Validation.ValidatorType'#6#4'None'#25'Validation.V'
- +'alidationType'#7#6'vtUser'#24'Validation.InputRequired'#8#6'OnExit'#7#15'O3'
- +'2FlexEditExit'#16'OnUserValidation'#7#26'O32FlexEdit1UserValidation'#17'OnV'
- +'alidationError'#7#26'O32FlexEditValidationError'#0#0#12'TO32FlexEdit'#12'O3'
- +'2FlexEdit2'#4'Left'#3#168#0#3'Top'#3#160#0#5'Width'#2'Q'#6'Height'#2#21#27
- +'EfColors.Disabled.BackColor'#7#8'clWindow'#27'EfColors.Disabled.TextColor'#7
- +#10'clGrayText'#24'EfColors.Error.BackColor'#7#5'clRed'#24'EfColors.Error.Te'
- +'xtColor'#7#7'clBlack'#28'EfColors.Highlight.BackColor'#7#11'clHighlight'#28
- +'EfColors.Highlight.TextColor'#7#15'clHighlightText'#8'TabOrder'#2#1#22'Vali'
- +'dation.BeepOnError'#9#25'Validation.SoftValidation'#8#26'Validation.Validat'
- +'ionEvent'#7#8'veOnExit'#24'Validation.ValidatorType'#6#4'None'#25'Validatio'
- +'n.ValidationType'#7#6'vtUser'#24'Validation.InputRequired'#8#6'OnExit'#7#15
- +'O32FlexEditExit'#16'OnUserValidation'#7#26'O32FlexEdit2UserValidation'#17'O'
- +'nValidationError'#7#26'O32FlexEditValidationError'#0#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/tests/TestFlexEdit/unit1.pas b/Source/3rdParty/Orpheus/tests/TestFlexEdit/unit1.pas
deleted file mode 100644
index d975a084..00000000
--- a/Source/3rdParty/Orpheus/tests/TestFlexEdit/unit1.pas
+++ /dev/null
@@ -1,77 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls, ovcdata, o32editf, o32flxed;
-
-type
- TForm1 = class(TForm)
- Label1: TLabel;
- O32FlexEdit1: TO32FlexEdit;
- Label2: TLabel;
- O32FlexEdit2: TO32FlexEdit;
- procedure O32FlexEdit1UserValidation(Sender: TObject;
- var ValidEntry: Boolean);
- procedure O32FlexEdit2UserValidation(Sender: TObject;
- var ValidEntry: Boolean);
- procedure O32FlexEditValidationError(Sender: TObject; ErrorCode: Word;
- ErrorMsg: String);
- procedure O32FlexEditExit(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.dfm}
-{$ELSE}
-{$R *.lfm}
-{$ENDIF}
-
-procedure TForm1.O32FlexEdit1UserValidation(Sender: TObject;
- var ValidEntry: Boolean);
-begin
- if TO32FlexEdit(Sender).Text = '' then
- ValidEntry := True
- else
- ValidEntry := StrToIntDef(TO32FlexEdit(Sender).Text, 0) > 0;
-end;
-
-procedure TForm1.O32FlexEdit2UserValidation(Sender: TObject;
- var ValidEntry: Boolean);
-begin
- if TO32FlexEdit(Sender).Text = '' then
- ValidEntry := True
- else
- ValidEntry := StrToFloatDef(TO32FlexEdit(Sender).Text, 0) > 0;
-end;
-
-procedure TForm1.O32FlexEditValidationError(Sender: TObject;
- ErrorCode: Word; ErrorMsg: String);
-begin
- MessageDlg(ErrorMsg + #13#10 + 'Press Ctrl+Z to undo.', mtError, [mbOK], 0);
-end;
-
-procedure TForm1.O32FlexEditExit(Sender: TObject);
-begin
-{$IFNDEF MSWINDOWS}
- {TO32FlexEdit OnUserValidation doesn't work, so validate here
- so user is notified if error, even though focus will change.}
-// SendMessage(TO32FlexEdit(Sender).Handle, OM_VALIDATE, 0, 0);
-// This workaround no longer works with LCL 0.9.28 -- error message dialog
-// just repeats. SendMessage/OM_VALIDATE cancels exit event?
-// PostMessage appears to work okay, though.
- PostMessage(TO32FlexEdit(Sender).Handle, OM_VALIDATE, 0, 0);
-{$ENDIF}
-end;
-
-end.
diff --git a/Source/3rdParty/Orpheus/tests/TestLabel/project1.bdsproj b/Source/3rdParty/Orpheus/tests/TestLabel/project1.bdsproj
deleted file mode 100644
index 21fa3766..00000000
--- a/Source/3rdParty/Orpheus/tests/TestLabel/project1.bdsproj
+++ /dev/null
@@ -1,175 +0,0 @@
-
-
-
-
- Delphi.Personality
- VCLApplication
- 1.0
- {CD069137-4C4C-40B2-AAA5-777E14CC0753}
-
-
-
-
- project1.dpr
-
-
- 7.0
-
-
- 8
- 0
- 1
- 1
- 0
- 0
- 1
- 1
- 1
- 0
- 0
- 1
- 0
- 1
- 1
- 1
- 1
- 1
- 0
- 1
- 0
- 1
- 0
- 1
- 1
- 1
- True
- True
- WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-
- False
-
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- False
- False
- False
- True
- True
- True
- True
- True
- True
-
-
-
- 0
- 0
- False
- 1
- False
- False
- False
- 16384
- 1048576
- 4194304
-
-
-
-
-
-
-
- C:\Orpheus4\FPC
- vcl;rtl;vclx;indy;vclie;xmlrtl;inetdbbde;inet;inetdbxpress;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;inetdb;bdertl;vcldbx;adortl;teeui;teedb;tee;ibxpress;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k
-
-
- False
-
-
-
-
-
- False
-
-
- True
- False
-
-
-
- $00000000
-
-
-
- False
- False
- 1
- 0
- 0
- 0
- False
- False
- False
- False
- False
- 1033
- 1252
-
-
-
-
- 1.0.0.0
-
-
-
-
-
- 1.0.0.0
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/tests/TestLabel/project1.cfg b/Source/3rdParty/Orpheus/tests/TestLabel/project1.cfg
deleted file mode 100644
index 45be3be1..00000000
--- a/Source/3rdParty/Orpheus/tests/TestLabel/project1.cfg
+++ /dev/null
@@ -1,38 +0,0 @@
--$A8
--$B-
--$C+
--$D+
--$E-
--$F-
--$G+
--$H+
--$I+
--$J-
--$K-
--$L+
--$M-
--$N+
--$O+
--$P+
--$Q+
--$R+
--$S-
--$T+
--$U-
--$V+
--$W-
--$X+
--$YD
--$Z1
--cg
--AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
--H+
--W+
--M
--$M16384,1048576
--K$00400000
--LE"c:\delphi7\Projects\Bpl"
--LN"c:\delphi7\Projects\Bpl"
--w-UNSAFE_TYPE
--w-UNSAFE_CODE
--w-UNSAFE_CAST
diff --git a/Source/3rdParty/Orpheus/tests/TestLabel/project1.dof b/Source/3rdParty/Orpheus/tests/TestLabel/project1.dof
deleted file mode 100644
index a964abf6..00000000
--- a/Source/3rdParty/Orpheus/tests/TestLabel/project1.dof
+++ /dev/null
@@ -1,136 +0,0 @@
-[FileVersion]
-Version=7.0
-[Compiler]
-A=8
-B=0
-C=1
-D=1
-E=0
-F=0
-G=1
-H=1
-I=1
-J=0
-K=0
-L=1
-M=0
-N=1
-O=1
-P=1
-Q=1
-R=1
-S=0
-T=1
-U=0
-V=1
-W=0
-X=1
-Y=1
-Z=1
-ShowHints=1
-ShowWarnings=1
-UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-NamespacePrefix=
-SymbolDeprecated=1
-SymbolLibrary=1
-SymbolPlatform=1
-UnitLibrary=1
-UnitPlatform=1
-UnitDeprecated=1
-HResultCompat=1
-HidingMember=1
-HiddenVirtual=1
-Garbage=1
-BoundsError=1
-ZeroNilCompat=1
-StringConstTruncated=1
-ForLoopVarVarPar=1
-TypedConstVarPar=1
-AsgToTypedConst=1
-CaseLabelRange=1
-ForVariable=1
-ConstructingAbstract=1
-ComparisonFalse=1
-ComparisonTrue=1
-ComparingSignedUnsigned=1
-CombiningSignedUnsigned=1
-UnsupportedConstruct=1
-FileOpen=1
-FileOpenUnitSrc=1
-BadGlobalSymbol=1
-DuplicateConstructorDestructor=1
-InvalidDirective=1
-PackageNoLink=1
-PackageThreadVar=1
-ImplicitImport=1
-HPPEMITIgnored=1
-NoRetVal=1
-UseBeforeDef=1
-ForLoopVarUndef=1
-UnitNameMismatch=1
-NoCFGFileFound=1
-MessageDirective=1
-ImplicitVariants=1
-UnicodeToLocale=1
-LocaleToUnicode=1
-ImagebaseMultiple=1
-SuspiciousTypecast=1
-PrivatePropAccessor=1
-UnsafeType=0
-UnsafeCode=0
-UnsafeCast=0
-[Linker]
-MapFile=0
-OutputObjs=0
-ConsoleApp=1
-DebugInfo=0
-RemoteSymbols=0
-MinStackSize=16384
-MaxStackSize=1048576
-ImageBase=4194304
-ExeDescription=
-[Directories]
-OutputDir=
-UnitOutputDir=
-PackageDLLOutputDir=
-PackageDCPOutputDir=
-SearchPath=
-Packages=vcl;rtl;vclx;indy;vclie;xmlrtl;inetdbbde;inet;inetdbxpress;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;inetdb;bdertl;vcldbx;adortl;teeui;teedb;tee;ibxpress;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k
-Conditionals=
-DebugSourceDirs=
-UsePackages=0
-[Parameters]
-RunParams=
-HostApplication=
-Launcher=
-UseLauncher=0
-DebugCWD=
-[Language]
-ActiveLang=
-ProjectLang=
-RootDir=
-[Version Info]
-IncludeVerInfo=0
-AutoIncBuild=0
-MajorVer=1
-MinorVer=0
-Release=0
-Build=0
-Debug=0
-PreRelease=0
-Special=0
-Private=0
-DLL=0
-Locale=1033
-CodePage=1252
-[Version Info Keys]
-CompanyName=
-FileDescription=
-FileVersion=1.0.0.0
-InternalName=
-LegalCopyright=
-LegalTrademarks=
-OriginalFilename=
-ProductName=
-ProductVersion=1.0.0.0
-Comments=
diff --git a/Source/3rdParty/Orpheus/tests/TestLabel/project1.dpr b/Source/3rdParty/Orpheus/tests/TestLabel/project1.dpr
deleted file mode 100644
index 8a2e82e5..00000000
--- a/Source/3rdParty/Orpheus/tests/TestLabel/project1.dpr
+++ /dev/null
@@ -1,18 +0,0 @@
-program Project1;
-
-uses
-{$IFDEF LCL}
- Interfaces,
-{$ENDIF}
- Forms,
- Unit1 in 'Unit1.pas' {Form1};
-
-{$IFDEF MSWINDOWS}
-{$R *.res}
-{$ENDIF}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Orpheus/tests/TestLabel/project1.lpi b/Source/3rdParty/Orpheus/tests/TestLabel/project1.lpi
deleted file mode 100644
index 8f104d26..00000000
--- a/Source/3rdParty/Orpheus/tests/TestLabel/project1.lpi
+++ /dev/null
@@ -1,110 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/tests/TestLabel/unit1.dfm b/Source/3rdParty/Orpheus/tests/TestLabel/unit1.dfm
deleted file mode 100644
index 257f4f0f..00000000
--- a/Source/3rdParty/Orpheus/tests/TestLabel/unit1.dfm
+++ /dev/null
@@ -1,48 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 386
- Height = 340
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'MS Sans Serif'
- Font.Style = []
- OldCreateOrder = False
- PixelsPerInch = 96
- TextHeight = 13
- object OvcLabel1: TOvcLabel
- Left = 64
- Top = 32
- Width = 257
- Height = 49
- Caption = 'Fancy Raised Label'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clGray
- Font.Height = -26
- Font.Name = 'Times New Roman'
- Font.Style = []
- ParentColor = False
- end
- object OvcLabel2: TOvcLabel
- Left = 64
- Top = 112
- Width = 257
- Height = 49
- Appearance = apSunken
- Caption = 'Fancy Sunken Label'
- Color = clBtnFace
- ColorScheme = csCustom
- CustomSettings.HighlightDirection = sdDownRight
- CustomSettings.ShadowDirection = sdUpLeft
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clGray
- Font.Height = -26
- Font.Name = 'Times New Roman'
- Font.Style = []
- ParentColor = False
- end
-end
diff --git a/Source/3rdParty/Orpheus/tests/TestLabel/unit1.lfm b/Source/3rdParty/Orpheus/tests/TestLabel/unit1.lfm
deleted file mode 100644
index a95dc727..00000000
--- a/Source/3rdParty/Orpheus/tests/TestLabel/unit1.lfm
+++ /dev/null
@@ -1,43 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 378
- Height = 306
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- PixelsPerInch = 96
- object OvcLabel1: TOvcLabel
- Left = 64
- Top = 32
- Width = 257
- Height = 49
- Caption = 'Fancy Raised Label'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clGray
- Font.Height = -26
- Font.Style = []
- ParentColor = False
- end
- object OvcLabel2: TOvcLabel
- Left = 64
- Top = 112
- Width = 257
- Height = 49
- Appearance = apSunken
- Caption = 'Fancy Sunken Label'
- Color = clBtnFace
- ColorScheme = csCustom
- CustomSettings.HighlightDirection = sdDownRight
- CustomSettings.ShadowDirection = sdUpLeft
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clGray
- Font.Height = -26
- Font.Style = []
- ParentColor = False
- end
-end
diff --git a/Source/3rdParty/Orpheus/tests/TestLabel/unit1.lrs b/Source/3rdParty/Orpheus/tests/TestLabel/unit1.lrs
deleted file mode 100644
index 0b05e52c..00000000
--- a/Source/3rdParty/Orpheus/tests/TestLabel/unit1.lrs
+++ /dev/null
@@ -1,15 +0,0 @@
-LazarusResources.Add('TForm1','FORMDATA',[
- 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#192#0#3'Top'#2'r'#5'Width'#3'z'#1#6'Heigh'
- +'t'#3'2'#1#7'Caption'#6#5'Form1'#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7
- +#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245
- +#10'Font.Style'#11#0#13'PixelsPerInch'#2'`'#0#9'TOvcLabel'#9'OvcLabel1'#4'Le'
- +'ft'#2'@'#3'Top'#2' '#5'Width'#3#1#1#6'Height'#2'1'#7'Caption'#6#18'Fancy Ra'
- +'ised Label'#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7#15'DEFAULT_CHARSET'
- +#10'Font.Color'#7#6'clGray'#11'Font.Height'#2#230#10'Font.Style'#11#0#11'Par'
- +'entColor'#8#0#0#9'TOvcLabel'#9'OvcLabel2'#4'Left'#2'@'#3'Top'#2'p'#5'Width'
- +#3#1#1#6'Height'#2'1'#10'Appearance'#7#8'apSunken'#7'Caption'#6#18'Fancy Sun'
- +'ken Label'#5'Color'#7#9'clBtnFace'#11'ColorScheme'#7#8'csCustom!CustomSetti'
- +'ngs.HighlightDirection'#7#11'sdDownRight'#30'CustomSettings.ShadowDirection'
- +#7#8'sdUpLeft'#12'Font.Charset'#7#15'DEFAULT_CHARSET'#10'Font.Color'#7#6'clG'
- +'ray'#11'Font.Height'#2#230#10'Font.Style'#11#0#11'ParentColor'#8#0#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/tests/TestLabel/unit1.pas b/Source/3rdParty/Orpheus/tests/TestLabel/unit1.pas
deleted file mode 100644
index 65596c72..00000000
--- a/Source/3rdParty/Orpheus/tests/TestLabel/unit1.pas
+++ /dev/null
@@ -1,35 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls, ovclabel;
-
-type
-
- { TForm1 }
-
- TForm1 = class(TForm)
- OvcLabel1: TOvcLabel;
- OvcLabel2: TOvcLabel;
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.dfm}
-{$ELSE}
-{$R *.lfm}
-{$ENDIF}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/tests/TestRLbl/project1.bdsproj b/Source/3rdParty/Orpheus/tests/TestRLbl/project1.bdsproj
deleted file mode 100644
index 21fa3766..00000000
--- a/Source/3rdParty/Orpheus/tests/TestRLbl/project1.bdsproj
+++ /dev/null
@@ -1,175 +0,0 @@
-
-
-
-
- Delphi.Personality
- VCLApplication
- 1.0
- {CD069137-4C4C-40B2-AAA5-777E14CC0753}
-
-
-
-
- project1.dpr
-
-
- 7.0
-
-
- 8
- 0
- 1
- 1
- 0
- 0
- 1
- 1
- 1
- 0
- 0
- 1
- 0
- 1
- 1
- 1
- 1
- 1
- 0
- 1
- 0
- 1
- 0
- 1
- 1
- 1
- True
- True
- WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-
- False
-
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- False
- False
- False
- True
- True
- True
- True
- True
- True
-
-
-
- 0
- 0
- False
- 1
- False
- False
- False
- 16384
- 1048576
- 4194304
-
-
-
-
-
-
-
- C:\Orpheus4\FPC
- vcl;rtl;vclx;indy;vclie;xmlrtl;inetdbbde;inet;inetdbxpress;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;inetdb;bdertl;vcldbx;adortl;teeui;teedb;tee;ibxpress;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k
-
-
- False
-
-
-
-
-
- False
-
-
- True
- False
-
-
-
- $00000000
-
-
-
- False
- False
- 1
- 0
- 0
- 0
- False
- False
- False
- False
- False
- 1033
- 1252
-
-
-
-
- 1.0.0.0
-
-
-
-
-
- 1.0.0.0
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/tests/TestRLbl/project1.cfg b/Source/3rdParty/Orpheus/tests/TestRLbl/project1.cfg
deleted file mode 100644
index 45be3be1..00000000
--- a/Source/3rdParty/Orpheus/tests/TestRLbl/project1.cfg
+++ /dev/null
@@ -1,38 +0,0 @@
--$A8
--$B-
--$C+
--$D+
--$E-
--$F-
--$G+
--$H+
--$I+
--$J-
--$K-
--$L+
--$M-
--$N+
--$O+
--$P+
--$Q+
--$R+
--$S-
--$T+
--$U-
--$V+
--$W-
--$X+
--$YD
--$Z1
--cg
--AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
--H+
--W+
--M
--$M16384,1048576
--K$00400000
--LE"c:\delphi7\Projects\Bpl"
--LN"c:\delphi7\Projects\Bpl"
--w-UNSAFE_TYPE
--w-UNSAFE_CODE
--w-UNSAFE_CAST
diff --git a/Source/3rdParty/Orpheus/tests/TestRLbl/project1.dof b/Source/3rdParty/Orpheus/tests/TestRLbl/project1.dof
deleted file mode 100644
index a964abf6..00000000
--- a/Source/3rdParty/Orpheus/tests/TestRLbl/project1.dof
+++ /dev/null
@@ -1,136 +0,0 @@
-[FileVersion]
-Version=7.0
-[Compiler]
-A=8
-B=0
-C=1
-D=1
-E=0
-F=0
-G=1
-H=1
-I=1
-J=0
-K=0
-L=1
-M=0
-N=1
-O=1
-P=1
-Q=1
-R=1
-S=0
-T=1
-U=0
-V=1
-W=0
-X=1
-Y=1
-Z=1
-ShowHints=1
-ShowWarnings=1
-UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-NamespacePrefix=
-SymbolDeprecated=1
-SymbolLibrary=1
-SymbolPlatform=1
-UnitLibrary=1
-UnitPlatform=1
-UnitDeprecated=1
-HResultCompat=1
-HidingMember=1
-HiddenVirtual=1
-Garbage=1
-BoundsError=1
-ZeroNilCompat=1
-StringConstTruncated=1
-ForLoopVarVarPar=1
-TypedConstVarPar=1
-AsgToTypedConst=1
-CaseLabelRange=1
-ForVariable=1
-ConstructingAbstract=1
-ComparisonFalse=1
-ComparisonTrue=1
-ComparingSignedUnsigned=1
-CombiningSignedUnsigned=1
-UnsupportedConstruct=1
-FileOpen=1
-FileOpenUnitSrc=1
-BadGlobalSymbol=1
-DuplicateConstructorDestructor=1
-InvalidDirective=1
-PackageNoLink=1
-PackageThreadVar=1
-ImplicitImport=1
-HPPEMITIgnored=1
-NoRetVal=1
-UseBeforeDef=1
-ForLoopVarUndef=1
-UnitNameMismatch=1
-NoCFGFileFound=1
-MessageDirective=1
-ImplicitVariants=1
-UnicodeToLocale=1
-LocaleToUnicode=1
-ImagebaseMultiple=1
-SuspiciousTypecast=1
-PrivatePropAccessor=1
-UnsafeType=0
-UnsafeCode=0
-UnsafeCast=0
-[Linker]
-MapFile=0
-OutputObjs=0
-ConsoleApp=1
-DebugInfo=0
-RemoteSymbols=0
-MinStackSize=16384
-MaxStackSize=1048576
-ImageBase=4194304
-ExeDescription=
-[Directories]
-OutputDir=
-UnitOutputDir=
-PackageDLLOutputDir=
-PackageDCPOutputDir=
-SearchPath=
-Packages=vcl;rtl;vclx;indy;vclie;xmlrtl;inetdbbde;inet;inetdbxpress;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;inetdb;bdertl;vcldbx;adortl;teeui;teedb;tee;ibxpress;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k
-Conditionals=
-DebugSourceDirs=
-UsePackages=0
-[Parameters]
-RunParams=
-HostApplication=
-Launcher=
-UseLauncher=0
-DebugCWD=
-[Language]
-ActiveLang=
-ProjectLang=
-RootDir=
-[Version Info]
-IncludeVerInfo=0
-AutoIncBuild=0
-MajorVer=1
-MinorVer=0
-Release=0
-Build=0
-Debug=0
-PreRelease=0
-Special=0
-Private=0
-DLL=0
-Locale=1033
-CodePage=1252
-[Version Info Keys]
-CompanyName=
-FileDescription=
-FileVersion=1.0.0.0
-InternalName=
-LegalCopyright=
-LegalTrademarks=
-OriginalFilename=
-ProductName=
-ProductVersion=1.0.0.0
-Comments=
diff --git a/Source/3rdParty/Orpheus/tests/TestRLbl/project1.dpr b/Source/3rdParty/Orpheus/tests/TestRLbl/project1.dpr
deleted file mode 100644
index 8a2e82e5..00000000
--- a/Source/3rdParty/Orpheus/tests/TestRLbl/project1.dpr
+++ /dev/null
@@ -1,18 +0,0 @@
-program Project1;
-
-uses
-{$IFDEF LCL}
- Interfaces,
-{$ENDIF}
- Forms,
- Unit1 in 'Unit1.pas' {Form1};
-
-{$IFDEF MSWINDOWS}
-{$R *.res}
-{$ENDIF}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Orpheus/tests/TestRLbl/project1.lpi b/Source/3rdParty/Orpheus/tests/TestRLbl/project1.lpi
deleted file mode 100644
index b5aee615..00000000
--- a/Source/3rdParty/Orpheus/tests/TestRLbl/project1.lpi
+++ /dev/null
@@ -1,108 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/tests/TestRLbl/unit1.dfm b/Source/3rdParty/Orpheus/tests/TestRLbl/unit1.dfm
deleted file mode 100644
index cd79d3f9..00000000
--- a/Source/3rdParty/Orpheus/tests/TestRLbl/unit1.dfm
+++ /dev/null
@@ -1,78 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 443
- Height = 327
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'MS Sans Serif'
- Font.Style = []
- OldCreateOrder = False
- PixelsPerInch = 96
- TextHeight = 13
- object OvcRotatedLabel1: TOvcRotatedLabel
- Left = 56
- Top = 32
- Width = 153
- Height = 25
- AutoSize = False
- Caption = 'Not rotated'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -13
- Font.Name = 'Arial'
- Font.Style = []
- ShadowedText = False
- end
- object OvcRotatedLabel2: TOvcRotatedLabel
- Left = 56
- Top = 80
- Width = 153
- Height = 57
- AutoSize = False
- Caption = 'Rotated 15 degrees'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -13
- Font.Name = 'Arial'
- Font.Style = []
- FontAngle = 15
- OriginY = 30
- ShadowedText = False
- end
- object OvcRotatedLabel3: TOvcRotatedLabel
- Left = 56
- Top = 160
- Width = 153
- Height = 57
- AutoSize = False
- Caption = 'Rotated -15 degrees'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -13
- Font.Name = 'Arial'
- Font.Style = []
- FontAngle = -15
- OriginX = 5
- ShadowedText = False
- end
- object OvcRotatedLabel4: TOvcRotatedLabel
- Left = 264
- Top = 32
- Width = 65
- Height = 185
- AutoSize = False
- Caption = 'Rotated 90 degrees'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -13
- Font.Name = 'Arial'
- Font.Style = []
- FontAngle = 90
- OriginY = 175
- ShadowedText = False
- end
-end
diff --git a/Source/3rdParty/Orpheus/tests/TestRLbl/unit1.lfm b/Source/3rdParty/Orpheus/tests/TestRLbl/unit1.lfm
deleted file mode 100644
index 48716a27..00000000
--- a/Source/3rdParty/Orpheus/tests/TestRLbl/unit1.lfm
+++ /dev/null
@@ -1,71 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 435
- Height = 293
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- PixelsPerInch = 96
- object OvcRotatedLabel1: TOvcRotatedLabel
- Left = 56
- Top = 32
- Width = 153
- Height = 25
- AutoSize = False
- Caption = 'Not rotated'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -13
- Font.Style = []
- ShadowedText = False
- end
- object OvcRotatedLabel2: TOvcRotatedLabel
- Left = 56
- Top = 80
- Width = 153
- Height = 57
- AutoSize = False
- Caption = 'Rotated 15 degrees'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -13
- Font.Style = []
- FontAngle = 15
- OriginY = 30
- ShadowedText = False
- end
- object OvcRotatedLabel3: TOvcRotatedLabel
- Left = 56
- Top = 160
- Width = 153
- Height = 57
- AutoSize = False
- Caption = 'Rotated -15 degrees'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -13
- Font.Style = []
- FontAngle = -15
- OriginX = 5
- ShadowedText = False
- end
- object OvcRotatedLabel4: TOvcRotatedLabel
- Left = 264
- Top = 32
- Width = 65
- Height = 185
- AutoSize = False
- Caption = 'Rotated 90 degrees'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -13
- Font.Style = []
- FontAngle = 90
- OriginY = 175
- ShadowedText = False
- end
-end
diff --git a/Source/3rdParty/Orpheus/tests/TestRLbl/unit1.lrs b/Source/3rdParty/Orpheus/tests/TestRLbl/unit1.lrs
deleted file mode 100644
index f86891bd..00000000
--- a/Source/3rdParty/Orpheus/tests/TestRLbl/unit1.lrs
+++ /dev/null
@@ -1,23 +0,0 @@
-LazarusResources.Add('TForm1','FORMDATA',[
- 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#192#0#3'Top'#2'r'#5'Width'#3#179#1#6'Heig'
- +'ht'#3'%'#1#7'Caption'#6#5'Form1'#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7
- +#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245
- +#10'Font.Style'#11#0#13'PixelsPerInch'#2'`'#0#16'TOvcRotatedLabel'#16'OvcRot'
- +'atedLabel1'#4'Left'#2'8'#3'Top'#2' '#5'Width'#3#153#0#6'Height'#2#25#8'Auto'
- +'Size'#8#7'Caption'#6#11'Not rotated'#12'Font.Charset'#7#15'DEFAULT_CHARSET'
- +#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#243#10'Font.Style'#11#0
- +#12'ShadowedText'#8#0#0#16'TOvcRotatedLabel'#16'OvcRotatedLabel2'#4'Left'#2
- +'8'#3'Top'#2'P'#5'Width'#3#153#0#6'Height'#2'9'#8'AutoSize'#8#7'Caption'#6#18
- +'Rotated 15 degrees'#12'Font.Charset'#7#15'DEFAULT_CHARSET'#10'Font.Color'#7
- +#12'clWindowText'#11'Font.Height'#2#243#10'Font.Style'#11#0#9'FontAngle'#2#15
- +#7'OriginY'#2#30#12'ShadowedText'#8#0#0#16'TOvcRotatedLabel'#16'OvcRotatedLa'
- +'bel3'#4'Left'#2'8'#3'Top'#3#160#0#5'Width'#3#153#0#6'Height'#2'9'#8'AutoSiz'
- +'e'#8#7'Caption'#6#19'Rotated -15 degrees'#12'Font.Charset'#7#15'DEFAULT_CHA'
- +'RSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#243#10'Font.Style'
- +#11#0#9'FontAngle'#2#241#7'OriginX'#2#5#12'ShadowedText'#8#0#0#16'TOvcRotate'
- +'dLabel'#16'OvcRotatedLabel4'#4'Left'#3#8#1#3'Top'#2' '#5'Width'#2'A'#6'Heig'
- +'ht'#3#185#0#8'AutoSize'#8#7'Caption'#6#18'Rotated 90 degrees'#12'Font.Chars'
- +'et'#7#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'
- +#2#243#10'Font.Style'#11#0#9'FontAngle'#2'Z'#7'OriginY'#3#175#0#12'ShadowedT'
- +'ext'#8#0#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/tests/TestRLbl/unit1.pas b/Source/3rdParty/Orpheus/tests/TestRLbl/unit1.pas
deleted file mode 100644
index ac9c87b4..00000000
--- a/Source/3rdParty/Orpheus/tests/TestRLbl/unit1.pas
+++ /dev/null
@@ -1,34 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, ovcbase, ovcrlbl;
-
-type
- TForm1 = class(TForm)
- OvcRotatedLabel1: TOvcRotatedLabel;
- OvcRotatedLabel2: TOvcRotatedLabel;
- OvcRotatedLabel3: TOvcRotatedLabel;
- OvcRotatedLabel4: TOvcRotatedLabel;
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.dfm}
-{$ELSE}
-{$R *.lfm}
-{$ENDIF}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/tests/TestSimpField/project1.bdsproj b/Source/3rdParty/Orpheus/tests/TestSimpField/project1.bdsproj
deleted file mode 100644
index 21fa3766..00000000
--- a/Source/3rdParty/Orpheus/tests/TestSimpField/project1.bdsproj
+++ /dev/null
@@ -1,175 +0,0 @@
-
-
-
-
- Delphi.Personality
- VCLApplication
- 1.0
- {CD069137-4C4C-40B2-AAA5-777E14CC0753}
-
-
-
-
- project1.dpr
-
-
- 7.0
-
-
- 8
- 0
- 1
- 1
- 0
- 0
- 1
- 1
- 1
- 0
- 0
- 1
- 0
- 1
- 1
- 1
- 1
- 1
- 0
- 1
- 0
- 1
- 0
- 1
- 1
- 1
- True
- True
- WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-
- False
-
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- False
- False
- False
- True
- True
- True
- True
- True
- True
-
-
-
- 0
- 0
- False
- 1
- False
- False
- False
- 16384
- 1048576
- 4194304
-
-
-
-
-
-
-
- C:\Orpheus4\FPC
- vcl;rtl;vclx;indy;vclie;xmlrtl;inetdbbde;inet;inetdbxpress;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;inetdb;bdertl;vcldbx;adortl;teeui;teedb;tee;ibxpress;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k
-
-
- False
-
-
-
-
-
- False
-
-
- True
- False
-
-
-
- $00000000
-
-
-
- False
- False
- 1
- 0
- 0
- 0
- False
- False
- False
- False
- False
- 1033
- 1252
-
-
-
-
- 1.0.0.0
-
-
-
-
-
- 1.0.0.0
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/tests/TestSimpField/project1.cfg b/Source/3rdParty/Orpheus/tests/TestSimpField/project1.cfg
deleted file mode 100644
index 45be3be1..00000000
--- a/Source/3rdParty/Orpheus/tests/TestSimpField/project1.cfg
+++ /dev/null
@@ -1,38 +0,0 @@
--$A8
--$B-
--$C+
--$D+
--$E-
--$F-
--$G+
--$H+
--$I+
--$J-
--$K-
--$L+
--$M-
--$N+
--$O+
--$P+
--$Q+
--$R+
--$S-
--$T+
--$U-
--$V+
--$W-
--$X+
--$YD
--$Z1
--cg
--AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
--H+
--W+
--M
--$M16384,1048576
--K$00400000
--LE"c:\delphi7\Projects\Bpl"
--LN"c:\delphi7\Projects\Bpl"
--w-UNSAFE_TYPE
--w-UNSAFE_CODE
--w-UNSAFE_CAST
diff --git a/Source/3rdParty/Orpheus/tests/TestSimpField/project1.dof b/Source/3rdParty/Orpheus/tests/TestSimpField/project1.dof
deleted file mode 100644
index a964abf6..00000000
--- a/Source/3rdParty/Orpheus/tests/TestSimpField/project1.dof
+++ /dev/null
@@ -1,136 +0,0 @@
-[FileVersion]
-Version=7.0
-[Compiler]
-A=8
-B=0
-C=1
-D=1
-E=0
-F=0
-G=1
-H=1
-I=1
-J=0
-K=0
-L=1
-M=0
-N=1
-O=1
-P=1
-Q=1
-R=1
-S=0
-T=1
-U=0
-V=1
-W=0
-X=1
-Y=1
-Z=1
-ShowHints=1
-ShowWarnings=1
-UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-NamespacePrefix=
-SymbolDeprecated=1
-SymbolLibrary=1
-SymbolPlatform=1
-UnitLibrary=1
-UnitPlatform=1
-UnitDeprecated=1
-HResultCompat=1
-HidingMember=1
-HiddenVirtual=1
-Garbage=1
-BoundsError=1
-ZeroNilCompat=1
-StringConstTruncated=1
-ForLoopVarVarPar=1
-TypedConstVarPar=1
-AsgToTypedConst=1
-CaseLabelRange=1
-ForVariable=1
-ConstructingAbstract=1
-ComparisonFalse=1
-ComparisonTrue=1
-ComparingSignedUnsigned=1
-CombiningSignedUnsigned=1
-UnsupportedConstruct=1
-FileOpen=1
-FileOpenUnitSrc=1
-BadGlobalSymbol=1
-DuplicateConstructorDestructor=1
-InvalidDirective=1
-PackageNoLink=1
-PackageThreadVar=1
-ImplicitImport=1
-HPPEMITIgnored=1
-NoRetVal=1
-UseBeforeDef=1
-ForLoopVarUndef=1
-UnitNameMismatch=1
-NoCFGFileFound=1
-MessageDirective=1
-ImplicitVariants=1
-UnicodeToLocale=1
-LocaleToUnicode=1
-ImagebaseMultiple=1
-SuspiciousTypecast=1
-PrivatePropAccessor=1
-UnsafeType=0
-UnsafeCode=0
-UnsafeCast=0
-[Linker]
-MapFile=0
-OutputObjs=0
-ConsoleApp=1
-DebugInfo=0
-RemoteSymbols=0
-MinStackSize=16384
-MaxStackSize=1048576
-ImageBase=4194304
-ExeDescription=
-[Directories]
-OutputDir=
-UnitOutputDir=
-PackageDLLOutputDir=
-PackageDCPOutputDir=
-SearchPath=
-Packages=vcl;rtl;vclx;indy;vclie;xmlrtl;inetdbbde;inet;inetdbxpress;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;inetdb;bdertl;vcldbx;adortl;teeui;teedb;tee;ibxpress;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k
-Conditionals=
-DebugSourceDirs=
-UsePackages=0
-[Parameters]
-RunParams=
-HostApplication=
-Launcher=
-UseLauncher=0
-DebugCWD=
-[Language]
-ActiveLang=
-ProjectLang=
-RootDir=
-[Version Info]
-IncludeVerInfo=0
-AutoIncBuild=0
-MajorVer=1
-MinorVer=0
-Release=0
-Build=0
-Debug=0
-PreRelease=0
-Special=0
-Private=0
-DLL=0
-Locale=1033
-CodePage=1252
-[Version Info Keys]
-CompanyName=
-FileDescription=
-FileVersion=1.0.0.0
-InternalName=
-LegalCopyright=
-LegalTrademarks=
-OriginalFilename=
-ProductName=
-ProductVersion=1.0.0.0
-Comments=
diff --git a/Source/3rdParty/Orpheus/tests/TestSimpField/project1.dpr b/Source/3rdParty/Orpheus/tests/TestSimpField/project1.dpr
deleted file mode 100644
index 7e174316..00000000
--- a/Source/3rdParty/Orpheus/tests/TestSimpField/project1.dpr
+++ /dev/null
@@ -1,18 +0,0 @@
-program Project1;
-
-uses
-{$IFDEF LCL}
- Interfaces,
-{$ENDIF}
- Forms,
- Unit1 in 'unit1.pas' {Form1};
-
-{$IFDEF MSWINDOWS}
-{$R *.res}
-{$ENDIF}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Orpheus/tests/TestSimpField/project1.lpi b/Source/3rdParty/Orpheus/tests/TestSimpField/project1.lpi
deleted file mode 100644
index aac4d262..00000000
--- a/Source/3rdParty/Orpheus/tests/TestSimpField/project1.lpi
+++ /dev/null
@@ -1,110 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/tests/TestSimpField/unit1.dfm b/Source/3rdParty/Orpheus/tests/TestSimpField/unit1.dfm
deleted file mode 100644
index 950c035e..00000000
--- a/Source/3rdParty/Orpheus/tests/TestSimpField/unit1.dfm
+++ /dev/null
@@ -1,80 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 423
- Height = 323
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'MS Sans Serif'
- Font.Style = []
- OldCreateOrder = False
- PixelsPerInch = 96
- TextHeight = 13
- object Label1: TLabel
- Left = 16
- Top = 24
- Width = 385
- Height = 33
- Alignment = taCenter
- AutoSize = False
- Caption = 'Enter a positive integer, then move to next control to validate.'
- WordWrap = True
- end
- object Label2: TLabel
- Left = 16
- Top = 104
- Width = 385
- Height = 33
- Alignment = taCenter
- AutoSize = False
- Caption =
- 'Enter a positive real number, then move to next control to valid' +
- 'ate.'
- WordWrap = True
- end
- object OvcSimpleField1: TOvcSimpleField
- Left = 168
- Top = 56
- Width = 81
- Height = 21
- Cursor = crIBeam
- DataType = sftString
- CaretOvr.Shape = csBlock
- ControlCharColor = clRed
- DecimalPlaces = 0
- EFColors.Disabled.BackColor = clWindow
- EFColors.Disabled.TextColor = clGrayText
- EFColors.Error.BackColor = clRed
- EFColors.Error.TextColor = clBlack
- EFColors.Highlight.BackColor = clHighlight
- EFColors.Highlight.TextColor = clHighlightText
- PictureMask = 'X'
- TabOrder = 0
- OnError = OvcSimpleFieldError
- OnUserValidation = OvcSimpleField1UserValidation
- end
- object OvcSimpleField2: TOvcSimpleField
- Left = 168
- Top = 136
- Width = 81
- Height = 21
- Cursor = crIBeam
- DataType = sftString
- CaretOvr.Shape = csBlock
- ControlCharColor = clRed
- DecimalPlaces = 0
- EFColors.Disabled.BackColor = clWindow
- EFColors.Disabled.TextColor = clGrayText
- EFColors.Error.BackColor = clRed
- EFColors.Error.TextColor = clBlack
- EFColors.Highlight.BackColor = clHighlight
- EFColors.Highlight.TextColor = clHighlightText
- PictureMask = 'X'
- TabOrder = 1
- OnError = OvcSimpleFieldError
- OnUserValidation = OvcSimpleField2UserValidation
- end
-end
diff --git a/Source/3rdParty/Orpheus/tests/TestSimpField/unit1.lfm b/Source/3rdParty/Orpheus/tests/TestSimpField/unit1.lfm
deleted file mode 100644
index 5506803c..00000000
--- a/Source/3rdParty/Orpheus/tests/TestSimpField/unit1.lfm
+++ /dev/null
@@ -1,77 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 415
- Height = 289
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- PixelsPerInch = 96
- object Label1: TLabel
- Left = 16
- Top = 24
- Width = 385
- Height = 33
- Alignment = taCenter
- AutoSize = False
- Caption = 'Enter a positive integer, then move to next control to validate.'
- WordWrap = True
- end
- object Label2: TLabel
- Left = 16
- Top = 104
- Width = 385
- Height = 33
- Alignment = taCenter
- AutoSize = False
- Caption =
- 'Enter a positive real number, then move to next control to valid' +
- 'ate.'
- WordWrap = True
- end
- object OvcSimpleField1: TOvcSimpleField
- Left = 168
- Top = 56
- Width = 81
- Height = 21
- Cursor = crIBeam
- DataType = sftString
- CaretOvr.Shape = csBlock
- ControlCharColor = clRed
- DecimalPlaces = 0
- EFColors.Disabled.BackColor = clWindow
- EFColors.Disabled.TextColor = clGrayText
- EFColors.Error.BackColor = clRed
- EFColors.Error.TextColor = clBlack
- EFColors.Highlight.BackColor = clHighlight
- EFColors.Highlight.TextColor = clHighlightText
- PictureMask = 'X'
- TabOrder = 0
- OnError = OvcSimpleFieldError
- OnUserValidation = OvcSimpleField1UserValidation
- end
- object OvcSimpleField2: TOvcSimpleField
- Left = 168
- Top = 136
- Width = 81
- Height = 21
- Cursor = crIBeam
- DataType = sftString
- CaretOvr.Shape = csBlock
- ControlCharColor = clRed
- DecimalPlaces = 0
- EFColors.Disabled.BackColor = clWindow
- EFColors.Disabled.TextColor = clGrayText
- EFColors.Error.BackColor = clRed
- EFColors.Error.TextColor = clBlack
- EFColors.Highlight.BackColor = clHighlight
- EFColors.Highlight.TextColor = clHighlightText
- PictureMask = 'X'
- TabOrder = 1
- OnError = OvcSimpleFieldError
- OnUserValidation = OvcSimpleField2UserValidation
- end
-end
diff --git a/Source/3rdParty/Orpheus/tests/TestSimpField/unit1.lrs b/Source/3rdParty/Orpheus/tests/TestSimpField/unit1.lrs
deleted file mode 100644
index 8cc2f112..00000000
--- a/Source/3rdParty/Orpheus/tests/TestSimpField/unit1.lrs
+++ /dev/null
@@ -1,29 +0,0 @@
-LazarusResources.Add('TForm1','FORMDATA',[
- 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#192#0#3'Top'#2'r'#5'Width'#3#159#1#6'Heig'
- +'ht'#3'!'#1#7'Caption'#6#5'Form1'#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7
- +#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245
- +#10'Font.Style'#11#0#13'PixelsPerInch'#2'`'#0#6'TLabel'#6'Label1'#4'Left'#2
- +#16#3'Top'#2#24#5'Width'#3#129#1#6'Height'#2'!'#9'Alignment'#7#8'taCenter'#8
- +'AutoSize'#8#7'Caption'#6'@Enter a positive integer, then move to next contr'
- +'ol to validate.'#8'WordWrap'#9#0#0#6'TLabel'#6'Label2'#4'Left'#2#16#3'Top'#2
- +'h'#5'Width'#3#129#1#6'Height'#2'!'#9'Alignment'#7#8'taCenter'#8'AutoSize'#8
- +#7'Caption'#6'DEnter a positive real number, then move to next control to va'
- +'lidate.'#8'WordWrap'#9#0#0#15'TOvcSimpleField'#15'OvcSimpleField1'#4'Left'#3
- +#168#0#3'Top'#2'8'#5'Width'#2'Q'#6'Height'#2#21#6'Cursor'#7#7'crIBeam'#8'Dat'
- +'aType'#7#9'sftString'#14'CaretOvr.Shape'#7#7'csBlock'#16'ControlCharColor'#7
- +#5'clRed'#13'DecimalPlaces'#2#0#27'EFColors.Disabled.BackColor'#7#8'clWindow'
- +#27'EFColors.Disabled.TextColor'#7#10'clGrayText'#24'EFColors.Error.BackColo'
- +'r'#7#5'clRed'#24'EFColors.Error.TextColor'#7#7'clBlack'#28'EFColors.Highlig'
- +'ht.BackColor'#7#11'clHighlight'#28'EFColors.Highlight.TextColor'#7#15'clHig'
- +'hlightText'#11'PictureMask'#6#1'X'#8'TabOrder'#2#0#7'OnError'#7#19'OvcSimpl'
- +'eFieldError'#16'OnUserValidation'#7#29'OvcSimpleField1UserValidation'#0#0#15
- +'TOvcSimpleField'#15'OvcSimpleField2'#4'Left'#3#168#0#3'Top'#3#136#0#5'Width'
- +#2'Q'#6'Height'#2#21#6'Cursor'#7#7'crIBeam'#8'DataType'#7#9'sftString'#14'Ca'
- +'retOvr.Shape'#7#7'csBlock'#16'ControlCharColor'#7#5'clRed'#13'DecimalPlaces'
- +#2#0#27'EFColors.Disabled.BackColor'#7#8'clWindow'#27'EFColors.Disabled.Text'
- +'Color'#7#10'clGrayText'#24'EFColors.Error.BackColor'#7#5'clRed'#24'EFColors'
- +'.Error.TextColor'#7#7'clBlack'#28'EFColors.Highlight.BackColor'#7#11'clHigh'
- +'light'#28'EFColors.Highlight.TextColor'#7#15'clHighlightText'#11'PictureMas'
- +'k'#6#1'X'#8'TabOrder'#2#1#7'OnError'#7#19'OvcSimpleFieldError'#16'OnUserVal'
- +'idation'#7#29'OvcSimpleField2UserValidation'#0#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/tests/TestSimpField/unit1.pas b/Source/3rdParty/Orpheus/tests/TestSimpField/unit1.pas
deleted file mode 100644
index 401319b0..00000000
--- a/Source/3rdParty/Orpheus/tests/TestSimpField/unit1.pas
+++ /dev/null
@@ -1,65 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls, ovcbase, ovcdata, ovcef, ovcsf;
-
-type
- TForm1 = class(TForm)
- Label1: TLabel;
- OvcSimpleField1: TOvcSimpleField;
- Label2: TLabel;
- OvcSimpleField2: TOvcSimpleField;
- procedure OvcSimpleField1UserValidation(Sender: TObject;
- var ErrorCode: Word);
- procedure OvcSimpleFieldError(Sender: TObject; ErrorCode: Word;
- ErrorMsg: String);
- procedure OvcSimpleField2UserValidation(Sender: TObject;
- var ErrorCode: Word);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.dfm}
-{$ELSE}
-{$R *.lfm}
-{$ENDIF}
-
-
-procedure TForm1.OvcSimpleField1UserValidation(Sender: TObject;
- var ErrorCode: Word);
-begin
- ErrorCode := 0;
- if (TOvcSimpleField(Sender).Text <> '') and
- (StrToIntDef(TOvcSimpleField(Sender).Text, 0) <= 0) then
- ErrorCode := oeInvalidNumber;
-end;
-
-procedure TForm1.OvcSimpleFieldError(Sender: TObject; ErrorCode: Word;
- ErrorMsg: String);
-begin
- MessageDlg(ErrorMsg + #13#10 + 'Press Ctrl+Z to undo.', mtError, [mbOK], 0);
-end;
-
-procedure TForm1.OvcSimpleField2UserValidation(Sender: TObject;
- var ErrorCode: Word);
-begin
- ErrorCode := 0;
- if (TOvcSimpleField(Sender).Text <> '') and
- (StrToFloatDef(TOvcSimpleField(Sender).Text, 0) <= 0) then
- ErrorCode := oeInvalidNumber;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/tests/TestSpinner/project1.bdsproj b/Source/3rdParty/Orpheus/tests/TestSpinner/project1.bdsproj
deleted file mode 100644
index 21fa3766..00000000
--- a/Source/3rdParty/Orpheus/tests/TestSpinner/project1.bdsproj
+++ /dev/null
@@ -1,175 +0,0 @@
-
-
-
-
- Delphi.Personality
- VCLApplication
- 1.0
- {CD069137-4C4C-40B2-AAA5-777E14CC0753}
-
-
-
-
- project1.dpr
-
-
- 7.0
-
-
- 8
- 0
- 1
- 1
- 0
- 0
- 1
- 1
- 1
- 0
- 0
- 1
- 0
- 1
- 1
- 1
- 1
- 1
- 0
- 1
- 0
- 1
- 0
- 1
- 1
- 1
- True
- True
- WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-
- False
-
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- False
- False
- False
- True
- True
- True
- True
- True
- True
-
-
-
- 0
- 0
- False
- 1
- False
- False
- False
- 16384
- 1048576
- 4194304
-
-
-
-
-
-
-
- C:\Orpheus4\FPC
- vcl;rtl;vclx;indy;vclie;xmlrtl;inetdbbde;inet;inetdbxpress;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;inetdb;bdertl;vcldbx;adortl;teeui;teedb;tee;ibxpress;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k
-
-
- False
-
-
-
-
-
- False
-
-
- True
- False
-
-
-
- $00000000
-
-
-
- False
- False
- 1
- 0
- 0
- 0
- False
- False
- False
- False
- False
- 1033
- 1252
-
-
-
-
- 1.0.0.0
-
-
-
-
-
- 1.0.0.0
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/tests/TestSpinner/project1.cfg b/Source/3rdParty/Orpheus/tests/TestSpinner/project1.cfg
deleted file mode 100644
index 45be3be1..00000000
--- a/Source/3rdParty/Orpheus/tests/TestSpinner/project1.cfg
+++ /dev/null
@@ -1,38 +0,0 @@
--$A8
--$B-
--$C+
--$D+
--$E-
--$F-
--$G+
--$H+
--$I+
--$J-
--$K-
--$L+
--$M-
--$N+
--$O+
--$P+
--$Q+
--$R+
--$S-
--$T+
--$U-
--$V+
--$W-
--$X+
--$YD
--$Z1
--cg
--AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
--H+
--W+
--M
--$M16384,1048576
--K$00400000
--LE"c:\delphi7\Projects\Bpl"
--LN"c:\delphi7\Projects\Bpl"
--w-UNSAFE_TYPE
--w-UNSAFE_CODE
--w-UNSAFE_CAST
diff --git a/Source/3rdParty/Orpheus/tests/TestSpinner/project1.dof b/Source/3rdParty/Orpheus/tests/TestSpinner/project1.dof
deleted file mode 100644
index a964abf6..00000000
--- a/Source/3rdParty/Orpheus/tests/TestSpinner/project1.dof
+++ /dev/null
@@ -1,136 +0,0 @@
-[FileVersion]
-Version=7.0
-[Compiler]
-A=8
-B=0
-C=1
-D=1
-E=0
-F=0
-G=1
-H=1
-I=1
-J=0
-K=0
-L=1
-M=0
-N=1
-O=1
-P=1
-Q=1
-R=1
-S=0
-T=1
-U=0
-V=1
-W=0
-X=1
-Y=1
-Z=1
-ShowHints=1
-ShowWarnings=1
-UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-NamespacePrefix=
-SymbolDeprecated=1
-SymbolLibrary=1
-SymbolPlatform=1
-UnitLibrary=1
-UnitPlatform=1
-UnitDeprecated=1
-HResultCompat=1
-HidingMember=1
-HiddenVirtual=1
-Garbage=1
-BoundsError=1
-ZeroNilCompat=1
-StringConstTruncated=1
-ForLoopVarVarPar=1
-TypedConstVarPar=1
-AsgToTypedConst=1
-CaseLabelRange=1
-ForVariable=1
-ConstructingAbstract=1
-ComparisonFalse=1
-ComparisonTrue=1
-ComparingSignedUnsigned=1
-CombiningSignedUnsigned=1
-UnsupportedConstruct=1
-FileOpen=1
-FileOpenUnitSrc=1
-BadGlobalSymbol=1
-DuplicateConstructorDestructor=1
-InvalidDirective=1
-PackageNoLink=1
-PackageThreadVar=1
-ImplicitImport=1
-HPPEMITIgnored=1
-NoRetVal=1
-UseBeforeDef=1
-ForLoopVarUndef=1
-UnitNameMismatch=1
-NoCFGFileFound=1
-MessageDirective=1
-ImplicitVariants=1
-UnicodeToLocale=1
-LocaleToUnicode=1
-ImagebaseMultiple=1
-SuspiciousTypecast=1
-PrivatePropAccessor=1
-UnsafeType=0
-UnsafeCode=0
-UnsafeCast=0
-[Linker]
-MapFile=0
-OutputObjs=0
-ConsoleApp=1
-DebugInfo=0
-RemoteSymbols=0
-MinStackSize=16384
-MaxStackSize=1048576
-ImageBase=4194304
-ExeDescription=
-[Directories]
-OutputDir=
-UnitOutputDir=
-PackageDLLOutputDir=
-PackageDCPOutputDir=
-SearchPath=
-Packages=vcl;rtl;vclx;indy;vclie;xmlrtl;inetdbbde;inet;inetdbxpress;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;inetdb;bdertl;vcldbx;adortl;teeui;teedb;tee;ibxpress;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k
-Conditionals=
-DebugSourceDirs=
-UsePackages=0
-[Parameters]
-RunParams=
-HostApplication=
-Launcher=
-UseLauncher=0
-DebugCWD=
-[Language]
-ActiveLang=
-ProjectLang=
-RootDir=
-[Version Info]
-IncludeVerInfo=0
-AutoIncBuild=0
-MajorVer=1
-MinorVer=0
-Release=0
-Build=0
-Debug=0
-PreRelease=0
-Special=0
-Private=0
-DLL=0
-Locale=1033
-CodePage=1252
-[Version Info Keys]
-CompanyName=
-FileDescription=
-FileVersion=1.0.0.0
-InternalName=
-LegalCopyright=
-LegalTrademarks=
-OriginalFilename=
-ProductName=
-ProductVersion=1.0.0.0
-Comments=
diff --git a/Source/3rdParty/Orpheus/tests/TestSpinner/project1.dpr b/Source/3rdParty/Orpheus/tests/TestSpinner/project1.dpr
deleted file mode 100644
index 7e174316..00000000
--- a/Source/3rdParty/Orpheus/tests/TestSpinner/project1.dpr
+++ /dev/null
@@ -1,18 +0,0 @@
-program Project1;
-
-uses
-{$IFDEF LCL}
- Interfaces,
-{$ENDIF}
- Forms,
- Unit1 in 'unit1.pas' {Form1};
-
-{$IFDEF MSWINDOWS}
-{$R *.res}
-{$ENDIF}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Orpheus/tests/TestSpinner/project1.lpi b/Source/3rdParty/Orpheus/tests/TestSpinner/project1.lpi
deleted file mode 100644
index aac4d262..00000000
--- a/Source/3rdParty/Orpheus/tests/TestSpinner/project1.lpi
+++ /dev/null
@@ -1,110 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/tests/TestSpinner/unit1.dfm b/Source/3rdParty/Orpheus/tests/TestSpinner/unit1.dfm
deleted file mode 100644
index adf4d98e..00000000
--- a/Source/3rdParty/Orpheus/tests/TestSpinner/unit1.dfm
+++ /dev/null
@@ -1,33 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 423
- Height = 323
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'MS Sans Serif'
- Font.Style = []
- OldCreateOrder = False
- PixelsPerInch = 96
- TextHeight = 13
- object OvcSpinner1: TOvcSpinner
- Left = 144
- Top = 88
- Width = 49
- Height = 65
- AutoRepeat = True
- Delta = 1.000000000000000000
- FocusedControl = Edit1
- end
- object Edit1: TEdit
- Left = 208
- Top = 112
- Width = 57
- Height = 21
- TabOrder = 1
- Text = '0'
- end
-end
diff --git a/Source/3rdParty/Orpheus/tests/TestSpinner/unit1.lfm b/Source/3rdParty/Orpheus/tests/TestSpinner/unit1.lfm
deleted file mode 100644
index e3ce41f6..00000000
--- a/Source/3rdParty/Orpheus/tests/TestSpinner/unit1.lfm
+++ /dev/null
@@ -1,30 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 415
- Height = 289
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- PixelsPerInch = 96
- object OvcSpinner1: TOvcSpinner
- Left = 144
- Top = 88
- Width = 49
- Height = 65
- AutoRepeat = True
- Delta = 1.000000000000000000
- FocusedControl = Edit1
- end
- object Edit1: TEdit
- Left = 208
- Top = 112
- Width = 57
- Height = 21
- TabOrder = 1
- Text = '0'
- end
-end
diff --git a/Source/3rdParty/Orpheus/tests/TestSpinner/unit1.lrs b/Source/3rdParty/Orpheus/tests/TestSpinner/unit1.lrs
deleted file mode 100644
index a72911da..00000000
--- a/Source/3rdParty/Orpheus/tests/TestSpinner/unit1.lrs
+++ /dev/null
@@ -1,10 +0,0 @@
-LazarusResources.Add('TForm1','FORMDATA',[
- 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#192#0#3'Top'#2'r'#5'Width'#3#159#1#6'Heig'
- +'ht'#3'!'#1#7'Caption'#6#5'Form1'#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7
- +#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245
- +#10'Font.Style'#11#0#13'PixelsPerInch'#2'`'#0#11'TOvcSpinner'#11'OvcSpinner1'
- +#4'Left'#3#144#0#3'Top'#2'X'#5'Width'#2'1'#6'Height'#2'A'#10'AutoRepeat'#9#5
- +'Delta'#5#0#0#0#0#0#0#0#128#255'?'#14'FocusedControl'#7#5'Edit1'#0#0#5'TEdit'
- +#5'Edit1'#4'Left'#3#208#0#3'Top'#2'p'#5'Width'#2'9'#6'Height'#2#21#8'TabOrde'
- +'r'#2#1#4'Text'#6#1'0'#0#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/tests/TestSpinner/unit1.pas b/Source/3rdParty/Orpheus/tests/TestSpinner/unit1.pas
deleted file mode 100644
index 27e42b9a..00000000
--- a/Source/3rdParty/Orpheus/tests/TestSpinner/unit1.pas
+++ /dev/null
@@ -1,32 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls, ovcsc, ovcbase;
-
-type
- TForm1 = class(TForm)
- OvcSpinner1: TOvcSpinner;
- Edit1: TEdit;
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.dfm}
-{$ELSE}
-{$R *.lfm}
-{$ENDIF}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/tests/TestTable/manifest.rc b/Source/3rdParty/Orpheus/tests/TestTable/manifest.rc
deleted file mode 100644
index f2751735..00000000
--- a/Source/3rdParty/Orpheus/tests/TestTable/manifest.rc
+++ /dev/null
@@ -1 +0,0 @@
-1 24 project1.exe.manifest
diff --git a/Source/3rdParty/Orpheus/tests/TestTable/project1.bdsproj b/Source/3rdParty/Orpheus/tests/TestTable/project1.bdsproj
deleted file mode 100644
index 21fa3766..00000000
--- a/Source/3rdParty/Orpheus/tests/TestTable/project1.bdsproj
+++ /dev/null
@@ -1,175 +0,0 @@
-
-
-
-
- Delphi.Personality
- VCLApplication
- 1.0
- {CD069137-4C4C-40B2-AAA5-777E14CC0753}
-
-
-
-
- project1.dpr
-
-
- 7.0
-
-
- 8
- 0
- 1
- 1
- 0
- 0
- 1
- 1
- 1
- 0
- 0
- 1
- 0
- 1
- 1
- 1
- 1
- 1
- 0
- 1
- 0
- 1
- 0
- 1
- 1
- 1
- True
- True
- WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-
- False
-
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- False
- False
- False
- True
- True
- True
- True
- True
- True
-
-
-
- 0
- 0
- False
- 1
- False
- False
- False
- 16384
- 1048576
- 4194304
-
-
-
-
-
-
-
- C:\Orpheus4\FPC
- vcl;rtl;vclx;indy;vclie;xmlrtl;inetdbbde;inet;inetdbxpress;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;inetdb;bdertl;vcldbx;adortl;teeui;teedb;tee;ibxpress;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k
-
-
- False
-
-
-
-
-
- False
-
-
- True
- False
-
-
-
- $00000000
-
-
-
- False
- False
- 1
- 0
- 0
- 0
- False
- False
- False
- False
- False
- 1033
- 1252
-
-
-
-
- 1.0.0.0
-
-
-
-
-
- 1.0.0.0
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/tests/TestTable/project1.cfg b/Source/3rdParty/Orpheus/tests/TestTable/project1.cfg
deleted file mode 100644
index 45be3be1..00000000
--- a/Source/3rdParty/Orpheus/tests/TestTable/project1.cfg
+++ /dev/null
@@ -1,38 +0,0 @@
--$A8
--$B-
--$C+
--$D+
--$E-
--$F-
--$G+
--$H+
--$I+
--$J-
--$K-
--$L+
--$M-
--$N+
--$O+
--$P+
--$Q+
--$R+
--$S-
--$T+
--$U-
--$V+
--$W-
--$X+
--$YD
--$Z1
--cg
--AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
--H+
--W+
--M
--$M16384,1048576
--K$00400000
--LE"c:\delphi7\Projects\Bpl"
--LN"c:\delphi7\Projects\Bpl"
--w-UNSAFE_TYPE
--w-UNSAFE_CODE
--w-UNSAFE_CAST
diff --git a/Source/3rdParty/Orpheus/tests/TestTable/project1.dof b/Source/3rdParty/Orpheus/tests/TestTable/project1.dof
deleted file mode 100644
index a964abf6..00000000
--- a/Source/3rdParty/Orpheus/tests/TestTable/project1.dof
+++ /dev/null
@@ -1,136 +0,0 @@
-[FileVersion]
-Version=7.0
-[Compiler]
-A=8
-B=0
-C=1
-D=1
-E=0
-F=0
-G=1
-H=1
-I=1
-J=0
-K=0
-L=1
-M=0
-N=1
-O=1
-P=1
-Q=1
-R=1
-S=0
-T=1
-U=0
-V=1
-W=0
-X=1
-Y=1
-Z=1
-ShowHints=1
-ShowWarnings=1
-UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-NamespacePrefix=
-SymbolDeprecated=1
-SymbolLibrary=1
-SymbolPlatform=1
-UnitLibrary=1
-UnitPlatform=1
-UnitDeprecated=1
-HResultCompat=1
-HidingMember=1
-HiddenVirtual=1
-Garbage=1
-BoundsError=1
-ZeroNilCompat=1
-StringConstTruncated=1
-ForLoopVarVarPar=1
-TypedConstVarPar=1
-AsgToTypedConst=1
-CaseLabelRange=1
-ForVariable=1
-ConstructingAbstract=1
-ComparisonFalse=1
-ComparisonTrue=1
-ComparingSignedUnsigned=1
-CombiningSignedUnsigned=1
-UnsupportedConstruct=1
-FileOpen=1
-FileOpenUnitSrc=1
-BadGlobalSymbol=1
-DuplicateConstructorDestructor=1
-InvalidDirective=1
-PackageNoLink=1
-PackageThreadVar=1
-ImplicitImport=1
-HPPEMITIgnored=1
-NoRetVal=1
-UseBeforeDef=1
-ForLoopVarUndef=1
-UnitNameMismatch=1
-NoCFGFileFound=1
-MessageDirective=1
-ImplicitVariants=1
-UnicodeToLocale=1
-LocaleToUnicode=1
-ImagebaseMultiple=1
-SuspiciousTypecast=1
-PrivatePropAccessor=1
-UnsafeType=0
-UnsafeCode=0
-UnsafeCast=0
-[Linker]
-MapFile=0
-OutputObjs=0
-ConsoleApp=1
-DebugInfo=0
-RemoteSymbols=0
-MinStackSize=16384
-MaxStackSize=1048576
-ImageBase=4194304
-ExeDescription=
-[Directories]
-OutputDir=
-UnitOutputDir=
-PackageDLLOutputDir=
-PackageDCPOutputDir=
-SearchPath=
-Packages=vcl;rtl;vclx;indy;vclie;xmlrtl;inetdbbde;inet;inetdbxpress;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;inetdb;bdertl;vcldbx;adortl;teeui;teedb;tee;ibxpress;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k
-Conditionals=
-DebugSourceDirs=
-UsePackages=0
-[Parameters]
-RunParams=
-HostApplication=
-Launcher=
-UseLauncher=0
-DebugCWD=
-[Language]
-ActiveLang=
-ProjectLang=
-RootDir=
-[Version Info]
-IncludeVerInfo=0
-AutoIncBuild=0
-MajorVer=1
-MinorVer=0
-Release=0
-Build=0
-Debug=0
-PreRelease=0
-Special=0
-Private=0
-DLL=0
-Locale=1033
-CodePage=1252
-[Version Info Keys]
-CompanyName=
-FileDescription=
-FileVersion=1.0.0.0
-InternalName=
-LegalCopyright=
-LegalTrademarks=
-OriginalFilename=
-ProductName=
-ProductVersion=1.0.0.0
-Comments=
diff --git a/Source/3rdParty/Orpheus/tests/TestTable/project1.dpr b/Source/3rdParty/Orpheus/tests/TestTable/project1.dpr
deleted file mode 100644
index bd55dc21..00000000
--- a/Source/3rdParty/Orpheus/tests/TestTable/project1.dpr
+++ /dev/null
@@ -1,22 +0,0 @@
-program Project1;
-
-uses
-{$IFDEF LCL}
- Interfaces,
-{$ENDIF}
- Forms,
- Unit1 in 'Unit1.pas' {Form1};
-
-{$IFDEF MSWINDOWS}
-{$R *.res} {Include program's icon resource file}
-{$ENDIF}
-
-{$IFNDEF FPC} //With FPC, assume .exe can find .manifest file at runtime
-{$R manifest.res} {Include program's manifest in .exe for XP theme support}
-{$ENDIF}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Orpheus/tests/TestTable/project1.exe.manifest b/Source/3rdParty/Orpheus/tests/TestTable/project1.exe.manifest
deleted file mode 100644
index 3a04c418..00000000
--- a/Source/3rdParty/Orpheus/tests/TestTable/project1.exe.manifest
+++ /dev/null
@@ -1,23 +0,0 @@
-
-
-
-
-
- project1
-
-
-
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/tests/TestTable/project1.lpi b/Source/3rdParty/Orpheus/tests/TestTable/project1.lpi
deleted file mode 100644
index fc9c9739..00000000
--- a/Source/3rdParty/Orpheus/tests/TestTable/project1.lpi
+++ /dev/null
@@ -1,108 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/tests/TestTable/unit1.dfm b/Source/3rdParty/Orpheus/tests/TestTable/unit1.dfm
deleted file mode 100644
index c81c7c7d..00000000
--- a/Source/3rdParty/Orpheus/tests/TestTable/unit1.dfm
+++ /dev/null
@@ -1,142 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 816
- Height = 480
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'Arial'
- Font.Style = []
- OldCreateOrder = False
- Position = poScreenCenter
- OnCreate = FormCreate
- OnDestroy = FormDestroy
- DesignSize = (
- 808
- 446)
- PixelsPerInch = 96
- TextHeight = 14
- object OvcTable1: TOvcTable
- Left = 16
- Top = 16
- Width = 777
- Height = 409
- Anchors = [akLeft, akTop, akRight, akBottom]
- Color = clWindow
- Controller = OvcController1
- GridPenSet.NormalGrid.NormalColor = clBtnShadow
- GridPenSet.NormalGrid.Style = psDot
- GridPenSet.NormalGrid.Effect = geBoth
- GridPenSet.LockedGrid.NormalColor = clBtnShadow
- GridPenSet.LockedGrid.Style = psSolid
- GridPenSet.LockedGrid.Effect = ge3D
- GridPenSet.CellWhenFocused.NormalColor = clBlack
- GridPenSet.CellWhenFocused.Style = psSolid
- GridPenSet.CellWhenFocused.Effect = geBoth
- GridPenSet.CellWhenUnfocused.NormalColor = clBlack
- GridPenSet.CellWhenUnfocused.Style = psDash
- GridPenSet.CellWhenUnfocused.Effect = geBoth
- LockedRowsCell = OvcTCColHead1
- Options = [otoNoRowResizing, otoNoColResizing, otoTabToArrow, otoEnterToArrow, otoAlwaysEditing, otoNoSelection, otoThumbTrack]
- TabOrder = 0
- OnGetCellData = OvcTable1GetCellData
- CellData = (
- 'Form1.OvcTCColHead1'
- 'Form1.OvcTCRowHead1'
- 'Form1.OvcTCString1'
- 'Form1.OvcTCMemo1'
- 'Form1.OvcTCCheckBox1'
- 'Form1.OvcTCComboBox1'
- 'Form1.OvcTCBitMap1')
- RowData = (
- 35)
- ColData = (
- 120
- False
- True
- 'Form1.OvcTCRowHead1'
- 100
- False
- True
- 'Form1.OvcTCString1'
- 150
- False
- True
- 'Form1.OvcTCMemo1'
- 120
- False
- True
- 'Form1.OvcTCCheckBox1'
- 160
- False
- True
- 'Form1.OvcTCComboBox1'
- 100
- False
- True
- 'Form1.OvcTCBitMap1')
- end
- object OvcTCColHead1: TOvcTCColHead
- Headings.Strings = (
- 'TOvcTCRowHead'
- 'TOvcTCString'
- 'TOvcTCMemo'
- 'TOvcTCCheckBox'
- 'TOvcTCComboBox'
- 'TOvcTCBitmap')
- ShowLetters = False
- Adjust = otaCenter
- Table = OvcTable1
- Left = 48
- end
- object OvcTCRowHead1: TOvcTCRowHead
- Adjust = otaCenter
- Table = OvcTable1
- Left = 80
- end
- object OvcTCString1: TOvcTCString
- AutoAdvanceLeftRight = True
- Table = OvcTable1
- Left = 144
- end
- object OvcTCMemo1: TOvcTCMemo
- Table = OvcTable1
- Left = 264
- end
- object OvcTCCheckBox1: TOvcTCCheckBox
- Adjust = otaCenter
- CellGlyphs.IsDefault = True
- CellGlyphs.GlyphCount = 3
- CellGlyphs.ActiveGlyphCount = 2
- Table = OvcTable1
- Left = 384
- end
- object OvcTCComboBox1: TOvcTCComboBox
- Style = csDropDownList
- Table = OvcTable1
- OnChange = OvcTCComboBox1Change
- Left = 512
- end
- object OvcTCBitMap1: TOvcTCBitMap
- Adjust = otaTopCenter
- Table = OvcTable1
- Left = 624
- end
- object OvcController1: TOvcController
- EntryCommands.TableList = (
- 'Default'
- True
- ()
- 'WordStar'
- False
- ()
- 'Grid'
- False
- ())
- Epoch = 2000
- Left = 16
- end
-end
diff --git a/Source/3rdParty/Orpheus/tests/TestTable/unit1.lfm b/Source/3rdParty/Orpheus/tests/TestTable/unit1.lfm
deleted file mode 100644
index 0bd379aa..00000000
--- a/Source/3rdParty/Orpheus/tests/TestTable/unit1.lfm
+++ /dev/null
@@ -1,136 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 808
- Height = 446
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- Position = poScreenCenter
- OnCreate = FormCreate
- OnDestroy = FormDestroy
- PixelsPerInch = 96
- object OvcTable1: TOvcTable
- Left = 16
- Top = 16
- Width = 777
- Height = 409
- Anchors = [akLeft, akTop, akRight, akBottom]
- Color = clWindow
- Controller = OvcController1
- GridPenSet.NormalGrid.NormalColor = clBtnShadow
- GridPenSet.NormalGrid.Style = psDot
- GridPenSet.NormalGrid.Effect = geBoth
- GridPenSet.LockedGrid.NormalColor = clBtnShadow
- GridPenSet.LockedGrid.Style = psSolid
- GridPenSet.LockedGrid.Effect = ge3D
- GridPenSet.CellWhenFocused.NormalColor = clBlack
- GridPenSet.CellWhenFocused.Style = psSolid
- GridPenSet.CellWhenFocused.Effect = geBoth
- GridPenSet.CellWhenUnfocused.NormalColor = clBlack
- GridPenSet.CellWhenUnfocused.Style = psDash
- GridPenSet.CellWhenUnfocused.Effect = geBoth
- LockedRowsCell = OvcTCColHead1
- Options = [otoNoRowResizing, otoNoColResizing, otoTabToArrow, otoEnterToArrow, otoAlwaysEditing, otoNoSelection, otoThumbTrack]
- TabOrder = 0
- OnGetCellData = OvcTable1GetCellData
- CellData = (
- 'Form1.OvcTCColHead1'
- 'Form1.OvcTCRowHead1'
- 'Form1.OvcTCString1'
- 'Form1.OvcTCMemo1'
- 'Form1.OvcTCCheckBox1'
- 'Form1.OvcTCComboBox1'
- 'Form1.OvcTCBitMap1')
- RowData = (
- 35)
- ColData = (
- 120
- False
- True
- 'Form1.OvcTCRowHead1'
- 100
- False
- True
- 'Form1.OvcTCString1'
- 150
- False
- True
- 'Form1.OvcTCMemo1'
- 120
- False
- True
- 'Form1.OvcTCCheckBox1'
- 160
- False
- True
- 'Form1.OvcTCComboBox1'
- 100
- False
- True
- 'Form1.OvcTCBitMap1')
- end
- object OvcTCColHead1: TOvcTCColHead
- Headings.Strings = (
- 'TOvcTCRowHead'
- 'TOvcTCString'
- 'TOvcTCMemo'
- 'TOvcTCCheckBox'
- 'TOvcTCComboBox'
- 'TOvcTCBitmap')
- ShowLetters = False
- Adjust = otaCenter
- Table = OvcTable1
- Left = 48
- end
- object OvcTCRowHead1: TOvcTCRowHead
- Adjust = otaCenter
- Table = OvcTable1
- Left = 80
- end
- object OvcTCString1: TOvcTCString
- AutoAdvanceLeftRight = True
- Table = OvcTable1
- Left = 144
- end
- object OvcTCMemo1: TOvcTCMemo
- Table = OvcTable1
- Left = 264
- end
- object OvcTCCheckBox1: TOvcTCCheckBox
- Adjust = otaCenter
- CellGlyphs.IsDefault = True
- CellGlyphs.GlyphCount = 3
- CellGlyphs.ActiveGlyphCount = 2
- Table = OvcTable1
- Left = 384
- end
- object OvcTCComboBox1: TOvcTCComboBox
- Style = csDropDownList
- Table = OvcTable1
- OnChange = OvcTCComboBox1Change
- Left = 512
- end
- object OvcTCBitMap1: TOvcTCBitMap
- Adjust = otaTopCenter
- Table = OvcTable1
- Left = 624
- end
- object OvcController1: TOvcController
- EntryCommands.TableList = (
- 'Default'
- True
- ()
- 'WordStar'
- False
- ()
- 'Grid'
- False
- ())
- Epoch = 2000
- Left = 16
- end
-end
diff --git a/Source/3rdParty/Orpheus/tests/TestTable/unit1.lrs b/Source/3rdParty/Orpheus/tests/TestTable/unit1.lrs
deleted file mode 100644
index bea33cf0..00000000
--- a/Source/3rdParty/Orpheus/tests/TestTable/unit1.lrs
+++ /dev/null
@@ -1,42 +0,0 @@
-LazarusResources.Add('TForm1','FORMDATA',[
- 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#192#0#3'Top'#2'r'#5'Width'#3'('#3#6'Heigh'
- +'t'#3#190#1#7'Caption'#6#5'Form1'#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7
- +#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245
- +#10'Font.Style'#11#0#8'Position'#7#14'poScreenCenter'#8'OnCreate'#7#10'FormC'
- +'reate'#9'OnDestroy'#7#11'FormDestroy'#13'PixelsPerInch'#2'`'#0#9'TOvcTable'
- +#9'OvcTable1'#4'Left'#2#16#3'Top'#2#16#5'Width'#3#9#3#6'Height'#3#153#1#7'An'
- +'chors'#11#6'akLeft'#5'akTop'#7'akRight'#8'akBottom'#0#5'Color'#7#8'clWindow'
- +#10'Controller'#7#14'OvcController1!GridPenSet.NormalGrid.NormalColor'#7#11
- +'clBtnShadow'#27'GridPenSet.NormalGrid.Style'#7#5'psDot'#28'GridPenSet.Norma'
- +'lGrid.Effect'#7#6'geBoth!GridPenSet.LockedGrid.NormalColor'#7#11'clBtnShado'
- +'w'#27'GridPenSet.LockedGrid.Style'#7#7'psSolid'#28'GridPenSet.LockedGrid.Ef'
- +'fect'#7#4'ge3D&GridPenSet.CellWhenFocused.NormalColor'#7#7'clBlack GridPenS'
- +'et.CellWhenFocused.Style'#7#7'psSolid!GridPenSet.CellWhenFocused.Effect'#7#6
- +'geBoth(GridPenSet.CellWhenUnfocused.NormalColor'#7#7'clBlack"GridPenSet.Cel'
- +'lWhenUnfocused.Style'#7#6'psDash#GridPenSet.CellWhenUnfocused.Effect'#7#6'g'
- +'eBoth'#14'LockedRowsCell'#7#13'OvcTCColHead1'#7'Options'#11#16'otoNoRowResi'
- +'zing'#16'otoNoColResizing'#13'otoTabToArrow'#15'otoEnterToArrow'#16'otoAlwa'
- +'ysEditing'#14'otoNoSelection'#13'otoThumbTrack'#0#8'TabOrder'#2#0#13'OnGetC'
- +'ellData'#7#20'OvcTable1GetCellData'#8'CellData'#1#6#19'Form1.OvcTCColHead1'
- +#6#19'Form1.OvcTCRowHead1'#6#18'Form1.OvcTCString1'#6#16'Form1.OvcTCMemo1'#6
- +#20'Form1.OvcTCCheckBox1'#6#20'Form1.OvcTCComboBox1'#6#18'Form1.OvcTCBitMap1'
- +#0#7'RowData'#1#2'#'#0#7'ColData'#1#2'x'#8#9#6#19'Form1.OvcTCRowHead1'#2'd'#8
- +#9#6#18'Form1.OvcTCString1'#3#150#0#8#9#6#16'Form1.OvcTCMemo1'#2'x'#8#9#6#20
- +'Form1.OvcTCCheckBox1'#3#160#0#8#9#6#20'Form1.OvcTCComboBox1'#2'd'#8#9#6#18
- +'Form1.OvcTCBitMap1'#0#0#0#13'TOvcTCColHead'#13'OvcTCColHead1'#16'Headings.S'
- +'trings'#1#6#13'TOvcTCRowHead'#6#12'TOvcTCString'#6#10'TOvcTCMemo'#6#14'TOvc'
- +'TCCheckBox'#6#14'TOvcTCComboBox'#6#12'TOvcTCBitmap'#0#11'ShowLetters'#8#6'A'
- +'djust'#7#9'otaCenter'#5'Table'#7#9'OvcTable1'#4'Left'#2'0'#0#0#13'TOvcTCRow'
- +'Head'#13'OvcTCRowHead1'#6'Adjust'#7#9'otaCenter'#5'Table'#7#9'OvcTable1'#4
- +'Left'#2'P'#0#0#12'TOvcTCString'#12'OvcTCString1'#20'AutoAdvanceLeftRight'#9
- +#5'Table'#7#9'OvcTable1'#4'Left'#3#144#0#0#0#10'TOvcTCMemo'#10'OvcTCMemo1'#5
- +'Table'#7#9'OvcTable1'#4'Left'#3#8#1#0#0#14'TOvcTCCheckBox'#14'OvcTCCheckBox'
- +'1'#6'Adjust'#7#9'otaCenter'#20'CellGlyphs.IsDefault'#9#21'CellGlyphs.GlyphC'
- +'ount'#2#3#27'CellGlyphs.ActiveGlyphCount'#2#2#5'Table'#7#9'OvcTable1'#4'Lef'
- +'t'#3#128#1#0#0#14'TOvcTCComboBox'#14'OvcTCComboBox1'#5'Style'#7#14'csDropDo'
- +'wnList'#5'Table'#7#9'OvcTable1'#8'OnChange'#7#20'OvcTCComboBox1Change'#4'Le'
- +'ft'#3#0#2#0#0#12'TOvcTCBitMap'#12'OvcTCBitMap1'#6'Adjust'#7#12'otaTopCenter'
- +#5'Table'#7#9'OvcTable1'#4'Left'#3'p'#2#0#0#14'TOvcController'#14'OvcControl'
- +'ler1'#23'EntryCommands.TableList'#1#6#7'Default'#9#1#0#6#8'WordStar'#8#1#0#6
- +#4'Grid'#8#1#0#0#5'Epoch'#3#208#7#4'Left'#2#16#0#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/tests/TestTable/unit1.pas b/Source/3rdParty/Orpheus/tests/TestTable/unit1.pas
deleted file mode 100644
index 8d0fe64e..00000000
--- a/Source/3rdParty/Orpheus/tests/TestTable/unit1.pas
+++ /dev/null
@@ -1,152 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
- ovcbase, ovctcbmp, ovctccbx, ovctcgly, ovctcbox, ovctcedt,
- ovctchdr, ovctcmmn, ovctcell, ovctcstr, ovctable;
-
-const
- MaxDataRecs = 20;
- MaxStrLen = 100;
- MaxMemoLen = 1000;
- cnStr = 1; {Column numbers for controls}
- cnMemo = 2;
- cnCheckbox = 3;
- cnCombo = 4;
- cnBitmap = 5;
-
-type
- TDataRec = record
- Str : string[MaxStrLen];
- Memo : array[0..MaxMemoLen] of Char;
- Check : TCheckBoxState;
- ComboIndex : Integer;
- Bitmap : TBitmap;
- end;
-
- TDataArray = array[1..MaxDataRecs] of TDataRec;
-
- TForm1 = class(TForm)
- OvcTable1: TOvcTable;
- OvcController1: TOvcController;
- OvcTCColHead1: TOvcTCColHead;
- OvcTCRowHead1: TOvcTCRowHead;
- OvcTCString1: TOvcTCString;
- OvcTCMemo1: TOvcTCMemo;
- OvcTCCheckBox1: TOvcTCCheckBox;
- OvcTCComboBox1: TOvcTCComboBox;
- OvcTCBitMap1: TOvcTCBitMap;
- procedure FormCreate(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure OvcTable1GetCellData(Sender: TObject; RowNum,
- ColNum: Integer; var Data: Pointer; Purpose: TOvcCellDataPurpose);
- procedure OvcTCComboBox1Change(Sender: TObject);
- private
- BmpPath : string; {Path to Orpheus .bmp files}
- DataArray : TDataArray; {A place to store data entered in table}
- public
- end;
-
-var
- Form1: TForm1;
-
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.dfm} {Link Delphi form file}
-{$ELSE}
-{$R *.lfm}
-{$ENDIF}
-
-procedure TForm1.FormCreate(Sender: TObject);
- {Initialize the main form.
- Do anything that needs to be done before the form
- can be displayed.}
-var
- SearchResult : Integer;
- SearchRec : TSearchRec;
-begin
- OvcTable1.RowLimit := MaxDataRecs + OvcTable1.LockedRows;
-
- OvcTCString1.MaxLength := MaxStrLen; {Be sure to set this here or in form}
- OvcTCMemo1.MaxLength := MaxMemoLen;
-
- {Populate cell combo box with names of Orpheus control bitmap files.
- Assumes bitmap files are two levels up from program with Windows and GTK
- or five levels up with OS X app bundle folder.}
- BmpPath := ExtractFilePath(ParamStr(0)) + '..' + PathDelim + '..' + PathDelim;
- if FindFirst(BmpPath + 'TO*.bmp', 0, SearchRec) <> 0 then
- begin
- BmpPath := '..' + PathDelim + '..' + PathDelim;
- if FindFirst(BmpPath + 'TO*.bmp', 0, SearchRec) <> 0 then
- BmpPath := ExtractFilePath(ParamStr(0)) + '..' + PathDelim + '..' +
- PathDelim + '..' + PathDelim + '..' + PathDelim + '..' + PathDelim;
- end;
- OvcTCComboBox1.Items.Add(' (None)'); {So we can "unselect"}
- try
- SearchResult := FindFirst(BmpPath + 'TO*.bmp', 0, SearchRec);
- while SearchResult = 0 do {Do until no more matching files found}
- begin
- OvcTCComboBox1.Items.Add(SearchRec.Name);
- SearchResult := FindNext(SearchRec);
- end;
- finally
- FindClose(SearchRec);
- end;
-end; {TForm1.FormCreate}
-
-
-procedure TForm1.FormDestroy(Sender: TObject);
-var
- RecNum : Integer;
-begin
- for RecNum := 1 to MaxDataRecs do {Free any TBitmap's created}
- DataArray[RecNum].Bitmap.Free;
-end; {TForm1.FormDestroy}
-
-
-procedure TForm1.OvcTable1GetCellData(Sender: TObject; RowNum,
- ColNum: Integer; var Data: Pointer; Purpose: TOvcCellDataPurpose);
- {This event handler is called when the table needs data to display
- or edit in a cell or a place to save a cell's edited data.}
-begin
- Data := nil;
- if (RowNum < OvcTable1.LockedRows) or (RowNum > OvcTable1.RowLimit) then
- Exit;
-
- case ColNum of
- cnStr : Data := @DataArray[RowNum].Str;
- cnMemo : Data := @DataArray[RowNum].Memo;
- cnCheckbox : Data := @DataArray[RowNum].Check;
- cnCombo : Data := @DataArray[RowNum].ComboIndex;
- cnBitmap : Data := pointer(DataArray[RowNum].Bitmap);
- end;
-end; {TForm1.OvcTable1GetCellData}
-
-
-procedure TForm1.OvcTCComboBox1Change(Sender: TObject);
- {This event handler is called whenever combo box selection
- changes.
- Note: TOvcTCComboBox is not descended from TCustomComboBox, but
- its editing control (Sender) is, so okay to typecast it in order
- to reference ItemIndex.}
-begin
- DataArray[OvcTable1.ActiveRow].Bitmap.Free;
- DataArray[OvcTable1.ActiveRow].Bitmap := nil;
- if TCustomComboBox(Sender).ItemIndex > 0 then {Bitmap file selected?}
- begin
- DataArray[OvcTable1.ActiveRow].Bitmap := TBitmap.Create;
- DataArray[OvcTable1.ActiveRow].Bitmap.LoadFromFile(
- BmpPath + OvcTCComboBox1.Items[TCustomComboBox(Sender).ItemIndex]);
- end;
- OvcTable1.AllowRedraw := False;
- OvcTable1.InvalidateCell(OvcTable1.ActiveRow, cnBitmap); {Force display of bitmap}
- OvcTable1.AllowRedraw := True;
-end; {TForm1.OvcTCComboBox1Change}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/tests/TestTblEdits/manifest.rc b/Source/3rdParty/Orpheus/tests/TestTblEdits/manifest.rc
deleted file mode 100644
index f2751735..00000000
--- a/Source/3rdParty/Orpheus/tests/TestTblEdits/manifest.rc
+++ /dev/null
@@ -1 +0,0 @@
-1 24 project1.exe.manifest
diff --git a/Source/3rdParty/Orpheus/tests/TestTblEdits/project1.bdsproj b/Source/3rdParty/Orpheus/tests/TestTblEdits/project1.bdsproj
deleted file mode 100644
index 21fa3766..00000000
--- a/Source/3rdParty/Orpheus/tests/TestTblEdits/project1.bdsproj
+++ /dev/null
@@ -1,175 +0,0 @@
-
-
-
-
- Delphi.Personality
- VCLApplication
- 1.0
- {CD069137-4C4C-40B2-AAA5-777E14CC0753}
-
-
-
-
- project1.dpr
-
-
- 7.0
-
-
- 8
- 0
- 1
- 1
- 0
- 0
- 1
- 1
- 1
- 0
- 0
- 1
- 0
- 1
- 1
- 1
- 1
- 1
- 0
- 1
- 0
- 1
- 0
- 1
- 1
- 1
- True
- True
- WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-
- False
-
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- False
- False
- False
- True
- True
- True
- True
- True
- True
-
-
-
- 0
- 0
- False
- 1
- False
- False
- False
- 16384
- 1048576
- 4194304
-
-
-
-
-
-
-
- C:\Orpheus4\FPC
- vcl;rtl;vclx;indy;vclie;xmlrtl;inetdbbde;inet;inetdbxpress;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;inetdb;bdertl;vcldbx;adortl;teeui;teedb;tee;ibxpress;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k
-
-
- False
-
-
-
-
-
- False
-
-
- True
- False
-
-
-
- $00000000
-
-
-
- False
- False
- 1
- 0
- 0
- 0
- False
- False
- False
- False
- False
- 1033
- 1252
-
-
-
-
- 1.0.0.0
-
-
-
-
-
- 1.0.0.0
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/tests/TestTblEdits/project1.cfg b/Source/3rdParty/Orpheus/tests/TestTblEdits/project1.cfg
deleted file mode 100644
index 45be3be1..00000000
--- a/Source/3rdParty/Orpheus/tests/TestTblEdits/project1.cfg
+++ /dev/null
@@ -1,38 +0,0 @@
--$A8
--$B-
--$C+
--$D+
--$E-
--$F-
--$G+
--$H+
--$I+
--$J-
--$K-
--$L+
--$M-
--$N+
--$O+
--$P+
--$Q+
--$R+
--$S-
--$T+
--$U-
--$V+
--$W-
--$X+
--$YD
--$Z1
--cg
--AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
--H+
--W+
--M
--$M16384,1048576
--K$00400000
--LE"c:\delphi7\Projects\Bpl"
--LN"c:\delphi7\Projects\Bpl"
--w-UNSAFE_TYPE
--w-UNSAFE_CODE
--w-UNSAFE_CAST
diff --git a/Source/3rdParty/Orpheus/tests/TestTblEdits/project1.dof b/Source/3rdParty/Orpheus/tests/TestTblEdits/project1.dof
deleted file mode 100644
index a964abf6..00000000
--- a/Source/3rdParty/Orpheus/tests/TestTblEdits/project1.dof
+++ /dev/null
@@ -1,136 +0,0 @@
-[FileVersion]
-Version=7.0
-[Compiler]
-A=8
-B=0
-C=1
-D=1
-E=0
-F=0
-G=1
-H=1
-I=1
-J=0
-K=0
-L=1
-M=0
-N=1
-O=1
-P=1
-Q=1
-R=1
-S=0
-T=1
-U=0
-V=1
-W=0
-X=1
-Y=1
-Z=1
-ShowHints=1
-ShowWarnings=1
-UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-NamespacePrefix=
-SymbolDeprecated=1
-SymbolLibrary=1
-SymbolPlatform=1
-UnitLibrary=1
-UnitPlatform=1
-UnitDeprecated=1
-HResultCompat=1
-HidingMember=1
-HiddenVirtual=1
-Garbage=1
-BoundsError=1
-ZeroNilCompat=1
-StringConstTruncated=1
-ForLoopVarVarPar=1
-TypedConstVarPar=1
-AsgToTypedConst=1
-CaseLabelRange=1
-ForVariable=1
-ConstructingAbstract=1
-ComparisonFalse=1
-ComparisonTrue=1
-ComparingSignedUnsigned=1
-CombiningSignedUnsigned=1
-UnsupportedConstruct=1
-FileOpen=1
-FileOpenUnitSrc=1
-BadGlobalSymbol=1
-DuplicateConstructorDestructor=1
-InvalidDirective=1
-PackageNoLink=1
-PackageThreadVar=1
-ImplicitImport=1
-HPPEMITIgnored=1
-NoRetVal=1
-UseBeforeDef=1
-ForLoopVarUndef=1
-UnitNameMismatch=1
-NoCFGFileFound=1
-MessageDirective=1
-ImplicitVariants=1
-UnicodeToLocale=1
-LocaleToUnicode=1
-ImagebaseMultiple=1
-SuspiciousTypecast=1
-PrivatePropAccessor=1
-UnsafeType=0
-UnsafeCode=0
-UnsafeCast=0
-[Linker]
-MapFile=0
-OutputObjs=0
-ConsoleApp=1
-DebugInfo=0
-RemoteSymbols=0
-MinStackSize=16384
-MaxStackSize=1048576
-ImageBase=4194304
-ExeDescription=
-[Directories]
-OutputDir=
-UnitOutputDir=
-PackageDLLOutputDir=
-PackageDCPOutputDir=
-SearchPath=
-Packages=vcl;rtl;vclx;indy;vclie;xmlrtl;inetdbbde;inet;inetdbxpress;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;inetdb;bdertl;vcldbx;adortl;teeui;teedb;tee;ibxpress;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k
-Conditionals=
-DebugSourceDirs=
-UsePackages=0
-[Parameters]
-RunParams=
-HostApplication=
-Launcher=
-UseLauncher=0
-DebugCWD=
-[Language]
-ActiveLang=
-ProjectLang=
-RootDir=
-[Version Info]
-IncludeVerInfo=0
-AutoIncBuild=0
-MajorVer=1
-MinorVer=0
-Release=0
-Build=0
-Debug=0
-PreRelease=0
-Special=0
-Private=0
-DLL=0
-Locale=1033
-CodePage=1252
-[Version Info Keys]
-CompanyName=
-FileDescription=
-FileVersion=1.0.0.0
-InternalName=
-LegalCopyright=
-LegalTrademarks=
-OriginalFilename=
-ProductName=
-ProductVersion=1.0.0.0
-Comments=
diff --git a/Source/3rdParty/Orpheus/tests/TestTblEdits/project1.dpr b/Source/3rdParty/Orpheus/tests/TestTblEdits/project1.dpr
deleted file mode 100644
index bd55dc21..00000000
--- a/Source/3rdParty/Orpheus/tests/TestTblEdits/project1.dpr
+++ /dev/null
@@ -1,22 +0,0 @@
-program Project1;
-
-uses
-{$IFDEF LCL}
- Interfaces,
-{$ENDIF}
- Forms,
- Unit1 in 'Unit1.pas' {Form1};
-
-{$IFDEF MSWINDOWS}
-{$R *.res} {Include program's icon resource file}
-{$ENDIF}
-
-{$IFNDEF FPC} //With FPC, assume .exe can find .manifest file at runtime
-{$R manifest.res} {Include program's manifest in .exe for XP theme support}
-{$ENDIF}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Orpheus/tests/TestTblEdits/project1.exe.manifest b/Source/3rdParty/Orpheus/tests/TestTblEdits/project1.exe.manifest
deleted file mode 100644
index 3a04c418..00000000
--- a/Source/3rdParty/Orpheus/tests/TestTblEdits/project1.exe.manifest
+++ /dev/null
@@ -1,23 +0,0 @@
-
-
-
-
-
- project1
-
-
-
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/tests/TestTblEdits/project1.lpi b/Source/3rdParty/Orpheus/tests/TestTblEdits/project1.lpi
deleted file mode 100644
index fc9c9739..00000000
--- a/Source/3rdParty/Orpheus/tests/TestTblEdits/project1.lpi
+++ /dev/null
@@ -1,108 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/tests/TestTblEdits/unit1.dfm b/Source/3rdParty/Orpheus/tests/TestTblEdits/unit1.dfm
deleted file mode 100644
index 15fd404d..00000000
--- a/Source/3rdParty/Orpheus/tests/TestTblEdits/unit1.dfm
+++ /dev/null
@@ -1,141 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 776
- Height = 480
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'Arial'
- Font.Style = []
- OldCreateOrder = False
- OnCreate = FormCreate
- OnDestroy = FormDestroy
- DesignSize = (
- 768
- 446)
- PixelsPerInch = 96
- TextHeight = 14
- object OvcTable1: TOvcTable
- Left = 16
- Top = 16
- Width = 737
- Height = 409
- Anchors = [akLeft, akTop, akRight, akBottom]
- Color = clWindow
- Controller = OvcController1
- GridPenSet.NormalGrid.NormalColor = clBtnShadow
- GridPenSet.NormalGrid.Style = psDot
- GridPenSet.NormalGrid.Effect = geBoth
- GridPenSet.LockedGrid.NormalColor = clBtnShadow
- GridPenSet.LockedGrid.Style = psSolid
- GridPenSet.LockedGrid.Effect = ge3D
- GridPenSet.CellWhenFocused.NormalColor = clBlack
- GridPenSet.CellWhenFocused.Style = psSolid
- GridPenSet.CellWhenFocused.Effect = geBoth
- GridPenSet.CellWhenUnfocused.NormalColor = clBlack
- GridPenSet.CellWhenUnfocused.Style = psDash
- GridPenSet.CellWhenUnfocused.Effect = geBoth
- LockedRowsCell = OvcTCColHead1
- Options = [otoNoRowResizing, otoNoColResizing, otoTabToArrow, otoEnterToArrow, otoAlwaysEditing, otoNoSelection, otoThumbTrack]
- TabOrder = 0
- OnGetCellData = OvcTable1GetCellData
- CellData = (
- 'Form1.OvcTCColHead1'
- 'Form1.O32TCFlexEdit1'
- 'Form1.OvcTCSimpleField1'
- 'Form1.OvcTCRowHead1'
- 'Form1.OvcTCString1')
- RowData = (
- 35)
- ColData = (
- 110
- False
- True
- 'Form1.OvcTCRowHead1'
- 150
- False
- True
- 'Form1.OvcTCString1'
- 150
- False
- True
- 'Form1.OvcTCSimpleField1'
- 150
- False
- True
- 'Form1.O32TCFlexEdit1')
- end
- object OvcTCColHead1: TOvcTCColHead
- Headings.Strings = (
- 'TOvcTCRowHead'
- 'TOvcTCString'
- 'TOvcTCSimpleField'
- 'TO32TCFlexEdit'
- '')
- ShowLetters = False
- Adjust = otaCenter
- Table = OvcTable1
- Left = 48
- end
- object OvcTCRowHead1: TOvcTCRowHead
- Adjust = otaCenter
- Table = OvcTable1
- Left = 80
- end
- object OvcTCString1: TOvcTCString
- AutoAdvanceLeftRight = True
- Table = OvcTable1
- Left = 144
- end
- object OvcController1: TOvcController
- EntryCommands.TableList = (
- 'Default'
- True
- ()
- 'WordStar'
- False
- ()
- 'Grid'
- False
- ())
- Epoch = 2000
- Left = 16
- end
- object OvcTCSimpleField1: TOvcTCSimpleField
- CaretOvr.Shape = csBlock
- EFColors.Disabled.BackColor = clWindow
- EFColors.Disabled.TextColor = clGrayText
- EFColors.Error.BackColor = clRed
- EFColors.Error.TextColor = clBlack
- EFColors.Highlight.BackColor = clHighlight
- EFColors.Highlight.TextColor = clHighlightText
- Table = OvcTable1
- OnError = OvcTCSimpleField1Error
- OnUserValidation = OvcTCSimpleField1UserValidation
- Left = 296
- RangeHigh = {00000000000000000000}
- RangeLow = {00000000000000000000}
- end
- object O32TCFlexEdit1: TO32TCFlexEdit
- EditorBorders.Active = False
- EditorBorders.FlatColor = clBlack
- EditorBorders.BorderStyle = bstyRaised
- EditorOptions.Alignment = taLeftJustify
- EditorOptions.Color = clWindow
- EditorOptions.Cursor = crDefault
- EditorOptions.MaxLines = 3
- EditorOptions.PasswordChar = #0
- EditorOptions.ReadOnly = False
- EditorOptions.ShowButton = False
- Table = OvcTable1
- Validation.BeepOnError = True
- Validation.InputRequired = False
- Validation.ValidatorType = 'None'
- Validation.ValidationType = vtUser
- OnUserValidation = O32TCFlexEdit1UserValidation
- Left = 448
- end
-end
diff --git a/Source/3rdParty/Orpheus/tests/TestTblEdits/unit1.lfm b/Source/3rdParty/Orpheus/tests/TestTblEdits/unit1.lfm
deleted file mode 100644
index 3f042e69..00000000
--- a/Source/3rdParty/Orpheus/tests/TestTblEdits/unit1.lfm
+++ /dev/null
@@ -1,135 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 768
- Height = 446
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- OnCreate = FormCreate
- OnDestroy = FormDestroy
- PixelsPerInch = 96
- object OvcTable1: TOvcTable
- Left = 16
- Top = 16
- Width = 737
- Height = 409
- Anchors = [akLeft, akTop, akRight, akBottom]
- Color = clWindow
- Controller = OvcController1
- GridPenSet.NormalGrid.NormalColor = clBtnShadow
- GridPenSet.NormalGrid.Style = psDot
- GridPenSet.NormalGrid.Effect = geBoth
- GridPenSet.LockedGrid.NormalColor = clBtnShadow
- GridPenSet.LockedGrid.Style = psSolid
- GridPenSet.LockedGrid.Effect = ge3D
- GridPenSet.CellWhenFocused.NormalColor = clBlack
- GridPenSet.CellWhenFocused.Style = psSolid
- GridPenSet.CellWhenFocused.Effect = geBoth
- GridPenSet.CellWhenUnfocused.NormalColor = clBlack
- GridPenSet.CellWhenUnfocused.Style = psDash
- GridPenSet.CellWhenUnfocused.Effect = geBoth
- LockedRowsCell = OvcTCColHead1
- Options = [otoNoRowResizing, otoNoColResizing, otoTabToArrow, otoEnterToArrow, otoAlwaysEditing, otoNoSelection, otoThumbTrack]
- TabOrder = 0
- OnGetCellData = OvcTable1GetCellData
- CellData = (
- 'Form1.OvcTCColHead1'
- 'Form1.O32TCFlexEdit1'
- 'Form1.OvcTCSimpleField1'
- 'Form1.OvcTCRowHead1'
- 'Form1.OvcTCString1')
- RowData = (
- 35)
- ColData = (
- 110
- False
- True
- 'Form1.OvcTCRowHead1'
- 150
- False
- True
- 'Form1.OvcTCString1'
- 150
- False
- True
- 'Form1.OvcTCSimpleField1'
- 150
- False
- True
- 'Form1.O32TCFlexEdit1')
- end
- object OvcTCColHead1: TOvcTCColHead
- Headings.Strings = (
- 'TOvcTCRowHead'
- 'TOvcTCString'
- 'TOvcTCSimpleField'
- 'TO32TCFlexEdit'
- '')
- ShowLetters = False
- Adjust = otaCenter
- Table = OvcTable1
- Left = 48
- end
- object OvcTCRowHead1: TOvcTCRowHead
- Adjust = otaCenter
- Table = OvcTable1
- Left = 80
- end
- object OvcTCString1: TOvcTCString
- AutoAdvanceLeftRight = True
- Table = OvcTable1
- Left = 144
- end
- object OvcController1: TOvcController
- EntryCommands.TableList = (
- 'Default'
- True
- ()
- 'WordStar'
- False
- ()
- 'Grid'
- False
- ())
- Epoch = 2000
- Left = 16
- end
- object OvcTCSimpleField1: TOvcTCSimpleField
- CaretOvr.Shape = csBlock
- EFColors.Disabled.BackColor = clWindow
- EFColors.Disabled.TextColor = clGrayText
- EFColors.Error.BackColor = clRed
- EFColors.Error.TextColor = clBlack
- EFColors.Highlight.BackColor = clHighlight
- EFColors.Highlight.TextColor = clHighlightText
- Table = OvcTable1
- OnError = OvcTCSimpleField1Error
- OnUserValidation = OvcTCSimpleField1UserValidation
- Left = 296
- RangeHigh = {00000000000000000000}
- RangeLow = {00000000000000000000}
- end
- object O32TCFlexEdit1: TO32TCFlexEdit
- EditorBorders.Active = False
- EditorBorders.FlatColor = clBlack
- EditorBorders.BorderStyle = bstyRaised
- EditorOptions.Alignment = taLeftJustify
- EditorOptions.Color = clWindow
- EditorOptions.Cursor = crDefault
- EditorOptions.MaxLines = 3
- EditorOptions.PasswordChar = #0
- EditorOptions.ReadOnly = False
- EditorOptions.ShowButton = False
- Table = OvcTable1
- Validation.BeepOnError = True
- Validation.InputRequired = False
- Validation.ValidatorType = 'None'
- Validation.ValidationType = vtUser
- OnUserValidation = O32TCFlexEdit1UserValidation
- Left = 448
- end
-end
diff --git a/Source/3rdParty/Orpheus/tests/TestTblEdits/unit1.lrs b/Source/3rdParty/Orpheus/tests/TestTblEdits/unit1.lrs
deleted file mode 100644
index 93620a86..00000000
--- a/Source/3rdParty/Orpheus/tests/TestTblEdits/unit1.lrs
+++ /dev/null
@@ -1,49 +0,0 @@
-LazarusResources.Add('TForm1','FORMDATA',[
- 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#192#0#3'Top'#2'r'#5'Width'#3#0#3#6'Height'
- +#3#190#1#7'Caption'#6#5'Form1'#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7#15
- +'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245#10
- +'Font.Style'#11#0#8'OnCreate'#7#10'FormCreate'#9'OnDestroy'#7#11'FormDestroy'
- +#13'PixelsPerInch'#2'`'#0#9'TOvcTable'#9'OvcTable1'#4'Left'#2#16#3'Top'#2#16
- +#5'Width'#3#225#2#6'Height'#3#153#1#7'Anchors'#11#6'akLeft'#5'akTop'#7'akRig'
- +'ht'#8'akBottom'#0#5'Color'#7#8'clWindow'#10'Controller'#7#14'OvcController1'
- +'!GridPenSet.NormalGrid.NormalColor'#7#11'clBtnShadow'#27'GridPenSet.NormalG'
- +'rid.Style'#7#5'psDot'#28'GridPenSet.NormalGrid.Effect'#7#6'geBoth!GridPenSe'
- +'t.LockedGrid.NormalColor'#7#11'clBtnShadow'#27'GridPenSet.LockedGrid.Style'
- +#7#7'psSolid'#28'GridPenSet.LockedGrid.Effect'#7#4'ge3D&GridPenSet.CellWhenF'
- +'ocused.NormalColor'#7#7'clBlack GridPenSet.CellWhenFocused.Style'#7#7'psSol'
- +'id!GridPenSet.CellWhenFocused.Effect'#7#6'geBoth(GridPenSet.CellWhenUnfocus'
- +'ed.NormalColor'#7#7'clBlack"GridPenSet.CellWhenUnfocused.Style'#7#6'psDash#'
- +'GridPenSet.CellWhenUnfocused.Effect'#7#6'geBoth'#14'LockedRowsCell'#7#13'Ov'
- +'cTCColHead1'#7'Options'#11#16'otoNoRowResizing'#16'otoNoColResizing'#13'oto'
- +'TabToArrow'#15'otoEnterToArrow'#16'otoAlwaysEditing'#14'otoNoSelection'#13
- +'otoThumbTrack'#0#8'TabOrder'#2#0#13'OnGetCellData'#7#20'OvcTable1GetCellDat'
- +'a'#8'CellData'#1#6#19'Form1.OvcTCColHead1'#6#20'Form1.O32TCFlexEdit1'#6#23
- +'Form1.OvcTCSimpleField1'#6#19'Form1.OvcTCRowHead1'#6#18'Form1.OvcTCString1'
- +#0#7'RowData'#1#2'#'#0#7'ColData'#1#2'n'#8#9#6#19'Form1.OvcTCRowHead1'#3#150
- +#0#8#9#6#18'Form1.OvcTCString1'#3#150#0#8#9#6#23'Form1.OvcTCSimpleField1'#3
- +#150#0#8#9#6#20'Form1.O32TCFlexEdit1'#0#0#0#13'TOvcTCColHead'#13'OvcTCColHea'
- +'d1'#16'Headings.Strings'#1#6#13'TOvcTCRowHead'#6#12'TOvcTCString'#6#17'TOvc'
- +'TCSimpleField'#6#14'TO32TCFlexEdit'#6#0#0#11'ShowLetters'#8#6'Adjust'#7#9'o'
- +'taCenter'#5'Table'#7#9'OvcTable1'#4'Left'#2'0'#0#0#13'TOvcTCRowHead'#13'Ovc'
- +'TCRowHead1'#6'Adjust'#7#9'otaCenter'#5'Table'#7#9'OvcTable1'#4'Left'#2'P'#0
- +#0#12'TOvcTCString'#12'OvcTCString1'#20'AutoAdvanceLeftRight'#9#5'Table'#7#9
- +'OvcTable1'#4'Left'#3#144#0#0#0#14'TOvcController'#14'OvcController1'#23'Ent'
- +'ryCommands.TableList'#1#6#7'Default'#9#1#0#6#8'WordStar'#8#1#0#6#4'Grid'#8#1
- +#0#0#5'Epoch'#3#208#7#4'Left'#2#16#0#0#17'TOvcTCSimpleField'#17'OvcTCSimpleF'
- +'ield1'#14'CaretOvr.Shape'#7#7'csBlock'#27'EFColors.Disabled.BackColor'#7#8
- +'clWindow'#27'EFColors.Disabled.TextColor'#7#10'clGrayText'#24'EFColors.Erro'
- +'r.BackColor'#7#5'clRed'#24'EFColors.Error.TextColor'#7#7'clBlack'#28'EFColo'
- +'rs.Highlight.BackColor'#7#11'clHighlight'#28'EFColors.Highlight.TextColor'#7
- +#15'clHighlightText'#5'Table'#7#9'OvcTable1'#7'OnError'#7#22'OvcTCSimpleFiel'
- +'d1Error'#16'OnUserValidation'#7#31'OvcTCSimpleField1UserValidation'#4'Left'
- +#3'('#1#9'RangeHigh'#10#10#0#0#0#0#0#0#0#0#0#0#0#0#0#8'RangeLow'#10#10#0#0#0
- +#0#0#0#0#0#0#0#0#0#0#0#0#14'TO32TCFlexEdit'#14'O32TCFlexEdit1'#20'EditorBord'
- +'ers.Active'#8#23'EditorBorders.FlatColor'#7#7'clBlack'#25'EditorBorders.Bor'
- +'derStyle'#7#10'bstyRaised'#23'EditorOptions.Alignment'#7#13'taLeftJustify'
- +#19'EditorOptions.Color'#7#8'clWindow'#20'EditorOptions.Cursor'#7#9'crDefaul'
- +'t'#22'EditorOptions.MaxLines'#2#3#26'EditorOptions.PasswordChar'#6#1#0#22'E'
- +'ditorOptions.ReadOnly'#8#24'EditorOptions.ShowButton'#8#5'Table'#7#9'OvcTab'
- +'le1'#22'Validation.BeepOnError'#9#24'Validation.InputRequired'#8#24'Validat'
- +'ion.ValidatorType'#6#4'None'#25'Validation.ValidationType'#7#6'vtUser'#16'O'
- +'nUserValidation'#7#28'O32TCFlexEdit1UserValidation'#4'Left'#3#192#1#0#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/tests/TestTblEdits/unit1.pas b/Source/3rdParty/Orpheus/tests/TestTblEdits/unit1.pas
deleted file mode 100644
index f235f2c1..00000000
--- a/Source/3rdParty/Orpheus/tests/TestTblEdits/unit1.pas
+++ /dev/null
@@ -1,137 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
- ovctcedt, ovctchdr, ovctcmmn, ovctable, ovcbase, ovctcsim, o32tcflx,
- ovcdata, ovcsf, ovctcbef, ovctcell, ovctcstr;
-
-const
- MaxDataRecs = 20;
- MaxStrLen = 100;
- cnStr = 1; {Column numbers for controls}
- cnSimp = 2;
- cnFlex = 3;
-
-type
- TDataRec = record
- Str : string[MaxStrLen];
- Simp : string[MaxStrLen];
- Flex : string;
- end;
-
- TDataArray = array[1..MaxDataRecs] of TDataRec;
-
- TForm1 = class(TForm)
- OvcTable1: TOvcTable;
- OvcController1: TOvcController;
- OvcTCColHead1: TOvcTCColHead;
- OvcTCRowHead1: TOvcTCRowHead;
- OvcTCString1: TOvcTCString;
- OvcTCSimpleField1: TOvcTCSimpleField;
- O32TCFlexEdit1: TO32TCFlexEdit;
- procedure FormCreate(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure OvcTable1GetCellData(Sender: TObject; RowNum,
- ColNum: Integer; var Data: Pointer; Purpose: TOvcCellDataPurpose);
- procedure OvcTCSimpleField1UserValidation(Sender: TObject;
- var ErrorCode: Word);
- procedure OvcTCSimpleField1Error(Sender: TObject; ErrorCode: Word;
- ErrorMsg: String);
- procedure O32TCFlexEdit1UserValidation(Sender: TObject; Value: String;
- var ValidEntry: Boolean);
- private
- DataArray : TDataArray; {A place to store data entered in table}
- public
- end;
-
-var
- Form1: TForm1;
-
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.dfm} {Link Delphi form file}
-{$ELSE}
-{$R *.lfm}
-{$ENDIF}
-
-procedure TForm1.FormCreate(Sender: TObject);
- {Initialize the main form.
- Do anything that needs to be done before the form
- can be displayed.}
-var
- RowNum : Integer;
-begin
- OvcTable1.RowLimit := MaxDataRecs + OvcTable1.LockedRows;
-
- OvcTCString1.MaxLength := MaxStrLen; {Be sure to set this here or in form}
- OvcTCSimpleField1.MaxLength := MaxStrLen;
- O32TCFlexEdit1.MaxLength := MaxStrLen;
-
-{$IFDEF FPC}
- for RowNum := 1 to MaxDataRecs do
- SetLength(DataArray[RowNum].Flex, MaxStrLen);
-{$ENDIF}
-end; {TForm1.FormCreate}
-
-
-procedure TForm1.FormDestroy(Sender: TObject);
-begin
-end; {TForm1.FormDestroy}
-
-
-procedure TForm1.OvcTable1GetCellData(Sender: TObject; RowNum,
- ColNum: Integer; var Data: Pointer; Purpose: TOvcCellDataPurpose);
- {This event handler is called when the table needs data to display
- or edit in a cell or a place to save a cell's edited data.}
-begin
- Data := nil;
- if (RowNum < OvcTable1.LockedRows) or (RowNum > OvcTable1.RowLimit) then
- Exit;
-
- case ColNum of
- cnStr : Data := @DataArray[RowNum].Str;
- cnSimp : Data := @DataArray[RowNum].Simp;
- cnFlex : Data := PChar(DataArray[RowNum].Flex);
- end;
-end; {TForm1.OvcTable1GetCellData}
-
-
-procedure TForm1.OvcTCSimpleField1UserValidation(Sender: TObject;
- var ErrorCode: Word);
-var
- AnInt : Integer;
-begin
- ErrorCode := 0;
- if (TOvcSimpleField(Sender).Text <> '') and
- (not TryStrToInt(TOvcSimpleField(Sender).Text, AnInt)) then
- ErrorCode := oeInvalidNumber;
-end;
-
-procedure TForm1.OvcTCSimpleField1Error(Sender: TObject; ErrorCode: Word;
- ErrorMsg: String);
-begin
- MessageDlg(ErrorMsg + #13#10 + 'Enter an integer or press Ctrl+Z to undo.',
- mtError, [mbOK], 0);
-end;
-
-procedure TForm1.O32TCFlexEdit1UserValidation(Sender: TObject;
- Value: String; var ValidEntry: Boolean);
-var
- AnInt : Integer;
-begin
- ValidEntry := True;
- if (Value <> '') and (not TryStrToInt(Value, AnInt)) then
- begin
- ValidEntry := False;
- MessageDlg('Invalid value.' + #13#10 +
- 'Enter an integer or press Ctrl+Z to undo.', mtError, [mbOK], 0);
- end;
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/tests/TestURL/project1.bdsproj b/Source/3rdParty/Orpheus/tests/TestURL/project1.bdsproj
deleted file mode 100644
index 21fa3766..00000000
--- a/Source/3rdParty/Orpheus/tests/TestURL/project1.bdsproj
+++ /dev/null
@@ -1,175 +0,0 @@
-
-
-
-
- Delphi.Personality
- VCLApplication
- 1.0
- {CD069137-4C4C-40B2-AAA5-777E14CC0753}
-
-
-
-
- project1.dpr
-
-
- 7.0
-
-
- 8
- 0
- 1
- 1
- 0
- 0
- 1
- 1
- 1
- 0
- 0
- 1
- 0
- 1
- 1
- 1
- 1
- 1
- 0
- 1
- 0
- 1
- 0
- 1
- 1
- 1
- True
- True
- WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-
- False
-
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- False
- False
- False
- True
- True
- True
- True
- True
- True
-
-
-
- 0
- 0
- False
- 1
- False
- False
- False
- 16384
- 1048576
- 4194304
-
-
-
-
-
-
-
- C:\Orpheus4\FPC
- vcl;rtl;vclx;indy;vclie;xmlrtl;inetdbbde;inet;inetdbxpress;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;inetdb;bdertl;vcldbx;adortl;teeui;teedb;tee;ibxpress;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k
-
-
- False
-
-
-
-
-
- False
-
-
- True
- False
-
-
-
- $00000000
-
-
-
- False
- False
- 1
- 0
- 0
- 0
- False
- False
- False
- False
- False
- 1033
- 1252
-
-
-
-
- 1.0.0.0
-
-
-
-
-
- 1.0.0.0
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/tests/TestURL/project1.cfg b/Source/3rdParty/Orpheus/tests/TestURL/project1.cfg
deleted file mode 100644
index 45be3be1..00000000
--- a/Source/3rdParty/Orpheus/tests/TestURL/project1.cfg
+++ /dev/null
@@ -1,38 +0,0 @@
--$A8
--$B-
--$C+
--$D+
--$E-
--$F-
--$G+
--$H+
--$I+
--$J-
--$K-
--$L+
--$M-
--$N+
--$O+
--$P+
--$Q+
--$R+
--$S-
--$T+
--$U-
--$V+
--$W-
--$X+
--$YD
--$Z1
--cg
--AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
--H+
--W+
--M
--$M16384,1048576
--K$00400000
--LE"c:\delphi7\Projects\Bpl"
--LN"c:\delphi7\Projects\Bpl"
--w-UNSAFE_TYPE
--w-UNSAFE_CODE
--w-UNSAFE_CAST
diff --git a/Source/3rdParty/Orpheus/tests/TestURL/project1.dof b/Source/3rdParty/Orpheus/tests/TestURL/project1.dof
deleted file mode 100644
index a964abf6..00000000
--- a/Source/3rdParty/Orpheus/tests/TestURL/project1.dof
+++ /dev/null
@@ -1,136 +0,0 @@
-[FileVersion]
-Version=7.0
-[Compiler]
-A=8
-B=0
-C=1
-D=1
-E=0
-F=0
-G=1
-H=1
-I=1
-J=0
-K=0
-L=1
-M=0
-N=1
-O=1
-P=1
-Q=1
-R=1
-S=0
-T=1
-U=0
-V=1
-W=0
-X=1
-Y=1
-Z=1
-ShowHints=1
-ShowWarnings=1
-UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-NamespacePrefix=
-SymbolDeprecated=1
-SymbolLibrary=1
-SymbolPlatform=1
-UnitLibrary=1
-UnitPlatform=1
-UnitDeprecated=1
-HResultCompat=1
-HidingMember=1
-HiddenVirtual=1
-Garbage=1
-BoundsError=1
-ZeroNilCompat=1
-StringConstTruncated=1
-ForLoopVarVarPar=1
-TypedConstVarPar=1
-AsgToTypedConst=1
-CaseLabelRange=1
-ForVariable=1
-ConstructingAbstract=1
-ComparisonFalse=1
-ComparisonTrue=1
-ComparingSignedUnsigned=1
-CombiningSignedUnsigned=1
-UnsupportedConstruct=1
-FileOpen=1
-FileOpenUnitSrc=1
-BadGlobalSymbol=1
-DuplicateConstructorDestructor=1
-InvalidDirective=1
-PackageNoLink=1
-PackageThreadVar=1
-ImplicitImport=1
-HPPEMITIgnored=1
-NoRetVal=1
-UseBeforeDef=1
-ForLoopVarUndef=1
-UnitNameMismatch=1
-NoCFGFileFound=1
-MessageDirective=1
-ImplicitVariants=1
-UnicodeToLocale=1
-LocaleToUnicode=1
-ImagebaseMultiple=1
-SuspiciousTypecast=1
-PrivatePropAccessor=1
-UnsafeType=0
-UnsafeCode=0
-UnsafeCast=0
-[Linker]
-MapFile=0
-OutputObjs=0
-ConsoleApp=1
-DebugInfo=0
-RemoteSymbols=0
-MinStackSize=16384
-MaxStackSize=1048576
-ImageBase=4194304
-ExeDescription=
-[Directories]
-OutputDir=
-UnitOutputDir=
-PackageDLLOutputDir=
-PackageDCPOutputDir=
-SearchPath=
-Packages=vcl;rtl;vclx;indy;vclie;xmlrtl;inetdbbde;inet;inetdbxpress;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;inetdb;bdertl;vcldbx;adortl;teeui;teedb;tee;ibxpress;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k
-Conditionals=
-DebugSourceDirs=
-UsePackages=0
-[Parameters]
-RunParams=
-HostApplication=
-Launcher=
-UseLauncher=0
-DebugCWD=
-[Language]
-ActiveLang=
-ProjectLang=
-RootDir=
-[Version Info]
-IncludeVerInfo=0
-AutoIncBuild=0
-MajorVer=1
-MinorVer=0
-Release=0
-Build=0
-Debug=0
-PreRelease=0
-Special=0
-Private=0
-DLL=0
-Locale=1033
-CodePage=1252
-[Version Info Keys]
-CompanyName=
-FileDescription=
-FileVersion=1.0.0.0
-InternalName=
-LegalCopyright=
-LegalTrademarks=
-OriginalFilename=
-ProductName=
-ProductVersion=1.0.0.0
-Comments=
diff --git a/Source/3rdParty/Orpheus/tests/TestURL/project1.dpr b/Source/3rdParty/Orpheus/tests/TestURL/project1.dpr
deleted file mode 100644
index 8a2e82e5..00000000
--- a/Source/3rdParty/Orpheus/tests/TestURL/project1.dpr
+++ /dev/null
@@ -1,18 +0,0 @@
-program Project1;
-
-uses
-{$IFDEF LCL}
- Interfaces,
-{$ENDIF}
- Forms,
- Unit1 in 'Unit1.pas' {Form1};
-
-{$IFDEF MSWINDOWS}
-{$R *.res}
-{$ENDIF}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Orpheus/tests/TestURL/project1.lpi b/Source/3rdParty/Orpheus/tests/TestURL/project1.lpi
deleted file mode 100644
index 8560250b..00000000
--- a/Source/3rdParty/Orpheus/tests/TestURL/project1.lpi
+++ /dev/null
@@ -1,108 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/tests/TestURL/unit1.dfm b/Source/3rdParty/Orpheus/tests/TestURL/unit1.dfm
deleted file mode 100644
index d5ada538..00000000
--- a/Source/3rdParty/Orpheus/tests/TestURL/unit1.dfm
+++ /dev/null
@@ -1,33 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 511
- Height = 362
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'MS Sans Serif'
- Font.Style = []
- OldCreateOrder = False
- PixelsPerInch = 96
- TextHeight = 13
- object OvcURL1: TOvcURL
- Left = 96
- Top = 56
- Width = 138
- Height = 13
- Hint = 'http://www.lazarus.freepascal.org'
- Caption = 'URL link to Lazarus Web site'
- URL = 'http://www.lazarus.freepascal.org'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'MS Sans Serif'
- Font.Style = [fsUnderline]
- ParentFont = False
- ParentShowHint = False
- ShowHint = True
- end
-end
diff --git a/Source/3rdParty/Orpheus/tests/TestURL/unit1.lfm b/Source/3rdParty/Orpheus/tests/TestURL/unit1.lfm
deleted file mode 100644
index a9471327..00000000
--- a/Source/3rdParty/Orpheus/tests/TestURL/unit1.lfm
+++ /dev/null
@@ -1,29 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 503
- Height = 328
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- PixelsPerInch = 96
- object OvcURL1: TOvcURL
- Left = 96
- Top = 56
- Width = 138
- Height = 13
- Hint = 'http://www.lazarus.freepascal.org'
- Caption = 'URL link to Lazarus Web site'
- URL = 'http://www.lazarus.freepascal.org'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = [fsUnderline]
- ParentFont = False
- ParentShowHint = False
- ShowHint = True
- end
-end
diff --git a/Source/3rdParty/Orpheus/tests/TestURL/unit1.lrs b/Source/3rdParty/Orpheus/tests/TestURL/unit1.lrs
deleted file mode 100644
index faecae9e..00000000
--- a/Source/3rdParty/Orpheus/tests/TestURL/unit1.lrs
+++ /dev/null
@@ -1,11 +0,0 @@
-LazarusResources.Add('TForm1','FORMDATA',[
- 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#192#0#3'Top'#2'r'#5'Width'#3#247#1#6'Heig'
- +'ht'#3'H'#1#7'Caption'#6#5'Form1'#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7
- +#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245
- +#10'Font.Style'#11#0#13'PixelsPerInch'#2'`'#0#7'TOvcURL'#7'OvcURL1'#4'Left'#2
- +'`'#3'Top'#2'8'#5'Width'#3#138#0#6'Height'#2#13#4'Hint'#6'!http://www.lazaru'
- +'s.freepascal.org'#7'Caption'#6#28'URL link to Lazarus Web site'#3'URL'#6'!h'
- +'ttp://www.lazarus.freepascal.org'#12'Font.Charset'#7#15'DEFAULT_CHARSET'#10
- +'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245#10'Font.Style'#11#11'f'
- +'sUnderline'#0#10'ParentFont'#8#14'ParentShowHint'#8#8'ShowHint'#9#0#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/tests/TestURL/unit1.pas b/Source/3rdParty/Orpheus/tests/TestURL/unit1.pas
deleted file mode 100644
index c8f91c17..00000000
--- a/Source/3rdParty/Orpheus/tests/TestURL/unit1.pas
+++ /dev/null
@@ -1,31 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls, ovcurl;
-
-type
- TForm1 = class(TForm)
- OvcURL1: TOvcURL;
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.dfm}
-{$ELSE}
-{$R *.lfm}
-{$ENDIF}
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/tests/TestVLB/project1.bdsproj b/Source/3rdParty/Orpheus/tests/TestVLB/project1.bdsproj
deleted file mode 100644
index 21fa3766..00000000
--- a/Source/3rdParty/Orpheus/tests/TestVLB/project1.bdsproj
+++ /dev/null
@@ -1,175 +0,0 @@
-
-
-
-
- Delphi.Personality
- VCLApplication
- 1.0
- {CD069137-4C4C-40B2-AAA5-777E14CC0753}
-
-
-
-
- project1.dpr
-
-
- 7.0
-
-
- 8
- 0
- 1
- 1
- 0
- 0
- 1
- 1
- 1
- 0
- 0
- 1
- 0
- 1
- 1
- 1
- 1
- 1
- 0
- 1
- 0
- 1
- 0
- 1
- 1
- 1
- True
- True
- WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-
- False
-
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- True
- False
- False
- False
- True
- True
- True
- True
- True
- True
-
-
-
- 0
- 0
- False
- 1
- False
- False
- False
- 16384
- 1048576
- 4194304
-
-
-
-
-
-
-
- C:\Orpheus4\FPC
- vcl;rtl;vclx;indy;vclie;xmlrtl;inetdbbde;inet;inetdbxpress;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;inetdb;bdertl;vcldbx;adortl;teeui;teedb;tee;ibxpress;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k
-
-
- False
-
-
-
-
-
- False
-
-
- True
- False
-
-
-
- $00000000
-
-
-
- False
- False
- 1
- 0
- 0
- 0
- False
- False
- False
- False
- False
- 1033
- 1252
-
-
-
-
- 1.0.0.0
-
-
-
-
-
- 1.0.0.0
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/tests/TestVLB/project1.cfg b/Source/3rdParty/Orpheus/tests/TestVLB/project1.cfg
deleted file mode 100644
index 45be3be1..00000000
--- a/Source/3rdParty/Orpheus/tests/TestVLB/project1.cfg
+++ /dev/null
@@ -1,38 +0,0 @@
--$A8
--$B-
--$C+
--$D+
--$E-
--$F-
--$G+
--$H+
--$I+
--$J-
--$K-
--$L+
--$M-
--$N+
--$O+
--$P+
--$Q+
--$R+
--$S-
--$T+
--$U-
--$V+
--$W-
--$X+
--$YD
--$Z1
--cg
--AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
--H+
--W+
--M
--$M16384,1048576
--K$00400000
--LE"c:\delphi7\Projects\Bpl"
--LN"c:\delphi7\Projects\Bpl"
--w-UNSAFE_TYPE
--w-UNSAFE_CODE
--w-UNSAFE_CAST
diff --git a/Source/3rdParty/Orpheus/tests/TestVLB/project1.dof b/Source/3rdParty/Orpheus/tests/TestVLB/project1.dof
deleted file mode 100644
index a964abf6..00000000
--- a/Source/3rdParty/Orpheus/tests/TestVLB/project1.dof
+++ /dev/null
@@ -1,136 +0,0 @@
-[FileVersion]
-Version=7.0
-[Compiler]
-A=8
-B=0
-C=1
-D=1
-E=0
-F=0
-G=1
-H=1
-I=1
-J=0
-K=0
-L=1
-M=0
-N=1
-O=1
-P=1
-Q=1
-R=1
-S=0
-T=1
-U=0
-V=1
-W=0
-X=1
-Y=1
-Z=1
-ShowHints=1
-ShowWarnings=1
-UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-NamespacePrefix=
-SymbolDeprecated=1
-SymbolLibrary=1
-SymbolPlatform=1
-UnitLibrary=1
-UnitPlatform=1
-UnitDeprecated=1
-HResultCompat=1
-HidingMember=1
-HiddenVirtual=1
-Garbage=1
-BoundsError=1
-ZeroNilCompat=1
-StringConstTruncated=1
-ForLoopVarVarPar=1
-TypedConstVarPar=1
-AsgToTypedConst=1
-CaseLabelRange=1
-ForVariable=1
-ConstructingAbstract=1
-ComparisonFalse=1
-ComparisonTrue=1
-ComparingSignedUnsigned=1
-CombiningSignedUnsigned=1
-UnsupportedConstruct=1
-FileOpen=1
-FileOpenUnitSrc=1
-BadGlobalSymbol=1
-DuplicateConstructorDestructor=1
-InvalidDirective=1
-PackageNoLink=1
-PackageThreadVar=1
-ImplicitImport=1
-HPPEMITIgnored=1
-NoRetVal=1
-UseBeforeDef=1
-ForLoopVarUndef=1
-UnitNameMismatch=1
-NoCFGFileFound=1
-MessageDirective=1
-ImplicitVariants=1
-UnicodeToLocale=1
-LocaleToUnicode=1
-ImagebaseMultiple=1
-SuspiciousTypecast=1
-PrivatePropAccessor=1
-UnsafeType=0
-UnsafeCode=0
-UnsafeCast=0
-[Linker]
-MapFile=0
-OutputObjs=0
-ConsoleApp=1
-DebugInfo=0
-RemoteSymbols=0
-MinStackSize=16384
-MaxStackSize=1048576
-ImageBase=4194304
-ExeDescription=
-[Directories]
-OutputDir=
-UnitOutputDir=
-PackageDLLOutputDir=
-PackageDCPOutputDir=
-SearchPath=
-Packages=vcl;rtl;vclx;indy;vclie;xmlrtl;inetdbbde;inet;inetdbxpress;dbrtl;soaprtl;dsnap;VclSmp;dbexpress;vcldb;dbxcds;inetdb;bdertl;vcldbx;adortl;teeui;teedb;tee;ibxpress;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;Rave50CLX;Rave50VCL;dclOffice2k
-Conditionals=
-DebugSourceDirs=
-UsePackages=0
-[Parameters]
-RunParams=
-HostApplication=
-Launcher=
-UseLauncher=0
-DebugCWD=
-[Language]
-ActiveLang=
-ProjectLang=
-RootDir=
-[Version Info]
-IncludeVerInfo=0
-AutoIncBuild=0
-MajorVer=1
-MinorVer=0
-Release=0
-Build=0
-Debug=0
-PreRelease=0
-Special=0
-Private=0
-DLL=0
-Locale=1033
-CodePage=1252
-[Version Info Keys]
-CompanyName=
-FileDescription=
-FileVersion=1.0.0.0
-InternalName=
-LegalCopyright=
-LegalTrademarks=
-OriginalFilename=
-ProductName=
-ProductVersion=1.0.0.0
-Comments=
diff --git a/Source/3rdParty/Orpheus/tests/TestVLB/project1.dpr b/Source/3rdParty/Orpheus/tests/TestVLB/project1.dpr
deleted file mode 100644
index 8a2e82e5..00000000
--- a/Source/3rdParty/Orpheus/tests/TestVLB/project1.dpr
+++ /dev/null
@@ -1,18 +0,0 @@
-program Project1;
-
-uses
-{$IFDEF LCL}
- Interfaces,
-{$ENDIF}
- Forms,
- Unit1 in 'Unit1.pas' {Form1};
-
-{$IFDEF MSWINDOWS}
-{$R *.res}
-{$ENDIF}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Orpheus/tests/TestVLB/project1.lpi b/Source/3rdParty/Orpheus/tests/TestVLB/project1.lpi
deleted file mode 100644
index aac4d262..00000000
--- a/Source/3rdParty/Orpheus/tests/TestVLB/project1.lpi
+++ /dev/null
@@ -1,110 +0,0 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/Source/3rdParty/Orpheus/tests/TestVLB/unit1.dfm b/Source/3rdParty/Orpheus/tests/TestVLB/unit1.dfm
deleted file mode 100644
index 1eea279c..00000000
--- a/Source/3rdParty/Orpheus/tests/TestVLB/unit1.dfm
+++ /dev/null
@@ -1,46 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 554
- Height = 437
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'MS Sans Serif'
- Font.Style = []
- OldCreateOrder = False
- OnCreate = FormCreate
- PixelsPerInch = 96
- TextHeight = 13
- object Label1: TLabel
- Left = 40
- Top = 304
- Width = 473
- Height = 33
- AutoSize = False
- Caption = 'Double-click an item in list'
- Color = clBtnHighlight
- ParentColor = False
- end
- object OvcVirtualListBox1: TOvcVirtualListBox
- Left = 40
- Top = 40
- Width = 473
- Height = 238
- Header = 'Header goes here'
- HeaderColor.BackColor = clBtnFace
- HeaderColor.TextColor = clBtnText
- ProtectColor.BackColor = clRed
- ProtectColor.TextColor = clWhite
- RowHeight = 13
- SelectColor.BackColor = clHighlight
- SelectColor.TextColor = clHighlightText
- ShowHeader = True
- UseTabStops = True
- OnGetItem = OvcVirtualListBox1GetItem
- TabOrder = 0
- OnDblClick = OvcVirtualListBox1DblClick
- end
-end
diff --git a/Source/3rdParty/Orpheus/tests/TestVLB/unit1.lfm b/Source/3rdParty/Orpheus/tests/TestVLB/unit1.lfm
deleted file mode 100644
index 6ca4fa8d..00000000
--- a/Source/3rdParty/Orpheus/tests/TestVLB/unit1.lfm
+++ /dev/null
@@ -1,43 +0,0 @@
-object Form1: TForm1
- Left = 192
- Top = 114
- Width = 546
- Height = 403
- Caption = 'Form1'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Style = []
- OnCreate = FormCreate
- PixelsPerInch = 96
- object Label1: TLabel
- Left = 40
- Top = 304
- Width = 473
- Height = 33
- AutoSize = False
- Caption = 'Double-click an item in list'
- Color = clBtnHighlight
- ParentColor = False
- end
- object OvcVirtualListBox1: TOvcVirtualListBox
- Left = 40
- Top = 40
- Width = 473
- Height = 238
- Header = 'Header goes here'
- HeaderColor.BackColor = clBtnFace
- HeaderColor.TextColor = clBtnText
- ProtectColor.BackColor = clRed
- ProtectColor.TextColor = clWhite
- RowHeight = 13
- SelectColor.BackColor = clHighlight
- SelectColor.TextColor = clHighlightText
- ShowHeader = True
- UseTabStops = True
- OnGetItem = OvcVirtualListBox1GetItem
- TabOrder = 0
- OnDblClick = OvcVirtualListBox1DblClick
- end
-end
diff --git a/Source/3rdParty/Orpheus/tests/TestVLB/unit1.lrs b/Source/3rdParty/Orpheus/tests/TestVLB/unit1.lrs
deleted file mode 100644
index c562b53c..00000000
--- a/Source/3rdParty/Orpheus/tests/TestVLB/unit1.lrs
+++ /dev/null
@@ -1,16 +0,0 @@
-LazarusResources.Add('TForm1','FORMDATA',[
- 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3#192#0#3'Top'#2'r'#5'Width'#3'"'#2#6'Heigh'
- +'t'#3#147#1#7'Caption'#6#5'Form1'#5'Color'#7#9'clBtnFace'#12'Font.Charset'#7
- +#15'DEFAULT_CHARSET'#10'Font.Color'#7#12'clWindowText'#11'Font.Height'#2#245
- +#10'Font.Style'#11#0#8'OnCreate'#7#10'FormCreate'#13'PixelsPerInch'#2'`'#0#6
- +'TLabel'#6'Label1'#4'Left'#2'('#3'Top'#3'0'#1#5'Width'#3#217#1#6'Height'#2'!'
- +#8'AutoSize'#8#7'Caption'#6#28'Double-click an item in list'#5'Color'#7#14'c'
- +'lBtnHighlight'#11'ParentColor'#8#0#0#18'TOvcVirtualListBox'#18'OvcVirtualLi'
- +'stBox1'#4'Left'#2'('#3'Top'#2'('#5'Width'#3#217#1#6'Height'#3#238#0#6'Heade'
- +'r'#6#16'Header goes here'#21'HeaderColor.BackColor'#7#9'clBtnFace'#21'Heade'
- +'rColor.TextColor'#7#9'clBtnText'#22'ProtectColor.BackColor'#7#5'clRed'#22'P'
- +'rotectColor.TextColor'#7#7'clWhite'#9'RowHeight'#2#13#21'SelectColor.BackCo'
- +'lor'#7#11'clHighlight'#21'SelectColor.TextColor'#7#15'clHighlightText'#10'S'
- +'howHeader'#9#11'UseTabStops'#9#9'OnGetItem'#7#25'OvcVirtualListBox1GetItem'
- +#8'TabOrder'#2#0#10'OnDblClick'#7#26'OvcVirtualListBox1DblClick'#0#0#0
-]);
diff --git a/Source/3rdParty/Orpheus/tests/TestVLB/unit1.pas b/Source/3rdParty/Orpheus/tests/TestVLB/unit1.pas
deleted file mode 100644
index aff91f18..00000000
--- a/Source/3rdParty/Orpheus/tests/TestVLB/unit1.pas
+++ /dev/null
@@ -1,68 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- {$IFNDEF LCL} Windows, Messages, {$ELSE} LclIntf, LMessages, LclType, LResources, {$ENDIF}
- SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, ovcbase, ovcvlb, StdCtrls;
-
-type
- TForm1 = class(TForm)
- OvcVirtualListBox1: TOvcVirtualListBox;
- Label1: TLabel;
- procedure FormCreate(Sender: TObject);
- procedure OvcVirtualListBox1GetItem(Sender: TObject; Index: Integer;
- var ItemString: String);
- procedure OvcVirtualListBox1DblClick(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$IFNDEF LCL}
-{$R *.dfm}
-{$ELSE}
-{$R *.lfm}
-{$ENDIF}
-
-procedure TForm1.FormCreate(Sender: TObject);
-var
- TabStops : array[0..1] of Integer;
-begin
- TabStops[0] := 150;
- TabStops[1] := 300;
- OvcVirtualListBox1.SetTabStops(TabStops);
-
- OvcVirtualListBox1.Header := 'Name column'#9'Address column'#9'City column';
-
- if OvcVirtualListBox1.IntegralHeight then
- OvcVirtualListBox1.ClientHeight :=
- (OvcVirtualListBox1.ClientHeight div OvcVirtualListBox1.RowHeight) *
- OvcVirtualListBox1.RowHeight;
- {Since RowHeight might have changed based on font used by current
- platform, make sure height still integral.}
-end;
-
-procedure TForm1.OvcVirtualListBox1GetItem(Sender: TObject; Index: Integer;
- var ItemString: String);
-begin
- ItemString := 'Item ' + IntToStr(Index) + ' name'#9 +
- 'Item ' + IntToStr(Index) + ' address'#9 +
- 'Item ' + IntToStr(Index) + ' city';
-end;
-
-procedure TForm1.OvcVirtualListBox1DblClick(Sender: TObject);
-begin
- Label1.Caption :=
- 'You double-clicked item ' + IntToStr(OvcVirtualListBox1.ItemIndex);
-end;
-
-
-end.
diff --git a/Source/3rdParty/Orpheus/units/i386-linux/o32sr.rst b/Source/3rdParty/Orpheus/units/i386-linux/o32sr.rst
deleted file mode 100644
index ab350ef6..00000000
--- a/Source/3rdParty/Orpheus/units/i386-linux/o32sr.rst
+++ /dev/null
@@ -1,1575 +0,0 @@
-
-# hash value = 47539321
-o32sr.rsnonestr='(None)'
-
-
-# hash value = 110676418
-o32sr.rsccuser='ccUser'
-
-
-# hash value = 147440164
-o32sr.rsccusernum='ccUser%d'
-
-
-# hash value = 23862543
-o32sr.rsdeletetable='Delete the %s table?'
-
-
-# hash value = 47591701
-o32sr.rsrenametable='Rename Table'
-
-
-# hash value = 62914634
-o32sr.rsentertablename='Enter new table name for %s:'
-
-
-# hash value = 214597221
-o32sr.rsnewtable='NewTable'
-
-
-# hash value = 180128884
-o32sr.rsdefaulttablename='Default'
-
-
-# hash value = 109686626
-o32sr.rswordstartablename='WordStar'
-
-
-# hash value = 321780
-o32sr.rsgridtablename='Grid'
-
-
-# hash value = 86327753
-o32sr.rsunknowntable='(Unknown)'
-
-
-# hash value = 184599794
-o32sr.rsdefaultentryerrortext='Entry Error'
-
-
-# hash value = 44316689
-o32sr.rsgotitemwarning='%d. *** Warning *** OnGetItem not assigned!'
-
-
-# hash value = 164121725
-o32sr.rssamplelistitem='%d. - Sample virtual list box item'
-
-
-# hash value = 61396826
-o32sr.rsalphastring='abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ'+
-
-
-# hash value = 1513
-o32sr.rstalllowchars='Wy'
-
-
-# hash value = 180128884
-o32sr.rsdefault='Default'
-
-
-# hash value = 89
-o32sr.rsyes='Y'
-
-
-# hash value = 78
-o32sr.rsno='N'
-
-
-# hash value = 84
-o32sr.rstrue='T'
-
-
-# hash value = 70
-o32sr.rsfalse='F'
-
-
-# hash value = 49589427
-o32sr.rsdescending=' - Desc'
-
-
-# hash value = 197701577
-o32sr.rsdefaultindex='(Default)'
-
-
-# hash value = 86025029
-o32sr.rsduplicatecommand='Duplicate command found while adding a new comm'+
-'and to the table'
-
-
-# hash value = 189452597
-o32sr.rstablenotfound='Command table not found or command table index out'+
-' of range'
-
-
-# hash value = 73438661
-o32sr.rsnotdoneyet='This feature is not implemented at this time'
-
-
-# hash value = 64194580
-o32sr.rsnocontrollerassigned='No Controller assigned'
-
-
-# hash value = 35420549
-o32sr.rscantcreatecommandtable='Unable to create command table'
-
-
-# hash value = 48081108
-o32sr.rscantdelete='Can'#39't delete this table. Must have at least one c'+
-'ommand table defined'
-
-
-# hash value = 20361444
-o32sr.rsinvalidkeysequence='Invalid or no key sequence entered'
-
-
-# hash value = 242348867
-o32sr.rsnotwordstarcommands='Keys entered are not WordStar style commands'+
-
-
-# hash value = 240741204
-o32sr.rsnocommandselected='No command selected'
-
-
-# hash value = 157959429
-o32sr.rsduplicatekeysequence='Duplicate key sequence'
-
-
-# hash value = 973461
-o32sr.rsrangeerror='Value is not within required range'
-
-
-# hash value = 206041701
-o32sr.rsinvalidnumber='Value is not valid for this field type'
-
-
-# hash value = 230136804
-o32sr.rsrequiredfield='A value is required in this field'
-
-
-# hash value = 92696485
-o32sr.rsinvaliddate='Value is not a valid date'
-
-
-# hash value = 92760373
-o32sr.rsinvalidtime='Value is not a valid time'
-
-
-# hash value = 104098179
-o32sr.rsblanksinfield='This field should contain no blanks'
-
-
-# hash value = 190360572
-o32sr.rspartialentry='This field should be either empty or completely ful'+
-'l'
-
-
-# hash value = 66474265
-o32sr.rsregiontoolarge='Region is too large (> 64K)'
-
-
-# hash value = 186038585
-o32sr.rsoutofmemoryforcopy='Could not allocate memory for clipboard copy'
-
-
-# hash value = 31889508
-o32sr.rsinvalidparamvalue='Parameter value is invalid'
-
-
-# hash value = 110743845
-o32sr.rsnotimersavail='No Window'#39's timers are available'
-
-
-# hash value = 219139891
-o32sr.rstoomanyevents='Too many trigger events'
-
-
-# hash value = 103937301
-o32sr.rsbadtriggerhandle='Invalid trigger handle'
-
-
-# hash value = 192553604
-o32sr.rsonselectnotassigned='OnSelect event is not assigned'
-
-
-# hash value = 124954245
-o32sr.rsinvalidpageindex='Invalid page index value'
-
-
-# hash value = 172862148
-o32sr.rsinvaliddatatype='Invalid data type for this field'
-
-
-# hash value = 39861684
-o32sr.rsinvalidtabfont='Invalid font. Non toTop oriented tabs require a T'+
-'rue-Type font'
-
-
-# hash value = 69686484
-o32sr.rsinvalidlabelfont='Invalid font. Rotated text requires a True-Type'+
-' font'
-
-
-# hash value = 258097070
-o32sr.rsoutofmemory='insufficient memory for requested operation'
-
-
-# hash value = 151298131
-o32sr.rstoomanyparas='Current operation will exceed the maximum number of'+
-' allowed paragraphs'
-
-
-# hash value = 88628149
-o32sr.rscannotjoin='Cannot join paragraphs. New paragraph size exceeds ma'+
-'ximum paragraph size'
-
-
-# hash value = 198920885
-o32sr.rstoomanybytes='Current operation will exceed the maximum text size'+
-
-
-# hash value = 158057429
-o32sr.rsparatoolong='Current operation will exceed the maximum paragraph '+
-'size'
-
-
-# hash value = 191420670
-o32sr.rsunknownerror='Unknown Error condition'
-
-
-# hash value = 154407027
-o32sr.rsinvalidpicturemask='Invalid picture mask: %s'
-
-
-# hash value = 13087785
-o32sr.rsinvalidrange='Invalid range. Enter a value between (%d) and (%d)'
-
-
-# hash value = 248400601
-o32sr.rsinvalidrealrange='Invalid range. Enter a value between (-1.7e+38)'+
-' and (+1.7e+38)'
-
-
-# hash value = 264564361
-o32sr.rsinvalidextendedrange='Invalid range. Enter a value between (-1.1e'+
-'+4932) and (+1.1e+4932)'
-
-
-# hash value = 155966601
-o32sr.rsinvaliddoublerange='Invalid range. Enter a value between (-1.7e+3'+
-'08) and (+1.7e+308)'
-
-
-# hash value = 246959545
-o32sr.rsinvalidsinglerange='Invalid range. Enter a value between (-3.4e+3'+
-'8) and (+3.4e+38)'
-
-
-# hash value = 246828377
-o32sr.rsinvalidcomprange='Invalid range. Enter a value between (-9.2e+18)'+
-' and (+9.2e+18)'
-
-
-# hash value = 235266788
-o32sr.rsinvaliddaterange='Invalid date range. Enter a value using '#39'%s'+
-#39' as the format'
-
-
-# hash value = 91612132
-o32sr.rsinvalidtimerange='Invalid time range. Enter a value using '#39'%s'+
-#39' as the format'
-
-
-# hash value = 22644165
-o32sr.rsinvalidrangevalue='Invalid range value'
-
-
-# hash value = 38619085
-o32sr.rsinvalidminmaxvalue='Invalid value - Maximum must always be greate'+
-'r than Minimum'
-
-
-# hash value = 149815988
-o32sr.rsrangenotsupported='Range limits for the currently selected data t'+
-'ype are not supported'
-
-
-# hash value = 54276856
-o32sr.rsinvalidlineorparaindex='Invalid line or paragraph index'
-
-
-# hash value = 77699476
-o32sr.rsnonfixedfont='Invalid font assignment. Font must be a fixed font'
-
-
-# hash value = 83345268
-o32sr.rsinvalidfontparam='Invalid font assignemnt. Font must be a TFont o'+
-'r TOvcFixedFont'
-
-
-# hash value = 252258974
-o32sr.rsinvalidlineorcolumn='Invalid line or column'
-
-
-# hash value = 243786162
-o32sr.rssaegeneral='Unknown sparse array error'
-
-
-# hash value = 187909973
-o32sr.rssaeatmaxsize='Sparse array is at the maximum size'
-
-
-# hash value = 164284260
-o32sr.rsinvalidxmlfile='Invalid XMLStore File Format'
-
-
-# hash value = 254995412
-o32sr.rsunterminatedelement='Improperly terminated element'
-
-
-# hash value = 205947476
-o32sr.rsbadcolorconstant='Invalid color constant'
-
-
-# hash value = 38445685
-o32sr.rsbadcolorvalue='Invalid color value'
-
-
-# hash value = 240618073
-o32sr.rssaeoutofbounds='Index is out of bounds for sparse array'
-
-
-# hash value = 239028484
-o32sr.rsinvalidfieldtype='Requested field type is not supported'
-
-
-# hash value = 86960565
-o32sr.rsbadalarmhandle='Invalid alarm handle'
-
-
-# hash value = 131528196
-o32sr.rsonisselectednotassigned='OnIsSelected event is not assigned'
-
-
-# hash value = 167101369
-o32sr.rsinvaliddateformask='Invalid date value for picture mask. (Year is'+
-' outside the Epoch range)'
-
-
-# hash value = 202611508
-o32sr.rsviewerioerror='Viewer triggered I/O error %d'
-
-
-# hash value = 93066788
-o32sr.rsviewerfilenotfound='Viewer: file not found'
-
-
-# hash value = 93921701
-o32sr.rsviewerpathnotfound='Viewer: path not found or invalid file name'
-
-
-# hash value = 37810179
-o32sr.rsviewertoomanyopenfiles='Viewer: too many open files'
-
-
-# hash value = 137519748
-o32sr.rsviewerfileaccessdenied='Viewer: file access denied'
-
-
-# hash value = 206530819
-o32sr.rscontrolattached='This control is already attached to %s'
-
-
-# hash value = 94969973
-o32sr.rscantedit='Could not enter edit mode'
-
-
-# hash value = 258793572
-o32sr.rschildtableerror='Data Source can not be a child table. Component '+
-'%s has a MasterSource defined'
-
-
-# hash value = 54018357
-o32sr.rsnotableattached='DataSource must be attached to a TTable (or comp'+
-'atible) source'
-
-
-# hash value = 115453668
-o32sr.rsnocollection='No collection exists in the owner component'
-
-
-# hash value = 139674484
-o32sr.rsnotovcdescendant='Owner must be a TOvcComponent or TOvcCustomComp'+
-'onent descendant'
-
-
-# hash value = 9129726
-o32sr.rsitemincompatible='Item incompatible with collection'
-
-
-# hash value = 265712596
-o32sr.rslabelnotattached='Label not attached'
-
-
-# hash value = 172254164
-o32sr.rsclassnotset='Item class not set'
-
-
-# hash value = 240220981
-o32sr.rscollectionnotfound='No collection found for this type'
-
-
-# hash value = 58974537
-o32sr.rsdayconverterror='Error converting day'
-
-
-# hash value = 66692648
-o32sr.rsmonthconverterror='Error converting month'
-
-
-# hash value = 43703893
-o32sr.rsmonthnameconverterror='Error converting month name'
-
-
-# hash value = 138364850
-o32sr.rsyearconverterror='Error converting year'
-
-
-# hash value = 44447241
-o32sr.rsinvalidday='Invalid day'
-
-
-# hash value = 105965320
-o32sr.rsinvalidmonth='Invalid month'
-
-
-# hash value = 12864069
-o32sr.rsinvalidmonthname='Invalid month name'
-
-
-# hash value = 174207906
-o32sr.rsinvalidyear='Invalid year'
-
-
-# hash value = 133961140
-o32sr.rsdayrequired='Day is required'
-
-
-# hash value = 114309780
-o32sr.rsmonthrequired='Month is required'
-
-
-# hash value = 150971572
-o32sr.rsyearrequired='Year is required'
-
-
-# hash value = 99732068
-o32sr.rsownermustbeform='Owner must be a TForm or descendant'
-
-
-# hash value = 256079797
-o32sr.rstimeconverterror='Error converting time value'
-
-
-# hash value = 70100255
-o32sr.rscancelquery='Cancel and lose changes?'
-
-
-# hash value = 124996276
-o32sr.rsnopagesassigned='No notebook pages assigned'
-
-
-# hash value = 147502133
-o32sr.rsrestoremi='&Restore'
-
-
-# hash value = 305108
-o32sr.rscutmi='Cu&t'
-
-
-# hash value = 2795129
-o32sr.rscopymi='&Copy'
-
-
-# hash value = 45517477
-o32sr.rspastemi='&Paste'
-
-
-# hash value = 179055749
-o32sr.rsdeletemi='&Delete'
-
-
-# hash value = 171665052
-o32sr.rsselectallmi='Select &All'
-
-
-# hash value = 124993891
-o32sr.rstablerowoutofbounds='Table row out of bounds'
-
-
-# hash value = 173710098
-o32sr.rstablemaxrows='Table max rows error'
-
-
-# hash value = 172411506
-o32sr.rstablemaxcolumns='Table max columns error'
-
-
-# hash value = 162625570
-o32sr.rstablegeneral='Table general error'
-
-
-# hash value = 259026723
-o32sr.rstabletomanycolumns='Too many columns'
-
-
-# hash value = 6303816
-o32sr.rstableinvalidfieldindex='Invalid field index'
-
-
-# hash value = 10366516
-o32sr.rstableheadernotassigned='Header not assigned'
-
-
-# hash value = 175419180
-o32sr.rstableinvalidheadercell='Invalid header cell'
-
-
-# hash value = 296859
-o32sr.rscalcback='Back'
-
-
-# hash value = 1299
-o32sr.rscalcmc='MC'
-
-
-# hash value = 1314
-o32sr.rscalcmr='MR'
-
-
-# hash value = 1315
-o32sr.rscalcms='MS'
-
-
-# hash value = 1275
-o32sr.rscalcmplus='M+'
-
-
-# hash value = 1277
-o32sr.rscalcmminus='M-'
-
-
-# hash value = 1156
-o32sr.rscalcct='CT'
-
-
-# hash value = 1141
-o32sr.rscalcce='CE'
-
-
-# hash value = 67
-o32sr.rscalcc='C'
-
-
-# hash value = 370836
-o32sr.rscalcsqrt='Sqrt'
-
-
-# hash value = 338644
-o32sr.rscalnext='NEXT'
-
-
-# hash value = 329348
-o32sr.rscallast='LAST'
-
-
-# hash value = 349862
-o32sr.rscalprev='PREV'
-
-
-# hash value = 4908932
-o32sr.rscalfirst='FIRST'
-
-
-# hash value = 13956
-o32sr.rscal1st='1ST'
-
-
-# hash value = 91849764
-o32sr.rscalsecond='SECOND'
-
-
-# hash value = 14116
-o32sr.rscal2nd='2ND'
-
-
-# hash value = 5820004
-o32sr.rscalthird='THIRD'
-
-
-# hash value = 14436
-o32sr.rscal3rd='3RD'
-
-
-# hash value = 78948232
-o32sr.rscalfourth='FOURTH'
-
-
-# hash value = 14728
-o32sr.rscal4th='4TH'
-
-
-# hash value = 4907612
-o32sr.rscalfinal='FINAL'
-
-
-# hash value = 18237
-o32sr.rscalbom='BOM'
-
-
-# hash value = 4627422
-o32sr.rscalbegin='BEGIN'
-
-
-# hash value = 19005
-o32sr.rscaleom='EOM'
-
-
-# hash value = 18980
-o32sr.rscalend='END'
-
-
-# hash value = 143275465
-o32sr.rscalyesterday='YESTERDAY'
-
-
-# hash value = 5847145
-o32sr.rscaltoday='TODAY'
-
-
-# hash value = 69498071
-o32sr.rscaltomorrow='TOMORROW'
-
-
-# hash value = 80477938
-o32sr.rseditingsections='Header Sections Editor'
-
-
-# hash value = 248718130
-o32sr.rseditingitems='Folder Items Editor'
-
-
-# hash value = 165259106
-o32sr.rseditingfolders='Folder Editor'
-
-
-# hash value = 31027826
-o32sr.rseditingpages='Tab Pages Editor'
-
-
-# hash value = 60438738
-o32sr.rseditingimages='Image List Editor'
-
-
-# hash value = 163229710
-o32sr.rssectionbasename='Section'
-
-
-# hash value = 330429
-o32sr.rsitembasename='Item'
-
-
-# hash value = 81144514
-o32sr.rsfolderbasename='Folder'
-
-
-# hash value = 354261
-o32sr.rspagebasename='Page'
-
-
-# hash value = 5257173
-o32sr.rsimagebasename='Image'
-
-
-# hash value = 5205139
-o32sr.rshoursname='Hours'
-
-
-# hash value = 67488403
-o32sr.rsminutesname='Minutes'
-
-
-# hash value = 163210467
-o32sr.rssecondsname='Seconds'
-
-
-# hash value = 4863637
-o32sr.rsclosecaption='Close'
-
-
-# hash value = 268126580
-o32sr.rsviewfieldnotfound='The view field %s was not found'
-
-
-# hash value = 17553811
-o32sr.rscantresolvefield='Unable to resolve view field %s'
-
-
-# hash value = 160173704
-o32sr.rsitemalreadyexists='Can'#39't add item %p - it already exists in t'+
-'he index'
-
-
-# hash value = 108159061
-o32sr.rsalreadyintempmode='The view is already in temporary index mode'
-
-
-# hash value = 17830740
-o32sr.rsitemnotfound='Specified report view data item %p was not found'
-
-
-# hash value = 201152055
-o32sr.rsupdatepending='This report view operation is invalid while update'+
-'s are pending'
-
-
-# hash value = 76579668
-o32sr.rsoncomparenotassigned='OnCompareFields not assigned'
-
-
-# hash value = 113924180
-o32sr.rsonfilternotassigned='OnFilter not assigned'
-
-
-# hash value = 141112020
-o32sr.rsgetasfloatnotassigned='GetAsFloat not assigned'
-
-
-# hash value = 164581701
-o32sr.rsnotintempmode='Report view is not in temporary index mode'
-
-
-# hash value = 139773240
-o32sr.rsitemnotinindex='The specified data item (%p) is not in the index'
-
-
-# hash value = 219185047
-o32sr.rsnoactiveview='No active view'
-
-
-# hash value = 207431808
-o32sr.rsitemisnotgroup='Item at line %d is not a group'
-
-
-# hash value = 244079028
-o32sr.rsnotmultiselect='This report view operation is only allowed when m'+
-'ultiselect is enabled'
-
-
-# hash value = 210158068
-o32sr.rslinenooutofrange='Invalid index %d'
-
-
-# hash value = 178454563
-o32sr.rsunknownview='Unknown view: %s'
-
-
-# hash value = 170685332
-o32sr.rsonkeysearchnotassigned='The OnKeySearch event is not assigned'
-
-
-# hash value = 41277828
-o32sr.rsonenumnotassigned='The OnEnum event is not assigned'
-
-
-# hash value = 53442292
-o32sr.rsonenumselectedna='OnEnumSelected not assigned'
-
-
-# hash value = 218640564
-o32sr.rsnomenuassigned='No menu item assigned'
-
-
-# hash value = 251158724
-o32sr.rsnoanchorassigned='No anchor item assigned'
-
-
-# hash value = 80460738
-o32sr.rsinvalidparameter='Invalid parameter: mpAnchor'
-
-
-# hash value = 198347043
-o32sr.rsinvalidoperation='Invalid operation: Call AddSplit for split menu'+
-'s'
-
-
-# hash value = 120111635
-o32sr.rsformuseonly='This component can only be used on forms'
-
-
-# hash value = 4794267
-o32sr.rscolorblack='Black'
-
-
-# hash value = 87594590
-o32sr.rscolormaroon='Maroon'
-
-
-# hash value = 5147582
-o32sr.rscolorgreen='Green'
-
-
-# hash value = 5648581
-o32sr.rscolorolive='Olive'
-
-
-# hash value = 346329
-o32sr.rscolornavy='Navy'
-
-
-# hash value = 92051237
-o32sr.rscolorpurple='Purple'
-
-
-# hash value = 371580
-o32sr.rscolorteal='Teal'
-
-
-# hash value = 321673
-o32sr.rscolorgray='Gray'
-
-
-# hash value = 94387394
-o32sr.rscolorsilver='Silver'
-
-
-# hash value = 22708
-o32sr.rscolorred='Red'
-
-
-# hash value = 340021
-o32sr.rscolorlime='Lime'
-
-
-# hash value = 100414311
-o32sr.rscoloryellow='Yellow'
-
-
-# hash value = 299957
-o32sr.rscolorblue='Blue'
-
-
-# hash value = 230291889
-o32sr.rscolorfuchsia='Fuchsia'
-
-
-# hash value = 297137
-o32sr.rscoloraqua='Aqua'
-
-
-# hash value = 6156453
-o32sr.rscolorwhite='White'
-
-
-# hash value = 258066265
-o32sr.rscolorlightgray='Light Gray'
-
-
-# hash value = 195515273
-o32sr.rscolormediumgray='Medium Gray'
-
-
-# hash value = 148152841
-o32sr.rscolordarkgray='Dark Gray'
-
-
-# hash value = 186314622
-o32sr.rscolormoneygreen='Money Green'
-
-
-# hash value = 45389333
-o32sr.rscolorskyblue='Sky Blue'
-
-
-# hash value = 4885373
-o32sr.rscolorcream='Cream'
-
-
-# hash value = 110646853
-o32sr.ccnonestr='ccNone'
-
-
-# hash value = 110593947
-o32sr.ccbackstr='ccBack'
-
-
-# hash value = 154279605
-o32sr.ccbotofpagestr='ccBotOfPage'
-
-
-# hash value = 174982732
-o32sr.ccbotrightcellstr='ccBotRightCell'
-
-
-# hash value = 185592085
-o32sr.cccompletedatestr='ccCompleteDate'
-
-
-# hash value = 185397125
-o32sr.cccompletetimestr='ccCompleteTime'
-
-
-# hash value = 110601849
-o32sr.cccopystr='ccCopy'
-
-
-# hash value = 194382114
-o32sr.ccctrlcharstr='ccCtrlChar'
-
-
-# hash value = 6912708
-o32sr.cccutstr='ccCut'
-
-
-# hash value = 6912691
-o32sr.ccdecstr='ccDec'
-
-
-# hash value = 6912700
-o32sr.ccdelstr='ccDel'
-
-
-# hash value = 128716748
-o32sr.ccdelbolstr='ccDelBol'
-
-
-# hash value = 128716492
-o32sr.ccdeleolstr='ccDelEol'
-
-
-# hash value = 180438837
-o32sr.ccdellinestr='ccDelLine'
-
-
-# hash value = 180473844
-o32sr.ccdelwordstr='ccDelWord'
-
-
-# hash value = 110606046
-o32sr.ccdownstr='ccDown'
-
-
-# hash value = 6913092
-o32sr.ccendstr='ccEnd'
-
-
-# hash value = 249526654
-o32sr.ccextenddownstr='ccExtendDown'
-
-
-# hash value = 183367860
-o32sr.ccextendendstr='ccExtendEnd'
-
-
-# hash value = 249510805
-o32sr.ccextendhomestr='ccExtendHome'
-
-
-# hash value = 249619572
-o32sr.ccextendleftstr='ccExtendLeft'
-
-
-# hash value = 249472014
-o32sr.ccextendpgdnstr='ccExtendPgDn'
-
-
-# hash value = 249471840
-o32sr.ccextendpgupstr='ccExtendPgUp'
-
-
-# hash value = 233047828
-o32sr.ccextendrightstr='ccExtendRight'
-
-
-# hash value = 263118336
-o32sr.ccextendupstr='ccExtendUp'
-
-
-# hash value = 9762773
-o32sr.ccextbotofpagestr='ccExtBotOfPage'
-
-
-# hash value = 241626181
-o32sr.ccextfirstpagestr='ccExtFirstPage'
-
-
-# hash value = 30776981
-o32sr.ccextlastpagestr='ccExtLastPage'
-
-
-# hash value = 76872229
-o32sr.ccexttopofpagestr='ccExtTopOfPage'
-
-
-# hash value = 267768340
-o32sr.ccextwordleftstr='ccExtWordLeft'
-
-
-# hash value = 257384708
-o32sr.ccextwordrightstr='ccExtWordRight'
-
-
-# hash value = 163584725
-o32sr.ccfirstpagestr='ccFirstPage'
-
-
-# hash value = 183990064
-o32sr.ccgotomarker0str='ccGotoMarker0'
-
-
-# hash value = 183990065
-o32sr.ccgotomarker1str='ccGotoMarker1'
-
-
-# hash value = 183990066
-o32sr.ccgotomarker2str='ccGotoMarker2'
-
-
-# hash value = 183990067
-o32sr.ccgotomarker3str='ccGotoMarker3'
-
-
-# hash value = 183990068
-o32sr.ccgotomarker4str='ccGotoMarker4'
-
-
-# hash value = 183990069
-o32sr.ccgotomarker5str='ccGotoMarker5'
-
-
-# hash value = 183990070
-o32sr.ccgotomarker6str='ccGotoMarker6'
-
-
-# hash value = 183990071
-o32sr.ccgotomarker7str='ccGotoMarker7'
-
-
-# hash value = 183990072
-o32sr.ccgotomarker8str='ccGotoMarker8'
-
-
-# hash value = 183990073
-o32sr.ccgotomarker9str='ccGotoMarker9'
-
-
-# hash value = 110622261
-o32sr.cchomestr='ccHome'
-
-
-# hash value = 6914115
-o32sr.ccincstr='ccInc'
-
-
-# hash value = 6914131
-o32sr.ccinsstr='ccIns'
-
-
-# hash value = 145752053
-o32sr.cclastpagestr='ccLastPage'
-
-
-# hash value = 110635988
-o32sr.ccleftstr='ccLeft'
-
-
-# hash value = 80496581
-o32sr.ccnewlinestr='ccNewLine'
-
-
-# hash value = 218103701
-o32sr.ccnextpagestr='ccNextPage'
-
-
-# hash value = 132166580
-o32sr.ccpageleftstr='ccPageLeft'
-
-
-# hash value = 230783876
-o32sr.ccpagerightstr='ccPageRight'
-
-
-# hash value = 159812293
-o32sr.ccpastestr='ccPaste'
-
-
-# hash value = 147718053
-o32sr.ccprevpagestr='ccPrevPage'
-
-
-# hash value = 110660527
-o32sr.ccredostr='ccRedo'
-
-
-# hash value = 147513093
-o32sr.ccrestorestr='ccRestore'
-
-
-# hash value = 159972756
-o32sr.ccrightstr='ccRight'
-
-
-# hash value = 80235598
-o32sr.ccscrolldownstr='ccScrollDown'
-
-
-# hash value = 177523024
-o32sr.ccscrollupstr='ccScrollUp'
-
-
-# hash value = 85033152
-o32sr.ccsetmarker0str='ccSetMarker0'
-
-
-# hash value = 85033153
-o32sr.ccsetmarker1str='ccSetMarker1'
-
-
-# hash value = 85033154
-o32sr.ccsetmarker2str='ccSetMarker2'
-
-
-# hash value = 85033155
-o32sr.ccsetmarker3str='ccSetMarker3'
-
-
-# hash value = 85033156
-o32sr.ccsetmarker4str='ccSetMarker4'
-
-
-# hash value = 85033157
-o32sr.ccsetmarker5str='ccSetMarker5'
-
-
-# hash value = 85033158
-o32sr.ccsetmarker6str='ccSetMarker6'
-
-
-# hash value = 85033159
-o32sr.ccsetmarker7str='ccSetMarker7'
-
-
-# hash value = 85033160
-o32sr.ccsetmarker8str='ccSetMarker8'
-
-
-# hash value = 85033161
-o32sr.ccsetmarker9str='ccSetMarker9'
-
-
-# hash value = 6916722
-o32sr.cctabstr='ccTab'
-
-
-# hash value = 155201908
-o32sr.cctableeditstr='ccTableEdit'
-
-
-# hash value = 39059308
-o32sr.cctopleftcellstr='ccTopLeftCell'
-
-
-# hash value = 87223477
-o32sr.cctopofpagestr='ccTopOfPage'
-
-
-# hash value = 110675119
-o32sr.ccundostr='ccUndo'
-
-
-# hash value = 432320
-o32sr.ccupstr='ccUp'
-
-
-# hash value = 110080820
-o32sr.ccwordleftstr='ccWordLeft'
-
-
-# hash value = 150041492
-o32sr.ccwordrightstr='ccWordRight'
-
-
-# hash value = 95129671
-o32sr.stringstr='String'
-
-
-# hash value = 302722
-o32sr.charstr='Char'
-
-
-# hash value = 157690686
-o32sr.booleanstr='Boolean'
-
-
-# hash value = 6277199
-o32sr.yesnostr='YesNo'
-
-
-# hash value = 56934404
-o32sr.longintstr='LongInt'
-
-
-# hash value = 386692
-o32sr.wordstr='Word'
-
-
-# hash value = 58919924
-o32sr.smallintstr='SmallInt'
-
-
-# hash value = 303269
-o32sr.bytestr='Byte'
-
-
-# hash value = 258575300
-o32sr.shortintstr='ShortInt'
-
-
-# hash value = 363388
-o32sr.realstr='Real'
-
-
-# hash value = 262950516
-o32sr.extendedstr='Extended'
-
-
-# hash value = 79083813
-o32sr.doublestr='Double'
-
-
-# hash value = 94391845
-o32sr.singlestr='Single'
-
-
-# hash value = 304704
-o32sr.compstr='Comp'
-
-
-# hash value = 305317
-o32sr.datestr='Date'
-
-
-# hash value = 372789
-o32sr.timestr='Time'
-
-
-# hash value = 14246210
-o32sr.charmask1str='X any character'
-
-
-# hash value = 176123385
-o32sr.charmask2str='! any char (upper)'
-
-
-# hash value = 128900505
-o32sr.charmask3str='L any char (lower)'
-
-
-# hash value = 60353161
-o32sr.charmask4str='x any char (mixed)'
-
-
-# hash value = 171931113
-o32sr.charmask5str='a alphas only'
-
-
-# hash value = 216715241
-o32sr.charmask6str='A alphas (upper)'
-
-
-# hash value = 238452713
-o32sr.charmask7str='l alphas (lower)'
-
-
-# hash value = 62010121
-o32sr.charmask8str='9 0-9'
-
-
-# hash value = 53531917
-o32sr.charmask9str='i 0-9, -'
-
-
-# hash value = 162581806
-o32sr.charmask10str='# 0-9, -, .'
-
-
-# hash value = 80873294
-o32sr.charmask11str='E 0-9, E, -, .'
-
-
-# hash value = 148737417
-o32sr.charmask12str='K 0-9, A-F (hex)'
-
-
-# hash value = 225029081
-o32sr.charmask14str='O 0-7 (octal)'
-
-
-# hash value = 169998697
-o32sr.charmask15str='b 0, 1 (binary)'
-
-
-# hash value = 149356809
-o32sr.charmask16str='B T or F (upper)'
-
-
-# hash value = 150477273
-o32sr.charmask17str='Y Y or N (upper)'
-
-
-# hash value = 97122065
-o32sr.charmask18str='1 User 1'
-
-
-# hash value = 97120274
-o32sr.charmask19str='2 User 2'
-
-
-# hash value = 97120531
-o32sr.charmask20str='3 User 3'
-
-
-# hash value = 97120788
-o32sr.charmask21str='4 User 4'
-
-
-# hash value = 97121045
-o32sr.charmask22str='5 User 5'
-
-
-# hash value = 97123350
-o32sr.charmask23str='6 User 6'
-
-
-# hash value = 97123607
-o32sr.charmask24str='7 User 7'
-
-
-# hash value = 97123864
-o32sr.charmask25str='8 User 8'
-
-
-# hash value = 25870412
-o32sr.fieldmask1str='$##,###.## Allows entry of 0 through 9, spa'+
-'ce, minus, and period Uses floating currency symbol'
-
-
-# hash value = 192143781
-o32sr.fieldmask2str='9999999999 Allows entry of 0 through 9, and'+
-' space'
-
-
-# hash value = 150217363
-o32sr.fieldmask3str='iiiiiiiiii Allows entry of 0 through 9, spa'+
-'ce, and minus'
-
-
-# hash value = 159131796
-o32sr.fieldmask4str='ii,iii,iii Allows entry of 0 through 9, spa'+
-'ce, and minus Displays number separators as needed'
-
-
-# hash value = 187563852
-o32sr.fieldmask5str='$iiiiiiiii Allows entry of 0 through 9, spa'+
-'ce, and minus Uses floating currency symbol'
-
-
-# hash value = 91771796
-o32sr.fieldmask6str='########## Allows entry of 0 through 9, spa'+
-'ce, minus, and period'
-
-
-# hash value = 150058862
-o32sr.fieldmask7str='#######.## Allows entry of 0 through 9, spa'+
-'ce, minus, and period Fixed decimal position'
-
-
-# hash value = 118082020
-o32sr.fieldmask8str='###,###.## Allows entry of 0 through 9, spa'+
-'ce, minus, and period Displays number separators as needed'
-
-
-# hash value = 203254956
-o32sr.fieldmask9str='$######.## Allows entry of 0 through 9, spa'+
-'ce, minus, and period Fixed decimal position Uses floating currency symb'+
-'ol'
-
-
-# hash value = 233619849
-o32sr.fieldmask10str='##########p Allows entry of 0 through 9, sp'+
-'ace, minus, and period Negative amounts use ()'
-
-
-# hash value = 23482388
-o32sr.fieldmask11str='###,###.##C Allows entry of 0 through 9, sp'+
-'ace, minus, and period Currency symbol at right'
-
-
-# hash value = 174256005
-o32sr.fieldmask12str='KKKKKKKK Hexadecimal (E4401F3E) Allows e'+
-'ntry of 0 through 9 and A through F Force upper case'
-
-
-# hash value = 160543589
-o32sr.fieldmask13str='KKKK Hexadecimal (1F3E) Allows entry'+
-' of 0 through 9 and A through F Force upper case'
-
-
-# hash value = 54097189
-o32sr.fieldmask14str='KK Hexadecimal (3E) Allows entry o'+
-'f 0 through 9 and A through F Force upper case'
-
-
-# hash value = 118534928
-o32sr.fieldmask15str='OOOOOOOO Octal (45135677) Allows entry o'+
-'f 0 through 7 '
-
-
-# hash value = 157956416
-o32sr.fieldmask16str='OOOO Octal (5677) Allows entry of 0 '+
-'through 7 '
-
-
-# hash value = 214007281
-o32sr.fieldmask17str='bbbbbbbbbbbbbbbb Binary (0101001010010100) Allow'+
-'s entry of 0 and 1'
-
-
-# hash value = 77656481
-o32sr.fieldmask18str='bbbbbbbb Binary (10010100) Allows entry '+
-'of 0 and 1'
-
-
-# hash value = 6873412
-o32sr.fieldmask19str='XXXXXXXXXX Any character can be entered'
-
-
-# hash value = 43546997
-o32sr.fieldmask20str='!!!!!!!!!! Any character can be entered Al'+
-'phabetic characters are forced to upper case'
-
-
-# hash value = 216754981
-o32sr.fieldmask21str='LLLLLLLLLL Any character can be entered Al'+
-'phabetic characters are forced to lower case'
-
-
-# hash value = 72846341
-o32sr.fieldmask22str='xxxxxxxxxx Any character can be entered Us'+
-'es mixed case'
-
-
-# hash value = 180843617
-o32sr.fieldmask23str='aaaaaaaaaa Alphabetic characters plus spac'+
-'e, minus, period, and comma'
-
-
-# hash value = 259223541
-o32sr.fieldmask24str='AAAAAAAAAA Alphabetic characters plus spac'+
-'e, minus, period, and comma Alphabetic characters are forced to upper ca'+
-'se'
-
-
-# hash value = 155046869
-o32sr.fieldmask25str='llllllllll Alphabetic characters plus spac'+
-'e, minus, period, and comma Alphabetic characters are forced to lower ca'+
-'se'
-
-
-# hash value = 178904805
-o32sr.fieldmask26str='(999) 999-9999 Phone number mask Allows 0 thro'+
-'ugh 9 and space'
-
-
-# hash value = 62017877
-o32sr.fieldmask27str='999-999-9999 Phone number mask Allows 0 thro'+
-'ugh 9 and space'
-
-
-# hash value = 107877989
-o32sr.fieldmask28str='99999-9999 US Zip Code mask Allows 0 throu'+
-'gh 9 and space'
-
-
-# hash value = 159165621
-o32sr.fieldmask29str='B Boolean mask Allows T, t, F, f '+
-'Forces input to upper case'
-
-
-# hash value = 226688133
-o32sr.fieldmask30str='Y Boolean mask Allows Y, y, N, n '+
-'Forces input to upper case'
-
-
-# hash value = 239529939
-o32sr.fieldmask31str='mm/dd/yy Date mask (01/05/96) Allows ent'+
-'ry of 0 through 9 plus space Month and Day are padded with zeros'
-
-
-# hash value = 265314611
-o32sr.fieldmask32str='mm/dd/yyyy Date mask (01/05/1996) Allows e'+
-'ntry of 0 through 9 plus space Month and Day are padded with zeros'
-
-
-# hash value = 140332467
-o32sr.fieldmask33str='dd nnn yyyy Date mask (05 Jan 1996) Allows '+
-'entry of 0 through 9 plus space Day is padded with zeros'
-
-
-# hash value = 60758483
-o32sr.fieldmask34str='MM/DD/yy Date mask ( 1/ 5/96) Allows ent'+
-'ry of 0 through 9 plus space Month and Day are padded with spaces'
-
-
-# hash value = 129420707
-o32sr.fieldmask35str='MM/DD/yyyy Date mask ( 1/ 5/1996) Allows e'+
-'ntry of 0 through 9 plus space Month and Day are padded with spaces'
-
-
-# hash value = 162411587
-o32sr.fieldmask36str='DD nnn yyyy Date mask ( 5 Jan 1996) Allows '+
-'entry of 0 through 9 plus space Day is padded with spaces'
-
-
-# hash value = 115637257
-o32sr.fieldmask37str='hh:mm Time mask (03:25) Allows entry '+
-'of 0 through 9 plus space Hours and minutes are padded with zeros (24 ho'+
-'ur clock)'
-
-
-# hash value = 110050003
-o32sr.fieldmask38str='hh:mm tt Time mask (03:25 pm) Allows ent'+
-'ry of 0 through 9 plus space Hours and minutes are padded with zeros'
-
-
-# hash value = 119359011
-o32sr.fieldmask39str='hh:mm:ss Time mask (03:25:07) Allows ent'+
-'ry of 0 through 9 plus space Hours, minutes, and seconds are padded with'+
-' zeros'
-
-
-# hash value = 151520073
-o32sr.fieldmask40str='HH:MM Time mask ( 3:25) Allows entry '+
-'of 0 through 9 plus space Hours and minutes are padded with spaces (24 h'+
-'our clock)'
-
-
-# hash value = 156598435
-o32sr.fieldmask41str='HH:MM tt Time mask ( 3:25 pm) Allows ent'+
-'ry of 0 through 9 plus space Hours and minutes are padded with spaces'
-
-
-# hash value = 105549971
-o32sr.fieldmask42str='HH:MM:SS Time mask ( 3:25: 7) Allows ent'+
-'ry of 0 through 9 plus space Hours, minutes, and seconds are padded with'+
-' spaces'
-
diff --git a/Source/3rdParty/Orpheus/units/i386-win32/o32sr.rsj b/Source/3rdParty/Orpheus/units/i386-win32/o32sr.rsj
deleted file mode 100644
index 4b00ea54..00000000
--- a/Source/3rdParty/Orpheus/units/i386-win32/o32sr.rsj
+++ /dev/null
@@ -1,377 +0,0 @@
-{"version":1,"strings":[
-{"hash":47539321,"name":"o32sr.rsnonestr","sourcebytes":[40,78,111,110,101,41],"value":"(None)"},
-{"hash":110676418,"name":"o32sr.rsccuser","sourcebytes":[99,99,85,115,101,114],"value":"ccUser"},
-{"hash":147440164,"name":"o32sr.rsccusernum","sourcebytes":[99,99,85,115,101,114,37,100],"value":"ccUser%d"},
-{"hash":23862543,"name":"o32sr.rsdeletetable","sourcebytes":[68,101,108,101,116,101,32,116,104,101,32,37,115,32,116,97,98,108,101,63],"value":"Delete the %s table?"},
-{"hash":47591701,"name":"o32sr.rsrenametable","sourcebytes":[82,101,110,97,109,101,32,84,97,98,108,101],"value":"Rename Table"},
-{"hash":62914634,"name":"o32sr.rsentertablename","sourcebytes":[69,110,116,101,114,32,110,101,119,32,116,97,98,108,101,32,110,97,109,101,32,102,111,114,32,37,115,58],"value":"Enter new table name for %s:"},
-{"hash":214597221,"name":"o32sr.rsnewtable","sourcebytes":[78,101,119,84,97,98,108,101],"value":"NewTable"},
-{"hash":180128884,"name":"o32sr.rsdefaulttablename","sourcebytes":[68,101,102,97,117,108,116],"value":"Default"},
-{"hash":109686626,"name":"o32sr.rswordstartablename","sourcebytes":[87,111,114,100,83,116,97,114],"value":"WordStar"},
-{"hash":321780,"name":"o32sr.rsgridtablename","sourcebytes":[71,114,105,100],"value":"Grid"},
-{"hash":86327753,"name":"o32sr.rsunknowntable","sourcebytes":[40,85,110,107,110,111,119,110,41],"value":"(Unknown)"},
-{"hash":184599794,"name":"o32sr.rsdefaultentryerrortext","sourcebytes":[69,110,116,114,121,32,69,114,114,111,114],"value":"Entry Error"},
-{"hash":44316689,"name":"o32sr.rsgotitemwarning","sourcebytes":[37,100,46,32,42,42,42,32,87,97,114,110,105,110,103,32,42,42,42,32,79,110,71,101,116,73,116,101,109,32,110,111,116,32,97,115,115,105,103,110,101,100,33],"value":"%d. *** Warning *** OnGetItem not assigned!"},
-{"hash":164121725,"name":"o32sr.rssamplelistitem","sourcebytes":[37,100,46,32,45,32,83,97,109,112,108,101,32,118,105,114,116,117,97,108,32,108,105,115,116,32,98,111,120,32,105,116,101,109],"value":"%d. - Sample virtual list box item"},
-{"hash":61396826,"name":"o32sr.rsalphastring","sourcebytes":[97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90],"value":"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"},
-{"hash":1513,"name":"o32sr.rstalllowchars","sourcebytes":[87,121],"value":"Wy"},
-{"hash":180128884,"name":"o32sr.rsdefault","sourcebytes":[68,101,102,97,117,108,116],"value":"Default"},
-{"hash":89,"name":"o32sr.rsyes","sourcebytes":[89],"value":"Y"},
-{"hash":78,"name":"o32sr.rsno","sourcebytes":[78],"value":"N"},
-{"hash":84,"name":"o32sr.rstrue","sourcebytes":[84],"value":"T"},
-{"hash":70,"name":"o32sr.rsfalse","sourcebytes":[70],"value":"F"},
-{"hash":49589427,"name":"o32sr.rsdescending","sourcebytes":[32,45,32,68,101,115,99],"value":" - Desc"},
-{"hash":197701577,"name":"o32sr.rsdefaultindex","sourcebytes":[40,68,101,102,97,117,108,116,41],"value":"(Default)"},
-{"hash":86025029,"name":"o32sr.rsduplicatecommand","sourcebytes":[68,117,112,108,105,99,97,116,101,32,99,111,109,109,97,110,100,32,102,111,117,110,100,32,119,104,105,108,101,32,97,100,100,105,110,103,32,97,32,110,101,119,32,99,111,109,109,97,110,100,32,116,111,32,116,104,101,32,116,97,98,108,101],"value":"Duplicate command found while adding a new command to the table"},
-{"hash":189452597,"name":"o32sr.rstablenotfound","sourcebytes":[67,111,109,109,97,110,100,32,116,97,98,108,101,32,110,111,116,32,102,111,117,110,100,32,111,114,32,99,111,109,109,97,110,100,32,116,97,98,108,101,32,105,110,100,101,120,32,111,117,116,32,111,102,32,114,97,110,103,101],"value":"Command table not found or command table index out of range"},
-{"hash":73438661,"name":"o32sr.rsnotdoneyet","sourcebytes":[84,104,105,115,32,102,101,97,116,117,114,101,32,105,115,32,110,111,116,32,105,109,112,108,101,109,101,110,116,101,100,32,97,116,32,116,104,105,115,32,116,105,109,101],"value":"This feature is not implemented at this time"},
-{"hash":64194580,"name":"o32sr.rsnocontrollerassigned","sourcebytes":[78,111,32,67,111,110,116,114,111,108,108,101,114,32,97,115,115,105,103,110,101,100],"value":"No Controller assigned"},
-{"hash":35420549,"name":"o32sr.rscantcreatecommandtable","sourcebytes":[85,110,97,98,108,101,32,116,111,32,99,114,101,97,116,101,32,99,111,109,109,97,110,100,32,116,97,98,108,101],"value":"Unable to create command table"},
-{"hash":48081108,"name":"o32sr.rscantdelete","sourcebytes":[67,97,110,39,116,32,100,101,108,101,116,101,32,116,104,105,115,32,116,97,98,108,101,46,32,77,117,115,116,32,104,97,118,101,32,97,116,32,108,101,97,115,116,32,111,110,101,32,99,111,109,109,97,110,100,32,116,97,98,108,101,32,100,101,102,105,110,101,100],"value":"Can't delete this table. Must have at least one command table defined"},
-{"hash":20361444,"name":"o32sr.rsinvalidkeysequence","sourcebytes":[73,110,118,97,108,105,100,32,111,114,32,110,111,32,107,101,121,32,115,101,113,117,101,110,99,101,32,101,110,116,101,114,101,100],"value":"Invalid or no key sequence entered"},
-{"hash":242348867,"name":"o32sr.rsnotwordstarcommands","sourcebytes":[75,101,121,115,32,101,110,116,101,114,101,100,32,97,114,101,32,110,111,116,32,87,111,114,100,83,116,97,114,32,115,116,121,108,101,32,99,111,109,109,97,110,100,115],"value":"Keys entered are not WordStar style commands"},
-{"hash":240741204,"name":"o32sr.rsnocommandselected","sourcebytes":[78,111,32,99,111,109,109,97,110,100,32,115,101,108,101,99,116,101,100],"value":"No command selected"},
-{"hash":157959429,"name":"o32sr.rsduplicatekeysequence","sourcebytes":[68,117,112,108,105,99,97,116,101,32,107,101,121,32,115,101,113,117,101,110,99,101],"value":"Duplicate key sequence"},
-{"hash":973461,"name":"o32sr.rsrangeerror","sourcebytes":[86,97,108,117,101,32,105,115,32,110,111,116,32,119,105,116,104,105,110,32,114,101,113,117,105,114,101,100,32,114,97,110,103,101],"value":"Value is not within required range"},
-{"hash":206041701,"name":"o32sr.rsinvalidnumber","sourcebytes":[86,97,108,117,101,32,105,115,32,110,111,116,32,118,97,108,105,100,32,102,111,114,32,116,104,105,115,32,102,105,101,108,100,32,116,121,112,101],"value":"Value is not valid for this field type"},
-{"hash":230136804,"name":"o32sr.rsrequiredfield","sourcebytes":[65,32,118,97,108,117,101,32,105,115,32,114,101,113,117,105,114,101,100,32,105,110,32,116,104,105,115,32,102,105,101,108,100],"value":"A value is required in this field"},
-{"hash":92696485,"name":"o32sr.rsinvaliddate","sourcebytes":[86,97,108,117,101,32,105,115,32,110,111,116,32,97,32,118,97,108,105,100,32,100,97,116,101],"value":"Value is not a valid date"},
-{"hash":92760373,"name":"o32sr.rsinvalidtime","sourcebytes":[86,97,108,117,101,32,105,115,32,110,111,116,32,97,32,118,97,108,105,100,32,116,105,109,101],"value":"Value is not a valid time"},
-{"hash":104098179,"name":"o32sr.rsblanksinfield","sourcebytes":[84,104,105,115,32,102,105,101,108,100,32,115,104,111,117,108,100,32,99,111,110,116,97,105,110,32,110,111,32,98,108,97,110,107,115],"value":"This field should contain no blanks"},
-{"hash":190360572,"name":"o32sr.rspartialentry","sourcebytes":[84,104,105,115,32,102,105,101,108,100,32,115,104,111,117,108,100,32,98,101,32,101,105,116,104,101,114,32,101,109,112,116,121,32,111,114,32,99,111,109,112,108,101,116,101,108,121,32,102,117,108,108],"value":"This field should be either empty or completely full"},
-{"hash":66474265,"name":"o32sr.rsregiontoolarge","sourcebytes":[82,101,103,105,111,110,32,105,115,32,116,111,111,32,108,97,114,103,101,32,40,62,32,54,52,75,41],"value":"Region is too large (> 64K)"},
-{"hash":186038585,"name":"o32sr.rsoutofmemoryforcopy","sourcebytes":[67,111,117,108,100,32,110,111,116,32,97,108,108,111,99,97,116,101,32,109,101,109,111,114,121,32,102,111,114,32,99,108,105,112,98,111,97,114,100,32,99,111,112,121],"value":"Could not allocate memory for clipboard copy"},
-{"hash":31889508,"name":"o32sr.rsinvalidparamvalue","sourcebytes":[80,97,114,97,109,101,116,101,114,32,118,97,108,117,101,32,105,115,32,105,110,118,97,108,105,100],"value":"Parameter value is invalid"},
-{"hash":110743845,"name":"o32sr.rsnotimersavail","sourcebytes":[78,111,32,87,105,110,100,111,119,39,115,32,116,105,109,101,114,115,32,97,114,101,32,97,118,97,105,108,97,98,108,101],"value":"No Window's timers are available"},
-{"hash":219139891,"name":"o32sr.rstoomanyevents","sourcebytes":[84,111,111,32,109,97,110,121,32,116,114,105,103,103,101,114,32,101,118,101,110,116,115],"value":"Too many trigger events"},
-{"hash":103937301,"name":"o32sr.rsbadtriggerhandle","sourcebytes":[73,110,118,97,108,105,100,32,116,114,105,103,103,101,114,32,104,97,110,100,108,101],"value":"Invalid trigger handle"},
-{"hash":192553604,"name":"o32sr.rsonselectnotassigned","sourcebytes":[79,110,83,101,108,101,99,116,32,101,118,101,110,116,32,105,115,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"OnSelect event is not assigned"},
-{"hash":124954245,"name":"o32sr.rsinvalidpageindex","sourcebytes":[73,110,118,97,108,105,100,32,112,97,103,101,32,105,110,100,101,120,32,118,97,108,117,101],"value":"Invalid page index value"},
-{"hash":172862148,"name":"o32sr.rsinvaliddatatype","sourcebytes":[73,110,118,97,108,105,100,32,100,97,116,97,32,116,121,112,101,32,102,111,114,32,116,104,105,115,32,102,105,101,108,100],"value":"Invalid data type for this field"},
-{"hash":39861684,"name":"o32sr.rsinvalidtabfont","sourcebytes":[73,110,118,97,108,105,100,32,102,111,110,116,46,32,78,111,110,32,116,111,84,111,112,32,111,114,105,101,110,116,101,100,32,116,97,98,115,32,114,101,113,117,105,114,101,32,97,32,84,114,117,101,45,84,121,112,101,32,102,111,110,116],"value":"Invalid font. Non toTop oriented tabs require a True-Type font"},
-{"hash":69686484,"name":"o32sr.rsinvalidlabelfont","sourcebytes":[73,110,118,97,108,105,100,32,102,111,110,116,46,32,82,111,116,97,116,101,100,32,116,101,120,116,32,114,101,113,117,105,114,101,115,32,97,32,84,114,117,101,45,84,121,112,101,32,102,111,110,116],"value":"Invalid font. Rotated text requires a True-Type font"},
-{"hash":258097070,"name":"o32sr.rsoutofmemory","sourcebytes":[105,110,115,117,102,102,105,99,105,101,110,116,32,109,101,109,111,114,121,32,102,111,114,32,114,101,113,117,101,115,116,101,100,32,111,112,101,114,97,116,105,111,110],"value":"insufficient memory for requested operation"},
-{"hash":151298131,"name":"o32sr.rstoomanyparas","sourcebytes":[67,117,114,114,101,110,116,32,111,112,101,114,97,116,105,111,110,32,119,105,108,108,32,101,120,99,101,101,100,32,116,104,101,32,109,97,120,105,109,117,109,32,110,117,109,98,101,114,32,111,102,32,97,108,108,111,119,101,100,32,112,97,114,97,103,114,97,112,104,115],"value":"Current operation will exceed the maximum number of allowed paragraphs"},
-{"hash":88628149,"name":"o32sr.rscannotjoin","sourcebytes":[67,97,110,110,111,116,32,106,111,105,110,32,112,97,114,97,103,114,97,112,104,115,46,32,78,101,119,32,112,97,114,97,103,114,97,112,104,32,115,105,122,101,32,101,120,99,101,101,100,115,32,109,97,120,105,109,117,109,32,112,97,114,97,103,114,97,112,104,32,115,105,122,101],"value":"Cannot join paragraphs. New paragraph size exceeds maximum paragraph size"},
-{"hash":198920885,"name":"o32sr.rstoomanybytes","sourcebytes":[67,117,114,114,101,110,116,32,111,112,101,114,97,116,105,111,110,32,119,105,108,108,32,101,120,99,101,101,100,32,116,104,101,32,109,97,120,105,109,117,109,32,116,101,120,116,32,115,105,122,101],"value":"Current operation will exceed the maximum text size"},
-{"hash":158057429,"name":"o32sr.rsparatoolong","sourcebytes":[67,117,114,114,101,110,116,32,111,112,101,114,97,116,105,111,110,32,119,105,108,108,32,101,120,99,101,101,100,32,116,104,101,32,109,97,120,105,109,117,109,32,112,97,114,97,103,114,97,112,104,32,115,105,122,101],"value":"Current operation will exceed the maximum paragraph size"},
-{"hash":191420670,"name":"o32sr.rsunknownerror","sourcebytes":[85,110,107,110,111,119,110,32,69,114,114,111,114,32,99,111,110,100,105,116,105,111,110],"value":"Unknown Error condition"},
-{"hash":154407027,"name":"o32sr.rsinvalidpicturemask","sourcebytes":[73,110,118,97,108,105,100,32,112,105,99,116,117,114,101,32,109,97,115,107,58,32,37,115],"value":"Invalid picture mask: %s"},
-{"hash":13087785,"name":"o32sr.rsinvalidrange","sourcebytes":[73,110,118,97,108,105,100,32,114,97,110,103,101,46,32,69,110,116,101,114,32,97,32,118,97,108,117,101,32,98,101,116,119,101,101,110,32,40,37,100,41,32,97,110,100,32,40,37,100,41],"value":"Invalid range. Enter a value between (%d) and (%d)"},
-{"hash":248400601,"name":"o32sr.rsinvalidrealrange","sourcebytes":[73,110,118,97,108,105,100,32,114,97,110,103,101,46,32,69,110,116,101,114,32,97,32,118,97,108,117,101,32,98,101,116,119,101,101,110,32,40,45,49,46,55,101,43,51,56,41,32,97,110,100,32,40,43,49,46,55,101,43,51,56,41],"value":"Invalid range. Enter a value between (-1.7e+38) and (+1.7e+38)"},
-{"hash":264564361,"name":"o32sr.rsinvalidextendedrange","sourcebytes":[73,110,118,97,108,105,100,32,114,97,110,103,101,46,32,69,110,116,101,114,32,97,32,118,97,108,117,101,32,98,101,116,119,101,101,110,32,40,45,49,46,49,101,43,52,57,51,50,41,32,97,110,100,32,40,43,49,46,49,101,43,52,57,51,50,41],"value":"Invalid range. Enter a value between (-1.1e+4932) and (+1.1e+4932)"},
-{"hash":155966601,"name":"o32sr.rsinvaliddoublerange","sourcebytes":[73,110,118,97,108,105,100,32,114,97,110,103,101,46,32,69,110,116,101,114,32,97,32,118,97,108,117,101,32,98,101,116,119,101,101,110,32,40,45,49,46,55,101,43,51,48,56,41,32,97,110,100,32,40,43,49,46,55,101,43,51,48,56,41],"value":"Invalid range. Enter a value between (-1.7e+308) and (+1.7e+308)"},
-{"hash":246959545,"name":"o32sr.rsinvalidsinglerange","sourcebytes":[73,110,118,97,108,105,100,32,114,97,110,103,101,46,32,69,110,116,101,114,32,97,32,118,97,108,117,101,32,98,101,116,119,101,101,110,32,40,45,51,46,52,101,43,51,56,41,32,97,110,100,32,40,43,51,46,52,101,43,51,56,41],"value":"Invalid range. Enter a value between (-3.4e+38) and (+3.4e+38)"},
-{"hash":246828377,"name":"o32sr.rsinvalidcomprange","sourcebytes":[73,110,118,97,108,105,100,32,114,97,110,103,101,46,32,69,110,116,101,114,32,97,32,118,97,108,117,101,32,98,101,116,119,101,101,110,32,40,45,57,46,50,101,43,49,56,41,32,97,110,100,32,40,43,57,46,50,101,43,49,56,41],"value":"Invalid range. Enter a value between (-9.2e+18) and (+9.2e+18)"},
-{"hash":235266788,"name":"o32sr.rsinvaliddaterange","sourcebytes":[73,110,118,97,108,105,100,32,100,97,116,101,32,114,97,110,103,101,46,32,69,110,116,101,114,32,97,32,118,97,108,117,101,32,117,115,105,110,103,32,39,37,115,39,32,97,115,32,116,104,101,32,102,111,114,109,97,116],"value":"Invalid date range. Enter a value using '%s' as the format"},
-{"hash":91612132,"name":"o32sr.rsinvalidtimerange","sourcebytes":[73,110,118,97,108,105,100,32,116,105,109,101,32,114,97,110,103,101,46,32,69,110,116,101,114,32,97,32,118,97,108,117,101,32,117,115,105,110,103,32,39,37,115,39,32,97,115,32,116,104,101,32,102,111,114,109,97,116],"value":"Invalid time range. Enter a value using '%s' as the format"},
-{"hash":22644165,"name":"o32sr.rsinvalidrangevalue","sourcebytes":[73,110,118,97,108,105,100,32,114,97,110,103,101,32,118,97,108,117,101],"value":"Invalid range value"},
-{"hash":38619085,"name":"o32sr.rsinvalidminmaxvalue","sourcebytes":[73,110,118,97,108,105,100,32,118,97,108,117,101,32,45,32,77,97,120,105,109,117,109,32,109,117,115,116,32,97,108,119,97,121,115,32,98,101,32,103,114,101,97,116,101,114,32,116,104,97,110,32,77,105,110,105,109,117,109],"value":"Invalid value - Maximum must always be greater than Minimum"},
-{"hash":149815988,"name":"o32sr.rsrangenotsupported","sourcebytes":[82,97,110,103,101,32,108,105,109,105,116,115,32,102,111,114,32,116,104,101,32,99,117,114,114,101,110,116,108,121,32,115,101,108,101,99,116,101,100,32,100,97,116,97,32,116,121,112,101,32,97,114,101,32,110,111,116,32,115,117,112,112,111,114,116,101,100],"value":"Range limits for the currently selected data type are not supported"},
-{"hash":54276856,"name":"o32sr.rsinvalidlineorparaindex","sourcebytes":[73,110,118,97,108,105,100,32,108,105,110,101,32,111,114,32,112,97,114,97,103,114,97,112,104,32,105,110,100,101,120],"value":"Invalid line or paragraph index"},
-{"hash":77699476,"name":"o32sr.rsnonfixedfont","sourcebytes":[73,110,118,97,108,105,100,32,102,111,110,116,32,97,115,115,105,103,110,109,101,110,116,46,32,70,111,110,116,32,109,117,115,116,32,98,101,32,97,32,102,105,120,101,100,32,102,111,110,116],"value":"Invalid font assignment. Font must be a fixed font"},
-{"hash":83345268,"name":"o32sr.rsinvalidfontparam","sourcebytes":[73,110,118,97,108,105,100,32,102,111,110,116,32,97,115,115,105,103,110,101,109,110,116,46,32,70,111,110,116,32,109,117,115,116,32,98,101,32,97,32,84,70,111,110,116,32,111,114,32,84,79,118,99,70,105,120,101,100,70,111,110,116],"value":"Invalid font assignemnt. Font must be a TFont or TOvcFixedFont"},
-{"hash":252258974,"name":"o32sr.rsinvalidlineorcolumn","sourcebytes":[73,110,118,97,108,105,100,32,108,105,110,101,32,111,114,32,99,111,108,117,109,110],"value":"Invalid line or column"},
-{"hash":243786162,"name":"o32sr.rssaegeneral","sourcebytes":[85,110,107,110,111,119,110,32,115,112,97,114,115,101,32,97,114,114,97,121,32,101,114,114,111,114],"value":"Unknown sparse array error"},
-{"hash":187909973,"name":"o32sr.rssaeatmaxsize","sourcebytes":[83,112,97,114,115,101,32,97,114,114,97,121,32,105,115,32,97,116,32,116,104,101,32,109,97,120,105,109,117,109,32,115,105,122,101],"value":"Sparse array is at the maximum size"},
-{"hash":164284260,"name":"o32sr.rsinvalidxmlfile","sourcebytes":[73,110,118,97,108,105,100,32,88,77,76,83,116,111,114,101,32,70,105,108,101,32,70,111,114,109,97,116],"value":"Invalid XMLStore File Format"},
-{"hash":254995412,"name":"o32sr.rsunterminatedelement","sourcebytes":[73,109,112,114,111,112,101,114,108,121,32,116,101,114,109,105,110,97,116,101,100,32,101,108,101,109,101,110,116],"value":"Improperly terminated element"},
-{"hash":205947476,"name":"o32sr.rsbadcolorconstant","sourcebytes":[73,110,118,97,108,105,100,32,99,111,108,111,114,32,99,111,110,115,116,97,110,116],"value":"Invalid color constant"},
-{"hash":38445685,"name":"o32sr.rsbadcolorvalue","sourcebytes":[73,110,118,97,108,105,100,32,99,111,108,111,114,32,118,97,108,117,101],"value":"Invalid color value"},
-{"hash":240618073,"name":"o32sr.rssaeoutofbounds","sourcebytes":[73,110,100,101,120,32,105,115,32,111,117,116,32,111,102,32,98,111,117,110,100,115,32,102,111,114,32,115,112,97,114,115,101,32,97,114,114,97,121],"value":"Index is out of bounds for sparse array"},
-{"hash":239028484,"name":"o32sr.rsinvalidfieldtype","sourcebytes":[82,101,113,117,101,115,116,101,100,32,102,105,101,108,100,32,116,121,112,101,32,105,115,32,110,111,116,32,115,117,112,112,111,114,116,101,100],"value":"Requested field type is not supported"},
-{"hash":86960565,"name":"o32sr.rsbadalarmhandle","sourcebytes":[73,110,118,97,108,105,100,32,97,108,97,114,109,32,104,97,110,100,108,101],"value":"Invalid alarm handle"},
-{"hash":131528196,"name":"o32sr.rsonisselectednotassigned","sourcebytes":[79,110,73,115,83,101,108,101,99,116,101,100,32,101,118,101,110,116,32,105,115,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"OnIsSelected event is not assigned"},
-{"hash":167101369,"name":"o32sr.rsinvaliddateformask","sourcebytes":[73,110,118,97,108,105,100,32,100,97,116,101,32,118,97,108,117,101,32,102,111,114,32,112,105,99,116,117,114,101,32,109,97,115,107,46,32,40,89,101,97,114,32,105,115,32,111,117,116,115,105,100,101,32,116,104,101,32,69,112,111,99,104,32,114,97,110,103,101,41],"value":"Invalid date value for picture mask. (Year is outside the Epoch range)"},
-{"hash":202611508,"name":"o32sr.rsviewerioerror","sourcebytes":[86,105,101,119,101,114,32,116,114,105,103,103,101,114,101,100,32,73,47,79,32,101,114,114,111,114,32,37,100],"value":"Viewer triggered I\/O error %d"},
-{"hash":93066788,"name":"o32sr.rsviewerfilenotfound","sourcebytes":[86,105,101,119,101,114,58,32,102,105,108,101,32,110,111,116,32,102,111,117,110,100],"value":"Viewer: file not found"},
-{"hash":93921701,"name":"o32sr.rsviewerpathnotfound","sourcebytes":[86,105,101,119,101,114,58,32,112,97,116,104,32,110,111,116,32,102,111,117,110,100,32,111,114,32,105,110,118,97,108,105,100,32,102,105,108,101,32,110,97,109,101],"value":"Viewer: path not found or invalid file name"},
-{"hash":37810179,"name":"o32sr.rsviewertoomanyopenfiles","sourcebytes":[86,105,101,119,101,114,58,32,116,111,111,32,109,97,110,121,32,111,112,101,110,32,102,105,108,101,115],"value":"Viewer: too many open files"},
-{"hash":137519748,"name":"o32sr.rsviewerfileaccessdenied","sourcebytes":[86,105,101,119,101,114,58,32,102,105,108,101,32,97,99,99,101,115,115,32,100,101,110,105,101,100],"value":"Viewer: file access denied"},
-{"hash":206530819,"name":"o32sr.rscontrolattached","sourcebytes":[84,104,105,115,32,99,111,110,116,114,111,108,32,105,115,32,97,108,114,101,97,100,121,32,97,116,116,97,99,104,101,100,32,116,111,32,37,115],"value":"This control is already attached to %s"},
-{"hash":94969973,"name":"o32sr.rscantedit","sourcebytes":[67,111,117,108,100,32,110,111,116,32,101,110,116,101,114,32,101,100,105,116,32,109,111,100,101],"value":"Could not enter edit mode"},
-{"hash":258793572,"name":"o32sr.rschildtableerror","sourcebytes":[68,97,116,97,32,83,111,117,114,99,101,32,99,97,110,32,110,111,116,32,98,101,32,97,32,99,104,105,108,100,32,116,97,98,108,101,46,32,67,111,109,112,111,110,101,110,116,32,37,115,32,104,97,115,32,97,32,77,97,115,116,101,114,83,111,117,114,99,101,32,100,101,102,105,110,101,100],"value":"Data Source can not be a child table. Component %s has a MasterSource defined"},
-{"hash":54018357,"name":"o32sr.rsnotableattached","sourcebytes":[68,97,116,97,83,111,117,114,99,101,32,109,117,115,116,32,98,101,32,97,116,116,97,99,104,101,100,32,116,111,32,97,32,84,84,97,98,108,101,32,40,111,114,32,99,111,109,112,97,116,105,98,108,101,41,32,115,111,117,114,99,101],"value":"DataSource must be attached to a TTable (or compatible) source"},
-{"hash":115453668,"name":"o32sr.rsnocollection","sourcebytes":[78,111,32,99,111,108,108,101,99,116,105,111,110,32,101,120,105,115,116,115,32,105,110,32,116,104,101,32,111,119,110,101,114,32,99,111,109,112,111,110,101,110,116],"value":"No collection exists in the owner component"},
-{"hash":139674484,"name":"o32sr.rsnotovcdescendant","sourcebytes":[79,119,110,101,114,32,109,117,115,116,32,98,101,32,97,32,84,79,118,99,67,111,109,112,111,110,101,110,116,32,111,114,32,84,79,118,99,67,117,115,116,111,109,67,111,109,112,111,110,101,110,116,32,100,101,115,99,101,110,100,97,110,116],"value":"Owner must be a TOvcComponent or TOvcCustomComponent descendant"},
-{"hash":9129726,"name":"o32sr.rsitemincompatible","sourcebytes":[73,116,101,109,32,105,110,99,111,109,112,97,116,105,98,108,101,32,119,105,116,104,32,99,111,108,108,101,99,116,105,111,110],"value":"Item incompatible with collection"},
-{"hash":265712596,"name":"o32sr.rslabelnotattached","sourcebytes":[76,97,98,101,108,32,110,111,116,32,97,116,116,97,99,104,101,100],"value":"Label not attached"},
-{"hash":172254164,"name":"o32sr.rsclassnotset","sourcebytes":[73,116,101,109,32,99,108,97,115,115,32,110,111,116,32,115,101,116],"value":"Item class not set"},
-{"hash":240220981,"name":"o32sr.rscollectionnotfound","sourcebytes":[78,111,32,99,111,108,108,101,99,116,105,111,110,32,102,111,117,110,100,32,102,111,114,32,116,104,105,115,32,116,121,112,101],"value":"No collection found for this type"},
-{"hash":58974537,"name":"o32sr.rsdayconverterror","sourcebytes":[69,114,114,111,114,32,99,111,110,118,101,114,116,105,110,103,32,100,97,121],"value":"Error converting day"},
-{"hash":66692648,"name":"o32sr.rsmonthconverterror","sourcebytes":[69,114,114,111,114,32,99,111,110,118,101,114,116,105,110,103,32,109,111,110,116,104],"value":"Error converting month"},
-{"hash":43703893,"name":"o32sr.rsmonthnameconverterror","sourcebytes":[69,114,114,111,114,32,99,111,110,118,101,114,116,105,110,103,32,109,111,110,116,104,32,110,97,109,101],"value":"Error converting month name"},
-{"hash":138364850,"name":"o32sr.rsyearconverterror","sourcebytes":[69,114,114,111,114,32,99,111,110,118,101,114,116,105,110,103,32,121,101,97,114],"value":"Error converting year"},
-{"hash":44447241,"name":"o32sr.rsinvalidday","sourcebytes":[73,110,118,97,108,105,100,32,100,97,121],"value":"Invalid day"},
-{"hash":105965320,"name":"o32sr.rsinvalidmonth","sourcebytes":[73,110,118,97,108,105,100,32,109,111,110,116,104],"value":"Invalid month"},
-{"hash":12864069,"name":"o32sr.rsinvalidmonthname","sourcebytes":[73,110,118,97,108,105,100,32,109,111,110,116,104,32,110,97,109,101],"value":"Invalid month name"},
-{"hash":174207906,"name":"o32sr.rsinvalidyear","sourcebytes":[73,110,118,97,108,105,100,32,121,101,97,114],"value":"Invalid year"},
-{"hash":133961140,"name":"o32sr.rsdayrequired","sourcebytes":[68,97,121,32,105,115,32,114,101,113,117,105,114,101,100],"value":"Day is required"},
-{"hash":114309780,"name":"o32sr.rsmonthrequired","sourcebytes":[77,111,110,116,104,32,105,115,32,114,101,113,117,105,114,101,100],"value":"Month is required"},
-{"hash":150971572,"name":"o32sr.rsyearrequired","sourcebytes":[89,101,97,114,32,105,115,32,114,101,113,117,105,114,101,100],"value":"Year is required"},
-{"hash":99732068,"name":"o32sr.rsownermustbeform","sourcebytes":[79,119,110,101,114,32,109,117,115,116,32,98,101,32,97,32,84,70,111,114,109,32,111,114,32,100,101,115,99,101,110,100,97,110,116],"value":"Owner must be a TForm or descendant"},
-{"hash":256079797,"name":"o32sr.rstimeconverterror","sourcebytes":[69,114,114,111,114,32,99,111,110,118,101,114,116,105,110,103,32,116,105,109,101,32,118,97,108,117,101],"value":"Error converting time value"},
-{"hash":70100255,"name":"o32sr.rscancelquery","sourcebytes":[67,97,110,99,101,108,32,97,110,100,32,108,111,115,101,32,99,104,97,110,103,101,115,63],"value":"Cancel and lose changes?"},
-{"hash":124996276,"name":"o32sr.rsnopagesassigned","sourcebytes":[78,111,32,110,111,116,101,98,111,111,107,32,112,97,103,101,115,32,97,115,115,105,103,110,101,100],"value":"No notebook pages assigned"},
-{"hash":147502133,"name":"o32sr.rsrestoremi","sourcebytes":[38,82,101,115,116,111,114,101],"value":"&Restore"},
-{"hash":305108,"name":"o32sr.rscutmi","sourcebytes":[67,117,38,116],"value":"Cu&t"},
-{"hash":2795129,"name":"o32sr.rscopymi","sourcebytes":[38,67,111,112,121],"value":"&Copy"},
-{"hash":45517477,"name":"o32sr.rspastemi","sourcebytes":[38,80,97,115,116,101],"value":"&Paste"},
-{"hash":179055749,"name":"o32sr.rsdeletemi","sourcebytes":[38,68,101,108,101,116,101],"value":"&Delete"},
-{"hash":171665052,"name":"o32sr.rsselectallmi","sourcebytes":[83,101,108,101,99,116,32,38,65,108,108],"value":"Select &All"},
-{"hash":124993891,"name":"o32sr.rstablerowoutofbounds","sourcebytes":[84,97,98,108,101,32,114,111,119,32,111,117,116,32,111,102,32,98,111,117,110,100,115],"value":"Table row out of bounds"},
-{"hash":173710098,"name":"o32sr.rstablemaxrows","sourcebytes":[84,97,98,108,101,32,109,97,120,32,114,111,119,115,32,101,114,114,111,114],"value":"Table max rows error"},
-{"hash":172411506,"name":"o32sr.rstablemaxcolumns","sourcebytes":[84,97,98,108,101,32,109,97,120,32,99,111,108,117,109,110,115,32,101,114,114,111,114],"value":"Table max columns error"},
-{"hash":162625570,"name":"o32sr.rstablegeneral","sourcebytes":[84,97,98,108,101,32,103,101,110,101,114,97,108,32,101,114,114,111,114],"value":"Table general error"},
-{"hash":259026723,"name":"o32sr.rstabletomanycolumns","sourcebytes":[84,111,111,32,109,97,110,121,32,99,111,108,117,109,110,115],"value":"Too many columns"},
-{"hash":6303816,"name":"o32sr.rstableinvalidfieldindex","sourcebytes":[73,110,118,97,108,105,100,32,102,105,101,108,100,32,105,110,100,101,120],"value":"Invalid field index"},
-{"hash":10366516,"name":"o32sr.rstableheadernotassigned","sourcebytes":[72,101,97,100,101,114,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"Header not assigned"},
-{"hash":175419180,"name":"o32sr.rstableinvalidheadercell","sourcebytes":[73,110,118,97,108,105,100,32,104,101,97,100,101,114,32,99,101,108,108],"value":"Invalid header cell"},
-{"hash":296859,"name":"o32sr.rscalcback","sourcebytes":[66,97,99,107],"value":"Back"},
-{"hash":1299,"name":"o32sr.rscalcmc","sourcebytes":[77,67],"value":"MC"},
-{"hash":1314,"name":"o32sr.rscalcmr","sourcebytes":[77,82],"value":"MR"},
-{"hash":1315,"name":"o32sr.rscalcms","sourcebytes":[77,83],"value":"MS"},
-{"hash":1275,"name":"o32sr.rscalcmplus","sourcebytes":[77,43],"value":"M+"},
-{"hash":1277,"name":"o32sr.rscalcmminus","sourcebytes":[77,45],"value":"M-"},
-{"hash":1156,"name":"o32sr.rscalcct","sourcebytes":[67,84],"value":"CT"},
-{"hash":1141,"name":"o32sr.rscalcce","sourcebytes":[67,69],"value":"CE"},
-{"hash":67,"name":"o32sr.rscalcc","sourcebytes":[67],"value":"C"},
-{"hash":370836,"name":"o32sr.rscalcsqrt","sourcebytes":[83,113,114,116],"value":"Sqrt"},
-{"hash":338644,"name":"o32sr.rscalnext","sourcebytes":[78,69,88,84],"value":"NEXT"},
-{"hash":329348,"name":"o32sr.rscallast","sourcebytes":[76,65,83,84],"value":"LAST"},
-{"hash":349862,"name":"o32sr.rscalprev","sourcebytes":[80,82,69,86],"value":"PREV"},
-{"hash":4908932,"name":"o32sr.rscalfirst","sourcebytes":[70,73,82,83,84],"value":"FIRST"},
-{"hash":13956,"name":"o32sr.rscal1st","sourcebytes":[49,83,84],"value":"1ST"},
-{"hash":91849764,"name":"o32sr.rscalsecond","sourcebytes":[83,69,67,79,78,68],"value":"SECOND"},
-{"hash":14116,"name":"o32sr.rscal2nd","sourcebytes":[50,78,68],"value":"2ND"},
-{"hash":5820004,"name":"o32sr.rscalthird","sourcebytes":[84,72,73,82,68],"value":"THIRD"},
-{"hash":14436,"name":"o32sr.rscal3rd","sourcebytes":[51,82,68],"value":"3RD"},
-{"hash":78948232,"name":"o32sr.rscalfourth","sourcebytes":[70,79,85,82,84,72],"value":"FOURTH"},
-{"hash":14728,"name":"o32sr.rscal4th","sourcebytes":[52,84,72],"value":"4TH"},
-{"hash":4907612,"name":"o32sr.rscalfinal","sourcebytes":[70,73,78,65,76],"value":"FINAL"},
-{"hash":18237,"name":"o32sr.rscalbom","sourcebytes":[66,79,77],"value":"BOM"},
-{"hash":4627422,"name":"o32sr.rscalbegin","sourcebytes":[66,69,71,73,78],"value":"BEGIN"},
-{"hash":19005,"name":"o32sr.rscaleom","sourcebytes":[69,79,77],"value":"EOM"},
-{"hash":18980,"name":"o32sr.rscalend","sourcebytes":[69,78,68],"value":"END"},
-{"hash":143275465,"name":"o32sr.rscalyesterday","sourcebytes":[89,69,83,84,69,82,68,65,89],"value":"YESTERDAY"},
-{"hash":5847145,"name":"o32sr.rscaltoday","sourcebytes":[84,79,68,65,89],"value":"TODAY"},
-{"hash":69498071,"name":"o32sr.rscaltomorrow","sourcebytes":[84,79,77,79,82,82,79,87],"value":"TOMORROW"},
-{"hash":80477938,"name":"o32sr.rseditingsections","sourcebytes":[72,101,97,100,101,114,32,83,101,99,116,105,111,110,115,32,69,100,105,116,111,114],"value":"Header Sections Editor"},
-{"hash":248718130,"name":"o32sr.rseditingitems","sourcebytes":[70,111,108,100,101,114,32,73,116,101,109,115,32,69,100,105,116,111,114],"value":"Folder Items Editor"},
-{"hash":165259106,"name":"o32sr.rseditingfolders","sourcebytes":[70,111,108,100,101,114,32,69,100,105,116,111,114],"value":"Folder Editor"},
-{"hash":31027826,"name":"o32sr.rseditingpages","sourcebytes":[84,97,98,32,80,97,103,101,115,32,69,100,105,116,111,114],"value":"Tab Pages Editor"},
-{"hash":60438738,"name":"o32sr.rseditingimages","sourcebytes":[73,109,97,103,101,32,76,105,115,116,32,69,100,105,116,111,114],"value":"Image List Editor"},
-{"hash":163229710,"name":"o32sr.rssectionbasename","sourcebytes":[83,101,99,116,105,111,110],"value":"Section"},
-{"hash":330429,"name":"o32sr.rsitembasename","sourcebytes":[73,116,101,109],"value":"Item"},
-{"hash":81144514,"name":"o32sr.rsfolderbasename","sourcebytes":[70,111,108,100,101,114],"value":"Folder"},
-{"hash":354261,"name":"o32sr.rspagebasename","sourcebytes":[80,97,103,101],"value":"Page"},
-{"hash":5257173,"name":"o32sr.rsimagebasename","sourcebytes":[73,109,97,103,101],"value":"Image"},
-{"hash":5205139,"name":"o32sr.rshoursname","sourcebytes":[72,111,117,114,115],"value":"Hours"},
-{"hash":67488403,"name":"o32sr.rsminutesname","sourcebytes":[77,105,110,117,116,101,115],"value":"Minutes"},
-{"hash":163210467,"name":"o32sr.rssecondsname","sourcebytes":[83,101,99,111,110,100,115],"value":"Seconds"},
-{"hash":4863637,"name":"o32sr.rsclosecaption","sourcebytes":[67,108,111,115,101],"value":"Close"},
-{"hash":268126580,"name":"o32sr.rsviewfieldnotfound","sourcebytes":[84,104,101,32,118,105,101,119,32,102,105,101,108,100,32,37,115,32,119,97,115,32,110,111,116,32,102,111,117,110,100],"value":"The view field %s was not found"},
-{"hash":17553811,"name":"o32sr.rscantresolvefield","sourcebytes":[85,110,97,98,108,101,32,116,111,32,114,101,115,111,108,118,101,32,118,105,101,119,32,102,105,101,108,100,32,37,115],"value":"Unable to resolve view field %s"},
-{"hash":160173704,"name":"o32sr.rsitemalreadyexists","sourcebytes":[67,97,110,39,116,32,97,100,100,32,105,116,101,109,32,37,112,32,45,32,105,116,32,97,108,114,101,97,100,121,32,101,120,105,115,116,115,32,105,110,32,116,104,101,32,105,110,100,101,120],"value":"Can't add item %p - it already exists in the index"},
-{"hash":108159061,"name":"o32sr.rsalreadyintempmode","sourcebytes":[84,104,101,32,118,105,101,119,32,105,115,32,97,108,114,101,97,100,121,32,105,110,32,116,101,109,112,111,114,97,114,121,32,105,110,100,101,120,32,109,111,100,101],"value":"The view is already in temporary index mode"},
-{"hash":17830740,"name":"o32sr.rsitemnotfound","sourcebytes":[83,112,101,99,105,102,105,101,100,32,114,101,112,111,114,116,32,118,105,101,119,32,100,97,116,97,32,105,116,101,109,32,37,112,32,119,97,115,32,110,111,116,32,102,111,117,110,100],"value":"Specified report view data item %p was not found"},
-{"hash":201152055,"name":"o32sr.rsupdatepending","sourcebytes":[84,104,105,115,32,114,101,112,111,114,116,32,118,105,101,119,32,111,112,101,114,97,116,105,111,110,32,105,115,32,105,110,118,97,108,105,100,32,119,104,105,108,101,32,117,112,100,97,116,101,115,32,97,114,101,32,112,101,110,100,105,110,103],"value":"This report view operation is invalid while updates are pending"},
-{"hash":76579668,"name":"o32sr.rsoncomparenotassigned","sourcebytes":[79,110,67,111,109,112,97,114,101,70,105,101,108,100,115,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"OnCompareFields not assigned"},
-{"hash":113924180,"name":"o32sr.rsonfilternotassigned","sourcebytes":[79,110,70,105,108,116,101,114,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"OnFilter not assigned"},
-{"hash":141112020,"name":"o32sr.rsgetasfloatnotassigned","sourcebytes":[71,101,116,65,115,70,108,111,97,116,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"GetAsFloat not assigned"},
-{"hash":164581701,"name":"o32sr.rsnotintempmode","sourcebytes":[82,101,112,111,114,116,32,118,105,101,119,32,105,115,32,110,111,116,32,105,110,32,116,101,109,112,111,114,97,114,121,32,105,110,100,101,120,32,109,111,100,101],"value":"Report view is not in temporary index mode"},
-{"hash":139773240,"name":"o32sr.rsitemnotinindex","sourcebytes":[84,104,101,32,115,112,101,99,105,102,105,101,100,32,100,97,116,97,32,105,116,101,109,32,40,37,112,41,32,105,115,32,110,111,116,32,105,110,32,116,104,101,32,105,110,100,101,120],"value":"The specified data item (%p) is not in the index"},
-{"hash":219185047,"name":"o32sr.rsnoactiveview","sourcebytes":[78,111,32,97,99,116,105,118,101,32,118,105,101,119],"value":"No active view"},
-{"hash":207431808,"name":"o32sr.rsitemisnotgroup","sourcebytes":[73,116,101,109,32,97,116,32,108,105,110,101,32,37,100,32,105,115,32,110,111,116,32,97,32,103,114,111,117,112],"value":"Item at line %d is not a group"},
-{"hash":244079028,"name":"o32sr.rsnotmultiselect","sourcebytes":[84,104,105,115,32,114,101,112,111,114,116,32,118,105,101,119,32,111,112,101,114,97,116,105,111,110,32,105,115,32,111,110,108,121,32,97,108,108,111,119,101,100,32,119,104,101,110,32,109,117,108,116,105,115,101,108,101,99,116,32,105,115,32,101,110,97,98,108,101,100],"value":"This report view operation is only allowed when multiselect is enabled"},
-{"hash":210158068,"name":"o32sr.rslinenooutofrange","sourcebytes":[73,110,118,97,108,105,100,32,105,110,100,101,120,32,37,100],"value":"Invalid index %d"},
-{"hash":178454563,"name":"o32sr.rsunknownview","sourcebytes":[85,110,107,110,111,119,110,32,118,105,101,119,58,32,37,115],"value":"Unknown view: %s"},
-{"hash":170685332,"name":"o32sr.rsonkeysearchnotassigned","sourcebytes":[84,104,101,32,79,110,75,101,121,83,101,97,114,99,104,32,101,118,101,110,116,32,105,115,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"The OnKeySearch event is not assigned"},
-{"hash":41277828,"name":"o32sr.rsonenumnotassigned","sourcebytes":[84,104,101,32,79,110,69,110,117,109,32,101,118,101,110,116,32,105,115,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"The OnEnum event is not assigned"},
-{"hash":53442292,"name":"o32sr.rsonenumselectedna","sourcebytes":[79,110,69,110,117,109,83,101,108,101,99,116,101,100,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"OnEnumSelected not assigned"},
-{"hash":218640564,"name":"o32sr.rsnomenuassigned","sourcebytes":[78,111,32,109,101,110,117,32,105,116,101,109,32,97,115,115,105,103,110,101,100],"value":"No menu item assigned"},
-{"hash":251158724,"name":"o32sr.rsnoanchorassigned","sourcebytes":[78,111,32,97,110,99,104,111,114,32,105,116,101,109,32,97,115,115,105,103,110,101,100],"value":"No anchor item assigned"},
-{"hash":80460738,"name":"o32sr.rsinvalidparameter","sourcebytes":[73,110,118,97,108,105,100,32,112,97,114,97,109,101,116,101,114,58,32,109,112,65,110,99,104,111,114],"value":"Invalid parameter: mpAnchor"},
-{"hash":198347043,"name":"o32sr.rsinvalidoperation","sourcebytes":[73,110,118,97,108,105,100,32,111,112,101,114,97,116,105,111,110,58,32,67,97,108,108,32,65,100,100,83,112,108,105,116,32,102,111,114,32,115,112,108,105,116,32,109,101,110,117,115],"value":"Invalid operation: Call AddSplit for split menus"},
-{"hash":120111635,"name":"o32sr.rsformuseonly","sourcebytes":[84,104,105,115,32,99,111,109,112,111,110,101,110,116,32,99,97,110,32,111,110,108,121,32,98,101,32,117,115,101,100,32,111,110,32,102,111,114,109,115],"value":"This component can only be used on forms"},
-{"hash":4794267,"name":"o32sr.rscolorblack","sourcebytes":[66,108,97,99,107],"value":"Black"},
-{"hash":87594590,"name":"o32sr.rscolormaroon","sourcebytes":[77,97,114,111,111,110],"value":"Maroon"},
-{"hash":5147582,"name":"o32sr.rscolorgreen","sourcebytes":[71,114,101,101,110],"value":"Green"},
-{"hash":5648581,"name":"o32sr.rscolorolive","sourcebytes":[79,108,105,118,101],"value":"Olive"},
-{"hash":346329,"name":"o32sr.rscolornavy","sourcebytes":[78,97,118,121],"value":"Navy"},
-{"hash":92051237,"name":"o32sr.rscolorpurple","sourcebytes":[80,117,114,112,108,101],"value":"Purple"},
-{"hash":371580,"name":"o32sr.rscolorteal","sourcebytes":[84,101,97,108],"value":"Teal"},
-{"hash":321673,"name":"o32sr.rscolorgray","sourcebytes":[71,114,97,121],"value":"Gray"},
-{"hash":94387394,"name":"o32sr.rscolorsilver","sourcebytes":[83,105,108,118,101,114],"value":"Silver"},
-{"hash":22708,"name":"o32sr.rscolorred","sourcebytes":[82,101,100],"value":"Red"},
-{"hash":340021,"name":"o32sr.rscolorlime","sourcebytes":[76,105,109,101],"value":"Lime"},
-{"hash":100414311,"name":"o32sr.rscoloryellow","sourcebytes":[89,101,108,108,111,119],"value":"Yellow"},
-{"hash":299957,"name":"o32sr.rscolorblue","sourcebytes":[66,108,117,101],"value":"Blue"},
-{"hash":230291889,"name":"o32sr.rscolorfuchsia","sourcebytes":[70,117,99,104,115,105,97],"value":"Fuchsia"},
-{"hash":297137,"name":"o32sr.rscoloraqua","sourcebytes":[65,113,117,97],"value":"Aqua"},
-{"hash":6156453,"name":"o32sr.rscolorwhite","sourcebytes":[87,104,105,116,101],"value":"White"},
-{"hash":258066265,"name":"o32sr.rscolorlightgray","sourcebytes":[76,105,103,104,116,32,71,114,97,121],"value":"Light Gray"},
-{"hash":195515273,"name":"o32sr.rscolormediumgray","sourcebytes":[77,101,100,105,117,109,32,71,114,97,121],"value":"Medium Gray"},
-{"hash":148152841,"name":"o32sr.rscolordarkgray","sourcebytes":[68,97,114,107,32,71,114,97,121],"value":"Dark Gray"},
-{"hash":186314622,"name":"o32sr.rscolormoneygreen","sourcebytes":[77,111,110,101,121,32,71,114,101,101,110],"value":"Money Green"},
-{"hash":45389333,"name":"o32sr.rscolorskyblue","sourcebytes":[83,107,121,32,66,108,117,101],"value":"Sky Blue"},
-{"hash":4885373,"name":"o32sr.rscolorcream","sourcebytes":[67,114,101,97,109],"value":"Cream"},
-{"hash":110646853,"name":"o32sr.ccnonestr","sourcebytes":[99,99,78,111,110,101],"value":"ccNone"},
-{"hash":110593947,"name":"o32sr.ccbackstr","sourcebytes":[99,99,66,97,99,107],"value":"ccBack"},
-{"hash":154279605,"name":"o32sr.ccbotofpagestr","sourcebytes":[99,99,66,111,116,79,102,80,97,103,101],"value":"ccBotOfPage"},
-{"hash":174982732,"name":"o32sr.ccbotrightcellstr","sourcebytes":[99,99,66,111,116,82,105,103,104,116,67,101,108,108],"value":"ccBotRightCell"},
-{"hash":185592085,"name":"o32sr.cccompletedatestr","sourcebytes":[99,99,67,111,109,112,108,101,116,101,68,97,116,101],"value":"ccCompleteDate"},
-{"hash":185397125,"name":"o32sr.cccompletetimestr","sourcebytes":[99,99,67,111,109,112,108,101,116,101,84,105,109,101],"value":"ccCompleteTime"},
-{"hash":110601849,"name":"o32sr.cccopystr","sourcebytes":[99,99,67,111,112,121],"value":"ccCopy"},
-{"hash":194382114,"name":"o32sr.ccctrlcharstr","sourcebytes":[99,99,67,116,114,108,67,104,97,114],"value":"ccCtrlChar"},
-{"hash":6912708,"name":"o32sr.cccutstr","sourcebytes":[99,99,67,117,116],"value":"ccCut"},
-{"hash":6912691,"name":"o32sr.ccdecstr","sourcebytes":[99,99,68,101,99],"value":"ccDec"},
-{"hash":6912700,"name":"o32sr.ccdelstr","sourcebytes":[99,99,68,101,108],"value":"ccDel"},
-{"hash":128716748,"name":"o32sr.ccdelbolstr","sourcebytes":[99,99,68,101,108,66,111,108],"value":"ccDelBol"},
-{"hash":128716492,"name":"o32sr.ccdeleolstr","sourcebytes":[99,99,68,101,108,69,111,108],"value":"ccDelEol"},
-{"hash":180438837,"name":"o32sr.ccdellinestr","sourcebytes":[99,99,68,101,108,76,105,110,101],"value":"ccDelLine"},
-{"hash":180473844,"name":"o32sr.ccdelwordstr","sourcebytes":[99,99,68,101,108,87,111,114,100],"value":"ccDelWord"},
-{"hash":110606046,"name":"o32sr.ccdownstr","sourcebytes":[99,99,68,111,119,110],"value":"ccDown"},
-{"hash":6913092,"name":"o32sr.ccendstr","sourcebytes":[99,99,69,110,100],"value":"ccEnd"},
-{"hash":249526654,"name":"o32sr.ccextenddownstr","sourcebytes":[99,99,69,120,116,101,110,100,68,111,119,110],"value":"ccExtendDown"},
-{"hash":183367860,"name":"o32sr.ccextendendstr","sourcebytes":[99,99,69,120,116,101,110,100,69,110,100],"value":"ccExtendEnd"},
-{"hash":249510805,"name":"o32sr.ccextendhomestr","sourcebytes":[99,99,69,120,116,101,110,100,72,111,109,101],"value":"ccExtendHome"},
-{"hash":249619572,"name":"o32sr.ccextendleftstr","sourcebytes":[99,99,69,120,116,101,110,100,76,101,102,116],"value":"ccExtendLeft"},
-{"hash":249472014,"name":"o32sr.ccextendpgdnstr","sourcebytes":[99,99,69,120,116,101,110,100,80,103,68,110],"value":"ccExtendPgDn"},
-{"hash":249471840,"name":"o32sr.ccextendpgupstr","sourcebytes":[99,99,69,120,116,101,110,100,80,103,85,112],"value":"ccExtendPgUp"},
-{"hash":233047828,"name":"o32sr.ccextendrightstr","sourcebytes":[99,99,69,120,116,101,110,100,82,105,103,104,116],"value":"ccExtendRight"},
-{"hash":263118336,"name":"o32sr.ccextendupstr","sourcebytes":[99,99,69,120,116,101,110,100,85,112],"value":"ccExtendUp"},
-{"hash":9762773,"name":"o32sr.ccextbotofpagestr","sourcebytes":[99,99,69,120,116,66,111,116,79,102,80,97,103,101],"value":"ccExtBotOfPage"},
-{"hash":241626181,"name":"o32sr.ccextfirstpagestr","sourcebytes":[99,99,69,120,116,70,105,114,115,116,80,97,103,101],"value":"ccExtFirstPage"},
-{"hash":30776981,"name":"o32sr.ccextlastpagestr","sourcebytes":[99,99,69,120,116,76,97,115,116,80,97,103,101],"value":"ccExtLastPage"},
-{"hash":76872229,"name":"o32sr.ccexttopofpagestr","sourcebytes":[99,99,69,120,116,84,111,112,79,102,80,97,103,101],"value":"ccExtTopOfPage"},
-{"hash":267768340,"name":"o32sr.ccextwordleftstr","sourcebytes":[99,99,69,120,116,87,111,114,100,76,101,102,116],"value":"ccExtWordLeft"},
-{"hash":257384708,"name":"o32sr.ccextwordrightstr","sourcebytes":[99,99,69,120,116,87,111,114,100,82,105,103,104,116],"value":"ccExtWordRight"},
-{"hash":163584725,"name":"o32sr.ccfirstpagestr","sourcebytes":[99,99,70,105,114,115,116,80,97,103,101],"value":"ccFirstPage"},
-{"hash":183990064,"name":"o32sr.ccgotomarker0str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,48],"value":"ccGotoMarker0"},
-{"hash":183990065,"name":"o32sr.ccgotomarker1str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,49],"value":"ccGotoMarker1"},
-{"hash":183990066,"name":"o32sr.ccgotomarker2str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,50],"value":"ccGotoMarker2"},
-{"hash":183990067,"name":"o32sr.ccgotomarker3str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,51],"value":"ccGotoMarker3"},
-{"hash":183990068,"name":"o32sr.ccgotomarker4str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,52],"value":"ccGotoMarker4"},
-{"hash":183990069,"name":"o32sr.ccgotomarker5str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,53],"value":"ccGotoMarker5"},
-{"hash":183990070,"name":"o32sr.ccgotomarker6str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,54],"value":"ccGotoMarker6"},
-{"hash":183990071,"name":"o32sr.ccgotomarker7str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,55],"value":"ccGotoMarker7"},
-{"hash":183990072,"name":"o32sr.ccgotomarker8str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,56],"value":"ccGotoMarker8"},
-{"hash":183990073,"name":"o32sr.ccgotomarker9str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,57],"value":"ccGotoMarker9"},
-{"hash":110622261,"name":"o32sr.cchomestr","sourcebytes":[99,99,72,111,109,101],"value":"ccHome"},
-{"hash":6914115,"name":"o32sr.ccincstr","sourcebytes":[99,99,73,110,99],"value":"ccInc"},
-{"hash":6914131,"name":"o32sr.ccinsstr","sourcebytes":[99,99,73,110,115],"value":"ccIns"},
-{"hash":145752053,"name":"o32sr.cclastpagestr","sourcebytes":[99,99,76,97,115,116,80,97,103,101],"value":"ccLastPage"},
-{"hash":110635988,"name":"o32sr.ccleftstr","sourcebytes":[99,99,76,101,102,116],"value":"ccLeft"},
-{"hash":80496581,"name":"o32sr.ccnewlinestr","sourcebytes":[99,99,78,101,119,76,105,110,101],"value":"ccNewLine"},
-{"hash":218103701,"name":"o32sr.ccnextpagestr","sourcebytes":[99,99,78,101,120,116,80,97,103,101],"value":"ccNextPage"},
-{"hash":132166580,"name":"o32sr.ccpageleftstr","sourcebytes":[99,99,80,97,103,101,76,101,102,116],"value":"ccPageLeft"},
-{"hash":230783876,"name":"o32sr.ccpagerightstr","sourcebytes":[99,99,80,97,103,101,82,105,103,104,116],"value":"ccPageRight"},
-{"hash":159812293,"name":"o32sr.ccpastestr","sourcebytes":[99,99,80,97,115,116,101],"value":"ccPaste"},
-{"hash":147718053,"name":"o32sr.ccprevpagestr","sourcebytes":[99,99,80,114,101,118,80,97,103,101],"value":"ccPrevPage"},
-{"hash":110660527,"name":"o32sr.ccredostr","sourcebytes":[99,99,82,101,100,111],"value":"ccRedo"},
-{"hash":147513093,"name":"o32sr.ccrestorestr","sourcebytes":[99,99,82,101,115,116,111,114,101],"value":"ccRestore"},
-{"hash":159972756,"name":"o32sr.ccrightstr","sourcebytes":[99,99,82,105,103,104,116],"value":"ccRight"},
-{"hash":80235598,"name":"o32sr.ccscrolldownstr","sourcebytes":[99,99,83,99,114,111,108,108,68,111,119,110],"value":"ccScrollDown"},
-{"hash":177523024,"name":"o32sr.ccscrollupstr","sourcebytes":[99,99,83,99,114,111,108,108,85,112],"value":"ccScrollUp"},
-{"hash":85033152,"name":"o32sr.ccsetmarker0str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,48],"value":"ccSetMarker0"},
-{"hash":85033153,"name":"o32sr.ccsetmarker1str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,49],"value":"ccSetMarker1"},
-{"hash":85033154,"name":"o32sr.ccsetmarker2str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,50],"value":"ccSetMarker2"},
-{"hash":85033155,"name":"o32sr.ccsetmarker3str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,51],"value":"ccSetMarker3"},
-{"hash":85033156,"name":"o32sr.ccsetmarker4str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,52],"value":"ccSetMarker4"},
-{"hash":85033157,"name":"o32sr.ccsetmarker5str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,53],"value":"ccSetMarker5"},
-{"hash":85033158,"name":"o32sr.ccsetmarker6str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,54],"value":"ccSetMarker6"},
-{"hash":85033159,"name":"o32sr.ccsetmarker7str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,55],"value":"ccSetMarker7"},
-{"hash":85033160,"name":"o32sr.ccsetmarker8str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,56],"value":"ccSetMarker8"},
-{"hash":85033161,"name":"o32sr.ccsetmarker9str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,57],"value":"ccSetMarker9"},
-{"hash":6916722,"name":"o32sr.cctabstr","sourcebytes":[99,99,84,97,98],"value":"ccTab"},
-{"hash":155201908,"name":"o32sr.cctableeditstr","sourcebytes":[99,99,84,97,98,108,101,69,100,105,116],"value":"ccTableEdit"},
-{"hash":39059308,"name":"o32sr.cctopleftcellstr","sourcebytes":[99,99,84,111,112,76,101,102,116,67,101,108,108],"value":"ccTopLeftCell"},
-{"hash":87223477,"name":"o32sr.cctopofpagestr","sourcebytes":[99,99,84,111,112,79,102,80,97,103,101],"value":"ccTopOfPage"},
-{"hash":110675119,"name":"o32sr.ccundostr","sourcebytes":[99,99,85,110,100,111],"value":"ccUndo"},
-{"hash":432320,"name":"o32sr.ccupstr","sourcebytes":[99,99,85,112],"value":"ccUp"},
-{"hash":110080820,"name":"o32sr.ccwordleftstr","sourcebytes":[99,99,87,111,114,100,76,101,102,116],"value":"ccWordLeft"},
-{"hash":150041492,"name":"o32sr.ccwordrightstr","sourcebytes":[99,99,87,111,114,100,82,105,103,104,116],"value":"ccWordRight"},
-{"hash":95129671,"name":"o32sr.stringstr","sourcebytes":[83,116,114,105,110,103],"value":"String"},
-{"hash":302722,"name":"o32sr.charstr","sourcebytes":[67,104,97,114],"value":"Char"},
-{"hash":157690686,"name":"o32sr.booleanstr","sourcebytes":[66,111,111,108,101,97,110],"value":"Boolean"},
-{"hash":6277199,"name":"o32sr.yesnostr","sourcebytes":[89,101,115,78,111],"value":"YesNo"},
-{"hash":56934404,"name":"o32sr.longintstr","sourcebytes":[76,111,110,103,73,110,116],"value":"LongInt"},
-{"hash":386692,"name":"o32sr.wordstr","sourcebytes":[87,111,114,100],"value":"Word"},
-{"hash":58919924,"name":"o32sr.smallintstr","sourcebytes":[83,109,97,108,108,73,110,116],"value":"SmallInt"},
-{"hash":303269,"name":"o32sr.bytestr","sourcebytes":[66,121,116,101],"value":"Byte"},
-{"hash":258575300,"name":"o32sr.shortintstr","sourcebytes":[83,104,111,114,116,73,110,116],"value":"ShortInt"},
-{"hash":363388,"name":"o32sr.realstr","sourcebytes":[82,101,97,108],"value":"Real"},
-{"hash":262950516,"name":"o32sr.extendedstr","sourcebytes":[69,120,116,101,110,100,101,100],"value":"Extended"},
-{"hash":79083813,"name":"o32sr.doublestr","sourcebytes":[68,111,117,98,108,101],"value":"Double"},
-{"hash":94391845,"name":"o32sr.singlestr","sourcebytes":[83,105,110,103,108,101],"value":"Single"},
-{"hash":304704,"name":"o32sr.compstr","sourcebytes":[67,111,109,112],"value":"Comp"},
-{"hash":305317,"name":"o32sr.datestr","sourcebytes":[68,97,116,101],"value":"Date"},
-{"hash":372789,"name":"o32sr.timestr","sourcebytes":[84,105,109,101],"value":"Time"},
-{"hash":14246210,"name":"o32sr.charmask1str","sourcebytes":[88,32,32,97,110,121,32,99,104,97,114,97,99,116,101,114],"value":"X any character"},
-{"hash":176123385,"name":"o32sr.charmask2str","sourcebytes":[33,32,32,97,110,121,32,99,104,97,114,32,40,117,112,112,101,114,41],"value":"! any char (upper)"},
-{"hash":128900505,"name":"o32sr.charmask3str","sourcebytes":[76,32,32,97,110,121,32,99,104,97,114,32,40,108,111,119,101,114,41],"value":"L any char (lower)"},
-{"hash":60353161,"name":"o32sr.charmask4str","sourcebytes":[120,32,32,97,110,121,32,99,104,97,114,32,40,109,105,120,101,100,41],"value":"x any char (mixed)"},
-{"hash":171931113,"name":"o32sr.charmask5str","sourcebytes":[97,32,32,97,108,112,104,97,115,32,111,110,108,121],"value":"a alphas only"},
-{"hash":216715241,"name":"o32sr.charmask6str","sourcebytes":[65,32,32,97,108,112,104,97,115,32,40,117,112,112,101,114,41],"value":"A alphas (upper)"},
-{"hash":238452713,"name":"o32sr.charmask7str","sourcebytes":[108,32,32,97,108,112,104,97,115,32,40,108,111,119,101,114,41],"value":"l alphas (lower)"},
-{"hash":62010121,"name":"o32sr.charmask8str","sourcebytes":[57,32,32,48,45,57],"value":"9 0-9"},
-{"hash":53531917,"name":"o32sr.charmask9str","sourcebytes":[105,32,32,48,45,57,44,32,45],"value":"i 0-9, -"},
-{"hash":162581806,"name":"o32sr.charmask10str","sourcebytes":[35,32,32,48,45,57,44,32,45,44,32,46],"value":"# 0-9, -, ."},
-{"hash":80873294,"name":"o32sr.charmask11str","sourcebytes":[69,32,32,48,45,57,44,32,69,44,32,45,44,32,46],"value":"E 0-9, E, -, ."},
-{"hash":148737417,"name":"o32sr.charmask12str","sourcebytes":[75,32,32,48,45,57,44,32,65,45,70,32,40,104,101,120,41],"value":"K 0-9, A-F (hex)"},
-{"hash":225029081,"name":"o32sr.charmask14str","sourcebytes":[79,32,32,48,45,55,32,40,111,99,116,97,108,41],"value":"O 0-7 (octal)"},
-{"hash":169998697,"name":"o32sr.charmask15str","sourcebytes":[98,32,32,48,44,32,49,32,40,98,105,110,97,114,121,41],"value":"b 0, 1 (binary)"},
-{"hash":149356809,"name":"o32sr.charmask16str","sourcebytes":[66,32,32,84,32,111,114,32,70,32,40,117,112,112,101,114,41],"value":"B T or F (upper)"},
-{"hash":150477273,"name":"o32sr.charmask17str","sourcebytes":[89,32,32,89,32,111,114,32,78,32,40,117,112,112,101,114,41],"value":"Y Y or N (upper)"},
-{"hash":97122065,"name":"o32sr.charmask18str","sourcebytes":[49,32,32,85,115,101,114,32,49],"value":"1 User 1"},
-{"hash":97120274,"name":"o32sr.charmask19str","sourcebytes":[50,32,32,85,115,101,114,32,50],"value":"2 User 2"},
-{"hash":97120531,"name":"o32sr.charmask20str","sourcebytes":[51,32,32,85,115,101,114,32,51],"value":"3 User 3"},
-{"hash":97120788,"name":"o32sr.charmask21str","sourcebytes":[52,32,32,85,115,101,114,32,52],"value":"4 User 4"},
-{"hash":97121045,"name":"o32sr.charmask22str","sourcebytes":[53,32,32,85,115,101,114,32,53],"value":"5 User 5"},
-{"hash":97123350,"name":"o32sr.charmask23str","sourcebytes":[54,32,32,85,115,101,114,32,54],"value":"6 User 6"},
-{"hash":97123607,"name":"o32sr.charmask24str","sourcebytes":[55,32,32,85,115,101,114,32,55],"value":"7 User 7"},
-{"hash":97123864,"name":"o32sr.charmask25str","sourcebytes":[56,32,32,85,115,101,114,32,56],"value":"8 User 8"},
-{"hash":25870412,"name":"o32sr.fieldmask1str","sourcebytes":[36,35,35,44,35,35,35,46,35,35,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,97,110,100,32,112,101,114,105,111,100,32,85,115,101,115,32,102,108,111,97,116,105,110,103,32,99,117,114,114,101,110,99,121,32,115,121,109,98,111,108],"value":"$##,###.## Allows entry of 0 through 9, space, minus, and period Uses floating currency symbol"},
-{"hash":192143781,"name":"o32sr.fieldmask2str","sourcebytes":[57,57,57,57,57,57,57,57,57,57,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,97,110,100,32,115,112,97,99,101],"value":"9999999999 Allows entry of 0 through 9, and space"},
-{"hash":150217363,"name":"o32sr.fieldmask3str","sourcebytes":[105,105,105,105,105,105,105,105,105,105,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,97,110,100,32,109,105,110,117,115],"value":"iiiiiiiiii Allows entry of 0 through 9, space, and minus"},
-{"hash":159131796,"name":"o32sr.fieldmask4str","sourcebytes":[105,105,44,105,105,105,44,105,105,105,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,97,110,100,32,109,105,110,117,115,32,68,105,115,112,108,97,121,115,32,110,117,109,98,101,114,32,115,101,112,97,114,97,116,111,114,115,32,97,115,32,110,101,101,100,101,100],"value":"ii,iii,iii Allows entry of 0 through 9, space, and minus Displays number separators as needed"},
-{"hash":187563852,"name":"o32sr.fieldmask5str","sourcebytes":[36,105,105,105,105,105,105,105,105,105,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,97,110,100,32,109,105,110,117,115,32,85,115,101,115,32,102,108,111,97,116,105,110,103,32,99,117,114,114,101,110,99,121,32,115,121,109,98,111,108],"value":"$iiiiiiiii Allows entry of 0 through 9, space, and minus Uses floating currency symbol"},
-{"hash":91771796,"name":"o32sr.fieldmask6str","sourcebytes":[35,35,35,35,35,35,35,35,35,35,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,97,110,100,32,112,101,114,105,111,100],"value":"########## Allows entry of 0 through 9, space, minus, and period"},
-{"hash":150058862,"name":"o32sr.fieldmask7str","sourcebytes":[35,35,35,35,35,35,35,46,35,35,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,97,110,100,32,112,101,114,105,111,100,32,70,105,120,101,100,32,100,101,99,105,109,97,108,32,112,111,115,105,116,105,111,110],"value":"#######.## Allows entry of 0 through 9, space, minus, and period Fixed decimal position"},
-{"hash":118082020,"name":"o32sr.fieldmask8str","sourcebytes":[35,35,35,44,35,35,35,46,35,35,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,97,110,100,32,112,101,114,105,111,100,32,68,105,115,112,108,97,121,115,32,110,117,109,98,101,114,32,115,101,112,97,114,97,116,111,114,115,32,97,115,32,110,101,101,100,101,100],"value":"###,###.## Allows entry of 0 through 9, space, minus, and period Displays number separators as needed"},
-{"hash":203254956,"name":"o32sr.fieldmask9str","sourcebytes":[36,35,35,35,35,35,35,46,35,35,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,97,110,100,32,112,101,114,105,111,100,32,70,105,120,101,100,32,100,101,99,105,109,97,108,32,112,111,115,105,116,105,111,110,32,85,115,101,115,32,102,108,111,97,116,105,110,103,32,99,117,114,114,101,110,99,121,32,115,121,109,98,111,108],"value":"$######.## Allows entry of 0 through 9, space, minus, and period Fixed decimal position Uses floating currency symbol"},
-{"hash":233619849,"name":"o32sr.fieldmask10str","sourcebytes":[35,35,35,35,35,35,35,35,35,35,112,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,97,110,100,32,112,101,114,105,111,100,32,78,101,103,97,116,105,118,101,32,97,109,111,117,110,116,115,32,117,115,101,32,40,41],"value":"##########p Allows entry of 0 through 9, space, minus, and period Negative amounts use ()"},
-{"hash":23482388,"name":"o32sr.fieldmask11str","sourcebytes":[35,35,35,44,35,35,35,46,35,35,67,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,97,110,100,32,112,101,114,105,111,100,32,67,117,114,114,101,110,99,121,32,115,121,109,98,111,108,32,97,116,32,114,105,103,104,116],"value":"###,###.##C Allows entry of 0 through 9, space, minus, and period Currency symbol at right"},
-{"hash":174256005,"name":"o32sr.fieldmask12str","sourcebytes":[75,75,75,75,75,75,75,75,32,32,32,32,32,32,32,32,32,32,32,32,72,101,120,97,100,101,99,105,109,97,108,32,40,69,52,52,48,49,70,51,69,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,97,110,100,32,65,32,116,104,114,111,117,103,104,32,70,32,70,111,114,99,101,32,117,112,112,101,114,32,99,97,115,101],"value":"KKKKKKKK Hexadecimal (E4401F3E) Allows entry of 0 through 9 and A through F Force upper case"},
-{"hash":160543589,"name":"o32sr.fieldmask13str","sourcebytes":[75,75,75,75,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,72,101,120,97,100,101,99,105,109,97,108,32,40,49,70,51,69,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,97,110,100,32,65,32,116,104,114,111,117,103,104,32,70,32,70,111,114,99,101,32,117,112,112,101,114,32,99,97,115,101],"value":"KKKK Hexadecimal (1F3E) Allows entry of 0 through 9 and A through F Force upper case"},
-{"hash":54097189,"name":"o32sr.fieldmask14str","sourcebytes":[75,75,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,72,101,120,97,100,101,99,105,109,97,108,32,40,51,69,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,97,110,100,32,65,32,116,104,114,111,117,103,104,32,70,32,70,111,114,99,101,32,117,112,112,101,114,32,99,97,115,101],"value":"KK Hexadecimal (3E) Allows entry of 0 through 9 and A through F Force upper case"},
-{"hash":118534928,"name":"o32sr.fieldmask15str","sourcebytes":[79,79,79,79,79,79,79,79,32,32,32,32,32,32,32,32,32,32,32,32,79,99,116,97,108,32,40,52,53,49,51,53,54,55,55,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,55,32],"value":"OOOOOOOO Octal (45135677) Allows entry of 0 through 7 "},
-{"hash":157956416,"name":"o32sr.fieldmask16str","sourcebytes":[79,79,79,79,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,79,99,116,97,108,32,40,53,54,55,55,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,55,32],"value":"OOOO Octal (5677) Allows entry of 0 through 7 "},
-{"hash":214007281,"name":"o32sr.fieldmask17str","sourcebytes":[98,98,98,98,98,98,98,98,98,98,98,98,98,98,98,98,32,32,32,32,66,105,110,97,114,121,32,40,48,49,48,49,48,48,49,48,49,48,48,49,48,49,48,48,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,97,110,100,32,49],"value":"bbbbbbbbbbbbbbbb Binary (0101001010010100) Allows entry of 0 and 1"},
-{"hash":77656481,"name":"o32sr.fieldmask18str","sourcebytes":[98,98,98,98,98,98,98,98,32,32,32,32,32,32,32,32,32,32,32,32,66,105,110,97,114,121,32,40,49,48,48,49,48,49,48,48,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,97,110,100,32,49],"value":"bbbbbbbb Binary (10010100) Allows entry of 0 and 1"},
-{"hash":6873412,"name":"o32sr.fieldmask19str","sourcebytes":[88,88,88,88,88,88,88,88,88,88,32,32,32,32,32,32,32,32,32,32,65,110,121,32,99,104,97,114,97,99,116,101,114,32,99,97,110,32,98,101,32,101,110,116,101,114,101,100],"value":"XXXXXXXXXX Any character can be entered"},
-{"hash":43546997,"name":"o32sr.fieldmask20str","sourcebytes":[33,33,33,33,33,33,33,33,33,33,32,32,32,32,32,32,32,32,32,32,65,110,121,32,99,104,97,114,97,99,116,101,114,32,99,97,110,32,98,101,32,101,110,116,101,114,101,100,32,65,108,112,104,97,98,101,116,105,99,32,99,104,97,114,97,99,116,101,114,115,32,97,114,101,32,102,111,114,99,101,100,32,116,111,32,117,112,112,101,114,32,99,97,115,101],"value":"!!!!!!!!!! Any character can be entered Alphabetic characters are forced to upper case"},
-{"hash":216754981,"name":"o32sr.fieldmask21str","sourcebytes":[76,76,76,76,76,76,76,76,76,76,32,32,32,32,32,32,32,32,32,32,65,110,121,32,99,104,97,114,97,99,116,101,114,32,99,97,110,32,98,101,32,101,110,116,101,114,101,100,32,65,108,112,104,97,98,101,116,105,99,32,99,104,97,114,97,99,116,101,114,115,32,97,114,101,32,102,111,114,99,101,100,32,116,111,32,108,111,119,101,114,32,99,97,115,101],"value":"LLLLLLLLLL Any character can be entered Alphabetic characters are forced to lower case"},
-{"hash":72846341,"name":"o32sr.fieldmask22str","sourcebytes":[120,120,120,120,120,120,120,120,120,120,32,32,32,32,32,32,32,32,32,32,65,110,121,32,99,104,97,114,97,99,116,101,114,32,99,97,110,32,98,101,32,101,110,116,101,114,101,100,32,85,115,101,115,32,109,105,120,101,100,32,99,97,115,101],"value":"xxxxxxxxxx Any character can be entered Uses mixed case"},
-{"hash":180843617,"name":"o32sr.fieldmask23str","sourcebytes":[97,97,97,97,97,97,97,97,97,97,32,32,32,32,32,32,32,32,32,32,65,108,112,104,97,98,101,116,105,99,32,99,104,97,114,97,99,116,101,114,115,32,112,108,117,115,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,112,101,114,105,111,100,44,32,97,110,100,32,99,111,109,109,97],"value":"aaaaaaaaaa Alphabetic characters plus space, minus, period, and comma"},
-{"hash":259223541,"name":"o32sr.fieldmask24str","sourcebytes":[65,65,65,65,65,65,65,65,65,65,32,32,32,32,32,32,32,32,32,32,65,108,112,104,97,98,101,116,105,99,32,99,104,97,114,97,99,116,101,114,115,32,112,108,117,115,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,112,101,114,105,111,100,44,32,97,110,100,32,99,111,109,109,97,32,65,108,112,104,97,98,101,116,105,99,32,99,104,97,114,97,99,116,101,114,115,32,97,114,101,32,102,111,114,99,101,100,32,116,111,32,117,112,112,101,114,32,99,97,115,101],"value":"AAAAAAAAAA Alphabetic characters plus space, minus, period, and comma Alphabetic characters are forced to upper case"},
-{"hash":155046869,"name":"o32sr.fieldmask25str","sourcebytes":[108,108,108,108,108,108,108,108,108,108,32,32,32,32,32,32,32,32,32,32,65,108,112,104,97,98,101,116,105,99,32,99,104,97,114,97,99,116,101,114,115,32,112,108,117,115,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,112,101,114,105,111,100,44,32,97,110,100,32,99,111,109,109,97,32,65,108,112,104,97,98,101,116,105,99,32,99,104,97,114,97,99,116,101,114,115,32,97,114,101,32,102,111,114,99,101,100,32,116,111,32,108,111,119,101,114,32,99,97,115,101],"value":"llllllllll Alphabetic characters plus space, minus, period, and comma Alphabetic characters are forced to lower case"},
-{"hash":178904805,"name":"o32sr.fieldmask26str","sourcebytes":[40,57,57,57,41,32,57,57,57,45,57,57,57,57,32,32,32,32,32,32,80,104,111,110,101,32,110,117,109,98,101,114,32,109,97,115,107,32,65,108,108,111,119,115,32,48,32,116,104,114,111,117,103,104,32,57,32,97,110,100,32,115,112,97,99,101],"value":"(999) 999-9999 Phone number mask Allows 0 through 9 and space"},
-{"hash":62017877,"name":"o32sr.fieldmask27str","sourcebytes":[57,57,57,45,57,57,57,45,57,57,57,57,32,32,32,32,32,32,32,32,80,104,111,110,101,32,110,117,109,98,101,114,32,109,97,115,107,32,65,108,108,111,119,115,32,48,32,116,104,114,111,117,103,104,32,57,32,97,110,100,32,115,112,97,99,101],"value":"999-999-9999 Phone number mask Allows 0 through 9 and space"},
-{"hash":107877989,"name":"o32sr.fieldmask28str","sourcebytes":[57,57,57,57,57,45,57,57,57,57,32,32,32,32,32,32,32,32,32,32,85,83,32,90,105,112,32,67,111,100,101,32,109,97,115,107,32,65,108,108,111,119,115,32,48,32,116,104,114,111,117,103,104,32,57,32,97,110,100,32,115,112,97,99,101],"value":"99999-9999 US Zip Code mask Allows 0 through 9 and space"},
-{"hash":159165621,"name":"o32sr.fieldmask29str","sourcebytes":[66,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,66,111,111,108,101,97,110,32,109,97,115,107,32,65,108,108,111,119,115,32,84,44,32,116,44,32,70,44,32,102,32,70,111,114,99,101,115,32,105,110,112,117,116,32,116,111,32,117,112,112,101,114,32,99,97,115,101],"value":"B Boolean mask Allows T, t, F, f Forces input to upper case"},
-{"hash":226688133,"name":"o32sr.fieldmask30str","sourcebytes":[89,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,66,111,111,108,101,97,110,32,109,97,115,107,32,65,108,108,111,119,115,32,89,44,32,121,44,32,78,44,32,110,32,70,111,114,99,101,115,32,105,110,112,117,116,32,116,111,32,117,112,112,101,114,32,99,97,115,101],"value":"Y Boolean mask Allows Y, y, N, n Forces input to upper case"},
-{"hash":239529939,"name":"o32sr.fieldmask31str","sourcebytes":[109,109,47,100,100,47,121,121,32,32,32,32,32,32,32,32,32,32,32,32,68,97,116,101,32,109,97,115,107,32,40,48,49,47,48,53,47,57,54,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,77,111,110,116,104,32,97,110,100,32,68,97,121,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,122,101,114,111,115],"value":"mm\/dd\/yy Date mask (01\/05\/96) Allows entry of 0 through 9 plus space Month and Day are padded with zeros"},
-{"hash":265314611,"name":"o32sr.fieldmask32str","sourcebytes":[109,109,47,100,100,47,121,121,121,121,32,32,32,32,32,32,32,32,32,32,68,97,116,101,32,109,97,115,107,32,40,48,49,47,48,53,47,49,57,57,54,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,77,111,110,116,104,32,97,110,100,32,68,97,121,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,122,101,114,111,115],"value":"mm\/dd\/yyyy Date mask (01\/05\/1996) Allows entry of 0 through 9 plus space Month and Day are padded with zeros"},
-{"hash":140332467,"name":"o32sr.fieldmask33str","sourcebytes":[100,100,32,110,110,110,32,121,121,121,121,32,32,32,32,32,32,32,32,32,68,97,116,101,32,109,97,115,107,32,40,48,53,32,74,97,110,32,49,57,57,54,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,68,97,121,32,105,115,32,112,97,100,100,101,100,32,119,105,116,104,32,122,101,114,111,115],"value":"dd nnn yyyy Date mask (05 Jan 1996) Allows entry of 0 through 9 plus space Day is padded with zeros"},
-{"hash":60758483,"name":"o32sr.fieldmask34str","sourcebytes":[77,77,47,68,68,47,121,121,32,32,32,32,32,32,32,32,32,32,32,32,68,97,116,101,32,109,97,115,107,32,40,32,49,47,32,53,47,57,54,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,77,111,110,116,104,32,97,110,100,32,68,97,121,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,115,112,97,99,101,115],"value":"MM\/DD\/yy Date mask ( 1\/ 5\/96) Allows entry of 0 through 9 plus space Month and Day are padded with spaces"},
-{"hash":129420707,"name":"o32sr.fieldmask35str","sourcebytes":[77,77,47,68,68,47,121,121,121,121,32,32,32,32,32,32,32,32,32,32,68,97,116,101,32,109,97,115,107,32,40,32,49,47,32,53,47,49,57,57,54,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,77,111,110,116,104,32,97,110,100,32,68,97,121,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,115,112,97,99,101,115],"value":"MM\/DD\/yyyy Date mask ( 1\/ 5\/1996) Allows entry of 0 through 9 plus space Month and Day are padded with spaces"},
-{"hash":162411587,"name":"o32sr.fieldmask36str","sourcebytes":[68,68,32,110,110,110,32,121,121,121,121,32,32,32,32,32,32,32,32,32,68,97,116,101,32,109,97,115,107,32,40,32,53,32,74,97,110,32,49,57,57,54,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,68,97,121,32,105,115,32,112,97,100,100,101,100,32,119,105,116,104,32,115,112,97,99,101,115],"value":"DD nnn yyyy Date mask ( 5 Jan 1996) Allows entry of 0 through 9 plus space Day is padded with spaces"},
-{"hash":115637257,"name":"o32sr.fieldmask37str","sourcebytes":[104,104,58,109,109,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,84,105,109,101,32,109,97,115,107,32,40,48,51,58,50,53,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,72,111,117,114,115,32,97,110,100,32,109,105,110,117,116,101,115,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,122,101,114,111,115,32,40,50,52,32,104,111,117,114,32,99,108,111,99,107,41],"value":"hh:mm Time mask (03:25) Allows entry of 0 through 9 plus space Hours and minutes are padded with zeros (24 hour clock)"},
-{"hash":110050003,"name":"o32sr.fieldmask38str","sourcebytes":[104,104,58,109,109,32,116,116,32,32,32,32,32,32,32,32,32,32,32,32,84,105,109,101,32,109,97,115,107,32,40,48,51,58,50,53,32,112,109,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,72,111,117,114,115,32,97,110,100,32,109,105,110,117,116,101,115,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,122,101,114,111,115],"value":"hh:mm tt Time mask (03:25 pm) Allows entry of 0 through 9 plus space Hours and minutes are padded with zeros"},
-{"hash":119359011,"name":"o32sr.fieldmask39str","sourcebytes":[104,104,58,109,109,58,115,115,32,32,32,32,32,32,32,32,32,32,32,32,84,105,109,101,32,109,97,115,107,32,40,48,51,58,50,53,58,48,55,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,72,111,117,114,115,44,32,109,105,110,117,116,101,115,44,32,97,110,100,32,115,101,99,111,110,100,115,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,122,101,114,111,115],"value":"hh:mm:ss Time mask (03:25:07) Allows entry of 0 through 9 plus space Hours, minutes, and seconds are padded with zeros"},
-{"hash":151520073,"name":"o32sr.fieldmask40str","sourcebytes":[72,72,58,77,77,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,84,105,109,101,32,109,97,115,107,32,40,32,51,58,50,53,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,72,111,117,114,115,32,97,110,100,32,109,105,110,117,116,101,115,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,115,112,97,99,101,115,32,40,50,52,32,104,111,117,114,32,99,108,111,99,107,41],"value":"HH:MM Time mask ( 3:25) Allows entry of 0 through 9 plus space Hours and minutes are padded with spaces (24 hour clock)"},
-{"hash":156598435,"name":"o32sr.fieldmask41str","sourcebytes":[72,72,58,77,77,32,116,116,32,32,32,32,32,32,32,32,32,32,32,32,84,105,109,101,32,109,97,115,107,32,40,32,51,58,50,53,32,112,109,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,72,111,117,114,115,32,97,110,100,32,109,105,110,117,116,101,115,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,115,112,97,99,101,115],"value":"HH:MM tt Time mask ( 3:25 pm) Allows entry of 0 through 9 plus space Hours and minutes are padded with spaces"},
-{"hash":105549971,"name":"o32sr.fieldmask42str","sourcebytes":[72,72,58,77,77,58,83,83,32,32,32,32,32,32,32,32,32,32,32,32,84,105,109,101,32,109,97,115,107,32,40,32,51,58,50,53,58,32,55,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,72,111,117,114,115,44,32,109,105,110,117,116,101,115,44,32,97,110,100,32,115,101,99,111,110,100,115,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,115,112,97,99,101,115],"value":"HH:MM:SS Time mask ( 3:25: 7) Allows entry of 0 through 9 plus space Hours, minutes, and seconds are padded with spaces"}
-]}
diff --git a/Source/3rdParty/Orpheus/units/x86_64-linux/o32sr.rsj b/Source/3rdParty/Orpheus/units/x86_64-linux/o32sr.rsj
deleted file mode 100644
index 4b00ea54..00000000
--- a/Source/3rdParty/Orpheus/units/x86_64-linux/o32sr.rsj
+++ /dev/null
@@ -1,377 +0,0 @@
-{"version":1,"strings":[
-{"hash":47539321,"name":"o32sr.rsnonestr","sourcebytes":[40,78,111,110,101,41],"value":"(None)"},
-{"hash":110676418,"name":"o32sr.rsccuser","sourcebytes":[99,99,85,115,101,114],"value":"ccUser"},
-{"hash":147440164,"name":"o32sr.rsccusernum","sourcebytes":[99,99,85,115,101,114,37,100],"value":"ccUser%d"},
-{"hash":23862543,"name":"o32sr.rsdeletetable","sourcebytes":[68,101,108,101,116,101,32,116,104,101,32,37,115,32,116,97,98,108,101,63],"value":"Delete the %s table?"},
-{"hash":47591701,"name":"o32sr.rsrenametable","sourcebytes":[82,101,110,97,109,101,32,84,97,98,108,101],"value":"Rename Table"},
-{"hash":62914634,"name":"o32sr.rsentertablename","sourcebytes":[69,110,116,101,114,32,110,101,119,32,116,97,98,108,101,32,110,97,109,101,32,102,111,114,32,37,115,58],"value":"Enter new table name for %s:"},
-{"hash":214597221,"name":"o32sr.rsnewtable","sourcebytes":[78,101,119,84,97,98,108,101],"value":"NewTable"},
-{"hash":180128884,"name":"o32sr.rsdefaulttablename","sourcebytes":[68,101,102,97,117,108,116],"value":"Default"},
-{"hash":109686626,"name":"o32sr.rswordstartablename","sourcebytes":[87,111,114,100,83,116,97,114],"value":"WordStar"},
-{"hash":321780,"name":"o32sr.rsgridtablename","sourcebytes":[71,114,105,100],"value":"Grid"},
-{"hash":86327753,"name":"o32sr.rsunknowntable","sourcebytes":[40,85,110,107,110,111,119,110,41],"value":"(Unknown)"},
-{"hash":184599794,"name":"o32sr.rsdefaultentryerrortext","sourcebytes":[69,110,116,114,121,32,69,114,114,111,114],"value":"Entry Error"},
-{"hash":44316689,"name":"o32sr.rsgotitemwarning","sourcebytes":[37,100,46,32,42,42,42,32,87,97,114,110,105,110,103,32,42,42,42,32,79,110,71,101,116,73,116,101,109,32,110,111,116,32,97,115,115,105,103,110,101,100,33],"value":"%d. *** Warning *** OnGetItem not assigned!"},
-{"hash":164121725,"name":"o32sr.rssamplelistitem","sourcebytes":[37,100,46,32,45,32,83,97,109,112,108,101,32,118,105,114,116,117,97,108,32,108,105,115,116,32,98,111,120,32,105,116,101,109],"value":"%d. - Sample virtual list box item"},
-{"hash":61396826,"name":"o32sr.rsalphastring","sourcebytes":[97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90],"value":"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"},
-{"hash":1513,"name":"o32sr.rstalllowchars","sourcebytes":[87,121],"value":"Wy"},
-{"hash":180128884,"name":"o32sr.rsdefault","sourcebytes":[68,101,102,97,117,108,116],"value":"Default"},
-{"hash":89,"name":"o32sr.rsyes","sourcebytes":[89],"value":"Y"},
-{"hash":78,"name":"o32sr.rsno","sourcebytes":[78],"value":"N"},
-{"hash":84,"name":"o32sr.rstrue","sourcebytes":[84],"value":"T"},
-{"hash":70,"name":"o32sr.rsfalse","sourcebytes":[70],"value":"F"},
-{"hash":49589427,"name":"o32sr.rsdescending","sourcebytes":[32,45,32,68,101,115,99],"value":" - Desc"},
-{"hash":197701577,"name":"o32sr.rsdefaultindex","sourcebytes":[40,68,101,102,97,117,108,116,41],"value":"(Default)"},
-{"hash":86025029,"name":"o32sr.rsduplicatecommand","sourcebytes":[68,117,112,108,105,99,97,116,101,32,99,111,109,109,97,110,100,32,102,111,117,110,100,32,119,104,105,108,101,32,97,100,100,105,110,103,32,97,32,110,101,119,32,99,111,109,109,97,110,100,32,116,111,32,116,104,101,32,116,97,98,108,101],"value":"Duplicate command found while adding a new command to the table"},
-{"hash":189452597,"name":"o32sr.rstablenotfound","sourcebytes":[67,111,109,109,97,110,100,32,116,97,98,108,101,32,110,111,116,32,102,111,117,110,100,32,111,114,32,99,111,109,109,97,110,100,32,116,97,98,108,101,32,105,110,100,101,120,32,111,117,116,32,111,102,32,114,97,110,103,101],"value":"Command table not found or command table index out of range"},
-{"hash":73438661,"name":"o32sr.rsnotdoneyet","sourcebytes":[84,104,105,115,32,102,101,97,116,117,114,101,32,105,115,32,110,111,116,32,105,109,112,108,101,109,101,110,116,101,100,32,97,116,32,116,104,105,115,32,116,105,109,101],"value":"This feature is not implemented at this time"},
-{"hash":64194580,"name":"o32sr.rsnocontrollerassigned","sourcebytes":[78,111,32,67,111,110,116,114,111,108,108,101,114,32,97,115,115,105,103,110,101,100],"value":"No Controller assigned"},
-{"hash":35420549,"name":"o32sr.rscantcreatecommandtable","sourcebytes":[85,110,97,98,108,101,32,116,111,32,99,114,101,97,116,101,32,99,111,109,109,97,110,100,32,116,97,98,108,101],"value":"Unable to create command table"},
-{"hash":48081108,"name":"o32sr.rscantdelete","sourcebytes":[67,97,110,39,116,32,100,101,108,101,116,101,32,116,104,105,115,32,116,97,98,108,101,46,32,77,117,115,116,32,104,97,118,101,32,97,116,32,108,101,97,115,116,32,111,110,101,32,99,111,109,109,97,110,100,32,116,97,98,108,101,32,100,101,102,105,110,101,100],"value":"Can't delete this table. Must have at least one command table defined"},
-{"hash":20361444,"name":"o32sr.rsinvalidkeysequence","sourcebytes":[73,110,118,97,108,105,100,32,111,114,32,110,111,32,107,101,121,32,115,101,113,117,101,110,99,101,32,101,110,116,101,114,101,100],"value":"Invalid or no key sequence entered"},
-{"hash":242348867,"name":"o32sr.rsnotwordstarcommands","sourcebytes":[75,101,121,115,32,101,110,116,101,114,101,100,32,97,114,101,32,110,111,116,32,87,111,114,100,83,116,97,114,32,115,116,121,108,101,32,99,111,109,109,97,110,100,115],"value":"Keys entered are not WordStar style commands"},
-{"hash":240741204,"name":"o32sr.rsnocommandselected","sourcebytes":[78,111,32,99,111,109,109,97,110,100,32,115,101,108,101,99,116,101,100],"value":"No command selected"},
-{"hash":157959429,"name":"o32sr.rsduplicatekeysequence","sourcebytes":[68,117,112,108,105,99,97,116,101,32,107,101,121,32,115,101,113,117,101,110,99,101],"value":"Duplicate key sequence"},
-{"hash":973461,"name":"o32sr.rsrangeerror","sourcebytes":[86,97,108,117,101,32,105,115,32,110,111,116,32,119,105,116,104,105,110,32,114,101,113,117,105,114,101,100,32,114,97,110,103,101],"value":"Value is not within required range"},
-{"hash":206041701,"name":"o32sr.rsinvalidnumber","sourcebytes":[86,97,108,117,101,32,105,115,32,110,111,116,32,118,97,108,105,100,32,102,111,114,32,116,104,105,115,32,102,105,101,108,100,32,116,121,112,101],"value":"Value is not valid for this field type"},
-{"hash":230136804,"name":"o32sr.rsrequiredfield","sourcebytes":[65,32,118,97,108,117,101,32,105,115,32,114,101,113,117,105,114,101,100,32,105,110,32,116,104,105,115,32,102,105,101,108,100],"value":"A value is required in this field"},
-{"hash":92696485,"name":"o32sr.rsinvaliddate","sourcebytes":[86,97,108,117,101,32,105,115,32,110,111,116,32,97,32,118,97,108,105,100,32,100,97,116,101],"value":"Value is not a valid date"},
-{"hash":92760373,"name":"o32sr.rsinvalidtime","sourcebytes":[86,97,108,117,101,32,105,115,32,110,111,116,32,97,32,118,97,108,105,100,32,116,105,109,101],"value":"Value is not a valid time"},
-{"hash":104098179,"name":"o32sr.rsblanksinfield","sourcebytes":[84,104,105,115,32,102,105,101,108,100,32,115,104,111,117,108,100,32,99,111,110,116,97,105,110,32,110,111,32,98,108,97,110,107,115],"value":"This field should contain no blanks"},
-{"hash":190360572,"name":"o32sr.rspartialentry","sourcebytes":[84,104,105,115,32,102,105,101,108,100,32,115,104,111,117,108,100,32,98,101,32,101,105,116,104,101,114,32,101,109,112,116,121,32,111,114,32,99,111,109,112,108,101,116,101,108,121,32,102,117,108,108],"value":"This field should be either empty or completely full"},
-{"hash":66474265,"name":"o32sr.rsregiontoolarge","sourcebytes":[82,101,103,105,111,110,32,105,115,32,116,111,111,32,108,97,114,103,101,32,40,62,32,54,52,75,41],"value":"Region is too large (> 64K)"},
-{"hash":186038585,"name":"o32sr.rsoutofmemoryforcopy","sourcebytes":[67,111,117,108,100,32,110,111,116,32,97,108,108,111,99,97,116,101,32,109,101,109,111,114,121,32,102,111,114,32,99,108,105,112,98,111,97,114,100,32,99,111,112,121],"value":"Could not allocate memory for clipboard copy"},
-{"hash":31889508,"name":"o32sr.rsinvalidparamvalue","sourcebytes":[80,97,114,97,109,101,116,101,114,32,118,97,108,117,101,32,105,115,32,105,110,118,97,108,105,100],"value":"Parameter value is invalid"},
-{"hash":110743845,"name":"o32sr.rsnotimersavail","sourcebytes":[78,111,32,87,105,110,100,111,119,39,115,32,116,105,109,101,114,115,32,97,114,101,32,97,118,97,105,108,97,98,108,101],"value":"No Window's timers are available"},
-{"hash":219139891,"name":"o32sr.rstoomanyevents","sourcebytes":[84,111,111,32,109,97,110,121,32,116,114,105,103,103,101,114,32,101,118,101,110,116,115],"value":"Too many trigger events"},
-{"hash":103937301,"name":"o32sr.rsbadtriggerhandle","sourcebytes":[73,110,118,97,108,105,100,32,116,114,105,103,103,101,114,32,104,97,110,100,108,101],"value":"Invalid trigger handle"},
-{"hash":192553604,"name":"o32sr.rsonselectnotassigned","sourcebytes":[79,110,83,101,108,101,99,116,32,101,118,101,110,116,32,105,115,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"OnSelect event is not assigned"},
-{"hash":124954245,"name":"o32sr.rsinvalidpageindex","sourcebytes":[73,110,118,97,108,105,100,32,112,97,103,101,32,105,110,100,101,120,32,118,97,108,117,101],"value":"Invalid page index value"},
-{"hash":172862148,"name":"o32sr.rsinvaliddatatype","sourcebytes":[73,110,118,97,108,105,100,32,100,97,116,97,32,116,121,112,101,32,102,111,114,32,116,104,105,115,32,102,105,101,108,100],"value":"Invalid data type for this field"},
-{"hash":39861684,"name":"o32sr.rsinvalidtabfont","sourcebytes":[73,110,118,97,108,105,100,32,102,111,110,116,46,32,78,111,110,32,116,111,84,111,112,32,111,114,105,101,110,116,101,100,32,116,97,98,115,32,114,101,113,117,105,114,101,32,97,32,84,114,117,101,45,84,121,112,101,32,102,111,110,116],"value":"Invalid font. Non toTop oriented tabs require a True-Type font"},
-{"hash":69686484,"name":"o32sr.rsinvalidlabelfont","sourcebytes":[73,110,118,97,108,105,100,32,102,111,110,116,46,32,82,111,116,97,116,101,100,32,116,101,120,116,32,114,101,113,117,105,114,101,115,32,97,32,84,114,117,101,45,84,121,112,101,32,102,111,110,116],"value":"Invalid font. Rotated text requires a True-Type font"},
-{"hash":258097070,"name":"o32sr.rsoutofmemory","sourcebytes":[105,110,115,117,102,102,105,99,105,101,110,116,32,109,101,109,111,114,121,32,102,111,114,32,114,101,113,117,101,115,116,101,100,32,111,112,101,114,97,116,105,111,110],"value":"insufficient memory for requested operation"},
-{"hash":151298131,"name":"o32sr.rstoomanyparas","sourcebytes":[67,117,114,114,101,110,116,32,111,112,101,114,97,116,105,111,110,32,119,105,108,108,32,101,120,99,101,101,100,32,116,104,101,32,109,97,120,105,109,117,109,32,110,117,109,98,101,114,32,111,102,32,97,108,108,111,119,101,100,32,112,97,114,97,103,114,97,112,104,115],"value":"Current operation will exceed the maximum number of allowed paragraphs"},
-{"hash":88628149,"name":"o32sr.rscannotjoin","sourcebytes":[67,97,110,110,111,116,32,106,111,105,110,32,112,97,114,97,103,114,97,112,104,115,46,32,78,101,119,32,112,97,114,97,103,114,97,112,104,32,115,105,122,101,32,101,120,99,101,101,100,115,32,109,97,120,105,109,117,109,32,112,97,114,97,103,114,97,112,104,32,115,105,122,101],"value":"Cannot join paragraphs. New paragraph size exceeds maximum paragraph size"},
-{"hash":198920885,"name":"o32sr.rstoomanybytes","sourcebytes":[67,117,114,114,101,110,116,32,111,112,101,114,97,116,105,111,110,32,119,105,108,108,32,101,120,99,101,101,100,32,116,104,101,32,109,97,120,105,109,117,109,32,116,101,120,116,32,115,105,122,101],"value":"Current operation will exceed the maximum text size"},
-{"hash":158057429,"name":"o32sr.rsparatoolong","sourcebytes":[67,117,114,114,101,110,116,32,111,112,101,114,97,116,105,111,110,32,119,105,108,108,32,101,120,99,101,101,100,32,116,104,101,32,109,97,120,105,109,117,109,32,112,97,114,97,103,114,97,112,104,32,115,105,122,101],"value":"Current operation will exceed the maximum paragraph size"},
-{"hash":191420670,"name":"o32sr.rsunknownerror","sourcebytes":[85,110,107,110,111,119,110,32,69,114,114,111,114,32,99,111,110,100,105,116,105,111,110],"value":"Unknown Error condition"},
-{"hash":154407027,"name":"o32sr.rsinvalidpicturemask","sourcebytes":[73,110,118,97,108,105,100,32,112,105,99,116,117,114,101,32,109,97,115,107,58,32,37,115],"value":"Invalid picture mask: %s"},
-{"hash":13087785,"name":"o32sr.rsinvalidrange","sourcebytes":[73,110,118,97,108,105,100,32,114,97,110,103,101,46,32,69,110,116,101,114,32,97,32,118,97,108,117,101,32,98,101,116,119,101,101,110,32,40,37,100,41,32,97,110,100,32,40,37,100,41],"value":"Invalid range. Enter a value between (%d) and (%d)"},
-{"hash":248400601,"name":"o32sr.rsinvalidrealrange","sourcebytes":[73,110,118,97,108,105,100,32,114,97,110,103,101,46,32,69,110,116,101,114,32,97,32,118,97,108,117,101,32,98,101,116,119,101,101,110,32,40,45,49,46,55,101,43,51,56,41,32,97,110,100,32,40,43,49,46,55,101,43,51,56,41],"value":"Invalid range. Enter a value between (-1.7e+38) and (+1.7e+38)"},
-{"hash":264564361,"name":"o32sr.rsinvalidextendedrange","sourcebytes":[73,110,118,97,108,105,100,32,114,97,110,103,101,46,32,69,110,116,101,114,32,97,32,118,97,108,117,101,32,98,101,116,119,101,101,110,32,40,45,49,46,49,101,43,52,57,51,50,41,32,97,110,100,32,40,43,49,46,49,101,43,52,57,51,50,41],"value":"Invalid range. Enter a value between (-1.1e+4932) and (+1.1e+4932)"},
-{"hash":155966601,"name":"o32sr.rsinvaliddoublerange","sourcebytes":[73,110,118,97,108,105,100,32,114,97,110,103,101,46,32,69,110,116,101,114,32,97,32,118,97,108,117,101,32,98,101,116,119,101,101,110,32,40,45,49,46,55,101,43,51,48,56,41,32,97,110,100,32,40,43,49,46,55,101,43,51,48,56,41],"value":"Invalid range. Enter a value between (-1.7e+308) and (+1.7e+308)"},
-{"hash":246959545,"name":"o32sr.rsinvalidsinglerange","sourcebytes":[73,110,118,97,108,105,100,32,114,97,110,103,101,46,32,69,110,116,101,114,32,97,32,118,97,108,117,101,32,98,101,116,119,101,101,110,32,40,45,51,46,52,101,43,51,56,41,32,97,110,100,32,40,43,51,46,52,101,43,51,56,41],"value":"Invalid range. Enter a value between (-3.4e+38) and (+3.4e+38)"},
-{"hash":246828377,"name":"o32sr.rsinvalidcomprange","sourcebytes":[73,110,118,97,108,105,100,32,114,97,110,103,101,46,32,69,110,116,101,114,32,97,32,118,97,108,117,101,32,98,101,116,119,101,101,110,32,40,45,57,46,50,101,43,49,56,41,32,97,110,100,32,40,43,57,46,50,101,43,49,56,41],"value":"Invalid range. Enter a value between (-9.2e+18) and (+9.2e+18)"},
-{"hash":235266788,"name":"o32sr.rsinvaliddaterange","sourcebytes":[73,110,118,97,108,105,100,32,100,97,116,101,32,114,97,110,103,101,46,32,69,110,116,101,114,32,97,32,118,97,108,117,101,32,117,115,105,110,103,32,39,37,115,39,32,97,115,32,116,104,101,32,102,111,114,109,97,116],"value":"Invalid date range. Enter a value using '%s' as the format"},
-{"hash":91612132,"name":"o32sr.rsinvalidtimerange","sourcebytes":[73,110,118,97,108,105,100,32,116,105,109,101,32,114,97,110,103,101,46,32,69,110,116,101,114,32,97,32,118,97,108,117,101,32,117,115,105,110,103,32,39,37,115,39,32,97,115,32,116,104,101,32,102,111,114,109,97,116],"value":"Invalid time range. Enter a value using '%s' as the format"},
-{"hash":22644165,"name":"o32sr.rsinvalidrangevalue","sourcebytes":[73,110,118,97,108,105,100,32,114,97,110,103,101,32,118,97,108,117,101],"value":"Invalid range value"},
-{"hash":38619085,"name":"o32sr.rsinvalidminmaxvalue","sourcebytes":[73,110,118,97,108,105,100,32,118,97,108,117,101,32,45,32,77,97,120,105,109,117,109,32,109,117,115,116,32,97,108,119,97,121,115,32,98,101,32,103,114,101,97,116,101,114,32,116,104,97,110,32,77,105,110,105,109,117,109],"value":"Invalid value - Maximum must always be greater than Minimum"},
-{"hash":149815988,"name":"o32sr.rsrangenotsupported","sourcebytes":[82,97,110,103,101,32,108,105,109,105,116,115,32,102,111,114,32,116,104,101,32,99,117,114,114,101,110,116,108,121,32,115,101,108,101,99,116,101,100,32,100,97,116,97,32,116,121,112,101,32,97,114,101,32,110,111,116,32,115,117,112,112,111,114,116,101,100],"value":"Range limits for the currently selected data type are not supported"},
-{"hash":54276856,"name":"o32sr.rsinvalidlineorparaindex","sourcebytes":[73,110,118,97,108,105,100,32,108,105,110,101,32,111,114,32,112,97,114,97,103,114,97,112,104,32,105,110,100,101,120],"value":"Invalid line or paragraph index"},
-{"hash":77699476,"name":"o32sr.rsnonfixedfont","sourcebytes":[73,110,118,97,108,105,100,32,102,111,110,116,32,97,115,115,105,103,110,109,101,110,116,46,32,70,111,110,116,32,109,117,115,116,32,98,101,32,97,32,102,105,120,101,100,32,102,111,110,116],"value":"Invalid font assignment. Font must be a fixed font"},
-{"hash":83345268,"name":"o32sr.rsinvalidfontparam","sourcebytes":[73,110,118,97,108,105,100,32,102,111,110,116,32,97,115,115,105,103,110,101,109,110,116,46,32,70,111,110,116,32,109,117,115,116,32,98,101,32,97,32,84,70,111,110,116,32,111,114,32,84,79,118,99,70,105,120,101,100,70,111,110,116],"value":"Invalid font assignemnt. Font must be a TFont or TOvcFixedFont"},
-{"hash":252258974,"name":"o32sr.rsinvalidlineorcolumn","sourcebytes":[73,110,118,97,108,105,100,32,108,105,110,101,32,111,114,32,99,111,108,117,109,110],"value":"Invalid line or column"},
-{"hash":243786162,"name":"o32sr.rssaegeneral","sourcebytes":[85,110,107,110,111,119,110,32,115,112,97,114,115,101,32,97,114,114,97,121,32,101,114,114,111,114],"value":"Unknown sparse array error"},
-{"hash":187909973,"name":"o32sr.rssaeatmaxsize","sourcebytes":[83,112,97,114,115,101,32,97,114,114,97,121,32,105,115,32,97,116,32,116,104,101,32,109,97,120,105,109,117,109,32,115,105,122,101],"value":"Sparse array is at the maximum size"},
-{"hash":164284260,"name":"o32sr.rsinvalidxmlfile","sourcebytes":[73,110,118,97,108,105,100,32,88,77,76,83,116,111,114,101,32,70,105,108,101,32,70,111,114,109,97,116],"value":"Invalid XMLStore File Format"},
-{"hash":254995412,"name":"o32sr.rsunterminatedelement","sourcebytes":[73,109,112,114,111,112,101,114,108,121,32,116,101,114,109,105,110,97,116,101,100,32,101,108,101,109,101,110,116],"value":"Improperly terminated element"},
-{"hash":205947476,"name":"o32sr.rsbadcolorconstant","sourcebytes":[73,110,118,97,108,105,100,32,99,111,108,111,114,32,99,111,110,115,116,97,110,116],"value":"Invalid color constant"},
-{"hash":38445685,"name":"o32sr.rsbadcolorvalue","sourcebytes":[73,110,118,97,108,105,100,32,99,111,108,111,114,32,118,97,108,117,101],"value":"Invalid color value"},
-{"hash":240618073,"name":"o32sr.rssaeoutofbounds","sourcebytes":[73,110,100,101,120,32,105,115,32,111,117,116,32,111,102,32,98,111,117,110,100,115,32,102,111,114,32,115,112,97,114,115,101,32,97,114,114,97,121],"value":"Index is out of bounds for sparse array"},
-{"hash":239028484,"name":"o32sr.rsinvalidfieldtype","sourcebytes":[82,101,113,117,101,115,116,101,100,32,102,105,101,108,100,32,116,121,112,101,32,105,115,32,110,111,116,32,115,117,112,112,111,114,116,101,100],"value":"Requested field type is not supported"},
-{"hash":86960565,"name":"o32sr.rsbadalarmhandle","sourcebytes":[73,110,118,97,108,105,100,32,97,108,97,114,109,32,104,97,110,100,108,101],"value":"Invalid alarm handle"},
-{"hash":131528196,"name":"o32sr.rsonisselectednotassigned","sourcebytes":[79,110,73,115,83,101,108,101,99,116,101,100,32,101,118,101,110,116,32,105,115,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"OnIsSelected event is not assigned"},
-{"hash":167101369,"name":"o32sr.rsinvaliddateformask","sourcebytes":[73,110,118,97,108,105,100,32,100,97,116,101,32,118,97,108,117,101,32,102,111,114,32,112,105,99,116,117,114,101,32,109,97,115,107,46,32,40,89,101,97,114,32,105,115,32,111,117,116,115,105,100,101,32,116,104,101,32,69,112,111,99,104,32,114,97,110,103,101,41],"value":"Invalid date value for picture mask. (Year is outside the Epoch range)"},
-{"hash":202611508,"name":"o32sr.rsviewerioerror","sourcebytes":[86,105,101,119,101,114,32,116,114,105,103,103,101,114,101,100,32,73,47,79,32,101,114,114,111,114,32,37,100],"value":"Viewer triggered I\/O error %d"},
-{"hash":93066788,"name":"o32sr.rsviewerfilenotfound","sourcebytes":[86,105,101,119,101,114,58,32,102,105,108,101,32,110,111,116,32,102,111,117,110,100],"value":"Viewer: file not found"},
-{"hash":93921701,"name":"o32sr.rsviewerpathnotfound","sourcebytes":[86,105,101,119,101,114,58,32,112,97,116,104,32,110,111,116,32,102,111,117,110,100,32,111,114,32,105,110,118,97,108,105,100,32,102,105,108,101,32,110,97,109,101],"value":"Viewer: path not found or invalid file name"},
-{"hash":37810179,"name":"o32sr.rsviewertoomanyopenfiles","sourcebytes":[86,105,101,119,101,114,58,32,116,111,111,32,109,97,110,121,32,111,112,101,110,32,102,105,108,101,115],"value":"Viewer: too many open files"},
-{"hash":137519748,"name":"o32sr.rsviewerfileaccessdenied","sourcebytes":[86,105,101,119,101,114,58,32,102,105,108,101,32,97,99,99,101,115,115,32,100,101,110,105,101,100],"value":"Viewer: file access denied"},
-{"hash":206530819,"name":"o32sr.rscontrolattached","sourcebytes":[84,104,105,115,32,99,111,110,116,114,111,108,32,105,115,32,97,108,114,101,97,100,121,32,97,116,116,97,99,104,101,100,32,116,111,32,37,115],"value":"This control is already attached to %s"},
-{"hash":94969973,"name":"o32sr.rscantedit","sourcebytes":[67,111,117,108,100,32,110,111,116,32,101,110,116,101,114,32,101,100,105,116,32,109,111,100,101],"value":"Could not enter edit mode"},
-{"hash":258793572,"name":"o32sr.rschildtableerror","sourcebytes":[68,97,116,97,32,83,111,117,114,99,101,32,99,97,110,32,110,111,116,32,98,101,32,97,32,99,104,105,108,100,32,116,97,98,108,101,46,32,67,111,109,112,111,110,101,110,116,32,37,115,32,104,97,115,32,97,32,77,97,115,116,101,114,83,111,117,114,99,101,32,100,101,102,105,110,101,100],"value":"Data Source can not be a child table. Component %s has a MasterSource defined"},
-{"hash":54018357,"name":"o32sr.rsnotableattached","sourcebytes":[68,97,116,97,83,111,117,114,99,101,32,109,117,115,116,32,98,101,32,97,116,116,97,99,104,101,100,32,116,111,32,97,32,84,84,97,98,108,101,32,40,111,114,32,99,111,109,112,97,116,105,98,108,101,41,32,115,111,117,114,99,101],"value":"DataSource must be attached to a TTable (or compatible) source"},
-{"hash":115453668,"name":"o32sr.rsnocollection","sourcebytes":[78,111,32,99,111,108,108,101,99,116,105,111,110,32,101,120,105,115,116,115,32,105,110,32,116,104,101,32,111,119,110,101,114,32,99,111,109,112,111,110,101,110,116],"value":"No collection exists in the owner component"},
-{"hash":139674484,"name":"o32sr.rsnotovcdescendant","sourcebytes":[79,119,110,101,114,32,109,117,115,116,32,98,101,32,97,32,84,79,118,99,67,111,109,112,111,110,101,110,116,32,111,114,32,84,79,118,99,67,117,115,116,111,109,67,111,109,112,111,110,101,110,116,32,100,101,115,99,101,110,100,97,110,116],"value":"Owner must be a TOvcComponent or TOvcCustomComponent descendant"},
-{"hash":9129726,"name":"o32sr.rsitemincompatible","sourcebytes":[73,116,101,109,32,105,110,99,111,109,112,97,116,105,98,108,101,32,119,105,116,104,32,99,111,108,108,101,99,116,105,111,110],"value":"Item incompatible with collection"},
-{"hash":265712596,"name":"o32sr.rslabelnotattached","sourcebytes":[76,97,98,101,108,32,110,111,116,32,97,116,116,97,99,104,101,100],"value":"Label not attached"},
-{"hash":172254164,"name":"o32sr.rsclassnotset","sourcebytes":[73,116,101,109,32,99,108,97,115,115,32,110,111,116,32,115,101,116],"value":"Item class not set"},
-{"hash":240220981,"name":"o32sr.rscollectionnotfound","sourcebytes":[78,111,32,99,111,108,108,101,99,116,105,111,110,32,102,111,117,110,100,32,102,111,114,32,116,104,105,115,32,116,121,112,101],"value":"No collection found for this type"},
-{"hash":58974537,"name":"o32sr.rsdayconverterror","sourcebytes":[69,114,114,111,114,32,99,111,110,118,101,114,116,105,110,103,32,100,97,121],"value":"Error converting day"},
-{"hash":66692648,"name":"o32sr.rsmonthconverterror","sourcebytes":[69,114,114,111,114,32,99,111,110,118,101,114,116,105,110,103,32,109,111,110,116,104],"value":"Error converting month"},
-{"hash":43703893,"name":"o32sr.rsmonthnameconverterror","sourcebytes":[69,114,114,111,114,32,99,111,110,118,101,114,116,105,110,103,32,109,111,110,116,104,32,110,97,109,101],"value":"Error converting month name"},
-{"hash":138364850,"name":"o32sr.rsyearconverterror","sourcebytes":[69,114,114,111,114,32,99,111,110,118,101,114,116,105,110,103,32,121,101,97,114],"value":"Error converting year"},
-{"hash":44447241,"name":"o32sr.rsinvalidday","sourcebytes":[73,110,118,97,108,105,100,32,100,97,121],"value":"Invalid day"},
-{"hash":105965320,"name":"o32sr.rsinvalidmonth","sourcebytes":[73,110,118,97,108,105,100,32,109,111,110,116,104],"value":"Invalid month"},
-{"hash":12864069,"name":"o32sr.rsinvalidmonthname","sourcebytes":[73,110,118,97,108,105,100,32,109,111,110,116,104,32,110,97,109,101],"value":"Invalid month name"},
-{"hash":174207906,"name":"o32sr.rsinvalidyear","sourcebytes":[73,110,118,97,108,105,100,32,121,101,97,114],"value":"Invalid year"},
-{"hash":133961140,"name":"o32sr.rsdayrequired","sourcebytes":[68,97,121,32,105,115,32,114,101,113,117,105,114,101,100],"value":"Day is required"},
-{"hash":114309780,"name":"o32sr.rsmonthrequired","sourcebytes":[77,111,110,116,104,32,105,115,32,114,101,113,117,105,114,101,100],"value":"Month is required"},
-{"hash":150971572,"name":"o32sr.rsyearrequired","sourcebytes":[89,101,97,114,32,105,115,32,114,101,113,117,105,114,101,100],"value":"Year is required"},
-{"hash":99732068,"name":"o32sr.rsownermustbeform","sourcebytes":[79,119,110,101,114,32,109,117,115,116,32,98,101,32,97,32,84,70,111,114,109,32,111,114,32,100,101,115,99,101,110,100,97,110,116],"value":"Owner must be a TForm or descendant"},
-{"hash":256079797,"name":"o32sr.rstimeconverterror","sourcebytes":[69,114,114,111,114,32,99,111,110,118,101,114,116,105,110,103,32,116,105,109,101,32,118,97,108,117,101],"value":"Error converting time value"},
-{"hash":70100255,"name":"o32sr.rscancelquery","sourcebytes":[67,97,110,99,101,108,32,97,110,100,32,108,111,115,101,32,99,104,97,110,103,101,115,63],"value":"Cancel and lose changes?"},
-{"hash":124996276,"name":"o32sr.rsnopagesassigned","sourcebytes":[78,111,32,110,111,116,101,98,111,111,107,32,112,97,103,101,115,32,97,115,115,105,103,110,101,100],"value":"No notebook pages assigned"},
-{"hash":147502133,"name":"o32sr.rsrestoremi","sourcebytes":[38,82,101,115,116,111,114,101],"value":"&Restore"},
-{"hash":305108,"name":"o32sr.rscutmi","sourcebytes":[67,117,38,116],"value":"Cu&t"},
-{"hash":2795129,"name":"o32sr.rscopymi","sourcebytes":[38,67,111,112,121],"value":"&Copy"},
-{"hash":45517477,"name":"o32sr.rspastemi","sourcebytes":[38,80,97,115,116,101],"value":"&Paste"},
-{"hash":179055749,"name":"o32sr.rsdeletemi","sourcebytes":[38,68,101,108,101,116,101],"value":"&Delete"},
-{"hash":171665052,"name":"o32sr.rsselectallmi","sourcebytes":[83,101,108,101,99,116,32,38,65,108,108],"value":"Select &All"},
-{"hash":124993891,"name":"o32sr.rstablerowoutofbounds","sourcebytes":[84,97,98,108,101,32,114,111,119,32,111,117,116,32,111,102,32,98,111,117,110,100,115],"value":"Table row out of bounds"},
-{"hash":173710098,"name":"o32sr.rstablemaxrows","sourcebytes":[84,97,98,108,101,32,109,97,120,32,114,111,119,115,32,101,114,114,111,114],"value":"Table max rows error"},
-{"hash":172411506,"name":"o32sr.rstablemaxcolumns","sourcebytes":[84,97,98,108,101,32,109,97,120,32,99,111,108,117,109,110,115,32,101,114,114,111,114],"value":"Table max columns error"},
-{"hash":162625570,"name":"o32sr.rstablegeneral","sourcebytes":[84,97,98,108,101,32,103,101,110,101,114,97,108,32,101,114,114,111,114],"value":"Table general error"},
-{"hash":259026723,"name":"o32sr.rstabletomanycolumns","sourcebytes":[84,111,111,32,109,97,110,121,32,99,111,108,117,109,110,115],"value":"Too many columns"},
-{"hash":6303816,"name":"o32sr.rstableinvalidfieldindex","sourcebytes":[73,110,118,97,108,105,100,32,102,105,101,108,100,32,105,110,100,101,120],"value":"Invalid field index"},
-{"hash":10366516,"name":"o32sr.rstableheadernotassigned","sourcebytes":[72,101,97,100,101,114,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"Header not assigned"},
-{"hash":175419180,"name":"o32sr.rstableinvalidheadercell","sourcebytes":[73,110,118,97,108,105,100,32,104,101,97,100,101,114,32,99,101,108,108],"value":"Invalid header cell"},
-{"hash":296859,"name":"o32sr.rscalcback","sourcebytes":[66,97,99,107],"value":"Back"},
-{"hash":1299,"name":"o32sr.rscalcmc","sourcebytes":[77,67],"value":"MC"},
-{"hash":1314,"name":"o32sr.rscalcmr","sourcebytes":[77,82],"value":"MR"},
-{"hash":1315,"name":"o32sr.rscalcms","sourcebytes":[77,83],"value":"MS"},
-{"hash":1275,"name":"o32sr.rscalcmplus","sourcebytes":[77,43],"value":"M+"},
-{"hash":1277,"name":"o32sr.rscalcmminus","sourcebytes":[77,45],"value":"M-"},
-{"hash":1156,"name":"o32sr.rscalcct","sourcebytes":[67,84],"value":"CT"},
-{"hash":1141,"name":"o32sr.rscalcce","sourcebytes":[67,69],"value":"CE"},
-{"hash":67,"name":"o32sr.rscalcc","sourcebytes":[67],"value":"C"},
-{"hash":370836,"name":"o32sr.rscalcsqrt","sourcebytes":[83,113,114,116],"value":"Sqrt"},
-{"hash":338644,"name":"o32sr.rscalnext","sourcebytes":[78,69,88,84],"value":"NEXT"},
-{"hash":329348,"name":"o32sr.rscallast","sourcebytes":[76,65,83,84],"value":"LAST"},
-{"hash":349862,"name":"o32sr.rscalprev","sourcebytes":[80,82,69,86],"value":"PREV"},
-{"hash":4908932,"name":"o32sr.rscalfirst","sourcebytes":[70,73,82,83,84],"value":"FIRST"},
-{"hash":13956,"name":"o32sr.rscal1st","sourcebytes":[49,83,84],"value":"1ST"},
-{"hash":91849764,"name":"o32sr.rscalsecond","sourcebytes":[83,69,67,79,78,68],"value":"SECOND"},
-{"hash":14116,"name":"o32sr.rscal2nd","sourcebytes":[50,78,68],"value":"2ND"},
-{"hash":5820004,"name":"o32sr.rscalthird","sourcebytes":[84,72,73,82,68],"value":"THIRD"},
-{"hash":14436,"name":"o32sr.rscal3rd","sourcebytes":[51,82,68],"value":"3RD"},
-{"hash":78948232,"name":"o32sr.rscalfourth","sourcebytes":[70,79,85,82,84,72],"value":"FOURTH"},
-{"hash":14728,"name":"o32sr.rscal4th","sourcebytes":[52,84,72],"value":"4TH"},
-{"hash":4907612,"name":"o32sr.rscalfinal","sourcebytes":[70,73,78,65,76],"value":"FINAL"},
-{"hash":18237,"name":"o32sr.rscalbom","sourcebytes":[66,79,77],"value":"BOM"},
-{"hash":4627422,"name":"o32sr.rscalbegin","sourcebytes":[66,69,71,73,78],"value":"BEGIN"},
-{"hash":19005,"name":"o32sr.rscaleom","sourcebytes":[69,79,77],"value":"EOM"},
-{"hash":18980,"name":"o32sr.rscalend","sourcebytes":[69,78,68],"value":"END"},
-{"hash":143275465,"name":"o32sr.rscalyesterday","sourcebytes":[89,69,83,84,69,82,68,65,89],"value":"YESTERDAY"},
-{"hash":5847145,"name":"o32sr.rscaltoday","sourcebytes":[84,79,68,65,89],"value":"TODAY"},
-{"hash":69498071,"name":"o32sr.rscaltomorrow","sourcebytes":[84,79,77,79,82,82,79,87],"value":"TOMORROW"},
-{"hash":80477938,"name":"o32sr.rseditingsections","sourcebytes":[72,101,97,100,101,114,32,83,101,99,116,105,111,110,115,32,69,100,105,116,111,114],"value":"Header Sections Editor"},
-{"hash":248718130,"name":"o32sr.rseditingitems","sourcebytes":[70,111,108,100,101,114,32,73,116,101,109,115,32,69,100,105,116,111,114],"value":"Folder Items Editor"},
-{"hash":165259106,"name":"o32sr.rseditingfolders","sourcebytes":[70,111,108,100,101,114,32,69,100,105,116,111,114],"value":"Folder Editor"},
-{"hash":31027826,"name":"o32sr.rseditingpages","sourcebytes":[84,97,98,32,80,97,103,101,115,32,69,100,105,116,111,114],"value":"Tab Pages Editor"},
-{"hash":60438738,"name":"o32sr.rseditingimages","sourcebytes":[73,109,97,103,101,32,76,105,115,116,32,69,100,105,116,111,114],"value":"Image List Editor"},
-{"hash":163229710,"name":"o32sr.rssectionbasename","sourcebytes":[83,101,99,116,105,111,110],"value":"Section"},
-{"hash":330429,"name":"o32sr.rsitembasename","sourcebytes":[73,116,101,109],"value":"Item"},
-{"hash":81144514,"name":"o32sr.rsfolderbasename","sourcebytes":[70,111,108,100,101,114],"value":"Folder"},
-{"hash":354261,"name":"o32sr.rspagebasename","sourcebytes":[80,97,103,101],"value":"Page"},
-{"hash":5257173,"name":"o32sr.rsimagebasename","sourcebytes":[73,109,97,103,101],"value":"Image"},
-{"hash":5205139,"name":"o32sr.rshoursname","sourcebytes":[72,111,117,114,115],"value":"Hours"},
-{"hash":67488403,"name":"o32sr.rsminutesname","sourcebytes":[77,105,110,117,116,101,115],"value":"Minutes"},
-{"hash":163210467,"name":"o32sr.rssecondsname","sourcebytes":[83,101,99,111,110,100,115],"value":"Seconds"},
-{"hash":4863637,"name":"o32sr.rsclosecaption","sourcebytes":[67,108,111,115,101],"value":"Close"},
-{"hash":268126580,"name":"o32sr.rsviewfieldnotfound","sourcebytes":[84,104,101,32,118,105,101,119,32,102,105,101,108,100,32,37,115,32,119,97,115,32,110,111,116,32,102,111,117,110,100],"value":"The view field %s was not found"},
-{"hash":17553811,"name":"o32sr.rscantresolvefield","sourcebytes":[85,110,97,98,108,101,32,116,111,32,114,101,115,111,108,118,101,32,118,105,101,119,32,102,105,101,108,100,32,37,115],"value":"Unable to resolve view field %s"},
-{"hash":160173704,"name":"o32sr.rsitemalreadyexists","sourcebytes":[67,97,110,39,116,32,97,100,100,32,105,116,101,109,32,37,112,32,45,32,105,116,32,97,108,114,101,97,100,121,32,101,120,105,115,116,115,32,105,110,32,116,104,101,32,105,110,100,101,120],"value":"Can't add item %p - it already exists in the index"},
-{"hash":108159061,"name":"o32sr.rsalreadyintempmode","sourcebytes":[84,104,101,32,118,105,101,119,32,105,115,32,97,108,114,101,97,100,121,32,105,110,32,116,101,109,112,111,114,97,114,121,32,105,110,100,101,120,32,109,111,100,101],"value":"The view is already in temporary index mode"},
-{"hash":17830740,"name":"o32sr.rsitemnotfound","sourcebytes":[83,112,101,99,105,102,105,101,100,32,114,101,112,111,114,116,32,118,105,101,119,32,100,97,116,97,32,105,116,101,109,32,37,112,32,119,97,115,32,110,111,116,32,102,111,117,110,100],"value":"Specified report view data item %p was not found"},
-{"hash":201152055,"name":"o32sr.rsupdatepending","sourcebytes":[84,104,105,115,32,114,101,112,111,114,116,32,118,105,101,119,32,111,112,101,114,97,116,105,111,110,32,105,115,32,105,110,118,97,108,105,100,32,119,104,105,108,101,32,117,112,100,97,116,101,115,32,97,114,101,32,112,101,110,100,105,110,103],"value":"This report view operation is invalid while updates are pending"},
-{"hash":76579668,"name":"o32sr.rsoncomparenotassigned","sourcebytes":[79,110,67,111,109,112,97,114,101,70,105,101,108,100,115,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"OnCompareFields not assigned"},
-{"hash":113924180,"name":"o32sr.rsonfilternotassigned","sourcebytes":[79,110,70,105,108,116,101,114,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"OnFilter not assigned"},
-{"hash":141112020,"name":"o32sr.rsgetasfloatnotassigned","sourcebytes":[71,101,116,65,115,70,108,111,97,116,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"GetAsFloat not assigned"},
-{"hash":164581701,"name":"o32sr.rsnotintempmode","sourcebytes":[82,101,112,111,114,116,32,118,105,101,119,32,105,115,32,110,111,116,32,105,110,32,116,101,109,112,111,114,97,114,121,32,105,110,100,101,120,32,109,111,100,101],"value":"Report view is not in temporary index mode"},
-{"hash":139773240,"name":"o32sr.rsitemnotinindex","sourcebytes":[84,104,101,32,115,112,101,99,105,102,105,101,100,32,100,97,116,97,32,105,116,101,109,32,40,37,112,41,32,105,115,32,110,111,116,32,105,110,32,116,104,101,32,105,110,100,101,120],"value":"The specified data item (%p) is not in the index"},
-{"hash":219185047,"name":"o32sr.rsnoactiveview","sourcebytes":[78,111,32,97,99,116,105,118,101,32,118,105,101,119],"value":"No active view"},
-{"hash":207431808,"name":"o32sr.rsitemisnotgroup","sourcebytes":[73,116,101,109,32,97,116,32,108,105,110,101,32,37,100,32,105,115,32,110,111,116,32,97,32,103,114,111,117,112],"value":"Item at line %d is not a group"},
-{"hash":244079028,"name":"o32sr.rsnotmultiselect","sourcebytes":[84,104,105,115,32,114,101,112,111,114,116,32,118,105,101,119,32,111,112,101,114,97,116,105,111,110,32,105,115,32,111,110,108,121,32,97,108,108,111,119,101,100,32,119,104,101,110,32,109,117,108,116,105,115,101,108,101,99,116,32,105,115,32,101,110,97,98,108,101,100],"value":"This report view operation is only allowed when multiselect is enabled"},
-{"hash":210158068,"name":"o32sr.rslinenooutofrange","sourcebytes":[73,110,118,97,108,105,100,32,105,110,100,101,120,32,37,100],"value":"Invalid index %d"},
-{"hash":178454563,"name":"o32sr.rsunknownview","sourcebytes":[85,110,107,110,111,119,110,32,118,105,101,119,58,32,37,115],"value":"Unknown view: %s"},
-{"hash":170685332,"name":"o32sr.rsonkeysearchnotassigned","sourcebytes":[84,104,101,32,79,110,75,101,121,83,101,97,114,99,104,32,101,118,101,110,116,32,105,115,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"The OnKeySearch event is not assigned"},
-{"hash":41277828,"name":"o32sr.rsonenumnotassigned","sourcebytes":[84,104,101,32,79,110,69,110,117,109,32,101,118,101,110,116,32,105,115,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"The OnEnum event is not assigned"},
-{"hash":53442292,"name":"o32sr.rsonenumselectedna","sourcebytes":[79,110,69,110,117,109,83,101,108,101,99,116,101,100,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"OnEnumSelected not assigned"},
-{"hash":218640564,"name":"o32sr.rsnomenuassigned","sourcebytes":[78,111,32,109,101,110,117,32,105,116,101,109,32,97,115,115,105,103,110,101,100],"value":"No menu item assigned"},
-{"hash":251158724,"name":"o32sr.rsnoanchorassigned","sourcebytes":[78,111,32,97,110,99,104,111,114,32,105,116,101,109,32,97,115,115,105,103,110,101,100],"value":"No anchor item assigned"},
-{"hash":80460738,"name":"o32sr.rsinvalidparameter","sourcebytes":[73,110,118,97,108,105,100,32,112,97,114,97,109,101,116,101,114,58,32,109,112,65,110,99,104,111,114],"value":"Invalid parameter: mpAnchor"},
-{"hash":198347043,"name":"o32sr.rsinvalidoperation","sourcebytes":[73,110,118,97,108,105,100,32,111,112,101,114,97,116,105,111,110,58,32,67,97,108,108,32,65,100,100,83,112,108,105,116,32,102,111,114,32,115,112,108,105,116,32,109,101,110,117,115],"value":"Invalid operation: Call AddSplit for split menus"},
-{"hash":120111635,"name":"o32sr.rsformuseonly","sourcebytes":[84,104,105,115,32,99,111,109,112,111,110,101,110,116,32,99,97,110,32,111,110,108,121,32,98,101,32,117,115,101,100,32,111,110,32,102,111,114,109,115],"value":"This component can only be used on forms"},
-{"hash":4794267,"name":"o32sr.rscolorblack","sourcebytes":[66,108,97,99,107],"value":"Black"},
-{"hash":87594590,"name":"o32sr.rscolormaroon","sourcebytes":[77,97,114,111,111,110],"value":"Maroon"},
-{"hash":5147582,"name":"o32sr.rscolorgreen","sourcebytes":[71,114,101,101,110],"value":"Green"},
-{"hash":5648581,"name":"o32sr.rscolorolive","sourcebytes":[79,108,105,118,101],"value":"Olive"},
-{"hash":346329,"name":"o32sr.rscolornavy","sourcebytes":[78,97,118,121],"value":"Navy"},
-{"hash":92051237,"name":"o32sr.rscolorpurple","sourcebytes":[80,117,114,112,108,101],"value":"Purple"},
-{"hash":371580,"name":"o32sr.rscolorteal","sourcebytes":[84,101,97,108],"value":"Teal"},
-{"hash":321673,"name":"o32sr.rscolorgray","sourcebytes":[71,114,97,121],"value":"Gray"},
-{"hash":94387394,"name":"o32sr.rscolorsilver","sourcebytes":[83,105,108,118,101,114],"value":"Silver"},
-{"hash":22708,"name":"o32sr.rscolorred","sourcebytes":[82,101,100],"value":"Red"},
-{"hash":340021,"name":"o32sr.rscolorlime","sourcebytes":[76,105,109,101],"value":"Lime"},
-{"hash":100414311,"name":"o32sr.rscoloryellow","sourcebytes":[89,101,108,108,111,119],"value":"Yellow"},
-{"hash":299957,"name":"o32sr.rscolorblue","sourcebytes":[66,108,117,101],"value":"Blue"},
-{"hash":230291889,"name":"o32sr.rscolorfuchsia","sourcebytes":[70,117,99,104,115,105,97],"value":"Fuchsia"},
-{"hash":297137,"name":"o32sr.rscoloraqua","sourcebytes":[65,113,117,97],"value":"Aqua"},
-{"hash":6156453,"name":"o32sr.rscolorwhite","sourcebytes":[87,104,105,116,101],"value":"White"},
-{"hash":258066265,"name":"o32sr.rscolorlightgray","sourcebytes":[76,105,103,104,116,32,71,114,97,121],"value":"Light Gray"},
-{"hash":195515273,"name":"o32sr.rscolormediumgray","sourcebytes":[77,101,100,105,117,109,32,71,114,97,121],"value":"Medium Gray"},
-{"hash":148152841,"name":"o32sr.rscolordarkgray","sourcebytes":[68,97,114,107,32,71,114,97,121],"value":"Dark Gray"},
-{"hash":186314622,"name":"o32sr.rscolormoneygreen","sourcebytes":[77,111,110,101,121,32,71,114,101,101,110],"value":"Money Green"},
-{"hash":45389333,"name":"o32sr.rscolorskyblue","sourcebytes":[83,107,121,32,66,108,117,101],"value":"Sky Blue"},
-{"hash":4885373,"name":"o32sr.rscolorcream","sourcebytes":[67,114,101,97,109],"value":"Cream"},
-{"hash":110646853,"name":"o32sr.ccnonestr","sourcebytes":[99,99,78,111,110,101],"value":"ccNone"},
-{"hash":110593947,"name":"o32sr.ccbackstr","sourcebytes":[99,99,66,97,99,107],"value":"ccBack"},
-{"hash":154279605,"name":"o32sr.ccbotofpagestr","sourcebytes":[99,99,66,111,116,79,102,80,97,103,101],"value":"ccBotOfPage"},
-{"hash":174982732,"name":"o32sr.ccbotrightcellstr","sourcebytes":[99,99,66,111,116,82,105,103,104,116,67,101,108,108],"value":"ccBotRightCell"},
-{"hash":185592085,"name":"o32sr.cccompletedatestr","sourcebytes":[99,99,67,111,109,112,108,101,116,101,68,97,116,101],"value":"ccCompleteDate"},
-{"hash":185397125,"name":"o32sr.cccompletetimestr","sourcebytes":[99,99,67,111,109,112,108,101,116,101,84,105,109,101],"value":"ccCompleteTime"},
-{"hash":110601849,"name":"o32sr.cccopystr","sourcebytes":[99,99,67,111,112,121],"value":"ccCopy"},
-{"hash":194382114,"name":"o32sr.ccctrlcharstr","sourcebytes":[99,99,67,116,114,108,67,104,97,114],"value":"ccCtrlChar"},
-{"hash":6912708,"name":"o32sr.cccutstr","sourcebytes":[99,99,67,117,116],"value":"ccCut"},
-{"hash":6912691,"name":"o32sr.ccdecstr","sourcebytes":[99,99,68,101,99],"value":"ccDec"},
-{"hash":6912700,"name":"o32sr.ccdelstr","sourcebytes":[99,99,68,101,108],"value":"ccDel"},
-{"hash":128716748,"name":"o32sr.ccdelbolstr","sourcebytes":[99,99,68,101,108,66,111,108],"value":"ccDelBol"},
-{"hash":128716492,"name":"o32sr.ccdeleolstr","sourcebytes":[99,99,68,101,108,69,111,108],"value":"ccDelEol"},
-{"hash":180438837,"name":"o32sr.ccdellinestr","sourcebytes":[99,99,68,101,108,76,105,110,101],"value":"ccDelLine"},
-{"hash":180473844,"name":"o32sr.ccdelwordstr","sourcebytes":[99,99,68,101,108,87,111,114,100],"value":"ccDelWord"},
-{"hash":110606046,"name":"o32sr.ccdownstr","sourcebytes":[99,99,68,111,119,110],"value":"ccDown"},
-{"hash":6913092,"name":"o32sr.ccendstr","sourcebytes":[99,99,69,110,100],"value":"ccEnd"},
-{"hash":249526654,"name":"o32sr.ccextenddownstr","sourcebytes":[99,99,69,120,116,101,110,100,68,111,119,110],"value":"ccExtendDown"},
-{"hash":183367860,"name":"o32sr.ccextendendstr","sourcebytes":[99,99,69,120,116,101,110,100,69,110,100],"value":"ccExtendEnd"},
-{"hash":249510805,"name":"o32sr.ccextendhomestr","sourcebytes":[99,99,69,120,116,101,110,100,72,111,109,101],"value":"ccExtendHome"},
-{"hash":249619572,"name":"o32sr.ccextendleftstr","sourcebytes":[99,99,69,120,116,101,110,100,76,101,102,116],"value":"ccExtendLeft"},
-{"hash":249472014,"name":"o32sr.ccextendpgdnstr","sourcebytes":[99,99,69,120,116,101,110,100,80,103,68,110],"value":"ccExtendPgDn"},
-{"hash":249471840,"name":"o32sr.ccextendpgupstr","sourcebytes":[99,99,69,120,116,101,110,100,80,103,85,112],"value":"ccExtendPgUp"},
-{"hash":233047828,"name":"o32sr.ccextendrightstr","sourcebytes":[99,99,69,120,116,101,110,100,82,105,103,104,116],"value":"ccExtendRight"},
-{"hash":263118336,"name":"o32sr.ccextendupstr","sourcebytes":[99,99,69,120,116,101,110,100,85,112],"value":"ccExtendUp"},
-{"hash":9762773,"name":"o32sr.ccextbotofpagestr","sourcebytes":[99,99,69,120,116,66,111,116,79,102,80,97,103,101],"value":"ccExtBotOfPage"},
-{"hash":241626181,"name":"o32sr.ccextfirstpagestr","sourcebytes":[99,99,69,120,116,70,105,114,115,116,80,97,103,101],"value":"ccExtFirstPage"},
-{"hash":30776981,"name":"o32sr.ccextlastpagestr","sourcebytes":[99,99,69,120,116,76,97,115,116,80,97,103,101],"value":"ccExtLastPage"},
-{"hash":76872229,"name":"o32sr.ccexttopofpagestr","sourcebytes":[99,99,69,120,116,84,111,112,79,102,80,97,103,101],"value":"ccExtTopOfPage"},
-{"hash":267768340,"name":"o32sr.ccextwordleftstr","sourcebytes":[99,99,69,120,116,87,111,114,100,76,101,102,116],"value":"ccExtWordLeft"},
-{"hash":257384708,"name":"o32sr.ccextwordrightstr","sourcebytes":[99,99,69,120,116,87,111,114,100,82,105,103,104,116],"value":"ccExtWordRight"},
-{"hash":163584725,"name":"o32sr.ccfirstpagestr","sourcebytes":[99,99,70,105,114,115,116,80,97,103,101],"value":"ccFirstPage"},
-{"hash":183990064,"name":"o32sr.ccgotomarker0str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,48],"value":"ccGotoMarker0"},
-{"hash":183990065,"name":"o32sr.ccgotomarker1str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,49],"value":"ccGotoMarker1"},
-{"hash":183990066,"name":"o32sr.ccgotomarker2str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,50],"value":"ccGotoMarker2"},
-{"hash":183990067,"name":"o32sr.ccgotomarker3str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,51],"value":"ccGotoMarker3"},
-{"hash":183990068,"name":"o32sr.ccgotomarker4str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,52],"value":"ccGotoMarker4"},
-{"hash":183990069,"name":"o32sr.ccgotomarker5str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,53],"value":"ccGotoMarker5"},
-{"hash":183990070,"name":"o32sr.ccgotomarker6str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,54],"value":"ccGotoMarker6"},
-{"hash":183990071,"name":"o32sr.ccgotomarker7str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,55],"value":"ccGotoMarker7"},
-{"hash":183990072,"name":"o32sr.ccgotomarker8str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,56],"value":"ccGotoMarker8"},
-{"hash":183990073,"name":"o32sr.ccgotomarker9str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,57],"value":"ccGotoMarker9"},
-{"hash":110622261,"name":"o32sr.cchomestr","sourcebytes":[99,99,72,111,109,101],"value":"ccHome"},
-{"hash":6914115,"name":"o32sr.ccincstr","sourcebytes":[99,99,73,110,99],"value":"ccInc"},
-{"hash":6914131,"name":"o32sr.ccinsstr","sourcebytes":[99,99,73,110,115],"value":"ccIns"},
-{"hash":145752053,"name":"o32sr.cclastpagestr","sourcebytes":[99,99,76,97,115,116,80,97,103,101],"value":"ccLastPage"},
-{"hash":110635988,"name":"o32sr.ccleftstr","sourcebytes":[99,99,76,101,102,116],"value":"ccLeft"},
-{"hash":80496581,"name":"o32sr.ccnewlinestr","sourcebytes":[99,99,78,101,119,76,105,110,101],"value":"ccNewLine"},
-{"hash":218103701,"name":"o32sr.ccnextpagestr","sourcebytes":[99,99,78,101,120,116,80,97,103,101],"value":"ccNextPage"},
-{"hash":132166580,"name":"o32sr.ccpageleftstr","sourcebytes":[99,99,80,97,103,101,76,101,102,116],"value":"ccPageLeft"},
-{"hash":230783876,"name":"o32sr.ccpagerightstr","sourcebytes":[99,99,80,97,103,101,82,105,103,104,116],"value":"ccPageRight"},
-{"hash":159812293,"name":"o32sr.ccpastestr","sourcebytes":[99,99,80,97,115,116,101],"value":"ccPaste"},
-{"hash":147718053,"name":"o32sr.ccprevpagestr","sourcebytes":[99,99,80,114,101,118,80,97,103,101],"value":"ccPrevPage"},
-{"hash":110660527,"name":"o32sr.ccredostr","sourcebytes":[99,99,82,101,100,111],"value":"ccRedo"},
-{"hash":147513093,"name":"o32sr.ccrestorestr","sourcebytes":[99,99,82,101,115,116,111,114,101],"value":"ccRestore"},
-{"hash":159972756,"name":"o32sr.ccrightstr","sourcebytes":[99,99,82,105,103,104,116],"value":"ccRight"},
-{"hash":80235598,"name":"o32sr.ccscrolldownstr","sourcebytes":[99,99,83,99,114,111,108,108,68,111,119,110],"value":"ccScrollDown"},
-{"hash":177523024,"name":"o32sr.ccscrollupstr","sourcebytes":[99,99,83,99,114,111,108,108,85,112],"value":"ccScrollUp"},
-{"hash":85033152,"name":"o32sr.ccsetmarker0str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,48],"value":"ccSetMarker0"},
-{"hash":85033153,"name":"o32sr.ccsetmarker1str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,49],"value":"ccSetMarker1"},
-{"hash":85033154,"name":"o32sr.ccsetmarker2str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,50],"value":"ccSetMarker2"},
-{"hash":85033155,"name":"o32sr.ccsetmarker3str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,51],"value":"ccSetMarker3"},
-{"hash":85033156,"name":"o32sr.ccsetmarker4str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,52],"value":"ccSetMarker4"},
-{"hash":85033157,"name":"o32sr.ccsetmarker5str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,53],"value":"ccSetMarker5"},
-{"hash":85033158,"name":"o32sr.ccsetmarker6str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,54],"value":"ccSetMarker6"},
-{"hash":85033159,"name":"o32sr.ccsetmarker7str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,55],"value":"ccSetMarker7"},
-{"hash":85033160,"name":"o32sr.ccsetmarker8str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,56],"value":"ccSetMarker8"},
-{"hash":85033161,"name":"o32sr.ccsetmarker9str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,57],"value":"ccSetMarker9"},
-{"hash":6916722,"name":"o32sr.cctabstr","sourcebytes":[99,99,84,97,98],"value":"ccTab"},
-{"hash":155201908,"name":"o32sr.cctableeditstr","sourcebytes":[99,99,84,97,98,108,101,69,100,105,116],"value":"ccTableEdit"},
-{"hash":39059308,"name":"o32sr.cctopleftcellstr","sourcebytes":[99,99,84,111,112,76,101,102,116,67,101,108,108],"value":"ccTopLeftCell"},
-{"hash":87223477,"name":"o32sr.cctopofpagestr","sourcebytes":[99,99,84,111,112,79,102,80,97,103,101],"value":"ccTopOfPage"},
-{"hash":110675119,"name":"o32sr.ccundostr","sourcebytes":[99,99,85,110,100,111],"value":"ccUndo"},
-{"hash":432320,"name":"o32sr.ccupstr","sourcebytes":[99,99,85,112],"value":"ccUp"},
-{"hash":110080820,"name":"o32sr.ccwordleftstr","sourcebytes":[99,99,87,111,114,100,76,101,102,116],"value":"ccWordLeft"},
-{"hash":150041492,"name":"o32sr.ccwordrightstr","sourcebytes":[99,99,87,111,114,100,82,105,103,104,116],"value":"ccWordRight"},
-{"hash":95129671,"name":"o32sr.stringstr","sourcebytes":[83,116,114,105,110,103],"value":"String"},
-{"hash":302722,"name":"o32sr.charstr","sourcebytes":[67,104,97,114],"value":"Char"},
-{"hash":157690686,"name":"o32sr.booleanstr","sourcebytes":[66,111,111,108,101,97,110],"value":"Boolean"},
-{"hash":6277199,"name":"o32sr.yesnostr","sourcebytes":[89,101,115,78,111],"value":"YesNo"},
-{"hash":56934404,"name":"o32sr.longintstr","sourcebytes":[76,111,110,103,73,110,116],"value":"LongInt"},
-{"hash":386692,"name":"o32sr.wordstr","sourcebytes":[87,111,114,100],"value":"Word"},
-{"hash":58919924,"name":"o32sr.smallintstr","sourcebytes":[83,109,97,108,108,73,110,116],"value":"SmallInt"},
-{"hash":303269,"name":"o32sr.bytestr","sourcebytes":[66,121,116,101],"value":"Byte"},
-{"hash":258575300,"name":"o32sr.shortintstr","sourcebytes":[83,104,111,114,116,73,110,116],"value":"ShortInt"},
-{"hash":363388,"name":"o32sr.realstr","sourcebytes":[82,101,97,108],"value":"Real"},
-{"hash":262950516,"name":"o32sr.extendedstr","sourcebytes":[69,120,116,101,110,100,101,100],"value":"Extended"},
-{"hash":79083813,"name":"o32sr.doublestr","sourcebytes":[68,111,117,98,108,101],"value":"Double"},
-{"hash":94391845,"name":"o32sr.singlestr","sourcebytes":[83,105,110,103,108,101],"value":"Single"},
-{"hash":304704,"name":"o32sr.compstr","sourcebytes":[67,111,109,112],"value":"Comp"},
-{"hash":305317,"name":"o32sr.datestr","sourcebytes":[68,97,116,101],"value":"Date"},
-{"hash":372789,"name":"o32sr.timestr","sourcebytes":[84,105,109,101],"value":"Time"},
-{"hash":14246210,"name":"o32sr.charmask1str","sourcebytes":[88,32,32,97,110,121,32,99,104,97,114,97,99,116,101,114],"value":"X any character"},
-{"hash":176123385,"name":"o32sr.charmask2str","sourcebytes":[33,32,32,97,110,121,32,99,104,97,114,32,40,117,112,112,101,114,41],"value":"! any char (upper)"},
-{"hash":128900505,"name":"o32sr.charmask3str","sourcebytes":[76,32,32,97,110,121,32,99,104,97,114,32,40,108,111,119,101,114,41],"value":"L any char (lower)"},
-{"hash":60353161,"name":"o32sr.charmask4str","sourcebytes":[120,32,32,97,110,121,32,99,104,97,114,32,40,109,105,120,101,100,41],"value":"x any char (mixed)"},
-{"hash":171931113,"name":"o32sr.charmask5str","sourcebytes":[97,32,32,97,108,112,104,97,115,32,111,110,108,121],"value":"a alphas only"},
-{"hash":216715241,"name":"o32sr.charmask6str","sourcebytes":[65,32,32,97,108,112,104,97,115,32,40,117,112,112,101,114,41],"value":"A alphas (upper)"},
-{"hash":238452713,"name":"o32sr.charmask7str","sourcebytes":[108,32,32,97,108,112,104,97,115,32,40,108,111,119,101,114,41],"value":"l alphas (lower)"},
-{"hash":62010121,"name":"o32sr.charmask8str","sourcebytes":[57,32,32,48,45,57],"value":"9 0-9"},
-{"hash":53531917,"name":"o32sr.charmask9str","sourcebytes":[105,32,32,48,45,57,44,32,45],"value":"i 0-9, -"},
-{"hash":162581806,"name":"o32sr.charmask10str","sourcebytes":[35,32,32,48,45,57,44,32,45,44,32,46],"value":"# 0-9, -, ."},
-{"hash":80873294,"name":"o32sr.charmask11str","sourcebytes":[69,32,32,48,45,57,44,32,69,44,32,45,44,32,46],"value":"E 0-9, E, -, ."},
-{"hash":148737417,"name":"o32sr.charmask12str","sourcebytes":[75,32,32,48,45,57,44,32,65,45,70,32,40,104,101,120,41],"value":"K 0-9, A-F (hex)"},
-{"hash":225029081,"name":"o32sr.charmask14str","sourcebytes":[79,32,32,48,45,55,32,40,111,99,116,97,108,41],"value":"O 0-7 (octal)"},
-{"hash":169998697,"name":"o32sr.charmask15str","sourcebytes":[98,32,32,48,44,32,49,32,40,98,105,110,97,114,121,41],"value":"b 0, 1 (binary)"},
-{"hash":149356809,"name":"o32sr.charmask16str","sourcebytes":[66,32,32,84,32,111,114,32,70,32,40,117,112,112,101,114,41],"value":"B T or F (upper)"},
-{"hash":150477273,"name":"o32sr.charmask17str","sourcebytes":[89,32,32,89,32,111,114,32,78,32,40,117,112,112,101,114,41],"value":"Y Y or N (upper)"},
-{"hash":97122065,"name":"o32sr.charmask18str","sourcebytes":[49,32,32,85,115,101,114,32,49],"value":"1 User 1"},
-{"hash":97120274,"name":"o32sr.charmask19str","sourcebytes":[50,32,32,85,115,101,114,32,50],"value":"2 User 2"},
-{"hash":97120531,"name":"o32sr.charmask20str","sourcebytes":[51,32,32,85,115,101,114,32,51],"value":"3 User 3"},
-{"hash":97120788,"name":"o32sr.charmask21str","sourcebytes":[52,32,32,85,115,101,114,32,52],"value":"4 User 4"},
-{"hash":97121045,"name":"o32sr.charmask22str","sourcebytes":[53,32,32,85,115,101,114,32,53],"value":"5 User 5"},
-{"hash":97123350,"name":"o32sr.charmask23str","sourcebytes":[54,32,32,85,115,101,114,32,54],"value":"6 User 6"},
-{"hash":97123607,"name":"o32sr.charmask24str","sourcebytes":[55,32,32,85,115,101,114,32,55],"value":"7 User 7"},
-{"hash":97123864,"name":"o32sr.charmask25str","sourcebytes":[56,32,32,85,115,101,114,32,56],"value":"8 User 8"},
-{"hash":25870412,"name":"o32sr.fieldmask1str","sourcebytes":[36,35,35,44,35,35,35,46,35,35,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,97,110,100,32,112,101,114,105,111,100,32,85,115,101,115,32,102,108,111,97,116,105,110,103,32,99,117,114,114,101,110,99,121,32,115,121,109,98,111,108],"value":"$##,###.## Allows entry of 0 through 9, space, minus, and period Uses floating currency symbol"},
-{"hash":192143781,"name":"o32sr.fieldmask2str","sourcebytes":[57,57,57,57,57,57,57,57,57,57,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,97,110,100,32,115,112,97,99,101],"value":"9999999999 Allows entry of 0 through 9, and space"},
-{"hash":150217363,"name":"o32sr.fieldmask3str","sourcebytes":[105,105,105,105,105,105,105,105,105,105,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,97,110,100,32,109,105,110,117,115],"value":"iiiiiiiiii Allows entry of 0 through 9, space, and minus"},
-{"hash":159131796,"name":"o32sr.fieldmask4str","sourcebytes":[105,105,44,105,105,105,44,105,105,105,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,97,110,100,32,109,105,110,117,115,32,68,105,115,112,108,97,121,115,32,110,117,109,98,101,114,32,115,101,112,97,114,97,116,111,114,115,32,97,115,32,110,101,101,100,101,100],"value":"ii,iii,iii Allows entry of 0 through 9, space, and minus Displays number separators as needed"},
-{"hash":187563852,"name":"o32sr.fieldmask5str","sourcebytes":[36,105,105,105,105,105,105,105,105,105,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,97,110,100,32,109,105,110,117,115,32,85,115,101,115,32,102,108,111,97,116,105,110,103,32,99,117,114,114,101,110,99,121,32,115,121,109,98,111,108],"value":"$iiiiiiiii Allows entry of 0 through 9, space, and minus Uses floating currency symbol"},
-{"hash":91771796,"name":"o32sr.fieldmask6str","sourcebytes":[35,35,35,35,35,35,35,35,35,35,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,97,110,100,32,112,101,114,105,111,100],"value":"########## Allows entry of 0 through 9, space, minus, and period"},
-{"hash":150058862,"name":"o32sr.fieldmask7str","sourcebytes":[35,35,35,35,35,35,35,46,35,35,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,97,110,100,32,112,101,114,105,111,100,32,70,105,120,101,100,32,100,101,99,105,109,97,108,32,112,111,115,105,116,105,111,110],"value":"#######.## Allows entry of 0 through 9, space, minus, and period Fixed decimal position"},
-{"hash":118082020,"name":"o32sr.fieldmask8str","sourcebytes":[35,35,35,44,35,35,35,46,35,35,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,97,110,100,32,112,101,114,105,111,100,32,68,105,115,112,108,97,121,115,32,110,117,109,98,101,114,32,115,101,112,97,114,97,116,111,114,115,32,97,115,32,110,101,101,100,101,100],"value":"###,###.## Allows entry of 0 through 9, space, minus, and period Displays number separators as needed"},
-{"hash":203254956,"name":"o32sr.fieldmask9str","sourcebytes":[36,35,35,35,35,35,35,46,35,35,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,97,110,100,32,112,101,114,105,111,100,32,70,105,120,101,100,32,100,101,99,105,109,97,108,32,112,111,115,105,116,105,111,110,32,85,115,101,115,32,102,108,111,97,116,105,110,103,32,99,117,114,114,101,110,99,121,32,115,121,109,98,111,108],"value":"$######.## Allows entry of 0 through 9, space, minus, and period Fixed decimal position Uses floating currency symbol"},
-{"hash":233619849,"name":"o32sr.fieldmask10str","sourcebytes":[35,35,35,35,35,35,35,35,35,35,112,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,97,110,100,32,112,101,114,105,111,100,32,78,101,103,97,116,105,118,101,32,97,109,111,117,110,116,115,32,117,115,101,32,40,41],"value":"##########p Allows entry of 0 through 9, space, minus, and period Negative amounts use ()"},
-{"hash":23482388,"name":"o32sr.fieldmask11str","sourcebytes":[35,35,35,44,35,35,35,46,35,35,67,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,97,110,100,32,112,101,114,105,111,100,32,67,117,114,114,101,110,99,121,32,115,121,109,98,111,108,32,97,116,32,114,105,103,104,116],"value":"###,###.##C Allows entry of 0 through 9, space, minus, and period Currency symbol at right"},
-{"hash":174256005,"name":"o32sr.fieldmask12str","sourcebytes":[75,75,75,75,75,75,75,75,32,32,32,32,32,32,32,32,32,32,32,32,72,101,120,97,100,101,99,105,109,97,108,32,40,69,52,52,48,49,70,51,69,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,97,110,100,32,65,32,116,104,114,111,117,103,104,32,70,32,70,111,114,99,101,32,117,112,112,101,114,32,99,97,115,101],"value":"KKKKKKKK Hexadecimal (E4401F3E) Allows entry of 0 through 9 and A through F Force upper case"},
-{"hash":160543589,"name":"o32sr.fieldmask13str","sourcebytes":[75,75,75,75,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,72,101,120,97,100,101,99,105,109,97,108,32,40,49,70,51,69,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,97,110,100,32,65,32,116,104,114,111,117,103,104,32,70,32,70,111,114,99,101,32,117,112,112,101,114,32,99,97,115,101],"value":"KKKK Hexadecimal (1F3E) Allows entry of 0 through 9 and A through F Force upper case"},
-{"hash":54097189,"name":"o32sr.fieldmask14str","sourcebytes":[75,75,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,72,101,120,97,100,101,99,105,109,97,108,32,40,51,69,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,97,110,100,32,65,32,116,104,114,111,117,103,104,32,70,32,70,111,114,99,101,32,117,112,112,101,114,32,99,97,115,101],"value":"KK Hexadecimal (3E) Allows entry of 0 through 9 and A through F Force upper case"},
-{"hash":118534928,"name":"o32sr.fieldmask15str","sourcebytes":[79,79,79,79,79,79,79,79,32,32,32,32,32,32,32,32,32,32,32,32,79,99,116,97,108,32,40,52,53,49,51,53,54,55,55,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,55,32],"value":"OOOOOOOO Octal (45135677) Allows entry of 0 through 7 "},
-{"hash":157956416,"name":"o32sr.fieldmask16str","sourcebytes":[79,79,79,79,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,79,99,116,97,108,32,40,53,54,55,55,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,55,32],"value":"OOOO Octal (5677) Allows entry of 0 through 7 "},
-{"hash":214007281,"name":"o32sr.fieldmask17str","sourcebytes":[98,98,98,98,98,98,98,98,98,98,98,98,98,98,98,98,32,32,32,32,66,105,110,97,114,121,32,40,48,49,48,49,48,48,49,48,49,48,48,49,48,49,48,48,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,97,110,100,32,49],"value":"bbbbbbbbbbbbbbbb Binary (0101001010010100) Allows entry of 0 and 1"},
-{"hash":77656481,"name":"o32sr.fieldmask18str","sourcebytes":[98,98,98,98,98,98,98,98,32,32,32,32,32,32,32,32,32,32,32,32,66,105,110,97,114,121,32,40,49,48,48,49,48,49,48,48,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,97,110,100,32,49],"value":"bbbbbbbb Binary (10010100) Allows entry of 0 and 1"},
-{"hash":6873412,"name":"o32sr.fieldmask19str","sourcebytes":[88,88,88,88,88,88,88,88,88,88,32,32,32,32,32,32,32,32,32,32,65,110,121,32,99,104,97,114,97,99,116,101,114,32,99,97,110,32,98,101,32,101,110,116,101,114,101,100],"value":"XXXXXXXXXX Any character can be entered"},
-{"hash":43546997,"name":"o32sr.fieldmask20str","sourcebytes":[33,33,33,33,33,33,33,33,33,33,32,32,32,32,32,32,32,32,32,32,65,110,121,32,99,104,97,114,97,99,116,101,114,32,99,97,110,32,98,101,32,101,110,116,101,114,101,100,32,65,108,112,104,97,98,101,116,105,99,32,99,104,97,114,97,99,116,101,114,115,32,97,114,101,32,102,111,114,99,101,100,32,116,111,32,117,112,112,101,114,32,99,97,115,101],"value":"!!!!!!!!!! Any character can be entered Alphabetic characters are forced to upper case"},
-{"hash":216754981,"name":"o32sr.fieldmask21str","sourcebytes":[76,76,76,76,76,76,76,76,76,76,32,32,32,32,32,32,32,32,32,32,65,110,121,32,99,104,97,114,97,99,116,101,114,32,99,97,110,32,98,101,32,101,110,116,101,114,101,100,32,65,108,112,104,97,98,101,116,105,99,32,99,104,97,114,97,99,116,101,114,115,32,97,114,101,32,102,111,114,99,101,100,32,116,111,32,108,111,119,101,114,32,99,97,115,101],"value":"LLLLLLLLLL Any character can be entered Alphabetic characters are forced to lower case"},
-{"hash":72846341,"name":"o32sr.fieldmask22str","sourcebytes":[120,120,120,120,120,120,120,120,120,120,32,32,32,32,32,32,32,32,32,32,65,110,121,32,99,104,97,114,97,99,116,101,114,32,99,97,110,32,98,101,32,101,110,116,101,114,101,100,32,85,115,101,115,32,109,105,120,101,100,32,99,97,115,101],"value":"xxxxxxxxxx Any character can be entered Uses mixed case"},
-{"hash":180843617,"name":"o32sr.fieldmask23str","sourcebytes":[97,97,97,97,97,97,97,97,97,97,32,32,32,32,32,32,32,32,32,32,65,108,112,104,97,98,101,116,105,99,32,99,104,97,114,97,99,116,101,114,115,32,112,108,117,115,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,112,101,114,105,111,100,44,32,97,110,100,32,99,111,109,109,97],"value":"aaaaaaaaaa Alphabetic characters plus space, minus, period, and comma"},
-{"hash":259223541,"name":"o32sr.fieldmask24str","sourcebytes":[65,65,65,65,65,65,65,65,65,65,32,32,32,32,32,32,32,32,32,32,65,108,112,104,97,98,101,116,105,99,32,99,104,97,114,97,99,116,101,114,115,32,112,108,117,115,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,112,101,114,105,111,100,44,32,97,110,100,32,99,111,109,109,97,32,65,108,112,104,97,98,101,116,105,99,32,99,104,97,114,97,99,116,101,114,115,32,97,114,101,32,102,111,114,99,101,100,32,116,111,32,117,112,112,101,114,32,99,97,115,101],"value":"AAAAAAAAAA Alphabetic characters plus space, minus, period, and comma Alphabetic characters are forced to upper case"},
-{"hash":155046869,"name":"o32sr.fieldmask25str","sourcebytes":[108,108,108,108,108,108,108,108,108,108,32,32,32,32,32,32,32,32,32,32,65,108,112,104,97,98,101,116,105,99,32,99,104,97,114,97,99,116,101,114,115,32,112,108,117,115,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,112,101,114,105,111,100,44,32,97,110,100,32,99,111,109,109,97,32,65,108,112,104,97,98,101,116,105,99,32,99,104,97,114,97,99,116,101,114,115,32,97,114,101,32,102,111,114,99,101,100,32,116,111,32,108,111,119,101,114,32,99,97,115,101],"value":"llllllllll Alphabetic characters plus space, minus, period, and comma Alphabetic characters are forced to lower case"},
-{"hash":178904805,"name":"o32sr.fieldmask26str","sourcebytes":[40,57,57,57,41,32,57,57,57,45,57,57,57,57,32,32,32,32,32,32,80,104,111,110,101,32,110,117,109,98,101,114,32,109,97,115,107,32,65,108,108,111,119,115,32,48,32,116,104,114,111,117,103,104,32,57,32,97,110,100,32,115,112,97,99,101],"value":"(999) 999-9999 Phone number mask Allows 0 through 9 and space"},
-{"hash":62017877,"name":"o32sr.fieldmask27str","sourcebytes":[57,57,57,45,57,57,57,45,57,57,57,57,32,32,32,32,32,32,32,32,80,104,111,110,101,32,110,117,109,98,101,114,32,109,97,115,107,32,65,108,108,111,119,115,32,48,32,116,104,114,111,117,103,104,32,57,32,97,110,100,32,115,112,97,99,101],"value":"999-999-9999 Phone number mask Allows 0 through 9 and space"},
-{"hash":107877989,"name":"o32sr.fieldmask28str","sourcebytes":[57,57,57,57,57,45,57,57,57,57,32,32,32,32,32,32,32,32,32,32,85,83,32,90,105,112,32,67,111,100,101,32,109,97,115,107,32,65,108,108,111,119,115,32,48,32,116,104,114,111,117,103,104,32,57,32,97,110,100,32,115,112,97,99,101],"value":"99999-9999 US Zip Code mask Allows 0 through 9 and space"},
-{"hash":159165621,"name":"o32sr.fieldmask29str","sourcebytes":[66,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,66,111,111,108,101,97,110,32,109,97,115,107,32,65,108,108,111,119,115,32,84,44,32,116,44,32,70,44,32,102,32,70,111,114,99,101,115,32,105,110,112,117,116,32,116,111,32,117,112,112,101,114,32,99,97,115,101],"value":"B Boolean mask Allows T, t, F, f Forces input to upper case"},
-{"hash":226688133,"name":"o32sr.fieldmask30str","sourcebytes":[89,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,66,111,111,108,101,97,110,32,109,97,115,107,32,65,108,108,111,119,115,32,89,44,32,121,44,32,78,44,32,110,32,70,111,114,99,101,115,32,105,110,112,117,116,32,116,111,32,117,112,112,101,114,32,99,97,115,101],"value":"Y Boolean mask Allows Y, y, N, n Forces input to upper case"},
-{"hash":239529939,"name":"o32sr.fieldmask31str","sourcebytes":[109,109,47,100,100,47,121,121,32,32,32,32,32,32,32,32,32,32,32,32,68,97,116,101,32,109,97,115,107,32,40,48,49,47,48,53,47,57,54,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,77,111,110,116,104,32,97,110,100,32,68,97,121,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,122,101,114,111,115],"value":"mm\/dd\/yy Date mask (01\/05\/96) Allows entry of 0 through 9 plus space Month and Day are padded with zeros"},
-{"hash":265314611,"name":"o32sr.fieldmask32str","sourcebytes":[109,109,47,100,100,47,121,121,121,121,32,32,32,32,32,32,32,32,32,32,68,97,116,101,32,109,97,115,107,32,40,48,49,47,48,53,47,49,57,57,54,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,77,111,110,116,104,32,97,110,100,32,68,97,121,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,122,101,114,111,115],"value":"mm\/dd\/yyyy Date mask (01\/05\/1996) Allows entry of 0 through 9 plus space Month and Day are padded with zeros"},
-{"hash":140332467,"name":"o32sr.fieldmask33str","sourcebytes":[100,100,32,110,110,110,32,121,121,121,121,32,32,32,32,32,32,32,32,32,68,97,116,101,32,109,97,115,107,32,40,48,53,32,74,97,110,32,49,57,57,54,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,68,97,121,32,105,115,32,112,97,100,100,101,100,32,119,105,116,104,32,122,101,114,111,115],"value":"dd nnn yyyy Date mask (05 Jan 1996) Allows entry of 0 through 9 plus space Day is padded with zeros"},
-{"hash":60758483,"name":"o32sr.fieldmask34str","sourcebytes":[77,77,47,68,68,47,121,121,32,32,32,32,32,32,32,32,32,32,32,32,68,97,116,101,32,109,97,115,107,32,40,32,49,47,32,53,47,57,54,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,77,111,110,116,104,32,97,110,100,32,68,97,121,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,115,112,97,99,101,115],"value":"MM\/DD\/yy Date mask ( 1\/ 5\/96) Allows entry of 0 through 9 plus space Month and Day are padded with spaces"},
-{"hash":129420707,"name":"o32sr.fieldmask35str","sourcebytes":[77,77,47,68,68,47,121,121,121,121,32,32,32,32,32,32,32,32,32,32,68,97,116,101,32,109,97,115,107,32,40,32,49,47,32,53,47,49,57,57,54,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,77,111,110,116,104,32,97,110,100,32,68,97,121,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,115,112,97,99,101,115],"value":"MM\/DD\/yyyy Date mask ( 1\/ 5\/1996) Allows entry of 0 through 9 plus space Month and Day are padded with spaces"},
-{"hash":162411587,"name":"o32sr.fieldmask36str","sourcebytes":[68,68,32,110,110,110,32,121,121,121,121,32,32,32,32,32,32,32,32,32,68,97,116,101,32,109,97,115,107,32,40,32,53,32,74,97,110,32,49,57,57,54,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,68,97,121,32,105,115,32,112,97,100,100,101,100,32,119,105,116,104,32,115,112,97,99,101,115],"value":"DD nnn yyyy Date mask ( 5 Jan 1996) Allows entry of 0 through 9 plus space Day is padded with spaces"},
-{"hash":115637257,"name":"o32sr.fieldmask37str","sourcebytes":[104,104,58,109,109,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,84,105,109,101,32,109,97,115,107,32,40,48,51,58,50,53,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,72,111,117,114,115,32,97,110,100,32,109,105,110,117,116,101,115,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,122,101,114,111,115,32,40,50,52,32,104,111,117,114,32,99,108,111,99,107,41],"value":"hh:mm Time mask (03:25) Allows entry of 0 through 9 plus space Hours and minutes are padded with zeros (24 hour clock)"},
-{"hash":110050003,"name":"o32sr.fieldmask38str","sourcebytes":[104,104,58,109,109,32,116,116,32,32,32,32,32,32,32,32,32,32,32,32,84,105,109,101,32,109,97,115,107,32,40,48,51,58,50,53,32,112,109,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,72,111,117,114,115,32,97,110,100,32,109,105,110,117,116,101,115,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,122,101,114,111,115],"value":"hh:mm tt Time mask (03:25 pm) Allows entry of 0 through 9 plus space Hours and minutes are padded with zeros"},
-{"hash":119359011,"name":"o32sr.fieldmask39str","sourcebytes":[104,104,58,109,109,58,115,115,32,32,32,32,32,32,32,32,32,32,32,32,84,105,109,101,32,109,97,115,107,32,40,48,51,58,50,53,58,48,55,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,72,111,117,114,115,44,32,109,105,110,117,116,101,115,44,32,97,110,100,32,115,101,99,111,110,100,115,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,122,101,114,111,115],"value":"hh:mm:ss Time mask (03:25:07) Allows entry of 0 through 9 plus space Hours, minutes, and seconds are padded with zeros"},
-{"hash":151520073,"name":"o32sr.fieldmask40str","sourcebytes":[72,72,58,77,77,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,84,105,109,101,32,109,97,115,107,32,40,32,51,58,50,53,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,72,111,117,114,115,32,97,110,100,32,109,105,110,117,116,101,115,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,115,112,97,99,101,115,32,40,50,52,32,104,111,117,114,32,99,108,111,99,107,41],"value":"HH:MM Time mask ( 3:25) Allows entry of 0 through 9 plus space Hours and minutes are padded with spaces (24 hour clock)"},
-{"hash":156598435,"name":"o32sr.fieldmask41str","sourcebytes":[72,72,58,77,77,32,116,116,32,32,32,32,32,32,32,32,32,32,32,32,84,105,109,101,32,109,97,115,107,32,40,32,51,58,50,53,32,112,109,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,72,111,117,114,115,32,97,110,100,32,109,105,110,117,116,101,115,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,115,112,97,99,101,115],"value":"HH:MM tt Time mask ( 3:25 pm) Allows entry of 0 through 9 plus space Hours and minutes are padded with spaces"},
-{"hash":105549971,"name":"o32sr.fieldmask42str","sourcebytes":[72,72,58,77,77,58,83,83,32,32,32,32,32,32,32,32,32,32,32,32,84,105,109,101,32,109,97,115,107,32,40,32,51,58,50,53,58,32,55,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,72,111,117,114,115,44,32,109,105,110,117,116,101,115,44,32,97,110,100,32,115,101,99,111,110,100,115,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,115,112,97,99,101,115],"value":"HH:MM:SS Time mask ( 3:25: 7) Allows entry of 0 through 9 plus space Hours, minutes, and seconds are padded with spaces"}
-]}
diff --git a/Source/3rdParty/Orpheus/units/x86_64-win64/o32sr.rsj b/Source/3rdParty/Orpheus/units/x86_64-win64/o32sr.rsj
deleted file mode 100644
index 4b00ea54..00000000
--- a/Source/3rdParty/Orpheus/units/x86_64-win64/o32sr.rsj
+++ /dev/null
@@ -1,377 +0,0 @@
-{"version":1,"strings":[
-{"hash":47539321,"name":"o32sr.rsnonestr","sourcebytes":[40,78,111,110,101,41],"value":"(None)"},
-{"hash":110676418,"name":"o32sr.rsccuser","sourcebytes":[99,99,85,115,101,114],"value":"ccUser"},
-{"hash":147440164,"name":"o32sr.rsccusernum","sourcebytes":[99,99,85,115,101,114,37,100],"value":"ccUser%d"},
-{"hash":23862543,"name":"o32sr.rsdeletetable","sourcebytes":[68,101,108,101,116,101,32,116,104,101,32,37,115,32,116,97,98,108,101,63],"value":"Delete the %s table?"},
-{"hash":47591701,"name":"o32sr.rsrenametable","sourcebytes":[82,101,110,97,109,101,32,84,97,98,108,101],"value":"Rename Table"},
-{"hash":62914634,"name":"o32sr.rsentertablename","sourcebytes":[69,110,116,101,114,32,110,101,119,32,116,97,98,108,101,32,110,97,109,101,32,102,111,114,32,37,115,58],"value":"Enter new table name for %s:"},
-{"hash":214597221,"name":"o32sr.rsnewtable","sourcebytes":[78,101,119,84,97,98,108,101],"value":"NewTable"},
-{"hash":180128884,"name":"o32sr.rsdefaulttablename","sourcebytes":[68,101,102,97,117,108,116],"value":"Default"},
-{"hash":109686626,"name":"o32sr.rswordstartablename","sourcebytes":[87,111,114,100,83,116,97,114],"value":"WordStar"},
-{"hash":321780,"name":"o32sr.rsgridtablename","sourcebytes":[71,114,105,100],"value":"Grid"},
-{"hash":86327753,"name":"o32sr.rsunknowntable","sourcebytes":[40,85,110,107,110,111,119,110,41],"value":"(Unknown)"},
-{"hash":184599794,"name":"o32sr.rsdefaultentryerrortext","sourcebytes":[69,110,116,114,121,32,69,114,114,111,114],"value":"Entry Error"},
-{"hash":44316689,"name":"o32sr.rsgotitemwarning","sourcebytes":[37,100,46,32,42,42,42,32,87,97,114,110,105,110,103,32,42,42,42,32,79,110,71,101,116,73,116,101,109,32,110,111,116,32,97,115,115,105,103,110,101,100,33],"value":"%d. *** Warning *** OnGetItem not assigned!"},
-{"hash":164121725,"name":"o32sr.rssamplelistitem","sourcebytes":[37,100,46,32,45,32,83,97,109,112,108,101,32,118,105,114,116,117,97,108,32,108,105,115,116,32,98,111,120,32,105,116,101,109],"value":"%d. - Sample virtual list box item"},
-{"hash":61396826,"name":"o32sr.rsalphastring","sourcebytes":[97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90],"value":"abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"},
-{"hash":1513,"name":"o32sr.rstalllowchars","sourcebytes":[87,121],"value":"Wy"},
-{"hash":180128884,"name":"o32sr.rsdefault","sourcebytes":[68,101,102,97,117,108,116],"value":"Default"},
-{"hash":89,"name":"o32sr.rsyes","sourcebytes":[89],"value":"Y"},
-{"hash":78,"name":"o32sr.rsno","sourcebytes":[78],"value":"N"},
-{"hash":84,"name":"o32sr.rstrue","sourcebytes":[84],"value":"T"},
-{"hash":70,"name":"o32sr.rsfalse","sourcebytes":[70],"value":"F"},
-{"hash":49589427,"name":"o32sr.rsdescending","sourcebytes":[32,45,32,68,101,115,99],"value":" - Desc"},
-{"hash":197701577,"name":"o32sr.rsdefaultindex","sourcebytes":[40,68,101,102,97,117,108,116,41],"value":"(Default)"},
-{"hash":86025029,"name":"o32sr.rsduplicatecommand","sourcebytes":[68,117,112,108,105,99,97,116,101,32,99,111,109,109,97,110,100,32,102,111,117,110,100,32,119,104,105,108,101,32,97,100,100,105,110,103,32,97,32,110,101,119,32,99,111,109,109,97,110,100,32,116,111,32,116,104,101,32,116,97,98,108,101],"value":"Duplicate command found while adding a new command to the table"},
-{"hash":189452597,"name":"o32sr.rstablenotfound","sourcebytes":[67,111,109,109,97,110,100,32,116,97,98,108,101,32,110,111,116,32,102,111,117,110,100,32,111,114,32,99,111,109,109,97,110,100,32,116,97,98,108,101,32,105,110,100,101,120,32,111,117,116,32,111,102,32,114,97,110,103,101],"value":"Command table not found or command table index out of range"},
-{"hash":73438661,"name":"o32sr.rsnotdoneyet","sourcebytes":[84,104,105,115,32,102,101,97,116,117,114,101,32,105,115,32,110,111,116,32,105,109,112,108,101,109,101,110,116,101,100,32,97,116,32,116,104,105,115,32,116,105,109,101],"value":"This feature is not implemented at this time"},
-{"hash":64194580,"name":"o32sr.rsnocontrollerassigned","sourcebytes":[78,111,32,67,111,110,116,114,111,108,108,101,114,32,97,115,115,105,103,110,101,100],"value":"No Controller assigned"},
-{"hash":35420549,"name":"o32sr.rscantcreatecommandtable","sourcebytes":[85,110,97,98,108,101,32,116,111,32,99,114,101,97,116,101,32,99,111,109,109,97,110,100,32,116,97,98,108,101],"value":"Unable to create command table"},
-{"hash":48081108,"name":"o32sr.rscantdelete","sourcebytes":[67,97,110,39,116,32,100,101,108,101,116,101,32,116,104,105,115,32,116,97,98,108,101,46,32,77,117,115,116,32,104,97,118,101,32,97,116,32,108,101,97,115,116,32,111,110,101,32,99,111,109,109,97,110,100,32,116,97,98,108,101,32,100,101,102,105,110,101,100],"value":"Can't delete this table. Must have at least one command table defined"},
-{"hash":20361444,"name":"o32sr.rsinvalidkeysequence","sourcebytes":[73,110,118,97,108,105,100,32,111,114,32,110,111,32,107,101,121,32,115,101,113,117,101,110,99,101,32,101,110,116,101,114,101,100],"value":"Invalid or no key sequence entered"},
-{"hash":242348867,"name":"o32sr.rsnotwordstarcommands","sourcebytes":[75,101,121,115,32,101,110,116,101,114,101,100,32,97,114,101,32,110,111,116,32,87,111,114,100,83,116,97,114,32,115,116,121,108,101,32,99,111,109,109,97,110,100,115],"value":"Keys entered are not WordStar style commands"},
-{"hash":240741204,"name":"o32sr.rsnocommandselected","sourcebytes":[78,111,32,99,111,109,109,97,110,100,32,115,101,108,101,99,116,101,100],"value":"No command selected"},
-{"hash":157959429,"name":"o32sr.rsduplicatekeysequence","sourcebytes":[68,117,112,108,105,99,97,116,101,32,107,101,121,32,115,101,113,117,101,110,99,101],"value":"Duplicate key sequence"},
-{"hash":973461,"name":"o32sr.rsrangeerror","sourcebytes":[86,97,108,117,101,32,105,115,32,110,111,116,32,119,105,116,104,105,110,32,114,101,113,117,105,114,101,100,32,114,97,110,103,101],"value":"Value is not within required range"},
-{"hash":206041701,"name":"o32sr.rsinvalidnumber","sourcebytes":[86,97,108,117,101,32,105,115,32,110,111,116,32,118,97,108,105,100,32,102,111,114,32,116,104,105,115,32,102,105,101,108,100,32,116,121,112,101],"value":"Value is not valid for this field type"},
-{"hash":230136804,"name":"o32sr.rsrequiredfield","sourcebytes":[65,32,118,97,108,117,101,32,105,115,32,114,101,113,117,105,114,101,100,32,105,110,32,116,104,105,115,32,102,105,101,108,100],"value":"A value is required in this field"},
-{"hash":92696485,"name":"o32sr.rsinvaliddate","sourcebytes":[86,97,108,117,101,32,105,115,32,110,111,116,32,97,32,118,97,108,105,100,32,100,97,116,101],"value":"Value is not a valid date"},
-{"hash":92760373,"name":"o32sr.rsinvalidtime","sourcebytes":[86,97,108,117,101,32,105,115,32,110,111,116,32,97,32,118,97,108,105,100,32,116,105,109,101],"value":"Value is not a valid time"},
-{"hash":104098179,"name":"o32sr.rsblanksinfield","sourcebytes":[84,104,105,115,32,102,105,101,108,100,32,115,104,111,117,108,100,32,99,111,110,116,97,105,110,32,110,111,32,98,108,97,110,107,115],"value":"This field should contain no blanks"},
-{"hash":190360572,"name":"o32sr.rspartialentry","sourcebytes":[84,104,105,115,32,102,105,101,108,100,32,115,104,111,117,108,100,32,98,101,32,101,105,116,104,101,114,32,101,109,112,116,121,32,111,114,32,99,111,109,112,108,101,116,101,108,121,32,102,117,108,108],"value":"This field should be either empty or completely full"},
-{"hash":66474265,"name":"o32sr.rsregiontoolarge","sourcebytes":[82,101,103,105,111,110,32,105,115,32,116,111,111,32,108,97,114,103,101,32,40,62,32,54,52,75,41],"value":"Region is too large (> 64K)"},
-{"hash":186038585,"name":"o32sr.rsoutofmemoryforcopy","sourcebytes":[67,111,117,108,100,32,110,111,116,32,97,108,108,111,99,97,116,101,32,109,101,109,111,114,121,32,102,111,114,32,99,108,105,112,98,111,97,114,100,32,99,111,112,121],"value":"Could not allocate memory for clipboard copy"},
-{"hash":31889508,"name":"o32sr.rsinvalidparamvalue","sourcebytes":[80,97,114,97,109,101,116,101,114,32,118,97,108,117,101,32,105,115,32,105,110,118,97,108,105,100],"value":"Parameter value is invalid"},
-{"hash":110743845,"name":"o32sr.rsnotimersavail","sourcebytes":[78,111,32,87,105,110,100,111,119,39,115,32,116,105,109,101,114,115,32,97,114,101,32,97,118,97,105,108,97,98,108,101],"value":"No Window's timers are available"},
-{"hash":219139891,"name":"o32sr.rstoomanyevents","sourcebytes":[84,111,111,32,109,97,110,121,32,116,114,105,103,103,101,114,32,101,118,101,110,116,115],"value":"Too many trigger events"},
-{"hash":103937301,"name":"o32sr.rsbadtriggerhandle","sourcebytes":[73,110,118,97,108,105,100,32,116,114,105,103,103,101,114,32,104,97,110,100,108,101],"value":"Invalid trigger handle"},
-{"hash":192553604,"name":"o32sr.rsonselectnotassigned","sourcebytes":[79,110,83,101,108,101,99,116,32,101,118,101,110,116,32,105,115,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"OnSelect event is not assigned"},
-{"hash":124954245,"name":"o32sr.rsinvalidpageindex","sourcebytes":[73,110,118,97,108,105,100,32,112,97,103,101,32,105,110,100,101,120,32,118,97,108,117,101],"value":"Invalid page index value"},
-{"hash":172862148,"name":"o32sr.rsinvaliddatatype","sourcebytes":[73,110,118,97,108,105,100,32,100,97,116,97,32,116,121,112,101,32,102,111,114,32,116,104,105,115,32,102,105,101,108,100],"value":"Invalid data type for this field"},
-{"hash":39861684,"name":"o32sr.rsinvalidtabfont","sourcebytes":[73,110,118,97,108,105,100,32,102,111,110,116,46,32,78,111,110,32,116,111,84,111,112,32,111,114,105,101,110,116,101,100,32,116,97,98,115,32,114,101,113,117,105,114,101,32,97,32,84,114,117,101,45,84,121,112,101,32,102,111,110,116],"value":"Invalid font. Non toTop oriented tabs require a True-Type font"},
-{"hash":69686484,"name":"o32sr.rsinvalidlabelfont","sourcebytes":[73,110,118,97,108,105,100,32,102,111,110,116,46,32,82,111,116,97,116,101,100,32,116,101,120,116,32,114,101,113,117,105,114,101,115,32,97,32,84,114,117,101,45,84,121,112,101,32,102,111,110,116],"value":"Invalid font. Rotated text requires a True-Type font"},
-{"hash":258097070,"name":"o32sr.rsoutofmemory","sourcebytes":[105,110,115,117,102,102,105,99,105,101,110,116,32,109,101,109,111,114,121,32,102,111,114,32,114,101,113,117,101,115,116,101,100,32,111,112,101,114,97,116,105,111,110],"value":"insufficient memory for requested operation"},
-{"hash":151298131,"name":"o32sr.rstoomanyparas","sourcebytes":[67,117,114,114,101,110,116,32,111,112,101,114,97,116,105,111,110,32,119,105,108,108,32,101,120,99,101,101,100,32,116,104,101,32,109,97,120,105,109,117,109,32,110,117,109,98,101,114,32,111,102,32,97,108,108,111,119,101,100,32,112,97,114,97,103,114,97,112,104,115],"value":"Current operation will exceed the maximum number of allowed paragraphs"},
-{"hash":88628149,"name":"o32sr.rscannotjoin","sourcebytes":[67,97,110,110,111,116,32,106,111,105,110,32,112,97,114,97,103,114,97,112,104,115,46,32,78,101,119,32,112,97,114,97,103,114,97,112,104,32,115,105,122,101,32,101,120,99,101,101,100,115,32,109,97,120,105,109,117,109,32,112,97,114,97,103,114,97,112,104,32,115,105,122,101],"value":"Cannot join paragraphs. New paragraph size exceeds maximum paragraph size"},
-{"hash":198920885,"name":"o32sr.rstoomanybytes","sourcebytes":[67,117,114,114,101,110,116,32,111,112,101,114,97,116,105,111,110,32,119,105,108,108,32,101,120,99,101,101,100,32,116,104,101,32,109,97,120,105,109,117,109,32,116,101,120,116,32,115,105,122,101],"value":"Current operation will exceed the maximum text size"},
-{"hash":158057429,"name":"o32sr.rsparatoolong","sourcebytes":[67,117,114,114,101,110,116,32,111,112,101,114,97,116,105,111,110,32,119,105,108,108,32,101,120,99,101,101,100,32,116,104,101,32,109,97,120,105,109,117,109,32,112,97,114,97,103,114,97,112,104,32,115,105,122,101],"value":"Current operation will exceed the maximum paragraph size"},
-{"hash":191420670,"name":"o32sr.rsunknownerror","sourcebytes":[85,110,107,110,111,119,110,32,69,114,114,111,114,32,99,111,110,100,105,116,105,111,110],"value":"Unknown Error condition"},
-{"hash":154407027,"name":"o32sr.rsinvalidpicturemask","sourcebytes":[73,110,118,97,108,105,100,32,112,105,99,116,117,114,101,32,109,97,115,107,58,32,37,115],"value":"Invalid picture mask: %s"},
-{"hash":13087785,"name":"o32sr.rsinvalidrange","sourcebytes":[73,110,118,97,108,105,100,32,114,97,110,103,101,46,32,69,110,116,101,114,32,97,32,118,97,108,117,101,32,98,101,116,119,101,101,110,32,40,37,100,41,32,97,110,100,32,40,37,100,41],"value":"Invalid range. Enter a value between (%d) and (%d)"},
-{"hash":248400601,"name":"o32sr.rsinvalidrealrange","sourcebytes":[73,110,118,97,108,105,100,32,114,97,110,103,101,46,32,69,110,116,101,114,32,97,32,118,97,108,117,101,32,98,101,116,119,101,101,110,32,40,45,49,46,55,101,43,51,56,41,32,97,110,100,32,40,43,49,46,55,101,43,51,56,41],"value":"Invalid range. Enter a value between (-1.7e+38) and (+1.7e+38)"},
-{"hash":264564361,"name":"o32sr.rsinvalidextendedrange","sourcebytes":[73,110,118,97,108,105,100,32,114,97,110,103,101,46,32,69,110,116,101,114,32,97,32,118,97,108,117,101,32,98,101,116,119,101,101,110,32,40,45,49,46,49,101,43,52,57,51,50,41,32,97,110,100,32,40,43,49,46,49,101,43,52,57,51,50,41],"value":"Invalid range. Enter a value between (-1.1e+4932) and (+1.1e+4932)"},
-{"hash":155966601,"name":"o32sr.rsinvaliddoublerange","sourcebytes":[73,110,118,97,108,105,100,32,114,97,110,103,101,46,32,69,110,116,101,114,32,97,32,118,97,108,117,101,32,98,101,116,119,101,101,110,32,40,45,49,46,55,101,43,51,48,56,41,32,97,110,100,32,40,43,49,46,55,101,43,51,48,56,41],"value":"Invalid range. Enter a value between (-1.7e+308) and (+1.7e+308)"},
-{"hash":246959545,"name":"o32sr.rsinvalidsinglerange","sourcebytes":[73,110,118,97,108,105,100,32,114,97,110,103,101,46,32,69,110,116,101,114,32,97,32,118,97,108,117,101,32,98,101,116,119,101,101,110,32,40,45,51,46,52,101,43,51,56,41,32,97,110,100,32,40,43,51,46,52,101,43,51,56,41],"value":"Invalid range. Enter a value between (-3.4e+38) and (+3.4e+38)"},
-{"hash":246828377,"name":"o32sr.rsinvalidcomprange","sourcebytes":[73,110,118,97,108,105,100,32,114,97,110,103,101,46,32,69,110,116,101,114,32,97,32,118,97,108,117,101,32,98,101,116,119,101,101,110,32,40,45,57,46,50,101,43,49,56,41,32,97,110,100,32,40,43,57,46,50,101,43,49,56,41],"value":"Invalid range. Enter a value between (-9.2e+18) and (+9.2e+18)"},
-{"hash":235266788,"name":"o32sr.rsinvaliddaterange","sourcebytes":[73,110,118,97,108,105,100,32,100,97,116,101,32,114,97,110,103,101,46,32,69,110,116,101,114,32,97,32,118,97,108,117,101,32,117,115,105,110,103,32,39,37,115,39,32,97,115,32,116,104,101,32,102,111,114,109,97,116],"value":"Invalid date range. Enter a value using '%s' as the format"},
-{"hash":91612132,"name":"o32sr.rsinvalidtimerange","sourcebytes":[73,110,118,97,108,105,100,32,116,105,109,101,32,114,97,110,103,101,46,32,69,110,116,101,114,32,97,32,118,97,108,117,101,32,117,115,105,110,103,32,39,37,115,39,32,97,115,32,116,104,101,32,102,111,114,109,97,116],"value":"Invalid time range. Enter a value using '%s' as the format"},
-{"hash":22644165,"name":"o32sr.rsinvalidrangevalue","sourcebytes":[73,110,118,97,108,105,100,32,114,97,110,103,101,32,118,97,108,117,101],"value":"Invalid range value"},
-{"hash":38619085,"name":"o32sr.rsinvalidminmaxvalue","sourcebytes":[73,110,118,97,108,105,100,32,118,97,108,117,101,32,45,32,77,97,120,105,109,117,109,32,109,117,115,116,32,97,108,119,97,121,115,32,98,101,32,103,114,101,97,116,101,114,32,116,104,97,110,32,77,105,110,105,109,117,109],"value":"Invalid value - Maximum must always be greater than Minimum"},
-{"hash":149815988,"name":"o32sr.rsrangenotsupported","sourcebytes":[82,97,110,103,101,32,108,105,109,105,116,115,32,102,111,114,32,116,104,101,32,99,117,114,114,101,110,116,108,121,32,115,101,108,101,99,116,101,100,32,100,97,116,97,32,116,121,112,101,32,97,114,101,32,110,111,116,32,115,117,112,112,111,114,116,101,100],"value":"Range limits for the currently selected data type are not supported"},
-{"hash":54276856,"name":"o32sr.rsinvalidlineorparaindex","sourcebytes":[73,110,118,97,108,105,100,32,108,105,110,101,32,111,114,32,112,97,114,97,103,114,97,112,104,32,105,110,100,101,120],"value":"Invalid line or paragraph index"},
-{"hash":77699476,"name":"o32sr.rsnonfixedfont","sourcebytes":[73,110,118,97,108,105,100,32,102,111,110,116,32,97,115,115,105,103,110,109,101,110,116,46,32,70,111,110,116,32,109,117,115,116,32,98,101,32,97,32,102,105,120,101,100,32,102,111,110,116],"value":"Invalid font assignment. Font must be a fixed font"},
-{"hash":83345268,"name":"o32sr.rsinvalidfontparam","sourcebytes":[73,110,118,97,108,105,100,32,102,111,110,116,32,97,115,115,105,103,110,101,109,110,116,46,32,70,111,110,116,32,109,117,115,116,32,98,101,32,97,32,84,70,111,110,116,32,111,114,32,84,79,118,99,70,105,120,101,100,70,111,110,116],"value":"Invalid font assignemnt. Font must be a TFont or TOvcFixedFont"},
-{"hash":252258974,"name":"o32sr.rsinvalidlineorcolumn","sourcebytes":[73,110,118,97,108,105,100,32,108,105,110,101,32,111,114,32,99,111,108,117,109,110],"value":"Invalid line or column"},
-{"hash":243786162,"name":"o32sr.rssaegeneral","sourcebytes":[85,110,107,110,111,119,110,32,115,112,97,114,115,101,32,97,114,114,97,121,32,101,114,114,111,114],"value":"Unknown sparse array error"},
-{"hash":187909973,"name":"o32sr.rssaeatmaxsize","sourcebytes":[83,112,97,114,115,101,32,97,114,114,97,121,32,105,115,32,97,116,32,116,104,101,32,109,97,120,105,109,117,109,32,115,105,122,101],"value":"Sparse array is at the maximum size"},
-{"hash":164284260,"name":"o32sr.rsinvalidxmlfile","sourcebytes":[73,110,118,97,108,105,100,32,88,77,76,83,116,111,114,101,32,70,105,108,101,32,70,111,114,109,97,116],"value":"Invalid XMLStore File Format"},
-{"hash":254995412,"name":"o32sr.rsunterminatedelement","sourcebytes":[73,109,112,114,111,112,101,114,108,121,32,116,101,114,109,105,110,97,116,101,100,32,101,108,101,109,101,110,116],"value":"Improperly terminated element"},
-{"hash":205947476,"name":"o32sr.rsbadcolorconstant","sourcebytes":[73,110,118,97,108,105,100,32,99,111,108,111,114,32,99,111,110,115,116,97,110,116],"value":"Invalid color constant"},
-{"hash":38445685,"name":"o32sr.rsbadcolorvalue","sourcebytes":[73,110,118,97,108,105,100,32,99,111,108,111,114,32,118,97,108,117,101],"value":"Invalid color value"},
-{"hash":240618073,"name":"o32sr.rssaeoutofbounds","sourcebytes":[73,110,100,101,120,32,105,115,32,111,117,116,32,111,102,32,98,111,117,110,100,115,32,102,111,114,32,115,112,97,114,115,101,32,97,114,114,97,121],"value":"Index is out of bounds for sparse array"},
-{"hash":239028484,"name":"o32sr.rsinvalidfieldtype","sourcebytes":[82,101,113,117,101,115,116,101,100,32,102,105,101,108,100,32,116,121,112,101,32,105,115,32,110,111,116,32,115,117,112,112,111,114,116,101,100],"value":"Requested field type is not supported"},
-{"hash":86960565,"name":"o32sr.rsbadalarmhandle","sourcebytes":[73,110,118,97,108,105,100,32,97,108,97,114,109,32,104,97,110,100,108,101],"value":"Invalid alarm handle"},
-{"hash":131528196,"name":"o32sr.rsonisselectednotassigned","sourcebytes":[79,110,73,115,83,101,108,101,99,116,101,100,32,101,118,101,110,116,32,105,115,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"OnIsSelected event is not assigned"},
-{"hash":167101369,"name":"o32sr.rsinvaliddateformask","sourcebytes":[73,110,118,97,108,105,100,32,100,97,116,101,32,118,97,108,117,101,32,102,111,114,32,112,105,99,116,117,114,101,32,109,97,115,107,46,32,40,89,101,97,114,32,105,115,32,111,117,116,115,105,100,101,32,116,104,101,32,69,112,111,99,104,32,114,97,110,103,101,41],"value":"Invalid date value for picture mask. (Year is outside the Epoch range)"},
-{"hash":202611508,"name":"o32sr.rsviewerioerror","sourcebytes":[86,105,101,119,101,114,32,116,114,105,103,103,101,114,101,100,32,73,47,79,32,101,114,114,111,114,32,37,100],"value":"Viewer triggered I\/O error %d"},
-{"hash":93066788,"name":"o32sr.rsviewerfilenotfound","sourcebytes":[86,105,101,119,101,114,58,32,102,105,108,101,32,110,111,116,32,102,111,117,110,100],"value":"Viewer: file not found"},
-{"hash":93921701,"name":"o32sr.rsviewerpathnotfound","sourcebytes":[86,105,101,119,101,114,58,32,112,97,116,104,32,110,111,116,32,102,111,117,110,100,32,111,114,32,105,110,118,97,108,105,100,32,102,105,108,101,32,110,97,109,101],"value":"Viewer: path not found or invalid file name"},
-{"hash":37810179,"name":"o32sr.rsviewertoomanyopenfiles","sourcebytes":[86,105,101,119,101,114,58,32,116,111,111,32,109,97,110,121,32,111,112,101,110,32,102,105,108,101,115],"value":"Viewer: too many open files"},
-{"hash":137519748,"name":"o32sr.rsviewerfileaccessdenied","sourcebytes":[86,105,101,119,101,114,58,32,102,105,108,101,32,97,99,99,101,115,115,32,100,101,110,105,101,100],"value":"Viewer: file access denied"},
-{"hash":206530819,"name":"o32sr.rscontrolattached","sourcebytes":[84,104,105,115,32,99,111,110,116,114,111,108,32,105,115,32,97,108,114,101,97,100,121,32,97,116,116,97,99,104,101,100,32,116,111,32,37,115],"value":"This control is already attached to %s"},
-{"hash":94969973,"name":"o32sr.rscantedit","sourcebytes":[67,111,117,108,100,32,110,111,116,32,101,110,116,101,114,32,101,100,105,116,32,109,111,100,101],"value":"Could not enter edit mode"},
-{"hash":258793572,"name":"o32sr.rschildtableerror","sourcebytes":[68,97,116,97,32,83,111,117,114,99,101,32,99,97,110,32,110,111,116,32,98,101,32,97,32,99,104,105,108,100,32,116,97,98,108,101,46,32,67,111,109,112,111,110,101,110,116,32,37,115,32,104,97,115,32,97,32,77,97,115,116,101,114,83,111,117,114,99,101,32,100,101,102,105,110,101,100],"value":"Data Source can not be a child table. Component %s has a MasterSource defined"},
-{"hash":54018357,"name":"o32sr.rsnotableattached","sourcebytes":[68,97,116,97,83,111,117,114,99,101,32,109,117,115,116,32,98,101,32,97,116,116,97,99,104,101,100,32,116,111,32,97,32,84,84,97,98,108,101,32,40,111,114,32,99,111,109,112,97,116,105,98,108,101,41,32,115,111,117,114,99,101],"value":"DataSource must be attached to a TTable (or compatible) source"},
-{"hash":115453668,"name":"o32sr.rsnocollection","sourcebytes":[78,111,32,99,111,108,108,101,99,116,105,111,110,32,101,120,105,115,116,115,32,105,110,32,116,104,101,32,111,119,110,101,114,32,99,111,109,112,111,110,101,110,116],"value":"No collection exists in the owner component"},
-{"hash":139674484,"name":"o32sr.rsnotovcdescendant","sourcebytes":[79,119,110,101,114,32,109,117,115,116,32,98,101,32,97,32,84,79,118,99,67,111,109,112,111,110,101,110,116,32,111,114,32,84,79,118,99,67,117,115,116,111,109,67,111,109,112,111,110,101,110,116,32,100,101,115,99,101,110,100,97,110,116],"value":"Owner must be a TOvcComponent or TOvcCustomComponent descendant"},
-{"hash":9129726,"name":"o32sr.rsitemincompatible","sourcebytes":[73,116,101,109,32,105,110,99,111,109,112,97,116,105,98,108,101,32,119,105,116,104,32,99,111,108,108,101,99,116,105,111,110],"value":"Item incompatible with collection"},
-{"hash":265712596,"name":"o32sr.rslabelnotattached","sourcebytes":[76,97,98,101,108,32,110,111,116,32,97,116,116,97,99,104,101,100],"value":"Label not attached"},
-{"hash":172254164,"name":"o32sr.rsclassnotset","sourcebytes":[73,116,101,109,32,99,108,97,115,115,32,110,111,116,32,115,101,116],"value":"Item class not set"},
-{"hash":240220981,"name":"o32sr.rscollectionnotfound","sourcebytes":[78,111,32,99,111,108,108,101,99,116,105,111,110,32,102,111,117,110,100,32,102,111,114,32,116,104,105,115,32,116,121,112,101],"value":"No collection found for this type"},
-{"hash":58974537,"name":"o32sr.rsdayconverterror","sourcebytes":[69,114,114,111,114,32,99,111,110,118,101,114,116,105,110,103,32,100,97,121],"value":"Error converting day"},
-{"hash":66692648,"name":"o32sr.rsmonthconverterror","sourcebytes":[69,114,114,111,114,32,99,111,110,118,101,114,116,105,110,103,32,109,111,110,116,104],"value":"Error converting month"},
-{"hash":43703893,"name":"o32sr.rsmonthnameconverterror","sourcebytes":[69,114,114,111,114,32,99,111,110,118,101,114,116,105,110,103,32,109,111,110,116,104,32,110,97,109,101],"value":"Error converting month name"},
-{"hash":138364850,"name":"o32sr.rsyearconverterror","sourcebytes":[69,114,114,111,114,32,99,111,110,118,101,114,116,105,110,103,32,121,101,97,114],"value":"Error converting year"},
-{"hash":44447241,"name":"o32sr.rsinvalidday","sourcebytes":[73,110,118,97,108,105,100,32,100,97,121],"value":"Invalid day"},
-{"hash":105965320,"name":"o32sr.rsinvalidmonth","sourcebytes":[73,110,118,97,108,105,100,32,109,111,110,116,104],"value":"Invalid month"},
-{"hash":12864069,"name":"o32sr.rsinvalidmonthname","sourcebytes":[73,110,118,97,108,105,100,32,109,111,110,116,104,32,110,97,109,101],"value":"Invalid month name"},
-{"hash":174207906,"name":"o32sr.rsinvalidyear","sourcebytes":[73,110,118,97,108,105,100,32,121,101,97,114],"value":"Invalid year"},
-{"hash":133961140,"name":"o32sr.rsdayrequired","sourcebytes":[68,97,121,32,105,115,32,114,101,113,117,105,114,101,100],"value":"Day is required"},
-{"hash":114309780,"name":"o32sr.rsmonthrequired","sourcebytes":[77,111,110,116,104,32,105,115,32,114,101,113,117,105,114,101,100],"value":"Month is required"},
-{"hash":150971572,"name":"o32sr.rsyearrequired","sourcebytes":[89,101,97,114,32,105,115,32,114,101,113,117,105,114,101,100],"value":"Year is required"},
-{"hash":99732068,"name":"o32sr.rsownermustbeform","sourcebytes":[79,119,110,101,114,32,109,117,115,116,32,98,101,32,97,32,84,70,111,114,109,32,111,114,32,100,101,115,99,101,110,100,97,110,116],"value":"Owner must be a TForm or descendant"},
-{"hash":256079797,"name":"o32sr.rstimeconverterror","sourcebytes":[69,114,114,111,114,32,99,111,110,118,101,114,116,105,110,103,32,116,105,109,101,32,118,97,108,117,101],"value":"Error converting time value"},
-{"hash":70100255,"name":"o32sr.rscancelquery","sourcebytes":[67,97,110,99,101,108,32,97,110,100,32,108,111,115,101,32,99,104,97,110,103,101,115,63],"value":"Cancel and lose changes?"},
-{"hash":124996276,"name":"o32sr.rsnopagesassigned","sourcebytes":[78,111,32,110,111,116,101,98,111,111,107,32,112,97,103,101,115,32,97,115,115,105,103,110,101,100],"value":"No notebook pages assigned"},
-{"hash":147502133,"name":"o32sr.rsrestoremi","sourcebytes":[38,82,101,115,116,111,114,101],"value":"&Restore"},
-{"hash":305108,"name":"o32sr.rscutmi","sourcebytes":[67,117,38,116],"value":"Cu&t"},
-{"hash":2795129,"name":"o32sr.rscopymi","sourcebytes":[38,67,111,112,121],"value":"&Copy"},
-{"hash":45517477,"name":"o32sr.rspastemi","sourcebytes":[38,80,97,115,116,101],"value":"&Paste"},
-{"hash":179055749,"name":"o32sr.rsdeletemi","sourcebytes":[38,68,101,108,101,116,101],"value":"&Delete"},
-{"hash":171665052,"name":"o32sr.rsselectallmi","sourcebytes":[83,101,108,101,99,116,32,38,65,108,108],"value":"Select &All"},
-{"hash":124993891,"name":"o32sr.rstablerowoutofbounds","sourcebytes":[84,97,98,108,101,32,114,111,119,32,111,117,116,32,111,102,32,98,111,117,110,100,115],"value":"Table row out of bounds"},
-{"hash":173710098,"name":"o32sr.rstablemaxrows","sourcebytes":[84,97,98,108,101,32,109,97,120,32,114,111,119,115,32,101,114,114,111,114],"value":"Table max rows error"},
-{"hash":172411506,"name":"o32sr.rstablemaxcolumns","sourcebytes":[84,97,98,108,101,32,109,97,120,32,99,111,108,117,109,110,115,32,101,114,114,111,114],"value":"Table max columns error"},
-{"hash":162625570,"name":"o32sr.rstablegeneral","sourcebytes":[84,97,98,108,101,32,103,101,110,101,114,97,108,32,101,114,114,111,114],"value":"Table general error"},
-{"hash":259026723,"name":"o32sr.rstabletomanycolumns","sourcebytes":[84,111,111,32,109,97,110,121,32,99,111,108,117,109,110,115],"value":"Too many columns"},
-{"hash":6303816,"name":"o32sr.rstableinvalidfieldindex","sourcebytes":[73,110,118,97,108,105,100,32,102,105,101,108,100,32,105,110,100,101,120],"value":"Invalid field index"},
-{"hash":10366516,"name":"o32sr.rstableheadernotassigned","sourcebytes":[72,101,97,100,101,114,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"Header not assigned"},
-{"hash":175419180,"name":"o32sr.rstableinvalidheadercell","sourcebytes":[73,110,118,97,108,105,100,32,104,101,97,100,101,114,32,99,101,108,108],"value":"Invalid header cell"},
-{"hash":296859,"name":"o32sr.rscalcback","sourcebytes":[66,97,99,107],"value":"Back"},
-{"hash":1299,"name":"o32sr.rscalcmc","sourcebytes":[77,67],"value":"MC"},
-{"hash":1314,"name":"o32sr.rscalcmr","sourcebytes":[77,82],"value":"MR"},
-{"hash":1315,"name":"o32sr.rscalcms","sourcebytes":[77,83],"value":"MS"},
-{"hash":1275,"name":"o32sr.rscalcmplus","sourcebytes":[77,43],"value":"M+"},
-{"hash":1277,"name":"o32sr.rscalcmminus","sourcebytes":[77,45],"value":"M-"},
-{"hash":1156,"name":"o32sr.rscalcct","sourcebytes":[67,84],"value":"CT"},
-{"hash":1141,"name":"o32sr.rscalcce","sourcebytes":[67,69],"value":"CE"},
-{"hash":67,"name":"o32sr.rscalcc","sourcebytes":[67],"value":"C"},
-{"hash":370836,"name":"o32sr.rscalcsqrt","sourcebytes":[83,113,114,116],"value":"Sqrt"},
-{"hash":338644,"name":"o32sr.rscalnext","sourcebytes":[78,69,88,84],"value":"NEXT"},
-{"hash":329348,"name":"o32sr.rscallast","sourcebytes":[76,65,83,84],"value":"LAST"},
-{"hash":349862,"name":"o32sr.rscalprev","sourcebytes":[80,82,69,86],"value":"PREV"},
-{"hash":4908932,"name":"o32sr.rscalfirst","sourcebytes":[70,73,82,83,84],"value":"FIRST"},
-{"hash":13956,"name":"o32sr.rscal1st","sourcebytes":[49,83,84],"value":"1ST"},
-{"hash":91849764,"name":"o32sr.rscalsecond","sourcebytes":[83,69,67,79,78,68],"value":"SECOND"},
-{"hash":14116,"name":"o32sr.rscal2nd","sourcebytes":[50,78,68],"value":"2ND"},
-{"hash":5820004,"name":"o32sr.rscalthird","sourcebytes":[84,72,73,82,68],"value":"THIRD"},
-{"hash":14436,"name":"o32sr.rscal3rd","sourcebytes":[51,82,68],"value":"3RD"},
-{"hash":78948232,"name":"o32sr.rscalfourth","sourcebytes":[70,79,85,82,84,72],"value":"FOURTH"},
-{"hash":14728,"name":"o32sr.rscal4th","sourcebytes":[52,84,72],"value":"4TH"},
-{"hash":4907612,"name":"o32sr.rscalfinal","sourcebytes":[70,73,78,65,76],"value":"FINAL"},
-{"hash":18237,"name":"o32sr.rscalbom","sourcebytes":[66,79,77],"value":"BOM"},
-{"hash":4627422,"name":"o32sr.rscalbegin","sourcebytes":[66,69,71,73,78],"value":"BEGIN"},
-{"hash":19005,"name":"o32sr.rscaleom","sourcebytes":[69,79,77],"value":"EOM"},
-{"hash":18980,"name":"o32sr.rscalend","sourcebytes":[69,78,68],"value":"END"},
-{"hash":143275465,"name":"o32sr.rscalyesterday","sourcebytes":[89,69,83,84,69,82,68,65,89],"value":"YESTERDAY"},
-{"hash":5847145,"name":"o32sr.rscaltoday","sourcebytes":[84,79,68,65,89],"value":"TODAY"},
-{"hash":69498071,"name":"o32sr.rscaltomorrow","sourcebytes":[84,79,77,79,82,82,79,87],"value":"TOMORROW"},
-{"hash":80477938,"name":"o32sr.rseditingsections","sourcebytes":[72,101,97,100,101,114,32,83,101,99,116,105,111,110,115,32,69,100,105,116,111,114],"value":"Header Sections Editor"},
-{"hash":248718130,"name":"o32sr.rseditingitems","sourcebytes":[70,111,108,100,101,114,32,73,116,101,109,115,32,69,100,105,116,111,114],"value":"Folder Items Editor"},
-{"hash":165259106,"name":"o32sr.rseditingfolders","sourcebytes":[70,111,108,100,101,114,32,69,100,105,116,111,114],"value":"Folder Editor"},
-{"hash":31027826,"name":"o32sr.rseditingpages","sourcebytes":[84,97,98,32,80,97,103,101,115,32,69,100,105,116,111,114],"value":"Tab Pages Editor"},
-{"hash":60438738,"name":"o32sr.rseditingimages","sourcebytes":[73,109,97,103,101,32,76,105,115,116,32,69,100,105,116,111,114],"value":"Image List Editor"},
-{"hash":163229710,"name":"o32sr.rssectionbasename","sourcebytes":[83,101,99,116,105,111,110],"value":"Section"},
-{"hash":330429,"name":"o32sr.rsitembasename","sourcebytes":[73,116,101,109],"value":"Item"},
-{"hash":81144514,"name":"o32sr.rsfolderbasename","sourcebytes":[70,111,108,100,101,114],"value":"Folder"},
-{"hash":354261,"name":"o32sr.rspagebasename","sourcebytes":[80,97,103,101],"value":"Page"},
-{"hash":5257173,"name":"o32sr.rsimagebasename","sourcebytes":[73,109,97,103,101],"value":"Image"},
-{"hash":5205139,"name":"o32sr.rshoursname","sourcebytes":[72,111,117,114,115],"value":"Hours"},
-{"hash":67488403,"name":"o32sr.rsminutesname","sourcebytes":[77,105,110,117,116,101,115],"value":"Minutes"},
-{"hash":163210467,"name":"o32sr.rssecondsname","sourcebytes":[83,101,99,111,110,100,115],"value":"Seconds"},
-{"hash":4863637,"name":"o32sr.rsclosecaption","sourcebytes":[67,108,111,115,101],"value":"Close"},
-{"hash":268126580,"name":"o32sr.rsviewfieldnotfound","sourcebytes":[84,104,101,32,118,105,101,119,32,102,105,101,108,100,32,37,115,32,119,97,115,32,110,111,116,32,102,111,117,110,100],"value":"The view field %s was not found"},
-{"hash":17553811,"name":"o32sr.rscantresolvefield","sourcebytes":[85,110,97,98,108,101,32,116,111,32,114,101,115,111,108,118,101,32,118,105,101,119,32,102,105,101,108,100,32,37,115],"value":"Unable to resolve view field %s"},
-{"hash":160173704,"name":"o32sr.rsitemalreadyexists","sourcebytes":[67,97,110,39,116,32,97,100,100,32,105,116,101,109,32,37,112,32,45,32,105,116,32,97,108,114,101,97,100,121,32,101,120,105,115,116,115,32,105,110,32,116,104,101,32,105,110,100,101,120],"value":"Can't add item %p - it already exists in the index"},
-{"hash":108159061,"name":"o32sr.rsalreadyintempmode","sourcebytes":[84,104,101,32,118,105,101,119,32,105,115,32,97,108,114,101,97,100,121,32,105,110,32,116,101,109,112,111,114,97,114,121,32,105,110,100,101,120,32,109,111,100,101],"value":"The view is already in temporary index mode"},
-{"hash":17830740,"name":"o32sr.rsitemnotfound","sourcebytes":[83,112,101,99,105,102,105,101,100,32,114,101,112,111,114,116,32,118,105,101,119,32,100,97,116,97,32,105,116,101,109,32,37,112,32,119,97,115,32,110,111,116,32,102,111,117,110,100],"value":"Specified report view data item %p was not found"},
-{"hash":201152055,"name":"o32sr.rsupdatepending","sourcebytes":[84,104,105,115,32,114,101,112,111,114,116,32,118,105,101,119,32,111,112,101,114,97,116,105,111,110,32,105,115,32,105,110,118,97,108,105,100,32,119,104,105,108,101,32,117,112,100,97,116,101,115,32,97,114,101,32,112,101,110,100,105,110,103],"value":"This report view operation is invalid while updates are pending"},
-{"hash":76579668,"name":"o32sr.rsoncomparenotassigned","sourcebytes":[79,110,67,111,109,112,97,114,101,70,105,101,108,100,115,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"OnCompareFields not assigned"},
-{"hash":113924180,"name":"o32sr.rsonfilternotassigned","sourcebytes":[79,110,70,105,108,116,101,114,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"OnFilter not assigned"},
-{"hash":141112020,"name":"o32sr.rsgetasfloatnotassigned","sourcebytes":[71,101,116,65,115,70,108,111,97,116,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"GetAsFloat not assigned"},
-{"hash":164581701,"name":"o32sr.rsnotintempmode","sourcebytes":[82,101,112,111,114,116,32,118,105,101,119,32,105,115,32,110,111,116,32,105,110,32,116,101,109,112,111,114,97,114,121,32,105,110,100,101,120,32,109,111,100,101],"value":"Report view is not in temporary index mode"},
-{"hash":139773240,"name":"o32sr.rsitemnotinindex","sourcebytes":[84,104,101,32,115,112,101,99,105,102,105,101,100,32,100,97,116,97,32,105,116,101,109,32,40,37,112,41,32,105,115,32,110,111,116,32,105,110,32,116,104,101,32,105,110,100,101,120],"value":"The specified data item (%p) is not in the index"},
-{"hash":219185047,"name":"o32sr.rsnoactiveview","sourcebytes":[78,111,32,97,99,116,105,118,101,32,118,105,101,119],"value":"No active view"},
-{"hash":207431808,"name":"o32sr.rsitemisnotgroup","sourcebytes":[73,116,101,109,32,97,116,32,108,105,110,101,32,37,100,32,105,115,32,110,111,116,32,97,32,103,114,111,117,112],"value":"Item at line %d is not a group"},
-{"hash":244079028,"name":"o32sr.rsnotmultiselect","sourcebytes":[84,104,105,115,32,114,101,112,111,114,116,32,118,105,101,119,32,111,112,101,114,97,116,105,111,110,32,105,115,32,111,110,108,121,32,97,108,108,111,119,101,100,32,119,104,101,110,32,109,117,108,116,105,115,101,108,101,99,116,32,105,115,32,101,110,97,98,108,101,100],"value":"This report view operation is only allowed when multiselect is enabled"},
-{"hash":210158068,"name":"o32sr.rslinenooutofrange","sourcebytes":[73,110,118,97,108,105,100,32,105,110,100,101,120,32,37,100],"value":"Invalid index %d"},
-{"hash":178454563,"name":"o32sr.rsunknownview","sourcebytes":[85,110,107,110,111,119,110,32,118,105,101,119,58,32,37,115],"value":"Unknown view: %s"},
-{"hash":170685332,"name":"o32sr.rsonkeysearchnotassigned","sourcebytes":[84,104,101,32,79,110,75,101,121,83,101,97,114,99,104,32,101,118,101,110,116,32,105,115,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"The OnKeySearch event is not assigned"},
-{"hash":41277828,"name":"o32sr.rsonenumnotassigned","sourcebytes":[84,104,101,32,79,110,69,110,117,109,32,101,118,101,110,116,32,105,115,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"The OnEnum event is not assigned"},
-{"hash":53442292,"name":"o32sr.rsonenumselectedna","sourcebytes":[79,110,69,110,117,109,83,101,108,101,99,116,101,100,32,110,111,116,32,97,115,115,105,103,110,101,100],"value":"OnEnumSelected not assigned"},
-{"hash":218640564,"name":"o32sr.rsnomenuassigned","sourcebytes":[78,111,32,109,101,110,117,32,105,116,101,109,32,97,115,115,105,103,110,101,100],"value":"No menu item assigned"},
-{"hash":251158724,"name":"o32sr.rsnoanchorassigned","sourcebytes":[78,111,32,97,110,99,104,111,114,32,105,116,101,109,32,97,115,115,105,103,110,101,100],"value":"No anchor item assigned"},
-{"hash":80460738,"name":"o32sr.rsinvalidparameter","sourcebytes":[73,110,118,97,108,105,100,32,112,97,114,97,109,101,116,101,114,58,32,109,112,65,110,99,104,111,114],"value":"Invalid parameter: mpAnchor"},
-{"hash":198347043,"name":"o32sr.rsinvalidoperation","sourcebytes":[73,110,118,97,108,105,100,32,111,112,101,114,97,116,105,111,110,58,32,67,97,108,108,32,65,100,100,83,112,108,105,116,32,102,111,114,32,115,112,108,105,116,32,109,101,110,117,115],"value":"Invalid operation: Call AddSplit for split menus"},
-{"hash":120111635,"name":"o32sr.rsformuseonly","sourcebytes":[84,104,105,115,32,99,111,109,112,111,110,101,110,116,32,99,97,110,32,111,110,108,121,32,98,101,32,117,115,101,100,32,111,110,32,102,111,114,109,115],"value":"This component can only be used on forms"},
-{"hash":4794267,"name":"o32sr.rscolorblack","sourcebytes":[66,108,97,99,107],"value":"Black"},
-{"hash":87594590,"name":"o32sr.rscolormaroon","sourcebytes":[77,97,114,111,111,110],"value":"Maroon"},
-{"hash":5147582,"name":"o32sr.rscolorgreen","sourcebytes":[71,114,101,101,110],"value":"Green"},
-{"hash":5648581,"name":"o32sr.rscolorolive","sourcebytes":[79,108,105,118,101],"value":"Olive"},
-{"hash":346329,"name":"o32sr.rscolornavy","sourcebytes":[78,97,118,121],"value":"Navy"},
-{"hash":92051237,"name":"o32sr.rscolorpurple","sourcebytes":[80,117,114,112,108,101],"value":"Purple"},
-{"hash":371580,"name":"o32sr.rscolorteal","sourcebytes":[84,101,97,108],"value":"Teal"},
-{"hash":321673,"name":"o32sr.rscolorgray","sourcebytes":[71,114,97,121],"value":"Gray"},
-{"hash":94387394,"name":"o32sr.rscolorsilver","sourcebytes":[83,105,108,118,101,114],"value":"Silver"},
-{"hash":22708,"name":"o32sr.rscolorred","sourcebytes":[82,101,100],"value":"Red"},
-{"hash":340021,"name":"o32sr.rscolorlime","sourcebytes":[76,105,109,101],"value":"Lime"},
-{"hash":100414311,"name":"o32sr.rscoloryellow","sourcebytes":[89,101,108,108,111,119],"value":"Yellow"},
-{"hash":299957,"name":"o32sr.rscolorblue","sourcebytes":[66,108,117,101],"value":"Blue"},
-{"hash":230291889,"name":"o32sr.rscolorfuchsia","sourcebytes":[70,117,99,104,115,105,97],"value":"Fuchsia"},
-{"hash":297137,"name":"o32sr.rscoloraqua","sourcebytes":[65,113,117,97],"value":"Aqua"},
-{"hash":6156453,"name":"o32sr.rscolorwhite","sourcebytes":[87,104,105,116,101],"value":"White"},
-{"hash":258066265,"name":"o32sr.rscolorlightgray","sourcebytes":[76,105,103,104,116,32,71,114,97,121],"value":"Light Gray"},
-{"hash":195515273,"name":"o32sr.rscolormediumgray","sourcebytes":[77,101,100,105,117,109,32,71,114,97,121],"value":"Medium Gray"},
-{"hash":148152841,"name":"o32sr.rscolordarkgray","sourcebytes":[68,97,114,107,32,71,114,97,121],"value":"Dark Gray"},
-{"hash":186314622,"name":"o32sr.rscolormoneygreen","sourcebytes":[77,111,110,101,121,32,71,114,101,101,110],"value":"Money Green"},
-{"hash":45389333,"name":"o32sr.rscolorskyblue","sourcebytes":[83,107,121,32,66,108,117,101],"value":"Sky Blue"},
-{"hash":4885373,"name":"o32sr.rscolorcream","sourcebytes":[67,114,101,97,109],"value":"Cream"},
-{"hash":110646853,"name":"o32sr.ccnonestr","sourcebytes":[99,99,78,111,110,101],"value":"ccNone"},
-{"hash":110593947,"name":"o32sr.ccbackstr","sourcebytes":[99,99,66,97,99,107],"value":"ccBack"},
-{"hash":154279605,"name":"o32sr.ccbotofpagestr","sourcebytes":[99,99,66,111,116,79,102,80,97,103,101],"value":"ccBotOfPage"},
-{"hash":174982732,"name":"o32sr.ccbotrightcellstr","sourcebytes":[99,99,66,111,116,82,105,103,104,116,67,101,108,108],"value":"ccBotRightCell"},
-{"hash":185592085,"name":"o32sr.cccompletedatestr","sourcebytes":[99,99,67,111,109,112,108,101,116,101,68,97,116,101],"value":"ccCompleteDate"},
-{"hash":185397125,"name":"o32sr.cccompletetimestr","sourcebytes":[99,99,67,111,109,112,108,101,116,101,84,105,109,101],"value":"ccCompleteTime"},
-{"hash":110601849,"name":"o32sr.cccopystr","sourcebytes":[99,99,67,111,112,121],"value":"ccCopy"},
-{"hash":194382114,"name":"o32sr.ccctrlcharstr","sourcebytes":[99,99,67,116,114,108,67,104,97,114],"value":"ccCtrlChar"},
-{"hash":6912708,"name":"o32sr.cccutstr","sourcebytes":[99,99,67,117,116],"value":"ccCut"},
-{"hash":6912691,"name":"o32sr.ccdecstr","sourcebytes":[99,99,68,101,99],"value":"ccDec"},
-{"hash":6912700,"name":"o32sr.ccdelstr","sourcebytes":[99,99,68,101,108],"value":"ccDel"},
-{"hash":128716748,"name":"o32sr.ccdelbolstr","sourcebytes":[99,99,68,101,108,66,111,108],"value":"ccDelBol"},
-{"hash":128716492,"name":"o32sr.ccdeleolstr","sourcebytes":[99,99,68,101,108,69,111,108],"value":"ccDelEol"},
-{"hash":180438837,"name":"o32sr.ccdellinestr","sourcebytes":[99,99,68,101,108,76,105,110,101],"value":"ccDelLine"},
-{"hash":180473844,"name":"o32sr.ccdelwordstr","sourcebytes":[99,99,68,101,108,87,111,114,100],"value":"ccDelWord"},
-{"hash":110606046,"name":"o32sr.ccdownstr","sourcebytes":[99,99,68,111,119,110],"value":"ccDown"},
-{"hash":6913092,"name":"o32sr.ccendstr","sourcebytes":[99,99,69,110,100],"value":"ccEnd"},
-{"hash":249526654,"name":"o32sr.ccextenddownstr","sourcebytes":[99,99,69,120,116,101,110,100,68,111,119,110],"value":"ccExtendDown"},
-{"hash":183367860,"name":"o32sr.ccextendendstr","sourcebytes":[99,99,69,120,116,101,110,100,69,110,100],"value":"ccExtendEnd"},
-{"hash":249510805,"name":"o32sr.ccextendhomestr","sourcebytes":[99,99,69,120,116,101,110,100,72,111,109,101],"value":"ccExtendHome"},
-{"hash":249619572,"name":"o32sr.ccextendleftstr","sourcebytes":[99,99,69,120,116,101,110,100,76,101,102,116],"value":"ccExtendLeft"},
-{"hash":249472014,"name":"o32sr.ccextendpgdnstr","sourcebytes":[99,99,69,120,116,101,110,100,80,103,68,110],"value":"ccExtendPgDn"},
-{"hash":249471840,"name":"o32sr.ccextendpgupstr","sourcebytes":[99,99,69,120,116,101,110,100,80,103,85,112],"value":"ccExtendPgUp"},
-{"hash":233047828,"name":"o32sr.ccextendrightstr","sourcebytes":[99,99,69,120,116,101,110,100,82,105,103,104,116],"value":"ccExtendRight"},
-{"hash":263118336,"name":"o32sr.ccextendupstr","sourcebytes":[99,99,69,120,116,101,110,100,85,112],"value":"ccExtendUp"},
-{"hash":9762773,"name":"o32sr.ccextbotofpagestr","sourcebytes":[99,99,69,120,116,66,111,116,79,102,80,97,103,101],"value":"ccExtBotOfPage"},
-{"hash":241626181,"name":"o32sr.ccextfirstpagestr","sourcebytes":[99,99,69,120,116,70,105,114,115,116,80,97,103,101],"value":"ccExtFirstPage"},
-{"hash":30776981,"name":"o32sr.ccextlastpagestr","sourcebytes":[99,99,69,120,116,76,97,115,116,80,97,103,101],"value":"ccExtLastPage"},
-{"hash":76872229,"name":"o32sr.ccexttopofpagestr","sourcebytes":[99,99,69,120,116,84,111,112,79,102,80,97,103,101],"value":"ccExtTopOfPage"},
-{"hash":267768340,"name":"o32sr.ccextwordleftstr","sourcebytes":[99,99,69,120,116,87,111,114,100,76,101,102,116],"value":"ccExtWordLeft"},
-{"hash":257384708,"name":"o32sr.ccextwordrightstr","sourcebytes":[99,99,69,120,116,87,111,114,100,82,105,103,104,116],"value":"ccExtWordRight"},
-{"hash":163584725,"name":"o32sr.ccfirstpagestr","sourcebytes":[99,99,70,105,114,115,116,80,97,103,101],"value":"ccFirstPage"},
-{"hash":183990064,"name":"o32sr.ccgotomarker0str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,48],"value":"ccGotoMarker0"},
-{"hash":183990065,"name":"o32sr.ccgotomarker1str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,49],"value":"ccGotoMarker1"},
-{"hash":183990066,"name":"o32sr.ccgotomarker2str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,50],"value":"ccGotoMarker2"},
-{"hash":183990067,"name":"o32sr.ccgotomarker3str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,51],"value":"ccGotoMarker3"},
-{"hash":183990068,"name":"o32sr.ccgotomarker4str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,52],"value":"ccGotoMarker4"},
-{"hash":183990069,"name":"o32sr.ccgotomarker5str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,53],"value":"ccGotoMarker5"},
-{"hash":183990070,"name":"o32sr.ccgotomarker6str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,54],"value":"ccGotoMarker6"},
-{"hash":183990071,"name":"o32sr.ccgotomarker7str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,55],"value":"ccGotoMarker7"},
-{"hash":183990072,"name":"o32sr.ccgotomarker8str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,56],"value":"ccGotoMarker8"},
-{"hash":183990073,"name":"o32sr.ccgotomarker9str","sourcebytes":[99,99,71,111,116,111,77,97,114,107,101,114,57],"value":"ccGotoMarker9"},
-{"hash":110622261,"name":"o32sr.cchomestr","sourcebytes":[99,99,72,111,109,101],"value":"ccHome"},
-{"hash":6914115,"name":"o32sr.ccincstr","sourcebytes":[99,99,73,110,99],"value":"ccInc"},
-{"hash":6914131,"name":"o32sr.ccinsstr","sourcebytes":[99,99,73,110,115],"value":"ccIns"},
-{"hash":145752053,"name":"o32sr.cclastpagestr","sourcebytes":[99,99,76,97,115,116,80,97,103,101],"value":"ccLastPage"},
-{"hash":110635988,"name":"o32sr.ccleftstr","sourcebytes":[99,99,76,101,102,116],"value":"ccLeft"},
-{"hash":80496581,"name":"o32sr.ccnewlinestr","sourcebytes":[99,99,78,101,119,76,105,110,101],"value":"ccNewLine"},
-{"hash":218103701,"name":"o32sr.ccnextpagestr","sourcebytes":[99,99,78,101,120,116,80,97,103,101],"value":"ccNextPage"},
-{"hash":132166580,"name":"o32sr.ccpageleftstr","sourcebytes":[99,99,80,97,103,101,76,101,102,116],"value":"ccPageLeft"},
-{"hash":230783876,"name":"o32sr.ccpagerightstr","sourcebytes":[99,99,80,97,103,101,82,105,103,104,116],"value":"ccPageRight"},
-{"hash":159812293,"name":"o32sr.ccpastestr","sourcebytes":[99,99,80,97,115,116,101],"value":"ccPaste"},
-{"hash":147718053,"name":"o32sr.ccprevpagestr","sourcebytes":[99,99,80,114,101,118,80,97,103,101],"value":"ccPrevPage"},
-{"hash":110660527,"name":"o32sr.ccredostr","sourcebytes":[99,99,82,101,100,111],"value":"ccRedo"},
-{"hash":147513093,"name":"o32sr.ccrestorestr","sourcebytes":[99,99,82,101,115,116,111,114,101],"value":"ccRestore"},
-{"hash":159972756,"name":"o32sr.ccrightstr","sourcebytes":[99,99,82,105,103,104,116],"value":"ccRight"},
-{"hash":80235598,"name":"o32sr.ccscrolldownstr","sourcebytes":[99,99,83,99,114,111,108,108,68,111,119,110],"value":"ccScrollDown"},
-{"hash":177523024,"name":"o32sr.ccscrollupstr","sourcebytes":[99,99,83,99,114,111,108,108,85,112],"value":"ccScrollUp"},
-{"hash":85033152,"name":"o32sr.ccsetmarker0str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,48],"value":"ccSetMarker0"},
-{"hash":85033153,"name":"o32sr.ccsetmarker1str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,49],"value":"ccSetMarker1"},
-{"hash":85033154,"name":"o32sr.ccsetmarker2str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,50],"value":"ccSetMarker2"},
-{"hash":85033155,"name":"o32sr.ccsetmarker3str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,51],"value":"ccSetMarker3"},
-{"hash":85033156,"name":"o32sr.ccsetmarker4str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,52],"value":"ccSetMarker4"},
-{"hash":85033157,"name":"o32sr.ccsetmarker5str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,53],"value":"ccSetMarker5"},
-{"hash":85033158,"name":"o32sr.ccsetmarker6str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,54],"value":"ccSetMarker6"},
-{"hash":85033159,"name":"o32sr.ccsetmarker7str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,55],"value":"ccSetMarker7"},
-{"hash":85033160,"name":"o32sr.ccsetmarker8str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,56],"value":"ccSetMarker8"},
-{"hash":85033161,"name":"o32sr.ccsetmarker9str","sourcebytes":[99,99,83,101,116,77,97,114,107,101,114,57],"value":"ccSetMarker9"},
-{"hash":6916722,"name":"o32sr.cctabstr","sourcebytes":[99,99,84,97,98],"value":"ccTab"},
-{"hash":155201908,"name":"o32sr.cctableeditstr","sourcebytes":[99,99,84,97,98,108,101,69,100,105,116],"value":"ccTableEdit"},
-{"hash":39059308,"name":"o32sr.cctopleftcellstr","sourcebytes":[99,99,84,111,112,76,101,102,116,67,101,108,108],"value":"ccTopLeftCell"},
-{"hash":87223477,"name":"o32sr.cctopofpagestr","sourcebytes":[99,99,84,111,112,79,102,80,97,103,101],"value":"ccTopOfPage"},
-{"hash":110675119,"name":"o32sr.ccundostr","sourcebytes":[99,99,85,110,100,111],"value":"ccUndo"},
-{"hash":432320,"name":"o32sr.ccupstr","sourcebytes":[99,99,85,112],"value":"ccUp"},
-{"hash":110080820,"name":"o32sr.ccwordleftstr","sourcebytes":[99,99,87,111,114,100,76,101,102,116],"value":"ccWordLeft"},
-{"hash":150041492,"name":"o32sr.ccwordrightstr","sourcebytes":[99,99,87,111,114,100,82,105,103,104,116],"value":"ccWordRight"},
-{"hash":95129671,"name":"o32sr.stringstr","sourcebytes":[83,116,114,105,110,103],"value":"String"},
-{"hash":302722,"name":"o32sr.charstr","sourcebytes":[67,104,97,114],"value":"Char"},
-{"hash":157690686,"name":"o32sr.booleanstr","sourcebytes":[66,111,111,108,101,97,110],"value":"Boolean"},
-{"hash":6277199,"name":"o32sr.yesnostr","sourcebytes":[89,101,115,78,111],"value":"YesNo"},
-{"hash":56934404,"name":"o32sr.longintstr","sourcebytes":[76,111,110,103,73,110,116],"value":"LongInt"},
-{"hash":386692,"name":"o32sr.wordstr","sourcebytes":[87,111,114,100],"value":"Word"},
-{"hash":58919924,"name":"o32sr.smallintstr","sourcebytes":[83,109,97,108,108,73,110,116],"value":"SmallInt"},
-{"hash":303269,"name":"o32sr.bytestr","sourcebytes":[66,121,116,101],"value":"Byte"},
-{"hash":258575300,"name":"o32sr.shortintstr","sourcebytes":[83,104,111,114,116,73,110,116],"value":"ShortInt"},
-{"hash":363388,"name":"o32sr.realstr","sourcebytes":[82,101,97,108],"value":"Real"},
-{"hash":262950516,"name":"o32sr.extendedstr","sourcebytes":[69,120,116,101,110,100,101,100],"value":"Extended"},
-{"hash":79083813,"name":"o32sr.doublestr","sourcebytes":[68,111,117,98,108,101],"value":"Double"},
-{"hash":94391845,"name":"o32sr.singlestr","sourcebytes":[83,105,110,103,108,101],"value":"Single"},
-{"hash":304704,"name":"o32sr.compstr","sourcebytes":[67,111,109,112],"value":"Comp"},
-{"hash":305317,"name":"o32sr.datestr","sourcebytes":[68,97,116,101],"value":"Date"},
-{"hash":372789,"name":"o32sr.timestr","sourcebytes":[84,105,109,101],"value":"Time"},
-{"hash":14246210,"name":"o32sr.charmask1str","sourcebytes":[88,32,32,97,110,121,32,99,104,97,114,97,99,116,101,114],"value":"X any character"},
-{"hash":176123385,"name":"o32sr.charmask2str","sourcebytes":[33,32,32,97,110,121,32,99,104,97,114,32,40,117,112,112,101,114,41],"value":"! any char (upper)"},
-{"hash":128900505,"name":"o32sr.charmask3str","sourcebytes":[76,32,32,97,110,121,32,99,104,97,114,32,40,108,111,119,101,114,41],"value":"L any char (lower)"},
-{"hash":60353161,"name":"o32sr.charmask4str","sourcebytes":[120,32,32,97,110,121,32,99,104,97,114,32,40,109,105,120,101,100,41],"value":"x any char (mixed)"},
-{"hash":171931113,"name":"o32sr.charmask5str","sourcebytes":[97,32,32,97,108,112,104,97,115,32,111,110,108,121],"value":"a alphas only"},
-{"hash":216715241,"name":"o32sr.charmask6str","sourcebytes":[65,32,32,97,108,112,104,97,115,32,40,117,112,112,101,114,41],"value":"A alphas (upper)"},
-{"hash":238452713,"name":"o32sr.charmask7str","sourcebytes":[108,32,32,97,108,112,104,97,115,32,40,108,111,119,101,114,41],"value":"l alphas (lower)"},
-{"hash":62010121,"name":"o32sr.charmask8str","sourcebytes":[57,32,32,48,45,57],"value":"9 0-9"},
-{"hash":53531917,"name":"o32sr.charmask9str","sourcebytes":[105,32,32,48,45,57,44,32,45],"value":"i 0-9, -"},
-{"hash":162581806,"name":"o32sr.charmask10str","sourcebytes":[35,32,32,48,45,57,44,32,45,44,32,46],"value":"# 0-9, -, ."},
-{"hash":80873294,"name":"o32sr.charmask11str","sourcebytes":[69,32,32,48,45,57,44,32,69,44,32,45,44,32,46],"value":"E 0-9, E, -, ."},
-{"hash":148737417,"name":"o32sr.charmask12str","sourcebytes":[75,32,32,48,45,57,44,32,65,45,70,32,40,104,101,120,41],"value":"K 0-9, A-F (hex)"},
-{"hash":225029081,"name":"o32sr.charmask14str","sourcebytes":[79,32,32,48,45,55,32,40,111,99,116,97,108,41],"value":"O 0-7 (octal)"},
-{"hash":169998697,"name":"o32sr.charmask15str","sourcebytes":[98,32,32,48,44,32,49,32,40,98,105,110,97,114,121,41],"value":"b 0, 1 (binary)"},
-{"hash":149356809,"name":"o32sr.charmask16str","sourcebytes":[66,32,32,84,32,111,114,32,70,32,40,117,112,112,101,114,41],"value":"B T or F (upper)"},
-{"hash":150477273,"name":"o32sr.charmask17str","sourcebytes":[89,32,32,89,32,111,114,32,78,32,40,117,112,112,101,114,41],"value":"Y Y or N (upper)"},
-{"hash":97122065,"name":"o32sr.charmask18str","sourcebytes":[49,32,32,85,115,101,114,32,49],"value":"1 User 1"},
-{"hash":97120274,"name":"o32sr.charmask19str","sourcebytes":[50,32,32,85,115,101,114,32,50],"value":"2 User 2"},
-{"hash":97120531,"name":"o32sr.charmask20str","sourcebytes":[51,32,32,85,115,101,114,32,51],"value":"3 User 3"},
-{"hash":97120788,"name":"o32sr.charmask21str","sourcebytes":[52,32,32,85,115,101,114,32,52],"value":"4 User 4"},
-{"hash":97121045,"name":"o32sr.charmask22str","sourcebytes":[53,32,32,85,115,101,114,32,53],"value":"5 User 5"},
-{"hash":97123350,"name":"o32sr.charmask23str","sourcebytes":[54,32,32,85,115,101,114,32,54],"value":"6 User 6"},
-{"hash":97123607,"name":"o32sr.charmask24str","sourcebytes":[55,32,32,85,115,101,114,32,55],"value":"7 User 7"},
-{"hash":97123864,"name":"o32sr.charmask25str","sourcebytes":[56,32,32,85,115,101,114,32,56],"value":"8 User 8"},
-{"hash":25870412,"name":"o32sr.fieldmask1str","sourcebytes":[36,35,35,44,35,35,35,46,35,35,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,97,110,100,32,112,101,114,105,111,100,32,85,115,101,115,32,102,108,111,97,116,105,110,103,32,99,117,114,114,101,110,99,121,32,115,121,109,98,111,108],"value":"$##,###.## Allows entry of 0 through 9, space, minus, and period Uses floating currency symbol"},
-{"hash":192143781,"name":"o32sr.fieldmask2str","sourcebytes":[57,57,57,57,57,57,57,57,57,57,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,97,110,100,32,115,112,97,99,101],"value":"9999999999 Allows entry of 0 through 9, and space"},
-{"hash":150217363,"name":"o32sr.fieldmask3str","sourcebytes":[105,105,105,105,105,105,105,105,105,105,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,97,110,100,32,109,105,110,117,115],"value":"iiiiiiiiii Allows entry of 0 through 9, space, and minus"},
-{"hash":159131796,"name":"o32sr.fieldmask4str","sourcebytes":[105,105,44,105,105,105,44,105,105,105,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,97,110,100,32,109,105,110,117,115,32,68,105,115,112,108,97,121,115,32,110,117,109,98,101,114,32,115,101,112,97,114,97,116,111,114,115,32,97,115,32,110,101,101,100,101,100],"value":"ii,iii,iii Allows entry of 0 through 9, space, and minus Displays number separators as needed"},
-{"hash":187563852,"name":"o32sr.fieldmask5str","sourcebytes":[36,105,105,105,105,105,105,105,105,105,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,97,110,100,32,109,105,110,117,115,32,85,115,101,115,32,102,108,111,97,116,105,110,103,32,99,117,114,114,101,110,99,121,32,115,121,109,98,111,108],"value":"$iiiiiiiii Allows entry of 0 through 9, space, and minus Uses floating currency symbol"},
-{"hash":91771796,"name":"o32sr.fieldmask6str","sourcebytes":[35,35,35,35,35,35,35,35,35,35,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,97,110,100,32,112,101,114,105,111,100],"value":"########## Allows entry of 0 through 9, space, minus, and period"},
-{"hash":150058862,"name":"o32sr.fieldmask7str","sourcebytes":[35,35,35,35,35,35,35,46,35,35,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,97,110,100,32,112,101,114,105,111,100,32,70,105,120,101,100,32,100,101,99,105,109,97,108,32,112,111,115,105,116,105,111,110],"value":"#######.## Allows entry of 0 through 9, space, minus, and period Fixed decimal position"},
-{"hash":118082020,"name":"o32sr.fieldmask8str","sourcebytes":[35,35,35,44,35,35,35,46,35,35,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,97,110,100,32,112,101,114,105,111,100,32,68,105,115,112,108,97,121,115,32,110,117,109,98,101,114,32,115,101,112,97,114,97,116,111,114,115,32,97,115,32,110,101,101,100,101,100],"value":"###,###.## Allows entry of 0 through 9, space, minus, and period Displays number separators as needed"},
-{"hash":203254956,"name":"o32sr.fieldmask9str","sourcebytes":[36,35,35,35,35,35,35,46,35,35,32,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,97,110,100,32,112,101,114,105,111,100,32,70,105,120,101,100,32,100,101,99,105,109,97,108,32,112,111,115,105,116,105,111,110,32,85,115,101,115,32,102,108,111,97,116,105,110,103,32,99,117,114,114,101,110,99,121,32,115,121,109,98,111,108],"value":"$######.## Allows entry of 0 through 9, space, minus, and period Fixed decimal position Uses floating currency symbol"},
-{"hash":233619849,"name":"o32sr.fieldmask10str","sourcebytes":[35,35,35,35,35,35,35,35,35,35,112,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,97,110,100,32,112,101,114,105,111,100,32,78,101,103,97,116,105,118,101,32,97,109,111,117,110,116,115,32,117,115,101,32,40,41],"value":"##########p Allows entry of 0 through 9, space, minus, and period Negative amounts use ()"},
-{"hash":23482388,"name":"o32sr.fieldmask11str","sourcebytes":[35,35,35,44,35,35,35,46,35,35,67,32,32,32,32,32,32,32,32,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,44,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,97,110,100,32,112,101,114,105,111,100,32,67,117,114,114,101,110,99,121,32,115,121,109,98,111,108,32,97,116,32,114,105,103,104,116],"value":"###,###.##C Allows entry of 0 through 9, space, minus, and period Currency symbol at right"},
-{"hash":174256005,"name":"o32sr.fieldmask12str","sourcebytes":[75,75,75,75,75,75,75,75,32,32,32,32,32,32,32,32,32,32,32,32,72,101,120,97,100,101,99,105,109,97,108,32,40,69,52,52,48,49,70,51,69,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,97,110,100,32,65,32,116,104,114,111,117,103,104,32,70,32,70,111,114,99,101,32,117,112,112,101,114,32,99,97,115,101],"value":"KKKKKKKK Hexadecimal (E4401F3E) Allows entry of 0 through 9 and A through F Force upper case"},
-{"hash":160543589,"name":"o32sr.fieldmask13str","sourcebytes":[75,75,75,75,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,72,101,120,97,100,101,99,105,109,97,108,32,40,49,70,51,69,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,97,110,100,32,65,32,116,104,114,111,117,103,104,32,70,32,70,111,114,99,101,32,117,112,112,101,114,32,99,97,115,101],"value":"KKKK Hexadecimal (1F3E) Allows entry of 0 through 9 and A through F Force upper case"},
-{"hash":54097189,"name":"o32sr.fieldmask14str","sourcebytes":[75,75,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,72,101,120,97,100,101,99,105,109,97,108,32,40,51,69,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,97,110,100,32,65,32,116,104,114,111,117,103,104,32,70,32,70,111,114,99,101,32,117,112,112,101,114,32,99,97,115,101],"value":"KK Hexadecimal (3E) Allows entry of 0 through 9 and A through F Force upper case"},
-{"hash":118534928,"name":"o32sr.fieldmask15str","sourcebytes":[79,79,79,79,79,79,79,79,32,32,32,32,32,32,32,32,32,32,32,32,79,99,116,97,108,32,40,52,53,49,51,53,54,55,55,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,55,32],"value":"OOOOOOOO Octal (45135677) Allows entry of 0 through 7 "},
-{"hash":157956416,"name":"o32sr.fieldmask16str","sourcebytes":[79,79,79,79,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,79,99,116,97,108,32,40,53,54,55,55,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,55,32],"value":"OOOO Octal (5677) Allows entry of 0 through 7 "},
-{"hash":214007281,"name":"o32sr.fieldmask17str","sourcebytes":[98,98,98,98,98,98,98,98,98,98,98,98,98,98,98,98,32,32,32,32,66,105,110,97,114,121,32,40,48,49,48,49,48,48,49,48,49,48,48,49,48,49,48,48,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,97,110,100,32,49],"value":"bbbbbbbbbbbbbbbb Binary (0101001010010100) Allows entry of 0 and 1"},
-{"hash":77656481,"name":"o32sr.fieldmask18str","sourcebytes":[98,98,98,98,98,98,98,98,32,32,32,32,32,32,32,32,32,32,32,32,66,105,110,97,114,121,32,40,49,48,48,49,48,49,48,48,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,97,110,100,32,49],"value":"bbbbbbbb Binary (10010100) Allows entry of 0 and 1"},
-{"hash":6873412,"name":"o32sr.fieldmask19str","sourcebytes":[88,88,88,88,88,88,88,88,88,88,32,32,32,32,32,32,32,32,32,32,65,110,121,32,99,104,97,114,97,99,116,101,114,32,99,97,110,32,98,101,32,101,110,116,101,114,101,100],"value":"XXXXXXXXXX Any character can be entered"},
-{"hash":43546997,"name":"o32sr.fieldmask20str","sourcebytes":[33,33,33,33,33,33,33,33,33,33,32,32,32,32,32,32,32,32,32,32,65,110,121,32,99,104,97,114,97,99,116,101,114,32,99,97,110,32,98,101,32,101,110,116,101,114,101,100,32,65,108,112,104,97,98,101,116,105,99,32,99,104,97,114,97,99,116,101,114,115,32,97,114,101,32,102,111,114,99,101,100,32,116,111,32,117,112,112,101,114,32,99,97,115,101],"value":"!!!!!!!!!! Any character can be entered Alphabetic characters are forced to upper case"},
-{"hash":216754981,"name":"o32sr.fieldmask21str","sourcebytes":[76,76,76,76,76,76,76,76,76,76,32,32,32,32,32,32,32,32,32,32,65,110,121,32,99,104,97,114,97,99,116,101,114,32,99,97,110,32,98,101,32,101,110,116,101,114,101,100,32,65,108,112,104,97,98,101,116,105,99,32,99,104,97,114,97,99,116,101,114,115,32,97,114,101,32,102,111,114,99,101,100,32,116,111,32,108,111,119,101,114,32,99,97,115,101],"value":"LLLLLLLLLL Any character can be entered Alphabetic characters are forced to lower case"},
-{"hash":72846341,"name":"o32sr.fieldmask22str","sourcebytes":[120,120,120,120,120,120,120,120,120,120,32,32,32,32,32,32,32,32,32,32,65,110,121,32,99,104,97,114,97,99,116,101,114,32,99,97,110,32,98,101,32,101,110,116,101,114,101,100,32,85,115,101,115,32,109,105,120,101,100,32,99,97,115,101],"value":"xxxxxxxxxx Any character can be entered Uses mixed case"},
-{"hash":180843617,"name":"o32sr.fieldmask23str","sourcebytes":[97,97,97,97,97,97,97,97,97,97,32,32,32,32,32,32,32,32,32,32,65,108,112,104,97,98,101,116,105,99,32,99,104,97,114,97,99,116,101,114,115,32,112,108,117,115,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,112,101,114,105,111,100,44,32,97,110,100,32,99,111,109,109,97],"value":"aaaaaaaaaa Alphabetic characters plus space, minus, period, and comma"},
-{"hash":259223541,"name":"o32sr.fieldmask24str","sourcebytes":[65,65,65,65,65,65,65,65,65,65,32,32,32,32,32,32,32,32,32,32,65,108,112,104,97,98,101,116,105,99,32,99,104,97,114,97,99,116,101,114,115,32,112,108,117,115,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,112,101,114,105,111,100,44,32,97,110,100,32,99,111,109,109,97,32,65,108,112,104,97,98,101,116,105,99,32,99,104,97,114,97,99,116,101,114,115,32,97,114,101,32,102,111,114,99,101,100,32,116,111,32,117,112,112,101,114,32,99,97,115,101],"value":"AAAAAAAAAA Alphabetic characters plus space, minus, period, and comma Alphabetic characters are forced to upper case"},
-{"hash":155046869,"name":"o32sr.fieldmask25str","sourcebytes":[108,108,108,108,108,108,108,108,108,108,32,32,32,32,32,32,32,32,32,32,65,108,112,104,97,98,101,116,105,99,32,99,104,97,114,97,99,116,101,114,115,32,112,108,117,115,32,115,112,97,99,101,44,32,109,105,110,117,115,44,32,112,101,114,105,111,100,44,32,97,110,100,32,99,111,109,109,97,32,65,108,112,104,97,98,101,116,105,99,32,99,104,97,114,97,99,116,101,114,115,32,97,114,101,32,102,111,114,99,101,100,32,116,111,32,108,111,119,101,114,32,99,97,115,101],"value":"llllllllll Alphabetic characters plus space, minus, period, and comma Alphabetic characters are forced to lower case"},
-{"hash":178904805,"name":"o32sr.fieldmask26str","sourcebytes":[40,57,57,57,41,32,57,57,57,45,57,57,57,57,32,32,32,32,32,32,80,104,111,110,101,32,110,117,109,98,101,114,32,109,97,115,107,32,65,108,108,111,119,115,32,48,32,116,104,114,111,117,103,104,32,57,32,97,110,100,32,115,112,97,99,101],"value":"(999) 999-9999 Phone number mask Allows 0 through 9 and space"},
-{"hash":62017877,"name":"o32sr.fieldmask27str","sourcebytes":[57,57,57,45,57,57,57,45,57,57,57,57,32,32,32,32,32,32,32,32,80,104,111,110,101,32,110,117,109,98,101,114,32,109,97,115,107,32,65,108,108,111,119,115,32,48,32,116,104,114,111,117,103,104,32,57,32,97,110,100,32,115,112,97,99,101],"value":"999-999-9999 Phone number mask Allows 0 through 9 and space"},
-{"hash":107877989,"name":"o32sr.fieldmask28str","sourcebytes":[57,57,57,57,57,45,57,57,57,57,32,32,32,32,32,32,32,32,32,32,85,83,32,90,105,112,32,67,111,100,101,32,109,97,115,107,32,65,108,108,111,119,115,32,48,32,116,104,114,111,117,103,104,32,57,32,97,110,100,32,115,112,97,99,101],"value":"99999-9999 US Zip Code mask Allows 0 through 9 and space"},
-{"hash":159165621,"name":"o32sr.fieldmask29str","sourcebytes":[66,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,66,111,111,108,101,97,110,32,109,97,115,107,32,65,108,108,111,119,115,32,84,44,32,116,44,32,70,44,32,102,32,70,111,114,99,101,115,32,105,110,112,117,116,32,116,111,32,117,112,112,101,114,32,99,97,115,101],"value":"B Boolean mask Allows T, t, F, f Forces input to upper case"},
-{"hash":226688133,"name":"o32sr.fieldmask30str","sourcebytes":[89,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,66,111,111,108,101,97,110,32,109,97,115,107,32,65,108,108,111,119,115,32,89,44,32,121,44,32,78,44,32,110,32,70,111,114,99,101,115,32,105,110,112,117,116,32,116,111,32,117,112,112,101,114,32,99,97,115,101],"value":"Y Boolean mask Allows Y, y, N, n Forces input to upper case"},
-{"hash":239529939,"name":"o32sr.fieldmask31str","sourcebytes":[109,109,47,100,100,47,121,121,32,32,32,32,32,32,32,32,32,32,32,32,68,97,116,101,32,109,97,115,107,32,40,48,49,47,48,53,47,57,54,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,77,111,110,116,104,32,97,110,100,32,68,97,121,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,122,101,114,111,115],"value":"mm\/dd\/yy Date mask (01\/05\/96) Allows entry of 0 through 9 plus space Month and Day are padded with zeros"},
-{"hash":265314611,"name":"o32sr.fieldmask32str","sourcebytes":[109,109,47,100,100,47,121,121,121,121,32,32,32,32,32,32,32,32,32,32,68,97,116,101,32,109,97,115,107,32,40,48,49,47,48,53,47,49,57,57,54,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,77,111,110,116,104,32,97,110,100,32,68,97,121,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,122,101,114,111,115],"value":"mm\/dd\/yyyy Date mask (01\/05\/1996) Allows entry of 0 through 9 plus space Month and Day are padded with zeros"},
-{"hash":140332467,"name":"o32sr.fieldmask33str","sourcebytes":[100,100,32,110,110,110,32,121,121,121,121,32,32,32,32,32,32,32,32,32,68,97,116,101,32,109,97,115,107,32,40,48,53,32,74,97,110,32,49,57,57,54,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,68,97,121,32,105,115,32,112,97,100,100,101,100,32,119,105,116,104,32,122,101,114,111,115],"value":"dd nnn yyyy Date mask (05 Jan 1996) Allows entry of 0 through 9 plus space Day is padded with zeros"},
-{"hash":60758483,"name":"o32sr.fieldmask34str","sourcebytes":[77,77,47,68,68,47,121,121,32,32,32,32,32,32,32,32,32,32,32,32,68,97,116,101,32,109,97,115,107,32,40,32,49,47,32,53,47,57,54,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,77,111,110,116,104,32,97,110,100,32,68,97,121,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,115,112,97,99,101,115],"value":"MM\/DD\/yy Date mask ( 1\/ 5\/96) Allows entry of 0 through 9 plus space Month and Day are padded with spaces"},
-{"hash":129420707,"name":"o32sr.fieldmask35str","sourcebytes":[77,77,47,68,68,47,121,121,121,121,32,32,32,32,32,32,32,32,32,32,68,97,116,101,32,109,97,115,107,32,40,32,49,47,32,53,47,49,57,57,54,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,77,111,110,116,104,32,97,110,100,32,68,97,121,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,115,112,97,99,101,115],"value":"MM\/DD\/yyyy Date mask ( 1\/ 5\/1996) Allows entry of 0 through 9 plus space Month and Day are padded with spaces"},
-{"hash":162411587,"name":"o32sr.fieldmask36str","sourcebytes":[68,68,32,110,110,110,32,121,121,121,121,32,32,32,32,32,32,32,32,32,68,97,116,101,32,109,97,115,107,32,40,32,53,32,74,97,110,32,49,57,57,54,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,68,97,121,32,105,115,32,112,97,100,100,101,100,32,119,105,116,104,32,115,112,97,99,101,115],"value":"DD nnn yyyy Date mask ( 5 Jan 1996) Allows entry of 0 through 9 plus space Day is padded with spaces"},
-{"hash":115637257,"name":"o32sr.fieldmask37str","sourcebytes":[104,104,58,109,109,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,84,105,109,101,32,109,97,115,107,32,40,48,51,58,50,53,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,72,111,117,114,115,32,97,110,100,32,109,105,110,117,116,101,115,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,122,101,114,111,115,32,40,50,52,32,104,111,117,114,32,99,108,111,99,107,41],"value":"hh:mm Time mask (03:25) Allows entry of 0 through 9 plus space Hours and minutes are padded with zeros (24 hour clock)"},
-{"hash":110050003,"name":"o32sr.fieldmask38str","sourcebytes":[104,104,58,109,109,32,116,116,32,32,32,32,32,32,32,32,32,32,32,32,84,105,109,101,32,109,97,115,107,32,40,48,51,58,50,53,32,112,109,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,72,111,117,114,115,32,97,110,100,32,109,105,110,117,116,101,115,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,122,101,114,111,115],"value":"hh:mm tt Time mask (03:25 pm) Allows entry of 0 through 9 plus space Hours and minutes are padded with zeros"},
-{"hash":119359011,"name":"o32sr.fieldmask39str","sourcebytes":[104,104,58,109,109,58,115,115,32,32,32,32,32,32,32,32,32,32,32,32,84,105,109,101,32,109,97,115,107,32,40,48,51,58,50,53,58,48,55,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,72,111,117,114,115,44,32,109,105,110,117,116,101,115,44,32,97,110,100,32,115,101,99,111,110,100,115,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,122,101,114,111,115],"value":"hh:mm:ss Time mask (03:25:07) Allows entry of 0 through 9 plus space Hours, minutes, and seconds are padded with zeros"},
-{"hash":151520073,"name":"o32sr.fieldmask40str","sourcebytes":[72,72,58,77,77,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,84,105,109,101,32,109,97,115,107,32,40,32,51,58,50,53,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,72,111,117,114,115,32,97,110,100,32,109,105,110,117,116,101,115,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,115,112,97,99,101,115,32,40,50,52,32,104,111,117,114,32,99,108,111,99,107,41],"value":"HH:MM Time mask ( 3:25) Allows entry of 0 through 9 plus space Hours and minutes are padded with spaces (24 hour clock)"},
-{"hash":156598435,"name":"o32sr.fieldmask41str","sourcebytes":[72,72,58,77,77,32,116,116,32,32,32,32,32,32,32,32,32,32,32,32,84,105,109,101,32,109,97,115,107,32,40,32,51,58,50,53,32,112,109,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,72,111,117,114,115,32,97,110,100,32,109,105,110,117,116,101,115,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,115,112,97,99,101,115],"value":"HH:MM tt Time mask ( 3:25 pm) Allows entry of 0 through 9 plus space Hours and minutes are padded with spaces"},
-{"hash":105549971,"name":"o32sr.fieldmask42str","sourcebytes":[72,72,58,77,77,58,83,83,32,32,32,32,32,32,32,32,32,32,32,32,84,105,109,101,32,109,97,115,107,32,40,32,51,58,50,53,58,32,55,41,32,65,108,108,111,119,115,32,101,110,116,114,121,32,111,102,32,48,32,116,104,114,111,117,103,104,32,57,32,112,108,117,115,32,115,112,97,99,101,32,72,111,117,114,115,44,32,109,105,110,117,116,101,115,44,32,97,110,100,32,115,101,99,111,110,100,115,32,97,114,101,32,112,97,100,100,101,100,32,119,105,116,104,32,115,112,97,99,101,115],"value":"HH:MM:SS Time mask ( 3:25: 7) Allows entry of 0 through 9 plus space Hours, minutes, and seconds are padded with spaces"}
-]}
diff --git a/Source/3rdParty/Synapse/source/demo/FreePascal/testdns.pas b/Source/3rdParty/Synapse/source/demo/FreePascal/testdns.pas
deleted file mode 100644
index ed179d8d..00000000
--- a/Source/3rdParty/Synapse/source/demo/FreePascal/testdns.pas
+++ /dev/null
@@ -1,28 +0,0 @@
-{$MODE DELPHI}
-
-Program testdns;
-
-uses
- dnssend, synamisc, classes;
-
-var
- l: tstringlist;
- s: string;
-begin
- l := TStringList.create;
- try
- s := GetDNS;
- writeln('DNS servers: ', s);
- l.commatext := s;
- if l.count > 0 then
- begin
- s := l[0];
- GetMailServers(s, paramstr(1), l);
- Writeln('MX records for domain ', paramstr(1), ':');
- writeln(l.text);
- end;
- finally
- l.free;
- end;
-end.
-
diff --git a/Source/3rdParty/Synapse/source/demo/FreePascal/testhttp.pas b/Source/3rdParty/Synapse/source/demo/FreePascal/testhttp.pas
deleted file mode 100644
index 64458d31..00000000
--- a/Source/3rdParty/Synapse/source/demo/FreePascal/testhttp.pas
+++ /dev/null
@@ -1,34 +0,0 @@
-{$MODE DELPHI}
-
-Program testhttp;
-
-uses
- httpsend, classes;
-
-var
- HTTP: THTTPSend;
- l: tstringlist;
-begin
- HTTP := THTTPSend.Create;
- l := TStringList.create;
- try
- if not HTTP.HTTPMethod('GET', Paramstr(1)) then
- begin
- writeln('ERROR');
- writeln(Http.Resultcode);
- end
- else
- begin
- writeln(Http.Resultcode, ' ', Http.Resultstring);
- writeln;
- writeln(Http.headers.text);
- writeln;
- l.loadfromstream(Http.Document);
- writeln(l.text);
- end;
- finally
- HTTP.Free;
- l.free;
- end;
-end.
-
diff --git a/Source/3rdParty/Synapse/source/demo/FreePascal/testmime.pas b/Source/3rdParty/Synapse/source/demo/FreePascal/testmime.pas
deleted file mode 100644
index bdaa281c..00000000
--- a/Source/3rdParty/Synapse/source/demo/FreePascal/testmime.pas
+++ /dev/null
@@ -1,38 +0,0 @@
-{$MODE DELPHI}
-
-Program testmime;
-
-uses
- mimepart, classes;
-
-type
- Tc = class(TObject)
- public
- class procedure ph(const Sender: TMimePart);
- end;
-
-class procedure Tc.ph(const Sender: TMimePart);
-begin
- Sender.DecodePart;
- Sender.EncodePart;
-end;
-
-var
- l: tstringlist;
- m:tmimepart;
-begin
- l := TStringList.create;
- m := tmimepart.create;
- try
- m.OnWalkPart:=tc.ph;
- m.Lines.LoadFromFile(paramstr(1));
- m.DecomposeParts;
- m.WalkPart;
- m.ComposeParts;
- m.Lines.SaveToFile(paramstr(1) + '.repack');
- finally
- m.free;
- l.free;
- end;
-end.
-
diff --git a/Source/3rdParty/Synapse/source/demo/FreePascal/testping.pas b/Source/3rdParty/Synapse/source/demo/FreePascal/testping.pas
deleted file mode 100644
index ba97d2dc..00000000
--- a/Source/3rdParty/Synapse/source/demo/FreePascal/testping.pas
+++ /dev/null
@@ -1,19 +0,0 @@
-{$MODE DELPHI}
-
-Program testping;
-
-uses
- pingsend, sysutils;
-
-var
- ping:TPingSend;
-begin
- ping:=TPingSend.Create;
- try
- ping.ping(ParamStr(1));
- Writeln (IntTostr(ping.pingtime));
- finally
- ping.Free;
- end;
-end.
-
diff --git a/Source/3rdParty/Synapse/source/demo/FreePascal/testroute.pas b/Source/3rdParty/Synapse/source/demo/FreePascal/testroute.pas
deleted file mode 100644
index ebe5aaed..00000000
--- a/Source/3rdParty/Synapse/source/demo/FreePascal/testroute.pas
+++ /dev/null
@@ -1,11 +0,0 @@
-{$MODE DELPHI}
-
-Program testroute;
-
-uses
- pingsend;
-
-begin
- Writeln (TracerouteHost(paramstr(1)));
-end.
-
diff --git a/Source/3rdParty/Synapse/source/demo/FreePascal/testssl.pas b/Source/3rdParty/Synapse/source/demo/FreePascal/testssl.pas
deleted file mode 100644
index 98c3e81b..00000000
--- a/Source/3rdParty/Synapse/source/demo/FreePascal/testssl.pas
+++ /dev/null
@@ -1,36 +0,0 @@
-{$MODE DELPHI}
-
-Program testssl;
-
-uses
- blcksock, synassl;
-
-var
- sock: TTCPBlockSocket;
-begin
- sock := TTCPBlockSocket.create;
- try
- sock.SSLEnabled:=True;
- writeln('Used OpenSSL library:');
- writeln(SSLLibFile);
- writeln(SSLUtilFile);
- sock.Connect(paramstr(1),paramstr(2));
- if sock.lasterror <> 0 then
- begin
- writeln('Error connecting!');
- exit;
- end;
- writeln;
- writeln('SSL version: ', sock.SSLGetSSLVersion);
- writeln('Cipher: ', sock.SSLGetCiphername);
- writeln('Cipher bits: ', sock.SSLGetCipherBits);
- writeln('Cipher alg. bits: ', sock.SSLGetCipherAlgBits);
- writeln('Certificate verify result: ', sock.SslGetVerifyCert);
- writeln('Certificate peer name: ', sock.SSLGetPeerName);
- writeln(sock.SSLGetCertInfo);
- sock.closesocket;
- finally
- sock.free;
- end;
-end.
-
diff --git a/Source/3rdParty/Synapse/source/demo/MailCheck/MailCheck.dof b/Source/3rdParty/Synapse/source/demo/MailCheck/MailCheck.dof
deleted file mode 100644
index 311aa565..00000000
--- a/Source/3rdParty/Synapse/source/demo/MailCheck/MailCheck.dof
+++ /dev/null
@@ -1,75 +0,0 @@
-[Compiler]
-A=1
-B=0
-C=1
-D=1
-E=0
-F=0
-G=1
-H=1
-I=1
-J=1
-K=0
-L=1
-M=0
-N=1
-O=1
-P=1
-Q=0
-R=0
-S=0
-T=0
-U=0
-V=1
-W=0
-X=1
-Y=0
-Z=1
-ShowHints=1
-ShowWarnings=1
-UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-[Linker]
-MapFile=0
-OutputObjs=0
-ConsoleApp=1
-DebugInfo=0
-MinStackSize=16384
-MaxStackSize=1048576
-ImageBase=4194304
-ExeDescription=
-[Directories]
-OutputDir=
-UnitOutputDir=
-SearchPath=
-Packages=vclx30;VCL30;vcldb30;vcldbx30;inetdb30;inet30;VclSmp30;Qrpt30;teeui30;teedb30;tee30;dss30;IBEVNT30
-Conditionals=
-DebugSourceDirs=
-UsePackages=0
-[Parameters]
-RunParams=
-HostApplication=
-[Version Info]
-IncludeVerInfo=0
-AutoIncBuild=0
-MajorVer=1
-MinorVer=0
-Release=0
-Build=0
-Debug=0
-PreRelease=0
-Special=0
-Private=0
-DLL=0
-Locale=1029
-CodePage=1250
-[Version Info Keys]
-CompanyName=
-FileDescription=
-FileVersion=1.0.0.0
-InternalName=
-LegalCopyright=
-LegalTrademarks=
-OriginalFilename=
-ProductName=
-ProductVersion=1.0.0.0
-Comments=
diff --git a/Source/3rdParty/Synapse/source/demo/MailCheck/MailCheck.dpr b/Source/3rdParty/Synapse/source/demo/MailCheck/MailCheck.dpr
deleted file mode 100644
index 51faa9b6..00000000
--- a/Source/3rdParty/Synapse/source/demo/MailCheck/MailCheck.dpr
+++ /dev/null
@@ -1,14 +0,0 @@
-program MailCheck;
-
-uses
- Forms,
- Unit1 in 'Unit1.pas' {Form1},
- mailchck in 'mailchck.pas';
-
-{$R *.RES}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/MailCheck/Unit1.dfm b/Source/3rdParty/Synapse/source/demo/MailCheck/Unit1.dfm
deleted file mode 100644
index 2198c447..00000000
Binary files a/Source/3rdParty/Synapse/source/demo/MailCheck/Unit1.dfm and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/demo/MailCheck/Unit1.pas b/Source/3rdParty/Synapse/source/demo/MailCheck/Unit1.pas
deleted file mode 100644
index 4e424714..00000000
--- a/Source/3rdParty/Synapse/source/demo/MailCheck/Unit1.pas
+++ /dev/null
@@ -1,36 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls, mailchck;
-
-type
- TForm1 = class(TForm)
- Label1: TLabel;
- Edit1: TEdit;
- Label2: TLabel;
- Button1: TButton;
- procedure Button1Click(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$R *.DFM}
-
-procedure TForm1.Button1Click(Sender: TObject);
-begin
- label2.caption := 'testing...';
- form1.Repaint;
- Label2.caption := IntToStr(mailcheck(Edit1.text));
-end;
-
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/MailCheck/mailchck.pas b/Source/3rdParty/Synapse/source/demo/MailCheck/mailchck.pas
deleted file mode 100644
index 4c50c93d..00000000
--- a/Source/3rdParty/Synapse/source/demo/MailCheck/mailchck.pas
+++ /dev/null
@@ -1,107 +0,0 @@
-unit mailchck;
-
-interface
-
-uses
- dnssend, smtpsend, synautil, classes, synamisc;
-
-function mailcheck(email:string):integer;
-
-implementation
-
-{
-0 - address exists
-1 - address may exists
-2 - your DNS nannot working (cannot check!)
-3 - your DNS is not defined (cannot check!)
-4 - cannot contact any MX servers (cannot check!);
-5 - domain not have MX record
-6 - address not exists
-7 - address is bad!
-}
-
-function mailcheck(email:string):integer;
-var
- smtp:TSMTPsend;
- domain:string;
- user: string;
- mailservers:tstringlist;
- dnsservers:tstringlist;
- x: integer;
- n, m: integer;
- b: boolean;
-begin
- result:=7;
- email:=getemailaddr(email);
- x := pos('@', email);
- if x <= 0 then
- exit; //invalid address format
- domain:=separateright(email,'@');
- user:=separateLeft(email,'@');
- if (domain = '') or (user = '') then
- exit; //invalid address format
- smtp:=tsmtpsend.create;
- mailservers:=tstringlist.create;
- dnsservers:=tstringlist.create;
- try
- dnsservers.CommaText := GetDNS;
- result := 3;
- if dnsservers.Count = 0 then
- Exit; // not DNS servers defined
- result := 2;
- b := false;
- for n := 0 to dnsservers.Count -1 do
- if GetMailServers(dnsservers[n], domain, mailservers) then
- begin
- b := true;
- break;
- end;
- if not b then
- Exit; // DNS cannot be contacted
- result := 5;
- if mailservers.Count = 0 then
- exit; // not defined MX record for requested domain
- b := false;
- for n := 0 to mailservers.count - 1 do
- begin
- smtp.TargetHost := mailservers[n];
- if not smtp.Login then
- Continue;
- b := true;
- if smtp.Verify(email) then
- begin
- if smtp.ResultCode < 252 then
- begin
- Result := 0; // user address confirmed!
- break;
- end;
- end
- else
- if smtp.ResultCode = 551 then
- begin
- Result := 6; // user address not confirmed!
- break;
- end;
- if not smtp.MailFrom('mailcheck@somewhere.com', 100) then
- Continue;
- if not smtp.MailTo(email) then
- begin
- Result := 6; // user address not confirmed!
- break;
- end
- else
- begin
- Result := 1; // address MAY exists
- break;
- end;
- end;
- if not b then
- result := 4; //cannot contact any mailserver;
- finally
- dnsservers.free;
- mailservers.free;
- smtp.free;
- end;
-end;
-
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/TFTPClient/MainBox.dfm b/Source/3rdParty/Synapse/source/demo/TFTPClient/MainBox.dfm
deleted file mode 100644
index a42e6f5f..00000000
--- a/Source/3rdParty/Synapse/source/demo/TFTPClient/MainBox.dfm
+++ /dev/null
@@ -1,130 +0,0 @@
-object Form1: TForm1
- Left = 535
- Top = 430
- Width = 314
- Height = 251
- Caption = 'Simple TFTP-Client'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'MS Sans Serif'
- Font.Style = []
- OldCreateOrder = False
- Position = poScreenCenter
- DesignSize = (
- 306
- 224)
- PixelsPerInch = 96
- TextHeight = 13
- object Label2: TLabel
- Left = 8
- Top = 146
- Width = 65
- Height = 13
- Anchors = [akLeft, akBottom]
- Caption = 'TargetSystem'
- end
- object Label3: TLabel
- Left = 199
- Top = 146
- Width = 50
- Height = 13
- Anchors = [akRight, akBottom]
- Caption = 'TargetPort'
- end
- object Label4: TLabel
- Left = 8
- Top = 170
- Width = 76
- Height = 13
- Anchors = [akLeft, akBottom]
- Caption = 'FileName to Get'
- end
- object Log: TMemo
- Left = 8
- Top = 8
- Width = 289
- Height = 129
- Anchors = [akLeft, akTop, akRight, akBottom]
- ScrollBars = ssVertical
- TabOrder = 0
- end
- object BExit: TButton
- Left = 222
- Top = 194
- Width = 55
- Height = 23
- Anchors = [akBottom]
- Caption = 'E&xit'
- TabOrder = 1
- OnClick = BExitClick
- end
- object BAbout: TButton
- Left = 27
- Top = 194
- Width = 55
- Height = 23
- Anchors = [akBottom]
- Caption = '&About'
- TabOrder = 2
- OnClick = BAboutClick
- end
- object TargetSystemEdit: TEdit
- Left = 88
- Top = 143
- Width = 104
- Height = 21
- Anchors = [akLeft, akRight, akBottom]
- TabOrder = 3
- Text = '127.0.0.1'
- end
- object TargetPortEdit: TEdit
- Left = 255
- Top = 143
- Width = 41
- Height = 21
- Anchors = [akRight, akBottom]
- TabOrder = 4
- Text = '69'
- end
- object TargetFileEdit: TEdit
- Left = 88
- Top = 167
- Width = 208
- Height = 21
- Anchors = [akLeft, akRight, akBottom]
- TabOrder = 5
- end
- object BGetFile: TButton
- Left = 94
- Top = 194
- Width = 55
- Height = 23
- Anchors = [akBottom]
- Caption = '&Get File'
- TabOrder = 6
- OnClick = BGetFileClick
- end
- object BPutFile: TButton
- Left = 158
- Top = 194
- Width = 55
- Height = 23
- Anchors = [akBottom]
- Caption = '&Put File'
- TabOrder = 7
- OnClick = BPutFileClick
- end
- object OpenDialog: TOpenDialog
- FilterIndex = 0
- Title = 'Select File to put ...'
- Left = 16
- Top = 16
- end
- object SaveDialog: TSaveDialog
- Title = 'Save File ...'
- Left = 48
- Top = 16
- end
-end
diff --git a/Source/3rdParty/Synapse/source/demo/TFTPClient/MainBox.pas b/Source/3rdParty/Synapse/source/demo/TFTPClient/MainBox.pas
deleted file mode 100644
index 74418380..00000000
--- a/Source/3rdParty/Synapse/source/demo/TFTPClient/MainBox.pas
+++ /dev/null
@@ -1,124 +0,0 @@
-unit MainBox;
-
-interface
-
-uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls, FTPTSend;
-
-type
- TForm1 = class(TForm)
- Log: TMemo;
- BExit: TButton;
- BAbout: TButton;
- Label2: TLabel;
- Label3: TLabel;
- Label4: TLabel;
- TargetSystemEdit: TEdit;
- TargetPortEdit: TEdit;
- TargetFileEdit: TEdit;
- BGetFile: TButton;
- BPutFile: TButton;
- OpenDialog: TOpenDialog;
- SaveDialog: TSaveDialog;
- procedure BAboutClick(Sender: TObject);
- procedure BExitClick(Sender: TObject);
- procedure BPutFileClick(Sender: TObject);
- procedure BGetFileClick(Sender: TObject);
- private
- { Private-Deklarationen }
- TFTPClient:TTFTPSend;
- public
- { Public-Deklarationen }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$R *.dfm}
-
-procedure TForm1.BAboutClick(Sender: TObject);
-begin
- // Show a little About-Box
- Application.MessageBox('Synapse Demo Application, (c) 2003 by Christian Brosius','About...',MB_OK);
-end;
-
-procedure TForm1.BExitClick(Sender: TObject);
-begin
- // Close the TFTP-Client
- Close;
-end;
-
-procedure TForm1.BPutFileClick(Sender: TObject);
-begin
- if OpenDialog.Execute
- then
- begin
- // Create TFTPClient
- TFTPClient := TTFTPSend.Create;
- Log.Lines.Add('TFTPClient created');
-
- // Set Target-Parameter
- TFTPClient.TargetHost := TargetSystemEdit.Text;
- Log.Lines.Add('TargetSystem is ' + TFTPClient.TargetHost);
- TFTPClient.TargetPort := TargetPortEdit.Text;
- Log.Lines.Add('TargetPort is ' + TFTPClient.TargetPort);
-
- // Try sending file
- Log.Lines.Add('Try to send ' + OpenDialog.FileName);
- TFTPClient.Data.LoadFromFile(OpenDialog.FileName);
- if TFTPClient.SendFile(ExtractFileName(OpenDialog.FileName))
- then
- begin
- // Filetransfer successful
- Log.Lines.Add('File successfully sent to TFTPServer');
- end
- else
- begin
- // Filetransfer not successful
- Log.Lines.Add('Error while sending File to TFTPServer');
- Log.Lines.Add('Error #' + IntToStr(TFTPClient.ErrorCode) + ' - ' + TFTPClient.ErrorString);
- end;
- // Free TFTPClient
- TFTPClient.Free;
- Log.Lines.Add('TFTPClient destroyed');
- end;
-end;
-
-procedure TForm1.BGetFileClick(Sender: TObject);
-begin
- // Create TFTPClient
- TFTPClient := TTFTPSend.Create;
- Log.Lines.Add('TFTPClient created');
-
- // Set Target-Parameter
- TFTPClient.TargetHost := TargetSystemEdit.Text;
- Log.Lines.Add('TargetSystem is ' + TFTPClient.TargetHost);
- TFTPClient.TargetPort := TargetPortEdit.Text;
- Log.Lines.Add('TargetPort is ' + TFTPClient.TargetPort);
-
- // Try sending file
- Log.Lines.Add('Try to get "' + TargetFileEdit.Text + '"');
- if TFTPClient.RecvFile(TargetFileEdit.Text)
- then
- begin
- // Filetransfer successful
- Log.Lines.Add('File successfully get from TFTPServer');
- SaveDialog.FileName := TargetFileEdit.Text;
- if SaveDialog.Execute
- then TFTPClient.Data.SaveToFile(SaveDialog.FileName);
- end
- else
- begin
- // Filetransfer not successful
- Log.Lines.Add('Error while getting File from TFTPServer');
- Log.Lines.Add(IntToStr(TFTPClient.ErrorCode) + ' - ' + TFTPClient.ErrorString);
- end;
- // Free TFTPClient
- TFTPClient.Free;
- Log.Lines.Add('TFTPClient destroyed');
-end;
-
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/TFTPClient/TFTPClient.dpr b/Source/3rdParty/Synapse/source/demo/TFTPClient/TFTPClient.dpr
deleted file mode 100644
index ef32ed06..00000000
--- a/Source/3rdParty/Synapse/source/demo/TFTPClient/TFTPClient.dpr
+++ /dev/null
@@ -1,13 +0,0 @@
-program TFTPClient;
-
-uses
- Forms,
- MainBox in 'MainBox.pas' {Form1};
-
-{$R *.res}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/TFTPServer/MainBox.dfm b/Source/3rdParty/Synapse/source/demo/TFTPServer/MainBox.dfm
deleted file mode 100644
index c1970219..00000000
--- a/Source/3rdParty/Synapse/source/demo/TFTPServer/MainBox.dfm
+++ /dev/null
@@ -1,67 +0,0 @@
-object MainForm: TMainForm
- Left = 276
- Top = 417
- Width = 503
- Height = 270
- Caption = 'Simple TFTP-Server'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -14
- Font.Name = 'MS Sans Serif'
- Font.Style = []
- OldCreateOrder = False
- Position = poScreenCenter
- OnCreate = FormCreate
- DesignSize = (
- 495
- 238)
- PixelsPerInch = 120
- TextHeight = 16
- object Label1: TLabel
- Left = 10
- Top = 199
- Width = 30
- Height = 16
- Anchors = [akLeft, akBottom]
- Caption = 'Path:'
- end
- object Log: TMemo
- Left = 8
- Top = 0
- Width = 481
- Height = 186
- Anchors = [akLeft, akTop, akRight, akBottom]
- ScrollBars = ssVertical
- TabOrder = 0
- end
- object BExit: TButton
- Left = 483
- Top = 261
- Width = 86
- Height = 31
- Anchors = [akBottom]
- Caption = 'E&xit'
- TabOrder = 1
- OnClick = BExitClick
- end
- object BAbout: TButton
- Left = 37
- Top = 261
- Width = 86
- Height = 31
- Anchors = [akBottom]
- Caption = '&About'
- TabOrder = 2
- OnClick = BAboutClick
- end
- object PathEdit: TEdit
- Left = 72
- Top = 196
- Width = 413
- Height = 21
- Anchors = [akLeft, akRight, akBottom]
- TabOrder = 3
- Text = 'C:\'
- end
-end
diff --git a/Source/3rdParty/Synapse/source/demo/TFTPServer/MainBox.pas b/Source/3rdParty/Synapse/source/demo/TFTPServer/MainBox.pas
deleted file mode 100644
index 1690e971..00000000
--- a/Source/3rdParty/Synapse/source/demo/TFTPServer/MainBox.pas
+++ /dev/null
@@ -1,50 +0,0 @@
-unit MainBox;
-
-interface
-
-uses
- Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
- Dialogs, StdCtrls, TFTPDaemonThread;
-
-type
- TMainForm = class(TForm)
- Log: TMemo;
- BExit: TButton;
- BAbout: TButton;
- Label1: TLabel;
- PathEdit: TEdit;
- procedure BExitClick(Sender: TObject);
- procedure BAboutClick(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- private
- { Private-Deklarationen }
- TFTPD:TTFTPDaemonThread;
- public
- { Public-Deklarationen }
- end;
-
-var
- MainForm: TMainForm;
-
-implementation
-
-{$R *.dfm}
-
-procedure TMainForm.BAboutClick(Sender: TObject);
-begin
- // Show a little About-Box
- Application.MessageBox('Synapse Demo Application, (c) 2003 by Christian Brosius','About...',MB_OK);
-end;
-
-procedure TMainForm.BExitClick(Sender: TObject);
-begin
- // Close the TFTP-Server
- Close;
-end;
-
-procedure TMainForm.FormCreate(Sender: TObject);
-begin
- TFTPD := TTFTPDaemonThread.Create('0.0.0.0','69');
-end;
-
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/TFTPServer/TFTPDaemonThread.pas b/Source/3rdParty/Synapse/source/demo/TFTPServer/TFTPDaemonThread.pas
deleted file mode 100644
index 74deb7d6..00000000
--- a/Source/3rdParty/Synapse/source/demo/TFTPServer/TFTPDaemonThread.pas
+++ /dev/null
@@ -1,129 +0,0 @@
-{
- TFTP supports five types of packets, all of which have been mentioned
- above:
- opcode operation
-
- 1 Read request (RRQ)
- 2 Write request (WRQ)
- 3 Data (DATA)
- 4 Acknowledgment (ACK)
- 5 Error (ERROR)
-
-
- Error Codes
- Value Meaning
-
- 0 Not defined, see error message (if any).
- 1 File not found.
- 2 Access violation.
- 3 Disk full or allocation exceeded.
- 4 Illegal TFTP operation.
- 5 Unknown transfer ID.
- 6 File already exists.
- 7 No such user.
-
-
-}
-
-unit TFTPDaemonThread;
-
-interface
-
-uses Classes, SysUtils, FTPTSend;
-
-type
- TTFTPDaemonThread = class(TThread)
- private
- { Private declarations }
- TFTPDaemon:TTFTPSend;
- FIPAdress:String;
- FPort:String;
- FLogMessage:String;
- procedure UpdateLog;
- protected
- procedure Execute; override;
- public
- constructor Create(IPAdress,Port:String);
- end;
-
-implementation
-
-uses MainBox;
-
-constructor TTFTPDaemonThread.Create(IPAdress,Port:String);
-begin
- FIPAdress := IPAdress;
- FPort := Port;
- inherited Create(False);
-end;
-
-procedure TTFTPDaemonThread.UpdateLOG;
-begin
- MainForm.Log.Lines.Add(FLogMessage);
-end;
-
-procedure TTFTPDaemonThread.Execute;
-var RequestType:Word;
- FileName:String;
-begin
- TFTPDaemon := TTFTPSend.Create;
- FLogMessage := 'ServerThread created on Port ' + FPort;
- Synchronize(UpdateLog);
- TFTPDaemon.TargetHost := FIPAdress;
- TFTPDaemon.TargetPort := FPort;
- try
- while not terminated do
- begin
- if TFTPDaemon.WaitForRequest(RequestType,FileName)
- then
- begin
- // Fill the Log-Memo whith Infos about the request
- case RequestType of
- 1:FLogMessage := 'Read-Request from '
- + TFTPDaemon.RequestIP + ':' + TFTPDaemon.RequestPort;
- 2:FLogMessage := 'Write-Request from '
- + TFTPDaemon.RequestIP + ':' + TFTPDaemon.RequestPort;
- end;
- Synchronize(UpdateLog);
- FLogMessage := 'File: ' + Filename;
- Synchronize(UpdateLog);
-
- // Process the Request
- case RequestType of
- 1:begin // Read request (RRQ)
- if FileExists(MainForm.PathEdit.Text + FileName)
- then
- begin
- TFTPDaemon.Data.LoadFromFile(MainForm.PathEdit.Text + FileName);
- if TFTPDaemon.ReplySend
- then
- begin
- FLogMessage := '"' + MainForm.PathEdit.Text + FileName + '" successfully sent.';
- Synchronize(UpdateLog);
- end;
- end
- else TFTPDaemon.ReplyError(1,'File not Found');
- end;
- 2:begin // Write request (WRQ)
- if not FileExists(MainForm.PathEdit.Text + FileName)
- then
- begin
- if TFTPDaemon.ReplyRecv
- then
- begin
- TFTPDaemon.Data.SaveToFile(MainForm.PathEdit.Text + FileName);
- FLogMessage := 'File sucessfully stored to ' + MainForm.PathEdit.Text + FileName;
- Synchronize(UpdateLog);
- end;
- end
- else TFTPDaemon.ReplyError(6,'File already exists');
- end;
- end;
- end;
- end;
- finally
- TFTPDaemon.Free;
- end;
-end;
-
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/TFTPServer/TFTPServer.dpr b/Source/3rdParty/Synapse/source/demo/TFTPServer/TFTPServer.dpr
deleted file mode 100644
index ab8a4117..00000000
--- a/Source/3rdParty/Synapse/source/demo/TFTPServer/TFTPServer.dpr
+++ /dev/null
@@ -1,14 +0,0 @@
-program TFTPServer;
-
-uses
- Forms,
- MainBox in 'MainBox.pas' {MainForm},
- TFTPDaemonThread in 'TFTPDaemonThread.pas';
-
-{$R *.res}
-
-begin
- Application.Initialize;
- Application.CreateForm(TMainForm, MainForm);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/echo/EchoSrv.dof b/Source/3rdParty/Synapse/source/demo/echo/EchoSrv.dof
deleted file mode 100644
index 07e95e46..00000000
--- a/Source/3rdParty/Synapse/source/demo/echo/EchoSrv.dof
+++ /dev/null
@@ -1,80 +0,0 @@
-[Compiler]
-A=1
-B=0
-C=1
-D=1
-E=0
-F=0
-G=1
-H=1
-I=1
-J=1
-K=0
-L=1
-M=0
-N=1
-O=1
-P=1
-Q=0
-R=0
-S=0
-T=0
-U=0
-V=1
-W=0
-X=1
-Y=0
-Z=1
-ShowHints=1
-ShowWarnings=1
-UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-
-[Linker]
-MapFile=0
-OutputObjs=0
-ConsoleApp=1
-DebugInfo=0
-MinStackSize=16384
-MaxStackSize=1048576
-ImageBase=4194304
-ExeDescription=
-
-[Directories]
-OutputDir=
-UnitOutputDir=
-SearchPath=
-Packages=VCLX30;VCL30;VCLDB30;VCLDBX30;INETDB30;INET30;VCLSMP30;QRPT30;TEEUI30;TEEDB30;TEE30;DSS30;IBEVNT30;RXCTL;RXDB;RXTOOLS
-Conditionals=
-DebugSourceDirs=
-UsePackages=0
-
-[Parameters]
-RunParams=
-HostApplication=
-
-[Version Info]
-IncludeVerInfo=0
-AutoIncBuild=0
-MajorVer=1
-MinorVer=0
-Release=0
-Build=0
-Debug=0
-PreRelease=0
-Special=0
-Private=0
-DLL=0
-Locale=1029
-CodePage=1250
-
-[Version Info Keys]
-CompanyName=
-FileDescription=
-FileVersion=1.0.0.0
-InternalName=
-LegalCopyright=
-LegalTrademarks=
-OriginalFilename=
-ProductName=
-ProductVersion=1.0.0.0
-Comments=
diff --git a/Source/3rdParty/Synapse/source/demo/echo/EchoSrv.dpr b/Source/3rdParty/Synapse/source/demo/echo/EchoSrv.dpr
deleted file mode 100644
index 77ebdfed..00000000
--- a/Source/3rdParty/Synapse/source/demo/echo/EchoSrv.dpr
+++ /dev/null
@@ -1,14 +0,0 @@
-program EchoSrv;
-
-uses
- Forms,
- main in 'main.pas' {Form1},
- echo in 'echo.pas';
-
-{$R *.RES}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/echo/echo.pas b/Source/3rdParty/Synapse/source/demo/echo/echo.pas
deleted file mode 100644
index 994ea522..00000000
--- a/Source/3rdParty/Synapse/source/demo/echo/echo.pas
+++ /dev/null
@@ -1,96 +0,0 @@
-unit echo;
-
-interface
-
-uses
- Classes, blcksock, synsock;
-
-type
- TTCPEchoDaemon = class(TThread)
- private
- Sock:TTCPBlockSocket;
- public
- Constructor Create;
- Destructor Destroy; override;
- procedure Execute; override;
- end;
-
- TTCPEchoThrd = class(TThread)
- private
- Sock:TTCPBlockSocket;
- CSock: TSocket;
- public
- Constructor Create (hsock:tSocket);
- procedure Execute; override;
- end;
-
-implementation
-
-{ TEchoDaemon }
-
-Constructor TTCPEchoDaemon.Create;
-begin
- inherited create(false);
- sock:=TTCPBlockSocket.create;
- FreeOnTerminate:=true;
-end;
-
-Destructor TTCPEchoDaemon.Destroy;
-begin
- Sock.free;
-end;
-
-procedure TTCPEchoDaemon.Execute;
-var
- ClientSock:TSocket;
-begin
- with sock do
- begin
- CreateSocket;
- setLinger(true,10000);
- bind('0.0.0.0','8008');
- listen;
- repeat
- if terminated then break;
- if canread(1000) then
- begin
- ClientSock:=accept;
- if lastError=0 then TTCPEchoThrd.create(ClientSock);
- end;
- until false;
- end;
-end;
-
-{ TEchoThrd }
-
-Constructor TTCPEchoThrd.Create(Hsock:TSocket);
-begin
- inherited create(false);
- Csock := Hsock;
- FreeOnTerminate:=true;
-end;
-
-procedure TTCPEchoThrd.Execute;
-var
- s: string;
-begin
- sock:=TTCPBlockSocket.create;
- try
- Sock.socket:=CSock;
- sock.GetSins;
- with sock do
- begin
- repeat
- if terminated then break;
- s := RecvPacket(60000);
- if lastError<>0 then break;
- SendString(s);
- if lastError<>0 then break;
- until false;
- end;
- finally
- Sock.Free;
- end;
-end;
-
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/echo/main.dfm b/Source/3rdParty/Synapse/source/demo/echo/main.dfm
deleted file mode 100644
index 60ec78ca..00000000
Binary files a/Source/3rdParty/Synapse/source/demo/echo/main.dfm and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/demo/echo/main.pas b/Source/3rdParty/Synapse/source/demo/echo/main.pas
deleted file mode 100644
index 7e9a560e..00000000
--- a/Source/3rdParty/Synapse/source/demo/echo/main.pas
+++ /dev/null
@@ -1,31 +0,0 @@
-unit main;
-
-interface
-
-uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls, echo;
-
-type
- TForm1 = class(TForm)
- Button1: TButton;
- procedure Button1Click(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$R *.DFM}
-
-procedure TForm1.Button1Click(Sender: TObject);
-begin
- TTCPEchoDaemon.create;
-end;
-
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/ftpserv/data/some_dir/some_third_file.txt b/Source/3rdParty/Synapse/source/demo/ftpserv/data/some_dir/some_third_file.txt
deleted file mode 100644
index b1a17ba1..00000000
--- a/Source/3rdParty/Synapse/source/demo/ftpserv/data/some_dir/some_third_file.txt
+++ /dev/null
@@ -1 +0,0 @@
-zzz
diff --git a/Source/3rdParty/Synapse/source/demo/ftpserv/data/some_file.txt b/Source/3rdParty/Synapse/source/demo/ftpserv/data/some_file.txt
deleted file mode 100644
index d6459e00..00000000
--- a/Source/3rdParty/Synapse/source/demo/ftpserv/data/some_file.txt
+++ /dev/null
@@ -1 +0,0 @@
-xxx
diff --git a/Source/3rdParty/Synapse/source/demo/ftpserv/data/some_other_file.txt b/Source/3rdParty/Synapse/source/demo/ftpserv/data/some_other_file.txt
deleted file mode 100644
index 35954da2..00000000
--- a/Source/3rdParty/Synapse/source/demo/ftpserv/data/some_other_file.txt
+++ /dev/null
@@ -1 +0,0 @@
-yyy
\ No newline at end of file
diff --git a/Source/3rdParty/Synapse/source/demo/ftpserv/ftpmain.pas b/Source/3rdParty/Synapse/source/demo/ftpserv/ftpmain.pas
deleted file mode 100644
index f2e5fd3f..00000000
--- a/Source/3rdParty/Synapse/source/demo/ftpserv/ftpmain.pas
+++ /dev/null
@@ -1,67 +0,0 @@
-unit ftpmain;
-
-{$IFDEF FPC}
- {$mode delphi}
-{$endif}
-
-interface
-
-uses
-{$IFDEF LINUX}
- Libc,
-{$ELSE}
- Windows,
-{$ENDIF}
- Classes, SysUtils, ftpthrd, blcksock, synsock;
-
-type
- TServiceThread = class(TThread)
- private
- { Private declarations }
- protected
- procedure Execute; override;
- public
- constructor Create;
- end;
-
-
-implementation
-
-{==============================================================================}
-{ TServiceThread }
-
-constructor TServiceThread.create;
-begin
- inherited create(false);
- FreeOnTerminate := false;
-// Priority := tpNormal;
-end;
-
-procedure TServiceThread.Execute;
-var
- ClientSock: TSocket;
- sock: TTCPBlockSocket;
-begin
- sock := TTCPBlockSocket.Create;
- try
- sock.bind('0.0.0.0','21');
- sock.setLinger(true, 10000);
- sock.listen;
- if sock.LastError <> 0 then
- exit;
- while not terminated do
- begin
- if sock.canread(1000) then
- begin
- ClientSock := sock.accept;
- if sock. lastError = 0 then
- TFtpServerThread.create(ClientSock);
- end;
- end;
- finally
- sock.Free;
- end;
-end;
-
-{==============================================================================}
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/ftpserv/ftpserv.dpr b/Source/3rdParty/Synapse/source/demo/ftpserv/ftpserv.dpr
deleted file mode 100644
index 1092cf22..00000000
--- a/Source/3rdParty/Synapse/source/demo/ftpserv/ftpserv.dpr
+++ /dev/null
@@ -1,15 +0,0 @@
-program ftpserv;
-
-uses
- Forms,
- main in 'main.pas' {Form1},
- ftpthrd in 'ftpthrd.pas',
- ftpmain in 'ftpmain.pas';
-
-{$R *.RES}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/ftpserv/ftpthrd.pas b/Source/3rdParty/Synapse/source/demo/ftpserv/ftpthrd.pas
deleted file mode 100644
index de88d1a9..00000000
--- a/Source/3rdParty/Synapse/source/demo/ftpserv/ftpthrd.pas
+++ /dev/null
@@ -1,373 +0,0 @@
-unit FtpThrd;
-
-{$IFDEF FPC}
- {$mode delphi}
-{$endif}
-
-interface
-
-uses
-{$IFDEF LINUX}
- Libc,
-{$ELSE}
- Windows,
-{$ENDIF}
- Classes, SysUtils, blcksock, synsock, synautil, filectrl;
-
-type
- TFtpServerThread = class(TThread)
- private
- clients: TSocket;
- FDataIP, FDataPort: string;
- protected
- procedure Execute; override;
- procedure send(const sock: TTcpBlocksocket; value: string);
- procedure ParseRemote(Value: string);
- function buildname(dir, value: string): string;
- function buildrealname(value: string): string;
- function buildlist(value: string): string;
- public
- constructor Create(sock: TSocket);
- end;
-
-implementation
-
-const
- timeout = 60000;
- MyMonthNames: array[1..12] of AnsiString =
- ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
- 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
-
-
-{==============================================================================}
-{ TFtpServerThread }
-
-constructor TFtpServerThread.create(sock: TSocket);
-begin
- inherited create(false);
- FreeOnTerminate := true;
- clients := sock;
-// Priority := tpNormal;
-end;
-
-procedure TFtpServerThread.send(const sock: TTcpBlocksocket; value: string);
-begin
- sock.SendString(value + CRLF);
-end;
-
-procedure TFtpServerThread.ParseRemote(Value: string);
-var
- n: integer;
- nb, ne: integer;
- s: string;
- x: integer;
-begin
- Value := trim(Value);
- nb := Pos('(',Value);
- ne := Pos(')',Value);
- if (nb = 0) or (ne = 0) then
- begin
- nb:=RPos(' ',Value);
- s:=Copy(Value, nb + 1, Length(Value) - nb);
- end
- else
- begin
- s:=Copy(Value,nb+1,ne-nb-1);
- end;
- for n := 1 to 4 do
- if n = 1 then
- FDataIP := Fetch(s, ',')
- else
- FDataIP := FDataIP + '.' + Fetch(s, ',');
- x := StrToIntDef(Fetch(s, ','), 0) * 256;
- x := x + StrToIntDef(Fetch(s, ','), 0);
- FDataPort := IntToStr(x);
-end;
-
-function TFtpServerThread.buildname(dir, value: string): string;
-begin
- if value = '' then
- begin
- result := dir;
- exit;
- end;
- if value[1] = '/' then
- result := value
- else
- if (dir <> '') and (dir[length(dir)] = '/') then
- Result := dir + value
- else
- Result := dir + '/' + value;
-end;
-
-function TFtpServerThread.buildrealname(value: string): string;
-begin
- value := replacestring(value, '..', '.');
- value := replacestring(value, '/', '\');
- result := '.\data' + value;
-end;
-
-function fdate(value: integer): string;
-var
- st: tdatetime;
- wYear, wMonth, wDay: word;
-begin
- st := filedatetodatetime(value);
- DecodeDate(st, wYear, wMonth, wDay);
- Result:= Format('%d %s %d', [wday, MyMonthNames[wMonth], wyear]);
-end;
-
-function TFtpServerThread.buildlist(value: string): string;
-var
- SearchRec: TSearchRec;
- r: integer;
- s: string;
-begin
- result := '';
- if value = '' then
- exit;
- if value[length(value)] <> '\' then
- value := value + '\';
- R := FindFirst(value + '*.*', faanyfile, SearchRec);
- while r = 0 do
- begin
- if ((searchrec.Attr and faHidden) = 0)
- and ((searchrec.Attr and faSysFile) = 0)
- and ((searchrec.Attr and faVolumeID) = 0) then
- begin
- s := '';
- if (searchrec.Attr and faDirectory) > 0 then
- begin
- if (searchrec.Name <> '.') and (searchrec.Name <> '..') then
- begin
- s := s + 'drwxrwxrwx 1 root root 1 ';
- s := s + fdate(searchrec.time) + ' ';
- s := s + searchrec.name;
- end;
- end
- else
- begin
- s := s + '-rwxrwxrwx 1 root other ';
- s := s + inttostr(searchrec.Size) + ' ';
- s := s + fdate(searchrec.time) + ' ';
- s := s + searchrec.name;
- end;
- if s <> '' then
- Result := Result + s + CRLF;
- end;
- r := findnext(SearchRec);
- end;
- Findclose(searchrec);
-end;
-
-procedure TFtpServerThread.Execute;
-var
- sock, dsock: TTCPBlockSocket;
- s, t: string;
- authdone: boolean;
- user: string;
- cmd, par: string;
- pwd: string;
- st: TFileStream;
-begin
- sock := TTCPBlockSocket.Create;
- dsock := TTCPBlockSocket.Create;
- try
- sock.Socket := clients;
- send(sock, '220 welcome ' + sock.GetRemoteSinIP + '!');
- authdone := false;
- user := '';
- repeat
- s := sock.RecvString(timeout);
- cmd := uppercase(separateleft(s, ' '));
- par := separateright(s, ' ');
- if sock.lasterror <> 0 then
- exit;
- if terminated then
- exit;
- if cmd = 'USER' then
- begin
- user := par;
- send(sock, '331 Please specify the password.');
- continue;
- end;
- if cmd = 'PASS' then
- begin
- //user verification...
- if ((user = 'username') and (par = 'password'))
- or (user = 'anonymous') then
- begin
- send(sock, '230 Login successful.');
- authdone := true;
- continue;
- end;
- end;
- send(sock, '500 Syntax error, command unrecognized.');
- until authdone;
-
- pwd := '/';
- repeat
- s := sock.RecvString(timeout);
- cmd := uppercase(separateleft(s, ' '));
- par := separateright(s, ' ');
- if par = s then
- par := '';
- if sock.lasterror <> 0 then
- exit;
- if terminated then
- exit;
- if cmd = 'QUIT' then
- begin
- send(sock, '221 Service closing control connection.');
- break;
- end;
- if cmd = 'NOOP' then
- begin
- send(sock, '200 tjadydadydadydaaaaa!');
- continue;
- end;
- if cmd = 'PWD' then
- begin
- send(sock, '257 ' + Quotestr(pwd, '"'));
- continue;
- end;
- if cmd = 'CWD' then
- begin
- t := unquotestr(par, '"');
- t := buildname(pwd, t);
- if directoryexists(Buildrealname(t)) then
- begin
- pwd := t;
- send(sock, '250 OK ' + t);
- end
- else
- send(sock, '550 Requested action not taken.');
- continue;
- end;
- if cmd = 'MKD' then
- begin
- t := unquotestr(par, '"');
- t := buildname(pwd, t);
- if CreateDir(Buildrealname(t)) then
- begin
- pwd := t;
- send(sock, '257 "' + t + '" directory created');
- end
- else
- send(sock, '521 "' + t + '" Requested action not taken.');
- continue;
- end;
- if cmd = 'CDUP' then
- begin
- pwd := '/';
- send(sock, '250 OK');
- continue;
- end;
- if (cmd = 'TYPE')
- or (cmd = 'ALLO')
- or (cmd = 'STRU')
- or (cmd = 'MODE') then
- begin
- send(sock, '200 OK');
- continue;
- end;
- if cmd = 'PORT' then
- begin
- Parseremote(par);
- send(sock, '200 OK');
- continue;
- end;
- if cmd = 'LIST' then
- begin
- t := unquotestr(par, '"');
- t := buildname(pwd, t);
- dsock.CloseSocket;
- dsock.Connect(Fdataip, Fdataport);
- if dsock.LastError <> 0 then
- send(sock, '425 Can''t open data connection.')
- else
- begin
- send(sock, '150 OK ' + t);
- dsock.SendString(buildlist(buildrealname(t)));
- send(sock, '226 OK ' + t);
- end;
- dsock.CloseSocket;
- continue;
- end;
- if cmd = 'RETR' then
- begin
- t := unquotestr(par, '"');
- t := buildname(pwd, t);
- if fileexists(buildrealname(t)) then
- begin
- dsock.CloseSocket;
- dsock.Connect(Fdataip, Fdataport);
- dsock.SetLinger(true, 10000);
- if dsock.LastError <> 0 then
- send(sock, '425 Can''t open data connection.')
- else
- begin
- send(sock, '150 OK ' + t);
- try
- st := TFileStream.Create(buildrealname(t), fmOpenRead or fmShareDenyWrite);
- try
- dsock.SendStreamRaw(st);
- finally
- st.free;
- end;
- send(sock, '226 OK ' + t);
- except
- on exception do
- send(sock, '451 Requested action aborted: local error in processing.');
- end;
- end;
- dsock.CloseSocket;
- end
- else
- send(sock, '550 File unavailable. ' + t);
- continue;
- end;
- if cmd = 'STOR' then
- begin
- t := unquotestr(par, '"');
- t := buildname(pwd, t);
- if directoryexists(extractfiledir(buildrealname(t))) then
- begin
- dsock.CloseSocket;
- dsock.Connect(Fdataip, Fdataport);
- dsock.SetLinger(true, 10000);
- if dsock.LastError <> 0 then
- send(sock, '425 Can''t open data connection.')
- else
- begin
- send(sock, '150 OK ' + t);
- try
- st := TFileStream.Create(buildrealname(t), fmCreate or fmShareDenyWrite);
- try
- dsock.RecvStreamRaw(st, timeout);
- finally
- st.free;
- end;
- send(sock, '226 OK ' + t);
- except
- on exception do
- send(sock, '451 Requested action aborted: local error in processing.');
- end;
- end;
- dsock.CloseSocket;
- end
- else
- send(sock, '553 Directory not exists. ' + t);
- continue;
- end;
- send(sock, '500 Syntax error, command unrecognized.');
- until false;
-
- finally
- dsock.free;
- sock.free;
- end;
-end;
-
-{==============================================================================}
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/ftpserv/main.dfm b/Source/3rdParty/Synapse/source/demo/ftpserv/main.dfm
deleted file mode 100644
index 60e45758..00000000
Binary files a/Source/3rdParty/Synapse/source/demo/ftpserv/main.dfm and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/demo/ftpserv/main.pas b/Source/3rdParty/Synapse/source/demo/ftpserv/main.pas
deleted file mode 100644
index 25fad92d..00000000
--- a/Source/3rdParty/Synapse/source/demo/ftpserv/main.pas
+++ /dev/null
@@ -1,31 +0,0 @@
-unit main;
-
-interface
-
-uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls, ftpmain;
-
-type
- TForm1 = class(TForm)
- Button1: TButton;
- procedure Button1Click(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$R *.DFM}
-
-procedure TForm1.Button1Click(Sender: TObject);
-begin
- TServiceThread.create;
-end;
-
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/http/Unit1.dfm b/Source/3rdParty/Synapse/source/demo/http/Unit1.dfm
deleted file mode 100644
index 85034066..00000000
Binary files a/Source/3rdParty/Synapse/source/demo/http/Unit1.dfm and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/demo/http/Unit1.pas b/Source/3rdParty/Synapse/source/demo/http/Unit1.pas
deleted file mode 100644
index 9b4034e2..00000000
--- a/Source/3rdParty/Synapse/source/demo/http/Unit1.pas
+++ /dev/null
@@ -1,148 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- HTTPSend, StdCtrls, ExtCtrls;
-
-type
- TForm1 = class(TForm)
- Panel1: TPanel;
- Panel2: TPanel;
- Panel3: TPanel;
- Panel4: TPanel;
- Memo1: TMemo;
- Memo2: TMemo;
- Label1: TLabel;
- Edit1: TEdit;
- Button1: TButton;
- Label2: TLabel;
- Label3: TLabel;
- Edit2: TEdit;
- Button2: TButton;
- Label4: TLabel;
- Label5: TLabel;
- Edit3: TEdit;
- Label6: TLabel;
- Edit4: TEdit;
- Label7: TLabel;
- Label8: TLabel;
- Edit5: TEdit;
- Button3: TButton;
- Label9: TLabel;
- Edit6: TEdit;
- Edit7: TEdit;
- Label10: TLabel;
- Panel5: TPanel;
- Label11: TLabel;
- Label12: TLabel;
- Edit8: TEdit;
- Edit9: TEdit;
- Label13: TLabel;
- procedure Button1Click(Sender: TObject);
- procedure Button2Click(Sender: TObject);
- procedure Button3Click(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$R *.DFM}
-
-function ProxyHttpPostURL(const URL, URLData: string; const Data: TStream): Boolean;
-var
- HTTP: THTTPSend;
-begin
- HTTP := THTTPSend.Create;
- try
- HTTP.ProxyHost := Form1.Edit8.Text;
- HTTP.ProxyPort := Form1.Edit9.Text;
- HTTP.Document.Write(Pointer(URLData)^, Length(URLData));
- HTTP.MimeType := 'application/x-www-form-urlencoded';
- Result := HTTP.HTTPMethod('POST', URL);
- Data.CopyFrom(HTTP.Document, 0);
- finally
- HTTP.Free;
- end;
-end;
-
-function ProxyHttpPostFile(const URL, FieldName, FileName: string;
- const Data: TStream; const ResultData: TStrings): Boolean;
-const
- CRLF = #$0D + #$0A;
-var
- HTTP: THTTPSend;
- Bound, s: string;
-begin
- Bound := IntToHex(Random(MaxInt), 8) + '_Synapse_boundary';
- HTTP := THTTPSend.Create;
- try
- HTTP.ProxyHost := Form1.Edit8.Text;
- HTTP.ProxyPort := Form1.Edit9.Text;
- s := '--' + Bound + CRLF;
- s := s + 'content-disposition: form-data; name="' + FieldName + '";';
- s := s + ' filename="' + FileName +'"' + CRLF;
- s := s + 'Content-Type: Application/octet-string' + CRLF + CRLF;
- HTTP.Document.Write(Pointer(s)^, Length(s));
- HTTP.Document.CopyFrom(Data, 0);
- s := CRLF + '--' + Bound + '--' + CRLF;
- HTTP.Document.Write(Pointer(s)^, Length(s));
- HTTP.MimeType := 'multipart/form-data, boundary=' + Bound;
- Result := HTTP.HTTPMethod('POST', URL);
- ResultData.LoadFromStream(HTTP.Document);
- finally
- HTTP.Free;
- end;
-end;
-
-
-procedure TForm1.Button1Click(Sender: TObject);
-var
- HTTP: THTTPSend;
-begin
- HTTP := THTTPSend.Create;
- try
- HTTP.ProxyHost := Edit8.Text;
- HTTP.ProxyPort := Edit9.Text;
- HTTP.HTTPMethod('GET', Edit1.text);
- Memo1.Lines.Assign(HTTP.Headers);
- Memo2.Lines.LoadFromStream(HTTP.Document);
- finally
- HTTP.Free;
- end;
-end;
-
-procedure TForm1.Button2Click(Sender: TObject);
-var
- st: TMemoryStream;
-begin
- st:=TMemoryStream.Create;
- try
- ProxyHTTPpostURL(Edit2.Text, Edit3.Text + '=' + Edit4.Text, st);
- st.Seek(0,soFromBeginning);
- Memo2.Lines.LoadFromStream(st);
- finally
- st.Free;
- end;
-end;
-
-procedure TForm1.Button3Click(Sender: TObject);
-var
- st: TFileStream;
-begin
- st := TFileStream.Create(Edit7.Text, fmOpenRead or fmShareDenyWrite);
- try
- ProxyHTTPPostFile(Edit5.Text, Edit6.Text, ExtractFilename(Edit7.Text), st, TStringList(memo2.Lines));
- finally
- st.Free;
- end;
-end;
-
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/http/httpdemo.dof b/Source/3rdParty/Synapse/source/demo/http/httpdemo.dof
deleted file mode 100644
index 41339f8a..00000000
--- a/Source/3rdParty/Synapse/source/demo/http/httpdemo.dof
+++ /dev/null
@@ -1,80 +0,0 @@
-[Compiler]
-A=1
-B=0
-C=1
-D=1
-E=0
-F=0
-G=1
-H=1
-I=1
-J=1
-K=0
-L=1
-M=0
-N=1
-O=1
-P=1
-Q=0
-R=0
-S=0
-T=0
-U=0
-V=1
-W=0
-X=1
-Y=0
-Z=1
-ShowHints=1
-ShowWarnings=1
-UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-
-[Linker]
-MapFile=0
-OutputObjs=0
-ConsoleApp=1
-DebugInfo=0
-MinStackSize=16384
-MaxStackSize=1048576
-ImageBase=4194304
-ExeDescription=
-
-[Directories]
-OutputDir=
-UnitOutputDir=
-SearchPath=
-Packages=
-Conditionals=
-DebugSourceDirs=
-UsePackages=0
-
-[Parameters]
-RunParams=
-HostApplication=
-
-[Version Info]
-IncludeVerInfo=0
-AutoIncBuild=0
-MajorVer=1
-MinorVer=0
-Release=0
-Build=0
-Debug=0
-PreRelease=0
-Special=0
-Private=0
-DLL=0
-Locale=1029
-CodePage=1250
-
-[Version Info Keys]
-CompanyName=
-FileDescription=
-FileVersion=1.0.0.0
-InternalName=
-LegalCopyright=
-LegalTrademarks=
-OriginalFilename=
-ProductName=
-ProductVersion=1.0.0.0
-Comments=
diff --git a/Source/3rdParty/Synapse/source/demo/http/httpdemo.dpr b/Source/3rdParty/Synapse/source/demo/http/httpdemo.dpr
deleted file mode 100644
index 5aa27f68..00000000
--- a/Source/3rdParty/Synapse/source/demo/http/httpdemo.dpr
+++ /dev/null
@@ -1,13 +0,0 @@
-program httpdemo;
-
-uses
- Forms,
- Unit1 in 'Unit1.pas' {Form1};
-
-{$R *.RES}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/http/web/post.htm b/Source/3rdParty/Synapse/source/demo/http/web/post.htm
deleted file mode 100644
index a4e8c0c8..00000000
--- a/Source/3rdParty/Synapse/source/demo/http/web/post.htm
+++ /dev/null
@@ -1,16 +0,0 @@
-
-
-
-
- Untitled
-
-
-
-
-
-
-
-
diff --git a/Source/3rdParty/Synapse/source/demo/http/web/postfile.htm b/Source/3rdParty/Synapse/source/demo/http/web/postfile.htm
deleted file mode 100644
index 7d34ea23..00000000
--- a/Source/3rdParty/Synapse/source/demo/http/web/postfile.htm
+++ /dev/null
@@ -1,15 +0,0 @@
-
-
-
-
- Untitled
-
-
-
-
-
-
-
diff --git a/Source/3rdParty/Synapse/source/demo/http/web/postfileresult.php b/Source/3rdParty/Synapse/source/demo/http/web/postfileresult.php
deleted file mode 100644
index 222680a2..00000000
--- a/Source/3rdParty/Synapse/source/demo/http/web/postfileresult.php
+++ /dev/null
@@ -1,11 +0,0 @@
-
-
- Example
-
-
- Temp filename:
- Uploaded filename:
- Uploaded size:
- Uploaded MIME type:
-
-
diff --git a/Source/3rdParty/Synapse/source/demo/http/web/postresult.php b/Source/3rdParty/Synapse/source/demo/http/web/postresult.php
deleted file mode 100644
index efec78b7..00000000
--- a/Source/3rdParty/Synapse/source/demo/http/web/postresult.php
+++ /dev/null
@@ -1,8 +0,0 @@
-
-
- Example
-
-
-
-
-
diff --git a/Source/3rdParty/Synapse/source/demo/httpproxy/ProxyThrd.pas b/Source/3rdParty/Synapse/source/demo/httpproxy/ProxyThrd.pas
deleted file mode 100644
index bee500de..00000000
--- a/Source/3rdParty/Synapse/source/demo/httpproxy/ProxyThrd.pas
+++ /dev/null
@@ -1,559 +0,0 @@
-unit ProxyThrd;
-
-interface
-
-uses
- Classes, SyncObjs, SysUtils, windows,
- blcksock, synsock, synautil;
-
-type
- TServiceThread = class(TThread)
- protected
- procedure Execute; override;
- public
- constructor Create;
- end;
-
- TLogRec = record
- ip: string;
- dt: TDateTime;
- req: string;
- stat: string;
- len: integer;
- ref: string;
- agent: string;
- end;
-
- TTCPHttpThrd = class(TThread)
- private
- csock: TSocket;
- public
- timeout: integer;
- Headers: TStringList;
- ProxyHeaders: TStringList;
- IdStr: string;
- LogRec: TLogRec;
- Constructor Create (hsock:tSocket);
- Destructor Destroy; override;
- procedure Execute; override;
- function RelayTCP(const fsock, dsock: TTCPBlockSocket): boolean;
- function RelaySock(const fsock, dsock: TTCPBlockSocket; Size: integer): boolean;
- procedure ReturnHTML(const sock: TTCPBlockSocket; const value, stat: string);
- procedure Return502(const sock: TTCPBlockSocket; host, port: string);
- procedure WriteAccessLog(const LogRec: TLogRec);
- end;
-
-
-procedure InitService;
-procedure DestroyService;
-procedure Writelog(value: string);
-
-var
- CS: TCriticalSection;
-
-implementation
-
-{==============================================================================}
-
-procedure InitService;
-begin
- CS := TCriticalSection.create;
-end;
-
-procedure DestroyService;
-begin
- cs.free;
-end;
-
-procedure Writelog(value: string);
-var
- f: textFile;
- s: string;
-begin
- CS.Enter;
- s := Value;
- s := extractfilepath(ParamStr(0)) + 'access.log';
- assignfile(f, s);
- if fileexists(s)
- then append(f)
- else rewrite(f);
- try
- writeln(f, Value);
- finally
- Closefile(f);
- CS.Leave;
- end;
-end;
-
-{==============================================================================}
-{ TServiceThread }
-
-constructor TServiceThread.create;
-begin
- FreeOnTerminate := false;
- inherited create(false);
-end;
-
-procedure TServiceThread.Execute;
-var
- sock: TTCPBlockSocket;
- ClientSock: TSocket;
-begin
- sock := TTCPBlockSocket.Create;
- try
- sock.bind('0.0.0.0','3128');
- if sock.LastError <> 0 then
- begin
- WriteLog('!!! BIND failed !!!');
- Exit;
- end;
- sock.setLinger(true,10000);
- sock.listen;
- repeat
- if terminated then
- break;
- if sock.canread(1000) then
- begin
- //new connection... launch TTCPHttpThrd
- ClientSock := sock.accept;
- if sock.lastError = 0 then
- TTCPHttpThrd.create(ClientSock);
- end;
- until false;
- finally
- sock.free;
- end;
-end;
-
-{==============================================================================}
-
-{ TTCPHttpThrd }
-
-Constructor TTCPHttpThrd.Create(Hsock:TSocket);
-begin
- csock := hsock;
- Headers := TStringList.Create;
- ProxyHeaders := TStringList.Create;
- FreeOnTerminate:=true;
- inherited create(false);
-end;
-
-Destructor TTCPHttpThrd.Destroy;
-begin
- Headers.Free;
- Proxyheaders.Free;
- inherited Destroy;
-end;
-
-//do both direction TCP proxy tunnel. (used by CONNECT method for https proxying)
-function TTCPHttpThrd.RelayTCP(const fsock, dsock: TTCPBlockSocket): boolean;
-var
- n: integer;
- buf: string;
- ql, rl: TList;
- fgsock, dgsock: TTCPBlockSocket;
- FDSet: TFDSet;
- FDSetSave: TFDSet;
- TimeVal: PTimeVal;
- TimeV: TTimeVal;
-begin
- result := false;
- //buffer maybe contains some pre-readed datas...
- if fsock.LineBuffer <> '' then
- begin
- buf := fsock.RecvPacket(timeout);
- if fsock.LastError <> 0 then
- Exit;
- dsock.SendString(buf);
- end;
- //begin relaying of TCP
- ql := TList.Create;
- rl := Tlist.create;
- try
- TimeV.tv_usec := (Timeout mod 1000) * 1000;
- TimeV.tv_sec := Timeout div 1000;
- TimeVal := @TimeV;
- if Timeout = -1 then
- TimeVal := nil;
- FD_ZERO(FDSetSave);
- FD_SET(fsock.Socket, FDSetSave);
- FD_SET(dsock.Socket, FDSetSave);
- FDSet := FDSetSave;
- while synsock.Select(65535, @FDSet, nil, nil, TimeVal) > 0 do
- begin
- rl.clear;
- if FD_ISSET(fsock.Socket, FDSet) then
- rl.Add(fsock);
- if FD_ISSET(dsock.Socket, FDSet) then
- rl.Add(dsock);
- for n := 0 to rl.Count - 1 do
- begin
- fgsock := TTCPBlockSocket(rl[n]);
- if fgsock = fsock then
- dgsock := dsock
- else
- dgsock := fsock;
- if fgsock.WaitingData > 0 then
- begin
- buf := fgsock.RecvPacket(0);
- dgsock.SendString(buf);
- if dgsock.LastError <> 0 then
- exit;
- end
- else
- exit;
- end;
- FDSet := FDSetSave;
- end;
- finally
- rl.free;
- ql.free;
- end;
- result := true;
-end;
-
-//transmit X bytes from fsock to dsock
-function TTCPHttpThrd.RelaySock(const fsock, dsock: TTCPBlockSocket; Size: integer): boolean;
-var
- sh, sl: integer;
- n: integer;
- buf: string;
-begin
- result := false;
- sh := size div c64k;
- sl := size mod c64k;
- for n := 1 to sh do
- begin
- buf := fsock.RecvBufferStr(c64k, timeout);
- if fsock.LastError <> 0 then
- Exit;
- dsock.SendString(buf);
- if dsock.LastError <> 0 then
- Exit;
- end;
- if sl > 0 then
- begin
- buf := fsock.RecvBufferStr(sl, timeout);
- if fsock.LastError <> 0 then
- Exit;
- dsock.SendString(buf);
- if dsock.LastError <> 0 then
- Exit;
- end;
- result := true;
-end;
-
-//core of proxy
-procedure TTCPHttpThrd.Execute;
-var
- Sock: TTCPBlockSocket;
- QSock: TTCPBlockSocket;
- s: string;
- method, uri, protocol: string;
- size: integer;
- Prot, User, Pass, Host, Port, Path, Para: string;
- chunked: boolean;
- status: integer;
- proxykeep: boolean;
- lasthost: String;
- rprotocol: String;
-begin
- idstr := inttostr(self.handle) + ' ';
- sock:=TTCPBlockSocket.create;
- Qsock:=TTCPBlockSocket.create;
- try
- Sock.socket:=CSock;
- timeout := 120000;
- lasthost := '';
- qsock.ConvertLineEnd := true;
- sock.ConvertLineEnd := true;
-
- repeat
- //read request line
- headers.Clear;
- proxyheaders.Clear;
- proxykeep := false;
- LogRec.ip := sock.GetRemoteSinIP;
- repeat
- s := sock.RecvString(timeout);
- if sock.lasterror <> 0 then
- Exit;
- LogRec.dt := now;
- LogRec.req := s;
- Logrec.stat := '';
- LogRec.len := 0;
- Logrec.Ref := '';
- Logrec.Agent := '';
- until s <> '';
- if s = '' then
- Exit;
- method := fetch(s, ' ');
- if (s = '') or (method = '') then
- Exit;
- uri := fetch(s, ' ');
- if uri = '' then
- Exit;
- protocol := fetch(s, ' ');
- size := 0;
- //read request headers
- if protocol <> '' then
- begin
- if pos('HTTP/', protocol) <> 1 then
- Exit;
- repeat
- s := sock.RecvString(Timeout);
- if sock.lasterror <> 0 then
- Exit;
- if s <> '' then
- begin
- if pos('PROXY-', uppercase(s)) = 1 then
- proxyHeaders.add(s)
- else
- Headers.add(s);
- end;
- if Pos('CONTENT-LENGTH:', Uppercase(s)) = 1 then
- Size := StrToIntDef(SeparateRight(s, ' '), 0);
- if Pos('PROXY-CONNECTION:', Uppercase(s)) = 1 then
- if Pos('KEEP', Uppercase(s)) > 0 then
- begin
- proxykeep := true;
- end;
- if Pos('REFERER:', Uppercase(s)) = 1 then
- LogRec.ref := Trim(SeparateRight(s, ' '));
- if Pos('USER-AGENT:', Uppercase(s)) = 1 then
- LogRec.agent := Trim(SeparateRight(s, ' '));
- until s = '';
- end;
-
- if proxykeep then
- headers.add('Connection: keep-alive')
- else
- headers.add('Connection: close');
-
- s := ParseURL(uri, Prot, User, Pass, Host, Port, Path, Para);
- Headers.Insert(0, method + ' ' + s + ' ' + protocol);
-
- if lasthost <> host then
- qsock.closesocket;
- if qsock.Socket = INVALID_SOCKET then
- begin
- qsock.Connect(host, port);
- if qsock.LastError <> 0 then
- begin
- return502(sock, host, port);
- exit;
- end;
- lasthost := host;
- end;
-
- if method = 'CONNECT' then
- begin
- sock.SendString(protocol + ' 200 Connection established' + CRLF + CRLF);
- LogRec.stat := '200';
- WriteAccesslog(Logrec);
- RelayTCP(sock, qsock);
- Exit;
- end;
- qsock.SendString(headers.text + CRLF);
-
- //upload data from client to server if needed.
- if size > 0 then
- begin
- if not RelaySock(sock, qsock, size) then
- exit;
- end;
-
- //read response line
- repeat
- headers.Clear;
- s := qsock.RecvString(timeout);
- if qsock.lasterror <> 0 then
- Exit;
- if s = '' then
- Exit;
- headers.Add(s);
- rprotocol := fetch(s, ' ');
- status := StrToIntDef(separateleft(s, ' '), 0);
- if status = 100 then
- begin
- sock.SendString(rprotocol + ' ' + s + CRLF);
- repeat
- s := qSock.RecvString(Timeout);
- if qSock.LastError = 0 then
- sock.SendString(s + CRLF);
- until (s = '') or (qSock.LastError <> 0);
- end;
- until status <> 100;
-
-
- //read response headers
- if pos('HTTP/', rprotocol) <> 1 then
- Exit;
- LogRec.stat := IntToStr(status);
- size := -1;
- chunked := false;
- //read response headers
- repeat
- s := qsock.RecvString(Timeout);
- if qsock.lasterror <> 0 then
- Exit;
- if s <> '' then
- Headers.add(s);
- if Pos('CONTENT-LENGTH:', Uppercase(s)) = 1 then
- Size := StrToIntDef(SeparateRight(s, ' '), 0);
- if Pos('TRANSFER-ENCODING:', uppercase(s)) = 1 then
- chunked:=Pos('CHUNKED', uppercase(s)) > 0;
- if Pos('CONNECTION:', uppercase(s)) = 1 then
- if Pos('CLOSE', uppercase(s)) > 0 then
- proxyKeep := False;
- until s = '';
-
- if (not(chunked)) and (size = -1) then
- proxyKeep := false;
-
- if proxykeep and (protocol <> 'HTTP/1.1') then
- proxykeep := false;
-
- sock.SendString(headers.text + CRLF);
-
- if method = 'HEAD' then
- begin
- LogRec.len := 0;
- end
- else
- begin
- if size > 0 then
- begin
- //identity kodovani
- if not RelaySock(qsock, sock, size) then
- exit;
- LogRec.len := Size;
- end
- else
- begin
- if chunked then
- begin
- repeat
- repeat
- s := qSock.RecvString(Timeout);
- if qSock.LastError = 0 then
- sock.SendString(s + CRLF);
- until (s <> '') or (qSock.LastError <> 0);
- if qSock.LastError <> 0 then
- Break;
- s := Trim(SeparateLeft(s, ' '));
- s := Trim(SeparateLeft(s, ';'));
- Size := StrToIntDef('$' + s, 0);
- LogRec.len := LogRec.len + Size;
- if Size = 0 then
- begin
- repeat
- s := qSock.RecvString(Timeout);
- if qSock.LastError = 0 then
- sock.SendString(s + CRLF);
- until (s = '') or (qSock.LastError <> 0);
- Break;
- end;
- if not RelaySock(qsock, sock, size) then
- break;
- until False;
- end
- else
- begin
- if size = -1 then
- if method = 'GET' then
- if (status div 100) = 2 then
- begin
- while qsock.LastError = 0 do
- begin
- s := qsock.RecvPacket(timeout);
- if qsock.LastError = 0 then
- sock.SendString(s);
- LogRec.len := LogRec.len + length(s);
- end;
- end;
- end;
- end;
- end;
- //done
- WriteAccesslog(Logrec);
- if (qsock.LastError <> 0) or (sock.LastError <> 0) then
- Exit;
- sleep(1);
- until not proxykeep;
- //finish with connection
- finally
- sock.Free;
- Qsock.Free;
- end;
-end;
-
-procedure TTCPHttpThrd.ReturnHTML(const sock: TTCPBlockSocket; const value, stat: string);
-begin
- sock.sendstring('HTTP/1.0 ' + stat + CRLF);
- sock.sendstring('Content-type: text/html' + CRLF);
- sock.sendstring('Content-length: ' + Inttostr(length(value)) + CRLF);
- sock.sendstring('proxy-Connection: close' + CRLF);
- sock.sendstring(CRLF);
- sock.sendstring(value);
-end;
-
-procedure TTCPHttpThrd.Return502(const sock: TTCPBlockSocket; host, port: string);
-var
- l: TStringlist;
-begin
- l := TStringList.Create;
- try
- l.Add('');
- l.Add('Bad address! ');
- l.Add('');
- l.Add('Bad address! ');
- l.Add('');
- l.Add('Unable to connect with: ' + host + ':' + port);
- l.Add('
');
- l.Add('Requested address is bad, or server is not accessible now.');
- l.Add('
');
- l.Add('
Error 502 ');
- l.Add('');
- l.Add('');
- l.Add('');
- ReturnHTML(sock, l.text, '502');
- finally
- l.free;
- end;
-end;
-
-//write Apache compatible access log
-procedure TTCPHttpThrd.WriteAccessLog(const LogRec: TLogRec);
-var
- day, month, year: word;
- s: string;
-const
- MNames: array[1..12] of string =
- ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
- 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
-begin
- Decodedate(LogRec.dt,year, month, day);
- s := Format('%.2d', [day]) + '/' + MNames[month] + '/' + IntToStr(year);
- s := '[' + s + FormatDateTime(':hh:nn:ss', LogRec.dt) + ' ' + TimeZone + ']';
- s := LogRec.ip + ' - - ' + s + ' "' + LogRec.req + '"';
- if LogRec.stat = '' then
- s := s + ' -'
- else
- s := s + ' ' + LogRec.Stat;
- if LogRec.len = 0 then
- s := s + ' -'
- else
- s := s + ' ' + IntToStr(LogRec.len);
- if LogRec.Ref = '' then
- s := s + ' "-"'
- else
- s := s + ' "' + LogRec.Ref + '"';
- if LogRec.Agent = '' then
- s := s + ' "-"'
- else
- s := s + ' "' + LogRec.Agent + '"';
- Writelog(s);
-end;
-
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/httpproxy/Unit1.dfm b/Source/3rdParty/Synapse/source/demo/httpproxy/Unit1.dfm
deleted file mode 100644
index 1cd657a9..00000000
Binary files a/Source/3rdParty/Synapse/source/demo/httpproxy/Unit1.dfm and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/demo/httpproxy/Unit1.pas b/Source/3rdParty/Synapse/source/demo/httpproxy/Unit1.pas
deleted file mode 100644
index d0919849..00000000
--- a/Source/3rdParty/Synapse/source/demo/httpproxy/Unit1.pas
+++ /dev/null
@@ -1,38 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls, proxythrd;
-
-type
- TForm1 = class(TForm)
- Button1: TButton;
- procedure Button1Click(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$R *.DFM}
-
-procedure TForm1.Button1Click(Sender: TObject);
-begin
- Button1.Enabled := False;
- TServiceThread.Create;
-end;
-
-procedure TForm1.FormCreate(Sender: TObject);
-begin
- InitService;
-end;
-
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/httpproxy/httpproxy.dof b/Source/3rdParty/Synapse/source/demo/httpproxy/httpproxy.dof
deleted file mode 100644
index b8b37618..00000000
--- a/Source/3rdParty/Synapse/source/demo/httpproxy/httpproxy.dof
+++ /dev/null
@@ -1,75 +0,0 @@
-[Compiler]
-A=1
-B=0
-C=1
-D=1
-E=0
-F=0
-G=1
-H=1
-I=1
-J=1
-K=0
-L=1
-M=0
-N=1
-O=1
-P=1
-Q=0
-R=0
-S=0
-T=0
-U=0
-V=1
-W=0
-X=1
-Y=0
-Z=1
-ShowHints=1
-ShowWarnings=1
-UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-[Linker]
-MapFile=0
-OutputObjs=0
-ConsoleApp=1
-DebugInfo=0
-MinStackSize=16384
-MaxStackSize=1048576
-ImageBase=4194304
-ExeDescription=
-[Directories]
-OutputDir=
-UnitOutputDir=
-SearchPath=
-Packages=
-Conditionals=
-DebugSourceDirs=
-UsePackages=0
-[Parameters]
-RunParams=
-HostApplication=
-[Version Info]
-IncludeVerInfo=0
-AutoIncBuild=0
-MajorVer=1
-MinorVer=0
-Release=0
-Build=0
-Debug=0
-PreRelease=0
-Special=0
-Private=0
-DLL=0
-Locale=1029
-CodePage=1250
-[Version Info Keys]
-CompanyName=
-FileDescription=
-FileVersion=1.0.0.0
-InternalName=
-LegalCopyright=
-LegalTrademarks=
-OriginalFilename=
-ProductName=
-ProductVersion=1.0.0.0
-Comments=
diff --git a/Source/3rdParty/Synapse/source/demo/httpproxy/httpproxy.dpr b/Source/3rdParty/Synapse/source/demo/httpproxy/httpproxy.dpr
deleted file mode 100644
index f6a4e32f..00000000
--- a/Source/3rdParty/Synapse/source/demo/httpproxy/httpproxy.dpr
+++ /dev/null
@@ -1,14 +0,0 @@
-program httpproxy;
-
-uses
- Forms,
- Unit1 in 'Unit1.pas' {Form1},
- ProxyThrd in 'ProxyThrd.pas';
-
-{$R *.RES}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/httpserv/http.pas b/Source/3rdParty/Synapse/source/demo/httpserv/http.pas
deleted file mode 100644
index 811fc7bf..00000000
--- a/Source/3rdParty/Synapse/source/demo/httpserv/http.pas
+++ /dev/null
@@ -1,202 +0,0 @@
-unit http;
-
-interface
-
-uses
- Classes, blcksock, winsock, Synautil, SysUtils;
-
-type
- TTCPHttpDaemon = class(TThread)
- private
- Sock:TTCPBlockSocket;
- public
- Constructor Create;
- Destructor Destroy; override;
- procedure Execute; override;
- end;
-
- TTCPHttpThrd = class(TThread)
- private
- Sock:TTCPBlockSocket;
- public
- Headers: TStringList;
- InputData, OutputData: TMemoryStream;
- Constructor Create (hsock:tSocket);
- Destructor Destroy; override;
- procedure Execute; override;
- function ProcessHttpRequest(Request, URI: string): integer;
- end;
-
-implementation
-
-{ TTCPHttpDaemon }
-
-Constructor TTCPHttpDaemon.Create;
-begin
- inherited create(false);
- sock:=TTCPBlockSocket.create;
- FreeOnTerminate:=true;
-end;
-
-Destructor TTCPHttpDaemon.Destroy;
-begin
- Sock.free;
- inherited Destroy;
-end;
-
-procedure TTCPHttpDaemon.Execute;
-var
- ClientSock:TSocket;
-begin
- with sock do
- begin
- CreateSocket;
- setLinger(true,10000);
- bind('0.0.0.0','80');
- listen;
- repeat
- if terminated then break;
- if canread(1000) then
- begin
- ClientSock:=accept;
- if lastError=0 then TTCPHttpThrd.create(ClientSock);
- end;
- until false;
- end;
-end;
-
-{ TTCPHttpThrd }
-
-Constructor TTCPHttpThrd.Create(Hsock:TSocket);
-begin
- sock:=TTCPBlockSocket.create;
- Headers := TStringList.Create;
- InputData := TMemoryStream.Create;
- OutputData := TMemoryStream.Create;
- Sock.socket:=HSock;
- FreeOnTerminate:=true;
- Priority:=tpNormal;
- inherited create(false);
-end;
-
-Destructor TTCPHttpThrd.Destroy;
-begin
- Sock.free;
- Headers.Free;
- InputData.Free;
- OutputData.Free;
- inherited Destroy;
-end;
-
-procedure TTCPHttpThrd.Execute;
-var
- timeout: integer;
- s: string;
- method, uri, protocol: string;
- size: integer;
- x, n: integer;
- resultcode: integer;
- close: boolean;
-begin
- timeout := 120000;
- repeat
- //read request line
- s := sock.RecvString(timeout);
- if sock.lasterror <> 0 then
- Exit;
- if s = '' then
- Exit;
- method := fetch(s, ' ');
- if (s = '') or (method = '') then
- Exit;
- uri := fetch(s, ' ');
- if uri = '' then
- Exit;
- protocol := fetch(s, ' ');
- headers.Clear;
- size := -1;
- close := false;
- //read request headers
- if protocol <> '' then
- begin
- if pos('HTTP/', protocol) <> 1 then
- Exit;
- if pos('HTTP/1.1', protocol) <> 1 then
- close := true;
- repeat
- s := sock.RecvString(Timeout);
- if sock.lasterror <> 0 then
- Exit;
- if s <> '' then
- Headers.add(s);
- if Pos('CONTENT-LENGTH:', Uppercase(s)) = 1 then
- Size := StrToIntDef(SeparateRight(s, ' '), -1);
- if Pos('CONNECTION: CLOSE', Uppercase(s)) = 1 then
- close := true;
- until s = '';
- end;
- //recv document...
- InputData.Clear;
- if size >= 0 then
- begin
- InputData.SetSize(Size);
- x := Sock.RecvBufferEx(InputData.Memory, Size, Timeout);
- InputData.SetSize(x);
- if sock.lasterror <> 0 then
- Exit;
- end;
- OutputData.Clear;
- ResultCode := ProcessHttpRequest(method, uri);
- sock.SendString(protocol + ' ' + IntTostr(ResultCode) + CRLF);
- if protocol <> '' then
- begin
- headers.Add('Content-length: ' + IntTostr(OutputData.Size));
- if close then
- headers.Add('Connection: close');
- headers.Add('Date: ' + Rfc822DateTime(now));
- headers.Add('Server: Synapse HTTP server demo');
- headers.Add('');
- for n := 0 to headers.count - 1 do
- sock.sendstring(headers[n] + CRLF);
- end;
- if sock.lasterror <> 0 then
- Exit;
- Sock.SendBuffer(OutputData.Memory, OutputData.Size);
- if close then
- Break;
- until Sock.LastError <> 0;
-end;
-
-function TTCPHttpThrd.ProcessHttpRequest(Request, URI: string): integer;
-var
- l: TStringlist;
-begin
-//sample of precessing HTTP request:
-// InputData is uploaded document, headers is stringlist with request headers.
-// Request is type of request and URI is URI of request
-// OutputData is document with reply, headers is stringlist with reply headers.
-// Result is result code
- result := 504;
- if request = 'GET' then
- begin
- headers.Clear;
- headers.Add('Content-type: Text/Html');
- l := TStringList.Create;
- try
- l.Add('');
- l.Add('
');
- l.Add('');
- l.Add('Request Uri: ' + uri);
- l.Add(' ');
- l.Add('This document is generated by Synapse HTTP server demo!');
- l.Add('');
- l.Add('');
- l.SaveToStream(OutputData);
- finally
- l.free;
- end;
- Result := 200;
- end;
-end;
-
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/httpserv/httpserv.dof b/Source/3rdParty/Synapse/source/demo/httpserv/httpserv.dof
deleted file mode 100644
index d00d8840..00000000
--- a/Source/3rdParty/Synapse/source/demo/httpserv/httpserv.dof
+++ /dev/null
@@ -1,75 +0,0 @@
-[Compiler]
-A=1
-B=0
-C=1
-D=1
-E=0
-F=0
-G=1
-H=1
-I=1
-J=1
-K=0
-L=1
-M=0
-N=1
-O=1
-P=1
-Q=0
-R=0
-S=0
-T=0
-U=0
-V=1
-W=0
-X=1
-Y=0
-Z=1
-ShowHints=1
-ShowWarnings=1
-UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-[Linker]
-MapFile=0
-OutputObjs=0
-ConsoleApp=1
-DebugInfo=0
-MinStackSize=16384
-MaxStackSize=1048576
-ImageBase=4194304
-ExeDescription=
-[Directories]
-OutputDir=
-UnitOutputDir=
-SearchPath=
-Packages=VCLX30;VCL30;VCLDB30;VCLDBX30;INETDB30;INET30;VCLSMP30;QRPT30;TEEUI30;TEEDB30;TEE30;DSS30;IBEVNT30;RXCTL;RXDB;RXTOOLS
-Conditionals=
-DebugSourceDirs=
-UsePackages=0
-[Parameters]
-RunParams=
-HostApplication=
-[Version Info]
-IncludeVerInfo=0
-AutoIncBuild=0
-MajorVer=1
-MinorVer=0
-Release=0
-Build=0
-Debug=0
-PreRelease=0
-Special=0
-Private=0
-DLL=0
-Locale=1029
-CodePage=1250
-[Version Info Keys]
-CompanyName=
-FileDescription=
-FileVersion=1.0.0.0
-InternalName=
-LegalCopyright=
-LegalTrademarks=
-OriginalFilename=
-ProductName=
-ProductVersion=1.0.0.0
-Comments=
diff --git a/Source/3rdParty/Synapse/source/demo/httpserv/httpserv.dpr b/Source/3rdParty/Synapse/source/demo/httpserv/httpserv.dpr
deleted file mode 100644
index ea3205a6..00000000
--- a/Source/3rdParty/Synapse/source/demo/httpserv/httpserv.dpr
+++ /dev/null
@@ -1,14 +0,0 @@
-program httpserv;
-
-uses
- Forms,
- main in 'main.pas' {Form1},
- http in 'http.pas';
-
-{$R *.RES}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/httpserv/main.dfm b/Source/3rdParty/Synapse/source/demo/httpserv/main.dfm
deleted file mode 100644
index ea1f841a..00000000
Binary files a/Source/3rdParty/Synapse/source/demo/httpserv/main.dfm and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/demo/httpserv/main.pas b/Source/3rdParty/Synapse/source/demo/httpserv/main.pas
deleted file mode 100644
index 198fecb2..00000000
--- a/Source/3rdParty/Synapse/source/demo/httpserv/main.pas
+++ /dev/null
@@ -1,31 +0,0 @@
-unit main;
-
-interface
-
-uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls, http;
-
-type
- TForm1 = class(TForm)
- Button1: TButton;
- procedure Button1Click(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$R *.DFM}
-
-procedure TForm1.Button1Click(Sender: TObject);
-begin
- TTCPHttpDaemon.create;
-end;
-
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/httpsserv/c_cacert.p12 b/Source/3rdParty/Synapse/source/demo/httpsserv/c_cacert.p12
deleted file mode 100644
index 7c5adc2b..00000000
Binary files a/Source/3rdParty/Synapse/source/demo/httpsserv/c_cacert.p12 and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/demo/httpsserv/http.pas b/Source/3rdParty/Synapse/source/demo/httpsserv/http.pas
deleted file mode 100644
index 546d1f91..00000000
--- a/Source/3rdParty/Synapse/source/demo/httpsserv/http.pas
+++ /dev/null
@@ -1,225 +0,0 @@
-unit http;
-
-{ Marked some code with !!!}
-
-interface
-
-uses
- Classes, blcksock, winsock, Synautil, ssl_openssl, SysUtils, Dialogs;
-
-type
- TTCPHttpDaemon = class(TThread)
- private
- Sock:TTCPBlockSocket;
- public
- Constructor Create;
- Destructor Destroy; override;
- procedure Execute; override;
- end;
-
- TTCPHttpThrd = class(TThread)
- private
- Sock:TTCPBlockSocket;
- public
- Headers: TStringList;
- InputData, OutputData: TMemoryStream;
- Constructor Create (hsock:tSocket);
- Destructor Destroy; override;
- procedure Execute; override;
- function ProcessHttpRequest(Request, URI: string): integer;
- end;
-
-implementation
-
-{ TTCPHttpDaemon }
-
-Constructor TTCPHttpDaemon.Create;
-begin
- sock:=TTCPBlockSocket.create;
- FreeOnTerminate:=true;
- inherited create(false);
-end;
-
-Destructor TTCPHttpDaemon.Destroy;
-begin
- Sock.free;
- inherited Destroy;
-end;
-
-procedure TTCPHttpDaemon.Execute;
-var
- ClientSock:TSocket;
-begin
- with sock do
- begin
- CreateSocket;
- setLinger(true,10000);
- bind('0.0.0.0','443');
- listen;
- repeat
- if terminated then break;
- if canread(1000) then
- begin
- ClientSock:=accept;
- if lastError=0 then TTCPHttpThrd.create(ClientSock);
- end;
- until false;
- end;
-end;
-
-{ TTCPHttpThrd }
-
-Constructor TTCPHttpThrd.Create(Hsock:TSocket);
-begin
- sock:=TTCPBlockSocket.create;
- Headers := TStringList.Create;
- InputData := TMemoryStream.Create;
- OutputData := TMemoryStream.Create;
- Sock.socket:=HSock;
- FreeOnTerminate:=true;
- inherited create(false);
-end;
-
-Destructor TTCPHttpThrd.Destroy;
-begin
- Sock.free;
- Headers.Free;
- InputData.Free;
- OutputData.Free;
- inherited Destroy;
-end;
-
-procedure TTCPHttpThrd.Execute;
-var
- timeout: integer;
- s: string;
- method, uri, protocol: string;
- size: integer;
- x, n: integer;
- resultcode: integer;
-begin
- timeout := 120000;
-
- // Note: There's no need for installing a client certificate in the
- // webbrowser. The server asks the webbrowser to send a certificate but
- // if nothing is installed the software will work because the server
- // doesn't check to see if a client certificate was supplied. If you
- // want you can install:
- //
- // file: c_cacert.p12
- // password: c_cakey
- //
- Sock.SSL.CertCAFile := ExtractFilePath(ParamStr(0)) + 's_cabundle.pem';
- Sock.SSL.CertificateFile := ExtractFilePath(ParamStr(0)) + 's_cacert.pem';
- Sock.SSL.PrivateKeyFile := ExtractFilePath(ParamStr(0)) + 's_cakey.pem';
- Sock.SSL.KeyPassword := 's_cakey';
- Sock.SSL.verifyCert := True;
-
- try
- if (not Sock.SSLAcceptConnection) or
- (Sock.SSL.LastError <> 0) then
- begin
- MessageDlg('Error while accepting SSL connection: ' + Sock.SSL.LastErrorDesc, mtError, [mbAbort], 0);
- Exit;
- end;
- except
- MessageDlg('Exception while accepting SSL connection', mtError, [mbAbort], 0);
- Exit;
- end;
-
-
- //read request line
- s := sock.RecvString(timeout);
- if sock.lasterror <> 0 then
- Exit;
- if s = '' then
- Exit;
- method := fetch(s, ' ');
- if (s = '') or (method = '') then
- Exit;
- uri := fetch(s, ' ');
- if uri = '' then
- Exit;
- protocol := fetch(s, ' ');
- headers.Clear;
- size := -1;
- //read request headers
- if protocol <> '' then
- begin
- if pos('HTTP/', protocol) <> 1 then
- Exit;
- repeat
- s := sock.RecvString(Timeout);
- if sock.lasterror <> 0 then
- Exit;
- if s <> '' then
- Headers.add(s);
- if Pos('CONTENT-LENGTH:', Uppercase(s)) = 1 then
- Size := StrToIntDef(SeparateRight(s, ' '), -1);
- until s = '';
- end;
- //recv document...
- InputData.Clear;
- if size >= 0 then
- begin
- InputData.SetSize(Size);
- x := Sock.RecvBufferEx(InputData.Memory, Size, Timeout);
- InputData.SetSize(x);
- if sock.lasterror <> 0 then
- Exit;
- end;
- OutputData.Clear;
- ResultCode := ProcessHttpRequest(method, uri);
- sock.SendString('HTTP/1.0 ' + IntTostr(ResultCode) + CRLF);
- if protocol <> '' then
- begin
- headers.Add('Content-length: ' + IntTostr(OutputData.Size));
- headers.Add('Connection: close');
- headers.Add('Date: ' + Rfc822DateTime(now));
- headers.Add('Server: Synapse HTTP server demo');
- headers.Add('');
- for n := 0 to headers.count - 1 do
- sock.sendstring(headers[n] + CRLF);
- end;
- if sock.lasterror <> 0 then
- Exit;
- Sock.SendBuffer(OutputData.Memory, OutputData.Size);
-end;
-
-function TTCPHttpThrd.ProcessHttpRequest(Request, URI: string): integer;
-var
- l: TStringlist;
-begin
-//sample of precessing HTTP request:
-// InputData is uploaded document, headers is stringlist with request headers.
-// Request is type of request and URI is URI of request
-// OutputData is document with reply, headers is stringlist with reply headers.
-// Result is result code
- result := 504;
- if request = 'GET' then
- begin
- headers.Clear;
- headers.Add('Content-type: Text/Html');
- l := TStringList.Create;
- try
- l.Add('');
- l.Add('');
- l.Add('');
- l.Add('Request Uri: ' + uri);
- l.Add(' ');
- l.Add('This document is generated by Synapse HTTPS server demo!');
- if Sock.SSL.GetPeerName = '' then
- l.Add('No client certificate received')
- else
- l.Add('Client certificate received from ' + Sock.SSL.GetPeerName);
- l.Add('');
- l.Add('');
- l.SaveToStream(OutputData);
- finally
- l.free;
- end;
- Result := 200;
- end;
-end;
-
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/httpsserv/httpserv.dof b/Source/3rdParty/Synapse/source/demo/httpsserv/httpserv.dof
deleted file mode 100644
index 1124af47..00000000
--- a/Source/3rdParty/Synapse/source/demo/httpsserv/httpserv.dof
+++ /dev/null
@@ -1,132 +0,0 @@
-[FileVersion]
-Version=7.0
-[Compiler]
-A=8
-B=0
-C=1
-D=1
-E=0
-F=0
-G=1
-H=1
-I=1
-J=0
-K=0
-L=1
-M=0
-N=1
-O=1
-P=1
-Q=0
-R=0
-S=0
-T=0
-U=0
-V=1
-W=0
-X=1
-Y=1
-Z=1
-ShowHints=1
-ShowWarnings=1
-UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-NamespacePrefix=
-SymbolDeprecated=1
-SymbolLibrary=1
-SymbolPlatform=1
-UnitLibrary=1
-UnitPlatform=1
-UnitDeprecated=1
-HResultCompat=1
-HidingMember=1
-HiddenVirtual=1
-Garbage=1
-BoundsError=1
-ZeroNilCompat=1
-StringConstTruncated=1
-ForLoopVarVarPar=1
-TypedConstVarPar=1
-AsgToTypedConst=1
-CaseLabelRange=1
-ForVariable=1
-ConstructingAbstract=1
-ComparisonFalse=1
-ComparisonTrue=1
-ComparingSignedUnsigned=1
-CombiningSignedUnsigned=1
-UnsupportedConstruct=1
-FileOpen=1
-FileOpenUnitSrc=1
-BadGlobalSymbol=1
-DuplicateConstructorDestructor=1
-InvalidDirective=1
-PackageNoLink=1
-PackageThreadVar=1
-ImplicitImport=1
-HPPEMITIgnored=1
-NoRetVal=1
-UseBeforeDef=1
-ForLoopVarUndef=1
-UnitNameMismatch=1
-NoCFGFileFound=1
-MessageDirective=1
-ImplicitVariants=1
-UnicodeToLocale=1
-LocaleToUnicode=1
-ImagebaseMultiple=1
-SuspiciousTypecast=1
-PrivatePropAccessor=1
-UnsafeType=0
-UnsafeCode=0
-UnsafeCast=0
-[Linker]
-MapFile=0
-OutputObjs=0
-ConsoleApp=1
-DebugInfo=0
-RemoteSymbols=0
-MinStackSize=16384
-MaxStackSize=1048576
-ImageBase=4194304
-ExeDescription=
-[Directories]
-OutputDir=
-UnitOutputDir=
-PackageDLLOutputDir=
-PackageDCPOutputDir=
-SearchPath=
-Packages=
-Conditionals=
-DebugSourceDirs=
-UsePackages=0
-[Parameters]
-RunParams=
-HostApplication=
-Launcher=
-UseLauncher=0
-DebugCWD=
-[Version Info]
-IncludeVerInfo=0
-AutoIncBuild=0
-MajorVer=1
-MinorVer=0
-Release=0
-Build=0
-Debug=0
-PreRelease=0
-Special=0
-Private=0
-DLL=0
-Locale=1029
-CodePage=1250
-[Version Info Keys]
-CompanyName=
-FileDescription=
-FileVersion=1.0.0.0
-InternalName=
-LegalCopyright=
-LegalTrademarks=
-OriginalFilename=
-ProductName=
-ProductVersion=1.0.0.0
-Comments=
diff --git a/Source/3rdParty/Synapse/source/demo/httpsserv/httpserv.dpr b/Source/3rdParty/Synapse/source/demo/httpsserv/httpserv.dpr
deleted file mode 100644
index ea3205a6..00000000
--- a/Source/3rdParty/Synapse/source/demo/httpsserv/httpserv.dpr
+++ /dev/null
@@ -1,14 +0,0 @@
-program httpserv;
-
-uses
- Forms,
- main in 'main.pas' {Form1},
- http in 'http.pas';
-
-{$R *.RES}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/httpsserv/main.dfm b/Source/3rdParty/Synapse/source/demo/httpsserv/main.dfm
deleted file mode 100644
index 3a9c08bc..00000000
--- a/Source/3rdParty/Synapse/source/demo/httpsserv/main.dfm
+++ /dev/null
@@ -1,25 +0,0 @@
-object Form1: TForm1
- Left = 370
- Top = 255
- Width = 232
- Height = 127
- Caption = 'HTTPServ'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -13
- Font.Name = 'MS Sans Serif'
- Font.Style = []
- OldCreateOrder = True
- PixelsPerInch = 120
- TextHeight = 16
- object Button1: TButton
- Left = 9
- Top = 14
- Width = 192
- Height = 24
- Caption = 'Run HTTP Server'
- TabOrder = 0
- OnClick = Button1Click
- end
-end
diff --git a/Source/3rdParty/Synapse/source/demo/httpsserv/main.pas b/Source/3rdParty/Synapse/source/demo/httpsserv/main.pas
deleted file mode 100644
index 198fecb2..00000000
--- a/Source/3rdParty/Synapse/source/demo/httpsserv/main.pas
+++ /dev/null
@@ -1,31 +0,0 @@
-unit main;
-
-interface
-
-uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls, http;
-
-type
- TForm1 = class(TForm)
- Button1: TButton;
- procedure Button1Click(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$R *.DFM}
-
-procedure TForm1.Button1Click(Sender: TObject);
-begin
- TTCPHttpDaemon.create;
-end;
-
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/httpsserv/s_cabundle.pem b/Source/3rdParty/Synapse/source/demo/httpsserv/s_cabundle.pem
deleted file mode 100644
index 1804cded..00000000
--- a/Source/3rdParty/Synapse/source/demo/httpsserv/s_cabundle.pem
+++ /dev/null
@@ -1,54 +0,0 @@
------BEGIN CERTIFICATE-----
-MIIEojCCA4qgAwIBAgIBATANBgkqhkiG9w0BAQQFADCBizELMAkGA1UEBhMCTkwx
-EjAQBgNVBAgTCUZsZXZvbGFuZDEPMA0GA1UEBxMGQWxtZXJlMRAwDgYDVQQKEwdp
-U2VydmVyMQ4wDAYDVQQLEwVTYWxlczESMBAGA1UEAxMJbG9jYWxob3N0MSEwHwYJ
-KoZIhvcNAQkBFhJzZXJ2ZXJAaG90bWFpbC5jb20wHhcNMDUwOTEwMTIyNTQwWhcN
-MDYwOTEwMTIyNTQwWjB6MQswCQYDVQQGEwJOTDESMBAGA1UECBMJRmxldm9sYW5k
-MRAwDgYDVQQKEwdpU2VydmVyMQ4wDAYDVQQLEwVTYWxlczESMBAGA1UEAxMJbG9j
-YWxob3N0MSEwHwYJKoZIhvcNAQkBFhJjbGllbnRAaG90bWFpbC5jb20wggEiMA0G
-CSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQCqPV/htC0M7wxnNxcXsfAuVacyvx+G
-minwpCyWJMJdcvACL43jzGA6Ap8QfwXgXR6pZxvFXbal9G0vZQEO/vgNuAhfXBIO
-+eGPrQFYg/IIsJzuLlmGiTh4TJS5WLA/t5o55cvrCyT7uyj4u1+5qkAiVqdgaoKp
-vac5Ip0yWNmPBPojvSELDmZ17qheKo6LX/2WG678cESYl1xrVwQubBttsCGxgVlC
-oUVXOSFUqjAtm1ZVk4+sBKqwZ+jUryYW9FHGQNFGlXQp0M/UlHBe9t/YFmswKU47
-EIVHGUCdz02p/77FGu7vWoMBBScOAaaMLBwXjc08s7IJxtj6vRn70EgRAgMBAAGj
-ggEfMIIBGzAJBgNVHRMEAjAAMCwGCWCGSAGG+EIBDQQfFh1PcGVuU1NMIEdlbmVy
-YXRlZCBDZXJ0aWZpY2F0ZTAdBgNVHQ4EFgQUNKzE1cM8luUu3Oh/73qkTNq4VgMw
-gcAGA1UdIwSBuDCBtYAU5fXRDlkYEkrR3AFeoXlNN4GE8A+hgZGkgY4wgYsxCzAJ
-BgNVBAYTAk5MMRIwEAYDVQQIEwlGbGV2b2xhbmQxDzANBgNVBAcTBkFsbWVyZTEQ
-MA4GA1UEChMHaVNlcnZlcjEOMAwGA1UECxMFU2FsZXMxEjAQBgNVBAMTCWxvY2Fs
-aG9zdDEhMB8GCSqGSIb3DQEJARYSc2VydmVyQGhvdG1haWwuY29tggkAi8LqjArw
-jpYwDQYJKoZIhvcNAQEEBQADggEBAI9YwWNlEV420DBKpzeYhQK3MAOSF8IhikzP
-a0MUewi5bsHo8lKpKJCN4f5yRZSx2FxL5NoxR5JEiFY8Nr5it3cgppd0FFWKf8p7
-LN8CIgS6/EmuFcVpe2JpcSBe95QpdloeTq5rygrBJb4UurIFewELpODXjC1MQZSM
-lvIbbLX8PVxpOZrLHjWBNzVBQ1Jfy/53Ova1pp6R/fqBZu6c6I61vB/IragWuQhO
-KQAjjCHUvL6NqZIz9VsNbiDR1NGjLYh7NRbcMr4Qc/HXkFeXugI+UyG+JH7/rYKB
-iNtQ/mPr2R2e5vaJhjmSZr0MjqSrMJ1VMI5AUokVWo8oNJosdMk=
------END CERTIFICATE-----
------BEGIN CERTIFICATE-----
-MIIEjzCCA3egAwIBAgIJAIvC6owK8I6WMA0GCSqGSIb3DQEBBAUAMIGLMQswCQYD
-VQQGEwJOTDESMBAGA1UECBMJRmxldm9sYW5kMQ8wDQYDVQQHEwZBbG1lcmUxEDAO
-BgNVBAoTB2lTZXJ2ZXIxDjAMBgNVBAsTBVNhbGVzMRIwEAYDVQQDEwlsb2NhbGhv
-c3QxITAfBgkqhkiG9w0BCQEWEnNlcnZlckBob3RtYWlsLmNvbTAeFw0wNTA5MTAx
-MjIyMTJaFw0wODA5MDkxMjIyMTJaMIGLMQswCQYDVQQGEwJOTDESMBAGA1UECBMJ
-Rmxldm9sYW5kMQ8wDQYDVQQHEwZBbG1lcmUxEDAOBgNVBAoTB2lTZXJ2ZXIxDjAM
-BgNVBAsTBVNhbGVzMRIwEAYDVQQDEwlsb2NhbGhvc3QxITAfBgkqhkiG9w0BCQEW
-EnNlcnZlckBob3RtYWlsLmNvbTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoC
-ggEBANyzvvJiLHEiK9hGJ8ugM5I2tfL0QYDjTgOcfYSmhtrdFJF1M9O2JNLMLvfC
-hROXkPL6mfFhiEKaoXflWLWs/whQKLeDSTIEj5FVDbvnehktSrh8vBt21HVTxovq
-HQ1Qk2wPU62tMnJrkjLLhuimTS90fdWVs6aJhsH4R85XczumIUNzKndqVyWAGzVX
-ImiXRR4P5CTkwzeQ70LbbYoxM+3+0pkAkZxtoQ/ZSaWLnI7wpeJ4/4Z31/1IlYtk
-IFFGY1HsbBy4RFbWIUdQ5c1GaKgLul415HZ3wV3Um9SULSxDIWZkN00/8qWtghVU
-CAQglry8b2GbnziEEWrqRQh0MeUCAwEAAaOB8zCB8DAdBgNVHQ4EFgQU5fXRDlkY
-EkrR3AFeoXlNN4GE8A8wgcAGA1UdIwSBuDCBtYAU5fXRDlkYEkrR3AFeoXlNN4GE
-8A+hgZGkgY4wgYsxCzAJBgNVBAYTAk5MMRIwEAYDVQQIEwlGbGV2b2xhbmQxDzAN
-BgNVBAcTBkFsbWVyZTEQMA4GA1UEChMHaVNlcnZlcjEOMAwGA1UECxMFU2FsZXMx
-EjAQBgNVBAMTCWxvY2FsaG9zdDEhMB8GCSqGSIb3DQEJARYSc2VydmVyQGhvdG1h
-aWwuY29tggkAi8LqjArwjpYwDAYDVR0TBAUwAwEB/zANBgkqhkiG9w0BAQQFAAOC
-AQEAE49cf2BZ0KIbIupJSrerrvD9JgskCvZE2JZu5ogetaqpF607wvpzvqfU5YsK
-HvT3yYaVIqEreiWinpCZzfW7SIKS8M6rPZk8nbv+O2FaY+wkaU8SLVS4ZMdB6BGb
-4Jwc3Y2DVwa8l/TwDE+dNM6jVvzNJAhu17IybIwo+jP6uyYw+E7Y40a3CF2dSkxF
-fUMO/wyQiN7BvqgeVjcfKbhi71rPg8xiJAnt1wjTLhL5WBuDJQw7wNzmMuh8BuR8
-J6exTroDNn8ZRISWX/Pz7da87S+dYLEI5+EjcfIZDtgHk9g37t48mli2ajYkS7WG
-W20dkY+dGSeVEsxLn+DuarseTQ==
------END CERTIFICATE-----
diff --git a/Source/3rdParty/Synapse/source/demo/httpsserv/s_cacert.pem b/Source/3rdParty/Synapse/source/demo/httpsserv/s_cacert.pem
deleted file mode 100644
index bb0d2aec..00000000
--- a/Source/3rdParty/Synapse/source/demo/httpsserv/s_cacert.pem
+++ /dev/null
@@ -1,27 +0,0 @@
------BEGIN CERTIFICATE-----
-MIIEjzCCA3egAwIBAgIJAIvC6owK8I6WMA0GCSqGSIb3DQEBBAUAMIGLMQswCQYD
-VQQGEwJOTDESMBAGA1UECBMJRmxldm9sYW5kMQ8wDQYDVQQHEwZBbG1lcmUxEDAO
-BgNVBAoTB2lTZXJ2ZXIxDjAMBgNVBAsTBVNhbGVzMRIwEAYDVQQDEwlsb2NhbGhv
-c3QxITAfBgkqhkiG9w0BCQEWEnNlcnZlckBob3RtYWlsLmNvbTAeFw0wNTA5MTAx
-MjIyMTJaFw0wODA5MDkxMjIyMTJaMIGLMQswCQYDVQQGEwJOTDESMBAGA1UECBMJ
-Rmxldm9sYW5kMQ8wDQYDVQQHEwZBbG1lcmUxEDAOBgNVBAoTB2lTZXJ2ZXIxDjAM
-BgNVBAsTBVNhbGVzMRIwEAYDVQQDEwlsb2NhbGhvc3QxITAfBgkqhkiG9w0BCQEW
-EnNlcnZlckBob3RtYWlsLmNvbTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoC
-ggEBANyzvvJiLHEiK9hGJ8ugM5I2tfL0QYDjTgOcfYSmhtrdFJF1M9O2JNLMLvfC
-hROXkPL6mfFhiEKaoXflWLWs/whQKLeDSTIEj5FVDbvnehktSrh8vBt21HVTxovq
-HQ1Qk2wPU62tMnJrkjLLhuimTS90fdWVs6aJhsH4R85XczumIUNzKndqVyWAGzVX
-ImiXRR4P5CTkwzeQ70LbbYoxM+3+0pkAkZxtoQ/ZSaWLnI7wpeJ4/4Z31/1IlYtk
-IFFGY1HsbBy4RFbWIUdQ5c1GaKgLul415HZ3wV3Um9SULSxDIWZkN00/8qWtghVU
-CAQglry8b2GbnziEEWrqRQh0MeUCAwEAAaOB8zCB8DAdBgNVHQ4EFgQU5fXRDlkY
-EkrR3AFeoXlNN4GE8A8wgcAGA1UdIwSBuDCBtYAU5fXRDlkYEkrR3AFeoXlNN4GE
-8A+hgZGkgY4wgYsxCzAJBgNVBAYTAk5MMRIwEAYDVQQIEwlGbGV2b2xhbmQxDzAN
-BgNVBAcTBkFsbWVyZTEQMA4GA1UEChMHaVNlcnZlcjEOMAwGA1UECxMFU2FsZXMx
-EjAQBgNVBAMTCWxvY2FsaG9zdDEhMB8GCSqGSIb3DQEJARYSc2VydmVyQGhvdG1h
-aWwuY29tggkAi8LqjArwjpYwDAYDVR0TBAUwAwEB/zANBgkqhkiG9w0BAQQFAAOC
-AQEAE49cf2BZ0KIbIupJSrerrvD9JgskCvZE2JZu5ogetaqpF607wvpzvqfU5YsK
-HvT3yYaVIqEreiWinpCZzfW7SIKS8M6rPZk8nbv+O2FaY+wkaU8SLVS4ZMdB6BGb
-4Jwc3Y2DVwa8l/TwDE+dNM6jVvzNJAhu17IybIwo+jP6uyYw+E7Y40a3CF2dSkxF
-fUMO/wyQiN7BvqgeVjcfKbhi71rPg8xiJAnt1wjTLhL5WBuDJQw7wNzmMuh8BuR8
-J6exTroDNn8ZRISWX/Pz7da87S+dYLEI5+EjcfIZDtgHk9g37t48mli2ajYkS7WG
-W20dkY+dGSeVEsxLn+DuarseTQ==
------END CERTIFICATE-----
diff --git a/Source/3rdParty/Synapse/source/demo/httpsserv/s_cakey.pem b/Source/3rdParty/Synapse/source/demo/httpsserv/s_cakey.pem
deleted file mode 100644
index 67529720..00000000
--- a/Source/3rdParty/Synapse/source/demo/httpsserv/s_cakey.pem
+++ /dev/null
@@ -1,30 +0,0 @@
------BEGIN RSA PRIVATE KEY-----
-Proc-Type: 4,ENCRYPTED
-DEK-Info: DES-CBC,6E9C19410AE44898
-
-/LmetEQseTTqG2/dNIanjj3xg8b4bBOJRH8kBzB0ZjBXwi0on5bTBIkOOzM6B6YZ
-fOGIHsrI5OS1wVVWF2++ydP8AD/cgPOewKCBEO/92n+OSOLNqgm+Ns2pvDR44lv0
-je7qIpPxj1RUdDuB45UocxFEZ50w38MgL7E2ITtS95nivtZWmMzTMQki1IYm+k4H
-sJcqcq6jQoreiUXkVLL4js2XwJBEh+rAgoaHHPvWKskdaR/tJG35o9h4YTnVmqhv
-SWKWsDW1ezJotD62VCSGU7KzrXmXBNSF9JPqV40fA1VRYp9cg/8qz8LYmAI2FLOy
-cvBXzvOTYhPbjIOo9nrvBdXZFUUnePLyxJFfWoeYzpvWU1kg1TswlMFwYHGu1SwG
-e5CbNpH7X5/BOLZ6xf4kVeaGLhVqR+FZytlITvi3ZewvfpcyDZt7hyDQ2Fgrtddy
-lF4DlC+eeGDB7eUxKwaIp4X5hiXr+1VJf4Grx33WLVW0Vy5zvQRQoxxfPfEGHexu
-Xddm2c1h8b34PiYx5+SDJ3JVDtZmEXXufDTdP6INkHBGt6JrQDT5OFPwNgjsv2x5
-9xwgccrtk2owVlbTqNLYvARmPC41hkBNcuLOf7FzBsrOEepoIcAnx603CL8vKqWp
-hTeF7npa5KgXWrq44aDraZ478wehN2zUo2p6HvRZlgqQl0WGb8JEVBb3rpB9j99i
-P9kF4ewqSzVF7Qa3FGJF6f2qqxCqQT/01V37OSS4YsAQT1r10WQjd+g/LGgZDbPM
-2GuyI+qtywpneyXiXX3JLZisgEES+XhodlH65YCDOT51izs6mATygMc1PMDh+rbh
-TbuU9gvjfev+sxEtbU83A6s3E/br6i6ChUk0O1okeknImeG93IF8f4Cnpq736hpC
-BNn74XXaplvGqKXcpG6r9v626P4SdnXOEDt1GTovdohjvjOWdNHrNbGVLR9GQZMq
-JmkLLTVB+nAECV4tyh5tAj0+w/5sG4QcX8rms1b9DmnvfTDSNbF+mDRQpz+7kL2+
-w9ORmHC+C59lB4h0jZFUoKZn7liKdRJwLRTuy6wmFkxIZiYKdlsUWHEYQ9OWFDTW
-yf073T3AQ21tZTNLypiW6qRhlussOGPdJx7IkEbuC6UXS1h74om1OQoTqq2uQ7Gl
-7v6WL6ZoAhuRdZoslodO9tCCaTizTRYLO4TEsxcJnY9+xLh0RzBY0PZKnZK3l5tH
-kyxOOSDX8Ld1sbSKRBJo7lhxhUGSUq4p6x/yhXz2CrW7LKpqGDstVPbU/33i4HAi
-XM04oDRRSlWcv9ZjcDksEfpb63/Ck323sxURukyzk3OYW7w8JtVZvMw8RD8TWCB1
-Dw89P2/RIdTGmu9xSfWeThjH10aXUVE2p09lK4VE5rVsZr2owdBQnOnc7WYffllB
-FICMgXPUVA50HyJm7d6yH6J2EiK5fGZ/6DNAqw4p8QNxikk78mt5FfuQ7S8sj2hg
-+vXLJhs49lbt47IDstTLtmWLz+tUdAdN9veZ91iDuOhNWoAh7EJmaBjt/zCn2LOq
-rirjPY3adAi3OzsBgMNQ1JEdCatHs8PbAQc1rbPo/548SWXqQh4iFQ==
------END RSA PRIVATE KEY-----
diff --git a/Source/3rdParty/Synapse/source/demo/mime/MimeDemo.dof b/Source/3rdParty/Synapse/source/demo/mime/MimeDemo.dof
deleted file mode 100644
index b8b37618..00000000
--- a/Source/3rdParty/Synapse/source/demo/mime/MimeDemo.dof
+++ /dev/null
@@ -1,75 +0,0 @@
-[Compiler]
-A=1
-B=0
-C=1
-D=1
-E=0
-F=0
-G=1
-H=1
-I=1
-J=1
-K=0
-L=1
-M=0
-N=1
-O=1
-P=1
-Q=0
-R=0
-S=0
-T=0
-U=0
-V=1
-W=0
-X=1
-Y=0
-Z=1
-ShowHints=1
-ShowWarnings=1
-UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-[Linker]
-MapFile=0
-OutputObjs=0
-ConsoleApp=1
-DebugInfo=0
-MinStackSize=16384
-MaxStackSize=1048576
-ImageBase=4194304
-ExeDescription=
-[Directories]
-OutputDir=
-UnitOutputDir=
-SearchPath=
-Packages=
-Conditionals=
-DebugSourceDirs=
-UsePackages=0
-[Parameters]
-RunParams=
-HostApplication=
-[Version Info]
-IncludeVerInfo=0
-AutoIncBuild=0
-MajorVer=1
-MinorVer=0
-Release=0
-Build=0
-Debug=0
-PreRelease=0
-Special=0
-Private=0
-DLL=0
-Locale=1029
-CodePage=1250
-[Version Info Keys]
-CompanyName=
-FileDescription=
-FileVersion=1.0.0.0
-InternalName=
-LegalCopyright=
-LegalTrademarks=
-OriginalFilename=
-ProductName=
-ProductVersion=1.0.0.0
-Comments=
diff --git a/Source/3rdParty/Synapse/source/demo/mime/MimeDemo.dpr b/Source/3rdParty/Synapse/source/demo/mime/MimeDemo.dpr
deleted file mode 100644
index 88a24f65..00000000
--- a/Source/3rdParty/Synapse/source/demo/mime/MimeDemo.dpr
+++ /dev/null
@@ -1,15 +0,0 @@
-program MimeDemo;
-
-uses
- Forms,
- Unit1 in 'Unit1.pas' {Form1},
- MIMEmess in 'MIMEmess.pas',
- MIMEpart in 'MIMEpart.pas';
-
-{$R *.RES}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/mime/Unit1.dfm b/Source/3rdParty/Synapse/source/demo/mime/Unit1.dfm
deleted file mode 100644
index 249c8e38..00000000
Binary files a/Source/3rdParty/Synapse/source/demo/mime/Unit1.dfm and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/demo/mime/Unit1.pas b/Source/3rdParty/Synapse/source/demo/mime/Unit1.pas
deleted file mode 100644
index adae2bd4..00000000
--- a/Source/3rdParty/Synapse/source/demo/mime/Unit1.pas
+++ /dev/null
@@ -1,97 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls, mimemess, mimepart, ComCtrls;
-
-type
- TForm1 = class(TForm)
- Edit1: TEdit;
- Button1: TButton;
- Label1: TLabel;
- Memo1: TMemo;
- Button2: TButton;
- Label2: TLabel;
- TreeView1: TTreeView;
- procedure Button1Click(Sender: TObject);
- procedure FormCreate(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure Button2Click(Sender: TObject);
- procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
- private
- { Private declarations }
- procedure AddMimeNode(const parent: TTreeNode; const part: TMimepart);
- public
- Mime:TMimemess;
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$R *.DFM}
-
-procedure TForm1.AddMimeNode(const parent: TTreeNode; const part: TMimepart);
-var
- s: string;
- node: TTreeNode;
- n: integer;
-begin
- s := format('%-24s %-15s %-s',[part.primary + '/' + part.secondary,part.filename,part.description]);
- node := TreeView1.Items.AddChild(parent, s);
- node.Data := part;
- for n := 0 to part.GetSubPartCount - 1 do
- AddMimeNode(node, part.getsubpart(n));
-end;
-
-procedure TForm1.Button1Click(Sender: TObject);
-var
- n:integer;
- s:string;
-begin
- mime.Clear;
- memo1.Clear;
- mime.Lines.LoadFromFile(edit1.text);
- mime.DecodeMessage;
- ShowMessage(datetimetostr(mime.Header.Date));
-
- Treeview1.Items.Clear;
- AddMimeNode(nil, mime.MessagePart);
- Treeview1.FullExpand;
-end;
-
-procedure TForm1.FormCreate(Sender: TObject);
-begin
- mime:=TMimemess.create;
-end;
-
-procedure TForm1.FormDestroy(Sender: TObject);
-begin
- mime.free;
-end;
-
-procedure TForm1.Button2Click(Sender: TObject);
-var
- f:string;
-begin
- with TMimePart(Treeview1.Selected.data) do
- begin
- f:=filename;
- if f=''
- then f:='mimedemo.txt';
- f:='c:/'+f;
- Decodepart;
- decodedlines.SaveToFile(f);
- end;
-end;
-
-procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode);
-begin
- memo1.Lines.assign(TMimepart(Node.Data).Lines);
-end;
-
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/modem/ModemDemo.dof b/Source/3rdParty/Synapse/source/demo/modem/ModemDemo.dof
deleted file mode 100644
index 41339f8a..00000000
--- a/Source/3rdParty/Synapse/source/demo/modem/ModemDemo.dof
+++ /dev/null
@@ -1,80 +0,0 @@
-[Compiler]
-A=1
-B=0
-C=1
-D=1
-E=0
-F=0
-G=1
-H=1
-I=1
-J=1
-K=0
-L=1
-M=0
-N=1
-O=1
-P=1
-Q=0
-R=0
-S=0
-T=0
-U=0
-V=1
-W=0
-X=1
-Y=0
-Z=1
-ShowHints=1
-ShowWarnings=1
-UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-
-[Linker]
-MapFile=0
-OutputObjs=0
-ConsoleApp=1
-DebugInfo=0
-MinStackSize=16384
-MaxStackSize=1048576
-ImageBase=4194304
-ExeDescription=
-
-[Directories]
-OutputDir=
-UnitOutputDir=
-SearchPath=
-Packages=
-Conditionals=
-DebugSourceDirs=
-UsePackages=0
-
-[Parameters]
-RunParams=
-HostApplication=
-
-[Version Info]
-IncludeVerInfo=0
-AutoIncBuild=0
-MajorVer=1
-MinorVer=0
-Release=0
-Build=0
-Debug=0
-PreRelease=0
-Special=0
-Private=0
-DLL=0
-Locale=1029
-CodePage=1250
-
-[Version Info Keys]
-CompanyName=
-FileDescription=
-FileVersion=1.0.0.0
-InternalName=
-LegalCopyright=
-LegalTrademarks=
-OriginalFilename=
-ProductName=
-ProductVersion=1.0.0.0
-Comments=
diff --git a/Source/3rdParty/Synapse/source/demo/modem/ModemDemo.dpr b/Source/3rdParty/Synapse/source/demo/modem/ModemDemo.dpr
deleted file mode 100644
index 8d2b4b2c..00000000
--- a/Source/3rdParty/Synapse/source/demo/modem/ModemDemo.dpr
+++ /dev/null
@@ -1,13 +0,0 @@
-program ModemDemo;
-
-uses
- Forms,
- Unit1 in 'Unit1.pas' {Form1};
-
-{$R *.RES}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/modem/Unit1.dfm b/Source/3rdParty/Synapse/source/demo/modem/Unit1.dfm
deleted file mode 100644
index 0b392190..00000000
Binary files a/Source/3rdParty/Synapse/source/demo/modem/Unit1.dfm and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/demo/modem/Unit1.pas b/Source/3rdParty/Synapse/source/demo/modem/Unit1.pas
deleted file mode 100644
index 533a334d..00000000
--- a/Source/3rdParty/Synapse/source/demo/modem/Unit1.pas
+++ /dev/null
@@ -1,49 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- SynaSer, StdCtrls, ExtCtrls;
-
-type
- TForm1 = class(TForm)
- Label1: TLabel;
- Edit1: TEdit;
- Label2: TLabel;
- Edit2: TEdit;
- Edit3: TEdit;
- Label3: TLabel;
- Button1: TButton;
- Bevel1: TBevel;
- Memo1: TMemo;
- procedure Button1Click(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$R *.DFM}
-
-procedure TForm1.Button1Click(Sender: TObject);
-var
- ser:TBlockSerial;
-begin
- ser:=TBlockSerial.Create;
- ser.RaiseExcept:=True;
- try
- ser.Connect(Edit1.Text, StrToIntDef(Edit2.Text, 9600),8,'N',0,false,false);
- memo1.lines.text:=ser.ATCommand(Edit3.Text);
- finally
- ser.free;
- end;
-end;
-
-end.
-
\ No newline at end of file
diff --git a/Source/3rdParty/Synapse/source/demo/scan/IPUtils.pas b/Source/3rdParty/Synapse/source/demo/scan/IPUtils.pas
deleted file mode 100644
index ae212967..00000000
--- a/Source/3rdParty/Synapse/source/demo/scan/IPUtils.pas
+++ /dev/null
@@ -1,117 +0,0 @@
-unit IPUtils;
-
-interface
-
-uses SysUtils;
-
-type TIPAdresse = record
- Oct1,
- Oct2,
- Oct3,
- Oct4:Byte;
- end;
-
-function StrToIP(const Value:String):TIPAdresse;
-function IPToStr(const Adresse:TIPAdresse):String;
-function IPToCardinal(const Adresse:TIPAdresse):Cardinal;
-function CardinalToIP(const Value:Cardinal):TIPAdresse;
-function IsIPAdress(const Value:String):Boolean;
-
-implementation
-
-// IPAdresse in Cardinal umwandeln
-function IPToCardinal(const Adresse:TIPAdresse):Cardinal;
-begin
- Result := (Adresse.Oct1*16777216)
- +(Adresse.Oct2*65536)
- +(Adresse.Oct3*256)
- +(Adresse.Oct4);
-end;
-
-// Cardinal in IP-Adresse umwandeln
-function CardinalToIP(const Value:Cardinal):TIPAdresse;
-begin
- Result.Oct1 := Value div 16777216;
- Result.Oct2 := Value div 65536;
- Result.Oct3 := Value div 256;
- Result.Oct4 := Value mod 256;
-end;
-
-// IP-Adresse in String umwandeln
-function IPToStr(const Adresse:TIPAdresse):String;
-begin
- Result := IntToStr(Adresse.Oct1) + '.' +
- IntToStr(Adresse.Oct2) + '.' +
- IntToStr(Adresse.Oct3) + '.' +
- IntToStr(Adresse.Oct4);
-end;
-
-function StrToIP(const Value:String):TIPAdresse;
-var n,x: Integer;
- Posi:Array[1..4]of Integer;
- Oktet:Array[1..4]of String;
-begin
- x := 0;
- // es dürfen nur Zahlen und Punkte vorhanden sein
- for n := 1 to Length(Value) do
- begin
- // Zähle die Punkte
- if Value[n] = '.'
- then
- begin
- Inc(x);
- Posi[x] := n;
- end
- else Oktet[x+1] := Oktet[x+1] + Value[n];
- end;
- Result.Oct1 := StrToInt(Oktet[1]);
- Result.Oct2 := StrToInt(Oktet[2]);
- Result.Oct3 := StrToInt(Oktet[3]);
- Result.Oct4 := StrToInt(Oktet[4]);
-end;
-
-function IsIPAdress(const Value:String):Boolean;
-var n,x,i: Integer;
- Posi:Array[1..4]of Integer;
- Oktet:Array[1..4]of String;
-begin
- Result := true;
- x := 0;
-
- // es dürfen nur Zahlen und Punkte vorhanden sein
- for n := 1 to Length(Value) do
- if not (Value[n] in ['0'..'9','.'])
- then
- begin
- // ungültiges Zeichen -> keine IP-Adresse
- Result := false;
- break;
- end
- else
- begin
- // Zähle die Punkte
- if Value[n] = '.'
- then
- begin
- Inc(x);
- Posi[x] := n;
- end
- else
- begin
- Oktet[x+1] := Oktet[x+1] + Value[n];
- end;
- end;
-
- for i := 1 to 4 do
- if (StrToInt(Oktet[i])>255)then Result := false;
-
- // es müssen genau 3 Punkte vorhanden sein
- if x <> 3
- then
- begin
- // Anzahl der Punkte <> 3 -> keine IP-Adresse
- Result := false;
- end;
-end;
-
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/scan/PingThread.pas b/Source/3rdParty/Synapse/source/demo/scan/PingThread.pas
deleted file mode 100644
index 88b8eb26..00000000
--- a/Source/3rdParty/Synapse/source/demo/scan/PingThread.pas
+++ /dev/null
@@ -1,48 +0,0 @@
-unit PingThread;
-
-interface
-
-uses Classes, PingSend, IPUtils;
-
-type
- PPingResult = ^TPingResult;
- TPingResult = Record
- IPAdress:String;
- Exists:Boolean;
- end;
-
-
-type
- TPingThread = class(TThread)
- private
- { Private declarations }
- protected
- procedure Execute; override;
- public
- PingResult:TPingResult;
- Ready:Boolean;
- constructor Create(Ping:TPingResult);
- end;
-
-implementation
-
-{ TPingThread }
-
-constructor TPingThread.Create(Ping:TPingResult);
-begin
- PingResult.IPAdress := Ping.IPAdress;
- inherited Create(False);
-end;
-
-procedure TPingThread.Execute;
-var Ping:TPingSend;
-begin
- Ready := false;
- Ping := TPingSend.Create;
- Ping.Timeout := 2000;
- PingResult.Exists := Ping.Ping(PingResult.IPAdress);
- Ping.Free;
- Ready := true;
-end;
-
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/scan/Readme.txt b/Source/3rdParty/Synapse/source/demo/scan/Readme.txt
deleted file mode 100644
index 061e7c88..00000000
--- a/Source/3rdParty/Synapse/source/demo/scan/Readme.txt
+++ /dev/null
@@ -1,16 +0,0 @@
-Scan v1.0
-Synapse Demo Application
-(c) 2003 by Christian Brosius (brosius@online.de)
-
-'Scan v1.0' is a multithreaded ping to scan a given networkrange for
-available IP-Adresses.
-
-Usage:
-
-'scan 192.168.50.1 192.168.50.254' scans a complete Class C Network with
-a timeout for each ping of 2 Seconds.
-
-The complete Scan will finish after about 3 Seconds.
-
-The result will be a sorted list of available IP-Adresses.
-
diff --git a/Source/3rdParty/Synapse/source/demo/scan/Scan.dpr b/Source/3rdParty/Synapse/source/demo/scan/Scan.dpr
deleted file mode 100644
index 56a4ccea..00000000
--- a/Source/3rdParty/Synapse/source/demo/scan/Scan.dpr
+++ /dev/null
@@ -1,95 +0,0 @@
-program Scan;
-
-{$APPTYPE CONSOLE}
-
-uses SysUtils, IPUtils, PingThread;
-
-var i,j:Cardinal;
- Ping:Array of TPingResult;
- PingCount,Cardinal1,Cardinal2:Cardinal;
- Puffer:String;
- ThreadArray:Array of TPingThread;
- ThreadsComplete:Boolean;
-begin
- WriteLn;
- WriteLn('Scan v1.0');
- WriteLn('Synapse Demo Application');
- WriteLn('(c)2003 by Christian Brosius');
- WriteLn;
- if (ParamCount = 2)and // Parse Commandline
- (IsIPAdress(ParamStr(1)))and
- (IsIPAdress(ParamStr(2)))
- then
- begin
- Cardinal1 := IPToCardinal(StrToIP(ParamStr(1)));
- Cardinal2 := IPToCardinal(StrToIP(ParamStr(2)));
- // Count of Adresses to ping
- PingCount := (Cardinal2 - Cardinal1) + 1;
-
- // Show Adresscount to User
- Write('Pinging ' + IntToStr(PingCount) + ' Adresses');
- // Initialize dyn. Arrays
- SetLength(Ping,PingCount);
- SetLength(ThreadArray,PingCount);
- j := 0;
- for i := Cardinal1 to Cardinal2 do
- begin
- Ping[j].IPAdress := IPToStr(CardinalToIP(i));
- Ping[j].Exists := false;
- Inc(j);
- end;
-
- // Create one Thread for each Ping
- for i := 0 to PingCount-1 do
- begin
- ThreadArray[i] := TPingThread.Create(Ping[i]);
- end;
-
- Write(' ');
-
- // Wait till all threads are executed
- repeat
- ThreadsComplete := true;
- Write('.');
- Sleep(1000);
- for i := 0 to PingCount-1 do
- begin
- if not ThreadArray[i].Ready
- then
- begin
- ThreadsComplete := false;
- break;
- end;
- end;
- until ThreadsComplete;
-
- WriteLn;
- WriteLn;
-
- // Show Results to User
- for i := 0 to PingCount-1 do
- begin
- if ThreadArray[i].PingResult.Exists
- then
- begin
- Puffer := IntToStr(i+1) + ' ' + ThreadArray[i].PingResult.IPAdress;
- WriteLn(Puffer);
- end;
- end;
-
- // Free Threads
- for i := 0 to PingCount-1 do
- begin
- ThreadArray[i].Free;
- end;
- end
- else
- begin
- WriteLn('Syntax: Scan StartIP StopIP');
- WriteLn;
- WriteLn('Description:');
- WriteLn(' With Scan you can do a very fast scan of Adresses on your Network-Segment.');
- WriteLn;
- WriteLn('Example: scan 192.168.50.1 192.168.50.254');
- end;
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/sftp/Demo/Main.dfm b/Source/3rdParty/Synapse/source/demo/sftp/Demo/Main.dfm
deleted file mode 100644
index 45b5a579..00000000
--- a/Source/3rdParty/Synapse/source/demo/sftp/Demo/Main.dfm
+++ /dev/null
@@ -1,181 +0,0 @@
-object TestSFTPForm: TTestSFTPForm
- Left = 207
- Top = 107
- Width = 696
- Height = 480
- Caption = 'Test SFTP'
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'MS Sans Serif'
- Font.Style = []
- OldCreateOrder = False
- OnCreate = FormCreate
- OnDestroy = FormDestroy
- PixelsPerInch = 96
- TextHeight = 13
- object Label1: TLabel
- Left = 8
- Top = 8
- Width = 22
- Height = 13
- Caption = 'Host'
- end
- object Label2: TLabel
- Left = 284
- Top = 8
- Width = 19
- Height = 13
- Caption = 'Port'
- end
- object Label3: TLabel
- Left = 8
- Top = 32
- Width = 26
- Height = 13
- Caption = 'Login'
- end
- object Label4: TLabel
- Left = 192
- Top = 32
- Width = 46
- Height = 13
- Caption = 'Password'
- end
- object Label5: TLabel
- Left = 8
- Top = 64
- Width = 48
- Height = 13
- Caption = 'Current dir'
- end
- object HostEdit: TEdit
- Left = 48
- Top = 4
- Width = 209
- Height = 21
- TabOrder = 0
- Text = '212.24.37.138'
- end
- object PortEdit: TEdit
- Left = 316
- Top = 4
- Width = 49
- Height = 21
- TabOrder = 1
- Text = '22'
- end
- object LoginEdit: TEdit
- Left = 48
- Top = 28
- Width = 113
- Height = 21
- TabOrder = 2
- Text = 'atv'
- end
- object PasswordEdit: TEdit
- Left = 252
- Top = 28
- Width = 113
- Height = 21
- PasswordChar = '*'
- TabOrder = 3
- Text = 'atv04040702'
- end
- object CurrentDirEdit: TEdit
- Left = 64
- Top = 60
- Width = 301
- Height = 21
- TabOrder = 5
- end
- object ConnectButton: TButton
- Left = 380
- Top = 4
- Width = 93
- Height = 25
- Caption = 'Connect'
- TabOrder = 4
- OnClick = ConnectButtonClick
- end
- object FileListBox: TListBox
- Left = 8
- Top = 92
- Width = 673
- Height = 353
- Font.Charset = RUSSIAN_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'Courier New'
- Font.Style = []
- ItemHeight = 14
- ParentFont = False
- TabOrder = 12
- OnDblClick = FileListBoxDblClick
- end
- object SendFileButton: TButton
- Left = 476
- Top = 68
- Width = 67
- Height = 21
- Caption = 'Send file...'
- TabOrder = 7
- OnClick = SendFileButtonClick
- end
- object GetFileButton: TButton
- Left = 544
- Top = 68
- Width = 67
- Height = 21
- Caption = 'Get file'
- TabOrder = 8
- OnClick = GetFileButtonClick
- end
- object DeleteButton: TButton
- Left = 612
- Top = 68
- Width = 67
- Height = 21
- Caption = 'Delete'
- TabOrder = 9
- OnClick = DeleteButtonClick
- end
- object ReloadButton: TButton
- Left = 368
- Top = 60
- Width = 57
- Height = 21
- Caption = 'Reload'
- TabOrder = 6
- OnClick = ReloadButtonClick
- end
- object ProgressBar: TProgressBar
- Left = 476
- Top = 45
- Width = 153
- Height = 15
- Min = 0
- Max = 100
- TabOrder = 10
- end
- object AbortButton: TButton
- Left = 632
- Top = 44
- Width = 45
- Height = 17
- Caption = 'Abort'
- TabOrder = 11
- OnClick = AbortButtonClick
- end
- object OpenDialog: TOpenDialog
- Options = [ofHideReadOnly, ofFileMustExist, ofEnableSizing]
- Left = 492
- Top = 12
- end
- object SaveDialog: TSaveDialog
- Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing]
- Left = 572
- Top = 12
- end
-end
diff --git a/Source/3rdParty/Synapse/source/demo/sftp/Demo/Main.pas b/Source/3rdParty/Synapse/source/demo/sftp/Demo/Main.pas
deleted file mode 100644
index 622f756d..00000000
--- a/Source/3rdParty/Synapse/source/demo/sftp/Demo/Main.pas
+++ /dev/null
@@ -1,179 +0,0 @@
-unit Main;
-
-interface
-
-uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls, SimpleSFTP, ComCtrls;
-
-type
- TTestSFTPForm = class(TForm)
- Label1: TLabel;
- Label2: TLabel;
- HostEdit: TEdit;
- PortEdit: TEdit;
- Label3: TLabel;
- LoginEdit: TEdit;
- Label4: TLabel;
- PasswordEdit: TEdit;
- Label5: TLabel;
- CurrentDirEdit: TEdit;
- ConnectButton: TButton;
- FileListBox: TListBox;
- DeleteButton: TButton;
- GetFileButton: TButton;
- SendFileButton: TButton;
- OpenDialog: TOpenDialog;
- SaveDialog: TSaveDialog;
- ReloadButton: TButton;
- ProgressBar: TProgressBar;
- AbortButton: TButton;
- procedure FormCreate(Sender: TObject);
- procedure FormDestroy(Sender: TObject);
- procedure ConnectButtonClick(Sender: TObject);
- procedure FileListBoxDblClick(Sender: TObject);
- procedure SendFileButtonClick(Sender: TObject);
- procedure GetFileButtonClick(Sender: TObject);
- procedure DeleteButtonClick(Sender: TObject);
- procedure ReloadButtonClick(Sender: TObject);
- procedure AbortButtonClick(Sender: TObject);
- private
- { Private declarations }
- FSFTP:TSimpleSFTP;
- FFileList:TSFTPFileList;
- FConnected:Boolean;
- FAbortFlag:Boolean;
- procedure SetCurrentDir(DirName:string);
- function TransferProgress(UserData:Pointer;Current,Total:Int64):Boolean;
- public
- { Public declarations }
- end;
-
-var
- TestSFTPForm: TTestSFTPForm;
-
-implementation
-
-{$R *.DFM}
-
-procedure TTestSFTPForm.FormCreate(Sender: TObject);
-begin
- FSFTP:=TSimpleSFTP.Create;
- FFileList:=TSFTPFileList.Create;
- FConnected:=False;
- FAbortFlag:=False;
-end;
-
-procedure TTestSFTPForm.FormDestroy(Sender: TObject);
-begin
- FFileList.Free;
- FSFTP.Free;
-end;
-
-procedure TTestSFTPForm.ConnectButtonClick(Sender: TObject);
-begin
- if FConnected then
- begin
- FSFTP.Disconnect;
- FConnected:=False;
- ConnectButton.Caption:='Connect';
- end
- else
- begin
- FFileList.Clear;
- FileListBox.Clear;
- CurrentDirEdit.Text:='';
- FSFTP.Connect(HostEdit.Text,PortEdit.Text,LoginEdit.Text,PasswordEdit.Text);
- FConnected:=True;
- ConnectButton.Caption:='Disconnect';
- SetCurrentDir('.');
- end;
-end;
-
-procedure TTestSFTPForm.SetCurrentDir(DirName:string);
-var i:Integer;
-begin
- CurrentDirEdit.Text:=FSFTP.SetCurrentDir(DirName);
- FFileList.Clear;
- FileListBox.Clear;
- FSFTP.ListDir(CurrentDirEdit.Text,FFileList);
- for i:=0 to FFileList.Count-1 do FileListBox.Items.Add(FFileList[i].LongName);
-end;
-
-procedure TTestSFTPForm.ReloadButtonClick(Sender: TObject);
-begin
- SetCurrentDir(CurrentDirEdit.Text);
-end;
-
-procedure TTestSFTPForm.FileListBoxDblClick(Sender: TObject);
-begin
- if FileListBox.Items.Count=0 then Exit;
- with FFileList[FileListBox.ItemIndex]^ do
- if file_type=SSH_FILEXFER_TYPE_DIRECTORY then
- SetCurrentDir(FileName);
-end;
-
-procedure TTestSFTPForm.AbortButtonClick(Sender: TObject);
-begin
- FAbortFlag:=True;
-end;
-
-function TTestSFTPForm.TransferProgress(UserData:Pointer;Current,Total:Int64):Boolean;
-begin
- if Total=0 then ProgressBar.Position:=0
- else ProgressBar.Position:=Round(Current/Total*ProgressBar.Max);
- Application.ProcessMessages;
- Result:=not FAbortFlag;
-end;
-
-procedure TTestSFTPForm.SendFileButtonClick(Sender: TObject);
-begin
- if OpenDialog.Execute then
- begin
- FAbortFlag:=False;
- TransferProgress(nil,0,0);
- FSFTP.PutFile(OpenDialog.FileName,CurrentDirEdit.Text,True,True,False,0,TransferProgress,nil);
- ShowMessage('File transfer completed '+OpenDialog.FileName);
- SetCurrentDir(CurrentDirEdit.Text);
- end;
-end;
-
-procedure TTestSFTPForm.GetFileButtonClick(Sender: TObject);
-begin
- if (FileListBox.Items.Count=0) or (FileListBox.ItemIndex<0) then Exit;
- with FFileList[FileListBox.ItemIndex]^ do
- if file_type=SSH_FILEXFER_TYPE_DIRECTORY then ShowMessage('Not a file')
- else
- begin
- SaveDialog.FileName:=FileName;
- if SaveDialog.Execute then
- begin
- FAbortFlag:=False;
- TransferProgress(nil,0,0);
- FSFTP.GetFile(CurrentDirEdit.Text,FileName,SaveDialog.FileName,True,True,False,0,
- TransferProgress,nil);
- ShowMessage('File transfer completed '+SaveDialog.FileName);
- end;
- end;
-end;
-
-procedure TTestSFTPForm.DeleteButtonClick(Sender: TObject);
-begin
- if (FileListBox.Items.Count=0) then Exit;
- with FFileList[FileListBox.ItemIndex]^ do
- begin
- if file_type=SSH_FILEXFER_TYPE_DIRECTORY then
- begin
- if MessageDlg('Delete dir ?',mtConfirmation,[mbOK,mbCancel],0)<>mrOK then Exit;
- FSFTP.DeleteDir(FileName);
- end
- else
- begin
- if MessageDlg('Delete file ?',mtConfirmation,[mbOK,mbCancel],0)<>mrOK then Exit;
- FSFTP.DeleteFile(FileName);
- end;
- end;
- SetCurrentDir(CurrentDirEdit.Text);
-end;
-
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/sftp/Demo/TestSFTP.dpr b/Source/3rdParty/Synapse/source/demo/sftp/Demo/TestSFTP.dpr
deleted file mode 100644
index 89b6c071..00000000
--- a/Source/3rdParty/Synapse/source/demo/sftp/Demo/TestSFTP.dpr
+++ /dev/null
@@ -1,14 +0,0 @@
-program TestSFTP;
-
-uses
- Forms,
- Main in 'Main.pas' {TestSFTPForm},
- SimpleSFTP in '..\SimpleSFTP.pas';
-
-{$R *.RES}
-
-begin
- Application.Initialize;
- Application.CreateForm(TTestSFTPForm, TestSFTPForm);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/sftp/SimpleSFTP.pas b/Source/3rdParty/Synapse/source/demo/sftp/SimpleSFTP.pas
deleted file mode 100644
index 28dc4e17..00000000
--- a/Source/3rdParty/Synapse/source/demo/sftp/SimpleSFTP.pas
+++ /dev/null
@@ -1,1553 +0,0 @@
-unit SimpleSFTP;
-
-interface
-
-uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,ssl_cryptlib,
- StdCtrls, blcksock, syncobjs, winsock, Math, CryptLib;
-
-// Example of SFTP client implementation. Based on
-// http://www.snailbook.com/docs/sftp.txt and PuTTY's source code.
-// Not tested carefully but directory listing and file transfer seems to work.
-// Requires cl32.dll (CryptLib) and Synapse 37b6 or newer !!!
-// If somebody knows how to extract file type information from file attributes
-// packet (I'm not sure that code in TSimpleSFTP.ParseFileNamePacket will work
-// in any case) then please let know to Sergey Gagarin (serg@screens.ru)
-
-const
- //Really developing was started for version 6 (all constants and file
- //attributes are from version 6, but server I've had for
- //testing was version 3, so it was tested for version 3 only !!!
- //Thanks to PuTTY source code, it was very usefull !
- //Please note that not all capabilities were tested carefully !!!
- SFTP_PROTOCOLCURRENTVERSION=3;
-
- //sftp packet types
- SSH_FXP_INIT =1;
- SSH_FXP_VERSION =2;
- SSH_FXP_OPEN =3;
- SSH_FXP_CLOSE =4;
- SSH_FXP_READ =5;
- SSH_FXP_WRITE =6;
- SSH_FXP_LSTAT =7;
- SSH_FXP_FSTAT =8;
- SSH_FXP_SETSTAT =9;
- SSH_FXP_FSETSTAT =10;
- SSH_FXP_OPENDIR =11;
- SSH_FXP_READDIR =12;
- SSH_FXP_REMOVE =13;
- SSH_FXP_MKDIR =14;
- SSH_FXP_RMDIR =15;
- SSH_FXP_REALPATH =16;
- SSH_FXP_STAT =17;
- SSH_FXP_RENAME =18;
- SSH_FXP_READLINK =19;
- SSH_FXP_SYMLINK =20;
- //server responce types
- SSH_FXP_STATUS =101;
- SSH_FXP_HANDLE =102;
- SSH_FXP_DATA =103;
- SSH_FXP_NAME =104;
- SSH_FXP_ATTRS =105;
- //extended packet types
- SSH_FXP_EXTENDED =200;
- SSH_FXP_EXTENDED_REPLY =201;
-// RESERVED_FOR_EXTENSIONS 210-255
-
- //file attributes flags (for protocol version 6, but processed
- //SSH_FILEXFER_ATTR_SIZE, SSH_FILEXFER_ATTR_PERMISSIONS
- //and SSH_FILEXFER_ATTR_ACCESSTIME only !!! (no extensions)
- //also flag 2 is processed but not used
- SSH_FILEXFER_ATTR_SIZE =$00000001;
- SSH_FILEXFER_ATTR_PERMISSIONS =$00000004;
- SSH_FILEXFER_ATTR_ACCESSTIME =$00000008;
- SSH_FILEXFER_ATTR_CREATETIME =$00000010;
- SSH_FILEXFER_ATTR_MODIFYTIME =$00000020;
- SSH_FILEXFER_ATTR_ACL =$00000040;
- SSH_FILEXFER_ATTR_OWNERGROUP =$00000080;
- SSH_FILEXFER_ATTR_SUBSECOND_TIMES =$00000100;
- SSH_FILEXFER_ATTR_BITS =$00000200;
- SSH_FILEXFER_ATTR_ALLOCATION_SIZE =$00000400;
- SSH_FILEXFER_ATTR_TEXT_HINT =$00000800;
- SSH_FILEXFER_ATTR_MIME_TYPE =$00001000;
- SSH_FILEXFER_ATTR_LINK_COUNT =$00002000;
- SSH_FILEXFER_ATTR_UNTRANLATED_NAME =$00004000;
- SSH_FILEXFER_ATTR_EXTENDED =$80000000;
-
- //file types (not present in version 3, but roughly "simulated"
- //in method ParseFileNamePacket (unfortunately, permissions field seems to contain no file type info)
- SSH_FILEXFER_TYPE_REGULAR =1;
- SSH_FILEXFER_TYPE_DIRECTORY =2;
- SSH_FILEXFER_TYPE_SYMLINK =3;
- SSH_FILEXFER_TYPE_SPECIAL =4;
- SSH_FILEXFER_TYPE_UNKNOWN =5;
- SSH_FILEXFER_TYPE_SOCKET =6;
- SSH_FILEXFER_TYPE_CHAR_DEVICE =7;
- SSH_FILEXFER_TYPE_BLOCK_DEVICE =8;
- SSH_FILEXFER_TYPE_FIFO =9;
-
- //permissions
- S_IRUSR =$0000400;
- S_IWUSR =$0000200;
- S_IXUSR =$0000100;
- S_IRGRP =$0000040;
- S_IWGRP =$0000020;
- S_IXGRP =$0000010;
- S_IROTH =$0000004;
- S_IWOTH =$0000002;
- S_IXOTH =$0000001;
- S_ISUID =$0004000;
- S_ISGID =$0002000;
- S_ISVTX =$0001000;
- //file type bits in permissions field
- S_IFMT =$0170000;// bitmask for the file type bitfields
- S_IFSOCK =$0140000;// socket
- S_IFLNK =$0120000;// symbolic link
- S_IFREG =$0100000;// regular file
- S_IFBLK =$0060000;// block device
- S_IFDIR =$0040000;// directory
- S_IFCHR =$0020000;// character device
- S_IFIFO =$0010000;// fifo
-
- //file attributes
- SSH_FILEXFER_ATTR_FLAGS_READONLY =$00000001;
- SSH_FILEXFER_ATTR_FLAGS_SYSTEM =$00000002;
- SSH_FILEXFER_ATTR_FLAGS_HIDDEN =$00000004;
- SSH_FILEXFER_ATTR_FLAGS_CASE_INSENSITIVE =$00000008;
- SSH_FILEXFER_ATTR_FLAGS_ARCHIVE =$00000010;
- SSH_FILEXFER_ATTR_FLAGS_ENCRYPTED =$00000020;
- SSH_FILEXFER_ATTR_FLAGS_COMPRESSED =$00000040;
- SSH_FILEXFER_ATTR_FLAGS_SPARSE =$00000080;
- SSH_FILEXFER_ATTR_FLAGS_APPEND_ONLY =$00000100;
- SSH_FILEXFER_ATTR_FLAGS_IMMUTABLE =$00000200;
- SSH_FILEXFER_ATTR_FLAGS_SYNC =$00000400;
- SSH_FILEXFER_ATTR_FLAGS_TRANSLATION_ERR =$00000800;
-
- //file access type
- ACE4_READ_DATA =$00000001;
- ACE4_LIST_DIRECTORY =$00000001;
- ACE4_WRITE_DATA =$00000002;
- ACE4_ADD_FILE =$00000002;
- ACE4_APPEND_DATA =$00000004;
- ACE4_ADD_SUBDIRECTORY =$00000004;
- ACE4_READ_NAMED_ATTRS =$00000008;
- ACE4_WRITE_NAMED_ATTRS =$00000010;
- ACE4_EXECUTE =$00000020;
- ACE4_DELETE_CHILD =$00000040;
- ACE4_READ_ATTRIBUTES =$00000080;
- ACE4_WRITE_ATTRIBUTES =$00000100;
- ACE4_DELETE =$00010000;
- ACE4_READ_ACL =$00020000;
- ACE4_WRITE_ACL =$00040000;
- ACE4_WRITE_OWNER =$00080000;
- ACE4_SYNCHRONIZE =$00100000;
-
- //open file flags
- SSH_FXF_ACCESS_DISPOSITION = $00000007;
- SSH_FXF_CREATE_NEW = $00000000;
- SSH_FXF_CREATE_TRUNCATE = $00000001;
- SSH_FXF_OPEN_EXISTING = $00000002;
- SSH_FXF_OPEN_OR_CREATE = $00000003;
- SSH_FXF_TRUNCATE_EXISTING = $00000004;
- SSH_FXF_ACCESS_APPEND_DATA = $00000008;
- SSH_FXF_ACCESS_APPEND_DATA_ATOMIC = $00000010;
- SSH_FXF_ACCESS_TEXT_MODE = $00000020;
- SSH_FXF_ACCESS_READ_LOCK = $00000040;
- SSH_FXF_ACCESS_WRITE_LOCK = $00000080;
- SSH_FXF_ACCESS_DELETE_LOCK = $00000100;
- SSH_FXF_NOFOLLOW = $00000200;
-
- //open file flags for protocol version 3 (as in PuTTY)
- SSH_FXF_READ =$00000001;
- SSH_FXF_WRITE =$00000002;
- SSH_FXF_APPEND =$00000004;
- SSH_FXF_CREAT =$00000008;
- SSH_FXF_TRUNC =$00000010;
- SSH_FXF_EXCL =$00000020;
-
- //rename flags
- SSH_FXP_RENAME_OVERWRITE =$00000001;
- SSH_FXP_RENAME_ATOMIC =$00000002;
- SSH_FXP_RENAME_NATIVE =$00000004;
-
- //error codes
- SSH_FX_OK =0;
- SSH_FX_EOF =1;
- SSH_FX_NO_SUCH_FILE =2;
- SSH_FX_PERMISSION_DENIED =3;
- SSH_FX_FAILURE =4;
- SSH_FX_BAD_MESSAGE =5;
- SSH_FX_NO_CONNECTION =6;
- SSH_FX_CONNECTION_LOST =7;
- SSH_FX_OP_UNSUPPORTED =8;
- SSH_FX_INVALID_HANDLE =9;
- SSH_FX_NO_SUCH_PATH =10;
- SSH_FX_FILE_ALREADY_EXISTS =11;
- SSH_FX_WRITE_PROTECT =12;
- SSH_FX_NO_MEDIA =13;
- SSH_FX_NO_SPACE_ON_FILESYSTEM =14;
- SSH_FX_QUOTA_EXCEEDED =15;
- SSH_FX_UNKNOWN_PRINCIPLE =16;
- SSH_FX_LOCK_CONFlICT =17;
- SSH_FX_DIR_NOT_EMPTY =18;
- SSH_FX_NOT_A_DIRECTORY =19;
- SSH_FX_INVALID_FILENAME =20;
- SSH_FX_LINK_LOOP =21;
-
-type
- TSimpleSFTP=class;//main class
-
- TSFTPFileAttributes=record //complete structure for protocol version 6
- FileName:string;
- LongName:string;//present in version 3 only !
- valid_attribute_flags:DWORD;
- file_type:byte;// always present
- size:int64;// present only if flag SIZE
- allocation_size:int64;// present only if flag ALLOCATION_SIZE
- owner:string;// present only if flag OWNERGROUP
- group:string;// present only if flag OWNERGROUP
- permissions:DWORD;// present only if flag PERMISSIONS
- atime:int64;// present only if flag ACCESSTIME
- atime_nseconds:DWORD;// present only if flag SUBSECOND_TIMES
- createtime:int64;// present only if flag CREATETIME
- createtime_nseconds:DWORD;// present only if flag SUBSECOND_TIMES
- mtime:int64;// present only if flag MODIFYTIME
- mtime_nseconds:DWORD;// present only if flag SUBSECOND_TIMES
- acl:string;// present only if flag ACL
- attrib_bits:DWORD;// present only if flag BITS
- text_hint:byte;// present only if flag TEXT_HINT
- mime_type:string;// present only if flag MIME_TYPE
- link_count:DWORD;// present only if flag LINK_COUNT
- untranslated_name:string;// present only if flag UNTRANSLATED_NAME
- extended_count:DWORD;// present only if flag EXTENDED - parsed but not used here !
-// extended_type:string;// not used here !
-// extended_data:string;//
- end;
- PSFTPFileAttributes=^TSFTPFileAttributes;
- //'atime', 'createtime', and 'mtime' - seconds from Jan 1, 1970 in UTC
-
- TSFTPFileList=class(TObject)
- protected
- FList:TList;
- function GetFile(i:Integer):PSFTPFileAttributes;
- public
- constructor Create;
- destructor Destroy;override;
- procedure Clear;
- function Count:Integer;
- procedure Add(FileRecord:TSFTPFileAttributes);
- procedure Delete(i:Integer);
- procedure Exchange(i,j:Integer);
- procedure Sort(Compare:TListSortCompare);
-
- property Files[i:Integer]:PSFTPFileAttributes read GetFile;default;
- end;
-
- TSimpleSFTPProgressCallback=function (UserData:Pointer;
- Current,Total:Int64):Boolean of object;//returns False to abort
- TSimpleSMPTEvent=procedure (Sender:TSimpleSFTP) of object;
-
- TSimpleSFTP=class(TObject)
- private
- //just utils to set file times for local files
- procedure GetLocalFileTimes(FileName:string;var AccessTime,CreateTime,ModifyTime:Int64);
- procedure SetLocalFileTimes(FileName:string;AccessTime,CreateTime,ModifyTime:Int64);
- //The only way we read server's data ! Do not use other socket read operations !
- procedure ReceiveBuffer(Buffer:PChar;BufferSize:Integer);
- protected
- FSocket:TTCPBlockSocket;
- FTimeout:DWORD;// timeout for data waitng (miliseconds)
- FProtocolVersion:DWORD;
- FRequestID:DWORD;
- FEndOfLine:string;//processed but not used
- FBufferSize:DWORD;
- FRemotePathSeparator:string;
- FCurrentDir:string;
-
- procedure DoError(ErrorMessage:string);
- procedure ResetSessionParams;
- //file names and attributes processing
- function ValidateRemoteDirName(RemoteDir:string):string;
- function ParseFileNamePacket(FileList:TSFTPFileList;PacketData:string;ProcessAttributes:Boolean=True):Integer;
- function ParseFileAttributes(AtributesString:string;var FieldOffset:Integer):TSFTPFileAttributes;
- function BuildAttributesString(FileAttributes:PSFTPFileAttributes):string;
- function BuildBlankAttributesString(IsDir:Boolean=False):string;
- //sftp packet constructing and parsing
- function BuildPacket(PaketType:Byte;Data:array of Pointer;DataSize:array of DWORD;
- IsFixedSize:array of Boolean;SendRequestID:Boolean=True):string;
- procedure AddDataToPacket(var PacketString:string;Data:array of Pointer;
- DataSize:array of DWORD;IsFixedSize:array of Boolean);//to build packet step by step
- function ParsePacketStrings(Data:string;Offset:Integer=0):TStringList;
- function GetStatus(PacketData:string):DWORD;//get status from server's SSH_FXP_STATUS packet
- function CheckStatus(PacketType:DWORD;PacketData:string;ErrorString:string):Boolean;
-
- procedure SendPacket(Packet:string);
- function ReceivePacket(RequestID:DWORD;var PacketType:Byte;ReceiveRequestID:Boolean=True):string;
-
- procedure Init;
- //internal file/dir operations
- function SetRealPath(DirName:string):string;
- function OpenFile(FileName:string;FileOpenFlags:DWORD):string;
- function CloseFile(FileHandle:string):Boolean;
- function OpenDir(DirName:string):string;
- function CloseDir(DirHandle:string):Boolean;
- function ReadFile(FileHandle:string;FileOffset:Int64;ReadSize:DWORD):string;
- procedure WriteFile(FileHandle:string;FileOffset:Int64;FileData:Pointer;DataSize:DWORD);
- procedure ReadDir(DirHandle:string;FileList:TSFTPFileList);
- //internal file attributes operations
- procedure InternalGetFileAtributes(PacketType:BYTE;FileID:string;//name or handle
- AttributeFlags:DWORD;var Attributes:TSFTPFileAttributes);
- procedure GetFileAtributesByHandle(FileHandle:string;var Attributes:TSFTPFileAttributes);
- procedure SetFileAtributesByHandle(FileHandle:string;Attributes:PSFTPFileAttributes);
- procedure GetFileTimesByHandle(FileHandle:string;var AccessTime,CreateTime,ModifyTime:Int64);
- procedure SetFileTimesByHandle(FileHandle:string;AccessTime,CreateTime,ModifyTime:Int64);
- function GetFileSizeByHandle(FileHandle:string):Int64;
- public
- constructor Create;virtual;
- destructor Destroy;override;
-
- procedure Connect(Host,Port,UserName,Password:string);
- procedure Disconnect;
-
- //file operation
- function PutFile(LocalFileName,RemoteDir:string;PreserveFileTimes:Boolean=True;Overwrite:Boolean=True;
- Append:Boolean=False;SourceStartPos:Int64=0;Callback:TSimpleSFTPProgressCallback=nil;UserData:Pointer=nil):Int64;
- function GetFile(RemoteDir,RemoteFileName,LocalFileName:string;PreserveFileTimes:Boolean=True;Overwrite:Boolean=True;
- Append:Boolean=False;SourceStartPos:Int64=0;Callback:TSimpleSFTPProgressCallback=nil;UserData:Pointer=nil):Int64;
- procedure DeleteFile(FileName:string);
- procedure RenameFile(OldName,NewName:string;FailIfExists:Boolean);
- function FileExists(FileName:string):Boolean;
-
- //dir operation (not all tested :-) )
- function GetCurrentDir:string;
- function SetCurrentDir(DirName:string):string;
- procedure ListDir(DirName:string;FileList:TSFTPFileList);
- procedure CreateDir(DirName:string;Attributes:PSFTPFileAttributes=nil);
- procedure DeleteDir(DirName:string);
-
- //file attributes opearations
- procedure GetFileAtributes(FileName:string;var Attributes:TSFTPFileAttributes;FollowLink:Boolean=True);
- procedure SetFileAtributes(FileName:string;Attributes:PSFTPFileAttributes);
- procedure GetFileTimes(FileName:string;var AccessTime,CreateTime,ModifyTime:Int64);
- procedure SetFileTimes(FileName:string;AccessTime,CreateTime,ModifyTime:Int64);
- function GetFileSize(FileName:string):Int64;
-
- property Socket:TTCPBlockSocket read FSocket;
- end;
-
-implementation
-
-const //error messages
- STRING_NOTIMPLEMENTED='Not implemented';
- STRING_INVALIDOUTPACKETDATA='Invalid out packet data';
- STRING_INVALIDINPACKETDATA='Invalid in packet data';
- STRING_UNEXPECTEDPACKETTYPE='Unexpected packet type';
- STRING_UNABLETOINIT='Unable to init';
- STRING_INVALIDBUFFERSIZE='Invalid buffer size';
- STRING_INVALIDFILEPOS='Invalid file position';
- STRING_FILETRANSFERABORTED='File transfer aborted';
- STRING_UNABLETOOPENFILE='Unable to open file';
- STRING_UNABLETOOPENDIR='Unable to open directory';
- STRING_UNABLETOCLOSEHANDLE='Unable to close handle';
- STRING_UNABLETOREADFILE='Unable to read file';
- STRING_UNABLETOREADDIR='Unable to read directory';
- STRING_UNABLETOWRITETOFILE='Unable to write to file';
- STRING_UNABLETODELETEFILE='Unable to delete file';
- STRING_UNABLETORENAMEFILE='Unable to rename file';
- STRING_UNABLETOCREATEDIR='Unable to create directory';
- STRING_UNABLETODELETEDIR='Unable to delete directory';
- STRING_UNABLETOSETFILEATTRIBUTES='Unable to set file attributes';
- STRING_INVALIDFILENAMECOUNT='Invalid file name count';
- STRING_RECEIVETIMEOUT='Receive timeout';
- STRING_UNEXPECTEDSSHMESSAGE='Unexpected SSH message';
- STRING_INVALIDCHANNELID='Invalid channel ID';
- STRING_INVALIDPROTOCOLVERSION='Invalid protocol version';
- STRING_UNABLETOSETPATH='Unable to set path';
- STRING_UNABLETOSETBUFFERSIZE='Unable to set buffer size';
- STRING_UNABLETOGETFILEATTRIBUTES='Unable to get file attributes';
- STRING_UNABLETOGETFILESIZE='Unable to get file size';
- STRING_UNABLETOGETFILETIMES='Unable to get file times';
- STRING_UNABLETOSETFILETIMES='Unable to set file times';
- STRING_UNABLETORECEIVEPACKETDATA='Unable to receive packet data';
- STRING_UNABLETOSENDPACKETDATA='Unable to receive packet data';
- STRING_UNKNOWNERROR='Unknown error';
-
-
-//************************************************************************
-//************************ File time converting utils ********************
-//************************************************************************
-// FileTime - number of 100-nanosecond intervals since January 1, 1601
-// SFTPFileTime - number of seconds since January 1, 1970
-// day_diff=134774
-const
- DAY_DIFF:Int64=134774;
- SECONDS_IN_DAY:Int64=86400;
-
-function FileTimeToSFTPFileTime(FileTime:Int64):Int64;
-begin
- Result:=(FileTime div 10000000)-DAY_DIFF*SECONDS_IN_DAY;
-end;
-
-function SFTPFileTimeToFileTime(FileTime:Int64):Int64;
-begin
- Result:=(FileTime+DAY_DIFF*SECONDS_IN_DAY)*10000000;
-end;
-
-//************************************************************************
-//************** Some utils to work with SFTP packet fields **************
-//************************************************************************
-
-function PutDataToString(Buffer:Pointer;Size:Integer):string;
-begin
- SetLength(Result,Size);
- CopyMemory(@Result[1],Buffer,Size);
-end;
-
-function InvertDWORD(Value:DWORD):DWORD;//SFTP uses inverted byte order !!!
-begin
- Result:=((Value and $FF) shl 24) or ((Value and $FF00) shl 8) or
- ((Value and $FF0000) shr 8) or ((Value and $FF000000) shr 24);
-end;
-
-function InvertInt64(Value:Int64):Int64;
-begin
- PDWORD(@Result)^:=InvertDWORD(PDWORD(Integer(@Value)+SizeOf(DWORD))^);
- PDWORD(Integer(@Result)+SizeOf(DWORD))^:=InvertDWORD(PDWORD(@Value)^);
-end;
-
-function PutDWORD(Value:DWORD):string;
-begin
- Value:=InvertDWORD(Value);
- Result:=PutDataToString(@Value,SizeOf(Value));
-end;
-
-function GetDWORD(Buffer:Pointer):DWORD;
-begin
- Result:=InvertDWORD(PDWORD(Buffer)^);
-end;
-
-function PutFixedPacketField(Buffer:Pointer;FieldSize:Integer):string;
-var CurDWORD:DWORD;
-begin //fixed size fields (DWORD, QWORD) are stored without field size
- SetLength(Result,FieldSize);
- case FieldSize of
- SizeOf(DWORD): Result:=PutDWORD(PDWORD(Buffer)^);
- SizeOf(Int64):
- Result:=PutDWORD(PDWORD(PChar(Buffer)+SizeOf(DWORD))^)+PutDWORD(PDWORD(Buffer)^);
- else Result:=PutDataToString(Buffer,FieldSize);
- end;
-end;
-
-function PutStringPacketField(Buffer:string):string;
-begin //string fields are stored with their length
- Result:=PutDWORD(Length(Buffer))+Buffer;
-end;
-
-procedure GetFixedPacketField(PacketData:string;var FieldOffset:Integer;
- Buffer:Pointer;FieldSize:Integer);
-var CurDWORD:DWORD;
-begin
- case FieldSize of
- SizeOf(DWORD):
- begin
- CurDWORD:=GetDWORD(@PacketData[FieldOffset]);
- CopyMemory(Buffer,@CurDWORD,SizeOf(DWORD));
- end;
- SizeOf(Int64):
- begin
- CurDWORD:=GetDWORD(@PacketData[FieldOffset]);
- CopyMemory(PChar(Buffer)+SizeOf(DWORD),@CurDWORD,SizeOf(DWORD));
- CurDWORD:=GetDWORD(@PacketData[FieldOffset+SizeOf(DWORD)]);
- CopyMemory(Buffer,@CurDWORD,SizeOf(DWORD));
- end;
- else CopyMemory(Buffer,@PacketData[FieldOffset],FieldSize);
- end;
- Inc(FieldOffset,FieldSize);
-end;
-
-function GetStringPacketField(PacketData:string;var FieldOffset:Integer):string;
-var FieldSize:DWORD;
-begin
- FieldSize:=GetDWORD(@PacketData[FieldOffset]);
- Inc(FieldOffset,SizeOf(FieldSize));
- SetLength(Result,FieldSize);
- CopyMemory(@Result[1],@PacketData[FieldOffset],FieldSize);
- Inc(FieldOffset,FieldSize);
-end;
-
-//****************************************************************
-//*********************** TSFTPFileList **************************
-//****************************************************************
-// list of file names and attributes
-
-constructor TSFTPFileList.Create;
-begin
- inherited Create;
- FList:=TList.Create;
-end;
-
-destructor TSFTPFileList.Destroy;
-begin
- Clear;
- FList.Free;
- inherited Destroy;
-end;
-
-function TSFTPFileList.GetFile(i:Integer):PSFTPFileAttributes;
-begin
- Result:=PSFTPFileAttributes(FList[i]);
-end;
-
-procedure TSFTPFileList.Clear;
-var i:Integer;
-begin
- for i:=FList.Count-1 downto 0 do Delete(i);
-end;
-
-function TSFTPFileList.Count:Integer;
-begin
- Result:=FList.Count;
-end;
-
-procedure TSFTPFileList.Add(FileRecord:TSFTPFileAttributes);
-var NewRecord:PSFTPFileAttributes;
-begin
- New(NewRecord);
- NewRecord^:=FileRecord;
- FList.Add(NewRecord);
-end;
-
-procedure TSFTPFileList.Delete(i:Integer);
-begin
- Dispose(PSFTPFileAttributes(FList[i]));
- FList.Delete(i);
-end;
-
-procedure TSFTPFileList.Exchange(i,j:Integer);
-begin
- FList.Exchange(i,j);
-end;
-
-procedure TSFTPFileList.Sort(Compare:TListSortCompare);
-begin
- FList.Sort(Compare);
-end;
-
-//************************************************************************
-//****************************** TSimpleSFTP *****************************
-//************************************************************************
-
-constructor TSimpleSFTP.Create;
-begin
- inherited Create;
- FSocket:=TTCPBlockSocket.CreateWithSSL(TSSLCryptLib);
- FSocket.RaiseExcept:=True;
- FTimeout:=60000;
- ResetSessionParams;
-end;
-
-destructor TSimpleSFTP.Destroy;
-begin
- Disconnect;
- try
- FSocket.Free;
- except
- end;
- inherited Destroy;
-end;
-
-procedure TSimpleSFTP.DoError(ErrorMessage:string);
-begin
- if Trim(ErrorMessage)='' then ErrorMessage:=STRING_UNKNOWNERROR;
- raise Exception.Create(ErrorMessage);
-end;
-
-procedure TSimpleSFTP.ResetSessionParams;
-begin
- FProtocolVersion:=SFTP_PROTOCOLCURRENTVERSION;
- FRequestID:=5;
- FEndOfLine:=#13#10;
- FBufferSize:=32768;
- FRemotePathSeparator:='/';
- FCurrentDir:='.';
-end;
-
-procedure TSimpleSFTP.Connect(Host,Port,UserName,Password:string);
-var NoDelay:Boolean;
-begin //setup proxy settings, ... before connecting
- FSocket.RaiseExcept:=True;
- try
- FSocket.Connect(Host,Port);
- //CryptLib manual recommends to disable the Nagle algorithm
- NoDelay:=True;
- setsockopt(FSocket.Socket,IPPROTO_TCP,TCP_NODELAY,@NoDelay,SizeOf(NoDelay));
- //do ssh handshake
- FSocket.SSL.SSLType:=LT_SSHv2;
- FSocket.SSL.Username:=UserName;
- FSocket.SSL.Password:=Password;
- FSocket.SSL.SSHChannelType:='subsystem';
- FSocket.SSL.SSHChannelArg1:='sftp';
- FSocket.SSLDoConnect;
- //negotiate protocol version
- ResetSessionParams;
- Init;
- except
- Disconnect;
- raise;
- end;
-end;
-
-procedure TSimpleSFTP.Disconnect;
-begin
- try
- FSocket.RaiseExcept:=False;
- if FSocket.Socket<>INVALID_SOCKET then FSocket.CloseSocket;
- except
- end;
-end;
-
-procedure TSimpleSFTP.GetLocalFileTimes(FileName:string;var AccessTime,CreateTime,ModifyTime:Int64);
-var Handle:THandle;
-begin //CreateTime is not used in version 3
- CreateTime:=0;
- AccessTime:=0;
- ModifyTime:=0;
- Handle:=CreateFile(PChar(FileName),GENERIC_READ,FILE_SHARE_READ+FILE_SHARE_WRITE,nil,OPEN_EXISTING,0,0);
- try
- if Handle=INVALID_HANDLE_VALUE then DoError(STRING_UNABLETOGETFILETIMES+': '+FileName);
- if not Windows.GetFileTime(Handle,@CreateTime,@AccessTime,@ModifyTime) then Exit;
- CreateTime:=FileTimeToSFTPFileTime(CreateTime);
- AccessTime:=FileTimeToSFTPFileTime(AccessTime);
- ModifyTime:=FileTimeToSFTPFileTime(ModifyTime);
- finally
- CloseHandle(Handle);
- end;
-end;
-
-procedure TSimpleSFTP.SetLocalFileTimes(FileName:string;AccessTime,CreateTime,ModifyTime:Int64);
-var Handle:THandle;AccessTimeP,CreateTimeP,ModifyTimeP:Pointer;
-begin //CreateTime is not used in version 3 (may be set CreateTime:=ModifyTime ?)
- if CreateTime<>0 then CreateTime:=SFTPFileTimeToFileTime(CreateTime);
- if AccessTime<>0 then AccessTime:=SFTPFileTimeToFileTime(AccessTime);
- if ModifyTime<>0 then ModifyTime:=SFTPFileTimeToFileTime(ModifyTime);
- if AccessTime=0 then AccessTimeP:=nil else AccessTimeP:=@AccessTime;
- if CreateTime=0 then CreateTimeP:=nil else CreateTimeP:=@CreateTime;
- if ModifyTime=0 then ModifyTimeP:=nil else ModifyTimeP:=@ModifyTime;
- Handle:=CreateFile(PChar(FileName),GENERIC_WRITE,FILE_SHARE_READ+FILE_SHARE_WRITE,nil,OPEN_EXISTING,0,0);
- try
- if Handle=INVALID_HANDLE_VALUE then DoError(STRING_UNABLETOSETFILETIMES+': '+FileName);
- if not Windows.SetFileTime(Handle,CreateTimeP,AccessTimeP,ModifyTimeP) then Exit;
- finally
- CloseHandle(Handle);
- end;
-end;
-
-function TSimpleSFTP.BuildPacket(PaketType:Byte;Data:array of Pointer;
- DataSize:array of DWORD;IsFixedSize:array of Boolean;SendRequestID:Boolean=True):string;
-var i:Integer;CurField:string;FieldSize:DWORD;
-begin //always increases FRequestID !
- if (Length(Data)<>Length(DataSize)) or (Length(Data)<>Length(IsFixedSize))
- then DoError(STRING_INVALIDOUTPACKETDATA);
- Result:='';
- //store packet fields
- for i:=Low(Data) to High(Data) do
- begin
- FieldSize:=DataSize[i];
- if FieldSize>0 then
- begin
- CurField:=PutDataToString(Data[i],FieldSize);
- //if not IsFixedSize then store field size too
- if not IsFixedSize[i] then CurField:=PutDWORD(FieldSize)+CurField;
- Result:=Result+CurField;
- end;
- end;
- //store packet request id
- if SendRequestID then Result:=PutDWORD(FRequestID)+Result;
- //store packet type
- Result:=Char(PaketType)+Result;
- //store packet size
- Result:=PutDWORD(Length(Result))+Result;
- Inc(FRequestID);
-end;
-
-procedure TSimpleSFTP.AddDataToPacket(var PacketString:string;Data:array of Pointer;
- DataSize:array of DWORD;IsFixedSize:array of Boolean);
-var i:Integer;CurField:string;FieldSize:DWORD;
-begin //just add field to packet string (not increases FRequestID , but modifies packet size)
- if (Length(Data)<>Length(DataSize)) or (Length(Data)<>Length(IsFixedSize))
- or (PacketString='') then DoError(STRING_INVALIDOUTPACKETDATA);
- //store packet fields
- for i:=Low(Data) to High(Data) do
- begin
- FieldSize:=DataSize[i];
- if FieldSize>0 then
- begin
- CurField:=PutDataToString(Data[i],FieldSize);
- if not IsFixedSize[i] then CurField:=PutDWORD(FieldSize)+CurField;
- PacketString:=PacketString+CurField;
- end;
- end;
- //set new packet size
- FieldSize:=Length(PacketString);
- CopyMemory(@PacketString[1],@FieldSize,SizeOf(FieldSize));
-end;
-
-function TSimpleSFTP.ParsePacketStrings(Data:string;Offset:Integer=0):TStringList;
-var CurPos,CurSize:DWORD;
-begin //assumed that packet contains string fields only starting from Offset
- if Offset>0 then Data:=Copy(Data,Offset,Length(Data));
- Result:=TStringList.Create;
- try
- CurPos:=1;
- while CurPos<(Length(Data)-SizeOf(CurSize)+1) do
- begin
- CurSize:=GetDWORD(@Data[CurPos]);
- Result.Add(Copy(Data,CurPos+SizeOf(CurSize),CurSize));
- CurPos:=CurPos+SizeOf(CurSize)+CurSize;
- end;
- except
- Result.Free;
- raise;
- end;
-end;
-
-procedure TSimpleSFTP.SendPacket(Packet:string);
-var SentLength,CurDataSize:Integer;StartTime:DWORD;
-begin
- FSocket.SendBuffer(@Packet[1],Length(Packet));
-end;
-
-procedure TSimpleSFTP.ReceiveBuffer(Buffer:PChar;BufferSize:Integer);
-begin
- FSocket.RecvBufferEx(Buffer,BufferSize,FTimeout);
-end;
-
-function TSimpleSFTP.ReceivePacket(RequestID:DWORD;var PacketType:Byte;ReceiveRequestID:Boolean=True):string;
-var PacketSize,CurRequestID,CurSize,CurDataSize:DWORD;PacketData:string;CurPacketType:BYTE;
- CurData:AnsiString;StartTime:DWORD;ReceivedLength:Integer;CurBuffer:string;
-begin
- Result:='';
- while True do
- begin
- //receive packet size
- ReceiveBuffer(@PacketSize,SizeOf(PacketSize));
- PacketSize:=GetDWORD(@PacketSize);
- //receive packet type
- ReceiveBuffer(@CurPacketType,SizeOf(CurPacketType));
- CurSize:=SizeOf(CurPacketType);
- //receive request id
- if ReceiveRequestID then
- begin
- ReceiveBuffer(@CurRequestID,SizeOf(CurRequestID));
- CurRequestID:=GetDWORD(@CurRequestID);
- CurSize:=CurSize+SizeOf(CurRequestID);
- end;
- //receive packet data
- SetLength(Result,PacketSize-CurSize);
- ReceiveBuffer(@Result[1],Length(Result));
- //check RequestID and PacketType (-1 and 0 means any ...)
- if (not ReceiveRequestID) or (RequestID=-1) or (RequestID=CurRequestID) then
- begin
- if (PacketType<>0) and (PacketType<>CurPacketType) then
- DoError(STRING_UNEXPECTEDPACKETTYPE+': '+IntToStr(PacketType)+'<>'+IntToStr(CurPacketType));
- PacketType:=CurPacketType;
- Break;
- end;
- end;
-end;
-
-procedure TSimpleSFTP.Init;
-var PacketData:string;PacketStrings:TStringList;i,FieldOffset:Integer;PacketType:Byte;
- TmpProtocolVersion,CurProtocolVersion:DWORD;
-begin //negotiate protocol version (we support version 3 only!)
- PacketType:=SSH_FXP_INIT;
- TmpProtocolVersion:=InvertDWORD(FProtocolVersion);
- SendPacket(BuildPacket(PacketType,[@TmpProtocolVersion],[SizeOf(TmpProtocolVersion)],[True],False));
- PacketType:=SSH_FXP_VERSION;
- PacketData:=ReceivePacket(FRequestID-1,PacketType,False);
- FieldOffset:=1;
- //get protocol version
- GetFixedPacketField(PacketData,FieldOffset,@CurProtocolVersion,SizeOf(CurProtocolVersion));
- if FProtocolVersionFRemotePathSeparator then
- DirName:=ValidateRemoteDirName(FCurrentDir)+DirName;
- Result:=SetRealPath(DirName);
- //try open new dir (just to check if it exists)
- DirHandle:=OpenDir(Result);
- CloseDir(DirHandle);
- FCurrentDir:=Result;
-end;
-
-function TSimpleSFTP.GetCurrentDir:string;
-begin
- Result:=SetCurrentDir('.');
-end;
-
-function TSimpleSFTP.SetRealPath(DirName:string):string;
-var PacketType:BYTE;PacketString,PacketData:string;FileList:TSFTPFileList;
-begin
- PacketType:=SSH_FXP_REALPATH;
- DirName:=DirName;
- PacketString:=BuildPacket(PacketType,[@DirName[1]],[Length(DirName)],[False]);
- SendPacket(PacketString);
- PacketType:=0;
- PacketData:=ReceivePacket(FRequestID-1,PacketType,True);
- CheckStatus(PacketType,PacketData,STRING_UNABLETOSETPATH+': '+DirName);
- if PacketType<>SSH_FXP_NAME then DoError(STRING_UNABLETOSETPATH+': '+DirName);
- FileList:=TSFTPFileList.Create;
- try
- ParseFileNamePacket(FileList,PacketData,False);
- if FileList.Count=0 then DoError(STRING_UNABLETOSETPATH+': '+DirName);
- Result:=FileList[0].FileName;
- finally
- FileList.Free;
- end;
-end;
-
-function TSimpleSFTP.FileExists(FileName:string):Boolean;
-var Attributes:TSFTPFileAttributes;FileOpenFlags:DWORD;FileHandle:string;
-begin //catches exception !
- try
- if FProtocolVersion>3 then FileOpenFlags:=SSH_FXF_OPEN_EXISTING
- else FileOpenFlags:=SSH_FXF_READ;
- FileHandle:=OpenFile(FileName,FileOpenFlags);
- CloseFile(FileHandle);
- Result:=True;
- except
- Result:=False;
- end;
-end;
-
-function TSimpleSFTP.GetFileSizeByHandle(FileHandle:string):Int64;
-var Attributes:TSFTPFileAttributes;
-begin
- GetFileAtributesByHandle(FileHandle,Attributes);
- if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_SIZE)<>0 then Result:=Attributes.size
- else DoError(STRING_UNABLETOGETFILESIZE);
-end;
-
-function TSimpleSFTP.GetFileSize(FileName:string):Int64;
-var Attributes:TSFTPFileAttributes;
-begin
- GetFileAtributes(FileName,Attributes);
- if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_SIZE)<>0 then Result:=Attributes.size
- else DoError(STRING_UNABLETOGETFILESIZE);
-end;
-
-procedure TSimpleSFTP.GetFileTimes(FileName:string;var AccessTime,CreateTime,ModifyTime:Int64);
-var Attributes:TSFTPFileAttributes;
-begin
- GetFileAtributes(FileName,Attributes);
- AccessTime:=0;
- CreateTime:=0;
- ModifyTime:=0;
- if FProtocolVersion>3 then
- begin
- if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_ACCESSTIME)<>0 then
- AccessTime:=Attributes.atime;
- if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_CREATETIME)<>0 then
- CreateTime:=Attributes.createtime;
- if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_MODIFYTIME)<>0 then
- ModifyTime:=Attributes.mtime;
- end
- else
- begin
- if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_ACCESSTIME)<>0 then
- begin
- AccessTime:=Attributes.atime;
- ModifyTime:=Attributes.mtime;
- end;
- end;
-end;
-
-procedure TSimpleSFTP.GetFileTimesByHandle(FileHandle:string;var AccessTime,CreateTime,ModifyTime:Int64);
-var Attributes:TSFTPFileAttributes;
-begin
- GetFileAtributesByHandle(FileHandle,Attributes);
- AccessTime:=0;
- CreateTime:=0;
- ModifyTime:=0;
- if FProtocolVersion>3 then
- begin
- if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_ACCESSTIME)<>0 then
- AccessTime:=Attributes.atime;
- if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_CREATETIME)<>0 then
- CreateTime:=Attributes.createtime;
- if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_MODIFYTIME)<>0 then
- ModifyTime:=Attributes.mtime;
- end
- else
- begin
- if (Attributes.valid_attribute_flags and SSH_FILEXFER_ATTR_ACCESSTIME)<>0 then
- begin
- AccessTime:=Attributes.atime;
- ModifyTime:=Attributes.mtime;
- end;
- end;
-end;
-
-function TSimpleSFTP.ValidateRemoteDirName(RemoteDir:string):string;
-begin //just add trailing '/' if needed
- if (RemoteDir<>'') and (Copy(RemoteDir,Length(RemoteDir)-Length(FRemotePathSeparator)+1,
- Length(FRemotePathSeparator))<>FRemotePathSeparator)
- then Result:=RemoteDir+FRemotePathSeparator else Result:=RemoteDir;
-end;
-
-function TSimpleSFTP.PutFile(LocalFileName,RemoteDir:string;PreserveFileTimes:Boolean=True;Overwrite:Boolean=True;
- Append:Boolean=False;SourceStartPos:Int64=0;Callback:TSimpleSFTPProgressCallback=nil;UserData:Pointer=nil):Int64;
-var FileHandle,Buffer:string;FileStream:TFileStream;CurrentRemoteOffset,TotalSize:Int64;CurRead:Integer;
- FileOpenFlags:DWORD;AccessTime,CreateTime,ModifyTime:Int64;RemoteFileName:string;
-begin //returns sent size (indeed if sent size is not file size then raise exception :-) )
- Result:=0;
- FileOpenFlags:=0;
- if FProtocolVersion>3 then
- begin
- if Overwrite then FileOpenFlags:=(FileOpenFlags or SSH_FXF_CREATE_NEW)
- else FileOpenFlags:=(FileOpenFlags or SSH_FXF_OPEN_OR_CREATE);
- if Append and not Overwrite then FileOpenFlags:=FileOpenFlags or SSH_FXF_ACCESS_APPEND_DATA;
- end
- else
- begin //as in PuTTY
- FileOpenFlags:=SSH_FXF_WRITE;
- if Overwrite then FileOpenFlags:=FileOpenFlags or SSH_FXF_WRITE or SSH_FXF_CREAT;
- if not Append then FileOpenFlags:=FileOpenFlags or SSH_FXF_TRUNC;
- end;
- RemoteFileName:=ValidateRemoteDirName(RemoteDir)+ExtractFileName(LocalFileName);
- //open remote file
- FileHandle:=OpenFile(RemoteFileName,FileOpenFlags);
- try
- if Append then CurrentRemoteOffset:=GetFileSizeByHandle(FileHandle) else CurrentRemoteOffset:=0;
- if FBufferSize<=0 then DoError(STRING_INVALIDBUFFERSIZE);
- SetLength(Buffer,FBufferSize);
- //open local file
- FileStream:=TFileStream.Create(LocalFileName,fmOpenRead or fmShareDenyNone);
- try
- TotalSize:=FileStream.Size-SourceStartPos;
- //local file offset
- FileStream.Seek(SourceStartPos,soFromBeginning);
- if FileStream.Position<>SourceStartPos then
- DoError(STRING_INVALIDFILEPOS+': '+LocalFileName+' ('+IntToStr(SourceStartPos)+')');
- while Result0 then //write remote file
- WriteFile(FileHandle,CurrentRemoteOffset,@Buffer[1],CurRead);
- CurrentRemoteOffset:=CurrentRemoteOffset+CurRead;
- Result:=Result+CurRead;
- if CurRead3 then FileOpenFlags:=SSH_FXF_OPEN_EXISTING
- else FileOpenFlags:=SSH_FXF_READ;
- RemoteFileName:=ValidateRemoteDirName(RemoteDir)+RemoteFileName;
- //open remote file
- FileHandle:=OpenFile(RemoteFileName,FileOpenFlags);
- try
- if FBufferSize<=0 then DoError(STRING_INVALIDBUFFERSIZE);
- FileOpenFlags:=0;
- if Overwrite then
- begin
- SysUtils.DeleteFile(LocalFileName);
- FileOpenFlags:=fmCreate;
- end
- else FileOpenFlags:=fmOpenWrite;
- //open local file
- FileStream:=TFileStream.Create(LocalFileName,FileOpenFlags);
- try
- //local file offset
- if Append and not Overwrite then FileStream.Seek(0,soFromEnd);
- //remote file size
- TotalSize:=GetFileSizeByHandle(FileHandle)-SourceStartPos;
- if TotalSize<0 then DoError(STRING_INVALIDFILEPOS+': '+RemoteFileName+' ('+IntToStr(SourceStartPos)+')');
- while Result0 then //write local file
- FileStream.Write(Buffer[1],CurRead);
- Inc(SourceStartPos,CurRead);
- Inc(Result,CurRead);
- if CurRead3 then FileAccessSize:=SizeOf(FileAccess) else FileAccessSize:=0;
- FileAccess:=ACE4_WRITE_DATA+ACE4_WRITE_ATTRIBUTES;
- AtributesString:=BuildBlankAttributesString;
- FileAccess:=InvertDWORD(FileAccess);
- FileOpenFlags:=InvertDWORD(FileOpenFlags);
- PacketString:=BuildPacket(PacketType,[@FileName[1],@FileAccess,@FileOpenFlags,@AtributesString[1]],
- [Length(FileName),FileAccessSize,SizeOf(FileOpenFlags),Length(AtributesString)],
- [False,True,True,True]);
- SendPacket(PacketString);
- PacketType:=0;
- PacketData:=ReceivePacket(FRequestID-1,PacketType);
- CheckStatus(PacketType,PacketData,STRING_UNABLETOOPENFILE+': '+FileName);
- if (PacketType<>SSH_FXP_HANDLE) then DoError(STRING_UNABLETOOPENFILE+': '+FileName);
- //get file handle
- FieldOffset:=1;
- Result:=GetStringPacketField(PacketData,FieldOffset);
-end;
-
-function TSimpleSFTP.OpenDir(DirName:string):string;
-var PacketType:BYTE;PacketString,PacketData:string;FieldOffset:Integer;
-begin
- PacketType:=SSH_FXP_OPENDIR;
- PacketString:=BuildPacket(PacketType,[@DirName[1]],[Length(DirName)],[False]);
- SendPacket(PacketString);
- PacketType:=0;
- PacketData:=ReceivePacket(FRequestID-1,PacketType);
- CheckStatus(PacketType,PacketData,STRING_UNABLETOOPENDIR+': '+DirName);
- if (PacketType<>SSH_FXP_HANDLE) then DoError(STRING_UNABLETOOPENDIR+': '+DirName);
- //get dir handle
- FieldOffset:=1;
- Result:=GetStringPacketField(PacketData,FieldOffset);
-end;
-
-function TSimpleSFTP.CloseFile(FileHandle:string):Boolean;
-var PacketType:BYTE;PacketString,PacketData:string;
-begin
- PacketType:=SSH_FXP_CLOSE;
- PacketString:=BuildPacket(PacketType,[@FileHandle[1]],[Length(FileHandle)],[False]);
- SendPacket(PacketString);
- PacketType:=0;
- PacketData:=ReceivePacket(FRequestID-1,PacketType);
- CheckStatus(PacketType,PacketData,STRING_UNABLETOCLOSEHANDLE+': '+FileHandle);
- Result:=True;
-end;
-
-function TSimpleSFTP.CloseDir(DirHandle:string):Boolean;
-begin
- Result:=CloseFile(DirHandle);
-end;
-
-function TSimpleSFTP.ReadFile(FileHandle:string;FileOffset:Int64;ReadSize:DWORD):string;
-var PacketType:BYTE;PacketString,PacketData:string;FieldOffset:Integer;
-begin
- Result:='';
- PacketType:=SSH_FXP_READ;
- FileOffset:=InvertInt64(FileOffset);
- ReadSize:=InvertDWORD(ReadSize);
- PacketString:=BuildPacket(PacketType,[@FileHandle[1],@FileOffset,@ReadSize],
- [Length(FileHandle),SizeOf(FileOffset),SizeOf(ReadSize)],[False,True,True]);
- SendPacket(PacketString);
- PacketType:=0;
- PacketData:=ReceivePacket(FRequestID-1,PacketType);
- case PacketType of
- SSH_FXP_STATUS:
- begin //server can say "EOF" or error
- if GetStatus(PacketData)=SSH_FX_EOF then Exit
- else CheckStatus(PacketType,PacketData,STRING_UNABLETOREADFILE+': '+FileHandle);
- end;
- SSH_FXP_DATA:
- begin
- FieldOffset:=1;
- Result:=GetStringPacketField(PacketData,FieldOffset);
- end;
- else DoError(STRING_UNABLETOREADFILE+': '+FileHandle);
- end;
-end;
-
-procedure TSimpleSFTP.ReadDir(DirHandle:string;FileList:TSFTPFileList);
-var PacketType:BYTE;PacketString,PacketData:string;
-begin
- FileList.Clear;
- PacketType:=SSH_FXP_READDIR;
- PacketString:=BuildPacket(PacketType,[@DirHandle[1]],[Length(DirHandle)],[False]);
- while True do
- begin
- SendPacket(PacketString);
- PacketType:=0;
- PacketData:=ReceivePacket(FRequestID-1,PacketType);
- case PacketType of
- SSH_FXP_STATUS:
- begin //server can say "EOF" or error
- if GetStatus(PacketData)=SSH_FX_EOF then Break
- else CheckStatus(PacketType,PacketData,STRING_UNABLETOREADDIR+': '+DirHandle);
- end;
- SSH_FXP_NAME:
- begin //PacketData can contain 1 or more file info
- ParseFileNamePacket(FileList,PacketData);
- end;
- else DoError(STRING_UNABLETOREADDIR+': '+DirHandle+' ('+STRING_UNEXPECTEDPACKETTYPE+
- ' '+IntToStr(PacketType)+')');
- end;
- end;
-end;
-
-function TSimpleSFTP.ParseFileNamePacket(FileList:TSFTPFileList;PacketData:string;
- ProcessAttributes:Boolean=True):Integer;
-var NameCount,i:DWORD;FileAttributes:TSFTPFileAttributes;FileName,LongName:string;FieldOffset:Integer;
-begin //returns count of file records added to FileList
- Result:=0;
- FieldOffset:=1;
- //get file record count
- GetFixedPacketField(PacketData,FieldOffset,@NameCount,SizeOf(NameCount));
- //get names and attributes
- for i:=1 to NameCount do
- begin
- FileName:=GetStringPacketField(PacketData,FieldOffset);
- if FProtocolVersion<=3 then LongName:=GetStringPacketField(PacketData,FieldOffset);
- if ProcessAttributes then FileAttributes:=ParseFileAttributes(PacketData,FieldOffset);
- FileAttributes.FileName:=FileName;
- if (FileAttributes.permissions and S_IFMT)<>0 then
- begin //we trying to check file type bits in permissions, but it seems to contain no file type bits
- if (FileAttributes.permissions and S_IFLNK)<>0 then FileAttributes.file_type:=SSH_FILEXFER_TYPE_SYMLINK
- else if (FileAttributes.permissions and S_IFREG)<>0 then FileAttributes.file_type:=SSH_FILEXFER_TYPE_REGULAR
- else if (FileAttributes.permissions and S_IFDIR)<>0 then FileAttributes.file_type:=SSH_FILEXFER_TYPE_DIRECTORY
- else FileAttributes.file_type:=SSH_FILEXFER_TYPE_UNKNOWN;
- end
- else
- begin
- if (FProtocolVersion<=3) and (LongName<>'') then
- begin //try to parse long file name (assumed it has the form of "ls -l" listing);
- FileAttributes.LongName:=LongName;
- case LongName[1] of //just simple file_type emulation :-) (it works with my server)
- '-': FileAttributes.file_type:=SSH_FILEXFER_TYPE_REGULAR;
- 'd': FileAttributes.file_type:=SSH_FILEXFER_TYPE_DIRECTORY;
- 'l': FileAttributes.file_type:=SSH_FILEXFER_TYPE_SYMLINK;
- '/': FileAttributes.file_type:=SSH_FILEXFER_TYPE_DIRECTORY;//in SetRealPath
- else FileAttributes.file_type:=SSH_FILEXFER_TYPE_UNKNOWN;
- end;
- end;
- end;
- FileList.Add(FileAttributes);
- Inc(Result);
- end;
-end;
-
-procedure ResetFileAttributes(FileAttributes:PSFTPFileAttributes);
-begin
- with FileAttributes^ do
- begin
- FileName:='';
- LongName:='';
- valid_attribute_flags:=0;
- file_type:=0;// always present (not in version 3)
- size:=0;// present only if flag SIZE
- allocation_size:=0;// present only if flag ALLOCATION_SIZE
- owner:='';// present only if flag OWNERGROUP
- group:='';// present only if flag OWNERGROUP
- permissions:=0;// present only if flag PERMISSIONS
- atime:=0;// present only if flag ACCESSTIME
- atime_nseconds:=0;// present only if flag SUBSECOND_TIMES
- createtime:=0;// present only if flag CREATETIME
- createtime_nseconds:=0;// present only if flag SUBSECOND_TIMES
- mtime:=0;// present only if flag MODIFYTIME
- mtime_nseconds:=0;// present only if flag SUBSECOND_TIMES
- acl:='';// present only if flag ACL
- attrib_bits:=0;// present only if flag BITS
- text_hint:=0;// present only if flag TEXT_HINT
- mime_type:='';// present only if flag MIME_TYPE
- link_count:=0;// present only if flag LINK_COUNT
- untranslated_name:='';// present only if flag UNTRANSLATED_NAME
- extended_count:=0;// present only if flag EXTENDED
-// extended_type:string;
-// extended_data:string;
- end;
-end;
-
-function TSimpleSFTP.ParseFileAttributes(AtributesString:string;var FieldOffset:Integer):TSFTPFileAttributes;
-var TmpInt64:Int64;TmpDWORD:DWORD;TmpString:string;i:Integer;
- procedure CopyFixedAttribute(CopyFlag:DWORD;CopyTo:Pointer;CopySize:Integer);
- begin
- if (Result.valid_attribute_flags and CopyFlag)<>0 then
- GetFixedPacketField(AtributesString,FieldOffset,CopyTo,CopySize);
- end;
- procedure CopyStringAttribute(CopyFlag:DWORD;var CopyTo:string);
- begin
- if (Result.valid_attribute_flags and CopyFlag)<>0 then
- CopyTo:=GetStringPacketField(AtributesString,FieldOffset);
- end;
-begin //version 3 parsing - like in PuTTY
- ResetFileAttributes(@Result);
- with Result do
- begin
- GetFixedPacketField(AtributesString,FieldOffset,@valid_attribute_flags,SizeOf(valid_attribute_flags));
- if FProtocolVersion>3 then
- GetFixedPacketField(AtributesString,FieldOffset,@file_type,SizeOf(file_type));
- CopyFixedAttribute(SSH_FILEXFER_ATTR_SIZE,@size,SizeOf(size));
- if FProtocolVersion<=3 then
- CopyFixedAttribute(2,@TmpInt64,SizeOf(TmpInt64));
- if FProtocolVersion>3 then
- begin
- CopyFixedAttribute(SSH_FILEXFER_ATTR_ALLOCATION_SIZE,@allocation_size,SizeOf(allocation_size));
- CopyStringAttribute(SSH_FILEXFER_ATTR_OWNERGROUP,owner);
- CopyStringAttribute(SSH_FILEXFER_ATTR_OWNERGROUP,group);
- end;
- CopyFixedAttribute(SSH_FILEXFER_ATTR_PERMISSIONS,@permissions,SizeOf(permissions));
- if FProtocolVersion>3 then
- begin
- CopyFixedAttribute(SSH_FILEXFER_ATTR_ACCESSTIME,@atime,SizeOf(atime));
- CopyFixedAttribute(SSH_FILEXFER_ATTR_ACCESSTIME or SSH_FILEXFER_ATTR_SUBSECOND_TIMES,@atime_nseconds,SizeOf(atime_nseconds));
- CopyFixedAttribute(SSH_FILEXFER_ATTR_CREATETIME,@createtime,SizeOf(createtime));
- CopyFixedAttribute(SSH_FILEXFER_ATTR_CREATETIME or SSH_FILEXFER_ATTR_SUBSECOND_TIMES,@createtime_nseconds,SizeOf(createtime_nseconds));
- CopyFixedAttribute(SSH_FILEXFER_ATTR_MODIFYTIME,@mtime,SizeOf(mtime));
- CopyFixedAttribute(SSH_FILEXFER_ATTR_MODIFYTIME or SSH_FILEXFER_ATTR_SUBSECOND_TIMES,@mtime_nseconds,SizeOf(mtime_nseconds));
- end
- else
- begin
- TmpDWORD:=0;
- CopyFixedAttribute(SSH_FILEXFER_ATTR_ACCESSTIME,@TmpDWORD,SizeOf(TmpDWORD));
- atime:=TmpDWORD;
- TmpDWORD:=0;
- CopyFixedAttribute(SSH_FILEXFER_ATTR_ACCESSTIME,@TmpDWORD,SizeOf(TmpDWORD));
- mtime:=TmpDWORD;
- end;
- if FProtocolVersion>3 then
- begin
- CopyStringAttribute(SSH_FILEXFER_ATTR_ACL,acl);
- if FProtocolVersion>4 then
- CopyFixedAttribute(SSH_FILEXFER_ATTR_BITS,@attrib_bits,SizeOf(attrib_bits));
- CopyFixedAttribute(SSH_FILEXFER_ATTR_TEXT_HINT,@text_hint,SizeOf(text_hint));
- CopyStringAttribute(SSH_FILEXFER_ATTR_MIME_TYPE,mime_type);
- CopyFixedAttribute(SSH_FILEXFER_ATTR_LINK_COUNT,@link_count,SizeOf(link_count));
- CopyStringAttribute(SSH_FILEXFER_ATTR_UNTRANLATED_NAME,untranslated_name);
- end;
- extended_count:=0;
- CopyFixedAttribute(SSH_FILEXFER_ATTR_EXTENDED,@extended_count,SizeOf(extended_count));
- for i:=1 to extended_count do
- begin //parsed but not used
- GetStringPacketField(AtributesString,FieldOffset);//extended_type
- GetStringPacketField(AtributesString,FieldOffset);//extended_data
- end;
- end;
-end;
-
-function TSimpleSFTP.BuildBlankAttributesString(IsDir:Boolean=False):string;
-var FileAttributes:TSFTPFileAttributes;
-begin
- ResetFileAttributes(@FileAttributes);
- if IsDir then FileAttributes.file_type:=SSH_FILEXFER_TYPE_DIRECTORY
- else FileAttributes.file_type:=SSH_FILEXFER_TYPE_REGULAR;
- Result:=BuildAttributesString(@FileAttributes);
-end;
-
-function TSimpleSFTP.BuildAttributesString(FileAttributes:PSFTPFileAttributes):string;
-var TmpInt64:Int64;TmpDWORD:DWORD;
- procedure AddFixedAttributeString(CopyFlag:DWORD;CurAttribute:Pointer;CurSize:Integer);
- begin
- if (FileAttributes^.valid_attribute_flags and CopyFlag)<>0 then
- Result:=Result+PutFixedPacketField(CurAttribute,CurSize);
- end;
- procedure AddStringAttributeString(CopyFlag:DWORD;CurAttribute:string);
- begin
- if (FileAttributes^.valid_attribute_flags and CopyFlag)<>0 then
- Result:=Result+PutStringPacketField(CurAttribute);
- end;
-begin //version 3 - like in PuTTY
- Result:='';
- with FileAttributes^ do
- begin
- Result:=Result+PutFixedPacketField(@valid_attribute_flags,SizeOf(valid_attribute_flags));
- if FProtocolVersion>3 then
- Result:=Result+PutFixedPacketField(@file_type,SizeOf(file_type));
- AddFixedAttributeString(SSH_FILEXFER_ATTR_SIZE,@size,SizeOf(size));
- if FProtocolVersion<=3 then
- AddFixedAttributeString(2,@TmpInt64,SizeOf(TmpInt64));
- if FProtocolVersion>3 then
- begin
- AddFixedAttributeString(SSH_FILEXFER_ATTR_ALLOCATION_SIZE,@allocation_size,SizeOf(allocation_size));
- AddStringAttributeString(SSH_FILEXFER_ATTR_OWNERGROUP,owner);
- AddStringAttributeString(SSH_FILEXFER_ATTR_OWNERGROUP,group);
- end;
- AddFixedAttributeString(SSH_FILEXFER_ATTR_PERMISSIONS,@permissions,SizeOf(permissions));
- if FProtocolVersion>3 then
- begin
- AddFixedAttributeString(SSH_FILEXFER_ATTR_ACCESSTIME,@atime,SizeOf(atime));
- AddFixedAttributeString(SSH_FILEXFER_ATTR_ACCESSTIME or SSH_FILEXFER_ATTR_SUBSECOND_TIMES,@atime_nseconds,SizeOf(atime_nseconds));
- AddFixedAttributeString(SSH_FILEXFER_ATTR_CREATETIME,@createtime,SizeOf(createtime));
- AddFixedAttributeString(SSH_FILEXFER_ATTR_CREATETIME or SSH_FILEXFER_ATTR_SUBSECOND_TIMES,@createtime_nseconds,SizeOf(createtime_nseconds));
- AddFixedAttributeString(SSH_FILEXFER_ATTR_MODIFYTIME,@mtime,SizeOf(mtime));
- AddFixedAttributeString(SSH_FILEXFER_ATTR_MODIFYTIME or SSH_FILEXFER_ATTR_SUBSECOND_TIMES,@mtime_nseconds,SizeOf(mtime_nseconds));
- end
- else
- begin
- TmpDWORD:=atime;
- AddFixedAttributeString(SSH_FILEXFER_ATTR_ACCESSTIME,@TmpDWORD,SizeOf(TmpDWORD));
- TmpDWORD:=mtime;
- AddFixedAttributeString(SSH_FILEXFER_ATTR_ACCESSTIME,@TmpDWORD,SizeOf(TmpDWORD));
- end;
- if FProtocolVersion>3 then
- begin
- AddStringAttributeString(SSH_FILEXFER_ATTR_ACL,acl);
- AddFixedAttributeString(SSH_FILEXFER_ATTR_BITS,@attrib_bits,SizeOf(attrib_bits));
- AddFixedAttributeString(SSH_FILEXFER_ATTR_TEXT_HINT,@text_hint,SizeOf(text_hint));
- AddStringAttributeString(SSH_FILEXFER_ATTR_MIME_TYPE,mime_type);
- AddFixedAttributeString(SSH_FILEXFER_ATTR_LINK_COUNT,@link_count,SizeOf(link_count));
- AddStringAttributeString(SSH_FILEXFER_ATTR_UNTRANLATED_NAME,untranslated_name);
- end;
- extended_count:=0;
- AddFixedAttributeString(SSH_FILEXFER_ATTR_EXTENDED,@extended_count,SizeOf(extended_count));
- end;
-end;
-
-procedure TSimpleSFTP.WriteFile(FileHandle:string;FileOffset:Int64;FileData:Pointer;DataSize:DWORD);
-var PacketType:BYTE;PacketString,PacketData:string;InvertedDataSize:DWORD;
-begin
- PacketType:=SSH_FXP_WRITE;
- FileOffset:=InvertInt64(FileOffset);
- InvertedDataSize:=InvertDWORD(DataSize);
- PacketString:=BuildPacket(PacketType,[@FileHandle[1],@FileOffset,@InvertedDataSize,FileData],
- [Length(FileHandle),SizeOf(FileOffset),SizeOf(DataSize),DataSize],[False,True,True,True]);
- SendPacket(PacketString);
- PacketType:=SSH_FXP_STATUS;
- PacketData:=ReceivePacket(FRequestID-1,PacketType);
- CheckStatus(PacketType,PacketData,STRING_UNABLETOWRITETOFILE+': '+FileHandle);
-end;
-
-procedure TSimpleSFTP.DeleteFile(FileName:string);
-var PacketType:BYTE;PacketString,PacketData:string;
-begin
- PacketType:=SSH_FXP_REMOVE;
- PacketString:=BuildPacket(PacketType,[@FileName[1]],[Length(FileName)],[False]);
- SendPacket(PacketString);
- PacketType:=SSH_FXP_STATUS;
- PacketData:=ReceivePacket(FRequestID-1,PacketType);
- CheckStatus(PacketType,PacketData,STRING_UNABLETODELETEFILE+': '+FileName);
-end;
-
-procedure TSimpleSFTP.RenameFile(OldName,NewName:string;FailIfExists:Boolean);
-var PacketType:BYTE;PacketString,PacketData:string;RenameFlags:DWORD;
-begin
- PacketType:=SSH_FXP_RENAME;
- RenameFlags:=SSH_FXP_RENAME_NATIVE;
- if not FailIfExists then RenameFlags:=RenameFlags+SSH_FXP_RENAME_OVERWRITE;
- RenameFlags:=InvertDWORD(RenameFlags);
- PacketString:=BuildPacket(PacketType,[@OldName[1],@NewName[1],@RenameFlags],
- [Length(OldName),Length(NewName),SizeOf(RenameFlags)],[False,False,True]);
- SendPacket(PacketString);
- PacketType:=SSH_FXP_STATUS;
- PacketData:=ReceivePacket(FRequestID-1,PacketType);
- CheckStatus(PacketType,PacketData,STRING_UNABLETORENAMEFILE+': '+OldName+
- ' -> '+NewName);
-end;
-
-procedure TSimpleSFTP.CreateDir(DirName:string;Attributes:PSFTPFileAttributes=nil);
-var PacketType:BYTE;PacketString,AttributesString,PacketData:string;
-begin
- PacketType:=SSH_FXP_MKDIR;
- if Assigned(Attributes) then AttributesString:=BuildAttributesString(Attributes)
- else AttributesString:=BuildBlankAttributesString(True);
- PacketString:=BuildPacket(PacketType,[@DirName[1],@AttributesString[1]],
- [Length(DirName),Length(AttributesString)],[False,True]);
- SendPacket(PacketString);
- PacketType:=SSH_FXP_STATUS;
- PacketData:=ReceivePacket(FRequestID-1,PacketType);
- CheckStatus(PacketType,PacketData,STRING_UNABLETOCREATEDIR+': '+DirName);
-end;
-
-procedure TSimpleSFTP.DeleteDir(DirName:string);
-var PacketType:BYTE;PacketString,PacketData:string;
-begin
- PacketType:=SSH_FXP_RMDIR;
- PacketString:=BuildPacket(PacketType,[@DirName[1]],[Length(DirName)],[False]);
- SendPacket(PacketString);
- PacketType:=SSH_FXP_STATUS;
- PacketData:=ReceivePacket(FRequestID-1,PacketType);
- CheckStatus(PacketType,PacketData,STRING_UNABLETODELETEDIR+': '+DirName);
-end;
-
-procedure TSimpleSFTP.ListDir(DirName:string;FileList:TSFTPFileList);
-var DirHandle:string;
-begin
- DirHandle:=OpenDir(DirName);
- try
- ReadDir(DirHandle,FileList);
- finally
- try
- CloseDir(DirHandle);
- except
- end;
- end;
-end;
-
-procedure TSimpleSFTP.InternalGetFileAtributes(PacketType:BYTE;FileID:string;//name or handle
- AttributeFlags:DWORD;var Attributes:TSFTPFileAttributes);
-var PacketString,AttributesString,PacketData:string;FieldOffset,AttributeFlagsSize:Integer;
-begin
- if FProtocolVersion>3 then AttributeFlagsSize:=SizeOf(AttributeFlags) else AttributeFlagsSize:=0;
- AttributeFlags:=InvertDWORD(AttributeFlags);
- PacketString:=BuildPacket(PacketType,[@FileID[1],@AttributeFlags],
- [Length(FileID),AttributeFlagsSize],[False,True]);
- SendPacket(PacketString);
- PacketType:=0;
- PacketData:=ReceivePacket(FRequestID-1,PacketType);
- CheckStatus(PacketType,PacketData,STRING_UNABLETOGETFILEATTRIBUTES+': '+FileID);
- if PacketType<>SSH_FXP_ATTRS then DoError(STRING_UNABLETOGETFILEATTRIBUTES+': '+FileID);
- FieldOffset:=1;
- Attributes:=ParseFileAttributes(PacketData,FieldOffset);
-end;
-
-procedure TSimpleSFTP.GetFileAtributes(FileName:string;var Attributes:TSFTPFileAttributes;FollowLink:Boolean=True);
-var PacketType:BYTE;AttributeFlags:DWORD;
-begin
- if FollowLink then PacketType:=SSH_FXP_STAT else PacketType:=SSH_FXP_LSTAT;
- AttributeFlags:=SSH_FILEXFER_ATTR_SIZE or SSH_FILEXFER_ATTR_PERMISSIONS
- or SSH_FILEXFER_ATTR_ACCESSTIME;
- InternalGetFileAtributes(PacketType,FileName,AttributeFlags,Attributes);
-end;
-
-procedure TSimpleSFTP.GetFileAtributesByHandle(FileHandle:string;var Attributes:TSFTPFileAttributes);
-var AttributeFlags:DWORD;
-begin
- AttributeFlags:=SSH_FILEXFER_ATTR_SIZE or SSH_FILEXFER_ATTR_PERMISSIONS
- or SSH_FILEXFER_ATTR_ACCESSTIME;
- InternalGetFileAtributes(SSH_FXP_FSTAT,FileHandle,AttributeFlags,Attributes);
-end;
-
-procedure TSimpleSFTP.SetFileAtributes(FileName:string;Attributes:PSFTPFileAttributes);
-var PacketType:BYTE;PacketString,AttributesString,PacketData:string;
-begin
- PacketType:=SSH_FXP_SETSTAT;
- AttributesString:=BuildAttributesString(Attributes);
- PacketString:=BuildPacket(PacketType,[@FileName[1],@AttributesString[1]],
- [Length(FileName),Length(AttributesString)],[False,True]);
- SendPacket(PacketString);
- PacketType:=SSH_FXP_STATUS ;
- PacketData:=ReceivePacket(FRequestID-1,PacketType);
- CheckStatus(PacketType,PacketData,STRING_UNABLETOSETFILEATTRIBUTES+': '+FileName);
-end;
-
-procedure TSimpleSFTP.SetFileAtributesByHandle(FileHandle:string;Attributes:PSFTPFileAttributes);
-var PacketType:BYTE;PacketString,AttributesString,PacketData:string;
-begin
- PacketType:=SSH_FXP_FSETSTAT;
- AttributesString:=BuildAttributesString(Attributes);
- PacketString:=BuildPacket(PacketType,[@FileHandle[1],@AttributesString[1]],
- [Length(FileHandle),Length(AttributesString)],[False,True]);
- SendPacket(PacketString);
- PacketType:=SSH_FXP_STATUS ;
- PacketData:=ReceivePacket(FRequestID-1,PacketType);
- CheckStatus(PacketType,PacketData,STRING_UNABLETOSETFILEATTRIBUTES+': '+FileHandle);
-end;
-
-procedure TSimpleSFTP.SetFileTimes(FileName:string;AccessTime,CreateTime,ModifyTime:Int64);
-var PacketType:BYTE;PacketString,AttributesString,PacketData:string;Attributes:TSFTPFileAttributes;
-begin
- ResetFileAttributes(@Attributes);
- Attributes.valid_attribute_flags:=SSH_FILEXFER_ATTR_ACCESSTIME;
- if FProtocolVersion>3 then
- Attributes.valid_attribute_flags:=Attributes.valid_attribute_flags or
- SSH_FILEXFER_ATTR_CREATETIME or SSH_FILEXFER_ATTR_MODIFYTIME;
- Attributes.atime:=AccessTime;
- Attributes.createtime:=CreateTime;
- Attributes.mtime:=ModifyTime;
- SetFileAtributes(FileName,@Attributes);
-end;
-
-procedure TSimpleSFTP.SetFileTimesByHandle(FileHandle:string;AccessTime,CreateTime,ModifyTime:Int64);
-var PacketType:BYTE;PacketString,AttributesString,PacketData:string;Attributes:TSFTPFileAttributes;
-begin
- ResetFileAttributes(@Attributes);
- Attributes.valid_attribute_flags:=SSH_FILEXFER_ATTR_ACCESSTIME;
- if FProtocolVersion>3 then
- Attributes.valid_attribute_flags:=Attributes.valid_attribute_flags or
- SSH_FILEXFER_ATTR_CREATETIME or SSH_FILEXFER_ATTR_MODIFYTIME;
- Attributes.atime:=AccessTime;
- Attributes.createtime:=CreateTime;
- Attributes.mtime:=ModifyTime;
- SetFileAtributesByHandle(FileHandle,@Attributes);
-end;
-
-function TSimpleSFTP.GetStatus(PacketData:string):DWORD;
-begin //assumed PacketType=SSH_FXP_STATUS
- Result:=GetDWORD(@PacketData[1]);
-end;
-
-function TSimpleSFTP.CheckStatus(PacketType:DWORD;PacketData:string;ErrorString:string):Boolean;
-var Status:DWORD;i,FieldOffset:Integer;
-begin
- Result:=False;
- if PacketType<>SSH_FXP_STATUS then Exit;
- FieldOffset:=1;
- GetFixedPacketField(PacketData,FieldOffset,@Status,SizeOf(Status));
- if Status<>SSH_FX_OK then
- begin //expected strings with error description ?
- while FieldOffset0 then
- exit;
- repeat
- if terminated then break;
- buf := sock.RecvPacket(1000);
- if sock.lasterror = 0 then
- begin
- snmprec.Clear;
- snmprec.DecodeBuf(buf);
- for n := 0 to snmprec.MIBCount - 1 do
- begin
- mib := snmprec.MIBByIndex(n);
- if mib <> nil then
- begin
- oid := mib.OID;
- value := mib.Value;
- valuetype := mib.valuetype;
- ProcessSnmpRequest(snmprec.PDUType, oid, value, valuetype);
- mib.OID := oid;
- mib.Value := value;
- mib.valuetype := valuetype;
- end;
- end;
- snmprec.PDUType := PDUGetResponse;
- snmprec.ErrorStatus := 0;
- Buf := snmprec.EncodeBuf;
- sock.SendString(Buf);
- end;
- until false;
- end;
-end;
-
-procedure TUDPSnmpDaemon.ProcessSnmpRequest(PDU: integer; var OID, Value: string;
- var valuetype: integer);
-begin
- if PDU = PDUGetRequest then
- begin
- if OID = '1.3.6.1.2.1.1.1.0' then
- begin
- Value := 'Synapse SNMP agent demo';
- Valuetype := ASN1_OCTSTR;
- end;
- end;
-end;
-
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/snmpserv/snmpserv.dof b/Source/3rdParty/Synapse/source/demo/snmpserv/snmpserv.dof
deleted file mode 100644
index d00d8840..00000000
--- a/Source/3rdParty/Synapse/source/demo/snmpserv/snmpserv.dof
+++ /dev/null
@@ -1,75 +0,0 @@
-[Compiler]
-A=1
-B=0
-C=1
-D=1
-E=0
-F=0
-G=1
-H=1
-I=1
-J=1
-K=0
-L=1
-M=0
-N=1
-O=1
-P=1
-Q=0
-R=0
-S=0
-T=0
-U=0
-V=1
-W=0
-X=1
-Y=0
-Z=1
-ShowHints=1
-ShowWarnings=1
-UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-[Linker]
-MapFile=0
-OutputObjs=0
-ConsoleApp=1
-DebugInfo=0
-MinStackSize=16384
-MaxStackSize=1048576
-ImageBase=4194304
-ExeDescription=
-[Directories]
-OutputDir=
-UnitOutputDir=
-SearchPath=
-Packages=VCLX30;VCL30;VCLDB30;VCLDBX30;INETDB30;INET30;VCLSMP30;QRPT30;TEEUI30;TEEDB30;TEE30;DSS30;IBEVNT30;RXCTL;RXDB;RXTOOLS
-Conditionals=
-DebugSourceDirs=
-UsePackages=0
-[Parameters]
-RunParams=
-HostApplication=
-[Version Info]
-IncludeVerInfo=0
-AutoIncBuild=0
-MajorVer=1
-MinorVer=0
-Release=0
-Build=0
-Debug=0
-PreRelease=0
-Special=0
-Private=0
-DLL=0
-Locale=1029
-CodePage=1250
-[Version Info Keys]
-CompanyName=
-FileDescription=
-FileVersion=1.0.0.0
-InternalName=
-LegalCopyright=
-LegalTrademarks=
-OriginalFilename=
-ProductName=
-ProductVersion=1.0.0.0
-Comments=
diff --git a/Source/3rdParty/Synapse/source/demo/snmpserv/snmpserv.dpr b/Source/3rdParty/Synapse/source/demo/snmpserv/snmpserv.dpr
deleted file mode 100644
index b42d38a4..00000000
--- a/Source/3rdParty/Synapse/source/demo/snmpserv/snmpserv.dpr
+++ /dev/null
@@ -1,16 +0,0 @@
-program snmpserv;
-
-uses
- Forms,
- main in 'main.pas' {Form1},
- snmp in 'snmp.pas',
- SNMPSend in 'SNMPSend.pas',
- ASN1Util in 'ASN1Util.pas';
-
-{$R *.RES}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
diff --git a/Source/3rdParty/Synapse/source/demo/sntp/SntpTest.dpr b/Source/3rdParty/Synapse/source/demo/sntp/SntpTest.dpr
deleted file mode 100644
index 2fc1d3ab..00000000
--- a/Source/3rdParty/Synapse/source/demo/sntp/SntpTest.dpr
+++ /dev/null
@@ -1,14 +0,0 @@
-program SntpTest;
-
-uses
- Forms,
- Unit1 in 'Unit1.pas' {Form1};
-
-{$R *.RES}
-
-begin
- Application.Initialize;
- Application.CreateForm(TForm1, Form1);
- Application.Run;
-end.
-
diff --git a/Source/3rdParty/Synapse/source/demo/sntp/Unit1.dfm b/Source/3rdParty/Synapse/source/demo/sntp/Unit1.dfm
deleted file mode 100644
index 1e47f352..00000000
Binary files a/Source/3rdParty/Synapse/source/demo/sntp/Unit1.dfm and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/demo/sntp/Unit1.pas b/Source/3rdParty/Synapse/source/demo/sntp/Unit1.pas
deleted file mode 100644
index ddc4e25c..00000000
--- a/Source/3rdParty/Synapse/source/demo/sntp/Unit1.pas
+++ /dev/null
@@ -1,45 +0,0 @@
-unit Unit1;
-
-interface
-
-uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- SNTPsend, StdCtrls;
-
-type
- TForm1 = class(TForm)
- Edit1: TEdit;
- Label1: TLabel;
- Button1: TButton;
- Label2: TLabel;
- procedure Button1Click(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
-var
- Form1: TForm1;
-
-implementation
-
-{$R *.DFM}
-
-procedure TForm1.Button1Click(Sender: TObject);
-var
- sntp:TSntpSend;
-begin
- sntp:=TSntpSend.Create;
- try
- sntp.TargetHost:=Edit1.Text;
- if sntp.GetSNTP
- then label2.Caption:=Datetimetostr(sntp.NTPTime)+' UTC'
- else label2.Caption:='Not contacted!';
- finally
- sntp.Free;
- end;
-end;
-
-end.
-
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/asn1util.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/asn1util.o
deleted file mode 100644
index 35f92855..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/asn1util.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/asn1util.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/asn1util.ppu
deleted file mode 100644
index 033ed5ea..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/asn1util.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/blcksock.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/blcksock.o
deleted file mode 100644
index 84569410..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/blcksock.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/blcksock.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/blcksock.ppu
deleted file mode 100644
index 211ee753..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/blcksock.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/clamsend.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/clamsend.o
deleted file mode 100644
index 6359d39c..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/clamsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/clamsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/clamsend.ppu
deleted file mode 100644
index a2b35e7a..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/clamsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/dnssend.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/dnssend.o
deleted file mode 100644
index 642d1250..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/dnssend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/dnssend.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/dnssend.ppu
deleted file mode 100644
index 54c2d53d..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/dnssend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/ftpsend.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/ftpsend.o
deleted file mode 100644
index f7901b43..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/ftpsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/ftpsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/ftpsend.ppu
deleted file mode 100644
index b12e304f..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/ftpsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/ftptsend.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/ftptsend.o
deleted file mode 100644
index 1e463fc5..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/ftptsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/ftptsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/ftptsend.ppu
deleted file mode 100644
index 612cffcd..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/ftptsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/httpsend.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/httpsend.o
deleted file mode 100644
index 315b6394..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/httpsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/httpsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/httpsend.ppu
deleted file mode 100644
index 8cbc47b1..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/httpsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/imapsend.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/imapsend.o
deleted file mode 100644
index 2164c475..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/imapsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/imapsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/imapsend.ppu
deleted file mode 100644
index e22b8ed0..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/imapsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/laz_synapse.compiled b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/laz_synapse.compiled
deleted file mode 100644
index 0c65f55f..00000000
--- a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/laz_synapse.compiled
+++ /dev/null
@@ -1,5 +0,0 @@
-
-
-
-
-
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/laz_synapse.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/laz_synapse.o
deleted file mode 100644
index 7b7c487e..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/laz_synapse.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/laz_synapse.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/laz_synapse.ppu
deleted file mode 100644
index 2a4908a9..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/laz_synapse.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/ldapsend.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/ldapsend.o
deleted file mode 100644
index 1bdcdfc0..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/ldapsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/ldapsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/ldapsend.ppu
deleted file mode 100644
index 7f2dec6b..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/ldapsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/mimeinln.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/mimeinln.o
deleted file mode 100644
index 884cc6a0..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/mimeinln.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/mimeinln.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/mimeinln.ppu
deleted file mode 100644
index 85a52bdb..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/mimeinln.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/mimemess.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/mimemess.o
deleted file mode 100644
index 716c3ae9..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/mimemess.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/mimemess.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/mimemess.ppu
deleted file mode 100644
index fdf8de4a..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/mimemess.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/mimepart.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/mimepart.o
deleted file mode 100644
index 216d5fb2..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/mimepart.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/mimepart.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/mimepart.ppu
deleted file mode 100644
index 532f90fd..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/mimepart.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/nntpsend.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/nntpsend.o
deleted file mode 100644
index 2c4ac991..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/nntpsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/nntpsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/nntpsend.ppu
deleted file mode 100644
index 65578b7f..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/nntpsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/pingsend.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/pingsend.o
deleted file mode 100644
index 646b9039..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/pingsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/pingsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/pingsend.ppu
deleted file mode 100644
index ddfc677f..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/pingsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/pop3send.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/pop3send.o
deleted file mode 100644
index 600aae21..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/pop3send.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/pop3send.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/pop3send.ppu
deleted file mode 100644
index cade9023..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/pop3send.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/slogsend.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/slogsend.o
deleted file mode 100644
index c9b9214d..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/slogsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/slogsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/slogsend.ppu
deleted file mode 100644
index 553a7ba8..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/slogsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/smtpsend.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/smtpsend.o
deleted file mode 100644
index 29df6da6..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/smtpsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/smtpsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/smtpsend.ppu
deleted file mode 100644
index e93e9790..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/smtpsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/snmpsend.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/snmpsend.o
deleted file mode 100644
index ea8c6233..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/snmpsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/snmpsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/snmpsend.ppu
deleted file mode 100644
index b87dee37..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/snmpsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/sntpsend.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/sntpsend.o
deleted file mode 100644
index 1ac826ab..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/sntpsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/sntpsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/sntpsend.ppu
deleted file mode 100644
index 0e964860..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/sntpsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synachar.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synachar.o
deleted file mode 100644
index 845c780a..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synachar.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synachar.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synachar.ppu
deleted file mode 100644
index 9f3a690f..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synachar.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synacode.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synacode.o
deleted file mode 100644
index 34e74d9c..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synacode.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synacode.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synacode.ppu
deleted file mode 100644
index 5b946298..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synacode.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synacrypt.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synacrypt.o
deleted file mode 100644
index c4226e1d..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synacrypt.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synacrypt.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synacrypt.ppu
deleted file mode 100644
index 49204b46..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synacrypt.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synadbg.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synadbg.o
deleted file mode 100644
index ec4fb514..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synadbg.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synadbg.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synadbg.ppu
deleted file mode 100644
index 637da366..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synadbg.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synafpc.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synafpc.o
deleted file mode 100644
index a2ba84b9..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synafpc.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synafpc.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synafpc.ppu
deleted file mode 100644
index 2a030033..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synafpc.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synaicnv.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synaicnv.o
deleted file mode 100644
index 3dae27bb..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synaicnv.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synaicnv.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synaicnv.ppu
deleted file mode 100644
index 053011cd..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synaicnv.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synaip.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synaip.o
deleted file mode 100644
index 01b105d9..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synaip.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synaip.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synaip.ppu
deleted file mode 100644
index 519cf898..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synaip.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synamisc.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synamisc.o
deleted file mode 100644
index da8585d9..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synamisc.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synamisc.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synamisc.ppu
deleted file mode 100644
index 3f9f71eb..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synamisc.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synaser.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synaser.o
deleted file mode 100644
index b91a6a6d..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synaser.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synaser.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synaser.ppu
deleted file mode 100644
index 91b89fd3..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synaser.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synautil.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synautil.o
deleted file mode 100644
index 6292dc22..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synautil.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synautil.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synautil.ppu
deleted file mode 100644
index 4374e5a9..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synautil.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synsock.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synsock.o
deleted file mode 100644
index b8eea899..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synsock.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synsock.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synsock.ppu
deleted file mode 100644
index 324d780e..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/synsock.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/tlntsend.o b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/tlntsend.o
deleted file mode 100644
index 6ee48b72..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/tlntsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/tlntsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/i386-win32/tlntsend.ppu
deleted file mode 100644
index 13cf59f7..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/i386-win32/tlntsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/asn1util.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/asn1util.o
deleted file mode 100644
index 27d7c2bf..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/asn1util.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/asn1util.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/asn1util.ppu
deleted file mode 100644
index 180fd29c..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/asn1util.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/blcksock.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/blcksock.o
deleted file mode 100644
index e4ad8f16..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/blcksock.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/blcksock.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/blcksock.ppu
deleted file mode 100644
index ee2f0ff9..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/blcksock.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/clamsend.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/clamsend.o
deleted file mode 100644
index e4c40126..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/clamsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/clamsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/clamsend.ppu
deleted file mode 100644
index 67f96544..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/clamsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/dnssend.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/dnssend.o
deleted file mode 100644
index e3111935..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/dnssend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/dnssend.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/dnssend.ppu
deleted file mode 100644
index 3c188744..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/dnssend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/ftpsend.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/ftpsend.o
deleted file mode 100644
index 31e4374c..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/ftpsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/ftpsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/ftpsend.ppu
deleted file mode 100644
index a1fce7a8..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/ftpsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/ftptsend.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/ftptsend.o
deleted file mode 100644
index 0b48be60..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/ftptsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/ftptsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/ftptsend.ppu
deleted file mode 100644
index 0c54c516..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/ftptsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/httpsend.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/httpsend.o
deleted file mode 100644
index 91424171..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/httpsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/httpsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/httpsend.ppu
deleted file mode 100644
index dfd81db6..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/httpsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/imapsend.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/imapsend.o
deleted file mode 100644
index a1978068..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/imapsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/imapsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/imapsend.ppu
deleted file mode 100644
index 7547d4f9..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/imapsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/laz_synapse.compiled b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/laz_synapse.compiled
deleted file mode 100644
index b5dc6870..00000000
--- a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/laz_synapse.compiled
+++ /dev/null
@@ -1,5 +0,0 @@
-
-
-
-
-
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/laz_synapse.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/laz_synapse.o
deleted file mode 100644
index 401a45c4..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/laz_synapse.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/laz_synapse.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/laz_synapse.ppu
deleted file mode 100644
index 50aeff94..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/laz_synapse.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/ldapsend.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/ldapsend.o
deleted file mode 100644
index 43146343..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/ldapsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/ldapsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/ldapsend.ppu
deleted file mode 100644
index b1ef09e6..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/ldapsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/mimeinln.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/mimeinln.o
deleted file mode 100644
index 0c234dcb..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/mimeinln.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/mimeinln.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/mimeinln.ppu
deleted file mode 100644
index 7a01d18e..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/mimeinln.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/mimemess.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/mimemess.o
deleted file mode 100644
index b57269d3..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/mimemess.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/mimemess.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/mimemess.ppu
deleted file mode 100644
index 6567ffd8..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/mimemess.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/mimepart.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/mimepart.o
deleted file mode 100644
index e8ac0ec7..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/mimepart.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/mimepart.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/mimepart.ppu
deleted file mode 100644
index 96c75802..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/mimepart.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/nntpsend.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/nntpsend.o
deleted file mode 100644
index 4abf0293..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/nntpsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/nntpsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/nntpsend.ppu
deleted file mode 100644
index d89f4450..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/nntpsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/pingsend.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/pingsend.o
deleted file mode 100644
index 11158082..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/pingsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/pingsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/pingsend.ppu
deleted file mode 100644
index 799a4b32..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/pingsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/pop3send.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/pop3send.o
deleted file mode 100644
index 49f29136..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/pop3send.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/pop3send.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/pop3send.ppu
deleted file mode 100644
index 857dbb7a..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/pop3send.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/slogsend.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/slogsend.o
deleted file mode 100644
index ed5a1740..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/slogsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/slogsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/slogsend.ppu
deleted file mode 100644
index d4890529..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/slogsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/smtpsend.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/smtpsend.o
deleted file mode 100644
index 1a54af88..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/smtpsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/smtpsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/smtpsend.ppu
deleted file mode 100644
index 779ba542..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/smtpsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/snmpsend.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/snmpsend.o
deleted file mode 100644
index f6eaceb2..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/snmpsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/snmpsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/snmpsend.ppu
deleted file mode 100644
index 938014f4..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/snmpsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/sntpsend.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/sntpsend.o
deleted file mode 100644
index aa16c390..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/sntpsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/sntpsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/sntpsend.ppu
deleted file mode 100644
index 261f2bd2..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/sntpsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synachar.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synachar.o
deleted file mode 100644
index f5b48b28..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synachar.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synachar.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synachar.ppu
deleted file mode 100644
index 46f78e09..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synachar.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synacode.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synacode.o
deleted file mode 100644
index de49e674..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synacode.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synacode.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synacode.ppu
deleted file mode 100644
index 5248b6a1..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synacode.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synacrypt.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synacrypt.o
deleted file mode 100644
index 3465f363..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synacrypt.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synacrypt.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synacrypt.ppu
deleted file mode 100644
index 862fb91f..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synacrypt.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synadbg.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synadbg.o
deleted file mode 100644
index 4404e85c..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synadbg.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synadbg.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synadbg.ppu
deleted file mode 100644
index 79839aa8..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synadbg.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synafpc.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synafpc.o
deleted file mode 100644
index ba96a5ad..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synafpc.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synafpc.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synafpc.ppu
deleted file mode 100644
index 125b69da..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synafpc.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synaicnv.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synaicnv.o
deleted file mode 100644
index 34dba74a..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synaicnv.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synaicnv.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synaicnv.ppu
deleted file mode 100644
index c5b70782..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synaicnv.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synaip.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synaip.o
deleted file mode 100644
index da3dedc0..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synaip.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synaip.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synaip.ppu
deleted file mode 100644
index db673190..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synaip.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synamisc.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synamisc.o
deleted file mode 100644
index bb9df340..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synamisc.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synamisc.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synamisc.ppu
deleted file mode 100644
index 5b36e948..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synamisc.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synaser.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synaser.o
deleted file mode 100644
index cb589ff4..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synaser.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synaser.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synaser.ppu
deleted file mode 100644
index 629e1851..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synaser.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synautil.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synautil.o
deleted file mode 100644
index ff4b2415..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synautil.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synautil.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synautil.ppu
deleted file mode 100644
index 54617e5a..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synautil.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synsock.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synsock.o
deleted file mode 100644
index 0121717d..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synsock.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synsock.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synsock.ppu
deleted file mode 100644
index 89a41a59..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/synsock.ppu and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/tlntsend.o b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/tlntsend.o
deleted file mode 100644
index b8a3824f..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/tlntsend.o and /dev/null differ
diff --git a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/tlntsend.ppu b/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/tlntsend.ppu
deleted file mode 100644
index 6736ce8f..00000000
Binary files a/Source/3rdParty/Synapse/source/lib/lib/x86_64-win64/tlntsend.ppu and /dev/null differ
diff --git a/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/registeruniqueinstance.o b/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/registeruniqueinstance.o
deleted file mode 100644
index ef728374..00000000
Binary files a/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/registeruniqueinstance.o and /dev/null differ
diff --git a/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/registeruniqueinstance.ppu b/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/registeruniqueinstance.ppu
deleted file mode 100644
index 72eff4c4..00000000
Binary files a/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/registeruniqueinstance.ppu and /dev/null differ
diff --git a/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/simpleipcwrapper.o b/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/simpleipcwrapper.o
deleted file mode 100644
index d1399913..00000000
Binary files a/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/simpleipcwrapper.o and /dev/null differ
diff --git a/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/simpleipcwrapper.ppu b/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/simpleipcwrapper.ppu
deleted file mode 100644
index afbdd2df..00000000
Binary files a/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/simpleipcwrapper.ppu and /dev/null differ
diff --git a/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/uniqueinstance.o b/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/uniqueinstance.o
deleted file mode 100644
index 73a98074..00000000
Binary files a/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/uniqueinstance.o and /dev/null differ
diff --git a/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/uniqueinstance.ppu b/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/uniqueinstance.ppu
deleted file mode 100644
index c101a2f8..00000000
Binary files a/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/uniqueinstance.ppu and /dev/null differ
diff --git a/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/uniqueinstance_package.compiled b/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/uniqueinstance_package.compiled
deleted file mode 100644
index b75d4fa2..00000000
--- a/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/uniqueinstance_package.compiled
+++ /dev/null
@@ -1,5 +0,0 @@
-
-
-
-
-
diff --git a/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/uniqueinstance_package.o b/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/uniqueinstance_package.o
deleted file mode 100644
index 52522f8d..00000000
Binary files a/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/uniqueinstance_package.o and /dev/null differ
diff --git a/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/uniqueinstance_package.ppu b/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/uniqueinstance_package.ppu
deleted file mode 100644
index 98cadd3f..00000000
Binary files a/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/uniqueinstance_package.ppu and /dev/null differ
diff --git a/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/uniqueinstanceraw.o b/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/uniqueinstanceraw.o
deleted file mode 100644
index b93fed87..00000000
Binary files a/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/uniqueinstanceraw.o and /dev/null differ
diff --git a/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/uniqueinstanceraw.ppu b/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/uniqueinstanceraw.ppu
deleted file mode 100644
index 6683206c..00000000
Binary files a/Source/3rdParty/uniqueinstance-1.0/lib/i386-win32-win32/uniqueinstanceraw.ppu and /dev/null differ
diff --git a/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/registeruniqueinstance.o b/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/registeruniqueinstance.o
deleted file mode 100644
index 20087b1a..00000000
Binary files a/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/registeruniqueinstance.o and /dev/null differ
diff --git a/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/registeruniqueinstance.ppu b/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/registeruniqueinstance.ppu
deleted file mode 100644
index 2f18d695..00000000
Binary files a/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/registeruniqueinstance.ppu and /dev/null differ
diff --git a/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/simpleipcwrapper.o b/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/simpleipcwrapper.o
deleted file mode 100644
index 1547bff7..00000000
Binary files a/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/simpleipcwrapper.o and /dev/null differ
diff --git a/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/simpleipcwrapper.ppu b/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/simpleipcwrapper.ppu
deleted file mode 100644
index 5c6a62a9..00000000
Binary files a/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/simpleipcwrapper.ppu and /dev/null differ
diff --git a/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/uniqueinstance.o b/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/uniqueinstance.o
deleted file mode 100644
index b69cb3a6..00000000
Binary files a/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/uniqueinstance.o and /dev/null differ
diff --git a/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/uniqueinstance.ppu b/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/uniqueinstance.ppu
deleted file mode 100644
index 09251df3..00000000
Binary files a/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/uniqueinstance.ppu and /dev/null differ
diff --git a/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/uniqueinstance_package.compiled b/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/uniqueinstance_package.compiled
deleted file mode 100644
index 61a4a5c0..00000000
--- a/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/uniqueinstance_package.compiled
+++ /dev/null
@@ -1,5 +0,0 @@
-
-
-
-
-
diff --git a/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/uniqueinstance_package.o b/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/uniqueinstance_package.o
deleted file mode 100644
index 90942274..00000000
Binary files a/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/uniqueinstance_package.o and /dev/null differ
diff --git a/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/uniqueinstance_package.ppu b/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/uniqueinstance_package.ppu
deleted file mode 100644
index fead0d91..00000000
Binary files a/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/uniqueinstance_package.ppu and /dev/null differ
diff --git a/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/uniqueinstanceraw.o b/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/uniqueinstanceraw.o
deleted file mode 100644
index ac3d8b1c..00000000
Binary files a/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/uniqueinstanceraw.o and /dev/null differ
diff --git a/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/uniqueinstanceraw.ppu b/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/uniqueinstanceraw.ppu
deleted file mode 100644
index 3e467bc4..00000000
Binary files a/Source/3rdParty/uniqueinstance-1.0/lib/x86_64-win64-win32/uniqueinstanceraw.ppu and /dev/null differ
diff --git a/Source/OSspecific/osspecific.pas b/Source/OSspecific/osspecific.pas
deleted file mode 100644
index d6ce8cad..00000000
--- a/Source/OSspecific/osspecific.pas
+++ /dev/null
@@ -1,28 +0,0 @@
-unit OSspecific;
-
-{$mode objfpc}{$H+}
-
-interface
-
-uses
- Graphics;
-
-function GetBlackColor(): TColor;
-
-implementation
-
-function GetBlackColor(): TColor;
-begin
- {$ifdef Windows}
- result:= RGBToColor(242, 242, 242);
- {$endif}
- {$ifdef Unix}
- result:= clBackground;
- {$endif}
- {$ifdef darwin}
- result:= clBackground;
- {$endif}
-end;
-
-end.
-
diff --git a/Source/Units/ColorBar.pas b/Source/Units/ColorBar.pas
index 35c49914..be5e4ad0 100644
--- a/Source/Units/ColorBar.pas
+++ b/Source/Units/ColorBar.pas
@@ -19,9 +19,7 @@ TColorBar = class(TGraphicControl)
FInsideColor, FOutsideColor, FIntermediateColor : TColor;
FShowValues, FValuesInBar : boolean;
FBandWidth : integer;
- { Private declarations }
protected
- { Protected declarations }
Procedure SetMin(V : LongInt);
Procedure SetMax(V : LongInt);
Procedure SetTarget(V : LongInt);
@@ -35,11 +33,9 @@ TColorBar = class(TGraphicControl)
Procedure SetValuesInBar(V : boolean);
Procedure SetBandWidth(I : integer);
public
- { Public declarations }
Constructor Create(AOwner : TComponent); override;
procedure Paint; override;
published
- { Published declarations }
property Min : LongInt read FMin write SetMin default -10;
property Max: LongInt read FMax write SetMax default 10;
property Target : LongInt read FTarget write SetTarget default 0;
diff --git a/Source/Units/amoebes.pas b/Source/Units/amoebes.pas
index 418ebf1d..09ef481d 100644
--- a/Source/Units/amoebes.pas
+++ b/Source/Units/amoebes.pas
@@ -347,7 +347,7 @@ procedure TAmoebeSerie.SetTitle(Value : string);
end;
Procedure TAmoebeSerie.SetNormLength(Value : LongInt);
-var L : LongInt;
+//var L : LongInt;
begin
if (Value > 0) and (FNorm > FMinValue) then
begin
@@ -628,6 +628,7 @@ procedure TAmoebeSerie.SetStartPoint(Value : TPoint);
end;
end;
Cnvs.Brush.Style:= bsSolid;
+ {$warning TAmoebeSerie.DrawModern: Color BC is not initialized!}
Cnvs.Brush.Color:= BC;
end;
end;
@@ -688,7 +689,8 @@ constructor TAmoebe.Create(AOwner : TComponent);
Destructor TAmoebe.Destroy;
var i : LongInt;
begin
- for i:= 0 to FSeries.Count-1 do TAmoebeSerie(FSeries.Items[i]).Free;
+ for i:= 0 to FSeries.Count-1 do
+ TAmoebeSerie(FSeries.Items[i]).Free;
FSeries.Clear;
FSeries.Free;
FSeries:= NIL;
@@ -697,7 +699,7 @@ constructor TAmoebe.Create(AOwner : TComponent);
end;
Procedure TAmoebe.Initialize;
-var i : LongInt;
+var //i : LongInt;
P : TPoint;
begin
FFitting:= false;
@@ -846,6 +848,7 @@ procedure TAmoebe.Print;
Function TAmoebe.DrawTitle(Cnvs : TCanvas; Rect : TRect) : LongInt;
begin
+ Result:= 0; // What should be returned?
if FTitle <> '' then
begin
Cnvs.Brush.Style:= bsClear;
@@ -859,7 +862,7 @@ procedure TAmoebe.Print;
var i, j : LongInt;
Serie, Serie2 : TAmoebeSerie;
PA : array of TPoint;
- L, A : double;
+ //A : double;
begin
//Teken eerst normcircel met kleur, dan de amoebe, dan de normcirkel leeg
//en tenslotte de assen
@@ -879,10 +882,11 @@ procedure TAmoebe.Print;
System.SetLength(PA, 3)
else
System.SetLength(PA, FSeries.Count);
-
+{ if FSeries.Count > 1 then
+ A:= 0.5 * TAmoebeSerie(FSeries.Items[1]).Angle
+ else
+ A:= 90; }
j:= 0;
- if FSeries.Count > 1 then A:= 0.5 * TAmoebeSerie(FSeries.Items[1]).Angle
- else A:= 90;
for i:= 1 to FSeries.Count do
begin
Serie:= TAmoebeSerie(FSeries.Items[i-1]);
@@ -925,10 +929,9 @@ procedure TAmoebe.Print;
end;
Procedure TAmoebe.DrawModern(Cnvs : TCanvas; Re : TRect);
-var i, j : LongInt;
+var i : LongInt;
Serie : TAmoebeSerie;
PA : array of TPoint;
- L, A : double;
begin
//Teken eerst normcircel met kleur, dan de amoebe, dan de normcirkel leeg
//en tenslotte de assen
@@ -1013,7 +1016,7 @@ procedure TAmoebe.Print;
end;
Procedure TAmoebe.DrawSlices(Cnvs : TCanvas; Re : TRect);
-var i, j : LongInt;
+var i : LongInt;
Serie : TAmoebeSerie;
L, A, A2 : double;
L2, X1, X2, X3, X4, Y1, Y2, Y3, Y4 : integer;
@@ -1032,7 +1035,6 @@ procedure TAmoebe.Print;
begin
if FSeries.Count > 1 then A:= TAmoebeSerie(FSeries.Items[1]).Angle
else A:= 45;
- j:= 0;
Cnvs.Brush.Style:= bsSolid;
Cnvs.Brush.Color:= FAmoebeColor;
Cnvs.Pen.Color:= clBlack;
@@ -1168,7 +1170,6 @@ procedure TAmoebe.Print;
Procedure TAmoebe.SetAmountSeries(Value : LongInt);
var i : LongInt;
- Serie : TAmoebeSerie;
begin
if Value < 0 then Value:= 0;
if FSeries = NIL then FSeries:= TList.Create;
@@ -1500,6 +1501,7 @@ procedure TAmoebe.SetSerieFont(SerieNr : LongInt; Value : TFont);
Function TAmoebe.ExecuteEditor : boolean;
begin
+ Result:= True;
{ if FAllowEditor then
begin
Application.CreateForm(TFrmAmoebeDlg, FrmAmoebeDlg);
@@ -1544,4 +1546,4 @@ procedure TAmoebe.Assign(Source : TPersistent);
end;
end.
-
\ No newline at end of file
+
diff --git a/Source/Units/bh_report.pas b/Source/Units/bh_report.pas
index c48e5f21..1fae0dcf 100644
--- a/Source/Units/bh_report.pas
+++ b/Source/Units/bh_report.pas
@@ -5,14 +5,12 @@
interface
uses
- Classes, SysUtils, Graphics, ExtCtrls, Printers, Types, TAGraph;
+ Classes, SysUtils, Graphics, ExtCtrls, Printers, LCLVersion, Types, TAGraph;
type
TBHRDocument = class;
TBHRElement = class(TObject)
- Constructor Create(D : TBHRDocument); virtual;
- Destructor Destroy; override;
private
FDocument : TBHRDocument;
FRect : TRect;
@@ -40,6 +38,8 @@ TBHRElement = class(TObject)
Procedure DeployKeepWithNext; virtual;
Procedure Move(PNr, Tp : word); virtual;
public
+ Constructor Create(D : TBHRDocument); virtual;
+ Destructor Destroy; override;
Procedure Draw(Cnvs : TCanvas; Pnr : integer; Scale : single); virtual;
Procedure CalcRect; virtual;
property Rect : TRect read FRect write SetRect;
@@ -58,13 +58,13 @@ TBHRElement = class(TObject)
end;
TBHRImage = class(TBHRElement)
- Constructor Create(D : TBHRDocument); override;
- Destructor Destroy; override;
private
FPicture : TPicture;
FStretch : boolean;
protected
public
+ Constructor Create(D : TBHRDocument); override;
+ Destructor Destroy; override;
Procedure Draw(Cnvs : TCanvas; Pnr : integer; Scale : single); override;
Procedure CalcRect; override;
published
@@ -73,13 +73,13 @@ TBHRImage = class(TBHRElement)
end;
{ TBHRBHGraph = class(TBHRElement)
- Constructor Create(D : TBHRDocument); override;
- Destructor Destroy; override;
private
FGraph : TBHGraph;
FStretch : boolean;
protected
public
+ Constructor Create(D : TBHRDocument); override;
+ Destructor Destroy; override;
Procedure Draw(Cnvs : TCanvas; Pnr : integer; Scale : single); override;
Procedure CalcRect; override;
published
@@ -88,13 +88,13 @@ { TBHRBHGraph = class(TBHRElement)
end; }
TBHRChart = class(TBHRElement)
- Constructor Create(D : TBHRDocument); override;
- Destructor Destroy; override;
private
FChart : TChart;
FStretch : boolean;
protected
public
+ Constructor Create(D : TBHRDocument); override;
+ Destructor Destroy; override;
Procedure Draw(Cnvs : TCanvas; Pnr : integer; Scale : single); override;
Procedure CalcRect; override;
published
@@ -106,8 +106,6 @@ TBHRText = class;
TBHRCell = class;
TBHRTable = class(TBHRElement)
- Constructor Create(D : TBHRDocument); override;
- Destructor Destroy; override;
private
FCells : array of array of TBHRCell;
FAutoSizeCells : boolean;
@@ -123,6 +121,8 @@ TBHRTable = class(TBHRElement)
protected
Procedure Move(PNr, Tp : word); override;
public
+ Constructor Create(D : TBHRDocument); override;
+ Destructor Destroy; override;
Function GetCell(aRow, aCol : integer) : TBHRCell;
Function NumRows : integer;
Function NumCols : integer;
@@ -147,8 +147,6 @@ TBHRTable = class(TBHRElement)
end;
TBHRCell = class(TBHRElement)
- Constructor Create(D : TBHRDocument; R, C : integer);
- Destructor Destroy; override;
private
FText : TBHRText;
FTable : TBHRTable;
@@ -179,6 +177,8 @@ TBHRCell = class(TBHRElement)
protected
Procedure Move(PNr, Tp : word); override;
public
+ Constructor Create(D : TBHRDocument; R, C : integer);
+ Destructor Destroy; override;
Procedure Draw(Cnvs : TCanvas; Pnr : integer; Scale : single); override;
Procedure CalcRect; override;
published
@@ -205,8 +205,6 @@ TLineProps = record
end;
TBHRText = class(TBHRElement)
- Constructor Create(D : TBHRDocument); override;
- Destructor Destroy; override;
private
FCell : TBHRCell;
FStrings : TStringList;
@@ -227,6 +225,8 @@ TBHRText = class(TBHRElement)
protected
Procedure Move(PNr, Tp : word); override;
public
+ Constructor Create(D : TBHRDocument); override;
+ Destructor Destroy; override;
Procedure Draw(Cnvs : TCanvas; Pnr : integer; Scale : single); override;
Procedure CalcRect; override;
Procedure AddString(s : string);
@@ -249,8 +249,6 @@ TBHRText = class(TBHRElement)
THeaderType = (thHeader, thFooter);
TBHRHeader = class(TBHRElement)
- Constructor Create(D : TBHRDocument; HT : THeaderType);
- Destructor Destroy; override;
private
FPicture : TPicture;
FPictRect, FTxtRect : TRect;
@@ -271,6 +269,8 @@ TBHRHeader = class(TBHRElement)
Procedure SetText(S : string);
protected
public
+ Constructor Create(D : TBHRDocument; HT : THeaderType);
+ Destructor Destroy; override;
Procedure Draw(Cnvs : TCanvas; Pnr : integer; Scale : single); override;
Procedure CalcRect; override;
property PictRect : TRect read GetPictRect write SetPictRect;
@@ -287,8 +287,6 @@ TBHRHeader = class(TBHRElement)
end;
TBHRDocument = class(TObject)
- Constructor Create;
- Destructor Destroy; override;
private
FHeader : TBHRHeader;
FFooter : TBHRHeader;
@@ -307,6 +305,8 @@ TBHRDocument = class(TObject)
Function GetElement(i : integer) : TBHRElement;
protected
public
+ Constructor Create;
+ Destructor Destroy; override;
Procedure AddPage;
Procedure RemovePage;
Function AddText(Rect : TRect; s : string) : TBHRText;
@@ -916,7 +916,10 @@ procedure TBHRElement.SetTop(t : word);
bmp : tbitmap;
GSc : single;
i, OLineWidth, OLegendMargin, OSymbolWidth : integer;
- OMFH, OTFH, OTL, OLFH : integer;
+ OMFH, OTL, OLFH : integer;
+ {$IF LCL_FullVersion < 2010000}
+ OTFH : integer;
+ {$ENDIF}
{const FH = 100;
PenW = 10;}
begin
@@ -935,7 +938,9 @@ procedure TBHRElement.SetTop(t : word);
BRect.Bottom:= SRect.Bottom - SRect.Top;
BRect.Right:= SRect.Right - SRect.Left;
+ {$IF LCL_FullVersion < 2010000}
OTFH:= FChart.AxisList[0].Title.Font.Size;
+ {$ENDIF}
OMFH:= FChart.AxisList[0].Marks.LabelFont.Size;
OTL:= FChart.AxisList[0].TickLength;
OLFH:= FChart.Legend.Font.Size;
@@ -946,7 +951,9 @@ procedure TBHRElement.SetTop(t : word);
for i:= 0 to FChart.AxisList.Count - 1 do
begin
FChart.AxisList[i].Marks.LabelFont.Size:= round(GSc * 9);
+ {$IF LCL_FullVersion < 2010000}
FChart.AxisList[i].Title.Font.Size:= round(GSC * 9);
+ {$ENDIF}
FChart.AxisList[i].TickLength:= round(GSc * OTL);
end;
FChart.Legend.Font.Size:= round(GSc * 9);
@@ -962,7 +969,9 @@ procedure TBHRElement.SetTop(t : word);
for i:= 0 to FChart.AxisList.Count - 1 do
begin
FChart.AxisList[i].Marks.LabelFont.Size:= OMFH;
+ {$IF LCL_FullVersion < 2010000}
FChart.AxisList[i].Title.Font.Size:= OTFH;
+ {$ENDIF}
FChart.AxisList[i].TickLength:= OTL;
end;
FChart.Legend.Font.Size:= OLFH;
diff --git a/Source/Units/bhgraphics.pas b/Source/Units/bhgraphics.pas
index ff6c6d1e..14fa04e4 100644
--- a/Source/Units/bhgraphics.pas
+++ b/Source/Units/bhgraphics.pas
@@ -964,14 +964,16 @@ implementation
Function PolyPolygon(Canvas : TCanvas; Points: array of TPoint; {PolyCounts : array of integer;} AmPoly : integer) : boolean;
begin
+ Result:= True;
Canvas.Polygon(Points, {PolyCounts,} AmPoly, false);
end;
Function PolyRoundedLine(Canvas : TCanvas; Points : array of TPoint; RoundPerc : single) : boolean;
-var i, j, Max, dX, dY : LongInt;
+var i, dX, dY : LongInt;
PB : array[1..4] of TPoint;
Line : array[1..2] of TPoint;
begin
+ Result:= True;
if RoundPerc < 0 then RoundPerc:= 0;
if RoundPerc > 50 then RoundPerc:= 50;
Line[1].X:= Points[0].X; Line[1].Y:= Points[0].Y;
diff --git a/Source/Units/bhprintforms.pas b/Source/Units/bhprintforms.pas
index d3efd005..04272772 100644
--- a/Source/Units/bhprintforms.pas
+++ b/Source/Units/bhprintforms.pas
@@ -25,13 +25,11 @@ TIngrListItem = record
Caption : string;
IngrType : TIngredientType;
end;
-
- TIngrListArray = array of TIngrListItem;
+ //TIngrListArray = array of TIngrListItem;
var Head1FontSize, Head2FontSize, Head3FontSize: word;
TextFontSize: word;
clHead, clOneven, clEven : TColor;
- IngrListArray : TIngrListArray;
Function CmToPixX(cm : single) : word;
begin
@@ -204,7 +202,7 @@ TIngrListItem = record
Function CreateCheckList(Doc : TBHRDocument; Rec : TRecipe) : boolean;
var i, j : integer;
txt : TBHRText;
- Space : TBHRElement;
+ {%H-}Space : TBHRElement;
logo : TImage;
R : TRect;
LineSpace : word;
@@ -264,8 +262,8 @@ TIngrListItem = record
txt : TBHRText;
logo : TImage;
tbl : TBHRTable;
- chart : TBHRChart;
- Space : TBHRElement;
+ {%H-}chart : TBHRChart;
+ {%H-}Space : TBHRElement;
R : TRect;
v : double;
LineSpace : word;
@@ -2532,11 +2530,10 @@ TIngrListItem = record
Function CreateStockList(Doc : TBHRDocument) : boolean;
var i, nRows, nCols, Ro, Co : integer;
- txt : TBHRText;
-// img : TBHRImage;
+ {%H-}txt : TBHRText;
logo : TImage;
tbl : TBHRTable;
- Space : TBHRElement;
+ {%H-}Space : TBHRElement;
R : TRect;
LineSpace : word;
s : string;
@@ -2900,7 +2897,6 @@ TIngrListItem = record
F : TFermentable;
H : THop;
Y : TYeast;
- wi : word;
const ItemLength = 40;
begin
Result:= false;
@@ -3033,7 +3029,7 @@ TIngrListItem = record
end;
Function CreateStockListFile : boolean;
-var i, j : integer;
+var i : integer;
Memo : TMemo;
dlg : TSaveDialog;
s, FN : string;
@@ -3041,13 +3037,12 @@ TIngrListItem = record
F : TFermentable;
H : THop;
Y : TYeast;
- wi : word;
ds, ls : char;
const ItemLength = 40;
begin
Result:= false;
- ds:= DecimalSeparator;
- ls:= ListSeparator;
+ ds:= DefaultFormatSettings.DecimalSeparator;
+ ls:= DefaultFormatSettings.ListSeparator;
if ds = ls then ls:= ';';
Application.ProcessMessages;
@@ -3178,10 +3173,11 @@ TIngrListItem = record
logo : TImage;
tbl : TBHRTable;
R : TRect;
- LineSpace, wi, totbr : word;
+ {LineSpace,} wi, totbr : word;
totvol, x : double;
s : string;
Rec : TRecipe;
+
Procedure NextR;
begin
Inc(Ro);
@@ -3203,7 +3199,7 @@ TIngrListItem = record
Head2FontSize:= 13;
Head3FontSize:= 10;
TextFontSize:= 9;
- LineSpace:= round(1.2 * FontSizeToPix(TextFontSize, 1));
+ //LineSpace:= round(1.2 * FontSizeToPix(TextFontSize, 1));
if (Doc <> NIL) then
begin
Screen.Cursor:= crHourglass;
diff --git a/Source/Units/cloud.pas b/Source/Units/cloud.pas
index 8b9909d2..4f07856e 100644
--- a/Source/Units/cloud.pas
+++ b/Source/Units/cloud.pas
@@ -1,4 +1,4 @@
-unit cloud;
+unit Cloud;
{$mode objfpc}{$H+}
@@ -16,7 +16,7 @@ TBHCloudFile = class(TObject)
FShowRecipe : TBBoolean; //show the recipe in the cloud recipe tree
FFileType : TFileType;
Constructor Create;
- Destructor Destroy;
+ Destructor Destroy; override;
Procedure ReadXML(iNode: TDOMNode);
Procedure SaveXML(Doc: TXMLDocument; iNode: TDOMNode);
private
@@ -77,7 +77,7 @@ TBHCloud = class(TObject)
Function GetFileRec(i : longint) : TBHCloudFile;
public
Constructor Create; virtual;
- Destructor Destroy;
+ Destructor Destroy; override;
Function ReadCloud : boolean; //retrieve file info of all files in the cloud
Procedure SaveXML;
Procedure ReadXML;
@@ -883,7 +883,7 @@ implementation
Function TBHCloud.LoadRecipeByName(FN : string) : boolean;
var ftp: TFTPSend;
- i, j, fnr : integer;
+ i : integer;
localfn, remotefn, remotefnd, ext : string;
bhr : TBHCloudFile;
begin
@@ -966,6 +966,7 @@ implementation
Function TBHCloud.LoadRecipeByIndex(i : longint) : boolean;
begin
+ Result:= True;
if (i >= Low(FFiles)) and (i <= High(FFiles)) then
LoadRecipeByName(FFiles[i].FileName.Value);
end;
@@ -1078,7 +1079,7 @@ function RunAsAdmin(const Handle: Hwnd; const Path, Params: string): Boolean;
var Proc: TProcess;
CharBuffer: array [0..511] of char;
RestCount: integer;
- ExitCode: integer;
+ //ExitCode: integer;
SudoPassword: string;
begin
Result:= false;
@@ -1141,7 +1142,7 @@ function RunAsAdmin(const Handle: Hwnd; const Path, Params: string): Boolean;
end;
SudoPassword := 'password'; //hope this will scramble memory
SudoPassword := ''; // and make the program a bit safer from snooping?!?
- ExitCode := Proc.ExitStatus;
+ //ExitCode := Proc.ExitStatus;
Result:= true;
finally
Proc.Free;
@@ -1229,12 +1230,11 @@ function RunAsAdmin(const Handle: Hwnd; const Path, Params: string): Boolean;
Function GetHTTPFile(URL, localfn : string) : boolean;
var Lines : TStringList;
- Header : TStringList;
+ //Header : TStringList;
HTTPGetResult: boolean;
HTTPSender: THTTPSend;
- RetryAttempt, i: integer;
+ RetryAttempt: integer;
dir : string;
- s : string;
const MaxRetries = 1;
begin
result:= false;
@@ -1358,11 +1358,13 @@ function RunAsAdmin(const Handle: Hwnd; const Path, Params: string): Boolean;
end;
Function DownloadNewVersion(fn : string) : boolean;
-var i, j : longint;
- localfn, fnlocal, s, bs : string;
+var localfn: string;
aProcess : TProcess; //TProcess is crossplatform is best way
delfile : PChar;
+ {$ifdef windows}
+ s, bs : string;
l : TStringList;
+ {$endif}
begin
Result:= false;
try
diff --git a/Source/Units/containers.pas b/Source/Units/containers.pas
index bdb3f8cb..17b9fdf0 100644
--- a/Source/Units/containers.pas
+++ b/Source/Units/containers.pas
@@ -29,7 +29,7 @@ TContainer = class(TObject)
Procedure SortByIndex2(I1, I2 : integer; Decending : boolean);
Procedure SortByName(s : string);
Procedure UnSelect;
- Function AddItem : TBase; virtual;
+ Function AddItem : TBase;
Procedure InsertItem(i : integer); virtual;
Procedure RemoveItem(i : integer); virtual;
Procedure RemoveByReference(Item : TBase); virtual;
@@ -58,7 +58,7 @@ TFermentables = class(TContainer)
Procedure ReadXML; override;
Function ImportXML : boolean; override;
Function GetSelectedItem : TFermentable;
- Function AddItem : TFermentable;
+ Function AddItem : TFermentable; reintroduce;
Procedure InsertItem(i : integer); override;
Function FindByNameAndSupplier(N, S : string) : TFermentable;
published
@@ -73,7 +73,7 @@ THops = class(TContainer)
Procedure ReadXML; override;
Function ImportXML : boolean; override;
Function GetSelectedItem : THop;
- Function AddItem : THop;
+ Function AddItem : THop; reintroduce;
Procedure InsertItem(i : integer); override;
Function FindByNameAndOriginAndAlfa(N, O : string; A : double) : THop;
published
@@ -88,7 +88,7 @@ TMiscs = class(TContainer)
Procedure ReadXML; override;
Function ImportXML : boolean; override;
Function GetSelectedItem : TMisc;
- Function AddItem : TMisc;
+ Function AddItem : TMisc; reintroduce;
Procedure InsertItem(i : integer); override;
published
property SelectedItem : TMisc read GetSelectedItem;
@@ -102,7 +102,7 @@ TYeasts = class(TContainer)
Procedure ReadXML; override;
Function ImportXML : boolean; override;
Function GetSelectedItem : TYeast;
- Function AddItem : TYeast;
+ Function AddItem : TYeast; reintroduce;
Procedure InsertItem(i : integer); override;
Function FindByNameAndLaboratory(N, L : string) : TYeast;
published
@@ -117,7 +117,7 @@ TWaters = class(TContainer)
Procedure ReadXML; override;
Function ImportXML : boolean; override;
Function GetSelectedItem : TWater;
- Function AddItem : TWater;
+ Function AddItem : TWater; reintroduce;
Procedure InsertItem(i : integer); override;
Function GetDefaultWater : TWater;
Function GetDemiWater : TWater;
@@ -133,7 +133,7 @@ TEquipments = class(TContainer)
Procedure ReadXML; override;
// Function ImportXML : boolean; override;
Function GetSelectedItem : TEquipment;
- Function AddItem : TEquipment;
+ Function AddItem : TEquipment; reintroduce;
Procedure InsertItem(i : integer); override;
Procedure CalcEfficiencyRegressionFactors;
Procedure CalcAttenuationRegressionFactors;
@@ -149,7 +149,7 @@ TBeerStyles = class(TContainer)
Procedure ReadXML; override;
Function ImportXML : boolean; override;
Function GetSelectedItem : TBeerStyle;
- Function AddItem : TBeerStyle;
+ Function AddItem : TBeerStyle; reintroduce;
Procedure InsertItem(i : integer); override;
published
property SelectedItem : TBeerStyle read GetSelectedItem;
@@ -163,7 +163,7 @@ TMashs = class(TContainer)
Procedure ReadXML; override;
Function ImportXML : boolean; override;
Function GetSelectedItem : TMash;
- Function AddItem : TMash;
+ Function AddItem : TMash; reintroduce;
Procedure InsertItem(i : integer); override;
published
property SelectedItem : TMash read GetSelectedItem;
@@ -188,7 +188,7 @@ TRecipes = class(TContainer)
FCommonMinMaxArray : TMinMaxArray;
Procedure QuickSortRecipes(var Arr : array of TBase);
Function ImportXMLs(FN : TStrings; DN : string; Equip : TEquipment) : boolean;
- Function ImportXML(FN : string; Equip : TEquipment) : boolean;
+ Function ImportXML(FN : string; Equip : TEquipment) : boolean; reintroduce;
Function ImportRECs(FN : TStrings; DN : string; Equip : TEquipment) : boolean;
Function ImportREC(FN : string; Equip : TEquipment) : boolean;
Function GetLastNrRecipe : string;
@@ -205,7 +205,7 @@ TRecipes = class(TContainer)
FT : TFileType) : boolean;
Procedure Sort;
Function GetSelectedItem : TRecipe;
- Function AddItem : TRecipe;
+ Function AddItem : TRecipe; reintroduce;
Procedure InsertItem(i : integer); override;
Function FindByNameAndNr(Nm, Nr : string) : TRecipe;
Function FindByAutoNr(nr : integer) : TRecipe;
@@ -427,7 +427,7 @@ implementation
begin
FDoc := TXMLDocument.Create;
// FDoc.Encoding:= 'ISO-8859-1';
- FRootNode := FDoc.CreateElement(FLabel);
+ FRootNode := FDoc.CreateElement(FLabel{%H-});
FDoc.Appendchild(FRootNode);
end;
@@ -441,7 +441,7 @@ implementation
if FileExists(FN) then
begin
ReadXMLFile(FDoc, FN);
- FRootNode:= FDoc.FindNode(FLabel);
+ FRootNode:= FDoc.FindNode(FLabel{%H-});
end;
except
FDoc.Free;
@@ -468,7 +468,7 @@ implementation
FImportFileName:= dlg.FileName;
dlg.Free;
ReadXMLFile(FDoc, FImportFileName);
- FRootNode:= FDoc.FindNode(FLabel);
+ FRootNode:= FDoc.FindNode(FLabel{%H-});
Result:= TRUE;
end;
except
@@ -1733,7 +1733,7 @@ implementation
var SL : TStringList;
i : integer;
mask : string;
- ps : TProgressBar;
+ //ps : TProgressBar;
begin
Result:= false;
if DN <> '' then
@@ -1789,7 +1789,7 @@ implementation
Function TRecipes.ImportXML(FN : string; Equip : TEquipment) : boolean;
var R : TRecipe;
- s : string;
+ //s : string;
begin
Result:= false;
FDoc := TXMLDocument.Create;
@@ -1798,8 +1798,8 @@ implementation
if FileExists(FN) then
begin
ReadXMLFile(FDoc, FN);
- s:= ExtractFileNameOnly(FN);
- FRootNode:= FDoc.FindNode(FLabel);
+ //s:= ExtractFileNameOnly(FN);
+ FRootNode:= FDoc.FindNode(FLabel{%H-});
if FRootNode <> NIL then
begin
FChild:= FRootNode.FirstChild;
@@ -1837,7 +1837,7 @@ implementation
var SL : TStringList;
i : integer;
mask : string;
- ps : TProgressBar;
+ //ps : TProgressBar;
begin
Result:= false;
if DN <> '' then
@@ -1883,7 +1883,7 @@ implementation
Function TRecipes.ImportREC(FN : string; Equip : TEquipment) : boolean;
var PI : TPromash;
R : TRecipe;
- s : string;
+ //s : string;
begin
Result:= false;
PI := TPromash.Create(FrmMain);
@@ -1897,7 +1897,7 @@ implementation
if R <> NIL then
begin
PI.Convert(R);
- s:= R.Style.Name.Value;
+ //s:= R.Style.Name.Value;
R.AutoNr.Value:= MaxAutoNr + 1;
CheckBeerStyle(R);
@@ -2954,7 +2954,6 @@ TStyleLetters = record
var sourcedata, destdata : string;
year, month, day : word;
i : integer;
- SearchResult : TSearchRec;
SL : TStringList;
begin
sourcedata:= Settings.DataLocation.Value;
@@ -2995,7 +2994,6 @@ TStyleLetters = record
result:= CopyFile(sd + fn, dd + fn);
end;
var destdata : string;
- year, month, day : word;
i : integer;
SL : TStringList;
begin
@@ -3192,10 +3190,10 @@ TStyleLetters = record
if FileExists(sd + fn) then
result:= CopyFile(sd + fn, dd + fn);
end;
-var SearchResult : TSearchRec;
- i : integer;
- SL : TStringList;
- StylesN, FermN, HopN, MiscN, YeastN, WaterN, sourcedata : string;
+var
+ i : integer;
+ SL : TStringList;
+ StylesN, FermN, HopN, MiscN, YeastN, WaterN : string;
begin
{$ifdef UNIX}
destination:= destination + '/';
@@ -3233,13 +3231,13 @@ TStyleLetters = record
else //copy previous database to new location, but clear brews
begin
{$ifdef UNIX}
- sourcedata:= '/usr/share/brewbuddy/';
+ //sourcedata:= '/usr/share/brewbuddy/';
{$endif}
{$ifdef darwin}
- sourcedata:= '/usr/share/brewbuddy/';
+ //sourcedata:= '/usr/share/brewbuddy/';
{$endif}
{$ifdef Windows}
- sourcedata:= ExtractFilePath(Application.ExeName) + 'brewbuddy\';
+ //sourcedata:= ExtractFilePath(Application.ExeName) + 'brewbuddy\';
if OnUSB then BHFolder:= DriveLetter + '\brewbuddy\brewbuddy\'
else BHFolder:= destination;
{$endif}
@@ -3348,7 +3346,6 @@ TStyleLetters = record
Initialization
if DoLog then slLog:= TStringList.Create
else slLog:= NIL;
- Screen.Cursor:= crHourglass;
ExecFolder:= Application.Location;
log('ExecFolder = ' + ExecFolder);
@@ -3450,7 +3447,7 @@ TStyleLetters = record
CheckSalts;
end
else
- ShowMessage('Databestanden niet gevonden');
+ WriteLn('Databestanden niet gevonden');
// Equipments.CalcEfficiencyRegressionFactors;
// Equipments.CalcAttenuationRegressionFactors;
@@ -3466,8 +3463,6 @@ TStyleLetters = record
Brews.ExportToCSV(Arr);
SetLength(Arr, 0);}
- Screen.Cursor:= crDefault;
-
Finalization
if OnUSB then
begin
diff --git a/Source/Units/data.pas b/Source/Units/data.pas
index 3aaecf88..f642778a 100644
--- a/Source/Units/data.pas
+++ b/Source/Units/data.pas
@@ -249,7 +249,7 @@ TStyle = class(TObject)
FPanelColors : TColor;
public
constructor Create;
- destructor Destroy;
+ destructor Destroy; override;
procedure Assign(St : TStyle);
procedure SaveXML(Doc: TXMLDocument; iNode: TDomNode; bxml: boolean);
procedure ReadXML(iNode: TDOMNode);
@@ -299,7 +299,7 @@ TBSettings = class(TObject)
FSortCloud : TBInteger;
public
constructor Create;
- destructor Destroy;
+ destructor Destroy; override;
procedure Save;
procedure Read;
published
@@ -352,6 +352,8 @@ TBase = class(TObject)
function GetValueByName(s: string): variant; virtual;
public
constructor Create(R: TRecipe); virtual;
+ {$warning Destructor should have "override", not "virtual" but it causes crash. Serious memory issues!}
+ //destructor Destroy; override;
destructor Destroy; virtual;
procedure SaveXML(Doc: TXMLDocument; iNode: TDOMNode; bxml: boolean); virtual;
procedure ReadXML(iNode: TDOMNode); virtual;
@@ -1670,7 +1672,7 @@ implementation
uses frmain, Containers, umulfit, utypes, lconvencoding, typinfo;
Procedure SetFloatSpinEdit(fse : TFloatSpinEdit; f : TBFloat; SetValue : boolean);
-var u : TUnit;
+var {%H-}u : TUnit;
begin
fse.AutoSize:= false;
fse.Height:= 23;
@@ -1697,7 +1699,6 @@ implementation
end;
Procedure SetSpinEdit(se : TSpinEdit; f : TBInteger; SetValue : boolean);
-var u : TUnit;
begin
se.AutoSize:= false;
se.Height:= 23;
@@ -1738,10 +1739,10 @@ procedure AddNode(Doc: TXMLDocument; iNode: TDOMNode; Title: string; Value: stri
iChild, iTextNode: TDOMNode;
s: string;
begin
- iChild := Doc.CreateElement(Title);
+ iChild := Doc.CreateElement(Title{%H-});
s := ReplaceSpecialChars(Value);
s := SetDecimalPoint(s);
- iTextNode := Doc.CreateTextNode(s);
+ iTextNode := Doc.CreateTextNode(s{%H-});
iChild.AppendChild(iTextNode);
iNode.AppendChild(iChild);
end;
@@ -1751,9 +1752,9 @@ procedure AddNodeS(Doc: TXMLDocument; iNode: TDOMNode; Title: string; Value: str
iChild, iTextNode: TDOMNode;
s: string;
begin
- iChild := Doc.CreateElement(Title);
+ iChild := Doc.CreateElement(Title{%H-});
s := ReplaceSpecialChars(Value);
- iTextNode := Doc.CreateTextNode(s);
+ iTextNode := Doc.CreateTextNode(s{%H-});
iChild.AppendChild(iTextNode);
iNode.AppendChild(iChild);
end;
@@ -1774,9 +1775,9 @@ function GetNodeString(iNode: TDOMNode; Title: string): string;
iChild: TDOMNode;
s: string;
begin
- iChild := iNode.FindNode(Title);
+ iChild := iNode.FindNode(Title{%H-});
if (iChild <> nil) and (iChild.FirstChild <> nil) then
- s := iChild.FirstChild.NodeValue
+ s := iChild{%H-}.FirstChild.NodeValue
else
s := '';
Result := Trim(ResetSpecialChars(s));
@@ -1841,23 +1842,29 @@ constructor TBData.Create(aParent : TBase);
procedure TBData.SaveXML(Doc: TXMLDocument; iNode: TDomNode; bxml: boolean);
var
- val: string;
+ v: string;
+ {$ifdef WINDOWS}
encs, encto: string;
+ {$endif}
begin
if (FCaption <> '') then
begin
- val := FCaption;
+ v := FCaption;
{$ifdef WINDOWS}
encs := 'utf8';
encto := GetDefaultTextEncoding;
- val := ConvertEncoding(FCaption, encs, encto);
+ v := ConvertEncoding(FCaption, encs, encto);
{$endif}
- AddNodeS(Doc, iNode, 'CAPTION', Val);
+ AddNodeS(Doc, iNode, 'CAPTION', v);
end;
end;
procedure TBData.ReadXML(iNode: TDOMNode);
-var v, encs, encto: string;
+var
+ v: string;
+ {$ifdef WINDOWS}
+ encs, encto: string;
+ {$endif}
begin
if (FLabel <> '') then
begin
@@ -2391,29 +2398,33 @@ constructor TBString.Create(aParent : TBase);
begin
Inherited Create(aParent);
FValue := '';
- FLabel := '';
end;
procedure TBString.SaveXML(Doc: TXMLDocument; iNode: TDomNode; bxml: boolean);
var
- val: string;
+ v: string;
+ {$ifdef WINDOWS}
encs, encto: string;
+ {$endif}
begin
if (FValue <> '') and (FLabel <> '') then
begin
- val := FValue;
+ v := FValue;
{$ifdef WINDOWS}
encs := 'utf8';
encto := GetDefaultTextEncoding;
- val := ConvertEncoding(FValue, encs, encto);
+ v := ConvertEncoding(FValue, encs, encto);
{$endif}
- AddNodeS(Doc, iNode, FLabel, Val);
+ AddNodeS(Doc, iNode, FLabel, v);
end;
end;
procedure TBString.ReadXML(iNode: TDOMNode);
var
- v, encs, encto: string;
+ v: string;
+ {$ifdef WINDOWS}
+ encs, encto: string;
+ {$endif}
begin
if FLabel <> '' then
begin
@@ -2442,15 +2453,15 @@ procedure TBString.Assign(Source: TBString);
end;
procedure TBString.SetValue(v: string);
-var
- encs, encto: string;
begin
FValue := v;
end;
function TBString.GetValue: string;
var
+ {$ifdef Windows}
i: integer;
+ {$endif}
s: string;
begin
s := FValue;
@@ -4227,9 +4238,11 @@ procedure TFermentable.ReadXML(iNode: TDOMNode);
end;
Function TFermentable.BufferCapacity : double; //mEq/kg.pH
-var C1, x, y, ebc : double;
-begin x:= FAcidTo57.Value;
- y:= FDIpH.Value;
+var C1, ebc: double;
+ //x, y: double;
+begin
+ //x:= FAcidTo57.Value;
+ //y:= FDIpH.Value;
if (FDIpH.Value <> 5.7) and (not Between(FAcidTo57.Value, -0.1, 0.1)) then
C1:= FAcidTo57.Value / (FDIpH.Value - 5.7)
else
@@ -4510,7 +4523,6 @@ constructor TYeast.Create(R: TRecipe);
FCultureDate.Value := 0;
FCultureDate.NodeLabel := 'CULTURE_DATE';
-
FTimeAerated := TBFloat.Create(self);
FTimeAerated.vUnit := uur;
FTimeAerated.DisplayUnit := uur;
@@ -4859,7 +4871,6 @@ procedure TYeast.SaveXML(Doc: TXMLDocument; iNode: TDomNode; bxml: boolean);
procedure TYeast.ReadXML(iNode: TDOMNode);
var am : double;
- b : boolean;
s, samun : string;
begin
inherited ReadXML(iNode);
@@ -6478,7 +6489,6 @@ destructor TEquipment.Destroy;
FEvapRate.Free;
FBoilTime.Free;
FCalcBoilVolume.Free;
- FMashVolume.Free;
FLauterDeadSpace.Free;
FTopUpKettle.Free;
FHopUtilization.Free;
@@ -6489,6 +6499,7 @@ destructor TEquipment.Destroy;
FTunHeight.Free;
FKettleHeight.Free;
FLauterHeight.Free;
+ FMashVolume.Free;
FEfficiency.Free;
FEffFactBD.Free;
FEffFactSG.Free;
@@ -7761,7 +7772,7 @@ function TMashStep.GetDisplayString: string;
procedure TMashStep.CalcStep;
var
- A, B, perc, GrM, VolMalt, VWater, Temp, Vol: double;
+ A, B, GrM, {VolMalt,} VWater, Temp, Vol: double;
i, n: integer;
Mash: TMash;
Prior: TMashStep;
@@ -7778,7 +7789,7 @@ procedure TMashStep.CalcStep;
end;
Mash := FRecipe.Mash;
GrM := FRecipe.GrainMassMash;
- VolMalt := GrM * MaltVolume;
+ //VolMalt := GrM * MaltVolume;
case MashStepType of
mstInfusion:
begin
@@ -8179,8 +8190,7 @@ function TMash.GetMashWaterVolume: double;
end;
procedure TMash.SetMashWaterVolume(V: double);
-var
- Vol: double;
+//var Vol: double;
begin
if (NumMashSteps > 0) and (V > 0) then
begin
@@ -8326,9 +8336,10 @@ function TMash.AverageTemperature: double;
begin
Result := 0;
pt:= 0;
+ MS:= NIL;
for i := 0 to NumMashSteps - 1 do
begin
- if i > 0 then MS2:= MS else MS2:= NIL;
+ MS2:= MS;
MS := MashStep[i];
if ((MS.StepTemp.Value > 59) and (MS.StepTemp.Value <= 65)) or
((MS.EndTemp.Value > 59) and (MS.EndTemp.Value <= 65)) then
@@ -8368,9 +8379,10 @@ function TMash.AverageTemperature: double;
begin
Result := 0;
pt:= 0;
+ MS:= NIL;
for i := 0 to NumMashSteps - 1 do
begin
- if i > 0 then MS2:= MS else MS2:= NIL;
+ MS2:= MS;
MS := MashStep[i];
if ((MS.StepTemp.Value > 65) and (MS.StepTemp.Value <= 75)) or
((MS.EndTemp.Value > 65) and (MS.EndTemp.Value <= 75)) then
@@ -8897,7 +8909,6 @@ procedure TCheckListItem.SaveXML(Doc: TXMLDocument; iNode: TDomNode; bxml: boole
end;
procedure TCheckListItem.ReadXML(iNode: TDOMNode);
-var iChild, iChild2: TDOMNode;
begin
FItem.ReadXML(iNode);
end;
@@ -9055,6 +9066,7 @@ constructor TCheckList.Create(R: TRecipe);
destructor TCheckList.Destroy;
begin
Clear;
+ Inherited;
end;
procedure TCheckList.Assign(Source: TBase);
@@ -9240,7 +9252,6 @@ TIngrListItem = record
F : TFermentable;
H : THop;
MS : TMashStep;
- ho, mi, se, mis : word;
numsalts : longint;
CLG : TCheckListGroup;
CLI : TCheckListItem;
@@ -13024,7 +13035,6 @@ function TRecipe.GetNumIngredients: integer;
var i, n : integer;
IDB : TIngredient;
F : TFermentable;
- H : THop;
M : TMisc;
Y : TYeast;
SL : TStringList;
@@ -13046,6 +13056,7 @@ function TRecipe.GetNumIngredients: integer;
end;
end;
+ SetLength(Amounts, 0);
SL:= TStringList.Create;
//avoid dubble counts, make a list of unique hops
for n:= 0 to NumHops - 1 do
@@ -13696,7 +13707,6 @@ procedure TRecipe.CalcWaterBalance;
function TRecipe.GetSGEndMashCalc : double;
var i : integer;
mvol, d, v, s, gs : double;
- MS : TMashStep;
F : TFermentable;
begin
mvol:= 0;
@@ -13742,9 +13752,8 @@ function TRecipe.GetSGEndMashCalc : double;
function TRecipe.GetSGStartBoil: double;
var
- p, d: double;
i: integer;
- Pl, s, v: double;
+ d, Pl, s, v: double;
F: TFermentable;
begin
if FBatchSize.Value <> 0 then
@@ -13791,8 +13800,8 @@ function TRecipe.GetSGStartBoil: double;
procedure TRecipe.CalcOG;
var
i, j, k: integer;
- v, v2, sg, d, tot, tot2, vol, vol1, vol2, sugF, sug, sug2, p, x: double;
- mass1, mass2 : double;
+ sg, d, tot, tot2, vol, vol1, vol2, sugF, sug, sug2, p, x: double;
+ //mass1, mass2 : double;
F: TFermentable;
// ibu, bindex : double;
begin
@@ -13920,7 +13929,6 @@ procedure TRecipe.CalcFermentablesFromPerc(OG: double);
i, j: integer;
sug, d, tot, totmass, x: double;
vol, vol1, vol2, sug2: double;
- mass1, mass2 : double;
F: TFermentable;
// ibu, bindex : double;
begin
@@ -13991,7 +13999,7 @@ procedure TRecipe.CalcFermentablesFromPerc(OG: double);
function TRecipe.CalcEfficiencyBeforeBoil: double;
var
i: integer;
- d, m, b, tot: double;
+ d, m, tot: double;
F: TFermentable;
begin
m := 0; //amount of sugars extracted from mash
@@ -14115,7 +14123,7 @@ function TRecipe.CalcVirtualOGduringFermentation: double;
end;
Function TRecipe.CalcOGFermenter : double;
-var vol1, vol2, sug, addedmass, addedS, ogx, top, vol, x: double;
+var vol1, {vol2,} sug, addedmass, addedS, ogx, top, vol, x: double;
F: TFermentable;
i: integer;
begin //og in fermenter, calculated from measured OG and volumes
@@ -14149,7 +14157,7 @@ function TRecipe.CalcVirtualOGduringFermentation: double;
vol:= vol + (x * SugarDensity + (1 - x) * 1) * F.Amount.Value;
end;
end;
- vol2:= vol1 + top + vol;
+ //vol2:= vol1 + top + vol;
sug:= sug + addedS; //kg
if ((vol1 * ogx + addedmass) > 0) then
@@ -14200,10 +14208,13 @@ function TRecipe.CalcVirtualOGduringFermentation: double;
begin
CalcColor;
Result:= FEstColor.Value;
+ addedVolume:= 0;
if FEquipment <> NIL then
begin
- if FEquipment.TopUpWaterBrewday.Value > 0 then top:= FEquipment.TopUpWaterBrewDay.Value
- else top:= FEquipment.TopUpWater.Value;
+ if FEquipment.TopUpWaterBrewday.Value > 0 then
+ top:= FEquipment.TopUpWaterBrewDay.Value
+ else
+ top:= FEquipment.TopUpWater.Value;
V2:= FVolumeFermenter.Value + top;
if V2 > 0 then
begin
@@ -14219,8 +14230,7 @@ function TRecipe.CalcVirtualOGduringFermentation: double;
end;
end;
V2:= V2 + addedvolume;
-
- if (V2 > 0) then
+ if V2 > 0 then
Result:= Result * V / V2;
// Result:= Convert(Result, FEstColor.vUnit, FEstColor.DisplayUnit);
end;
@@ -14229,7 +14239,6 @@ function TRecipe.CalcVirtualOGduringFermentation: double;
procedure TRecipe.EstimateFG;
var
- i: integer;
percS, percCara, BD, Att, AttBeer, sg: double;
Temp, TotTme: double;
Y: TYeast;
@@ -14708,7 +14717,7 @@ procedure SortByIndex(var Arr: array of TIngredient; Index: integer;
procedure QuickSort(var A: array of TIngredient; iLo, iHi: integer);
var
Lo, Hi: integer;
- mid, v: variant;
+ mid: variant;
TB: TIngredient;
begin
Lo := iLo;
@@ -14733,7 +14742,7 @@ procedure SortByIndex(var Arr: array of TIngredient; Index: integer;
procedure QuickSortDec(var A: array of TIngredient; iLo, iHi: integer);
var
Lo, Hi: integer;
- mid, v: variant;
+ mid: variant;
TB: TIngredient;
begin
Lo := iLo;
@@ -15085,10 +15094,9 @@ function TRecipe.GetRAmax: double;
procedure TRecipe.CalcMashWater;
var
i: integer;
- W: TWater;
M: TMisc;
- vol, acid, MolWt, AcidSG, AcidPrc, Acidmg, pK1, pK2, pK3, frac, TpH,
- ProtonDeficit: double;
+ vol, acid, MolWt, AcidSG, Acidmg, pK1, pK2, pK3, frac, TpH, ProtonDeficit: double;
+ //AcidPrc: double;
begin
FMashWater.Bicarbonate.Value:= 0;
FMashWater.Calcium.Value:= 0;
@@ -15102,7 +15110,7 @@ procedure TRecipe.CalcMashWater;
vol:= 0;
MolWt:= 0;
AcidSG:= 0;
- AcidPrc:= 0;
+ //AcidPrc:= 0;
Acidmg:= 0;
pK1:= 0;
pK2:= 0;
@@ -15155,7 +15163,7 @@ procedure TRecipe.CalcMashWater;
pK3:= 20;
MolWt:= 90.08;
AcidSG:= 1214; //@88%
- AcidPrc:= 0.88;
+ //AcidPrc:= 0.88;
frac:= CalcFrac(TpH, pK1, pK2, pK3);
acid:= acid + M.Amount.Value * M.FreeField.Value / 100 * AcidSG / MolWt * Frac / vol; //mEq/l
end;
@@ -15166,7 +15174,7 @@ procedure TRecipe.CalcMashWater;
pK3:= 20;
MolWt:= 36.46;
AcidSG:= 1142; //@28%
- AcidPrc:= 0.28;
+ //AcidPrc:= 0.28;
frac:= CalcFrac(TpH, pK1, pK2, pK3);
Acidmg:= M.Amount.Value * M.FreeField.Value / 100 * AcidSG / vol;
acid:= acid + Acidmg / MolWt * Frac; //mEq/l
@@ -15179,7 +15187,7 @@ procedure TRecipe.CalcMashWater;
pK3:= 12.44;
MolWt:= 98.00;
AcidSG:= 1170; //@25%
- AcidPrc:= 0.25;
+ //AcidPrc:= 0.25;
frac:= CalcFrac(TpH, pK1, pK2, pK3);
Acidmg:= M.Amount.Value * M.FreeField.Value / 100 * AcidSG / vol;
acid:= acid + Acidmg / MolWt * Frac; //mEq/l
@@ -15191,7 +15199,7 @@ procedure TRecipe.CalcMashWater;
pK3:= 20;
MolWt:= 98.07;
AcidSG:= 1700; //@93%
- AcidPrc:= 0.93;
+ //AcidPrc:= 0.93;
frac:= CalcFrac(TpH, pK1, pK2, pK3);
Acidmg:= M.Amount.Value * M.FreeField.Value / 100 * AcidSG / vol;
acid:= acid + Acidmg / MolWt * Frac; //mEq/l
@@ -15797,11 +15805,12 @@ function TRecipe.CopyToClipboardHTML: boolean;
Lichtgeel = '#fbfea3';
var
tabus, tabue, heads, heade, rowse, rowso, rowe, datas, datae, rows: string;
- lf, qm: char;
+ qm: char;
Memo: TMemo;
s1, s2: string;
i, n, rownr: integer;
- volmalt, spdspc, evap, mashvol, vol, x, top: double;
+ //volmalt, spdspc, evap, mashvol, vol: double;
+ x, top: double;
F: TFermentable;
H: THop;
M: TMisc;
@@ -15819,9 +15828,7 @@ function TRecipe.CopyToClipboardHTML: boolean;
end;
begin
- lf := CHR(10);
qm := CHR(34);
-
tabus := '';
heads := 'BrouwHulp Recept uitdraai');
@@ -16225,11 +16229,11 @@ function TRecipe.CopyToClipboardHTML: boolean;
function TRecipe.SaveHTML(s : string) : boolean;
var L : TStringList;
tabus, tabue, heads, heade, firsts, firste, rows, rowe, datas, datae: string;
- lf, qm: char;
- Memo: TMemo;
+ lf: char;
s1, s2: string;
i: integer;
- volmalt, spdspc, evap, mashvol, vol, x, top: double;
+ //volmalt, spdspc, evap, mashvol, vol: double;
+ x, top: double;
F: TFermentable;
H: THop;
M: TMisc;
@@ -16238,8 +16242,6 @@ function TRecipe.SaveHTML(s : string) : boolean;
MS: TMashStep;
begin
lf := CHR(10);
- qm := CHR(34);
-
tabus := '
'+lf+'
';
heads := ' ';
@@ -16962,7 +16964,6 @@ procedure TStyle.SaveXML(Doc: TXMLDocument; iNode: TDomNode; bxml: boolean);
//the style is supposed to be stored as a separate field in the settings file
var iChild: TDOMNode;
s : string;
- i : integer;
col : TColor;
r, g, b : integer;
rb, gb, bb : byte;
@@ -17050,7 +17051,6 @@ procedure TStyle.SaveXML(Doc: TXMLDocument; iNode: TDomNode; bxml: boolean);
procedure TStyle.ReadXML(iNode: TDOMNode);
var s : string;
i : integer;
- col : TColor;
r, g, b : integer;
rb, gb, bb : byte;
begin
diff --git a/Source/Units/hulpfuncties.pas b/Source/Units/hulpfuncties.pas
index d61b7bb6..4af14d9f 100644
--- a/Source/Units/hulpfuncties.pas
+++ b/Source/Units/hulpfuncties.pas
@@ -357,6 +357,7 @@ implementation
function GetTaskBarSize: TRect;
begin
+ Result := Rect(0,0,0,0);
{$ifdef Windows}
// SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0);
{$endif}
@@ -741,7 +742,7 @@ function GetTaskBarSize: TRect;
begin
Code:= 0;
try
- p:= Pos2(DecimalSeparator, S);
+ p:= Pos2(DefaultFormatSettings.DecimalSeparator, S);
if (p >= 0) and (p < Length(S)) then S[p]:= '.';
Val(S, D, Code);
Result:= D;
@@ -755,11 +756,11 @@ function GetTaskBarSize: TRect;
Function ValidateRealStr(S : string) : boolean;
var Code, p : integer;
SO : string;
- D : double;
+ {%H-}D : double;
begin
Code:= 0;
try
- p:= Pos2(DecimalSeparator, S);
+ p:= Pos2(DefaultFormatSettings.DecimalSeparator, S);
if (p >= 0) and (p < Length(S)) then S[p]:= '.';
Val(S, D, Code);
Result:= TRUE;
@@ -828,10 +829,10 @@ function GetTaskBarSize: TRect;
if s <> 'NTB' then
begin
- LongTimeFormat := 'hh:mm:ss';
- ShortDateFormat := 'DD-MM-YYYY';
- DateSeparator := '-';
- TimeSeparator := ':';
+ DefaultFormatSettings.LongTimeFormat := 'hh:mm:ss';
+ DefaultFormatSettings.ShortDateFormat := 'DD-MM-YYYY';
+ DefaultFormatSettings.DateSeparator := '-';
+ DefaultFormatSettings.TimeSeparator := ':';
try
Result:= StrToDate(ns);
except
@@ -839,7 +840,7 @@ function GetTaskBarSize: TRect;
end;
if Result = 0 then
begin
- ShortDateFormat := 'DD-MM-YY';
+ DefaultFormatSettings.ShortDateFormat := 'DD-MM-YY';
try
Result:= StrToDate(ns);
except
@@ -848,7 +849,7 @@ function GetTaskBarSize: TRect;
end;
if Result = 0 then
begin
- ShortDateFormat := 'MM-DD-YY';
+ DefaultFormatSettings.ShortDateFormat := 'MM-DD-YY';
try
Result:= StrToDate(ns);
except
@@ -857,7 +858,7 @@ function GetTaskBarSize: TRect;
end;
if Result = 0 then
begin
- ShortDateFormat := 'YY-MM-DD';
+ DefaultFormatSettings.ShortDateFormat := 'YY-MM-DD';
try
Result:= StrToDate(ns);
except
@@ -866,7 +867,7 @@ function GetTaskBarSize: TRect;
end;
if Result = 0 then
begin
- ShortDateFormat := 'YYYY-MM-DD';
+ DefaultFormatSettings.ShortDateFormat := 'YYYY-MM-DD';
try
Result:= StrToDate(ns);
except
@@ -875,7 +876,7 @@ function GetTaskBarSize: TRect;
end;
if Result = 0 then
begin
- ShortDateFormat := 'D-M-YY';
+ DefaultFormatSettings.ShortDateFormat := 'D-M-YY';
try
Result:= StrToDate(ns);
except
@@ -884,7 +885,7 @@ function GetTaskBarSize: TRect;
end;
if Result = 0 then
begin
- ShortDateFormat := 'M-D-YYYY';
+ DefaultFormatSettings.ShortDateFormat := 'M-D-YYYY';
try
Result:= StrToDate(ns);
except
@@ -893,7 +894,7 @@ function GetTaskBarSize: TRect;
end;
if Result = 0 then
begin
- ShortDateFormat := 'M-D-YY';
+ DefaultFormatSettings.ShortDateFormat := 'M-D-YY';
try
Result:= StrToDate(ns);
except
@@ -902,7 +903,7 @@ function GetTaskBarSize: TRect;
end;
if Result = 0 then
begin
- ShortDateFormat := 'YY-M-D';
+ DefaultFormatSettings.ShortDateFormat := 'YY-M-D';
try
Result:= StrToDate(ns);
except
@@ -911,7 +912,7 @@ function GetTaskBarSize: TRect;
end;
if Result = 0 then
begin
- ShortDateFormat := 'YYYY-M-D';
+ DefaultFormatSettings.ShortDateFormat := 'YYYY-M-D';
try
Result:= StrToDate(ns);
except
@@ -928,10 +929,10 @@ function GetTaskBarSize: TRect;
Function StringToTime(s : string) : TDateTime;
begin
- LongTimeFormat := 'hh:mm:ss';
- ShortDateFormat := 'DD-MM-YYY';
- DateSeparator := '-';
- TimeSeparator := ':';
+ DefaultFormatSettings.LongTimeFormat := 'hh:mm:ss';
+ DefaultFormatSettings.ShortDateFormat := 'DD-MM-YYY';
+ DefaultFormatSettings.DateSeparator := '-';
+ DefaultFormatSettings.TimeSeparator := ':';
try
Result:= StrToTime(s);
except
@@ -1028,7 +1029,7 @@ function GetTaskBarSize: TRect;
X1:= 0; X2:= 0; X3:= 0;
Di:= 4 * Power(-b*b + 3*a*c, 3) +
Power(-2 * Power(b, 3) + 9*a*b*c - 27*a*a*d, 2);
- if (Di > 0) and (a <> 0) and (E <> 0) then
+ if (Di > 0) and (a <> 0) then
begin
E:= Power(-2*b*b*b + 9*a*b*c - 27*a*a*d + SQRT(Di), 1/3);
X1:= -b/(3*a) - (Power(2, 1/3) * (-b*b+3*a*c)) / (3 * a * E)
@@ -1588,13 +1589,12 @@ function GetTaskBarSize: TRect;
{============================= Brewing functions ==============================}
Function CalcFrac(TpH, pK1, pK2, pK3 : double) : double;
-var r1d, r2d, r3d, dd, f1d, f2d, f3d, f4d : double;
+var r1d, r2d, r3d, dd, f2d, f3d, f4d : double;
begin
r1d:= Power(10, TpH - pK1);
r2d:= Power(10, TpH - pK2);
r3d:= Power(10, TpH - pK3);
dd:= 1/(1 + r1d + r1d*r2d + r1d*r2d*r3d);
- f1d:= dd;
f2d:= r1d*dd;
f3d:= r1d*r2d*dd;
f4d:= r1d*r2d*r3d*dd;
@@ -2191,11 +2191,8 @@ function GetTaskBarSize: TRect;
Function CalcIBU(Method : TIBUmethod; HopUse : THopUse; AA : Double; AM : Double; Vw : Double;
Vf : Double; SG : Double; Tboil : Double; HopVorm : THopForm;
BNAP : Double) : Double;
-var IBUi : Double;
- U : Double;
- a : Double;
- b : Double;
- c : Double;
+var IBUi, U : Double;
+ //a, b, c : Double;
begin
U:= 1;
if Vf > 0 then IBUi:= 10 * AM * AA / Vf
@@ -2290,7 +2287,7 @@ function GetTaskBarSize: TRect;
Zipper := TZipper.Create;
try
Zipper.FileName := zipfn;
- for I := 1 to l.Count - 1 do
+ for i := 1 to l.Count - 1 do
Zipper.Entries.AddFileEntry(l.Strings[i], zipfn);
Zipper.ZipAllFiles;
Result:= TRUE;
@@ -2301,8 +2298,8 @@ function GetTaskBarSize: TRect;
end;
Function UnZipFiles(zipfn, outpath : string) : boolean;
-var i : integer;
- Zipper: TUnZipper;
+var
+ Zipper: TUnZipper;
begin
Result:= false;
Zipper := TUnZipper.Create;
@@ -2332,7 +2329,9 @@ function GetTaskBarSize: TRect;
end;}
Procedure PlayStartProg;
+{$ifdef darwin}
var sound : TProcess;
+{$endif}
begin
// {$ifdef linux}
// AlSourcePlay(source[startprog]);
@@ -2351,7 +2350,9 @@ function GetTaskBarSize: TRect;
end;
Procedure PlayWarning;
+{$ifdef darwin}
var sound : TProcess;
+{$endif}
begin
// {$ifdef linux}
// AlSourcePlay(source[warning]);
@@ -2370,12 +2371,14 @@ function GetTaskBarSize: TRect;
end;
Procedure PlayAlarm;
+{$ifdef darwin}
var sound : TProcess;
+{$endif}
begin
// {$ifdef linux}
// AlSourcePlay(source[alarm]);
// {$endif}
- {$ifdef darwub}
+ {$ifdef darwin}
sound:= TProcess.Create(NIL);
sound.CommandLine:= 'afplay ' + StartSound;
sound.Execute;
@@ -2389,7 +2392,9 @@ function GetTaskBarSize: TRect;
end;
Procedure PlayEndProg;
+{$ifdef darwin}
var sound : TProcess;
+{$endif}
begin
// {$ifdef linux}
// AlSourcePlay(source[endprog]);
diff --git a/Source/Units/neuroot.pas b/Source/Units/neuroot.pas
index 607219c0..28e8e0cb 100644
--- a/Source/Units/neuroot.pas
+++ b/Source/Units/neuroot.pas
@@ -42,7 +42,7 @@ TBHNN = class(TObject)
Function GetActivationFunction : TActivationFunction;
public
Constructor Create;
- Destructor Destroy;
+ Destructor Destroy; override;
Procedure AddInputIndex(s : string);
Procedure AddOutputIndex(s : string);
Procedure ClearInputIndexs;
@@ -188,7 +188,7 @@ implementation
end;
Procedure TBHNN.SaveXML(Doc: TXMLDocument; iNode: TDOMNode);
-var i, j, n : integer;
+var j, n : integer;
iNN, iChild, iChild2 : TDOMNode;
begin
iNN:= Doc.CreateElement('NN');
@@ -232,7 +232,10 @@ implementation
Function ReadNode(iNode : TDomNode; FLabel : string) : string;
var
- v, encs, encto: string;
+ v: string;
+ {$ifdef WINDOWS}
+ encs, encto: string;
+ {$endif}
begin
Result:= '';
if FLabel <> '' then
@@ -275,7 +278,7 @@ implementation
end;
Procedure TBHNN.ReadXML(iNode: TDOMNode);
-var i, j, n : integer;
+var i, n : integer;
s : string;
iChild, iChild2 : TDOMNode;
x : double;
@@ -714,7 +717,7 @@ implementation
end;
Function TBHNN.CheckValidData(R : TRecipe) : boolean;
-var i, j : longint;
+var j : longint;
x, y : double;
begin
Result:= TRUE;
@@ -829,10 +832,10 @@ implementation
x : double;
progress, totmse : single;
tot : longint;
- valid : boolean;
begin
Result:= false;
Application.ProcessMessages;
+ SetLength(RA, 0);
try
if Perc < 50 then Perc:= 50;
if Perc > 100 then Perc:= 100;
@@ -861,7 +864,8 @@ implementation
SetLength(Outputs, High(FOutputIndexs) + 1);
//check if there is enough data to train the network
- if not CheckNumValidData(numvalid) then ShowNotification(Application, 'Niet genoeg brouwsels voor dit netwerk')
+ if not CheckNumValidData(numvalid) then
+ ShowNotification(Application, 'Niet genoeg brouwsels voor dit netwerk')
else
begin
tot:= NumRounds * j;
@@ -891,7 +895,8 @@ implementation
Application.ProcessMessages;
end;
Fmse:= totmse / j;
- if Assigned(FOnTrainRound) and valid then FOnTrainRound(self, Fmse, progress);
+ if Assigned(FOnTrainRound) then
+ FOnTrainRound(self, Fmse, progress);
Application.ProcessMessages;
Inc(k);
end;
@@ -900,7 +905,6 @@ implementation
SetLength(Inputs, 0);
SetLength(Outputs, 0);
SetLength(RA, 0);
-
Save;
FIsTrained:= TRUE;
if Assigned(FOnTrainReady) then FOnTrainReady(self, Fmse);
@@ -1030,10 +1034,10 @@ procedure AddNode(Doc: TXMLDocument; iNode: TDOMNode; Title: string; Value: stri
iChild, iTextNode: TDOMNode;
s: string;
begin
- iChild := Doc.CreateElement(Title);
+ iChild := Doc.CreateElement(Title{%H-});
s := ReplaceSpecialChars(Value);
s := SetDecimalPoint(s);
- iTextNode := Doc.CreateTextNode(s);
+ iTextNode := Doc.CreateTextNode(s{%H-});
iChild.AppendChild(iTextNode);
iNode.AppendChild(iChild);
end;
diff --git a/Source/Units/positieinterval.pas b/Source/Units/positieinterval.pas
index 92a9109c..06146f29 100644
--- a/Source/Units/positieinterval.pas
+++ b/Source/Units/positieinterval.pas
@@ -17,9 +17,7 @@ TPosInterval = class(TGraphicControl)
FInsideColor, FOutsideColor, FIntermediateColor : TColor;
FColorScale, FShowValues, FValuesInBar : boolean;
FDecimals : integer;
- { Private declarations }
protected
- { Protected declarations }
Procedure SetMin(V : double);
Procedure SetMax(V : double);
Procedure SetLow(V : double);
@@ -37,11 +35,9 @@ TPosInterval = class(TGraphicControl)
Procedure PaintLinux;
Procedure PaintWindows;
public
- { Public declarations }
Constructor Create(AOwner : TComponent); override;
procedure Paint; override;
published
- { Published declarations }
property Min : double read FMin write SetMin;
property Max: double read FMax write SetMax;
property Low : double read FLow write SetLow;
@@ -431,10 +427,11 @@ procedure GradHorizontal(Cnvs: TCanvas; Rect: TRect; FromColor, ToColor: TColor)
Procedure TPosInterval.PaintWindows;
var Rct, BarRect, MarkRect, PIRect : TRect;
TH, TW, BarW, pMin, pLow, pValue, pHigh, pMax, pTolerance, TextX, TextY : integer;
- OldFontColor, OldPenColor, OldBrushColor, ValueColor, LowColor, HighColor, MinColor, MaxColor : TColor;
+ OldFontColor, OldPenColor, OldBrushColor, ValueColor, LowColor, HighColor : TColor;
+ //MinColor, MaxColor : TColor;
MinC, MaxC : double;
valuestring : string;
- i, j, step : integer;
+ i, step : integer;
const Margin : integer = 5;
begin
OldPenColor:= Canvas.Pen.Color;
@@ -471,7 +468,6 @@ procedure GradHorizontal(Cnvs: TCanvas; Rect: TRect; FromColor, ToColor: TColor)
Rct.Top:= BarRect.Top;
Rct.Bottom:= BarRect.Bottom;
- j:= pMin;
if FColorScale then
begin
step:= round(BarW/20);
@@ -534,9 +530,8 @@ procedure GradHorizontal(Cnvs: TCanvas; Rect: TRect; FromColor, ToColor: TColor)
ValueColor:= Canvas.Pixels[pValue, round((BarRect.Bottom - BarRect.Top)/2 + BarRect.Top)];
LowColor:= Canvas.Pixels[pLow, round((BarRect.Bottom - BarRect.Top)/2 + BarRect.Top)];
HighColor:= Canvas.Pixels[pHigh, round((BarRect.Bottom - BarRect.Top)/2 + BarRect.Top)];
- MinColor:= Canvas.Pixels[pMin, round((BarRect.Bottom - BarRect.Top)/2 + BarRect.Top)];
- MaxColor:= Canvas.Pixels[pMax, round((BarRect.Bottom - BarRect.Top)/2 + BarRect.Top)];
-
+ //MinColor:= Canvas.Pixels[pMin, round((BarRect.Bottom - BarRect.Top)/2 + BarRect.Top)];
+ //MaxColor:= Canvas.Pixels[pMax, round((BarRect.Bottom - BarRect.Top)/2 + BarRect.Top)];
//Create Glassy effect
if FEffect = eGlassy then Glassify(Canvas, BarRect);
@@ -603,9 +598,10 @@ procedure GradHorizontal(Cnvs: TCanvas; Rect: TRect; FromColor, ToColor: TColor)
end;
Procedure TPosInterval.PaintLinux;
-var Rct, BarRect, MarkRect, PIRect : TRect;
+var Rct, BarRect, MarkRect : TRect;
TH, TW, BarW, pMin, pLow, pValue, pHigh, pMax, pTolerance, TextX, TextY : integer;
- OldFontColor, OldPenColor, OldBrushColor, ValueColor, LowColor, HighColor, MinColor, MaxColor : TColor;
+ OldFontColor, OldPenColor, OldBrushColor, ValueColor, LowColor, HighColor : TColor;
+ //MinColor, MaxColor : TColor;
MinC, MaxC : double;
valuestring : string;
Bmp : TBitmap;
@@ -712,9 +708,8 @@ procedure GradHorizontal(Cnvs: TCanvas; Rect: TRect; FromColor, ToColor: TColor)
ValueColor:= Bmp.Canvas.Pixels[pValue, round((BarRect.Bottom - BarRect.Top)/2 + BarRect.Top)];
LowColor:= Bmp.Canvas.Pixels[pLow, round((BarRect.Bottom - BarRect.Top)/2 + BarRect.Top)];
HighColor:= Bmp.Canvas.Pixels[pHigh, round((BarRect.Bottom - BarRect.Top)/2 + BarRect.Top)];
- MinColor:= Bmp.Canvas.Pixels[pMin, round((BarRect.Bottom - BarRect.Top)/2 + BarRect.Top)];
- MaxColor:= Bmp.Canvas.Pixels[pMax, round((BarRect.Bottom - BarRect.Top)/2 + BarRect.Top)];
-
+ //MinColor:= Bmp.Canvas.Pixels[pMin, round((BarRect.Bottom - BarRect.Top)/2 + BarRect.Top)];
+ //MaxColor:= Bmp.Canvas.Pixels[pMax, round((BarRect.Bottom - BarRect.Top)/2 + BarRect.Top)];
//Create Glassy effect
if FEffect = eGlassy then Glassify(Bmp.Canvas, BarRect);
@@ -796,4 +791,4 @@ procedure GradHorizontal(Cnvs: TCanvas; Rect: TRect; FromColor, ToColor: TColor)
end;
end.
-
\ No newline at end of file
+
diff --git a/Source/Units/promashimport.pas b/Source/Units/promashimport.pas
index a6c40c84..8c9384f3 100644
--- a/Source/Units/promashimport.pas
+++ b/Source/Units/promashimport.pas
@@ -569,7 +569,6 @@ implementation
Function ReadANSIString(FS : TFileStream; i : integer) : string;
var S : ansistring;
j : integer;
- Buffer : array of byte;
begin
SetLength(S, i);
for j:= 1 to i do
@@ -583,7 +582,6 @@ implementation
Function ReadString(FS : TFileStream; i : integer) : string;
var S : string;
j : integer;
- Buffer : array of byte;
begin
SetLength(S, i);
for j:= 1 to i do
@@ -708,7 +706,6 @@ implementation
end;
Procedure TPromash.Clear;
-var i : longint;
begin
FOpened:= false;
FFileName := '';
@@ -814,14 +811,11 @@ implementation
end;
Function IsPromashFile(FN : string) : boolean;
-var i : longint;
- FS : TFileStream;
- b : byte;
- chunksize, sk : longword;
- x : single;
- s, name : string;
- li, hopcount, maltcount, extracount, boiltime : LongInt;
- batchsize, wortsize, efficiency : single;
+var FS : TFileStream;
+ //x : single;
+ s : string;
+ li, hopcount, maltcount, extracount{, boiltime} : LongInt;
+ //batchsize, wortsize, efficiency : single;
begin
Result:= false;
if FileExists(FN) { *Converted from FileExists* } then
@@ -832,7 +826,6 @@ implementation
//Recipe Chunk
s:= ReadString(FS, 83);
s:= ConvertStringEnc(s);
- Name:= s;
li:= ReadLongInt(FS);
HopCount:= li;
li:= ReadLongInt(FS);
@@ -866,7 +859,6 @@ implementation
Function TPromash.OpenReadRec(FN : string) : boolean;
var i : longint;
FS : TFileStream;
- b : byte;
chunksize, sk : longword;
x : single;
s : string;
@@ -1308,7 +1300,7 @@ implementation
end;
Function TPromash.GetMaltYield(i : integer) : single; //in % !!!
-var s : single;
+//var s : single;
begin
if (i >= Low(FMalts)) and (i <= High(FMalts)) then
begin
diff --git a/Source/Units/rcstrngs.pas b/Source/Units/rcstrngs.pas
index c3f838a0..17a856c2 100644
--- a/Source/Units/rcstrngs.pas
+++ b/Source/Units/rcstrngs.pas
@@ -1,4 +1,4 @@
-unit rcstrngs;
+unit RcStrngs;
{$mode objfpc}{$H+}
diff --git a/Source/Units/subs.pas b/Source/Units/subs.pas
index f04a84a1..029eff68 100644
--- a/Source/Units/subs.pas
+++ b/Source/Units/subs.pas
@@ -87,6 +87,7 @@ implementation
Doc : TXMLDocument;
i : longint;
begin
+ Result:= True;
if NumItems > 0 then
begin
try
@@ -116,6 +117,7 @@ implementation
RootNode, Child : TDOMNode;
Doc : TXMLDocument;
begin
+ Result:= True;
RootNode:= NIL;
Doc:= NIL;
try
@@ -354,6 +356,7 @@ implementation
Doc : TXMLDocument;
i : longint;
begin
+ Result:= True;
if NumItems > 0 then
begin
try
@@ -385,6 +388,7 @@ implementation
RootNode, Child : TDOMNode;
Doc : TXMLDocument;
begin
+ Result:= True;
RootNode:= NIL;
Doc:= NIL;
try
diff --git a/Source/Units/timeedit.pp b/Source/Units/timeedit.pp
index e77f851e..e355816f 100644
--- a/Source/Units/timeedit.pp
+++ b/Source/Units/timeedit.pp
@@ -52,7 +52,7 @@
- Make it an installable Lazarus package, so it can be put on a form in design time
}
-unit timeedit;
+unit TimeEdit;
{$mode objfpc}{$H+}
@@ -62,13 +62,9 @@ interface
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
ExtCtrls, Clipbrd, LCLType, LCLProc, MaskEdit, ComCtrls;
-
-
-
type
TTimeEditFormat = (tefLong, tefShort);
-
type
{ TCustomTimeEdit }
@@ -386,8 +382,9 @@ procedure TCustomTimeEdit.ForceValidTime;
SH := IntToStr(H);
SM := IntToStr(M);
SS := IntToStr(Sec);
- ET := ZeroPad2(SH) + TimeSeparator + ZeroPad2(SM);
- if (FTimeEditFormat = tefLong) then ET := ET + TimeSeparator + ZeroPad2(SS);
+ ET := ZeroPad2(SH) + DefaultFormatSettings.TimeSeparator + ZeroPad2(SM);
+ if FTimeEditFormat = tefLong then
+ ET := ET + DefaultFormatSettings.TimeSeparator + ZeroPad2(SS);
//debugln(' Resetting EditText to ',ET);
EditText := ET;
end;
@@ -426,8 +423,9 @@ procedure TCustomTimeEdit.SetTime(const ATime: TDateTime);
SH := IntToStr(H);
SM := IntToStr(M);
SS := IntToStr(Sec);
- ET := ZeroPad2(SH) + TimeSeparator + ZeroPad2(SM);
- if (FTimeEditFormat = tefLong) then ET := ET + TimeSeparator + ZeroPad2(SS);
+ ET := ZeroPad2(SH) + DefaultFormatSettings.TimeSeparator + ZeroPad2(SM);
+ if FTimeEditFormat = tefLong then
+ ET := ET + DefaultFormatSettings.TimeSeparator + ZeroPad2(SS);
EditText := ET;
end;
diff --git a/Source/UserInterface/Forms/fdatabaselocation.pas b/Source/UserInterface/Forms/fdatabaselocation.pas
index 2a8be8f2..bc28848f 100644
--- a/Source/UserInterface/Forms/fdatabaselocation.pas
+++ b/Source/UserInterface/Forms/fdatabaselocation.pas
@@ -1,4 +1,4 @@
-unit fdatabaselocation;
+unit FDatabaseLocation;
{$mode objfpc}{$H+}
@@ -23,10 +23,8 @@ TFrmDatabaseLocation = class(TForm)
procedure deSettingsChange(Sender: TObject);
procedure cbRemoveClick(Sender: TObject);
private
- { private declarations }
FOldDir, FNewDir : string;
public
- { public declarations }
Function Execute : boolean;
end;
@@ -39,7 +37,7 @@ implementation
uses Data, Containers, frmain, Hulpfuncties, subs, neuroot;
procedure TFrmDatabaseLocation.deSettingsChange(Sender: TObject);
-var StylesN, FermN, HopN, MiscN, YeastN, WaterN : string;
+//var StylesN, FermN, HopN, MiscN, YeastN, WaterN : string;
begin
{ //Check if there are files in the chosen directory
FNewDir:= deSettings.Directory;
diff --git a/Source/UserInterface/Forms/fradjustto100.pas b/Source/UserInterface/Forms/fradjustto100.pas
index edfbb6a0..65e7a11a 100644
--- a/Source/UserInterface/Forms/fradjustto100.pas
+++ b/Source/UserInterface/Forms/fradjustto100.pas
@@ -1,4 +1,4 @@
-unit fradjustto100;
+unit FrAdjustTo100;
{$mode objfpc}{$H+}
@@ -18,9 +18,8 @@ TfrmAdjustTotalTo100 = class(TForm)
Label1: TLabel;
procedure cbBasemaltsClickCheck(Sender: TObject);
private
- { private declarations }
+
public
- { public declarations }
Function Execute(Rec : TRecipe) : boolean;
end;
diff --git a/Source/UserInterface/Forms/franalysis.pas b/Source/UserInterface/Forms/franalysis.pas
index b4e6a217..e8641a02 100644
--- a/Source/UserInterface/Forms/franalysis.pas
+++ b/Source/UserInterface/Forms/franalysis.pas
@@ -1,4 +1,4 @@
-unit franalysis;
+unit FrAnalysis;
{$mode objfpc}{$H+}
@@ -65,12 +65,10 @@ TFrmAnalysis = class(TForm)
procedure tbCopyToClipboardClick(Sender: TObject);
procedure tbPrintClick(Sender: TObject);
private
- { private declarations }
FX, FY : longint;
Procedure FillChart;
Function CalcRSquare : double;
public
- { public declarations }
Function Execute : boolean;
end;
@@ -80,16 +78,15 @@ TFrmAnalysis = class(TForm)
implementation
{$R *.lfm}
-uses Data, Containers, LCLType, Math, TAChartAxis, TAChartUtils, TACustomSource,
- TADrawerSVG, TADrawUtils, TADrawerCanvas, OSPrinters, TAPrint, Printers,
- hulpfuncties;
+uses Data, Containers, LCLType, Math, TAChartAxis, TAChartUtils,
+ TADrawerSVG, TADrawUtils, TADrawerCanvas, OSPrinters, TAPrint, Printers;
{ TFrmAnalysis }
procedure TFrmAnalysis.FormCreate(Sender: TObject);
var i, j : LongInt;
R : TRecipe;
- E : TEquipment;
+ //E : TEquipment;
s : string;
found : boolean;
begin
@@ -331,7 +328,7 @@ procedure TFrmAnalysis.FitSeriesFitComplete(Sender: TObject);
end;
Procedure TFrmAnalysis.FillChart;
-var i, XC, YC : longint;
+var i : longint;
x, y : double;
R : TRecipe;
s : string;
diff --git a/Source/UserInterface/Forms/frbeerstyles.pas b/Source/UserInterface/Forms/frbeerstyles.pas
index c3caa84b..3057f848 100644
--- a/Source/UserInterface/Forms/frbeerstyles.pas
+++ b/Source/UserInterface/Forms/frbeerstyles.pas
@@ -96,20 +96,18 @@ TFrmBeerstyles = class(TForm)
procedure fseIBUMinChange(Sender: TObject);
procedure fseOGMaxChange(Sender: TObject);
procedure fseOGMinChange(Sender: TObject);
- procedure tvSelectKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
- );
+ procedure tvSelectKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure tvSelectSelectionChanged(Sender: TObject);
procedure eNameChange(Sender: TObject);
procedure eStyleLetterExit(Sender: TObject);
procedure bbImportClick(Sender: TObject);
private
- { private declarations }
FSelectedNode : TTreeNode;
FUserClicked, FMustStore : boolean;
Procedure Store;
Procedure FillTree;
public
- { public declarations }
+
end;
var
@@ -191,7 +189,7 @@ procedure TFrmBeerstyles.FormCreate(Sender: TObject);
var i : integer;
letter, sname : string;
S : TBeerStyle;
- Node, ChildNode, ChildNode2 : TTreeNode;
+ Node, ChildNode, {%H-}ChildNode2 : TTreeNode;
begin
FUserClicked:= false;
tvSelect.Items.Clear;
diff --git a/Source/UserInterface/Forms/frboilmethod.pas b/Source/UserInterface/Forms/frboilmethod.pas
index 59dc4f4c..59c380db 100644
--- a/Source/UserInterface/Forms/frboilmethod.pas
+++ b/Source/UserInterface/Forms/frboilmethod.pas
@@ -1,4 +1,4 @@
-unit frboilmethod;
+unit FrBoilMethod;
{$mode objfpc}{$H+}
@@ -28,9 +28,9 @@ TFrmBoilMethod = class(TForm)
procedure fseSGafterChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
- { private declarations }
+
public
- { public declarations }
+
end;
var
diff --git a/Source/UserInterface/Forms/frchecklist.pas b/Source/UserInterface/Forms/frchecklist.pas
index c16823d7..1e871f28 100644
--- a/Source/UserInterface/Forms/frchecklist.pas
+++ b/Source/UserInterface/Forms/frchecklist.pas
@@ -1,4 +1,4 @@
-unit frchecklist;
+unit FrCheckList;
{$mode objfpc}{$H+}
@@ -23,13 +23,11 @@ TFrmChecklist = class(TForm)
procedure FormDestroy(Sender: TObject);
procedure FormHide(Sender: TObject);
private
- { private declarations }
CLGroups : array of TCheckGroup;
FRecipe : TRecipe;
Procedure PlaceWindow;
Procedure ClearAll;
public
- { public declarations }
Function Execute(R : TRecipe) : boolean;
end;
@@ -89,7 +87,7 @@ procedure TFrmChecklist.FormHide(Sender: TObject);
Procedure TFrmCheckList.PlaceWindow;
var ScreenBounds: TRect;
- tp, l, h : integer;
+ {tp,} l, h : integer;
const
{$ifdef windows}
PanelH = 80;
@@ -103,7 +101,7 @@ procedure TFrmChecklist.FormHide(Sender: TObject);
if FOptions = 0 then
begin
ScreenBounds := Screen.MonitorFromWindow(WindowHandle).BoundsRect;
- tp:= ScreenBounds.Top + round(0.5 * (Screenbounds.Bottom - Screenbounds.Top) - 0.5 * Height);
+ //tp:= ScreenBounds.Top + round(0.5 * (Screenbounds.Bottom - Screenbounds.Top) - 0.5 * Height);
FrmMain.SetBounds(0, FrmMain.Top, FrmMain.Width, FrmMain.Height);
l:= FrmMain.Left + FrmMain.Width + FMargin;
h:= ScreenBounds.Bottom - ScreenBounds.Top - PanelH;
@@ -130,9 +128,9 @@ procedure TFrmChecklist.FormHide(Sender: TObject);
CLI : TCheckListItem;
s : string;
begin
+ Result:= True;
Width:= 422;
PlaceWindow;
-
ClearAll;
if (R <> NIL) and (R.CheckList <> NIL) and (R.CheckList.NumItems > 0) then
begin
diff --git a/Source/UserInterface/Forms/frchoosebeerstyle.pas b/Source/UserInterface/Forms/frchoosebeerstyle.pas
index 464e789a..6af27bce 100644
--- a/Source/UserInterface/Forms/frchoosebeerstyle.pas
+++ b/Source/UserInterface/Forms/frchoosebeerstyle.pas
@@ -1,4 +1,4 @@
-unit frchoosebeerstyle;
+unit FrChooseBeerStyle;
{$mode objfpc}{$H+}
@@ -17,9 +17,8 @@ TFrmChooseBeerstyle = class(TForm)
bbOK: TBitBtn;
bbCancel: TBitBtn;
private
- { private declarations }
+
public
- { public declarations }
Function Execute : TBeerStyle;
end;
diff --git a/Source/UserInterface/Forms/frchoosebrews.pas b/Source/UserInterface/Forms/frchoosebrews.pas
index 94d3e93c..367dafde 100644
--- a/Source/UserInterface/Forms/frchoosebrews.pas
+++ b/Source/UserInterface/Forms/frchoosebrews.pas
@@ -1,4 +1,4 @@
-unit frchoosebrews;
+unit FrChoosebrews;
{$mode objfpc}{$H+}
@@ -31,13 +31,11 @@ TfrmChooseBrewsList = class(TForm)
procedure cbStartChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
- { private declarations }
Function GetStartDate : TDateTime;
Function GetEndDate : TDateTime;
Function GetStartNr : string;
Function GetEndNR : string;
public
- { public declarations }
Function Execute : integer;
published
property StartDate : TDateTime read GetStartDate;
diff --git a/Source/UserInterface/Forms/frchoosebrewschars.pas b/Source/UserInterface/Forms/frchoosebrewschars.pas
index 0b9b7f56..c0f5e04c 100644
--- a/Source/UserInterface/Forms/frchoosebrewschars.pas
+++ b/Source/UserInterface/Forms/frchoosebrewschars.pas
@@ -1,4 +1,4 @@
-unit frchoosebrewschars;
+unit FrChooseBrewsChars;
{$mode objfpc}{$H+}
@@ -28,7 +28,6 @@ TFrmChooseBrewChars = class(TForm)
bbCancel: TBitBtn;
procedure FormCreate(Sender: TObject);
private
- { private declarations }
Function GetNrRecipe : string;
Function GetName : string;
Function GetBeerStyle : TBeerStyle;
@@ -36,7 +35,6 @@ TFrmChooseBrewChars = class(TForm)
Function GetEquipment : TEquipment;
Function GetBrewDate : TDateTime;
public
- { public declarations }
Function Execute(brew : boolean) : boolean;
published
property NrRecipe : string read GetNrRecipe;
diff --git a/Source/UserInterface/Forms/frdividebrew.pas b/Source/UserInterface/Forms/frdividebrew.pas
index a4a15f47..64510768 100644
--- a/Source/UserInterface/Forms/frdividebrew.pas
+++ b/Source/UserInterface/Forms/frdividebrew.pas
@@ -1,4 +1,4 @@
-unit frdividebrew;
+unit FrDivideBrew;
{$mode objfpc}{$H+}
@@ -19,10 +19,8 @@ TFrmDivideBrew = class(TForm)
Label1: TLabel;
seNumBatches: TSpinEdit;
private
- { private declarations }
Function GetNumBatches : word;
public
- { public declarations }
Function Execute : integer;
published
property NumBatches : word read GetNumBatches;
diff --git a/Source/UserInterface/Forms/frdownloadprogress.pas b/Source/UserInterface/Forms/frdownloadprogress.pas
index 129e454f..e9140cf1 100644
--- a/Source/UserInterface/Forms/frdownloadprogress.pas
+++ b/Source/UserInterface/Forms/frdownloadprogress.pas
@@ -1,4 +1,4 @@
-unit frdownloadprogress;
+unit FrDownloadProgress;
{$mode objfpc}{$H+}
@@ -15,12 +15,10 @@ TFrmDownloadProgress = class(TForm)
ProgressBar1: TProgressBar;
procedure FormCreate(Sender: TObject);
private
- { private declarations }
FProgress, FMax : integer;
procedure SetProgress(l : integer);
Procedure SetMaxValue(l : integer);
public
- { public declarations }
procedure OnMonitor(Sender: TObject; Writing: Boolean;
const Buffer: TMemory; Len: Integer);
published
diff --git a/Source/UserInterface/Forms/frequipments.pas b/Source/UserInterface/Forms/frequipments.pas
index e250904b..e3fe1269 100644
--- a/Source/UserInterface/Forms/frequipments.pas
+++ b/Source/UserInterface/Forms/frequipments.pas
@@ -97,19 +97,17 @@ TFrmEquipments = class(TForm)
procedure fseBatchSizeChange(Sender: TObject);
procedure fseMashVolumeChange(Sender: TObject);
procedure fseTunVolumeChange(Sender: TObject);
- procedure tvSelectKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
- );
+ procedure tvSelectKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure tvSelectSelectionChanged(Sender: TObject);
procedure fseBoilSizeChange(Sender: TObject);
procedure fseEvapRateChange(Sender: TObject);
private
- { private declarations }
FSelectedNode : TTreeNode;
FNew : boolean;
FUserClicked : boolean;
Procedure Store;
public
- { public declarations }
+
end;
var
@@ -126,7 +124,7 @@ procedure TFrmEquipments.FormCreate(Sender: TObject);
var i : integer;
mname : string;
E : TEquipment;
- Node, ChildNode: TTreeNode;
+ Node, {%H-}ChildNode: TTreeNode;
begin
FUserClicked:= TRUE;
Equipments.UnSelect;
diff --git a/Source/UserInterface/Forms/frfermentables.pas b/Source/UserInterface/Forms/frfermentables.pas
index 915fe7b8..d5f827b4 100644
--- a/Source/UserInterface/Forms/frfermentables.pas
+++ b/Source/UserInterface/Forms/frfermentables.pas
@@ -110,21 +110,19 @@ TFrmFermentables = class(TForm)
procedure fseInventoryChange(Sender: TObject);
procedure fseYieldChange(Sender: TObject);
procedure sbClearClick(Sender: TObject);
- procedure tvSelectKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
- );
+ procedure tvSelectKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure tvSelectSelectionChanged(Sender: TObject);
procedure eSupplierExit(Sender: TObject);
procedure bbImportClick(Sender: TObject);
procedure bbCopyClick(Sender: TObject);
private
- { private declarations }
FSelectedNode : TTreeNode;
FUserClicked : boolean;
Procedure Store;
Procedure FillTree;
Procedure UpdateAmoebe;
public
- { public declarations }
+
end;
var
@@ -205,7 +203,7 @@ procedure TFrmFermentables.FormCreate(Sender: TObject);
var i : integer;
supp, fname : string;
F : TFermentable;
- Node, ChildNode, ChildNode2 : TTreeNode;
+ Node, ChildNode, {%H-}ChildNode2 : TTreeNode;
begin
tvSelect.Items.Clear;
Node:= tvSelect.Items.Add(nil,'Fabrikant');
@@ -474,7 +472,7 @@ procedure TFrmFermentables.bbAddClick(Sender: TObject);
procedure TFrmFermentables.bbDeleteClick(Sender: TObject);
var Ferm : TFermentable;
- Node, ChildNode, Node2 : TTreeNode;
+ Node, ChildNode{, Node2} : TTreeNode;
begin
FUserClicked:= false;
Node:= tvSelect.Selected;
@@ -567,8 +565,7 @@ procedure TFrmFermentables.cbTypeChange(Sender: TObject);
end;
procedure TFrmFermentables.eSearchChange(Sender: TObject);
-var i : integer;
- N : TTreeNode;
+var N : TTreeNode;
Ferm : TFermentable;
s, s2 : string;
Vis : boolean;
diff --git a/Source/UserInterface/Forms/frfermentables2.pas b/Source/UserInterface/Forms/frfermentables2.pas
index b39e8ad2..3790e331 100644
--- a/Source/UserInterface/Forms/frfermentables2.pas
+++ b/Source/UserInterface/Forms/frfermentables2.pas
@@ -86,7 +86,6 @@ TFrmFermentables2 = class(TForm)
procedure FormDestroy(Sender: TObject);
procedure cbFlexibleChange(Sender: TObject);
private
- { private declarations }
FFermentable, FOriginal, FChosen : TFermentable;
FTotal : double;
FRec : TRecipe;
@@ -97,7 +96,6 @@ TFrmFermentables2 = class(TForm)
procedure FillcbName;
Function InRecipe(F : TFermentable) : boolean;
public
- { public declarations }
Function Execute(F : TFermentable; perc : boolean; tot : double) : boolean;
end;
@@ -221,9 +219,6 @@ procedure TFrmFermentables2.FillcbName;
end;
Function TFrmFermentables2.Execute(F : TFermentable; perc : boolean; tot : double) : boolean;
-var i : integer;
- s : string;
- Fr : TFermentable;
begin
FRec:= F.Recipe;
FFermentable:= F;
diff --git a/Source/UserInterface/Forms/frfermentables3.pas b/Source/UserInterface/Forms/frfermentables3.pas
index 609d2d52..867555c5 100644
--- a/Source/UserInterface/Forms/frfermentables3.pas
+++ b/Source/UserInterface/Forms/frfermentables3.pas
@@ -1,4 +1,4 @@
-unit frfermentables3;
+unit FrFermentables3;
{$mode objfpc}{$H+}
@@ -43,7 +43,6 @@ TFrmFermentables3 = class(TForm)
procedure cbFlexibleChange(Sender: TObject);
Procedure BitBtn1Click(Sender : TObject);
private
- { private declarations }
Ftot : double;
FFerm : TFermentable;
FSort : integer;
@@ -53,7 +52,6 @@ TFrmFermentables3 = class(TForm)
Procedure SortGrid(Nr1, Nr2 : integer);
Function InRecipe(F : TFermentable) : boolean;
public
- { public declarations }
Function Execute(const F : TFermentable; prc : boolean) : boolean;
end;
diff --git a/Source/UserInterface/Forms/frgetpasswd.pas b/Source/UserInterface/Forms/frgetpasswd.pas
index 109b9b55..ac0e8822 100644
--- a/Source/UserInterface/Forms/frgetpasswd.pas
+++ b/Source/UserInterface/Forms/frgetpasswd.pas
@@ -1,4 +1,4 @@
-unit frgetpasswd;
+unit FrGetPasswd;
{$mode objfpc}{$H+}
@@ -19,9 +19,8 @@ TfrmGetPasswd = class(TForm)
mePasswd: TMaskEdit;
procedure FormCreate(Sender: TObject);
private
- { private declarations }
+
public
- { public declarations }
Function GetAnswer : string;
end;
diff --git a/Source/UserInterface/Forms/frgetstring.pas b/Source/UserInterface/Forms/frgetstring.pas
index f7a2f2c6..41f3594a 100644
--- a/Source/UserInterface/Forms/frgetstring.pas
+++ b/Source/UserInterface/Forms/frgetstring.pas
@@ -1,4 +1,4 @@
-unit frgetstring;
+unit FrGetString;
{$mode objfpc}{$H+}
@@ -18,9 +18,8 @@ TFrmGetString = class(TForm)
leAnswer: TLabeledEdit;
procedure FormCreate(Sender: TObject);
private
- { private declarations }
+
public
- { public declarations }
Function GetAnswer(Q : string) : string;
end;
diff --git a/Source/UserInterface/Forms/frgristwizard.pas b/Source/UserInterface/Forms/frgristwizard.pas
index 72349d90..9e06d7c7 100644
--- a/Source/UserInterface/Forms/frgristwizard.pas
+++ b/Source/UserInterface/Forms/frgristwizard.pas
@@ -1,4 +1,4 @@
-unit frgristwizard;
+unit FrGristWizard;
{$mode objfpc}{$H+}
@@ -95,9 +95,8 @@ TFrmGristWizard = class(TForm)
procedure sgSugarSelectEditor(Sender: TObject; aCol, aRow: Integer;
var Editor: TWinControl);
private
- { private declarations }
FRec : TRecipe;
- FUserClicked, FSortGrid : boolean;
+ FUserClicked : boolean;
FSelFerm : TFermentable;
FSelGrid : integer;
FIGSCYBase, FIGSCYSpecialty, FIGSCYSugar : integer;
@@ -106,7 +105,7 @@ TFrmGristWizard = class(TForm)
FScrollBars : array of TScrollRec;
piSG, piColor, piAlcohol : TPosInterval;
Procedure FillGrids;
- Procedure Update;
+ Procedure Update; reintroduce;
Procedure ChangeOG;
Function FindMaltScrollBar : TScrollBar;
Function FindScrollBar(sg : TStringGrid; aCol, aRow : integer) : TScrollBar;
@@ -120,7 +119,6 @@ TFrmGristWizard = class(TForm)
procedure sbScrollbarsChange(Sender: TObject);
procedure cbScrollbarsChange(Sender: TObject);
public
- { public declarations }
Function Execute(R : TRecipe) : boolean;
end;
@@ -454,8 +452,6 @@ procedure TFrmGristWizard.FormDestroy(Sender: TObject);
perc, n, ni, totbase, totspec, totsug, percvar, maxperc : double;
variableset, allsugarslocked, allspecialtylocked : boolean;
sb : TScrollBar;
- cb : TCheckBox;
- Rect : TRect;
St : TBeerStyle;
begin
FUserClicked:= false;
@@ -891,16 +887,14 @@ procedure TFrmGristWizard.sbSGChange(Sender: TObject);
procedure TFrmGristWizard.sbScrollbarsChange(Sender: TObject);
var sb : TScrollBar;
- i, spos, n : integer;
- totperc, delta : double;
+ i, n : integer;
+ {totperc,} delta : double;
F : TFermentable;
begin
if (FSelFerm <> NIL) and FUserClicked then
begin
FUserClicked:= false;
-
sb:= TScrollBar(sender);
- spos:= sb.Position;
FSelFerm:= FindFermentable(sb);
if FSelFerm <> NIL then
begin
@@ -920,7 +914,7 @@ procedure TFrmGristWizard.sbScrollbarsChange(Sender: TObject);
F:= FRec.SpecialtyMalt[i];
if (not F.LockPercentage) then Inc(n);
end;
- totperc:= sbSpecialty.Position / 10;
+ //totperc:= sbSpecialty.Position / 10;
delta:= FSelFerm.Percentage.Value - sb.Position / 10;
if n > 1 then delta:= delta / (n - 1);
for i:= 0 to FRec.NumSpecialtyMalts - 1 do
@@ -950,7 +944,7 @@ procedure TFrmGristWizard.sbScrollbarsChange(Sender: TObject);
F:= FRec.Sugar[i];
if (not F.LockPercentage) then Inc(n);
end;
- totperc:= sbSugars.Position / 10;
+ //totperc:= sbSugars.Position / 10;
delta:= FSelFerm.Percentage.Value - sb.Position / 10;
if n > 1 then delta:= delta / (n - 1);
for i:= 0 to FRec.NumSugars - 1 do
@@ -1504,8 +1498,6 @@ procedure TFrmGristWizard.bbAddFermentableClick(Sender: TObject);
i, j : integer;
prca : array of double;
v, vr : double;
- g : TStringGrid;
- sb : TScrollBar;
begin
try
if FRec <> NIL then
diff --git a/Source/UserInterface/Forms/frhistogram.pas b/Source/UserInterface/Forms/frhistogram.pas
index c176c443..e523ba0f 100644
--- a/Source/UserInterface/Forms/frhistogram.pas
+++ b/Source/UserInterface/Forms/frhistogram.pas
@@ -1,4 +1,4 @@
-unit frhistogram;
+unit FrHistogram;
{$mode objfpc}{$H+}
@@ -55,13 +55,11 @@ TFrmHistogram = class(TForm)
procedure tbCopyToClipboardClick(Sender: TObject);
procedure tbPrintClick(Sender: TObject);
private
- { private declarations }
FX : LongInt;
FMarkList : TStringList;
FHistArr : array of THistRecs;
Procedure FillChart;
public
- { public declarations }
Function Execute : boolean;
end;
@@ -131,8 +129,8 @@ procedure TFrmHistogram.cbPercentagesChange(Sender: TObject);
end;
Procedure TFrmHistogram.FillChart;
-var i, j, XC, tot : longint;
- x, y, xmin, xmax : double;
+var i, j, tot : longint;
+ x, {y,} xmin, xmax : double;
R : TRecipe;
s : string;
nbars : integer;
@@ -153,7 +151,7 @@ procedure TFrmHistogram.cbPercentagesChange(Sender: TObject);
begin
if i = 0 then DataSeries.Title:= R.GetNumberNameByIndex(FX+1);
x := R.GetNumberByIndex(FX+1);
- if ((x > -99) and (y > -99)) then
+ if (x > -99) {and (y > -99)} then
begin
xmin:= MinD(x, xmin);
xmax:= MaxD(x, xmax);
diff --git a/Source/UserInterface/Forms/frhop.pas b/Source/UserInterface/Forms/frhop.pas
index f46c63a4..83abb6bb 100644
--- a/Source/UserInterface/Forms/frhop.pas
+++ b/Source/UserInterface/Forms/frhop.pas
@@ -98,15 +98,13 @@ TFrmHop = class(TForm)
procedure fseCohumuloneChange(Sender: TObject);
procedure fseCostChange(Sender: TObject);
procedure sbClearClick(Sender: TObject);
- procedure tvSelectKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
- );
+ procedure tvSelectKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure tvSelectSelectionChanged(Sender: TObject);
procedure fseInventoryChange(Sender: TObject);
procedure eOriginExit(Sender: TObject);
procedure bbImportClick(Sender: TObject);
procedure bbCopyClick(Sender: TObject);
private
- { private declarations }
FNew : boolean;
FSelectedNode : TTreeNode;
FUserClicked : boolean;
@@ -114,7 +112,7 @@ TFrmHop = class(TForm)
Procedure FillTree;
Procedure UpdateAmoebe;
public
- { public declarations }
+
end;
var
@@ -187,7 +185,7 @@ procedure TFrmHop.FormCreate(Sender: TObject);
var i : integer;
H : THop;
s : string;
- Node, ChildNode, ChildNode2 : TTreeNode;
+ Node, ChildNode, {%H-}ChildNode2 : TTreeNode;
begin
tvSelect.Items.Clear;
Node:= tvSelect.Items.Add(nil,'Herkomst');
@@ -492,8 +490,7 @@ procedure TFrmHop.sbClearClick(Sender: TObject);
end;
procedure TFrmHop.eSearchChange(Sender: TObject);
-var i : integer;
- N : TTreeNode;
+var N : TTreeNode;
H : THop;
s, s2 : string;
Vis : boolean;
diff --git a/Source/UserInterface/Forms/frhop2.pas b/Source/UserInterface/Forms/frhop2.pas
index 68d77ab8..277c7320 100644
--- a/Source/UserInterface/Forms/frhop2.pas
+++ b/Source/UserInterface/Forms/frhop2.pas
@@ -85,14 +85,12 @@ TFrmHop2 = class(TForm)
procedure fseAlfaChange(Sender: TObject);
procedure cbFormChange(Sender: TObject);
private
- { private declarations }
FHop, FOriginal, FChosen : THop;
FCh, FUserClicked : boolean;
Function GetHopUse : THopUse;
Procedure SetControls;
Procedure FillcbName;
public
- { public declarations }
Function Execute(H : THop) : boolean;
end;
@@ -217,9 +215,6 @@ procedure TFrmHop2.FillcbName;
Function TFrmHop2.Execute(H : THop) : boolean;
var R : TRecipe;
- s : string;
- Ho : THop;
- i : integer;
hu : THopUse;
begin
Result:= false;
diff --git a/Source/UserInterface/Forms/frhop3.pas b/Source/UserInterface/Forms/frhop3.pas
index 0f3dd027..85092d13 100644
--- a/Source/UserInterface/Forms/frhop3.pas
+++ b/Source/UserInterface/Forms/frhop3.pas
@@ -1,4 +1,4 @@
-unit frhop3;
+unit FrHop3;
{$mode objfpc}{$H+}
@@ -44,7 +44,6 @@ TFrmHop3 = class(TForm)
procedure eSearchChange(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
private
- { private declarations }
FHop : THop;
FSort : integer;
FSortDec : boolean;
@@ -52,7 +51,6 @@ TFrmHop3 = class(TForm)
FHopList : array of THop;
Procedure SortGrid(Nr1, Nr2 : integer);
public
- { public declarations }
Function Execute(H : THop) : boolean;
end;
diff --git a/Source/UserInterface/Forms/frhopgraph.pas b/Source/UserInterface/Forms/frhopgraph.pas
index 166b3905..508a34c7 100644
--- a/Source/UserInterface/Forms/frhopgraph.pas
+++ b/Source/UserInterface/Forms/frhopgraph.pas
@@ -1,4 +1,4 @@
-unit frhopgraph;
+unit FrHopGraph;
{$mode objfpc}{$H+}
@@ -30,11 +30,9 @@ TFrmHopGraph = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
- { private declarations }
FGraphType : longint;
procedure FillGraph;
public
- { public declarations }
Function Execute(i : longint) : boolean;
end;
@@ -156,7 +154,7 @@ procedure TFrmHopGraph.FormDestroy(Sender: TObject);
begin
lcsData.Clear;
n:= 0;
-
+ SetLength(HRArr, 0);
case FGraphType of
0:
begin
@@ -357,13 +355,13 @@ procedure TFrmHopGraph.cbPropertiesChange(Sender: TObject);
procedure TFrmHopGraph.ChartToolset1DataPointCrosshairTool1AfterMouseMove(
ATool: TChartTool; APoint: TPoint);
var i : longint;
- Xv, Yv : double;
+ {Xv,} Yv : double;
t : string;
begin
i:= TDataPointCrosshairTool(atool).PointIndex;
if (i > -1) and (i <= cbsProperties.Source.Count - 1) then
begin
- Xv:= cbsProperties.Source.Item[i]^.X;
+ //Xv:= cbsProperties.Source.Item[i]^.X;
Yv:= cbsProperties.Source.Item[i]^.Y;
t:= cbsProperties.Source.Item[i]^.Text;
StatusBar1.Panels.Items[0].Text:= t + '; waarde: ' + RealToStrSignif(Yv, 3);
diff --git a/Source/UserInterface/Forms/frhopstorage.pas b/Source/UserInterface/Forms/frhopstorage.pas
index 2fa8f5c3..c670f71c 100644
--- a/Source/UserInterface/Forms/frhopstorage.pas
+++ b/Source/UserInterface/Forms/frhopstorage.pas
@@ -1,4 +1,4 @@
-unit frhopstorage;
+unit FrHopStorage;
{$mode objfpc}{$H+}
@@ -37,13 +37,12 @@ TFrmHopStorage = class(TForm)
procedure FormCreate(Sender: TObject);
procedure fseIBUChange(Sender: TObject);
private
- { private declarations }
Procedure CalcIBU;
Procedure SetHSI(v : double);
Procedure SetAlpha(v : double);
procedure SetAge(i : longint);
public
- { public declarations }
+
published
property HSI : double write SetHSI;
property Alpha : double write SetAlpha;
diff --git a/Source/UserInterface/Forms/frhopwizard.pas b/Source/UserInterface/Forms/frhopwizard.pas
index 0381f1f0..796118df 100644
--- a/Source/UserInterface/Forms/frhopwizard.pas
+++ b/Source/UserInterface/Forms/frhopwizard.pas
@@ -1,4 +1,4 @@
-unit frhopwizard;
+unit FrHopWizard;
{$mode objfpc}{$H+}
@@ -102,7 +102,6 @@ TFrmHopWizard = class(TForm)
procedure sgFlavourSelectEditor(Sender: TObject; aCol, aRow: Integer;
var Editor: TWinControl);
private
- { private declarations }
FRec : TRecipe;
FUserClicked : boolean;
FSelHop : THop;
@@ -122,7 +121,7 @@ TFrmHopWizard = class(TForm)
Function IsFlavourHop(H : THop) : boolean;
Function IsAromaHop(H : THop) : boolean;
Procedure FillGrids;
- Procedure Update;
+ Procedure Update; reintroduce;
Procedure ChangeIBU;
Function FindHopScrollBar : TScrollBar;
Function FindScrollBar(sg : TStringGrid; aCol, aRow : integer) : TScrollBar;
@@ -133,7 +132,6 @@ TFrmHopWizard = class(TForm)
procedure sbScrollbarsChange(Sender: TObject);
procedure cbScrollbarsChange(Sender: TObject);
public
- { public declarations }
Function Execute(R : TRecipe) : boolean;
end;
@@ -427,7 +425,6 @@ procedure TFrmHopWizard.FormDestroy(Sender: TObject);
ibu, gpl, n, ni : double;
sb : TScrollBar;
cb : TCheckBox;
- variableset : boolean;
begin
if FRec <> NIL then
begin
@@ -642,8 +639,6 @@ procedure TFrmHopWizard.FormDestroy(Sender: TObject);
ibubitter, ibuflavour, ibuaroma : double;
allflavourlocked, allaromalocked : boolean;
sb : TScrollBar;
- cb : TCheckBox;
- Rect : TRect;
St : TBeerStyle;
begin
FUserClicked:= false;
@@ -1074,20 +1069,16 @@ procedure TFrmHopWizard.fseGridChange(Sender: TObject);
procedure TFrmHopWizard.sbScrollbarsChange(Sender: TObject);
var sb : TScrollBar;
- i, spos, n : integer;
- vol, conc, amount, tot, delta : double;
+ i, n : integer;
+ vol, conc, amount, delta : double;
H : THop;
- ibuold, ibunew, ibufa, ibu : double;
+ ibuold, ibunew, ibu : double;
begin
if (FRec <> NIL) and (FSelHop <> NIL) and FUserClicked then
begin
FUserClicked:= false;
-
sb:= TScrollBar(sender);
-
- spos:= sb.Position;
FSelHop:= FindHop(sb);
-
vol:= FRec.BatchSize.DisplayValue;
conc:= sb.Position / 10;
amount:= conc * vol;
@@ -1831,9 +1822,6 @@ procedure TFrmHopWizard.sgAromaSelectEditor(Sender: TObject; aCol,
procedure TFrmHopWizard.bbAddHopClick(Sender: TObject);
var H : THop;
- g : TStringGrid;
- sb : TScrollBar;
- i, n : integer;
IBUold : double;
begin
try
diff --git a/Source/UserInterface/Forms/frimport.pas b/Source/UserInterface/Forms/frimport.pas
index 99ac402f..d8f5168e 100644
--- a/Source/UserInterface/Forms/frimport.pas
+++ b/Source/UserInterface/Forms/frimport.pas
@@ -1,4 +1,4 @@
-unit frimport;
+unit FrImport;
{$mode objfpc}{$H+}
@@ -32,7 +32,6 @@ TFrmImport = class(TForm)
procedure bbOKClick(Sender: TObject);
procedure odFileTypeChange(Sender: TObject);
private
- { private declarations }
FDirName : string;
FFileName : string;
FFileType : TFileType;
@@ -40,7 +39,6 @@ TFrmImport = class(TForm)
FDestination : TDestination;
FFiles : TStrings;
public
- { public declarations }
Function Execute : boolean;
published
property DirName : string read FDirName;
diff --git a/Source/UserInterface/Forms/frinfo.pas b/Source/UserInterface/Forms/frinfo.pas
index f9d44975..72d661ca 100644
--- a/Source/UserInterface/Forms/frinfo.pas
+++ b/Source/UserInterface/Forms/frinfo.pas
@@ -1,4 +1,4 @@
-unit frinfo;
+unit FrInfo;
{$mode objfpc}{$H+}
@@ -34,9 +34,8 @@ TfrmInfo = class(TForm)
procedure lTwitterClick(Sender: TObject);
procedure mBrewingChange(Sender: TObject);
private
- { private declarations }
+
public
- { public declarations }
Function Execute : boolean;
end;
diff --git a/Source/UserInterface/Forms/frmain.pas b/Source/UserInterface/Forms/frmain.pas
index a3689ebe..06928d88 100644
--- a/Source/UserInterface/Forms/frmain.pas
+++ b/Source/UserInterface/Forms/frmain.pas
@@ -5,13 +5,33 @@
interface
uses
- Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
- ComCtrls, ExtCtrls, ActnList, StdCtrls, StrUtils, Buttons, Grids, Spin,
- ExtDlgs, EditBtn, Printers, PrintersDlgs, TAGraph, TASeries,
+ // RTL, FCL
+ Classes, SysUtils, StrUtils, Crt, Math, DOM, {XMLRead,} XMLWrite,
+ // LazUtils
+ FileUtil,
+ // LCL
+ LCLIntf, Forms, Controls, Graphics, Menus, ComCtrls, ExtCtrls, StdCtrls,
+ ActnList, Buttons, Grids, Spin, Dialogs, ExtDlgs, EditBtn, DefaultTranslator,
+ Printers, PrintersDlgs,
+ // TAChart
+ TAGraph, TASeries,
TASources, TAChartUtils, TAChartAxis, TATransformations, TATools,
- TAMultiSeries, TAIntervalSources, Data, Containers, Hulpfuncties,
- PositieInterval, timeedit, UniqueInstance, {pl_luicontrols,} DOM, XMLRead, XMLWrite, LCLIntf,
- ExpandPanels, DefaultTranslator;
+ TAMultiSeries, TAIntervalSources,
+ // ExpandPanels
+ ExpandPanels,
+ // UniqueInstance
+ UniqueInstance,
+ // BrewBuddy
+ Data, Cloud, Containers, Hulpfuncties, RcStrngs, PositieInterval, TimeEdit,
+ FrFermentables, FrHop, FrYeasts, FrMiscs, FrWaters, FrEquipments,
+ FrBeerstyles, FrMashs, FrFermentables2, FrHop2, FrMiscs2, FrYeasts2,
+ FrFermentables3, FrHop3, FrMiscs3, FrYeasts3, FrMashstep,
+ FrWaterAdjustment, FrNotification, FrMeasurements, FrImport, FrRecipeToBrew,
+ BH_report, BHprintforms, FrPropagation, FrRefractometer, FrBoilMethod,
+ FDatabaseLocation, FrDivideBrew, FrChooseBrewsChars,
+ FrSplash, FrInfo, FrSynchronize, FrChoosebrews, FrRestoreDatabases, FrSettings,
+ FrAnalysis, FrHistogram, FrNN, neuroot, FrHopStorage, FrHopGraph,
+ FrGristWizard, FrAdjustTo100, FrHopWizard, FrWaterWizard, FrCheckList;
type
@@ -834,14 +854,11 @@ TfrmMain = class(TForm)
procedure tCTimerTimer(Sender: TObject);
procedure tMashTimerTimer(Sender: TObject);
procedure tbHelpClick(Sender: TObject);
- procedure tvBrewsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
- );
+ procedure tvBrewsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure tvBrewsSelectionChanged(Sender: TObject);
- procedure tvCloudKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
- );
+ procedure tvCloudKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure tvCloudSelectionChanged(Sender: TObject);
- procedure tvRecipesKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
+ procedure tvRecipesKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure tvRecipesSelectionChanged(Sender: TObject);
procedure bbStartTimerClick(Sender: TObject);
procedure bbResetTimersClick(Sender: TObject);
@@ -923,16 +940,11 @@ TfrmMain = class(TForm)
procedure cbAerationTypeChange(Sender: TObject);
procedure fseCoolingToChange(Sender: TObject);
procedure cbLockedChange(Sender: TObject);
-
- Procedure CloudOnCloudReady(Sender: TObject; NumFiles : longint);
- Procedure CloudOnFileRead(Sender : TObject; PercDone : single);
- Procedure CloudOnCloudError(Sender : TObject; Msg : string);
procedure sbHideToolsClick(Sender: TObject);
procedure sbShowToolsClick(Sender: TObject);
procedure tbTrainNNClick(Sender: TObject);
procedure tbChartClick(Sender: TObject);
private
- { private declarations }
FSelRecipe : TRecipe;
FSelBrew : TRecipe;
FSelCloud : TRecipe;
@@ -965,7 +977,7 @@ TfrmMain = class(TForm)
Procedure CheckTotal100;
Procedure Store;
Procedure UpdateIngredientsGrid;
- Procedure Update;
+ Procedure Update; reintroduce;
Procedure UpdatePredictions;
Procedure SetControls;
Procedure SortIngredients(I1, I2 : integer);
@@ -976,8 +988,11 @@ TfrmMain = class(TForm)
Procedure SetIcon;
Procedure SetControlsStrings;
Procedure NameChange;
+ // Handlers for TBHCloud events.
+ Procedure CloudOnCloudReady(Sender: TObject; NumFiles : longint);
+ Procedure CloudOnFileRead(Sender : TObject; PercDone : single);
+ Procedure CloudOnCloudError(Sender : TObject; Msg : string);
public
- { public declarations }
OriginalBounds: TRect;
OriginalWindowState: TWindowState;
ScreenBounds: TRect;
@@ -993,15 +1008,6 @@ implementation
{$R *.lfm}
{ TfrmMain }
-uses Crt, Math, FrFermentables, FrHop, FrYeasts, FrMiscs, FrWaters, FrEquipments,
- FrBeerstyles, frmashs, FrFermentables2, FrHop2, FrMiscs2, FrYeasts2,
- frfermentables3, frhop3, frmiscs3, fryeasts3, frmashstep,
- frwateradjustment, FrNotification, frmeasurements, frimport, frrecipetobrew,
- BH_report, BHprintforms, frpropagation, frrefractometer, frboilmethod,
- fdatabaselocation, frdividebrew, frchoosebrewschars,
- frsplash, frinfo, frsynchronize, frchoosebrews, frrestoredatabases, frsettings,
- cloud, franalysis, frhistogram, frnn, neuroot, frhopstorage, frhopgraph,
- frgristwizard, fradjustto100, frhopwizard, frwaterwizard, frchecklist, rcstrngs;
var clBack : TColor;
@@ -1033,7 +1039,7 @@ procedure TfrmMain.FormCreate(Sender: TObject);
st : TStarterType;
ps : TPrimingSugar;
R : TRecipe;
- b, bt : boolean;
+ b{, bt} : boolean;
begin
{$ifdef Windows}
clBack:= RGBToColor(242, 242, 242);
@@ -1059,8 +1065,6 @@ procedure TfrmMain.FormCreate(Sender: TObject);
Application.ProcessMessages;
end;
- Screen.Cursor:= crHourglass;
-
epRight.AddPanel(mroSG);
epRight.AddPanel(mroWaterSugar);
epRight.AddPanel(mroHydrometerCorrection);
@@ -1424,7 +1428,7 @@ procedure TfrmMain.FormCreate(Sender: TObject);
lMessage.Visible:= false;
pbProgress.Visible:= false;
b:= Settings.UseCloud.Value;
- bt:= (BHCloud.PassWord <> '');
+ //bt:= (BHCloud.PassWord <> '');
if Settings.UseCloud.Value then BHCloud.ReadCloud;
tsCloud.TabVisible:= Settings.UseCloud.Value and (BHCloud.PassWord <> '');
bbShowTools.Visible:= false;
@@ -1435,8 +1439,6 @@ procedure TfrmMain.FormCreate(Sender: TObject);
cbScaleVolume.Checked:= Settings.ScaleWithVolume.Value;
FUserClicked:= TRUE;
- Screen.Cursor:= crDefault;
-
if Settings.CheckForNewVersion.Value then
begin
if CheckNewVersion then
@@ -1761,10 +1763,10 @@ procedure TfrmMain.cbLockedClick(Sender: TObject);
end;
Procedure TfrmMain.SetControls;
-var u : TUnit;
- v : double;
- bl : boolean;
- s : string;
+var
+ v : double;
+ bl : boolean;
+ s : string;
begin
if FTemporary <> NIL then
begin
@@ -2454,7 +2456,6 @@ procedure TfrmMain.hcIngredientsSectionResize(
if Question(self, savechanges2) then
begin
Screen.Cursor:= crHourglass;
- Cursor:= crHourglass;
Application.ProcessMessages;
if FSelected <> NIL then
@@ -2468,14 +2469,12 @@ procedure TfrmMain.hcIngredientsSectionResize(
Brews.SaveXML;
Recipes.SaveXML;
Screen.Cursor:= crDefault;
- Cursor:= crDefault;
end
else FChanged:= false;
end
else
begin
Screen.Cursor:= crHourglass;
- Cursor:= crHourglass;
Application.ProcessMessages;
if FSelected <> NIL then
@@ -2489,7 +2488,6 @@ procedure TfrmMain.hcIngredientsSectionResize(
Brews.SaveXML;
Recipes.SaveXML;
Screen.Cursor:= crDefault;
- Cursor:= crDefault;
end;
end;
@@ -2532,7 +2530,6 @@ procedure TfrmMain.aFullScreenExecute(Sender: TObject);
procedure TfrmMain.tbSaveClick(Sender: TObject);
begin
Screen.Cursor:= crHourglass;
- Cursor:= crHourglass;
Application.ProcessMessages;
if (FSelected <> NIL) then
begin
@@ -2546,7 +2543,6 @@ procedure TfrmMain.tbSaveClick(Sender: TObject);
Application.ProcessMessages;
Recipes.SaveXML;
Screen.Cursor:= crDefault;
- Cursor:= crDefault;
end;
procedure TfrmMain.tbImportClick(Sender: TObject);
@@ -2631,12 +2627,10 @@ procedure TfrmMain.tbCopyClipboardClick(Sender: TObject);
if FSelected <> NIL then
begin
Screen.Cursor:= crHourglass;
- Cursor:= crHourglass;
Application.ProcessMessages;
if FTemporary.CopyToClipboardForumFormat then
ShowNotification(self, copysucces1);
Screen.Cursor:= crDefault;
- Cursor:= crDefault;
end;
end;
@@ -2645,12 +2639,10 @@ procedure TfrmMain.tbCopyHTMLClick(Sender: TObject);
if FSelected <> NIL then
begin
Screen.Cursor:= crHourglass;
- Cursor:= crHourglass;
Application.ProcessMessages;
if FTemporary.CopyToClipboardHTML then
ShowNotification(self, copysucces1);
Screen.Cursor:= crDefault;
- Cursor:= crDefault;
end;
end;
@@ -2662,7 +2654,6 @@ procedure TfrmMain.tbBrewsListClick(Sender: TObject);
if frmChooseBrewsList.Execute > -1 then
begin
Screen.Cursor:= crHourglass;
- Cursor:= crHourglass;
Application.ProcessMessages;
Doc:= TBHRDocument.Create;
@@ -2670,13 +2661,11 @@ procedure TfrmMain.tbBrewsListClick(Sender: TObject);
frmChooseBrewsList.StartNR, frmChooseBrewsList.EndNR) then
begin
Screen.Cursor:= crDefault;
- Cursor:= crDefault;
Doc.PrintPreview;
end
else Doc.Free;
Doc:= NIL; //Doc is freed automatically after PrintPreview form closes;
Screen.Cursor:= crDefault;
- Cursor:= crDefault;
end;
finally
frmChooseBrewsList.Free;
@@ -2688,7 +2677,6 @@ procedure TfrmMain.tbPrintPreviewClick(Sender: TObject);
RT : TRecType;
begin
Screen.Cursor:= crHourglass;
- Cursor:= crHourglass;
Application.ProcessMessages;
if pcRecipes.ActivePage = tsBrews then
@@ -2700,13 +2688,11 @@ procedure TfrmMain.tbPrintPreviewClick(Sender: TObject);
if CreateLogbook(Doc, FTemporary, RT) then
begin
Screen.Cursor:= crDefault;
- Cursor:= crDefault;
Doc.PrintPreview
end
else Doc.Free;
Doc:= NIL; //Doc is freed automatically after PrintPreview form closes;
Screen.Cursor:= crDefault;
- Cursor:= crDefault;
end;
procedure TfrmMain.tbPrintClick(Sender: TObject);
@@ -2989,7 +2975,6 @@ procedure TfrmMain.miCheckPrintClick(Sender: TObject);
var Doc : TBHRDocument;
begin
Screen.Cursor:= crHourglass;
- Cursor:= crHourglass;
Application.ProcessMessages;
FTemporary.CheckList.CreateCheckList;
@@ -2997,7 +2982,6 @@ procedure TfrmMain.miCheckPrintClick(Sender: TObject);
if CreateCheckList(Doc, FTemporary) then
begin
Screen.Cursor:= crDefault;
- Cursor:= crDefault;
Doc.PrintPreview;
end
else Doc.Free;
@@ -3018,14 +3002,12 @@ procedure TfrmMain.tbInventoryListClick(Sender: TObject);
var Doc : TBHRDocument;
begin
Screen.Cursor:= crHourglass;
- Cursor:= crHourglass;
Application.ProcessMessages;
Doc:= TBHRDocument.Create;
if CreateStockList(Doc) then
begin
Screen.Cursor:= crDefault;
- Cursor:= crDefault;
Doc.PrintPreview;
end
else Doc.Free;
@@ -3065,9 +3047,7 @@ procedure TfrmMain.tbBackupClick(Sender: TObject);
end;
procedure TfrmMain.tbRestoreClick(Sender: TObject);
-var DBlocation : string;
begin
- DBlocation:= BHFolder;
sddBackup.InitialDir:= BHFolder;
sddBackup.Title:= choosebackupfolder1;
sddBackup.Filter:= 'backup-*';
@@ -3360,7 +3340,7 @@ procedure TfrmMain.miRecipesToBrewsClick(Sender: TObject);
procedure TfrmMain.miCloudToBrewsClick(Sender: TObject);
var R : TRecipe;
- s : string;
+ //s : string;
ibu : double;
begin
if FSelected <> NIL then
@@ -3401,7 +3381,7 @@ procedure TfrmMain.miCloudToBrewsClick(Sender: TObject);
procedure TfrmMain.miCloudToRecipesClick(Sender: TObject);
var R : TRecipe;
- s : string;
+ //s : string;
begin
if FSelected <> NIL then
begin
@@ -3578,7 +3558,6 @@ procedure TfrmMain.SortByNumber(page : TTabSheet);
if (tvBrews.Selected <> NIL) and (tvBrews.Selected.Data <> NIL) then
Rec:= TRecipe(tvBrews.Selected.Data);
Screen.Cursor:= crHourglass;
- Cursor:= crHourglass;
Application.ProcessMessages;
tvBrews.Visible:= false;
tvBrews.Items.Clear;
@@ -3630,14 +3609,12 @@ procedure TfrmMain.SortByNumber(page : TTabSheet);
end;
end;
Screen.Cursor:= crDefault;
- Cursor:= crDefault;
end
else if page = tsRecipes then
begin
if (tvRecipes.Selected <> NIL) and (tvRecipes.Selected.Data <> NIL) then
Rec:= TRecipe(tvRecipes.Selected.Data);
Screen.Cursor:= crHourglass;
- Cursor:= crHourglass;
Application.ProcessMessages;
tvRecipes.Visible:= false;
tvRecipes.Items.Clear;
@@ -3674,7 +3651,6 @@ procedure TfrmMain.SortByNumber(page : TTabSheet);
tvRecipes.Selected.MakeVisible;
end;
Screen.Cursor:= crDefault;
- Cursor:= crDefault;
end
else if page = tsCloud then
begin
@@ -3683,7 +3659,6 @@ procedure TfrmMain.SortByNumber(page : TTabSheet);
if (tvCloud.Selected <> NIL) and (tvCloud.Selected.Data <> NIL) then
CloudF:= BHCloud.Selected;
Screen.Cursor:= crHourglass;
- Cursor:= crHourglass;
Application.ProcessMessages;
tvCloud.Visible:= false;
tvCloud.Items.Clear;
@@ -3713,7 +3688,6 @@ procedure TfrmMain.SortByNumber(page : TTabSheet);
tvCloud.Selected.MakeVisible;
end;
Screen.Cursor:= crDefault;
- Cursor:= crDefault;
end
else if not BHCloud.IsBusy then
tsCloud.TabVisible:= BHCloud.ReadCloud;
@@ -3725,18 +3699,17 @@ procedure TfrmMain.SortByStyle(page : TTabSheet);
st, le : string;
RootNode, ClassNode, StyleNode, RecipeNode : TTreeNode;
Rec, RecO : TRecipe;
- CloudF : longint;
+ //CloudF : longint;
CloudFile : TBHCloudFile;
begin
Rec:= NIL; RecO:= NIL;
- CloudF:= -1;
+ //CloudF:= -1;
if Page = tsBrews then
begin
//fill the treeview with brews
if (tvBrews.Selected <> NIL) and (tvBrews.Selected.Data <> NIL) then
RecO:= TRecipe(tvBrews.Selected.Data);
Screen.Cursor:= crHourglass;
- Cursor:= crHourglass;
Application.ProcessMessages;
tvBrews.Visible:= false;
tvBrews.Items.Clear;
@@ -3808,13 +3781,11 @@ procedure TfrmMain.SortByStyle(page : TTabSheet);
end;
finally
Screen.Cursor:= crDefault;
- Cursor:= crDefault;
end;
end
else if Page = tsRecipes then
begin
Screen.Cursor:= crHourglass;
- Cursor:= crHourglass;
Application.ProcessMessages;
if (tvRecipes.Selected <> NIL) and (tvRecipes.Selected.Data <> NIL) then
RecO:= TRecipe(tvRecipes.Selected.Data);
@@ -3875,13 +3846,11 @@ procedure TfrmMain.SortByStyle(page : TTabSheet);
end;
finally
Screen.Cursor:= crDefault;
- Cursor:= crDefault;
end;
end
else if Page = tsCloud then
begin
Screen.Cursor:= crHourglass;
- Cursor:= crHourglass;
Application.ProcessMessages;
if (tvCloud.Selected <> NIL) and (tvCloud.Selected.Data <> NIL) then
RecO:= TRecipe(tvCloud.Selected.Data);
@@ -3895,7 +3864,7 @@ procedure TfrmMain.SortByStyle(page : TTabSheet);
RootNode.StateIndex:= 11;
for i:= 0 to BHCloud.NumFiles - 1 do
begin
- CloudF:= BHCloud.Selected;
+ //CloudF:= BHCloud.Selected;
CloudFile:= BHCloud.FileRec[i];
if CloudFile.ShowRecipe.Value then
begin
@@ -3946,7 +3915,6 @@ procedure TfrmMain.SortByStyle(page : TTabSheet);
tsCloud.TabVisible:= BHCloud.ReadCloud;
finally
Screen.Cursor:= crDefault;
- Cursor:= crDefault;
tvCloud.Visible:= TRUE;
end;
end;
@@ -3958,17 +3926,14 @@ procedure TfrmMain.SortByDate(page : TTabSheet);
st : string;
RootNode, YearNode, MonthNode, RecipeNode : TTreeNode;
Rec, RecO : TRecipe;
- CloudF : longint;
CloudFile : TBHCloudFile;
begin
Rec:= NIL; RecO:= NIL;
- CloudF:= -1;
CloudFile:= NIL;
if Page = tsBrews then
begin
//fill the treeview with brews
Screen.Cursor:= crHourglass;
- Cursor:= crHourglass;
Application.ProcessMessages;
if (tvBrews.Selected <> NIL) and (tvBrews.Selected.Data <> NIL) then
RecO:= TRecipe(tvBrews.Selected.Data);
@@ -4039,13 +4004,11 @@ procedure TfrmMain.SortByDate(page : TTabSheet);
end;
finally
Screen.Cursor:= crDefault;
- Cursor:= crDefault;
end;
end
else if Page = tsRecipes then
begin
Screen.Cursor:= crHourglass;
- Cursor:= crHourglass;
Application.ProcessMessages;
if (tvRecipes.Selected <> NIL) and (tvRecipes.Selected.Data <> NIL) then
RecO:= TRecipe(tvRecipes.Selected.Data);
@@ -4103,13 +4066,11 @@ procedure TfrmMain.SortByDate(page : TTabSheet);
end;
finally
Screen.Cursor:= crDefault;
- Cursor:= crDefault;
end;
end
else if Page = tsCloud then
begin
Screen.Cursor:= crHourglass;
- Cursor:= crHourglass;
Application.ProcessMessages;
if (tvCloud.Selected <> NIL) and (tvCloud.Selected.Data <> NIL) then
RecO:= TRecipe(tvCloud.Selected.Data);
@@ -4168,7 +4129,6 @@ procedure TfrmMain.SortByDate(page : TTabSheet);
tsCloud.TabVisible:= BHCloud.ReadCloud;
finally
Screen.Cursor:= crDefault;
- Cursor:= crDefault;
tvCloud.Visible:= TRUE;
end;
end;
@@ -4241,8 +4201,8 @@ procedure TfrmMain.pcRecipesChange(Sender: TObject);
end;
procedure TfrmMain.FillAnalyseCharts;
-var lett, snm : string;
- num : integer;
+var //lett, snm : string;
+ //num : integer;
mma : TMinMax;
ylist: array [1..4] of Double;
i : integer;
@@ -4268,20 +4228,20 @@ procedure TfrmMain.FillAnalyseCharts;
begin
OK:= TRUE;
RC:= Brews;
- snm:= tvBrews.Selected.Text;
- lett:= tvBrews.Selected.Parent.Text;
+ //snm:= tvBrews.Selected.Text;
+ //lett:= tvBrews.Selected.Parent.Text;
end
else if (pcRecipes.ActivePage = tsRecipes) and (cbRecipesSort.ItemIndex = 1) and
(tvRecipes.Selected <> NIL) and (tvRecipes.Selected.Level = 2) then //sorted by beerstyle
begin
OK:= TRUE;
RC:= Recipes;
- snm:= tvRecipes.Selected.Text;
- lett:= tvRecipes.Selected.Parent.Text;
+ //snm:= tvRecipes.Selected.Text;
+ //lett:= tvRecipes.Selected.Parent.Text;
end;
if OK then
begin
- num:= RC.AnalyseFermentables(lett, snm);
+ //num:= RC.AnalyseFermentables(lett, snm);
dbawFermentables.Source.Ycount:= 5;
//create graph and show it
for i:= 0 to High(RC.FermentablesMinMaxArray) do
@@ -4297,7 +4257,7 @@ procedure TfrmMain.FillAnalyseCharts;
end;
lcsHopBW.YCount:= 5;
- num:= RC.AnalyseHops(lett, snm);
+ //num:= RC.AnalyseHops(lett, snm);
if rgBitterhop.Checked then
begin
for i:= 0 to High(RC.BitterhopMinMaxArray) do
@@ -4351,7 +4311,7 @@ procedure TfrmMain.FillAnalyseCharts;
end;
if maxr > 0 then latHopright.Scale:= maxl / maxr;
- num:= RC.AnalyseYeasts(lett, snm);
+ //num:= RC.AnalyseYeasts(lett, snm);
//create graph and show it
for i:= 0 to High(RC.YeastMinMaxArray) do
begin
@@ -4367,7 +4327,7 @@ procedure TfrmMain.FillAnalyseCharts;
maxl:= 0;
maxr:= 0;
- num:= RC.AnalyseMiscs(lett, snm);
+ //num:= RC.AnalyseMiscs(lett, snm);
for i:= 0 to High(RC.MiscMinMaxArray) do
begin
mma:= RC.MiscMinMaxArray[i];
@@ -4383,7 +4343,7 @@ procedure TfrmMain.FillAnalyseCharts;
end;
if maxr > 0 then latMiscRight.Scale:= maxl / maxr;
- num:= RC.AnalyseRecipes(lett, snm);
+ //num:= RC.AnalyseRecipes(lett, snm);
for i:= 0 to High(RC.CommonMinMaxArray) do
begin
mma:= RC.CommonMinMaxArray[i];
@@ -4423,7 +4383,7 @@ procedure TfrmMain.tvBrewsKeyDown(Sender: TObject; var Key: Word;
Procedure TfrmMain.UpdateAndStoreCheckList(Rec : TRecipe);
var R : TRecipe;
- i, n, g : longint;
+ //i, n, g : longint;
begin
if Rec.RecType = rtBrew then
begin
@@ -4431,26 +4391,26 @@ procedure TfrmMain.tvBrewsKeyDown(Sender: TObject; var Key: Word;
R:= Brews.FindByAutoNr(Rec.AutoNr.Value);
if R <> NIL then
begin
- n:= Rec.CheckList.NumItemsChecked;
+ //n:= Rec.CheckList.NumItemsChecked;
R.CheckList.Assign(Rec.CheckList);
- i:= R.CheckList.NumItemsChecked;
- n:= Rec.CheckList.NumItemsChecked;
- g:= Rec.CheckList.NumGroups;
+ //i:= R.CheckList.NumItemsChecked;
+ //n:= Rec.CheckList.NumItemsChecked;
+ //g:= Rec.CheckList.NumGroups;
if (FSelBrew = R) then
begin
if (FTemporary.RecType = rtBrew) and (FTemporary.AutoNr.Value = Rec.AutoNr.Value) then
begin
- g:= Rec.CheckList.NumGroups;
+ //g:= Rec.CheckList.NumGroups;
FTemporary.CheckList.Assign(Rec.CheckList);
- i:= FTemporary.CheckList.NumItemsChecked;
- n:= Rec.CheckList.NumItemsChecked;
+ //i:= FTemporary.CheckList.NumItemsChecked;
+ //n:= Rec.CheckList.NumItemsChecked;
FSelBrew.Assign(FTemporary);
- i:= FSelBrew.CheckList.NumItemsChecked;
- n:= Rec.CheckList.NumItemsChecked;
+ //i:= FSelBrew.CheckList.NumItemsChecked;
+ //n:= Rec.CheckList.NumItemsChecked;
end;
end;
Brews.SaveXML;
- i:= R.CheckList.NumItemsChecked;
+ //i:= R.CheckList.NumItemsChecked;
end;
FUserClicked:= TRUE;
end;
@@ -4589,7 +4549,6 @@ procedure TfrmMain.tvRecipesKeyDown(Sender: TObject; var Key: Word;
end;
Procedure TfrmMain.NameChange;
-var s : string;
begin
if FTemporary <> NIL then
Caption:= 'BrewBuddy - Sassy Saison - ' + FTemporary.Name.Value
@@ -4866,12 +4825,11 @@ procedure TfrmMain.fseBatchSizeChange(Sender: TObject);
end;
procedure TfrmMain.cbLockedChange(Sender: TObject);
-var n : TTreeNode;
+//var n : TTreeNode;
begin
if (FSelected <> NIL) and FUserClicked then
begin
Screen.Cursor:= crHourglass;
- Cursor:= crHourglass;
Application.ProcessMessages;
FTemporary.Locked.Value:= cbLocked.Checked;
Store;
@@ -4883,12 +4841,11 @@ procedure TfrmMain.cbLockedChange(Sender: TObject);
else
bbInventory.Color:= clDefault;
- n:= tvBrews.Items.FindNodeWithData(FSelected);
+ //n:= tvBrews.Items.FindNodeWithData(FSelected);
SetIcon;
Application.ProcessMessages;
Screen.Cursor:= crDefault;
- Cursor:= crDefault;
FChanged:= false;
end;
end;
@@ -5883,7 +5840,7 @@ procedure TfrmMain.sgIngredientsSelectEditor(Sender: TObject; aCol,
aRow: Integer; var Editor: TWinControl);
var r : TRect;
v : double;
- s : string;
+ //s : string;
Y : TYeast;
begin
Editor:= NIL;
@@ -5901,7 +5858,7 @@ procedure TfrmMain.sgIngredientsSelectEditor(Sender: TObject; aCol,
fseGrid.BoundsRect:= r;
fseGrid.DecimalPlaces:= Y.AmountYeast.Decimals;
fseGrid.MaxValue:= Y.AmountYeast.MaxValue;
- s:= Y.Name.Value;
+ //s:= Y.Name.Value;
v:= Y.AmountYeast.DisplayValue;
fseGrid.Value:= v;
Editor:= fseGrid;
@@ -5911,7 +5868,7 @@ procedure TfrmMain.sgIngredientsSelectEditor(Sender: TObject; aCol,
fseGrid.BoundsRect:= r;
fseGrid.DecimalPlaces:= FSelIngredient.Amount.Decimals;
fseGrid.MaxValue:= FSelIngredient.Amount.MaxValue;
- s:= FSelIngredient.Name.Value;
+ //s:= FSelIngredient.Name.Value;
v:= FSelIngredient.Amount.DisplayValue;
fseGrid.Value:= v;
Editor:= fseGrid;
@@ -6695,7 +6652,7 @@ procedure TfrmMain.fseChillerLossChange(Sender: TObject);
end;
procedure TfrmMain.fseTopUpWaterChange(Sender: TObject);
-var V, V2, x : double;
+//var V, V2, x : double;
begin
if (FSelected <> NIL) and (FTemporary.Mash <> NIL) and FUserClicked then
begin
@@ -7483,14 +7440,12 @@ procedure TfrmMain.bbChecklistClick(Sender: TObject);
var Doc : TBHRDocument;
begin
Screen.Cursor:= crHourglass;
- Cursor:= crHourglass;
Application.ProcessMessages;
Doc:= TBHRDocument.Create;
if CreateCheckList(Doc, FTemporary) then
begin
Screen.Cursor:= crDefault;
- Cursor:= crDefault;
Doc.PrintPreview
end
else Doc.Free;
diff --git a/Source/UserInterface/Forms/frmashs.pas b/Source/UserInterface/Forms/frmashs.pas
index df1ed7cf..131fdb64 100644
--- a/Source/UserInterface/Forms/frmashs.pas
+++ b/Source/UserInterface/Forms/frmashs.pas
@@ -1,4 +1,4 @@
-unit frmashs;
+unit FrMashs;
{$mode objfpc}{$H+}
@@ -47,13 +47,11 @@ TFrmMashs = class(TForm)
procedure FormCreate(Sender: TObject);
procedure sgMashStepsDblClick(Sender: TObject);
procedure sgMashStepsSelection(Sender: TObject; aCol, aRow: Integer);
- procedure tvSelectKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
- );
+ procedure tvSelectKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure tvSelectSelectionChanged(Sender: TObject);
procedure bbImportClick(Sender: TObject);
procedure bbCopyClick(Sender: TObject);
private
- { private declarations }
FSelectedNode : TTreeNode;
FNew : boolean;
FSelectedRow : integer;
@@ -61,7 +59,7 @@ TFrmMashs = class(TForm)
Procedure Store;
Procedure FillTree;
public
- { public declarations }
+
end;
var
@@ -108,7 +106,7 @@ procedure TFrmMashs.FormCreate(Sender: TObject);
var i : integer;
mname : string;
Mash : TMash;
- Node, ChildNode: TTreeNode;
+ Node, {%H-}ChildNode: TTreeNode;
begin
tvSelect.Items.Clear;
Node:= tvSelect.Items.Add(nil,'');
diff --git a/Source/UserInterface/Forms/frmashstep.pas b/Source/UserInterface/Forms/frmashstep.pas
index 2ff098f8..69cdf7fe 100644
--- a/Source/UserInterface/Forms/frmashstep.pas
+++ b/Source/UserInterface/Forms/frmashstep.pas
@@ -1,4 +1,4 @@
-unit frmashstep;
+unit FrMashstep;
{$mode objfpc}{$H+}
@@ -34,9 +34,8 @@ TFrmMashStep = class(TForm)
seStepTemp: TSpinEdit;
procedure FormCreate(Sender: TObject);
private
- { private declarations }
+
public
- { public declarations }
Function Execute(MS : TMashStep) : boolean;
end;
diff --git a/Source/UserInterface/Forms/frmeasurements.pas b/Source/UserInterface/Forms/frmeasurements.pas
index 3c53ee40..87cbf285 100644
--- a/Source/UserInterface/Forms/frmeasurements.pas
+++ b/Source/UserInterface/Forms/frmeasurements.pas
@@ -1,4 +1,4 @@
-unit frmeasurements;
+unit FrMeasurements;
{$mode objfpc}{$H+}
@@ -61,7 +61,6 @@ TfrmMeasurements = class(TForm)
procedure rxteTimeChange(Sender: TObject);
procedure bbRemoveAllClick(Sender: TObject);
private
- { private declarations }
FRecipe : TRecipe;
FMeasurements : TFermMeasurements;
FSelM : TFermMeasurement;
@@ -74,7 +73,6 @@ TfrmMeasurements = class(TForm)
Function CountColumns : integer;
Function FindEndHeader : integer;
public
- { public declarations }
Function Execute(R : TRecipe) : boolean;
end;
@@ -196,8 +194,8 @@ procedure TfrmMeasurements.FormDestroy(Sender: TObject);
end;
procedure TfrmMeasurements.sgMeasSelection(Sender: TObject; aCol, aRow: Integer);
-var sg : double;
- b : boolean;
+var
+ b : boolean;
begin //a row is selected. Put values of that row in the edit controls
FUserClicked:= false;
if (FMeasurements <> NIL) and (aRow > sgMeas.FixedRows) then
@@ -397,7 +395,7 @@ procedure TfrmMeasurements.bbRemoveAllClick(Sender: TObject);
StartDate, Date : TDateTime;
v, hr, sg : double;
Meas : TFermMeasurement;
- ColCount, DataStart, iDate : integer;
+ ColCount, DataStart : integer;
begin
Result:= false;
try
@@ -514,7 +512,7 @@ procedure TfrmMeasurements.bbRemoveAllClick(Sender: TObject);
end;
Function TfrmMeasurements.FindEndHeader : integer;
-var s, w : string;
+var s : string;
begin
Result:= 0;
repeat
diff --git a/Source/UserInterface/Forms/frmiscs.pas b/Source/UserInterface/Forms/frmiscs.pas
index 7084fea7..fee83e04 100644
--- a/Source/UserInterface/Forms/frmiscs.pas
+++ b/Source/UserInterface/Forms/frmiscs.pas
@@ -72,21 +72,19 @@ TFrmMiscs = class(TForm)
procedure fseCostChange(Sender: TObject);
procedure fseInventoryChange(Sender: TObject);
procedure sbClearClick(Sender: TObject);
- procedure tvSelectKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
- );
+ procedure tvSelectKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure tvSelectSelectionChanged(Sender: TObject);
procedure cbTypeChange(Sender: TObject);
procedure bbImportClick(Sender: TObject);
procedure bbCopyClick(Sender: TObject);
private
- { private declarations }
FSelectedNode : TTreeNode;
FNew : boolean;
FUserClicked: boolean;
Procedure Store;
Procedure FillTree;
public
- { public declarations }
+
end;
var
@@ -133,7 +131,7 @@ procedure TFrmMiscs.FormCreate(Sender: TObject);
var i : integer;
s : string;
M : TMisc;
- Node, ChildNode, ChildNode2: TTreeNode;
+ Node, ChildNode, {%H-}ChildNode2: TTreeNode;
begin
tvSelect.Items.Clear;
Node:= tvSelect.Items.Add(nil,'Type');
@@ -405,8 +403,7 @@ procedure TFrmMiscs.cbUseChange(Sender: TObject);
end;
procedure TFrmMiscs.eSearchChange(Sender: TObject);
-var i : integer;
- N : TTreeNode;
+var N : TTreeNode;
M : TMisc;
s, s2 : string;
Vis : boolean;
diff --git a/Source/UserInterface/Forms/frmiscs2.pas b/Source/UserInterface/Forms/frmiscs2.pas
index 2db39717..9cd5b5fb 100644
--- a/Source/UserInterface/Forms/frmiscs2.pas
+++ b/Source/UserInterface/Forms/frmiscs2.pas
@@ -49,14 +49,12 @@ TFrmMiscs2 = class(TForm)
procedure FormDestroy(Sender: TObject);
procedure cbNameChange(Sender: TObject);
private
- { private declarations }
FMisc, FOriginal, FChosen : TMisc;
FUserClicked : boolean;
Procedure Store;
Procedure SetControls;
procedure FillcbName;
public
- { public declarations }
Function Execute(M : TMisc) : boolean;
end;
@@ -202,9 +200,6 @@ procedure TFrmMiscs2.FillcbName;
end;
Function TFrmMiscs2.Execute(M : TMisc) : boolean;
-var i : integer;
- s : string;
- Mi : TMisc;
begin
Result:= false;
FMisc:= M;
diff --git a/Source/UserInterface/Forms/frmiscs3.pas b/Source/UserInterface/Forms/frmiscs3.pas
index 1dba529a..e7dda6f5 100644
--- a/Source/UserInterface/Forms/frmiscs3.pas
+++ b/Source/UserInterface/Forms/frmiscs3.pas
@@ -1,4 +1,4 @@
-unit frmiscs3;
+unit FrMiscs3;
{$mode objfpc}{$H+}
@@ -38,14 +38,12 @@ TFrmMiscs3 = class(TForm)
procedure eSearchChange(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
private
- { private declarations }
FMisc : TMisc;
FSort : integer;
FSortDec, FUserClicked : boolean;
FMiscList : array of TMisc;
Procedure SortGrid(Nr1, Nr2 : integer);
public
- { public declarations }
Function Execute(M : TMisc) : boolean;
end;
diff --git a/Source/UserInterface/Forms/frnn.pas b/Source/UserInterface/Forms/frnn.pas
index 9cd09a0d..29212314 100644
--- a/Source/UserInterface/Forms/frnn.pas
+++ b/Source/UserInterface/Forms/frnn.pas
@@ -1,4 +1,4 @@
-unit frnn;
+unit FrNN;
{$mode objfpc}{$H+}
@@ -129,18 +129,16 @@ TFrmNN = class(TForm)
procedure tvNNSelectionChanged(Sender: TObject);
procedure bbTrainClick(Sender: TObject);
private
- { private declarations }
FSelNN : TBHNN;
FUserClicked, FChanged, FTraining : boolean;
FISGX, FISGY : integer;
Procedure FillTree;
- Procedure Update;
+ Procedure Update; reintroduce;
Function UpdateNetwork : boolean;
Procedure AskToSave;
Procedure UpdateChart;
Procedure UpdatesgOutput;
public
- { public declarations }
Procedure Execute;
procedure NNOnTrainRound(Sender : TObject; Error, Progress : single);
procedure NNOnTrainReady(Sender : TObject; Error : single);
@@ -249,14 +247,14 @@ procedure TFrmNN.pcMainChange(Sender: TObject);
procedure TFrmNN.sbInputAddClick(Sender: TObject);
var s : string;
- i : integer;
+ //i : integer;
R : TRecipe;
begin
R:= TRecipe(Brews.Item[0]);
if (lbParameters.ItemIndex > -1) and (R <> NIL) and (FSelNN <> NIL) then
begin
s:= lbParameters.Items[lbParameters.ItemIndex];
- i:= R.GetNumberIndexByName(s);
+ //i:= R.GetNumberIndexByName(s);
lbParameters.Items.Delete(lbParameters.ItemIndex);
lbInput.Items.Add(s);
// FSelNN.AddInputIndex(i);
@@ -271,7 +269,7 @@ procedure TFrmNN.sbInputAddClick(Sender: TObject);
procedure TFrmNN.sbInputRemoveClick(Sender: TObject);
var s : string;
- i : integer;
+ //i : integer;
R : TRecipe;
begin
R:= TRecipe(Brews.Item[0]);
@@ -282,7 +280,7 @@ procedure TFrmNN.sbInputRemoveClick(Sender: TObject);
else
begin
s:= lbInput.Items[lbInput.ItemIndex];
- i:= R.GetNumberIndexByName(s);
+ //i:= R.GetNumberIndexByName(s);
lbInput.Items.Delete(lbInput.ItemIndex);
lbParameters.Items.Add(s);
UpdateNetwork;
@@ -292,7 +290,7 @@ procedure TFrmNN.sbInputRemoveClick(Sender: TObject);
procedure TFrmNN.sbOutputAddClick(Sender: TObject);
var s : string;
- i : integer;
+ //i : integer;
R : TRecipe;
begin
R:= TRecipe(Brews.Item[0]);
@@ -303,7 +301,7 @@ procedure TFrmNN.sbOutputAddClick(Sender: TObject);
else
begin
s:= lbParameters.Items[lbParameters.ItemIndex];
- i:= R.GetNumberIndexByName(s);
+ //i:= R.GetNumberIndexByName(s);
lbParameters.Items.Delete(lbParameters.ItemIndex);
lbOutput.Items.Add(s);
// FSelNN.AddOutputIndex(i);
@@ -319,14 +317,14 @@ procedure TFrmNN.sbOutputAddClick(Sender: TObject);
procedure TFrmNN.sbOutputRemoveClick(Sender: TObject);
var s : string;
- i : integer;
+ //i : integer;
R : TRecipe;
begin
R:= TRecipe(Brews.Item[0]);
if (lbOutput.ItemIndex > -1) and (R <> NIL) and (FSelNN <> NIL) then
begin
s:= lbOutput.Items[lbOutput.ItemIndex];
- i:= R.GetNumberIndexByName(s);
+ //i:= R.GetNumberIndexByName(s);
lbOutput.Items.Delete(lbOutput.ItemIndex);
lbParameters.Items.Add(s);
UpdateNetwork;
@@ -525,7 +523,7 @@ procedure TFrmNN.tvNNSelectionChanged(Sender: TObject);
Function TFrmNN.UpdateNetwork : boolean;
var s : string;
- i, n : integer;
+ i : integer;
numvalid : longint;
R : TRecipe;
begin
@@ -826,8 +824,7 @@ procedure TFrmNN.bbNewNNClick(Sender: TObject);
end;
procedure TFrmNN.bbRemoveNNClick(Sender: TObject);
-var i : integer;
- pn, tn, ns : TTreeNode;
+var pn, tn, ns : TTreeNode;
FS : TBHNN;
begin
if FSelNN <> NIL then
diff --git a/Source/UserInterface/Forms/frnotification.pas b/Source/UserInterface/Forms/frnotification.pas
index 2013942f..5fbf8ba5 100644
--- a/Source/UserInterface/Forms/frnotification.pas
+++ b/Source/UserInterface/Forms/frnotification.pas
@@ -21,9 +21,8 @@ TFrmNotification = class(TForm)
procedure FormDestroy(Sender: TObject);
procedure FormHide(Sender: TObject);
private
- { private declarations }
+
public
- { public declarations }
Procedure ShowFrm(s : string);
Procedure SetText(s : string);
Procedure AddText(s : string);
diff --git a/Source/UserInterface/Forms/frprintpreview.pas b/Source/UserInterface/Forms/frprintpreview.pas
index 2f798e2a..c8396e32 100644
--- a/Source/UserInterface/Forms/frprintpreview.pas
+++ b/Source/UserInterface/Forms/frprintpreview.pas
@@ -1,4 +1,4 @@
-unit frprintpreview;
+unit FrPrintPreview;
{$mode objfpc}{$H+}
@@ -34,7 +34,6 @@ TFrmPrintPreview = class(TForm)
procedure sbPageMouseWheelDown(Sender: TObject; Shift: TShiftState;
MousePos: TPoint; var Handled: Boolean);
private
- { private declarations }
FDocument : TBHRDocument;
FPageNr, FPageHeight, FPageWidth : word;
FScale, FZoomfactor : single;
@@ -42,7 +41,6 @@ TFrmPrintPreview = class(TForm)
Procedure SetDocument(F : TBHRDocument);
Procedure ShowPage;
public
- { public declarations }
Function Execute(F : TBHRDocument) : boolean;
published
property Document : TBHRDocument read FDocument write SetDocument;
diff --git a/Source/UserInterface/Forms/frpropagation.pas b/Source/UserInterface/Forms/frpropagation.pas
index c29d4e46..799c36db 100644
--- a/Source/UserInterface/Forms/frpropagation.pas
+++ b/Source/UserInterface/Forms/frpropagation.pas
@@ -1,4 +1,4 @@
-unit frpropagation;
+unit FrPropagation;
{$mode objfpc}{$H+}
@@ -51,14 +51,12 @@ TFrmPropagation = class(TForm)
procedure cbStarterTypeChange(Sender: TObject);
procedure bbOKClick(Sender: TObject);
private
- { private declarations }
FCellsNeeded : double;
FAuto : boolean;
Function CalcStart : double;
Procedure CalcNeeded;
Procedure CalcSteps;
public
- { public declarations }
Function Execute(Rec : TRecipe) : boolean;
end;
@@ -179,7 +177,7 @@ TStep = record
const numtrials = 12;
var i, n, n2 : integer;
SA1 : array[0..numtrials-1] of TStepArray;
- StepVol, TotVol, AmCells : double;
+ TotVol, AmCells : double;
numsteps : array[0..numtrials-1] of integer;
function TrySteps(StartVol, stepsize : double; SA : PStepArray) : integer;
diff --git a/Source/UserInterface/Forms/frquestion.pas b/Source/UserInterface/Forms/frquestion.pas
index d1b25699..8d0a9616 100644
--- a/Source/UserInterface/Forms/frquestion.pas
+++ b/Source/UserInterface/Forms/frquestion.pas
@@ -1,4 +1,4 @@
-unit frQuestion;
+unit FrQuestion;
{$mode objfpc}{$H+}
@@ -18,9 +18,8 @@ TFrmQuestion = class(TForm)
lQuestion: TLabel;
procedure FormCreate(Sender: TObject);
private
- { private declarations }
+
public
- { public declarations }
Function Question(s : string) : boolean;
end;
diff --git a/Source/UserInterface/Forms/frrecipetobrew.pas b/Source/UserInterface/Forms/frrecipetobrew.pas
index fbf5d42d..128b7067 100644
--- a/Source/UserInterface/Forms/frrecipetobrew.pas
+++ b/Source/UserInterface/Forms/frrecipetobrew.pas
@@ -1,4 +1,4 @@
-unit frrecipetobrew;
+unit FrRecipeToBrew;
{$mode objfpc}{$H+}
@@ -32,13 +32,11 @@ TfrmRecipeToBrew = class(TForm)
procedure eNrRecipeChange(Sender: TObject);
procedure deBrewDateChange(Sender: TObject);
private
- { private declarations }
FEquipment : TEquipment;
FNrRecipe : string;
FVolume : double;
FBrewDate : TDate;
public
- { public declarations }
Function Execute(R : TRecipe) : boolean;
end;
diff --git a/Source/UserInterface/Forms/frrefractometer.pas b/Source/UserInterface/Forms/frrefractometer.pas
index 8de373b9..8ccc6a0a 100644
--- a/Source/UserInterface/Forms/frrefractometer.pas
+++ b/Source/UserInterface/Forms/frrefractometer.pas
@@ -1,4 +1,4 @@
-unit frrefractometer;
+unit FrRefractometer;
{$mode objfpc}{$H+}
@@ -27,9 +27,9 @@ TFrmRefractometer = class(TForm)
procedure fseSGChange(Sender: TObject);
procedure bbOKClick(Sender: TObject);
private
- { private declarations }
+
public
- { public declarations }
+
end;
var
diff --git a/Source/UserInterface/Forms/frrestoredatabases.pas b/Source/UserInterface/Forms/frrestoredatabases.pas
index 32dae37e..fe3d2c90 100644
--- a/Source/UserInterface/Forms/frrestoredatabases.pas
+++ b/Source/UserInterface/Forms/frrestoredatabases.pas
@@ -1,4 +1,4 @@
-unit frrestoredatabases;
+unit FrRestoreDatabases;
{$mode objfpc}{$H+}
@@ -19,9 +19,8 @@ TfrmRestoreDatabase = class(TForm)
cbAll: TCheckBox;
procedure cbAllChange(Sender: TObject);
private
- { private declarations }
+
public
- { public declarations }
Function Execute : boolean;
end;
diff --git a/Source/UserInterface/Forms/frselectbeerstyle.pas b/Source/UserInterface/Forms/frselectbeerstyle.pas
index 37ada67d..767c4e21 100644
--- a/Source/UserInterface/Forms/frselectbeerstyle.pas
+++ b/Source/UserInterface/Forms/frselectbeerstyle.pas
@@ -1,4 +1,4 @@
-unit frselectbeerstyle;
+unit FrSelectBeerStyle;
{$mode objfpc}{$H+}
@@ -20,10 +20,8 @@ TFrmSelectBeerStyle = class(TForm)
procedure FormCreate(Sender: TObject);
procedure cbStylesChange(Sender: TObject);
private
- { private declarations }
FBeerStyle : TBeerStyle;
public
- { public declarations }
Function Execute(OldBeerstyle : string) : boolean;
published
property BeerStyle : TBeerstyle read FBeerStyle;
diff --git a/Source/UserInterface/Forms/frsettings.pas b/Source/UserInterface/Forms/frsettings.pas
index 306d2e80..1b1e5100 100644
--- a/Source/UserInterface/Forms/frsettings.pas
+++ b/Source/UserInterface/Forms/frsettings.pas
@@ -1,4 +1,4 @@
-unit frsettings;
+unit FrSettings;
{$mode objfpc}{$H+}
@@ -80,10 +80,8 @@ TfrmSettings = class(TForm)
procedure FormCreate(Sender: TObject);
procedure seFontSizeChange(Sender: TObject);
private
- { private declarations }
FStyle : TStyle;
public
- { public declarations }
Function Execute : boolean;
end;
diff --git a/Source/UserInterface/Forms/frsplash.pas b/Source/UserInterface/Forms/frsplash.pas
index cd283c0b..645f7e6f 100644
--- a/Source/UserInterface/Forms/frsplash.pas
+++ b/Source/UserInterface/Forms/frsplash.pas
@@ -1,4 +1,4 @@
-unit frsplash;
+unit FrSplash;
{$mode objfpc}{$H+}
@@ -18,10 +18,8 @@ TFrmSplash = class(TForm)
procedure tSplashTimer(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
- { private declarations }
FSecs, FDuration : integer;
public
- { public declarations }
Procedure Execute;
end;
diff --git a/Source/UserInterface/Forms/frsynchronize.pas b/Source/UserInterface/Forms/frsynchronize.pas
index fcee1329..737e4514 100644
--- a/Source/UserInterface/Forms/frsynchronize.pas
+++ b/Source/UserInterface/Forms/frsynchronize.pas
@@ -1,4 +1,4 @@
-unit frsynchronize;
+unit FrSynchronize;
{$mode objfpc}{$H+}
@@ -56,7 +56,6 @@ TfrmFTPList = class(TForm)
procedure bbRetrieveLocClick(Sender: TObject);
procedure PageControl1PageChanged(Sender: TObject);
private
- { private declarations }
Function GetFileFTP(Host, SourceFileName, TargetFileName, User, Password : string) : boolean;
Function SendFileFTP(Host, SourceFileName, TargetFileName, User, Password : string) : boolean;
Function GetAndSendFilesFTP(Host, User, Password : string) : boolean;
@@ -64,7 +63,7 @@ TfrmFTPList = class(TForm)
Procedure FillStringGrid;
Procedure Reset;
public
- { public declarations }
+
end;
TBHFileRec = record
diff --git a/Source/UserInterface/Forms/frwateradjustment.pas b/Source/UserInterface/Forms/frwateradjustment.pas
index 2abebbc8..30e4e9f0 100644
--- a/Source/UserInterface/Forms/frwateradjustment.pas
+++ b/Source/UserInterface/Forms/frwateradjustment.pas
@@ -1,4 +1,4 @@
-unit frwateradjustment;
+unit FrWaterAdjustment;
{$mode objfpc}{$H+}
@@ -100,7 +100,6 @@ TFrmWaterAdjustment = class(TForm)
procedure sgSourceDrawCell(Sender: TObject; aCol, aRow: Integer;
aRect: TRect; aState: TGridDrawState);
private
- { private declarations }
FRecipe : TRecipe;
FSource1, FSource2, FMashWater, FAdjustedWater, FTargetWater : TWater;
FColorCells : array of TCellCoord;
@@ -122,7 +121,6 @@ TFrmWaterAdjustment = class(TForm)
Function GetDefaultPerc(at : TAcidType) : double;
Procedure Dilute(perc : double);
public
- { public declarations }
Function Execute(R : TRecipe) : boolean;
end;
@@ -729,8 +727,7 @@ procedure TFrmWaterAdjustment.FormDestroy(Sender: TObject);
end;
Procedure TFrmWaterAdjustment.Dilute(perc : double);
-var i : integer;
- Wdemi : TWater;
+var Wdemi : TWater;
vol : double;
begin
Wdemi:= Waters.GetDemiWater;
@@ -785,7 +782,7 @@ procedure TFrmWaterAdjustment.FormDestroy(Sender: TObject);
end;
Procedure TFrmWaterAdjustment.SetTable(Row : integer; W : TWater);
-var pHa, RA : double;
+var RA : double;
i : integer;
begin
if (Row >= 1) and (Row <= 4) then
@@ -1014,13 +1011,13 @@ procedure TFrmWaterAdjustment.FormDestroy(Sender: TObject);
end;
Function TFrmWaterAdjustment.GetFrac(pH, pK1, pK2, pK3 : double) : double;
-var r1d, r2d, r3d, dd, f1d, f2d, f3d, f4d : double;
+var r1d, r2d, r3d, dd, {f1d,} f2d, f3d, f4d : double;
begin
r1d:= Power(10, fseTargetpH.Value - pK1);
r2d:= Power(10, fseTargetpH.Value - pK2);
r3d:= Power(10, fseTargetpH.Value - pK3);
dd:= 1/(1 + r1d + r1d*r2d + r1d*r2d*r3d);
- f1d:= dd;
+ //f1d:= dd;
f2d:= r1d*dd;
f3d:= r1d*r2d*dd;
f4d:= r1d*r2d*r3d*dd;
@@ -1484,10 +1481,10 @@ procedure TFrmWaterAdjustment.fseCaCl2Change(Sender: TObject);
Procedure TFrmWaterAdjustment.CalcSparge;
var alkalinity, acid, TargetpH : double;
- r1, r2, d, f1, f2, f3 : double;
- r1g, r2g, dg, f1g, f2g, f3g : double;
- r143, r243, d43, f143, f243, f343 : double;
- r1d, r2d, r3d, dd, f1d, f2d, f3d, f4d, fract, pK1, pK2, pK3, MolWt, AcidSG, AcidPrc : double;
+ r1, r2, d, f1, {f2,} f3 : double;
+ r1g, r2g, dg, f1g, {f2g,} f3g : double;
+ r143, r243, d43, f143, {f243,} f343 : double;
+ fract, pK1, pK2, pK3, MolWt, AcidSG, AcidPrc : double;
W : TWater;
AT : TAcidType;
begin
@@ -1506,7 +1503,7 @@ procedure TFrmWaterAdjustment.fseCaCl2Change(Sender: TObject);
r2:= power(10, acid - 10.33);
d:= 1 + r1 + r1*r2;
f1:= 1/d;
- f2:= r1/d;
+ //f2:= r1/d;
f3:= r1 * r2 / d;
//Step 2. Compute the mole fractions at pHb = 4.3 (the pH which defines alkalinity)
@@ -1514,7 +1511,7 @@ procedure TFrmWaterAdjustment.fseCaCl2Change(Sender: TObject);
r243:= power(10, 4.3 - 10.33);
d43:= 1 + r143 + r143*r243;
f143:= 1/d43;
- f243:= r143 / d43;
+ //f243:= r143 / d43;
f343:= r143 * r243 / d43;
//Step 3. Convert the sample alkalinity to milliequivalents/L
@@ -1528,7 +1525,7 @@ procedure TFrmWaterAdjustment.fseCaCl2Change(Sender: TObject);
r2g:= power(10, TargetpH - 10.33);
dg:= 1 + r1g + r1g*r2g;
f1g:= 1/dg;
- f2g:= r1g / dg;
+ //f2g:= r1g / dg;
f3g:= r1g * r2g / dg;
//Step 6. Use these to compute the milliequivalents acid required per liter (mEq/L)
@@ -1628,6 +1625,7 @@ procedure TFrmWaterAdjustment.fseAcidPercChange(Sender: TObject);
if FUserClicked then
begin
FUserClicked:= false;
+ {$warning This code makes no sense. AT gets a value but it is not used. }
for ATc:= Low(AcidTypeDisplayNames) to High(AcidTypeDisplayNames) do
if cbAcid.Items[cbAcid.ItemIndex] = AcidTypeDisplayNames[ATc] then
AT:= ATc;
@@ -1723,7 +1721,6 @@ procedure TFrmWaterAdjustment.bbTargetWaterClick(Sender: TObject);
dNa, dCa, dMg, dCl, dSO4, dCO3, dmax : Double;
NaCl, CaCl2 : Double;
MgSO4, CaSO4 : Double;
- MaxNeg : Double;
Vol : Double;
Wdest : TWater;
begin
@@ -1732,7 +1729,6 @@ procedure TFrmWaterAdjustment.bbTargetWaterClick(Sender: TObject);
dNa:= 0; dCa:= 0; dMg:= 0; dCl:= 0; dSO4:= 0; dCO3:= 0;
NaCl:= 0; CaCl2:= 0;
MgSO4:= 0; CaSO4:= 0;
- MaxNeg:= 0;
Vol:= 0;
Vol:= FMashWater.Amount.Value;
//remove dilution water if present and set all additions to 0
@@ -1887,22 +1883,17 @@ procedure TFrmWaterAdjustment.cbBaseMashChange(Sender: TObject);
end;
procedure TFrmWaterAdjustment.bbpHClSO4Click(Sender: TObject);
-var Na1, Na2, Nad, Ca1, Ca2, Cad, Mg1, Mg2, Mgd : Double;
- Cl1, Cl2, Cld, SO41, SO42, SO4d, CO31, CO32, CO3d : Double;
- dNa, dCa, dMg, dCl, dSO4, dCO3, dmax : Double;
- NaCl, CaCl2 : Double;
- MgSO4, CaSO4 : Double;
+var Cl1, Cl2, Cld, SO41, SO42, SO4d : Double;
+ dCl, dSO4, dmax : Double;
+ CaCl2, CaSO4 : Double;
ClSO4opt : double;
- MaxNeg : Double;
Vol : Double;
Wdest : TWater;
begin
- Na1:= 0; Na2:= 0; Nad:= 0; Ca1:= 0; Ca2:= 0; Cad:= 0; Mg1:= 0; Mg2:= 0; Mgd:= 0;
- Cl1:= 0; Cl2:= 0; Cld:= 0; SO41:= 0; SO42:= 0; SO4d:= 0; CO31:= 0; CO32:= 0; CO3d:= 0;
- dNa:= 0; dCa:= 0; dMg:= 0; dCl:= 0; dSO4:= 0; dCO3:= 0;
- NaCl:= 0; CaCl2:= 0;
- MgSO4:= 0; CaSO4:= 0;
- MaxNeg:= 0;
+ Cl1:= 0; Cl2:= 0; Cld:= 0; SO41:= 0; SO42:= 0; SO4d:= 0;
+ dCl:= 0; dSO4:= 0;
+ CaCl2:= 0;
+ CaSO4:= 0;
Vol:= 0;
Vol:= FMashWater.Amount.Value;
//remove dilution water if present and set all additions to 0
@@ -1958,7 +1949,6 @@ procedure TFrmWaterAdjustment.bbpHClSO4Click(Sender: TObject);
SO42:= Cl2 / ClSO4opt;
end;
-
// Get concentration of ions in diluted brewwater (1) and target water (2) in mmol/l
SO41:= FMashWater.Sulfate.Value / MMSO4;
SO42:= MaxD(SO41, SO42) / MMSO4;
@@ -1972,7 +1962,6 @@ procedure TFrmWaterAdjustment.bbpHClSO4Click(Sender: TObject);
CaSO4:= dSO4;
CaCl2:= dCl / 2;
-
//calculate addition in grams per salt
CaCl2:= CaCl2 * MMCaCl2 * Vol / 1000;
CaSO4:= CaSO4 * MMCaSO4 * Vol / 1000;
diff --git a/Source/UserInterface/Forms/frwaters.pas b/Source/UserInterface/Forms/frwaters.pas
index 00b918f6..28cd9115 100644
--- a/Source/UserInterface/Forms/frwaters.pas
+++ b/Source/UserInterface/Forms/frwaters.pas
@@ -87,7 +87,6 @@ TFrmWaters = class(TForm)
procedure bbImportClick(Sender: TObject);
procedure bbCopyClick(Sender: TObject);
private
- { private declarations }
FSelectedNode : TTreeNode;
FNew : boolean;
FUserClicked : boolean;
@@ -95,7 +94,7 @@ TFrmWaters = class(TForm)
Procedure FillTree;
Procedure UpdateAmoebe;
public
- { public declarations }
+
end;
var
@@ -155,7 +154,7 @@ procedure TFrmWaters.FormCreate(Sender: TObject);
var i : integer;
mname : string;
W : TWater;
- Node, ChildNode: TTreeNode;
+ Node, {%H-}ChildNode: TTreeNode;
begin
tvSelect.Items.Clear;
Node:= tvSelect.Items.Add(nil,'');
@@ -407,8 +406,6 @@ procedure TFrmWaters.bbCancelClick(Sender: TObject);
end;
procedure TFrmWaters.cbDefaultChange(Sender: TObject);
-var i : integer;
- W : TWater;
begin
end;
diff --git a/Source/UserInterface/Forms/frwaterwizard.pas b/Source/UserInterface/Forms/frwaterwizard.pas
index e869bd1c..de63330e 100644
--- a/Source/UserInterface/Forms/frwaterwizard.pas
+++ b/Source/UserInterface/Forms/frwaterwizard.pas
@@ -1,4 +1,4 @@
-unit frwaterwizard;
+unit FrWaterWizard;
{$mode objfpc}{$H+}
@@ -81,16 +81,14 @@ TFrmWaterWizard = class(TForm)
procedure sbSpargeChange(Sender: TObject);
procedure sbSpargeMashChange(Sender: TObject);
private
- { private declarations }
FRec : TRecipe;
un, dun : TUnit;
Mash : TMash;
Eq : TEquipment;
FUserClicked : boolean;
FMaxFerm : double;
- Procedure Update;
+ Procedure Update; reintroduce;
public
- { public declarations }
Function Execute(R : TRecipe) : boolean;
end;
diff --git a/Source/UserInterface/Forms/fryeasts.pas b/Source/UserInterface/Forms/fryeasts.pas
index 40d638dd..5c6ff1b9 100644
--- a/Source/UserInterface/Forms/fryeasts.pas
+++ b/Source/UserInterface/Forms/fryeasts.pas
@@ -94,21 +94,19 @@ TFrmYeasts = class(TForm)
procedure fseMaxTemperatureChange(Sender: TObject);
procedure fseMinTemperatureChange(Sender: TObject);
procedure sbClearClick(Sender: TObject);
- procedure tvSelectKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
- );
+ procedure tvSelectKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure tvSelectSelectionChanged(Sender: TObject);
procedure eLaboratoryExit(Sender: TObject);
procedure bbImportClick(Sender: TObject);
procedure bbCopyClick(Sender: TObject);
private
- { private declarations }
FSelectedNode : TTreeNode;
FUserClicked : boolean;
Procedure Store;
Procedure FillTree;
Procedure UpdateAmoebe;
public
- { public declarations }
+
end;
var
@@ -184,7 +182,7 @@ procedure TFrmYeasts.FormCreate(Sender: TObject);
var i : integer;
supp, yname : string;
Y : TYeast;
- Node, ChildNode, ChildNode2 : TTreeNode;
+ Node, ChildNode, {%H-}ChildNode2 : TTreeNode;
begin
tvSelect.Items.Clear;
Node:= tvSelect.Items.Add(nil,'Fabrikant');
@@ -495,8 +493,7 @@ procedure TFrmYeasts.cbYeastFormChange(Sender: TObject);
end;
procedure TFrmYeasts.eSearchChange(Sender: TObject);
-var i : integer;
- N : TTreeNode;
+var N : TTreeNode;
Y : TYeast;
s, s2 : string;
Vis : boolean;
diff --git a/Source/UserInterface/Forms/fryeasts2.pas b/Source/UserInterface/Forms/fryeasts2.pas
index 359257db..ba2e37a4 100644
--- a/Source/UserInterface/Forms/fryeasts2.pas
+++ b/Source/UserInterface/Forms/fryeasts2.pas
@@ -67,14 +67,12 @@ TFrmYeasts2 = class(TForm)
procedure FormDestroy(Sender: TObject);
procedure cbNameChange(Sender: TObject);
private
- { private declarations }
FYeast, FOriginal, FChosen : TYeast;
FUserClicked : boolean;
Procedure Store;
Procedure SetControls;
procedure FillcbName;
public
- { public declarations }
Function Execute(Y : TYeast) : boolean;
end;
@@ -195,9 +193,6 @@ procedure TFrmYeasts2.cbOnlyInStockChange(Sender: TObject);
end;
Function TFrmYeasts2.Execute(Y : TYeast) : boolean;
-var i : integer;
- s : string;
- Ye : TYeast;
begin
FYeast:= Y;
FOriginal.Assign(Y);
diff --git a/Source/UserInterface/Forms/fryeasts3.pas b/Source/UserInterface/Forms/fryeasts3.pas
index 71f55be0..d435bd10 100644
--- a/Source/UserInterface/Forms/fryeasts3.pas
+++ b/Source/UserInterface/Forms/fryeasts3.pas
@@ -1,4 +1,4 @@
-unit fryeasts3;
+unit FrYeasts3;
{$mode objfpc}{$H+}
@@ -35,14 +35,12 @@ TFrmYeasts3 = class(TForm)
procedure eSearchChange(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
private
- { private declarations }
FYeast : TYeast;
FSort : integer;
FSortDec, FUserClicked : boolean;
FYeastList : array of TYeast;
Procedure SortGrid(Nr1, Nr2 : integer);
public
- { public declarations }
Function Execute(Y : TYeast) : boolean;
end;
diff --git a/Source/brewbuddy_linux-x64.lpi b/Source/brewbuddy_linux-x64.lpi
index 0e5bfd50..4e6c8d55 100644
--- a/Source/brewbuddy_linux-x64.lpi
+++ b/Source/brewbuddy_linux-x64.lpi
@@ -1,9 +1,12 @@
-
+
-
+
+
+
+
@@ -19,7 +22,7 @@
-
+
@@ -28,16 +31,13 @@
-
-
+
-
-
-
+
@@ -46,21 +46,25 @@
+
+
+
+
+
-
-
-
-
-
+
+
+
+
-
+
@@ -71,35 +75,24 @@
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
+
+
-
+
-
+
-
-
-
-
@@ -108,1588 +101,394 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
+
+
-
-
-
-
+
+
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
+
+
+
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
@@ -1697,8 +496,7 @@
-
-
+
@@ -1715,51 +513,26 @@
-
-
-
+
+
+
+
+
+
+
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/Source/brewbuddy_osx.lpi b/Source/brewbuddy_osx.lpi
index 5ded8c0e..1393bff6 100644
--- a/Source/brewbuddy_osx.lpi
+++ b/Source/brewbuddy_osx.lpi
@@ -1,14 +1,16 @@
-
+
-
+
+
+
+
-
@@ -20,20 +22,19 @@
-
+
-
-
-
-
-
+
+
+
+
-
+
@@ -44,35 +45,24 @@
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
+
+
-
+
-
+
-
-
-
-
@@ -81,1492 +71,365 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
@@ -1574,7 +437,7 @@
-
+
@@ -1591,8 +454,6 @@
-
-
@@ -1610,37 +471,6 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/Source/brewbuddy_win32.lpi b/Source/brewbuddy_win32.lpi
index 3fd907e3..de2a4b02 100644
--- a/Source/brewbuddy_win32.lpi
+++ b/Source/brewbuddy_win32.lpi
@@ -1,9 +1,12 @@
-
+
-
+
+
+
+
@@ -19,7 +22,7 @@
-
+
@@ -27,15 +30,14 @@
-
-
-
-
-
+
+
+
+
-
+
@@ -46,35 +48,24 @@
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
+
+
-
+
-
+
-
-
-
-
@@ -83,1623 +74,365 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
@@ -1707,8 +440,8 @@
-
-
+
+
@@ -1743,37 +476,6 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/Source/brewbuddy_win64.lpi b/Source/brewbuddy_win64.lpi
index c304b62f..24fed0d2 100644
--- a/Source/brewbuddy_win64.lpi
+++ b/Source/brewbuddy_win64.lpi
@@ -1,9 +1,12 @@
-
+
-
+
+
+
+
@@ -19,7 +22,7 @@
-
+
@@ -28,8 +31,7 @@
-
-
+
@@ -69,8 +71,8 @@
-
-
+
+
@@ -97,15 +99,14 @@
-
-
-
-
-
+
+
+
+
-
+
@@ -116,35 +117,24 @@
-
-
-
-
+
+
+
-
-
-
-
-
-
-
-
+
+
-
+
-
+
-
-
-
-
@@ -153,1623 +143,365 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
-
-
-
-
-
-
+
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
@@ -1777,8 +509,8 @@
-
-
+
+
@@ -1808,37 +540,6 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-